 |
OpenVMS Utility Routines Manual
8.3.1 Main Callable DECTPU Utility Routines
The following callable DECTPU routines are described in this chapter:
- TPU$INITIALIZE
- TPU$EXECUTE_INIFILE
- TPU$CONTROL
- TPU$EXECUTE_COMMAND
- TPU$CLEANUP
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:
- 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.
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");
}
|
|
