MODULE file_io_example (MAIN = top_level,
                        ADDRESSING_MODE (EXTERNAL = GENERAL)) =

BEGIN

FORWARD ROUTINE
    top_level,                  ! Main routine of this example
    lse_init,                   ! Initialize LSE
    lse_io;                     ! File I/O routine for LSE

!
! Declare the stream data structure passed to the file I/O routine
!

MACRO
    stream_file_id =  0, 0, 32, 0 % ,    ! File ID
    stream_rat =      6, 0,  8, 0 % ,    ! Record attributes
    stream_rfm =      7, 0,  8, 0 % ,    ! Record format
    stream_file_nm =  8, 0,  0, 0 % ;    ! File name descriptor

!
! Declare the routines that would actually do the I/O.  These must be supplied
! in another module
!

EXTERNAL ROUTINE
    my_io_open,                 ! Routine to open a file
    my_io_close,                ! Routine to close a file
    my_io_get_record,           ! Routine to read a record
    my_io_put_record;           ! Routine to write a record
!
! Declare the LSE routines
!

EXTERNAL ROUTINE
    lse$fileio,                 ! LSE's internal file I/O routine
    lse$handler,                ! LSE's condition handler
    lse$initialize,             ! Initialize LSE
    lse$execute_inifile,        ! Execute the initial procedures
    lse$execute_command,        ! Execute an LSE statement
    lse$control,                ! Let user interact with LSE
    lse$cleanup;                ! Have LSE clean up after itself
!
! Declare the LSE literals
!

EXTERNAL LITERAL
    lse$k_close,                ! File I/O operation codes
    lse$k_close_delete,
    lse$k_open,
    lse$k_get,
    lse$k_put,
    lse$_access,                ! File access codes
    lse$k_io,
    lse$k_input,
    lse$k_output,
    lse$_calluser,             ! Item list entry codes
    lse$_fileio,
    lse$_outputfile,
    lse$_sectionfile,
    lse$_commandfile,
    lse$_filename,
    lse$_journalfile,
    lse$_options,
    lse$m_recover,              ! Mask for values in options bit vector
    lse$m_journal,
    lse$m_read,
    lse$m_command,
    lse$m_create,
    lse$m_section,
    lse$m_display,
    lse$m_output,
    lse$m_reset_terminal,       ! Masks for cleanup bit vector
    lse$m_kill_processes,
    lse$m_delete_exith,
    lse$m_last_time,
    tpu$_nofileaccess,          ! DECTPU status codes
    tpu$_openin,
    tpu$_inviocode,
    tpu$_failure,
    tpu$_closein,
    tpu$_closeout,
    tpu$_readerr,
    tpu$_writeerr,
    tpu$_success;

ROUTINE top_level =    BEGIN
!++
! Main entry point of your program
!–
! Your_initialization_routine must be declared as a BPV
    LOCAL
        initialize_bpv: VECTOR [2],
        status,
        cleanup_flags;
    !
    ! First establish the condition handler
    !    ENABLE
        lse$handler ();
    !
    ! Initialize the editing session by passing LSE$INITIALIZE the address of
    ! the bound procedure value that defines the routine that LSE is
    ! to call to return the initialization item list.
    !
    initialize_bpv [0] = lse_init;
    initialize_bpv [1] = 0;
    lse$initialize (initialize_bpv);
    !
    ! Call LSE to execute the contents of the command file, the debug file,
    ! or the LSE$INIT_PROCEDURE from the section file.
    !
    lse$execute_inifile();
    !
    ! Let LSE take over.
    !
    lse$control();
    !
    ! Have LSE clean up after itself.
    !
    cleanup_flags = lse$m_reset_terminal OR     ! Reset the terminal
                    lse$m_kill_processes OR     ! Delete subprocesses
                    lse$m_delete_exith OR       ! Delete the exit handler
                    lse$m_last_time;            ! Last time calling the editor
    lse$cleanup (cleanup_flags);
    RETURN tpu$_success;
    END;

