.NLIST
;	THE FOLLOWING LINES ARE STANDARD FOR THE DALLAS LABORATORY OF
;	EASTMAN KODAK COLOR PRINT AND PROCESSING.  LIST CONTROLS
;	ARE DELETED OR REMOVED, AS DESIRED.
;	.LIST	TTM	; LIST IN TELETYPE (80-COLUMN) MODE
;	.NLIST		; DON'T LIST ANYTHING
;	.NLIST	SYM	; DON'T LIST SYMBOL TABLE
;	.NLIST	COM	; DON'T LIST COMMENTS
;	.NLIST	SEQ	; DON'T LIST LINE NUMBERS
;	.NLIST	LOC	; DON'T LIST PC LOCATIONS
;	.NLIST	BIN	; DON'T LIST BINARY CODE
	.NLIST	CND	; DON'T LIST UNSATISIFED CONDITIONAL CODING
;	.LIST	MEB	; LIST MACRO EXPANSIONS
	.NLIST	BEX	; LIST ONLY 1ST LINE OF BINARY EXPANSIONS
	.ENABL	AMA	; LIST ABSOLUTE ADDRESSES
	.LIST
;
;************************************
	.TITLE	DDSC
;************************************
;
	.IDENT	/PMC002/
;
; SIZE OF MAIN I/O BUFFER IN BLOCKS.  
BUFBLK=40.
;
; TASK SIZE MAY INCREASED AT THE EXPENSE OF RUN TIME BY DECREASING
; THE SIZE OF THE BUFFER.
;
; WITH A 40. BLOCK BUFFER, RUN TIME IS APPROXIMATELY 2 SECONDS PER
; FILE, PLUS 3-5 MINUTES ON AN RP02 DRIVE.
;
;
;
;	DALLAS-DISK-SAVE-AND-COMPRESS (DDSC) IS A DIRECTORY-DRIVEN
;	TASK FOR SAVING AND COMPRESSING A SOURCE DISK ONTO AN OBJECT
;	DISK -- ELIMINATING UN-USED DISK BLOCKS IN EACH FILE,
;	COMPRESSING THE INDEX FILE, AND ELIMINATING "LOST" FILES
;	FROM THE OBJECT PACK.
;
;	THE TASK SHOULD BE RUN FROM [1,1].  THE SOURCE PACK MAY BE IN
;	"READ-ONLY".
;
;	LIMITATIONS:
;		1) THE TASK AS BUILT WILL HANDLE A MAXIMUM OF
;		251 UFD'S.  IT MAY BE EASILY MODIFIED FOR A LARGER
;		NUMBER.
;		2) THE TASK WILL NOT HANDLE A SOURCE-PACK INDEX FILE
;		WITH FILE EXTENSION HEADERS.  (IS THIS EVEN POSSIBLE?).
;		3) IF A SYSTEM PACK IS COMPRESSED, IT WILL NOT BE
;		BOOTABLE.  A TARGET SYSGEN MUST BE PERFORMED ON IT FIRST.
;
;	ANY FILE CONTAINED IN ANY SOURCE PACK DIRECTORY WILL BE
;	COPIED TO THE OBJECT PACK, WITH THE RESTRICTIONS NOTED BELOW.
;
;	THIS TASK DOES NOT PRETEND TO REALLY "CLEAN UP" A PACK.
;	IN ORDER TO HAVE A REALLY CLEAN PACK, THE USER IS RESPONSIBLE
;	FOR CERTAIN THINGS:
;
;		(1) DELETING OBSOLETE OR UNUSED DIRECTORIES AND FILES.
;		(2) PURGING OLD VERSIONS OF FILES.
;		(3) REMOVING ANY "SYNONYMS" FOR THE SAME FILE.
;
;	VARIOUS OPTIONS ARE PRESENTED PRIOR TO THE ACTUAL START OF
;	THE DISK COMPRESSION.  THE PRINCIPAL ONE OF THESE IS THE
;	QUESTION AS TO HOW MANY FILES THE INDEX FILE SHOULD PROVIDE
;	FOR.  IT IS DESIRABLE TO CREATE THE INDEX FILE LARGE ENOUGH
;	TO HOLD AS MANY FILES AS WILL EVER BE ON THE PACK, SINCE THIS
;	INSURES THAT THE INDEX FILE WILL BE CONTIGUOUS AND WILL OPERATE
;	AT MAXIMUM EFFICIENCY.
;
;	IF DISK INITIALIZATION IS DONE "ON-LINE" BY DDSC, THE INDEX
;	FILE AND ALL UFD'S ARE CREATED IN THE MIDDLE OF THE PACK.  THIS
;	IS NORMALLY THE MOST EFFICIENT PLACE FOR THEM.  THE ONLY EXCEPTION
;	WOULD BE FOR A PACK WITH VERY FEW AND VERY SMALL FILES.
;
;	IF THE OBJECT PACK IS INITIALIZED ON-LINE, IT IS INITIALIZED
;	WITH /CHA=[DCF].  IN THE AUTHOR'S EXPERIENCE, THERE IS NO
;	DISADVANTAGE WHATSOEVER IN THIS TYPE OF INITIALIZATION.
;	HOWEVER, IF ONE DOES NOT WANT THESE CHARACTERISTICS, THE
;	PACK MUST BE INITIALIZED AHEAD OF TIME.
;
;	DDSC OFFERS THE OPTION OF LISTING UFD'S ON THE OBJECT PACK
;	IN NUMERIC SEQUENCE, REGARDLESS OF HOW THEY MAY HAVE BEEN
;	CREATED ON THE SOURCE PACK. THIS PROBABLY HAS LITTLE EFFECT
;	ON THE PACK'S OPERATION, BUT ON A SYSTEM WITH A LARGE NUMBER
;	OF UFD'S, IT MAY ASSIST IN LISTINGS AND DISK MAINTENANCE.
;
;	THE UFD'S ARE ACTUALLY CREATED IN THE SAME ORDER AS ON THE
;	SOURCE PACK, BUT ARE THEN SORTED NUMERICALLY IN THE MFD.
;	FILES ARE COPIED FROM SOURCE TO OBJECT ACCORDING TO THE
;	NEW ORDER.  THE NEXT TIME THE PACK IS COMPRESSED, UFD'S
;	WILL ACTUALLY BE CREATED IN SEQUENTIAL ORDER.
;
;	THE "PIP" RE-NAME FUNCTION, FOR RE-NAMING EXISTING FILES,
;	CHANGES THE ENTRY IN A UFD, BUT DOES NOT CHANGE THE NAME
;	IN THE FILE HEADER IN THE INDEX FILE.  (IN OTHER WORDS, THE
;	NAME IN THE INDEX FILE AND THE NAME IN THE UFD DO NOT AGREE).
;	"DDSC" CREATES ALL FILES ON THE OBJECT PACK WITH NAMES MATCHING
;	THOSE IN EACH UFD, NOT THOSE IN THE SOURCE PACK INDEX FILE.
;
;	ALL FILES ON THE SOURCE PACK THAT CAN BE READ WILL BE COPIED
;	TO THE OBJECT PACK.  THOSE THAT CANNOT BE READ INCLUDE:
;
;		(1) FILES THAT ARE ACCESSED FOR WRITE
;		(2) FILES THAT ARE LOCKED
;		(3) "LOST" FILES, NOT INCLUDED IN ANY DIRECTORY
;		(4) FILES THAT DO NOT HAVE "READ" PRIVILEGES FOR THE SYSTEM.
;
;	IF A FILE ON THE SOURCE PACK HAS MORE THAN ONE ENTRY IN ANY
;	DIRECTORY (PRIMARILY FROM A "SYNONYM" ENTRY), SEPARATE NEW
;	FILES WILL BE CREATED ON THE OBJECT PACK.  THE NAMES WILL
;	NO LONGER BE SYNONOMOUS.
;
;	THE USER HAS THE OPTION OF RETAINING THE CREATION DATES OF
;	THE FILES ON THE SOURCE PACK, OR OF LETTING ALL FILES SHOW
;	THE CURRENT DATE AS THEIR CREATION DATE.  IN EITHER EVENT
;	THE LATEST REVISION DATE WILL BE CLEARED.  THE AUTHOR'S
;	PREFERENCE IS TO ALWAYS RETAIN THE ORIGINAL CREATION DATE
;	FOR EVERY FILE.  (OF COURSE, THIS MEANS THAT THE CREATION
;	DATES WILL PRECEED THE CREATION DATE OF THE PACK).
;
;	AS OPPOSED TO DISK COPY ROUTINES, "DDSC" RECOGNIZES BAD
;	BLOCKS ON THE OBJECT PACK, AND HANDLES THEM PROPERLY.
;
;	ANY PROBLEMS IN READING THE SOURCE PACK OR WRITING THE OBJECT
;	PACK ARE NOTED BY THE TASK, WHETHER OR NOT PERIODIC REPORTS
;	HAVE BEEN REQUESTED.  THE PERIODIC REPORTS ARE PRIMARILY
;	FOR "REASSURANCE" OF THE OPERATOR, SHOWING WHEN EACH NEW
;	UFD IS STARTED, AND THE NUMBER OF FILES AND BLOCKS IN EACH
;	UFD.
;
;	IF THE TASK CANNOT HANDLE ALL OF THE OPERATIONS UP UNTIL ALL OF
;	THE UFD'S HAVE BEEN CREATED, IT WILL STOP.  ONCE THE ACTUAL FILE
;	COPYING BEGINS, THE TASK WILL PROCEED -- SKIPPING ANY FILES IT
;	CANNOT OPEN, OR ANY BLOCKS IT CANNOT COPY,-- BUT PROVIDING ERROR
;	MESSAGES
;
;	PC VALUES IN ANY ERROR MESSAGES REFER TO OFFSETS FROM THE
;	START OF THE UNNAMED PSECT, AND PERMIT REFERENCE TO THE TASK
;	LISTING TO SEE JUST WHAT CAUSED THE ERROR.
;
	.PAGE
	.MCALL	ALUN$S, DIR$, SPWN$, OPEN$M, DELET$
	.MCALL	FSRSZ$, FDBDF$, FDRC$A, FDBK$A, FDOP$A
	.MCALL	OPEN$R, OPEN$W, CLOSE$, EXIT$S, FDOF$L, NBOF$L
	.MCALL	OFNB$W, OFNB$R, QIOW$S, READ$, WRITE$, WAIT$
	.MCALL	HMBOF$, FHDOF$, DEF$L, FDAT$A
	.MCALL	ASTX$S, WTSE$S, OPNT$D
	.MCALL	FDBK$R
