TITLE	MAGDMP TAPE CREATOR

.MLLIT==1

A=1
B=2
C=3
D=4
E=5
TT=6
;I=7
;Q=10
MCHN=10		;MACHINE INDEX
J=11
R=12
W=13
H=14
P=15
T=16
U=17

TYIC==1
TYOC==2
DKIC==3
DKOC==4
MTCH==5
ERRC==6

..ERR=001000,,
.TYP=002000,,
.WERR=003000,,
.6TYP=004000,,
UUOMAX==4

DEFINE	ERR X
	..ERR [ASCIZ \X\]TERMIN

DEFINE	TYP X
IFSE [X]CRLF,.IOT TYOC,[15]
IFSN [X]CRLF,.TYP [ASCIZ \X\]
TERMIN

DEFINE	WERR X
	.WERR [ASCIZ \X\]TERMIN

%TICLC==10000		;CONVERT LOWER CASE

PAT:
LOC	41
	JSR UUOH
	JSR TSINT
LOC	PAT
PATCH:	BLOCK 100

MCHNTB:	OFFSET -.
AIMCHN::SIXBIT/AI/
MLMCHN::SIXBIT/ML/
DMMCHN::SIXBIT/DM/
MCMCHN::SIXBIT/MC/
KAMCHN::SIXBIT/KA/
LMCHNTB:: OFFSET 0

