.TITLE	KLLOAD	KL11 file loader
	.IDENT	/03.01/
;
; This is the job loader for the KL-11 system console of the PDP-11.
; It will read one job in Intel-Hex format from the console, creating the job
; structure, allocating main and stack memory partitions for the job and
; returning a pointer to the job structure in R0. If a single empty line is
; input, nothing will be created or allocated and zero will be returned in R0.
; Carry is cleared in both these cases, it is set if some real error occurs.
;
; The job image must be in RT-11 REL (relocatable) format, linked to location
; 1000. The job name is supposed to be in locations 10 and 12 of sector 0 in
; the job image file.
;
; 09-AUG-2005	H. Rosenfeld	rewrote LOADER to understand RT-11 REL images
; 17-JUL-2005	H. Rosenfeld	cleaned up, changed to load just a single job
; 18-MAY-2005	H. Rosenfeld	split LOADER from GRUMPF.MAC
;
	.LIST	ME
	.NLIST	CND
	.ENABL	REG
	.LIBRARY	/CALL.SML/
	.LIBRARY	/UTIL.SML/
	.LIBRARY	/MEMORY.SML/
	.LIBRARY	/JOBCTL.SML/
	.MCALL	.CALL,.ENTRY,.RETRN
	.MCALL	.SYSPUT,.SYSGET
	.MCALL	.M$ALLO,.P$ALLO,.P$FREE,.P$ERR
	.MCALL	.J$ALLO,.JOBCTL
	.GLOBL	CURJOB

	.JOBCTL

	.CSECT
; input helper routine
; repeatedly reads hex lines until one with address >= 2(sp) is read
; sets registers R3 (address) and R1 (byte count), checks for end record
SKIP:	JSR	PC,GETL			; get next hex line
	MOV	HEXBUF,R4		; get hex buffer
	MOV	(R4)+,R3		; get address
	MOVB	(R4)+,R1		; get byte count
	TSTB	(R4)+			; test record type
	BNE	H$DONE			; stop if not data record (type 0)
	CMP	R3,2(SP)		; address below?
	BLO	SKIP			; yea, skip
	RTS	PC

H$DONE:	MOV	R2,R0			; return job pointer
	CLC				; no error
	.RETRN

HDRERR:	.SYSPUT	#HDFAIL
	SEC				; indicate error
	.RETRN

; main loader routine
LOADER::.ENTRY
	SUB	#62,SP			; allocate buffer for input strings
	MOV	SP,TMPBUF
	SUB	#24,SP			; allocate buffer for decoded strings
	MOV	SP,HEXBUF
	CLR	CHKSUM			; clear checksum
	CLR	R2			; clear job pointer
	.SYSPUT	#HEXL			; tell user to send data
	.SYSGET	TMPBUF,#62		; read line
	MOV	TMPBUF,R4		; process input
	TSTB	(R4)			; empty line?
	BEQ	H$DONE			; yea, get out
	JSR	PC,GETH			; convert to binary
	MOV	HEXBUF,R4		; process binary
	TST	(R4)+			; address 0?
	BNE	HDRERR			; nay, error
	CMPB	(R4)+,#20		; byte count 20?
	BNE	HDRERR			; nay, error
	TSTB	(R4)+			; data record (type 0)?
	BNE	HDRERR			; nay, error
	MOV	10(R4),-(SP)		; save first part of name
	MOV	12(R4),-(SP)		; save second part of name
	MOV	#40,-(SP)		; skip until address 40
	JSR	PC,SKIP
	BNE	HDRERR			; abort if > 40
	TST	(SP)+			; stack cleanup
	MOV	HEXBUF,R4		; get hex buffer
	TST	(R4)+			; skip address
	CMPB	(R4)+,#20		; byte count 20?
	BNE	HDRERR			; nay, error
	TSTB	(R4)+			; data record (type 0)?
	BNE	HDRERR			; nay, error
	MOV	(R4),-(SP)		; save start address
	MOV	12(R4),-(SP)		; save program size
	MOV	14(R4),-(SP)		; save stack size
	JSR	PC,GETL			; get next hex line
	MOV	HEXBUF,R4		; get hex buffer
	CMP	(R4)+,#60		; address 60?
	BNE	HDRERR			; nay, error
	CMPB	(R4)+,#20		; byte count 20?
	BNE	HDRERR			; nay, error
	TSTB	(R4)+			; data record (type 0)?
	BNE	HDRERR			; nay, error
	CMP	(R4)+,#^RREL		; REL image?
	BNE	HDRERR			; nay, error
	MOV	(R4)+,-(SP)		; save address of relocation data
	.J$ALLO	-116(R5),-120(R5)	; allocate job structure
	BCS	ERRET			; abort on error
	MOV	R0,R2			; save job structure pointer
	MOV	CURJOB,-(SP)		; save CURJOB
	MOV	R2,CURJOB		; switch to new job
	.M$ALLO	#0,-124(R5),#^RJOB,J$NAME(R2),J$NAME+2(R2)
					; allocate main memory partition
	MOV	(SP)+,CURJOB		; restore CURJOB
	BCS	ERRET			; abort on error
	MOV	R0,J$PART(R2)		; set partition in job structure
	ADD	-122(R5),R0		; calculate job PC
	SUB	#1000,R0		; PC = mempart - 1000 + start
	MOV	R0,J$PC(R2)		; set job PC
	MOV	CURJOB,-(SP)		; save CURJOB
	MOV	R2,CURJOB		; switch to new job
	.M$ALLO	#0,-126(R5),#^RSTK,#^RSTA,#^RCK
					; allocate stack memory partition
	MOV	(SP)+,CURJOB		; restore CURJOB
	BCS	ERRET			; abort on error
	MOV	R0,J$STCK(R2)		; set stack partition in job structure
	ADD	-126(R5),R0		; calculate job SP
	MOV	R0,J$SP(R2)		; set job SP
	MOV	-130(R5),R0		; get sector number of relocation data
	ASH	#11,R0			; shift to calculate address
	MOV	R0,-(SP)		; store on stack
