

; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 1

; Digital Equipment Corporation

;

;	0001	MODULE purgedir (  ! Purges a directory

;	0002	                    LANGUAGE (BLISS32),

;	0003	                    IDENT = 'X00001'

;	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 Utility

;	0028	!

;	0029	! ABSTRACT:

;	0030	!

;	0031	!	This module opens an ODS-2 directory and purges files from it according to

;	0032	!	the file specification passed to the PURGE command.

;	0033	!

;	0034	! ENVIRONMENT:

;	0035	!

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

;	0037	!	operates at non-AST level.

;	0038	!

;	0039	!--

;	0040	!++

;	0041	!

;	0042	! AUTHOR:	Carol Peters,	CREATION DATE:	15 May 1978 10:30

;	0043	!

;	0044	! REVISION HISTORY:

;	0045	!

;	0046	!--

;	0047	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 2

; Digital Equipment Corporation

;

;	0048	!

;	0049	! Table of Contents

;	0050	!

;	0051	FORWARD ROUTINE

;	0052	    del$purge_spec	: NOVALUE,			! Purges files related to one file specification

;	0053	    get_directory,					! Reads into virtual memory an ODS-2 directory

;	0054	    format_ods1_dir	: NOVALUE,			! Sorts an ODS-1 directory to look like ODS-2 format

;	0055	    write_entry		: NOVALUE,			! Writes an ODS-2 entry from an ODS-1 entry

;	0056	    purge_ods2_dir	: NOVALUE,			! Purges an ODS-2 directory of files that match a spec

;	0057	    find_ods2_file;					! Finds the next entry in an ODS-2 directory

;	0058	

;	0059	!

;	0060	! Include files

;	0061	!

;	0062	

;	0063	LIBRARY 'SYS$LIBRARY:LIB.L32';				! VAX/VMS system definitions

;	0064	

;	0065	REQUIRE 'SRC$:DELETE.REQ';				! Common DELETE literal definitions and macros

;	0153	

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

;	0202	

;	0203	LIBRARY 'SRC$:DR1DEF.L32';				! Definition of ODS-1 fields

;	0204	

;	0205	!

;	0206	! Global variables

;	0207	!

;	0208	

;	0209	!

;	0210	! Own variables

;	0211	!

;	0212	

;	0213	OWN

;	0214	    error_buffer	: VECTOR [err_buf_len, BYTE];	! Buffer for PURGE/LOG file specifications

;	0215	

;	0216	GLOBAL

;	0217	    direc_bufptr	: REF BLOCK [, BYTE],		! Pointer into directory buffer

;	0218	    sorted_bufptr	: REF BLOCK [, BYTE],		! Pointer into sorted directory buffer

;	0219	    direc_buftop,					! Pointer to output directory buffer

;	0220	    dir_block_no,					! Holds current directory block number

;	0221	    end_block_no;					! Holds end block number of directory file.

;	0222	

;	0223	!

;	0224	! Macros

;	0225	!

;	0226	

;	0227	!

;	0228	! Equated symbols

;	0229	!

;	0230	

;	0231	LITERAL

;	0232	    end_of_block	= 65535;			! End of directory block indicator

;	0233	

;	0234	!

;	0235	! Special linkages

;	0236	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 2-1

; Digital Equipment Corporation

;

;	0237	

;	0238	LINKAGE

;	0239	    jsb47	= JSB (REGISTER=4, REGISTER=7);		! Declare a JSB linkage type

;	0240	

;	0241	!

;	0242	! External variables

;	0243	!

;	0244	

;	0245	EXTERNAL

;	0246	    del$cli_status	: BITVECTOR,			! CLI status word

;	0247	    del$keepver_val;					! Holds number of versions to save

;	0248	

;	0249	EXTERNAL ROUTINE

;	0250	    del$del_error,					! Reports an error in file deletion.

;	0251	    del$r50_cvt1	: jsb47,			! Converts 1 word of RAD-50 to ASCII

;	0252	    del$r50_cvt3	: jsb47,			! Converts 3 words of RAD-50 to ASCII

;	0253	    lib$get_vm;						! Virtual memory allocator



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 3

; Digital Equipment Corporation

;

;	0254	GLOBAL ROUTINE del$purge_spec (fab_block) : NOVALUE =	! Purges files related to one file specification

;	0255	

;	0256	!++

;	0257	! Functional description

;	0258	!

;	0259	!	This routine deletes old versions of files described by a single file specification.

;	0260	!	The specification contains no version number fields. It can contain wildcards in

;	0261	!	the name and/or type fields.

;	0262	!

;	0263	!	The number of versions of each file to keep is stored in the global variable

;	0264	!	del$keepver_val. After the most recent "n" versions of each file name/type 

;	0265	!	combination have been saved (not deleted), then the remaining versions are deleted

;	0266	!	by calling the RMS delete file function.

;	0267	!

;	0268	!	This routine only purges ODS-2 directories.

;	0269	!

;	0270	! Calling sequence

;	0271	!

;	0272	!	del$purge_spec (fab_block.ra.v)

;	0273	!

;	0274	! Input parameters

;	0275	!

;	0276	!	fab_block	- the FAB describing the input file specification

;	0277	!

;	0278	! Implicit inputs

;	0279	!

;	0280	!	The NAM block and XAB block associated with the FAB block argument. Their

;	0281	!	addresses are contained in the FAB block.

;	0282	!

;	0283	!	The FAB block tells whether the device is a directory-device. If it is not,

;	0284	!	the purge does not occur.

;	0285	!

;	0286	!	del$keepver_val	- holds the number of versions to keep or zero. Zero implies keep 1.

;	0287	!

;	0288	!	The file specification has been parsed. The parsed specification is guaranteed not

;	0289	!	to have any version field. The string is in the ESA field of the NAM block.

;	0290	!	The directory identification is in the DID fields of the NAM block.

;	0291	!

;	0292	! Output parameters

;	0293	!

;	0294	!	none

;	0295	!

;	0296	! Implicit outputs

;	0297	!

;	0298	!	The WILDCARD_BIT in DEL$CLI_STATUS is always turned off.

;	0299	!

;	0300	! Routine value

;	0301	!

;	0302	!	novalue

;	0303	!

;	0304	! Side effects

;	0305	!

;	0306	!	Files may be deleted. Errors are signaled.

;	0307	!

;	0308	!--



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 3-1

; Digital Equipment Corporation

;

;	0309	

;	0310	    BEGIN

;	0311	

;	0312	    MAP

;	0313	        fab_block	: REF BLOCK [, BYTE];

;	0314	

;	0315	    BIND

;	0316	        nam_block	=				! NAM block associated with FAB block

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

;	0318	

;	0319	     LOCAL

;	0320	        spec_desc	: BLOCK [8, BYTE],		! String descriptor for file specification

;	0321	        status;						! Temporary status variable

;	0322	

;	0323	!

;	0324	! Confirm that the device specified is a directory device. If not, cancel the

;	0325	! purge operation.

;	0326	!

;	0327	

;	0328	    IF NOT .fab_block [$FAB_DEV (dir)]			! If not a directory device,

;	0329	    THEN

;	0330	        BEGIN

;	0331	        del$cli_status [wildcard_bit] = FALSE;		! Turn off wildcards.

;	0332	        spec_desc [dsc$w_length] =			!    make a string descriptor to

;	0333	            .nam_block [nam$b_esl];

;	0334	        spec_desc [dsc$a_pointer] =			!    the file specification.

;	0335	            .nam_block [nam$l_esa];

;	0336	        put_message (

;     P 0337	                        msg$_nofilpurg,			!    report a fatal error

;     P 0338	                        1,				!    with one argument,

;     P 0339	                        spec_desc);			!    the file specification.

;	0340								!    ****REPLACE THIS ERROR MESSAGE, V.2.

;	0341	        RETURN;						!    and give up on this specification.

;	0342	        END;

;	0343	

;	0344	!

;	0345	! Open the directory file and read it into memory. This routine returns failure if

;	0346	! the directory cannot be opened, if the directory does not fit into the buffer allocated

;	0347	! for it, or if the directory is not an ODS-2 directory.

;	0348	!

;	0349	

;	0350	    status = get_directory (				! Open the directory file and

;	0351	                            .fab_block);		!    read it into memory. Specify the FAB block address.

;	0352	    IF NOT .status					! If the GET fails, then

;	0353	    THEN

;	0354	        RETURN;						! just return. An error was signaled already.

;	0355	

;	0356	!

;	0357	! If this directory is in ODS-1 format, reformat it to look like ODS-2 format internally.

;	0358	!

;	0359	

;	0360	    IF .status EQL ods_1_dir				! If an ODS-1 directory was read,

;	0361	    THEN

;	0362	        format_ods1_dir ();				!    then sort it.

;	0363	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 3-2

; Digital Equipment Corporation

;

;	0364	!

;	0365	! If the user did not specify a number of files to keep, default the number to 1.

;	0366	!

;	0367	

;	0368	    IF .del$keepver_val LEQ 0				! If no /KEEP qualifier specified,

;	0369	    THEN

;	0370	        del$keepver_val = 1;				!    then the default is keep most recent file.

;	0371	

;	0372	!

;	0373	! Make a string descriptor of the file specification, and call the purging routine.

;	0374	!

;	0375	

;	0376	    spec_desc [dsc$w_length] = .nam_block [nam$b_esl];	! The length is the expanded name string length.

;	0377	    spec_desc [dsc$a_pointer] = .nam_block [nam$l_esa];	! The address is the expanded name string address.

;	0378	    purge_ods2_dir (					! Purge the directory.

;	0379	                    spec_desc,				!    Specify the descriptor of the file specification

;	0380	                    .fab_block);			!    and the address of the FAB block.

;	0381	

;	0382	    END;





							    .TITLE  PURGEDIR

							    .IDENT  \X00001\



							    .PSECT  $OWN$,NOEXE,2



					      00000 ERROR_BUFFER:

							    .BLKB   200



							    .PSECT  $GLOBAL$,NOEXE,2



					      00000 DIREC_BUFPTR::

							    .BLKB   4

					      00004 SORTED_BUFPTR::

							    .BLKB   4

					      00008 DIREC_BUFTOP::

							    .BLKB   4

					      0000C DIR_BLOCK_NO::

							    .BLKB   4

					      00010 END_BLOCK_NO::

							    .BLKB   4



							    .GLOBL  DEL$CLI_RESULT, DEL$MSG_NUMBER, DEL$CLI_STATUS

							    .GLOBL  DEL$KEEPVER_VAL, DEL$DEL_ERROR, DEL$R50_CVT1, DEL$R50_CVT3

							    .GLOBL  LIB$GET_VM



							    .PSECT  $CODE$,NOWRT,2



					 000C 00000 	    .ENTRY  DEL$PURGE_SPEC, Save R2,R3				      ; 0254

		         5E	       08  C2 00002 	    SUBL2   #8, SP						      ;

		         53	  04   AC  D0 00005 	    MOVL    FAB_BLOCK, R3					      ; 0317

		         52	  28   A3  D0 00009 	    MOVL    40(R3), R2						      ; 0310

	   26	    40   A3	       03  E0 0000D 	    BBS     #3, 64(R3), 1$					      ; 0328

		  0000G  CF	       10  8A 00012 	    BICB2   #16, DEL$CLI_STATUS					      ; 0331

		         6E	  0B   A2  9B 00017 	    MOVZBW  11(R2), SPEC_DESC					      ; 0332



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 3-3

; Digital Equipment Corporation

;

		    04   AE	  0C   A2  D0 0001B 	    MOVL    12(R2), SPEC_DESC+4					      ; 0334

				       5E  DD 00020 	    PUSHL   SP							      ; 0339

				       01  DD 00022 	    PUSHL   #1							      ;

		         7E	122B   8F  3C 00024 	    MOVZWL  #4651, -(SP)					      ;

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

				       50  DD 0002E 	    PUSHL   R0							      ;

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

					   04 00037 	    RET     							      ; 0341

				       53  DD 00038 1$:     PUSHL   R3							      ; 0350

		  0000V  CF	       01  FB 0003A 	    CALLS   #1, GET_DIRECTORY					      ;

		         28	       50  E9 0003F 	    BLBC    STATUS, 4$						      ; 0352

		         01	       50  D1 00042 	    CMPL    STATUS, #1						      ; 0360

				       05  12 00045 	    BNEQ    2$							      ;

		  0000V  CF	       00  FB 00047 	    CALLS   #0, FORMAT_ODS1_DIR					      ; 0362

				0000G  CF  D5 0004C 2$:     TSTL    DEL$KEEPVER_VAL					      ; 0368

				       05  14 00050 	    BGTR    3$							      ;

		  0000G  CF	       01  D0 00052 	    MOVL    #1, DEL$KEEPVER_VAL					      ; 0370

		         6E	  0B   A2  9B 00057 3$:     MOVZBW  11(R2), SPEC_DESC					      ; 0376

		    04   AE	  0C   A2  D0 0005B 	    MOVL    12(R2), SPEC_DESC+4					      ; 0377

				       53  DD 00060 	    PUSHL   R3							      ; 0378

				  04   AE  9F 00062 	    PUSHAB  SPEC_DESC						      ;

		  0000V  CF	       02  FB 00065 	    CALLS   #2, PURGE_ODS2_DIR					      ;

					   04 0006A 4$:     RET     							      ; 0254



; Routine Size:  107 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4

; Digital Equipment Corporation

;

;	0383	ROUTINE get_directory (fab_block) =			! Opens and reads in a directory

;	0384	

;	0385	!++

;	0386	! Functional description

;	0387	!

;	0388	!	This routine opens the directory file in which a parsed file specification

;	0389	!	is listed. Then it allocates a buffer from virtual memory and

;	0390	!	reads the entire directory file into virtual memory.

;	0391	!

;	0392	!	If the directory file is not readable, or does not fit into memory, this routine

;	0393	!	returns an error.

;	0394	!

;	0395	! Calling sequence

;	0396	!

;	0397	!	get_directory (fab_block.ra.v)

;	0398	!

;	0399	! Input parameters

;	0400	!

;	0401	!	fab_block	- FAB associated with the parsed file. Used for

;	0402	!			  the opening of the directory file

;	0403	!

;	0404	! Implicit inputs

;	0405	!

;	0406	!	NAM block associated with FAB block passed as an input parameter.

;	0407	!	The file specification has been parsed. Thus the following fields in the NAM block

;	0408	!	apply to the directory file of the parsed file specification:

;	0409	!

;	0410	!		DID_NUM	- directory identification number

;	0411	!		DID_SEQ	- directory sequence number

;	0412	!		DID_RVN	- directory revision number

;	0413	!

;	0414	!	Fields in the XAB block:

;	0415	!

;	0416	! 		EBK	- holds the number of blocks in the directory file

;	0417	!			  after the directory file open.

;	0418	!		FFB	- holds the number of the first free byte in the last block.

;	0419	!

;	0420	!	dir_buf_len	- the length of the buffer for the directory

;	0421	!

;	0422	! Output parameters

;	0423	!

;	0424	!	none

;	0425	!

;	0426	! Implicit outputs

;	0427	!

;	0428	!	direc_bufptr	- Pointer to directory buffer.

;	0429	!	dir_block_no	- Number of the current directory block.

;	0430	!	end_block_no	- Number of the last block in the directory.

;	0431	!	sorted_bufptr	- Pointer into buffer to be used to sort ODS-1 directory (if necessary).

;	0432	!

;	0433	! Routine value

;	0434	!

;	0435	!	ods_2_dir	- ODS-2 directory, success code

;	0436	!	ods_1_dir	- ODS-1 directory, success code

;	0437	!	FALSE		- the OPEN or the QIO failed.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4-1

; Digital Equipment Corporation

;

;	0438	!

;	0439	! Side effects

;	0440	!

;	0441	!	Errors are signaled. Virtual memory is allocated for the buffers.

;	0442	!

;	0443	!--

;	0444	

;	0445	    BEGIN

;	0446	

;	0447	    MAP

;	0448	        fab_block	: REF BLOCK [, BYTE];

;	0449	

;	0450	    BIND

;	0451	        nam_block	=				! Associated NAM block.

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

;	0453	        xab_block	=				! Associated XAB block.

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

;	0455	

;	0456	    LOCAL

;	0457	        spec_did_num	: WORD,				! File specification's directory ident

;	0458	        spec_did_seq	: WORD,				! File specification's directory sequence number

;	0459	        spec_did_rvn	: WORD,				! File specification's directory revision number

;	0460	        buffer_size,					! Holds size of buffer needed for file read.

;	0461	        status;						! Holds RMS status codes

;	0462	

;	0463	!

;	0464	! The file specification has been parsed. Load the directory identification numbers into

;	0465	! the file identification number fields. Save the old DID numbers for later ERASEs of files in the directory.

;	0466	!

;	0467	! Also set FOP bits to indicate that RMS is

;	0468	! to open this file only, that the channel is to be assigned in user mode, and that

;	0469	! RMS is expected to do no further processing on this file. Then try to open the directory file.

;	0470	!

;	0471	

;	0472	    nam_block [nam$w_fid_num] =				! Load the directory identification number,

;	0473	        .nam_block [nam$w_did_num];

;	0474	    nam_block [nam$w_fid_seq] =				!    the directory sequence number,

;	0475	        .nam_block [nam$w_did_seq];

;	0476	    nam_block [nam$w_fid_rvn] =				!    and the directory revision number.

;	0477	        .nam_block [nam$w_did_rvn];

;	0478	

;	0479	    spec_did_num = .nam_block [nam$w_did_num];		! Save the file spec's directory ident number,

;	0480	    spec_did_seq = .nam_block [nam$w_did_seq];		!    sequence number,

;	0481	    spec_did_rvn = .nam_block [nam$w_did_rvn];		!    and revision number.

;	0482	

;	0483	    fab_block [fab$v_ufm] = TRUE;			! Ask RMS to assign the channel in user mode

;	0484	    fab_block [fab$v_ufo] = TRUE;			! Tell RMS to open and then abandon the file.

;	0485	

;	0486	    IF NOT $RMS_OPEN (					! Open the directory file.

;     P 0487	                        FAB = .fab_block,		!    Specify the FAB block address

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

;	0489	    THEN

;	0490	        RETURN FALSE;					! If the OPEN failed, return with error code.

;	0491	

;	0492	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4-2

; Digital Equipment Corporation

;

;	0493	! Check the size of the directory file. Then allocate space for it. If enough space

;	0494	! cannot be allocated, signal an error and return with failure status code.

;	0495	!

;	0496	

;	0497	    buffer_size = .xab_block [xab$l_ebk] * 512;		! Compute space needed for directory buffer.

;	0498	    status = LIB$GET_VM (				! Allocate a buffer of that size.

;	0499	                            buffer_size,		!    Specify size of buffer needed in bytes and a

;	0500	                            direc_bufptr);		!    place for the address of the buffer to be returned.

;	0501	

;	0502	    IF NOT .status					! If the space cannot be allocated,

;	0503	    THEN

;	0504	        BEGIN

;	0505	        put_message (					!    signal an error message to the user,

;     P 0506	                        msg$_delinterr);		!    saying that the directory is too large,

;	0507								!    ****change this****

;	0508	        RETURN FALSE;					!    and return with error code.

;	0509	        END;

;	0510	

;	0511	!

;	0512	! Since the OPEN succeeded, the channel of the file is in the STV field of the FAB.

;	0513	! Queue an I/O request to read the entire file into a buffer.

;	0514	!

;	0515	

;	0516	    status = $QIOW (					! Read in the directory file.

;     P 0517	                    CHAN = .fab_block [fab$l_stv],	!    Specify a channel number,

;     P 0518	                    FUNC = io$_readvblk,		!    a read operation,

;     P 0519	                    P1 = .direc_bufptr,			!    a buffer pointer, and

;     P 0520	                    P2 = .xab_block [xab$l_ebk] * 512,	!    a buffer size,

;     P 0521	                    P3 = 1);				!    and block number 1 for where to start reading.

;	0522	

;	0523	    IF NOT .status					! If the QIO fails, report the error.

;	0524	    THEN

;	0525	        BEGIN

;	0526	        SIGNAL (.status);				!    Signal the error.

;	0527	        RETURN FALSE;					!    Return an error status code.

;	0528	        END;

;	0529	

;	0530	!

;	0531	! Now close the directory file, and restore the FOP field of the FAB block to its

;	0532	! RMS state. Also restore the directory numbers.

;	0533	!

;	0534	

;	0535	    status = $DASSGN (					! To close the directory file, just

;     P 0536	                        CHAN = .fab_block [fab$l_stv]);	!    deassign the channel.

;	0537	

;	0538	    IF NOT .status					! If this deassign fails,

;	0539	    THEN

;	0540	        BEGIN

;	0541	        SIGNAL (.status);				!    then signal an error and

;	0542	        RETURN FALSE;					!    return with error status code.

;	0543	        END;

;	0544	

;	0545	    fab_block [fab$v_ufm] = FALSE;			! Turn off bits that required the channel to be

;	0546	    fab_block [fab$v_ufo] = FALSE;			! assigned in user mode, and that told RMS not to

;	0547								! expect to do anything further than file opening.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4-3

; Digital Equipment Corporation

;

;	0548	    nam_block [nam$w_did_num] = .spec_did_num;		! Restore the file spec's directory

;	0549	    nam_block [nam$w_did_seq] = .spec_did_seq;		!    identification, sequence, and

;	0550	    nam_block [nam$w_did_rvn] = .spec_did_rvn;		!    revision number.

;	0551	

;	0552	!

;	0553	! Initialize the buffer pointer and block count variables. Direc_bufptr points to the current

;	0554	! top of the directory. Direc_buftop always points to the real top of the buffer.

;	0555	! This second buffer top pointer is necessary to allow different buffers to be used during

;	0556	! the actual purge operation.

;	0557	!

;	0558	

;	0559	    direc_buftop = .direc_bufptr;			! This pointer always points to top of buffer.

;	0560	    dir_block_no = 1;					! Initialize block number to block 1.

;	0561	    IF .xab_block [xab$w_ffb] EQL 0			! If no bytes are written in the last block of

;	0562	    THEN						!    the directory file, then the actual

;	0563	        end_block_no = .xab_block [xab$l_ebk] - 1	!    last block is one less than the EBK field.

;	0564	    ELSE

;	0565	        end_block_no = .xab_block [xab$l_ebk];		! Otherwise, it is the EBK field.

;	0566								!    file from the XAB block field.

;	0567	

;	0568	!

;	0569	! If the directory is ODS-1 format, allocate another buffer into which to sort it.

;	0570	! If the allocate fails, return with error code. Finally, return a success code

;	0571	! based on whether the file is an ODS-1 or an ODS-2 directory.

;	0572	!

;	0573	

;	0574	    IF .fab_block [fab$b_rfm] EQL fab$c_var		! ODS-2 directory files have variable record format.

;	0575	    THEN

;	0576	        RETURN ods_2_dir				! Return ODS-2 code if variable records in this file.

;	0577	    ELSE

;	0578	        BEGIN

;	0579	        status = LIB$GET_VM (				! Allocate a second buffer.

;	0580	                                buffer_size,		!    Specify the same buffer size,

;	0581	                                sorted_bufptr);		!    and a pointer address.

;	0582	

;	0583	        IF NOT .status					! If space cannot be allocated,

;	0584	        THEN

;	0585	            BEGIN

;	0586	            put_message (				!    then signal the user

;     P 0587	                            msg$_delinterr);		!    that the directory is too large,

;	0588								!    ****change this****

;	0589	            RETURN FALSE;				!    and return with an error code.

;	0590	            END

;	0591	        ELSE

;	0592	            RETURN ods_1_dir;				! Otherwise, return with ODS-1 status code.

;	0593	        END;

;	0594	

;	0595	    END;







							    .GLOBL  SYS$OPEN, SYS$QIOW, SYS$DASSGN



					 0BFC 0006B GET_DIRECTORY:

							    .WORD   Save R2,R3,R4,R5,R6,R7,R8,R9,R11			      ; 0383



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4-4

; Digital Equipment Corporation

;

		         5B	0000'  CF  9E 0006D 	    MOVAB   DIREC_BUFPTR, R11					      ;

		         5E	       04  C2 00072 	    SUBL2   #4, SP						      ;

		         53	  04   AC  D0 00075 	    MOVL    FAB_BLOCK, R3					      ; 0452

		         52	  28   A3  D0 00079 	    MOVL    40(R3), R2						      ; 0445

		         55	  24   A3  D0 0007D 	    MOVL    36(R3), R5						      ;

		    24   A2	  2A   A2  D0 00081 	    MOVL    42(R2), 36(R2)					      ; 0472

		    28   A2	  2E   A2  B0 00086 	    MOVW    46(R2), 40(R2)					      ; 0476

		         57	  2A   A2  B0 0008B 	    MOVW    42(R2), SPEC_DID_NUM				      ; 0479

		         58	  2C   A2  B0 0008F 	    MOVW    44(R2), SPEC_DID_SEQ				      ; 0480

		         59	  2E   A2  B0 00093 	    MOVW    46(R2), SPEC_DID_RVN				      ; 0481

		    06   A3	0402   8F  A8 00097 	    BISW2   #1026, 6(R3)					      ; 0483

				0000G  CF  9F 0009D 	    PUSHAB  DEL$DEL_ERROR					      ; 0488

				       53  DD 000A1 	    PUSHL   R3							      ;

	      00000000G  9F	       02  FB 000A3 	    CALLS   #2, @#SYS$OPEN					      ;

		         54	       50  E9 000AA 	    BLBC    R0, 3$						      ;

	   56	    10   A5	       09  78 000AD 	    ASHL    #9, 16(R5), R6					      ; 0497

		         6E	       56  D0 000B2 	    MOVL    R6, BUFFER_SIZE					      ;

				       5B  DD 000B5 	    PUSHL   R11							      ; 0498

				  04   AE  9F 000B7 	    PUSHAB  BUFFER_SIZE						      ;

		  0000G  CF	       02  FB 000BA 	    CALLS   #2, LIB$GET_VM					      ;

		         54	       50  D0 000BF 	    MOVL    R0, STATUS						      ;

		         03	       54  E8 000C2 	    BLBS    STATUS, 1$						      ; 0502

				     0082  31 000C5 	    BRW     8$							      ;

				       7E  7C 000C8 1$:     CLRQ    -(SP)						      ; 0521

		         7E	       01  7D 000CA 	    MOVQ    #1, -(SP)						      ;

				       56  DD 000CD 	    PUSHL   R6							      ;

				       6B  DD 000CF 	    PUSHL   DIREC_BUFPTR					      ;

				       7E  7C 000D1 	    CLRQ    -(SP)						      ;

		         7E	       31  7D 000D3 	    MOVQ    #49, -(SP)						      ;

				  0C   A3  DD 000D6 	    PUSHL   12(R3)						      ;

				       7E  D4 000D9 	    CLRL    -(SP)						      ;

	      00000000G  9F	       0C  FB 000DB 	    CALLS   #12, @#SYS$QIOW					      ;

		         54	       50  D0 000E2 	    MOVL    R0, STATUS						      ;

		         10	       54  E9 000E5 	    BLBC    STATUS, 2$						      ; 0523

				  0C   A3  DD 000E8 	    PUSHL   12(R3)						      ; 0536

	      00000000G  9F	       01  FB 000EB 	    CALLS   #1, @#SYS$DASSGN					      ;

		         54	       50  D0 000F2 	    MOVL    R0, STATUS						      ;

		         0B	       54  E8 000F5 	    BLBS    STATUS, 4$						      ; 0538

				       54  DD 000F8 2$:     PUSHL   STATUS						      ; 0541

	      00000000G  00	       01  FB 000FA 	    CALLS   #1, LIB$SIGNAL					      ;

				       60  11 00101 3$:     BRB     10$							      ; 0542

		    06   A3	0402   8F  AA 00103 4$:     BICW2   #1026, 6(R3)					      ; 0545

		    2A   A2	       57  B0 00109 	    MOVW    SPEC_DID_NUM, 42(R2)				      ; 0548

		    2C   A2	       58  B0 0010D 	    MOVW    SPEC_DID_SEQ, 44(R2)				      ; 0549

		    2E   A2	       59  B0 00111 	    MOVW    SPEC_DID_RVN, 46(R2)				      ; 0550

		    08   AB	       6B  D0 00115 	    MOVL    DIREC_BUFPTR, DIREC_BUFTOP				      ; 0559

		    0C   AB	       01  D0 00119 	    MOVL    #1, DIR_BLOCK_NO					      ; 0560

				  14   A5  B5 0011D 	    TSTW    20(R5)						      ; 0561

				       08  12 00120 	    BNEQ    5$							      ;

      10   AB	    10   A5	       01  C3 00122 	    SUBL3   #1, 16(R5), END_BLOCK_NO				      ; 0563

				       05  11 00128 	    BRB     6$							      ; 0561

		    10   AB	  10   A5  D0 0012A 5$:     MOVL    16(R5), END_BLOCK_NO				      ; 0565

		         02	  1F   A3  91 0012F 6$:     CMPB    31(R3), #2						      ; 0574

				       04  12 00133 	    BNEQ    7$							      ;

		         50	       03  D0 00135 	    MOVL    #3, R0						      ; 0576



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 4-5

; Digital Equipment Corporation

;

					   04 00138 	    RET     							      ;

				  04   AB  9F 00139 7$:     PUSHAB  SORTED_BUFPTR					      ; 0579

				  04   AE  9F 0013C 	    PUSHAB  BUFFER_SIZE						      ;

		  0000G  CF	       02  FB 0013F 	    CALLS   #2, LIB$GET_VM					      ;

		         54	       50  D0 00144 	    MOVL    R0, STATUS						      ;

		         15	       54  E8 00147 	    BLBS    STATUS, 9$						      ; 0583

		         7E	1244   8F  3C 0014A 8$:     MOVZWL  #4676, -(SP)					      ; 0587

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

				       50  DD 00154 	    PUSHL   R0							      ;

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

				       04  11 0015D 	    BRB     10$							      ; 0589

		         50	       01  D0 0015F 9$:     MOVL    #1, R0						      ; 0592

					   04 00162 	    RET     							      ;

				       50  D4 00163 10$:    CLRL    R0							      ; 0383

					   04 00165 	    RET     							      ;



; Routine Size:  251 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5

; Digital Equipment Corporation

;

;	0596	ROUTINE format_ods1_dir : NOVALUE =			! Reformats an ODS-1 directory to look like ODS-2

;	0597	

;	0598	!++

;	0599	! Functional description

;	0600	!

;	0601	!	This routine takes an ODS-1 directory and writes its contents into another buffer.

;	0602	!	In the process, the entries are sorted according to the ASCII collating sequence

;	0603	!	by file name and type, and their format is changed to ODS-2 directory entry format.

;	0604	!

;	0605	!	The difference between the sorted and formatted ODS-2 directory created by this program

;	0606	!	and a real ODS-2 directory, is that the former allows entries to cross block boundaries.

;	0607	!

;	0608	! Calling sequence

;	0609	!

;	0610	!	format_ods1_dir ()

;	0611	!

;	0612	! Input parameters

;	0613	!

;	0614	!	none

;	0615	!

;	0616	! Implicit inputs

;	0617	!

;	0618	!	end_block_no	- contains the number of the last block of the buffer.

;	0619	!	sorted_bufptr	- pointer to buffer for reformatted directory

;	0620	!	direc_bufptr	- pointer to buffer containing the original ODS-1 directory

;	0621	!

;	0622	! Output parameters

;	0623	!

;	0624	!	none

;	0625	!

;	0626	! Implicit outputs

;	0627	!

;	0628	!	end_block_no	- reset to the number of the last block in the reformatted directory buffer

;	0629	!	direc_bufptr	- reset to point to the sorted buffer

;	0630	!	direc_buftop	- reset to point to the sorted buffer

;	0631	!

;	0632	! Routine value

;	0633	!

;	0634	!	novalue

;	0635	!

;	0636	! Side effects

;	0637	!

;	0638	!	The entries in the original buffer are written in sorted ODS-2 format into the

;	0639	!	sorted buffer.

;	0640	!

;	0641	!--

;	0642	

;	0643	    BEGIN

;	0644	

;	0645	!

;	0646	! The macro that follows compares a field of one ODS-1 directory entry to the parallel field in

;	0647	! another entry. If the second entry is lower in the collating sequence, it replaces the

;	0648	! first entry in subsequent compares during the current scan through the buffer.

;	0649	! If the second entry is greater, the comparison between these two entries ends and processing goes on

;	0650	! to the next entry. If the entries are equal, comparison of another field will follow.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5-1

; Digital Equipment Corporation

;

;	0651	!

;	0652	

;	0653	    MACRO

;	0654	        compare_entries (rad_field) =

;     M 0655	            BEGIN

;     M 0656	            IF .current_entry [%REMOVE (rad_field)] GTRU .next_entry [%REMOVE (rad_field)]

;     M 0657	            THEN

;     M 0658	                BEGIN

;     M 0659	                current_entry = .next_entry;

;     M 0660	                next_entry = .next_entry + dr1$k_length;

;     M 0661	                LEAVE scan_loop;

;     M 0662	                END

;     M 0663	            ELSE

;     M 0664	                IF .current_entry [%REMOVE (rad_field)] LSSU .next_entry [%REMOVE (rad_field)]

;     M 0665	                THEN

;     M 0666	                    BEGIN

;     M 0667	                    next_entry = .next_entry + dr1$k_length;

;     M 0668	                    LEAVE scan_loop;

;     M 0669	                    END;

;     M 0670	            END%;

;	0671	

;	0672	    LOCAL

;	0673	        current_entry	: REF BLOCK [, BYTE],		! Entry believed to be current lowest in sort

;	0674	        current_top	: REF BLOCK [, BYTE],		! Top of current unsorted buffer

;	0675	        next_entry	: REF BLOCK [, BYTE],		! Next entry to compare

;	0676	        direc_bottom,					! First free byte in directory buffer

;	0677	        sorted_top,					! Current top of sorted buffer

;	0678	        old_entry	: BLOCK [dr1$k_length, BYTE];	! Holds last entry written to ODS-2 buffer

;	0679	

;	0680	    LABEL

;	0681	        scan_loop;					! Loop that scans directory buffer once.

;	0682	

;	0683	!

;	0684	! If the directory is empty, the number of blocks is zero. Write a phony end of block

;	0685	! byte here and return.

;	0686	!

;	0687	

;	0688	    IF .end_block_no EQL 0				! If directory is empty,

;	0689	    THEN

;	0690	        BEGIN

;	0691	        sorted_bufptr [dir$w_size] = end_of_block;	!    set an end of block flag here.

;	0692	        direc_buftop= .sorted_bufptr;			! Store a new permanent head of buffer.

;	0693	        direc_bufptr = .sorted_bufptr;			! New buffer is to be used in purging files.

;	0694	        end_block_no = 1;				! The directory is one virtual block.

;	0695	        RETURN;						! And return to caller.

;	0696	        END;

;	0697	

;	0698	!

;	0699	! Compute the null entry that follows the last entry in the directory.

;	0700	!

;	0701	

;	0702	    direc_bottom = (.end_block_no * 512)		! First free entry is past the end of the

;	0703	                    + .direc_bufptr;			!    last block.

;	0704	

;	0705	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5-2

; Digital Equipment Corporation

;

;	0706	! Initialize the pointers to the buffers. Zero the buffer for the previous ODS-2 entry written.

;	0707	!

;	0708	

;	0709	    current_top = .direc_bufptr;			! The start of unprocessed entries is the input buffer.

;	0710	    sorted_top = .sorted_bufptr;			! Save the beginning of the output buffer too.

;	0711	    old_entry [dr1$w_name_1] = 0;			! The old_entry block holds the RAD-50 format name

;	0712	    old_entry [dr1$w_name_2] = 0;			!    and type of the last entry written to the ODS-2

;	0713	    old_entry [dr1$w_name_3] = 0;			!    directory buffer.

;	0714	    old_entry [dr1$w_file_type] = 0;			!    Clear this out.

;	0715	

;	0716	!

;	0717	! The outer loop scans the ODS-1 directory once for each entry in the input directory buffer.

;	0718	! On each scan, the lowest entry is located, written to the ODS-2 directory, and marked as

;	0719	! null. If the top entry is null, the perceived top of buffer

;	0720	! is moved down one entry, and the next entry is processed. This loop continues until

;	0721	! all entries in the input directory are seen.

;	0722	!

;	0723	

;	0724	    WHILE 1 DO						! Loop to process entire directory buffer.

;	0725	        BEGIN

;	0726	

;	0727	!

;	0728	! Find the first non-null entry in the buffer. Set current_entry to this entry. Set

;	0729	! next_entry to one past this entry.

;	0730	!

;	0731	

;	0732	        WHILE

;	0733	            (.current_top [dr1$w_fid_num] EQL 0) AND	! If the current entry is null, and

;	0734	                (.current_top LSSU .direc_bottom)	!    this is not the end of the buffer,

;	0735	        DO

;	0736	            current_top = .current_top + dr1$k_length;	!    then move the top of buffer down one entry.

;	0737	        IF .current_top GEQU .direc_bottom		! If we have processed the entire buffer,

;	0738	        THEN

;	0739	            BEGIN

;	0740	            IF .sorted_top EQL .sorted_bufptr		!    and no entries were found,

;	0741	            THEN

;	0742	                sorted_bufptr [dir$w_size] =		!    set an end of block flag here.

;	0743	                        end_of_block;

;	0744	            EXITLOOP;					! In any case, stop processing.

;	0745	            END;

;	0746	

;	0747	        current_entry = .current_top;			! Setup a new entry to scan through buffer.

;	0748	        next_entry = .current_entry + dr1$k_length;	! Setup the next entry too.

;	0749	

;	0750	!

;	0751	! This inner loop scans the input buffer once and comes up with the entry that is lowest in

;	0752	! the collating sequence.

;	0753	!

;	0754	

;	0755	        WHILE 1 DO

;	0756	

;	0757	scan_loop:

;	0758	

;	0759	            BEGIN

;	0760	



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5-3

; Digital Equipment Corporation

;

;	0761	!

;	0762	! First see whether the directory has been entirely scanned.

;	0763	!

;	0764	

;	0765	            IF .next_entry GEQU .direc_bottom		! If this next entry is past the end of the

;	0766	            THEN					!    directory, then

;	0767	                EXITLOOP;				!    then stop scanning.

;	0768	

;	0769	!

;	0770	! If the next entry is null, get the next entry in the input directory buffer.

;	0771	! This is another entry, so go back to the beginning of scan_loop and compare it.

;	0772	!

;	0773	

;	0774	            IF .next_entry [dr1$w_fid_num] EQL 0	! If null entry,

;	0775	            THEN

;	0776	                BEGIN

;	0777	                next_entry = .next_entry

;	0778	                                + dr1$k_length;		! Move to next entry.

;	0779	                LEAVE scan_loop;			!    go get another.

;	0780	                END;

;	0781	

;	0782	!

;	0783	! Now compare the name, type, and version number fields of the current entry with the

;	0784	! next entry. If next entry is smaller than current entry, make next entry the new current

;	0785	! entry and go on to get another next. If next entry is bigger, just get next. Entries

;	0786	! will never be equal. Note that version number comparison is reversed from name and type --

;	0787	! the highest version number remains or becomes the current entry, so that entries

;	0788	! are collected most recent versions first.

;	0789	!

;	0790	

;	0791	            compare_entries ([dr1$w_name_1]);		! Compare first three letters in name,

;	0792	            compare_entries ([dr1$w_name_2]);		!    and second three letters,

;	0793	            compare_entries ([dr1$w_name_3]);		!    and third three letters;

;	0794	            compare_entries ([dr1$w_file_type]);	!    then compare file type.

;	0795	            IF .current_entry [dr1$w_version] LSSU	! If version of current is less than version

;	0796	                    .next_entry [dr1$w_version]

;	0797	            THEN

;	0798	                current_entry = .next_entry;		!    of next entry, swap them.

;	0799	

;	0800	            next_entry = .next_entry + dr1$k_length;	! Move to next entry.

;	0801	            END;					! End of scan loop.

;	0802	

;	0803	!

;	0804	! The input directory is scanned and current_entry holds the lowest entry in the collating sequence.

;	0805	! Write the new lowest directory entry into the output buffer. Save the name and type.

;	0806	!

;	0807	

;	0808	        write_entry (					! Write the entry in ODS-2 format.

;	0809	                        .current_entry,			!    Specify the current entry pointer,

;	0810	                        old_entry,			!    the address of the last entry written,

;	0811	                        sorted_top);			!    and the pointer to the

;	0812								!    current top of the sorted directory.

;	0813	

;	0814	        old_entry [dr1$w_name_1] = 			! Save the name and type of this entry

;	0815	            .current_entry [dr1$w_name_1];



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5-4

; Digital Equipment Corporation

;

;	0816	        old_entry [dr1$w_name_2] =			!    later comparison.

;	0817	            .current_entry [dr1$w_name_2];

;	0818	        old_entry [dr1$w_name_3] =

;	0819	            .current_entry [dr1$w_name_3];

;	0820	        old_entry [dr1$w_file_type] =

;	0821	            .current_entry [dr1$w_file_type];

;	0822	

;	0823	!

;	0824	! Zero first field of the current directory entry so that it will not be found again on a scan.

;	0825	!

;	0826	

;	0827	        current_entry [dr1$w_fid_num] = 0;		! Zero first three letter field.

;	0828	

;	0829	        END;						! End of outer loop.

;	0830	

;	0831	!

;	0832	! Reset pointers to directory buffer for later purge processing. Reset end of block marker.

;	0833	!

;	0834	

;	0835	    direc_buftop = .sorted_bufptr;			! Store a new permanent head of buffer.

;	0836	    direc_bufptr = .sorted_bufptr;			! New buffer is to be used in purging files.

;	0837	    end_block_no = 1;					! The directory is one virtual block

;	0838	

;	0839	    END;











					 083C 00166 FORMAT_ODS1_DIR:

							    .WORD   Save R2,R3,R4,R5,R11				      ; 0596

		         5B	0000'  CF  9E 00168 	    MOVAB   SORTED_BUFPTR, R11					      ;

		         5E	       14  C2 0016D 	    SUBL2   #20, SP						      ;

				  0C   AB  D5 00170 	    TSTL    END_BLOCK_NO					      ; 0688

				       11  12 00173 	    BNEQ    1$							      ;

		         50	       6B  D0 00175 	    MOVL    SORTED_BUFPTR, R0					      ; 0691

		         60	       01  AE 00178 	    MNEGW   #1, (R0)						      ;

		    04   AB	       50  D0 0017B 	    MOVL    R0, DIREC_BUFTOP					      ; 0692

		    FC   AB	       50  D0 0017F 	    MOVL    R0, DIREC_BUFPTR					      ; 0693

				     00A6  31 00183 	    BRW     11$							      ; 0694

	   50	    0C   AB	       09  78 00186 1$:     ASHL    #9, END_BLOCK_NO, R0				      ; 0702

	   55	         50	  FC   AB  C1 0018B 	    ADDL3   DIREC_BUFPTR, R0, DIREC_BOTTOM			      ; 0703

		         54	  FC   AB  D0 00190 	    MOVL    DIREC_BUFPTR, CURRENT_TOP				      ; 0709

		         6E	       6B  D0 00194 	    MOVL    SORTED_BUFPTR, SORTED_TOP				      ; 0710

				  0A   AE  7C 00197 	    CLRQ    OLD_ENTRY+6						      ; 0711

				       64  B5 0019A 2$:     TSTW    (CURRENT_TOP)					      ; 0733

				       0A  12 0019C 	    BNEQ    4$							      ;

		         55	       54  D1 0019E 	    CMPL    CURRENT_TOP, DIREC_BOTTOM				      ; 0734

				       05  1E 001A1 	    BGEQU   4$							      ;

		         54	       10  C0 001A3 	    ADDL2   #16, CURRENT_TOP					      ; 0736

				       F2  11 001A6 3$:     BRB     2$							      ; 0732

		         55	       54  D1 001A8 4$:     CMPL    CURRENT_TOP, DIREC_BOTTOM				      ; 0737

				       0B  1F 001AB 	    BLSSU   5$							      ;

		         6B	       6E  D1 001AD 	    CMPL    SORTED_TOP, SORTED_BUFPTR				      ; 0740

				       72  12 001B0 	    BNEQ    10$							      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 5-5

; Digital Equipment Corporation

;

		    00   BB	       01  AE 001B2 	    MNEGW   #1, @SORTED_BUFPTR					      ; 0742

				       6C  11 001B6 	    BRB     10$							      ; 0744

		         52	       54  D0 001B8 5$:     MOVL    CURRENT_TOP, CURRENT_ENTRY				      ; 0747

	   53	         52	       10  C1 001BB 	    ADDL3   #16, CURRENT_ENTRY, NEXT_ENTRY			      ; 0748

		         55	       53  D1 001BF 6$:     CMPL    NEXT_ENTRY, DIREC_BOTTOM				      ; 0765

				       4B  1E 001C2 	    BGEQU   9$							      ;

				       63  B5 001C4 	    TSTW    (NEXT_ENTRY)					      ; 0774

				       42  13 001C6 	    BEQL    8$							      ;

		    06   A3	  06   A2  B1 001C8 	    CMPW    6(CURRENT_ENTRY), 6(NEXT_ENTRY)			      ; 0791

				       38  1A 001CD 	    BGTRU   7$							      ;

		    06   A3	  06   A2  B1 001CF 	    CMPW    6(CURRENT_ENTRY), 6(NEXT_ENTRY)			      ;

				       34  1F 001D4 	    BLSSU   8$							      ;

		    08   A3	  08   A2  B1 001D6 	    CMPW    8(CURRENT_ENTRY), 8(NEXT_ENTRY)			      ; 0792

				       2A  1A 001DB 	    BGTRU   7$							      ;

		    08   A3	  08   A2  B1 001DD 	    CMPW    8(CURRENT_ENTRY), 8(NEXT_ENTRY)			      ;

				       26  1F 001E2 	    BLSSU   8$							      ;

		    0A   A3	  0A   A2  B1 001E4 	    CMPW    10(CURRENT_ENTRY), 10(NEXT_ENTRY)			      ; 0793

				       1C  1A 001E9 	    BGTRU   7$							      ;

		    0A   A3	  0A   A2  B1 001EB 	    CMPW    10(CURRENT_ENTRY), 10(NEXT_ENTRY)			      ;

				       18  1F 001F0 	    BLSSU   8$							      ;

		    0C   A3	  0C   A2  B1 001F2 	    CMPW    12(CURRENT_ENTRY), 12(NEXT_ENTRY)			      ; 0794

				       0E  1A 001F7 	    BGTRU   7$							      ;

		    0C   A3	  0C   A2  B1 001F9 	    CMPW    12(CURRENT_ENTRY), 12(NEXT_ENTRY)			      ;

				       0A  1F 001FE 	    BLSSU   8$							      ;

		    0E   A3	  0E   A2  B1 00200 	    CMPW    14(CURRENT_ENTRY), 14(NEXT_ENTRY)			      ; 0795

				       03  1E 00205 	    BGEQU   8$							      ;

		         52	       53  D0 00207 7$:     MOVL    NEXT_ENTRY, CURRENT_ENTRY				      ; 0798

		         53	       10  C0 0020A 8$:     ADDL2   #16, NEXT_ENTRY					      ; 0800

				       B0  11 0020D 	    BRB     6$							      ; 0755

				       5E  DD 0020F 9$:     PUSHL   SP							      ; 0808

				  08   AE  9F 00211 	    PUSHAB  OLD_ENTRY						      ;

				       52  DD 00214 	    PUSHL   CURRENT_ENTRY					      ;

		  0000V  CF	       03  FB 00216 	    CALLS   #3, WRITE_ENTRY					      ;

		    0A   AE	  06   A2  7D 0021B 	    MOVQ    6(CURRENT_ENTRY), OLD_ENTRY+6			      ; 0814

				       62  B4 00220 	    CLRW    (CURRENT_ENTRY)					      ; 0827

				       82  11 00222 	    BRB     3$							      ; 0724

		    04   AB	       6B  D0 00224 10$:    MOVL    SORTED_BUFPTR, DIREC_BUFTOP				      ; 0835

		    FC   AB	       6B  D0 00228 	    MOVL    SORTED_BUFPTR, DIREC_BUFPTR				      ; 0836

		    0C   AB	       01  D0 0022C 11$:    MOVL    #1, END_BLOCK_NO					      ; 0837

					   04 00230 	    RET     							      ; 0596



; Routine Size:  203 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6

; Digital Equipment Corporation

;

;	0840	ROUTINE write_entry (new_entry, old_entry, buffer_ptr) : NOVALUE =

;	0841								! Writes an ODS-2 entry from an ODS-1 entry

;	0842	

;	0843	!++

;	0844	! Functional description

;	0845	!

;	0846	!	This routine converts an ODS-1 directory entry into an ODS-2 directory entry and

;	0847	!	writes it into an output buffer. If the entry is simply another version of the last

;	0848	!	directory entry written, then the version number and FID information is added to the

;	0849	!	last directory entry.

;	0850	!

;	0851	!	The calling routine is responsible for the address of the top of the output buffer

;	0852	!	and for the contents of the last entry written.

;	0853	!

;	0854	! Calling sequence

;	0855	!

;	0856	!	write_entry (new_entry.ra.v, old_entry.ra.v, buffer_ptr.ra.r)

;	0857	!

;	0858	! Input parameters

;	0859	!

;	0860	!	new_entry	- the address of the new entry to place in the output buffer

;	0861	!	old_entry	- the RAD-50 format name and type strings of the last entry written

;	0862	!	buffer_ptr	- a pointer to the address of the current entry in the output buffer

;	0863	!

;	0864	! Implicit inputs

;	0865	!

;	0866	!	The format of the new entry is an ODS-1 directory format. The name and type

;	0867	!	strings are in RAD-50.

;	0868	!

;	0869	! Output parameters

;	0870	!

;	0871	!	buffer_ptr	- the contents of the pointer is updated to point to a new directory entry

;	0872	!			  if one is written.

;	0873	!

;	0874	! Implicit outputs

;	0875	!

;	0876	!	Either the current entry in the output buffer has a version added to it, or a

;	0877	!	new version is written.

;	0878	!

;	0879	! Routine value

;	0880	!

;	0881	!	novalue

;	0882	!

;	0883	! Side effects

;	0884	!

;	0885	!	none

;	0886	!

;	0887	!--

;	0888	

;	0889	    BEGIN

;	0890	

;	0891	    MAP

;	0892	        new_entry	: REF BLOCK [, BYTE],

;	0893	        old_entry	: REF BLOCK [, BYTE],

;	0894	        buffer_ptr	: REF VECTOR;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6-1

; Digital Equipment Corporation

;

;	0895	

;	0896	    MACRO

;	0897	        eob_marker	= 8, 0, 16, 0%;			! End of block marker

;	0898	

;	0899	    LOCAL

;	0900	        buffer_top	: REF BLOCK [, BYTE],		! Holds current top of buffer

;	0901	        bottom_of_entry	: REF BLOCK [, BYTE],		! Holds address of first

;	0902								!    free byte at bottom of this entry

;	0903	        name_pointer,					! Character pointer to ASCII name

;	0904	        ascii_name	: BLOCK [14, BYTE],		! Holds ASCII file name/type combination

;	0905	        stg_length;					! Length of name/type string

;	0906	

;	0907	!

;	0908	! Make a pointer to the current top of the output buffer.

;	0909	!

;	0910	

;	0911	    buffer_top = .buffer_ptr [0];			! Points to current output entry.

;	0912	

;	0913	!

;	0914	! See whether the new entry is the same name, type combination as the last entry stored.

;	0915	!

;	0916	

;	0917	    IF (.old_entry [dr1$w_name_1] EQL			! If the three name fields

;	0918	            .new_entry [dr1$w_name_1]) AND		! are equal,

;	0919	       (.old_entry [dr1$w_name_2] EQL

;	0920	            .new_entry [dr1$w_name_2]) AND

;	0921	       (.old_entry [dr1$w_name_3] EQL

;	0922	            .new_entry [dr1$w_name_3]) AND

;	0923	       (.old_entry [dr1$w_file_type] EQL		! and the file type field is equal,

;	0924	            .new_entry [dr1$w_file_type])

;	0925	    THEN						!    then this is just another version of the

;	0926	        BEGIN						!    last entry.

;	0927	

;	0928	!

;	0929	! Another version to add to the last entry. Add the version number and the file identification

;	0930	! numbers to the bottom of this entry, and increase the stored size of the entry.

;	0931	!

;	0932	

;	0933	        bottom_of_entry = .buffer_top 			! Locate the end of the current entry.

;	0934	                            + .buffer_top [dir$w_size]	!    It is after this entry

;	0935	                            + 2;			!    and after the count bytes.

;	0936	        bottom_of_entry [dir$w_version] =		! Store the new version number.

;	0937	            .new_entry [dr1$w_version];

;	0938	        bottom_of_entry [dir$w_fid_num] =		! Store the three identification numbers:

;	0939	            .new_entry [dr1$w_fid_num];			!    the file identification number,

;	0940	        bottom_of_entry [dir$w_fid_seq] =		!    the file sequence number,

;	0941	            .new_entry [dr1$w_fid_seq];

;	0942	        bottom_of_entry [dir$w_fid_rvn] =		!    and the file revision number.

;	0943	            .new_entry [dr1$w_fid_rvn];

;	0944	

;	0945	!

;	0946	! Put a phony end of block marker here.

;	0947	!

;	0948	

;	0949	        bottom_of_entry [eob_marker] = end_of_block;	! This is to detect end of buffer.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6-2

; Digital Equipment Corporation

;

;	0950	

;	0951	        buffer_top [dir$w_size] =			! Increase the size of this entry by one version.

;	0952	            .buffer_top [dir$w_size] + dir$k_version;

;	0953	

;	0954	        END

;	0955	

;	0956	    ELSE

;	0957	        BEGIN

;	0958	

;	0959	!

;	0960	! Otherwise, this is a new entry. Move the buffer top to the first free byte after the current

;	0961	! entry. Load in the directory entry type.

;	0962	!

;	0963	

;	0964	        IF .buffer_top [dir$w_size] NEQ 0		! If this entry is in use,

;	0965	        THEN						!    then move to another one.

;	0966	            buffer_top = .buffer_top			! Move to space for a new directory entry

;	0967	                            + .buffer_top [dir$w_size] + 2;

;	0968	        buffer_ptr [0] = .buffer_top;			! Return new top of buffer to caller.

;	0969	        buffer_top [dir$v_type] = dir$c_fid;		! This is a normal file entry type.

;	0970	

;	0971	!

;	0972	! Initialize a buffer into which the RAD-50 file name and type can be converted. Then

;	0973	! convert the RAD-50 characters.

;	0974	!

;	0975	

;	0976	        name_pointer = ch$ptr (ascii_name);		! Make a character pointer of the ASCII buffer

;	0977	        ch$fill (					! Fill the buffer with blanks.

;	0978	                    0,					!    Specify zeroes to fill the buffer,

;	0979	                    14,					!    number of characters in the buffer,

;	0980	                    .name_pointer);			!    and a character pointer to the buffer.

;	0981	

;	0982	        del$r50_cvt3 (					! Convert the RAD-50 string to ASCII.

;	0983	                        new_entry [dr1$w_name_1],	!    Specify the address of the RAD-50 string,

;	0984	                        ascii_name);			!    and the ASCII buffer address.

;	0985	

;	0986	!

;	0987	! Determine how many characters are in the converted ASCII string. Write a dot after the

;	0988	! last character to separate file name from file type.

;	0989	!

;	0990	

;	0991	        name_pointer = ch$find_ch (			! Look for a zero at the end of the string.

;	0992	                                    14,			!    Specify the length of the string,

;	0993	                                    .name_pointer,	!    the pointer to the ASCII string,

;	0994	                                    0);			!    and the character to find.

;	0995	

;	0996	        ch$wchar_a ('.', name_pointer);			! Write a dot between the name and type strings.

;	0997	

;	0998	!

;	0999	! Now convert the file type RAD-50 string to ASCII.

;	1000	!

;	1001	

;	1002	        del$r50_cvt1 (					! Convert the file type from RAD-50 to ASCII.

;	1003	                        new_entry [dr1$w_file_type],	!    Specify the address of the RAD-50 string

;	1004	                        .name_pointer);			!    and the destination string address.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6-3

; Digital Equipment Corporation

;

;	1005	

;	1006	!

;	1007	! Calculate end of type string and thereby the length of the file name/type string. Load

;	1008	! this length rounded to an even number into the character count of the new directory entry.

;	1009	!

;	1010	

;	1011	        name_pointer = ch$find_ch (			! Locate the zero at the end of

;	1012	                                    14,			!    the type string. Specify the string length,

;	1013	                                    ch$ptr (ascii_name),!    the string address,

;	1014	                                    0);			!    and the zero to match.

;	1015	

;	1016	        buffer_top [dir$b_namecount] = ch$diff (	! Find the length of the string. Specify

;	1017	                                                .name_pointer,

;	1018	                                                ch$ptr (ascii_name));

;	1019								!    the address of end of string and start of string.

;	1020	

;	1021	!

;	1022	! Move the file name/type string into the directory entry.

;	1023	!

;	1024	

;	1025	        ch$move (					! Move the ASCII string into this entry in the

;	1026	                    .buffer_top [dir$b_namecount],	!    output buffer. Specify the length,

;	1027	                    ch$ptr (ascii_name),		!    the address of the character string,

;	1028	                    ch$ptr (buffer_top [dir$b_namecount] + 1));

;	1029								!    and the output address.

;	1030	

;	1031	!

;	1032	! Now move the version number and the file identification numbers into the

;	1033	! new directory entry.

;	1034	!

;	1035	

;	1036	        buffer_top [dir$w_size] = dir$k_length - 2	! Store length of this directory entry.

;	1037	                                    + dir$k_version	!    It is the length of overhead of an entry (minus size)

;	1038	                                    + .buffer_top [dir$b_namecount]

;	1039	                                    + (IF (.buffer_top [dir$b_namecount] MOD 2) NEQ 0

;	1040	                                       THEN

;	1041	                                           1		!    plus the length of one version, plus the

;	1042	                                       ELSE

;	1043	                                           0);		!    length of the name/type string rounded to even value.

;	1044	

;	1045	        buffer_top = .buffer_top			! Compute the beginning of the version number

;	1046	                        + .buffer_top [dir$w_size]	!    field. It is the top of the entry plus the

;	1047	                        - dir$k_version			!    size of the entry, minus the version part,

;	1048	                        + 2;				!    plus two for the count field.

;	1049	

;	1050	        buffer_top [dir$w_version] =			! Store the version number.

;	1051	                .new_entry [dr1$w_version];

;	1052	        buffer_top [dir$w_fid_num] =			! Store the identification numbers:

;	1053	                .new_entry [dr1$w_fid_num];		!    the identification number,

;	1054	        buffer_top [dir$w_fid_seq] =			!    the sequence number,

;	1055	                .new_entry [dr1$w_fid_seq];

;	1056	        buffer_top [dir$w_fid_rvn] =			!    and the revision number.

;	1057	                .new_entry [dr1$w_fid_rvn];

;	1058	

;	1059	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6-4

; Digital Equipment Corporation

;

;	1060	! Move phony end of block marker into first free byte.

;	1061	!

;	1062	

;	1063	        buffer_top [eob_marker] = end_of_block;		! This detects end of block.

;	1064	

;	1065	        END;

;	1066	

;	1067	    END;











					 0FFC 00231 WRITE_ENTRY:

							    .WORD   Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11		      ; 0840

		         5E	       10  C2 00233 	    SUBL2   #16, SP						      ;

		         58	  0C   BC  D0 00236 	    MOVL    @BUFFER_PTR, BUFFER_TOP				      ; 0911

		         56	  04   AC  D0 0023A 	    MOVL    NEW_ENTRY, R6					      ; 0918

		         50	  08   AC  D0 0023E 	    MOVL    OLD_ENTRY, R0					      ; 0917

		    06   A6	  06   A0  B1 00242 	    CMPW    6(R0), 6(R6)					      ;

				       33  12 00247 	    BNEQ    1$							      ;

		    08   A6	  08   A0  B1 00249 	    CMPW    8(R0), 8(R6)					      ; 0919

				       2C  12 0024E 	    BNEQ    1$							      ;

		    0A   A6	  0A   A0  B1 00250 	    CMPW    10(R0), 10(R6)					      ; 0921

				       25  12 00255 	    BNEQ    1$							      ;

		    0C   A6	  0C   A0  B1 00257 	    CMPW    12(R0), 12(R6)					      ; 0923

				       1E  12 0025C 	    BNEQ    1$							      ;

		         50	       68  3C 0025E 	    MOVZWL  (BUFFER_TOP), R0					      ; 0934

		         50	       58  C0 00261 	    ADDL2   BUFFER_TOP, R0					      ;

		         50	       02  C0 00264 	    ADDL2   #2, BOTTOM_OF_ENTRY					      ; 0935

		         60	  0E   A6  B0 00267 	    MOVW    14(R6), (BOTTOM_OF_ENTRY)				      ; 0936

		    02   A0	       66  B0 0026B 	    MOVW    (R6), 2(BOTTOM_OF_ENTRY)				      ; 0938

		    04   A0	  02   A6  D0 0026F 	    MOVL    2(R6), 4(BOTTOM_OF_ENTRY)				      ; 0940

		    08   A0	       01  AE 00274 	    MNEGW   #1, 8(BOTTOM_OF_ENTRY)				      ; 0949

		         68	       08  A0 00278 	    ADDW2   #8, (BUFFER_TOP)					      ; 0952

					   04 0027B 	    RET     							      ; 0917

				       68  B5 0027C 1$:     TSTW    (BUFFER_TOP)					      ; 0964

				       0A  13 0027E 	    BEQL    2$							      ;

		         50	       68  3C 00280 	    MOVZWL  (BUFFER_TOP), R0					      ; 0967

		         50	       58  C0 00283 	    ADDL2   BUFFER_TOP, R0					      ;

	   58	         50	       02  C1 00286 	    ADDL3   #2, R0, BUFFER_TOP					      ;

		    0C   BC	       58  D0 0028A 2$:     MOVL    BUFFER_TOP, @BUFFER_PTR				      ; 0968

		    04   A8	       07  8A 0028E 	    BICB2   #7, 4(BUFFER_TOP)					      ; 0969

		         59	       6E  9E 00292 	    MOVAB   ASCII_NAME, NAME_POINTER				      ; 0976

	   00	         6E	       00  2C 00295 	    MOVC5   #0, (SP), #0, #14, (NAME_POINTER)			      ; 0977

		         69	       0E     00299									      ;

		         57	       6E  9E 0029B 	    MOVAB   ASCII_NAME, R7					      ; 0982

		         54	  06   A6  9E 0029E 	    MOVAB   6(R6), R4						      ; 0983

				     0000  30 002A2 	    BSBW    DEL$R50_CVT3					      ; 0982

	   69	         0E	       00  3A 002A5 	    LOCC    #0, #14, (NAME_POINTER)				      ; 0991

				       02  12 002A9 	    BNEQ    3$							      ;

				       51  D4 002AB 	    CLRL    R1							      ;

		         59	       51  D0 002AD 3$:     MOVL    R1, NAME_POINTER					      ;

		         89	       2E  90 002B0 	    MOVB    #46, (NAME_POINTER)+				      ; 0996

		         54	  0C   A6  9E 002B3 	    MOVAB   12(R6), R4						      ; 1003



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 6-5

; Digital Equipment Corporation

;

		         57	       59  D0 002B7 	    MOVL    NAME_POINTER, R7					      ; 1002

				     0000  30 002BA 	    BSBW    DEL$R50_CVT1					      ;

	   6E	         0E	       00  3A 002BD 	    LOCC    #0, #14, ASCII_NAME					      ; 1011

				       02  12 002C1 	    BNEQ    4$							      ;

				       51  D4 002C3 	    CLRL    R1							      ;

		         59	       51  D0 002C5 4$:     MOVL    R1, NAME_POINTER					      ;

		         57	  05   A8  9E 002C8 	    MOVAB   5(BUFFER_TOP), R7					      ; 1016

		         50	       6E  9E 002CC 	    MOVAB   ASCII_NAME, R0					      ; 1018

	   67	         59	       50  83 002CF 	    SUBB3   R0, NAME_POINTER, (R7)				      ;

		         50	       67  9A 002D3 	    MOVZBL  (R7), R0						      ; 1026

      01   A7	         6E	       50  28 002D6 	    MOVC3   R0, ASCII_NAME, 1(R7)				      ; 1025

		         50	       67  9A 002DB 	    MOVZBL  (R7), R0						      ; 1039

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

				       7E     002E2									      ;

	   50	         8E	       02  7B 002E3 	    EDIV    #2, (SP)+, R0, R0					      ;

				       50     002E7									      ;

				       50  D5 002E8 	    TSTL    R0							      ;

				       05  13 002EA 	    BEQL    5$							      ;

		         50	       01  D0 002EC 	    MOVL    #1, R0						      ;

				       02  11 002EF 	    BRB     6$							      ;

				       50  D4 002F1 5$:     CLRL    R0							      ;

		         51	       67  9A 002F3 6$:     MOVZBL  (R7), R1						      ;

		         50	       51  C0 002F6 	    ADDL2   R1, R0						      ;

	   68	         50	       0C  A1 002F9 	    ADDW3   #12, R0, (BUFFER_TOP)				      ;

		         50	       68  3C 002FD 	    MOVZWL  (BUFFER_TOP), R0					      ; 1046

		         50	       58  C0 00300 	    ADDL2   BUFFER_TOP, R0					      ;

	   58	         50	       06  C3 00303 	    SUBL3   #6, R0, BUFFER_TOP					      ; 1048

		         68	  0E   A6  B0 00307 	    MOVW    14(R6), (BUFFER_TOP)				      ; 1050

		    02   A8	       66  B0 0030B 	    MOVW    (R6), 2(BUFFER_TOP)					      ; 1052

		    04   A8	  02   A6  D0 0030F 	    MOVL    2(R6), 4(BUFFER_TOP)				      ; 1054

		    08   A8	       01  AE 00314 	    MNEGW   #1, 8(BUFFER_TOP)					      ; 1063

					   04 00318 	    RET     							      ; 0840



; Routine Size:  232 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7

; Digital Equipment Corporation

;

;	1068	ROUTINE purge_ods2_dir (spec_desc, fab_block) : NOVALUE =

;	1069								! Purges an ODS-2 directory of files that match a spec

;	1070	

;	1071	!++

;	1072	! Functional description

;	1073	!

;	1074	!	Search a file directory for all entries whose file name and type combination match

;	1075	!	the name/type described by the argument. For each match, save the most recent version(s) of

;	1076	!	the file and purge all previous versions. The file name/type passed as the argument may

;	1077	!	contain wildcards in one or both fields.

;	1078	!

;	1079	!	First calculate the address and length of the file name and the file type field. For

;	1080	!	each entry, also calculate the address and length of the file name and file type fields.

;	1081	!	Then decode whether the name/type combinations match. Use the following match criteria:

;	1082	!

;	1083	!	For file name and type

;	1084	!		if wild, match is true

;	1085	!		else if explicit and match, match is true

;	1086	!		else if explicit and not match, match is false

;	1087	!		else match is true because field was not specified

;	1088	!

;	1089	!	For each directory entry whose name/type matches the argument, save as many

;	1090	!	versions as is specified by the value of DEL$KEEPVER_VAL, and delete the rest. The

;	1091	!	directory entries are constructed as follows:

;	1092	!

;	1093	!		|-------------------------------|

;	1094	!		|   file name and type string   |

;	1095	!		|-------------------------------|

;	1096	!		|         version number        |

;	1097	!		|-------------------------------|

;	1098	!		|       file identification     |

;	1099	!		|-------------------------------|

;	1100	!		|         version number        |

;	1101	!		|-------------------------------|

;	1102	!		|                               |

;	1103	!		|              etc.             |

;	1104	!

;	1105	!	The version numbers are ordered as most recent version first.

;	1106	!

;	1107	! Calling sequence

;	1108	!

;	1109	!	purge_ods2_dir (spec_desc.rt.ds, fab_block.ra.v)

;	1110	!

;	1111	! Input parameters

;	1112	!

;	1113	!	spec_desc	- a string descriptor of the file name to match

;	1114	!	fab_block	- a FAB block that describes the file name/type combination

;	1115	!

;	1116	! Implicit inputs

;	1117	!

;	1118	!	direc_bufptr	- points to the beginning of the directory buffer

;	1119	!	del$keepver_val	- number of versions to keep of each file/type combination

;	1120	!

;	1121	! Output parameters

;	1122	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-1

; Digital Equipment Corporation

;

;	1123	!	none

;	1124	!

;	1125	! Implicit outputs

;	1126	!

;	1127	!	After processing is complete, direc_bufptr points past the last entry in the directory buffer.

;	1128	!

;	1129	! Routine value

;	1130	!

;	1131	!	novalue

;	1132	!

;	1133	! Side effects

;	1134	!

;	1135	!	Files may be deleted.

;	1136	!

;	1137	!--

;	1138	

;	1139	    BEGIN

;	1140	

;	1141	    MAP

;	1142	        spec_desc	: REF BLOCK [, BYTE],

;	1143	        fab_block	: REF BLOCK [, BYTE];

;	1144	

;	1145	    BIND

;	1146	        nam_block	=				! NAM block associated with FAB block argument

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

;	1148	

;	1149	    LABEL

;	1150	        match_loop;

;	1151	

;	1152	    LOCAL

;	1153	        spec_length,					! Holds unread length of input file string

;	1154	        spec_ptr,					! Pointer to a character string

;	1155	        spec_name_ptr,					! Pointer to the file name string

;	1156	        spec_type_ptr,					! Pointer to the file type string

;	1157	        spec_name_len,					! Length of the file name string

;	1158	        spec_type_len,					! Length of the file type string

;	1159	        entry_desc	: BLOCK [8, BYTE],		! String descriptor for a directory entry

;	1160	        entry_name_ptr,					! Pointer to an entry file name string

;	1161	        entry_type_ptr,					! Pointer to an entry file type string

;	1162	        entry_name_len,					! Length of an entry file name string

;	1163	        entry_type_len,					! Length of an entry file type string

;	1164	        count,						! Loop counter variable

;	1165	        match_flag,					! Boolean, says a match has been found

;	1166	        version_list	: REF BLOCK [, BYTE],		! Pointer to a version list

;	1167	        versions_saved,					! Count of versions of a file saved so far.

;	1168	        num_files_purg,					! Count of files purged.

;	1169	        error_desc	: BLOCK [8, BYTE],		! String descriptor for error buffer

;	1170	        error_bufptr,					! Character pointer to error buffer

;	1171	        dev_dir_length,					! Length of device/directory string

;	1172	        status;						! Status variable for RMS return

;	1173	

;	1174	!

;	1175	! First turn off the wildcard bit so that no one else tries to process any wildcards in this spec.

;	1176	! Also, initialize the number of files purged from this file specification.

;	1177	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-2

; Digital Equipment Corporation

;

;	1178	

;	1179	    del$cli_status [wildcard_bit] = FALSE;		! Turn off bit in status word.

;	1180	    num_files_purg = 0;					! Number of files purged is zero.

;	1181	

;	1182	!

;	1183	! If the directory is empty, just report that no files were purged and return.

;	1184	!

;	1185	

;	1186	    IF .direc_bufptr [dir$w_size] EQLU end_of_block	! If no entries in this block

;	1187	        AND .end_block_no EQL 1				!    and only one block exists in the directory,

;	1188	    THEN

;	1189	        BEGIN

;	1190	        put_message (					!    then tell user that no files were purged.

;     P 1191	                        msg$_nofilpurg,			!    Message is "no files purged",

;     P 1192	                        1,				!    FAO count is one argument,

;     P 1193	                        .spec_desc);			!    and give address of file spec descriptor.

;	1194	        RETURN;						! Return successfully.

;	1195	        END;

;	1196	

;	1197	!

;	1198	! Initialize the error buffer descriptor. If a file cannot be purged, this buffer is used

;	1199	! to report the failure. The buffer also holds a file name for logging file purges.

;	1200	!

;	1201	

;	1202	    error_desc [dsc$w_length] = err_buf_len;		! Length of error buffer

;	1203	    error_desc [dsc$a_pointer] = error_buffer;		! Address of buffer

;	1204	

;	1205	!

;	1206	! Find the addresses and lengths of the file name and file type in the string described

;	1207	! by the input parameter.

;	1208	!

;	1209	

;	1210	    spec_length = .spec_desc [dsc$w_length];		! Get original length of file spec string.

;	1211	    spec_ptr = ch$ptr (.spec_desc [dsc$a_pointer]);	! Make a character pointer to the input string

;	1212	    count = 0;						! Initialize loop count variable.

;	1213	    WHILE 1 DO

;	1214	        BEGIN

;	1215	

;	1216	!

;	1217	! Look for a ']' or a '>' that is not followed by a ':'.

;	1218	!

;	1219	

;	1220	        spec_name_ptr = ch$find_ch (			! Look for a closing angle bracket.

;	1221	                                    .spec_length,

;	1222	                                    .spec_ptr,		!    Specify the length of the string, the pointer

;	1223	                                    '>');		!    to the string, and the character to match.

;	1224	        IF ch$fail (					! If the character is not found,

;	1225	                    .spec_name_ptr)			!

;	1226	        THEN

;	1227	            spec_name_ptr = ch$find_ch (		!    then look for a closing square bracket.

;	1228	                                        .spec_length,

;	1229	                                        .spec_ptr,

;	1230	                                        ']');		!    Specify the same arguments.

;	1231	

;	1232	        IF ch$fail (					! If neither character is seen,



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-3

; Digital Equipment Corporation

;

;	1233	                    .spec_name_ptr)

;	1234	        THEN

;	1235	            BEGIN

;	1236	            put_message (				!    then signal an error

;     P 1237	                            msg$_delinterr);

;	1238	            RETURN;					!    and return to caller.

;	1239	            END;

;	1240	

;	1241	        spec_length = .spec_length			! Calculate the remaining length of the input string.

;	1242	                    - ch$diff (				!    It is the original length,

;	1243	                                .spec_name_ptr,		!    minus the address of the name string

;	1244	                                .spec_ptr) - 1;		!    minus the address of the original string

;	1245								!    minus the closing bracket.

;	1246	        IF ch$a_rchar (spec_name_ptr) NEQ ':'		! If the next character is not a colon,

;	1247	        THEN EXITLOOP;					!    then exit with address of file name.

;	1248	

;	1249	!

;	1250	! This must be a network file specification. Pass up the node name and look for the real

;	1251	! directory specification.

;	1252	!

;	1253	

;	1254	        spec_ptr = .spec_name_ptr;			! Reload variables for loop rerun.

;	1255	        count = .count + 1;				! Increment the count of times through the loop.

;	1256	        IF .count GTR 1					! If this is the second time through

;	1257	        THEN

;	1258	            BEGIN

;	1259	            put_message (				!    then point out that RMS has output a bad file name.

;     P 1260	                            msg$_delinterr);

;	1261	            RETURN;					! And return to the caller.

;	1262	            END;

;	1263	

;	1264	        END;						! Go back to start of loop.

;	1265	

;	1266	!

;	1267	! Compute and save the length of the device and directory string.

;	1268	!

;	1269	

;	1270	    dev_dir_length = .spec_desc [dsc$w_length] 		! Original length minus remaining length gives

;	1271	                        - .spec_length;			!    length of device/directory string.

;	1272	

;	1273	!

;	1274	! The beginning of the file name has been located. Now look for the start of the file type,

;	1275	! which is marked by a '.' (period).

;	1276	!

;	1277	

;	1278	    spec_type_ptr = ch$find_ch (			! Look through the remaining input string for a file

;	1279	                                .spec_length,		!    type separator.

;	1280	                                .spec_name_ptr,		!    Specify the length of the remaining string, the

;	1281	                                '.');			!    address of the file name, and the separator character.

;	1282	    IF ch$fail (					! If the period is not to be seen,

;	1283	                .spec_type_ptr)

;	1284	    THEN

;	1285	        BEGIN

;	1286	        put_message (					!    then report an error

;     P 1287	                        msg$_delinterr);



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-4

; Digital Equipment Corporation

;

;	1288	        RETURN;						!    and return to the caller.

;	1289	        END;

;	1290	

;	1291	    spec_name_len = ch$diff (				! Calculate the length of the file name string.

;	1292	                                .spec_type_ptr,		!    It is the difference between the start of the type

;	1293	                                .spec_name_ptr);	!    string and the name string.

;	1294	

;	1295	!

;	1296	! Finally look for the beginning of the version number string in order to compute

;	1297	! the length of the file type string.

;	1298	!

;	1299	

;	1300	    spec_ptr = ch$find_ch (				! In the remainder of the input string, look for a

;	1301	                            .spec_length - .spec_name_len,

;	1302	                            .spec_type_ptr,		!    semicolon. Specify the remaining length, the address

;	1303	                            ';');			!    of the type string, and the character to match.

;	1304	    IF ch$fail (					! if no semicolon is present,

;	1305	                .spec_ptr)

;	1306	    THEN

;	1307	        BEGIN

;	1308	        put_message (					!    then signal an error,

;     P 1309	                        msg$_delinterr);

;	1310	        RETURN;						!    and return to the caller.

;	1311	        END;

;	1312	

;	1313	    spec_type_len = ch$diff (				! Calculate the length of the file type string.

;	1314	                                .spec_ptr,		!    It is the difference between the start of the

;	1315	                                .spec_type_ptr);	!    type and version number strings.

;	1316	

;	1317	!

;	1318	! Obtain the first entry in the ODS-2 directory buffer. If it is null, ask for more until

;	1319	! a null entry or end of directory is seen.

;	1320	!

;	1321	

;	1322	    IF .direc_bufptr [dir$w_size] NEQU end_of_block	! If this entry is not end of block,

;	1323	    THEN

;	1324	        BEGIN

;	1325	        IF .direc_bufptr [dir$v_type] EQL dir$c_fid	! If this entry is a normal file entry,

;	1326	        THEN

;	1327	            BEGIN

;	1328	            entry_desc [dsc$w_length] =			!    then store the length of the name/type string,

;	1329	                .direc_bufptr [dir$b_namecount];

;	1330	            entry_desc [dsc$a_pointer] =		!    as well as its address.

;	1331	                direc_bufptr [dir$b_namecount] + 1;

;	1332	            END

;	1333	        END

;	1334	    ELSE

;	1335	        IF NOT find_ods2_file (				! Otherwise, look for an entry.

;	1336	                                entry_desc)		!    Specify a string descriptor.

;	1337	        THEN

;	1338	            RETURN;					! If none at all, just return.

;	1339	

;	1340	!

;	1341	! The loop labelled match_loop that follows compares each entry in the directory file

;	1342	! with the input string. If a match is found, the older versions of that file are deleted.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-5

; Digital Equipment Corporation

;

;	1343	! The loop is executed until each entry in the directory has been processed.

;	1344	!

;	1345	

;	1346	    DO							! Execute this loop once per directory entry.

;	1347	

;	1348	match_loop:

;	1349	        BEGIN

;	1350	        entry_name_ptr = ch$ptr (			! Make a character pointer of the directory entry.

;	1351	                                    .entry_desc [dsc$a_pointer]);

;	1352	        entry_type_ptr = ch$find_ch (			! Find the beginning of the file type string in

;	1353	                                        .entry_desc [dsc$w_length],

;	1354	                                        .entry_name_ptr,

;	1355	                                        '.');		!    the directory entry. It is marked by a '.'.

;	1356	        IF ch$fail (					! If a period is not present,

;	1357	                    .entry_type_ptr)			!    then the directory file is corrupted.

;	1358	        THEN

;	1359	            BEGIN

;	1360	            put_message (				! Signal an error to the user,

;     P 1361	                            msg$_delinterr);

;	1362	            RETURN;					! and return to the caller.

;	1363	            END;

;	1364	

;	1365	        entry_name_len = ch$diff (			! Compute the length of the file name string in the entry.

;	1366	                                    .entry_type_ptr,	!    It is the difference between the start of the file type

;	1367	                                    .entry_name_ptr);	!    and the file name strings.

;	1368	        entry_type_len = .entry_desc [dsc$w_length]	! Also compute the length of the file type string.

;	1369	                            -.entry_name_len;		!    It is the remainder of the string.

;	1370	

;	1371	!

;	1372	! Test for match of file name and type.

;	1373	!

;	1374	

;	1375	        IF .spec_name_len EQL 1 AND			! If the input file specification had a wildcard

;	1376	            ch$rchar (.spec_name_ptr) EQL '*'		!    in the file name field

;	1377	        THEN

;	1378	            match_flag = TRUE				! Then there is a match so far.

;	1379	

;	1380	        ELSE

;	1381	            IF ch$eql (					! Otherwise, test for character string match.

;	1382	                        .spec_name_len,			!    Specify input name length,

;	1383	                        .spec_name_ptr,			!    input name address,

;	1384	                        .entry_name_len,		!    entry name length, and

;	1385	                        .entry_name_ptr)		!    entry name address.

;	1386	            THEN

;	1387	                match_flag = TRUE			! If the strings match, then set flag;

;	1388	            ELSE

;	1389	                LEAVE match_loop;			!    otherwise, go try next entry.

;	1390	

;	1391	        IF ch$eql (					! If the input file specification has a wildcard

;	1392	                    .spec_type_len,			!    type field,

;	1393	                    .spec_type_ptr,

;	1394	                    2,

;	1395	                    UPLIT BYTE (%ASCII '.*'))

;	1396	        THEN

;	1397	            match_flag = TRUE				! then there is a match.



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-6

; Digital Equipment Corporation

;

;	1398	        ELSE

;	1399	            IF ch$eql (					! Otherwise, test for character string match.

;	1400	                        .spec_type_len,			!    Specify input type length,

;	1401	                        .spec_type_ptr,			!    input type address,

;	1402	                        .entry_type_len,		!    entry type length, and

;	1403	                        .entry_type_ptr)		!    entry type address.

;	1404	            THEN

;	1405	                match_flag = TRUE			! If the strings match, then set flag;

;	1406	            ELSE

;	1407	                LEAVE match_loop;			!    otherwise, go look at next entry.

;	1408	

;	1409	!

;	1410	! The file name/type combination matches this directory entry.

;	1411	! In sequence, pick up each version number record that represents a file and after saving the

;	1412	! requested number of recent versions, delete all the older versions. Note that the version

;	1413	! numbers are stored in the order of most recent files first.

;	1414	!

;	1415	

;	1416	        version_list = .direc_bufptr			! Make a pointer to the beginning of the version

;	1417	                        + dir$k_length			!    list. It is the start of the entry, plus a constant,

;	1418	                        + .direc_bufptr [dir$b_namecount]

;	1419	                        + (IF (.direc_bufptr [dir$b_namecount] MOD 2) NEQ 0

;	1420	                           THEN				!    the character count rounded up to 

;	1421	                               1			!    an even number.

;	1422	                           ELSE

;	1423	                               0);

;	1424	        versions_saved = 0;				! Set the number of versions saved to zero.

;	1425	

;	1426	        DO						! Loop checking versions until no more versions left.

;	1427	            BEGIN

;	1428	            IF .versions_saved GEQ .del$keepver_val	! If we have saved enough versions of this entry,

;	1429	            THEN

;	1430	                BEGIN					!    then delete the file specified by this file id.

;	1431	                nam_block [nam$w_fid_num] =		! Copy the file identification number,

;	1432	                    .version_list [dir$w_fid_num];

;	1433	                nam_block [nam$w_fid_seq] =		!    the file sequence number,

;	1434	                    .version_list [dir$w_fid_seq];

;	1435	                nam_block [nam$w_fid_rvn] =		!    and the file version number into the NAM block.

;	1436	                    .version_list [dir$w_fid_rvn];

;	1437	                status = $RMS_ERASE (			! And erase the file.

;     P 1438	                                        FAB = .fab_block);

;	1439								!    Specify a FAB block address

;	1440	

;	1441	!

;	1442	! If the purge succeeds, increment number of files purged.

;	1443	!

;	1444	

;	1445	                IF .status				! If the PURGE works,

;	1446	                THEN					!    then increment files purged count.

;	1447	                    num_files_purg = .num_files_purg + 1;

;	1448	

;	1449	!

;	1450	! If logging files purged or if this file could not be erased, collect a complete file

;	1451	! specification and tell user the name of the file and its disposition.

;	1452	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-7

; Digital Equipment Corporation

;

;	1453	

;	1454	                IF NOT .status OR			! If the ERASE failed,

;	1455	                    .del$cli_status [log_msg_bit]	!    or if logging is going on,

;	1456	                THEN

;	1457	                    BEGIN				! Make up the file name from parts.

;	1458	                    ch$copy (				! Copy the device and directory strings

;	1459	                                .dev_dir_length,	!    to the error buffer.

;	1460	                                ch$ptr (.spec_desc [dsc$a_pointer]),

;	1461	                                0,			!    Specify lengths, pointers to input and

;	1462	                                .dev_dir_length,	!    output buffers, and a zero fill character.

;	1463	                                ch$ptr (error_buffer));

;	1464	

;	1465	                    error_bufptr = ch$plus (		! Point past the device/directory string

;	1466	                                            ch$ptr (error_buffer),

;	1467	                                            .dev_dir_length);

;	1468								!    in the output buffer.

;	1469	                    ch$copy (				! Now copy in the file name and type string.

;	1470	                                .entry_desc [dsc$w_length],

;	1471	                                ch$ptr (.entry_desc [dsc$a_pointer]),

;	1472	                                0,			!    Specify lengths and pointers to input and

;	1473	                                .entry_desc [dsc$w_length],

;	1474	                                .error_bufptr);		!    output buffers, and zero fill character.

;	1475	

;	1476	                    error_bufptr = ch$plus (		! Advance output buffer pointer past name/type.

;	1477	                                            .error_bufptr,

;	1478	                                            .entry_desc [dsc$w_length]);

;	1479	                    ch$wchar_a (			! Write a semi-colon after the file type.

;	1480	                                ';',			!    Specify a semi-colon and

;	1481	                                error_bufptr);		!    and the buffer pointer.

;	1482	

;	1483	                    error_desc [dsc$w_length] =		! Length of string is dev/dir + file name/type

;	1484	                            .dev_dir_length + .entry_desc [dsc$w_length] + 1;

;	1485								!    plus one for the semi-colon.

;	1486	

;	1487	                    IF NOT .status			! If file could not be purged,

;	1488	                    THEN

;	1489	                        put_messagex (			! Tell user about the file.

;     P 1490	                                     msg$_filnotpur,	!    then send a "not purged" message,

;     P 1491	                                     2,			!    Also send number of arguments,

;     P 1492	                                     error_desc,	!    a descriptor to the file specification,

;     P 1493	                                     .version_list [dir$w_version],

;     P 1494								!    and the version number in binary.

;     P 1495	                                     .fab_block [fab$l_sts],

;     P 1496	                                     .fab_block [fab$l_stv])

;	1497								!    Also send the FAB status information.

;	1498	                    ELSE

;	1499	                        put_message (			! Otherwise, log the file deletion,

;     P 1500	                                     msg$_filpurged,	!    Send the proper "file deleted" message code,

;     P 1501	                                     2,                 !    the number of FAO arguments 

;     P 1502	                                     error_desc,	!    a descriptor to the file specification,

;     P 1503	                                     .version_list [dir$w_version]);

;	1504								!    and the binary version number.

;	1505	                    END;

;	1506	                END

;	1507	            ELSE



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-8

; Digital Equipment Corporation

;

;	1508	                versions_saved = .versions_saved + 1;	! Otherwise, increment the count of versions saved.

;	1509	            version_list = .version_list 		! Move to next version number.

;	1510	                                + dir$k_version;

;	1511	            END

;	1512	        UNTIL .version_list GEQA			! If the version list is all read, then go to next entry.

;	1513	                (.direc_bufptr + .direc_bufptr [dir$w_size] + 2);

;	1514	

;	1515	        END						! End of directory scan loop.

;	1516	

;	1517	    UNTIL NOT find_ods2_file (				! Loops until no more entries seen.

;	1518	                                entry_desc);

;	1519	

;	1520	!

;	1521	! Indicate to user if no files matching this file specification were purged.

;	1522	!

;	1523	

;	1524	    IF .num_files_purg EQL 0				! If no files were purged,

;	1525	    THEN

;	1526	        put_message (					!    then tell user.

;     P 1527	                        msg$_nofilpurg,			!    Specify an error code,

;     P 1528	                        1,				!    argument count of 1,

;     P 1529	                        .spec_desc);			!    and the descriptor of the file specification.

;	1530	

;	1531	    END;







							    .PSECT  $PLIT$,NOWRT,NOEXE,2



					      00000 P.AAA:  .ASCII  \.*\						      ;

					      00002	    .BLKB   2



							    .GLOBL  SYS$ERASE



							    .PSECT  $CODE$,NOWRT,2



					 0FFC 00319 PURGE_ODS2_DIR:

							    .WORD   Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11		      ; 1068

		         5E	       38  C2 0031B 	    SUBL2   #56, SP						      ;

		         50	  08   AC  D0 0031E 	    MOVL    FAB_BLOCK, R0					      ; 1147

		         58	  28   A0  D0 00322 	    MOVL    40(R0), R8						      ; 1139

		  0000G  CF	       10  8A 00326 	    BICB2   #16, DEL$CLI_STATUS					      ; 1179

				  24   AE  D4 0032B 	    CLRL    NUM_FILES_PURG					      ; 1180

		  FFFF   8F	0000'  DF  B1 0032E 	    CMPW    @DIREC_BUFPTR, #65535				      ; 1186

				       0A  12 00335 	    BNEQ    1$							      ;

		         01	0000'  CF  D1 00337 	    CMPL    END_BLOCK_NO, #1					      ; 1187

				       03  12 0033C 	    BNEQ    1$							      ;

				     0261  31 0033E 	    BRW     31$							      ;

		    28   AE	  C8   8F  9B 00341 1$:     MOVZBW  #200, ERROR_DESC					      ; 1202

		    2C   AE	0000'  CF  9E 00346 	    MOVAB   ERROR_BUFFER, ERROR_DESC+4				      ; 1203

		         53	  04   AC  D0 0034C 	    MOVL    SPEC_DESC, R3					      ; 1210

		         52	       63  3C 00350 	    MOVZWL  (R3), SPEC_LENGTH					      ;

		         54	  04   A3  D0 00353 	    MOVL    4(R3), SPEC_PTR					      ; 1211

				       55  D4 00357 	    CLRL    COUNT						      ; 1212

	   64	         52	       3E  3A 00359 2$:     LOCC    #62, SPEC_LENGTH, (SPEC_PTR)			      ; 1220



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-9

; Digital Equipment Corporation

;

				       02  12 0035D 	    BNEQ    3$							      ;

				       51  D4 0035F 	    CLRL    R1							      ;

		         59	       51  D0 00361 3$:     MOVL    R1, SPEC_NAME_PTR					      ;

				       0C  12 00364 	    BNEQ    5$							      ; 1225

	   64	         52	  5D   8F  3A 00366 	    LOCC    #93, SPEC_LENGTH, (SPEC_PTR)			      ; 1227

				       02  12 0036B 	    BNEQ    4$							      ;

				       51  D4 0036D 	    CLRL    R1							      ;

		         59	       51  D0 0036F 4$:     MOVL    R1, SPEC_NAME_PTR					      ;

				       59  D5 00372 5$:     TSTL    SPEC_NAME_PTR					      ; 1233

				       46  13 00374 	    BEQL    9$							      ;

	   50	         54	       59  C3 00376 	    SUBL3   SPEC_NAME_PTR, SPEC_PTR, R0				      ; 1244

		         52	  FF A042  9E 0037A 	    MOVAB   -1(R0)[SPEC_LENGTH], SPEC_LENGTH			      ;

				       59  D6 0037F 	    INCL    SPEC_NAME_PTR					      ; 1246

		         3A	       69  91 00381 	    CMPB    (SPEC_NAME_PTR), #58				      ;

				       0C  12 00384 	    BNEQ    6$							      ;

		         54	       59  D0 00386 	    MOVL    SPEC_NAME_PTR, SPEC_PTR				      ; 1254

				       55  D6 00389 	    INCL    COUNT						      ; 1255

		         01	       55  D1 0038B 	    CMPL    COUNT, #1						      ; 1256

				       C9  15 0038E 	    BLEQ    2$							      ;

				       6E  11 00390 	    BRB     13$							      ; 1260

		         57	       63  3C 00392 6$:     MOVZWL  (R3), DEV_DIR_LENGTH				      ; 1271

		         57	       52  C2 00395 	    SUBL2   SPEC_LENGTH, DEV_DIR_LENGTH				      ;

	   69	         52	       2E  3A 00398 	    LOCC    #46, SPEC_LENGTH, (SPEC_NAME_PTR)			      ; 1278

				       02  12 0039C 	    BNEQ    7$							      ;

				       51  D4 0039E 	    CLRL    R1							      ;

		    08   AE	       51  D0 003A0 7$:     MOVL    R1, SPEC_TYPE_PTR					      ;

				       5A  13 003A4 	    BEQL    13$							      ; 1283

      18   AE	    08   AE	       59  C3 003A6 	    SUBL3   SPEC_NAME_PTR, SPEC_TYPE_PTR, SPEC_NAME_LEN		      ; 1293

		         52	  18   AE  C2 003AC 	    SUBL2   SPEC_NAME_LEN, R2					      ; 1301

      08   BE	         52	       3B  3A 003B0 	    LOCC    #59, R2, @SPEC_TYPE_PTR				      ; 1300

				       02  12 003B5 	    BNEQ    8$							      ;

				       51  D4 003B7 	    CLRL    R1							      ;

		         54	       51  D0 003B9 8$:     MOVL    R1, SPEC_PTR					      ;

				       42  13 003BC 9$:     BEQL    13$							      ; 1305

      20   AE	         54	  08   AE  C3 003BE 	    SUBL3   SPEC_TYPE_PTR, SPEC_PTR, SPEC_TYPE_LEN		      ; 1315

		         50	0000'  CF  D0 003C4 	    MOVL    DIREC_BUFPTR, R0					      ; 1322

		  FFFF   8F	       60  B1 003C9 	    CMPW    (R0), #65535					      ;

				       12  13 003CE 	    BEQL    10$							      ;

		         07	  04   A0  93 003D0 	    BITB    4(R0), #7						      ; 1325

				       18  12 003D4 	    BNEQ    11$							      ;

		    30   AE	  05   A0  9B 003D6 	    MOVZBW  5(R0), ENTRY_DESC					      ; 1328

		    34   AE	  06   A0  9E 003DB 	    MOVAB   6(R0), ENTRY_DESC+4					      ; 1331

				       0C  11 003E0 	    BRB     11$							      ; 1322

				  30   AE  9F 003E2 10$:    PUSHAB  ENTRY_DESC						      ; 1335

		  0000V  CF	       01  FB 003E5 	    CALLS   #1, FIND_ODS2_FILE					      ;

		         01	       50  E8 003EA 	    BLBS    R0, 11$						      ;

					   04 003ED 	    RET     							      ;

		         5B	  34   AE  D0 003EE 11$:    MOVL    ENTRY_DESC+4, ENTRY_NAME_PTR			      ; 1350

	   6B	    30   AE	       2E  3A 003F2 	    LOCC    #46, ENTRY_DESC, (ENTRY_NAME_PTR)			      ; 1352

				       02  12 003F7 	    BNEQ    12$							      ;

				       51  D4 003F9 	    CLRL    R1							      ;

		         6E	       51  D0 003FB 12$:    MOVL    R1, ENTRY_TYPE_PTR					      ;

				       14  12 003FE 	    BNEQ    14$							      ; 1357

		         7E	1244   8F  3C 00400 13$:    MOVZWL  #4676, -(SP)					      ; 1361

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



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-10

; Digital Equipment Corporation

;

				       50  DD 0040A 	    PUSHL   R0							      ;

	      00000000G  00	       01  FB 0040C 	    CALLS   #1, LIB$STOP					      ;

					   04 00413 	    RET     							      ; 1362

      0C   AE	         6E	       5B  C3 00414 14$:    SUBL3   ENTRY_NAME_PTR, ENTRY_TYPE_PTR, ENTRY_NAME_LEN	      ; 1367

		         50	  30   AE  3C 00419 	    MOVZWL  ENTRY_DESC, R0					      ; 1369

      1C   AE	         50	  0C   AE  C3 0041D 	    SUBL3   ENTRY_NAME_LEN, R0, ENTRY_TYPE_LEN			      ;

		         01	  18   AE  D1 00423 	    CMPL    SPEC_NAME_LEN, #1					      ; 1375

				       05  12 00427 	    BNEQ    15$							      ;

		         2A	       69  91 00429 	    CMPB    (SPEC_NAME_PTR), #42				      ; 1376

				       0A  13 0042C 	    BEQL    16$							      ;

	   00	         69	  18   AE  2D 0042E 15$:    CMPC5   SPEC_NAME_LEN, (SPEC_NAME_PTR), #0, ENTRY_NAME_LEN, -     ; 1381

		         6B	  0C   AE     00433		    (ENTRY_NAME_PTR)					      ;

				       1A  12 00436 	    BNEQ    17$							      ;

		    04   AE	       01  D0 00438 16$:    MOVL    #1, MATCH_FLAG					      ; 1387

	   00	    08   BE	  20   AE  2D 0043C 	    CMPC5   SPEC_TYPE_LEN, @SPEC_TYPE_PTR, #0, #2, P.AAA	      ; 1391

		  0000'  CF	       02     00442									      ;

				       0F  13 00446 	    BEQL    18$							      ;

	   00	    08   BE	  20   AE  2D 00448 	    CMPC5   SPEC_TYPE_LEN, @SPEC_TYPE_PTR, #0, ENTRY_TYPE_LEN, -      ; 1399

		    00   BE	  1C   AE     0044E		    @ENTRY_TYPE_PTR					      ;

				       03  13 00452 17$:    BEQL    18$							      ;

				     0138  31 00454 	    BRW     29$							      ;

		    04   AE	       01  D0 00457 18$:    MOVL    #1, MATCH_FLAG					      ; 1405

		         50	0000'  CF  D0 0045B 	    MOVL    DIREC_BUFPTR, R0					      ; 1416

		         51	  05   A0  9A 00460 	    MOVZBL  5(R0), R1						      ; 1418

		         51	       50  C0 00464 	    ADDL2   R0, R1						      ;

		         50	  05   A0  9A 00467 	    MOVZBL  5(R0), R0						      ; 1419

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

				       7E     0046F									      ;

	   50	         8E	       02  7B 00470 	    EDIV    #2, (SP)+, R0, R0					      ;

				       50     00474									      ;

				       50  D5 00475 	    TSTL    R0							      ;

				       05  13 00477 	    BEQL    19$							      ;

		         50	       01  D0 00479 	    MOVL    #1, R0						      ;

				       02  11 0047C 	    BRB     20$							      ;

				       50  D4 0047E 19$:    CLRL    R0							      ;

		         56	  06 A041  9E 00480 20$:    MOVAB   6(R0)[R1], VERSION_LIST				      ;

				  10   AE  D4 00485 	    CLRL    VERSIONS_SAVED					      ; 1424

		  0000G  CF	  10   AE  D1 00488 21$:    CMPL    VERSIONS_SAVED, DEL$KEEPVER_VAL			      ; 1428

				       03  18 0048E 	    BGEQ    22$							      ;

				     00E1  31 00490 	    BRW     27$							      ;

		    24   A8	  02   A6  D0 00493 22$:    MOVL    2(VERSION_LIST), 36(R8)				      ; 1431

		    28   A8	  06   A6  B0 00498 	    MOVW    6(VERSION_LIST), 40(R8)				      ; 1435

				  08   AC  DD 0049D 	    PUSHL   FAB_BLOCK						      ; 1438

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

		    14   AE	       50  D0 004A7 	    MOVL    R0, STATUS						      ;

		         0D	  14   AE  E9 004AB 	    BLBC    STATUS, 23$						      ; 1445

				  24   AE  D6 004AF 	    INCL    NUM_FILES_PURG					      ; 1447

		         06	  14   AE  E9 004B2 	    BLBC    STATUS, 23$						      ; 1454

	   78	  0000G  CF	       01  E1 004B6 	    BBC     #1, DEL$CLI_STATUS, 24$				      ; 1455

		         50	  04   AC  D0 004BC 23$:    MOVL    SPEC_DESC, R0					      ; 1460

	   00	    04   B0	       57  2C 004C0 	    MOVC5   DEV_DIR_LENGTH, @4(R0), #0, DEV_DIR_LENGTH, ERROR_BUFFER  ; 1458

		  0000'  CF	       57     004C5									      ;

		         5A	0000'CF47  9E 004C9 	    MOVAB   ERROR_BUFFER[DEV_DIR_LENGTH], ERROR_BUFPTR		      ; 1467

	   00	    34   BE	  30   AE  2C 004CF 	    MOVC5   ENTRY_DESC, @ENTRY_DESC+4, #0, ENTRY_DESC, (ERROR_BUFPTR) ; 1469

		         6A	  30   AE     004D5									      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-11

; Digital Equipment Corporation

;

		         50	  30   AE  3C 004D8 	    MOVZWL  ENTRY_DESC, R0					      ; 1478

		         5A	       50  C0 004DC 	    ADDL2   R0, ERROR_BUFPTR					      ;

		         8A	       3B  90 004DF 	    MOVB    #59, (ERROR_BUFPTR)+				      ; 1481

		         50	  30   AE  3C 004E2 	    MOVZWL  ENTRY_DESC, R0					      ; 1484

		         50	       57  C0 004E6 	    ADDL2   DEV_DIR_LENGTH, R0					      ;

      28   AE	         50	       01  A1 004E9 	    ADDW3   #1, R0, ERROR_DESC					      ;

		         65	  14   AE  E8 004EE 	    BLBS    STATUS, 26$						      ; 1487

	   53	    08   AC	       08  C1 004F2 	    ADDL3   #8, FAB_BLOCK, R3					      ; 1496

	   52	    08   AC	       0C  C1 004F7 	    ADDL3   #12, FAB_BLOCK, R2					      ;

		         7E	1230   8F  3C 004FC 	    MOVZWL  #4656, -(SP)					      ;

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

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

				       7E     0050A									      ;

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

				       50     0050F									      ;

		         04	       50  D1 00510 	    CMPL    R0, #4						      ;

				       21  13 00513 	    BEQL    25$							      ;

				       62  DD 00515 	    PUSHL   (R2)						      ;

				       63  DD 00517 	    PUSHL   (R3)						      ;

		         7E	       66  32 00519 	    CVTWL   (VERSION_LIST), -(SP)				      ;

				  34   AE  9F 0051C 	    PUSHAB  ERROR_DESC						      ;

				       02  DD 0051F 	    PUSHL   #2							      ;

		         7E	1230   8F  3C 00521 	    MOVZWL  #4656, -(SP)					      ;

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

				       50  DD 0052B 	    PUSHL   R0							      ;

	      00000000G  00	       06  FB 0052D 	    CALLS   #6, LIB$SIGNAL					      ;

				       41  11 00534 24$:    BRB     28$							      ;

				       62  DD 00536 25$:    PUSHL   (R2)						      ;

				       63  DD 00538 	    PUSHL   (R3)						      ;

		         7E	       66  32 0053A 	    CVTWL   (VERSION_LIST), -(SP)				      ;

				  34   AE  9F 0053D 	    PUSHAB  ERROR_DESC						      ;

				       02  DD 00540 	    PUSHL   #2							      ;

		         7E	1230   8F  3C 00542 	    MOVZWL  #4656, -(SP)					      ;

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

				       50  DD 0054C 	    PUSHL   R0							      ;

	      00000000G  00	       06  FB 0054E 	    CALLS   #6, LIB$STOP					      ;

				       20  11 00555 	    BRB     28$							      ; 1487

		         7E	       66  32 00557 26$:    CVTWL   (VERSION_LIST), -(SP)				      ; 1503

				  2C   AE  9F 0055A 	    PUSHAB  ERROR_DESC						      ;

				       02  DD 0055D 	    PUSHL   #2							      ;

		         7E	1253   8F  3C 0055F 	    MOVZWL  #4691, -(SP)					      ;

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

				       50  DD 00569 	    PUSHL   R0							      ;

	      00000000G  00	       04  FB 0056B 	    CALLS   #4, LIB$SIGNAL					      ;

				       03  11 00572 	    BRB     28$							      ; 1454

				  10   AE  D6 00574 27$:    INCL    VERSIONS_SAVED					      ; 1508

		         56	       08  C0 00577 28$:    ADDL2   #8, VERSION_LIST					      ; 1510

		         50	0000'  DF  3C 0057A 	    MOVZWL  @DIREC_BUFPTR, R0					      ; 1513

		         50	0000'  CF  C0 0057F 	    ADDL2   DIREC_BUFPTR, R0					      ;

		         50	       02  C0 00584 	    ADDL2   #2, R0						      ;

		         50	       56  D1 00587 	    CMPL    VERSION_LIST, R0					      ; 1512

				       03  1E 0058A 	    BGEQU   29$							      ;

				     FEF9  31 0058C 	    BRW     21$							      ;

				  30   AE  9F 0058F 29$:    PUSHAB  ENTRY_DESC						      ; 1517

		  0000V  CF	       01  FB 00592 	    CALLS   #1, FIND_ODS2_FILE					      ;



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 7-12

; Digital Equipment Corporation

;

		         03	       50  E9 00597 	    BLBC    R0, 30$						      ;

				     FE51  31 0059A 	    BRW     11$							      ;

				  24   AE  D5 0059D 30$:    TSTL    NUM_FILES_PURG					      ; 1524

				       18  12 005A0 	    BNEQ    32$							      ;

				  04   AC  DD 005A2 31$:    PUSHL   SPEC_DESC						      ; 1529

				       01  DD 005A5 	    PUSHL   #1							      ;

		         7E	122B   8F  3C 005A7 	    MOVZWL  #4651, -(SP)					      ;

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

				       50  DD 005B1 	    PUSHL   R0							      ;

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

					   04 005BA 32$:    RET     							      ; 1068



; Routine Size:  674 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 8

; Digital Equipment Corporation

;

;	1532	ROUTINE find_ods2_file (output_desc) =			! finds next file entry in directory

;	1533	

;	1534	!++

;	1535	! Functional description

;	1536	!

;	1537	!	Finds the file name and type of the next file in a directory

;	1538	!	file and returns a string descriptor to the file name in the

;	1539	!	output parameter. Returns FALSE as the routine value if no

;	1540	!	more entries are seen.

;	1541	!

;	1542	!	Looks at the first word in the directory buffer as pointed to

;	1543	!	by the directory buffer pointer. If this word is -1, moves to

;	1544	!	the next block in the directory buffer. If this word is 0, 

;	1545	!	concludes that the directory buffer is completely read.

;	1546	!

;	1547	!	Then looks at the type of directory entry. If it is not FID

;	1548	!	(file identification type), skips to the next entry. Otherwise,

;	1549	!	places the length and address of the file name and type into

;	1550	!	the output descriptor, and returns a value of TRUE.

;	1551	!

;	1552	! Calling sequence

;	1553	!

;	1554	!	find_ods2_file (output_desc.wt.ds)

;	1555	!

;	1556	! Input parameters

;	1557	!

;	1558	!	none

;	1559	!

;	1560	! Implicit inputs

;	1561	!

;	1562	!	direc_bufptr	- pointer to the current "next" byte of the

;	1563	!			  directory buffer. This is guaranteed to 

;	1564	!			  point to the beginning of an entry, a -1

;	1565	!			  meaning end of block, or 0 meaning end of

;	1566	!			  buffer.

;	1567	!	dir_block_no	- The number of the current directory block.

;	1568	!	end_block_no	- The number of the last block in the directory.

;	1569	!

;	1570	! Output parameters

;	1571	!

;	1572	!	output_desc	- a static string descriptor of the "next"

;	1573	!			  file name found.

;	1574	!

;	1575	! Implicit outputs

;	1576	!

;	1577	!	direc_bufptr	- updated to point to a new "next" entry.

;	1578	!	dir_block_no	- Incremented if a new block is started.

;	1579	!

;	1580	! Routine value

;	1581	!

;	1582	!	TRUE	- if an entry is found.

;	1583	!	FALSE	- if no more entries exist.

;	1584	!

;	1585	! Side effects

;	1586	!



; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 8-1

; Digital Equipment Corporation

;

;	1587	!	none

;	1588	!

;	1589	!--

;	1590	

;	1591	    BEGIN

;	1592	

;	1593	    MAP

;	1594	        output_desc	: REF BLOCK [, BYTE];

;	1595	

;	1596	    DO							! Keep looking until a good entry

;	1597	        BEGIN

;	1598	

;	1599	!

;	1600	! Increment directory buffer pointer to point to the next entry in the buffer.

;	1601	!

;	1602	

;	1603	        direc_bufptr = .direc_bufptr			! New pointer is old pointer plus size

;	1604	                        + .direc_bufptr [dir$w_size]	!    of last entry

;	1605	                        + 2;				!    plus size of entry byte counter.

;	1606	

;	1607	!

;	1608	! Test for end of this block (entries don't cross block boundaries). If an end of block

;	1609	! marker is seen, move pointer to next block and test for end of data.

;	1610	!

;	1611	

;	1612	        IF .direc_bufptr [dir$w_size] EQLU end_of_block	! If no more entries in this block,

;	1613	        THEN						! then look for another block.

;	1614	            BEGIN

;	1615	            dir_block_no = .dir_block_no + 1;		! Increment number of current directory block

;	1616	            IF .dir_block_no GTR .end_block_no

;	1617	            THEN

;	1618	                 RETURN FALSE;				! If the entire directory is read,

;	1619								! return from this routine.

;	1620	            direc_bufptr = .direc_buftop + (512 * (.dir_block_no - 1));

;	1621								! Otherwise, update directory buffer pointer

;	1622								! to the beginning of the next block.

;	1623	            END;

;	1624	

;	1625	        END						! End of loop.

;	1626	

;	1627	    UNTIL .direc_bufptr [dir$v_type] EQL dir$c_fid;	! Run loop untila normal file entry is seen.

;	1628	

;	1629	!

;	1630	! Found an entry. Return a string descriptor to the file name.

;	1631	!

;	1632	

;	1633	    output_desc [dsc$w_length] =			! Set length of file name string

;	1634	        .direc_bufptr [dir$b_namecount];

;	1635	    output_desc [dsc$a_pointer] =			! and address of file name string.

;	1636	        direc_bufptr [dir$b_namecount] + 1;

;	1637	    RETURN TRUE;					! Return with success status code

;	1638	

;	1639	    END;







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 8-2

; Digital Equipment Corporation

;







					 0800 005BB FIND_ODS2_FILE:

							    .WORD   Save R11						      ; 1532

		         5B	0000'  CF  9E 005BD 	    MOVAB   DIREC_BUFPTR, R11					      ;

		         50	  00   BB  3C 005C2 1$:     MOVZWL  @DIREC_BUFPTR, R0					      ; 1604

		         50	       6B  C0 005C6 	    ADDL2   DIREC_BUFPTR, R0					      ;

	   6B	         50	       02  C1 005C9 	    ADDL3   #2, R0, DIREC_BUFPTR				      ; 1605

		  FFFF   8F	  00   BB  B1 005CD 	    CMPW    @DIREC_BUFPTR, #65535				      ; 1612

				       18  12 005D3 	    BNEQ    2$							      ;

				  0C   AB  D6 005D5 	    INCL    DIR_BLOCK_NO					      ; 1615

		    10   AB	  0C   AB  D1 005D8 	    CMPL    DIR_BLOCK_NO, END_BLOCK_NO				      ; 1616

				       28  14 005DD 	    BGTR    3$							      ;

	   50	    0C   AB	       09  78 005DF 	    ASHL    #9, DIR_BLOCK_NO, R0				      ; 1620

		         50	  08   AB  C0 005E4 	    ADDL2   DIREC_BUFTOP, R0					      ;

		         6B	FE00   C0  9E 005E8 	    MOVAB   -512(R0), DIREC_BUFPTR				      ;

		         51	       6B  D0 005ED 2$:     MOVL    DIREC_BUFPTR, R1					      ; 1627

		         07	  04   A1  93 005F0 	    BITB    4(R1), #7						      ;

				       CC  12 005F4 	    BNEQ    1$							      ;

		         50	  04   AC  D0 005F6 	    MOVL    OUTPUT_DESC, R0					      ; 1633

		         60	  05   A1  9B 005FA 	    MOVZBW  5(R1), (R0)						      ;

		    04   A0	  06   A1  9E 005FE 	    MOVAB   6(R1), 4(R0)					      ; 1636

		         50	       01  D0 00603 	    MOVL    #1, R0						      ; 1637

					   04 00606 	    RET     							      ;

				       50  D4 00607 3$:     CLRL    R0							      ; 1532

					   04 00609 	    RET     							      ;



; Routine Size:  79 bytes







; Bliss-32 7.352	Saturday 22-AUG-1978 03:54:31	DBB3:[DELETE.SRC]PURGEDIR.B32;76				Page 9

; Digital Equipment Corporation

;

;	1640	END

;	1641	ELUDOM









							    .GLOBL  LIB$SIGNAL, LIB$STOP



;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

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

;  $GLOBAL$       	    20    WRT,  RD ,NOEXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)

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

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









;				LIBRARY STATISTICS

;

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

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]LIB.L32;1		      5582        57         1       252

;  DBB3:[DELETE.SRC]VMSMAC.L32;1	         6         5        83         4

;  DBB3:[DELETE.SRC]DR1DEF.L32;2	        14         9        64         4











; Size:		1546 code + 224 data bytes

; Run Time:	00:55.8

; Elapsed Time:	01:55.4

; Memory Used:	427 pages

; Compilation Complete

