

; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 1

; Digital Equipment Corporation

;

;	0001	MODULE delemain (	! STARLET Native File Deletion Utility

;	0002	                        IDENT = 'X00001',

;	0003	                        MAIN = del$main

;	0004	                        ) =

;	0005	BEGIN

;	0006	

;	0007	!

;	0008	! Copyright (c) 1978

;	0009	! Digital Equipment Corporation, Maynard, Massachusetts 01754

;	0010	!

;	0011	! This software is furnished  under a license for use only on a single

;	0012	! computer  system and  may be  copied only with  the inclusion of the

;	0013	! above copyright notice.  This software, or any other copies thereof,

;	0014	! may not be provided or  otherwise made available to any other person

;	0015	! except for use on such system and to one who agrees to these license

;	0016	! terms.  Title to and  ownership of the  software  shall at all times

;	0017	! remain in DEC.

;	0018	!

;	0019	! The information in this software is subject to change without notice

;	0020	! and should  not be construed  as a commitment  by Digital  Equipment

;	0021	! Corporation.

;	0022	!

;	0023	! DEC assumes  no  responsibility  for  the use or  reliability of its

;	0024	! software on equipment which is not supplied by DEC.

;	0025	

;	0026	!++

;	0027	! FACILITY:  DELETE

;	0028	!

;	0029	! ABSTRACT:

;	0030	!

;	0031	!	This utility program deletes one or more user-specified files.

;	0032	!

;	0033	! ENVIRONMENT:  

;	0034	!

;	0035	!	VAX/VMS operating system, unprivileged user mode utility,

;	0036	!	operates at non-AST level.

;	0037	!

;	0038	! AUTHOR:  Carol Peters,	CREATION DATE:  03 May 1978

;	0039	!

;	0040	! REVISION HISTORY:

;	0041	!

;	0042	!--



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 2

; Digital Equipment Corporation

;

;	0043	!

;	0044	! Table of contents

;	0045	!

;	0046	

;	0047	FORWARD ROUTINE

;	0048	    del$main,						! Main DELETE control routine

;	0049	    delete_file		: NOVALUE,			! Deletes one file

;	0050	    check_wildcards,					! Validates wildcards and version numbers

;	0051	    check_date,						! Selects deletions based on date

;	0052	    confirm_delete,					! Asks user whether a file is to be deleted.

;	0053	    close_error		: NOVALUE,			! Handles errors on closing a file

;	0054	    condit_handler,					! Condition handler for errors and messages

;	0055	    file_error	: NOVALUE,				! Handles errors on RMS file functions

;	0056	    get_confirm;					! PUTMSG action routine for /CONFIRM.

;	0057	

;	0058	!

;	0059	! Include files

;	0060	!

;	0061	

;	0062	LIBRARY 'SYS$LIBRARY:STARLET.L32';			! VAX/VMS common definitions

;	0063	

;	0064	LIBRARY	'SYS$LIBRARY:CLIMAC.L32';			! CLI macros

;	0065	

;	0066	REQUIRE	'SRC$:DELETE.REQ';				! COPY literal definitions and macros

;	0154	

;	0155	REQUIRE 'SRC$:DELEMSG.REQ';				! Definition of macros to SIGNAL a message

;	0203	

;	0204	!

;	0205	! Macros

;	0206	!

;	0207	

;	0208	!

;	0209	! Equated symbols

;	0210	!

;	0211	

;	0212	!

;	0213	! OWN storage

;	0214	!

;	0215	

;	0216	OWN

;	0217	    del_or_not;						! Flag saying delete a file or not

;	0218	

;	0219	!

;	0220	! Global variables

;	0221	!

;	0222	

;	0223	!

;	0224	! External references

;	0225	!

;	0226	

;	0227	EXTERNAL

;	0228	    cli_work_area	: BLOCK [, BYTE],		! CLI dynamic work area

;	0229	    del$before_date	: BLOCK [, BYTE],		! Specified /BEFORE date value.

;	0230	    del$cli_status	: BITVECTOR,			! Status bits for DELETE utility

;	0231	    del$keepver_val,					! Number of versions to keep in a PURGE session



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 2-1

; Digital Equipment Corporation

;

;	0232	    del$severe_err	: BLOCK [, BYTE],		! Most severe error code that has occurred

;	0233	    del$since_date	: BLOCK [, BYTE],		! Specified /SINCE date value.

;	0234	    infile_desc		: BLOCK [, BYTE],		! CLI input file descriptor block

;	0235	    infile_fab		: BLOCK [, BYTE],		! FAB block for file

;	0236	    infile_nam_blk	: BLOCK [, BYTE],		! NAM block for file

;	0237	    infile_xabdat	: BLOCK [, BYTE],		! XAB date/time block for file specifications

;	0238	    infile_xabfhc	: BLOCK [, BYTE],		! XAB file header characteristics block

;	0239	    initial_desc	: BLOCK [, BYTE];		! CLI initialization block

;	0240	

;	0241	EXTERNAL ROUTINE

;	0242	    del$get_cmdqual,					! Gets the command qualifiers

;	0243	    del$get_file,					! Gets the file specification from command line.

;	0244	    del$del_error,					! Handles an error on a file deletion.

;	0245	    del$parse_file,					! Parses a file specification

;	0246	    del$purge_spec,					! Purges files related to one file specification

;	0247	    lib$cvt_dtb,					! Converts an ASCII string to an integer value.

;	0248	    lib$get_command,					! Gets a line from SYS$COMMAND.

;	0249	    del$search_fil,					! Searches for the next file

;	0250	    sys$putmsg	: ADDRESSING_MODE (ABSOLUTE);		! Outputs a message to the user.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 3

; Digital Equipment Corporation

;

;	0251	ROUTINE del$main =					! Main DELETE control routine

;	0252	

;	0253	!++

;	0254	! Functional description

;	0255	!

;	0256	!	This routine is the central control routine for the DELETE utility.

;	0257	!	It determines the basic logical flow and calls support routines

;	0258	!	that perform each logical function in deleting and purging files.

;	0259	!

;	0260	! Calling sequence

;	0261	!

;	0262	!	del$main ()

;	0263	!

;	0264	! Input parameters

;	0265	!

;	0266	!	AP.rlu.va - Argument list passed from the Command Language Interpreter

;	0267	!

;	0268	! Implicit inputs

;	0269	!

;	0270	!	infile_fab	- the FAB block to use for each file specification

;	0271	!	infile_nam_blk	- the NAM block to use for each file specification

;	0272	!

;	0273	! Output parameters

;	0274	!

;	0275	!	none

;	0276	!

;	0277	! Implicit outputs

;	0278	!

;	0279	!	del$severe_err	- set whenever an error occurs

;	0280	!

;	0281	! Routine value

;	0282	!

;	0283	!	Most severe error encountered during processing or SS$_NORMAL

;	0284	!

;	0285	! Side effects

;	0286	!

;	0287	!	The specified files are deleted.

;	0288	!

;	0289	!--

;	0290	

;	0291	    BEGIN

;	0292	

;	0293	    BUILTIN

;	0294		AP;						! Declare the name of the argument pointer.

;	0295	

;	0296	    BIND

;	0297		argument_list = AP	:  REF BLOCK [,BYTE];	! Declare the form of the argument list.

;	0298	

;	0299	    LOCAL

;	0300		status;						! General routine return code

;	0301	

;	0302	    LABEL

;	0303	        process_loop;					! Label for file processing loop

;	0304	

;	0305	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 3-1

; Digital Equipment Corporation

;

;	0306	! Enable a condition handler for this utility.

;	0307	!

;	0308	

;	0309	    ENABLE condit_handler;				! Enable a local handler.

;	0310	

;	0311	!

;	0312	! Initialization consists of storing the address of the parsing callback routine,

;	0313	! and initializing the CLI work areas. This initializes all bit settings in the CLI status word.

;	0314	!

;	0315	

;	0316	    del$cli_result = .argument_list [cli$a_utilserv];	! Save the address of the CLI result parse routine.

;	0317	

;	0318	    call_cli (						! Call the CLI with the following arguments:

;	0319	                initial_desc,				!    CLI initialization request descriptor address,

;	0320			cli_work_area,				!    CLI work area address,

;	0321			del$cli_status);			!    and the DELETE status bit vector address.

;	0322	

;	0323	!

;	0324	! Set a bit in the status word that says that some input parameters have been specified.

;	0325	! This allows for first time through the "get-input" loop.

;	0326	!

;	0327	

;	0328	    infile_desc [cli$v_concatinp] = TRUE;		! Needed to allow a retrieve of

;	0329								! the first file-specification.

;	0330	

;	0331	!

;	0332	! Get the command qualifiers from the Command Language Interpreter (CLI).

;	0333	!

;	0334	

;	0335	    del$get_cmdqual ();					! Get the command qualifiers.

;	0336	

;	0337	!

;	0338	! The remainder of this routine is executed for each

;	0339	! file specification supplied by the user.

;	0340	!

;	0341	

;	0342	    WHILE 1 DO						! Beginning of repeat loop

;	0343	

;	0344	process_loop:

;	0345	

;	0346		BEGIN

;	0347	

;	0348	!

;	0349	! Unless a wildcard specification is being processed, get the next file specification

;	0350	! from the CLI.

;	0351	!

;	0352	

;	0353	        IF NOT .del$cli_status [wildcard_bit]		! If not processing a wildcard specification,

;	0354	        THEN

;	0355	            BEGIN					!    then get another specification.

;	0356	            status = del$get_file (			! Call the routine del$get_file with

;	0357	                                    infile_fab,		!    the address of the FAB block,

;	0358	                                    infile_nam_blk,	!    and the address of the NAM block.

;	0359	                                    (IF .del$cli_status [purge_cmd_bit]

;	0360	                                     THEN



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 3-2

; Digital Equipment Corporation

;

;	0361	                                         infile_xabfhc

;	0362	                                     ELSE

;	0363	                                         infile_xabdat)

;	0364	                                    );			!    Choose a XABDAT block for deleting

;	0365								!    and a XABFHC for purging.

;	0366	

;	0367	            IF .status EQL no_more_files		! If there are no more file specs,

;	0368	            THEN

;	0369	                EXITLOOP;				!    then exit the file spec processing loop.

;	0370	

;	0371	            IF NOT .status				! If the file specification wasn't okay,

;	0372	            THEN

;	0373	                LEAVE process_loop;			!    then go get the next one.

;	0374	

;	0375	!

;	0376	! See whether this new file specification contains any wildcards. Also confirm that

;	0377	! a DELETE command specifies an explicit or wildcard version number, and that a PURGE

;	0378	! command does not specify any version number.

;	0379	!

;	0380	

;	0381	            IF NOT check_wildcards (infile_nam_blk)	! If wildcard settings are not valid,

;	0382	            THEN

;	0383	                LEAVE process_loop;			!    then go get next file specification.

;	0384	

;	0385	            END;

;	0386	

;	0387	!

;	0388	! Perform DELETE or PURGE processing for this file specification.

;	0389	!

;	0390	

;	0391	        IF .del$cli_status [purge_cmd_bit]		! If this is a PURGE command

;	0392	        THEN

;	0393	            del$purge_spec (				!    then call the purge routine with the

;	0394	                            infile_fab)			!    addresses of the FAB and NAM

;	0395	        ELSE

;	0396	            delete_file (				! Otherwise, call the delete routine with

;	0397	                            infile_fab);		!    the addresses of the FAB.

;	0398	

;	0399		END;						! End of "WHILE 1 DO" file spec processing loop.

;	0400	

;	0401	!

;	0402	! Return to the caller.

;	0403	!

;	0404	

;	0405	    RETURN .del$severe_err;				! Use the most severe error encountered

;	0406								! as the completion code from this routine.

;	0407	

;	0408	    END;





							    .TITLE  DELEMAIN

							    .IDENT  \X00001\



							    .PSECT  $OWN$,NOEXE,2





; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 3-3

; Digital Equipment Corporation

