TITLE DSKDMP
C=1	;C-A-B FOR LINKS
A=2
B=3
D=4
BLKIN=5	;PSEUDO-CORE BLOCK IN CBUF
WRITE=6	;NEG MEANS DUMP, RH 0 OR WRBIT
DIFF=7	;DIFF CONO ALSO TEMP
HEAD=10	;HEAD CONO ALSO TEMP
P=11	;JSP AC
BLOK=12
UNIT=13	;UNIT AND M.A. DATAO
CMD=14	;COMMAND CHAR
T=15	;VERY TEMP
TT=16	;ANOTHER JSP AC, ALSO VERY TEMP
BUFP=17	;DBUF PNTR--LAST WORD USED

.INSRT DSKDMP SWITCH
.INSRT MDSK >
.INSRT MFSDFS >
NDSK==2
ICWA=30

LPM=102000,,
LPMR= LPM 2,

DDT==MEMSIZ-4000
IFN DBGSW,MEMSIZ==MEMSIZ-10000	;MOVE DOWN UNDER DDT IF DEBUG MODE
CORE==MEMSIZ-12000	;HIGHEST ADR ALWAYS IN CORE+1
CORES==CORE_<-12>	;BLK # OF ABOVE (FIRST OF 4 BLKS SWAPPED OUT FOR BUFFER AREAS)
HIGH==MEMSIZ-100	;HIGHEST ADR LOADED/DUMPED+1
CBLK==NBLKS	;DPC ADR WHERE "CORE" BLK IS SAVED


ZZZ:	IFE DBGSW,[
	MOVE T,....	;THIS CODE BLTS THE FOLLOWING OFFSET CODE
	BLT T,MEMSIZ-1-1	;INTO HIGH MEMORY AND WRITES DSKDMP ON ITS
	MOVE T,PROG+MEMSIZ-2-ERROR+1
	MOVEM T,ERROR+MEMSIZ-2-ERROR+1	;AVOID LOSING DUE TO -1 BLT LOSSAGE
]
	MOVEI T,ICWA+2	;SET UP CHANNEL JUMP
	MOVEM T,ICWA 	;IN INITIAL CHANNEL ADDRESS
	SETZM ICWA+1 	;AND CLEAR REMAINING STUFF
	SETZM ICWA+3
	MOVSI T,-NDSK
	SETZM QDED(T)
	AOBJN T,.-1	;ALL UNITS ON LINE
	MOVEI UNIT,ERROR	;MAGIC BLOCK THEN STARTS IT
	MOVEI BLOK,NBLKS+5
	MOVEI WRITE,10
	JSP TT,WRD3
	MOVEI BLOK,NBLKS+6
	MOVEI WRITE,10
	JSP TT,WRD3
	CONSZ DPC,ALLER
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,ZZZ
	JRST BEG


IFE DBGSW,[
....:	PROG,,ERROR

LOC 2000	;MAKE OFFSET CONVENIENT
PROG:	OFFSET CORE+10000-.
]IFN DBGSW,LOC MEMSIZ-2000

ERROR:	0
	CLEARM MEMSIZ-1 	;DON'T READ ANY MORE COMMANDS FROM MEMORY
	SOS T,ERROR 	;PICK UP ERROR CODE FROM THE AC FIELD OF
	LDB T,[270400+T,,]	;THE JSR ERROR
	MOVE D,ERMESS(T)
	JSP TT,PD 	;PRINT OUT APPROPRIATE COMMENT
	CAIL T,EBUG
	JRST READ 	;BAD ERROR - NO MORE DISKING
LOADG1:	DATAI TTY,C 	;FLUSH RANDOM CHARACTER
	TRO CMD,10 	;MAKE SURE PSEUDO-CORE IN CORE
	JRST LOADG 	;BY SIMULATING END OF LOADING, NON-GOING COMMAND
BEG:	CONO 635550 	;ENTER HERE, CLEAR WORLD
	LPMR PGBLK
	MOVEI B,ICWA+2
	MOVEM B,ICWA
	CLEARM ICWA+1
	MOVSI B,-2000 	;SIZE OF DPC BLOCK
	MOVEM B,@ICWA 	;INTO CHANNEL PROGRAM
	MOVE B,[-NXWDS,,XWDS-1]
	MOVEM B,ICWA+3
	MOVSI B,-200+NXWDS
	MOVEM B,ICWA+4
	CLEARM ICWA+5
	MOVSI B,-NDSK 	;FOR NUMBER OF DISKS
	SETOM PKNUM(B)	;SET DISK TO UNKNOWN
	AOBJN B,.-1
	MOVE T,[JRST LOADG1]	;SET BOOTSTRAP TO MIDDLE OF WORLD
	MOVEM T,BOOT
	JSR EDMP,ERROR	;CAUSE TYPOUT BY SIMULATING ERROR
ERMESS:	IRP XX,,[ECMP,EDIR,EEOF,ESNF,EFNF,EPNM,ECKS
EDSK,EDDT,EBUG,EC63,ECRD,ECWR,ECDR,EDMP,EMFC]YY,,[CMPERR,DIRFUL
EOF,SYSNNF,FNF,PKNMTD,CKSERR,DSKFUL,NODDT,?BUG?,CLOB63
CLOBRD,CLOBWR,DIRCLB,DSKDMP,MFDCLB]
XX==.-ERMESS
	SIXBIT \YY\
TERMIN

PD:	JSP P,CRLF 	;TYPE A CR
PD2:	MOVEI C,40
	JSP P,TYO 	;AND A SPACE
	MOVE B,[440600,,D]
