1!		LAWRENCE UNIVERSITY
		COMPUTER CENTER
		APPLETON, WISCONSIN 54911
		(414) 739-3681, EXT 5564

    PROGRAM NAME, VERSION AND DATE:
	PACK, VERSION 1A, 5-JUN-74
2!  PROGRAM AUTHORSHIP:
	PACK WAS WRITTEN AND DESIGNED BY PAUL KONING OF THE LAWRENCE
	UNIVERSITY COMPUTER CENTER.

    PURPOSE OF PROGRAM:
	PACK IS USED FOR PACKING DISKS, I.E. COPYING THE CONTENTS ON A
3!	BLANK PACK, FILE BY FILE, TO 'CLEAN OUT' THE DIRCTORY AND FILE
	STRUCTURE AND THEREBY OBTAIN FASTER ACCESS.

    LANGUAGE AND OPERATING SYSTEM:
	PACK IS WRITTEN IN BASIC-PLUS, USING PRIVILEGED SYS FUNCTIONS
	AS DEFINED FOR RSTS V4A-12
4!
    AVAILABILITY:
	PACK IS A NON-PROPRIETARY PROGRAM PRODUCT OF LAWRENCE UNIVERSITY
	IT IS DISTRIBUTED AT COST FOR EDUCATIONAL USE, ON THE CONDITION
	THAT IT NOT BE SOLD, RENTED OR LEASED FOR PROFIT.

5!  LIMITATIONS:
	1) PACK CAN ONLY BE RUN WHEN NO OTHER USERS ARE ON THE SYSTEM.
	   PREFERABLY IT SHOULD BE RUN ONLY UNDER 'UNISYSTEM'.
	2) DURING ITS OPERATION, NO DISKS SHOULD BE MOUNTED EXCEPT THE
6!	   SYSTEM DISK AND THE DISKS THAT PACK IS CURRENTLY PACKING.
	   FAILURE TO DO SO WILL RESULT IN A 'DIRTY' DISK.
	3) PACK ASSUMES THAT ALL 'ORIGINAL' DISKS TO PACK WILL BE
7!	   MOUNTED ON ONE DRIVE, AND ALL NEW PACKS ON ANOTHER. THEIR NAMES
	   ARE GIVEN IN LINE 120.
	4) PACK DESTROYS THE ORIGINAL PACK IN THE PROCESS OF PACKING. IT
	   IS THEREFORE NECESSARY TO BACK UP PROPERLY BEFORE STARTING,
8!	   AND TO COPY THE NEWLY PACKED DISK ONTO THE ORIGINAL PACK WITH
	   ROLLIN.

    FURTHER DOCUMENTATION:
	PACK ASSUMES THE DISK ID'S FOR THE DISKS THAT ARE TO BE PACKED
	ARE STORED IN PACK AS DATA STATEMENTS (SEE LINE 100). IT WILL
9!	INSTRUCT THE OPERATOR TO MOUNT THE PROPER DISKS ON THE DRIVES,
	AND WHEN HE INDICATES THEY ARE READY, PACK WILL MOUNT THEM
	AND PERFORM THE PACKING. WHEN FINISHED, PACK WILL DISMOUNT THE
10!	DISKS AND CHECK IF MORE DISKS HAVE TO BE PACKED. IF SO, IT WILL
	REPEAT THE PROCESS FOR THE NEXT DISK. IF NOT, IT WILL PERFORM
	A BOOT FROM THE SYSTEM DISK (DF0:) TO RELLOAD RSTS. THE OPERATOR
11!	SHOULD THEN LOAD ROLLIN TO COPY THE NEWLY CREATED PACKS ONTO
	THE ORIGINALS THAT WERE DESTROYED IN THE PROCESS.

    DISCLAIMER:
	NEITHER THE AUTHOR OF THIS PROGRAM NOR LAWRENCE UNIVERSITY
12!	ASSUME ANY LIABILITY, EXPRESSED OR IMPLIED, WITH RESPECT TO
	THE CORRECTNESS OR PERFORMANCE OF THIS PROGRAM.


100 DATA PACK0,PACK2
110 ! PACK0 AND PACK2 ARE THE STANDARD PACKS AT LAWRENCE
120 D1$="DK0:":D2$="DK2:":U1%=0%:U2%=2%
	! D1$ AND D2$ ARE THE INPUT AND OUTPUT DEVICE NAMES,
	U1% AND U2% ARE THE RESP. UNIT NUMBERS
