Document revision date: 30 March 2001
[Compaq] [Go to the documentation home page] [How to order documentation] [Help on this site] [How to contact us]
[OpenVMS documentation]

OpenVMS Utility Routines Manual


Previous Contents Index

8.3.1 Main Callable DECTPU Utility Routines

The following callable DECTPU routines are described in this chapter:

Note

Before calling any of these routines, you must establish TPU$HANDLER or provide your own condition handler. See the routine description of TPU$HANDLER in this chapter and the OpenVMS Calling Standard for information about establishing a condition handler.

8.3.2 Other DECTPU Utility Routines

The full callable interface includes several utility routines for which you can provide parameters. Depending on your application, you might be able to use these routines rather than write your own routines. These DECTPU utility routines and their descriptions follow:

Note that TPU$CLIPARSE and TPU$PARSEINFO destroy the context maintained by the CLI$ routines for parsing commands.

8.3.3 User-Written Routines

This section defines the requirements for user-written routines. When these routines are passed to DECTPU, they must be passed as bound procedure values. (See Section 8.1.3 for a description of bound procedure values.) Depending on your application, you might have to write one or all of the following routines:

8.4 Using the DECTPU Routines: Examples

Example 8-1, Example 8-2, Example 8-3, and Example 8-4 use callable DECTPU. These examples are included here for illustrative purposes only; Compaq does not assume responsibility for supporting these examples.

Example 8-1 Sample VAX BLISS Template for Callable DECTPU

MODULE file_io_example (MAIN = top_level, 
                        ADDRESSING_MODE (EXTERNAL = GENERAL)) = 
 
BEGIN 
 
FORWARD ROUTINE 
    top_level,                  ! Main routine of this example 
    tpu_init,                   ! Initialize TPU 
    tpu_io;                     ! File I/O routine for TPU 
! 
! 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 DECTPU routines 
! 
EXTERNAL ROUTINE 
    tpu$fileio,                 ! DECTPU's internal file I/O routine 
    tpu$handler,                ! DECTPU's condition handler 
    tpu$initialize,             ! Initialize DECTPU 
    tpu$execute_inifile,        ! Execute the initial procedures 
    tpu$execute_command,        ! Execute a DECTPU statement 
    tpu$control,                ! Let user interact with DECTPU 
    tpu$cleanup;                ! Have DECTPU cleanup after itself 
! 
! Declare the DECTPU literals 
! 
EXTERNAL LITERAL 
    tpu$k_close,                ! File I/O operation codes 
    tpu$k_close_delete, 
    tpu$k_open, 
    tpu$k_get, 
    tpu$k_put, 
 
    tpu$k_access,               ! File access codes 
    tpu$k_io, 
    tpu$k_input, 
    tpu$k_output, 
 
    tpu$_calluser,             ! Item list entry codes 
    tpu$_fileio, 
    tpu$_outputfile, 
    tpu$_sectionfile, 
    tpu$_commandfile, 
    tpu$_filename, 
    tpu$_journalfile, 
    tpu$_options, 
 
    tpu$m_recover,              ! Mask for values in options bitmask 
    tpu$m_journal, 
    tpu$m_read, 
    tpu$m_command, 
    tpu$m_create, 
    tpu$m_section, 
    tpu$m_display, 
    tpu$m_output, 
 
    tpu$m_reset_terminal,       ! Masks for cleanup bitmask 
    tpu$m_kill_processes, 
    tpu$m_delete_exith, 
    tpu$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 
        tpu$handler (); 
    ! 
    ! Initialize the editing session, passing TPU$INITIALIZE the address of 
    ! the bound procedure value which defines the routine which DECTPU is 
    ! to call to return the initialization item list 
    ! 
    initialize_bpv [0] = tpu_init; 
    initialize_bpv [1] = 0; 
    tpu$initialize (initialize_bpv); 
    ! 
    ! Call DECTPU to execute the contents of the command file, the debug file 
    ! or the TPU$INIT_PROCEDURE from the section file. 
    ! 
    tpu$execute_inifile(); 
    ! 
    ! Let DECTPU take over. 
    ! 
    tpu$control(); 
    ! 
    ! Have DECTPU cleanup after itself 
    ! 
    cleanup_flags = tpu$m_reset_terminal OR     ! Reset the terminal 
                    tpu$m_kill_processes OR     ! Delete Subprocesses 
                    tpu$m_delete_exith OR       ! Delete the exit handler 
                    tpu$m_last_time;            ! Last time calling the editor 
 
    tpu$cleanup (cleanup_flags); 
 
    RETURN tpu$_success; 
 
    END; 
