                                XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 1
                                                                19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    0	      1 MODULE XDELET (	IDENT = 'V1.1-25'		%TITLE 'XPO$DELETE - XPORT File Delete'
    0	      2 		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
    0	      3 		%BLISS36( ,ENTRY( XPO$DELETE ),OTS='' )
    0	      4 		) =
    0	      5 BEGIN
    1	      6 
    1	      7 !
    1	      8 !			  COPYRIGHT (c) 1982 BY
    1	      9 !	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
    1	     10 !
    1	     11 ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
    1	     12 ! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
    1	     13 ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
    1	     14 ! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
    1	     15 ! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
    1	     16 ! TRANSFERRED.
    1	     17 !
    1	     18 ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
    1	     19 ! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
    1	     20 ! CORPORATION.
    1	     21 !
    1	     22 ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
    1	     23 ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
    1	     24 !
    1	     25 
    1	     26 !++
    1	     27 !
    1	     28 ! FACILITY:  BLISS Library
    1	     29 !
    1	     30 ! ABSTRACT:
    1	     31 !
    1	     32 !	This module is the XPORT file delete module.
    1	     33 !
    1	     34 ! ENVIRONMENT:  User mode - multiple host operating/file systems
    1	     35 !
    1	     36 ! AUTHORS:  Ward Clark,			CREATION DATE:  22 February 1979
    1	     37 !	    Linda Duffell
    1	     38 !
    1	     39 !--

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 2
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    1	     41 !
    1	     42 ! TABLE OF CONTENTS:
    1	     43 !
    1	     44 
    1	     45 FORWARD ROUTINE
    1	     46     XPO$DELETE;						! XPORT file delete routine
    1	     47 
    1	     48 !
    1	     49 ! INCLUDE FILES:
    1	     50 !
    1	     51 
    1	     52 LIBRARY  'XPORT' ;					! Public XPORT control block and macro definitions
    1	     54 LIBRARY  'XPOSYS' ;					! Internal XPORT macro definitions
    1	     56 
    1	     57     $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11 )
		; %PRINT:		This module was compiled for VAX/VMS
		; %PRINT:		XPORT V1.3-51    XPOSYS V1.3-16    XPO$K_VERSION = 1    XPO$K_LEVEL = 3
    1	     58 
    1	     59 %IF $TOPS10 %THEN
U   1	     60 REQUIRE  'XT10' ;					! TOPS-10 I/O interface macros
U   1	     61 %FI
    1	     62 
    1	     63 %IF $TOPS20 %THEN
U   1	     64 REQUIRE  'XT20' ;					! TOPS-20 I/O interface macros
U   1	     65 %FI
    1	     66 
    1	     67 %IF $VMS %THEN
    1	     68 REQUIRE  'XVMS' ;					! XPORT-specific VAX/VMS interface definitions
    1	     98 %FI
    1	     99 
    1	    100 %IF $11M %THEN
U   1	    101 REQUIRE  'XRSX' ;					! XPORT-specific RSX-11 and FCS interface definitions
U   1	    102 %FI
    1	    103 
    1	    104 %IF $RSTS %THEN
U   1	    105 REQUIRE  'XRSTS' ;					! RSTS/E system interface definitions
U   1	    106 %FI
    1	    107 
    1	    108 %IF $RT11 %THEN
U   1	    109 REQUIRE  'XRT11' ;					! RT-11 system interface definitions
U   1	    110 %FI
    1	    111 
    1	    112 !
    1	    113 ! MACROS:
    1	    114 !
    1	    115 
    1	    116 !
    1	    117 ! EQUATED SYMBOLS:
    1	    118 !
    1	    119 
    1	    120 LITERAL
    1	    121     yes = 1,						! Used to turn an indicator on
    1	    122     no = 0;						! Used to turn an indicator off
    1	    123 
    1	    124 %IF $VMS %THEN
    1	    125 LITERAL
    1	    126     max_file_spec = 255;				! Maximum length of a file specification

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 3
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    1	    127 %FI
    1	    128 
    1	    129 !
    1	    130 ! PSECT DECLARATIONS:
    1	    131 !
    1	    132 
    1	    133     $XPO_PSECTS						! Declare XPORT PSECT names and attributes
    1	    134 
    1	    135 !
    1	    136 ! OWN STORAGE:
    1	    137 !
    1	    138 
    1	    139 !
    1	    140 ! EXTERNAL REFERENCES:
    1	    141 !
    1	    142 
    1	    143 %IF $TOPS10 %THEN
U   1	    144 EXTERNAL ROUTINE
U   1	    145     X10$CHAN_ASSIGN,					! Channel assignment routine
U   1	    146     X10$ASCII_6BIT,					! ASCII-to-sixbit conversion routine
U   1	    147     X10$ENTER_LOOKUP,					! Setup routine for the ENTER/LOOKUP block
U   1	    148     X10$CLEANUP;					! TOPS10 control block cleanup routine
U   1	    149 %FI
    1	    150 
    1	    151 %IF $TOPS20 %THEN
U   1	    152 EXTERNAL ROUTINE
U   1	    153     X20$ERROR :  NOVALUE;				! TOPS-20 to XPORT completion code conversion routine
U   1	    154 %FI
    1	    155 
    1	    156 %IF $VMS %THEN
    1	    157 EXTERNAL ROUTINE
    1	    158     XPO$RMS_PARSE,					! RMS file specification resultion routine
    1	    159     XPO$RMS_ERROR :  NOVALUE;				! RMS-to-XPORT completion code conversion routine
    1	    160 %FI
    1	    161 
    1	    162 %IF $11M %THEN
U   1	    163 EXTERNAL
U   1	    164     XRSX$EVENT_FLAG;					! XPORT QIO/FCS event flag number
U   1	    165 
U   1	    166 EXTERNAL ROUTINE
U   1	    167     XRSX$SPEC_SETUP,					! File-spec setup and LUN assignment routine
U   1	    168     XRSX$DSPT_SETUP :  NOVALUE,				! FCS DSPT setup routine
U   1	    169     XRSX$XOPEN,						! XPORT/FCS file open routine
U   1	    170     XRSX$RSLT_FIXUP,					! Resultant file-spec fixup routine
U   1	    171     XRSX$IO_ERROR :  NOVALUE,				! FCS-to-XPORT completion code conversion routine
U   1	    172     XRSX$CLEANUP;					! QIO/FCS cleanup routine
U   1	    173 %FI
    1	    174 
    1	    175 %IF $RSTS %THEN
U   1	    176 EXTERNAL ROUTINE
U   1	    177     XRST$SPEC_SETUP,					! File-spec setup routine
U   1	    178     XRST$ERROR :  NOVALUE;				! RSTS-to-XPORT completion code conversion routine
U   1	    179 %FI
    1	    180 
    1	    181 %IF $RT11 %THEN
U   1	    182 EXTERNAL
U   1	    183     XPO$CHANNELS :  BITVECTOR[];			! Channel assignment vector in XPO$OPEN

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 4
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   1	    184 
U   1	    185 EXTERNAL LITERAL
U   1	    186     XPO$K_MAX_CHAN;					! Maximum I/O channel number
U   1	    187 
U   1	    188 EXTERNAL ROUTINE
U   1	    189     XRT$ASCII_RAD50 :  NOVALUE,				! ASCII to RADIX-50 conversion routine
U   1	    190     XRT$CHK_BACKGRD,					! Background job verification
U   1	    191     XRT$FETCH;						! Fetch handler routine
U   1	    192 %FI

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 5
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    1	    194 GLOBAL ROUTINE XPO$DELETE ( iob, success_action, failure_action ) =
    1	    195 
    1	    196 !++
    1	    197 !
    1	    198 ! FUNCTIONAL DESCRIPTION:
    1	    199 !
    1	    200 !	This routine is the XPORT file delete routine.
    1	    201 !
    1	    202 ! FORMAL PARAMETERS:
    1	    203 !
    1	    204 !	iob - address of IOB
    1	    205 !	success_action - address of success action routine
    1	    206 !	failure_action - address of failure action routine
    1	    207 !
    1	    208 ! IMPLICIT INPUTS:
    1	    209 !
    1	    210 !	Information contained in or pointed to by the caller's IOB
    1	    211 !
    1	    212 ! IMPLICIT OUTPUTS:
    1	    213 !
    1	    214 !	Various fields in the caller's IOB are updated to reflect
    1	    215 !	the results of the file delete function
    1	    216 !
    1	    217 ! COMPLETION CODES:  (also returned in IOB$G_COMP_CODE)
    1	    218 !
    1	    219 !	XPO$_NORMAL - the file was successfully deleted
    1	    220 !
    1	    221 !	XPO$_BAD_DEVICE - invalid device specified (TOPS-10, 11M, RSTS, RT11)
    1	    222 !	XPO$_BAD_IO_OPT - invalid I/O option (REMEMBER)
    1	    223 !	XPO$_BAD_IOB - the IOB is invalid
    1	    224 !		( IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid IOB length )
    1	    225 !	XPO$_BAD_LOGIC - FAB or RAB already exists (VMS, 11M)
    1	    226 !	XPO$_BAD_RSLT - Invalid resultant file specification (VMS)
    1	    227 !		( IOB$G_2ND_CODE =$STR_CPY completion code )
    1	    228 !	XPO$_BAD_SPEC - invalid  file specification
    1	    229 !		( IOB$G_2ND_CODE = XPO$_NO_CONCAT - concatenated file-spec not allowed
    1	    230 !				    XPO$_BAD_LENGTH - invalid length (TOPS-20) )
    1	    231 !	XPO$_BAD_TYPE - invalid file type (TOPS-10, RT-11)
    1	    232 !		( IOB$G_2ND_CODE = $XPO_PARSE_SPEC completion code )
    1	    233 !	XPO$_FOREGROUND - this is a foreground job (RT-11)
    1	    234 !	XPO$_FREE_MEM - error deallocating IOB-related memory
    1	    235 !		(IOB$G_2ND_CODE = $XPO_FREE_MEM completion code)
    1	    236 !	XPO$_GET_MEM - insufficient core for RMS control blocks (VMS)
    1	    237 !		( IOB$G_2ND_CODE = $XPO_GET_MEM completion code )
    1	    238 !	XPO$_IO_ERROR - I/O error (RT-11)
    1	    239 !	XPO$_NO_CHANNEL - no I/O channel is available (TOPS-10, RT-11)
    1	    240 !	XPO$_NO_FILE - file not found (RT-11)
    1	    241 !	XPO$_OPEN - the file is currently open
    1	    242 !	failure completion codes from $XPO_VALID_IOB
    1	    243 !	failure completion codes from $XPO_BUILD_SPEC (TOPS-10, TOPS-20, RT-11)
    1	    244 !	failure completion code from $T10_ERROR (TOPS-10)
    1	    245 !	failure completion codes from X20$ERROR (TOPS-20)
    1	    246 !	failure completion codes from XPO$RMS_PARSE (VMS)
    1	    247 !	failure completion codes from XPO$RMS_CLEANUP (VMS)
    1	    248 !	failure completion codes from XPO$RMS_ERROR (VMS)
    1	    249 !	failure completion codes from XRSX$SPEC_SETUP (11M)
    1	    250 !	failure completion codes from XRSX$IO_ERROR (11M)

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 6
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    1	    251 !	failure completion codes from XRSX$CLEANUP (11M)
    1	    252 !	failure completion codes from XRST$SPEC_SETUP (RSTS)
    1	    253 !	failure completion codes from XRST$ERROR (RSTS)
    1	    254 !	failure completion codes from XRT$FETCH (RT-11)
    1	    255 !
    1	    256 ! SIDE EFFECTS:
    1	    257 !
    1	    258 !	None
    1	    259 !
    1	    260 !--
    1	    261 
    1	    262     BEGIN
    2	    263 
    2	    264     MAP
    2	    265 	iob :  REF $XPO_IOB();				! Redefine the IOB parameter
    2	    266 
    2	    267 %IF $TOPS20 OR $RT11 %THEN
