File: files.c

package info (click to toggle)
regina 0.08e-2
links: PTS
area: main
in suites: slink
size: 2,128 kB
ctags: 2,840
sloc: ansic: 23,618; sh: 1,520; lex: 1,371; yacc: 1,115; makefile: 562; cpp: 280
file content (4015 lines) | stat: -rw-r--r-- 124,662 bytes
#ifndef lint
static char *RCSid = "$Id: files.c,v 1.13 1993/05/10 06:19:06 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 * This module is a real pain, since file I/O is one of the features
 * that varies most between different platforms. And what makes it
 * even more of a pain, is the fact that it must be coordinated with
 * the handling of the condition NOTREADY. Anyway, here are the
 * decisions set up before (well ... during) the implementation that
 * guide how this this thing is supposed to work.
 *
 * There are four kind of routines, structured in four levels:
 *            
 * (1)---------+       (2)--------+       
 * | builtin   | ----> | general  |   B   C library
 * | functions |   A   | routines | ---->  Routines  
 * +-----------+       +----------+       
 *       |                  |                  
 *       |                  |                        
 *       |                  V     (3)--------+               
 *       +----------------->+---> | Error    |               
 *                                | routines |               
 *                                +----------+               
 *
 * 1) Builtin functions, these has the "std_" prefix which is standard 
 *    for all buildin functions. The task for these functions are to 
 *    process parameters, call (2) which specializes on operations (like
 *    read, write, position etc), and return a decent answer back to its
 *    caller. There is one routine in this level for each of the 
 *    functions in the library of built-in functions. Most of them are
 *    std_* functions, but there are a few others too.
 *
 * 2) These are general operations for reading, writing, positioning,
 *    etc.  They may call the C library routines directly, or
 *    indirectly, through calls to (3). The interface (A) between (1)
 *    and (2) is based on the local structure fileboxptr and strengs.
 *    There are one function in this level for each of the basic 
 *    operations needed to be performed on a file. Opening, closing,
 *    reading a line, writing a line, line positioning, reading chars,
 *    writing chars, positioning chars, counting lines, counting 
 *    chars, etc. The interface (B) to the C library routines uses 
 *    FILE* and char* for its operations.
 *
 * 3) General routines to perform 'trivial' tasks. In this level, 
 *    things like retriving Rexx's file table entries are implemented, 
 *    and all the errorhandling. These are called from both the two
 *    previous levels.
 *
 * There are three standard files, called "<stdin>", "<stdout>" and
 * "<stderr>" (note that the "<" and ">" are part of the filename.)
 * These are handles for the equivalent Unix standard files. This
 * might cause problems if you actually do want a file calls that, or
 * if one of these files is closed, and the more information is
 * written to it (I can easily visulize Users trying to delete such a
 * file :-)) So the standard files -- having set flag SURVIVOR -- will
 * never be closed or reopened. 
 *
 * Error_file is called by that routine which actually discovers the
 * problem. If it is an CALL ON condition, it will set the FLAG_FAKE
 * flag, which all other routines will check for.
 */

#include "rexx.h"
#include <errno.h>
#include <stdio.h>
#include <string.h>
#ifdef HAVE_ASSERT_H
# include <assert.h>
#endif
#ifdef HAVE_LIMITS_H
# include <limits.h>
#endif
#include <ctype.h>
#include <time.h>
#if defined(VMS)
# include <stat.h>
#elif defined(OS2)
# include <sys/stat.h>
# ifdef HAVE_UNISTD_H
#  include <unistd.h>
# endif
#elif defined(__WATCOMC__) || defined(_MSC_VER)         /* MH 10-06-96 */
# include <sys/stat.h>                                  /* MH 10-06-96 */
# include <fcntl.h>                                     /* MH 10-06-96 */
# ifdef HAVE_UNISTD_H
#  include <unistd.h>                                   /* MH 10-06-96 */
# endif
#else
# include <sys/stat.h>
# include <pwd.h>
# include <grp.h>
# include <fcntl.h>
# ifdef HAVE_UNISTD_H
#  include <unistd.h>
# endif
#endif

#ifdef HAVE_LINUX_STAT_H
# include <linux/stat.h>
#endif

/*
 * The macrodefinition below defines the various modes in which a
 * file may be opened. These modes are:
 *
 *  READ      - Open for readonly access. The current read position 
 *              is set to the the start of the file. If the file does 
 *              not exist, report an error. 
 *
 *  WRITE     - Open for read and write. The current read position is
 *              set to the start of the file, while the current write 
 *              position is set to EOF. If file does not exist, create 
 *              it. If file does exist, use existing data.
 *  
 *  UPDATE    - The combined operation of READ and WRITE, but if file 
 *              does not exist, issue an error. 
 * 
 *  APPEND    - Open in APPEND mode, i.e. open for writeonly, position 
 *              at the End-Of-File, and (if possible) open in a mode 
 *              that disallows positioning. The file will be a transient
 *              file. If the file does not exist, create it.
 *
 *  CREATE    - Open for write, but if the file does exist, truncate 
 *              it at the beginning after opening it.
 */
#define ACCESS_NONE           0
#define ACCESS_READ           1
#define ACCESS_WRITE          2
#define ACCESS_UPDATE         3
#define ACCESS_APPEND         4
#define ACCESS_CREATE         5
#define ACCESS_STREAM_APPEND  6
#define ACCESS_STREAM_REPLACE 7

/*
 * These macros is used to set the value of the 'oper' in the filebox
 * data structure. If last operation on a file was a read or a write, 
 * set 'oper' to OPER_READ or OPER_WRITE, respectively. If last 
 * operation was repositioning or flushing, use OPER_NONE. See 
 * description of 'oper' field in definition of 'filebox'.
 */
#define OPER_NONE          0
#define OPER_READ          1
#define OPER_WRITE         2

/* 
 * Flags, carrying information about files. The 'flag' field in the 
 * 'filebox' structure is set to values matching these defintions. The
 * meaning of each of these flags is:
 *
 * PERSIST   - Set if file is persistent, if unset, file is treated
 *             as a transient file. 
 * EOF       - Currently not in use
 * READ      - File has been opened for read access.
 * WRITE     - File has been opened for write access. 
 * CREATE    - Currently not in use
 * ERROR     - Set if the file is in error state. If operations are 
 *             attempted performed on files in state error, the 
 *             NOTREADY condition will in general be raised, and the
 *             operation will fail. 
 * SURVIVOR  - Set for certain special files; the default streams, which 
 *             is not really to be closed or reopened. 
 * FAKE      - Meaningful only if ERROR is set. If FAKE is set, and 
 *             an operation on the file is attempted, the operation is 
 *             'faked' (NOTREADY is not triggered, and the result returned
 *             for write operations does not report that the output was
 *             not written.
 * WREOF     - Current write position is at EOF. If line output is 
 *             performed, there is no need to truncate the file. 
 * RDEOF     - Current read position is at EOF. Reading EOF raises the
 *             NOTREADY condition, but does not put the file into error
 *             state. 
 * SWAPPED   - This flag is set if the file is currently swapped out, that
 *             is, the file is closed in order to let another file use 
 *             the system's file table sloth freed when the file was 
 *             temporarily closed.
 */
#define FLAG_PERSIST   0x0001
#define FLAG_EOF       0x0002 
#define FLAG_READ      0x0004
#define FLAG_WRITE     0x0008
#define FLAG_CREATE    0x0010
#define FLAG_ERROR     0x0020
#define FLAG_SURVIVOR  0x0040
#define FLAG_FAKE      0x0080
#define FLAG_WREOF     0x0100
#define FLAG_RDEOF     0x0200
#define FLAG_SWAPPED   0x0400

/* 
 * So, what is the big difference between FAKE and ERROR. Well, when a 
 * file gets it ERROR flag set, it signalizes that the file is in 
 * error state, and that no fileoperations should be performed on it. 
 * The FAKE flag is only meaningful when the ERROR flag is set. If set
 * the FAKE flag tells that file operations should be faked in order to 
 * give the user the impression that everything is OK, while if FAKE is 
 * not set, errors are returned. 
 *
 * The clue is that if a statement contains several operations on one 
 * file, and the first operation bombs, CALL ON NOTREADY will not take
 * effect before the next statement boundary at the same procedural 
 * level So, for the rest of the file operations until that statement 
 * has finished, the FAKE flag is set, and signalizes that OK result
 * should be returned whenever positioning or write is performed, and 
 * that NOTREADY should not be raised again.
 * 
 * The reason for the RDEOF flag is that reading beyond EOF is not really
 * a capital crime, and a lot of programmers are likely to do that, and 
 * expect things to be OK after repositioning current read position to 
 * another part of the file. If a file is put into ERROR state, it has
 * to be explicitly reset in order to do any useful to it afterwards. 
 * Therefore, if EOF is seen on input, RDEOF is set, and NOTREADY is
 * raised, but the file is not put into ERROR state. 
 */

/*
 * The following macros defines symbolic names to the commands available
 * in the Rexx built-in function STREAM(). The meaning of each of these
 * commands are:
 *
 *  READ       - Opens the file with the corresponding mode. For a deeper
 *  WRITE        description of each of these modes, see the defininition
 *  APPEND       of the ACCESS_* macros. STREAM() is used to explicitly
 *  UPDATE       open a file, while Rexx is totally happy with the 
 *  CREATE       traditional implicit opening, i.e. that the file is 
 *               opened for the needed access at the time when it is 
 *               first used. If the file to be opened is already open, 
 *               it will first be closed, and then opened in the 
 *               specified mode.
 *
 *  CLOSE      - Closes a file, works for any type of access. But if 
 *               the file is a default stream, it will not be closed. 
 *               Default streams should not be closed.
 * 
 *  FLUSH      - Performs flushing on the file. Actually, I'm not so 
 *               sure whether that is very interesting, since flushing
 *               is always performed after a write, anyway. Though, it 
 *               might become an important function if the automatic 
 *               flushing after write is removed (e.g. to improve speed).
 * 
 *  STATUS     - Returns status information assiciated with the file as
 *               a human readable string. The information returned is the 
 *               internal information that Rexx stores in the Rexx file
 *               table entry for that file. Use FSTAT to get information
 *               about the file from the operating system. See the 
 *               function 'getrexxstatus()' for more information about 
 *               the layout of the returned string.
 * 
 *  FSTAT      - Returns status information associated with the file as
 *               a human readable string. The information returned is the
 *               information normally returned by the stat() system call
 *               under Unix (i.e. size, dates, access modes, etc). Use 
 *               STATUS to get Rexx's information about the file. See
 *               the function 'getstatus()' for more information about
 *               the layout of the string returned. 
 * 
 * RESET       - Resets the file after an error. Of course, this will 
 *               only work for files which are 'resettable'. If the error
 *               is too serious, resetting will help little to fix the 
 *               problem. E.g. writing beyond end-of-file can easily be
 *               fixed by RESET, trying to use a file which is named 
 *               by an invalid syntax can not be correctly reset.
 *
 * READABLE    - Checks that the file in question is available in the 
 * WRITABLE      mode given, for the user that is executing the script. 
 * EXECUTABLE    I.e. READABLE will return '1' for a file, if the file 
 *               is readable for the user, else '0' is returned. Note 
 *               that FSTAT returns the information about the accessmodes
 *               for a file, these returns the 'accessmode' which is 
 *               relevant for a particular user. Also note that if your
 *               machine are using suid-bit (i.e. Unix), this function 
 *               will check for the real uid, not the effective uid. 
 *               Consequently, it may not give the wanted result for 
 *               suid rexx scripts, see the Unix access() function. (And
 *               anyway, suid scripts are a _very_ bad idea under Unix,
 *               so this is probably not a problem ... :-)
 */
#define COMMAND_NONE         0
#define COMMAND_READ         1
#define COMMAND_WRITE        2
#define COMMAND_APPEND       3
#define COMMAND_UPDATE       4
#define COMMAND_CREATE       5
#define COMMAND_CLOSE        6
#define COMMAND_FLUSH        7
#define COMMAND_STATUS       8
#define COMMAND_FSTAT        9
#define COMMAND_RESET       10
#define COMMAND_READABLE    11
#define COMMAND_WRITEABLE   12
#define COMMAND_EXECUTABLE  13
#define COMMAND_LIST        14
#define COMMAND_QUERY_DATETIME 15
#define COMMAND_QUERY_EXISTS   16
#define COMMAND_QUERY_HANDLE   17
#define COMMAND_QUERY_SEEK     18
#define COMMAND_QUERY_SIZE     19
#define COMMAND_QUERY_STREAMTYPE 20
#define COMMAND_QUERY_TIMESTAMP  21
#define COMMAND_QUERY_POSITION    23
#define COMMAND_QUERY       24
#define COMMAND_QUERY_POSITION_READ       25
#define COMMAND_QUERY_POSITION_WRITE      26
#define COMMAND_QUERY_POSITION_CHAR       27
#define COMMAND_QUERY_POSITION_LINE       28
#define COMMAND_QUERY_POSITION_SYS        29
#define COMMAND_OPEN                      30
#define COMMAND_OPEN_READ                 31
#define COMMAND_OPEN_WRITE                32
#define COMMAND_OPEN_BOTH                 33
#define COMMAND_OPEN_BOTH_APPEND          34
#define COMMAND_OPEN_BOTH_REPLACE         35
#define COMMAND_OPEN_WRITE_APPEND         36
#define COMMAND_OPEN_WRITE_REPLACE        37
#define COMMAND_POSITION                  38

/* 
 * Define TRUE_TRL_IO, if you want the I/O system to be even more like
 * TRL. It will try to mimic the behaviour in TRL exactly. Note that if
 * you _do_ define this, you might experience a degrade in runtime 
 * performance.
 */ 
#define TRUE_TRL_IO

/*
 * There are two ways to report an error for file I/O operations. Either
 * as an "error" or as a "warning". Both will raise the NOTREADY 
 * condition, but only ERROR will actually put the file into ERROR mode. 
 * Warnings are used for e.g. EOF while reading. Both are implemented 
 * by the same routine.
 */
#define file_error(a,b,c)   handle_file_error(a,b,c,1)
#define file_warning(a,b,c) handle_file_error(a,b,c,0)

/*
 * Which character is used to delimit lines in text files? Actually, 
 * this should have been a bit more general, since the use of LF as
 * EOL-marker is a bit Unix-ish. We have to change this before porting
 * to other platforms.
 */
#define EOL (0x0a)
#define CR (0x0d)

/* 
 * Regina truncates a file when repositioning by the use of a line
 * count. That is, if the file has ten lines, and you use the BIF 
 * lineout(file,,4), it will be truncated after the fourth line. 
 * Truncating is not performed for character repositioning. 
 *
 * If you don't want truncating after line repositioning, undefine 
 * the macro HAVE_FTRUNCATE in config.h. Also, if your system doesn't
 * have ftruncate(), undefine HAVE_FTRUNCATE, and survive without the
 * truncating. 
 *
 * The function ftruncate() is a BSDism; if you have trouble finding 
 * it, try linking with -lbsd or -lucb or something like that. Since 
 * it is not a standard POSIX feature, some machines may generate 
 * warnings during compilation. Let's help these machines ...
 */
#if defined(FIX_PROTOS) && defined(HAVE_FTRUNCATE)
# if defined(ultrix)
   int ftruncate( int fd, int length ) ;
# endif
#endif

/*
 * Since development of Ultrix has ceased, and they never managed to 
 * fix a few things, we want to define a few things, just in order 
 * to kill a few warnings ...
 */
#if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
   int fstat( int fd, struct stat *buf ) ;
   int stat( char *path, struct stat *buf ) ;
#endif