ROUTINE tpu_init = 
 
    BEGIN 
 
    ! 
    ! Allocate the storage block needed to pass the file I/O routine as a 
    ! bound procedure variable as well as the bitmask for the initialization 
    ! options 
    ! 
    OWN 
        file_io_bpv: VECTOR [2, LONG] 
                     INITIAL (TPU_IO, 0), 
        options; 
    ! 
    ! These macros define the file names passed to DECTPU 
    ! 
    MACRO 
        out_file = 'OUTPUT.TPU' % , 
        com_file = 'TPU$COMMAND' % , 
        sec_file = 'TPU$SECTION' % , 
        inp_file = 'FILE.TPU' % ; 
    
    ! 
    ! Create the item list to pass to DECTPU.  Each item list entry consists of 
    ! two words which 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 DECTPU 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 bitmask 
            WORD (tpu$_options), 
            LONG (options), 
            LONG (0), 
 
            WORD (4),                       ! File I/O routine 
            WORD (tpu$_fileio), 
            LONG (file_io_bpv), 
            LONG (0), 
 
            WORD (%CHARCOUNT (out_file)),    ! Output file 
            WORD (tpu$_outputfile), 
            LONG (UPLIT (%ASCII out_file)), 
            LONG (0), 
 
            WORD (%CHARCOUNT (com_file)),    ! Command file 
            WORD (tpu$_commandfile), 
            LONG (UPLIT (%ASCII com_file)), 
            LONG (0), 
 
            WORD (%CHARCOUNT (sec_file)),   ! Section file 
            WORD (tpu$_sectionfile), 
            LONG (UPLIT (%ASCII sec_file)), 
            LONG (0), 
 
            WORD (%CHARCOUNT (inp_file)),    ! Input file 
            WORD (tpu$_filename), 
            LONG (UPLIT (%ASCII inp_file)), 
            LONG (0), 
 
            LONG (0));                      ! Terminating longword of 0 
    ! 
    ! Initialize the options bitmask 
    ! 
    options = tpu$m_display OR              ! We have a display 
              tpu$m_section OR              ! We have a section file 
              tpu$m_create OR               ! Create a new file if one does not 
                                            !   exist 
              tpu$m_command OR              ! We have a section file 
              tpu$m_output;                 ! We supplied an output file spec 
 
    ! 
    ! Return the item list as the value of this routine for DECTPU to interpret 
    ! 
    RETURN item_list; 
 
    END;                                    ! End of routine tpu_init 
ROUTINE tpu_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 TPU's file I/O routines? 
! 
    IF (..p_opcode NEQ tpu$k_open) AND (.stream [stream_file_id] GTR 511) 
    THEN 
        RETURN tpu$fileio (.p_opcode, .stream, .data); 
 
! 
! Either we're opening the file, or we know it's one of ours 
! Call the appropriate routine (not shown in this example) 
! 
    SELECTONE ..p_opcode OF 
        SET 
 
        [tpu$k_open]: 
            status = my_io_open (.stream, .data); 
 
        [tpu$k_close, tpu$k_close_delete]: 
            status = my_io_close (.stream, .data); 
 
        [tpu$k_get]: 
            status = my_io_get_record (.stream, .data); 
 
        [tpu$k_put]: 
            status = my_io_put_record (.stream, .data); 
 
        [OTHERWISE]: 
            status = tpu$_failure; 
 
        TES; 
 
    RETURN .status; 
 
    END;                                        ! End of routine TPU_IO 
 
END                                             ! End Module file_io_example 
 
ELUDOM 
Example 8-2 shows normal DECTPU setup in Compaq Fortran.

Example 8-2 Normal DECTPU Setup in Compaq Fortran

C       A sample Fortran program that calls DECTPU to act 
C       normally, using the programmable interface. 
C 
C       IMPLICIT NONE 
 
        INTEGER*4       CLEAN_OPT       !options for clean up routine 
        INTEGER*4       STATUS          !return status from DECTPU routines 
        INTEGER*4       BPV_PARSE(2)    !set up a bound procedure value 
        INTEGER*4       LOC_PARSE       !a local function call 
C       declare the DECTPU functions 
 
        INTEGER*4       TPU$CONTROL 
        INTEGER*4       TPU$CLEANUP 
        INTEGER*4       TPU$EXECUTE_INIFILE 
        INTEGER*4       TPU$INITIALIZE 
        INTEGER*4       TPU$CLIPARSE 
C       declare a local copy to hold the values of DECTPU cleanup variables 
 
        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       declare the DECTPU functions used as external 
 
        EXTERNAL        TPU$HANDLER 
        EXTERNAL        TPU$CLIPARSE 
 
        EXTERNAL        TPU$_SUCCESS    !external error message 
 
        EXTERNAL        LOC_PARSE       !user supplied routine to 