PD1:	ILDB C,B 	;AND THE SIXBIT CONTENTS OF D
	ADDI C,40
	JSP P,TYO
	TLNE B,770000
	JRST PD1
	JRST (TT)

PNO:
C12:	IDIVI C,10. 	;PRINT CONTENTS OF C AS A TWO-DIGIT
	DPB C,[60600,,A]	;DECIMAL NUMBER PRECEDED
	MOVEI D,(SIXBIT /#00/+A) ;BY <SPACE>#
	MOVE B,[300600,,D]
	JRST PD1

WRCB:	MOVEI UNIT,CBUF	;WRITE OUT CONTENTS OF CBUF
	LSH BLKIN,-12	;ON APPROPRIATE BLOCK
	MOVEI BLOK,CBLK-CORES(BLKIN)
	JRST WRM

LODUMP:	MOVEI UNIT,CORE	;DEPENDING ON SIGN BIT OF WRITE, LOAD OR DUMP
	MOVEI BLOK,CBLK	;PSEUDO-CORE (766000-775777)
LODMP1:	JSP TT,WRDM
	ADDI UNIT,2000
	CAIGE UNIT,ERROR
	AOJA BLOK,LODMP1
	MOVEI BLKIN,CORE
	JRST (P)

FD:	HRRZ C,B 	;SET UP POINTER IN C TO FETCH OR DEPOSIT
	  	;CONTENTS OF ADDRESS IN RIGHT HALF OF B
IFN DBGSW, SKIPGE WRITE	;LOAD DDT WHEN IN DEBUG MODE
	CAIGE C,HIGH
	CAIGE C,40
	JRST (P)
	CAIGE C,CORE 	;IF ADDR IS IN REAL CORE, RETURN IMMEDIATELY
	JRST 1(P)
FDX:	CAIL C,(BLKIN)	;ADDR IS IN PSEUDO-CORE--CHECK IF RIGHT
	CAILE C,1777(BLKIN)	;BLOCK IS IN CBUF
	JRST FD3 	;IT'S NOT THERE--READ IT IN
FD4:	SUBI C,-CORE(BLKIN)	;IT'S THERE--SET UP RIGHT POINTER IN C
	JRST 1(P) 	;AND RETURN
FD3:	JUMPLE WRITE,FD3A	;IF DUMP OR VERIFY DON'T BOTHER
	  	;TO WRITE OUT CURRENT BLOCK
FD3B:	JSP TT,WRCB 	;IF LOAD, WRITE CURRENT BLOCK FIRST
FD3A:	MOVEI UNIT,CBUF
	MOVE BLKIN,C
	ANDI BLKIN,776000
	LDB BLOK,[121000,,BLKIN]
	ADDI BLOK,CBLK-CORES
	JSP TT,RDM 	;READ IN CORRECT BLOCK
	JRST FD4 	;SET UP POINTER AND RETURN

GBP:	IDIVI C,6 	;TURN USER DIRECTORY CHARACTER ADDR IN C
	IMULI A,-60000	;INTO A BYTE POINTER
	HRLI C,440600(A)
	ADDI C,DIR+UDDESC
	JRST (TT)

WD:	AOBJN BUFP,WD1	;READ, WRITE, OR VERIFY WORD IN D FROM, INTO,
	JSP TT,NXTBLK	;OR AGAINST WORD IN DBUF
	JSP TT,WRDB 	;TIME TO REFILL OR EMPTY DBUF
	MOVSI BUFP,-2000	;RESET BUFFER POINTER
WD1:	JUMPG WRITE,WD2	;JUMP ON LOAD
	JUMPL WRITE,WD3	;JUMP ON WRITE
	CAME D,DBUF(BUFP)	;HERE IF VERIFY
	JSR ECMP,ERROR	;VERIFY COMPARE LOST
	JRST (P)
WD2:	SKIPA D,DBUF(BUFP)	;LOAD
WD3:	MOVEM D,DBUF(BUFP)	;DUMP
	JRST (P)

NXTTUT:	HRRZ B,CU 	;SELECT NEXT UNIT AND READ ITS TUT
	AOJ B,
	CAIN B,NDSK
	MOVEI B,0
	HRRM B,CU
	CAIN B,@MU
	JRST 1(TT) 	;SKIP IF NO MORE
	SKIPE QDED(B)
	JRST NXTTUT 	;UNIT NOT ON LINE
RDTUT:	MOVEI BLOK,TUTBLK	;READ TUT OF CURRENT UNIT
	MOVEI UNIT,TUT
	SETOM PKNUM(B)	;ALWAYS READ HEADER FOR TUT
	JRST RD

NXTBW3:	0
	IBP DIRPT 	;DO AN IDPB T,DIRPT CHECKING TO SEE IF
	LDB DIFF,[1200,,DIRPT] ;RUNNING INTO NAME AREA
	CAML DIFF,DIR+UDNAMP
	JSR EDIR,ERROR
	DPB T,DIRPT
	JRST @NXTBW3

NXTBW:	MOVE BLOK,LBLOCK	;FIND NEXT FREE BLOCK TO WRITE
	MOVEI HEAD,1(BLOK)
	ILDB T,TUTPT
	JUMPN T,NXTBW1	;JUMP IF VERY NEXT BLOCK NOT FREE
	AOSG T,BLKCNT
NXTBW5:	SOJA HEAD,NXTBW4	;GENERATE LOAD ADR IF FIRST TIME (COMPENSATE FOR LBLOCK OFF BY 1)
	CAIG T,UDTKMX-1
	JRST NXTBW2 	;NO NEED TO MODIFY DIRECTORY YET
	CLEARM BLKCNT 	;14 IN A ROW--RESET COUNTER AND
NXTBW6:	JSR NXTBW3 	;DPB BYTE INTO DIRECTORY
NXTBW2:	MOVE BLOK,HEAD
	CAIL BLOK,NBLKS
	JSR EDSK,ERROR	;NO MORE DISK LEFT
	MOVEI T,1
	DPB T,TUTPT 	;MARK BLOCK USED IN TUT
	JRST WRDB1
NXTBW1:	ADDI HEAD,1 	;SEARCH FOR NEXT FREE BLOCK
	ILDB T,TUTPT
	JUMPN T,NXTBW1
	SUBM HEAD,BLOK
	SKIPLE T,BLKCNT	;COME UP WITH DESC BYTE FOR LAST FEW BLOCKS
	JSR NXTBW3
	CLEARM BLKCNT
	JUMPL T,NXTBW5	;FIRST TIME
	MOVEI T,UDTKMX-1(BLOK)
	CAIGE T,UDWPH 	;CAN WE SAY SKIP N--TAKE 1?
	JRST NXTBW6 	;YES
NXTBW4:	MOVEI BLOK,NXLBYT
	MOVE T,HEAD
	ROT T,-NXLBYT*6
	ADDI T,UDWPH+1
	JSR NXTBW3
	ROT T,6
	SOJG BLOK,.-2
	JRST NXTBW6

NXTBLK:	JUMPL WRITE,NXTBW	;GET NEXT BLOCK OF FILE--IF DUMP, FIND FREE
	MOVE BLOK,LBLOCK	;BLOCK
NXTB6:	SOSLE BLKCNT 	;HAVE WE RUN OUT OF "TAKE N"?
	AOJA BLOK,WRDB1	;NO--TAKE NEXT BLOCK
	ILDB T,DIRPT 	;YES--GET NEXT DESC BYTE
	CAILE T,UDWPH
	JRST NXTB1 	;IT'S A LOAD ADDR
	CAIE T,UDWPH
	JUMPN T,NXTB2 	;IT'S A TAKE OR SKIP
	CAIE CMD,'D 	;IT'S 0 OR NULL--IF THIS IS A LOAD, IT'S AN
	CAIN CMD,'K 	;UNEXPECTED END OF FILE
	JRST KILL1 	;IF LOAD OR KILL, O.K.
	JSR EEOF,ERROR
NXTB1:	MOVEI BLOK,-UDWPH-1(T)  ;LOAD ADR
	MOVEI BUFP,NXLBYTS
NXTB1A:	MOVEI T,0
	CAIE CMD,'D
	CAIN CMD,'K
	DPB T,DIRPT 	;IF KILLING FILE, ZERO THIS BYTE (OTHERS ZEROED AT KILL)
	LSH BLOK,6
	ILDB T,DIRPT
	ADD BLOK,T 	;GET COMPLETE BLOCK NUMBER
	SOJG BUFP,NXTB1A
	JRST NXTB3
NXTB2:	MOVEM T,BLKCNT
	CAIG T,UDTKMX
	AOJA BLOK,WRDB1	;TAKE N STARTING WITH NEXT ONE
	ADDI BLOK,-UDTKMX+1(T) ;SKIP N-<MAX TAKE> AND TAKE 1
NXTB3:	CLEARM BLKCNT
WRDB1:	MOVEM BLOK,LBLOCK
	JRST (TT)

WRDM:	SKIPL WRITE 	;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	HRRI WRITE,10	;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 	;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF	;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE	;READ OR WRITE FROM/ON CURRENT UNIT
RD:	TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	HRRI WRITE,10	;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0	;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	DPB WRITE,[360600,,DBLK]	;SET OP, UNIT SEL
	DPB WRITE,[DUNFLD SEEK]
	DPB WRITE,[DUNFLD RECAL]
	HRLI UNIT,-2000
	MOVEM UNIT,@ICWA
	SOS @ICWA
	LDB UNIT,[300,,WRITE]	;ISOLATE FROM GARBAGE
	MOVNI DIFF,11	;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;10. LOSSES PERMITTED
WRD5:	DATAO DPC,CLATT	;CLEAR ATTENTIONS
	HRRZ DIFF,BLOK
	IDIVI DIFF,NCBLKS
	DPB DIFF,[DCYL SEEK]
	DPB DIFF,[DCYL DBLK]
	MOVE DIFF,HEAD
	IMULI DIFF,NSSECS
	IDIVI DIFF,NHSECS
	DPB DIFF,[DSURF DBLK]
	DPB HEAD,[DSECT DBLK]
	DATAO DPC,SEEK
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	JRST .-2
	DATAO DPC,CLATT
	TLNN DIFF,(ONCYL)
	JRST WRD0
	DATAO DPC,DBLK
	CONSO DPC,DONE
	JRST .-1
	CONSO DPC,ALLER
	JRST WRDX
	HRRZM BLOK,BADBLK
	AOSG ERRCT	;HARDWARE ERROR--CHECK COUNTER
	JRST WRD5	;TRY AGAIN
	TRNE WRITE,10	;GIVE UP--DISTINGUISH BETWEEN
	JSR ECWR,ERROR	;WRITE ERRORS AND
	JSR ECRD,ERROR	;READ ERRORS

WRDX:	HRRZ UNIT,@ICWA	;RESTORE ADDR
	ADDI UNIT,1 	;COMPENSATE FOR IOWD LOSSAGE
	DPB BLOK,[XWBLK,,XWDS]
	TRZ WRITE,-1	;FLUSH GARBAGE
	JRST (TT)

WRD0:	AOSLE ERRCT
	JSR EC63,ERROR
	DATAO DPC,RECAL
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	JRST .-2
	JRST WRD5

DBLK:	ICWA
SEEK:	DSEEKC
RECAL:	DRCALC
CLATT:	DEASEC ALLATT

TYI:	ILDB C,MEMSIZ-1	;CHECK FOR COMMANDS FROM MEMORY
	JUMPN C,(P)	;FOUND ONE--RETURN
	CLEARM MEMSIZ-1
	CONSO TTY,40
	JRST .-1
	DATAI TTY,C
	ANDI C,177
	CAIGE C,175
	CAIN C,33
	JRST (P)	;DON'T ECHO GRITCHES
TYO:	SKIPE MEMSIZ-1
	JRST (P)	;DON'T ECHO COMMANDS FROM MEMORY
	HRRZ A,C	;COMPUTE PARITY
	IMULI A,40201
	AND A,[1111111]
	IMUL A,[1111111]
	TLNE A,1
	IORI C,200
	CONSZ TTY,20
	JRST .-1
	DATAO TTY,C
	ANDCMI C,200
	JUMPGE C,(P)	;CHECK FOR CRLF (AS OPPOSED TO ECHOING A CR)
	SKIPA C,C12	;TYPE AN LF
CRLF:	HRROI C,15
	JRST TYO

LINK:	CAIE CMD,'D
	CAIN CMD,'K
	MOVSI WRITE,-1	;MAKE THIS INFO MORE CONVENIENT
	MOVE D,[440600,,C]
	MOVEI T,0
LINKL:	ILDB TT,DIRPT
	SKIPGE WRITE
	DPB T,DIRPT	;CLOBBER CHARS READ FOR DUMP OR KILL
	CAIN TT,';
	JRST LINKN
	CAIN TT,':
	JRST LINKQ
LINKQ1:	IDPB TT,D
	TLNE D,770000
	JRST LINKL
LINKN1:	CAMGE D,[600,,B]	;THRU WITH FN2?
	JRST LINKL
	JUMPL WRITE,KILL1
	MOVEM A,FN1
	MOVEM B,FN2
	JRST MLOOK2

LINKN:	TLNN D,770000
	JRST LINKN1
	IDPB T,D	;FILL OUT WITH SPACES
	JRST LINKN

LINKQ:	ILDB TT,DIRPT
	JUMPGE WRITE,LINKQ1
	DPB T,DIRPT
	JRST LINKQ1

READ:	MOVEI BLKIN,CORE
	JSP P,CRLF
	MOVEI CMD,0	;INITIALIZE COMMAND
READ1A:	MOVEI WRITE,0	;INITIALIZE NUMBER
	MOVSI B,(SIXBIT \@\)	;INITIALIZE 1ST FILE NAME
READ1:	MOVEM B,FN1
READ3A:	MOVSI B,(SIXBIT \@\)	;INITIALIZE CURRENT FILE NAME
	MOVE D,[440600,,B]
READ2:	JSP P,TYI
	CAIN C,177
	JRST READ	;IF RUBOUT START OVER
	CAIGE C,175
	CAIN C,33
	JRST ALTMOD	;JUMP IF 33, 175, 176
	ASH WRITE,3	;DOES NOT CHANGE SIGN OF WRITE
	CAIL C,"0
	CAILE C,"7
	TLOA WRITE,400000	;NON-NUMERIC CHAR--MAKE WRITE NEGATIVE
	ADDI WRITE,-"0(C)	;NUMERIC CHAR--ACCUMULATE NUMBER
	CAIN C,";
	JRST READ3	;SET SYSTEM NAME
	CAIN C,40
	JRST READ1	;SET FIRST FILE NAME
	CAIN C,^Q
	JSP P,TYI	;QUOTED CHARACTER
	CAIGE C,140	;CHECK FOR LOWER CASE
	SUBI C,40
	JUMPL C,DOIT	;IF LESS THAN 40 (EXC. ^Q) END OF COMMAND
	TLNE D,770000	;SKIP IF ALREADY SIX CHARS
	IDPB C,D
	JRST READ2
READ3:	MOVEM B,SYSN
	CAIE CMD,'U
	JRST READ3A
	JRST DOIT	;IF COMMAND IS U GO LIST DIRECTORY

PGBLK:	BLOCK 8

ONOFF:	CAIGE WRITE,NDSK
	DPB CMD,[100,,QDED(WRITE)]	;LOW BIT OF CMD DETERMINES ON/OFF LINE STATUS
	JRST READ

ALT1:	LDB CMD,D	;PICK UP COMMAND CHAR
	CAIE CMD,'K
	TRNN CMD,2
	JRST READ1A	;GET FILE NAME
	JRST DOIT	;DON'T WANT FILE NAME--GO TO WORK

ALTMOD:	MOVEI C,"$
	JSP P,TYO	;ECHO DOLLAR SIGN
	JUMPLE WRITE,ALT2	;JUMP IF NOT <NUMBER><ALTMODE> LAST TYPED
	JUMPN CMD,ONOFF	;JUMP IF <CMD><ALTMODE><NUMBER><ALTMODE>
	HRRM WRITE,SADR	;SET STARTING ADDR
	JRST READ
ALT2:	TLC D,360000
	TLCN D,360000	;DON'T SKIP IF SINGLE CHARACTER BEFORE <ALTMODE>
	JUMPE CMD,ALT1	;JUMP IF NO COMMAND ALREADY TYPED
DOIT:	MOVEM B,FN2	;STORE SECOND FILE NAME
	HRRZ B,MU
	HRRM B,CU	;MAKE MASTER UNIT CURRENT UNIT
	MOVNI WRITE,1
	JSP P,LODUMP	;DUMP OUT PSEUDO-CORE
	CAIN CMD,'G
	JRST LOADG0	;GO
	JSP TT,RDTUT
	MOVE C,SYSN
MLOOK2:	MOVSI WRITE,1	;MAKE WRITE INDICATE LOAD
	MOVEI BLOK,MFDBLK
	MOVEI UNIT,DIR
	JSP TT,RD	;READ MASTER DIRECTORY TO FIND WHERE USER DIRECTORY IS
	MOVE T,DIR+MDCHK
	CAME T,[SIXBIT /M.F.D./]
	JSR EMFC,ERROR
	CAIN CMD,'S
	JRST LISTS	;LIST DISK ID'S AND SYSTEM NAMES
	MOVE C,SYSN
	MOVE T,DIR+MDNAMP
MLOOK:	CAMN C,DIR+MNUNAM(T)	;LOOK UP SYSTEM NAME
	JRST MLOOK1
	ADDI T,LMNBLK
	CAIGE T,2000
	JRST MLOOK
	JSR ESNF,ERROR	;NOT FOUND

MLOOK1:	MOVEI BLOK,2*NUDSL-2000(T)	;CONVERT USER SLOT TO BLOCK NUMBER
	LSH BLOK,-1
	HRRM BLOK,UDBLK	;REMEMBER FOR KILL OR DUMP
	MOVEI UNIT,DIR
	JSP TT,RDM	;READ USER DIRECTORY
ULOOK:	CAME C,DIR+UDNAME
	JSR ECDR,ERROR	;WRONG ONE??
	CAIE CMD,'F
	CAIN CMD,'U
	JRST LISTFC	;LIST USER DIRECTORY
	MOVSI TT,UNIGFL
	MOVE T,DIR+UDNAMP
	MOVE A,FN1
	MOVE B,FN2
ULOOK1:	CAMN A,DIR+UNFN1(T)	;LOOK UP FILE NAME
	CAME B,DIR+UNFN2(T)
	JRST ULOOK2
	TDNN TT,DIR+UNRNDM(T)	;IS THIS FILE FOR REAL?
	JRST ULOOK3
ULOOK2:	ADDI T,LUNBLK
	CAIGE T,2000
	JRST ULOOK1
	CAIE CMD,'D	;IF NOT FOUND BETTER BE DUMP
	JSR EFNF,ERROR
	MOVE T,DIR+UDNAMP
ULOOK4:	SKIPN DIR+UNFN1(T)	;FIND FREE SLOT FOR NEW FILE
	JRST DUMP
	ADDI T,LUNBLK
	CAIGE T,2000
	JRST ULOOK4
	MOVNI T,LUNBLK	;NO FREE SLOTS--TRY TO EXTEND NAME AREA DOWN
	ADDM T,DIR+UDNAMP
	MOVE T,DIR+UDESCP
	IDIVI T,6
	ADDI T,UDDESC
	CAMGE T,DIR+UDNAMP	;DID WE RUN INTO DESCRIPTOR AREA?
	JRST DUMP0
	JSR EDIR,ERROR	;YES
ULOOK3:	HRRM T,DMP4	;IF FILE FOUND, SAVE SLOT NUMBER FOR DUMP
	LDB C,[UNDSCP DIR+UNRNDM(T)]
	JSP TT,GBP
	MOVEM C,DIRPT	;SET UP DESCRIPTOR AREA BYTE POINTER
	MOVSI TT,UNLINK
	TDNE TT,DIR+UNRNDM(T)
	JRST LINK	;FILE IS A LINK
	LDB A,[UNPKN DIR+UNRNDM(T)]
ULOOK5:	CAMN A,TUT+QPKNUM	;SEE IF IT'S MOUNTED
	JRST LOAD
	JSP TT,NXTTUT
	JRST ULOOK5
	JSR EPNM,ERROR

LOAD:	CAIE CMD,'D	;GET HERE IF FILE FOUND
	CAIN CMD,'K	;IF DUMP OR KILL, DELETE IT
	JRST KILL
ZERO:	MOVEI TT,CORE-1
	TRNN CMD,20
	JRST ZERO1
	MOVE B,SADR
	SUBI B,1
	JSP P,FD	;GET DDT'S SYMBOL TABLE POINTER
	JSR EDDT,ERROR	;CAN'T GET IT??
	HRROS B,(C)	;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
	HRRM B,LOADS4
	JSP P,FD
	JSR EDDT,ERROR
	MOVE D,(C)
	MOVEM D,DDTM2
	MOVEI TT,CORE-1
	CAILE TT,(D)
	HRRZ TT,D
ZERO1:	TRNE CMD,1
	JRST LOAD1	;NON-ZEROING COMMAND
	SETZM 40 	;BEGIN CLEARING CORE
	MOVE T,[40,,41]	;SET UP BLT POINTER
IFE FULHSW,[ 	;CODE TO SKIP OVER NXM
ZERO2:	CAIG TT,10*2000-1(T)	;MORE THAN 8K LEFT TO ZERO?
	JRST ZERO4 	;NO, ZERO REMAINING WORDS AND PROCEED
	BLT T,10*2000-1(T)	;ZERO NEXT 8K
ZERO3:	ADDI T,10*2000	;MOVE DEST OF BLT PNTR UP 8K
	ANDCMI T,1777 	;ROUND DOWN TO 1K BOUNDARY
	CONO 10000 	;CLEAR NXM
	MOVES (T) 	;SET NXM IF HOLE
	CONSZ 10000 	;NXM GENERATED?
	JRST ZERO3 	;YES, GO TO NEXT 8K
	JRST ZERO2 	;NO, CLEAR THIS 8K
ZERO4:]
	BLT T,(TT) 	;AND CLEAR TO TOP BOUNDARY
	TRNE CMD,20
	JRST LOAD1	;IF SYMBOL-LOADING COMMAND, STOP THERE
	CLEARM CBUF
	MOVE T,[CBUF,,CBUF+1]
	BLT T,CBUF+1777
	MOVEI UNIT,CBUF
	MOVE BLOK,[-5,,CBLK]
	JSP TT,WRM	;CLEAR PSEUDO-CORE
	AOBJN BLOK,.-1
LOAD1:	SETZB BUFP,BLKCNT	;SET UP BUFP SO FIRST CALL TO WD WILL READ
LOAD2:	JSP P,WD	;FIRST BLOCK OF FILE
	CAME D,[JRST 1]	;LOOK FOR END OF SBLK LOADER
	JRST LOAD2
	CAIN CMD,'I	;IF VERIFY, START SIMULATING DUMP
	JRST DUMP.5
LOAD3:	JSP P,WD	;READ BLOCK HEADER
	JUMPGE D,LOADS	;IT'S A JUMP BLOCK
	MOVE A,D
	MOVE B,D
	JSR LOADB	;LOAD LOGICAL BLOCK INTO CORE
	JRST LOAD3

LOADS:	TRNN CMD,20
	JRST LOADJ	;DON'T LOAD SYMBOLS
	MOVEM D,NXTBW3	;SAVE S.A.
LOADS1:	MOVE B,DDTM2
	JSP P,WD	;GET SYMBOL BLOCK HEADER
	JUMPGE D,LOADS2	;JUMP IF END OF SYMBOLS
	MOVSS D
	HRLI D,-1(D)
	ADD B,D	;EFFECTIVELY SUBTRACTS LENGTH OF BLOCK FROM BOTH HALVES
	MOVEM B,DDTM2	;OF SYMBOL TABLE POINTER
	HRL B,D	;SET UP AOBJN POINTER IN B
	HRLZ A,D	;AND RECREATE HEADER IN A
	JSR LOADB	;LOAD THE SYMBOLS
	JRST LOADS1

LOADS2:	MOVE D,DDTM2
LOADS4:	MOVEI B,.	;PNTR TO SYMTAB PNTR
	JSP P,FD	;PUT BACK SYMBOL TABLE POINTER
	JSR EBUG,ERROR	;CAN'T PUT IT BACK??
	MOVEM D,(C)
	MOVE D,NXTBW3	;"GIVE" S.A. TO DDT
	JRST LOADG0

LOADJ:	HRRM D,SADR	;SET STARTING ADDRESS FROM JUMP BLOCK
LOADG0:	MOVE T,[CONSZ DPC,BUSY]
	MOVEM T,BOOT
LOADG:	JSP TT,WRCB	;MAKE SURE ALL LOADED CRUFT IN PSEUDO-CORE IS OUT
	MOVEI WRITE,0
	JSP P,LODUMP	;AND LOAD IT ALL IN
	TRNE CMD,10
	JRST READ	;NON-GOING COMMAND
GO:	DATAO DPC,CLATT
	MOVE B,ERRWD
	MOVEM B,@ICWA
	CLEARM ICWA+3
	DATAO DPC,SWPSK
	CONSO DPC,DONE
	JRST .-1
	DATAO DPC,SWPOU1
	CONSO DPC,DONE
	JRST .-1
	DATAO DPC,SWPOU2
	JRST WAIT

LOADB:	0
LOAD4:	JSP P,WD	;LOAD A LOGICAL BLOCK--AOBJN POINTER IN B,
	ROT A,1	;BLOCK HEADER IN A (FOR CHECKSUM)
	ADD A,D	;ADD NEW WORD INTO CHECKSUM
	JSP P,FD	;AND PREPARE TO SMASH IT AWAY
	JRST .+2	;LOCATION CAN'T BE LOADED
	MOVEM D,(C)	;SMASH WORD AWAY
	AOBJN B,LOAD4
	JSP P,WD
	CAMN A,D	;CHECK THE CHECKSUM
	JRST @LOADB
	JSR ECKS,ERROR	;BAD CHECKSUM

LISTS:	JSP P,CRLF
LISTS2:	CONSZ TTY,40
	JRST LOADG1	;SHUT UP IF KEY HIT
	MOVE C,TUT+QPKNUM	;TYPE PACK NUMBER
	JSP TT,PNO
	MOVE D,TUT+QPKID	;AND I.D.
	JSP TT,PD2
	JSP TT,NXTTUT	;SAME FOR ALL DIRECTORIES
	JRST LISTS2
	MOVE T,DIR+MDNAMP
LISTS1:	CONSO TTY,40	;STOP TYPING IF TTI FLAG ON
	CAIL T,2000
	JRST LOADG1
	SKIPE D,DIR+MNUNAM(T)
	JSP TT,PD	;TYPE OUT USER NAME
	ADDI T,LMNBLK
	JRST LISTS1

LISTFC:	MOVE T,DIR+UDNAMP
LISTF1:	CONSO TTY,40	;STOP TYPING IF TTI FLAG ON
	CAIL T,2000
	JRST LOADG1
	SKIPN DIR+UNFN1(T)	;SKIP IF FILE IN THIS SLOT
	JRST LISTF2
	JSP P,CRLF
	LDB C,[UNPKN DIR+UNRNDM(T)]
	JSP TT,PNO	;TYPE PACK NUMBER
	MOVE D,DIR+UNFN1(T)
	JSP TT,PD2	;TYPE FIRST FILE NAME
	MOVE D,DIR+UNFN2(T)
	JSP TT,PD2	;AND SECOND FILE NAME
LISTF2:	ADDI T,LUNBLK
	JRST LISTF1

KILL:	JSP TT,NXTB6	;GET HERE ON KILL OR DUMP OF EXISTING FILE
	MOVEI T,0	;ZERO BYTES IN USER DIRECTORY DESCIPTOR AREA
	DPB T,DIRPT	;NXTB6 JUMPS TO KILL1 AT END OF FILE
	MOVE C,BLOK
	JSP TT,GTP
	ILDB T,C
	CAIGE T,TUTLK-1	;SOS USAGE OF THIS BLOCK
	SOJL T,[JSR ECDR,ERROR]
	DPB T,C
	JRST KILL
KILL1:	HRRZ T,DMP4	;CLEAR OUT USER DIRECTORY SLOT
	CLEARM DIR+UNFN1(T)
	CLEARM DIR+UNFN2(T)
	CLEARM DIR+UNRNDM(T)
	MOVSI WRITE,-1
	CAIN CMD,'K
	JRST KILDMP	;IF KILL DON'T DUMP
	JRST DMP4	;MUST DUMP ON SAME UNIT

DUMP0:	MOVE T,DIR+UDNAMP	;GET HERE IF SLOT CREATED AT BOTTOM OF NAME AREA
DUMP:	HRRM T,DMP4	;GET HERE IF EMPTY SLOT FOUND IN NAME AREA
DMP0:	MOVEI D,0	;GET HERE IF USING SLOT OF OLD FILE
DMP1:	MOVE C,TUT+QSWAPA
	MOVSI B,-NBLKS(C)
	JSP TT,GTP
DMP2:	ILDB T,C
	SKIPE T
	SUBI B,1
	AOBJN B,DMP2
	CAIG B,(D)	;RH OF D IS HIGHEST SO FAR, LH SAYS WHICH UNIT
	JRST DMP5	;NOT BETTER THAN RECORD
	MOVE D,B	;NEW RECORD--RECORD IT
	HRL D,CU
DMP5:	JSP TT,NXTTUT	;TRY NEXT
	JRST DMP1
		;FALLS THRU AT END

DMP3:	HLRM D,CU	;SET CURRENT UNIT TO ONE WITH MOST FREE BLOCKS
	JSP TT,RDTUT	;GET ITS TUT
DMP4:	MOVEI T,.
	MOVE A,FN1
	MOVE B,FN2
	MOVEM A,DIR+UNFN1(T)	;PUT CRUFT INTO SLOT
	MOVEM B,DIR+UNFN2(T)
	SETOM DIR+UNDATE(T)
	MOVEM A,XWDS+XWFN1
	MOVEM B,XWDS+XWFN2
	MOVE C,SYSN
	MOVEM C,XWDS+XWSYSN
	MOVE C,DIR+UDESCP	;PUT DESCRIPTOR CHARACTER ADDRESS
	MOVE B,TUT+QPKNUM	;AND PACK NUMBER
	DPB B,[UNPKN C]
	MOVEM C,DIR+UNRNDM(T)	;INTO USER DIRECTORY SLOT
	MOVE C,TUT+QSWAPA
	MOVEM C,LBLOCK
	JSP TT,GTP
	MOVEM C,TUTPT	;INITIALIZE TUT POINTER
	MOVE C,DIR+UDESCP
	JSP TT,GBP
	MOVEM C,DIRPT	;INITIALIZE DESCRIPTOR AREA POINTER
	SETOB WRITE,BLKCNT	;FORCE NXTBW TO LOAD ADR
	HRLOI BUFP,-2001-1	;SET UP BUFP SO FIRST WORD GOES IN DBUF+0
	MOVE D,[JRST 1]
	JSP P,WD	;END OF SBLK LOADER

DUMP.5:	MOVSI WRITE,-'I(CMD)	;GET HERE IF VERIFY--SET WRITE NEGATIVE IF
	MOVEI B,40	;DUMP AND ZERO IF VERIFY--FIRST ADDR DUMPED IS 40
DUMP1:
IFE FULHSW,[ 	;SKIP OVER NXM ON DUMPING
	CONSO 10000 	;NXM SET?
	JRST DUMP1A 	;NO, CONTINUE IN SEQUENCE
	ADDI B,10*2000-1	;SKIP 8K
	TRZ B,1777 	;ROUND DOWN TO 8K BOUDARY
	CONO 10000 	;CLEAR NXM
DUMP1A:]
	JSP P,FD
	JRST DUMPJ	;TIME TO WRITE JUMP BLOCK
	SKIPN (C)	;LOOK FOR NON-ZEROES
	AOJA B,DUMP1
	MOVE A,B	;FOUND SOME
	HRLI B,-200	;DON'T DUMP MORE THAN 200 OF THEM
DUMP2:	JSP P,FD
	JRST DUMP3	;END OF CORE--WRITE OUT THIS BLOCK
	SKIPE (C)	;LOOK FOR ZEROES
	JRST DUMP2A
	AOBJP B,DUMP3	;JUMPS IF WE HAVE 200 WORDS' WORTH OF CRUD ANYWAY
	JSP P,FD
	JRST DUMP3
	SUBI B,1
	SKIPE (C)	;IF NOT TWO ZEROES DON'T END BLOCK
DUMP2A:	AOBJN B,DUMP2	;UNLESS THERE ARE ALREADY 200 WORDS
DUMP3:	HRRM B,DUMP4	;SAVE ADDRESS TO CONTINUE SEARCH
	SUBM A,B	;GET MINUS THE LENGTH OF THE BLOCK
	HRL A,B	;SET UP HEADER IN A
	MOVE B,A	;AND B
	MOVE D,A	;AND D
	JSP P,WD	;WRITE HEADER
DUMP3A:	JSP P,FD
	JSR EBUG,ERROR	;CAN'T FETCH WORD WE FETCHED BEFORE??
	MOVE D,(C)
	ROT A,1
	ADD A,D	;COMPUTE CHECKSUM
	JSP P,WD
	AOBJN B,DUMP3A
	MOVE D,A
	JSP P,WD	;WRITE OUT CHECKSUM
DUMP4:	MOVEI B,.	;AND CONTINUE SEARCHING
	JRST DUMP1

GTP:	IDIVI C,36./TUTBYT
	IMULI A,-10000*TUTBYT
	HRLI C,440000+TUTBYT_6(A)
	ADDI C,TUT
	JRST (TT)

DUMPJ:	MOVE D,SADR
	JSP P,WD	;WRITE OUT JUMP BLOCK
	JUMPE WRITE,LOADG1	;IF VERIFY, THAT'S ALL
	JSP P,WD	;INDICATE NO SYMBOLS IN FILE
	JSP TT,NXTBLK
	JSP TT,WRDB	;WRITE OUT LAST BLOCK
	SKIPE T,BLKCNT
	JSR NXTBW3	;STORE LAST DESCRIPTOR BYTE
	MOVEI T,0
	JSR NXTBW3	;AND INDICATE END OF FILE
	LDB T,[360600,,DIRPT]
	IDIVI T,6
	HRRZ TT,DIRPT
	IMULI TT,6
	SUBI TT,6*<DIR+UDDESC>-5-1(T)
	HRRZM TT,DIR+UDESCP	;INDICATE NEW END OF DESCRIPTOR AREA
KILDMP:	MOVEI UNIT,TUT
	MOVEI BLOK,TUTBLK
	JSP TT,WRD	;WRITE OUT MASTER DIRECTORY ON THIS UNIT
	HRRZ B,CU
	HRRM B,KD2	;WRITE OUT USER DIRECTORY ON ALL UNITS
KD1:	AOJ B,
	CAIN B,NDSK
	MOVEI B,0
	HRRM B,CU
	SKIPE QDED(B)
	JRST KD2
	MOVEI UNIT,DIR
UDBLK:	MOVEI BLOK,.
	JSP TT,WR
KD2:	CAIN B,.
	JRST LOADG1
	JRST KD1

ERRCT:	0	;ERROR COUNTER
DDTM2:	0	;DDT SYMBOL TABLE POINTER
LBLOCK:	0	;LAST BLOCK WRITTEN OR READ
BLKCNT:	0	;NUMBER OF BLOCKS READ OR WRITTEN CONSECUTIVELY
DIRPT:	0	;DESCRIPTOR AREA BYTE POINTER
TUTPT:	0	;TUT BYTE POINTER
FN1:	0	;FILE NAME 1
FN2:	0	;FILE NAME 2
PKNUM:	REPEAT NDSK,-1
QDED:	BLOCK NDSK
XWDS:	BLOCK NXWDS
CONSTA
BLOCK <.\67>-.
BADBLK:	0	;BLOCK WITH HDWE ERROR
IRP XX,,\<.-1>
IF1,PRINTX  BADBLK=XX
 TERMIN
BLOCK ERROR+1700-.

CBOOT:	CLEARM MEMSIZ-1	;BOOTSTRAP
BOOT:	JRST BEG	;OR CONSZ DPC,BUSY OR JRST LOADG1
	JRST .-1
	MOVEI B,ICWA+2	;SET UP CHANNEL PROG
	MOVEM B,ICWA
	SETZM ICWA+1
	SETZM ICWA+3
	DATAO DPC,CLATT1
	MOVE B,ERRWD
	MOVEM B,@ICWA
	DATAO DPC,SWPSK	;POSITION
	CONSO DPC,DONE
	JRST .-1
	DATAO DPC,SWPIN1	;WRITE TOP BLOCK EXCEPT FOR TOP 100 WDS
	CONSO DPC,DONE
	JRST .-1
	DATAO DPC,SWPIN2	;READ IN DSKDMP
	CONSO DPC,DONE
	JRST .-1
	JRST BEG

ERRWD:	-1700,,ERROR-1
CLATT1:	DEASEC ALLATT
SWPSK:	DSEEKC+200._22.
SWPIN1:	DWRITC+200._22.+3_17.+6._12.+ICWA	;NBLKS 4
SWPIN2:	DREADC+200._22.+4_17.+5._12.+ICWA	;NBLKS 5
SWPOU1:	DWRITC+200._22.+4_17.+5._12.+ICWA	;NBLKS 5
SWPOU2:	DREADC+200._22.+3_17.+6_12.+ICWA	;NBLKS 4

WAIT:	CONSO DPC,DONE
	JRST .-1
SADR:	JRST BOOT	;AND GO TO PROGRAM TO BE STARTED
SYSN:	SIXBIT /./

OFFSET 0
LOC CORE
CBUF:	BLOCK 2000	;PSEUDO-CORE BUFFER
DBUF:	BLOCK 2000	;DISK BUFFER
DIR:	BLOCK 2000	;DIRECTORY BUFFER
TUT:	BLOCK 2000
IFN .&777777-ERROR,PRINTX ;UGH
;
END ZZZ