/** 
 * FILE ---  Optional File-Access Word Set
 *
 *  Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE              @(#) %derived_by: guidod %
 *  @version %version: bln_mpt1!5.8 %
 *    (%date_modified: Tue Sep 10 13:28:57 2002 %)
 *
 *  @description
 *       The Optional File-Access Word Set and
 *       File-Access Extension Words.
 *       These words imply some kind of file-system unlike
 *       the BLOCK wordset.
 *
 */
/*@{*/

#if defined(__version_control__) && defined(__GNUC__)
static char* id __attribute__((unused)) = 
"@(#) $Id: %full_filespec: file-ext.c~bln_mpt1!5.8:csrc:bln_12xx!1 % $";
#endif

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>
#include <pfe/def-xtra.h>

#include <stdio.h>
#include <errno.h>

#include <pfe/file-sub.h>
#include <pfe/logging.h>
#include <pfe/_missing.h>

/* long <-> p4dcell conversion macros, won't work on 16 bit machines */

#define UL2UDC(UL, UDC)	((UDC).hi = 0, (UDC).lo = (p4ucell)(UL))
#define UDC2UL(HI, LO)	(LO)

#ifndef _NULLFILE_ROBUST   /* USER-CONFIG */
#ifdef  PFE_HAVE_WINBASE_H /* read/write check for NULL-file w/in pfe itself */
#define _NULLFILE_ROBUST 1 /* win32 API will SIGBUS on NULL-file read/write */
#else
#define _NULLFILE_ROBUST 0
#endif
#endif

#if _NULLFILE_ROBUST+0
#define _is_nullfile(X) !(X)
#else
#define _is_nullfile(X) 0
#endif

#ifdef PFE_WITH_FIG
#define CHECKFILE " - did an earlier FILE-OPEN fail?" \
                  " - often it is file permissions" \
                  " - file or directory read-only?"
#else
#define CHECKFILE " (did some FILE-OPEN fail?)"
#endif

/* ================================================================= */

/** BIN ( access-mode -- access-mode' )
 * modify the give file access-mode to be a binary-mode
 */
FCode (p4_bin)
{
    *SP += FMODE_BIN;
}

/** CLOSE-FILE ( file -- code )
 * close the file and return the status-code
 */
FCode (p4_close_file)
{
    File *fid = (File *) SP[0];

    if (_is_nullfile(fid)) goto nullfile;
    SP[0] = p4_close_file (fid) ? errno : 0;
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_warn ("close on NULL file");
}

/** CREATE-FILE ( str-adr str-len mode -- file code )
 * create the file with the given name and open
 * it - returns the file id and a status code.
 * A code of zero means success. An existing file
 * of the same name is truncated upon open.
 */
FCode (p4_create_file)
{
    char *fn = (char *) SP[2];	/* c-addr, name */
    p4ucell u = SP[1];		/* length of name */
    p4cell fam = SP[0];		/* file access mode */
    File *fid = p4_create_file (fn, u, fam);
    
    SP += 1;
    SP[1] = (p4cell) fid;
    SP[0] = fid ? 0 : errno;
}

/** DELETE-FILE ( str-adr str-len -- code )
 * delete the named file and return a status code
 */
FCode (p4_delete_file)
{
    char* fnz = p4_pocket_filename ((char*)SP[1], SP[0]) ; /* as asciiz */
    SP += 1;
    SP[0] = _pfe_remove (fnz) ? errno : 0;
}

/** FILE-POSITION ( file -- p.pos code )
 * return the current position in the file and
 * return a status code. A code of zero means success.
 */
FCode (p4_file_position)
{
    File *fid = (File *) SP[0];	/* file-id */
    long pos;
    p4udcell ud;

    if (_is_nullfile(fid)) goto nullfile;
    pos = ftell (fid->f);
    SP -= 2;
    if (pos != -1)
    {
        UL2UDC (pos, ud);
        SP[0] = 0;		/* ior */
    }else{
        ud.lo = ud.hi = UCELL_MAX;
        SP[0] = errno;		/* ior */
    }
    *(p4udcell *) &SP[1] = ud;	/* ud */
    return;
 nullfile:
    ud.lo = ud.hi = 0;
    *(p4udcell *) &SP[1] = ud;
    SP[0] = EINVAL;
    P4_warn ("trying seek on NULL file");
}

