1ca987d46SWarner Losh /******************************************************************* 2ca987d46SWarner Losh ** s y s d e p . c 3ca987d46SWarner Losh ** Forth Inspired Command Language 4ca987d46SWarner Losh ** Author: John Sadler (john_sadler@alum.mit.edu) 5ca987d46SWarner Losh ** Created: 16 Oct 1997 6ca987d46SWarner Losh ** Implementations of FICL external interface functions... 7ca987d46SWarner Losh ** 8ca987d46SWarner Losh *******************************************************************/ 9ca987d46SWarner Losh 10ca987d46SWarner Losh /* $FreeBSD$ */ 11ca987d46SWarner Losh 12ca987d46SWarner Losh #ifdef TESTMAIN 13ca987d46SWarner Losh #include <stdio.h> 14ca987d46SWarner Losh #include <stdlib.h> 15ca987d46SWarner Losh #else 16ca987d46SWarner Losh #include <stand.h> 17ca987d46SWarner Losh #endif 18ca987d46SWarner Losh #include "ficl.h" 19ca987d46SWarner Losh 20ca987d46SWarner Losh /* 21ca987d46SWarner Losh ******************* FreeBSD P O R T B E G I N S H E R E ******************** Michael Smith 22ca987d46SWarner Losh */ 23ca987d46SWarner Losh 24ca987d46SWarner Losh #if PORTABLE_LONGMULDIV == 0 25ca987d46SWarner Losh DPUNS ficlLongMul(FICL_UNS x, FICL_UNS y) 26ca987d46SWarner Losh { 27ca987d46SWarner Losh DPUNS q; 28*56e53cb8SWarner Losh uint64_t qx; 29ca987d46SWarner Losh 30*56e53cb8SWarner Losh qx = (uint64_t)x * (uint64_t) y; 31ca987d46SWarner Losh 32*56e53cb8SWarner Losh q.hi = (uint32_t)( qx >> 32 ); 33*56e53cb8SWarner Losh q.lo = (uint32_t)( qx & 0xFFFFFFFFL); 34ca987d46SWarner Losh 35ca987d46SWarner Losh return q; 36ca987d46SWarner Losh } 37ca987d46SWarner Losh 38ca987d46SWarner Losh UNSQR ficlLongDiv(DPUNS q, FICL_UNS y) 39ca987d46SWarner Losh { 40ca987d46SWarner Losh UNSQR result; 41*56e53cb8SWarner Losh uint64_t qx, qh; 42ca987d46SWarner Losh 43ca987d46SWarner Losh qh = q.hi; 44ca987d46SWarner Losh qx = (qh << 32) | q.lo; 45ca987d46SWarner Losh 46ca987d46SWarner Losh result.quot = qx / y; 47ca987d46SWarner Losh result.rem = qx % y; 48ca987d46SWarner Losh 49ca987d46SWarner Losh return result; 50ca987d46SWarner Losh } 51ca987d46SWarner Losh #endif 52ca987d46SWarner Losh 53ca987d46SWarner Losh void ficlTextOut(FICL_VM *pVM, char *msg, int fNewline) 54ca987d46SWarner Losh { 55ca987d46SWarner Losh IGNORE(pVM); 56ca987d46SWarner Losh 57ca987d46SWarner Losh while(*msg != 0) 58ca987d46SWarner Losh putchar(*(msg++)); 59ca987d46SWarner Losh if (fNewline) 60ca987d46SWarner Losh putchar('\n'); 61ca987d46SWarner Losh 62ca987d46SWarner Losh return; 63ca987d46SWarner Losh } 64ca987d46SWarner Losh 65ca987d46SWarner Losh void *ficlMalloc (size_t size) 66ca987d46SWarner Losh { 67ca987d46SWarner Losh return malloc(size); 68ca987d46SWarner Losh } 69ca987d46SWarner Losh 70ca987d46SWarner Losh void *ficlRealloc (void *p, size_t size) 71ca987d46SWarner Losh { 72ca987d46SWarner Losh return realloc(p, size); 73ca987d46SWarner Losh } 74ca987d46SWarner Losh 75ca987d46SWarner Losh void ficlFree (void *p) 76ca987d46SWarner Losh { 77ca987d46SWarner Losh free(p); 78ca987d46SWarner Losh } 79ca987d46SWarner Losh 80ca987d46SWarner Losh 81ca987d46SWarner Losh /* 82ca987d46SWarner Losh ** Stub function for dictionary access control - does nothing 83ca987d46SWarner Losh ** by default, user can redefine to guarantee exclusive dict 84ca987d46SWarner Losh ** access to a single thread for updates. All dict update code 85ca987d46SWarner Losh ** is guaranteed to be bracketed as follows: 86ca987d46SWarner Losh ** ficlLockDictionary(TRUE); 87ca987d46SWarner Losh ** <code that updates dictionary> 88ca987d46SWarner Losh ** ficlLockDictionary(FALSE); 89ca987d46SWarner Losh ** 90ca987d46SWarner Losh ** Returns zero if successful, nonzero if unable to acquire lock 91ca987d46SWarner Losh ** befor timeout (optional - could also block forever) 92ca987d46SWarner Losh */ 93ca987d46SWarner Losh #if FICL_MULTITHREAD 94ca987d46SWarner Losh int ficlLockDictionary(short fLock) 95ca987d46SWarner Losh { 96ca987d46SWarner Losh IGNORE(fLock); 97ca987d46SWarner Losh return 0; 98ca987d46SWarner Losh } 99ca987d46SWarner Losh #endif /* FICL_MULTITHREAD */ 100