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