2015-04-09 10:00:26 +00:00
|
|
|
/*******************************************************************
|
|
|
|
** s y s d e p . c
|
|
|
|
** Forth Inspired Command Language
|
|
|
|
** Author: John Sadler (john_sadler@alum.mit.edu)
|
|
|
|
** Created: 16 Oct 1997
|
|
|
|
** Implementations of FICL external interface functions...
|
|
|
|
**
|
|
|
|
*******************************************************************/
|
|
|
|
|
|
|
|
/* $FreeBSD$ */
|
|
|
|
|
|
|
|
#ifdef TESTMAIN
|
|
|
|
#include <stdio.h>
|
|
|
|
#include <stdlib.h>
|
|
|
|
#else
|
|
|
|
#include <stand.h>
|
|
|
|
#endif
|
|
|
|
#include "ficl.h"
|
|
|
|
|
|
|
|
/*
|
|
|
|
******************* FreeBSD P O R T B E G I N S H E R E ******************** Michael Smith
|
|
|
|
*/
|
|
|
|
|
|
|
|
#if PORTABLE_LONGMULDIV == 0
|
|
|
|
DPUNS ficlLongMul(FICL_UNS x, FICL_UNS y)
|
|
|
|
{
|
|
|
|
DPUNS q;
|
2018-03-13 16:33:00 +00:00
|
|
|
uint64_t qx;
|
2015-04-09 10:00:26 +00:00
|
|
|
|
2018-03-13 16:33:00 +00:00
|
|
|
qx = (uint64_t)x * (uint64_t) y;
|
2015-04-09 10:00:26 +00:00
|
|
|
|
2018-03-13 16:33:00 +00:00
|
|
|
q.hi = (uint32_t)( qx >> 32 );
|
|
|
|
q.lo = (uint32_t)( qx & 0xFFFFFFFFL);
|
2015-04-09 10:00:26 +00:00
|
|
|
|
|
|
|
return q;
|
|
|
|
}
|
|
|
|
|
|
|
|
UNSQR ficlLongDiv(DPUNS q, FICL_UNS y)
|
|
|
|
{
|
|
|
|
UNSQR result;
|
2018-03-13 16:33:00 +00:00
|
|
|
uint64_t qx, qh;
|
2015-04-09 10:00:26 +00:00
|
|
|
|
|
|
|
qh = q.hi;
|
|
|
|
qx = (qh << 32) | q.lo;
|
|
|
|
|
|
|
|
result.quot = qx / y;
|
|
|
|
result.rem = qx % y;
|
|
|
|
|
|
|
|
return result;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
void ficlTextOut(FICL_VM *pVM, char *msg, int fNewline)
|
|
|
|
{
|
|
|
|
IGNORE(pVM);
|
|
|
|
|
|
|
|
while(*msg != 0)
|
|
|
|
putchar(*(msg++));
|
|
|
|
if (fNewline)
|
|
|
|
putchar('\n');
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
void *ficlMalloc (size_t size)
|
|
|
|
{
|
|
|
|
return malloc(size);
|
|
|
|
}
|
|
|
|
|
|
|
|
void *ficlRealloc (void *p, size_t size)
|
|
|
|
{
|
|
|
|
return realloc(p, size);
|
|
|
|
}
|
|
|
|
|
|
|
|
void ficlFree (void *p)
|
|
|
|
{
|
|
|
|
free(p);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
** Stub function for dictionary access control - does nothing
|
|
|
|
** by default, user can redefine to guarantee exclusive dict
|
|
|
|
** access to a single thread for updates. All dict update code
|
|
|
|
** is guaranteed to be bracketed as follows:
|
|
|
|
** ficlLockDictionary(TRUE);
|
|
|
|
** <code that updates dictionary>
|
|
|
|
** ficlLockDictionary(FALSE);
|
|
|
|
**
|
|
|
|
** Returns zero if successful, nonzero if unable to acquire lock
|
|
|
|
** befor timeout (optional - could also block forever)
|
|
|
|
*/
|
|
|
|
#if FICL_MULTITHREAD
|
|
|
|
int ficlLockDictionary(short fLock)
|
|
|
|
{
|
|
|
|
IGNORE(fLock);
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
#endif /* FICL_MULTITHREAD */
|