;

					      00000 DEL_OR_NOT:

							    .BLKB   4



							    .GLOBL  DEL$CLI_RESULT, DEL$MSG_NUMBER, CLI_WORK_AREA

							    .GLOBL  DEL$BEFORE_DATE, DEL$CLI_STATUS, DEL$KEEPVER_VAL

							    .GLOBL  DEL$SEVERE_ERR, DEL$SINCE_DATE, INFILE_DESC, INFILE_FAB

							    .GLOBL  INFILE_NAM_BLK, INFILE_XABDAT, INFILE_XABFHC, INITIAL_DESC

							    .GLOBL  DEL$GET_CMDQUAL, DEL$GET_FILE, DEL$DEL_ERROR, DEL$PARSE_FILE

							    .GLOBL  DEL$PURGE_SPEC, LIB$CVT_DTB, LIB$GET_COMMAND, DEL$SEARCH_FIL

							    .GLOBL  SYS$PUTMSG



							    .PSECT  $CODE$,NOWRT,2



					 0C04 00000 DEL$MAIN:

							    .WORD   Save R2,R10,R11					      ; 0251

		         5A	0000G  CF  9E 00002 	    MOVAB   INFILE_FAB, R10					      ;

		         5B	0000G  CF  9E 00007 	    MOVAB   DEL$CLI_STATUS, R11					      ;

		         6D 00000074   EF  DE 0000C 	    MOVAL   7$, (FP)						      ; 0291

		  0000G  CF	  08   AC  D0 00013 	    MOVL    8(ARGUMENT_LIST), DEL$CLI_RESULT			      ; 0316

				       5B  DD 00019 	    PUSHL   R11							      ; 0318

				0000G  CF  9F 0001B 	    PUSHAB  CLI_WORK_AREA					      ;

				0000G  CF  9F 0001F 	    PUSHAB  INITIAL_DESC					      ;

		  0000G  DF	       03  FB 00023 	    CALLS   #3, @DEL$CLI_RESULT					      ;

		  0000G  CF	       02  88 00028 	    BISB2   #2, INFILE_DESC+3					      ; 0328

		  0000G  CF	       00  FB 0002D 	    CALLS   #0, DEL$GET_CMDQUAL					      ; 0335

	   34	         6B	       04  E0 00032 1$:     BBS     #4, DEL$CLI_STATUS, 4$				      ; 0353

	   07	         6B	       05  E1 00036 	    BBC     #5, DEL$CLI_STATUS, 2$				      ; 0359

		         50	0000G  CF  9E 0003A 	    MOVAB   INFILE_XABFHC, R0					      ;

				       05  11 0003F 	    BRB     3$							      ;

		         50	0000G  CF  9E 00041 2$:     MOVAB   INFILE_XABDAT, R0					      ;

				       50  DD 00046 3$:     PUSHL   R0							      ;

				0000G  CF  9F 00048 	    PUSHAB  INFILE_NAM_BLK					      ; 0356

				       5A  DD 0004C 	    PUSHL   R10							      ;

		  0000G  CF	       03  FB 0004E 	    CALLS   #3, DEL$GET_FILE					      ;

		         52	       50  D0 00053 	    MOVL    R0, STATUS						      ;

		         03	       52  D1 00056 	    CMPL    STATUS, #3						      ; 0367

				       25  13 00059 	    BEQL    6$							      ;

		         D4	       52  E9 0005B 	    BLBC    STATUS, 1$						      ; 0371

				0000G  CF  9F 0005E 	    PUSHAB  INFILE_NAM_BLK					      ; 0381

		  0000V  CF	       01  FB 00062 	    CALLS   #1, CHECK_WILDCARDS					      ;

		         C8	       50  E9 00067 	    BLBC    R0, 1$						      ;

	   09	         6B	       05  E1 0006A 4$:     BBC     #5, DEL$CLI_STATUS, 5$				      ; 0391

				       5A  DD 0006E 	    PUSHL   R10							      ; 0393

		  0000G  CF	       01  FB 00070 	    CALLS   #1, DEL$PURGE_SPEC					      ;

				       BB  11 00075 	    BRB     1$							      ; 0391

				       5A  DD 00077 5$:     PUSHL   R10							      ; 0396

		  0000V  CF	       01  FB 00079 	    CALLS   #1, DELETE_FILE					      ;

				       B2  11 0007E 	    BRB     1$							      ; 0342

		         50	0000G  CF  D0 00080 6$:     MOVL    DEL$SEVERE_ERR, R0					      ; 0405

					   04 00085 	    RET     							      ; 0251

					 0000 00086 7$:     .WORD   Save nothing					      ; 0291

				       7E  D4 00088 	    CLRL    -(SP)						      ;

				       5E  DD 0008A 	    PUSHL   SP							      ;

		         7E	  04   AC  7D 0008C 	    MOVQ    4(AP), -(SP)					      ;

		  0000V  CF	       03  FB 00090 	    CALLS   #3, CONDIT_HANDLER					      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 3-4

; Digital Equipment Corporation

;

					   04 00095 	    RET     							      ;



; Routine Size:  150 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 4

; Digital Equipment Corporation

;

;	0409	ROUTINE delete_file (fab_block) : NOVALUE =		! Deletes a file

;	0410	

;	0411	!++

;	0412	! Functional description

;	0413	!

;	0414	!	This routine deletes one file. If a wildcard specification is active, an RMS SEARCH

;	0415	!	function is called to find the next file that matches the wildcard specification.

;	0416	!	If the user specified the /CONFIRM qualifier, the name of the file is output to

;	0417	!	SYS$OUTPUT and the user can advise whether the file is to be deleted or not. Then

;	0418	!	the file is opened, closed with the delete bit set, and the deletion reported if

;	0419	!	the /LOG qualifier was specified.

;	0420	!

;	0421	! Calling sequence

;	0422	!

;	0423	!	delete_file (fab_block.ra.v)

;	0424	!

;	0425	! Input parameters

;	0426	!

;	0427	!	fab_block	- The FAB block for the file specification

;	0428	!

;	0429	! Implicit inputs

;	0430	!

;	0431	!	Bits are tested in the status word:

;	0432	!

;	0433	!		WILDCARD_BIT	- determines whether the specification contains wildcards.

;	0434	!		CONFIRM_BIT	- whether the user wishes to decide on a per file

;	0435	!				  basis whether the file is to be deleted.

;	0436	!		LOG_MSG_BIT	- whether each deletion is to be logged on SYS$OUTPUT.

;	0437	!

;	0438	!	Fields in the NAM block are used to log the deletion:

;	0439	!

;	0440	!		RSA	- address of the resultant name string

;	0441	!		RSL	- length of the resultant name string

;	0442	!

;	0443	! Output parameters

;	0444	!

;	0445	!	none

;	0446	!

;	0447	! Implicit outputs

;	0448	!

;	0449	!	The routine DEL$SEARCH_FIL turns off the wildcard flag if a wildcard

;	0450	!	specification is exhausted.

;	0451	!

;	0452	! Routine value

;	0453	!

;	0454	!	novalue

;	0455	!

;	0456	! Side effects

;	0457	!

;	0458	!	Errors are signaled. Files are deleted. If a file is opened by the check_date routine,

;	0459	!	it is closed (and perhaps also deleted).

;	0460	!

;	0461	!--

;	0462	

;	0463	    BEGIN



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 4-1

; Digital Equipment Corporation

;

;	0464	

;	0465	    MAP

;	0466	        fab_block	: REF BLOCK [, BYTE];

;	0467	

;	0468	    BIND

;	0469	        nam_block	=				! Associated NAM block address.

;	0470	                .fab_block [fab$l_nam]	: BLOCK [, BYTE];

;	0471	

;	0472	    LOCAL

;	0473	        status;						! Holds RMS status codes

;	0474	

;	0475	!

;	0476	! If the current file specification contains a wildcard, search for the next matching file.

;	0477	!

;	0478	

;	0479	    IF .del$cli_status [wildcard_bit]			! If the current spec contains a wildcard,

;	0480	    THEN

;	0481	        BEGIN

;	0482	        status = del$search_fil (			! Search through the directory for the

;	0483	                                    .fab_block);	!    next matching file.

;	0484	        IF NOT .status OR				! If the SEARCH fails, or if

;	0485	            (.status EQL no_more_files)			!    no more files matching wildcards exist,

;	0486	        THEN

;	0487	            RETURN;					! then return to caller.

;	0488	        END;

;	0489	

;	0490	!

;	0491	! If the /BEFORE or /SINCE qualifier was specified, see whether this file should

;	0492	! be deleted based the relation between its date field and the specified date field.

;	0493	! The user can select deletion based on creation, expiration, or modification date.

;	0494	!

;	0495	

;	0496	    IF .del$cli_status [since_bit] OR			! If the /SINCE or the /BEFORE

;	0497	        .del$cli_status [before_bit]			!    qualifier was specified,

;	0498	    THEN

;	0499	        BEGIN

;	0500	        IF NOT check_date (				!    see whether this file qualifies for deletion.

;	0501	                            .fab_block)			!    Specify the address of the FAB block.

;	0502	        THEN

;	0503	            RETURN;					! If the file doesn't qualify, just return.

;	0504	        END;

;	0505	

;	0506	!

;	0507	! If the /CONFIRM qualifier was specified, ask the user whether this file

;	0508	! should be deleted. If the user says no, then just go process the next file.

;	0509	!

;	0510	

;	0511	    IF .del$cli_status [confirm_bit]			! If /CONFIRM was requested,

;	0512	    THEN

;	0513	        BEGIN

;	0514	        IF NOT confirm_delete (				! Ask the user whether to delete the file.

;	0515	                                 .fab_block)		! If the user says no,

;	0516	        THEN

;	0517	            BEGIN

;	0518	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 4-2

; Digital Equipment Corporation

;

;	0519	!

;	0520	! If the file is open due to a date checking operation, close it.

;	0521	!

;	0522	

;	0523	            IF .fab_block [fab$w_ifi] NEQ 0		! If the file is open,

;	0524	            THEN

;	0525	                status = $RMS_CLOSE (			!    then close it.

;     P 0526	                                        FAB = .fab_block,

;     P 0527	                                        ERR = close_error);

;	0528	            RETURN;					! Return to caller.

;	0529	            END;

;	0530	        END;

;	0531	

;	0532	!

;	0533	! Delete the current file. If the file was opened by the check_date routine, just close

;	0534	! it with the delete bit set. Otherwise simply call RMS to perform the erase function.

;	0535	! If the erase or delete doesn't work, just return. The calling routine

;	0536	! will go on to process the next file.

;	0537	!

;	0538	

;	0539	    IF .fab_block [fab$w_ifi] NEQ 0			! If the file is open,

;	0540	    THEN

;	0541	        BEGIN

;	0542	        fab_block [fab$v_dlt] = TRUE;			!    then set the deletion bit,

;	0543	        status = $RMS_CLOSE (				!    and ask RMS to close and delete the file.

;     P 0544	                                FAB = .fab_block);	!    Specify the address of the FAB block.

;	0545	

;	0546	        IF NOT .status					! If the close and delete fails,

;	0547	        THEN

;	0548	            file_error (				!    then report an error to the user.

;	0549	                            msg$_filnotdel,		!    Specify that file was not deleted,

;	0550	                            .fab_block);		!    and specify the address of the FAB.

;	0551	

;	0552	        fab_block [fab$v_dlt] = FALSE;			! Turn off the delete bit to avoide side effects.

;	0553	        END

;	0554	

;	0555	    ELSE

;	0556	        status = $RMS_ERASE (				! Erase the file.

;     P 0557	                                FAB = .fab_block);	!    Specify the address of the FAB block.

;	0558	

;	0559	        IF NOT .status					! If the ERASE function fails

;	0560	        THEN

;	0561	            file_error (				!    then report an error to the user.

;	0562	                            msg$_filnotdel,		!    Specify that the file was not deleted,

;	0563	                            .fab_block);		!    and give the address of the FAB block.

;	0564	

;	0565	!

;	0566	! If the deletion worked, and the /LOG qualifier was given, report the deletion.

;	0567	!

;	0568	

;	0569	    IF .status AND .del$cli_status [log_msg_bit]

;	0570	    THEN						! If successful deletion and logging going on,

;	0571	        BEGIN						!    then report the deletion.

;	0572	

;	0573	        LOCAL



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 4-3

; Digital Equipment Corporation

;

;	0574	            name_desc	: VECTOR [2];			! String descriptor for file name

;	0575	

;	0576	        name_desc [0] = .nam_block [nam$b_rsl];		! Load the length and address of the

;	0577	        name_desc [1] = .nam_block [nam$l_rsa];		! file into the string descriptor.

;	0578	        put_messagex (					! and output the message.

;     P 0579	                        msg$_deleted,			!    This is the message number,

;     P 0580	                        1,				!    one argument coming, which is

;     P 0581	                        name_desc);			!    the file name descriptor.

;	0582	        END;

;	0583	

