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 * ------------------------------------------------------------------------
17 * Module name: ycore.c
18 * Abstract: Words defined for this particular implementation of
19 forth. Do not expect to find these words in other
32 /**************************************************************************/
33 /* WORDS DEFINITION *******************************************************/
34 /**************************************************************************/
36 /* ( --- ) print current version of yForth? */
37 void _yforth_version() {
41 /* ( c-addr u --- ) save a snapshot of the current dictionary and vocabulary
45 FILE *f = fopen(get_file_name(), "wb");
46 struct image_header hd;
49 memset(&hd, 0, sizeof(struct image_header));
50 strcpy(hd.header, "yForth? Image File\n");
54 hd.dspace_size = dspace_size;
55 hd.pattern = VERSION_PATTERN;
56 if (fwrite(&hd, sizeof(struct image_header), 1, f) < 1) _error = E_NOFILE;
59 if (fwrite(&vm, sizeof(struct voc_marker), 1, f) < 1) _error = E_NOFILE;
61 if (fwrite(dp0, sizeof(Cell), dspace_size, f) < dspace_size)
66 } else _error = E_NOFILE;
69 /* ( c-addr u --- n ) execute command pointeb by c-addr via "system", n is
70 * the result of operation as described in the C library manual
73 register UCell len = *sp++;
74 register Char *name = (Char *) *sp;
75 extern Char s_tmp_buffer[];
76 memcpy(s_tmp_buffer, name, len);
77 s_tmp_buffer[len] = '\0';
78 *sp = system(s_tmp_buffer);