OCI260,	-260
OCTINT,	0

OCTIN0,	0
	DCA	OCTINT
	STA
	TAD	INBUF
	DCA	AXS1
OCTIN1,	TAD I	AXS1
	DCA	AXS2
	TAD	AXS2
	TAD	OCI260
	SPA
	JMP	OCTIN2
	TAD	C7770
	SMA
	JMP	OCTIN2
	TAD	C0010
	DCA	AXS2
	TAD	OCTINT
	CLL RTL
	RAL
	TAD	AXS2
	DCA	OCTINT
	JMP	OCTIN1
OCTIN2,	CLL CLA
	TAD	OCTINT
	JMP I	OCTIN0

/AFTER LOAD OR DUMP, BOOT BACK TO WHATEVER OPERATING SYSTEM IS ON THE RF08.
/THIS WAY, INIT CAN BE USED TO LOAD/DUMP OS/8.
RBOOT,	6641			/DCXA	/CLEAR RF08 EXTENDED DISK ADDRESS
	DCEA			/AND EVERYTHING ELSE
	-200			/CLA
	DMAR
	DFSC
	5352			/JMP .
	5752			/JMP I .-1
CRLF=	LOGM2+10
LOGM2,	TEXT "END WITH ALTMODE_"
LOGM3,	TEXT "$_"
SYSTEM,	TEXT "SYSTEM"
LIBARY,	TEXT "LIBRARY"
OPRAT,	TEXT "OPERATOR"
PASWRD,	TEXT " PASSWORD? "
TAB,	-01
	-11
	-21
	-41
	-51			/THE NEXT WORD MUST BE POSITIVE
MSG,	TEXT "_SI"
	TEXT "_FIP"
	TEXT "_INIT"
	TEXT "_TS8"
	TEXT "_PUTR"
UPAROW,	TEXT "  ^  "
*INIP

/ZERO OUT FIRST 6 TRACKS IN PREPARATION FOR BUILDING NEW SYSTEM

SBUILD,	YESNO
	REALLY
	JMP I	SUPERA		/LUCKILY WE CAUGHT HIM/HER
	ZERO1			/ZERO FIELD 1
	TAD	C0051		/START AT TRACK 5, FIELD 1
SB2,	DCA	SB3
	DISC
	DMAW			/WRITE A FIELD OF ZEROES TO DISK
SB3,	.-.
	DISCHK			/MAKE SURE DISK IS OK
	TAD	SB3
	TAD	C7770		/GO TO PREVIOUS TRACK
	SMA			/ARE WE THROUGH?
	JMP	SB2		/NO
	TAD	MSGA		/INITIALIZE ADDRESS OF MESSAGES
	DCA	MSGB
	TAD	TABA		/INITIALIZE TABLE POINTER
	DCA	TABB
BUILD1,	MESSAG			/ASK FOR A TAPE
MSGB,	.-.
	TAD I	PATXAD
	DCA	SB3
	MESSAG
	UPAROW			/"  ^  "
SB4,
IFNZRO CPU&7776 <6030>		/ON 8E, CLEAR FLAG, BUT NO READER RUN
IFZERO CPU&7776 <KCC >		/CLEAR FLAG
	INKRB			/WAIT FOR A KEY TO BE PRESSED
	TAD	C7600		/LEADER?
	SZA
	TAD	C7763		/CARRIAGE RETURN?
	SZA CLA
	JMP	SB4		/NO
	STA
	DCA	FLAG

/ROUTINE TO PATCH THE DISK. A BINARY TAPE IS READ, AND THE CORRESPONDING
/WORDS ON A DISK TRACK ARE PATCHED. THE FIELD SETTING ON THE TAPE
/DETERMINES WHICH TRACK WILL BE PATCHED. A TAPE WITHOUT A FIELD SETTING
/WILL PATCH TRACK 5. A TAPE WITHOUT AN ORIGIN WILL LOAD STARTING AT 0
/HENCE A SAVE FORMAT TAPE WILL LOAD PROPERLY INTO THE SWAP TRACK FOR
/JOB NUMBER 1.

PATCH,	DISC
	DMAR			/READ TRACK 5 INTO CORE
C0051,	0051			/TO PATCH IT IF NO FIELD SETTING
	DISCHK			/MAKE SURE THE DISK IS OK
	TAD	.-2		/NOW REMEMBER WHAT IS IN FIELD 1
	DCA	PATW		/SO IT WILL BE PROPERLY RE-WRITTEN
	TAD	PATW
	DCA	PATR
	CDF	10		/USE FIELD 1 AS BUFFER
	JMS I	BINTA		/READ THE BINARY TAPE
	JMP	PATFLD		/A FIELD SETTING HAS BEEN ENCOUNTERED
	SNA			/END OF TAPE - WAS THERE A CHECKSUM ERROR?
	JMS	PATRW		/NO, SO WRITE OUT FIELD 1
	ISZ	FLAG		/WHERE DID WE COME FROM?
	JMP I	SUPERA		/BACK TO SUPERVISOR
	CHDF
	SZA CLA			/CONTINUE BUILDING - WAS THERE ERROR?
	JMP	BHUH		/YES - TRY AGAIN
	TAD I	TABB		/NO - WAS RIGHT TAPE LOADED?
	TAD	PATR
	SZA CLA
	JMP	BHUH		/NO - TRY AGAIN
	IAC
	TAD	SB3		/ADDRESS OF LAST CHARACTER TYPED + 1
	DCA	MSGB		/SET UP FOR NEXT MESSAGE
	ISZ	TABB
	TAD I	TABB		/ARE WE THROUGH?
	SPA CLA
	JMP	BUILD1		/NO
	JMP I	.+1		/YES
	SUPREF

