194290Sdcs/* $FreeBSD$ */ 294290Sdcs 394290Sdcs#include <errno.h> 494290Sdcs#include <stdlib.h> 594290Sdcs#include <stdio.h> 694290Sdcs#include <string.h> 794290Sdcs#include <ctype.h> 894290Sdcs#include <sys/stat.h> 994290Sdcs#include "ficl.h" 1094290Sdcs 1194290Sdcs#if FICL_WANT_FILE 1294290Sdcs/* 1394290Sdcs** 1494290Sdcs** fileaccess.c 1594290Sdcs** 1694290Sdcs** Implements all of the File Access word set that can be implemented in portable C. 1794290Sdcs** 1894290Sdcs*/ 1994290Sdcs 2094290Sdcsstatic void pushIor(FICL_VM *pVM, int success) 2194290Sdcs{ 2294290Sdcs int ior; 2394290Sdcs if (success) 2494290Sdcs ior = 0; 2594290Sdcs else 2694290Sdcs ior = errno; 2794290Sdcs stackPushINT(pVM->pStack, ior); 2894290Sdcs} 2994290Sdcs 3094290Sdcs 3194290Sdcs 3294290Sdcsstatic void ficlFopen(FICL_VM *pVM, char *writeMode) /* ( c-addr u fam -- fileid ior ) */ 3394290Sdcs{ 3494290Sdcs int fam = stackPopINT(pVM->pStack); 3594290Sdcs int length = stackPopINT(pVM->pStack); 3694290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 3794290Sdcs char mode[4]; 3894290Sdcs FILE *f; 3994290Sdcs 4094290Sdcs char *filename = (char *)alloca(length + 1); 4194290Sdcs memcpy(filename, address, length); 4294290Sdcs filename[length] = 0; 4394290Sdcs 4494290Sdcs *mode = 0; 4594290Sdcs 4694290Sdcs switch (FICL_FAM_OPEN_MODE(fam)) 4794290Sdcs { 4894290Sdcs case 0: 4994290Sdcs stackPushPtr(pVM->pStack, NULL); 5094290Sdcs stackPushINT(pVM->pStack, EINVAL); 5194290Sdcs return; 5294290Sdcs case FICL_FAM_READ: 5394290Sdcs strcat(mode, "r"); 5494290Sdcs break; 5594290Sdcs case FICL_FAM_WRITE: 5694290Sdcs strcat(mode, writeMode); 5794290Sdcs break; 5894290Sdcs case FICL_FAM_READ | FICL_FAM_WRITE: 5994290Sdcs strcat(mode, writeMode); 6094290Sdcs strcat(mode, "+"); 6194290Sdcs break; 6294290Sdcs } 6394290Sdcs 6494290Sdcs strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t"); 6594290Sdcs 6694290Sdcs f = fopen(filename, mode); 6794290Sdcs if (f == NULL) 6894290Sdcs stackPushPtr(pVM->pStack, NULL); 6994290Sdcs else 7094290Sdcs { 7194290Sdcs ficlFILE *ff = (ficlFILE *)malloc(sizeof(ficlFILE)); 7294290Sdcs strcpy(ff->filename, filename); 7394290Sdcs ff->f = f; 7494290Sdcs stackPushPtr(pVM->pStack, ff); 7594290Sdcs 7694290Sdcs fseek(f, 0, SEEK_SET); 7794290Sdcs } 7894290Sdcs pushIor(pVM, f != NULL); 7994290Sdcs} 8094290Sdcs 8194290Sdcs 8294290Sdcs 8394290Sdcsstatic void ficlOpenFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */ 8494290Sdcs{ 8594290Sdcs ficlFopen(pVM, "a"); 8694290Sdcs} 8794290Sdcs 8894290Sdcs 8994290Sdcsstatic void ficlCreateFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */ 9094290Sdcs{ 9194290Sdcs ficlFopen(pVM, "w"); 9294290Sdcs} 9394290Sdcs 9494290Sdcs 9594290Sdcsstatic int closeFiclFILE(ficlFILE *ff) /* ( fileid -- ior ) */ 9694290Sdcs{ 9794290Sdcs FILE *f = ff->f; 9894290Sdcs free(ff); 9994290Sdcs return !fclose(f); 10094290Sdcs} 10194290Sdcs 10294290Sdcsstatic void ficlCloseFile(FICL_VM *pVM) /* ( fileid -- ior ) */ 10394290Sdcs{ 10494290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 10594290Sdcs pushIor(pVM, closeFiclFILE(ff)); 10694290Sdcs} 10794290Sdcs 10894290Sdcsstatic void ficlDeleteFile(FICL_VM *pVM) /* ( c-addr u -- ior ) */ 10994290Sdcs{ 11094290Sdcs int length = stackPopINT(pVM->pStack); 11194290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 11294290Sdcs 11394290Sdcs char *filename = (char *)alloca(length + 1); 11494290Sdcs memcpy(filename, address, length); 11594290Sdcs filename[length] = 0; 11694290Sdcs 11794290Sdcs pushIor(pVM, !unlink(filename)); 11894290Sdcs} 11994290Sdcs 12094290Sdcsstatic void ficlRenameFile(FICL_VM *pVM) /* ( c-addr1 u1 c-addr2 u2 -- ior ) */ 12194290Sdcs{ 12294290Sdcs int length; 12394290Sdcs void *address; 12494290Sdcs char *from; 12594290Sdcs char *to; 12694290Sdcs 12794290Sdcs length = stackPopINT(pVM->pStack); 12894290Sdcs address = (void *)stackPopPtr(pVM->pStack); 12994290Sdcs to = (char *)alloca(length + 1); 13094290Sdcs memcpy(to, address, length); 13194290Sdcs to[length] = 0; 13294290Sdcs 13394290Sdcs length = stackPopINT(pVM->pStack); 13494290Sdcs address = (void *)stackPopPtr(pVM->pStack); 13594290Sdcs 13694290Sdcs from = (char *)alloca(length + 1); 13794290Sdcs memcpy(from, address, length); 13894290Sdcs from[length] = 0; 13994290Sdcs 14094290Sdcs pushIor(pVM, !rename(from, to)); 14194290Sdcs} 14294290Sdcs 14394290Sdcsstatic void ficlFileStatus(FICL_VM *pVM) /* ( c-addr u -- x ior ) */ 14494290Sdcs{ 14594290Sdcs struct stat statbuf; 14694290Sdcs 14794290Sdcs int length = stackPopINT(pVM->pStack); 14894290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 14994290Sdcs 15094290Sdcs char *filename = (char *)alloca(length + 1); 15194290Sdcs memcpy(filename, address, length); 15294290Sdcs filename[length] = 0; 15394290Sdcs 15494290Sdcs if (stat(filename, &statbuf) == 0) 15594290Sdcs { 15694290Sdcs /* 15794290Sdcs ** the "x" left on the stack is implementation-defined. 15894290Sdcs ** I push the file's access mode (readable, writeable, is directory, etc) 15994290Sdcs ** as defined by ANSI C. 16094290Sdcs */ 16194290Sdcs stackPushINT(pVM->pStack, statbuf.st_mode); 16294290Sdcs stackPushINT(pVM->pStack, 0); 16394290Sdcs } 16494290Sdcs else 16594290Sdcs { 16694290Sdcs stackPushINT(pVM->pStack, -1); 16794290Sdcs stackPushINT(pVM->pStack, ENOENT); 16894290Sdcs } 16994290Sdcs} 17094290Sdcs 17194290Sdcs 17294290Sdcsstatic void ficlFilePosition(FICL_VM *pVM) /* ( fileid -- ud ior ) */ 17394290Sdcs{ 17494290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 17594290Sdcs long ud = ftell(ff->f); 17694290Sdcs stackPushINT(pVM->pStack, ud); 17794290Sdcs pushIor(pVM, ud != -1); 17894290Sdcs} 17994290Sdcs 18094290Sdcs 18194290Sdcs 18294290Sdcsstatic long fileSize(FILE *f) 18394290Sdcs{ 18494290Sdcs struct stat statbuf; 18594290Sdcs statbuf.st_size = -1; 18694290Sdcs if (fstat(fileno(f), &statbuf) != 0) 18794290Sdcs return -1; 18894290Sdcs return statbuf.st_size; 18994290Sdcs} 19094290Sdcs 19194290Sdcs 19294290Sdcs 19394290Sdcsstatic void ficlFileSize(FICL_VM *pVM) /* ( fileid -- ud ior ) */ 19494290Sdcs{ 19594290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 19694290Sdcs long ud = fileSize(ff->f); 19794290Sdcs stackPushINT(pVM->pStack, ud); 19894290Sdcs pushIor(pVM, ud != -1); 19994290Sdcs} 20094290Sdcs 20194290Sdcs 20294290Sdcs 20394290Sdcs#define nLINEBUF 256 20494290Sdcsstatic void ficlIncludeFile(FICL_VM *pVM) /* ( i*x fileid -- j*x ) */ 20594290Sdcs{ 20694290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 20794290Sdcs CELL id = pVM->sourceID; 20894290Sdcs int result = VM_OUTOFTEXT; 20994290Sdcs long currentPosition, totalSize; 21094290Sdcs long size; 21194290Sdcs pVM->sourceID.p = (void *)ff; 21294290Sdcs 21394290Sdcs currentPosition = ftell(ff->f); 21494290Sdcs totalSize = fileSize(ff->f); 21594290Sdcs size = totalSize - currentPosition; 21694290Sdcs 21794290Sdcs if ((totalSize != -1) && (currentPosition != -1) && (size > 0)) 21894290Sdcs { 21994290Sdcs char *buffer = (char *)malloc(size); 22094290Sdcs long got = fread(buffer, 1, size, ff->f); 22194290Sdcs if (got == size) 22294290Sdcs result = ficlExecC(pVM, buffer, size); 22394290Sdcs } 22494290Sdcs 22594290Sdcs#if 0 22694290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 22794290Sdcs CELL id = pVM->sourceID; 22894290Sdcs char cp[nLINEBUF]; 22994290Sdcs int nLine = 0; 23094290Sdcs int keepGoing; 23194290Sdcs int result; 23294290Sdcs pVM->sourceID.p = (void *)ff; 23394290Sdcs 23494290Sdcs /* feed each line to ficlExec */ 23594290Sdcs keepGoing = TRUE; 23694290Sdcs while (keepGoing && fgets(cp, nLINEBUF, ff->f)) 23794290Sdcs { 23894290Sdcs int len = strlen(cp) - 1; 23994290Sdcs 24094290Sdcs nLine++; 24194290Sdcs if (len <= 0) 24294290Sdcs continue; 24394290Sdcs 24494290Sdcs if (cp[len] == '\n') 24594290Sdcs cp[len] = '\0'; 24694290Sdcs 24794290Sdcs result = ficlExec(pVM, cp); 24894290Sdcs 24994290Sdcs switch (result) 25094290Sdcs { 25194290Sdcs case VM_OUTOFTEXT: 25294290Sdcs case VM_USEREXIT: 25394290Sdcs break; 25494290Sdcs 25594290Sdcs default: 25694290Sdcs pVM->sourceID = id; 25794290Sdcs keepGoing = FALSE; 25894290Sdcs break; 25994290Sdcs } 26094290Sdcs } 26194290Sdcs#endif /* 0 */ 26294290Sdcs /* 26394290Sdcs ** Pass an empty line with SOURCE-ID == -1 to flush 26494290Sdcs ** any pending REFILLs (as required by FILE wordset) 26594290Sdcs */ 26694290Sdcs pVM->sourceID.i = -1; 26794290Sdcs ficlExec(pVM, ""); 26894290Sdcs 26994290Sdcs pVM->sourceID = id; 27094290Sdcs closeFiclFILE(ff); 27194290Sdcs} 27294290Sdcs 27394290Sdcs 27494290Sdcs 27594290Sdcsstatic void ficlReadFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 ior ) */ 27694290Sdcs{ 27794290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 27894290Sdcs int length = stackPopINT(pVM->pStack); 27994290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 28094290Sdcs int result; 28194290Sdcs 28294290Sdcs clearerr(ff->f); 28394290Sdcs result = fread(address, 1, length, ff->f); 28494290Sdcs 28594290Sdcs stackPushINT(pVM->pStack, result); 28694290Sdcs pushIor(pVM, ferror(ff->f) == 0); 28794290Sdcs} 28894290Sdcs 28994290Sdcs 29094290Sdcs 29194290Sdcsstatic void ficlReadLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 flag ior ) */ 29294290Sdcs{ 29394290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 29494290Sdcs int length = stackPopINT(pVM->pStack); 29594290Sdcs char *address = (char *)stackPopPtr(pVM->pStack); 29694290Sdcs int error; 29794290Sdcs int flag; 29894290Sdcs 29994290Sdcs if (feof(ff->f)) 30094290Sdcs { 30194290Sdcs stackPushINT(pVM->pStack, -1); 30294290Sdcs stackPushINT(pVM->pStack, 0); 30394290Sdcs stackPushINT(pVM->pStack, 0); 30494290Sdcs return; 30594290Sdcs } 30694290Sdcs 30794290Sdcs clearerr(ff->f); 30894290Sdcs *address = 0; 30994290Sdcs fgets(address, length, ff->f); 31094290Sdcs 31194290Sdcs error = ferror(ff->f); 31294290Sdcs if (error != 0) 31394290Sdcs { 31494290Sdcs stackPushINT(pVM->pStack, -1); 31594290Sdcs stackPushINT(pVM->pStack, 0); 31694290Sdcs stackPushINT(pVM->pStack, error); 31794290Sdcs return; 31894290Sdcs } 31994290Sdcs 32094290Sdcs length = strlen(address); 32194290Sdcs flag = (length > 0); 32294290Sdcs if (length && ((address[length - 1] == '\r') || (address[length - 1] == '\n'))) 32394290Sdcs length--; 32494290Sdcs 32594290Sdcs stackPushINT(pVM->pStack, length); 32694290Sdcs stackPushINT(pVM->pStack, flag); 32794290Sdcs stackPushINT(pVM->pStack, 0); /* ior */ 32894290Sdcs} 32994290Sdcs 33094290Sdcs 33194290Sdcs 33294290Sdcsstatic void ficlWriteFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */ 33394290Sdcs{ 33494290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 33594290Sdcs int length = stackPopINT(pVM->pStack); 33694290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 33794290Sdcs 33894290Sdcs clearerr(ff->f); 33994290Sdcs fwrite(address, 1, length, ff->f); 34094290Sdcs pushIor(pVM, ferror(ff->f) == 0); 34194290Sdcs} 34294290Sdcs 34394290Sdcs 34494290Sdcs 34594290Sdcsstatic void ficlWriteLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */ 34694290Sdcs{ 34794290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 34894290Sdcs size_t length = (size_t)stackPopINT(pVM->pStack); 34994290Sdcs void *address = (void *)stackPopPtr(pVM->pStack); 35094290Sdcs 35194290Sdcs clearerr(ff->f); 35294290Sdcs if (fwrite(address, 1, length, ff->f) == length) 35394290Sdcs fwrite("\n", 1, 1, ff->f); 35494290Sdcs pushIor(pVM, ferror(ff->f) == 0); 35594290Sdcs} 35694290Sdcs 35794290Sdcs 35894290Sdcs 35994290Sdcsstatic void ficlRepositionFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */ 36094290Sdcs{ 36194290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 36294290Sdcs size_t ud = (size_t)stackPopINT(pVM->pStack); 36394290Sdcs 36494290Sdcs pushIor(pVM, fseek(ff->f, ud, SEEK_SET) == 0); 36594290Sdcs} 36694290Sdcs 36794290Sdcs 36894290Sdcs 36994290Sdcsstatic void ficlFlushFile(FICL_VM *pVM) /* ( fileid -- ior ) */ 37094290Sdcs{ 37194290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 37294290Sdcs pushIor(pVM, fflush(ff->f) == 0); 37394290Sdcs} 37494290Sdcs 37594290Sdcs 37694290Sdcs 37794290Sdcs#if FICL_HAVE_FTRUNCATE 37894290Sdcs 37994290Sdcsstatic void ficlResizeFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */ 38094290Sdcs{ 38194290Sdcs ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); 38294290Sdcs size_t ud = (size_t)stackPopINT(pVM->pStack); 38394290Sdcs 38494290Sdcs pushIor(pVM, ftruncate(fileno(ff->f), ud) == 0); 38594290Sdcs} 38694290Sdcs 38794290Sdcs#endif /* FICL_HAVE_FTRUNCATE */ 38894290Sdcs 38994290Sdcs#endif /* FICL_WANT_FILE */ 39094290Sdcs 39194290Sdcs 39294290Sdcs 39394290Sdcsvoid ficlCompileFile(FICL_SYSTEM *pSys) 39494290Sdcs{ 39594290Sdcs#if FICL_WANT_FILE 39694290Sdcs FICL_DICT *dp = pSys->dp; 39794290Sdcs assert(dp); 39894290Sdcs 39994290Sdcs dictAppendWord(dp, "create-file", ficlCreateFile, FW_DEFAULT); 40094290Sdcs dictAppendWord(dp, "open-file", ficlOpenFile, FW_DEFAULT); 40194290Sdcs dictAppendWord(dp, "close-file", ficlCloseFile, FW_DEFAULT); 40294290Sdcs dictAppendWord(dp, "include-file", ficlIncludeFile, FW_DEFAULT); 40394290Sdcs dictAppendWord(dp, "read-file", ficlReadFile, FW_DEFAULT); 40494290Sdcs dictAppendWord(dp, "read-line", ficlReadLine, FW_DEFAULT); 40594290Sdcs dictAppendWord(dp, "write-file", ficlWriteFile, FW_DEFAULT); 40694290Sdcs dictAppendWord(dp, "write-line", ficlWriteLine, FW_DEFAULT); 40794290Sdcs dictAppendWord(dp, "file-position", ficlFilePosition, FW_DEFAULT); 40894290Sdcs dictAppendWord(dp, "file-size", ficlFileSize, FW_DEFAULT); 40994290Sdcs dictAppendWord(dp, "reposition-file", ficlRepositionFile, FW_DEFAULT); 41094290Sdcs dictAppendWord(dp, "file-status", ficlFileStatus, FW_DEFAULT); 41194290Sdcs dictAppendWord(dp, "flush-file", ficlFlushFile, FW_DEFAULT); 41294290Sdcs 41394290Sdcs dictAppendWord(dp, "delete-file", ficlDeleteFile, FW_DEFAULT); 41494290Sdcs dictAppendWord(dp, "rename-file", ficlRenameFile, FW_DEFAULT); 41594290Sdcs 41694290Sdcs#ifdef FICL_HAVE_FTRUNCATE 41794290Sdcs dictAppendWord(dp, "resize-file", ficlResizeFile, FW_DEFAULT); 41894290Sdcs 41994290Sdcs ficlSetEnv(pSys, "file", FICL_TRUE); 42094290Sdcs ficlSetEnv(pSys, "file-ext", FICL_TRUE); 42194290Sdcs#endif /* FICL_HAVE_FTRUNCATE */ 42294290Sdcs#else 423231042Srpaulo (void)pSys; 42494290Sdcs#endif /* FICL_WANT_FILE */ 42594290Sdcs} 426