MODULE XT10 ( IDENT = 'X00.04' %TITLE 'TOPS-10-specific XPORT Routines' %BLISS16( ,OLDBLISS='EIS' ) %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( X10$CHAN_ASSIGN, X10$ASCII_6BIT, X10$ENTER_LOOKUP, X10$LOOKUP_FINI, X10$SEQ_INFO, X10$GET_FILE, X10$CLEANUP ),OTS='' ) ) = BEGIN ! ! COPYRIGHT (c) 1979 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module contains all XPORT routines which are specific to TOPS-10. ! ! ENVIRONMENT: User mode ! ! AUTHOR: Ward Clark, CREATION DATE: 27 April 1979 ! !-- ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $TOPS10 ) REQUIRE 'XT10' ; ! TOPS-10 I/O interface macros ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE X10$CHAN_ASSIGN, ! Channel assignment routine X10$ASCII_6BIT, ! ASCII to 6-bit conversion routine X10$ENTER_LOOKUP, ! Enter/Lookup block setup routine X10$LOOKUP_FINI, ! ENTER/LOOKUP block setup completion routine X10$SEQ_INFO, ! Page/sequence number processing X10$GET_FILE, ! TOPS-10 disk file read routine X10$CLEANUP; ! TOPS-10 control block cleanup routine ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! LITERAL yes = 1, no = 0, maximum_chan = 15; ! Maximum channel number ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! OWN channel_vector : BITVECTOR[ maximum_chan + 1 ]; ! I/O channel assignment vector ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE X10$CHAN_ASSIGN( iob ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine assigns a TOPS10 channel number. ! ! FORMAL PARAMETERS: ! ! iob - address of an IOB ! ! IMPLICIT INPUTS: ! ! Information contained in or pointed to by the caller's IOB ! ! IMPLICIT OUTPUTS: ! ! The IOB channel field and flag is setup. ! ! COMPLETION CODES: ! ! XPO$_NORMAL - setup was successfully completed ! XPO$_NO_CHANNEL - no I/O channel is available ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! ! Assign an I/O channel ! INCR channel FROM 0 TO maximum_chan + 1 DO ! Search for an unused I/O channel. BEGIN IF .channel GTR maximum_chan ! If all channels have been assigned THEN ! $XPO_RETURN ( NO_CHANNEL ); ! return an error code to the caller. IF NOT .channel_vector[.channel] ! If this channel is not assigned, THEN ! BEGIN ! channel_vector[.channel] = yes; ! indicate that this channel is in use, iob[IOB$H_CHANNEL] = .channel; ! save the number in the IOB, iob[IOB$V_CH_ASSIGN] = yes; ! indicate that the channel has been assigned EXITLOOP; ! and exit the search loop. END; END; ! ! Return to the caller. ! RETURN XPO$_NORMAL; END; GLOBAL ROUTINE X10$ASCII_6BIT( length, pointer ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine converts the first 6 characters of an ASCII string ! to 6-bit and returns the converted string as the value of the ! routine. ! ! FORMAL PARAMETERS: ! ! length = length of the ASCII string in characters ! pointer = pointer to the ASCII string ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE ! ! the converted 6 character 6-bit string ! or ! -1 = string contains an invalid character ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN LOCAL value, ! converted string value_pointer, ! pointer to the converted value string_pointer, ! pointer to the ASCII string character; ! single ASCII character ! ! Initialize the local pointers. ! string_pointer = .pointer; ! Initialize the ASCII string and value_pointer = CH$PTR( value, 0, 6 ); ! the converted value pointers. ! ! Convert the ASCII string one character at a time. ! INCR index FROM 1 TO 6 DO ! Convert only 6 characters. BEGIN IF .index GTR .length ! If all of the input characters have been converted, THEN ! CH$WCHAR_A( 0, value_pointer ) ! pad the converted string with a null/blank. ELSE BEGIN ! Otherwise, character = CH$RCHAR_A( string_pointer ); ! pickup the next input character. IF .character GEQ %C'a' AND ! If the character is lower case, .character LEQ %C'z' ! THEN ! character = .character - %O'40'; ! convert it to upper case. IF .character LSS %O'40' OR ! If the character is a control character .character GTR %O'137' ! or an unsupported special character, THEN ! RETURN -2; ! return an error code to the caller. CH$WCHAR_A( .character - %O'40', ! Put a 6-bit character into the value string. value_pointer ); END; END; ! ! Return the converted string value to the caller. ! RETURN .value ! Return the 6-bit string to the caller. END; GLOBAL ROUTINE X10$ENTER_LOOKUP( iob, parse_block, lookup_list ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine : 1.) initializes the ENTER/LOOKUP block ! 2.) setups the default PATH ! 3.) calls X10$LOOKUP_FINI to complete the setup of the ENTER/LOOKUP block ! ! FORMAL PARAMETERS: ! ! iob = address of an IOB ! parse_block = file-spec parse block ! lookup_list = Enter/Lookup argument list ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The Enter/Lookup argument list is filled in. ! ! COMPLETION CODES ! ! XPO$_NORMAL - The Enter/Lookup argument list was successfully setup. ! ! error code from X10$LOOKUP_FINI with iob[IOB$G_COMP_CODE] set ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(), parse_block : REF $XPO_SPEC_BLOCK, lookup_list : REF $T10_LOOK_ARGS; ! ! Initialize the Enter/Lookup block ! INCR index FROM 0 TO LOOK$K_ARG_LEN-1 DO lookup_list[.index,0,%BPVAL,0] = 0; ! ! Setup the default path for the current job. ! IF .parse_block[XPO$V_PPN] ! If the user specified a PPN then initially set THEN ! up the default path. BEGIN lookup_list[LOOK$G_FUNCT] = -1; $T10_PATH( X10$K_MAX_SFD + 4, lookup_list[LOOK$Z_PATH] ); END; ! ! Setup the Enter/Lookup block with the file-spec information ! IF NOT X10$LOOKUP_FINI( .iob, .parse_block, .lookup_list ) THEN RETURN .iob[IOB$G_COMP_CODE]; ! ! Return to the caller. ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; GLOBAL ROUTINE X10$LOOKUP_FINI( iob, parse_block, lookup_list ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine completes the setup of the LOOKUP/ENTER block and fills in the PATH block. ! ! FORMAL PARAMETERS: ! ! iob = address of an IOB ! parse_block = file-spec parse block ! lookup_list = Enter/Lookup argument list ! ! IMPLICIT INPUTS: ! ! This routine requires the PATH block of the LOOKUP/ENTER block has already been setup with ! default information. ! ! IMPLICIT OUTPUTS: ! ! The Enter/Lookup argument list is filled in. ! ! COMPLETION CODES ! ! XPO$_NORMAL - The Enter/Lookup argument list was successfully setup. ! ! XPO$_BAD_DIRECT with the iob[IOB$G_COMP_CODE] set to this ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(), parse_block : REF $XPO_SPEC_BLOCK, lookup_list : REF $T10_LOOK_ARGS; BIND file_name = parse_block[XPO$T_FILE_NAME] : $STR_DESCRIPTOR(), file_type = parse_block[XPO$T_FILE_TYPE] : $STR_DESCRIPTOR(), directory = parse_block[XPO$T_DIRECT] : $STR_DESCRIPTOR(), sfd = lookup_list[LOOK$Z_SFDS] : VECTOR; LOCAL direct_scan : $STR_DESCRIPTOR( CLASS = BOUNDED ), field_delimiter; ! ! Setup the Enter/Lookup block with the file-spec information ! lookup_list[LOOK$T_NAME] = ! Fill in the Enter/Lookup argument list: X10$ASCII_6BIT( ! file name ( 6-bit ) .file_name[STR$H_LENGTH], ! .file_name[STR$A_POINTER] ); ! ! lookup_list[LOOK$T_EXT] = ! file extension ( 6-bit ) X10$ASCII_6BIT( ! .file_type[STR$H_LENGTH] -1, ! CH$PLUS(.file_type[STR$A_POINTER], 1) ) ! ^-18; ! (note: 3 characters are in high half-word) IF .parse_block[XPO$V_PPN] ! If the user specified a PPN, THEN ! BEGIN ! lookup_list[LOOK$H_PGMR] = ! save the address of the PATH block. lookup_list[LOOK$Z_PATH]; IF .parse_block[XPO$H_PGMR_NUMB] NEQ 0 ! If the user specified a programmer number, THEN ! lookup_list[LOOK$H_PTH_PGMR] = ! save it in the PATH block. .parse_block[XPO$H_PGMR_NUMB]; IF .parse_block[XPO$H_PROJ_NUMB] NEQ 0 ! If the user specified a project number, THEN ! lookup_list[LOOK$H_PTH_PROJ] = ! save it in the PATH block. .parse_block[XPO$H_PROJ_NUMB]; ! ! Setup the SFD information. ! IF NOT .parse_block[XPO$V_SFD] THEN sfd[0] = 0 ELSE BEGIN ! ! Setup the directory scanning string descriptor. ! $STR_DESC_INIT( DESCRIPTOR = direct_scan, CLASS = BOUNDED, STRING = directory ); ! ! Parse the SFD names. ! INCR index FROM -2 TO X10$K_MAX_SFD - 1 DO BEGIN ! Get the SFD name. IF NOT $STR_SCAN( REMAINDER = direct_scan, STOP = ',]' , SUBSTRING = direct_scan, DELIMITER = field_delimiter, FAILURE = 0 ) AND .field_delimiter NEQ null THEN EXITLOOP; IF .index GEQ 0 ! Skip past the project, programmer number. THEN BEGIN IF .direct_scan[STR$H_LENGTH] GTR 0 THEN sfd[.index] = ! Fill in the PATH block: X10$ASCII_6BIT( ! SFD name (6-bit) .direct_scan[STR$H_LENGTH], .direct_scan[STR$A_POINTER] ) ELSE IF .sfd[.index] EQL 0 THEN $XPO_RETURN( BAD_DIRECT ); END; IF .field_delimiter EQL %C',' ! Ignore the comma. THEN direct_scan[STR$H_LENGTH] = .direct_scan[STR$H_LENGTH] + 1 ELSE BEGIN ! Indicate there are no more SFDs. sfd[.index+1] = 0; EXITLOOP; END; END; IF .field_delimiter NEQ %C']' AND .field_delimiter NEQ null THEN $XPO_RETURN ( BAD_DIRECT ); END; ! End of PATH block setup END; ! ! Return to the caller. ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; GLOBAL ROUTINE X10$SEQ_INFO( iob ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine processes SOS page marks and line numbers, updating ! the appropriate IOB fields. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The following IOB fields are updated: ! IOB$H_PAGE_NUMB - may be incremented ! IOB$G_SEQ_NUMB - set to sequence number or record number ! IOB$G_COMP_CODE - may be set to XPO$_NEW_PAGE success code ! ! COMPLETION CODES: ! ! XPO$_NORMAL - page mark and/or sequence number successfully processed ! XPO$_END_FILE - end-of-file reached ! XPO$_IO_ERROR - I/O error ! XPO$_BAD_RECORD - invalid data in file ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND t10_block = .iob[IOB$A_BUFFER_CB] : $XT10_BLOCK, buffer_cb = t10_block[XT10$Z_CB] : VECTOR; ! TOPS-10 buffer control block LOCAL status, ! Temporary routine completion code character; ! Single ASCII character MACRO GET_CHARACTER = BEGIN status = X10$GET_FILE( .iob, character ); IF NOT .status THEN RETURN .status; END %, SKIP_CHARACTER( value ) = BEGIN GET_CHARACTER; IF .character NEQ value THEN RETURN XPO$_BAD_RECORD; END %; ! ! Advance to the next word boundary in the system input buffer. ! WHILE .BLOCK[buffer_cb[$BFPTR],0,30,6,0] GTR 1 DO ! Loop to the next word boundary, SKIP_CHARACTER( null ); ! bypassing characters which must be nulls. ! ! Page Mark processing. ! WHILE 1 DO ! Loop to process multiple page marks. BEGIN SWITCHES NOSAFE; ! buffer_cb gets updated by X10$GET_FILE. DO ! Bypass any nulls which precede a potential page mark. GET_CHARACTER ! UNTIL .character NEQ null; ! IF NOT .(.buffer_cb[$BFPTR]) ! If the low bit (bit 35) of the current word of THEN ! the input buffer is not 1, RETURN XPO$_BAD_RECORD; ! return an error code to the caller. IF .character NEQ space ! If the character is not a space, THEN ! EXITLOOP; ! exit the page mark loop. INCR count FROM 1 TO 4 DO ! Bypass the following required characters: SKIP_CHARACTER( space ); ! 4 spaces SKIP_CHARACTER( cr ); ! a single carriage return SKIP_CHARACTER( ff ); ! a single form feed INCR count FROM 1 TO 3 DO ! SKIP_CHARACTER( null ); ! 3 more nulls iob[IOB$H_PAGE_NUMB] = .iob[IOB$H_PAGE_NUMB]+1; ! Increment the IOB page counter iob[IOB$G_COMP_CODE] = XPO$_NEW_PAGE; ! and update current success completion code. END; ! ! Sequence number processing. ! WHILE .character EQL null DO ! Bypass any nulls which precede a sequence number. GET_CHARACTER; ! IF NOT .(.buffer_cb[$BFPTR]) ! If the low bit (bit 35) of the current word of THEN ! the input buffer is not 1, RETURN XPO$_BAD_RECORD; ! return an error code to the caller. iob[IOB$G_SEQ_NUMB] = 0; ! Start the sequence number at zero. INCR count FROM 1 TO 5 DO ! Loop to convert 5 characters to binary. BEGIN IF .character LSS %C'0' OR .character GTR %C'9' ! If the character is not a decimal digit, THEN ! RETURN XPO$_BAD_RECORD; ! return an error code to the caller. iob[IOB$G_SEQ_NUMB] = 10 * .iob[IOB$G_SEQ_NUMB] ! Shift the current sequence value + (.character - %C'0'); ! and add in the new digit. GET_CHARACTER; ! Pickup the next character. END; IF .character NEQ ht ! If a tab does not follow the sequence number, THEN ! RETURN XPO$_BAD_RECORD; ! return an error code to the caller. ! ! Return to the caller. ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; GLOBAL ROUTINE X10$GET_FILE( iob, value_pointer ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine read a single character or binary value from ! a disk file and returns this character/value to the caller. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! value_pointer - address of character/value deposit area ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! XPO$_NORMAL - character/value successfully read ! XPO$_END_FILE - end-of-file reached ! XPO$_IO_ERROR - I/O error ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND t10_block = .iob[IOB$A_BUFFER_CB] : $XT10_BLOCK, buffer_cb = t10_block[XT10$Z_CB] : VECTOR; ! TOPS-10 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 ! IF $T10_IN( .iob[IOB$H_CHANNEL] ) ! fill the next system buffer. THEN buffer_cb[$BFCTR] = .buffer_cb[$BFCTR] - 1 ! Then decrement the new buffer count. ! ! Decode an input failure. ! ELSE BEGIN IF ($T10_GETSTS(.iob[IOB$H_CHANNEL]) AND ! If the file status indicates end-of-file, IO$EOF) NEQ 0 ! THEN ! RETURN XPO$_END_FILE ! return an EOF code to the caller. ELSE RETURN XPO$_IO_ERROR; ! Otherwise, return an I/O error code to the caller. END; ! ! Pass a single character or value back to the caller. ! .value_pointer = CH$RCHAR_A( buffer_cb[$BFPTR] ); ! Pass back a character/value. ! ! Return to the caller ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; GLOBAL ROUTINE X10$CLEANUP( iob ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine frees up the assigned channel, the allocated buffers and the control blocks. ! ! FORMAL PARAMETERS: ! ! iob - address of an IOB ! ! IMPLICIT INPUTS: ! ! iob[IOB$A_BUFFER_CB] - address of XPORT's Tops10 control block ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! XPO$_NORMAL - TOPS10 cleanup was successful ! failure completion code from $XPO_FREE_MEM ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter. ! ! Free the assigned channel, the I/O buffers and the control block. ! IF .iob[IOB$V_CH_ASSIGN] ! If a channel has been assigned, THEN ! BEGIN ! channel_vector[ .iob[IOB$H_CHANNEL] ] = 0; ! release the assigned channel, iob[IOB$H_CHANNEL] = 0; ! reset the channel in the IOB, iob[IOB$V_CH_ASSIGN] = 0; ! and the channel assignment flag. IF .iob[IOB$A_BUFFER_CB] NEQ 0 THEN BEGIN BIND t10_block = .iob[IOB$A_BUFFER_CB] : $XT10_BLOCK, buffer_cb = t10_block[XT10$Z_CB] : VECTOR; ! TOPS-10 buffer control block IF .t10_block[XT10$A_BUFFER1] NEQ 0 ! Free any allocated I/O buffers. THEN $XPO_IF_NOT( $XPO_FREE_MEM( BINARY_DATA = ( X10$K_BUFFER_SZ + X10$K_HEADER_SZ, .t10_block[XT10$A_BUFFER1] ), FAILURE = 0 ) ) THEN RETURN .$XPO_STATUS; IF .t10_block[XT10$A_BUFFER2] NEQ 0 THEN $XPO_IF_NOT( $XPO_FREE_MEM( BINARY_DATA = ( X10$K_BUFFER_SZ + X10$K_HEADER_SZ, .t10_block[XT10$A_BUFFER2] ), FAILURE = 0 ) ) THEN RETURN .$XPO_STATUS; $XPO_IF_NOT( $XPO_FREE_MEM( ! Free the control block. BINARY_DATA = ( XT10$K_BLK_LEN, t10_block ), FAILURE = 0 ) ) THEN RETURN .$XPO_STATUS; iob[IOB$A_BUFFER_CB] = 0; ! Indicate that the TOPS10 control block no longer exists. END; END; ! ! Return to the caller. ! RETURN XPO$_NORMAL ! Return a success code to the caller. END; END ELUDOM