io/prom/forth.cc

/*
 *      PearPC
 *      forth.cc
 *
 *      Copyright (C) 2003 Sebastian Biallas (sb@biallas.net)
 *
 *      This program is free software; you can redistribute it and/or modify
 *      it under the terms of the GNU General Public License version 2 as
 *      published by the Free Software Foundation.
 *
 *      This program is distributed in the hope that it will be useful,
 *      but WITHOUT ANY WARRANTY; without even the implied warranty of
 *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *      GNU General Public License for more details.
 *
 *      You should have received a copy of the GNU General Public License
 *      along with this program; if not, write to the Free Software
 *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include <cstdlib>
#include <cstring>
#include <cstdarg>

#include "system/display.h"
#include "tools/snprintf.h"
#include "prommem.h"
#include "forth.h"
#include "forthtable.h"

ForthPos::ForthPos()
{
        mFpm = fpmLinePos;
        mLine = 1;
        mPos = 1;
        mOffset = 0;
}

void ForthPos::copy(ForthPos &p) 
{
        mFpm = p.mFpm;
        mLine = p.mLine;
        mPos = p.mPos;
        mOffset = p.mOffset;
}

int ForthPos::toString(char *buf, int buflen) const
{
        if (mFpm == fpmOffset) {
                return ht_snprintf(buf, buflen, "%08x", mOffset);
        } else {
                return ht_snprintf(buf, buflen, "%d:%d", mLine, mPos);
        }
}

void ForthPos::clearPos()
{
        mPos = 0;
}

void ForthPos::setMode(ForthPosMode fpm)
{
        mFpm = fpm;
}

void ForthPos::setLinePos(int line, int pos)
{
        mLine = line;
        mPos = pos;
}

void ForthPos::setOffset(uint32 offset)
{
        mOffset = offset;
}

void ForthPos::inc()
{
        if (mFpm == fpmOffset) {
                mOffset++;
        } else {
                mPos++;
        }
}

void ForthPos::inc(int n)
{
        if (mFpm == fpmOffset) {
                mOffset+=n;
        } else {
                mPos+=n;
        }
}

void ForthPos::incLine()
{
        mLine++;
}

ForthException::ForthException()
{
}

ForthInterpreterException::ForthInterpreterException(ForthPos &pos, const char *msg, ...)
{
        char estr2[120];
        va_list va;
        va_start(va, msg);
        ht_vsnprintf(estr2, sizeof estr2, msg, va);
        va_end(va);
        ht_snprintf(estr, sizeof estr, "%s: %s at %y", "Interpreter Exception", estr2, &pos);
}

ForthRunException::ForthRunException(ForthPos &pos, const char *msg, ...)
{
        char estr2[120];
        va_list va;
        va_start(va, msg);
        ht_vsnprintf(estr2, sizeof estr2, msg, va);
        va_end(va);
        ht_snprintf(estr, sizeof estr, "%s: %s at %y", "Run Exception", estr2, &pos);
}

/*
 *
 */
#define STRING_BUFFER_SIZE 120
ForthVM::ForthVM()
{
        codestack = new Stack(true);
        datastack = new Stack(true);
        mGlobalVocalbulary = new AVLTree(true);
        promMalloc(STRING_BUFFER_SIZE, mStringBufferEA[0], (void**)&(mStringBuffer[0]));
        promMalloc(STRING_BUFFER_SIZE, mStringBufferEA[1], (void**)&(mStringBuffer[1]));
        mStringBufferIdx = 0;
        mFCodeBuffer = new String();
        mFCodeBufferIdx = 0;
        forth_build_vocabulary(*mGlobalVocalbulary, *this);
        
        forth_disassemble(*this);
}

ForthVM::~ForthVM()
{
        delete datastack;
        delete codestack;
        delete mGlobalVocalbulary;
}
        
void ForthVM::emitFCode(uint32 fcode)
{
        if (fcode > 0xfff || (fcode >= 0x01 && fcode <= 0x0f)) {
                throw ForthInterpreterException(mErrorPos, "internal: broken fcode %x", fcode);
        }
        if (fcode > 0xff) {
                emitFCodeByte(fcode>>8);
        }
        emitFCodeByte(fcode);
}

