root/usr/src/common/ficl/fileaccess.c
#include "ficl.h"

#if FICL_WANT_FILE
/*
 * fileaccess.c
 *
 * Implements all of the File Access word set that can be implemented in
 * portable C.
 */

static void
pushIor(ficlVm *vm, int success)
{
        int ior;
        if (success)
                ior = 0;
        else
                ior = errno;
        ficlStackPushInteger(vm->dataStack, ior);
}

/* ( c-addr u fam -- fileid ior ) */
static void
ficlFileOpen(ficlVm *vm, char *writeMode)
{
        int fam = ficlStackPopInteger(vm->dataStack);
        int length = ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);
        char mode[4];
        FILE *f;
        char *filename = (char *)malloc(length + 1);
        memcpy(filename, address, length);
        filename[length] = 0;

        *mode = 0;

        switch (FICL_FAM_OPEN_MODE(fam)) {
        case 0:
                ficlStackPushPointer(vm->dataStack, NULL);
                ficlStackPushInteger(vm->dataStack, EINVAL);
        goto EXIT;
        case FICL_FAM_READ:
                strcat(mode, "r");
        break;
        case FICL_FAM_WRITE:
                strcat(mode, writeMode);
        break;
        case FICL_FAM_READ | FICL_FAM_WRITE:
                strcat(mode, writeMode);
                strcat(mode, "+");
        break;
        }

        strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");

        f = fopen(filename, mode);
        if (f == NULL)
                ficlStackPushPointer(vm->dataStack, NULL);
        else {
                ficlFile *ff = (ficlFile *)malloc(sizeof (ficlFile));
                strcpy(ff->filename, filename);
                ff->f = f;
                ficlStackPushPointer(vm->dataStack, ff);

                fseek(f, 0, SEEK_SET);
        }
        pushIor(vm, f != NULL);

EXIT:
        free(filename);
}

/* ( c-addr u fam -- fileid ior ) */
static void
ficlPrimitiveOpenFile(ficlVm *vm)
{
        ficlFileOpen(vm, "a");
}

/* ( c-addr u fam -- fileid ior ) */
static void
ficlPrimitiveCreateFile(ficlVm *vm)
{
        ficlFileOpen(vm, "w");
}

/* ( fileid -- ior ) */
static int
ficlFileClose(ficlFile *ff)
{
        FILE *f = ff->f;
        free(ff);
        return (!fclose(f));
}

/* ( fileid -- ior ) */
static void
ficlPrimitiveCloseFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        pushIor(vm, ficlFileClose(ff));
}

/* ( c-addr u -- ior ) */
static void
ficlPrimitiveDeleteFile(ficlVm *vm)
{
        int length = ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);

        char *filename = (char *)malloc(length + 1);
        memcpy(filename, address, length);
        filename[length] = 0;

        pushIor(vm, !unlink(filename));
        free(filename);
}

/* ( c-addr1 u1 c-addr2 u2 -- ior ) */
static void
ficlPrimitiveRenameFile(ficlVm *vm)
{
        int length;
        void *address;
        char *from;
        char *to;

        length = ficlStackPopInteger(vm->dataStack);
        address = (void *)ficlStackPopPointer(vm->dataStack);
        to = (char *)malloc(length + 1);
        memcpy(to, address, length);
        to[length] = 0;

        length = ficlStackPopInteger(vm->dataStack);
        address = (void *)ficlStackPopPointer(vm->dataStack);

        from = (char *)malloc(length + 1);
        memcpy(from, address, length);
        from[length] = 0;

        pushIor(vm, !rename(from, to));

        free(from);
        free(to);
}

/* ( c-addr u -- x ior ) */
static void
ficlPrimitiveFileStatus(ficlVm *vm)
{
        int status;
        int ior;

        int length = ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);

        char *filename = (char *)malloc(length + 1);
        memcpy(filename, address, length);
        filename[length] = 0;

        ior = ficlFileStatus(filename, &status);
        free(filename);

        ficlStackPushInteger(vm->dataStack, status);
        ficlStackPushInteger(vm->dataStack, ior);
}

/* ( fileid -- ud ior ) */
static void
ficlPrimitiveFilePosition(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        long ud = ftell(ff->f);
        ficlStackPushInteger(vm->dataStack, ud);
        pushIor(vm, ud != -1);
}

/* ( fileid -- ud ior ) */
static void
ficlPrimitiveFileSize(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        long ud = ficlFileSize(ff);
        ficlStackPushInteger(vm->dataStack, ud);
        pushIor(vm, ud != -1);
}

/* ( i*x fileid -- j*x ) */
#define nLINEBUF        256
static void
ficlPrimitiveIncludeFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        ficlCell id = vm->sourceId;
        int  except = FICL_VM_STATUS_OUT_OF_TEXT;
        long currentPosition, totalSize;
        long size;
        ficlString s;
        vm->sourceId.p = (void *)ff;

        currentPosition = ftell(ff->f);
        totalSize = ficlFileSize(ff);
        size = totalSize - currentPosition;

        if ((totalSize != -1) && (currentPosition != -1) && (size > 0)) {
                char *buffer = (char *)malloc(size);
                long got = fread(buffer, 1, size, ff->f);
                if (got == size) {
                        FICL_STRING_SET_POINTER(s, buffer);
                        FICL_STRING_SET_LENGTH(s, size);
                        except = ficlVmExecuteString(vm, s);
                }
        }

        if ((except < 0) && (except != FICL_VM_STATUS_OUT_OF_TEXT))
                ficlVmThrow(vm, except);

        /*
         * Pass an empty line with SOURCE-ID == -1 to flush
         * any pending REFILLs (as required by FILE wordset)
         */
        vm->sourceId.i = -1;
        FICL_STRING_SET_FROM_CSTRING(s, "");
        ficlVmExecuteString(vm, s);

        vm->sourceId = id;
        ficlFileClose(ff);
}

