MODULE XDELET ( IDENT = 'V1.1-25' %TITLE 'XPO$DELETE - XPORT File Delete' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$DELETE ),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 delete module. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHORS: Ward Clark, CREATION DATE: 22 February 1979 ! Linda Duffell ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$DELETE; ! XPORT file delete 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 %FI ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! %IF $TOPS10 %THEN EXTERNAL ROUTINE X10$CHAN_ASSIGN, ! Channel assignment routine X10$ASCII_6BIT, ! ASCII-to-sixbit conversion routine X10$ENTER_LOOKUP, ! Setup routine for the ENTER/LOOKUP block X10$CLEANUP; ! TOPS10 control block cleanup routine %FI %IF $TOPS20 %THEN EXTERNAL 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 %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, ! XPORT/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$ERROR : NOVALUE; ! RSTS-to-XPORT completion code conversion routine %FI %IF $RT11 %THEN EXTERNAL XPO$CHANNELS : BITVECTOR[]; ! Channel assignment vector in XPO$OPEN EXTERNAL LITERAL XPO$K_MAX_CHAN; ! Maximum I/O channel number EXTERNAL ROUTINE XRT$ASCII_RAD50 : NOVALUE, ! ASCII to RADIX-50 conversion routine XRT$CHK_BACKGRD, ! Background job verification XRT$FETCH; ! Fetch handler routine %FI GLOBAL ROUTINE XPO$DELETE ( iob, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine is the XPORT file delete routine. ! ! FORMAL PARAMETERS: ! ! iob - address of 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 file delete function ! ! COMPLETION CODES: (also returned in IOB$G_COMP_CODE) ! ! XPO$_NORMAL - the file was successfully deleted ! ! XPO$_BAD_DEVICE - invalid device specified (TOPS-10, 11M, RSTS, RT11) ! XPO$_BAD_IO_OPT - invalid I/O option (REMEMBER) ! XPO$_BAD_IOB - the IOB is invalid ! ( IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid IOB length ) ! XPO$_BAD_LOGIC - FAB or RAB already exists (VMS, 11M) ! XPO$_BAD_RSLT - Invalid resultant file specification (VMS) ! ( IOB$G_2ND_CODE =$STR_CPY completion code ) ! XPO$_BAD_SPEC - invalid file specification ! ( IOB$G_2ND_CODE = XPO$_NO_CONCAT - concatenated file-spec not allowed ! XPO$_BAD_LENGTH - invalid length (TOPS-20) ) ! XPO$_BAD_TYPE - invalid file type (TOPS-10, RT-11) ! ( IOB$G_2ND_CODE = $XPO_PARSE_SPEC completion code ) ! XPO$_FOREGROUND - this is a foreground job (RT-11) ! XPO$_FREE_MEM - error deallocating IOB-related memory ! (IOB$G_2ND_CODE = $XPO_FREE_MEM completion code) ! XPO$_GET_MEM - insufficient core for RMS control blocks (VMS) ! ( IOB$G_2ND_CODE = $XPO_GET_MEM completion code ) ! XPO$_IO_ERROR - I/O error (RT-11) ! XPO$_NO_CHANNEL - no I/O channel is available (TOPS-10, RT-11) ! XPO$_NO_FILE - file not found (RT-11) ! XPO$_OPEN - the file is currently open ! failure completion codes from $XPO_VALID_IOB ! failure completion codes from $XPO_BUILD_SPEC (TOPS-10, TOPS-20, RT-11) ! failure completion code from $T10_ERROR (TOPS-10) ! failure completion codes from X20$ERROR (TOPS-20) ! failure completion codes from XPO$RMS_PARSE (VMS) ! failure completion codes from XPO$RMS_CLEANUP (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$ERROR (RSTS) ! failure completion codes from XRT$FETCH (RT-11) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter %IF $TOPS20 OR $RT11 %THEN LOCAL channel_assign; ! Channel assignment indicator %FI %IF $TOPS10 OR $TOPS20 %THEN LOCAL channel_open; ! Channel open indicator %FI %IF $RT11 %THEN LOCAL lookup_args : $XRT_LOOK_ARGS; ! RT-11 LOOKUP argument list %FI ! ! XPORT routine initialization. ! $XPO_MAIN_BEGIN( IO, FIXUP_IOB ) ! Define the MAIN_BLOCK code block ! and validate the caller's IOB. %IF $TOPS20 OR $RT11 %THEN channel_assign = no; ! Start out with no channel assigned %FI %IF $TOPS10 OR $TOPS20 %THEN channel_open = no; ! or opened. %FI ! ! Establish IOB defaults. ! $XPO_VALID_IOB( .iob ); ! Validate or default caller's file-spec and prompt string. ! ! 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 $STR_SCAN( STRING = .iob[IOB$A_FILE_SPEC], ! a concatenated file-spec was specified FIND = '+', FAILURE = 0 ) THEN $XPO_QUIT( BAD_SPEC, NO_CONCAT ); IF .iob[IOB$V_REMEMBER] ! OPTION=REMEMBER was specified THEN $XPO_QUIT( BAD_IO_OPT ); !+ ! ! System-specific file delete processing follows. ! !- %TITLE 'TOPS-10 File Delete' %IF $TOPS10 %THEN !+ ! ! TOPS-10 File Delete Processing ! ! NOTE: The following code is very similar to the code in ! XPO$RENAME since TOPS-10 file delete is a special ! form of file rename. ! !- 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 ); ! ! Don't try deleting the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. ! ! Parse the resultant file specification into its individual components. ! $XPO_IF_NOT($XPO_PARSE_SPEC( ! Reparse the current file specification. FILE_SPEC = iob[IOB$T_RESULTANT], SPEC_BLOCK = file_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_TYPE, (.$XPO_STATUS) ); ! ! Assign a TOPS-10 I/O channel to this file. ! IF NOT X10$CHAN_ASSIGN( .iob ) THEN $XPO_QUIT(); ! ! 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; 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] ); ! ! 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. ! ! Perform a LOOKUP monitor call. ! IF NOT X10$ENTER_LOOKUP( .iob, file_parse, lookup_args ) ! Setup the LOOKUP argument block. THEN $XPO_QUIT(); IF NOT $T10_LOOKUP( ! Perform a TOPS-10 LOOKUP: .iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the LOOKUP fails, $T10_ERROR( .lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_FILE ); ! ! Perform a special RENAME monitor call to delete the file. ! lookup_args[LOOK$T_NAME] = 0; ! Clear the file name and file type to indicate a delete. lookup_args[LOOK$T_EXT] = 0; IF NOT $T10_RENAME( ! Perform a TOPS-10 RENAME: .iob[IOB$H_CHANNEL], ! channel number lookup_args ) ! address of argument list THEN ! If the RENAME fails, $T10_ERROR( .lookup_args[LOOK$H_STATUS], ! return error codes to the caller. NO_DELETE ); ! ! Cleanup the IOB after a successful file delete. ! IF .channel_open ! If 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 assignment. channel_open = no; ! Indicate that the channel is no longer open. END; $XPO_ZAP_IOB( .iob ); ! Reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of TOPS-10 code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate the MAIN_BLOCK code block. ! ! Close and release the assigned I/O channel. ! IF .channel_open ! If 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 assignment. END; !+ ! ! End of TOPS-10 File Delete Processing ! !- %FI %TITLE 'TOPS-20 File Delete' %IF $TOPS20 %THEN !+ ! ! TOPS-20 File Delete 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. ! ! Build a resultant file specification from the specifications passed by the caller. ! $XPO_BUILD_SPEC( .iob ); IF NOT $X20_ASCIZ( resultant, resultant_spec ) ! Store the file-spec in resultant_spec and make it ASCIZ. THEN $XPO_QUIT( BAD_SPEC, BAD_LENGTH ); ! Return an error code if the file-spec is too long. ! ! Associate the file with a JFN. ! IF NOT $T20_GTJFN( GJ_SHT OR GJ_OLD, ! Use short form to associate an existing file with a JFN. CH$PTR( resultant_spec ), ! Pointer to the file-spec jfn_or_error ) ! JFN or error code is returned here. THEN BEGIN X20$ERROR( .iob, .jfn_or_error ); $XPO_QUIT(); END; channel_assign = yes; ! Indicate JFN has been assigned. iob[IOB$H_CHANNEL] = .jfn_or_error; ! Save the JFN. ! ! Delete the file. ! IF NOT $T20_DELF( ! Delete the file: .iob[IOB$H_CHANNEL], ! JFN jfn_or_error ) ! storage area for any error condition THEN BEGIN X20$ERROR( .iob, .jfn_or_error ); $XPO_QUIT(); END; ! ! Cleanup the IOB after a successful file delete. ! channel_assign = no; ! Indicate that the JFN is no longer assigned. $XPO_ZAP_IOB( .iob ); ! Reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of TOPS-20 code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate the MAIN_BLOCK code block. ! ! Release the JFN. ! IF .channel_assign ! If a JFN has been assigned THEN ! BEGIN ! $T20_RLJFN( .iob[IOB$H_CHANNEL] ); ! release the JFN, iob[IOB$H_CHANNEL] = 0; ! and zero the IOB channel field. END; !+ ! ! End of TOPS-20 File Delete Processing ! !- %FI %TITLE 'VAX/VMS File Delete' %IF $VMS %THEN !+ ! ! VAX/VMS File Delete Processing ! !- BEGIN LOCAL fab : REF $FAB_DECL, ! Address of RMS FAB 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. ! ! Use RMS PARSE to perform file specification resolution. ! IF NOT XPO$RMS_PARSE( .iob ) ! Perform file-spec resolution. THEN $XPO_QUIT(); 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 ! ! Use RMS ERASE to delete the file. ! $RMS_ERASE( FAB = .fab ); ! Delete the file. ! ! 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 file-spec buffer length for safety sake. ! ! Check for a file delete failure. ! IF NOT .fab[FAB$L_STS] ! If file deletion failed, THEN ! BEGIN ! XPO$RMS_ERROR( .iob, .fab[FAB$L_STS], ! convert the RMS completion codes into .fab[FAB$L_STV] ); ! equivalent XPORT completion codes $XPO_QUIT(); ! and then jump to return to the caller. END; ! ! Cleanup the IOB after a successful file delete. ! $XPO_ZAP_IOB( .iob ); ! Free the RMS control blocks and reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of VMS code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; %FI %TITLE 'RSX-11M File Delete' %IF $11M %THEN !+ ! ! RSX-11M File Delete 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(); ! ! Don't try deleting the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code 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$DSPT] = fcs_blocks[FCS$Z_DS_DESC]; ! address of FCS dataset descriptor fdb[F$EFN] = .XRSX$EVENT_FLAG; ! event flag number ! ! Setup the FCS Dataset Descriptor (DSPT). ! XRSX$DSPT_SETUP( fcs_blocks[FCS$Z_DS_DESC], spec_parse ); ! ! Open the file. ! IF NOT XRSX$XOPEN( .iob ) ! Open the specified file. THEN BEGIN XRSX$RSLT_FIXUP( .iob ); XRSX$IO_ERROR( .iob, .fdb[F$ERR] ); $XPO_QUIT(); END; ! ! Delete the file. ! BEGIN EXTERNAL ROUTINE %NAME( '.DLFNB' ); BUILTIN R0; R0 = fdb; ! Setup the FDB address register. %NAME( '.DLFNB' )(); ! Delete the file which has been opened. IF .fdb[F$ERR] NEQ IS$SUC ! Check for a file delete failure. THEN BEGIN XRSX$RSLT_FIXUP( .iob ); XRSX$IO_ERROR( .iob, .fdb[F$ERR] ); $XPO_QUIT(); END; END; ! ! Cleanup the IOB after a successful file delete. ! $XPO_ZAP_IOB( .iob ); ! Reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. 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 File Delete Processing ! !- %FI %TITLE 'RSTS/E File Delete' %IF $RSTS %THEN !+ ! ! RSTS/E File Delete Processing ! !- BEGIN ! ! 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(); ! ! Don't try deleting the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. ! ! Zero out the unused fields of the FIRQB and set up the delete subfunction. ! $XRSTS_FIRQB[FQJOB] = 0; $XRSTS_FIRQB[FQSIZM] = 0; $XRSTS_FIRQB[FQSIZ] = 0; $XRSTS_FIRQB[FQMODE] = 0; $XRSTS_FIRQB[FQPROT] = 0; $XRSTS_FIRQB[FQPFLG] = 0; $XRSTS_FIRQB[FQCLUS] = 0; $XRSTS_FIRQB[FQNENT] = 0; $XRSTS_FIRQB[FQFUN] = DLNFQ; ! ! Delete the file. ! $CALFIP; IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! Report any errors. THEN BEGIN XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; ! ! Cleanup the IOB after a successful file delete. ! $XPO_ZAP_IOB( .iob ); ! Reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of RSTS/E code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate the MAIN_BLOCK code block. !+ ! ! End of RSTS/E File Delete Processing ! !- %FI %TITLE 'RT-11 File Delete' %IF $RT11 %THEN !+ ! ! RT-11 File Delete Processing ! !- BEGIN LOCAL file_parse : $XPO_SPEC_BLOCK; ! Current file-spec parse block 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(); ! ! Verify that this is a background job. ! IF NOT XRT$CHK_BACKGRD( ) THEN $XPO_QUIT( FOREGROUND ); ! ! Build a resultant file specification from the specifications passed by the caller. ! $XPO_BUILD_SPEC( .iob ); ! ! Don't try deleting the user's terminal. ! IF .iob[IOB$V_TERMINAL] ! If this is the user's terminal, THEN ! $XPO_QUIT( BAD_DEVICE ); ! return an error code to the caller. ! ! Parse the resultant file specification into its individual components. ! $XPO_IF_NOT($XPO_PARSE_SPEC( ! Reparse the current file specification. FILE_SPEC = iob[IOB$T_RESULTANT], SPEC_BLOCK = file_parse, FAILURE = 0 ) ) THEN $XPO_QUIT( BAD_TYPE, (.$XPO_STATUS) ); ! ! Setup the RADIX-50 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 channel number, and channel_assign = yes; ! indicate that the channel has been assigned. EXITLOOP; END; END; ! ! Delete the file. ! IF NOT $DELETE( ! Perform an RT-11 DELETE: .iob[IOB$H_CHANNEL], ! channel number CH$PTR(lookup_args), 0 ) ! pointer to the address of the argument list THEN ! BEGIN ! IF .RT_ERR_EMT EQL 1 ! the error bit is set to 1 then THEN ! $XPO_QUIT( NO_FILE ) ! the file does not exist. ELSE IF .RT_ERR_EMT NEQ 0 ! If the error bit is set to 2 then THEN ! $XPO_QUIT( IO_ERROR ); ! an illegal operation occurred. ! Otherwise, the channel is in use. END ELSE EXITLOOP; ! Successful lookup - channel was not in use. END; ! End of channel loop ! ! Cleanup the IOB after a successful file delete. ! channel_assign = no; ! Indicate that the channel is no longer assigned. $XPO_ZAP_IOB( .iob ); ! Reset the IOB. $XPO_QUIT( NORMAL ); ! Return a success code to the caller. END; ! End of RT-11 code block. ! ! End of the MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate the MAIN_BLOCK code block. ! ! Return the assigned channel ! IF .channel_assign THEN BEGIN XPO$CHANNELS[.iob[IOB$H_CHANNEL]] = no; iob[IOB$H_CHANNEL] = 0; END; !+ ! ! End of RT-11 File Delete Processing ! !- %FI %TITLE 'XPO$DELETE Routine Termination' !+ ! ! Continuation of system-independent file delete processing ! !- ! ! Call an appropriate action routine. ! $XPO_ACTION_RTN( .iob ); ! Call a success or failure action routine. ! ! Cleanup the IOB after a file delete failure. ! IF NOT .iob[IOB$G_COMP_CODE] 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$DELETE routine END ELUDOM