BHUH,	MESSAG
	HUH2
	JMP	BUILD1

PATXAD,	BUFPTR
MSGA,	MSG+7			/AC IS -7 WHEN THIS IS TADDED
TABA,	TAB
FLAG,	0
TABB,	0

PATFLD,	IAC			/TRACK IS IN BITS 6-8, MAKE IT FIELD 1
	DCA	PATR		/AND SAVE IT
	JMS	PATRW		/WRITE PREVIOUS TRACK; READ NEW ONE
	JMP I	BINT3A		/AND CONTINUE
BINT3A,	BINT3
BINTA,	BINTAP

PATRW,	0
	DISC
	DMAW			/WRITE THE PREVIOUS TRACK
PATW,	.-.			/TRACK FOR PREVIOUS PATCHING
	DISCHK			/MAKE SURE THE DISK IS OK
	DISC
	DMAR			/READ IN NEW TRACK
PATR,	1			/TRACK FOR UPCOMING PATCHING
	DISCHK			/MAKE SURE THE DISK IS OK
	TAD	PATR
	DCA	PATW		/REMEMBER WHICH TRACK WE'RE WORKING ON
	JMP I	PATRW		/AND RETURN

/SYSTEM INITIALIZATION

SYSINI,	DISC			/READ INIT INTO FIELD 2
	DMAR
	0022
	DISCHK			/MAKE SURE DISK IS OK
	CIF CDF 20		/NOW GO THERE
	JMP	.+1
	TAD	.-2
	DCA	INIF		/SET UP CHDF
	JMS I	SYSPER		/INITIALIZE FIP
	DISC			/LOAD FIELD 0
	6603
	TS8DEX
	DISCHK			/CHECK FOR DISK OK
	TAD	DVTBA
	DCA	INIT0
SYSI1,	TAD I	INIT0
	DCA	CHDFA
	JMS I	CHDFA
	ISZ	INIT0
	JMP	SYSI1

SYSPER,	PERSET
INIT0,	0			/VARIABLE DVTB POINTER
DVTBA,	DVTB			/ADDRESS OF DVTB
XTELL,	TEXT "_EXEC DDT LOADED_"

DVTB,	CLEAR			/READ MONITOR II INTO DATFLD
	CORINI
	DSKINI
	DATEIN
	TIMEIN
	START
*INIP+200
/NUMBER INPUT
/CALL	NUMBIN
/	NOT A NUMBER
/	# IN AC

NUMBIN=	JMS I	NUMBIA

NUMBI0,	0
	DCA	NUMAGN		/NUMBER MAGNITUDE
	CLL STA RTL		/MAXIMUM OF TWO DIGITS IN NUMBER
	DCA	NUMCNT
	JMS I	NUMSKP		/SKIP LEADING TABS AND SPACES
	JMP I	NUMBI0		/NOTHING THERE
NUMBI1,	TAD	CHAR
	TAD	NUMM9
	SMA SZA
	JMP	NUMBI3		/NOT A NUMBER
	TAD	NUMP9
	SPA
	JMP	NUMBI3		/NOT A NUMBER
	DCA	CHAR
	ISZ	NUMCNT
	SKP
	JMP I	NUMBI0		/TOO MANY DIGITS
	TAD	NUMAGN		/ * 1
	CLL RTL			/ * 4
	TAD	NUMAGN		/ * 5
	RAL			/ * 10
	TAD	CHAR
	DCA	NUMAGN
	COMGET
	JMP	NUMBI3		/NO MORE CHARACTERS
	JMP	NUMBI1

NUMBI3,	CLA
	TAD	C0003		/HAVE ANY DIGITS BEEN FOUND?
	TAD	NUMCNT
	SNA CLA
	JMP I	NUMBI0		/NO
	ISZ	NUMBI0
	TAD	NUMAGN
	JMP I	NUMBI0

NUMAGN=	NUMHO+1
NUMCNT,	0
NUMSKP,	SKIPS
NUMM9,	-"9
NUMP9,	11
START,	0
	DTCA
	PCF

	IFZERO D689-4	<
	EDF			/TURN ON DATA PHONES
	DFCRF
	CCF		>

	TSF			/WAIT FOR CONSOLE FLAG FROM DIALOG
	JMP	.-1
	TCF
	RRB
	KCC
	CIF CDF
	IFNZRO DC08A	<
	T1ON		>
	IFZERO DC08A	<
			IFZERO CPU-1	<
			CLL CMA	/LOAD CLOCK BUFFER
			CCF CLB		>
			>
	IFZERO DC08A	<