GO:	MOVE P,[-LPDL-1,,PDL-1]
	.OPEN TYIC,[%TICLC+.UAI,,'TTY]
	 .VALUE
	.OPEN TYOC,[.UAO,,'TTY]
	 .VALUE
	.CALL [ SETZ		;SET UP ^G ^S INTERRUPTS
		'TTYSET
		MOVEI TYIC
		[222622222222]
		SETZ [232222220222]]
	 .VALUE
	.6TYP [.FNAM1]
	TYP .
	.6TYP [.FNAM2]
	TYP CRLF
WHMCHN:	TYP FOR WHICH MACHINE? 
	PUSHJ P,GETSYL
	 JRST BDMCHN
	JUMPE B,[.CALL [SETZ		;THIS ONE
			'SSTATU
			REPEAT 5, MOVEM A
			SETZM B]
		  .VALUE
		 JRST .+1 ]
	MOVSI A,-LMCHNTB	
	CAME B,MCHNTB(A)
	 AOBJN A,.-1
	JUMPL A,WHMCH0
BDMCHN:	TYP [???
]
	JRST WHMCHN

WHMCH0:	HRRZ MCHN,A
	PUSHJ P,REW
	TYP [TAPE REWOUND
INITIALIZE]
	PUSHJ P,Y.OR.N
	 CAIA
	  PUSHJ P,MTINI	;INITIALIZE THE TAPE
	CAIN MCHN,MCMCHN
	 JRST DIRIN	;MC IS A KL10, WHICH DOESN'T HAVE READIN MODE
	MOVE A,[-20,,BUF]
	.IOT MTCH,A	;READ FIRST 20 WORDS
	JUMPL A,[ERR MAGDMP HRI FILE TOO SHORT,]
	MOVSI A,-20
INICHK:	MOVE B,BUF(A)
	CAMN B,MTHRI(A)
	 AOBJN A,INICHK
	JUMPL A,[ERR FIRST FILE ON TAPE NOT IN HRI MODE,]
DIRIN:	MOVEI T,DIR
DIRINL:	MOVE A,[MTCH,,H]
	MOVE H,[1,,7]
	.MTAPE A,	;SPACE TO BEGINNING OF NEXT FILE
	ERR COULDN'T SPACE TO BEGINNING OF HEADER FILE
	.OPEN MTCH,[26,,(SIXBIT /MT0/)]
	ERR OPEN FAILED AT DIRINL?
	HRLI T,-3
	.IOT MTCH,T	;GET FIRST 3 WORDS OF HEADER
	JUMPL T,DIREOF
	CAIN T,DIRF
	 JRST DIRIN1	;DIRECTORY NOW FULL
	MOVE A,[MTCH,,H]
	MOVE H,[1,,7]
	.MTAPE A,	;SPACE TO BEGINNING OF NEXT FILE
	ERR COULDN'T SPACE TO BEGINNING OF ACTUAL FILE
	JRST DIRINL

DIREOF:	TLNE T,2	;SKIP IF LH(T) = -3
	 ERR HEADER FILE SHORT
DIRIN1:	HRRZM T,DIREND
UUOERR:	MOVE P,[-LPDL-1,,PDL-1]
	.SUSET [.SMSK2,,[1_TYIC]]
	PUSHJ P,REW
;DROPS THROUGH;DROPS IN
INLUP:	TYP [
_]
	.IOT TYIC,A
	CAIN A,"?
	 JRST LISTCM
	CAIN A,"D
	 JRST DIDE
	CAIN A,"I
	 JRST INIT
	CAIN A,"R
	 JRST READ
	CAIN A,"W
	 JRST WRITE
	CAIN A,"P
	 JRST POSITN
	CAIN A,"Q
	 .BREAK 16,040000
INLOSE:	TYP ?
	JRST INLUP

LISTCM:	TYP [
Directory
Initialize
Position
Read
Write
Quit
]
	JRST INLUP

DEL:	TYP LETE - not implemented
	JRST INLOSE

DIDE:;	.IOT TYIC,A
;	CAIN A,"E
;	 JRST DEL
;	CAIE A,"I	;DIRECTORY
;	 JRST INLOSE
	TYP [IRECTORY
]
	MOVEI W,DIR
DIRTL:	CAMN W,DIREND
	 JRST INLUP
	.6TYP (W)	;FN1
	TYP [  ]
	.6TYP 1(W)	;FN2
	.6TYP 2(W)	;VERSION #
	TYP CRLF
	ADDI W,3
	JRST DIRTL

INIT:	TYP NITIALIZE
	PUSHJ P,Y.OR.N
	 JRST INLOSE
	PUSHJ P,MTINI
	JRST INLUP

Y.OR.N:	TYP [ (Y or N)? ]
	.IOT TYIC,A
	TYP CRLF
	CAIE A,"Y
	CAIN A,"y
	 JRST POPJ1
	CAIE A,"N
	CAIN A,"n
	 POPJ P,
	.IOT TYOC,[7]
	JRST Y.OR.N

WRITE:	TYP [RITE ]
	SKIPA
WRITL1:	 TYP CRLF
	TYP FROM 
	PUSHJ P,GETDKF
	 JRST WRITL1
	HRRZ A,DEV
	CAIN A,(SIXBIT /MT0/)
	 WERR CAN'T READ FROM MT0
	MOVEI A,.BII
	HRLM A,DEV
	.OPEN DKIC,DEV
	 WERR FILE NOT FOUND
	SKIPA
WRITL2:	 TYP CRLF
	TYP ONTO TAPE FILE 
	PUSHJ P,GETMTF
	 JRST WRITL2
	MOVNI T,1	;INDICATE WRITING
	MOVE W,FN1
	MOVE H,FN2
	MOVE J,VERNO
	PUSHJ P,LOOK
	 WERR VERSION ALREADY EXISTS
	MOVE A,DIREND
	CAIN A,DIRF
	 WERR DIRECTORY FULL
	ADDI A,3
	EXCH A,DIREND
	MOVEM W,(A)
	MOVEM H,1(A)
	HRRZM J,2(A)
	MOVE H,[1,,10]
	MOVEM H,TEM
	MOVE H,[MTCH,,TEM]
	.MTAPE H,	;SKIP TO LOGICAL END OF TAPE
	 ERR CAN'T SKIP TO END OF TAPE
	.OPEN MTCH,[.BIO,,(SIXBIT /MT0/)]
	 WERR MAG TAPE LOSING
	HRLI A,-3
	.IOT MTCH,A	;WRITE HEADER
	.OPEN MTCH,[.BIO,,(SIXBIT /MT0/)]	;WRITE EOF
	 ERR COULDN'T WRITE EOF AFTER HEADER
	PUSHJ P,MTWRT
	JRST INLUP

READ:	TYP EAD 
	SETZM POSF'
READL0:	SKIPA
READL1:	 TYP CRLF
	SKIPN POSF
	 TYP FROM
	SKIPE POSF
	 TYP TO
	TYP  TAPE FILE 
	PUSHJ P,GETMTF
	 JRST READL1
	MOVEI T,0	;INDICATES READING
	MOVE W,FN1
	MOVE H,FN2
	MOVE J,VERNO
	PUSHJ P,LOOK	;D GETS DIR + INDEX*3
	 WERR FILE NOT FOUND
	SKIPE POSF
	 JRST READL4
	PUSH P,D
	SKIPA
READL2:	 TYP CRLF
	TYP INTO 
	PUSHJ P,GETDKF
	 JRST READL2
	HRRZ A,DEV
	CAIN A,(SIXBIT /MT0/)
	 WERR CAN'T WRITE ONTO MT0
	MOVEI A,.BIO
	HRLM A,DEV
	.OPEN DKOC,DEV
	 WERR OPEN FOR WRITING FAILED
	POP P,D
READL4:	SUBI D,DIR
	IDIVI D,3
	LSH D,1
	ADDI D,1	;# FILES -1 TO SKIP
READL3:	MOVE A,[1,,7]
	MOVEM A,TEM
	MOVE A,[MTCH,,TEM]
	.MTAPE A,	;SPACE TO BEGINNING OF NEXT FILE
	 ERR CAN'T SPACE TO BEGINNING OF FILE
	SOJGE D,READL3
	SKIPE POSF
	 .BREAK 16,040000	;P COMMAND, LET DDT READ TAPE
	PUSHJ P,MTRD
	JRST INLUP	

POSITN:	TYP OSITION 
	SETOM POSF'
	JRST READL0

GETDKF:	MOVSI A,(SIXBIT /@/)
	MOVEM A,FN1
	MOVEM A,FN2
	MOVNI D,2
	MOVEI A,(SIXBIT /DSK/)
	HRRM A,DEV
	.SUSET [.RSNAM,,SNAME]
GETDK1:	PUSHJ P,GETSYL
	 POPJ P,	;RUBOUT
	CAIN A,":
	 HLRM B,DEV
	CAIN A,";
	 MOVEM B,SNAME
	CAIN A,33
	 JRST GETDK3
	CAIE A,12
	CAIN A,15
	 JRST GETDK3
	CAIE A,40
	 JRST GETDK1	;MUST HAVE BEEN ; OR :
	AOJG D,GETDK2
	MOVEM B,FN1+1(D)
	JRST GETDK1

GETDK2:	HLRM B,DEV
	JRST GETDK1

GETDK3:	JUMPE B,GETDK4
	AOJG D,GETDK5
	MOVEM B,FN1+1(D)
	JRST GETDK4

GETDK5:	HLRM B,DEV
GETDK4:	.SUSET [.SSNAM,,SNAME]
POPJ1:	AOS (P)
CPOPJ:	POPJ P,

GETMTF:	MOVSI A,(SIXBIT /@/)
	MOVEM A,FN1
	MOVEM A,FN2
	SETZM VERNO
	MOVNI D,2
GETMT1:	PUSHJ P,GETSYL
	 POPJ P,	;RUBOUT
	CAIN A,33
	 JRST GETMT6
	CAIE A,12
	CAIN A,15
	 JRST GETMT6
	AOJG D,GETMT2
	MOVEM B,FN1+1(D)
	JRST GETMT1

GETMT2:	HLRZS B		;VERSION NO
	JUMPE B,GETMT5
	MOVE C,[220600,,B]
GETMT3:	TLNN C,770000
	 JRST GETMT5
	ILDB A,C
	JUMPE A,GETMT4
	CAIL A,'0
	CAILE A,'9
	 POPJ P,	;BAD VERSION #
	JRST GETMT3

GETMT4:	LSH B,-6
	TRNN B,77
	 JRST GETMT4
	IORI B,202020
GETMT5:	MOVEM B,VERNO
	JRST POPJ1

GETMT6:	AOJG D,GETMT2
	MOVEM B,FN1+1(D)
	JRST POPJ1

;SET UP W=FN1, H=FN2, J=VER # OR 0, T < 0 FOR WRITE
;DOESN'T SKIP IF TRYING TO READ AND NOT FOUND OR TRYING TO WRITE AND FOUND
;RETURNS INDEX IN D FOR READ, VER # IN J FOR WRITE

LOOK:	SETOB B,D	;B = HIGHEST VER # FOUND, D = INDEX
	MOVEI A,DIR
LOOKL:	CAMN A,DIREND
	 JRST LOOKE1
	CAMN W,(A)
	CAME H,1(A)
	 JRST LOOKE
	HRRZ C,2(A)
	JUMPE J,LOOK1
	CAMN C,J
	 JRST LOOK2
LOOKE:	ADDI A,3
	JRST LOOKL

LOOKE1:	JUMPL T,LOOKW	;WRITE
	JUMPL D,CPOPJ	;NOT FOUND FOR READ
LOOK2:	JUMPL T,CPOPJ	;WRITING VERNO AND FOUND IT
	JUMPE J,POPJ1
	MOVE D,A
	JRST POPJ1

LOOK1:	CAMG C,B
	 JRST LOOKE
	MOVE B,C
	MOVE D,A
	JRST LOOKE

LOOKW:	JUMPN J,POPJ1	;VERSION # GIVEN
	SKIPGE B
	 MOVEI B,202020
	SUBI B,9_6+9
	TRNN B,20
	 JRST LOOKW1
	TRNE B,20_6
	 ADDI B,1_12.-10._6
	ADDI B,10._6-<9_6+10.>
LOOKW1:	HRRZI J,<9_6+10.>(B)
	JRST POPJ1

GETSYL:	MOVEI B,0
	MOVE C,[440600,,B]
GETSY3:.IOT TYIC,A
	CAIN A,40
	 JRST GETSY3
	JRST GETSY2

GETSY1:	.IOT TYIC,A
GETSY2:	CAIN A,^Q
	 JRST GETSYQ
	CAIE A,";
	CAIN A,":
	 JRST POPJ1
	CAIE A,40
	CAIN A,15
	 JRST POPJ1
	CAIE A,33
	CAIN A,12
	 JRST POPJ1
	CAIN A,177
	 POPJ P,
GETSY4:	SUBI A,40
	TLNE C,770000
	 IDPB A,C
	JRST GETSY1

GETSYQ:	.IOT TYIC,A
	JRST GETSY4

MTRD:	MOVE A,[-200,,BUF]
	.IOT MTCH,A
	HRLOI B,-<BUF+1>(A)
	EQVI B,BUF
	.IOT DKOC,B
	JUMPGE A,MTRD
	.CLOSE DKOC,
	JRST REW

MTWRT:	MOVE A,[-200,,BUF]
	.IOT DKIC,A
	HRLOI B,-<BUF+1>(A)
	EQVI B,BUF
	.IOT MTCH,B
	JUMPGE A,MTWRT
	.CLOSE DKIC,
REW:	.OPEN MTCH,[26,,(SIXBIT /MT0/)]
	 ERR MAG TAPE NOT AVAILABLE
	MOVE A,[MTCH,,[1]]
	.MTAPE A,	;REWIND
	 .VALUE
	POPJ P,

MTINI:	.OPEN MTCH,[7,,(SIXBIT /MT0/)]
	 ERR MAG TAPE NOT AVAILABLE
	CAIN MCHN,MCMCHN
	 JRST MTINI1
	MOVE A,[-20,,MTHRI]
	.IOT MTCH,A	;WRITE HRI LOADER
	PUSHJ P,MDBOPN
MTINIL:	HRROI A,B
	.IOT DKIC,A
	JUMPL A,[ERR COULDN'T FIND JRST 1 IN . MAGDMP BIN,]
	CAME B,[JRST 1]
	 JRST MTINIL
	PUSHJ P,MTWRT
MTINI0:	TYP [TAPE INITIALIZED
]
	MOVEI T,DIR
	MOVEM T,DIREND	
	POPJ P,

MTHRI:	-17,,0		;0  NOTE: TM10B USES I/O BUS IN HRI MODE
	JFCL		;1
	HRRI 11,4	;2
	CONSO 344,1	;3
	JRST 3		;4
	ROT -2(11)	;5
	DATAI 340,@10(11) ;6
	XCT 10(11)	;7
	XCT 13(11)	;10
	SOJA 11,0	;11
	CAME 17		;12
	ADD (17)	;13
	SKIPL 17,0	;14
	JRST 4,15	;15
	AOBJN 17,3	;16
	JRST 2		;17

MDBOPN:	.SUSET [.RSNAM,,SNAME]
	.SUSET [.SSNAM,,[SIXBIT /./]]
	MOVE A,MDBFN2(MCHN)
	MOVEM A,MGDBIN+2
	.OPEN DKIC,MGDBIN
	 CAIA
	  JRST MDBOP1
	.6TYP MGDBIN+1
	TYP [ ]
	.6TYP MGDBIN+2
	ERR [ NOT IN . DIRECTORY]

MDBOP1:	.SUSET [.SSNAM,,SNAME]
	POPJ P,

MTINI1:	PUSHJ P,MDBOPN		;INITIALIZE NON-HARDWARE-READIN TAPE
	.CALL [SETZ ? SIXBIT/LOAD/ ? MOVEI -1 ? SETZI DKIC]	;LOAD UP MAGDMP
	 ERR CAN'T LOAD UP MAGDMP
	MOVE A,[-601,,-601]	;DUMP IT OUT OF UPPER CORE WHERE IT LOADED
	.IOT MTCH,A
	.CORE <HICORE+1777>/2000 ;AND DELETE THE UPPER CORE
	 JFCL
	.CLOSE DKIC,
	PUSHJ P,REW
	JRST MTINI0

UUOH:	0
	MOVEM 17,UUOACS+17
	MOVEI 17,UUOACS
	BLT 17,UUOACS+16
	LDB T,[331100,,40]	;OP CODE
	JUMPE T,ILUUO
	CAILE T,UUOMAX
	 JRST ILUUO
	LDB R,[270400,,40]	;AC FIELD
	HRRZ A,40	;EFFECTIVE ADDRESS
	MOVE P,UUOPDP
	PUSHJ P,@UUODTB-1(T)
	 JRST .+2
	AOS UUOH
URET:	MOVSI 17,UUOACS
	BLT 17,17
	JRST 2,@UUOH

UUODTB:	AERR
	ATYP
	AWERR
	A6TYP

ILUUO:	.VALUE [ASCIZ /:ILLEGAL UUO /]

AERR:	PUSHJ P,AXERR
	.VALUE

ATYP:	HRLI A,440700
TYPE:	ILDB B,A
	JUMPE B,CPOPJ
	.IOT TYOC,B
	JRST TYPE

AWERR:	PUSHJ P,AXERR
	MOVEI A,UUOERR
	MOVEM A,UUOH
	POPJ P,

AXERR:	.IOT TYOC,[15]
	PUSHJ P,ATYP
	.SUSET [.RBCHN,,A]
	MOVSI A,.RIOS(A)
	HRRI A,A
	.SUSET A
	TLNE A,-1		;SUPPRESS ISE0
	 .OPEN ERRC,[.UAI,,'ERR ? 1]
	  JRST AXERR2
	MOVEI A,[ASCIZ/ - /]
	PUSHJ P,ATYP
AXERR1:	.IOT ERRC,A
	CAIGE A,40
	 JRST AXERR2
	.IOT TYOC,A
	JRST AXERR1

AXERR2:	.CLOSE ERRC,
	.SUSET [.SBCHN,,[0]]	;ONCE ONLY
	.IOT TYOC,[15]
	POPJ P,

A6TYP:	MOVE A,@40
	LSHC A,-36.
A6TYPL:	LSHC A,6
	ADDI A,40
	.IOT TYOC,A
	MOVEI A,0
	JUMPN B,A6TYPL
	POPJ P,

TSINT:	0		;ONLY TYI INTERRUPTS CAN COME HERE
	0
	MOVEM A,TSINTA
	MOVEI A,TYIC
	.ITYIC A,
	 JRST TSINTX
	CAIE A,^G
	 JRST TSINTX
	.RESET TYIC,
	.RESET TYOC,
	.DISMISS [.+1]
	WERR ?QUIT? 

TSINTX:	MOVE A,TSINTA
	.DISMISS TSINT+1

;MTAPE1:	SETZ
;	SIXBIT /MTAPE/
;	1000,,MTCH
;	1000,,0
;	401000,,6
;
;MTAPE2:	SETZ
;	SIXBIT /MTAPE/
;	1000,,MTCH
;	1000,,0
;	401000,,1

TEM:	0

MGDBIN:	6,,(SIXBIT /DSK/)
	SIXBIT /MAGDMP/
	SIXBIT /BIN/

MDBFN2:	IRPS X,,[AI ML DM MC KA]
	 SIXBIT/BIN.!X/
	TERMIN

LPDL==20
PDL:	BLOCK LPDL
LUUPDL==10
UUOPDP:	-LUUPDL-1,,UUOPDL-1
UUOPDL:	BLOCK LUUPDL
UUOACS:	BLOCK 20
TSINTA:	0
BUF:	BLOCK 200
DIR:	BLOCK 20.*3
DIRF:
DIREND:	0

DEV:	0
FN1:	0
FN2:	0
SNAME:	0
VERNO:	0

CONSTANTS
VARIABLES
HICORE:
END	GO