/** 
   -- miscellaneous useful extra words for BLOCK-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 BLOCK-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/block-sub.h>

#include <errno.h>
#include <string.h>
#include <pfe/logging.h>


/** CLOSE-BLOCKFILE ( -- ) w32for
   w32for-implementation:
 blockhandle -1 <> if flush close-file drop then
 -1 set-blockfile
   in pfe:
 : CLOSE-BLOCKFILE 
   BLOCK-FILE ?DUP IF FLUSH CLOSE-FILE DROP THEN 
   OFF> BLOCK-FILE ;
 */
FCode (p4_close_blockfile)
{
    if (BLOCK_FILE)
    
{
	FX (p4_flush);
	p4_close_file (BLOCK_FILE);
    }

    BLOCK_FILE = 0;
}


/** OPEN-BLOCKFILE ( "filename" -- ) w32for
 w32for-implementation:
 close-blockfile
 parse-word r/w open-file abort" failed to open block-file"
 set-blockfile
 empty-buffers 
 */
FCode (p4_open_blockfile)
{
    FX (p4_close_blockfile);
    p4_word_parseword (' '); *DP=0; /* PARSE-WORD-NOHERE */
    if (! PFE.word.len)
        p4_throw (P4_ON_INVALID_NAME);
    if (! p4_set_blockfile (p4_open_blockfile (PFE.word.ptr, PFE.word.len)))
        p4_throws (FX_IOR, PFE.word.ptr, PFE.word.len);
}



/** CREATE-BLOCKFILE ( n "filename" -- ) w32for
   w32for-implementation:
 close-blockfile
 parse-word r/w create-file abort" failed to create block-file"
 set-blockfile
 dup b/buf m* blockhandle resize-file
 abort" unable to create a file of that size"
 empty-buffers
 0 do i wipe loop 
 flush
   pfe does not wipe the buffers
 */
FCode (p4_create_blockfile)
{
    register p4_File *fid;
    
    FX (p4_close_blockfile);
    p4_word_parseword (' '); *DP=0; /* PARSE-WORD-NOHERE */
    if (! PFE.word.len)
        p4_throw (P4_ON_INVALID_NAME);
    switch (p4_file_access (PFE.word.ptr, PFE.word.len))
    
{
     case -1:
     case 0:
         fid = p4_create_file (PFE.word.ptr, PFE.word.len, FMODE_RWB);
         if (fid == NULL)
             p4_throws (FX_IOR, PFE.word.ptr, PFE.word.len);
         p4_close_file (fid);
    }

    if (! p4_set_blockfile (p4_open_blockfile (PFE.word.ptr, PFE.word.len)))
        p4_throws (FX_IOR, PFE.word.ptr, PFE.word.len);
    p4_resize_file (BLOCK_FILE, (FX_POP)*BPBUF);
}


/** USING ( 'filename' -- ) obsolete
   use filename as a block file 
   OBSOLETE!! use => OPEN-BLOCKFILE
 */
FCode (p4_using)
{
    P4_fail ("DO NOT use USING - use OPEN-BLOCKFILE");
    FX (p4_open_blockfile);
}


/** USING-NEW ( 'filename' -- ) obsolete
   like => USING but can create the file
   OBSOLETE!! use => CREATE-BLOCKFILE
 */
FCode (p4_using_new)
{
    P4_fail ("DO NOT use USING-NEW - use 0 CREATE-BLOCKFILE");
    FX_PUSH (0);
    FX (p4_create_blockfile);
}


/** SET-BLOCKFILE ( fid -- ) win32for
   win32forth uses a system-filedescriptor where -1 means unused
   in the BLOCKHANDLE, but we use a "FILE*"-like structure, so NULL
   means NOT-IN-USE. Here we set it.
 */
FCode(p4_set_blockfile)
{
    p4_set_blockfile ((p4_File*) FX_POP);
}


P4_LISTWORDS (block_misc) =
{
    P4_INTO ("FORTH", "[ANS]"),
    P4_FXco ("CLOSE-BLOCKFILE",		p4_close_blockfile),
    P4_FXco ("OPEN-BLOCKFILE",		p4_open_blockfile),
    P4_FXco ("CREATE-BLOCKFILE",	p4_create_blockfile),

    P4_INTO ("EXTENSIONS", 0),
    P4_DVaL ("BLOCK-FILE",		input.block_file),
    P4_FXco ("SET-BLOCKFILE",		p4_set_blockfile),
    P4_FXco ("USING",			p4_using),
    P4_FXco ("USING-NEW",		p4_using_new),
    P4_OCoN ("B/BUF",			P4_BPBUF),
}
;
P4_COUNTWORDS (block_misc, "BLOCK-Misc Compatibility words");

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