;	0584	    END;







							    .GLOBL  SYS$CLOSE, SYS$ERASE



					 0E1C 00096 DELETE_FILE:

							    .WORD   Save R2,R3,R4,R9,R10,R11				      ; 0409

		         59	0000G  CF  9E 00098 	    MOVAB   DEL$MSG_NUMBER, R9					      ;

		         5A 00000000G  9F  9E 0009D 	    MOVAB   @#SYS$CLOSE, R10					      ;

		         5B	0000G  CF  9E 000A4 	    MOVAB   DEL$CLI_STATUS, R11					      ;

		         5E	       08  C2 000A9 	    SUBL2   #8, SP						      ;

		         52	  04   AC  D0 000AC 	    MOVL    FAB_BLOCK, R2					      ; 0470

		         53	  28   A2  D0 000B0 	    MOVL    40(R2), R3						      ; 0463

	   12	         6B	       04  E1 000B4 	    BBC     #4, DEL$CLI_STATUS, 1$				      ; 0479

				       52  DD 000B8 	    PUSHL   R2							      ; 0482

		  0000G  CF	       01  FB 000BA 	    CALLS   #1, DEL$SEARCH_FIL					      ;

		         54	       50  D0 000BF 	    MOVL    R0, STATUS						      ;

		         7C	       54  E9 000C2 	    BLBC    STATUS, 10$						      ; 0484

		         03	       54  D1 000C5 	    CMPL    STATUS, #3						      ; 0485

				       24  13 000C8 	    BEQL    4$							      ;

	   04	         6B	       06  E0 000CA 1$:     BBS     #6, DEL$CLI_STATUS, 2$				      ; 0496

	   0B	         6B	       07  E1 000CE 	    BBC     #7, DEL$CLI_STATUS, 3$				      ; 0497

				       52  DD 000D2 2$:     PUSHL   R2							      ; 0500

		  0000V  CF	       01  FB 000D4 	    CALLS   #1, CHECK_DATE					      ;

		         01	       50  E8 000D9 	    BLBS    R0, 3$						      ;

					   04 000DC 	    RET     							      ;

	   1D	         6B	       02  E1 000DD 3$:     BBC     #2, DEL$CLI_STATUS, 6$				      ; 0511

				       52  DD 000E1 	    PUSHL   R2							      ; 0514

		  0000V  CF	       01  FB 000E3 	    CALLS   #1, CONFIRM_DELETE					      ;

		         13	       50  E8 000E8 	    BLBS    R0, 6$						      ;

				  02   A2  B5 000EB 	    TSTW    2(R2)						      ; 0523

				       01  12 000EE 4$:     BNEQ    5$							      ;

					   04 000F0 	    RET     							      ;

				0000V  CF  9F 000F1 5$:     PUSHAB  CLOSE_ERROR						      ; 0527

				       52  DD 000F5 	    PUSHL   R2							      ;

		         6A	       02  FB 000F7 	    CALLS   #2, SYS$CLOSE					      ;

		         54	       50  D0 000FA 	    MOVL    R0, STATUS						      ;

					   04 000FD 	    RET     							      ; 0528

				  02   A2  B5 000FE 6$:     TSTW    2(R2)						      ; 0539

				       23  13 00101 	    BEQL    8$							      ;

		    05   A2	  80   8F  88 00103 	    BISB2   #128, 5(R2)						      ; 0542

				       52  DD 00108 	    PUSHL   R2							      ; 0544

		         6A	       01  FB 0010A 	    CALLS   #1, SYS$CLOSE					      ;

		         54	       50  D0 0010D 	    MOVL    R0, STATUS						      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 4-4

; Digital Equipment Corporation

;

		         0C	       54  E8 00110 	    BLBS    STATUS, 7$						      ; 0546

				       52  DD 00113 	    PUSHL   R2							      ; 0548

		         7E	11F0   8F  3C 00115 	    MOVZWL  #4592, -(SP)					      ;

		  0000V  CF	       02  FB 0011A 	    CALLS   #2, FILE_ERROR					      ;

		    05   A2	  80   8F  8A 0011F 7$:     BICB2   #128, 5(R2)						      ; 0552

				       0C  11 00124 	    BRB     9$							      ; 0539

				       52  DD 00126 8$:     PUSHL   R2							      ; 0557

	      00000000G  9F	       01  FB 00128 	    CALLS   #1, @#SYS$ERASE					      ;

		         54	       50  D0 0012F 	    MOVL    R0, STATUS						      ;

		         0F	       54  E8 00132 9$:     BLBS    STATUS, 11$						      ; 0559

				       52  DD 00135 	    PUSHL   R2							      ; 0561

		         7E	11F0   8F  3C 00137 	    MOVZWL  #4592, -(SP)					      ;

		  0000V  CF	       02  FB 0013C 	    CALLS   #2, FILE_ERROR					      ;

		         4F	       54  E9 00141 10$:    BLBC    STATUS, 13$						      ; 0569

	   4B	         6B	       01  E1 00144 11$:    BBC     #1, DEL$CLI_STATUS, 13$				      ;

		         6E	  03   A3  9A 00148 	    MOVZBL  3(R3), NAME_DESC					      ; 0576

		    04   AE	  04   A3  D0 0014C 	    MOVL    4(R3), NAME_DESC+4					      ; 0577

		         7E	1203   8F  3C 00151 	    MOVZWL  #4611, -(SP)					      ; 0581

		         69	       01  FB 00156 	    CALLS   #1, DEL$MSG_NUMBER					      ;

	   00	         50	       01  7A 00159 	    EMUL    #1, R0, #0, -(SP)					      ;

				       7E     0015D									      ;

	   50	         8E	       08  7B 0015E 	    EDIV    #8, (SP)+, R0, R0					      ;

				       50     00162									      ;

		         04	       50  D1 00163 	    CMPL    R0, #4						      ;

				       16  13 00166 	    BEQL    12$							      ;

				       5E  DD 00168 	    PUSHL   SP							      ;

				       01  DD 0016A 	    PUSHL   #1							      ;

		         7E	1203   8F  3C 0016C 	    MOVZWL  #4611, -(SP)					      ;

		         69	       01  FB 00171 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 00174 	    PUSHL   R0							      ;

	      00000000G  00	       03  FB 00176 	    CALLS   #3, LIB$SIGNAL					      ;

					   04 0017D 	    RET     							      ;

				       5E  DD 0017E 12$:    PUSHL   SP							      ;

				       01  DD 00180 	    PUSHL   #1							      ;

		         7E	1203   8F  3C 00182 	    MOVZWL  #4611, -(SP)					      ;

		         69	       01  FB 00187 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 0018A 	    PUSHL   R0							      ;

	      00000000G  00	       03  FB 0018C 	    CALLS   #3, LIB$STOP					      ;

					   04 00193 13$:    RET     							      ; 0409



; Routine Size:  254 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 5

; Digital Equipment Corporation

;

;	0585	ROUTINE check_wildcards (nam_block) =			! Validate wildcards and version numbers.

;	0586	

;	0587	!++

;	0588	! Functional description

;	0589	!

;	0590	!	This routine validates the version number specification. Then it sets a bit in

;	0591	!	the status word if any wildcards are present in the specification.

;	0592	!

;	0593	!	The rule is that the DELETE command requires explicit or wildcard version number

;	0594	!	specification, whereas the PURGE command does NOT allow any version number

;	0595	!	specification. Note that for file specifications that are network quoted

;	0596	!	strings, no wildcard or explicit version number is needed for DELETE.

;	0597	!

;	0598	!	If specifications are improper for the command given, an error is signaled and

;	0599	!	an error return taken.

;	0600	!

;	0601	! Calling sequence

;	0602	!

;	0603	!	check_wildcards (nam_block.ra.v)

;	0604	!

;	0605	! Input parameters

;	0606	!

;	0607	!	nam_block	- the NAM block for the file specification being checked

;	0608	!

;	0609	! Implicit inputs

;	0610	!

;	0611	!	The file specification associated with the NAM block has been PARSED with an RMS function call.

;	0612	!

;	0613	!	The following fields in the NAM block are read:

;	0614	!

;	0615	!		NAM$V_WILDCARD	- wildcards are present in the specification

;	0616	!		NAM$V_WILD_VER	- a wildcard version number was given

;	0617	!		NAM$V_EXP_VER	- an explicit version number was given

;	0618	!		NAM$V_QUOTED	- a quoted file specification was given. Wildcard

;	0619	!				  specification is as yet unknown.

;	0620	!

;	0621	!	The PURGE_CMD_BIT in DEL$CLI_STATUS is read to determine whether the

;	0622	!		command given was a DELETE or a PURGE command.

;	0623	!

;	0624	! Output parameters

;	0625	!

;	0626	!	none

;	0627	!

;	0628	! Implicit outputs

;	0629	!

;	0630	!	The WILDCARD_BIT in DEL$CLI_STATUS is set if wildcards are present in the specification.

;	0631	!

;	0632	! Routine value

;	0633	!

;	0634	!	TRUE	- all settings are valid

;	0635	!	FALSE	- invalid setting

;	0636	!

;	0637	! Side effects

;	0638	!

;	0639	!	If any part of the specification is seen to be invalid, then an error is signaled.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 5-1

; Digital Equipment Corporation

;

;	0640	!

;	0641	!--

;	0642	

;	0643	    BEGIN

;	0644	

;	0645	    MAP

;	0646	        nam_block	: REF BLOCK [, BYTE];

;	0647	

;	0648	!

;	0649	! Don't allow version number specification for a PURGE command.

;	0650	!

;	0651	

;	0652	    IF .del$cli_status [purge_cmd_bit]			! If this is a PURGE command,

;	0653	    THEN

;	0654	        BEGIN

;	0655	        IF .nam_block [nam$v_wild_ver] OR		!    then look for version number

;	0656	            .nam_block [nam$v_exp_ver]			!    specification.

;	0657	        THEN

;	0658	            BEGIN

;	0659	            put_message (msg$_purgever);		! If present, signal an error,

;	0660	            RETURN FALSE;				!    and return an error status code.

;	0661	            END;

;	0662	        END

;	0663	

;	0664	!

;	0665	! A DELETE command, to the contrary, requires an explicit or wildcard version number.

;	0666	!

;	0667	

;	0668	    ELSE

;	0669	        BEGIN

;	0670	        IF NOT .nam_block [nam$v_wild_ver] AND		! If an explicit or wildcard version

;	0671	            NOT .nam_block [nam$v_exp_ver] AND		!    number is not present,

;	0672	            NOT .nam_block [nam$v_quoted]		!    and the file specification is not quoted,

;	0673	        THEN

;	0674	            BEGIN

;	0675	            put_message (msg$_delver);			!    then signal an error,

;	0676	            RETURN FALSE;				!    and return an error status code.

;	0677	            END;

;	0678	        END;

;	0679	

;	0680	!

;	0681	! If wildcards are present, set a flag.

;	0682	!

;	0683	

;	0684	    IF .nam_block [nam$v_wildcard]			! If a wildcard is present in the specification

;	0685	    THEN

;	0686	        del$cli_status [wildcard_bit] = TRUE;		!    then set a flag in the status word.

;	0687	

;	0688	!

;	0689	! Arrival here means that no invalid specifications were noticed.

;	0690	!

;	0691	

;	0692	    RETURN TRUE;					! Return a success code.

;	0693	

;	0694	    END;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 5-2

; Digital Equipment Corporation

;











					 0004 00194 CHECK_WILDCARDS:

							    .WORD   Save R2						      ; 0585

	   52	    04   AC	       34  C1 00196 	    ADDL3   #52, NAM_BLOCK, R2					      ; 0655

	   0E	  0000G  CF	       05  E1 0019B 	    BBC     #5, DEL$CLI_STATUS, 2$				      ; 0652

	   03	         62	       03  E0 001A1 	    BBS     #3, (R2), 1$					      ; 0655

		         27	       62  E9 001A5 	    BLBC    (R2), 4$						      ; 0656

		         7E	1212   8F  3C 001A8 1$:     MOVZWL  #4626, -(SP)					      ; 0659

				       10  11 001AD 	    BRB     3$							      ;

	   1C	         62	       03  E0 001AF 2$:     BBS     #3, (R2), 4$					      ; 0670

		         19	       62  E8 001B3 	    BLBS    (R2), 4$						      ; 0671

	   15	         62	       12  E0 001B6 	    BBS     #18, (R2), 4$					      ; 0672

		         7E	120A   8F  3C 001BA 	    MOVZWL  #4618, -(SP)					      ; 0675

		  0000G  CF	       01  FB 001BF 3$:     CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 001C4 	    PUSHL   R0							      ;

	      00000000G  00	       01  FB 001C6 	    CALLS   #1, LIB$SIGNAL					      ;

				       0D  11 001CD 	    BRB     6$							      ; 0676

		         05	  01   A2  E9 001CF 4$:     BLBC    1(R2), 5$						      ; 0684

		  0000G  CF	       10  88 001D3 	    BISB2   #16, DEL$CLI_STATUS					      ; 0686

		         50	       01  D0 001D8 5$:     MOVL    #1, R0						      ; 0692

					   04 001DB 	    RET     							      ;

				       50  D4 001DC 6$:     CLRL    R0							      ; 0585

					   04 001DE 	    RET     							      ;



