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: include file for "core" word set
38 /**************************************************************************/
39 /* VARIABLES **************************************************************/
40 /**************************************************************************/
42 variable(Cell, to_in, ">in")
43 variable(Cell, source_id, "source-id")
44 variable(Char *, tib, "tib")
45 variable(Char *, input_buffer, "input-buffer")
46 variable(Cell, in_input_buffer, "in-input-buffer")
47 variable(Cell, base, "base")
48 variable(Char *, dp, "dp")
49 variable(Cell, error, "error")
50 variable(struct word_def *, last, "last")
51 variable(Cell, state, "state")
52 variable(Cell, env_slash_counted_string, "&counted-string")
53 variable(Cell, env_slash_hold, "&hold")
54 variable(Cell, env_slash_pad, "&pad")
55 variable(Cell, env_address_unit_bits, "&address-unit-bits")
56 variable(Cell, env_core, "&core")
57 variable(Cell, env_core_ext, "&core-ext")
58 variable(Cell, env_floored, "&floored")
59 variable(Cell, env_max_char, "&max-char")
60 variable(Cell, env_max_d, "&max-d")
61 variable(Cell, env_max_n, "&max-n")
62 variable(Cell, env_max_u, "&max-u")
63 variable(Cell, env_max_ud, "&max-ud")
64 variable(Cell, env_return_stack_cells, "&return-stack-cells")
65 variable(Cell, env_stack_cells, "&stack-cells")
66 variable(Cell, env_double, "&double")
67 variable(Cell, env_double_ext, "&double-ext")
68 variable(Cell, env_floating, "&floating")
69 variable(Cell, env_floating_stack, "&floating-stack")
70 variable(Cell, env_max_float, "&max-float")
71 variable(Cell, env_floating_ext, "&floating-ext")
72 variable(Cell, env_memory_alloc, "&memory-alloc")
73 variable(Cell, env_memory_alloc_ext, "&memory-alloc-ext")
74 variable(Cell, env_search_order, "&search-order")
75 variable(Cell, env_wordlists, "&wordlists")
76 variable(Cell, env_search_order_ext, "&search-order-ext")
77 variable(Cell, env_tools, "&tools")
78 variable(Cell, env_tools_ext, "&tools-ext")
79 variable(Cell, env_number_locals, "&#locals")
80 variable(Cell, env_locals, "&locals")
81 variable(Cell, env_locals_ext, "&locals-ext")
82 variable(Cell, env_facility, "&facility")
83 variable(Cell, env_facility_ext, "&facility-ext")
84 variable(Cell, env_block, "&block")
85 variable(Cell, env_block_ext, "&block-ext")
86 variable(Cell, env_exception, "&exception")
87 variable(Cell, env_exception_ext, "&exception-ext")
88 variable(Cell, env_file, "&file")
89 variable(Cell, env_file_ext, "&file-ext")
90 variable(Cell, env_string, "&string")
91 variable(Cell, env_string_ext, "&string-ext")
92 variable(Cell, check_system, "(check-system)")
94 /**************************************************************************/
95 /* PROTOTYPES *************************************************************/
96 /**************************************************************************/
100 code(star_slash, "*/", 0)
101 code(star_slash_mod, "*/mod", 0)
103 code(plus_store, "+!", 0)
106 code(slash_mod, "/mod", 0)
107 code(zero_less, "0<", 0)
108 code(zero_equals, "0=", 0)
109 code(one_plus, "1+", 0)
110 code(one_minus, "1-", 0)
111 code(two_store, "2!", 0)
112 code(two_star, "2*", 0)
113 code(two_slash, "2/", 0)
114 code(two_fetch, "2@", 0)
115 code(two_drop, "2drop", 0)
116 code(two_dupe, "2dup", 0)
117 code(two_over, "2over", 0)
118 code(two_swap, "2swap", 0)
119 code(less_than, "<", 0)
121 code(greater_than, ">", 0)
122 code(to_r, ">r", COMP_ONLY)
123 code(question_dupe, "?dup", 0)
126 code(align, "align", 0)
127 code(aligned, "aligned", 0)
130 code(c_store, "c!", 0)
131 code(c_fetch, "c@", 0)
132 code(cell_plus, "cell+", 0)
133 code(cells, "cells", 0)
134 code(char_plus, "char+", 0)
135 code(chars, "chars", 0)
136 code(depth, "depth", 0)
137 code(drop, "drop", 0)
139 code(f_m_slash_mod, "fm/mod", 0)
140 code(invert, "invert", 0)
141 code(l_shift, "lshift", 0)
142 code(m_star, "m*", 0)
146 code(negate, "negate", 0)
148 code(over, "over", 0)
149 code(r_from, "r>", COMP_ONLY)
150 code(r_fetch, "r@", COMP_ONLY)
152 code(r_shift, "rshift", 0)
153 code(s_to_d, "s>d", 0)
154 code(s_m_slash_rem, "sm/rem", 0)
155 code(swap, "swap", 0)
156 code(u_less_than, "u<", 0)
157 code(u_m_star, "um*", 0)
158 code(u_m_slash_mod, "um/mod", 0)
160 code(word, "word", 0)
161 code(to_number, ">number", 0)
162 code(interpret, "interpret", 0)
163 code(accept, "accept", 0)
164 code(source, "source", 0)
166 code(evaluate, "evaluate", 0)
167 code(quit, "quit", 0)
169 code(allot, "allot", 0)
170 code(c_comma, "c,", 0)
171 code(here, "here", 0)
172 code(exit_imm, "exit", COMP_ONLY | IMMEDIATE)
174 code(variable, "variable", 0)
175 code(constant, "constant", 0)
176 code(create, "create", 0)
177 code(does, "does>", COMP_ONLY | IMMEDIATE)
178 code(semi_colon, ";", COMP_ONLY | IMMEDIATE)
179 code(if, "if", COMP_ONLY | IMMEDIATE)
180 code(then, "then", COMP_ONLY | IMMEDIATE)
181 code(else, "else", COMP_ONLY | IMMEDIATE)
182 code(begin, "begin", COMP_ONLY | IMMEDIATE)
183 code(do, "do", COMP_ONLY | IMMEDIATE)
184 code(loop, "loop", COMP_ONLY | IMMEDIATE)
185 code(i, "i", COMP_ONLY)
186 code(j, "j", COMP_ONLY)
187 code(plus_loop, "+loop", COMP_ONLY | IMMEDIATE)
188 code(recurse, "recurse", COMP_ONLY | IMMEDIATE)
189 code(find, "find", 0)
190 code(less_number_sign, "<#", 0)
191 code(number_sign, "#", 0)
192 code(hold, "hold", 0)
193 code(number_sign_s, "#s", 0)
194 code(number_sign_greater, "#>", 0)
197 code(emit, "emit", 0)
198 code(space, "space", 0)
199 code(spaces, "spaces", 0)
200 code(type, "type", 0)
202 code(dot_quote, ".\"", COMP_ONLY | IMMEDIATE)
204 code(to_body, ">body", 0)
205 code(abort, "abort", 0)
206 code(abort_quote, "abort\"", COMP_ONLY | IMMEDIATE)
207 code(count, "count", 0)
208 code(decimal, "decimal", 0)
209 code(environment_query, "environment?", 0)
210 code(execute, "execute", 0)
211 code(fill, "fill", 0)
212 code(immediate, "immediate", 0)
214 code(leave, "leave", COMP_ONLY)
215 code(literal, "literal", COMP_ONLY | IMMEDIATE)
216 code(move, "move", 0)
217 code(postpone, "postpone", COMP_ONLY | IMMEDIATE)
218 code(s_quote, "s\"", IMMEDIATE)
219 code(sign, "sign", 0)
220 code(unloop, "unloop", COMP_ONLY)
221 code(left_bracket, "[", COMP_ONLY | IMMEDIATE)
222 code(bracket_tick, "[']", COMP_ONLY | IMMEDIATE)
223 code(char, "char", 0)
224 code(bracket_char, "[char]", COMP_ONLY | IMMEDIATE)
225 code(right_bracket, "]", 0)
226 code(while, "while", COMP_ONLY | IMMEDIATE)
227 code(repeat, "repeat", COMP_ONLY | IMMEDIATE)
228 code(paren_does_paren, "(does)", 0)
229 code(paren_compile_paren, "(compile)", 0)
230 code(paren_do_paren, "(do)", 0)
231 code(paren_loop_paren, "(loop)", 0)
232 code(paren_plus_loop_paren, "(+loop)", 0)
233 code(paren_dot_quote_paren, "(.\")", 0)
234 code(paren_do_colon_paren, "(doCol)", 0)
235 code(zero_branch, "(0branch)", 0)
236 code(branch, "(branch)", 0)
237 code(do_literal, "(doLit)", 0)
238 code(do_fliteral, "(doFLit)", 0)
239 code(do_exit, "(doExit)", 0)
240 code(do_value, "(doValue)", 0)
241 code(view_error_msg, "view-error-message", 0)
242 code(read_const, "read-const", 0)
246 /**************************************************************************/
247 /* AUXILIARY FUNCTIONS PROTOTYPES *****************************************/
248 /**************************************************************************/
250 struct word_def *search_wordlist(Char *name, Cell len, struct vocabulary *wid);
251 struct word_def *search_word(Char *name, Cell len);
252 void ins_word(struct word_def *p);
253 void mark_word(struct word_def *p);
254 void set_find_stack(Char *addr, struct word_def *xt);
255 int strmatch(const Char *s1, const Char *s2, int len1);
256 int is_base_digit(Char ch);
257 int process_char(Char *addr, int max_len, int cur_pos, char ch);
258 void create_definition(Cell class);
259 void exec_colon(pfp *ip0);
260 void exec_word(struct word_def *xt);
261 void compile_word(struct word_def *xt);
262 void save_input_specification(void);
263 void restore_input_specification(void);
264 void check_system(void);