void ForthVM::emitFCodeByte(byte b)
{
        *mFCodeBuffer += (char)b;
}

byte ForthVM::getFCodeByte()
{
        if (mFCodeBufferIdx >= mFCodeBuffer->length()) throw ForthRunException(mErrorPos, "unexpected end of program");
        return (*mFCodeBuffer)[mFCodeBufferIdx++];
}

uint32 ForthVM::getFCode()
{
        uint32 fcode = getFCodeByte();
        if (fcode >= 0x01 && fcode <= 0x0f) {
                fcode <<= 8;
                fcode |= getFCodeByte();
        }
        return fcode;
}

int ForthVM::outf(const char *m, ...)
{
        char b[1024];
        va_list va;
        va_start(va, m);
        int a = ht_vsnprintf(b, sizeof b, m, va);
        va_end(va);
        gDisplay->print(b);
        return a;
}

bool ForthVM::getChar()
{
        if (input->read(&currentChar, 1) != 1) {
//              ht_printf("getChar: false\n");
                return false;
        }
        if (currentChar == 10) {
                mPos.incLine(); 
                mPos.clearPos();
        }
        mPos.inc();
//      ht_printf("getChar: %d '%c'\n", currentChar, currentChar);
        return true;
}

String &ForthVM::getToken(const String &delimiters)
{
        
}

bool ForthVM::consumeSpace(bool except)
{
        return false;   
}

bool ForthVM::skipWhite()
{
        do {
                switch (currentChar) {
                case 9:
                case ' ':
                        if (!getChar()) return false;
                        continue;
                }
        } while (0);
        return true;
}

bool ForthVM::skipWhiteCR()
{
        while (currentChar == ' ' || currentChar == 10 || currentChar == 13 || currentChar == 9) {
                if (!getChar()) return false;
        }
        return true;
}

void ForthVM::interprete(Stream &in, Stream &out)
{
        input = &in;
        output = &out;  
        mPos.setLinePos(1, 1);
        mPos.setMode(fpmLinePos);
        if (!getChar()) return;
        mMode = fmInterprete;
        while (1) {
                // get a token
                if (!skipWhiteCR()) break;
                int i=0;
                mErrorPos.copy(mPos);
                do {
                        if (i==sizeof mCurToken) throw ForthInterpreterException(mErrorPos, "token too long");
                        mCurToken[i++] = currentChar;
                        if (!getChar()) break;
                        if (currentChar==9 || currentChar==10 || currentChar==13 || currentChar==' ') {
                                break;
                        }
                } while (1);
                mCurToken[i] = 0;
                ForthWordBuildIn fwbi(mCurToken, 0, NULL);
                ForthWord *fw = (ForthWord*)mGlobalVocalbulary->get(mGlobalVocalbulary->find(&fwbi));
                if (fw) {
                        if (mMode == fmCompile) {
                                fw->compile(*this);
                        } else {
                                fw->interprete(*this);
                        }
                } else {
                        throw ForthInterpreterException(mErrorPos, "unkown word '%s'", mCurToken);
                }
        }
}
                
/*
 * data stack
 */
void ForthVM::dataPush(uint32 value)
{
        datastack->push(new UInt(value));
}

uint32 ForthVM::dataPop()
{
        UInt *u = (UInt*)datastack->pop();
        if (!u) {
                throw ForthRunException(mErrorPos, "Stack underflow");
        }
        return u->value;
}

bool ForthVM::dataEmpty()
{
        return datastack->isEmpty();
}

uint32 ForthVM::dataGet(uint n)
{
        UInt *u;
        if (datastack->isEmpty() || !((u = (UInt*)(*datastack)[datastack->count() - n - 1]))) {
                throw ForthRunException(mErrorPos, "Stack underflow");
        }
        return u->value;        
}

void ForthVM::dataClear()
{
        datastack->delAll();
}

uint32 ForthVM::dataDepth()
{
        return datastack->count();
}

void *ForthVM::dataStr(uint32 u, bool exc)
{
        void *p = NULL;//prom_mem_eaptr(u);
        if (!p) throw ForthRunException(mErrorPos, "invalid address");
        return p;
}

/*
 * code stack
 */
