TITLE SQUASH
	SUBTTL SWITCHES AND NONREL SYMBOLS

;AUTHOR: MIKE FRY. U OF ILL AT CU
;MARCH 1977.
;SEE SQUASH.DOC FOR GENERAL DOCUMENTATION.

	RADIX 10
AGEREF==0	;AGE OF FILE TOO OLD TO SAVE
SLTIM1==2	;NUMBER OF SECONDS TO SLEEP AT NOTIFICATION OF
		;SUPERCEDE.
SLTIM==2	;NUMBER OF SECONDS TO SLEEP AT EACH FILENAME TYPED
		;DURING ABOVE.
BFSZDI==3	;NUMBE OF BUFFERS IN D1'S RING AT DECOMP
BFSZDO==3	;SIMILAR FOR D3 ON DECOMP
BFSZCI==3	;SIMILAR FOR D1 ON CREATE
BFSZCO==3
; D2 ALWAYS USES ONE BUFFER RINGS
	RADIX 8
PROM=557	;PROTECTION ON LIBRARY FILE.
PROJCT=6551	;PPN OF SQUASH.CNT, THE BOOKEEPING FILE.
PROGCT=37761
BKON==0	;BKON NONZERO ALLOWS BOOKKEEPING CODE
		;TO BE ASSEMBLED.
EXPON==0	;SWITCH FOR EXPANDED LISTING AND LITERALS
;  DEVICE STATUS BITS:
.IOIMG==10	;IMAGE MODE. THIS IS MODE LIB FILE IN.
IO.DER==1B19	;DEVICE DETECTED ERROR. (DISK)
IO.DTE==1B20	;COMPUTER HARDWARE DETECTED ERROR ON DISK
IO.BKT==1B21	;BLOCK TOO LARGE
IO.EOF==1B22	;END OF FILE
IO.SYN==1B30	;SYNC INPUT
IO.UWC==1B31	;USER WORD COUNT
; LOOKUP-ENTER ERROR CODES:
ERFBM%==3	;FILE BEING MODIFIED ERROR CODE
ERFNF%==0	;FILE NOT FOUND ERROR CODE
ERNRM%==14	;NO ROOM OR QUOTA EXCEEDED ON DSK

IF1,<
 IFN BKON,<PRINTX BOOKKEEPING ON>
 IFE AGEREF,<PRINTX NO AGE CONDITION>
 IFN AGEREF,<
  DEFINE AGEOUT(AGERT)
   <PRINTX WILL NOT STORE FILES NOT ACCESSED FOR AGERT DAYS>
  RADIX 10
  AGEOUT \AGEREF
 RADIX 8
>>
F=0	;FLAG REGISTER
A=1	;ACCUMS
B=2
C=3
D=C+1
E=5
G=6
T2OLD=7	;HOLDS DATE OF FILE TOO OLD
T1=10
T2=11
T3=12
T4=13
P=15
FL$=16	;ALWAYS CONTAINS ADDRESS OF FILENAME TO BE USED
	;WHEN TYPING FILENAME WITH ERROR MESSAGE.
D1==1	;DEVICE CHANNELS
D2==2
D3==3
	OPDEF JEROP[1B8]	;BREAK, TYPE ERROR MESSAGE,AND EXIT.
	OPDEF JEROF[1B7]	;SAME AS JEROP, BUT WITH FILENAME TPED
	OPDEF JEROFB[3B7]	;SAME AS JEROF BUT WITH RETURN
	OPDEF JTYPFN[1B6]	;TYPE A FILENAME AND CR-LF

	PAGE
	SUBTTL MACROS
	IFN EXPON,<LALL>

DEFINE SLPOUT(SL)		;ALGORITHM FOR SLEEPING AT
	<IFN SL,<		;;NOTIFICATIONS OF SUPERCEDE.
	 MOVEI D,SL
	 SKPINC		;;DON'T SLEEP IF CHAR ON TTY
	 SLEEP D,>>

DEFINE REPROT(DEV,BLK,AC,PROT,LBK<0>)	;REPROTECTS A FILE
	<MOVEI AC,PROT
	DPB AC,[POINT 9,BLK+2+2*LBK,8]	;;LBK=1 MEANS LONG BLOCK
	IFE LBK,<SETZM BLK+3>	;;DON'T NEED TO CLEAR PPN WORD ON LONG BLOCK.
	RENAME DEV,BLK
	 JEROF @RENERF>

DEFINE REPRO2(DEV,BLK,AC,LBK<0>)	;REPROTECTS TO 057 AND LOOKS UP.
	<REPROT DEV,BLK,AC,57,LBK
	IFE LBK,<SETZM BLK+3>	;;AGAIN, NO CLEARING NEEDED IF LONG BLOCK
	LOOKUP DEV,BLK
	 JEROF @LKPERF>

	REPEAT 0,<
   BLMOV SETS UP AND EXECUTES A BLT, USED FOR TRANSFER OF DATA
FROM THE INPUT BUFFERS TO THOSE OF OUTPUT. AOS IS USED RATHER
THAN A MOVE BECAUSE THESE POINTERS TO DATA IN THE BUFFERS ARE
SET UP FO ILDB AND IDPB INSTRUCTIONS. (BUFFER HEADER BLOCKS.)
>
DEFINE BLMOV(K,L,DEST1,SOUR1,DEST2,SOUR2)
	<IFNB <DEST1>,<AOS K,DEST1+1>
	IFNB <DEST2>,<MOVEI K,DEST2>
	IFNB <SOUR1>,<AOS L,SOUR1+1>
	IFNB <SOUR2>,<MOVEI L,SOUR2>
	HRL K,L
	HRRZI L,177(K)
	BLT K,(L)>

	REPEAT 0,<
   USING WORD 2 OF HEADER BLOCK AS ABOVE,MVAST BLT'S DATA FROM THE