U   2	    268     LOCAL
U   2	    269 	channel_assign;					! Channel assignment indicator
U   2	    270 %FI
    2	    271 
    2	    272 %IF $TOPS10 OR $TOPS20 %THEN
U   2	    273     LOCAL
U   2	    274 	channel_open;					! Channel open indicator
U   2	    275 %FI
    2	    276 
    2	    277 %IF $RT11 %THEN
U   2	    278     LOCAL
U   2	    279 	lookup_args :  $XRT_LOOK_ARGS;			! RT-11 LOOKUP argument list
U   2	    280 %FI
    2	    281 
    2	    282 !
    2	    283 ! XPORT routine initialization.
    2	    284 !
    2	    285 
    2	    286     $XPO_MAIN_BEGIN( IO, FIXUP_IOB )			! Define the MAIN_BLOCK code block
    3	    287 							! and validate the caller's IOB.
    3	    288 
    3	    289 %IF $TOPS20 OR $RT11 %THEN
U   3	    290     channel_assign = no;				! Start out with no channel assigned
U   3	    291 %FI
    3	    292 
    3	    293 %IF $TOPS10 OR $TOPS20 %THEN
U   3	    294     channel_open = no;					! or opened.
U   3	    295 %FI
    3	    296 
    3	    297 !
    3	    298 ! Establish IOB defaults.
    3	    299 !
    3	    300 
    3	    301     $XPO_VALID_IOB( .iob );				! Validate or default caller's file-spec and prompt string.
    3	    302 
    3	    303 !
    3	    304 ! Check the IOB for invalid or conflicting information.
    3	    305 !
    3	    306 							! Return an error code if the IOB is invalid
    3	    307 							! for one of the following reasons:

XDELET                          XPO$DELETE - XPORT File Delete   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 7
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    3	    308 
    3	    309     IF .iob[IOB$V_OPEN]					!    the file is already open
    3	    310     THEN
    3	    311 	$XPO_QUIT( OPEN );
    3	    312 
    3	    313     IF $STR_SCAN( STRING = .iob[IOB$A_FILE_SPEC],	!    a concatenated file-spec was specified
P   3	    314 		    FIND = '+',
P   3	    315 		    FAILURE = 0 )
    4	    316     THEN
    3	    317 	$XPO_QUIT( BAD_SPEC, NO_CONCAT );
    3	    318 
    3	    319     IF .iob[IOB$V_REMEMBER]				!    OPTION=REMEMBER was specified
    3	    320     THEN
    3	    321 	$XPO_QUIT( BAD_IO_OPT );
    3	    322 
    3	    323 !+
    3	    324 !
    3	    325 !	System-specific file delete processing follows.
    3	    326 !
    3	    327 !-

XDELET                          TOPS-10 File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 8
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    3	    329 %TITLE 'TOPS-10 File Delete'
    3	    330 %IF $TOPS10 %THEN
U   3	    331 
U   3	    332 !+
U   3	    333 !
U   3	    334 !	TOPS-10 File Delete Processing
U   3	    335 !
U   3	    336 !	NOTE: The following code is very similar to the code in
U   3	    337 !	      XPO$RENAME since TOPS-10 file delete is a special
U   3	    338 !	      form of file rename.
U   3	    339 !
U   3	    340 !-
U   3	    341 
U   3	    342     BEGIN
U   3	    343 
U   3	    344     LOCAL
U   3	    345 	file_parse :  $XPO_SPEC_BLOCK,			! Current file-spec parse block
U   3	    346 	open_args :  $T10_OPEN_ARGS,			! TOPS-10 OPEN argument list
U   3	    347 	lookup_args :  $T10_LOOK_ARGS;			! TOPS-10 LOOKUP argument list
U   3	    348 
U   3	    349     BIND						! Redefine several spec-block fields.
U   3	    350 	device = file_parse[XPO$T_DEVICE] :  $STR_DESCRIPTOR();
U   3	    351 
U   3	    352 !
U   3	    353 ! Build a resultant file specification from the specifications passed by the caller.
U   3	    354 !
U   3	    355 
U   3	    356     $XPO_BUILD_SPEC( .iob );
U   3	    357 
U   3	    358 !
U   3	    359 ! Don't try deleting the user's terminal.
U   3	    360 !
U   3	    361 
U   3	    362     IF .iob[IOB$V_TERMINAL]				! If this is the user's terminal,
U   3	    363     THEN						!
U   3	    364 	$XPO_QUIT( BAD_DEVICE );			! return an error code to the caller.
U   3	    365 
U   3	    366 !
U   3	    367 ! Parse the resultant file specification into its individual components.
U   3	    368 !
U   3	    369 
U   3	    370     $XPO_IF_NOT($XPO_PARSE_SPEC(			! Reparse the current file specification.
U   3	    371 		    FILE_SPEC = iob[IOB$T_RESULTANT],
U   3	    372 		    SPEC_BLOCK = file_parse,
U   3	    373 		    FAILURE = 0 ) )
U   3	    374     THEN
U   3	    375 	$XPO_QUIT( BAD_TYPE, (.$XPO_STATUS) );
U   3	    376 
U   3	    377 !
U   3	    378 ! Assign a TOPS-10 I/O channel to this file.
U   3	    379 !
U   3	    380 
U   3	    381     IF NOT X10$CHAN_ASSIGN( .iob )
U   3	    382     THEN
U   3	    383     	$XPO_QUIT();
U   3	    384 
U   3	    385 !

XDELET                          TOPS-10 File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 9
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   3	    386 ! Setup the OPEN argument list.
U   3	    387 !
U   3	    388 
U   3	    389     INCR index FROM 0 TO OPEN$K_ARG_LEN-1 DO		! Zero the open argument list.
U   3	    390 	open_args[.index,0,%BPVAL,0] = 0;
U   3	    391 
U   3	    392     open_args[OPEN$T_DEVICE] =				! Convert the device name to 6-bit and put it
U   3	    393 	    X10$ASCII_6BIT(				! in the argument list.
U   3	    394 		.device[STR$H_LENGTH] - 1,
U   3	    395 		.device[STR$A_POINTER] );
U   3	    396 
U   3	    397 !
U   3	    398 ! Open the assigned channel.
U   3	    399 !
U   3	    400 
U   3	    401     IF $T10_OPEN( .iob[IOB$H_CHANNEL], open_args )	! If the assigned channel can be opened,
U   3	    402     THEN						!
U   3	    403 	channel_open = yes				! indicate that a channel has been opened.
U   3	    404     ELSE
U   3	    405 	$XPO_QUIT( BAD_DEVICE );			! Otherwise, return an error code to the caller.
U   3	    406 
U   3	    407 !
U   3	    408 ! Perform a LOOKUP monitor call.
U   3	    409 !
U   3	    410 
U   3	    411     IF NOT X10$ENTER_LOOKUP( .iob, file_parse, lookup_args )	! Setup the LOOKUP argument block.
U   3	    412     THEN
U   3	    413         $XPO_QUIT();
U   3	    414 
U   3	    415     IF NOT $T10_LOOKUP(					! Perform a TOPS-10 LOOKUP:
U   3	    416 		.iob[IOB$H_CHANNEL],			!    channel number
U   3	    417 		lookup_args )				!    address of argument list
U   3	    418 
U   3	    419     THEN						! If the LOOKUP fails,
U   3	    420 	$T10_ERROR( .lookup_args[LOOK$H_STATUS],	! return error codes to the caller.
U   3	    421 			NO_FILE );
U   3	    422 
U   3	    423 !
U   3	    424 ! Perform a special RENAME monitor call to delete the file.
U   3	    425 !
U   3	    426 
U   3	    427     lookup_args[LOOK$T_NAME] = 0;			! Clear the file name and file type to indicate a delete.
U   3	    428     lookup_args[LOOK$T_EXT] = 0;
U   3	    429 
U   3	    430     IF NOT $T10_RENAME(					! Perform a TOPS-10 RENAME:
U   3	    431 		.iob[IOB$H_CHANNEL],			!    channel number
U   3	    432 		lookup_args )				!    address of argument list
U   3	    433 
U   3	    434     THEN						! If the RENAME fails,
U   3	    435 	$T10_ERROR( .lookup_args[LOOK$H_STATUS],	! return error codes to the caller.
U   3	    436 			NO_DELETE );
U   3	    437 
U   3	    438 !
U   3	    439 ! Cleanup the IOB after a successful file delete.
U   3	    440 !
U   3	    441 
U   3	    442     IF .channel_open					! If a channel has been opened,

