*20
//MOD40
	 
/DECODE MODULE 40
/BLOCK 62
	 
/CONTENTS
/   MSTORIT
/   TABPUT
	 
	LODSYM
	 
	SEGMNT 4
	*1400
	40
	 
	 
	JMP OUTSET
	LDA I
	FILNAM-1
	JMP MSCAN
	 JMP .+3	/NOT PRESENT
	JMP REPLAX	/FILE PRESENT
	JMP DOSTOR	/REPLACE
	LDA I
	NULL-1
	JMP MSCAN
	 JMP FULL	/TAPE FULL
DOSTOR,	LDA		/SLOT AVAILABLE
	FILNAM
	STA I FILPTR
	LDA
	FILNAM+1
	STA I FILPTR
	LDA
	BETA1
	ADA I
	125
	MUL I
	5
	ADD ONE
	BSE I
	5000
	STA I FILPTR
	STC FILNAM+2
/
	JMP BLDWRD
	JMP SETWRI
	ADD CURU
	JMP SETU
	JMP XFER
	JMP EX1
/
TABNAM,	SET 15
	0
	FETCH
	ROL 2
	ADA I
	TABTAB
	STC BETA2
	LDA BETA2
	STC TABDF
	LDA I BETA2
	STC BETA3
	LDA I BETA2
	STC TABEND
	LDA I BETA2
	STA
	TABLOC
	ADD BETA3
	STC BETA3
/
	ADD TABLOC
TABLUP,	SAE
	TABEND
	SKP
	JMP GOUSER 	/END OF TABLE
TABDF,	LDF 	/DF OF TABLE
	LDA BETA3
	AZE I
	JMP NOTNAM
	STC FILNAM
	LDA I BETA3
	STC FILNAM+1
	JMP INCLOC
	LDF 3
	JMP 15
NOTNAM,	LDA I BETA3
	JMP INCLOC
	JMP TABLUP
	EJECT
INCLOC,	LDA I BETA3
	LDA I
	2
	ADM
	TABLOC
	STA BETA2 	/UPDATE PTR
	JMP 0
	EJECT
DIR,	ADD 0
	STC DIRX
	ADD CURU
	JMP SETU
	LDA I
	6000
	JMP RWBLK
	LDF 3
DIRX,	JMP
/
SETRDE,	LDA I
	RDC
	STC RW
	LDA I
	IOB 12
	STC OI
	JMP 0
/
SETWRI,	LDA I
	WRC
	STC RW
	LDA I
	IOB I 12
	STC OI
	JMP 0
	EJECT
	 
	 
OUTSET,	LDA
	0
	STC OUTX
	STC ASSFLG	/CLR FLAG
	ADD OUTFLG
	APO I
	JMP OUTX	/SET, LEAVE
/OUTFLG NOT SET, CHECK INFLG
	LDA
	INFLG
	APO
	JMP CKSAV-2	/NOT SET
/INFLG SET, SAVE INPUT DIR
	IOB I 12
	6066
	ADD M1
	STC MTEM
	JMP CKSAV
/
	CLR
	STC MTEM
/CHECK FOR SAVED OUTPUT DIR
CKSAV,	ADD SAVDIR
	ADD M1
	AZE
	JMP FSTOUT	/NONE SAVED
/SAVED OUTPUT DIR, GET IT
	SET BETA1
	OUPTR
	LDH BETA1
	STC CURU
	IOB 12
	6067
	SKP
	 
/GET FIRST OUTPUT DIR
FSTOUT,	JMP NXU
	 
	ADD MTEM
	STC SAVDIR
	STC OUTFLG	/SET FLAG
	COM
	STC INFLG	/CLR FLAG
	 
OUTX,	JMP 		/EXIT
	EJECT