void ForthVM::codePush(uint32 value)
{
        codestack->push(new UInt(value));
}

uint32 ForthVM::codePop()
{
        UInt *u = (UInt*)codestack->pop();
        if (!u) {
                throw ForthRunException(mErrorPos, "Codestack underflow");
        }
        return u->value;
}

bool ForthVM::codeEmpty()
{
        return codestack->isEmpty();
}

uint32 ForthVM::codeGet(uint n)
{
        UInt *u;
        if (codestack->isEmpty() || !((u = (UInt*)(*codestack)[codestack->count() - n - 1]))) {
                throw ForthRunException(mErrorPos, "Codestack underflow");
        }
        return u->value;
}

void ForthVM::codeClear()
{
        codestack->delAll();
}

uint32 ForthVM::codeDepth()
{
        return codestack->count();
}

/*
 *      memory
 */
void ForthVM::promMalloc(uint32 size, uint32 &ea, void **p)
{
//      ea = prom_mem_malloc(size);
//      *p = prom_mem_ptr(ea);
//      ea = prom_mem_phys_to_virt(ea);
}

/*
 *
 */
ForthWord::ForthWord(const char *n)
        :Object()
{
        mName = strdup(n);
}

ForthWord::~ForthWord()
{
        free(mName);
}
                        
int ForthWord::compareTo(const Object *obj) const
{
        return strcmp(mName, ((ForthWord*)obj)->mName);
}

void ForthWord::compile(ForthVM &vm)
{
        throw ForthInterpreterException(vm.mErrorPos, "internal: no compile method for '%s'", mName);
}

uint32 ForthWord::getExecToken(ForthVM &vm)
{
        throw ForthInterpreterException(vm.mErrorPos, "cannot tick '%s'", mName);
}

void ForthWord::interprete(ForthVM &vm)
{
        throw ForthInterpreterException(vm.mErrorPos, "internal: no interprete method for %s", mName);
}

int ForthWord::toString(char *buf, int buflen) const
{
        return ht_snprintf(buf, buflen, "[WORD:'%s']", mName);
}

ForthWordBuildIn::ForthWordBuildIn(const char *name, uint32 fcode, FCodeFunction func)
        :ForthWord(name)
{
        mFCode = fcode;
        mFunc = func;
}

void ForthWordBuildIn::compile(ForthVM &vm)
{
        vm.emitFCode(mFCode);
}

uint32 ForthWordBuildIn::getExecToken(ForthVM &vm)
{
        return mFCode;
}

void ForthWordBuildIn::interprete(ForthVM &vm)
{
        mFunc(vm);
}

/*
 *
 */
 
ForthWordAlias::ForthWordAlias(const char *name, int n, ...)
        :ForthWord(name)
{
        va_list ap;
        mFCodes = (uint16*)malloc(n*sizeof (uint16));
        for (int i=0; i<n; i++) {
                mFCodes[i] = va_arg(ap, int);
        }
        va_end(ap);
        mNumFCodes = n;
}

void ForthWordAlias::compile(ForthVM &vm)
{
        for (int i=0; i<mNumFCodes; i++) {
                vm.emitFCode(mFCodes[i]);
        }
}

void ForthWordAlias::interprete(ForthVM &vm)
{
}

/*
 *
 */
ForthWordString::ForthWordString(const char *name, ForthWordStringType fwst)
        :ForthWord(name)
{
        mFwst = fwst;
}

void ForthWordString::compile(ForthVM &vm)
{
}

String &ForthWordString::get(ForthVM &vm, String &s)
{
        s = "";
        if (vm.currentChar == 10 || vm.currentChar == 13) return s;
        while (1) {
                if (!vm.getChar()) throw ForthInterpreterException(vm.mErrorPos, "unterminated string");
                switch (mFwst) {
                case fwstString:
                case fwstStringPrint:
                        if (vm.currentChar=='"') {
                                vm.getChar();
                                return s;
                        }
                        break;
                case fwstStringWithHex:
                        if (vm.currentChar=='"') {
                                if (!vm.getChar()) return s;
                                if (vm.currentChar=='(') {
                                        // start hex mode and wait for ')'
                                } else {
                                        return s;
                                }
                        }
                        break;
                case fwstStringPrintBracket:
                        if (vm.currentChar==')') {
                                vm.getChar();
                                return s;
                        }
                        break;
                }
                s += vm.currentChar;
        }
}