;
; DEFINE SYMBOLS LOCALLY
	FDOF$L
	NBOF$L
	HMBOF$
	FHDOF$
	DEF$L
;
;  PSECT $$FSRZ1
	FSRSZ$	0	; BLOCK I/O WILL BE USED
;
	.PSECT	$DATA
CR=15
TAB=11
LF=12
YES=131
;
;TASK SWITCHES
LOC:	.BLKB	1
RPT:	.BLKB	1
FULL:	.BLKB	1
DATES:	.BLKB	1
INIT:	.BLKB	1
ANS:	.BLKB	1
BAD:	.BLKB	1
SORT:	.BLKB	1
;
;
;
; FDB FOR ALL SOURCE FILES
SFIL:	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	,512.,,32.,IOST
	FDOP$A	2,DESC,,FO.RD!FA.SHR
;
; FDB FOR ALL OBJECT FILES
OFIL:	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	,512.,,31.,IOSTO
	FDOP$A	3,DESC,,FO.WRT
;
; FDB FOR TEMPORARY FILE
TFIL:	FDBDF$
	FDAT$A	R.FIX,,512.,-47000
	FDRC$A	FD.RWM
	FDBK$A	BUFFO,512.,,32.,IOST
	FDOP$A	4,DUMMY
;
IOST:	.BLKW	2	; I/O STATUS BLOCK
IOSTO:	.BLKW	2	; I/O STATUS BLOCK, OBJECT
IBUFFS:	.BLKW	256.	; BUFFER FOR SOURCE INDEX FILE
IBUFFO:	.BLKW	256.	; BUFFER OF OBJECT INDEX FILE
BUFFO:	.BLKW	BUFBLK*256.	; SOURCE DATA BUFFER
BUFFS:	.BLKW	256.	; OBJECT DATA BUFFER
UFDID:	.BLKW	BUFBLK*128.	; ARRAY FOR 256 DIRECTORY FILE ID'S
UFDPT:	.WORD	UFDID		; POINTER FOR UFDID ARRAY
DESC:	.WORD	4,SDRIVE
	.WORD	5,UIC
	.WORD	12.,MSTDIR
DUMMY:	.WORD	4,ODRIVE
	.WORD	5,UIC
	.WORD	11.,DUMNAM
;
WORK:	.BLKB	3
	.BYTE	'E
TWO:	.WORD	2
THREE:	.WORD	3
ISSW:	.WORD	1	; SWITCH FOR SOURCE DISK INDEX FILE HEADER
IOSW:	.WORD	1	; SWITCH FOR OBJECT DISK INDEX FILE HEADER
FILES:	.WORD	0
SBLOK:	.BLKW	1
BLOCKS:	.WORD	0
TOTFIL:	.WORD	0
TOTBLK:	.WORD	0
SNUM:	.BLKW
ONUM:	.BLKW
SADR:	.BLKW	2
OADR:	.BLKW	2
BLKCT:	.BLKW
ERRBLK:	.BLKW
HOLD:	.BLKW	8.
;
UIC:	.ASCII	/[0,0]/
MSTDIR:	.ASCII	/000000.DIR;1/
DUMNAM:	.ASCII	/DUMMY.TMP;1/
;
M10:	.ASCII	<15><12><12><12>\ENTER SOURCE DRIVE, E.G. DP1: <CR>   \
M10L=.-M10
M20:	.ASCII	<CR><LF>\ENTER OBJECT DRIVE <CR>   \
M20L=.-M20
M30:	.ASCII	<CR><LF><LF>\HAS OBJECT PACK BEEN FRESHLY INITIALIZED?\
	.ASCII	\ [Y/N]   \
M30L=.-M30
M40:	.ASCII	<CR><LF>\DO YOU WANT TO INITIALIZE ON LINE? [Y/N]   \
M40L=.-M40
M50:	.ASCII	<CR><LF>\DO YOU WANT TO CHECK FOR BAD BLOCKS? [Y/N]   \
M50L=.-M50
M60:	.ASCII	<CR><LF>\ENTER LABEL (UP TO 12 CONTIGUOUS ALPHA\
	.ASCII	\NUMERIC CHAR) <CR>   \