; Routine Size:  75 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6

; Digital Equipment Corporation

;

;	0695	ROUTINE check_date (fab_block) =			! Selects file for deletion based on date comparison

;	0696	

;	0697	!++

;	0698	! Functional description

;	0699	!

;	0700	!	This routine decides whether a file can be deleted by comparing one of the file's date

;	0701	!	values with prespecified dates from the command line. The date value chosen is the

;	0702	!	creation date, the revision date, and/or the expiration date. Which date is used is based

;	0703	!	on the user having said /CREATE, /MODIFY, and/or /EXPIRE, or on the default date selection.

;	0704	!

;	0705	!	The appropriate date is compared with dates specified in the command line. If the

;	0706	!	user said /BEFORE, the file is a candidate for deletion if the selected date is previous

;	0707	!	in time to the specified date. If the user said /SINCE, the file is a candidate for deletion

;	0708	!	if the selected date is later than the specified date.

;	0709	!

;	0710	!	This routine returns a true value if the file is a candidate for deletion.

;	0711	!

;	0712	! Calling sequence

;	0713	!

;	0714	!	check_date (fab_block.ra.v)

;	0715	!

;	0716	! Input parameters

;	0717	!

;	0718	!	fab_block	- the FAB block associated with the file specification

;	0719	!

;	0720	! Implicit inputs

;	0721	!

;	0722	!	Fields in the associated XABDAT block.

;	0723	!

;	0724	!		CDT0	- high bits of creation date

;	0725	!		CDT4	- low bits of creation date

;	0726	!		EDT0	- high bits of expiration date

;	0727	!		EDT4	- low bits of expiration date

;	0728	!		RDT0	- high bits of modification date

;	0729	!		RDT4	- low bits of modification date

;	0730	!

;	0731	!	del$before_date	- Specified /BEFORE date.

;	0732	!	del$since_date	- Specified /SINCE date.

;	0733	!

;	0734	! Output parameters

;	0735	!

;	0736	!	none

;	0737	!

;	0738	! Implicit outputs

;	0739	!

;	0740	!	none

;	0741	!

;	0742	! Routine value

;	0743	!

;	0744	!	TRUE	- file is to be deleted

;	0745	!	FALSE	- file is not to be deleted

;	0746	!

;	0747	! Side effects

;	0748	!

;	0749	!	none



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-1

; Digital Equipment Corporation

;

;	0750	!

;	0751	!--

;	0752	

;	0753	    BEGIN

;	0754	

;	0755	    MAP

;	0756	        fab_block	: REF BLOCK [, BYTE];

;	0757	

;	0758	    BIND

;	0759	        xabdat_block	=				! Associated XABDAT block

;	0760	                .fab_block [fab$l_xab]	: BLOCK [, BYTE];

;	0761	

;	0762	    LOCAL

;	0763	        status,						! Holds RMS status codes

;	0764	        earlier,					! Boolean, says /BEFORE was true

;	0765	        later,						! Boolean, says /SINCE was true

;	0766	        xab_high_offset,				! Offset to high-bit XAB date field

;	0767	        xab_low_offset;					! Offset to low-bit XAB date field

;	0768	

;	0769	    MACRO

;	0770	        offset_value (o, p, s, e) = o%,			! Get offset field from a field macro.

;	0771	        pos_siz_ext (o, p, s, e) = p, s, e%,		! Get position, size, and extension fields from a

;	0772								!    field macro.

;	0773	        high_date	= 4, 0, 32, 0%,			! High-bits in specified date

;	0774	        low_date	= 0, 0, 32, 0%;			! Low-bits in specified date

;	0775	

;	0776	!

;	0777	! First open the current file so that the XABDAT fields are filled in.

;	0778	! If the OPEN fails, signal a message, and return FALSE so that the file is not deleted.

;	0779	!

;	0780	

;	0781	    status = $RMS_OPEN (				! Open the file.

;     P 0782	                        FAB = .fab_block,		!    Specify the address of the FAB

;     P 0783	                        ERR = del$del_error);		!    and an error action routine.

;	0784	

;	0785	    IF NOT .status					! If the open fails,

;	0786	    THEN

;	0787	        RETURN FALSE;					!    then return with indication of no delete.

;	0788	

;	0789	    status = $RMS_CLOSE (				! Close the file too.

;     P 0790	                            FAB = .fab_block,		!    Specify the address of the FAB

;     P 0791	                            ERR = close_error);		!    and an error action routine.

;	0792	

;	0793	    IF NOT .status					! If the CLOSE fails,

;	0794	    THEN

;	0795	        RETURN FALSE;					!    then return with no delete indication.

;	0796	

;	0797	!

;	0798	! For each date that the user said to check, decide whether the file's related date value

;	0799	! indicates that the file should be deleted.

;	0800	!

;	0801	

;	0802	    SELECT TRUE OF

;	0803	        SET

;	0804	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-2

; Digital Equipment Corporation

;

;	0805	        [.del$cli_status [create_bit]]:			! Creation date

;	0806	

;	0807	            BEGIN

;	0808	            earlier = FALSE;				! Initialize Boolean date matches

;	0809	            later = FALSE;				!    for both /BEFORE and /SINCE.

;	0810	

;	0811	!

;	0812	! If the user said /BEFORE, and the file's creation date is previous to the specified

;	0813	! date, then set Boolean indicator that /BEFORE was satisfied.

;	0814	!

;	0815	

;	0816	            IF .del$cli_status [before_bit]		! If /BEFORE was specified,

;	0817	            THEN

;	0818	                BEGIN

;	0819	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0820	                    offset_value (xab$l_cdt0);		!    32-bit halves of the file's creation date.

;	0821	                xab_high_offset =

;	0822	                    offset_value (xab$l_cdt4);

;	0823	

;	0824	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_cdt0)]

;	0825	                    LSSU .del$before_date [high_date])	! If the creation high date value is earlier

;	0826	                THEN

;	0827	                    earlier = TRUE			!    then the /BEFORE condition is met.

;	0828	                ELSE

;	0829	                    BEGIN

;	0830	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_cdt0)]

;	0831	                        EQLU .del$before_date [high_date])

;	0832	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_cdt0)]

;	0833	                        LSSU .del$before_date [low_date])

;	0834								!    than the specified /BEFORE date,

;	0835	                    THEN

;	0836	                        earlier = TRUE;			!    then set the /BEFORE condition Boolean.

;	0837	                    END;

;	0838	                END;

;	0839	

;	0840	!

;	0841	! If the user said /SINCE, and the file's creation date is later than the specified

;	0842	! date, and the /BEFORE condition was satisfied, then return with an indication to delete the file.

;	0843	!

;	0844	

;	0845	            IF .del$cli_status [since_bit]		! If /SINCE was specified,

;	0846	            THEN

;	0847	                BEGIN

;	0848	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0849	                    offset_value (xab$l_cdt0);		!    32-bit halves of the file's creation date.

;	0850	                xab_high_offset =

;	0851	                    offset_value (xab$l_cdt4);

;	0852	

;	0853	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_cdt0)]

;	0854	                    GTRU .del$since_date [high_date])	! If the file's high date is later than the

;	0855	                THEN

;	0856	                    later = TRUE			!    /SINCE high date, then the /SINCE condition is met.

;	0857	                ELSE

;	0858	                    BEGIN

;	0859	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_cdt0)]



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-3

; Digital Equipment Corporation

;

;	0860	                        EQLU .del$since_date [high_date])

;	0861								! Otherwise, if high date is equal, and low

;	0862	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_cdt0)]

;	0863	                        GTRU .del$since_date [low_date])!    date is greater,

;	0864	                    THEN

;	0865	                        later = TRUE;			!    then the /SINCE condition is met.

;	0866	                    END;

;	0867	                END;

;	0868	

;	0869	            IF (.earlier OR				! If the /BEFORE condition is met,

;	0870	                NOT .del$cli_status [before_bit])	!    or /BEFORE was not specified,

;	0871	                AND (.later OR				!    and the /SINCE condition is met,

;	0872	                NOT .del$cli_status [since_bit])	!    or /SINCE was not specified,

;	0873	            THEN

;	0874	                RETURN TRUE;				!    then delete the file.

;	0875	            END;

;	0876	

;	0877	

;	0878	        [.del$cli_status [modify_bit]]:			! Revision date

;	0879	

;	0880	            BEGIN

;	0881	            earlier = FALSE;				! Initialize Boolean date matches

;	0882	            later = FALSE;				!    for both /BEFORE and /SINCE.

;	0883	

;	0884	!

;	0885	! If the user said /BEFORE, and the file's revision date is previous to the specified

;	0886	! date, then set Boolean indicator that /BEFORE was satisfied.

;	0887	!

;	0888	

;	0889	            IF .del$cli_status [before_bit]		! If /BEFORE was specified,

;	0890	            THEN

;	0891	                BEGIN

;	0892	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0893	                    offset_value (xab$l_rdt0);		!    32-bit halves of the file's revision date.

;	0894	                xab_high_offset =

;	0895	                    offset_value (xab$l_rdt4);

;	0896	

;	0897	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_rdt0)]

;	0898	                    LSSU .del$before_date [high_date])	! If the revision high date value is earlier

;	0899	                THEN

;	0900	                    earlier = TRUE			!    then the /BEFORE condition is met.

;	0901	                ELSE

;	0902	                    BEGIN

;	0903	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_rdt0)]

;	0904	                        EQLU .del$before_date [high_date])

;	0905	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_rdt0)]

;	0906	                        LSSU .del$before_date [low_date])

;	0907								!    than the specified /BEFORE date,

;	0908	                    THEN

;	0909	                        earlier = TRUE;			!    then set the /BEFORE condition Boolean.

;	0910	                    END;

;	0911	                END;

;	0912	

;	0913	!

;	0914	! If the user said /SINCE, and the file's revision date is later than the specified



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-4

; Digital Equipment Corporation

;

;	0915	! date, and the /BEFORE condition was satisfied, then return with an indication to delete the file.

;	0916	!

;	0917	

;	0918	            IF .del$cli_status [since_bit]		! If /SINCE was specified,

;	0919	            THEN

;	0920	                BEGIN

;	0921	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0922	                    offset_value (xab$l_rdt0);		!    32-bit halves of the file's revision date.

;	0923	                xab_high_offset =

;	0924	                    offset_value (xab$l_rdt4);

;	0925	

;	0926	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_rdt0)]

;	0927	                    GTRU .del$since_date [high_date])	! If the file's high date is later than the

;	0928	                THEN

;	0929	                    later = TRUE			!    /SINCE high date, then the /SINCE condition is met.

;	0930	                ELSE

;	0931	                    BEGIN

;	0932	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_rdt0)]

;	0933	                        EQLU .del$since_date [high_date])

;	0934								! Otherwise, if high date is equal, and low

;	0935	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_rdt0)]

;	0936	                        GTRU .del$since_date [low_date])!    date is greater,

;	0937	                    THEN

;	0938	                        later = TRUE;			!    then the /SINCE condition is met.

;	0939	                    END;

;	0940	                END;

;	0941	

;	0942	            IF (.earlier OR				! If the /BEFORE condition is met,

;	0943	                NOT .del$cli_status [before_bit])	!    or /BEFORE was not specified,

;	0944	                AND (.later OR				!    and the /SINCE condition is met,

;	0945	                NOT .del$cli_status [since_bit])	!    or /SINCE was not specified,

;	0946	            THEN

;	0947	                RETURN TRUE;				!    then delete the file.

;	0948	            END;

;	0949	

;	0950	

;	0951	        [.del$cli_status [expire_bit]]:			! Expiration date

;	0952	

;	0953	

;	0954	            BEGIN

;	0955	            earlier = FALSE;				! Initialize Boolean date matches

;	0956	            later = FALSE;				!    for both /BEFORE and /SINCE.

;	0957	

;	0958	!

;	0959	! If the user said /BEFORE, and the file's expiration date is previous to the specified

;	0960	! date, then set Boolean indicator that /BEFORE was satisfied.

;	0961	!

;	0962	

;	0963	            IF .del$cli_status [before_bit]		! If /BEFORE was specified,

;	0964	            THEN

;	0965	                BEGIN

;	0966	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0967	                    offset_value (xab$l_edt0);		!    32-bit halves of the file's expiration date.

;	0968	                xab_high_offset =

;	0969	                    offset_value (xab$l_edt4);



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-5

; Digital Equipment Corporation

;

;	0970	

;	0971	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_edt0)]

;	0972	                    LSSU .del$before_date [high_date])	! If the expiration high date value is earlier