125 PRINT "PACK V1A [FOR RSTS V4A-12] -- PACKING PROGRAM -- LAWRENCE"
130 ON ERROR GOTO 400:READ X7$:&"MOUNT THE ORIGINAL ";X7$;" ON ";D1$;
	" AND THE BLANK INITIALIZED ";X7$;" ON ";D2$:
	&"HIT RETURN WHEN DONE - ";:OPEN "KB:" FOR INPUT AS FILE 11%:
	INPUT #11%,A$:CLOSE 11%
140 ON ERROR GOTO 210
150 CHANGE SYS(CHR$(6%)+CHR$(-10%)+D1$+X7$) TO M%:M%(1%)=6%
160 M%(2%)=3%:M%(3%)=0%:CHANGE M% TO A$:A$=SYS(A$)
170 M%(3%)=6%:CHANGE M% TO A$:A$=SYS(A$)
180 M%(25%)=U2%:M%(3%)=0%:CHANGE M% TO A$:A$=SYS(A$)
190 M%(3%)=6%:CHANGE M% TO A$:A$=SYS(A$)
200 GOTO 260
210 IF ERR=14% THEN &"PLEASE READY DRIVE";M%(25%):
	&"HIT RETURN WHEN DONE - ";:OPEN"KB:" FOR INPUT AS FILE 11%:
	INPUT #11%,A$:CLOSE 11%:RESUME
220 IF ERR=25% AND M%(25%)=U2% THEN &"PLEASE RE-INITIALIZE THE";
	" NEW PACK ON ";D2$;" - IT NEEDS 'CLEANING'":M%(25%)=U1%:
	M%(3%)=2%:CHANGE M% TO A$:A$=SYS(A$):GOTO 430 ! DISMOUNT THE
	FIRST DISK AND RESTART THE SYSTEM
230 IF ERR=25% THEN &"DISK PACK NEEDS 'CLEANING'":M%(2%)=2%:
	CHANGE M% TO A$:A$=SYS(A$):M%(2%)=3%:RESUME 170
	! CLEAN THE FIRST DISK IF NEEDED, BUT NOT THE SECOND ONE
240 IF ERR=18% THEN IF M%(25%)=U2% THEN RESUME 190 ELSE RESUME 170
250 E$="MOUNTING DK"+MID(NUM$(M%(25%)),2%,1%)+":"+X7$:E%=0%:
	GOTO 620
260 I%=3%
270 ON ERROR GOTO 380:A%=FNA%(D1$,I%):I%=I%+1%:GOTO 270 UNLESS N%(5%)
	OR N%(6%):I1%=0%:A$="["+NUM$(N%(8%))+","+NUM$(N%(7%))+"]":
	D3$=D1$+A$:D4$=D2$+A$:&"ACCOUNT ";A$
280 &"   FILE    LENGTH"
290 F$=FNL$(I1%):L%=SWAP%(M%(14%))+M%(13%):IF L%=0% OR E$="TMP" THEN
	I1%=I1%+1%:GOTO 290
300 NAME D3$+F$ AS D3$+F$+"<0>"
310 C%=0%:C%=N%(29%) IF E$="BAC":OPEN D3$+F$ FOR INPUT AS FILE 1%:
	OPEN D4$+F$ FOR OUTPUT AS FILE 2%,CLUSTERSIZE C%
320 FIELD #1%,512% AS I$:FIELD #2%,512% AS O$:GOSUB 610
	! OPEN INPUT AND OUTPUT FILES AND SET CREATION AND ACCESS
	DATES AND TIMES
330 ON ERROR GOTO 360:FOR K%=L% TO 1% STEP -1%:GET #1%,RECORD K%:
	LSET O$=I$:PUT #2%,RECORD K%:NEXT K% ! RECORDS ARE MOVED
	BACKWARDS TO AVOID EXTENDING THE FILE L% TIMES!!!
340 &F$;" ";L%
350 CLOSE 1%,2%:NAME D4$+F$ AS D4$+F$+"<"+NUM$(M%(15%))+">":GOTO 290
360 E$="TRANSFERRING "+F$:E%=-1%:GOTO 620
370 RESUME 270 IF ERR=5% OR ERR=18%:E$="DIRECTORY LOOKUP":E%=0%:
	GOTO 620
380 RESUME 390 IF ERR=5% OR ERR=18%:E$="ACCOUNT LOOKUP":E%=0%:
	GOTO 620
390 CHANGE SYS(CHR$(6%)+CHR$(-10%)+D1$+X7$) TO M%:M%(1%)=6%:M%(2%)=3%:
	M%(3%)=2%:CHANGE M% TO A$:A$=SYS(A$):M%(25%)=U2%:CHANGE M% TO A$:
	A$=SYS(A$):&"THE DISKS ARE NOW DISMOUNTED":GOTO 130
