MODULE XRT11 ( IDENT = 'X00.04' %TITLE 'RT-11-specific XPORT Routines' ) = BEGIN ! ! COPYRIGHT (c) 1980 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 contains all XPORT routines which are specific to RT-11. ! ! ENVIRONMENT: User mode ! ! AUTHOR: Linda Duffell CREATION DATE: 25 January 1980 ! !-- ! ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $RT11 ) REQUIRE 'XRT11'; ! RT-11 system interface definitions ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XRT$ASCII_RAD50 : NOVALUE, ! ASCII to RADIX-50 conversion routine XRT$CHK_BACKGRD, ! Verification of a background job XRT$FETCH, ! Fetch handler routine XRT$IN, ! Input processing XRT$OUT, ! Output processing XRT$GET_FILE, ! Disk file read routine XRT$CLOSE; ! Close processing ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! LITERAL yes = 1, ! Used to turn an indicator on no = 0; ! Used to turn an indicator off ! ! PSECT DECLARATIONS: ! ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE XRT$ASCII_RAD50( pointer, length, storage_area, storage_size, fill ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine converts a string of ASCII characters to RADIX-50 and returns ! the converted string in the storage_area provided. It converts only as many ! characters as the storage_area can accomodate. ! ! FORMAL PARAMETERS: ! ! pointer = pointer to the ASCII string ! length = length of the ASCII string in characters ! storage_area = address of where to store converted RADIX-50 string ! storage_size = word size of storage_area ! fill = fill character ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN BIND rad50_area = .storage_area : VECTOR; LOCAL string_pointer, ! pointer to the ASCII string string_length, ! length of the ASCII string character, ! single ASCII character rad50_char : VECTOR[3]; ! Radix-50 characters (3 per word) ! ! Initialize the local pointers. ! string_pointer = .pointer; ! Initialize the ASCII string and string_length = .length; ! length. ! ! Convert the ASCII string one character at a time. ! INCR word_count FROM 0 TO .storage_size-1 DO ! Convert only as many characters as the storage area can accomodate. BEGIN INCR index FROM 0 TO 2 DO ! Only 3 RADIX-50 characters per word BEGIN IF .string_length EQL 0 ! If all of the input characters have been converted, THEN ! rad50_char[.index] = .fill ! insert the fill characters. ELSE BEGIN character = CH$RCHAR_A(string_pointer); ! Otherwise, pickup the next input character. string_length = .string_length - 1; rad50_char[.index] = ! Convert ASCII characters to RADIX-50 characters. ( SELECTONEU .character OF SET [ %O'40' ] : 0; [ %C'$' ] : %O'33'; [ %C'.' ] : %O'34'; [ %C'0' TO %C'9' ]: .character - %O'22'; [ %C'A' TO %C'Z' ] : .character - %O'100'; [ %C'a' TO %c'z' ] : .character - %O'140'; [ OTHERWISE ] : %O'35'; TES ); END; END; rad50_area[.word_count] = ! Save the 3 RADIX-50 characters in one word. .rad50_char[0] * %O'3100' + .rad50_char[1] * %O'50' + .rad50_char[2] ; END; ! ! Return the converted string value to the caller. ! RETURN ! Return to the caller. END; GLOBAL ROUTINE XRT$CHK_BACKGRD = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine verifies that the job is a background job. ! ! FORMAL PARAMETERS: ! ! none ! ! IMPLICIT INPUTS: ! ! none ! ! IMPLICIT OUTPUTS: ! ! none ! ! COMPLETION CODES: ! ! XPO$_NORMAL - the job is a background job ! XPO$_FOREGROUND - the job is a foreground job ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN LOCAL gtjb_args : $XRT_GTJB_ARGS; ! Set up the GTJB argument list ! ! Determine if this is a background job. ! $GTJB( gtjb_args ); ! Get the job number and IF .gtjb_args[ GTJB$T_JOB ] NEQ 0 ! check if it is a background job. THEN RETURN XPO$_FOREGROUND; ! Return an error code if it isn't. RETURN XPO$_NORMAL ! Otherwise, return a normal completion code. END; GLOBAL ROUTINE XRT$FETCH( iob, device_name ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine checks if the I/O handler for the specified device ! is in core. If not, it allocates enough space and fetches the handler. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! device_name - address of RADIX-50 device name ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! For error conditions, iob[IOB$G_COMP_CODE] is set. ! ! COMPLETION CODES: ! ! XPO$_NORMAL - specified device I/O handler is in core ! XPO$_BAD_DEVICE - device not found ! XPO$_GET_MEM - buffer allocation error ! (IOB$G_2ND_CODE = completion code from $XPO_GET_MEM) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter $FIELD handler_fields = ! Handler descriptor: SET ! handler_link = [$ADDRESS], ! address of the next handler element handler_size = [$ADDRESS], ! handler size handler_name = [$ADDRESS] ! handler name TES; LITERAL handler_elem_sz = $FIELD_SET_SIZE; ! Length of a handler descriptor MACRO handler_element = BLOCK[ handler_elem_sz ] FIELD( handler_fields ) %; OWN handler_chain : handler_element ! Dummy handler descriptor to head of handler chain PRESET( [handler_link]=0, [handler_size]=0, [handler_name]=0 ); LOCAL prev_handler : REF handler_element, ! Address of previous handler element curr_handler : REF handler_element, ! Address of current handler element status_block : VECTOR[4]; ! Storage area for the device status words ! ! Get the status of the device handler. ! IF NOT $DSTATUS( ! Obtain the device status: status_block, ! storage area for status words CH$PTR(.device_name) ) ! pointer to device name THEN $XPO_RETURN( BAD_DEVICE ); ! Report any errors ! ! Fetch the device handler if it isn't already in core ! IF .status_block[2] EQL 0 ! If the handler is not already in memory THEN ! BEGIN ! prev_handler = handler_chain; ! point to the head of the handler element chain WHILE ! Loop to the end of the handler element chain (curr_handler = .prev_handler[handler_link]) NEQ 0 DO prev_handler = curr_handler; $XPO_IF_NOT( ! Allocate enough memory for the handler. $XPO_GET_MEM( UNITS = (.status_block[1]) + (handler_elem_sz * %UPVAL), RESULT = prev_handler[handler_link], FAILURE = 0 ) ) THEN $XPO_RETURN( GET_MEM, (.$XPO_STATUS) ); curr_handler = .prev_handler[handler_link]; ! Point to the new handler element curr_handler[handler_size] = .status_block[1]; ! Save the size of the handler curr_handler[handler_name] = .(.device_name); ! Save the name of the device $FETCH( ! FETCH the handler: curr_handler + (handler_elem_sz * %UPVAL),! address of where to store the handler CH$PTR( curr_handler[handler_name] ) ); ! pointer to device name END; RETURN XPO$_NORMAL END; GLOBAL ROUTINE XRT$IN( iob ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine allocates an input buffer ( if 1st time through ) and fills the ! input buffer. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The input buffer control_block (IOB$A_BUFFER_CB) is updated. ! ! For error conditions other than XPO$_END_FILE, the followin IOB field is set: ! iob[IOB$G_COMP_CODE] ! ! COMPLETION CODES: ! ! XPO$_NORMAL - input buffer has been filled sucessfully ! XPO$_END_FILE - end-of-file reached ! XPO$_GET_MEM - buffer allocation error ! (IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! XPO$_IO_ERROR - hard error occurred on channel ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR, ! Buffer control block channel = .iob[IOB$H_CHANNEL]; LOCAL error_code, ! Storage area for error conditions count, status; ! ! Initialize the error condition code. ! error_code = no; ! ! Allocate an input buffer if first input. ! IF .buffer_cb[$BFADR] EQL 0 ! If this is the first input THEN ! BEGIN ! allocate an input buffer. $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = XRT$K_BUFFER_SZ, RESULT = buffer_cb[$BFADR], FAILURE = 0) ) THEN $XPO_RETURN( GET_MEM, (.$XPO_STATUS) ); buffer_cb[$BFBLK] = 0; ! First block of file is always zero. END; ! ! Fill the input buffer. ! count = $READW( ! Fill the input buffer: channel, ! channel number .buffer_cb[$BFADR], ! address of input buffer XRT$K_BUFFER_SZ, ! buffer size .buffer_cb[$BFBLK], ! block number of file error_code = yes ); ! set this if an error occurs IF .error_code THEN IF .RT_ERR_EMT ! Return appropriate error conditions to the caller. THEN $XPO_RETURN( IO_ERROR ) ELSE RETURN XPO$_END_FILE; ! ! Update the input buffer control_block ! buffer_cb[$BFBLK] = .buffer_cb[$BFBLK] + 1; ! Point to the next block of the file. buffer_cb[$BFCTR] = .count * 2; ! Save the number of characters in the buffer control block. buffer_cb[$BFPTR] = CH$PTR(.buffer_cb[$BFADR]); ! Save a character pointer to the buffer. RETURN XPO$_NORMAL END; GLOBAL ROUTINE XRT$OUT( iob ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine allocates an output buffer the first time it is called. ! From then on it outputs the output buffer to the file associated with the channel. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The output buffer control_block (IOB$A_BUFFER_CB) is updated. ! ! For error conditions the following IOB field is set: ! iob[IOB$G_COMP_CODE] ! ! COMPLETION CODES: ! ! XPO$_NORMAL - empty buffer or ! output buffer has been allocated or ! output buffer has been output sucessfully ! XPO$_GET_MEM - buffer allocation error ! ( IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! XPO$_IO_ERROR - hardware error ! XPO$_IO_ERROR - attempt to write past EOF ! ( IOB$G_2ND_CODE = XPO$_END_FILE ) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR, ! Buffer control block channel = .iob[IOB$H_CHANNEL]; LOCAL error_code, ! Storage area for error conditions count; ! Storage area for output buffer byte count ! ! Initialize the error condition code. ! error_code = no; ! ! Just allocate an output buffer the first time through. ! IF .buffer_cb[$BFADR] EQL 0 THEN BEGIN $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = XRT$K_BUFFER_SZ, RESULT = buffer_cb[$BFADR], FAILURE = 0) ) THEN $XPO_RETURN( GET_MEM, (.$XPO_STATUS) ); END ELSE ! ! Otherwise, output the buffer. ! BEGIN count = ( XRT$K_BUFFER_SZ * 2 - ! Convert the count to reflect word mode. .buffer_cb[$BFCTR] + 1 ) / 2; IF .count EQL 0 ! If there isn't any data in the buffer, THEN ! RETURN XPO$_NORMAL; ! return a success code to the caller. $WRITW( ! Output the buffer: channel, ! channel number .buffer_cb[$BFADR], ! address of output buffer .count, ! number of words to be written .buffer_cb[$BFBLK], ! block number to be written error_code = yes ); ! set this if an error occurs IF .error_code THEN IF .RT_ERR_EMT ! Return appropriate error conditions to the caller. THEN $XPO_RETURN( IO_ERROR ) ELSE $XPO_RETURN( IO_ERROR, END_FILE ); buffer_cb[$BFBLK] = .buffer_cb[$BFBLK] + 1; ! Point to the next block of the file. END; ! ! Clear out the output buffer. ! INCR index FROM 0 TO (XRT$K_BUFFER_SZ ^1) - 1 BY 2 DO ! Make sure to start off with an empty output buffer. ( .buffer_cb[$BFADR] + .index ) = 0; ! ! Update the output buffer control_block. ! buffer_cb[$BFCTR] = XRT$K_BUFFER_SZ * 2; ! Set the counter in terms of characters. buffer_cb[$BFPTR] = CH$PTR(.buffer_cb[$BFADR]); ! Save a character pointer to the buffer. RETURN XPO$_NORMAL END; GLOBAL ROUTINE XRT$GET_FILE( iob, value_pointer ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine reads a single character from a disk ! file and returns this character to the caller. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! value_pointer - address of character deposit area ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! For certain error conditions, other than XPO$_END_FILE, the following IOB fields are set: ! iob[IOB$G_COMP_CODE] ! iob[IOB$G_2ND_CODE] ! ! COMPLETION CODES: ! ! XPO$_NORMAL - character successfully read ! XPO$_END_FILE - end-of-file reached ! failure completion codes from XRT$IN ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR; ! TOPS-10/TOPS-20 buffer control block ! ! Fill the system input buffer if necessary. ! buffer_cb[$BFCTR] = .buffer_cb[$BFCTR] - 1; ! Decrement the input buffer count. IF .buffer_cb[$BFCTR] LSS 0 ! If the buffer was empty, THEN ! SELECTONE XRT$IN( .iob ) OF ! Fill the next input buffer. SET [ XPO$_NORMAL ] : ! Successful input: buffer_cb[$BFCTR] = ! Decrement the new byte count. .buffer_cb[$BFCTR] -1; [ XPO$_END_FILE ]: ! End-of-file: RETURN XPO$_END_FILE; ! Return error to caller. [ OTHERWISE ]: ! All other error conditions: RETURN .iob[IOB$G_COMP_CODE]; ! Return the final completion code to the caller. TES; ! ! Pass a single character or value back to the caller. ! .value_pointer = CH$RCHAR_A( buffer_cb[$BFPTR] ); ! Pass back a character. ! ! Return to the caller ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; GLOBAL ROUTINE XRT$CLOSE( iob ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine checks to see if output is being done and if so, ! all data in the buffers that has not been transmitted to the ! device is written to the device. ! ! It gives back any dynamic memory allocated for the I/O buffers ! it closes the file and releases the channel. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The buffer control_block (IOB$A_BUFFER_CB) is zeroed out. ! ! COMPLETION CODES: ! ! XPO$_NORMAL - file has been closed successfully ! XPO$_FREE_MEM - error deallocating IOB-related memory ! ( IOB$G_2ND_CODE = completion code from $XPO_FREE_MEM ) ! failure completion codes from XRT$OUT ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB. BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR, channel = .iob[IOB$H_CHANNEL]; ! ! Transmit any leftover data if doing output. ! IF .buffer_cb[$BFADR] NEQ 0 ! Make sure we've allocated a buffer. THEN BEGIN IF .iob[IOB$V_OUTPUT] ! If we're doing output, THEN ! IF NOT XRT$OUT( .iob ) ! clear out all data from the buffer. THEN RETURN .iob[IOB$G_COMP_CODE]; ! Report any error to the caller. ! ! Free the internal XPORT I/O buffer. ! $XPO_IF_NOT( $XPO_FREE_MEM( BINARY_DATA = (XRT$K_BUFFER_SZ, .buffer_cb[$BFADR]), FAILURE = 0) ) THEN $XPO_RETURN( FREE_MEM, (.$XPO_STATUS) ); INCR count from 0 to 3 DO ! Zero out the buffer control block. buffer_cb[.count] = 0; END; ! ! Close the file and release the channel. ! $CLOSE( channel); ! Close and release the channel. RETURN XPO$_NORMAL END; END ELUDOM