/* 
 * Here comes another 'sunshine-story' ...  Since SunOS don't have 
 * a decent set of include-files in the standard version of the OS, 
 * their <stdio.h> don't define these macros. Instead, Sun seems to
 * survive with the old custom of using the numberic values of these
 * macros directly. If compiled with "SunKlugdes" defined, try to 
 * fix this.
 *
 * If you are using gcc on a Sun, you may want to run the program 
 * fixincludes that comes with gcc. It will fix this more permanently.
 * At least one recent version of GCC for VMS doesn't have this 

 */
#if defined(SunKludges) || (defined(__GNUC__) && defined(VMS))
# define SEEK_SET  0
# define SEEK_CUR  1
# define SEEK_END  2
#endif

/*
 * Some machines don't defined these ... they should!
 */
#if defined(VMS) || defined(_MSC_VER)
# define F_OK 0
# define X_OK 1
# define W_OK 2
# define R_OK 4
#endif 

/*
 * Here is the datastructure in which to store the information about 
 * open files. The storage format of the file table is discussed 
 * elsewhere. The fields used to handle storing are 'next' and 'prev'
 * which is used to implement a double linked list of files having 
 * the same hashfunc; and 'newer' and 'older' which are used to maintain
 * a large double linked list of all files in order of the most 
 * recently used file. 
 *
 * The other fields are:
 *
 *  fileptr    - Pointer to the filehandle use by the system when 
 *               accessing the file through the normal I/O calls.
 *               If this pointer is NULL, it means that the file is
 *               not currently open. 
 *  oper       - Holds the value that tells whether the most recent 
 *               operation on this file was a read or a write. This has
 *               importance for flushing, since a read can't imediately
 *               follow a write (or vice versa) without a flush (or
 *               a repositioning) inbetween. Takes the values OPER_READ,
 *               OPER_WRITE or OPER_NONE (signalizes that most recent 
 *               operation can be followed by either read or write). 
 *  flag       - Bitfield that holds information about the file. The 
 *               significance of the various fields are described by 
 *               the FLAG_* macros. 
 *  error      - Most recently 'errno' code for this file. It could have
 *               been stored into 'errmsg' instead, but that would require
 *               copying of data which might not be used. If undefined, 
 *               it will have the value 0.
 *  readpos    - The current read position in the file, as a character
 *               position. Note that this is in 'C-syntax', i.e. the
 *               first character in the file is numbered "0". A value of 
 *               -1 means that the value is unknown or undefined. 
 *  readline   - The line number of the current read position, which must
 *               be positive if define. A value of zero means that the
 *               line number is undefined or unknown. If current read 
 *               position is at an EOL, 'readline' refers to the line
 *               preceding the EOL.
 *  writepos   - Similar to 'readpos' but for current write position.
 *  writeline  - Similar to 'readline' but for current write position. 
 *  filename   - Pointer to string containing the filename assiciated 
 *               with this file. This string is garanteed to have an 
 *               ASCII NUL following the last character, so it can be 
 *               used directly in file operations. This field *must* 
 *               be defined. 
 *  errmsg     - Error message associated with the file. Some errors are
 *               not trapped during call to system routines, and these 
 *               does not have an error message defined by the opsys. 
 *               E.g. when positioning current read position after EOF.
 *               This field stores errormessages for these situations. 
 *               If undefined, it will be a NULL pointer.
 *
 * Both errmsg and error can not be defined simultaneously. 
 */
typedef struct fileboxtype *fileboxptr ;
typedef struct fileboxtype {
   FILE *fileptr ;
   unsigned char oper ;
   size_t readpos, writepos, thispos ;
   int flag, error, readline, writeline, linesleft ;
   fileboxptr prev, next, newer, older ;
   streng *filename ;
   streng *errmsg ;
} filebox ;

/* 
 * The following two pointers are pointers into the doble linked list
 * of all files in the file table. They points to the most recently 
 * used file, and the least recently used open file. Note that the latter 
 * of these are _not_ the same as the last file in the list. If the 
 * Rexx' file table contains more files than the system's file table
 * can contain, 'lrufile' will point to the last open file in the double 
 * linked list. Files further out in the list are 'swapped' out.
 */
static fileboxptr mrufile=NULL ;
static fileboxptr swappoint=NULL ;

static void handle_file_error(fileboxptr, int, char*, int ) ;
void closefile( streng *name )  ;

/*
 * Marks all entries in the filetable. Used only by the memory
 * management. Does not really change anything, so you can in general
 * forget this one. This routine is called from memory.c in order to 
 * mark all statically defined data in this file. 
 */
#ifdef TRACEMEM

void *rdarea=NULL ;

void mark_filetable( void ) 
{
   fileboxptr ptr=NULL ;

   for (ptr=mrufile; ptr; ptr=ptr->older)
   {
      markmemory( ptr, TRC_FILEPTR ) ;
      markmemory( ptr->filename, TRC_FILEPTR ) ;
      if (ptr->errmsg)
         markmemory( ptr->errmsg, TRC_FILEPTR ) ;
   }

   if (rdarea)
      markmemory( rdarea, TRC_FILEPTR ) ;

}
#endif /* TRACEMEM */



/*
 * This command maps the string 'cmd' into a number which is to be 
 * interpreted according to the settings of the COMMAND_ macros. 
 * The input strings must be one of the valid command, or else the 
 * COMMAND_NONE value is returned. 
 *
 * Well, this routine should really have been implemented differently, 
 * since sequential searching through a list of strings is not very 
 * efficient. But still, it is not so many entries in the list, and 
 * this function is not going to be called often, so I suppose it 
 * doesn't matter too much. Ideallistic, it should be rewritten to 
 * a binary search.
 */

char get_command( streng *cmd ) 
{
   char *cptr=NULL ;

   for (cptr=cmd->value; cptr<cmd->value+cmd->len; cptr++)
      if (islower(*cptr))
         *cptr = toupper(*cptr) ;

   if (cmd->len==4 && !memcmp(cmd->value, "READ", 4))
      return COMMAND_READ ;
   if (cmd->len==5 && !memcmp(cmd->value, "WRITE", 5))
      return COMMAND_WRITE ;
   if (cmd->len==6 && !memcmp(cmd->value, "APPEND", 6))
      return COMMAND_APPEND ;
   if (cmd->len==6 && !memcmp(cmd->value, "UPDATE", 6))
      return COMMAND_UPDATE ;
   if (cmd->len==6 && !memcmp(cmd->value, "CREATE", 6))
      return COMMAND_CREATE ;
   if (cmd->len==5 && !memcmp(cmd->value, "CLOSE", 5))
      return COMMAND_CLOSE ;
   if (cmd->len==5 && !memcmp(cmd->value, "FLUSH", 5))
      return COMMAND_FLUSH ;
   if (cmd->len==6 && !memcmp(cmd->value, "STATUS", 6))
      return COMMAND_STATUS ;
   if (cmd->len==5 && !memcmp(cmd->value, "FSTAT", 5))
      return COMMAND_FSTAT ;
   if (cmd->len==5 && !memcmp(cmd->value, "RESET", 5))
      return COMMAND_RESET ;
   if (cmd->len==8 && !memcmp(cmd->value, "READABLE", 8))
      return COMMAND_READABLE ;
   if (cmd->len==8 && !memcmp(cmd->value, "WRITABLE", 8))
      return COMMAND_WRITEABLE ;
   if (cmd->len==10 && !memcmp(cmd->value, "EXECUTABLE", 10))
      return COMMAND_EXECUTABLE ;
   if (cmd->len==4 && !memcmp(cmd->value,  "LIST", 4))
      return COMMAND_LIST ;
   if (cmd->len>=4 && !memcmp(cmd->value,  "OPEN", 4))
      return COMMAND_OPEN ;
   if (cmd->len>=5 && !memcmp(cmd->value,  "QUERY", 5))
      return COMMAND_QUERY ;
   else
      return COMMAND_NONE ;
}

char get_querycommand( streng *cmd )
{
   if (cmd->len==8 && !memcmp(cmd->value,  "DATETIME", 8))
      return COMMAND_QUERY_DATETIME ;
   if (cmd->len==6 && !memcmp(cmd->value,  "EXISTS", 6))
      return COMMAND_QUERY_EXISTS ;
   if (cmd->len==6 && !memcmp(cmd->value,  "HANDLE", 6))
      return COMMAND_QUERY_HANDLE ;
   if (cmd->len>=4 && !memcmp(cmd->value,  "SEEK", 4))
      return COMMAND_QUERY_SEEK ;
   if (cmd->len>=8 && !memcmp(cmd->value,  "POSITION", 8))
      return COMMAND_QUERY_POSITION ;
   if (cmd->len==4  && !memcmp(cmd->value, "SIZE", 4))
      return COMMAND_QUERY_SIZE ;
   if (cmd->len==10 && !memcmp(cmd->value, "STREAMTYPE", 10))
      return COMMAND_QUERY_STREAMTYPE ;
   if (cmd->len==9  && !memcmp(cmd->value, "TIMESTAMP", 9))
      return COMMAND_QUERY_TIMESTAMP ;
   else
      return COMMAND_NONE ;
}

char get_querypositioncommand( streng *cmd )
{
   if (cmd->len==4 && !memcmp(cmd->value,  "READ", 4))
      return COMMAND_QUERY_POSITION_READ ;
   if (cmd->len==5 && !memcmp(cmd->value,  "WRITE", 5))
      return COMMAND_QUERY_POSITION_WRITE ;
   if (cmd->len==4 && !memcmp(cmd->value,  "CHAR", 4))
      return COMMAND_QUERY_POSITION_CHAR ;
   if (cmd->len==4 && !memcmp(cmd->value,  "LINE", 4))
      return COMMAND_QUERY_POSITION_LINE ;
   if (cmd->len==3 && !memcmp(cmd->value,  "SYS", 3))
      return COMMAND_QUERY_POSITION_SYS ;
   else
      return COMMAND_NONE ;
}

char get_opencommand( streng *cmd )
{
   if (cmd->len>=4 && !memcmp(cmd->value,  "BOTH", 4))
      return COMMAND_OPEN_BOTH ;
   if (cmd->len==4 && !memcmp(cmd->value,  "READ", 4))
      return COMMAND_OPEN_READ ;
   if (cmd->len>=5 && !memcmp(cmd->value,  "WRITE", 5))
      return COMMAND_OPEN_WRITE ;
   else
      return COMMAND_OPEN_BOTH ;
}

char get_opencommandboth( streng *cmd )
{
   if (cmd->len==6 && !memcmp(cmd->value,  "APPEND", 6))
      return COMMAND_OPEN_BOTH_APPEND ;
   if (cmd->len==7 && !memcmp(cmd->value,  "REPLACE", 7))
      return COMMAND_OPEN_BOTH_REPLACE ;
   if (cmd->len==0)
      return COMMAND_OPEN_BOTH ;
   else
      return COMMAND_NONE ;
}

char get_opencommandwrite( streng *cmd )
{
   if (cmd->len==6 && !memcmp(cmd->value,  "APPEND", 6))
      return COMMAND_OPEN_WRITE_APPEND ;
   if (cmd->len==7 && !memcmp(cmd->value,  "REPLACE", 7))
      return COMMAND_OPEN_WRITE_REPLACE ;
   if (cmd->len==0)
      return COMMAND_OPEN_WRITE ;
   else
      return COMMAND_NONE ;
}


/* ==================================================================== */
/*                       level 3 routines                               */

/* 
 * Returns the fileboxptr of a file, if is has already been opened. 
 * If it does not exist in Rexx's file table, a NULL pointer is 
 * returned in stead. It is easy to change the datastruction in 
 * which the file table is stored. 
 *
 * If using VMS, or another opsys that has a caseinsensitive file 
 * system, maybe it should disregard the case of the filename. In 
 * general, maybe it should 'normalize' the file name before storing
 * it in the file table (do we sence an upcoming namei() :-)
 */

static fileboxptr filehash[128] = { NULL } ;

int filehashvalue( streng *name )
{
   char *cptr=NULL, *endp=NULL ;
   int value=0 ;

   assert( name ) ;
   cptr = name->value ;
   endp = cptr + name->len ;

   for (; cptr<endp; value += *(cptr++)) ;
   return (value%128) ;
}


void removefileptr( fileboxptr ptr ) 
{
   if (swappoint == ptr)
     swappoint = ptr->newer ;

   if (mrufile==ptr)
      mrufile = ptr->older ;
   
   if (ptr->older)
      ptr->older->newer = ptr->newer ;
   
   if (ptr->newer)
      ptr->newer->older = ptr->older ;

   if (ptr->next)
      ptr->next->prev = ptr->prev ;
  
   if (ptr->prev)
      ptr->prev->next = ptr->next ;
   else
      filehash[filehashvalue(ptr->filename)] = ptr->next ;
}


void enterfileptr( fileboxptr ptr ) 
{
   int hashval=0 ;
   
   /*
    * First, get the magic number for this file. Note that when we're 
    * doing hashing like this, we *may* get trouble on machines that 
    * don't differ between upper and lower case letters in filenames. 
    */
   hashval = filehashvalue(ptr->filename) ;

   /* 
    * Then, link it into the list of values having the same hashvalue
    */
   ptr->next = filehash[hashval] ;
   if (ptr->next)
      ptr->next->prev = ptr ;
   filehash[hashval] = ptr ;
   ptr->prev = NULL ;

   /* 
    * Then, link it into the 'global' list of files, sorted by how 
    * recently they have been used.
    */
   ptr->older = mrufile ;
   if (ptr->older)
      ptr->older->newer = ptr ;
   ptr->newer = NULL ;
   mrufile = ptr ;

   if (!swappoint)
      swappoint = ptr ;
}


void swapout_file( void ) 
{
   /*
    * Too many open files simultaneously, we have to close one down
    * in order to free one file descriptor, but only if there actually
    * are some files that can be closed down. 
    */
nextfile:
   if (swappoint==NULL)
   {
      swappoint = mrufile ;
      for (; swappoint && swappoint->older; swappoint=swappoint->older) ;
   }

   if (swappoint==NULL)
       exiterror( ERR_SYSTEM_FAILURE, 0 )  ;

   if ((swappoint->flag & FLAG_SURVIVOR) || 
       (swappoint->flag & FLAG_SWAPPED) ||
       (swappoint->fileptr==NULL ))
   {
      swappoint = swappoint->newer ;
      goto nextfile ;
   }
      
   errno = 0 ;
   if (fclose( swappoint->fileptr )==EOF)
       exiterror( ERR_SYSTEM_FAILURE, 0 )  ;

   swappoint->fileptr = NULL ;
   swappoint->flag |= FLAG_SWAPPED ;
   swappoint->thispos = EOF ;
   swappoint = swappoint->newer ;
}

static char *acc_mode[] = { "rb", "r+b", "ab" } ;

#define ACCMODE_READ  0
#define ACCMODE_RDWRT 1
#define ACCMODE_WRITE 2
#define ACCMODE_NONE  3

void swapin_file( fileboxptr ptr )
{
   int faccess=0, itmp=0 ;

   /*
    * First, just try to reopen the file, we _might_ have a vacant 
    * entry in the system file table, so, use that. 
    */
   itmp = (ptr->flag & (FLAG_READ | FLAG_WRITE)) ;
   if (itmp==(FLAG_READ | FLAG_WRITE))
      faccess = ACCMODE_RDWRT ;
   else if (itmp==(FLAG_READ))
      faccess = ACCMODE_READ ;
   else if (itmp==(FLAG_WRITE))
      faccess = ACCMODE_WRITE ;
   else
     faccess = ACCMODE_NONE ;

   if (faccess == ACCMODE_NONE) 
      exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;
   
tryagain:
#ifdef SGIkludges
   errno = EMFILE ;
#else
   errno = 0 ;
#endif
   ptr->fileptr = fopen( ptr->filename->value, acc_mode[faccess] ) ;
   if ((!ptr->fileptr) && (errno == EMFILE))
   {
      swapout_file() ;
      goto tryagain ;
   }

   ptr->flag &= ~(FLAG_SWAPPED) ;
   if (ptr->fileptr==NULL)
      file_error( ptr, errno, NULL ) ;
   else   
      fseek( ptr->fileptr, 0, SEEK_SET ) ;

   ptr->thispos = 0 ;
   ptr->readline = ptr->writeline = 0 ;
   ptr->linesleft = 0 ;
}