;	0973	                THEN

;	0974	                    earlier = TRUE			!    then the /BEFORE condition is met.

;	0975	                ELSE

;	0976	                    BEGIN

;	0977	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_edt0)]

;	0978	                        EQLU .del$before_date [high_date])

;	0979	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_edt0)]

;	0980	                        LSSU .del$before_date [low_date])

;	0981								!    than the specified /BEFORE date,

;	0982	                    THEN

;	0983	                        earlier = TRUE;			!    then set the /BEFORE condition Boolean.

;	0984	                    END;

;	0985	                END;

;	0986	

;	0987	!

;	0988	! If the user said /SINCE, and the file's expiration date is later than the specified

;	0989	! date, and the /BEFORE condition was satisfied, then return with an indication to delete the file.

;	0990	!

;	0991	

;	0992	            IF .del$cli_status [since_bit]		! If /SINCE was specified,

;	0993	            THEN

;	0994	                BEGIN

;	0995	                xab_low_offset =			!    calculate the byte offset of the high and low

;	0996	                    offset_value (xab$l_edt0);		!    32-bit halves of the file's expiration date.

;	0997	                xab_high_offset =

;	0998	                    offset_value (xab$l_edt4);

;	0999	

;	1000	                IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_edt0)]

;	1001	                    GTRU .del$since_date [high_date])	! If the file's high date is later than the

;	1002	                THEN

;	1003	                    later = TRUE			!    /SINCE high date, then the /SINCE condition is met.

;	1004	                ELSE

;	1005	                    BEGIN

;	1006	                    IF (.xabdat_block [.xab_high_offset, pos_siz_ext (xab$l_edt0)]

;	1007	                        EQLU .del$since_date [high_date])

;	1008								! Otherwise, if high date is equal, and low

;	1009	                        AND (.xabdat_block [.xab_low_offset, pos_siz_ext (xab$l_edt0)]

;	1010	                        GTRU .del$since_date [low_date])!    date is greater,

;	1011	                    THEN

;	1012	                        later = TRUE;			!    then the /SINCE condition is met.

;	1013	                    END;

;	1014	                END;

;	1015	

;	1016	            IF (.earlier OR				! If the /BEFORE condition is met,

;	1017	                NOT .del$cli_status [before_bit])	!    or /BEFORE was not specified,

;	1018	                AND (.later OR				!    and the /SINCE condition is met,

;	1019	                NOT .del$cli_status [since_bit])	!    or /SINCE was not specified,

;	1020	            THEN

;	1021	                RETURN TRUE;				!    then delete the file.

;	1022	            END;

;	1023	

;	1024	        TES;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-6

; Digital Equipment Corporation

;

;	1025	

;	1026	!

;	1027	! If the routine gets this far, no dates were appropriate for file deletion.

;	1028	! Return a status code that says don't delete the file.

;	1029	!

;	1030	

;	1031	    RETURN FALSE;					! Return no delete status code.

;	1032	

;	1033	    END;







							    .GLOBL  SYS$OPEN



					 0E1C 001DF CHECK_DATE:

							    .WORD   Save R2,R3,R4,R9,R10,R11				      ; 0695

		         59	0000G  CF  9E 001E1 	    MOVAB   DEL$SINCE_DATE+4, R9				      ;

		         5A	0000G  CF  9E 001E6 	    MOVAB   DEL$BEFORE_DATE+4, R10				      ;

		         5B	0000G  CF  9E 001EB 	    MOVAB   DEL$CLI_STATUS, R11					      ;

		         53	  04   AC  D0 001F0 	    MOVL    FAB_BLOCK, R3					      ; 0760

		         52	  24   A3  D0 001F4 	    MOVL    36(R3), R2						      ; 0753

				0000G  CF  9F 001F8 	    PUSHAB  DEL$DEL_ERROR					      ; 0783

				       53  DD 001FC 	    PUSHL   R3							      ;

	      00000000G  9F	       02  FB 001FE 	    CALLS   #2, @#SYS$OPEN					      ;

		         54	       50  D0 00205 	    MOVL    R0, STATUS						      ;

		         10	       54  E9 00208 	    BLBC    STATUS, 1$						      ; 0785

				0000V  CF  9F 0020B 	    PUSHAB  CLOSE_ERROR						      ; 0791

				       53  DD 0020F 	    PUSHL   R3							      ;

	      00000000G  9F	       02  FB 00211 	    CALLS   #2, @#SYS$CLOSE					      ;

		         54	       50  D0 00218 	    MOVL    R0, STATUS						      ;

		         03	       54  E8 0021B 1$:     BLBS    STATUS, 2$						      ; 0793

				     012C  31 0021E 	    BRW     22$							      ;

		         5E	  01   AB  E9 00221 2$:     BLBC    DEL$CLI_STATUS+1, 8$				      ; 0802

				       51  D4 00225 	    CLRL    EARLIER						      ; 0808

				       53  D4 00227 	    CLRL    LATER						      ; 0809

	   22	         6B	       07  E1 00229 	    BBC     #7, DEL$CLI_STATUS, 4$				      ; 0816

		         54	       14  D0 0022D 	    MOVL    #20, XAB_LOW_OFFSET					      ; 0819

		         50	       18  D0 00230 	    MOVL    #24, XAB_HIGH_OFFSET				      ; 0821

				     6042  9F 00233 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0824

		         6A	       9E  D1 00236 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       11  1F 00239 	    BLSSU   3$							      ;

				     6042  9F 0023B 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0830

		         6A	       9E  D1 0023E 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       0C  12 00241 	    BNEQ    4$							      ;

				     6442  9F 00243 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 0832

		    FC   AA	       9E  D1 00246 	    CMPL    @(SP)+, DEL$BEFORE_DATE				      ;

				       03  1E 0024A 	    BGEQU   4$							      ;

		         51	       01  D0 0024C 3$:     MOVL    #1, EARLIER						      ; 0836

	   22	         6B	       06  E1 0024F 4$:     BBC     #6, DEL$CLI_STATUS, 6$				      ; 0845

		         54	       14  D0 00253 	    MOVL    #20, XAB_LOW_OFFSET					      ; 0848

		         50	       18  D0 00256 	    MOVL    #24, XAB_HIGH_OFFSET				      ; 0850

				     6042  9F 00259 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0853

		         69	       9E  D1 0025C 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       11  1A 0025F 	    BGTRU   5$							      ;

				     6042  9F 00261 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0859



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-7

; Digital Equipment Corporation

;

		         69	       9E  D1 00264 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       0C  12 00267 	    BNEQ    6$							      ;

				     6442  9F 00269 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 0862

		    FC   A9	       9E  D1 0026C 	    CMPL    @(SP)+, DEL$SINCE_DATE				      ;

				       03  1B 00270 	    BLEQU   6$							      ;

		         53	       01  D0 00272 5$:     MOVL    #1, LATER						      ; 0865

		         04	       51  E8 00275 6$:     BLBS    EARLIER, 7$						      ; 0869

	   07	         6B	       07  E0 00278 	    BBS     #7, DEL$CLI_STATUS, 8$				      ; 0870

		         60	       53  E8 0027C 7$:     BLBS    LATER, 13$						      ; 0871

	   5F	         6B	       06  E1 0027F 	    BBC     #6, DEL$CLI_STATUS, 14$				      ; 0872

	   5E	    01   AB	       02  E1 00283 8$:     BBC     #2, DEL$CLI_STATUS+1, 15$				      ; 0802

				       51  D4 00288 	    CLRL    EARLIER						      ; 0881

				       53  D4 0028A 	    CLRL    LATER						      ; 0882

	   22	         6B	       07  E1 0028C 	    BBC     #7, DEL$CLI_STATUS, 10$				      ; 0889

		         54	       0C  D0 00290 	    MOVL    #12, XAB_LOW_OFFSET					      ; 0892

		         50	       10  D0 00293 	    MOVL    #16, XAB_HIGH_OFFSET				      ; 0894

				     6042  9F 00296 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0897

		         6A	       9E  D1 00299 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       11  1F 0029C 	    BLSSU   9$							      ;

				     6042  9F 0029E 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0903

		         6A	       9E  D1 002A1 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       0C  12 002A4 	    BNEQ    10$							      ;

				     6442  9F 002A6 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 0905

		    FC   AA	       9E  D1 002A9 	    CMPL    @(SP)+, DEL$BEFORE_DATE				      ;

				       03  1E 002AD 	    BGEQU   10$							      ;

		         51	       01  D0 002AF 9$:     MOVL    #1, EARLIER						      ; 0909

	   22	         6B	       06  E1 002B2 10$:    BBC     #6, DEL$CLI_STATUS, 12$				      ; 0918

		         54	       0C  D0 002B6 	    MOVL    #12, XAB_LOW_OFFSET					      ; 0921

		         50	       10  D0 002B9 	    MOVL    #16, XAB_HIGH_OFFSET				      ; 0923

				     6042  9F 002BC 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0926

		         69	       9E  D1 002BF 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       11  1A 002C2 	    BGTRU   11$							      ;

				     6042  9F 002C4 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0932

		         69	       9E  D1 002C7 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       0C  12 002CA 	    BNEQ    12$							      ;

				     6442  9F 002CC 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 0935

		    FC   A9	       9E  D1 002CF 	    CMPL    @(SP)+, DEL$SINCE_DATE				      ;

				       03  1B 002D3 	    BLEQU   12$							      ;

		         53	       01  D0 002D5 11$:    MOVL    #1, LATER						      ; 0938

		         04	       51  E8 002D8 12$:    BLBS    EARLIER, 13$					      ; 0942

	   07	         6B	       07  E0 002DB 	    BBS     #7, DEL$CLI_STATUS, 15$				      ; 0943

		         67	       53  E8 002DF 13$:    BLBS    LATER, 21$						      ; 0944

	   63	         6B	       06  E1 002E2 14$:    BBC     #6, DEL$CLI_STATUS, 21$				      ; 0945

	   62	    01   AB	       01  E1 002E6 15$:    BBC     #1, DEL$CLI_STATUS+1, 22$				      ; 0802

				       51  D4 002EB 	    CLRL    EARLIER						      ; 0955

				       53  D4 002ED 	    CLRL    LATER						      ; 0956

	   22	         6B	       07  E1 002EF 	    BBC     #7, DEL$CLI_STATUS, 17$				      ; 0963

		         54	       1C  D0 002F3 	    MOVL    #28, XAB_LOW_OFFSET					      ; 0966

		         50	       20  D0 002F6 	    MOVL    #32, XAB_HIGH_OFFSET				      ; 0968

				     6042  9F 002F9 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0971

		         6A	       9E  D1 002FC 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       11  1F 002FF 	    BLSSU   16$							      ;

				     6042  9F 00301 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 0977

		         6A	       9E  D1 00304 	    CMPL    @(SP)+, DEL$BEFORE_DATE+4				      ;

				       0C  12 00307 	    BNEQ    17$							      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 6-8

; Digital Equipment Corporation

;

				     6442  9F 00309 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 0979

		    FC   AA	       9E  D1 0030C 	    CMPL    @(SP)+, DEL$BEFORE_DATE				      ;

				       03  1E 00310 	    BGEQU   17$							      ;

		         51	       01  D0 00312 16$:    MOVL    #1, EARLIER						      ; 0983

	   22	         6B	       06  E1 00315 17$:    BBC     #6, DEL$CLI_STATUS, 19$				      ; 0992

		         54	       1C  D0 00319 	    MOVL    #28, XAB_LOW_OFFSET					      ; 0995

		         50	       20  D0 0031C 	    MOVL    #32, XAB_HIGH_OFFSET				      ; 0997

				     6042  9F 0031F 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 1000

		         69	       9E  D1 00322 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       11  1A 00325 	    BGTRU   18$							      ;

				     6042  9F 00327 	    PUSHAB  (XAB_HIGH_OFFSET)[R2]				      ; 1006

		         69	       9E  D1 0032A 	    CMPL    @(SP)+, DEL$SINCE_DATE+4				      ;

				       0C  12 0032D 	    BNEQ    19$							      ;

				     6442  9F 0032F 	    PUSHAB  (XAB_LOW_OFFSET)[R2]				      ; 1009

		    FC   A9	       9E  D1 00332 	    CMPL    @(SP)+, DEL$SINCE_DATE				      ;

				       03  1B 00336 	    BLEQU   19$							      ;

		         53	       01  D0 00338 18$:    MOVL    #1, LATER						      ; 1012

		         04	       51  E8 0033B 19$:    BLBS    EARLIER, 20$					      ; 1016

	   0B	         6B	       07  E0 0033E 	    BBS     #7, DEL$CLI_STATUS, 22$				      ; 1017

		         04	       53  E8 00342 20$:    BLBS    LATER, 21$						      ; 1018

	   04	         6B	       06  E0 00345 	    BBS     #6, DEL$CLI_STATUS, 22$				      ; 1019

		         50	       01  D0 00349 21$:    MOVL    #1, R0						      ; 1021

					   04 0034C 	    RET     							      ;

				       50  D4 0034D 22$:    CLRL    R0							      ; 0695

					   04 0034F 	    RET     							      ;



