/INIT - UWM VERSION 25
/
/COPYRIGHT 1971, 1975		DIGITAL EQUIPMENT CORPORATION
/				MAYNARD, MASSACHUSETTS
/
/EXTENSIVELY MODIFIED AND CORRECTED BY
/	RICHARD BARTLEIN, 1974, 1976
/	UNIVERSITY OF WISCONSIN - MILWAUKEE

	*0
	JMP I .+1	/JUST IN CASE WE GET HERE
	SUPER
	*10
T8AX1,	.-1	/680 SERVICE
T8AX2,	.-1	/680 SERVICE
T8AX3,	.-1	/680 SERVICE
L2Q,	.-1	/LEVEL 2 QUEUE
L2QE,	.-1	/LEVEL 2 QUEUE EMPTY POINTER
AXS1,	.
AXS2,	.
DSKPTR,	.-1	/DISC REQUEST QUEUE POINTER

/CONSTANTS
C0002,	2
C0003,	3
C0007,	7
C0010,	10
C0100,	100
C0400,	400
C6203,	6203
C7770,	-10
C7774,	-4
C7777,	-1
MC0377,	-377

AUTOSW,	0	/ =0, FOR MANUAL RESTART
CHAR,	0	/CHAR & NUMHO MUST REMAIN ADJACENT
NUMHO,	0
	0
	0
CJOBMX,	-JOBMAX
CLK1A,	CLK1
CLK2A,	CLK2
CONDVA,	CONDBA
CORCNT,	0
CORTBA,	CORTBL-1
DSUTBA,	DSUTBL
INBUF,	INBUFA
SVCLK1,	0	/SAVED SYSTEM CLOCK
SVCLK2,	0
SVDATE,	0	/SAVED SYSTEM DATE
SVUPT1,	0
SVUPT2,	0
SWBASE,	SWDEX		/SWAP TRACT FOR JOB 1

T8SL,	.
T8NL,	.		/-NUMBER OF LINES
T8LN,	.
/NEXT 17 LOC USED BY 680 SERVICE AS DEFINED BELOW
T8INFL,	.	/INPUT READY FLAG
T8BFK,	.	/TO RESET INPUT BUFFER POINTER
T8NUML,	NULINE	/NUMBER OF LINES
T8K0,	.
T8K7,	.	/K FOR 1ST OUTPUT BUFFER
T8OUTK,	.	/POINTER TO FIRST OUTPUT BUFFER
T8OTK2,	.	/POINTER TO SECOND OUTPUT BUFFER
T8K14,	.
T8K36,	.	/K FOR 2ND OUTPUT BUFFER
T8CNT1,	.	/HOLD MAJOR LOOP COUNTER
T8CNT2,	.	/MINOR LOOP COUNTER
T8CNT3,	.	/COUNTER FOR INPUT BUFFER
T8K8,	.		/TO ENTER COMMON SUBROUTINE
T8K99,	.
T8SOUT,	.
KCHAR,	.		/CTY INPUT CHARACTER
TCHAR,	.	/CTY OUTPUT CHARACTER

/SUBROUTINE DISPATCHES

CHDF=	JMS .		/CHANGE TO CURRENT FIELD
CHDFA,	0
INIF,	CDI INFLD
	JMP I CHDFA

COMGET=	JMS I .
	COMGE0
DISC=	JMS I .
	DISC0
YESNO=	JMS I .
	YESNO0		/READ A 'Y' OR 'N'
MESSAG=	JMS I .
	MESSA0		/TYPE A PACKED MESSAGE
NUMBIN=	JMS I .
	NUMBI0		/READ IN A NUMBER
OCTIN=	JMS I .
	OCTIN0
PRINT=	JMS I .
	PRINT0		/QUEUE CHARACTERS FOR PRINTING
TYPE=	JMS I .
TYPEA,	OUT
GETIN=	JMS I .
	GETIN0
WAIT=	JMP I .
	WSCHED		/RESCHEDULE
	*200
/
/PROGRAM TO OPEN AND MODIFY SINGLE DISC REGISTERS
/
DISCLK,	MESSAG		/TYPE A CR-LF
	 CRLF
	JMS OTIN	/GET AN ADDRESS
	JMP DISCLK	/: IS ONLY VALID TERMINATOR
	JMP DISCLK
DISPLA,	JMS I PSPACE
	JMS I POPEN	/GET THE WORD FROM DISC
	TAD OPNREG
	JMS I PHACK	/ & TYPE IT OUT
	JMS I PSPACE
	JMS I PSAVE	/THEN SAVE IT FOR A MOMENT
	JMS OTIN	/GET NEW VALUE, IF ANY
	JMP SHUT	/<CR> - CLOSE REGISTER
	JMP CLSOPN	/<LF> - CLOSE & OPEN NEXT REGISTER
	JMP DISPLA	/: - TREAT AS NEW DISC ADDRESS

SHUT,	TAD INPUT	/WAS REGISTER ALTERED?
	SPA CLA
	JMP DISCLK	/NO - JUST GET NEXT ADDRESS
	TAD VALUE1	/YES - CHANGE THE DISC LOCATION
	DCA OPNREG
	JMS I PCLOSE
	JMP DISCLK	/NOW GET NEXT ADDRESS
CLSOPN,	TAD INPUT	/WAS REGISTER ALTERED?
	SPA CLA
	JMP .+4		/NO - JUST OPEN THE NEXT
	TAD VALUE1	/YES - WRITE OUT THE NEW VALUE
	DCA OPNREG
	JMS I PCLOSE
	TAD KCR		/NOW TYPE <CR>
	TYPE
	TAD KCR
	TYPE
	JMS I PRESTO	/GET THE CURRENT REGISTER ADDRESS
	JMS I PNXTAD	/ AND INCREMENT IT BY 1
	TAD VALUE	/THEN TYPE IT OUT
	JMS I PHACK
	TAD VALUE1
	JMS I PHACK
	TAD KCOLON
	TYPE
	JMP DISPLA	/THEN LOOK FOR ANY CHANGE

KCOLON,	":
KCR,	215
POPEN,	XOPN
PCLOSE,	CLOSE
PNXTAD,	NEXTAD
PSAVE,	SAVE
PRESTO,	RESTOR
PHACK,	HACK
PIN,	IN
PSPACE,	SPACE
/ROUTINE TO INPUT AN OCTAL NUMBER
/ECHOES INPUT IF IT WAS VALID
/CALL:	JMS OTIN
/	 CR TERMINATOR
/	 LF TERMINATOR
/	 : TERMINATOR
/
/RETURNS WITH "DOUBLE PRECISION" INPUT IN
/VALUE AND VALUE1
/INPUT=0 IF THERE WAS ANY, ELSE -1

OTIN,	0
	CLA CMA
	DCA INPUT	/NO INPUT YET
	DCA VALUE	/CLEAR THE NUMBER
	DCA VALUE1
	SKP
	TYPE
LISTEN, JMS I PIN
	DCA YCHAR
/
/NOW CHECK TO SEE IF THE INPUT HAD A VALID TERMINATOR
	TAD YCHAR
	TAD KMCOLON
	SNA CLA		/COLON?
	JMP COEXIT	/YES
	TAD YCHAR
	TAD KMLF
	SNA CLA		/LINE-FEED?
	JMP LFEXIT	/YES
	TAD YCHAR
	TAD KMCR
	SNA CLA		/CARRIAGE RETURN?
	JMP CREXIT	/YES
	TAD YCHAR
	TAD KMCX
	SNA CLA		/CTRL/X?
	JMP I XDDTA	/YES - ZING OFF TO XDDT
/
/NOT A VALID TERMINATOR - IS IT A VALID OCTAL DIGIT?
	TAD YCHAR
	TAD KMZERO
	SPA CLA		/LEGAL OCTAL DIGIT?
	JMP LISTEN	/NO - IGNORE IT
	TAD YCHAR
	TAD KMEIGHT
	SMA CLA
	JMP LISTEN
/
/COMES HERE WITH A VALID OCTAL DIGIT
	DCA INPUT	/INDICATE 'INPUT FOUND'
/
/NOW ADD THIS DIGIT TO THE DOUBLE PRECISION TOTAL
	TAD YCHAR
	AND C0007	/CONVERT THE DIGIT TO OCTAL
	DCA XCHAR
/
/FIRST, SHIFT HIGH-ORDER WORD LEFT ONE PLACE
	TAD VALUE
	CLL RAL
	CLL RAL
	CLL RAL
	DCA VALUE
/
/NOW GET LEFT-MOST LO-ORDER DIGIT
	TAD VALUE1
	RTL
	RTL
	AND C0007
/
/MOVE THIS DIGIT INTO THE HIGH ORDER WORD
	TAD VALUE
	DCA VALUE
/
/NOW ADD NEW INPUT DIGIT
	TAD VALUE1
	CLL RAL
	CLL RAL
	CLL RAL
	TAD XCHAR
	DCA VALUE1
	TAD YCHAR
	JMP LISTEN

COEXIT, ISZ OTIN
LFEXIT, ISZ OTIN
CREXIT,	JMP I OTIN
VALUE,	0
VALUE1,	0
OPNREG,	0
YCHAR,	0
XCHAR,	0
INPUT,	-1	/=-1, IF NO INPUT; =0, IF INPUT
KMCOLO,	-":
KMCX,	-230	/CTRL/X
KMLF,	-212
KMCR,	-215
KMZERO,	-"0
KMEIGH,	-"8
XDDTA,	7000	/XDDT ADDRESS
	PAGE
/ROUTINE TO OPEN A DISC LOCATION (REGISTER)
XOPN,	0
	TAD I PVALUE	/SET THE DISC ADDRESS
	IFZERO RF08-40 <
	AND K177
	CLL RTL; RTL; RTL
	>
	DCA DISCHI
	TAD I PVALU1
	DCA DISCLO
	TAD RDIOT	/SET FOR READ
	JMS DISK
	JMP I XOPN
RDIOT,	DMAR

/ROUTINE TO CLOSE A DISC REGISTER
CLOSE,	0
	TAD WRIOT	/SET FOR WRITE
	JMS DISK
	JMP I CLOSE
WRIOT,	DMAW

/DISC TRANSFER ROUTINE
DISK,	0
	DCA DLKIOT	/READ OR WRITE IOT
	RIF
	TAD K6201
	DCA INIF	/SET UP 'CHDF' ROUTINE
	IFZERO RK8E <
K6201,	CDF		/DOWN TO FIELD 0
	CLA CMA		/MOVING JUST ONE WORD
	DCA I P7750
	TAD PREGAD
	DCA I P7751
	CHDF
	RIF
	IFZERO RF08-40 <
	TAD DISCHI	/GET THE DISC EXTENSION
	>
	DIML		/SET FIELD (& EXTENSION)
	IFZERO RF08 <
	TAD DISCHI	/GET HIGH-ORDER ADDRESS
	DXAL
	>
	CLA		/DEAL DOESN'T CLEAR AC
	TAD DISCLO	/GET LO-ORDER ADDRESS
DLKIOT,	0		/DMAR OR DMAW
	DFSE		/ANY ERRORS?
	IFZERO RF08 <
	SKP CLA		/NO
	HLT		/YES - JUST DIE
	DFSC		/I/O FINISHED?
	JMP .-4		/NO - JUST WAIT
	>
	IFZERO RF08-40 <
	HLT		/YES - JUST DIE
	DFSC		/FINISHED?
	JMP .-3		/NO - JUST WAIT
	>
	DCMA		/CLEAR THE DISC FLAG
	JMP I DISK	/ AND RETURN

P7750,	7750
P7751,	7751
PREGAD,	OPNREG-1	/REGISTER VALUE
	>
	IFNZRO RK8E <
	TAD DISCLO	/SET THE DATA POINTER
	DCA DISK3
	TAD DLKIOT	/GET THE IOT
	RTR
	SZL CLA		/IS THIS A WRITE?
	JMP .+5		/NO
	TAD I PREGAD	/ & SET THE NEW VALUE
K6201,	CDF
	DCA I DISK3
	CHDF
	TAD DISCHI	/SET THE DISC EXTENSION
	CLL RTL; RAL
	DCA DISKAD
	DISC		/DO THE I/O
