Google
 

Trailing-Edge - PDP-10 Archives - BB-JR93L-BB_1990 - 10,7/feload/feload.p11
There are 5 other files named feload.p11 in the archive. Click here to see a list.
	.TITLE	FELOAD -- BOOT PROGRAM TO FIND & LOAD RSX20F V1(5) 30-Jan-89

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1989.  ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

;Original program supplied by Jeff Guenther, ADP Network Services,
;Ann Arbor, Michigan.

;Edit history
;
;Edit	Description
;----	-----------
;1	Modify sense of leftmost Switch-register bit
;	test so that '1' means load KLDCP and '0' means
;	load RSX-20F.  Add title, copyright statement.
;	28-Jan-88/JJF
;
;2	Change "Loading CORIMG.SYS" to "Loading RSX-20F".  Also change
;	all text messages to make them more meaningful; add prefix 
;	question-mark before all error messages to fit into TOPS standards.
;	05-Feb-88/JJF
;
;3	Extend table of .STDTB values to include the one for version
;	16-00 of RSX-20F.
;	10-Feb-88 /JJF
;
;4	Fix bug where the messages were too long and the code wouldn't
;	assemble because it was too big to fit in blocks 4 to 7.
;	12-May-88 /JJF
;
;5	Extend .STDTB table to include value for RSX-20F version 16-01.
;	30-Jan-89 /JJF
;
;[End of edit history]

;;	FELOAD is a small program used to load the "front end" program.
;;	Taking cues from the pdp11 switch register and the operator
;;	console teletype, it decides which front end system (ie: rsx20f
;;	or kldcp) to run, searches the appropriate front end directory
;;	and loads the correct boot for the system and starts it by
;;	branching to location 0.

	.ENABL	ABS,LC
	.ENABL	LC		;REALLY LOWER CASE


;;	If FELOAD is started at it's "starting address", rather than 0
;;	then it will load rsx20f unconditionally.  This is to support
;;	booting from KLDCP into RSX20F via the .P 20F or >. RSX commands.

;	First, the BM873YJ rom reads our block 0 code into physical core
;	block 0.  Then we read in blocks 4-7 into physical locations 4000-7777.
;	We always use 10000-10777 as impure data storage.
;	Then if we are booting rsx20f we move ourselves to 130000 and above.


NEWADR=	130000	;RELOCATION IF WE NEED TO LOAD 20F
KLDIR=	12000	;BUILD KLDCP DIRECTORY HERE UPWARDS
.SBTTL	UNIVERSALS -- F11HOM - Format of the FILES-11 home block, offsets as seen from 11

.MACRO	BSYM	.name,.value	;;MACRO TO DEFINE SYMBOLS
	W.'.name'=.offset	;;define name as current offset
	.offset=.offset+'.value'.;;redefine offset for next symbol
.ENDM	BSYM

.MACRO	F11HOM	;;ALL OFFSETS BELOW ARE GIVEN IN DECIMAL
	.offset=0	;;	START OFF AT 0
	BSYM	IBSZ,2	;;	OFFSET TO INDEX-BIT-MAP SIZE
			;;	# OF BLOCKS IN THE "SAT" PORTION ONLY
			;;	SO THE FILE INDEXF.SYS IS ALWAYS LARGER
			;;	SINCE IT INCLUDES THE FILE HEADERS ("RIB"S)
			;;	AS WELL AS THE SAT.
	BSYM	IBLB,4	;;	DISK ADDRESS (LBN) OF THE INDEX-BIT-MAP
	BSYM	FMAX,2	;;	# OF FILES ALLOWED
	BSYM	SBCL,2	;;	STORAGE-BIT-MAP CLUSTER SIZE
	BSYM	DVTY,2	;;	DISK-DEVICE TYPE
	BSYM	VLEV,2	;;	STRUCTURE LEVEL
	BSYM	VNAM,12	;;	12 ASCII CHARACTERS "VOLUME NAME"
	BSYM	RES1,4	;;	"RESERVED"
	BSYM	VOWN,2	;;	VOLUME OWNERS
	BSYM	VPRO,2	;;	VOLUME PROTECTION
	BSYM	VCHA,2	;;	VOLUME CHARACTERISTICS
	BSYM	DFPR,2	;;	DEFAULT PROTECTION
	BSYM	RES2,6	;;	"RESERVED"
	BSYM	WISZ,1	;;	DEFAULT NUMBER OF RETRIEVAL POINTERS IN A WINDOW
	BSYM	FIEX,1	;;	DEFAULT NUMBER OF BLOCKS TO EXTEND FILES
	BSYM	LRUC,1	;;	NUMBER OF ENTRIES IN DIRECTORY LRU
	BSYM	AVAL,11	;;	"AVAILABLE SPACE"
	BSYM	CHK1,2	;;	CHECKSUM OF WORDS 0-28.
	BSYM	VDAT,14	;;	CREATION DATE AND TIME
	BSYM	VHL,100	;;	VOLUME-HEADER LABEL
	BSYM	SYSI,82	;;	SYSTEM-SPECIFIC INFORMATION
	BSYM	RVOL,254;;	RELATIVE VOLUME TABLE
	BSYM	CHK2,2	;;	CHECKSUM OF HOME BLOCK WORDS 0 THRU 255
.ENDM	F11HOM
	F11HOM
.SBTTL UNIVERSALS -- T10HOM - Format of TOPS10 home block, as seen from 11 side

.MACRO	WSYM	.NAME,.VALUE
	'.NAME'='.VALUE'.
.ENDM	WSYM

.MACRO	T10HOM
;	This stuff defines the "PDP11 WORD NUMBER" of each thing
WSYM	HOMNA0,0	;;OFFSET CONTAINING SIXBIT .HOM. (TRUNCATED TO 16 BITS)
	SIXHOM=105755	;;TOPS10 SIXBIT "HOM" TRUNCATED TO 16 BITS
WSYM	HOMNA1,1	;;2ND HALF OF SIXBIT .HOM. (ALWAYS 0)

;;	HERE ARE THE KLDCP POINTERS
WSYM	HOMKV1,98	;;CONTAINS .RAD50 /KL / IF KLDCP VERSION 1
WSYM	HOMKV2,106	;;CONTAINS .RAD50 /KLA/ IF KLDCP VERSION 2
WSYM	HOMKV3,107	;;CONTAINS .RAD50 /D10/ IF KLDCP VERSION 2
WSYM	HOMKCY,108	;;CONTAINS CYLINDER OF KLADFE.SYS
WSYM	HOMKTS,109	;;CONTAINS TRACK/SECTOR OF KLADFE.SYS
WSYM	HOMKLN,110	;;CONTAINS LENGTH OF KLADFE.SYS

;;	HERE ARE THE FILES11 POINTERS
WSYM	HOMFEV,98	;;CONTAINS 100000 IF FILES11 VALID
	VALID=100000	;;BIT ON IF FILES11 VALID
WSYM	HOMFE0,99	;;CONTAINS LBN OF FILES11 FILE SYSTEM
WSYM	HOMFLN,101	;;LENGTH OF CONTIGUOUS FILES11 FILE SYSTEM
.ENDM	T10HOM

	T10HOM		;;FORCE DEFAULT DEFINITIONS

.SBTTL UNIVERSALS -- F11HED - format of FILES-11 file header block, as seen from 11

.MACRO	BSYM	.name,.value
	W.'.name'=.offset
	.offset=.offset+'.value'.
.ENDM	BSYM

.MACRO	F11HED
	.offset=0
	BSYM	IDOF,1	;;	OFFSET INTO THE ID AREA
	BSYM	MPOF,1	;;	OFFSET INTO THE MAP AREA (FROM THE ID AREA)
	BSYM	FNUM,2	;;	FILE NUMBER
	BSYM	FSEQ,2	;;	FILE SEQUENCE
	BSYM	FLEV,2	;;	STRUCTURE LEVEL AND SYSTEM NUMBER
	BSYM	PROG,1	;;	MEMBER NUMBER
	BSYM	PROJ,1	;;	GROUP NUMBER
	BSYM	FPRO,2	;;	FILE-PROTECTION CODE
	BSYM	UCHA,1	;;	USER CONTROLLER FILE CHARACTERISTICS