M60L=.-M60
M65:	.ASCII	<CR><LF>\THE VALUE FOR THE INITIAL SIZE OF THE INDEX FILE\
	.ASCII	<CR><LF>\DEFAULTS TO THE NUMBER OF FILES NOW ON THE SOURCE\
	.ASCII	<CR><LF>\PACK + 12%.  THE VALUE WILL BE \
CURFIL:	.ASCII	\      \
	.ASCII	<CR><LF>\DO YOU WANT TO SPECIFY A LARGER VALUE? [Y/N]   \
M65L=.-M65
M70:	.ASCII	<CR><LF>\ENTER DECIMAL NUMBER <CR>   \
M70L=.-M70
M71:	.ASCII	<CR><LF>\USE FILE EXTENSION SIZE OF 3? [Y/N]   \
M71L=.-M71
M72:	.ASCII	<CR><LF>\ENTER FILE EXTENSION SIZE <CR>   \
M72L=.-M72
M73:	.ASCII	<CR><LF>\USE LRU OF 3? [Y/N]   \
M73L=.-M73
M74:	.ASCII	<CR><LF>\ENTER LRU VALUE <CR>   \
M74L=.-M74
M75:	.ASCII	<CR><LF>\USE WIN OF 7? [Y/N]   \
M75L=.-M75
M76:	.ASCII	<CR><LF>\ENTER WIN VALUE <CR>   \
M76L=.-M76
M90:	.ASCII	<CR><LF>\UFD DIRECTORY FILES MAY BE CREATED JUST LARGE\
	.ASCII	<CR><LF><TAB>\ENOUGH TO HOLD THEIR CURRENT FILES, OR THEY\
	.ASCII	<CR><LF><TAB>\MAY HOLD AS MANY FILES AS THEY HAVE EVER HELD.\
	.ASCII	<CR><LF><TAB>\DO YOU WANT THE MINIMUM SIZE? [Y/N]   \
M90L=.-M90
M100:	.ASCII	<CR><LF>\CREATE UFD'S IN NUMERIC SEQUENCE? [Y/N]   \
M100L=.-M100
M110:	.ASCII	<CR><LF>\KEEP ORIGINAL CREATION DATES ON FILES? \
	.ASCII	\[Y/N]  \
M110L=.-M110
M120:	.ASCII	<CR><LF>\ISSUE PROGRESS REPORTS AT THE END OF EACH\
	.ASCII	\ UFD? [Y/N]   \
M120L=.-M120
M123:	.ASCII	<CR><LF>\STARTING CHECK FOR BAD BLOCKS.  BE PATIENT!!\<CR><LF>
M123L=.-M123
M130:	.ASCII	<CR><LF><LF>\STOP. DRIVE ASSIGNMENT FAILURE.\
M130L=.-M130
M140:	.ASCII	<CR><LF><LF>\NEXT REPORT WILL BE AFTER UFD'S ARE\
	.ASCII	\ CREATED\<CR><LF>
M140L=.-M140
M150:	.ASCII	<CR><LF>\YOU WILL COPY \
	.EVEN
SDRIVE:	.BLKB	4
	.ASCII	\ ONTO \
ODRIVE:	.BLKB	4
	.ASCII	\. CORRECT? [Y/N]   \
M150L=.-M150
M151:	.ASCII	<7><CR><LF><LF>\ALL DATA ON \
	.EVEN
M151A:	.BLKB	4
	.ASCII	\ IS ABOUT TO BE DESTROYED.  OK? [Y/N]  \<7><0><7>
M151L=.-M151
M160:	.ASCII	<CR><LF><LF>\*** FATAL ***\
M160L=.-M160
M170:	.ASCII	<CR><LF><LF>\ERROR \
M170A:	.BLKB	4
	.ASCII	\ AT PC \
M170B:	.BLKB	5
	.BYTE	CR,LF
M170L=.-M170
M180:	.ASCII	<CR><LF><TAB>
	.BLKB	5
	.ASCII	\. BLOCKS IN\
M180A:	.BLKB	5
	.ASCII	\. FILES\
M180L=.-M180
M200:	.ASCII	\SOURCE FILE DID NOT OPEN\<CR><LF>
M200L=.-M200
M210:	.ASCII	\OBJECT FILE DID NOT OPEN\<CR><LF>
M210L=.-M210
M220:	.ASCII	\SOURCE FILE READ FAILURE\<CR><LF>
M220L=.-M220
M221:	.ASCII	\OBJECT FILE WRITE FAILURE\<CR><LF>
M221L=.-M221
M230:	.ASCII	\DATA NOT UPDATED IN FILE HEADER\<CR><LF>
M230L=.-M230
M240:	.ASCII	<CR><LF><LF>\COMPRESSION FINISHED\<CR><LF><LF>
M240L=.-M240
M250:	.ASCII	<CR><LF>\BLOCK #\
	.EVEN
M250A:	.BYTE	4
	.ASCII	<CR><LF>
M250L=.-M250
	.EVEN
M260:	.BYTE	CR,LF
	.ASCII	\                                \
	.EVEN
;
DMO:	SPWN$	...DMO,,,,,19.,,,DMOCL,8.
DMOCL:	.ASCII	/DMO /
	.BLKB	4
	.EVEN
INSBAD:	SPWN$	...INS,,,,,19.,,,INBDCL,13.
INBDCL:	.ASCII	/INS [11,1]BAD/
	.EVEN
CHKBAD:	SPWN$	...BAD,,,,,19.,,,BADCL,8.
BADCL:	.ASCII	/BAD /
	.BLKB	4
	.EVEN
INSINI:	SPWN$	...INS,,,,,19.,,,INICL,13.
INICL:	.ASCII	/INS [11,1]INI/
	.EVEN
OBINI:	SPWN$	...INI,,,,,19.,,,OBINCL,OBINCT
INIMSG:	.ASCII	<CR><LF>
OBINCL:	.ASCII	/INI /
	.BLKB	4
LABEL:	.ASCII	\A           \
	.ASCII	\/CHA=[DCF]/BAD=[AUTO]/INF=\
COUNT:	.ASCII	\      /EXT=\
EXT:	.ASCII	\3  /LRU=\
LRU:	.ASCII	\3  /WIN=\
WIN:	.ASCII	\7  \
OBINCT=.-OBINCL
	.ASCII	<CR><LF>
INIL=.-INIMSG
	.EVEN
MOU:	SPWN$	...MOU,,,,,19.,,,MOUCL,MOUCT
MOUCL:	.ASCII	/MOU /
	.BLKB	4
	.ASCII	\/OVR/CHA=[DCF]\
MOUCT=.-MOUCL
	.EVEN
	.PAGE
	.PSECT
;
; START OF EXECUTABLE PROGRAM
;
START:
;  REQUEST SOURCE DRIVE
	MOV	#M10,R4		
	MOV	#M10L,R5
	CALL	MESSG
	MOV	#SDRIVE,R2	; READ SOURCE DRIVE
	MOV	#5,R3
	CALL	INPUT
;
; REQUEST OBJECT DRIVE
	MOV	#M20,R4	
	MOV	#M20L,R5
	CALL	MESSG
	MOV	#ODRIVE,R2	; READ OBJECT DRIVE
	MOV	#5,R3
	CALL	INPUT
