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

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