/ROUTINE TO CONVERT ASCII TO TSS/8 SIXBIT

ASCSIX,	0
	CLL STA RAL		/SET AC=-2
	DCA	ASCNT
	TAD	INBUF
	DCA	ASCI6		/INPUT BUFFER
	TAD I	ASCSIX
	DCA	ASCI7		/POINTER TO OUTPUT VECTOR
	ISZ	ASCSIX
ASCI1,	JMS	ASCGET		/GET ONE CHARACTER
	CLL RTL
	RTL
	RTL			/SHIFT TO HIGH ORDER
	DCA I	ASCI7		/SAVE THE CHARACTER
	CHDF
	JMS	ASCGET		/GO GET ANOTHER CHARACTER
	TAD I	ASCI7		/PACK IT IN WITH THE LAST ONE
	DCA I	ASCI7		/AND SAVE IT
	ISZ	ASCI7
	CHDF
	ISZ	ASCNT		/DONE?
	JMP	ASCI1		/NO
	JMP I	ASCSIX		/YES, EXIT

ASC240,	-240

ASCGET,	0			/GET A PASSWORD CHARACTER, EXIT UPON CARRIAGE RETURN
	TAD I	ASCI6		/GET NEXT CHARACTER
	TAD	ASCCR
	SNA CLA			/IS IT CR?
	JMP I	ASCSIX		/YES, RETURN
	TAD I	ASCI6
	ISZ	ASCI6
	TAD	ASC240		/PASSWORDS ARE STORED IN EXCESS 240 CODE
	DATFLD
	JMP I	ASCGET

ASCCR,	-215
CSQ,	TEXT "ENABLE ^S FEATURE? "
*INIP+2200

/USES INIT'S BINARY LOADER TO LOAD INTO FIELD 1
	ZERO1			/ZERO FIELD 1
	DATFLD
Y1,	JMS I	BINLD		/GO LOAD BINARY TAPE
	SKP			/FIELD SETTING ENCOUNTERED
	JMP I	SUPERA		/END OF TAPE
	DCA	DISC0		/SAVE IT
	RDF
	CIA
	TAD	DISC0		/IS IT THE CURRENT FIELD ANYWAY?
	SNA CLA
	JMP I	BINT3B		/YES - SO IT'S OK
	TAD	DISC0		/NO - LET HIM/HER KNOW ABOUT IT
	HLT
	CLA			/IGNORE FIELD SETTING
	JMP I	BINT3B

BINLD,	BINTAP
BINT3B,	BINT3

Y,	JMS I	STFLDA
	JMP	Y1

STFLDA,	STFLD

RDORWT,	TEXT "READ OR WRITE - "
FIELD1,	TEXT "FIELD NUMBER - "
TRACK,	TEXT "TRACK NUMBER - "
TAPMES,	TEXT "_TAPE "
TIMESS,	TEXT "HR:MIN - "
NUMBLK,	TEXT "# - "
YN,	TEXT "YES OR NO... "
/DISK READ OR WRITE
/CALL	DISC
/	FUNCTION
/	DEAL ARGUMENTS (DISC EXTENSION IN BITS 1-8; MEMORY FIELD IN BITS 9-11)
/	DISCHK
/	RETURN HERE WHEN OK

DISC=	JMS I DISCA
DISCHK=	JMS I DISCHA


DISC0,	0
	RDF
	TAD	C6201
	DCA	DISC2
	CHDF
	TAD I	DISC0
	DCA	DISROW
	ISZ	DISC0
	TAD I	DISC0
	DCA	DEALSV		/SAVE THE DEAL ARGUMENTS
	TAD	DEALSV
IFZERO RF08-40 <	ISZ DISC0
	CLL RTL
	RAL
	DEAL
	CLA CLL>
IFZERO RF08 <	RTL
	RAL
	AND	C0070
	DIML
	TAD I	DISC0
	CLL RTR
	ISZ	DISC0
	RAR
	DXAL>
	CDF
	DCA I	C7750
	STA
	DCA I	C7751
DISROW,	0
	JMP I	DISC0

C0070,	70
C7750,	7750
C7751,	7751


/SUBROUTINE TO WAIT FOR DISK COMPLETION, CHECK FOR ERRORS, AND
/IF THERE ARE ANY ERRORS, RETRY THE OPERATION.