;
; VERIFY DRIVES
	MOV	#M150,R4	
	MOV	#M150L,R5
	CALL	MESSG
	MOV	#ANS,R2
	MOV	#1,R3
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	10$
;
; PRINT WARNING MESSAGE !!
	MOV	ODRIVE,M151A
	MOV	ODRIVE+2,M151A+2
	MOV	#M151,R4
	MOV	#M151L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BEQ	12$
;
; EXIT ON A BAD ENTRY
10$:
	MOV	#M130,R4
	MOV	#8.,R5
	CALL	MESSG
	EXIT$S
;
; ASSIGN LOGICAL UNITS
; EXIT IF ASSIGNS FAIL
12$:
	MOVB	SDRIVE+2,R0
	SUB	#60,R0
	MOV	SDRIVE,R1
	ALUN$S	#2,R1,R0
	TST	$DSW
	BLT	14$
	MOVB	ODRIVE+2,R0
	SUB	#60,R0
	MOV	ODRIVE,R1
	ALUN$S	#3,R1,R0
	TST	$DSW
	BGT	16$
14$:
	JMP	64$
;
; CHECK ON INITIALIZATION
16$:
	MOV	#M30,R4
	MOV	#M30L,R5
	CALL	MESSG
	MOV	#ANS,R2
	MOV	#1,R3
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	18$
	JMP	50$
;
; IF NOT INITIALIZED, CHECK FOR ON-LINE INITIALIZATION
18$:
	MOV	#M40,R4
	MOV	#M40L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	10$
	INCB	INIT		; SET INITIALIZATION SWITCH
;
; IF PACK IS TO BE INITIALIZED, SEE IF "BAD" IS TO BE RUN
	MOV	#M50,R4
	MOV	#M50L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	20$
	INCB	BAD		; SET BAD BLOCKS SWITCH
;
; GET THE LABEL FOR THE OBJECT PACK
20$:
	MOV	#M60,R4
	MOV	#M60L,R5
	CALL	MESSG
	MOV	#11.,R2	; CLEAR LABEL FIELD
22$:
	MOVB	#' ,LABEL(R2)	
	SOB	R2,22$
	MOV	#LABEL,R2
	MOV	#12.,R3
	CALL	INPUT
;
; CHECK THE LABEL FOR VALIDITY AND RE-REQUEST IF INVALID.
; LABEL MUST NOT CAUSE A SYNTAX ERROR IN INIT COMMAND LINE
	MOV	#12.,R1
24$:
	CMPB	LABEL-1(R1),#40
	BNE	26$
	SOB	R1,24$
26$:
	CMPB	#'Z,LABEL-1(R1)
	BLT	20$
	CMPB	#'A,LABEL-1(R1)
	BLE	28$
	CMPB	#'9,LABEL-1(R1)
	BLT	20$
	CMPB	#'0,LABEL-1(R1)
	BGT	20$
28$:
	SOB	R1,26$
;
;
; GET THE NUMBER OF FILES CURRENTLY IN USE ON THE SOURCE PACK
	CLR	SADR
	MOV	#1,SADR+2
	QIOW$S #IO.RLB,#2,#32.,,#IOST,,<#BUFFO,#512.,#0,SADR,SADR+2>
	TSTB	IOST
	BGT	30$
	JMP	10$
30$:
	MOV	BUFFO+H.IBLB,SADR	; ADR OF INDEX FILE BIT MAP
	MOV	BUFFO+H.IBLB+2,SADR+2
	MOV	BUFFO+H.IBSZ,R0		; BIT MAP SIZE, IN BLOCKS
	CLR	R4		; FILE COUNTER
32$:
	QIOW$S #IO.RLB,#2,#32.,,#IOST,,<#BUFFO,#512.,#0,SADR,SADR+2>
	TSTB	IOST
	BGT	34$
	JMP	10$
34$:
	ADD	#1,SADR+2
	ADC	SADR
	MOV	#512.,R1
36$:
	MOV	BUFFO-2(R1),R2
	MOV	#16.,R3
38$:
	ASL	R2
	BEQ	40$
	ADC	R4
	BR	38$
40$:
	ADC	R4
	DEC	R1
	SOB	R1,36$
	SOB	R0,32$
	MOV	#COUNT,R0
	ASH	#-4,R4	; DIVIDE COUNT BY 8, AND MAKE EVEN NUMBER
	ASL	R4
	MOV	R4,R1
	ASH	#3,R4
	ADD	R4,R1	; TOTAL COUNT IS ORIGINAL COUNT + 12%
	MOV	#24012,R2
	CALL	$CBTA
	MOVB	#'.,(R0)
	MOV	#COUNT,R0	; MOVE COUNT INTO INIT COMMAND LINE
	MOV	#CURFIL,R1
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
;
; GET NUMBER OF RECORDS FOR THE INDEX FILE
	MOV	#M65,R4
	MOV	#M65L,R5
	CALL	MESSG
	MOV	#ANS,R2
	MOV	#1,R3
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	42$
	MOV	#M70,R4
	MOV	#M70L,R5
	CALL	MESSG
	MOV	#COUNT,R2
	MOV	#6,R3
	CALL	INPUT
	MOV	#ANS,R2
	MOV	#1,R3
;
; GET FILE EXTENSION SIZE
42$:
	MOV	#M71,R4
	MOV	#M71L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BEQ	44$
	MOV	#M72,R4
	MOV	#M72L,R5
	CALL	MESSG
	MOV	#EXT,R2
	MOV	#3,R3
	CALL	INPUT
;
; GET LRU
44$:
	MOV	#M73,R4
	MOV	#M73L,R5
	CALL	MESSG
	MOV	#ANS,R2
	MOV	#1,R3
	CALL	INPUT
	CMPB	#YES,(R2)
	BEQ	46$
	MOV	#M74,R4
	MOV	#M74L,R5
	CALL	MESSG
	MOV	#LRU,R2
	MOV	#3,R3
	CALL	INPUT
;
; GET WIN
46$:
	MOV	#M75,R4
	MOV	#M75L,R5
	CALL	MESSG
	MOV	#ANS,R2
	MOV	#1,R3
	CALL	INPUT
	CMPB	#YES,(R2)
	BEQ	50$
	MOV	#M76,R4
	MOV	#M76L,R5
	CALL	MESSG
	MOV	#WIN,R2
	MOV	#3,R3
	CALL	INPUT
	MOV	#ANS,R2
	MOV	#1,R3
	BR	50$
;
; CHECK ON SIZE OF UFD FILES
50$:
	MOV	#M90,R4
	MOV	#M90L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	52$
	INCB	FULL		; SET SWITCH FOR FULL UFD SIZE
;
; SEE IF UFD'S ARE TO BE CREATED IN NUMERIC ORDER
52$:
	MOV	#M100,R4	; SORT UFD'S?
	MOV	#M100L,R5
	CALL	MESSG
	MOV	#ANS,R2
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	54$
	INCB	SORT		; SET SWITCH FOR SORTING
;
;  CHECK ON RETAINING ORIGINAL FILE DATES
54$:
	MOV	#M110,R4
	MOV	#M110L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	56$
	INCB	DATES		; SET DATE SWITCH