ROUTINE lse_init =
    BEGIN
    !
    ! Allocate the storage block needed to pass the file I/O routine as a
    ! bound procedure variable as well as the bit vector for the initialization
    ! options.
    !
    OWN
        file_io_bpv: VECTOR [2, LONG]
                     INITIAL (LSE_IO, 0),
        options;
    !
    ! These macros define the file names passed to LSE.
    !
    MACRO
        out_file = 'OUTPUT.TPU' % ,
        com_file = 'LSE$COMMAND' % ,
        sec_file = 'LSE$SECTION' % ,
        inp_file = 'FILE.TPU' % ;
    !
    ! Create the item list to pass to LSE.  Each item list entry consists of
    ! two words that specify the size of the item and its code, the address of
    ! the buffer containing the data, and a longword to receive a result (always
    ! zero, since LSE does not return any result values in the item list).
    !
    !               +--------------------------------+
    !               | Item Code      | Item Length   |
    !               +----------------+---------------+
    !               |        Buffer Address          |
    !               +--------------------------------+
    !               |    Return Address (always 0)   |
    !               +--------------------------------+
    !
    ! Remember that the item list is always terminated with a longword containing
    ! a zero.
    !
    BIND
        item_list = UPLIT BYTE (
            WORD (4),                       ! Options bit vector
            WORD (lse$_options),
            LONG (options),
            LONG (0),

            WORD (4),                       ! File I/O routine
            WORD (lse$_fileio),
            LONG (file_io_bpv),
            LONG (0),

            WORD (%CHARCOUNT (out_file)),    ! Output file
            WORD (lse$_outputfile),
            LONG (UPLIT (%ASCII out_file)),
            LONG (0),

            WORD (%CHARCOUNT (com_file)),    ! Command file
            WORD (lse$_commandfile),
            LONG (UPLIT (%ASCII com_file)),
            LONG (0),

            WORD (%CHARCOUNT (sec_file)),   ! Section file
            WORD (lse$_sectionfile),
            LONG (UPLIT (%ASCII sec_file)),
            LONG (0),

            WORD (%CHARCOUNT (inp_file)),    ! Input file
            WORD (lse$_filename),
            LONG (UPLIT (%ASCII inp_file)),
            LONG (0),
            LONG (0));                      ! Terminating longword of 0
    !
    ! Initialize the options bitvector
    !
    options = lse$m_display OR              ! We have a display
              lse$m_section OR              ! We have a section file
              lse$m_create OR               ! Create a new file if one does not
                                            !   exist
              lse$m_command OR              ! We have a section file
              lse$m_output;                 ! We supplied an output file spec
    !
    ! Return the item list as the value of this routine for LSE to interpret.
    !
    RETURN item_list;
    END;                                    ! End of routine lse_init

ROUTINE lse_io (p_opcode, stream: REF BLOCK [ ,byte], data) =
!
! This routine determines how to process a TPU I/O request.
!
    BEGIN
    LOCAL
        status;
!
! Is this one of ours, or do we pass it to LSE's file I/O routines?
!
    IF (..p_opcode NEQ lse$k_open) AND (.stream [stream_file_id] GTR 511)
    THEN
        RETURN lse$fileio (.p_opcode, .stream, .data);
!
! Either we are opening the file, or we know it is one of ours.
! Call the appropriate routine (not shown in this example).
!
    SELECTONE ..p_opcode OF
        SET
        [lse$k_open]:
            status = my_io_open (.stream, .data);
        [lse$k_close, lse$k_close_delete]:
            status = my_io_close (.stream, .data);
        [lse$k_get]:
            status = my_io_get_record (.stream, .data);
        [lse$k_put]:
            status = my_io_put_record (.stream, .data);
        [OTHERWISE]:
            status = tpu$_failure;
        TES;
    RETURN .status;
    END;                                        ! End of routine LSE_IO
END                                             ! End Module file_io_example

C       A sample FORTRAN program that calls LSE to act
C       normally, using the programmable interface.
C
C       IMPLICIT NONE
        INTEGER*4       CLEAN_OPT       !Options for cleanup routine.
        INTEGER*4       STATUS          !Return status from LSE routines.
        INTEGER*4       BPV_PARSE(2)    !Set up a Bound Procedure Value.
        INTEGER*4       LOC_PARSE       !A local function call.
C
C       Declare the LSE functions.
C
        INTEGER*4       LSE$CONTROL
        INTEGER*4       LSE$CLEANUP
        INTEGER*4       LSE$EXECUTE_INIFILE
        INTEGER*4       LSE$INITIALIZE
        INTEGER*4       LSE$CLIPARSE