4$:	MOV	-124(R5),R0		; get program size
	ADD	J$PART(R2),R0		; calculate program end
	MOV	R0,-(SP)		; store on stack
	MOV	#1000,-(SP)		; skip until address 1000
	JSR	PC,SKIP
	SUB	(SP)+,R3		; calculate relative address
	ADD	J$PART(R2),R3		; calculate absolute address
	MOV	(SP)+,R0		; get program end from stack
5$:	CMP	R3,R0			; end reached?
	BEQ	6$			; yea, need to get next line
	BHIS	7$			; yea, maybe its this line
	MOVB	(R4)+,(R3)+		; copy bytes
	SOB	R1,5$
	BR	4$
6$:	JSR	PC,SKIP			; skip to relocation data
7$:	ASR	R1			; divide byte count by 4
	ASR	R1			; since we process 4 byte at a time
	BEQ	6$			; zero count? try next.
8$:	MOV	(R4)+,R3		; get relocation information
	CMP	R3,#-2			; end of relocation information?
	BEQ	11$			; yea, stop
	ASL	R3			; get relocation address & operation
	BCC	9$			; add
	ADD	J$PART(R2),R3		; calculate absolute address
	SUB	J$PART(R2),(R3)		; relocate
	ADD	#1000,(R3)		; adjust
	BR	10$
9$:	ADD	J$PART(R2),R3		; calculate absolute address
	ADD	J$PART(R2),(R3)		; relocate
	SUB	#1000,(R3)		; adjust
10$:	TST	(R4)+			; skip word
	SOB	R1,8$
	BR	6$
11$:	MOV	#-1,(SP)		; skip forever...
	JSR	PC,SKIP

ERROR:	.SYSPUT	#HFAIL
ERRET:	SEC				; indicate error
	.RETRN

; input helper routine
; reads a hex line and decodes it
GETL:	.SYSPUT	#PROMPT			; issue prompt
	.SYSGET	TMPBUF,#62		; read line
	MOV	TMPBUF,R4		; process it

GETH:	CMPB	(R4)+,#':		; colon?
	BNE	ERROR			; nay, error
	MOV	HEXBUF,R3		; decode into hex buffer
	JSR	PC,HEX			; get next binary byte
	MOVB	R0,-(SP)		; this is byte count
	JSR	PC,HEX			; get next binary byte
	MOV	R0,R1			; this is hi-byte of address
	SWAB	R1			; so move it to hi-byte
	JSR	PC,HEX			; get next binary bate
	ADD	R0,R1			; add lo-byte
	MOV	R1,(R3)+		; store address
	MOVB	(SP)+,R1		; get byte count
	MOVB	R1,(R3)+		; store byte count
	JSR	PC,HEX			; get next binary byte
	MOVB	R0,(R3)+		; this is record type
	BEQ	1$			; copy if data record
	DEC	R0			; test for end record
	BNE	ERROR			; error if not end record
	BR	2$			; skip copying
1$:	JSR	PC,HEX			; get next binary byte
	MOVB	R0,(R3)+		; store byte
	SOB	R1,1$
2$:	JSR	PC,HEX			; get next binary byte
	TSTB	CHKSUM			; correct checksum?
	BNE	ERROR			; nay, error
	RTS	PC

; input helper routine
; converts two hex characters pointed to by R4 into a single binary byte in R0
HEX:	MOV	R1,-(SP)		; we shouldn't corrupt R1
	MOVB	(R4)+,R0		; get first character
	SUB	#'A,R0			; try to convert to binary
	BPL	1$			; if negative, this was a digit
	ADD	#7,R0			; so adjust for digit conversion
1$:	ADD	#12,R0			; finish conversion to binary
	ASH	#4,R0			; shift to hi-nibble of byte
	MOVB	(R4)+,R1		; get second character
	SUB	#'A,R1			; same conversion as above
	BPL	2$
	ADD	#7,R1
2$:	ADD	#12,R1
	ADD	R1,R0			; add to create binary byte
	ADD	R0,CHKSUM		; add to checksum
	MOV	(SP)+,R1		; restore R1
	RTS	PC

	.PSECT	DATA
CHKSUM:	.BLKW	1			; record checksum
TMPBUF:	.BLKW	1			; pointer to input buffer
HEXBUF:	.BLKW	1			; pointer to hex buffer

	.PSECT	CONST
HEXL:	.ASCII	<15><12>/SEND HEX DATA NOW, OR <CR> TO FINISH/
PROMPT:	.ASCIZ	<15><12>/>/
HFAIL:	.ASCIZ	<15><12>/HEX LOAD ERROR/<7>
HDFAIL:	.ASCIZ	<15><12>/HEADER ERROR/<7><15><12>

	.END	LOADER