READ TO THE WRITE AND SETS UP THE DATA WORDS COUNT IN THE
RIGHT HALF OF WORD 3 OF THE BUFFER. IF LASTO IS NOT 0, WHEN C
CONTAINS 0 IT GETS THE COUNT FROM 3(A)'S RH, OTHERWISE
JUST 200. 'A' POINTS TO THE FIRST WORD OF A SQUASH DIR BLOCK.
>
DEFINE MVAST(LASTO)	;MOVES DATA FROM INPUT TO OUTPUT.
	<BLMOV D,E,WD3,RD1	;;WD3&RD1 BUFFER RNG HDRS
	IFN LASTO,<JUMPN C,.+3
	 HLRZ E,3(A)	;;FETCHES NO OF WORDS WRITTEN FROM SQUASH DIR
	 JRST .+2>
	 MOVEI E,200
	HRR D,WD3
	HRRM E,1(D)
	OUT D3,>


	REPEAT 0,<
   MVWT IS SIMILAR TO MVAST, BUT IT GETS ITS DATA FROM SVBLK
RATHER THAN DIR, AND IS USED TO WRITE BLOCK 1 OF THE LIB FILE TO
REFRESH WORD 1, THE NUMBER OF BLOCKS BEFORE THE LAST DIR BLOCK.
>
DEFINE MVWT(K,L,BLKD,DEV)
	<BLMOV K,L,BLKD,,,SVBLK
	MOVE K,BLKD	;;BLKD IS THE BUFFER HEADER.
	MOVEI L,200	;;WILL FILL IN NUMBER OF DATA WORDS (200)
	HRRM L,1(K)
	WAIT DEV,	;;WAIT TILL DEVICE INACTIVE
	USETO DEV,1	;;READY TO WRITE BLOCK 1
	OUT DEV,	;;SKIPS ON ERROR
>
DEFINE JERR(LISTO)	;ERROR MESSAGES
	<JEROP [ASCIZ/LISTO/]>

DEFINE JERF(LISTO)	;ERROR MESSAGES WITH FILENAME
	<JEROF [ASCIZ/LISTO /]>

DEFINE JERFB(LISTO)	;NONFATAL ERRORS WITH FILENAME
	<JEROFB [ASCIZ/LISTO /]>

	PAGE
	SUBTTL REFERENCE POINTS

	LOC 41
	JSP P,ABORTY		;NOTE P HAS PC OF ERROR DETECTION

	RELOC 0
; THE VARIOUS EXIT POINTS:
ABORTY:	HLRZ T4,40	;GET OP CODE
	CAIN T4,(JTYPFN)
	 JRST TYPFN	;JUST TYPE A FILENAME, AND RETURN BY P.
	OUTSTR CRLF	;<CR>-<LF>
	OUTSTR @40	;OUTPUT ERROR MESSAGE
	MOVEM P,PSAV#	;SAVE PC OF ERROR.
	CAIN T4,(JEROP)	;TEST FOR WHETHER FILENAME APPROPRIATE.
	 JRST ABORT
	MOVEM T4,SOP#	;SAVE THE OP CODE
	JTYPFN (FL$)	;TYPE CURRENT FILENAME
	MOVE T4,SOP	;RESTORE OP CODE
	MOVE P,PSAV	;RESTORE PC
	CAIN T4,(JEROFB)	;FATAL?
	 JRSTF (P)	;NO. RETURN.
ABORT:	RESET	;STANDARD ABORT. KILL FILES WRITING
	JRST EMEX
RELOUT:	RELEAS D3,
	RELEAS D1,
	RELEAS D2,
EMEX:	EXIT 1,	;ONLY EXIT POINT
	JRST ABORT

; SUBROUTINE FOR TYPING A FILENAME AND CRLF. CALLED BY THE
; JTYPFN UUO, WITH EFFECTIVE ADDRESS THAT OF THE FILENAME
; AND EXTENSION IN SIXBIT(1 AND A HALF WORDS)
; NOTE THAT THE AC'S USED ARE NOT SAVED. IT SIMPLY WASN'T
;NECESSARY, BUT IF IN DOUBT, SAVEM.
TYPFN:	HRLI T4,(<POINT 6,>)	;SET UP BYTE POINTER
	HRR T4,40	;GET ADDR FROM CALLING INSTRUCTION
	MOVEI T3,1
	MOVEI D,6	;SET FOR FILENAME
TFNM:	ILDB E,T4
	JUMPE E,.+3	;SUPPRESSES BLANKS.
	ADDI E,40
	OUTCHR E
	SOJG D,TFNM
	SOJL T3,DNTP
	OUTCHR ["."]
	MOVEI D,3	;SET FOR EXTENSION
	JRST TFNM
DNTP:	OUTSTR CRLF	;<CR>-<LF>
	JRSTF (P)	;RETURN

	REPEAT 0,<
   HERE THE OVER QUOTA CONDITION IS DETECTED. F IS SET TO ONES
AND IS TESTED AND CLEARED AT'TRYB'& 'REEB'. IF USER GOES OVER QUOTA
WHILE COPYING A FILE INTO MASTER, THE COPIED FILES ARE DELETED
AND A NEW SEG IS STARTED. THIS IS SO THAT IF THERE ARE NO NEW FILES
ON DSK WHEN DECOMPOSITION TAKES PLACE, SQUASH CAN DECOMPOSE THE
WHOLE LIB FILE. WITHOUT THIS FEATURE, THE LIB FILE COULD EAT A LOT MORE
THAN IT COULD SPIT OUT.
>
OVQHND:	SETO F,		;SET FLAG TO INFORM PROGRAM. FLAG DETECTED BY
			;F<0, SO THIS COULD BE MADE TO SET ONLY BIT 0.
	SETZB P,OVQINT+3	;CLEARS INT BLOCK WORDS FOR REUSE.
	EXCH P,OVQINT+2	;ZERO RETURN FOR MORE, GET RET ADDR.
	CAMN B,[-174]	;CHECKS B, COUNT ON FILES IN SEG.
	 JRSTF (P)	;ALLOWS CONTINUE IF THHIS IS FIRST
	HRRI P,ABTSEG	;IF NOT FIRST, ABORTS SEGMENT
	JRSTF (P)

	PAGE
	SUBTTL DEVICE INITIALIZATION AND DECISION

	REPEAT 0,<
   HERE BEGINS THE PROGRAM.DEVICE 1 IS THE MAIN READ DEVICE,
