/[pearpc]/src/io/prom/forth.cc
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /src/io/prom/forth.cc

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Wed Sep 5 17:11:21 2007 UTC (16 years, 6 months ago) by dpavlin
File size: 10146 byte(s)
import upstream CVS
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(n*sizeof (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

  ViewVC Help
Powered by ViewVC 1.1.26