IFNZRO CPU-4 <CECI>
IFZERO CPU-4 <IAC
	CLLE
	CLA>
			>

	IFZERO LPT-1	<LCP>	/CLEAR INTERRUPT FOR LPT

	ION
	WAIT


REALLY,	TEXT "BUILD? "

/ASK WHETHER TO READ OR WRITE
RW,	0
	CLA CLL
	RIF
	TAD	C6201
	DCA	INIF		/INITIALIZE CHDF
	CHDF
	TAD I	RW
	DCA	.+2
RW1,	MESSAG
	.-.			/CRLF OR "TAPE "
	MESSAG
	RDORWT			/READ OR WRITE?
	GETIN
	TAD I	INBUF		/FIRST CHARACTER
	TAD	RWMR		/R?
	CLL
	SZA			/YES
	TAD	RWMW		/W? SET LINK
	SZA CLA
	JMP	RW1		/NOT R OR W
	RTL			/0 FOR R, 2 FOR W
	ISZ	RW
	JMP I	RW
RWMR,	-"R
RWMW,	"R-"W

KEBOOT,	IAC
	CLL RTL
RFBOOT,	TAD	OSTAB
	DCA	AXS1
	TAD I	AXS1
	DCA	OSF
	TAD I	AXS1
	DCA	OST
	TAD I	AXS1
	DCA	OSC
	TAD I	AXS1
	DCA	OSA
/BOOTWTRAP FOR DEVICE OF YOUR CHOICE -- SET FOR DECTAPE HERE
OSB,	CHDF
	TAD I	OSF
	CDF
	DCA I	OST
	ISZ	OSF
	ISZ	OST
	ISZ	OSC
	JMP	OSB
	DTRA DTXA		/MAKE LAST TAPE FLAP (LOAD/DUMP)
	CDF CIF
	JMP I	OSA
*INIP+400

FREND,	-FIPBLK			/END OF FREE CORE
LODDTA,	LODDT			/LOAD XDDT INTO FIELD 1
XDDFLG,	-1
CORFLD,	0
CORLNK,	0
CORJMS,	0			/ISZ I	CONDBA IF ^S/^Q FEATURE DISABLED
CORCSQ,	KBDSQ			/LOCATION OF JMS FOR ^S FEATURE

CORINI,	0
	ISZ	XDDFLG		/DID [S]HE WANT EXEC DDT?
	JMS I	LODDTA		/YES
	TAD	CORJMS
	CDF
	SZA
	DCA I	CORCSQ		/NO!
	TAD	CORFLD		/HOW MANY USER FIELDS DID [S]HE SAY
	SNA			/NO RESPONSE
	IAC			/ASSUME 1 USER FIELD
	DCA	CORCNT
	TAD	CORCNT
	CMA			/INIT CORE SEARCH ROUTINE
	DCA	AXS1
	CLL CMA RTL
	TAD	CORSRA
	DCA	AXS2
	IAC
	TAD	AXS1
	DCA I	AXS2
	TAD	CORTBA
	CMA
	TAD	AXS1
	DCA I	AXS2
	TAD	CORTBA
	DCA	AXS2
	CLL CML RTR		/ASSIGN AND LOCK DATFLD
	DCA I	AXS2		/NOW UNLOCK ALL USER FIELDS
	ISZ	AXS1
	JMP	.-2
	STL RTL
	TAD	CORCNT
	CLL RTL
	DCA	CORCNT
	TAD	CORCNT
	TAD	DSUTBA
	TAD	C0010		/MUST START IN MULTIPLE OF 8
	AND	C7770
	DCA I	FREE
	TAD I	FREE
	DATFLD
	DCA	CORLNK
	TAD	CORGEA
	DCA	CORF1
CORIN1,	TAD	CORLNK
	TAD	C0010
	DCA	AXS2
CORIN4,	TAD	AXS2
	TAD	FREND
	SNA CLA
	JMP	CORIN2		/DONE
	TAD	AXS2
	DCA I	CORLNK
	TAD	AXS2
	DCA	CORLNK
	ISZ	AXS1
	JMP	CORIN1
	HLT			/OOPS!!!
CORIN2,	TAD I	CORF1		/ANY EXTRA FREE CORE TO BE GENERATED?
	SNA
	JMP	CORIN3
	DCA	AXS2
	ISZ	CORF1
	TAD I	CORF1
	CIA
	DCA	FREND
	ISZ	CORF1
	JMP	CORIN4
CORIN3,	DCA I	CORLNK		/LAST LINK IS ZERO
	TAD	AXS1
	IAC
	CDF
	DCA I	FRECNT
	CHDF
	JMP I	CORINI




CORF1,	0
CORGEA,	RINGIN
FRETEL,	0
	MESSAG
	CY50
	IFNZRO CPU-2 <IAC>
	IFZERO CPU-2 <STL RTL>
	JMP I	FRETEL