.ENDM	F11HED
	F11HED

.MACRO	F11FID	;; DEFINE ID AREA
	.offset=0	;; OFFSET FROM THE START OF THE ID AREA
	BSYM	FNAM,6	;; 6 BYTES OF RAD50, 3 CHARS PER 2 BYTES
	BSYM	FTYP,2	;; 2 BYTES OF FILE TYPE IN RAD50
	BSYM	FVER,2	;; FILE VERSION # IN BINARY
	BSYM	RVNO,2	;; REVISION # IN BINARY
	BSYM	RVDT,7	;; REVISION DATE IN ASCII ddmmmyy FORMAT
	BSYM	RVTI,6	;; REVISION TIME IN ASCII hhmmss FORMAT
	BSYM	CRDT,7	;; CREATION DATE IN ASCII ddmmmyy FORMAT
	BSYM	CRTI,6	;; CREATE TIME IN hhmmss FORMAT
	BSYM	EXDT,7	;; EXPIRE DATE IN ASCII ddmmmyy FORMAT
	.ENDM	F11FID
	F11FID		;;INCARNATE THE SYMBOLS

.MACRO	F11MAP		;; DEFINE THE MAPPING AREA TOO
	.offset=0
	BSYM	ESQN,1	;; EXTENSION SEGMENT NUMBER
	BSYM	ERVN,1	;; EXTENSION RELATIVE VOLUME NUMBER (NEVER USED)
	BSYM	EFNU,2	;; EXTENSION FILE NUMBER
	BSYM	EFSQ,2	;; EXTENSION SEQUENCE NUMBER
	BSYM	CTSZ,1	;; # OF BYTES IN A "BLOCK-COUNT FIELD" - ALWAYS 1
	BSYM	LBSZ,1	;; # BYTES IN "LOGICAL BLOCK NUMBER FIELD" - ALWAYS 3
	BSYM	USE,1	;; # RETRIEVAL POINTERS
	BSYM	MAX,1	;; MAX # RETRIEVAL SLOTS IN THIS MAP
	BSYM	RTRV,0	;; OFFSET TO RETRIEVAL POINTERS
.ENDM	F11MAP
	F11MAP		;;INCARNATE THE SYMBOLS

.SBTTL UNIVERSALS -- IOBITS - words and bits in the I/O page, seen from the 11

.MACRO	IOBITS
.SBTTL UNIVERSALS -- IOBITS - Basic CPU

V.CPU=	004	;CPU errors VECTOR
V.ILL=	010	;Illegal instruction VECTOR
V.RES=	010	;Reserved instruction VECTOR
V.BPT=	014	;BPT, breakpoint trap VECTOR
V.IOT=	020	;IOT, input/output trap VECTOR
V.PWF=	024	;Power Fail trap VECTOR
V.EMT=	030	;EMT, emulator trap VECTOR
V.TRP=	034	;TRAP instruction


PS=	177776	;Processor Status word (IE: PS)
R.SL=	177774	;Stack limit register

R.R7=	177707	;R7
R.PC=	R.R7	;Another name
R.R6=	177706	;R6
R.SP=	R.R6	;Another name

R.R5=	177705	;R5
R.R4=	177704	;R4
R.R3=	177703	;R3
R.R2=	177702	;R2
R.R1=	177701	;R1
R.R0=	177700	;R0

R.SWR=	177570	;Switch register
SWR=R.SWR	;Another name
R.DSP=	R.SWR	;Display register
.SBTTL UNIVERSALS -- IOBITS - DL11 console terminal

V.DLI=	060	;CONSOLE TERMINAL KEYBOARD VECTOR
V.DLO=	064	;CONSOLE TERMINAL PRINTER VECTOR

DL.RSR=	177560	;RECEIVER STATUS REGISTER
  DLDSCH=100000	;R/O DATASET STATUS CHANGE. REQUEST DATASET INTERRUPT.
  DLRNGI=40000	;R/O RING INDICATOR. IF RING COMES ON, SETS DLDSCH.
  DLCTS=20000	;R/O CLEAR TO SEND. IF CTS CHANGES, SETS DLDSCH
  DLCD=10000	;R/O CARRIER DETECT. IF CD CHANGES, SETS DLDSCH.
  DLRA=4000	;R/O RECEIVER ACTIVE. SET IF UART IS ASSEMBLING A CHARACTER.
  DLSRD=2000	;R/O SECONDARY RECEIVED DATA. IF SRD CHANGES, SETS DLDSCH.
  DLRD=200	;R/O RECEIVER DONE.  SET IF COMPLETE CHARACTER IS READY TO READ.
  DLRIE=100	;R/W RECEIVER INTERRUPT ENABLE.  DO INTERRUPT IF DLRD TURNS ON.
  DLDIE=40	;R/W DATASET INTERRUPT ENABLE. DO INTERRUPT IF DLDSCH TURNS ON
  DLSTD=10	;R/W SECONDARY TRANSMITTED DATA. IF SET, SIGNAL GOES ON.
  DLRTS=4	;R/W REQUEST TO SEND. IF SET, SIGNAL GOES ON.
  DLDTR=2	;R/W DATA TERMINAL READY.  IF SET, SIGNAL GOES ON.
  DLRDRE=1	;W/O READER ENABLE.  ADVANCE ASR PTR ONE FRAME IF AUTOMATIC.

DL.RBF=	177562	;RECEIVER BUFFER
  DLRERR=100000	;R/O RECEIVER ERROR.  LOGICAL OR OF (DLROVR,DLRFRM,DLRPAR)
  DLROVR=40000	;R/O RECEIVER OVERRUN.  THE OLD CHARACTER IS REPLACED WITH NEW.
  DLRFRM=20000	;R/O RECEIVER FRAMING ERROR.
  DLRPAR=10000	;R/O RECEIVER DATA PARITY ERROR.
  DLRDAT=377	;R/O RECEIVER DATA. THE CHARACTER READ.

DL.XSR=	177564	;XMITTER STATUS
  DLXRDY=200	;R/O TRANSMITTER READY. REQUESTS TRANSMITTER INTRP.
  DLXIE=100	;R/W TRANSMITTER INTERRUPT ENABLED. DO INTERRUPT IF DLXRDY SET.
  DLXMNT=4	;R/W TRANSMITTER MAINTENENCE.  CAUSES OUTPUT TO INPUT LOOP.
  DLXBRK=1	;R/W TRANSMITTER BREAK.  FORCE BREAK SIGNAL UNTIL CLEARED.

DL.XBF=	177566	;XMITTER BUFFER
  DLXDAT=377	;W/O TRANSMIT DATA. CHARACTER TO TYPE.
.SBTTL UNIVERSALS -- IOBITS - RH11/RP06 bit definitions


V.RH11=	254	;RH11 INTERRUPT VECTOR