DLKIOT,	 0	/FUNCTION
DISKAD,	 0	/DISC EXT. & FIELD
	HLT		/ERROR - JUST DIE
	CDF		/CHANGE TO THE DATA FIELD
	TAD I DISK3	/ & GET THE REGISTER CONTENTS
	CHDF
	DCA I PREGAD	/ & SAVE THE VALUE
	JMP I DISK	/THEN RETURN
DISK3,	0
PREGAD,	OPNREG		/REGISTER VALUE
	>

DISCLO,	0
DISCHI,	0
K177,	177
PVALUE, VALUE
PVALU1, VALUE1
/ROUTINE TO TYPE THE 4 OCTAL DIGITS IN THE ACC
/ON THE TELEPRINTER

HACK,	0
	CLL RTL
	RTL
	DCA XHACK
	TAD C7774
	DCA XCNT	/SET DIGIT COUNTER
YHACK,	TAD XHACK
	AND C0007
	TAD K260
	TYPE
	TAD XHACK
	RAL
	RTL
	DCA XHACK
	ISZ XCNT
	JMP YHACK
	JMP I HACK
XCNT,	0
XHACK,	0
K260,	260

/ROUTINE TO GET A CHAR FROM THE KEYBOARD
IN,	0
	CLA
	KSF
	JMP .-1
	KRB
	AND K177	/ZAP THE PARITY BIT
	SNA
	JMP IN+1	/IGNORE NULLS
	TAD K200
	DCA SAVE
	TAD SAVE
	TYPE
	TAD SAVE
	TAD MLCA
	SPA		/IS IT LOWER-CASE?
	JMP IN1		/NO
	TAD MLCZ
	SMA SZA
	JMP IN1		/NO
	TAD LCFIX	/YES - CONVERT IT TO UPPER
	DCA SAVE
IN1,	CLA CLL
	TAD SAVE
	JMP I IN	/RETURN W/ AC = CHAR
K200,	200
LCFIX,	372-40
MLCA,	-341	/LOWER-CASE "A"
MLCZ,	341-372	/ AND "Z"

/ROUTINE TO TELEPRINT A CHAR

OUT,	0
	TLS
	CLA
	TSF
	JMP .-1
	JMP I OUT

/TYPE TWO SPACES

SPACE,	0
	TAD KSPACE
	TYPE
	TAD KSPACE
	TYPE
	JMP I SPACE
KSPACE,	240

/ROUTINE TO INCREMENT THE DOUBLE-PRECISON VALUE
/IN VALUE, VALUE1

NEXTAD,	0
	CLA
	ISZ I PVALU1
	JMP I NEXTAD
	ISZ I PVALUE
	JMP I NEXTAD

/ROUTINE TO SAVE VALUE, VALUE1
SAVE,	0
	TAD I PVALUE
	DCA SAVE1
	TAD I PVALU1
	DCA SAVE2
	JMP I SAVE

/ROUTINE TO RESTORE VALUE, VALUE1
RESTOR,	0
	TAD SAVE1
	DCA I PVALUE
	TAD SAVE2
	DCA I PVALU1
	JMP I RESTOR
SAVE1,	0
SAVE2,	0
	PAGE
/ROUTINE TO TYPE PACKED MESSAGES.
/THE CHARACTER '_' CAUSES CR-LF TO BE TYPED.
/CALLING SEQUENCE:
/	MESSAG
/	 ADDRESS OF PACKED-MESSAGE
/	RETURN

MESSA0,	0
	TAD I MESSA0	/GET THE MESSAGE ADDRESS
	DCA MSGPTR
	ISZ MESSA0
MSGLP,	TAD I MSGPTR
	CLL RTR; RTR; RTR
	JMS MSGPRT	/TYPE LEFT CHARACTER
	TAD I MSGPTR
	JMS MSGPRT	/ AND THEN THE RIGHT-HAND
	ISZ MSGPTR
	JMP MSGLP

MSGPRT,	0
	AND MSG77	/ZAP ANY BAD BITS
	SNA		/ARE WE DONE?
	JMP I MESSA0	/YES - RETURN
	TAD MSGM37
	SNA		/IS IT '_'?
	JMP MSGCR	/YES - TYPE <CR-LF>
	SPA		/IS IT ALPHABETIC?
	TAD C0100	/YES - ADD IN BIT
	TAD MSG237	/ & ADD BACK 37 & PARITY
MSGPR1,	TYPE		/TYPE THE CHARACTER
	JMP I MSGPRT

MSGCR,	TAD MSG215	/'_' MEANS <CR-LF>
	TYPE
	TAD MSG212
	JMP MSGPR1	/GO SHARE SOME CODE

MSGPTR,	0
MSG77,	77
MSG212,	212
MSG215,	215
MSG237,	237
MSGM37,	-37

AUTOMS,	TEXT /__SYSTEM CRASH: /
CORMES,	TEXT /# USER FIELDS - /
RDORWT,	TEXT /_READ OR WRITE/
FIELD1,	TEXT /FIELD # - /
TRACK,	TEXT /TRACK # - /
OOPS,	TEXT /OOPS_/
CRLF=	.-1
FIPREM,	TEXT /REFRESH??/
DATMES,	TEXT /MONTH-DAY-YEAR: /
TIMESS,	TEXT /HR:MIN - /
DASH=	.-2
DDTMES,	TEXT /LOAD XDDT? /
LDXRS,	TEXT /_LOAD, DUMP, START?? /
	PAGE

/SYSTEM INITIALIZATION

SYSINI,	CLA CLL
	CHDF		/SET THIS FIELD
	JMS I SYSPER
	DISC		/LOAD FIELD 0
	 DMAR
	 TS8DEX
	JMP .-3		/ERROR - TRY AGAIN
	TAD DVTB
	DCA INIT0
SYSI1,	TAD I INIT0
	DCA CHDFA
	JMS I CHDFA
	ISZ INIT0
	JMP SYSI1

SYSPER,	PERSET
INIT0,	0		/VARIABLE DVTB POINTER

DVTB,	.+1
	CLEAR		/READ MONITOR II INTO DATFLD
	CORINI
	T8INI
	DSKINI
	CLKINI
	RDYMSG
		IFNZRO BILLNG <
	FRCJOB
		>
	START

/INITIALIZE THE TIME AND DATE; IF WE'RE DOING AN AUTO-RESTART
/WE USE THE TIME AND DATE FROM THE PREVIOUS SYSTEM.  IF WE
/AREN'T RESTARTING FROM A CRASH, WE RESTORE THE SYSTEM
/UPTIME.
CLKINI,	0
	CHDF
	TAD AUTOSW
	SZA CLA		/DOING AN AUTOMATIC RESTART?
	JMP CLKIN1	/YES - DON'T RESTORE THE UPTIME
	TAD SVUPT1
	DATFLD
	DCA I UPTM1A	/NO - RESTORE THE SYSTEM UPTIME
	TAD SVUPT2
	DCA I UPTM2A
CLKIN1,	CHDF
	JMS I CLKDAT
	JMS I CLKTIM
	JMP I CLKINI
/
CLKDAT,	DATEIN
CLKTIM,	TIMEIN
UPTM1A,	UPTIM1
UPTM2A,	UPTIM2

		IFNZRO BILLNG <
/ROUTINE TO FORCE THE HIGHEST CONFIGURED KEYBOARD UP;
/THIS IS DONE JUST BEFORE THE SYSTEM IS ACTUALLY STARTED
/AND IS NORMALLY USED TO BRING 'BATCH' BACK ONLINE.

FRCJOB,	0
	CHDF
	TAD FRCDEV
	CIF
	GETDDB		/GET AN INPUT DDB
	JMP I FRCJOB	/NONE THERE; SHOULD CRASH HERE, BUT JUST RETURN
	DATFLD
	TAD I FRCDEV
	DCA CHDFA	/NOW POINTS TO THE DDB ITSELF
	TAD I CHDFA
	TAD FRCFLG
	DCA I CHDFA	/SET THE 'DSI', 'DFORC', AND 'CTRLB' BITS
	CHDF
	TAD FRCSTR
	DCA AXS1	/SET THE POINTER TO THE COMMAND LINE
FRCJ1,	TAD I AXS1
	SNA		/END OF FORCE STRING?
	JMP I FRCJOB	/YES - RETURN
	CDF
	DCA I TTYCHR	/STORE THE CHARACTER IN FIELD 0
	CHDF
	CIF
	GIR		/NOW PROCESS THE CHARACTER
FRCDEV,	 DEVTBL+NULINE+NULINE
	JMP I FRCJOB	/NO ROOM - JUST RETURN
	JMP FRCJ1

FRCFLG,	DSI+DHALF+DFORC+CTRLB
GETDDB=	JMS I .
	GETDB0
GIR=	JMS I .
	GIR00
TTYCHR,	TTCHAR
/
FA1=	BILLNG%1000+"0
FA2=	BILLNG^10%1000+"0
FA3=	BILLNG^100%1000+"0
FA4=	BILLNG^1000%1000+"0
FJ1=	JOBMAX%10
FJ2=	-FJ1^10+JOBMAX
FRCSTR,	.
	"L;"O;"G;"I;"N;" ;FA1;FA2;FA3;FA4;" ;"A;" ;"0+FJ1;"0+FJ2
	";;"R;"U;" ;"L;"O;"G;"$;"4;"3
	";;"T;"A;" ;"0;" ;"L;"O;"G;"$;" ;"S;"T;"A;"R;"T;"E;"D;215;0
		>

/HERE WE FINALLY START UP TSS/8 BY ENTERING THE SCHEDULAR.

START,	0
	CLA CLL
	IFZERO CPU-2	<
	CAF
	>
	IFNZRO CPU-2 <
	IFNZRO RK05+RK8E <
	CLA CLL IAC
	DCLR		/CLEAR THE RK05
	>
	DTCA
	IFNZRO LPT	<LCF>	/CLEAR PRINTER
	RRB		/CLEAR ALL INTERRUPT FLAGS
	CLA
	PCF
	TCF
	CUF		/TURN OFF THE USER-MODE
	>

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

	IFZERO D680-2 <
	TT8ON
	>
	IFZERO D680 <
		IFZERO CPU-1 <
		CLL CMA			/LOAD CLOCK BUFFER
		CCF CLB
	>>
	IFZERO D680 <
		IFNZRO CPU-3 <
	CECI
	>>
		IFZERO	CPU-3	<
	TAD M62		/50 MILLISECONDS PER TIC.
	OCTAL
	CLAB
	CLA
	TAD C4100
	CLLR
	CLA
	TAD C300
	CLEN
	CLSA
	CLA CMA
	MTON
	CLA IAC
	MINT
	CLA
		>
	CIF CDF
	WAIT		/NOW START TSS/8
		IFZERO	CPU-3	<
M62,	-62
C4100,	4100
C300,	300
		>
	PAGE
	IFZERO D680-2 <
/INITIALIZE 680 SYSTEM

M8=	C7770
T8INCT,	0
T8GO,	T8GOS
	>

KC=	KCC-30
T8INI,	0
	IFNZRO CPU-3 <
		IFZERO D680-2	<
	TAD T8NUML
	T8INIT
	0
	TAD M8		/WAIT 8 CLOCK TICKS
	DCA T8INCT
	TT8ON
	T8SKP		/WAIT
	JMP .-1
	ISZ T8INCT	/DONE?
	JMP .-4		/NO
	T8OFF
		>

T8INPT,	30+KC	/K00 - INPUT DEVICE CODE
	400+KC
	420+KC	/K02
	440+KC
	460+KC	/K04
	340+KC
	110+KC	/K06
	300+KC
	320+KC	/K10
	500+KC
	520+KC	/K12
	540+KC
	560+KC	/K14
	700+KC
	360+KC	/K16
	720+KC
	740+KC	/K20
	060+KC
	140+KC	/K22
	160+KC

	*T8INPT+KL8+PT08
	JMP I T8INI

	IFZERO NULINE-24&4000	<GLITCH>
	>
	IFZERO CPU-3 <
	JMP I T8INI	/A BIGGY IF A DC02, ISN'T IT
	>
	IFZERO D680-2 <
/INITIALIZATION
/ENTER WITH NUMBER OF LINES IN AC
/FORMAT		T8INIT
/		1ST LINE NO.

T8INIT=	JMS I T8GO