XDELET                          TOPS-10 File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 10
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   3	    443     THEN						!
U   3	    444 	BEGIN						!
U   3	    445 	$T10_CLOSE( .iob[IOB$H_CHANNEL] );		! close the assigned channel
U   3	    446 	$T10_RELEASE( .iob[IOB$H_CHANNEL] );		! and release the channel assignment.
U   3	    447 	channel_open = no;				! Indicate that the channel is no longer open.
U   3	    448 	END;
U   3	    449 
U   3	    450     $XPO_ZAP_IOB( .iob );				! Reset the IOB.
U   3	    451 
U   3	    452     $XPO_QUIT( NORMAL );				! Return a success code to the caller.
U   3	    453 
U   3	    454     END;						! End of TOPS-10 code block.
U   3	    455 
U   3	    456 !
U   3	    457 ! End of the MAIN_BLOCK code block.
U   3	    458 !
U   3	    459 
U   3	    460     $XPO_MAIN_END;					! Terminate the MAIN_BLOCK code block.
U   3	    461 
U   3	    462 !
U   3	    463 ! Close and release the assigned I/O channel.
U   3	    464 !
U   3	    465 
U   3	    466     IF .channel_open					! If a channel has been opened,
U   3	    467     THEN						!
U   3	    468 	BEGIN						!
U   3	    469 	$T10_CLOSE( .iob[IOB$H_CHANNEL] );		! close the assigned channel
U   3	    470 	$T10_RELEASE( .iob[IOB$H_CHANNEL] );		! and release the channel assignment.
U   3	    471 	END;
U   3	    472 
U   3	    473 !+
U   3	    474 !
U   3	    475 !	End of TOPS-10 File Delete Processing
U   3	    476 !
U   3	    477 !-
U   3	    478 %FI

XDELET                          TOPS-20 File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 11
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    3	    480 %TITLE 'TOPS-20 File Delete'
    3	    481 %IF $TOPS20 %THEN
U   3	    482 
U   3	    483 !+
U   3	    484 !
U   3	    485 !	TOPS-20 File Delete Processing
U   3	    486 !
U   3	    487 !-
U   3	    488 
U   3	    489     BEGIN
U   3	    490 
U   3	    491     BIND
U   3	    492 	resultant = iob[IOB$T_RESULTANT] :  $STR_DESCRIPTOR();
U   3	    493 
U   3	    494     LOCAL
U   3	    495 	resultant_spec :  VECTOR[CH$ALLOCATION(X20$K_MAX_SPEC)],
U   3	    496   	jfn_or_error;					! Storage area for JFN or error code.
U   3	    497 
U   3	    498 !
U   3	    499 ! Build a resultant file specification from the specifications passed by the caller.
U   3	    500 !
U   3	    501 
U   3	    502     $XPO_BUILD_SPEC( .iob );
U   3	    503 
U   3	    504     IF NOT $X20_ASCIZ( resultant, resultant_spec )	! Store the file-spec in resultant_spec and make it ASCIZ.
U   3	    505     THEN
U   3	    506 	$XPO_QUIT( BAD_SPEC, BAD_LENGTH );		! Return an error code if the file-spec is too long.
U   3	    507 
U   3	    508 !
U   3	    509 ! Associate the file with a JFN.
U   3	    510 !
U   3	    511 
U   3	    512     IF NOT $T20_GTJFN( GJ_SHT OR GJ_OLD,		! Use short form to associate an existing file with a JFN.
U   3	    513 			 CH$PTR( resultant_spec ),	! Pointer to the file-spec
U   3	    514 			jfn_or_error )			! JFN or error code is returned here.
U   3	    515     THEN
U   3	    516 	BEGIN
U   3	    517 	X20$ERROR( .iob, .jfn_or_error );
U   3	    518 	$XPO_QUIT();
U   3	    519 	END;
U   3	    520 
U   3	    521     channel_assign = yes;				! Indicate JFN has been assigned.
U   3	    522 
U   3	    523     iob[IOB$H_CHANNEL] = .jfn_or_error;			! Save the JFN.
U   3	    524 
U   3	    525 !
U   3	    526 ! Delete the file.
U   3	    527 !
U   3	    528 
U   3	    529     IF NOT $T20_DELF(					! Delete the file:
U   3	    530 		      .iob[IOB$H_CHANNEL],		!    JFN
U   3	    531 		      jfn_or_error )			!    storage area for any error condition
U   3	    532     THEN
U   3	    533 	BEGIN
U   3	    534 	X20$ERROR( .iob, .jfn_or_error );
U   3	    535 	$XPO_QUIT();
U   3	    536 	END;

XDELET                          TOPS-20 File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 12
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   3	    537 
U   3	    538 !
U   3	    539 ! Cleanup the IOB after a successful file delete.
U   3	    540 !
U   3	    541 
U   3	    542     channel_assign = no;				! Indicate that the JFN is no longer assigned.
U   3	    543 
U   3	    544     $XPO_ZAP_IOB( .iob );				! Reset the IOB.
U   3	    545 
U   3	    546     $XPO_QUIT( NORMAL );				! Return a success code to the caller.
U   3	    547 
U   3	    548     END;						! End of TOPS-20 code block.
U   3	    549 
U   3	    550 !
U   3	    551 ! End of the MAIN_BLOCK code block.
U   3	    552 !
U   3	    553 
U   3	    554     $XPO_MAIN_END;					! Terminate the MAIN_BLOCK code block.
U   3	    555 
U   3	    556 !
U   3	    557 ! Release the JFN.
U   3	    558 !
U   3	    559 
U   3	    560     IF .channel_assign					! If a JFN has been assigned
U   3	    561     THEN						!
U   3	    562 	BEGIN						!
U   3	    563 	$T20_RLJFN( .iob[IOB$H_CHANNEL] );		! release the JFN,
U   3	    564 	iob[IOB$H_CHANNEL] = 0;				! and zero the IOB channel field.
U   3	    565 	END;
U   3	    566 
U   3	    567 !+
U   3	    568 !
U   3	    569 !	End of TOPS-20 File Delete Processing
U   3	    570 !
U   3	    571 !-
U   3	    572 
U   3	    573 %FI

XDELET                          VAX/VMS File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 13
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    3	    575 %TITLE 'VAX/VMS File Delete'
    3	    576 %IF $VMS %THEN
    3	    577 
    3	    578 !+
    3	    579 !
    3	    580 !	VAX/VMS File Delete Processing
    3	    581 !
    3	    582 !-
    3	    583 
    3	    584     BEGIN
    4	    585 
    4	    586     LOCAL
    4	    587 	fab :  REF $FAB_DECL,				! Address of RMS FAB
    4	    588 	name_block :  REF $NAM_DECL,			! Address of RMS Name Block
    4	    589 	resultant_spec :				! Space for a resultant file-spec
    4	    590 	    VECTOR[ CH$ALLOCATION(max_file_spec) ];
    4	    591 
    4	    592 !
    4	    593 ! Make sure that no FAB or RAB already exists.
    4	    594 !
    4	    595 
    4	    596     IF .iob[IOB$A_RMS_FAB] NEQ 0 OR			! If a FAB already exists
    4	    597 	.iob[IOB$A_RMS_RAB] NEQ 0			! or a RAB already exists,
    4	    598     THEN						!
    4	    599 	$XPO_QUIT( BAD_LOGIC );				! return an error code to the caller.
    4	    600 
    4	    601 !
    4	    602 ! Create an RMS File Access Block (FAB).
    4	    603 !
    4	    604 
    4	    605     $XPO_IF_NOT( $XPO_GET_MEM( UNITS = FAB$C_BLN,	! Get dynamic memory for a FAB.
P   4	    606 				RESULT = fab,
P   4	    607 				FAILURE = 0 ) )
    6	    608     THEN
    5	    609 	$XPO_QUIT( GET_MEM, (.$XPO_STATUS) );
    4	    610 
    4	    611     iob[IOB$A_RMS_FAB] = .fab;				! Save the address of the FAB.
    4	    612 
    4	    613     $FAB_INIT( FAB = .fab );				! Initialize the FAB.
    4	    614 
    4	    615 !
    4	    616 ! Use RMS PARSE to perform file specification resolution.
    4	    617 !
    4	    618 
    4	    619     IF NOT XPO$RMS_PARSE( .iob )			! Perform file-spec resolution.
    4	    620     THEN
    4	    621 	$XPO_QUIT();
    4	    622 
    4	    623     name_block = .fab[FAB$L_NAM];			! Update the Name Block built by XPO$RMS_PARSE:
    4	    624     name_block[NAM$B_RSS] = max_file_spec;		!    length of resultant file-spec buffer
    4	    625     name_block[NAM$L_RSA] = resultant_spec;		!    pointer to the resultant file-spec buffer
    4	    626 
    4	    627 !
    4	    628 ! Use RMS ERASE to delete the file.
    4	    629 !
    4	    630 
    4	    631     $RMS_ERASE( FAB = .fab );				! Delete the file.