; Routine Size:  369 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 7

; Digital Equipment Corporation

;

;	1034	ROUTINE confirm_delete (fab_block) =			! See whether user wants to delete this file

;	1035	

;	1036	!++

;	1037	! Functional description

;	1038	!

;	1039	!	This routine signals the condition handler with a code signifying that

;	1040	!	confirmation to delete a file is needed. The condition handler processing

;	1041	!	causes a global variable to be set TRUE if deletion is to occur, and

;	1042	!	FALSE if deletion is not to occur. This routine also returns TRUE if deletion

;	1043	!	is to occur.

;	1044	!

;	1045	! Calling sequence

;	1046	!

;	1047	!	confirm_delete (fab_block.ra.v)

;	1048	!

;	1049	! Input parameters

;	1050	!

;	1051	!	fab_block	- the address of the FAB block associated with the file to be deleted

;	1052	!

;	1053	! Implicit inputs

;	1054	!

;	1055	!	The file associated with the FAB passed as a parameter is assumed to be OPEN.

;	1056	!	Fields in the associated NAM block are read:

;	1057	!

;	1058	!		RSL	- length of the resultant name field.

;	1059	!		RSA	- address of the resultant name field.

;	1060	!		ESL	- length of the expanded name field.

;	1061	!		ESA	- address of the expanded name field.

;	1062	!

;	1063	! Output parameters

;	1064	!

;	1065	!	none

;	1066	!

;	1067	! Implicit outputs

;	1068	!

;	1069	!	DEL_OR_NOT	- set to TRUE if deletion is to occur.

;	1070	!			- set to FALSE if deletion is not to occur.

;	1071	!

;	1072	! Routine value

;	1073	!

;	1074	!	TRUE	- if deletion

;	1075	!	FALSE	- if no deletion

;	1076	!

;	1077	! Side effects

;	1078	!

;	1079	!	A read to the terminal occurs. The prompt string is the name of the

;	1080	!	file to be deleted plus a brief question. If the read fails, a severe error

;	1081	!	is signaled.

;	1082	!

;	1083	!--

;	1084	

;	1085	    BEGIN

;	1086	

;	1087	    MAP

;	1088	        fab_block	: REF BLOCK [, BYTE];



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 7-1

; Digital Equipment Corporation

;

;	1089	

;	1090	    BIND

;	1091	        nam_block	=				! Associated NAM block address

;	1092	                .fab_block [fab$l_nam]	: BLOCK [, BYTE];

;	1093	

;	1094	    LOCAL

;	1095	        name_desc	: VECTOR [2];			! String descriptor for file name

;	1096	

;	1097	!

;	1098	! Load the file name and length into the local string descriptor.

;	1099	!

;	1100	

;	1101	    IF .nam_block [nam$b_rsl] NEQ 0			! If a resultant file name string exists,

;	1102	    THEN						!    then use it.

;	1103	        BEGIN

;	1104	        name_desc [0] = .nam_block [nam$b_rsl];		! Length of file is from RSL field of NAM block.

;	1105	        name_desc [1] = .nam_block [nam$l_rsa];		! Address is from RSA field of NAM block.

;	1106	        END

;	1107	    ELSE

;	1108	        BEGIN						! Otherwise, use expanded name string.

;	1109	        name_desc [0] = .nam_block [nam$b_esl];		! Length of file is from ESL field of NAM block.

;	1110	        name_desc [1] = .nam_block [nam$l_esa];		! Address is from ESA field of NAM block.

;	1111	        END;

;	1112	

;	1113	!

;	1114	! Signal an error, specifying the error code MSG$_CONFDEL. This message causes

;	1115	! PUTMSG to be called with an action routine that is called before the message

;	1116	! is output. This action routine does the read, and stores the answer as a setting

;	1117	! in DEL_OR_NOT. The action routine also suppresses PUTMSG's outputting of

;	1118	! the message.

;	1119	!

;	1120	

;	1121	     put_message (					! Signal the confirm message.

;     P 1122	                    msg$_confdel,			!    Specify the "confirm deletion" message code,

;     P 1123	                    1,					!    one FAO argument,

;     P 1124	                    name_desc);				!    and the FAO argument - the name of the file.

;	1125	

;	1126	!

;	1127	! If the action routine set the global variable, then return with success. Otherwise,

;	1128	! return with failure.

;	1129	!

;	1130	

;	1131	    IF .del_or_not					! If the file is to be deleted,

;	1132	    THEN

;	1133	        RETURN TRUE					!    then return with a success code,

;	1134	    ELSE

;	1135	        RETURN FALSE;					!    otherwise, return with a FALSE code.

;	1136	

;	1137	    END;











					 0000 00350 CONFIRM_DELETE:



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 7-2

; Digital Equipment Corporation

;

							    .WORD   Save nothing					      ; 1034

		         5E	       08  C2 00352 	    SUBL2   #8, SP						      ;

		         50	  04   AC  D0 00355 	    MOVL    FAB_BLOCK, R0					      ; 1092

		         50	  28   A0  D0 00359 	    MOVL    40(R0), R0						      ; 1085

				  03   A0  95 0035D 	    TSTB    3(R0)						      ; 1101

				       0B  13 00360 	    BEQL    1$							      ;

		         6E	  03   A0  9A 00362 	    MOVZBL  3(R0), NAME_DESC					      ; 1104

		    04   AE	  04   A0  D0 00366 	    MOVL    4(R0), NAME_DESC+4					      ; 1105

				       09  11 0036B 	    BRB     2$							      ; 1101

		         6E	  0B   A0  9A 0036D 1$:     MOVZBL  11(R0), NAME_DESC					      ; 1109

		    04   AE	  0C   A0  D0 00371 	    MOVL    12(R0), NAME_DESC+4					      ; 1110

				       5E  DD 00376 2$:     PUSHL   SP							      ; 1124

				       01  DD 00378 	    PUSHL   #1							      ;

		         7E	11FB   8F  3C 0037A 	    MOVZWL  #4603, -(SP)					      ;

		  0000G  CF	       01  FB 0037F 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 00384 	    PUSHL   R0							      ;

	      00000000G  00	       03  FB 00386 	    CALLS   #3, LIB$SIGNAL					      ;

		         04	0000'  CF  E9 0038D 	    BLBC    DEL_OR_NOT, 3$					      ; 1131

		         50	       01  D0 00392 	    MOVL    #1, R0						      ; 1133

					   04 00395 	    RET     							      ;

				       50  D4 00396 3$:     CLRL    R0							      ; 1034

					   04 00398 	    RET     							      ;



; Routine Size:  73 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 8

; Digital Equipment Corporation

;

;	1138	ROUTINE file_error (message_id, fab_block) : NOVALUE =	! RMS failure error action routine

;	1139	

;	1140	!++

;	1141	! Functional description

;	1142	!

;	1143	!	This RMS error action routine sends an error message to the user.

;	1144	!

;	1145	! Calling sequence

;	1146	!

;	1147	!	file_error (message_id.rv, fab_block.ra.v)

;	1148	!

;	1149	! Input parameters

;	1150	!

;	1151	!	message_id	- The message code for the message to send.

;	1152	!	fab_block	- Address of the FAB block of the file for which the error occurred

;	1153	!

;	1154	! Implicit inputs

;	1155	!

;	1156	!	Fields in the associated NAM block:

;	1157	!

;	1158	!		RSA	- the address of the resultant name string of an opened file

;	1159	!		RSL	- the length of the resultant name string

;	1160	!		ESA	- the address of the expanded name string of a parsed file

;	1161	!		ESL	- the length of the expanded name string

;	1162	!

;	1163	!	Fields in the FAB block:

;	1164	!

;	1165	!		STS	- primary RMS status code

;	1166	!		STV	- secondard RMS status code

;	1167	!

;	1168	!	INFILE_DESC	- the CLI data block for the parameter

;	1169	!

;	1170	! Output parameters

;	1171	!

;	1172	!	none

;	1173	!

;	1174	! Implicit outputs

;	1175	!

;	1176	!	none

;	1177	!

;	1178	! Routine value

;	1179	!

;	1180	!	novalue

;	1181	!

;	1182	! Side effects

;	1183	!

;	1184	!	none

;	1185	!

;	1186	!--

;	1187	

;	1188	    BEGIN

;	1189	

;	1190	    MAP

;	1191	        fab_block	: REF BLOCK [, BYTE];

;	1192	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 8-1

; Digital Equipment Corporation

;

;	1193	    BIND

;	1194	        nam_block	=				! Associated NAM block address

;	1195	                .fab_block [fab$l_nam]	: BLOCK [, BYTE];

;	1196	

;	1197	    LOCAL

;	1198	        name_desc	: VECTOR [2];			! String descriptor for the file name

;	1199	

;	1200	!

;	1201	! Fill in the file name descriptor with the most complete name possible.

;	1202	!

;	1203	

;	1204	    IF .nam_block [nam$b_rsl] NEQ 0			! If a resultant name string exists,

;	1205	    THEN						!

;	1206		BEGIN						!

;	1207		name_desc [0] = .nam_block [nam$b_rsl];		! then fill in the resultant name length

;	1208		name_desc [1] = .nam_block [nam$l_rsa];		! and address.

;	1209		END

;	1210	    ELSE

;	1211		IF .nam_block [nam$b_esl] NEQ 0			! If RMS created an expanded string

;	1212		THEN						! but couldn't open the file,

;	1213		    BEGIN					!

;	1214		    name_desc [0] = .nam_block [nam$b_esl];	! then fill in the expanded name length

;	1215		    name_desc [1] = .nam_block [nam$l_esa];	! and address.

;	1216		    END

;	1217		ELSE						! Otherwise, no RMS name information is available.

;	1218		    BEGIN

;	1219		    name_desc [0] = .infile_desc [cli$w_rqsize];! So use the file name length

;	1220		    name_desc [1] = .infile_desc [cli$a_rqaddr];! and length passed by the CLI.

;	1221		    END;

;	1222	

;	1223	!

;	1224	! Signal the error condition.

;	1225	!

;	1226	

;	1227	    put_messagex (					! Signal "input open error" with the following arguments:

;     P 1228	                    .message_id,			!    the message identifier,

;     P 1229	                    1,					!    the number of message arguments,

;     P 1230	                    name_desc,				!    the address of input name descriptor,

;     P 1231	                    .fab_block [fab$l_sts],		!    the primary RMS completion code,

;     P 1232	                    .fab_block [fab$l_stv]);		!    and the scondary RMS completion code.

;	1233	

;	1234	!

;	1235	! Return to the caller.

;	1236	!

;	1237	

;	1238	    RETURN;						! Return to the caller.

;	1239	

;	1240	    END;











					 0804 00399 FILE_ERROR:

							    .WORD   Save R2,R11						      ; 1138



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 8-2

; Digital Equipment Corporation