C
C       Declare a local copy to hold the values of LSE cleanup variables.
C
        INTEGER*4       RESET_TERMINAL
        INTEGER*4       DELETE_JOURNAL
        INTEGER*4       DELETE_BUFFERS,DELETE_WINDOWS
        INTEGER*4       DELETE_EXITH,EXECUTE_PROC
        INTEGER*4       PRUNE_CACHE,KILL_PROCESSES
        INTEGER*4       CLOSE_SECTION
C
C       Declare the LSE functions used as external.
C
        EXTERNAL        LSE$HANDLER
        EXTERNAL        LSE$CLIPARSE
        EXTERNAL        TPU$_SUCCESS    !External error message.
        EXTERNAL        LOC_PARSE       !User-supplied routine to call LSE$CLIPARSE.
C
C       Declare the LSE cleanup variables as external.
C       These are the external literals that hold the
C       value of the options.
C
        EXTERNAL        LSE$M_RESET_TERMINAL
        EXTERNAL        LSE$M_DELETE_JOURNAL
        EXTERNAL        LSE$M_DELETE_BUFFERS,LSE$M_DELETE_WINDOWS
        EXTERNAL        LSE$M_DELETE_EXITH,LSE$M_EXECUTE_PROC
        EXTERNAL        LSE$M_PRUNE_CACHE,LSE$M_KILL_PROCESSES
100     CALL LIB$ESTABLISH ( LSE$HANDLER )       !Establish the condition handler.
C
C       Set up the Bound Procedure Value for the call to LSE$INITIALIZE.
C
        BPV_PARSE( 1 ) = %LOC( LOC_PARSE )
        BPV_PARSE( 2 ) = 0
C
C       Call the LSE initialization routine to do some setup work.
C
        STATUS = LSE$INITIALIZE ( BPV_PARSE )
C
C       Check the status.  If it is not a success, then signal the error.
C
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN
                CALL LIB$SIGNAL( %VAL( STATUS ) )
                GOTO 9999
        ENDIF
C
C       Execute the LSE$_ init files and also a command file if it
C       was specified in the command line call to LSE.
C
        STATUS = LSE$EXECUTE_INIFILE ( )
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN !Make sure everything is ok.
                CALL LIB$SIGNAL( %VAL( STATUS ) )
                GOTO 9999
        ENDIF
C
C       Invoke LSE as it normally would appear.
C
        STATUS = LSE$CONTROL ( )        !Call LSE.
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN !Make sure everything is ok.
                CALL LIB$SIGNAL( %VAL( STATUS ) )
C               GOTO 9999
        ENDIF
C
C       Get the value of the option from the external literals.  In FORTRAN, you
C       cannot use external literals directly so you must first get the value
C       of the literal from its external location.  Here we are getting the
C       values of the options that we want to use in the call to LSE$CLEANUP.
C
        DELETE_JOURNAL  = %LOC ( LSE$M_DELETE_JOURNAL )
        DELETE_EXITH    = %LOC ( LSE$M_DELETE_EXITH )
        DELETE_BUFFERS  = %LOC ( LSE$M_DELETE_BUFFERS )
        DELETE_WINDOWS  = %LOC ( LSE$M_DELETE_WINDOWS )
        EXECUTE_PROC    = %LOC ( LSE$M_EXECUTE_PROC )
        RESET_TERMINAL  = %LOC ( LSE$M_RESET_TERMINAL )
        KILL_PROCESSES  = %LOC ( LSE$M_KILL_PROCESSES )
        CLOSE_SECTION   = %LOC ( LSE$M_CLOSE_SECTION )
C
C       Now that we have the local copies of the variables we can do the
C       logical OR to set the multiple options that we need.
C
        CLEAN_OPT = DELETE_JOURNAL .OR. DELETE_EXITH .OR.
        1       DELETE_BUFFERS .OR. DELETE_WINDOWS .OR. EXECUTE_PROC
        1       .OR. RESET_TERMINAL .OR. KILL_PROCESSES .OR. CLOSE_SECTION