DISCH0,	0
	CLL STA RTL
	DCA	RFTRY		/TRY 3 TIMES
IFZERO RF08 <DFSE DFSC>
IFNZRO RF08 <DFSC>
	JMP	.-1		/WAIT FOR THE DISK TO FINISH
	DFSE			/ERROR?
IFZERO RF08-40 <SKP>		/DF32 SKIPS BACKWARDS
	JMP	DISC2		/NO
	DIMA
	AND	DSKFLG		/CHECK WLS, DRL, PER
	CDF
	SNA
	TAD I	C7750		/MAYBE NXD - IS WC=0?
DISC2,	.-.			/CDF -- RESTORE DATA FIELD
	SNA			/OK?
	JMP I	DISCH0		/I GUESS SO
	ISZ	RFTRY		/3 TRIES YET?
	CLA SKP
	JMP	DISERR		/DISK WRITE LOCKED, PARITY ERROR, OR DRL
	TAD	DISROW		/GET OLD DMAR OR DMAW
	DCA	.+2
	DISC
	0
DEALSV,	0			/DEAL ARGUMENTS SAVED BY LAST DISC CALL
	JMP	DISCH0+3

DSKFLG,	IFZERO RF08 <1005>
	IFZERO RF08-40 <0007>
RFTRY,	0			/RETRY COUNT FOR DISK ERRORS

DISERR,	MESSAG
	DISKER
	JMP I	SUPERA
DISKER,	TEXT "_DISK ERROR"
*INIP+2400

/DISC DUMP ON DTA1
/DECTAPE BLOCK 40N+1=DISC TRACK N

DSKDMP,	JMS I	RWA		/GO TO INITIALIZE CHDF, PRINT MESSAGE,
	TAPMES			/AND DETERMINE READ OR WRITE
	DCA	DTA
	MESSAG
	NUMBLK
	GETIN
	OCTIN
	CIA
	SNA
DSKSUP,	TAD	DSKSZ
	DCA	LDFCNT		/SAVE DISK TRACK COUNT
	DCA	RFFUNC		/WELL, FOLKS, THE FOLLOWING ROUTINE
	CHDF			/ONLY WORKS IN FIELD 0, SO HERE
	TAD I	RFFUNC		/WE GO, MOVING EVERYTHING DOWN TO
	CDF			/FIELD 0 SO THAT IT WILL BE HAPPY
	DCA I	RFFUNC
	ISZ	RFFUNC
	JMP	.-5
	CIF CDF			/AND DOWN TO FIELD 0!
	JMP	.+1
	TAD	.-2
	DCA	INIF		/SET UP CHDF FOR FIELD 0
	TAD	DTA		/IS IT LOAD OR DUMP??
	CLL
	SNA CLA
	STL
	SNL			/SKIP IF READ
	TAD	C0020
	TAD	C0030
	DCA I	DTFUNA		/SAVE FUNCTION FOR DECTAPE
	TAD	RFDMAR
	SZL			/SKIP IF DISK READ
	TAD	C0002		/MAKE IT DMAW
	DCA	RFFUNC		/SAVE DMAR OR DMAW
	TAD	LDFCNT
	RAL
	DCA	LDFCNT		/FUDGE LDFCNT SO THAT IT ISZES TO 0 AT THE RIGHT TIME
	DCA I	DTBLKA		/START AT DECTAPE BLOCK 1
	TAD	C1000
	DTLA			/START WITH DECTAPE DRIVE 1
	IAC
	DCA	RFTRAK		/START WITH RF08/DF32 TRACK 0 FIELD 1
	TAD	C0010
	DCA I	DTFLDA		/START WITH DECTAPE FIELD 1
	TAD	DTA
	SZA CLA			/LOAD OR DUMP?
	JMP	DMPINI		/MUST BE DUMP
	JMS I	DTRWA		/READ FIRST TRACK FROM DECTAPE
	DISC			/READ OR WRITE - START OPERATION ONLY
RFFUNC,	0			/DMAR OR DMAW
RFTRAK,	0			/BITS 1-8=TRACK, 9-11=FIELD
	ISZ	LDFCNT		/DONE LOADING?
	JMP	LD2		/NO
	DISCHK			/YES - LAST WRITE OK??
	JMP	LDSTOP