T8GOS,	0
	CDF
	DCA I T8NL	/NO. OF LINES
	CHDF
	TAD I T8GOS	/STARTING LINE NO.
	CDF
	CLL RTL		/POSITIONED
	RAL		/ IN
	DCA T8K26	/ BITS 2-8 (INITIAL LSW)
	DCA T8K15	/CLEAR THE CTR
	TAD I T8NL	/RAISE NO. OF
	ISZ T8K15	/ LINES TO AN
	TAD T8K16	/ EVEN MULTIPLE
	SNA		/OF 5, SKP IF NOT INTEGRAL ANS.
	JMP .+7		/CAME OUT EVEN
	SMA		/SKP IF WE'VE GONE BEYOND
	JMP .-5		/CONTINUE
	TAD T8K19	/BACK UP ONE
	ISZ I T8NL	/UP THE NO OF LINES
	SZA		/SKIP IF FINISHED
	JMP .-3		/CONTINUE BACKING UP
	CLA
	TAD T8K15
	CIA
	DCA T8K15	/STORE -N/5
	TAD I T8NL
	CIA
	DCA I T8NL	/STORE -N
	TAD I T8BFK	/INPUT BUFF.PTR
	DCA I PT8AX2
	TAD T8K16	/-5
	DCA I PT8CT1	/MAJOR LOOP COUNTER
	TAD T8K15	/-N/5
	DCA I T8K23	/T8MNC
	TAD T8K38	/SET CTR FOR MAX NO.
	TAD T8K15	/CHARS PER PASS EQ
	DCA I T8K0	/32-N/5
	TAD I T8NL
	DCA I T8K14	/-NO. LINES
	STA
	DCA I T8CNT3	/SET TO SKP
	TAD I T8K7	/T8OBF
	DCA I T8OUTK	/1ST OUTPUT BUFFER POINTER
	TAD I T8K36	/T8OBF2
	DCA I T8OTK2	/2ND OUTPUT BUFFER POINTER
	CHDF
	TAD I T8GOS	/STARTING LINE NO.
	CDF
	DCA I T8K33	/T8K9, STARTING LINE NO. -1
	TAD I T8K33
	DCA I TT8K39
	TAD I T8K33	/T8K9
	CIA		/MAKE NEGATIVE
	DCA I T8K34	/T8SL, -STARTING LINE NO.
	DCA T8INFL	/CLEAR INPUT FLAG COUNTER
	STA		/-1
	DCA I T8K35	/T8LC, RESET INTERRUPT LEVEL COUNTER
	ISZ T8GOS	/INDEX EXIT
	CHDF
	JMP I T8GOS	/EXIT

/CONSTANTS
T8K15,	0		/SET TO -N/5
T8K16,	-5		/FOR EVN MULT OF FIVE
T8K17,	10		/FOR ADDING TO LINE NO.
T8K19,	1		/USED TO FORM MULT OF 5
T8K20,	T8IN-1		/FOR STORING TTI'S
T8K21,	T8OBF-1		/DOUBLE BUF-
T8K22,	T8OBF2		/FERED OUTPUT
T8K23,	T8MNC		/FOR -N/5
T8K25,	TTI		/FOR THE TTI TABLE
T8K26,	0		/LINE STATUS WORD
T8K27,	2000		/CHAR. ASSEMBLY WOR
T8K28,	JMS I T8K99	/FOR JUMP TO STORE CHAR
T8K29,	JMP I T8K8	/FOR FINAL JUMP
T8K33,	T8K9		/FOR STARTING LINE-1
T8K34,	T8SL		/-STARTING LINE NO.
T8K35,	T8LC		/FOR INTERRUPT LEVEL COUNTER
T8K38,	40		/USED FOR NO. CHR/PASS
TT8K39,	T8LN

PT8AX2,	T8AX2
PT8CT1,	T8CNT1
	>
	PAGE

CORFRE,	FREE
CORFCT,	FRECNT
CORF1,	RINGIN
CORGEA,	RINGIN
CORLNK,	0
CORMAX,	CORMEM%10-1	/NUMBER OF USER FIELDS
CORSRA,	CORSRC		/RESIDENT CORTBL SEARCH ROUTINE
FREND,	-FIPBLK		/END OF FREE CORE AREA
FRIEND,	-FIPBLK
LODDTA,	LODDT		/LOAD XDDT INTO FIELD 1

CORINI,	0
	TAD AUTOSW
	SZA CLA		/AUTO-RESTART?
	JMP CORIN0	/YES - ASSUME CONFIGURED MEMORY
	JMP CORIN0	/CHANGE TO 'NOP' FOR XDDT & MEMORY MESSAGE

	IFNZRO CPU-3 <
	YESNO		/LOAD XDDT?
	 DDTMES
	SKP		/NO
	JMS I LODDTA	/YES - MOVE XDDT INTO FIELD 2
		>
	MESSAG		/# USER FIELDS -
	 CORMES
	GETIN		/READ THE RESPONSE
	OCTIN		/ AND CONVERT IT FROM ASCII
	JMP .+2
CORIN0,	TAD CORMAX	/GET THE NUMBER OF USER FIELDS
	AND C0007
	SNA		/ANYTHING ENTERED?
	IAC		/NO - ASSUME 1 USER FIELD
	DCA CORCNT
	TAD CORCNT
	CIA
	DCA AXS1	/SAVE COUNTER FOR CORE-SEARCH ROUTINE
	CLL CMA RTL
	TAD CORSRA
	DCA AXS2
	CDF
	TAD AXS1
	DCA I AXS2	/SET (-) # USER FIELDS
	TAD CORCNT
	TAD C0002	/ALLOW FOR 'DATFLD' AND INITIAL 'CORTBL' OFFSET
	TAD CORTBA
	CIA
	DCA I AXS2	/SET (-) THE FIRST LOCKED ENTRY IN CORTBL
	TAD CORTBA
	IAC		/ (SKIP 'DATFLD')
	DCA AXS2
	DCA I AXS2	/NOW UNLOCK ALL USER FIELDS
	ISZ AXS1
	JMP .-2
	TAD CORCNT
	TAD C0002	/ALLOW FOR THE RESIDENT MONITOR
	CLL RTL
	DCA CORCNT	/CORCNT = TOTAL # FIELDS * 4
	TAD CORCNT
	TAD DSUTBA
	TAD C0010	/ALLOW 'DSUTBL' TERMINATOR (1 WORD)
	AND C7770	/ AND FIND NEXT 8-WORD BOUNDARY
	DCA I CORFRE	/SET THE POINTER TO THE FREE-CORE
	TAD CORGEA
	DCA CORF1	/SET POINTER TO ADDITION FREE-CORE LIST
	TAD FRIEND
	DCA FREND	/ (JUST IN CASE INIT GETS REUSED)
	TAD I CORFRE
	DATFLD
CORIN1,	DCA CORLNK
	TAD CORLNK
	TAD C0010
	DCA AXS2
CORIN2,	TAD AXS2
	TAD FREND
	SNA CLA		/IS THE NEXT BLOCK PAST THE END?
	JMP CORIN3	/YES - WE'RE DONE
	TAD AXS2
	DCA I CORLNK	/NO - SET THE LINK-WORD IN THE PREVIOUS BLOCK
	TAD AXS2
	ISZ AXS1	/INCREMENT OUR BLOCK COUNTER
	JMP CORIN1
	HLT		/OOPS!!
CORIN3,	TAD I CORF1
	SNA		/ANY MORE 'EXTRA' SPACE?
	JMP CORIN4	/NO
	DCA AXS2	/YES - OVERLAY THE UNUSED DEVICE HANDLERS
	ISZ CORF1
	TAD I CORF1
	CIA
	DCA FREND	/SET THE AREA LIMIT
	ISZ CORF1
	JMP CORIN2
CORIN4,	DCA I CORLNK	/LAST LINK IS ZERO
	TAD AXS1
	IAC
	CDF
	DCA I CORFCT	/SET THE NUMBER OF FREE-CORE BLOCKS
	CHDF
	JMP I CORINI


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

SKISPA,	-240
SKITAB,	240-211

SKIPS,	0
SKIPS1,	COMGET		/FETCH A CHARACTER
	JMP I SKIPS	/NONE LEFT
	TAD SKISPA
	SZA		/A SPACE?
	TAD SKITAB
	SNA CLA		/ OR A TAB (CTRL/I)?
	JMP SKIPS1	/YES - IGNORE IT
	ISZ SKIPS
	JMP I SKIPS	/RETURN NORMALLY
	PAGE
/THIS ROUTINE READS OR WRITES 4K AT A TIME.
/CALLING SEQUENCE:
/	DISC
/	 FUNCTION	(6603 OR 6605)
/	 DDDM		D=DISC EXTENSION, M=DATA FIELD (BITS 9-11)
/	ERROR RETURN
/	NORMAL RETURN
/
	IFZERO RK8E <

DISC0,	0
	RDF
	TAD C6201
	DCA DISC1
	TAD DISC1
	DCA DISC2
	TAD I DISC0	/GET THE FUNCTION WORD
	DCA DISROW
	ISZ DISC0
	TAD I DISC0	/GET THE FIELD # & DISC EXT.

	IFZERO RF08-40 <
	ISZ DISC0
	CLL RTL
	RAL
	DEAL		/ AND SEND THEM TO THE CONTROLLER
	CLA CLL
	>
	IFZERO RF08 <
	RTL
	RAL
	AND C0070
	DIML		/SEND OUT THE FIELD SELECT
	TAD I DISC0
	CLL RTR
	RAR
	DXAL		/ AND THE DISC EXTENSION
	ISZ DISC0
	>
C6201,	CDF
	TAD I C7750
	DCA WCSAVE	/SAVE THE CURRENT DATA-BREAK WORDS
	TAD I C7751
	DCA MASAVE
	DCA I C7750	/THEN SET FOR ENTIRE FIELD
	STA
	DCA I C7751	/ STARTING AT ADDRESS 0
DISC1,	0
DISROW,	0		/THEN START THE TRANSFER
	DFSC
	JMP .-1
	DFSE		/ANY ERRORS?

	IFZERO RF08-40 <
	SKP
	>
	ISZ DISC0	/NO - FIX THE RETURN ADDRESS
	CLA CLL
	TAD WCSAVE
	CDF
	DCA I C7750	/FINALLY, RESTORE THE CONTROL WORDS
	TAD MASAVE
	DCA I C7751
DISC2,	0
	JMP I DISC0	/ AND RETURN

C0070,	70
C7750,	7750
C7751,	7751
MASAVE,	0
WCSAVE,	0
	>
	IFNZRO RK8E <
/
/ROUTINE TO HANDLE THE RK08/E DISC.

DISC0,	0
	CLA CLL CMA RTL	/SET THE ERROR RE-TRY COUNTER
	DCA DISCER
DSRTRY,	TAD I DISC0	/GET THE FUNCTION
	RTR; RAR	/ & ISOLATE THE READ/WRITE BIT
	CLA RAR
	DCA DISCMD
	ISZ DISC0
	TAD I DISC0	/NOW GET THE ADDRESSING INFORMATION
	RTL; RAL
	AND DS70	/PICK OUT THE DATA FIELD
	TAD DISCMD
	DCA DISCMD	/ & SAVE IT IN THE COMMAND-WORD
	TAD DSM20	/INITIALIZE THE BLOCK COUNTER
	DCA DSBLKS
	DLCA		/ & LOAD THE CORE ADDRESS
	TAD I DISC0	/NOW GET THE DISC ADDRESS
	AND DS7770
	CLL RAL
	DCA DISCAD
	SZL		/HIGH-ORDER BIT ON?
DSOVFL,	ISZ DISCMD	/YES - SET IT IN THE COMMAND-WORD
DSLOOP,	DCA DSHDCK	/SET 'CHECK-HEADER' SWITCH
	DCLR		/CLEAR THE CONTROLLER
	TAD DSHDCK	/GET THE 'CHECK-HEADER' SWITCH
	CLL RTR
	TAD DISCMD	/ & THE REST OF THE COMMAND
	DLDC
	TAD DISCAD	/NOW GET THE DISC ADDRESS
	DLAG		/ & DO THE I/O
	DSKP
	JMP .-1
	DRST		/BACK AGAIN! GET THE STATUS
	CLL RAL
	SZA		/ANY ERROR BITS?
	JMP DSERR	/YES
	ISZ DSBLKS	/NO - DECREMENT BLOCK-COUNT
	SKP
	JMP DISCDN	/ALL DONE
	TAD DISCAD	/NO - CHECK FOR END OF TRACK
	CMA
	AND DS37
	SZA CLA		/ARE WE AT A BOUNDARY?
	CLA CLL CML RAR	/NO - SKIP HEADER CHECK
	ISZ DISCAD	/NOW INCREMENT THE ADDRESS
	JMP DSLOOP	/ AND DO IT AGAIN
	JMP DSOVFL	/ADDRESS OVERFLOWED - INCREMENT HI-ORDER