fileboxptr getfileptr( streng *name )
{
   fileboxptr ptr=0 ;

   /* 
    * First, try to find the correct file in this sloth of the 
    * hash table. If one is found, ptr points to it, else, ptr is set
    * to NULL
    */
   for (ptr=filehash[filehashvalue(name)];ptr;ptr=ptr->next)
      if (!Str_cmp(name,ptr->filename))
         break ;

   /*
    * In order not to create any problems later, just return with NULL
    * (signifying that no file was found) if that is the case. Then we may
    * able to assume that ptr _is_ set later.
    */
   if (!ptr)
      return NULL ;

   /*
    * Now, put the file in front of the list of files storted by how 
    * recently they were used. We assume that any access to a file is 
    * equivalent to the file being used. 
    */
   if (ptr->newer)
   {
      if (swappoint==ptr)
         swappoint = ptr->newer ;
      ptr->newer->older = ptr->older ;
      if (ptr->older) 
         ptr->older->newer = ptr->newer ;
      ptr->older = mrufile ;
      ptr->newer = NULL ;
      mrufile->newer = ptr ;
      mrufile = ptr ;
   }
 
   /*
    * If this file has been swapped out, we have to reopen it, so we can 
    * continue to access it. First we verify that swappoint is set; if it 
    * isn't that means that 
    */
   if (ptr->flag & FLAG_SWAPPED)
      swapin_file( ptr ) ;

   return ptr ;
}


void flush_input( fileboxptr ptr )
{
   return ;
}


/*
 * This closes the file ... actually, I'm not sure whether that is the 
 * correct thing to do, but lots of other rexx interpreters seem to do
 * exactly that. Maybe a feature for the 'traditional' mode?
 */
void flush_output( streng *ptr )
{
   closefile( ptr ) ;
   return ;
}



/*
 * Sets up the internal filetable for REXX, and initializes it with
 * the three standard files under Unix, stderr, stdout og and stdin.
 * Should only be called once, from the main routine. We should also 
 * add code to register the routine for marking memory from this 
 * routine. 
 * 
 * As a shortcut to access these three default files, there is a 
 * variable 'stdio_ptr' which contains pointers to them. This allows
 * for quick access to the default streams. 
 */

static fileboxptr stdio_ptr[3] ;

void initfiletable( void ) 
{
   int i=0 ;

   for (i=0; i<3; i++)
   {
      stdio_ptr[i] = Malloc( sizeof( filebox )) ;
      stdio_ptr[i]->errmsg = NULL ;
      stdio_ptr[i]->error = 0 ;
   }
 
   stdio_ptr[0]->fileptr = stdin ;
   stdio_ptr[1]->fileptr = stdout ;
   stdio_ptr[2]->fileptr = stderr ;

   stdio_ptr[0]->flag = ( FLAG_SURVIVOR + FLAG_READ ) ;
   stdio_ptr[1]->flag = ( FLAG_SURVIVOR + FLAG_WRITE ) ;
   stdio_ptr[2]->flag = ( FLAG_SURVIVOR + FLAG_WRITE ) ;

   stdio_ptr[0]->filename = Str_cre( "<stdin>" ) ;
   stdio_ptr[1]->filename = Str_cre( "<stdout>" ) ;
   stdio_ptr[2]->filename = Str_cre( "<stderr>" ) ;     

   enterfileptr( stdio_ptr[0] ) ;
   enterfileptr( stdio_ptr[1] ) ;
   enterfileptr( stdio_ptr[2] ) ;
}





/* 
 * Sets the proper error conditions for the file, including providing a
 * a hook into the CALL/SIGNAL ON system. Now, we also like to set some
 * other information, like the status of the file (taken from rc).
 *
 * First parameter is the file to operate on, the second and third 
 * parameters are the error message to set (they can't both be defined), 
 * and the last parameter is the level of 'severity'. If set, the file
 * is thrown into error state.
 */
static void handle_file_error(fileboxptr ptr, int rc, char *errmsg, int level) 
{
   trap *traps=NULL ;
   extern proclevel currlevel ;

   assert( !(rc && errmsg) ) ;

   if ((ptr->flag & FLAG_ERROR) && (ptr->flag & FLAG_FAKE))
   {
      /* 
       * If we are faking for this file already, don't bother to do anything 
       * more. In particular, we do not want to set a new error, since that
       * will in general only overwrite the old (and probably more relevant)
       * error message. However, faking are _only_ done when NOTREADY is 
       * being trapped. 
       */
      return ;
   }
   else
   {
      /*
       * If the file is not already in error, set the ERROR flag, and record
       * the error message. Also, clear the FAKE flag. This flag is only 
       * defined when the ERROR flag is set, and we don't want any old 
       * values laying around (it will be set later if needed).
       */
      if (level)
      {
         ptr->flag &= ~FLAG_FAKE ;
         ptr->flag |= FLAG_ERROR ;
      }

      /*
       * Set the error message, but only if one was given. This routine
       * can be called _without_ any errormessage, and if so, keep the 
       * old one (if any)
       */
      if (rc || errmsg)
      {
         if (ptr->errmsg)
           Free_string( ptr->errmsg ) ;
         
         ptr->error = rc ; 
         if (errmsg)
            ptr->errmsg = Str_cre( errmsg ) ;
         else
            ptr->errmsg = NULL ;
      }

      /* 
       * OK, the file has been put into ERROR state, now we must check 
       * to see if we should raise the NOTREADY condition. If NOTREADY
       * is not currently enabled, don't bother to try to raise it.
       */
      traps = gettraps( currlevel ) ;
      if (traps[SIGNAL_NOTREADY].on_off) 
      {
         /* 
          * The NOTREADY condition is being trapped; set the FAKE flag
          * so that we don't create more errors for this file. But _only_
          * set the FAKE flag if NOTREADY is trapped by method CALL.
          * Then raise the condition ...
          */
         if (!traps[SIGNAL_NOTREADY].invoked)
            ptr->flag |= FLAG_FAKE ;

         condition_hook(SIGNAL_NOTREADY,rc+100,-1,Str_dup(ptr->filename));
      }
   }
}



/* 
 * This routine is supposed to be called when the condition is triggered
 * by method CALL. From the time the condition is raised until the CALL is
 * is triggered, I/O to the file is faked. But before the condition handler
 * is called, we try to tidy things up a bit. 
 *
 * At least, we have to clear the FAKE flag. Other 'nice' things to do
 * is to clear error indicator in the file pointer, and to reset the 
 * file in general. The ERROR state is not cleared, _unless_ the file
 * is one of the default streams. 
 */

void fixup_file( streng *filename )
{
   fileboxptr ptr=NULL ;

   ptr = getfileptr( filename ) ;
   if (ptr)
   {       
      /* 
       * If the file is open, try to clear it, first clear the error 
       * indicator, and then try to fseek() to a 'safe' point. If the 
       * seeking didn't work out, don't bother, it was worth a try.
       */
      if (ptr->fileptr)
      {
         clearerr( ptr->fileptr ) ;
         fseek( ptr->fileptr, 0, SEEK_SET ) ;
         ptr->thispos = 0 ;
      }

      ptr->oper = OPER_NONE ;

      if (ptr->flag & FLAG_SURVIVOR)
         ptr->flag &= ~(FLAG_ERROR) ;

      ptr->flag &= ~(FLAG_FAKE) ;
   }
}




/*
 * This is stupid ... if the file exists, but is in error mode, we
 * shall not close it, but leave it open, so that the rest of the
 * operations on this file in this statement don't trip. Same happens 
 * if we are not able to close it properly. Oh well ... 
 * 
 * On second thoughts ... Faking only applies for input and output.
 * So closing doesn't have to be faked. Remove the file, whatever
 * happens.
 */
void closefile( streng *name ) 
{
   fileboxptr ptr=NULL ;

   /* If it isn't open, don't try to close it ... */
   ptr = getfileptr( name ) ;
   if (ptr)
   {
      /* 
       * If this is one of the default streams, don't let it be closed. 
       * These file shall stay open, whatever happens. 
       */
      if (ptr->flag & FLAG_SURVIVOR)
         return ;

      /* 
       * If the fileptr seems to point to something ... close it. We 
       * really don't want to leak file table sloths. Actually, we should 
       * check that the close was ok, and not let the fileptr go unless 
       * we know that it was really closed (and released for new use).
       * Previously, it only closed when file was not in error. I don't 
       * know what is the correct action, but this seems to be the most
       * sensible ...
       */
      if (ptr->fileptr)
         fclose( ptr->fileptr ) ;
     
      removefileptr( ptr ) ;

      if (ptr->errmsg)
         Free_string( ptr->errmsg ) ;

      Free_string( ptr->filename ) ;
      Free( ptr ) ; 
   }
}
 



/* 
 * This function is called when we need some kind of access to a file
 * but don't (yet) have it. It will only be called when we want to 
 * open a file implicitly, e.g. it is open for reading, and it has then
 * been named in a output function. 
 *
 * This is rather primitive ... but this function can only be called
 * when the file is open for read, and we want to open it for write; 
 * or if the file i open for write, and we want to open it for read. 
 * So I think this will suffice. It ignores the 'access' parameter
 * And just assumes that the file must be opened in both read and 
 * write. 
 *
 * To improve on this function, we ought to do a lot more checking, 
 * e.g. that the 'access' wanted are required, and that the file is 
 * already open in some kind of mode. If this don't hold, we probably
 * have an error condition. 
 *
 * We should also check another thing, that the new file which is opened
 * is in fact the same file that we closed. Perferably, we should open
 * the new file, then check the device and inode of both the old and 
 * new file to see whether they are the same (using stat()). If they 
 * are not the same, the reopening should fail. As it is implemented 
 * now, the Unix method for temporary files (open it, remove it, 
 * use it, and then close it) will fail; and we loose access to the 
 * original file too.
 */
void reopen_file( fileboxptr ptr, int faccess ) 
{
   if (!ptr)
       exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

   /*
    * We can not reopen the default streams, that makes no sence. If 
    * tried, report an error. 
    */
   if (ptr->flag & FLAG_SURVIVOR)
   {
      file_error( ptr, 0, "Invalid operation on default stream" ) ;
      return ;
   }

   /* 
    * Close the old file, and try to reopen the new file. There is the
    * same problem here as in closefile(); if closing didn't work (for
    * some mysterious reason), the system's file table should become 
    * full. Better checking might be required.
    */
   errno = 0 ;
   fclose( ptr->fileptr ) ;
   ptr->fileptr = fopen( ptr->filename->value, "r+b" ) ;
   if (ptr->fileptr==NULL)
   {
      file_error( ptr, errno, NULL ) ;
      return ;
   }

   /*
    * We definitively want to set the close-on-exec flag. Suppose 
    * an output file has not been flushed, and we execute a command. 
    * This might perform an exec() and then a system(), which _will_ 
    * flush all files (close them). The result is that the file might
    * be flushed twice ... not good.
    *
    * This don't work on VMS ... but the file system on VMS is so 
    * different anyway, so it will probably not create any problems.
    * Besides, we don't do exec() and system() on VMS. 
    */
#if !defined(VMS) && !defined(OS2) && !defined(DOS) && !defined(__WATCOMC__) && !defined(_MSC_VER) /* MH 10-06-96 */
   if (ptr && ptr->fileptr)
   {
      int flags, fno ;
      fno = fileno( ptr->fileptr ) ;
      assert( fno >= -1) ;
      flags = fcntl( fno, F_GETFD ) ;
      flags |= FD_CLOEXEC ;
      if (fcntl( fno, F_SETFD, flags)== -1) 
          exiterror( ERR_SYSTEM_FAILURE, 0 )  ;
   }
#endif

   /* 
    * If readposition is EOF (=illegal), then we "probably" needed to 
    * open it in read mode. Set the current read position to the start
    * of the file. 
    */
   if (ptr->readpos==EOF)
   {
      ptr->readline = 1 ;
      ptr->linesleft = 0 ;
      ptr->readpos = 0 ;
      ptr->thispos = 0 ;
      fseek( ptr->fileptr, 0, SEEK_SET ) ;
   }

   /*
    * Then do the same thing for write access. We always set this to the 
    * end-of-file -- the default -- even though there are other write 
    * modes available. If the file is implicitly open in write mode, 
    * then the current write position should be set to the default 
    * value.
    */
   if (ptr->writepos==EOF)
   {
      ptr->writeline = 0 ;
      fseek( ptr->fileptr, 0, SEEK_END ) ;
      ptr->writepos = ftell( ptr->fileptr ) ;
      ptr->thispos = ptr->writepos ;
   }

   /* 
    * Then, at last, do some simple bookkeeping, set both read and 
    * write access, and clear any previous problem.
    */
   ptr->flag = FLAG_READ | FLAG_WRITE | FLAG_PERSIST ;
   ptr->error = 0 ;
   if (ptr->errmsg)
      Free_string(ptr->errmsg) ;

   ptr->errmsg = NULL ;
}



/* 
 * This function explicitly opens a file. It will be called if the user 
 * has called the built-in function STREAM() in order to open a file
 * in a particular mode. It will also be called if the file is not 
 * previously open, and is used in a read or write operation. 
 *
 * It takes two parameters, the name of the file to open, and the 
 * mode in which it is to be opened. The mode has a value which is 
 * matched by the ACCESS_ macros defined earlier. 
 * 
 * If the file is actually open in advance, then we close it before we
 * do any other operations. If the user is interested in the file in 
 * one particular mode, he is probably not interested in any previous
 * modes. 
 */