XDELET                          VAX/VMS File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 14
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    4	    632 
    4	    633 !
    4	    634 ! Save the resultant file specification.
    4	    635 !
    4	    636 
    4	    637     IF .name_block[NAM$B_RSL] NEQ 0			! If a resultant file-spec was created by RMS,
    4	    638     THEN						!
    4	    639 	BEGIN						!
    5	    640 	$XPO_IF_NOT( $STR_COPY(				! copy the file-spec into dynamic memory.
P   5	    641 		    STRING = (.name_block[NAM$B_RSL],
P   5	    642 				.name_block[NAM$L_RSA]),
P   5	    643 		    TARGET = iob[IOB$T_RESULTANT],
P   5	    644 		    FAILURE = 0 ) )
    7	    645 	THEN
    6	    646 	    $XPO_QUIT( BAD_RSLT, (.$XPO_STATUS) );
    5	    647 
    5	    648 	name_block[NAM$L_RSA] =				! Then have the Name Block point to the copied file-spec.
    5	    649 	    .iob[$SUB_FIELD(IOB$T_RESULTANT,STR$A_POINTER)];
    5	    650 	END;
    4	    651 
    4	    652     name_block[NAM$B_RSS] = 0;				! Zero the resultant file-spec buffer length for safety sake
    4	    652 .
    4	    653 
    4	    654 !
    4	    655 ! Check for a file delete failure.
    4	    656 !
    4	    657 
    4	    658     IF NOT .fab[FAB$L_STS]				! If file deletion failed,
    4	    659     THEN						!
    4	    660 	BEGIN						!
    5	    661 	XPO$RMS_ERROR( .iob, .fab[FAB$L_STS],		! convert the RMS completion codes into
    5	    662 			.fab[FAB$L_STV] );		! equivalent XPORT completion codes
    5	    663 	$XPO_QUIT();					! and then jump to return to the caller.
    5	    664 	END;
    4	    665 
    4	    666 !
    4	    667 ! Cleanup the IOB after a successful file delete.
    4	    668 !
    4	    669 
    4	    670     $XPO_ZAP_IOB( .iob );				! Free the RMS control blocks and reset the IOB.
    4	    671 
    4	    672     $XPO_QUIT( NORMAL );				! Return a success code to the caller.
    4	    673 
    4	    674     END;						! End of VMS code block.
    3	    675 
    3	    676 !
    3	    677 ! End of the MAIN_BLOCK code block.
    3	    678 !
    3	    679 
    3	    680     $XPO_MAIN_END;
    2	    681 
    2	    682 %FI

XDELET                          RSX-11M File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 15
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    2	    684 %TITLE 'RSX-11M File Delete'
    2	    685 %IF $11M %THEN
U   2	    686 
U   2	    687 !+
U   2	    688 !
U   2	    689 !	RSX-11M File Delete Processing
U   2	    690 !
U   2	    691 !-
U   2	    692 
U   2	    693     BEGIN
U   2	    694     LOCAL
U   2	    695 	spec_parse :  $XPO_SPEC_BLOCK;		! Resultant file-spec parse block
U   2	    696 
U   2	    697 !
U   2	    698 ! Make sure that no QIO/FCS information already exists.
U   2	    699 !
U   2	    700 
U   2	    701     IF .iob[IOB$H_CHANNEL] NEQ 0 OR		! If a LUN has been assigned
U   2	    702 	.iob[IOB$A_FCS_FDB] NEQ 0		! or XPORT's FCS blocks have been allocated,
U   2	    703     THEN					!
U   2	    704 	$XPO_QUIT( BAD_LOGIC );			! return an error code to the caller.
U   2	    705 
U   2	    706 !
U   2	    707 ! Build a resultant file specification from the specifications passed by the caller
U   2	    708 ! and assign an RSX-11M Logical Unit Number (LUN) to this file.
U   2	    709 !
U   2	    710 
U   2	    711     IF NOT XRSX$SPEC_SETUP( .iob, spec_parse )
U   2	    712     THEN
U   2	    713 	$XPO_QUIT();
U   2	    714 
U   2	    715 !
U   2	    716 ! Don't try deleting the user's terminal.
U   2	    717 !
U   2	    718 
U   2	    719     IF .iob[IOB$V_TERMINAL]			! If this is the user's terminal,
U   2	    720     THEN					!
U   2	    721 	$XPO_QUIT( BAD_DEVICE );		! return an error code to the caller.
U   2	    722 
U   2	    723 !
U   2	    724 ! Allocate an XPORT set of FCS control blocks.
U   2	    725 !
U   2	    726 
U   2	    727     $XPO_IF_NOT( $XPO_GET_MEM( FULLWORDS = FCS$K_BLK_LEN,
U   2	    728 				RESULT = iob[IOB$A_FCS_FDB],
U   2	    729 				FILL = 0,
U   2	    730 				FAILURE = 0 ) )
U   2	    731     THEN
U   2	    732 	$XPO_QUIT( GET_MEM, (.$XPO_STATUS) );
U   2	    733 
U   2	    734     BEGIN
U   2	    735     BIND					! Redeclare each FCS control block
U   2	    736 	fcs_blocks = .iob[IOB$A_FCS_FDB] :  $FCS_BLOCKS,
U   2	    737 	fdb = fcs_blocks[FCS$Z_FDB] :  FDB$;
U   2	    738 
U   2	    739 !
U   2	    740 ! Setup the FCS File Descriptor Block (FDB).

XDELET                          RSX-11M File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 16
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   2	    741 !
U   2	    742 
U   2	    743 						! Setup all common FDB fields:
U   2	    744     fdb[F$LUN] = .iob[IOB$H_CHANNEL];		!    logical unit number (LUN)
U   2	    745     fdb[F$DSPT] = fcs_blocks[FCS$Z_DS_DESC];	!    address of FCS dataset descriptor
U   2	    746     fdb[F$EFN] = .XRSX$EVENT_FLAG;		!    event flag number
U   2	    747 
U   2	    748 !
U   2	    749 ! Setup the FCS Dataset Descriptor (DSPT).
U   2	    750 !
U   2	    751 
U   2	    752     XRSX$DSPT_SETUP( fcs_blocks[FCS$Z_DS_DESC], spec_parse );
U   2	    753 
U   2	    754 !
U   2	    755 ! Open the file.
U   2	    756 !
U   2	    757 
U   2	    758     IF NOT XRSX$XOPEN( .iob )				! Open the specified file.
U   2	    759     THEN
U   2	    760         BEGIN
U   2	    761 	XRSX$RSLT_FIXUP( .iob );
U   2	    762         XRSX$IO_ERROR( .iob, .fdb[F$ERR] );
U   2	    763         $XPO_QUIT();
U   2	    764         END;
U   2	    765 
U   2	    766 !
U   2	    767 ! Delete the file.
U   2	    768 !
U   2	    769 
U   2	    770     BEGIN
U   2	    771     EXTERNAL ROUTINE %NAME( '.DLFNB' );
U   2	    772     BUILTIN R0;
U   2	    773 
U   2	    774     R0 = fdb;					! Setup the FDB address register.
U   2	    775 
U   2	    776     %NAME( '.DLFNB' )();			! Delete the file which has been opened.
U   2	    777 
U   2	    778     IF .fdb[F$ERR] NEQ IS$SUC			! Check for a file delete failure.
U   2	    779     THEN
U   2	    780         BEGIN
U   2	    781 	XRSX$RSLT_FIXUP( .iob );
U   2	    782         XRSX$IO_ERROR( .iob, .fdb[F$ERR] );
U   2	    783         $XPO_QUIT();
U   2	    784         END;
U   2	    785     END;
U   2	    786 
U   2	    787 !
U   2	    788 ! Cleanup the IOB after a successful file delete.
U   2	    789 !
U   2	    790 
U   2	    791     $XPO_ZAP_IOB( .iob );				! Reset the IOB.
U   2	    792 
U   2	    793     $XPO_QUIT( NORMAL );			! Return a success code to the caller.
U   2	    794 
U   2	    795     END;					! End of "FCB block BINDs" code block
U   2	    796     END;					! End of RSX-11M code block
U   2	    797 

XDELET                          RSX-11M File Delete              4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 17
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   2	    798 !
U   2	    799 ! End of the MAIN_BLOCK code block.
U   2	    800 !
U   2	    801 
U   2	    802     $XPO_MAIN_END;				! Terminate MAIN_BLOCK.
U   2	    803 
U   2	    804 !+
U   2	    805 !
U   2	    806 !	End of RSX-11M File Delete Processing
U   2	    807 !
U   2	    808 !-
U   2	    809 
U   2	    810 %FI

XDELET                          RSTS/E File Delete               4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 18
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    2	    812 %TITLE 'RSTS/E File Delete'
    2	    813 %IF $RSTS %THEN
U   2	    814 
U   2	    815 !+
U   2	    816 !
U   2	    817 !	RSTS/E File Delete Processing
U   2	    818 !
U   2	    819 !-
U   2	    820 
U   2	    821     BEGIN
U   2	    822 
U   2	    823 !
U   2	    824 ! Build a resultant file specification from the specifications passed by the caller
U   2	    825 ! and setup the FIRQB with this information.
U   2	    826 !
U   2	    827 
U   2	    828     IF NOT XRST$SPEC_SETUP( .iob )
U   2	    829     THEN
U   2	    830     	$XPO_QUIT();
U   2	    831 
U   2	    832 !
U   2	    833 ! Don't try deleting the user's terminal.
U   2	    834 !
U   2	    835 
U   2	    836     IF .iob[IOB$V_TERMINAL]				! If this is the user's terminal,
U   2	    837     THEN						!
U   2	    838 	$XPO_QUIT( BAD_DEVICE );			! return an error code to the caller.
U   2	    839 
U   2	    840 !
U   2	    841 ! Zero out the unused fields of the FIRQB and set up the delete subfunction.
U   2	    842 !
U   2	    843 
U   2	    844     $XRSTS_FIRQB[FQJOB] = 0;
U   2	    845     $XRSTS_FIRQB[FQSIZM] = 0;
U   2	    846     $XRSTS_FIRQB[FQSIZ] = 0;
U   2	    847     $XRSTS_FIRQB[FQMODE] = 0;
U   2	    848     $XRSTS_FIRQB[FQPROT] = 0;
U   2	    849     $XRSTS_FIRQB[FQPFLG] = 0;
U   2	    850     $XRSTS_FIRQB[FQCLUS] = 0;
U   2	    851     $XRSTS_FIRQB[FQNENT] = 0;
U   2	    852 
U   2	    853     $XRSTS_FIRQB[FQFUN] = DLNFQ;
U   2	    854 !
U   2	    855 ! Delete the file.
U   2	    856 !
U   2	    857 
U   2	    858     $CALFIP;
U   2	    859 
U   2	    860     IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0				! Report any errors.
U   2	    861     THEN
U   2	    862     	BEGIN
U   2	    863     	XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] );
U   2	    864     	$XPO_QUIT();
U   2	    865     	END;
U   2	    866 
U   2	    867 !
U   2	    868 ! Cleanup the IOB after a successful file delete.