LOGM1,	TEXT "_NEW LOGIN MESSAGE? "
FREQUE,	TEXT "60 HERTZ POWER? "
CY50,	TEXT "50 HERTZ ASSUMED_"
*INIP+600

/SKIP LEADING SPACES AND TABS
/CALL	JMS SKIPS
/	BUFFER EMPTY
/	NORMAL RETURN

SKISPA,	-240
SKITAB,	240-211

SKIPS,	0
SKIPS1,	COMGET
	JMP I	SKIPS		/NONE LEFT
	TAD	SKISPA
	TAD	CHAR
	SZA
	TAD	SKITAB
	SNA CLA
	JMP	SKIPS1
	ISZ	SKIPS
	JMP I	SKIPS

MESSA0,	0
	RDF
	TAD	C6201
	DCA	MESSA2
	CHDF
	TAD I	MESSA0
	DCA	BUFPTR
	ISZ	MESSA0
MESSA1,	TAD I	BUFPTR		/PICK UP NEXT WORD
	SNA			/DONE?
	JMP	MESSA2		/YES
	RTR			/GET LEFT HALF OF WORD
	RTR
	RTR
	JMS	PRINTI		/PRINT IT
	TAD I	BUFPTR
	AND	K0077
	SNA			/DONE?
	JMP	MESSA2		/YES
	JMS	PRINTI		/PRINT IT
	ISZ	BUFPTR		/NEXT WORD
	JMP	MESSA1

MESSA2,	.-.			/CDF TO RESTORE DATA FIELD
	JMP I	MESSA0		/RETURN


PRINTI,	0
	AND	K0077
	TAD	K7741
	SNA			/BACKARROW?
	JMP	PRCRLF		/YUP - TIME FOR CARRIAGE RETURN, LINE FEED
	SPA
	TAD	C0100		/RESTORE BIT 5
	TAD	C0037
PRINT2,	OUTTLS			/PRINT THE CHARACTER
	JMP I	PRINTI		/RETURN

PRCRLF,	TAD	CM215		/GET A CARRIAGE RETURN
	CIA
	OUTTLS
	TAD	C0212		/AND NOW LINE FEED
	JMP	PRINT2

BUFPTR,	0
K0077,	0077
K7741,	7741

GETIN0,	0
GETIN1,	STA
	TAD	INBUF
	DCA	AXS1		/FOR GETCH
	TAD	INBUF
	DCA	NUMHO
	TAD	GETIN3		/MINUS THE LAST LOCATION IN THE BUFFER
	DCA	NUMHO+1
GETIN2,	JMS	GETCH		/GET A CHARACTER INTO THE BUFFER
	JMP	GETIN1		/BUFFER FULL; TRY AGAIN
	TAD	CM212		/HAS [S]HE TYPED A CR (OR LINE FEED)?
	SNA CLA
	JMP I	GETIN0		/YES, WE'RE ALL THROUGH HERE
	JMP	GETIN2		/NO, GET ANOTHER CHARACTER

GETIN3,	-INBUFA-20
CM212,	-212
CM215,	-215
C0212,	212
/SUBROUTINE TO GET A CHARACTER, AND PUT IT IN THE BUFFER.
/RETURN CALL PLUS 1 IF TOO MANY CHARACTERS WERE TYPED.
/RETURN CALL PLUS 2 WITH CHARACTER IN AC IS THE NORMAL RETURN.
/UPON RUBOUT, ECHOES RUBBED CHARACTERS, BUT NOT PAST BEGINNING OF BUFFER.

GETCH,	0
GETESC,	377-233
GETCH1,	INKRB
GETCH2,	DCA	CHAR
	TAD	CHAR
	TAD	MC0377
	SNA			/IS IT A RUBOUT?
	JMP	GETCH3		/YES, GO WORRY ABOUT IT
	TAD	GETESC		/IS IT ESCAPE?
	SZA CLA			/YES; DON'T ECHO
	TAD	CHAR
	OUTTLS			/ECHO CHARACTER
	TAD	AXS1
	TAD	NUMHO+1		/THIS SHOULD BE MINUS THE LAST ADDRESS IN THE BUFFER
	SMA CLA			/HAVE WE OVERRUN THE END OF THE BUFFER?
	JMP	GETCH5		/YES
	TAD	CHAR
	DCA I	AXS1		/ALL OK, NOW SAVE THE CHAR IN THE BUFFER
	TAD	CHAR
	TAD	CM215
	SZA CLA			/WAS THAT A CARRIAGE RETURN?
	JMP	GETCH4		/NO
	TAD	C0212		/GET LINE FEED AND ECHO, STORE IT
	JMP	GETCH2

