;   SD VAX-11 CORAL COMPILER :B/BC/BC-6A.00-049
	.TITLE	MAIN
;1 'CORAL''PROGRAM'  RESTORE FILES 11B
;2  
;3 'DEFINE' VERSION NUMBER " IDENT (\VMS 12\) ";
;4 'COMMENT':
;5  
;6       Sub-System    :   File Recovery Program
;7  
;8       Computer Type :   DEC VAX VMS Version 4.4 FILES-11 Structure level 2
;9  
;10       Author        :   W. B. Langdon  CEGB ( CERL )
;11  
;12       Creation Date :   6 Decmeber 1982
;13  
;14 ;
;15 'COMMENT':
;16  
;17       FUNCTIONAL DESCRIPTION.
;18       ---------- -----------
;19  
;20         This program tries to recover deleted files on FILES-11 structure
;21         level 2 volumes. It has not been tried on multi-volumn sets.
;22           It searches the index file INDEXF for an entry
;23         corrosponding to the deleted file. If the entry is found then it
;24         may be restored if the users so wishes.
;25 ;
;26  
;27  
;28 'COMMENT':
;29  
;30       GLOBAL OBJECTS USED WITHIN PROGRAM.
;31       ------ ------- ---- ------ -------
;32  
;33       SYSTEM SERVICES:
;34 
;35           SYS$ASCTIM
;36 
;37 
;38       STREAM I/O PROCEDURES:  ( Brian Christie's I/O package )
;39 
;40           CLOSE ALL STREAMS, CONTINUE ON ERROR, EXIT ON ERROR, FIND IN, 
;41           FIND OUT, IN BLOCK, IN CHAR, IN STREAM, LAST  ERROR, OPEN STREAM, 
;42           OUT BLOCK, OUT CHAR, OUT INT, OUT TEXT, OUT STREAM
;43 ;
;44 
;45 (-Page *** Modifications *** )
;46 
;47 
;48 'COMMENT':
;49  
;50 	MODIFICATIONS:
;51  
;52 Author	: WBL
;53 Date	: 11 February 1983	
;54 Version	: 8A
;55 Changes	: remove wear-out of program based on files age.
;56           Add status checks and diagnostic outputs on OPENSTREAM ( indexf ),
;57           IN STREAM ( indexf ) in main program and OUTBLOCK in UP DATE BLOCK
;58             NB no difficulty was found in going from VAX/VMS version 2.5 to 3.0
;59  
;60 Author	: WBL
;61 Date	: 2 March 1983	
;62 Version	: 8.1
;63 Changes	: Add SET FILE PAR call on INDEXF that was removed by accident
;64  
;65 Author	: WBL
;66 Date	: 3 March 1983	
;67 Version	: 10A
;68 Changes	: In rearrange procedure ASK to limit number of times question 
;69           is asked avoids indefinite loop on EOF and limit answer to one char
;70 
;71 Author	: WBL
;72 Date	: ?	
;73 Version	: 10B
;74 Changes	: ?
;75 
;76 Author	: WBL
;77 Date	: 24 january 1985
;78 Version	: VMS 10B
;79 Changes	: Use SDL CORAL-66 compiler and CSID IO package to run in native mode.
;80           Replace ? by \ in code inserts
;81           Replace "SF:[200,200]STREAMLIB.CRL" by VAXIOP
;82           Replace BUFFER [0:255] by [0:127]
;83           Add VMS string descriptor FILE COUNT, FILE ADDRESS and use FILE COUNT
;84             inplace of FILE [0] and FILE ADDRESS in place of FILE0
;85           Add RBUFFER and WBUFFER and use them in place of most of BUFFER
;86           Add lable parameters to inner procedures SAME CHARS and ADD to allow
;87             jumps to lables out side them.
;88           Remove VBN HI and VBN LO and change calls of FINDIN etc.
;89           Remove check for MAXFILES exceeding 32k-1
;90 
;91 Author	: WBL
;92 Date	: 20 May 1986
;93 Version	: VMS 10B ZZ
;94 Changes	: Add using SHARE I/O procedure
;95           Add back in setting MAX ENTRY (and now include high order word
;96             which up to now has been forced to be zero, otherwise got zero)
;97             cf. MAXFILES in version VMS 10B
;98           Replace setting file position before start of search loop by setting
;99             inside. This is needed because with B. Christie's I/O package
;100             IN BLOCK and OUT BLOCK do not update the file position.
;101 
;102 Author	: WBL
;103 Date	: 21 May 1986
;104 Version	: VMS 11
;105 Changes	: Add support for %% wildcard, allow $ and _ as legal file name,
;106             characters, expand FILE from 0:31 to 0:132.
;107           Move "Search finished" to END LOOP:
;108           Move " Continue search? out of ASK = YES condition to after it and
;109             if NO jump to new lable END PROC rather than END LOOP
;110           Add support for long file names by using new procedure BUFF CHAR 
;111             in place of reading from BUFF directly. Split F NAME MAX into
;112             F NAME MAX1 and F NAME MAX2 and similary treat F NAME START
;113           Add write through CACHE
;114 ;
;115 'COMMENT'
;116 Author	: WBL
;117 Date	: 18 December 1986
;118 Version	: VMS 12
;119 Changes	: Allow - in a legal file name,
;120           Create procedure DISPLAY FILE HEADER from code in main program,
;121             make it additionally display FH2$W_SEG_NUM, file extension fid, 
;122             back link fid and file creation and revision date and times
;123           Add F NAME LIMIT to cope with file extension headers
;124 ;
;125 
;126 'COMMENT'::;
;127 
;128 
;129 'COMMENT' stream input/output library communicator;
;130 
;131   'LIBRARY' ( VAXIOP );
;132 
;133 'COMMENT' System service communicator. Nb 3rd param is byte address;
;134 
;135 'EXTERNAL' (
;136 'DEFINE' VI  "'VALUE' 'INTEGER'";    (Immediate value)
;137 'DEFINE' LI  "'LOCATION' 'INTEGER'"; (Address of variable)
;138 'DEFINE' SD  "'VALUE' 'INTEGER'";    (Address of string descriptor)
;139 
;140 'INTEGER''PROCEDURE' SYS ASCTIM     /SYS$ASCTIM      (LI,SD,VI,VI);
;141                                      (Convert binary time to ASCII string)
;142 'DELETE' SD;
;143 'DELETE' LI;
;144 'DELETE' VI;
;145 );
;146 
;147 'DEFINE' IDENT (ID) "'PROCEDURE' COIDENT;'CODE''BEGIN'\ .IDENT /\ID\/ \'END'";
;148 
;149 'DEFINE' YES "0";
;150 'DEFINE' NO  "1";
;151 
;152 'DEFINE' SPACE "32"; ( ascii )
;153 
;154 
;155 'SEGMENT' MAIN
;  SEGMENT - MAIN
	.PSECT	D.MAIN,WRT,NOEXE,LONG
C$REM::	.BLKL	1
C$SP::	.BLKL	1
	.PSECT	D.MAIN,WRT,NOEXE
DA:
	.BLKL	99
VA:
	.BLKL	12970
.=DA+68
	.LONG	0
.=VA+51848
	.LONG	65
.=DA+336
	.LONG	0
.=VA+51872
	.LONG	134480385, -2143281136
	.PSECT	P.MAIN,NOWRT,EXE,LONG
	.ENTRY	MAIN, ^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	PUSHL	FP
	MOVL	SP, C$SP
;156 'BEGIN'
	MOVAL	DA, R10
	JMP	LA1
; ********************* PA2 *********************
	.ALIGN	2
PA2:
 .IDENT /VMS 12/ 

;200   'INTEGER' INDEX, TT IN, TT OUT;
;201 
;202   'INTEGER' BITMAP SIZE, ENTRY NO, FIRST ENTRY;
;203   'INTEGER' F NAME LIMIT, F NAME START1, F NAME START2;
;204   'INTEGER' START BIT MAP;
;205 
;206 
;207   'INTEGER''ARRAY' BUFFER [0:127];
;208     'OVERLAY' BUFFER [0] 'WITH' 'BYTE''ARRAY' BUFF [0:511];
;209 
;210   'BYTE''ARRAY' FILE [0:132];
;211     'OVERLAY' FILE [0] 'WITH' 'INTEGER' FILE0;
;212   'COMMENT' String descriptor block for FILE. Nb. the most significant word
;213     of FILE COUNT should be HEX (010E) but nobody checks this so leave as zero;
;214   'INTEGER' FILE COUNT, FILE ADDRESS;
;215 
;216 (-PAGE *** RBUFFER, WBUFFER *** )
;217  
;218 'COMMENT' ***********************************************************
;219  
;220  
;221   PROCESS:   Access BUFFER as though it were a word array.
;222  
;223   HISTORY:   added 25-Jan-85 VMS 10B
;224  
;225 **********************************************************************
;226 ;
;227 
;228 'INTEGER''PROCEDURE' RBUFFER ( 'VALUE''INTEGER' WORD OFFSET );
;229   'BEGIN'
;230 
; ********************* PA3 *********************
	.ALIGN	2
PA3:
	MOVAL	DA, R10
	MOVQ	(SP)+, 48(R10)
;231     'ANSWER' 'IF' 'BITS' [1,0] WORD OFFSET = 0 'THEN'
	BITL	52(R10), S^#1
	BEQL	BA2
	BRW	LA5
BA2:
;232                'BITS' [16,0] BUFFER [ WORD OFFSET/2 ]
;233              'ELSE'
	ASHL	#-1, 52(R10), R11
	ASHL	S^#1, R11, R9
	MOVZWL	396(R10)[R9], R0
	BRW	LA4
LA5:
	ASHL	#-1, 52(R10), R11
	ASHL	S^#1, R11, R9
	MOVZWL	398(R10)[R9], R0
LA4:
	JMP	@48(R10)
;234                'BITS' [16,16] BUFFER [ WORD OFFSET/2 ];
;235 
;236   'END'PROCEDURE  RBUFFER;
;237 
;238 

;239 'PROCEDURE' WBUFFER ( 'VALUE''INTEGER' WORD OFFSET, DATA );
;240   'BEGIN'
;241 
; ********************* PA7 *********************
	.ALIGN	2
PA7:
	MOVAL	DA, R10
	MOVQ	(SP)+, 56(R10)
	MOVL	(SP)+, 64(R10)
;242     'IF' 'BITS' [1,0] WORD OFFSET = 0 'THEN'
	BITL	60(R10), S^#1
	BEQL	BA3
	BRW	LA8
BA3:
;243       'BITS' [16,0] BUFFER [ WORD OFFSET/2 ] := DATA
;244     'ELSE'
	ASHL	#-1, 60(R10), R11
	ASHL	S^#1, R11, R9
	CVTLW	64(R10), 396(R10)[R9]
	BRW	LA9
LA8:
;245       'BITS' [16,16] BUFFER [ WORD OFFSET/2 ] := DATA;
;246 
;247   'END'PROCEDURE  WBUFFER;
;248 
;249 (-PAGE *** READ BLOCK and WRITE BLOCK *** )
;250  
;251 'COMMENT' ***********************************************************
;252  
;253  
;254   INPUTS :   BUFFER
;255  
;256   PROCESS:   
;257  
;258   OUTPUTS:   BUFFER
;259   
;260   GLOBALS:   
;261  
;262   MACROS :   
;263  
;264   HISTORY:
;265 WBL VMS11  21-May-86 Procedure written
;266 
;267 **********************************************************************
;268 ;
;269 
;270 'DEFINE' CACHE LIMIT "99";
;271 
	ASHL	#-1, 60(R10), R11
	ASHL	S^#1, R11, R9
	CVTLW	64(R10), 398(R10)[R9]
LA9:
	JMP	@56(R10)

;272 'INTEGER' CACHE NUM BLOCKS := 0;
;273 'INTEGER' CACHE FIRST BLOCK;
;274 
;275 'INTEGER''ARRAY' CACHE [ 0: CACHE LIMIT, 0:127 ];
;276 
;277 
;278 'INTEGER''PROCEDURE' RESIDENT ( 'VALUE''INTEGER' BLOCK NO );
;279   'BEGIN'
;280     'INTEGER' OFFSET;
;281 
; ********************* PA10 *********************
	.ALIGN	2
PA10:
	MOVAL	DA, R10
	MOVQ	(SP)+, 76(R10)
;282     OFFSET := BLOCK NO - CACHE FIRST BLOCK;
;283 
;284     'ANSWER' 'IF'   OFFSET >= 0                                    'AND' 
	SUBL3	72(R10), 80(R10), 84(R10)
	BGEQ	BA4
	BRW	LA12
BA4:
;285                   BLOCK NO <  CACHE FIRST BLOCK + CACHE NUM BLOCKS   'THEN'
;286                OFFSET
	ADDL3	72(R10), 68(R10), R0
	CMPL	80(R10), R0
	BLSS	BA5
	BRW	LA12
BA5:
;287              'ELSE'
	MOVL	84(R10), R0
	BRW	LA11
LA12:
	MOVL	#-1, R0
LA11:
	JMP	@76(R10)
;288                -1;
;289 
;290   'END'PROCEDURE  RESIDENT;
;291 
;292 

;293 'INTEGER''PROCEDURE' READ BLOCK ( 'VALUE''INTEGER' BLOCK NO );
;294   'BEGIN'
;295     'INTEGER''PROCEDURE' MOVE FROM CACHE;
;296       'BEGIN'
;297         'INTEGER' N, OFFSET;
;298 
; ********************* PA15 *********************
	.ALIGN	2
PA15:
	MOVAL	DA, R10
	MOVL	(SP)+, 96(R10)
	PUSHL	92(R10)
	JSB	PA10
;299         OFFSET := RESIDENT ( BLOCK NO );
;300 
;301         'IF' OFFSET < 0 'THEN'
	MOVL	R0, 104(R10)
	BLSS	BA6
	BRW	LA17
BA6:
	MOVL	#-1, R0
	JMP	@96(R10)
;302           'ANSWER' -1;
;303 
LA17:
LA19:
;304         'FOR' N := 0 'STEP' 1 'UNTIL' 127 'DO'
	CLRL	100(R10)
LA20:
	CMPL	100(R10), #127
	BLEQ	BA7
	BRW	LA21
BA7:
	ASHL	S^#7, 104(R10), R11
	ADDL2	100(R10), R11
	MOVL	100(R10), R9
	MOVL	1044(R10)[R11], 396(R10)[R9]
	INCL	100(R10)
	BRW	LA20
;305           BUFFER [ N ] := CACHE [ OFFSET, N ];
;306 
LA21:
	MOVL	#512, R0
	JMP	@96(R10)
;307         'ANSWER' 512;
;308 
;309       'END'PROCEDURE  MOVE FROM CACHE;
;310 
;311 (-PAGE *** READ BLOCK *** Page 2 *** )
;312 
;313 

;314     'INTEGER''PROCEDURE' READ ( 'LOCATION''INTEGER' START BUFFER;
;315                                 'VALUE''INTEGER'    NBLKS         );
;316       'BEGIN'
;317         'INTEGER' LENGTH, SAVE;
;318 
; ********************* PA22 *********************
	.ALIGN	2
PA22:
	MOVAL	DA, R10
	MOVQ	(SP)+, 108(R10)
	MOVL	(SP)+, 116(R10)
	CALLS	S^#0, G^$ASKIN
;319         SAVE := ASK IN STREAM;
;320 
	MOVL	R0, 124(R10)
	PUSHL	0(R10)
	CALLS	S^#1, G^$INSTR
;321         IN STREAM ( INDEX );
;322 
	PUSHL	92(R10)
	CALLS	S^#1, G^$FNDIN
;323         FIND IN ( BLOCK NO );
	SUBL2	S^#8, SP
	ASHL	#-2, 112(R10), 0(SP)
	ASHL	S^#9, 116(R10), 4(SP)
	CALLS	S^#2, G^$INBL
;324         LENGTH := INBLOCK ( 'LOCATION' ( START BUFFER ), NBLKS*512 );
;325 
	MOVL	R0, 120(R10)
	PUSHL	124(R10)
	CALLS	S^#1, G^$INSTR
;326         IN STREAM ( SAVE );
;327 
	MOVL	120(R10), R0
	JMP	@108(R10)
;328         'ANSWER' LENGTH;
;329 
;330       'END'PROCEDURE  READ;
;331 
;332 

;333     'INTEGER''PROCEDURE' READ INTO CACHE;
;334       'BEGIN'
;335         'INTEGER' LENGTH;
;336 
; ********************* PA29 *********************
	.ALIGN	2
PA29:
	MOVAL	DA, R10
	MOVL	(SP)+, 128(R10)
	SUBL2	S^#8, SP
	MOVAL	1044(R10), 0(SP)
	MOVL	#100, 4(SP)
	JSB	PA22
;337         LENGTH := READ ( CACHE [ 0, 0 ], CACHE LIMIT + 1 );
;338 
;339         'IF' LENGTH <= 0 'THEN'
	MOVL	R0, 132(R10)
	BLEQ	BA8
	BRW	LA31
BA8:
	JMP	@128(R10)
;340           'ANSWER' LENGTH;
;341 
LA31:
;342         CACHE NUM BLOCKS  := LENGTH / 512;
;343         CACHE FIRST BLOCK := BLOCK NO;
;344 
	ASHL	#-9, 132(R10), 68(R10)
	MOVL	92(R10), 72(R10)
	JSB	PA15
	JMP	@128(R10)
;345         'ANSWER' MOVE FROM CACHE;
;346 
;347       'END'PROCEDURE  READ INTO CACHE;
;348 
;349 

; ********************* PA14 *********************
	.ALIGN	2
PA14:
	MOVAL	DA, R10
	MOVQ	(SP)+, 88(R10)
;350     'ANSWER' 'IF' CACHE NUM BLOCKS = 0 'THEN'
;351                READ INTO CACHE
;352 
	TSTL	68(R10)
	BEQL	BA9
	BRW	LA35
BA9:
	JSB	PA29
	BRW	LA34
LA35:
	PUSHL	92(R10)
	JSB	PA10
;353              'ELSE''IF' RESIDENT ( BLOCK NO ) >= 0 'THEN'
;354                MOVE FROM CACHE
;355 
	TSTL	R0
	BGEQ	BA10
	BRW	LA38
BA10:
	JSB	PA15
	BRW	LA34
LA38:
;356              'ELSE''IF' BLOCK NO <= CACHE LIMIT 'THEN'
	CMPL	92(R10), #99
	BLEQ	BA11
	BRW	LA40
BA11:
	SUBL2	S^#8, SP
	MOVAL	396(R10), 0(SP)
;357                READ ( BUFFER [ 0 ], 1 )
;358 
	MOVL	S^#1, 4(SP)
	JSB	PA22
;359              'ELSE'
	BRW	LA34
LA40:
	JSB	PA29
LA34:
	JMP	@88(R10)
;360                READ INTO CACHE;
;361 
;362   'END'PROCEDURE  READ BLOCK;
;363 
;364 (-PAGE *** WRITE BLOCK *** )
;365 
;366 

;367 'INTEGER''PROCEDURE' WRITE BLOCK ( 'VALUE''INTEGER' BLOCK NO );
;368   'BEGIN'
;369     'INTEGER' DUMMY, OFFSET, SAVE;
;370 
; ********************* PA44 *********************
	.ALIGN	2
PA44:
	MOVAL	DA, R10
	MOVQ	(SP)+, 136(R10)
	PUSHL	140(R10)
	JSB	PA10
;371     OFFSET := RESIDENT ( BLOCK NO );
;372     'IF' OFFSET >= 0 'THEN'
	MOVL	R0, 148(R10)
	BGEQ	BA12
	BRW	LA46
BA12:
;373       'BEGIN'
;374         'INTEGER' N;
;375 
LA47:
;376         'FOR' N := 0 'STEP' 1 'UNTIL' 127 'DO'
	CLRL	156(R10)
LA48:
	CMPL	156(R10), #127
	BLEQ	BA13
	BRW	LA46
BA13:
	ASHL	S^#7, 148(R10), R11
	ADDL2	156(R10), R11
	MOVL	156(R10), R9
	MOVL	396(R10)[R9], 1044(R10)[R11]
	INCL	156(R10)
	BRW	LA48
;377           CACHE [ OFFSET, N ] := BUFFER [ N ];
;378 
;379       'END' RESIDENT; (so update CACHE to be on safe side)
;380 
LA46:
	CALLS	S^#0, G^$ASKOU
;381     SAVE := ASK OUT STREAM;
;382 
	MOVL	R0, 152(R10)
	PUSHL	0(R10)
	CALLS	S^#1, G^$OUSTR
;383     OUT STREAM ( INDEX );
;384 
	PUSHL	140(R10)
	CALLS	S^#1, G^$FNDOU
;385     FIND OUT ( BLOCK NO );
;386 
	PUSHL	S^#8
	CALLS	S^#1, G^$CNTE
;387     CONTINUE ON ERROR ( 8 );
	SUBL2	S^#8, SP
	MOVAL	396(R10), R11
	ASHL	#-2, R11, 0(SP)
	MOVL	#512, 4(SP)
	CALLS	S^#2, G^$OUTBL
;388     OUT BLOCK ( 'LOCATION' ( BUFFER [ 0 ] ), 512 );
	PUSHL	S^#8
	CALLS	S^#1, G^$EXTE
;389     EXIT ON ERROR ( 8 );
;390 
	PUSHL	152(R10)
	CALLS	S^#1, G^$OUSTR
;391     OUT STREAM ( SAVE );
;392 
	MOVAL	144(R10), -(SP)
	CALLS	S^#1, G^$LSTE
;393     'ANSWER' 'IF' LAST ERROR ( DUMMY ) <> 0 'THEN'
	TSTL	R0
	BNEQ	BA14
	BRW	LA59
BA14:
;394                -1
;395              'ELSE'
	MOVL	#-1, R0
	BRW	LA57
LA59:
	MOVL	#512, R0
LA57:
	JMP	@136(R10)
;396                512;
;397 
;398   'END'PROCEDURE  WRITE BLOCK;
;399 
;400 
;401 'DELETE' CACHE LIMIT;
;402 
;403 (-PAGE *** ASK *** )
;404  
;405 'COMMENT' ***********************************************************
;406  
;407  
;408   INPUTS :   STRING  question to be asked of user
;409  
;410   PROCESS:   Asks question of operator. 
;411  
;412   OUTPUTS:   returns answer. If no answer given replies NO.
;413  
;414   MACROS :   NO, YES
;415  
;416 **********************************************************************
;417 ;
;418 

;419 'INTEGER''PROCEDURE' ASK ( 'VALUE''INTEGER' QUESTION );
;420   'BEGIN'
;421     'INTEGER' CHAR, TRIES;
;422 
; ********************* PA61 *********************
	.ALIGN	2
PA61:
	MOVAL	DA, R10
	MOVQ	(SP)+, 160(R10)
;423     TRIES := 0;
;424 
;425 ASK QUESTION:
	CLRL	172(R10)
LA62:
;426     TRIES := TRIES + 1;
	INCL	172(R10)
	PUSHL	164(R10)
	CALLS	S^#1, G^$OUTXT
;427     OUTTEXT ( QUESTION );
	PUSHL	S^#27
	CALLS	S^#1, G^$OUTCH
;428     OUTCHAR ( ESC );
;429 
	CALLS	S^#0, G^$INCH
;430     CHAR := INCHAR;
;431 
;432     'IF' CHAR <> EOL 'THEN'
	MOVL	R0, 168(R10)
	CMPL	R0, S^#10
	BNEQ	BA15
	BRW	LA66
BA15:
;433       'BEGIN'
;434         'INTEGER' DUMMY;
LA67:
	CALLS	S^#0, G^$INCH
	MOVL	R0, 176(R10)
	CMPL	R0, S^#32
	BGEQ	BA16
	BRW	LA66
BA16:
	BRW	LA67
;435         'FOR' DUMMY := INCHAR 'WHILE' DUMMY >= SPACE 'DO';
;436       'END' FLUSH INPUT LINE;
;437 
LA66:
;438     'IF'       CHAR 'MASK' 'OCTAL' ( 137 ) = 'LITERAL' (Y) 'THEN'
	BICL3	#-96, 168(R10), R0
	CMPL	R0, #89
	BEQL	BA17
	BRW	LA70
BA17:
;439       'ANSWER' YES
;440 
	CLRL	R0
	JMP	@160(R10)
LA70:
;441     'ELSE''IF' CHAR 'MASK' 'OCTAL' ( 137 ) = 'LITERAL' (N) 'OR'
	BICL3	#-96, 168(R10), R0
	CMPL	R0, #78
	BNEQ	BA18
	BRW	LA72
BA18:
;442                                       CHAR = EOL           'THEN'
	CMPL	168(R10), S^#10
	BEQL	BA19
	BRW	LA73
BA19:
LA72:
;443       'ANSWER' NO
;444 
	MOVL	S^#1, R0
	JMP	@160(R10)
LA73:
;445     'ELSE''IF' CHAR = EOF 'THEN'
;446       'GOTO' ERROR  'COMMENT' exit program on <control-Z>;
;447 
	CMPL	168(R10), S^#26
	BNEQ	BA20
	BRW	LA76
BA20:
;448     'ELSE''IF' TRIES <= 3 'THEN'
	CMPL	172(R10), S^#3
	BLEQ	BA21
	BRW	LA76
BA21:
;449       'BEGIN'
	.PSECT	R.MAIN,NOWRT,NOEXE,LONG
SA78:
	.ASCID	/ I don't understand. Answer Y or N /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA78, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;450          OUTTEXT ( " I don't understand. Answer Y or N " );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;451          OUTCHAR ( EOL );
	BRW	LA62
;452          'GOTO' ASK QUESTION;
;453 
;454       'END' TRY AGAIN
;455     'ELSE'
;456       'GOTO' ERROR; ( exit program )
;457       
;458   'END'PROCEDURE  ASK;
;459 
;460 (-PAGE ***  ERROR1, ERROR2, STREAM ERROR *** )
;461  
;462 'COMMENT' ***********************************************************
;463  
;464  
;465   INPUTS :   STRING1, STRING2   text to be displayed to operator
;466              TT OUT             stream to operator's console
;467 
;468   PROCESS:   Display text to operator then exit to ERROR:
;469 
;470   CALLED :   main program, UPDATE BIT MAP, UPDATE BLOCK
;471 
;472 **********************************************************************
;473 ;
;474  
LA76:
	MOVL	C$SP, SP
	MOVL	(SP), FP
	BRW	LA367

;475 'PROCEDURE' ERROR1 ( 'VALUE''INTEGER' STRING1 );
;476   'BEGIN'
; ********************* PA81 *********************
	.ALIGN	2
PA81:
	MOVAL	DA, R10
	MOVQ	(SP)+, 180(R10)
	PUSHL	8(R10)
	CALLS	S^#1, G^$OUSTR
;477     OUTSTREAM ( TT OUT );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA84:
	.ASCID	/ERROR - /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA84, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;478     OUTTEXT ( "ERROR - " );
	PUSHL	184(R10)
	CALLS	S^#1, G^$OUTXT
;479     OUTTEXT ( STRING1 );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;480     OUTCHAR ( EOL );
	BRW	LA87
;481     'GOTO' ERROR;
;482  
;483   'END'PROCEDURE  ERROR1;
;484  
;485  
LA87:
	MOVL	C$SP, SP
	MOVL	(SP), FP
	BRW	LA367

;486 'PROCEDURE' ERROR2 ( 'VALUE''INTEGER' STRING1, STRING2 );
;487   'BEGIN'
; ********************* PA89 *********************
	.ALIGN	2
PA89:
	MOVAL	DA, R10
	MOVQ	(SP)+, 188(R10)
	MOVL	(SP)+, 196(R10)
	PUSHL	8(R10)
	CALLS	S^#1, G^$OUSTR
;488     OUTSTREAM ( TT OUT );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA92:
	.ASCID	/ERROR - /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA92, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;489     OUTTEXT ( "ERROR - " );
	PUSHL	192(R10)
	CALLS	S^#1, G^$OUTXT
;490     OUTTEXT ( STRING1 );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;491     OUTCHAR ( EOL );
	PUSHL	196(R10)
	CALLS	S^#1, G^$OUTXT
;492     OUTTEXT ( STRING2 );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;493     OUTCHAR ( EOL );
	BRW	LA97
;494     'GOTO' ERROR;
;495  
;496   'END'PROCEDURE  ERROR2;
;497 
LA97:
	MOVL	C$SP, SP
	MOVL	(SP), FP
	BRW	LA367

;498 'PROCEDURE' STREAM ERROR ( 'VALUE''INTEGER' STRING, AUX ERROR CODE );
;499   'BEGIN'
; ********************* PA99 *********************
	.ALIGN	2
PA99:
	MOVAL	DA, R10
	MOVQ	(SP)+, 200(R10)
	MOVL	(SP)+, 208(R10)
	PUSHL	8(R10)
	CALLS	S^#1, G^$OUSTR
;500     OUTSTREAM ( TT OUT );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;501     OUTCHAR ( EOL );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;502     OUTCHAR ( EOL );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA104:
	.ASCID	/ I/<47>/O error/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA104, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;503     OUTTEXT ( " I/O error" );
	PUSHL	204(R10)
	CALLS	S^#1, G^$OUTXT
;504     OUTTEXT ( STRING );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;505     OUTCHAR ( EOL );
;506     'IF' AUX ERROR CODE = 'OCTAL' ( 360 ) 'THEN'
	CMPL	208(R10), #240
	BEQL	BA22
	BRW	LA107
BA22:
;507       'BEGIN'
	.PSECT	R.MAIN,NOWRT,NOEXE
SA109:
	.ASCID	/           Privilege violation /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA109, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;508         OUTTEXT ( "           Privilege violation " );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;509         OUTCHAR ( EOL );
;510       'END';
	BRW	LA107
;511     'GOTO' ERROR;
;512  
;513   'END'PROCEDURE  STREAM ERROR;
;514 
;515 (-PAGE *** BUFF CHAR *** )
;516  
;517 'COMMENT' ***********************************************************
;518  
;519   INPUTS :   CHAR NO       num of character required. In range 1:F NAME LIMIT
;520              BUFF          byte array holding current entry in INDEXF
;521              F NAME START1 offset into BUFF showing start of file name
;522              F NAME START2 offset into BUFF showing start of 2nd file segment
;523 
;524   PROCESS:
;525  
;526   OUTPUTS:   returns character
;527 
;528   MACROS :   F NAME MAX1
;529  
;530   CHANGES:
;531 WBL VMS11  21-May-86 Procedure added.
;532 
;533 **********************************************************************
;534 ;
;535 
LA107:
	MOVL	C$SP, SP
	MOVL	(SP), FP
	BRW	LA367

;536 'INTEGER''PROCEDURE' BUFF CHAR ( 'VALUE''INTEGER' CHAR NO );
;537   'BEGIN'
;538 
; ********************* PA113 *********************
	.ALIGN	2
PA113:
	MOVAL	DA, R10
	MOVQ	(SP)+, 212(R10)
;539     'ANSWER' 'IF'       CHAR NO <= F NAME MAX1 'THEN'
	CMPL	216(R10), S^#20
	BLEQ	BA23
	BRW	LA115
BA23:
;540                BUFF [ F NAME START1 + CHAR NO - 1 ]
;541              'ELSE'
	ADDL3	28(R10), 216(R10), R11
	DECL	R11
	MOVZBL	396(R10)[R11], R0
	BRW	LA114
LA115:
	ADDL3	32(R10), 216(R10), R11
	SUBL2	S^#21, R11
	MOVZBL	396(R10)[R11], R0
LA114:
	JMP	@212(R10)
;542                BUFF [ F NAME START2 + CHAR NO - 1 - F NAME MAX1 ];
;543 
;544   'END';
;545 
;546 (-PAGE *** DISPLAY FILE HEADER *** )
;547  
;548 'COMMENT' ***********************************************************
;549  
;550   INPUTS :   
;551 
;552   PROCESS:   
;553  
;554   OUTPUTS:   
;555 
;556   MACROS :   
;557 
;558   CALLS  :   RBUFFER
;559  
;560   CHANGES:
;561 WBL VMS12  15-Dec-86 New procedure
;562 
;563 **********************************************************************
;564 ;
;565 

;566 'PROCEDURE' DISPLAY FILE HEADER;
;567   'BEGIN'
;568     'PROCEDURE' OUT FILE ID ( 'VALUE''INTEGER' INDEX, SEQUENCE NO, VOLUMN NO );
;569       'BEGIN'
; ********************* PA118 *********************
	.ALIGN	2
PA118:
	MOVAL	DA, R10
	MOVQ	(SP)+, 224(R10)
	MOVQ	(SP)+, 232(R10)
	.PSECT	R.MAIN,NOWRT,NOEXE
SA120:
	.ASCID	/ (/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA120, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;570         OUTTEXT ( " (" );
	SUBL2	S^#12, SP
	MOVL	228(R10), 0(SP)
	MOVL	S^#6, 4(SP)
	MOVL	S^#10, 8(SP)
	CALLS	S^#3, G^$OUTIN
;571         OUTINT  ( INDEX, 6, 10 );       ( file identification - index )
	.PSECT	R.MAIN,NOWRT,NOEXE
SA123:
	.ASCID	/, /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA123, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;572         OUTTEXT ( ", " );
	SUBL2	S^#12, SP
	MOVL	232(R10), 0(SP)
	MOVL	S^#6, 4(SP)
	MOVL	S^#10, 8(SP)
	CALLS	S^#3, G^$OUTIN
;573         OUTINT  ( SEQUENCE NO, 6, 10 ); ( sequence number )
	.PSECT	R.MAIN,NOWRT,NOEXE
SA126:
	.ASCID	/, /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA126, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;574         OUTTEXT ( ", " );
	SUBL2	S^#12, SP
	MOVL	236(R10), 0(SP)
	MOVL	S^#6, 4(SP)
	MOVL	S^#10, 8(SP)
	CALLS	S^#3, G^$OUTIN
;575         OUTINT  ( VOLUMN NO, 6, 10 );   ( volumn number )
	.PSECT	R.MAIN,NOWRT,NOEXE
SA129:
	.ASCID	/) /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA129, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;576         OUTTEXT ( ") " );
;577       'END' PROCEDURE OUT FILE ID;
;578 
	JMP	@224(R10)

;579     'PROCEDURE' OUT TIME ( 'VALUE''INTEGER' IDENT BYTE OFFSET );
;580       'BEGIN'
;581         'BYTE''ARRAY' STRING [ 0:22 ] := 'LITERAL'(A);
;582         'OVERLAY' STRING [0] 'WITH' 'INTEGER' STRING0;
;583         'INTEGER' STRING COUNT, STRING ADDRESS;
; ********************* PA130 *********************
	.ALIGN	2
PA130:
	MOVAL	DA, R10
	MOVQ	(SP)+, 240(R10)
;584         STRING COUNT   := 23;
;585         STRING ADDRESS := 'LOCATION' (STRING0) * 4;
;586 
;587         SYS ASCTIM ( STRING COUNT,
;588                      'LOCATION'(STRING COUNT)*4,
;589                      'LOCATION'(BUFFER [ 0 ] )*4 + 
;590                                             F NAME START1 + IDENT BYTE OFFSET ,
	MOVL	S^#23, 248(R10)
	MOVAL	52244(R10), 252(R10)
	SUBL2	S^#16, SP
	MOVAL	248(R10), 0(SP)
	MOVAL	248(R10), 4(SP)
	MOVAL	396(R10), 52336(R10)
	ADDL3	52336(R10), 28(R10), R0
	ADDL3	R0, 244(R10), 8(SP)
	CLRL	12(SP)
	CALLS	S^#4, G^SYS$ASCTIM
;591                      0                            );
;592 
	MOVAL	248(R10), R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;593         OUT TEXT ( 'LOCATION' (STRING COUNT) );
;594 
;595       'END' PROCEDURE OUT FILE ID;
;596 
;597 (-PAGE *** DISPLAY FILE HEADER *** Page 2 *** )
;598 
;599 
	JMP	@240(R10)

;600     'INTEGER' J;
;601 
; ********************* PA117 *********************
	.ALIGN	2
PA117:
	MOVAL	DA, R10
	MOVL	(SP)+, 220(R10)
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;602     OUTCHAR ( EOL );
	PUSHL	S^#2
	JSB	PA3
;603     OUTTEXT ( 'IF' RBUFFER (SEG NUM) = 0 'THEN'
;604                 "Deleted file "
	TSTL	R0
	BEQL	BA24
	BRW	LA137
BA24:
;605               'ELSE'
	.PSECT	R.MAIN,NOWRT,NOEXE
SA138:
	.ASCID	/Deleted file /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA138, R0
	ASHL	#-2, R0, R0
	BRW	LA135
LA137:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA139:
	.ASCID	/Deleted file extension /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA139, R0
	ASHL	#-2, R0, R0
LA135:
	PUSHL	R0
	CALLS	S^#1, G^$OUTXT
;606                 "Deleted file extension "  );
;607 
LA140:
;608     'FOR' J := 1 'STEP' 1 'UNTIL' F NAME LIMIT 'DO'
	MOVL	S^#1, 256(R10)
	MOVL	24(R10), 52340(R10)
LA141:
	CMPL	256(R10), 52340(R10)
	BLEQ	BA25
	BRW	LA142
BA25:
	PUSHL	256(R10)
	JSB	PA113
	PUSHL	R0
	CALLS	S^#1, G^$OUTCH
	INCL	256(R10)
	BRW	LA141
;609       OUTCHAR ( BUFF CHAR ( J ) );
;610  
LA142:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA146:
	.ASCID	/ found/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA146, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;611     OUTTEXT ( " found" );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;612     OUTCHAR ( EOL );
;613 
	PUSHL	S^#2
	JSB	PA3
;614     'IF' RBUFFER (SEG NUM) = 0 'THEN'
	TSTL	R0
	BEQL	BA26
	BRW	LA149
BA26:
;615       'BEGIN'
	.PSECT	R.MAIN,NOWRT,NOEXE
SA151:
	.ASCID	/Creation date /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA151, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;616         OUTTEXT ( "Creation date " );
	PUSHL	S^#22
	JSB	PA130
;617         OUT TIME ( CREDATE );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA154:
	.ASCID	/ /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA154, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;618         OUTTEXT ( " " );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA156:
	.ASCID	/Revision date /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA156, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;619         OUTTEXT ( "Revision date " );
	PUSHL	S^#30
	JSB	PA130
;620         OUT TIME ( REVDATE );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;621         OUTCHAR ( EOL );
;622       'END';
;623 
LA149:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA160:
	.ASCID	/File id     /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA160, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;624     OUTTEXT ( "File id     " );
	SUBL2	S^#12, SP
	MOVL	16(R10), 0(SP)
;625     OUT FILE ID ( ENTRY NO,
	PUSHL	S^#5
	JSB	PA3
	MOVL	R0, 4(SP)
;626                   RBUFFER (F ID SEQ), 
	PUSHL	S^#6
	JSB	PA3
	MOVL	R0, 8(SP)
	JSB	PA118
;627                   RBUFFER (F ID RVN) );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA165:
	.ASCID	/Segment num /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA165, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;628     OUTTEXT ( "Segment num " );
	PUSHL	S^#2
	JSB	PA3
	SUBL2	S^#12, SP
	MOVL	R0, 0(SP)
	MOVL	S^#6, 4(SP)
	MOVL	S^#10, 8(SP)
	CALLS	S^#3, G^$OUTIN
;629     OUT INT ( RBUFFER (SEG NUM), 6, 10 );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;630     OUTCHAR ( EOL );
;631 
	.PSECT	R.MAIN,NOWRT,NOEXE
SA170:
	.ASCID	/Extension   /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA170, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;632     OUTTEXT ( "Extension   " );
	PUSHL	S^#7
	JSB	PA3
	SUBL2	S^#12, SP
	MOVL	R0, 0(SP)
;633     OUT FILE ID ( RBUFFER (EX FID NUM), 
	PUSHL	S^#8
	JSB	PA3
	MOVL	R0, 4(SP)
;634                   RBUFFER (EX FID SEQ), 
	PUSHL	S^#9
	JSB	PA3
	MOVL	R0, 8(SP)
	JSB	PA118
;635                   RBUFFER (EX FID RVN) );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA176:
	.ASCID	/Back pointer/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA176, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;636     OUTTEXT ( "Back pointer" );
	PUSHL	S^#33
	JSB	PA3
	SUBL2	S^#12, SP
	MOVL	R0, 0(SP)
;637     OUT FILE ID ( RBUFFER (BK FID NUM), 
	PUSHL	S^#34
	JSB	PA3
	MOVL	R0, 4(SP)
;638                   RBUFFER (BK FID SEQ), 
	PUSHL	S^#35
	JSB	PA3
	MOVL	R0, 8(SP)
	JSB	PA118
;639                   RBUFFER (BK FID RVN) );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;640     OUTCHAR ( EOL );
;641  
;642   'END'PROCEDURE  DISPLAY FILE HEAD;
;643 
;644 (-PAGE *** FILE MATCH *** )
;645  
;646 'COMMENT' ***********************************************************
;647  
;648   INPUTS :   FILE         byte array holdin file name suppiled by user
;649              FILE COUNT   number of characters in FILE
;650              F NAME LIMIT number of characters in block
;651 
;652   PROCESS:   Compares the file name in the entry with that supplied by the
;653              user. Taking note of any wild card characters in the users spec.
;654  
;655   OUTPUTS:   'answer's YES if they match NO otherwise.
;656 
;657   MACROS :   NO, YES
;658 
;659   CALLS  :   BUFF CHAR
;660  
;661   CHANGES:
;662 WBL VMS10B 25-JAN-85 Add lable argument to SAME CHARS and macro SAME CHAR
;663   and use it inplace of SAME CHARS. Use FILE COUNT in place of FILE [0].
;664 WBL VMS11  21-May-86 Add 'OR' FILE [ FILE POS ] = 'LITERAL' ( %% ), rename 
;665   BUFF POS as BUFF NO and init to 0 instead of F NAME START+1, use BUFF CHAR
;666   Replace BUFF POS > F NAME MAX + F NAME START by BUFF NO > F NAME MAX2
;667 WBL VMS12  18-Dec-86 Replace F NAME MAX2 by F NAME LIMIT, add PART MATCH and
;668   return it instead of NO if exceed F NAME LIMIT
;669 
;670 **********************************************************************
;671 ;
;672 
;673 (-PAGE *** FILE MATCH *** Page 2 *** )
;674 
;675 
;676 'DEFINE' SAME CHAR "SAME CHARS ( BUFF NAME EXCEEDED )";
;677 
;678 
	JMP	@220(R10)

;679 'INTEGER''PROCEDURE' FILE MATCH;
;680   'BEGIN'
;681     'INTEGER' BUFF NO, FILE POS;
;682 
;683     'INTEGER''PROCEDURE' SAME CHARS ( 'LABEL' BUFF NAME EXCEEDED );
;684       'BEGIN'
LA184:
	JMP	@276(R10)
; ********************* PA183 *********************
	.ALIGN	2
PA183:
	MOVAL	DA, R10
	MOVQ	(SP)+, 272(R10)
;685         'IF' BUFF NO > F NAME LIMIT 'THEN'
	CMPL	264(R10), 24(R10)
	BLEQ	BA27
	BRW	LA184
BA27:
;686           'GOTO' BUFF NAME EXCEEDED;
;687 
	PUSHL	264(R10)
	JSB	PA113
;688         'ANSWER'  'IF' FILE [ FILE POS ] = BUFF CHAR ( BUFF NO ) 'OR'
	MOVL	268(R10), R11
	MOVZBL	908(R10)[R11], R1
	CMPL	R1, R0
	BNEQ	BA28
	BRW	LA188
BA28:
;689                        FILE [ FILE POS ] = 'LITERAL' ( %% )     'THEN'
;690                     YES
	MOVZBL	908(R10)[R11], R0
	CMPL	R0, S^#37
	BEQL	BA29
	BRW	LA189
BA29:
LA188:
;691                   'ELSE'
	CLRL	R0
	BRW	LA186
LA189:
	MOVL	S^#1, R0
LA186:
	JMP	@272(R10)
;692                     NO;
;693 
;694       'END'PROCEDURE SAME CHARS;
;695 

;696     'INTEGER' PART MATCH, WILD FLAG;
;697 
; ********************* PA182 *********************
	.ALIGN	2
PA182:
	MOVAL	DA, R10
	MOVL	(SP)+, 260(R10)
;698     BUFF NO   := 0;
	CLRL	264(R10)
;699     PART MATCH:= NO;
	MOVL	S^#1, 280(R10)
;700     WILD FLAG := NO;
;701 
	MOVL	S^#1, 284(R10)
LA191:
;702     'FOR' FILE POS := 1 'STEP' 1 'UNTIL' FILE COUNT 'DO'
	MOVL	S^#1, 268(R10)
	MOVL	40(R10), 52356(R10)
LA192:
	CMPL	268(R10), 52356(R10)
	BLEQ	BA30
	BRW	LA193
BA30:
;703       'BEGIN'
;704         'IF' FILE [ FILE POS ] = 'LITERAL' (*) 'THEN'
	MOVL	268(R10), R11
	MOVZBL	908(R10)[R11], R0
	CMPL	R0, S^#42
	BEQL	BA31
	BRW	LA194
BA31:
;705           WILD FLAG := YES
;706         'ELSE'
	CLRL	284(R10)
	BRW	LA195
LA194:
;707           'BEGIN'
;708             'IF' WILD FLAG = YES 'THEN'
	TSTL	284(R10)
	BEQL	BA32
	BRW	LA196
BA32:
;709               'BEGIN'
;710                 WILD FLAG := NO;
	MOVL	S^#1, 284(R10)
LA197:
	INCL	264(R10)
	BRB	BA33
BA34:
	MOVAL	DA, R10
	JMP	LA199
BA33:
	MOVAL	BA34, -(SP)
	JSB	PA183
	CMPL	R0, S^#1
	BEQL	BA35
	BRW	LA200
BA35:
	BRW	LA197
;711                 'FOR' BUFF NO := BUFF NO + 1 'WHILE' SAME CHAR = NO 'DO';
;712               'END'
;713             'ELSE'                  
LA196:
;714               'BEGIN'
;715                 BUFF NO := BUFF NO + 1;
	INCL	264(R10)
	BRB	BA36
BA37:
	MOVAL	DA, R10
	JMP	LA199
BA36:
	MOVAL	BA37, -(SP)
	JSB	PA183
;716                 'IF' SAME CHAR = NO 'THEN'
	CMPL	R0, S^#1
	BEQL	BA38
	BRW	LA200
BA38:
	MOVL	S^#1, R0
	JMP	@260(R10)
;717                   'ANSWER' NO;
;718 
;719               'END';
LA200:
;720             PART MATCH := YES; (file matches so far)
;721           'END';
	CLRL	280(R10)
LA195:
	INCL	268(R10)
	BRW	LA192
;722       'END';
LA193:
	CLRL	R0
	JMP	@260(R10)
;723     'ANSWER' YES;
;724 
;725 BUFF NAME EXCEEDED:
;726   'COMMENT' Remainder of the file name is not stored. If matched begining of 
;727      file name fail safe by assuming the rest would have would have matched;
;728 
LA199:
	MOVL	280(R10), R0
	JMP	@260(R10)
;729     'ANSWER' PART MATCH;
;730 
;731 
;732   'END'PROCEDURE  FILE MATCH;
;733 
;734 'DELETE' SAME CHAR;
;735 
;736 (-PAGE *** GET FILE NAME *** )
;737  
;738 'COMMENT' ***********************************************************
;739  
;740  
;741   INPUTS :
;742  
;743   PROCESS:   Reads file from operators console and places it in FILE.
;744              Those parts of the file name that are not specified eg.
;745              version number are set to wild cards.
;746  
;747   OUTPUTS:   FILE
;748   
;749   GLOBALS:   ERROR: control is passed to this label after repeted errors.
;750  
;751   MACROS :   NO, SPACE, YES
;752 
;753   NOTE   :   A leading semicolon will be treated as a syntax error but is
;754              ok if a dot is 1st character. (eg .:nn is ok)
;755  
;756   HISTORY:
;757 WBL VMS10B 25-JAN-85 Add lable argument to procedure ADD. Add setting of 
;758   FILE ADDRESS and replace FILE [0] by FILE COUNT.
;759 WBL VMS11  21-May-86 Replace POS < 31 by POS < 132, add $ _ and %% to legal
;760 WBL VMS12  18-Dec-86 Add 'LITERAL'(-) to procedure LEGAL
;761 
;762 **********************************************************************
;763 ;
;764 

;765 'PROCEDURE' GET FILE NAME;
;766   'BEGIN'
;767     'INTEGER' END NAME FOUND, POS;
;768 
;769     'INTEGER''PROCEDURE' READ PART ( 'VALUE''INTEGER' TERM );
;770       'BEGIN'
;771 
;772         'PROCEDURE' ADD ( 'VALUE''INTEGER' CHAR; 'LABEL' READ PART ERROR );
;773           'BEGIN'
LA207:
	JMP	@316(R10)
; ********************* PA206 *********************
	.ALIGN	2
PA206:
	MOVAL	DA, R10
	MOVQ	(SP)+, 308(R10)
	MOVL	(SP)+, 316(R10)
;774             'IF' POS < 132 'THEN'
	CMPL	296(R10), #132
	BLSS	BA39
	BRW	LA207
BA39:
;775               'BEGIN'
;776                 FILE [ POS ] := 'IF' CHAR < 'LITERAL' (a) 'OR'
	MOVL	296(R10), R0
	MOVL	R0, 52364(R10)
	CMPL	312(R10), #97
	BGEQ	BA40
	BRW	LA210
BA40:
;777                                      CHAR > 'LITERAL' (z)    'THEN'
;778                                   CHAR
	CMPL	312(R10), #122
	BGTR	BA41
	BRW	LA211
BA41:
LA210:
;779                                 'ELSE'
	MOVL	312(R10), R0
	BRW	LA209
LA211:
	BICL3	#-96, 312(R10), R0
LA209:
	MOVL	52364(R10), R11
	CVTLB	R0, 908(R10)[R11]
;780                                   CHAR 'MASK' 'OCTAL' (137); ( upper case )
;781                 POS := POS + 1;
;782               'END'
;783             'ELSE'
;784               'GOTO' READ PART ERROR;
;785 
;786            'END'PROCEDURE  ADD;
;787 
	INCL	296(R10)
	JMP	@308(R10)

;788         'INTEGER''PROCEDURE' LEGAL ( 'VALUE''INTEGER' CHAR );
; ********************* PA212 *********************
	.ALIGN	2
PA212:
	MOVAL	DA, R10
	MOVQ	(SP)+, 320(R10)
	CMPL	324(R10), S^#48
	BGEQ	BA42
	BRW	LA214
BA42:
;789            'ANSWER' 'IF' CHAR >= 'LITERAL' (0) 'AND' CHAR <= 'LITERAL' (9) 'OR'
	CMPL	324(R10), S^#57
	BGTR	BA43
	BRW	LA215
BA43:
LA214:
	CMPL	324(R10), #65
	BGEQ	BA44
	BRW	LA216
BA44:
;790                          CHAR >= 'LITERAL' (A) 'AND' CHAR <= 'LITERAL' (Z) 'OR'
	CMPL	324(R10), #90
	BGTR	BA45
	BRW	LA215
BA45:
LA216:
	CMPL	324(R10), #97
	BGEQ	BA46
	BRW	LA217
BA46:
;791                          CHAR >= 'LITERAL' (a) 'AND' CHAR <= 'LITERAL' (z) 'OR'
	CMPL	324(R10), #122
	BGTR	BA47
	BRW	LA215
BA47:
LA217:
;792                          CHAR =  'LITERAL' ($)  'OR'
	CMPL	324(R10), S^#36
	BNEQ	BA48
	BRW	LA215
BA48:
;793                          CHAR =  'LITERAL' (_)  'OR'
	CMPL	324(R10), #95
	BNEQ	BA49
	BRW	LA215
BA49:
;794                          CHAR =  'LITERAL' (-)  'OR'
	CMPL	324(R10), S^#45
	BNEQ	BA50
	BRW	LA215
BA50:
;795                          CHAR =  'LITERAL' (%%) 'OR'
	CMPL	324(R10), S^#37
	BNEQ	BA51
	BRW	LA215
BA51:
;796                          CHAR =  'LITERAL' (*)                           'THEN'
;797                       YES
	CMPL	324(R10), S^#42
	BEQL	BA52
	BRW	LA218
BA52:
LA215:
;798                     'ELSE'
	CLRL	R0
	BRW	LA213
LA218:
;799                       NO;
;800 
	MOVL	S^#1, R0
LA213:
	JMP	@320(R10)

; ********************* PA205 *********************
	.ALIGN	2
PA205:
	MOVAL	DA, R10
	MOVQ	(SP)+, 300(R10)
;801         'INTEGER' CHAR, CHARS ADDED;;
;802 
;803         CHARS ADDED := NO;  ( initialise )
	MOVL	S^#1, 332(R10)
;804         CHAR        := EOL; ( default )
;805 
;806         'IF' END NAME FOUND = NO 'THEN'
	MOVL	S^#10, 328(R10)
	CMPL	292(R10), S^#1
	BEQL	BA53
	BRW	LA220
BA53:
;807           'BEGIN'
LA221:
	CALLS	S^#0, G^$INCH
	MOVL	R0, 328(R10)
	PUSHL	R0
	JSB	PA212
	TSTL	R0
	BEQL	BA54
	BRW	LA220
BA54:
;808             'FOR' CHAR := INCHAR 'WHILE' LEGAL ( CHAR ) = YES 'DO'
;809               'BEGIN'
;810                 CHARS ADDED := YES;
	CLRL	332(R10)
	SUBL2	S^#8, SP
	MOVL	328(R10), 0(SP)
	BRB	BA55
BA56:
	MOVAL	DA, R10
	JMP	LA230
BA55:
	MOVAL	BA56, 4(SP)
	JSB	PA206
;811                 ADD ( CHAR, READ PART ERROR );
	BRW	LA221
;812               'END';
;813           'END';
;814 
LA220:
;815         'IF' CHARS ADDED = NO 'THEN'
	CMPL	332(R10), S^#1
	BEQL	BA57
	BRW	LA227
BA57:
	SUBL2	S^#8, SP
	MOVL	S^#42, 0(SP)
	BRB	BA58
BA59:
	MOVAL	DA, R10
	JMP	LA230
BA58:
	MOVAL	BA59, 4(SP)
	JSB	PA206
;816           ADD ( 'LITERAL'(*), READ PART ERROR);(null part replace by wild card)
;817 
LA227:
	CMPL	328(R10), 304(R10)
	BNEQ	BA60
	BRW	LA229
BA60:
	CMPL	328(R10), S^#32
	BNEQ	BA61
	BRW	LA229
BA61:
;818         'IF' CHAR = TERM 'OR' CHAR = SPACE 'OR' CHAR = EOL 'THEN'
	CMPL	328(R10), S^#10
	BEQL	BA62
	BRW	LA230
BA62:
LA229:
;819           'BEGIN'
;820             'IF' TERM <> 0 'THEN'
	TSTL	304(R10)
	BNEQ	BA63
	BRW	LA231
BA63:
	SUBL2	S^#8, SP
	MOVL	304(R10), 0(SP)
	BRB	BA64
BA65:
	MOVAL	DA, R10
	JMP	LA230
BA64:
	MOVAL	BA65, 4(SP)
	JSB	PA206
;821               ADD ( TERM, READ PART ERROR );
LA231:
	CMPL	328(R10), S^#32
	BNEQ	BA66
	BRW	LA233
BA66:
;822             'IF' CHAR = SPACE 'OR' CHAR = EOL 'THEN'
	CMPL	328(R10), S^#10
	BEQL	BA67
	BRW	LA234
BA67:
LA233:
;823               END NAME FOUND := YES;
	CLRL	292(R10)
LA234:
	CLRL	R0
	JMP	@300(R10)
;824             'ANSWER' YES;
;825 
;826           'END';
;827 
;828 READ PART ERROR:
LA230:
	MOVL	S^#1, R0
	JMP	@300(R10)
;829         'ANSWER' NO;
;830 
;831       'END'PROCEDURE  READ PART;
;832 

;833     'INTEGER' NERRORS := 0;
;834 
;835   'COMMENT' Setup second half of VMS string descriptor for FILE;
; ********************* PA204 *********************
	.ALIGN	2
PA204:
;836     FILE ADDRESS := 'LOCATION' ( FILE0 ) * 4 + 1;
;837 
;838 ASKFILE:
	MOVAL	DA, R10
	MOVL	(SP)+, 288(R10)
	MOVAL	908(R10), 52380(R10)
	ADDL3	52380(R10), S^#1, 44(R10)
LA236:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA238:
	.ASCID	/File ? /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA238, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;839     OUTTEXT ( "File ? " );
	PUSHL	S^#27
	CALLS	S^#1, G^$OUTCH
;840     OUTCHAR ( ESC );
;841 
;842     POS := 1;
	MOVL	S^#1, 296(R10)
;843     END NAME FOUND := NO;
	MOVL	S^#1, 292(R10)
	PUSHL	S^#46
	JSB	PA205
;844     'IF' READ PART ( 'LITERAL' (.) ) = YES 'AND'
	TSTL	R0
	BEQL	BA68
	BRW	LA241
BA68:
	PUSHL	S^#59
	JSB	PA205
;845          READ PART ( 'LITERAL' (;) ) = YES 'AND'
	TSTL	R0
	BEQL	BA69
	BRW	LA241
BA69:
	PUSHL	S^#0
	JSB	PA205
;846          READ PART ( 0 )             = YES   'THEN'
	TSTL	R0
	BEQL	BA70
	BRW	LA241
BA70:
;847       FILE COUNT := POS - 1 'COMMENT' set length;
;848 
;849     'ELSE'
	SUBL3	S^#1, 296(R10), 40(R10)
	BRW	LA244
LA241:
;850       'BEGIN'
	.PSECT	R.MAIN,NOWRT,NOEXE
SA246:
	.ASCID	/File name syntax error /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA246, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;851         OUTTEXT ( "File name syntax error " );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;852         OUTCHAR ( EOL );
;853         N ERRORS := NERRORS + 1;
;854         'IF' NERRORS < = 3 'THEN'
;855           'GOTO' ASK FILE
;856 
	INCL	336(R10)
	CMPL	336(R10), S^#3
	BGTR	BA71
	BRW	LA236
BA71:
;857         'ELSE'
	BRW	LA249
;858           'GOTO' ERROR;
;859 
;860       'END';
;861 
;862   'END'PROCEDURE  GET FILE NAME; 
;863 
;864 (-PAGE *** UPDATE BIT MAP *** )
;865  
;866 'COMMENT' ***********************************************************
;867  
;868  
;869   INPUTS :   BUFFER/BUFF
;870              ENTRY NO     First file entry has ENTRY NO equal to one.
;871              START BITMAP virtual block number of first block in bit map
;872              BITMAP SIZE  in blocks
;873 
;874   PROCESS:   When the file is deleted then the bit in the bit map indicating
;875              whether it's entry in INDEXF.SYS is in use may be cleared. This
;876              procedure sets it again.
;877 
;878   OUTPUTS:   BUFFER/BUFF
;879              Disk block containing use/free block is modified and written back.
;880  
;881   CALLS  :   ERROR1, READ BLOCK, WRITE BLOCK
;882 
;883   HISTORY:
;884 WBL VMS10B 25-JAN-85 Replace SAVE HI and SAVE LO by SAVE and change calling of
;885   WHERE IN and FINDOUT. Replace VBN HI and VBN LO by VBN and change calling
;886   of FINDIN.
;887 WBL VMS11  21-May-86 Replace INBLOCK, OUTBLOCK etc by READ BLOCK and WRITE BLOCK
;888   Add check for WRITE BLOCK error
;889  
;890 **********************************************************************
;891 ;
;892  
LA244:
	JMP	@288(R10)
LA249:
	MOVL	C$SP, SP
	MOVL	(SP), FP
	BRW	LA367

;893 'PROCEDURE' UPDATE BITMAP;
;894   'BEGIN'
;895     'INTEGER' BIT NUMBER, BIT OFFSET, BYTE NUMBER, BYTE OFFSET, BLOCK NUMBER;
;896     'INTEGER' VBN;
;897 
;898     'BYTE''ARRAY' BIT [ 0:7 ] := 
;899       'OCTAL'(001),'OCTAL'(002),'OCTAL'(004),'OCTAL'(010),
;900       'OCTAL'(020),'OCTAL'(040),'OCTAL'(100),'OCTAL'(200);
;901 
; ********************* PA251 *********************
	.ALIGN	2
PA251:
;902      BIT NUMBER   := ENTRY NO - 1;             ( entry no starts from one )
;903      BYTE NUMBER  := BIT NUMBER / 8;
;904      BIT  OFFSET  := BIT NUMBER - BYTE NUMBER * 8;
;905      BLOCK NUMBER := BYTE NUMBER / 512;
;906      BYTE OFFSET  := BYTE NUMBER - BLOCK NUMBER * 512;
;907 
;908   'COMMENT' check required bit lies in the bit map;
;909 
;910      'IF' BLOCK NUMBER >= BIT MAP SIZE 'THEN'
	MOVAL	DA, R10
	MOVL	(SP)+, 340(R10)
	SUBL3	S^#1, 16(R10), 344(R10)
	ASHL	#-3, 344(R10), 352(R10)
	ASHL	S^#3, 352(R10), R0
	SUBL3	R0, 344(R10), 348(R10)
	ASHL	#-9, 352(R10), 360(R10)
	ASHL	S^#9, 360(R10), R0
	SUBL3	R0, 352(R10), 356(R10)
	CMPL	360(R10), 12(R10)
	BGEQ	BA72
	BRW	LA252
BA72:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA254:
	.ASCID	/ bit map overflow /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA254, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;911        ERROR1 ( " bit map overflow " );
;912 
;913   'COMMENT' read in relevant block of bit map;
;914 
LA252:
;915      VBN := START BITMAP + BLOCK NUMBER;
;916 
	ADDL3	36(R10), 360(R10), 364(R10)
	PUSHL	364(R10)
	JSB	PA14
;917      'IF' READ BLOCK ( VBN ) <> 512 'THEN'
	CMPL	R0, #512
	BNEQ	BA73
	BRW	LA256
BA73:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA258:
	.ASCID	/Read error on bitmap/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA258, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;918        ERROR1 ( "Read error on bitmap" );
;919 
;920    'COMMENT' ensure free/used bit describing file header is set to used;
;921 
LA256:
	MOVL	348(R10), R11
	MOVZBL	52268(R10)[R11], R0
	MOVL	356(R10), R9
	MOVZBL	396(R10)[R9], R1
	BISL2	R1, R0
	CVTLB	R0, 396(R10)[R9]
;922      BUFF [ BYTE OFFSET ] := BUFF [ BYTE OFFSET ] 'UNION' BIT [ BIT OFFSET ];
;923 
;924     
;925    'COMMENT' write block back to index file;
;926 
	PUSHL	364(R10)
	JSB	PA44
;927      'IF' WRITE BLOCK ( VBN ) <> 512 'THEN'
	CMPL	R0, #512
	BNEQ	BA74
	BRW	LA260
BA74:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA262:
	.ASCID	/Write error on bitmap/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA262, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;928        ERROR1 ( "Write error on bitmap" );
;929 
;930   'END'PROCEDURE  UPDATE BITMAP;
;931  
;932 (-PAGE *** UPDATE BLOCK *** )
;933  
;934 'COMMENT' ***********************************************************
;935  
;936  
;937   INPUTS :   BUFFER       holds block to be updated
;938              ENTRY NO     This forms one word of the three word file 
;939                           identification. First file entry has ENTRY NO
;940                           equal to one.
;941              FIRST ENTRY  virtual block number of first entry.
;942 
;943   PROCESS:   When the file is deleted the first word of the three word file
;944              identification code held in the entry is replaced by zero.
;945              A bit in the file characteristics bit mask may be set to indicate
;946              that the file is marked for delete. Inaddition the the checksum 
;947              is also zeroed. Both these words are recalculated, the marked
;948              for delete bit is always cleared and then the entry is replaced.
;949 
;950   OUTPUTS:   BUFFER
;951              Disk block containing entry is modified and written back.
;952 
;953   CALLS  :   ERROR1, WRITE BLOCK
;954  
;955   MACROS :   F ID NUM, FILE CHAR, MARK DEL
;956   HISTORY:
;957 WBL VMS10B 25-JAN-85 Replace BUFFER[] by WBUFFER() and RBUFFER(). Replace 
;958   VBN HI and VBN LO by VBN and change calling of FINDOUT
;959 WBL VMS11  21-May-86 Replace OUT BLOCK etc. by WRITE BLOCK, use ERROR1 
;960   instead of STREAM ERROR
;961 
;962 **********************************************************************
;963 ;
;964 
;965 'DEFINE' NOT ( XBITS ) "'INTEGER'( 'HEX'(FFFF) 'DIFFER' XBITS )"; (complement)
;966 
LA260:
	JMP	@340(R10)

;967 'PROCEDURE' UPDATE BLOCK;
;968   'BEGIN'
;969     'INTEGER' CHECK SUM, N;
;970 
;971   'COMMENT' undelete entry;
;972  
; ********************* PA263 *********************
	.ALIGN	2
PA263:
	MOVAL	DA, R10
	MOVL	(SP)+, 368(R10)
	SUBL2	S^#8, SP
	MOVL	S^#4, 0(SP)
	MOVL	16(R10), 4(SP)
	JSB	PA7
;973     WBUFFER (F ID NUM, ENTRY NO);
;974 
;975   'COMMENT' clear marked for delete bit;
;976 
	SUBL2	S^#8, SP
	MOVL	S^#26, 0(SP)
	PUSHL	S^#26
	JSB	PA3
	BICL3	#-32768, R0, 4(SP)
	JSB	PA7
;977     WBUFFER (FILE CHAR, RBUFFER (FILE CHAR) 'MASK' NOT ( MARK DEL ) );
;978 
;979   'COMMENT' calculate checksum and restore it;
;980 
;981     CHECK SUM := 0;
;982 
	CLRL	372(R10)
LA267:
;983     'FOR' N := 0 'STEP' 1 'UNTIL' 254 'DO'
	CLRL	376(R10)
LA268:
	CMPL	376(R10), #254
	BLEQ	BA75
	BRW	LA269
BA75:
	PUSHL	376(R10)
	JSB	PA3
	ADDL2	R0, 372(R10)
	INCL	376(R10)
	BRW	LA268
;984       CHECK SUM := CHECK SUM + RBUFFER ( N );
;985 
LA269:
	SUBL2	S^#8, SP
	MOVL	#255, 0(SP)
	MOVL	372(R10), 4(SP)
	JSB	PA7
;986     WBUFFER ( 255, CHECK SUM );
;987 
;988  'COMMENT' write block back to index file;
;989 
	ADDL3	16(R10), 20(R10), R0
	SUBL3	S^#1, R0, -(SP)
	JSB	PA44
;990     'IF' WRITE BLOCK ( ENTRY NO + FIRST ENTRY - 1 ) <> 512 'THEN'
	CMPL	R0, #512
	BNEQ	BA76
	BRW	LA273
BA76:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA275:
	.ASCID	/I/<47>/O error on writting to INDEXF/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA275, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;991       ERROR1 ( "I/O error on writting to INDEXF" );
;992 
;993   'END'PROCEDURE  UPDATE BLOCK;
;994 
;995 'DELETE' NOT;
;996 
;997 (-PAGE *** main program *** )
;998 
LA273:
	JMP	@368(R10)

;999   'INTEGER' MAX ENTRY;
;1000 
;1001   'INTEGER' AUX, ERROR TYPE;
;1002 
LA1:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA277:
	.ASCID	/SYS$INPUT/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#12, SP
	MOVAL	SA277, R11
	ASHL	#-2, R11, 0(SP)
	.PSECT	R.MAIN,NOWRT,NOEXE
SA278:
	.ASCID	/TXT/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA278, R11
	ASHL	#-2, R11, 4(SP)
	MOVAL	4(R10), 8(SP)
	CALLS	S^#3, G^$OPNST
;1003   OPENSTREAM ( "SYS$INPUT", "TXT", TT IN );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA280:
	.ASCID	/SYS$OUTPUT/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#12, SP
	MOVAL	SA280, R11
	ASHL	#-2, R11, 0(SP)
	.PSECT	R.MAIN,NOWRT,NOEXE
SA281:
	.ASCID	/TXT/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA281, R11
	ASHL	#-2, R11, 4(SP)
	MOVAL	8(R10), 8(SP)
	CALLS	S^#3, G^$OPNST
;1004   OPENSTREAM ( "SYS$OUTPUT", "TXT", TT OUT );
;1005 
	PUSHL	8(R10)
	CALLS	S^#1, G^$OUSTR
;1006   OUTSTREAM ( TT OUT );
;1007 
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1008   OUTCHAR ( EOL );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1009   OUTCHAR ( EOL );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA286:
	.ASCID	/  FILES-11B restoration program. /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA286, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1010   OUTTEXT ( "  FILES-11B restoration program. " );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1011   OUTCHAR ( EOL );  OUTCHAR ( EOL );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA290:
	.ASCID	/  Version :  VMS Native mode 12/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA290, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1012   OUTTEXT ( "  Version :  VMS Native mode 12" );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1013   OUTCHAR ( EOL );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA293:
	.ASCID	/  Author  :  W. B. Langdon  CEGB  0372 374488 /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA293, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1014   OUTTEXT ( "  Author  :  W. B. Langdon  CEGB  0372 374488 " );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1015   OUTCHAR ( EOL ); OUTCHAR ( EOL ); OUTCHAR ( EOL );
;1016 
;1017 
	PUSHL	S^#7
	CALLS	S^#1, G^$CNTE
;1018   CONTINUE ON ERROR ( 7 );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA299:
	.ASCID	/INDEXF/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#12, SP
	MOVAL	SA299, R11
	ASHL	#-2, R11, 0(SP)
	.PSECT	R.MAIN,NOWRT,NOEXE
SA300:
	.ASCID	/BLK/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA300, R11
	ASHL	#-2, R11, 4(SP)
	MOVAL	0(R10), 8(SP)
	CALLS	S^#3, G^$OPNST
;1019   OPENSTREAM ( "INDEXF", "BLK", INDEX );
	PUSHL	S^#7
	CALLS	S^#1, G^$EXTE
;1020   EXIT ON ERROR ( 7 );
	MOVAL	384(R10), -(SP)
	CALLS	S^#1, G^$LSTE
;1021   ERROR TYPE := LAST ERROR ( AUX );
;1022   'IF' ERROR TYPE <> 0 'THEN'
	MOVL	R0, 388(R10)
	BNEQ	BA77
	BRW	LA303
BA77:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA305:
	.ASCID	/ on setting up stream to INDEXF. Is device ready ?/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#8, SP
	MOVAL	SA305, R11
	ASHL	#-2, R11, 0(SP)
	MOVL	384(R10), 4(SP)
	JSB	PA99
;1023     STREAM ERROR ( " on setting up stream to INDEXF. Is device ready ?", AUX );
;1024 
LA303:
	SUBL2	S^#16, SP
	MOVL	0(R10), 0(SP)
	.PSECT	R.MAIN,NOWRT,NOEXE
SA307:
	.ASCID	/MOD/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA307, R11
	ASHL	#-2, R11, 4(SP)
	CLRL	8(SP)
	CLRL	12(SP)
	CALLS	S^#4, G^$SFPR
;1025   SET FILE PAR   ( INDEX , "MOD", 0, 0 );
	PUSHL	0(R10)
	CALLS	S^#1, G^$SHARE
;1026   SHARE ( INDEX );
;1027 
	PUSHL	S^#3
	CALLS	S^#1, G^$CNTE
;1028   CONTINUE ON ERROR ( 3 );
	PUSHL	0(R10)
	CALLS	S^#1, G^$INSTR
;1029   INSTREAM ( INDEX );
	PUSHL	S^#3
	CALLS	S^#1, G^$EXTE
;1030   EXIT ON ERROR ( 3 );
	MOVAL	384(R10), -(SP)
	CALLS	S^#1, G^$LSTE
;1031   ERROR TYPE := LAST ERROR ( AUX );
;1032   'IF' ERROR TYPE <> 0 'THEN'
	MOVL	R0, 388(R10)
	BNEQ	BA78
	BRW	LA313
BA78:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA315:
	.ASCID	/ on opening INDEXF/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#8, SP
	MOVAL	SA315, R11
	ASHL	#-2, R11, 0(SP)
	MOVL	384(R10), 4(SP)
	JSB	PA99
;1033     STREAM ERROR ( " on opening INDEXF", AUX );
;1034 
;1035 'COMMENT' read in Home Block;
;1036  
LA313:
	PUSHL	S^#2
	JSB	PA14
;1037   'IF' READ BLOCK ( HOME BLOCK ) <> 512 'THEN'
	CMPL	R0, #512
	BNEQ	BA79
	BRW	LA317
BA79:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA319:
	.ASCID	/Home block read error on INDEXF/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA319, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;1038     ERROR1 ( "Home block read error on INDEXF" );
;1039  
;1040 'COMMENT' Check that this is a structure level 2 volumn;
;1041  
LA317:
	PUSHL	S^#6
	JSB	PA3
;1042   'IF' 'BITS' [8,8] RBUFFER ( STRUCLEV ) <> 2 'THEN'
	EXTZV	S^#8, S^#8, R0, R1
	CMPL	R1, S^#2
	BNEQ	BA80
	BRW	LA321
BA80:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA323:
	.ASCID	/This is not a structure level 2 Volumn /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	SUBL2	S^#8, SP
	MOVAL	SA323, R11
	ASHL	#-2, R11, 0(SP)
;1043     ERROR2 ( "This is not a structure level 2 Volumn ",
	.PSECT	R.MAIN,NOWRT,NOEXE
SA324:
	.ASCID	/use INDEX program for structure level 1/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA324, R11
	ASHL	#-2, R11, 4(SP)
	JSB	PA89
;1044              "use INDEX program for structure level 1" );
;1045  
;1046 'COMMENT' check version number;
;1047  
LA321:
	PUSHL	S^#6
	JSB	PA3
;1048   'IF' 'BITS' [8,0] RBUFFER (STRUCLEV) <> 1 'THEN'
	MOVZBL	R0, R1
	CMPL	R1, S^#1
	BNEQ	BA81
	BRW	LA326
BA81:
;1049     'BEGIN'
	.PSECT	R.MAIN,NOWRT,NOEXE
SA328:
	.ASCID	/WARNING - new version of FILES-11B.  Version /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA328, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1050       OUTTEXT ( "WARNING - new version of FILES-11B.  Version " );
	PUSHL	S^#6
	JSB	PA3
	SUBL2	S^#12, SP
	MOVZBL	R0, 0(SP)
	MOVL	S^#4, 4(SP)
	MOVL	S^#10, 8(SP)
	CALLS	S^#3, G^$OUTIN
;1051       OUTINT  ( 'BITS' [8,0] RBUFFER (STRUCLEV), 4, 10 );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1052       OUTCHAR ( EOL );
;1053     'END';
;1054  
;1055 'COMMENT' Extract the maximium number of files INDEXF can hold;
;1056  
LA326:
	PUSHL	S^#14
	JSB	PA3
	PUSHL	S^#15
	MOVL	R0, 52396(R10)
	JSB	PA3
	ASHL	S^#16, R0, R0
;1057   MAX ENTRY := RBUFFER (MAXFILES LO) + RBUFFER (MAXFILES HI)*'OCTAL' (200000);
;1058  
;1059 'COMMENT' Find the virtual blocks containing the start of the bit map. Then
;1060   find the first entry by adding the number of blocks used by the bit map 
;1061   to the VBN of the first block of the bit map ;
;1062 
	ADDL3	52396(R10), R0, 380(R10)
	PUSHL	S^#11
	JSB	PA3
;1063   START BITMAP := RBUFFER ( IB MAP VBN );
	MOVL	R0, 36(R10)
	PUSHL	S^#16
	JSB	PA3
;1064   BIT MAP SIZE := RBUFFER ( IB MAP SIZE );
;1065   FIRST ENTRY  := START BIT MAP + BIT MAP SIZE;
;1066  
;1067 'COMMENT' End of Home block checks;
;1068 
;1069 (-PAGE *** search for deleted file header *** )
;1070  
	MOVL	R0, 12(R10)
	ADDL3	36(R10), R0, 20(R10)
	PUSHL	4(R10)
	CALLS	S^#1, G^$INSTR
;1071   IN STREAM ( TT IN );
	JSB	PA204
;1072   GET FILE NAME;
;1073 
	.PSECT	R.MAIN,NOWRT,NOEXE
SA339:
	.ASCID	/Starting search for /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA339, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1074   OUTTEXT ( "Starting search for " );
	MOVAL	40(R10), R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1075   OUTTEXT ( 'LOCATION' ( FILE COUNT ) );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1076   OUTCHAR ( EOL );
;1077 
LA342:
;1078   'FOR' ENTRY NO := 1 'STEP'1 'UNTIL' MAX ENTRY 'DO'
	MOVL	S^#1, 16(R10)
	MOVL	380(R10), 52396(R10)
LA343:
	CMPL	16(R10), 52396(R10)
	BLEQ	BA82
	BRW	LA344
BA82:
;1079     'BEGIN'
;1080       'INTEGER' LENGTH;
;1081  
	SUBL3	S^#1, 16(R10), R0
	ADDL3	R0, 20(R10), -(SP)
	JSB	PA14
;1082       LENGTH := READ BLOCK ( ENTRY NO - 1 + FIRST ENTRY );
;1083  
;1084       'IF' LENGTH < 0 'THEN'
	MOVL	R0, 392(R10)
	BGEQ	BA83
	BRW	LA344
BA83:
;1085         'GOTO' END LOOP; ( end of file found )
;1086 
;1087       'IF' LENGTH <> 512 'THEN'
	CMPL	R0, #512
	BNEQ	BA84
	BRW	LA348
BA84:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA350:
	.ASCID	/Read error on INDEXF/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA350, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA81
;1088         ERROR1 ( "Read error on INDEXF" );
;1089 
;1090 
;1091    'COMMENT' find the start of this entries file name segments; 
;1092 
LA348:
	MOVZBL	396(R10), R0
;1093       F NAME START1 := BUFF [ ID OFFSET ]*2; (convert from word to byte offset)
;1094       F NAME START2 := F NAME START1 + F NAME MAX1 + 2 + 4*8; (ie. add 1 word )
;1095                                                               (+4 8 byte times)
	ASHL	S^#1, R0, 28(R10)
	ADDL3	28(R10), S^#54, 32(R10)
	PUSHL	S^#2
	JSB	PA3
;1096       F NAME LIMIT  := 'IF' RBUFFER (SEG NUM) = 0 'THEN'
	TSTL	R0
	BEQL	BA85
	BRW	LA353
BA85:
;1097                          F NAME MAX2 'COMMENT' Only first header has full name;
;1098                        'ELSE'
	MOVL	#86, R0
	BRW	LA351
LA353:
	MOVL	S^#20, R0
LA351:
;1099                          F NAME MAX1;'COMMENT' File name extension missing;
;1100 
;1101     'COMMENT' if this entry has been deleted and it's name matches
;1102       that supplied by the user then restore it, if required;
;1103  
;1104 (-----'IF' FILE MATCH = YES 'THEN'---------------------------------------------)
	MOVL	R0, 24(R10)
	PUSHL	S^#4
	JSB	PA3
	TSTL	R0
	BEQL	BA86
	BRW	LA355
BA86:
	JSB	PA182
;1105       'IF' RBUFFER (F ID NUM) = 0 'AND' FILE MATCH = YES 'THEN'
	TSTL	R0
	BEQL	BA87
	BRW	LA355
BA87:
;1106         'BEGIN'
	JSB	PA117
;1107           DISPLAY FILE HEADER;
;1108 
	PUSHL	4(R10)
	CALLS	S^#1, G^$INSTR
;1109           INSTREAM ( TT IN );
	.PSECT	R.MAIN,NOWRT,NOEXE
SA360:
	.ASCID	/Do you wish to restore it? Y/<47>/N /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA360, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA61
;1110           'IF' ASK ( "Do you wish to restore it? Y/N " ) = YES 'THEN'
	TSTL	R0
	BEQL	BA88
	BRW	LA361
BA88:
;1111             'BEGIN'
	JSB	PA263
;1112               UPDATE BLOCK;
	JSB	PA251
;1113               UPDATE BITMAP;
;1114             'END';
;1115 
LA361:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA365:
	.ASCID	/Continue search for file(s)? Y/<47>/N /
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA365, R11
	ASHL	#-2, R11, -(SP)
	JSB	PA61
;1116           'IF' ASK ( "Continue search for file(s)? Y/N " ) = NO 'THEN'
	CMPL	R0, S^#1
	BNEQ	BA89
	BRW	LA367
BA89:
;1117             'GOTO' END PROC;
;1118  
;1119         'END' DELETED FILE FOUND;
LA355:
	INCL	16(R10)
	BRW	LA343
;1120     'END'LOOP;
;1121 END LOOP:
LA344:
	.PSECT	R.MAIN,NOWRT,NOEXE
SA369:
	.ASCID	/Search finished/
	.ALIGN	2
	.PSECT	P.MAIN,NOWRT,EXE
	MOVAL	SA369, R11
	ASHL	#-2, R11, -(SP)
	CALLS	S^#1, G^$OUTXT
;1122   OUTTEXT ( "Search finished" );
	PUSHL	S^#10
	CALLS	S^#1, G^$OUTCH
;1123   OUTCHAR ( EOL );
;1124 
;1125 END PROC:
;1126 ERROR:
LA367:
	CALLS	S^#0, G^$CLALL
;1127   CLOSE ALL STREAMS;
;1128  
	MOVL	#402685953, R0
	RET	
	.PSECT	D.MAIN,WRT,NOEXE
TA:
	.BLKL	32
;1129 'END'SEGMENT;
;1130 'FINISH'
	.EXTERNAL	$SHARE
	.EXTERNAL	$SFPR
	.EXTERNAL	$FNDIN
	.EXTERNAL	$FNDOU
	.EXTERNAL	$CNTE
	.EXTERNAL	$EXTE
	.EXTERNAL	$LSTE
	.EXTERNAL	$OPNST
	.EXTERNAL	$INSTR
	.EXTERNAL	$OUSTR
	.EXTERNAL	$INCH
	.EXTERNAL	$ASKIN
	.EXTERNAL	$ASKOU
	.EXTERNAL	$OUTCH
	.EXTERNAL	$OUTXT
	.EXTERNAL	$CLALL
	.EXTERNAL	$OUTIN
	.EXTERNAL	$OUTBL
	.EXTERNAL	$INBL
	.EXTERNAL	SYS$ASCTIM
;  ************* END OF MAIN *************
	.END	MAIN