fileboxptr openfile( streng *name, int faccess )
{
   fileboxptr ptr=NULL ;
   struct stat statbuf ;
   int rc=0 ;
   long lpos=0L ;

   /*
    * First check wether this file is already open, and use that open
    * file if possible. However, that may not be possible, since we
    * may want to use the file for another operation now. So, if the 
    * file _is_ open, check to see if access is right.
    */
   ptr = getfileptr( name ) ;
   if (ptr)
   {
      if (ptr->flag & FLAG_SURVIVOR) 
      {
         file_error( ptr, 0, "Can't open a default stream" ) ;
         return ptr ;
      }
      closefile( name ) ;
   }
   
   /* 
    * Now, get a new file table entry, and fill in the various 
    * field with appropriate (i.e. default) values. 
    */
   ptr = Malloc( sizeof(filebox) ) ;
   ptr->filename = Str_ify( Str_dup( name )) ;
   ptr->flag = 0 ;
   ptr->error = 0 ;
   ptr->errmsg = NULL ;
   ptr->readline = 0 ; 
   ptr->linesleft = 0 ;
   ptr->writeline = 0 ;
   ptr->thispos = EOF ;
   ptr->readpos = EOF ;
   ptr->writepos = EOF ;

   /*
    * suppose we tried to open, but didn't manage, well, stuff it into
    * the file table, we might want to retrieve information about it
    * later on. _And_ we need to know about the problem if the file
    * I/O is to be faked later on. 
    */
   enterfileptr( ptr ) ;
   name = ptr->filename ; 
   goto try_to_open ;

kill_one_file:
   swapout_file() ;

try_to_open:
   /* 
    * In most of these, we have to check that the file opened is really
    * a persistent file. We should not take that for granted.
    */
   errno = 0 ;
   if (faccess==ACCESS_READ)
   {
      if ((ptr->fileptr = fopen( name->value, "rb" )))
      {
         ptr->flag = FLAG_READ | FLAG_PERSIST ;
         ptr->readline = 1 ;
         ptr->linesleft = 0 ;
         ptr->thispos = ptr->readpos = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_WRITE)
   {
      /*
       * This is really a problem. If opened in mode "w", it will 
       * truncate the file if it did exist. If opened int mode "r+", 
       * it will fail if the file did not exist. So we try to 
       * combine the two.
       */
      ptr->flag = FLAG_READ ;
      ptr->fileptr = fopen( name->value, "r+b" ) ;
      errno = 0 ;
      if (!ptr->fileptr)
         ptr->fileptr = fopen( name->value, "w+b" ) ;

      errno = 0 ;
      if (!ptr->fileptr)
      {
#ifdef SGIkludges
         errno = EMFILE ;
#else
         errno = 0 ;
#endif
         ptr->fileptr = fopen( name->value, "wb" ) ;
         ptr->flag &= 0 ;
      } 

      /*
       * Then set the current read and write positions to the start and   
       * the end of the file, respectively.
       */
      if (ptr->fileptr)
      {
         ptr->flag |= FLAG_WRITE | FLAG_PERSIST ;
         fseek( ptr->fileptr, 0, SEEK_END ) ;
         lpos = ftell( ptr->fileptr ) ;
         ptr->thispos = ptr->writepos = lpos ;
         ptr->writeline = 0 ;
         ptr->readpos = 0 ;
         ptr->readline = 1 ;
         ptr->linesleft = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_APPEND)
   {
      /* 
       * In append mode, the file is opened as a transient file, all
       * writing must be done at the end of the file. It is not 
       * possible to perform reading on the file. Useful for files
       * to which you have write, but not read access (e.g. logfiles).
       */
      if ((ptr->fileptr = fopen( name->value, "ab" )))
      {
         ptr->flag = FLAG_WRITE | FLAG_WREOF ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_STREAM_APPEND)
   {
      /* 
       * In "stream" append mode, the file is opened as a persistent file, all
       * writing must be done at the end of the file. It is not 
       * possible to perform reading on the file. Useful for files
       * to which you have write, but not read access (e.g. logfiles).
       */
      if ((ptr->fileptr = fopen( name->value, "ab" )))
      {
         ptr->flag = FLAG_WRITE | FLAG_WREOF | FLAG_PERSIST;
         fseek( ptr->fileptr, 0, SEEK_END ) ;
         lpos = ftell( ptr->fileptr ) ;
         ptr->thispos = ptr->writepos = lpos ;
         ptr->writeline = 0 ;
         ptr->readpos = 0 ;
         ptr->readline = 1 ;
         ptr->linesleft = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_STREAM_REPLACE)
   {
      /* 
       * The file is created if it didn't exist, and if it did exist
       * it is truncated and the file pointers set to the start of file.
       */
      if ((ptr->fileptr = fopen( name->value, "w+b" )))
      {
         ptr->flag = FLAG_WRITE | FLAG_READ | FLAG_WREOF | FLAG_RDEOF |
                        FLAG_PERSIST ;
         ptr->writeline = ptr->readline = 1 ;
         ptr->linesleft = 0 ;
         ptr->readpos = ptr->writepos = ptr->thispos = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_UPDATE)
   {
      /*  
       * Like read access, but it will not create the file if it didn't 
       * already exist. Instead, an error is reported.
       */
      if ((ptr->fileptr = fopen( name->value, "r+b" )))
      {
         ptr->flag = FLAG_WRITE | FLAG_READ | FLAG_PERSIST ;
         ptr->readline = 0 ;
         ptr->linesleft = 0 ;
         ptr->writeline = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else if (faccess==ACCESS_CREATE)
   {
      /* 
       * The file is created if it didn't exist, and if it did exist
       * it is truncated. 
       */
      if ((ptr->fileptr = fopen( name->value, "w+b" )))
      {
         ptr->flag = FLAG_WRITE | FLAG_READ | FLAG_WREOF | FLAG_RDEOF |
                        FLAG_PERSIST ;
         ptr->writeline = ptr->readline = 1 ;
         ptr->linesleft = 0 ;
         ptr->readpos = ptr->writepos = ptr->thispos = 0 ;
      }
      else if (errno==EMFILE)
         goto kill_one_file ;
      else 
         file_error( ptr, errno, NULL ) ;
   }
   else
       exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

#if !defined(VMS) && !defined(OS2) && !defined(DOS) && !defined(__WATCOMC__) && !defined(_MSC_VER) /* MH 10-06-96 */
   /* 
    * Then we check to see if this is a transient or persistent file. 
    * We can remove a 'persistent' setting, but add one, since we 
    * sometimes want to access a persistent file as transient (append). 
    */
   if (ptr->fileptr)
   {
      int fno ;
      errno = 0 ;
      fno = fileno(ptr->fileptr) ;
      rc = fstat( fno, &statbuf ) ;
      if (rc==0 && !S_ISREG(statbuf.st_mode))
         ptr->flag &= ~(FLAG_PERSIST) ;
      else if (rc!=0)
         file_error( ptr, errno, NULL ) ;
   }

   /* 
    * As with reopen_file(), we want to set the close-on-exec flag, 
    * se reopen_file for more information.
    */
   if (ptr->fileptr)
   {
      int flags, fno ;
      fno = fileno(ptr->fileptr) ;
      assert( fno >= -1) ;
      flags = fcntl( fno, F_GETFD ) ;
      flags |= FD_CLOEXEC ;
      if (fcntl( fno, F_SETFD, flags)== -1) 

          exiterror( ERR_SYSTEM_FAILURE, 0 )  ;
   }
#endif

   return (ptr) ;      
}




/* ------------------------------------------------------------------- */
/*                     High level utility routines                     */




/*
 * This function is really just an interface to the function getfileptr().
 * It takes a (possible) filename, and retrieves the corresponding 
 * Rexx file table entry. If the file does not exist, it is opened in 
 * the mode indicated by 'open_mode'. If it does exist, this routine 
 * verifies that it it has been opened in a mode corresponding to 
 * 'access' (OPER_READ or OPER_WRITE).
 *
 * If the file does not exist, it is opened in either normal read 
 * or normal write. This correcspinds to an "implicit" file open 
 * in Rexx.
 */
fileboxptr get_file_ptr( streng *name, int faccess, int open_mode )
{
   fileboxptr ptr=NULL ;

   ptr = getfileptr( name ) ;
   if (ptr==NULL)
      return openfile( name, open_mode ) ;

   if (ptr->flag & FLAG_ERROR)
      return ptr ;

   if (faccess==OPER_READ && (!(ptr->flag & FLAG_READ)))
      reopen_file( ptr, ACCESS_READ ) ;
   else if (faccess==OPER_WRITE && (!(ptr->flag & FLAG_WRITE)))
      reopen_file( ptr, ACCESS_WRITE ) ;
      
   return ptr ;
}



/*
 * This routine reads one complete line from the file indicated by 
 * the file table entry 'ptr'. Or rather, it read from the current 
 * read position, until and including the first EOL mark, and returns
 * that. If the EOL mark is implemented as certain characters, they are
 * not returned. It closely corresponds to the LINEIN() built-in 
 * function. 
 *
 * What is the upper limit for the size that we might read in? It's 
 * best not to have any limit, so the method is the following: A 
 * temporary area is used for storing the data read from the file. 
 * We never know the size needed until the EOL mark is found. So 
 * just read the data into the temporary area. If the EOL is found, 
 * then we know the size, and we can transfer the data into a 'streng' 
 * of suitable size. If the temporary area is too small, allocate 
 * an area twice the size, and copy the data over. Afterwards, keep the 
 * new area as the temporary area. 
 * 
 * This way, be normally use little memory, but we are still able to 
 * read as large lines as the memory allows, if it is needed. 
 */
streng *readoneline( fileboxptr ptr ) 
{
   int i=0, j=0, k=0, eolf=0, eolchars=1 ;
   streng *ret=NULL ;
   static int size=0 ;
   static char *string=NULL ;

   /* 
    * First verify that we actually have a file that is not in an 
    * ERROR state. If so, don't perform any operations. 
    */
   if ( ptr->flag & FLAG_ERROR )
   {
      if (!(ptr->flag & FLAG_FAKE))
         file_error( ptr, 0, NULL ) ;

      return nullstringptr() ;
   }

   /*
    * If the string is not yet allocated, allocate it, and use an 
    * initial size of 512 bytes. This can be increased during runtime.
    */
   if (!string)
   {
      string = Malloc( (size=5120) ) ;
#ifdef TRACEMEM
      rdarea = string ;
#endif      
   }

 /* 
   if (ptr->fileptr==stdin)
      fcntl( stdin, F_SETFL, O_NONBLOCK | fcntl(stdin,F_GETFL)) ;
  */
   errno = 0 ;
   for (i=0; ; i++) 
   {
      j = getc(ptr->fileptr);
      if (j == EOL)
      {
         eolf = EOL;
         break;
      }
#if !defined(UNIX)
      if (j == CR)
      {
         k = getc(ptr->fileptr);
         if (k == EOL)
         {
            eolf = EOL;
            eolchars = 2;
            break;
         }
         else
         {
            ungetc(k,ptr->fileptr);
            eolf = EOL;
            break;
         }
      }
#endif
      /*
       * If we hit end-of-file, handle it carefully, and terminate the 
       * reading. Note that this means that there we have read an 
       * incomplete last line, so return what we've got, and report 
       * an NOTREADY condition. (Partly, I disagree, but this is how
       * TRL defines it ... Case I: Programmer using Emacs forgets to
       * add a EOL after the last line; Rexx triggers NOTREADY when
       * reading that last, incomplete line.
       */
      if (j==EOF)
      {
         ptr->flag |= FLAG_RDEOF ;
         file_warning( ptr, 0, "EOF on line input" ) ;
         break ;
      }
      
      /* 
       * We are trying to avoid any limits other than memory-imposed
       * limits. So if the buffer size that we currently have are too
       * small, double it, and hide the operation from the rest of the
       * interpreter. 
       */
      if (i>=size)
      {
         char *tmpstring ;

         assert( i == size ) ;
         tmpstring = Malloc( 2*size+10 ) ;
         memcpy( tmpstring, string, size ) ;
         Free( string ) ;
         string = tmpstring ;
         size *= 2 ;
#ifdef TRACEMEM
         rdarea = string ;
#endif
      }
    
      /*
       * Just an ordinary character ... append it to the buffer 
       */
      string[i] = j ;
   }

   if (ptr->thispos != EOF)
      ptr->thispos += i - (j==EOF) ;

   if (ptr->readpos != EOF)
      ptr->readpos = ptr->thispos ;

   /* 
    * If we did read a complete line, we have to increment the line
    * count for the current read pointer of this file. This part of
    * the code is a bit Unix-ish. It will have to be reworked for 
    * other types of operating systems. 
    */
   if ((eolf==EOL) && (ptr->readline > 0))
   {
      ptr->readline += eolchars ;  /* only if we actually saw the "\n" !!! */
      if (ptr->linesleft)
         ptr->linesleft-- ;
   }

   /* 
    * Wrap up the data that was read, and return it as a 'streng'.
    *
    */
/*   if (i>1000) i = 1000 ; */
   ret = Str_make( i ) ;
   memcpy( ret->value, string, ret->len=i ) ;
   return ret ;
}




/*
 * This routine will position the current read or write position 
 * of a file, to the start of a particular line. The file to be 
 * operated on is 'ptr', the pointer to manipulate is indicated
 * by 'oper' (either OPER_READ or OPER_WRITE), and the linenumber
 * to position at is 'lineno'.
 *
 * There are (at least) two ways to do the backup of the current 
 * position in the file. First to backup to the start of the file
 * and then to seek forward, or to seek backwards from the current
 * position of the file. 
 *
 * Perhaps the first is best for the standard case, and the second 
 * should be activated when the line-parameter is negative ... ?
 */

void positionfile( fileboxptr ptr, int oper, int lineno ) 
{
   int ch=0x00 ;
   int from_line=0, old_errno=0, tmp=0 ;
   long from_char=0L ;

   /* 
    * If file is in ERROR state, don't touch it. 
    */
   if (ptr->flag & FLAG_ERROR)
   {
      if (!(ptr->flag & FLAG_FAKE))
         file_error( ptr, 0, NULL ) ;
      return ;
   }

   /* 
    * If this isn't a persistent file, then report an error. We can only
    * perform repositioning in persistent files. 
    */

   if (!(ptr->flag & FLAG_PERSIST ))
   {
      file_error( ptr, 0, "Positioning attempted for transient file" ) ;
      return ;
   }        

   /* 
    * If we do any repositioning, then make the old estimate of lines 
    * left to read invalid. This is not really needed in all cases, but
    * it is a good start. And you _may_ even want to recalculate the 
    * number of lines left!
    */ 
   if (ptr->linesleft>0)
      ptr->linesleft = 0 ;

   if (ptr->thispos == EOF)
   {
      errno = 0 ;
      ptr->thispos = ftell( ptr->fileptr ) ;
   }

   /* 
    * So, what we are going to do depends partly on wheter we are moving
    * the read or the write position of the file. We may even be as 
    * lucky as not to have to move anything ... :-) First we can clear 
    * the EOF flag, if set. Repositioning will clean up any EOF state. 
    */
   if (oper == OPER_READ)
      ptr->flag &= ~(FLAG_RDEOF) ;
   else if (oper == OPER_WRITE)
      ptr->flag &= ~(FLAG_WREOF) ;

   /* 
    * We know the line number of at most three positions in the file: 
    * the start of the file, the write position and the read position. 
    * If the file is open only for reading or writing, we know at most
    * two positions. And in addition, the read and/or the write 
    * position may be be invalid (i.e. previous operation was 
    * character oriented). But at least, we know the line number of 
    * one position, the start of the file, which is the first line. 
    *
    * The best method seems to be: First start with the start of file
    * and then see if using the read or the write position instead is 
    * a better deal. There is one drawback ... we assume that all lines
    * are equally long. That assumption is probably not too bad for text
    * files, but it may create unnecessary overhead for 'peculiar' files
    */
   from_line = 1 ;
   from_char = 0 ;

   /*
    * First, let's check to see if we gain anything from using the 
    * read position instead. If the distance from the current read
    * position to the wanted line (counted in number of lines) is smaller
    * than the number of lines from the first line to the wanted line,
    * use the current read position in stead. But only if the current 
    * read position is defined. 
    */
   if ((ptr->flag & FLAG_READ) && (ptr->readline > 0))
   {
      assert( ptr->readpos != EOF) ;
      tmp = ptr->readline - lineno ;
      if (tmp<0)
         tmp = (-tmp) ;

      if (tmp < (lineno - from_line))
      {
         from_line = ptr->readline ;
         from_char = ptr->readpos ;
      }
   }

   /*
    * Then, we check to see whether we can gain even more if we use
    * the current write position of the file instead. 
    */
   if ((ptr->flag & FLAG_WRITE) && (ptr->writeline > 0))
   {
      assert( ptr->writepos != EOF ) ;
      tmp = ptr->writeline - lineno ;
      if (tmp<0)
         tmp = (-tmp) ;

      if (tmp < (lineno - from_line))
      {
         from_line = ptr->writeline ;
         from_char = ptr->writepos ;
      }
   }

   /* 
    * By now, the variables from_line, and from_char should contain 
    * the optimal starting point from where a seek for the 'lineno' 
    * line in the file can start, so first, move there. An in addition, 
    * it should be the known position which is closest to the wanted
    * line. 
    */
   if (from_char != ptr->thispos)
   {
      errno = 0 ;
      if (fseek( ptr->fileptr, from_char, SEEK_SET ))
      {
         file_error( ptr, errno, NULL ) ;
         return ;
      }
      ptr->thispos = from_char ;
   }
   assert( from_char == ftell(ptr->fileptr) ) ;

   /*
    * Now we are positioned at the right spot, so seek forwards or
    * backwards until we reach the correct line. Actually, the method
    * we are going to use may seem a bit strange at first. First we
    * seek forward until we pass the line, and then we seek backwards
    * until we reach the line and at the end we back up to the first 
    * preceding end-of-line marker. This may seem awkward, but it is 
    * fairly simple. And in addition, it will always position us at
    * the _start_ of the wanted line.
    */
   once_more:
   while ((lineno>from_line))   /* seek forward */
   {
      for (;((ch=getc(ptr->fileptr))!=EOF)&&(ch!=EOL);from_char++) ;
      if (ch==EOL) 
         from_line++ ;
      else
         break ;
   } 

   /*
    * Then we seek backwards until we reach the line. The backwards
    * movement is _really_ awkward, so perhaps we should read in 512
    * bytes, and analyse the data in it instead? Indeed, another 
    * algoritm should be chosen. Maybe later ...
    */
   while (lineno<=from_line && from_char>0)
   {
      errno = 0 ;
      if (fseek(ptr->fileptr, -1, SEEK_CUR))
      {
         /* 
          * Should this happen? Only if someone overwrites EOF chars in
          * the file, but that _may_ happend ...   Report error for 
          * any errors from the fseek and ftell. If we hit the start of
          * the file, reset from_line check whether we are _below_ lineno
          * If so, jump back and seek from the start (then we *must* 
          * start at line 1, since the data we've got are illegal).
          *
          * It will also happen if we are seeking backwards for the 
          * first line.
          */
         old_errno = errno ;
         errno = 0 ;
         if (fseek(ptr->fileptr,0,SEEK_SET))
         {
            file_error( ptr, errno, NULL ) ;
            return ;
         }

         from_line = 1 ;
         ptr->thispos = 0 ;
         if (from_line<lineno)
         {
            ptr->readline = ptr->writeline = (-1) ;
            goto once_more ;
         }

         break ;  /* we were looking for the first line ... how lucky :-) */
      }

      /* 
       * After seeking one character backwards, we must read the character
       * that we just skipped over. Do that, and test whether it is 
       * a end-of-line character.
       */
      ch = getc(ptr->fileptr) ;
      if (ch==EOL) 
      {
         if (lineno==from_line)
            break ;
         
         from_line-- ;
      }

      /*
       * Then we move backwards once more, in order to compensate for 
       * reading the character. Sigh, we are really doing a lot of 
       * forward and backward reading, arn't we?
       */
      errno = 0 ;
      if (fseek(ptr->fileptr, -1, SEEK_CUR))
      {
         file_error( ptr, errno, NULL ) ;
         return ;
      }
   } 

   /* 
    * Now we are almost finished. We just have to set the correct 
    * information in the Rexx file table entry.
    */
   ptr->thispos = ftell( ptr->fileptr ) ;
   if (oper == OPER_READ)
   {
      ptr->readline = lineno ;
      ptr->readpos = ptr->thispos ;
      ptr->flag &= ~(FLAG_RDEOF) ;
   }
   else
   {
      ptr->writeline = lineno ;
      ptr->writepos = ptr->thispos ;
      ptr->flag &= ~(FLAG_WREOF) ;
   }
}
     



/* 
 * I wish every function would be as easy as this! Basically, it 
 * only contain simple error checking, and a direct positioning. 
 * it is called by the built-in function CHARIN() and CHAROUT() 
 * in order to position the current read or write position at the 
 * correct place in the file. 
 */
void positioncharfile( fileboxptr fileptr, int oper, int where )
{
   /* 
    * If the file is in state ERROR, don't touch it! Since we are not
    * to return any data, don't bother about the state of FAKE.
    */
   if (fileptr->flag & FLAG_ERROR)
   {
      if (!(fileptr->flag & FLAG_FAKE))
         file_error( fileptr, 0, NULL ) ;
      return ;
   }

   /* 
    * If the file is not persistent, then positioning is not allowed.
    * Give the appropriate error for this.
    */
   if (!(fileptr->flag & FLAG_PERSIST)) 
   {
      file_error( fileptr, 0, "File is not persistent" ) ;
      return ;
   }

#ifdef TRUE_TRL_IO
   /* 
    * TRL says that positioning the read position to after the last 
    * character in the file, is an error. Unix allows it, and gives
    * an EOF at the next reading. So, we have to handle this as a
    * special case ...  Check that the new position is valid.
    *
    * Should we give "Incorrect call to routine" when the character
    * position is greater than the size of the file? Perhaps we should
    * raise the NOTREADY condition instead?
    */
   {
      long oldp, endp ;

      oldp = ftell( fileptr->fileptr ) ;
      fseek(fileptr->fileptr, 0, SEEK_END) ;
      endp = ftell( fileptr->fileptr ) ;
      fseek( fileptr->fileptr, oldp, SEEK_SET ) ;

      if ((oper==OPER_READ) && (endp<where))
      {
         file_error( fileptr, 0, "Repositioning at or after EOF" ) ;
         return ;
      }
      else if ((oper==OPER_WRITE) && ((endp+1)<where))
      {
         file_error( fileptr, 0, "Repositioning after EOF" ) ;
         return ;
      }
   }
#endif

   /*
    * Then do the actual positioning. Remember to clear errno first. 
    * Previously, this code tested afterwards to see if ftell() 
    * returned the same position that fseek() tried to set. Surly, that
    * must be unnecessary? 
    */
   errno = 0 ;
   if (fseek(fileptr->fileptr,(where-1),SEEK_SET))
   {
      file_error( fileptr, errno, NULL ) ;
      return ;
   }

   /* 
    * Then we have to update the file pointers in the entry in our
    * file table. 
    *
    * Clear the end-of-file flag. Even if we *did* position to the 
    * end of file, we don't want to discover that until we actually 
    * _read_ data that is _off_ the end-of-file.
    */
   fileptr->thispos = where-1 ;
   if ((oper==OPER_READ) && (fileptr->flag & FLAG_READ))
   {
      fileptr->readpos = where-1 ;
      fileptr->flag &= ~(FLAG_RDEOF) ;
   }
   else if ((oper==OPER_WRITE) && (fileptr->flag & FLAG_WRITE))
   {
      fileptr->writepos = where-1 ;
      fileptr->flag &= ~(FLAG_WREOF) ;
   }
   else
      file_error( fileptr, 0, NULL ) ;

   /* 
    * And then, set the linenr field to a value signifying that we 
    * have no good idea about which lines are current. 
    *
    * Since we did a fseek, we can automatically set oper to NONE.
    */
   fileptr->readline = 0 ;
   fileptr->writeline = 0 ;
   fileptr->oper = OPER_NONE ;
}



/*
 * This routine reads a string of data from a file indicated by 
 * the Rexx file table entry 'ptr'. The read starts at the current
 * read position, and the length will be 'length' characters.
 *
 * Then, what if the data to be read are more than what is possible
 * to store in one string; let's say length=100,000, and the size of 
 * length in a string is 16 bit. Well, That should return an error 
 * in Str_make(), but maybe we should handle it more elegantly?
 */
streng *readbytes( fileboxptr fileptr, int length ) 
{
   int didread=0 ;
   streng *retvalue=NULL ;

   /* 
    * If state is ERROR, then refuse to handle the file further.
    * If the state was 'only' EOF, then don't bother, the length of 
    * the file might have increased since last attempt to read.
    */
   if (fileptr->flag & FLAG_ERROR)
   {
      if (!(fileptr->flag & FLAG_FAKE))
         file_error( fileptr, 0, NULL ) ;
      return nullstringptr() ;
   }

   assert( fileptr->flag & FLAG_READ ) ;

   /* 
    * If we are not at the current read position, we have to 
    * seek to the correct position, but first we have to the validity
    * of these positions.
    */
   if (fileptr->flag & FLAG_PERSIST)
   {
      if (fileptr->thispos != fileptr->readpos)
      {
         errno = 0 ;
         if (fseek(fileptr->fileptr, fileptr->readpos, SEEK_SET ))
         {
            file_error( fileptr, errno, NULL ) ;
            return nullstringptr() ;
         }
         fileptr->thispos = fileptr->readpos ;
         fileptr->oper = OPER_NONE ;
      }
   }

   /* 
    * The joy of POSIX ...  If a file is open for input and output, it
    * must be flushed when changing between the two. Therefore, check
    * the type of the last operation. Actually, this are not very likely
    * since that situation would in general have been handled above.
    */
   if (fileptr->oper==OPER_WRITE)
   {
      errno = 0 ;
      if (fseek( fileptr->fileptr, 0L, SEEK_CUR ))
      {
         /* Hey, how could this have happened?!?! NFS down? */
         file_error( fileptr, errno, NULL ) ;
         return nullstringptr() ;
      }
      fileptr->oper = OPER_NONE ;
   }
      
   /* 
    * Lets get ready for the big event. First allocate enough space to 
    * hold the data we are hoping to be able to read. Then read it 
    * directly into the string.
    */
   retvalue = Str_make(length+1) ;
   errno = 0 ;
   didread = fread( retvalue->value, 1, length, fileptr->fileptr ) ;

   /* 
    * Variable 'read' contains the number of items (=bytes) read, or 
    * it contains EOF if an error occurred. Handle the error the 
    * normal way; i.e. trigger file_error and return nothing.
    */
   if (didread==EOF)
   {
      file_error( fileptr, errno, NULL ) ;
      return nullstringptr() ;
   }

   /* 
    * What if we didn't manage to read all the data? Well, return what 
    * we got, but still trigger an error, since EOF should be 
    * considered a NOTREADY condition. However, we try to handle EOF
    * a bit more elegantly than other errors, since lots of programmers
    * are probably not bothering about EOF; an EOF condition should be 
    * able to be reset using a file positioning.
    */
   assert( 0<=didread && didread<=length ) ;   /* It'd better be! */
   retvalue->len = didread ;
   if (didread<length)
   {
      file_warning( fileptr, 0, "EOF on char input" ) ;
      fileptr->flag |= FLAG_RDEOF ;
   }
   else
      fileptr->flag &= ~FLAG_RDEOF ;

   /* 
    * Then, at the end, we have to set the pointers and counter to 
    * the correct values 
    */
   fileptr->thispos += didread ;
   fileptr->readpos += didread ;
   fileptr->readline = (-1) ;
   fileptr->linesleft = 0 ;
   fileptr->oper = OPER_READ ;

   return retvalue ;
}



/* 
 * This routines write a string to a file pointed to by the Rexx file 
 * table entry 'fileptr'. The string to be written is 'string', and the 
 * length of the write is implicitly given avs the length of 'string'
 *
 * This routine is called from the Rexx built-in function CHAROUT().
 * It is a fairly streight forward implementation.
 */

int writebytes( fileboxptr fileptr, streng *string ) 
{
   int written=0 ;

   /* 
    * First, if this file is in state ERROR, don't touch it, what to 
    * return depends on whether the file is in state FAKE. 
    */
   if ( fileptr->flag & FLAG_ERROR )
      if ( fileptr->flag & FLAG_FAKE )
         return string->len ;
      else
      {
         file_error( fileptr, 0, NULL ) ;
         if (fileptr->flag & FLAG_FAKE)
            return string->len ;

         return 0 ;
      }

   /* 
    * If we are not at the current write position, we have to 
    * seek to the correct position
    */
   if (fileptr->thispos != fileptr->writepos)
   {
      errno = 0 ;
      if (fseek(fileptr->fileptr, fileptr->writepos, SEEK_SET ))
      {
         file_error( fileptr, errno, NULL ) ;
         return 0 ;
      }
      fileptr->thispos = fileptr->writepos ;
      fileptr->oper = OPER_NONE ;
   }

   /*
    * If previous operation on this file was a read, we have to flush 
    * the file before we can perform any write operations. This will 
    * seldom happen, since it is in general handled above.
    */
   if (fileptr->oper & OPER_READ)
   {
      errno = 0 ;
      if (fseek(fileptr->fileptr, 0, SEEK_CUR))
      {
         file_error( fileptr, errno, NULL ) ;
         return (fileptr->flag & FLAG_FAKE) ? string->len : 0 ;
      }
      fileptr->oper = OPER_NONE ;
   }

   /*
    * Here comes the actual writing. This also works when the length
    * of string is zero. 
    */
   errno = 0 ;
   written = fwrite( string->value, 1, string->len, fileptr->fileptr ) ;
   
   /*
    * Here comes the error checking. Note that this function will 
    * return the number of elements written, it will never return 
    * EOF as fread can, since the problems surrounding EOF can not 
    * occur in this operation. Therefore, report a fullfleged error
    * whenever rc is less than the length of string.
    */
   assert( 0<=written && written<=string->len ) ;
   if (written < string->len ) 
      file_error( fileptr, errno, NULL ) ;
   else
   {
      /* 
       * If the operation was successful, then we set misc status 
       * information about the file, and the counters and pointers.
       */
      fileptr->writeline = 0 ;
      fileptr->flag &= ~FLAG_RDEOF ;
      fileptr->oper = OPER_WRITE ;
      fileptr->thispos += written ;
      fileptr->writepos += written ;

      fflush( fileptr->fileptr ) ; 
   }

   return written ;
}



/*
 * This routine counts the complete lines remaining in the file 
 * pointed to by the Rexx file table entry 'ptr'. The count starts 
 * at the current read position, and the current line will be counted
 * even if the current read position points to the middle of a line. 
 * The last line will only be counted if it was actually terminated 
 * by a EOL marker. If the current line is the last line, but it was
 * not explicitly terminated by a EOL marker, zero is returned. 
 */
int countlines( fileboxptr ptr ) 
{
   long oldpoint=0L ;
   int left=0, ch=0, prevch=-1 ;

   /*
    * If this file is in ERROR state, we really don't want to try to 
    * operate on it. Just report an error, and return 0.
    */
   if ( ptr->flag & FLAG_ERROR )
   {
      if (!(ptr->flag & FLAG_FAKE))
         file_error( ptr, 0, NULL ) ;
      return 0 ;
   }

   /*
    * Counting lines requires us to reposition in the file. However,
    * we can not reposition in transient files. If this is not a 
    * persistent file, don't do any repositioning, just return one
    * for any situation where we are not sure whether there are more
    * data or not (i.e. unless we are sure that there are no more data,
    * return "1"
    */
   if (!(ptr->flag & FLAG_PERSIST)) 
   {
      return (!feof(ptr->fileptr)) ;
   }
   else
   {
      /*
       * Take advantage of the cached value of the lines left in the
       * file
       */
      if (ptr->linesleft)
         return ptr->linesleft ;

      /*
       * If, however, this is a persistent file, we have to read from 
       * the current read position to the end-of-file, and count all 
       * the lines. First, make sure that wse position at the current
       * read position.
       */
      errno = 0 ;    
      oldpoint = ftell( ptr->fileptr ) ;
      if (oldpoint==EOF)
      {
         file_error( ptr, errno, NULL ) ;
         return 0 ;
      }

      /* 
       * Then read the rest of the file, and keep a count of all the files 
       * read in the process.
       */
#ifdef UNIX
      for(left=0;((ch=getc(ptr->fileptr))!=EOF);)
         if (ch==EOL)
            left++ ;
#else
      for(left=0;;)
      {
         ch = getc(ptr->fileptr);
         if (ch == EOF)
            break;
         if ( ch == CR)
            left++ ;
         else
         {
            if ( ch == EOL && prevch != CR)
               left++ ;
         }
         prevch = ch;
      }
#endif
 
      /* 
       * At the end, try to reposition back to the old current read 
       * position, and report an error if that attempt failed. 
       */
      errno = 0 ;
      if (fseek(ptr->fileptr, oldpoint, SEEK_SET))
      {
         file_error( ptr, errno, NULL ) ;
         return 0 ;
      }
      ptr->linesleft = left ;
   }
   return left ;
}



/* 
 * This routine calculates the number of bytes remaining in the file, 
 * i.e the number of bytes from the current read position until the 
 * end-of-file.  It is, of course, called from the Rexx built-in 
 * function CHARS()
 */

int calc_chars_left( fileboxptr ptr ) 
{
   int left=0 ;
   long oldpoint=0L, newpoint=0L ;

   if (! ptr->flag & FLAG_READ)
      return 0 ;

   /* 
    * First, determine whether this file is in ERROR state. If so, we
    * don't want to touch it. Whether or not the file is in FAKE state
    * is fairly irrelevant in this situation
    */
   if ( ptr->flag & FLAG_ERROR )
   {
      if (!(ptr->flag & FLAG_FAKE))
         file_error( ptr, 0, NULL ) ;
      return 0 ;
   }

   /* 
    * If this is not a persistent file, then we have no means of finding 
    * out how much of the file is available. Then, return 1 if we are not
    * at the end-of-file, and 0 otherwise.
    */
   if (!(ptr->flag & FLAG_PERSIST))
      left = ( !(ptr->flag & FLAG_RDEOF)) ;
   else
   {
      /* 
       * This is a persistent file, which is not in error state. OK, then
       * we must record the current point, fseek to the end-of-file, 
       * ftell to get that position, and fseek back to where we started.
       * And we have to check for errors everywhere ... sigh.
       *
       * First, record the current position in the file.
       */
      errno = 0 ;
      oldpoint = ftell( ptr->fileptr ) ;
      if (oldpoint==EOF)
      {
         file_error( ptr, errno, NULL ) ;
         return 0 ;
      }

      /* 
       * Then, move the current position to the end-of-file
       */
      errno = 0 ;
      if (fseek(ptr->fileptr, 0L, SEEK_END))
      {
         file_error( ptr, errno, NULL ) ;
         return 0 ;
      }
      
      /* 
       * And record the position of the end-of-file
       */
      errno = 0 ;
      newpoint = ftell( ptr->fileptr ) ;
      if (newpoint==EOF)
      {
         file_error( ptr, errno, NULL ) ;
         return 0 ;
      }

      /*
       * And, at last, position back to the place where we started. 
       * Actually, this may not be necessary, since we _can_ leave the
       * current position at the end-of-file. After all, the next read
       * or write _will_ position back correctly. However, let's be 
       * nice ... 
       */
      errno = 0 ;
      if (fseek(ptr->fileptr, oldpoint, SEEK_SET))
      {
         file_error( ptr, errno, NULL ) ;     
         return 0 ;
      }

      /* 
       * Then we have some accounting to do; calculate the size of the 
       * last part of the file. And also set oper to NONE, we _have_
       * done a repositioning ... actually, several :-)
       */
      left = newpoint - ptr->readpos ;
      ptr->oper = OPER_NONE ;
   }

   return left ;
}






/*
 * This routine writes a line to the file indicated by 'ptr'. The line
 * to be written is 'data', and it will be terminated by an extra 
 * EOL marker after the charactrers in 'data'. 
 */
int writeoneline( fileboxptr ptr, streng *data ) 
{
   char *i=NULL ;

   /*
    * First, make sure that the file is not in ERROR state. If it is
    * report an error, and return a result depending on whether this
    * file is to be faked.
    */
   if (ptr->flag & FLAG_ERROR)
      if (ptr->flag & FLAG_FAKE)
         return 0 ; 
      else
      {
         file_error( ptr, 0, NULL ) ;
         if (ptr->flag & FLAG_FAKE) 
            return 0 ;
         return 1 ;
      }
      
         
   /* 
    * If we are to write a new line, we ought to truncate the file after
    * that line. Or rather, we truncate the file at the start of the
    * new line, before we write it out. But only if we have the non-POSIX
    * function ftruncate() available. And not if we are already there.
    */
#if defined(HAVE_FTRUNCATE)
# if OLD_OPTIONS
   if (currlevel->u.options.lineouttrunc)
# else
   if ( get_options_flag( currlevel, EXT_LINEOUTTRUNC ) )
# endif
   {
      if (ptr->oper != OPER_WRITE && !(ptr->flag & (FLAG_WREOF)) &&
                                     (ptr->flag & FLAG_PERSIST))
      {
        int fno ;
        errno = 0 ;
        fno = fileno( ptr->fileptr ) ;
        if (ftruncate( fno, ptr->writepos))
          {
            file_error( ptr, errno, NULL ) ;
            return !(ptr->flag & FLAG_FAKE) ;
          }
        fseek( ptr->fileptr, 0, SEEK_END ) ;
        ptr->thispos = ptr->writepos = ftell( ptr->fileptr ) ;
        if (ptr->readpos>ptr->thispos && ptr->readpos!=EOF)
          {
            ptr->readpos = ptr->thispos ;
            ptr->readline = 0 ;
            ptr->linesleft = 0 ;
          }
      }
   }
#endif

   /*
    * Then, output the characters in 'data', and sense any problem.
    * If there is a problem, report an error
    */
   errno = 0 ;
   for (i=data->value; i<Str_end(data); i++)
   {       
      if (putc( *i, ptr->fileptr)==EOF)
      {
         file_error( ptr, errno, NULL ) ;
         return 1 ;
      }
   }

   /*
    * After all the data has been written out, we have to explicitly 
    * terminate the file with an end-of-line marker. Under Unix this 
    * is the single character EOL. Under Macintosh this is the single
    * character CR, and all others it is CR and EOL.
    */
#if !defined(UNIX)
   if (putc( CR, ptr->fileptr)==EOF)
   {
      file_error( ptr, errno, NULL ) ;
      return 1 ;
   }
#endif
#if !defined(MAC)
   if (putc( EOL, ptr->fileptr)==EOF)
   {
      file_error( ptr, errno, NULL ) ;
      return 1 ;
   }
#endif

   /*
    * Then we have to update the counters and pointers in the Rexx 
    * file table entry. We must do that in order to be able to keep 
    * track of where we are. 
    */
   ptr->thispos += data->len + 1 ;
   ptr->writepos = ptr->thispos ;
   ptr->oper = OPER_WRITE ;

   if (ptr->writeline)
      ptr->writeline++ ;

   ptr->flag |= FLAG_WREOF ;

   /* 
    * At the end, we flush the data. We do this in order to avoid 
    * surprises later. Maybe we shouldn't do that, since it may force
    * a systemcall, which might give away the timeslice and decrease
    * system time. So you might want to remove this call ... at your 
    * own risk :-)
    */
   errno = 0 ;
   if (fflush( ptr->fileptr ))
   {
      file_error( ptr, errno, NULL ) ;
      return 1 ; 
   }

   return 0 ;
}

/* 
 * This routine is a way of retrieving the information returned by the
 * standard Unix call stat(). It takes the name of a file as parameter,
 * and return information about that file. This is not standard Rexx, 
 * but quite useful. It is accessed through the built-in function
 * STREAM(), command 'FSTAT'
 */
streng *getstatus( streng *filename , int subcommand)
{
   fileboxptr ptr=NULL ;
   int rc=0 ;
   int fno=0 ;
   long pos_read = -2L, pos_write = -2L, pos_line = -2L;
   int streamtype = 0; /* unknown */
   streng *result=NULL ;
   struct stat buffer ;
   struct tm *static_tmdata = NULL ;
   struct tm tmdata ;
   static char *fmt = "%02d-%02d-%02d %02d:%02d:%02d" ;
   static char *iso = "%04d-%02d-%02d %02d:%02d:%02d" ;
   static char *streamdesc[] = { "UNKNOWN", "PERSISTENT", "TRANSIENT" };

   /*
    * First get the Rexx file table entry associated with the file, 
    * and then call stat() for that file. If the file is already open, 
    * then call fstat, since that will in general be a 'safer' way
    * to be sure that it is _really_ the file that is open in Rexx.
    */
   ptr = getfileptr( filename ) ;
   if (ptr && ptr->fileptr)
   {
      fno = fileno( ptr->fileptr ) ;
      rc = fstat( fno, &buffer ) ;
      if (ptr->flag & FLAG_PERSIST)
         streamtype = 1;
      else
         streamtype = 2;
      pos_read = ptr->readpos;
      pos_write = ptr->writepos;
      pos_line = ptr->readline;
   }
   else
   {
      /*
       * Nul terminate the filename string, as stat() will barf if
       * it isn't.
       */
      filename->value[filename->len] = 0x00;
      rc = stat( filename->value, &buffer ) ;
      streamtype = 1;
   }

   /*
    * If we were able to retrieve any useful information, store it
    * in a string of suitable length, and return that string. 
    * If the filename does not exist, always return an empty string.
    */
   if (rc==(-1))
      result = nullstringptr() ;
   else
   {
      switch ( subcommand )
      {
         case COMMAND_FSTAT:
            result = Str_make( 128 ) ;
            sprintf( result->value, 
               "%d %ld %03o %d %s %s %ld", 
               buffer.st_dev, (long)(buffer.st_ino),
               buffer.st_mode & 0x7f, buffer.st_nlink,
#if defined(VMS) || defined(OS2) || defined(DOS) || defined (__WATCOMC__) || defined(_MSC_VER) /* MH 10-06-96 */
               "USER", "GROUP",
#else
            getpwuid( buffer.st_uid )->pw_name, 
            getgrgid( buffer.st_gid )->gr_name, 
#endif         
            (long)(buffer.st_size) ) ;
            break;
         case COMMAND_QUERY_EXISTS:
#if defined(HAVE__FULLPATH)
            result = Str_make( _MAX_PATH );
            _fullpath(result->value, filename->value, _MAX_PATH);
#elif defined(HAVE_TRUENAME)
            result = Str_make( _MAX_PATH ) ;
            _truename(filename->value, result->value);
#else
            result = Str_make( 1024 ) ;
            if (my_fullpath(result->value, filename->value, 1024) == -1)
               result = nullstringptr() ;
#endif
            break;
         case COMMAND_QUERY_SIZE:
            result = Str_make( 50 ) ;
            sprintf( result->value, "%ld", (long)(buffer.st_size) ) ;
            break;
         case COMMAND_QUERY_HANDLE:
            if (fno)
            {
               result = Str_make( 10 ) ;
               sprintf( result->value, "%d", fno ) ;
            }
            else
               result = nullstringptr() ;
            break;
         case COMMAND_QUERY_STREAMTYPE:
            result = Str_make( 12 ) ;
            sprintf( result->value, "%s", streamdesc[streamtype] ) ;
            break;
         case COMMAND_QUERY_DATETIME:
            static_tmdata = localtime(&buffer.st_mtime) ;
            memcpy(&tmdata, static_tmdata, sizeof(struct tm));
            result = Str_make( 20 ) ;
            sprintf( result->value, fmt, tmdata.tm_mon+1, tmdata.tm_mday,
                     tmdata.tm_year, tmdata.tm_hour, tmdata.tm_min, 
                     tmdata.tm_sec ) ;
            break;
         case COMMAND_QUERY_TIMESTAMP:
            static_tmdata = localtime(&buffer.st_mtime) ;
            memcpy(&tmdata, static_tmdata, sizeof(struct tm));
            result = Str_make( 20 ) ;
            sprintf( result->value, iso, tmdata.tm_year+1900, tmdata.tm_mon+1, 
                     tmdata.tm_mday,
                     tmdata.tm_hour, tmdata.tm_min, 
                     tmdata.tm_sec ) ;
            break;
         case COMMAND_QUERY_POSITION_READ:
         case COMMAND_QUERY_POSITION_CHAR:
         case COMMAND_QUERY_POSITION_SYS:
            if (pos_read != (-2))
            {
               result = Str_make( 50 ) ;
               sprintf( result->value, "%ld", pos_read + 1) ;
            }
            else
               result = nullstringptr() ;
            break;
         case COMMAND_QUERY_POSITION_WRITE:
            if (pos_write != (-2))
            {
               result = Str_make( 50 ) ;
               sprintf( result->value, "%ld", pos_write + 1) ;
            }
            else
               result = nullstringptr() ;
            break;
         case COMMAND_QUERY_POSITION_LINE:
            if (pos_line != (-2))
            {
               result = Str_make( 50 ) ;
               sprintf( result->value, "%ld", pos_line ) ;
            }
            else
               result = nullstringptr() ;
            break;
      }
      result->len = strlen( result->value ) ;
   }

   return result ;
}


/* 
 * This little sweet routine returns information stored in the Rexx 
 * file table entry about the named file 'filename'. It is perhaps more
 * of a debugging function than a Rexx function. It is accessed by the
 * Rexx built-in function STREAM(), command 'STATUS'. One of the nice
 * pieces of information this function returns is whether a file is 
 * transient or persistent. 
 *
 * This is really a simple function, just retrieve the Rexx file 
 * table entry, and store the information in that entry into a string
 * and return that string. 
 * 
 * The difference between getrexxstatus() and getstatus() is that 
 * that former returns information stored in Rexx's datastructures, 
 * while the latter return information about the file stored in and
 * managed by the operating system
 */
streng *getrexxstatus( fileboxptr ptr ) 
{
   streng *result=NULL ;

   if (ptr==NULL)
      return nullstringptr() ;

   result = Str_make(64) ;  /* Ought to be enough */
   result->value[0] = 0x00 ;

   if ((ptr->flag & FLAG_READ) && (ptr->flag & FLAG_WRITE))
      strcat( result->value, "READ/WRITE" ) ;
   else if (ptr->flag & FLAG_READ)
      strcat( result->value, "READ" ) ;
   else if (ptr->flag & FLAG_WRITE)
      strcat( result->value, "WRITE" ) ;
   else 
      strcat( result->value, "NONE" ) ;

   sprintf( result->value + strlen(result->value),
            " READ: char=%ld line=%d WRITE: char=%ld line=%d %s", 
            (long)(ptr->readpos+1), ptr->readline,
            (long)(ptr->writepos+1), ptr->writeline, 
            (ptr->flag & FLAG_PERSIST) ? "PERSISTENT" : "TRANSIENT" ) ;

   result->len = strlen(result->value) ;
   return result ;
}


/* 
 * This routine parses the remainder of the parameters passed to the
 * Stream(,'C','QUERY...') function.
 */
streng *getquery( streng *filename , streng *subcommand)
{
   streng *result=NULL, *psub=NULL ;
   char oper = 0;

   /* 
    * Get the subcommand to QUERY
    */

   oper = get_querycommand( subcommand );
   switch ( oper )
   {
      case COMMAND_QUERY_DATETIME :
      case COMMAND_QUERY_TIMESTAMP :
      case COMMAND_QUERY_EXISTS :
      case COMMAND_QUERY_HANDLE :
      case COMMAND_QUERY_SIZE :
      case COMMAND_QUERY_STREAMTYPE :
         result = getstatus(filename, oper );
         break;
      case COMMAND_QUERY_SEEK :
      case COMMAND_QUERY_POSITION :
         if ( oper == COMMAND_QUERY_SEEK )
            psub = Str_nodup( subcommand, 4, subcommand->len - 4 );
         else
            psub = Str_nodup( subcommand, 8, subcommand->len - 8 );
         psub = Str_strp( psub, ' ', STRIP_LEADING);
         oper = get_querypositioncommand( psub );
         switch ( oper )
         {
            case COMMAND_QUERY_POSITION_READ :
            case COMMAND_QUERY_POSITION_WRITE :
            case COMMAND_QUERY_POSITION_CHAR :
            case COMMAND_QUERY_POSITION_LINE :
            case COMMAND_QUERY_POSITION_SYS :
               result = getstatus(filename, oper );
               break;
            default:
                exiterror( ERR_INCORRECT_CALL, 0 )  ;
               break;
         }
         Free_string(psub);
         break;
      default:
          exiterror( ERR_INCORRECT_CALL, 0 )  ;
         break;
   }

   return result ;
}

/* 
 * This routine parses the remainder of the parameters passed to the
 * Stream(,'C','OPEN...') function.
 */
streng *getopen( streng *filename , streng *subcommand)
{
   fileboxptr ptr=NULL ;
   streng *result=NULL, *psub=NULL ;
   char oper = 0;

   /* 
    * Get the subcommand to OPEN
    */
   oper = get_opencommand( subcommand );
   switch ( oper )
   {
      case COMMAND_OPEN_BOTH :
         if ( subcommand->len >= 4
         &&   memcmp(subcommand->value, "BOTH", 4) == 0 )
            psub = Str_nodup( subcommand, 4, subcommand->len - 4 );
         else
            psub = Str_dup( subcommand );
         psub = Str_strp( psub, ' ', STRIP_LEADING);
         oper = get_opencommandboth( psub );
         switch ( oper )
         {
            case COMMAND_OPEN_BOTH :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_WRITE ) ;
               break;
            case COMMAND_OPEN_BOTH_APPEND :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_STREAM_APPEND ) ;
               break;
            case COMMAND_OPEN_BOTH_REPLACE :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_STREAM_REPLACE ) ;
               break;
            default:
               exiterror( ERR_INCORRECT_CALL, 0 )  ;
               break;
         }
         Free_string(psub);
         if (ptr->fileptr)
            result = Str_cre( "READY:" ) ;
         else
            result = Str_cre( "ERROR:2" ) ;
         break;
      case COMMAND_OPEN_READ :
         closefile( filename ) ;
         ptr = openfile( filename, ACCESS_READ ) ;
         if (ptr->fileptr)
            result = Str_cre( "READY:" ) ;
         else
            result = Str_cre( "ERROR:2" ) ;
         break;
      case COMMAND_OPEN_WRITE :
         psub = Str_nodup( subcommand, 5, subcommand->len - 5 );
         psub = Str_strp( psub, ' ', STRIP_LEADING);
         oper = get_opencommandwrite( psub );
         switch ( oper )
         {
            case COMMAND_OPEN_WRITE :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_WRITE ) ;
               break;
            case COMMAND_OPEN_WRITE_APPEND :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_STREAM_APPEND ) ;
               break;
            case COMMAND_OPEN_WRITE_REPLACE :
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_STREAM_REPLACE ) ;
               break;
            default:
                exiterror( ERR_INCORRECT_CALL, 0 )  ;
               break;
         }
         Free_string(psub);
         if (ptr->fileptr)
            result = Str_cre( "READY:" ) ;
         else
            result = Str_cre( "ERROR:2" ) ;
         break;
      default:
          exiterror( ERR_INCORRECT_CALL, 0 )  ;
         break;
   }

   return result ;
}



/* ------------------------------------------------------------------- */
/*                   Rexx builtin functions (level 3)                  */
/*
 * This part consists of one function for each of the Rexx builtin
 * functions that operates on filesystem I/O
 */


/* 
 * This routine implements the Rexx built-in function CHARS(). It is
 * really quite simple, little more than a wrap-around to the 
 * function calc_chars_left.
 */
streng *std_chars( paramboxptr parms )
{
   char opt = 'N';
   streng *string=NULL ;
   fileboxptr ptr=NULL ;
   int was_closed=0, result=0 ;

   /* Syntax: chars([filename]) */
   checkparam(  parms,  0,  2 , "CHARS" ) ;

   if (parms&&parms->next&&parms->next->value)
      opt = getoptionchar( parms->next->value, "CHARS", 2, "CN" ) ;

   string = (parms->value && parms->value->len) ? parms->value : stdio_ptr[0]->filename ;

   /* 
    * Get a pointer to the Rexx file table entry of the file, and 
    * calculate the number of characters left.
    */
   ptr = getfileptr( string ) ;
   was_closed = (ptr==NULL) ;
   if (!ptr)
      ptr = get_file_ptr( string, OPER_READ, ACCESS_READ ) ;

   result = calc_chars_left( ptr ) ;
   if (was_closed)
      closefile( string ) ;

   return int_to_streng( result ) ;
}
   


/*
 * Implements the Rexx builtin function charin(). This function takes 
 * three parameters, and they are treated pretty straight forward 
 * according to TRL. If called with no start position, and a length of 
 * zero, it may be used to do some fancy work (flushing I/O?), although
 * that is probably more needed for output :-)  Note that the file in 
 * entered into the file table in this case, so it might be used to 
 * explicitly open a file for reading. However, consider using stream()
 * to do this, it's a much cleaner approach!
 */
streng *std_charin( paramboxptr parms )
{
   streng *filename=NULL, *result=NULL ;
   fileboxptr ptr=NULL ;
   int length=0, start=0 ;

   /* Syntax: charin([filename][,[start][,length]]) */
   checkparam(  parms,  0,  3 , "CHARIN" ) ;

   /*
    * First, let's get the information about the file from the 
    * file table, and open it in the correct mode if is not already 
    * availble as such.
    */
   filename = (parms->value && parms->value->len) ? (parms->value) : stdio_ptr[0]->filename ;
   ptr = get_file_ptr( filename, OPER_READ, ACCESS_READ ) ;

   /*
    * Then, get the starting point, or set it to zero.
    */
   parms = parms->next ;
   if ((parms)&&(parms->value))
      start = atopos(parms->value) ;      
   else
      start = 0 ;

   /* 
    * At last, get the length, or use the default value one.
    */
   if (parms)
      parms = parms->next ;

   if ((parms)&&(parms->value))
      length = atozpos( parms->value ) ;
   else
      length = 1 ;

   /* 
    * Position current position in file if necessary
    */
   if (start)
      positioncharfile( ptr, OPER_READ, start ) ;

   if (length)
      result = readbytes( ptr, length ) ;
   else
   {
      if (!start) 
         flush_input( ptr )  ;  /* Whatever happens ... */
      result = nullstringptr() ;
   }

   return result ;
}



/* 
 * This function implements the Rexx built-in function CHAROUT(). It 
 * is basically a wrap-around for the two functions that perform 
 * character repositioning in a file; and writes out characters.
 */

streng *std_charout( paramboxptr parms )
{
   streng *filename=NULL, *string=NULL ;
   int length=0, pos=0 ;
   fileboxptr ptr=NULL ;

   /* Syntax: charout([filename][,[string][,start]]) */
   checkparam(  parms,  0,  3 , "CHAROUT" ) ;

   filename = (parms->value && parms->value->len) ? (parms->value) : stdio_ptr[1]->filename ;

   /* Read the data to be written, if any */
   parms = parms->next ;
   if (parms && parms->value )
      string = parms->value ;
   else
      string = NULL ;

   /* Read the position to start writing, is any */
   if (parms)
      parms = parms->next ;

   if ( parms && parms->value ) 
      pos = atopos(parms->value) ;
   else 
      pos = 0 ;

   /* 
    * Get the filepointer, if necessary, open in in the right mode 
    */
   if (pos || string)
      ptr = get_file_ptr( filename, OPER_WRITE, ACCESS_WRITE ) ;
#ifdef lint
   else
      ptr = NULL ;
#endif

   /* 
    * If we are to position the write position somewhere, do that first.
    */   
   if (pos)
      positioncharfile( ptr, OPER_WRITE, pos ) ;

   /* 
    * Then, write the actual data, or flush output if neither data nor
    * position was given.
    */
   if (string)
      length = string->len - writebytes( ptr, string ) ;
   else 
   {
      length = 0 ;
      if (!pos)
         flush_output( filename ) ;  /* Whatever that may mean */
   }

   return int_to_streng( length ) ;
}



/*
 * Simple routine that implements the Rexx built-in function LINES().
 * Really just a wrap-around to the countlines() routine. 
 */

streng *std_lines( paramboxptr parms )
{
   char opt = 'N';
   fileboxptr ptr=NULL ;
   streng *filename=NULL ;
   int was_closed=0, result=0 ;

   /* Syntax: lines([filename][,S|N]) */
   checkparam(  parms,  0,  2 , "LINES" ) ;

   if (parms&&parms->next&&parms->next->value)
      opt = getoptionchar( parms->next->value, "LINES", 2, "CN" ) ;

   /* 
    * Get the name of the file (use defaults if necessary), and get
    * a pointer to the entry of that file from the file table 
    */
   if (parms->value
   &&  parms->value->len)
      filename = parms->value ;
   else
      filename = stdio_ptr[0]->filename ;

   /* 
    * Try to get the Rexx file table entry, if it doesn't work, then 
    * try again ... and a bit harder
    */
   ptr = getfileptr( filename ) ;
   was_closed = (ptr==NULL) ;
   if (!ptr)
      ptr = get_file_ptr( filename, OPER_READ, ACCESS_READ ) ;

   /*
    * It's rather simple ... all the work has already been done in
    * the function countlines()
    */
   result = countlines( ptr ) ;
   if (was_closed)
      closefile( filename ) ;

   return int_to_streng( result ) ;
}



/* 
 * The Rexx built-in function LINEIN() reads a line from a file. 
 * The actual reading is performed in 'readoneline', while this routine
 * takes care of range checking of parameters, and decides which 
 * lower level routines to call.
 */

streng *std_linein( paramboxptr parms )
{
   streng *filename=NULL, *res=NULL ;
   fileboxptr ptr=NULL ;
   int count=0, line=0 ;

   /* Syntax: linein([filename][,[line][,count]]) */
   checkparam(  parms,  0,  3 , "LINEIN" ) ;

   /* 
    * First get the name of the file, or use the appropriate default
    */
   if (parms->value
   &&  parms->value->len)
      filename = parms->value ;
   else 
      filename = stdio_ptr[0]->filename ;

   /* 
    * Then get the line number at which the read it to start, or set
    * set it to zero if none was specified.
    */
   if (parms)
      parms = parms->next ;

   if (parms && parms->value)
      line = atopos( parms->value ) ;
   else
      line = 0 ;  /* Illegal value */

   /*
    * And at last, read the count, which can be only 0 or 1, and which
    * is the number of lines to read.
    */
   if (parms)
      parms = parms->next ;

   if (parms && parms->value)
   {
      count = atozpos( parms->value ) ;
      if (count!=0 && count!=1) 
          exiterror( ERR_INCORRECT_CALL, 0 )  ;
   }
   else
      count = 1 ;  /* The default */

   /* 
    * Now, get the pointer to the entry in the file table that contains
    * information about this file, or make it automatically create 
    * an entry if one didn't exist.
    */
   ptr = get_file_ptr( filename, OPER_READ, ACCESS_READ ) ;

   /* 
    * If line was specified, we must reposition the current read 
    * position of the file. 
    */
   if (line)
      positionfile( ptr, OPER_READ, line ) ;

   /*
    * As the last thing, read in the data. If no data was wanted, skip it
    * but call flushing if line wasn't specified either.
    */
   if (count)
      res = readoneline( ptr ) ;
   else
   {
      if (!line)
         flush_input( ptr ) ;
      res = nullstringptr() ;
   }
        
   return res ;
}




/*
 * This function is a wrap-around for the Rexx built-in function
 * LINEOUT(). It performs parameter checking and decides which lower
 * level routines to call. 
 */

streng *std_lineout( paramboxptr parms )
{
   streng *string=NULL, *file=NULL ;
   int lineno=0, result=0 ;
   fileboxptr ptr=NULL ;

   /* Syntax: lineout([filename][,[string][,line]]) */
   checkparam(  parms,  0,  3 , "LINEOUT" ) ;
   
   /* 
    * First get the pointer for the file to operate on. If omitted, 
    * use the standard output stream
    */
   if (parms->value
   &&  parms->value->len)
      file = parms->value ;
   else 
      file = stdio_ptr[1]->filename ;

   ptr = get_file_ptr( file, OPER_WRITE, ACCESS_WRITE ) ;   

   /* 
    * Then, get the data to be written, if any.
    */
   if (parms)
      parms = parms->next ;
 
   if (parms && parms->value)
      string = parms->value ;
   else
      string = NULL ;

   /* 
    * At last, we must find the line number of the file to write. We
    * must position the file at this line before the write. 
    */
   if (parms)
      parms = parms->next ;

   if (parms && parms->value)
      lineno = atopos( parms->value ) ;
   else
      lineno = 0 ;  /* illegal value */

   if (string || lineno)
      ptr = get_file_ptr( file, OPER_WRITE, ACCESS_WRITE ) ;   

   /* 
    * First, let's reposition the file if necessary.
    */
   if (lineno)
      positionfile( ptr, OPER_WRITE, lineno ) ;

   /*
    * And then, we write out the data. If there are not data, it may have
    * been just positioning. However, if there are neither data nor 
    * a linenumber, something magic may happen.
    */
   if (string)
      result = writeoneline( ptr, string ) ; 
   else
   {
      if (!lineno)
         flush_output( file ) ;
      result = 0 ;
   }

   return int_to_streng( result ) ;
}




/* 
 * This function checks whether a particular file is accessable by
 * the user in a certain mode, which may be read, write or execute. 
 * Unforunately, this function differs a bit from the functionality
 * of several others. It explicitly checks a file, so that if the 
 * file didn't exist in advance, it is _not_ opened. And even _if_
 * the file existed, the file in the file system is checked, not the 
 * file opened by Regina. The two may differ slightly under certain
 * circumstances. 
 */

int is_accessable( streng *filename, int mode )
{
   int res=0 ;
   
   filename = Str_ify( filename ) ;
   /*
    * First, call access() with the 'correct' parameters, and store
    * the result in 'res'. If 'mode' had an "impossible" value, give 
    * an error.
    */
   if (mode == COMMAND_READABLE)
      res = access( filename->value, R_OK ) ;
   else if (mode == COMMAND_WRITEABLE)
      res = access( filename->value, W_OK ) ;
   else if (mode == COMMAND_EXECUTABLE)
      res = access( filename->value, X_OK ) ;
   else
       exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

   /*
    * Perhaps we should analyze the output a bit before returning? 
    * If res==EACCES, that is not really an error, while other errno
    * code _do_ signify an error. However ... since the return code 
    * a boolean variable, just return it.
    */
   return (res==0) ;
}



/*
 * This little function implements the RESET command of the Rexx 
 * built-in function STREAM(). Basically, most of the job is done in
 * the function 'fixup_file()'. Except from removing the ERROR flag.
 * The 'fixup_file()' fucntion is intended for fixing the file at the
 * start of a condition handler for the NOTREADY condition.
 *
 * The value returned from this function is either "READY" or "UNKNOWN", 
 * and reflects the philosophy that the file _is_ fixed, unless it 
 * is impossible to open it. Of course, that may be a false READY, 
 * since the actual _problem_ might not have been fixed, but at least
 * you have another try at the problem. 
 */

streng *reset_file( fileboxptr fileptr ) 
{
   if (!fileptr)
      return nullstringptr() ;

   fixup_file( fileptr->filename ) ;
   fileptr->flag &= ~(FLAG_ERROR | FLAG_FAKE) ;
   
   if (fileptr->fileptr)
      return Str_cre( "READY" ) ;   /* Per definition */
   else
      return Str_cre( "UNKNOWN" ) ;
}



/* 
 * The built-in function STREAM() is new in TRL2. It is supposed to be 
 * a sort of all-round function for just about anything having to do with
 * files. The details of its specification in TRL2 leaves a lot of room
 * for the implementors. Two of the options to this command -- the Status
 * and Description options are treated as defined by TRL, the Command 
 * option takes several command, defined by the COMMAND_ macros. 
 */
streng* std_stream( paramboxptr parms ) 
{
   char oper=' ' ;
   streng *command=NULL, *result=NULL, *filename=NULL, *psub=NULL ;
   fileboxptr ptr=NULL ;

   /* Syntax: stream(filename[,[oper][,command ...]]) */
   checkparam(  parms,  1,  3 , "STREAM" ) ;

   /* 
    * Get the filepointer to Rexx's file table, but make sure that the 
    * file is not in any way created if it didn't exist. 
    */
   filename = parms->value ;
   ptr = getfileptr( filename ) ;

   /* 
    * Read the 'operation'. This is really just an 'option'. The 
    * default option is 'S'. 
    */
   parms = parms->next ;
   if (parms && parms->value)
      oper = getoptionchar( parms->value, "STREAM", 2, "CSD" ) ;
   else
      oper = 'S' ;

   /*
    * If the operation was 'C', we _must_ have a third parameter, on the
    * other hand, if it was not 'C', we must never have a third parameter. 
    * Make sure that these rules are followed.
    */
   command = NULL ;
   if (oper=='C')
   {
      parms = parms->next ;
      if (parms && parms->value)
         command = parms->value ;
      else
          exiterror( ERR_INCORRECT_CALL, 0 )  ;
   }
   else
      if (parms && parms->next && parms->next->value)
          exiterror( ERR_INCORRECT_CALL, 0 )  ;

   /* 
    * Here comes the main loop. 
    */
   result = NULL ;
   switch ( oper ) 
   {
      case 'C':
         /* 
          * Read the command, and 'translate' it into an integer which 
          * describes it, see the implementation of get_command(), and 
          * the COMMAND_ macros. The first of these are rather simple, 
          * in fact, they could probably be compressed to save some 
          * space. 
          */
         command = Str_strp( command, ' ', STRIP_BOTH );
         oper = get_command( command ) ;
         switch(oper)
         {
            case COMMAND_NONE:
                exiterror( ERR_INCORRECT_CALL, 0 )  ;
               break;
            case COMMAND_READ:
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_READ ) ;
               break;
            case COMMAND_WRITE:
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_WRITE ) ;
               break;
            case COMMAND_APPEND:
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_APPEND ) ;
               break;
            case COMMAND_UPDATE:
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_UPDATE ) ;
               break;
            case COMMAND_CREATE:
               closefile( filename ) ;
               ptr = openfile( filename, ACCESS_CREATE ) ;
               break;
            case COMMAND_CLOSE:
               /* 
                * The file is always unknown after is has been closed. Does
                * that sound convincing, or does it sound like I didn't feel
                * to implement the rest of this ... ?
                */
               closefile( filename ) ;
               result = Str_cre( "UNKNOWN" ) ;
               break ;
            case COMMAND_FLUSH:
               /* 
                * Flush the file. Actually, this might not be needed, since 
                * the functions that write out data may contain explicit
                * calls to fflush()
                */
               ptr = getfileptr( filename ) ;
               if (ptr && ptr->fileptr)
               {
                  errno = 0 ;
                  if (fflush( ptr->fileptr))
                  {
                     file_error( ptr, errno, NULL ) ;
                     result = Str_cre( "ERROR" ) ;
                  }
                  else
                     result = Str_cre( "READY" ) ;
               }
               else if (ptr)
                  result = Str_cre( "ERROR" ) ;
               else
                  result = Str_cre( "UNKNOWN" ) ;
               break ;
            case COMMAND_STATUS:
               ptr = getfileptr( filename ) ;
               result = getrexxstatus( ptr ) ;
               break;
            case COMMAND_FSTAT:
               result = getstatus( filename , COMMAND_FSTAT) ;
               break;
            case COMMAND_RESET:
               ptr = getfileptr( filename ) ;
               result = reset_file( ptr ) ;
               break;
            case COMMAND_READABLE:
            case COMMAND_WRITEABLE:
            case COMMAND_EXECUTABLE:
               result = int_to_streng( is_accessable( filename, oper )) ;
               break;
            case COMMAND_QUERY:
               /*
                * We have to further parse the remainder of the command
                * to determine what sub-command has been passed.
                */
               psub = Str_nodup( command , 5, command->len - 5);
               psub = Str_strp( psub, ' ', STRIP_LEADING);
               result = getquery( filename, psub ) ;
               Free_string(psub);
               break;
            case COMMAND_OPEN:
               /*
                * We have to further parse the remainder of the command
                * to determine what sub-command has been passed.
                */
               psub = Str_nodup( command , 4, command->len - 4);
               psub = Str_strp( psub, ' ', STRIP_LEADING);
               result = getopen( filename, psub ) ;
               Free_string(psub);
               break;
            default:
                exiterror( ERR_INCORRECT_CALL, 0 )  ;
               break;
         }
         break ;

      case 'D':
         /* 
          * Get a description of the most recent error for this file
          */
         if (ptr)
         {
            if (ptr->errmsg)
               result = Str_dup(ptr->errmsg) ;
            else if (ptr->error)
               result = Str_cre( strerror(ptr->error) ) ;
         }
         break ;

      case 'S':
         /* 
          * Get a simple status for the file in question. If the file
          * doesn't exist in Rexx's tables, UNKNOWN is returned. If the 
          * file is in error state, return ERROR, else return READY, 
          * unless current read position is at EOF, in which case 
          * NOTREADY is return. Note that ERROR and NOTREADY are the
          * two states that will raise the NOTREADY condition. 
          */
         if (ptr)
         {
            if (ptr->flag & FLAG_ERROR)
               result = Str_cre( "ERROR" ) ;
            else if (ptr->flag & FLAG_RDEOF)
               result = Str_cre( "NOTREADY" ) ;
            else
               result = Str_cre( "READY" ) ;
         }
         else
            result = Str_cre( "UNKNOWN" ) ;

         break ;

      default:
          exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;
   }
  
   if (result==NULL)
      result = nullstringptr() ;

   return result ;
}