XDELET                          RSTS/E File Delete               4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 19
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   2	    869 !
U   2	    870 
U   2	    871     $XPO_ZAP_IOB( .iob );				! Reset the IOB.
U   2	    872 
U   2	    873     $XPO_QUIT( NORMAL );				! Return a success code to the caller.
U   2	    874 
U   2	    875     END;						! End of RSTS/E code block.
U   2	    876 
U   2	    877 !
U   2	    878 ! End of the MAIN_BLOCK code block.
U   2	    879 !
U   2	    880 
U   2	    881     $XPO_MAIN_END;					! Terminate the MAIN_BLOCK code block.
U   2	    882 
U   2	    883 !+
U   2	    884 !
U   2	    885 !	End of RSTS/E File Delete Processing
U   2	    886 !
U   2	    887 !-
U   2	    888 %FI

XDELET                          RT-11 File Delete                4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 20
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    2	    890 %TITLE 'RT-11 File Delete'
    2	    891 %IF $RT11 %THEN
U   2	    892 
U   2	    893 !+
U   2	    894 !
U   2	    895 !	RT-11 File Delete Processing
U   2	    896 !
U   2	    897 !-
U   2	    898 
U   2	    899     BEGIN
U   2	    900 
U   2	    901     LOCAL
U   2	    902 	file_parse :  $XPO_SPEC_BLOCK;			! Current file-spec parse block
U   2	    903 
U   2	    904     BIND						! Redefine several spec-block fields.
U   2	    905 	device = file_parse[XPO$T_DEVICE] :  $STR_DESCRIPTOR(),
U   2	    906 	file_name = file_parse[XPO$T_FILE_NAME] :  $STR_DESCRIPTOR(),
U   2	    907 	file_type = file_parse[XPO$T_FILE_TYPE] :  $STR_DESCRIPTOR();
U   2	    908 
U   2	    909 !
U   2	    910 ! Verify that this is a background job.
U   2	    911 !
U   2	    912 
U   2	    913     IF NOT XRT$CHK_BACKGRD( )
U   2	    914     THEN
U   2	    915 	$XPO_QUIT( FOREGROUND );
U   2	    916 
U   2	    917 !
U   2	    918 ! Build a resultant file specification from the specifications passed by the caller.
U   2	    919 !
U   2	    920 
U   2	    921     $XPO_BUILD_SPEC( .iob );
U   2	    922 
U   2	    923 !
U   2	    924 ! Don't try deleting the user's terminal.
U   2	    925 !
U   2	    926 
U   2	    927     IF .iob[IOB$V_TERMINAL]				! If this is the user's terminal,
U   2	    928     THEN						!
U   2	    929 	$XPO_QUIT( BAD_DEVICE );			! return an error code to the caller.
U   2	    930 
U   2	    931 !
U   2	    932 ! Parse the resultant file specification into its individual components.
U   2	    933 !
U   2	    934 
U   2	    935     $XPO_IF_NOT($XPO_PARSE_SPEC(			! Reparse the current file specification.
U   2	    936 		    FILE_SPEC = iob[IOB$T_RESULTANT],
U   2	    937 		    SPEC_BLOCK = file_parse,
U   2	    938 		    FAILURE = 0 ) )
U   2	    939     THEN
U   2	    940 	$XPO_QUIT( BAD_TYPE, (.$XPO_STATUS) );
U   2	    941 
U   2	    942 !
U   2	    943 ! Setup the RADIX-50  argument list.
U   2	    944 !
U   2	    945 
U   2	    946      INCR index FROM 0 TO LOOK$K_ARG_LEN-1 DO		! Zero the LOOKUP argument list.

XDELET                          RT-11 File Delete                4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 21
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   2	    947 	lookup_args[.index,0,%BPVAL,0] = 0;
U   2	    948 
U   2	    949 							! Fill in the LOOKUP argument list:
U   2	    950      XRT$ASCII_RAD50(					!    device name (Radix-50)
U   2	    951          .device[STR$A_POINTER],			!
U   2	    952          .device[STR$H_LENGTH] - 1,			!
U   2	    953          lookup_args[LOOK$T_DEVICE],			!
U   2	    954          1, 0 );					!
U   2	    955 							!
U   2	    956      XRT$ASCII_RAD50(					!    file name (Radix-50)
U   2	    957          .file_name[STR$A_POINTER],			!
U   2	    958          .file_name[STR$H_LENGTH],			!
U   2	    959          lookup_args[LOOK$T_NAME1],			!
U   2	    960          2, 0 );					!
U   2	    961 							!
U   2	    962      XRT$ASCII_RAD50(					!    file type (Radix-50)
U   2	    963          CH$PLUS(.file_type[STR$A_POINTER], 1),		!
U   2	    964          .file_type[STR$H_LENGTH] - 1,			!
U   2	    965          lookup_args[LOOK$T_TYPE],			!
U   2	    966          1, 0 );					!
U   2	    967 
U   2	    968 !
U   2	    969 ! Fetch the I/O handler for the specified device.
U   2	    970 !
U   2	    971 
U   2	    972      IF NOT XRT$FETCH(.iob, lookup_args[LOOK$T_DEVICE])
U   2	    973      THEN
U   2	    974 	$XPO_QUIT();
U   2	    975 
U   2	    976 !
U   2	    977 ! Assign an RT-11 I/O channel to this file.
U   2	    978 !
U   2	    979 
U   2	    980      WHILE 1 DO						! Loop until we find a free channel.
U   2	    981 
U   2	    982          BEGIN
U   2	    983          INCR channel FROM 0 TO xpo$k_max_chan+1 DO	! Search for an unused I/O channel.(i.e. unused by XPORT)
U   2	    984             BEGIN
U   2	    985 	    IF .channel GTR xpo$k_max_chan		! If all channels have been assigned,
U   2	    986 	    THEN					!
U   2	    987 	        $XPO_QUIT( NO_CHANNEL );		! return an error code to the caller.
U   2	    988 
U   2	    989 	    IF NOT .xpo$channels[.channel]		! If this channel is not assigned,
U   2	    990 	    THEN					!
U   2	    991 		BEGIN					!
U   2	    992 		XPO$CHANNELS[.channel] = yes;		! indicate that this channel is in use,
U   2	    993 		iob[IOB$H_CHANNEL] = .channel;		! save the channel number, and
U   2	    994 		channel_assign = yes;			! indicate that the channel has been assigned.
U   2	    995 	        EXITLOOP;				
U   2	    996 		END;
U   2	    997 	    END;
U   2	    998 
U   2	    999 !
U   2	   1000 ! Delete the file.
U   2	   1001 !
U   2	   1002 
U   2	   1003 	    IF NOT $DELETE(				! Perform an RT-11 DELETE:

XDELET                          RT-11 File Delete                4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 22
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

U   2	   1004 		.iob[IOB$H_CHANNEL],			!    channel number
U   2	   1005 		CH$PTR(lookup_args), 0 )		!    pointer to the address of the argument list
U   2	   1006 	    THEN					!
U   2	   1007 		BEGIN					!
U   2	   1008 		IF .RT_ERR_EMT EQL 1			! the error bit is set to 1 then
U   2	   1009 		THEN					!
U   2	   1010 		    $XPO_QUIT( NO_FILE )		! the file does not exist.
U   2	   1011 		ELSE
U   2	   1012 		    IF .RT_ERR_EMT  NEQ 0		! If the error bit is set to 2 then
U   2	   1013 		    THEN				!
U   2	   1014 		        $XPO_QUIT( IO_ERROR );		! an illegal operation occurred.
U   2	   1015 							! Otherwise, the channel is in use.
U   2	   1016 		END
U   2	   1017 	    ELSE
U   2	   1018 	        EXITLOOP;				! Successful lookup - channel was not in use.
U   2	   1019 
U   2	   1020      END;						! End of channel loop
U   2	   1021 
U   2	   1022 !
U   2	   1023 ! Cleanup the IOB after a successful file delete.
U   2	   1024 !
U   2	   1025 
U   2	   1026     channel_assign = no;				! Indicate that the channel is no longer assigned.
U   2	   1027 
U   2	   1028     $XPO_ZAP_IOB( .iob );				! Reset the IOB.
U   2	   1029 
U   2	   1030     $XPO_QUIT( NORMAL );				! Return a success code to the caller.
U   2	   1031 
U   2	   1032     END;						! End of RT-11 code block.
U   2	   1033 
U   2	   1034 !
U   2	   1035 ! End of the MAIN_BLOCK code block.
U   2	   1036 !
U   2	   1037 
U   2	   1038     $XPO_MAIN_END;					! Terminate the MAIN_BLOCK code block.
U   2	   1039 
U   2	   1040 !
U   2	   1041 ! Return the assigned channel
U   2	   1042 !
U   2	   1043 
U   2	   1044     IF .channel_assign
U   2	   1045     THEN
U   2	   1046 	BEGIN
U   2	   1047 	XPO$CHANNELS[.iob[IOB$H_CHANNEL]] = no;		
U   2	   1048 	iob[IOB$H_CHANNEL] = 0;
U   2	   1049 	END;
U   2	   1050 
U   2	   1051 !+
U   2	   1052 !
U   2	   1053 !	End of RT-11 File Delete Processing
U   2	   1054 !
U   2	   1055 !-
U   2	   1056 %FI

