git.gag.com Git - debian/yforth/blob - file.c

   1 /* yForth? - A Forth interpreter written in ANSI C
   2  * Copyright (C) 2012 Luca Padovani
   3  *
   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.
   8  *
   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.
  13  *
  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: file.c
  18  * Abstract:    File word set
  19  */
  20
  21 #include <stdio.h>
  22 #include <errno.h>
  23 #include <malloc.h>
  24 #include <string.h>
  25 #include "yforth.h"
  26 #include "core.h"
  27 #include "block.h"
  28 #include "file.h"
  29
  30 /**************************************************************************/
  31 /* VARIABLES **************************************************************/
  32 /**************************************************************************/
  33
  34 static char *file_mode[] = {
  35         "r",                            /* FILE_R_O                     */
  36         "rb",                           /* FILE_R_O | FILE_BIN  */
  37         "w",                            /* FILE_W_O                     */
  38         "wb",                           /* FILE_W_O | FILE_BIN  */
  39         "w+",                           /* FILE_R_W                             */
  40         "w+b",                          /* FILE_R_W | FILE_BIN  */
  41         };
  42
  43 Char file_name[FILE_NAME_SIZE];
  44
  45 /**************************************************************************/
  46 /* WORDS ******************************************************************/
  47 /**************************************************************************/
  48
  49 void _bin() {
  50         sp[0] |= FILE_BIN;
  51 }
  52
  53 void _close_file() {
  54         if (fclose((FILE *) sp[0])) sp[0] = (Cell) errno;
  55         else sp[0] = 0;
  56 }
  57
  58 void _create_file() {
  59         register Cell fam = *sp++;
  60         register FILE *f;
  61         get_file_name();
  62         if (fam & (~FILE_BIN) == FILE_R_O) fam = FILE_R_W | (fam & FILE_BIN);
  63         f = fopen(file_name, file_mode[fam]);
  64         *--sp = (Cell) f;
  65         *--sp = (Cell) f ? 0 : errno;
  66 }
  67
  68 void _delete_file() {
  69         get_file_name();
  70         if (remove(file_name)) *--sp = (Cell) errno;
  71         else *--sp = 0;
  72 }
  73
  74 void _file_position() {
  75         register FILE *f = (FILE *) sp[0];
  76         register DCell ud = ftell(f);
  77         sp -= 2;
  78         if (ud == -1L) sp[0] = (Cell) errno;
  79         else {
  80                 PUT_DCELL(sp + 1, ud);
  81                 sp[0] = 0;
  82         }
  83 }
  84
  85 void _file_size() {
  86         register FILE *f = (FILE *) sp[0];
  87         register DCell o_pos = ftell(f);
  88         if (o_pos != -1L) {
  89                 fseek(f, 0, SEEK_END);
  90                 _file_position();
  91                 fseek(f, o_pos, SEEK_SET);
  92         } else {
  93                 sp -= 2;
  94                 sp[0] = (Cell) errno;
  95         }
  96 }
  97
  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;
 104         _b_l_k = 0;
 105         if (_input_buffer) {
 106                 while (!feof(f) && !ferror(f) && !_error) {
 107                         if (fgets(_input_buffer, FILE_BUFFER_SIZE - 1, f)) {
 108                                 _to_in = 0;
 109                                 _in_input_buffer = strlen(_input_buffer);
 110                                 if (_in_input_buffer && _input_buffer[_in_input_buffer - 1] == '\n')
 111                                         _in_input_buffer--;
 112                                 _interpret();
 113                         }
 114                 }
 115                 fclose(f);
 116                 free(_input_buffer);
 117         }
 118         restore_input_specification();
 119 }
 120
 121 void _included() {
 122         _r_o();
 123         _open_file();
 124         if ((_error = *sp++) == 0) _include_file();
 125         else sp++;
 126 }
 127
 128 void _open_file() {
 129         register Cell fam = *sp++;
 130         register FILE *f;
 131         get_file_name();
 132         f = fopen(file_name, file_mode[fam]);
 133         *--sp = (Cell) f;
 134         *--sp = (Cell) (f ? 0 : E_FILENOTFOUND);
 135 }
 136
 137 void _r_o() {
 138         *--sp = FILE_R_O;
 139 }
 140
 141 void _r_w() {
 142         *--sp = FILE_R_W;
 143 }
 144
 145 void _read_file() {
 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);
 150         *--sp = (Cell) rd;
 151         *--sp = (Cell) ferror(f) ? errno : 0;
 152 }
 153
 154 void _read_line() {
 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--;
 161                 *--sp = 0;
 162                 *--sp = FFLAG(1);
 163                 *--sp = len;
 164         } else {
 165                 *--sp = (Cell) errno;
 166                 *--sp = FFLAG(0);
 167                 *--sp = 0;
 168         }
 169 }
 170
 171 void _reposition_file() {
 172         register FILE *f = (FILE *) *sp++;
 173         register UDCell ud = GET_DCELL(sp);
 174         sp++;
 175         if (fseek(f, ud, SEEK_SET)) sp[0] = errno;
 176         else sp[0] = 0;
 177 }
 178
 179 void _resize_file() {
 180         register FILE *f = (FILE *) sp[0];
 181         register UDCell ud = GET_DCELL(sp + 1), ud1;
 182         register Cell ior;
 183         _file_size();
 184         ior = *sp++;
 185         if (!ior) {
 186                 ud1 = GET_DCELL(sp);
 187                 if (ud < ud1) ior = truncate_file(f, ud1, ud);
 188                 else if (ud > ud1) ior = expand_file(f, ud1, ud);
 189         }
 190         sp += 3;
 191         sp[0] = ior;
 192 }
 193
 194 void _w_o() {
 195         *--sp = FILE_W_O;
 196 }
 197
 198 void _write_file() {
 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;
 203         else sp[0] = 0;
 204 }
 205
 206 void _write_line() {
 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;
 213         else sp[0] = 0;
 214 }
 215
 216 /**************************************************************************/
 217 /* AUXILIARY FUNCTIONS ****************************************************/
 218 /**************************************************************************/
 219
 220 Cell truncate_file(FILE *f, UDCell cur, UDCell ud) {
 221         if (fseek(f, ud, SEEK_SET)) return (errno);
 222         else return (0);
 223 }
 224
 225 Cell expand_file(FILE *f, UDCell cur, UDCell ud) {
 226         fseek(f, 0, SEEK_END);
 227         while (cur < ud && !ferror(f)) {
 228                 fputc(' ', f);
 229                 cur++;
 230         }
 231         if (ferror(f)) return (errno);
 232         else return (0);
 233 }
 234
 235 Char *get_file_name() {
 236         register UCell u = (UCell) *sp++;
 237         register Char *buffer = (Char *) *sp++;
 238         memcpy(file_name, buffer, u);
 239         file_name[u] = '\0';
 240         return (file_name);
 241 }
 242
 243 void load_file(Char *name) {
 244         *--sp = (Cell) name;
 245         *--sp = strlen(name);
 246         _included();
 247 }