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: File word set
30 /**************************************************************************/
31 /* VARIABLES **************************************************************/
32 /**************************************************************************/
34 static char *file_mode[] = {
36 "rb", /* FILE_R_O | FILE_BIN */
38 "wb", /* FILE_W_O | FILE_BIN */
40 "w+b", /* FILE_R_W | FILE_BIN */
43 Char file_name[FILE_NAME_SIZE];
45 /**************************************************************************/
46 /* WORDS ******************************************************************/
47 /**************************************************************************/
54 if (fclose((FILE *) sp[0])) sp[0] = (Cell) errno;
59 register Cell fam = *sp++;
62 if (fam & (~FILE_BIN) == FILE_R_O) fam = FILE_R_W | (fam & FILE_BIN);
63 f = fopen(file_name, file_mode[fam]);
65 *--sp = (Cell) f ? 0 : errno;
70 if (remove(file_name)) *--sp = (Cell) errno;
74 void _file_position() {
75 register FILE *f = (FILE *) sp[0];
76 register DCell ud = ftell(f);
78 if (ud == -1L) sp[0] = (Cell) errno;
80 PUT_DCELL(sp + 1, ud);
86 register FILE *f = (FILE *) sp[0];
87 register DCell o_pos = ftell(f);
89 fseek(f, 0, SEEK_END);
91 fseek(f, o_pos, SEEK_SET);
98 void _include_file() {
99 register FILE *f = (FILE *) *sp++;
100 save_input_specification();
101 _source_id = (Cell) f;
102 _input_buffer = malloc(FILE_BUFFER_SIZE);
103 _in_input_buffer = 0;
106 while (!feof(f) && !ferror(f) && !_error) {
107 if (fgets(_input_buffer, FILE_BUFFER_SIZE - 1, f)) {
109 _in_input_buffer = strlen(_input_buffer);
110 if (_in_input_buffer && _input_buffer[_in_input_buffer - 1] == '\n')
118 restore_input_specification();
124 if ((_error = *sp++) == 0) _include_file();
129 register Cell fam = *sp++;
132 f = fopen(file_name, file_mode[fam]);
134 *--sp = (Cell) (f ? 0 : E_FILENOTFOUND);
146 register FILE *f = (FILE *) *sp++;
147 register UCell u1 = (UCell) *sp++;
148 register Char *buffer = (Char *) *sp++;
149 size_t rd = fread(buffer, 1, (size_t) u1, f);
151 *--sp = (Cell) ferror(f) ? errno : 0;
155 register FILE *f = (FILE *) *sp++;
156 register UCell u1 = (UCell) *sp++;
157 register Char *buffer = (Char *) *sp++;
158 if (fgets(buffer, u1 + 1, f)) {
159 int len = strlen(buffer);
160 if (len && buffer[len - 1] == '\n') len--;
165 *--sp = (Cell) errno;
171 void _reposition_file() {
172 register FILE *f = (FILE *) *sp++;
173 register UDCell ud = GET_DCELL(sp);
175 if (fseek(f, ud, SEEK_SET)) sp[0] = errno;
179 void _resize_file() {
180 register FILE *f = (FILE *) sp[0];
181 register UDCell ud = GET_DCELL(sp + 1), ud1;
187 if (ud < ud1) ior = truncate_file(f, ud1, ud);
188 else if (ud > ud1) ior = expand_file(f, ud1, ud);
199 register FILE *f = (FILE *) *sp++;
200 register UCell u = (UCell) *sp++;
201 register Char *buffer = (Char *) *sp;
202 if (fwrite(buffer, 1, (size_t) u, f) < u) sp[0] = errno;
207 register FILE *f = (FILE *) *sp++;
208 register UCell u = (UCell) *sp++;
209 register Char *buffer = (Char *) *sp;
210 while (u--) if (fputc(*buffer++, f) == EOF) break;
211 if (!ferror(f)) fputc('\n', f);
212 if (ferror(f)) sp[0] = errno;
216 /**************************************************************************/
217 /* AUXILIARY FUNCTIONS ****************************************************/
218 /**************************************************************************/
220 Cell truncate_file(FILE *f, UDCell cur, UDCell ud) {
221 if (fseek(f, ud, SEEK_SET)) return (errno);
225 Cell expand_file(FILE *f, UDCell cur, UDCell ud) {
226 fseek(f, 0, SEEK_END);
227 while (cur < ud && !ferror(f)) {
231 if (ferror(f)) return (errno);
235 Char *get_file_name() {
236 register UCell u = (UCell) *sp++;
237 register Char *buffer = (Char *) *sp++;
238 memcpy(file_name, buffer, u);
243 void load_file(Char *name) {
245 *--sp = strlen(name);