/WE HIT AN ERROR CONDITION - RE-CALIBRATE THE DISC & TRY AGAIN.
DSERR,	AND DS1002
	SNA CLA		/WAS IT A SEEK-FAIL OR CYL. ADDR ERROR?
	JMP DSAGN	/NO - JUST TRY AGAIN
	DCLR		/YES - WE RE-CALIBRATE THE DRIVE
	CLA CLL CML RTL	/ (AC=2)
	DCLR
	DSKP
	JMP .-1
	DCLR
	DRST		/NOW WAIT FOR THE STATUS TO CLEAR
	SZA CLA
	JMP .-2
DSAGN,	CLA CLL CMA
	TAD DISC0	/BACK UP THE PARAMETER POINTER
	DCA DISC0	/ SO WE START FRESH
	ISZ DISCER	/ BUT WE ONLY TRY 3 TIMES
	JMP DSRTRY
DISCDN,	ISZ DISC0	/GOOD FINISH - FIX RETURN ADDRESS
	ISZ DISC0
	JMP I DISC0	/THEN RETURN

DISCAD,	0
DISCMD,	0
DISCER,	0
DSBLKS,	0
DSHDCK,	0
DSM20,	-20
DS37,	37
DS70,	70
DS1002,	1002
DS7770,	7770
	>
/
/SUBROUTINE TO READ A LINE FROM THE KEYBOARD.
GETIN0,	0
	TAD INBUF
	DCA BUFPTR
GETIN1,	JMS I GETCHR	/READ A CHARACTER
	DCA I BUFPTR
	TAD I BUFPTR
	TAD MC0377
	SZA CLA		/RUBOUT IN STRING?
	JMP GETIN3	/NO
	TAD INBUF	/YES - ANYTHING TO RUB OUT?
	CIA
	TAD BUFPTR
	SNA CLA
	JMP GETIN1	/NO - JUST IGNORE RUBOUT
	CLA CMA		/YES - BACK UP THE POINTER
	TAD BUFPTR
	DCA BUFPTR
	TAD I BUFPTR	/ECHO CHARACTER
	TYPE
	JMP GETIN1

GETIN3,	TAD BUFPTR
	TAD BUFLIM
	SNA CLA		/REACHED BUFFER LIMIT?
	JMP GETIN4	/YES - RING THE BELL
	TAD I BUFPTR
	ISZ BUFPTR	/ & INCREMENT THE POINTER
	TAD CM215
	SZA CLA		/IS IT A CARRIAGE RETURN?
	JMP GETIN1
	TAD C0212
	TYPE		/YES - TYPE A LINE-FEED
	DCA I BUFPTR	/ AND STORE A ZERO
	CLA CMA
	TAD INBUF
	DCA AXS1	/SET THE INDEX REGISTER
	JMP I GETIN0
GETIN4,	TAD C0007
	TYPE
	JMP GETIN1

BUFLIM,	-INBUFZ
BUFPTR,	0
CM215,	-215
C0212,	212
GETCHR,	IN
	PAGE
/INIT BOOTSTRAP - LOAD TRACK 2 INTO FIELD 0

INBOOT,	CDF
	STA
	DCA I B7751
	DCA I B7750
	IOF

	IFZERO D680-2 <
	T8OFF
	>
/START HERE IF WC & MA SETUP
	IFZERO RF08 <
	DIML		/SET THE FIELD NUMBER
	CLA CLL CML RTL
	DXAL		/ AND THE TRACK NUMBER
	>
	IFZERO RF08-40 <
	TAD S0200
	DEAL		/SET THE TRACK & FIELD
	CLA
	>
	DMAR		/NOW START THE READ
	DFSC
	JMP .-1
	CIF CDF
	JMP I .+1	/WHEN DONE, START UP 'INIT'
	SUPER

B7750,	7750
B7751,	7751
S0200,	200	/INIT TRACK
/DATE INPUT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1

DATMUL,	DMUL
CMBASE,	-112	/ '74
CM13,	-15
CMCR,	-215
CM32,	-40
C0012,	14
C0031,	37
DATMON,	0
DATDAY,	0
DATEA,	DATE

DATEIN,	0
	CLA CLL
	TAD AUTOSW
	SNA CLA		/DOING AN AUTO-RESTART?
	JMP .+3		/NO
	TAD SVDATE
	JMP DATE1	/YES - USE SAVED CURRENT DATE
	MESSAG		/MONTH-DAY-YEAR:
	 DATMES
	GETIN
	NUMBIN		/MONTH
	 -"9
	JMP DATEIN+1
	SNA
	JMP DATEIN+1
	DCA DATMON
	TAD DATMON
	TAD CM13
	SMA CLA		/0<MONTH<13?
	JMP DATEIN+1	/NO
	NUMBIN		/DAY
	 -"9
	JMP DATEIN+1
	SNA
	JMP DATEIN+1
	DCA DATDAY
	TAD DATDAY	/0<DAY<32?
	TAD CM32
	SMA CLA
	JMP DATEIN+1
	NUMBIN		/YEAR
	 -"9
	JMP DATEIN+1
	SNA
	JMP DATEIN+1
	TAD CMBASE
	SPA
	JMP DATEIN+1
	DCA NUMHO+1
	TAD C0012
	JMS I DATMUL
	STA
	TAD DATMON
	TAD NUMHO+2
	DCA NUMHO+1
	TAD C0031
	JMS I DATMUL
	STA
	TAD DATDAY
	TAD NUMHO+2
DATE1,	CDF
	DCA I DATEA
	CHDF
	JMP I DATEIN
/ROUTINE TO TYPE A MESSAGE AND CHECK FOR A YES-NO RESPONSE.
/CALLING SEQUENCE:
/	YESNO
/	 MSGAD	/ADDRESS OF QUESTION
/	'NO' RETURN
/	'YES' RETURN

YESNO0,	0
	TAD I YESNO0
	ISZ YESNO0
	DCA .+2
	MESSAG
	 0
	GETIN
	TAD I INBUF
	TAD CM331
	SNA CLA		/FIRST CHARACTER A "Y"?
	ISZ YESNO0	/YES - INDEX RETURN
	JMP I YESNO0
CM331,	-331

/ROUTINE TO FETCH ONE CHARACTER FROM THE KEYBOARD BUFFER.

COMGE0,	0
	TAD I AXS1
	DCA CHAR
	TAD CHAR
	TAD CMCR
	SNA CLA		/CARRIAGE RETURN?
	JMP .+4		/YES-RESET AXS1 SO NEXT CALL FINDS CR
	ISZ COMGE0	/NO
	TAD CHAR
	JMP I COMGE0	/RETURN WITH AC = CHAR = CHARACTER
	STA
	TAD AXS1
	DCA AXS1		/BACK UP POINTER
	JMP I COMGE0
	PAGE

/NUMBER INPUT
/CALL:	NUMBIN
/	 -"N	N=7,9 IN ASCII
/	NOT A NUMBER
/	# IN AC

NUMAGN=	NUMHO+1	/MAGNITUDE
NUMB17,	17
NUMCNT,	0	/DIGIT COUNT
	IFNZRO NUMOCT-NUMDEC-10	<GLITCH>
NUMDIF=	C0010
NUMDSP,	JMP NUMDEC
NUMINU,	-"-
NUMM5,	-5
NUMPLS,	-"+
NUMSGN,	0	/SIGN
NUMSKP,	SKIPS
NUMZER,	-"0

NUMBI0,	0
	TAD I NUMBI0	/SET CONVERSION DISPATCH
	AND C0002
	SNA CLA
	TAD NUMDIF	/OCTAL
	TAD NUMDSP	/DECIMAL
	DCA NUMDEC-1
	DCA NUMSGN	/INITIALIZE
	DCA NUMAGN
	DCA NUMHO
	DCA NUMCNT
	JMS I NUMSKP	/SKIP LEADING SPACES AND TABS
	JMP NUMBI4	/BUFFER EMPTY
	TAD CHAR
	TAD NUMPLS	/+?
	SNA CLA
	JMP NUMBI1	/YES
	TAD CHAR
	TAD NUMINU	/-?
	SZA CLA
	JMP NUMBI2	/NO
	ISZ NUMSGN	/YES - SET (-) INDICATOR
NUMBI1,	COMGET		/GET A CHARACTER
	JMP NUMBI3
NUMBI2,	CLA
	TAD CHAR
	TAD NUMZER
	SPA CLA		/DIGIT?
	JMP NUMBI3	/NO
	TAD CHAR
	TAD I NUMBI0
	SMA SZA CLA
	JMP NUMBI3
	TAD CHAR
	AND NUMB17
	DCA CHDFA
	ISZ NUMCNT
	TAD NUMCNT	/MORE THAT 4 DIGITS?
	TAD NUMM5
	SPA CLA
	JMP NUMBI5	/NO
	TAD NUMHO	/SHIFT HIGH ORDER
	CLL RTL
	RAL
	AND C7770
	DCA NUMHO
	TAD NUMAGN
	CLL RTL
	RTL
	AND C0007
	TAD NUMHO
	DCA NUMHO
NUMBI5,	TAD NUMAGN
	CLL RTL
	RAL
	AND C7770
	HLT
NUMDEC,	CLL
	TAD NUMAGN
	SZL
	ISZ NUMHO
	CLL
	TAD NUMAGN
	SZL
	ISZ NUMHO
NUMOCT,	CLL
	TAD CHDFA
	SZL
	ISZ NUMHO
	DCA NUMAGN
	JMP NUMBI1

NUMBI3,	TAD NUMCNT
	SNA CLA
	JMP NUMBI4	/NOT A NUMBER
	ISZ NUMBI0
	TAD NUMSGN
	CLL RAR
	CLA
	TAD NUMAGN
	SZL
	CIA
NUMBI4,	ISZ NUMBI0
	JMP I NUMBI0
OCI260,	-260
OCTINT,	0

OCTIN0,	0
	DCA OCTINT
OCTIN1,	TAD I AXS1	/GET A CHARACTER
	DCA AXS2
	TAD AXS2
	TAD OCI260
	SPA		/IS IT A LEGAL DIGIT?
	JMP OCTIN2	/NO - WE'RE DONE
	TAD C7770
	SMA
	JMP OCTIN2	/NO
	TAD C0010
	DCA AXS2
	TAD OCTINT	/YES - GET THE NUMBER SO FAR
	CLL RTL		/ MULTIPLY IT BY 8
	RAL
	TAD AXS2	/ AND ADD IN THE NEW DIGIT
	DCA OCTINT
	JMP OCTIN1
OCTIN2,	CLA CLL
	TAD OCTINT
	JMP I OCTIN0
	PAGE

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,	0
M12,	-14
DSKINI,	0		/CLEAR USER DISC REQUEST QUEUE
	DATFLD
	TAD CORCNT
	CIA
	DCA AXS1
	STA
	TAD DSUTBA
	DCA AXS2
	DCA I AXS2
	ISZ AXS1
	JMP .-2
	STA
	DCA I AXS2	/MARK END OF TABLE
	CDF
	DCMA		/CLEAR THE DISC FLAG
	CHDF
	JMP I DSKINI
/TIME INPUT

TIMULT,	DMUL
TIMCK2,	-INCLK2-1
TIMCK1,	-INCLK1
C0074,	74	/60
C660,	TICMIN	/TICKS PER MINUTE

TIMEIN,	0
	TAD AUTOSW
	SNA CLA		/DOING AUTO-RESTART?
	JMP TIME1	/NO
	CDF
	TAD SVCLK1	/YES - RESET THE OLD CLOCK
	DCA I CLK1A
	TAD SVCLK2
	JMP TIME2
TIME1,	MESSAG
	 TIMESS		/TIME:
	GETIN
	NUMBIN
	 -"9
	JMP TIMEIN+1
	DCA NUMHO+1
	DCA NUMHO
	TAD C0074
	JMS I TIMULT
	NUMBIN
	 -"9
	JMP TIMEIN+1
	TAD NUMHO+2
	DCA NUMHO+1
	DCA NUMHO
	TAD C660
	JMS I TIMULT
	CLL
	CDF
	TAD NUMHO+2
	TAD TIMCK1
	DCA I CLK1A
	RAL
	TAD NUMHO+1
	TAD TIMCK2
