sys/boot/ficl/vm.c

   1 /*******************************************************************
   2 ** v m . c
   3 ** Forth Inspired Command Language - virtual machine methods
   4 ** Author: John Sadler (john_sadler@alum.mit.edu)
   5 ** Created: 19 July 1997
   6 **
   7 *******************************************************************/
   8 /*
   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
  13 ** of the interp.
  14 */
  15
  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 $ */
  18
  19 #ifdef TESTMAIN
  20 #include <stdlib.h>
  21 #include <stdio.h>
  22 #include <ctype.h>
  23 #else
  24 #include <stand.h>
  25 #endif
  26 #include <stdarg.h>
  27 #include <string.h>
  28 #include "ficl.h"
  29
  30 static char digits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  31
  32
  33 /**************************************************************************
  34                         v m B r a n c h R e l a t i v e
  35 **
  36 **************************************************************************/
  37 void vmBranchRelative(FICL_VM *pVM, int offset)
  38 {
  39     pVM->ip += offset;
  40     return;
  41 }
  42
  43
  44 /**************************************************************************
  45                         v m C r e a t e
  46 **
  47 **************************************************************************/
  48 FICL_VM *vmCreate(FICL_VM *pVM, unsigned nPStack, unsigned nRStack)
  49 {
  50     if (pVM == NULL)
  51     {
  52         pVM = (FICL_VM *)ficlMalloc(sizeof (FICL_VM));
  53         assert (pVM);
  54         memset(pVM, 0, sizeof (FICL_VM));
  55     }
  56
  57     if (pVM->pStack)
  58         stackDelete(pVM->pStack);
  59     pVM->pStack = stackCreate(nPStack);
  60
  61     if (pVM->rStack)
  62         stackDelete(pVM->rStack);
  63     pVM->rStack = stackCreate(nRStack);
  64
  65     pVM->textOut = ficlTextOut;
  66
  67     vmReset(pVM);
  68     return pVM;
  69 }
  70
  71
  72 /**************************************************************************
  73                         v m D e l e t e
  74 **
  75 **************************************************************************/
  76 void vmDelete (FICL_VM *pVM)
  77 {
  78     if (pVM)
  79     {
  80         ficlFree(pVM->pStack);
  81         ficlFree(pVM->rStack);
  82         ficlFree(pVM);
  83     }
  84
  85     return;
  86 }
  87
  88
  89 /**************************************************************************
  90                         v m E x e c u t e
  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)
  97 {
  98     pVM->runningWord = pWord;
  99     pWord->code(pVM);
 100     return;
 101 }
 102
 103
 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)
 117 {
 118     M_INNER_LOOP(pVM);
 119 }
 120 #endif
 121
 122
 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.
 128 **
 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)
 132 {
 133     STRINGINFO si = vmParseStringEx(pVM, delimiter, 0);
 134
 135     if (SI_COUNT(si) > FICL_STRING_MAX)
 136     {
 137         SI_SETLEN(si, FICL_STRING_MAX);
 138     }
 139
 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);
 143
 144     return spDest->text + SI_COUNT(si) + 1;
 145 }
 146
 147
 148 /**************************************************************************
 149                         v m G e t W o r d
 150 ** vmGetWord calls vmGetWord0 repeatedly until it gets a string with
 151 ** non-zero length.
 152 **************************************************************************/
 153 STRINGINFO vmGetWord(FICL_VM *pVM)
 154 {
 155     STRINGINFO si = vmGetWord0(pVM);
 156
 157     if (SI_COUNT(si) == 0)
 158     {
 159         vmThrow(pVM, VM_RESTART);
 160     }
 161
 162     return si;
 163 }
 164
 165
 166 /**************************************************************************
 167                         v m G e t W o r d 0
 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)
 176 {
 177     char *pSrc      = vmGetInBuf(pVM);
 178     char *pEnd      = vmGetInBufEnd(pVM);
 179     STRINGINFO si;
 180     FICL_UNS count = 0;
 181     char ch;
 182
 183     pSrc = skipSpace(pSrc, pEnd);
 184     SI_SETPTR(si, pSrc);
 185
 186     for (ch = *pSrc; (pEnd != pSrc) && !isspace(ch); ch = *++pSrc)
 187     {
 188         count++;
 189     }
 190
 191     SI_SETLEN(si, count);
 192
 193     if ((pEnd != pSrc) && isspace(ch))    /* skip one trailing delimiter */
 194         pSrc++;
 195
 196     vmUpdateTib(pVM, pSrc);
 197
 198     return si;
 199 }
 200
 201
 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)
 209 {
 210     STRINGINFO si;
 211     char *cp = (char *)pVM->pad;
 212     si = vmGetWord0(pVM);
 213
 214     if (SI_COUNT(si) > nPAD)
 215         SI_SETLEN(si, nPAD);
 216
 217     strncpy(cp, SI_PTR(si), SI_COUNT(si));
 218     cp[SI_COUNT(si)] = '\0';
 219     return (int)(SI_COUNT(si));
 220 }
 221
 222
 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)
 234 {
 235         return vmParseStringEx(pVM, delim, 1);
 236 }
 237
 238 STRINGINFO vmParseStringEx(FICL_VM *pVM, char delim, char fSkipLeading)
 239 {
 240     STRINGINFO si;
 241     char *pSrc      = vmGetInBuf(pVM);
 242     char *pEnd      = vmGetInBufEnd(pVM);
 243     char ch;
 244
 245         if (fSkipLeading)
 246         {                       /* skip lead delimiters */
 247                 while ((pSrc != pEnd) && (*pSrc == delim))
 248                         pSrc++;
 249         }
 250
 251     SI_SETPTR(si, pSrc);    /* mark start of text */
 252
 253     for (ch = *pSrc; (pSrc != pEnd)
 254                   && (ch != delim)
 255                   && (ch != '\r')
 256                   && (ch != '\n'); ch = *++pSrc)
 257     {
 258         ;                   /* find next delimiter or end of line */
 259     }
 260
 261                             /* set length of result */
 262     SI_SETLEN(si, pSrc - SI_PTR(si));
 263
 264     if ((pSrc != pEnd) && (*pSrc == delim))     /* gobble trailing delimiter */
 265         pSrc++;
 266
 267     vmUpdateTib(pVM, pSrc);
 268     return si;
 269 }
 270
 271
 272 /**************************************************************************
 273                         v m P o p
 274 **
 275 **************************************************************************/
 276 CELL vmPop(FICL_VM *pVM)
 277 {
 278     return stackPop(pVM->pStack);
 279 }
 280
 281
 282 /**************************************************************************
 283                         v m P u s h
 284 **
 285 **************************************************************************/
 286 void vmPush(FICL_VM *pVM, CELL c)
 287 {
 288     stackPush(pVM->pStack, c);
 289     return;
 290 }
 291
 292
 293 /**************************************************************************
 294                         v m P o p I P
 295 **
 296 **************************************************************************/
 297 void vmPopIP(FICL_VM *pVM)
 298 {
 299     pVM->ip = (IPTYPE)(stackPopPtr(pVM->rStack));
 300     return;
 301 }
 302
 303
 304 /**************************************************************************
 305                         v m P u s h I P
 306 **
 307 **************************************************************************/
 308 void vmPushIP(FICL_VM *pVM, IPTYPE newIP)
 309 {
 310     stackPushPtr(pVM->rStack, (void *)pVM->ip);
 311     pVM->ip = newIP;
 312     return;
 313 }
 314
 315
 316 /**************************************************************************
 317                         v m P u s h T i b
 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)
 321 {
 322     if (pSaveTib)
 323     {
 324         *pSaveTib = pVM->tib;
 325     }
 326
 327     pVM->tib.cp = text;
 328     pVM->tib.end = text + nChars;
 329     pVM->tib.index = 0;
 330 }
 331
 332
 333 void vmPopTib(FICL_VM *pVM, TIB *pTib)
 334 {
 335     if (pTib)
 336     {
 337         pVM->tib = *pTib;
 338     }
 339     return;
 340 }
 341
 342
 343 /**************************************************************************
 344                         v m Q u i t
 345 **
 346 **************************************************************************/
 347 void vmQuit(FICL_VM *pVM)
 348 {
 349     static FICL_WORD *pInterp = NULL;
 350     if (!pInterp)
 351         pInterp = ficlLookup("interpret");
 352     assert(pInterp);
 353
 354     stackReset(pVM->rStack);
 355     pVM->fRestart    = 0;
 356     pVM->ip          = &pInterp;
 357     pVM->runningWord = pInterp;
 358     pVM->state       = INTERPRET;
 359     pVM->tib.cp      = NULL;
 360     pVM->tib.end     = NULL;
 361     pVM->tib.index   = 0;
 362     pVM->pad[0]      = '\0';
 363     pVM->sourceID.i  = 0;
 364     return;
 365 }
 366
 367
 368 /**************************************************************************
 369                         v m R e s e t
 370 **
 371 **************************************************************************/
 372 void vmReset(FICL_VM *pVM)
 373 {
 374     vmQuit(pVM);
 375     stackReset(pVM->pStack);
 376     pVM->base        = 10;
 377     return;
 378 }
 379
 380
 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)
 387 {
 388     if (textOut)
 389         pVM->textOut = textOut;
 390     else
 391         pVM->textOut = ficlTextOut;
 392
 393     return;
 394 }
 395
 396
 397 /**************************************************************************
 398                         v m S t e p
 399 ** Single step the vm - equivalent to "step into" - used for debugging
 400 **************************************************************************/
 401 #if FICL_WANT_DEBUGGER
 402 void vmStep(FICL_VM *pVM)
 403 {
 404         M_VM_STEP(pVM);
 405 }
 406 #endif
 407
 408
 409 /**************************************************************************
 410                         v m T e x t O u t
 411 ** Feeds text to the vm's output callback
 412 **************************************************************************/
 413 void vmTextOut(FICL_VM *pVM, char *text, int fNewline)
 414 {
 415     assert(pVM);
 416     assert(pVM->textOut);
 417     (pVM->textOut)(pVM, text, fNewline);
 418
 419     return;
 420 }
 421
 422
 423 /**************************************************************************
 424                         v m T h r o w
 425 **
 426 **************************************************************************/
 427 void vmThrow(FICL_VM *pVM, int except)
 428 {
 429     if (pVM->pState)
 430         longjmp(*(pVM->pState), except);
 431 }
 432
 433
 434 void vmThrowErr(FICL_VM *pVM, char *fmt, ...)
 435 {
 436     va_list va;
 437     va_start(va, fmt);
 438     vsprintf(pVM->pad, fmt, va);
 439     vmTextOut(pVM, pVM->pad, 1);
 440     va_end(va);
 441     longjmp(*(pVM->pState), VM_ERREXIT);
 442 }
 443
 444
 445 /**************************************************************************
 446                         w o r d I s I m m e d i a t e
 447 **
 448 **************************************************************************/
 449 int wordIsImmediate(FICL_WORD *pFW)
 450 {
 451     return ((pFW != NULL) && (pFW->flags & FW_IMMEDIATE));
 452 }
 453
 454
 455 /**************************************************************************
 456                         w o r d I s C o m p i l e O n l y
 457 **
 458 **************************************************************************/
 459 int wordIsCompileOnly(FICL_WORD *pFW)
 460 {
 461     return ((pFW != NULL) && (pFW->flags & FW_COMPILE));
 462 }
 463
 464
 465 /**************************************************************************
 466                         s t r r e v
 467 **
 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 */
 474     char c;
 475
 476     if (i > 1)
 477     {
 478         while (p1 < p2)
 479         {
 480             c = *p2;
 481             *p2 = *p1;
 482             *p1 = c;
 483             p1++; p2--;
 484         }
 485     }
 486
 487     return string;
 488 }
 489
 490
 491 /**************************************************************************
 492                         d i g i t _ t o _ c h a r
 493 **
 494 **************************************************************************/
 495 char digit_to_char(int value)
 496 {
 497     return digits[value];
 498 }
 499
 500
 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)
 507 {
 508     int i = 1;
 509     FICL_UNS t = 2;
 510
 511     for (; ((t <= u) && (t != 0)); i++, t <<= 1)
 512     {
 513         if (u == t)
 514             return i;
 515     }
 516
 517     return 0;
 518 }
 519
 520
 521 /**************************************************************************
 522                         l t o a
 523 **
 524 **************************************************************************/
 525 char *ltoa( FICL_INT value, char *string, int radix )
 526 {                               /* convert long to string, any base */
 527     char *cp = string;
 528     int sign = ((radix == 10) && (value < 0));
 529     int pwr;
 530
 531     assert(radix > 1);
 532     assert(radix < 37);
 533     assert(string);
 534
 535     pwr = isPowerOfTwo((FICL_UNS)radix);
 536
 537     if (sign)
 538         value = -value;
 539
 540     if (value == 0)
 541         *cp++ = '0';
 542     else if (pwr != 0)
 543     {
 544         FICL_UNS v = (FICL_UNS) value;
 545         FICL_UNS mask = (FICL_UNS) ~(-1 << pwr);
 546         while (v)
 547         {
 548             *cp++ = digits[v & mask];
 549             v >>= pwr;
 550         }
 551     }
 552     else
 553     {
 554         UNSQR result;
 555         DPUNS v;
 556         v.hi = 0;
 557         v.lo = (FICL_UNS)value;
 558         while (v.lo)
 559         {
 560             result = ficlLongDiv(v, (FICL_UNS)radix);
 561             *cp++ = digits[result.rem];
 562             v.lo = result.quot;
 563         }
 564     }
 565
 566     if (sign)
 567         *cp++ = '-';
 568
 569     *cp++ = '\0';
 570
 571     return strrev(string);
 572 }
 573
 574
 575 /**************************************************************************
 576                         u l t o a
 577 **
 578 **************************************************************************/
 579 char *ultoa(FICL_UNS value, char *string, int radix )
 580 {                               /* convert long to string, any base */
 581     char *cp = string;
 582     DPUNS ud;
 583     UNSQR result;
 584
 585     assert(radix > 1);
 586     assert(radix < 37);
 587     assert(string);
 588
 589     if (value == 0)
 590         *cp++ = '0';
 591     else
 592     {
 593         ud.hi = 0;
 594         ud.lo = value;
 595         result.quot = value;
 596
 597         while (ud.lo)
 598         {
 599             result = ficlLongDiv(ud, (FICL_UNS)radix);
 600             ud.lo = result.quot;
 601             *cp++ = digits[result.rem];
 602         }
 603     }
 604
 605     *cp++ = '\0';
 606
 607     return strrev(string);
 608 }
 609
 610
 611 /**************************************************************************
 612                         c a s e F o l d
 613 ** Case folds a NULL terminated string in place. All characters
 614 ** get converted to lower case.
 615 **************************************************************************/
 616 char *caseFold(char *cp)
 617 {
 618     char *oldCp = cp;
 619
 620     while (*cp)
 621     {
 622         if (isupper(*cp))
 623             *cp = (char)tolower(*cp);
 624         cp++;
 625     }
 626
 627     return oldCp;
 628 }
 629
 630
 631 /**************************************************************************
 632                         s t r i n c m p
 633 **
 634 **************************************************************************/
 635 int strincmp(char *cp1, char *cp2, FICL_COUNT count)
 636 {
 637     int i = 0;
 638     char c1, c2;
 639
 640     for (c1 = *cp1, c2 = *cp2;
 641         ((i == 0) && count && c1 && c2);
 642         c1 = *++cp1, c2 = *++cp2, count--)
 643     {
 644         i = tolower(c1) - tolower(c2);
 645     }
 646
 647     return i;
 648 }
 649
 650
 651
 652 /**************************************************************************
 653                         s k i p S p a c e
 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)
 660 {
 661     assert(cp);
 662
 663     while ((cp != end) && isspace(*cp))
 664         cp++;
 665
 666     return cp;
 667 }
 668
 669