/** FILE-SIZE ( file -- s.size code )
 * return the current size of the file and
 * return a status code. A code of zero means success.
 */
FCode (p4_file_size)
{
    File *fid = (File *) SP[0];	/* fileid */
    long size;
    p4udcell ud;

    if (_is_nullfile(fid)) goto nullfile;
    size = fsize (fid->f);
    SP -= 2;
    if (size != -1)
    {
        UL2UDC (size, ud);
        SP[0] = 0;		/* ior */
    }else{
        ud.lo = ud.hi = UCELL_MAX;
        SP[0] = errno;		/* ior */
    }
    *(p4udcell *) &SP[1] = ud;	/* ud */
    return;
 nullfile:
    ud.lo = ud.hi = 0;
    *(p4udcell *) &SP[1] = ud;
    SP[0] = EINVAL;
    P4_warn ("trying seek on NULL file");
}

/** INCLUDE-FILE ( file -- )
 * INTERPRET the given file
 */
FCode (p4_include_file)
{
    p4_include_file ((File *) *SP++);
}

/** INCLUDED ( str-adr str-len -- )
 * open the named file and then INCLUDE-FILE
 * see also the interactive INCLUDE
 */
FCode (p4_included)
{
    char *fn = (char *) SP[1];	/* c-addr, name */
    p4ucell u = SP[0];		/* length of name */

    SP += 2;
    p4_included (fn, u);
}

/** OPEN-FILE ( str-adr str-len mode -- file code )
 * open the named file with mode. returns the
 * file id and a status code. A code of zero
 * means success.
 */
FCode (p4_open_file)
{
    char *fn = (char *) SP[2];	/* c-addr, name */
    p4ucell u = SP[1];		/* length of name */
    p4cell fam = SP[0];		/* file access mode */
    File *fid = p4_open_file (fn, u, fam);

    SP += 1;
    SP[1] = (p4cell) fid;
    SP[0] = fid ? 0 : errno;
}

/** READ-FILE ( str-adr str-len file -- count code )
 * fill the given string buffer with characters
 * from the buffer. A status code of zero means
 * success and the returned count gives the
 * number of bytes actually read. If an error
 * occurs the number of already transferred bytes 
 * is returned.
 */
FCode (p4_read_file)
{
    char *c_addr = (char *) SP[2];
    p4ucell u = SP[1];
    File *fid = (File *) SP[0];
    SP += 1;
    if (_is_nullfile(fid)) goto nullfile;
    SP[0] = p4_read_file (c_addr, &u, fid);
    SP[1] = u;
    return;
 nullfile:
    SP[0] = EINVAL;
    SP[1] = 0;
    P4_fail ("trying read from NULL file" CHECKFILE);
}

/** READ-LINE ( str-adr str-len file -- count flag code )
 * fill the given string buffer with one line
 * from the file. A line termination character
 * (or character sequence under WIN/DOS) may
 * also be placed in the buffer but is not
 * included in the final count. In other respects
 * this function performs a READ-FILE
 */
FCode (p4_read_line)
{
    char *c_addr = (char *) SP[2];
    p4ucell u = SP[1];
    File *fid = (File *) SP[0];
    p4cell ior;
    if (_is_nullfile(fid)) goto nullfile;
    SP[1] = p4_read_line (c_addr, &u, fid, &ior);
    SP[2] = u;
    SP[0] = ior;
    return;
 nullfile:
    SP[0] = EINVAL;
    SP[1] = EINVAL;
    SP[2] = 0;
    P4_fail ("trying read from NULL file" CHECKFILE);
}

/** REPOSITION-FILE ( o.offset file -- code )
 * reposition the file offset - the next FILE-POSITION
 * would return o.offset then. returns a status code.
 */
FCode (p4_reposition_file)
{
    File *fid = (File *) SP[0];
    long pos = UDC2UL (SP[1], SP[2]);

    if (_is_nullfile(fid)) goto nullfile;
    SP += 2;
    SP[0] = p4_reposition_file (fid, pos);
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_warn ("trying seek on NULL file");
}