C                                       call TPUCLIPARSE and setup 
C       declare the DECTPU cleanup variables as external these are the 
C       external literals that hold the value of the options 
 
        EXTERNAL        TPU$M_RESET_TERMINAL 
        EXTERNAL        TPU$M_DELETE_JOURNAL 
        EXTERNAL        TPU$M_DELETE_BUFFERS,TPU$M_DELETE_WINDOWS 
        EXTERNAL        TPU$M_DELETE_EXITH,TPU$M_EXECUTE_PROC 
        EXTERNAL        TPU$M_PRUNE_CACHE,TPU$M_KILL_PROCESSES 
 
100     CALL LIB$ESTABLISH ( TPU$HANDLER )       !establish the condition handler 
C       set up the bound procedure value for the call to TPU$INITIALIZE 
 
        BPV_PARSE( 1 ) = %LOC( LOC_PARSE ) 
        BPV_PARSE( 2 ) = 0 
C       call the DECTPU initialization routine to do some set up work 
 
        STATUS = TPU$INITIALIZE ( BPV_PARSE ) 
 
C       Check the status if it is not a success then signal the error 
 
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN 
 
                CALL LIB$SIGNAL( %VAL( STATUS ) ) 
                GOTO 9999 
 
        ENDIF 
C       execute the TPU$_ init files and also a command file if it 
C       was specified in the command line call to DECTPU 
 
        STATUS = TPU$EXECUTE_INIFILE ( ) 
 
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN !make sure everything is ok 
 
                CALL LIB$SIGNAL( %VAL( STATUS ) ) 
                GOTO 9999 
 
        ENDIF 
C       invoke the editor as it normally would appear 
 
        STATUS = TPU$CONTROL ( )        !call the DECTPU editor 
 
        IF ( STATUS .NE. %LOC ( TPU$_SUCCESS ) ) THEN !make sure everything is ok 
 
                CALL LIB$SIGNAL( %VAL( STATUS ) ) 
C               GOTO 9999 
        ENDIF 
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 TPU$CLEANUP. 
 
        DELETE_JOURNAL  = %LOC ( TPU$M_DELETE_JOURNAL ) 
        DELETE_EXITH    = %LOC ( TPU$M_DELETE_EXITH ) 
        DELETE_BUFFERS  = %LOC ( TPU$M_DELETE_BUFFERS ) 
        DELETE_WINDOWS  = %LOC ( TPU$M_DELETE_WINDOWS ) 
        EXECUTE_PROC    = %LOC ( TPU$M_EXECUTE_PROC ) 
        RESET_TERMINAL  = %LOC ( TPU$M_RESET_TERMINAL ) 
        KILL_PROCESSES  = %LOC ( TPU$M_KILL_PROCESSES ) 
        CLOSE_SECTION   = %LOC ( TPU$M_CLOSE_SECTION ) 
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. 
 
        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       do the necessary clean up 
C       TPU$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 = TPU$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 TPU$CLIPARSE 
C       Declare the DECTPU functions used 
 
        INTEGER*4       TPU$FILEIO 
        INTEGER*4       TPU$CLIPARSE 
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 
 
        EXTERNAL        TPU$FILEIO 
 
        BPV(1) = %LOC(TPU$FILEIO)       !set up the bound procedure value 
        BPV(2) = 0 
 
        EDIT_COMM(1:12) = 'TPU TEST.TXT' 
C       parse the command line and build the item list for TPU$INITIALIZE 
9999     LOC_PARSE = TPU$CLIPARSE (EDIT_COMM, BPV , 0) 
 
        RETURN 
        END 
 
Example 8-3 shows how to build a callback item list with Compaq Fortran.

Example 8-3 Building a Callback Item List with Compaq Fortran

       PROGRAM  TEST_TPU 
C 
       IMPLICIT NONE 
C 
C       Define the expected DECTPU return statuses 
C 
       EXTERNAL        TPU$_SUCCESS 
       EXTERNAL        TPU$_QUITTING 
       EXTERNAL        TPU$_EXITING 
C 
C       Declare the DECTPU routines and symbols used 
C 
       EXTERNAL        TPU$M_DELETE_CONTEXT 
       EXTERNAL        TPU$HANDLER 
       INTEGER*4       TPU$M_DELETE_CONTEXT 
       INTEGER*4       TPU$INITIALIZE 
       INTEGER*4       TPU$EXECUTE_INIFILE 
       INTEGER*4       TPU$CONTROL 
       INTEGER*4       TPU$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        TPU_STARTUP       ! the DECTPU set-up function 
       INTEGER*4       TPU_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 DECTPU cleanup 
       INTEGER*4       RET_STATUS 
       INTEGER*4       MATCH_STATUS 