D2 IS THE AUXILIARY READ, FOR THE UFD OR FOR TEST LOOKUPS
AND D3 IS THE MAIN WRITING CHANNEL.NOTE THAT ALL DEVICES WORK IN
MODE 10, 36-BIT BYTE MODE,D1 AND D3 HAVE BIT 31 SET,REQUIRING THE
PROGRAM TO SPECIFY THE NUMBER OF WORDS WRITTEN. THIS IS BECAUSE
SQUASH USES BLT'S INSTEAD OF IDPB'S TO FILL THE BUFFER, SO THE
COMPUTATION OF THE WORD COUNT BY BYTE COUNT WOULD BE IN ERROR.
>
SQUASH:	RESET
	SETZ F,		;F HAS "SUPERCEDE FLAG IN DECOMP,
			;'OVER QUOTA' FLAG ON CREATE
IFN AGEREF,< DATE T2OLD,	;T2OLD HAS AGE OF FILE NOT
	 SUBI T2OLD,AGEREF>	;ACCESED RECENTLY, NOT TO BE EATEN.
	INIT D1,IO.UWC!.IOIMG
	SIXBIT/DSK/
	XWD WD1,RD1	;WILL WRITE VIA D1 ONLY TO REFRESH BLOCK 1
			;IT HAS TO ALWAYS HAVE THE CORRECT POINTER TO
			;THE LAST SEGMENT'S DIR BLOCK.
OPDERR:	 JERR ?CAN'T GET TO DSK
	INIT D2,.IOIMG
	SIXBIT/DSK/
	 EXP RD2
	 JEROP @OPDERR
	INIT D3,IO.UWC!.IOIMG
	SIXBIT/DSK/
	XWD WD3,RD3	;WILL NEVER WANT TO READ ON D3, BUT LOOKUP.
	 JEROP @OPDERR

	INBUF D2,1
	GETPPN A,	;GET DIRECTORY ON [PPN].UFD[1,1]
	 JUMP		;IN CASE USER PRIVELEGED AND LOGGED IN TWICE
	MOVEM A,UFDBLK
REED:	MOVEI FL$,[SIXBIT/OPEN/
		   Z]	;ON FILETYPING ERRORS, OPEN IS FILENAME
	MOVE B,[XWD 1,1]	;REENTRY POINT ON WULTI SEG LIB FILE
				;ON DECOMPOSITION
	MOVEM B,UFDBLK+3	;'A' HAS POINTER TO NEXT SEG'S DIR
	LOOKUP D2,UFDBLK	;BLOCK ON REENTRY, PPN FIRST TIME
UFDEMT:	JERR ?NO UFD (DISK EMPTY)
	IN D2,	;GET FIRST BLOCK OF DIRECTORY
	 JRST .+2
	 JEROP @UFDEMT
	LOOKUP D1,LBLK	;TRIES FOR MASTER.LIB
	 JRST MAKLIB	;IF NOT THERE, GOTO MAKLIB
	PAGE
	SUBTTL RESTORATION OF LIB FILE
	COMMENT/INITIALIZATION OF DEVICES, GETTING LIB'S DIR BLOCK/

	JUMPE A,REENOU	;TO REENOU IF HAVE UNDONE ALL BUT 1 SEG IN
			;MULTISEG LIB FILE
	SKIPE WD1	;TO REELBK IF IN MIDST OF MULTISEG
	 JRST REELBK	;CONTINUE IF FIRST TIME AROUND.
			;NOTE 'A' HAS PPN, NOT 0, ON FIRST TIME
			;'WD1' HAS 0 FIRST TIME, ADDR OF BUFFER LATER.
	OUTSTR [ASCIZ/UNDOING LIBRARY FILE.../]
	INBUF D1,BFSZDI		;GET BUFFERS
	OUTBUF D3,BFSZDO
	REPRO2 D1,LBLK,A,1	;REPROTECT MASTER.LIB TO 057 WITH LONG BLK
	SETSTS D1,IO.UWC!IO.SYN!.IOIMG	;SET TO SYNC INPUT
	IN D1,		;IN CASE WANT TO START AT LATER BLOCK
	 JRST .+2
	 JEROP @MFERR	;MASTER NOT ON CORRECT FORMAT
	SETSTS D1,IO.UWC!.IOIMG	;RESTORE TO REGULAR INPUT MODE
	MOVE C,RD1+1
	SKIPN A,1(C)	;FIRST WORD HAS WHICH BLOCK TO READ-1
	 JRST FB1	;TO FB1 IF NOT MULTISEG FILE.