/*
 * This routine will traverse the list of open files, and dump relevant
 * information about each of them. Really a debugging routine. It is 
 * not available when Regina is compiled with optimalization. 
 */
#ifndef NDEBUG
streng *dbg_dumpfiles( paramboxptr parms )
{
   fileboxptr ptr=NULL ;
   int i=0 ;
   char string[10] ;

   checkparam(  parms,  0,  0 , "DUMPFILES" ) ;

   fprintf(stddump,
     "                                                Read      Write\n" ) ;
   fprintf(stddump,
     "File Filename                       Flags    line char  line char\n");
   
   for (ptr=mrufile;ptr;ptr=ptr->next)
   {
      int fno ;
      fno = fileno( ptr->fileptr ) ;
      fprintf( stddump,"%4d %-30s", fno, ptr->filename->value);
      i = 0 ;

      string[0] = ( ptr->flag & FLAG_READ     ) ? 'r' : ' ' ;
      string[1] = ( ptr->flag & FLAG_WRITE    ) ? 'w' : ' ' ;
      string[2] = ( ptr->flag & FLAG_PERSIST  ) ? 'p' : 't' ;
      string[3] = ( ptr->flag & FLAG_RDEOF    ) ? 'R' : ' ' ;
      string[4] = ( ptr->flag & FLAG_WREOF    ) ? 'W' : ' ' ;
      string[5] = ( ptr->flag & FLAG_SURVIVOR ) ? 'S' : ' ' ;
      string[6] = ( ptr->flag & FLAG_ERROR    ) ? 'E' : ' ' ;
      string[7] = ((ptr->flag & FLAG_FAKE) &&
                   (ptr->flag & FLAG_ERROR)   ) ? 'F' : ' ' ;
      string[8] = 0x00 ;

      fprintf( stddump, " %8s %4ld %4d  %4ld %4d\n", 
               string, (long)(ptr->readpos), ptr->readline, 
               (long)(ptr->writepos), ptr->writeline ) ;

      if (ptr->flag & FLAG_ERROR)
      {
         if (ptr->errmsg)
            fprintf(stddump, "     ==> %s\n", ptr->errmsg->value ) ;
         else if (ptr->error)
            fprintf(stddump, "     ==> %s\n", strerror( ptr->error )) ;
      }
   }
   fprintf( stddump,"  r=read, w=write, p=persistent, t=transient, e=eof\n");
   fprintf( stddump,"  R=read-eof, W=write-eof, S=special, E=error, F=fake\n");

   return nullstringptr() ;
}
#endif