TIME2,	DCA I CLK2A
	CHDF
	JMP I TIMEIN

INBUFA,	ZBLOCK 12	/INPUT BUFFER FOR INIT RESPONSES
INBUFZ=	.-1
	PAGE
/DECTAPE TRANSFER ROUTINE
/CALLING SEQUENCE:
/	JMS DTGO
/	WORD 0BCD, WHERE:
/		B(BITS 3-5) = UNIT NUMBER
/		C(BITS 6-8) = MEMORY FIELD
/		D(BITS 9-11); 5=WRITE,3=READ
/	BLOCK NUMBER
/	ERROR RETURN
/	NORMAL RETURN

	IFZERO TD8E <
		IFNZRO CPU-3 <

DTGO,	0
	CLA CLL CMA RTL
	DCA DTERRI
	TAD I DTGO	/GET THE FUNCTION WORD
	ISZ DTGO
	DCA DTMF
	TAD DTMF
	CLL RTL
	RAL
	DCA DTFUNC
	TAD I DTGO	/GET THE STARTING BLOCK NUMBER
	ISZ DTGO
	DCA DTBLKO
DTAGN,	CDF
	CLA CMA
	DCA I DTMAA	/SET THE SEARCH WORD-BUFFER
	DTLB
DTREV,	CLA CLL
	TAD DTFUNC	/START SEARCH REVERSE
	AND DT7010	/EXTRACT UNIT NUMBER
	TAD DT0600	/SEARCH REVERSE FUNCTION
	DTCA DTXA	/START SEARCH
DTRWT,	JMS DTWAIT	/REVERSE WAIT
	JMP DTREV	/SELECT ERROR, TRY AGAIN
	JMP DTFOR	/FRONT END ZONE ASSUMED
	TAD C0003
	CDF
	TAD I C7777
	CMA
	TAD DTBLKO	/BACK 3 FROM OBJECT BLOCK?
	SPA CLA		/IF SO, START FORWARD
	JMP DTRWT	/IF NOT, CONTINUE REVERSE

DTFOR,	TAD DTFUNC	/START SEARCH FORWARD
	AND DT7010
	TAD DT0200
	DTCA DTXA
DTFWT,	JMS DTWAIT	/FORWARD WAIT
	JMP DTFOR	/SELECT ERROR; TRY AGAIN
	JMP DTREV	/BACK END ZONE ASSUMED
	CDF
	TAD I C7777
	CIA
	TAD DTBLKO	/OBJECT BLOCK
	SPA		/ARE WE PAST IT?
	JMP DTREV	/YES - REVERSE DIRECTION
	SZA CLA		/NO - IS THIS THE BLOCK WE WANT?
	JMP DTFWT	/NO - JUST CONTINUE SEARCH
	TAD DTMF
	DTLB		/SET THE DATA FIELD
	DCA I DTWCA
	TAD DTFUNC
	AND DT0070	/EXTRACT READ OR WRITE BYTE
	TAD C0100	/CONTINUOUS MODE
	JMS DTWAIT	/XOR IN READ OR WRITE; XOR OUT THE SEARCH
	NOP		/SELECT ERROR - TREAT AS NORMAL ERROR
	JMP DTERR
	ISZ DTGO	/INCREMENT IF NORMAL RETURN
DTER1,	DTRA
	AND DT0200
	DTXA		/STOP THE DRIVE
	JMP I DTGO

DTERR,	ISZ DTERRI
	JMP DTAGN	/RE-TRY TRANSFER
	JMP DTER1


/ROUTINE TO KILL TIME WHILE DECTAPE SPINS
/CALL:	JMS DTWAIT
/	RETURN IF SELECT ERROR OCCURS
/	RETURN FOR ALL OTHER ERROR CONDITIONS
/	RETURN IF TRANSFER OR OPERATION WAS OK

DTWAIT,	0
	DTXA		/XOR THE FUNCTION WORD
	CHDF		/BACK TO THIS DATA FIELD
	DTRA		/CHECK THE STATUS
	AND DT0200
	SNA CLA		/IS THE TAPE MOVING?
	JMP I DTWAIT	/NO - MUST BE SELECT ERROR
	DTSF DTRB	/YES - WAIT FOR THE FLAG
	JMP .-1
	SMA		/ANY ERRORS?
	ISZ DTWAIT	/NO - INCREMENT RETURN ADDRESS
	AND C0400
	SNA CLA		/SELECT ERROR?
	ISZ DTWAIT	/NO - INCREMENT RETURN AGAIN
	JMP I DTWAIT	/ THEN RETURN

DTMA=7755
DTWC=7754
DTMAA,	DTMA
DTWCA,	DTWC
DT0070,	70
DT7010,	7010
DT0600,	600
DTERRI,	0
DTFUNC,	0		/STORE THE FUNCTION
DTBLKO,	0
DT0200,	200
DTMF,	0
		>
		IFZERO CPU-3 <
DTGO,	0		/SAME CALLING SEQUENCE AS THE 8 VERSION.
	CLA
	TAD I DTGO	/GET THE CALLING WORD
	DCA DTWHAT	/WHAT HE WANTS TO DO.
	ISZ DTGO
	TAD I DTGO	/GET THE BLAHS NOW
	DCA DTBLCK	/SAVE AWAY NOW.
	ISZ DTGO	/WE ARE NOW POINTING TO THE ERROR RETURN
	TAD	DTWHAT		/REGET THE DESIRED FUNCTION
	RTR
	RAR			/PLACE THE READ OR WRITE BIT IN THE LINC.
	SZL CLA			/IF READ BYPASS FUDGE
	CLA CLL IAC RTL		/+4 FOR THE OPERATION
	TAD	C0702		/BASIC READ INSTRUCTION.
	DCA	DTINST		/SAVE IN THE EXECUTE WORD NOW.
	TAD	DTWHAT		/REGET THE FUNCTION STUFF
	AND	C0100		/GET THE UNIT NUMBER JAZZ.
	CLL RTR
	RAR			/ROTATE TO BIT 8.
	TAD	DTINST
	DCA	DTINST		/STASH IT AWAY. ALL IS NOW WELL
	TAD	DTWHAT		/GET THE STUFF AGAIN.
	RTL
	RTL			/MOVE TO BITS 0-2
	RTL
	AND	C7000		/CHOP OFF THE EXTRA CRAP
	DCA	DTAXO		/SAVE IN THE AXO REGISTER
	TAD	DTWHAT
	RTL
	RTL
	RTL			/BITS 3-4 IN BITS 10-11
	AND	C0003		/CHOP OFF SOME MORE CRAP
	TAD	C0030		/SET NO PAUSE AND EXTENDED ADDRSSSING.
	TAD	DTAXO
	DCA	DTAXO		/SAVE AWAY FOR A SECOND.
	6141			/GET INTO LINC MODE
	1020			/LDA I
DTAXO,	0
	11			/THE CLEAR WILL SET UP THE TMA ADDRESS
	23			/TMA.
DTINST,	0			/PROPER INSTRUCTION
DTBLCK,	0			/PROPER BLOCK
	6			/DJR.
	416			/STD
	6000 .-2		/JMP	.-2
	3			/TAC
	2			/GET INTO 8 MODE
	CMA
	SNA CLA
	JMP	DTGOOD
	TAD	DTWHAT
	RTR
	RAR
	SZL CLA			/WAS IT A READ??????
DTGOOD,	ISZ	DTGO		/NOPE. A WRITE WAS OK. GOOD EXIT
	JMP I	DTGO
DTWHAT,	0
C0030,	0030
C0702,	702
C7000,	7000
		>
	>
	IFNZRO TD8E <
/ROUTINE TO HANDLE THE TD8E DECTAPES FOR LOADING AND
/DUMPING THE SYSTEM; THEY CANNOT BE USED UNDER TSS/8.
/CALLING SEQUENCE:
/	JMS DTGO
/	 ABCD	/A=UNUSED; B=UNIT; C=FIELD; D=3 (READ), 5 (WRITE)
/	 BLOCK #
/	ERROR RETURN
/	NORMAL RETURN

SDSS=	6771	/SKIP ON SINGLE-LINE FLAG
SDST=	6772	/SKIP ON TIMING ERROR
SDSQ=	6773	/SKIP ON QUAD-LINE FLAG
SDLC=	6774	/LOAD COMMAND REGISTER
SDLD=	6775	/LOAD DATA REGISTER
SDRC=	6776	/READ COMMAND REGISTER
SDRD=	6777	/READ DATA REGISTER

DTGO,	0
	CLA CLL CMA RTL	/SET THE ERROR LIMIT (3)
	DCA I DTERCT
	TAD I DTGO	/GET THE FUNCTION WORD
	DCA I DTFNC
	ISZ DTGO
	TAD I DTFNC	/GET THE LOW BIT OF THE UNIT #
	CLL RTL; RTL; RAL
	AND DT4000
	DCA I DTDRV
	TAD I DTFNC	/NOW GET THE DATA FIELD
	AND DT70
	TAD DT6201
	DCA DTFLD
	TAD I DTGO	/GET THE STARTING BLOCK #
	DCA DTBLK
	ISZ DTGO
	TAD DTM37	/ AND SET THE BLOCK COUNT TO 37
	DCA DTBLCT
DTMNT,	TAD I DTDRV	/TEST FOR A SELECT ERROR
	SDLC
	SDRC
	AND DT100
	SZA CLA		/ERROR?
	JMP DTMNT	/YES - JUST WAIT FOR DRIVE
	DCA I DTBFF	/ZERO START ADDRESS (SINCE WE DO A WHOLE FIELD)
	CLA CLL		/ & START DRIVE IN REVERSE INITIALLY
	JMP DTMOVE
DTNEXT,	CHDF		/GET BACK TO OUR FIELD
	SDST
	SZA CLA		/CHECKSUM ERROR?
	JMP DTERR	/YES - NO RECOVERY HERE
	ISZ DTBLCT	/ANY MORE BLOCKS TO DO?
	SKP		/YES
	JMP DTEXIT	/NO - TAKE 'NORMAL' EXIT
	ISZ DTBLK	/INCREMENT THE BLOCK #
DTMOVE,	CLA CML RTR	/GET THE MOTION BIT (1=FORWARD, 0=REVERSE)
	TAD DT1000	/ & ADD IN THE 'GO' BIT
	TAD I DTDRV
	SDLC		/THEN START THE DRIVE
	JMS DTRDQD
	JMS DTRDQD
	CLA
DTSRCH,	SDSS		/WAIT FOR SINGLE-LINE FLAG
	JMP .-1
	SDRC
	CLL RTL
	AND DT374	/ISOLATE THE MARK-TRACK BITS
	TAD DTM110
	SNA		/IS IT THE END-ZONE?
	JMP DTENDZ	/YES
	TAD DTM20
	SZA CLA		/IS IT A BLOCK MARK?
	JMP DTSRCH	/NOPE - KEEP LOOKING
	SDRD		/YES - GET THE BLOCK NUMBER
	SZL		/ARE WE IN REVERSE?
	TAD DT3		/YES - ALLOW 3 BLOCKS FOR TURNAROUND
	CMA
	TAD DTBLK	/ (WATCH THE LINK HERE)
	CMA
	SNA		/IS THIS THE RIGHT BLOCK?
	JMP DTFND	/YES
	SZL CLA		/NO - ARE WE HEADED FOR IT?
	JMP DTSRCH	/YES - KEEP GOING
DTENDZ,	SDRC		/GET OUR DIRECTION
	CLL RTL
	SZL CLA		/ARE WE IN REVERSE?
	JMP DTMOVE	/YES - TURN AROUND
DTERR,	ISZ DTERCT	/STEP THE ERROR COUNTER
	JMP DTMOVE	/ & TRY AGAIN
	SKP

/HERE WE STOP THE TAPE AND RETURN.
DTEXIT,	ISZ DTGO	/FIX FOR THE NORMAL RETURN
DTQUIT,	CLA CLL
	CHDF		/GET BACK TO OUR FIELD
	TAD I DTDRV	/STOP THE DRIVE
	SDLC
	CLA
	JMP I DTGO	/THEN RETURN
