xref: /illumos-gate/usr/src/common/ficl/fileaccess.c (revision afc2ba1deb75b323afde536f2dd18bcafdaa308d)
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