;
; CHECK ON PROGRESS REPORTS
56$:
	MOV	#M120,R4
	MOV	#M120L,R5
	CALL	MESSG
	CALL	INPUT
	CMPB	#YES,(R2)
	BNE	58$
	INCB	RPT		; SET REPORT SWITCH
;
; DISMOUNT OBJECT DRIVE REGARDLESS.
; MUST BE DISMOUNTED FOR "BAD" AND "INIT", AND IF THESE ARE NOT
; DONE IT MUST BE MOUNTED [DCF] IN CASE PACK WAS NOT INITIALIZED
; THAT WAY.
58$:
	MOV	ODRIVE,DMOCL+4
	MOV	ODRIVE+2,DMOCL+6
	DIR$	#DMO
	WTSE$S	#19.		; WAIT FOR COMPLETION
;
; SEE IF BAD SHOULD BE RUN
	TSTB	BAD
	BEQ	60$
	DIR$	#INSBAD		; INSTALL BAD
	WTSE$S	#19.
	MOV	ODRIVE,BADCL+4
	MOV	ODRIVE+2,BADCL+6
	MOV	#M123,R4
	MOV	#M123L,R5
	CALL	MESSG
	DIR$	#CHKBAD
	TST	$DSW
	BLT	64$
	WTSE$S	#19.
;
; INITIALIZE THE PACK IF THIS WAS REQUESTED
60$:
	TSTB	INIT
	BEQ	62$
	DIR$	#INSINI		; INSTALL INIT
	WTSE$S	#19.
	MOV	ODRIVE,OBINCL+4
	MOV	ODRIVE+2,OBINCL+6
	MOV	#INIMSG,R4
	MOV	#INIL,R5
	CALL	MESSG
	DIR$	#OBINI		; AND INITIALIZE
	TST	$DSW
	BLT	64$
	WTSE$S	#19.
	INCB	LOC		; SET SW FOR TEMP FILE
;
; REMOUNT THE PACK [DCF]
62$:
	MOV	ODRIVE,MOUCL+4
	MOV	ODRIVE+2,MOUCL+6
	DIR$	#MOU
	TST	$DSW
	BLT	64$
	WTSE$S	#19.
	BR	66$
64$:
	MOV	#M130,R4
	MOV	#M130L,R5
	CALL	MESSG
	EXIT$S
66$:
	MOV	#M140,R4
	MOV	#M140L,R5
	CALL	MESSG
;
; CHECK LOCATION OF INDEX FILE ON OBJECT PACK
; FOR POSSIBLE CREATION OF DUMMY FILE
	CLR	SADR
	MOV	#1,SADR+2
	QIOW$S	#IO.RLB,#3,#3,,#IOST,,<#BUFFO,#512.,#0,SADR,SADR+2>
	TSTB	IOST
	BLE	67$
	MOV	BUFFO+H.IBLB+2,R1
	SUB	#10.,R1
	BLE	67$
	NEG	R1
	MOV	R1,TFIL+F.CNTG
	INCB	LOC		; SET SWITCH FOR DUMMY FILE
;
; OPEN AND CLOSE THE MFD ON THE SOURCE PACK TO FILL IN THE FDB
67$:
	OPEN$R	#SFIL
	BCC	68$
	CALL	FATALV		; ABORT ON ERROR
68$:
	CLOSE$	#SFIL
	MOV	#ODRIVE,DESC+2
;
; OPEN AND CLOSE THE MFD ON THE OBJECT PACK TO FILL IN THE FDB
	OPEN$R	#OFIL
	BCC	70$
	CALL	FATALV
70$:
	CLOSE$	#OFIL
;
; CREATE TEMPORARY FILE IF INDEX FILE IS IN MIDDLE OF PACK.
; THIS PUTS THE DIRECTORY FILES ADJACENT TO THE INDEX FILE INSTEAD
; OF AT THE START OF THE PACK.
	CMPB	#1,LOC
	BNE	74$
	OPEN$W	#TFIL		; OPEN TEMPORARY FILE
	BCC	72$
	CALL	FATALL
72$:
	DELET$	#TFIL
;
; THE TWO FDB'S CONTAIN THE UIC ID'S FOR [0,0].  THESE WILL
; REMAIN UNTIL ALL DIRECTORIES HAVE BEEN CREATED.
;
; NOW READ ALL OF THE DIRECTORY ENTRIES IN THE MFD OF THE SOURCE
; PACK AND CREATE DIRECTORIES ON THE OBJECT PACK.  
;
74$:
	CLR	SFIL+F.FNB+N.NEXT	; CONTEXT WORD FOR .FIND
	MOV	#352,SFIL+F.FNB+N.STAT	; '*' NAME AND VERSION
	MOV	#UFDID,R4	; INDEX FOR FILE ID ARRAY
LOOP:
	MOV	#SFIL,R0	; ARG FOR .FIND
	MOV	#<SFIL+F.FNB>,R1
	CALL	.FIND	; LOOK FOR NEXT ENTRY IN SOURCE MFD
	BCC	76$
	JMP	SETDON
; UIC [0,0] ALREADY EXISTS ON OBJECT DRIVE.  SKIP IT.
76$:
	CMP	#140116,SFIL+F.FNB+N.FNAM	; "000" IN R50
	BNE	78$
	CMP	#140116,SFIL+F.FNB+N.FNAM+2
	BEQ	LOOP
;
; WHEN A DIRECTORY IS FOUND, OPEN THE FILES FOR IT
; CREATING IT ON OBJECT PACK.
78$:
; MOVE FILE ID ONTO INTERNAL UIC LIST
	MOV	SFIL+F.FNB+N.FID,(R4)+
	MOV	SFIL+F.FNB+N.FID+2,(R4)+
	MOV	-4(R4),SNUM
; OPEN SOURCE DIRECTORY FILE BY FILE NAME BLOCK
	OFNB$R	#SFIL
	BCC	80$
	CALL	FATALV
;
; SET UP FDB ON OBJECT PACK
80$:
	MOV	#<SFIL+F.FNB+N.FNAM>,R1
	MOV	#<OFIL+F.FNB+N.FNAM>,R2
	MOV	(R1)+,(R2)+	; NAME
	MOV	(R1)+,(R2)+
	MOV	(R1)+,(R2)+
	MOV	(R1)+,(R2)+	; TYPE
	MOV	(R1)+,(R2)+	; VERSION
	MOV	SFIL,OFIL	; F.RTYP AND F.RATT
	MOV	SFIL+2,OFIL+2	; F.RSIZ
;
; CHECK NUMBER OF BLOCKS TO ALLOCATE TO UFD INITIALLY
	MOV	SFIL+F.EFBK+2,OFIL+F.CNTG
	CMPB	#1,FULL
	BNE	82$
	MOV	SFIL+F.HIBK+2,OFIL+F.CNTG	; BLOCKS TO ALLOCATE
82$:
	MOV	OFIL+F.EFBK+2,R3
	DEC	R3
	OFNB$W	#OFIL
	BCC	84$
	CALL	FATALV
84$:
	CLOSE$	#SFIL
;
; WRITE BLANK RECORDS TO THE OBJECT PACK DIRECTORY
	TST	R3
	BLE	90$
	MOV	#1,OFIL+F.BKVB+2
