MODULE XT20 ( IDENT = 'X00.05' %TITLE 'TOPS-20-specific XPORT Routines' %BLISS36( ,ENTRY( X20$IN, X20$OUT, X20$CLOSE, X20$ERROR ),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-20. ! ! ENVIRONMENT: User mode ! ! AUTHOR: Linda Duffell CREATION DATE: 30 October 1979 ! !-- ! ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $TOPS20 ) REQUIRE 'XT20'; ! TOPS-20 I/O interface macros ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE X20$IN, ! Input processing X20$OUT, ! Output processing X20$CLOSE, ! Close processing X20$ERROR : NOVALUE; ! TOPS-20 error handling routine ! ! MACROS: ! MACRO code_table[] = VECTOR[ (3 * %LENGTH) + 1 ] INITIAL( 3*%LENGTH, code_entry(%REMAINING) ) %, code_entry[ code_set ] = decode_entry( %REMOVE(code_set) ) %, decode_entry( t20_code, xport_code, secondary ) = t20_code, xport_code, %IF %NULL(secondary) %THEN 0 %ELSE secondary %FI %; ! ! EQUATED SYMBOLS: ! ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! OWN ! XPORT Functions ( Open,Close,Delete,Rename,Get,Put) t20_to_xport : code_table( ! Meaning of TOPS-20 completion codes: ( CLSX1, XPO$_NOT_OPEN ), ! C file is not open ( CLSX2, XPO$_NO_CLOSE ), ! C file cannot be closed by this process ( CLSX3, XPO$_IN_USE ), ! C file still mapped ( DELFX1, XPO$_PROTECTED ), ! D delete access required ( DELFX2, XPO$_IN_USE ), ! D file cannot be deleted because it is currently open ( DELFX3, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! D system scratch area depleted; file not deleted ( DELFX7, XPO$_CORRUPTED ), ! D FDB formatted incorrectly; file not deleted ( DELFX8, XPO$_CORRUPTED ), ! D FDB not found ( ENQX20, XPO$_FILE_LOCK ), ! C locked JFN cannot be closed ( GJFX3, XPO$_NO_CHANNEL ), ! O DR no JFN's available ( GJFX10, XPO$_BAD_VER ), ! O DR generation number is not numeric ( GJFX12, XPO$_BAD_ACCT ), ! O DR more than one account field is not allowed ( GJFX13, XPO$_BAD_PROT ), ! O DR more than one protection field is not allowed ( GJFX14, XPO$_BAD_PROT ), ! O DR invalid protection ( GJFX16, XPO$_BAD_DEVICE ), ! O DR no such device ( GJFX17, XPO$_NO_FILE, XPO$_NO_DIRECT ), ! O DR no such directory name ( GJFX18, XPO$_NO_FILE, XPO$_BAD_NAME ), ! O DR no such filename ( GJFX19, XPO$_NO_FILE, XPO$_BAD_TYPE ), ! O DR no such file type ( GJFX20, XPO$_NO_FILE, XPO$_BAD_VER ), ! O DR no such generation number ( GJFX21, XPO$_NO_FILE ), ! O DR file was expunged ( GJFX22, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! O DR insufficient system resources ( GJFX23, XPO$_BAD_DIRECT, XPO$_NO_SPACE ), ! O DR directory full ( GJFX24, XPO$_NO_FILE ), ! O DR file not found ( GJFX27, XPO$_EXISTS ), ! O DR file already exists ( GJFX28, XPO$_NOT_ONLINE ), ! O DR device is not online ( GJFX30, XPO$_BAD_ACCT ), ! O DR account is not numeric ( GJFX31, XPO$_BAD_REQ, XPO$_WILDCARD ), ! O DR invalid wildcard designator ( GJFX32, XPO$_NO_FILE ), ! O DR no files match this specification ( GJFX33, XPO$_BAD_NAME ), ! O DR filename was not specified ( GJFX35, XPO$_BAD_DIRECT, XPO$_PROTECTED ), ! O DR directory access priveleges required ( GJFX36, XPO$_BAD_DIRECT, XPO$_CORRUPTED ), ! O DR internal format of directory is incorrect ( GJFX38, XPO$_BAD_DEVICE ), ! O DR file not found because output-only device was specified ( GJFX40, XPO$_BAD_ATTR ), ! O DR undefined attribute in file specification ( GJFX43, XPO$_BAD_TEMP ), ! O DR more than one ;T specification is not allowed ( GJFX44, XPO$_NO_FILE, XPO$_BAD_ACCT ), ! O DR account string does not match ( GJFX45, XPO$_BAD_ATTR ), ! O DR illegal to specify multiple specifications for the same attr. ( GJFX46, XPO$_BAD_ATTR ), ! O DR attribute value is required ( GJFX47, XPO$_BAD_ATTR ), ! O DR attribute does not take a value ( GJFX49, XPO$_BAD_ATTR ), ! O DR invalid attribute for this device ( IOX1, XPO$_NOT_INPUT ), ! G file is not open for reading ( IOX2, XPO$_NOT_OUTPUT ), ! P file is not open for writing ( IOX4, XPO$_END_FILE ), ! G end of file reached ( IOX5, XPO$_IO_ERROR ), ! GP device or data error ( IOX7, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! GP insufficient system resources ( IOX8, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! GP monitor internal error ( IOX11, XPO$_NO_SPACE ), ! OCDRGP quota exceeded or disk full ( OPNX1, XPO$_OPEN ), ! O R file is already open ( OPNX2, XPO$_NO_FILE ), ! O file does not exist ( OPNX3, XPO$_PROTECTED ), ! O read access required ( OPNX4, XPO$_PROTECTED ), ! O write access required ( OPNX5, XPO$_PROTECTED ), ! O execute access required ( OPNX6, XPO$_PROTECTED ), ! O append access required ( OPNX7, XPO$_IN_USE ), ! O device already assigned to another job ( OPNX8, XPO$_NOT_ONLINE ), ! O device is not on-line ( OPNX9, XPO$_IN_USE ), ! O invalid simultaneous access ( OPNX10, XPO$_NO_SPACE ), ! O entire file structure full ( OPNX12, XPO$_PROTECTED ), ! O list access required ( OPNX15, XPO$_PROTECTED ), ! O read/write access required ( OPNX16, XPO$_CORRUPTED ), ! O file has bad index block ( OPNX17, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! O no room in job for long file page table ( OPNX23, XPO$_NO_SPACE ), ! O disk quota exceeded ( OPNX25, XPO$_NO_WRITE ), ! O device is write-locked ( RNAMX1, XPO$_BAD_DEVICE ), ! R files are not on same device ( RNAMX4, XPO$_NO_SPACE ), ! R quota exceeded in destination of rename ( RNAMX7, XPO$_NO_FILE ), ! R source file expunged ( RNAMX8, XPO$_PROTECTED ), ! R write or owner access to source file required ( RNAMX9, XPO$_NO_FILE ), ! R source file is non-existent ( RNMX10, XPO$_OPEN ), ! R source file is not closed ( RNMX11, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! R source file has bad page table ( RNMX13, XPO$_IO_ERROR, XPO$_HOST_ERROR ), ! R insufficient system resources ( VACCX0, XPO$_BAD_ACCT ) ); ! O DR invalid account ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE X20$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 following IOB fields are set: ! iob[IOB$G_COMP_CODE] ! iob[IOB$G_2ND_CODE] ! ! COMPLETION CODES: ! ! XPO$_NORMAL - input buffer has been filled sucessfully ! XPO$_END_FILE - end-of-file reached and no input in buffer ! XPO$_GET_MEM - buffer allocation error ! (IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! failure completion codes from X20$ERROR ! ! 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 jfn = .iob[IOB$H_CHANNEL]; LOCAL error_code, ! Storage area for error conditions count, status; ! ! 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 = X20$K_BUFFER_SZ, RESULT = buffer_cb[$BFADR], FAILURE = 0) ) THEN $XPO_RETURN( GET_MEM, (.$XPO_STATUS) ); END; ! ! Fill the input buffer. ! buffer_cb[$BFPTR] = CH$PTR( .buffer_cb[$BFADR], ! Always input in 36-bit mode. 0, %BPVAL ); IF NOT $T20_SIN( ! Fill the input buffer: jfn, ! JFN .buffer_cb[$BFPTR], ! pointer to input buffer - X20$K_BUFFER_SZ, ! minus the specified # of bytes to read 0, ! do not terminate input for specific bytes count ) ! return the number of bytes input. THEN BEGIN ! If an error occurred getting input, $T20_GETER( ! Get the error code: $FHSLF, ! This process error_code ); ! Error code returned here IF .error_code AND GS_EOF EQL 0 ! If error return and not end-of-file, THEN ! BEGIN ! X20$ERROR( .iob, .error_code ); ! convert the error into an equivalent XPORT completion code, RETURN .iob[IOB$G_COMP_CODE]; ! and return the final completion code to the caller. END ELSE IF .count EQL 0 ! Only report the end-of-file condition THEN ! RETURN XPO$_END_FILE; ! when there is no more input. END; ! ! Update the input buffer control_block ! IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a character-mode file, THEN ! BEGIN ! buffer_cb[$BFPTR] = CH$PTR(.buffer_cb[$BFADR]); ! adjust the pointer to charcter size bytes buffer_cb[$BFCTR] = .count * 5; ! and the count to the number of characters. END ELSE buffer_cb[$BFCTR] = .count; ! In binary mode, count and pointer remain in word mode. RETURN XPO$_NORMAL END; GLOBAL ROUTINE X20$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 JFN. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The output buffer control_block (IOB$A_BUFFER_CB) is updated. ! ! For certain error conditions the following IOB fields are set: ! iob[IOB$G_COMP_CODE] ! iob[IOB$G_2ND_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 ) ! failure completion codes from X20$ERROR ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR, ! Redefine the IOB jfn = .iob[IOB$H_CHANNEL]; LOCAL error_code, ! Storage area for error conditions count; ! Storage area for output buffer byte count ! ! Just allocate an output buffer the first time through. ! IF .buffer_cb[$BFADR] EQL 0 THEN BEGIN $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = X20$K_BUFFER_SZ, RESULT = buffer_cb[$BFADR], FAILURE = 0) ) THEN $XPO_RETURN( GET_MEM, (.$XPO_STATUS) ); END ELSE ! ! Otherwise, output the buffer. ! BEGIN IF .iob[IOB$V_BINARY] ! If this is a binary file, THEN ! count = X20$K_BUFFER_SZ - .buffer_cb[$BFCTR]! get the number of words transferred. ELSE ! Otherwise, if the buffer isn't full and ! it is record or string mode, count = ( X20$K_BUFFER_SZ * 5 - ! then convert count to reflect word mode instead. .buffer_cb[$BFCTR] + 4 ) / 5; IF .count EQL 0 ! If there isn't any data in the buffer, THEN ! RETURN XPO$_NORMAL; ! just return a success code to the caller. IF NOT $T20_SOUT( ! Output the buffer in 36-bit mode: jfn, ! JFN CH$PTR(.buffer_cb[$BFADR],0, ! pointer to output buffer %BPVAL ), ! (36-bit pointer) - .count, ! minus the specified # of bytes to be transferred 0 ) ! do not terminate output with a specified byte THEN BEGIN ! If the output failed, $T20_GETER( ! get the error: $FHSLF, ! this process error_code ); ! error code returned here X20$ERROR( .iob, .error_code ); ! Convert the error into an equivalent XPORT completion code. RETURN .iob[IOB$G_COMP_CODE] ! Return the final completion code to the caller. END; END; ! ! Clear out the output buffer. ! INCR index FROM 0 TO (X20$K_BUFFER_SZ -1) DO ! Make sure to start off with an empty output buffer. ( .buffer_cb[$BFADR] + .index ) = 0; ! ! Update the output buffer control_block. ! IF .iob[IOB$V_BINARY] ! If this is a binary file, THEN ! BEGIN ! buffer_cb[$BFPTR] = ! make the pointer a fullword pointer CH$PTR( .buffer_cb[$BFADR], 0, %BPVAL ); ! buffer_cb[$BFCTR] = X20$K_BUFFER_SZ; ! and set the counter in terms of words. END ELSE ! If record or string mode, BEGIN ! buffer_cb[$BFPTR] = CH$PTR(.buffer_cb[$BFADR]); ! make the pointer a character pointer buffer_cb[$BFCTR] = X20$K_BUFFER_SZ * 5; ! and the counter in terms of characters. END; RETURN XPO$_NORMAL END; GLOBAL ROUTINE X20$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 ! and it closes the file and releases the JFN. ! ! FORMAL PARAMETERS: ! ! iob - address of XPORT IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The buffer control_block (IOB$A_BUFFER_CB) is zeroed out. ! ! For certain error conditions the following IOB fields are set: ! iob[IOB$G_COMP_CODE] ! iob[IOB$G_2ND_CODE] ! ! 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 X20$OUT ! failure completion codes from X20$ERROR ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB. BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR, jfn = .iob[IOB$H_CHANNEL]; LOCAL error_code; ! Storage area for error conditions ! ! 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 X20$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 = (X20$K_BUFFER_SZ, .buffer_cb[$BFADR]), FAILURE = 0) ) THEN $XPO_RETURN( FREE_MEM, (.$XPO_STATUS) ); INCR count from 0 to 2 DO ! Zero out the buffer control block. buffer_cb[.count] = 0; END; ! ! Close the file and release the JFN. ! IF NOT $T20_CLOSF( jfn, error_code ) THEN BEGIN ! If an error occurred while closing the file, X20$ERROR( .iob, .error_code ); ! convert the error into the equivalent XPORT completion code, RETURN .iob[IOB$G_COMP_CODE] ! and return the final completion code to the caller. END; RETURN XPO$_NORMAL END; %TITLE 'X20$ERROR - T20-to-XPORT Code Conversion' GLOBAL ROUTINE X20$ERROR( iob, t20_sts ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine converts a TOPS-20 failure completion code into ! an equivalent XPORT completion code. ! ! FORMAL PARAMETERS: ! ! iob - address of an IOB ! t20_sts - TOPS-20 error code ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! iob[IOB$G_COMP_CODE] = XPORT completion code ! iob[IOB$G_2ND_CODE] = XPORT completion code (in some cases) ! ! COMPLETION CODES: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter ! ! Convert the TOPS-20 error code into an equivalent XPORT completion code. ! INCR index FROM 1 TO t20_to_xport[0] BY 3 DO ! Loop through the conversion table. IF .t20_sts EQL .t20_to_xport[.index] ! If the TOPS-20 code is found THEN ! BEGIN ! iob[IOB$G_COMP_CODE] = ! use the equivalent XPORT completion code .t20_to_xport[.index+1]; ! as the primary IOB completion code iob[IOB$G_2ND_CODE] = ! and set the IOB secondary code to be .t20_to_xport[.index+2]; ! an XPORT completion code. RETURN ! Return to the caller after code translation. END; ! ! Return a logic error completion code if an unexpected TOPS-20 error occurs. ! iob[IOB$G_COMP_CODE] = XPO$_SYS_ERROR; ! Indicate an XPORT system error iob[IOB$G_2ND_CODE] = .t20_sts; ! and save the primary TOPS-20 completion code. RETURN ! Return to the caller. END; END ELUDOM