?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Replaced deprecated variables CONTRIBDIR, BINDIR and
[AROS-Contrib.git] / rexx / src / interpre.c
blob1b45d6c116ac34b5ebaa8e979882b7d51c150655
1 /*
2 * $Header$
3 * $Log$
4 * Revision 1.1 2001/04/04 05:43:39 wang
5 * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
6 *
7 * Revision 1.8 1999/11/26 13:13:47 bnv
8 * Added: Windows CE support
9 * Changed: To use the new macros.
10 *
11 * Revision 1.7 1999/06/10 14:08:35 bnv
12 * When a called procedure with local variables returne a variable
13 * the variable contents was freed first before copied to the RESULT.
14 *
15 * Revision 1.6 1999/05/14 12:31:22 bnv
16 * Minor changes
17 *
18 * Revision 1.5 1999/03/15 15:21:36 bnv
19 * Corrected to handle the error_trace
20 *
21 * Revision 1.4 1999/03/15 09:01:57 bnv
22 * Corrected: error_trace
23 *
24 * Revision 1.3 1999/03/10 16:53:32 bnv
25 * Added MSC support
26 *
27 * Revision 1.2 1999/03/01 10:54:37 bnv
28 * Corrected: To clean correctly the RxStck after an interpret_mn
29 *
30 * Revision 1.1 1998/07/02 17:34:50 bnv
31 * Initial revision
32 *
33 */
34
35 #define __INTERPRET_C__
36
37 #ifndef WCE
38 # include <stdio.h>
39 # include <signal.h>
40 #endif
41
42 #include <bmem.h>
43
44 #include <lerror.h>
45 #include <lstring.h>
46
47 #include <rexx.h>
48 #include <stack.h>
49 #include <trace.h>
50 #include <bintree.h>
51 #include <compile.h>
52 #include <interpre.h>
53
54 #ifdef WCE
55 # define MAX_EVENT_COUNT 50
56 #endif
57
58 /* ---------------- global variables ------------------ */
59 int _trace; /* if trace is enabled */
60 PLstr RxStck[STCK_SIZE]; /* Array of PLstr */
61 int RxStckTop; /* top item of stack */
62 Lstr _tmpstr[STCK_SIZE]; /* temporary strings */
63
64 /*extern int _interrupt;*/ /* if any interrupt is pending */
65 /*void ProcessInterrupt();*/
66
67 /* ---------------- Local variables ------------------- */
68 static Scope VarScope; /* Variables Scope */
69 static PLstr ToParse; /* Parsing variables */
70 static int DataStart,
71 DataEnd,
72 BreakStart,
73 BreakEnd,
74 SourceEnd; /* Length of string+1 */
75
76
77 static jmp_buf old_error; /* keep old value of errortrap */
78
79 extern Lstr stemvaluenotfound; /* from variable.c */
80
81 #ifdef __DEBUG__
82 # define DEBUGDISPLAY0(a) if (__debug__) printf("\t%u\t%s\n",inst_ip,(a))
83 # define DEBUGDISPLAY0nl(a) if (__debug__) printf("\t%u\t%s\t",inst_ip,(a))
84 # define DEBUGDISPLAY(a) if (__debug__) {printf("\t%u\t%s\t\"",inst_ip,(a)); \
85 Lprint(STDOUT,RxStck[RxStckTop]); printf("\"\n"); }
86 # define DEBUGDISPLAYi(a,b) if (__debug__) {printf("\t%u\t%s\t\"",inst_ip,(a)); \
87 Lprint(STDOUT,(b)); printf("\"\n"); }
88 # define DEBUGDISPLAY2(a) if (__debug__) {printf("\t%u\t%s\t\"",inst_ip,(a)); \
89 Lprint(STDOUT,RxStck[RxStckTop-1]); printf("\",\""); \
90 Lprint(STDOUT,RxStck[RxStckTop]);printf("\"\n"); }
91
92 int instr_cnt[256]; /* instruction counter */
93 #else
94 # define DEBUGDISPLAY0(a)
95 # define DEBUGDISPLAY0nl(a)
96 # define DEBUGDISPLAY(a)
97 # define DEBUGDISPLAYi(a,b)
98 # define DEBUGDISPLAY2(a)
99 #endif
100
101 #define CHKERROR if (RxStckTop==STCK_SIZE-1) Lerror(ERR_STORAGE_EXHAUSTED,0)
102 #define INCSTACK { RxStckTop++; CHKERROR; }
103 #define POP_C_POP_B_PEEK_A { POP(C); POP(B); PEEK(A); }
104 #define PEEK(x) x = &(RxStck[RxStckTop])
105 #define PEEKR(x,r) x = &(RxStck[RxStckTop-(r)])
106 #define POP(x) x = &(RxStck[RxStckTop--])
107 #define PUSH(x) {x = &(RxStck[++RxStckTop]); CHKERROR; }
108
109 #ifndef ALIGN
110 # define PLEAF(x) { x = (PBinLeaf)(*(dword*)Rxcip); \
111 Rxcip += sizeof(dword); }
112 # define INCWORD(x) (x) += sizeof(word)
113 # define INCDWORD(x) (x) += sizeof(dword)
114 # define CWORD word
115 #else
116 # define PLEAF(x) x = (PBinLeaf)(*Rxcip++)
117 # define INCWORD(x) (x)++
118 # define INCDWORD(x) (x)++
119 # define CWORD dword
120 #endif
121
122 /* ---------------- RxProcResize ---------------- */
123 void
124 RxProcResize( void )
125 {
126 size_t oldsize=_Proc_size;
127
128 _Proc_size += PROC_INC;
129 _Proc = (RxProc*) REALLOC( _Proc, _Proc_size * sizeof(RxProc) );
130 MEMSET(_Proc+oldsize,0,PROC_INC*sizeof(RxProc));
131 } /* RxProcResize */
132
133 /* ------------- I_trigger_space -------------- */
134 static void
135 I_trigger_space( void )
136 {
137 /* normalise to 0 .. len-1 */
138 DataStart = BreakEnd-1;
139
140 /* skip leading spaces */
141 LSKIPBLANKS(*ToParse,DataStart);
142
143 /* find word */
144 BreakStart = DataStart;
145 LSKIPWORD(*ToParse,BreakStart);
146
147 /* skip trailing spaces */
148 BreakEnd = BreakStart;
149 LSKIPBLANKS(*ToParse,BreakEnd);
150
151 /* again in rexx strings 1..len */
152 DataStart++;
153 BreakStart++;
154 BreakEnd++;
155 } /* I_trigger_space */
156
157 /* ------------- I_trigger_litteral -------------- */
158 static void
159 I_trigger_litteral(const PLstr lit)
160 {
161 int PatternPos;
162
163 PatternPos = (int)Lpos(lit,ToParse,DataStart);
164 if (PatternPos>0) {
165 BreakStart = PatternPos;
166 BreakEnd = PatternPos + LLEN(*lit);
167 } else { /* the rest of the source is selected */
168 DataStart = BreakEnd;
169 BreakStart = SourceEnd;
170 BreakEnd = SourceEnd;
171 }
172 } /* I_trigger_litteral */
173
174 /* ----------------- I_LoadOption ---------------- */
175 static void
176 I_LoadOption( const PLstr value, const int opt )
177 {
178 char *ch;
179
180 switch (opt) {
181 case environment_opt:
182 Lstrcpy(value,_Proc[_rx_proc].env);
183 break;
184
185 case digits_opt:
186 Licpy(value,_Proc[_rx_proc].digits);
187 break;
188
189 case fuzz_opt:
190 Licpy(value,_Proc[_rx_proc].fuzz);
191 break;
192
193 case form_opt:
194 Lscpy(value,(_Proc[_rx_proc].form)?"SCIENTIFIC":"ENGINEERING");
195 break;
196
197 case author_opt:
198 Lscpy(value,AUTHOR);
199 break;
200
201 case version_opt:
202 Lscpy(value,VERSION);
203 break;
204
205 case os_opt:
206 Lscpy(value,OS);
207 break;
208
209 case calltype_opt:
210 switch (_Proc[_rx_proc].calltype) {
211 case CT_PROCEDURE:
212 Lscpy(value,"PROCEDURE");
213 break;
214 case CT_FUNCTION:
215 Lscpy(value,"FUNCTION");
216 break;
217 default:
218 Lscpy(value,"COMMAND");
219 }
220 break;
221
222 case filename_opt:
223 Lstrcpy(value,&(CompileClause[0].fptr)->filename);
224 break;
225
226 case prgname_opt:
227 Lscpy(value,_prgname);
228 break;
229
230 case shell_opt:
231 #ifndef WCE
232 ch = getenv(SHELL);
233 if (ch)
234 Lscpy(value,ch);
235 else
236 #endif
237 LZEROSTR(*value);
238 break;
239
240 default:
241 Lerror(ERR_INTERPRETER_FAILURE,0);
242 }
243 } /* I_LoadOption */
244
245 /* ----------------- I_StoreOption --------------- */
246 static void
247 I_StoreOption( const PLstr value, const int opt )
248 {
249 long l;
250
251 switch (opt) {
252 case environment_opt:
253 if (LLEN(*value) > 250)
254 Lerror(ERR_ENVIRON_TOO_LONG,1,value);
255 if (_Proc[_rx_proc].env == _Proc[_rx_proc-1].env)
256 LPMALLOC(_Proc[_rx_proc].env);
257 Lstrcpy(_Proc[_rx_proc].env,value);
258 break;
259
260 case trace_opt:
261 TraceSet(value);
262 if (_Proc[_rx_proc].trace &
263 (normal_trace | off_trace | error_trace))
264 _trace = FALSE;
265 else
266 _trace = TRUE;
267
268 break;
269
270 case digits_opt:
271 if (LLEN(*value)==0)
272 _Proc[_rx_proc].digits = LMAXNUMERICDIGITS;
273 else {
274 l = Lrdint(value);
275 if (l <= 0)
276 Lerror(ERR_INVALID_INTEGER,5,value);
277 _Proc[_rx_proc].digits = (int)l;
278 }
279 lNumericDigits = MIN(_Proc[_rx_proc].digits,LMAXNUMERICDIGITS);
280 if (_Proc[_rx_proc].digits <= _Proc[_rx_proc].fuzz)
281 Lerror(ERR_INVALID_RESULT,1);
282 break;
283
284 case fuzz_opt:
285 if (LLEN(*value)==0)
286 _Proc[_rx_proc].fuzz = 0;
287 else {
288 l = Lrdint(value);
289 if (l <= 0)
290 Lerror(ERR_INVALID_INTEGER,6,value);
291 _Proc[_rx_proc].fuzz = (int)l;
292 }
293 if (_Proc[_rx_proc].digits <= _Proc[_rx_proc].fuzz)
294 Lerror(ERR_INVALID_RESULT,1);
295 break;
296
297 case form_opt:
298 _Proc[_rx_proc].form = (int)Lrdint(value);
299 break;
300
301 case set_signal_opt:
302 case set_signal_name_opt:
303 switch (LSTR(*value)[0]) {
304 case 'E':
305 _Proc[_rx_proc].condition |= SC_ERROR;
306 if (opt==set_signal_name_opt)
307 _Proc[_rx_proc].lbl_error = RxStck[RxStckTop-1];
308 else
309 _Proc[_rx_proc].lbl_error = &(ErrorStr->key);
310 break;
311 case 'H':
312 _Proc[_rx_proc].condition |= SC_HALT;
313 if (opt==set_signal_name_opt)
314 _Proc[_rx_proc].lbl_halt = RxStck[RxStckTop-1];
315 else
316 _Proc[_rx_proc].lbl_halt = &(HaltStr->key);
317 break;
318 case 'N':
319 if (LSTR(*value)[2]=='V') {
320 _Proc[_rx_proc].condition |= SC_NOVALUE;
321 if (opt==set_signal_name_opt)
322 _Proc[_rx_proc].lbl_novalue = RxStck[RxStckTop-1];
323 else
324 _Proc[_rx_proc].lbl_novalue = &(NoValueStr->key);
325 } else {
326 _Proc[_rx_proc].condition |= SC_NOTREADY;
327 if (opt==set_signal_name_opt)
328 _Proc[_rx_proc].lbl_notready = RxStck[RxStckTop-1];
329 else
330 _Proc[_rx_proc].lbl_notready = &(NotReadyStr->key);
331 }
332 break;
333 case 'S':
334 _Proc[_rx_proc].condition |= SC_SYNTAX;
335 if (opt==set_signal_name_opt)
336 _Proc[_rx_proc].lbl_syntax = RxStck[RxStckTop-1];
337 else
338 _Proc[_rx_proc].lbl_syntax = &(SyntaxStr->key);
339 break;
340 default:
341 Lerror(ERR_INTERPRETER_FAILURE,0);
342 }
343 break;
344
345 case unset_signal_opt:
346 switch (LSTR(*value)[0]) {
347 case 'E':
348 _Proc[_rx_proc].condition &= ~SC_ERROR;
349 break;
350 case 'H':
351 _Proc[_rx_proc].condition &= ~SC_HALT;
352 break;
353 case 'N':
354 if (LSTR(*value)[2]=='V')
355 _Proc[_rx_proc].condition &= ~SC_NOVALUE;
356 else
357 _Proc[_rx_proc].condition &= ~SC_NOTREADY;
358 break;
359 case 'S':
360 _Proc[_rx_proc].condition &= ~SC_SYNTAX;
361 break;
362 default:
363 Lerror(ERR_INTERPRETER_FAILURE,0);
364 }
365 break;
366
367 default:
368 Lerror(ERR_INTERPRETER_FAILURE,0);
369 }
370 } /* I_StoreOption */
371
372 /* ---------------- I_MakeIntArgs ---------------- */
373 /* prepare arguments for an internal function call */
374 /* returns stack position after call */
375 #ifdef INLINE
376 inline
377 #endif
378 static int
379 I_MakeIntArgs( const int na, const int realarg, const word existarg )
380 {
381 int i,st;
382 word bp; /* bit position */
383
384 Rxarg.n = na;
385 bp = (1 << (na-1));
386
387 /* must doit reverse */
388 MEMSET(Rxarg.a,0,sizeof(Rxarg.a));
389
390 Rxarg.r = RxStck[RxStckTop-realarg];
391
392 st = RxStckTop; /* stack position of arguments */
393 for (i=na-1; i>=0; i--) {
394 if (existarg & bp) {
395 if (Rxarg.r == RxStck[st]) {
396 Lstrcpy(&(_tmpstr[st]),RxStck[st]);
397 Rxarg.a[i] = &_tmpstr[st];
398 } else
399 Rxarg.a[i] = RxStck[st];
400 st--;
401 }
402 bp >>= 1;
403 }
404 return st;
405 } /* I_MakeIntArgs */
406
407 /* ---------------- I_MakeArgs ---------------- */
408 /* prepare arguments for a call to a func */
409 #ifdef INLINE
410 inline
411 #endif
412 static void
413 I_MakeArgs( const int calltype, const int na, const word existarg )
414 {
415 int i,st;
416 word bp; /* bit position */
417 RxProc *pr;
418 Args *arg;
419
420 _rx_proc++; /* increase program items */
421
422 if (_rx_proc==_Proc_size) RxProcResize();
423 pr = _Proc+_rx_proc;
424
425 /* initialise pr structure */
426 /* use the old values */
427 MEMCPY(pr,_Proc+_rx_proc-1,sizeof(*pr));
428 pr->calltype = calltype;
429 pr->ip = (size_t)((byte huge *)Rxcip - (byte huge *)Rxcodestart);
430 pr->stacktop = RxStckTop;
431
432 /* setup arguments */
433 arg = &(pr->arg);
434 arg->n = na;
435
436 bp = (1 << (na-1));
437
438 /* must doit reverse */
439 MEMSET(arg->a,0,sizeof(arg->a));
440
441 st = RxStckTop; /* stack position of arguments */
442 for (i=na-1; i>=0; i--) {
443 if (existarg & bp) {
444 arg->a[i] = RxStck[st];
445 st--;
446 } else
447 arg->a[i] = NULL;
448 bp >>= 1;
449 }
450 arg->r = RxStck[st];
451
452 if (calltype==CT_FUNCTION)
453 pr->stack = st;
454 else
455 pr->stack = st-1;
456 } /* I_MakeArgs */
457
458 /* -------------- I_CallFunction ---------------- */
459 static int
460 I_CallFunction( void )
461 {
462 PBinLeaf leaf,litleaf;
463 RxFunc *func;
464 int ct,nargs,realarg,st;
465 CTYPE existarg, line;
466 Lstr cmd;
467 PLstr res;
468 #ifdef __DEBUG__
469 size_t inst_ip;
470 #endif
471
472 /* --- read the arguments here --- */
473 PLEAF(leaf); /* function number */
474 nargs = *(Rxcip++); /* number of args */
475 realarg = *(Rxcip++); /* real arguments */
476 existarg = *(CWORD *)Rxcip; /* existing arguments */
477 INCWORD(Rxcip);
478 line = *(CWORD *)Rxcip; /* SIGL line */
479 INCWORD(Rxcip);
480 ct = *(Rxcip++); /* call type */
481 func = (RxFunc *)(leaf->value);
482
483 #ifdef __DEBUG__
484 if (__debug__) {
485 int i;
486 for (i=0; i<LLEN(leaf->key); i++)
487 putchar(LSTR(leaf->key)[i]);
488 printf(" NoArgs=%d, Exist=%lX Type=%s\n",
489 nargs, existarg,(func->type==FT_BUILTIN)?"builtin":"other");
490 }
491 #endif
492
493 if (func->type == FT_BUILTIN) {
494 nargs = I_MakeIntArgs(nargs,realarg,existarg);
495 (func->builtin->func)(func->builtin->opt);
496 if (ct==CT_PROCEDURE) {
497 RxVarSet(VarScope,ResultStr,Rxarg.r);
498 RxStckTop = nargs-1; /* clear stack */
499 } else
500 RxStckTop = nargs;
501 return TRUE;
502 } else {
503 if (func->label == UNKNOWN_LABEL) {
504 #ifndef WCE
505 /* try an external function */
506 /***
507 /// First check to see if this prg exist with
508 /// the extension of the calling program
509 /// but this should be done in compiling time..
510 ***/
511 st = RxStckTop-realarg;
512 res = RxStck[st++];
513 LINITSTR(cmd);
514 Lstrcpy(&cmd,&(leaf->key));
515 while (st<=RxStckTop) {
516 Lcat(&cmd," ");
517 Lstrcat(&cmd,RxStck[st++]);
518 }
519 RxRedirectCmd(&cmd,FALSE,TRUE,res);
520 LFREESTR(cmd);
521 RxStckTop -= realarg;
522 #else
523 Lerror(ERR_INVALID_FUNCTION,0);
524 #endif
525 return TRUE;
526 } else {
527 Rxcip++;
528 RxSetSpecialVar(SIGLVAR,line);
529 I_MakeArgs(ct,nargs,existarg);
530 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart+func->label);
531 Rxcip++; /* skip the newclause_mn */
532 if (_trace) TraceClause();
533
534 /* handle proc_mn code */
535 if (*Rxcip == proc_mn) {
536 int exposed;
537
538 /* give a unique program id */
539 /* we might have a problem after 2*32 routine calls!! */
540 _procidcnt++;
541 _Proc[_rx_proc].id = _procidcnt;
542 Rx_id = _procidcnt;
543 #ifdef __DEBUG__
544 if (__debug__)
545 inst_ip = (size_t)((byte huge *)Rxcip - (byte huge *)Rxcodestart);
546 #endif
547 DEBUGDISPLAY0nl("PROC ");
548 Rxcip++;
549 _Proc[_rx_proc].scope = RxScopeMalloc();
550 VarScope = _Proc[_rx_proc].scope;
551
552 /* handle exposed variables */
553 exposed = *(Rxcip++);
554 #ifdef __DEBUG__
555 if (__debug__ && exposed>0)
556 printf("EXPOSE");
557 #endif
558 for (;exposed>0;exposed--) {
559 PLEAF(litleaf); /* Get pointer to variable */
560 #ifdef __DEBUG__
561 if (__debug__) {
562 putchar(' ');
563 Lprint(STDOUT,&(litleaf->key));
564 }
565 #endif
566 RxVarExpose(VarScope,litleaf);
567 }
568 #ifdef __DEBUG__
569 if (__debug__)
570 putchar('\n');
571 #endif
572 }
573 }
574 return FALSE;
575 }
576 } /* I_CallFunction */
577
578 /* ---------------- I_ReturnProc -------------- */
579 /* restore arguments after a procedure return */
580 static void
581 I_ReturnProc( void )
582 {
583 /* fix ip and stack */
584 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + _Proc[_rx_proc].ip);
585 RxStckTop = _Proc[_rx_proc].stack;
586
587 if (_rx_proc>0) {
588 /* free everything that it is new */
589 if (VarScope!=_Proc[_rx_proc-1].scope) {
590 RxScopeFree(VarScope);
591 FREE(VarScope);
592 }
593
594 if (_Proc[_rx_proc].env != _Proc[_rx_proc-1].env)
595 LPFREE(_Proc[_rx_proc].env);
596 }
597
598 /* load previous data and exit */
599 _rx_proc--;
600 Rx_id = _Proc[_rx_proc].id;
601 VarScope = _Proc[_rx_proc].scope;
602 lNumericDigits = _Proc[_rx_proc].digits;
603
604 if (_Proc[_rx_proc].trace & (normal_trace | off_trace | error_trace))
605 _trace = FALSE;
606 else
607 _trace = TRUE;
608 } /* I_ReturnProc */
609
610 /* ------------ RxInitInterStr -------------- */
611 void
612 RxInitInterStr()
613 {
614 RxProc *pr;
615
616 _rx_proc++; /* increase program items */
617 if (_rx_proc==_Proc_size) RxProcResize();
618 pr = _Proc+_rx_proc;
619
620 /* program id is the same */
621 MEMCPY(pr,_Proc+_rx_proc-1,sizeof(*pr));
622 pr->calltype = CT_INTERPRET;
623 pr->ip = (size_t)((byte huge *)Rxcip - (byte huge *)Rxcodestart);
624 pr->codelen = LLEN(*_code);
625 pr->clauselen = CompileCurClause;
626 pr->stack = RxStckTop-1; /* before temporary str */
627 pr->stacktop = RxStckTop;
628
629 /* setup arguments */
630 (pr->arg).n = 0;
631 MEMSET(pr->arg.a,0,sizeof(pr->arg.a));
632 (pr->arg).r = NULL;
633
634 /* --- save state --- */
635 MEMCPY(old_error,_error_trap,sizeof(_error_trap));
636 SIGNAL(SIGINT,SIG_IGN);
637
638 /* compile the program */
639 RxInitCompile(rxfile,RxStck[RxStckTop]);
640 RxCompile();
641
642 /* --- restore state --- */
643 MEMCPY(_error_trap,old_error,sizeof(_error_trap));
644 SIGNAL(SIGINT,RxHaltTrap);
645
646 /* might have changed position */
647 Rxcodestart = (CIPTYPE*)LSTR(*_code);
648 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + pr->codelen);
649
650 /* check for an error in compilation */
651 if (RxReturnCode) {
652 /* --- load previous data and exit ---- */
653 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + pr->ip);
654 _rx_proc--;
655 Rx_id = _Proc[_rx_proc].id;
656 VarScope = _Proc[_rx_proc].scope;
657
658 RxSetSpecialVar(RCVAR,RxReturnCode);
659 RxSignalCondition(SC_SYNTAX);
660 }
661 } /* RxInitInterStr */
662
663 /* ------------ RxDoneInterStr -------------- */
664 static void
665 RxDoneInterStr( void )
666 {
667 /* fix ip and stack */
668 if (_Proc[_rx_proc].calltype == CT_INTERACTIVE) {
669 if (_Proc[_rx_proc].trace &
670 (normal_trace | off_trace | error_trace))
671 _trace = FALSE;
672 else
673 _trace = TRUE;
674 }
675
676 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + _Proc[_rx_proc].ip);
677 RxStckTop = _Proc[_rx_proc].stack;
678
679 /* fixup code length, cut the interpretation code */
680 LLEN(*_code) = _Proc[_rx_proc].codelen;
681 CompileCurClause = _Proc[_rx_proc].clauselen;
682 if (_Proc[_rx_proc].env != _Proc[_rx_proc-1].env) {
683 Lstrcpy(_Proc[_rx_proc-1].env, _Proc[_rx_proc].env);
684 LPFREE(_Proc[_rx_proc].env);
685 }
686
687 /* --- load previous data and exit ---- */
688 _rx_proc--;
689 Rx_id = _Proc[_rx_proc].id;
690
691 _Proc[_rx_proc].trace = _Proc[_rx_proc+1].trace;
692 _Proc[_rx_proc].interactive_trace = _Proc[_rx_proc+1].interactive_trace;
693 VarScope = _Proc[_rx_proc].scope;
694 } /* RxDoneInterStr */
695
696 /* ---------------- RxInitInterpret --------------- */
697 void
698 RxInitInterpret( void )
699 {
700 int i;
701
702 #ifdef __DEBUG__
703 MEMSET(instr_cnt,sizeof(instr_cnt),0);
704 #endif
705 MEMSET(RxStck,0,(STCK_SIZE)*sizeof(PLstr));
706 RxStckTop = -1;
707 MEMSET(_tmpstr,0,(STCK_SIZE)*sizeof(Lstr));
708 for (i=0; i<STCK_SIZE;i++) {
709 Lfx(&(_tmpstr[i]),0);
710 if (!LSTR(_tmpstr[i])) Lerror(ERR_STORAGE_EXHAUSTED,0);
711 }
712 } /* RxInitInterpret */
713
714 /* ---------------- RxDoneInterpret --------------- */
715 void
716 RxDoneInterpret( void )
717 {
718 int i;
719 #ifdef __DEBUG__
720 FILE *fout;
721 fout = fopen("instr.cnt","w");
722 fprintf(fout,"Instr\tCount\n");
723 for (i=0; i<pow_mn; i++) /* pow is the last command */
724 fprintf(fout,"%d\t%d\n",i,instr_cnt[i]);
725 fclose(fout);
726
727 if (RxStckTop>=0)
728 fprintf(STDERR,"interpret: Something left in stack %d\n", RxStckTop);
729 #endif
730
731 /* clear stack */
732 for (i=0; i<STCK_SIZE; i++) {
733 #ifdef __DEBUG__
734 if (__debug__ && LLEN(_tmpstr[i])) {
735 fprintf(STDERR,"Freeing... %d: \"",i);
736 Lprint(STDERR,&(_tmpstr[i]));
737 fprintf(STDERR,"\"\n");
738 }
739 #endif
740 LFREESTR(_tmpstr[i]);
741 }
742 } /* RxDoneInterpret */
743
744 /* ---------------- RxInterpret --------------- */
745 int
746 RxInterpret( void )
747 {
748 PLstr a=NULL;
749 IdentInfo *inf;
750 byte na,nf;
751 CTYPE w;
752 int jc, errno, subno, found;
753 PBinLeaf litleaf,leaf;
754 RxFunc *func;
755 #ifdef __DEBUG__
756 size_t inst_ip;
757 char cmd='\n';
758 int i;
759 #endif
760 #ifdef WCE
761 int event_count = 0;
762 #endif
763 RxReturnCode = 0;
764 Rx_id = _Proc[_rx_proc].id;
765
766 Rxcodestart = (CIPTYPE*)LSTR(*_code);
767 VarScope = _Proc[_rx_proc].scope;
768 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + _Proc[_rx_proc].ip);
769 _Proc[_rx_proc].stack = RxStckTop;
770
771 if (_Proc[_rx_proc].trace & (normal_trace | off_trace | error_trace))
772 _trace = FALSE;
773 else
774 _trace = TRUE;
775
776 SIGNAL(SIGINT,RxHaltTrap);
777
778 if ((jc=setjmp(_error_trap))!=0) {
779 CIPTYPE *tmp_Rxcip;
780
781 if (jc==JMP_EXIT) {
782 RxStckTop = -1;
783 goto interpreter_fin;
784 }
785 /* else if (jc==JMP_CONTINUE) .... CONTINUE code */
786
787 /* exit from interpret, if we are in any */
788 tmp_Rxcip = Rxcip;
789 while (_Proc[_rx_proc].calltype==CT_INTERPRET)
790 RxDoneInterStr();
791 Rxcip = tmp_Rxcip;
792
793 /* clear stack */
794 RxStckTop = _Proc[_rx_proc].stacktop;
795 }
796
797 while (1) {
798 main_loop:
799
800 #ifdef __DEBUG__
801 if (__debug__) {
802 while (1) {
803 cmd = getchar();
804 switch (l2u[(byte)cmd]) {
805 case 'M':
806 printf("Memory allocated=%ld\n",
807 mem_allocated());
808 break;
809 case 'S':
810 if (RxStckTop<0)
811 printf("Stack is empty\n");
812 else
813 for (i=RxStckTop; i>=0; i--) {
814 printf("#%d: \"",i);
815 Lprint(STDOUT,RxStck[i]);
816 printf("\"\n");
817 }
818 break;
819 case 'Q':
820 goto interpreter_fin;
821 case '\n':
822 goto outofcmd;
823 }
824 }
825 outofcmd:
826 printf("Stck:%d\t",RxStckTop+1);
827 inst_ip = (size_t)((byte huge *)Rxcip - (byte huge *)Rxcodestart);
828 }
829 instr_cnt[(int)*Rxcip]++;
830 #endif
831 switch (*(Rxcip++)) {
832 /*
833 * [mnemonic] <type>[value]...
834 * type: b = byte
835 * w = word
836 * p = pointer
837 */
838 /* START A NEW COMMAND */
839 case newclause_mn:
840 DEBUGDISPLAY0("NEWCLAUSE");
841 if (_trace) TraceClause();
842 #ifdef WCE
843 /* Check for messages in the event queue */
844 if (++event_count == MAX_EVENT_COUNT) {
845 event_count = 0;
846 /* Peek the stacked events */
847 WKeyPressed();
848 /*// if (_interrupt) ProcessInterrupt(); */
849 }
850 #endif
851 goto main_loop;
852
853 /* POP = NO OPERATION */
854 case nop_mn:
855 DEBUGDISPLAY0("NOP");
856 goto main_loop;
857
858 /* PUSH p[lit] */
859 /* push a litteral to stack */
860 case push_mn:
861 RxStckTop++;
862 RxStck[RxStckTop] = (PLstr)(*(dword*)Rxcip);
863 INCDWORD(Rxcip);
864 CHKERROR;
865 DEBUGDISPLAY("PUSH");
866 goto chk4trace;
867
868 /* PUSHTMP */
869 case pushtmp_mn:
870 RxStckTop++;
871 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
872 CHKERROR;
873 DEBUGDISPLAY0("PUSHTMP");
874 goto main_loop;
875
876 /* POP b[num] */
877 /* pop NUM stack items */
878 case pop_mn:
879 DEBUGDISPLAY0("POP");
880 RxStckTop -= *(Rxcip++);
881 goto main_loop;
882
883 /* DUP b[rel] */
884 /* duplicate RELative stck item */
885 case dup_mn:
886 RxStckTop++;
887 RxStck[RxStckTop] = RxStck[RxStckTop-*(Rxcip++)-1];
888 CHKERROR;
889 DEBUGDISPLAY("DUP");
890 goto main_loop;
891
892 /* COPY */
893 /* copy (Lstrcpy) top item */
894 /* to previous one */
895 case copy_mn:
896 DEBUGDISPLAY("COPY");
897 Lstrcpy(RxStck[RxStckTop-1],RxStck[RxStckTop]);
898 RxStckTop -= 2;
899 goto main_loop;
900
901 /* COPY2TMP */
902 /* if top item is not a pointer */
903 /* to a tmp var then copy the */
904 /* value to a tmp var */
905 case copy2tmp_mn:
906 /* copy to temporary only if different */
907 if (RxStck[RxStckTop] != &(_tmpstr[RxStckTop])) {
908 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
909 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
910 }
911 DEBUGDISPLAY("COPY2TMP");
912 goto main_loop;
913
914 /* PATCH w[rel] b[code] */
915 /* patch CODE string to RELative pos with CODE */
916 case patch_mn:
917 w = *(CWORD *)Rxcip; INCWORD(Rxcip);
918 *(CIPTYPE*)((byte huge *)Rxcodestart + w) = *(Rxcip++);
919 DEBUGDISPLAY0("PATCH");
920 goto main_loop;
921
922 /* RAISE b[cond] b[errno] b[subno] */
923 /* raise an error condition */
924 case raise_mn:
925 errno = *(Rxcip++);
926 subno = *(Rxcip++);
927 DEBUGDISPLAY("RAISE");
928 Lerror(errno,subno,RxStck[RxStckTop]);
929 goto main_loop;
930
931 /* LOADARG b[arg] */
932 /* push an ARGument to stck */
933 case loadarg_mn:
934 INCSTACK;
935 na = *(Rxcip++); /* argument to push */
936 if (_Proc[_rx_proc].arg.a[na])
937 RxStck[RxStckTop] = _Proc[_rx_proc].arg.a[na];
938 else {
939 LZEROSTR(_tmpstr[RxStckTop]);
940 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
941 }
942 DEBUGDISPLAY("LOADARG");
943 goto main_loop;
944
945
946 /* LOADOPT [data] */
947 /* load an option */
948 case loadopt_mn:
949 INCSTACK;
950 nf = *(Rxcip++); /* option to load */
951 /**
952 /// Maybe only pointer to Option!!!
953 **/
954 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
955 I_LoadOption(RxStck[RxStckTop],nf);
956 DEBUGDISPLAY("LOADOPT");
957 goto main_loop;
958
959 /* STOREOPT [data] */
960 /* store an option */
961 case storeopt_mn:
962 DEBUGDISPLAY("STOREOPT");
963 nf = *(Rxcip++); /* option to store */
964 I_StoreOption(RxStck[RxStckTop],nf);
965 RxStckTop--;
966 goto main_loop;
967
968 /* LOAD p[leaf] */
969 /* push a VARiable to stck */
970 case load_mn:
971 INCSTACK; /* make space */
972 PLEAF(litleaf); /* get variable ptr */
973 DEBUGDISPLAYi("LOAD",&(litleaf->key));
974
975 inf = (IdentInfo*)(litleaf->value);
976
977 /* check to see if we have allready its position */
978 if (inf->id == Rx_id) {
979 leaf = inf->leaf[0];
980 RxStck[RxStckTop] = LEAFVAL(leaf);
981 } else {
982 leaf = RxVarFind(VarScope, litleaf, &found);
983 if (found)
984 RxStck[RxStckTop] = LEAFVAL(leaf);
985 else {
986 if (inf->stem) {
987 /* Lstrcpy to a temp variable */
988 Lstrcpy(&(_tmpstr[RxStckTop]),&stemvaluenotfound);
989 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
990 if (leaf==NULL &&
991 _Proc[_rx_proc].condition & SC_NOVALUE)
992 RxSignalCondition(SC_NOVALUE);
993 } else {
994 if (_Proc[_rx_proc].condition & SC_NOVALUE)
995 RxSignalCondition(SC_NOVALUE);
996 RxStck[RxStckTop] = &(litleaf->key);
997 }
998 }
999 }
1000 goto chk4trace;
1001
1002 /* STORE p[leaf] */
1003 /* store top stck item to VARiable */
1004 case create_mn: /* assigmnent */
1005 INCSTACK;
1006 PLEAF(litleaf); /* Get pointer to variable */
1007 DEBUGDISPLAYi("CREATE",&(litleaf->key));
1008
1009 inf = (IdentInfo*)(litleaf->value);
1010 if (inf->id == Rx_id) {
1011 leaf = inf->leaf[0];
1012 RxStck[RxStckTop] = LEAFVAL(leaf);
1013 } else {
1014 leaf = RxVarFind(VarScope,litleaf,&found);
1015
1016 if (found)
1017 RxStck[RxStckTop] = LEAFVAL(leaf);
1018 else {
1019 leaf = RxVarAdd(VarScope,
1020 &(litleaf->key),
1021 inf->stem,
1022 leaf);
1023 RxStck[RxStckTop] = LEAFVAL(leaf);
1024 if (inf->stem==0) {
1025 inf->id = Rx_id;
1026 inf->leaf[0] = leaf;
1027 }
1028 }
1029
1030 }
1031 goto main_loop;
1032
1033 /* DROP p[leaf] */
1034 /* drop VARiable */
1035 case drop_mn:
1036 PLEAF(litleaf); /* Get pointer to variable */
1037 DEBUGDISPLAYi("DROP",&(litleaf->key));
1038
1039 inf = (IdentInfo*)(litleaf->value);
1040 if (inf->id == Rx_id) {
1041 leaf = inf->leaf[0];
1042 RxVarDel(VarScope,litleaf,leaf);
1043 } else {
1044 leaf = RxVarFind(VarScope,litleaf,&found);
1045 if (found)
1046 RxVarDel(VarScope,litleaf,leaf);
1047 }
1048 inf->id = NO_CACHE;
1049 goto chk4trace;
1050
1051 /* indirect drop, from stack */
1052 /* asssume that is UPPER case tmp */
1053 case dropind_mn:
1054 DEBUGDISPLAY("DROP_IND");
1055 RxVarDelInd(VarScope,RxStck[RxStckTop]);
1056 RxStckTop--;
1057 goto chk4trace;
1058
1059 case assignstem_mn:
1060 PLEAF(litleaf); /* Get pointer to stem */
1061 DEBUGDISPLAYi("ASSIGNSTEM",&(litleaf->key));
1062 inf = (IdentInfo*)(litleaf->value);
1063 if (inf->id == Rx_id) {
1064 leaf = inf->leaf[0];
1065 RxScopeAssign(leaf);
1066 } else {
1067 leaf = RxVarFind(VarScope,litleaf,&found);
1068 if (found)
1069 RxScopeAssign(leaf);
1070 }
1071 goto main_loop;
1072
1073 /* BYINIT [patchpos] */
1074 case byinit_mn:
1075 w = *(CWORD *)Rxcip; INCWORD(Rxcip);
1076 DEBUGDISPLAY("BYINIT");
1077 /* copy to temporary only if different */
1078 if (RxStck[RxStckTop] != &(_tmpstr[RxStckTop])) {
1079 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
1080 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1081 }
1082 /* patch comparision code */
1083 if (Llt(RxStck[RxStckTop],&(ZeroStr->key)))
1084 *(CIPTYPE*)((byte huge *)Rxcodestart + w) = tle_mn;
1085 else
1086 *(CIPTYPE*)((byte huge *)Rxcodestart + w) = tge_mn;
1087 goto main_loop;
1088
1089 /* FORINIT */
1090 /* Initialise a FOR loop*/
1091 case forinit_mn:
1092 DEBUGDISPLAY("FORINIT");
1093 /* copy to temporary only if different */
1094 if (RxStck[RxStckTop] != &(_tmpstr[RxStckTop])) {
1095 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
1096 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1097 }
1098 L2INT(RxStck[RxStckTop]); /* it is in temporary */
1099 if (Llt(RxStck[RxStckTop],&(ZeroStr->key)))
1100 Lerror(ERR_INVALID_INTEGER,3,RxStck[RxStckTop]);
1101 goto main_loop;
1102
1103 /* DECFOR */
1104 case decfor_mn:
1105 DEBUGDISPLAY("DECFOR");
1106 a = RxStck[RxStckTop-*(Rxcip++)];
1107 if (Leq(a,&(ZeroStr->key)))
1108 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart+ *(CWORD*)Rxcip);
1109 else
1110 INCWORD(Rxcip);
1111 Ldec(a);
1112 goto main_loop;
1113
1114 /**
1115 //// Beware might lose something when number is like ' 10 '
1116 **/
1117 /* TOINT */
1118 /* change to integer */
1119 case toint_mn:
1120 DEBUGDISPLAY("TOINT");
1121 L2INT(RxStck[RxStckTop]);
1122 goto main_loop;
1123
1124 /* LOWER */
1125 /* upper top stack */
1126 case lower_mn:
1127 DEBUGDISPLAY("LOWER");
1128 Llower(RxStck[RxStckTop]);
1129 goto main_loop;
1130
1131 /* UPPER */
1132 /* upper top stack */
1133 case upper_mn:
1134 DEBUGDISPLAY("UPPER");
1135 Lupper(RxStck[RxStckTop]);
1136 goto main_loop;
1137
1138 /* SIGNAL p[label] */
1139 /* clear stack and jmp to LABEL pos */
1140 case signal_mn:
1141 /* clear stack */
1142 RxStckTop = _Proc[_rx_proc].stacktop;
1143
1144 /* check label */
1145 PLEAF(leaf);
1146 func = (RxFunc*)(leaf->value);
1147 DEBUGDISPLAYi("SIGNAL",&(leaf->key));
1148
1149 if (func->label==UNKNOWN_LABEL)
1150 Lerror(ERR_UNEXISTENT_LABEL,1,&(leaf->key));
1151 /* jump */
1152 Rxcip=(CIPTYPE*)((byte huge *)Rxcodestart+func->label);
1153 goto main_loop;
1154
1155 /* SIGNALVAL [address] */
1156 /* get address from stack */
1157 case signalval_mn:
1158 DEBUGDISPLAY("SIGNALEVAL");
1159
1160 /* clear stack */
1161 RxStckTop = _Proc[_rx_proc].stacktop;
1162
1163 /* search for label */
1164 L2STR(RxStck[RxStckTop]);
1165 leaf = BinFind(&_labels,RxStck[RxStckTop--]);
1166 if (leaf==NULL || ((RxFunc*)(leaf->value))->label == UNKNOWN_LABEL)
1167 Lerror(ERR_UNEXISTENT_LABEL,1,RxStck[RxStckTop+1]);
1168 func = (RxFunc*)(leaf->value);
1169 /* jump */
1170 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + (size_t)(func->label));
1171 goto main_loop;
1172
1173 /* JMP w[pos] */
1174 /* unconditional jump to POSition */
1175 case jmp_mn:
1176 DEBUGDISPLAY0nl("JMP");
1177 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + *(CWORD *)Rxcip);
1178 #ifdef __DEBUG__
1179 if (__debug__)
1180 printf("%d\n",(byte huge *)Rxcip-(byte huge *)Rxcodestart);
1181 #endif
1182 goto main_loop;
1183
1184 /* JF w[pos] */
1185 /* jump if top is 0 to POSition */
1186 case jf_mn:
1187 DEBUGDISPLAY0nl("JF");
1188 #ifdef __DEBUG__
1189 if (__debug__) {
1190 w = *(CWORD *)Rxcip;
1191 if (!Lbool(RxStck[RxStckTop]))
1192 printf("%ld *\n",w);
1193 else
1194 printf("%ld\n",w);
1195 }
1196 #endif
1197 if (!Lbool(RxStck[RxStckTop--]))
1198 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart+ *(CWORD*)Rxcip);
1199 else
1200 INCWORD(Rxcip);
1201 goto main_loop;
1202
1203 /* JT w[pos] */
1204 /* jump if top is 1 to POSition */
1205 case jt_mn:
1206 DEBUGDISPLAY0nl("JT");
1207 #ifdef __DEBUG__
1208 if (__debug__) {
1209 w = *(CWORD *)Rxcip;
1210 if (Lbool(RxStck[RxStckTop]))
1211 printf("%ld *\n",w);
1212 else
1213 printf("%ld\n",w);
1214 }
1215 #endif
1216 if (Lbool(RxStck[RxStckTop--]))
1217 Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart+ *(CWORD*)Rxcip);
1218 else
1219 INCWORD(Rxcip);
1220 goto main_loop;
1221
1222 /* CALL p[label] b[noargs] w[existarg] */
1223 /* create new stack and jmp to LABEL pos*/
1224 case call_mn:
1225 DEBUGDISPLAY0nl("CALL");
1226 if (I_CallFunction())
1227 goto chk4trace;
1228 goto main_loop;
1229
1230 /* RETURN */
1231 /* clear stack and return */
1232 /* if first prg then exit */
1233 case return_mn:
1234 DEBUGDISPLAY0("RETURN");
1235 if (_Proc[_rx_proc].calltype == CT_FUNCTION)
1236 Lerror(ERR_NO_DATA_RETURNED,0);
1237 if (_rx_proc==0) { /* root program */
1238 RxReturnCode = 0;
1239 goto interpreter_fin;
1240 }
1241 I_ReturnProc();
1242 goto main_loop;
1243
1244 /* RETURNF */
1245 /* move top of stack to correct */
1246 /* position of return arg and */
1247 /* clear stack */
1248 case returnf_mn:
1249 DEBUGDISPLAY0("RETURNF");
1250 if (_rx_proc==0) { /* Root program */
1251 RxReturnCode = (int)Lrdint(RxStck[RxStckTop--]);
1252 goto interpreter_fin;
1253 } else
1254 if (_Proc[_rx_proc].calltype != CT_PROCEDURE)
1255 /**
1256 // It is possible to do a DUP in the compile code of returnf
1257 **/
1258 Lstrcpy(_Proc[_rx_proc].arg.r, RxStck[RxStckTop]);
1259 else {
1260 /* is the Variable space private? */
1261 /* proc: PROCEDURE */
1262 if (VarScope!=_Proc[_rx_proc-1].scope)
1263 /* not a tmp var */
1264 if (RxStck[RxStckTop] != &(_tmpstr[RxStckTop]))
1265 {
1266 Lstrcpy(&(_tmpstr[RxStckTop]),
1267 RxStck[RxStckTop]);
1268 RxStck[RxStckTop] =
1269 &(_tmpstr[RxStckTop]);
1270 }
1271 /* point the return data */
1272 a = RxStck[RxStckTop];
1273 }
1274
1275 I_ReturnProc();
1276
1277 if (_Proc[_rx_proc+1].calltype == CT_PROCEDURE)
1278 /* Assign the the RESULT variable */
1279 RxVarSet(VarScope,ResultStr,a);
1280 goto main_loop;
1281
1282 /* INTERPRET [string] */
1283 case interpret_mn:
1284 DEBUGDISPLAY("INTERPRET");
1285 /* copy to a temporary var */
1286 if (RxStck[RxStckTop] != &(_tmpstr[RxStckTop])) {
1287 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
1288 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1289 }
1290 RxInitInterStr();
1291 goto main_loop;
1292
1293 case inter_end_mn:
1294 DEBUGDISPLAY0("INTER_END");
1295 RxDoneInterStr();
1296 goto main_loop;
1297
1298 /* PROC */
1299 case proc_mn:
1300 DEBUGDISPLAY0("ERROR-PROC");
1301 Lerror(ERR_UNEXPECTED_PROC,1);
1302 goto chk4trace;
1303
1304 /* SAY */
1305 /* display TOP item */
1306 case say_mn:
1307 DEBUGDISPLAY("SAY");
1308 Lprint(STDOUT,RxStck[RxStckTop--]);
1309 PUTCHAR('\n');
1310 goto main_loop;
1311
1312 /* SYSTEM */
1313 /* execute a system call*/
1314 case system_mn:
1315 DEBUGDISPLAY2("SYSTEM");
1316 L2STR(RxStck[RxStckTop]);
1317 LASCIIZ(*(RxStck[RxStckTop]));
1318 RxExecuteCmd(RxStck[RxStckTop],RxStck[RxStckTop-1]);
1319 RxStckTop -= 2;
1320 goto main_loop;
1321
1322 /* EXIT */
1323 /* exit prg with RC */
1324 case exit_mn:
1325 DEBUGDISPLAY("EXIT");
1326 RxReturnCode = (int)Lrdint(RxStck[RxStckTop--]);
1327 /* free everything from stack */
1328 #ifndef __DEBUG__
1329 RxStckTop = -1;
1330 #endif
1331 goto interpreter_fin;
1332
1333 /* PARSE */
1334 /* Initialise PARSING */
1335 case parse_mn:
1336 DEBUGDISPLAY("PARSE");
1337 /* Do not remove from stack */
1338 ToParse = RxStck[RxStckTop];
1339 L2STR(ToParse);
1340 DataStart = BreakStart = BreakEnd = 1;
1341 SourceEnd = LLEN(*ToParse)+1;
1342 goto main_loop;
1343
1344 /* PVAR */
1345 /* Parse to stack */
1346 case pvar_mn:
1347 DEBUGDISPLAY0("PVAR");
1348 if (BreakEnd<=DataStart)
1349 DataEnd = SourceEnd;
1350 else
1351 DataEnd = BreakStart;
1352
1353 if (DataEnd!=DataStart)
1354 _Lsubstr(RxStck[RxStckTop--],ToParse,DataStart,DataEnd-DataStart);
1355 else {
1356 LZEROSTR(*(RxStck[RxStckTop]));
1357 RxStckTop--;
1358 }
1359 if (_trace) {
1360 RxStckTop++;
1361 TraceInstruction(*Rxcip);
1362 RxStckTop--;
1363 }
1364 Rxcip++;
1365 goto main_loop;
1366 /*** goto chk4trace; ***/
1367
1368 /* PDOT */
1369 /* Parse to hyperspace */
1370 case pdot_mn:
1371 /* Only for debugging */
1372 DEBUGDISPLAY0("PDOT");
1373 if (_trace) {
1374 /* Make space */
1375 RxStckTop++;
1376 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1377 if (BreakEnd<=DataStart)
1378 DataEnd = SourceEnd;
1379 else
1380 DataEnd = BreakStart;
1381 if (DataEnd!=DataStart)
1382 _Lsubstr(RxStck[RxStckTop],ToParse,DataStart,DataEnd-DataStart);
1383 else
1384 LZEROSTR(*(RxStck[RxStckTop]));
1385 TraceInstruction(*Rxcip);
1386 RxStckTop--; /* free space */
1387 }
1388 Rxcip++;
1389 goto main_loop;
1390
1391 /* TR_SPACE */
1392 /* trigger a space */
1393 case tr_space_mn:
1394 DEBUGDISPLAY0("TR_SPACE");
1395 I_trigger_space();
1396 goto main_loop;
1397
1398 /* TR_LIT */
1399 /* trigger a litteral from stck */
1400 case tr_lit_mn:
1401 DEBUGDISPLAY("TR_LIT");
1402 DataStart = BreakEnd;
1403 I_trigger_litteral(RxStck[RxStckTop--]);
1404 goto main_loop;
1405
1406 /* TR_ABS */
1407 /* trigger ABSolute position */
1408 case tr_abs_mn:
1409 DEBUGDISPLAY("TR_ABS");
1410 /**
1411 // L2INT(**A);
1412 **/
1413 DataStart = BreakEnd;
1414 BreakStart = (size_t)LINT(*(RxStck[RxStckTop--]));
1415
1416 /* check for boundaries */
1417 BreakStart = RANGE(1,BreakStart,SourceEnd);
1418 BreakEnd = BreakStart;
1419 goto main_loop;
1420
1421 /* TR_REL */
1422 /* trigger RELative position */
1423 case tr_rel_mn:
1424 DEBUGDISPLAY("TR_REL");
1425
1426 /**
1427 // L2INT(**A);
1428 **/
1429 DataStart = BreakStart;
1430 BreakStart = DataStart + (size_t)LINT(*(RxStck[RxStckTop--]));
1431
1432 /* check for boundaries */
1433 BreakStart = RANGE(1,BreakStart,SourceEnd);
1434 BreakEnd = BreakStart;
1435 goto main_loop;
1436
1437 /* TR_END */
1438 /* trigger to END of data */
1439 case tr_end_mn:
1440 DEBUGDISPLAY0("TR_END");
1441 DataStart = BreakEnd;
1442 BreakStart = SourceEnd;
1443 BreakEnd = SourceEnd;
1444 goto main_loop;
1445
1446 /* RX_QUEUE */
1447 /* queue stck to Rexx queue */
1448 case rx_queue_mn:
1449 DEBUGDISPLAY("RX_PUSH");
1450 LPMALLOC(a); /* duplicate variable */
1451 Lfx(a,1);
1452 Lstrcpy(a,RxStck[RxStckTop--]);
1453 Queue2Stack(a);
1454 goto main_loop;
1455
1456 /* RX_PUSH */
1457 /* push stck to Rexx queue */
1458 case rx_push_mn:
1459 DEBUGDISPLAY("RX_PUSH");
1460 LPMALLOC(a); /* duplicate variable */
1461 Lfx(a,1);
1462 Lstrcpy(a,RxStck[RxStckTop--]);
1463 Push2Stack(a);
1464 goto main_loop;
1465
1466 /* RX_PULL */
1467 /* pull stck from Rexx queue */
1468 case rx_pull_mn:
1469 RxStckTop++;
1470 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1471 a = NULL;
1472 /* delete empty stacks */
1473 while (StackQueued()==0 && StackList.items>1)
1474 DeleteStack();
1475 if (StackQueued()>0) {
1476 a = PullFromStack();
1477 Lstrcpy(RxStck[RxStckTop],a);
1478 LPFREE(a);
1479 while (StackQueued()==0 && StackList.items>1)
1480 DeleteStack();
1481 } else {
1482 Lread(STDIN,RxStck[RxStckTop],LREADLINE);
1483 }
1484 DEBUGDISPLAY("RX_PULL");
1485 goto main_loop;
1486
1487 /* RX_EXTERNAL */
1488 /* read data from extrnal queue */
1489 case rx_external_mn:
1490 RxStckTop++;
1491 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1492 Lread(STDIN,RxStck[RxStckTop],LREADLINE);
1493 DEBUGDISPLAY("RX_EXTERNAL");
1494 goto main_loop;
1495
1496 case eq_mn:
1497 DEBUGDISPLAY2("EQ");
1498 a = RxStck[RxStckTop-2];
1499 LICPY(*a,
1500 Leq(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1501 RxStckTop -= 2;
1502 goto chk4trace;
1503
1504 case ne_mn:
1505 DEBUGDISPLAY2("NE");
1506 a = RxStck[RxStckTop-2];
1507 LICPY(*a,
1508 Lne(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1509 RxStckTop -= 2;
1510 goto chk4trace;
1511
1512 case gt_mn:
1513 DEBUGDISPLAY2("GT");
1514 a = RxStck[RxStckTop-2];
1515 LICPY(*a,
1516 Lgt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1517 RxStckTop -= 2;
1518 goto chk4trace;
1519
1520 case ge_mn:
1521 DEBUGDISPLAY2("GE");
1522 a = RxStck[RxStckTop-2];
1523 LICPY(*a,
1524 Lge(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1525 RxStckTop -= 2;
1526 goto chk4trace;
1527
1528 case lt_mn:
1529 DEBUGDISPLAY2("LT");
1530 a = RxStck[RxStckTop-2];
1531 LICPY(*a,
1532 Llt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1533 RxStckTop -= 2;
1534 goto chk4trace;
1535
1536 case le_mn:
1537 DEBUGDISPLAY2("LE");
1538 a = RxStck[RxStckTop-2];
1539 LICPY(*a,
1540 Lle(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1541 RxStckTop -= 2;
1542 goto chk4trace;
1543
1544 case deq_mn:
1545 DEBUGDISPLAY2("DEQ");
1546 a = RxStck[RxStckTop-2];
1547 LICPY(*a,
1548 Ldeq(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1549 RxStckTop -= 2;
1550 goto chk4trace;
1551
1552 case dne_mn:
1553 DEBUGDISPLAY2("DNE");
1554 a = RxStck[RxStckTop-2];
1555 LICPY(*a,
1556 Ldne(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1557 RxStckTop -= 2;
1558 goto chk4trace;
1559
1560 case dgt_mn:
1561 DEBUGDISPLAY2("DGT");
1562 a = RxStck[RxStckTop-2];
1563 LICPY(*a,
1564 Ldgt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1565 RxStckTop -= 2;
1566 goto chk4trace;
1567
1568 case dge_mn:
1569 DEBUGDISPLAY2("DGE");
1570 a = RxStck[RxStckTop-2];
1571 LICPY(*a,
1572 Ldge(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1573 RxStckTop -= 2;
1574 goto chk4trace;
1575
1576 case dlt_mn:
1577 DEBUGDISPLAY2("DLT");
1578 a = RxStck[RxStckTop-2];
1579 LICPY(*a,
1580 Ldlt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1581 RxStckTop -= 2;
1582 goto chk4trace;
1583
1584 case dle_mn:
1585 DEBUGDISPLAY2("DLE");
1586 a = RxStck[RxStckTop-2];
1587 LICPY(*a,
1588 Ldle(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1589 RxStckTop -= 2;
1590 goto chk4trace;
1591
1592 case teq_mn:
1593 DEBUGDISPLAY2("TEQ");
1594 a = &(_tmpstr[RxStckTop-1]);
1595 LICPY(*a,
1596 Leq(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1597 RxStckTop--;
1598 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1599 goto chk4trace;
1600
1601 case tne_mn:
1602 DEBUGDISPLAY2("TNE");
1603 a = &(_tmpstr[RxStckTop-1]);
1604 LICPY(*a,
1605 Lne(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1606 RxStckTop--;
1607 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1608 goto chk4trace;
1609
1610 case tdeq_mn:
1611 DEBUGDISPLAY2("TDEQ");
1612 a = &(_tmpstr[RxStckTop-1]);
1613 LICPY(*a,
1614 Ldeq(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1615 RxStckTop--;
1616 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1617 goto chk4trace;
1618
1619 case tdne_mn:
1620 DEBUGDISPLAY2("TNDE");
1621 a = &(_tmpstr[RxStckTop-1]);
1622 LICPY(*a,
1623 Ldne(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1624 RxStckTop--;
1625 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1626 goto chk4trace;
1627
1628 case tgt_mn:
1629 DEBUGDISPLAY2("TGT");
1630 a = &(_tmpstr[RxStckTop-1]);
1631 LICPY(*a,
1632 Lgt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1633 RxStckTop--;
1634 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1635 goto chk4trace;
1636
1637 case tge_mn:
1638 DEBUGDISPLAY2("TGE");
1639 a = &(_tmpstr[RxStckTop-1]);
1640 LICPY(*a,
1641 Lge(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1642 RxStckTop--;
1643 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1644 goto chk4trace;
1645
1646 case tlt_mn:
1647 DEBUGDISPLAY2("TLT");
1648 a = &(_tmpstr[RxStckTop-1]);
1649 LICPY(*a,
1650 Llt(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1651 RxStckTop--;
1652 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1653 goto chk4trace;
1654
1655 case tle_mn:
1656 DEBUGDISPLAY2("TLE");
1657 a = &(_tmpstr[RxStckTop-1]);
1658 LICPY(*a,
1659 Lle(RxStck[RxStckTop-1],RxStck[RxStckTop]));
1660 RxStckTop--;
1661 RxStck[RxStckTop] = &_tmpstr[RxStckTop];
1662 goto chk4trace;
1663
1664 case not_mn:
1665 DEBUGDISPLAY("NOT");
1666 a = RxStck[RxStckTop-1];
1667 LICPY(*a,!Lbool(RxStck[RxStckTop]));
1668 RxStckTop--;
1669 goto chk4trace;
1670
1671 case and_mn:
1672 DEBUGDISPLAY2("AND");
1673 a = RxStck[RxStckTop-2];
1674 LICPY(*a,
1675 Lbool(RxStck[RxStckTop-1]) & Lbool(RxStck[RxStckTop]));
1676 RxStckTop -= 2;
1677 goto chk4trace;
1678
1679 case or_mn:
1680 DEBUGDISPLAY2("OR");
1681 a = RxStck[RxStckTop-2];
1682 LICPY(*a,
1683 Lbool(RxStck[RxStckTop-1]) | Lbool(RxStck[RxStckTop]));
1684 RxStckTop -= 2;
1685 goto chk4trace;
1686
1687 case xor_mn:
1688 DEBUGDISPLAY2("XOR");
1689 a = RxStck[RxStckTop-2];
1690 LICPY(*a,
1691 Lbool(RxStck[RxStckTop-1]) ^ Lbool(RxStck[RxStckTop]));
1692 RxStckTop -= 2;
1693 goto chk4trace;
1694
1695 case concat_mn:
1696 DEBUGDISPLAY2("CONCAT");
1697 a = RxStck[RxStckTop-2];
1698 if (a!=RxStck[RxStckTop]) {
1699 Lstrcpy(a,RxStck[RxStckTop-1]);
1700 Lstrcat(a,RxStck[RxStckTop]);
1701 } else {
1702 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
1703 Lstrcpy(a,RxStck[RxStckTop-1]);
1704 Lstrcat(a,&(_tmpstr[RxStckTop]));
1705 }
1706 RxStckTop -= 2;
1707 goto chk4trace;
1708
1709 case bconcat_mn:
1710 DEBUGDISPLAY2("BCONCAT");
1711 a = RxStck[RxStckTop-2];
1712 if (a==RxStck[RxStckTop]) {
1713 Lstrcpy(&(_tmpstr[RxStckTop]),RxStck[RxStckTop]);
1714 RxStck[RxStckTop] = &(_tmpstr[RxStckTop]);
1715 }
1716 Lstrcpy(a,RxStck[RxStckTop-1]);
1717 L2STR(a);
1718 LSTR(*a)[LLEN(*a)] = ' ';
1719 LLEN(*a)++;
1720 Lstrcat(a,RxStck[RxStckTop]);
1721 RxStckTop -= 2;
1722 goto chk4trace;
1723
1724 case neg_mn:
1725 DEBUGDISPLAY("NEG");
1726 Lneg(RxStck[RxStckTop-1],RxStck[RxStckTop]);
1727 RxStckTop--;
1728 goto chk4trace;
1729
1730 case inc_mn:
1731 DEBUGDISPLAY("INC");
1732 Linc(RxStck[RxStckTop--]);
1733 goto chk4trace;
1734
1735 case dec_mn:
1736 DEBUGDISPLAY("DEC");
1737 Ldec(RxStck[RxStckTop--]);
1738 goto chk4trace;
1739
1740 case add_mn:
1741 DEBUGDISPLAY2("ADD");
1742 Ladd(RxStck[RxStckTop-2],
1743 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1744 RxStckTop -= 2;
1745 goto chk4trace;
1746
1747 case sub_mn:
1748 DEBUGDISPLAY2("SUB");
1749 Lsub(RxStck[RxStckTop-2],
1750 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1751 RxStckTop -= 2;
1752 goto chk4trace;
1753
1754 case mul_mn:
1755 DEBUGDISPLAY2("MUL");
1756 Lmult(RxStck[RxStckTop-2],
1757 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1758 RxStckTop -= 2;
1759 goto chk4trace;
1760
1761 case div_mn:
1762 DEBUGDISPLAY2("DIV");
1763 Ldiv(RxStck[RxStckTop-2],
1764 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1765 RxStckTop -= 2;
1766 goto chk4trace;
1767
1768 case idiv_mn:
1769 DEBUGDISPLAY2("IDIV");
1770 Lintdiv(RxStck[RxStckTop-2],
1771 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1772 RxStckTop -= 2;
1773 goto chk4trace;
1774
1775 case mod_mn:
1776 DEBUGDISPLAY2("MOD");
1777 Lmod(RxStck[RxStckTop-2],
1778 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1779 RxStckTop -= 2;
1780 goto chk4trace;
1781
1782 case pow_mn:
1783 DEBUGDISPLAY2("POW");
1784 Lexpose(RxStck[RxStckTop-2],
1785 RxStck[RxStckTop-1],RxStck[RxStckTop]);
1786 RxStckTop -= 2;
1787 goto chk4trace;
1788
1789 default:
1790 DEBUGDISPLAY0("error, unknown mnemonic");
1791 Rxcip--;
1792 #ifndef WIN
1793 fprintf(STDERR,"Opcode found=%ld (0x%02lX)\n",(long)*Rxcip,(unsigned long)*Rxcip);
1794 #else
1795 PUTS("Opcode found=0x"); PUTINT(*Rxcip,0,16);
1796 #endif
1797 Lerror(ERR_INTERPRETER_FAILURE,0);
1798 }
1799 chk4trace:
1800 if (_trace) TraceInstruction(*Rxcip);
1801 Rxcip++; /* skip trace byte */
1802 }
1803 interpreter_fin:
1804 SIGNAL(SIGINT,SIG_IGN);
1805 return RxReturnCode;
1806 } /* RxInterpret */
Mirror of AROS' Contrib svn.