/ROUTINE TO SCAN
/CURRENT INDEX DIRECTORY
/SCANS FOR ETITHER A
/MATCH OF FILE NAMES
/OR FOR THE NEXT 
/AVAILABLE SLOT
/IF SCAN OF CURRENT
/INDEX IS FRUITLESS,
/THEN NEXT INDEX FROM
/INUNIT OR OUTUNIT LIST
/IS READ IN AND SCANNED
/
MSCAN,	SET 15
	0
	STC IDXLUP+1
	ADD OTCNT
	COM
	STC BETA3
MSCNXT,	SETFIL
	SET I BETA1
	-125
IDXLUP,	SET I BETA2
	NULL-1		/OR FILNAM-1
	LDA I FILPTR
	SAE I BETA2
	JMP NOTIDX
	LDA I FILPTR
	SAE I BETA2
	JMP NOTIDX+1
	LDA I		/GOT IT
	-2
	ADD FILPTR
	STC FILPTR
	STC FILNAM+2
	XSK I 15 
	JMP 15
/
NOTIDX,	LDA I FILPTR
	LDA I FILPTR
	XSK I BETA1
	JMP IDXLUP
/DEASSIGN DIRECTORY
	JMP SETWRI
	JMP DIR
/GET NEXT INDEX
	JMP NXU
	XSK I BETA3
	JMP MSCNXT
	JMP 15 	/NO FIND
/
NXU,	SET 14
	0
	SET BETA4
	OUPTR
	LDH I BETA4
	SHD I
	7700 	/LIST TERMINATOR
	JMP NXX
	STC CURU
	JMP SETRDE
	JMP DIR
	LDA
	BETA4
	STC OUPTR
	JMP 14
NXX,	LDA I
	4\OUTLST-1
	STC OUPTR
	JMP NXU+2
	EJECT
/ROUTINE TO TRANSFER
/FILE FROM CORE TO 
/DISK-TAPE OR VICE
/VERSA.
/SET UP FROM WORD1 AND WORD2
/
XFER,	SET BETA4
	0
	ADD TUMB1
	STC TU1
	ADD TUMB2
	STC TU2
	ADD CNT1 	/CNTR, WORD1
	AZE I
	JMP WRD2
	STC BETA3
TU1,	0 	/UMB, WORD1
	ADD TAPWRD 	/QN-BN, WORD1
	JMP RWBLK
	ADA I
	1001
	STC TAPWRD
	XSK I BETA3
	JMP TU1+1
WRD2,	SRO I
	5252
	JMP BETA4
	ADD CNT2 	/CNTR, WORD2
	STC BETA3
	ADD TAPWR2 	/QN-BN, WORD2
	STC TAPWRD
TU2,	0 	/UMB, WORD2
	JMP TU1+1
	EJECT
/ROUTINE TO SET AXO
/TAPE UNIT. ENTER WITH
/UNIT NO. IN AC
/
SETU,	SCR 1
	STC XT 	/FOR XOB
	ADD CURU
	BCL I
	7776
	ROL 3
	BSE I
RW,	RDC 	/OR WRC
	STC XU 	/TAPE COMMAND
	JMP 0
	EJECT
/ROUTINE TO READ OR 
/WRITE FILES.
/HANDLES MULTIPLE TAPE
/OR DISK UNITS.
/ENTER WITH QN-BN IN AC
/
RWBLK,	STC RB
	ADD 0
	STC RBX
	ADD CURU
	ADA I
	-7
	APO I
	JMP RDSK
	LDA I
XT,	0
	AXO
XU,	RDC 	/OR WRC
RB,	0
	SETAXO
	ADD RB
RBX,	JMP
/DISK
RDSK,	ADD M1
	APO
	CLR
	STC .+2
/SET DISK PARTITION
	IOB 13
	0
/OPERATE DISK
	ADD RB
	STC .+2
OI,	IOB 12 	/OR OPR I 12
	0
	IOB 13
	0
AA40,	JMP RBX-1
/
/
/MOD40
/FEB 74