Google
 

Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64a-sb - 10,7/klepto/klepto.mac
There are 3 other files named klepto.mac in the archive. Click here to see a list.
	TITLE	KLEPTO - THE KLEPTOMANIAC (A FAST RIPOFF)
	SUBTTL	DEFINITONS
	SEARCH	MAC10,JOBDAT,UUOSYM,COMMOD
	TWOSEG	760000			;MAKE ROOM FOR LARGE LOWSEG
	SALL				;SAVE THE FORESTS

;STEPHEN M. WOLFE
;MR1-2/S43
;DIGITAL EQUIPMENT CO.
;TECHNICAL SUPPORT GROUP (HOSS)
;200 FOREST ST.
;MARLBORO, MA., 01752
;(617) 467-5583

;AC'S
	F=0				;FLAGS
	T1=1				;TEMPS
	T2=T1+1
	T3=T2+1
	T4=T3+1
	P1=5				;PRESERVED
	P2=P1+1
	P3=P2+1
	P4=P3+1
	U=11				;ADDR OF UDB
	TC=12				;ADDR OF TCB
	FL=13				;ADDR OF FIL
	DDB=14				;ADDR OF DDB
	B=15				;ADDR OF BUFFER
	P=17				;PDL

;FLAGS
	F.DIR==1B35			;RIB OF DIRECTORY
	F.PRM==1B34			;PRIME RIB
	F.RIB==1B33			;ALREADY STEPPED OVER RIB
	F.SUM==1B32			;ALREADY DID CHECKSUM
	F.STR==1B31			;STR DATA FROZEN
	F.HW==1B30			;HIGH WATER
	F.VHW==1B29			;VERY HIGH WATER (PANIC)
	F.P2==1B28			;PASS 2
	F.SAT==1B27			;SAT.SYS
	F.TTY==1B26			;OUTPUT TO PHYSICAL TTY
	F.702==1B25			;7.02 MONITOR (OR LATER)
	F.SHC==1B24			;SAT HAS CHANGED
	F.TTC==1B23			;USE TTCALL
	F.LOK==1B22			;I OWN THE INTERLOCK
	F.NOC==1B21			;NO CTRL-C ALLOWED
	F.CC==1B20			;CTRL-C WAS TYPED
	F.SIL==1B19			;NO OUTPUT TO LOG FILE (TTCALL ONLY)
	F.ALL==1B18			;WE ARE DOING ALL

;ASSEMBLY PARAMETERS
	PAGLSH==11			;BITS PER PAGE
	PAGSIZ==1_PAGLSH		;WORDS PER PAGE
	IFNDEF	BADDR,<BADDR==3>	;NUMBER OF BAD CFPS IT TAKES TO
					;DECLARE THAT DIR IS CLOBBERED
	IFNDEF	UPN,<UPN==2>		;PAGES TO ALLOCATE AT A TIME
	NSTR==^D36			;NUMBER OF STRS
	IFNDEF	NSEC,<NSEC==2>		;SECONDS TO SLEEP
	IFNDEF	MINVRT,<MINVRT=^D512>	;MINIMUM AMOUNT OF SWAP SPACE
	IFNDEF	DOWNN,<DOWNN==5>	;NUMBER OF PAGES TO RELEASE
	PDLSIZ==200			;SIZE OF PDL
	BLKSIZ==200			;SIZE OF A DISK BLOCK
	FOOSIZ==33			;SIZE OF SCRATCH SPACE
	NUNT==^D15			;MAX UNITS IN A STR
	IFG	<1_ACSUN1>-1-NUNT,<PRINTX NUNT TOO SMALL>
	IFNDEF	NSLT,<NSLT==10>		;NUMBER OF COPIES OF KLEPTO
	IFNDEF	NHCOR,<NHCOR==640>	;NUMBER OF WORDS OF HISEG FREE CORE
	IFNDEF	FTCIH,<FTCIH==0>	;CODE IN HISEG
					;THERE IS A BUG IN SETUWP
					;WHICH LEAVES THE HISEG UNCACHED
	IFNDEF	LPTWID,<LPTWID==^D132>	;WIDTH OF LPT
	IFNDEF	LNM,<LNM=='STR'>	;LOGICAL NAME
	IFNDEF	MAXSAF,<MAXSAF==^D500>	;MAX SAFETY BLOCKS PER UNIT
	IFNDEF	NDDBS,<NDDBS==5>	;NUMBER OF DDBS
	IFNDEF	NBLK,<NBLK==^D25>	;NUMBER OF BLOCKS TO READ AT ONCE
	IFNDEF	NSKP,<NSKP==^D9>	;NUMBER OF BLOCKS WE ARE WILLING
					; TO SKIP (CALIBRATED FOR AN RP06)
	IFNDEF	DSKP,<DSKP==^D20>	;BPT ON AN RP06
	IFNDEF	FTDBUG,<FTDBUG==-1>	;DEBUGGING CODE
	IFNDEF	FTCHK,<FTCHK==0>	;CODE TO CHECK TREE CONSISTENCY
	IFNDEF	FTGCHK,<FTGCHK==0>	;CODE TO CHECK CONSISTENCY OF GARBAGE
	IFNDEF	TREG,<TREG==^D20>	;THRESHOLD FOR TYPING REGIONS
	IFNDEF	RMAR,<RMAR==^D15>	;RIGHT MARGIN
	IFNDEF	HWN,<HWN==6>		;HIGH WATER NUMERATOR
	IFNDEF	HWD,<HWD==7>		;HIGH WATER DEMONINATOR
	IFNDEF	VHWN,<VHWN==7>		;VERY HIGH WATER NUMERATOR
	IFNDEF	VHWD,<VHWD==^D8>	;VERY HIGH WATER DEMONINATOR

;OPDEFS
	OPDEF	PJRST[JRST]		;POPPING JRST
	DEFINE	FALL(AA),<IF2 <IFN AA-.,<PRINTX CANNOT FALL TO AA>>>

;CH'S
	TL==16				;TEMP LOG
	TO==17				;LOG FILE

;MONITOR SYMBOLS
	KONCPU==32			;THE 7.01 VERSION OF THIS SYMBOL
	UNI2ND==72			;THE 7.01 VERSION OF THIS SYMBOL

;ABBREVIATIONS:
;CC=CLUSTER COUNT
;CS=CHECK SUM
;CA=CLUSTER ADDRESS
;BN=BLOCK NUMBER (USUALLY RELATIVE TO STR)
;RTP=RETRIEVAL POINTER
;FORMAT OF TCB (TASK CONTROL BLOCK)
	TCBLNK==0			;LH=BACKWARD, RH=FORWARD
	TCBSON==1			;LH=LEFT SON, RH=RIGHT SON
	TCBRNT==2			;LH=ADDR OF PARENT TCB
	TCBBAL==2			;BALANCE FACTOR (HEIGHT OF LEFT SUBTREE
					; MINUS HEIGHT OF RIGHT SUBTREE)
		TCSBAL==3
		TCNBAL==^D20
		BALMO==1		;TOO RIGHT HEAVY
		BALM==2			;RIGHT HEAVY (ACCEPTABLY SO)
		BALZ==3			;PERFECTLY BALANCED
		BALP==4			;LEFT HEAVY (ACCEPTABLY SO)
		BALPO==5		;TOO LEFT HEAVY
	TCBGAR==2			;SIZE (GC ONLY)
		TCSGAR==^D15
		TCNGAR==^D35
		TCMGAR==<1_TCSGAR>-1
	TCBCOD==3			;FUNCTION CODE
		TCSCOD==3
		TCNCOD==2
	TCBRBC==3			;(RIB ONLY) COUNT OF RIBS
		TCSRBC==^D8		;I.E. PRIME RIB IS NUMBER 0
		TCNRBC==^D10
		IFG DESRBC-TCSRBC,<PRINTX TCSRBC TOO SMALL>
	TCBCX==3			;CHANNEL INDEX (OF DDB)
		TCSCX==4		; THIS FIELD ONLY FILLED IN FOR
		TCNCX==^D14		; ONE TCB PER BUFFER
		CXACT==<1_TCSCX>-1	;TRUST ME, I'M ACTIVE
		IFG NDDBS-<CXACT-1>,<PRINTX NDDBS TOO LARGE>
	TCBCOR==3			;(EXTENDED RIB) FILE IS
		TCPCOR==1B15		;CORRUPT, IT HAS FREE
					;AND/OR MULTIPLY USED CLUSTERS
	TCBMBB==3			;MIGHT BE BAD
		TCPMBB==1B16		;THIS BLOCK IS SUSPECTED OF HAVING
					;AN I/O ERROR
	TCBFIL==3			;RH=ADDR OF FIL
	TCBBLK==4			;BN RELATIVE TO STR
	TCBFLR==5			;(EXTENDED RIB) CONTENTS OF RIBFLR
	TCBREL==5			;(SUM+DIR) BN RELATIVE TO FILE
	TCBSUM==6			;(SUM ONLY) CHECKSUM
	TCBSIZ==6			;(EXTENDED RIB) RIBSIZ FROM PRIME RIB
	TCBLFT==7			;(EXTENDED RIB) BLOCKS LEFT IN RIBALC
	TCBCST==10			;(CORRUPT EXTENDED RIB)
					; COPY OF F2CST AND M2CST

;FORMAT OF FIL (FILE BLOCK)
	FILNAM==0			;FILE NAME
	FILEXT==1			;LH=EXTENSION
	FILDAD==FILEXT			;RH=PARENT FIL (0 IF MFD)
	FILCFP==2			;LH=CFP FOR THIS FILE
					;USED IN CHECKING RIBUFD
	FILCNT==2			;USE COUNT
		FISCNT==^D18
		FINCNT==^D35
;FORMAT OF A REG (REGION)
	REGNXT==0			;RH=NEXT REGION
	REGLOW==1			;LOWEST CLUSTER IN REGION
	REGHI==2			;HIGHEST CLUSTER IN REGION

;FORMAT OF A CST (CLUSTER LIST HEADER)
	CSTREG==0			;RH=ADDR OF 1ST REG
	CSTNUM==1			;TOTAL CLUSTERS IN ALL REGIONS
	CSTCNT==2			;TOTAL NUMBER OF REGIONS

;FORMAT OF A DDB
	DDBHDR==0			;RING HEADER (3 WORDS)
	DDBLBN==3			;LOW BN
	DDBHBN==4			;HIGH BN
	DDBPUN==5			;PHYS UNIT NAME CURRENTLY OPEN
	DDBBUF==6			;ADDR OF BUFFER
	DDBCH==7			;CHANNEL NUMBER
	DDBCX==10			;CHANNEL INDEX (INTO USRJDA)
	DDBTCB==11			;1ST TCB
	DDBDON==12			;NON-0 IF I/O DONE
	DDBERR==13			;NON-0 IF I/O ERROR

;FORMAT OF SNF
	SNFNXT==0			;NEXT SNF ON SYSTEM
	SNFLNK==1			;NEXT SNF THIS LIST
	SNFNAM==2			;NAME OF STR
	SNFCHN==3			;BIT MASK OF CHANNELS
	SNFVRT==4			;PAGES OF SWAPPING SPACE (0 IF NOT ASL)

;FORMAT OF A CNF
	CNFNXT==0			;ADDR OF NEXT CNF
	CNFNAM==1			;PHYS NAME OF UNIT
	CNFALT==2			;NAME OF ALTERNATE PORT
	CNFSTR==3			;NAME OF STR
	CNFCHN==4			;BIT MASK OF CHANNELS
	CNFVRT==5			;PAGES OF SWAPPING SPACE (0 IF NOT ASL)

;LOG FILE
	LOGNXT==0			;ADDR OF NEXT LOG
	LOGDEV==1			;STR NAME FILE IS ON
	LOGNAM==2			;FILENAME