/* 
 * Yuk ... !
 * This should really go out .... We definitively don't want to do this. 
 * we want to go through readoneline() for the default input stream. 
 */
streng *readkbdline( void )
{
   static  int got_eof=0 ;
   streng *source=NULL ;
   int ch=0x00 ;
   int i=0 ;

   source = Str_make(BUFFERSIZE) ;
   if (got_eof) 
      (void)fseek(stdin,SEEK_SET,0) ;

   do 
   {
      if (i<BUFFERSIZE) 
         source->value[i++] = ch = getc(stdin) ;
   } while((ch!='\012')&&(ch!=EOF)) ;

   got_eof = (ch==EOF) ;
   source->len = i-1 ;

   return source ;
}



/* 
 * This routine is not really interesting. You should use the STREAM()
 * built-in function for greater portability and functionality. It is 
 * left in the code for portability reasons. 
 */
#ifdef OLD_REGINA_FEATURES
streng *unx_open( paramboxptr parms )
{
   fileboxptr ptr=NULL ;
   char ch=' ' ;
   int iaccess=ACCESS_NONE ;

   checkparam(  parms,  1,  2 , "OPEN" ) ;
   
   if ((parms->next)&&(parms->next->value)) 
   {
      ch = getoptionchar( parms->next->value, "OPEN", 2, "RW" ) ;
      if ( ch == 'R' ) /* bja */
         iaccess = ACCESS_READ ;
      else if ( ch == 'W' ) /* bja */
         iaccess = ACCESS_WRITE ;
      else
         assert( 0 ) ;
   }
   else
      iaccess = ACCESS_READ ;
   
   parms->value = Str_ify( parms->value ) ;
   ptr = openfile( parms->value, iaccess ) ;

   return int_to_streng(( ptr && ptr->fileptr )) ;
}
#endif


