MLSYS from around 1973. Needed to build ML ITS 785.

src/mlsys/10d16k.1

@@ -0,0 +1,413 @@
+;TITLE MACDMP - MAC DECTAPE UTILITY - R CLEMENTS 8 OCT 67 - V001
+MODE==0
+
+	IFE MODE,TITLE MACDMP TD10 TAPE CONTROL VERSION
+	IFN MODE,TITLE MACDMP  551/136 TAPE CONTROL VERSION
+
+	NOSYMS
+	RIM10
+MEMSIZ==40000	;16K
+
+	DTC=320
+	DTS=324
+
+F=0	;MUST BE 0. USED BY JRA'S
+A=2	;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT
+B=1	;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH
+C=3	;HOLDS BITS FOR DECTAPE CONO DURING I/O
+D=4	;HOLDS POINTERS FOR AOBJN'S THROUGH CORE
+E=5	;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK
+P=6	;PC FOR JSP'S
+CKS=7	;USUALLY CHECKSUM
+FILN=10	;NUMBER OF FILE IN DIRECTORY, 1 TO 27 OCTAL
+BLKNO=11	;BLOCK NUMBER SEARCHED FOR ON TAPE
+WRITE=12	;MULTI-STATE FLAG FOR DEFINING I/O OPERATION
+		;1=D 0=K -5=I -1=ELSE
+PNTR=13	;POINTER TO BYTE TABLE IN DIRECTORY
+CH=14	;HOLDS 6BIT CHARACTER OF COMMAND, OR -1
+Q=15	;ANOTHER JSP AC
+G=16	;RARELY USED VERY TEMP
+
+DDT=MEMSIZ-4000	;LOCATION OF HIGH DDT, MAC VERSION.
+COMPTR=MEMSIZ-1	;COMMAND POINTER, IF SUPPLIED
+
+DEFINE INFORM A,B
+IF2,[PRINTX \A!B
+\]
+TERMIN
+
+	LOC MEMSIZ-602
+	LOZAD=.-1	;WHEN CORE IS CLEARED, IT
+			;IS FROM 40 THRU LOZAD
+	LOW=20	;FIRST LOCATION CONSIDERED FOR DUMPING
+	HIGH=.-1	;LAST LOCATION CONSIDERED FOR DUMPING
+FOOF:	BLOCK 1	;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1
+TAB:	BLOCK 200	;FILE DIRECTORY
+TAPENO:	BLOCK 1	;TAPE UNIT SHIFTED LEFT FOR CONO
+;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS
+;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1
+
+BEGR:	SETZM COMPTR	;CLEAR ANY JUNK IN COMMAND POINTER
+	CONO 635550	;I/O RESET, ETC.
+BEG:	JSP P,CRR	;TYPE A CR-LF
+	MOVEI D,SPNT-1	;PREPARE TO REMOVE AOBJN POINTERS
+BEG1:	SETZB A,FOOF	;CLEAR A TO PUT IN CORE, CLEAR
+			;FOOF FOR  THE NEXT ZERO CORE SEARCH
+	EXCH A,1(D)	;REMOVE HEADER LIST
+	AOBJN A,.	;COUNT THROUGH TO NEXT HEADER
+	TLNE A,-2
+	JRST .-2
+	MOVEI D,-1(A)	;ACCOUNT FOR OVERSHOOT IN AOBJN
+	JUMPN D,BEG1	;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR
+	MOVE PNTR,[XWD 500,TAB+55]	;5 BIT BYTES IN DIRECTORY
+	SETZB CH,F
+CRCH:	SETOI WRITE,215	;USED FOR CARRET TYPEOUT
+TYI:	MOVSI B,400000	;INIT FILE NAME TO @ @
+SPACE:	EXCH C,B	;COPY FIRST WORD OF NAME TO C
+	MOVSI B,400000	;PREPARE FOR SECOND WORD
+	MOVSI E,20600	;FAKE OUT END-TEST OF BYTE POINTER
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+NEXT:	ILDB A,@BEGR	;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED
+			;RH OF NEXT IS USED AS A CONSTANT
+	JUMPN A,RCH	;JUMP IF COMMEND READ FROM CORE
+	MOVNI FILN,1	;INITIALIZATION FOR SEARCH
+	MOVEI BLKNO,0	; "
+	CONSO TTY,40	;TYPEIN FLAG?
+	JRST .-1	;NO,WAIT
+	DATAI TTY,A	;GET TYPED IN CHARACTER
+	JSP P,TYO	;ECHO IT (WITH PARITY)
+RCH:	ANDI A,177	;STRIP OFF PARITY
+	CAIN A,177	;RUBOUT?
+	JRST BEGR	;YES. RESTART MACDMP
+	CAIE A,33	;NEW ALTMODE?
+	CAIL A,175	;OR 175 OR 176 ALTMODES?
+	JRST ALTTST	;YES, SOME ALTMODE.
+	CAIL A,140	;LOWER CASE CHARACTER?
+	TRZ A,40	;YES. CHANGE TO UPPER CASE
+	SUBI A,40	;CONVERT TO SIXBIT
+	JUMPL A,CARRET	;ANY CONTROL CHARACTER
+	JUMPE A,SPACE	;CHAR WAS 40
+NEXT1:	TLNE E,770000	;NO MORE THAN SIX CHARS
+	IDPB A,E	;GOES INTO AC1 = B
+	JRST NEXT	;GET ANOTHER CHARACTER
+
+
+;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT
+JBLK:	CAILE CH,"M-40	;SKIP IF SYMS NOT NEEDED
+	JRA CH,LOAD	;F=0   C(CH)LT=0   C(F)=-1
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+	JUMPL CH,DDTG	;IF SYMS JUST READ
+	HRRM D,SADR	;SAVE STARTING ADDRESS
+;THE FOLLOWING CONDITIONAL ASSEMBLY ASSURES THAT THE
+;TRZA INSTRUCTION AT THRU+2 WILL CLEAR BIT 35.
+IFE .&1,[	JUMPN CH,BEG	;IF NOT LOADGO COMMAND
+SADR:	JRST BEG	;CURRENT S.A.
+]
+IFN .&1,[SADR:	JUMPE CH,BEG
+	JRST BEG
+]
+DDTG:	HRROS DDT-1	;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
+	JRST DDT	;AND GO TO DDT
+
+LOADS:			;HERE TO LOAD TAPE TO CORE, OR VERIFY
+	MOVEI D,LOZAD+1	;FIRST LOC NOT TO ZERO
+	SETZM 40	;A "FEATURE"
+	MOVE C,[XWD 40,41]	;PREPARE TO CLEAR CORE.
+	CAIN CH,"T-40	;IF "T", DONT CLOBBER DDT SYMS OR DDT
+	MOVE D,@DDT-1	;GET FIRST LOC OF DDT SYMS
+	TRNN CH,3	;SKIP ON M,N,I   NOT ON L,T,@
+	BLT C,-1(D)	;ZERO CORE
+LOAD:	JSP Q,LODUMP	;START READING FILE. LODUMP PROCESSES
+			;ONE HEADER AND ITS DATA
+	JSP P,UWAIT	;GET THE CHECKSUM OF THAT HEADER BLOCK
+	CAMN CKS,D	;CHECK CHECKSUM
+	JRST LOAD	;IF OK, GET NEXT BLOCK.(IF NONE, 
+			;LODUMP RETURNS TO JBLK.)
+DELE:	JUMPE C,BEG	;IF C IS ZERO, NO I/O WAS DONE.
+			;I.E., A "K" COMMAND
+	SKIPN E,WRITE	;SKIP IF NOT IN THE K PHASE OF A D COMMAND.
+			;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK
+	AOJA WRITE,CLSTP	; 0 TO 1. GO DUMP OUT DIRECTORY.
+ERR:	SKIPA P,NEXT	;SET TO RETURN TO BEGR
+CRR:	SKIPA A,CRCH	;LIKE HRROI A,215 AND SKIPA
+	SKIPA A,FD3	;GET A BELL CHARACTER
+TYO:	SKIPN COMPTR	;DONT TYO IF NO TYI, UNLESS ERR
+	DATAO TTY,A	;TYPE OUT
+	CONSZ TTY,20	;WAIT FOR TTY TO FINISH
+	JRST .-1	;NOT YET
+	CAIE A,215	;IF CR TYPED IN,
+	JUMPGE A,(P)	;OR SIGN BIT OF CHAR ON,(SEE CRR)
+	MOVEI A,12	;APPEND A LINEFEED
+	JRST TYO	;GO TYPE LF
+
+ALTTST:	TLNN B,4040	;IF ALPHA CHARACTERS, DONT GET CH
+	LDB CH,E	;LAST CH BEFORE ALT, -40
+	JUMPN CH,ALTMD	;IF CH NOT NULL, GOT PROCESS ALTMODE
+CARRET:	AOJE A,NEXT1	;IGNORE A ^_
+	MOVSI FILN,-30	;FILE NAME SPECIFIED. FIRST THING TO
+			;DO IS LOOK IT UP IN DIRECTORY
+LUP:	AOJ FILN,DMP3A	;RH COUNTS BY 2,LH BY 1. NOTE AOBJN
+	SKIPN TAB-1(FILN)	;SEARCH FOR FREE FILE
+	SKIPE BLKNO,TAB(FILN)	;CHECK BOTH WORDS
+	TDZA BLKNO,BLKNO	;ENSURE CLEAR BLOCK NMBER
+	HRRM FILN,FREE	;SAVE NUMBER OF A FREE FILE
+	CAMN C,TAB-1(FILN)	;SEARCH FOR TYPED-IN FILE
+	CAME B,TAB(FILN)	;BOTH WORDS
+	AOBJN FILN,LUP	;NOT THIS ONE. KEEP LOOKING
+	JUMPL FILN,BEG69	;IF FILE FOUND, JUMP
+	JUMPLE WRITE,ERR	;IF NOT FOUND, BETTER BE DUMP
+FREE:	MOVEI FILN,.	;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE
+			;(ADDRESS MODIFIED ABOVE)
+	SKIPE TAB(FILN)	;MAKE SURE HOLE AVAILABLE
+	JRST ERR	;NO FREE SLOTS
+
+BEG69:	SKIPN WRITE	;DELETE? (K COMMAND)
+	SETZB B,C	;YES, KILL FILE
+	MOVEM C,TAB-1(FILN)	;CLEAR IF DELE, ENTER IF NEW DUMP
+	MOVEM B,TAB(FILN)	;BOTH WORDS
+	MOVEI FILN,1(FILN)	;FILN IS (2*FILE #-1)+1, NOW +1 MORE
+	LSH FILN,-1	;FORM DIR NO 1 TO 27
+	JUMPLE WRITE,BEG69A	;JUMP IF NOT DUMP COMMAND
+	ANDCAM WRITE,TAB+55(FILN)	;CLEAR MODE BIT,(WRITE)=1
+	IORM WRITE,TAB+104(FILN)	;SET MODE BIT
+
+BEG69A:	TRNE WRITE,4	;SKIP IF MODIFY DIRECTORY (D,K,I)
+	SOJA F,LOADS	;ALL LOAD INSTRUCTIONS. F:=-1
+
+
+;DUMP WRITES OUT CORE ONTO TAPE
+
+;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE
+;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN
+;THE TAPE IS WRITTEN. THE DATA BLOCKS ARE EACH FOLLOWED BY A CHECKSUM.
+;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST
+;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.
+;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH
+;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF
+;CORE WAS FILLED UP TO THE BASE OF MACDMP.
+
+DUMP:			;HERE ON D,K,I. (BLKN)=0, FILN SET UP
+	MOVE A,[XWD LOW-HIGH,LOW]	;COUNTER TO EXAMINE 
+					;CORE FOR BLOCKS OF 0
+	MOVEI CKS,SPNT	;FIRST HEADER GOES INTO SPNT
+DMP1:	SKIPE (A)	;FIND SOME NON-ZERO CORE
+	JRST DMP1C
+	AOBJN A,DMP1	;ZERO. KEEP LOOKING.
+	TLNE A,-2
+	JRST DMP1
+DMP1C:	MOVEM A,D	;SAVE ADR
+DMP1B:	SKIPN (A)	;FIND SOME ZERO CORE
+	SKIPE 1(A)	;DON'T MAKE NEW BLOCK FOR 1 ZERO
+	CAIA
+	JRST DMP1A
+	AOBJN A,DMP1B	;NON-ZERO. KEEP LOOKING
+	TLNE A,-2
+	JRST DMP1B
+DMP1A:	SUB D,A	;GET -COUNT IN BOTH HALVES OF D
+	ADDI D,(A)	;GET F.A. IN RH OF D
+	MOVEM D,(CKS)	;SAVE HEADER
+	MOVE CKS,A	;F.A.+W.C.IS ADR OF NEXT HEADER
+			;I.E., FIRST 0 AFTER THE DATA
+	TLNE A,-1
+	JRST DMP1	;GET NEXT BLOCK IF MORE NON-ZERO CORE
+DMP2:	MOVE CKS,[JRST 1]	;OUTPUT A MAGIC WORD, SIMULATING
+				;THE END OF THE DDT LOADER
+	MOVEI D,SPNT	;SET UP TO FOLLOW THE HEADERS.
+DMP3A:	JSP P,UWAIT	;START WRITING . THE POINTER IS IN
+			;WORD FOLLOWING THE JSP.
+	JFCL CKS	;FIRST WORD TO LOOK LIKE END OF LOADER
+			;ON SUCCESSIVE LOOPS, THIS OUTPUTS THE CKSM
+DMP3:	MOVE D,(D)	;GET HEADER
+	JUMPGE D,THRU	;IF NULL HEADER FOUND
+	SKIPA Q,LUP	;Q:= DMP3A AS A RETURN AFTER AOBJN
+LODUMP:	CAMN D,[JRST 1]	;LOAD COMMANDS ENTER HERE, TOO
+	TLO BLKNO,400000	;JRST 1 DUMPED OR READ
+	JSP P,UWAIT
+	MOVE CKS,D	;IN/OUTPUT HEADER, ADD IT TO CKS
+	JUMPGE BLKNO,LODUMP	;WAIT FOR JRST 1 ON READS.
+	JUMPGE D,JBLK	;IF JRST BLOCK READ. CANT HAPPEN ON WRITE
+	JUMPGE CH,DMP5	;IF NOT LOADING SYMS
+	HLRO P,D
+	ADD P,D
+	ADDB P,@DDT-1	;COMPUTE LOAD ADR FOR SYMS AND UPDATE POINTER
+	HRR D,P
+DMP5:	ROT CKS,1	;TRANSFER A DATA BLOCK
+	JSP P,UWAIT
+	ADD CKS,(D)	;IN/OUTPUT DATA WORD, AND CKSM IT
+	AOBJN D,DMP5	;COUNT DOWN THE HEADER
+	TLNE D,-2
+	JRST DMP5
+	JRST (Q)	;END OF HEADER. TO DMP3A OR LOAD+1
+;WRITE:  1=D  0=K  -5=I  -1=ELSE
+
+THRU:	JUMPL WRITE,BEG
+	JSP P,UWAIT
+	TRZA WRITE,SADR	;OUTPUT JRST BLOCK, WRITE := 0 (WAS 1), THEN
+			;CLEAR ANY FURTHER BLOCKS WITH THE 
+			;CURRENT FILE NUMBER (IF REUSING AN OLD NAME)
+UWAIT:	AOJL E,UWAIT1	;RETURN ADDR = (P)      DATA ADDR = @(P)
+			;E IS -WD COUNT IN BLOCK OR POSITIVE
+			;BYTE POINTER FIRST TIME THRU
+MNLUP:	AOSA BLKNO	;NEXT BLOCK IN THE DIRECTORY
+MNLUP1:	DPB B,PNTR	;FOR DELETE, 0 FILE NAME AND NUMBER
+	ILDB A,PNTR	;SEARCH FILE DIR
+	CAIN A,37
+	JRST DELE	;END OF TAB MARKER, DELE GOES TO
+			;CLSTP ON A "D" TO DUMP DIRECTORY
+	TLO A,-1(WRITE)	;0 ON D, -1 ON K OR K PHASE OF D
+	CAIE FILN,(A)	;IS THIS BLOCK ASSIGNED TO CURRENT FILE?
+	JUMPN A,MNLUP	;OR MAYBE FREE? JUMP IF IN USE BY
+			;ANOTHER FILE.
+	DPB FILN,PNTR	;SMASH AWAY WRITE BLOCK ON D OR K. BUT
+			;SEE MNLUP1 ON K.
+	JUMPE WRITE,MNLUP1	;K COMMAND
+
+
+;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,
+;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS
+;DETERMINED BY CONTENTS OF WRITE.
+
+RBLK:	HRRO C,TAPENO	;CURRENT TAPE NO.
+			;SET LH TO  PREPARE FOR JUMPN IN DELE
+IFE MODE,[
+	TRO B,-1	;ENSURE GOING FORWARD WHEN FIRST SEARCH
+	CONSO DTC,300000	;IS A DIRECTION ASSERTED?
+	TRO C,200000	;NO. GO FORWARD
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRO C,300000	;TURN AROUND
+RBG:	CONO DTC,20200(C)	;ISSUE THE COMMAND TO TD10.
+				;200=SEARCH, 300=READ, 700=WRITE.
+UWAIT1:	CONSZ DTS,672700	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DTS,1	;DATA READY?
+	JRST .-3	;NO. GO WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DTC,B	;NO. SEARCHING. GET BLOCK NO.
+	TRZ C,300000	;CLOBBER DIRECTION BITS IN CONO
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	CONSZ DTC,100000	;COMPLEMENT DECISION IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR  TURNAROUND SPACE.
+]
+IFN MODE,[
+	SETOB A,B	;GO FORWARD, SET DC FOR SEARCH
+	CONSZ UTS,40	;IS CHECKSUM BEING WRITTEN?
+	JRST .-1	;WAIT
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRCA C,10000	;CHANGE DIRECTION AND DELAY
+	CONSO UTC,200000	;UNIT SELECTED?
+	TRO C,2000	;INVOKE STARTUP DELAY
+RBG:	CONO UTC,220200(C)	;COMMAND TO THE  551.
+				;200=SEARCH, 300=READ, 700=WRITE.
+	CONO DC,4011(A)	;COMMAND TO THE 136.
+UWAIT1:	CONSZ UTS,6	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DC,1000	;DATA READY?
+	JRST .-3	;NO. WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DC,B	;NO. SEARCHING. GET BLOCK NUMBER
+	TRZ C,2000	;DONT DELAY ANY MORE
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	TRNE C,10000	;COMPLEMENT IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR TURNAROUND SPACE.
+]
+	JUMPN B,RB1	;JUMP IF NOT GOING FORWARD INTO (BLKNO)
+	MOVNI E,200	;WORDS PER BLOCK
+	TRO C,100	;READ COMMAND, MAYBE
+	JUMPLE WRITE,RBG	;JUMP IF READ
+	TRO C,400	;CHANGE TO WRITE COMMAND
+IFN MODE,MOVNI A,401	;SET 136 TO OUTPUT
+	JRST RBG	;AND GO PROCESS BLOCK.
+
+IFE MODE,[
+	DATAI DTC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DTC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 TO INOUT +1 ARE DISPATCHED TO.
+	DATAO DTC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	AOJN E,UWAIT3	;WAS THAT THE LAST WORD IN THE DT BLOCK?
+	CONO DTS,1	;YES. GIVE FUNCTION STOP TO TD10
+	CONSO DTS,100000	;AND WAIT FOR CHECKSUM TO BE DONE
+	JRST .-1	;NOT YET. WAIT
+UWAIT3:	SOJA E,0(P)	;DONE. COMPENSATE FOR THE AOJN ABOVE, AND
+			;RETURN TO CALLER OF UWAIT OR RBLK
+]
+
+IFN MODE,[
+	DATAI DC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 THRU INOUT+1 ARE DISPATCHED TO.
+	DATAO DC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	JRST 0(P)	;RETURN TO CALLER OF UWAIT OR RBLK.
+]
+
+ALTMD:	MOVEI A,"$
+	JSP P,TYO	;ALTMODE IS PRINTED AS "$"
+	CAIE CH,"K-40	;FOR K, WRITE := 0
+	CAIN CH,"D-40	;FOR D, WRITE :=1
+	AOJLE WRITE,.-1	;COUNT (WRITE)
+	CAIN CH,"G-40	;GO TO PROGRAM?
+	JRST @SADR	;YES. JUMP OUT
+	CAIN CH,"F-40	;FILE DIR PRINT?
+	JRST FDIR	;YES. PRINT FILE DIR OF THIS TAPE
+	CAIN CH,"I-40	;CORE VS TAPE INTERROGATOR?
+	MOVNI WRITE,5	;WRITE :=-5 FOR "I"
+	CAILE CH,27	;SKIP IF OCTAL NUMBER
+	JRST TYI	;NO. GO PROCESS FILE NAME
+	LSH B,3	;CONVERT SIXBIT TO OCTAL
+	LSHC F,3	;F+1=B
+	JUMPN B,.-2	;MAY BE MORE THAN 1 DIGIT (START ADR)
+	CAILE F,7	;SKIP IF ONE DIGIT
+	JRA D,JBLK	;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.
+OPNTP:			;SHIFT UNIT NUMBER LEFT FOR CONO
+IFE MODE,	LSH F,11
+IFN MODE,LSH F,3
+	MOVEM F,TAPENO	;SAVE IN CORE
+IFE MODE,	CONO DTC,10000	;DESELECT OLD DRIVE
+CLSTP:	MOVEI BLKNO,100	;BLK NO OF FILE DIR
+	JSP P,RBLK	;MOVE TO BLOCK 100
+	JFCL TAB+200(E)	;READ OR WRITE DIR TAB AS DETERMINED BY WRITE
+	AOJL E,UWAIT1	;COUNT THE 200 WORDS
+	JRST BEG	;GO ASK FOR NEXT COMMAND
+
+FDIR:	MOVNI FILN,56	;2*27(OCTAL) FILES.
+FD2:	JSP P,CRR	;CR-LF
+FD3:	AOJ FILN,207		;USED FOR BELL TYPEOUT
+	SKIPN C,TAB+55(FILN)	;FIRST WORD OF NAME. IS IT BLANK?
+	AOJA C,FD1	;YES. SET C=1 AND LOOP
+	JSP G,SIXBP	;PRINT FIRST WORD OF FILE NAME
+	MOVE C,TAB+56(FILN)	;SECOND WORD OF FILE NAME
+	JSP G,SIXBP	;PRINT AND CEAR C
+FD1:	AOJL FILN,FD2(C)	;CAN JUMP TO FD2 OR FD3. COUNT FILES.
+	JRST BEG	;ALL FILES PRINTED OR BLANK. RETURN.
+
+SIXBP:	MOVNI B,7	;SIXBP PRINTS C(C) IN 6BIT
+			;AND APPENDS A SPACE
+			;LEAVES (C)=0
+SIXBP1:	MOVEI A,0
+	LSHC A,6
+	ADDI A,40	;SIXBIT TO ASCII
+	JSP P,TYO	;TYPE OUT CHARACTER
+	AOJL B,SIXBP1	;LOOP IF MORE CHARACTERS
+	JRST 0(G)	;RETURN
+
+SPNT:	0	;POINTER TO HEADERS IN CORE.
+
+	CONSTANTS
+
+	SLOP=COMPTR-17-.	;THIS MANY WORDS BEFORE RESERVED AREA
+				;FOR COMMAND STRINGS.
+
+INFORM ROOM AT TOP=,\<COMPTR-.>
+
+	END BEGR
+
+

src/mlsys/10dmp.12

@@ -0,0 +1,409 @@
+;TITLE MACDMP - MAC DECTAPE UTILITY - R CLEMENTS 8 OCT 67 - V001
+MODE==0
+
+	IFE MODE,TITLE MACDMP TD10 TAPE CONTROL VERSION
+	IFN MODE,TITLE MACDMP  551/136 TAPE CONTROL VERSION
+
+	NOSYMS
+	RIM10
+MEMSIZ==1000000	;MOOOBY
+
+	DTC=320
+	DTS=324
+
+F=0	;MUST BE 0. USED BY JRA'S
+A=2	;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT
+B=1	;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH
+C=3	;HOLDS BITS FOR DECTAPE CONO DURING I/O
+D=4	;HOLDS POINTERS FOR AOBJN'S THROUGH CORE
+E=5	;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK
+P=6	;PC FOR JSP'S
+CKS=7	;USUALLY CHECKSUM
+FILN=10	;NUMBER OF FILE IN DIRECTORY, 1 TO 27 OCTAL
+BLKNO=11	;BLOCK NUMBER SEARCHED FOR ON TAPE
+WRITE=12	;MULTI-STATE FLAG FOR DEFINING I/O OPERATION
+		;1=D 0=K -5=I -1=ELSE
+PNTR=13	;POINTER TO BYTE TABLE IN DIRECTORY
+CH=14	;HOLDS 6BIT CHARACTER OF COMMAND, OR -1
+Q=15	;ANOTHER JSP AC
+G=16	;RARELY USED VERY TEMP
+
+DDT=MEMSIZ-4000	;LOCATION OF HIGH DDT, MAC VERSION.
+COMPTR=MEMSIZ-1	;COMMAND POINTER, IF SUPPLIED
+
+DEFINE INFORM A,B
+IF2,[PRINTX \A!B
+\]
+TERMIN
+
+	LOC MEMSIZ-602
+	LOZAD=.-1	;WHEN CORE IS CLEARED, IT
+			;IS FROM 40 THRU LOZAD
+	LOW=20	;FIRST LOCATION CONSIDERED FOR DUMPING
+	HIGH=.-1	;LAST LOCATION CONSIDERED FOR DUMPING
+FOOF:	BLOCK 1	;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1
+TAB:	BLOCK 200	;FILE DIRECTORY
+TAPENO:	BLOCK 1	;TAPE UNIT SHIFTED LEFT FOR CONO
+;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS
+;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1
+
+BEGR:	SETZM COMPTR	;CLEAR ANY JUNK IN COMMAND POINTER
+	CONO 635550	;I/O RESET, ETC.
+BEG:	JSP P,CRR	;TYPE A CR-LF
+	MOVEI D,SPNT-1	;PREPARE TO REMOVE AOBJN POINTERS
+BEG1:	SETZB A,FOOF	;CLEAR A TO PUT IN CORE, CLEAR
+			;FOOF FOR  THE NEXT ZERO CORE SEARCH
+	EXCH A,1(D)	;REMOVE HEADER LIST
+	AOBJN A,.	;COUNT THROUGH TO NEXT HEADER
+	MOVEI D,-1(A)	;ACCOUNT FOR OVERSHOOT IN AOBJN
+	JUMPN D,BEG1	;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR
+	MOVE PNTR,[XWD 500,TAB+55]	;5 BIT BYTES IN DIRECTORY
+	SETZB CH,F
+CRCH:	SETOI WRITE,215	;USED FOR CARRET TYPEOUT
+TYI:	MOVSI B,400000	;INIT FILE NAME TO @ @
+SPACE:	EXCH C,B	;COPY FIRST WORD OF NAME TO C
+	MOVSI B,400000	;PREPARE FOR SECOND WORD
+	MOVSI E,20600	;FAKE OUT END-TEST OF BYTE POINTER
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+NEXT:	ILDB A,@BEGR	;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED
+			;RH OF NEXT IS USED AS A CONSTANT
+	JUMPN A,RCH	;JUMP IF COMMEND READ FROM CORE
+	MOVNI FILN,1	;INITIALIZATION FOR SEARCH
+	MOVEI BLKNO,0	; "
+	CONSO TTY,40	;TYPEIN FLAG?
+	JRST .-1	;NO,WAIT
+	DATAI TTY,A	;GET TYPED IN CHARACTER
+	JSP P,TYO	;ECHO IT (WITH PARITY)
+RCH:	ANDI A,177	;STRIP OFF PARITY
+	CAIN A,177	;RUBOUT?
+	JRST BEGR	;YES. RESTART MACDMP
+	CAIE A,33	;NEW ALTMODE?
+	CAIL A,175	;OR 175 OR 176 ALTMODES?
+	JRST ALTTST	;YES, SOME ALTMODE.
+	CAIL A,140	;LOWER CASE CHARACTER?
+	TRZ A,40	;YES. CHANGE TO UPPER CASE
+	SUBI A,40	;CONVERT TO SIXBIT
+	JUMPL A,CARRET	;ANY CONTROL CHARACTER
+	JUMPE A,SPACE	;CHAR WAS 40
+NEXT1:	TLNE E,770000	;NO MORE THAN SIX CHARS
+	IDPB A,E	;GOES INTO AC1 = B
+	JRST NEXT	;GET ANOTHER CHARACTER
+
+
+;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT
+JBLK:	CAILE CH,"M-40	;SKIP IF SYMS NOT NEEDED
+	JRA CH,LOAD	;F=0   C(CH)LT=0   C(F)=-1
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+	JUMPL CH,DDTG	;IF SYMS JUST READ
+	HRRM D,SADR	;SAVE STARTING ADDRESS
+;THE FOLLOWING CONDITIONAL ASSEMBLY ASSURES THAT THE
+;TRZA INSTRUCTION AT THRU+2 WILL CLEAR BIT 35.
+IFE .&1,[	JUMPN CH,BEG	;IF NOT LOADGO COMMAND
+SADR:	JRST BEG	;CURRENT S.A.
+]
+IFN .&1,[SADR:	JUMPE CH,BEG
+	JRST BEG
+]
+DDTG:	HRROS DDT-1	;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
+	JRST DDT	;AND GO TO DDT
+
+LOADS:			;HERE TO LOAD TAPE TO CORE, OR VERIFY
+	MOVEI D,LOZAD+1	;FIRST LOC NOT TO ZERO
+	SETZM 40	;A "FEATURE"
+	MOVE C,[XWD 40,41]	;PREPARE TO CLEAR CORE.
+	CAIN CH,"T-40	;IF "T", DONT CLOBBER DDT SYMS OR DDT
+	MOVE D,@DDT-1	;GET FIRST LOC OF DDT SYMS
+	TRNN CH,3	;SKIP ON M,N,I   NOT ON L,T,@
+	BLT C,-1(D)	;ZERO CORE
+LOAD:	JSP Q,LODUMP	;START READING FILE. LODUMP PROCESSES
+			;ONE HEADER AND ITS DATA
+	JSP P,UWAIT	;GET THE CHECKSUM OF THAT HEADER BLOCK
+	CAMN CKS,D	;CHECK CHECKSUM
+	JRST LOAD	;IF OK, GET NEXT BLOCK.(IF NONE, 
+			;LODUMP RETURNS TO JBLK.)
+DELE:	JUMPE C,BEG	;IF C IS ZERO, NO I/O WAS DONE.
+			;I.E., A "K" COMMAND
+	SKIPN E,WRITE	;SKIP IF NOT IN THE K PHASE OF A D COMMAND.
+			;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK
+	AOJA WRITE,CLSTP	; 0 TO 1. GO DUMP OUT DIRECTORY.
+ERR:	SKIPA P,NEXT	;SET TO RETURN TO BEGR
+CRR:	SKIPA A,CRCH	;LIKE HRROI A,215 AND SKIPA
+	SKIPA A,FD3	;GET A BELL CHARACTER
+TYO:	SKIPN COMPTR	;DONT TYO IF NO TYI, UNLESS ERR
+	DATAO TTY,A	;TYPE OUT
+	CONSZ TTY,20	;WAIT FOR TTY TO FINISH
+	JRST .-1	;NOT YET
+	CAIE A,215	;IF CR TYPED IN,
+	JUMPGE A,(P)	;OR SIGN BIT OF CHAR ON,(SEE CRR)
+	MOVEI A,12	;APPEND A LINEFEED
+	JRST TYO	;GO TYPE LF
+
+ALTTST:	TLNN B,4040	;IF ALPHA CHARACTERS, DONT GET CH
+	LDB CH,E	;LAST CH BEFORE ALT, -40
+	JUMPN CH,ALTMD	;IF CH NOT NULL, GOT PROCESS ALTMODE
+CARRET:	AOJE A,NEXT1	;IGNORE A ^_
+	MOVSI FILN,-30	;FILE NAME SPECIFIED. FIRST THING TO
+			;DO IS LOOK IT UP IN DIRECTORY
+LUP:	AOJ FILN,DMP3A	;RH COUNTS BY 2,LH BY 1. NOTE AOBJN
+	SKIPN TAB-1(FILN)	;SEARCH FOR FREE FILE
+	SKIPE BLKNO,TAB(FILN)	;CHECK BOTH WORDS
+	TDZA BLKNO,BLKNO	;ENSURE CLEAR BLOCK NMBER
+	HRRM FILN,FREE	;SAVE NUMBER OF A FREE FILE
+	CAMN C,TAB-1(FILN)	;SEARCH FOR TYPED-IN FILE
+	CAME B,TAB(FILN)	;BOTH WORDS
+	AOBJN FILN,LUP	;NOT THIS ONE. KEEP LOOKING
+	JUMPL FILN,BEG69	;IF FILE FOUND, JUMP
+	JUMPLE WRITE,ERR	;IF NOT FOUND, BETTER BE DUMP
+FREE:	MOVEI FILN,.	;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE
+			;(ADDRESS MODIFIED ABOVE)
+	SKIPE TAB(FILN)	;MAKE SURE HOLE AVAILABLE
+	JRST ERR	;NO FREE SLOTS
+
+BEG69:	SKIPN WRITE	;DELETE? (K COMMAND)
+	SETZB B,C	;YES, KILL FILE
+	MOVEM C,TAB-1(FILN)	;CLEAR IF DELE, ENTER IF NEW DUMP
+	MOVEM B,TAB(FILN)	;BOTH WORDS
+	MOVEI FILN,1(FILN)	;FILN IS (2*FILE #-1)+1, NOW +1 MORE
+	LSH FILN,-1	;FORM DIR NO 1 TO 27
+	JUMPLE WRITE,BEG69A	;JUMP IF NOT DUMP COMMAND
+	ANDCAM WRITE,TAB+55(FILN)	;CLEAR MODE BIT,(WRITE)=1
+	IORM WRITE,TAB+104(FILN)	;SET MODE BIT
+
+BEG69A:	TRNE WRITE,4	;SKIP IF MODIFY DIRECTORY (D,K,I)
+	SOJA F,LOADS	;ALL LOAD INSTRUCTIONS. F:=-1
+
+
+;DUMP WRITES OUT CORE ONTO TAPE
+
+;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE
+;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN
+;THE TAPE IS WRITTEN. THE DATA BLOCKS ARE EACH FOLLOWED BY A CHECKSUM.
+;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST
+;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.
+;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH
+;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF
+;CORE WAS FILLED UP TO THE BASE OF MACDMP.
+
+DUMP:			;HERE ON D,K,I. (BLKN)=0, FILN SET UP
+	MOVE A,[XWD LOW-HIGH,LOW]	;COUNTER TO EXAMINE 
+					;CORE FOR BLOCKS OF 0
+	MOVEI CKS,SPNT	;FIRST HEADER GOES INTO SPNT
+DMP1:	SKIPE (A)	;FIND SOME NON-ZERO CORE
+	JRST DMP1C
+	AOBJN A,DMP1	;ZERO. KEEP LOOKING.
+	TLNE A,-2
+	JRST DMP1
+DMP1C:	MOVEM A,D	;SAVE ADR
+DMP1B:	SKIPN (A)	;FIND SOME ZERO CORE
+	SKIPE 1(A)	;DON'T MAKE NEW BLOCK FOR 1 ZERO
+	CAIA
+	JRST DMP1A
+	AOBJN A,DMP1B	;NON-ZERO. KEEP LOOKING
+DMP1A:	SUB D,A	;GET -COUNT IN BOTH HALVES OF D
+	ADDI D,(A)	;GET F.A. IN RH OF D
+	MOVEM D,(CKS)	;SAVE HEADER
+	MOVE CKS,A	;F.A.+W.C.IS ADR OF NEXT HEADER
+			;I.E., FIRST 0 AFTER THE DATA
+	TLNE A,-1
+	JRST DMP1	;GET NEXT BLOCK IF MORE NON-ZERO CORE
+DMP2:	MOVE CKS,[JRST 1]	;OUTPUT A MAGIC WORD, SIMULATING
+				;THE END OF THE DDT LOADER
+	MOVEI D,SPNT	;SET UP TO FOLLOW THE HEADERS.
+DMP3A:	JSP P,UWAIT	;START WRITING . THE POINTER IS IN
+			;WORD FOLLOWING THE JSP.
+	JFCL CKS	;FIRST WORD TO LOOK LIKE END OF LOADER
+			;ON SUCCESSIVE LOOPS, THIS OUTPUTS THE CKSM
+DMP3:	MOVE D,(D)	;GET HEADER
+	JUMPGE D,THRU	;IF NULL HEADER FOUND
+	SKIPA Q,LUP	;Q:= DMP3A AS A RETURN AFTER AOBJN
+LODUMP:	CAMN D,[JRST 1]	;LOAD COMMANDS ENTER HERE, TOO
+	TLO BLKNO,400000	;JRST 1 DUMPED OR READ
+	JSP P,UWAIT
+	MOVE CKS,D	;IN/OUTPUT HEADER, ADD IT TO CKS
+	JUMPGE BLKNO,LODUMP	;WAIT FOR JRST 1 ON READS.
+	JUMPGE D,JBLK	;IF JRST BLOCK READ. CANT HAPPEN ON WRITE
+	JUMPGE CH,DMP5	;IF NOT LOADING SYMS
+	HLRO P,D
+	ADD P,D
+	ADDB P,@DDT-1	;COMPUTE LOAD ADR FOR SYMS AND UPDATE POINTER
+	HRR D,P
+DMP5:	ROT CKS,1	;TRANSFER A DATA BLOCK
+	JSP P,UWAIT
+	ADD CKS,(D)	;IN/OUTPUT DATA WORD, AND CKSM IT
+	AOBJN D,DMP5	;COUNT DOWN THE HEADER
+	TLNE D,-2
+	JRST DMP5
+	JRST (Q)	;END OF HEADER. TO DMP3A OR LOAD+1
+;WRITE:  1=D  0=K  -5=I  -1=ELSE
+
+THRU:	JUMPL WRITE,BEG
+	JSP P,UWAIT
+	TRZA WRITE,SADR	;OUTPUT JRST BLOCK, WRITE := 0 (WAS 1), THEN
+			;CLEAR ANY FURTHER BLOCKS WITH THE 
+			;CURRENT FILE NUMBER (IF REUSING AN OLD NAME)
+UWAIT:	AOJL E,UWAIT1	;RETURN ADDR = (P)      DATA ADDR = @(P)
+			;E IS -WD COUNT IN BLOCK OR POSITIVE
+			;BYTE POINTER FIRST TIME THRU
+MNLUP:	AOSA BLKNO	;NEXT BLOCK IN THE DIRECTORY
+MNLUP1:	DPB B,PNTR	;FOR DELETE, 0 FILE NAME AND NUMBER
+	ILDB A,PNTR	;SEARCH FILE DIR
+	CAIN A,37
+	JRST DELE	;END OF TAB MARKER, DELE GOES TO
+			;CLSTP ON A "D" TO DUMP DIRECTORY
+	TLO A,-1(WRITE)	;0 ON D, -1 ON K OR K PHASE OF D
+	CAIE FILN,(A)	;IS THIS BLOCK ASSIGNED TO CURRENT FILE?
+	JUMPN A,MNLUP	;OR MAYBE FREE? JUMP IF IN USE BY
+			;ANOTHER FILE.
+	DPB FILN,PNTR	;SMASH AWAY WRITE BLOCK ON D OR K. BUT
+			;SEE MNLUP1 ON K.
+	JUMPE WRITE,MNLUP1	;K COMMAND
+
+
+;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,
+;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS
+;DETERMINED BY CONTENTS OF WRITE.
+
+RBLK:	HRRO C,TAPENO	;CURRENT TAPE NO.
+			;SET LH TO  PREPARE FOR JUMPN IN DELE
+IFE MODE,[
+	TRO B,-1	;ENSURE GOING FORWARD WHEN FIRST SEARCH
+	CONSO DTC,300000	;IS A DIRECTION ASSERTED?
+	TRO C,200000	;NO. GO FORWARD
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRO C,300000	;TURN AROUND
+RBG:	CONO DTC,20200(C)	;ISSUE THE COMMAND TO TD10.
+				;200=SEARCH, 300=READ, 700=WRITE.
+UWAIT1:	CONSZ DTS,672700	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DTS,1	;DATA READY?
+	JRST .-3	;NO. GO WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DTC,B	;NO. SEARCHING. GET BLOCK NO.
+	TRZ C,300000	;CLOBBER DIRECTION BITS IN CONO
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	CONSZ DTC,100000	;COMPLEMENT DECISION IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR  TURNAROUND SPACE.
+]
+IFN MODE,[
+	SETOB A,B	;GO FORWARD, SET DC FOR SEARCH
+	CONSZ UTS,40	;IS CHECKSUM BEING WRITTEN?
+	JRST .-1	;WAIT
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRCA C,10000	;CHANGE DIRECTION AND DELAY
+	CONSO UTC,200000	;UNIT SELECTED?
+	TRO C,2000	;INVOKE STARTUP DELAY
+RBG:	CONO UTC,220200(C)	;COMMAND TO THE  551.
+				;200=SEARCH, 300=READ, 700=WRITE.
+	CONO DC,4011(A)	;COMMAND TO THE 136.
+UWAIT1:	CONSZ UTS,6	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DC,1000	;DATA READY?
+	JRST .-3	;NO. WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DC,B	;NO. SEARCHING. GET BLOCK NUMBER
+	TRZ C,2000	;DONT DELAY ANY MORE
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	TRNE C,10000	;COMPLEMENT IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR TURNAROUND SPACE.
+]
+	JUMPN B,RB1	;JUMP IF NOT GOING FORWARD INTO (BLKNO)
+	MOVNI E,200	;WORDS PER BLOCK
+	TRO C,100	;READ COMMAND, MAYBE
+	JUMPLE WRITE,RBG	;JUMP IF READ
+	TRO C,400	;CHANGE TO WRITE COMMAND
+IFN MODE,MOVNI A,401	;SET 136 TO OUTPUT
+	JRST RBG	;AND GO PROCESS BLOCK.
+
+IFE MODE,[
+	DATAI DTC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DTC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 TO INOUT +1 ARE DISPATCHED TO.
+	DATAO DTC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	AOJN E,UWAIT3	;WAS THAT THE LAST WORD IN THE DT BLOCK?
+	CONO DTS,1	;YES. GIVE FUNCTION STOP TO TD10
+	CONSO DTS,100000	;AND WAIT FOR CHECKSUM TO BE DONE
+	JRST .-1	;NOT YET. WAIT
+UWAIT3:	SOJA E,0(P)	;DONE. COMPENSATE FOR THE AOJN ABOVE, AND
+			;RETURN TO CALLER OF UWAIT OR RBLK
+]
+
+IFN MODE,[
+	DATAI DC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 THRU INOUT+1 ARE DISPATCHED TO.
+	DATAO DC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	JRST 0(P)	;RETURN TO CALLER OF UWAIT OR RBLK.
+]
+
+ALTMD:	MOVEI A,"$
+	JSP P,TYO	;ALTMODE IS PRINTED AS "$"
+	CAIE CH,"K-40	;FOR K, WRITE := 0
+	CAIN CH,"D-40	;FOR D, WRITE :=1
+	AOJLE WRITE,.-1	;COUNT (WRITE)
+	CAIN CH,"G-40	;GO TO PROGRAM?
+	JRST @SADR	;YES. JUMP OUT
+	CAIN CH,"F-40	;FILE DIR PRINT?
+	JRST FDIR	;YES. PRINT FILE DIR OF THIS TAPE
+	CAIN CH,"I-40	;CORE VS TAPE INTERROGATOR?
+	MOVNI WRITE,5	;WRITE :=-5 FOR "I"
+	CAILE CH,27	;SKIP IF OCTAL NUMBER
+	JRST TYI	;NO. GO PROCESS FILE NAME
+	LSH B,3	;CONVERT SIXBIT TO OCTAL
+	LSHC F,3	;F+1=B
+	JUMPN B,.-2	;MAY BE MORE THAN 1 DIGIT (START ADR)
+	CAILE F,7	;SKIP IF ONE DIGIT
+	JRA D,JBLK	;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.
+OPNTP:			;SHIFT UNIT NUMBER LEFT FOR CONO
+IFE MODE,	LSH F,11
+IFN MODE,LSH F,3
+	MOVEM F,TAPENO	;SAVE IN CORE
+IFE MODE,	CONO DTC,10000	;DESELECT OLD DRIVE
+CLSTP:	MOVEI BLKNO,100	;BLK NO OF FILE DIR
+	JSP P,RBLK	;MOVE TO BLOCK 100
+	JFCL TAB+200(E)	;READ OR WRITE DIR TAB AS DETERMINED BY WRITE
+	AOJL E,UWAIT1	;COUNT THE 200 WORDS
+	JRST BEG	;GO ASK FOR NEXT COMMAND
+
+FDIR:	MOVNI FILN,56	;2*27(OCTAL) FILES.
+FD2:	JSP P,CRR	;CR-LF
+FD3:	AOJ FILN,207		;USED FOR BELL TYPEOUT
+	SKIPN C,TAB+55(FILN)	;FIRST WORD OF NAME. IS IT BLANK?
+	AOJA C,FD1	;YES. SET C=1 AND LOOP
+	JSP G,SIXBP	;PRINT FIRST WORD OF FILE NAME
+	MOVE C,TAB+56(FILN)	;SECOND WORD OF FILE NAME
+	JSP G,SIXBP	;PRINT AND CEAR C
+FD1:	AOJL FILN,FD2(C)	;CAN JUMP TO FD2 OR FD3. COUNT FILES.
+	JRST BEG	;ALL FILES PRINTED OR BLANK. RETURN.
+
+SIXBP:	MOVNI B,7	;SIXBP PRINTS C(C) IN 6BIT
+			;AND APPENDS A SPACE
+			;LEAVES (C)=0
+SIXBP1:	MOVEI A,0
+	LSHC A,6
+	ADDI A,40	;SIXBIT TO ASCII
+	JSP P,TYO	;TYPE OUT CHARACTER
+	AOJL B,SIXBP1	;LOOP IF MORE CHARACTERS
+	JRST 0(G)	;RETURN
+
+SPNT:	0	;POINTER TO HEADERS IN CORE.
+
+	CONSTANTS
+
+	SLOP=COMPTR-17-.	;THIS MANY WORDS BEFORE RESERVED AREA
+				;FOR COMMAND STRINGS.
+
+INFORM ROOM AT TOP=,\<COMPTR-.>
+
+	END BEGR
+
+

src/mlsys/10dmp.13

@@ -0,0 +1,413 @@
+;TITLE MACDMP - MAC DECTAPE UTILITY - R CLEMENTS 8 OCT 67 - V001
+MODE==0
+
+	IFE MODE,TITLE MACDMP TD10 TAPE CONTROL VERSION
+	IFN MODE,TITLE MACDMP  551/136 TAPE CONTROL VERSION
+
+	NOSYMS
+	RIM10
+MEMSIZ==1000000	;MOOOBY
+
+	DTC=320
+	DTS=324
+
+F=0	;MUST BE 0. USED BY JRA'S
+A=2	;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT
+B=1	;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH
+C=3	;HOLDS BITS FOR DECTAPE CONO DURING I/O
+D=4	;HOLDS POINTERS FOR AOBJN'S THROUGH CORE
+E=5	;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK
+P=6	;PC FOR JSP'S
+CKS=7	;USUALLY CHECKSUM
+FILN=10	;NUMBER OF FILE IN DIRECTORY, 1 TO 27 OCTAL
+BLKNO=11	;BLOCK NUMBER SEARCHED FOR ON TAPE
+WRITE=12	;MULTI-STATE FLAG FOR DEFINING I/O OPERATION
+		;1=D 0=K -5=I -1=ELSE
+PNTR=13	;POINTER TO BYTE TABLE IN DIRECTORY
+CH=14	;HOLDS 6BIT CHARACTER OF COMMAND, OR -1
+Q=15	;ANOTHER JSP AC
+G=16	;RARELY USED VERY TEMP
+
+DDT=MEMSIZ-4000	;LOCATION OF HIGH DDT, MAC VERSION.
+COMPTR=MEMSIZ-1	;COMMAND POINTER, IF SUPPLIED
+
+DEFINE INFORM A,B
+IF2,[PRINTX \A!B
+\]
+TERMIN
+
+	LOC MEMSIZ-602
+	LOZAD=.-1	;WHEN CORE IS CLEARED, IT
+			;IS FROM 40 THRU LOZAD
+	LOW=20	;FIRST LOCATION CONSIDERED FOR DUMPING
+	HIGH=.-1	;LAST LOCATION CONSIDERED FOR DUMPING
+FOOF:	BLOCK 1	;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1
+TAB:	BLOCK 200	;FILE DIRECTORY
+TAPENO:	BLOCK 1	;TAPE UNIT SHIFTED LEFT FOR CONO
+;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS
+;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1
+
+BEGR:	SETZM COMPTR	;CLEAR ANY JUNK IN COMMAND POINTER
+	CONO 635550	;I/O RESET, ETC.
+BEG:	JSP P,CRR	;TYPE A CR-LF
+	MOVEI D,SPNT-1	;PREPARE TO REMOVE AOBJN POINTERS
+BEG1:	SETZB A,FOOF	;CLEAR A TO PUT IN CORE, CLEAR
+			;FOOF FOR  THE NEXT ZERO CORE SEARCH
+	EXCH A,1(D)	;REMOVE HEADER LIST
+	AOBJN A,.	;COUNT THROUGH TO NEXT HEADER
+	TLNE A,-2
+	JRST .-2
+	MOVEI D,-1(A)	;ACCOUNT FOR OVERSHOOT IN AOBJN
+	JUMPN D,BEG1	;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR
+	MOVE PNTR,[XWD 500,TAB+55]	;5 BIT BYTES IN DIRECTORY
+	SETZB CH,F
+CRCH:	SETOI WRITE,215	;USED FOR CARRET TYPEOUT
+TYI:	MOVSI B,400000	;INIT FILE NAME TO @ @
+SPACE:	EXCH C,B	;COPY FIRST WORD OF NAME TO C
+	MOVSI B,400000	;PREPARE FOR SECOND WORD
+	MOVSI E,20600	;FAKE OUT END-TEST OF BYTE POINTER
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+NEXT:	ILDB A,@BEGR	;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED
+			;RH OF NEXT IS USED AS A CONSTANT
+	JUMPN A,RCH	;JUMP IF COMMEND READ FROM CORE
+	MOVNI FILN,1	;INITIALIZATION FOR SEARCH
+	MOVEI BLKNO,0	; "
+	CONSO TTY,40	;TYPEIN FLAG?
+	JRST .-1	;NO,WAIT
+	DATAI TTY,A	;GET TYPED IN CHARACTER
+	JSP P,TYO	;ECHO IT (WITH PARITY)
+RCH:	ANDI A,177	;STRIP OFF PARITY
+	CAIN A,177	;RUBOUT?
+	JRST BEGR	;YES. RESTART MACDMP
+	CAIE A,33	;NEW ALTMODE?
+	CAIL A,175	;OR 175 OR 176 ALTMODES?
+	JRST ALTTST	;YES, SOME ALTMODE.
+	CAIL A,140	;LOWER CASE CHARACTER?
+	TRZ A,40	;YES. CHANGE TO UPPER CASE
+	SUBI A,40	;CONVERT TO SIXBIT
+	JUMPL A,CARRET	;ANY CONTROL CHARACTER
+	JUMPE A,SPACE	;CHAR WAS 40
+NEXT1:	TLNE E,770000	;NO MORE THAN SIX CHARS
+	IDPB A,E	;GOES INTO AC1 = B
+	JRST NEXT	;GET ANOTHER CHARACTER
+
+
+;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT
+JBLK:	CAILE CH,"M-40	;SKIP IF SYMS NOT NEEDED
+	JRA CH,LOAD	;F=0   C(CH)LT=0   C(F)=-1
+;STOP TAPE DRIVE
+IFN MODE,CONO UTC,0
+IFE MODE,CONO DTC,400000
+	JUMPL CH,DDTG	;IF SYMS JUST READ
+	HRRM D,SADR	;SAVE STARTING ADDRESS
+;THE FOLLOWING CONDITIONAL ASSEMBLY ASSURES THAT THE
+;TRZA INSTRUCTION AT THRU+2 WILL CLEAR BIT 35.
+IFE .&1,[	JUMPN CH,BEG	;IF NOT LOADGO COMMAND
+SADR:	JRST BEG	;CURRENT S.A.
+]
+IFN .&1,[SADR:	JUMPE CH,BEG
+	JRST BEG
+]
+DDTG:	HRROS DDT-1	;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
+	JRST DDT	;AND GO TO DDT
+
+LOADS:			;HERE TO LOAD TAPE TO CORE, OR VERIFY
+	MOVEI D,LOZAD+1	;FIRST LOC NOT TO ZERO
+	SETZM 40	;A "FEATURE"
+	MOVE C,[XWD 40,41]	;PREPARE TO CLEAR CORE.
+	CAIN CH,"T-40	;IF "T", DONT CLOBBER DDT SYMS OR DDT
+	MOVE D,@DDT-1	;GET FIRST LOC OF DDT SYMS
+	TRNN CH,3	;SKIP ON M,N,I   NOT ON L,T,@
+	BLT C,-1(D)	;ZERO CORE
+LOAD:	JSP Q,LODUMP	;START READING FILE. LODUMP PROCESSES
+			;ONE HEADER AND ITS DATA
+	JSP P,UWAIT	;GET THE CHECKSUM OF THAT HEADER BLOCK
+	CAMN CKS,D	;CHECK CHECKSUM
+	JRST LOAD	;IF OK, GET NEXT BLOCK.(IF NONE, 
+			;LODUMP RETURNS TO JBLK.)
+DELE:	JUMPE C,BEG	;IF C IS ZERO, NO I/O WAS DONE.
+			;I.E., A "K" COMMAND
+	SKIPN E,WRITE	;SKIP IF NOT IN THE K PHASE OF A D COMMAND.
+			;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK
+	AOJA WRITE,CLSTP	; 0 TO 1. GO DUMP OUT DIRECTORY.
+ERR:	SKIPA P,NEXT	;SET TO RETURN TO BEGR
+CRR:	SKIPA A,CRCH	;LIKE HRROI A,215 AND SKIPA
+	SKIPA A,FD3	;GET A BELL CHARACTER
+TYO:	SKIPN COMPTR	;DONT TYO IF NO TYI, UNLESS ERR
+	DATAO TTY,A	;TYPE OUT
+	CONSZ TTY,20	;WAIT FOR TTY TO FINISH
+	JRST .-1	;NOT YET
+	CAIE A,215	;IF CR TYPED IN,
+	JUMPGE A,(P)	;OR SIGN BIT OF CHAR ON,(SEE CRR)
+	MOVEI A,12	;APPEND A LINEFEED
+	JRST TYO	;GO TYPE LF
+
+ALTTST:	TLNN B,4040	;IF ALPHA CHARACTERS, DONT GET CH
+	LDB CH,E	;LAST CH BEFORE ALT, -40
+	JUMPN CH,ALTMD	;IF CH NOT NULL, GOT PROCESS ALTMODE
+CARRET:	AOJE A,NEXT1	;IGNORE A ^_
+	MOVSI FILN,-30	;FILE NAME SPECIFIED. FIRST THING TO
+			;DO IS LOOK IT UP IN DIRECTORY
+LUP:	AOJ FILN,DMP3A	;RH COUNTS BY 2,LH BY 1. NOTE AOBJN
+	SKIPN TAB-1(FILN)	;SEARCH FOR FREE FILE
+	SKIPE BLKNO,TAB(FILN)	;CHECK BOTH WORDS
+	TDZA BLKNO,BLKNO	;ENSURE CLEAR BLOCK NMBER
+	HRRM FILN,FREE	;SAVE NUMBER OF A FREE FILE
+	CAMN C,TAB-1(FILN)	;SEARCH FOR TYPED-IN FILE
+	CAME B,TAB(FILN)	;BOTH WORDS
+	AOBJN FILN,LUP	;NOT THIS ONE. KEEP LOOKING
+	JUMPL FILN,BEG69	;IF FILE FOUND, JUMP
+	JUMPLE WRITE,ERR	;IF NOT FOUND, BETTER BE DUMP
+FREE:	MOVEI FILN,.	;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE
+			;(ADDRESS MODIFIED ABOVE)
+	SKIPE TAB(FILN)	;MAKE SURE HOLE AVAILABLE
+	JRST ERR	;NO FREE SLOTS
+
+BEG69:	SKIPN WRITE	;DELETE? (K COMMAND)
+	SETZB B,C	;YES, KILL FILE
+	MOVEM C,TAB-1(FILN)	;CLEAR IF DELE, ENTER IF NEW DUMP
+	MOVEM B,TAB(FILN)	;BOTH WORDS
+	MOVEI FILN,1(FILN)	;FILN IS (2*FILE #-1)+1, NOW +1 MORE
+	LSH FILN,-1	;FORM DIR NO 1 TO 27
+	JUMPLE WRITE,BEG69A	;JUMP IF NOT DUMP COMMAND
+	ANDCAM WRITE,TAB+55(FILN)	;CLEAR MODE BIT,(WRITE)=1
+	IORM WRITE,TAB+104(FILN)	;SET MODE BIT
+
+BEG69A:	TRNE WRITE,4	;SKIP IF MODIFY DIRECTORY (D,K,I)
+	SOJA F,LOADS	;ALL LOAD INSTRUCTIONS. F:=-1
+
+
+;DUMP WRITES OUT CORE ONTO TAPE
+
+;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE
+;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN
+;THE TAPE IS WRITTEN. THE DATA BLOCKS ARE EACH FOLLOWED BY A CHECKSUM.
+;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST
+;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.
+;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH
+;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF
+;CORE WAS FILLED UP TO THE BASE OF MACDMP.
+
+DUMP:			;HERE ON D,K,I. (BLKN)=0, FILN SET UP
+	MOVE A,[XWD LOW-HIGH,LOW]	;COUNTER TO EXAMINE 
+					;CORE FOR BLOCKS OF 0
+	MOVEI CKS,SPNT	;FIRST HEADER GOES INTO SPNT
+DMP1:	SKIPE (A)	;FIND SOME NON-ZERO CORE
+	JRST DMP1C
+	AOBJN A,DMP1	;ZERO. KEEP LOOKING.
+	TLNE A,-2
+	JRST DMP1
+DMP1C:	MOVEM A,D	;SAVE ADR
+DMP1B:	SKIPN (A)	;FIND SOME ZERO CORE
+	SKIPE 1(A)	;DON'T MAKE NEW BLOCK FOR 1 ZERO
+	CAIA
+	JRST DMP1A
+	AOBJN A,DMP1B	;NON-ZERO. KEEP LOOKING
+	TLNE A,-2
+	JRST DMP1B
+DMP1A:	SUB D,A	;GET -COUNT IN BOTH HALVES OF D
+	ADDI D,(A)	;GET F.A. IN RH OF D
+	MOVEM D,(CKS)	;SAVE HEADER
+	MOVE CKS,A	;F.A.+W.C.IS ADR OF NEXT HEADER
+			;I.E., FIRST 0 AFTER THE DATA
+	TLNE A,-1
+	JRST DMP1	;GET NEXT BLOCK IF MORE NON-ZERO CORE
+DMP2:	MOVE CKS,[JRST 1]	;OUTPUT A MAGIC WORD, SIMULATING
+				;THE END OF THE DDT LOADER
+	MOVEI D,SPNT	;SET UP TO FOLLOW THE HEADERS.
+DMP3A:	JSP P,UWAIT	;START WRITING . THE POINTER IS IN
+			;WORD FOLLOWING THE JSP.
+	JFCL CKS	;FIRST WORD TO LOOK LIKE END OF LOADER
+			;ON SUCCESSIVE LOOPS, THIS OUTPUTS THE CKSM
+DMP3:	MOVE D,(D)	;GET HEADER
+	JUMPGE D,THRU	;IF NULL HEADER FOUND
+	SKIPA Q,LUP	;Q:= DMP3A AS A RETURN AFTER AOBJN
+LODUMP:	CAMN D,[JRST 1]	;LOAD COMMANDS ENTER HERE, TOO
+	TLO BLKNO,400000	;JRST 1 DUMPED OR READ
+	JSP P,UWAIT
+	MOVE CKS,D	;IN/OUTPUT HEADER, ADD IT TO CKS
+	JUMPGE BLKNO,LODUMP	;WAIT FOR JRST 1 ON READS.
+	JUMPGE D,JBLK	;IF JRST BLOCK READ. CANT HAPPEN ON WRITE
+	JUMPGE CH,DMP5	;IF NOT LOADING SYMS
+	HLRO P,D
+	ADD P,D
+	ADDB P,@DDT-1	;COMPUTE LOAD ADR FOR SYMS AND UPDATE POINTER
+	HRR D,P
+DMP5:	ROT CKS,1	;TRANSFER A DATA BLOCK
+	JSP P,UWAIT
+	ADD CKS,(D)	;IN/OUTPUT DATA WORD, AND CKSM IT
+	AOBJN D,DMP5	;COUNT DOWN THE HEADER
+	TLNE D,-2
+	JRST DMP5
+	JRST (Q)	;END OF HEADER. TO DMP3A OR LOAD+1
+;WRITE:  1=D  0=K  -5=I  -1=ELSE
+
+THRU:	JUMPL WRITE,BEG
+	JSP P,UWAIT
+	TRZA WRITE,SADR	;OUTPUT JRST BLOCK, WRITE := 0 (WAS 1), THEN
+			;CLEAR ANY FURTHER BLOCKS WITH THE 
+			;CURRENT FILE NUMBER (IF REUSING AN OLD NAME)
+UWAIT:	AOJL E,UWAIT1	;RETURN ADDR = (P)      DATA ADDR = @(P)
+			;E IS -WD COUNT IN BLOCK OR POSITIVE
+			;BYTE POINTER FIRST TIME THRU
+MNLUP:	AOSA BLKNO	;NEXT BLOCK IN THE DIRECTORY
+MNLUP1:	DPB B,PNTR	;FOR DELETE, 0 FILE NAME AND NUMBER
+	ILDB A,PNTR	;SEARCH FILE DIR
+	CAIN A,37
+	JRST DELE	;END OF TAB MARKER, DELE GOES TO
+			;CLSTP ON A "D" TO DUMP DIRECTORY
+	TLO A,-1(WRITE)	;0 ON D, -1 ON K OR K PHASE OF D
+	CAIE FILN,(A)	;IS THIS BLOCK ASSIGNED TO CURRENT FILE?
+	JUMPN A,MNLUP	;OR MAYBE FREE? JUMP IF IN USE BY
+			;ANOTHER FILE.
+	DPB FILN,PNTR	;SMASH AWAY WRITE BLOCK ON D OR K. BUT
+			;SEE MNLUP1 ON K.
+	JUMPE WRITE,MNLUP1	;K COMMAND
+
+
+;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,
+;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS
+;DETERMINED BY CONTENTS OF WRITE.
+
+RBLK:	HRRO C,TAPENO	;CURRENT TAPE NO.
+			;SET LH TO  PREPARE FOR JUMPN IN DELE
+IFE MODE,[
+	TRO B,-1	;ENSURE GOING FORWARD WHEN FIRST SEARCH
+	CONSO DTC,300000	;IS A DIRECTION ASSERTED?
+	TRO C,200000	;NO. GO FORWARD
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRO C,300000	;TURN AROUND
+RBG:	CONO DTC,20200(C)	;ISSUE THE COMMAND TO TD10.
+				;200=SEARCH, 300=READ, 700=WRITE.
+UWAIT1:	CONSZ DTS,672700	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DTS,1	;DATA READY?
+	JRST .-3	;NO. GO WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DTC,B	;NO. SEARCHING. GET BLOCK NO.
+	TRZ C,300000	;CLOBBER DIRECTION BITS IN CONO
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	CONSZ DTC,100000	;COMPLEMENT DECISION IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR  TURNAROUND SPACE.
+]
+IFN MODE,[
+	SETOB A,B	;GO FORWARD, SET DC FOR SEARCH
+	CONSZ UTS,40	;IS CHECKSUM BEING WRITTEN?
+	JRST .-1	;WAIT
+RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
+	TRCA C,10000	;CHANGE DIRECTION AND DELAY
+	CONSO UTC,200000	;UNIT SELECTED?
+	TRO C,2000	;INVOKE STARTUP DELAY
+RBG:	CONO UTC,220200(C)	;COMMAND TO THE  551.
+				;200=SEARCH, 300=READ, 700=WRITE.
+	CONO DC,4011(A)	;COMMAND TO THE 136.
+UWAIT1:	CONSZ UTS,6	;ANY ERRORS?
+	JRST ERR	;YES. GO DING AND THEN TYI
+	CONSO DC,1000	;DATA READY?
+	JRST .-3	;NO. WAIT SOME MORE
+	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
+	DATAI DC,B	;NO. SEARCHING. GET BLOCK NUMBER
+	TRZ C,2000	;DONT DELAY ANY MORE
+	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
+	TRNE C,10000	;COMPLEMENT IF GOING REVERSE
+	TRC B,-2	;BIT 35 IS FOR TURNAROUND SPACE.
+]
+	JUMPN B,RB1	;JUMP IF NOT GOING FORWARD INTO (BLKNO)
+	MOVNI E,200	;WORDS PER BLOCK
+	TRO C,100	;READ COMMAND, MAYBE
+	JUMPLE WRITE,RBG	;JUMP IF READ
+	TRO C,400	;CHANGE TO WRITE COMMAND
+IFN MODE,MOVNI A,401	;SET 136 TO OUTPUT
+	JRST RBG	;AND GO PROCESS BLOCK.
+
+IFE MODE,[
+	DATAI DTC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DTC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 TO INOUT +1 ARE DISPATCHED TO.
+	DATAO DTC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	AOJN E,UWAIT3	;WAS THAT THE LAST WORD IN THE DT BLOCK?
+	CONO DTS,1	;YES. GIVE FUNCTION STOP TO TD10
+	CONSO DTS,100000	;AND WAIT FOR CHECKSUM TO BE DONE
+	JRST .-1	;NOT YET. WAIT
+UWAIT3:	SOJA E,0(P)	;DONE. COMPENSATE FOR THE AOJN ABOVE, AND
+			;RETURN TO CALLER OF UWAIT OR RBLK
+]
+
+IFN MODE,[
+	DATAI DC,G	;THIS SEQUENCE FOR VERIFY ("I")
+	CAME G,@(P)	;CHECK WITH CORE
+	JRST ERR	;BAD COMPARE
+	JRST UWAIT2	;OK
+	DATAI DC,@(P)	;READ COMMANDS. GET WORD TO CORE
+INOUT:	JRST UWAIT2	;INOUT-5 THRU INOUT+1 ARE DISPATCHED TO.
+	DATAO DC,@(P)	;OUTPUT TO TAPE
+UWAIT2:	JRST 0(P)	;RETURN TO CALLER OF UWAIT OR RBLK.
+]
+
+ALTMD:	MOVEI A,"$
+	JSP P,TYO	;ALTMODE IS PRINTED AS "$"
+	CAIE CH,"K-40	;FOR K, WRITE := 0
+	CAIN CH,"D-40	;FOR D, WRITE :=1
+	AOJLE WRITE,.-1	;COUNT (WRITE)
+	CAIN CH,"G-40	;GO TO PROGRAM?
+	JRST @SADR	;YES. JUMP OUT
+	CAIN CH,"F-40	;FILE DIR PRINT?
+	JRST FDIR	;YES. PRINT FILE DIR OF THIS TAPE
+	CAIN CH,"I-40	;CORE VS TAPE INTERROGATOR?
+	MOVNI WRITE,5	;WRITE :=-5 FOR "I"
+	CAILE CH,27	;SKIP IF OCTAL NUMBER
+	JRST TYI	;NO. GO PROCESS FILE NAME
+	LSH B,3	;CONVERT SIXBIT TO OCTAL
+	LSHC F,3	;F+1=B
+	JUMPN B,.-2	;MAY BE MORE THAN 1 DIGIT (START ADR)
+	CAILE F,7	;SKIP IF ONE DIGIT
+	JRA D,JBLK	;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.
+OPNTP:			;SHIFT UNIT NUMBER LEFT FOR CONO
+IFE MODE,	LSH F,11
+IFN MODE,LSH F,3
+	MOVEM F,TAPENO	;SAVE IN CORE
+IFE MODE,	CONO DTC,10000	;DESELECT OLD DRIVE
+CLSTP:	MOVEI BLKNO,100	;BLK NO OF FILE DIR
+	JSP P,RBLK	;MOVE TO BLOCK 100
+	JFCL TAB+200(E)	;READ OR WRITE DIR TAB AS DETERMINED BY WRITE
+	AOJL E,UWAIT1	;COUNT THE 200 WORDS
+	JRST BEG	;GO ASK FOR NEXT COMMAND
+
+FDIR:	MOVNI FILN,56	;2*27(OCTAL) FILES.
+FD2:	JSP P,CRR	;CR-LF
+FD3:	AOJ FILN,207		;USED FOR BELL TYPEOUT
+	SKIPN C,TAB+55(FILN)	;FIRST WORD OF NAME. IS IT BLANK?
+	AOJA C,FD1	;YES. SET C=1 AND LOOP
+	JSP G,SIXBP	;PRINT FIRST WORD OF FILE NAME
+	MOVE C,TAB+56(FILN)	;SECOND WORD OF FILE NAME
+	JSP G,SIXBP	;PRINT AND CEAR C
+FD1:	AOJL FILN,FD2(C)	;CAN JUMP TO FD2 OR FD3. COUNT FILES.
+	JRST BEG	;ALL FILES PRINTED OR BLANK. RETURN.
+
+SIXBP:	MOVNI B,7	;SIXBP PRINTS C(C) IN 6BIT
+			;AND APPENDS A SPACE
+			;LEAVES (C)=0
+SIXBP1:	MOVEI A,0
+	LSHC A,6
+	ADDI A,40	;SIXBIT TO ASCII
+	JSP P,TYO	;TYPE OUT CHARACTER
+	AOJL B,SIXBP1	;LOOP IF MORE CHARACTERS
+	JRST 0(G)	;RETURN
+
+SPNT:	0	;POINTER TO HEADERS IN CORE.
+
+	CONSTANTS
+
+	SLOP=COMPTR-17-.	;THIS MANY WORDS BEFORE RESERVED AREA
+				;FOR COMMAND STRINGS.
+
+INFORM ROOM AT TOP=,\<COMPTR-.>
+
+	END BEGR
+
+

src/mlsys/boot.1

@@ -0,0 +1,43 @@
+
+
+TITLE DBOOT
+
+RIM10
+NOSYMS
+B==2
+ICWA==30
+
+MEMSIZ==1000000
+
+.INSRT MLSYS;MDSK >
+
+LOC MEMSIZ-100
+
+BOOT:	CONSZ DPC,BUSY
+	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
+	CONSO DPC,DONE
+	JRST .-1
+	DATAO DPC,SWPIN1
+	CONSO DPC,DONE
+	JRST .-1
+	DATAO DPC,SWPIN2
+	CONSO DPC,DONE
+	JRST .-1
+	JRST 4,.	;SHOULD BE CLOBBERED
+
+ERRWD:	-2000,,MEMSIZ-2000-1
+CLATT1:	DEASEC ALLATT
+SWPSK:	DSEEKC+200._22.
+SWPIN1:	DWRITC+200._22.+3_17.+6._12.+ICWA	;NBLKS 4
+SWPIN2:	DREADC+200._22.+5_17.+4._12.+ICWA	;NBLKS 6
+
+END BOOT
+

src/mlsys/boot.2

@@ -0,0 +1,44 @@
+
+
+TITLE DBOOT
+
+RIM10
+NOSYMS
+B==2
+ICWA==30
+
+MEMSIZ==1000000
+
+.INSRT MLSYS;MDSK >
+
+LOC MEMSIZ-100
+
+BOOT:	CLEARM MEMSIZ-1
+	CONSZ DPC,BUSY
+	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
+	CONSO DPC,DONE
+	JRST .-1
+	DATAO DPC,SWPIN1
+	CONSO DPC,DONE
+	JRST .-1
+	DATAO DPC,SWPIN2
+	CONSO DPC,DONE
+	JRST .-1
+	JRST 4,.	;SHOULD BE CLOBBERED
+
+ERRWD:	-2000,,MEMSIZ-2000-1
+CLATT1:	DEASEC ALLATT
+SWPSK:	DSEEKC+200._22.
+SWPIN1:	DWRITC+200._22.+3_17.+6._12.+ICWA	;NBLKS 4
+SWPIN2:	DREADC+200._22.+5_17.+4._12.+ICWA	;NBLKS 6
+
+END BOOT
+

src/mlsys/decdsk.dmp108

@@ -0,0 +1,892 @@
+
+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]YY,,[CMPERR,DIRFUL
+EOF,SYSNNF,FNF,PKNMTD,CKSERR,DSKFUL,NODDT,?BUG?,CLOB63
+CLOBRD,CLOBWR,DIRCLB,DSKDMP]
+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
+	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
+

src/mlsys/decdsk.dmp109

@@ -0,0 +1,895 @@
+
+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
+

src/mlsys/dskdmp.switch

@@ -0,0 +1,5 @@
+;PARAMETER FILE FOR DSKDMP
+FULHSW==0		;NON ZERO MEANS LOTS OF CORE
+MEMSIZ=1000000		;ACTUAL SIZE OF MEM
+DBGSW==0		;1 TO DEBUG THIS WITH DDT
+

src/mlsys/itsdin.6

@@ -0,0 +1,118 @@
+
+QINTE:	CONI DPC,TT	;GET CONDITIONS
+	DATAI DPC,R
+	CONO DPC,175700+DSKCHN	;RESET CONDITIONS
+	MOVEM TT,QERST
+	CONSZ DPC,20	;WAIT FOR UNBUSY
+	JRST 4,.-1
+	MOVE E,QCHPRG
+	TRNE TT,20000	;OVERRUN
+	JRST QOVR
+	TRNE TT,2000	;NOT READY
+	JRST QNRDY
+	TDNE TT,[12010700]	;BITS 14,16,23,27-29 ARE LOSERS
+	JRST 4,.
+	TLNE TT,5	;WD OR SECTOR PARITY ERROR
+	JRST QDE
+	TRNE TT,1000	;WRITE LOCKED
+	JRST QIRWRE
+	TRNE TT,40000	;SEARCH FAILED
+	JRST QHE
+	TRNN TT,100000	;POWER FAILURE
+	JRST QINTE1
+	CONSZ DPC,100000	;TRY IT AGAIN
+	JRST 4,.-1
+	JRST QHE
+QINTE1:	TLNE R,10	;FILE UNSAFE
+	JRST 4,.	;NEED OPERATOR INTERVENTION
+	TLNE R,4
+	JRST 4,.	;NO SUCH DRIVE
+	TLNE R,100	;POSITION FAILURE
+	JRST QHE
+	AOS NQSE	;SPURIOUS ERROR
+	JRST QINTX	;IGNORE
+
+QIRWRE:	JRST 4,.	;IRRECOVERABLE WRITE ERROR
+
+QNRDY:	LDB Q,[410300,,R]	;WHICH DPC
+	SKIPN QSEEK(Q)
+	SKIPGE QRCAL(Q)	;NOT SEEKING OR RECALIBRATING IS ERROR
+	JRST QINTN2
+	JRST 4,.
+
+QINTAT:	CONI DPC,QERST
+	SETZM QSEEK(Q)
+	DATAO DPC,QATTNS(Q)	;CLEAR ATTNS
+	DATAI DPC,E
+	TLNN E,40
+	JRST QREC
+	SETZM QRCAL(Q)
+	LDB E,[311000,,E]
+	MOVEM E,QPOS(Q)	;REMEMBER WHERE IT IS AT
+	JRST QINT	;TRY AGAIN
+
+QINT:	AOS QGTBZY
+	MOVEM TT,QCST
+	TDNE TT,[17377700]	;ANY ERRORS?
+	JRST QINTE
+QINTN2:	DATAI DPC,R
+	SKIPGE QSDU	;DONT CLOB CMD BUF TO CLR ATTS DURING DATA XFER
+	TRNN R,776	;ANY ATTNS
+	JRST QINTA	;NO
+FINDQ:	LDB I,[11000,,R]	;YES,FIND WHICH DRIVE
+	JFFO I,.+1	;CLOBBERS Q
+	SUBI Q,28.
+	JRST QINTAT
+
+QINTA:	SKIPGE Q,QSDU
+	JRST QINT1	;NOT EXPECTING DATA COMPLETION
+	CONSO DPC,400000
+	CONSO DPC,10
+	JRST DSKEX
+	CONSZ DPC,20
+	JRST 4,.-1	;BUSY?
+	JRST QINTA1QINT6A:	IORI T,7000+ICWA	;DON'T STOP FOR PARITY ERRORS (PLUS INITIAL CHNL ADR)
+	MOVEM T,QCHPRG
+	DPB Q,[DUNFLD+QCHPRG]
+	HLLZS QICWA
+	DPB R,[121000,,QICWA]
+	MOVE E,R
+	LSH E,-10.
+	TRC E,7
+	DPB E,[410300,,QICWA]	;SET UP HIGH ADR BITS
+	SOS TT,QICWA
+	MOVE E,QSGL(C)
+	PUSHJ P,QPOSR
+	IORB E,QCHPRG
+	SETOM QSLDD(C)
+QOVR:	CONSZ DPC,20
+	JRST QOVR
+	CONO DPC,175700+DSKCHN
+	MOVEI TT,QICWA
+	HRRZM TT,ICWA
+	LDB TT,[DCYL E]
+	CAME TT,QPOS(Q)
+	JRST DSKEX	;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
+	SETZM ICWA+1
+	DATAO DPC,QCHPRG	;ENTRY ON OVERRUN
+	MOVE A,TIME
+	MOVEM A,LQTM
+	MOVEM Q,QSDU
+QINTX:	JRST DSKEX
+
+
+QPOSR:	CAIL E,NBLKS
+	JRST 4,.
+	MOVEI D,0
+	IDIVI E,NBLKSC
+	DPB E,[DCYL+D]
+	MOVEM E,QSPPS(Q)
+	MOVE E,TT
+	IMULI E,NSSECS
+	IDIVI E,NHSECS
+	DPB E,[DSURF+D]
+	DPB TT,[DSECT+D]
+	DPB Q,[DUNFLD+D]
+	MOVE E,D
+	POPJ P,
+

src/mlsys/itsdin.7

@@ -0,0 +1,117 @@
+
+QINTE:	CONI DPC,TT	;GET CONDITIONS
+	DATAI DPC,R
+	CONO DPC,175700+DSKCHN	;RESET CONDITIONS
+	MOVEM TT,QERST
+	CONSZ DPC,20	;WAIT FOR UNBUSY
+	JRST 4,.-1
+	MOVE E,QCHPRG
+	TRNE TT,20000	;OVERRUN
+	JRST QOVR
+	TRNE TT,2000	;NOT READY
+	JRST QNRDY
+	TDNE TT,[12010700]	;BITS 14,16,23,27-29 ARE LOSERS
+	JRST 4,.
+	TLNE TT,5	;WD OR SECTOR PARITY ERROR
+	JRST QDE
+	TRNE TT,1000	;WRITE LOCKED
+	JRST QIRWRE
+	TRNE TT,40000	;SEARCH FAILED
+	JRST QHE
+	TRNN TT,100000	;POWER FAILURE
+	JRST QINTE1
+	CONSZ DPC,100000	;TRY IT AGAIN
+	JRST 4,.-1
+	JRST QHE
+QINTE1:	TLNE R,10	;FILE UNSAFE
+	JRST 4,.	;NEED OPERATOR INTERVENTION
+	TLNE R,4
+	JRST 4,.	;NO SUCH DRIVE
+	TLNE R,100	;POSITION FAILURE
+	JRST QHE
+	AOS NQSE	;SPURIOUS ERROR
+	JRST QINTX	;IGNORE
+
+QIRWRE:	JRST 4,.	;IRRECOVERABLE WRITE ERROR
+
+QNRDY:	LDB Q,[410300,,R]	;WHICH DPC
+	SKIPN QSEEK(Q)
+	SKIPGE QRCAL(Q)	;NOT SEEKING OR RECALIBRATING IS ERROR
+	JRST QINTN2
+	JRST 4,.
+
+QINTAT:	CONI DPC,QERST
+	SETZM QSEEK(Q)
+	DATAO DPC,QATTNS(Q)	;CLEAR ATTNS
+	DATAI DPC,E
+	TLNN E,40
+	JRST QREC
+	SETZM QRCAL(Q)
+	LDB E,[311000,,E]
+	MOVEM E,QPOS(Q)	;REMEMBER WHERE IT IS AT
+	JRST QINT	;TRY AGAIN
+
+QINT:	AOS QGTBZY
+	MOVEM TT,QCST
+	TDNE TT,[17377700]	;ANY ERRORS?
+	JRST QINTE
+QINTN2:	DATAI DPC,R
+	SKIPGE QSDU	;DONT CLOB CMD BUF TO CLR ATTS DURING DATA XFER
+	TRNN R,776	;ANY ATTNS
+	JRST QINTA	;NO
+FINDQ:	LDB I,[11000,,R]	;YES,FIND WHICH DRIVE
+	JFFO I,.+1	;CLOBBERS Q
+	SUBI Q,28.
+	JRST QINTAT
+
+QINTA:	SKIPGE Q,QSDU
+	JRST QINT1	;NOT EXPECTING DATA COMPLETION
+	CONSO DPC,400000
+	CONSO DPC,10
+	JRST DSKEX
+	CONSZ DPC,20
+	JRST 4,.-1	;BUSY?
+	JRST QINTA1QINT6A:	IORI T,7000+ICWA	;DON'T STOP FOR PARITY ERRORS (PLUS INITIAL CHNL ADR)
+	MOVEM T,QCHPRG
+	DPB Q,[DUNFLD+QCHPRG]
+	HLLZS QICWA
+	DPB R,[121000,,QICWA]
+	LDB E,[100100,,R]	;MA17
+	TRC E,7
+	DPB E,[410300,,QICWA]	;SET UP HIGH ADR BITS
+	SOS TT,QICWA
+	MOVE E,QSGL(C)
+	PUSHJ P,QPOSR
+	IORB E,QCHPRG
+	SETOM QSLDD(C)
+QOVR:	CONSZ DPC,20
+	JRST QOVR
+	CONO DPC,175700+DSKCHN
+	MOVEI TT,QICWA
+	HRRZM TT,ICWA
+	LDB TT,[DCYL E]
+	CAME TT,QPOS(Q)
+	JRST DSKEX	;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
+	SETZM ICWA+1
+	DATAO DPC,QCHPRG	;ENTRY ON OVERRUN
+	MOVE A,TIME
+	MOVEM A,LQTM
+	MOVEM Q,QSDU
+QINTX:	JRST DSKEX
+
+
+QPOSR:	CAIL E,NBLKS
+	JRST 4,.
+	MOVEI D,0
+	IDIVI E,NBLKSC
+	DPB E,[DCYL+D]
+	MOVEM E,QSPPS(Q)
+	MOVE E,TT
+	IMULI E,NSSECS
+	IDIVI E,NHSECS
+	DPB E,[DSURF+D]
+	DPB TT,[DSECT+D]
+	DPB Q,[DUNFLD+D]
+	MOVE E,D
+	POPJ P,
+

src/mlsys/itsdin.8

@@ -0,0 +1,119 @@
+
+QINTE:	CONI DPC,TT	;GET CONDITIONS
+	DATAI DPC,R
+	CONO DPC,175700+DSKCHN	;RESET CONDITIONS
+	MOVEM TT,QERST
+	CONSZ DPC,20	;WAIT FOR UNBUSY
+	JRST 4,.-1
+	MOVE E,QCHPRG
+	TRNE TT,20000	;OVERRUN
+	JRST QOVR
+	TRNE TT,2000	;NOT READY
+	JRST QNRDY
+	TDNE TT,[12010700]	;BITS 14,16,23,27-29 ARE LOSERS
+	JRST 4,.
+	TLNE TT,5	;WD OR SECTOR PARITY ERROR
+	JRST QDE
+	TRNE TT,1000	;WRITE LOCKED
+	JRST QIRWRE
+	TRNE TT,40000	;SEARCH FAILED
+	JRST QHE
+	TRNN TT,100000	;POWER FAILURE
+	JRST QINTE1
+	CONSZ DPC,100000	;TRY IT AGAIN
+	JRST 4,.-1
+	JRST QHE
+QINTE1:	TLNE R,10	;FILE UNSAFE
+	JRST 4,.	;NEED OPERATOR INTERVENTION
+	TLNE R,4
+	JRST 4,.	;NO SUCH DRIVE
+	TLNE R,100	;POSITION FAILURE
+	JRST QHE
+	AOS NQSE	;SPURIOUS ERROR
+	JRST QINTX	;IGNORE
+
+QIRWRE:	JRST 4,.	;IRRECOVERABLE WRITE ERROR
+
+QNRDY:	LDB Q,[410300,,R]	;WHICH DPC
+	SKIPN QSEEK(Q)
+	SKIPGE QRCAL(Q)	;NOT SEEKING OR RECALIBRATING IS ERROR
+	JRST QINTN2
+	JRST 4,.
+
+QINTAT:	CONI DPC,QERST
+	SETZM QSEEK(Q)
+	DATAO DPC,QATTNS(Q)	;CLEAR ATTNS
+	DATAI DPC,E
+	TLNN E,40
+	JRST QREC
+	SETZM QRCAL(Q)
+	LDB E,[311000,,E]
+	MOVEM E,QPOS(Q)	;REMEMBER WHERE IT IS AT
+	JRST QINT	;TRY AGAIN
+
+QINT:	AOS QGTBZY
+	MOVEM TT,QCST
+	TDNE TT,[17377700]	;ANY ERRORS?
+	JRST QINTE
+QINTN2:	DATAI DPC,R
+	SKIPGE QSDU	;DONT CLOB CMD BUF TO CLR ATTS DURING DATA XFER
+	TRNN R,776	;ANY ATTNS
+	JRST QINTA	;NO
+FINDQ:	LDB I,[11000,,R]	;YES,FIND WHICH DRIVE
+	JFFO I,.+1	;CLOBBERS Q
+	SUBI Q,28.
+	JRST QINTAT
+
+QINTA:	SKIPGE Q,QSDU
+	JRST QINT1	;NOT EXPECTING DATA COMPLETION
+	CONSO DPC,400000
+	CONSO DPC,10
+	JRST DSKEX
+	CONSZ DPC,20
+	JRST 4,.-1	;BUSY?
+	JRST QINTA1QINT6A:	IORI T,7000+ICWA	;DON'T STOP FOR PARITY ERRORS (PLUS INITIAL CHNL ADR)
+	MOVEM T,QCHPRG
+	DPB Q,[DUNFLD+QCHPRG]
+	HLLZS QICWA
+	DPB R,[121000,,QICWA]
+	LDB E,[100100,,R]	;MA17
+	TRC E,7
+	DPB E,[410300,,QICWA]	;SET UP HIGH ADR BITS
+	MOVE TT,QICWA
+	SOS TT
+	HRRM TT,QICWA
+	MOVE E,QSGL(C)
+	PUSHJ P,QPOSR
+	IORB E,QCHPRG
+	SETOM QSLDD(C)
+QOVR:	CONSZ DPC,20
+	JRST QOVR
+	CONO DPC,175700+DSKCHN
+	MOVEI TT,QICWA
+	HRRZM TT,ICWA
+	LDB TT,[DCYL E]
+	CAME TT,QPOS(Q)
+	JRST DSKEX	;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
+	SETZM ICWA+1
+	DATAO DPC,QCHPRG	;ENTRY ON OVERRUN
+	MOVE A,TIME
+	MOVEM A,LQTM
+	MOVEM Q,QSDU
+QINTX:	JRST DSKEX
+
+
+QPOSR:	CAIL E,NBLKS
+	JRST 4,.
+	MOVEI D,0
+	IDIVI E,NBLKSC
+	DPB E,[DCYL+D]
+	MOVEM E,QSPPS(Q)
+	MOVE E,TT
+	IMULI E,NSSECS
+	IDIVI E,NHSECS
+	DPB E,[DSURF+D]
+	DPB TT,[DSECT+D]
+	DPB Q,[DUNFLD+D]
+	MOVE E,D
+	POPJ P,
+

src/mlsys/itsutp.5

@@ -0,0 +1,408 @@
+; T S UTAPE ROUTINES PI SERV
+
+TAPE:	0
+UTP1:	0	;JRST PIPOS OR DATAI DC, OR JRST UTP3
+
+BBLK
+
+	SOS .-1
+	AOSGE TAPCNT
+	JRST 12,@TAPE
+
+UTP3:	CONO DTS,770001
+	JRST 12,@TAPE
+
+PIPOS:	MOVEM A,TAP1
+	MOVEM B,TAP2
+	MOVEM C,TAP3
+	MOVE C,SUNIT
+	DATAI DTC,B
+	TDZE B,[1777#-1]
+	JRST PIPOS7
+	MOVEM B, EUPOS(C)
+	HRRZM C, DG2(C)
+	SKIPGE UGOAL(C)
+	JRST PIPF1
+	SUB B,UGOAL(C)
+	JUMPE B,PIPOS2
+	ADD B,UDIR(C)
+	MOVMM B,UTENB
+	SKIPGE ULDCH(C)
+	JRST PIPOS3
+	JUMPN B,PIPOS3
+PIPOSL:	MOVEI A,40000+DCCHN_3
+	DPB C,[110300,,A]	;SET SELECTED UNIT CONO DTC,FOO(A)
+	MOVE B,UDIR(C)
+	XCT UTST2(B)
+PIPOS5:	MOVE C,TAP3
+	MOVE B,TAP2
+	MOVE A,TAP1
+	JRST 12,@TAPE
+
+PIPOS7:	AOS BDBLKC
+	JRST PIPOSL
+
+EBLK
+
+BDBLKC:	0
+BBLK
+
+PIPOS3:	MOVE A,UDIR(C)
+	LSH A,2
+	SUB B,A
+	XOR B,UDIR(C)
+	MOVEI A,40000
+	DPB C,[110300,,A]
+	JUMPG B,PIPOS4	;GOING WRONG DIR
+PIPOS6:	MOVE B,TIME
+	MOVEM B,ULCTM(C)
+	ADD B,UTENB
+	MOVEM B,DRTM(C)
+PIPF2:	MOVE B,UDIR(C)
+	TRNN A,40000
+	TRO A,30000
+	XCT  UTST2(B)
+;	CLEARM UDCC
+;	SETOM DCFREE
+	CONO DTS,770001	;ENABLE ALL INTERUPTS AND SET FUNCTION STOP
+	JRST PIPOS5
+
+PIPF1:	MOVEI A,40000
+	DPB C,[110300,,A]
+	MOVE B,TIME
+	MOVEM B,ULCTM(C)
+	JRST PIPF2
+PIPOS4:	TRZ A,40000	;TURN TAPE AROUND
+	CLEARM DG2(C)
+	MOVNS B,UDIR(C)
+	MOVEM B,OUDIR(C)
+	JRST PIPOS6
+
+PIPOS2:	HLRZ A,ULDCH(C)
+	SKIPL ULDCH(C)
+	SKIPGE UTRAC(A)
+	JRST PIPOS3	;CHANNEL LOCKED
+	SETOM UTLDD(A)	;CHANNEL ACTUALLY LOADED TRANSFER IMMINENT
+	AOS SMODE
+	MOVEI A,0
+	MOVE B,UMEMAD(C)
+	SKIPGE URDWR(C)
+	TROA A,400	;WRITE
+	TLZ B,(BLKO-BLKI)
+	SKIPL UDIR(C)
+	JRST TAPFOR
+	TRO A,100000
+	ADD B,[DATAI-BLKI 200]
+	MOVEM B,UTP1
+	MOVNI B,200
+	MOVEM B,TAPCNT
+
+TAP4:	CONO DTC,300+DCCHN_3+UTCCHN(A)
+	CONO DTS,770000
+	MOVE B,URDWR(C)
+	MOVEM B,WRITE
+	MOVE C,TAP3
+	MOVE B,TAP2
+	MOVE A,TAP1
+	JRST 12,@TAPE
+
+TAPFOR:	TRO A,200000
+	HRRM B,TAPCNT
+	HRRI B,TAPCNT
+	MOVEM B,DCMLOC
+	MOVE B,[-200,,UTP3]
+	HRRM B,UTP1
+	HLLM B,TAPCNT
+	JRST TAP4
+UTERR:	CONI DTS,E
+	SKIPL SMODE
+	JRST UDATER
+;	SKIPGE UDCC
+;	SETOM DCFREE
+UTER5:	SKIPN C,SUNIT
+	JRST JDB3
+	SETOM DG2(C)
+	SKIPL UFLAPF(C)
+	JRST UTER6
+	CLEARM UFLAPF(C)
+	CLEARM EUPOS(C)
+	CLEARM UDIR(C)
+	CLEARM OUDIR(C)
+	CONO DTC,400000	;STOP DRIVE
+	JRST JDB3
+
+UTER6:	AOS UTERP(C)
+	HRLM E,UTERP(C)
+	TRNN E,20000
+	JRST JDB3	;END ZONE
+	MOVNS B,UDIR(C)
+	MOVEI A,0
+	SKIPGE B
+	MOVEI A,1103
+	MOVEM A,EUPOS(C)
+	MOVE A,TIME
+	MOVEM A,ULCTM(C)
+	MOVEM A,DRTM(C)
+	JRST JDB7
+
+UDATER:	CONO DTS,770001	;ENABLE ALL INTERUPTS AND STOP FUNCTION
+	SETOM SMODE
+	HLRZ D,ULDCH(C)
+	CLEARM UTLDD(D)
+	JRST JDB3
+UTCB0:	MOVE C,SUNIT
+	AOSE CUINT	;SKIP IF CLOCK CAUSED INTERUPT
+	JRST JDBRK	;NOT TIME FLAG
+UTCB1:	MOVE B,UDIR(C)
+	AOSN UTHERR	;HANG UP ERROR SENT FOR SLOW CLOCK ROUTINE
+	JRST UTERR
+	JRST JDB3
+
+JDDT3:	MOVE A,EUPOS(C)	;AFTER DATA XFER
+	SUB A,UGOAL(C)
+	MOVMS E,A
+	ADD A,TIME
+	MOVEM A,DRTM(C)
+	MOVE C,[-NUNITS,,1]
+	MOVM B,DRTM(C)
+	CAMGE B,TIME
+	JRST JDB3	;SOMETHING ELSE DUE
+	AOBJN C,.-3
+	MOVE C,SUNIT
+	SOJLE E,JDB7	;RELOADING FOR NEXT BLOCK
+	JRST JDB3
+ILLP:	MOVEM D,UGOAL(C)	;LOW PRIORITY POSIT ENTRY
+	MOVSI A,(SETZ)
+	IORM A,ULDCH(C)
+
+UTDC:	SKIPGE UGOAL(C)
+	POPJ P,	;UNIT IDLE
+	SKIPGE DG2(C)
+	JRST UTDC3
+UTDC1:	MOVE A,EUPOS(C)	;ESTIMATE UNIT TIME AND UPDATE EUPOS
+	SKIPG DG2(C)	;SKIP ON EXACT POS KNOWN
+	SKIPN UDIR(C)	;SKIP ON UNIT RUNNING
+	JRST UTDC4
+	MOVE B,TIME
+	SUBM B,ULCTM(C)
+	EXCH B,ULCTM(C)
+	IMUL B,UDIR(C)
+	ADD A,B	;ACTUAL ESTIMATED POSITION
+	MOVEM A,EUPOS(C)	;UPDATE EUPOS
+UTDC4:	SUB A,UGOAL(C)
+	MOVM B,A
+	CAIG B,2
+	JRST UTDC2
+	ADD A,UDIR(C)
+	MOVMS Aî	
+	CAMLE A,B
+	SETZB A,B	;GOING WRONG DIR
+UTDC2:	CAILE B,200.
+	MOVEI B,200.	;LIMIT LONGEST DEAD RECKON
+	ADD B,TIME
+	MOVEM B,DRTM(C)
+	POPJ P,
+
+UTDC3:	MOVEI B,0	;NOT KNOWN EXACT POS REQUIRES IMMEDIATE ATTENTION
+	JRST UTDC2
+
+JDBRK:	CONSO DTS,2
+	JRST POPRET
+	CONSZ DTS,670300
+	JRST UTERR
+	CONSO DTS,100000
+	JRST POPRET
+	SKIPL SMODE
+	JRST JDDTA	;DATA MODE
+JDB3:
+;	SKIPGE UDCC
+;	SETOM DCFREE
+	HRLOI B,177777
+	MOVEM B,UTTM2
+	SETOM UTTM3	;UNIT MOST URGENT
+	CLEARM UTTM1	;UNIT COULD START
+	MOVE C,[-NUNITS,,1]
+JDBRK7:	SKIPGE B,UFLAPF(C)
+	JRST JDF1	;FLAPPING OP
+JDF2:	SKIPL ULDCH(C)	;SKIP ON LOW PRIOR POSIT
+	SKIPGE UGOAL(C)
+	JRST JDB6	;UNIT FREE
+JDS1:	SKIPE UDIR(C)
+	JRST JDBRK4
+	SKIPN UTTM1	;UNIT TO START
+	HRRZM C,UTTM1
+	JRST JDBRK6
+JDBRK4:	MOVE B,DRTM(C)
+	SUB B,TIME
+	MOVE E,B
+	SUB E,UTTM2	;TIME SMOE OTHER UNIT NEEDS ATTN
+	JUMPL B,JDCV1	;ALREADY OVERDUE
+	MOVM D,E
+	CAIG B,20.	;CONFLICT MORE THAN 20 BLKS AWAY
+	CAIL D,20.	;THEY ARE SEPARETED BY 20 BLKS
+	JRST JDCV1
+	HRRZS C	;RELIEVE CONFLICT BY STOPPING UNIT DUE LATEST
+	CAMG B,UTTM2
+	HRRZ C,UTTM3
+JDF5:	PUSHJ P,JDSTP	;STOP UNIT
+	JRST JDB3
+
+JDCV1:	JUMPGE E,ULLP
+	MOVEM B,UTTM2	;UNIT DUE SOONEST
+	HRRZM C,UTTM3
+ULLP:	SKIPL ULDCH(C)
+	JRST JDBRK6
+	MOVE B,TIME	;LOW PRIORITY POSIT IN PROGRESS
+	SUB B,ULCTM(C)
+	IMUL B,UDIR(C)
+	SKIPE DG2(C)
+	MOVEI B,0
+	ADD B,EUPOS(C)
+	SUB B,UGOAL(C)
+	MOVMS B
+	CAIGE B,10.
+	PUSHJ P,ULLP1	;TERM LOW PRIORITY DIRECTORY POS (COMMIT TO ACTUAL WRITE)
+JDBRK6:	AOBJN C,JDBRK7
+	MOVE C,UTTM3	;MOST PRESSING RUNNING UNIT
+	MOVE B,UTTM2
+	CAIGE B,30.
+	JRST JDB7	;STAY WITH PRESSING UNIT
+	SKIPE UTTM1
+	JRST JDB5	;START UNIT IF POSSIBLE
+JDF6A:	CAMG B,[10000000.]
+	JRST JDB7
+	SETOM UIDLE
+	JRST POPRET
+
+JDF1:	MOVE E,UDIRO(C)
+	AOJE E,JDF1A
+	TLNE E,100000
+	JRST JDF2
+JDF1A:	SKIPGE UGOAL(C)	;FLAPPING OP
+	SKIPGE ULDCH(C)
+	JRST JDF2
+	SKIPE UDIR(C)
+	SKIPG DG2(C)
+	JRST .+2
+	JRST JDF3A	;HAVE JUST READ IN TAPE POS
+	TLNN B,100000
+	JRST JDF3	;UNIT TO START FLAPPING (I.E. READ IN TAPE POS, THEN FLAP)
+	LDB D,[4000,,B]
+	TLNN B,100000
+	JRST JDBRK6
+	TLNN B,200000	;ABORT FLAPPING
+	CAMG D,TIME
+	JRST JDF4	;UNIT TO STOP FLAPPING
+	JRST JDBRK6
+
+JDDS:	CONO DTC,10000	;DESELECT
+	CLEARM SUNIT
+	POPJ P,
+
+JDSTP:	MOVEI A,430000
+	SETZM UDIR(C)
+	SETZM OUDIR(C)
+JDCNN:	HRRZS C
+	CAME C,SUNIT	;DIR CONO IN A TO UNIT IN C
+	SKIPN SUNIT
+	JRST JDSTP1
+	PUSHJ P,JDDS
+JDSTP1:	DPB C,[110300,,A]
+	CONO DTC,(A)
+	MOVEM C,SUNIT
+	POPJ P,
+
+JDF3:	MOVE A,UDIRO(C)	;WANT TO FLAP
+	AOJE A,JDF3A1	;DIR NOT IN
+	TLNE A,10000
+	JRST JDF3A2	;DIR ON WAY IN
+	HRRZ A,ULDCH(C)
+	LDB Q,[IOCH,,IOBFT(A)]
+	CAIE Q,NUTIC+NUTOC
+	JRST 4,.
+	LDB Q,[IOLO,,IOBFT(A)]
+	CAIE Q,(C)
+	JRST 4,.
+	PUSHJ P,IBRTN	;RETURN DIR BUFFER
+JDF3A2:	SETOM UDIRO(C)
+	SETZM UTASS(C)
+JDF3A1:	SETOM UDPWF(C)
+	SKIPGE DG2(C)
+	JRST JDF6
+JDF3A:	SETOM DG2(C)	;FLAP UNIT INC(KNOWING WHERE IT IS)
+	MOVE E,EUPOS(C)
+	IMULI E,50.	;50 MS/BLOCK
+	IDIVI E,33.	;33 MS/(1/2 SEC)
+	ADDI E,30.	;15 SECS EXTRA
+	ADD E,TIME	;NET TIME TO STOP FLAPPING
+	TLO E,100000
+	DPB E,[4200,,UFLAPF(C)]
+	LSH C,9.
+	CONO DTC,130000(C)	;GO REVERSE
+	PUSHJ P,JDDS
+	JRST JDB3
+
+JDF6:	HRRZS C
+	SETOM UDIR(C)
+	JRST JDB7
+
+JDF4:	TLNE B,40000
+	JRST JDF4A
+	MOVEI A,230000	;A SHOT OF FOWARD
+	PUSHJ P,JDCNN	;REEL WILL STOP
+	AND B,[700000,,]
+	ADD B,[40000,,2]
+	ADD B,TIME
+	MOVEM B,UFLAPF(C)
+	JRST JDB3
+
+JDF4A:	PUSHJ P,JDSTP
+	CLEARM UFLAPF(C)
+	CLEARM EUPOS(C)
+	SETOM DG2(C)
+	JRST JDF5
+JDB5:	HRRZ C,UTTM1
+	MOVE E,UGOAL(C)
+	CAML E,EUPOS(C)
+	SKIPA B,[1]
+	MOVNI B,1
+	MOVEM B,UDIR(C)
+JDB7:	SKIPN B,UDIR(C)
+	JRST 4,.	;NOT TRYING TO GO
+	MOVEI A,DCCHN_3
+	SKIPN SUNIT
+	JRST DCGB1
+	CAME C,SUNIT
+	JRST DCGB2
+	CAMN B,OUDIR(C)
+	TRO A,40000	;INHIBIT START DELAY (SAME UNIT, SAME DIRECTION)
+DCGB1:	MOVEM C,SUNIT
+	MOVEM B,OUDIR(C)
+	TRNN A,40000
+	TRO A,30000
+	DPB C,[110300,,A]
+	XCT UTST2(B)
+	CONO DTS,770000
+	MOVE C,[JSR TAPE]
+	MOVEM C,DCMLOC
+	MOVEM C,DCMLOC+1
+	MOVE C,[JRST PIPOS]
+	MOVEM C,UTP1
+	JRST POPRET
+
+DCGB2:	PUSHJ P,JDDS
+	JRST DCGB1
+
+	CONO DTC,130200+UTCCHN+<DCCHN_3>(A)
+UTST:	CONO DTC,430000+UTCCHN+<DCCHN_3>(A)
+	CONO DTC,230200+UTCCHN+<DCCHN_3>(A)
+
+	CONO DTC,130200+UTCCHN(A)
+UTST1:	CONO DTC,430000+UTCCHN(A)
+	CONO DTC,230200+UTCCHN(A)
+
+	CONO DTC,100200+UTCCHN(A)
+UTST2:	CONO DTC,400000+UTCCHN(A)
+	CONO DTC,200200+UTCCHN(A)
+
+

src/mlsys/itsutp.6

@@ -0,0 +1,413 @@
+; T S UTAPE ROUTINES PI SERV
+
+TAPE:	0
+UTP1:	0	;JRST PIPOS OR DATAI DC, OR JRST UTP3
+
+BBLK
+
+	SOS .-1
+	AOSGE TAPCNT
+	JRST 12,@TAPE
+
+UTP3:	CONO DTS,770001
+	JRST 12,@TAPE
+
+PIPOS:	MOVEM A,TAP1
+	MOVEM B,TAP2
+	MOVEM C,TAP3
+	MOVE C,SUNIT
+	DATAI DTC,B
+	TDZE B,[1777#-1]
+	JRST PIPOS7
+	MOVEM B, EUPOS(C)
+	HRRZM C, DG2(C)
+	SKIPGE UGOAL(C)
+	JRST PIPF1
+	SUB B,UGOAL(C)
+	JUMPE B,PIPOS2
+	ADD B,UDIR(C)
+	MOVMM B,UTENB
+	SKIPGE ULDCH(C)
+	JRST PIPOS3
+	JUMPN B,PIPOS3
+PIPOSL:	MOVEI A,40000+DCCHN_3
+	DPB C,[110300,,A]	;SET SELECTED UNIT CONO DTC,FOO(A)
+	MOVE B,UDIR(C)
+	XCT UTST2(B)
+PIPOS5:	MOVE C,TAP3
+	MOVE B,TAP2
+	MOVE A,TAP1
+	JRST 12,@TAPE
+
+PIPOS7:	AOS BDBLKC
+	JRST PIPOSL
+
+EBLK
+
+BDBLKC:	0
+BBLK
+
+PIPOS3:	MOVE A,UDIR(C)
+	LSH A,2
+	SUB B,A
+	XOR B,UDIR(C)
+	MOVEI A,40000
+	DPB C,[110300,,A]
+	JUMPG B,PIPOS4	;GOING WRONG DIR
+PIPOS6:	MOVE B,TIME
+	MOVEM B,ULCTM(C)
+	ADD B,UTENB
+	MOVEM B,DRTM(C)
+PIPF2:	MOVE B,UDIR(C)
+	TRNN A,40000
+	TRO A,30000
+	XCT  UTST2(B)
+;	CLEARM UDCC
+;	SETOM DCFREE
+	CONO DTS,770001	;ENABLE ALL INTERUPTS AND SET FUNCTION STOP
+	JRST PIPOS5
+
+PIPF1:	MOVEI A,40000
+	DPB C,[110300,,A]
+	MOVE B,TIME
+	MOVEM B,ULCTM(C)
+	JRST PIPF2
+PIPOS4:	TRZ A,40000	;TURN TAPE AROUND
+	CLEARM DG2(C)
+	MOVNS B,UDIR(C)
+	MOVEM B,OUDIR(C)
+	JRST PIPOS6
+
+PIPOS2:	HLRZ A,ULDCH(C)
+	SKIPL ULDCH(C)
+	SKIPGE UTRAC(A)
+	JRST PIPOS3	;CHANNEL LOCKED
+	SETOM UTLDD(A)	;CHANNEL ACTUALLY LOADED TRANSFER IMMINENT
+	AOS SMODE
+	MOVEI A,0
+	MOVE B,UMEMAD(C)
+	SKIPGE URDWR(C)
+	TROA A,400	;WRITE
+	TLZ B,(BLKO-BLKI)
+	SKIPL UDIR(C)
+	JRST TAPFOR
+	TRO A,100000
+	ADD B,[DATAI-BLKI 200]
+	MOVEM B,UTP1
+	MOVNI B,200
+	MOVEM B,TAPCNT
+
+TAP4:	CONO DTC,300+DCCHN_3+UTCCHN(A)
+	CONO DTS,770000
+	MOVE B,URDWR(C)
+	MOVEM B,WRITE
+	MOVE C,TAP3
+	MOVE B,TAP2
+	MOVE A,TAP1
+	JRST 12,@TAPE
+
+TAPFOR:	TRO A,200000
+	HRRM B,TAPCNT
+	HRRI B,TAPCNT
+	MOVEM B,DCMLOC
+	MOVE B,[-200,,UTP3]
+	HRRM B,UTP1
+	HLLM B,TAPCNT
+	JRST TAP4
+UTERR:	CONI DTS,E
+	SKIPL SMODE
+	JRST UDATER
+;	SKIPGE UDCC
+;	SETOM DCFREE
+UTER5:	SKIPN C,SUNIT
+	JRST JDB3
+	SETOM DG2(C)
+	SKIPL UFLAPF(C)
+	JRST UTER6
+	CLEARM UFLAPF(C)
+	CLEARM EUPOS(C)
+	CLEARM UDIR(C)
+	CLEARM OUDIR(C)
+	CONO DTC,400000	;STOP DRIVE
+	JRST JDB3
+
+UTER6:	AOS UTERP(C)
+	HRLM E,UTERP(C)
+	TRNN E,20000
+	JRST JDB3	;END ZONE
+	MOVNS B,UDIR(C)
+	MOVEI A,0
+	SKIPGE B
+	MOVEI A,1103
+	MOVEM A,EUPOS(C)
+	MOVE A,TIME
+	MOVEM A,ULCTM(C)
+	MOVEM A,DRTM(C)
+	JRST JDB7
+
+UDATER:	CONO DTS,770001	;ENABLE ALL INTERUPTS AND STOP FUNCTION
+	SETOM SMODE
+	HLRZ D,ULDCH(C)
+	CLEARM UTLDD(D)
+	JRST JDB3
+UTCB0:	MOVE C,SUNIT
+	AOSE CUINT	;SKIP IF CLOCK CAUSED INTERUPT
+	JRST JDBRK	;NOT TIME FLAG
+UTCB1:	MOVE B,UDIR(C)
+	AOSN UTHERR	;HANG UP ERROR SENT FOR SLOW CLOCK ROUTINE
+	JRST UTERR
+	JRST JDB3
+
+JDDT3:	MOVE A,EUPOS(C)	;AFTER DATA XFER
+	SUB A,UGOAL(C)
+	MOVMS E,A
+	ADD A,TIME
+	MOVEM A,DRTM(C)
+	MOVE C,[-NUNITS,,1]
+	MOVM B,DRTM(C)
+	CAMGE B,TIME
+	JRST JDB3	;SOMETHING ELSE DUE
+	AOBJN C,.-3
+	MOVE C,SUNIT
+	SOJLE E,JDB7	;RELOADING FOR NEXT BLOCK
+	JRST JDB3
+ILLP:	MOVEM D,UGOAL(C)	;LOW PRIORITY POSIT ENTRY
+	MOVSI A,(SETZ)
+	IORM A,ULDCH(C)
+
+UTDC:	SKIPGE UGOAL(C)
+	POPJ P,	;UNIT IDLE
+	SKIPGE DG2(C)
+	JRST UTDC3
+UTDC1:	MOVE A,EUPOS(C)	;ESTIMATE UNIT TIME AND UPDATE EUPOS
+	SKIPG DG2(C)	;SKIP ON EXACT POS KNOWN
+	SKIPN UDIR(C)	;SKIP ON UNIT RUNNING
+	JRST UTDC4
+	MOVE B,TIME
+	SUBM B,ULCTM(C)
+	EXCH B,ULCTM(C)
+	IMUL B,UDIR(C)
+	ADD A,B	;ACTUAL ESTIMATED POSITION
+	MOVEM A,EUPOS(C)	;UPDATE EUPOS
+UTDC4:	SUB A,UGOAL(C)
+	MOVM B,A
+	CAIG B,2
+	JRST UTDC2
+	ADD A,UDIR(C)
+	MOVMS Aî	
+	CAMLE A,B
+	SETZB A,B	;GOING WRONG DIR
+UTDC2:	CAILE B,200.
+	MOVEI B,200.	;LIMIT LONGEST DEAD RECKON
+	ADD B,TIME
+	MOVEM B,DRTM(C)
+	POPJ P,
+
+UTDC3:	MOVEI B,0	;NOT KNOWN EXACT POS REQUIRES IMMEDIATE ATTENTION
+	JRST UTDC2
+
+JDBRK:	CONSZ DTC,7
+	CONSO DTS,2
+	JRST POPRET
+	CONSZ DTS,670300
+	JRST UTERR
+	CONSO DTS,100000
+	JRST POPRET
+	SKIPL SMODE
+	JRST JDDTA	;DATA MODE
+JDB3:
+;	SKIPGE UDCC
+;	SETOM DCFREE
+	HRLOI B,177777
+	MOVEM B,UTTM2
+	SETZM UTTM4
+	SETOM UTTM3	;UNIT MOST URGENT
+	CLEARM UTTM1	;UNIT COULD START
+	MOVE C,[-NUNITS,,1]
+JDBRK7:	SKIPGE B,UFLAPF(C)
+	JRST JDF1	;FLAPPING OP
+JDF2:	SKIPL ULDCH(C)	;SKIP ON LOW PRIOR POSIT
+	SKIPGE UGOAL(C)
+	JRST JDB6	;UNIT FREE
+JDS1:	SKIPE UDIR(C)
+	JRST JDBRK4
+	SKIPN UTTM1	;UNIT TO START
+	HRRZM C,UTTM1
+	JRST JDBRK6
+JDBRK4:	MOVE B,DRTM(C)
+	SUB B,TIME
+	MOVE E,B
+	SUB E,UTTM2	;TIME SOME OTHER UNIT NEEDS ATTN
+	JUMPL B,JDCV1	;ALREADY OVERDUE
+	MOVM D,E
+	CAIG B,20.	;CONFLICT MORE THAN 20 BLKS AWAY
+	CAIL D,20.	;THEY ARE SEPARETED BY 20 BLKS
+	JRST JDCV1
+	HRRZS C	;RELIEVE CONFLICT BY STOPPING UNIT DUE LATEST
+	CAMG B,UTTM2
+	HRRZ C,UTTM3
+JDF5:	PUSHJ P,JDSTP	;STOP UNIT
+	JRST JDB3
+
+JDCV1:	JUMPGE E,ULLP
+	MOVEM B,UTTM2	;UNIT DUE SOONEST
+	HRRZM C,UTTM3
+ULLP:	SKIPL ULDCH(C)
+	JRST JDBRK6
+	MOVE B,TIME	;LOW PRIORITY POSIT IN PROGRESS
+	SUB B,ULCTM(C)
+	IMUL B,UDIR(C)
+	SKIPE DG2(C)
+	MOVEI B,0
+	ADD B,EUPOS(C)
+	SUB B,UGOAL(C)
+	MOVMS B
+	CAIGE B,10.
+	PUSHJ P,ULLP1	;TERM LOW PRIORITY DIRECTORY POS (COMMIT TO ACTUAL WRITE)
+JDBRK6:	AOBJN C,JDBRK7
+	MOVE C,UTTM3	;MOST PRESSING RUNNING UNIT
+	MOVE B,UTTM2
+	CAIGE B,30.
+	JRST JDB7	;STAY WITH PRESSING UNIT
+	SKIPE UTTM1
+	JRST JDB5	;START UNIT IF POSSIBLE
+JDF6A:	CAMG B,[10000000.]
+	JRST JDB7
+	AOSE UTTM4	;DON'T IF FLAP OP STILL IN PROGRESS
+	PUSHJ P,JDDS
+	SETOM UIDLE
+	JRST POPRET
+
+JDF1:	MOVE E,UDIRO(C)
+	AOJE E,JDF1A
+	TLNE E,100000
+	JRST JDF2
+JDF1A:	SKIPGE UGOAL(C)	;FLAPPING OP
+	SKIPGE ULDCH(C)
+	JRST JDF2
+	SKIPE UDIR(C)
+	SKIPG DG2(C)
+	JRST .+2
+	JRST JDF3A	;HAVE JUST READ IN TAPE POS
+	TLNN B,100000
+	JRST JDF3	;UNIT TO START FLAPPING (I.E. READ IN TAPE POS, THEN FLAP)
+	LDB D,[4000,,B]
+	TLNN B,100000
+	JRST JDBRK6
+	TLNN B,200000	;ABORT FLAPPING
+	CAMG D,TIME
+	JRST JDF4	;UNIT TO STOP FLAPPING
+	SETOM UTTM4	;INDICATE FLAP OP STILL ACTIVE
+	JRST JDBRK6
+
+JDDS:	CONO DTC,10000	;DESELECT
+	CLEARM SUNIT
+	POPJ P,
+
+JDSTP:	MOVEI A,430000
+	SETZM UDIR(C)
+	SETZM OUDIR(C)
+JDCNN:	HRRZS C
+	CAME C,SUNIT	;DIR CONO IN A TO UNIT IN C
+	SKIPN SUNIT
+	JRST JDSTP1
+	PUSHJ P,JDDS
+JDSTP1:	DPB C,[110300,,A]
+	CONO DTC,(A)
+	MOVEM C,SUNIT
+	POPJ P,
+
+JDF3:	MOVE A,UDIRO(C)	;WANT TO FLAP
+	AOJE A,JDF3A1	;DIR NOT IN
+	TLNE A,10000
+	JRST JDF3A2	;DIR ON WAY IN
+	HRRZ A,ULDCH(C)
+	LDB Q,[IOCH,,IOBFT(A)]
+	CAIE Q,NUTIC+NUTOC
+	JRST 4,.
+	LDB Q,[IOLO,,IOBFT(A)]
+	CAIE Q,(C)
+	JRST 4,.
+	PUSHJ P,IBRTN	;RETURN DIR BUFFER
+JDF3A2:	SETOM UDIRO(C)
+	SETZM UTASS(C)
+JDF3A1:	SETOM UDPWF(C)
+	SKIPGE DG2(C)
+	JRST JDF6
+JDF3A:	SETOM DG2(C)	;FLAP UNIT INC(KNOWING WHERE IT IS)
+	MOVE E,EUPOS(C)
+	IMULI E,50.	;50 MS/BLOCK
+	IDIVI E,33.	;33 MS/(1/2 SEC)
+	ADDI E,30.	;15 SECS EXTRA
+	ADD E,TIME	;NET TIME TO STOP FLAPPING
+	TLO E,100000
+	DPB E,[4200,,UFLAPF(C)]
+	LSH C,9.
+	CONO DTC,130000(C)	;GO REVERSE
+	PUSHJ P,JDDS
+	JRST JDB3
+
+JDF6:	HRRZS C
+	SETOM UDIR(C)
+	JRST JDB7
+
+JDF4:	TLNE B,40000
+	JRST JDF4A
+	MOVEI A,230000	;A SHOT OF FOWARD
+	PUSHJ P,JDCNN	;REEL WILL STOP
+	AND B,[700000,,]
+	ADD B,[40000,,2]
+	ADD B,TIME
+	MOVEM B,UFLAPF(C)
+	JRST JDB3
+
+JDF4A:	PUSHJ P,JDSTP
+	CLEARM UFLAPF(C)
+	CLEARM EUPOS(C)
+	SETOM DG2(C)
+	JRST JDF5
+JDB5:	HRRZ C,UTTM1
+	MOVE E,UGOAL(C)
+	CAML E,EUPOS(C)
+	SKIPA B,[1]
+	MOVNI B,1
+	MOVEM B,UDIR(C)
+JDB7:	SKIPN B,UDIR(C)
+	JRST 4,.	;NOT TRYING TO GO
+	MOVEI A,DCCHN_3
+	SKIPN SUNIT
+	JRST DCGB1
+	CAME C,SUNIT
+	JRST DCGB2
+	CAMN B,OUDIR(C)
+	TRO A,40000	;INHIBIT START DELAY (SAME UNIT, SAME DIRECTION)
+DCGB1:	MOVEM C,SUNIT
+	MOVEM B,OUDIR(C)
+	TRNN A,40000
+	TRO A,30000
+	DPB C,[110300,,A]
+	XCT UTST2(B)
+	CONO DTS,770000
+	MOVE C,[JSR TAPE]
+	MOVEM C,DCMLOC
+	MOVEM C,DCMLOC+1
+	MOVE C,[JRST PIPOS]
+	MOVEM C,UTP1
+	JRST POPRET
+
+DCGB2:	PUSHJ P,JDDS
+	JRST DCGB1
+
+	CONO DTC,130200+UTCCHN+<DCCHN_3>(A)
+UTST:	CONO DTC,430000+UTCCHN+<DCCHN_3>(A)
+	CONO DTC,230200+UTCCHN+<DCCHN_3>(A)
+
+	CONO DTC,130200+UTCCHN(A)
+UTST1:	CONO DTC,430000+UTCCHN(A)
+	CONO DTC,230200+UTCCHN(A)
+
+	CONO DTC,100200+UTCCHN(A)
+UTST2:	CONO DTC,400000+UTCCHN(A)
+	CONO DTC,200200+UTCCHN(A)
+
+

src/mlsys/mdsk.0

@@ -0,0 +1,57 @@
+;DISK PHYSICAL PARAMETERS
+DSK=250
+
+;DISK COMMANDS
+
+DREADC==000000,,	;READ DATA
+DWRITC==100000,,	;WRITE DATA
+			;OP CODE 2 UNUSED
+DWRITH==300000,,	;WRITE HEADER AND DATA (FORMAT PACK)
+DSEEKC==400000,,	;POSITION HEADS
+DEASEC==500000,,	;CLEAR ATTENTIONS
+DNOOPC==600000,,	;SELECT DRIVE
+DRCALC==700000,,	;RECALIBRATE DRIVE
+
+;BYTE POINTERS FOR ABOVE COMMANDS
+
+DUNFLD==360300,,	;UNIT FIELD (ALL COMMANDS)
+DCYL==261000,,	;CYLINDER FIELD (READ,WRIT,WRITH,SEEK)
+DSURF==210500,,	;SURFACE FIELD (READ,WRIT,WRITH)
+DSECT==140500,,	;SECTOR FIELD (READ,WRIT,WRITH)
+
+;DATAI FIELDS
+
+
+DUNFLI==410300,,		;UNIT FIELD
+DCYLI==311000,,		;CYLINDER FIELD
+
+SKINC==100,,		;SEEK INCOMPLETE
+ONCYL==40,,		;ON CYLINDER
+ONLINE==10,,		;ON LINE
+FUNSAF==4,,		;FILE UNSAFE
+NSCHDR==2,,		;NO SUCH DRIVE
+RDONLY==2,,		;READ ONLY
+
+NOWRIH==400000		;WRITE HEADER LOCKOUT
+
+SECTI==140500,,
+
+ALLATT==776
+
+;CONO INFORMATION
+
+DCLEAR==175710		;CLEAR ALL ERROR CONDITIONS
+
+
+;CONI INFORMATION
+
+PARER==  4000
+SRCER== 40000
+HRDER==130000
+PROER==402300
+WRTER==  1000
+ALLER==577300
+DONE==10
+BUSY==20
+
+

src/mlsys/mdsk.1

@@ -0,0 +1,57 @@
+;DISK PHYSICAL PARAMETERS
+DPC=250
+
+;DISK COMMANDS
+
+DREADC==000000,,	;READ DATA
+DWRITC==100000,,	;WRITE DATA
+			;OP CODE 2 UNUSED
+DWRITH==300000,,	;WRITE HEADER AND DATA (FORMAT PACK)
+DSEEKC==400000,,	;POSITION HEADS
+DEASEC==500000,,	;CLEAR ATTENTIONS
+DNOOPC==600000,,	;SELECT DRIVE
+DRCALC==700000,,	;RECALIBRATE DRIVE
+
+;BYTE POINTERS FOR ABOVE COMMANDS
+
+DUNFLD==360300,,	;UNIT FIELD (ALL COMMANDS)
+DCYL==261000,,	;CYLINDER FIELD (READ,WRIT,WRITH,SEEK)
+DSURF==210500,,	;SURFACE FIELD (READ,WRIT,WRITH)
+DSECT==140500,,	;SECTOR FIELD (READ,WRIT,WRITH)
+
+;DATAI FIELDS
+
+
+DUNFLI==410300,,		;UNIT FIELD
+DCYLI==311000,,		;CYLINDER FIELD
+
+SKINC==100,,		;SEEK INCOMPLETE
+ONCYL==40,,		;ON CYLINDER
+ONLINE==10,,		;ON LINE
+FUNSAF==4,,		;FILE UNSAFE
+NSCHDR==2,,		;NO SUCH DRIVE
+RDONLY==2,,		;READ ONLY
+
+NOWRIH==400000		;WRITE HEADER LOCKOUT
+
+SECTI==140500,,
+
+ALLATT==776
+
+;CONO INFORMATION
+
+DCLEAR==175710		;CLEAR ALL ERROR CONDITIONS
+
+
+;CONI INFORMATION
+
+PARER==  4000
+SRCER== 40000
+HRDER==130000
+PROER==402300
+WRTER==  1000
+ALLER==577300
+DONE==10
+BUSY==20
+
+

src/mlsys/mfsdfs.3

@@ -0,0 +1,97 @@
+
+;FILE SYSTEM PARAMETERS
+
+;PHYSICAL CHARACTERISTICS
+NCYLS==200.	;# CYLINDERS NORMALLY USED
+XCYLS==3	;# EXTRA CYLINDERS FOR SPARES, HACKS, ETC.
+NHEDS==22.	;# TRACKS/CYLINDER (REALLY = (20.*10.)/9)
+NSECS==1	;# SECTORS/TRK
+SECBLK==1	;# SECTORS/BLOCK
+
+;FORMAT
+	;HARDWARE:
+	;	20. TRACKS PER CYLINDER
+	;	10. SECTORS PER TRACK
+	;SOFTWARE
+	;	9 SECTORS PER BLOCK OF WHICH FIRST EIGHT SECTORS
+	;	CONTAINS 2000 WDS OF DATA AND
+	;	FIRST NXWDS OF LAST SECTOR CONTAIN RETRIEVAL INFO.
+
+NSSECS==9	;#HARDWARE SECTORS PER SOFTWARE BLOCK
+NHSECS==10.	;#HARDWARE SECTORS PER HARDWARE TRACK
+NCBLKS==NHEDS*NSECS/SECBLK	;# BLKS/CYL
+NBLKS==NCYLS*NCBLKS	;TOTAL # REG BLKS
+XBLKS==XCYLS*NCBLKS	;# XTRA BLKS
+
+;MFD INFO
+MFDBLK==NBLKS/2-1	;LOC ON DISK
+	;RANDOM INFO
+	MDNUM==0	;ASCENDING DIR NUM
+	MDNAMP==1	;PNTR TO ORG OF NAME AREA
+	MDYEAR==2	;CURRENT YEAR
+	MPDOFF==3	;DE-CORIOLIS CLOCK OFFSET
+	MPDWDK==4	;PREFERED DISK TO WRITE ON (PHYSICAL #)
+	LMIBLK==5	;TOTAL STG USED BY HACKS LIKE THIS
+	;USER NAME BLKS FROM C(MDNAMP) TO END
+	LMNBLK==2	;# WDS/BLK
+	MNUNAM==0	;6BIT USER NAME
+
+;TUT INFO
+TUTBLK==MFDBLK-1	;LOC ON DISK
+TUTBYT==4	;SIZE OF BYTES
+	TUTBP==440000+TUTBYT_6,,
+	TUTEPW==36./TUTBYT
+TUTLK==1_<TUTBYT>-1	;HIGHEST CODE MEANS LOCKED OUT
+QTUTP==1777	;ALLOC PNTR ADV BY CYLS
+QPKNUM==1776	;PACK #
+QPKID==1775	;PACK ID
+QSWAPA==1774	;SWAPPING ALLOCATION
+LTIBLK==4	;STG FOR RANDOM INFO ^
+
+;UFD INFO
+NUDSL==200.	;# UFDS SPACE RESERVED
+	;RANDOM INFO
+	UDESCP==0	;FS PNTR TO DESC AREA
+	UDNAMP==1	;PNTR TO ORG OF NAME AREA
+	UDNAME==2	;USER NAME (FOR CHECKING)
+	UDDESC==11.	;FIRST LOC AVAIL FOR DESC
+	;UFD DESCRIPTORS
+	UDTKMX==12.	;HIGHEST "TAKE N" CODE
+	UDWPH==31.	;PLACE HOLDER ON WRITE (OR NULL FILE)
+	NXLBYT==2	;# ADDITIONAL BYTES FOR LOAD ADDR
+	;NAME AREA DATA
+	LUNBLK==5	;WDS/NAME BLK
+	UNFN1==0	;FIRST FN
+	UNFN2==1	;SECOND FN
+	UNRNDM==2	;ALL KINDS OF RANDOM INFO
+		UNDSCP==1500,,	;PNTR TO DESC
+		UNPKN==150500,,	;PACK #
+		UNLINK==1	;LINK BIT
+		UNWRIT==4	;OPEN FOR WRITING
+		UNMARK==10	;GC MARK BIT
+		UNCDEL==20	;DEL WHEN CLOSED
+		UNPDEL==40	;DEL FROM UNMOUNTED PACK
+		DELBTS==UNCDEL+UNPDEL	;DELETED -- IGNORE
+		UNIGFL==DELBTS+UNWRIT	;BITS TO IGNORE FILE
+		UNDBLK==301300,,	;BLK # DESC BLK (0 => NONE)
+		UNDUMP==400000	;HAS BEEN DUMPED
+	UNDATE==3	;DATE ETC.
+		UNYMD==1200,,	;COMPACTED TIME OF CREATION
+		UNREFT==121000,,	;DAYS SINCE CREATION LAST REF
+;EXTRA WORDS IN DATA BLOCKS
+NXWDS==4	;# XTRA WDS
+BLKSIZ==2000		;EXTRA WORDS ARE DRAWN OUT OF THE BLOCK
+
+	XWBLK==1700,,		;BP TO PREV BLK # IN FILE FLD
+	XWAWC==171200,,	;BP TO ACTIVE WD CNT
+XWSYSN==1
+XWFN1==2
+XWFN2==3
+
+IF1 [
+IFG NUDSL*LMNBLK+LMIBLK-2000,[PRINTX /MFD LOSES
+/]
+IFG NBLKS/<36./TUTBYT>+LTIBLK-2000,[PRINTX /TUT LOSES
+/]
+]
+

src/mlsys/mfsdfs.4

@@ -0,0 +1,98 @@
+
+;FILE SYSTEM PARAMETERS
+
+;PHYSICAL CHARACTERISTICS
+NCYLS==200.	;# CYLINDERS NORMALLY USED
+XCYLS==3	;# EXTRA CYLINDERS FOR SPARES, HACKS, ETC.
+NHEDS==22.	;# TRACKS/CYLINDER (REALLY = (20.*10.)/9)
+NSECS==1	;# SECTORS/TRK
+SECBLK==1	;# SECTORS/BLOCK
+
+;FORMAT
+	;HARDWARE:
+	;	20. TRACKS PER CYLINDER
+	;	10. SECTORS PER TRACK
+	;SOFTWARE
+	;	9 SECTORS PER BLOCK OF WHICH FIRST EIGHT SECTORS
+	;	CONTAINS 2000 WDS OF DATA AND
+	;	FIRST NXWDS OF LAST SECTOR CONTAIN RETRIEVAL INFO.
+
+NSSECS==9	;#HARDWARE SECTORS PER SOFTWARE BLOCK
+NHSECS==10.	;#HARDWARE SECTORS PER HARDWARE TRACK
+NCBLKS==NHEDS*NSECS/SECBLK	;# BLKS/CYL
+NBLKS==NCYLS*NCBLKS	;TOTAL # REG BLKS
+XBLKS==XCYLS*NCBLKS	;# XTRA BLKS
+
+;MFD INFO
+MFDBLK==NBLKS/2-1	;LOC ON DISK
+	;RANDOM INFO
+	MDNUM==0	;ASCENDING DIR NUM
+	MDNAMP==1	;PNTR TO ORG OF NAME AREA
+	MDYEAR==2	;CURRENT YEAR
+	MPDOFF==3	;DE-CORIOLIS CLOCK OFFSET
+	MPDWDK==4	;PREFERED DISK TO WRITE ON (PHYSICAL #)
+	MDCHK==5	;THIS WORD MUST BE M.F.D. (FOR CHECKING)
+	LMIBLK==6	;TOTAL STG USED BY HACKS LIKE THIS
+	;USER NAME BLKS FROM C(MDNAMP) TO END
+	LMNBLK==2	;# WDS/BLK
+	MNUNAM==0	;6BIT USER NAME
+
+;TUT INFO
+TUTBLK==MFDBLK-1	;LOC ON DISK
+TUTBYT==4	;SIZE OF BYTES
+	TUTBP==440000+TUTBYT_6,,
+	TUTEPW==36./TUTBYT
+TUTLK==1_<TUTBYT>-1	;HIGHEST CODE MEANS LOCKED OUT
+QTUTP==1777	;ALLOC PNTR ADV BY CYLS
+QPKNUM==1776	;PACK #
+QPKID==1775	;PACK ID
+QSWAPA==1774	;SWAPPING ALLOCATION
+LTIBLK==4	;STG FOR RANDOM INFO ^
+
+;UFD INFO
+NUDSL==200.	;# UFDS SPACE RESERVED
+	;RANDOM INFO
+	UDESCP==0	;FS PNTR TO DESC AREA
+	UDNAMP==1	;PNTR TO ORG OF NAME AREA
+	UDNAME==2	;USER NAME (FOR CHECKING)
+	UDDESC==11.	;FIRST LOC AVAIL FOR DESC
+	;UFD DESCRIPTORS
+	UDTKMX==12.	;HIGHEST "TAKE N" CODE
+	UDWPH==31.	;PLACE HOLDER ON WRITE (OR NULL FILE)
+	NXLBYT==2	;# ADDITIONAL BYTES FOR LOAD ADDR
+	;NAME AREA DATA
+	LUNBLK==5	;WDS/NAME BLK
+	UNFN1==0	;FIRST FN
+	UNFN2==1	;SECOND FN
+	UNRNDM==2	;ALL KINDS OF RANDOM INFO
+		UNDSCP==1500,,	;PNTR TO DESC
+		UNPKN==150500,,	;PACK #
+		UNLINK==1	;LINK BIT
+		UNWRIT==4	;OPEN FOR WRITING
+		UNMARK==10	;GC MARK BIT
+		UNCDEL==20	;DEL WHEN CLOSED
+		UNPDEL==40	;DEL FROM UNMOUNTED PACK
+		DELBTS==UNCDEL+UNPDEL	;DELETED -- IGNORE
+		UNIGFL==DELBTS+UNWRIT	;BITS TO IGNORE FILE
+		UNDBLK==301300,,	;BLK # DESC BLK (0 => NONE)
+		UNDUMP==400000	;HAS BEEN DUMPED
+	UNDATE==3	;DATE ETC.
+		UNYMD==1200,,	;COMPACTED TIME OF CREATION
+		UNREFT==121000,,	;DAYS SINCE CREATION LAST REF
+;EXTRA WORDS IN DATA BLOCKS
+NXWDS==4	;# XTRA WDS
+BLKSIZ==2000		;EXTRA WORDS ARE DRAWN OUT OF THE BLOCK
+
+	XWBLK==1700,,		;BP TO PREV BLK # IN FILE FLD
+	XWAWC==171200,,	;BP TO ACTIVE WD CNT
+XWSYSN==1
+XWFN1==2
+XWFN2==3
+
+IF1 [
+IFG NUDSL*LMNBLK+LMIBLK-2000,[PRINTX /MFD LOSES
+/]
+IFG NBLKS/<36./TUTBYT>+LTIBLK-2000,[PRINTX /TUT LOSES
+/]
+]
+