1 /*******************************************************************
3 ** Forth Inspired Command Language - virtual machine methods
4 ** Author: John Sadler (john_sadler@alum.mit.edu)
5 ** Created: 19 July 1997
7 *******************************************************************/
9 ** This file implements the virtual machine of FICL. Each virtual
10 ** machine retains the state of an interpreter. A virtual machine
11 ** owns a pair of stacks for parameters and return addresses, as
12 ** well as a pile of state variables and the two dedicated registers
16 /* $FreeBSD: src/sys/boot/ficl/vm.c,v 1.5.2.1 2000/07/06 23:51:45 obrien Exp $ */
17 /* $DragonFly: src/sys/boot/ficl/vm.c,v 1.2 2003/06/17 04:28:17 dillon Exp $ */
30 static char digits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
33 /**************************************************************************
34 v m B r a n c h R e l a t i v e
36 **************************************************************************/
37 void vmBranchRelative(FICL_VM *pVM, int offset)
44 /**************************************************************************
47 **************************************************************************/
48 FICL_VM *vmCreate(FICL_VM *pVM, unsigned nPStack, unsigned nRStack)
52 pVM = (FICL_VM *)ficlMalloc(sizeof (FICL_VM));
54 memset(pVM, 0, sizeof (FICL_VM));
58 stackDelete(pVM->pStack);
59 pVM->pStack = stackCreate(nPStack);
62 stackDelete(pVM->rStack);
63 pVM->rStack = stackCreate(nRStack);
65 pVM->textOut = ficlTextOut;
72 /**************************************************************************
75 **************************************************************************/
76 void vmDelete (FICL_VM *pVM)
80 ficlFree(pVM->pStack);
81 ficlFree(pVM->rStack);
89 /**************************************************************************
91 ** Sets up the specified word to be run by the inner interpreter.
92 ** Executes the word's code part immediately, but in the case of
93 ** colon definition, the definition itself needs the inner interp
94 ** to complete. This does not happen until control reaches ficlExec
95 **************************************************************************/
96 void vmExecute(FICL_VM *pVM, FICL_WORD *pWord)
98 pVM->runningWord = pWord;
104 /**************************************************************************
105 v m I n n e r L o o p
106 ** the mysterious inner interpreter...
107 ** This loop is the address interpreter that makes colon definitions
108 ** work. Upon entry, it assumes that the IP points to an entry in
109 ** a definition (the body of a colon word). It runs one word at a time
110 ** until something does vmThrow. The catcher for this is expected to exist
111 ** in the calling code.
112 ** vmThrow gets you out of this loop with a longjmp()
113 ** Visual C++ 5 chokes on this loop in Release mode. Aargh.
114 **************************************************************************/
115 #if INLINE_INNER_LOOP == 0
116 void vmInnerLoop(FICL_VM *pVM)
123 /**************************************************************************
124 v m G e t S t r i n g
125 ** Parses a string out of the VM input buffer and copies up to the first
126 ** FICL_STRING_MAX characters to the supplied destination buffer, a
127 ** FICL_STRING. The destination string is NULL terminated.
129 ** Returns the address of the first unused character in the dest buffer.
130 **************************************************************************/
131 char *vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter)
133 STRINGINFO si = vmParseStringEx(pVM, delimiter, 0);
135 if (SI_COUNT(si) > FICL_STRING_MAX)
137 SI_SETLEN(si, FICL_STRING_MAX);
140 strncpy(spDest->text, SI_PTR(si), SI_COUNT(si));
141 spDest->text[SI_COUNT(si)] = '\0';
142 spDest->count = (FICL_COUNT)SI_COUNT(si);
144 return spDest->text + SI_COUNT(si) + 1;
148 /**************************************************************************
150 ** vmGetWord calls vmGetWord0 repeatedly until it gets a string with
152 **************************************************************************/
153 STRINGINFO vmGetWord(FICL_VM *pVM)
155 STRINGINFO si = vmGetWord0(pVM);
157 if (SI_COUNT(si) == 0)
159 vmThrow(pVM, VM_RESTART);
166 /**************************************************************************
168 ** Skip leading whitespace and parse a space delimited word from the tib.
169 ** Returns the start address and length of the word. Updates the tib
170 ** to reflect characters consumed, including the trailing delimiter.
171 ** If there's nothing of interest in the tib, returns zero. This function
172 ** does not use vmParseString because it uses isspace() rather than a
173 ** single delimiter character.
174 **************************************************************************/
175 STRINGINFO vmGetWord0(FICL_VM *pVM)
177 char *pSrc = vmGetInBuf(pVM);
178 char *pEnd = vmGetInBufEnd(pVM);
183 pSrc = skipSpace(pSrc, pEnd);
186 for (ch = *pSrc; (pEnd != pSrc) && !isspace(ch); ch = *++pSrc)
191 SI_SETLEN(si, count);
193 if ((pEnd != pSrc) && isspace(ch)) /* skip one trailing delimiter */
196 vmUpdateTib(pVM, pSrc);
202 /**************************************************************************
203 v m G e t W o r d T o P a d
204 ** Does vmGetWord0 and copies the result to the pad as a NULL terminated
205 ** string. Returns the length of the string. If the string is too long
206 ** to fit in the pad, it is truncated.
207 **************************************************************************/
208 int vmGetWordToPad(FICL_VM *pVM)
211 char *cp = (char *)pVM->pad;
212 si = vmGetWord0(pVM);
214 if (SI_COUNT(si) > nPAD)
217 strncpy(cp, SI_PTR(si), SI_COUNT(si));
218 cp[SI_COUNT(si)] = '\0';
219 return (int)(SI_COUNT(si));
223 /**************************************************************************
224 v m P a r s e S t r i n g
225 ** Parses a string out of the input buffer using the delimiter
226 ** specified. Skips leading delimiters, marks the start of the string,
227 ** and counts characters to the next delimiter it encounters. It then
228 ** updates the vm input buffer to consume all these chars, including the
229 ** trailing delimiter.
230 ** Returns the address and length of the parsed string, not including the
231 ** trailing delimiter.
232 **************************************************************************/
233 STRINGINFO vmParseString(FICL_VM *pVM, char delim)
235 return vmParseStringEx(pVM, delim, 1);
238 STRINGINFO vmParseStringEx(FICL_VM *pVM, char delim, char fSkipLeading)
241 char *pSrc = vmGetInBuf(pVM);
242 char *pEnd = vmGetInBufEnd(pVM);
246 { /* skip lead delimiters */
247 while ((pSrc != pEnd) && (*pSrc == delim))
251 SI_SETPTR(si, pSrc); /* mark start of text */
253 for (ch = *pSrc; (pSrc != pEnd)
256 && (ch != '\n'); ch = *++pSrc)
258 ; /* find next delimiter or end of line */
261 /* set length of result */
262 SI_SETLEN(si, pSrc - SI_PTR(si));
264 if ((pSrc != pEnd) && (*pSrc == delim)) /* gobble trailing delimiter */
267 vmUpdateTib(pVM, pSrc);
272 /**************************************************************************
275 **************************************************************************/
276 CELL vmPop(FICL_VM *pVM)
278 return stackPop(pVM->pStack);
282 /**************************************************************************
285 **************************************************************************/
286 void vmPush(FICL_VM *pVM, CELL c)
288 stackPush(pVM->pStack, c);
293 /**************************************************************************
296 **************************************************************************/
297 void vmPopIP(FICL_VM *pVM)
299 pVM->ip = (IPTYPE)(stackPopPtr(pVM->rStack));
304 /**************************************************************************
307 **************************************************************************/
308 void vmPushIP(FICL_VM *pVM, IPTYPE newIP)
310 stackPushPtr(pVM->rStack, (void *)pVM->ip);
316 /**************************************************************************
318 ** Binds the specified input string to the VM and clears >IN (the index)
319 **************************************************************************/
320 void vmPushTib(FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib)
324 *pSaveTib = pVM->tib;
328 pVM->tib.end = text + nChars;
333 void vmPopTib(FICL_VM *pVM, TIB *pTib)
343 /**************************************************************************
346 **************************************************************************/
347 void vmQuit(FICL_VM *pVM)
349 static FICL_WORD *pInterp = NULL;
351 pInterp = ficlLookup("interpret");
354 stackReset(pVM->rStack);
357 pVM->runningWord = pInterp;
358 pVM->state = INTERPRET;
368 /**************************************************************************
371 **************************************************************************/
372 void vmReset(FICL_VM *pVM)
375 stackReset(pVM->pStack);
381 /**************************************************************************
382 v m S e t T e x t O u t
383 ** Binds the specified output callback to the vm. If you pass NULL,
384 ** binds the default output function (ficlTextOut)
385 **************************************************************************/
386 void vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut)
389 pVM->textOut = textOut;
391 pVM->textOut = ficlTextOut;
397 /**************************************************************************
399 ** Single step the vm - equivalent to "step into" - used for debugging
400 **************************************************************************/
401 #if FICL_WANT_DEBUGGER
402 void vmStep(FICL_VM *pVM)
409 /**************************************************************************
411 ** Feeds text to the vm's output callback
412 **************************************************************************/
413 void vmTextOut(FICL_VM *pVM, char *text, int fNewline)
416 assert(pVM->textOut);
417 (pVM->textOut)(pVM, text, fNewline);
423 /**************************************************************************
426 **************************************************************************/
427 void vmThrow(FICL_VM *pVM, int except)
430 longjmp(*(pVM->pState), except);
434 void vmThrowErr(FICL_VM *pVM, char *fmt, ...)
438 vsprintf(pVM->pad, fmt, va);
439 vmTextOut(pVM, pVM->pad, 1);
441 longjmp(*(pVM->pState), VM_ERREXIT);
445 /**************************************************************************
446 w o r d I s I m m e d i a t e
448 **************************************************************************/
449 int wordIsImmediate(FICL_WORD *pFW)
451 return ((pFW != NULL) && (pFW->flags & FW_IMMEDIATE));
455 /**************************************************************************
456 w o r d I s C o m p i l e O n l y
458 **************************************************************************/
459 int wordIsCompileOnly(FICL_WORD *pFW)
461 return ((pFW != NULL) && (pFW->flags & FW_COMPILE));
465 /**************************************************************************
468 **************************************************************************/
469 char *strrev( char *string )
470 { /* reverse a string in-place */
471 int i = strlen(string);
472 char *p1 = string; /* first char of string */
473 char *p2 = string + i - 1; /* last non-NULL char of string */
491 /**************************************************************************
492 d i g i t _ t o _ c h a r
494 **************************************************************************/
495 char digit_to_char(int value)
497 return digits[value];
501 /**************************************************************************
502 i s P o w e r O f T w o
503 ** Tests whether supplied argument is an integer power of 2 (2**n)
504 ** where 32 > n > 1, and returns n if so. Otherwise returns zero.
505 **************************************************************************/
506 int isPowerOfTwo(FICL_UNS u)
511 for (; ((t <= u) && (t != 0)); i++, t <<= 1)
521 /**************************************************************************
524 **************************************************************************/
525 char *ltoa( FICL_INT value, char *string, int radix )
526 { /* convert long to string, any base */
528 int sign = ((radix == 10) && (value < 0));
535 pwr = isPowerOfTwo((FICL_UNS)radix);
544 FICL_UNS v = (FICL_UNS) value;
545 FICL_UNS mask = (FICL_UNS) ~(-1 << pwr);
548 *cp++ = digits[v & mask];
557 v.lo = (FICL_UNS)value;
560 result = ficlLongDiv(v, (FICL_UNS)radix);
561 *cp++ = digits[result.rem];
571 return strrev(string);
575 /**************************************************************************
578 **************************************************************************/
579 char *ultoa(FICL_UNS value, char *string, int radix )
580 { /* convert long to string, any base */
599 result = ficlLongDiv(ud, (FICL_UNS)radix);
601 *cp++ = digits[result.rem];
607 return strrev(string);
611 /**************************************************************************
613 ** Case folds a NULL terminated string in place. All characters
614 ** get converted to lower case.
615 **************************************************************************/
616 char *caseFold(char *cp)
623 *cp = (char)tolower(*cp);
631 /**************************************************************************
634 **************************************************************************/
635 int strincmp(char *cp1, char *cp2, FICL_COUNT count)
640 for (c1 = *cp1, c2 = *cp2;
641 ((i == 0) && count && c1 && c2);
642 c1 = *++cp1, c2 = *++cp2, count--)
644 i = tolower(c1) - tolower(c2);
652 /**************************************************************************
654 ** Given a string pointer, returns a pointer to the first non-space
655 ** char of the string, or to the NULL terminator if no such char found.
656 ** If the pointer reaches "end" first, stop there. Pass NULL to
657 ** suppress this behavior.
658 **************************************************************************/
659 char *skipSpace(char *cp, char *end)
663 while ((cp != end) && isspace(*cp))