MODULE XGET ( IDENT = 'X1.2-26' %TITLE 'XPO$GET - XPORT File Input' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$GET ),OTS='' ) ) = BEGIN ! ! COPYRIGHT (c) 1982 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 is the XPORT file input module. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHORS: Ward Clark, CREATION DATE: 26 June 1978 ! Linda Duffell ! ! MODIFIED BY: Edward G. Freedman See CMS history for details ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$GET; ! XPORT File Input Routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11 ) %IF $TOPS10 %THEN REQUIRE 'XT10' ; ! TOPS-10 I/O interface macros %FI %IF $TOPS20 %THEN REQUIRE 'XT20' ; ! TOPS-20 I/O interface macros %FI %IF $VMS %THEN REQUIRE 'XVMS' ; ! XPORT-specific VAX/VMS interface definitions %FI %IF $11M %THEN REQUIRE 'XRSX' ; ! XPORT-specific RSX-11 and FCS-11 interface definitions %FI %IF $RSTS %THEN REQUIRE 'XRSTS' ; ! RSTS/E I/O interface definitions %FI %IF $RT11 %THEN REQUIRE 'XRT11' ; ! RT-11 I/O interface macros %FI ! ! MACROS: ! %IF $TOPS20 %THEN MACRO get_error = BEGIN LOCAL error; ! Storage area for error code. $T20_GETER( $FHSLF, error ); ! Pick up the last error for this process. X20$ERROR( .iob, .error ); ! Convert the error into an equivalent XPORT completion code END % ; %FI ! ! EQUATED SYMBOLS: ! LITERAL yes = 1, ! Used to turn an indicator on no = 0, ! Used to turn an indicator off max_prompt_len = 255, ! Maximum number of characters in an input prompt buffer_length = 80, ! Input buffer allocation and increment size ctrl_d = %O'4', ! Control-D ctrl_z = %O'32', ! Control-Z (terminal EOF) term_buffer_len = 255; ! Length of terminal input buffer (RSX-11M/RSTS only) ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE XPO$OPEN, ! XPORT file open routine XPO$CLOSE; ! XPORT file close routine %IF $TOPS10 OR $TOPS20 %THEN EXTERNAL ROUTINE X36$SEQ_INFO, ! TOPS-10/TOPS-20 file sequence info routine X36$GET_FILE; ! TOPS-10/TOPS-20 file read routine %FI %IF $TOPS20 %THEN EXTERNAL ROUTINE X20$IN, ! TOPS-20 input routine X20$ERROR : NOVALUE; ! TOPS-20 to XPORT completion code conversion table %FI %IF $VMS %THEN EXTERNAL ROUTINE XPO$RMS_ERROR : NOVALUE, ! RMS-to-XPORT completion code conversion routine LIB$GET_EF : ADDRESSING_MODE(GENERAL), ! Event flag allocation LIB$FREE_EF : ADDRESSING_MODE(GENERAL); ! Event flag deallocation %FI %IF $11M %THEN EXTERNAL XRSX$EVENT_FLAG; ! XPORT QIO/FCS event flag number EXTERNAL ROUTINE XRSX$IO_ERROR : NOVALUE; ! RSX-to-XPORT completion code conversion routine %FI %IF $RSTS %THEN EXTERNAL ROUTINE XRST$IN, ! RSTS/E input routine XRST$GET_FILE, ! RSTS/E file read routine XRST$ERROR : NOVALUE; ! RSTS-to-XPORT completion code routine %FI %IF $RT11 %THEN EXTERNAL ROUTINE XRT$IN, ! RT-11 input routine XRT$GET_FILE; ! RT-11 file read routine %FI GLOBAL ROUTINE XPO$GET ( iob, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine inputs a single record from the file described ! by the caller's IOB. ! ! FORMAL PARAMETERS: ! ! iob - address of the caller's IOB ! success_action - address of success action routine ! failure_action - address of failure action routine ! ! IMPLICIT INPUTS: ! ! Information contained in or pointed to by the caller's IOB ! ! IMPLICIT OUTPUTS: ! ! Various fields in the caller's IOB are updated to reflect ! the results of the requested I/O function ! ! COMPLETION CODES: (also returned in IOB$G_COMP_CODE) ! ! XPO$_NORMAL - the input operation was successful ! XPO$_INCOMPLETE - an incomplete amount of data was read ! XPO$_NEW_FILE - the first get on a concatenated file was successful ! XPO$_NEW_PAGE - the first read on a new SOS page was successful ! ! XPO$_END_FILE - end-of-file reached ! ! XPO$_BAD_IOB - invalid IOB ! (IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid length ! or XPO$_CORRUPTED - IOB$T_STRING is invalid (TOPS-10)) ! XPO$_BAD_PROMPT - invalid input prompt ! (IOB$G_2ND_CODE = XPO$_BAD_LENGTH - prompt longer than 255 characters ! or XPO$_CONFLICT - prompt on binary or random GET ! or $STR_APPEND completion code ! or $STR_COPY completion code(TOPS-10, TOPS-20, RT-11) ! or completion code from $STR_VALIDATE) ! XPO$_BAD_REQ - invalid request ! (IOB$G_2ND_CODE = XPO$_BAD_LENGTH - zero count (STREAM or BINARY only) ! or XPO$_BAD_DTYPE - invalid input data type) ! XPO$_FREE_MEM - buffer deallocation error ! (IOB$G_2ND_CODE = $XPO_FREE_MEM completion code) ! XPO$_GET_MEM - buffer allocation error (TOPS-10,TOPS-20,RSX-11M,RSTS) ! ( IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! XPO$_IO_BUFFER - I/O buffering error (VMS, 11M) ! (IOB$G_2ND_CODE = $STR_COPY or $STR_APPEND completion code) ! XPO$_NOT_INPUT - file is not open for output ! XPO$_NOT_OPEN - the file is not opened ! XPO$_NO_SPACE - quota exceeded or disk full (TOPS-20) ! XPO$_SYS_ERROR - unexpected operating system error (VMS) ! ( IOB$G_2ND_CODE = completion code from LIB$GET_EF or LIB$FREE_EF) ! failure completion codes from X20$ERROR (TOPS-20) ! failure completion codes from X36$SEQ_INFO (TOPS-10/TOPS-20) ! failure completion codes from X36$GET_FILE (TOPS-10/TOPS-20) ! failure completion code from $STR_APPEND (VMS) ! failure completion codes from XPO$RMS_ERROR (VMS) ! failure completion codes from XRSX$IO_ERROR (RSX-11M) ! failure completion codes from XRST$GET_FILE (RSTS) ! failure completion codes from XRST$ERROR (RSTS) ! failure completion codes from XRT$GET_FILE (RT-11) ! ! Note: If automatic input concatenation occurs and the necessary ! file close or open operation fails, the appropriate $XPO_CLOSE ! or $XPO_OPEN failure completion codes are returned. ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND prompt = .iob[IOB$A_PROMPT] : $STR_DESCRIPTOR();! Redefine the input prompt descriptor LABEL READ_BLOCK; ! System-specific file input block %IF $RT11 %THEN LOCAL lower_case_bit, special_mode; %FI ! ! XPORT routine initialization. ! $XPO_MAIN_BEGIN( IO ) ! Define the MAIN_BLOCK code block ! and validate the caller's IOB. iob[IOB$G_COMP_CODE] = XPO$_NORMAL; ! Start out assuming everything will be ok. ! ! Validate the caller's IOB. ! IF NOT .iob[IOB$V_OPEN] ! If the file is not open THEN ! $XPO_QUIT( NOT_OPEN ); ! return an error code to the caller. IF NOT .iob[IOB$V_INPUT] ! If the file is not opened for input, THEN ! $XPO_QUIT( NOT_INPUT ); ! return an error code to the caller. IF NOT .iob[IOB$V_RECORD] AND ! If this is not a character record file .iob[IOB$H_STRING] LEQ 0 ! and the data length is zero, THEN ! $XPO_QUIT( BAD_REQ, BAD_LENGTH ); ! return error codes to the caller. IF (.iob[IOB$V_RECORD] AND ! Check for the following conflicts: .iob[$SUB_FIELD(IOB$T_STRING,STR$B_DTYPE)] ! character file with bad data type NEQ STR$K_DTYPE_T) OR ! (.iob[IOB$V_STREAM] AND ! Check for the following conflicts: .iob[$SUB_FIELD(IOB$T_STRING,STR$B_DTYPE)] ! character file with bad data type NEQ STR$K_DTYPE_T) OR ! ((.iob[IOB$V_BINARY] OR .iob[IOB$V_RANDOM]) AND ! binary or random file with bad data type .iob[$SUB_FIELD(IOB$T_DATA,XPO$B_DTYPE)] NEQ XPO$K_DTYPE_BU) THEN ! If the IOB is questionable, $XPO_QUIT( BAD_REQ, BAD_DTYPE ); ! return error codes to the caller. $STR_VALIDATE( prompt, (XPO$_BAD_PROMPT) ); ! Validate the prompt string descriptor. IF .prompt[STR$H_LENGTH] NEQ 0 AND ! If a prompt is specified for a binary (.iob[IOB$V_BINARY] OR .iob[IOB$V_RANDOM]) ! or random GET, THEN ! $XPO_QUIT( BAD_PROMPT, CONFLICT ); ! return error codes to the caller. IF .prompt[STR$H_LENGTH] GTR max_prompt_len ! If the input prompt is too long, THEN ! $XPO_QUIT( BAD_PROMPT, BAD_LENGTH ); ! return error codes to the caller. ! ! Repeat the remainder of this routine in order to perform ! automatic input concatenation. ! WHILE 1 DO ! The following repeat loop is terminated BEGIN ! by a return to the caller. ! ! Read the next record from the input stream. ! IF ( NOT .iob[IOB$V_EOF] ) ! If end-of-file has not been reached, OR .iob[IOB$V_RANDOM] ! or random access is allowed THEN ! read one record from the input file. READ_BLOCK : BEGIN !+ ! ! System-specific file input processing follows. ! !- %TITLE 'TOPS-10/TOPS-20/RT-11 Terminal GET Prompting' %IF $TOPS10 OR $TOPS20 OR $RT11 %THEN !+ ! ! TOPS-10/TOPS-20/RT-11 GET Processing ! !- BEGIN BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR; ! TOPS-10/TOPS-20/RT-11 buffer control block %IF $RT11 %THEN LOCAL value : BYTE; ! Single ASCII character OWN no_crlf : $STR_DESCRIPTOR( STRING = (1, UPLIT BYTE(%O'200')) ); %ELSE LOCAL value; ! Single ASCII character or value %FI LOCAL req_length, ! Requested input data length new_buffer, ! New input buffer pointer/address buffer_pointer; ! XPORT input buffer pointer MACRO max_string_len = $SUB_FIELD( IOB$T_STRING, STR$H_MAXLEN ) %; %IF $RT11 %THEN ! ! RT-11 initialization ! IF .iob[IOB$V_TERMINAL] ! If this is a terminal file THEN ! BEGIN ! lower_case_bit = .RT_JSW_LC; ! Save the original terminal status special_mode = .RT_JSW_STT; ! of both the lower_case and special_mode bits. RT_JSW_LC = yes; ! Disable automatic conversion of lower-case to upper-case. END; %FI ! ! TOPS-10/TOPS-20/RT-11 initialization. ! IF .iob[$SUB_FIELD(IOB$T_STRING,STR$B_CLASS)] ! Make sure IOB$T_STRING is DYNAMIC_BOUNDED. NEQ STR$K_CLASS_DB THEN $XPO_QUIT( BAD_IOB, CORRUPTED ); req_length = .iob[IOB$H_STRING]; ! Pickup the input request length before ! it is smashed by input prompting. !+ ! ! TOPS-10/TOPS-20/RT-11 Terminal GET Prompting ! !- ! ! Issue a terminal input prompt, if requested. ! IF .iob[IOB$V_TERMINAL] AND ! If this is a terminal file .prompt[STR$H_LENGTH] GTR 0 ! and a prompt string was specified, THEN ! issue an input prompt. BEGIN LOCAL status; iob[IOB$H_STRING] = 0; ! Allow for prompt to be placed in input buffer. status = $STR_COPY( ! Move the prompt string into the input data buffer. STRING = .iob[IOB$A_PROMPT], TARGET = iob[IOB$T_STRING], FAILURE = 0 ); IF .status THEN %IF NOT $RT11 %THEN status = $STR_APPEND( ! Add an ASCII null to the end of the prompt. STRING = %CHAR(null), TARGET = iob[IOB$T_STRING], FAILURE = 0); %ELSE status = $STR_APPEND( ! (RT-11) Indicate we don't want to append a 'crlf'. STRING = no_crlf, TARGET = iob[IOB$T_STRING], FAILURE = 0); %FI IF NOT .status ! If the prompt string was not successfully built, THEN ! $XPO_QUIT( BAD_PROMPT, (.status) ) ! return error codes to the caller. ELSE ! Otherwise, %IF $TOPS10 %THEN ! $T10_OUTSTR( ! send it to the user's terminal. $XPO_ADDRESS(.iob[IOB$A_STRING]) ); %FI %IF $TOPS20 %THEN IF NOT $T20_PSOUT( .iob[IOB$A_STRING] ) ! send it to the user's terminal. THEN BEGIN get_error; $XPO_QUIT (); END; %FI %IF $RT11 %THEN $PRINT( .iob[IOB$A_STRING] ); ! send it to the user's terminal %FI END; %FI %TITLE 'TOPS-20 Terminal Record-mode GET' %IF $TOPS20 %THEN !+ ! ! TOPS-20 Terminal Record-mode GET Processing ! !- IF .iob[IOB$V_RECORD] AND .iob[IOB$V_TERMINAL] ! IF this is a record-mode terminal file THEN ! execute the following block. BEGIN LOCAL flags, ! Parameter used with RDTTY. ptr_or_error, ! Parameter used with RDTTY. flags_count; ! Parameter used with RDTTY. ! ! Allocate a buffer if we haven't already. ! IF .iob[max_string_len] EQL 0 THEN BEGIN $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a buffer. CHARACTERS = buffer_length, DESCRIPTOR = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Report any errors. END; ! ! Initialize some locations. ! iob[IOB$G_SEQ_NUMB]= ! Increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; buffer_pointer = .iob[IOB$A_STRING]; ! Setup the local input buffer pointer. iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Move a single record into the local input buffer. ! flags = .iob[max_string_len]; ! Initialize to amount remaining in buffer WHILE 1 DO BEGIN flags = .flags OR RD_BRK OR RD_BEL OR ! Break on ^Z, ESC, or End-Of-Line, RD_CRF; ! and store only the line feed when RETURN key is hit. IF NOT $T20_RDTTY( ! Read in a record: .buffer_pointer, ! pointer to buffer area used for terminal input .flags, ! preset options and number of bytes 0, ! indicates no prompting text ptr_or_error, ! updated string pointer or error code returned here flags_count ) ! indicator bits and updated count returned here THEN $XPO_QUIT( NO_SPACE ); ! Return to caller if error occurred. iob[IOB$H_STRING] = .iob[IOB$H_STRING] + ! Update the character count: ( (.flags AND X20$K_RIGHT_HLF)- ! count of available bytes before RDTTY (.flags_count AND X20$K_RIGHT_HLF) ); ! count of available bytes after RDTTY IF (.flags_count AND RD_BTM) EQL RD_BTM ! If one of the break characters was reached, THEN ! then figure out which one. BEGIN SELECTONE CH$RCHAR(CH$PLUS(.buffer_pointer, ! Get the last character input. (CH$DIFF(.ptr_or_error, .buffer_pointer)-1))) OF SET [ ctrl_Z ] : ! End-Of-File: BEGIN ! IF NOT $T20_PSOUT( ! Echo a CR/LF. UPLIT( %STRING(%CHAR(cr,lf,0)) ) ) THEN ! If error condition encountered, BEGIN ! get_error; ! return appropriate completion code to caller. $XPO_QUIT (); END; ! IF .iob[IOB$H_STRING] EQL 1 ! THEN ! and jump to EOF processing if it is the BEGIN ! iob[IOB$H_STRING] = 0; ! LEAVE READ_BLOCK; ! first character on the line END ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END; END; [ lf ] : ! End-Of-Line: EXITLOOP; ! exit the terminal read loop [ esc ] : ! Escape character: BEGIN ! flags = .flags_count AND X20$K_RIGHT_HLF; ! Figure how much room is left in buffer. buffer_pointer = .ptr_or_error; ! Update the pointer and continue inputting. END; TES; END ELSE BEGIN ! When the buffer is full, $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a larger input buffer. CHARACTERS = (.iob[max_string_len] + buffer_length), RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); buffer_pointer = ! Copy the current input data into the new buffer. CH$MOVE( .iob[IOB$H_STRING], .iob[IOB$A_STRING], .new_buffer ); $XPO_FREE_QUIT( ! Free the original input buffer STRING = (.iob[IOB$H_STRING], ! but don't zero the descriptor length fields. .iob[IOB$A_STRING]) ); ! Update the XPORT input buffer descriptor: iob[IOB$A_STRING] = .new_buffer; ! pointer to input buffer iob[max_string_len] = .iob[max_string_len] + buffer_length; ! length of the input buffer flags = buffer_length; END; END; ! ! Remove any control characters from the end of the record. ! buffer_pointer = CH$PLUS( .iob[IOB$A_STRING], ! Point past the last input character. .iob[IOB$H_STRING] ); WHILE .iob[IOB$H_STRING] GTR 0 DO ! Loop to remove control characters from BEGIN ! the end of the input record. buffer_pointer = ! Decrement the buffer pointer. CH$PLUS( .buffer_pointer, -1 ); value = CH$RCHAR( .buffer_pointer ); ! Pickup the last character in the record. IF .value EQL lf OR .value EQL ctrl_z ! If the character is a line feed or ^Z, THEN ! iob[IOB$H_STRING] = ! decrement the record length. .iob[IOB$H_STRING] - 1 ELSE EXITLOOP; ! Otherwise, exit this cleanup loop. END; $XPO_QUIT(); ! Return the current success code to the caller. END; %FI %TITLE 'TOPS-10/TOPS-20 Record-mode GET' %IF $TOPS10 OR $TOPS20 %THEN !+ ! ! TOPS-10 Record-mode GET Processing for File and Terminal. ! TOPS-20 Record-mode GET Processing for File only. ! !- %IF $TOPS10 %THEN IF .iob[IOB$V_RECORD] ! If this a record-mode character file, %FI %IF $TOPS20 %THEN IF .iob[IOB$V_RECORD] AND NOT .iob[IOB$V_TERMINAL] ! If this is record-mode and not the terminal, %FI THEN ! execute the following block. BEGIN ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Process any page or sequence number information in the record. ! IF .iob[IOB$V_SEQUENCED] ! If this is a sequenced file, THEN ! SELECTONE X36$SEQ_INFO( .iob ) OF ! update the page number and/or sequence number in the IOB SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: LEAVE READ_BLOCK; ! Jump to EOF processing. [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return error codes to the caller. TES ELSE ! If this is not a sequenced file, iob[IOB$G_SEQ_NUMB] = ! simply increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; ! ! Move a single record into the local input buffer. ! buffer_pointer = .iob[IOB$A_STRING]; ! Setup the local input buffer pointer. WHILE 1 DO ! Fill the input buffer a character at a time. BEGIN %IF $TOPS10 %THEN IF .iob[IOB$V_TERMINAL] ! If this is a terminal file, THEN ! read one character from the user's terminal BEGIN $T10_INCHWL( value ); ! in record mode (wait for end-of-line). IF .value EQL ctrl_z ! If the character is a ^Z, THEN ! BEGIN ! $T10_OUTSTR( ! echo a CR/LF UPLIT( %STRING(%CHAR(cr,lf,0)) ) ); ! ! IF .iob[IOB$H_STRING] EQL 0 ! THEN ! and jump to EOF processing if it is the LEAVE READ_BLOCK ! first character on the line ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END; END; END; %FI IF NOT .iob[IOB$V_TERMINAL] ! Here if working with files. THEN BEGIN SELECTONE X36$GET_FILE(.iob,value) OF ! Read one character from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return error codes to the caller. TES; END; IF .value EQL lf OR ! If the character is a line feed (.value EQL null AND ! or a page mark has been reached, .iob[IOB$G_COMP_CODE] EQL ! XPO$_NEW_PAGE) ! THEN ! EXITLOOP; ! exit the read loop. IF .iob[IOB$H_STRING] GTR 0 OR ! If a non-null character has been found .value NEQ null ! THEN ! BEGIN ! put it into the XPORT input buffer. IF .iob[IOB$H_STRING] GEQ ! If the XPORT input buffer is full, .iob[max_string_len] ! THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a larger input buffer. CHARACTERS = (.iob[max_string_len] + buffer_length), RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); buffer_pointer = ! Copy the current input data into the new buffer. CH$MOVE( .iob[IOB$H_STRING], .iob[IOB$A_STRING], .new_buffer ); $XPO_FREE_QUIT( ! Free the original input buffer STRING = (.iob[IOB$H_STRING], ! but don't zero the descriptor length fields. .iob[IOB$A_STRING]) ); ! Update the XPORT input buffer descriptor: iob[IOB$A_STRING] = .new_buffer; ! pointer to input buffer iob[max_string_len] = ! length of the input buffer .iob[max_string_len] + buffer_length; END; CH$WCHAR_A( .value, buffer_pointer ); ! Put the new character into the XPORT input buffer iob[IOB$H_STRING] = ! and increment the input record length. .iob[IOB$H_STRING] + 1; END; END; ! ! Remove any control characters from the end of the record. ! buffer_pointer = CH$PLUS( .iob[IOB$A_STRING], ! Point past the last input character. .iob[IOB$H_STRING] ); WHILE .iob[IOB$H_STRING] GTR 0 DO ! Loop to remove control characters from BEGIN ! the end of the input record. buffer_pointer = ! Decrement the buffer pointer. CH$PLUS( .buffer_pointer, -1 ); value = CH$RCHAR( .buffer_pointer ); ! Pickup the last character in the record. IF .value EQL cr ! If the character is a carriage return, THEN ! iob[IOB$H_STRING] = ! decrement the record length. .iob[IOB$H_STRING] - 1 ELSE EXITLOOP; ! Otherwise, exit this cleanup loop. END; $XPO_QUIT(); ! Return the current success code to the caller. END; %FI %TITLE 'TOPS-10/TOPS-20 Stream-mode and Binary-mode GET' %IF $TOPS10 OR $TOPS20 %THEN !+ ! ! TOPS-10/TOPS-20 Stream-mode and Binary-mode GET Processing ! ! Note that the following section depends on IOB$T_STRING and IOB$T_DATA ! being the same actual IOB fields. ! !- !+ ! Random access i/o has been implemented and tested for VMS. Though some code is in place to ! support random access i/o for TOPS-20 as well, it is NOT COMPLETE and is known to not be ! reliable. Therefor, a conditional check for use of the random attribute is in XPORT.REQ and ! XOPEN.BLI. When the TOPS20 code is completed and tested, this conditional can be changed to ! " %IF NOT $VMS OR NOT $TOPS20 %THEN " for XOPEN.BLI ! " %IF NOT %BLISS(BLISS32) OR NOT %BLISS(BLISS36) %THEN " for XPORT.REQ ! ! See also: ! XPORT.REQ - $XPO_OPEN definition, random disallowed. ! XOPEN.BLI - $IOB initialization, random disallowed. ! XGET.BLI - comments in 'TOPS-10/TOPS-20 Stream-mode and Binary-mode GET' ! XPUT.BLI - comments in 'TOPS-10/TOPS-20/RT-11 File PUT' !- ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Allocate a new input buffer if the current buffer is too small. ! IF .req_length GTR .iob[max_string_len] ! If the current input buffer is too small, THEN ! BEGIN ! $XPO_FREE_QUIT( STRING = iob[IOB$T_STRING] ); ! free the buffer. IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a character file, THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a new character input buffer. CHARACTERS = .req_length, RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); END ELSE $XPO_IF_NOT( $XPO_GET_MEM( ! Otherwise, allocate a new binary input buffer. UNITS = .req_length, RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Update the input data descriptor: iob[IOB$A_STRING] = .new_buffer; ! new input buffer pointer/address iob[max_string_len] = .req_length; ! length of the new input buffer END; ! ! Setup a local pointer to the input buffer. ! IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a character operation, THEN ! buffer_pointer = .iob[IOB$A_STRING] ! pickup the character buffer pointer. ELSE buffer_pointer = ! Otherwise, create a "unit pointer". CH$PTR( .iob[IOB$A_DATA], 0, %BPVAL ); ! ! If this is a random file, then set the file position. ! %IF $TOPS20 %THEN IF .iob[IOB$V_RANDOM] THEN BEGIN LOCAL file_pos ; file_pos = .iob[IOB$G_NEXT_POS] ; ! Go to the indicated record $T20_SFPTR ( .iob[IOB$H_CHANNEL], .file_pos ) ; ! ! Check to see what the last operation was. If it was a PUT, then the buffer ! count is wrong. Reset the buffer_cb[$BFCTR] to 0, so that when X36$GET_FILE ! is called, it will refresh the buffer. ! IF .iob[$IOB$FILLER2] EQL 2 THEN buffer_cb[$BFCTR] = 0 ; iob[$IOB$FILLER2] = 1 ; ! Indicate that the last operation was GET END ; ! of IF .iob[IOB$V_RANDOM] %FI ! ! Fill the input buffer one character/value at a time. ! INCR count FROM 1 TO .req_length DO ! Fill the buffer one character/value at a time. BEGIN IF .iob[IOB$V_TERMINAL] ! If this is a terminal file, THEN ! BEGIN ! %IF $TOPS10 %THEN $T10_INCHRW( value ); ! read one character from the terminal %FI %IF $TOPS20 %THEN IF NOT $T20_PBIN( value ) ! read one character from the terminal THEN BEGIN get_error; $XPO_QUIT(); END; %FI ! IF .value EQL ctrl_z ! If a ^Z is read from the terminal, THEN ! BEGIN ! %IF $TOPS10 %THEN $T10_OUTSTR( ! echo a CR/LF UPLIT( %STRING(%CHAR(cr,lf,0)) ) ); ! %FI %IF $TOPS20 %THEN IF NOT $T20_PSOUT( CH$PTR( ! echo a CR/LF UPLIT( %STRING(%CHAR(cr,lf,0)) ))) THEN BEGIN get_error; $XPO_QUIT(); END; %FI ! IF .iob[IOB$H_STRING] EQL 0 ! THEN ! and jump to EOF processing if it is the LEAVE READ_BLOCK ! first character read ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END; END; END ELSE SELECTONE X36$GET_FILE( .iob, value ) OF ! Otherwise, read one character/value from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return error codes to the caller. TES; CH$WCHAR_A( .value, buffer_pointer ); ! Move one character/value into the buffer iob[IOB$H_STRING] = .iob[IOB$H_STRING] + 1; ! and increment the data length. END; ! ! Calculate the number of fullwords of binary data which have been read. ! IF .iob[IOB$V_BINARY] OR .iob[IOB$V_RANDOM] ! If this is a binary or random read, THEN ! iob[IOB$H_FULLWORDS] = ! calculate the number of complete BLISS fullwords read. .iob[IOB$H_UNITS] / %UPVAL; ! ! If this was a random request, save the file position in G_NEXT_POS ! %IF $TOPS20 %THEN IF .iob[IOB$V_RANDOM] THEN ! Add the starting position to the number of words read BEGIN iob[IOB$G_CURR_POS] = .iob[IOB$G_NEXT_POS]; iob[IOB$G_NEXT_POS] = .iob[IOB$G_NEXT_POS] + .iob[IOB$H_UNITS]; ! and get next available word END; %FI ! ! Check for a truncated input request. ! IF .iob[IOB$H_STRING] LSS .req_length ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of TOPS-10/TOPS-20 input processing. !+ ! ! End of TOPS-10/TOPS-20 GET Processing ! !- %FI %TITLE 'VAX/VMS Terminal GET' %IF $VMS %THEN !+ ! ! VAX/VMS Terminal GET ! ! NOTE: The following code is very similar to the corresponding code for RSX-11M. ! !- IF .iob[IOB$V_TERMINAL] THEN BEGIN LOCAL function_code, ! I/O function code req_length, ! Number of characters requested terminator_mask : VECTOR[2], ! Input terminator info status : $IOSB, ! QIO status block event_flag; ! Event flag number for QIOW OWN stream_terminator : VECTOR[2] ! ^Z (sub) is the only STREAM input terminator. INITIAL( 0, 1^sub ); MACRO max_string_len = $SUB_FIELD( IOB$T_STRING, STR$H_MAXLEN ) %; LOCAL ! *** VMS BUG BYPASS *** bug_fix_buffer : VECTOR[ max_prompt_len+1, BYTE ], ! "leading line-feed on prompt is ignored" bug_fix_prompt : $STR_DESCRIPTOR( CLASS=BOUNDED ); $STR_DESC_INIT( DESCRIPTOR = bug_fix_prompt, CLASS = BOUNDED, STRING = ( max_prompt_len+1, bug_fix_buffer ) ); IF .prompt[STR$H_LENGTH] GTR 0 THEN BEGIN $STR_COPY( STRING = %CHAR(lf), TARGET = bug_fix_prompt, FAILURE = 0 ); $XPO_IF_NOT( $STR_APPEND( STRING = prompt, TARGET = bug_fix_prompt, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_PROMPT, (.$XPO_STATUS) ); END; ! *** End of VMS BUG BYPASS *** ! ! Setup for RECORD-mode terminal input. ! IF .iob[IOB$V_RECORD] THEN BEGIN function_code = IO$_READPROMPT; ! I/O function code req_length = term_buffer_len; ! maximum input record length terminator_mask = 0; ! standard RMS input terminators indicator END ! ! Setup for STREAM-mode terminal input. ! ELSE BEGIN function_code = IO$_TTYREADPALL; ! I/O function code req_length = .iob[IOB$H_STRING]; ! number of characters requested terminator_mask = stream_terminator; ! address of input terminator mask iob[IOB$H_STRING] = 0; ! Indicate that the input buffer is empty. END; ! ! Allocate a terminal input buffer, if necessary. ! IF .iob[max_string_len] LSS .req_length ! See if the input buffer is large enough. THEN BEGIN $XPO_IF_NOT( $XPO_FREE_MEM( ! Free the current input buffer. STRING = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( FREE_MEM, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new input buffer. CHARACTERS = .req_length, RESULT = iob[IOB$A_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[max_string_len] = .req_length; ! Then setup the terminal buffer length. END; ! ! Read ASCII characters from the terminal. ! $XPO_IF_NOT ( LIB$GET_EF ( event_flag ) ) ! Allocate an event flag THEN ! If the allocation failed, $XPO_QUIT( SYS_ERROR, (.$XPO_STATUS) ); ! return these codes to the caller. $QIOW( FUNC = .function_code, ! Read a stream of characters from the terminal: EFN = .event_flag, ! Event flag number CHAN = .iob[IOB$H_CHANNEL], ! I/O channel number IOSB = status, ! address of QIO status block P1 = .iob[IOB$A_STRING], ! address of the terminal input buffer P2 = .req_length, ! length of the terminal input buffer P4 = .terminator_mask, ! address of terminator mask ! P5 = .prompt[STR$A_POINTER], ! address of the prompt string (if any) ! P6 = .prompt[STR$H_LENGTH] ); ! length of the prompt string P5 = .bug_fix_prompt[STR$A_POINTER], ! address of the prompt string (if any) *** BUG BYPASS *** P6 = .bug_fix_prompt[STR$H_LENGTH] ); ! length of the prompt string *** BUG BYPASS *** $XPO_IF_NOT ( LIB$FREE_EF ( event_flag ) ) ! Free the allocated event flag THEN ! If the free failed, $XPO_QUIT( SYS_ERROR, (.$XPO_STATUS) ); ! return these codes to the caller. IF NOT .status[IOSB$H_STATUS] ! If the QIO operation failed, THEN ! BEGIN ! XPO$RMS_ERROR( .iob, ! convert the QIO error code into XPORT completion codes .status[IOSB$H_STATUS], 0 ); ! $XPO_QUIT(); ! and return these codes to the caller. END; IF .status[IOSB$B_TERM1] EQL sub ! If end-of-file was reached, THEN ! IF .status[IOSB$H_IO_COUNT] EQL 0 ! THEN ! LEAVE READ_BLOCK ! either jump to end-of-file processing ELSE ! iob[IOB$V_EOF] = yes; ! or indicate a pending end-of-file. ! ! Remove the parity bit from all characters read. ! BEGIN LOCAL buffer_pointer; iob[IOB$H_STRING] = .status[IOSB$H_IO_COUNT]; ! Indicate how many characters were read buffer_pointer = .iob[IOB$A_STRING]; ! Point to the terminal input buffer. INCR index FROM 1 TO .iob[IOB$H_STRING] DO ! Convert one character at a time. CH$WCHAR_A( CH$RCHAR( .buffer_pointer ) AND %X'7F', buffer_pointer ); END; ! ! Check for a truncated STREAM input request. ! IF .iob[IOB$V_STREAM] AND .iob[IOB$H_STRING] LSS .req_length THEN $XPO_QUIT( INCOMPLETE ) ! ! Return the current success code to the caller. ! ELSE $XPO_QUIT(); END; %FI %TITLE 'VAX/VMS Record-mode GET' %IF $VMS %THEN !+ ! ! VAX/VMS Record-mode GET Processing ! !- BEGIN BIND fab = .iob[IOB$A_RMS_FAB] : $FAB_DECL, ! Define the IOB's FAB rab = .iob[IOB$A_RMS_RAB] : $RAB_DECL; ! and RAB. IF .iob[IOB$V_RECORD] ! If this is a record-mode file, THEN ! execute the following block. BEGIN LOCAL fixed_control : WORD VOLATILE; ! VFC record header buffer ! ! Setup the RAB for a GET record operation. ! IF .iob[IOB$V_SEQUENCED] ! If this is a sequenced file, THEN ! rab[RAB$L_RHB] = fixed_control; ! point to the record header buffer. ! ! Read a single record. ! IF NOT $RMS_GET( RAB = rab ) ! Read a single record. THEN SELECTONE .rab[RAB$L_STS] OF ! Process a GET failure. SET [ RMS$_EOF ] : ! "end-of-file": LEAVE READ_BLOCK; ! Jump to end-of-file processing. [ RMS$_RTB ] : ! "record too large for user buffer": iob[IOB$G_COMP_CODE] = ! Indicate that the current record has been truncated. XPO$_TRUNCATED; [ OTHERWISE ] : ! Any other RMS error: BEGIN ! XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .rab[RAB$L_STS], ! equivalent XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; TES; ! ! Check for a page mark in a sequenced file. ! IF .iob[IOB$V_SEQUENCED] ! If this is a sequenced file THEN ! IF .fixed_control EQL %X'FFFF' AND ! and the sequence number is %X'FFFF' .rab[RAB$W_RSZ] EQL 1 AND ! and the record is a single form feed, .(.rab[RAB$L_RBF])<0,8> EQL FF ! THEN ! BEGIN ! iob[IOB$H_PAGE_NUMB] = ! increment the IOB page count, .iob[IOB$H_PAGE_NUMB] + 1; ! iob[IOB$G_SEQ_NUMB] = 0; ! zero the record sequence number, iob[IOB$G_COMP_CODE] = ! and setup a special success completion code. XPO$_NEW_PAGE; END ! ! Setup the sequence number or record number. ! ELSE ! If a sequenced record was read, iob[IOB$G_SEQ_NUMB] = ! return the record sequence number. .fixed_control ELSE ! Otherwise, if an unsequence record was read, iob[IOB$G_SEQ_NUMB] = ! increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; ! ! Return the actual input record. ! $XPO_IF_NOT( $STR_COPY( STRING = ( .rab[RAB$W_RSZ], .rab[RAB$L_RBF] ), TARGET = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ); ! ! Return to the caller after successfully reading a single record. ! $XPO_QUIT(); ! Jump to return a success code to the caller. END; %FI %TITLE 'VAX/VMS Stream-mode GET' %IF $VMS %THEN !+ ! ! VAX/VMS Stream-mode GET Processing ! ! NOTES: ! The following code is similar to the corresponding code for RSX-11M. ! !- IF .iob[IOB$V_STREAM] ! If this is a stream-mode file get, THEN ! execute the following block. BEGIN MACRO buffer_data [] = ! Moves data into the XPORT internal I/O buffer $XPO_IF_NOT( $STR_APPEND( STRING = (%REMAINING), TARGET = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ) %, amt_data_left = rab[RAB$L_CTX] %; ! Amount of unprocessed data in RMS input buffer LOCAL req_length; ! Number of characters/units requested ! ! Setup the IOB for buffered input. ! req_length = .iob[IOB$H_STRING]; ! Pickup the number of characters/units requested iob[IOB$H_STRING] = 0; ! and then indicate that the input buffer is empty. WHILE .req_length GTR 0 DO ! Loop until enough characters/units have been read. BEGIN IF .amt_data_left EQL -2 ! If CR/LF generation is pending, THEN ! BEGIN ! buffer_data( %CHAR(cr) ); ! put a CR in the input buffer, amt_data_left = -1; ! indicate a LF is still needed, req_length = .req_length - 1; ! decrement the request count, IF .req_length EQL 0 ! and exit if the input buffer is now full. THEN EXITLOOP; END; IF .amt_data_left EQL -1 ! If LF generation is pending, THEN ! BEGIN ! buffer_data( %CHAR(lf) ); ! put a LF in the input buffer, amt_data_left = 0; ! indicate all RMS data has been processed, req_length = .req_length - 1; ! decrement the request count, IF .req_length EQL 0 ! and exit if the input buffer is now full. THEN EXITLOOP; END; ! ! Read a record or a block from the input file. ! IF .amt_data_left EQL 0 ! If all previous RMS data has been processed, THEN ! BEGIN ! IF .rab[RAB$V_BIO] ! THEN ! $RMS_READ( RAB = rab ) ! read a single block ELSE ! $RMS_GET( RAB = rab ); ! or a single record. IF NOT .rab[RAB$L_STS] THEN SELECTONE .rab[RAB$L_STS] OF ! Process an RMS GET failure. SET [ RMS$_EOF ] : ! End-of-file detected: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been processed, THEN ! LEAVE READ_BLOCK ! jump to end-of-file processing. ELSE BEGIN ! iob[IOB$V_EOF] = yes; ! Otherwise, simply remember the end-of-file EXITLOOP; ! and return an incomplete amount of data. END; [ OTHERWISE ] : ! Any other RMS error: BEGIN ! XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .rab[RAB$L_STS], ! equivalent XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; TES; amt_data_left = .rab[RAB$W_RSZ]; ! Save the amount of data actually read. END; ! ! Move data into the XPORT internal input buffer. ! IF .amt_data_left LEQ .req_length ! If not enough data has been read, THEN ! BEGIN ! buffer_data( .amt_data_left, ! move all unprocessed data into the XPORT input buffer, .rab[RAB$L_RBF] + .rab[RAB$W_RSZ] - ! .amt_data_left ); ! ! req_length = .req_length - .amt_data_left; ! calculate how much addition data is needed, ! IF .fab[FAB$V_CR] ! THEN ! amt_data_left = -2 ! and then indicate that a CR/LF is needed ELSE ! amt_data_left = 0; ! or than there is no unprocessed input data. END ELSE BEGIN ! If more than enough data has been read, buffer_data( .req_length, ! move enough data to satisfy this request, .rab[RAB$L_RBF] + .rab[RAB$W_RSZ] - ! .amt_data_left ); ! amt_data_left = .amt_data_left - ! calculate how much unprocessed data remains, .req_length; ! req_length = 0; ! and indicate no more data is needed for this request. END; END; ! ! Check for a truncated input request. ! IF .req_length NEQ 0 ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of stream input processing. %FI %TITLE 'VAX/VMS Binary-mode GET' %IF $VMS %THEN !+ ! ! VAX/VMS Binary-mode GET Processing ! ! NOTES: ! The following code is similar to the corresponding code for RSX-11M. ! !- IF .iob[IOB$V_BINARY] AND NOT .iob[IOB$V_RANDOM] THEN ! If this is a binary-mode file get, BEGIN ! execute the following block. MACRO amt_data_left = rab[RAB$L_CTX] %; ! Amount of unprocessed data in RMS input buffer LOCAL req_length; ! Number of characters/units requested ! ! Setup the IOB for buffered input. ! req_length = .iob[IOB$H_UNITS]; ! Pickup the number of units requested iob[IOB$H_UNITS] = 0; ! and then indicate that the input buffer is empty. IF .req_length GTRU ! Reallocate the input buffer if it is too small. .iob[$SUB_FIELD(IOB$T_DATA,XPO$H_MAXLEN)] THEN BEGIN $XPO_IF_NOT( $XPO_FREE_MEM( BINARY_DATA = iob[IOB$T_DATA], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( UNITS = .req_length, DESCRIPTOR = iob[IOB$T_DATA], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ); END; ! ! Read a block from the input file. ! WHILE .req_length GTR 0 DO ! Loop until enough units have been read. BEGIN IF .amt_data_left EQL 0 ! If all previous RMS data has been processed, THEN ! BEGIN ! $RMS_READ( RAB = rab ); ! read a single block IF NOT .rab[RAB$L_STS] THEN SELECTONE .rab[RAB$L_STS] OF ! Process an RMS GET failure. SET [ RMS$_EOF ] : ! End-of-file detected: IF .iob[IOB$H_UNITS] EQL 0 ! If no data has been processed, THEN ! LEAVE READ_BLOCK ! jump to end-of-file processing. ELSE BEGIN ! iob[IOB$V_EOF] = yes; ! Otherwise, simply remember the end-of-file EXITLOOP; ! and return an incomplete amount of data. END; [ OTHERWISE ] : ! Any other RMS error: BEGIN ! XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .rab[RAB$L_STS], ! equivalent XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; TES; amt_data_left = .rab[RAB$W_RSZ]; ! Save the amount of data actually read. END; ! ! Move data into the XPORT internal input buffer. ! IF .amt_data_left LEQ .req_length ! If not enough data has been read, THEN ! BEGIN ! CH$MOVE( .amt_data_left, ! move all unprocessed data into the XPORT input buffer, .rab[RAB$L_RBF] + .rab[RAB$W_RSZ] - .amt_data_left, .iob[IOB$A_DATA] + .iob[IOB$H_UNITS] ); ! ! iob[IOB$H_UNITS] = .iob[IOB$H_UNITS] + ! update the length of the input data, .amt_data_left; ! req_length = .req_length - .amt_data_left; ! calculate how much addition data is needed, amt_data_left = 0; ! and indicate there is no unprocessed input data. END ELSE BEGIN ! If more than enough data has been read, CH$MOVE( .req_length, ! move enough data to satisfy this request, .rab[RAB$L_RBF] + .rab[RAB$W_RSZ] - .amt_data_left, .iob[IOB$A_DATA] + .iob[IOB$H_UNITS] ); ! ! iob[IOB$H_UNITS] = .iob[IOB$H_UNITS] + ! update the length of the input data, .req_length; ! amt_data_left = .amt_data_left - ! calculate how much unprocessed data remains, .req_length; ! req_length = 0; ! and indicate no more data is needed for this request. END; END; ! ! Calculate the number of fullwords of binary data which have been read. ! iob[IOB$H_FULLWORDS] = ! calculate the number of complete BLISS fullwords read. .iob[IOB$H_UNITS] / %UPVAL; ! ! Check for a truncated input request. ! IF .req_length NEQ 0 ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of binary input processing. %FI %TITLE 'VAX/VMS Random Binary-mode GET' %IF $VMS %THEN !+ ! VAX/VMS Random Binary-mode GET Processing ! ! Implicit inputs: ! IOB$G_NEXT_POS - the byte after the last read/write ! amt_buff_used (rab[RAB$L_CTX]) - indicates modified data in the XPORT internal output buffer ! set by XPO$PUT, cleared by XPO$GET and XPO$CLOSE ! ! Implicit outputs: ! IOB$G_CURR_POS - the byte starting the current read ! amt_buff_used (rab[RAB$L_CTX]) - indicates modified data in the XPORT internal output buffer ! tested by XPO$PUT, XPO$GET and XPO$CLOSE !- IF .iob[IOB$V_RANDOM] THEN ! If this is a random-mode file get, BEGIN ! execute the following block. BIND fab = .iob[IOB$A_RMS_FAB] : $FAB_DECL, ! Define the IOB's FAB rab = .iob[IOB$A_RMS_RAB] : $RAB_DECL; ! and RAB. MACRO amt_buff_used = rab[RAB$L_CTX] %, ! Indicates modified data in the XPORT internal output buffer requested_block = ( ( .next_pos / .rab[RAB$W_USZ] ) + 1 ) %, ! VBN is 1 origin requested_unit = ( .next_pos MOD .rab[RAB$W_USZ] ) %; ! byte in block LOCAL move_amt, ! Amount of data to move after a given $RMS_READ next_pos, ! Position in file of requested characters/units req_length; ! Number of characters/units requested ! ! Setup the IOB for buffered input. ! req_length = .iob[IOB$H_UNITS]; ! Pickup the number of units requested next_pos = .iob[IOB$G_NEXT_POS]; ! Pickup the position of requested units iob[IOB$H_UNITS] = 0; ! and then indicate that the input buffer is empty. iob[IOB$H_FULLWORDS] = 0; ! and then indicate that the input buffer is empty. ? IF .req_length GTRU ! Reallocate the input buffer if it is too small. .iob[$SUB_FIELD(IOB$T_DATA,XPO$H_MAXLEN)] THEN BEGIN $XPO_IF_NOT( $XPO_FREE_MEM( BINARY_DATA = iob[IOB$T_DATA], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( UNITS = .req_length, DESCRIPTOR = iob[IOB$T_DATA], FAILURE = 0 ) ) THEN $XPO_QUIT( IO_BUFFER, (.$XPO_STATUS) ); END; ! ! Read a block from the input file. ! WHILE .req_length GTR 0 DO ! Loop until enough units have been read. BEGIN IF requested_block NEQ .rab[RAB$L_RFA0] ! If the block has not been read into the buffer, THEN ! BEGIN ! IF .iob[IOB$V_OUTPUT] AND ! and this is also an output file .amt_buff_used NEQ 0 ! and there is modified data in the buffer THEN ! BEGIN ! then flush the buffer to disk. rab[RAB$W_RSZ] = .rab[RAB$W_USZ]; ! Setup the output block length rab[RAB$L_RBF] = .rab[RAB$L_UBF]; ! and address of the data buffer. IF $RMS_WRITE( RAB = rab ) ! If the write operation is successful, THEN ! amt_buff_used = 0 ! indicate that the output buffer is empty. ELSE BEGIN XPO$RMS_ERROR( .iob, ! Otherwise, convert the RMS completion codes .rab[RAB$L_STS], ! into appropriate XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return an error to the caller. END; END; rab[RAB$L_BKT] = requested_block; ! Now specify the block to read $RMS_READ( RAB = rab ); ! read a single block IF NOT .rab[RAB$L_STS] THEN SELECTONE .rab[RAB$L_STS] OF ! Process an RMS GET failure. SET [ RMS$_EOF ] : ! End-of-file detected: IF .iob[IOB$H_UNITS] EQL 0 ! If no data has been processed, THEN ! LEAVE READ_BLOCK ! jump to end-of-file processing. ELSE BEGIN ! iob[IOB$V_EOF] = yes; ! Otherwise, simply remember the end-of-file EXITLOOP; ! and return an incomplete amount of data. END; [ OTHERWISE ] : ! Any other RMS error: BEGIN ! XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .rab[RAB$L_STS], ! equivalent XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; TES; END; ! ! Check if request for data is beyond the EOF ! IF requested_unit GEQU .rab[RAB$W_RSZ] ! If the requested unit is beyond the available data THEN ! then this is an EOF condition. IF .iob[IOB$H_UNITS] EQL 0 ! If no data has been processed, THEN ! LEAVE READ_BLOCK ! jump to end-of-file processing. ELSE BEGIN iob[IOB$V_EOF] = yes; ! Otherwise, simply remember the end-of-file EXITLOOP; ! and return an incomplete amount of data. END; ! ! Move data into the XPORT internal input buffer. ! move_amt = MINU ( ! amount to move is the minimum of .req_length, ! the requested length to read .rab[RAB$W_RSZ] - requested_unit ); ! and the amount of data available CH$MOVE( .move_amt, ! move the data .rab[RAB$L_RBF] + requested_unit, ! from the XPORT internal buffer .iob[IOB$A_DATA] + .iob[IOB$H_UNITS] ); ! into the XPORT input buffer iob[IOB$H_UNITS] = .iob[IOB$H_UNITS] + .move_amt; ! update the length of the input data, req_length = .req_length - .move_amt; ! calculate how much additional data is needed, next_pos = .next_pos + .move_amt; ! update the pointer (requested_block and requested_byte) END; ! of WHILE ! ! Calculate the file position and number of fullwords of binary data which have been read. ! iob[IOB$H_FULLWORDS] = .iob[IOB$H_UNITS] / %UPVAL; ! calculate the number of complete BLISS fullwords read. iob[IOB$G_CURR_POS] = .iob[IOB$G_NEXT_POS]; ! position just read from (in UNITS) iob[IOB$G_NEXT_POS] = .next_pos; ! next position to read from (in UNITS) ! ! Check for a truncated input request. ! IF .req_length NEQ 0 ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of RANDOM input processing. END; ! End of VAX/VMS input processing. !+ ! ! End of VAX/VMS GET Processing ! !- %FI %TITLE 'RSX-11M Terminal GET Prompting' %IF $11M %THEN !+ ! ! RSX-11M GET Processing ! !- BEGIN !+ ! ! RSX-11M Terminal GET Prompting ! !- ! ! Issue a terminal input prompt, if requested. ! IF .iob[IOB$V_TERMINAL] AND ! If this is a terminal file .prompt[STR$H_LENGTH] GTR 0 ! and a prompt string was specified, THEN ! issue an input prompt. BEGIN LOCAL prompt_buffer : VECTOR[ max_prompt_len+2, BYTE ], crlf_prompt : $STR_DESCRIPTOR( CLASS=BOUNDED ), status : $QIO_STATUS; ! QIO status block $STR_DESC_INIT( DESCRIPTOR = crlf_prompt, ! Add a CRLF to the beginning of the prompt. CLASS = BOUNDED, STRING = ( max_prompt_len+2, prompt_buffer ) ); $STR_COPY( STRING = %CHAR(cr,lf), TARGET = crlf_prompt, FAILURE = 0 ); $XPO_IF_NOT( $STR_APPEND( STRING = prompt, TARGET = crlf_prompt, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_PROMPT, (.$XPO_STATUS) ); QIOW$S( IO$WVB, ! Write a "virtual block" to the terminal: .iob[IOB$H_CHANNEL], ! LUN .XRSX$EVENT_FLAG,, ! event flag number status,, ! address of QIO status block < .crlf_prompt[STR$A_POINTER], ! address of prompt data .crlf_prompt[STR$H_LENGTH], ! length of prompt data 0 > ); ! indicate no carriage control IF .status[QS$ERR] NEQ IS$SUC ! If writing to the terminal fails, THEN ! BEGIN ! XRSX$IO_ERROR( .iob, .status[QS$ERR] ); ! convert the QIO error code to XPORT completion codes $XPO_QUIT(); ! and return these codes to the caller. END; END; ! End of terminal prompting %FI %TITLE 'RSX-11M Record-mode Terminal GET' %IF $11M %THEN !+ ! ! RSX-11M Record-mode Terminal GET ! !- IF .iob[IOB$V_RECORD] AND .iob[IOB$V_TERMINAL] THEN BEGIN LOCAL status : $QIO_STATUS; ! QIO status block MACRO max_string_len = $SUB_FIELD( IOB$T_STRING, STR$H_MAXLEN ) %; ! ! Allocate a terminal input buffer, if necessary. ! IF .iob[max_string_len] EQL 0 ! If this is the first get, THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate the buffer. CHARACTERS = term_buffer_len, RESULT = iob[IOB$A_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[max_string_len] = term_buffer_len; ! Then setup the terminal buffer length. END; ! ! Read a single line from the terminal. ! QIOW$S( IO$RVB, ! Read a "virtual block" from the terminal. .iob[IOB$H_CHANNEL], ! LUN .XRSX$EVENT_FLAG,, ! event flag number status,, ! address of QIO status block < .iob[IOB$A_STRING], ! address of the terminal input buffer .iob[max_string_len] > ); ! length of the terminal input buffer IF .status[QS$ERR] NEQ IS$SUC THEN IF .status[QS$ERR] EQL IE$EOF ! If end-of-file was reached, THEN ! IF .status[QS$IO_COUNT] EQL 0 ! THEN ! LEAVE READ_BLOCK ! either jump to end-of-file processing ELSE ! iob[IOB$V_EOF] = yes ! or indicate a pending end-of-file. ELSE BEGIN ! If any other error occurred, XRSX$IO_ERROR( .iob, .status[QS$ERR] ); ! convert the QIO error codes into XPORT completion codes $XPO_QUIT(); ! and return these codes to the caller. END; iob[IOB$H_STRING] = .status[QS$IO_COUNT]; ! Indicate how many characters were read $XPO_QUIT(); ! and return the current success code to the caller. END; %FI %TITLE 'RSX-11M Stream-mode Terminal GET' %IF $11M %THEN !+ ! ! RSX-11M Stream-mode Terminal GET ! ! NOTE: The following code is very similar to the corresponding code for VAX/VMS. ! !- IF .iob[IOB$V_STREAM] AND .iob[IOB$V_TERMINAL] THEN BEGIN LOCAL req_length, ! Number of characters requested buffer_pointer, ! Pointer into terminal input buffer status : $QIO_STATUS; ! QIO status block MACRO max_string_len = $SUB_FIELD( IOB$T_STRING, STR$H_MAXLEN ) %; ! ! Allocate a terminal input buffer, if necessary. ! req_length = .iob[IOB$H_STRING]; ! Save the number of characters requested. IF .iob[max_string_len] LSS .req_length ! See if the input buffer is large enough. THEN BEGIN $XPO_IF_NOT( $XPO_FREE_MEM( ! Free the current input buffer. STRING = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( FREE_MEM, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new input buffer. CHARACTERS = .req_length, RESULT = iob[IOB$A_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[max_string_len] = .req_length; ! Then setup the terminal buffer length. END; ! ! Read a stream of characters from the terminal. ! QIOW$S( IO$RAL, ! Read a stream of characters from the terminal. .iob[IOB$H_CHANNEL], ! LUN .XRSX$EVENT_FLAG,, ! event flag number status,, ! address of QIO status block < .iob[IOB$A_STRING], ! address of the terminal input buffer .req_length > ); ! length of the terminal input buffer IF .status[QS$ERR] NEQ IS$SUC THEN IF .status[QS$ERR] EQL IE$EOF ! If end-of-file was reached, THEN ! IF .status[QS$IO_COUNT] EQL 0 ! THEN ! LEAVE READ_BLOCK ! either jump to end-of-file processing ELSE ! iob[IOB$V_EOF] = yes ! or indicate a pending end-of-file. ELSE BEGIN ! If any other error occurred, XRSX$IO_ERROR( .iob, .status[QS$ERR] ); ! convert the QIO error codes into XPORT completion codes $XPO_QUIT(); ! and return these codes to the caller. END; ! ! Remove the parity bit from all characters read. ! iob[IOB$H_STRING] = .status[QS$IO_COUNT]; ! Indicate how many characters were read buffer_pointer = .iob[IOB$A_STRING]; ! Point to the terminal input buffer. INCR index FROM 1 TO .iob[IOB$H_STRING] DO ! Convert one character at a time. CH$WCHAR_A( CH$RCHAR( .buffer_pointer ) AND %X'7F', buffer_pointer ); ! ! Check for a truncated input request. ! IF .iob[IOB$H_STRING] LSS .req_length ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; %FI %TITLE 'RSX-11M Record-mode File GET' %IF $11M %THEN !+ ! ! RSX-11M Record-mode File GET ! !- IF .iob[IOB$V_RECORD] THEN BEGIN BIND fcs_blocks = .iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, fdb = fcs_blocks[FCS$Z_FDB] : FDB$; ! ! Read a single record. ! IF NOT GET$( fdb ) THEN SELECTONE .fdb[F$ERR] OF ! Process a GET$ failure. SET [ IE$EOF ] : ! "end-of-file": LEAVE READ_BLOCK; ! Jump to end-of-file processing. [ OTHERWISE ] : ! Any other FCS-11 error: BEGIN ! XRSX$IO_ERROR( .iob, ! convert the FCS-11 error code into XPORT completion codes .fdb[F$ERR] ); ! $XPO_QUIT(); ! and return these codes to the caller. END; TES; ! ! Check for a page mark in a sequenced file. ! IF .iob[IOB$V_SEQUENCED] ! If this is a sequenced file THEN ! IF .fdb[F$SEQN] EQL %X'FFFF' AND ! and the sequence number is %X'FFFF' .fdb[F$NRBD$S] EQL 1 AND ! and the record is a single form feed, .(.fdb[F$NRBD$A])<0,8> EQL FF ! THEN ! BEGIN ! iob[IOB$H_PAGE_NUMB] = ! increment the IOB page count, .iob[IOB$H_PAGE_NUMB] + 1; ! iob[IOB$G_SEQ_NUMB] = 0; ! zero the record sequence number, iob[IOB$G_COMP_CODE] = ! and setup a special success completion code. XPO$_NEW_PAGE; END ! ! Update the IOB after a successful file read operation. ! ELSE ! If this is a sequenced file, iob[IOB$G_SEQ_NUMB] = .fdb[F$SEQN] ! return the record sequence number. ELSE iob[IOB$G_SEQ_NUMB] = ! Otherwise, increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; $STR_DESC_INIT( DESCRIPTOR = iob[IOB$T_STRING], ! Setup the IOB input record descriptor. CLASS = FIXED, STRING = (.fdb[F$NRBD$S],.fdb[F$NRBD$A]) ); ! ! Return to the caller after successfully reading a single record. ! $XPO_QUIT(); ! Jump to return a success code to the caller. END; %FI %TITLE 'RSX-11M Stream-mode and Binary-mode GET' %IF $11M %THEN !+ ! ! RSX-11M Stream-mode and Binary-mode GET Processing ! ! NOTES: ! The following code is very similar to the corresponding code for VAX/VMS. ! ! The following code depends on IOB$T_STRING and IOB$T_DATA being the same IOB fields. ! !- BEGIN BIND fcs_blocks = .iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, fdb = fcs_blocks[FCS$Z_FDB] : FDB$, amt_data_left = fcs_blocks[FCS$G_BUFF_LEFT]; LOCAL io_count, ! Address of I/O count io_buffer; ! Address of I/O buffer address MACRO buffer_data [] = ! Moves data into the XPORT internal I/O buffer BEGIN LOCAL status; iob[$SUB_FIELD(IOB$T_DATA,XPO$B_DTYPE)] = STR$K_DTYPE_T; status = $STR_APPEND( STRING = (%REMAINING), TARGET = iob[IOB$T_STRING], FAILURE = 0 ); IF .iob[IOB$V_BINARY] THEN iob[$SUB_FIELD(IOB$T_DATA,XPO$B_DTYPE)] = XPO$K_DTYPE_BU; IF NOT .status THEN $XPO_QUIT( IO_BUFFER, (.status) ); END %; LOCAL req_length; ! Number of characters/units requested ! ! Setup the IOB for buffered input. ! req_length = .iob[IOB$H_STRING]; ! Pickup the number of characters/units requested iob[IOB$H_STRING] = 0; ! and then indicate that the input buffer is empty. IF .iob[IOB$V_BINARY] ! Setup pointers to the I/O count, buffer address, THEN ! and completion code. BEGIN io_count = fcs_blocks[FCS$G_IO_COUNT]; io_buffer = fdb[F$BKDS$A]; END ELSE BEGIN io_count = fdb[F$NRBD$S]; io_buffer = fdb[F$NRBD$A]; END; ! ! Loop until enough characters/units have been read. ! WHILE .req_length GTR 0 DO BEGIN IF .amt_data_left EQL -2 ! If CR/LF generation is pending, THEN ! BEGIN ! buffer_data( %CHAR(cr) ); ! put a CR in the input buffer, amt_data_left = -1; ! indicate a LF is still needed, req_length = .req_length - 1; ! decrement the request count, IF .req_length EQL 0 ! and exit if the input buffer is now full. THEN EXITLOOP; END; IF .amt_data_left EQL -1 ! If LF generation is pending, THEN ! BEGIN ! buffer_data( %CHAR(lf) ); ! put a LF in the input buffer, amt_data_left = 0; ! indicate all RMS data has been processed, req_length = .req_length - 1; ! decrement the request count, IF .req_length EQL 0 ! and exit if the input buffer is now full. THEN EXITLOOP; END; ! ! Read a record or a block from the input file. ! IF .amt_data_left EQL 0 ! If all previous RMS data has been processed, THEN ! BEGIN ! IF .iob[IOB$V_BINARY] ! THEN ! BEGIN ! READ$( fdb ); ! read a single block IF .fdb[F$ERR] EQL IS$SUC ! THEN ! WAIT$( fdb ); ! END ! ELSE ! GET$( fdb ); ! or a single record. IF .fdb[F$ERR] NEQ IS$SUC THEN SELECTONE .fdb[F$ERR] OF ! Process a GET$ or READ$ failure. SET [ IE$EOF ] : ! "End-of-file reached": IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to end-of-file processing. ELSE BEGIN iob[IOB$V_EOF] = yes; ! Otherwise, simply remember the end-of-file EXITLOOP; ! and return an incomplete amount of data. END; [ OTHERWISE ] : ! Any other FCS-11 error: BEGIN ! XRSX$IO_ERROR( .iob, ! Convert the FCS-11 completion code into .fdb[F$ERR] ); ! equivalent XPORT completion codes $XPO_QUIT(); ! and then jump to return to the caller. END; TES; amt_data_left = ..io_count; ! Save the amount of data actually read. END; ! ! Move data into the XPORT internal input buffer. ! IF .amt_data_left LEQ .req_length ! If not enough data has been read, THEN ! BEGIN ! buffer_data( .amt_data_left, ! move all unprocessed data into the XPORT input buffer, ..io_buffer + ..io_count - ! .amt_data_left ); ! ! req_length = .req_length - .amt_data_left; ! calculate how much addition data is needed, ! IF .fdb[FD$$CR] AND .iob[IOB$V_STREAM] ! THEN ! amt_data_left = -2 ! and then indicate that a CR/LF is needed ELSE ! amt_data_left = 0; ! or than there is no unprocessed input data. END ELSE BEGIN ! If more than enough data has been read, buffer_data( .req_length, ! move enough data to satisfy this request, ..io_buffer + ..io_count - ! .amt_data_left ); ! amt_data_left = .amt_data_left - ! calculate how much unprocessed data remains, .req_length; ! req_length = 0; ! and indicate no more data is needed for this request. END; END; ! ! Calculate the number of fullwords of binary data which have been read. ! IF .iob[IOB$V_BINARY] ! If this is a binary read, THEN ! iob[IOB$H_FULLWORDS] = ! calculate the number of complete BLISS fullwords read. .iob[IOB$H_UNITS] / %UPVAL; ! ! Check for a truncated input request. ! IF .req_length NEQ 0 ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of stream/binary input processing. END; ! End of RSX-11M input processing. !+ ! ! End of RSX-11M GET Processing ! !- %FI %TITLE 'RSTS/E GET Prompting' %IF $RSTS %THEN !+ ! ! RSTS/E GET Processing ! !- BEGIN BIND rsts_cb = .iob[IOB$A_RSTS_CB] : $XRSTS_CB; ! XPORT-specific RSTS/E interface info LOCAL value : BYTE, ! Single ASCII character req_length, ! Requested input data length new_buffer, ! New input buffer pointer/address buffer_pointer; ! XPORT input buffer pointer MACRO max_string_len = $SUB_FIELD( IOB$T_STRING, STR$H_MAXLEN ) %; ! ! RSTS/E initialization. ! IF .iob[$SUB_FIELD(IOB$T_STRING,STR$B_CLASS)] ! Make sure IOB$T_STRING is DYNAMIC_BOUNDED. NEQ STR$K_CLASS_DB THEN $XPO_QUIT( BAD_IOB, CORRUPTED ); req_length = .iob[IOB$H_STRING]; ! Pickup the input request length before ! it is smashed by input prompting. !+ ! ! RSTS/E Terminal GET Prompting ! ! NOTE: This code is very similar to the TOPS10/TOPS20/RT11 terminal prompting. !- ! ! Issue a terminal input prompt, if requested. ! IF .iob[IOB$V_TERMINAL] AND ! If this is a terminal file .prompt[STR$H_LENGTH] GTR 0 ! and a prompt string was specified, THEN ! issue an input prompt. BEGIN $XRSTS_INI_FIRQB; ! Initialize the FIRQB. $XRSTS_INI_XRB; ! Initialize the XRB. ! Setup the XRB: $XRSTS_XRB[XRLEN] = .prompt[STR$H_LENGTH]; ! length of prompt $XRSTS_XRB[XRBC] = .prompt[STR$H_LENGTH]; ! length of prompt $XRSTS_XRB[XRLOC] = .prompt[STR$A_POINTER]; ! starting address of prompt $XRSTS_XRB[XRCI] = 0; ! channel number times 2 (user's terminal is always 0) $WRITE; ! Send the prompt to the terminal. IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! Report any errors. THEN BEGIN XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; END; %FI %TITLE 'RSTS/E Record-mode Terminal GET' %IF $RSTS %THEN !+ ! ! RSTS/E Record-mode Terminal GET ! !- IF .iob[IOB$V_RECORD] AND .iob[IOB$V_TERMINAL] THEN BEGIN ! ! Allocate a terminal input buffer, if necessary. ! IF .iob[max_string_len] EQL 0 ! If this is the first get, THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate the buffer. CHARACTERS = term_buffer_len, RESULT = iob[IOB$A_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[max_string_len] = term_buffer_len; ! Then setup the terminal buffer length. END; ! ! Read a single line from the terminal. ! $XRSTS_INI_FIRQB; ! Initialize the FIRQB. $XRSTS_INI_XRB; ! Initialize the XRB. ! Setup the XRB: $XRSTS_XRB[XRLEN] = .iob[max_string_len]; ! size of the buffer in bytes $XRSTS_XRB[XRLOC] = .iob[IOB$A_STRING]; ! starting address of buffer $XRSTS_XRB[XRCI] = 0; ! channel number times 2 (user's terminal is always 0) $READ; ! Read from the terminal. IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 THEN IF .$XRSTS_FIRQB[FQIOSTS] EQL RSTS$_EOF ! If end-of-file was reached, THEN ! IF .$XRSTS_XRB[XRBC] LEQ 1 ! (^Z is counted as one character) THEN ! LEAVE READ_BLOCK ! either jump to end-of-file processing ELSE ! iob[IOB$V_EOF] = yes ! or indicate a pending end-of-file. ELSE BEGIN ! If any other error occurred, XRST$ERROR(.iob,.$XRSTS_FIRQB[FQIOSTS]);! convert the RSTS error codes into XPORT completion codes $XPO_QUIT(); ! and return these codes to the caller. END; iob[IOB$H_STRING] = .$XRSTS_XRB[XRBC]; ! Indicate how many characters were read ! ! Remove any control characters from the end of the record. ! buffer_pointer = CH$PLUS( .iob[IOB$A_STRING], ! Point past the last input character. .iob[IOB$H_STRING] ); WHILE .iob[IOB$H_STRING] GTR 0 DO ! Loop to remove control characters from BEGIN ! the end of the input record. buffer_pointer = ! Decrement the buffer pointer. CH$PLUS( .buffer_pointer, -1 ); value = CH$RCHAR( .buffer_pointer ); ! Pickup the last character in the record. IF .value EQL cr OR .value EQL ctrl_z OR ! If the character is a control character, .value EQL lf OR .value EQL esc OR ! .value EQL ff OR .value EQL ctrl_d ! THEN ! iob[IOB$H_STRING] = ! decrement the record length. .iob[IOB$H_STRING] - 1 ELSE EXITLOOP; ! Otherwise, exit this cleanup loop. END; $XPO_QUIT(); ! and return the current success code to the caller. END; %FI %TITLE 'RSTS/E Record-mode GET from record file' %IF $RSTS %THEN !+ ! ! RSTS/E Record-mode GET From a Record Format File ! !- IF .iob[IOB$V_RECORD] AND ! Test for record-mode input and a record format file. ( .rsts_cb[XRSTS$V_RECF] EQL RSTS$K_FIXED OR .rsts_cb[XRSTS$V_RECF] EQL RSTS$K_VARIABLE OR .rsts_cb[XRSTS$V_RECF] EQL RSTS$K_VFC ) THEN BEGIN LOCAL record_length; ! Length of current record ! ! Fill the XPORT internal buffer if it is empty. ! IF .rsts_cb[XRSTS$G_BFCTR] EQL 0 THEN SELECTONE XRST$IN( .iob ) OF SET [ XPO$_END_FILE ] : LEAVE read_block; [ XPO$_NORMAL ] : XPO$_NORMAL; [ OTHERWISE ] : $XPO_QUIT(); TES; ! ! Determine the current record length based on the record format ! and adjust the buffer pointer if necessary. ! SELECTONE .rsts_cb[XRSTS$V_RECF] OF SET [ RSTS$K_FIXED ] : record_length = .iob[IOB$G_REC_SIZE]; [ RSTS$K_VARIABLE ] : BEGIN record_length = ..rsts_cb[XRSTS$A_BFPTR]; rsts_cb[XRSTS$A_BFPTR] = .rsts_cb[XRSTS$A_BFPTR] + 2; rsts_cb[XRSTS$G_BFCTR] = .rsts_cb[XRSTS$G_BFCTR] - 2; END; [ RSTS$K_VFC ] : BEGIN record_length = ..rsts_cb[XRSTS$A_BFPTR] - .rsts_cb[XRSTS$V_FIXS]; rsts_cb[XRSTS$A_BFPTR] = .rsts_cb[XRSTS$A_BFPTR] + 2 + .rsts_cb[XRSTS$V_FIXS]; rsts_cb[XRSTS$G_BFCTR] = .rsts_cb[XRSTS$G_BFCTR] - 2 - .rsts_cb[XRSTS$V_FIXS]; END; TES; ! ! Copy the record text into another XPORT internal buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that the input record buffer is empty. WHILE .record_length GTRU .rsts_cb[XRSTS$G_BFCTR] DO BEGIN $XPO_IF_NOT( $STR_APPEND( STRING = ( .rsts_cb[XRSTS$G_BFCTR], .rsts_cb[XRSTS$A_BFPTR] ), TARGET = iob[IOB$H_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); record_length = .record_length - .rsts_cb[XRSTS$G_BFCTR]; SELECTONE XRST$IN( .iob ) OF SET [ XPO$_END_FILE ] : $XPO_QUIT( SYS_ERROR, END_FILE ); [ XPO$_NORMAL ] : XPO$_NORMAL; [ OTHERWISE ] : $XPO_QUIT(); TES; END; $XPO_IF_NOT( $STR_APPEND( STRING = ( .record_length, .rsts_cb[XRSTS$A_BFPTR] ), TARGET = iob[IOB$H_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); record_length = .record_length + 1 ! Round record length up to even number. AND %X'FFFE'; ! ! Adjust the buffer pointer and remaining buffer count. ! rsts_cb[XRSTS$A_BFPTR] = .rsts_cb[XRSTS$A_BFPTR] + .record_length; rsts_cb[XRSTS$G_BFCTR] = .rsts_cb[XRSTS$G_BFCTR] - .record_length; ! ! Determine whether the next record is in the current buffer. ! SELECTONE .rsts_cb[XRSTS$V_RECF] OF SET [ RSTS$K_FIXED ] : IF .iob[IOB$G_REC_SIZE] GTRU .rsts_cb[XRSTS$G_BFCTR] AND (.rsts_cb[XRSTS$V_PRIC] AND RSTS$K_NO_SPAN) NEQ 0 THEN rsts_cb[XRSTS$G_BFCTR] = 0; [ RSTS$K_VFC ] : IF .rsts_cb[XRSTS$G_BFCTR] NEQ 0 AND ..rsts_cb[XRSTS$A_BFPTR] EQL 0 THEN rsts_cb[XRSTS$G_BFCTR] = 0; TES; ! ! Return to the caller after a successful GET. ! $XPO_QUIT(); END; %FI %TITLE 'RSTS/E Record-mode GET from Stream File' %IF $RSTS %THEN !+ ! ! RSTS/E Record-mode GET from a Stream Format File ! ! Note that the following section is very similar to TOPS-10/RT11 ! record-mode GET processing for file. !- IF .iob[IOB$V_RECORD] ! If this a record-mode character file, THEN ! execute the following block. BEGIN ! ! Allocate a buffer if we haven't already. ! IF .iob[max_string_len] EQL 0 THEN BEGIN $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a buffer. CHARACTERS = buffer_length, DESCRIPTOR = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Report any errors. END; ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Process any page or sequence number information in the record. ! iob[IOB$G_SEQ_NUMB] = ! Simply increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; ! ! Move a single record into the local input buffer. ! buffer_pointer = .iob[IOB$A_STRING]; ! Setup the local input buffer pointer. WHILE 1 DO ! Fill the input buffer a character at a time. BEGIN SELECTONE XRST$GET_FILE(.iob,value) OF ! Read one character from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return to caller with the preset completion code. TES; IF .value EQL lf ! If the character is a line feed, THEN ! EXITLOOP; ! exit the read loop. IF .iob[IOB$H_STRING] GTR 0 OR ! If a non-null character has been found .value NEQ null ! THEN ! BEGIN ! put it into the XPORT input buffer. IF .iob[IOB$H_STRING] GEQ ! If the XPORT input buffer is full, .iob[max_string_len] ! THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a larger input buffer. CHARACTERS = (.iob[max_string_len] + buffer_length), RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); buffer_pointer = ! Copy the current input data into the new buffer. CH$MOVE( .iob[IOB$H_STRING], .iob[IOB$A_STRING], .new_buffer ); $XPO_FREE_QUIT( ! Free the original input buffer STRING = (.iob[IOB$H_STRING], ! but don't zero the descriptor length fields. .iob[IOB$A_STRING]) ); ! Update the XPORT input buffer descriptor: iob[IOB$A_STRING] = .new_buffer; ! pointer to input buffer iob[max_string_len] = ! length of the input buffer .iob[max_string_len] + buffer_length; END; CH$WCHAR_A( .value, buffer_pointer ); ! Put the new character into the XPORT input buffer iob[IOB$H_STRING] = ! and increment the input record length. .iob[IOB$H_STRING] + 1; END; END; ! ! Remove any control characters from the end of the record. ! buffer_pointer = CH$PLUS( .iob[IOB$A_STRING], ! Point past the last input character. .iob[IOB$H_STRING] ); WHILE .iob[IOB$H_STRING] GTR 0 DO ! Loop to remove control characters from BEGIN ! the end of the input record. buffer_pointer = ! Decrement the buffer pointer. CH$PLUS( .buffer_pointer, -1 ); value = CH$RCHAR( .buffer_pointer ); ! Pickup the last character in the record. IF .value EQL cr ! If the character is a carriage return, THEN ! iob[IOB$H_STRING] = ! decrement the record length. .iob[IOB$H_STRING] - 1 ELSE EXITLOOP; ! Otherwise, exit this cleanup loop. END; $XPO_QUIT(); ! Return the current success code to the caller. END; %FI %TITLE 'RSTS/E Stream-mode and Binary-mode GET' %IF $RSTS %THEN !+ ! ! RSTS/E Stream-mode and Binary-mode GET Processing ! ! Note that the following section depends on IOB$T_STRING and IOB$T_DATA ! being the same actual IOB fields and resembles TOPS-10/TOPS-20/RT11 GET processing. ! !- ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Allocate a new input buffer if the current buffer is too small. ! IF .req_length GTR .iob[max_string_len] ! If the current input buffer is too small, THEN ! BEGIN ! $XPO_FREE_QUIT( STRING = iob[IOB$T_STRING] ); ! free the buffer. $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new input buffer. UNITS = .req_length, RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Update the input data descriptor: iob[IOB$A_STRING] = .new_buffer; ! new input buffer pointer/address iob[max_string_len] = .req_length; ! length of the new input buffer END; ! ! Setup a local pointer to the input buffer. ! buffer_pointer = .iob[IOB$A_STRING]; ! Pickup the buffer pointer. ! ! Fill the input buffer one character/value at a time. ! INCR count FROM 1 TO .req_length DO ! Fill the buffer one character/value at a time. BEGIN IF .iob[IOB$V_TERMINAL] ! If this is a terminal file, THEN ! BEGIN ! $TTDDT; ! Enable stream mode input from terminal. $XRSTS_INI_FIRQB; ! Initialize the FIRQ. $XRSTS_INI_XRB; ! Initialize the XRB. ! Setup the XRB: $XRSTS_XRB[XRLEN] = 1; ! terminal input buffer length $XRSTS_XRB[XRLOC] = value; ! buffer address $XRSTS_XRB[XRCI] = 0; ! channel number times 2(user's terminal is always 0) $READ; ! Read one character from the user's terminal. IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! THEN ! BEGIN ! IF .$XRSTS_FIRQB[FQIOSTS] EQL RSTS$_EOF ! THEN ! IF .iob[IOB$H_STRING] EQL 0 ! THEN ! and jump to EOF processing if it is the LEAVE READ_BLOCK ! first character read ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END ELSE BEGIN XRST$ERROR(.iob, .$XRSTS_FIRQB[FQIOSTS]); $XPO_QUIT(); END; END; END ELSE SELECTONE XRST$GET_FILE( .iob, value ) OF ! Read one character from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return error codes to the caller. TES; CH$WCHAR_A( .value, buffer_pointer ); ! Move one character into the buffer iob[IOB$H_STRING] = .iob[IOB$H_STRING] + 1; ! and increment the data length. END; ! ! Calculate the number of fullwords of binary data which have been read. ! IF .iob[IOB$V_BINARY] ! If this is a binary read, THEN ! iob[IOB$H_FULLWORDS] = ! calculate the number of complete BLISS fullwords read. .iob[IOB$H_UNITS] / %UPVAL; ! ! Check for a truncated input request. ! IF .iob[IOB$H_STRING] LSS .req_length ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of RSTS/E input processing. !+ ! ! End of RSTS/E GET Processing ! !- %FI %TITLE 'RT-11 Record-mode GET' %IF $RT11 %THEN !+ ! ! RT-11 Record-mode GET Processing for File and Terminal. ! ! Note that the following section is very similar to TOPS-10 ! record-mode GET processing for file and terminal. !- IF .iob[IOB$V_RECORD] ! If this a record-mode character file, THEN ! execute the following block. BEGIN ! ! Allocate a buffer if we haven't already. ! IF .iob[max_string_len] EQL 0 THEN BEGIN $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a buffer. CHARACTERS = buffer_length, DESCRIPTOR = iob[IOB$T_STRING], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Report any errors. END; ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Process any page or sequence number information in the record. ! iob[IOB$G_SEQ_NUMB] = ! Simply increment the input record count. .iob[IOB$G_SEQ_NUMB] + 1; ! ! Move a single record into the local input buffer. ! buffer_pointer = .iob[IOB$A_STRING]; ! Setup the local input buffer pointer. WHILE 1 DO ! Fill the input buffer a character at a time. BEGIN IF .iob[IOB$V_TERMINAL] ! If this is a terminal file, THEN ! read one character from the user's terminal BEGIN ! $TTYIN( value ); ! in record mode (wait for end-of-line). IF .value EQL ctrl_z ! If the character is a ^Z, THEN ! BEGIN ! $PRINT( ! echo a CR/LF UPLIT( %STRING(%CHAR(cr,lf,0)) ) ); ! ! IF .iob[IOB$H_STRING] EQL 0 ! THEN ! and jump to EOF processing if it is the LEAVE READ_BLOCK ! first character on the line ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END; END; END; IF NOT .iob[IOB$V_TERMINAL] ! Here if working with files. THEN BEGIN SELECTONE XRT$GET_FILE(.iob,value) OF ! Otherwise, read one character from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return to caller with the preset completion code. TES; END; IF .value EQL lf ! If the character is a line feed, THEN ! EXITLOOP; ! exit the read loop. IF .iob[IOB$H_STRING] GTR 0 OR ! If a non-null character has been found .value NEQ null ! THEN ! BEGIN ! put it into the XPORT input buffer. IF .iob[IOB$H_STRING] GEQ ! If the XPORT input buffer is full, .iob[max_string_len] ! THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a larger input buffer. CHARACTERS = (.iob[max_string_len] + buffer_length), RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); buffer_pointer = ! Copy the current input data into the new buffer. CH$MOVE( .iob[IOB$H_STRING], .iob[IOB$A_STRING], .new_buffer ); $XPO_FREE_QUIT( ! Free the original input buffer STRING = (.iob[IOB$H_STRING], ! but don't zero the descriptor length fields. .iob[IOB$A_STRING]) ); ! Update the XPORT input buffer descriptor: iob[IOB$A_STRING] = .new_buffer; ! pointer to input buffer iob[max_string_len] = ! length of the input buffer .iob[max_string_len] + buffer_length; END; CH$WCHAR_A( .value, buffer_pointer ); ! Put the new character into the XPORT input buffer iob[IOB$H_STRING] = ! and increment the input record length. .iob[IOB$H_STRING] + 1; END; END; ! ! Remove any control characters from the end of the record. ! buffer_pointer = CH$PLUS( .iob[IOB$A_STRING], ! Point past the last input character. .iob[IOB$H_STRING] ); WHILE .iob[IOB$H_STRING] GTR 0 DO ! Loop to remove control characters from BEGIN ! the end of the input record. buffer_pointer = ! Decrement the buffer pointer. CH$PLUS( .buffer_pointer, -1 ); value = CH$RCHAR( .buffer_pointer ); ! Pickup the last character in the record. IF .value EQL cr ! If the character is a carriage return, THEN ! iob[IOB$H_STRING] = ! decrement the record length. .iob[IOB$H_STRING] - 1 ELSE EXITLOOP; ! Otherwise, exit this cleanup loop. END; $XPO_QUIT(); ! Return the current success code to the caller. END; %FI %TITLE 'RT-11 Stream-mode and Binary-mode GET' %IF $RT11 %THEN !+ ! ! RT-11 Stream-mode and Binary-mode GET Processing ! ! Note that the following section depends on IOB$T_STRING and IOB$T_DATA ! being the same actual IOB fields and resembles TOPS-10/TOPS-20 GET processing. ! !- ! ! Indicate that no data has been read into the XPORT input buffer. ! iob[IOB$H_STRING] = 0; ! Indicate that no data has been read. ! ! Allocate a new input buffer if the current buffer is too small. ! IF .req_length GTR .iob[max_string_len] ! If the current input buffer is too small, THEN ! BEGIN ! $XPO_FREE_QUIT( STRING = iob[IOB$T_STRING] ); ! free the buffer. $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new input buffer. UNITS = .req_length, RESULT = new_buffer, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! Update the input data descriptor: iob[IOB$A_STRING] = .new_buffer; ! new input buffer pointer/address iob[max_string_len] = .req_length; ! length of the new input buffer END; ! ! Setup a local pointer to the input buffer. ! buffer_pointer = .iob[IOB$A_STRING]; ! Pickup the buffer pointer. ! ! Set the special mode TT bit for terminal files. ! IF .iob[IOB$V_TERMINAL] THEN RT_JSW_STT = yes; ! ! Fill the input buffer one character/value at a time. ! INCR count FROM 1 TO .req_length DO ! Fill the buffer one character/value at a time. BEGIN IF .iob[IOB$V_TERMINAL] ! If this is a terminal file, THEN ! BEGIN ! $TTYIN( value ); ! read one character from the terminal $TTYOUT( value ); ! and echo the character. IF .value EQL ctrl_z ! If a ^Z is read from the terminal, THEN ! BEGIN ! $PRINT( ! echo a CR/LF UPLIT( %STRING(%CHAR(cr,lf,0)) ) ); ! ! IF .iob[IOB$H_STRING] EQL 0 ! THEN ! and jump to EOF processing if it is the LEAVE READ_BLOCK ! first character read ELSE ! BEGIN ! iob[IOB$V_EOF] = yes; ! or turn on the EOF indicator EXITLOOP; ! and then exit the terminal read loop. END; END; END ELSE SELECTONE XRT$GET_FILE( .iob, value ) OF ! Read one character from the data file SET ! and process any error completion code. [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$H_STRING] EQL 0 ! If no data has been read, THEN ! LEAVE READ_BLOCK ! jump to EOF processing. ELSE ! BEGIN ! Otherwise, iob[IOB$V_EOF] = yes; ! turn on the EOF indicator EXITLOOP; ! and exit the character read loop. END; [ XPO$_NORMAL ] : ! Successful return: XPO$_NORMAL; ! Just fall out of 'SELECTONE' [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return error codes to the caller. TES; CH$WCHAR_A( .value, buffer_pointer ); ! Move one character into the buffer iob[IOB$H_STRING] = .iob[IOB$H_STRING] + 1; ! and increment the data length. END; ! ! Calculate the number of fullwords of binary data which have been read. ! IF .iob[IOB$V_BINARY] ! If this is a binary read, THEN ! iob[IOB$H_FULLWORDS] = ! calculate the number of complete BLISS fullwords read. .iob[IOB$H_UNITS] / %UPVAL; ! ! Check for a truncated input request. ! IF .iob[IOB$H_STRING] LSS .req_length ! If not enough data was read, THEN ! $XPO_QUIT( INCOMPLETE ) ! return a non-standard success code to the caller. ELSE $XPO_QUIT(); ! Otherwise, return the current success code to the caller. END; ! End of RT-11 input processing. !+ ! ! End of RT-11 GET Processing ! !- %FI %TITLE 'XPO$GET - Common End-of-File Processing' !+ ! ! Continuation of system-independent file input processing ! !- END; ! End of READ_BLOCK block ! ! Input end-of-file processing. ! iob[IOB$V_EOF] = yes; ! Indicate end-of-file has been reached. BEGIN BIND concat = iob[IOB$T_CONCAT] : $STR_DESCRIPTOR( CLASS = DYNAMIC_BOUNDED ); IF NOT .iob[IOB$V_CONC_SPEC] OR ! If there was no input concatenation .concat[STR$H_LENGTH] + ! or the last concatenated file has already been read, .concat[STR$H_PFXLEN] GEQ ! .concat[STR$H_MAXLEN] ! THEN ! $XPO_QUIT( END_FILE ); ! return a warning failure code to the caller. END; ! ! Automatic input concatenation at end-of-file. ! iob[IOB$V_AUTO_CONC] = yes; ! Indicate that input switching is in progress so ! that XPO$CLOSE will not reset vital IOB information. IF NOT XPO$CLOSE( .iob, 0, 0 ) ! If the current file cannot be closed, THEN ! $XPO_QUIT(); ! jump to XPO$GET termination. IF NOT XPO$OPEN( .iob, 0, 0 ) ! If the next input file cannot be opened, THEN ! $XPO_QUIT(); ! jump to XPO$GET termination. ! Otherwise, if the open was successful, iob[IOB$V_AUTO_CONC] = no; ! turn off the input switching indicator, ! iob[IOB$G_COMP_CODE] = XPO$_NEW_FILE; ! setup the success completion code for the ! first get operation on the new file, ! END; ! and then loop back to attempt reading the new file. %TITLE 'XPO$GET - Routine Termination' !+ ! ! XPORT routine termination. ! !- $XPO_MAIN_END; ! End of MAIN_BLOCK code block ! ! Call an appropriate action routine. ! $XPO_ACTION_RTN( .iob ); ! ! Cleanup the IOB after a GET failure. ! IF NOT .iob[IOB$G_COMP_CODE] ! If the GET operation failed, THEN ! iob[IOB$V_AUTO_CONC] = no; ! turn off auto-concatenation so CLOSE can perform ! standard IOB cleanup. %IF $RT11 %THEN IF .iob[IOB$V_TERMINAL] ! Set the terminal characteristics to their orignal state. THEN BEGIN RT_JSW_LC = .lower_case_bit; RT_JSW_STT = .special_mode; END; %FI ! ! Return to the caller. ! RETURN .iob[IOB$G_COMP_CODE] ! Return the IOB completion code to the caller. END; END ELUDOM