GETCH3,	TAD	AXS1		/[S]HE TYPED A RUBOUT
	DCA	CHAR		/SAVE BUFFER POINTER
	TAD	AXS1
	CIA
	TAD	NUMHO		/THIS SHOULD BE THE INITIAL VALUE OF AXS1
	SMA SZA CLA		/IS [S]HE BACKING UP TOO FAR?
	JMP	GETCH1		/YES, JUST IGNORE THE RUBOUT
	TAD I	CHAR		/GOT GET THE RUBBED-OUT CHARACTER
	OUTTLS			/AND ECHO IT
	STA
	TAD	AXS1		/NOW BACK UP AXS1
	DCA	AXS1
	JMP	GETCH1

GETCH4,	TAD	CHAR		/PUT CHAR IN AC FOR RETURN
	ISZ	GETCH		//SKIP ON RETURN
	JMP I	GETCH		/AND RETURN

GETCH5,	MESSAG			/THE DUMMY IS TOO PROLIFIC WITH THE TYPING!!
	HUH
	JMP I	GETCH
*INIP+1000

/INIT BOOTSTRAP - LOAD TRACK 2 INTO FIELD 0


INBOOT,	DCA	DATEIN		/SAVE AC
	DISC
	DMAR			/READ TRACK 2 TO FIELD 0
	0020
	TAD	DATEIN		/RESTORE AC
	DFSC
	JMP	.-1
	CIF CDF			/AWAY TO FIELD 0, IF WE AREN'T THERE ALREADY
	DCA	CHDFA		/AC SAYS WHERE TO JUMP
	TAD	C6201
	DCA I	INIFA
	JMP I	CHDFA		/SO JUMP THERE

SUPREF,	TAD	SUPFUG		/REFRESH
SUPST,	TAD	SYSINA		/START
	JMP	INBOOT		/BOOT IN FRESH COPY OF INIT

INIFA,	INIF
SYSINA,	SYSINI
SUPFUG,	REFCO0-SYSINI

/DATE INPUT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1

DATMUL,	DMUL
CMCR,	-215
C0012,	14
C0031,	37
	DECIMAL
DM13,	-13
D11,	11
D31,	31
DM74,	-74
	OCTAL
DATMON,	0
DATDAY,	0

DATEIN,	0
	CLA CLL
	MESSAG			/MONTH-DAY-YEAR:
	DATMES
	GETIN
	STA
	TAD	INBUF
	DCA	AXS1
	NUMBIN			/MONTH
	JMP	DATEIN+1
	TAD	DM13
	STL IAC
	TAD	D11
	SZL			/0<MONTH<13?
	JMP	DATEIN+1	/NO
	DCA	DATMON
	NUMBIN			/DAY
	JMP	DATEIN+1
	TAD	DM32
	STL
	TAD	D31
	SZL			/0<DAY<32?
	JMP	DATEIN+1	/NO
	DCA	DATDAY
	NUMBIN
	JMP	DATEIN+1
	TAD	DM74
	SPA			/WAY OUT OF LINE?
	JMP	DATEIN+1	/YES
	DCA	NUMHO+1
	TAD	C0012
	JMS I	DATMUL
	TAD	DATMON
	TAD	NUMHO+2
	DCA	NUMHO+1
	DCA	NUMHO
	TAD	C0031
	JMS I	DATMUL
	TAD	NUMHO+1
	SZA			/IS DATE OVERFLOWED?
	JMP	DATEIN+1	/YES
	TAD	DATDAY
	TAD	NUMHO+2
	CDF
	DCA I	DATE
	CHDF
	JMP I	DATEIN

DATMES,	TEXT "MONTH-DAY-YEAR: "

DSKINI,	0			/CLEAR USER DISK REQUEST QUEUE
	DATFLD
	TAD	CORCNT
	TAD	DSUTBA
	DCA	CORCNT
	STA
	DCA I	CORCNT		/MARK END OF TABLE
	DCMA
	CHDF
	JMP I	DSKINI
COMGET=	JMS I COMGEA

COMGE0,	0
	TAD I	AXS1
	DCA	CHAR
	TAD	CHAR
	TAD	CMCR
	SNA CLA			/IS IT A CARRIAGE RETURN?
	JMP	.+3		/YES - RESET AXS1 SO NEXT CALL FINDS CR
	ISZ	COMGE0		/NO
	JMP I	COMGE0

	STA
	TAD	AXS1
	DCA	AXS1		/BACK UP POINTER
	JMP I	COMGE0

YESNO0,	0
	TAD I	YESNO0
	ISZ	YESNO0
	DCA	.+2
YESNO1,	MESSAG
	0
	GETIN
	TAD I	INBUF
	TAD	YESNON
	SNA
	JMP	YESNO2
	TAD	YESNOY
	SZA CLA
	JMP	YESNO3		/[S]HE DIDN'T ANSWER Y OR N
	ISZ	YESNO0
YESNO2,	JMP I	YESNO0		/RETURN, SKIPPING IF YES
YESNO3,	MESSAG
	YN
	JMP	YESNO1		/ASK HIM/HER AGAIN

YESNON,	-"N
YESNOY,	"N-"Y
*INIP+1200

/ROUTINE TO DUMP SELECTED FIELD

