The following callable DECTPU routines are described in this chapter:

• TPU$INITIALIZE
• TPU$EXECUTE_INIFILE
• TPU$CONTROL
• TPU$EXECUTE_COMMAND
• TPU$CLEANUP

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:

• TPU$CLIPARSE---Parses a command line and builds the item list for TPU$INITIALIZE
• TPU$PARSEINFO---Parses a command and builds an item list for TPU$INITIALIZE
• TPU$FILEIO---The default file I/O routine
• TPU$MESSAGE---Writes error messages and strings using the built-in procedure MESSAGE
• TPU$HANDLER---The default condition handler
• TPU$CLOSE_TERMINAL---Closes the DECTPU channel to the terminal (and its associated mailbox) for the duration of a CALL_USER routine
• TPU$SPECIFY_ASYNC_ACTION---Specifies an asynchronous event for interrupting the TPU$CONTROL routine
• TPU$TRIGGER_ASYNC_ACTION---Interrupts the TPU$CONTROL routine on a specified asynchronous event

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:

• Routine for initialization callback---This is a routine that TPU$INITIALIZE calls to obtain values for initialization parameters. The initialization parameters are returned as an item list.
• Routine for file I/O---This is a routine that handles file operations. Instead of writing your own file I/O routine, you can use the TPU$FILEIO utility routine. DECTPU does not use this routine for journal file operations or for operations performed by the built-in procedure SAVE.
• Routine for condition handling---This is a routine that handles error conditions. Instead of writing your own condition handler, you can use the default condition handler, TPU$HANDLER.
• Routine for the built-in procedure CALL_USER---This is a routine that is called by the built-in procedure CALL_USER. You can use this mechanism to cause your program to get control during an editing session.

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; HP 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 HP Fortran.

Example 8-2 Normal DECTPU Setup in HP 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 HP Fortran.

Example 8-3 Building a Callback Item List with HP 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"); }