/** RESIZE-FILE ( s.size file -- code )
 * resize the give file, returns a status code.
 */
FCode (p4_resize_file)
{
    File *fid = (File *) SP[0];
    long size = UDC2UL (SP[1], SP[2]);

    if (_is_nullfile(fid)) goto nullfile;
    SP += 2;
    if (p4_resize_file (fid, size) != 0)
        *SP = errno;
    else
        *SP = 0, fid->size = (p4ucell) (size / BPBUF);
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_fail ("trying seek on NULL file" CHECKFILE);
}

/** WRITE-FILE ( str-adr str-len file -- code )
 * write characters from the string buffer to a file,
 * returns a status code.
 */ 
FCode (p4_write_file)
{
    char *c_addr = (char *) SP[2];
    p4ucell u = SP[1];
    File *fid = (File *) SP[0];

    SP += 2;
    if (_is_nullfile(fid)) goto nullfile;
    SP[0] = p4_write_file (c_addr, u, fid);
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_fail ("trying write to NULL file" CHECKFILE);
}

/** WRITE-LINE ( str-adr str-len file -- code )
 * write characters from the string buffer to a file,
 * and add the line-terminator to the end of it.
 * returns a status code.
 */
FCode (p4_write_line)
{
    char *c_addr = (char *) SP[2];
    p4ucell u = SP[1];
    File *fid = (File *) SP[0];

    SP += 2;
    if (_is_nullfile(fid)) goto nullfile;
    if ((SP[0] = p4_write_file (c_addr, u, fid)) == 0)
        putc ('\n', fid->f);
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_fail ("trying write to NULL file" CHECKFILE);
}

/** FILE-STATUS ( str-adr str-len -- sub-code code )
 * check the named file - if it exists
 * the status code is zero. The sub-code
 * is implementation-specific.
 */
FCode (p4_file_status)
{
    int mode = p4_file_access ((char *) SP[1], SP[0]);

    if (mode == -1)
    {
        SP[1] = 0;
        SP[0] = errno;
    }else{
        SP[1] = mode;
        SP[0] = 0;
    }
}

/** FLUSH-FILE ( file -- code )
 * flush all unsaved buffers of the file to disk.
 * A status code of zero means success.
 */
FCode (p4_flush_file)
{
    File *fid = (File *) SP[0];

    if (_is_nullfile(fid)) goto nullfile;
    if (BLOCK_FILE == fid)
    {
        FX (p4_save_buffers);
        SP[0] = 0;
    }else{
        if (fflush (fid->f))
            SP[0] = errno;
        else
            SP[0] = 0;
    }
    return;
 nullfile:
    SP[0] = EINVAL;
    P4_warn ("trying flush on NULL file");
}

/** RENAME-FILE ( str-adr1 str-len1 str-adr2 str-len2 -- code )
 * rename the file named by string1 to the name of string2.
 * returns a status-code
 */
FCode (p4_rename_file)
{
    char* oldnm;
    char* newnm;

    oldnm = p4_pocket_filename ((char *) SP[3], SP[2]);
    newnm = p4_pocket_filename ((char *) SP[1], SP[0]);
    SP += 3;
    *SP = _P4_rename (oldnm, newnm) ? errno : 0;
}

static FCode (p__max_files)
{
    FX_PUSH (PFE_set.max_files);
}

/** R/O ( -- bitmask )
 * a bitmask for OPEN-FILE ( R/O R/W W/O BIN )
 */

/** W/O ( -- bitmask )
 * a bitmask for OPEN-FILE or CREATE-FILE ( R/O R/W W/O BIN )
 */

/** R/W ( -- bitmask )
 * a bitmask for OPEN-FILE or CREATE-FILE ( R/O R/W W/O BIN )
 */

/**  ENVIRONMENT MAX-FILES  ( -- number )
 * the number of opened file-ids allowed during compilation.
 * portable programs can check this with ENVIRONMENT?
 */

P4_LISTWORDS (file) =
{
     (, ),
     (,		 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,		 ),
     (,		 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,		 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),
     (,	 ),

     (,  ),
     (,	  ),
     (,	 ),
    
};
P4_COUNTWORDS (file, "File-access + extensions");

/*@}*/