FUGE1:	SKIPE 2(C)	;BEGIN CHANGE OF OLD FORMAT. CHECK FOR
			;FILENAME AS FIRST ENTRY. (NOW BLOCK #)
FUGE2:	JRST FB1	;SO NOT REALLY MULTISEG
			;IN NEW FORMAT, WORD TWO IS 0.

	OUTBUF D1,1	;FOR WRITING BLOCK ONE EACH TIME THROUGH.
	BLMOV B,C,,RD1,SVBLK	;SAVE BLOCK 1 IN SVBLK
REELBK:	ENTER D1,LBLK	;ENTER FOR WRITING BLOCK 1
	 JEROF @DSKFL	;ONLY ENTERS IF MULTISEG
	USETI D1,1(A)	;MOVE TO LAST DIR BLOCK
REENOU:	IN D1,	;READ IN THE CORRECT DIRECTORY
	 JRST .+2
	 JEROP @MFERR	;ERROR IMPLIES NOT REALLY LIB FILE
FB1:	MOVEM A,LBLK+11	;SAVE BLOCK NUMBER. WILL DEALOCATE LATER BLKS.
	BLMOV A,B,,RD1,DIR	;MOVE DIR TO 'DIR'
FUGE4:	SKIPN DIR+2	;CHECK FOR OLD FORMAT DIR. NOW SHOULD
			;HAVE 0 IN WORD 2.
	 JRST STCKSP
	MOVE T1,[XWD FUGE3,A]	;WILL BLT SUBROUTINE TO AC'S
	BLT T1,A+3	;TO PUSH DIR DOWN FOUR.
	MOVEI T1,173	;COUNTER FOR WORDS TO MOVE LESS ONE.
	JRST A		;WILL PULL DIR DOWN BY 4
DNPULL:	SETZM DIR	;AND 0 FIRST WORD TO INDICATE NOT MULTISEG
FUGE5:

	PAGE
	COMMENT/DETECTION AND HANDLING OF SUPERCEDE/

STCKSP:	MOVEI G,100	;SET UFD COUNTER
	AOS B,RD2+1	;POINTER TO UFD BLOCK
RETBSP:	MOVEI A,DIR+4	;INITIALIZE LIB DIR POINTER
	HLLZ T2,1(B)	;GET EXTENSION
	SKIPE T1,(B)	;IF FILENAME 0
RETASP:	SKIPN T3,(A)	;OR OTHER FILENAME 0
			;NOTE 0 NAME MARKS END OF LIB DIR, BUT NOT OF UFD
	 JRST INCBSP	;THEN INCREMENT UFD POINTER
	HLLZ T4,1(A)	;GET EXTENSION FROM LIB DIR
	CAMN T1,T3	;CHECK FOR MATCH
	CAME T2,T4	;AND HERE
	 JRST INCASP	;DON'T BOTH, INCR DIR POINTER
	JUMPL F,ALRDNT	;HAS "FILES SUPERCEDED:" BEEN TYPED?
	OUTSTR [ASCIZ/
FILES SUPERCEDED:
/]
	SLPOUT SLTIM1	;SLEEP SLTIM1 SECONDS
ALRDNT:	JTYPFN T1	;TYPE FILENAME IN T1&T2
	SETO F,		;SET FILES SUPERCEDED FLAG.
	SLPOUT SLTIM	;SLEEP SLTIM SEONDS
	SETZM 1(A)	;ZERO WORD 2 OF DIR ENTRY AS FLAG FOR DELETE.
INCASP:	ADDI A,4	;INCR DIR POINTER
	JRST RETASP	;AND BACK
INCBSP:	ADDI B,2	;INCR UFD POINTER
	SOJG G,RETBSP	;UP UFD COUNT AND BACK
	IN D2,		;TRY FOR MORE UFD
	 JRST STCKSP	;MORE THERE. GO BACK AND CHECK THIS BLOCK.
	CLOSE D2,	;DONE WITH CHECK FOR SUPERCEDE IN THIS SEG

	PAGE
	COMMENT/ACTUAL COPY WORK/
	MOVEI FL$,FLBLK+2	;ON FILETYPING ERROR, NAME FROM LBLK.
	MOVE A,[XWD FLBLK+2,DIR+4]	;PONTER TO ENTRY IN DIR,
			;AND WHEN SWAPPED, BLT POINTER TO MOVE
			;FROM DIR BLOCK TO ENTER BLOCK
			;NOTE MINIMUM OF 1 LIB DIR ENTRY/SEG
BEGCP:	HRRZ C,3(A)	;FETCH BLOCK COUNT
	SKIPN T1,1(A)	;TEST FOR FLAGGED FOR DELETION
	 JRST COPLOO	;T1 HAVING 0 WILL SIGNIFY DELETE.
	MOVS D,A	;SET UP BLT ARGUMENT (A HAS FLBLK IN LH)
	BLT D,FLBLK+4	;MOVE 1ST 3 WORDS OF LOOKUP BLOCK TO ENTER BL
	MOVEM C,FLBLK+10	;GIVE SIZE OF FILE
	HRLOI D,777	;WILL ZAPP PROTECTION FOR NOW
	ANDM D,FLBLK+4
	SETZM FLBLK+6	;ENTRIES 6 AND 7 NOT NEEDED
	SETZM FLBLK+7
	ENTER D3,FLBLK	;ENTER JUST AS ORIGINAL

	 JRST .+2	;HANDLING OF FAILURE ONN ENNTER:
	 JRST ENTFOK
	HRRZ T1,FLBLK+3	;GET ERROR CODE FROM RH OF WORD 3 OF ENTER BLOCK
	CAIN T1,ERFNF%	;IMPROPER FILENAE?
	 JEROP @MFERR	;LIB FILE NOT IN CORRECT FORMAT
	CAIN T1,ERNRM%	;DISK FULL?
DSKFL:	 JERF ?DISK MUST BE FULL OR OVER QUOTA AT
	CAIE T1,ERFBM%	;FILE BEING MODIFIED?
HARDR:	 JERF ?MONITOR OR HARDWARE ERROR ON DISK AT
	JERFB <[SOMEONE MODIFYING>
	OUTSTR [ASCIZ/LIB COPY BEING DESTROYED...]/]
	SLPOUT SLTIM	;SLEEP
	SETZB F,T1	;CLEAR 'FILES SUPERCEDED FLAG AND FLAG DELETE
	JRST COPLOO

ENTFOK:	OUTPUT D3,	;INITIALIZE BUFFER
COPLOO:	SOJL C,ENDCOP	;DEC 1 AND TEST FOR NO MORE BLOCKS
	IN D1,	;COPY FROM MASTER TO FILE
	 JRST .+2	;NORMAL RETURN
MFERR:	 JERR ?LIBRARY FILE(MASTER.LIB) NOT IN PROPER FORMAT
	JUMPE T1,COPLOO	;IF DELETING, DON'T GO ON
	MVAST 1	;TRANSFER OUT VIA BLT. ON LAST BLK,USE 3(A) FOR
	 JRST .+2	;NORMAL RETURN
	 JEROF @DSKFL	;ERROR IF DSK FULL (OR HARDWARE ERROR)
	JRST COPLOO	;BACK FOR NEXT BLOCK

ENDCOP:	JUMPE T1,INCRAB	;AGAIN, IF DELETING, SKIP NEXT PART.
	SETZM 3(A)	;CLEAR PPN WORD
	RENAME D3,(A)	;RENAME TO ORIGINAL MODE AND PROTECTION.
			;THE FILE IS WRITTEN IN IMAGE MODE SO
			;DUMP FILES CAN BE HANDLED, AND
			;THE RENAME WOULD FAIL WITHOUT A LOW PROTECTION
RENERF:	 JERF ?UNKNOWN RENAME FAILURE ON
INCRAB:	ADDI A,4	;TERMINATION OF COPYING LOOP
	SKIPE C,(A)	;0 NAME INDICATES NO MORE IN SEG
	 JRST BEGCP	;GO BACK FOR NEXT FILE.
	PAGE
	COMMENT/CLEANING UP AND RESTART IF MORE/

	HRRZ FL$,REEDR	;'CLOSE' IS FILENAME ON TYPING ERROR MESS.
	SKIPE LBLK+11	;CHECK FOR MORE TO COME IN.
	 JRST MORLBK
	SETZM LBLK+2	;DELETE LIBRARY FILE(MASTER.LIB)
	RENAME D1,LBLK
	 OUTSTR [ASCIZ/
[FAILURE DELETING LIBRARY FILE]/]
	JRST RELOUT	;AND EXIT
MORLBK:	MOVE A,DIR	;GET NEXT EARLIER REL BLOCK
	MOVEM A,SVBLK	;PUT AS LAST IN FILE
	OUTPUT D1,	;SET UP OUT BUFFER
	MVWT B,C,WD1,D1	;WRITE BLOCK 1 AFTER WAITING.
	 JRST .+2	;SHOULD NEVER HAVE AN ERROR HERE, BUT
DROERR:	 JERR ?ERROR WRITING LIBRARY DIRECTORY AT CLOSE
	RENAME D1,LBLK	;RENAME TO DEALLOCTE TRAILING BLOCKS
			;AS SET AT 'REELBK+2' OR SO ABOVE.
	 OUTSTR [ASCIZ/
[IMPOSSIBLE RENAME FAILURE AT END OF SEGMENT.
WILL TRY TO CONTINUE]/]
	JRST REED	;'A' HAS NEW REL BLOCK NUMBER

	PAGE
	SUBTTL CREATION OF LIBRARY FILE
	COMMENT/INITIALIZATION OF NEW LIB FILE/

	REPEAT 0,<
   IT'S IMPERATIVE THAT THE QUOTA BE CHECKED BEFORE SQUASH GOES
INTO PRODUCTION. IF THE USER IS OVER QUOTA WHEN THE PROGRAM
IS RUN (LOGGED IN QUOTA, THAT IS), THE ENTER OF THE LIBRARY FILE
WILL FAIL. BUT IF THERE IS ONLY ONE CLUSTER OF DISK SPACE LEFT
WHEN THE PROGRAM IS RUN, THE ENTER WILL SUCCEED, BUT DECOMPOSITION
WILL FAIL FOR THE FIRST FILE IN THE LIB FILE.(IT WOULD BE THE
ONLY FILE REMAINING THERE, AS THE OVER QUOTA CONDITION WOULD HAVE
MADE SQUASH PUT IT IN A GEGMENT BY ITSELF). THE DECOMPOSITION WILL
ACTUALLY ONLY FAIL IF THE DIR BLOCK ALONG WITH THE DATA FILE TAKE
UP MORE ROOM THAN THE DATA FILE ALONE. ORIGINALLY, THE LIB FILE
WAS ENTERED BEFORE THE CHECK WAS MADE, BUT APPARENTLY WHEN A FILE
IS FIRST ENTERED, IF NO ESTIMATE IS GIVEN AS TO THE SIZE OF THE
FILE TO BE WRITTEN, AS MANY AS 30 BLOCKS WILL BE ALLOCATED TO IT IF
POSSIBLE BY THE MONITOR.
>
MAKLIB:	HRRZ A,LBLK+3	;GET ERROR CODE FROM LIB LOOKUP BLOCK
	CAIE A,ERFNF%	;HAD BETTER BE FILE NOT FOUND
	 JERR ?ERROR OTHER THAN FILE NOT FOUND ON LOOKING FOR LIB FILE
	HLLZS LBLK+3	;CLEAR LOOKUP ERROR
	HRLZI A,(SIXBIT/DSK/)	;WILL CHECK ROOM LEFT ON DSK
	MOVEM A,DIR
	MOVE A,[XWD 6,DIR]	;WILL USE FIRST FEW WORDS OF DIR BLOCK
	DSKCHR A,	;GET DISK CHARACTERISTICS
	 JERR ?ERROR ON DSKCHR UUO.
	LDB A,[POINT 9,DIR+5,8]	;GET CLUSTER SIZE
	LSH A,1		;DOUBLE CLUSTER SIZE. NEED TWO CLUSTERS.
	CAMLE A,DIR+1	;COMPARE WITH LOGGEDIN LEFT
	 JERR ?NOT ENOUGH QUOTA LEFT TO MAKE A LIBRARY FILE
	MOVEI A,4	;WILL RESET LENGTH OF LONG BLOCK
	MOVEM A,FLBLK	;DON'T NEED 7'TH WORD ON CREATION SEGMENT
	OUTSTR [ASCIZ/MAKING LIBRARY FILE.../]
	INBUF D1,BFSZCI		;GET BUFFERS
	OUTBUF D3,BFSZCO
	MOVEI G,100	;COUTER FOR DIR ENTRIES LEFT
	MOVEI A,OVQINT	;SET OVER QUOTA TRAP. F TURNS TO 1'S ON OV QTA
	HRRM A,.JBINT##	;(AND OTHER POSSIBILITIES) SEE OVQHND ABOVE
	ENTER D3,LBLK	;ENTER MASTER.LIB FOR WRITING
ENTLER:	 JERR ?IMPOSSIBLE ERROR ENTERING LIBRARY FILE
RECENT:			;THIS IS THE REENTRY POINT ON A MULTISEG LIB FILE.
	SETZM DIR	;CLEARS DIR BLOCK
	MOVE A,[XWD DIR,DIR+1]	;WITHH A BLT
	BLT A,DIR+200	;BLOCK IS 201 WORDS LONG
	OUTPUT D3,	;INITIALIZE OUT BUFFER
	HRROI B,-174	;INDEX FOR DIR BLOCK
	MOVE A,CURLBK	;GET REL BLOCK-1 OF NEXT SEG'S DIR (0AT START)
	USETO D3,2(A)	;WILL WRITE DIR LAST. MOVE TO BLK 2.
			;IF F SET AT USETO, B HAS -174 SO WILL CONTINUE.
			;IT'S AN IMPOSSIBLE SITUATION ANYWAY.

	PAGE
	COMMENT/OPENNING FILE FOR EATING AND DECISION TO EAT/

	MOVEI FL$,FLBLK+2	;FILENAME IN CASE OF TYPING ERR MESS.
	JRST NEXF	;START BIG COPY LOOP FROM BOTTOM
BEGFIL:	AOS C,RD2+1	;GET EXTENSION
	HLLZ C,(C)	;FIRST, CHECK FOR A MATCH WITH A PASSOVER ENTRY
	SETOB D,E	;DIS INDEX, E IS FOR DETECTING WILDCARD.
PSVBEG:	CAME A,PSVBLK+1(D)	;TRY FILENAME
	CAMN E,PSVBLK+1(D)	;TRY FOR WILCARD
	 AOJA D,.+2	;ONE OF THEM SUCCEEDED
	 AOJA D,PSVREE	;BOTH FAILED
	CAME C,PSVBLK+1(D)	;TRY EXTENSION MATCH
	CAMN E,PSVBLK+1(D)	;AND WILDCARD
	 JRST FDPRG	;PASSOVER
PSVREE:	SKIPE PSVBLK+2(D)	;CHECK FOR END OF BLOCK
	 AOJA D,PSVBEG	;BACK TO CHECK MORE

	MOVEM A,FLBLK+2	;LOAD FILENAME INTO LOOKUP BLOCK
	MOVEM C,FLBLK+3	;SAME FOR EXTENSION
	LOOKUP D1,FLBLK		;OPEN NEXT FILE
LKPERF:	 JERF ?UNKNOWN ERROR LOOKING UP
			;THIS FILE MUST HAVE BEEN FOUND SINCE
			;WE JUST GOT IT OUT OF THE UFD.
IFN AGEREF,<HRRZ C,FLBLK+3	;CHECK ACCES DATE
	ANDI C,17777
	CAML C,T2OLD	;FILE TOO OLD?
	 JRST NOTOLD
	CLOSE D1,10	;CLOSE SUPPRESSING UPDATE OF ACCESS DATE
	JRST FDPRG	;AND PASSOVER
NOTOLD:>
	HRLI C,FLBLK+2
	HRRI C,DIR+200(B)	;TRANSFER LOOKUP BLOCK TO DIR.
	BLT C,DIR+202(B)
	SETZ C,	;COUNTER FOR NUMBER OF BLOCKS IN INPUT FILE.
BEGCOP:	IN D1,		;READ AND WRITE TILL END OF FILE
	 JRST .+2
	 JRST DNFIL
	MVAST		;TRANSFER IS BY BLT'S
	 JRST OUTOK	;NORMAL RETURN
	PAGE
	COMMENT/HANDLING OF DISK WRITE ERROR ON CREATION/

	REPEAT 0,<
   HERE IS THE HANDLING OF DISK ERRORS, SUCH AS OVER QUOTA, ON
WRITING THE LIBRARY FILE. HARDWARE ERRORS ABORT THE FILE ALTOGETHER
BUT IF DISK IS FULL (OR OVER QUOTA),WRITING IS DISCONTINUED AND
ALL IS AS THOUGH THERE WERE NO ROOM LEFT IN THE LIBRARY DIR.
SO SQUASH JUST EATS AS MUCH AS IT CAN. THE OVER QUOTA
TRAP JRSTF'S TO HERE IF IT WENT OVER QUOTA ON A FILE OTHER THAN
THE FIRST IN A SEGMENT. ON THE FIRST IN A SEG, COPYING IS ALLOWED
TO CONTINUE, BUT F IS SET TO GO TO NEXT SEG WHEN DONE WITH THAT FILE.
F IS SET WHEN OVQHND COMES HERE, TOO, BUT IS ONLY USED TO CONTROL
MESSAGE SENDING.
>
ABTSEG:	CLOSE D1,10	;CLOSES FILE WITHOUT CHANGING ACCESS DT
	GETSTS D3,C
	SETSTS D3,.IOIMG!IO.UWC
	TRNE C,IO.DER!IO.DTE	;CHECK FOR HARDWARE ERROR
	 JEROF @HARDR	;MUST BE HARDWARE
	CAMN B,[-174]	;FATAL IF FIRST FILE IN SEGMENT
			;LIB FILE WILL BE CLOSED, BUT NO MORE WRITTEN
	 JERFB ?OUT OF DISK SPACE AT 
SKPTPO:	HRROI A,-2
	ADDM A,RD2+1	;DEC POINTER
	JRST REEDR	;CONTINUE AS THOUGH B RAN OUT

OUTOK:	MOVE D,RD1	;GET # OF WORDS IN BLOCK
	HRL C,1(D)
	AOJA C,BEGCOP	;AND BACK FOR NEXT BLOCK IF ANY MORE.

DNFIL:	STATO D1,IO.EOF	;BETTER BE DUE TO END OF FILE
	 JERF ?UNKNOWN ERROR ON INPUT AT
	MOVEM C,DIR+203(B)	;RECORD NO OF BLKS&WDS IN LAST.
	HRRZ C,C	;REDUCE TO NO. OF BLOCKS
	ADDM C,TOTM#	;ADD TO TOTAL IN MASTER (FOR RECORDS)&ALLOC.
IFN BKON,<ADDI C,6	;ROUND UP TO COMPUTE PREV DSK SPACE
	IDIVI C,5
	IMULI C,5
	ADDM C,TOTD#>	;ADD TO TOTAL PREVIOUS TO SQUASH

	HRLOI C,177777	;WILL CLEAR FIRST 2 BITS OF PROTECTION
	ANDM C,FLBLK+4
	RENAME D1,FLBLK	;RENAME AND CLOSE. WILL DELETE AFTER SAFE.
	 JERFB %UNKNOWN ERROR RENAMING

	PAGE
	COMMENT/CONTROL ON GETTING MORE FILES. END OF LOOP
		BEGUN AT BEGFIL/

	ADDI B,4	;NEXT ENTRY IN DIR BLOCK
FDPRG:	SOJG G,NEXF	;UFD ENTRIES LEFT
	IN D2,		;IF NONE,TRY FOR MORE
	 JRST NEXFG	;IT FOUND SOME MORE UFD!!!!!
REEDR:	MOVEI FL$,[SIXBIT/CLOSE/
		   Z]	;CLOSE IS FILENAME TYPED ON ERROR MESS.
	SETZM DIR+200(B)	;0 AFTER LAST ENTRY
	CAME B,[EXP -174]	;IF NOT AT LEAST 1 FILE,GOHOME
	 JRST REEB
	SKIPN A,TOTM	;DON'T INCREMENT ALLOCATION
	 JRST ABORT	;JUST QUIT IF NOTHING THERE
	MOVEM A,LBLK+11	;SET ALLOCATION
	JRST RNMI	;RENAME TO TRUNCATE TRAILING BLOCKS, AND FINISH.
NEXFG:	MOVEI G,100	;RESET COUNTER FOR THHIS NEW UFD BLOCK.
NEXF:	ILDB A,RD2+1	;GET NEXT FILENAME
	JUMPN A,TRYB	;TEST FOR 0 NAME
	AOS RD2+1	;INCREMENT BYTE POINTER
	JRST FDPRG
TRYB:	JUMPL F,.+2	;CK FOR F TURNED ON DURIN FILE WRITING.
	JUMPN B,BEGFIL	;PASSED ALL TESTS. READY FOR NEXT FILE.
	SOS RD2+1	;IF FAILED BY B OR F, DECR ILDB POINTER.
			;B=0 MEANS LIB DIR HAS 31ENTRIES AREADY

	PAGE
	COMMENT/CLEANING UP, WRITING DIR, DEL EATEN FILES,RESTART IF MORE/

REEB:	SETZ F,		;SWITCH F OFF, READY TO TRY AGAIN
	AOS A,TOTM	;TOTM HAS TOTAL BLOCKS IN LIB FILE. ADD 1 FOR DIR.
	MOVEM A,LBLK+11	;RECORD ALLOCATION
	EXCH A,CURLBK#	;THE FUTURE MADE CURRENT
	MOVE B,A	;STORE START OF SEG JUST DONE
	EXCH A,PRVLBK#	;THE PRESENT MADE PAST
	MOVEM A,DIR	;AND THE PREVIOUS SEG'S DIR BLOCK PNTR WRITTEN
	BLMOV D,E,WD3,,,DIR	;MOVE DIR TO OUT BUFFER
	MOVEI D,200
	MOVE E,WD3
	HRRM D,1(E)
	WAIT D3,	;MUST WAIT TILL OUTPUT DONE TO MOVE HEAD.
	USETO D3,1(B)	;NOW WRITE DIR BLOCK
	OUT D3,
	 JRST .+2
	 JEROF @DROERR

	JUMPN B,RECGO	;IF BLOCK JUST WRITTEN WAS FIRST, INITIALIZE
	JUMPE G,RNMII	;AUTO RENAME TO PROM IF ONLY 1 BLOCK
	BLMOV C,D,,,SVBLK,DIR	;GET DIR AND SAVE(BLOCK 1 WILL BE REFRESHED
	JRST RNMI	;BLOCK 1 IN SAFE PLACE FOR LATER.
RECGO:	MOVEM B,SVBLK	;B HAS CURRENT DIR'S REL BLOCK. RECORD IN BL1
	MVWT A,B,WD3,D3	;WRITE BLOCK 1
	 JRST .+2
	 JEROF @DROERR

RNMI:	MOVEI A,57	;IF MORE TO COME, GIVE LIB 057 PROT
	JUMPN G,.+2
RNMII:	MOVEI A,PROM	;IF NO MORE, GIVE IT PROM PROTECTION
	DPB A,[POINT 9,LBLK+4,8]
	RENAME D3,LBLK	;RENAME WITH ALLOCATION SPECIFIED
	 OUTSTR [ASCIZ/
[UNKNOWN ERROR REPROTECTING LIBRARY FILE]/]

	MOVEI A,DIR	;DELETE FILES COPIED TO MASTER.LIB
	SETZM FLBLK+2	;0 LOOKUP BLOCK TO DELETE WITH
	JRST DEL1	;ENTER DELETE AREA FROM BOTTOM.
BEGDEL:	HRRZ FL$,A	;SET POINTER TO FILE NAME IN CASE OF ERR
	SETZM 3(A)
	LOOKUP D1,(A)
	 JEROF @LKPERF
	RENAME D1,FLBLK
	 JERFB %FAILURE DELETING
DEL1:	ADDI A,4
	SKIPE (A)	;DONE WHEN 0 ENCOUNTERED AS FILENAME IN DIR
	 JRST BEGDEL	;WILL WORK EVEN IF ALL 0.

	JUMPE G,NFTL	;G=0 MENS OUT OF UFD, QUIT.
	LOOKUP D3,LBLK	;APPEND MODE ENTERED
	 JEROF @LKPERF
	ENTER D3,LBLK	;SET TO WRITE ON LIB FILIE AGAIN
	 JEROP @ENTLER
	JRST RECENT	;BACK FOR MORE
NFTL:

	PAGE
	COMMENT/BOOKKEEPING AND EXIT/

;   HERE THE TOTAL NUMBER OF BLOCKS IN MASTER.LIB AND
;THAT OF DISK SPACE USED BEFORE RUN ARE RECORDED ON
;DSKC:SQUASH.CNT[6551,37761]
IFN BKON,<MOVEI FL$,CNTBLK	;BOOKKEEPING FILE IS NAME OF FILE ON ERR
	MOVE A,[XWD PROJCT,PROGCT]	;SAVE PPN OF SQUASH.CNT
	MOVEI C,12	;WILL TRY TO OPEN BOOKKEEPING FILE 10 TIMES
	MOVEM A,CNTBLK+3
TRENT:	ENTER D3,CNTBLK
	 JRST .+2	;IF UNSUCESSFUL
	 JRST ENTOKB
	HRRZ B,CNTBLK+1	;GET ERROR CODE
	CAIE B,ERFBM%	;IS IT BECAUSE FILE BEING MODIFIED?
BKIMP:	 JERR [BOOKKEEPING IMPOSSIBLE]
	SOJL C,BKIMP	;TRYNG TOO MANY TIMES?
	HLLZS CNTBLK+1	;YES. CLEAR ERROR CODE.
	MOVEI B,^D34	;WILL SLEEP 34MS (2 JIFFIES)
	HIBER B,
	 JEROP @BKIMP	;IF CAN'T SLEEP, CAN'T KEEP BOOK.
	JRST TRENT	;TRY AGAIN.
ENTOKB:	MOVEM A,CNTBLK+3	;RESET PPN.
	LOOKUP D2,CNTBLK	;GET TO READ
	 JRST .+2	;NOW TO HANDLE ERROR HERE
	 JRST LKPOKB
	HRRZ B,CNTBLK+1	;GET ERROR CODE
	CAIE B,ERFNF%	;IS IT BECAUSE FILE NO EXISTE?
	 JEROP @BKIMP	;ANY OTHER ERROR IMPOSSIBLE TO HANDLE.
	MOVEI B,DIR	;WILL MAKE DEVICE 2 POINT TO DIR BLOCK
	SETZM DIR+1	;WILL PLAY LIKE READ IN ALL 0'S.
	SETZM DIR+2
	SETZM DIR+3
	JRST INITB	;SO AS TO INITIALIZE BOOKKEEPING FILE.
LKPOKB:	IN D2,	;READ SQUASH.CNT
	 JRST .+2
	 JEROP @BKIMP
	HRRZ B,RD2+1	;POINTERS TO DATA IN BUFFERS
INITB:	OUTPUT D3,	;INITIALIZE OUT.
	HRRZ A,WD3+1
	AOS C,1(B)	;INCREMENT COUNT OF USES.
	MOVEM C,1(A)
	MOVE C,TOTM	;GET TOTAL DATA BLOCKS IN MASTER
	ADDI C,6	;2 FOR RIBS, 4 FOR ROUND
	IDIVI C,5
	IMULI C,5
	ADD C,2(B)
	MOVEM C,2(A)	;ADD TO TOTAL
	MOVE C,3(B)
	ADD C,TOTD	;ADD TOTAL BEFORE SQUASH
	MOVEM C,3(A)
	MOVEI C,3	;SET WORD COUNT
	HRRM C,(A)
	OUTPUT D3,
>
	JRST RELOUT	;EXIT WITH CON=RESET
	PAGE
	SUBTTL DATA AREA, UTILITY BLOCKS, LITERALS

PSVBLK:	EXP -1		;-1 IS WILDCARD.
	SIXBIT/REL/
	EXP -1
	SIXBIT/BAK/
	EXP -1
	SIXBIT/TMP/
	SIXBIT/SQUASH/
	SIXBIT/SHR/
	SIXBIT/SQUASH/
	SIXBIT/LOW/
	SIXBIT/SQUASH/
	SIXBIT/CNT/
	SIXBIT/MASTER/	;PASSOVER ENTRIES
	SIXBIT/SAV/	;FORMAT FOR ENTRIES IS AS SHOWN.
	SIXBIT/SQUASH/
	SIXBIT/HGH/
	SIXBIT/SQUASH/
	SIXBIT/SAV/
	-1
	SIXBIT/SFD/
	Z		;ZERO MARKS END OF BLOCK. MUST BE AT LEAST
		;ONE ENTRY.
CRLF:	BYTE (7)15,12	;CARRIAGE RETURN-LINE FEED
IFN BKON,<
CNTBLK:	SIXBIT/SQUASH/
	SIXBIT/CNT/	;BOOKKEEPING FILE
	EXP 122B8	;PROTECTION ON SQUASH.CNT
	Z
>
RD1:	BLOCK 3		;BUFFER HEADERS
RD2:	BLOCK 3
RD3:	BLOCK 3
WD1:	BLOCK 3
WD3:	BLOCK 3
DIR:	BLOCK 201	;STORAGE OF MASTER'S DIRECTORY
SVBLK:	BLOCK 200	;BLOCK ONE OF LIB FILE SAVED HERE.
FLBLK:	EXP 10	;LONG ENTER BLOCK FOR DATA FILES
	BLOCK 10	;USED TO SPECIFY FILE SIZE, SINCE KNOWN
LBLK:	EXP 11	;LONG RENAME BLOCK FOR LIBRARY FILE
	Z
	SIXBIT/MASTER/
	SIXBIT/LIB/
	BLOCK 7
UFDBLK:	Z
	SIXBIT/UFD/	;LOOKUP BLOCK FOR UFD.
	BLOCK 2
OVQINT:	XWD 4,OVQHND	;INTERRUPT BLOCK ON OVER QUOTA.
	EXP 1B31	;SET FOR OVER QUOTA ONLY
	BLOCK 2
FUGE3:	MOVE T2,DIR(T1)	;4 WORD REVERSE BLT ROUTINE FOR AC'S.
	MOVEM T2,DIR+4(T1)	;USED ONLY FOR PUSHING DIR DOWN IN
	SOJGE T1,A	;EATING A LIB FILE WRITTEN IN THE OLD FORMAT
	JRST DNPULL
	END SQUASH