151786Sdcs/******************************************************************* 240843Smsmith** v m . c 340843Smsmith** Forth Inspired Command Language - virtual machine methods 440843Smsmith** Author: John Sadler (john_sadler@alum.mit.edu) 540843Smsmith** Created: 19 July 1997 694290Sdcs** $Id: vm.c,v 1.13 2001/12/05 07:21:34 jsadler Exp $ 740843Smsmith*******************************************************************/ 840843Smsmith/* 940843Smsmith** This file implements the virtual machine of FICL. Each virtual 1040843Smsmith** machine retains the state of an interpreter. A virtual machine 1140843Smsmith** owns a pair of stacks for parameters and return addresses, as 1240843Smsmith** well as a pile of state variables and the two dedicated registers 1340843Smsmith** of the interp. 1440843Smsmith*/ 1576116Sdcs/* 1676116Sdcs** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) 1776116Sdcs** All rights reserved. 1876116Sdcs** 1976116Sdcs** Get the latest Ficl release at http://ficl.sourceforge.net 2076116Sdcs** 2194290Sdcs** I am interested in hearing from anyone who uses ficl. If you have 2294290Sdcs** a problem, a success story, a defect, an enhancement request, or 2394290Sdcs** if you would like to contribute to the ficl release, please 2494290Sdcs** contact me by email at the address above. 2594290Sdcs** 2676116Sdcs** L I C E N S E and D I S C L A I M E R 2776116Sdcs** 2876116Sdcs** Redistribution and use in source and binary forms, with or without 2976116Sdcs** modification, are permitted provided that the following conditions 3076116Sdcs** are met: 3176116Sdcs** 1. Redistributions of source code must retain the above copyright 3276116Sdcs** notice, this list of conditions and the following disclaimer. 3376116Sdcs** 2. Redistributions in binary form must reproduce the above copyright 3476116Sdcs** notice, this list of conditions and the following disclaimer in the 3576116Sdcs** documentation and/or other materials provided with the distribution. 3676116Sdcs** 3776116Sdcs** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 3876116Sdcs** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 3976116Sdcs** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 4076116Sdcs** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 4176116Sdcs** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 4276116Sdcs** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 4376116Sdcs** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 4476116Sdcs** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 4576116Sdcs** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 4676116Sdcs** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 4776116Sdcs** SUCH DAMAGE. 4876116Sdcs*/ 4940843Smsmith 5051786Sdcs/* $FreeBSD: releng/10.3/sys/boot/ficl/vm.c 167850 2007-03-23 22:26:01Z jkim $ */ 5151786Sdcs 5240883Smsmith#ifdef TESTMAIN 5340883Smsmith#include <stdlib.h> 5440883Smsmith#include <stdio.h> 5540883Smsmith#include <ctype.h> 5640883Smsmith#else 5740876Smsmith#include <stand.h> 5840883Smsmith#endif 5940843Smsmith#include <stdarg.h> 6040843Smsmith#include <string.h> 6140843Smsmith#include "ficl.h" 6240843Smsmith 6340843Smsmithstatic char digits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; 6440843Smsmith 6540843Smsmith 6640843Smsmith/************************************************************************** 6740843Smsmith v m B r a n c h R e l a t i v e 6840843Smsmith** 6940843Smsmith**************************************************************************/ 7040843Smsmithvoid vmBranchRelative(FICL_VM *pVM, int offset) 7140843Smsmith{ 7240843Smsmith pVM->ip += offset; 7340843Smsmith return; 7440843Smsmith} 7540843Smsmith 7640843Smsmith 7740843Smsmith/************************************************************************** 7840843Smsmith v m C r e a t e 7976116Sdcs** Creates a virtual machine either from scratch (if pVM is NULL on entry) 8076116Sdcs** or by resizing and reinitializing an existing VM to the specified stack 8176116Sdcs** sizes. 8240843Smsmith**************************************************************************/ 8340843SmsmithFICL_VM *vmCreate(FICL_VM *pVM, unsigned nPStack, unsigned nRStack) 8440843Smsmith{ 8540843Smsmith if (pVM == NULL) 8640843Smsmith { 8740843Smsmith pVM = (FICL_VM *)ficlMalloc(sizeof (FICL_VM)); 8851786Sdcs assert (pVM); 8951786Sdcs memset(pVM, 0, sizeof (FICL_VM)); 9040843Smsmith } 9140843Smsmith 9240843Smsmith if (pVM->pStack) 9340843Smsmith stackDelete(pVM->pStack); 9440843Smsmith pVM->pStack = stackCreate(nPStack); 9540843Smsmith 9640843Smsmith if (pVM->rStack) 9740843Smsmith stackDelete(pVM->rStack); 9840843Smsmith pVM->rStack = stackCreate(nRStack); 9940843Smsmith 10076116Sdcs#if FICL_WANT_FLOAT 10176116Sdcs if (pVM->fStack) 10276116Sdcs stackDelete(pVM->fStack); 10376116Sdcs pVM->fStack = stackCreate(nPStack); 10476116Sdcs#endif 10576116Sdcs 10640843Smsmith pVM->textOut = ficlTextOut; 10740843Smsmith 10840843Smsmith vmReset(pVM); 10940843Smsmith return pVM; 11040843Smsmith} 11140843Smsmith 11240843Smsmith 11340843Smsmith/************************************************************************** 11440843Smsmith v m D e l e t e 11576116Sdcs** Free all memory allocated to the specified VM and its subordinate 11676116Sdcs** structures. 11740843Smsmith**************************************************************************/ 11840843Smsmithvoid vmDelete (FICL_VM *pVM) 11940843Smsmith{ 12040843Smsmith if (pVM) 12140843Smsmith { 12240843Smsmith ficlFree(pVM->pStack); 12340843Smsmith ficlFree(pVM->rStack); 12476116Sdcs#if FICL_WANT_FLOAT 12576116Sdcs ficlFree(pVM->fStack); 12676116Sdcs#endif 12740843Smsmith ficlFree(pVM); 12840843Smsmith } 12940843Smsmith 13040843Smsmith return; 13140843Smsmith} 13240843Smsmith 13340843Smsmith 13440843Smsmith/************************************************************************** 13540843Smsmith v m E x e c u t e 13651786Sdcs** Sets up the specified word to be run by the inner interpreter. 13751786Sdcs** Executes the word's code part immediately, but in the case of 13851786Sdcs** colon definition, the definition itself needs the inner interp 13951786Sdcs** to complete. This does not happen until control reaches ficlExec 14040843Smsmith**************************************************************************/ 14140843Smsmithvoid vmExecute(FICL_VM *pVM, FICL_WORD *pWord) 14240843Smsmith{ 14340843Smsmith pVM->runningWord = pWord; 14440843Smsmith pWord->code(pVM); 14540843Smsmith return; 14640843Smsmith} 14740843Smsmith 14840843Smsmith 14940843Smsmith/************************************************************************** 15051786Sdcs v m I n n e r L o o p 15151786Sdcs** the mysterious inner interpreter... 15251786Sdcs** This loop is the address interpreter that makes colon definitions 15351786Sdcs** work. Upon entry, it assumes that the IP points to an entry in 15451786Sdcs** a definition (the body of a colon word). It runs one word at a time 15551786Sdcs** until something does vmThrow. The catcher for this is expected to exist 15651786Sdcs** in the calling code. 15751786Sdcs** vmThrow gets you out of this loop with a longjmp() 15851786Sdcs** Visual C++ 5 chokes on this loop in Release mode. Aargh. 15951786Sdcs**************************************************************************/ 16051786Sdcs#if INLINE_INNER_LOOP == 0 16151786Sdcsvoid vmInnerLoop(FICL_VM *pVM) 16251786Sdcs{ 16351786Sdcs M_INNER_LOOP(pVM); 16451786Sdcs} 16551786Sdcs#endif 16694290Sdcs#if 0 16794290Sdcs/* 16894290Sdcs** Recast inner loop that inlines tokens for control structures, arithmetic and stack operations, 16994290Sdcs** as well as create does> : ; and various literals 17094290Sdcs*/ 17194290Sdcstypedef enum 17294290Sdcs{ 17394290Sdcs PATCH = 0, 17494290Sdcs L0, 17594290Sdcs L1, 17694290Sdcs L2, 17794290Sdcs LMINUS1, 17894290Sdcs LMINUS2, 17994290Sdcs DROP, 18094290Sdcs SWAP, 18194290Sdcs DUP, 18294290Sdcs PICK, 18394290Sdcs ROLL, 18494290Sdcs FETCH, 18594290Sdcs STORE, 18694290Sdcs BRANCH, 18794290Sdcs CBRANCH, 18894290Sdcs LEAVE, 18994290Sdcs TO_R, 19094290Sdcs R_FROM, 19194290Sdcs EXIT; 19294290Sdcs} OPCODE; 19351786Sdcs 19494290Sdcstypedef CELL *IPTYPE; 19560959Sdcs 19694290Sdcsvoid vmInnerLoop(FICL_VM *pVM) 19794290Sdcs{ 19894290Sdcs IPTYPE ip = pVM->ip; 19994290Sdcs FICL_STACK *pStack = pVM->pStack; 20094290Sdcs 20194290Sdcs for (;;) 20294290Sdcs { 20394290Sdcs OPCODE o = (*ip++).i; 20494290Sdcs CELL c; 20594290Sdcs switch (o) 20694290Sdcs { 20794290Sdcs case L0: 20894290Sdcs stackPushINT(pStack, 0); 20994290Sdcs break; 21094290Sdcs case L1: 21194290Sdcs stackPushINT(pStack, 1); 21294290Sdcs break; 21394290Sdcs case L2: 21494290Sdcs stackPushINT(pStack, 2); 21594290Sdcs break; 21694290Sdcs case LMINUS1: 21794290Sdcs stackPushINT(pStack, -1); 21894290Sdcs break; 21994290Sdcs case LMINUS2: 22094290Sdcs stackPushINT(pStack, -2); 22194290Sdcs break; 22294290Sdcs case DROP: 22394290Sdcs stackDrop(pStack, 1); 22494290Sdcs break; 22594290Sdcs case SWAP: 22694290Sdcs stackRoll(pStack, 1); 22794290Sdcs break; 22894290Sdcs case DUP: 22994290Sdcs stackPick(pStack, 0); 23094290Sdcs break; 23194290Sdcs case PICK: 23294290Sdcs c = *ip++; 23394290Sdcs stackPick(pStack, c.i); 23494290Sdcs break; 23594290Sdcs case ROLL: 23694290Sdcs c = *ip++; 23794290Sdcs stackRoll(pStack, c.i); 23894290Sdcs break; 23994290Sdcs case EXIT: 24094290Sdcs return; 24194290Sdcs } 24294290Sdcs } 24394290Sdcs 24494290Sdcs return; 24594290Sdcs} 24694290Sdcs#endif 24794290Sdcs 24894290Sdcs 24994290Sdcs 25051786Sdcs/************************************************************************** 25194290Sdcs v m G e t D i c t 25294290Sdcs** Returns the address dictionary for this VM's system 25394290Sdcs**************************************************************************/ 25494290SdcsFICL_DICT *vmGetDict(FICL_VM *pVM) 25594290Sdcs{ 25694290Sdcs assert(pVM); 25794290Sdcs return pVM->pSys->dp; 25894290Sdcs} 25994290Sdcs 26094290Sdcs 26194290Sdcs/************************************************************************** 26240843Smsmith v m G e t S t r i n g 26340843Smsmith** Parses a string out of the VM input buffer and copies up to the first 26440843Smsmith** FICL_STRING_MAX characters to the supplied destination buffer, a 26540843Smsmith** FICL_STRING. The destination string is NULL terminated. 26640843Smsmith** 26740843Smsmith** Returns the address of the first unused character in the dest buffer. 26840843Smsmith**************************************************************************/ 26940843Smsmithchar *vmGetString(FICL_VM *pVM, FICL_STRING *spDest, char delimiter) 27040843Smsmith{ 27160959Sdcs STRINGINFO si = vmParseStringEx(pVM, delimiter, 0); 27240843Smsmith 27340843Smsmith if (SI_COUNT(si) > FICL_STRING_MAX) 27440843Smsmith { 27540843Smsmith SI_SETLEN(si, FICL_STRING_MAX); 27640843Smsmith } 27740843Smsmith 27840843Smsmith strncpy(spDest->text, SI_PTR(si), SI_COUNT(si)); 27940843Smsmith spDest->text[SI_COUNT(si)] = '\0'; 28040843Smsmith spDest->count = (FICL_COUNT)SI_COUNT(si); 28140843Smsmith 28240843Smsmith return spDest->text + SI_COUNT(si) + 1; 28340843Smsmith} 28440843Smsmith 28540843Smsmith 28640843Smsmith/************************************************************************** 28740843Smsmith v m G e t W o r d 28840843Smsmith** vmGetWord calls vmGetWord0 repeatedly until it gets a string with 28940843Smsmith** non-zero length. 29040843Smsmith**************************************************************************/ 29140843SmsmithSTRINGINFO vmGetWord(FICL_VM *pVM) 29240843Smsmith{ 29340843Smsmith STRINGINFO si = vmGetWord0(pVM); 29440843Smsmith 29540843Smsmith if (SI_COUNT(si) == 0) 29640843Smsmith { 29740843Smsmith vmThrow(pVM, VM_RESTART); 29840843Smsmith } 29940843Smsmith 30040843Smsmith return si; 30140843Smsmith} 30240843Smsmith 30340843Smsmith 30440843Smsmith/************************************************************************** 30540843Smsmith v m G e t W o r d 0 30640843Smsmith** Skip leading whitespace and parse a space delimited word from the tib. 30740843Smsmith** Returns the start address and length of the word. Updates the tib 30840843Smsmith** to reflect characters consumed, including the trailing delimiter. 30940843Smsmith** If there's nothing of interest in the tib, returns zero. This function 31040843Smsmith** does not use vmParseString because it uses isspace() rather than a 31140843Smsmith** single delimiter character. 31240843Smsmith**************************************************************************/ 31340843SmsmithSTRINGINFO vmGetWord0(FICL_VM *pVM) 31440843Smsmith{ 31551786Sdcs char *pSrc = vmGetInBuf(pVM); 31651786Sdcs char *pEnd = vmGetInBufEnd(pVM); 31740843Smsmith STRINGINFO si; 31861182Sdcs FICL_UNS count = 0; 319167850Sjkim char ch = 0; 32040843Smsmith 32151786Sdcs pSrc = skipSpace(pSrc, pEnd); 32240843Smsmith SI_SETPTR(si, pSrc); 32340843Smsmith 324167850Sjkim/* 32551786Sdcs for (ch = *pSrc; (pEnd != pSrc) && !isspace(ch); ch = *++pSrc) 32640843Smsmith { 32740843Smsmith count++; 32840843Smsmith } 329167850Sjkim*/ 33040843Smsmith 331167850Sjkim /* Changed to make Purify happier. --lch */ 332167850Sjkim for (;;) 333167850Sjkim { 334167850Sjkim if (pEnd == pSrc) 335167850Sjkim break; 336167850Sjkim ch = *pSrc; 337167850Sjkim if (isspace(ch)) 338167850Sjkim break; 339167850Sjkim count++; 340167850Sjkim pSrc++; 341167850Sjkim } 342167850Sjkim 34340843Smsmith SI_SETLEN(si, count); 34440843Smsmith 34551786Sdcs if ((pEnd != pSrc) && isspace(ch)) /* skip one trailing delimiter */ 34640843Smsmith pSrc++; 34740843Smsmith 34840843Smsmith vmUpdateTib(pVM, pSrc); 34940843Smsmith 35040843Smsmith return si; 35140843Smsmith} 35240843Smsmith 35340843Smsmith 35440843Smsmith/************************************************************************** 35540843Smsmith v m G e t W o r d T o P a d 35676116Sdcs** Does vmGetWord and copies the result to the pad as a NULL terminated 35740843Smsmith** string. Returns the length of the string. If the string is too long 35840843Smsmith** to fit in the pad, it is truncated. 35940843Smsmith**************************************************************************/ 36040843Smsmithint vmGetWordToPad(FICL_VM *pVM) 36140843Smsmith{ 36240843Smsmith STRINGINFO si; 36340843Smsmith char *cp = (char *)pVM->pad; 36476116Sdcs si = vmGetWord(pVM); 36540843Smsmith 36640843Smsmith if (SI_COUNT(si) > nPAD) 36740843Smsmith SI_SETLEN(si, nPAD); 36840843Smsmith 36940843Smsmith strncpy(cp, SI_PTR(si), SI_COUNT(si)); 37040843Smsmith cp[SI_COUNT(si)] = '\0'; 37140843Smsmith return (int)(SI_COUNT(si)); 37240843Smsmith} 37340843Smsmith 37440843Smsmith 37540843Smsmith/************************************************************************** 37640843Smsmith v m P a r s e S t r i n g 37740843Smsmith** Parses a string out of the input buffer using the delimiter 37840843Smsmith** specified. Skips leading delimiters, marks the start of the string, 37940843Smsmith** and counts characters to the next delimiter it encounters. It then 38040843Smsmith** updates the vm input buffer to consume all these chars, including the 38140843Smsmith** trailing delimiter. 38240843Smsmith** Returns the address and length of the parsed string, not including the 38340843Smsmith** trailing delimiter. 38440843Smsmith**************************************************************************/ 38540843SmsmithSTRINGINFO vmParseString(FICL_VM *pVM, char delim) 38660959Sdcs{ 38776116Sdcs return vmParseStringEx(pVM, delim, 1); 38860959Sdcs} 38960959Sdcs 39060959SdcsSTRINGINFO vmParseStringEx(FICL_VM *pVM, char delim, char fSkipLeading) 39140843Smsmith{ 39240843Smsmith STRINGINFO si; 39340843Smsmith char *pSrc = vmGetInBuf(pVM); 39451786Sdcs char *pEnd = vmGetInBufEnd(pVM); 39551786Sdcs char ch; 39640843Smsmith 39776116Sdcs if (fSkipLeading) 39876116Sdcs { /* skip lead delimiters */ 39976116Sdcs while ((pSrc != pEnd) && (*pSrc == delim)) 40076116Sdcs pSrc++; 40176116Sdcs } 40240843Smsmith 40340843Smsmith SI_SETPTR(si, pSrc); /* mark start of text */ 40440843Smsmith 40551786Sdcs for (ch = *pSrc; (pSrc != pEnd) 40651786Sdcs && (ch != delim) 40740843Smsmith && (ch != '\r') 40840843Smsmith && (ch != '\n'); ch = *++pSrc) 40940843Smsmith { 41040843Smsmith ; /* find next delimiter or end of line */ 41140843Smsmith } 41240843Smsmith 41340843Smsmith /* set length of result */ 41440843Smsmith SI_SETLEN(si, pSrc - SI_PTR(si)); 41540843Smsmith 41651786Sdcs if ((pSrc != pEnd) && (*pSrc == delim)) /* gobble trailing delimiter */ 41740843Smsmith pSrc++; 41840843Smsmith 41940843Smsmith vmUpdateTib(pVM, pSrc); 42040843Smsmith return si; 42140843Smsmith} 42240843Smsmith 42340843Smsmith 42440843Smsmith/************************************************************************** 42560959Sdcs v m P o p 42660959Sdcs** 42760959Sdcs**************************************************************************/ 42860959SdcsCELL vmPop(FICL_VM *pVM) 42960959Sdcs{ 43060959Sdcs return stackPop(pVM->pStack); 43160959Sdcs} 43260959Sdcs 43360959Sdcs 43460959Sdcs/************************************************************************** 43560959Sdcs v m P u s h 43660959Sdcs** 43760959Sdcs**************************************************************************/ 43860959Sdcsvoid vmPush(FICL_VM *pVM, CELL c) 43960959Sdcs{ 44060959Sdcs stackPush(pVM->pStack, c); 44160959Sdcs return; 44260959Sdcs} 44360959Sdcs 44460959Sdcs 44560959Sdcs/************************************************************************** 44640843Smsmith v m P o p I P 44740843Smsmith** 44840843Smsmith**************************************************************************/ 44940843Smsmithvoid vmPopIP(FICL_VM *pVM) 45040843Smsmith{ 45140843Smsmith pVM->ip = (IPTYPE)(stackPopPtr(pVM->rStack)); 45240843Smsmith return; 45340843Smsmith} 45440843Smsmith 45540843Smsmith 45640843Smsmith/************************************************************************** 45740843Smsmith v m P u s h I P 45840843Smsmith** 45940843Smsmith**************************************************************************/ 46040843Smsmithvoid vmPushIP(FICL_VM *pVM, IPTYPE newIP) 46140843Smsmith{ 46240843Smsmith stackPushPtr(pVM->rStack, (void *)pVM->ip); 46340843Smsmith pVM->ip = newIP; 46440843Smsmith return; 46540843Smsmith} 46640843Smsmith 46740843Smsmith 46840843Smsmith/************************************************************************** 46940843Smsmith v m P u s h T i b 47040843Smsmith** Binds the specified input string to the VM and clears >IN (the index) 47140843Smsmith**************************************************************************/ 47251786Sdcsvoid vmPushTib(FICL_VM *pVM, char *text, FICL_INT nChars, TIB *pSaveTib) 47340843Smsmith{ 47440843Smsmith if (pSaveTib) 47540843Smsmith { 47640843Smsmith *pSaveTib = pVM->tib; 47740843Smsmith } 47840843Smsmith 47940843Smsmith pVM->tib.cp = text; 48051786Sdcs pVM->tib.end = text + nChars; 48140843Smsmith pVM->tib.index = 0; 48240843Smsmith} 48340843Smsmith 48440843Smsmith 48540843Smsmithvoid vmPopTib(FICL_VM *pVM, TIB *pTib) 48640843Smsmith{ 48740843Smsmith if (pTib) 48840843Smsmith { 48940843Smsmith pVM->tib = *pTib; 49040843Smsmith } 49140843Smsmith return; 49240843Smsmith} 49340843Smsmith 49440843Smsmith 49540843Smsmith/************************************************************************** 49640843Smsmith v m Q u i t 49740843Smsmith** 49840843Smsmith**************************************************************************/ 49940843Smsmithvoid vmQuit(FICL_VM *pVM) 50040843Smsmith{ 50140843Smsmith stackReset(pVM->rStack); 50240843Smsmith pVM->fRestart = 0; 50376116Sdcs pVM->ip = NULL; 50476116Sdcs pVM->runningWord = NULL; 50540843Smsmith pVM->state = INTERPRET; 50640843Smsmith pVM->tib.cp = NULL; 50743078Smsmith pVM->tib.end = NULL; 50840843Smsmith pVM->tib.index = 0; 50940843Smsmith pVM->pad[0] = '\0'; 51040843Smsmith pVM->sourceID.i = 0; 51140843Smsmith return; 51240843Smsmith} 51340843Smsmith 51440843Smsmith 51540843Smsmith/************************************************************************** 51640843Smsmith v m R e s e t 51740843Smsmith** 51840843Smsmith**************************************************************************/ 51940843Smsmithvoid vmReset(FICL_VM *pVM) 52040843Smsmith{ 52140843Smsmith vmQuit(pVM); 52240843Smsmith stackReset(pVM->pStack); 52376116Sdcs#if FICL_WANT_FLOAT 52476116Sdcs stackReset(pVM->fStack); 52576116Sdcs#endif 52640843Smsmith pVM->base = 10; 52740843Smsmith return; 52840843Smsmith} 52940843Smsmith 53040843Smsmith 53140843Smsmith/************************************************************************** 53240843Smsmith v m S e t T e x t O u t 53340843Smsmith** Binds the specified output callback to the vm. If you pass NULL, 53440843Smsmith** binds the default output function (ficlTextOut) 53540843Smsmith**************************************************************************/ 53640843Smsmithvoid vmSetTextOut(FICL_VM *pVM, OUTFUNC textOut) 53740843Smsmith{ 53840843Smsmith if (textOut) 53940843Smsmith pVM->textOut = textOut; 54040843Smsmith else 54140843Smsmith pVM->textOut = ficlTextOut; 54240843Smsmith 54340843Smsmith return; 54440843Smsmith} 54540843Smsmith 54640843Smsmith 54740843Smsmith/************************************************************************** 54840843Smsmith v m T e x t O u t 54940843Smsmith** Feeds text to the vm's output callback 55040843Smsmith**************************************************************************/ 55140843Smsmithvoid vmTextOut(FICL_VM *pVM, char *text, int fNewline) 55240843Smsmith{ 55340843Smsmith assert(pVM); 55440843Smsmith assert(pVM->textOut); 55540843Smsmith (pVM->textOut)(pVM, text, fNewline); 55640843Smsmith 55740843Smsmith return; 55840843Smsmith} 55940843Smsmith 56040843Smsmith 56140843Smsmith/************************************************************************** 56240843Smsmith v m T h r o w 56340843Smsmith** 56440843Smsmith**************************************************************************/ 56540843Smsmithvoid vmThrow(FICL_VM *pVM, int except) 56640843Smsmith{ 56751786Sdcs if (pVM->pState) 56851786Sdcs longjmp(*(pVM->pState), except); 56940843Smsmith} 57040843Smsmith 57140843Smsmith 57240843Smsmithvoid vmThrowErr(FICL_VM *pVM, char *fmt, ...) 57340843Smsmith{ 57440843Smsmith va_list va; 57540843Smsmith va_start(va, fmt); 57640843Smsmith vsprintf(pVM->pad, fmt, va); 57740843Smsmith vmTextOut(pVM, pVM->pad, 1); 57840843Smsmith va_end(va); 57940843Smsmith longjmp(*(pVM->pState), VM_ERREXIT); 58040843Smsmith} 58140843Smsmith 58240843Smsmith 58340843Smsmith/************************************************************************** 58440843Smsmith w o r d I s I m m e d i a t e 58540843Smsmith** 58640843Smsmith**************************************************************************/ 58740843Smsmithint wordIsImmediate(FICL_WORD *pFW) 58840843Smsmith{ 58940843Smsmith return ((pFW != NULL) && (pFW->flags & FW_IMMEDIATE)); 59040843Smsmith} 59140843Smsmith 59240843Smsmith 59340843Smsmith/************************************************************************** 59440843Smsmith w o r d I s C o m p i l e O n l y 59540843Smsmith** 59640843Smsmith**************************************************************************/ 59740843Smsmithint wordIsCompileOnly(FICL_WORD *pFW) 59840843Smsmith{ 59940843Smsmith return ((pFW != NULL) && (pFW->flags & FW_COMPILE)); 60040843Smsmith} 60140843Smsmith 60240843Smsmith 60340843Smsmith/************************************************************************** 60440843Smsmith s t r r e v 60540843Smsmith** 60640843Smsmith**************************************************************************/ 60740843Smsmithchar *strrev( char *string ) 60840843Smsmith{ /* reverse a string in-place */ 60940843Smsmith int i = strlen(string); 61040843Smsmith char *p1 = string; /* first char of string */ 61140843Smsmith char *p2 = string + i - 1; /* last non-NULL char of string */ 61240843Smsmith char c; 61340843Smsmith 61440843Smsmith if (i > 1) 61540843Smsmith { 61640843Smsmith while (p1 < p2) 61740843Smsmith { 61840843Smsmith c = *p2; 61940843Smsmith *p2 = *p1; 62040843Smsmith *p1 = c; 62140843Smsmith p1++; p2--; 62240843Smsmith } 62340843Smsmith } 62440843Smsmith 62540843Smsmith return string; 62640843Smsmith} 62740843Smsmith 62840843Smsmith 62940843Smsmith/************************************************************************** 63040843Smsmith d i g i t _ t o _ c h a r 63140843Smsmith** 63240843Smsmith**************************************************************************/ 63340843Smsmithchar digit_to_char(int value) 63440843Smsmith{ 63540843Smsmith return digits[value]; 63640843Smsmith} 63740843Smsmith 63840843Smsmith 63940843Smsmith/************************************************************************** 64051786Sdcs i s P o w e r O f T w o 64151786Sdcs** Tests whether supplied argument is an integer power of 2 (2**n) 64251786Sdcs** where 32 > n > 1, and returns n if so. Otherwise returns zero. 64351786Sdcs**************************************************************************/ 64451786Sdcsint isPowerOfTwo(FICL_UNS u) 64551786Sdcs{ 64651786Sdcs int i = 1; 64751786Sdcs FICL_UNS t = 2; 64851786Sdcs 64951786Sdcs for (; ((t <= u) && (t != 0)); i++, t <<= 1) 65051786Sdcs { 65151786Sdcs if (u == t) 65251786Sdcs return i; 65351786Sdcs } 65451786Sdcs 65551786Sdcs return 0; 65651786Sdcs} 65751786Sdcs 65851786Sdcs 65951786Sdcs/************************************************************************** 66040843Smsmith l t o a 66140843Smsmith** 66240843Smsmith**************************************************************************/ 66351786Sdcschar *ltoa( FICL_INT value, char *string, int radix ) 66440843Smsmith{ /* convert long to string, any base */ 66540843Smsmith char *cp = string; 66640843Smsmith int sign = ((radix == 10) && (value < 0)); 66751786Sdcs int pwr; 66840843Smsmith 66940843Smsmith assert(radix > 1); 67040843Smsmith assert(radix < 37); 67140843Smsmith assert(string); 67240843Smsmith 67351786Sdcs pwr = isPowerOfTwo((FICL_UNS)radix); 67451786Sdcs 67540843Smsmith if (sign) 67640843Smsmith value = -value; 67740843Smsmith 67840843Smsmith if (value == 0) 67940843Smsmith *cp++ = '0'; 68051786Sdcs else if (pwr != 0) 68151786Sdcs { 68251786Sdcs FICL_UNS v = (FICL_UNS) value; 68351786Sdcs FICL_UNS mask = (FICL_UNS) ~(-1 << pwr); 68451786Sdcs while (v) 68551786Sdcs { 68651786Sdcs *cp++ = digits[v & mask]; 68751786Sdcs v >>= pwr; 68851786Sdcs } 68951786Sdcs } 69040843Smsmith else 69140843Smsmith { 69251786Sdcs UNSQR result; 69351786Sdcs DPUNS v; 69440843Smsmith v.hi = 0; 69551786Sdcs v.lo = (FICL_UNS)value; 69640843Smsmith while (v.lo) 69740843Smsmith { 69851786Sdcs result = ficlLongDiv(v, (FICL_UNS)radix); 69940843Smsmith *cp++ = digits[result.rem]; 70040843Smsmith v.lo = result.quot; 70140843Smsmith } 70240843Smsmith } 70340843Smsmith 70440843Smsmith if (sign) 70540843Smsmith *cp++ = '-'; 70640843Smsmith 70740843Smsmith *cp++ = '\0'; 70840843Smsmith 70940843Smsmith return strrev(string); 71040843Smsmith} 71140843Smsmith 71240843Smsmith 71340843Smsmith/************************************************************************** 71440843Smsmith u l t o a 71540843Smsmith** 71640843Smsmith**************************************************************************/ 71751786Sdcschar *ultoa(FICL_UNS value, char *string, int radix ) 71840843Smsmith{ /* convert long to string, any base */ 71940843Smsmith char *cp = string; 72051786Sdcs DPUNS ud; 72140843Smsmith UNSQR result; 72240843Smsmith 72340843Smsmith assert(radix > 1); 72440843Smsmith assert(radix < 37); 72540843Smsmith assert(string); 72640843Smsmith 72740843Smsmith if (value == 0) 72840843Smsmith *cp++ = '0'; 72940843Smsmith else 73040843Smsmith { 73140843Smsmith ud.hi = 0; 73240843Smsmith ud.lo = value; 73340843Smsmith result.quot = value; 73440843Smsmith 73540843Smsmith while (ud.lo) 73640843Smsmith { 73761182Sdcs result = ficlLongDiv(ud, (FICL_UNS)radix); 73840843Smsmith ud.lo = result.quot; 73940843Smsmith *cp++ = digits[result.rem]; 74040843Smsmith } 74140843Smsmith } 74240843Smsmith 74340843Smsmith *cp++ = '\0'; 74440843Smsmith 74540843Smsmith return strrev(string); 74640843Smsmith} 74740843Smsmith 74840843Smsmith 74940843Smsmith/************************************************************************** 75040843Smsmith c a s e F o l d 75140843Smsmith** Case folds a NULL terminated string in place. All characters 75240843Smsmith** get converted to lower case. 75340843Smsmith**************************************************************************/ 75440843Smsmithchar *caseFold(char *cp) 75540843Smsmith{ 75640843Smsmith char *oldCp = cp; 75740843Smsmith 75840843Smsmith while (*cp) 75940843Smsmith { 76040843Smsmith if (isupper(*cp)) 76140843Smsmith *cp = (char)tolower(*cp); 76240843Smsmith cp++; 76340843Smsmith } 76440843Smsmith 76540843Smsmith return oldCp; 76640843Smsmith} 76740843Smsmith 76840843Smsmith 76940843Smsmith/************************************************************************** 77040843Smsmith s t r i n c m p 77176116Sdcs** (jws) simplified the code a bit in hopes of appeasing Purify 77240843Smsmith**************************************************************************/ 77376116Sdcsint strincmp(char *cp1, char *cp2, FICL_UNS count) 77440843Smsmith{ 77540843Smsmith int i = 0; 77640843Smsmith 77776116Sdcs for (; 0 < count; ++cp1, ++cp2, --count) 77840843Smsmith { 77976116Sdcs i = tolower(*cp1) - tolower(*cp2); 78076116Sdcs if (i != 0) 78176116Sdcs return i; 78276116Sdcs else if (*cp1 == '\0') 78376116Sdcs return 0; 78440843Smsmith } 78576116Sdcs return 0; 78640843Smsmith} 78740843Smsmith 78840843Smsmith/************************************************************************** 78940843Smsmith s k i p S p a c e 79040843Smsmith** Given a string pointer, returns a pointer to the first non-space 79140843Smsmith** char of the string, or to the NULL terminator if no such char found. 79251786Sdcs** If the pointer reaches "end" first, stop there. Pass NULL to 79351786Sdcs** suppress this behavior. 79440843Smsmith**************************************************************************/ 79543078Smsmithchar *skipSpace(char *cp, char *end) 79640843Smsmith{ 79740843Smsmith assert(cp); 79840843Smsmith 79943078Smsmith while ((cp != end) && isspace(*cp)) 80040843Smsmith cp++; 80140843Smsmith 80240843Smsmith return cp; 80340843Smsmith} 80440843Smsmith 80540843Smsmith 806