86$:
	WRITE$	#OFIL,#<BUFFO+512.>	; FILL DIRECTORIES WITH 0'S
	WAIT$	#OFIL	; TO AVOID ANY CONFLICT WITH
	TSTB	IOSTO	; ANY RESIDUAL DATA
	BGT	88$
	CALL	FATALL
88$:
	SOB	R3,86$
;
; SAVE THE TWO-WORD FILE ID'S OF THE SOURCE AND OBJECT DIRECTORY
; FILES IN AN INTERNAL 4X ARRAY, INDEXED BY R4.
90$:
	MOV	OFIL+F.FNB+N.FID,(R4)+
	MOV	OFIL+F.FNB+N.FID+2,(R4)+
	MOV	-4(R4),ONUM
	CLOSE$	#OFIL
	CALL	HEDUPD
	JMP	LOOP
;
;
;
;
;
SETDON:
	CLOSE$	#SFIL
;
; WHEN ALL DIRECTORIES HAVE BEEN CREATED, CLOSE THE TEMPORARY FILE.
; THIS FREES UP ALL THE SPACE ON THE FIRST HALF OF THE DISK.
	DELET$	#TFIL
;
; SORT UICS IF REQUESTED
	TSTB	SORT
	BEQ	LOOP2
; SORT ROUTINE
; OPEN MFD ON OBJECT PACK AND READ IN DATA BLOCKS
	OPEN$M	#OFIL
	BCC	92$
	CALL	ERRORE
	JMP	LOOP2
92$:
	MOV	OFIL+F.EFBK+2,R2
	MOV	#BUFFO,R1
94$:
	READ$	#OFIL,R1
	WAIT$	#OFIL
	ADD	#512.,R1
	SOB	R2,94$
	MOV	#<BUFFO+80.>,R0
96$:
	CMP	12.(R0),#15172	; CHECK FOR .DIR ENTRY
	BEQ	98$
	ADD	#16.,R0
	BR	96$
98$:
	SUB	#<BUFFO+80.>,R0
	MOV	R0,R1
	MOV	R0,R2
	ADD	#16.,R2
99$:
	CMP	BUFFO+86.(R1),BUFFO+86.(R2)
	BLO	102$
	BHI	100$
	CMP	BUFFO+88.(R1),BUFFO+88.(R2)
	BLO	102$
; IF COMPARISON IS GREATER, UFD REFERENCED BY R2 IS LOWER
100$:
	MOV	R2,R1
102$:
	ADD	#16.,R2
	TST	BUFFO+80.(R2)	; END OF UFD'S?
	BNE	99$
	CMP	R0,R1
	BEQ	108$
;
; SWAP FILE ENTRIES -- MOVING LOWEST UIC REMAINING TO ITS OWN SPOT
	MOV	R0,R3
	ADD	#<BUFFO+80.>,R3
	MOV	#HOLD,R2
	MOV	R1,R4
	ADD	#<BUFFO+80.>,R4
	MOV	#8.,R5
104$:
	MOV	(R3),(R2)
	MOV	(R4),(R3)+
	MOV	(R2)+,(R4)+
	SOB	R5,104$
;
; SWAP ENTRIES IN THE UFD LIST
	ASR	R1	; NEXT ARRAY IS 4 WDS WIDE, NOT 8
	ADD	#UFDID,R1
	MOV	R0,R3
	ASR	R3
	ADD	#UFDID,R3
	MOV	#HOLD,R2
	MOV	#4,R5
106$:
	MOV	(R3),(R2)
	MOV	(R1),(R3)+
	MOV	(R2)+,(R1)+
	SOB	R5,106$
;
; CHECK FOR END OF SORT
108$:
	ADD	#16.,R0
	MOV	R0,R1
	MOV	R0,R2
	ADD	#16.,R2
	TST	BUFFO+80.(R2)
	BNE	99$
; WRITE BLOCKS OF MFD FROM BUFFO BACK INTO THE MFD
	MOV	OFIL+F.EFBK+2,R2
	MOV	#BUFFO,R1
	MOV	#1,OFIL+F.BKVB+2
110$:
	WRITE$	#OFIL,R1
	WAIT$	#OFIL
	ADD	#512.,R1
	SOB	R2,110$
;
;
;
;
;
; NOW BEGIN TO COPY FILES.
LOOP2:					; START ON A NEW DIRECTORY
	CLOSE$	#OFIL
	MOV	UFDPT,R2
	TST	(R2)	; ANY LEFT TO DO?
	BNE	112$
	JMP	ALLDON
;
; READ THE FILE HEADER FOR THE SOURCE DIRECTORY, IN ORDER TO GET ITS
; NAME.  THIS WILL BE PRINTED IF PERIODIC REPORTS HAVE BEEN REQUESTED.
; OTHERWISE IT WILL BE USED ONLY IN ANY ERROR MESSAGES.
112$:
	MOV	#1,ISSW
	MOV	#ISSW,-(SP)		; PUSH ARGS FOR HEDFND
	MOV	#IOST,-(SP)
	MOV	#SADR,-(SP)
	MOV	R2,-(SP)
	MOV	#IBUFFS,-(SP)
	MOV	#TWO,-(SP)
	MOV	#6,-(SP)
	MOV	SP,R5
	CALL	HEDBLK	; GET LOGICAL BLK # FOR DIRECTORY FILE HEADER
	TST	IOST
	BGE	114$
	CALL	FATALL
114$:
  QIOW$S  #IO.RLB,#2,#32.,,#IOST,,<#BUFFS,#512.,#0,SADR,SADR+2>
	CLR	ISSW
	ADD	#14.,SP
	MOV	BUFFS+I.FNAM+S.HDHD,R1	; CONVERT DIRECTORY NAME TO A1
	MOV	#<M260+2>,R0
	MOVB	#'[,(R0)+
	CALL	$C5TA
	MOVB	#',,(R0)+
	MOV	BUFFS+I.FNAM+2+S.HDHD,R1
	CALL	$C5TA
	MOVB	#'],(R0)+
	CMPB	#1,RPT		; IF REPORTS HAVE BEEN REQUESTED,
	BNE	116$		; PRINT DIRECTORY NAME
	MOVB	#' ,M260+12.
	MOVB	#' ,M260+13.
	MOV	#<M260+14.>,-(SP)
	MOV	#1,-(SP)
	MOV	SP,R5
	CALL	TIME
	MOVB	#' ,M260+22.
	MOVB	#' ,M260+23.
	ADD	#4,SP
	QIOW$S	#IO.WAL,#1,#1,,,,<#M260,#24.>
;
; MOVE DIRECTORY FILE ID'S FROM BOTH DRIVES INTO FDB'S.  THIS
; ENABLES A SEARCH OF THE SOURCE DIRECTORY AND ENTRY OF THE
; FILE INTO THE OBJECT DIRECTORY.
116$:
	MOV	UFDPT,R4
	MOV	(R4)+,SFIL+F.FNB+N.DID	; SOURCE ID
	MOV	(R4)+,SFIL+F.FNB+N.DID+2
	MOV	(R4)+,OFIL+F.FNB+N.DID	; OBJECT ID
	MOV	(R4)+,OFIL+F.FNB+N.DID+2
	MOV	R4,UFDPT
	MOV	#370,SFIL+F.FNB+N.STAT	; FULL WILD CARD SEARCH
	CLR	SFIL+F.FNB+N.NEXT
