196962Sjake/******************************************************************* 296962Sjake** s y s d e p . c 396962Sjake** Forth Inspired Command Language 496962Sjake** Author: John Sadler (john_sadler@alum.mit.edu) 596962Sjake** Created: 16 Oct 1997 696962Sjake** Implementations of FICL external interface functions... 796962Sjake** 896962Sjake*******************************************************************/ 996962Sjake 1096962Sjake/* $FreeBSD$ */ 1196962Sjake 1296962Sjake#ifdef TESTMAIN 1396962Sjake#include <stdio.h> 1496962Sjake#include <stdlib.h> 1596962Sjake#else 1696962Sjake#include <stand.h> 1796962Sjake#endif 1896962Sjake#include "ficl.h" 1996962Sjake 2096962Sjake/* 2196962Sjake******************* FreeBSD P O R T B E G I N S H E R E ******************** Michael Smith 2296962Sjake*/ 2396962Sjake 2496962Sjake#if PORTABLE_LONGMULDIV == 0 2596962SjakeDPUNS ficlLongMul(FICL_UNS x, FICL_UNS y) 2696962Sjake{ 2796962Sjake DPUNS q; 2896962Sjake u_int64_t qx; 2996962Sjake 3096962Sjake qx = (u_int64_t)x * (u_int64_t) y; 3196962Sjake 3296962Sjake q.hi = (u_int32_t)( qx >> 32 ); 3396962Sjake q.lo = (u_int32_t)( qx & 0xFFFFFFFFL); 3496962Sjake 3596962Sjake return q; 3696962Sjake} 3796962Sjake 3896962SjakeUNSQR ficlLongDiv(DPUNS q, FICL_UNS y) 3996962Sjake{ 4096962Sjake UNSQR result; 4196962Sjake u_int64_t qx, qh; 4296962Sjake 4396962Sjake qh = q.hi; 4496962Sjake qx = (qh << 32) | q.lo; 4596962Sjake 4696962Sjake result.quot = qx / y; 4796962Sjake result.rem = qx % y; 4896962Sjake 4996962Sjake return result; 5096962Sjake} 5196962Sjake#endif 5296962Sjake 5396962Sjakevoid ficlTextOut(FICL_VM *pVM, char *msg, int fNewline) 5496962Sjake{ 5596962Sjake IGNORE(pVM); 5696962Sjake 5796962Sjake while(*msg != 0) 5896962Sjake putchar(*(msg++)); 5996962Sjake if (fNewline) 6096962Sjake putchar('\n'); 6196962Sjake 6296962Sjake return; 6396962Sjake} 6496962Sjake 6596962Sjakevoid *ficlMalloc (size_t size) 6696962Sjake{ 6796962Sjake return malloc(size); 6896962Sjake} 6996962Sjake 7096962Sjakevoid *ficlRealloc (void *p, size_t size) 7196962Sjake{ 7296962Sjake return realloc(p, size); 7396962Sjake} 7496962Sjake 7596962Sjakevoid ficlFree (void *p) 7696962Sjake{ 7796962Sjake free(p); 7896962Sjake} 7996962Sjake 8096962Sjake 8196962Sjake/* 8296962Sjake** Stub function for dictionary access control - does nothing 8396962Sjake** by default, user can redefine to guarantee exclusive dict 8496962Sjake** access to a single thread for updates. All dict update code 8596962Sjake** is guaranteed to be bracketed as follows: 8696962Sjake** ficlLockDictionary(TRUE); 8796962Sjake** <code that updates dictionary> 8896962Sjake** ficlLockDictionary(FALSE); 8996962Sjake** 9096962Sjake** Returns zero if successful, nonzero if unable to acquire lock 9196962Sjake** befor timeout (optional - could also block forever) 9296962Sjake*/ 9396962Sjake#if FICL_MULTITHREAD 9496962Sjakeint ficlLockDictionary(short fLock) 9596962Sjake{ 9696962Sjake IGNORE(fLock); 9796962Sjake return 0; 9896962Sjake} 9996962Sjake#endif /* FICL_MULTITHREAD */ 10096962Sjake 10196962Sjake 102