1 constant ESTATE_NEW -3;
2 constant ESTATE_QUIT -2;
3 constant ESTATE_DANGEROUS -1;
4 constant ESTATE_NORMAL 0;
5 constant ESTATE_ERROR 1;
8 constant TYPE_STRING = 1;
10 constant STACK_NONE = 0;
11 constant STACK_FOR = 1;
12 constant STACK_REPEAT = 2;
13 constant STACK_WHILE = 3;
14 constant STACK_GOSUB = 4;
16 constant STACK_SIZE = 16;
17 array stack_type table STACK_SIZE;
18 array stack_cmd table STACK_SIZE;
19 array stack_line table STACK_SIZE;
23 global program_ptr = 0;
24 global program_lineno;
26 ! An error has occurred.
29 print "^", (string) msg;
31 print " at line ", program_lineno;
35 ! Miscellaneous errors.
37 [ error_nomore; error("Token didn't expect more input"); ];
38 [ error_typemismatch; error("Type mismatch"); ];
39 [ error_missingopenp; error("Missing open parenthesis"); ];
40 [ error_missingclosep; error("Missing close parenthesis"); ];
41 [ error_syntaxerror; error("Syntax error"); ];
42 [ error_outofmemory; error("Out of memory"); ];
43 [ error_notrunning; error("Not running a program"); ];
44 [ error_stackoverflow; error("Stack overflow"); ];
46 ! End of statement token?
49 return ((t == TOKEN__EOL) || (t == TOKEN__COLON));
55 while (cmd->0 == TOKEN__SPACE)
59 ! Read and evaluate an lvalue.
61 [ eval_lvalue varname i j val;
68 if (cmd->0 ~= TOKEN__LPAREN)
70 ! It's not an array, so we can return the raw name.
71 return strdup(varname);
75 val = eval_expression();
78 if (val-->0 ~= TYPE_INT)
89 if (cmd->0 == TOKEN__COMMA)
92 error("Multidimensional arrays are not supported");
95 if (cmd->0 ~= TOKEN__RPAREN)
112 ! Read and evaluate a leaf expression.
129 ret-->0 = TYPE_STRING;
130 ret-->1 = string_alloc(cmd+1, cmd->0);
131 cmd = cmd + cmd->0 + 1;
136 if (ret-->0 ~= TYPE_INT)
139 error("Can only use - operator on strings");
142 ret-->1 = -(ret-->1);
149 if (cmd->0 ~= TOKEN__LPAREN)
151 ret = store_lookup(i);
154 error("Variable not found");
161 ret = eval_expression();
164 if (ret-->0 ~= TYPE_INT)
167 error_typemismatch();
172 if ((cmd++)->0 ~= TOKEN__RPAREN)
179 j = mem_alloc(2+cmd-i);
186 ret = store_lookup(j);
190 error("Array or array index not found");
196 ret = eval_expression();
199 if ((cmd++)->0 ~= TOKEN__RPAREN)
201 error_missingclosep();
208 TOKEN_RND, TOKEN_VAL:
210 if ((cmd++)->0 ~= TOKEN__LPAREN)
212 error_missingopenp();
215 ret = eval_expression();
218 if ((cmd++)->0 ~= TOKEN__RPAREN)
220 error_missingclosep();
227 if (ret-->0 ~= TYPE_INT)
229 error_typemismatch();
234 ret-->1 = random(ret-->1) - 1;
238 if (ret-->0 ~= TYPE_STRING)
240 error_typemismatch();
246 ret-->1 = string_toint(ret-->1);
253 error("Botched leaf expression");
257 ! Evaluate an expression.
259 [ eval_expression ret val i;
268 TOKEN__EOL, TOKEN__COLON, TOKEN__SEMICOLON, TOKEN__COMMA, TOKEN__RPAREN,
269 TOKEN_THEN, TOKEN_TO, TOKEN_STEP:
272 ! Operators that can work on any type.
274 TOKEN__PLUS, TOKEN__LARROW, TOKEN__RARROW, TOKEN__EQUALS, TOKEN__NEQUAL:
276 val = eval_expression();
279 if (ret-->0 ~= val-->0)
288 ret-->1 = (ret-->1 + val-->1);
292 ret-->1 = (ret-->1 < val-->1);
296 ret-->1 = (ret-->1 > val-->1);
300 ret-->1 = (ret-->1 == val-->1);
304 ret-->1 = (ret-->1 ~= val-->1);
314 ret-->1 = (string_compare(ret-->1, val-->1) == 0);
319 ret-->1 = (string_compare(ret-->1, val-->1) ~= 0);
322 TOKEN__PLUS, TOKEN__LARROW, TOKEN__RARROW:
323 error("Unimplemented opcode");
331 ! Operators that only work on ints.
333 TOKEN__MINUS, TOKEN__STAR, TOKEN__SLASH, TOKEN_AND, TOKEN_OR:
335 val = eval_expression();
338 if ((ret-->0 ~= TYPE_INT) || (val-->0 ~= TYPE_INT))
344 ret-->1 = ret-->1 - val-->1;
348 ret-->1 = ret-->1 * val-->1;
354 error("Division by zero");
357 ret-->1 = ret-->1 / val-->1;
361 ret-->1 = ret-->1 && val-->1;
365 ret-->1 = ret-->1 || val-->1;
372 error("Botched complex expression");
379 error_typemismatch();
387 ! List the current program.
391 if (eos(cmd->0) == 0)
392 val = eval_expression();
400 if (val-->0 ~= TYPE_INT)
402 error_typemismatch();
414 store_listprogramhex();
423 return ESTATE_NORMAL;
426 ! Prints out an expression.
438 val = eval_expression();
448 string_print(val-->1);
453 error("Internal error --- invalid type in print!");
468 return ESTATE_NORMAL;
473 return ESTATE_NORMAL;
483 return ESTATE_NORMAL;
485 val = eval_expression();
488 if (val-->0 ~= TYPE_INT)
495 ! When we call this, it's entirely possible that the heap will be
497 return script_invoke(id);
500 error_typemismatch();
504 ! Variable assignment.
506 [ cmd_varassignment varname val;
507 varname = eval_lvalue();
512 if ((cmd++)->0 ~= TOKEN__EQUALS)
515 error("Unrecognised keyword");
520 val = eval_expression();
527 store_assign(varname, val-->0, val-->1);
531 return ESTATE_NORMAL;
539 stack_type-->1 = STACK_NONE;
540 program_ptr = store_bottom;
542 ! As the program is already tokenised, we can directly run the
543 ! bytecode in the store.
546 ! Reached the end of the program?
548 if (program_ptr->0 == 0)
554 ! Read in the line number and execute the line..
557 program_ptr = program_ptr + program_ptr->0;
558 program_lineno = p-->0;
561 ! Execute the line. Remember execute_command needs to be
562 ! pointed at the byte *before* the bytecode...
564 i = execute_command(p);
565 } until (i ~= ESTATE_NORMAL);
573 [ cmd_input val varname buf;
578 if (cmd->0 == TOKEN__STRING)
583 if (val-->0 == TYPE_STRING)
584 string_print(val-->1);
587 error_typemismatch();
614 ! Get the variable name to put the result into.
616 if ((cmd++)->0 ~= TOKEN__VAR)
621 varname = eval_lvalue();
625 ! Get the user's input.
627 buf = mem_alloc(255);
638 ! Assign to the variable.
640 store_assign(varname, TYPE_STRING, string_alloc(buf+2, buf->1));
642 ! Free the temporary buffer.
647 return ESTATE_NORMAL;
650 ! Jump to a line number.
653 if (program_ptr == 0)
659 val = eval_expression();
662 if (val-->0 ~= TYPE_INT)
665 error_typemismatch();
669 i = store_findline(val-->1);
673 error("No such line number");
678 return ESTATE_NORMAL;
682 ! Conditional execution.
685 val = eval_expression();
689 if ((cmd++)->0 ~= TOKEN_THEN)
696 if ((val-->0 == TYPE_INT) && (val-->1 == 0))
700 return ESTATE_NORMAL;
703 ! Top half of a FOR loop.
705 [ cmd_for varname val initialval targetval stepval cmdptr;
706 ! FOR can only be used when running a program.
708 if (program_ptr == 0)
714 ! Store the address of the FOR instruction.
718 ! Read the variable name.
721 if ((cmd++)->0 ~= TOKEN__VAR)
726 varname = eval_lvalue();
733 if ((cmd++)->0 ~= TOKEN__EQUALS)
739 ! Read the initial value.
741 val = eval_expression();
744 if (val-->0 ~= TYPE_INT)
746 error_typemismatch();
749 initialval = val-->1;
755 if ((cmd++)->0 ~= TOKEN_TO)
761 ! Read the target value.
763 val = eval_expression();
766 if (val-->0 ~= TYPE_INT)
768 error_typemismatch();
774 ! Is there a STEP clause?
777 if (cmd->0 == TOKEN_STEP)
782 ! Read the STEP value.
784 val = eval_expression();
787 if (val-->0 ~= TYPE_INT)
789 error_typemismatch();
797 ! Otherwise, default to 1.
802 ! Is this a new loop?
804 if (stack_type-->stack_ptr == STACK_NONE)
806 ! Yes. Ensure there's room on the stack.
808 if ((stack_ptr+1) >= STACK_SIZE)
810 error_stackoverflow();
813 stack_ptr-->stack_type = STACK_NONE;
815 ! ...and set the initial value.
817 store_assign(varname, TYPE_INT, initialval);
821 ! Otherwise, load the loop counter.
823 val = store_lookup(varname);
826 error("FOR loop counter has disappeared");
829 if (val-->0 ~= TYPE_INT)
831 error_typemismatch();
834 initialval = val-->1;
839 initialval = initialval + stepval;
843 if (((stepval < 0) && (initialval < targetval)) ||
844 ((stepval >= 0) && (initialval > targetval)))
846 ! Abort! The NEXT keyword has placed the pointer to
847 ! to the next instruction after the loop on the stack.
849 cmd = stack_cmd-->stack_ptr;
850 program_ptr = stack_line-->stack_ptr;
851 stack_type-->stack_ptr = 0;
852 return ESTATE_NORMAL;
856 ! Write back the new loop counter.
858 store_assign(varname, TYPE_INT, initialval);
863 stack_type-->stack_ptr = STACK_FOR;
864 stack_cmd-->stack_ptr = cmdptr;
865 stack_line-->stack_ptr = program_ptr;
867 return ESTATE_NORMAL;
876 ! Bottom half of a FOR loop.
879 ! NEXT can only be used when running a program.
881 if (program_ptr == 0)
888 if ((stack_ptr == 0) || (stack_type-->stack_ptr ~= STACK_FOR))
890 error("NEXT without FOR");
894 i = stack_cmd-->stack_ptr;
895 j = stack_line-->stack_ptr;
896 stack_cmd-->stack_ptr = cmd;
897 stack_line-->stack_ptr = program_ptr;
901 return ESTATE_NORMAL;
904 ! Top half of a REPEAT..UNTIL loop.
907 ! REPEAT can only be used when running a program.
909 if (program_ptr == 0)
915 if ((stack_ptr+1) >= STACK_SIZE)
917 error_stackoverflow();
921 stack_type-->stack_ptr = STACK_REPEAT;
922 stack_cmd-->stack_ptr = cmd+1;
923 stack_line-->stack_ptr = program_ptr;
925 return ESTATE_NORMAL;
928 ! Bottom half of a REPEAT..UNTIL loop.
931 ! REPEAT can only be used when running a program.
933 if (program_ptr == 0)
940 if ((stack_ptr == 0) || (stack_type-->stack_ptr ~= STACK_REPEAT))
942 error("UNTIL without REPEAT");
946 val = eval_expression();
949 if (val-->0 ~= TYPE_INT)
952 error_typemismatch();
958 cmd = stack_cmd-->stack_ptr;
959 program_ptr = stack_line-->stack_ptr;
963 stack_type-->stack_ptr = STACK_NONE;
965 return ESTATE_NORMAL;
970 [ execute_command _cmd i;
979 TOKEN__EOL: return ESTATE_NORMAL;
980 TOKEN__SPACE: continue;
985 if (store_addline(i, cmd, _cmd->0 - 4))
987 ! Don't execute anything else on this line.
988 return ESTATE_DANGEROUS;
991 i = cmd_varassignment();
1012 if (i ~= ESTATE_NORMAL)
1015 return ESTATE_NORMAL;
1027 restore endofstatement;
1028 error("Load failed");
1029 return ESTATE_ERROR;
1036 if (i == ESTATE_NORMAL)
1057 save endofstatement;
1058 error("Save failed");
1059 return ESTATE_ERROR;
1067 return ESTATE_ERROR;
1071 if (i ~= ESTATE_ERROR)
1077 error("Unimplemented token");
1078 return ESTATE_ERROR;
1081 if (i == ESTATE_ERROR)
1082 return ESTATE_ERROR;
1087 if (eos(cmd->0) == 0)
1090 return ESTATE_ERROR;
1093 if (cmd->0 == TOKEN__COLON)
1097 return ESTATE_NORMAL;