/* 
 * This routine is not really interesting. You should use the CLOSE 
 * command of the STREAM() built-in function for greater portability
 * and compatibility. It is left in the code only for compatibility 
 * reasons.
 */
#ifdef OLD_REGINA_FEATURES
streng *unx_close( paramboxptr parms )
{
   fileboxptr ptr=NULL ;

   checkparam(  parms,  1,  1 , "CLOSE" ) ;
   ptr = getfileptr( parms->value ) ;
   closefile( parms->value ) ;

   return int_to_streng( ptr!=NULL ) ;
}
#endif

/*
 * The code in this function borrows heavily from code supplied by
 * Keith Patton (keith,patton@dssi-jcl.com)
 */
void get_external_routine(char *inname, FILE **fp, char *outname)
{
   static char *extensions[] = {"",".rexx",".rex",".cmd",NULL};
   char *env_path = getenv("REGINA_MACROS");
   char *paths = NULL;
   int i = 0;

   for (i=0;extensions[i]!=NULL && *fp == NULL;i++)
   {
      /*
       * Try the filename without any path first
       */
      strcpy(outname,inname);
      strcat(outname,extensions[i]);
      *fp = fopen(outname, "rb");
      if (*fp != NULL)
         break;

      paths = env_path;
      while (paths && !*fp)
      {
         int pathlen; 
         char *sep;

         while (*paths == PATH_SEPARATOR)
            paths++;
         sep = strchr(paths, PATH_SEPARATOR);
         pathlen = sep ? sep-paths : strlen(paths);
         if (pathlen == 0)
            break; /* no more paths! */
         strncpy(outname, paths, pathlen);
         outname[pathlen] = 0;

         if (outname[pathlen-1] != FILE_SEPARATOR)
            strcat(outname, FILE_SEPARATOR_STR);
         strcat(outname, inname);
         strcat(outname, extensions[i]);
         paths = sep? sep+1 : 0; /* set up for next pass */
         *fp = fopen(outname, "rb");
         if (*fp != NULL)
            break;
      }
   }

   return;
}

