/** 
 * -- miscellaneous useful extra words for FILE-EXT
 *
 *  Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
 *
 *  @see     GNU LGPL
 *  @author  Tektronix CTE              @(#) %derived_by: guidod %
 *  @version %version:  %
 *    (%date_modified:  %)
 *
 *  @description
 *      Compatiblity with former standards, miscellaneous useful words.
 *      ... for FILE-EXT
 */
/*@{*/

#if defined(__version_control__) && defined(__GNUC__)
static char* id __attribute__((unused)) = 
"@(#) $Id: %full_filespec:   % $";
#endif

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>
#include <pfe/file-sub.h>

#include <errno.h>

/** INCLUDE ( 'filename' -- ? )
 * load the specified file, see also LOAD" filename"
 */
FCode (p4_include)
{
    char *fn = p4_word (' ');

    p4_included (fn + 1, *(p4char *) fn);
}

/************************************************************************/
/* more file manipulation                                               */
/************************************************************************/

/** COPY-FILE ( src-str src-strlen dst-str dst-strlen -- errno|0 )
 * like RENAME-FILE, copies the file from src-name to dst-name
 * and returns an error-code or null
 */
FCode (p4_copy_file)
{
    char* src = p4_pocket_filename ((char *) SP[3], SP[2]);
    char* dst = p4_pocket_filename ((char *) SP[1], SP[0]);
    SP += 3;
    *SP = fn_copy (src, dst, LONG_MAX) ? errno : 0;
}

/** MOVE-FILE ( src-str src-strlen dst-str dst-strlen -- errno|0 )
 * like RENAME-FILE, but also across-volumes 

 * moves the file from src-name to dst-name and returns an
 * error-code or null
 */
FCode (p4_move_file)		
{
    char* src = p4_pocket_filename ((char *) SP[3], SP[2]);
    char* dst = p4_pocket_filename ((char *) SP[1], SP[0]);
    SP += 3;
    *SP = fn_move (src, dst) ? errno : 0;
}

/** FILE-R/W ( addr blk f fid -- )
 * like FIG-Forth  R/W 
 */
FCode (p4_file_rw)			
{	
    p4_read_write (
                   (File *) SP[0],	/* file to read from */
                   (char *) SP[3],	/* buffer address, 1K */
                   (p4ucell) SP[2],	/* block number */
                   SP[0]);		/* readflag */
    SP += 4;
}

/** FILE-BLOCK ( a file-id -- c )
 */
FCode (p4_file_block)
{
    File *fid = (File *) *SP++;

    *SP = (p4cell) p4_block (fid, *SP);
}

/** FILE-BUFFER ( a file-id -- c )
 */
FCode (p4_file_buffer)
{
    File *fid = (File *) *SP++;
    int n;

    *SP = (p4cell) p4_buffer (fid, *SP, &n);
}

/** FILE-EMPTY-BUFFERS ( file-id -- )
 */
FCode (p4_file_empty_buffers)
{
    p4_empty_buffers ((File *) *SP++);
}

/** FILE-FLUSH ( file-id -- )
 simulate      : FILE-FLUSH DUP FILE-SAVE-BUFFERS FILE-EMTPY-BUFFERS ;
 */
FCode (p4_file_flush)
{
    File *fid = (File *) *SP++;

    p4_save_buffers (fid);
    p4_empty_buffers (fid);
}

/** FILE-LIST ( x file-id -- )
 */
FCode (p4_file_list)
{
    File *fid = (File *) *SP++;
    
    p4_list (fid, SCR = *SP++);
}

/** FILE-LOAD ( x file-id -- )
 */
FCode (p4_file_load)
{
    File *fid = (File *) *SP++;

    p4_load (fid, *SP++);
}

/** FILE-SAVE-BUFFERS ( file-id -- )
 */
FCode (p4_file_save_buffers)
{
    File *fid = (File *) *SP++;
    
    p4_save_buffers (fid);
}

/** FILE-THRU ( lo hi file-id -- )
 * see THRU
 */
FCode (p4_file_thru)
{
    File *fid = (File *) *SP++;
    int hi = *SP++;
    int lo = *SP++;

    p4_thru (fid, lo, hi);
}

/** FILE-UPDATE ( file-id -- )
 */
FCode (p4_file_update)
{
    p4_update ((File *) *SP++);
}

P4_LISTWORDS (file_misc) =
{
     (, ),
     (,		),

    /* more file-manipulation */
     (,	),
     (,	),
     (,	),
    /** the FILE-operations can can also be USING blocks from a file */
     (,	),
     (,	),
     (, ),
     (,	),
     (,	),
     (,	),
     (, ),
     (,	),
     (,	),
};
P4_COUNTWORDS (file_misc, "FILE-Misc Compatibility words");

/*@}*/
/* 
 * Local variables:
 * c-file-style: "stroustrup"
 * End:
 */