CD0,	JMS	ASKFLD
	DCA	.+2
	JMS	ASKSTA		/INITIALIZE STARTING ADDRESS
	.-.
	JMS	SP
CD1,	TAD	NUMHO		/PRINT ADDRESS OF DATA TO BE PRINTED
	JMS I	HACKA
	TAD	C7770
	DCA	NUMHO+1		/8 DATA WORDS PER LINE
CD2,	JMS I	SPACEA		/PUT IN SOME SPACE
	TAD I	NUMHO		/GET DATA WORD
	JMS I	HACKA		/PRINT IT
	ISZ	NUMHO		/ARE WE THROUGH?
	JMP	CD3		/NO
	MESSAG
	CRLF
	JMP I	SUPERA

CD3,	ISZ	NUMHO+1
	JMP	CD2
	MESSAG
	CRLF
	CHEKCC
	JMP	CD1

/ROUTINE TO COMPARE A SELECTED FIELD TO FIELD 1 AND PRINT
/OUT ANY DIFFERENCES THERE MIGHT BE. SR0=1 CAUSES A 0 IN THE FIRST
/SELECTED FIELD TO BE IGNORED; ASSUMED TO BE JMS ENTRY POINTS, ETC.

MF0,	JMS	ASKFLD		/GET FIRST FIELD
	DCA	MF1
	TAD	MF1
	DCA	MF3
	JMS	ASKFLD		/GET SECOND FIELD
	DCA	MF5
	TAD	MF5
	DCA	MF6
	JMS	ASKSTA		/INITIALIZE STARTING ADDRESS
	JMS	SP
MF1,	.-.
	TAD I	NUMHO
MF5,	.-.
	CIA
	TAD I	NUMHO
	SZA CLA
	JMP	MF3
MF2,	CHEKCC
	ISZ	NUMHO
	JMP	MF1
	JMP I	SUPERA

MF3,	.-.
	TAD I	NUMHO
	SZA CLA
	JMP	MF4
	LAS
	SPA CLA
	JMP	MF2
MF4,	TAD	NUMHO
	JMS I	HACKA
	JMS I	SPACEA
	TAD I	NUMHO
	JMS I	HACKA
	JMS I	SPACEA
MF6,	.-.
	TAD I	NUMHO
	JMS I	HACKA
	MESSAG
	CRLF
	JMP	MF2

/ROUTINE TO INITIALIZE OUTPUT TO EITHER LPT OR TO TTY. SENDS OUT A
/CHARACTER TO BOTH, TO SEE WHICH GETS BACK FIRST WITH A FLAG.

SP,	0
	STA
	LPC			/INVALID CHARACTER TO MAKE SURE IT COMES BACK FAST
	TAD	K0213
	TLS			/VALID CHARACTER IN CASE OF PARALLEL LA30 OR SUCH
	CLA
SP1,	LSF
	JMP	SP2
	TAD	OUT2
	DCA	OUTA
	JMP	SP3
SP2,	TSF
	JMP	SP1
SP3,	MESSAG
	CRLF
	JMP I	SP
OUT2,	OUTLP
K0213,	0213

ASKFLD,	0
	MESSAG
	FIELD1
	GETIN
	OCTIN
	TAD	C7770
	STL
	TAD	C0010
	SZL
	JMP I	SUPHA
	RTL
	RAL
	TAD	C6201
	JMP I	ASKFLD
SUPHA,	SUPHUH

ASKSTA,	0
	MESSAG
	START1
	GETIN
	OCTIN
	DCA	NUMHO
	JMP I	ASKSTA
START1,	TEXT "START AT - "

OUTLP,	0
	LPC
	LSF
	JMP	.-1
	CLA
	JMP I	OUTLP

HACKA,	HACK
SPACEA,	SPACE
LDXRS,	TEXT "_LOAD, DUMP, START, ETC? "
/TIME INPUT

FREQ,	IFNZRO DC08A <
	-67 >			/55 TICKS PER SYSTEM TICK IF DC08A; INITIALIZED AT REFRESH TIME
IFZERO DC08A <-12>		/IN CASE OF PDP-8/A
CLKINA,	CLKINI
TIMCK2,	-INCLK2-1
TIMCK1,	-INCLK1
C660,	TICMIN			/TICKS PER MINUTE
	DECIMAL
DM24,	-24
D24,	24
DM60,	-60
D60,	60
	OCTAL

TIMEIN,	0
	CLA CLL
	MESSAG
	TIMESS			/TIME:
	GETIN
	STA
	TAD	INBUF
	DCA	AXS1
	DCA	CHAR
	NUMBIN
	JMP	TIMEIN+1
	TAD	DM24
	STL
	TAD	D24
	SZL			/HOURS BETWEEN 0 AND 23?
	JMP	TIMEIN+1	/NO
	DCA	NUMHO+1
	DCA	NUMHO
	TAD	D60
	JMS	DMUL
	DCA	CHAR
	NUMBIN
	JMP	TIMEIN+1
	TAD	DM60
	STL
	TAD	D60
	SZL			/MINUTES BETWEEN 0 AND 59?
	JMP	TIMEIN+1	/NO
	TAD	NUMHO+2
	DCA	NUMHO+1
	DCA	NUMHO
	TAD	C660
	JMS	DMUL
	CLL
	CDF
	TAD	NUMHO+2
	TAD	TIMCK1
	DCA I	CLK1
	RAL
	TAD	NUMHO+1
	TAD	TIMCK2
	DCA I	CLK2
	TAD	FREQ
	DCA I	CLKINA
	CHDF
	JMP I	TIMEIN