400 IF ERR<>57% THEN E$="READING DISK ID'S":E%=0%:GOTO 620
410 RESUME 420
420 &"END OF PACKING, WAIT FOR SYSTEM REBOOT, THEN USE":
	&"'ROLLIN' TO RESTORE THE ORIGINAL PACKS"
430 X%=PEEK(2098%)+2%:T%=PEEK(X%):T%=T%+8192% UNLESS T% AND 8192%:
	A$=SYS(CHR$(6%)+CHR$(-6%)+CHR$(X%)+CHR$(SWAP%(X%))+CHR$(T%)+
	CHR$(SWAP%(T%))):X%=PEEK(PEEK(PEEK(2098%)))+22%
440 IF PEEK(X%) THEN 440:A$=SYS(CHR$(6%)+CHR$(5%))
450 A$=SYS(CHR$(6%)+CHR$(-6%)+CHR$(4%)+CHR$(0%)+CHR$(6%)+CHR$(0%)+
	CHR$(193%)+CHR$(21%)+CHR$(50%)+CHR$(255%)+CHR$(95%)+CHR$(0%)+
	CHR$(68%)+CHR$(246%))
460 A%=PEEK(1%):STOP ! BOOT FROM DF0: BY EXECUTING THE FOLLOWING:
	.=4		; TRAP VECTOR FOR BUS TIME-OUT
	.WORD 6		; GO TO LOCATION 6 IF ONE (NAMELY A PEEK(1)
			;   OCCURS
470 !	MOV #177462,R1	; PUT THE ADDRESS OF THE RFWC REGISTER IN R1
			;   FOR THE BOOTSTRAP
	JMP @#173104	; THEN GO TO ITS SECOND INSTRUCTION
480 DEF FNW%(D$) ! FUNCTION TO TEST FOR VALID DEVICE NAME;
	DK: AND DP: ARE THE ONLY DEVICES CONSIDERED VALID
490 GOTO 520 IF LEFT(D$,2%)<>"DK" AND LEFT(D$,2%)<>"DP":
	GOTO 520 IF RIGHT(D$,4%)<>":":ON ERROR GOTO 510
500 Z$=SYS(CHR$(6%)+CHR$(10%)+RIGHT(SYS(CHR$(6%)+CHR$(-10%)+D$),3%)):
	FNW%=0%:GOTO 530
510 RESUME 520
520 &"INVALID DEVICE NAME - ";D$:FNW%=-1%
530 FNEND
540 DEF FNA%(D$,P%) ! FIND ENTRY #P% IN THE MFD ON DEVICE D$
550 ON ERROR GOTO 380
560 DIM N%(30%):CHANGE SYS(CHR$(6%)+CHR$(-10%)+D$) TO N%:N%(1%)=6%:
	N%(2%)=14%:N%(3%)=P%:N%(4%)=SWAP%(P%):N%(0%)=30%:
	CHANGE N% TO Z$:CHANGE SYS(Z$) TO N%:FNEND
570 DEF FNL$(P%) ! FUNCTION TO LOOKUP A DIRECTORY ENTRY
580 ON ERROR GOTO 370
590 DIM M%(30%):M%(0%)=30%:M%(1%)=6%:M%(2%)=15%:M%(3%)=P%:
	M%(4%)=SWAP%(P%):M%(5%)=N%(7%):M%(6%)=N%(8%):M%(Z%)=N%(Z%)
	FOR Z%=23% TO 26%:CHANGE M% TO M$:CHANGE SYS(M$) TO M%
600 E$=RAD$(M%(11%)+SWAP%(M%(12%))):FNL$=RAD$(M%(7%)+SWAP%(M%(8%)))+
	RAD$(M%(9%)+SWAP%(M%(10%)))+"."+E$:FNEND
610 DIM O%(30%):O%(0%)=30%:O%(1%)=6%:O%(2%)=-11%:O%(3%)=2%:
	O%(Z1%)=M%(Z1%+13%) FOR Z1%=4% TO 9%:CHANGE O% TO O1$:
	O1$=SYS(O1$):RETURN
620 RESUME 630
630 E9$=RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(ERR)),3%):
	&LEFT(E9$,INSTR(1%,E9$,CHR$(0%))-1%);" - ERROR IN ";E$
640 IF E% THEN CLOSE 1%,2%:KILL F$:GOTO 290 ! IF TRANSFER ERROR, WIPE
	OUT THE VICTIM FILE
650 IF ERR=20% THEN GOTO 130 ! DISK ID'S WERE NOT RIGHT, GIVE THE
	STUPID OPERATOR A SECOND CHANCE
660 END