XDELET                          XPO$DELETE Routine Termination   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 23
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

    2	   1058 %TITLE 'XPO$DELETE Routine Termination'
    2	   1059 
    2	   1060 !+
    2	   1061 !
    2	   1062 !	Continuation of system-independent file delete processing
    2	   1063 !
    2	   1064 !-
    2	   1065 
    2	   1066 !
    2	   1067 ! Call an appropriate action routine.
    2	   1068 !
    2	   1069 
    2	   1070     $XPO_ACTION_RTN( .iob );				! Call a success or failure action routine.
    2	   1071 
    2	   1072 !
    2	   1073 ! Cleanup the IOB after a file delete failure.
    2	   1074 !
    2	   1075 
    2	   1076     IF NOT .iob[IOB$G_COMP_CODE]
    2	   1077     THEN
    2	   1078 	$XPO_ZAP_IOB( .iob );
    2	   1079 
    2	   1080 !
    2	   1081 ! Return to the caller.
    2	   1082 !
    2	   1083 
    2	   1084     RETURN .iob[IOB$G_COMP_CODE]			! Return the IOB completion code to the caller.
    2	   1085 
    2	   1086     END;						! End of XPO$DELETE routine
    1	   1087 END
    1	   1088 ELUDOM

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 24
V1.1-25                                                         19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

				      .psect _XPO$CODE, CON, LCL, SHR, EXE, NOWRT, NOVEC
				      .proc   XPO$DELETE
				      .align 32
				      .global  XPO$DELETE
			XPO$DELETE:											   // 000194
			   { .mii 
002C04BA5A40     0000		      alloc   r105 = rspfs, 3, 72, 7, 0
0000B2000A00     0001		      sxt4    r40 = IOB				// r40 = r32				   // 000286
0119E8CE0300     0002		      adds    r12 = -272, r12								   // 000194
			   }
			   { .mii 
000008000000     0010		      nop.m   0
000188001A00     0011		      mov     r104 = br0
010800101A80     0012		      mov     r106 = r1 ;;
			   }
			   { .mmi 
0080828000C0     0020		      ld4     r3 = [r40] ;;								   // 000286
01C438006000     0021		      cmp4.eq pr0, pr7 = r3, r0
000008000000     0022		      nop.i   0
			   }
			   { .mfb 
000008000000     0030		      nop.m   0
000008000000     0031		      nop.f   0
00860000C007     0032	       (pr7)  br.cond.dpnt.few L$8
			   }
			   { .mmi 
01080A8B0200     0040		      adds    r8 = 216, r40 ;;
008080800200     0041		      ld4     r8 = [r8]
000008000000     0042		      nop.i   0 ;;
			   }
			   { .mfb 
01CC48800000     0050		      cmp4.eq pr0, pr9 = 0, r8
000008000000     0051		      nop.f   0
008600008009     0052	       (pr9)  br.cond.dpnt.few L$8
			   }
			   { .mii 
01200007A240     0060		      mov     r9 = 61
0120000022C0     0061		      mov     r11 = 1
012000006480     0062		      mov     r18 = 3 ;;
			   }
			   { .mmi 
00AC42812080     0070		      st2     [r40] = r9, 2 ;;
00AC02816040     0071		      st1     [r40] = r11, 1
000008000000     0072		      nop.i   0 ;;
			   }
			   { .mmi 
00BC0A825F40     0080		      st1     [r40] = r18, -3 ;;
000008000000     0081		      nop.m   0
000008000000     0082		      nop.i   0
			   }
	         0090	L$8:
			   { .mii 
01200001C540     0090		      mov     r21 = 14
012000004A40     0091		      mov     r41 = 2
000008000000     0092		      nop.i   0 ;;
			   }
			   { .mmi 

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 25
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

00A04283C500     00A0		      ld2     r20 = [r40], 30 ;;
00AC0282A040     00A1		      st1     [r40] = r21, 1
01CC0147A2C0     00A2		      cmp4.eq pr11, pr0 = 61, r20 ;;
			   }
			   { .mfb 
00BC0A853840     00B0		      st1     [r40] = r41, -31
000008000000     00B1		      nop.f   0
00860000A00B     00B2	       (pr11) br.cond.dpnt.few L$12 ;;
			   }
			   { .mii 
01080A8B0640     00C0		      adds    r25 = 216, r40
01080A8B86C0     00C1		      adds    r27 = 220, r40
000008000000     00C2		      nop.i   0
			   }
			   { .mlx 
000008000000     00D0		      nop.m   0
000000000000     00D1		      movl    r24 = 2146308 ;;
019800410C
			   }
			   { .mlx 
008C81930000     00E0		      st4     [r25] = r24
000000000000     00E1		      movl    r26 = 2138210 ;;
019400588D
			   }
			   { .mfb 
008C81B34000     00F0		      st4     [r27] = r26
000008000000     00F1		      nop.f   0
0080000A8000     00F2		      br.sptk.few L$13 ;;
			   }
	         0100	L$12:
			   { .mii 
01080A8B8700     0100		      adds    r28 = 220, r40
012000002640     0101		      mov     r25 = 1									   // 000301
0000B2001AC0     0102		      sxt4    r107 = IOB ;;			// r107 = r32
			   }
			   { .mfb 
008C81C00000     0110		      st4     [r28] = r0								   // 000286
000008000000     0111		      nop.f   0
00A000001000     0112		      br.call.sptk.many br0 = XPO$VALID_IOB						   // 000301
			   }
			   { .mib 
010806A00040     0120		      mov     r1 = r106
00A0308001C0     0121		      tbit.z  pr7, pr6 = r8, 0
0086000A2007     0122	       (pr7)  br.cond.dpnt.few L$13
			   }
			   { .mmi 
010802860A00     0130		      adds    r40 = 48, r40 ;;								   // 000309
00B08A8A0A80     0131		      ld4     r42 = [r40], -48
000008000000     0132		      nop.i   0 ;;
			   }
			   { .mii 
000008000000     0140		      nop.m   0
00A402A40A80     0141		      extr.u  r42 = r42, 16, 1 ;;
00A042A00240     0142		      tbit.z  pr9, pr8 = r42, 0
			   }
			   { .mfb 
000008000000     0150		      nop.m   0

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 26
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

000008000000     0151		      nop.f   0
008600006009     0152	       (pr9)  br.cond.dpnt.few L$16
			   }
			   { .mlx 
01080A8B0B00     0160		      adds    r44 = 216, r40								   // 000311
800000000000     0161		      movl    r43 = 2138602 ;;
0194305A95
			   }
			   { .mfb 
008C82C56000     0170		      st4     [r44] = r43
000008000000     0171		      nop.f   0
008000098000     0172		      br.sptk.few L$13 ;;
			   }
	         0180	L$16:												   // 000315
			   { .mii 
012000100B40     0180		      add     r45 = @ltoff($STR$PATTERN), r1
010802808A00     0181		      adds    r40 = 4, r40
01200000E640     0182		      mov     r25 = 7
			   }
			   { .mii 
012400003AC0     0190		      addl    r107 = 16385, r0
0000B0001C40     0191		      sxt4    r113 = r0
0000B0001C00     0192		      sxt4    r112 = r0 ;;
			   }
			   { .mmi 
0080C2D00B40     01A0		      ld8     r45 = $STR$PATTERN		// r45 = [r45]
00B08A8F9B00     01A1		      ld4     r108 = [r40], -4
0000B0001BC0     01A2		      sxt4    r111 = r0 ;;
			   }
			   { .mii 
000008000000     01B0		      nop.m   0
0000B0001B80     01B1		      sxt4    r110 = r0
0000B2D01B40     01B2		      sxt4    r109 = r45
			   }
			   { .mib 
000008000000     01C0		      nop.m   0
0000B6C01B00     01C1		      sxt4    r108 = r108
00A000001000     01C2		      br.call.sptk.many br0 = XST$SCAN
			   }
			   { .mib 
010806A00040     01D0		      mov     r1 = r106
00A0308001C0     01D1		      tbit.z  pr7, pr6 = r8, 0
00860000A007     01D2	       (pr7)  br.cond.dpnt.few L$18								   // 000313
			   }
			   { .mii 
01080A8B0BC0     01E0		      adds    r47 = 216, r40								   // 000317
01080A8B8C40     01E1		      adds    r49 = 220, r40
000008000000     01E2		      nop.i   0
			   }
			   { .mlx 
000008000000     01F0		      nop.m   0
000000000000     01F1		      movl    r46 = 2138290 ;;
0194104C97
			   }
			   { .mlx 
008C82F5C000     0200		      st4     [r47] = r46
000000000000     0201		      movl    r48 = 2138450 ;;

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 27
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

0194205498
			   }
			   { .mfb 
008C83160000     0210		      st4     [r49] = r48
000008000000     0211		      nop.f   0
008000084000     0212		      br.sptk.few L$13 ;;
			   }
	         0220	L$18:												   // 000313
			   { .mmi 
010802858A00     0220		      adds    r40 = 44, r40 ;;								   // 000319
00B08A8A8C80     0221		      ld4     r50 = [r40], -44
000008000000     0222		      nop.i   0 ;;
			   }
			   { .mii 
000008000000     0230		      nop.m   0
00A403250C80     0231		      extr.u  r50 = r50, 20, 1 ;;
00A043200240     0232		      tbit.z  pr9, pr8 = r50, 0
			   }
			   { .mfb 
000008000000     0240		      nop.m   0
000008000000     0241		      nop.f   0
008600006009     0242	       (pr9)  br.cond.dpnt.few L$20
			   }
			   { .mlx 
01080A8B0D00     0250		      adds    r52 = 216, r40								   // 000321
800000000000     0251		      movl    r51 = 2138202 ;;
0194005699
			   }
			   { .mfb 
008C83466000     0260		      st4     [r52] = r51
000008000000     0261		      nop.f   0
00800007A000     0262		      br.sptk.few L$13 ;;
			   }
	         0270	L$20:												   // 000586
			   { .mmi 
01080A8D0D40     0270		      adds    r53 = 232, r40 ;;								   // 000596
008083500D40     0271		      ld4     r53 = [r53]
000008000000     0272		      nop.i   0 ;;
			   }
			   { .mfb 
01C4535002C0     0280		      cmp4.eq pr11, pr10 = r0, r53
000008000000     0281		      nop.f   0
00860000800A     0282	       (pr10) br.cond.dpnt.few L$22
			   }
			   { .mmi 
01080A8D8D80     0290		      adds    r54 = 236, r40 ;;								   // 000597
008083600D80     0291		      ld4     r54 = [r54]
000008000000     0292		      nop.i   0 ;;
			   }
			   { .mmi 
01C463600340     02A0		      cmp4.eq pr13, pr12 = r0, r54 ;;
01C0000012CD     02A1	       (pr13) cmp.eq.unc pr11, pr0 = r0, r0							   // 000596
01C00000128C     02A2	       (pr12) cmp.eq.unc pr10, pr0 = r0, r0
			   }
			   { .bbb 
00860000200A     02B0	       (pr10) br.cond.dpnt.few L$22
004000000000     02B1		      nop.b   0

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 28
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

00860000600B     02B2	       (pr11) br.cond.dpnt.few L$23
			   }
	         02C0	L$22:
			   { .mlx 
01080A8B0E00     02C0		      adds    r56 = 216, r40								   // 000599
800000000000     02C1		      movl    r55 = 2146316 ;;
019800431B
			   }
			   { .mfb 
008C8386E000     02D0		      st4     [r56] = r55
000008000000     02D1		      nop.f   0
00800006C000     02D2		      br.sptk.few L$13 ;;
			   }
	         02E0	L$23:												   // 000607
			   { .mii 
010800C30E80     02E0		      adds    r58 = 24, r12
010800C38EC0     02E1		      adds    r59 = 28, r12
000008000000     02E2		      nop.i   0
			   }
			   { .mlx 
010800C30F00     02F0		      adds    r60 = 24, r12
800000000008     02F1		      movl    r57 = 33685504 ;;
018001001C
			   }
			   { .mii 
008C83A72000     0300		      st4     [r58] = r57
01200000C640     0301		      mov     r25 = 6
0000B0001C00     0302		      sxt4    r112 = r0
			   }
			   { .mii 
0119F80FFB40     0310		      adds    r109 = -1, r0
0000B0001BC0     0311		      sxt4    r111 = r0
0000B0001B80     0312		      sxt4    r110 = r0
			   }
			   { .mmi 
0120000A1AC0     0320		      mov     r107 = 80
008C83B00000     0321		      st4     [r59] = r0
0000B3C01B00     0322		      sxt4    r108 = r60
			   }
			   { .mfb 
000008000000     0330		      nop.m   0
000008000000     0331		      nop.f   0
00A000001000     0332		      br.call.sptk.many br0 = XPO$ALLOC_MEM
			   }
			   { .mii 
010800C38F40     0340		      adds    r61 = 28, r12
00A0308001C0     0341		      tbit.z  pr7, pr6 = $XPO$STATUS, 0		// pr7, pr6 = r8, 0
010806A00040     0342		      mov     r1 = r106 ;;
			   }
			   { .mii 
008083D00F40     0350		      ld4     r61 = [r61]
01C000001206     0351	       (pr6)  cmp.eq.unc pr8, pr0 = r0, r0 ;;
010803D00F88     0352	       (pr8)  mov     FAB = r61				// r62 = r61
			   }
			   { .mfb 
000008000000     0360		      nop.m   0
000008000000     0361		      nop.f   0

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 29
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

008600008008     0362	       (pr8)  br.cond.dpnt.few L$24
			   }
			   { .mii 
01080A8B1000     0370		      adds    r64 = 216, r40								   // 000609
01080A8B9040     0371		      adds    r65 = 220, r40
000008000000     0372		      nop.i   0
			   }
			   { .mlx 
000008000000     0380		      nop.m   0
800000000000     0381		      movl    r63 = 2138370 ;;
019420409F
			   }
			   { .mmb 
008C8407E000     0390		      st4     [r64] = r63
008C84110000     0391		      st4     [r65] = $XPO$STATUS		// [r65] = r8
008000054000     0392		      br.sptk.few L$13 ;;
			   }
	         03A0	L$24:												   // 000607
			   { .mii 
01080A8D10C0     03A0		      adds    r67 = 232, r40								   // 000611
012000007100     03A1		      mov     r68 = 3									   // 000613
0120000A1180     03A2		      mov     r70 = 80
			   }
			   { .mii 
010800001B40     03B0		      mov     r109 = r0
0000B3E01080     03B1		      sxt4    r66 = FAB				// r66 = r62
0120000A1B00     03B2		      mov     r108 = 80 ;;
			   }
			   { .mib 
008C8437C000     03C0		      st4     [r67] = FAB			// [r67] = r62				   // 000611
010804201AC0     03C1		      mov     r107 = r66								   // 000613
00A000001000     03C2		      br.call.sptk.many br0 = OTS$FILL ;;
			   }
			   { .mii 
00AC04288040     03D0		      st1     [r66] = r68, 1
012000002640     03D1		      mov     r25 = 1									   // 000619
0000B2001AC0     03D2		      sxt4    r107 = IOB			// r107 = r32
			   }
			   { .mmi 
010806A00040     03E0		      mov     r1 = r106 ;;								   // 000613
00AC0428C780     03E1		      st1     [r66] = r70, 30
000008000000     03E2		      nop.i   0 ;;
			   }
			   { .mmi 
00BC0C253DC0     03F0		      st1     [r66] = r41, -9 ;;
00AC04252480     03F1		      st1     [r66] = r41, 18
000008000000     03F2		      nop.i   0
			   }
			   { .mfb 
000008000000     0400		      nop.m   0
000008000000     0401		      nop.f   0
00A000001000     0402		      br.call.sptk.many br0 = XPO$RMS_PARSE						   // 000619
			   }
			   { .mib 
010806A00040     0410		      mov     r1 = r106
00A0308001C0     0411		      tbit.z  pr7, pr6 = r8, 0
008600044007     0412	       (pr7)  br.cond.dpnt.few L$13 ;;

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 30
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

			   }
			   { .mii 
00B08C2B1280     0420		      ld4     r74 = [r66], -40								   // 000623
0120080FF2C0     0421		      mov     r75 = 255									   // 000624
012000002640     0422		      mov     r25 = 1 ;;								   // 000631
			   }
			   { .mii 
000008000000     0430		      nop.m   0
0000B3E01AC0     0431		      sxt4    r107 = FAB			// r107 = r62
0000B4A01280     0432		      sxt4    r74 = r74 ;;								   // 000624
			   }
			   { .mmi 
010804A05280     0440		      adds    r74 = 2, r74 ;;
00AC04A96080     0441		      st1     [r74] = r75, 2
010800C412C0     0442		      adds    r75 = 32, r12 ;;								   // 000625
			   }
			   { .mfb 
00BC8CA97FC0     0450		      st4     [r74] = r75, -1
000008000000     0451		      nop.f   0
00A000001000     0452		      br.call.sptk.many br0 = SYS$ERASE ;;						   // 000631
			   }
			   { .mii 
00B00CAFB380     0460		      ld1     r78 = [r74], -3								   // 000637
010806A00040     0461		      mov     r1 = r106 ;;								   // 000631
01C404E001C0     0462		      cmp4.eq pr7, pr0 = r0, r78							   // 000637
			   }
			   { .mfb 
000008000000     0470		      nop.m   0
000008000000     0471		      nop.f   0
00860001C007     0472	       (pr7)  br.cond.dpnt.few L$30
			   }
			   { .mii 
010800C213C0     0480		      adds    r79 = 16, r12								   // 000644
010800C25440     0481		      adds    r81 = 18, r12
01201001D400     0482		      mov     r80 = 270
			   }
			   { .mmi 
010800C294C0     0490		      adds    r83 = 20, r12
012000039480     0491		      mov     r82 = 28
010800C21500     0492		      adds    r84 = 16, r12 ;;
			   }
			   { .mii 
008C44F9C000     04A0		      st2     [r79] = r78
01200000A640     04A1		      mov     r25 = 5
010005251480     04A2		      add     r82 = r40, r82
			   }
			   { .mmi 
008C451A0000     04B0		      st2     [r81] = r80
010804A09280     04B1		      adds    r74 = 4, r74
0000B0001BC0     04B2		      sxt4    r111 = r0 ;;
			   }
			   { .mii 
012400001AC0     04C0		      addl    r107 = 16384, r0
0000B0001B80     04C1		      sxt4    r110 = r0
0000B5201B40     04C2		      sxt4    r109 = r82
			   }
			   { .mib 

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 31
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

00B08CAF9400     04D0		      ld4     r80 = [r74], -4
0000B5401B00     04D1		      sxt4    r108 = r84
004000000000     04D2		      nop.b   0 ;;
			   }
			   { .mfb 
008C853A0000     04E0		      st4     [r83] = r80
000008000000     04E1		      nop.f   0
00A000001000     04E2		      br.call.sptk.many br0 = XST$COPY
			   }
			   { .mib 
010806A00040     04F0		      mov     r1 = r106
00A0308001C0     04F1		      tbit.z  pr7, pr6 = $XPO$STATUS, 0		// pr7, pr6 = r8, 0
008600008006     04F2	       (pr6)  br.cond.dpnt.few L$31
			   }
			   { .mii 
01080A8B1580     0500		      adds    r86 = 216, r40								   // 000646
01080A8B95C0     0501		      adds    r87 = 220, r40
000008000000     0502		      nop.i   0
			   }
			   { .mlx 
000008000000     0510		      nop.m   0
800000000000     0511		      movl    r85 = 2138282 ;;
0194104AAA
			   }
			   { .mmb 
008C856AA000     0520		      st4     [r86] = r85
008C85710000     0521		      st4     [r87] = $XPO$STATUS		// [r87] = r8
008000022000     0522		      br.sptk.few L$13 ;;
			   }
	         0530	L$31:												   // 000644
			   { .mmi 
010802840A00     0530		      adds    r40 = 32, r40 ;;								   // 000649
00B08A8C1600     0531		      ld4     r88 = [r40], -32
010804A09280     0532		      adds    r74 = 4, r74 ;;								   // 000648
			   }
			   { .mmi 
00BC8CAB1F00     0540		      st4     [r74] = r88, -4 ;;
000008000000     0541		      nop.m   0
000008000000     0542		      nop.i   0
			   }
	         0550	L$30:												   // 000637
			   { .mmi 
010804A05280     0550		      adds    r74 = 2, r74 ;;								   // 000652
008C04A00000     0551		      st1     [r74] = r0
010804211080     0552		      adds    r66 = 8, r66 ;;								   // 000658
			   }
			   { .mmi 
00A0842096C0     0560		      ld4     r91 = [r66], 4 ;;
000008000000     0561		      nop.m   0
00A045B00240     0562		      tbit.z  pr9, pr8 = r91, 0
			   }
			   { .mfb 
000008000000     0570		      nop.m   0
000008000000     0571		      nop.f   0
00860000A008     0572	       (pr8)  br.cond.dpnt.few L$33
			   }
			   { .mii 

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 32
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

008084201B40     0580		      ld4     r109 = [r66]								   // 000661
012000006640     0581		      mov     r25 = 3
0000B5B01B00     0582		      sxt4    r108 = r91 ;;
			   }
			   { .mii 
000008000000     0590		      nop.m   0
0000B2001AC0     0591		      sxt4    r107 = IOB			// r107 = r32
0000B6D01B40     0592		      sxt4    r109 = r109
			   }
			   { .mfb 
000008000000     05A0		      nop.m   0
000008000000     05A1		      nop.f   0
00A000001000     05A2		      br.call.sptk.many br0 = XPO$RMS_ERROR
			   }
			   { .mfb 
010806A00040     05B0		      mov     r1 = r106
000008000000     05B1		      nop.f   0
008000010000     05B2		      br.sptk.few L$13 ;;								   // 000663
			   }
	         05C0	L$33:												   // 000670
			   { .mib 
012000002640     05C0		      mov     r25 = 1
0000B2001AC0     05C1		      sxt4    r107 = IOB			// r107 = r32
00A000001000     05C2		      br.call.sptk.many br0 = XPO$ZAP_IOB
			   }
			   { .mib 
010806A00040     05D0		      mov     r1 = r106
00A0308001C0     05D1		      tbit.z  pr7, pr6 = $XPO$STATUS, 0		// pr7, pr6 = r8, 0
008600008006     05D2	       (pr6)  br.cond.dpnt.few L$35
			   }
			   { .mii 
01080A8B1740     05E0		      adds    r93 = 216, r40
01080A8B9780     05E1		      adds    r94 = 220, r40
000008000000     05E2		      nop.i   0
			   }
			   { .mlx 
000008000000     05F0		      nop.m   0
000000000000     05F1		      movl    r92 = 2138362 ;;
0194105EAE
			   }
			   { .mmb 
008C85DB8000     0600		      st4     [r93] = r92
008C85E10000     0601		      st4     [r94] = $XPO$STATUS		// [r94] = r8
008000006000     0602		      br.sptk.few L$13 ;;
			   }
	         0610	L$35:
			   { .mlx 
01080A8B1800     0610		      adds    r96 = 216, r40								   // 000672
800000000000     0611		      movl    r95 = 2129921 ;;
019000406F
			   }
			   { .mfi 
008C860BE000     0620		      st4     [r96] = r95
000008000000     0621		      nop.f   0
000008000000     0622		      nop.i   0
			   }
	         0630	L$13:												   // 001070

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 33
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

			   { .mii 
01080A8B1840     0630		      adds    r97 = 216, r40
0108022018C0     0631		      mov     r99 = FAILURE_ACTION		// r99 = r34
000008000000     0632		      nop.i   0 ;;
			   }
			   { .mmi 
008086101880     0640		      ld4     r98 = [r97] ;;
000008000000     0641		      nop.m   0
00A046200000     0642		      tbit.z  pr0, pr8 = r98, 0 ;;
			   }
			   { .mmi 
0108021018C8     0650	       (pr8)  mov     r99 = SUCCESS_ACTION ;;		// r99 = r33
01C406300280     0651		      cmp4.eq pr10, pr0 = r0, $XPO$ACTION	// pr10, pr0 = r0, r99
000008000000     0652		      nop.i   0
			   }
			   { .mfb 
000008000000     0660		      nop.m   0
000008000000     0661		      nop.f   0
00860001000A     0662	       (pr10) br.cond.dpnt.few L$38
			   }
			   { .mii 
01080A8B9B40     0670		      adds    r109 = 220, r40
0000B63018C0     0671		      sxt4    r99 = $XPO$ACTION			// r99 = r99
01080A8B1980     0672		      adds    r102 = 216, r40
			   }
			   { .mii 
012000008640     0680		      mov     r25 = 4
0000B2001B80     0681		      sxt4    r110 = IOB			// r110 = r32
0000B6201B00     0682		      sxt4    r108 = r98 ;;
			   }
			   { .mii 
008086D01B40     0690		      ld4     r109 = [r109]
012000003AC0     0691		      mov     r107 = 1
0108063118C0     0692		      adds    r99 = 8, r99 ;;
			   }
			   { .mib 
000008000000     06A0		      nop.m   0
0000B6D01B40     06A1		      sxt4    r109 = r109
004000000000     06A2		      nop.b   0
			   }
			   { .mmi 
00B0CE3F0040     06B0		      ld8     r1 = [r99], -8 ;;
0080C63018C0     06B1		      ld8     r99 = [r99]
000008000000     06B2		      nop.i   0 ;;
			   }
			   { .mib 
000008000000     06C0		      nop.m   0
000E001C6180     06C1		      mov     br6 = r99
00210000C000     06C2		      br.call.sptk.few br0 = br6
			   }
			   { .mii 
008C86610000     06D0		      st4     [r102] = r8
010806A00040     06D1		      mov     r1 = r106
000008000000     06D2		      nop.i   0
			   }
	         06E0	L$38:
			   { .mmi 

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 34
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

01080A8B19C0     06E0		      adds    r103 = 216, r40 ;;							   // 001076
0080867019C0     06E1		      ld4     r103 = [r103]
000008000000     06E2		      nop.i   0 ;;
			   }
			   { .mib 
000008000000     06F0		      nop.m   0
00A0367001C0     06F1		      tbit.z  pr7, pr6 = r103, 0
008600006006     06F2	       (pr6)  br.cond.dpnt.few L$39
			   }
			   { .mib 
012000002640     0700		      mov     r25 = 1									   // 001078
0000B2001AC0     0701		      sxt4    r107 = IOB			// r107 = r32
00A000001000     0702		      br.call.sptk.many br0 = XPO$ZAP_IOB
			   }
			   { .mfi 
010806A00040     0710		      mov     r1 = r106
000008000000     0711		      nop.f   0
000008000000     0712		      nop.i   0
			   }
	         0720	L$39:												   // 001076
			   { .mmi 
01080A8B0A00     0720		      adds    r40 = 216, r40 ;;								   // 001084
008082800200     0721		      ld4     r8 = [r40]
000008000000     0722		      nop.i   0 ;;
			   }
			   { .mib 
000008000000     0730		      nop.m   0
0000B0800200     0731		      sxt4    r8 = r8
004000000000     0732		      nop.b   0
			   }
			   { .mii 
000008000000     0740		      nop.m   0
0001540D2000     0741		      mov.i   rspfs = r105
010810C20300     0742		      adds    r12 = 272, r12 ;;
			   }
			   { .mib 
000008000000     0750		      nop.m   0
000E001D0000     0751		      mov     br0 = r104
000108001100     0752		      br.ret.sptk.many br0 ;;
			   }
				      .endp   XPO$DELETE