;

		         5B	0000G  CF  9E 0039B 	    MOVAB   DEL$MSG_NUMBER, R11					      ;

		         5E	       08  C2 003A0 	    SUBL2   #8, SP						      ;

		         52	  08   AC  D0 003A3 	    MOVL    FAB_BLOCK, R2					      ; 1195

		         50	  28   A2  D0 003A7 	    MOVL    40(R2), R0						      ; 1188

				  03   A0  95 003AB 	    TSTB    3(R0)						      ; 1204

				       0B  13 003AE 	    BEQL    1$							      ;

		         6E	  03   A0  9A 003B0 	    MOVZBL  3(R0), NAME_DESC					      ; 1207

		    04   AE	  04   A0  D0 003B4 	    MOVL    4(R0), NAME_DESC+4					      ; 1208

				       1B  11 003B9 	    BRB     3$							      ; 1204

				  0B   A0  95 003BB 1$:     TSTB    11(R0)						      ; 1211

				       0B  13 003BE 	    BEQL    2$							      ;

		         6E	  0B   A0  9A 003C0 	    MOVZBL  11(R0), NAME_DESC					      ; 1214

		    04   AE	  0C   A0  D0 003C4 	    MOVL    12(R0), NAME_DESC+4					      ; 1215

				       0B  11 003C9 	    BRB     3$							      ; 1211

		         6E	0000G  CF  3C 003CB 2$:     MOVZWL  INFILE_DESC+8, NAME_DESC				      ; 1219

		    04   AE	0000G  CF  D0 003D0 	    MOVL    INFILE_DESC+12, NAME_DESC+4				      ; 1220

				  04   AC  DD 003D6 3$:     PUSHL   MESSAGE_ID						      ; 1232

		         6B	       01  FB 003D9 	    CALLS   #1, DEL$MSG_NUMBER					      ;

	   00	         50	       01  7A 003DC 	    EMUL    #1, R0, #0, -(SP)					      ;

				       7E     003E0									      ;

	   50	         8E	       08  7B 003E1 	    EDIV    #8, (SP)+, R0, R0					      ;

				       50     003E5									      ;

		         04	       50  D1 003E6 	    CMPL    R0, #4						      ;

				       19  13 003E9 	    BEQL    4$							      ;

		         7E	  08   A2  7D 003EB 	    MOVQ    8(R2), -(SP)					      ;

				  08   AE  9F 003EF 	    PUSHAB  NAME_DESC						      ;

				       01  DD 003F2 	    PUSHL   #1							      ;

				  04   AC  DD 003F4 	    PUSHL   MESSAGE_ID						      ;

		         6B	       01  FB 003F7 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 003FA 	    PUSHL   R0							      ;

	      00000000G  00	       05  FB 003FC 	    CALLS   #5, LIB$SIGNAL					      ;

					   04 00403 	    RET     							      ;

		         7E	  08   A2  7D 00404 4$:     MOVQ    8(R2), -(SP)					      ;

				  08   AE  9F 00408 	    PUSHAB  NAME_DESC						      ;

				       01  DD 0040B 	    PUSHL   #1							      ;

				  04   AC  DD 0040D 	    PUSHL   MESSAGE_ID						      ;

		         6B	       01  FB 00410 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 00413 	    PUSHL   R0							      ;

	      00000000G  00	       05  FB 00415 	    CALLS   #5, LIB$STOP					      ;

					   04 0041C 	    RET     							      ; 1138



; Routine Size:  132 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 9

; Digital Equipment Corporation

;

;	1241	ROUTINE close_error (fab_block) : NOVALUE =		! RMS close file failure error action routine

;	1242	

;	1243	!++

;	1244	! Functional description

;	1245	!

;	1246	!	This RMS error action routine sends a file close error message to the user.

;	1247	!

;	1248	! Calling sequence

;	1249	!

;	1250	!	close_error (fab_block.ra.v)

;	1251	!

;	1252	! Input parameters

;	1253	!

;	1254	!	fab_block	- Address of the FAB block of the file that couldn't be closed.

;	1255	!

;	1256	! Implicit inputs

;	1257	!

;	1258	!	Fields in the associated NAM block:

;	1259	!

;	1260	!		RSA	- the address of the name of the opened file

;	1261	!		RSL	- the length of the name of the opened file

;	1262	!

;	1263	! Output parameters

;	1264	!

;	1265	!	none

;	1266	!

;	1267	! Implicit outputs

;	1268	!

;	1269	!	none

;	1270	!

;	1271	! Routine value

;	1272	!

;	1273	!	novalue

;	1274	!

;	1275	! Side effects

;	1276	!

;	1277	!	none

;	1278	!

;	1279	!--

;	1280	

;	1281	    BEGIN

;	1282	

;	1283	    MAP

;	1284	        fab_block	: REF BLOCK [, BYTE];

;	1285	

;	1286	    BIND

;	1287	        nam_block	=				! Associated NAM block address

;	1288	                .fab_block [fab$l_nam]	: BLOCK [, BYTE];

;	1289	

;	1290	    LOCAL

;	1291	        name_desc	: VECTOR [2];			! String descriptor for the file name

;	1292	

;	1293	!

;	1294	! Set up a string descriptor that describes that file that couldn't be closed.

;	1295	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 9-1

; Digital Equipment Corporation

;

;	1296	

;	1297	    name_desc [0] = .nam_block [nam$b_rsl];		! The length is the resultant name length.

;	1298	    name_desc [1] = .nam_block [nam$l_rsa];		! The address, the resultant name address.

;	1299	

;	1300	!

;	1301	! Signal a close error.

;	1302	!

;	1303	

;	1304	    put_message (					! Signal a "delete error" with the following arguments:

;     P 1305	                    msg$_closedel,			!    a "file not closed" error,

;     P 1306	                    1,					!    the number of message arguments,

;     P 1307	                    name_desc,				!    the address of file name descriptor,

;     P 1308	                    .fab_block [fab$l_sts],		!    the primary RMS completion code,

;     P 1309	                    .fab_block [fab$l_stv]);		!    and the secondary RMS completion code.

;	1310	

;	1311	!

;	1312	! Return to the caller.

;	1313	!

;	1314	

;	1315	    RETURN;						! Return to the caller.

;	1316	

;	1317	    END;











					 0000 0041D CLOSE_ERROR:

							    .WORD   Save nothing					      ; 1241

		         5E	       04  C2 0041F 	    SUBL2   #4, SP						      ;

		         51	  04   AC  D0 00422 	    MOVL    FAB_BLOCK, R1					      ; 1288

		         50	  28   A1  D0 00426 	    MOVL    40(R1), R0						      ; 1281

		         7E	  03   A0  9A 0042A 	    MOVZBL  3(R0), NAME_DESC					      ; 1297

		    04   AE	  04   A0  D0 0042E 	    MOVL    4(R0), NAME_DESC+4					      ; 1298

		         7E	  08   A1  7D 00433 	    MOVQ    8(R1), -(SP)					      ; 1309

				  08   AE  9F 00437 	    PUSHAB  NAME_DESC						      ;

				       01  DD 0043A 	    PUSHL   #1							      ;

		         7E	1218   8F  3C 0043C 	    MOVZWL  #4632, -(SP)					      ;

		  0000G  CF	       01  FB 00441 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 00446 	    PUSHL   R0							      ;

	      00000000G  00	       05  FB 00448 	    CALLS   #5, LIB$SIGNAL					      ;

					   04 0044F 	    RET     							      ; 1241



; Routine Size:  51 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 10

; Digital Equipment Corporation

;

;	1318	ROUTINE condit_handler (signal_array, mechan_array) =	! Condition handler for DELETE utility

;	1319	

;	1320	!++

;	1321	! Functional description

;	1322	!

;	1323	!	This condition handler is called because a condition has been signaled by

;	1324	!	the DELETE utility. This handler calls SYS$PUTMSG to report the problem or

;	1325	!	information. Then the signal code is examined for severity level. Severe errors

;	1326	!	are resignaled. These subsequently cause the program to halt through the actions

;	1327	!	of LIB$STOP (a library routine). All other errors cause the condition handler to

;	1328	!	return a continue code, which continues the execution of the DELETE utility.

;	1329	!

;	1330	! Calling sequence

;	1331	!

;	1332	!	condit_handler (signal_array.ra.v, mechan_array.ra.v)

;	1333	!

;	1334	! Input parameters

;	1335	!

;	1336	!	signal_array	- the address of the signal array for the condition

;	1337	!	mechan_array	- the address of the mechanism array for the condition

;	1338	!

;	1339	! Implicit inputs

;	1340	!

;	1341	!	The PURGE_CMD_BIT in DEL$CLI_STATUS tells whether a DELETE or a PURGE command

;	1342	!		caused this error.

;	1343	!

;	1344	! Output parameters

;	1345	!

;	1346	!	none

;	1347	!

;	1348	! Implicit outputs

;	1349	!

;	1350	!	The number of arguments listed in the signal argument list is reduced by two.

;	1351	!

;	1352	! Routine value

;	1353	!

;	1354	!	SS$_RESIGNAL	- on a severe error

;	1355	!	SS$_CONTINUE	- on a continuable error

;	1356	!

;	1357	! Side effects

;	1358	!

;	1359	!	The message is output to the device SYS$ERROR or SYS$OUTPUT.

;	1360	!

;	1361	!--

;	1362	

;	1363	    BEGIN

;	1364	

;	1365	    MAP

;	1366	        signal_array	: REF BLOCK [, BYTE];

;	1367	

;	1368	    MACRO

;	1369	        putmsg_flags	= 2, 0, 16, 0%;			! Flags for PUTMSG in signal argument list

;	1370	

;	1371	    LOCAL

;	1372	        condition_name	: BLOCK [4, BYTE],		! Temporary home for condition name



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 10-1

; Digital Equipment Corporation

;

;	1373	        confirm_msg,					! Boolean, says whether the message is just delete confirmation

;	1374	        facil_name_desc	: VECTOR [2];			! String descriptor for the message prefix

;	1375	

;	1376	!

;	1377	! Bypass system messages. We don't know how to handle them.

;	1378	!

;	1379	

;	1380	    condition_name = .signal_array [chf$l_sig_name];	! Get the condition name.

;	1381	    IF .condition_name [sts$v_fac_no] EQL 0		! If no facility name,

;	1382	    THEN

;	1383	        RETURN ss$_resignal;				!    then this is a system message. Resignal it.

;	1384	

;	1385	!

;	1386	! Remove PC and PSL from the signal argument list by reducing the argument count.

;	1387	!

;	1388	

;	1389	    signal_array [chf$l_sig_args] = 			! Reduce the length of the signal argument

;	1390	        .signal_array [chf$l_sig_args] - 2;		!    list so that PC and PSL are not included.

;	1391	    IF ((.condition_name [sts$v_msg_no] ^ 3) OR		! If this is the file deletion confirmation message,

;	1392	        .condition_name [sts$v_severity])		!    then don't output a facility name.

;	1393	        EQL msg$_confdel

;	1394	    THEN

;	1395	        confirm_msg = TRUE				! Set flag that this is just delete confirmation.

;	1396	    ELSE

;	1397	        confirm_msg = FALSE;				!    Otherwise, set flag to FALSE.

;	1398	

;	1399	    IF .confirm_msg					! If confirming the deletion of a file,

;	1400	    THEN

;	1401	        signal_array [putmsg_flags] = 1;		! Set PUTMSG flags to suppress facility and severity.

;	1402	

;	1403	!

;	1404	! Create a string descriptor for the facility name. These are "PURGE" or "DELETE".

;	1405	! Don't do this for the file confirmation message.

;	1406	!

;	1407	

;	1408	    IF NOT .confirm_msg					! If this is an average message, not confirmation

;	1409	    THEN

;	1410	        BEGIN

;	1411	        IF .del$cli_status [purge_cmd_bit]		! If this is a PURGE command,

;	1412	        THEN

;	1413	            BEGIN

;	1414	            facil_name_desc [1] =			!    set up for a "PURGE" prefix.

;	1415	                 UPLIT BYTE (%ASCII 'PURGE');

;	1416	            facil_name_desc [0] = 5;			!    Length is five characters.

;	1417	            END

;	1418	        ELSE

;	1419	            BEGIN

;	1420	            facil_name_desc [1] =			! Otherwise, set up for a "DELETE" prefix.

;	1421	                UPLIT BYTE (%ASCII 'DELETE');

;	1422	            facil_name_desc [0] = 6;			! Length is six characters.

;	1423	            END;

;	1424	        END;

;	1425	

;	1426	!

;	1427	! Now output the message. If this is a "confirm whether or not to delete this file"



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 10-2

; Digital Equipment Corporation

;

;	1428	! message, then specify an action routine. The action routine actually outputs the

;	1429	! message and waits for input. Otherwise, just let PUTMSG do its work.

;	1430	!

;	1431	

;	1432	    sys$putmsg (					! Output the message.

;	1433	                .signal_array,				!    Pass the address of the signal list;

;	1434	                (IF .confirm_msg			!    if confirmation message,

;	1435	                 THEN

;	1436	                     get_confirm			!    then specify an action routine;

;	1437	                 ELSE

;	1438	                     0),				!    otherwise, no action routine;

;	1439	                (IF .confirm_msg			!    again, if confirmation,

;	1440	                 THEN

;	1441	                     0					!    then no facility name descriptor;

;	1442	                 ELSE

;	1443	                     facil_name_desc)			!    otherwise, specify descriptor of facility name.

;	1444	                );

;	1445	

;	1446	!

;	1447	! If this was a severe error, then resignal the exception. Otherwise, continue from

;	1448	! this condition back into the normal program execution.

;	1449	!

;	1450	

;	1451	    IF .signal_array [chf$l_sig_name] MOD 8		! If the message is severe,

;	1452	        EQL sts$k_severe

;	1453	    THEN

;	1454	        RETURN ss$_resignal				!    then resignal the error;

;	1455	    ELSE

;	1456	        RETURN ss$_continue;				!    otherwise, continue as before.

;	1457	