/WE FOUND THE BLOCK - NOW PERFORM THE OPERATION.
DTFND,	SZL CLA		/ARE WE GOING THE RIGHT WAY?
	JMP DTMOVE	/NO - TURN AROUND
DTFLD,	HLT		/YES - GET TO THE DATA FIELD
	JMP I .+1	/ & GO PERFORM THE I/O
	DTPAGE

/SUBROUTINE TO READ ONE FULL WORD FROM TAPE
DTRDQD,	0
	SDSQ		/WAIT FOR FULL WORD
	JMP .-1
	SDRD		/THEN READ IT
	JMP I DTRDQD	/ & RETURN

/SUBROUTINE TO WRITE ONE FULL WORD ONTO TAPE.
DTWRQD,	0
	JMS I DTEQF	/UPDATE THE CHECKSUM
	SDSQ		/NOW WAIT FOR A WORD-BOUNDARY
	JMP .-1
	SDLD
	CLA
	JMP I DTWRQD

DTBFF,	DTBUFF
DTBLCT,	0
DTBLK,	0
DTDRV,	DTUNIT
DTEQF,	DTEQUF
DTERCT,	0
DTFNC,	DTFUNC
DT3,	3
DT70,	70
DT100,	100
DT374,	374
DT1000,	1000
DT4000,	4000
DT6201,	CDF
DTM20,	-20
DTM37,	-37
DTM110,	-110
	>
	PAGE

/4K DISC READ OR WRITE

LOAD,	CLA CLL
	RIF
	TAD C6203
	DCA INIF
	CHDF
LOAD1,	MESSAG		/ "READ OR WRITE - "
	 RDORWT
	MESSAG
	 DASH
	GETIN
	TAD I INBUF
	TAD CMR
	SNA		/FIRST CHAR "R"?
	JMP .+5		/YES - DO A READ
	TAD CMW
	SZA CLA		/NO - A "W"?
	JMP LOAD1	/NO - ASK AGAIN
	CLA CLL CML RTL	/YES - SET FOR "WRITE"
	TAD C6603	/ OR A "READ"
	DCA RORW
	MESSAG		/ "FIELD # - "
	 FIELD1
	GETIN
	OCTIN		/GET THE FIELD #
	AND C0007
	DCA FLDNUM
	MESSAG		/ "TRACK # - "
	 TRACK
	GETIN
	OCTIN
	CLL RTL
	RAL
	TAD FLDNUM
	DCA FLDNUM
	DISC		/NOW READ THE TRACK
RORW,	 0
FLDNUM,	 0
	SKP		/ERROR
	JMP .+3
	MESSAG		/ "OOPS" - DISC ERROR
	 OOPS
	JMP I .+1	/NOW BACK TO XDDT
	7000

CMR,	-"R
CMW,	"R-"W
C6603,	6603
CLEAR,	0
	CLA
	DISC		/READ MONITOR II INTO FIELD 1
	 DMAR
	 TS8DEX+11
	HLT		/ERROR?
	TAD CLR1
	JMS ZERO	/ZERO OUT FREE CORE
	CHDF
	JMP I CLEAR

CLR1,	JOBTBL

ZERO,	0		/CLEAR FIELD 1 FROM C(AC) TO 7777
	DCA CLR2	/BEGINNING ADDRESS
	DATFLD
	DCA I CLR2
	ISZ CLR2
	JMP .-2
	JMP I ZERO
CLR2,	0
/SUBROUTINE TO SEND A MESSAGE TO ALL REAL CONSOLE PRINTERS.
PRTAL0,	0
	TAD I PRTAL0	/GET THE MESSAGE ADDRESS
	DCA PRAMSG
	ISZ PRTAL0
	TAD PRAMAX
	DCA AXS1	/SET THE CONSOLE COUNTER
	DCA AXS2
PRTAL1,	TAD AXS2	/GET THE CONSOLE NUMBER
	JMS QUEUE	/ AND SEND THE MESSAGE
PRAMSG,	 0
	ISZ AXS2
	ISZ AXS1
	JMP PRTAL1	/DO THE NEXT ONE
	JMP I PRTAL0	/ AND RETURN
/
PRAMAX,	-TRUKBD-1
/
/SUBROUTINE TO SEND A MESSAGE TO A PARTICULAR CONSOLE.
/CALLED WITH THE CONSOLE NUMBER IN THE AC.
QUEUE,	0
	DCA QTTY
	TAD I QUEUE	/GET THE MESSAGE ADDRESS
	DCA QPTR
	ISZ QUEUE
	TAD QTTY
	CLL CML RAL
	TAD QTBL
	DCA QDEV	/POINTS TO DEVTBL ENTRY
QUEUE1,	CDF
	TAD QDEV
	DCA I CONDVA	/SET DEVTBL ENTRY ADDRESS FOR 'PRINT'
	CHDF
QUEUE2,	TAD I QPTR	/GET A CHARACTER
	SNA		/END OF MESSAGE?
	JMP I QUEUE	/YES - RETURN
	CIF
	PRINT		/NOW BUFFER IT
	JMP I QUEUE	/NO ROOM - JUST RETURN
	ISZ QPTR
	JMP QUEUE2
/
QDEV,	0
QPTR,	0
QTBL,	DEVTBL
QTTY,	0
	PAGE

	IFZERO TD8E <
	IFNZRO CPU-3 <

/
/TC08 BOOTSTRAP LOADER; THIS IS WRITTEN IN BLOCK ZERO
/OF TC08 SYSTEM DUMP TAPES. THIS ALLOWS THE SYSTEM TO
/BE BROUGHT UP USING THE TC08 DECTAPE BOOTSTRAP.

TCHEAD,	JMP TCHD1	/START LOAD SEQUENCE
TCBLKS,	0	/# OF TRACKS INIT SHOULD LOAD ONCE BOOTSTRAPPED
TCDTA,	DTA	/READ/WRITE FLAG IN 'INIT'
TCFLD,	INFLD	/FIELD TO LOAD 'INIT'
TCINBK,	-101	/DECTAPE LOCATION OF 'INIT'
TCINIF,	INIF	/DATA-FIELD SELECT ROUTINE IN 'INIT'
TCMA,	7755	/DATA-BREAK MEMORY ADDRESS
TCWC,	7754	/DATA-BREAK WORD-COUNT
TCWRD,	7777	/ADDR. OF WORD-BUFFER USED TO CHECK BLOCK NUMBER
TC130,	130	/READ FUNCTION
TC200,	200
TC600,	600
TC610,	610

	IFNZRO TCHEAD+16-.&4000	<GLITCH>
	*TCHEAD+16
	DTSF		/THIS OVERLAYS THE TC08 BOOTSTRAP
	JMP .-1
TCHD1,	CLA CLL
	DTLB		/SET FIELD ZERO FOR SEARCH
	TAD TC600
	DTCA DTXA	/FIRST REWIND THE TAPE
	DTSF
	JMP .-1
	CDF
	TAD TCWRD
	DCA I TCMA	/SET THE WORD-BUFFER
	TAD TC610	/NOW SEARCH FORWARD
TCHD2,	DTXA		/SET THE FUNCTION
	DTSF DTRB	/ AND WAIT FOR THE FLAG
	JMP .-1
	SPA CLA		/ANY ERRORS?
	JMP TCHD1	/YES - RETRY
	TAD I TCWRD
	TAD TCINBK
	SZA CLA		/REACHED 'INIT' BLOCK YET?
	JMP TCHD2	/NO - CONTINUE SEARCH
	TAD TCFLD
	DTLB		/YES - SET FIELD FOR 'INIT'
	DCA I TCWC	/ AND CLEAR THE WORD-COUNT TO TRANSFER 4K
	CLA CMA
	DCA I TCMA
	TAD TC130
	DTXA		/NOW START READ OF 'INIT'
	DTSF DTRB
	JMP .-1
	SPA CLA		/ANY ERRORS?
	JMP TCHD1	/YES - RETRY
	TAD TC200
	DTXA		/ALL DONE - STOP THE DRIVE
TCUDF,	CDF INFLD	/GET TO THE 'INIT' FIELD
	TAD TCUDF
	DCA I TCINIF	/SET UP THE DATA-FIELD SELECT ROUTINE
	TAD TCSVT1
	DCA I SVUP1A	/PASS BACK THE OLD UPTIME
	TAD TCSVT2
	DCA I SVUP2A
	CLA CMA
	DCA I TCDTA	/SET THE READ/WRITE FLAG TO 'READ'
	CIF CDF INFLD
	TAD TCBLKS
	SNA		/SHOULD WE LOAD THE SYSTEM?
	JMP I .+2	/NO - JUST START 'INIT'
	JMP I .+2	/YES - WE DO THIS ONLY WHEN BUILDING THE SYSTEM
	SUPER
	SYSBLD
/
SVUP1A,	SVUPT1
SVUP2A,	SVUPT2
TCSVT1,	0
TCSVT2,	0

/
/SUBROUTINE TO WRITE OUT THE PRECEDING TAPE HEADER.
WRTHD,	0
	CLA CLL
	TAD SVUPT1	/COPY OVER THE SAVED UPTIME
	DCA TCSVT1
	TAD SVUPT2
	DCA TCSVT2
WRTHD1,	DTLB		/USE FIELD ZERO FOR SEARCH
	TAD TC600
	DTCA DTXA	/REWIND THE FIRST REEL
	JMS I WHWAIT	/ & WAIT FOR THE FLAG
	JMP WRTHD1	/SELECT ERROR - TRY AGAIN
	SKP		/MUST BE END-ZONE ERROR
	JMP WRTHD1	/NO ERROR - BUT WE SHOULD GET ONE
	CDF
	TAD TCWRD
	DCA I TCMA	/SET THE WORD-POINTER
	TAD TC610
	JMS I WHWAIT	/ AND SEARCH FORWARD
	JMP WRTHD1	/SELECT ERROR
	JMP WRTHD1	/OTHER ERROR
	CDF
	TAD I TCWRD
	SZA CLA		/AT BLOCK ZERO?
	JMP WRTHD1	/NO - TRY AGAIN
	RIF
	DTLB		/YES - SET THE CURRENT FIELD
	TAD WRTLEN
	DCA I TCWC	/ AND THE WORD-COUNT
	TAD WRTADR
	DCA I TCMA	/ AND THE ADDRESS
	TAD WH50
	JMS I WHWAIT	/THEN START THE WRITE
	JMP WRTHD1	/SELECT ERROR - TRY AGAIN
	JMP WRTHD1	/OTHER ERROR - START OVER
	JMP I WRTHD	/NO ERRORS - JUST RETURN
/
WH50,	50
WHWAIT,	DTWAIT
WRTADR,	TCHEAD-1
WRTLEN,	-200

	*TCHEAD+154
	7755	/THESE OVERLAY THE BREAK LOCATIONS DURING
	7755	/ THE INITIAL LOAD
	>>
	IFNZRO TD8E <	/CONTINUATION OF TD8E DECTAPE HANDLER
/
/NOW SET UP TO DO THE READ OR WRITE.
DTPAGE,	TAD DTM201	/SET (-) WORDS / BLOCK
	DCA DTWDCT
DTRVGD,	SDSS		/NOW WAIT FOR REVERSE-GUARD
	JMP .-1
	SDRC
	AND DT77
	TAD DTM32
	SZA CLA		/IS IT REVERSE-GUARD?
	JMP DTRVGD	/NO - KEEP LOOKING
	TAD DTFUNC	/GET THE FUNCTION-WORD
	RTR
	SZL CLA		/READ?
	JMP DTREAD	/YES
DTWRIT,	SDRC		/NO - WRITE
	AND DT300
	SZA CLA		/WRITE-LOCK OR SELECT ERROR?
	JMP I DTBAD	/YES - JUST DIE
	JMS I DTRQD	/ (THIS WORD UNUSED)
	CLA
	TAD DT1400	/GET THE FUNCTION
	TAD DTUNIT	/ AND THE UNIT
	SDLC		/ AND START THE TRANSFER
	CLA CMA		/PUT 77 INTO REVERSE CHECKSUM
	JMS I DTWQD
	CLA CMA		/ AND INITIALIZE OUR CHECKSUM
	DCA DTCKSM
