MODULE XTESTB ( IDENT = 'X00.08', %TITLE 'XPORT Binary I/O Test' MAIN = TEST_BINARY ! Entry point of main program %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) ) = BEGIN ! ! COPYRIGHT (c) 1979 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module demonstrates the use of XPORT binary I/O functions. ! ! ENVIRONMENT: User Mode ! ! AUTHOR: Ward Clark, CREATION DATE: 10 January 1979 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE TEST_BINARY; ! Principal testing routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! XPORT control block and macro definitions ! ! MACROS: ! MACRO SKIP( literal_string ) = ! Prefix a literal string with a line-feed %STRING( %CHAR(lf), literal_string ) %; ! ! EQUATED SYMBOLS: ! LITERAL lf = %O'12'; ! ASCII line feed character ! ! OWN STORAGE: ! OWN tty_input : $XPO_IOB(), ! IOB for input from terminal tty_output : $XPO_IOB(), ! IOB for output to terminal input_file : $XPO_IOB(), ! IOB for input file output_file : $XPO_IOB(); ! IOB for output file ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE TEST_BINARY = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This module explicitly tests the following XPORT binary I/O functions: ! ! * open terminal/file for input and output ! * get from terminal/file ! * put to terminal/file ! ! These I/O functions indirectly test the following XPORT functions: ! ! * default failure action routine ! * dynamic memory allocation ($XPO_GET_MEM) ! * dynamic memory deallocation ($XPO_FREE_MEM) ! * message routine ($XPO_PUT_MSG) ! * BLISS transportable string package ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! XPO$_NORMAL - successful completion ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN LOCAL status; ! XPORT I/O completion code %IF %VARIANT NEQ 0 %THEN ! ! Initialize the IOB's ! $XPO_IOB_INIT( IOB = tty_input ); $XPO_IOB_INIT( IOB = tty_output ); $XPO_IOB_INIT( IOB = input_file ); $XPO_IOB_INIT( IOB = output_file ); %FI ! ! Open the user's terminal for output and send the user a greeting message. ! $XPO_OPEN( IOB = tty_output, ! Open the user's terminal: FILE_SPEC = $XPO_OUTPUT, ! standard output file OPTIONS = OUTPUT ); ! open for output $XPO_PUT( IOB = tty_output, ! Send the user a greeting message. STRING = skip('XPORT Binary I/O Test') ); ! ! Open the user's terminal for input. ! $XPO_OPEN( IOB = tty_input, ! Open the user's terminal: FILE_SPEC = $XPO_INPUT, ! standard input file OPTIONS = INPUT ); ! open for input ! ! Request the name of the file to be copied and open that file. ! WHILE 1 DO ! Keep asking until an input file can be opened. BEGIN IF NOT $XPO_GET( IOB = tty_input, ! Read a file name from the terminal. PROMPT = skip('Input file name? ') ) THEN ! If terminal end-of-file (^Z) is reached, RETURN XPO$_NORMAL; ! terminate program execution. status = $XPO_OPEN( IOB = input_file, ! Open the specified input file: FILE_SPEC = ! input file-spec descriptor tty_input[IOB$T_STRING], ! OPTIONS = (BINARY,INPUT), ! open for binary input I/O FAILURE = XPO$IO_FAILURE ); ! non-terminating I/O failure action routine IF .status THEN EXITLOOP; ! If the input file was successfully opened, ! exit the file open loop. END; ! ! Request the name of the output file and open that file. ! WHILE 1 DO ! Keep asking until an output file can be opened. BEGIN IF NOT $XPO_GET( IOB = tty_input, ! Read a file name from the terminal. PROMPT = skip('Output file name? ') ) THEN ! If terminal end-of-file (^Z) is reached, RETURN XPO$_NORMAL; ! terminate program execution. status = $XPO_OPEN( IOB = output_file, ! Open the specified output file: FILE_SPEC = ! output file-spec descriptor tty_input[IOB$T_STRING], ! OPTIONS = (BINARY,OUTPUT), ! open for binary output I/O FAILURE = XPO$IO_FAILURE ); ! non-terminating I/O failure action routine IF .status THEN EXITLOOP; ! If the output file was successfully opened, ! exit the file open loop. END; ! ! Copy the input file to the output file 50 fullwords at a time. ! WHILE $XPO_GET( IOB = input_file, ! Read binary data until end-of-file is reached. FULLWORDS = 50 ) DO $XPO_PUT( IOB = output_file, ! Write the binary data into the output file: BINARY_DATA = input_file[IOB$T_DATA] ); ! input binary data descriptor ! ! Close the input and output files. ! $XPO_CLOSE( IOB = input_file ); ! Close the input file. $XPO_CLOSE( IOB = output_file ); ! Close the output file. ! ! Send the user a completion message. ! $XPO_PUT( IOB = tty_output, ! Send the user a blank line followed by a message. STRING = skip('XPORT Binary I/O Test Complete') ); ! ! Close the terminal input and output files. ! $XPO_CLOSE( IOB = tty_input ); ! Close the terminal input file. $XPO_CLOSE( IOB = tty_output ); ! Close the terminal output file. ! ! Terminate XPORT I/O testing. ! RETURN XPO$_NORMAL; ! Exit with a normal completion code. END; END ELUDOM