;	1458	    END;







							    .PSECT  $PLIT$,NOWRT,NOEXE,2



					      00000 P.AAA:  .ASCII  \PURGE\						      ;

					      00005	    .BLKB   3

					      00008 P.AAB:  .ASCII  \DELETE\						      ;

					      0000E	    .BLKB   2







							    .PSECT  $CODE$,NOWRT,2



					 000C 00450 CONDIT_HANDLER:

							    .WORD   Save R2,R3						      ; 1318

		         5E	       08  C2 00452 	    SUBL2   #8, SP						      ;

		         52	  04   AC  D0 00455 	    MOVL    SIGNAL_ARRAY, R2					      ; 1380

		         51	  04   A2  D0 00459 	    MOVL    4(R2), CONDITION_NAME				      ;

	   51	         0C	       10  ED 0045D 	    CMPZV   #16, #12, CONDITION_NAME, #0			      ; 1381

				       00     00461									      ;

				       7B  13 00462 	    BEQL    11$							      ;

		         62	       02  C2 00464 	    SUBL2   #2, (R2)						      ; 1390

	   51	         0D	       03  EF 00467 	    EXTZV   #3, #13, CONDITION_NAME, R0				      ; 1391



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 10-3

; Digital Equipment Corporation

;

				       50     0046B									      ;

	   50	         50	       03  78 0046C 	    ASHL    #3, R0, R0						      ;

	   51	         03	       00  EF 00470 	    EXTZV   #0, #3, CONDITION_NAME, R3				      ;

				       53     00474									      ;

		         50	       53  C8 00475 	    BISL2   R3, R0						      ;

	      000011FB   8F	       50  D1 00478 	    CMPL    R0, #4603						      ; 1393

				       05  12 0047F 	    BNEQ    1$							      ;

		         51	       01  D0 00481 	    MOVL    #1, CONFIRM_MSG					      ; 1395

				       02  11 00484 	    BRB     2$							      ; 1391

				       51  D4 00486 1$:     CLRL    CONFIRM_MSG						      ; 1397

		         07	       51  E9 00488 2$:     BLBC    CONFIRM_MSG, 3$					      ; 1399

		    02   A2	       01  B0 0048B 	    MOVW    #1, 2(R2)						      ; 1401

		         1D	       51  E8 0048F 	    BLBS    CONFIRM_MSG, 6$					      ; 1408

	   0B	  0000G  CF	       05  E1 00492 3$:     BBC     #5, DEL$CLI_STATUS, 4$				      ; 1411

		    04   AE	0000'  CF  9E 00498 	    MOVAB   P.AAA, FACIL_NAME_DESC+4				      ; 1415

		         6E	       05  D0 0049E 	    MOVL    #5, FACIL_NAME_DESC					      ; 1416

				       09  11 004A1 	    BRB     5$							      ; 1411

		    04   AE	0000'  CF  9E 004A3 4$:     MOVAB   P.AAB, FACIL_NAME_DESC+4				      ; 1421

		         6E	       06  D0 004A9 	    MOVL    #6, FACIL_NAME_DESC					      ; 1422

		         04	       51  E9 004AC 5$:     BLBC    CONFIRM_MSG, 7$					      ; 1439

				       7E  D4 004AF 6$:     CLRL    -(SP)						      ;

				       05  11 004B1 	    BRB     8$							      ;

		         50	       6E  9E 004B3 7$:     MOVAB   FACIL_NAME_DESC, R0					      ;

				       50  DD 004B6 	    PUSHL   R0							      ;

		         09	       51  E9 004B8 8$:     BLBC    CONFIRM_MSG, 9$					      ; 1434

		         50	0000V  CF  9E 004BB 	    MOVAB   GET_CONFIRM, R0					      ;

				       50  DD 004C0 	    PUSHL   R0							      ;

				       02  11 004C2 	    BRB     10$							      ;

				       7E  D4 004C4 9$:     CLRL    -(SP)						      ;

				       52  DD 004C6 10$:    PUSHL   R2							      ; 1432

	      00000000G  9F	       03  FB 004C8 	    CALLS   #3, @#SYS$PUTMSG					      ;

	   00	    04   A2	       01  7A 004CF 	    EMUL    #1, 4(R2), #0, -(SP)				      ; 1451

				       7E     004D4									      ;

	   50	         8E	       08  7B 004D5 	    EDIV    #8, (SP)+, R0, R0					      ;

				       50     004D9									      ;

		         04	       50  D1 004DA 	    CMPL    R0, #4						      ; 1452

				       06  12 004DD 	    BNEQ    12$							      ;

		         50	0918   8F  3C 004DF 11$:    MOVZWL  #2328, R0						      ; 1454

					   04 004E4 	    RET     							      ;

		         50	       01  D0 004E5 12$:    MOVL    #1, R0						      ; 1456

					   04 004E8 	    RET     							      ; 1318



; Routine Size:  153 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 11

; Digital Equipment Corporation

;

;	1459	ROUTINE get_confirm (msg_desc) =			! Reads (with prompt) from the terminal

;	1460	

;	1461	!++

;	1462	! Functional description

;	1463	!

;	1464	!	This routine calls a library routine -- LIB$GET_COMMAND -- to obtain a "Y" or "N"

;	1465	!	from the user. "Y" means delete the file just opened. "N" means don't delete it;

;	1466	!	just close it.

;	1467	!

;	1468	!	If the library routine returns with an error code, a severe error is signaled,

;	1469	!	and this utility halts.

;	1470	!

;	1471	!	The user's answer causes the value of DEL_OR_NOT to be set on or off.

;	1472	!

;	1473	!	This routine always resignals so that PUTMSG, its caller, does no further

;	1474	!	processing.

;	1475	!

;	1476	! Calling sequence

;	1477	!

;	1478	!	get_confirm (msg_desc.rd.s)

;	1479	!

;	1480	! Input parameters

;	1481	!

;	1482	!	msg_desc	- the address of a string descriptor that describes the prompt message

;	1483	!

;	1484	! Implicit inputs

;	1485	!

;	1486	!	none

;	1487	!

;	1488	! Output parameters

;	1489	!

;	1490	!	none

;	1491	!

;	1492	! Implicit outputs

;	1493	!

;	1494	!	DEL_OR_NOT	- set if user says "Y"

;	1495	!			- set to zero if user says anything else

;	1496	!

;	1497	! Routine value

;	1498	!

;	1499	!	ss$_resignal	- error code that causes PUTMSG to cease processing and return to caller

;	1500	!

;	1501	! Side effects

;	1502	!

;	1503	!	If the READ fails, another error is signaled, a severe error, and control

;	1504	!	never returns to this routine.

;	1505	!

;	1506	!--

;	1507	

;	1508	    BEGIN

;	1509	

;	1510	    MAP

;	1511	        msg_desc	: REF BLOCK [, BYTE];

;	1512	

;	1513	    LOCAL



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 11-1

; Digital Equipment Corporation

;

;	1514	        buffer		: VECTOR [CH$ALLOCATION (8)],	! Buffer for response string

;	1515	        char,						! Holds one character

;	1516	        answer_desc	: BLOCK [8, BYTE];		! String descriptor for response string

;	1517	

;	1518	!

;	1519	! Zero the response buffer.

;	1520	!

;	1521	

;	1522	    CH$FILL (' ', 8, CH$PTR (buffer));			! Zero the local response buffer.

;	1523	

;	1524	!

;	1525	! Initialize the string descriptor for the response buffer.

;	1526	!

;	1527	

;	1528	    answer_desc [dsc$w_length] = 8;			! Length of response buffer is eight characters

;	1529	    answer_desc [dsc$a_pointer] = buffer;		! Load address of response buffer.

;	1530	    answer_desc [dsc$b_class] = dsc$k_class_s;		! This is a static descriptor.

;	1531	

;	1532	!

;	1533	! Call the library routine to READ from the terminal. If this routine fails,

;	1534	! signal a severe error and don't return to this routine.

;	1535	!

;	1536	

;	1537	    IF NOT lib$get_command (				! Call a routine to output a prompt

;	1538	                            answer_desc,		!    string and solicit input from

;	1539	                            .msg_desc)			!    the user.

;	1540	    THEN

;	1541	        BEGIN

;	1542	        put_message (					! Failure. Signal a severe error.

;     P 1543	                        msg$_badlogic);			!    Specify an interim error code.

;	1544	        RETURN ss$_continue;				! ***This is just for a ~clean ending.

;	1545	        END;

;	1546	

;	1547	!

;	1548	! Read the first character of the response. If it is "Y", then set the TRUE the global

;	1549	! variable that says delete the file. Otherwise, any other response causes the global

;	1550	! to be set to FALSE, meaning don't delete the file.

;	1551	!

;	1552	

;	1553	    char = CH$RCHAR (CH$PTR (buffer));			! Get one character from the input buffer.

;	1554	    IF (.char EQL 'Y') OR (.char EQL 'y')		! If the character is "Y",

;	1555	    THEN

;	1556	        del_or_not = TRUE				!    set the variable to TRUE, meaning delete;

;	1557	    ELSE

;	1558	        del_or_not = FALSE;				!    otherwise, set it to FALSE, meaning no delete.

;	1559	

;	1560	    RETURN ss$_resignal					! Return error code so PUTMSG returns.

;	1561	

;	1562	    END;











					 003C 004E9 GET_CONFIRM:



; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 11-2

; Digital Equipment Corporation

;

							    .WORD   Save R2,R3,R4,R5					      ; 1459

		         5E	       10  C2 004EB 	    SUBL2   #16, SP						      ;

	   20	         6E	       00  2C 004EE 	    MOVC5   #0, (SP), #32, #8, BUFFER				      ; 1522

		    08   AE	       08     004F2									      ;

		         6E	       08  B0 004F5 	    MOVW    #8, ANSWER_DESC					      ; 1528

		    04   AE	  08   AE  9E 004F8 	    MOVAB   BUFFER, ANSWER_DESC+4				      ; 1529

		    03   AE	       01  90 004FD 	    MOVB    #1, ANSWER_DESC+3					      ; 1530

				  04   AC  DD 00501 	    PUSHL   MSG_DESC						      ; 1537

				  04   AE  9F 00504 	    PUSHAB  ANSWER_DESC						      ;

		  0000G  CF	       02  FB 00507 	    CALLS   #2, LIB$GET_COMMAND					      ;

		         17	       50  E8 0050C 	    BLBS    R0, 1$						      ;

		         7E	1124   8F  3C 0050F 	    MOVZWL  #4388, -(SP)					      ; 1543

		  0000G  CF	       01  FB 00514 	    CALLS   #1, DEL$MSG_NUMBER					      ;

				       50  DD 00519 	    PUSHL   R0							      ;

	      00000000G  00	       01  FB 0051B 	    CALLS   #1, LIB$STOP					      ;

		         50	       01  D0 00522 	    MOVL    #1, R0						      ; 1544

					   04 00525 	    RET     							      ;

		         50	  08   AE  9A 00526 1$:     MOVZBL  BUFFER, CHAR					      ; 1553

	      00000059   8F	       50  D1 0052A 	    CMPL    CHAR, #89						      ; 1554

				       09  13 00531 	    BEQL    2$							      ;

	      00000079   8F	       50  D1 00533 	    CMPL    CHAR, #121						      ;

				       07  12 0053A 	    BNEQ    3$							      ;

		  0000'  CF	       01  D0 0053C 2$:     MOVL    #1, DEL_OR_NOT					      ; 1556

				       04  11 00541 	    BRB     4$							      ; 1554

				0000'  CF  D4 00543 3$:     CLRL    DEL_OR_NOT						      ; 1558

		         50	0918   8F  3C 00547 4$:     MOVZWL  #2328, R0						      ; 1560

					   04 0054C 	    RET     							      ; 1459



; Routine Size:  100 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:52:13	DBB3:[DELETE.SRC]DELEMAIN.B32;114				Page 12

; Digital Equipment Corporation

;

;	1563	END

;	1564	ELUDOM









							    .GLOBL  LIB$SIGNAL, LIB$STOP



;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  $OWN$          	     4    WRT,  RD ,NOEXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)

;  $CODE$         	  1357  NOWRT,  RD ,  EXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)

;  $PLIT$         	    16  NOWRT,  RD ,NOEXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)









;				LIBRARY STATISTICS

;

;					     -------- Symbols --------    Blocks

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]STARLET.L32;1		      2688        58         2       145

;  DBA4:[SYSLIB]CLIMAC.L32;1		        14         0         0         3

;  DBB3:[DELETE.SRC]VMSMAC.L32;1	         6         3        50         4











; Size:		1357 code + 20 data bytes

; Run Time:	00:40.1

; Elapsed Time:	01:21.6

; Memory Used:	250 pages

; Compilation Complete