RP.CS1=	176700	;;CONTROL AND STATUS REGISTER 1
  RPSC=100000	;;R/O SPECIAL CONDITION. LOGICAL OR OF "RPTRE","RPATTN","RPMCPE"
  RPTRE=40000	;;R/O TRANSFER ERROR.  LOR OF DLT,WCE,UPE,NED,NEM,PGE,
		;;MXF, MDPE, OR A DRIVE ERROR DURING DATA XFER.
  RPCPE=20000	;;R/O CONTROL BUS PARITY ERROR (DURING REMOTE REGISTER READ)
  RPDVA=4000	;;R/O DRIVE AVAILABLE. 1=NOT BUSY ON OTHER PORT.
  RPPSEL=2000	;;R/W PORT SELECT. 1=DO DATA TRANSFER VIA UNIBUS B.
  RPAD17=1000	;;R/W UNIBUS ADDRESS BIT 17.
  RPAD16=400	;;R/W UNIBUS ADDRESS BIT 16.
  RPRDY=200	;;R/O READY. 1=DATA TRANSFER IN PROGRESS. 0=DONE.
  RPIE=100	;;R/W INTERRUPT ENABLE. DO INTERUPT IF RPRDY OR RPATTN GET SET.
  RPFUNC=77	;;R/W FUNCTION AND GO BITS.
    RPOPNP=0	;  NO OPERATION
    RPOPUL=2	;  UNLOAD/STANDBY
    RPOPRC=6	;  RECALIBRATE
    RPOPDC=10	;  DRIVE CLEAR
    RPOPRP=12	;  RELEASE PORT
    RPOPSR=30	;  SEARCH COMMAND
    RPOPWC=50	;  WRITE CHECK DATA
    RPOPWH=52	;  WRITE CHECK HEADER & DATA
    RPOPWD=60	;  WRITE DATA
    RPOPWF=62	;  WRITE FORMAT (HEADER & DATA)
    RPOPRD=70	;  READ DATA
    RPOPRF=72	;  READ FORMAT (HEADER & DATA)
    RPOPSK=4	;  SEEK
    RPOPOF=14	;  OFFSET
    RPOPCL=16	;  (RETURN TO) CENTERLINE
    RPOPPA=22	;  PACK ACKNOWLEDGE
    RPOPRI=20	;  READ-IN PRESET
      RPGO=1	;;R/W GO. REQUEST DRIVE TO DO FUNCTION. CLEARED WHEN DONE.

RP.WC=	176702	;;R/W WORD COUNT REGISTER. 2s COMPLEMENT WORD COUNT FOR XFER.

RP.BA=	176704	;;R/W UNIBUS ADDRESS REGISTER. LOW 15 BITS OF XFER ADDRESS.

RP.DA=	176706	;;DESIRED SECTOR/TRACK ADDRESS REGISTER
  RPTRKA=017400	;;R/W TRACK ADDRESS - HIGH BYTE OF WORD IS TRACK ADDRESS
  RPSCTA=37	;;R/W SECTOR ADDRESS - LOW BYTE OF WORD IS SECTOR ADDRESS

RP.CS2=	176710	;;CONTROL AND STATUS 2 REGISTER
  RPDLT=100000	;;R/O DATA LATE. CAUSES RPTRE TO GET SET.
  RPWCE=40000	;;R/O WRITE CHECK ERROR. MISMATCH DURING WRITE. SETS RPTRE.

RP.DS=	176712	;;DRIVE STATUS REGISTER
  RPATA=100000	;;R/O ATTENTION.
  RPERR=40000	;;R/O SET IF RP.ER1,RP.ER2,RP.ER3 GET SET. ONLY RPOPDC CAN CLR.