void CloseOpenFiles( void )
{
   extern sysinfobox *systeminfo ;
   sysinfobox *ptr = systeminfo;;

   while (ptr)
   {
      if (systeminfo->input_fp)
      {
         fclose(systeminfo->input_fp);
         systeminfo->input_fp = NULL;
      }
      ptr = systeminfo->previous;
   }
   return;
}

#if !defined(HAVE__FULLPATH) && !defined(HAVE_TRUENAME)
/*
 * This function builds up the full pathname of a file
 * It is based heavily on code from splitpath() defined in
 * nonansi.c of Mark Hessling's THE
 */
int my_fullpath( char *dst, char *src, int size )
{
   char tmp[1024];
   char curr_path[1024];
   char path[1024];
   char fname[1024];
   int i = 0, len = -1;
   struct stat stat_buf;

#ifdef __EMX__
   _getcwd2(curr_path,1024);
#else
   getcwd(curr_path,1024);
#endif
   strcpy(tmp,src);
   /*
    * First determine if the supplied filename is a directory.
    */
#ifdef __EMX__
   for ( i = 0; i < strlen( tmp ); i++ )
      if ( tmp[ i ] == '\\' )
         tmp[ i ] = '/';
#endif
   if ((stat(tmp,&stat_buf) == 0)
   &&  (stat_buf.st_mode & S_IFMT) == S_IFDIR)
   {
      strcpy(path,tmp);
      strcpy(fname,"");
   }
   else          /* here if the file doesn't exist or is not a directory */
   {
      for (i=strlen(tmp),len=-1;i>-1;i--)
      {
         if (tmp[i] == '/')
         {
            len = i;
            break;
         }
      }
      switch(len)
      {
         case (-1):
#ifdef __EMX__
            _getcwd2(path,1024);
#else
            getcwd(path,1024);
#endif
            strcpy(fname,tmp);
            break;
         case 0:
            strcpy(path,tmp);
            path[1] = '\0';
            strcpy(fname,tmp+1+len);
            break;
         default:
            strcpy(path,tmp);
            path[len] = '\0';
            strcpy(fname,tmp+1+len);
            break;
      }
   }
   /*
    * Change directory to the supplied path, if possible and store the
    * expanded path.
    * If an error, restore the current path.
    */
#ifdef __EMX__
   if (_chdir2(path) != 0)
   {
      _chdir2(curr_path);
      return(-1);
   }
   _getcwd2(path,1024);
   _chdir2(curr_path);
#else
   if (chdir(path) != 0)
   {
      chdir(curr_path);
      return(-1);
   }
   getcwd(path,1024);
   chdir(curr_path);
#endif
   /*
    * Append the OS directory character to the path if it doesn't already
    * end in the character.
    */
   len = strlen(path);
   if (len > 0)
   {
      if ( path[ len - 1 ] != '/' )
      {
         strcat(path,"/");
         len++;
      }
#ifdef __EMX__
      for ( i = 0; i < len; i++ )
         if ( path[ i ] == '/' )
            path[ i ] = '\\';
#endif
   }
   strcpy(dst,path);
   strcat(dst,fname);
   return(0);
}
#endif