1*afc2ba1dSToomas Soome #include "ficl.h"
2*afc2ba1dSToomas Soome
3*afc2ba1dSToomas Soome #if FICL_WANT_FILE
4*afc2ba1dSToomas Soome /*
5*afc2ba1dSToomas Soome * fileaccess.c
6*afc2ba1dSToomas Soome *
7*afc2ba1dSToomas Soome * Implements all of the File Access word set that can be implemented in
8*afc2ba1dSToomas Soome * portable C.
9*afc2ba1dSToomas Soome */
10*afc2ba1dSToomas Soome
11*afc2ba1dSToomas Soome static void
pushIor(ficlVm * vm,int success)12*afc2ba1dSToomas Soome pushIor(ficlVm *vm, int success)
13*afc2ba1dSToomas Soome {
14*afc2ba1dSToomas Soome int ior;
15*afc2ba1dSToomas Soome if (success)
16*afc2ba1dSToomas Soome ior = 0;
17*afc2ba1dSToomas Soome else
18*afc2ba1dSToomas Soome ior = errno;
19*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, ior);
20*afc2ba1dSToomas Soome }
21*afc2ba1dSToomas Soome
22*afc2ba1dSToomas Soome /* ( c-addr u fam -- fileid ior ) */
23*afc2ba1dSToomas Soome static void
ficlFileOpen(ficlVm * vm,char * writeMode)24*afc2ba1dSToomas Soome ficlFileOpen(ficlVm *vm, char *writeMode)
25*afc2ba1dSToomas Soome {
26*afc2ba1dSToomas Soome int fam = ficlStackPopInteger(vm->dataStack);
27*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
28*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
29*afc2ba1dSToomas Soome char mode[4];
30*afc2ba1dSToomas Soome FILE *f;
31*afc2ba1dSToomas Soome char *filename = (char *)malloc(length + 1);
32*afc2ba1dSToomas Soome memcpy(filename, address, length);
33*afc2ba1dSToomas Soome filename[length] = 0;
34*afc2ba1dSToomas Soome
35*afc2ba1dSToomas Soome *mode = 0;
36*afc2ba1dSToomas Soome
37*afc2ba1dSToomas Soome switch (FICL_FAM_OPEN_MODE(fam)) {
38*afc2ba1dSToomas Soome case 0:
39*afc2ba1dSToomas Soome ficlStackPushPointer(vm->dataStack, NULL);
40*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, EINVAL);
41*afc2ba1dSToomas Soome goto EXIT;
42*afc2ba1dSToomas Soome case FICL_FAM_READ:
43*afc2ba1dSToomas Soome strcat(mode, "r");
44*afc2ba1dSToomas Soome break;
45*afc2ba1dSToomas Soome case FICL_FAM_WRITE:
46*afc2ba1dSToomas Soome strcat(mode, writeMode);
47*afc2ba1dSToomas Soome break;
48*afc2ba1dSToomas Soome case FICL_FAM_READ | FICL_FAM_WRITE:
49*afc2ba1dSToomas Soome strcat(mode, writeMode);
50*afc2ba1dSToomas Soome strcat(mode, "+");
51*afc2ba1dSToomas Soome break;
52*afc2ba1dSToomas Soome }
53*afc2ba1dSToomas Soome
54*afc2ba1dSToomas Soome strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");
55*afc2ba1dSToomas Soome
56*afc2ba1dSToomas Soome f = fopen(filename, mode);
57*afc2ba1dSToomas Soome if (f == NULL)
58*afc2ba1dSToomas Soome ficlStackPushPointer(vm->dataStack, NULL);
59*afc2ba1dSToomas Soome else {
60*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)malloc(sizeof (ficlFile));
61*afc2ba1dSToomas Soome strcpy(ff->filename, filename);
62*afc2ba1dSToomas Soome ff->f = f;
63*afc2ba1dSToomas Soome ficlStackPushPointer(vm->dataStack, ff);
64*afc2ba1dSToomas Soome
65*afc2ba1dSToomas Soome fseek(f, 0, SEEK_SET);
66*afc2ba1dSToomas Soome }
67*afc2ba1dSToomas Soome pushIor(vm, f != NULL);
68*afc2ba1dSToomas Soome
69*afc2ba1dSToomas Soome EXIT:
70*afc2ba1dSToomas Soome free(filename);
71*afc2ba1dSToomas Soome }
72*afc2ba1dSToomas Soome
73*afc2ba1dSToomas Soome /* ( c-addr u fam -- fileid ior ) */
74*afc2ba1dSToomas Soome static void
ficlPrimitiveOpenFile(ficlVm * vm)75*afc2ba1dSToomas Soome ficlPrimitiveOpenFile(ficlVm *vm)
76*afc2ba1dSToomas Soome {
77*afc2ba1dSToomas Soome ficlFileOpen(vm, "a");
78*afc2ba1dSToomas Soome }
79*afc2ba1dSToomas Soome
80*afc2ba1dSToomas Soome /* ( c-addr u fam -- fileid ior ) */
81*afc2ba1dSToomas Soome static void
ficlPrimitiveCreateFile(ficlVm * vm)82*afc2ba1dSToomas Soome ficlPrimitiveCreateFile(ficlVm *vm)
83*afc2ba1dSToomas Soome {
84*afc2ba1dSToomas Soome ficlFileOpen(vm, "w");
85*afc2ba1dSToomas Soome }
86*afc2ba1dSToomas Soome
87*afc2ba1dSToomas Soome /* ( fileid -- ior ) */
88*afc2ba1dSToomas Soome static int
ficlFileClose(ficlFile * ff)89*afc2ba1dSToomas Soome ficlFileClose(ficlFile *ff)
90*afc2ba1dSToomas Soome {
91*afc2ba1dSToomas Soome FILE *f = ff->f;
92*afc2ba1dSToomas Soome free(ff);
93*afc2ba1dSToomas Soome return (!fclose(f));
94*afc2ba1dSToomas Soome }
95*afc2ba1dSToomas Soome
96*afc2ba1dSToomas Soome /* ( fileid -- ior ) */
97*afc2ba1dSToomas Soome static void
ficlPrimitiveCloseFile(ficlVm * vm)98*afc2ba1dSToomas Soome ficlPrimitiveCloseFile(ficlVm *vm)
99*afc2ba1dSToomas Soome {
100*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
101*afc2ba1dSToomas Soome pushIor(vm, ficlFileClose(ff));
102*afc2ba1dSToomas Soome }
103*afc2ba1dSToomas Soome
104*afc2ba1dSToomas Soome /* ( c-addr u -- ior ) */
105*afc2ba1dSToomas Soome static void
ficlPrimitiveDeleteFile(ficlVm * vm)106*afc2ba1dSToomas Soome ficlPrimitiveDeleteFile(ficlVm *vm)
107*afc2ba1dSToomas Soome {
108*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
109*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
110*afc2ba1dSToomas Soome
111*afc2ba1dSToomas Soome char *filename = (char *)malloc(length + 1);
112*afc2ba1dSToomas Soome memcpy(filename, address, length);
113*afc2ba1dSToomas Soome filename[length] = 0;
114*afc2ba1dSToomas Soome
115*afc2ba1dSToomas Soome pushIor(vm, !unlink(filename));
116*afc2ba1dSToomas Soome free(filename);
117*afc2ba1dSToomas Soome }
118*afc2ba1dSToomas Soome
119*afc2ba1dSToomas Soome /* ( c-addr1 u1 c-addr2 u2 -- ior ) */
120*afc2ba1dSToomas Soome static void
ficlPrimitiveRenameFile(ficlVm * vm)121*afc2ba1dSToomas Soome ficlPrimitiveRenameFile(ficlVm *vm)
122*afc2ba1dSToomas Soome {
123*afc2ba1dSToomas Soome int length;
124*afc2ba1dSToomas Soome void *address;
125*afc2ba1dSToomas Soome char *from;
126*afc2ba1dSToomas Soome char *to;
127*afc2ba1dSToomas Soome
128*afc2ba1dSToomas Soome length = ficlStackPopInteger(vm->dataStack);
129*afc2ba1dSToomas Soome address = (void *)ficlStackPopPointer(vm->dataStack);
130*afc2ba1dSToomas Soome to = (char *)malloc(length + 1);
131*afc2ba1dSToomas Soome memcpy(to, address, length);
132*afc2ba1dSToomas Soome to[length] = 0;
133*afc2ba1dSToomas Soome
134*afc2ba1dSToomas Soome length = ficlStackPopInteger(vm->dataStack);
135*afc2ba1dSToomas Soome address = (void *)ficlStackPopPointer(vm->dataStack);
136*afc2ba1dSToomas Soome
137*afc2ba1dSToomas Soome from = (char *)malloc(length + 1);
138*afc2ba1dSToomas Soome memcpy(from, address, length);
139*afc2ba1dSToomas Soome from[length] = 0;
140*afc2ba1dSToomas Soome
141*afc2ba1dSToomas Soome pushIor(vm, !rename(from, to));
142*afc2ba1dSToomas Soome
143*afc2ba1dSToomas Soome free(from);
144*afc2ba1dSToomas Soome free(to);
145*afc2ba1dSToomas Soome }
146*afc2ba1dSToomas Soome
147*afc2ba1dSToomas Soome /* ( c-addr u -- x ior ) */
148*afc2ba1dSToomas Soome static void
ficlPrimitiveFileStatus(ficlVm * vm)149*afc2ba1dSToomas Soome ficlPrimitiveFileStatus(ficlVm *vm)
150*afc2ba1dSToomas Soome {
151*afc2ba1dSToomas Soome int status;
152*afc2ba1dSToomas Soome int ior;
153*afc2ba1dSToomas Soome
154*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
155*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
156*afc2ba1dSToomas Soome
157*afc2ba1dSToomas Soome char *filename = (char *)malloc(length + 1);
158*afc2ba1dSToomas Soome memcpy(filename, address, length);
159*afc2ba1dSToomas Soome filename[length] = 0;
160*afc2ba1dSToomas Soome
161*afc2ba1dSToomas Soome ior = ficlFileStatus(filename, &status);
162*afc2ba1dSToomas Soome free(filename);
163*afc2ba1dSToomas Soome
164*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, status);
165*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, ior);
166*afc2ba1dSToomas Soome }
167*afc2ba1dSToomas Soome
168*afc2ba1dSToomas Soome /* ( fileid -- ud ior ) */
169*afc2ba1dSToomas Soome static void
ficlPrimitiveFilePosition(ficlVm * vm)170*afc2ba1dSToomas Soome ficlPrimitiveFilePosition(ficlVm *vm)
171*afc2ba1dSToomas Soome {
172*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
173*afc2ba1dSToomas Soome long ud = ftell(ff->f);
174*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, ud);
175*afc2ba1dSToomas Soome pushIor(vm, ud != -1);
176*afc2ba1dSToomas Soome }
177*afc2ba1dSToomas Soome
178*afc2ba1dSToomas Soome /* ( fileid -- ud ior ) */
179*afc2ba1dSToomas Soome static void
ficlPrimitiveFileSize(ficlVm * vm)180*afc2ba1dSToomas Soome ficlPrimitiveFileSize(ficlVm *vm)
181*afc2ba1dSToomas Soome {
182*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
183*afc2ba1dSToomas Soome long ud = ficlFileSize(ff);
184*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, ud);
185*afc2ba1dSToomas Soome pushIor(vm, ud != -1);
186*afc2ba1dSToomas Soome }
187*afc2ba1dSToomas Soome
188*afc2ba1dSToomas Soome /* ( i*x fileid -- j*x ) */
189*afc2ba1dSToomas Soome #define nLINEBUF 256
190*afc2ba1dSToomas Soome static void
ficlPrimitiveIncludeFile(ficlVm * vm)191*afc2ba1dSToomas Soome ficlPrimitiveIncludeFile(ficlVm *vm)
192*afc2ba1dSToomas Soome {
193*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
194*afc2ba1dSToomas Soome ficlCell id = vm->sourceId;
195*afc2ba1dSToomas Soome int except = FICL_VM_STATUS_OUT_OF_TEXT;
196*afc2ba1dSToomas Soome long currentPosition, totalSize;
197*afc2ba1dSToomas Soome long size;
198*afc2ba1dSToomas Soome ficlString s;
199*afc2ba1dSToomas Soome vm->sourceId.p = (void *)ff;
200*afc2ba1dSToomas Soome
201*afc2ba1dSToomas Soome currentPosition = ftell(ff->f);
202*afc2ba1dSToomas Soome totalSize = ficlFileSize(ff);
203*afc2ba1dSToomas Soome size = totalSize - currentPosition;
204*afc2ba1dSToomas Soome
205*afc2ba1dSToomas Soome if ((totalSize != -1) && (currentPosition != -1) && (size > 0)) {
206*afc2ba1dSToomas Soome char *buffer = (char *)malloc(size);
207*afc2ba1dSToomas Soome long got = fread(buffer, 1, size, ff->f);
208*afc2ba1dSToomas Soome if (got == size) {
209*afc2ba1dSToomas Soome FICL_STRING_SET_POINTER(s, buffer);
210*afc2ba1dSToomas Soome FICL_STRING_SET_LENGTH(s, size);
211*afc2ba1dSToomas Soome except = ficlVmExecuteString(vm, s);
212*afc2ba1dSToomas Soome }
213*afc2ba1dSToomas Soome }
214*afc2ba1dSToomas Soome
215*afc2ba1dSToomas Soome if ((except < 0) && (except != FICL_VM_STATUS_OUT_OF_TEXT))
216*afc2ba1dSToomas Soome ficlVmThrow(vm, except);
217*afc2ba1dSToomas Soome
218*afc2ba1dSToomas Soome /*
219*afc2ba1dSToomas Soome * Pass an empty line with SOURCE-ID == -1 to flush
220*afc2ba1dSToomas Soome * any pending REFILLs (as required by FILE wordset)
221*afc2ba1dSToomas Soome */
222*afc2ba1dSToomas Soome vm->sourceId.i = -1;
223*afc2ba1dSToomas Soome FICL_STRING_SET_FROM_CSTRING(s, "");
224*afc2ba1dSToomas Soome ficlVmExecuteString(vm, s);
225*afc2ba1dSToomas Soome
226*afc2ba1dSToomas Soome vm->sourceId = id;
227*afc2ba1dSToomas Soome ficlFileClose(ff);
228*afc2ba1dSToomas Soome }
229*afc2ba1dSToomas Soome
230*afc2ba1dSToomas Soome /* ( c-addr u1 fileid -- u2 ior ) */
231*afc2ba1dSToomas Soome static void
ficlPrimitiveReadFile(ficlVm * vm)232*afc2ba1dSToomas Soome ficlPrimitiveReadFile(ficlVm *vm)
233*afc2ba1dSToomas Soome {
234*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
235*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
236*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
237*afc2ba1dSToomas Soome int result;
238*afc2ba1dSToomas Soome
239*afc2ba1dSToomas Soome clearerr(ff->f);
240*afc2ba1dSToomas Soome result = fread(address, 1, length, ff->f);
241*afc2ba1dSToomas Soome
242*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, result);
243*afc2ba1dSToomas Soome pushIor(vm, ferror(ff->f) == 0);
244*afc2ba1dSToomas Soome }
245*afc2ba1dSToomas Soome
246*afc2ba1dSToomas Soome /* ( c-addr u1 fileid -- u2 flag ior ) */
247*afc2ba1dSToomas Soome static void
ficlPrimitiveReadLine(ficlVm * vm)248*afc2ba1dSToomas Soome ficlPrimitiveReadLine(ficlVm *vm)
249*afc2ba1dSToomas Soome {
250*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
251*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
252*afc2ba1dSToomas Soome char *address = (char *)ficlStackPopPointer(vm->dataStack);
253*afc2ba1dSToomas Soome int error;
254*afc2ba1dSToomas Soome int flag;
255*afc2ba1dSToomas Soome
256*afc2ba1dSToomas Soome if (feof(ff->f)) {
257*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, -1);
258*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, 0);
259*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, 0);
260*afc2ba1dSToomas Soome return;
261*afc2ba1dSToomas Soome }
262*afc2ba1dSToomas Soome
263*afc2ba1dSToomas Soome clearerr(ff->f);
264*afc2ba1dSToomas Soome *address = 0;
265*afc2ba1dSToomas Soome fgets(address, length, ff->f);
266*afc2ba1dSToomas Soome
267*afc2ba1dSToomas Soome error = ferror(ff->f);
268*afc2ba1dSToomas Soome if (error != 0) {
269*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, -1);
270*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, 0);
271*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, error);
272*afc2ba1dSToomas Soome return;
273*afc2ba1dSToomas Soome }
274*afc2ba1dSToomas Soome
275*afc2ba1dSToomas Soome length = strlen(address);
276*afc2ba1dSToomas Soome flag = (length > 0);
277*afc2ba1dSToomas Soome if (length && ((address[length - 1] == '\r') ||
278*afc2ba1dSToomas Soome (address[length - 1] == '\n')))
279*afc2ba1dSToomas Soome length--;
280*afc2ba1dSToomas Soome
281*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, length);
282*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, flag);
283*afc2ba1dSToomas Soome ficlStackPushInteger(vm->dataStack, 0); /* ior */
284*afc2ba1dSToomas Soome }
285*afc2ba1dSToomas Soome
286*afc2ba1dSToomas Soome /* ( c-addr u1 fileid -- ior ) */
287*afc2ba1dSToomas Soome static void
ficlPrimitiveWriteFile(ficlVm * vm)288*afc2ba1dSToomas Soome ficlPrimitiveWriteFile(ficlVm *vm)
289*afc2ba1dSToomas Soome {
290*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
291*afc2ba1dSToomas Soome int length = ficlStackPopInteger(vm->dataStack);
292*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
293*afc2ba1dSToomas Soome
294*afc2ba1dSToomas Soome clearerr(ff->f);
295*afc2ba1dSToomas Soome fwrite(address, 1, length, ff->f);
296*afc2ba1dSToomas Soome pushIor(vm, ferror(ff->f) == 0);
297*afc2ba1dSToomas Soome }
298*afc2ba1dSToomas Soome
299*afc2ba1dSToomas Soome /* ( c-addr u1 fileid -- ior ) */
300*afc2ba1dSToomas Soome static void
ficlPrimitiveWriteLine(ficlVm * vm)301*afc2ba1dSToomas Soome ficlPrimitiveWriteLine(ficlVm *vm)
302*afc2ba1dSToomas Soome {
303*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
304*afc2ba1dSToomas Soome size_t length = (size_t)ficlStackPopInteger(vm->dataStack);
305*afc2ba1dSToomas Soome void *address = (void *)ficlStackPopPointer(vm->dataStack);
306*afc2ba1dSToomas Soome
307*afc2ba1dSToomas Soome clearerr(ff->f);
308*afc2ba1dSToomas Soome if (fwrite(address, 1, length, ff->f) == length)
309*afc2ba1dSToomas Soome fwrite("\n", 1, 1, ff->f);
310*afc2ba1dSToomas Soome pushIor(vm, ferror(ff->f) == 0);
311*afc2ba1dSToomas Soome }
312*afc2ba1dSToomas Soome
313*afc2ba1dSToomas Soome /* ( ud fileid -- ior ) */
314*afc2ba1dSToomas Soome static void
ficlPrimitiveRepositionFile(ficlVm * vm)315*afc2ba1dSToomas Soome ficlPrimitiveRepositionFile(ficlVm *vm)
316*afc2ba1dSToomas Soome {
317*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
318*afc2ba1dSToomas Soome size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);
319*afc2ba1dSToomas Soome
320*afc2ba1dSToomas Soome pushIor(vm, fseek(ff->f, ud, SEEK_SET) == 0);
321*afc2ba1dSToomas Soome }
322*afc2ba1dSToomas Soome
323*afc2ba1dSToomas Soome /* ( fileid -- ior ) */
324*afc2ba1dSToomas Soome static void
ficlPrimitiveFlushFile(ficlVm * vm)325*afc2ba1dSToomas Soome ficlPrimitiveFlushFile(ficlVm *vm)
326*afc2ba1dSToomas Soome {
327*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
328*afc2ba1dSToomas Soome pushIor(vm, fflush(ff->f) == 0);
329*afc2ba1dSToomas Soome }
330*afc2ba1dSToomas Soome
331*afc2ba1dSToomas Soome #if FICL_PLATFORM_HAS_FTRUNCATE
332*afc2ba1dSToomas Soome /* ( ud fileid -- ior ) */
333*afc2ba1dSToomas Soome static void
ficlPrimitiveResizeFile(ficlVm * vm)334*afc2ba1dSToomas Soome ficlPrimitiveResizeFile(ficlVm *vm)
335*afc2ba1dSToomas Soome {
336*afc2ba1dSToomas Soome ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
337*afc2ba1dSToomas Soome size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);
338*afc2ba1dSToomas Soome
339*afc2ba1dSToomas Soome pushIor(vm, ficlFileTruncate(ff, ud) == 0);
340*afc2ba1dSToomas Soome }
341*afc2ba1dSToomas Soome #endif /* FICL_PLATFORM_HAS_FTRUNCATE */
342*afc2ba1dSToomas Soome #endif /* FICL_WANT_FILE */
343*afc2ba1dSToomas Soome
344*afc2ba1dSToomas Soome void
ficlSystemCompileFile(ficlSystem * system)345*afc2ba1dSToomas Soome ficlSystemCompileFile(ficlSystem *system)
346*afc2ba1dSToomas Soome {
347*afc2ba1dSToomas Soome #if !FICL_WANT_FILE
348*afc2ba1dSToomas Soome FICL_IGNORE(system);
349*afc2ba1dSToomas Soome #else
350*afc2ba1dSToomas Soome ficlDictionary *dictionary = ficlSystemGetDictionary(system);
351*afc2ba1dSToomas Soome ficlDictionary *environment = ficlSystemGetEnvironment(system);
352*afc2ba1dSToomas Soome
353*afc2ba1dSToomas Soome FICL_SYSTEM_ASSERT(system, dictionary);
354*afc2ba1dSToomas Soome FICL_SYSTEM_ASSERT(system, environment);
355*afc2ba1dSToomas Soome
356*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "create-file",
357*afc2ba1dSToomas Soome ficlPrimitiveCreateFile, FICL_WORD_DEFAULT);
358*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "open-file",
359*afc2ba1dSToomas Soome ficlPrimitiveOpenFile, FICL_WORD_DEFAULT);
360*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "close-file",
361*afc2ba1dSToomas Soome ficlPrimitiveCloseFile, FICL_WORD_DEFAULT);
362*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "include-file",
363*afc2ba1dSToomas Soome ficlPrimitiveIncludeFile, FICL_WORD_DEFAULT);
364*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "read-file",
365*afc2ba1dSToomas Soome ficlPrimitiveReadFile, FICL_WORD_DEFAULT);
366*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "read-line",
367*afc2ba1dSToomas Soome ficlPrimitiveReadLine, FICL_WORD_DEFAULT);
368*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "write-file",
369*afc2ba1dSToomas Soome ficlPrimitiveWriteFile, FICL_WORD_DEFAULT);
370*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "write-line",
371*afc2ba1dSToomas Soome ficlPrimitiveWriteLine, FICL_WORD_DEFAULT);
372*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "file-position",
373*afc2ba1dSToomas Soome ficlPrimitiveFilePosition, FICL_WORD_DEFAULT);
374*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "file-size",
375*afc2ba1dSToomas Soome ficlPrimitiveFileSize, FICL_WORD_DEFAULT);
376*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "reposition-file",
377*afc2ba1dSToomas Soome ficlPrimitiveRepositionFile, FICL_WORD_DEFAULT);
378*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "file-status",
379*afc2ba1dSToomas Soome ficlPrimitiveFileStatus, FICL_WORD_DEFAULT);
380*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "flush-file",
381*afc2ba1dSToomas Soome ficlPrimitiveFlushFile, FICL_WORD_DEFAULT);
382*afc2ba1dSToomas Soome
383*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "delete-file",
384*afc2ba1dSToomas Soome ficlPrimitiveDeleteFile, FICL_WORD_DEFAULT);
385*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "rename-file",
386*afc2ba1dSToomas Soome ficlPrimitiveRenameFile, FICL_WORD_DEFAULT);
387*afc2ba1dSToomas Soome
388*afc2ba1dSToomas Soome #if FICL_PLATFORM_HAS_FTRUNCATE
389*afc2ba1dSToomas Soome ficlDictionarySetPrimitive(dictionary, "resize-file",
390*afc2ba1dSToomas Soome ficlPrimitiveResizeFile, FICL_WORD_DEFAULT);
391*afc2ba1dSToomas Soome
392*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, "file", FICL_TRUE);
393*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, "file-ext", FICL_TRUE);
394*afc2ba1dSToomas Soome #else /* FICL_PLATFORM_HAS_FTRUNCATE */
395*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, "file", FICL_FALSE);
396*afc2ba1dSToomas Soome ficlDictionarySetConstant(environment, "file-ext", FICL_FALSE);
397*afc2ba1dSToomas Soome #endif /* FICL_PLATFORM_HAS_FTRUNCATE */
398*afc2ba1dSToomas Soome
399*afc2ba1dSToomas Soome #endif /* !FICL_WANT_FILE */
400*afc2ba1dSToomas Soome }
401