;
; THIS FINAL LOOP IS THRU ALL THE FILES LISTED IN THE SOURCE
; DIRECTORY.  IF THERE IS A FAILURE OF ANY TYPE HERE, THE FILE
; ON WHICH THE FAILURE OCCURRED WILL BE NOTED, BUT THE TASK
; WILL CONTINUE.
LOOP2A:
	MOV	#SFIL,R0
	MOV	#<SFIL+F.FNB>,R1
	CALL	.FIND	; FIND NEXT FILE IN DIRECTORY
	BCC	118$
	JMP	UICDON
118$:
	OFNB$R	#SFIL
	BCC	120$
	CALL	ERRORE
	QIOW$S	#IO.WAL,#1,#1,,,,<#M200,#M200L>
	BR	LOOP2A
; MOVE REQUIRED DATA FROM SOURCE FILE FDB TO OBJECT FILE FDB
120$:
	MOV	#<SFIL+F.FNB+N.FNAM>,R1
	MOV	#<OFIL+F.FNB+N.FNAM>,R2
	MOV	(R1)+,(R2)+	; NAME
	MOV	(R1)+,(R2)+
	MOV	(R1)+,(R2)+
	MOV	(R1)+,(R2)+	; TYPE
	MOV	(R1)+,(R2)+	; VERSION
	MOV	SFIL,OFIL	; F.RTYP AND F.RATT
	MOV	SFIL+F.RSIZ,OFIL+F.RSIZ	; F.RSIZ
	MOV	SFIL+F.FFBY,OFIL+F.FFBY	; F.FFBY
;
; DETERMINE BLOCKS TO BE ALLOCATED
; ALWAYS ALLOCATED THE SMALLER NUMBER OF THE BLOCKS ALLOCATED ON THE
; SOURCE PACK, OR THE END-OF-FILE BLOCK
	MOV	SFIL+F.HIBK+2,R1
	MOV	SFIL+F.EFBK+2,R2
	MOV	R1,OFIL+F.HIBK+2
	MOV	R2,OFIL+F.EFBK+2
	CMP	R2,R1
	BLT	122$
	MOV	R1,R2
122$:
	MOV	R2,OFIL+F.CNTG	; ALLOCATE CONTIGUOUS BLOCKS
	OFNB$W	#OFIL
	BCC	124$
	CALL	ERRORE
	QIOW$S	#IO.WAL,#1,#1,,,,<#M210,#M210L>
	CLOSE$	#SFIL
	BR	LOOP2A
;
; INCREMENT COUNT OF FILES IN THIS UFD
124$:
	INC	FILES
	MOV	R2,R3
	MOV	SFIL+F.FNB+N.FID,SNUM	; SAVE ID OF SOURCE FILE
	MOV	OFIL+F.FNB+N.FID,ONUM	; SAVE ID OF OBJECT FILE
	TST	R3	; ANY BLOCKS TO DO?
	BGT	123$	; IF NOT, GO TO NEXT FILE
	JMP	136$
123$:
	MOV	R3,BLKCT	; NUMBER OF BLOCKS TO COPY
	ADD	R3,BLOCKS
	MOV	#1,SBLOK	; STARTING BLOCK NUMBER
	MOV	#BUFBLK,R3	; COPY MAX BLOCKS AT EACH READ
125$:
	MOV	BLKCT,R2
	CMP	R3,R2	; NUMBER OF BLOCKS TO READ AT A TIME
	BGE	126$
	MOV	R3,R2
126$:
	ASH	#9.,R2	; MULT BY 512. BYTES/BLOCK
	MOV	#BUFFO,R1
	READ$	#SFIL,R1,R2,,,#IOST
	CMP	IOST,#IE.EOF
	BEQ	136$
	WAIT$	#SFIL
	TSTB	IOST
	BGT	128$
	CMP	#1,R3	; ARE WE READING 1 BLOCK AT A TIME?
	BLT	127$	; IF NOT, SET UP TO DO SO
	CALL	ERRORE
	QIOW$S	#IO.WAL,#1,#1,,,,<#M220,#M220L>
	MOV	SFIL+F.BKVB+2,ERRBLK	; BLOCK WHERE ERROR OCCURRED
	DEC	ERRBLK
	CALL	RECERR
	BR	128$
127$:
	MOV	#1,R3	; READ ONE BLOCK AT A TIME
	MOV	SBLOK,SFIL+F.BKVB+2	; START WHERE LAST BLOCK STARTED
	MOV	SBLOK,OFIL+F.BKVB+2
	BR	125$
128$:
	ASH	#-9.,R2		; GET BLOCKS REQUESTED IN READ
	SUB	R2,BLKCT
	ADD	R2,SBLOK	; START OF NEXT GROUP
	MOV	IOST+2,R2	; BYTE COUNT ACTUALLY READ
	CMP	R2,#512.	; MUST BE AT LEAST 512.
	BGE	129$
	MOV	#512.,R2
129$:
	MOV	#BUFFO,R1
	WRITE$	#OFIL,R1,R2,,,#IOST
	WAIT$	#OFIL
	TSTB	IOST
	BGT	132$
	CALL	ERRORE
	QIOW$S	#IO.WAL,#1,#1,,,,<#M221,#M221L>
	MOV	OFIL+F.BKVB+2,ERRBLK
	DEC	ERRBLK
	CALL	RECERR
132$:
	TST	BLKCT
	BLE	136$
	JMP	125$
;
; WHEN FILE IS COPIED, CLOSE BOTH FILES
136$:
	CLOSE$	#SFIL
	CLOSE$	#OFIL
	FDBK$R	#SFIL,,#512.
	FDBK$R	#OFIL,,#512.
	CALL	HEDUPD
;
; THIS COMPLETES DATA FOR ONE FILE IN A DIRECTORY.  CONTINUE
; LOOP THRU ALL FILES IN THE DIRECTORY.
	JMP	LOOP2A
UICDON:
	TSTB	RPT
	BEQ	154$
	MOV	#<M180+2>,R0
	MOV	BLOCKS,R1
	MOV	#27012,R2
	CALL	$CBTA
	MOV	#M180A,R0
	MOV	FILES,R1
	MOV	#23012,R2
	CALL	$CBTA
	QIOW$S	#IO.WAL,#1,#1,,,,<#M180,#M180L>
	CLR	BLOCKS
	CLR	FILES
154$:
	JMP	LOOP2
;
; WHEN ALL DIRECTORIES ARE DONE, WE'RE THROUGH
ALLDON:
	MOV	#M240,R4
	MOV	#M240L,R5
	CALL	MESSG
	EXIT$S
;
;
; AST SERVICE ROUTINES FOR I/O COMPLETION DURING FILE COPYING
; AST ENTRY POINT WHEN OBJECT FILE BLOCK IS WRITTEN
CHKO:
	MOV	R0,-(SP)
	MOV	2(SP),R0
	TST	(R0)
	BGE	10$
	MOV	R5,-(SP)
	MOV	OFIL+F.BKVB+2,R5
	DEC	R5
	CALL	ERROR
	MOV	(SP)+,R5
10$:
	MOV	(SP)+,R0
	TST	(SP)+
	ASTX$S