LD2,	TAD	RFTRAK		/WHAT FIELD DOES DECTAPE GO TO NOW?
	RTR
	SPA CLA
	TAD	C0010
	TAD	C0010
	DCA I	DTFLDA
	JMS I	DTRWA		/READ/WRITE DECTAPE
	ISZ	LDFCNT		/DONE DUMPING???
	JMP	DMPJMP		/NO
	DCMA			/MAKE SURE THE DISK IS STOPPED
LDSTOP,	TAD	C0400		/YES - REWIND LAST DECTAPE
	DTXA
	JMP I	.+1
	RFBOOT			/NOW GO BOOT WHATEVER IS ON RF08/DF32
DMPJMP,	DISKCHK			/DISK OK??
	TAD	RFTRAK
	RAR
	SZL CLA
	TAD	C0002
	TAD	C0007
	TAD	RFTRAK
	DCA	RFTRAK
	JMP	RFFUNC-1
DMPINI,	DISC
RFDMAR,	DMAR
	1
	JMP	DMPJMP

SUPDMP,	STA
SUPLOD,	DCA	DTA		/SET DTA NON-0 FOR LOAD, 0 FOR DUMP
	JMP	DSKSUP		/AND GO LOAD OR DUMP

DTA,	0
DSKSZ,	-DSKSIZ
LDFCNT,	0
DTFUNA,	DTFUNC
DTBLKA,	DTBLOK
DTFLDA,	DTFLD
DTRWA,	DTRORW
C0020,	0020
C0030,	0030
RWA,	RW
TAPERR,	TEXT "_TAPE READ ERROR"
HUH,	TEXT "_WHAT?_PLEASE TRY AGAIN_"
HUH2=	HUH+3
/FILE PHANTOM AND DISK REFRESHER

/WRITE NEW MFD ON DISC DIRECTLY ABOVE THE SWAPPING AREA
PAGE
FIPR4,	0
FIPASC,	ASCSIX
MFD1,	MFDT-1

FIPREF,	ZERO1			/ZERO FIELD 1
	MESSAG			/"SYSTEM"
	SYSTEM
	MESSAG			/"PASSWORD"
	PASWRD
	GETIN
	JMS I	FIPASC		/CONVERT PASSWORD TO SIXBIT
	0011			/GOOES AT WORD 11, 12 OF MFD
	MESSAG			/"LIBRARY"
	LIBARY
	MESSAG			/"PASSWORD"
	PASWRD
	GETIN
	JMS I	FIPASC		/CONVERT PASSWORD TO SIXBIT
	0041			/AND PUT IT AT WORDS 41,42 OF MFD
	MESSAG			/"OPERATOR"
	OPRAT
	MESSAG			/"PASSWORD"
	PASWRD
	GETIN
	JMS I	FIPASC		/CONVERT PASSWORD TO SIXBIT
	0061			/AND PUT IT AT WORDS 61,62 OF MFD
	TAD	MFD1		/INITIALIZE POINTER
	DCA	AXS1
FIPR2,	TAD I	AXS1		/GET ADDRESS OF DATA TO BE STORED IN MFD
	SNA			/ARE WE THROUGH?
	JMP	FIPR3		/YES
	DCA	FIPR4		/SAVE IT
	TAD I	AXS1		/GET DATA TO STORE
	DATFLD
	DCA I	FIPR4		/STORE IT IN THE MFD
	CHDF
	JMP	FIPR2		/GO FOR MORE

FIPR3,	TAD	SWBASE
	TAD	JBMXP		/"JOBMAX"
	CLL RTL
	STL RAL			/MAKE IT FIELD 1
	DCA	.+3
	DISC
	DMAW			/WRITE OUT THE MFD
	.-.
	DISCHK