C
C       Do the necessary cleanup.
C       LSE$CLEANUP wants the address of the flags as the parameter so
C       pass the %LOC of CLEAN_OPT, which is the address of the variable.
        STATUS = LSE$CLEANUP ( %LOC ( CLEAN_OPT ) )
        IF ( STATUS .NE. %LOC (TPU$_SUCCESS) ) THEN
                CALL LIB$SIGNAL( %VAL(STATUS) )
        ENDIF
9999    CALL LIB$REVERT         !Go back to normal processing – handlers.
        STOP
        END
C
C
        INTEGER*4  FUNCTION LOC_PARSE
        INTEGER*4       BPV(2)          !A local Bound Procedure Value
        CHARACTER*12    EDIT_COMM       !A command line to send to LSE$CLIPARSE
C
C       Declare the LSE functions used.
C
        INTEGER*4       LSE$FILEIO
        INTEGER*4       LSE$CLIPARSE
C
C       Declare this routine as external because it is never called directly and
C       we need to tell FORTRAN that it is a function and not a variable.
C
        EXTERNAL        LSE$FILEIO        BPV(1) = %LOC(LSE$FILEIO)       !Set up the bound procedure value.
        BPV(2) = 0
        EDIT_COMM(1:12) = 'LSE TEST.TXT'
C
C       Parse the command line and build the item list for LSE$INITIALIZE.
C
9999     LOC_PARSE = LSE$CLIPARSE (EDIT_COMM, BPV , 0)
        RETURN
        END

       PROGRAM  TEST_LSEC
       IMPLICIT NONECC
       Define the expected LSE return statuses.
C
       EXTERNAL        TPU$_SUCCESS
       EXTERNAL        TPU$_QUITTING
       EXTERNAL        TPU$_EXITING
C
C
       Declare the LSE routines and symbols used.
C
       EXTERNAL        LSE$M_DELETE_CONTEXT
       EXTERNAL        LSE$HANDLER
       INTEGER*4       LSE$M_DELETE_CONTEXT
       INTEGER*4       LSE$INITIALIZE
       INTEGER*4       LSE$EXECUTE_INIFILE
       INTEGER*4       LSE$CONTROL
       INTEGER*4       LSE$CLEANUP
C
C      Use LIB$MATCH_COND to compare condition codes.
C
       INTEGER*4
       LIB$MATCH_COND
C
C       Declare the external callback routine.
C
       EXTERNAL        LSE_STARTUP       ! The LSE setup function.
       INTEGER*4       LSE_STARTUP
       INTEGER*4       BPV(2)            ! Set up a Bound Procedure Value.
C
C      Declare the functions used for working with the condition handler.
C
       INTEGER*4       LIB$ESTABLISH
       INTEGER*4       LIB$REVERT
C
C      Local flags and indices
C
       INTEGER*4       CLEANUP_FLAG       ! Flag(s) for LSE cleanup.
       INTEGER*4       RET_STATUS
       INTEGER*4       MATCH_STATUS
C
C      Initializations
C
       RET_STATUS       = 0
       CLEANUP_FLAG     = %LOC(LSE$M_DELETE_CONTEXT)
C
C      Establish the default LSE condition handler.
C
       CALL LIB$ESTABLISH(%REF(LSE$HANDLER))
C
C      Set up the Bound Procedure Value for the initialization callback.
C
       BPV(1)  =  %LOC (LSE_STARTUP)       BPV(2)  =  0
C
C      Call the LSE procedure for initialization.
C
       RET_STATUS = LSE$INITIALIZE(BPV)
       IF (RET_STATUS .NE. %LOC(TPU$_SUCCESS)) THEN
       CALL LIB$SIGNAL (%VAL(RET_STATUS))
       ENDIFCC      Execute the LSE initialization file.
C
       RET_STATUS = LSE$EXECUTE_INIFILE()
       IF (RET_STATUS .NE. %LOC(TPU$_SUCCESS)) THEN
       CALL LIB$SIGNAL (%VAL(RET_STATUS))
       ENDIF
C
C      Pass control to LSE.
C
       RET_STATUS = LSE$CONTROL()
C
C      Test for valid exit condition codes.  You must use LIB$MATCH_COND
C      because the severity of TPU$_QUITTING can be set by the LSE
C      application.
C
       MATCH_STATUS = LIB$MATCH_COND (RET_STATUS, %LOC (TPU$_QUITTING),
       1                                          %LOC (TPU$_EXITING))
       IF (MATCH_STATUS .EQ. 0) THEN       CALL LIB$SIGNAL (%VAL(RET_STATUS))
       ENDIF
