MODULE XOPEN ( IDENT = 'X1.2-45' %TITLE 'XPO$OPEN - XPORT File Open' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$OPEN, XPO$BUILD_SPEC, XPO$DIRECT_PARSE, XPO$DVICE_PARSE, XPO$EXTRA_PARSE, XPO$FIELD_DELIM, XPO$LAST_PARSE, XPO$NAME_PARSE, XPO$NEXT_FIELD, XPO$PARSE_SPEC, XPO$SCAN_SPEC, XPO$SETUP_PARSE, XPO$STATE, XPO$FAILURE, XPO$FM_FAILURE, XPO$GM_FAILURE, XPO$IO_FAILURE, XPO$PM_FAILURE, XPO$PS_FAILURE, XST$BINARY, STR$A_FAILURE, STR$B_FAILURE, STR$C_FAILURE, STR$FAILURE, STR$S_FAILURE, STR$X_FAILURE, XPO$TERMINATE, XPO$MESSAGE),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 open module. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHORS: Ward Clark, CREATION DATE: 26 June 1978 ! Linda Duffell ! ! MODIFIED BY: Laura Y. Schwartz !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$OPEN; ! XPORT File Open 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 interface definitions %FI %IF $RSTS %THEN REQUIRE 'XRSTS' ; ! RSTS/E system interface definitions %FI %IF $RT11 %THEN REQUIRE 'XRT11' ; ! RT-11 system interface definitions %FI ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! LITERAL yes = 1, ! Used to turn an indicator on no = 0; ! Used to turn an indicator off %IF $VMS %THEN LITERAL max_file_spec = 255, ! Maximum length of a file specification bytes_per_block = 512, ! Size of a Files-11 disk block binary_record_len = 512, ! Default length of a binary file "record" io_buffer_size = 512; ! Default I/O buffer size LITERAL RMS$_FILEPURGED = SS$_FILEPURGED + 1^16; ! *** RMS BUG BYPASS *** %FI %IF $11M %THEN LITERAL bytes_per_block = 512, ! Size of a Files-11 disk block default_alloc = 5; ! Standard file allocation size %FI ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! %IF $TOPS20 OR $RT11 %THEN EXTERNAL LITERAL xpo$k_max_chan; ! Maximum I/O channel/JFN number %FI %IF $TOPS20 %THEN EXTERNAL X20$BUFFER_CB : BLOCKVECTOR[ ,3 ]; ! Buffer control blocks for each channel %FI %IF $TOPS10 %THEN EXTERNAL ROUTINE X10$CHAN_ASSIGN, ! Channel assignment routine X10$ASCII_6BIT, ! ASCII to 6-bit conversion routine X10$ENTER_LOOKUP; ! Setup routine for ENTER/LOOKUP block %FI %IF $TOPS20 %THEN EXTERNAL ROUTINE X20$IN, ! File input routine X20$OUT, ! File output routine X20$ERROR : NOVALUE; ! TOPS-20 to XPORT completion code conversion routine %FI %IF $VMS %THEN EXTERNAL ROUTINE XPO$RMS_PARSE, ! RMS file specification resultion routine XPO$RMS_ERROR : NOVALUE, ! RMS-to-XPORT completion code conversion routine XPO$RMS_CLEANUP; ! RMS control block cleanup routine %FI %IF $11M %THEN EXTERNAL XRSX$EVENT_FLAG; ! XPORT QIO/FCS event flag number EXTERNAL ROUTINE XRSX$SPEC_SETUP, ! File-spec setup and LUN assignment routine XRSX$DSPT_SETUP : NOVALUE, ! FCS DSPT setup routine XRSX$XOPEN, ! FCS file open routine XRSX$RSLT_FIXUP, ! Resultant file-spec fixup routine XRSX$IO_ERROR : NOVALUE, ! FCS-to-XPORT completion code conversion routine XRSX$CLEANUP; ! QIO/FCS cleanup routine %FI %IF $RSTS %THEN EXTERNAL ROUTINE XRST$SPEC_SETUP, ! File-spec setup routine XRST$ASSIGN_CH, ! Channel assignment routine XRST$OUT, ! File output routine XRST$ERROR : NOVALUE, ! RSTS-to-XPORT completion code conversion routine XRST$FIXUP; ! Channel assignment cleanup routine %FI %IF $RT11 %THEN EXTERNAL XPO$CHANNELS : BITVECTOR, ! I/O channel assignment vector XRT$BUFFER_CB : BLOCKVECTOR[ ,4 ]; ! Buffer control blocks for each channel EXTERNAL ROUTINE XRT$ASCII_RAD50 : NOVALUE, ! ASCII to RADIX-50 conversion routine XRT$CHK_BACKGRD, ! Background job verification XRT$FETCH, ! Fetch handler routine XRT$OUT; ! File output routine %FI GLOBAL ROUTINE XPO$OPEN ( iob, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine is the XPORT file open routine. It performs the ! following functions: ! ! * establish IOB defaults ! ! * check for missing or conflicting IOB information ! ! * build a resultant file specification ! ! * open the specified file ! ! FORMAL PARAMETERS: ! ! iob - address of an 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 file was successfully opened ! XPO$_CREATED - the file was successfully created ! ! XPO$_BAD_DEVICE - invalid device specified (TOPS-10) ! XPO$_BAD_IO_OPT - invalid I/O option (e.g., binary terminal I/O) (TOPS-10, TOPS-20, 11M, RSTS, ,RT-11) ! XPO$_BAD_IOB - the IOB is invalid ! (IOB$G_2ND_CODE = XPO$_CONFLICT - conflicting information ! or XPO$_BAD_LENGTH - invalid IOB length) ! XPO$_BAD_LOGIC - internal logic error detected ! XPO$_BAD_RSLT - invalid resultant file specification ! (IOB$G_2ND_CODE = completion code from $XPO_PARSE_SPEC (TOPS-10, RT-11) ! or completion code from $STR_COPY (VMS) ! or completion code from XRSX$RSLT_FIXUP (11M)) ! XPO$BAD_CONCAT - concatenated input file-CONCAT cannot be saved ! (IOB$G_2ND_CODE = completion code from $STR_COPY or $XPO_FREE_MEM) ! XPO$_BAD_NAME - no file name was specified (RT-11) ! XPO$_BAD_SIZE - invalid file size specified (RT-11) ! XPO$_BAD_SPEC - invalid file specification ! (IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid length (TOPS-20) ! or completion code from $STR_COPY or $STR_SCAN) ! XPO$_FOREGROUND - this is a foreground job (RT-11) ! XPO$_FREE_MEM - error deallocating IOB-related memory ! (IOB$G_2ND_CODE = completion code from $XPO_FREE_MEM) ! XPO$_GET_MEM - insufficient memory for RMS control blocks or buffers (VMS) ! ( IOB$G_2ND_CODE = completion code from $XPO_GET_MEM ) ! XPO$_IO_ERROR - I/O error (TOPS-10) ! XPO$_NO_APPEND - append function not allowed (RT-11) ! XPO$_NO_CHANNEL - no I/O channel is available (TOPS-10, TOPS-20, RT-11) ! XPO$_NO_FILE - file not found (RT-11) ! XPO$_NO_MEMORY - insufficient memory for buffers (TOPS-10, RSTS, RT-11) ! XPO$_NO_SEQ - sequenced files not allowed (RSTS, RT-11) ! XPO$_NO_SPACE - insufficient space (RT-11) ! XPO$_OPEN - the file is already open ! failure completion codes from $XPO_VALID_IOB ! failure completion code from $T10_ERROR (TOPS-10) ! failure completion codes from $XPO_BUILD_SPEC (TOPS-10, TOPS-20, RT-11) ! failure completion codes from X20$ERROR (TOPS-20) ! failure completion codes from X20$IN (TOPS-20) ! failure completion codes from X20$OUT (TOPS-20) ! failure completion codes from XPO$RMS_PARSE (VMS) ! failure completion codes from XPO$RMS_ERROR (VMS) ! failure completion codes from XRSX$SPEC_SETUP (11M) ! failure completion codes from XRSX$IO_ERROR (11M) ! failure completion codes from XRSX$CLEANUP (11M) ! failure completion codes from XRST$SPEC_SETUP (RSTS) ! failure completion codes from XRST$ASSIGN_CH (RSTS) ! failure completion codes from XRST$ERROR (RSTS) ! failure completion codes from XRT$FETCH (RT-11) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter LOCAL current_iob : REF $XPO_IOB(); ! Temporary IOB pointer %IF $TOPS10 OR $TOPS20 OR $RT11 %THEN LOCAL channel_open; ! Channel open indicator %FI %IF $TOPS20 OR $RT11 %THEN LOCAL channel_assign; ! Channel assignment indicator %FI %IF $VMS %THEN LOCAL header_xab : REF $XABFHC_DECL; ! Address of file header XAB %FI %IF $RT11 %THEN LOCAL error_code, ! Error condition indicator lookup_args : $XRT_LOOK_ARGS; ! RT-11 LOOKUP/ENTER argument list %FI ! ! XPORT routine initialization. ! $XPO_MAIN_BEGIN( IO, FIXUP_IOB ) ! Define the MAIN_BLOCK code block %IF $TOPS10 %THEN channel_open = no; ! Indicate that no channel has been opened. %FI %IF $TOPS20 OR $RT11 %THEN channel_assign = no; ! Indicate that no channel has been assigned channel_open = no; ! or opened. %FI %IF $VMS %THEN header_xab = 0; ! Initialize the file header XAB address. %FI %IF $RT11 %THEN error_code = no; ! Indicate that an error has not occurred. %FI ! ! Establish IOB defaults. ! $XPO_VALID_IOB( .iob ); ! Validate or default caller's file-spec and prompt string. IF .iob[IOB$V_OVERWRITE] OR .iob[IOB$V_APPEND] ! If overwrite/extend existing file is requested THEN ! iob[IOB$V_OUTPUT] = yes; ! assume this is an output file. IF NOT (.iob[IOB$V_INPUT] OR .iob[IOB$V_OUTPUT]) ! If neither INPUT or OUTPUT was specified AND ($STR_EQL( STRING1 = .iob[IOB$A_FILE_SPEC], ! and the user's "terminal" was specified, STRING2 = $XPO_INPUT, ! FAILURE = 0 ) ! %IF $VMS %THEN ! OR $STR_EQL( STRING1 = .iob[IOB$A_FILE_SPEC], ! STRING2 = $XPO_OUTPUT, ! FAILURE = 0 ) OR ! $STR_EQL( STRING1 = .iob[IOB$A_FILE_SPEC], ! STRING2 = $XPO_ERROR, ! FAILURE = 0 ) ! %FI ) ! THEN ! BEGIN ! iob[IOB$V_INPUT] = yes; ! allow both input and output. iob[IOB$V_OUTPUT] = yes; END; IF NOT .iob[IOB$V_OUTPUT] ! If this is not an output file, THEN ! iob[IOB$V_INPUT] = yes; ! assume that it is an input file. IF .iob[IOB$V_SEQUENCED] OR ! If sequenced record format is requested NOT (.iob[IOB$V_BINARY] OR .iob[IOB$V_STREAM] ! or if binary or stream or random I/O OR .iob[IOB$V_RANDOM] ) ! are not requested, THEN ! iob[IOB$V_RECORD] = yes; ! assume that this is a record format file. ! ! Setup initial IOB field values. ! iob[IOB$V_CLOSED] = no; ! Turn off the file-closed indicator. IF .iob[IOB$H_PAGE_NUMB] EQL 0 THEN iob[IOB$H_PAGE_NUMB] = 1; ! ! Check the IOB for invalid or conflicting information. ! ! Return an error code if the IOB is invalid ! for one of the following reasons: IF .iob[IOB$V_OPEN] ! the file is already open THEN $XPO_QUIT( OPEN ); IF (.iob[IOB$V_BINARY] AND ! both binary and record data .iob[IOB$V_RECORD]) OR ! (.iob[IOB$V_BINARY] AND ! both binary and stream data .iob[IOB$V_STREAM]) OR ! (.iob[IOB$V_RANDOM] AND ! both random and record data .iob[IOB$V_RECORD]) OR ! (.iob[IOB$V_RANDOM] AND ! both random and stream data .iob[IOB$V_STREAM]) OR ! (.iob[IOB$V_STREAM] AND .iob[IOB$V_RECORD]) OR ! both stream and record format (.iob[IOB$G_REC_SIZE] NEQ 0 AND ! fixed record length and not record format NOT .iob[IOB$V_RECORD]) THEN $XPO_QUIT( BAD_IOB, CONFLICT ); IF .iob[IOB$V_REMEMBER] ! OPTION=REMEMBER specified THEN $XPO_QUIT( BAD_IO_OPT ); !+ ! 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' !- %IF NOT $VMS %THEN IF .iob[IOB$V_RANDOM] THEN $XPO_QUIT( BAD_ATTR, NO_SUPPORT ); %FI ! ! Complete IOB setup. ! BEGIN BIND concat = iob[IOB$T_CONCAT] : $STR_DESCRIPTOR( CLASS = DYNAMIC_BOUNDED ), input_string = iob[IOB$T_STRING] : $STR_DESCRIPTOR(); IF .iob[IOB$V_INPUT] ! Input IOB setup: THEN ! BEGIN ! iob[IOB$V_SEQUENCED] = no; ! assume an unsequenced file IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! THEN ! input_string[STR$B_DTYPE] = STR$K_DTYPE_T ! character input if RECORD or STREAM mode ELSE ! input_string[STR$B_DTYPE] = XPO$K_DTYPE_BU; ! input_string[STR$B_CLASS] = STR$K_CLASS_DB; ! input string will be DYNAMIC_BOUNDED END; IF NOT .iob[IOB$V_AUTO_CONC] ! Concatenated input file-spec setup: THEN BEGIN IF NOT .iob[IOB$V_OUTPUT] AND $STR_SCAN( STRING = .iob[IOB$A_FILE_SPEC], FIND = '+', FAILURE = 0 ) THEN BEGIN iob[IOB$V_CONC_SPEC] = yes; ! Indicate concatenated input file-spec. IF .iob[IOB$V_RANDOM] ! Random access does not allow concatenated THEN ! file specs $XPO_QUIT( BAD_IOB, CONFLICT ); $STR_DESC_INIT( DESCRIPTOR = concat, ! First setup the concatenated file-spec descriptor CLASS = DYNAMIC ); ! to be a DYNAMIC descriptor. $XPO_IF_NOT( $STR_COPY( ! Save the caller's concatenated file-spec. STRING = .iob[IOB$A_FILE_SPEC], TARGET = concat, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_SPEC, (.$XPO_STATUS) ); iob[IOB$A_FILE_SPEC] = concat; ! Update the primary file-spec field. concat[STR$B_CLASS] = STR$K_CLASS_DB; ! Change the descriptor to DYNAMIC_BOUNDED. concat[STR$H_MAXLEN] = .concat[STR$H_LENGTH]; concat[STR$H_LENGTH] = 0; concat[STR$H_PFXLEN] = 0; $STR_SCAN( REMAINDER = concat, ! Find the end of the 1st file specification. STOP = '+', SUBSTRING = concat, FAILURE = 0 ); END; END ELSE ! Internal (automatic) open: BEGIN concat[STR$H_LENGTH] = ! Bypass the "+" which follows the last file-spec. .concat[STR$H_LENGTH] + 1; $XPO_IF_NOT( $STR_SCAN( REMAINDER = concat, ! Find the next file-spec. STOP = '+', SUBSTRING = concat, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_SPEC, (.$XPO_STATUS) ); END; END; ! End of BIND declaration block !+ ! ! System-specific OPEN processing follows. ! !- %TITLE 'TOPS-10 File Open' %IF $TOPS10 %THEN !+ ! ! TOPS-10 OPEN Processing ! !- BEGIN LOCAL file_parse : $XPO_SPEC_BLOCK, ! Current file-spec parse block open_args : $T10_OPEN_ARGS, ! TOPS-10 OPEN argument list lookup_args : $T10_LOOK_ARGS; ! TOPS-10 LOOKUP argument list BIND ! Redefine several spec-block fields. device = file_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(); ! ! Build a resultant file specification from the specifications passed by the caller. ! $XPO_BUILD_SPEC( .iob ); ! ! Bypass opening the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! BEGIN ! IF .iob[IOB$V_BINARY] ! return an error code if binary I/O is requested THEN ! $XPO_QUIT( BAD_IO_OPT ); ! ! $XPO_QUIT( NORMAL ); ! or return a success code to the caller. END; ! ! Further validate the caller's IOB. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT] ! If the file is being opened for both input and output, THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. ! ! Parse the resultant file-specification into its individual components. ! $XPO_IF_NOT( $XPO_PARSE_SPEC( ! Parse the file-specification. FILE_SPEC = iob[IOB$T_RESULTANT], SPEC_BLOCK = file_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); ! ! Assign a TOPS-10 I/O channel to this file. ! IF NOT X10$CHAN_ASSIGN( .iob ) THEN $XPO_QUIT(); ! ! Allocate an XPORT TOPS10 control block. ! $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = XT10$K_BLK_LEN, RESULT = iob[IOB$A_BUFFER_CB], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); BEGIN BIND t10_block = .iob[IOB$A_BUFFER_CB] : $XT10_BLOCK, buffer_cb = t10_block[XT10$Z_CB] : VECTOR, extra_buffer_cb = t10_block[XT10$Z_XTRA_CB] : VECTOR; ! ! Setup the OPEN argument list. ! INCR index FROM 0 TO OPEN$K_ARG_LEN-1 DO ! Zero the open argument list. open_args[.index,0,%BPVAL,0] = 0; IF .iob[IOB$V_BINARY] ! If this is a binary file, THEN ! open_args[OPEN$H_STATUS] = $IOBIN ! set binary data mode. ELSE open_args[OPEN$H_STATUS] = $IOASC; ! Otherwise, set ASCII data mode. open_args[OPEN$T_DEVICE] = ! Convert the device name to 6-bit and put it X10$ASCII_6BIT( ! in the argument list. .device[STR$H_LENGTH] - 1, .device[STR$A_POINTER] ); IF .iob[IOB$V_INPUT] ! If this is an input file THEN ! open_args[OPEN$A_IN_BCB] = buffer_cb ! setup the input buffer control block address ELSE ! If this is an output file, BEGIN ! open_args[OPEN$A_OUT_BCB] = buffer_cb; ! setup the output buffer control block address IF .iob[IOB$V_APPEND] AND .iob[IOB$V_RECORD] ! If a record-mode file is being extended, THEN ! open_args[OPEN$A_IN_BCB] = ! setup the input buffer control block address extra_buffer_cb; ! since an initial input operation will be needed. END; ! ! Open the assigned channel. ! IF $T10_OPEN( .iob[IOB$H_CHANNEL], open_args ) ! If the assigned channel can be opened, THEN ! channel_open = yes ! indicate that a channel has been opened. ELSE $XPO_QUIT( BAD_DEVICE ); ! Otherwise, return an error code to the caller. ! ! Generate our own I/O buffers( 2 ). ! $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = X10$K_BUFFER_SZ + X10$K_HEADER_SZ, RESULT = t10_block[XT10$A_BUFFER1], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = X10$K_BUFFER_SZ + X10$K_HEADER_SZ, RESULT = t10_block[XT10$A_BUFFER2], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); ! ! Indicate to the monitor that we are generating our own buffers. ! BEGIN BIND buffer1 = .t10_block[XT10$A_BUFFER1] : $XT10_HEADER_BLK, buffer2 = .t10_block[XT10$A_BUFFER2] : $XT10_HEADER_BLK; buffer_cb[$BFADR] = X10$K_USE_BIT + ! Indicate that the buffer was never referenced and buffer1[XT10$Z_BFHDR]; ! point to the first buffer in the ring. buffer1[XT10$V_SIZE] = X10$K_BUFFER_SZ + 1; ! Save the size of the first buffer and buffer1[XT10$A_NXT_BUFF] = buffer2[XT10$Z_BFHDR]; ! point to the address of the next buffer. buffer2[XT10$V_SIZE] = X10$K_BUFFER_SZ + 1; ! Save the size of the second buffer and buffer2[XT10$A_NXT_BUFF] = buffer1[XT10$Z_BFHDR]; ! point to the address of the next buffer. END; ! ! Perform a LOOKUP monitor call. ! IF NOT X10$ENTER_LOOKUP( .iob, file_parse, lookup_args ) ! Setup the LOOKUP/ENTER argument list. THEN $XPO_QUIT(); iob[IOB$G_COMP_CODE] = XPO$_CREATED; ! Initially assume that a file will be created. IF .iob[IOB$V_INPUT] OR ! If this is an open for input .iob[IOB$V_OVERWRITE] OR .iob[IOB$V_APPEND] ! or and open for output of an existing file, THEN ! IF $T10_LOOKUP( ! perform a TOPS-10 LOOKUP: .iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the LOOKUP is successful, iob[IOB$G_COMP_CODE] = XPO$_NORMAL ! setup a new successful completion code. ELSE IF NOT (.iob[IOB$V_OUTPUT] AND ! Otherwise, unless this is an open for output (.lookup_args[LOOK$H_STATUS] EQL ! and the error is "file does not exist", ERFNF_)) ! THEN ! $T10_ERROR(.lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_FILE ); ! ! Reset the LOOKUP/ENTER argument list. ( LOOKUP writes into this block. ) ! IF .iob[IOB$V_APPEND] OR .iob[IOB$V_OVERWRITE] THEN IF NOT X10$ENTER_LOOKUP( .iob, file_parse, lookup_args ) THEN $XPO_QUIT(); ! ! Perform an ENTER monitor call. ! IF .iob[IOB$V_OUTPUT] ! If this is an open for output, THEN ! IF NOT $T10_ENTER( ! perform a TOPS-10 ENTER: .iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the ENTER fails, $T10_ERROR( .lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_CREATE ); ! ! If this is a record-mode input file, check to see if it is sequenced. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_RECORD] ! If this is a record-mode input file, THEN ! IF $T10_IN( .iob[IOB$H_CHANNEL] ) ! fill the first system input buffer. THEN IF .(.( buffer_cb[$BFPTR] ) + 1) ! Test the low bit (bit 35) of the 1st word of the file THEN ! and assume that the file is sequenced iob[IOB$V_SEQUENCED] = yes ! if the bit is 1 ELSE ! or that it is not sequenced iob[IOB$V_SEQUENCED] = no ! if the bit is 0. ELSE IF ($T10_GETSTS( .iob[IOB$H_CHANNEL] ) ! If an immediate end-of-file was reached, AND IO$EOF) NEQ 0 ! THEN ! turn on the IOB end-of-file indicator which iob[IOB$V_EOF] = yes ! will cause the first $XPO_GET to fail. ELSE ! If any other read error occurred, $XPO_QUIT( IO_ERROR ); ! return an error code to the caller. ! ! If an existing record-mode file is being extended, check to see if it is sequenced. ! IF .iob[IOB$V_APPEND] AND .iob[IOB$V_RECORD] AND ! If an existing record-mode file is being extended, (.iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL) ! THEN ! IF $T10_IN( .iob[IOB$H_CHANNEL] ) ! fill the first system input buffer. THEN IF .(.(extra_buffer_cb + $BFPTR) + 1) ! Test the low bit (bit 35) of the 1st word of the file THEN ! and assume that the file is sequenced iob[IOB$V_SEQUENCED] = yes ! if the bit is 1 ELSE ! or that it is not sequenced iob[IOB$V_SEQUENCED] = no ! if the bit is 0. ELSE IF ($T10_GETSTS( .iob[IOB$H_CHANNEL] ) ! If an error other than end-of-file was detected, AND IO$EOF) EQL 0 ! THEN ! $XPO_QUIT( IO_ERROR ); ! return an error code to the caller. ! ! Position at end-of-file if an existing file is being extended. ! IF .iob[IOB$V_APPEND] AND ! If an existing file is being extended, (.iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL) ! THEN ! $T10_USETI( ! use TOPS-10 USETI to position to end-of-file: .iob[IOB$H_CHANNEL], ! channel number -1 ); ! end-of-file indicator IF .iob[IOB$V_APPEND] AND .iob[IOB$V_RECORD] ! If a record-mode file is being extended, THEN ! $T10_CLOSE( .iob[IOB$H_CHANNEL], CL$OUT ); ! close the input side of the channel. ! ! If this is an output file, perform a dummy output operation ! to force the system to allocate its I/O buffer(s). ! IF .iob[IOB$V_OUTPUT] ! If this is an output file, THEN ! IF NOT $T10_OUT( .iob[IOB$H_CHANNEL] ) ! force buffer allocation. THEN ! If the allocation fails, $XPO_QUIT( NO_MEMORY ); ! return an error code to the caller. END; ! End of "TOPS10 control block" code block END; ! End of TOPS-10 code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. ! ! Close and release the assigned I/O channel in the event of an OPEN error. ! IF NOT .iob[IOB$G_COMP_CODE] AND .channel_open ! If an open error occurred and a channel has been opened, THEN ! BEGIN ! $T10_CLOSE( .iob[IOB$H_CHANNEL] ); ! close the assigned channel $T10_RELEASE( .iob[IOB$H_CHANNEL] ); ! and release the channel. END; !+ ! ! End of TOPS-10 OPEN Processing ! !- %FI %TITLE 'TOPS-20 File Open' %IF $TOPS20 %THEN !+ ! ! TOPS-20 OPEN processing ! !- BEGIN BIND resultant = iob[IOB$T_RESULTANT] : $STR_DESCRIPTOR(); LOCAL resultant_spec : VECTOR [CH$ALLOCATION(X20$K_MAX_SPEC)], jfn_or_error, ! Storage area for JFN or error code flags; ! Parameter used for getting a JFN ! ! Build a resultant file specification from the specification passed by the caller. ! $XPO_BUILD_SPEC( .iob ); ! ! Bypass opening the user's terminal. ! If .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! BEGIN ! IF .iob[IOB$V_BINARY] ! return an error code if binary OR .iob[IOB$V_RANDOM] ! or random I/O is requested THEN ! $XPO_QUIT( BAD_IO_OPT ); ! ! $XPO_QUIT( NORMAL ); ! or return a success code to the caller. END; ! ! Further validate the caller's IOB. ! IF (.iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT]) ! If the file is being opened for both input and output, AND (NOT .iob[IOB$V_RANDOM]) ! and random I/O not requested THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. ! ! Get prepared for associating a JFN with the file. ! IF NOT $X20_ASCIZ( resultant, resultant_spec ) ! Copy the file-spec to resultant_spec and make it ASCIZ. THEN $XPO_QUIT( BAD_SPEC, BAD_LENGTH ); ! Return an error code to the caller if file-spec is too long. IF .iob[IOB$V_INPUT] OR .iob[IOB$V_APPEND] OR ! If we're doing input or appending or .iob[IOB$V_OVERWRITE] ! overwriting a file, THEN ! flags = GJ_SHT OR GJ_OLD ! first refer to an existing file. ELSE ! IF .iob[IOB$V_TEMPORARY] ! Otherwise, create a new generation of the file. THEN flags = GJ_SHT OR GJ_FOU OR GJ_TMP ELSE flags = GJ_SHT OR GJ_FOU OR GJ_NEW OR $GJNHG; ! ! Associate the file with a JFN. ! iob[IOB$G_COMP_CODE] = XPO$_CREATED; ! Initially assume a file is being created IF $T20_GTJFN( ! Get the JFN: .flags, ! specified options CH$PTR(resultant_spec), ! pointer to file-spec jfn_or_error ) ! JFN or error code returned here THEN BEGIN IF .iob[IOB$V_INPUT] OR .iob[IOB$V_APPEND] OR ! If we were doing input, appending .iob[IOB$V_OVERWRITE] ! or overwriting and found the file, THEN ! iob[IOB$G_COMP_CODE] = XPO$_NORMAL; ! indicate the file already exists. END ELSE ! Here if GTJFN failed. IF ( (.jfn_or_error NEQ GJFX24) AND ! If the file exists or (.jfn_or_error NEQ GJFX18) AND ! (.jfn_or_error NEQ GJFX19) ) OR ! .iob[IOB$V_INPUT] ! we're doing input, THEN ! BEGIN ! X20$ERROR( .iob, .jfn_or_error ); ! convert the error to equivalent XPORT completion codes $XPO_QUIT(); ! and return to the caller. END ELSE BEGIN ! Otherwise, we're appending or overwriting to a new file. IF NOT $T20_GTJFN( ! Get the JFN: GJ_SHT OR GJ_FOU OR ! use short form and file is a new file GJ_NEW OR $GJNHG, ! increment generation number if not specified CH$PTR(resultant_spec), ! pointer to file-spec jfn_or_error ) ! JFN or error code returned here THEN BEGIN ! If GTJFN failed, X20$ERROR( .iob, .jfn_or_error ); ! convert the error to equivalent XPORT completion codes $XPO_QUIT(); ! and return to the caller. END; END; channel_assign = yes; ! Indicate JFN has been assigned. iob[IOB$H_CHANNEL] = .jfn_or_error; ! Save the JFN. ! ! Get prepared for opening the file. ! flags = OF_PLN OR X20$K_WORD_SIZE; ! Include line number information, ! and always read/write in word mode. IF .iob[IOB$V_INPUT] OR ! If we're doing input or we're appending (.iob[IOB$V_APPEND] AND ! to a file which exists, .iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL) ! THEN ! flags = .flags OR OF_RD; ! then indicate we're reading. IF .iob[IOB$V_OUTPUT] ! If we're doing output, THEN ! flags = .flags OR OF_WR OR OF_RTD; ! indicate we're writing and restrict access by other users. ! ! Open the file. ! IF NOT $T20_OPENF( ! Open the file: .iob[IOB$H_CHANNEL], ! JFN .flags, ! specified options jfn_or_error ) ! storage area for JFN or error code THEN BEGIN X20$ERROR( .iob, .jfn_or_error ); ! Convert the error to an equivalent XPORT completion code $XPO_QUIT(); ! and return to the caller. END; channel_open = yes; ! Indicate that a file has been opened. iob[IOB$A_BUFFER_CB] = ! Save the address of the buffer control block. X20$BUFFER_CB[.iob[IOB$H_CHANNEL],$BASE]; ! ! If this is a record mode input file or an existing record mode ! file is being extended, check to see if it is sequenced. ! IF ( .iob[IOB$V_INPUT] AND .iob[IOB$V_RECORD] ) OR ( .iob[IOB$V_APPEND] AND .iob[IOB$V_RECORD] AND ( .iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL ) ) THEN BEGIN SELECTONE X20$IN( .iob ) OF ! Allocate and fill the input buffer. SET [ XPO$_END_FILE ] : ! End-of-file: IF .iob[IOB$V_INPUT] ! If we're doing input THEN ! turn on the IOB end-of-file indicator which .iob[IOB$V_EOF] = yes; ! will cause the first $XPO_GET to fail. [ XPO$_NORMAL ] : ! Successful return: BEGIN IF .(.(.iob[IOB$A_BUFFER_CB]+$BFPTR)+1) ! Test the low bit (bit 35) of the 1st word of the file THEN ! and assume that the file is sequenced iob[IOB$V_SEQUENCED] = yes ! if the bit is 1 ELSE ! or it is not sequenced iob[IOB$V_SEQUENCED] = no; ! if the bit is 0. END; [ OTHERWISE ] : ! All other error conditions: $XPO_QUIT(); ! Return with the previously set completion codes. TES; IF .iob[IOB$V_APPEND] ! If we're appending to an existing file THEN ! BEGIN ! $XPO_FREE_QUIT( STRING = ! get rid of the input buffer, (.(.iob[IOB$A_BUFFER_CB] + $BFCTR), .(.iob[IOB$A_BUFFER_CB] + $BFPTR)) ); INCR count FROM 0 TO 2 DO ! Then zero out the buffer control block. (.iob[IOB$A_BUFFER_CB] + .count) = 0; END; END; ! ! Position at end-of-file if an existing file is being extended. ! IF .iob[IOB$V_APPEND] AND (.iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL) THEN $T20_SFPTR( .iob[IOB$H_CHANNEL], -1 ); ! ! If this is an output file, perform a dummy output operation ! to allocate its I/O buffer. ! IF .iob[IOB$V_OUTPUT] ! If this is an output file, THEN ! IF NOT X20$OUT( .iob ) ! allocate the buffer. THEN $XPO_QUIT(); END; ! End of TOPS-20 code block ! ! End of MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. ! ! In the event of an OPEN error, close and release the assigned JFN. ! IF NOT .iob[IOB$G_COMP_CODE] ! If an open error occurred, THEN ! BEGIN ! IF .channel_open ! and a file has been opened, THEN ! $T20_CLOSF( .iob[IOB$H_CHANNEL] ) ! then close the file and release the JFN. ELSE IF .channel_assign ! If the file has not been opened, THEN ! and the JFN has been assigned $T20_RLJFN( .iob[IOB$H_CHANNEL] ); ! then release the JFN. iob[IOB$H_CHANNEL] = 0; ! Zero the IOB channel field. END; !+ ! ! End of TOPS-20 OPEN processing ! !- %FI %TITLE 'VAX/VMS File Open' %IF $VMS %THEN !+ ! ! VAX/VMS OPEN Processing ! !- BEGIN LOCAL fab : REF $FAB_DECL, ! Address of RMS FAB rab : REF $RAB_DECL, ! Address of RMS RAB name_block : REF $NAM_DECL, ! Address of RMS Name Block resultant_spec : ! Space for a resultant file-spec VECTOR[ CH$ALLOCATION(max_file_spec) ]; ! ! Make sure that no FAB or RAB already exists. ! IF .iob[IOB$A_RMS_FAB] NEQ 0 OR ! If a FAB already exists .iob[IOB$A_RMS_RAB] NEQ 0 ! or a RAB already exists, THEN ! $XPO_QUIT( BAD_LOGIC ); ! return an error code to the caller. ! ! Create an RMS File Access Block (FAB). ! $XPO_IF_NOT( $XPO_GET_MEM( UNITS = FAB$C_BLN, ! Get dynamic memory for a FAB. RESULT = fab, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[IOB$A_RMS_FAB] = .fab; ! Save the address of the FAB. $FAB_INIT( FAB = .fab, ! Initialize the FAB: BKS = .iob[IOB$G_BLK_SIZE] / ! bucket size bytes_per_block, ! BLS = .iob[IOB$G_BLK_SIZE], ! block size (mag tape only) CTX = .iob, ! address of XPORT IOB FAC =, ! no file access indicators - overrides FAC=GET default FOP = SQO, ! file processing option: sequential only MRS = .iob[IOB$G_REC_SIZE], ! fixed-length record size ORG = SEQ, ! sequential file organization RFM = VAR ); ! variable record format ($FAB_INIT default) ! fab[FAB$V_NEF] = NOT .iob[IOB$V_APPEND]; ! "not end of file" indicator fab[FAB$V_CIF] = .iob[IOB$V_APPEND] OR ! "create if" indicator .iob[IOB$V_OVERWRITE]; ! fab[FAB$V_TRN] = .iob[IOB$V_OVERWRITE]; ! "allow truncate file with PUT" indicator fab[FAB$V_BIO] = .iob[IOB$V_BINARY] OR ! "block I/O" indicator for binary or .iob[IOB$V_RANDOM]; ! random files IF .iob[IOB$V_INPUT] ! Special input file FAB setup: THEN ! BEGIN ! fab[FAB$V_GET] = yes; ! "GET" indicator fab[FAB$V_BRO] = .iob[IOB$V_STREAM]; ! "mixed block/record I/O" indicator for stream I/O fab[FAB$V_SHRGET] = yes; ! allow others to read file END; IF .iob[IOB$V_OUTPUT] ! Special output file FAB setup: THEN ! BEGIN ! fab[FAB$V_MXV] = .iob[IOB$V_MAX_VERSI]; ! "maximize file version" indicator fab[FAB$V_OFP] = yes; ! "output file parse" indicator fab[FAB$V_PUT] = yes; ! "PUT" indicator fab[FAB$V_CR] = .iob[IOB$V_RECORD]; ! "implicit CR/LF" indicator fab[FAB$V_NIL] = yes; ! "no file sharing" indicator fab[FAB$V_GET] = .iob[IOB$V_RANDOM]; ! "input and output" for an OUTPUT RANDOM file ! N.B. If a file is open for random access output, ! XPORT must be able to read in the file before writing. ! IF .iob[IOB$V_BINARY] OR .iob[IOB$V_RANDOM] ! THEN ! BEGIN ! fab[FAB$B_RFM] = FAB$C_FIX; ! binary "record" format (actually FIXED) fab[FAB$W_MRS] = binary_record_len; ! binary "record" length END ! ELSE ! IF .iob[IOB$V_SEQUENCED] ! THEN ! fab[FAB$B_RFM] = FAB$C_VFC ! sequenced (VFC) record format ELSE ! IF .iob[IOB$G_REC_SIZE] NEQ 0 ! THEN ! fab[FAB$B_RFM] = FAB$C_FIX; ! fixed record format END; ! ! Use RMS PARSE to perform file specification resolution. ! IF NOT XPO$RMS_PARSE( .iob ) ! Perform file-spec resolution. THEN $XPO_QUIT(); ! Jump to return error codes if file-spec resolution fails. name_block = .fab[FAB$L_NAM]; ! Update the Name Block built by XPO$RMS_PARSE: name_block[NAM$B_RSS] = max_file_spec; ! length of resultant file-spec buffer name_block[NAM$L_RSA] = resultant_spec; ! pointer to the resultant file-spec buffer ! ! Special setup for terminal I/O. ! IF .iob[IOB$V_TERMINAL] THEN BEGIN fab[FAB$V_UFO] = yes; ! Turn on "user file open" fab[FAB$V_BRO] = no; ! and turn off "mixed block/record I/O". END; ! ! Build a file header extended attributes block (XAB). ! IF ( .iob[IOB$V_INPUT] AND .iob[IOB$V_RECORD] ) OR ! If this file may be read in record or ( .iob[IOB$V_INPUT] AND .iob[IOB$V_STREAM] ) OR ! stream mode, we need the LRL ( .iob[IOB$V_RANDOM] AND .iob[IOB$V_APPEND] ) ! If appending to a random file, we need ! to save the end of file. THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! get dynamic memory for a file header XAB. UNITS = XAB$C_FHCLEN, RESULT = header_xab, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); fab[FAB$L_XAB] = .header_xab; ! Have the FAB point to the XAB. $XABFHC_INIT( XAB = .header_xab ); ! Initialize the XAB. END; ! ! Open the specified file. ! IF .iob[IOB$V_INPUT] ! If this is an input file, THEN ! $RMS_OPEN( FAB = .fab ) ! open the file. ELSE $RMS_CREATE( FAB = .fab ); ! Otherwise, create an output file. ! ! If there was an error on the open, and the file was a random file, then special processing ! is required. ! IF ( .iob[IOB$V_RANDOM] AND (NOT .fab[FAB$L_STS] ) ) THEN SELECTONE .fab[FAB$L_STS] OF SET [ RMS$_FNF ]: ! ERROR: File not found IF .iob[IOB$V_OUTPUT] THEN ! If the open was for input and output and the file doesn't exist $RMS_CREATE ( FAB = .fab ) ; ! then open the file for output [ RMS$_FEX ]: ! ERROR: File already exists $RMS_OPEN ( FAB = .fab ) ; ! If the open was for output and an EXACT file specification was ! given, then open the file - don't create it TES ; fab[FAB$L_XAB] = 0; ! Disconnect the file header XAB from the FAB. ! ! Save the resultant file specification. ! IF .name_block[NAM$B_RSL] NEQ 0 ! If a resultant file-spec was created by RMS, THEN ! BEGIN ! $XPO_IF_NOT( $STR_COPY( ! copy the file-spec into dynamic memory. STRING = (.name_block[NAM$B_RSL], .name_block[NAM$L_RSA]), TARGET = iob[IOB$T_RESULTANT], FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); name_block[NAM$L_RSA] = ! Then have the Name Block point to the copied file-spec. .iob[$SUB_FIELD(IOB$T_RESULTANT,STR$A_POINTER)]; END; name_block[NAM$B_RSS] = 0; ! Zero the resultant buffer length for safety sake. ! ! Interpret the RMS OPEN or CREATE completion code. ! SELECTONE .fab[FAB$L_STS] OF ! Translate the RMS completion code into SET ! an appropriate XPORT completion code. [ RMS$_NORMAL ] : IF .iob[IOB$V_INPUT] OR .fab[FAB$V_CIF] ! If an existing file was opened, THEN ! iob[IOB$G_COMP_CODE] = XPO$_NORMAL ! setup a normal success code. ELSE iob[IOB$G_COMP_CODE] = XPO$_CREATED; ! Otherwise, indicate a new file was created. [ RMS$_CREATED, RMS$_FILEPURGED ] : ! "file was created" or "oldest version deleted" iob[IOB$G_COMP_CODE] = XPO$_CREATED; [ RMS$_SUPERSEDE ] : ! "existing file was superseded" iob[IOB$G_COMP_CODE] = XPO$_NORMAL; [ OTHERWISE ] : ! Any other RMS error: BEGIN XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .fab[FAB$L_STS], ! equivalent XPORT completion codes .fab[FAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; TES; ! ! Verify device characteristics. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT] AND ! If this file is being opened for both input and output (NOT .iob[IOB$V_RANDOM]) AND ! and the file isn't a random file ((.fab[FAB$L_DEV] AND DEV$M_FOD) NEQ 0) ! and the device is file structured, THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. IF .fab[FAB$V_UFO] ! If this is a "user file open", THEN ! BEGIN ! iob[IOB$H_CHANNEL] = .fab[FAB$L_STV]; ! save the I/O channel number $XPO_QUIT(); ! and bypass the rest of XPORT open processing. END; ! ! Update the caller's IOB after a successful file open. ! IF .iob[IOB$V_TERMINAL] ! *** BYPASS FOR RMS ERROR *** THEN fab[FAB$V_CR] = yes; iob[IOB$V_SEQUENCED] = ! Indicate whether the file is sequenced. .fab[FAB$B_RFM] EQL FAB$C_VFC AND NOT .fab[FAB$V_PRN] AND .fab[FAB$B_FSZ] EQL 2; IF .fab[FAB$B_RFM] EQL FAB$C_FIX ! If this is a fixed-length record file, THEN ! iob[IOB$G_REC_SIZE] = .fab[FAB$W_MRS]; ! save the record length. iob[IOB$G_BLK_SIZE] = .fab[FAB$W_BLS]; ! Save the file block size. ! ! Create an RMS Record Access Block (RAB). ! $XPO_IF_NOT( $XPO_GET_MEM( UNITS = RAB$C_BLN, ! Get dynamic memory for a RAB. RESULT = rab, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); iob[IOB$A_RMS_RAB] = .rab; ! Save the address of the RAB. $RAB_INIT( RAB = .rab, ! Initialize the RAB: FAB = .fab, ! address of the associated FAB ROP = (LOC,PMT), ! locate-mode GET & input prompt indicators UBF = 0 ); ! "no buffer allocated" indicator ! rab[RAB$V_EOF] = .iob[IOB$V_APPEND]; ! "position to end-of-file" indicator rab[RAB$V_TPT] = .iob[IOB$V_OVERWRITE]; ! "truncate file with PUT" indicator rab[RAB$V_BIO] = .iob[IOB$V_BINARY] OR ! "block I/O only" indicator for binary I/O .iob[IOB$V_RANDOM] OR ! or random I/O (.iob[IOB$V_STREAM] AND ! or stream I/O of undefined file .fab[FAB$B_RFM] EQL FAB$C_UDF); ! ! Allocate an XPORT internal I/O buffer. ! IF .iob[IOB$V_INPUT] OR .iob[IOB$V_BINARY] OR ! If an XPORT I/O buffer will be needed, .iob[IOB$V_RANDOM] THEN ! build the buffer in dynamic memory. BEGIN rab[RAB$W_USZ] = ! Setup the buffer size (IF .rab[RAB$V_BIO] ! THEN ! .fab[FAB$W_BLS] ! for binary block I/O ELSE ! .header_xab[XAB$W_LRL]); ! or character record I/O. IF .rab[RAB$W_USZ] EQL 0 ! If no record/block size exists, THEN ! rab[RAB$W_USZ] = io_buffer_size; ! assume a maximum sized buffer. $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate the dynamic buffer. UNITS = .rab[RAB$W_USZ], RESULT = rab[RAB$L_UBF], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); END; ! ! Save the end of file pointer. ! IF ( .iob[IOB$V_RANDOM] AND .iob[IOB$V_APPEND] ) ! If appending to a non-zero file AND (.header_xab[XAB$L_EBK] NEQ 0) ! with random access, we THEN ! need to save the end of file. iob[IOB$G_NEXT_POS] = ! End of file block is origin 1 (.header_xab[XAB$L_EBK] - 1 ) * bytes_per_block; ! ! Perform an RMS CONNECT operation. ! IF NOT $RMS_CONNECT( RAB = .rab ) ! If connecting the RAB to the FAB fails, THEN ! 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; END; ! End of VMS code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. ! ! Free the RMS file header XAB if one was created. ! IF .header_xab NEQ 0 THEN $XPO_FREE_MEM( BINARY_DATA = ( XAB$C_FHCLEN, .header_xab, UNITS ), FAILURE = 0 ); !+ ! ! End of VAX/VMS OPEN Processing ! !- %FI %TITLE 'RSX-11M File Open' %IF $11M %THEN !+ ! ! RSX-11M OPEN Processing ! !- BEGIN LOCAL spec_parse : $XPO_SPEC_BLOCK; ! Resultant file-spec parse block ! ! Make sure that no QIO/FCS information already exists. ! IF .iob[IOB$H_CHANNEL] NEQ 0 OR ! If a LUN has been assigned .iob[IOB$A_FCS_FDB] NEQ 0 ! or XPORT's FCS blocks have been allocated, THEN ! $XPO_QUIT( BAD_LOGIC ); ! return an error code to the caller. ! ! Build a resultant file specification from the specifications passed by the caller ! and assign an RSX-11M Logical Unit Number (LUN) to this file. ! IF NOT XRSX$SPEC_SETUP( .iob, spec_parse ) THEN $XPO_QUIT(); ! ! Perform special OPEN processing for terminal devices. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! perform special setup instead of OPEN$. BEGIN LOCAL status : $QIO_STATUS; ! QIO status codes IF .iob[IOB$V_BINARY] ! If binary I/O is requested, THEN ! $XPO_QUIT( BAD_IO_OPT ); ! return an error code to the caller. IF NOT ALUN$S( .iob[IOB$H_CHANNEL], ! Assign the LUN to the terminal device: .(.spec_parse[XPO$A_DEVICE]), ! 2 character device name 0 ) ! device unit number **** TEMPORARY **** THEN $XPO_QUIT( BAD_LOGIC ); ! Return an error code if the LUN assignment failed. $XPO_QUIT( NORMAL ); ! Otherwise, return a success code to the caller. END; ! ! Further validate the caller's IOB. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT] ! If the file is being opened for both input and output, THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. ! ! Allocate an XPORT set of FCS control blocks. ! $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = FCS$K_BLK_LEN, RESULT = iob[IOB$A_FCS_FDB], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); BEGIN BIND ! Redeclare each FCS control block fcs_blocks = .iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, fdb = fcs_blocks[FCS$Z_FDB] : FDB$; ! ! Setup the FCS File Descriptor Block (FDB). ! ! Setup all common FDB fields: fdb[F$LUN] = .iob[IOB$H_CHANNEL]; ! logical unit number (LUN) fdb[F$OVBS] = .iob[IOB$G_BLK_SIZE]; ! override blocksize fdb[F$DSPT] = fcs_blocks[FCS$Z_DS_DESC]; ! address of FCS dataset descriptor fdb[F$EFN] = .XRSX$EVENT_FLAG; ! event flag number ! (NOTE: F$EFN and F$BKEF are the same field) IF .iob[IOB$V_INPUT] ! Setup all input file FDB fields: THEN ! BEGIN ! fdb[FO$$RD] = yes; ! open existing file for input fdb[FA$$SHR] = yes; ! shared access END; IF .iob[IOB$V_OUTPUT] ! Setup all output file FDB fields: THEN ! BEGIN ! fdb[F$CNTG] = -default_alloc; ! file allocation size (non-contiguous) fdb[F$ALOC] = -1; ! file extension quantity - use system default fdb[FO$$WRT] = NOT .iob[IOB$V_APPEND]; ! open new file for output fdb[FA$$EXT] = yes; ! allow extend of existing file fdb[FA$$CRE] = NOT .iob[IOB$V_APPEND] AND ! create new file NOT .iob[IOB$V_OVERWRITE]; ! fdb[FO$$APD] = .iob[IOB$V_APPEND] OR ! open existing file for append or NOT .iob[IOB$V_OVERWRITE]; ! don't supersede existing file ! (NOTE: FO$$APD and FO$$NSP are the same bit) END; IF .iob[IOB$V_RECORD] ! Setup all RECORD-mode FDB fields: THEN ! BEGIN ! fdb[R$$FIX] = .iob[IOB$G_REC_SIZE] NEQ 0; ! fixed length records fdb[R$$VAR] = .iob[IOB$G_REC_SIZE] EQL 0; ! variable length records fdb[R$$SEQ] = .iob[IOB$V_SEQUENCED]; ! sequenced records fdb[FD$$CR] = yes; ! implied CR/LF carriage control fdb[F$RSIZ] = .iob[IOB$G_REC_SIZE]; ! fixed record length END; IF .iob[IOB$V_STREAM] ! Setup all STREAM-mode FDB fields: THEN ! fdb[R$$VAR] = yes; ! variable length records IF .iob[IOB$V_BINARY] ! Setup all BINARY-mode FDB fields: THEN ! BEGIN ! fdb[FD$$RWM] = yes; ! READ$/WRITE$ file access fdb[F$BKST] = fcs_blocks[FCS$Z_STATUS]; ! address of FCS status block END; ! ! Setup the FCS Dataset Descriptor (DSPT). ! XRSX$DSPT_SETUP( fcs_blocks[FCS$Z_DS_DESC], spec_parse ); ! ! Open the file. ! IF XRSX$XOPEN( .iob ) ! Open the specified file. THEN IF .fdb[FA$$CRE] ! Set an appropriate success completion code. THEN iob[IOB$G_COMP_CODE] = XPO$_CREATED ELSE iob[IOB$G_COMP_CODE] = XPO$_NORMAL ELSE IF .iob[IOB$V_OUTPUT] AND ! If an attempt to open an existing file for output fails, .fdb[F$ERR] EQL IE$NSF ! THEN ! BEGIN ! fdb[FA$$CRE] = yes; ! IF XRSX$XOPEN( .iob ) ! attempt to create a new output file. THEN iob[IOB$G_COMP_CODE] = XPO$_CREATED ELSE BEGIN XRSX$RSLT_FIXUP( .iob ); XRSX$IO_ERROR( .iob, .fdb[F$ERR] ); $XPO_QUIT(); END; END ELSE BEGIN XRSX$RSLT_FIXUP( .iob ); XRSX$IO_ERROR( .iob, .fdb[F$ERR] ); $XPO_QUIT(); END; ! ! Update the caller's IOB after a successful file open. ! $XPO_IF_NOT( XRSX$RSLT_FIXUP( .iob ) ) ! Fixup the resultant file-spec. THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); iob[IOB$V_SEQUENCED] = .fdb[R$$SEQ]; ! Indicate whether the file is sequenced. IF .fdb[R$$FIX] ! If the file has fixed-length records, THEN ! iob[IOB$G_REC_SIZE] = .fdb[F$RSIZ]; ! put the record length into the IOB. ! iob[IOB$G_BLK_SIZE] = .fdb[F$OVBS]; ! Put the blocksize into the IOB. *** TEMPORARY *** ! ! Allocate an FCS block or record I/O buffer. ! IF ( .iob[IOB$V_RECORD] AND .iob[IOB$V_INPUT] ) OR ! If this a character-mode input file, ( .iob[IOB$V_STREAM] AND .iob[IOB$V_INPUT] ) ! THEN ! BEGIN ! $XPO_IF_NOT( $XPO_GET_MEM( ! allocate a record buffer. UNITS = .fdb[F$RSIZ], RESULT = fdb[F$URBD$A], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); fdb[F$URBD$S] = .fdb[F$RSIZ]; ! Save the size of the allocated input record buffer. END; IF .iob[IOB$V_BINARY] ! If this is a binary-mode file, THEN ! allocate a block I/O buffer. BEGIN LOCAL device_info : GLUN$INFO; GLUN$S( .fdb[F$LUN], device_info ); ! Obtain device information. IF .fdb[F$OVBS] EQL 0 OR ! If no block size has been established .device_info[GL$FILES_11] ! or this is a Files-11 device, THEN ! fdb[F$OVBS] = bytes_per_block; ! assume a default block size. $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate the block I/O buffer. UNITS = .fdb[F$OVBS], RESULT = fdb[F$BKDS$A], FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); fdb[F$BKDS$S] = .fdb[F$OVBS]; ! Save the size of the allocate block I/O buffer. END; END; ! End of "FCB block BINDs" code block END; ! End of RSX-11M code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. !+ ! ! End of RSX-11M OPEN Processing ! !- %FI %TITLE 'RSTS/E File Open' %IF $RSTS %THEN !+ ! ! RSTS/E OPEN Processing ! !- BEGIN ! ! Check for RSTS restraints ! IF .iob[IOB$V_SEQUENCED] ! RSTS/E does not support sequenced files. THEN $XPO_QUIT( NO_SEQ ); ! ! Build a resultant file specification from the specifications passed by the caller, ! and setup the FIRQB with this information. ! IF NOT XRST$SPEC_SETUP( .iob ) THEN $XPO_QUIT(); ! ! Bypass opening the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal and THEN ! BEGIN ! IF .iob[IOB$V_BINARY] ! binary I/O is requested, THEN ! return an error code. $XPO_QUIT( BAD_IO_OPT ); ! ! $XPO_QUIT( NORMAL ); ! Otherwise, return a success code to the caller. END; ! ! Assign a RSTS/E channel number to this file. ! IF NOT XRST$ASSIGN_CH( .iob ) THEN $XPO_QUIT(); ! ! Further validate the caller's IOB. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT] ! If the file is being opened for both input and output, THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. ! ! Allocate an XPORT set of RSTS/E control blocks. ! $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = XRSTS$K_CB_LEN, RESULT = iob[IOB$A_RSTS_CB], FILL = 0, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); BEGIN BIND rsts_cb = .iob[IOB$A_RSTS_CB] : $XRSTS_CB; ! Redeclare the buffer control block. ! ! Complete the setup of the FIRQB ! $XRSTS_FIRQB[FQFIL] = .iob[IOB$H_CHANNEL] * 2; ! Common FIRQB field (channel number times 2) IF .iob[IOB$V_INPUT] ! Setup all input file FIRQB fields: THEN ! BEGIN ! $XRSTS_FIRQB[FQFUN] = OPNFQ; ! open function code $XRSTS_FIRQB[FQMODE] = XRSTS$K_SIGN_BIT + 0; ! normal read/write mode END; IF .iob[IOB$V_OUTPUT] ! Setup all output FIRQB fields: THEN ! IF .iob[IOB$V_APPEND] ! Setup all append file FIRQB fields: THEN ! BEGIN ! $XRSTS_FIRQB[FQFUN] = OPNFQ; ! open function code $XRSTS_FIRQB[FQMODE] = XRSTS$K_SIGN_BIT + 2;! append mode END ! ELSE ! Setup all other output file FIRQB fields: BEGIN ! $XRSTS_FIRQB[FQFUN] = CREFQ; ! create function code $XRSTS_FIRQB[FQMODE] = XRSTS$K_SIGN_BIT +0; ! normal read/write mode END; ! ! Open the file. ! $CALFIP; ! Open the specified file. IF .$XRSTS_FIRQB[FQIOSTS] EQL 0 ! Set an appropriate success completion code. THEN IF .iob[IOB$V_APPEND] OR .iob[IOB$V_INPUT] THEN iob[IOB$G_COMP_CODE] = XPO$_NORMAL ELSE iob[IOB$G_COMP_CODE] = XPO$_CREATED ELSE BEGIN IF .iob[IOB$V_OUTPUT] AND ! If an attempt to open an existing file for output fails, .$XRSTS_FIRQB[FQIOSTS] EQL RSTS$_NOSUCH ! THEN ! BEGIN ! $XRSTS_FIRQB[FQIOSTS] = 0; ! reinitialize the status word, $XRSTS_FIRQB[FQFUN] = CREFQ; ! setup the create subfunction, $XRSTS_FIRQB[FQMODE] = XRSTS$K_SIGN_BIT +0; ! and the normal read/write mode. $CALFIP; ! Open the file. IF .$XRSTS_FIRQB[FQIOSTS] EQL 0 THEN iob[IOB$G_COMP_CODE] = XPO$_CREATED ELSE BEGIN XRST$FIXUP; XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; END ELSE BEGIN XRST$FIXUP; XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; END; ! ! Get the attributes of a file. ! IF .iob[IOB$G_COMP_CODE] EQL XPO$_NORMAL ! If we're reading a file, THEN ! check what type a file it is. BEGIN $XRSTS_INI_FIRQB; ! Initialize the FIRQB. $XRSTS_FIRQB[FQFUN] = UU$ATR; ! Setup the function code. $XRSTS_FIRQB[FQFIL] = .iob[IOB$H_CHANNEL]; ! Setup the channel number. $UUO; ! Get the attributes of the file. IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! Report any errors. THEN BEGIN XRST$FIXUP; XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; IF .$XRSTS_FIRQB[FQAT1] NEQ 0 ! *** TEMPORARY *** THEN ! If the file has attributes, save them: BEGIN ! rsts_cb[XRSTS$G_AT1] = .$XRSTS_FIRQB[FQAT1];! word 1 rsts_cb[XRSTS$G_AT2] = .$XRSTS_FIRQB[FQAT2];! word 2 rsts_cb[XRSTS$G_AT5] = .$XRSTS_FIRQB[FQAT5];! word 5 rsts_cb[XRSTS$G_AT6] = .$XRSTS_FIRQB[FQAT6];! word 6 rsts_cb[XRSTS$G_AT7] = .$XRSTS_FIRQB[FQAT7];! word 7 rsts_cb[XRSTS$G_AT8] = .$XRSTS_FIRQB[FQAT8];! word 8 IF .rsts_cb[XRSTS$V_RECF] EQL RSTS$K_UNDEFINE! Verify that the record format is defined. THEN $XPO_QUIT( BAD_FORMAT ); IF .rsts_cb[XRSTS$V_FILO] NEQ RSTS$K_SEQ ! Verify that the record is sequential. THEN $XPO_QUIT( BAD_ORG ); IF .iob[IOB$V_APPEND] AND ! Verify that we are appending to a STREAM ASCII file. ( .rsts_cb[XRSTS$V_RECF] NEQ RSTS$K_STREAM) THEN $XPO_QUIT( NO_APPEND, BAD_FORMAT ); IF .rsts_cb[XRSTS$V_RECF] EQL RSTS$K_FIXED ! Save in the IOB the record size for fixed length records. THEN iob[IOB$G_REC_SIZE] = .rsts_cb[XRSTS$G_AT2]; END; END; ! ! If we're doing output perform a dummy output operation to allocate it's I/O buffer. ! IF .iob[IOB$V_OUTPUT] ! If we're doing ouput THEN ! IF NOT XRST$OUT( .iob ) ! allocate an output buffer THEN ! $XPO_QUIT(NO_MEMORY); ! and return to the user if an error occurs. END; ! End of RSTS/E control block BIND END; ! End of RSTS/E code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. !+ ! ! End of RSTS/E OPEN Processing ! !- %FI %TITLE 'RT-11 File Open' %IF $RT11 %THEN !+ ! ! RT-11 OPEN Processing ! !- BEGIN LOCAL file_parse : $XPO_SPEC_BLOCK, ! Current file-spec parse block length; ! Size of requested output file BIND ! Redefine several spec-block fields. device = file_parse[XPO$T_DEVICE] : $STR_DESCRIPTOR(), file_name = file_parse[XPO$T_FILE_NAME] : $STR_DESCRIPTOR(), file_type = file_parse[XPO$T_FILE_TYPE] : $STR_DESCRIPTOR(), file_size = file_parse[XPO$T_EXTRA] : $STR_DESCRIPTOR( CLASS = BOUNDED ); ! ! Check for RT-11 restraints ! IF NOT XRT$CHK_BACKGRD() ! Verify that this is a background job. THEN $XPO_QUIT( FOREGROUND ); IF .iob[IOB$V_APPEND] ! The APPEND function is not allowed under RT-11. THEN $XPO_QUIT( NO_APPEND ); IF .iob[IOB$V_SEQUENCED] ! RT-11 does not support sequenced files. THEN $XPO_QUIT( NO_SEQ ); ! ! Build a resultant file specification from the specifications passed by the caller. ! $XPO_BUILD_SPEC( .iob ); ! ! Bypass opening the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal and THEN ! BEGIN ! IF .iob[IOB$V_BINARY] ! binary I/O is requested, THEN ! return an error code. $XPO_QUIT( BAD_IO_OPT ); ! ! $XPO_QUIT( NORMAL ); ! Otherwise, return a success code to the caller. END; ! ! Further validate the caller's IOB. ! IF .iob[IOB$V_INPUT] AND .iob[IOB$V_OUTPUT] ! If the file is being opened for both input and output, THEN ! $XPO_QUIT( BAD_IOB, CONFLICT ); ! return error codes to the caller. ! ! Parse the resultant file-specification into its individual components. ! $XPO_IF_NOT( $XPO_PARSE_SPEC( ! Parse the file-specification. FILE_SPEC = iob[IOB$T_RESULTANT], SPEC_BLOCK = file_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) ); ! ! Return an error if a file name was not specified. ! IF .file_name[STR$H_LENGTH] EQL 0 THEN $XPO_QUIT( BAD_NAME ); ! ! Setup the LOOKUP/ENTER argument list. ! INCR index FROM 0 TO LOOK$K_ARG_LEN-1 DO ! Zero the LOOKUP argument list. lookup_args[.index,0,%BPVAL,0] = 0; ! Fill in the LOOKUP argument list: XRT$ASCII_RAD50( ! device name (Radix-50) .device[STR$A_POINTER], ! .device[STR$H_LENGTH] - 1, ! lookup_args[LOOK$T_DEVICE], ! 1, 0 ); ! ! XRT$ASCII_RAD50( ! file name (Radix-50) .file_name[STR$A_POINTER], ! .file_name[STR$H_LENGTH], ! lookup_args[LOOK$T_NAME1], ! 2, 0 ); ! ! XRT$ASCII_RAD50( ! file type (Radix-50) CH$PLUS(.file_type[STR$A_POINTER], 1), ! .file_type[STR$H_LENGTH] - 1, ! lookup_args[LOOK$T_TYPE], ! 1, 0 ); ! ! ! Fetch the I/O handler for the specified device. ! IF NOT XRT$FETCH(.iob, lookup_args[LOOK$T_DEVICE]) THEN $XPO_QUIT(); ! ! Assign an RT-11 I/O channel to this file. ! WHILE 1 DO ! Loop until we find a free channel. BEGIN INCR channel FROM 0 TO XPO$K_MAX_CHAN+1 DO ! Search for an unused I/O channel.(i.e. unused by XPORT) BEGIN IF .channel GTR XPO$K_MAX_CHAN ! If all channels have been assigned, THEN ! $XPO_QUIT( NO_CHANNEL ); ! return an error code to the caller. IF NOT .XPO$CHANNELS[.channel] ! If this channel is not assigned, THEN ! BEGIN ! XPO$CHANNELS[.channel] = yes; ! indicate that this channel is in use, iob[IOB$H_CHANNEL] = .channel; ! save the number in the IOB, channel_assign = yes; ! indicate that a channel has been assigned, EXITLOOP; ! and then exit the search loop. END; END; iob[IOB$A_BUFFER_CB] = ! Save the address of the buffer control block. XRT$BUFFER_CB[ .iob[IOB$H_CHANNEL],$BASE ]; ! ! Perform a LOOKUP if we're doing input. ! IF .iob[IOB$V_INPUT] ! If this is an open for input, THEN ! BEGIN ! iob[IOB$G_COMP_CODE] = XPO$_NORMAL; ! assume a successful completion. $LOOKUP( ! Perform an RT-11 LOOKUP: .iob[IOB$H_CHANNEL], ! channel number lookup_args, 0, ! address of argument list error_code = yes ); ! if an error occurs, then set error_code IF .error_code ! If an error occurred and THEN ! BEGIN ! IF .RT_ERR_EMT ! the error bit is set to 1 then THEN ! $XPO_QUIT( NO_FILE ); ! the file does not exist. error_code = no; ! Otherwise, the channel is in use. END ELSE EXITLOOP; ! Successful lookup - channel was not in use. END; ! ! Perform an ENTER if we're doing output. ! If .iob[IOB$V_OUTPUT] ! If this is an open for output, THEN ! BEGIN ! iob[IOB$G_COMP_CODE] = XPO$_CREATED; ! assume a successful completion code. IF .file_size[STR$H_LENGTH] EQL 0 ! If the size wasn't specified, THEN ! length = -1 ! set up the default size (largest empty entry on device). ELSE ! IF NOT $STR_BINARY( ! Otherwise pick up the resultant size. STRING = ( .file_size[STR$H_LENGTH] - 2, CH$PTR(.file_size[STR$A_POINTER], 1) ), RESULT = length, OPTION = BASE10, RANGE = ( -1, %X'7FFF' ), FAILURE = 0 ) THEN $XPO_QUIT( BAD_SIZE ); $ENTER( ! Perform an RT-11 ENTER: .iob[IOB$H_CHANNEL], ! channel number lookup_args, ! address of argument list .length, 0, ! file size specification error_code = yes ); ! if an error occurs then set error_code IF .error_code ! If an error occurred and THEN ! BEGIN ! IF .RT_ERR_EMT ! and the error bit is set to 1 then THEN ! $XPO_QUIT( NO_SPACE ); ! there is not enough room. error_code = no; ! Otherwise, the channel is in use. END ELSE EXITLOOP; ! Successful ENTER - channel was not in use. END; END; ! End of channel loop ! ! If we're doing output perform a dummy output operation to allocate it's I/O buffer. ! IF .iob[IOB$V_OUTPUT] ! If we're doing ouput THEN ! IF NOT XRT$OUT( .iob ) ! allocate an output buffer THEN ! $XPO_QUIT(NO_MEMORY); ! and return to user if an error occurs. END; ! End of RT-11 code block ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. ! ! In the event of an OPEN error, release the I/O channel and the I/O handler. ! IF NOT .iob[IOB$G_COMP_CODE] AND ! If an open error occurred and .channel_assign ! a channel number was assigned THEN ! BEGIN ! XPO$CHANNELS[ .iob[IOB$H_CHANNEL] ] = no; ! release the channel number iob[IOB$H_CHANNEL] = 0; ! and zero the IOB channel field. END; !+ ! ! End of RT-11 OPEN Processing ! !- %FI %TITLE 'XPO$OPEN Routine Termination' !+ ! ! Continuation of system-independent file rename processing ! !- ! ! Update the caller's IOB. ! iob[IOB$V_OPEN] = .iob[IOB$G_COMP_CODE]; ! A success completion code means the file was opened. ! ! Call an appropriate action routine. ! $XPO_ACTION_RTN( .iob ); ! Call a success or failure action routine. ! ! Cleanup the IOB after a file open failure. ! IF NOT .iob[IOB$G_COMP_CODE] AND NOT .iob[IOB$V_AUTO_CONC] THEN $XPO_ZAP_IOB( .iob ); ! ! Return to the caller. ! RETURN .iob[IOB$G_COMP_CODE] ! Return the IOB completion code to the caller. END; ! End of XPO$OPEN routine END ELUDOM