/SYSGEN				EDITED 10/10/73
/COPYRIGHT 1971, 1972, 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
/
/SGW,RFL
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/

	SYSDAT=	3711	/JULY 25, 1973
	TC08TL=	6734		/LOCATIONS FOR INTERRUPT HACK
	TC12TL=	6712
	DIRBFR=	4400
	LINBUF=	4000
	LINE=	4200
	P7400=	2
	KPTRST=	43
	PF0=	6200
	GET=	57
	W0=	46
	W1=	W0+1
	W2=	W1+1
	W3=	W2+1
	W4=	W3+1
	W5=	W4+1
	U0=	W5+1
	U1=	U0+1
	U2=	U1+1
	BADINT=	U0		/AT STARTUP TIME ONLY!
	DTAJMS=	6610		/ADDR OF DTA HANDLER
	RK8JMS=	6410
	UTBLK=	10	/BLOCK WHERE UNITS TABLE IS ON SYSTEM TAPE (IN THE LAST HALF OF IT, OF COURSE,
			/TO MAKE LIFE DIFFICULT)
	KOTOPD=	74
	IODIE=	7702	/*** C A R E F U L ! ! ! * * *
	RECOVR=	7766
	KSPLIT=	76
	SYSHND=	77
	CTCFG=	21
	KMOVE=	23
	TEMP=	61
	LPOUT=	35
	KCDOIO=	27
	KRDOIO=	26
	GETPNT=	10
	M4=	66
	COUNT=	62
	DXAL=	6643
	DIMA=	6616
	DCLA=	6751
	P70=	65
	P17=	64
	TF0=	6260
	SBT=	6370
	AC0002=	7326
	AC7775=	7016
	KGETC=	24
	M1=	45
	*10
XR10,	0
XR11,	0
XR12,	RFLIST-1
XR13,	13
*100
SA1,	0
A1,	0
A2,	0
A3,	0
QUOT,	0
REM,	0
NUMBER,	0
MAXDEV,	0
LNMBR,	0
UNIT,	0
LUNMBR,	0		/CURRENT LOGICAL UNIT #
WFLAG,	0
USED,	0
OWNED,	0
DORG,	0
BOOT,	0
NEWLPT,	0
NEWSYS,	0
HUNKS,	0
DZERO,	0
NEWUNT,	0
ANLXFG,	0
	P77=	20		/
	P7600=	70
	P7=	40
	FLAGS=	7772
	SWITCH=	7776
	UNDEF=	5400		/FOR UNDEFINED LOGICAL UNITS
	UTBASE=	6200
	KOTOPD=	74

	*200
	TAD I	M4		/GET SYSTEM DEVICE POINTER
	DCA	SYSHND		/BECAUSE PAGE 0 VALUE MAY NOT BE CORRECT...
	TAD	BADINT
	DCA I	(LPTKIL		/FIX UP THIS POINTER
	JMP I	(INIT		/GO DO THE ONCE-ONLY STUFF
DOIT,	TAD	WINIT
	DCA	WFLAG
	TAD I	(SWITCH
	SNA
	JMP I	(RESET		/GUY WANTS TO REASSIGN LOGICAL UNITS
	TAD	(-300
	SNA
	JMP I	(CONFIG		/RECONFIGURE SYSTEM
	TAD	(300-2400
	SNA
	JMP I	(TTYSET		/TELETYPE INPUT, DIRECTLY
	TAD	(2400-1400
	SZA CLA			/CHECK FOR /L  (LIST TABLE OPTION)
	JMP	BAD		/NOPE, A BADNESS
LISTOP,	TAD	K214
	JMS I	LPOUT		/EJECT TO START
	TAD	K5		/DEVICE NUMBER, LPT
	JMS I	KCDOIO
	HEADR1-1		/PRINT FIRST LINE OF HEADER
K5,	5
	TAD	K5
	JMS I	KCDOIO		/NOW 2ND LINE
	HEADR2-1
K212,	212
	TAD	K212
	JMS I	LPOUT
	CLA IAC
	DCA	UNITNO		/START AT LOGICAL UNIT #1
	TAD	(-17
	DCA	UCOUNT
	TAD	(UTBASE-1+3
	DCA	GETPNT
LOOP,	TAD	(0101
	JMS	LP8P2C
	TAD	UNITNO
	JMS I	KOTOPD
	JMS	LP8P2C
	TAD I	GETPNT		/GET POINTER TO HANDLER, -1
	DCA	TEMP
	TAD	TEMP
	AND	P7
	TAD	(0121
	DCA I	(PUN		/PHYSICAL UNIT #
	TAD	TEMP
	AND	(7770
	TAD	M1
	DCA	TEMP
	TAD I	TEMP
	DCA	NUN
	DCA	QUOT
	ISZ	GETPNT
	TAD I	GETPNT
	CIA
	SNA
	JMP	NODEF
	JMS	DIV100
	JMS I	KOTOPD
	DCA I	(HILEN
	TAD	REM
	JMS I	KOTOPD
	DCA I	(LOLEN
	TAD	K5
	JMS I	KCDOIO
	LUD-1
K214,	214
REDO,	ISZ	UNITNO
	ISZ	UCOUNT
	JMP	LOOP
	TAD	K214
	JMS I	LPOUT
	JMP I	P7600
NODEF,	TAD	K5
	JMS I	KCDOIO
	UND-1
	NOP
	JMP	REDO
UNITNO,	0
UCOUNT,	0
BAD,	CLA IAC
	JMS I	KCDOIO
	BADSW-1
	NOP
	DCA I	(TF0		/TURN OFF BATCH
	JMP I	P7600
DIV100,	0
DODIV,	CLL
	TAD	(-144
	ISZ	QUOT
	SZL
	JMP	DODIV
	TAD	(144
	DCA	REM
	CLA CMA
	TAD	QUOT
	JMP I	DIV100
WINIT,	762
	PAGE

LUD,	-11
	0101
	0101
	0101
NUN,	0
PUN,	0
	0101
	0101
HILEN,	0
LOLEN,	0
LP8P2C,	0
	DCA	LTEM
	TAD	LTEM
	RTR
	RTR
	RTR
	AND	P77
	TAD	(237
	JMS I	LPOUT
	TAD	LTEM
	AND	P77
	TAD	(237
	JMS I	LPOUT
	JMP I	LP8P2C
LTEM,	0
CTRLZ,	TAD I	(SBT
	SNA CLA
	JMP	WRITEO		/IF TTY INPUT
	TAD	ERRMSG
	SZA CLA		/IF FILE INPUT & ERRORS, DON'T CHANGE
	JMP I	P7600
WRITEO,	JMS I	(GDINFO	/GET DIRECTORY INFO
	TAD I	SA1	/GET # OF HUNKS LEFT ON SYS DEV
	CLL CML CMA
	TAD	(7401
	SNL SMA CLA
	JMP	MAXSIZ	/LARGER THAN 4096 BLOCKS - USE MAX
	TAD I	SA1
	CIA
	CLL RTL
	RTL		/MULTIPLY BY 16
	SKP
MAXSIZ,	STA		/FOR SAFETY
	JMS I	(PDINFO	/SET NEW DIRECTORY LIMIT
	TAD	(PFLIST
	DCA	T
	TAD	(-20
	DCA	COUNT	/NOW GO THROUGH THE NEW UNITS TABLE
SYSRLP,	TAD I	T
	ISZ	T		/GET HANDLER ADDRESS
	CIA
	TAD I	(PF0	/IS IT THE SYSTEM HANDLER?
	SNA CLA
	TAD I	SA1	/YES - RELOCATE IT
	CIA
	TAD I	T
	DCA I	T
	ISZ	T
	ISZ	T
	ISZ	COUNT
	JMP	SYSRLP
	DCA I	(PFLIST+1	/SYS UNIT STARTS AT 0
	TAD I	SA1
	DCA I	(PFLIST+2	/AND IS AS LONG AS IT CAN BE
	TAD	(UTBLK
	JMS I	KSPLIT
	JMS I	SYSHND
	200
	LINBUF
	0
	TAD	(PFLIST-PFEND
	JMS I	KMOVE
	CDF 0
	PFLIST-1
	LINBUF+200-1
	DCA	CTCFG
	CLA CLL CMA
	AC7775
	TAD	WFLAG
	SZA CLA
	TAD	(UTBLK-1
	IAC
	JMS I	KSPLIT
	JMS I	SYSHND
	4200
	LINBUF
	0
	TAD	(PFLIST-PFEND
	JMS I	KMOVE
	CDF 0
	PFLIST-1
	PF0-1
	JMP I	(LISTOP
T,	0
BADSYN,	-6	/SYNTAX ERROR
	6472
	5765
	4271
	0146
	6363
	6063
BADDEV,	-7	/ILLEGAL DEVICE
	5255
	5546
	5042
	5501
	4546
	6752
	4446
/
	PAGE

TTYSET,	DCA I	(SBT
RESET,	TAD I	(FLAGS
	SPA CLA			/IS FGBG RUNNING?
	JMP	FGBGIN		/IF SO, DISALLOW CHANGING LOGICAL UNITS
	TAD	(PFLIST-1	/SET UP POINTER TO TENATIVE UNITS TABLE
	DCA	XR13
	TAD	(PF0-1		/POINTER TO CURRENT UNITS TABLE
	DCA	GETPNT
	TAD I	GETPNT		/MOVE CURRENT SYSTEM DEVICE PARAMTERES TO NEW TABLE
	DCA I	XR13
	TAD I	GETPNT
	DCA I	XR13
	TAD I	GETPNT
	DCA I	XR13
	TAD	(SYSLST-3	/NOW SUBTRACT SYSTEM SPACE FROM SYSTEM DEVICE ALLOTMENT
	DCA	GETPNT
NXT,	ISZ	GETPNT
	ISZ	GETPNT
	TAD I	GETPNT
	SPA			/JUST A SAFETY MEASURE - SHOULD NEVER HAPPEN
	HLT			/IT DID?  WELL, WE'RE DEAD NOW
	TAD I	(PF0
	SZA CLA			/MATCH CURRENT SYSTEM DEVICE TO LIST
	JMP	NXT		/WRONT ONE, TRY AGAIN...
	ISZ	GETPNT
	TAD I	GETPNT
	DCA	SA1		/POINTER TO (-) # OF SEGS LEFT
	IAC
	DCA	LUNMBR		/SET CURRENT LOGICAL UNIT # = 1
	TAD I	(SBT		/CHECK FOR FILE INPUT
	SNA CLA
	JMP	TTYLIN		/NOPE, TTY INPUT
REINIT,	CLA IAC			/IFN #1
	JMS I	(SYSINI
	3610			/15 BLOCK BUFFER, READ INTO FIELD 1
	JMP	CTRLZ		/NO MORE FILES
SYSLIN,	CLA IAC			/IFN = 1
	JMS I	KRDOIO
	LINBUF-1
	JMP	REINIT		/TRY RE-SYSINITING IF EOF SEEN
	TAD I	(LINBUF+1	/PICK UP LINE #
	DCA	LNMBR
	AC0002			/SET REL. CHAR. PAST LINE #
	JMP	UNPACK		/NOW UNPACK LINE
TTYLIN,	JMS I	KCDOIO
	LINBUF-1
	JMP	CTRLZ
UNPACK,	DCA	RELC
	TAD	(LINE-1
	DCA	XR12
GLOOP,	TAD	(LINBUF
	JMS I	KGETC
RELC,	0
	SNA
	JMP	EOL
	ISZ	RELC
	TAD	M1
	SNA
	JMP	GLOOP		/IGNORE SPACES
	TAD	(-74
	SNA
	JMP	GLOOP		/IGNORE TABS
	TAD	(75+237		/MAKE ASCII
	DCA I	XR12
	JMP	GLOOP
/
	PAGE

EOL,	DCA I	XR12		/0 AT END
	TAD	(LINE-1
	DCA	XR12
	TAD I	XR12		/IGNORE BLANK LINES
	SNA
	JMP I	[NXTLIN
	TAD	(-273		/AND COMMENT LINES
	SNA CLA
	JMP I	[NXTLIN
	CLA CMA		/REBACKUP ONE
	TAD	XR12
	DCA	XR12
	JMS	GET2C		/MAKE UP DEVICE MNEMNONIC
	TAD	(-0413		/-DK
	SNA
	JMP	RKAS
	TAD	(0413-0516		/DK-EN
	SNA
	JMP	CTRLZ		/"END" STATEMENT SEEN
	TAD	(0516-0424		/EN-DT
	SZA CLA
	JMP	DEVERR		/DEVICE ERROR
DTAS,	TAD	P7
	DCA	MAXDEV
	TAD	(DTLIST
	JMP	SAVDEV
RKAS,	TAD	(3
	DCA	MAXDEV
	TAD	(RKLIST
	JMP	SAVDEV
DEVERR,	JMS I	[ERRMSG
	BADDEV-1
	JMP I	[NXTLIN
ERRMSG,	0
	CLA
	DCA I	(TF0		/TURN OFF BATCH MODE
	TAD I	ERRMSG
	ISZ	ERRMSG
	DCA	.+3
	CLA IAC
	JMS I	KCDOIO
	0
K12,	12
	DCA	QUOT		/0
	TAD I	(SBT
	SNA CLA
	JMP I	ERRMSG	/DON'T PRINT LINE NO. IF TTY INPUT
	TAD	LNMBR
	JMS I	[DIV100
	JMS I	KOTOPD
	DCA	HINUM
	TAD	REM
	JMS I	KOTOPD
	DCA	LONUM
	CLA IAC
	JMS I	KCDOIO
	ATLINE-1		/"AT LINE XXXX"
	NOP
	JMP I	ERRMSG
GETNUM,	0
	DCA	NUMBER
	DCA	NUMSW
GETDIG,	TAD I	XR12
	SZA
	JMP	TSTNUM
NONUMB,	CLA CMA
	TAD	XR12		/BACK UP 1
	DCA	XR12
	JMP I	GETNUM
TSTNUM,	TAD	(-272
	CLL
	TAD	K12
	SNL
	JMP	NONUMB
	DCA	DIGIT
	TAD	NUMSW
	SNA CLA
	ISZ	GETNUM
	ISZ	NUMSW
	TAD	NUMBER
	CLL RTL
	TAD	NUMBER
	RAL
	TAD	DIGIT
	DCA	NUMBER
	SNL
	JMP	GETDIG
	JMS I	[ERRMSG
	NM2BIG-1
	JMP I	[NXTLIN
NUMSW,	0
DIGIT,	0
ATLINE,	-6
	4265
	0155
	5257
	4601
HINUM,	0
LONUM,	0
	PAGE

SAVDEV,	DCA	SYSTEM
	JMS	GETCHR		/GET UNIT #
	DCA	TEMP
	ISZ	MAXDEV		/DO YOU BELIEVE THIS ONE?
	TAD	MAXDEV
	CIA
	TAD	(-260
	TAD	TEMP
	CLL
	TAD	MAXDEV
	SNL
	JMP	DEVERR
	DCA	UNIT
	TAD	UNIT
	CLL RAL
	TAD	UNIT
	TAD	SYSTEM
	DCA	A1
	TAD	A1
	IAC
	DCA	A2
	TAD	A2
	IAC
	DCA	A3
	TAD I	XR12
	SZA
	TAD	(-273
	SNA
	JMP	ASSALL
	TAD	P17
	SZA CLA
	JMP	SYNERR		/SYNTAX ERROR
	JMS	GETNUM		/PICK UP A DECIMAL #
	TAD I	XR12		/GET TERMINATOR
	SNA
	JMP	DEVOK		/EOL
	TAD	(-273		/SEMICOLON FOR COMMENT
	SZA CLA
	JMP	SYNERR
DEVOK,	TAD I	A3		/GET (-) # OF FREE SEGMENTS LEFT ON DEVICE
	SNA
	JMP	BADSIZ		/EXACTLY 0 SPACE LEFT
	CLL CML
	TAD	NUMBER		/GET (+) AMOUNT WE'RE TRYING TO ALLOCATE
	SZA SNL			/0 LEFT WILL CLEAR LINK, BUT IT'S OK
	JMP	BADSIZ		/NOPE, WON'T FIT
OK,	DCA I	A3		/SAVE NEW LENGTH LEFT
	TAD I	A1		/MOVE IN HANDLER POINTER
	DCA I	XR13
	TAD I	A2		/GET FIRST FREE SEG # ON DEV
	DCA I	XR13
	TAD	NUMBER
	CIA
	DCA I	XR13		/PUT IN (-) # OF SEGS ON THIS UNIT
	TAD I	A2		/SET NEW FREE SEG # IN TABLE 1
	TAD	NUMBER
	DCA I	A2
	ISZ	LUNMBR		/BUMP LOGICAL UNIT #
	TAD	LUNMBR
	TAD	(-17
	SPA SNA CLA
	JMP	NXTLIN
	TAD	(JMP	OVRFLO		/SET ERROR IF MORE ASSIGNMENTS TRIED
	DCA	SAVDEV
NXTLIN,	TAD I	(SBT		/IS INPUT TTY, OR FILE?
	SNA CLA			/GO TO CORRECT PLACE FOR INPUT
	JMP	TTYLIN
	JMP	SYSLIN
SYSINI,	0
	JMS I	KPTRST		/ENTER WITH IFN IN AC
	TAD I	SYSINI
	DCA I	W0
	ISZ	SYSINI
	DCA I	W1		/0
	TAD	(SBT-1
	DCA	GET
X,	ISZ	GET
	TAD I	GET
	SNA
	JMP I	SYSINI		/NO MORE FILES IN LIST
	CMA
	SNA			/USED?
	JMP	X		/YUP
	CLL CMA RAR
	RTR
	RTR
	DCA	TEMP
	TAD	TEMP
	AND	P7400
	DCA I	W5
	TAD	TEMP
	RAL
	AND	(377
	DCA I	W4
	CLA CMA
	DCA I	GET
	DCA I	W3
	ISZ	SYSINI
	JMP I	SYSINI
BADSIZ,	JMS I	[ERRMSG
	NOFIT-1
	JMP I	[NXTLIN
OVRFLO,	JMS I	[ERRMSG
	ALLUSE-1
	JMP I	[NXTLIN
SYSTEM,	0
ASSALL,	TAD I	A3
	CIA
	DCA	NUMBER
	JMP	DEVOK
/
	PAGE

PFLIST,	UNDEF;0;0	/0
	UNDEF;0;0	/1
	UNDEF;0;0	/2
	UNDEF;0;0	/3
	UNDEF;0;0	/4
	UNDEF;0;0	/5
	UNDEF;0;0	/6
	UNDEF;0;0	/7
	UNDEF;0;0	/8
	UNDEF;0;0	/9
	UNDEF;0;0	/10
	UNDEF;0;0	/11
	UNDEF;0;0	/12
	UNDEF;0;0	/13
	UNDEF;0;0	/14
	UNDEF;0;0	/15
	PFEND=.

DTLIST,	DTAJMS+0
DT0BEG,	0
DT0SIZ,	-56
	DTAJMS+1
	0
	-56
	DTAJMS+2
	0
	-56
	DTAJMS+3
	0
	-56
	DTAJMS+4
	0
	-56
	DTAJMS+5
	0
	-56
	DTAJMS+6
	0
	-56
	DTAJMS+7
	0
	-56
RKLIST,	RK8JMS+0
RK0BEG,	0
RKSIZ0,	-313		/THIS CHANGES TO -626 IF RK05 OR TO -100*N IF RF08
	RK8JMS+1
	0
RKSIZ1,	-313		/	DITTO
	RK8JMS+2
	0
RKSIZ2,	-313		/	ETC.
	RK8JMS+3
	0
RKSIZ3,	-626
SYSLST,	-DTAJMS
	DT0BEG
	DT0SIZ
	-RK8JMS
	RK0BEG
	RKSIZ0
NM2BIG,	-6	/# TOO LARGE
	0401
	6560
	6001
	5542
	6350
	4600
GET2C,	0
	JMS	GETCHR
	AND	P77
	CLL RTL
	RTL
	RTL
	DCA	TEMP
	JMS	GETCHR
	AND	P77
	TAD	TEMP
	JMP I	GET2C
GETCHR,	0
	TAD I	XR12
	SZA
	JMP I	GETCHR
SYNERR,	JMS I	[ERRMSG		/CHAR. EXPECTED, NONE FOUND
	BADSYN-1
	JMP I	[NXTLIN
BADSW,	-5		/"BAD SWITCH"
	4342
	4501
	6470
	5265
	4451
	PAGE

/ROUTINE TO GET INFORMATION FROM SYSTEM DIRECTORY
GDINFO,	0
	DCA	DORG	/INITIALIZE FILE ORIGIN
	CLA IAC
GDSEG,	DCA	DSEG	/SAVE SEGMENT #
	TAD	DSEG
	JMS I	KSPLIT
	JMS I	SYSHND
	0200
	DIRBFR
	0		/READ IN DIRECTORY SEGMENT
	TAD	DORG
	SNA		/FIRST SEGMENT?
	TAD I	(DIRBFR+1	/YES - GET FILE ORIGIN
	DCA	DORG
	TAD I	(DIRBFR+2
	SZA		/LAST SEGMENT?
	JMP	GDSEG	/NO
	TAD I	(DIRBFR+1
	DCA	BLOCK
	TAD I	(DIRBFR
	DCA	DCOUNT
	TAD	(DIRBFR+5	/PREPARE TO SCAN SEGMENT
	DCA	DPTR
	SKP
	JMS	DSKIP
	ISZ	DCOUNT
	JMP	.-2	/SKIP ALL BUT LAST ENTRY
	TAD I	DPTR
	SNA CLA		/LAST ENTRY EMXTY?
	JMP	LASTMT	/YES
	JMS	DSKIP	/NO - THEN "USED" = "OWNED"
	TAD	BLOCK
	DCA	USED
	JMP	DGCOMN
LASTMT,	TAD	BLOCK
	DCA	USED
	JMS	DSKIP
DGCOMN,	TAD	BLOCK
	DCA	OWNED
	JMP I	GDINFO
DPTR,	0
NEW,	0
BLOCK,	0
CHANGE,	0
DSEG,	0
DCOUNT,	0
DSKIP,	0
	TAD I	DPTR
	SNA CLA
	JMP	.+3
	CLA CLL CMA RTL
	TAD I	(DIRBFR+4	/SKIP FOR FILE ENTRIES
	CIA
	IAC		/SKIP FOR EMPTY ENTRIES
	TAD	DPTR
	DCA	DPTR	/SKIP TO LAST WORD OF ENTRY
	TAD I	DPTR	/WHICH IS LENGTH
	CIA
	TAD	BLOCK	/WHICH WE ADD INTO THE CURRENT BLOCK #
	DCA	BLOCK
	ISZ	DPTR
	JMP I	DSKIP

/ROUTINE TO CHANGE "OWNED" AND REWRITE DIRECTORY
PDINFO,	0
	DCA	NEW	/NEW VALUE OF "OWNED" IN AC ON ENTRY
	TAD	NEW
	CIA
	TAD	OWNED
	SNA
	JMP I	PDINFO	/NO CHANGE - BYE
	DCA	CHANGE
	TAD	NEW
	CMA CLL
	TAD	USED
	SZL CLA		/CHECK IF WE ARE BEING SQUEEZED TOO MUCH
	JMP	SQZERR	/YES
	TAD	USED
	CIA
	TAD	OWNED
	SNA CLA		/MUST WE CREATE A FRESH EMPTY ENTRY?
	JMP	MAKMT	/YES
	STA		/NO - JUST ALTER THE EXISTING ONE
	TAD	DPTR
	DCA	DPTR
	TAD I	DPTR
DPCOMN,	TAD	CHANGE
	SNA		/IF THE EMPTY ENTRY COMES OUT NULL,
	ISZ I	(DIRBFR	/DELETE IT
	SKP
	JMP	SQZERR	/WE CAN'T BE LEFT WITH NOTHING!
	DCA I	DPTR
	TAD	DSEG
	JMS I	KSPLIT
	JMS I	SYSHND
	4200
	DIRBFR
	0		/REWRITE THIS SEGMENT
	JMP I	PDINFO
MAKMT,	STA
	TAD I	(DIRBFR
	DCA I	(DIRBFR	/BUMP ENTRY COUNT
	DCA I	DPTR
	ISZ	DPTR
	JMP	DPCOMN	/MAKE NEW ENTRY WITH LENGTH "CHANGE"
SQZERR,	JMS I	[ERRMSG
	SQZMSG-1
	JMP I	P7600
	PAGE

/SYSTEM CONFIGURATOR
CONFIG,	CLA
	TAD I	(FLAGS
	SPA CLA			/IS FGBG RUNNING?
	JMP	FGBGIN		/IF SO, DON'T LET GUY DO THIS
	DCA	BOOT
	DCA	DZERO
	DCA	HUNKS
	JMS I	(YESNO
	CHGSYS-1
	SKP
	JMP	NOCHNG
	CLA IAC
	JMS I	KCDOIO
	SYSMSG-1
	NOP
	DCA I	(LINBUF+2
	JMS I	KCDOIO
	LINBUF-1
	JMP	NOCHNG
	TAD I	(LINBUF+1
	TAD	(-4554		/DK
	SNA
	JMP	RKSYS
	TAD	(4554-4565	/DT
	SZA CLA
	JMP	CONFIG	/ERROR - ASK HIM AGAIN
DTSYS,	TAD	(DTAJMS
	DCA	NEWSYS
	TAD	(DTBOOT
	DCA	BTADR
	ISZ	BOOT		/FOR LATER SELECTION OF PROPER INTERRUPT HACK THING
	JMP	COMNC
RKSYS,	TAD	(RK8JMS
	DCA	NEWSYS
	TAD	(RKBOOT
	DCA	BTADR
COMNC,	TAD I	(LINBUF+2
	CLL RTR
	RTR
	RTR
	AND	P77
	SNA
	JMP	SAVUNT
	TAD	(-31
	CLL
	TAD	(10
	SNL
	JMP	CONFIG	/NOT IN RANGE 0-7
SAVUNT,	DCA	NEWUNT
	JMS I	(GDINFO
	JMS I	(YESNO
	ALLQ-1		/TRANSFER FILES?
	JMP	TALL	/YES
	ISZ	DZERO	/SET DIRECTORY ZERO FLAG
	TAD I	(DORG
	SKP
TALL,	TAD I	(USED
	TAD	P17	/CHANGE BLOCKS TO HUNKS
	CLL RTR
	RTR
	AND	(377
	CIA
	DCA	HUNKS
	JMP	LPTASK
NOCHNG,	TAD I	(PF0	/USE EXISTING SYSTEM DEVICE,
	DCA	NEWSYS
	DCA	NEWUNT	/AND UNIT 0
LPTASK,	DCA	ANLXFG
	JMS I	(YESNO
	LP08Q-1
	SKP
	JMP	.+3
	ISZ	ANLXFG
	JMP	COL130
	JMS I	(YESNO
	LPTQ-1
COL130,	TAD	(-64
	TAD	(-120
	DCA	NEWLPT	/NEW LINE PRINTER LENGTH
	JMP I	(GOTOIT	/GO TO IT!
FGBGIN,	CLA IAC
	JMS I	KCDOIO
	FGBGMG-1		/NOT WITH FGBG
	NOP
	JMP I	P7600
FGBGMG,	-7			/NOT WITH FGBG
	5760
	6501
	7052
	6551
	0147
	5043
	5000
/
	PAGE

/CONFIG - PERFORM ACTUAL ALTERATIONS AND/OR TRANSFER
GOTOIT,	JMS I	(YESNO
	SURE-1
	SKP
	JMP	CONFIG
	TAD	HUNKS
	SNA CLA
	JMP	INPLAC	/CHANGE SYSTEM IN PLACE
	TAD	NEWUNT
	TAD	(4010
	DCA	OUTCTL
	DCA	IBLOCK
	DCA	OBLOCK
COPYLP,	JMS I	SYSHND
	0010
	0
IBLOCK,	0
	TAD	IBLOCK
	JMS I	(CHNGES	/MAKE CHANGES
	JMS I	NEWSYS
OUTCTL,	0
	0
OBLOCK,	0
	ISZ	IBLOCK
	ISZ	OBLOCK
	ISZ	HUNKS
	JMP	COPYLP
	TAD	NEWUNT
	TAD	(4200
	DCA	BTCTL
	JMS I	NEWSYS
BTCTL,	0
BTADR,	0
	0
	TAD	DZERO
	SNA CLA
	JMP I	P7600
	TAD I	(DORG
	DCA I	(ZORG
	TAD I	(OWNED
	CIA
	TAD I	(DORG
	DCA I	(ZLNGTH
	TAD	BTCTL
	DCA	DIRCTL
	CLA IAC
	JMS I	KSPLIT
	JMS I	NEWSYS
DIRCTL,	0
	ZRODIR
	0
	JMP I	P7600
INPLAC,	JMS I	SYSHND
	10
	0
R1,	0
R2,	CLA
	JMS I	(CHNGES
	JMS I	SYSHND
	4010
	0
R3,	0
	TAD	R1
	SZA CLA		/HAVE WE COPIED BOTH HUNK 0 AND 1
	JMP I	P7600
	ISZ	R1	/ONTO THEMSELVES?
	ISZ	R2
	ISZ	R3
	JMP	INPLAC	/NO - GET HUNK 1
	PAGE

/RANDOMNESS
ALLUSE,	-11		/"ALL UNITS ASSIGNED"
	4255
	5501
	6657
	5265
	6401
	4264
	6452
	5057
	4645
NOFIT,	-16		/"INSUFFICIENT SPACE ON DEVICE"
	5257
	6466
	4747
	5244
	5246
	5765
	0164
	6142
	4446
	0160
	5701
	4546
	6752
	4446
HEADR1,	-27
	5560	/"LOGICAL   DEVICE   LENGTH      SYSGEN V 3.07"
	5052
	4442
	5501
	0101
	4546
	6752
	4446
	0101
	5546
	5750
	6551
	0101
	0101
	0101
	6472
	6450
	4657
	0101
	6701	/V
	2417	/3.
	2130	/07
	0000	/FOR PATCH LEVEL
HEADR2,	-16
	6657	/"UNIT #  NAME    (SEGMENTS)"
	5265
	0104
	0101
	0101
	5742
	5646
	0101
	0101
	1164
	4650
	5646
	5765
	6412
UND,	-11
	0101
	0101
	1601		/"- UNDEFINED -"
	6657
	4546
	4752
	5746
	4501
	1600
ZRODIR,	-1
ZORG,	0
	0
	0
	-1
	0
ZLNGTH,	0
YESNO,	0
	TAD I	YESNO
	DCA	QUEST
	ISZ	YESNO
	CLA IAC
	JMS I	KCDOIO
QUEST,	0
	NOP
	JMS I	KCDOIO
	LINBUF-1
	JMP	YESNO+4
	TAD I	(LINBUF+1
	AND	(7700
	TAD	(-7200	/"Y"
	SZA CLA
	ISZ	YESNO
	JMP I	YESNO
	PAGE

SQZMSG,	.+1-SYSMSG	/NOT ENOUGH ROOM FOR SYSTEM AND FILES
	157;6065;146;5760
	6650;5101;6360
	6056;147;6063
	164;7264;6546
	5601;4257;4501
	4752;5546;6400
SYSMSG,	.+1-CHGSYS	/WHAT IS THE NEW SYSTEM DEVICE?
	7051;4265;152
	6401;6551;4601
	5746;7001;6472
	6465;4656;145
	4667;5244;4640
CHGSYS,	.+1-ALLQ	/DO YOU WANT TO CHANGE THE SYSTEMS DEVICE?
	4560;172;6066
	170;4257;6501
	6560;144
	5142;5750;4601
	6551;4601;6472
	6465;4656;145
	4667;5244;4640
	0
ALLQ,	.+1-LP08Q		/DO YOU WANT TO TRANSFER YOUR FILES?
	4560;172;6066
	170;4257;6501
	6560;165;6342
	5764;4746;6301
	7260;6663;147
	5255;4664;4000
LP08Q,	.+1-LPTQ		/DO YOU HAVE AN ANELEX LINE PRINTER?
	4560;0172;6066
	0151;4267;4601
	4257;0142;5746
	5546;7101;6163
	5257;6546;6340
LPTQ,	.+1-SURE		/132 COLUMN PRINTER?
	2224;2301;4460
	5566;5657;0161
	6352;5765;4663
	4000
SURE,	.+1-END	/IS EVERYTHING CORRECT?
	5264;146;6746
	6372;6551;5257
	5001;4460;6363
	4644;6540
END,
	PAGE

/ROUTINE WHICH CHANGES CODE AS IT PASSES THROUGH
CHNGES,	0		/HUNK NUMBER IN AC ON ENTRY
	SNA
	JMP	CHANG0	/HUNK ZERO HAS ALL KINDZA GOODIES
	TAD M1
	SNA
	JMP CHANG1
	CLA
	JMP I	CHNGES
CHANG0,	CDF 10
	TAD	HUNKS
	SNA CLA
	JMP	JUSTLP	/NOT CHANGING SYSTEM
	TAD	NEWSYS
	DCA I	(5774
	TAD	NEWSYS
	DCA I	(4200
	TAD	BOOT
	TAD	(TAD RKWAIT
	DCA	.+1
	HLT
	DCA I	(RECOVR+1-2000	/WAIT LOOP POINTER * * * C A R E F U L ! ! ! * * *
JUSTLP,	TAD	NEWLPT
	DCA I	(5773
	CDF 0
	TAD	ANLXFG
	SZA CLA
	TAD	(ANLXHD-LP08HD
	TAD	(LP08HD+2
	DCA	MOVRG1
	TAD (-56
	JMS I	KMOVE		/MOVE IN CORRECT LPT HANDLER
	CDF 10
MOVRG1,	0
	5430
	JMP I	CHNGES
CHANG1,	CLA CLL CMA RTL
	TAD MOVRG1
	DCA MOVRG2
	CLA CLL CMA RTL
	JMS I KMOVE		/MOVE IN ERROR FLAG KILLING STUFF
	CDF 10
MOVRG2,	0
LPTKIL,	0			/FILLED IN AT STARTUP TIME
	JMP I CHNGES
RKWAIT,	RK01TL		/THIS CHANGES IF RK05 OR RF08
DTWAIT,	TC08TL		/THIS CHANGES IF TC12 (TD8E DOES IOF, SO IT DOESN'T MATTER)
/
	PAGE

BOOTS=.
/THIS WHOLE THING LOOKS WORSE THAN IT ACTUALLY IS.  CHECK CODE "INIT."
/THAT CODE FINDS OUT IF THE MACHINE HAS AN RK05 (STANDARD) OR AN RK01.
/IF MACHINE HAS AN RK01, IT CHECKS IN-CORE HANDLER TO SEE IF IT'S THE
/RK01 HANDLER, AND IF IT ISN'T, A COPY OF THE RK01 HANDLER GETS MOVED IN
/TO 6400, AND WRITTEN OUT TO THE SYSTEM DEVICE.
/LIKEWISE, IT CHECKS THE TYPE OF TAPE YOU HAVE, BY LOOKING AT THE IN-CORE
/HANDLER, AND MOVES THE CORRECT BOOTSTRAP IN FOR LATER USE.
/BECAUSE OF MULTITUDINOUS "NOPUNC" ORIGINS, BE CAREFUL ABOUT WHERE
/YOU THINK THIS CODE REALLY IS...IT MAY NOT BE.
	RK05BT=.
	RKBOOT=.		/THIS CODE CHANGES IF RK01
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	ZBLOCK 3230-.
	DSKP=6741
	DSKP
	JMP	.-1
	CLA IAC
	DCLR=6742
	DCLR
	TAD	RE6000
	DLCAE=6744	/DUPLICATE MNEMNONIC WITH RK8...DUMB!
	DLCAE
RLP,	TAD	REBLK
	DLAG=6743
	DLAG
REP7,	7
	DSKP
	JMP	.-1
	ISZ	REBLK
	TAD	RE1000
	DLDCE=6746	/ALSO DUPLICATED WITH RK8
	DLDCE
	ISZ	RCNT
	JMP	RLP
	JMP I	R57600
RCNT,	-4
RE1000,	1000
RE6000,	6000
REBLK,	10
	ZBLOCK 3270-.
R57600,	7600

	*BOOTS+100
LP08HD,	6663;7410;6667
	1306;7700;5240;2306;5242;7240;3225;6662;5216;2305
	1705;7510;3305;7200;1705;6666;LPSIZ,	356;5211
	0000;6201;0324;3704;7201;6665;1306;1251;7650
	5257;6202;7340;1306;3306;3225;1704;7420;6666
	7630;2304;1704;7510;3304;7200;5653
	LPLOC,	7021;LPLOC2,	7020;0000
/
/LOCATIONS LPSIZ, LPLOC, LPLOC2  CHANGE IF TD8E
/

	*BOOTS+200
	TC12BT=.
	/THIS READS INTO *4000, FIELD 0
	PCDF=71
/LINCTAPE BOOTSTRAP
	HLT
	401
	7464
	7264
	7601
	SYSDAT
	0
K7600,	7600
K70,	70
	K7,	7
K17,	17
LK200,	200
KCDF,	CDF 0
	*.&7600+17
C,	7767	/-10
	1020	/LDA I
	20
	1	/AXO
J,	1020	/LDA I
L,	6000
	23	/TMA
	702
K,	20
	1020	/LDA I
	1
	2027	/ADD K
	4027	/STC K
	2024	/ADD L
	2013	/ADD LK200
	4024	/STC L
	237	/XSK I C
	6023	/JMP J
	2	/PDP
	TAD	K70
	DCA	65
	TAD	K7
	DCA	P7
	TAD	K17
	DCA	P17
	TAD	K7600
	DCA	P7600
	TAD	KCDF
	DCA	PCDF
	JMP I	K7600

	*BOOTS+300
ANLXHD,	6651;7410;6652
	6652;3301;5216;7775;7566;7574;7574;1252;6002;2301
	1064;6652;6664;6001;1236;3237;5653;7771
	0000;3307;1301;7640;5255;1307;1235;7450
	5240;1234;7450;5653;7001;7650;5241;1237
	7650;5653;1307;6654;2237;5653
	0000;5653;0000

	*BOOTS+400
	TC08BT=.
	DTBOOT=.		/CHANGES IF TD8E OR TC12
	NOPUNC
	*7600
	ENPUNC
	JMP	FAKEIT
	0401
	7464
	7264
	7601
	SYSDAT
	0
CHGCA,	DCA	7755
	DTSF
	JMP	.-1
	DCA	7755
	JMP	1
	0
	0
	0
DWAIT,	JMP	CHGCA
	NOPUNC
	*201	/THIS SHOULD REALLY BE "*1" BUT PAL10 BLOWS UP IF IT IS
	/THIS CODE READS INTO FIELD 0, PAGE 0, WHEN BOOTSTRAPPED
	ENPUNC
	TAD	D30
SRCHLP,	DTXA
	DTSF
	JMP	.-1
	AND I	0		/MAGIC...THIS IS SUPPOSED TO MAKE THE BOOTSTRAP WORK
	TAD	0
	TAD	DM20
	SZA CLA
	JMP	SRCHLP
	TAD	D5777
	DCA I	D7755
	DCA I	D7754
	TAD	D30
BRDLP,	DTXA
	DTSF
	JMP	.-1
	CLA CMA
	TAD I	D7755
	DCA I	D7755
	ISZ	M10
	JMP	BRDLP
	JMP I	D7600
DM20,	-20
D5777,	5777
D30,	30
M10,	-10
D7600,	7600
D7755,	7755
	D7754,	7754
	ZBLOCK 2
	7
	NOPUNCH
	*.+7417
	ENPUNCH
FAKEIT,	TAD	D600
	DTCA DTXA
	DTSF
	JMP	.-1
	TAD	D7577
	DCA	7754
	TAD	D7577
	DCA	7755
	TAD	D220
	DTCA DTXA
	TAD	D5217
	DCA	DWAIT
D5217,	JMP	DWAIT
D600,	600
	D220,	220
D7577,	7577
	ZBLOCK 7		/PRAY
	7600
	ZBLOCK 6
	6610

	*BOOTS+600
	TD8EBT=.
	0;0401;7464;7264;7601;SYSDAT;0
	ZBLOCK	11
	NOPUNCH
	*7400
	ENPUNCH
QMOVE,	TAD I	P1
	DCA I	P2		/RELOCATE
	ISZ	P1
	ISZ	P2
	ISZ	TDK		/DONE?
	JMP	QMOVE
	JMP	0
P1,	TDK+1
P2,	0
TDK,	TDBOOT-TDBEND-1
	NOPUNCH
	*1200		/THIS IS REALLY *0
	ENPUNCH
TDBOOT,	TAD	QK7600
	DCA	TDWCT
	7400		/MUST BE AT LOC'N 2
	SDSS=6771
	SDSS		/WAIT FOR BLOCK MARK
	JMP	.-1
	SDRC=6776
	SDRC
	AND	TD77
	TAD	KM26
	SZA CLA		/IS IT A BLOCK MARK?
	JMP	TDBOOT+2		/NOPE
	SDRD=6777
	SDRD		/YUP, GET BLOCK #
	TAD	TDBKNO		/RIGHT ONE?
	SZA CLA
	JMP	TDBOOT+2		/NOT YET
TDRGRD,	SDSS
	JMP	.-1
	77		/MUST BE AT LOC'N 20
	SDRC
	AND	TD77
	TAD	KM32		/IS IT REV. GUARD?
	SZA CLA
	JMP	TDRGRD
	JMS	TDRQD
	JMS	TDRQD
	JMS	TDRQD
QTDREA,	JMS	TDRQD		/GET A DATA WORD
	ISZ	QTDPTR
	DCA I	QTDPTR
	ISZ	TDWCT		/DONE?
	JMP	QTDREAD
QK7600,	7600
TD77,	77
	7		/MUST BE AT LOC'N 40
	CLA CMA
	TAD	TDBKNO
	DCA	TDBKNO
	ISZ	QM10
	JMP	TDBOOT
	SDLC=6774
	SDLC		/STOP TAPE
	JMP I	QK7600		/BOOT REST OF SYSTEM
TDWCT,	7600
TDRQD,	0
	SDSQ=6773
	SDSQ
	JMP	.-1
	SDRD
	JMP I	TDRQD
KM26,	-26
KM32,	-32
TDBKNO,	-20		/READ BLKS 20-27
QTDPTR,	5777		/INTO 6000-7777
QM10,	-10
	0
	0
	70		/MUST BE AT 65
	0
	0
	7600		/MUST BE AT 70
	CDF 0		/MUST BE AT 71
TDBEND,

	*4200
	RK01BT=.
	NOPUNC
	*601	/THIS SHOULD ALSO BE "*1" BUT PAL10 GIVES "Z" ERRORS IF IT IS...
	ENPUNC
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	ZBLOCK 617-.
X3777,	3777+1
P6000,	6000	
RKBLP,	TAD I	X3777
	DCA I	P6000
	ISZ	P6000
	JMP	RKBLP
	JMP I	.+1
	7600
	ZBLOCK 630-.
	6745		/DSKD
	JMP	.-1
	JMP	RKBLP
	ZBLOCK 640-.
	7
	ZBLOCK 670-.
	7600

	*4300
RFLIST,	77;177;277;377;0	/PUT HERE FOR LACK OF A BETTER PLACE
	RF08BT=.
	NOPUNC
	*4200		/ANY PAGE BOUNDARY WILL DO...
	ENPUNC
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	*RF08BT+16	/THINK ABOUT THIS ONE
	NOPUNCH
	*6622
	ENPUNCH
	TAD	RB70
	DCA	65		/THIS CODE READS INTO 6622
	TAD	RB7600
	DCA	70
	TAD	RBSIZ
	DCA	COUNT
	TAD	RBDOT1
	DCA	GETPNT
	TAD	RBDOT2
	DCA	XR11
	TAD I	GETPNT		/MOVE DOWN TO 5000
	DCA I	XR11
	ISZ	COUNT
	JMP	.-3
	JMP I	.+1
	RDOT&177+5000
RDOT,	TAD	R5777
	DCA I	R7750
	TAD	R5777
	DCA I	R7751
	CLA CLL CML RAR
	6603
	6622
	JMP	.-1
	JMP I	RB7600
R7750,	7750
R7751,	7751
R5777,	5777
RB70,	70
RB7600,	7600
RBSIZ,	-25
RBDOT1,	RDOT-1
RBDOT2,	RDOT&177+5000-1

	*4400
INIT,	TAD I	(FLAGS
	SPA CLA			/IF FGBG RUNNING,
	JMP I	(DOIT		/WE CAN'T ISSUE RANDOM DISK IOTS!
	CLA CLL CML RTR		/2000
	6742			/IF RK05, SHOULD CLA
	SNA CLA
	JMP	GOTRK5		/IT DID SO IT IS
	TAD	P70
	6732			/DLDC
	SNA CLA			/RK01?
	JMP	ISITIN		/YUP
RFCKLP,	TAD I	XR12		/SET TO RFLIST-1
	SNA			/END OF LIST?
	JMP	RK01CK		/YUP - GO SEE WHAT HAPPENED
	6643
	6616
	RTR
	SZL CLA
	JMP	RK01CK		/NON-EXISTENT PLATTER
	TAD	(-100		/EACH RF08 PLATTER IS 64 SEGMENTS LONG
	TAD	DKSIZE
	DCA	DKSIZE
	JMP	RFCKLP
RK01CK,	TAD	DKSIZE
	SNA CLA			/DID WE FIND ANY RF'S?
	JMP	ISITIN
GOTRF,	TAD	(RF08BT-1
	DCA	RKBTAD
	TAD	(RF08-1
	DCA	RKADDR
	TAD	(RF08TL
	DCA I	(RKWAIT
	TAD	(-7750+4
ISITIN,	TAD	M4		/ASSUME IN CHEERFUL IGNORANCE IT'S AN RK01
	TAD I	(6401
	SNA  CLA		/HAVE WE ALREADY GOT A RK01 HANDLER?
	JMP	MVBOOT		/YES - SO JUST WORRY ABOUT BOOTSTRAP
RKMOVE,	TAD	M140
	CDF 10
	JMS I	KMOVE		/MOVE IN CORRECT HADLER
	CDF 0
RKADDR,	RK01-1			/THIS CHANGES IF RK05 OR RF08
	6400-1
	RKBLK=	11
	TAD	(RKBLK^400	/WHERE DISK HANDLER IS ON TAPE
	JMS I	SYSHND		/WRITE OUT NEW ONE
	4100
	6400
	0
MVBOOT,	TAD	(-100		/MOVE IN CORRECT BOOTSTRAP
	JMS I	KMOVE
	CDF 0
RKBTAD,	RK01BT-1		/THIS CHANGES IF RK05 OR RF08
	RKBOOT-1
	TAD	DKSIZE
	SZA			/IF RK01, DKSIZE=0
	DCA I	(RKSIZ0
	TAD I	(RKSIZ0
	DCA I	(RKSIZ1
	TAD I	(RKSIZ1
	DCA I	(RKSIZ2
	TAD I	(RKSIZ2
	DCA I	(RKSIZ3
NODISK,	TAD I	(6600		/NOW CHECK FOR TYPE OF TAPE
	TAD	(-7754		/FIRST WORD OF EACH HANDLER IS UNIQUE
	SNA			/TC08?
	JMP I	(DOIT		/YES - REASON HAS PREVAILED!
	TAD	(7754-100	/IS IT TC12?
M140,	SZA CLA
	JMP	LINC		/YUP
	TAD	(7221		/NO - ASSUME IN CHEERFUL IGNORANCE IT'S GOT TO BE TD8E
	DCA I	(LPLOC
	TAD	(7220		/SHRINK LPT BUFFER AS NECESSARY
	DCA I	(LPLOC2
	TAD	(117		/TO LEAVE SPACE FOR TD8E HANDLER
	DCA I	(LPSIZ
	TAD	(TD8EBT-1
	DCA	DTMOVE
	JMP	DTSIZE
LINC,	TAD	(TC12TL		/CHANGE INTERRUPT HACK
	DCA I	(DTWAIT
DTSIZE,	TAD	P7600
	JMS I	KMOVE
	CDF 0
DTMOVE,	TC12BT-1		/TC12 IS MOVE DEFAULT, FOR NO GOOD REASON
	DTBOOT-1
DTOK,	JMP I	(DOIT
/
GOTRK5,	TAD	(RK05BT-1
	DCA	RKBTAD
	TAD	(RK05-1
	DCA	RKADDR
	TAD	(-626
	DCA	DKSIZE
	TAD	(RK05TL
	DCA I	(RKWAIT
	TAD	(-3700+4
	JMP	ISITIN
DKSIZE,	0
/
	PAGE

/
	FIELD 1
/

	*200
	RK05=.
	NOPUNC
	*6400
	ENPUNC
	DCLR=6742
	DLAG=6743
	DLDC=6746
	DRST=6745
	DSKP=6741
	DLCA=6744
CHKHED,	0
R3700,	3700		/"R3700" MUST BE AT RELATIVE LOCATION 201
KIODIE,	IODIE
GARG,	0
TRYRK,	0
R4077,	4077
PAGCNT,	0
RKCODE,	4554		/"DK"
RK8,	0			/MUST BE AT *6410
	DCA	GARG		/ENTER WITH LOW BLOCK BITS IN AC
	TAD I	RK8
	AND	RE7		/GET UNIT BITS
	TAD I	RK8		/MULTIPLY THEM BY 2
	AND	R4077		/AND GET R/W AND FIELD BITS
	DCA	RKECMD
	TAD I	RK8
	ISZ	RK8
R201,	AND	R3700		/GET # OF PAGES TO DO
	SNA			/0 IMPLIES 40...
	CLA CLL CML RAR		/4000
	DCA	PAGCNT
	TAD I	RK8		/GET CURRENT ADDRESS
	ISZ	RK8
	DCA	RCA		/RCA IS A REGISTERED TRADEMARK OF RADIO CORPORATION OF AMERICA?
	DCA	CTCFG		/TURN OFF ^C
	TAD	GARG
	CLL RAL
	TAD I	RK8
	ISZ	RK8
	RTL
	RTL
	DCA	GARG
	SZL			/CHECK FOR POSSIBLE "SUPER CYLINDER" BIT
RK2,	ISZ	RKECMD		/IF IT IS THERE
RK1,	DCA	CHKHED
RKRETR,	CLA CLL CMA RTL		/-3
	DCA	TRYRK
RELPX,	DCLR			/CLEAR STATUS
	TAD	RCA
	DLCA			/LOAD CURRENT ADDRESS
	TAD	PAGCNT
	AND	RE7600
	SNA CLA
	TAD	R201
	TAD	CHKHED
	CLL RAR
	TAD	RKECMD
	DLDC			/LOAD COMMAND REGISTER
	TAD	GARG		/NOW GET DISK ADDRESS
	DLAG			/AND START IT GOING
RK05TL,	DSKP
	JMP	.-1
	DRST			/GET STATUS
	CLL RAL
	SZA CLA
	JMP	RKEBAD		/OH WELL
	TAD	PAGCNT
	TAD	RE7600
	SPA SNA
	JMP	RKDONE
	DCA	PAGCNT
	TAD	RCA
	TAD	R400
	DCA	RCA
	TAD	GARG
	CMA
	AND	RK37
	SZA CLA			/CHECK FOR NEW TRACK
	STL RTR			/IF NOT, SET "DON'T CHECK HEADER"
	ISZ	GARG
	JMP	RK1
	JMP	RK2
RKEBAD,	DCLR			/RECALIBRATE
	STL RTL
	DCLR
	DSKP
	JMP	.-1
	DCLR
	DRST
	SZA CLA
	JMP	.-2
	DCA	CHKHED
	ISZ	TRYRK		/HAVE WE ALREADY TRIED THIS FOOLISHNESS ENOUGH?
	JMP	RELPX		/'FRAID NOT
FATALE,	TAD	RKCODE
	JMS I	KIODIE		/TELL USER THE BAD NEWS
	JMP	RKRETR
RE7600,
RKDONE,	7600
	ISZ	CTCFG		/RE-ENABLE ^C
	JMP I	RK8
	JMP I	RE7600
RKECMD,	0
R400,	400
RK37,	37
RE7,	7
RCA,	0

	*400
	RF08=	.
	NOPUNC
	*6400
	ENPUNC
	0	/SBT PROTECTION
RFWC,	7750
RFCA,	7751
RFCNT,	0
RFLOW,	0
RFIODI,	IODIE
RFDMAR,	DMAR
	DMAR=6603
	DCMA=6601
	DIML=6615
	DXAL=6643
	DISK=6622
	DFSE=6621
	4554		/"DK"
RF08X,	0
	IFNZRO RF08X&7 <ERROR - MUST BEGIN ON 10-WORD BOUNDARY>
	DCA	RFLOW		/SAVE LOW ORDER DISK ADDRESS
	DCA	CTCFG		/INHIBIT ^C
	AC7775
	DCA	RFCNT
RFRETR,	TAD I	RF08X
	RAL
	CLA RTL
	TAD	RFDMAR		/6603 (READ) OR 6605 (WRITE)
	DCA	RFINST
	TAD	RF70		/CHECK FOR EXISTENCE OF ANY DISK AT ALL
	DIML
	SZA CLA		/CHECK FOR NO DISK AT ALL
	JMP	RFBAD
	TAD I	RF08X
	AND	RF70		/LOAD DISK DATA FIELD
	DIML
	TAD I	RF08X
	RAL
	AND	RF7600
	CIA
	DCA I	RFWC		/SET UP WORD COOUNT
	CLA CMA
	ISZ	RF08X
	TAD I	RF08X
	DCA I	RFCA		/&CURRENT ADDR
	ISZ	RF08X
	TAD I	RF08X
	DXAL			/HI-ORDER DISK ADDR
	ISZ	RF08X
	TAD	RFLOW
RFINST,	6603			/GO
RFWAIT,	DFSE
	JMP	RFOK
RFERR,	ISZ	RFCNT		/TRY 3 TIMES
	JMP	RFREPT
RFBAD,	TAD	RF08X-1
	JMS I	RFIODI
RFREPT,	AC7775
	TAD	RF08X
	DCA	RF08X		/BACK UP SO WE CAN RE-GET THE ARGS
	JMP	RFRETR
RFOK,	DISK
RF08TL,	JMP	RFWAIT
	DCMA
	ISZ	CTCFG
	JMP I	RF08X
	JMP I	RF7600
RF70,	70
RF7600,	RF7600

	*600
	RK01=.
	NOPUNC
	*6400
	ENPUNC
	DLDC=6732
	DLWC=6753
	DLDR=6733
	DLCA=6755
	DSKD=6745
	DSKE=6747
	DKRE=7325
	DCLS=6742
	DRDS=6741
	DCLA=6751
	DRCA=6757
	DRDA=6734
	DRWC=6752
	NOPUNC
	*6400
	ENPUNC
	0		/PROTECTION FOR SBT
RK4,	4
RKOVER,	ISZ	CTCFG		/RE-ENABLE CTRL/C
	JMP I	RK8
	JMP I	RK7600		/CTRL/C TYPED WHILE INHIBITED - BOOTSTRAP
RKDLDR,	DLDR
RKCNT,	0
	4554		/"DK"
RK8,	0
	IFNZRO RK8&7 <ERROR - MUST START ON 10-WORD BOUNDARY>
	DCA	RKLOW		/SAVE LO-ORDER ADDR
	DCA	CTCFG		/INHIBIT CTRL/C
	AC7775
	DCA	RKCNT		/# OF TRIES ON ERROR
RK8RET,	TAD I	RK8
	AND	RK4
	SZA CLA			/DON'T ALLOW UNIT #S .GT. 3
	JMP	RKBAD
	TAD I	RK8
	AND	RK7
	TAD I	RK8
	AND	RK77		/UNIT #*2+FIELD
	DLDC
	TAD I	RK8
	RAL
	AND	RK7600
	SZA
	CIA
	DLWC			/LOAD WORD COUNT
	RTL
	TAD	RKDLDR
	DCA	RKINST		/READ (6733) OR WRITE (6735)
	ISZ	RK8
	CLA CMA
	TAD I	RK8
	DLCA			/LOAD CURRENT ADDRESS
	SZA CLA		/CHECK FOR NO DISK AT ALL
	JMP	RKBAD
	ISZ	RK8
	DCLS
	CLL
	DSKE			/CHECK FOR NON-EXISTENT DISK ERROR
	SKP
	JMP	RKBAD		/IT SURE IS
	TAD I	RK8
	TAD	RKLOW		/GET BLOCK ADDRESS
	TAD	RKLOW
	RTL
	RTL
	ISZ	RK8
RKINST,	6733			/GO!
RK01TL,	DSKD
	JMP	.-1		/& WAIT...
	DSKE
	JMP	RKOVER		/NO ERROR
	DRDS
	AND	RK4		/CHECK FOR TRACK OVERFLOW
	SZA CLA
	JMP	RKTKOV
	ISZ	RKCNT		/SOME OTHER ERROR - BADNESS
	JMP	RKNOER
RKBAD,	TAD	RK8-1
	JMS I	RKIODI		/TRIED 3 TIMES - GO AWAY
	AC7775
	DCA	RKCNT
RKNOER,	DRDS
	AND	RKP40		/TRACK SEEK ERROR?
	DCLS
	SNA CLA
	JMP	RKBACK
	DCLA			/YES - RECALIBRATE
	DSKD
	JMP	.-1
RKBACK,	AC7775
	TAD	RK8
	DCA	RK8
	JMP	RK8RET		/GO TRY AGAIN
RKTKOV,	DCLS
	DRDA
	AND	RK7760		/??
	TAD	RKP20		/BUMP TRACK NUMBER
	JMP	RKINST		/GO BACK & DO REST OF TRANSFER
RKLOW,	0
RK7,	7
RKP20,	20
RKP40,	40
RK77,	77
RK7600,	7600
RK7760,	7760
RKIODI,	IODIE

	$ - $ - $