/* ( c-addr u1 fileid -- u2 ior ) */
static void
ficlPrimitiveReadFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        int length = ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);
        int result;

        clearerr(ff->f);
        result = fread(address, 1, length, ff->f);

        ficlStackPushInteger(vm->dataStack, result);
        pushIor(vm, ferror(ff->f) == 0);
}

/* ( c-addr u1 fileid -- u2 flag ior ) */
static void
ficlPrimitiveReadLine(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        int length = ficlStackPopInteger(vm->dataStack);
        char *address = (char *)ficlStackPopPointer(vm->dataStack);
        int error;
        int flag;

        if (feof(ff->f)) {
                ficlStackPushInteger(vm->dataStack, -1);
                ficlStackPushInteger(vm->dataStack, 0);
                ficlStackPushInteger(vm->dataStack, 0);
                return;
        }

        clearerr(ff->f);
        *address = 0;
        fgets(address, length, ff->f);

        error = ferror(ff->f);
        if (error != 0) {
                ficlStackPushInteger(vm->dataStack, -1);
                ficlStackPushInteger(vm->dataStack, 0);
                ficlStackPushInteger(vm->dataStack, error);
                return;
        }

        length = strlen(address);
        flag = (length > 0);
        if (length && ((address[length - 1] == '\r') ||
            (address[length - 1] == '\n')))
                length--;

        ficlStackPushInteger(vm->dataStack, length);
        ficlStackPushInteger(vm->dataStack, flag);
        ficlStackPushInteger(vm->dataStack, 0); /* ior */
}

/* ( c-addr u1 fileid -- ior ) */
static void
ficlPrimitiveWriteFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        int length = ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);

        clearerr(ff->f);
        fwrite(address, 1, length, ff->f);
        pushIor(vm, ferror(ff->f) == 0);
}

/* ( c-addr u1 fileid -- ior ) */
static void
ficlPrimitiveWriteLine(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        size_t length = (size_t)ficlStackPopInteger(vm->dataStack);
        void *address = (void *)ficlStackPopPointer(vm->dataStack);

        clearerr(ff->f);
        if (fwrite(address, 1, length, ff->f) == length)
                fwrite("\n", 1, 1, ff->f);
        pushIor(vm, ferror(ff->f) == 0);
}

/* ( ud fileid -- ior ) */
static void
ficlPrimitiveRepositionFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);

        pushIor(vm, fseek(ff->f, ud, SEEK_SET) == 0);
}

/* ( fileid -- ior ) */
static void
ficlPrimitiveFlushFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        pushIor(vm, fflush(ff->f) == 0);
}

#if FICL_PLATFORM_HAS_FTRUNCATE
/* ( ud fileid -- ior ) */
static void
ficlPrimitiveResizeFile(ficlVm *vm)
{
        ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
        size_t ud = (size_t)ficlStackPopInteger(vm->dataStack);

        pushIor(vm, ficlFileTruncate(ff, ud) == 0);
}
#endif /* FICL_PLATFORM_HAS_FTRUNCATE */
#endif /* FICL_WANT_FILE */

void
ficlSystemCompileFile(ficlSystem *system)
{
#if !FICL_WANT_FILE
        FICL_IGNORE(system);
#else
        ficlDictionary *dictionary = ficlSystemGetDictionary(system);
        ficlDictionary *environment = ficlSystemGetEnvironment(system);

        FICL_SYSTEM_ASSERT(system, dictionary);
        FICL_SYSTEM_ASSERT(system, environment);

        ficlDictionarySetPrimitive(dictionary, "create-file",
            ficlPrimitiveCreateFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "open-file",
            ficlPrimitiveOpenFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "close-file",
            ficlPrimitiveCloseFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "include-file",
            ficlPrimitiveIncludeFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "read-file",
            ficlPrimitiveReadFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "read-line",
            ficlPrimitiveReadLine,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "write-file",
            ficlPrimitiveWriteFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "write-line",
            ficlPrimitiveWriteLine,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "file-position",
            ficlPrimitiveFilePosition,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "file-size",
            ficlPrimitiveFileSize,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "reposition-file",
            ficlPrimitiveRepositionFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "file-status",
            ficlPrimitiveFileStatus,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "flush-file",
            ficlPrimitiveFlushFile,  FICL_WORD_DEFAULT);

        ficlDictionarySetPrimitive(dictionary, "delete-file",
            ficlPrimitiveDeleteFile,  FICL_WORD_DEFAULT);
        ficlDictionarySetPrimitive(dictionary, "rename-file",
            ficlPrimitiveRenameFile,  FICL_WORD_DEFAULT);

#if FICL_PLATFORM_HAS_FTRUNCATE
        ficlDictionarySetPrimitive(dictionary, "resize-file",
            ficlPrimitiveResizeFile,  FICL_WORD_DEFAULT);

        ficlDictionarySetConstant(environment, "file", FICL_TRUE);
        ficlDictionarySetConstant(environment, "file-ext", FICL_TRUE);
#else /*  FICL_PLATFORM_HAS_FTRUNCATE */
        ficlDictionarySetConstant(environment, "file", FICL_FALSE);
        ficlDictionarySetConstant(environment, "file-ext", FICL_FALSE);
#endif /* FICL_PLATFORM_HAS_FTRUNCATE */

#endif /* !FICL_WANT_FILE */
}