C 
C      Initializations 
C 
       RET_STATUS       = 0 
       CLEANUP_FLAG     = %LOC(TPU$M_DELETE_CONTEXT) 
C 
C      Establish the default DECTPU condition handler 
C 
       CALL LIB$ESTABLISH(%REF(TPU$HANDLER)) 
C 
C      Set up the bound procedure value for the initialization callback 
C 
       BPV(1)  =  %LOC (TPU_STARTUP) 
       BPV(2)  =  0 
C 
C      Call the DECTPU procedure for initialization 
C 
       RET_STATUS = TPU$INITIALIZE(BPV) 
 
       IF (RET_STATUS .NE. %LOC(TPU$_SUCCESS)) THEN 
       CALL LIB$SIGNAL (%VAL(RET_STATUS)) 
       ENDIF 
C 
C      Execute the DECTPU initialization file 
C 
       RET_STATUS = TPU$EXECUTE_INIFILE() 
 
       IF (RET_STATUS .NE. %LOC(TPU$_SUCCESS)) THEN 
       CALL LIB$SIGNAL (%VAL(RET_STATUS)) 
       ENDIF 
C 
C      Pass control to DECTPU 
C 
       RET_STATUS = TPU$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 TPU 
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 = TPU$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 TPU_STARTUP 
 
       IMPLICIT NONE 
 
       INTEGER*4       OPTION_MASK       ! temporary variable for DECTPU 
       CHARACTER*44       SECTION_NAME   ! temporary variable for DECTPU 
C 
C      External DECTPU routines and symbols 
C 
       EXTERNAL        TPU$K_OPTIONS 
       EXTERNAL        TPU$M_READ 
       EXTERNAL        TPU$M_SECTION 
       EXTERNAL        TPU$M_DISPLAY 
       EXTERNAL        TPU$K_SECTIONFILE 
       EXTERNAL        TPU$K_FILEIO 
       EXTERNAL        TPU$FILEIO 
       INTEGER*4       TPU$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 DECTPU session 
C 
       OPTION_MASK = %LOC(TPU$M_SECTION) .OR. %LOC(TPU$M_READ) 
       1       .OR. %LOC(TPU$M_DISPLAY) 
C 
C      Define the name of the initialization section file 
C 
       SECTION_NAME = 'TPU$SECTION' 
