1 /* yForth? - A Forth interpreter written in ANSI C
2 * Copyright (C) 2012 Luca Padovani
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 * ------------------------------------------------------------------------
18 * Abstract: Core word set
37 /**************************************************************************/
38 /* VARIABLES **************************************************************/
39 /**************************************************************************/
41 Char s_tmp_buffer[TMP_BUFFER_SIZE]; /* used by s" */
43 Cell _to_in; /* ptr to parse area */
44 Cell _source_id; /* input source device */
45 Char * _tib; /* ptr to terminal input buffer */
46 Char * _input_buffer; /* current input buffer */
47 Cell _in_input_buffer; /* # of chars in input buffer */
48 Cell _base; /* base is base */
49 Char * _dp; /* dictionary pointer */
50 Cell _error; /* error code */
51 struct word_def * _last; /* ptr to last defined word */
52 Cell _state; /* state of the interpreter */
53 Cell _check_system = 1; /* 1 => check stacks overflow & underflow */
54 /* Some variables used by environment? follows... */
55 Cell _env_slash_counted_string;
58 Cell _env_address_unit_bits;
67 Cell _env_return_stack_cells;
68 Cell _env_stack_cells;
72 Cell _env_floating_stack;
74 Cell _env_floating_ext;
75 Cell _env_memory_alloc;
76 Cell _env_memory_alloc_ext;
77 Cell _env_search_order;
78 Cell _env_search_order_ext;
82 Cell _env_number_locals;
86 Cell _env_facility_ext;
90 Cell _env_exception_ext;
96 /**************************************************************************/
97 /* WORDS ******************************************************************/
98 /**************************************************************************/
101 compile_cell((Cell) _paren_dot_quote_paren);
104 _dp = (Char *) WORD_PTR(_dp);
108 void _paren_dot_quote_paren() {
109 register Char *addr = (Char *) ip;
110 *--sp = (Cell) (addr + 1);
111 *--sp = (Cell) *addr;
113 ip = (pfp *) WORD_PTR((Char *) ip);
117 register Cell u = *sp++;
118 register Char *addr = (Char *) *sp++;
119 while (u--) putchar(*addr++);
126 _number_sign_greater();
146 register DCell u = *sp;
147 register int usign = u < 0;
157 _number_sign_greater();
168 register UCell u = *sp++;
169 while (u--) putchar(' ');
172 void _less_number_sign() {
174 p_pnos = pnos + pnos_size;
177 void _number_sign() {
178 register UDCell ud1 = GET_DCELL(sp);
179 register int rem = ud1 % _base;
182 if (rem < 10) *--p_pnos = rem + '0';
183 else *--p_pnos = rem - 10 + 'a';
188 register Char ch = (Char) *sp++;
193 void _number_sign_s() {
195 while (sp[0] || sp[1]);
198 void _number_sign_greater() {
199 sp[1] = (Cell) p_pnos;
204 register Cell *addr = (Cell *) *sp++;
214 register DCell d = (DCell) sp[1] * (DCell) sp[2];
215 sp[2] = d / (DCell) sp[0];
219 void _star_slash_mod() {
220 register DCell d = (DCell) sp[1] * (DCell) sp[2];
221 sp[2] = d % (DCell) sp[0];
222 sp[1] = d / (DCell) sp[0];
232 register Cell *addr = (Cell *) *sp++;
247 register Cell n1 = sp[1];
248 register Cell n2 = sp[0];
254 sp[0] = FFLAG(sp[0] < 0);
257 void _zero_equals() {
258 sp[0] = FFLAG(sp[0] == 0);
270 register Cell *addr = (Cell *) *sp++;
284 register Cell *addr = (Cell *) *sp;
306 register Cell x4 = sp[0];
307 register Cell x3 = sp[1];
315 sp[1] = FFLAG(sp[1] < sp[0]);
320 sp[1] = FFLAG(sp[1] == sp[0]);
324 void _greater_than() {
325 sp[1] = FFLAG(sp[1] > sp[0]);
333 void _question_dupe() {
334 if (sp[0]) sp--, sp[0] = sp[1];
338 sp[0] = *((Cell *) sp[0]);
342 register Cell n = sp[0];
343 sp[0] = n >= 0 ? n : -n;
347 _dp = (Char *) ALIGN_PTR(_dp);
351 sp[0] = ALIGN_PTR((Cell *) sp[0]);
364 register Char *addr = (Char *) *sp++;
365 *addr = (Char) *sp++;
369 register Char *addr = (Char *) *sp;
374 sp[0] += sizeof(Cell);
378 sp[0] *= sizeof(Cell);
382 sp[0] += sizeof(Char);
386 sp[0] *= sizeof(Char);
390 register Cell dep = sp_top - sp;
403 void _f_m_slash_mod() {
404 register Cell n1 = *sp++;
405 register DCell d1 = GET_DCELL(sp);
408 #if !FLOORED_DIVISION
411 if (sp[1] > 0) sp[1]++;
423 register UCell u = (UCell) *sp++;
428 register DCell d = (DCell) sp[1] * (DCell) sp[0];
433 register Cell n2 = *sp++;
434 sp[0] = sp[0] > n2 ? sp[0] : n2;
438 register Cell n2 = *sp++;
439 sp[0] = sp[0] < n2 ? sp[0] : n2;
470 register Cell x3 = sp[0];
471 register Cell x2 = sp[1];
472 register Cell x1 = sp[2];
479 register UCell u = (UCell) *sp++;
480 ((UCell *) sp)[0] >>= u;
484 register DCell d = (DCell) (*sp--);
488 void _s_m_slash_rem() {
489 register Cell n1 = *sp++;
490 register DCell d1 = GET_DCELL(sp);
496 if (sp[1] > 0) sp[1]--;
504 register Cell temp = sp[0];
509 void _u_less_than() {
510 sp[1] = FFLAG((UCell) sp[1] < (UCell) sp[0]);
515 register UDCell ud = (UDCell) sp[1] * (UDCell) sp[0];
519 void _u_m_slash_mod() {
520 register UCell u1 = *sp++;
521 register UDCell ud = GET_DCELL(sp);
532 *--sp = (Cell) *ip++;
535 void _do_fliteral() {
536 *--fp = (Real) *((Real *) ip);
537 ip += sizeof(Real) / sizeof(Cell);
542 register Char delim = (Char) *sp;
544 while (_to_in < _in_input_buffer && _input_buffer[_to_in] == delim) _to_in++;
548 for (j = 0; j < i; j++) *(_dp + j + 1) = *addr++;
549 *(_dp + i + 1) = ' ';
554 register UCell u1 = (UCell) *sp;
555 register Char *addr = (Char *) *(sp + 1);
556 register UDCell ud1 = GET_DCELL(sp + 2);
557 while (is_base_digit(*addr) && u1) {
559 if (*addr <= '9') ud1 += *addr - '0';
560 else ud1 += toupper(*addr) - 'A' + 10;
564 PUT_DCELL(sp + 2, ud1);
565 *(sp + 1) = (Cell) addr;
571 register Cell usign = 1;
573 register const_type = 1;
574 register Char *orig = (Char *) sp[1];
575 register Cell orig_len = sp[0];
576 if (sp[0] && *((Char *) sp[1]) == '-') {
578 sp[1] += sizeof(Char);
583 if (sp[0] && *((Char *) sp[1]) == '.') {
586 sp[1] += sizeof(Char);
590 num = GET_DCELL(sp + 1);
593 PUT_DCELL(sp + 1, num);
595 if (!n) *sp = const_type;
612 register struct word_def *xt;
613 while (!_error && _to_in < _in_input_buffer) {
617 if (!(*_dp)) continue; /* Please forget this! */
618 xt = search_word(_dp + 1, *_dp);
620 if (_state == INTERPRET) {
621 if (xt->class & COMP_ONLY) _error = E_NOCOMP;
623 } else /* _state == COMPILE */ {
624 if (xt->class & IMMEDIATE) exec_word(xt);
625 else compile_word(xt);
627 } else /* xt == 0 */ {
631 *--sp = (Cell) (_dp + sizeof(Char));
641 if (_state == INTERPRET) sp++;
644 compile_cell((Cell) _do_literal);
645 compile_cell((Cell) num);
650 if (_state == COMPILE) {
652 compile_cell((Cell) _do_literal);
653 compile_cell((Cell) num);
654 compile_cell((Cell) _do_literal);
655 compile_cell((Cell) (num >> CellBits));
659 if (_state == COMPILE) {
660 compile_cell((Cell) _do_fliteral);
672 register Cell n1 = *sp++;
673 register Char *addr = (Char *) *sp;
678 i = process_char(addr, n1, i, ch);
679 } while (ch != '\n');
684 *--sp = (Cell) _input_buffer;
685 *--sp = _in_input_buffer;
689 register Cell eof = 1;
691 while (_to_in < _in_input_buffer && _input_buffer[_to_in] != ')') _to_in++;
692 if (_source_id != 0 && _source_id != -1 && _to_in == _in_input_buffer) {
696 } while (_to_in == _in_input_buffer && !eof);
697 if (_to_in < _in_input_buffer) _to_in++;
701 register Cell u = *sp++;
702 register Char *addr = (Char *) *sp++;
703 save_input_specification();
705 _in_input_buffer = u;
706 _input_buffer = addr;
710 restore_input_specification();
713 void _view_error_msg() {
714 static struct an_error {
719 { "everything allright", 0, 0 },
720 { "no input avaliable", 0, 0 },
721 { "unknown word", 0, 1 },
722 { "word must be compiled", 0, 1 },
723 { "corrupted dictionary", 1, 0 },
724 { "not enough memory", 0, 0 },
725 { "data-stack underflow", 1, 0 },
726 { "data-stack overflow", 1, 0 },
727 { "return-stack underflow", 1, 0 },
728 { "return-stack overflow", 1, 0 },
729 { "floating-stack underflow", 1, 0 },
730 { "floating-stack overflow", 1, 0 },
731 { "data-space corrupted", 1, 0 },
732 { "data-space exhausted", 1, 0 },
733 { "unable to access image file", 0, 0 },
734 { "primitive not implemented", 0, 1 },
735 { "floating-point/math exception", 0, 0 },
736 { "segmentation fault", 0, 0 },
737 { "file not found", 0, 0 },
739 if (err_msg[-_error].print_word) {
746 printf("error(%d): %s.\n", -_error, err_msg[-_error].msg);
747 if (err_msg[-_error].please_abort) {
748 printf("Aborting...\n");
757 _input_buffer = _tib;
760 while (_error == E_OK) {
765 if (_state == INTERPRET && !_error) printf("ok\n");
766 else if (_state == COMPILE) printf("ko ");
767 } else _error = E_NOINPUT;
768 if (_error == E_OK && _check_system) check_system();
775 *((Cell *) _dp) = *sp++;
784 *_dp++ = (Char) *sp++;
797 compile_cell((Cell) _do_exit);
800 void _paren_do_colon_paren() {
801 *--rp = (Cell) (ip + 1);
803 while (ip) (*ip++)();
808 create_definition(A_COLON);
814 create_definition(A_VARIABLE);
820 register Cell x = *sp++;
821 create_definition(A_CONSTANT);
827 create_definition(A_CREATE);
833 compile_cell((Cell) _paren_does_paren);
839 void _paren_does_paren() {
840 _last->func[0] = (pfp) (ip + 1);
849 void _zero_branch() {
851 else ip += 1 + (Cell) *ip;
855 ip += 1 + (Cell) *ip;
859 compile_cell((Cell) _zero_branch);
865 register Cell *patch = (Cell *) *sp++;
866 *patch = ((Cell *) _dp) - patch - 1;
881 compile_cell((Cell) _paren_do_paren);
883 *--sp = 0; /* Non e' un ?do */
886 void _paren_do_paren() {
889 /* R: index limit --- */
893 register Cell q_do = *sp++;
894 register Cell *dest = (Cell *) *sp++;
895 compile_cell((Cell) _paren_loop_paren);
896 compile_cell(dest - ((Cell *) _dp) - 1);
898 register Cell *patch = (Cell *) *sp++;
899 *patch = ((Cell *) _dp) - patch - 1;
903 void _paren_loop_paren() {
904 if (rp[0] == ++rp[1]) {
907 } else ip += 1 + (Cell) *ip;
919 register Cell q_do = *sp++;
920 register Cell *dest = (Cell *) *sp++;
921 compile_cell((Cell) _paren_plus_loop_paren);
922 compile_cell(dest - ((Cell *) _dp) - 1);
924 register Cell *patch = (Cell *) *sp++;
925 *patch = ((Cell *) _dp) - patch - 1;
929 void _paren_plus_loop_paren() {
930 register Cell old_index = *rp;
932 if (old_index < rp[1] && rp[0] >= rp[1]) {
935 } else ip += 1 + (Cell) *ip;
939 register Char *addr = (Char *) *sp;
940 register Cell len = (Cell) *addr++;
941 register struct word_def *xt = search_word(addr, len);
942 set_find_stack(addr, xt);
946 compile_cell((Cell) _paren_do_colon_paren);
947 compile_cell((Cell) &_last->func[0]);
955 if (!(*sp = (Cell) search_word(addr + 1, *addr))) _error = E_NOWORD;
959 *sp = (Cell) &((struct word_def *) *sp)->func[0];
967 void _abort_quote() {
970 compile_cell((Cell) _do_literal);
972 compile_cell((Cell) _throw);
977 register Char *addr = (Char *) *sp;
979 sp[0] = (Cell) *addr;
987 void _environment_query() {
988 register Cell len = *sp++;
989 register Char *addr = (Char *) *sp++;
994 { "/COUNTED-STRING", &_env_slash_counted_string },
995 { "/HOLD", &_env_slash_hold },
996 { "/PAD", &_env_slash_pad },
997 { "ADDRESS-UNIT-BITS", &_env_address_unit_bits },
998 { "CORE", &_env_core },
999 { "CORE-EXT", &_env_core_ext },
1000 { "FLOORED", &_env_floored },
1001 { "MAX-CHAR", &_env_max_char },
1002 { "MAX-D", &_env_max_d },
1003 { "MAX-N", &_env_max_n },
1004 { "MAX-U", &_env_max_u },
1005 { "MAX-UD", &_env_max_ud },
1006 { "RETURN-STACK-CELLS", &_env_return_stack_cells },
1007 { "STACK-CELLS", &_env_stack_cells },
1008 { "DOUBLE", &_env_double },
1009 { "DOUBLE-EXT", &_env_double_ext },
1010 { "FLOATING", &_env_floating },
1011 { "FLOATING-STACK", &_env_floating_stack },
1012 { "MAX-FLOAT", &_env_max_float },
1013 { "FLOATING-EXT", &_env_floating_ext },
1014 { "MEMORY-ALLOC", &_env_memory_alloc },
1015 { "MEMORY-ALLOC-EXT", &_env_memory_alloc_ext },
1016 { "SEARCH-ORDER", &_env_search_order },
1017 { "WORDLISTS", &_env_wordlists },
1018 { "SEARCH-ORDER-EXT", &_env_search_order_ext },
1019 { "TOOLS", &_env_tools },
1020 { "TOOLS-EXT", &_env_tools_ext },
1021 { "#LOCALS", &_env_number_locals },
1022 { "LOCALS", &_env_locals },
1023 { "LOCALS-EXT", &_env_locals_ext },
1024 { "FACILITY", &_env_facility },
1025 { "FACILITY-EXT", &_env_facility_ext },
1026 { "BLOCK", &_env_block },
1027 { "BLOCK-EXT", &_env_block_ext },
1028 { "EXCEPTION", &_env_exception },
1029 { "EXCEPTION-EXT", &_env_exception_ext },
1030 { "FILE", &_env_file },
1031 { "FILE-EXT", &_env_file_ext },
1032 { "STRING", &_env_string },
1033 { "STRING-EXT", &_env_string_ext },
1037 for (i = 0; i < len; i++) addr[i] = toupper(addr[i]);
1039 while (kw[i].name && memcmp(addr, kw[i].name, len)) i++;
1041 if (!strcmp(kw[i].name + 1, "MAX-UD")) {
1043 PUT_DCELL(sp, MAX_UD);
1044 } else if (!strcmp(kw[i].name + 1, "MAX-FLOAT"))
1046 else *--sp = *kw[i].var;
1048 } else *--sp = FFLAG(0);
1052 exec_word((struct word_def *) *sp++);
1056 register int c = (int) *sp++;
1057 register UCell u = (UCell) *sp++;
1058 register Char *addr = (Char *) *sp++;
1059 if (u) memset(addr, c, u);
1063 _last->class |= IMMEDIATE;
1072 while (*ip != _paren_loop_paren && *ip != _paren_plus_loop_paren) ip++;
1077 compile_cell((Cell) _do_literal);
1078 compile_cell(sp[0]);
1083 register UCell u = (UCell) *sp++;
1084 register Char *dest = (Char *) *sp++;
1085 register Char *source = (Char *) *sp++;
1086 if (u) memmove(dest, source, u);
1093 if (*sp++ > 0) /* IMMEDIATE word */
1094 compile_word((struct word_def *) *sp++);
1096 compile_cell((Cell) _paren_compile_paren);
1097 compile_cell(sp[0]);
1102 void _paren_compile_paren() {
1103 compile_word((struct word_def *) *sp++);
1107 if (_state == INTERPRET) {
1110 memcpy(s_tmp_buffer, _dp, *_dp + 1);
1111 sp[0] = (Cell) s_tmp_buffer;
1115 compile_cell((Cell) _count);
1130 void _left_bracket() {
1134 void _bracket_tick() {
1145 void _bracket_char() {
1150 void _right_bracket() {
1166 *--sp = (Cell) *((Cell *) *ip++);
1169 /**************************************************************************/
1170 /* AUXILIARY FUNCTIONS ****************************************************/
1171 /**************************************************************************/
1173 /* strmatch: compare two strings, the first is expressed as (s1, len), while
1174 * the second is a counted string pointed by "s2". If the two strings are
1175 * identical return 0, 1 otherwise. The comparison is case INsensitive
1177 int strmatch(const Char *s1, const Char *s2, int len1) {
1178 if (len1 != *s2++) return (1);
1180 while (len1--) if (toupper(*s1++) != toupper(*s2++)) return (1);
1185 /* search_wordlist: search a word (name, len) within the selected vocabulary.
1186 * Called by "search_word"
1188 struct word_def *search_wordlist(Char *name, Cell len, struct vocabulary *wid) {
1189 register struct word_def *p = wid->voc[hash_func(name, len)];
1190 while (p && strmatch(name, p->name, len)) p = p->link;
1194 /* search_word: search the word (name, len) into the vocabularies, starting
1195 * with the vocabulary on the top of the vocabularies stack. If found,
1196 * return the word's execution token, which is a pointer to the structure
1197 * "word_def" of the word. If not found, return NULL.
1199 struct word_def *search_word(Char *name, Cell len) {
1200 register struct word_def *p;
1201 register Cell ttop = top;
1202 if (locals_defined()) {
1203 p = get_first_local();
1204 while (p && strmatch(name, p->name, len)) p = p->link;
1208 p = search_wordlist(name, len, ttop >= 0 ? list[ttop] : forth_wid);
1215 /* ins_word: add the word with execution token "p" in the current
1216 * compilation vocabulary
1218 void ins_word(struct word_def *p) {
1219 register int hash = hash_func(p->name + 1, *p->name);
1220 p->link = voc->voc[hash];
1223 /* mark_word: make the word with execution token "p" visible, by updating
1224 * the compilation vocabulary head pointer
1226 void mark_word(struct word_def *p) {
1227 register int hash = hash_func(p->name + 1, *p->name);
1231 /* set_find_stack: setup the data stack after a search in the vocabularies
1232 * as reuired by the word "find"
1234 void set_find_stack(Char *addr, struct word_def *xt) {
1237 if (xt->class & IMMEDIATE) *--sp = 1;
1238 else *--sp = (Cell) -1;
1245 /* is_base_digit: return true if the digit "ch" is valid in the current base
1246 * stored in the variable "base".
1248 int is_base_digit(Char ch) {
1250 if (ch >= '0' && ch <= '9') {
1251 if (ch - '0' < _base) return (1);
1254 if (ch >= 'A' && ch <= 'Z') {
1255 if (ch - 'A' + 10 < _base) return (1);
1261 /* process_char: do the work when a key is stroken on the keyboard.
1262 * "addr" is a base pointer to the buffer where the characters are to be
1263 * stored, "max_len" is the size of the buffer, "cur_pos" the current
1264 * position within the buffer, and "ch" the character to be processed.
1266 int process_char(Char *addr, int max_len, int cur_pos, char ch) {
1269 if (cur_pos) cur_pos--;
1276 if (cur_pos < max_len) addr[cur_pos++] = ch;
1284 /* create_definition: create a new word in the dictionary allocating the
1285 * space for the name, which is stored yet by the call to "word", then
1286 * allocating a structure "word_def" and setting the "class" field to the
1287 * value passed to the function.
1289 void create_definition(Cell class) {
1290 register struct word_def *def;
1291 register Char *name;
1296 _dp = (Char *) WORD_PTR(_dp);
1298 def = (struct word_def *) _dp;
1303 _dp += sizeof(struct word_def) - sizeof(Cell);
1306 /* exec_colon: execute a colon definition, with the first instruction pointed
1309 void exec_colon(pfp *ip0) {
1310 register pfp *old_ip = ip;
1312 while (ip) (*ip++)();
1316 /* exec_word: execute the word with execution token "xt" when interpreting
1318 void exec_word(struct word_def *xt) {
1319 switch (xt->class & A_WORD) {
1320 case A_PRIMITIVE: xt->func[0](); break;
1323 case A_VARIABLE: *--sp = (Cell) &xt->func[0]; break;
1324 case A_COLON: exec_colon(&xt->func[0]); break;
1327 case A_CONSTANT: *--sp = (Cell) xt->func[0]; break;
1329 *--sp = (Cell) xt->func[0];
1330 *--sp = (Cell) xt->func[1];
1332 case A_FCONSTANT: *--fp = *((Real *) &xt->func[0]); break;
1334 *--sp = (Cell) &xt->func[1];
1335 if (xt->func[0]) exec_colon((pfp *) xt->func[0]);
1338 exec_marker((struct voc_marker *) &xt->func[0]);
1341 default: _error = E_NOVOC; break;
1345 /* compile_word: compile word with execution token "xt" within the dictionary
1347 void compile_word(struct word_def *xt) {
1348 switch (xt->class & A_WORD) {
1350 compile_cell((Cell) xt->func[0]);
1355 compile_cell((Cell) _do_literal);
1356 compile_cell((Cell) &xt->func[0]);
1359 compile_cell((Cell) _do_value);
1360 compile_cell((Cell) &xt->func[0]);
1364 compile_cell((Cell) _do_literal);
1365 compile_cell((Cell) xt->func[0]);
1368 compile_cell((Cell) _do_literal);
1369 compile_cell((Cell) xt->func[0]);
1370 compile_cell((Cell) _do_literal);
1371 compile_cell((Cell) xt->func[1]);
1374 compile_cell((Cell) _do_fliteral);
1375 compile_real(*((Real *) &xt->func[0]));
1378 compile_cell((Cell) _paren_do_colon_paren);
1379 compile_cell((Cell) &xt->func[0]);
1382 compile_cell((Cell) _do_literal);
1383 compile_cell((Cell) &xt->func[1]);
1385 compile_cell((Cell) _paren_do_colon_paren);
1386 compile_cell((Cell) xt->func[0]);
1390 compile_cell((Cell) _paren_read_local_paren);
1391 compile_cell((Cell) xt->func[0]);
1394 compile_cell((Cell) _paren_marker_paren);
1395 compile_cell((Cell) &xt->func[0]);
1397 default: _error = E_NOVOC; break;
1401 /* save_input_specification: save all the information needed to restore the
1402 * state of current input later. First the word "save-input" is called, and
1403 * then each Cell on the stack is copied in the return stack
1405 void save_input_specification() {
1406 register int dim, dim1;
1409 while (dim--) _to_r();
1410 *--sp = (Cell) dim1;
1414 /* restore_input_specification: restore the input source by calling
1415 * "restore-input" after that the Cells on the return stack has been moved
1418 void restore_input_specification() {
1419 register int dim = *rp++, dim1 = dim;
1420 while (dim--) _r_from();
1421 *--sp = (Cell) dim1;
1426 /* check_system: perform some tests to verify that's everything ok */
1427 void check_system() {
1428 if (sp > sp_top) _error = E_DSTK_UNDER;
1429 else if (sp < sp_base) _error = E_DSTK_OVER;
1430 else if (rp > rp_top) _error = E_RSTK_UNDER;
1431 else if (rp < rp_base) _error = E_RSTK_OVER;
1432 else if (fstack_size && fp > fp_top) _error = E_FSTK_UNDER;
1433 else if (fstack_size && fp < fp_base) _error = E_FSTK_OVER;
1434 else if (_dp < dp0) _error = E_DSPACE_UNDER;
1435 else if (_dp > dp0 + dspace_size) _error = E_DSPACE_OVER;