DTWRLP,	TAD I DTBUFF	/OK, NOW GET A DATA WORD
	JMS I DTWQD	/ & WRITE IT OUT
	ISZ DTBUFF	/THEN MOVE THE POINTER
	NOP
	ISZ DTWDCT	/ & STEP THE WORD-COUNT
	JMP DTWRLP	/THEN GET THE NEXT
	JMS DTCHEK	/ALL DONE - UPDATE THE CHECKSUM
	JMS I DTWQD	/ AND WRITE IT OUT
	JMS I DTWQD
	CLL CML		/SET TO START FORWARD
	JMP I DTNXTA	/ AND GO DO THE NEXT BLOCK

DTREAD,	JMS I DTRQD	/SKIP THE CONTROL-WORDS
	JMS I DTRQD
	JMS I DTRQD
	AND DT77
	TAD DT7700
	DCA DTCKSM
DTRDLP,	JMS I DTRQD	/OK, GET A WORD FROM TAPE
	JMS DTEQUF	/ & INCLUDE IT IN THE CHECKSUM
	DCA I DTBUFF	/ THEN STORE IT
	ISZ DTBUFF
	NOP
	ISZ DTWDCT	/STEP THE WORD-COUNT
	JMP DTRDLP
	JMS I DTRQD	/GET THE CHECKSUM
	AND DT7700
	JMS DTEQUF
	JMS DTCHEK	/ & CUT IT DOWN
	JMP I DTNXTA	/THEN GO CHECK IT & GET NEXT BLOCK

/SUBROUTINE TO UPDATE THE CHECKSUM.
DTEQUF,	0
	CMA		/ALTHOUGH DECTAPE CHECKSUMS ARE
	DCA DTEQF1	/ THE EQUIVALENCE OF ALL WORDS 6 BITS
	TAD DTEQF1	/ AT A TIME, EQUIVALENCE IS ASSOCIATIVE
	AND DTCKSM	/ SO WE DO IT 12 BITS AT A TIME & CONDENSE
	CIA		/ IT LATER. THIS ROUTINE USES THESE IDENTITIES:
	CLL RAL		/	A+B=(A.XOR.B)+2*(A.AND.B)
	TAD DTEQF1	/	A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
	TAD DTCKSM	/	A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
	DCA DTCKSM
	TAD DTEQF1
	CMA
	JMP I DTEQUF
DTEQF1,	0

/SUBROUTINE TO CONDENSE THE CHECKSUM (SEE COMMENTS IN DTEQUF).
DTCHEK,	0
	CLA
	TAD DTCKSM
	CMA
	CLL RTL; RTL; RTL
	JMS DTEQUF
	CLA CLL CML	/FORCES LINK ON AT DTNEXT
	TAD DTCKSM
	AND DT7700
	JMP I DTCHEK

DTBAD,	DTQUIT
DTBUFF,	0
DTCKSM,	0
DTERRS,	0
DTFUNC,	0
DTNXTA,	DTNEXT
DTRQD,	DTRDQD
DTUNIT,	0
DTWDCT,	0
DTWQD,	DTWRQD
DT77,	77
DT300,	300
DT1400,	1400
DT7700,	7700
DTM32,	-32
DTM201,	-201
	>
	*3400

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

DSKDMP,	COMGET		/SCAN TO FIND A COMMA
	JMP DSKD1	/BUFFER EMPTY - DUMP THE WHOLE DISC
	TAD MCOM
	SZA CLA		/COMMA?
	JMP DSKDMP	/NO
	NUMBIN		/YES - READ THE NUMBER OF 4K BLOCKS TO DUMP
	 -"7
	JMP I SUPERA	/BAD #
	CIA
DSKD1,
	IFZERO TD8E <
	IFNZRO CPU-3 <
	DCA I HDBLKA	/SET THE COUNT INTO THE TC08 BOOTSTRAP
	TAD I HDBLKA
	>>
	SNA		/IF ZERO, DO THE WHOLE DISC
	TAD DSKSZ
SYSBLD,	DCA DSKCNT	/ENTRY FROM SYSTEM DECTAPE BOOTSTRAP
	CLL
	TAD DTA
	SZA CLA		/READ OR WRITE?
	STL		/READ - SET L=1
	SNL		/READ OR WRITE?
	TAD C0002	/WRITE
	TAD C0013	/READ - START WITH UNIT # 0
	DCA DSKDTP
	IAC
	DCA DSKDTP+1
	SZL		/READ FROM TAPE?
	TAD C0002	/YES - THEN WE WRITE ONTO DISC
	TAD D6603	/NO - WE READ FROM DISC
	DCA DSKDKP
	IAC
	DCA DSKDKP+1
	SZL
	IAC
	TAD DSKDSA	/GET THE POINTER-LIST
	DCA DTA
	TAD I DTA
	DCA DSKDRD	/SET THE READ-SUBROUTINE CALL
	ISZ DTA
	TAD I DTA
	DCA DSKDWR	/SET THE WRITE-SUBROUTINE CALL

	IFZERO TD8E <
	IFNZRO CPU-3 <
	SNL		/IS THIS A WRITE?
	JMS I WRTHDA	/YES - WRITE OUT A BOOTSTRAP LOADER
	>>
/
/NOW WE TRANSFER THE SPECIFIED NUMBER BLOCKS
/FROM OUR INPUT-DEVICE (TAPE OR DISC) TO OUR OUTPUT DEVICE
/(DISC OR TAPE).
DSKDRD,	 HLT
DSKDWR,	 HLT
	ISZ DSKCNT
	JMP DSKDRD
	JMP I .+1
SUPERA,	SUPER

DSK,	0
	DISC
DSKDKP,	 0
	 0
	JMP DSK1
	TAD DSKDKP+1
	TAD C0010
	DCA DSKDKP+1
	JMP I DSK
DSK1,
	IFZERO RF08	<DIMA>
	IFZERO RF08-40	<DEAC>
	AND C0002
	SNA CLA		/'NXD' ERROR?
	JMP DSK+1	/NO - JUST TRY AGAIN
	JMP I DSK	/YES - RETURN NORMALLY

DTA,	0
	JMS I DSKTGO
DSKDTP,	 0
	 0
	JMP .-3		/ERROR - JUST TRY AGAIN
	TAD DSKDTP+1
	TAD C0040
	DCA DSKDTP+1
	TAD DSKDTP+1
	TAD C0040
	TAD CM2702
	SPA CLA		/REACHED THE END OF THIS REEL?
	JMP I DTA	/NO - JUST RETURN
	TAD C0100	/YES - INCREMENT THE UNIT NUMBER
	TAD DSKDTP
	DCA DSKDTP
	DCA DSKDTP+1
	JMP I DTA


C0040,	40
C0013,	13
CM2702,	-2702
DSKCNT,	0
DSKSZ,	-DSKSIZ
DSKTGO,	DTGO
D6603,	6603
MCOM,	-254
DSKDSA,	.+1
	JMS DSK
	JMS DTA
	JMS DSK

	IFZERO TD8E <
	IFNZRO CPU-3 <
HDBLKA,	TCBLKS
WRTHDA,	WRTHD
	>>
	PAGE
/FILE PHANTOM AND DISC REFRESHER
/WRITE NEW MFD ON DISC DIRECTLY ABOVE THE SWAPPING AREA

REFCO0,	YESNO		/"ARE YOU SURE"?
	 FIPREM
	JMP I REFSUP	/NO
	MESSAG		/YES - TELL HIM INITIAL PASSWORDS
	 NEWPAS
	JMS I FIPBLT	/CLEAR FIELD 1
	CHDF
	TAD MFD1	/MOVE VIRGIN "MFD" TO FIELD 1
	DCA COUNT2
FIPRF3,	TAD I COUNT2	/GET A WORD
	ISZ COUNT2
	CMA
	SNA		/REACHED THE END OF THE CANNED MFD?
	JMP FIPRF1	/YES
	CMA
	DATFLD
	DCA I COUNT	/NO - STORE THE WORD INTO FIP
	CHDF
	ISZ COUNT
	JMP FIPRF3
FIPRF1,	DISC		/WRITE OUT THE FRESH MFD
	 DMAW
	 SWDEX+JOBMAX^10+1
	HLT		/DISC WRITE ERROR