C 
C      Set up the required I/O routine.  Use the DECTPU default. 
C 
       BPV(1) = %LOC(TPU$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(TPU$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(TPU$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(TPU$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 
       TPU_STARTUP = %LOC(CALLBACK) 
 
       RETURN 
       END 
Example 8-4 shows how to specify a user-written file I/O routine in VAX C.

Example 8-4 Specifying a User-Written File I/O Routine in VAX C

/* 
Segment of a simple VAX C program to invoke DECTPU.  This program provides its 
own FILEIO routine instead of using the one provided by DECTPU. This program 
will run correctly if you write the routines it calls. 
*/ 
 
/* 
** To compile this example use the command: 
$ CC <file-name> 
 
** To link this example after a successful compilation: 
 
$ LINK <file-name>,sys$input/ 
SYS$LIBRARY:VAXCRTL/SHARE 
<PRESS-Ctrl/Z> 
 
The TPUSHR shareable image is found by the linker in IMAGELIB.OLB. 
 
*/ 
#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 TPU */ 
    tpu$m_delete_journal, tpu$m_delete_exith, 
    tpu$m_delete_buffers, tpu$m_delete_windows, tpu$m_delete_cache, 
    tpu$m_prune_cache, tpu$m_execute_file, tpu$m_execute_proc, 
    tpu$m_delete_context, tpu$m_reset_terminal, tpu$m_kill_processes, 
    tpu$m_close_section, tpu$m_delete_others, tpu$m_last_time; 
globalvalue                     /* Item codes for item list entries */ 
    tpu$k_fileio, tpu$k_options, tpu$k_sectionfile, 
    tpu$k_commandfile ; 
globalvalue                     /* Option codes for option item */ 
    tpu$m_display, tpu$m_section, tpu$m_command, tpu$m_create ; 
 
globalvalue                     /* Possible item codes in item list */ 
    tpu$k_access, tpu$k_filename, tpu$k_defaultfile, 
    tpu$k_relatedfile, tpu$k_record_attr, tpu$k_maximize_ver, 
    tpu$k_flush, tpu$k_filesize; 
 
globalvalue                     /* Possible access types for tpu$k_access */ 
    tpu$k_io, tpu$k_input, tpu$k_output; 
 
globalvalue                     /* OpenVMS RMS File Not Found message code */ 
    rms$_fnf; 
globalvalue                     /* FILEIO routine functions */ 
    tpu$k_open, tpu$k_close, tpu$k_close_delete, 
    tpu$k_get, tpu$k_put; 
int lib$establish ();           /* RTL routine to establish an event handler */ 
int tpu$cleanup ();             /* TPU routine to free resources used */ 
int tpu$control ();             /* TPU routine to invoke the editor */ 
int tpu$execute_inifile ();     /* TPU routine to execute initialization code */ 
int tpu$handler ();             /* TPU signal handling routine */ 
int tpu$initialize ();          /* TPU routine to initialize the editor */ 
 
/* 
   This function opens a file for either read or write access, based upon 
   the itemlist 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 == tpu$k_access) 
            { 
            if (item->buffer_add == tpu$k_io) access = "r+"; 
            else if (item->buffer_add == tpu$k_input) access = "r"; 
            else if (item->buffer_add == tpu$k_output) access = "w"; 
            } 
        else if (item->item_code == tpu$k_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 == tpu$k_defaultfile) 
            {                           /* Add code to handle default file  */ 
            }                           /* spec here                        */ 
        else if (item->item_code == tpu$k_relatedfile) 
            {                           /* Add code to handle related       */ 
            }                           /* file spec here                   */ 
        else if (item->item_code == tpu$k_record_attr) 
            {                           /* Add code to handle record        */ 
            }                           /* attributes for creating files    */ 
        else if (item->item_code == tpu$k_maximize_ver) 
            {                           /* Add code to maximize version     */ 
            }                           /* number with existing file here   */ 
        else if (item->item_code == tpu$k_flush) 
            {                           /* Add code to cause each record    */ 
            }                           /* to be flushed to disk as written */ 
        else if (item->item_code == tpu$k_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 TPU 
 */ 
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 == tpu$k_open)                    /* Initial access to file */ 
        status = open_file (data,stream); 
    else if (*code == tpu$k_close)              /* End access to file */ 
        status = close_file (data,stream); 
    else if (*code == tpu$k_close_delete)       /* Treat same as close */ 
        status = close_file (data,stream); 
    else if (*code == tpu$k_get)                /* Read a record from a file */ 
        status = read_line (data,stream); 
    else if (*code == tpu$k_put)                /* Write a record to a file */ 
        status = write_line (data,stream); 
    else 
        {                                       /* Who knows what we have? */ 
        status = tpu$_success; 
        printf ("Bad FILEIO I/O function requested"); 
        } 
    return status; 
} 
/* 
   This procedure formats the initialization item list and returns it as 
   its return value. 
 */ 
callrout() 
{ 
    static struct bpv_arg add_block = 
        { fileio, 0 } ;         /* BPV for fileio routine */ 
    int options ; 
    char *section_name = "TPU$SECTION"; 
    static struct item_list_entry arg[] = 
        {/* length code              buffer add return add */ 
               { 4,tpu$k_fileio,     0,         0 }, 
               { 4,tpu$k_options,    0,         0 }, 
               { 0,tpu$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 = tpu$m_display | tpu$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 TPU, then passes control to it. 
 */ 
main() 
{ 
    int return_status ; 
    int cleanup_options; 
    struct bpv_arg add_block; 
 
/* Establish as condition handler the normal DECTPU handler */ 
 
    lib$establish(tpu$handler); 
 
/* Setup a BPV to point to the callback routine */ 
 
    add_block.routine_add = callrout ; 
    add_block.env = 0; 
 
/* Do the initialize of DECTPU */ 
 
    return_status = tpu$initialize(&add_block); 
    if (!return_status) 
        exit(return_status); 
 
/* Have TPU execute the procedure TPU$INIT_PROCEDURE from the section file */ 
/* and then compile and execute the code from the command file */ 
 
    return_status = tpu$execute_inifile(); 
    if (!return_status) 
        exit (return_status); 
 
/* Turn control over to DECTPU */ 
 
    return_status = tpu$control (); 
    if (!return_status) 
        exit(return_status); 
 
/* Now clean up. */ 
 
    cleanup_options = tpu$m_last_time | tpu$m_delete_context; 
    return_status = tpu$cleanup (&cleanup_options); 
    exit (return_status); 
 
    printf("Experiment complete"); 
} 


Previous Next Contents Index

  [Go to the documentation home page] [How to order documentation] [Help on this site] [How to contact us]  
  privacy and legal statement  
4493PRO_011.HTML