/** 
   -- 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 <br>
   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 <c> R/W </c>
 */
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) =
{
    P4_INTO ("FORTH", "[ANS]"),
    P4_FXco ("INCLUDE",		p4_include),

    /* more file-manipulation */
    P4_FXco ("COPY-FILE",	p4_copy_file),
    P4_FXco ("MOVE-FILE",	p4_move_file),
    P4_FXco ("FILE-R/W",	p4_file_rw),
    /** the FILE-operations can can also be => USING blocks from a file */
    P4_FXco ("FILE-BLOCK",	p4_file_block),
    P4_FXco ("FILE-BUFFER",	p4_file_buffer),
    P4_FXco ("FILE-EMPTY-BUFFERS", p4_file_empty_buffers),
    P4_FXco ("FILE-FLUSH",	p4_file_flush),
    P4_FXco ("FILE-LIST",	p4_file_list),
    P4_FXco ("FILE-LOAD",	p4_file_load),
    P4_FXco ("FILE-SAVE-BUFFERS", p4_file_save_buffers),
    P4_FXco ("FILE-THRU",	p4_file_thru),
    P4_FXco ("FILE-UPDATE",	p4_file_update),
}
;
P4_COUNTWORDS (file_misc, "FILE-Misc Compatibility words");

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