1 /* yForth? - Written by Luca Padovani (C) 1996/97
2 * ------------------------------------------------------------------------
3 * This software is FreeWare as long as it comes with this header in each
4 * source file, anyway you can use it or any part of it whatever
5 * you want. It comes without any warranty, so use it at your own risk.
6 * ------------------------------------------------------------------------
8 * Abstract: Core word set
27 /**************************************************************************/
28 /* VARIABLES **************************************************************/
29 /**************************************************************************/
31 Char s_tmp_buffer[TMP_BUFFER_SIZE]; /* used by s" */
33 Cell _to_in; /* ptr to parse area */
34 Cell _source_id; /* input source device */
35 Char * _tib; /* ptr to terminal input buffer */
36 Char * _input_buffer; /* current input buffer */
37 Cell _in_input_buffer; /* # of chars in input buffer */
38 Cell _base; /* base is base */
39 Char * _dp; /* dictionary pointer */
40 Cell _error; /* error code */
41 struct word_def * _last; /* ptr to last defined word */
42 Cell _state; /* state of the interpreter */
43 Cell _check_system = 1; /* 1 => check stacks overflow & underflow */
44 /* Some variables used by environment? follows... */
45 Cell _env_slash_counted_string;
48 Cell _env_address_unit_bits;
57 Cell _env_return_stack_cells;
58 Cell _env_stack_cells;
62 Cell _env_floating_stack;
64 Cell _env_floating_ext;
65 Cell _env_memory_alloc;
66 Cell _env_memory_alloc_ext;
67 Cell _env_search_order;
68 Cell _env_search_order_ext;
72 Cell _env_number_locals;
76 Cell _env_facility_ext;
80 Cell _env_exception_ext;
86 /**************************************************************************/
87 /* WORDS ******************************************************************/
88 /**************************************************************************/
91 compile_cell((Cell) _paren_dot_quote_paren);
94 _dp = (Char *) WORD_PTR(_dp);
98 void _paren_dot_quote_paren() {
99 register Char *addr = (Char *) ip;
100 *--sp = (Cell) (addr + 1);
101 *--sp = (Cell) *addr;
103 ip = (pfp *) WORD_PTR((Char *) ip);
107 register Cell u = *sp++;
108 register Char *addr = (Char *) *sp++;
109 while (u--) putchar(*addr++);
116 _number_sign_greater();
136 register DCell u = *sp;
137 register int usign = u < 0;
147 _number_sign_greater();
158 register UCell u = *sp++;
159 while (u--) putchar(' ');
162 void _less_number_sign() {
164 p_pnos = pnos + pnos_size;
167 void _number_sign() {
168 register UDCell ud1 = GET_DCELL(sp);
169 register int rem = ud1 % _base;
172 if (rem < 10) *--p_pnos = rem + '0';
173 else *--p_pnos = rem - 10 + 'a';
178 register Char ch = (Char) *sp++;
183 void _number_sign_s() {
185 while (sp[0] || sp[1]);
188 void _number_sign_greater() {
189 sp[1] = (Cell) p_pnos;
194 register Cell *addr = (Cell *) *sp++;
204 register DCell d = (DCell) sp[1] * (DCell) sp[2];
205 sp[2] = d / (DCell) sp[0];
209 void _star_slash_mod() {
210 register DCell d = (DCell) sp[1] * (DCell) sp[2];
211 sp[2] = d % (DCell) sp[0];
212 sp[1] = d / (DCell) sp[0];
222 register Cell *addr = (Cell *) *sp++;
237 register Cell n1 = sp[1];
238 register Cell n2 = sp[0];
244 sp[0] = FFLAG(sp[0] < 0);
247 void _zero_equals() {
248 sp[0] = FFLAG(sp[0] == 0);
260 register Cell *addr = (Cell *) *sp++;
274 register Cell *addr = (Cell *) *sp;
296 register Cell x4 = sp[0];
297 register Cell x3 = sp[1];
305 sp[1] = FFLAG(sp[1] < sp[0]);
310 sp[1] = FFLAG(sp[1] == sp[0]);
314 void _greater_than() {
315 sp[1] = FFLAG(sp[1] > sp[0]);
323 void _question_dupe() {
324 if (sp[0]) sp--, sp[0] = sp[1];
328 sp[0] = *((Cell *) sp[0]);
332 register Cell n = sp[0];
333 sp[0] = n >= 0 ? n : -n;
337 _dp = (Char *) ALIGN_PTR(_dp);
341 sp[0] = ALIGN_PTR((Cell *) sp[0]);
354 register Char *addr = (Char *) *sp++;
355 *addr = (Char) *sp++;
359 register Char *addr = (Char *) *sp;
364 sp[0] += sizeof(Cell);
368 sp[0] *= sizeof(Cell);
372 sp[0] += sizeof(Char);
376 sp[0] *= sizeof(Char);
380 register Cell dep = sp_top - sp;
393 void _f_m_slash_mod() {
394 register Cell n1 = *sp++;
395 register DCell d1 = GET_DCELL(sp);
398 #if !FLOORED_DIVISION
401 if (sp[1] > 0) sp[1]++;
413 register UCell u = (UCell) *sp++;
418 register DCell d = (DCell) sp[1] * (DCell) sp[0];
423 register Cell n2 = *sp++;
424 sp[0] = sp[0] > n2 ? sp[0] : n2;
428 register Cell n2 = *sp++;
429 sp[0] = sp[0] < n2 ? sp[0] : n2;
460 register Cell x3 = sp[0];
461 register Cell x2 = sp[1];
462 register Cell x1 = sp[2];
469 register UCell u = (UCell) *sp++;
470 ((UCell *) sp)[0] >>= u;
474 register DCell d = (DCell) (*sp--);
478 void _s_m_slash_rem() {
479 register Cell n1 = *sp++;
480 register DCell d1 = GET_DCELL(sp);
486 if (sp[1] > 0) sp[1]--;
494 register Cell temp = sp[0];
499 void _u_less_than() {
500 sp[1] = FFLAG((UCell) sp[1] < (UCell) sp[0]);
505 register UDCell ud = (UDCell) sp[1] * (UDCell) sp[0];
509 void _u_m_slash_mod() {
510 register UCell u1 = *sp++;
511 register UDCell ud = GET_DCELL(sp);
522 *--sp = (Cell) *ip++;
525 void _do_fliteral() {
526 *--fp = (Real) *((Real *) ip);
527 ip += sizeof(Real) / sizeof(Cell);
532 register Char delim = (Char) *sp;
534 while (_to_in < _in_input_buffer && _input_buffer[_to_in] == delim) _to_in++;
538 for (j = 0; j < i; j++) *(_dp + j + 1) = *addr++;
539 *(_dp + i + 1) = ' ';
544 register UCell u1 = (UCell) *sp;
545 register Char *addr = (Char *) *(sp + 1);
546 register UDCell ud1 = GET_DCELL(sp + 2);
547 while (is_base_digit(*addr) && u1) {
549 if (*addr <= '9') ud1 += *addr - '0';
550 else ud1 += toupper(*addr) - 'A' + 10;
554 PUT_DCELL(sp + 2, ud1);
555 *(sp + 1) = (Cell) addr;
561 register Cell usign = 1;
563 register const_type = 1;
564 register Char *orig = (Char *) sp[1];
565 register Cell orig_len = sp[0];
566 if (sp[0] && *((Char *) sp[1]) == '-') {
568 sp[1] += sizeof(Char);
573 if (sp[0] && *((Char *) sp[1]) == '.') {
576 sp[1] += sizeof(Char);
580 num = GET_DCELL(sp + 1);
583 PUT_DCELL(sp + 1, num);
585 if (!n) *sp = const_type;
602 register struct word_def *xt;
603 while (!_error && _to_in < _in_input_buffer) {
607 if (!(*_dp)) continue; /* Please forget this! */
608 xt = search_word(_dp + 1, *_dp);
610 if (_state == INTERPRET) {
611 if (xt->class & COMP_ONLY) _error = E_NOCOMP;
613 } else /* _state == COMPILE */ {
614 if (xt->class & IMMEDIATE) exec_word(xt);
615 else compile_word(xt);
617 } else /* xt == 0 */ {
621 *--sp = (Cell) (_dp + sizeof(Char));
631 if (_state == INTERPRET) sp++;
634 compile_cell((Cell) _do_literal);
635 compile_cell((Cell) num);
640 if (_state == COMPILE) {
642 compile_cell((Cell) _do_literal);
643 compile_cell((Cell) num);
644 compile_cell((Cell) _do_literal);
645 compile_cell((Cell) (num >> CellBits));
649 if (_state == COMPILE) {
650 compile_cell((Cell) _do_fliteral);
662 register Cell n1 = *sp++;
663 register Char *addr = (Char *) *sp;
668 i = process_char(addr, n1, i, ch);
669 } while (ch != '\n');
674 *--sp = (Cell) _input_buffer;
675 *--sp = _in_input_buffer;
679 register Cell eof = 1;
681 while (_to_in < _in_input_buffer && _input_buffer[_to_in] != ')') _to_in++;
682 if (_source_id != 0 && _source_id != -1 && _to_in == _in_input_buffer) {
686 } while (_to_in == _in_input_buffer && !eof);
687 if (_to_in < _in_input_buffer) _to_in++;
691 register Cell u = *sp++;
692 register Char *addr = (Char *) *sp++;
693 save_input_specification();
695 _in_input_buffer = u;
696 _input_buffer = addr;
700 restore_input_specification();
703 void _view_error_msg() {
704 static struct an_error {
709 { "everything allright", 0, 0 },
710 { "no input avaliable", 0, 0 },
711 { "unknown word", 0, 1 },
712 { "word must be compiled", 0, 1 },
713 { "corrupted dictionary", 1, 0 },
714 { "not enough memory", 0, 0 },
715 { "data-stack underflow", 1, 0 },
716 { "data-stack overflow", 1, 0 },
717 { "return-stack underflow", 1, 0 },
718 { "return-stack overflow", 1, 0 },
719 { "floating-stack underflow", 1, 0 },
720 { "floating-stack overflow", 1, 0 },
721 { "data-space corrupted", 1, 0 },
722 { "data-space exhausted", 1, 0 },
723 { "unable to access image file", 0, 0 },
724 { "primitive not implemented", 0, 1 },
725 { "floating-point/math exception", 0, 0 },
726 { "segmentation fault", 0, 0 },
727 { "file not found", 0, 0 },
729 if (err_msg[-_error].print_word) {
736 printf("error(%d): %s.\n", -_error, err_msg[-_error].msg);
737 if (err_msg[-_error].please_abort) {
738 printf("Aborting...\n");
747 _input_buffer = _tib;
750 while (_error == E_OK) {
755 if (_state == INTERPRET && !_error) printf("ok\n");
756 else if (_state == COMPILE) printf("ko ");
757 } else _error = E_NOINPUT;
758 if (_error == E_OK && _check_system) check_system();
765 *((Cell *) _dp) = *sp++;
774 *_dp++ = (Char) *sp++;
787 compile_cell((Cell) _do_exit);
790 void _paren_do_colon_paren() {
791 *--rp = (Cell) (ip + 1);
793 while (ip) (*ip++)();
798 create_definition(A_COLON);
804 create_definition(A_VARIABLE);
810 register Cell x = *sp++;
811 create_definition(A_CONSTANT);
817 create_definition(A_CREATE);
823 compile_cell((Cell) _paren_does_paren);
829 void _paren_does_paren() {
830 _last->func[0] = (pfp) (ip + 1);
839 void _zero_branch() {
841 else ip += 1 + (Cell) *ip;
845 ip += 1 + (Cell) *ip;
849 compile_cell((Cell) _zero_branch);
855 register Cell *patch = (Cell *) *sp++;
856 *patch = ((Cell *) _dp) - patch - 1;
871 compile_cell((Cell) _paren_do_paren);
873 *--sp = 0; /* Non e' un ?do */
876 void _paren_do_paren() {
879 /* R: index limit --- */
883 register Cell q_do = *sp++;
884 register Cell *dest = (Cell *) *sp++;
885 compile_cell((Cell) _paren_loop_paren);
886 compile_cell(dest - ((Cell *) _dp) - 1);
888 register Cell *patch = (Cell *) *sp++;
889 *patch = ((Cell *) _dp) - patch - 1;
893 void _paren_loop_paren() {
894 if (rp[0] == ++rp[1]) {
897 } else ip += 1 + (Cell) *ip;
909 register Cell q_do = *sp++;
910 register Cell *dest = (Cell *) *sp++;
911 compile_cell((Cell) _paren_plus_loop_paren);
912 compile_cell(dest - ((Cell *) _dp) - 1);
914 register Cell *patch = (Cell *) *sp++;
915 *patch = ((Cell *) _dp) - patch - 1;
919 void _paren_plus_loop_paren() {
920 register Cell old_index = *rp;
922 if (old_index < rp[1] && rp[0] >= rp[1]) {
925 } else ip += 1 + (Cell) *ip;
929 register Char *addr = (Char *) *sp;
930 register Cell len = (Cell) *addr++;
931 register struct word_def *xt = search_word(addr, len);
932 set_find_stack(addr, xt);
936 compile_cell((Cell) _paren_do_colon_paren);
937 compile_cell((Cell) &_last->func[0]);
945 if (!(*sp = (Cell) search_word(addr + 1, *addr))) _error = E_NOWORD;
949 *sp = (Cell) &((struct word_def *) *sp)->func[0];
957 void _abort_quote() {
960 compile_cell((Cell) _do_literal);
962 compile_cell((Cell) _throw);
967 register Char *addr = (Char *) *sp;
969 sp[0] = (Cell) *addr;
977 void _environment_query() {
978 register Cell len = *sp++;
979 register Char *addr = (Char *) *sp++;
984 { "/COUNTED-STRING", &_env_slash_counted_string },
985 { "/HOLD", &_env_slash_hold },
986 { "/PAD", &_env_slash_pad },
987 { "ADDRESS-UNIT-BITS", &_env_address_unit_bits },
988 { "CORE", &_env_core },
989 { "CORE-EXT", &_env_core_ext },
990 { "FLOORED", &_env_floored },
991 { "MAX-CHAR", &_env_max_char },
992 { "MAX-D", &_env_max_d },
993 { "MAX-N", &_env_max_n },
994 { "MAX-U", &_env_max_u },
995 { "MAX-UD", &_env_max_ud },
996 { "RETURN-STACK-CELLS", &_env_return_stack_cells },
997 { "STACK-CELLS", &_env_stack_cells },
998 { "DOUBLE", &_env_double },
999 { "DOUBLE-EXT", &_env_double_ext },
1000 { "FLOATING", &_env_floating },
1001 { "FLOATING-STACK", &_env_floating_stack },
1002 { "MAX-FLOAT", &_env_max_float },
1003 { "FLOATING-EXT", &_env_floating_ext },
1004 { "MEMORY-ALLOC", &_env_memory_alloc },
1005 { "MEMORY-ALLOC-EXT", &_env_memory_alloc_ext },
1006 { "SEARCH-ORDER", &_env_search_order },
1007 { "WORDLISTS", &_env_wordlists },
1008 { "SEARCH-ORDER-EXT", &_env_search_order_ext },
1009 { "TOOLS", &_env_tools },
1010 { "TOOLS-EXT", &_env_tools_ext },
1011 { "#LOCALS", &_env_number_locals },
1012 { "LOCALS", &_env_locals },
1013 { "LOCALS-EXT", &_env_locals_ext },
1014 { "FACILITY", &_env_facility },
1015 { "FACILITY-EXT", &_env_facility_ext },
1016 { "BLOCK", &_env_block },
1017 { "BLOCK-EXT", &_env_block_ext },
1018 { "EXCEPTION", &_env_exception },
1019 { "EXCEPTION-EXT", &_env_exception_ext },
1020 { "FILE", &_env_file },
1021 { "FILE-EXT", &_env_file_ext },
1022 { "STRING", &_env_string },
1023 { "STRING-EXT", &_env_string_ext },
1027 for (i = 0; i < len; i++) addr[i] = toupper(addr[i]);
1029 while (kw[i].name && memcmp(addr, kw[i].name, len)) i++;
1031 if (!strcmp(kw[i].name + 1, "MAX-UD")) {
1033 PUT_DCELL(sp, MAX_UD);
1034 } else if (!strcmp(kw[i].name + 1, "MAX-FLOAT"))
1036 else *--sp = *kw[i].var;
1038 } else *--sp = FFLAG(0);
1042 exec_word((struct word_def *) *sp++);
1046 register int c = (int) *sp++;
1047 register UCell u = (UCell) *sp++;
1048 register Char *addr = (Char *) *sp++;
1049 if (u) memset(addr, c, u);
1053 _last->class |= IMMEDIATE;
1062 while (*ip != _paren_loop_paren && *ip != _paren_plus_loop_paren) ip++;
1067 compile_cell((Cell) _do_literal);
1068 compile_cell(sp[0]);
1073 register UCell u = (UCell) *sp++;
1074 register Char *dest = (Char *) *sp++;
1075 register Char *source = (Char *) *sp++;
1076 if (u) memmove(dest, source, u);
1083 if (*sp++ > 0) /* IMMEDIATE word */
1084 compile_word((struct word_def *) *sp++);
1086 compile_cell((Cell) _paren_compile_paren);
1087 compile_cell(sp[0]);
1092 void _paren_compile_paren() {
1093 compile_word((struct word_def *) *sp++);
1097 if (_state == INTERPRET) {
1100 memcpy(s_tmp_buffer, _dp, *_dp + 1);
1101 sp[0] = (Cell) s_tmp_buffer;
1105 compile_cell((Cell) _count);
1120 void _left_bracket() {
1124 void _bracket_tick() {
1135 void _bracket_char() {
1140 void _right_bracket() {
1156 *--sp = (Cell) *((Cell *) *ip++);
1159 /**************************************************************************/
1160 /* AUXILIARY FUNCTIONS ****************************************************/
1161 /**************************************************************************/
1163 /* strmatch: compare two strings, the first is expressed as (s1, len), while
1164 * the second is a counted string pointed by "s2". If the two strings are
1165 * identical return 0, 1 otherwise. The comparison is case INsensitive
1167 int strmatch(const Char *s1, const Char *s2, int len1) {
1168 if (len1 != *s2++) return (1);
1170 while (len1--) if (toupper(*s1++) != toupper(*s2++)) return (1);
1175 /* search_wordlist: search a word (name, len) within the selected vocabulary.
1176 * Called by "search_word"
1178 struct word_def *search_wordlist(Char *name, Cell len, struct vocabulary *wid) {
1179 register struct word_def *p = wid->voc[hash_func(name, len)];
1180 while (p && strmatch(name, p->name, len)) p = p->link;
1184 /* search_word: search the word (name, len) into the vocabularies, starting
1185 * with the vocabulary on the top of the vocabularies stack. If found,
1186 * return the word's execution token, which is a pointer to the structure
1187 * "word_def" of the word. If not found, return NULL.
1189 struct word_def *search_word(Char *name, Cell len) {
1190 register struct word_def *p;
1191 register Cell ttop = top;
1192 if (locals_defined()) {
1193 p = get_first_local();
1194 while (p && strmatch(name, p->name, len)) p = p->link;
1198 p = search_wordlist(name, len, ttop >= 0 ? list[ttop] : forth_wid);
1205 /* ins_word: add the word with execution token "p" in the current
1206 * compilation vocabulary
1208 void ins_word(struct word_def *p) {
1209 register int hash = hash_func(p->name + 1, *p->name);
1210 p->link = voc->voc[hash];
1213 /* mark_word: make the word with execution token "p" visible, by updating
1214 * the compilation vocabulary head pointer
1216 void mark_word(struct word_def *p) {
1217 register int hash = hash_func(p->name + 1, *p->name);
1221 /* set_find_stack: setup the data stack after a search in the vocabularies
1222 * as reuired by the word "find"
1224 void set_find_stack(Char *addr, struct word_def *xt) {
1227 if (xt->class & IMMEDIATE) *--sp = 1;
1228 else *--sp = (Cell) -1;
1235 /* is_base_digit: return true if the digit "ch" is valid in the current base
1236 * stored in the variable "base".
1238 int is_base_digit(Char ch) {
1240 if (ch >= '0' && ch <= '9') {
1241 if (ch - '0' < _base) return (1);
1244 if (ch >= 'A' && ch <= 'Z') {
1245 if (ch - 'A' + 10 < _base) return (1);
1251 /* process_char: do the work when a key is stroken on the keyboard.
1252 * "addr" is a base pointer to the buffer where the characters are to be
1253 * stored, "max_len" is the size of the buffer, "cur_pos" the current
1254 * position within the buffer, and "ch" the character to be processed.
1256 int process_char(Char *addr, int max_len, int cur_pos, char ch) {
1259 if (cur_pos) cur_pos--;
1266 if (cur_pos < max_len) addr[cur_pos++] = ch;
1274 /* create_definition: create a new word in the dictionary allocating the
1275 * space for the name, which is stored yet by the call to "word", then
1276 * allocating a structure "word_def" and setting the "class" field to the
1277 * value passed to the function.
1279 void create_definition(Cell class) {
1280 register struct word_def *def;
1281 register Char *name;
1286 _dp = (Char *) WORD_PTR(_dp);
1288 def = (struct word_def *) _dp;
1293 _dp += sizeof(struct word_def) - sizeof(Cell);
1296 /* exec_colon: execute a colon definition, with the first instruction pointed
1299 void exec_colon(pfp *ip0) {
1300 register pfp *old_ip = ip;
1302 while (ip) (*ip++)();
1306 /* exec_word: execute the word with execution token "xt" when interpreting
1308 void exec_word(struct word_def *xt) {
1309 switch (xt->class & A_WORD) {
1310 case A_PRIMITIVE: xt->func[0](); break;
1313 case A_VARIABLE: *--sp = (Cell) &xt->func[0]; break;
1314 case A_COLON: exec_colon(&xt->func[0]); break;
1317 case A_CONSTANT: *--sp = (Cell) xt->func[0]; break;
1319 *--sp = (Cell) xt->func[0];
1320 *--sp = (Cell) xt->func[1];
1322 case A_FCONSTANT: *--fp = *((Real *) &xt->func[0]); break;
1324 *--sp = (Cell) &xt->func[1];
1325 if (xt->func[0]) exec_colon((pfp *) xt->func[0]);
1328 exec_marker((struct voc_marker *) &xt->func[0]);
1331 default: _error = E_NOVOC; break;
1335 /* compile_word: compile word with execution token "xt" within the dictionary
1337 void compile_word(struct word_def *xt) {
1338 switch (xt->class & A_WORD) {
1340 compile_cell((Cell) xt->func[0]);
1345 compile_cell((Cell) _do_literal);
1346 compile_cell((Cell) &xt->func[0]);
1349 compile_cell((Cell) _do_value);
1350 compile_cell((Cell) &xt->func[0]);
1354 compile_cell((Cell) _do_literal);
1355 compile_cell((Cell) xt->func[0]);
1358 compile_cell((Cell) _do_literal);
1359 compile_cell((Cell) xt->func[0]);
1360 compile_cell((Cell) _do_literal);
1361 compile_cell((Cell) xt->func[1]);
1364 compile_cell((Cell) _do_fliteral);
1365 compile_real(*((Real *) &xt->func[0]));
1368 compile_cell((Cell) _paren_do_colon_paren);
1369 compile_cell((Cell) &xt->func[0]);
1372 compile_cell((Cell) _do_literal);
1373 compile_cell((Cell) &xt->func[1]);
1375 compile_cell((Cell) _paren_do_colon_paren);
1376 compile_cell((Cell) xt->func[0]);
1380 compile_cell((Cell) _paren_read_local_paren);
1381 compile_cell((Cell) xt->func[0]);
1384 compile_cell((Cell) _paren_marker_paren);
1385 compile_cell((Cell) &xt->func[0]);
1387 default: _error = E_NOVOC; break;
1391 /* save_input_specification: save all the information needed to restore the
1392 * state of current input later. First the word "save-input" is called, and
1393 * then each Cell on the stack is copied in the return stack
1395 void save_input_specification() {
1396 register int dim, dim1;
1399 while (dim--) _to_r();
1400 *--sp = (Cell) dim1;
1404 /* restore_input_specification: restore the input source by calling
1405 * "restore-input" after that the Cells on the return stack has been moved
1408 void restore_input_specification() {
1409 register int dim = *rp++, dim1 = dim;
1410 while (dim--) _r_from();
1411 *--sp = (Cell) dim1;
1416 /* check_system: perform some tests to verify that's everything ok */
1417 void check_system() {
1418 if (sp > sp_top) _error = E_DSTK_UNDER;
1419 else if (sp < sp_base) _error = E_DSTK_OVER;
1420 else if (rp > rp_top) _error = E_RSTK_UNDER;
1421 else if (rp < rp_base) _error = E_RSTK_OVER;
1422 else if (fstack_size && fp > fp_top) _error = E_FSTK_UNDER;
1423 else if (fstack_size && fp < fp_base) _error = E_FSTK_OVER;
1424 else if (_dp < dp0) _error = E_DSPACE_UNDER;
1425 else if (_dp > dp0 + dspace_size) _error = E_DSPACE_OVER;