C
C      Clean up after processing.
C
       RET_STATUS = LSE$CLEANUP(%REF(CLEANUP_FLAG))
       IF (RET_STATUS .NE. %LOC(TPU$_SUCCESS)) THEN
       CALL LIB$SIGNAL (%VAL(RET_STATUS))
       ENDIF
C
C      Set the condition handler back to the default.
C
       RET_STATUS = LIB$REVERT()
       END
       INTEGER*4 FUNCTION LSE_STARTUP
       IMPLICIT NONE
       INTEGER*4
       OPTION_MASK
       ! Temporary variable for LSE
       CHARACTER*44
       SECTION_NAME   ! Temporary variable for LSE
C
C      External LSE routines and symbols.
C
       EXTERNAL        LSE$K_OPTIONS
       EXTERNAL        LSE$M_READ
       EXTERNAL        LSE$M_SECTION
       EXTERNAL        LSE$M_DISPLAY
       EXTERNAL        LSE$K_SECTIONFILE
       EXTERNAL        LSE$K_FILEIO
       EXTERNAL        LSE$FILEIO
       INTEGER*4       LSE$FILEIO
C
C      The bound procedure value used for setting up the file I/O routine.
C
       INTEGER*4       BPV(2)
C
C
       Define the structure of the item list defined for the callback.
C
       STRUCTURE /CALLBACK/
       INTEGER*2       BUFFER_LENGTH
       INTEGER*2       ITEM_CODE
       INTEGER*4       BUFFER_ADDRESS
       INTEGER*4       RETURN_ADDRESS
       END STRUCTURE
C
C      There are a total of four items in the item list.
C
       RECORD /CALLBACK/ CALLBACK (4)
C
C      Make sure it is not optimized!
C
       VOLATILE /CALLBACK/
C
C
       Define the options we want to use in the LSE session.
C
       OPTION_MASK = %LOC(LSE$M_SECTION) .OR. %LOC(LSE$M_READ)
       1
       .OR. %LOC(LSE$M_DISPLAY)
C
C      Define the name of the initialization section file.
C
       SECTION_NAME = 'LSE$SECTION'
C
C      Set up the required I/O routine.  Use the LSE default.
C
       BPV(1) = %LOC(LSE$FILEIO)
       BPV(2) = 0
C
C      Build the callback item list.
C
C      Set up the edit session options.
C
       CALLBACK(1).ITEM_CODE = %LOC(LSE$K_OPTIONS)
       CALLBACK(1).BUFFER_ADDRESS = %LOC(OPTION_MASK)
       CALLBACK(1).BUFFER_LENGTH = 4
       CALLBACK(1).RETURN_ADDRESS = 0
C
C      Identify the section file to be used.
C
       CALLBACK(2).ITEM_CODE = %LOC(LSE$K_SECTIONFILE)
       CALLBACK(2).BUFFER_ADDRESS = %LOC(SECTION_NAME)
       CALLBACK(2).BUFFER_LENGTH = LEN(SECTION_NAME)
       CALLBACK(2).RETURN_ADDRESS = 0
C
C      Set up the I/O handler.
C
       CALLBACK(3).ITEM_CODE = %LOC(LSE$K_FILEIO)
       CALLBACK(3).BUFFER_ADDRESS = %LOC(BPV)
       CALLBACK(3).BUFFER_LENGTH = 4
       CALLBACK(3).RETURN_ADDRESS = 0
C
C      End the item list with zeros to indicate we are finished.
C
       CALLBACK(4).ITEM_CODE = 0
       CALLBACK(4).BUFFER_ADDRESS = 0
       CALLBACK(4).BUFFER_LENGTH = 0
       CALLBACK(4).RETURN_ADDRESS = 0
C
C      Return the address of the item list.
C
       LSE_STARTUP = %LOC(CALLBACK)
       RETURN
       END

/*
Simple example of a C program to invoke LSE.  This program provides its
own FILEIO routine instead of using the one provided by LSE.
*/

#include descrip
#include stdio

/* Data structures needed */

struct bpv_arg                  /* Bound procedure value */
    {
    int *routine_add ;          /* Pointer to routine */
    int env ;                   /* Environment pointer */
    } ;