Routine Size: 1888 bytes,    Routine Base: _XPO$CODE + 0000

				       .psect _XPO$DATA, CON, LCL, NOSHR, NOEXE, WRT, NOVEC
				      .lcomm  $STR$PATTERN, 8, 8
				      .lcomm  P.AAA, 1, 1
				      .psect _XPO$DATA, CON, LCL, NOSHR, NOEXE, WRT, NOVEC
			$STR$PATTERN:
    0001         0000		      data2   0x1 // data2 1
      0E         0002		      data1   0xE // data1 14
      01         0003		      data1   0x1 // data1 1
00000000         0004		      data4   P.AAA
				      .psect _XPO$PLIT, CON, LCL, NOSHR, NOEXE, NOWRT, NOVEC
			P.AAA:
      2B         0000		      data1   0x2B // data1 43
				      .section .data

XDELET                          Machine Code Listing             4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 35
V1.1-25                         XPO$DELETE                      19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

				      .type   XPO$VALID_IOB, @function 
				      .global  XPO$VALID_IOB
				      .section .data
				      .type   XST$SCAN, @function 
				      .global  XST$SCAN
				      .section .data
				      .type   XPO$ALLOC_MEM, @function 
				      .global  XPO$ALLOC_MEM
				      .section .data
				      .type   OTS$FILL, @function 
				      .global  OTS$FILL
				      .section .data
				      .type   XPO$RMS_PARSE, @function 
				      .global  XPO$RMS_PARSE
				      .section .data
				      .type   SYS$ERASE, @function 
				      .global  SYS$ERASE
				      .section .data
				      .type   XST$COPY, @function 
				      .global  XST$COPY
				      .section .data
				      .type   XPO$RMS_ERROR, @function 
				      .global  XPO$RMS_ERROR
				      .section .data
				      .type   XPO$ZAP_IOB, @function 
				      .global  XPO$ZAP_IOB
				      .section .data
				      .type   XPO$ZAP_IOB, @function 
				      .global  XPO$ZAP_IOB


;				Library Statistics
;
;					     -------- Symbols --------	    Pages
;	File				     Total    Loaded   Percent      Mapped
;
;  DISK$NORMS_OWN:[LASTOVICA.XPORT.VMSGEN]XPORT.L32;14
;					       590       151        25       270
;  DISK$NORMS_OWN:[LASTOVICA.XPORT.VMSGEN]XPOSYS.L32;14
;					        91        19        20        27
;  SYS$COMMON:[SYSLIB]STARLET.L32;1	     28352        50         0      2178


    0	   1089 
    0	   1090 
    0	   1091 


                                Source Listing                   4-FEB-2004 11:01:35  BLISS-32I T1.1-053                Page 36
                                Source Listing                  19-MAR-2002 10:12:06  [LASTOVICA.XPORT.VMSGEN]XDELET.BLI;1

COMMAND LINE:

BLISSXDELET/VARIANT=3/LIST/DEBUG
