Trailing-Edge
-
PDP-10 Archives
-
BB-F494Z-DD_1986
-
10,7/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