struct item_list_entry          /* Item list data structure */
    {
    short int buffer_length;
    /* Buffer length */
    short int item_code;        /* Item code */
    int *buffer_add;            /* Buffer address */
    int *return_len_add;        /* Return address */
    } ;
struct stream_type
    {
    int ident;                  /* Stream id */
    short int alloc;            /* File size */
    short int flags;            /* File record attributes/format */
    short int length;           /* Resultant file name length */
    short int stuff;            /* File name descriptor class & type */
    int nam_add;                /* File name descriptor text pointer */
    } ;
globalvalue tpu$_success;       /* TPU Success code */
globalvalue tpu$_quitting;      /* Exit code defined by TPU */
globalvalue                     /* Cleanup codes defined by LSE */
    lse$m_delete_journal, lse$m_delete_exith,
    lse$m_delete_buffers, lse$m_delete_windows, lse$m_delete_cache,
    lse$m_prune_cache, lse$m_execute_file, lse$m_execute_proc,
    lse$m_delete_context, lse$m_reset_terminal, lse$m_kill_processes,
    lse$m_close_section, lse$m_delete_others, lse$m_last_time;
globalvalue                     /* Item codes for item list entries */
    lse$k_fileio, lse$k_options, lse$k_sectionfile,
    lse$k_commandfile ;
globalvalue                     /* Option codes for option item */
    lse$m_display, lse$m_section, lse$m_command, lse$m_create ;
globalvalue                     /* Possible item codes in item list */
    lse$_access, lse$_filename, lse$_defaultfile,
    lse$_relatedfile, lse$_record_attr, lse$_maximize_ver,
    lse$_flush, lse$_filesize;
globalvalue                     /* Possible access types for lse$_access */
    lse$k_io, lse$k_input, lse$k_output;
globalvalue                     /* RMS File Not Found message code */
    rms$_fnf;
globalvalue                     /* FILEIO routine functions */
    lse$k_open, lse$k_close, lse$k_close_delete,
    lse$k_get, lse$k_put;
int lib$establish ();           /* RTL routine to establish an event handler */
int lse$cleanup ();             /* LSE routine to free resources used */
int lse$control ();             /* LSE routine to invoke the editor */
int lse$execute_inifile ();     /* LSE routine to execute initialization code */
int lse$handler ();             /* LSE signal handling routine */
int lse$initialize ();          /* LSE routine to initialize the editor */

/*
   This function opens a file for either read or write access, based on
   the item list passed as the data parameter.  Note that a full implementation
   of the file open routine would have to handle the default file, related
   file, record attribute, maximize version, flush and file size item code
   properly.
 */
open_file (data, stream)

int *data;
struct stream_type *stream;
{
    struct item_list_entry *item;
    char *access;               /* File access type */
    char filename[256];         /* Max file specification size */
    FILE *fopen();
    /* Process the item list */
    item = data;
    while (item->item_code != 0 && item->buffer_length != 0)
        {
        if (item->item_code == lse$_access)
            {
            if (item->buffer_add == lse$k_io) access = "r+";
            else if (item->buffer_add == lse$k_input) access = "r";
            else if (item->buffer_add == lse$k_output) access = "w";
            }
        else if (item->item_code == lse$_filename)
            {
            strncpy (filename, item->buffer_add, item->buffer_length);
            filename [item->buffer_length] = 0;
            lib$scopy_r_dx (&item->buffer_length, item->buffer_add,
                                                        &stream->length);
            }
        else if (item->item_code == lse$_defaultfile)
            {
                           /* Add code to handle default file  */
            }
                           /* spec here                        */
        else if (item->item_code == lse$_relatedfile)
            {
                           /* Add code to handle related       */
            }
                           /* file spec here                   */
        else if (item->item_code == lse$_record_attr)
            {
                           /* Add code to handle record        */
            }
                           /* attributes for creating files    */
        else if (item->item_code == lse$_maximize_ver)
            {
                           /* Add code to maximize version     */
            }
                           /* number with existing file here   */
        else if (item->item_code == lse$_flush)
            {
                           /* Add code to cause each record    */
            }
                           /* to be flushed to disk as written */
        else if (item->item_code == lse$_filesize)
            {
                           /* Add code to handle specification */
            }
                           /* of initial file allocation here  */
        ++item;
         /* get next item */
        }
    stream->ident = fopen(filename,access);
    if (stream->ident != 0)
        return tpu$_success;
    else
        return rms$_fnf;}
