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: File word set
20 /**************************************************************************/
21 /* VARIABLES **************************************************************/
22 /**************************************************************************/
24 static char *file_mode[] = {
26 "rb", /* FILE_R_O | FILE_BIN */
28 "wb", /* FILE_W_O | FILE_BIN */
30 "w+b", /* FILE_R_W | FILE_BIN */
33 Char file_name[FILE_NAME_SIZE];
35 /**************************************************************************/
36 /* WORDS ******************************************************************/
37 /**************************************************************************/
44 if (fclose((FILE *) sp[0])) sp[0] = (Cell) errno;
49 register Cell fam = *sp++;
52 if (fam & (~FILE_BIN) == FILE_R_O) fam = FILE_R_W | (fam & FILE_BIN);
53 f = fopen(file_name, file_mode[fam]);
55 *--sp = (Cell) f ? 0 : errno;
60 if (remove(file_name)) *--sp = (Cell) errno;
64 void _file_position() {
65 register FILE *f = (FILE *) sp[0];
66 register DCell ud = ftell(f);
68 if (ud == -1L) sp[0] = (Cell) errno;
70 PUT_DCELL(sp + 1, ud);
76 register FILE *f = (FILE *) sp[0];
77 register DCell o_pos = ftell(f);
79 fseek(f, 0, SEEK_END);
81 fseek(f, o_pos, SEEK_SET);
88 void _include_file() {
89 register FILE *f = (FILE *) *sp++;
90 save_input_specification();
91 _source_id = (Cell) f;
92 _input_buffer = malloc(FILE_BUFFER_SIZE);
96 while (!feof(f) && !ferror(f) && !_error) {
97 if (fgets(_input_buffer, FILE_BUFFER_SIZE - 1, f)) {
99 _in_input_buffer = strlen(_input_buffer);
100 if (_in_input_buffer && _input_buffer[_in_input_buffer - 1] == '\n')
108 restore_input_specification();
114 if ((_error = *sp++) == 0) _include_file();
119 register Cell fam = *sp++;
122 f = fopen(file_name, file_mode[fam]);
124 *--sp = (Cell) (f ? 0 : E_FILENOTFOUND);
136 register FILE *f = (FILE *) *sp++;
137 register UCell u1 = (UCell) *sp++;
138 register Char *buffer = (Char *) *sp++;
139 size_t rd = fread(buffer, 1, (size_t) u1, f);
141 *--sp = (Cell) ferror(f) ? errno : 0;
145 register FILE *f = (FILE *) *sp++;
146 register UCell u1 = (UCell) *sp++;
147 register Char *buffer = (Char *) *sp++;
148 if (fgets(buffer, u1 + 1, f)) {
149 int len = strlen(buffer);
150 if (len && buffer[len - 1] == '\n') len--;
155 *--sp = (Cell) errno;
161 void _reposition_file() {
162 register FILE *f = (FILE *) *sp++;
163 register UDCell ud = GET_DCELL(sp);
165 if (fseek(f, ud, SEEK_SET)) sp[0] = errno;
169 void _resize_file() {
170 register FILE *f = (FILE *) sp[0];
171 register UDCell ud = GET_DCELL(sp + 1), ud1;
177 if (ud < ud1) ior = truncate_file(f, ud1, ud);
178 else if (ud > ud1) ior = expand_file(f, ud1, ud);
189 register FILE *f = (FILE *) *sp++;
190 register UCell u = (UCell) *sp++;
191 register Char *buffer = (Char *) *sp;
192 if (fwrite(buffer, 1, (size_t) u, f) < u) sp[0] = errno;
197 register FILE *f = (FILE *) *sp++;
198 register UCell u = (UCell) *sp++;
199 register Char *buffer = (Char *) *sp;
200 while (u--) if (fputc(*buffer++, f) == EOF) break;
201 if (!ferror(f)) fputc('\n', f);
202 if (ferror(f)) sp[0] = errno;
206 /**************************************************************************/
207 /* AUXILIARY FUNCTIONS ****************************************************/
208 /**************************************************************************/
210 Cell truncate_file(FILE *f, UDCell cur, UDCell ud) {
211 if (fseek(f, ud, SEEK_SET)) return (errno);
215 Cell expand_file(FILE *f, UDCell cur, UDCell ud) {
216 fseek(f, 0, SEEK_END);
217 while (cur < ud && !ferror(f)) {
221 if (ferror(f)) return (errno);
225 Char *get_file_name() {
226 register UCell u = (UCell) *sp++;
227 register Char *buffer = (Char *) *sp++;
228 memcpy(file_name, buffer, u);
233 void load_file(Char *name) {
235 *--sp = strlen(name);