RP.ER1=	176714	;;ERROR REGISTER 01
  RPDCK=100000	;;R/W DATA CHECK (IE: CORRECTABLE)
  RPUNS=40000	;;R/W UNSAVE (LOGICAL OR OF ALL UNSAFE BITS IN RPER2&RPER3)
  RPOPI=20000	;;R/W OPERATION INCOMPLETE
  RPDTE=10000	;;R/W DRIVE TIMING ERROR
  RPWLE=4000	;;R/W WRITE LOCK ERROR
  RPIAE=2000	;;R/W INVALID ADDRESS ERROR (DISK ADDRESS, NOT CORE ADDRESS)
  RPAOE=1000	;;R/W ADDRESS OVERFLOW ERROR (CYLINDER REGISTER OVERFLOWED)
  RPHCRF=400	;;R/W HEADER CRC ERROR
  RPHCE=200	;;R/W HEADER COMPARE ERROR
  RPECH=100	;;R/W ECC HARD ERROR
  RPWCF=40	;;R/W WRITE CLOCK FAIL
  RPFER=20	;;R/W FORMAT ERROR (OFFSET FMT DOESN'T MATCH DATA ON DISK)
  RPPAR=10	;;R/W PARITY ERROR
  RPRMR=4	;;R/W REGISTER MODIFICATION REFUSED
  RPILR=2	;;R/W ILLEGAL REGISTER
  RPILF=1	;;R/W ILLEGAL FUNCTION CODE

RP.OF=	176732	;;OFFSET REGISTER
  RPSCG=100000	;;R/W SIGN CHANGE (FLIPS IF HEAD IS OVER TRUE TRACK'S CENTERLINE
  RPFMT2=10000	;;R/W 1 WHEN 16BIT/WORD FORMAT, 0 WHEN 18BIT/WORD FORMAT
  RPECI=4000	;;R/W 1 TO DISABLE ECC ERROR CORRECTION
  RPHCI=2000	;;R/W 1 TO DISABLE "HEADER COMPARE"
  RPOFSD=377	;;R/W OFFSET INFORMATION

RP.DC=	176734	;;DESIRED CYLINDER
  RPCYLA=777	;;R/W CYLINDER ADDRESS.

RP.EC1=	176744	;;ECC POSITION
		;;R/O

RP.EC2=	176746	;;ECC PATTERN
		;;R/O
.ENDM	IOBITS
	IOBITS
.SBTTL UNIVERSALS -- KLDHED - Format of entry in KLDCP directory

.MACRO	WSYM	.NAME
	W.'.NAME'=.OFFSET
	.OFFSET=.OFFSET+2
.ENDM	WSYM
.OFFSET=0

.MACRO	KLDHED
WSYM	KFL0	;FIRST HALF OF KLDCP FILE NAME
WSYM	KFL1	;SECOND HALF OF KLDCP FILE NAME
WSYM	KEXT	;EXT OF KLDCP FILE NAME
WSYM	KCRE	;CREATION DATA
WSYM	KCYL	;CYLINDER OF FILE
WSYM	KTS	;TRACK/SECTOR
WSYM	KWAH	;WORDS ALLOCATED (HIGH)
WSYM	KWAL	;WORDS ALLOCATED (LOW)
WSYM	K1LA	;PDP11 LOAD ADDDRESS
WSYM	K1SA	;PDP11 START ADDRESS
WSYM	KTYP	;FILE TYPE & FILE STATUS
WSYM	KCHK	;CHECK SUM
WSYM	KRS1	;RESERVED (0)
WSYM	KRS2	;RESERVED (0)
WSYM	KCPH	;CURRENT POSITION (HIGH)
WSYM	KCPL	;CURRENT POSITION (LOW)
FDESIZ=.OFFSET	;SIZE OF AN ENTRY
.ENDM	KLDHED
	KLDHED
	.SBTTL	DEFINITIONS - "helper" macros

.MACRO	TYPE	.string	;;MACRO TO TYPE A STRING ON THE CONSOLE
	.ENABL	LC
	CALL	STYPE
	.ASCIZ	@'.string'@<15><12>
	.EVEN
.ENDM	TYPE

.MACRO	ABORT	.string	;;MACRO TO TYPE A STRING AND THEN HALT
	TYPE	<'.string'>
	HALT
.ENDM	ABORT

.MACRO	CALL	.dest
	JSR	PC,.dest
.ENDM	CALL

.MACRO	RETURN
	RTS	PC
.ENDM	RETURN
	.SBTTL	BLOCK 0 booting code
	.=0			;LOAD INTO LOCATION 0

;	THIS CODES RESIDES IN PHYSICAL DISK BLOCK 0; THE ROM LOADS IT
FELOAD:	MOV	R0,INITR0
	MOV	#INITR1,R0
	MOV	R1,(R0)+			;SAVE R1
	MOV	R2,(R0)+			;SAVE R2
	MOV	R3,(R0)+			;SAVE R3
	MOV	R4,(R0)+			;SAVE R4
	MOV	R5,(R0)+			;SAVE R5
;	MOV	SP,(R0)+			;SAVE SP
	MOV	R1,R5				;PRESERVE CSR ADDRESS IN R5
	MOV	RP.CS2-RP.CS1(R5),RPUNIT	;SAVE UNIT NUMBER

;	NOW READ IN 2ND PART OF BOOT
	MOV	#PROMPT,R0		;UNIBUS ADDRESS OF 2ND PART
	CLR	R1			;HIGH ORDER LBN=0
	MOV	#4,R2			;LOW ORDER LBN=4
	MOV	R2,R3			;REQUEST 4 BLOCK READ
	MOV	#STAK,SP		;INIT THE STACK POINTER
	CALL	REDBLK			;READ THAT BLOCK FROM RP04
	BCS	2$			;BRANCH IF CAN'T READ 2ND PART
1$:	JMP	PROMPT		;JOIN "2nD PART CODE"

2$:	ABORT	<?Can't get FELOAD part 2>
;	ROUTINE TO TYPE A CHARACTER ON THE CONSOLE TERMINAL
TYO:	MOV	R0,@#DL.XBF		;TYPE THE CHARACTER
TYO1:	TSTB	@#DL.XSR			;WAIT FOR "DONE" TO APPEAR
	BGE	TYO1			;LOOP UNTIL IT TURNS ON
	RTS	PC

;	ROUTINE TO TYPE A STRING
STYPE:	MOV	(SP)+,R1		;PICK UP ADDRESS OF STRING
STYPE1:	MOVB	(R1)+,R0		;PICK UP A BYTE
	BEQ	STYPE2			;EXIT IF WE PICK UP A ZERO
	CALL	TYO			;OTHERWISE TYPE IT
	BR	STYPE1			;LOOP TILL WE FIND THE 0
STYPE2:	INC	R1			;ADVANCE ONE BYTE
	BIC	#1,R1			;TURN OFF ODD BIT
	JMP	@R1			;RETURN TO CALLER
;	ROUTINE TO ROTATE THE 3 WORDS @R1 (R3) BITS LEFT
;	(USED TO DO ECC CORRECTION)
PROL36:	ASL	(R1)
	ROL	2(R1)
	ROL	4(R1)
	DEC	R3
	BNE	PROL36
	RETURN
;	ROUTINE TO READ RP04/RP05/RP06 DISK BLOCKS
;ENTER:
;	R0/	UNIBUS AADRESS OF 1ST WORD TO XFER
;	R1/	HIGH ORDER WORD OF LBN
;	R2/	LOW ORDER WORD OF LBN
;	R3/	# OF BLOCKS TO READ CONTIGUOUSLY, 0 MEANS 1
;	R5/	ADDRESS OF RPCS1

REDBLK:	MOV	R0,SAVUBA	;SAVE UNIBUS ADDRESS
	MOV	R3,SAVCNT	;SAVE COUNT OF BLOCKS
REDBL0:	MOV	R1,SAVHLB	;SAVE HIGH LBN
	MOV	R2,SAVLLB	;SAVE LOW LBN

;	HERE TO READ A BLOCK
	MOV	#16.,R4		;TRY UP TO 16 TIMES
REDBL1:	MOV	RPUNIT,RP.CS2-RP.CS1(R5)	;SETUP UNIT FIELD
	MOV	SAVUBA,RP.BA-RP.CS1(R5)	;SET THE UNIBUS ADDRESS
	MOV	#-400,RP.WC-RP.CS1(R5)	;SET THE WORD COUNT FOR 1 BLOCK
	CLR	R3			;START OFF WITH 0 ANSWER
1$:	INC	R3			;COUNT A SUBTRACTION
	SUB	#380.,R2		;USE A SUBTRACT LOOP ...
	SBC	R1			;...TO CALCULATE "LBN / BPC"
	BPL	1$			;...TO GET DESIRED CYLINDER ADDRESS
	DEC	R3			;FORGET THE LAST SUBTRACTION
	ADD	#380.,R2		;PUT BACK THE LAST CYLINDER'S BLOCKS
	ADC	R1			;...
; NOW R3=DESIRED CYLINDER ADDRESS
	MOV	R3,RP.DC-RP.CS1(R5)	;SPECIFY THE DESIRED CYLINDER

	CLR	R3			;CLEAR RESULT
2$:	INC	R3			;COUNT FIRST ONE
	SUB	#20.,R2
	SBC	R1			;TAKE CARE OF CARRY (IF ANY)
	BPL	2$			;LOOP UNTIL WE GO TOO FAR
	ADD	#20.,R2			;RETURN IT
	ADC	R1			;FIX FINAL CARRY
	DEC	R3			;ONE LESS THAN WE THOUGHT

	SWAB	R3			;TRACK IN LH
	BIS	R3,R2			;INSERT SECTOR
	MOV	R2,RP.DA-RP.CS1(R5)	;TELL DRIVE TRACK/SECTOR

	CLR	RP.OF-RP.CS1(R5)	;CLEAR OFFSET
	CMP	R4,#8.		;2ND 8 TRIES?
	BGT	3$			;NO
	MOV	#RPHCI,RP.OF-RP.CS1(R5)	;YES, TRY TURNING ON HEADER INHIBIT
3$:	MOV	#71,RP.CS1-RP.CS1(R5)	;TELL KONTROLLER TO DO THE READ
	CLR	R0			;CLEAR TIMEOUT COUNT
4$:	INC	R0			;COUNT UP TIMER
	BEQ	5$			;BRANCH IF XFER TIMED OUT
	BIT	#RPTRE!RPCPE!RPRDY,RP.CS1-RP.CS1(R5)	;TEST FOR DONE
	BEQ	4$			;LOOP TILL ONE COMES ON

5$:	DEC	R4			;CHECK RETRY COUNT
	BMI	GIVEUP			;GIVE UP IF NO MORE POSSIBLE
	TST	R0			;TEST TIMEOUT COUNT
	BEQ	RETRY			;IT TIMED OUT, TRY IT ALL OVER AGAIN
	BIT	#RPCPE!RPTRE,RP.CS1-RP.CS1(R5);CHECK CONTROL BUS PARITY ERROR
	BNE	RETRY			;RETRY ENTIRE OPERATION
	BIT	#RPATA!RPERR,RP.DS-RP.CS1(R5)	;CHECK DISK ERRORS
	BNE	TRYECC			;GO CONSIDER CORRECTABLE ERROR

;IF WE GET HERE, THE XFER WAS APPARENTLY ERROR-FREE
REDAOK:	MOV	SAVLLB,R2		;RESTORE LOW LBN
	MOV	SAVHLB,R1		;RESTORE HIGH LBN
	INC	R2			;ADD 1 TO LBN
	ADC	R1			;ADD POSSIBLE CARRY
	ADD	#1000,SAVUBA		;STEP TO NEXT BLOCK ADDRESS
	DEC	SAVCNT
	BGT	REDBL0			;READ ANOTHER
;	ADD TO SAVUBA WILL NEVER "OVERFLOW" 16 BIT ADDRESS
;	CLC				;CLEAR ERROR
	RETURN

;HERE TO RETRY THE XFER
RETRY:	MOV	SAVHLB,R1		;RESTORE THE LBN TO XFER
	MOV	SAVLLB,R2		;...
	BR	REDBL1			;GO DO THE OPERATION AGAIN
;WE DID OUR BEST, GIVE UP
GIVEUP:	SEC
	RETURN

;HERE IF READ FAILED, TRY AGAIN
TRYECC:	BIT	#77777,RP.ER1-RP.CS1(R5)	;CHECK FOR ANY ERROR, 'CEPT ECC DATA
	BNE	RETRY			;IF NOT ECC ERR, TRY VIA HARD RE-READ
	MOV	RP.EC1-RP.CS1(R5),R2	;GET ECC POSITION
	BEQ	RETRY			;GIVE UP IF POS=0

	CLR	ECWRD0
	CLR	ECWRD0+2
	CLR	ECWRD0+4
	CLR	ECWRD0+6
	CLR	ECWRD0+10
	CLR	ECWRD0+12

	MOV	RP.EC2-RP.CS1(R5),ECMSK0;GET ECC CORRECTION

	DEC	R2			;DIVIDE POSITION BY 18.
	CLR	R3
61$:	SUB	#18.,R2			;
	BLT	62$			;
	INC	R3			;
	BR	61$			;

62$:	ADD	#18.,R2			;DONE, R3=WORD, R2=SHIFTS
	ASL	R3			;DOUBLE WORD POSITION, 11 ADR IN BYTES
	ADD	SAVUBA,R3
	MOV	R3,ECADR0		;SETUP 1ST BAD WORD ADDRESS

	TST	(R3)+
	MOV	R3,ECADR1		;SETUP 2ND BAD WORD ADDRESS
;	MOV	#ECWRD0,R1
	MOV	(R3),ECWRD0		;SETUP 2ND BAD WORD
	MOV	(R3),ECBAD1		;SAVE 2ND BAD WORD
	CALL	PROL36			;POSITION 2ND WORD INTO UPPER 18 BITS

	MOV	@ECADR0,ECWRD0		;SETUP 1ST BAD WORD
	MOV	ECWRD0,ECBAD0		;SAVE 1ST BAD WORD

;	MOV	#ECMSK0,R1
	MOV	R2,R3
	CALL	PROL36			;POSITION ECC CORRECTION WORD

	MOV	ECMSK0,-(SP)		;CORRECT BITS 0-16
	BIC	ECWRD0,(SP)		;
	BIC	ECMSK0,ECWRD0
	BIS	(SP)+,ECWRD0

	MOV	ECMSK0+2,-(SP)		;CORRECT BITS 17-32
	BIC	ECWRD1,(SP)		;
	BIC	ECMSK0+2,ECWRD1
	BIS	(SP)+,ECWRD1

	MOV	ECMSK0+4,-1(SP)		;CORRECT BITS 33-36
	BIC	ECWRD2,(SP)
	BIC	ECMSK0+4,ECWRD2
	BIS	(SP)+,ECWRD2

;	MOV	#ECWRD0,R1
	MOV	ECWRD0,@ECADR0		;PUT 1ST CORRECT WORD BACK IN CORE

	MOV	#14.,R3
	CALL	PROL36
	MOV	ECWRD2,@ECADR1		;PUT 2ND WORD BACK IN CORE
	BR	REDAOK			;NOW GO TO NEXT BLOCK
	.SBTTL	END OF BLOCK 0 CODE

	.DEPHASE
	.=.
B0WRDS=./2		;# OF WORDS USED IN BLOCK 0 (NOT BYTES)
	.PRINT	1000-.;LOCATIONS LEFT IN BLOCK 0 BOOT
	.SBTTL	START OF BLOCK 4-7 CODE

	.=4000				;THIS GOES INTO BLOCK 4 (THRU 7)

PROMPT:	BIT	#1,INITR5		;READ "SWR" BUTTON PUSHED?
	BNE	SWRFOO			;YES, GO DO THAT

	TSTB	INITR5			;TEST THE "DISK" BIT
	BMI	DISK			;BRANCH IF DISK SET
;N.B.: HE PUSHED DTA/FLOPPY BUTTON - AND WE COULDN'T HAVE GOTTEN HERE!
	ABORT	<?FELOAD cannot boot DECtape or floppy>

SWRFOO:
DISK:	BIT	#100000,@#SWR		;IS THE HIGH ORDER BIT SET?
	BNE	GETKLD			;YES, GET KLDCP
	BR	GETRSX			;NO, GET RSX20F
	.SBTTl	BOOT IN AND START 20F FRONT END

USERSX:	MOV	#100207,INITR5
	MOV	#176700,INITR1
	MOV	#176700,R5
	MOV	#STAK,SP
GETRSX:	CALL	MOVEME			;GO TO NEW HOME
	CALL	GETHOM			;GET THE TOPS10 HOME BLOCKS
	CALL	GETH11			;GET THE FILES11 HOME BLOCK
	CALL	FND550			;GO FIND FHB FOR 5,5,0 (CORIMG.SYS)
	CALL	RED550			;GO READ IN CORIMG.SYS INTO CORE
	CALL	FNDACP			;GO FIND F11ACP.TSK
	CALL	POK20F			;GO POKE SOME MAGIC VALUES INTO
					;THE RESIDENT IMAGE OF THE 20F MONITOR
	JMP	RESACS			;RESTORE ACS AND START RSX20F
;	HERE TO LOAD AND START KLDCP FRONT END
GETKLD:	CALL	GETHOM		;GET TOPS10 HOME BLOCK(S)
	CALL	VRFKLD		;VERIFY THIS IS A KLAD PACK
	CALL	FNDDIR		;FIND THE DIRECTORY LOCATION AND SIZE
	CALL	REDDIR		;GO READ KLAD10 DIRECTORY
	CALL	FNDKLD		;GO FIND KLDCP.BIN IN THE DIRECTORY
	CALL	LODKLD		;GO LOAD KLDCP.BIN

	JMP	RESACS		;GO START KLDCP
GETHOM:	MOV	#1,R2
	CALL	GETH10
	BCS	2$
1$:	RETURN

2$:	MOV	#12,R2
	CALL	GETH10
	BCC	1$
	ABORT	<?Unable to read HOME.SYS>

;	ROUTINE TO READ A TOPS-10 HOME BLOCK

GETH10:	MOV	DBA,R0			;ADDRESS OF DISK BUFFER
	CLR	R1			;HIGH ORDER LBN OF HOME BLOCKS ALWAYS 0
	CLR	R3			;ALWAYS JUST ONE BLOCK TO READ
	CALL	REDBLK			;READ THE HOME BLOCK
	BCC	2$			;BRANCH IF NO ERRORS
1$:	SEC				;SET CARRY SO CALLER SEES ERROR
	RTS	PC			;RETURN WITH CARRY SET

;HERE IF READ OF BLOCK SUCCEEDED
2$:	CMP	#105755,DB		;MAKE SURE LH OF PDP10 WORD #0='HOM'
	BNE	1$			;GIVE ERROR RETURN IF NOT
	TST	DB+2			;MAKE SURE RH OF PDP10 WORD#0 IS ZERO
	BNE	1$			;GIVE ERROR RETURN IF NOT

	CLC				;CLEAR CARRY
	RTS	PC			;GIVE GOOD RETURN
;	ROUTINE TO READ IN THE FILES11 HOME BLOCK
;	ENTER WITH GOOD TOPS10 HOME BLOCK IN DB
GETH11:	MOV	DB+<HOMFE0*2>-2,R1	;GET "HIGH" LBN OF HOME BLOCK
	BMI	1$			;BRANCH IFF VALID BIT IS SET
	ABORT	<?VALID bit not set in TOPS-10 home block>

;	HERE IF TOPS10 HOME BLOCK SAYS WE HAVE AN RSX20F FILE AREA
;	READ IN THE FILES11 HOME BLOCK
1$:	MOVB	R1,R1			;ISOLATE LOWBYTE (OF HIGH WORD)
	MOV	DB+<HOMFE0*2>,R2	;GET LOW WORD OF HOME BLOCK LBN
	CLRB	R2			;CLEAR LOW BYTE
	ADD	#400,R2			;STEP TO MULTIPLE OF 400 SECTORS
	CLR	R3			;SETUP TO READ 0 BLOCKS (=1 BLOCK)
	MOV	DBA,R0			;SETUP TO READ INTO DISK BUFFER

	CALL	REDBLK			;READ WHAT OUGHT TO BE FILE11 HOME BLOCK
	BCC	2$			;
	ABORT	<?Unable to read FILES-11 home block>
2$:	RETURN
;	ROUTINE TO "FIND" THE FHB FOR CORIMG.SYS.
;	CORIMG.SYS IS "KNOWN" FILE 5,5,0 SO LOOKUP THE QUICK WAY.
;	ENTER WITH GOOD FILES11 HOME BLOCK IN DB
FND550:	MOV	DB+W.IBLB,R1		;GET HIGH ORDER INDEX BIT MAP LBN
	MOV	DB+W.IBLB+2,R2		;GET LOW ORDER LBN
	ADD	DB+W.IBSZ,R2		;ADD SIZE OF BIT MAP TO GET LBN OF 1,1,0
	ADC	R1			;ADD THE OVERFLOW OF THE LOW ORDER ADD
	ADD	#5-1,R2			;COMPUTE ADDRESS OF (5,5,0)
	ADC	R1			;...
	MOV	R1,SAVR1		;SAVE R1 OF FHB FOR CORIMG
	MOV	R2,SAVR2		;SAVE R2 OF FHB FOR CORIMG
	CLR	R3			;SPECIFY 0 BLOCKS (=1 BLOCK)
	MOV	DBA,R0			;READ INTO DISK BUFFER
	CALL	REDBLK			;READ WHAT OUGHT TO BE THE RIB OF
					;(5,5,0), IE: CORIMG.SYS
	BCC	3$
	ABORT	<?Can't read FHB of CORIMG.SYS to load RSX-20F>

;	HERE WHEN WE HAVE (APPARENTLY) READ IN THE FHB FOR CORIMG.SYS.
;	DO SOME (CASUAL) VERIFICATION THAT IT REALLY...
;	...IS A GOOD FHB FOR CORIMG.SYS(5,5,0).
3$:	MOV	DB+W.FNUM,R1		;GET FILE NUMBER
	MOV	DB+W.FSEQ,R2		;GET FILE SEQUENCE NUMBER
	CMP	R1,R2			;THE SAME?
	BEQ	5$			;BRANCH AHEAD IF FILSEQ=FILNUM
	ABORT	<?Sequence # of CORIMG.SYS not equal to file #>

5$:	CMP	R1,#5			;SHOULD BE FILE (5,5,0)
	BEQ	6$			;
	ABORT	<?File ID for CORIMG.SYS is not (5,5,0)>

6$:	RETURN
;	ROUTINE TO READ CORIMG.SYS INTO CORE IN THE PROPER PLACE (0-127777)
;	ENTER WITH GOOD FHB FOR CORIMG.SYS IN DB
RED550:	TYPE	<[Loading RSX-20F]>
	MOVB	DB+W.MPOF,R2		;GET OFFSET OF ID AREA
	ADD	R2,R2			;COMPUTE SIZE IN BYTES
	ADD	DBA,R2			;COMPUTE R2= ADDRESS OF MAP AREA
	MOVB	W.RTRV(R2),R1		;GET HIGH LBN BYTE
	MOV	W.RTRV+2(R2),R2		;GET LOW LBN WORD
	CLR	R0			;READ INTO LOCATION 0
	MOV	#130,R3			;READ 130 BLOCKS (IE: ALL OF CORIMG.SYS)
	CALL	REDBLK			;READ A BLOCK (IE: BLOCK 0 OF CORIMG.SYS)
	BCC	1$
	  ABORT	<Error reading CORIMG.SYS -- RSX-20F load aborted>
1$:	RETURN
;	ROUTINE TO FIND THE LOWEST FILE#'D FILE WITH NAME OF F11ACP.TSK
;	WE'LL USE THIS FILE'S LBN ADDRESS TO TELL THE INCORE RSX20F WHERE
;	IT'S PRINCIPLE ACP FOR THE BOOT DEVICE IS
;	ENTER WITH SAVR1/SAVR2 BEING THE LBN OF FHB FOR CORIMG.SYS
FHBMAX:	60.				;READ NO MORE THAN 60 FHBS
F11ACP:	.RAD50	/F11ACP   TSK/

FNDACP:	DEC	FHBMAX			;BUMP COUNT DOWN
	BMI	1$			;BRANCH IF WE'RE NEVER FOUND IT
	INC	SAVR2			;STEP TO NEXT BLOCK
	TST	SAVR2			;DID IT JUST OVERFLOW?
	BNE	2$			;NO, SKIP UPDATE
	INC	SAVR1			;
2$:	MOV	DBA,R0			;READ NEXT FHB INTO DB
	MOV	SAVR1,R1		;GET FHB LBN ADR
	MOV	SAVR2,R2		;...
	CLR	R3			;1 BLOCK ONLY
	CALL	REDBLK			;READ IN AN FHB
	BCS	FNDACP			;GO ON TO NEXT FHB IF WE CAN'T READ THIS
	MOVB	DB+W.IDOF,R2		;GET OFFSET TO ID AREA IN WORDS
	ADD	R2,R2			;COMPUTE OFFSET IN WORDS
	ADD	DBA,R2			;LOAD R2=ADDRESS OF ID AREA
	CMP	W.FNAM(R2),F11ACP	;DOES THIS LOOK AS IF IT IS F11ACP?
	BNE	FNDACP			;GO TO NEXT FHB IF FILE DOESN'T MATCH
	CMP	W.FNAM+2(R2),F11ACP+2	;...?
	BNE	FNDACP			;GO TO NEXT FHB IF FILE DOESN'T MATCH
	TST	W.FNAM+4(R2)		;...
	BNE	FNDACP			;GO TO NEXT FHB IF FILE DOESN'T MATCH
	CMP	W.FTYP(R2),F11ACP+6.	;CHECK FOR .TSK EXTENSION
	BNE	FNDACP			;GO TO NEXT FHB IF TYPE DOESN'T MATCH
	MOV	W.FVER(R2),LEVELV	;STORE THE VERSION OF THE ACP
	RETURN

1$:	SEC
	RETURN
;	ROUTINE TO POKE MAGIC VALUES INTO THE 20F CORE IMAGE
;	  TO COMPENSATE FOR THE FACT WE DIDN'T BOOT THIS VIA "SAVE"S RPBOOT.
;	ENTER WITH GOOD FHB FOR F11ACP IN DB.

;*** THE CONSTANTS DEFINED HERE NEED TO BE REDEFINED AS NEEDED
S.DL=32	;; THIS OFFSET IS START OF 2 WORD ENTRY CONTAINING DISK ADDRESS
	;; OF THE LOAD IMAGE FOR THIS TASK. OFFSET INTO STD BLOCK.
RPBOOT=7664	;; ADDRESS OF RPBOOT, TAKE FROM LISTING OF SAV TASK
RPRESU==7772	;; ADDRESS OF LINE SAYING "BOOTSTRAP COMPLETE", FROM SAV LISTING
;*** THE CONSTANTS ABOVE MAY NEED TO BE UPDATED, BUT NOTE THAT
;*** THIS IS NOT COMMON SINCE S.DL MAY NEVER CHANGE AND RPRESU-RPBOOT
;*** WILL PROBABLY REMAIN A CONSTANT EVEN IF RPRESU OR RPBOOT CHANGES
POK20F:	MOVB	DB+W.MPOF,R2		;GET OFFSET TO MAP AREA
	ADD	R2,R2			;CONVERT TO BYTE OFFSET
	ADD	DBA,R2			;ADD NEW BUFFER ADR
	MOVB	W.RTRV(R2),R1		;GET HIGH LBN BYTE OF F11ACP.TSK
	MOV	W.RTRV+2(R2),R2	;GET LOW LBN WORD OF F11ACP.TSK
	ADD	#2,R2			;ADD 2 TO GET AT SKIP TASK HEADER INFO
	ADC	R1			;...
	CALL	GETSTD		;FIND VALUE OF .STDTB BASED ON 20F VERSION
	TST	R0		;CHECK TO MAKE SURE WE GOT IT
	BEQ	1$
	ADD	#<4*2>,R0	;COMPUTE ADDRESS OF F11ACP ENTRY
	MOV	@R0,R0		;LOAD R0 WITH STD FOR F11ACP
	BEQ	1$		;BRANCH IF WE FAILED
	MOV	R1,S.DL+0(R0)	;INSERT HIGH ORDER LBN INTO STD BLOCK
	MOV	R2,S.DL+2(R0)	;INSERT LOW ORDER LBN INTO STD BLOCK

	MOV	#<RPRESU-RPBOOT>,NEWPC	;NEW PC INSIDE "RPBOOT" IN THE SAV TASK

;	Force RSX20F to believe that we used "SW/REG" rather than "DISK"
;	even if we didn't!
;[JJF %1(4) Maybe we really don't want it to believe it!]
;	BIS	#200!1,INITR5		;TURN ON "DISK=200" AND "SW=1"
	JMP	RESACS			;RESTORE ACS AND START BOOT

1$:	ABORT	<?STD address of F11ACP within CORIMG.SYS incorrect>
;	ROUTINE TO SEARCH TABLES TO FIND THE VALUE OF .STDTB
;	RETURN CURRENT 20F'S VALUE OF .STDTB IN R0

GETSTD:	MOV	#VERTAB+NEWADR,R0	;LOAD ADDRESS OF TABLE
1$:	TST	@R0			;CHECK FOR END OF TABLE
	BEQ	2$			;BRANCH IF END OF TABLE
	CMP	(R0)+,LEVELV		;COMPARE WITH 20F VERSION
	BEQ	GOTSTD			;BRANCH IF WE FIND SAME VERSION#
	BR	1$
2$:	ABORT	<?Unable to determine F11ACP.TSK file version>
GOTSTD:	MOV	VALTAB-VERTAB-2(R0),R0	;LOAD STD ADDRESS
	RETURN


;*** NOTE THAT NEWER VERSIONS OF 20F WILL NEED TO HAVE ENTRIES IN THE DTBX MACRO
;*** SIMPLY LOOK AT THE NEW RSX20F MAP FOR THE VALUE OF .STDTB.
	.MACRO	DTBX	;;LIST OF .STDTB VALUES
XP	1506,6350	;VERSION 1506
XP	1550,6372	;VERSION 1550
XP	1600,6372	;VERSION 1600
XP	1601,6372	;VERSION 1601
	.ENDM
;	MACROS TO EXPAND THE VERSION NUMBER INFO FOR 20F
.MACRO XP	a,b
.WORD	a
.ENDM
VERTAB:	DTBX
	0

.MACRO XP	a,b
.WORD	b
.ENDM
VALTAB:	DTBX
;	ROUTINE TO MOVE THE INCORE IMAGE 0-7777 TO NEWHOM-<NEWHOM+7777>

MOVEME:	MOV	#DB+NEWADR,DBA		;SETUP NEW DB ADDR
	MOV	#NEWADR,R0		;SETUP DESTINATION
	CLR	R1			;SETUP ORIGIN
	MOV	#ENDING/2,R2		;SETUP # WORDS TO MOVE
1$:	MOV	(R1)+,(R0)+		;MOVE A WORD TO NEW HOME
	SOB	R2,1$			;KEEP DOING IT

	ADD	#NEWADR,SP		;RELOCATE THE STACK
	ADD	#NEWADR,(SP)		;ADJUST RETURN ADDRESS
	RTS	PC			;RETURN TO SAME PLACE IN NEW HOME
;	ROUTINE TO VERIFY THAT THIS IS A GOOD KLAD10 PACK
;	ENTER WITH TOPS10 HOME BLOCK IN DB.
VRFKLD:	CMP	DB+<HOMKV2*2>,#043241	;CHECK FOR "KLAD10" IN RAD50
	BNE	1$		;BRANCH IF NOT THERE
	CMP	DB+<HOMKV3*2>,#016766	;CHECK 2ND HALF
	BEQ	2$		;BRANCH IF "KLAD10" THERE
1$:	ABORT	<?RAD50 "KLAD10" missing>

2$:	RTS	PC			;RETURN
;	ROUTINE TO LOCATE THE SIZE AND POSITION OF THE KLDCP DIRECTORY.
;	ENTER WITH GOOD TOPS10 HOME BLOCK IN DB.
FNDDIR:	CLR	LBNL		;CLEAR BLOCK NUMBER SUM
	CLR	LBNH		;CLEAR BLOCK NUMBER SUM HIGH ORDER
	MOV	#19.*20.,R1	;GET MULTIPLIER

3$:	ADD	DB+<HOMKCY*2>,LBNL
	ADC	LBNH		;ADD IN CARRY
	SOB	R1,3$		;LOOP

	MOV	#20.,R1		;GET MULTIPLIER
	MOVB	DB+<HOMKTS*2>+1,R4	;GET TRACK
4$:	ADD	R4,LBNL		;ADD IN A TRACK OF BLOCKS
	ADC	LBNH		;ADD IN CARRY
	SOB	R1,4$		;ACCOUNT FOR ALL TRACKS

	MOVB	DB+<HOMKTS*2>,R4	;GET SECTOR
	ADD	R4,LBNL		;ADD IN SECTOR COUNT
	ADC	LBNH		;FIX UP THE CARRY
	MOV	DB+<HOMKLN*2>,KLDLEN;REMEMBER SIZE OF DIRECTORY
	RTS	PC		;RETURN
REDDIR:	MOV	#KLDIR,R0	;SETUP ADDRESS OF DIRECTORY
	MOV	LBNH,R1		;SETUP HIGH LBN
	MOV	LBNL,R2		;SETUP LOW LBN OF DIRECTORY
	MOV	KLDLEN,R3	;RECALL SIZE OF DIRECTORY
	CALL	REDBLK		;READ IN THE DIRECTORY
	BCS	8$		;DIE IF CAN'T READ DIRECTORY
	RTS	PC		;RETURN
8$:	ABORT	<?I/O error reading KLADFE.DIR>
FNDKLD:	MOV	#KLDIR,R4	;POINT R4 AT DIRECTORY BUFFER

	CLR	R1		;CLEAR SUM (WILL BECOME COUNT OF ENTRIES)
	MOV	KLDLEN,R2	;GET MULTIPLIER
5$:	ADD	#1000/FDESIZ,R1	;COMPUTE # ENTRIES PER BLOCK
	SOB	R2,5$		;COMPUTE # OF ENTRIES


6$:	CMP	W.KFL0(R4),W.KFL0+KLDCP
	BNE	7$		;BRANCH IF NOT EQUAL IN 1ST HALF OF FILE NAME
	CMP	W.KFL1(R4),W.KFL1+KLDCP
	BNE	7$		;BRANCH IF NOT CORRECT 2ND HALF OF FILE NAME
	CMP	W.KEXT(R4),W.KEXT+KLDCP
	BEQ	FOUNDK		;BRANCH IF FILE NAMES AND EXT ALL MATCH

; HERE IF SOME PART OF FILE NAME OR EXTENSION DOES NOT MATCH
7$:	ADD	#FDESIZ,R4	;STEP TO NEXT ENTRY
	SOB	R1,6$		;LOOP FOR NEXT ENTRY
	ABORT	<?Cannot find KLDCP.BIN>

;FOUND KLDCP.BIN, CONVERT CYL/TRACK/SECTOR TO LOGICAL BLOCK NUMBER
FOUNDK:	CLR	LBNH		;CLEAR LBN HIGH
	CLR	LBNL		;CLEAR LBN LOW
	MOV	W.KCYL(R4),R0	;GET CYL#
	BEQ	2$		;SKIP IT IF ON CYLINDER 0
1$:	ADD	#380.,LBNL	;ADD IN A CYLINDER WORTH OF BLOCKS
	ADC	LBNH		;	(TAKE CARE OF CARRY, IF ANY)
	SOB	R0,1$		;...FOR EVERY CYLINDER THERE
2$:	MOVB	W.KTS+1(R4),R0	;GET TRACK # (NEVER .GT. 20, IGNORE SIGN EXTEND)
	BEQ	4$		;DON'T IF ON TRACK 0
3$:	ADD	#20.,LBNL	;ADD IN A TRACK'S WORTH OF BLOCKS
	ADC	LBNH		;	(TAKE CARE OF CARRY, IF ANY)
	SOB	R0,3$		;...FOR EVERY TRACK INVOLVED
4$:	MOVB	W.KTS(R4),R0	;GET SECTOR #
	ADD	R0,LBNL		;ADD SECTOR NUMBER AS FINAL OFFSET
	ADC	LBNH		;AND TAKE CARE OF FINAL CARRY

;CONVERT THE WORD COUNT TO A BLOCK COUNT
FIXWCK:	MOV	#8.,R0		;GET #POSITIONS TO SHIFT
1$:	ASR	W.KWAH(R4)	;SHIFT TO THE RIGHT
	ROR	W.KWAL(R4)	;THE WORD COUNT RIGHT
	SOB	R0,1$		;TO CONVERT TO A BLOCK COUNT
	TST	W.KWAH(R4)	;TEST HIGH ORDER (BLOCK) COUNT
	BEQ	2$
	ABORT	<?KLDCP.BIN is too large to load>
2$:	RTS	PC		;RETURN

KLDCP:	.RAD50	/KLDCP BIN/
LODKLD:	CLR	FCOUNT		;INITIALIZE "DVFRAM" (AND DVWORD)
	TYPE	<[Loading KLDCP.BIN]>
	MOV	W.KWAL(R4),BLKCNT
LDBIN1:	CLR	$CKS11		;INITIALIZE THE CHECKSUM
	CALL	DVFRAM		;GET A FRAME INTO R0
	DECB	R0		;CHECK FOR "BLOCK START"
	BNE	LDBIN1		;LOOP AND WAIT FOR BLOCK START CODE (IE: 1)

	CALL	DVFRAM		;READ ANOTHER FRAME (AND FORGET IT)

	CALL	DVWORD		;GET A FULL WORD, THE BYTE COUNT
	MOV	R0,LBC		;SAVE BYTE COUNT
	SUB	#6,LBC		;CHECK FOR XFER BLOCK
	BEQ	LJMP		;IF BYTE COUNT = 6, THIS IS AN XFER BLOCK
	CALL	DVWORD		;GET A FULL WORD, THE LOAD ADDRESS
	MOV	R0,R4		;SAVE LOAD ADDRESS

LDBIN2:	CALL	DVFRAM		;GET A DATA BYTE
	DEC	LBC		;DECREMENT BYTE COUNT
	BGE	LDBIN3		;BRANCH IF INSIDE DATA PART OF PACKET
	TSTB	$CKS11		;IF BYTE COUNT EXPIRES, CHECK CHECKSUM
	BEQ	LDBIN1		;START ANOTHER BLOCK IF CHECKSUM WAS OK
BADCHK:	ABORT	<?Checksum error while loading KLDCP.BIN>

LDBIN3:				;
10$:	MOVB	R0,(R4)+	;SAVE THE BYTE INTO CORE
12$:	BR	LDBIN2		;LOOP FOR MORE DATA

LJMP:	CALL	DVWORD		;GET (POSSIBEL) XFER ADDRESS
	MOV	R0,NEWPC		;REMEMBER XFER ADDRESS
	CALL	DVFRAM		;GET A FRAME
	TSTB	$CKS11		;CHECK CHECKSUM
	BNE	BADCHK
	RTS	PC		;RETURN
RESACS:	MOV	INITR0,R0	;RESTORE R0
	MOV	INITR1,R1	;RESTORE R1
	MOV	INITR2,R2	;RESTORE R2
	MOV	INITR3,R3	;RESTORE R3
	MOV	INITR4,R4	;RESTORE R4
	MOV	INITR5,R5	;RESTORE R5
	MOV	INITSP,SP	;RESTORE SP
	JMP	@NEWPC		;START AT NEWLY LOADED CODE
;	ROUTINE TO READ A FRAME
DVFRAM:	DEC	FCOUNT		;ANY FRAMES LEFT?
	BMI	DVFMOR		;NO, GO GET MORE
	MOVB	@FPOINT,R0	;YES, GET IT
	BIC	#^C377,R0	;CLEAR UPPER BYTE
	ADD	R0,$CKS11	;COMPUTE CHECKSUM
	INC	FPOINT		;UPDATE POINTER
	RETURN			;RETURN

DVWORD:	CALL	DVFRAM		;GET A FRAME
	MOV	R0,-(SP)	;SAVE THE 1ST BYTE
	CALL	DVFRAM		;GET ANOTHER FRAME
	SWAB	R0		;MAKE IT THE "HIGH" FRAME
	BIS	(SP)+,R0	;COMBINE WITH 1ST BYTE
	RETURN			;RETURN

DVFMOR:	DEC	BLKCNT		;COUNT ANOTHER BLOCK AS READ
	BMI	2$		;COMPLAIN IF PREMATURE EOF
	MOV	DBA,R0		;BUFFER ADDRESS
	MOV	LBNH,R1		;GET DISK ADDRESS
	MOV	LBNL,R2		;GET DISK ADDRESS, LOW PART
	CLR	R3		;GET 1 BLOCK ONLY
	MOV	R4,-(SP)	;SAVE R4 (BYTE POINTER)
	CALL	REDBLK		;READ ANOTHER BLOCK
	BCS	1$		;REMARK ON ERROR
	MOV	(SP)+,R4	;RESTORE BYTE POINTER
	MOV	#1000,FCOUNT	;1000 FRAMES NOW AVAILABLE
	MOV	DBA,FPOINT	;STARTING AT DB
	INC	LBNL		;START TO READ NEXT BLOCK
	ADC	LBNH		;...
	BR	DVFRAM

1$:	MOV	(SP)+,R4	;RESTORE BYTE POINTER
	ABORT	<?Input error reading KLDCP.BIN>

2$:	ABORT	<?Premature EOF while reading KLDCP.BIN>
	.SBTTL	END OF 2ND PART

DBA:	.WORD	DB
	.=.
	.PRINT	10000-.;	BYTES REMAINING IN 2ND PART OF BOOT
	.SBTTL	IMPURE NON-INITIALIZED DATA

	.=10000
	.BLKW	50
STAK:	.BLKW	1
DB:	.BLKW	400			;DISK I/O BUFFER
SAVR1:	.BLKW	1		;R1 (HIGH ORDER LBN OF CORIMG.SYS'S FHB)
SAVR2:	.BLKW	1		;R2 (LOW ORDER LBN OF CORIMG.SYS'S FHB)
BLKCNT:	.BLKW	1		;BLOCK COUNT FOR READING .BIN FILES
LBC:	.BLKW	1			;BYTE COUNT OF CURRENT .BIN PACKET
$CKS11:	.BLKw	1		;THE .BIN FILE CHECKSUM WORD
FPOINT:	.BLKW	1			;POINTER TO CURRENT FRAME
FCOUNT:	.BLKW	1			;COUNT OF FRAMES IN CURRENT DISK BUFFER

INITR0:	.BLKW	1			;THE R0 WE GOT FROM THE ROM
INITR1:	.BLKW	1			;THE R1 WE GOT FROM THE ROM
INITR2:	.BLKW	1			;THE R2 WE GOT FROM THE ROM
INITR3:	.BLKW	1			;THE R3 WE GOT FROM THE ROM
INITR4:	.BLKW	1			;THE R4 WE GOT FROM THE ROM
INITR5:	.BLKW	1			;THE R5 WE GOT FROM THE ROM
INITSP:	.BLKW	1			;THE SP WE GOT FROM THE ROM
NEWPC:	.BLKW	1		;THE R7 WE WANT TO START PROGRAM WITH
SAVUBA:	.BLKW	1			;THE UNIBUS ADDRESS
RPUNIT:	.BLKW	1			;COPY OF RPCS2 TO SAVE UNIT #
SAVHLB:	.BLKW	1			;HIGH WORD OF LBN FOR NEXT XFER
SAVLLB:	.BLKW	1			;LOW WORD OF LBN FOR NEXT XFER
SAVCNT:	.BLKW	1			;# OF BLOCKS TO XFER, 0 COUNTED AS 1
LBNH:	.BLKW	1			;LBN HIGH
LBNL:	.BLKW	1			;LBN LOW
KLDLEN:	.BLKW	1			;LENGTH OF KLDCP DIRECTORY
ECWRD0:	.BLKW	1
ECWRD1:	.BLKW	1
ECWRD2:	.BLKW	1
ECMSK0:	.BLKW	1
ECMSK1:	.BLKW	1
ECMSK2:	.BLKW	1
ECADR0:	.BLKW	1
ECADR1:	.BLKW	1
ECBAD0:	.BLKW	1
ECBAD1:	.BLKW	1
LEVELV:	.BLKW	1	;VERSION # OF 20F FROM F11ACP.TSK FILE

	.PRINT .;END OF IMPURE AREA

ENDING=.
	.END	USERSX			;GIVE USERSX FOR KLDCP