;
;
;*******************************************
;	INTERNAL SUBROUTINES
;*******************************************
;
;
HEDUPD:
; NOW NEED TO MOVE SOME DATA FROM THE SOURCE HEADER TO THE
; OBJECT HEADER.
; GET THE FILE HEADER LOCATION FOR THE SOURCE FILE
	CLR	-(SP)
	MOV	#IOST,-(SP)
	MOV	#SADR,-(SP)
	MOV	#SNUM,-(SP)
	MOV	#IBUFFS,-(SP)
	MOV	#TWO,-(SP)
	MOV	#6,-(SP)
	MOV	SP,R5
	CALL	HEDBLK
	TSTB	IOST
	BGE	138$
	JMP	150$
;
; READ THE FILE HEADER FOR THE SOURCE FILE
138$:
  QIOW$S  #IO.RLB,#2,#32.,,#IOST,,<#BUFFS,#512.,#0,SADR,SADR+2>
	TSTB	IOST
	BGT	140$
	JMP	150$
;
; FIND THE LOGICAL DISK ADR OF THE OBJECT FILE
; NORMALLY, THE INDEX FILE HEADER WILL BE READ ONLY ONCE.  HOWEVER,
; IF THE INDEX FILE IS EXPANDED DURING THE COMPRESSION, IT MAY NEED
; TO BE READ AGAIN.  THIS IS INDICATED WHEN "HEDBLK" RETURNS A
; -35. ERROR.  
140$:
	MOV	IOSW,12.(SP)
	MOV	#OADR,8.(SP)
	MOV	#ONUM,6(SP)
	MOV	#IBUFFO,4(SP)
	MOV	#THREE,2(SP)
	CALL	HEDBLK
	ADD	#14.,SP
	TSTB	IOST
	BGE	142$
	CMP	#-35.,IOST
	BNE	150$
	TST	IOSW
	BNE	150$
	MOV	#1,IOSW
	BR	140$
;
; READ THE FILE HEADER FOR THE OBJECT FILE
142$:
	CLR	IOSW
  QIOW$S  #IO.RLB,#3,#32.,,#IOST,,<#BUFFO,#512.,#0,OADR,OADR+2>
	TSTB	IOST
	BLT	150$
;
; AS DATA IS MOVED FROM THE SOURCE TO THE OBJECT FILE HEADER,
; THE CHECKSUM OF THE LATTER MUST BE KEPT UPDATED.
144$:
	MOV	#BUFFS,R1
	MOV	#BUFFO,R2
	MOV	R4,-(SP)
	MOV	R2,R4	; USE R4 AS ADR OF CHECKSUM
	ADD	#H.CKSM,R4
;
; MOVE FILE OWNERSHIP
	SUB	H.PROG(R2),(R4)
	ADD	H.PROG(R1),(R4)
	MOV	H.PROG(R1),H.PROG(R2)
;
; MOVE FILE PROTECTION
	SUB	H.FPRO(R2),(R4)
	ADD	H.FPRO(R1),(R4)
	MOV	H.FPRO(R1),H.FPRO(R2)
;
; IF NECESSARY, MOVE EOF BLOCK NUMBER AND NEXT AVAILABLE BYTE
	TST	H.UFAT+F.FFBY(R1)
	BEQ	145$
	SUB	H.UFAT+F.EFBK(R2),(R4)
	SUB	H.UFAT+F.EFBK+2(R2),(R4)
	ADD	H.UFAT+F.EFBK(R1),(R4)
	ADD	H.UFAT+F.EFBK+2(R1),(R4)
	MOV	H.UFAT+F.EFBK(R1),H.UFAT+F.EFBK(R2)
	MOV	H.UFAT+F.EFBK+2(R1),H.UFAT+F.EFBK+2(R2)
	SUB	H.UFAT+F.FFBY(R2),(R4)
	ADD	H.UFAT+F.FFBY(R1),(R4)
	MOV	H.UFAT+F.FFBY(R1),H.UFAT+F.FFBY(R2)
;
; MOVE DATES FROM SOURCE TO OBJECT FILE
145$:
	CMPB	#1,DATES
	BNE	148$
	MOV	#14.,R3		; MOVE 13 WORDS
	ADD	#<S.HDHD+I.RVNO>,R1
	ADD	#<S.HDHD+I.RVNO>,R2
146$:
	SUB	(R2),(R4)
	ADD	(R1),(R4)
	MOV	(R1)+,(R2)+
	SOB	R3,146$
148$:
	MOV	(SP)+,R4
;
; WRITE BACK OBJECT FILE HEADER
  QIOW$S  #IO.WLB,#3,#32.,,#IOST,,<#BUFFO,#512.,#0,OADR,OADR+2>
	TSTB	IOST
	BGT	152$
150$:
	CALL	ERROR
	QIOW$S	#IO.WAL,#1,#1,,,,<#M230,#M230L>
152$:
	RETURN
;
;
INPUT:
	QIOW$S	#IO.RLB,#1,#1,,,,<R2,R3>
	CMPB	#100,(R2)
	BGT	10$
	BICB	#40,(R2)	; CHANGE FIRST BYTE TO UPPER CASE
10$:
	RETURN
MESSG:	QIOW$S	#IO.WAL,#1,#1,,,,<R4,R5>
	RETURN
;
; ERROR SUBROUTINE
; ERROR ENTRY FOR RECORD I/O
FATALV:
	MOVB	F.ERR(R0),IOST
; ERROR ENTRY FOR BLOCK I/O
FATALL:
	QIOW$S	#IO.WAL,#1,#1,,,,<#M160,#M160L>
	CALL	DECODE
	QIOW$S	#IO.WAL,#1,#1,,,,<#M170,#M170L>
	EXIT$S
;
;
; ERROR ENTRY FOR NON-FATAL ERRORS
SAVPC:	.BLKW	1
ERRORE:
	MOV	F.ERR(R0),IOST
ERROR:
	MOV	(SP),SAVPC
	SUB	#6,SAVPC
	CALL	$SAVAL
	CLR	R3
	MOV	#<M260+12.>,R0
;
; CONVERT FILE NAME, TYPE, VERSION TO A1
10$:
	MOV	SFIL+N.FNAM+F.FNB(R3),R1
	CALL	$C5TA
	ADD	#2,R3
	CMP	#6,R3
	BGT	10$
	MOVB	#'.,(R0)+
	MOV	SFIL+N.FNAM+F.FNB(R3),R1
	CALL	$C5TA
	MOVB	#';,(R0)+
	MOV	SFIL+N.FNAM+F.FNB+2(R3),R1
	MOV	#14412,R2
	CALL	$CBTA
	QIOW$S	#IO.WAL,#1,#1,,,,<#M260,#30.>
;
; CONVERT ERROR CODES AND PC ADDRESSES TO A1
DECODE:
	MOVB	IOST,R1
	MOV	#M170A,R0
	MOV	#14412,R2
	CALL	$CBTA
	MOV	SAVPC,R1
	SUB	#START,R1
	MOV	#M170B,R0
	MOV	#24010,R2
	CALL	$CBTA
	QIOW$S	#IO.WAL,#1,#1,,,,<#M170,#M170L>
	RETURN
RECERR:
	CALL	$SAVAL
	MOV	#M250A,R0
	MOV	ERRBLK,R1
	MOV	#14412,R2
	CALL	$CBTA
	QIOW$S	#IO.WAL,#1,#1,,,,<#M250,#M250L>
	RETURN
	.END	START