/INITIALIZE STORAGE ALLOCATION TABLE "SAT"
/THE SAT TABLE RESIDES IN FIP AT 7777 AND EXTENDS
/DOWN THRU 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
	DCA FIPRF2
	TAD CENTBL
	JMS I FIPBLT	/CLEAR ALL THE FIP TABLE SPACE
	TAD SEGMAX
	DCA STORE0	/ # SEGS = DSKSIZ-JOBMAX-SWDEX^20-1
	CLA CMA
	DATFLD
	DCA I SATBOT	/"-255"
	CLL STA RAL	/SUBTRACT TWO SEGMENTS (FOR 1,2 UFD'S)
	TAD STORE0	/SET SATCNT TO # DISC SEGMENTS-2
	DCA I SATCNT	/"-254"
	CLL CML RAR	/MARK SEGMENTS 0,1 FOR MFD,UFD USAGE
	CLL CML RAR
	DCA I SATTBL
	TAD STORE0
	SMA		/OVER 4000 SEGMENTS?
	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
	TAD COUNT
	TAD SATTBL
	TAD C7777
	DCA COUNT	/POINTS TO LAST NON-LOCKED WORD IN SAT
	CLL CML RAL	/BUILD THE PARTIAL WORD FOR THE END
	ISZ STORE0
	JMP .-2
	DCA I COUNT	/MARK END OF FILE STORAGE AS ALLOCATED
	JMP FIPRF5
FIPRF4, CLA CMA
	DCA I COUNT	/NOW LOCK-OUT THE REMAINDER OF SAT
FIPRF5,	ISZ COUNT
	JMP FIPRF4
	CHDF
	DISC		/NOW WRITE OUT THE NEW 'FIP'
	 DMAW
FIPRF2,	 0
	HLT
	JMP I REFSUP	/RETURN TO 'INIT' SUPERVISOR

REFSUP,	SUPER
SATTBL, -SATSIZ+2

COUNT,	0
MFD1,	MFD
COUNT2,	0
C7764,	-14
STORE0,	0
FIPRFD,	FIPRD
CENTBL,	ENTABL	/BOTTOM OF FIP TABLE AREA
FIPBLT,	ZERO	/ROUTINE TO CLEAR FIELD 1 FROM C(AC)
SATBOT,	-SATSIZ
SATCNT,	-SATSIZ+1
C0253,	253
CM4004, -4004
SEGMAX,	DSKSIZ-JOBMAX-SWDEX^20-1	/MAXIMUM SEGMENT NUMBER
/ROUTINE TO MOVE XDDT INTO DATFLD (HIGH END OF TS8II).

LODDT,	0
	TAD KM4300
	DCA I FRENDA	/MAKE FREE-CORE END AT 4300
	CLA CMA
	TAD K4300
	DCA AXS1	/POINTS TO ORIGINAL
	TAD AXS1
	DCA AXS2	/POINTS TO COPY
LODLP,	TAD I AXS1	/GET A WORD
	DATFLD
	DCA I AXS2	/ & MOVE IT
	CHDF
	ISZ DDTSIZ	/ARE WE DONE?
	JMP LODLP	/NO
	JMP I LODDT	/YES - RETURN

DDTSIZ,	4300-7577	/THIS GETS DESTROYED
FRENDA,	FRIEND
K4300,	4300
KM4300,	-4300
/
NEWPAS,	TEXT /_INITIAL MGR1 & MGR2 PASSWORDS ARE 'LOAD'_/
	PAGE
	JMP I .+1
	INBOOT

CRTABL,	RTABLE-1	/MFD SEGMENT #S
CUTABL,	UTABLE
CUTAB1,	UTABLE+1
FIPTBS,	ENTABL-1	/START OF AREA TO CLEAR IN FIP
MFDLOC,	SWDEX+JOBMAX^10+1	/DISC ADDRESS OF MFD
SATCON,	SATSIZ+1

PERSET,	0
	TAD MFDLOC
	DCA FRD1
	DISC		/READ THE MFD INTO FIELD 1
	 DMAR
FRD1,	 0
	JMP .-3		/ERROR - TRY AGAIN
	TAD C0010
	CLL RAL
	DCA AXS1
	TAD INBUF
	DCA AXS2
	TAD M7		/SET THE MAX SEGMENT COUNT
	DCA FRD1
FRD2,	CDF 10
	TAD I AXS1
	CHDF
	SNA		/HAVE WE REACHED THE END?
	JMP FRD3	/YES - WE'RE DONE
	DCA I AXS2
	ISZ FRD1
	JMP FRD2
FRD3,	DCA I AXS2	/STORE A ZERO AS A TERMINATOR
	JMS FIPRD	/FIP TO FIELD 1
	DCA PERSE1
	TAD FIPTBS	/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
PERSE3,	CHDF
	TAD I AXS2
	DATFLD
	SNA
	JMP .+3
	DCA I AXS1
	JMP PERSE3
	CLL CLA CML RAL
	DCA I CUTABL	/UTABLE=1
	CMA
	DCA I CUTAB1	/UTABLE+1=-1
	CHDF
	DISC		/NOW WRITE IT OUT
	 DMAW
PERSE1,	 0
	JMP .-3
	JMP I PERSET

/ROUTINE TO READ 'FIP' INTO FIELD 1
FIPRD,	0
	TAD PERFIP
	DCA PERSE0
	DISC		/READ FIP INTO FIELD 1
	 DMAR
PERSE0,	 0
	JMP .-3
	TAD PERSE0
	JMP I FIPRD

PERFIP,	FIPDEX^2+1	/DISC ADDRESS OF FIP
M7,	-7
/
/INITIAL MFD AFTER REFRESHING
MFD,	0
	0
	0
	10
	0
	0
	0
	0

	1		/0,1 PROJ,PROG NUMBER
	5457	/"LOAD"
	4144
	30		/NEXT ENTRY
	37		/PROTECTION
	0
	0
	20		/FIRST RETREIVAL BLOCK AT WORD 10

	0
	1		/SEGMENT 1 IS THE ONLY ONE AROUND
	0		/NO OTHER SEGMENTS YET
	0		/FINISH UP THE BLOCK
	0
	0
	0
	0

	2		/0,2 PROJ,PROG NUMBER
	5457	/"LOAD"
	4144
	0		/NO OTHER ENTRIES
	32		/PROTECTION
	0
	0
	40		/SECONDS RETRIEVAL BLOCK

	0		/ONLY WINDOW
	2		/SEGMENT #2
	7777		/TERMINATE THE STRING

UPMSG,	TEXT '__TSS/8 RESTARTED_PLEASE LOGIN__.'
	PAGE
	IFNZRO 4200-.	<GLITCH>
/INIT SUPERVISOR
/OVERLAYS XDDT PERMANENT SYMBOL TABLE
MANUAL,	JMP SUPER	/STARTED IN 'SI' - DON'T GRAB THE DATE & TIME
AUTOST,	DCA AUTOSW	/SET (OR CLEAR) THE AUTO-RESTART FLAG
	CDF
	TAD I CLK1A
	DCA SVCLK1	/SAVE THE CURRENT TIME
	TAD I CLK2A
	DCA SVCLK2
	TAD I DATEB
	DCA SVDATE	/ AND THE DATE
	DATFLD
	TAD I UPTM1B	/ AND THE SYSTEM UPTIME
	DCA SVUPT1
	TAD I UPTM2B
	DCA SVUPT2
SUPER,	RIF
	TAD C6203
	DCA INIF
	CHDF
	TAD AUTOSW
	SZA CLA		/AUTOMATIC RESTART?
	JMP I SYSINA	/YES
	MESSAG
	 LDXRS		/LOAD, DUMP, XDDT, REFRESH, START??
	GETIN		/WAIT FOR REPLY
	TAD I INBUF
	TAD CM0314	/LOAD?
	SNA
	JMP SUPLOD	/YES
	TAD C0010	/DUMP?
	SNA CLA
	JMP SUPDMP	/YES

	TAD I INBUF
	TAD CM0330	/XDDT?
	SNA CLA
	JMP I SUPDDT	/YES

	/NOW IT'S EITHER REFRESH OR START...
	/EITHER WAY, WE NEED AN INIT IN FIELD 2

	RIF
	TAD C7760
	SNA CLA		/ARE WE ALREADY THERE?
	JMP SUPER2	/YES
	DCA SUPCNT	/HAVE TO MOVE THERE
	CHDF
	TAD I SUPCNT	/FROM HERE...
	DATFLD+10
	DCA I SUPCNT	/	... TO THERE
	ISZ SUPCNT
	JMP .-5
	DATFLD+12
	JMP .+1
	TAD .-2
	DCA INIF	/REMEMBER WHERE WE ARE

SUPER2,	TAD I INBUF
	TAD CM0322	/REFRESH?
	SZA CLA
	JMP I .+2	/NO; ASSUME START
	JMP I .+2	/YES
SYSINA,	SYSINI
	REFCO0

SUPLOD,	STA		/"DTA" = 0 FOR WRITE; =/ 0 OTHERWISE
SUPDMP,	DCA I SUPDTA
	JMP I .+1
	DSKDMP

SUPDDT,	7000
SUPDTA,	DTA
C7760,	-20
CM0314,	-"L
CM0322,	-"R
CM0330,	-"X
DATEB,	DATE
SUPCNT,	0
UPTM1B,	UPTIM1
UPTM2B,	UPTIM2
/
/SYSTEM INITIALIZATION ROUTINE TO TYPE THE SYSTEM RESTARTED
/MESSAGE ON ALL CONSOLES; WE ALSO PRINT ADDITIONAL INFO
/ON K00 IF THIS IS AN AUTOMATIC SYSTEM REBOOT.
RDYMSG,	0
	TAD RDYQCH
	DCA TYPEA	/REPLACE THE 'TYPE' ROUTINE
	TAD AUTOSW
	SNA CLA		/DOING AN AUTOMATIC RESTART?
	JMP RDYMS1	/NO
	TAD RDYTP0
	DCA QCHAR	/SET TO BUFFER FOR K00
	MESSAG		/TYPE SYSTEM CRASH MESSAGE
	 AUTOMS
	TAD AUTOSW
	JMS I RDYOCT	/ THE CRASH ADDRESS,
	MESSAG
	 DASH
	TAD SVDATE
	JMS I RDYOCT	/ THE DATE,
	TAD KSLASH
	TYPE
	TAD SVCLK2
	JMS I RDYOCT	/ AND THE TIME
	TAD SVCLK1
	JMS I RDYOCT
	MESSAG
	 DASH
	TAD SVUPT2
	JMS I RDYOCT	/ AND ALSO THE SYSTEM UPTIME
	TAD SVUPT1
	JMS I RDYOCT
RDYMS1,	TAD RDYTP1
	DCA QCHAR	/NOW SET TO BUFFER FOR EVERYONE
	TAD C0007
	TYPE		/RING THE BELL
	MESSAG		/ AND TELL EVERYONE WE'RE BACK UP
	 UPMSG
	TAD RDYTYP
	DCA TYPEA	/RESET THE 'TYPE' ROUTINE
	JMP I RDYMSG	/ AND RETURN
/
KSLASH,	"/
RDYQCH,	RTYPE
RDYTYP,	OUT
RDYTP0,	QUEUE	/BUFFER CHARACTER FOR K00 ONLY
RDYTP1,	PRTAL0	/BUFFER CHARACTER FOR EVERY TERMINAL
RDYOCT,	HACK	/TYPE AN OCTAL NUMBER
/
/ROUTINE TO BUFFER A SINGLE CHARACTER IN TSS/8
RTYPE,	0
	DCA RTYPCH	/SAVE THE CHARACTER
	RTR		/ AND THE LINK
	DCA SUPCNT
	JMS I QCHAR	/THEN BUFFER IT
	 RTYPCH
	TAD SUPCNT
	CLL RTL		/RESTORE THE LINK
	JMP I RTYPE	/ AND RETURN
/
QCHAR,	0
RTYPCH,	0	/SINGLE CHARACTER MESSAGE
	0
/
/PATCHES TO 'XDDT'
	IFNZRO 4434-.&4000	<GLITCH; *.-1>

	*5137
	7777	/ASSUMED UPPER SEARCH-LIMIT

	*5400
	70	/PATCH MAX FIELD SELECT FOR XDDT

	*5722
	7777	/INITIAL UPPER SEARCH-LIMIT

	*6367
	INFLD	/INITIAL DATA FIELD

	*6400
	4434	/DELETE ALL BUT THE 8 BASIC INSTRUCTIONS IN XDDT
	4434
	4434
/
	*7626
/BINARY LOADER - SLIGHTLY MODIFIED FROM THE STANDARD LOADER
/TO ALLOW IT TO OVERLAY ITSELF & TO MAKE THE DATA-BREAK
/LOCATIONS CLOBBERABLE.

/EXTRACT ERRORS, FIELD, L/T
BEGG=	.
	*.+1
	DCA SWITCH	/SET SWITCH
	JMS READ	/GET A CHARACTER
	TAD M376
	SPA SNA CLA	/IS IT A 377?
	JMP .+4		/NO
	ISZ SWITCH	/YES - COMPLEMENT SWITCH
	CMA
	JMP BEGG+1
	TAD SWITCH
	SZA CLA		/IS SWITCH SET?
	JMP BEGG+2	/YES - IGNORE
	TAD CHAR1	/NO - TEST FOR CODE TYPES
	AND MASK
	TAD M200
	SPA
	ISZ BEGG	/DATA OR ORIGIN
	SPA SNA CLA
	JMP I BEGG	/DATA, ORIGIN, OR L/T
	TAD CHAR1
	AND FMASK
	TAD CHANGE
	DCA MEMTEM	/SAVE NEW FIELD SETTING
	JMP BEGG+2	/CONTINUE INPUT
FMASK,	70
CHANGE,	CDF

READ=	.		/ROUTINE TO GET ONE CHAR
	*.+2		/'JMP' TO APPROPRIATE SECTION
LOR,	KSF		/WAIT FOR FLAG
	JMP .-1
	KRB
	DCA CHAR1
	TAD CHAR1
	JMP I READ
HIR,	RSF
	JMP .-1
	RRB RFC
	JMP LOR+3
MASK,	300

/TRAILER CODE SEEN
BEND,	JMS ASSEMB	/ASSEMBLE THE TAPE CHECKSUM
	CIA
	TAD CHKSUM
DONE,	HLT		/ & HALT WITH DIFFERENCE IN AC

BEGIN,	KCC
	RFC
	RDF
	TAD CHANGE
	DCA MEMTEM	/SAVE FIELD INSTRUCTION
	CLA OSR
	SMA CLA		/LOW- OR HIGH-SPEED READER?
	TAD HIRI	/HIGH
	TAD LORI	/LOW
	DCA READ+1
	JMS BEGG	/SKIP PAST LEADER
	JMP .-1
GO,	DCA CHKSUM
	TAD MEMTEM
	DCA MEMFLD	/SET DATA-FIELD SELECT
	TAD CHAR1
	DCA WORD1
	JMS READ	/GET SECOND CHAR OF PAIR
	DCA WORD2
	JMS BEGG	/LOOK AHEAD
	JMP BEND	/TRAILER SEEN - LAST WORD IS CHECKSUM
	JMS ASSEMB
	SNL		/NEW ORIGIN?
	JMP MEMFLD	/NO - STORE THE WORD
	DCA ORIGIN	/YES - SET IT
CHEX,	TAD WORD1
	TAD WORD2
	TAD CHKSUM	/UPDATE THE CHECKSUM
	JMP GO

ASSEMB=	.
	*.+1
	TAD WORD1
	CLL RTL
	RTL
	RTL
	TAD WORD2
	JMP I ASSEMB
LORI,	JMP LOR
HIRI,	HIR-LOR
M376,	-376
	7751	/THESE ARE FOR THE DISC DATA-BREAK
	7751	/ CONTROL-WORDS
SWITCH=	.
MEMTEM=	SWITCH+1
	*7754
	7755	/THESE ARE THE DECTAPE DATA-BREAK WORDS
	7755
MEMFLD=	.	/DATA-FIELD SELECT
	*MEMFLD+1
	DCA I ORIGIN
	ISZ ORIGIN
M200,	7600
	JMP CHEX
CHAR1=	.	/BY NOT USING ZERO CONSTANTS HERE, WE
CHKSUM=	CHAR1+1	/ PERMIT THIS LOADER TO LOAD OVER ITSELF
ORIGIN=	CHKSUM+1
WORD1=	ORIGIN+1
WORD2=	WORD1+1
	*7777
	JMP BEGIN
/////	$$$$$
	$$$$$