Bring in FICL 2.04. No bump of loader version is required by this
commit.
This commit is contained in:
parent
35f9e4a1db
commit
7795d19132
Notes:
svn2git
2020-12-20 02:59:44 +00:00
svn path=/head/; revision=60959
@ -381,8 +381,7 @@ void dictDelete(FICL_DICT *pDict)
|
||||
/**************************************************************************
|
||||
d i c t E m p t y
|
||||
** Empty the dictionary, reset its hash table, and reset its search order.
|
||||
** Clears and (re-)creates the main hash table (pForthWords) with the
|
||||
** size specified by nHash.
|
||||
** Clears and (re-)creates the hash table with the size specified by nHash.
|
||||
**************************************************************************/
|
||||
void dictEmpty(FICL_DICT *pDict, unsigned nHash)
|
||||
{
|
||||
|
@ -131,6 +131,38 @@ FICL_VM *ficlNewVM(void)
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
f i c l F r e e V M
|
||||
** Removes the VM in question from the system VM list and deletes the
|
||||
** memory allocated to it. This is an optional call, since ficlTermSystem
|
||||
** will do this cleanup for you. This function is handy if you're going to
|
||||
** do a lot of dynamic creation of VMs.
|
||||
**************************************************************************/
|
||||
void ficlFreeVM(FICL_VM *pVM)
|
||||
{
|
||||
FICL_VM *pList = vmList;
|
||||
|
||||
assert(pVM != 0);
|
||||
|
||||
if (vmList == pVM)
|
||||
{
|
||||
vmList = vmList->link;
|
||||
}
|
||||
else for (pList; pList != 0; pList = pList->link)
|
||||
{
|
||||
if (pList->link == pVM)
|
||||
{
|
||||
pList->link = pVM->link;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (pList)
|
||||
vmDelete(pVM);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
f i c l B u i l d
|
||||
** Builds a word into the dictionary.
|
||||
@ -151,6 +183,7 @@ int ficlBuild(char *name, FICL_CODE code, char flags)
|
||||
int err = ficlLockDictionary(TRUE);
|
||||
if (err) return err;
|
||||
|
||||
assert(dictCellsAvail(dp) > sizeof (FICL_WORD) / sizeof (CELL));
|
||||
dictAppendWord(dp, name, code, flags);
|
||||
|
||||
ficlLockDictionary(FALSE);
|
||||
@ -187,9 +220,8 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
|
||||
|
||||
int except;
|
||||
jmp_buf vmState;
|
||||
jmp_buf *oldState;
|
||||
TIB saveTib;
|
||||
FICL_VM VM;
|
||||
FICL_STACK rStack;
|
||||
|
||||
if (!pInterp)
|
||||
pInterp = ficlLookup("interpret");
|
||||
@ -203,11 +235,9 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
|
||||
vmPushTib(pVM, pText, size, &saveTib);
|
||||
|
||||
/*
|
||||
** Save and restore pVM and pVM->rStack to enable nested calls to ficlExec
|
||||
** Save and restore VM's jmp_buf to enable nested calls to ficlExec
|
||||
*/
|
||||
memcpy((void*)&VM, (void*)pVM, sizeof(FICL_VM));
|
||||
memcpy((void*)&rStack, (void*)pVM->rStack, sizeof(FICL_STACK));
|
||||
|
||||
oldState = pVM->pState;
|
||||
pVM->pState = &vmState; /* This has to come before the setjmp! */
|
||||
except = setjmp(vmState);
|
||||
|
||||
@ -267,14 +297,11 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
|
||||
#endif
|
||||
}
|
||||
dictResetSearchOrder(dp);
|
||||
memcpy((void*)pVM, (void*)&VM, sizeof(FICL_VM));
|
||||
memcpy((void*)pVM->rStack, (void*)&rStack, sizeof(FICL_STACK));
|
||||
stackReset(pVM->pStack);
|
||||
pVM->base = 10;
|
||||
vmReset(pVM);
|
||||
break;
|
||||
}
|
||||
|
||||
pVM->pState = VM.pState;
|
||||
pVM->pState = oldState;
|
||||
vmPopTib(pVM, &saveTib);
|
||||
return (except);
|
||||
}
|
||||
@ -393,7 +420,7 @@ int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
|
||||
vmThrow(pVM, except);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
pVM->pState = oldState;
|
||||
return (except);
|
||||
@ -543,3 +570,5 @@ void ficlTermSystem(void)
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
@ -517,11 +517,17 @@ STRINGINFO vmGetWord(FICL_VM *pVM);
|
||||
STRINGINFO vmGetWord0(FICL_VM *pVM);
|
||||
int vmGetWordToPad(FICL_VM *pVM);
|
||||
STRINGINFO vmParseString(FICL_VM *pVM, char delimiter);
|
||||
STRINGINFO vmParseStringEx(FICL_VM *pVM, char delimiter, char fSkipLeading);
|
||||
CELL vmPop(FICL_VM *pVM);
|
||||
void vmPush(FICL_VM *pVM, CELL c);
|
||||
void vmPopIP (FICL_VM *pVM);
|
||||
void vmPushIP (FICL_VM *pVM, IPTYPE newIP);
|
||||
void vmQuit (FICL_VM *pVM);
|
||||
void vmReset (FICL_VM *pVM);
|
||||
void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut);
|
||||
#if FICL_WANT_DEBUGGER
|
||||
void vmStep(FICL_VM *pVM);
|
||||
#endif
|
||||
void vmTextOut(FICL_VM *pVM, char *text, int fNewline);
|
||||
void vmThrow (FICL_VM *pVM, int except);
|
||||
void vmThrowErr(FICL_VM *pVM, char *fmt, ...);
|
||||
@ -533,13 +539,13 @@ void vmThrowErr(FICL_VM *pVM, char *fmt, ...);
|
||||
** The inner interpreter - coded as a macro (see note for
|
||||
** INLINE_INNER_LOOP in sysdep.h for complaints about VC++ 5
|
||||
*/
|
||||
#define M_INNER_LOOP(pVM) \
|
||||
for (;;) \
|
||||
{ \
|
||||
#define M_VM_STEP(pVM) \
|
||||
FICL_WORD *tempFW = *(pVM)->ip++; \
|
||||
(pVM)->runningWord = tempFW; \
|
||||
tempFW->code(pVM); \
|
||||
}
|
||||
|
||||
#define M_INNER_LOOP(pVM) \
|
||||
for (;;) { M_VM_STEP(pVM) }
|
||||
|
||||
|
||||
#if INLINE_INNER_LOOP != 0
|
||||
@ -771,6 +777,16 @@ int ficlExecFD(FICL_VM *pVM, int fd);
|
||||
*/
|
||||
FICL_VM *ficlNewVM(void);
|
||||
|
||||
/*
|
||||
** Force deletion of a VM. You do not need to do this
|
||||
** unless you're creating and discarding a lot of VMs.
|
||||
** For systems that use a constant pool of VMs for the life
|
||||
** of the system, ficltermSystem takes care of VM cleanup
|
||||
** automatically.
|
||||
*/
|
||||
void ficlFreeVM(FICL_VM *pVM);
|
||||
|
||||
|
||||
/*
|
||||
** Set the stack sizes (return and parameter) to be used for all
|
||||
** subsequently created VMs. Returns actual stack size to be used.
|
||||
|
@ -2,6 +2,8 @@
|
||||
\ ** F I C L 2 . 0 C L A S S E S
|
||||
\ john sadler 1 sep 98
|
||||
\ Needs oop.fr
|
||||
\
|
||||
\ $FreeBSD$
|
||||
|
||||
.( loading ficl utility classes ) cr
|
||||
also oop definitions
|
||||
@ -68,6 +70,16 @@ object subclass c-ptr
|
||||
c-4byte => set
|
||||
;
|
||||
|
||||
\ force the pointer to be null
|
||||
: clr-ptr
|
||||
0 -rot c-ptr => .addr c-4byte => set
|
||||
;
|
||||
|
||||
\ return flag indicating null-ness
|
||||
: ?null ( inst class -- flag )
|
||||
c-ptr => get-ptr 0=
|
||||
;
|
||||
|
||||
\ increment the pointer in place
|
||||
: inc-ptr ( inst class -- )
|
||||
2dup 2dup ( i c i c i c )
|
||||
|
@ -9,6 +9,11 @@
|
||||
\ locstate: 0 = looking for | or -- or }}
|
||||
\ 1 = found |
|
||||
\ 2 = found --
|
||||
\ 3 = found }
|
||||
\ 4 = end of line
|
||||
\
|
||||
\ $FreeBSD$
|
||||
|
||||
hide
|
||||
0 constant zero
|
||||
|
||||
@ -19,16 +24,18 @@ hide
|
||||
: ?| ( c-addr u -- c-addr u flag )
|
||||
2dup s" |" compare 0= ;
|
||||
|
||||
\ examine name and push true if it's a 2local
|
||||
\ (starts with '2'), false otherwise.
|
||||
: ?2loc ( c-addr u -- c-addr n flag )
|
||||
over c@ [char] 2 = if true else false endif ;
|
||||
|
||||
: ?delim ( c-addr u -- state | c-addr u 0 )
|
||||
?| if
|
||||
2drop 1
|
||||
else
|
||||
?-- if
|
||||
2drop 2
|
||||
else
|
||||
?} if 2drop 3 else 0 endif
|
||||
endif
|
||||
endif
|
||||
?| if 2drop 1 exit endif
|
||||
?-- if 2drop 2 exit endif
|
||||
?} if 2drop 3 exit endif
|
||||
dup 0=
|
||||
if 2drop 4 exit endif
|
||||
0
|
||||
;
|
||||
|
||||
set-current
|
||||
@ -45,7 +52,9 @@ set-current
|
||||
repeat
|
||||
|
||||
\ now unstack the locals
|
||||
0 do (local) loop \ ( )
|
||||
0 do
|
||||
?2loc if (2local) else (local) endif
|
||||
loop \ ( )
|
||||
|
||||
\ zero locals until -- or }
|
||||
locstate 1 = if
|
||||
@ -53,7 +62,11 @@ set-current
|
||||
parse-word
|
||||
?delim dup to locstate
|
||||
0= while
|
||||
postpone zero (local)
|
||||
?2loc if
|
||||
postpone zero postpone zero (2local)
|
||||
else
|
||||
postpone zero (local)
|
||||
endif
|
||||
repeat
|
||||
endif
|
||||
|
||||
|
@ -1,6 +1,9 @@
|
||||
\ ** ficl/softwords/oo.fr
|
||||
\ ** F I C L O - O E X T E N S I O N S
|
||||
\ ** john sadler aug 1998
|
||||
\
|
||||
\ $FreeBSD$
|
||||
|
||||
|
||||
.( loading ficl O-O extensions ) cr
|
||||
7 ficl-vocabulary oop
|
||||
@ -216,6 +219,10 @@ set-current previous
|
||||
\ instance of the class. This word gets compiled into
|
||||
\ the wordlist of every class by the SUB method.
|
||||
\ PRECONDITION: current-class contains the class address
|
||||
\ why use a state variable instead of the stack?
|
||||
\ >> Stack state is not well-defined during compilation (there are
|
||||
\ >> control structure match codes on the stack, of undefined size
|
||||
\ >> easiest way around this is use of this thread-local variable
|
||||
\
|
||||
: do-do-instance ( -- )
|
||||
s" : .do-instance does> [ current-class @ ] literal ;"
|
||||
@ -232,7 +239,8 @@ set-current previous
|
||||
\
|
||||
:noname
|
||||
wordlist
|
||||
create immediate
|
||||
create
|
||||
immediate
|
||||
0 , \ NULL parent class
|
||||
dup , \ wid
|
||||
3 cells , \ instance size
|
||||
@ -295,6 +303,24 @@ previous
|
||||
--> array-init
|
||||
;
|
||||
|
||||
\ Create an anonymous initialized instance from the heap
|
||||
: alloc \ ( class metaclass -- instance class )
|
||||
locals| meta class |
|
||||
class meta metaclass => get-size allocate ( -- addr fail-flag )
|
||||
abort" allocate failed " ( -- addr )
|
||||
class 2dup --> init
|
||||
;
|
||||
|
||||
\ Create an anonymous array of initialized instances from the heap
|
||||
: alloc-array \ ( n class metaclass -- instance class )
|
||||
locals| meta class nobj |
|
||||
class meta metaclass => get-size
|
||||
nobj * allocate ( -- addr fail-flag )
|
||||
abort" allocate failed " ( -- addr )
|
||||
nobj over class --> array-init
|
||||
class
|
||||
;
|
||||
|
||||
\ create a proxy object with initialized payload address given
|
||||
: ref ( instance-addr class metaclass "name" -- )
|
||||
drop create , ,
|
||||
@ -412,6 +438,14 @@ do-do-instance
|
||||
loop
|
||||
;
|
||||
|
||||
\ free storage allocated to a heap instance by alloc or alloc-array
|
||||
\ NOTE: not protected against errors like FREEing something that's
|
||||
\ really in the dictionary.
|
||||
: free \ ( instance class -- )
|
||||
drop free
|
||||
abort" free failed "
|
||||
;
|
||||
|
||||
\ Instance aliases for common class methods
|
||||
\ Upcast to parent class
|
||||
: super ( instance class -- instance parent-class )
|
||||
|
@ -69,6 +69,8 @@ decimal 32 constant bl
|
||||
|
||||
: local ( name -- ) bl word count (local) ; immediate
|
||||
|
||||
: 2local ( name -- ) bl word count (2local) ; immediate
|
||||
|
||||
: end-locals ( -- ) 0 0 (local) ; immediate
|
||||
|
||||
\ #endif
|
||||
|
@ -118,6 +118,7 @@ void vmInnerLoop(FICL_VM *pVM)
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m G e t S t r i n g
|
||||
** Parses a string out of the VM input buffer and copies up to the first
|
||||
@ -128,7 +129,7 @@ void vmInnerLoop(FICL_VM *pVM)
|
||||
**************************************************************************/
|
||||
char *vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter)
|
||||
{
|
||||
STRINGINFO si = vmParseString(pVM, delimiter);
|
||||
STRINGINFO si = vmParseStringEx(pVM, delimiter, 0);
|
||||
|
||||
if (SI_COUNT(si) > FICL_STRING_MAX)
|
||||
{
|
||||
@ -229,14 +230,22 @@ int vmGetWordToPad(FICL_VM *pVM)
|
||||
** trailing delimiter.
|
||||
**************************************************************************/
|
||||
STRINGINFO vmParseString(FICL_VM *pVM, char delim)
|
||||
{
|
||||
return vmParseStringEx(pVM, delim, 1);
|
||||
}
|
||||
|
||||
STRINGINFO vmParseStringEx(FICL_VM *pVM, char delim, char fSkipLeading)
|
||||
{
|
||||
STRINGINFO si;
|
||||
char *pSrc = vmGetInBuf(pVM);
|
||||
char *pEnd = vmGetInBufEnd(pVM);
|
||||
char ch;
|
||||
|
||||
while ((pSrc != pEnd) && (*pSrc == delim)) /* skip lead delimiters */
|
||||
pSrc++;
|
||||
if (fSkipLeading)
|
||||
{ /* skip lead delimiters */
|
||||
while ((pSrc != pEnd) && (*pSrc == delim))
|
||||
pSrc++;
|
||||
}
|
||||
|
||||
SI_SETPTR(si, pSrc); /* mark start of text */
|
||||
|
||||
@ -259,6 +268,27 @@ STRINGINFO vmParseString(FICL_VM *pVM, char delim)
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m P o p
|
||||
**
|
||||
**************************************************************************/
|
||||
CELL vmPop(FICL_VM *pVM)
|
||||
{
|
||||
return stackPop(pVM->pStack);
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m P u s h
|
||||
**
|
||||
**************************************************************************/
|
||||
void vmPush(FICL_VM *pVM, CELL c)
|
||||
{
|
||||
stackPush(pVM->pStack, c);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m P o p I P
|
||||
**
|
||||
@ -363,6 +393,18 @@ void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut)
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m S t e p
|
||||
** Single step the vm - equivalent to "step into" - used for debugging
|
||||
**************************************************************************/
|
||||
#if FICL_WANT_DEBUGGER
|
||||
void vmStep(FICL_VM *pVM)
|
||||
{
|
||||
M_VM_STEP(pVM);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
v m T e x t O u t
|
||||
** Feeds text to the vm's output callback
|
||||
|
@ -52,6 +52,7 @@ static FICL_WORD *pExitParen = NULL;
|
||||
static FICL_WORD *pIfParen = NULL;
|
||||
static FICL_WORD *pInterpret = NULL;
|
||||
static FICL_WORD *pLitParen = NULL;
|
||||
static FICL_WORD *pTwoLitParen = NULL;
|
||||
static FICL_WORD *pLoopParen = NULL;
|
||||
static FICL_WORD *pPLoopParen = NULL;
|
||||
static FICL_WORD *pQDoParen = NULL;
|
||||
@ -62,16 +63,24 @@ static FICL_WORD *pType = NULL;
|
||||
|
||||
#if FICL_WANT_LOCALS
|
||||
static FICL_WORD *pGetLocalParen= NULL;
|
||||
static FICL_WORD *pGet2LocalParen= NULL;
|
||||
static FICL_WORD *pGetLocal0 = NULL;
|
||||
static FICL_WORD *pGetLocal1 = NULL;
|
||||
static FICL_WORD *pToLocalParen = NULL;
|
||||
static FICL_WORD *pTo2LocalParen = NULL;
|
||||
static FICL_WORD *pToLocal0 = NULL;
|
||||
static FICL_WORD *pToLocal1 = NULL;
|
||||
static FICL_WORD *pLinkParen = NULL;
|
||||
static FICL_WORD *pUnLinkParen = NULL;
|
||||
static int nLocals = 0;
|
||||
static CELL *pMarkLocals = NULL;
|
||||
|
||||
static void doLocalIm(FICL_VM *pVM);
|
||||
static void do2LocalIm(FICL_VM *pVM);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** C O N T R O L S T R U C T U R E B U I L D E R S
|
||||
**
|
||||
@ -223,6 +232,18 @@ static int isNumber(FICL_VM *pVM, STRINGINFO si)
|
||||
}
|
||||
|
||||
|
||||
static void ficlIsNum(FICL_VM *pVM)
|
||||
{
|
||||
STRINGINFO si;
|
||||
FICL_INT ret;
|
||||
|
||||
SI_SETLEN(si, stackPopINT(pVM->pStack));
|
||||
SI_SETPTR(si, stackPopPtr(pVM->pStack));
|
||||
ret = isNumber(pVM, si) ? FICL_TRUE : FICL_FALSE;
|
||||
stackPushINT(pVM->pStack, ret);
|
||||
return;
|
||||
}
|
||||
|
||||
/**************************************************************************
|
||||
a d d & f r i e n d s
|
||||
**
|
||||
@ -915,7 +936,7 @@ static void commentLine(FICL_VM *pVM)
|
||||
*/
|
||||
static void commentHang(FICL_VM *pVM)
|
||||
{
|
||||
vmParseString(pVM, ')');
|
||||
vmParseStringEx(pVM, ')', 0);
|
||||
return;
|
||||
}
|
||||
|
||||
@ -1068,11 +1089,7 @@ static void ifCoIm(FICL_VM *pVM)
|
||||
** called (not?branch) since it does "branch if false".
|
||||
**************************************************************************/
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void ifParen(FICL_VM *pVM)
|
||||
#else
|
||||
static void ifParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
FICL_UNS flag;
|
||||
|
||||
@ -1134,11 +1151,7 @@ static void elseCoIm(FICL_VM *pVM)
|
||||
** compilation address, and branches to that location.
|
||||
**************************************************************************/
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void branchParen(FICL_VM *pVM)
|
||||
#else
|
||||
static void branchParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
vmBranchRelative(pVM, *(int *)(pVM->ip));
|
||||
return;
|
||||
@ -1158,6 +1171,22 @@ static void endifCoIm(FICL_VM *pVM)
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
h a s h
|
||||
** hash ( c-addr u -- code)
|
||||
** calculates hashcode of specified string and leaves it on the stack
|
||||
**************************************************************************/
|
||||
|
||||
static void hash(FICL_VM *pVM)
|
||||
{
|
||||
STRINGINFO si;
|
||||
SI_SETLEN(si, stackPopUNS(pVM->pStack));
|
||||
SI_SETPTR(si, stackPopPtr(pVM->pStack));
|
||||
stackPushUNS(pVM->pStack, hashHashCode(si));
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
i n t e r p r e t
|
||||
** This is the "user interface" of a Forth. It does the following:
|
||||
@ -1188,10 +1217,13 @@ static void interpret(FICL_VM *pVM)
|
||||
** Get next word...if out of text, we're done.
|
||||
*/
|
||||
if (si.count == 0)
|
||||
{
|
||||
vmThrow(pVM, VM_OUTOFTEXT);
|
||||
}
|
||||
|
||||
interpWord(pVM, si);
|
||||
|
||||
|
||||
return; /* back to inner interpreter */
|
||||
}
|
||||
|
||||
@ -1239,6 +1271,7 @@ static void interpWord(FICL_VM *pVM, STRINGINFO si)
|
||||
{
|
||||
vmThrowErr(pVM, "Error: Compile only!");
|
||||
}
|
||||
|
||||
vmExecute(pVM, tempFW);
|
||||
}
|
||||
|
||||
@ -1285,11 +1318,8 @@ static void interpWord(FICL_VM *pVM, STRINGINFO si)
|
||||
** parameter stack at runtime. This code is compiled by "literal".
|
||||
**
|
||||
**************************************************************************/
|
||||
#ifdef FICL_TRACE
|
||||
void literalParen(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void literalParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
#if FICL_ROBUST > 1
|
||||
vmCheckStack(pVM, 0, 1);
|
||||
@ -1299,6 +1329,17 @@ static void literalParen(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
static void twoLitParen(FICL_VM *pVM)
|
||||
{
|
||||
#if FICL_ROBUST > 1
|
||||
vmCheckStack(pVM, 0, 2);
|
||||
#endif
|
||||
stackPushINT(pVM->pStack, *((FICL_INT *)(pVM->ip)+1));
|
||||
stackPushINT(pVM->pStack, *(FICL_INT *)(pVM->ip));
|
||||
vmBranchRelative(pVM, 2);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
l i t e r a l I m
|
||||
@ -1320,6 +1361,18 @@ static void literalIm(FICL_VM *pVM)
|
||||
}
|
||||
|
||||
|
||||
static void twoLiteralIm(FICL_VM *pVM)
|
||||
{
|
||||
FICL_DICT *dp = ficlGetDict();
|
||||
assert(pTwoLitParen);
|
||||
|
||||
dictAppendCell(dp, LVALUEtoCELL(pTwoLitParen));
|
||||
dictAppendCell(dp, stackPop(pVM->pStack));
|
||||
dictAppendCell(dp, stackPop(pVM->pStack));
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
/**************************************************************************
|
||||
l i s t W o r d s
|
||||
**
|
||||
@ -1602,11 +1655,8 @@ static void doCoIm(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void doParen(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void doParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
CELL index, limit;
|
||||
#if FICL_ROBUST > 1
|
||||
@ -1645,11 +1695,8 @@ static void qDoCoIm(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void qDoParen(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void qDoParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
CELL index, limit;
|
||||
#if FICL_ROBUST > 1
|
||||
@ -1722,11 +1769,8 @@ static void plusLoopCoIm(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void loopParen(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void loopParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
FICL_INT index = stackGetTop(pVM->rStack).i;
|
||||
FICL_INT limit = stackFetch(pVM->rStack, 1).i;
|
||||
@ -1747,11 +1791,8 @@ static void loopParen(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef FICL_TRACE
|
||||
void plusLoopParen(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void plusLoopParen(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
FICL_INT index = stackGetTop(pVM->rStack).i;
|
||||
FICL_INT limit = stackFetch(pVM->rStack, 1).i;
|
||||
@ -2057,11 +2098,8 @@ static void compileOnly(FICL_VM *pVM)
|
||||
** and count on the stack. Finally, update ip to point to the first
|
||||
** aligned address after the string text.
|
||||
**************************************************************************/
|
||||
#ifdef FICL_TRACE
|
||||
void stringLit(FICL_VM *pVM)
|
||||
#else
|
||||
|
||||
static void stringLit(FICL_VM *pVM)
|
||||
#endif
|
||||
{
|
||||
FICL_STRING *sp = (FICL_STRING *)(pVM->ip);
|
||||
FICL_COUNT count = sp->count;
|
||||
@ -2092,8 +2130,6 @@ static void dotParen(FICL_VM *pVM)
|
||||
char *pDest = pVM->pad;
|
||||
char ch;
|
||||
|
||||
pSrc = skipSpace(pSrc, pEnd);
|
||||
|
||||
for (ch = *pSrc; (pEnd != pSrc) && (ch != ')'); ch = *++pSrc)
|
||||
*pDest++ = ch;
|
||||
|
||||
@ -2597,6 +2633,19 @@ static void repeatCoIm(FICL_VM *pVM)
|
||||
}
|
||||
|
||||
|
||||
static void againCoIm(FICL_VM *pVM)
|
||||
{
|
||||
FICL_DICT *dp = ficlGetDict();
|
||||
|
||||
assert(pBranchParen);
|
||||
dictAppendCell(dp, LVALUEtoCELL(pBranchParen));
|
||||
|
||||
/* expect "begin" branch marker */
|
||||
resolveBackBranch(dp, pVM, destTag);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
c h a r & f r i e n d s
|
||||
** 6.1.0895 CHAR CORE ( "<spaces>name" -- char )
|
||||
@ -2723,7 +2772,7 @@ static void environmentQ(FICL_VM *pVM)
|
||||
** EVALUATE CORE ( i*x c-addr u -- j*x )
|
||||
** Save the current input source specification. Store minus-one (-1) in
|
||||
** SOURCE-ID if it is present. Make the string described by c-addr and u
|
||||
** both the input source andinput buffer, set >IN to zero, and interpret.
|
||||
** both the input source and input buffer, set >IN to zero, and interpret.
|
||||
** When the parse area is empty, restore the prior input source
|
||||
** specification. Other stack effects are due to the words EVALUATEd.
|
||||
**
|
||||
@ -2775,6 +2824,7 @@ static void stringQuoteIm(FICL_VM *pVM)
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
t y p e
|
||||
** Pop count and char address from stack and print the designated string.
|
||||
@ -2822,7 +2872,7 @@ static void ficlWord(FICL_VM *pVM)
|
||||
char delim = (char)stackPopINT(pVM->pStack);
|
||||
STRINGINFO si;
|
||||
|
||||
si = vmParseString(pVM, delim);
|
||||
si = vmParseStringEx(pVM, delim, 1);
|
||||
|
||||
if (SI_COUNT(si) > nPAD-1)
|
||||
SI_SETLEN(si, nPAD-1);
|
||||
@ -2863,27 +2913,12 @@ static void parseNoCopy(FICL_VM *pVM)
|
||||
**************************************************************************/
|
||||
static void parse(FICL_VM *pVM)
|
||||
{
|
||||
char *pSrc = vmGetInBuf(pVM);
|
||||
char *pEnd = vmGetInBufEnd(pVM);
|
||||
char *cp;
|
||||
FICL_UNS count;
|
||||
char delim = (char)stackPopINT(pVM->pStack);
|
||||
STRINGINFO si;
|
||||
char delim = (char)stackPopINT(pVM->pStack);
|
||||
|
||||
cp = pSrc; /* mark start of text */
|
||||
|
||||
while ((pSrc != pEnd) && (*pSrc != delim))
|
||||
{
|
||||
pSrc++; /* find next delimiter or end */
|
||||
}
|
||||
|
||||
count = pSrc - cp; /* set length of result */
|
||||
|
||||
if ((pSrc != pEnd) && (*pSrc == delim)) /* gobble trailing delimiter */
|
||||
pSrc++;
|
||||
|
||||
vmUpdateTib(pVM, pSrc);
|
||||
stackPushPtr(pVM->pStack, cp);
|
||||
stackPushUNS(pVM->pStack, count);
|
||||
si = vmParseStringEx(pVM, delim, 0);
|
||||
stackPushPtr(pVM->pStack, SI_PTR(si));
|
||||
stackPushUNS(pVM->pStack, SI_COUNT(si));
|
||||
return;
|
||||
}
|
||||
|
||||
@ -2942,6 +2977,7 @@ static void find(FICL_VM *pVM)
|
||||
}
|
||||
|
||||
|
||||
|
||||
/**************************************************************************
|
||||
f m S l a s h M o d
|
||||
** f-m-slash-mod CORE ( d1 n1 -- n2 n3 )
|
||||
@ -3189,8 +3225,7 @@ static void sToD(FICL_VM *pVM)
|
||||
** input buffer.
|
||||
**************************************************************************/
|
||||
static void source(FICL_VM *pVM)
|
||||
{ int i;
|
||||
|
||||
{
|
||||
stackPushPtr(pVM->pStack, pVM->tib.cp);
|
||||
stackPushINT(pVM->pStack, vmGetInBufLen(pVM));
|
||||
return;
|
||||
@ -3555,16 +3590,22 @@ static void toValue(FICL_VM *pVM)
|
||||
FICL_WORD *pFW;
|
||||
|
||||
#if FICL_WANT_LOCALS
|
||||
FICL_DICT *pLoc = ficlGetLoc();
|
||||
if ((nLocals > 0) && (pVM->state == COMPILE))
|
||||
{
|
||||
FICL_DICT *pLoc = ficlGetLoc();
|
||||
pFW = dictLookup(pLoc, si);
|
||||
if (pFW)
|
||||
if (pFW && (pFW->code == doLocalIm))
|
||||
{
|
||||
dictAppendCell(dp, LVALUEtoCELL(pToLocalParen));
|
||||
dictAppendCell(dp, LVALUEtoCELL(pFW->param[0]));
|
||||
return;
|
||||
}
|
||||
else if (pFW && pFW->code == do2LocalIm)
|
||||
{
|
||||
dictAppendCell(dp, LVALUEtoCELL(pTo2LocalParen));
|
||||
dictAppendCell(dp, LVALUEtoCELL(pFW->param[0]));
|
||||
return;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
@ -3726,14 +3767,13 @@ static void doLocalIm(FICL_VM *pVM)
|
||||
**************************************************************************/
|
||||
static void localParen(FICL_VM *pVM)
|
||||
{
|
||||
static CELL *pMark = NULL;
|
||||
FICL_DICT *pDict = ficlGetDict();
|
||||
STRINGINFO si;
|
||||
SI_SETLEN(si, stackPopUNS(pVM->pStack));
|
||||
SI_SETPTR(si, (char *)stackPopPtr(pVM->pStack));
|
||||
|
||||
if (SI_COUNT(si) > 0)
|
||||
{ /* add a local to the dict and update nLocals */
|
||||
{ /* add a local to the **locals** dict and update nLocals */
|
||||
FICL_DICT *pLoc = ficlGetLoc();
|
||||
if (nLocals >= FICL_MAX_LOCALS)
|
||||
{
|
||||
@ -3747,7 +3787,7 @@ static void localParen(FICL_VM *pVM)
|
||||
{ /* compile code to create a local stack frame */
|
||||
dictAppendCell(pDict, LVALUEtoCELL(pLinkParen));
|
||||
/* save location in dictionary for #locals */
|
||||
pMark = pDict->here;
|
||||
pMarkLocals = pDict->here;
|
||||
dictAppendCell(pDict, LVALUEtoCELL(nLocals));
|
||||
/* compile code to initialize first local */
|
||||
dictAppendCell(pDict, LVALUEtoCELL(pToLocal0));
|
||||
@ -3766,7 +3806,84 @@ static void localParen(FICL_VM *pVM)
|
||||
}
|
||||
else if (nLocals > 0)
|
||||
{ /* write nLocals to (link) param area in dictionary */
|
||||
*(FICL_INT *)pMark = nLocals;
|
||||
*(FICL_INT *)pMarkLocals = nLocals;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static void get2LocalParen(FICL_VM *pVM)
|
||||
{
|
||||
FICL_INT nLocal = *(FICL_INT *)(pVM->ip++);
|
||||
stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal]);
|
||||
stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal+1]);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static void do2LocalIm(FICL_VM *pVM)
|
||||
{
|
||||
FICL_DICT *pDict = ficlGetDict();
|
||||
int nLocal = pVM->runningWord->param[0].i;
|
||||
|
||||
if (pVM->state == INTERPRET)
|
||||
{
|
||||
stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal]);
|
||||
stackPush(pVM->pStack, pVM->rStack->pFrame[nLocal+1]);
|
||||
}
|
||||
else
|
||||
{
|
||||
dictAppendCell(pDict, LVALUEtoCELL(pGet2LocalParen));
|
||||
dictAppendCell(pDict, LVALUEtoCELL(nLocal));
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static void to2LocalParen(FICL_VM *pVM)
|
||||
{
|
||||
FICL_INT nLocal = *(FICL_INT *)(pVM->ip++);
|
||||
pVM->rStack->pFrame[nLocal+1] = stackPop(pVM->pStack);
|
||||
pVM->rStack->pFrame[nLocal] = stackPop(pVM->pStack);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static void twoLocalParen(FICL_VM *pVM)
|
||||
{
|
||||
FICL_DICT *pDict = ficlGetDict();
|
||||
STRINGINFO si;
|
||||
SI_SETLEN(si, stackPopUNS(pVM->pStack));
|
||||
SI_SETPTR(si, (char *)stackPopPtr(pVM->pStack));
|
||||
|
||||
if (SI_COUNT(si) > 0)
|
||||
{ /* add a local to the **locals** dict and update nLocals */
|
||||
FICL_DICT *pLoc = ficlGetLoc();
|
||||
if (nLocals >= FICL_MAX_LOCALS)
|
||||
{
|
||||
vmThrowErr(pVM, "Error: out of local space");
|
||||
}
|
||||
|
||||
dictAppendWord2(pLoc, si, do2LocalIm, FW_COMPIMMED);
|
||||
dictAppendCell(pLoc, LVALUEtoCELL(nLocals));
|
||||
|
||||
if (nLocals == 0)
|
||||
{ /* compile code to create a local stack frame */
|
||||
dictAppendCell(pDict, LVALUEtoCELL(pLinkParen));
|
||||
/* save location in dictionary for #locals */
|
||||
pMarkLocals = pDict->here;
|
||||
dictAppendCell(pDict, LVALUEtoCELL(nLocals));
|
||||
}
|
||||
|
||||
dictAppendCell(pDict, LVALUEtoCELL(pTo2LocalParen));
|
||||
dictAppendCell(pDict, LVALUEtoCELL(nLocals));
|
||||
|
||||
nLocals += 2;
|
||||
}
|
||||
else if (nLocals > 0)
|
||||
{ /* write nLocals to (link) param area in dictionary */
|
||||
*(FICL_INT *)pMarkLocals = nLocals;
|
||||
}
|
||||
|
||||
return;
|
||||
@ -3813,11 +3930,7 @@ static void setParentWid(FICL_VM *pVM)
|
||||
** like it's in the dictionary address range.
|
||||
** NOTE: this excludes :noname words!
|
||||
*/
|
||||
#ifdef FICL_TRACE
|
||||
int isAFiclWord(FICL_WORD *pFW)
|
||||
#else
|
||||
static int isAFiclWord(FICL_WORD *pFW)
|
||||
#endif
|
||||
{
|
||||
FICL_DICT *pd = ficlGetDict();
|
||||
|
||||
@ -4262,20 +4375,27 @@ static void fkey(FICL_VM *pVM)
|
||||
**
|
||||
** More comments can be found throughout catch's code.
|
||||
**
|
||||
** BUGS: do not handle locals unnesting correctly... I think...
|
||||
**
|
||||
** Daniel C. Sobral Jan 09/1999
|
||||
** sadler may 2000 -- revised to follow ficl.c:ficlExecXT.
|
||||
**************************************************************************/
|
||||
|
||||
static void ficlCatch(FICL_VM *pVM)
|
||||
{
|
||||
int except;
|
||||
static FICL_WORD *pQuit = NULL;
|
||||
|
||||
int except;
|
||||
jmp_buf vmState;
|
||||
FICL_VM VM;
|
||||
FICL_STACK pStack;
|
||||
FICL_STACK rStack;
|
||||
FICL_WORD *pFW;
|
||||
IPTYPE exitIP;
|
||||
|
||||
if (!pQuit)
|
||||
pQuit = ficlLookup("exit-inner");
|
||||
|
||||
assert(pVM);
|
||||
assert(pQuit);
|
||||
|
||||
|
||||
/*
|
||||
** Get xt.
|
||||
@ -4313,63 +4433,42 @@ static void ficlCatch(FICL_VM *pVM)
|
||||
*/
|
||||
except = setjmp(vmState);
|
||||
|
||||
/*
|
||||
** And now, choose what to do depending on except.
|
||||
*/
|
||||
switch (except)
|
||||
{
|
||||
/*
|
||||
** Setup condition - push poison pill so that the VM throws
|
||||
** VM_INNEREXIT if the XT terminates normally, then execute
|
||||
** the XT
|
||||
*/
|
||||
case 0:
|
||||
vmPushIP(pVM, &pQuit); /* Open mouth, insert emetic */
|
||||
vmExecute(pVM, pFW);
|
||||
vmInnerLoop(pVM);
|
||||
break;
|
||||
|
||||
/* Things having gone wrong... */
|
||||
if(except)
|
||||
{
|
||||
/*
|
||||
** Normal exit from XT - lose the poison pill,
|
||||
** restore old setjmp vector and push a zero.
|
||||
*/
|
||||
case VM_INNEREXIT:
|
||||
vmPopIP(pVM); /* Gack - hurl poison pill */
|
||||
pVM->pState = VM.pState; /* Restore just the setjmp vector */
|
||||
stackPushINT(pVM->pStack, 0); /* Push 0 -- everything is ok */
|
||||
break;
|
||||
|
||||
/*
|
||||
** Some other exception got thrown - restore pre-existing VM state
|
||||
** and push the exception code
|
||||
*/
|
||||
default:
|
||||
/* Restore vm's state */
|
||||
memcpy((void*)pVM, (void*)&VM, sizeof(FICL_VM));
|
||||
memcpy((void*)pVM->pStack, (void*)&pStack, sizeof(FICL_STACK));
|
||||
memcpy((void*)pVM->rStack, (void*)&rStack, sizeof(FICL_STACK));
|
||||
|
||||
/* Push error */
|
||||
stackPushINT(pVM->pStack, except);
|
||||
|
||||
}
|
||||
else /* Things being ok... */
|
||||
{
|
||||
/*
|
||||
* We need to know when to exit the inner loop
|
||||
* Colonp, the "code" for colon words, just pushes
|
||||
* the word's IP onto the RP, and expect the inner
|
||||
* interpreter to do the rest. Well, I'd rather have
|
||||
* it done *before* I return from this function,
|
||||
* losing the automatic variables I'm using to save
|
||||
* state. Sure, I could save this on dynamic memory
|
||||
* and save state on RP, or I could even implement
|
||||
* the poor man's version of this word in Forth with
|
||||
* sp@, sp!, rp@ and rp!, but we have a lot of state
|
||||
* neatly tucked away in pVM, so why not save it?
|
||||
*/
|
||||
exitIP = pVM->ip;
|
||||
|
||||
/* Execute the xt -- inline code for vmExecute */
|
||||
|
||||
pVM->runningWord = pFW;
|
||||
pFW->code(pVM);
|
||||
|
||||
/*
|
||||
** Run the inner loop until we get back to exitIP
|
||||
*/
|
||||
for (; pVM->ip != exitIP;)
|
||||
{
|
||||
pFW = *pVM->ip++;
|
||||
|
||||
/* Inline code for vmExecute */
|
||||
pVM->runningWord = pFW;
|
||||
pFW->code(pVM);
|
||||
}
|
||||
|
||||
|
||||
/* Restore just the setjmp vector */
|
||||
pVM->pState = VM.pState;
|
||||
|
||||
/* Push 0 -- everything is ok */
|
||||
stackPushINT(pVM->pStack, 0);
|
||||
}
|
||||
stackPushINT(pVM->pStack, except);/* Push error */
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@ -4393,8 +4492,6 @@ static void ficlThrow(FICL_VM *pVM)
|
||||
}
|
||||
|
||||
|
||||
/*************** freebsd added memory-alloc handling words ******************/
|
||||
|
||||
static void ansAllocate(FICL_VM *pVM)
|
||||
{
|
||||
size_t size;
|
||||
@ -4652,6 +4749,7 @@ void ficlCompileCore(FICL_DICT *dp)
|
||||
dictAppendWord(dp, ".(", dotParen, FW_DEFAULT);
|
||||
dictAppendWord(dp, ":noname", colonNoName, FW_DEFAULT);
|
||||
dictAppendWord(dp, "?do", qDoCoIm, FW_COMPIMMED);
|
||||
dictAppendWord(dp, "again", againCoIm, FW_COMPIMMED);
|
||||
dictAppendWord(dp, "parse", parse, FW_DEFAULT);
|
||||
dictAppendWord(dp, "pick", pick, FW_DEFAULT);
|
||||
dictAppendWord(dp, "roll", roll, FW_DEFAULT);
|
||||
@ -4710,6 +4808,14 @@ void ficlCompileCore(FICL_DICT *dp)
|
||||
ficlSetEnv("return-stack-cells",FICL_DEFAULT_STACK);
|
||||
ficlSetEnv("stack-cells", FICL_DEFAULT_STACK);
|
||||
|
||||
/*
|
||||
** DOUBLE word set (partial)
|
||||
*/
|
||||
dictAppendWord(dp, "2constant", twoConstant, FW_IMMEDIATE);
|
||||
dictAppendWord(dp, "2literal", twoLiteralIm, FW_IMMEDIATE);
|
||||
dictAppendWord(dp, "dnegate", dnegate, FW_DEFAULT);
|
||||
|
||||
|
||||
/*
|
||||
** EXCEPTION word set
|
||||
*/
|
||||
@ -4743,6 +4849,12 @@ void ficlCompileCore(FICL_DICT *dp)
|
||||
dictAppendWord(dp, "(toLocal1)",toLocal1, FW_COMPILE);
|
||||
dictAppendWord(dp, "(local)", localParen, FW_COMPILE);
|
||||
|
||||
pGet2LocalParen =
|
||||
dictAppendWord(dp, "(@2local)", get2LocalParen, FW_COMPILE);
|
||||
pTo2LocalParen =
|
||||
dictAppendWord(dp, "(to2Local)",to2LocalParen, FW_COMPILE);
|
||||
dictAppendWord(dp, "(2local)", twoLocalParen, FW_COMPILE);
|
||||
|
||||
ficlSetEnv("locals", FICL_TRUE);
|
||||
ficlSetEnv("locals-ext", FICL_TRUE);
|
||||
ficlSetEnv("#locals", FICL_MAX_LOCALS);
|
||||
@ -4806,15 +4918,15 @@ void ficlCompileCore(FICL_DICT *dp)
|
||||
dictAppendWord(dp, ".env", listEnv, FW_DEFAULT);
|
||||
dictAppendWord(dp, ".ver", ficlVersion, FW_DEFAULT);
|
||||
dictAppendWord(dp, "-roll", minusRoll, FW_DEFAULT);
|
||||
dictAppendWord(dp, "2constant", twoConstant, FW_IMMEDIATE); /* DOUBLE */
|
||||
dictAppendWord(dp, ">name", toName, FW_DEFAULT);
|
||||
dictAppendWord(dp, "body>", fromBody, FW_DEFAULT);
|
||||
dictAppendWord(dp, "compare", compareString, FW_DEFAULT); /* STRING */
|
||||
dictAppendWord(dp, "compile-only",
|
||||
compileOnly, FW_DEFAULT);
|
||||
dictAppendWord(dp, "dnegate", dnegate, FW_DEFAULT); /* DOUBLE */
|
||||
dictAppendWord(dp, "endif", endifCoIm, FW_COMPIMMED);
|
||||
dictAppendWord(dp, "forget-wid",forgetWid, FW_DEFAULT);
|
||||
dictAppendWord(dp, "hash", hash, FW_DEFAULT);
|
||||
dictAppendWord(dp, "number?", ficlIsNum, FW_DEFAULT);
|
||||
dictAppendWord(dp, "parse-word",parseNoCopy, FW_DEFAULT);
|
||||
dictAppendWord(dp, "sliteral", sLiteralCoIm, FW_COMPIMMED); /* STRING */
|
||||
dictAppendWord(dp, "wid-set-super",
|
||||
@ -4835,6 +4947,8 @@ void ficlCompileCore(FICL_DICT *dp)
|
||||
dictAppendWord(dp, "(;)", semiParen, FW_COMPILE);
|
||||
pLitParen =
|
||||
dictAppendWord(dp, "(literal)", literalParen, FW_COMPILE);
|
||||
pTwoLitParen =
|
||||
dictAppendWord(dp, "(2literal)",twoLitParen, FW_COMPILE);
|
||||
pStringLit =
|
||||
dictAppendWord(dp, "(.\")", stringLit, FW_COMPILE);
|
||||
pIfParen =
|
||||
|
Loading…
Reference in New Issue
Block a user