DMUL,	0
	DCA	MP2		/MULTIPLIER
	TAD	NUMHO+1		/LOW ORDER MULTIPLICAND
	JMS	MP4
	DCA	NUMHO+2		/LOW ORDER
	TAD	MP5
	DCA	NUMHO+1		/HIGH ORDER
	TAD	NUMHO		/HIGH ORDER MULTIPLICAND
	SNA
	JMP I	DMUL
	JMS	MP4
	TAD	NUMHO+1
	DCA	NUMHO+1
	RAL			/GET CARRY
	TAD	MP5
	DCA	NUMHO
	JMP I	DMUL


MP4,	0
	DCA	MP1
	DCA	MP5
	TAD	M12
	DCA	MP3
	CLL
	TAD	MP1
	RAR
	DCA	MP1
	TAD	MP5
	SNL
	JMP	.+3
	CLL
	TAD	MP2
	RAR
	DCA	MP5
	ISZ	MP3
	JMP	MP4+6
	TAD	MP1
	RAR
	CLL
	JMP I	MP4

MP1,	0
MP2,	0
MP3,	0
MP5=	CHDFA
M12,	-14
CORMES,	TEXT "# USER FIELDS - "


INBUFA=	.
	ZBLOCK 20		/INPUT BUFFER FOR INIT INPUT
*INIP+1600

/DECTAPE - READ OR WRITE ONE FIELD
/JMS TO DTRORW WITH DESIRED FIELD IN DTFLD, BEGINNING BLOCK MINUS
/ONE IN DTBLOK, DESIRED DRIVE IN CONTROLLER, AND DTFUNC
/0050 FOR A WRITE OR 0030 FOR A READ.

DTRORW,	0
	STA
	DCA	DTCAS		/START CA AT -1
	TAD	C7740
	DCA	DTBLCT		/40 BLOCKS PER FIELD
	DTRA
	AND	C0200		/IS TAPE MOVING??
	SNA CLA
	TAD	C0600		/NO - START IT THE OTHER WAY
	DTXA
DTSR1,	TAD	C7773
	DCA	DTRY			/TRY 5 TIMES UPON ERROR
DTSR2,	DTLB			/BLOCK NUMBERS TO THIS FIELD
	DCA I	C7755		/AT LOCATION 0
	TAD	C0010		/START SEARCHING
DTSR3,	DTXA
	JMS	DTWAIT		/WAIT
	DTRA
	RTL
	RTL			/DIRECTION BIT TO LINK
	CLA
	TAD	DTBLOK		/DESIRED BLOCK - 1
	CMA			/-DESIRED BLOCK
	SZL			/FUDGE IF GOING IN REVERSE
	TAD	C0003
	TAD	0		/REAL BLOCK - DESIRED BLOCK (+3?)
	SNA CLA			/WHAT DO WE DO NOW?
	SNL
	JMP	DTSR7		/KEEP GOING, MAYBE REVERSE DIRECTION
	TAD	C7600		/WE'RE THERE, MAKE WC=-200
	DCA I	C7754
	TAD	DTCAS
	DCA I	C7755		/SET UP CA
	TAD	DTFLD
	DTLB			/SET UP FIELD FOR TRANSFER
	TAD	DTFUNC
	DTXA			/SET UP FOR READ OR WRITE
	JMS	DTWAIT		/WAIT
	TAD I	C7755		/SAVE NEW CURRENT ADDRESS
	DCA	DTCAS
	DTRA			/REMOVE ANY FUNCTION FROM CONTROLLER
	AND	C0077
	DTXA
	ISZ	DTBLOK		/TIME FOR NEXT BLOCK
	ISZ	DTBLCT		/ARE WE THROUGH?
	JMP	DTSR1		/NO
	TAD	DTBLOK		/YES -
	TAD	CM2677		/END OF TAPE??
	SPA CLA
	JMP I	DTRORW		/NO
	TAD	C0400		/YES
	DTXA			/REWIND TAPE
	DTRA
	TAD	C1000		/GO TO NEXT DRIVE
	AND	C7000
	DCA	DTBLOK
	CHEKCC			/STALL
	DTRA DTXA
	CHEKCC			/STALL
	TAD	DTBLOK
	DTXA			/REMEMBER IT IN THE CONTROLLER
	DCA	DTBLOK		/START AT BLOCK 1
	CHEKCC			/STALL
	JMP I	DTRORW		/RETURN