/*
  This procedure closes a file.
 */
close_file (data,stream)
struct stream_type *stream;

{
    close(stream->ident);
    return tpu$_success;
}
/*
  This procedure reads a line from a file.
 */
read_line(data,stream)
struct dsc$descriptor *data;
struct stream_type *stream;
{
    char textline[984];                 /* Max line size for TPU records */
    int len;
    globalvalue rms$_eof;               /* RMS End-Of-File code */
    if (fgets(textline,984,stream->ident) == NULL)
        return rms$_eof;
    else
        {
        len = strlen(textline);
        if (len > 0)            len = len - 1;
        return lib$scopy_r_dx (&len, textline, data);
        }
}
/*
  This procedure writes a line to a file.
 */
write_line(data,stream)
struct dsc$descriptor *data;
struct stream_type *stream;
{
    char textline[984];                 /* Max line size for TPU records */
    strncpy (textline, data->dsc$a_pointer, data->dsc$w_length);
    textline [data->dsc$w_length] = 0;
    fputs(textline,stream->ident);
    fputs("\n",stream->ident);
    return tpu$_success;
}
/*
   This procedure will handle I/O for LSE.
 */
fileio(code,stream,data)
int *code;
int *stream;
int *data;
{
    int status;
/* Dispatch based on code type.  Note that a full implementation of the      */
/* file I/O routines would have to handle the close and delete code properly */
/* instead of simply closing the file.                                        */
    if (*code == lse$k_open)                    /* Initial access to file */
        status = open_file (data,stream);
    else if (*code == lse$k_close)              /* End access to file */
        status = close_file (data,stream);
    else if (*code == lse$k_close_delete)       /* Treat same as close */
        status = close_file (data,stream);
    else if (*code == lse$k_get)                /* Read a record from a file */
        status = read_line (data,stream);
    else if (*code == lse$k_put)                /* Write a record to a file */
        status = write_line (data,stream);
    else
        {                                       /* Who knows what we got? */
        status = tpu$_success;
        printf ("Bad FILEIO I/O function requested");
        }
    return status;
}
/*
   This procedure formats the initialization item list and returns it as
   a return value.
 */
callrout()
{
    static struct bpv_arg add_block =
        { fileio, 0 } ;         /* BPV for fileio routine */
    int options ;    char *section_name = "LSE$SECTION";
    static struct item_list_entry arg[] =
        {/* length code              buffer add return add */
               { 4,lse$k_fileio,     0,         0 },
               { 4,lse$k_options,    0,         0 },
               { 0,lse$k_sectionfile,0,         0 },
               { 0,0,                0,         0 }
        };
    /* Setup file I/O routine item entry */
    arg[0].buffer_add = &add_block;

    /* Setup options item entry.  Leave journaling off. */
    options = lse$m_display | lse$m_section;
    arg[1].buffer_add = &options;

    /* Setup section file name */
    arg[2].buffer_length = strlen(section_name);
    arg[2].buffer_add = section_name;
    return arg;
}

/*
   Main program.  Initializes LSE, then passes control to it.
 */main()

{
    int return_status ;
    int cleanup_options;
    struct bpv_arg add_block;
/* Establish as condition handler the normal LSE handler */
    lib$establish(lse$handler);
/* Setup a BPV to point to the callback routine */
    add_block.routine_add = callrout ;
    add_block.env = 0;
/* Do the initialize of LSE */
    return_status = lse$initialize(&add_block);
    if (!return_status)
        exit(return_status);
/* Have LSE execute the procedure LSE$INIT_PROCEDURE from the section file */
/* and then compile and execute the code from the command file */
    return_status = lse$execute_inifile();
    if (!return_status)
        exit (return_status);
/*
 Turn control over to LSE
 */
    return_status = lse$control ();
    if (!return_status)
        exit(return_status);
/*
 Now clean up.
 */
    cleanup_options = lse$m_last_time | lse$m_delete_context;
    return_status = lse$cleanup (&cleanup_options);
    exit (return_status);
    printf("Experiment complete");
}