;SIZES
	SIZFIL==3			;SIZE OF FIL
	SIZDIR==6			;SIZE OF DIR TCB
	SIZSUM==7			;SIZE OF SUM TCB
	SIZRIB==5			;SIZE OF PRIME RIB TCB
	SIZXRB==10			;SIZE OF EXTENDED RIB TCB
	SIZCXR==SIZXRB+SCSTL		;SIZE OF CORRUPT EXTENDED RIB
	SIZREG==3			;SIZE OF REG
	SIZCST==3			;SIZE OF CST
	SIZDDB==14			;SIZE OF DDB
	SIZGAR==3			;SIZE OF SMALLEST BLOCK
	SIZCNF==6			;SIZE OF CNF
	SIZLOG==3			;SIZE OF LOG FILE
	SIZSNF==5			;SIZE OF SNF
	SUBTTL	EDIT HISTORY

	VWHO==0		;DEC
	VMAJOR==1
	VMINOR==0
	VEDIT==1	;6-8-84/SMW DEVELOPEMENT COMPLETED,
			;COMMENCE EDIT HISTORY

	LOC	.JBVER
	BYTE	(3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT
	SUBTTL	DATA AREAS
	RELOC	0
FAST:	BLOCK	1			;FIRST WORD IN CORE (UNUSED)
CRSHAC:	BLOCK	20			;ACS SAVED BY DIE
TDEV:	BLOCK	3			;OPEN BLOCK FOR TEMP LOG
LDEV:	BLOCK	3			;OPEN BLOCK FOR LOG FILE
LFIL:	BLOCK	.RBEXT+1		;ENTER BLOCK FOR LOG FILE
TFIL:	BLOCK	.RBEXT+1		;LOOKUP/ENTER BLOCK FOR TEMP LOG
PTH:	BLOCK	.PTMAX			;PATH OF LOG FILE
	PTHL==.-PTH
SVWCNT:	BLOCK	1			;SAVED VALUE OF WRDCNT
WRDCNT:	BLOCK	1			;WORDS ALLOCATED
FREMEM:	BLOCK	1			;1ST FREE CORE BLOCK
SSL:	BLOCK	NSTR*3+.FSDSO		;ARG BLOCK FOR CHANGING SSL
FOO:	BLOCK	FOOSIZ			;SCRATCH SPACE
SYSPPN:	BLOCK	1			;PPN OF SYS
MFDPPN:	BLOCK	1			;PPN OF MFD
FFAPPN:	BLOCK	1			;OPR PPN
ROOT:	BLOCK	1			;ROOT NODE
QTCB:	BLOCK	1			;TCB QUEUE
DEV:	BLOCK	3			;OPEN BLOCK
IBUF:	BLOCK	3			;RING HEADER FOR TEMP LOG
OBUF:	BLOCK	3			;RING HEADER FOR LOG FILE
SAVBUF:	BLOCK	1			;ADDR OF 1ST BUF FOR LOG FILE
HW:	BLOCK	1			;HIGH WATER LEVEL
VHW:	BLOCK	1			;VERY HIGH WATER LEVEL
ZER:!					;ZERO AT BEGINNING OF STR
LSTCST:	BLOCK	SIZCST			;LOST CLUSTERS
FRECST:	BLOCK	SIZCST			;FREE CLUSTERS
MULCST:	BLOCK	SIZCST			;MULTIPLY USED CLUSTERS
BADCST:	BLOCK	SIZCST			;BAD CLUSTERS
					;THIS LIST CONTAINS ONLY THOSE
					;BAD BLOCKS WHICH WERE NOT
					;INCLUDED IN BADBLK.SYS
ZERL==.-ZER				;LENGTH
SCST:!					;ZERO AT BEGINING OF PASS 2 RIB
F2CST:	BLOCK	SIZCST			;FREE CLUSTERS THIS RIB
M2CST:	BLOCK	SIZCST			;MULTIPLY USED CLUSTERS THIS RIB
SCSTL==.-SCST				;LENGTH
HPOS:	BLOCK	1			;HORIZONTAL POSITION OF CURSOR
MARGIN:	BLOCK	1			;VALUE OF HPOS AT RIGHT MARGIN
ACTCNT:	BLOCK	1			;NUMBER OF ACTIVE DDBS
DDBS:	BLOCK	1			;NUMBER OF DDBS TOTAL
DONCNT:	BLOCK	1			;USED BY FNDDON
USRJDA:	BLOCK	NDDBS+1			;ADDR OF DDB
TBUDB:	BLOCK	NUNT			;ADDR OF UDB (NOT IN ORDER)
DEFIN:	BLOCK	.FSNUN			;DEFINE A STR
TABUDB:	BLOCK	NUNT			;ADDR OF UNIT DATA BLOCK
	DEFINL==.-DEFIN			;SIZE OF ARG BLOCK
LOGSTR:	BLOCK	1			;STR LOG FILE IS ON
OURCPU:	BLOCK	1			;CURRENT CPU (BIT MASK)
OVERN:	BLOCK	1			;NUMBER OF BAD FREE CLUSTERS
MYSGN:	BLOCK	1			;MY HISEG NUMBER
MYSLT:	BLOCK	1			;MY SLOT NUMBER
MYJOB:	BLOCK	1			;MY JOB NUMBER
RUNSTR:	BLOCK	1			;STR PROGRAM WAS RUN FROM
LOGS:	BLOCK	1			;ADDR OF 1ST LOG
MONVER:	BLOCK	1			;MONITOR VERSION
MYSNF:	BLOCK	1			;ADDR OF SNF WE ARE DOING
PDL:	BLOCK	PDLSIZ			;PUSH DOWN LIST
CMD:	BLOCK	2			;COMMAND LIST
SAVPC:	BLOCK	1			;COPY OF .EROPC

;THESE LOCATIONS ARE USED AS LOCAL VARIABLES INSIDE DORIB
DRPHY:	BLOCK	1	;BN RELATIVE TO STR
DRBLK:	BLOCK	1	;BN RELATIVE TO STR (WORKING COPY)
DRCA:	BLOCK	1	;CLUSTER ADDRESS
DRCS:	BLOCK	1	;CHECKSUM
DRCC:	BLOCK	1	;CLUSTER COUNT
DRCNT:	BLOCK	1	;BLOCKS LEFT IN THIS CLUSTER
DRLFT:	BLOCK	1	;BLOCKS LEFT TILL RIBALC RUNS OUT
DRREL:	BLOCK	1	;BN RELATIVE TO FILE
DRSIZ:	BLOCK	1	;RIBSIZ IN BLOCKS
	SUBTTL	STRUCTURE DATA BLOCK
	DEFINE	SE(AA),<
	IFN	.-SDB-AA,<PRINTX BB IS WRONG>
	BLOCK	1>

SDB:!
ALIAS:	SE	.FSSNM	;NAME STR MOUNTED AS
NUN:	SE	.FSSNU	;NUMBER OF UNITS
HLBN:	SE	.FSSHL	;HIGHEST LOGICAL BLOCK NUMBER
SSIZ:	SE	.FSSSZ	;SUM OF UDBBPU
	SE	.FSSRQ	;RESERVED QUOTA
	SE	.FSSRF	;RESERVED QUOTA LEFT
STAL:	SE	.FSSTL	;SUM OF UDBTAL
SOVR:	SE	.FSSOD	;OVERDRAW
SPT1:	SE	.FSSMP	;1ST RTP FOR MFD
S1PT:	SE	.FSSML	;NON-0 IF MFD ONLY HAS 1 RTP
SUN1:	SE	.FSSUN	;1ST UNIT FOR MFD
STRY:	SE	.FSSTR	;RETRIES ON ERROR
BIGBPU:	SE	.FSSBU	;BIGGEST UDBBPU
BPSC:	SE	.FSSBC	;BLOCKS PER SUPER CLUSTER
SCPU:	SE	.FSSSU	;SUPER CLUSTERS PER UNIT
	SE	.FSSIG	;IGNORED
CCBP:	SE	.FSSCC	;BP TO CLUSTER COUNT
CSBP:	SE	.FSSCK	;BP TO CHECKSUM
CABP:	SE	.FSSCA	;BP TO CLUSTER ADDRESS
SPVS:	SE	.FSPVT	;NON-0 IF PRIVATE STR
SPPN:	SE	.FSPPN	;OWNER PPN
CRSBN:	SE	.FSSCR	;BN (REL TO STR) OF CRASH.EXE
SK4C:	SE	.FSK4C	;K FOR CRASH
	SZSDB==.-SDB	;PORTION OF SDB PASSED TO STRUUO
BPC:	BLOCK	1	;BLOCKS PER CLUSTER
BPCS:	BLOCK	1	;BITS PER CHECKSUM
MBPCS:	BLOCK	1	;MINUS BITS PER CHECKSUM
BPLU:	BLOCK	1	;BLOCKS PER LARGEST UNIT
HUN:	BLOCK	1	;HIGHEST UNIT NUMBER
STRNAM:	BLOCK	1	;NAME OF STR (IN HOME BLOCKS)
MFDBN:	BLOCK	1	;BN OF RIB OF MFD
WL:	BLOCK	1	;SOME UNIT IN STR IS WRITE LOCKED
SDL:	BLOCK	1	;POSITION IN SDL OR -1
PSSL:	BLOCK	1	;POSITION IN SSL OR 0
SSLSTS:	BLOCK	1	;STATUS OF THIS STR IN SSL
	SUBTTL	UNIT DATA BLOCK
	ZZ==0
	DEFINE	ITM(AA),<
	AA==ZZ
	ZZ==ZZ+1>

	DEFINE	ITEM(AA,BB),<
	IFN	BB-ZZ,<PRINTX BB IS WRONG>
	ITM	AA>

;UNIT DATA BLOCK (UDB)
	ITEM	UDBNAM,.FSUNM		;UNIT NAME
	ITEM	UDBHID,.FSUID		;PACK SERIAL NUMBER (SIXBIT)
	ITEM	UDBLOG,.FSULN		;LOGICAL UNIT NAME (E.G. DSKB0)
	ITEM	UDBLUN,.FSULU		;LOGICAL UNIT NUMBER
	ITEM	UDBAWL,.FSUDS		;STATUS (E.G. SOFWARE WRITE-LOCK)
	ITEM	UDBGRP,.FSUGP		;BLOCKS TO TRY ALLOCATING ON OUTPUT
	ITEM	UDBTAL,.FSUTL		;BLOCKS LEFT (MINUS SAFETY FACTOR)
	ITEM	UDBBPC,.FSUBC		;BLOCKS PER CLUSTER
	ITEM	UDBCPS,.FSUCS		;CLUSTERS PER SAT
	ITEM	UDBWPS,.FSUWS		;WORDS PER SAT
	ITEM	UDBSIC,.FSUSC		;SATS IN CORE
	ITEM	UDBSPU,.FSUSU		;SATS PER UNIT
	ITEM	UDBSPT,.FSUSP		;POINTER TO SPT
	ITEM	UDBSLB,.FSUSB		;1ST BLOCK FOR SWAPPING
	ITEM	UDBK4S,.FSUKS		;K FOR SWAPPING
	SZUDB==ZZ			;PORTION OF UDB PASSED TO STRUUO
	ITM	UDBBLK			;BN WHERE UNIT START (RELATIVE TO STR)
	ITM	UDBSSF			;ENTRIES IN SPT SO FAR
	ITM	UDBBPU			;BLOCKS PER UNIT
	ITM	UDBHLB			;HIGHEST LEGAL BLOCK
	ITM	UDBCYL			;BLOCKS PER CYLINDER
	ITM	UDBBPT			;BLOCKS PER TRACK
	ITM	UDBPST			;POINTER TO TABLE OF POINTERS
					;INDEX BY SAT NUMBER, TABLE GIVES
					;POINTER TO SAT BLOCK
	ITM	UDBHWP			;NON-0 IF HARDWARE WRITE PROTECT
	ITM	UDBASL			;POSITION IN ASL OR -1
	ITM	UDBALT			;NAME OF ALTERNATE PORT
	ITM	UDBCPU			;CPU SPECIFICATION (7.01 ONLY)
	ITM	UDBSKP			;BLOCKS TO SKIP
	SIZUDB==ZZ			;SIZE OF UDB
	SUBTTL	SHARED WRITEABLE HISEG
	RELOC				;TO HISEG

JBTJOB:	BLOCK	NSLT			;TABLE OF JOB NUMBERS
JBTCHN:	BLOCK	NSLT			;BIT MASK OF CHANNELS
LOKJOB:	0				;JOB THAT OWNS INTERLOCK
ILOCK:	-1				;THE INTERLOCK
BLST:	BLOCK	1			;LIST OF UNPROCESSED STRS
ALST:	BLOCK	1			;LIST OF STRS ALREADY DONE
SLST:	BLOCK	1			;LIST OF ALL STRS ON SYSTEM
JBTLOG:	BLOCK	NSLT			;STR NAME LOG IS OPEN ON
JBTSTR:	BLOCK	NSLT			;STR NAME IN PROGRESS
CNTSLT:	0				;NUMBER OF SLOTS IN USE
CONFIG:	BLOCK	1			;POINTER TO LIST OF CNF'S
CHNNAM:	BLOCK	^D36+1			;TABLE OF NAMES OF CHANNELS
HFF:	BLOCK	1			;FIRST FREE ADDR IN HISEG
HCOR:	BLOCK	NHCOR			;HISEG FREE CORE
	SUBTTL	IMPURE DATA

	RELOC				;BACK TO LOWSEG
IFN FTCIH,<
LOW:!	RELOC				;BACK TO HISEG
HI:	PHASE	LOW
>
INTR:	XWD	4,TRAP			;INTERRUPT BLOCK
	ER.ICC				;CTRL-C ONLY
	BLOCK	2

;END OF IMPURE CODE
IFN FTCIH,<
	DEPHASE
	LOWL==.-HI			;SIZE OF IMPURE DATA
	RELOC				;BACK TO LOWSEG
	BLOCK	LOWL			;ALLOCATE SPACE
	RELOC				;BACK TO HISEG
>
	SUBTTL	BYTE POINTERS

FIYCNT:	POINT	FISCNT,FILCNT(FL),FINCNT ;USE COUNT
FIZCNT:	POINT	FISCNT,FILCNT(P3),FINCNT ;USE COUNT
RIYRBA:	POINT	DESRBA,RIBXRA(B),DENRBA	;RIB ADDRESS
RIYRBU:	POINT	DESRBU,RIBXRA(B),DENRBU	;RIB UNIT
TCWCOD:	POINT	TCSCOD,TCBCOD(T1),TCNCOD ;FUNCTION CODE
TCXCOD:	POINT	TCSCOD,TCBCOD(T2),TCNCOD ;FUNCTION CODE
TCZCOD:	POINT	TCSCOD,TCBCOD(P2),TCNCOD ;FUNCTION CODE
TCYCOD:	POINT	TCSCOD,TCBCOD(TC),TCNCOD ;FUNCTION CODE
TCXRBC:	POINT	TCSRBC,TCBRBC(T2),TCNRBC ;RIB COUNT
TCYRBC:	POINT	TCSRBC,TCBRBC(TC),TCNRBC ;RIB COUNT
TCZRBC:	POINT	TCSRBC,TCBRBC(P2),TCNRBC ;RIB COUNT
BAYNBB:	POINT	BASNBB,BAFNBB(P2),BANNBB ;NUMBER BAD BLOCKS IN REGION-1
BAYNBR:	POINT	BASNBR,BAFNBR(B),BANNBR	;NUMBER OF BAD REGIONS
TCXBAL:	POINT	TCSBAL,TCBBAL(T1),TCNBAL ;BALANCE FACTOR
TCZBAL:	POINT	TCSBAL,TCBBAL(T2),TCNBAL ;BALANCE FACTOR
TCWBAL:	POINT	TCSBAL,TCBBAL(T3),TCNBAL ;BALANCE FACTOR
TCVBAL:	POINT	TCSBAL,TCBBAL(T4),TCNBAL ;BALANCE FACTOR
TCYCX:	POINT	TCSCX,TCBCX(TC),TCNCX	;CHANNEL INDEX
TCXCX:	POINT	TCSCX,TCBCX(T1),TCNCX	;CHANNEL INDEX
TCZCX:	POINT	TCSCX,TCBCX(T2),TCNCX	;CHANNEL INDEX
DEYSIZ:	PNTR	@DDBBUF(DDB),BF.SIZ	;SIZE OF BUFFER
TCXGAR:	POINT	TCSGAR,TCBGAR(T2),TCNGAR ;SIZE OF GARBAGE
TCZGAR:	POINT	TCSGAR,TCBGAR(T4),TCNGAR ;SIZE OF GARBAGE
TCWGAR:	POINT	TCSGAR,TCBGAR(T3),TCNGAR ;SIZE OF GARBAGE
SPYCLA:	POINT	CLASIZ,(T2),CLAPOS	;CA PART OF SPT
SPYTAL:	POINT	TALSIZ,(T2),TALPOS	;CC PART OF SPT
	SUBTTL	INITIALIZATION

KLEPTO:	JFCL				;NO CCL
	RESET				;STOP I/O
	MOVE	P,[IOWD PDLSIZ,PDL]	;SETUP PDL
	SETZ	F,			;SETUP FLAGS
IFN FTCIH,<
	MOVE	T1,[XWD HI,LOW]		;COPY IMPURE DATA
	BLT	T1,LOW+LOWL-1
>
	MOVEI	T1,INTR			;CTRL-C TRAP
	HRRM	T1,.JBINT
	SETZM	WRDCNT			;NO CORE ALLOCATED YET
	SETZM	FREMEM
	PUSHJ	P,MAKDDB		;BUILD DDBS
	SETOM	OURCPU			;ASSUME ALL CPUS
	MOVE	T1,[%LDMFD]		;PPN OF MFD
	GETTAB	T1,
	 PUSHJ	P,DIE
	MOVEM	T1,MFDPPN
	MOVE	T1,[%LDFFA]		;PPN OF OPR
	GETTAB	T1,
	 PUSHJ	P,DIE
	MOVEM	T1,FFAPPN
	HRROI	T1,.GTPPN		;OUR PPN
	GETTAB	T1,
	 PUSHJ	P,DIE
	CAME	T1,FFAPPN		;ARE WE THE OPR?
	JRST	NOTOPR			;NO
	MOVE	T1,[%LDSYS]		;PPN OF SYS
	GETTAB	T1,
	 PUSHJ	P,DIE
	MOVEM	T1,SYSPPN
	PJOB	T1,			;MY JOB NUMBER
	MOVEM	T1,MYJOB
	HRROI	T1,.GTSGN		;MY HISEG NUMBER
	GETTAB	T1,
	 PUSHJ	P,DIE
	HRRZM	T1,MYSGN
	SETZ	T1,			;WRITE ENABLE THE HISEG
	SETUWP	T1,
	 PUSHJ	P,DIE
	PUSHJ	P,GETLOK		;GET INTERLOCK
	PUSHJ	P,ALIVE			;MAKE SURE EVERYBODY ALIVE
	PUSHJ	P,GETSLT		;GET A SLOT NUMBER
	PUSHJ	P,LUNIT			;BUILD LIST OF UNITS
	PUSHJ	P,BDALL			;BUILD LIST OF STRS
	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	PUSHJ	P,OPENLG		;OPEN DEVICE FOR LOG
	PUSHJ	P,SWATER		;SET WATER LEVEL
	SETZM	LOGS			;NO TMP LOGS YET
	MOVSI	T1,LNM			;ALL?
	DEVNAM	T1,
	 JRST	NOSTR
	CAMN	T1,[SIXBIT /ALL/]
	JRST	DOALL			;YES
	PUSHJ	P,GETLOK		;GET INTERLOC
	PUSHJ	P,PIKONE		;TELL THE WORLD WHICH STR
	 JRST	XIT
	PUSHJ	P,PIKLOG		;PICK STR FOR LOG
	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	PUSHJ	P,DOSTR			;PROCESS THE STR
	PUSHJ	P,GETLOK		;GET INTERLOCK BACK
	PUSHJ	P,ALIVE			;CHECK IF EVERYBODY ALIVE
	PUSHJ	P,DONSTR		;TELL THE WORLD WE ARE DONE
	JRST	XIT			;EXIT
;HERE TO DO ALL THE STR'S ON THE SYSTEM
DOALL:	HRROI	T1,.GTRDV		;GET STR RUN FROM
	GETTAB	T1,
	 PUSHJ	P,DIE
	MOVEM	T1,RUNSTR
	PUSHJ	P,GETLOK		;GET INTERLOCK
	TRO	F,F.ALL			;WE ARE DOINT ALL
DOALL1:	PUSHJ	P,PIKSTR		;PICK A STR
	 JRST	XIT			;NONE
	PUSHJ	P,PIKLOG		;PICK A STR FOR LOG FILE
	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	PUSHJ	P,GC			;COLLECT GARBAGE
	PUSHJ	P,CDOWN			;GIVE CORE AWAY
	PUSHJ	P,DOSTR			;PROCESS THE STR
	PUSHJ	P,GETLOK		;GET INTERLOCK
	PUSHJ	P,ALIVE			;SEE IF ANYBODY DIED
	PUSHJ	P,DONSTR		;FLAG THAT STR IS DONE
	PUSHJ	P,CPYLG			;COPY TMP LOG
	 JFCL
	SETZM	RUNSTR			;OK TO DO RUN STR NOW
	JRST	DOALL1			;LOOP

;HERE IF NOT OPR
NOTOPR:	OUTSTR	[ASCIZ /Must be OPR
/]
	EXIT

;HERE IF LOGICAL NAME ISN'T ASSIGNED
NOSTR:	OUTSTR	[ASCIZ /STR isn't assigned
/]
	PUSHJ	P,GETLOK		;GET INTERLOCK
XIT:	PUSHJ	P,CPYLG			;COPY TMP LOG
	 JRST	XIT2			;DO IT LATER
	PUSHJ	P,GIVSLT		;GIVE UP SLOT NUMBER
	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	EXIT
XIT2:	PUSHJ	P,SLEEPY		;SLEEP AWHILE
	JRST	XIT
	SUBTTL	MAINSTREAM

;ROUTINE TO PROCESS A STR
DOSTR:	MOVE	T1,WRDCNT		;SAVE WORD COUNT
	MOVEM	T1,SVWCNT
	PUSHJ	P,BEGIN			;TELL WHICH STR WE ARE DOING
	MOVE	T1,[XWD QTCB,QTCB]	;QUEUE IS INITIALY EMPTY
	MOVEM	T1,QTCB
	SETZM	ROOT
	SETZM	ZER			;ZERO AT BEGINNING OF STR
	MOVE	T1,[XWD ZER,ZER+1]
	BLT	T1,ZER+ZERL-1
	TRZ	F,F.P2			;PASS 1
	PUSHJ	P,PUNT			;COMPILE TABLE OF UNITS
	PUSHJ	P,RDHOM			;READ HOME BLOCKS
	 JRST	BADHOM
	PUSHJ	P,RSTR			;REMOVE STR
	 JRST	DOSTR1
	PUSHJ	P,BDMFD			;BUILD TCB FOR MFD
DOPASS:	HRRZ	T1,QTCB			;CRANK UP I/O
	PUSHJ	P,CRANK0
	 PUSHJ	P,DIE
	HRRZ	TC,QTCB			;1ST TCB
LOOP:	LDB	T1,TCYCOD		;DISPATCH
	PUSHJ	P,@FUNX(T1)
	PUSHJ	P,SCHED			;PICK NEXT TCB
	 SETZ	T1,			;DONE WITH PASS 1
	PUSH	P,T1			;SAVE ADDR OF NEXT TCB
	PUSHJ	P,DECFIL		;DECREMENT USE COUNT ON FIL
	PUSHJ	P,UNLINK		;UNLINK TCB FROM TREE
	PUSHJ	P,UNLNK			;UNLINK TCB FROM QUEUE
IFN FTCHK,<
	PUSHJ	P,CHECK			;CHECK CONSISTENCY
>
	PUSHJ	P,GIVTCB		;RETURN TCB TO FREE LIST
	POP	P,TC			;RESTORE ADDR OF NEXT TCB
	JUMPN	TC,LOOP

;HERE WHEN DONE WITH A COMPLETE PASS OF THE STR
	TRNE	F,F.P2			;DONE WITH PASS 1 OR 2?
	JRST	DONE2			;PASS 2
;HERE WHEN DONE WITH PASS ONE
IFN FTDBUG,<
	HRRZ	T1,QTCB			;FORGOT ANY TCBS?
	CAIE	T1,QTCB
	PUSHJ	P,DIE
>
	PUSHJ	P,DOSAT			;PROCESS SAT BLOCKS
	 JRST	DOSTR4			;CAN'T FIND SATS
	PUSHJ	P,CSTSO			;PRINT CST'S
	PUSHJ	P,BADOVR		;OVERLAP OF FREE AND BAD
	MOVEM	T1,OVERN
	PUSHJ	P,DEBAD			;DEALLOCATE BAD REGIONS
	PUSHJ	P,DELST			;DEALLOCATE LOST REGIONS
	PUSHJ	P,DEFRE			;DEALLOCATE FREE REGIONS
	SKIPN	T1,OVERN		;ANY OVERLAP?
	JRST	NOVR			;NO
	MOVEI	T2,[ASCIZ /All/]	;TOTAL OVERLAP?
	CAME	T1,FRECST+CSTNUM
	MOVEI	T2,[ASCIZ /Some/]	;NO, PARTIAL OVERLAP
	PUSHJ	P,STRO
	MOVEI	T2,[ASCIZ / free clusters are bad blocks/]
	PUSHJ	P,STRDSP
NOVR:	MOVE	T1,FRECST+CSTNUM	;FREE CLUSTERS
	SUB	T1,OVERN		;MINUS BAD FREE
	ADD	T1,MULCST+CSTNUM	;MULTIPLY USED CLUSTERS
	JUMPN	T1,DOP2			;GO IF NEED PASS TWO
	MOVEI	T2,[ASCIZ /No need for pass two/]
	PUSHJ	P,STRDSP
	JRST	DONE2			;DONE
;HERE TO START PASS TWO
DOP2:	MOVEI	T2,MULCST		;MARK MULTIPLY USED CLUSTERS IN
	PUSHJ	P,MARKC			; SAT SO THEY ARE EASY TO SPOT
	TRO	F,F.P2			;FLAG PASS TWO
	MOVEI	T2,[ASCIZ /Begining pass two/]
	PUSHJ	P,STRDSP
	PUSHJ	P,BDMFD			;BUILD TCB FOR MFD
	JRST	DOPASS

DOSTR1:	MOVEI	T2,[ASCIZ /Cannot remove STR, aborting/]
	JRST	DOSTR2

BADHOM:	MOVEI	T2,[ASCIZ /Error while reading home blocks, aborting/]
DOSTR2:	PUSHJ	P,STRDSP
	JRST	DOSTR4

;HERE WHEN DONE WITH PASS TWO
DONE2:	PUSHJ	P,DEMUL			;DEALLOCATE MULTIPLY USED REGIONS
	PUSHJ	P,ASTR			;PUT STR BACK
	 PUSHJ	P,DOSTR3
DOSTR4:	PUSHJ	P,DESTR			;DEALLOCATE CORE
	MOVE	T1,WRDCNT		;MISS SOMETHING?
	CAME	T1,SVWCNT
	PUSHJ	P,DIE			;BUG
	POPJ	P,

DOSTR3:	MOVEI	T2,[ASCIZ /Error while mounting STR/]
STRDSP:	PUSHJ	P,STRO
	PJRST	DSPACE
	SUBTTL	SCHEDULER

;TC PASSES ADDR OF PREVIOUS TCB
;T1 RETURNS ADDR OF NEXT TCB
;NOSKIP IF QUEUE IS EMPTY
SCHED:	LDB	T2,TCYCX		;FIND DDB
	MOVE	DDB,USRJDA(T2)
	MOVE	T1,TC			;START AT CURRENT TCB
SCHED3:	HRRZ	T1,TCBLNK(T1)		;GET NEXT TCB
	CAIN	T1,QTCB
	JRST	SCHED0
	MOVE	T2,TCBBLK(T1)		;IS IT IN CACHE?
	CAMLE	T2,DDBHBN(DDB)
	JRST	SCHED0			;NO
	PUSHJ	P,FITP			;FIT IN CORE?
	 JRST	SCHED3			;NO
SCHED2:	LDB	T2,TCYCX		;COPY CHANNEL INDEX
	DPB	T2,TCXCX
	JRST	CPOPJ1
SCHED0:	MOVE	T1,TC			;BACK TO BEGINING
SCHED4:	HLRZ	T1,TCBLNK(T1)		;GET PREVIOUS TCB
	CAIN	T1,QTCB
	JRST	SCHED1
	MOVE	T2,TCBBLK(T1)		;IS IT IN CACHE?
	CAMGE	T2,DDBLBN(DDB)
	JRST	SCHED1			;NO
	PUSHJ	P,FITP			;FIT IN CORE?
	 JRST	SCHED4			;NO
	JRST	SCHED2			;DO IT

;HERE IF CURRENT DDB IS EXHAUSTED
SCHED1:	SOS	ACTCNT			;ONE LESS USEFUL DDB
	MOVEI	T1,CXACT		;MARK ACTIVE BEFORE INVALIDATE
	DPB	T1,TCYCX
	SETOM	DDBHBN(DDB)		;INVALIDATE CACHE
	PUSHJ	P,CRANK			;CRANK UP SOME I/O
	 POPJ	P,			;NOTHING TO CRANK UP
	MOVE	T1,DDBTCB(DDB)		;1ST TCB IN THAT DDB
	JRST	CPOPJ1
;ROUTINE TO CRANK UP I/O:
;START UP A TRANSFER ON THIS DDB,
;AND WAIT FOR I/O TO FINISH ON SOME (OTHER) DDB.
;DDB PASSES CURRENT DDB
;TC PASSES CURRENT TCB
;SKIP IF THERE IS INDEED STUFF TO DO
CRANK:	PUSHJ	P,NEXT			;FIND A TCB TO START
	 JRST	CRANK1			;NONE
CRANK0:	PUSH	P,TC			;SAVE CURRENT TCB
	MOVE	TC,T1			;TCB TO START
	PUSHJ	P,LODTCB		;START IT
	POP	P,TC			;RESTORE CURRENT TCB
	MOVE	T1,ACTCNT		;ALL DDBS ACTIVE?
	CAMN	T1,DDBS
	JRST	CRANK2			;YES
	PUSHJ	P,FNDIDL		;NO, FIND ONE THAT'S IDLE
	JRST	CRANK			;START SOMETHING ON IT
CRANK1:	SETOM	DDBHBN(DDB)		;INVALIDATE CACHE
	SKIPN	ACTCNT			;ANY DDBS ACTIVE?
	POPJ	P,			;NO
CRANK2:	PUSHJ	P,FNDDON		;WAIT FOR SOME DDB TO FINISH
	JRST	CPOPJ1
;FIND AN IDLE DDB
;DDB RETURNS DDB
FNDIDL:	MOVEI	T1,1
FNDID1:	MOVE	DDB,USRJDA(T1)
	SKIPL	DDBHBN(DDB)
	AOJA	T1,FNDID1
	POPJ	P,

;WAIT TILL SOME DDB FINISHES I/O
;DDB RETURNS DDB
FNDDON:	PUSHJ	P,SAVE1			;SAVE AC
FNDDN1:	MOVE	P1,DDBS			;THIS MANY DDBS TO TEST
FNDDN2:	AOS	T1,DONCNT		;NEXT DDB TO TEST
	IDIV	T1,DDBS
	MOVE	DDB,USRJDA+1(T2)
	SKIPGE	DDBHBN(DDB)		;I/O ALREADY STARTED?
	JRST	FNDDN3			;NO
	SKIPN	DDBDON(DDB)		;I/O ALREADY DONE?
	PUSHJ	P,DOIN			;OR JUST FINISHED NOW?
	 POPJ	P,			;YES, A WINNER
FNDDN3:	SOJG	P1,FNDDN2		;TEST EACH DDB
	MOVE	T1,[HB.RIO+HB.RWJ+^D1000] ;NONE DONE, SLEEP AWHILE
	HIBER	T1,
	 HALT
	JRST	FNDDN1			;TRY AGAIN

;ROUTINE TO FIND THE CX OF A TCB (IF ANY)
;T1 PASSES TCB
;T2 RETURNS CX
;CPOPJ IF I/O NOT IN PROGRESS
;CPOPJ1 IF FOUND
FNDCX:	MOVE	T2,DDBS			;THIS MANY DDBS TO TEST
	MOVE	T3,TCBBLK(T1)		;BN OF THIS TCB
FNDCX1:	MOVE	T4,USRJDA(T2)		;ADDR OF DDB
	CAML	T3,DDBLBN(T4)		;BN IN CACHE?
	CAMLE	T3,DDBHBN(T4)
	SOJG	T2,FNDCX1		;NO, TEST NEXT DDB
	SKIPE	T2			;FOUND IT?
	AOS	(P)			;YES, SKIP
	POPJ	P,
;FIND NEXT TCB TO START I/O ON
;TC PASSES CURRENT TCB
;T1 RETURNS NEXT TCB
;CPOPJ1 IF OK
;CPOPJ IF NO TCB'S STARTABLE
NEXT:	PUSHJ	P,SAVE2			;SAVE AC
	PUSHJ	P,TWATER		;TEST WATER LEVEL
	MOVE	T2,TCBBLK(TC)		;FIND UDB
	IDIV	T2,BPLU
	HRRZ	U,TABUDB(T2)
	IDIV	T3,UDBCYL(U)		;CYL NUMBER
	IMUL	T3,UDBCYL(U)		;1ST BN THIS CYL
	ADD	T3,UDBBLK(U)		;BN RELATIVE TO STR
	MOVE	P1,T3			;SAVE IT IN A SAFE PLACE
	MOVE	P2,P1			;1ST BN ON NEXT CYL
	ADD	P2,UDBCYL(U)
NEXT14:	MOVE	T1,TC			;FIND LAST TCB IN PREVIOUS CYL
NEXT1:	HLRZ	T1,TCBLNK(T1)
	CAIN	T1,QTCB
	JRST	NEXT3
	CAMG	P1,TCBBLK(T1)
	JRST	NEXT1
;HERE TO FIND NEXT TCB THAT DOES NOT HAVE I/O ACTIVE
NEXT3:	HRRZ	T1,TCBLNK(T1)		;STEP TO NEXT TCB
	CAIN	T1,QTCB
	JRST	NEXT10			;NONE
NEXT13:	LDB	T2,TCXCX		;GET CHANNEL INDEX
	CAIN	T2,CXACT		;RESTARTING CURRENT DDB?
	JRST	NEXT3			;YES, PITCH IT
	JUMPN	T2,NEXT4		;I/O ACTIVE IF NON-0
	PUSHJ	P,FNDCX			;DON'T KNOW, SEARCH AND FIND OUT
	 JRST	NEXT6			;NOT ACTIVE
NEXT4:	MOVE	T2,USRJDA(T2)		;GET DDB ADDR
	MOVE	T2,DDBHBN(T2)		;HIGHEST BN IN TRANSIT
NEXT5:	HRRZ	T1,TCBLNK(T1)		;FIND 1ST TCB BEYOND THAT BN
	CAIN	T1,QTCB
	JRST	NEXT10
	CAML	T2,TCBBLK(T1)
	JRST	NEXT5
	JRST	NEXT13			;SEE IF IT'S ACTIVE
;HERE WITH T1=1ST TCB THAT DOES NOT HAVE I/O ACTIVE
NEXT6:	CAMG	P2,TCBBLK(T1)		;SAME CYL?
	JRST	NEXT7			;NO
	PUSHJ	P,FITP			;WILL TCB FIT IN CORE?
	 JRST	NEXT3			;NO
	JRST	CPOPJ1			;YES, A WINNER
;HERE IF MUST MOVE HEADS IN
;HERE WITH T1=1ST TCB ON NEXT CYL
NEXT7:	SKIPN	ACTCNT			;I/O ACTIVE ON THIS CYL?
	JRST	NEXT9			;NO, MOVE HEADS NOW
	POPJ	P,			;YES, DON'T MOVE TILL I/O DONE
NEXT8:	HRRZ	T1,TCBLNK(T1)
	CAIN	T1,QTCB
	JRST	NEXT11
;HERE IF MUST MOVE HEADS, FIND ANY TCB THAT WILL FIT IN CORE
NEXT9:	PUSHJ	P,FITP			;THIS ONE FIT?
	 JRST	NEXT8			;NO
	JRST	CPOPJ1			;YES, A WINNER
;HERE IF MUST MOVE HEADS OUT
;HERE WITH T1=QTCB
NEXT10:	SKIPE	ACTCNT			;I/O ACTIVE ON THIS CYL?
	POPJ	P,			;YES, DON'T MOVE TILL I/O DONE
;HERE IF MUST MOVE HEADS, FIND ANY TCB THAT WILL FIT IN CORE
NEXT11:	HRRZ	T1,TCBLNK(T1)		;STEP TO NEXT TCB
	CAMG	P1,TCBBLK(T1)		;BACK TO ORIGINAL CYL?
	JRST	NEXT15			;YES, NOTHING WE CAN DO
	PUSHJ	P,FITP			;THIS ONE FIT?
	 JRST	NEXT11			;NO
	JRST	CPOPJ1			;YES, A WINNER

;HERE IF ABSOLUTELY NOTHING TO DO
NEXT15:	TRZN	F,F.VHW			;IGNORE VHW (MAY GO VIRTUAL)
	TRZE	F,F.HW			;DIDN'T WORK, TRY IGNORING HW
	JRST	NEXT14
	POPJ	P,
	SUBTTL	WATER LEVEL

;ROUTINE TO SET THE WATER LEVEL(S)
;BY "HIGH WATER" WE MEAN THAT WE'RE LOW ON CORE AND SHOULD
;TRY TO BE MORE CONSERVATIVE.
SWATER:	MOVE	T2,[%NSCMX]		;GET CORMAX
	GETTAB	T2,
	 PUSHJ	P,DIE
	HRROI	T3,.GTCVL		;CURRENT PHYS LIMIT
	GETTAB	T3,
	 PUSHJ	P,DIE
	ANDI	T3,77777
	LSH	T3,PAGLSH
	CAMLE	T2,T3			;TAKE THE LOWER OF THE TWO
	MOVE	T2,T3
	HRRZ	T3,.JBHRL		;HIGHEST ADDR IN HISEG
	CAMLE	T2,T3			;TAKE THE LOWER OF THE TWO
	MOVE	T2,T3
	HLRZ	T3,.JBHRL		;MINUS SIZE OF HISEG
	SUB	T2,T3
	SUB	T2,.JBFF		;MINUS STUFF ALREADY USED
	ADD	T2,WRDCNT
	MOVE	T1,T2			;SAVE IT
	IMULI	T2,HWN			;COMPUTE FRACTION
	IDIVI	T2,HWD
	MOVEM	T2,HW			;HIGH WATER
	IMULI	T1,VHWN			;COMPUTE FRACTION
	IDIVI	T1,VHWD
	MOVEM	T1,VHW			;VERY HIGH WATER
	POPJ	P,

;ROUTINE TO TEST THE WATER LEVEL AND SET THE BITS IN F
TWATER:	MOVE	T1,WRDCNT		;HIGH WATER?
	CAMGE	T1,HW
	TRZA	F,F.HW+F.VHW		;NO
	TROA	F,F.HW			;YES
	POPJ	P,
	CAMGE	T1,VHW			;VERY HIGH WATER?
	TRZA	F,F.VHW			;NO
	TRO	F,F.VHW			;YES
	POPJ	P,
;ROUTINE TO TEST IF THERE'S ENOUGH CORE TO PROCESS A GIVEN TCB
;T1 PASSES ADDR OF TCB
;SKIP IF THERE'S ENOUGH CORE
;FNCSUM ALWAYS MAKES CORE SIZE SMALLER SO THEY'RE ALWAYS SAFE.
;FNCDIR ALWAYS MAKES YOU BIGGER SO NEVER DO THOSE IF YOU'RE LOW ON CORE.
;FNCRIB SOMETIMES MAKES YOU BIGGER AND SOMETIMES SMALLER, IT TAKES
;EXTENSIVE CHECKING.
;DIRECTORY RIBS ALWAYS MAKE YOU BIGGER.
;OTHER RIBS SOMETIMES MAKE YOU BIGGER AND SOMETIMES SMALLER, DEPENDING
;ON HOW MANY RTP'S HAVE TO BE CHECKSUMED. THERE'S NO WAY TO TELL
;WITHOUT ACTUALLY READING THE RIB. BUT MOST RIBS ONLY HAVE ONE RTP,
;AND WILL PROBABLY MAKE YOU SMALLER. WE TEND TO GIVE RIBS THE BENEFIT
;OF A DOUBT AND ASSUME THEY MAKE US SMALLER. IF, HOWEVER, WE'RE AT
;THE VERY HIGH WATER MARK, THEN BE VERY CONSERVATIVE AND DON'T PROCESS
;ANY RIBS. WE ASSUME THAT THE ONLY WAY TO GET TO THE VERY HIGH WATER MARK
;IS BY HAVING LOTS OF RIBS WITH LOTS OF RTP'S. THUS THERE MUST BE LOTS
;OF CHECKSUMS IN THE QUEUE. PROCESS ONLY THE CHECKSUMS.
FITP:	TRNN	F,F.HW			;HIGH WATER MARK?
	JRST	CPOPJ1			;NO, IT'S SAFE
	LDB	T2,TCWCOD		;YES, BETTER CHECK IT
	PJRST	@FUNHW(T2)

;ROUTINE TO TEST IF THERE'S ENOUGH CORE TO PROCESS A RIB
HWRIB:	HRRZ	T2,TCBFIL(T1)		;DIR?
	HLRZ	T2,FILEXT(T2)
	CAIE	T2,'SFD'
	CAIN	T2,'UFD'
	POPJ	P,			;YES, DON'T PROCESS
	TRNN	F,F.VHW			;VERY HIGH WATER?
	AOS	(P)			;NO, GIVE HIM BENEFIT OF DOUBT
	POPJ	P,			;YES, DON'T PROCESS
	SUBTTL	DISPATCH TABLES

	DEFINE	FUNC,<
	XX	FNCRIB,DORIB,SIZRIB,GIVRIB,HWRIB
	XX	FNCDIR,DODIR,SIZDIR,GIVBLK,CPOPJ
	XX	FNCSUM,DOSUM,SIZSUM,GIVBLK,CPOPJ1
>

	DEFINE	XX(AA,BB,CC,DD,EE),<
	AA==.-FUNX
	BB
>
FUNX:	FUNC

	DEFINE	XX(AA,BB,CC,DD,EE),<CC>
FUNSZ:	FUNC

	DEFINE	XX(AA,BB,CC,DD,EE),<DD>
FUNGV:	FUNC

	DEFINE	XX(AA,BB,CC,DD,EE),<EE>
FUNHW:	FUNC
	SUBTTL	PROCESS A RIB

DORIB:	PUSHJ	P,SAVE1			;PRESERVE ACS
	TRZ	F,F.DIR+F.RIB+F.PRM+F.SAT ;CLEAR FLAGS
	LDB	T1,TCYRBC		;PRIME RIB?
	SKIPN	T1
	TRO	F,F.PRM			;YES, LIGHT FLAG
	TRNN	F,F.P2			;WHICH PASS?
	JRST	DORIB5			;ONE
	SETZM	SCST			;TWO, ZERO CST
	MOVE	T1,[XWD SCST,SCST+1]
	BLT	T1,SCST+SCSTL-1
	MOVE	T1,TCBCOR(TC)		;SAVED CST?
	TRNN	F,F.PRM
	TLNN	T1,(TCPCOR)
	JRST	DORIB5			;NO
	MOVEI	T1,SCST			;YES, RESTORE IT
	HRLI	T1,TCBCST(TC)
	BLT	T1,SCST+SCSTL-1
DORIB5:	PUSHJ	P,REDTCB		;READ THE BLOCK
	 JRST	DORB10			;I/O ERROR
	PUSHJ	P,RBCK			;CHECK REASONABLENESS
	 JRST	DORB11
	MOVE	P1,RIBFIR(B)		;AOBJN TO RTP'S
	ADD	P1,B
	HRRZ	T1,FILDAD(FL)		;GO IN NOT MFD
	JUMPN	T1,DORIB6
	TRNN	F,F.PRM			;GO UNLESS PRIME RIB
	JRST	DORIB6
	SETZM	S1PT			;MFD ONLY HAS ONE RTP?
	SKIPN	2(P1)
	SETOM	S1PT			;YES
DORIB6:	HLRZ	T1,FILEXT(FL)		;DIRECTORY?
	CAIE	T1,'UFD'
	CAIN	T1,'SFD'
	TRO	F,F.DIR			;YES, SET FLAG
	CAIN	T1,'SYS'		;SET FLAG IF SAT.SYS
	TRO	F,F.SAT
	MOVS	T1,RIBNAM(B)
	MOVE	T2,RIBPPN(B)
	CAIN	T1,'SAT'
	CAME	T2,SYSPPN
	TRZ	F,F.SAT
	TRNN	F,F.PRM			;PRIME RIB?
	SKIPA	T1,TCBFLR(TC)		;NO, GET FLR FROM TCB
	MOVEI	T1,1			;YES, 1ST BLOCK
	MOVEM	T1,DRREL		;STORE 1ST LOGICAL RECORD
	MOVE	T1,RIBSIZ(B)		;SIZE OF FILE IN BLOCKS
	IDIVI	T1,BLKSIZ
	SKIPE	T2
	ADDI	T1,1
	TRNN	F,F.PRM			;PRIME RIB?
	MOVE	T1,TCBSIZ(TC)		;NO, GET SIZE FROM TCB
	MOVEM	T1,DRSIZ		;STORE SIZE
	TRNN	F,F.PRM			;PRIME RIB?
	SKIPA	T1,TCBLFT(TC)		;NO, GET LEFTOVER FROM TCB
	MOVE	T1,RIBALC(B)		;YES, FROM RIB
	MOVEM	T1,DRLFT		;STORE BLOCKS LEFT

;HERE TO PROCESS AN RTP
DORIB1:	SKIPN	T1,(P1)			;PICK UP RTP
	JRST	DORIB2			;EOF
	LDB	T2,CCBP			;GET CC
	JUMPN	T2,DORIB3		;UNIT OR GROUP?

;HERE FOR UNIT POINTER
	TRZ	T1,RIPNUB		;GET RID OF NOISE BIT
	CAMLE	T1,HUN			;IN RANGE?
	JRST	DORB12			;NO
	HRRZ	U,TABUDB(T1)		;YES, POINT TO NEW UDB
	JRST	DORIB4

;HERE FOR GROUP POINTER
DORIB3:	MOVEM	T2,DRCC			;STORE CC
	LDB	T3,CSBP			;STORE CS
	MOVEM	T3,DRCS
	LDB	T4,CABP			;STORE CA
	MOVEM	T4,DRCA
	ADD	T2,T4			;IN RANGE?
	IMUL	T2,BPC
	SUBI	T2,1
	CAMLE	T2,UDBHLB(U)
	JRST	DORB12			;NO
	PUSHJ	P,DOGRP			;PROCESS THE GROUP
;HERE WHEN ALL DONE WITH RTP
DORIB4:	AOBJN	P1,DORIB1		;LOOP
	SKIPN	DRLFT			;RIB EXACTLY FULL?
	JRST	DORIB2			;YES, FORCE EOF
	SKIPN	RIBXRA(B)		;BETTER BE EXTENDED
	JRST	DORB12
	LDB	P1,RIYRBU		;BN OF EXTENDED RIB
	IMUL	P1,BPLU
	LDB	T1,RIYRBA
	IMUL	T1,BPC
	ADDB	P1,T1
	PUSHJ	P,LEGALP		;IN RANGE?
	 JRST	DORB12			;NO
	MOVE	T2,F2CST+CSTCNT		;SET T2 NON-ZERO TO SAVE CST
	ADD	T2,M2CST+CSTCNT
	TRNN	F,F.P2
	SETZ	T2,
	MOVEI	T1,SIZXRB		;ALLOCATE CORE
	SKIPE	T2
	MOVEI	T1,SIZCXR
	PUSH	P,T2
	PUSHJ	P,GETBLK
	MOVE	T1,P1			;LINK THE TCB
	PUSHJ	P,LNKTCB
	MOVEI	T1,FNCRIB		;FUNCTION CODE
	DPB	T1,TCXCOD
	LDB	T1,TCYRBC		;RIB COUNT
	ADDI	T1,1
	DPB	T1,TCXRBC
	HRRM	FL,TCBFIL(T2)		;ADDR OF FIL
	LDB	T1,FIYCNT		;BUMP USE COUNT OF FIL
	ADDI	T1,1
	DPB	T1,FIYCNT
	MOVE	T1,DRREL		;BN RELATIVE TO FILE
	SUBI	T1,1			;ACCOUNT FOR SPARE RIB
	MOVEM	T1,TCBFLR(T2)		;SHOULD BE 1ST LOGICAL RECORD
	MOVE	T1,DRSIZ		;SIZE
	MOVEM	T1,TCBSIZ(T2)
	MOVE	T1,DRLFT		;BLOCKS LEFT
	MOVEM	T1,TCBLFT(T2)
	MOVSI	T1,(TCPCOR)
	ANDCAM	T1,TCBCOR(T2)
	POP	P,T3
	JUMPE	T3,CPOPJ		;GO IF NOT SAVING CST
	IORM	T1,TCBCOR(T2)		;LIGHT FLAG
	MOVEI	T1,TCBCST(T2)
	HRLI	T1,SCST			;SAVE CST
	BLT	T1,TCBCST+SCSTL-1(T2)
	POPJ	P,
;HERE ON EOF
DORIB2:	SKIPE	RIBXRA(B)		;SHOULDN'T BE EXTENDED
	PUSHJ	P,DORB16
	SKIPE	DRLFT			;TEST RIBALC
	PUSHJ	P,DORB13
	MOVE	T1,DRREL		;TEST RIBSIZ
	SUBI	T1,2
	CAMGE	T1,DRSIZ
	PUSHJ	P,DORB14
	FALL	DNRIB

;COMMON EXIT FOR DORIB
DNRIB:	TRNN	F,F.P2			;WHICH PASS?
	POPJ	P,			;PASS 1
	PUSHJ	P,CSTTO			;PASS 2, TYPE CST'S
	MOVEI	P1,F2CST		;DEALLOCATE FREE
	PUSHJ	P,DECST
	MOVEI	P1,M2CST		;DEALLOCATE MULTIPLE
	PJRST	DECST
DORB10:	PUSHJ	P,MRKIT			;NOT A LOST CLUSTER
	MOVEI	T2,[ASCIZ /Error while reading RIB/]
	PUSHJ	P,DORB15
	PJRST	DNRIB

DORB12:	PUSHJ	P,DORB16
	PJRST	DNRIB

DORB16:	MOVEI	T2,[ASCIZ /Bad pointer in RIB/]
DORB15:	PUSHJ	P,STRO
	TRNE	F,F.PRM			;GO IF PRIME RIB
	JRST	DORB99
	MOVEI	T1," "
	PUSHJ	P,CO
	LDB	T1,TCYRBC
	PUSHJ	P,OCTO
DORB99:	MOVEI	T2,[ASCIZ / of /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO
	PJRST	DSPACE

DORB11:	PUSHJ	P,MRKIT			;NOT A LOST CLUSTER
	MOVEI	T2,[ASCIZ /RIB error on /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO
	TRNE	F,F.PRM			;GO IF PRIME RIB
	JRST	DORB17
	MOVEI	T2,[ASCIZ / (RIB /]
	PUSHJ	P,STRO
	LDB	T1,TCYRBC
	PUSHJ	P,OCTO
	MOVEI	T1,")"
	PUSHJ	P,CO
DORB17:	PUSHJ	P,DSPACE
	JRST	DNRIB

DORB13:	SKIPA	T2,[SIXBIT /RIBALC/]
DORB14:	MOVE	T2,[SIXBIT /RIBSIZ/]
	PUSHJ	P,SIXO
	MOVEI	T2,[ASCIZ / is wrong in /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO
	PJRST	DSPACE

DIE:	MOVEM	17,CRSHAC+17		;SAVE THE ACS
	MOVEI	17,CRSHAC
	BLT	17,CRSHAC+16
	MOVE	17,CRSHAC+17
	PUSHJ	P,GIVIF			;GIVE UP INTERLOCK
	HALT				;FATAL ERROR
;SUBROUTINE TO PROCESS A GROUP
DOGRP:	TRNE	F,F.SAT			;SAT.SYS?
	PUSHJ	P,SAVSAT		;YES, SAVE CA
	TRZ	F,F.SUM			;HAVEN'T DONE CHECKSUM YET
	MOVE	T2,DRCA			;BN RELATIVE TO STR
	IMUL	T2,BPC
	ADD	T2,UDBBLK(U)
	MOVEM	T2,DRPHY
	MOVN	T1,DRCC			;BUMP COUNT
	IMUL	T1,BPC
	ADDM	T1,DRLFT
DOGRP1:	MOVE	T1,DRPHY		;LIGHT SAT BIT
	PUSHJ	P,MARKIT
	PUSHJ	P,DOCLT			;PROCESS THIS CLUSTER
	MOVE	T1,BPC			;BUMP BN
	ADDM	T1,DRPHY
	SOSE	DRCC			;LOOP
	JRST	DOGRP1
	POPJ	P,
;ROUTINE TO PROCESS ALL THE BLOCKS IN A CLUSTER
DOCLT:	MOVE	T1,DRPHY		;WORKING COPY OF BN
	MOVEM	T1,DRBLK
	MOVE	T1,BPC			;SETUP LOOP
	MOVEM	T1,DRCNT
DOCLT1:	TRON	F,F.RIB			;STEPPED OVER THE RIB YET?
	JRST	DOCLT2			;NO, THIS IS IT
	MOVE	T1,DRREL		;PAST EOF?
	CAMLE	T1,DRSIZ
	JRST	DOCLT4			;YES, IGNORE IT
	TRNN	F,F.DIR			;IS THIS A DIR?
	JRST	DOCLT3			;NO, WE'RE ONLY INTERESTED IN 1ST BLOCK
	PUSHJ	P,BDDIR			;YES, BUILD A TCB TO READ THIS BLOCK
	AOS	DRREL			;BUMP BN RELATIVE TO FILE
DOCLT2:	AOS	DRBLK			;LOOP
	SOSE	DRCNT
	JRST	DOCLT1
	POPJ	P,
DOCLT3:	TRON	F,F.SUM			;DONE CHECKSUM YET?
	PUSHJ	P,BDSUM			;NO, DO IT NOW
DOCLT4:	MOVE	T1,DRCNT		;DUMP BN RELATIVE TO FILE
	ADDM	T1,DRREL
	POPJ	P,
;ROUTINE TO BUILD A TCB FOR CHECKSUM
BDSUM:	MOVE	T1,RIBSTS(B)		;ALWAYS BAD CHECKSUM?
	TRNN	T1,RIPABC
	TRNE	F,F.P2			;OR PASS TWO?
	POPJ	P,			;YES, DON'T BOTHER
	MOVEI	T1,SIZSUM		;ALLOCATE CORE
	PUSHJ	P,GETBLK
	MOVE	T1,DRBLK		;LINK THE TCB
	PUSHJ	P,LNKTCB
	MOVEI	T1,FNCSUM		;FUNCTION CODE
	DPB	T1,TCXCOD
	HRRM	FL,TCBFIL(T2)		;ADDR OF FIL
	LDB	T1,FIYCNT		;BUMP USE COUNT OF FIL
	ADDI	T1,1
	DPB	T1,FIYCNT
	MOVE	T1,DRREL		;BN RELATIVE TO FILE
	MOVEM	T1,TCBREL(T2)
	MOVE	T1,DRCS			;EXPECTED CHECKSUM
	MOVEM	T1,TCBSUM(T2)
	POPJ	P,
;ROUTINE TO BUILD A TCB FOR THE DATA BLOCK OF A DIRECTORY
BDDIR:	MOVEI	T1,SIZDIR		;ALLOCATE CORE
	PUSHJ	P,GETBLK
	MOVE	T1,DRBLK		;LINK THE TCB
	PUSHJ	P,LNKTCB
	MOVEI	T1,FNCDIR		;FUNCTION CODE
	DPB	T1,TCXCOD
	HRRM	FL,TCBFIL(T2)		;ADDR OF FIL
	LDB	T1,FIYCNT		;BUMP USE COUNT OF FIL
	ADDI	T1,1
	DPB	T1,FIYCNT
	MOVE	T1,DRREL		;BN RELATIVE TO FILE
	MOVEM	T1,TCBREL(T2)
	POPJ	P,
	SUBTTL	READ A DIRECTORY BLOCK

DODIR:	PUSHJ	P,SAVE3			;SAVE ACS
	PUSHJ	P,REDTCB		;READ THE BLOCK
	 JRST	IOERR			;I/O ERROR
	PUSHJ	P,DRCK			;CHECK
	 JRST	DIRERR			;BAD DIRECTORY
	MOVE	P1,B			;START WITH ENTRY ZERO
DODIR1:	SKIPN	T2,(P1)			;EMPTY SLOT?
	JRST	DODIR2			;YES, IGNORE IT
	HLLZ	T1,FILEXT(FL)		;MFD POINTS TO SELF
	HLR	T1,FILCFP(FL)
	CAMN	T1,1(P1)
	CAME	T2,FILNAM(FL)
	JRST	DODIR3
	JRST	DODIR2
DODIR3:	MOVEI	T1,SIZFIL		;BUILD A FIL
	PUSHJ	P,GETBLK
	MOVE	P3,T2
	MOVE	T1,(P1)			;STORE FILENAME IN FIL
	MOVEM	T1,FILNAM(P3)
	HLLZ	T1,1(P1)		;STORE EXTENSION IN FIL
	HLLM	T1,FILEXT(P3)
	HRRM	FL,FILDAD(P3)		;STORE ADDR OF PARENT FIL
	LDB	T1,FIYCNT		;BUMP PARENT COUNT
	ADDI	T1,1
	DPB	T1,FIYCNT
	MOVEI	T1,1			;SET FIL USE COUNT
	DPB	T1,FIZCNT		;(TCB WILL POINT TO FIL)
	HRRZ	T1,1(P1)		;STORE CFP IN FIL
	HRLM	T1,FILCFP(P3)
	JUMPE	T1,DODIR9		;ZERO IS ILLEGAL
	IMUL	T1,BPSC			;BN RELATIVE TO STR
	PUSHJ	P,LEGALP		;LEGAL BN?
	 JRST	DODIR9			;NO
	MOVEI	T1,SIZRIB		;BUILD A TCB
	PUSHJ	P,GETBLK
	MOVE	P2,T2
	HRRZ	T1,1(P1)		;LINK IT
	IMUL	T1,BPSC
	PUSHJ	P,LNKTCB
	MOVEI	T1,FNCRIB		;STORE FUNCTION IN TCB
	DPB	T1,TCZCOD
	SETZ	T1,			;PRIME RIB
	DPB	T1,TCZRBC
	HRRM	P3,TCBFIL(P2)		;STORE ADDR OF FIL IN TCB
DODIR2:	ADDI	P1,2			;LOOP
	CAIE	P1,BLKSIZ(B)
	JRST	DODIR1
	PJRST	TWATER			;WATER LEVEL HAS CHANGED SIGNIFICANTLY
;HERE IF BAD CFP
DODIR9:	MOVEI	T2,[ASCIZ /Bad CFP for /]
	PUSHJ	P,STRO
	PUSH	P,FL
	MOVE	FL,P3
	PUSHJ	P,FILO
	PUSHJ	P,DECFIL
	POP	P,FL
	PUSHJ	P,DSPACE
	JRST	DODIR2

;ROUTINE TO CHECK IF DIRECTORY DATA BLOCK IS OK
DRCK:	MOVE	P1,B			;START WITH ENTRY ZERO
	SETZ	P2,			;NO BAD ONES YET
DRCK1:	SKIPN	(P1)			;ZERO FILENAME?
	JRST	DRCK3			;YES, EMPTY SLOT
	HRRZ	T1,1(P1)		;GET CFP
	JUMPE	T1,DRCK2		;ZERO IS ILLEGAL
	IMUL	T1,BPSC			;CONVERT TO BN
	PUSHJ	P,LEGALP		;LEGAL BN?
	 JRST	DRCK2			;NO
	JRST	DRCK4			;YES
;HERE IF FILENAME IS ZERO
DRCK3:	SKIPE	1(P1)			;EXTENSION MUST BE ZERO TOO
	POPJ	P,			;FAIL IMMEDIATELY
	JRST	DRCK4
;HERE IF CFP IS BAD
DRCK2:	ADDI	P2,1			;COUNT IT
	CAIN	P2,BADDR		;REACH THRESHOLD?
	POPJ	P,			;YES
DRCK4:	ADDI	P1,2			;LOOP
	CAIE	P1,BLKSIZ(B)
	JRST	DRCK1
	JRST	CPOPJ1			;OK
	SUBTTL	CONFIGURATION

;ROUTINE TO BUILD A LIST OF ALL THE STRUCTURES ON THE SYSTEM
BDALL:	PUSHJ	P,SAVE2
	MOVEI	P1,CONFIG-CNFNXT	;PRESET PRED
BDALL1:	HRRZ	P1,CNFNXT(P1)		;STEP TO NEXT CNF
	JUMPE	P1,CPOPJ
	MOVE	P2,CNFSTR(P1)		;NAME OF STR
	MOVEI	T2,SLST-SNFNXT		;PRESET PRED
BDALL2:	HRRZ	T2,SNFNXT(T2)		;STEP TO NEXT SNF
	JUMPE	T2,BDALL3
	CAMN	P2,SNFNAM(T2)		;ALREADY KNOW ABOUT THAT ONE?
	JRST	BDALL4			;YES
	JRST	BDALL2			;NO
BDALL3:	MOVEI	T1,SIZSNF		;ALLOCATE AN SNF
	PUSHJ	P,GETHI
	MOVE	T1,SLST			;LINK TO SLST
	MOVEM	T1,SNFNXT(T2)
	MOVEM	T2,SLST
	MOVE	T1,BLST			;LINK TO BLST
	MOVEM	T1,SNFLNK(T2)
	MOVEM	T2,BLST
	MOVEM	P2,SNFNAM(T2)		;SAVE STR NAME
BDALL4:	MOVEI	T4,CONFIG-CNFNXT	;PRESET PRED
	SETZB	T1,T3
BDALL5:	HRRZ	T4,CNFNXT(T4)		;STEP TO NEXT UNIT
	JUMPE	T4,BDALL6
	CAME	P2,CNFSTR(T4)		;THIS STR?
	JRST	BDALL5			;NO
	IOR	T1,CNFCHN(T4)		;CHAN MASK
	ADD	T3,CNFVRT(T4)		;SWAPPING SPACE
	JRST	BDALL5
BDALL6:	MOVEM	T1,SNFCHN(T2)		;CHANNEL MASK
	MOVEM	T3,SNFVRT(T2)		;SWAPPING SPACE
	JRST	BDALL1			;NEXT UNIT
;ROUTINE TO BUILD THE UDBS FOR ALL THE UNITS IN A STR
;ALIAS PASSES THE NAME OF THE STR
;TBUDB RETURNS A LIST OF POINTERS TO UDBS
;HUN RETURNS HIGHEST UNIT NUMBER
PUNT:	PUSHJ	P,SAVE1			;SAVE P1
	PUSHJ	P,GETLOK
	MOVEI	P1,CONFIG-CNFNXT	;START WITH 1ST UNIT ON SYSTEM
	SETZM	NUN			;NO UNITS SO FAR
	SETZM	WL			;NO UNITS WRITE LOCKED (YET)
	SETZM	SSIZ			;SUM OF UDBBPU
	SETZM	BIGBPU			;BIGGEST UDBBPU
PUNT1:	HRRZ	P1,CNFNXT(P1)		;STEP TO NEXT CNF
	JUMPE	P1,GIVLOK
	MOVE	T1,CNFSTR(P1)		;OUR STR?
	CAME	T1,ALIAS
	JRST	PUNT1			;NO
	MOVEI	T1,SIZUDB		;BUILD A UDB
	PUSHJ	P,GETZER
	MOVE	U,T2
	MOVE	T1,CNFNAM(P1)		;UNIT NAME
	MOVEM	T1,UDBNAM(U)
	MOVE	T1,CNFALT(P1)		;ALTERNATE PORT
	MOVEM	T1,UDBALT(U)
	AOS	T3,NUN			;BUMP COUNT
	CAILE	T3,NUNT			;TOO BIG?
	PUSHJ	P,DIE			;YES
	SUBI	T3,1			;HIGHEST UNIT
	MOVEM	T3,HUN
	MOVEM	U,TBUDB(T3)
	PUSHJ	P,MOVCPY		;SAVE CAPACITY
	JRST	PUNT1			;AND TRY NEXT UNIT
;ROUTINE TO COMPILE A LIST OF ALL THE UNITS ON THE SYSTEM
LUNIT:	PUSHJ	P,SAVE2			;SAVE AC
	SETZ	P1,			;NONE SO FAR
LUNIT1:	SYSPHY	P1,			;GET NAME OF NEXT UNIT ON SYSTEM
	 PUSHJ	P,DIE
	JUMPE	P1,CPOPJ
	MOVEM	P1,FOO+.DCNAM		;GET STATS
	MOVE	T1,[XWD FOOSIZ,FOO]
	DSKCHR	T1,
	 PUSHJ	P,DIE
	SKIPE	FOO+.DCSNM		;IN A STR?
	TLNE	T1,(DC.STS)		;AND UNIT OK?
	JRST	LUNIT1			;NO, SKIP IT
	MOVEI	P2,CONFIG-CNFNXT	;SEE IF IT ALREADY EXISTS
LUNIT2:	HRRZ	P2,CNFNXT(P2)
	JUMPE	P2,LUNIT3		;NO
	CAME	P1,CNFNAM(P2)
	CAMN	P1,CNFALT(P2)
	JRST	LUNIT4			;YES
	JRST	LUNIT2
;HERE IF UNIT DOES NOT YET EXIST
LUNIT3:	MOVEI	T1,SIZCNF		;ALLOCATE A CNF
	PUSHJ	P,GETHI
	MOVE	P2,T2			;PUT IT IN A SAFE PLACE
	MOVE	T1,CONFIG		;LINK IT
	MOVEM	T1,CNFNXT(P2)
	MOVEM	P2,CONFIG
	SETZM	CNFVRT(P2)		;NO SWAP SPACE YET
;HERE IF UNIT DOES EXIST, STORE NEW INFO
LUNIT4:	MOVEM	P1,CNFNAM(P2)		;SAVE PHYS UNIT NAME
	MOVE	T1,FOO+.DCSNM		;STR NAME
	MOVEM	T1,CNFSTR(P2)
	MOVE	T1,FOO+.DCK4S		;K FOR SWAPPING
	LSH	T1,1			;PAGES
	SKIPL	FOO+.DCPAS		;IN ASL?
	MOVEM	T1,CNFVRT(P2)		;YES, THESE PAGES COUNT
	MOVE	T2,P1			;CHANNEL MASK
	PUSHJ	P,GETCHN
	MOVEM	T1,CNFCHN(P2)
	MOVE	T2,FOO+.DCALT		;ALTERNATE UNIT NAME
	MOVEM	T2,CNFALT(P2)
	JUMPE	T2,LUNIT1		;LOOP
	PUSHJ	P,GETCHN		;CHANNEL MASK OF ALTERNATE
	IORM	T1,CNFCHN(P2)		;ADD IT IN
	JRST	LUNIT1			;LOOP

;ROUTINE TO ALLOCATE SOME CORE IN THE HISEG
;T1 PASSES SIZE (DESTROYED)
;T2 RETURNS ADDR
;NOTE THAT HISEG CORE IS NEVER RETURNED
GETHI:	MOVE	T2,HFF			;FIRST FREE
	ADDB	T1,HFF			;NEW FIRST FREE
	CAILE	T1,HCOR+NHCOR
	PUSHJ	P,DIE
	POPJ	P,
;ROUTINE TO BUILD A BIT MASK FOR THE CHANNEL NUMBER
;T2 PASSES THE UNIT NAME
;T1 RETURNS BIT MASK
;THIS ROUTINE IS A HORRIBLE CROCK. WE REALLY OUGHT TO USE THE
;CHANNEL NUMBER RETURNED BY THE DSKCHR UUO, BUT THE INFORMATION
;RETURNED BY DSKCHR SIMPLY CAN'T BE TRUSTED. THERE ARE SIMPLY
;TOO MANY MONITOR BUGS INVOLVED. THE VALUE RETURNED BY DSKCHR IS
;A CHANNEL NUMBER PER CPU RATHER THAN SYSTEM WIDE. MOREOVER,
;PRE-703 MONITORS RETURN A BAD CHANNEL NUMBER FOR THE SECOND
;KDB OF A 16 DRIVE RP20 STRING.
;THE ALGORITHM USED HERE DOESN'T ALWAYS GENERATE PERFECT RESULTS,
;BUT IT'S USUALLY PRETTY GOOD.
GETCHN:	HLRZS	T1,T2			;BLOW THE UNIT NUMBER
	TRZ	T1,77			;IS IT AN RP20?
	CAIE	T1,'RN '
	JRST	GTCHN1			;NO
	MOVE	T3,MONVER		;PRE-703?
	CAIL	T3,70300
	JRST	GTCHN1			;NO
	TRNN	T2,1			;ALTERNATE KDB?
	SUBI	T2,1			;YES, USE NAME OF PRIME KDB
GTCHN1:	SKIPN	T3,CHNNAM		;SEARCH FOR KON NAME
	JRST	GTCHN2
GTCHN3:	CAMN	T2,CHNNAM(T3)
	JRST	GTCHN4			;FOUND IT
	SOJN	T3,GTCHN3
GTCHN2:	AOS	T3,CHNNAM		;NOT FOUND, ROOM FOR ANOTHER?
	CAILE	T3,^D36
	SOS	T3,CHNNAM		;NOPE, BACK UP
	MOVEM	T2,CHNNAM(T3)		;STORE CHANNEL NAME
GTCHN4:	MOVEI	T1,1			;BUILD A BIT MASK
	LSH	T1,-1(T3)
	POPJ	P,
	SUBTTL	READ HOME BLOCKS

;ROUTINE TO READ THE HOME BLOCKS OF ALL THE UNITS ON A STR
;SKIP IF OK
RDHOM:	PUSHJ	P,SAVE1			;SAVE P1
	SETZM	TABUDB
	MOVE	T1,[XWD TABUDB,TABUDB+1]
	BLT	T1,TABUDB+NUNT-1
	TRZ	F,F.STR			;STR INFO ISN'T FROZEN YET
	MOVE	P1,HUN			;SET UP LOOP
RDHOM1:	MOVE	U,TBUDB(P1)		;GET ADDR OF UDB
	PUSHJ	P,RDHM			;READ THE HOME BLOCK
	 POPJ	P,
	MOVE	T1,HOMLUN(B)		;GET LOGICAL UNIT NUMBER
	SKIPE	TABUDB(T1)		;ALREADY HAVE ONE OF THOSE?
	POPJ	P,			;YES
	HRLI	U,SZUDB			;SAVE ADDR OF UDB
	MOVEM	U,TABUDB(T1)
	PUSHJ	P,MOVSTR		;COPY STUFF TO STRUCTURE DATA BLOCK
	 POPJ	P,
	PUSHJ	P,MOVUDB		;COPY STUFF TO UDB
	PUSHJ	P,BLDSAT		;BUILD SAT TABLES
	SOJGE	P1,RDHOM1		;LOOP FOR EACH UNIT
	MOVE	T1,MFDBN		;TEST IF BN IS LEGAL
	PUSHJ	P,LEGALP
	 POPJ	P,
	MOVE	T1,MFDBN
	IDIV	T1,BPSC
	SKIPN	T2
	AOS	(P)
	POPJ	P,
;ROUTINE TO READ A HOME BLOCK
;U PASSES UDB
;SKIP IF OK
RDHM:	MOVEI	T3,1			;READ 1ST HOME BLOCK
	PUSHJ	P,REDBLK
	 JRST	RDHM1			;ERROR
	PUSHJ	P,HMCK			;VALID HOME BLOCK?
	 JRST	RDHM1			;NO
	JRST	CPOPJ1			;YES, WIN
RDHM1:	MOVEI	T3,12			;READ 2ND HOME BLOCK
	PUSHJ	P,REDBLK
	 POPJ	P,
	PJRST	HMCK			;AND CHECK IF VALID

;ROUTINE TO READ A BAT BLOCK
;U PASSES UDB
;SKIP IF OK
RDBT:	MOVEI	T3,2			;READ 1ST BAT BLOCK
	PUSHJ	P,REDBLK
	 JRST	RDBT1			;ERROR
	PUSHJ	P,BTCK			;VALID BAT BLOCK?
	 JRST	RDBT1			;NO
	JRST	CPOPJ1			;YES, WIN
RDBT1:	MOVEI	T3,13			;READ 2ND BAT BLOCK
	PUSHJ	P,REDBLK
	 POPJ	P,
	FALL	BTCK			;AND CHECK IF VALID

;ROUTINE TO TEST VALIDITY OF A BAT BLOCK
;SKIP IF OK
BTCK:	MOVS	T1,BAFNAM(B)		;NAME
	MOVE	T2,BAFCOD(B)		;UNLIKELY CODE
	CAIN	T1,'BAT'
	CAIE	T2,CODBAT
	POPJ	P,
	HLRE	T1,BAFFIR(B)		;USEABLE WORDS
	MOVNS	T1
	HRRZ	T2,BAFFIR(B)		;1ST WORD
	ADD	T2,T1			;LAST WORD +1
	LDB	T3,BAYNBR		;REGIONS
	ADD	T3,BAFCNT(B)
	LSH	T3,1			;TIMES WORDS PER ENTRY
	CAMG	T3,T1			;TOO MANY ENTRIES?
	CAILE	T2,BAFCOD		;NOT ENOUGH SLOTS?
	POPJ	P,
	JRST	CPOPJ1
	SUBTTL	TCB I/O

;ROUTINE TO READ THE BLOCK POINTED TO BY A TCB
;TC PASSES ADDR OF TCB
;U RETURNS ADDR OF UDB
;FL RETURNS ADDR OF FIL
;SKIP IF OK
REDTCB:	HRRZ	FL,TCBFIL(TC)		;LOAD ADDR OF FIL
	LDB	T1,TCYCX		;FIND DDB
IFN FTDBUG,<
	SKIPN	T1
	PUSHJ	P,DIE
>
	MOVE	DDB,USRJDA(T1)
	MOVE	T1,TCBBLK(TC)		;FIND UNIT
IFN FTDBUG,<
	CAML	T1,DDBLBN(DDB)
	CAMLE	T1,DDBHBN(DDB)
	PUSHJ	P,DIE
>
	IDIV	T1,BPLU
	HRRZ	U,TABUDB(T1)
	SKIPE	DDBERR(DDB)		;ERROR?
	POPJ	P,			;YES
	MOVE	B,TCBBLK(TC)		;ADDR OF BLOCK
	SUB	B,DDBLBN(DDB)
	IMULI	B,BLKSIZ
	ADD	B,DDBBUF(DDB)
	ADDI	B,2
	JRST	CPOPJ1
;HERE TO LOAD A TCB INTO CACHE
;TC PASSES TCB
;DDB PASSES DDB
;WE WILL READ SEVERAL BLOCKS ALL AT ONCE
;FIND THE HIGHEST DO-ABLE BLOCK
LODTCB:	PUSHJ	P,SAVE4			;SAVE ACS
	MOVE	P2,TCBBLK(TC)		;FIND UNIT
	IDIV	P2,BPLU
	HRRZ	U,TABUDB(P2)
	MOVE	P2,TCBBLK(TC)		;GET BN BACK
	MOVE	T1,TCBMBB(TC)		;SUSPECTED BAD?
	TLNE	T1,(TCPMBB)
	JRST	LDTCB9			;YES, DO SINGLE BLOCK XFER
	MOVE	P1,P3			;BN RELATIVE TO UNIT
	IDIV	P1,UDBCYL(U)		;CYL NUMBER
	ADDI	P1,1			;NEXT CYL
	IMUL	P1,UDBCYL(U)		;1ST BN OF NEXT CYL
	ADD	P1,UDBBLK(U)		;RELATIVE TO STR
	MOVE	P4,TCBBLK(TC)		;1ST BN THAT WON'T FIT IN BUFFER
	ADDI	P4,NBLK
	HRRZ	T1,TC			;START WITH CURRENT TCB
	PUSHJ	P,XTRAP			;WANT EXTRA BLOCK?
	 TLO	T1,(1B0)		;NO
LDTCB2:	MOVE	P2,T1			;SAVE LAST GOOD TCB
LDTCB4:	HRRZ	T1,TCBLNK(T1)		;STEP TO NEXT TCB
	CAIN	T1,QTCB			;IF END
	JRST	LDTCB3			;THEN DON'T DO IT
	CAMLE	P1,TCBBLK(T1)		;SAME CYL?
	CAMG	P4,TCBBLK(T1)		;AND FIT IN BUFFER?
	JRST	LDTCB3			;NO, DON'T DO IT
	LDB	T2,TCXCX		;SEE IF I/O ALREADY ACTIVE
	JUMPN	T2,LDTCB3		;YES
	PUSHJ	P,FNDCX			;DON'T KNOW, SEARCH AND FIND OUT
	 SKIPA	T3,TCBMBB(T1)		;NOT ACTIVE
	JRST	LDTCB3			;ACTIVE
	TLNE	T3,(TCPMBB)		;SUSPECTED BAD?
	JRST	LDTCB3			;YES, DON'T DO IT
	PUSHJ	P,FITP			;FIT IN CORE?
	 JRST	LDTCB4			;NO
	MOVE	T2,TCBBLK(P2)		;BN OF LAST GOOD TCB
	ADD	T2,UDBSKP(U)		;1ST BN THAT WOULD SKIP TOO MUCH
	ADDI	T2,2
	SKIPL	P2			;WANT EXTRA BLOCK?
	ADDI	T2,1			;YES, ONE MORE
	CAMG	T2,TCBBLK(T1)		;SKIP TOO MUCH?
	JRST	LDTCB3			;YES, DON'T DO IT
	PUSHJ	P,XTRAP			;DOES CURRENT TCB WANT EXTRA?
	 TLO	T1,(1B0)		;NO
	MOVE	T2,TCBBLK(T1)		;NEXT BN
	ADDI	T2,1
	TRNE	F,F.702			;7.02?
	CAME	T2,P4			;AND EXTRA WON'T FIT IN BUFFER?
	JRST	LDTCB2
	CAME	T2,P1			;AND EXTRA IS SAME CYL?
	SKIPGE	T1			;AND WE WANT EXTRA?
	 JRST	LDTCB2
	FALL	LDTCB3			;YES, PUT THIS TCB IN NEXT XFER
					; SO WE WON'T HAVE TO DO A ONE
					; BLOCK XFER JUST TO PICK UP
					; THE EXTRA

;HERE WITH P2=LAST GOOD TCB
LDTCB3:	MOVE	T1,P2			;LAST GOOD TCB
	MOVE	P2,TCBBLK(T1)		;THIS BN
	SKIPGE	T1			;WANT EXTRA BLOCK?
	JRST	LDTCB9			;NO
	ADDI	P2,1			;NEXT BN
	CAMGE	P2,P1			;SAME CYL?
	CAML	P2,P4			;AND FIT IN BUFFER?
	SUBI	P2,1			;NO EXTRA

;HERE WITH P2=HIGHEST BN TO READ
LDTCB9:	MOVEM	P2,DDBHBN(DDB)		;HIGH
	MOVE	T1,TCBBLK(TC)		;LOW
	MOVEM	T1,DDBLBN(DDB)
	SETZM	DDBERR(DDB)		;NO ERRORS SO FAR
	SETZM	DDBDON(DDB)		;NOT DONE YET
	SUB	P2,TCBBLK(TC)		;NUMBER OF BLOCKS
	ADDI	P2,1
	IMULI	P2,BLKSIZ		;NUMBER OF WORDS
	PUSHJ	P,OPNUDB		;MAKE SURE UNIT IS OPEN
	 PUSHJ	P,DIE			;IT WENT AWAY
	MOVE	T1,DDBCX(DDB)		;STORE CHANNEL INDEX
	DPB	T1,TCYCX
	MOVEM	TC,DDBTCB(DDB)		;STORE 1ST TCB
	AOS	ACTCNT			;ANOTHER DDB ACTIVE
	MOVE	T3,P3			;POSITION
	PUSHJ	P,SUSETI
	TRNE	F,F.702			;BIG BUFFERS?
	JRST	LDTCB6			;YES

;HERE IF 7.01
	MOVE	T4,DDBBUF(DDB)		;BUILD IOWD
	ADDI	T4,1
	MOVNS	P2
	HRL	T4,P2
	MOVEM	T4,CMD
LDTCB7:	PUSHJ	P,IOXCT			;READ IT
	IN	CMD
	 JRST	DOIN1
	PUSHJ	P,SETDMP		;ERROR, CLEAR BIT
	MOVE	T4,DDBBUF(DDB)		;BUILD SINGLE IOWD
	ADDI	T4,1
	HRLI	T4,-BLKSIZ
	CAMN	T4,CMD			;ALREADY SINGLE?
	JRST	DOIN2			;YES, HARD ERROR
	MOVEM	T4,CMD
	PUSHJ	P,SETMBB		;SET "MIGHT BE BAD"
	MOVE	T4,DDBLBN(DDB)		;ONLY ONE BLOCK
	MOVEM	T4,DDBHBN(DDB)
	MOVE	T3,P3			;RE-POSITION
	PUSHJ	P,SUSETI
	JRST	LDTCB7			;TRY AGAIN

;HERE IF 7.02
LDTCB6:	ADDI	P2,1			;STORE SIZE OF BUFFER
	DPB	P2,DEYSIZ
	PUSHJ	P,DOIN			;START I/O
	 POPJ	P,			;FINISHED
	POPJ	P,			;NOT FINISHED
;ROUTINE DO NON-BLOCKING INPUT
;SKIP IF NOT DONE
DOIN:	PUSHJ	P,IOXCT			;DO IT
	IN
	 JRST	DOIN1
	PUSHJ	P,IOXCT			;ERROR?
	STATO	IO.ERR
	 JRST	CPOPJ1			;NO, MERELY UNFINISHED
	PUSHJ	P,SETBUF		;YES, CLEAR ERROR BIT
	LDB	T1,DEYSIZ		;GET SIZE
	CAIN	T1,BLKSIZ+1		;ALREADY SINGLE?
	JRST	DOIN2			;YES, HARD ERROR
	MOVEI	T1,BLKSIZ+1		;NO, MAKE SINGLE
	DPB	T1,DEYSIZ
	PUSHJ	P,SETMBB		;SET "MIGHT BE BAD"
	MOVE	T2,DDBLBN(DDB)		;RE-POSITION
	MOVEM	T2,DDBHBN(DDB)
	IDIV	T2,BPLU
	PUSHJ	P,SUSETI
	JRST	DOIN			;TRY AGAIN
DOIN2:	SETOM	DDBERR(DDB)		;HARD ERROR
DOIN1:	SETOM	DDBDON(DDB)		;IO DONE
	POPJ	P,
;THIS ROUTINE IS CALLED WHENEVER THERE IS AN I/O ERROR.
;WE DON'T KNOW WHICH BLOCK IT IS THAT'S BAD,
;SO WE WILL LIGHT TCPMBB IN ALL THE TCB'S.
;THIS BIT WILL CAUSE EACH BLOCK TO BE READ SEPERATELY (WITHOUT
;TRYING TO XFER SEVERAL BLOCKS IN THE SAME BUFFER).
;THIS IS THE FASTEST ALGORITHM FOR FINDING THE BAD BLOCK.
;YES, IT'S EVEN FASTER THAN A BINARY SEARCH!
;IT TURNS OUT THAT THE LIMITING FACTOR ON HOW FAST YOU CAN SEARCH IS
;THE NUMBER OF TIMES THAT THE BAD BLOCK IS READ. EACH TIME THAT
;WE ATTEMPT TO READ THE BAD BLOCK, THE MONITOR WILL END UP DOING
;NUMEROUS RETRIES. THIS CAN TAKE UPWARDS OF 1/2 SEC EACH TIME!
;THUS THE GOAL IN DESIGNING THE SEARCH ALGORITHM IS THAT THE BAD
;BLOCK (WHEREVER IT MAY BE) SHOULD ONLY BE READ ONCE.
SETMBB:	MOVE	T1,DDBTCB(DDB)		;1ST TCB IN XFER
STMBB1:	MOVSI	T2,(TCPMBB)		;LIGHT THE BIT
	IORM	T2,TCBMBB(T1)
	HRRZ	T1,TCBLNK(T1)		;STEP TO NEXT TCB
	CAIN	T1,QTCB
	POPJ	P,
	MOVE	T2,TCBBLK(T1)		;END OF XFER?
	CAMG	T2,DDBHBN(DDB)
	JRST	STMBB1			;NO, LOOP
	POPJ	P,			;YES
;ROUTINE TO DECIDE WHETHER TO READ AN EXTRA BLOCK
;T1 PASSES ADDR OF TCB
;SKIP IF SHOULD READ AN EXTRA BLOCK
;THIS DOES NOT IMPLY THAT THE EXTRA BLOCK WILL FIT IN THE BUFFER,
;IT MERELY IMPLIES THAT WE WOULD LIKE TO READ THE EXTRA BLOCK IF IT
;WILL, IN FACT, FIT.
XTRAP:	HRRZ	T2,TCBLNK(T1)		;NEXT TCB
	CAIN	T2,QTCB
	JRST	XTRAP1
	MOVE	T3,TCBBLK(T1)		;NEXT BN
	ADDI	T3,1
	CAMN	T3,TCBBLK(T2)		;CONSECUTIVE TCB'S?
	POPJ	P,			;YES
XTRAP1:	LDB	T2,TCWCOD		;RIB?
	CAIE	T2,FNCRIB
	POPJ	P,			;NO
	HRRZ	T2,TCBFIL(T1)		;YES, RIB OF DIR?
	HLRZ	T2,FILEXT(T2)
	CAIE	T2,'SFD'
	CAIN	T2,'UFD'
	JRST	CPOPJ1			;YES, READ XTRA
	TRNN	F,F.P2			;NOT DIR, IS IT PASS 2?
	AOS	(P)			;PASS 1, READ XTRA
	POPJ	P,			;PASS 2, NO XTRA
	SUBTTL	I/O

;ROUTINE TO READ A DISK BLOCK (WITHOUT HAVING A TCB)
;U PASSES A POINTER TO THE UDB
;DDB PASSES A POINTER TO THE DDB
;T3 PASSES BN RELATIVE TO UNIT
;NOSKIP IF ERROR
;SKIP IF OK
REDBLK:	SETOM	DDBHBN(DDB)		;INVALIDATE CACHE
	MOVE	B,DDBBUF(DDB)		;ADDR OF BUFFER
	ADDI	B,2
	JUMPE	T3,CPOPJ
	PUSHJ	P,OPNUDB		;MAKE SURE UNIT IS OPEN
	 POPJ	P,
	PUSHJ	P,CODMP			;SWITCH TO DUMP
	PUSHJ	P,SUSETI		;POSITION
	MOVEI	T1,-1(B)		;BUILD IOWD
	HRLI	T1,-BLKSIZ
	MOVEM	T1,CMD
	PUSHJ	P,IOXCT			;READ IT
	IN	CMD
	 JRST	CPOPJ1			;WIN
	PJRST	SETDMP			;CLEAR ERROR BIT

;ROUTINE TO WRITE A DISK BLOCK (WITHOUT HAVING A TCB)
;U PASSES A POINTER TO THE UDB
;DDB PASSES A POINTER TO THE DDB
;B PASSES A POINTER TO THE BUFFER
;T3 PASSES BN RELATIVE TO UNIT
;NOSKIP IF ERROR
;SKIP IF OK
WRTBLK:	JUMPE	T3,CPOPJ
	PUSHJ	P,OPNUDB		;MAKE SURE UNIT IS OPEN
	 POPJ	P,
	PUSHJ	P,CODMP			;SWITCH TO DUMP
	PUSHJ	P,SUSETO		;POSITION
	MOVEI	T1,-1(B)		;BUILD IOWD
	HRLI	T1,-BLKSIZ
	MOVEM	T1,CMD
	PUSHJ	P,IOXCT			;WRITE IT
	OUT	CMD
	 JRST	CPOPJ1			;WIN
	PJRST	SETDMP			;CLEAR ERROR BIT
;ROUTINE TO EXECUTE AN IO INSTRUCTION ON THE RIGHT CHANNEL
;DDB PASSES DDB
;CLOBBERS T1 (ALL OTHER ACS PRESERVED)
IOXCT:	MOVE	T1,DDBCH(DDB)		;GET CHANNEL NUMBER
	LSH	T1,^D18+4+1		;POSTION IT
	ADD	T1,@(P)			;ADD REST OF INSTRUCTION
	AOS	(P)			;SKIP OVER INSTRUCTION
	XCT	T1			;DO THE INSTRUCTION
	 POPJ	P,			;NOSKIP
	JRST	CPOPJ1			;SKIP

;ROUTINE TO OPEN THE UNIT
;U PASSES UDB
;DDB PASSES DDB
OPNUDB:	MOVE	T1,UDBNAM(U)		;ALREADY OPEN?
	CAMN	T1,DDBPUN(DDB)
	JRST	CPOPJ1			;YES
	MOVEM	T1,DEV+.OPDEV		;NO, OPEN IT NOW
	MOVEI	T1,.IODMP
	TRNE	F,F.702
	MOVE	T1,[UU.AIO+UU.LBF+.IOBIN]
	MOVEM	T1,DEV+.OPMOD
	MOVEI	T1,DDBHDR(DDB)
	MOVEM	T1,DEV+.OPBUF
	SETZM	DDBPUN(DDB)
	PUSHJ	P,IOXCT
	OPEN	DEV
	 POPJ	P,
	MOVE	T1,UDBNAM(U)
	MOVEM	T1,DDBPUN(DDB)
	MOVE	T1,DDBBUF(DDB)
	TLO	T1,(BF.VBR)
	MOVEM	T1,DDBHDR+.BFADR(DDB)
;UNDER 7.02 THERE DOES NOT APPEAR TO BE ANY ADVANTAGE TO SETTING CPU.
;USING QUEUED PROTOCOL IS ONLY GOING TO TAKE ONE TICK, AND GETTING THE
;REQUEST QUEUED A TICK FASTER WOULDN'T REALLY HELP. THE DRIVE WILL STILL
;BE BUSY DOING THE CURRENT TRANSFER FOR AT LEAST A TICK ANYWAY.
;THUS THERE IS NO ADVANTAGE TO SETTING CPU. IN FACT, IT'S ACTUALLY AN
;ADVANTAGE TO BE RUNNABLE ON LOTS OF CPU'S. THAT WAY, YOU'RE MORE LIKELY
;TO GET CPU TIME WHEN YOU NEED IT IN A HURRY.
	TRNE	F,F.702			;7.01?
	JRST	CPOPJ1			;NO ADVANTAGE
	MOVE	T1,UDBCPU(U)		;CPU(S) THIS UNIT IS ON
	CAMN	T1,OURCPU
	JRST	CPOPJ1			;YES
	MOVEM	T1,OURCPU		;NO
	HRLI	T1,.STCPU		;SET US THERE
	SETUUO	T1,
	 JFCL
	JRST	CPOPJ1

;PUT DDB INTO BUFFERED MODE
SETBUF:	PUSHJ	P,IOXCT
	SETSTS	.IOBIN
	POPJ	P,

;PUT DDB INTO DUMP MODE
SETDMP:	PUSHJ	P,IOXCT
	SETSTS	.IODMP
	POPJ	P,

;COROUTINE TO PUT DDB IN DUMP MODE
CODMP:	TRNN	F,F.702			;ALREADY IN DUMP MODE?
	POPJ	P,			;YES
	PUSHJ	P,SETDMP		;NO, SWITCH
	POP	P,T1			;PRUNE STACK
	PUSHJ	P,@T1			;CALL CALLER
	 CAIA
	AOS	(P)
	JRST	SETBUF			;SWITCH BACK

;ROUTINE TO PERFORM A SUPER USETI
;THE SUSET UUO REALLY SUCKS.
;I PREFER A GOOD OLD USETI.
;BUT SOME PEOPLE PATCH SUPER USETI OUT OF THEIR MONITOR.
;T3 PASSES BN (RELATIVE TO UNIT)
;CLOBBERS T1
SUSETI:	MOVE	T1,DDBCH(DDB)		;GET CHANNEL NUMBER
	LSH	T1,^D23			;POSITION IT
SUSET2:	ADD	T1,T3			;BN
	SUSET.	T1,
	 PUSHJ	P,DIE			;SERVES YOU RIGHT!
	POPJ	P,

;ROUTINE TO PERFORM A SUPER USETO
;T3 PASSES BN (RELATIVE TO UNIT)
;CLOBBERS T1
SUSETO:	MOVE	T1,DDBCH(DDB)		;GET CHANNEL NUMBER
	LSH	T1,^D23			;POSITION IT
	TLO	T1,(SU.SOT)		;OUTPUT
	JRST	SUSET2
	SUBTTL	CHECK HOME BLOCKS

;ROUTINE TO TEST THE VALIDITY OF A HOME BLOCK
;SKIP IF HOME BLOCK IS OK
HMCK:	MOVS	T1,HOMNAM(B)		;NAME MUST BE HOME
	MOVE	T2,HOMCOD(B)		;MUST HAVE MAGIC NUMBER
	CAIN	T1,'HOM'
	CAIE	T2,CODHOM
	POPJ	P,
	LDB	T1,[POINT 6,HOMCLP(B),11];BITS PER CA
	LDB	T2,[POINT 6,HOMCLP(B),5];CA BIT POSITION
	JUMPN	T2,CPOPJ		;MUST BE ZERO
	LDB	T2,[POINT 6,HOMCKP(B),11];BITS PER CS
	LDB	T3,[POINT 6,HOMCKP(B),5];CS BIT POSITION
	CAIG	T1,CLASIZ		;CA MUST FIT IN SPT
	CAME	T1,T3			;SIZE OF CA IS POSITION OF CS
	POPJ	P,
	ADD	T1,T2			;COMBINED SIZE OF CA AND CS
	LDB	T2,[POINT 6,HOMCNP(B),11];BITS PER CC
	LDB	T3,[POINT 6,HOMCNP(B),5];CC BIT POSITION
	CAME	T1,T3			;SIZE OF CA+CS IS POSITION OF CC
	POPJ	P,
	ADD	T1,T2			;COMBINED SIZE OF CA, CS, AND CC
	SKIPN	HOMREF(B)		;CAN'T NEED REFRESHING
	CAIE	T1,^D36			;MUST FILL THE WORD EXACTLY
	POPJ	P,
	SKIPL	T1,HOMLUN(B)		;LOGICAL UNIT NUMBER
	CAMLE	T1,HUN
	POPJ	P,
	SUB	T1,HUN			;NUMBER OF UNITS REMAINING
	SKIPN	T2,HOMNXT(B)		;IS THIS SUPPOSED TO BE LAST UNIT?
	JUMPN	T1,CPOPJ		;YES, BETTER BE NONE LEFT
	SKIPN	T1			;NONE LEFT?
	JUMPN	T2,CPOPJ		;YES, IT'S SUPPOSED TO BE THE LAST
	SKIPLE	T1,HOMBSC(B)		;BPSC MUST BE POSITIVE
	SKIPG	T2,HOMBPC(B)		;BPC MUST BE POSITIVE
	POPJ	P,
	IDIV	T1,T2			;BPC MUST DIVIDE BPSC
	JUMPN	T2,CPOPJ
	SKIPLE	T1,HOMSPU(B)		;SATS PER UNIT
	CAILE	T1,^D100		;BE REASONABLE
	POPJ	P,
	SKIPLE	T2,HOMSIC(B)		;SATS IN CORE
	CAMLE	T2,T1
	POPJ	P,
	MOVE	T1,BIGBPU		;BIGGEST UNIT
	IDIV	T1,HOMBSC(B)		;SUPER CLUSTERS ON BIGGEST UNIT
	SKIPE	T2
	ADDI	T1,1
	CAMN	T1,HOMSCU(B)
	SKIPN	HOMSNM(B)		;MUST BE PART OF A STR
	POPJ	P,
	SKIPE	T1,HOMK4S(B)		;SWAP SPACE MUST FIT
	MOVE	T1,HOMSLB(B)
	MOVE	T2,HOMK4S(B)
	LSH	T2,3
	ADD	T1,T2
	CAMLE	T1,UDBBPU(U)
	POPJ	P,
	JRST	CPOPJ1
	SUBTTL	MFD TCB

;ROUTINE TO BUILD A TCB FOR MFD
;SKIP IF OK
BDMFD:	MOVEI	T1,SIZFIL		;ALLOCATE CORE FOR FIL
	PUSHJ	P,GETBLK
	MOVE	FL,T2
	MOVE	T1,MFDPPN		;FILENAME
	MOVEM	T1,FILNAM(FL)
	MOVSI	T1,'UFD'		;EXT
	MOVEM	T1,FILEXT(FL)
	MOVE	T1,MFDBN		;CFP
	IDIV	T1,BPSC
	HRLZM	T1,FILCFP(FL)
	MOVEI	T1,1			;USE COUNT
	DPB	T1,FIYCNT
	MOVEI	T1,SIZRIB		;ALLOCATE CORE FOR TCB
	PUSHJ	P,GETBLK
	MOVE	T1,MFDBN		;PUT TCB IN QUEUE
	PUSHJ	P,LNKTCB
	MOVE	TC,T2
	MOVEI	T1,FNCRIB		;FUNCTION CODE
	DPB	T1,TCYCOD
	SETZ	T1,			;PRIME RIB
	DPB	T1,TCYRBC
	HRRM	FL,TCBFIL(TC)		;ADDR OF FIL
	POPJ	P,
	SUBTTL	STORE HOME BLOCK INFO

;ROUTINE TO COPY INFO FROM HOME BLOCKS TO STR DATA BLOCK
;SKIP IF OK
MOVSTR:	MOVE	T1,HOMSNM(B)		;STRUCTURE NAME
	TRNN	F,F.STR
	MOVEM	T1,STRNAM
	CAME	T1,STRNAM
	POPJ	P,
	MOVE	T1,NUN			;HIGHEST LEGAL BN
	IMUL	T1,BIGBPU
	SUBI	T1,1
	MOVEM	T1,HLBN
	MOVEI	T1,T1			;BP TO CC
	HLL	T1,HOMCNP(B)
	TLZ	T1,77
	TRNN	F,F.STR
	MOVEM	T1,CCBP
	CAME	T1,CCBP
	POPJ	P,
	HLL	T1,HOMCKP(B)		;BP TO CS
	TLZ	T1,77
	TRNN	F,F.STR
	MOVEM	T1,CSBP
	CAME	T1,CSBP
	POPJ	P,
	LDB	T2,[POINT 6,CSBP,11]	;BITS PER CHECKSUM
	MOVEM	T2,BPCS
	MOVNS	T2
	HRRZM	T2,MBPCS
	HLL	T1,HOMCLP(B)		;BP TO CA
	TLZ	T1,77
	TRNN	F,F.STR
	MOVEM	T1,CABP
	CAME	T1,CABP
	POPJ	P,
	MOVE	T1,HOMBPC(B)		;BLOCKS PER CLUSTER
	TRNN	F,F.STR
	MOVEM	T1,BPC
	CAME	T1,BPC
	POPJ	P,
	MOVE	T1,HOMBSC(B)		;BLOCKS PER SUPER CLUSTER
	TRNN	F,F.STR
	MOVEM	T1,BPSC
	CAME	T1,BPSC
	POPJ	P,
	IMUL	T1,HOMSCU(B)		;BLOCKS PER (LARGEST) UNIT
	TRNN	F,F.STR
	MOVEM	T1,BPLU
	CAME	T1,BPLU
	POPJ	P,
	MOVE	T1,HOMPT1(B)		;BN FOR MFD
	TRNN	F,F.STR
	MOVEM	T1,SPT1
	CAME	T1,SPT1
	POPJ	P,
	LDB	T2,CABP
	IMUL	T2,BPC
	MOVE	T1,HOMUN1(B)
	TRNN	F,F.STR
	MOVEM	T1,SUN1
	CAME	T1,SUN1
	POPJ	P,
	IMUL	T1,BPLU
	ADD	T1,T2
	MOVEM	T1,MFDBN
	MOVE	T1,HOMOVR(B)		;OVERDRAW
	TRNN	F,F.STR
	MOVEM	T1,SOVR
	CAME	T1,SOVR
	POPJ	P,
	MOVEI	T1,DSKTRY		;RETRIES ON ERROR
	MOVEM	T1,STRY
	MOVE	T1,HOMPVS(B)		;NON-0 IF PRIVATE STR
	ANDI	T1,HOPPVS
	SKIPE	T1
	SETO	T1,
	TRNN	F,F.STR
	MOVEM	T1,SPVS
	CAME	T1,SPVS
	POPJ	P,
	MOVE	T1,HOMOPP(B)		;OWNER PPN
	TRNN	F,F.STR
	MOVEM	T1,SPPN
	CAME	T1,SPPN
	POPJ	P,
	MOVE	T1,HOMCRS(B)		;BN (REL TO STR) OF CRASH.EXE
	TRNN	F,F.STR
	MOVEM	T1,CRSBN
	CAME	T1,CRSBN
	POPJ	P,
	MOVE	T1,HOMSCU(B)		;SUPER CLUSTERS PER UNIT
	TRNN	F,F.STR
	MOVEM	T1,SCPU
	CAME	T1,SCPU
	POPJ	P,
	MOVE	T1,HOMK4C(B)		;K FOR CRASH
	TRNN	F,F.STR
	MOVEM	T1,SK4C
	CAME	T1,SK4C
	POPJ	P,
	TRO	F,F.STR			;STR DATA ACCEPTED
	JRST	CPOPJ1
;ROUTINE TO COPY INFO FROM HOME BLOCK TO UDB
MOVUDB:	MOVE	T1,HOMLUN(B)		;LOGICAL UNIT NUMBER
	MOVEM	T1,UDBLUN(U)
	IMUL	T1,BPLU			;LOWEST BLOCK
	MOVEM	T1,UDBBLK(U)
	MOVE	T1,UDBBPU(U)		;HIGHEST LEGAL BLOCK
	IDIV	T1,HOMBPC(B)
	IMUL	T1,HOMBPC(B)
	SUBI	T1,1
	MOVEM	T1,UDBHLB(U)
	MOVE	T1,HOMSPU(B)		;SATS PER UNIT
	MOVEM	T1,UDBSPU(U)
	MOVE	T1,UDBBPU(U)		;CLUSTERS PER SAT
	IDIV	T1,BPC
	SUBI	T1,1
	IDIV	T1,UDBSPU(U)
	ADDI	T1,1
	MOVEM	T1,UDBCPS(U)
	SUBI	T1,1			;WORDS PER SAT
	IDIVI	T1,^D36
	ADDI	T1,1
	MOVEM	T1,UDBWPS(U)
	MOVE	T1,HOMHID(B)		;PACK SERIAL NUMBER
	MOVEM	T1,UDBHID(U)
	MOVE	T1,HOMGRP(B)		;BLOCKS TO TRY ALLOCATE
	MOVEM	T1,UDBGRP(U)
	MOVE	T1,HOMBPC(B)		;BLOCKS PER CLUSTER
	MOVEM	T1,UDBBPC(U)
	MOVE	T1,HOMSIC(B)		;SATS IN CORE
	MOVEM	T1,UDBSIC(U)
	MOVE	T1,HOMSLB(B)		;1ST BLOCK FOR SWAPPING
	MOVEM	T1,UDBSLB(U)
	MOVE	T1,HOMK4S(B)		;K FOR SWAPPING
	MOVEM	T1,UDBK4S(U)
	MOVSI	T1,(FS.UWL)		;SOFTWARE WRITE LOCK
	AND	T1,WL
	MOVEM	T1,UDBAWL(U)
	MOVE	T1,HOMLUN(B)		;LOGICAL UNIT NAME
	IDIVI	T1,10
	SKIPE	T1
	ADDI	T1,'0'
	ADDI	T2,'0'
	ROT	T2,-6
	SKIPE	T1
	LSHC	T1,-6
	MOVE	T1,ALIAS
MVUDB1:	LSH	T1,-6
	TRNN	T1,77
	JRST	MVUDB1
MVUDB2:	LSHC	T1,6
	TLNN	T1,770000
	JRST	MVUDB2
	MOVEM	T1,UDBLOG(U)
	POPJ	P,
;ROUTINE TO SAVE CAPACITY
MOVCPY:	MOVE	T1,UDBNAM(U)		;DO A DSKCHR
	MOVEM	T1,FOO+.DCNAM
	MOVE	T1,[XWD FOOSIZ,FOO]
	DSKCHR	T1,
	 PUSHJ	P,DIE
	TLNE	T1,(DC.AWL+DC.HWP)	;WRITE LOCK?
	SETOM	WL			;YES
	SETZM	UDBHWP(U)
	TLNE	T1,(DC.HWP)		;HARDWARE WRITE PROTECT?
	SETOM	UDBHWP(U)		;YES
	MOVE	T1,FOO+.DCUSZ		;SAVE UNIT SIZE
	MOVEM	T1,UDBBPU(U)
	ADDM	T1,SSIZ			;SUM OF UDBBPU
	CAMLE	T1,BIGBPU		;BIGGEST UDBBPU?
	MOVEM	T1,BIGBPU		;YES
	LOAD	T1,FOO+.DCUCH,DC.UCY	;BLOCKS PER CYLINDER
	MOVEM	T1,UDBCYL(U)
	LOAD	T1,FOO+.DCUCH,DC.UCT	;BLOCKS PER TRACK
	MOVEM	T1,UDBBPT(U)
	IMULI	T1,NSKP			;BLOCKS TO SKIP
	ADDI	T1,DSKP/2		;ROUND
	IDIVI	T1,DSKP
	MOVEM	T1,UDBSKP(U)
	MOVE	T1,FOO+.DCPAS		;POSITION IN ASL
	MOVEM	T1,UDBASL(U)
	MOVE	T1,FOO+.DCPSD		;POSITION IN SDL
	MOVEM	T1,SDL
	SKIPE	T1,FOO+.DCALT		;DON'T OVERWRITE WITH ZERO
	MOVEM	T1,UDBALT(U)		;SAVE ALTERNATE UNIT
	TRNN	F,F.702			;7.01?
	PUSHJ	P,FNDCPU		;YES, FIND WHICH CPU
	POPJ	P,
;ROUTINE TO FIND WHICH CPU(S) THE DISK IS ON.
;WE ONLY NEED THIS INFORMATION IN 7.01, BUT
;7.01 IS THE ONLY MONITOR WHERE DSKCHR DOESN'T
;RETURN THIS INFO.
FNDCPU:	SETOM	UDBCPU(U)		;ASSUME ALL CPUS
	MOVE	T1,[%LDUNI]		;ADDR OF 1ST UDB
	GETTAB	T1,
	 HALT
FNCPU1:	HLRZS	T1			;IN RH
	JUMPE	T1,CPOPJ		;GIVE UP
	MOVEI	T2,UNINAM(T1)		;GET NAME OF UNIT
	PEEK	T2,
	CAME	T2,UDBNAM(U)		;OURS?
	CAMN	T2,UDBALT(U)
	JRST	FNCPU2			;YES
	MOVEI	T1,UNISYS(T1)		;NO, GET ADDR OF NEXT UDB
	PEEK	T1,
	JRST	FNCPU1			;LOOP
FNCPU2:	MOVEI	T2,UNIKON(T1)		;ADDR OF KDB
	PEEK	T2,
	MOVEI	T2,KONCPU(T2)		;CPU WORD
	PEEK	T2,
	LSH	T2,-41			;BIT MASK
	MOVEI	T3,SP.CR0
	LSH	T3,(T2)
	MOVEM	T3,UDBCPU(U)
	SKIPN	UDBALT(U)		;2ND PORT?
	POPJ	P,			;NO
	MOVEI	T1,UNI2ND(T1)		;YES, GET ADDR OF 2ND UDB
	PEEK	T1,
	MOVEI	T2,UNINAM(T1)		;DOUBLE CHECK
	PEEK	T2,
	CAME	T2,UDBNAM(U)
	CAMN	T2,UDBALT(U)
	CAIA
	POPJ	P,
	MOVEI	T1,UNIKON(T1)		;2ND KDB
	PEEK	T1,
	MOVEI	T1,KONCPU(T1)		;CPU WORD
	PEEK	T1,
	LSH	T1,-41			;BIT MASK
	MOVEI	T2,SP.CR0
	LSH	T2,(T1)
	IORM	T2,UDBCPU(U)
	POPJ	P,
	SUBTTL	CHECK A RIB

;ROUTINE TO TEST FOR A VALID RIB
;NOSKIP IF RIB ERROR
;SKIP IF RIB IS OK
RBCK:	MOVE	T1,TCBBLK(TC)		;BN MUST POINT TO SELF
	IDIV	T1,BPLU
	MOVE	T1,RIBCOD(B)		;MAGIC NUMBER MUST BE RIGHT
	CAIN	T1,CODRIB
	CAME	T2,RIBSLF(B)
	POPJ	P,
	MOVE	T1,FILNAM(FL)		;CHECK FILENAME AND EXT
	MOVE	T2,FILEXT(FL)
	XOR	T2,RIBEXT(B)
	CAMN	T1,RIBNAM(B)
	TLNE	T2,-1
	POPJ	P,
	HRRZ	T2,RIBFIR(B)		;1ST RTP MUST BE IN RANGE
	CAIL	T2,RIBTIM+1
	CAILE	T2,RIBCOD-1
	POPJ	P,
	HLRE	T3,RIBFIR(B)		;LAST RTP MUST BE IN RANGE
	SUBM	T2,T3
	CAIL	T3,1(T2)
	CAILE	T3,RIBCOD
	POPJ	P,
	LDB	T3,TCYRBC		;GET RIB COUNT
	SKIPE	T3			;EXTENDED RIB?
	SKIPA	T4,TCBFLR(TC)		;YES, GET 1ST LOGICAL RECORD
	MOVEI	T4,1			;NO, BLOCK ONE
	SUBI	T4,1			;LAST BLOCK IN PREVIOUS RIB
	CAME	T4,RIBFLR(B)		;CHECK IT
	POPJ	P,
	ADD	T2,B			;GET 1ST RTP
	MOVE	T1,(T2)
	MOVE	T4,UDBLUN(U)		;IS IT UNIT POINTER?
	CAIN	T1,RIPNUB(T4)
	AOSA	T2			;YES, POINT TO 1ST GROUP
	JUMPE	T3,CPOPJ		;NO, ERROR UNLESS EXTENDED RIB
	MOVE	T1,(T2)			;GET 1ST GROUP POINTER
	LDB	T1,CABP			;GET CLUSTER ADDRESS
	IMUL	T1,BPC			;MUST POINT TO SELF
	CAME	T1,RIBSLF(B)
	POPJ	P,
	MOVE	T1,RIBUFD(B)		;CHECK UPWARD POINTER
	PUSHJ	P,CTINT			;CONVERT TO INTERNAL FORMAT
	IDIV	T1,BPSC
	JUMPN	T2,CPOPJ
	HLRZ	T3,FILCFP(FL)
	HRRZ	T2,FILDAD(FL)
	SKIPE	T2
	HLRZ	T3,FILCFP(T2)
	CAME	T1,T3
	POPJ	P,
	MOVE	T1,FL			;FIND UFD
RBCK1:	HRRZ	T2,FILDAD(T1)
	SKIPE	T2
	MOVE	T1,T2
	HLRZ	T2,FILEXT(T1)
	CAIE	T2,'UFD'
	JRST	RBCK1
	MOVE	T2,FILNAM(T1)
	CAMN	T2,RIBPPN(B)
	AOS	(P)
	POPJ	P,
	SUBTTL	CHECKSUMING

;READ A DATA BLOCK AND COMPUTE THE CHECKSUM
DOSUM:	PUSHJ	P,REDTCB		;READ THE BLOCK
	 JRST	IOERR			;I/O ERROR
	MOVE	T1,0(B)			;COMPUTE THE CHECKSUM
	PUSHJ	P,FOLD
	CAMN	T2,TCBSUM(TC)		;IS IT RIGHT?
	POPJ	P,			;YES
	MOVEI	T2,[ASCIZ /Checksum error on file /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO			;TYPE FILESPEC
	PUSHJ	P,CRLFO
	MOVEI	T2,[ASCIZ /Block /]
	PUSHJ	P,STRO
	MOVE	T1,TCBREL(TC)
	PUSHJ	P,OCTO
	MOVEI	T2,[ASCIZ / relative to file, cluster /]
	PUSHJ	P,STRO
	MOVE	T1,TCBBLK(TC)
	IDIV	T1,BPC
	PUSHJ	P,OCTO
	PJRST	DSPACE

DIRERR:	SKIPA	T2,[[ASCIZ /Directory is overwritten with garbage /]]
IOERR:	MOVEI	T2,[ASCIZ /Error while reading file /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO			;TYPE FILESPEC
	PUSHJ	P,CRLFO
	MOVEI	T2,[ASCIZ /Block /]
	PUSHJ	P,STRO
	MOVE	T1,TCBREL(TC)
	PUSHJ	P,OCTO
	MOVEI	T2,[ASCIZ / relative to file, block /]
	PUSHJ	P,STRO
	MOVE	T1,TCBBLK(TC)
	PUSHJ	P,BNO
	MOVEI	T2,[ASCIZ / relative to STR/]
	PUSHJ	P,STRO
DSPACE:	PUSHJ	P,CRLFO
	TRNE	F,F.TTY			;BREAK OUTPUT
	PUSHJ	P,BUFO
	PJRST	CRLFO

;ROUTINE TO COMPUTE FOLDED CHECKSUM
;T1 PASSES WORD TO BE FOLDED
;T2 RETURNS CHECKSUM
FOLD:	SETZ	T2,
	LSHC	T1,@MBPCS
	ROT	T2,@BPCS
	JUMPE	T1,CPOPJ
	ADD	T1,T2
	JRST	FOLD
	SUBTTL	CORE MANAGEMENT

;ROUTINE TO DECREMENT USE COUNT OF FIL
DECFIL:	LDB	T1,FIYCNT		;DECREMENT COUNT
	SUBI	T1,1
	DPB	T1,FIYCNT
	JUMPN	T1,CPOPJ		;OTHER USERS, LEAVE ALONE
	PUSH	P,FL			;LAST USER, SAVE ADDR
	HRRZ	FL,FILDAD(FL)		;GET ADDR OF PARENT
	SKIPE	FL			;MFD?
	PUSHJ	P,DECFIL		;NO, DECREMENT PARENT'S COUNT
	POP	P,FL			;RESTORE ADDR OF SON
	FALL	GIVFIL			;RETURN SON TO FREE LIST

;ROUTINE TO GIVE A FIL BACK TO FREE CORE
GIVFIL:	MOVEI	T1,SIZFIL
	MOVE	T2,FL
	PJRST	GIVBLK

;ROUTINE TO GIVE A TCB AWAY
GIVTCB:	LDB	T3,TCYCOD		;GET FUNCTION CODE
	MOVE	T1,FUNSZ(T3)		;SIZE
	MOVE	T2,TC			;ADDR
	PJRST	@FUNGV(T3)		;DISPATCH

;ROUTINE TO GIVE A RIB TCB AWAY
GIVRIB:	LDB	T3,TCYRBC		;PRIME OR EXTENDED?
	JUMPE	T3,GIVBLK
	MOVEI	T1,SIZXRB		;EXTENDED
	MOVE	T3,TCBCOR(TC)		;CORRUPT?
	TLNE	T3,(TCPCOR)
	MOVEI	T1,SIZCXR		;YES, CORRUPT EXTENDED RIB
	PJRST	GIVBLK
;ROUTINE TO GET A BLOCK OF CORE AND ZERO IT
;T1 PASSES SIZE OF BLK (NOT PRESERVED)
;T2 RETURNS ADDR OF BLK
GETZER:	PUSHJ	P,GETBLK		;ALLOCATE THE CORE
	SETZM	(T2)			;ZERO 1ST WORD
	CAIN	T1,1			;ONLY ONE WORD?
	POPJ	P,			;YES, ALL DONE
	HRLZI	T3,0(T2)		;BLT THE REST
	HRRI	T3,1(T2)
	ADDI	T1,-1(T2)
	BLT	T3,(T1)
	POPJ	P,

;ROUTINE TO GET A CORE BLOCK
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADDR OF BLK
GETBLK:	ADDM	T1,WRDCNT		;BUMP COUNT
	PUSHJ	P,TRYBLK		;ANY FREE BLOCKS?
	 POPJ	P,			;YES
	MOVE	T2,.JBFF		;NO, ENOUGH CORE TO MAKE 1?
	ADD	T2,T1
	CAMG	T2,.JBREL
	JRST	GTBLK1			;YES
	PUSHJ	P,GC			;NO, GARBAGE COLLECT
	PUSHJ	P,CDOWN			;CORE DOWN
	PUSHJ	P,TRYBLK		;TRY AGAIN
	 POPJ	P,			;WIN
	MOVE	T2,.JBFF		;STILL LOSE, GET MORE CORE
	ADD	T2,T1
	MOVE	T3,T2
	TRNN	F,F.HW
	ADDI	T3,<UPN-1>*PAGSIZ
	CORE	T3,
	 PUSHJ	P,DIE
GTBLK1:	EXCH	T2,.JBFF		;T2=ADDR OF BLK
	POPJ	P,

;ROUTINE TO CORE DOWN
;THIS ROUTINE MAY ONLY BE CALLED IMMEDIATELY AFTER GC
;PRESERVES T1
CDOWN:	HRRZ	T2,FREMEM		;LAST FREE NODE
	JUMPE	T2,CPOPJ
	HLRZ	T3,(T2)			;SIZE OF LAST NODE
	CAIGE	T3,DOWNN*PAGSIZ		;BIG ENOUGH?
	POPJ	P,			;NO
	ADD	T3,T2			;1ST ADDR BEYOND LAST NODE
	CAME	T3,.JBFF		;LAST NODE IS AT VERY END?
	POPJ	P,			;NO
	HRRZ	T3,(T2)			;UNLINK LAST NODE
	HRRM	T3,FREMEM
	MOVEM	T2,.JBFF		;NEW VALUE OF 1ST FREE
	CORE	T2,			;PITCH SOME CORE
	 PUSHJ	P,DIE			;MONITOR BUG?
	POPJ	P,
;ROUTINE TO TRY TO FIND A FREE CORE BLK
;T1 PASSES SIZE OF BLK (PRESERVED)
;T2 RETURNS ADDR OF BLK
;SKIP IF FAIL
TRYBLK:	PUSHJ	P,SAVE3			;SAVE P1-P3
	MOVEI	P1,-1			;FLAG NONE SO FAR
	MOVEI	P2,FREMEM		;POINT TO 0TH FREE BLK
TRYLOP:	MOVE	P3,P2			;ADVANCE TO NEXT BLK
	HRRZ	P2,(P3)
	JUMPE	P2,TRY1			;QUIT IF NO MORE BLKS
	HLRZ	T4,(P2)			;GET SIZE OF BLK
	CAML	T4,T1			;BIG ENOUGH?
	CAML	T4,P1			;AND SMALLEST SO FAR?
	JRST	TRYLOP			;NO
	SUB	T4,T1			;YES, COMPUTE SIZE OF LEFTOVER
	CAIGE	T4,SIZGAR		;IS IT JUST A CRUMB?
	JUMPN	T4,TRYLOP		;YES, DON'T LEAVE CRUMBS AROUND
	HLRZ	P1,(P2)			;REMEMBER WHERE IT IS
	MOVE	T3,P3
	JUMPN	T4,TRYLOP		;GO IF NOT PERFECT MATCH
TRY1:	CAIN	P1,-1			;QUIT IF NO WINNERS AT ALL
	JRST	CPOPJ1
	HRRZ	T2,(T3)			;ADDR OF BEST
	CAMG	P1,T1			;TOO BIG?
	JRST	TRYESY			;NO, JUST RIGHT
	MOVE	P2,T2			;COMPUTE ADDR OF LEFTOVER
	ADD	P2,T1
	SUB	P1,T1			;COMPUTE SIZE OF LEFTOVER
	HRL	P1,(T2)			;SPLIT INTO TWO BLKS
	MOVSM	P1,(P2)
	HRL	P2,T1
	MOVEM	P2,(T2)
TRYESY:	HRRZ	T4,(T2)			;UNLINK THE BLK
	HRRM	T4,(T3)
	POPJ	P,

;ROUTINE TO RETURN A BLOCK OF CORE TO FREE LIST
;T1 PASSES SIZE OF BLK
;T2 PASSES ADDR OF BLK
GIVBLK:
IFN FTGCHK,<
	CAIGE	T1,SIZGAR
	PUSHJ	P,DIE
>
	HRRZ	T3,FREMEM		;ADD TO HEAD OF LIST
	HRL	T3,T1
	MOVEM	T3,(T2)
	MOVEM	T2,FREMEM
	MOVNS	T1			;MAINTAIN COUNT
	ADDM	T1,WRDCNT
	POPJ	P,
;GARBAGE COLLECT ROUTINE
;COMBINES CONSECUTIVE FRAGMENTS
;T1 IS PRESERVED
GC:	PUSH	P,T1			;SAVE T1
	PUSH	P,QTCB			;SAVE THE TCB TREE
	PUSH	P,ROOT
	MOVE	T1,[XWD QTCB,QTCB]	;BUILD A NULL TREE
	MOVEM	T1,QTCB
	SETZM	ROOT
GC1:	HRRZ	T2,FREMEM		;ADDR OF NEXT FREE NODE
	JUMPE	T2,GC2
	HRRZ	T1,(T2)			;UNLINK IT FROM FREE LIST
	HRRM	T1,FREMEM
	HLRZ	T1,(T2)			;SIZE OF NODE
	PUSHJ	P,LNKGAR		;LINK IT INTO THE TREE
IFN FTGCHK,<
	PUSHJ	P,CHECK			;CHECK CONSISTENCY
>
	JRST	GC1			;LOOP
GC2:	HRRZ	T2,QTCB			;ADDR OF NEXT NODE
	CAIN	T2,QTCB			;QUIT IF LAST NODE
	JRST	GC3
	HRRZ	T1,TCBLNK(T2)		;UNLINK IT FROM TREE
	HRRM	T1,QTCB
	LDB	T1,TCXGAR		;LINK IT TO FREE LIST
	HRL	T1,FREMEM
	MOVSM	T1,(T2)
	HRRM	T2,FREMEM
	JRST	GC2			;LOOP
GC3:	POP	P,ROOT			;RESTORE TCB TREE
	POP	P,QTCB
	JRST	TPOPJ			;RESTORE T1
;ROUTINE TO LINK A FREE NODE INTO THE TREE
;USED ONLY FOR GC
;T1 PASSES SIZE OF BLK
;T2 PASSES ADDR OF BLK
LNKGAR:
IFN FTDBUG,<
	CAIGE	T1,SIZGAR
	PUSHJ	P,DIE
>
	DPB	T1,TCXGAR		;STORE SIZE
	SETZM	TCBSON(T2)		;NO SONS
	MOVEI	T4,BALZ			;WE ARE BALANCED
	DPB	T4,TCZBAL
	SKIPN	T4,ROOT			;1ST TIME?
	JRST	LNKGR4			;YES
LNKGR1:	MOVE	T3,T4			;ADVANCE TO NEXT NODE
	CAML	T2,T3			;TOO HIGH OR TOO LOW?
	JRST	LNKGR2			;TOO HIGH, GO RIGHT
	HLRZ	T4,TCBSON(T3)		;TOO LOW, GET LEFT SON
	JUMPN	T4,LNKGR1		;AND LOOP
	LDB	T4,TCXGAR		;JUST BEFORE PARENT?
	ADD	T4,T2
	CAME	T4,T3
	JRST	LNKG10			;NO
	LDB	T4,TCXGAR		;YES, TOO BIG TO COMBINE?
	LDB	T1,TCWGAR
	ADD	T4,T1
	CAIG	T4,TCMGAR
	JRST	LNKGR6			;NO, GO COMBINE
LNKG10:	HLRZ	T4,TCBLNK(T3)		;PRED
	CAIN	T4,QTCB
	JRST	LNKGR7			;NO PRED
	LDB	T1,TCZGAR		;JUST AFTER PRED?
	ADD	T1,T4
	CAME	T1,T2
	JRST	LNKGR7			;NO
	LDB	T1,TCZGAR		;YES, TOO BIG TO COMBINE?
	LDB	T4,TCXGAR
	ADD	T1,T4
	HLRZ	T4,TCBLNK(T3)
	CAIG	T1,TCMGAR
	JRST	LNKGR8			;NO, GO COMBINE
LNKGR7:	HRLM	T2,TCBSON(T3)		;MAKE US THE LEFT SON
	HRLM	T3,TCBRNT(T2)
;HERE WITH T4=PRED, T3=SUCC
LNKGR3:	HRRM	T2,TCBLNK(T4)		;WE ARE SUCC OF PRED
	HRLM	T2,TCBLNK(T3)		;WE ARE PRED OF SUCC
	HRL	T3,T4			;PRED,,SUCC
	MOVEM	T3,TCBLNK(T2)
	PUSH	P,T2			;PRESERVE ADDR OF NODE
	PUSHJ	P,ADDND1		;ADD NODE TO BALANCE FACTOR
T2POPJ:	POP	P,T2
	POPJ	P,

LNKGR2:	HRRZ	T4,TCBSON(T3)		;GET RIGHT SON
	JUMPN	T4,LNKGR1		;AND LOOP
	LDB	T4,TCWGAR		;JUST AFTER PARENT?
	ADD	T4,T3
	CAME	T4,T2
	JRST	LNKG11			;NO
	LDB	T4,TCWGAR		;YES, TOO BIG TO COMBINE?
	LDB	T1,TCXGAR
	ADD	T4,T1
	CAIG	T4,TCMGAR
	JRST	LNKGR5			;NO, GO COMBINE
LNKG11:	HRRZ	T4,TCBLNK(T3)		;GET SUCC
	LDB	T1,TCXGAR		;JUST BEFORE SUCC?
	ADD	T1,T2
	CAME	T1,T4
	JRST	LNKG12			;NO
	LDB	T1,TCZGAR		;YES, TOO BIG TO COMBINE?
	LDB	T4,TCXGAR
	ADD	T1,T4
	HRRZ	T4,TCBLNK(T3)
	CAIG	T1,TCMGAR
	JRST	LNKGR9			;NO, GO COMBINE
LNKG12:	HRRM	T2,TCBSON(T3)		;MAKE US THE RIGHT SON
	HRLM	T3,TCBRNT(T2)
	EXCH	T3,T4			;OTHER WAY AROUND
	JRST	LNKGR3

;HERE TO INSERT THE VERY FIRST NODE
LNKGR4:	MOVEM	T2,ROOT			;WE BECOME THE ROOT
	HRRZS	TCBRNT(T2)		;NO PARENT
	MOVE	T3,[XWD QTCB,QTCB]	;LINK US
	MOVEM	T3,TCBLNK(T2)
	HRRZM	T2,QTCB
	HRLM	T2,QTCB
	POPJ	P,

;HERE TO INSERT JUST AFTER T3
LNKGR5:	MOVE	T4,T3
;HERE TO INSERT JUST AFTER T4
LNKGR8:	LDB	T1,TCXGAR		;TOTAL SIZE
	LDB	T3,TCZGAR
	ADD	T1,T3
	DPB	T1,TCZGAR
	HRRZ	T2,TCBLNK(T4)		;NEXT
	ADD	T1,T4			;JUST BEFORE NEXT?
	CAME	T1,T2
	POPJ	P,
	LDB	T1,TCZGAR		;YES, TOO BIG TO COMBINE?
	LDB	T3,TCXGAR
	ADD	T1,T3
	CAILE	T1,TCMGAR
	POPJ	P,			;YES, DON'T COMBINE
;HERE WHEN WE JUST INSERTED A NODE WHICH IS AN EXACT FIT
;FOR WHAT WAS MISSING BETWEEN TWO OTHER NODES. COMBINE INTO A SINGLE NODE.
;HERE WITH T4=LOW NODE, T2=HIGH NODE
LNKGR0:	PUSH	P,T4			;LOW NODE
	PUSH	P,T2			;HIGH NODE
	PUSH	P,TC			;SAVE TC
	MOVE	TC,T2			;UNLINK HIGH NODE
	PUSHJ	P,UNLINK
	PUSHJ	P,UNLNK
	POP	P,TC			;RESTORE TC
	POP	P,T2			;HIGH NODE
	POP	P,T4			;LOW NODE
	JRST	LNKGR8			;GO COMBINE

;HERE TO INSERT JUST BEFORE T3
LNKGR6:	MOVE	T4,T3
;HERE TO INSERT JUST BEFORE T4
LNKGR9:	HLRZ	T1,TCBRNT(T4)		;COPY PARENT
	HRLM	T1,TCBRNT(T2)
	SKIPN	T1
	MOVEI	T1,ROOT-TCBSON
	HLRZ	T3,TCBSON(T1)		;LEFT SON OF PARENT OR RIGHT?
	CAMN	T3,T4
	HRLM	T2,TCBSON(T1)		;LEFT
	CAME	T3,T4
	HRRM	T2,TCBSON(T1)		;RIGHT
	HLRZ	T1,TCBLNK(T4)		;PRED
	HRRM	T2,TCBLNK(T1)		;PRED HAS NEW SUCC
	HRRZ	T1,TCBLNK(T4)		;SUCC
	HRLM	T2,TCBLNK(T1)		;SUCC HAS NEW PRED
	HLRZ	T1,TCBSON(T4)		;LEFT SON HAS NEW PARENT
	SKIPE	T1
	HRLM	T2,TCBRNT(T1)
	HRRZ	T1,TCBSON(T4)		;RIGHT SON HAS NEW PARENT
	SKIPE	T1
	HRLM	T2,TCBRNT(T1)
	MOVE	T1,TCBSON(T4)		;COPY SONS
	MOVEM	T1,TCBSON(T2)
	MOVE	T1,TCBLNK(T4)		;COPY LINKS
	MOVEM	T1,TCBLNK(T2)
	LDB	T1,TCVBAL		;COPY BALANCE FACTOR
	DPB	T1,TCZBAL
	LDB	T1,TCXGAR		;TOTAL SIZE
	LDB	T3,TCZGAR
	ADD	T1,T3
	DPB	T1,TCXGAR
	HLRZ	T4,TCBLNK(T2)		;PRED
	CAIN	T4,QTCB
	POPJ	P,			;NO PRED
	LDB	T1,TCZGAR		;JUST AFTER PRED?
	ADD	T1,T4
	CAME	T1,T2
	POPJ	P,			;NO
	LDB	T1,TCXGAR		;YES, TOO BIG TO COMBINE?
	LDB	T3,TCZGAR
	ADD	T1,T3
	CAIG	T1,TCMGAR
	JRST	LNKGR0			;NO, GO COMBINE
	POPJ	P,			;YES, DON'T COMBINE
;ROUTINE TO INSERT A TCB INTO THE QUEUE
;T1 PASSES BN
;T2 PASSES ADDR OF TCB (PRESERVED)
LNKTCB:	MOVEM	T1,TCBBLK(T2)		;STORE BN
	SETZB	T4,TCBSON(T2)		;WE HAVE NO SONS
	DPB	T4,TCZCX		;NOT YET LOADED INTO CACHE
	MOVSI	T4,(TCPMBB)		;NOT BAD
	ANDCAM	T4,TCBMBB(T2)
	MOVEI	T4,BALZ			;WE ARE BALANCED
	DPB	T4,TCZBAL
	SKIPN	T4,ROOT			;1ST TIME?
	JRST	LNKTC4			;YES
LNKTC1:	MOVE	T3,T4			;ADVANCE TO NEXT NODE
	CAML	T1,TCBBLK(T3)		;TOO HIGH OR TOO LOW?
	JRST	LNKTC2			;TOO HIGH, GO RIGHT
	HLRZ	T4,TCBSON(T3)		;TOO LOW, GET LEFT SON
	JUMPN	T4,LNKTC1		;AND LOOP
	HRLM	T2,TCBSON(T3)		;NONE, MAKE US THE LEFT SON
	HRLM	T3,TCBRNT(T2)
	HLRZ	T4,TCBLNK(T3)		;GET PRED
;HERE WITH T4=PRED, T3=SUCC
LNKTC3:	HRRM	T2,TCBLNK(T4)		;WE ARE SUCC OF PRED
	HRLM	T2,TCBLNK(T3)		;WE ARE PRED OF SUCC
	HRL	T3,T4			;PRED,,SUCC
	MOVEM	T3,TCBLNK(T2)
	PUSH	P,T2			;PRESERVE ADDR OF NODE
	PUSHJ	P,ADDND1		;ADD NODE TO BALANCE FACTOR
IFN FTCHK,<
	PUSHJ	P,CHECK			;CHECK CONSISTENCY
>
	JRST	T2POPJ

LNKTC2:	HRRZ	T4,TCBSON(T3)		;GET RIGHT SON
	JUMPN	T4,LNKTC1		;AND LOOP
	HRRM	T2,TCBSON(T3)		;NONE, MAKE US THE RIGHT SON
	HRLM	T3,TCBRNT(T2)
LNKTC5:	HRRZ	T4,TCBLNK(T3)		;GET SUCC
	EXCH	T3,T4			;OTHER WAY AROUND
	JRST	LNKTC3

LNKTC4:	MOVEM	T2,ROOT			;WE BECOME THE ROOT
	HRRZS	TCBRNT(T2)		;NO PARENT
	HRRZ	T3,QTCB			;LINK US
	JRST	LNKTC5
;ROUTINE TO UNLINK THE TCB FROM THE QUEUE
UNLNK:	HLRZ	T1,TCBLNK(TC)		;UNLINK TCB FROM QUEUE
	HRRZ	T2,TCBLNK(TC)
	HRRM	T2,TCBLNK(T1)
	HRLM	T1,TCBLNK(T2)
	POPJ	P,

;ROUTINE TO UNLINK THE TCB FROM THE TREE
UNLINK:	HLRZ	T1,TCBSON(TC)		;DO WE HAVE A LEFT SON?
	JUMPE	T1,UNLNK6		;NO, EASY
	HRRZ	T1,TCBSON(TC)		;DO WE HAVE A RIGHT SON?
	JUMPE	T1,UNLNK6		;NO, EASY

;HERE WHEN WE HAVE BOTH LEFT AND RIGHT SONS
	MOVE	T1,TC			;NODE TO MOVE OUT
	LDB	T4,TCXBAL		;ITS BALANCE FACTOR
	HRRZ	T2,TCBLNK(T1)		;NODE TO MOVE IN
	CAIL	T4,BALZ
	HLRZ	T2,TCBLNK(T1)
IFN FTDBUG,<
	HLRZ	T3,TCBSON(T2)		;LEFT CORNER CAN'T HAVE LEFT SON
	CAIL	T4,BALZ
	HRRZ	T3,TCBSON(T2)		;RIGHT CORNER CAN'T HAVE RIGHT SON
	SKIPE	T3
	PUSHJ	P,DIE
>
	PUSH	P,T1			;NODE TO MOVE OUT
	PUSH	P,T2			;NODE TO MOVE IN
	PUSHJ	P,ORPHAN		;UNLINK CORNER NODE FROM ITS OLD POSITION
	POP	P,T2			;NODE TO MOVE IN
	POP	P,T1			;NODE TO MOVE OUT
	PJRST	SWAP			;T2 NODE TAKES PLACE OF T1 NODE

;HERE WHEN WE DON'T HAVE BOTH SONS
UNLNK6:	MOVE	T2,TC			;NODE TO UNLINK
	PJRST	ORPHAN			;BLAST IT
;ROUTINE TO ADD A NODE TO THE BALANCE FACTOR
;T1 PASSES ADDR OF NODE JUST ADDED
ADDNOD:	MOVE	T2,T1			;WANT IT IN OTHER AC
;HERE WITH ADDR OF NODE IN T2
ADDND1:	HLRZ	T1,TCBRNT(T2)		;PARENT
	JUMPE	T1,CPOPJ		;NOBODY TO ADD TO
	MOVEI	T3,1			;ASSUME LEFT SON
	HLRZ	T4,TCBSON(T1)		;LEFT SON?
	CAME	T4,T2
	SETO	T3,			;NO, RIGHT SON
	LDB	T4,TCXBAL		;PARENT'S BALANCE FACTOR
	ADD	T4,T3			;UPDATE BALANCE FACTOR
	DPB	T4,TCXBAL
	CAIL	T4,BALM			;WITHIN TOLERANCE?
	CAILE	T4,BALP
	PUSHJ	P,REBAL			;NO, REBALANCE THE TREE
	CAIE	T4,BALZ			;PERFECTLY BALANCED?
	JRST	ADDNOD			;NO, ADJUST GRANDPA TOO
	POPJ	P,			;YES
;ROUTINE TO SUBTRACT A NODE FROM THE BALANCE FACTOR
;T1 PASSES ADDR OF PARENT (OF NODE JUST DELETED)
;T3 PASSES DELTA FACTOR
SUBNOD:	LDB	T4,TCXBAL		;GET PARENT'S BALANCE FACTOR
	ADD	T4,T3			;ADJUST BALANCE FACTOR
	DPB	T4,TCXBAL
	CAIL	T4,BALM			;WITHIN TOLERANCE?
	CAILE	T4,BALP
	PUSHJ	P,REBAL			;NO, REBALANCE THE TREE
	CAIE	T4,BALZ			;PERFECTLY BALANCED?
	POPJ	P,			;NO, ALL DONE
	MOVE	T2,T1			;YES, SAVE ADDR OF PARENT
	HLRZ	T1,TCBRNT(T2)		;GET ADDR OF GRANDPA
	JUMPE	T1,CPOPJ		;NONE
	MOVEI	T3,1			;ASSUME FATHER IS RIGHT SON OF GRANDPA
	HRRZ	T4,TCBSON(T1)		;TRUE?
	CAME	T4,T2
	SETO	T3,			;NO, LEFT SON
	JRST	SUBNOD			;UPDATE GRANDPA'S BALANCE FACTOR
;ROUTINE TO REBALANCE THE TREE
;I.E. MAKE BALANCE FACTOR BETTER BY ROTATING THE ROOT NODE
;T1 PASSES ROOT OF UNBALANCED SUBTREE
;T4 PASSES BALANCE FACTOR OF ROOT
;T1 RETURNS NEW ROOT
;T4 RETURNS NEW BALANCE FACTOR OF NEW ROOT
REBAL:	PUSHJ	P,SAVE2			;SAVE ACS
	HLRZ	P1,TCBRNT(T1)		;ORIGINAL PARENT OF ORIGINAL ROOT
	CAIL	T4,BALZ			;RIGHT HEAVY OR LEFT HEAVY?
	JRST	REBL			;LEFT HEAVY
	FALL	REBR			;RIGHT HEAVY

;HERE IF RIGHT HEAVY
REBR:	HRRZ	T2,TCBSON(T1)		;B
IFN FTDBUG,<
	SKIPN	T2
	PUSHJ	P,DIE
>
	HLRZ	T3,TCBSON(T2)		;Y OR C
	LDB	T4,TCZBAL		;B BALANCE
IFN FTDBUG,<
	CAIL	T4,BALM
	CAILE	T4,BALP
	PUSHJ	P,DIE
>
	CAIN	T4,BALP
	JRST	REBR3
	MOVE	P2,[EXP BALZ,BALM]-BALM(T4)
	DPB	P2,TCXBAL
	MOVE	P2,[EXP BALZ,BALP]-BALM(T4)
	DPB	P2,TCZBAL
	HRRM	T3,TCBSON(T1)
	SKIPE	T3
	HRLM	T1,TCBRNT(T3)
	HRLM	T1,TCBSON(T2)
	HRLM	T2,TCBRNT(T1)
	JRST	REBCM

;CASE R3
REBR3:
IFN FTDBUG,<
	SKIPN	T3
	PUSHJ	P,DIE
>
	LDB	T4,TCWBAL
IFN FTDBUG,<
	CAIL	T4,BALM
	CAILE	T4,BALP
	PUSHJ	P,DIE
>
	MOVEI	P2,BALZ
	DPB	P2,TCWBAL
	MOVE	P2,[EXP BALP,BALZ,BALZ]-BALM(T4)
	DPB	P2,TCXBAL
	MOVE	P2,[EXP BALZ,BALZ,BALM]-BALM(T4)
	DPB	P2,TCZBAL
	HLRZ	T4,TCBSON(T3)		;Y1
	HRRM	T4,TCBSON(T1)
	SKIPE	T4
	HRLM	T1,TCBRNT(T4)
	HRRZ	T4,TCBSON(T3)		;Y2
	HRLM	T4,TCBSON(T2)
	SKIPE	T4
	HRLM	T2,TCBRNT(T4)
	HRLZM	T1,TCBSON(T3)
	HRLM	T3,TCBRNT(T1)
	HRRM	T2,TCBSON(T3)
	HRLM	T3,TCBRNT(T2)
	JRST	REBCOM
;HERE IF LEFT HEAVY
REBL:	HLRZ	T2,TCBSON(T1)		;B
IFN FTDBUG,<
	SKIPN	T2
	PUSHJ	P,DIE
>
	HRRZ	T3,TCBSON(T2)		;Y OR C
	LDB	T4,TCZBAL		;B BALANCE
IFN FTDBUG,<
	CAIL	T4,BALM
	CAILE	T4,BALP
	PUSHJ	P,DIE
>
	CAIN	T4,BALM
	JRST	REBL3
	MOVE	P2,[EXP BALP,BALZ]-BALZ(T4)
	DPB	P2,TCXBAL
	MOVE	P2,[EXP BALM,BALZ]-BALZ(T4)
	DPB	P2,TCZBAL
	HRLM	T3,TCBSON(T1)
	SKIPE	T3
	HRLM	T1,TCBRNT(T3)
	HRRM	T1,TCBSON(T2)
	HRLM	T2,TCBRNT(T1)
	JRST	REBCM

;CASE L3
REBL3:
IFN FTDBUG,<
	SKIPN	T3
	PUSHJ	P,DIE
>
	LDB	T4,TCWBAL
IFN FTDBUG,<
	CAIL	T4,BALM
	CAILE	T4,BALP
	PUSHJ	P,DIE
>
	MOVEI	P2,BALZ
	DPB	P2,TCWBAL
	MOVE	P2,[EXP BALZ,BALZ,BALM]-BALM(T4)
	DPB	P2,TCXBAL
	MOVE	P2,[EXP BALP,BALZ,BALZ]-BALM(T4)
	DPB	P2,TCZBAL
	HLRZ	T4,TCBSON(T3)		;Y2
	HRRM	T4,TCBSON(T2)
	SKIPE	T4
	HRLM	T2,TCBRNT(T4)
	HRRZ	T4,TCBSON(T3)		;Y1
	HRLM	T4,TCBSON(T1)
	SKIPE	T4
	HRLM	T1,TCBRNT(T4)
	HRLZM	T2,TCBSON(T3)
	HRLM	T3,TCBRNT(T2)
	HRRM	T1,TCBSON(T3)
	HRLM	T3,TCBRNT(T1)
	FALL	REBCOM
;COMMON EXIT FOR REBAL
REBCOM:	MOVE	T2,T3

;HERE WITH:
;T1=OLD ROOT
;T2=NEW ROOT
;P1=OLD PARENT OF OLD ROOT
REBCM:	HRLM	P1,TCBRNT(T2)
	SKIPN	P1
	MOVEI	P1,ROOT-TCBSON
	HRRZ	T3,TCBSON(P1)
	CAMN	T3,T1
	HRRM	T2,TCBSON(P1)
	CAME	T3,T1
	HRLM	T2,TCBSON(P1)
	MOVE	T1,T2			;NEW ROOT
	LDB	T4,TCXBAL		;NEW BALANCE OF NEW ROOT
	POPJ	P,
;ROUTINE TO UNLINK A NODE FROM THE TREE
;THIS ROUTINE ONLY WORKS IF THE NODE DOESN'T HAVE BOTH SONS
;T2 PASSES NODE
ORPHAN:	HLRZ	T1,TCBRNT(T2)		;GET PARENT
	HRRZ	T3,TCBSON(T2)		;GET SON (IF ANY)
	SKIPN	T3
	HLRZ	T3,TCBSON(T2)
	SKIPE	T3			;HAVE SON?
	HRLM	T1,TCBRNT(T3)		;YES, SON GETS NEW PARENT
	SKIPN	T1			;DELETING THE ROOT?
	MOVEI	T1,ROOT-TCBSON		;YES, FAKE PARENT
	HRRZ	T4,TCBSON(T1)		;RIGHT SON OR LEFT SON?
	CAME	T4,T2
	JRST	ORPHN1			;LEFT
	HRRM	T3,TCBSON(T1)		;RIGHT, PARENT GETS NEW SON
	MOVEI	T3,1			;DELTA BALANCE FACTOR
	HLRZ	T1,TCBRNT(T2)		;GET PARENT BACK
	JUMPN	T1,SUBNOD
	POPJ	P,

;HERE IF THE NODE WE'RE DELETING IS A LEFT SON
ORPHN1:
IFN FTDBUG,<
	HLRZ	T4,TCBSON(T1)		;DOUBLE CHECK
	CAME	T4,T2
	PUSHJ	P,DIE
>
	HRLM	T3,TCBSON(T1)		;PARENT GETS NEW SON
	SETO	T3,			;DELTA BALANCE FACTOR
	HLRZ	T1,TCBRNT(T2)		;GET PARENT BACK
	JUMPN	T1,SUBNOD
	POPJ	P,
;T2 NODE TAKES T1 NODE'S PLACE
;PRESERVES T1 AND T2
SWAP:	HRRZ	T3,TCBSON(T1)		;COPY RIGHT SON (IF ANY)
	HRRM	T3,TCBSON(T2)
	SKIPE	T3			;RIGHT SON EXIST?
	HRLM	T2,TCBRNT(T3)		;YES, RIGHT SON GETS NEW PARENT
	HLRZ	T3,TCBSON(T1)		;COPY LEFT SON (IF ANY)
	HRLM	T3,TCBSON(T2)
	SKIPE	T3			;LEFT SON EXIST?
	HRLM	T2,TCBRNT(T3)		;YES, LEFT SON GETS NEW PARENT
	LDB	T3,TCXBAL		;COPY BALANCE FACTOR
	DPB	T3,TCZBAL
	HLRZ	T3,TCBRNT(T1)		;COPY PARENT
	HRLM	T3,TCBRNT(T2)
	SKIPN	T3			;ROOT?
	MOVEI	T3,ROOT-TCBSON		;YES, FAKE PARENT
	HRRZ	T4,TCBSON(T3)		;ARE WE RIGHT SON?
	CAMN	T4,T1
	HRRM	T2,TCBSON(T3)		;YES, UPDATE PARENT
	CAME	T4,T1			;ARE WE LEFT SON?
	HRLM	T2,TCBSON(T3)		;YES, UPDATE PARENT
	POPJ	P,
IFN FTCHK,<IFN FTGCHK,<PRINTX FTCHK AND FTGCHK CANNOT BOTH BE ON>>
IFN FTCHK!FTGCHK,<
;ROUTINE TO CHECK THE ENTIRE TREE FOR CONSISTENCY
CHECK:	SETZ	T1,			;START AT ROOT
	SKIPE	T2,ROOT
	PUSHJ	P,CTREE
	HRRZ	T1,QTCB			;DOES 1ST NODE POINT TO 2ND?
	HLRZ	T1,TCBLNK(T1)
	CAIE	T1,QTCB
	PUSHJ	P,DIE			;NO
	POPJ	P,

;ROUTINE TO CHECK A NODE FOR CONSISTENCY
;T2 PASSES NODE TO BE CHECKED
;T1 PASSES WHAT PARENT SHOULD BE
;T2 RETURNS HEIGHT OF TREE
CTREE:	HLRZ	T3,TCBRNT(T2)		;CHECK PARENT
	CAME	T3,T1
	PUSHJ	P,DIE
	MOVE	T1,T2			;SAVE ADDR OF ROOT
	HRRZ	T2,TCBLNK(T1)		;NEXT NODE POINT BACK TO US?
	HLRZ	T3,TCBLNK(T2)
	CAME	T3,T1
	PUSHJ	P,DIE
IFN FTCHK,<
	HRLOI	T3,377777		;ASSUME LAST NODE
	CAIE	T2,QTCB			;TRUE?
	MOVE	T3,TCBBLK(T2)		;NO, GET BN OF NEXT NODE
	CAMG	T3,TCBBLK(T1)		;NEXT BN SHOULD BE GREATER
>
IFN FTGCHK,<
	CAIN	T2,QTCB			;LAST NODE?
	MOVSI	T2,1			;YES, FAKE ADDR
	LDB	T3,TCVGAR		;LAST ADDR IN THIS NODE
	ADD	T3,T1
	CAMGE	T2,T3			;NEXT NODE SHOULD BE GREATER ADDR
>
	PUSHJ	P,DIE
	HLRZ	T2,TCBSON(T1)		;LEFT SUBTREE
	JUMPE	T2,CTREE1		;NONE
IFN FTCHK,<
	MOVE	T3,TCBBLK(T2)		;LEFT BN SHOULD BE LESS
	CAML	T3,TCBBLK(T1)
>
IFN FTGCHK,<
	CAML	T2,T1			;LEFT SON SHOULD BE LOWER ADDR
>
	PUSHJ	P,DIE
	PUSH	P,T1			;SAVE ROOT
	PUSHJ	P,CTREE			;CHECK LEFT SUBTREE
	POP	P,T1			;RESTORE ROOT
CTREE1:	PUSH	P,T2			;SAVE HEIGHT OF LEFT SUBTREE
	HRRZ	T2,TCBSON(T1)		;RIGHT SUBTREE
	JUMPE	T2,CTREE2		;NONE
IFN FTCHK,<
	MOVE	T3,TCBBLK(T2)		;RIGHT BN SHOULD BE GREATER
	CAMG	T3,TCBBLK(T1)
>
IFN FTGCHK,<
	CAMG	T2,T1			;RIGHT SON SHOULD BE HIGHER ADDR
>
	PUSHJ	P,DIE
	PUSH	P,T1			;SAVE ROOT
	PUSHJ	P,CTREE			;CHECK RIGHT SUBTREE
	POP	P,T1			;RESTORE ROOT
CTREE2:	POP	P,T3			;RESTORE HEIGHT OF LEFT SUBTREE
	MOVEI	T4,BALZ(T3)		;COMPUTE BALANCE FACTOR
	SUB	T4,T2
	CAIL	T4,BALM			;IN RANGE?
	CAILE	T4,BALP
	PUSHJ	P,DIE
	LDB	T1,TCXBAL		;MATCH EXPECTED?
	CAME	T1,T4
	PUSHJ	P,DIE
	CAMGE	T2,T3			;HEIGHT OF THIS TREE IS GREATER OF
	MOVE	T2,T3			; HEIGHTS OF SUBTREES
	AOJA	T2,CPOPJ		; PLUS ONE
>
	SUBTTL	BLOCK NUMBER

;ROUTINE TO TEST IF BN IS LEGAL
;T1 PASSES BN RELATIVE TO STR (DESTROYED)
;SKIP IF LEGAL
LEGALP:	IDIV	T1,BPLU
	CAMLE	T1,HUN
	POPJ	P,
	HRRZ	T1,TABUDB(T1)
	CAMG	T2,UDBHLB(T1)
	AOS	(P)
	POPJ	P,

;ROUTINE TO CONVERT BN TO INTERNAL FORMAT
CTINT:	IDIV	T1,BIGBPU
	IMUL	T1,BPLU
	ADD	T1,T2
	POPJ	P,

;ROUTINE TO CONVERT BN TO MONITOR FORMAT
CTMON:	IDIV	T1,BPLU
	IMUL	T1,BIGBPU
	ADD	T1,T2
	POPJ	P,
	SUBTTL	PRINTOUT ROUTINES

;ROUTINE TO PRINT A FILESPEC
FILO:	HLRZ	T1,FILEXT(FL)		;A UFD?
	CAIN	T1,'UFD'
	JRST	FILO1			;YES
	MOVE	T2,FILNAM(FL)		;FILENAME
	PUSHJ	P,SIXO
	JRST	FILO2
FILO1:	MOVEI	T1,"["
	PUSHJ	P,CO
	PUSHJ	P,PPNO			;PRINT PPN
	MOVEI	T1,"]"
	PUSHJ	P,CO
FILO2:	MOVEI	T1,"."			;DOT
	PUSHJ	P,CO
	HLLZ	T2,FILEXT(FL)		;EXTENSION
	PUSHJ	P,SIXO
	HRRZ	T1,FILDAD(FL)		;QUIT IF MFD
	JUMPE	T1,CPOPJ
	HRRZ	T1,FILDAD(T1)		;OR UFD
	JUMPE	T1,CPOPJ
	MOVEI	T1,"["			;BEGIN PATH
	PUSHJ	P,CO
	PUSH	P,FL
	HRRZ	FL,FILDAD(FL)
	PUSHJ	P,PTHO
	MOVEI	T1,"]"			;END PATH
	PUSHJ	P,CO
FLPOPJ:	POP	P,FL
	POPJ	P,

;ROUTINE TO PRINT THE PATH
PTHO:	PUSH	P,FL			;SAVE CURRENT FILE
	HRRZ	FL,FILDAD(FL)		;ADDR OF PARENT
	JUMPE	FL,FLPOPJ		;QUIT IF NONE
	PUSHJ	P,PTHO			;PRINT PARENT FIRST
	POP	P,FL			;RESTORE SELF
	HLRZ	T1,FILEXT(FL)		;SFD OR UFD?
	CAIN	T1,'UFD'
	PJRST	PPNO			;UFD
	MOVEI	T1,","			;SFD
	PUSHJ	P,CO
	MOVE	T2,FILNAM(FL)		;SFD NAME
	PJRST	SIXO

;ROUTINE TO OUTPUT A PPN
PPNO:	HLRZ	T1,FILNAM(FL)		;UFD, PRINT PROJECT
	PUSHJ	P,OCTO
	MOVEI	T1,","
	PUSHJ	P,CO
	HRRZ	T1,FILNAM(FL)		;PRINT PROGRAMMER
	PJRST	OCTO
;ROUTINE TO OUTPUT A BLOCK NUMBER (RELATIVE TO STR)
BNO:	PUSHJ	P,CTMON			;CONVERT TO MONITOR FORMAT
	FALL	OCTO

;ROUTINE TO OUTPUT AN OCTAL/DECIMAL NUMBER
;T1 PASSES THE NUMBER
OCTO:	SKIPA	T3,[10]
DECO:	MOVEI	T3,^D10
DECO1:	IDIV	T1,T3
	HRLM	T2,(P)
	SKIPE	T1
	PUSHJ	P,DECO1
	HLRZ	T1,(P)
	ADDI	T1,"0"
	JRST	CO

;ROUTINE TO OUTPUT A CHAR
;T1 PASSES THE CHAR
CO:	CAIN	T1,12			;LINE FEED?
	SETZM	HPOS			;YES, RESET POSITION
	AOS	HPOS			;NO, COUNT HORIZONTAL POSITION
	TRNE	F,F.TTC			;USE TTCALL?
	OUTCHR	T1			;YES
	TRNE	F,F.SIL			;TTCALL ONLY?
	POPJ	P,			;YES
CO3:	SOSGE	OBUF+.BFCTR
	JRST	CO2
	IDPB	T1,OBUF+.BFPTR
	POPJ	P,
CO2:	PUSHJ	P,BUFO
	JRST	CO3

;ROUTINE TO OUTPUT A BUFFER
BUFO:	OUT	TO,
	 POPJ	P,
	PUSHJ	P,DIE

;ROUTINE TO OUTPUT A SIXBIT NAME
;T2 PASSES THE NAME
SIXO:	LSHC	T1,6
	ANDI	T1,77
	ADDI	T1,"A"-'A'
	PUSHJ	P,CO
	JUMPN	T2,SIXO
	POPJ	P,
;ROUTINE TO OUTPUT A CRLF
CRLFO:	MOVEI	T2,[BYTE (7)15,12]
	FALL	STRO

;ROUTINE TO OUTPUT AN ASCIZ STRING
;T2 PASSES ADDR OF STRING
STRO:	HRLI	T2,(POINT 7)
STRO1:	ILDB	T1,T2
	JUMPE	T1,CPOPJ
	PUSHJ	P,CO
	JRST	STRO1

;ROUTINE TO PRINT UNIT NAME
UNITO:	MOVE	T2,UDBNAM(U)
	PUSHJ	P,SIXO
	MOVEI	T1,"("
	PUSHJ	P,CO
	MOVE	T2,UDBLOG(U)
	PUSHJ	P,SIXO
	MOVEI	T1,")"
	PJRST	CO
;ROUTINE TO TELL THE OPR WHICH STR WE ARE DOING
BEGIN:	PUSHJ	P,ONTTC			;USE TTCALLS
	MOVEI	T2,[ASCIZ /Beginning /]
	PUSHJ	P,STRO
	MOVE	T2,ALIAS
	PUSHJ	P,SIXO
	PJRST	DSPACE

;COROUTINE TO TURN ON TTCALLS
ONTTC:	TRNE	F,F.TTY			;LOG DIRECTLY TO TTY?
	POPJ	P,			;YES
	TRO	F,F.TTC			;NO, DO THIS PART DIRECTLY
	POP	P,T1			;CALL THE CALLER
	PUSHJ	P,@T1
	TRZ	F,F.TTC			;STOP TTCALLS
	POPJ	P,

;COROUTINE TO ENTER TTCALL ONLY MODE
ONSIL:	SKIPN	LOGSTR			;LOG FILE TO DISK?
	POPJ	P,			;NO
	TRO	F,F.TTC+F.SIL		;TTCALL ONLY
	POP	P,T1			;CALL THE CALLER
	PUSHJ	P,@T1
	TRZ	F,F.TTC+F.SIL		;NORMAL OUTPUT
	POPJ	P,
	SUBTTL	ADD/REMOVE STR

;ROUTINE TO REMOVE A STR
RSTR:	PUSHJ	P,RASL			;REMOVE FROM ASL
	 JRST	RSTR3			;PUT OTHER UNITS BACK
	PUSHJ	P,RSDL			;REMOVE FROM SDL
	 JRST	RSTR3
	PUSHJ	P,RSSL			;REMOVE FROM SSL
	 JRST	RSTR2
	MOVEI	T1,.FSREM		;FUNCTION CODE
	MOVEM	T1,FOO+.FSFCN
	MOVE	T1,ALIAS		;STR NAME
	MOVEM	T1,FOO+.FSMNM
	MOVE	T1,[XWD 2,FOO]		;REMOVE IT
	STRUUO	T1,
	 JRST	RSTR0
	JRST	CPOPJ1

RSTR0:	PUSHJ	P,ASSL			;PUT BACK IN SSL
	 JFCL
RSTR2:	PUSHJ	P,ASDL			;PUT BACK IN SDL
	 JFCL
RSTR3:	PUSHJ	P,AASL			;PUT BACK IN ASL
	POPJ	P,

;ROUTINE TO REMOVE STR FROM ASL (IF NECESSARY)
RASL:	MOVE	T1,HUN			;HIGHEST UNIT NUMBER
RASL2:	HRRZ	U,TABUDB(T1)		;ADDR OF UDB
	SKIPGE	UDBASL(U)		;IN ASL?
	JRST	RASL1			;NO
	MOVEI	T2,UDBNAM(U)		;REMOVE FROM ASL
	HRLI	T2,.DUSWP
	DISK.	T2,
	 CAIA
	JRST	RASL1
	CAIE	T2,DUOIP%		;MIGRATE ALREADY IN PROGRESS?
	POPJ	P,
	PUSHJ	P,SLPY			;SLEEP AWHILE
	JRST	RASL2			;TRY AGAIN
RASL1:	SOJGE	T1,RASL2		;LOOP FOR EACH UNIT
	JRST	CPOPJ1

;ROUTINE TO REMOVE STR FROM SDL (IF NECESSARY)
RSDL:	SKIPGE	SDL			;IN SDL?
	JRST	CPOPJ1			;NO
	MOVE	T1,[XWD .DURSD,ALIAS]	;YES, REMOVE IT
	DISK.	T1,
	 POPJ	P,
	JRST	CPOPJ1

;ROUTINE TO REMOVE STR FROM SSL (IF NECESSARY)
RSSL:	SETZM	FOO+.DFGJN		;SSL=JOB 0
	SETOM	FOO+.DFGNM		;1ST STR PLEASE
	SETZB	T2,PSSL			;POSITION IN SSL
	MOVEI	T3,SSL+.FSDSO		;ADDR TO STORE 1ST STR
RSSL1:	ADDI	T2,1			;BUMP POSITION
	MOVE	T1,[XWD 5,FOO]		;GET NEXT STR
	GOBSTR	T1,
	 POPJ	P,
	MOVE	T1,FOO+.DFGNM
	CAME	T1,ALIAS		;OUR STR?
	JRST	RSSL2			;NO
	MOVEM	T2,PSSL			;YES, SAVE POSITION
	MOVE	T1,FOO+.DFGST		;SAVE STATUS
	MOVEM	T1,SSLSTS
	JRST	RSSL1			;LOOP
RSSL2:	JUMPE	T1,RSSL3		;GO IF END OF LIST
	MOVEM	T1,.DFJNM(T3)		;COPY STR NAME
	MOVE	T1,FOO+.DFGST		;AND STATUS
	MOVEM	T1,.DFJST(T3)
	SETZM	.DFJDR(T3)
	ADDI	T3,3			;BUMP ADDR
	JRST	RSSL1			;LOOP
RSSL3:	SKIPN	PSSL			;IN SSL?
	JRST	CPOPJ1			;NO
	MOVEI	T1,.FSDSL		;FUNCTION
	MOVEM	T1,SSL+.FSFCN
	SETZM	SSL+.FSDJN		;JOB 0
	MOVEI	T1,DF.SRM		;REMOVE
	MOVEM	T1,SSL+.FSDFL
	MOVSI	T1,-SSL(T3)		;DO IT
	HRRI	T1,SSL
	STRUUO	T1,
	 POPJ	P,
	JRST	CPOPJ1
;ROUTINE TO ADD A STR
ASTR:	MOVEI	T1,.FSDEF		;FUNCTION
	MOVEM	T1,DEFIN+.FSFCN
	MOVE	T1,[XWD SZSDB,SDB]	;ADDR OF STR DATA BLOCK
	MOVEM	T1,DEFIN+.FSNST
	MOVE	T1,[XWD DEFINL,DEFIN]
	STRUUO	T1,
	 POPJ	P,
	PUSHJ	P,ASSL			;PUT BACK IN SSL
	 JFCL
	PUSHJ	P,ASDL			;PUT BACK IN SDL
	 JFCL
	PUSHJ	P,AASL			;PUT BACK IN ASL
	JRST	CPOPJ1

;ROUTINE TO ADD STR TO ASL
AASL:	MOVE	T1,HUN			;HIGHEST UNIT NUMBER
AASL1:	HRRZ	U,TABUDB(T1)		;ADDR OF UDB
	SKIPGE	UDBASL(U)		;BELONGS IN ASL?
	JRST	AASL2			;NO
	MOVEI	T2,UDBNAM(U)		;PUT UNIT IN ASL
	HRLI	T2,.DUASW
	DISK.	T2,
	 JFCL
AASL2:	SOJGE	T1,AASL1		;LOOP FOR EACH UNIT
	POPJ	P,

;ROUTINE TO ADD STR TO SDL
ASDL:	SKIPGE	SDL			;BELONGS IN SDL?
	JRST	CPOPJ1			;NO
	MOVE	T1,[XWD .DUASD,ALIAS]	;YES, PUT IT BACK
	DISK.	T1,
	 POPJ	P,
	JRST	CPOPJ1

;ROUTINE TO ADD STR TO SSL
ASSL:	SKIPN	PSSL			;BELONGS IN SSL?
	JRST	CPOPJ1			;NO
	SETZM	FOO+.DFGJN		;SSL=JOB 0
	SETOM	FOO+.DFGNM		;1ST STR PLEASE
	SETZ	T2,			;POSITION IN SSL
	MOVEI	T3,SSL+.FSDSO		;ADDR TO STORE 1ST STR
ASSL1:	ADDI	T2,1			;BUMP POSITION
	CAME	T2,PSSL			;NOW?
	JRST	ASSL4			;NO, NOT YET
	MOVE	T1,ALIAS		;YES, COPY STR NAME
	MOVEM	T1,.DFJNM(T3)
	MOVE	T1,SSLSTS		;COPY STATUS
	MOVEM	T1,.DFJST(T3)
	SETZM	.DFJDR(T3)
	ADDI	T3,3			;BUMP ADDR
ASSL4:	MOVE	T1,[XWD 5,FOO]		;GET NEXT STR
	GOBSTR	T1,
	 POPJ	P,
	SKIPN	T1,FOO+.DFGNM
	JRST	ASSL3			;GO IF END OF LIST
	MOVEM	T1,.DFJNM(T3)		;COPY STR NAME
	MOVE	T1,FOO+.DFGST		;AND STATUS
	MOVEM	T1,.DFJST(T3)
	SETZM	T1,.DFJDR(T3)
	ADDI	T3,3			;BUMP ADDR
	JRST	ASSL1			;LOOP
ASSL3:	MOVEI	T1,.FSDSL		;FUNCTION
	MOVEM	T1,SSL+.FSFCN
	SETZM	SSL+.FSDJN		;JOB 0
	MOVEI	T1,DF.SRM		;REMOVE
	MOVEM	T1,SSL+.FSDFL
	MOVSI	T1,-SSL(T3)		;DO IT
	HRRI	T1,SSL
	STRUUO	T1,
	 POPJ	P,
	JRST	CPOPJ1
	SUBTTL	LOG FILE

;ROUTINE TO OPEN THE DEVICE FOR THE LOG FILE
OPENLG:	MOVSI	T1,'LPT'		;DEVICE NAME
	MOVE	T2,T1
	DEVTYP	T1,			;IS IT SPOOLED?
	 SETZ	T1,
	TLNE	T1,(TY.SPL)
	JRST	OPNLG5			;YES
	MOVE	T1,T2			;IS IT ASSIGNED?
	DEVCHR	T1,
	TRNE	T1,DV.ASC
	TLNN	T1,(DV.AVL)
OPNLG5:	MOVSI	T2,'TTY'		;NO, USE TTY
	MOVEM	T2,LDEV+.OPDEV		;OPEN IT
	MOVEI	T2,.IOASC
	MOVEM	T2,LDEV+.OPMOD
	MOVSI	T2,OBUF
	MOVEM	T2,LDEV+.OPBUF
	OPEN	TO,LDEV
	 PUSHJ	P,DIE
	OUTBUF	TO,			;BUILD BUFFERS NOW
	MOVE	T2,OBUF+.BFADR		;SAVE ADDR OF 1ST BUF
	MOVEM	T2,SAVBUF
	MOVEI	T2,LPTWID-RMAR		;SET MARGIN
	MOVEM	T2,MARGIN
	MOVEI	T1,TO			;GET DEVICE TYPE (TTY MIGHT BE LOGICAL)
	DEVCHR	T1,
	TLNE	T1,(DV.DSK)		;DISK?
	JRST	OPNLG1			;YES
	SETZM	LOGSTR			;NO
	TLNN	T1,(DV.TTY)		;TTY?
	POPJ	P,			;NO
	TRO	F,F.TTY			;YES
	MOVEI	T1,TO			;GET UDX
	IONDX.	T1,
	 PUSHJ	P,DIE
	MOVEM	T1,FOO+.TOUDX
	MOVEI	T1,.TOWID		;FUNCTION
	MOVEM	T1,FOO+.TOFNC
	MOVE	T1,[XWD 2,FOO]		;READ WIDTH OF TTY
	TRMOP.	T1,
	 MOVEI	T1,LPTWID
	SUBI	T1,RMAR			;BACK OFF
	MOVEM	T1,MARGIN		;SET MARGIN
	POPJ	P,

;HERE IF DISK
OPNLG1:	PUSHJ	P,GETLOK		;GET INTERLOCK
	MOVE	T1,LDEV+.OPDEV		;WHAT STR IS LOG?
	MOVEM	T1,FOO+.DCNAM
	MOVE	T1,[XWD FOOSIZ,FOO]
	DSKCHR	T1,
	 JRST	OPNLG2
	MOVE	T1,FOO+.DCSNM
	JRST	OPNLG4

;HERE IF DSKCHR FAILED (STR WAS PROBABLY YANKED)
OPNLG2:	MOVE	T1,LDEV+.OPDEV		;UN-DO LOGICAL NAME
	DEVNAM	T1,
	 SETO	T1,
	PUSHJ	P,INPROG		;IS IT IN PROGRESS?
	 JRST	OPNLG4			;YES
	MOVE	T1,SLST			;NO, I GUESS IT DOESN'T MATTER
	MOVE	T1,SNFNAM(T1)
OPNLG4:	MOVEM	T1,LOGSTR		;YES, THAT'S IT THEN
	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	MOVE	T1,LDEV+.OPDEV		;GET PATH
	MOVEM	T1,PTH+.PTFCN
	MOVE	T1,[XWD PTHL,PTH]
	PATH.	T1,
	 CAIA
	POPJ	P,
	HRRE	T1,.PTFRD		;GET DEFAULT PATH
	MOVEM	T1,PTH+.PTFCN
	MOVE	T1,[XWD PTHL,PTH]
	PATH.	T1,
	 PUSHJ	P,DIE
	POPJ	P,
;ROUTINE TO COPY TEMP LOGS BACK TO THE STR WHERE THEY BELONG
;CALL WITH INTERLOCK
;EXIT CPOPJ IF STILL MORE TO GO
;EXIT CPOPJ1 IF ALL DONE
CPYLG:	PUSHJ	P,SAVE1
CPYLG0:	SKIPN	P1,LOGS			;ANY TO COPY?
	JRST	CPOPJ1			;NO
	MOVE	T1,LOGSTR		;NAME OF LOG STR
	MOVEM	T1,LDEV+.OPDEV
	TRNE	F,F.ALL			;DOING ALL?
	JRST	CPYLG6			;YES, MUST WAIT FOR STR TO FINISH
	MOVE	T2,CNTSLT		;WE AREN'T, BUT ARE WE THE ONLY ONE?
	CAIN	T2,1
	JRST	CPYLG5			;ONLY ONE, IT'LL NEVER FINISH
CPYLG6:	MOVEI	T2,ALST-SNFLNK		;IS LOG STR DONE?
CPYLG3:	HRRZ	T2,SNFLNK(T2)
	JUMPE	T2,CPOPJ
	CAME	T1,SNFNAM(T2)
	JRST	CPYLG3
CPYLG5:	MOVE	T1,LOGDEV(P1)		;IS TMP STR AVAILABLE?
	MOVEM	T1,TDEV+.OPDEV
	PUSHJ	P,INPROG
	 POPJ	P,			;NO
	MOVE	T2,MYSLT		;YES, LOCK IT DOWN
	MOVEM	T1,JBTLOG(T2)
	PUSHJ	P,GIVLOK		;GIVE AWAY INTERLOCK
	MOVEI	T1,.IOBIN
	MOVEM	T1,LDEV+.OPMOD
	MOVEM	T1,TDEV+.OPMOD
	MOVSI	T1,OBUF
	MOVEM	T1,LDEV+.OPBUF
	MOVEI	T1,.RBEXT
	MOVEM	T1,LFIL+.RBCNT
	MOVEM	T1,TFIL+.RBCNT
	MOVEI	T1,PTH
	MOVEM	T1,LFIL+.RBPPN
	MOVE	T1,LOGNAM(P1)
	MOVEM	T1,LFIL+.RBNAM
	MOVEM	T1,TFIL+.RBNAM
	MOVSI	T1,'LST'
	MOVEM	T1,LFIL+.RBEXT
	MOVEI	T1,IBUF
	MOVEM	T1,TDEV+.OPBUF
	MOVE	T1,FFAPPN
	MOVEM	T1,TFIL+.RBPPN
	MOVSI	T1,'TMP'
	MOVEM	T1,TFIL+.RBEXT
	OPEN	TL,TDEV			;OPEN TEMP ON ANOTHER CH
	 JRST	CPYLG4
	LOOKUP	TL,TFIL
	 JRST	CPYLG4
	OPEN	TO,LDEV			;RE-OPEN LOG FILE
	 JRST	CPYLG4
	ENTER	TO,LFIL
	 JRST	CPYLG4
	MOVE	T1,SAVBUF		;USE SAME BUFFERS
	MOVEM	T1,OBUF+.BFADR
	MOVEI	T2,TDEV			;COMPUTE SIZE OF BUFFERS
	DEVSIZ	T2,
	 PUSHJ	P,DIE
	HLRZ	T1,T2
	IMULI	T1,(T2)
	PUSHJ	P,GETBLK		;ALLOCATE SPACE
	PUSH	P,T1			;SAVE SIZE
	PUSH	P,T2			;SAVE ADDR
	EXCH	T2,.JBFF		;ALLOCATE BUFFERS
	INBUF	TL,
	MOVEM	T2,.JBFF
CPYLG1:	PUSHJ	P,CI			;INPUT A CHAR FROM TEMP FILE
	 JRST	CPYLG2			;EOF
	PUSHJ	P,CO			;COPY TO LOG FILE
	JRST	CPYLG1
CPYLG2:	CLOSE	TO,			;CLOSE THE LOG FILE
	STATZ	TO,IO.ERR
	 PUSHJ	P,DIE
	SETZM	FOO			;DELETE TEMP LOG
	RENAME	TL,FOO
	 JFCL
	RELEAS	TL,
	POP	P,T2			;RESTORE ADDR
	POP	P,T1			;RESTORE SIZE
	PUSHJ	P,GIVBLK		;GIVE BACK SPACE
CPYLG4:	PUSHJ	P,GETLOK		;GET INTERLOCK
	MOVE	T1,MYSLT		;FREE TMP STR
	SETZM	JBTLOG(T1)
	MOVE	T1,LOGNXT(P1)		;UNLINK LOG
	MOVEM	T1,LOGS
	MOVEI	T1,SIZLOG		;RETURN LOG
	MOVE	T2,P1
	PUSHJ	P,GIVBLK
	JRST	CPYLG0			;DO ANOTHER LOG
;ROUTINE TO INPUT A CHAR FROM THE TEMP LOG
;T1 RETURNS THE CHAR
CI:	SOSGE	IBUF+.BFCTR
	JRST	CI2
	ILDB	T1,IBUF+.BFPTR
	JRST	CPOPJ1
CI2:	IN	TL,
	 JRST	CI
	STATZ	TL,IO.ERR
	 PUSHJ	P,DIE
	POPJ	P,

;ROUTINE TO TEST IF STR IS IN PROGRESS
;T1 PASSES STR NAME
;NOSKIP IF IN PROGRESS
;SKIP IF NOT IN PROGRESS
INPROG:	PUSHJ	P,SAVE1
	MOVEI	P1,NSLT-1
INPRG1:	CAMN	T1,JBTSTR(P1)
	POPJ	P,
	SOJGE	P1,INPRG1
	JRST	CPOPJ1
;ROUTINE TO PICK A STR FOR THE LOG FILE (AND OPEN IT)
;YOU MUST HAVE THE INTERLOCK TO CALL THIS ROUTINE
PIKLOG:	PUSHJ	P,SAVE1
PKLOGA:	SKIPN	T1,LOGSTR		;LOG ON DISK?
	POPJ	P,			;NO
	MOVEI	T2,.IOASC
	MOVEM	T2,LDEV+.OPMOD
	MOVSI	T2,OBUF
	MOVEM	T2,LDEV+.OPBUF
	MOVEI	T2,.RBEXT
	MOVEM	T2,LFIL+.RBCNT
	MOVE	T2,ALIAS
	MOVEM	T2,LFIL+.RBNAM
	CAMN	T1,ALIAS		;DOING LOG STR?
	JRST	PKLOG2			;YES, MUST USE TMP STR
	MOVE	T3,ALIAS		;PROCESS STR AND LOG STR THE ONLY ONES?
	MOVEI	T2,SLST-SNFNXT
PKLOGC:	HRRZ	T2,SNFNXT(T2)
	JUMPE	T2,PKLOGD		;YES, MUST GO ON ACTUAL STR
	CAME	T3,SNFNAM(T2)
	CAMN	T1,SNFNAM(T2)
	JRST	PKLOGC
	TRNN	F,F.ALL			;NO, DOING ALL?
	JRST	PKLOGD			;NOT ALL, DON'T CARE IF DONE
	MOVEI	T2,ALST-SNFLNK		;LOG STR PROCESSED YET?
PKLOG1:	HRRZ	T2,SNFLNK(T2)
	JUMPE	T2,PKLOG2		;NO
	CAME	T1,SNFNAM(T2)
	JRST	PKLOG1
	JRST	PKLOG3
;HERE TO PUT ON ACTUAL STR IF NOT IN PROGRESS
PKLOGD:	PUSHJ	P,INPROG		;LOG STR IN PROGRESS?
	 JRST	PKLOG2			;YES, PUT ON TMP STR (IF ONE EXISTS)
;HERE TO PUT LOG ON ACTUAL STR
PKLOG3:	MOVEM	T1,LDEV+.OPDEV
	OPEN	TO,LDEV
	 JRST	PKLOG2
	MOVE	T1,SAVBUF		;USE SAME BUFFERS
	MOVEM	T1,OBUF+.BFADR
	MOVEI	T1,PTH
	MOVEM	T1,LFIL+.RBPPN
	MOVSI	T1,'LST'
	MOVEM	T1,LFIL+.RBEXT
	ENTER	TO,LFIL
	 JRST	PKLOG2
	JRST	PKLOGB
;HERE TO PUT LOG FILE ON TMP STR
;TRY ALL STRS COMPLETED
PKLOG2:	MOVEI	P1,ALST-SNFLNK
PKLOG5:	HRRZ	P1,SNFLNK(P1)
	JUMPE	P1,PKLOG4
	MOVE	T1,SNFNAM(P1)
	PUSHJ	P,TRYLG
	 JRST	PKLOG9			;WIN
	JRST	PKLOG5
;TRY WHAT WORKED FOR SOMEBODY ELSE
PKLOG4:	MOVEI	P1,NSLT-1
PKLOG6:	SKIPN	T1,JBTLOG(P1)
	JRST	PKLOG7
	PUSHJ	P,TRYLG
	 JRST	PKLOG9
PKLOG7:	SOJGE	P1,PKLOG6
;TRY ANYTHING AT ALL
	MOVEI	P1,BLST-SNFLNK
PKLOG8:	HRRZ	P1,SNFLNK(P1)
	JUMPE	P1,PKLOG0
	MOVE	T1,SNFNAM(P1)
	PUSHJ	P,TRYLG
	 JRST	PKLOG9
	JRST	PKLOG8
;HERE IF NO PLACE AT ALL TO PUT LOG
;WAIT FOR SOMETHING TO FINISH
PKLOG0:	PUSHJ	P,SLEEPY		;SLEEP AWHILE
	JRST	PKLOGA			;TRY AGAIN
;HERE WHEN WE SUCCESSFULLY CREATED A TMP LOG
PKLOG9:	MOVEI	T1,SIZLOG		;ALLOCATE A LOG BLOCK
	PUSHJ	P,GETBLK
	MOVE	T1,ALIAS		;FILE NAME
	MOVEM	T1,LOGNAM(T2)
	MOVE	T1,LDEV+.OPDEV		;DEVICE
	MOVEM	T1,LOGDEV(T2)
	MOVE	T1,LOGS			;LINK IT
	MOVEM	T1,LOGNXT(T2)
	MOVEM	T2,LOGS
PKLOGB:	MOVE	T1,MYSLT		;TELL THE WORLD
	MOVE	T2,LDEV+.OPDEV
	MOVEM	T2,JBTLOG(T1)
	POPJ	P,

;ROUTINE TO ATTEMPT THE CREATION OF A TMP LOG
;T1 PASSES STR TO TRY FOR
;CPOPJ IF SUCCEED
;CPOPJ1 IF FAIL
TRYLG:	CAMN	T1,LOGSTR		;PUTING TMP FILE ON ACTUAL STR?
	JRST	CPOPJ1			;YES, THAT'S SILLY
	MOVEM	T1,LDEV+.OPDEV		;SAVE DEVICE NAME
	OPEN	TO,LDEV
	 JRST	CPOPJ1
	MOVE	T3,SAVBUF		;USE SAME BUFFERS
	MOVEM	T3,OBUF+.BFADR
	MOVE	T3,FFAPPN		;ENTER TEMP FILE
	MOVEM	T3,LFIL+.RBPPN
	MOVSI	T3,'TMP'
	MOVEM	T3,LFIL+.RBEXT
	ENTER	TO,LFIL
	 JRST	CPOPJ1
	POPJ	P,

;ROUTINE TO SLEEP
SLEEPY:	PUSHJ	P,GIVLOK		;GIVE UP INTERLOCK
	PUSHJ	P,SLPY			;SLEEP AWHILE
	PJRST	GETLOK			;GET INTERLOCK BACK

;SLEEP
SLPY:	MOVEI	T1,NSEC			;SLEEP AWHILE
	SLEEP	T1,
	POPJ	P,
	SUBTTL	BAT BLOCK

;ROUTINE TO PROCESS BAT BLOCK FOR A GIVEN UNIT
DOBT:	PUSHJ	P,SAVE4			;SAVE ACS
	PUSHJ	P,RDBT			;READ BAT BLOCK
	 JRST	DOBT9			;ERROR
	LDB	P1,BAYNBR		;NUMBER OF BAD REGIONS
	ADD	P1,BAFCNT(B)
	JUMPE	P1,CPOPJ
	HRRZ	P2,BAFFIR(B)		;OFFSET OF 1ST ENTRY
	ADD	P2,B			;ADDR OF 1ST ENTRY
DOBT2:	LDB	P3,BAYNBB		;NUMBER OF BAD BLOCKS
	ADDI	P3,1
	MOVE	P4,BAFELB(P2)		;WORD CONTAINING BN
	MOVE	T1,BAFNBB(P2)		;WORD CONTAINING BAPNTP
	TRNE	T1,BAPNTP		;NEW ENTRY OR OLD?
	TLZA	P4,BATMSK		;NEW
	TLZ	P4,-1			;OLD
DOBT3:	CAMLE	P4,UDBHLB(U)		;LEGAL BN?
	JRST	DOBT4			;NO
	MOVE	T1,UDBBLK(U)		;CONVERT TO BN RELATIVE TO STR
	ADD	T1,P4
	PUSH	P,T1
	PUSHJ	P,SATBIT		;FIND SAT BIT
	POP	P,T1
	TDNE	T2,(T3)			;ALREADY LIT? (I.E. IN BADBLK?)
	JRST	DOBT5			;YES, IGNORE
	IORM	T2,(T3)			;NO, LIGHT IT NOW
	IDIV	T1,BPC			;CONVERT BN TO CLUSTER
	MOVEI	T2,BADCST		;ADD CLUSTER TO BAD LIST
	PUSHJ	P,ADDLST
DOBT5:	ADDI	P4,1			;NEXT BN
	SOJG	P3,DOBT3		;LOOP FOR EACH BLOCK IN REGION
DOBT4:	ADDI	P2,2			;ADDR OF NEXT ENTRY
	SOJG	P1,DOBT2		;LOOP FOR EACH ENTRY
	POPJ	P,

;HERE IF BAT BLOCK IS BAD
DOBT9:	MOVEI	T2,[ASCIZ /Error while reading BAT blocks on /]
	PUSHJ	P,STRO
	PUSHJ	P,UNITO
	PJRST	DSPACE
;ROUTINE TO COMPUTE THE AMOUNT OF OVERLAP BETWEEN THE BAD LIST
;AND THE FREE LIST
;T1 RETURNS THE NUMBER OF CLUSTERS OF OVERLAP
BADOVR:	SETZ	T1,			;NONE SO FAR
	SKIPE	FRECST+CSTCNT		;QUIT EARLY IF NONE AT ALL
	SKIPN	BADCST+CSTCNT
	POPJ	P,
	PUSHJ	P,SAVE2
	MOVEI	P1,FRECST+CSTREG-REGNXT	;PRESET PRED
	MOVEI	P2,BADCST+CSTREG-REGNXT
	HRRZ	P1,REGNXT(P1)		;NEXT FREE REGION
	JUMPE	P1,CPOPJ
BDOVR1:	HRRZ	P2,REGNXT(P2)		;NEXT BAD REGION
	JUMPE	P2,CPOPJ
BDOVR2:	MOVE	T2,REGLOW(P1)		;DO THEY OVERLAP?
	CAMLE	T2,REGHI(P2)
	JRST	BDOVR1			;NO, GET NEXT BAD REGION
	MOVE	T3,REGHI(P1)
	CAML	T3,REGLOW(P2)
	JRST	BDOVR3			;YES
BDOVR4:	HRRZ	P1,REGNXT(P1)		;NO, GET NEXT FREE REGION
	JUMPN	P1,BDOVR2
	POPJ	P,
;HERE WHEN THERE IS DEFINITELY SOME OVERLAP
BDOVR3:	CAMGE	T2,REGLOW(P2)		;GET HIGHEST OF THE LOWS
	MOVE	T2,REGLOW(P2)
	CAMLE	T3,REGHI(P2)		;GET LOWEST OF THE HIGHS
	MOVE	T3,REGHI(P2)
	SUBM	T3,T2			;BUMP COUNT
	ADDI	T1,1(T2)
	CAMN	T3,REGHI(P1)		;WHICH REGION ENDS FIRST?
	JRST	BDOVR4			;FREE
	JRST	BDOVR1			;BAD
	SUBTTL	SAT BLOCKS

;ROUTINE TO ALLOCATE SPACE FOR SAT BLOCKS
BLDSAT:	PUSHJ	P,SAVE3			;SAVE ACS
	MOVE	T1,UDBSPU(U)		;BUILD SPT
	PUSHJ	P,GETZER
	HRL	T2,UDBSPU(U)
	MOVEM	T2,UDBSPT(U)
	SETOM	UDBSSF(U)		;NO ENTRIES IN SPT YET
	MOVE	T1,UDBSPU(U)		;BUILD PST
	PUSHJ	P,GETBLK
	MOVEM	T2,UDBPST(U)
	MOVE	P1,UDBSPU(U)		;HIGHEST SAT NUMBER
	SUBI	P1,1
	MOVE	T1,UDBBPU(U)		;NUMBER OF FULL CLUSTERS
	IDIV	T1,BPC
	MOVE	T2,P1			;TOTAL BITS IN ALL BUT LAST SAT
	IMUL	T2,UDBCPS(U)
	SUB	T1,T2			;NUMBER OF CLUSTERS IN LAST SAT
	SKIPA	P2,T1
BLDST1:	MOVE	P2,UDBCPS(U)		;CLUSTERS PER SAT
	MOVE	T1,UDBWPS(U)		;ALLOCATE SPACE FOR SAT
	PUSHJ	P,GETZER
	MOVE	P3,T2			;PUT PNTR IN SAFE PLACE
	MOVE	T1,P1			;STORE IT
	ADD	T1,UDBPST(U)
	MOVEM	P3,(T1)
	MOVE	T1,P2			;CLUSTERS THIS SAT
	IDIVI	T1,^D36			;WORDS
	MOVEI	T3,^D36			;UNUSED BITS
	SUBM	T3,T2
	SETZ	T3,			;BUILD MASK
	SETO	T4,
	LSHC	T3,(T2)
	HRLI	P3,T1			;INDEX REGISTER
	CAMGE	T1,UDBWPS(U)		;IS LAST WORD COMPLETELY FULL?
	IORM	T3,@P3			;NO, MARK UNUSED BITS
BLDST2:	ADDI	T1,1			;POINT AT NEXT WORD
	CAML	T1,UDBWPS(U)		;DONE?
	JRST	BLDST3			;YES
	SETOM	@P3			;NO, MARK ALL BITS
	JRST	BLDST2			;LOOP
BLDST3:	SOJGE	P1,BLDST1		;DO NEXT SAT
	POPJ	P,
;ROUTINE TO STORE CA IN SPT
SAVSAT:	TRON	F,F.RIB			;STEPPED OVER RIB YET?
	POPJ	P,			;NO, STEP NOW
	AOS	T2,UDBSSF(U)		;GOT THEM ALL?
	CAML	T2,UDBSPU(U)
	POPJ	P,			;YES
	ADD	T2,UDBSPT(U)		;NEXT ADDR IN SPT
	MOVE	T1,DRCA			;STORE CA
	DPB	T1,SPYCLA
	POPJ	P,
;ROUTINE TO READ THE SAT BLOCKS AND SEE IF THEY ARE RIGHT
;IN THIS ROUTINE:
;P1=ADDR WITHIN SAT BLOCK (AS READ FROM DISK)
;P2=SAT NUMBER
;P3=WORD NUMBER
;P4=ADDR WITHIN SAT BLOCK (AS COMPUTED)
;NOSKIP IF CAN'T FIND SATS
DOSAT:	PUSHJ	P,SAVE4			;SAVE ACS
	MOVE	T1,HUN			;FOUND ALL SATS?
DOSAT7:	HRRZ	U,TABUDB(T1)
	MOVE	T2,UDBSSF(U)
	ADDI	T2,1
	CAMGE	T2,UDBSPU(U)
	JRST	DOSAT8			;NO
	SOJGE	T1,DOSAT7
	SETZM	STAL			;NUMBER FREE BLOCKS (STR WIDE)
	MOVE	T1,HUN			;HIGHEST UNIT NUMBER
DOSAT1:	HRRZ	U,TABUDB(T1)		;UNIT DATA BLOCK
	SKIPN	UDBAWL(U)		;WRITE LOCKED?
	SKIPE	UDBHWP(U)
	PUSHJ	P,DOSTWL		;YES
	MOVE	T1,UDBBPU(U)		;COMPUTE SAFETY FACTOR
	MOVE	T2,UDBK4S(U)
	LSH	T2,3
	SUB	T1,T2
	IDIVI	T1,UNVRSF
	CAILE	T1,MAXSAF
	MOVEI	T1,MAXSAF
	MOVNS	T1
	MOVEM	T1,UDBTAL(U)
	ADDM	T1,STAL			;BUMP STR WIDE COUNTER
	PUSHJ	P,DOBT			;DO BAT BLOCKS
	MOVE	P2,UDBSPU(U)		;HIGHEST SAT NUMBER
	SUBI	P2,1
DOSAT2:	MOVE	T3,P2			;ADDR OF SAT
	ADD	T3,UDBPST(U)
	MOVE	P4,(T3)
	TRZ	F,F.SHC			;SAT IS OK SO FAR
	MOVE	T2,P2			;READ THE SAT BLOCK
	ADD	T2,UDBSPT(U)
	SETZ	T3,
	DPB	T3,SPYTAL
	LDB	T3,SPYCLA
	IMUL	T3,BPC
	PUSHJ	P,REDBLK
	 PUSHJ	P,DOSTRE		;ERROR
	SETZ	P3,			;START WITH WORD 0
	MOVE	P1,B
DOSAT4:	MOVE	T1,(P1)			;PICK UP A SAT WORD
	CAMN	T1,(P4)			;RIGHT?
	JRST	DOSAT5			;YES
	TRO	F,F.SHC			;MUST REWRITE SAT
	TDZ	T1,(P4)			;DO LOST CLUSTERS
	MOVEI	T2,LSTCST
	PUSHJ	P,DOCST
	MOVE	T1,(P4)			;DO FREE CLUSTERS
	TDZ	T1,(P1)
	MOVEI	T2,FRECST
	PUSHJ	P,DOCST
	MOVE	T2,(P4)			;GET FREE CLUSTERS BACK
	TDZ	T2,(P1)
	SKIPA	T1,(P4)			;FIX THE SAT WORD
DOSAT5:	TDZA	T2,T2
	MOVEM	T1,(P1)
	MOVEM	T2,(P4)			;SET SAT TO FREE CLUSTERS
	MOVE	T2,(P1)			;COUNT FREE CLUSTERS
	PUSHJ	P,CNTSAT
	MOVE	T2,P2			;BUMP COUNT IN SPT
	ADD	T2,UDBSPT(U)
	LDB	T3,SPYTAL
	ADD	T3,T4
	DPB	T3,SPYTAL
	IMUL	T4,BPC			;CONVERT CLUSTERS TO BLOCKS
	ADDM	T4,UDBTAL(U)		;BUMP UNIT COUNT
	ADDM	T4,STAL			;BUMP STR COUNT
	ADDI	P3,1			;LOOP FOR EACH WORD
	ADDI	P1,1
	CAME	P3,UDBWPS(U)
	AOJA	P4,DOSAT4
;JFCL THIS LOCATION TO PREVENT SAT BLOCKS FROM BEING WRITTEN
SATPAT:	TRNN	F,F.SHC			;REWRITE SAT?
	JRST	DOSAT6			;NO
	SKIPN	UDBAWL(U)		;WRITE PROTECT?
	SKIPE	UDBHWP(U)
	JRST	DOSAT6			;YES, DON'T TRY TO WRITE
	MOVE	T2,P2			;COMPUTE BN OF SAT
	ADD	T2,UDBSPT(U)
	LDB	T3,SPYCLA
	IMUL	T3,BPC
	PUSHJ	P,WRTBLK		;WRITE THE SAT
	 PUSHJ	P,DOSTWE		;ERROR
DOSAT6:	SOJGE	P2,DOSAT2		;LOOP FOR EACH SAT
	MOVE	T1,UDBLUN(U)		;LOOP FOR EACH UNIT
	SOJGE	T1,DOSAT1
	JRST	CPOPJ1

;HERE IF CAN'T FIND ALL THE SATS
DOSAT8:	MOVEI	T2,[ASCIZ /Can't find SAT.SYS
SATs will not be processed
STR will not be mounted/]
	PJRST	STRDSP
;HERE IF ERROR WHILE READING SAT BLOCK
;B PASSES ADDR SAT WOULD HAVE BEEN READ INTO
;P4 PASSES ADDR OF SAT (AS COMPUTED)
;P2 PASSES SAT NUMBER
DOSTRE:	HRLZ	T1,P4			;COPY SAT BLOCK
	HRR	T1,B
	MOVE	T2,B
	ADD	T2,UDBWPS(U)
	BLT	T1,-1(T2)
	TRO	F,F.SHC			;WRITE SAT
	MOVEI	T2,[ASCIZ /read/]
	JRST	DOSTER

;HERE IF ERROR WHILE WRITTING SAT BLOCK
;P2 PASSES SAT NUMBER
DOSTWE:	MOVEI	T2,[ASCIZ /writt/]
DOSTER:	PUSH	P,T2			;SAVE READ/WRITE
	MOVEI	T2,[ASCIZ /Error while /]
	PUSHJ	P,STRO
	POP	P,T2
	PUSHJ	P,STRO
	MOVEI	T2,[ASCIZ /ing SAT block /]
	PUSHJ	P,STRO
	MOVE	T1,P2
	PUSHJ	P,OCTO
	MOVEI	T2,[ASCIZ / on unit /]
	PUSHJ	P,STRO
	PUSHJ	P,UNITO
	PJRST	DSPACE

;HERE IF UNIT IS WRITE LOCKED
DOSTWL:	PUSHJ	P,UNITO
	MOVEI	T2,[ASCIZ / is write locked and SATs will not be corrected/]
	PUSHJ	P,STRO
	PJRST	DSPACE
;ROUTINE TO COUNT THE NUMBER OF ZERO BITS IN A SAT WORD
;T2 PASSES THE CORRECTED VERSION OF THE SAT WORD
;T4 RETURNS THE COUNT
CNTSAT:	SETZ	T4,			;COUNTER
CNTST2:	SETCMM	T2			;COMPLIMENT
	JFFO	T2,CNTST3		;COUNT LEADING "ONES"
	POPJ	P,			;NO MORE
CNTST3:	SETZ	T1,			;PURGE LEADING "ONES"
	ROTC	T1,(T3)
	SETCMM	T2			;RETURN TO NORMAL SPACE TIME
	JFFO	T2,CNTST4		;COUNT ZEROES
	MOVEI	T4,^D36			;ALL ZEROES
	POPJ	P,
CNTST4:	ADD	T4,T3			;ADD TO TOTAL
	SETO	T1,			;PURGE ZEROES
	ROTC	T1,(T3)
	JRST	CNTST2			;LOOP
;LIGHT A SAT BIT
MRKIT:	MOVE	T1,TCBBLK(TC)		;BN OF RIB
	FALL	MARKIT

;ROUTINE TO LIGHT A SAT BIT
;T1 PASSES BN
MARKIT:	PUSH	P,T1			;SAVE BN
	PUSHJ	P,SATBIT		;FIND THE RIGHT BIT
	POP	P,T1			;RESTORE BN
	TRNE	F,F.P2			;PASS TWO?
	JRST	MARKI2			;YES
	TDNE	T2,(T3)			;ALREADY ON?
	JRST	ADDMUL			;YES
	IORM	T2,(T3)			;NO, LIGHT IT NOW
	POPJ	P,

;HERE IF PASS TWO
MARKI2:	TDNN	T2,(T3)			;TARGET BN?
	POPJ	P,			;NO
	IDIV	T1,BPC			;CONVERT BN TO CLUSTER
	MOVEI	T2,MULCST		;IS IT FREE OR MULTIPLE?
	PUSHJ	P,FNDREG
	 SKIPA	T2,[F2CST]		;FREE
	MOVEI	T2,M2CST		;MULTIPLY USED
	PJRST	ADDLST			;ADD IT TO CLUSTER LIST
;ROUTINE TO FIND THE SAT BIT CORRESPONDING TO A GIVEN BN
;T1 PASSES BN (DESTROYED)
;T2 RETURNS BIT MASK
;T3 RETURNS WORD ADDR
SATBIT:	IDIV	T1,BPLU			;UNIT AND OFFSET
	HRRZ	T1,TABUDB(T1)		;UNIT DATA BLOCK
	IDIV	T2,BPC			;CLUSTER
	IDIV	T2,UDBCPS(T1)		;SAT AND OFFSET
	ADD	T2,UDBPST(T1)		;ADDR OF PST ENTRY
	IDIVI	T3,^D36			;WORD AND BIT
	ADD	T3,(T2)			;WORD ADDR
	MOVSI	T2,(1B0)		;BUILD MASK
	MOVNS	T4
	LSH	T2,(T4)
	POPJ	P,

;SUBROUTINE TO FIND A REGION
;T1 PASSES CLUSTER NUMBER
;T2 PASSES CST
;T3 RETURNS REG
;SKIP IF FOUND
FNDREG:	MOVEI	T3,CSTREG-REGNXT(T2)	;PRESET PRED
FNDRG1:	HRRZ	T3,REGNXT(T3)		;STEP TO NEXT REGION
	JUMPE	T3,CPOPJ		;QUIT IF NO MORE REGIONS
	CAMGE	T1,REGLOW(T3)		;WITHIN REGION?
	POPJ	P,
	CAMLE	T1,REGHI(T3)
	JRST	FNDRG1			;NO, KEEP SEARCHING
	JRST	CPOPJ1			;YES, WIN

;SUBROUTINE TO MARK A CLUSTER LIST
;T2 PASSES CST
MARKC:	PUSHJ	P,SAVE2			;SAVE AC
	MOVEI	P1,CSTREG-REGNXT(T2)	;PRESET PRED
MARKC1:	HRRZ	P1,REGNXT(P1)		;STEP TO NEXT REGION
	JUMPE	P1,CPOPJ		;QUIT IF NO MORE REGIONS
	MOVE	P2,REGLOW(P1)		;1ST CLUSTER
MARKC2:	MOVE	T1,P2			;CONVERT CLUSTER TO BN
	IMUL	T1,BPC
	PUSHJ	P,SATBIT		;FIND CORRESPONDING BIT
	IORM	T2,(T3)		 	;LIGHT BIT
	CAME	P2,REGHI(P1)		;END OF REGION?
	AOJA	P2,MARKC2		;NO, NEXT CLUSTER
	JRST	MARKC1			;YES, NEXT REGION
	SUBTTL	CLUSTER LIST

;ROUTINE TO ADD A BIT MASK TO THE CLUSTER LIST
;T1 PASSES THE BIT MASK
;T2 PASSES ADDR OF CST
;U PASSES UDB
;P2 PASSES SAT NUMBER
;P3 PASSES WORD NUMBER
DOCST:	JUMPE	T1,CPOPJ		;NONE IS EASY
	PUSHJ	P,SAVE4			;SAVE ACS
	MOVE	T3,UDBBLK(U)		;1ST CLUSTER ON UNIT
	IDIV	T3,BPC
	MOVE	P1,T3
	IMUL	P2,UDBCPS(U)		;1ST CLUSTER IN SAT
	ADD	P1,P2
	IMULI	P3,^D36			;1ST CLUSTER IN WORD
	ADD	P1,P3
	MOVE	P2,T1			;SAVE THE BITS
	MOVE	P4,T2			;ADDR OF CST
DOCST1:	JFFO	P2,DOCST2		;FIND FIRST ONE
	POPJ	P,			;NO MORE ONES, ALL DONE
DOCST2:	ADD	P1,P3			;CLUSTER IN QUESTION
	MOVE	T1,P1			;ADD IT TO THE LIST
	MOVE	T2,P4
	PUSHJ	P,ADDLST
	LSH	P2,1(P3)		;SHIFT OUT THE ONE
	AOJA	P1,DOCST1		;AND LOOP

;ROUTINE TO ADD A MULTIPLY USED CLUSTER TO THE LIST
;T1 PASSES BN
ADDMUL:	IDIV	T1,BPC			;CONVERT TO CLUSTER
	MOVEI	T2,MULCST		;ADD IT
	FALL	ADDLST

;ROUTINE TO ADD A CLUSTER TO THE LIST
;T1 PASSES CLUSTER NUMBER
;T2 PASSES ADDR OF CST (DESTROYED)
ADDLST:	PUSHJ	P,SAVE4			;SAVE ACS
	DMOVE	P1,T1			;COPY ARGS
	MOVEI	P3,CSTREG-REGNXT(P2)	;PRESET PRED
ADDLS1:	MOVE	P4,P3			;SAVE AS PRED
	HRRZ	P3,REGNXT(P4)		;STEP TO NEXT REGION
	JUMPE	P3,ADDLS3		;END OF LIST
	MOVE	T1,REGLOW(P3)		;CLUSTER JUST BEFORE REGION
	SUBI	T1,1
	CAMGE	P1,T1			;FAR ENOUGH?
	JRST	ADDLS3			;NO, BUILD NEW REGION
	CAME	P1,T1			;JUST BEFORE?
	JRST	ADDLS2			;NO, CHECK IF INTERIOR
	MOVEM	P1,REGLOW(P3)		;NEW LOWEST
	JRST	ADDLS4
ADDLS2:	MOVE	T1,REGHI(P3)		;CLUSTER JUST PAST REGION
	ADDI	T1,1
	CAMLE	P1,T1			;BEYOND END?
	JRST	ADDLS1			;YES, TEST NEXT REGION
	CAME	P1,T1			;JUST PAST?
	POPJ	P,			;NO, DUPLICATE CLUSTER
	MOVEM	P1,REGHI(P3)		;NEW HIGHEST
	AOS	CSTNUM(P2)		;ANOTHER CLUSTER
	HRRZ	T2,REGNXT(P3)		;NEXT REGION BEYOND
	JUMPE	T2,CPOPJ
	ADDI	T1,1			;NEXT CLUSTER BEYOND
	CAME	T1,REGLOW(T2)		;ADJACENT?
	POPJ	P,			;NO
	MOVE	T3,REGHI(T2)		;YES, MERGE THE TWO REGIONS
	MOVEM	T3,REGHI(P3)
	SOS	CSTCNT(P2)		;ONE LESS REGION
	HRRZ	T3,REGNXT(T2)		;UNLINK 2ND REGION
	HRRM	T3,REGNXT(P3)
	MOVEI	T1,SIZREG		;PITCH IT
	PJRST	GIVBLK

;HERE TO BUILD A NEW REGION
ADDLS3:	MOVEI	T1,SIZREG		;ALLOCATE CORE
	PUSHJ	P,GETBLK
	MOVEM	P1,REGLOW(T2)		;STORE BOUNDS
	MOVEM	P1,REGHI(T2)
	MOVEM	P3,REGNXT(T2)		;LINK IT
	HRRM	T2,REGNXT(P4)
	AOS	CSTCNT(P2)		;ANOTHER REGION
ADDLS4:	AOS	CSTNUM(P2)		;ANOTHER CLUSTER
	POPJ	P,
;ROUTINE TO PRINT CST'S (PASS ONE)
CSTSO:	MOVEI	T1,[ASCIZ /lost/]
	MOVEI	T2,[ASCIZ /marked in SAT but not in any file/]
	MOVEI	T3,LSTCST
	PUSHJ	P,CSTA
	MOVEI	T1,[ASCIZ /free/]
	MOVEI	T2,[ASCIZ /not marked in SAT but in some file/]
	MOVEI	T3,FRECST
	PUSHJ	P,CSTA
	MOVEI	T1,[ASCIZ /multiply used/]
	MOVEI	T2,[ASCIZ /belonging to more than one file/]
	MOVEI	T3,MULCST
	PJRST	CSTA

;ROUTINE TO PRINT CST'S (PASS TWO)
CSTTO:	MOVEI	T1,[ASCIZ /free/]
	MOVEI	T3,F2CST
	PUSHJ	P,CSTO
	MOVEI	T1,[ASCIZ /multiply used/]
	MOVEI	T3,M2CST
	FALL	CSTO

;ROUTINE TO PRINT A CST
;T1 PASSES CST NAME (SHORT FORM)
;T2 PASSES CST NAME (LONG FORM), USED ONLY IN PASS ONE
;T3 PASSES CST
;FL PASSES FIL, USED ONLY IN PASS TWO
CSTO:	SKIPN	CSTCNT(T3)		;ANY?
	POPJ	P,			;NO
;ENTER HERE TO ALWAYS PRINT
CSTA:	PUSHJ	P,SAVE3			;SAVE AC'S
	DMOVE	P1,T1
	MOVE	P3,T3
	MOVE	T1,CSTNUM(P3)		;NUMBER OF CLUSTERS
	PUSHJ	P,DECO
	MOVEI	T1,40
	PUSHJ	P,CO
	MOVE	T2,P1			;SHORT NAME
	PUSHJ	P,STRO
	MOVEI	T2,[ASCIZ / cluster/]
	PUSHJ	P,STRO
	MOVEI	T1,"s"
	MOVE	T2,CSTNUM(P3)
	CAIE	T2,1
	PUSHJ	P,CO
	MOVEI	T2,[ASCIZ / in /]
	PUSHJ	P,STRO
	MOVE	T1,CSTCNT(P3)		;NUMBER OF REGIONS
	PUSHJ	P,DECO
	MOVEI	T2,[ASCIZ / region/]
	PUSHJ	P,STRO
	MOVEI	T1,"s"
	MOVE	T2,CSTCNT(P3)
	CAIE	T2,1
	PUSHJ	P,CO
	MOVEI	T1,40
	PUSHJ	P,CO
	TRNE	F,F.P2			;WHICH PASS?
	JRST	CSTO9			;PASS TWO
	MOVEI	T1,"("			;PASS ONE
	PUSHJ	P,CO
	MOVE	T2,P2
	PUSHJ	P,STRO
	MOVEI	T1,")"
	PUSHJ	P,CO
	JRST	CSTO8
CSTO9:	MOVEI	T2,[ASCIZ /in file /]
	PUSHJ	P,STRO
	PUSHJ	P,FILO
CSTO8:	PUSHJ	P,CRLFO
	SKIPN	T1,CSTCNT(P3)		;OVER THRESHOLD?
	PJRST	CRLFO
	CAILE	T1,TREG
	TRNN	F,F.TTY			;AND PHYS TTY?
	SKIPA	P1,CSTREG(P3)		;NO, GET 1ST REG
	PJRST	CRLFO			;YES
CSTO1:	MOVE	T2,HPOS			;BEGINING OF LINE?
	MOVEI	T1,","
	CAIE	T2,1
	PUSHJ	P,CO			;NO, PRINT A COMMA
	MOVE	T1,REGLOW(P1)		;PRINT 1ST CLUSTER
	PUSHJ	P,OCTO
	MOVE	T1,REGLOW(P1)		;ONLY ONE CLUSTER?
	CAMN	T1,REGHI(P1)
	JRST	CSTO2			;YES
	MOVEI	T1,"-"			;NO, PRINT LAST CLUSTER
	PUSHJ	P,CO
	MOVE	T1,REGHI(P1)
	PUSHJ	P,OCTO
CSTO2:	MOVE	T1,HPOS			;PAST MARGIN?
	CAML	T1,MARGIN
	PUSHJ	P,CRLFO			;YES, NEWLINE
	HRRZ	P1,REGNXT(P1)		;NEXT REGION
	JUMPN	P1,CSTO1		;LOOP
	PJRST	DSPACE			;EXTRA CRLF
	SUBTTL	ALLOCATE/DEALLOCATE

;ROUTINE TO DEALLOCATE BAD REGIONS
DEBAD:	PUSHJ	P,SAVE1
	MOVEI	P1,BADCST
	PJRST	DECST

;ROUTINE TO DEALLOCATE LOST REGIONS
DELST:	PUSHJ	P,SAVE1
	MOVEI	P1,LSTCST
	PJRST	DECST

;ROUTINE TO DEALLOCATE FREE REGIONS
DEFRE:	PUSHJ	P,SAVE1
	MOVEI	P1,FRECST
	PJRST	DECST

;ROUTINE TO DEALLOCATE MULTIPLY USED REGIONS
DEMUL:	PUSHJ	P,SAVE1
	MOVEI	P1,MULCST
	FALL	DECST

;ROUTINE TO DEALLOCATE ALL THE REGIONS IN A CLUSTER LIST
;P1 PASSES ADDR OF CLUSTER LIST
DECST:	HRRZ	T2,CSTREG(P1)		;ADDR OF 1ST REGION
	JUMPE	T2,CPOPJ
	HRRZ	T3,REGNXT(T2)		;UNLINK IT
	HRRM	T3,CSTREG(P1)
	MOVEI	T1,SIZREG		;PITCH IT
	PUSHJ	P,GIVBLK
	JRST	DECST			;LOOP
;ROUTINE TO DEALLOCATE ALL THE UNITS IN A STR
DESTR:	PUSHJ	P,SAVE3			;SAVE ACS
	SKIPGE	P2,HUN			;HIGHEST UNIT NUMBER
	POPJ	P,
DESTR1:	SKIPN	U,TBUDB(P2)		;UNIT DATA BLOCK
	JRST	DESTR6
	SKIPN	P1,UDBPST(U)		;ADDR OF PST
	JRST	DESTR5
	MOVE	P3,UDBSPU(U)		;SATS PER UNIT
DESTR2:	MOVE	T2,(P1)			;ADDR OF SAT
	MOVE	T1,UDBWPS(U)		;WORDS PER SAT
	PUSHJ	P,GIVBLK		;DEALLOCATE CORE
	SOSE	P3			;LOOP FOR EACH SAT
	AOJA	P1,DESTR2
	MOVE	T2,UDBPST(U)		;DEALLOCATE PST ITSELF
	MOVE	T1,UDBSPU(U)
	PUSHJ	P,GIVBLK
DESTR5:	MOVE	T1,UDBSPU(U)		;DEALLOCATE SPT
	HRRZ	T2,UDBSPT(U)
	SKIPE	T2
	PUSHJ	P,GIVBLK
	MOVE	T2,U			;DEALLOCATE UDB ITSELF
	MOVEI	T1,SIZUDB
	PUSHJ	P,GIVBLK
DESTR6:	SOJGE	P2,DESTR1		;LOOP FOR EACH UNIT
	POPJ	P,
;ROUTINE TO BUILD THE DDBS
MAKDDB:	PUSHJ	P,SAVE1			;SAVE AC
	MOVE	T1,[%CNDVN]		;MONITOR VERSION
	GETTAB	T1,
	 HALT
	HLRZM	T1,MONVER
	MOVE	T1,MONVER
	CAIL	T1,70200		;7.02 (OR LATER)?
	TRO	F,F.702			;YES
	MOVEI	P1,1			;1 DDB FOR 7.01
	TRNE	F,F.702
	MOVEI	P1,NDDBS		;MANY FOR 7.02
	MOVEM	P1,DDBS
MKDDB1:	MOVEI	T1,SIZDDB		;ALLOCATE CORE FOR DDB
	PUSHJ	P,GETBLK
	MOVE	DDB,T2
	MOVEM	DDB,USRJDA(P1)
	MOVEI	T1,NBLK*BLKSIZ+3	;ALLOCATE CORE FOR BUFFER
	PUSHJ	P,GETBLK
	ADDI	T2,1			;STEP OVER DEVIOS WORD
	MOVEM	T2,DDBBUF(DDB)		;STORE IN DDB
	HRLI	T2,NBLK*BLKSIZ+1	;POINT BUFFER AT SELF
	MOVEM	T2,(T2)
	SETOM	DDBHBN(DDB)		;INVALIDATE CACHE
	SETZM	DDBPUN(DDB)		;NO UNIT OPEN YET
	MOVEM	P1,DDBCH(DDB)		;CHANNEL NUMBER
	MOVEM	P1,DDBCX(DDB)		;CHANNEL INDEX (SAME FOR NOW)
	SOJG	P1,MKDDB1
	SETZM	ACTCNT			;NO DDBS ACTIVE YET
	POPJ	P,
	SUBTTL	INTERLOCK

;ROUTINE TO GET THE INTERLOCK
GTLOK1:	MOVE	T1,MYJOB		;RESTART?
	CAMN	T1,LOKJOB
	JRST	GTLOK2			;YES
	TRZ	F,F.NOC			;CTRL-C OK
	MOVEI	T1,22			;SLEEP AWHILE
	HIBER	T1,
	 PUSHJ	P,DIE
;ENTER HERE
GETLOK:
IFN FTDBUG,<
	TRNE	F,F.LOK
	PUSHJ	P,DIE
>
	TRO	F,F.NOC			;NO CTRL-C
	AOSE	ILOCK			;GOT IT?
	JRST	GTLOK1			;NO
GTLOK2:	TRO	F,F.LOK			;YES
	MOVE	T1,MYJOB		;WE GOT IT
	MOVEM	T1,LOKJOB
	POPJ	P,

;ROUTINE TO GIVE UP THE INTERLOCK
GIVIF:	TRNN	F,F.LOK			;OWN IT?
	POPJ	P,			;NO
GIVLOK:
IFN FTDBUG,<
	TRNN	F,F.LOK
	PUSHJ	P,DIE
>
	SETZM	LOKJOB			;NOBODY OWNS IT
	SETOM	ILOCK			;GIVE IT AWAY
	TRZ	F,F.LOK+F.NOC		;CTRL-C OK
	TRZE	F,F.CC			;WAS CTRL-C TYPED?
	MONRT.				;YES, EXIT
	POPJ	P,			;CONTINUE

;CTRL-C TRAP
TRAP:	MOVEM	T1,SAVPC		;SAVE AN AC
	MOVE	T1,INTR+.EROPC		;PICK UP PC
	SETZM	INTR+.EROPC		;RE-ENABLE TRAP
	EXCH	T1,SAVPC		;STORE PC
	TRNE	F,F.NOC			;CTRL-C ALLOWED?
	TROA	F,F.CC			;NO, SET FLAG
	MONRT.				;YES, EXIT
	JRSTF	@SAVPC			;CONTINUE
;ROUTINE TO CHECK IF ALL THE OTHER JOBS ARE STILL ALIVE
ALIVE:	MOVEI	T1,NSLT-1		;START WITH HIGHEST SLOT
ALIVE1:	SKIPN	JBTJOB(T1)		;SLOT IN USE?
	JRST	ALIVE2			;NO
	HRLZ	T2,JBTJOB(T1)		;YES, GET HIS HISEG
	HRRI	T2,.GTSGN
	GETTAB	T2,
	 PUSHJ	P,DIE
	TLZ	T2,-1
	CAMN	T2,MYSGN		;SAME AS OUR HISEG?
	JRST	ALIVE2			;YES, STILL ALIVE
	SETZM	JBTSTR(T1)		;NO, DECLARE HIM DEAD
	SETZM	JBTJOB(T1)
	SETZM	JBTCHN(T1)
	SETZM	JBTLOG(T1)
	SOS	CNTSLT
ALIVE2:	SOJGE	T1,ALIVE1		;LOOP FOR EACH SLOT
	POPJ	P,
;ROUTINE TO DEALLOCATE A SLOT
GIVSLT:	MOVE	T1,MYSLT
	SETZM	JBTJOB(T1)
	SOS	CNTSLT
	POPJ	P,

;ROUTINE TO ALLOCATE A SLOT NUMBER
GETSLT:	MOVEI	T1,NSLT-1		;START WITH HIGHEST SLOT
GTSLT1:	SKIPE	T2,JBTJOB(T1)		;SLOT IN USE?
	CAME	T2,MYJOB		;BY ME?
	SOJGE	T1,GTSLT1		;NO, TRY NEXT SLOT
	JUMPGE	T1,GTSLT5		;YES
;HERE IF WE DON'T ALREADY HAVE A SLOT,
;FIND AN EMPTY ONE
	MOVEI	T1,NSLT-1		;START WITH HIGHEST SLOT
GTSLT3:	SKIPN	JBTJOB(T1)		;EMPTY?
	JRST	GTSLT4			;YES
	SOJGE	T1,GTSLT3		;NO, TRY NEXT
	PUSHJ	P,DIE
GTSLT4:	AOSA	T2,CNTSLT		;BUMP COUNT
GTSLT5:	MOVE	T2,CNTSLT		;GET COUNT
	MOVEM	T1,MYSLT		;SAVE SLOT NUMBER
	MOVE	T3,MYJOB		;TELL OUR JOB NUMBER
	MOVEM	T3,JBTJOB(T1)
	CAIE	T2,1			;ARE WE THE ONLY SLOT?
	POPJ	P,			;NO
	FALL	FIRSLT			;YES

;ROUTINE TO SET UP THE SHARED HISEG
;CALLED ONLY BY THE FIRST JOB
FIRSLT:	MOVEI	T1,HCOR			;INITIALIZE FIRST FREE
	MOVEM	T1,HFF
	SETZM	SLST			;NO STRS YET
	SETZM	BLST
	SETZM	ALST
	SETZM	CONFIG
	POPJ	P,
	SUBTTL	PICK A STR

;ROUTINE TO PICK A STR TO PROCESS
;RULES:
;TRY TO DO THE LOG STR EARLY (BUT DON'T DO IT FIRST).
;IF YOU DO THE LOG STR FIRST, YOU MIGHT BLOW AWAY
;THE JSL OF SOMEBODY WHO DID AN "ASSIGN DSK LPT".
;LET HIM RUN LONG ENOUGH TO FIGURE OUT WHAT HIS JSL IS.
;TRY NOT TO DO THE RUN STR FIRST, SOMEBODY MIGHT STILL BE
;LOADING THE EXE FILE AND WOULD GET A TRANSMISSION ERROR.
;DO NOT, UNDER ANY CIRCUMSTANCE, DO A STR THAT SOME OTHER JOB
;HAS A LOG FILE OPEN ON.
;TRY NOT TO DO A STR IF SOMEBODY ELSE IS ALREADY USING THAT CHANNEL.
PIKSTR:	PUSHJ	P,SAVE4
	SETZ	P4,			;NOTHING GOOD YET
	SKIPN	RUNSTR			;1ST TIME?
	SKIPN	P1,LOGSTR		;LOG FILE TO DISK?
	JRST	PKSTR2			;NO
	MOVEI	P2,BLST-SNFLNK		;LOG STR ALREADY STARTED?
PKSTR1:	HRRZ	P2,SNFLNK(P2)
	JUMPE	P2,PKSTR2		;YES
	CAME	P1,SNFNAM(P2)
	JRST	PKSTR1
	MOVEI	P3,NSLT-1		;NO, SOMEBODY HAS LOG FILE HERE?
PKSTR0:	CAMN	P1,JBTLOG(P3)
	JRST	PKSTR2			;YES, DON'T DO IT
	SOJGE	P3,PKSTR0
	PUSHJ	P,SWPOK			;OK TO REMOVE FROM ASL?
	 JRST	PKSTR2			;NO
	MOVE	P4,P2			;WE CAN DO THIS STR
	MOVE	P2,SNFCHN(P4)		;ANYBODY USING THIS CHAN?
	MOVEI	P3,NSLT-1
PKSTRA:	TDNE	P2,JBTCHN(P3)
	JRST	PKSTR2			;YES, TRY TO FIND SOMETHING BETTER
	SOJGE	P3,PKSTRA
	JRST	PKSTR9			;DO IT
;HERE IF CAN'T DO LOG STR 1ST
PKSTR2:	MOVEI	P2,BLST-SNFLNK		;PRESET PRED
PKSTR5:	HRRZ	P2,SNFLNK(P2)		;STEP TO NEXT STR
	JUMPE	P2,PKSTR7
	MOVE	P1,SNFNAM(P2)
	MOVEI	P3,NSLT-1		;SOMEBODY HAS LOG FILE HERE?
PKSTR6:	CAMN	P1,JBTLOG(P3)
	JRST	PKSTR5			;YES, DO NOT DO THIS STR
	SOJGE	P3,PKSTR6
	PUSHJ	P,SWPOK			;OK TO REMOVE FROM ASL?
	 JRST	PKSTR5			;NO
	MOVE	P4,P2			;NO, WE CAN DO THIS STR
	SKIPE	RUNSTR			;1ST TIME?
	CAME	P1,LOGSTR		;YES, DON'T DO LOG STR
	CAMN	P1,RUNSTR		;IS IT THE RUN STR?
	JRST	PKSTR5			;YES, TRY TO FIND SOMETHING BETTER
	MOVE	P1,SNFCHN(P2)		;SOMEBODY USING THIS CHANNEL?
	MOVEI	P3,NSLT-1
PKSTR8:	TDNE	P1,JBTCHN(P3)
	JRST	PKSTR5			;YES, TRY TO FIND SOMETHING BETTER
	SOJGE	P3,PKSTR8
	JRST	PKSTR9			;NO, GOOD, DO IT NOW
;HERE WHEN THERE'S NOTHING REALLY GOOD TO DO
;DO ONE OF THE UNPLEASANT STRS
PKSTR7:	JUMPE	P4,PKSTR3		;GO IF NONE
;HERE WHEN WE FOUND A PERFECT STR
PKSTR9:	MOVE	P1,SNFNAM(P4)		;GET STR NAME
	MOVEI	P2,BLST-SNFLNK		;FIND PRED
PKSTRB:	CAMN	P4,SNFLNK(P2)
	JRST	PKSTR4
	HRRZ	P2,SNFLNK(P2)
	JRST	PKSTRB
PKSTR4:	MOVE	P3,SNFLNK(P4)		;UNLINK FROM BLST
	MOVEM	P3,SNFLNK(P2)
	MOVEM	P4,MYSNF		;SAVE ADDR OF SNF
	MOVEM	P1,ALIAS		;STR NAME WE WILL DO
	MOVE	P2,MYSLT		;TELL EVERYBODY IT'S OURS
	MOVEM	P1,JBTSTR(P2)
	MOVE	P1,SNFCHN(P4)		;TELL THEM WHAT CHANNEL
	MOVEM	P1,JBTCHN(P2)
	JRST	CPOPJ1

;HERE IF THERE'S ABSOLUTELY NOTHING TO DO
PKSTR3:	MOVE	T1,CNTSLT		;ARE WE THE ONLY ONE?
	CAIE	T1,1
	POPJ	P,			;NO
	MOVEI	P2,BLST-SNFLNK		;PRESET PRED
PKSTRC:	HRRZ	P2,SNFLNK(P2)		;STEP TO NEXT STR
	JUMPE	P2,CPOPJ
	PUSHJ	P,SWPOK			;PARANOIA
	 PUSHJ	P,SWPBAD		;CAN'T REMOVE FROM ASL
	JRST	PKSTRC
;ROUTINE TO TELL THE WORLD ABOUT THE ONE STR WE ARE DOING
;CALL WITH INTERLOCK
PIKONE:	PUSHJ	P,SAVE4
	MOVSI	P1,LNM			;NAME STR MOUNTED AS
	MOVEM	P1,FOO+.DCNAM
	MOVE	P1,[XWD FOOSIZ,FOO]
	DSKCHR	P1,
	 PUSHJ	P,DIE
	SKIPA	P1,FOO+.DCSNM
PKONE3:	PUSHJ	P,SLEEPY		;SLEEP AWHILE
	MOVEI	P2,BLST-SNFLNK		;FIND OUR STR'S SLOT
PKONE1:	MOVE	P4,P2
	HRRZ	P2,SNFLNK(P4)
	JUMPE	P2,CPOPJ		;NOT FOUND
	CAME	P1,SNFNAM(P2)
	JRST	PKONE1
	PUSHJ	P,SWPOK			;OK TO REMOVE FROM ASL?
	 JRST	PKONE2			;NO
	EXCH	P2,P4			;YES
	JRST	PKSTR4
PKONE2:	MOVE	T1,CNTSLT		;ARE WE THE ONLY ONE?
	CAIE	T1,1
	JRST	PKONE3			;NO
SWPBAD:	PUSHJ	P,ONSIL			;TTCALL ONLY
	MOVEI	T2,[ASCIZ /Cannot process STR /]
	PUSHJ	P,STRO
	MOVE	T2,SNFNAM(P2)
	PUSHJ	P,SIXO
	MOVEI	T2,[ASCIZ / (not enough swapping space)/]
	PJRST	STRDSP
;ROUTINE TO TEST IF IT'S OK TO REMOVE A STR FROM THE ASL
;P2 PASSES ADDR OF SNF
;SKIP IF OK
SWPOK:	SKIPN	SNFVRT(P2)		;IN ASL?
	JRST	CPOPJ1			;NO, IT'S OK
	MOVE	T1,[%SWVRT]		;NUMBER OF FREE PAGES OF SWAP SPACE
	GETTAB	T1,
	 PUSHJ	P,DIE
	CAMG	T1,SNFVRT(P2)		;REMOVING ALL FREE PAGES?
	POPJ	P,			;YES, DON'T DO THAT
;HERE TO ADD UP ALL THE SWAPPING SPACE THAT'S LEFT
	SETZ	T1,
	MOVEI	T2,BLST-SNFLNK
SWPOK1:	HRRZ	T2,SNFLNK(T2)
	JUMPE	T2,SWPOK2
	CAME	T2,P2
	ADD	T1,SNFVRT(T2)
	JRST	SWPOK1
SWPOK2:	MOVEI	T2,ALST-SNFLNK
SWPOK3:	HRRZ	T2,SNFLNK(T2)
	JUMPE	T2,SWPOK4
	ADD	T1,SNFVRT(T2)
	JRST	SWPOK3
SWPOK4:	CAIL	T1,MINVRT		;BELOW TRESHHOLD?
	AOS	(P)			;OK
	POPJ	P,
;ROUTINE TO TELL THE WORLD WE ARE DONE WITH THE STR
DONSTR:	MOVE	T2,MYSNF		;LINK IT TO ALST
	MOVE	T3,ALST
	MOVEM	T3,SNFLNK(T2)
	MOVEM	T2,ALST
	MOVE	T1,MYSLT		;CLEAR TABLES
	SETZM	JBTSTR(T1)
	SETZM	JBTLOG(T1)
	SETZM	JBTCHN(T1)
	SKIPN	LOGSTR
	POPJ	P,
	CLOSE	TO,
	STATZ	TO,IO.ERR
	 PUSHJ	P,DIE
	POPJ	P,
	SUBTTL	SAVE AC

SAVE1:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSHJ	P,CJRA
	 SOS	-1(P)
	JRST	RET1

SAVE2:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSHJ	P,CJRA
	 SOS	-2(P)
	JRST	RET2

SAVE3:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSHJ	P,CJRA
	 SOS	-3(P)
	JRST	RET3

SAVE4:	EXCH	P1,(P)
	HRLI	P1,(P)
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,CJRA
	 SOS	-4(P)
RET4:	POP	P,P4
RET3:	POP	P,P3
RET2:	POP	P,P2
RET1:	POP	P,P1
CPOPJ1:	AOSA	(P)			;SKIP RETURN
TPOPJ:	POP	P,T1			;RESTORE T1
CPOPJ:	POPJ	P,

CJRA:	JRA	P1,(P1)

	END	KLEPTO