DTSR7,	SNL			/REVERSE DIRECTION?
	JMP	DTSR3		/NO
	TAD	C0400
	ISZ	DTRY		/COUNT AN ERROR
	JMP	DTSR3		/AND GO REVERSE DIRECTION
	TAD	C7600		/AC=200
	DTXA			/STOP THE TAPE
	MESSAG
	TAPMIS
	JMP I	SUPERA

TAPMIS,	TEXT "_DECTAPE ERROR"

DTRY,	0
DTBLCT,	0			/COUNT OF BLOCKS TO R/W FOR ONE FIELD
DTBLOK,	0			/CURRENT DESIRED BLOCK MINUS ONE
DTFLD,	0			/DECTAPE FIELD IN BITS 6-8
DTFUNC,	0			/DECTAPE FUNCTION, 30 FOR READ, 50 FOR WRITE
DTLA=	6766			/SHOULDN'T BE HERE, BUT PUT IT IN WHILE I REMEMBER
DTCAS,	0
C7773,	7773
C7754,	7754
C7755,	7755
CM2677,	-2677
C0077,	0077
C7000,	7000
STATB,	0			/FOR DIAGNOSTIC PURPOSES
				/MOST RECENT DECTAPE STATUS B ON ERROR

/DTWAIT - SUBROUTINE TO WAIT FOR DECTAPE COMPLETION FLAG


DTWAIT,	0
	DTSF
	JMP	.-1		/WAIT FOR FLAG
	CHEKCC
	DTRB
	SMA CLA			/ANY ERROR?
	JMP I	DTWAIT		/NO
	DTRB
	DCA	STATB		/FOR DIAGNOSTIC PURPOSES
	TAD	STATB
	AND	C0400		/SELECT ERROR?
	SZA CLA
	JMP	DTWSEL		/YES
DTWGOR,	DTRA
	AND	C0377		/REMOVE FUNCTION FROM CONTROLLER
	DTXA
	TAD	C0600		/GO IN REVERSE
	DTXA
	JMP	DTSR2
DTWSEL,	DCA	0
	DTXA			/SELECT ERROR!
C0600,	0600			/WASTE TIME - SELECT ERROR RETURNS AFTER
C0377,	0377			/WASTE TIME - 5 MICROSECONDS AFTER DTXA
	CHEKCC
	DTRB			/IS IT STILL THERE?
	SPA CLA
	JMP	DTWSEL		/YES, TRY AGAIN
	ISZ	0		/NO, WAIT A WHILE
	JMP	DTWSEL+1
	JMP	DTWGOR		/OK, IT SEEMS TO BE GONE

*INIP+2000

/4K DISK READ OR WRITE


LOAD,	JMS I	RWB		/GO TO INITIALIZE CHDF, PRINT MESSAGE,
	CRLF			/AND DETERMINE READ OR WRITE
	TAD	C6603		/MAKE A DMAW OR A DMAR

	DCA	RORW
	MESSAG
	FIELD1
	GETIN
	TAD I	INBUF
	AND	C0007
	DCA	FLDNUM
	MESSAG
	TRACK
	GETIN
	OCTIN
	CLL RTL
	RAL
	TAD	FLDNUM
	DCA	FLDNUM
	DISC
RORW,	0
FLDNUM,	0
	DISCHK			/CHECK FOR DISK OK
	JMP	LOAD

C6603,	6603
RWB,	RW
ASCI7,
CLEAR,	0
	CLA
	DISC			/READ MONITOR II INTO FIELD 1
	6603
	TS8DEX+11
	DISCHK			/CHECK FOR OK DISK COMPLETION
	TAD	CLR1
	JMS	ZERO		/ZERO OUT FREE CORE
	JMP I	CLEAR

CLR1,	JOBTBL

ASCI6,
ZERO,	0			/CLEAR FIELD 1 FROM C(AC) TO 7777
	DCA	CLR2		/BEGINNING ADDRESS
	DATFLD
	DCA I	CLR2
	ISZ	CLR2
	JMP	.-2
	CHDF
	JMP I	ZERO
ASCNT,
CLR2,	0
/ROUTINE TO MOVE XDDT INTO DATFLD

LODDT,	0
	TAD	KM4400
	DCA I	FRENDA		/MAKE FRECORE STOP AT 4400
	STA
	TAD	K4400
	DCA	AXS1		/POINTS TO ORIGINAL
	TAD	AXS1
	DCA	AXS2		/POINTS TO COPY
LODDT1,	CHDF
	TAD I	AXS1
	DATFLD
	DCA I	AXS2
	ISZ	DDTSIZ		/ARE WE DONE YET?
	JMP	LODDT1
	DCA I	XOPA		/CHANGE ^C TO JUMP TO FIELD 0
	CHDF
	MESSAG
	XTELL
	JMP I	LODDT		/YES

XOPA,	XOP
K4400,	4400
KM4400,	-4400
FRENDA,	FREND
DDTSIZ,	4400-7577		/THIS GETS DESTROYED, BUT WHAT THE HECK

DDTMES,	TEXT "LOAD EXEC DDT AT START-UP? "