/INITIALIZE STORAGE ALLOCATION TABLE "SAT"
/THE SAT TABLE RESIDES IN FIP AT 7777 AND EXTENDS
/DOWN THROUGH 7777-(SATSIZ-1). EACH BIT POSITION REPRESENTS 1 SEGMENT
/OF FILE STORAGE.
/SEGMENT 0 IS BIT 0 OF 7252,
/SEGMENT 1 IS BIT 1 OF 7252, ETC.   7252=7777-(SATSIZ+2).
/LOCATION SATCNT=7777-(SATSIZ-1)+1 CONTAINS THE COUNT OF AVAILABLE
/SEGMENTS.  A SEGMENT IS AVAILABLE IF ITS SAT BIT HAS THE
/VALUE 0.

	JMS I	FIPRFD		/FIP TO FIELD 1
	TAD	CJTABL
	ZERO1			/CLEAR ALL FIP TABLES AND RETRIEVAL INFORMATION
	TAD	SWDEXP
	TAD	CJOBMX
	TAD	DSKSZP		/"DSKSIZ"
	CLL RTL
	RTL
	TAD	C7777		/CAN'T USE LAST SEGMENT ON DF32
	DCA	STORE0		/NUMBER OF DISK SEGMENTS
	CLA CMA
	DATFLD
	DCA I	SATBOT		/"-255"
	CLL STA RTL		/SUBTRACT THREE SEGMENTS (FOR 1,2,3 UFD'S)
	TAD	STORE0		/SET SATCNT TO # DISC SEGMENTS-2
	DCA I	SATCNT		/"-254"
	TAD	K7000		/MARK SEGMENTS 1,2,3 FOR MFD, UFD USAGE
	DCA I	SATTBL
	TAD	STORE0		/MORE THAN 4000 SEGMENTS.
	SMA
	JMP	.+6		/NO OK
	TAD	CM4004		/SUBTRACT 4004
	DCA	STORE0
	TAD	C0253		/253 WORDS=4004 SEGS
	DCA	COUNT
	TAD	STORE0
	TAD	C7764		/-14
	ISZ	COUNT		/COUNT # ZERO WORDS IN SAT
	SMA
	JMP	.-3
	DCA	STORE0
	STA
	TAD	COUNT
	TAD	SATTBL
	DCA	COUNT
	STL RAL
	ISZ	STORE0
	JMP	.-2
	DCA I	COUNT		/MARK END OF FILE STORAGE AS ALLOCATED
	JMP	FIPRF5
FIPRF4,	CLA CMA
	DCA I	COUNT
FIPRF5,	ISZ	COUNT
	JMP	FIPRF4
	DISC
	DMAW
	0011			/FIP IS TRACK 1, FIELD 1
	DISCHK			/MAKE SURE THE DISK IS OK
	JMP I	SUPERA
SATTBL,	-SATSIZ+2
K7000,	7000

COUNT,	0
SWDEXP,	-SWDEX
JBMXP,	JOBMAX
C7764,	-14
DSKSZP,	DSKSIZ
STORE0,	0
FIPRFD,	FIPRD
CJTABL,	JTABLE
SATBOT,	-SATSIZ
SATCNT,	-SATSIZ+1
C0253,	253
CM4004,	-4004
FIPREM,	TEXT "_WRITE ZERO SYSTEM DIRECTORY? "
*INIP+3000
	JMP I	.+1
	INBOOT


/MFD SEGMENT #S TO INBUF

FRD0,	0
	TAD	SWBASE
	TAD	JBMAX
	CLL RTL
	STL RAL
	DCA	FRD1
	DISC
	DMAR
FRD1,	0
	DISCHK			/MAKE SURE THE DISK IS OK
	TAD	K0020
	DCA	AXS1
	TAD	INBUF
	DCA	AXS2
	TAD	K7771
	DCA	Z1
FRD2,	DATFLD
	TAD I	AXS1
	CHDF
	DCA I	AXS2
	ISZ	Z1
	JMP	FRD2
	DATFLD
	TAD I	FGRACE		/FETCH SIZE OF "GRACE SPACE"
	CHDF
	DCA I	AXS2
	JMP I	FRD0

JBMAX,	JOBMAX
FGRACE,	0014
K0020,	0020

Z1,
FIPRD,	0
	DISC
	DMAR
	0011			/FIP IS TRACK 1, READ INTO FIELD 1
	DISCHK			/MAKE SURE THE DISK IS OK
	JMP I	FIPRD

Z0,	JMS I	STFLDB		/SET DATA FIELD TYPED
	DCA	Z1
	DCA I	Z1		/ZERO OUT A FIELD
	ISZ	Z1
	JMP	.-2
	JMP I	SUPERA

STFLDB,	STFLD
/TABLE USED TO CONSTRUCT VIRGIN MFD
/INCLUDES ENTRIES FOR ACCOUNTS 1, 2, 3
/EACH PAIR OF NUMBERS INCLUDES FIRST THE MFD ADDRESS, THEN ITS CONTENTS

MFDT,	3;10			/DUMMY POINTER
	10;1			/ACCOUNT NUMBER 1
	13;40			/NEXT ACCOUNT STARTS AT 40; LINK TO IT
	14;12			/DEFAULT "GRACE SPACE" OF 10 SEGMENTS PAST QUOTA
	17;20			/SEGMENT LIST IS AT 20
	21;1			/MFD STARTS WITH SEGMENT 1 ONLY
	30			/AN EXTRA BLOCK IS USED HERE. THE REASON IS SO THAT THE
	7777			/LAST ACCOUNT IN A SEGMENT WON'T HAVE ITS RETRIEVAL
				/BLOCK IN THE NEXT SEGMENT.
	40;2			/ACCOUNT 2
	43;60			/LINK TO NEXT ACCOUNT AT 60
	44;7777			/NO LIMIT ON DISK SEGMENTS
	47;50			/SEGMENT LIST IS AT 50
	51;2			/ACCOUNT 2 UFD STARTS WITH ONLY SEGMENT 2
	60;3			/ACCOUNT 3
	64;7777			/NO LIMIT ON DISK SEGMENTS
	67;70			/SEGMENT LIST IS AT 70
	71;3			/ACC. 3 UFD OWNS SEGMENT 3 ONLY, INITIALLY
	0			/TABLE TERMINATOR
CRTABL,	RTABLE-1		/MFD SEGMENT #S
CUTABL,	UTABLE
SATCON,	SATSIZ+1
CJOBTB,	JTABLE-1		/START OF AREA TO CLEAR IN FIP

PERSET,	0
	JMS	FRD0		/MFD SEGMENT #S TO INBUF
	JMS	FIPRD		/FIP TO FIELD 1
	TAD	CJOBTB		/CLEAR FIP TABLES
	DCA	AXS1
	DATFLD
	DCA I	AXS1
	TAD	AXS1		/HAVE WE REACHED BOTTOM OF SAT?
	TAD	SATCON
	SZA CLA
	JMP	.-4		/NO
	TAD	CRTABL		/MOVE MFD SEGMENT #S TO RTABLE
	DCA	AXS1
	TAD	INBUF
	DCA	AXS2
	TAD	K7771
	DCA	Z1
PERSE3,	CHDF
	TAD I	AXS2
	DATFLD
	DCA I	AXS1
	ISZ	Z1
	JMP	PERSE3
	CLL CLA CML RAL
	DCA I	CUTABL		/UTABLE=1
	CMA
	ISZ	CUTABL
	DCA I	CUTABL		/UTABLE+1=-1
	ISZ	CUTABL
	CHDF
	TAD I	AXS2
	DATFLD
	CIA
	DCA I	CUTABL		/UTABLE+2=-"GRACE SPACE"
	CHDF
	DISC
	DMAW
	0011			/WRITE FIP FROM FIELD 1, TO TRACK 1
	DISCHK			/MAKE SURE THE DISK IS OK
	JMP I	PERSET

K7771,	7771

/THERE'S ALWAYS SOMEONE WHO WILL TRY TO LOAD INIT INTO THE SAME FIELD AS
/THE BINARY LOADER.  GIVE HIM/HER A MESSAGE IF [S]HE DOES!!

*4200
	CLA
	RIF
	TAD	C6201
	DCA	INIF
	MESSAG
	OOPS
	HLT
	JMP	.-4
OOPS,	TEXT "_PLEASE DON'T TRY TO LOAD INIT WITH THE BINARY LOADER "
*.-1
	TEXT "LOCATED IN FIELD 2!"
*7632
	JMP I	SUPERA		/THIS INSTRUCTION SHOULD INTERCEPT ANY BINARY
				/LOADER IN PROGRESS IN THIS FIELD.
/INIT SUPERVISOR
/OVERLAYS XDDT PERMANENT SYMBOL TABLE

	*4200
SUPER,	CLA			/SET DATA FIELD
	RIF
	TAD	C6201
	DCA	INIF
	CHDF
	DTRA
	AND	C0200
	DTXA			/STOP ANY DECTAPE WHICH MAY BE MOVING AFTER AN ERROR
	TAD	OUT1
	DCA	OUTA		/RESTORE TTY OUTPUT
IFZERO CPU-2 <6030>		/DO HIM/HER A FAVOR IF IT'S AN 8/E
IFNZRO CPU-2 <6032>		/NOT QUITE AS HELPFUL, BUT NECESSARY

	MESSAG
	LDXRS			/LOAD, DUMP, START AND OTHER THINGS IN THE LIST OF COMMANDS??
	GETIN			/WAIT FOR REPLY
	TAD	SUPTBA		/ADDRESS OF TABLE OF LETTERS
	DCA	AXS1		/SAVE IT AUTO-INDEX
SUPER2,	TAD I	AXS1		/GET A LETTER FROM TABLE
	SNA			/END OF TABLE?
	JMP	SUPHUH		/YES - LET HIM/HER TRY AGAIN
	TAD I	INBUF		/ADD ON FIRST CHARACTER TYPED
	SNA CLA			/THIS ONE?
	JMP	SUPER3		/YES - DISPATCH
	ISZ	AXS1		/NO - PASS UP DISPATCH ADDRESS
	JMP	SUPER2		/NEXT

SUPER3,	TAD I	AXS1		/GET DISPATCH ADDRESS
	DCA	CHDFA
	JMP I	CHDFA		/AND DISPATCH

SUPHUH,	CLA
	MESSAG
	HUH
	JMP	SUPER

SUPTBA,	SUPTBL-1
OUT1,	OUT
STFLD,	0
	CHDF
	TAD I	STFAD		/WHAT WAS THE SECOND CHARACTER TYPED?
	TAD	STFM8
	CLL
	TAD	C0010
	SNL
	JMP	SUPHUH
	CLL RTL
	RAL
	TAD	C6201
	DCA	.+1
	.-.
	JMP I	STFLD
STFAD,	INBUFA+1
STFM8,	-"8
/REFRESHER CONTROL

LOGSMA,	LOGMES
REFFLD,	CORFLD
REFDDT,	XDDFLG
NOCSQ,	ISZ	CONDBA
REFCSQ,	CORJMS
IFZERO DC08A <
REFREQ,	FREQ
CYC50,	FRETEL
CYC60,
IFNZRO CPU-2 <-6>
IFZERO CPU-2 <-14>	>

REFCO0,	JMS I	LOGSMA		/CHECK FOR NEW SI LOGIN MESSAGE
	DISC			/READ INIT INTO FIELD 1
	DMAR
	21
	DISCHK			/IS IT OK?
	YESNO			/LAOD XDDT?
	DDTMES
	STA
	DATFLD
	DCA I	REFDDT		/INITIALIZE XDDT LOAD FLAG
REFCO1,	CHDF
	MESSAG			/# USER FIELDS -
	CORMES
	GETIN
	OCTIN
	DATFLD
	DCA I	REFFLD		/INITIALIZE NUMBER OF USER FIELDS
	TAD I	REFFLD
	CLL IAC
	TAD	C7770
	SZL CLA			/IS HIS/HER ANSWER REASONABLE?
	JMP	REFCO1		/NO
	CHDF
	YESNO
	CSQ			/DOES [S]HE WANT ^S FEATURE?
	TAD	NOCSQ		/NO
	DATFLD
	DCA I	REFCSQ
IFZERO DC08A < IFNZRO CPU-4 <
	CHDF
	YESNO
	FREQUE			/60 HERTZ?
	JMS I	CYC50
	TAD	CYC60
	DATFLD
	DCA I	REFREQ	> >
	CHDF
	DISC			/WRITE OUT INIT
	DMAW
	21
	DISCHK			/MAKE SURE IT'S OK
	YESNO			/DO YOU WANT TO REFRESH?
	FIPREM
	JMP I	SUPERA		/NO
	JMP I	.+1
	FIPREF			/GO REFRESH

SUPTBL,	-"L
	SUPLOD			/LOAD
	-"D
	SUPDMP			/DUMP
	-"I
	SUPREF			/INITIALIZE
	-"S
	SUPST			/START
	-"X
	7000			/XDDT
	-"B
	SBUILD			/BUILD
	-"P
	DISCLK			/PATCH
	-"T
	DSKDMP			/LOAD OR DUMP; YOU CHOOSE HOW MANY TRACKS
	-"O
	PATCH			/LOAD AN OVERLAY TAPE
	-"C
	LOAD			/READ OR WRITE 4K TO "C" OR
	-"Y
	Y			/READ BINARY TAPE TO A SELECTED FIELD
	-"Z
	Z0			/ZERO A SELECTED FIELD
	-"M
	MF0			/MATCH A SELECT FIELD WITH FIELD 1
	-"W
	CD0			/DUMP A SELECTED FIELD
	-"E
	OSB			/EXIT TO SOME OPERATING SYSTEM
	-"R
	RFBOOT			/BOOT TO OPERATING SYSTEM ON RF08/DF32
	-"K
	KEBOOT			/ROOT TO RK8E
	0			/TABLE TERMINATOR

/FOLLOWING THIS COMMENT, YOU WILL FIND XDDT. ONLY IT MIGHT BE A
/LITTLE HARD TO SEE, SINCE IT'S XLISTED.


	*5400
	70			/PATCH FIELD SELECT FOR XDDT

	*6400
	4434
	4434
	4434

*4724
	6031			/PATCH TO FIX XDDT BUGS ON 8E
*4726
	5376
*4776
	6032
	5772
*5004				/^C CODE
	TSF
	JMP	.-1		/WAIT FOR FLAG FROM ^C
XOP,	SKP			/NOP IF XDDT IS EXEC DDT
	CIF CDF 0
	JMP I	.+1
	4200
*5523
	1222
*5547
	7000
*5572
	7760			/GIVE THE TTY FLAG MORE TIME
*6045
	5225			/DON'T GO TO BINARY LOADER
/BINARY LOADER SUBROUTINE
/CALLING SEQUENCE: CDF TO FIELD TO LOAD TAPE INTO
/	JMS	BINTAP
/	JMP	?	/RETURN WITH FIELD SETTING IN AC6-8
/			/JMP BINT3 WHEN DESIRED ACTION HAS BEEN TAKEN
/	?		/RETURN WITH CHECKSUM IN THE AC

*7600

BINTAP,	0
	KCC			/BRING UP FLAG ON LS READER, AC=0
	RFC			/BRING UP FLAG ON HS READER
	TAD	M200
	DCA	TEMP		/INITIALIZE DELAY TIME
BLORI,
BINF,	KSF			/LS READER FLAG YET?
	JMP	.+3		/NO
	TAD	BLORI		/YES ---
	JMP	.+4
	RSF			/HS READER FLAG YET?
	JMP	BINIL		/NO
	TAD	BHIRI		/YES
	DCA	BINRD+1		/SAVE HI/LO SWITCH
	JMS	BFR		/READ TAPE-LEADER?
	JMP	.+2		/YES - GO FIND END OF LEADER
	JMP	.-2		/NO - FIND LEADER BEFORE ANYTHING
	JMS	BFR		/READ TAPE - LEADER?
	JMP	.-1		/YES - KEEP LOOKING
	DCA	ORIGIN		/INITIALIZE ORIGIN FOR SAVE TAPES
GO,	DCA	BINCHK		/CLEAR OUT OR UPDATE CHECKSUM
BINT2,	TAD	FRAME		/WHAT WAS IT?
	TAD	C7500
	SMA
	JMP	BINFLD		/MUST HAVE BEEN A FIELD SETTING
	TAD	MASK		/NOW GET THE FRAME BACK
	DCA	WORD1
	JMS	BINRD		/GET NEXT FRAME
	DCA	WORD2
	JMS	BFR		/NOW LOOK AHEAD FOR LEADER/TRAILER
	JMP	BINC		/TRAILER! GO DO CHECKSUM
	JMS	ASSEMB		/ASSEMBLE WORD
	SZL			/ORIGIN?
	JMP	BINORG		/ORIGIN
	DCA I	ORIGIN		/STORE AWAY DATA
	ISZ	ORIGIN		/PREPARE FOR NEXT
M200,	CLA 400
BINT4,	TAD	WORD1		/NOW UPDATE THE CHECKSUM
	TAD	WORD2
	TAD	BINCHK		/ADD IN OLD CHECKSUM
	JMP	GO		/AND GO SAVE IT AND CONTINUE

BINC,	JMS	ASSEMB		/ASSEMBLE THE CHECKSUM
	CIA
	TAD	BINCHK		/COMPUTE FINAL CHECKSUM
BINC2,	ISZ	BINTAP		/SKIP ON RETURN
	SNA			/CHECKSUM OK?
	JMP I	BINTAP		/YES
	DCA	BINCHK		/SAVE IT
	MESSAG			/TELL HIM/HER ABOUT BAD CHECKSUM
	TAPERR
	TAD	BINCHK		/GET CHECKSUM
	JMP I	BINTAP		/AND RETURN; CHECKSUM IN AC

BINFLD,	AND	K0070		/GET FIELD BITS
	JMP I	BINTAP		/AND GO PROCESS THEM

SWITCH,
ASSEMB,	0
	TAD	WORD1
	CLL RTL
	RTL
	RTL
	TAD	WORD2
	JMP I	ASSEMB
BINIL,	JMS	DELAY
	JMP	BINF

/HERE IS THE REAL BINARY LOADER!

	JMS	BINTAP		/GO AND BINARY LOAD
	JMP	.+3		/FOUND A FIELD SETTING
M376,	HLT			/FINISHED - CHECKSUM IN AC
BEGIN,	JMP	.-3		/CONTINUE - [S]HE WANTS ANOTHER TAPE READ
	TAD	K6201		/MAKE A CDF
	DCA	.+1		/SAVE IT
TEMP,	.-.
	JMP	BINT3		/AND CONTINUE

/MORE BINARY LOAD JUNK

/BFR - READ TAPE, IGNORING FRAMES BRACKETED BY RUBOUTS
/SKIP ON RETURN IF LEADER NOT FOUND

BFR,	0
	DCA	SWITCH		/SET THE SWITCH (OR RESET IT)
	TAD	M200
	DCA	TEMP
	JMS	BINRD		/GET A CHARACTER
	TAD	M376		/TEST FOR 377; RUBOUT
	SPA SNA CLA
	JMP	.+4		/NOT RUBOUT
	ISZ	SWITCH		/YES; COMPLEMENT SWITCH
	CMA
	JMP	BFR+1
	TAD	SWITCH
	SZA CLA			/IS THE SWITCH SET?
	JMP	BFR+2		/YES; IGNORE THE DATA
	TAD	FRAME		/WHAT WAS THE CHARACTER AGAIN?
	AND	MASK
	TAD	M200
	SZA CLA			/WAS IT LEADER?
	ISZ	BFR		/NO, SKIP ON RETURN
	JMP I	BFR		/AND RETURN

BINT3,	JMS	BFR		/GET NEXT FRAME
	JMP	BINC		/HUH? LEADER/TRAILER FOLLOWING FIELD SETTING OR ORIGIN!!
	JMP	BINT2		/AND PROCESS IT

BINRD,	0
	HLT			/KSF OR ELSE JMP HIR
	JMP	BINDL
	KRB
	DCA	FRAME
	TAD	FRAME
	JMP I	BINRD
BHIR,	RSF
	JMP	BINDL
	RRB RFC
	JMP	.-6

*7750				/WC & CA; INIT WILL READ INTO FIELD 0 OK
	.+1;.
BINDL,	JMS	DELAY
	JMP	BINRD+1

WORD1,	.-.			/DECTAPE WC & CA
WORD2,	.-.

/MORE BINARY LOAD JUNK

BINORG,	DCA	ORIGIN		/SAVE ORIGIN
	JMP	BINT4

DELAY,	0
	ISZ	FRAME
	JMP I	DELAY
	ISZ	TEMP
	JMP I	DELAY
	STA			/TIME OUT - GIVE HIM/HER ERROR MESSAGE
	JMP	BINC2

BHIRI,	JMP	BHIR
BINCHK,	0			/CHECKSUM ACCUMULATION
ORIGIN,	0			/CURRNET ADDRESS
FRAME,	0
C7500,	7500
MASK,	0300
K0070,	0070
K6201,	6201

*7777
	JMP	BEGIN		/BINARY LOADER?!!
$	$	$	$	$!!!!!!!!!!