void ForthWordString::interprete(ForthVM &vm)
{
        String s;
        get(vm, s);
        switch (mFwst) {
        case fwstString:
        case fwstStringWithHex: {
                int len = s.length();
                memmove(vm.mStringBuffer[vm.mStringBufferIdx], s.content(), MIN(len, STRING_BUFFER_SIZE));
                vm.dataPush(vm.mStringBufferEA[vm.mStringBufferIdx]);
                vm.dataPush(len);
                vm.mStringBufferIdx ^= 1;
                break;
        }
        case fwstStringPrint:
        case fwstStringPrintBracket:
                vm.outf("%y", &s);
                break;
        }
}

ForthVar::ForthVar(const char *name, uint32 address)
        : ForthWord(name)
{
}

void ForthVar::compile(ForthVM &vm)
{
}

uint32 ForthVar::getExecToken(ForthVM &vm)
{
}

void ForthVar::interprete(ForthVM &vm)
{
}

1	dpavlin	1	/*
2			* PearPC
3			* forth.cc
4			*
5			* Copyright (C) 2003 Sebastian Biallas (sb@biallas.net)
6			*
7			* This program is free software; you can redistribute it and/or modify
8			* it under the terms of the GNU General Public License version 2 as
9			* published by the Free Software Foundation.
10			*
11			* This program is distributed in the hope that it will be useful,
12			* but WITHOUT ANY WARRANTY; without even the implied warranty of
13			* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14			* GNU General Public License for more details.
15			*
16			* You should have received a copy of the GNU General Public License
17			* along with this program; if not, write to the Free Software
18			* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19			*/
20
21			#include <cstdlib>
22			#include <cstring>
23			#include <cstdarg>
24
25			#include "system/display.h"
26			#include "tools/snprintf.h"
27			#include "prommem.h"
28			#include "forth.h"
29			#include "forthtable.h"
30
31			ForthPos::ForthPos()
32			{
33			mFpm = fpmLinePos;
34			mLine = 1;
35			mPos = 1;
36			mOffset = 0;
37			}
38
39			void ForthPos::copy(ForthPos &p)
40			{
41			mFpm = p.mFpm;
42			mLine = p.mLine;
43			mPos = p.mPos;
44			mOffset = p.mOffset;
45			}
46
47			int ForthPos::toString(char *buf, int buflen) const
48			{
49			if (mFpm == fpmOffset) {
50			return ht_snprintf(buf, buflen, "%08x", mOffset);
51			} else {
52			return ht_snprintf(buf, buflen, "%d:%d", mLine, mPos);
53			}
54			}
55
56			void ForthPos::clearPos()
57			{
58			mPos = 0;
59			}
60
61			void ForthPos::setMode(ForthPosMode fpm)
62			{
63			mFpm = fpm;
64			}
65
66			void ForthPos::setLinePos(int line, int pos)
67			{
68			mLine = line;
69			mPos = pos;
70			}
71
72			void ForthPos::setOffset(uint32 offset)
73			{
74			mOffset = offset;
75			}
76
77			void ForthPos::inc()
78			{
79			if (mFpm == fpmOffset) {
80			mOffset++;
81			} else {
82			mPos++;
83			}
84			}
85
86			void ForthPos::inc(int n)
87			{
88			if (mFpm == fpmOffset) {
89			mOffset+=n;
90			} else {
91			mPos+=n;
92			}
93			}
94
95			void ForthPos::incLine()
96			{
97			mLine++;
98			}
99
100			ForthException::ForthException()
101			{
102			}
103
104			ForthInterpreterException::ForthInterpreterException(ForthPos &pos, const char *msg, ...)
105			{
106			char estr2[120];
107			va_list va;
108			va_start(va, msg);
109			ht_vsnprintf(estr2, sizeof estr2, msg, va);
110			va_end(va);
111			ht_snprintf(estr, sizeof estr, "%s: %s at %y", "Interpreter Exception", estr2, &pos);
112			}
113
114			ForthRunException::ForthRunException(ForthPos &pos, const char *msg, ...)
115			{
116			char estr2[120];
117			va_list va;
118			va_start(va, msg);
119			ht_vsnprintf(estr2, sizeof estr2, msg, va);
120			va_end(va);
121			ht_snprintf(estr, sizeof estr, "%s: %s at %y", "Run Exception", estr2, &pos);
122			}
123
124			/*
125			*
126			*/
127			#define STRING_BUFFER_SIZE 120
128			ForthVM::ForthVM()
129			{
130			codestack = new Stack(true);
131			datastack = new Stack(true);
132			mGlobalVocalbulary = new AVLTree(true);
133			promMalloc(STRING_BUFFER_SIZE, mStringBufferEA[0], (void**)&(mStringBuffer[0]));
134			promMalloc(STRING_BUFFER_SIZE, mStringBufferEA[1], (void**)&(mStringBuffer[1]));
135			mStringBufferIdx = 0;
136			mFCodeBuffer = new String();
137			mFCodeBufferIdx = 0;
138			forth_build_vocabulary(mGlobalVocalbulary, this);
139
140			forth_disassemble(*this);
141			}
142
143			ForthVM::~ForthVM()
144			{
145			delete datastack;
146			delete codestack;
147			delete mGlobalVocalbulary;
148			}
149
150			void ForthVM::emitFCode(uint32 fcode)
151			{
152			if (fcode > 0xfff \|\| (fcode >= 0x01 && fcode <= 0x0f)) {
153			throw ForthInterpreterException(mErrorPos, "internal: broken fcode %x", fcode);
154			}
155			if (fcode > 0xff) {
156			emitFCodeByte(fcode>>8);
157			}
158			emitFCodeByte(fcode);
159			}
160
161			void ForthVM::emitFCodeByte(byte b)
162			{
163			*mFCodeBuffer += (char)b;
164			}
165
166			byte ForthVM::getFCodeByte()
167			{
168			if (mFCodeBufferIdx >= mFCodeBuffer->length()) throw ForthRunException(mErrorPos, "unexpected end of program");
169			return (*mFCodeBuffer)[mFCodeBufferIdx++];
170			}
171
172			uint32 ForthVM::getFCode()
173			{
174			uint32 fcode = getFCodeByte();
175			if (fcode >= 0x01 && fcode <= 0x0f) {
176			fcode <<= 8;
177			fcode \|= getFCodeByte();
178			}
179			return fcode;
180			}
181
182			int ForthVM::outf(const char *m, ...)
183			{
184			char b[1024];
185			va_list va;
186			va_start(va, m);
187			int a = ht_vsnprintf(b, sizeof b, m, va);
188			va_end(va);
189			gDisplay->print(b);
190			return a;
191			}
192
193			bool ForthVM::getChar()
194			{
195			if (input->read(&currentChar, 1) != 1) {
196			// ht_printf("getChar: false\n");
197			return false;
198			}
199			if (currentChar == 10) {
200			mPos.incLine();
201			mPos.clearPos();
202			}
203			mPos.inc();
204			// ht_printf("getChar: %d '%c'\n", currentChar, currentChar);
205			return true;
206			}
207
208			String &ForthVM::getToken(const String &delimiters)
209			{
210
211			}
212
213			bool ForthVM::consumeSpace(bool except)
214			{
215			return false;
216			}
217
218			bool ForthVM::skipWhite()
219			{
220			do {
221			switch (currentChar) {
222			case 9:
223			case ' ':
224			if (!getChar()) return false;
225			continue;
226			}
227			} while (0);
228			return true;
229			}
230
231			bool ForthVM::skipWhiteCR()
232			{
233			while (currentChar == ' ' \|\| currentChar == 10 \|\| currentChar == 13 \|\| currentChar == 9) {
234			if (!getChar()) return false;
235			}
236			return true;
237			}
238
239			void ForthVM::interprete(Stream &in, Stream &out)
240			{
241			input = &in;
242			output = &out;
243			mPos.setLinePos(1, 1);
244			mPos.setMode(fpmLinePos);
245			if (!getChar()) return;
246			mMode = fmInterprete;
247			while (1) {
248			// get a token
249			if (!skipWhiteCR()) break;
250			int i=0;
251			mErrorPos.copy(mPos);
252			do {
253			if (i==sizeof mCurToken) throw ForthInterpreterException(mErrorPos, "token too long");
254			mCurToken[i++] = currentChar;
255			if (!getChar()) break;
256			if (currentChar==9 \|\| currentChar==10 \|\| currentChar==13 \|\| currentChar==' ') {
257			break;
258			}
259			} while (1);
260			mCurToken[i] = 0;
261			ForthWordBuildIn fwbi(mCurToken, 0, NULL);
262			ForthWord fw = (ForthWord)mGlobalVocalbulary->get(mGlobalVocalbulary->find(&fwbi));
263			if (fw) {
264			if (mMode == fmCompile) {
265			fw->compile(*this);
266			} else {
267			fw->interprete(*this);
268			}
269			} else {
270			throw ForthInterpreterException(mErrorPos, "unkown word '%s'", mCurToken);
271			}
272			}
273			}
274
275			/*
276			* data stack
277			*/
278			void ForthVM::dataPush(uint32 value)
279			{
280			datastack->push(new UInt(value));
281			}
282
283			uint32 ForthVM::dataPop()
284			{
285			UInt u = (UInt)datastack->pop();
286			if (!u) {
287			throw ForthRunException(mErrorPos, "Stack underflow");
288			}
289			return u->value;
290			}
291
292			bool ForthVM::dataEmpty()
293			{
294			return datastack->isEmpty();
295			}
296
297			uint32 ForthVM::dataGet(uint n)
298			{
299			UInt *u;
300			if (datastack->isEmpty() \|\| !((u = (UInt)(datastack)[datastack->count() - n - 1]))) {
301			throw ForthRunException(mErrorPos, "Stack underflow");
302			}
303			return u->value;
304			}
305
306			void ForthVM::dataClear()
307			{
308			datastack->delAll();
309			}
310
311			uint32 ForthVM::dataDepth()
312			{
313			return datastack->count();
314			}
315
316			void *ForthVM::dataStr(uint32 u, bool exc)
317			{
318			void *p = NULL;//prom_mem_eaptr(u);
319			if (!p) throw ForthRunException(mErrorPos, "invalid address");
320			return p;
321			}
322
323			/*
324			* code stack
325			*/
326			void ForthVM::codePush(uint32 value)
327			{
328			codestack->push(new UInt(value));
329			}
330
331			uint32 ForthVM::codePop()
332			{
333			UInt u = (UInt)codestack->pop();
334			if (!u) {
335			throw ForthRunException(mErrorPos, "Codestack underflow");
336			}
337			return u->value;
338			}
339
340			bool ForthVM::codeEmpty()
341			{
342			return codestack->isEmpty();
343			}
344
345			uint32 ForthVM::codeGet(uint n)
346			{
347			UInt *u;
348			if (codestack->isEmpty() \|\| !((u = (UInt)(codestack)[codestack->count() - n - 1]))) {
349			throw ForthRunException(mErrorPos, "Codestack underflow");
350			}
351			return u->value;
352			}
353
354			void ForthVM::codeClear()
355			{
356			codestack->delAll();
357			}
358
359			uint32 ForthVM::codeDepth()
360			{
361			return codestack->count();
362			}
363
364			/*
365			* memory
366			*/
367			void ForthVM::promMalloc(uint32 size, uint32 &ea, void **p)
368			{
369			// ea = prom_mem_malloc(size);
370			// *p = prom_mem_ptr(ea);
371			// ea = prom_mem_phys_to_virt(ea);
372			}
373
374			/*
375			*
376			*/
377			ForthWord::ForthWord(const char *n)
378			:Object()
379			{
380			mName = strdup(n);
381			}
382
383			ForthWord::~ForthWord()
384			{
385			free(mName);
386			}
387
388			int ForthWord::compareTo(const Object *obj) const
389			{
390			return strcmp(mName, ((ForthWord*)obj)->mName);
391			}
392
393			void ForthWord::compile(ForthVM &vm)
394			{
395			throw ForthInterpreterException(vm.mErrorPos, "internal: no compile method for '%s'", mName);
396			}
397
398			uint32 ForthWord::getExecToken(ForthVM &vm)
399			{
400			throw ForthInterpreterException(vm.mErrorPos, "cannot tick '%s'", mName);
401			}
402
403			void ForthWord::interprete(ForthVM &vm)
404			{
405			throw ForthInterpreterException(vm.mErrorPos, "internal: no interprete method for %s", mName);
406			}
407
408			int ForthWord::toString(char *buf, int buflen) const
409			{
410			return ht_snprintf(buf, buflen, "[WORD:'%s']", mName);
411			}
412
413			ForthWordBuildIn::ForthWordBuildIn(const char *name, uint32 fcode, FCodeFunction func)
414			:ForthWord(name)
415			{
416			mFCode = fcode;
417			mFunc = func;
418			}
419
420			void ForthWordBuildIn::compile(ForthVM &vm)
421			{
422			vm.emitFCode(mFCode);
423			}
424
425			uint32 ForthWordBuildIn::getExecToken(ForthVM &vm)
426			{
427			return mFCode;
428			}
429
430			void ForthWordBuildIn::interprete(ForthVM &vm)
431			{
432			mFunc(vm);
433			}
434
435			/*
436			*
437			*/
438
439			ForthWordAlias::ForthWordAlias(const char *name, int n, ...)
440			:ForthWord(name)
441			{
442			va_list ap;
443			mFCodes = (uint16)malloc(nsizeof (uint16));
444			for (int i=0; i<n; i++) {
445			mFCodes[i] = va_arg(ap, int);
446			}
447			va_end(ap);
448			mNumFCodes = n;
449			}
450
451			void ForthWordAlias::compile(ForthVM &vm)
452			{
453			for (int i=0; i<mNumFCodes; i++) {
454			vm.emitFCode(mFCodes[i]);
455			}
456			}
457
458			void ForthWordAlias::interprete(ForthVM &vm)
459			{
460			}
461
462			/*
463			*
464			*/
465			ForthWordString::ForthWordString(const char *name, ForthWordStringType fwst)
466			:ForthWord(name)
467			{
468			mFwst = fwst;
469			}
470
471			void ForthWordString::compile(ForthVM &vm)
472			{
473			}
474
475			String &ForthWordString::get(ForthVM &vm, String &s)
476			{
477			s = "";
478			if (vm.currentChar == 10 \|\| vm.currentChar == 13) return s;
479			while (1) {
480			if (!vm.getChar()) throw ForthInterpreterException(vm.mErrorPos, "unterminated string");
481			switch (mFwst) {
482			case fwstString:
483			case fwstStringPrint:
484			if (vm.currentChar=='"') {
485			vm.getChar();
486			return s;
487			}
488			break;
489			case fwstStringWithHex:
490			if (vm.currentChar=='"') {
491			if (!vm.getChar()) return s;
492			if (vm.currentChar=='(') {
493			// start hex mode and wait for ')'
494			} else {
495			return s;
496			}
497			}
498			break;
499			case fwstStringPrintBracket:
500			if (vm.currentChar==')') {
501			vm.getChar();
502			return s;
503			}
504			break;
505			}
506			s += vm.currentChar;
507			}
508			}
509
510			void ForthWordString::interprete(ForthVM &vm)
511			{
512			String s;
513			get(vm, s);
514			switch (mFwst) {
515			case fwstString:
516			case fwstStringWithHex: {
517			int len = s.length();
518			memmove(vm.mStringBuffer[vm.mStringBufferIdx], s.content(), MIN(len, STRING_BUFFER_SIZE));
519			vm.dataPush(vm.mStringBufferEA[vm.mStringBufferIdx]);
520			vm.dataPush(len);
521			vm.mStringBufferIdx ^= 1;
522			break;
523			}
524			case fwstStringPrint:
525			case fwstStringPrintBracket:
526			vm.outf("%y", &s);
527			break;
528			}
529			}
530
531			ForthVar::ForthVar(const char *name, uint32 address)
532			: ForthWord(name)
533			{
534			}
535
536			void ForthVar::compile(ForthVM &vm)
537			{
538			}
539
540			uint32 ForthVar::getExecToken(ForthVM &vm)
541			{
542			}
543
544			void ForthVar::interprete(ForthVM &vm)
545			{
546			}
547