	.TITLE	RLD3
	.IDENT	/hah015/
 
;
; VERSION 01
;
; TOM GETZINGER  26-OCT-80
;
; Modified:	07-Nov-83	hah002
;		Add support for library base additive RLD
;		07-Nov-83	hah003
;		Print numbers > 170000(8) as negative numbers
;		27-Jul-85	hah010
;		Convert SELECT subroutine to support DOB as a I&D space task.
;		06-Aug-85	hah012
;		Add more error messages.
;

;
; THIS MODULE PROCESSES "RLD" RECORDS IN PASS 3
;
; MACROs								;hah010
;									;hah010
	.macro	select	table						;hah010
	mov	r0,-(sp)	;Save R0 (restored by SELECT)		;hah010
	mov	table,	r0						;hah010
	call	select							;hah010
	.endm								;hah010
;
; LOCAL DATA
;
 
	.PSECT	RWDATA,RW,D
BYTMOD:	.BLKB	1		; SET IF BYTE MODIFICATION
CMD:	.BLKB	1		; CURRENT RELOCATION COMMAND
VAL:				; CURRENT RELOCATION VALUE
MODADR:	.BLKW	1		; CURRENT MODIFICATION ADDRESS
NAME:	.BLKW	2		; CURRENT RELOCATION NAME

	.even								;hah002
 
	.PSECT	RODATA,RO,D
CMDLEN:	.BYTE	0		; ILLEGAL
	.BYTE	10		; INTERNAL
	.BYTE	10		; GLOBAL
	.BYTE	10		; INTERNAL DISPLACED
	.BYTE	10		; GLOBAL DISPLACED
	.BYTE	17		; GLOBAL ADDITIVE
	.BYTE	17		; GLOBAL ADDITIVE DISPLACED
	.BYTE	0		; LOCATION COUNTER DEFINITION
	.BYTE	0		; LOCATION COUNTER MODIFICATION
	.BYTE	0		; .LIMIT
	.BYTE	10		; PSECT
	.BYTE	0		; ILLEGAL
	.BYTE	10		; PSECT DISPLACED
	.BYTE	10		; PSECT ADDITIVE
	.BYTE	10		; PSECT ADDITIVE DISPLACED
	.BYTE	0		; COMPLEX
	.byte	17		;Library base additive			;hah002

	.even								;hah002
table:									;hah010
	.BYTE	RT.I,RT.max						;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	intrnl		; INTERNAL				;hah010
	.WORD	glbl		; GLOBAL				;hah010
	.WORD	intdsp		; INTERNAL DISPLACED			;hah010
	.WORD	glbl		; GLOBAL DISPLACED			;hah010
	.WORD	gbladd		; GLOBAL ADDITIVE			;hah010
	.WORD	gbladd		; GLOBAL ADDITIVE DISPLACED		;hah010
	.WORD	illcod		; LOCATION COUNTER DEFINITION		;hah010
	.WORD	illcod		; LOCATION COUNTER MODIFICATION		;hah010
	.WORD	lmt		; .LIMIT				;hah010
	.WORD	psct		; PSECT					;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	psct		; PSECT DISPLACED			;hah010
	.WORD	pscadd		; PSECT ADDITIVE			;hah010
	.WORD	pscadd		; PSECT ADDITIVE DISPLACED		;hah010
	.WORD	cmplx		; COMPLEX				;hah010
	.word	libbas		;Library base additive			;hah010

	.PSECT	CODE,RO
	.enabl	lsb
 
	.MCALL	PUT$S
 
RLD3::	MOV	R2,-(SP)	; SAVE R2
 
10$:	SUB	#2,R4		; ANY MORE RELOCATION ENTRIES?
	BMI	45$		; NO
	CLRB	BYTMOD		; ASSUME WORD MODIFICATION
	MOVB	(R3)+,CMD	; GET RELOCATION COMMAND
	BPL	20$		; OUR ASSUMPTION WAS CORRECT
	INCB	BYTMOD		; NO IT WASN'T, SO SET BYTE MOD FLAG
	BICB	#200,CMD	; CLEAR MODIFICATION FLAG
20$:	MOVB	(R3)+,R0	; GET DISPLACEMENT
	ADD	LSTADR,R0	; CONVERT TO ADDRESS
	MOV	R0,MODADR	; AND SAVE IT
	CMPB	CMD,#RT.LCD	; LOCATION COUNTER DEFINITION?
	BEQ	30$		; YES
	CMPB	CMD,#RT.LCM	; NO, LOCATION COUNTER MODIFICATION?
	BNE	50$		; NO
 
30$:	CALL	DASM3		; DISASSEMBLE ANY PREVIOUS TEXT
	CALL	DMPTXT		; DUMP REMAINING TEXT
	CMPB	CMD,#RT.LCD	; LOCATION COUNTER DEFINITION?
	BNE	40$		; NO
	MOV	#CRNPSC,R0
	CALL	GETR50		; GET CURRENT PSECT NAME
	CALL	PSCNUM		; GET CURRENT PSECT NUMBER
	CMP	R0,CRNPSN	; IS IT THE SAME AS THE OLD CURRENT?
	BEQ	40$		; YES, SO IT DIDN'T CHANGE
	MOV	CRNPSN,R1	; NO
	BMI	35$		; THERE IS NO CURRENT PSECT
	ASH	#3,R1
	ADD	PSCTBL,R1	; POINT INTO THE PSECT TABLE
	MOV	CRNADR,4(R1)	; SAVE OLD "CURRENT ADDRESS"
	CMP	CRNADR,6(R1)	; DID WE HIT THE MAX ADDRESS?
	BNE	35$		; NO
	CLR	6(R1)		; YES, SO CLEAR MAX ADDRESS
35$:	MOV	R0,CRNPSN	; SAVE NEW PSECT NUMBER
	ASH	#3,R0
	ADD	PSCTBL,R0	; POINT INTO THE PSECT TABLE
	MOV	4(R0),CRNADR	; SET NEW "CURRENT ADDRESS"
	MOV	F.NRBD+2+FDBOUT,R5 ; POINT TO OUTPUT BUFFER
	MOV	#PSECT,R0	; OUTPUT "	.PSECT	"
	CALL	APPEND
	MOV	#CRNPSC,R0	; FOLLOWED BY THE PSECT NAME
	CALL	ADDR50
	SUB	F.NRBD+2+FDBOUT,R5 ; CALCULATE RECORD LENGTH
	PUT$S	#FDBOUT,,R5	; OUTPUT THE RECORD
40$:	CALL	GETWRD		; GET CURRENT ADDRESS
	CMP	R0,CRNADR	; DID THE CURRENT ADDRESS CHANGE?
	BEQ	42$		; NO
	MOV	R0,R1		; YES, COPY ADDRESS
	SUB	CRNADR,R1	; CALCULATE DIFFERENCE
	MOV	R0,CRNADR	; SAVE NEW CURRENT ADDRESS
	MOV	F.NRBD+2+FDBOUT,R5 ; POINT TO OUTPUT BUFFER
	MOV	#.EQ.P,R0	; OUTPUT "	.=.+"
	cmp	#170000,r1	;Negative number?			;hah003
	bhi	41$		;Probably not				;hah003
	neg	r1		;Make it positive			;hah003
	mov	#.eq.m,r0	;Change message				;hah003
41$:									;hah003
	CALL	APPEND
	MOV	R1,R0
	CALL	ADDOCT		; FOLLOWED BY THE DIFFERENCE
	SUB	F.NRBD+2+FDBOUT,R5 ; CALCULATE THE RECORD LENGTH
	PUT$S	#FDBOUT,,R5	; OUTPUT THE RECORD
42$:	TST	R4		; ANY RLD ENTRIES LEFT?
	beq	45$		;No, so we're done			;hah012
	trap	moddef		;RLD entries after loc. counter mod/def.;hah012
45$:	JMP	240$		; NO, SO WE'RE DONE
 
50$:	BIC	#1,R0		; CALCULATE WORD MOD ADDR
	MOV	#FRSTXT,R2	; GET FIRST LINK
 
60$:	MOV	(R2),R2		; LINK TO NEXT TEXT
	bne	65$		;Have more text				;hah012
	trap	reltxt		;Cant find text record to relocate	;hah012
65$:									;hah012
	CMP	T.ADDR(R2),MODADR ; DO THE ADDRESSES MATCH?
	BNE	70$		; NO
	CMPB	T.FLAG(R2),BYTMOD ; ARE THEY THE SAME LENGTH?
	BEQ	90$		; YES
	TST	BYTMOD		; NO, ARE WE MODIFYING A WORD?
	bne	80$		;No, so split the text word		;hah012
	trap	rellen		;Wrong length for relocation		;hah012
;
; Address of this text block does not match the address we want to relocate.
; See if we are trying to modify the second byte of this word.
;
70$:	CMP	R0,T.ADDR(R2)	; DO WORD ADDRESSES MATCH?
	BNE	60$		; NO, KEEP LOOKING
;
; Have the right word to modify, see if the current text is a byte or a word.
; Since the above compare succeeded, but the compare with MODADR did not, we
; are trying to modify the upper byte of some word.
;
	TSTB	T.FLAG(R2)	; IS TEXT A WORD?
	BNE	60$		; NO, SO KEEP LOOKING
;
; Current text is a word.  See if we are trying to do a byte split.
;
	TSTB	BYTMOD		; BYTE MODIFICATION?
	BNE	80$		; YES, SO SPLIT THE TEXT WORD
;
; Trying to modify a word starting at an odd address.  No can do.
;
	trap	wrdrel		;Trying to relocate word @ odd addres	;hah012
80$:	MOV	#FREEHD,R0	; ALLOCATE A MEMORY BLOCK
	MOV	#-T.LEN,R1	; FOR THE TEXT BYTE
	MOV	R2,-(SP)	; SAVE POINTER
;	CALL	$RQCB		; ALLOCATE A TEXT BLOCK			;hah015
;	BCC	85$		; WE GOT IT OKAY			;hah015
;	TRAP	NOMEM		; "NO DYNAMIC MEMORY"			;hah015
	call	getblk		;Allocate a text block			;hah015
85$:	MOV	(SP)+,R2	; RESTORE POINTER
	CLR	T.STR(R0)	; THERE IS NO STRING
	MOV	T.NEXT(R2),T.NEXT(R0) ; LINK NEW TEXT IN
	MOV	R0,T.NEXT(R2)
	MOVB	#TF.BYT,T.FLAG(R2) ; CHANGE WORD TO BYTE
	MOV	#TF.BYT,T.FLAG(R0) ; AND MAKE NEW TEXT A BYTE
	MOVB	T.VAL+1(R2),T.VAL(R0) ; SET VALUE
	CLRB	T.VAL+1(R2)	; REMOVE UPPER BYTE FROM OLD TEXT
	CLRB	T.VAL+1(R0)	; AND ENSURE IT'S CLEARED ON NEW TEXT
	MOV	T.ADDR(R2),T.ADDR(R0) ; GET ADDRESS
	INC	T.ADDR(R0)
	BIT	#1,MODADR	; ARE WE POINTING TO THE RIGHT BYTE
	BEQ	90$		; YES
	MOV	(R2),R2		; NO, SO GO TO IT
 
90$:
	BIT	#TF.REL!TF.LMT!tf.lib,T.FLAG(R2) ; HAS TXT BEEN REL?	;hah002
	beq	95$		;No, everyting is OK			;hah002
	trap	relrel		;Error, cannot relocate twice		;hah012
95$:									;hah002
	BIS	#TF.REL,T.FLAG(R2) ; NO, BUT IT IS NOW
	MOVB	CMD,R1		; GET RELOCATION COMMAND
	CMP	R1,#RT.max	; IS THE COMMAND TOO BIG?		;hah002
	BHI	illcod		; YES
	MOVB	CMDFLG(R1),R1	; GET THE FLAGS
	BIT	#CF.NAM,R1	; DOES CMD NEED A NAME?
	BEQ	100$		; NO
	MOV	#NAME,R0	; YES, SO GET IT
	CALL	GETR50
100$:	BIT	#CF.VAL,R1	; DOES CMD NEED A VALUE?
	BEQ	105$		; NO
	CALL	GETWRD		; YES, SO GET IT
	MOV	R0,VAL		; AND SAVE IT
105$:	BIT	#CF.DSP,R1	; IS THE TEXT DISPLACED?
	BEQ	110$		; NO
	BIS	#TF.DSP,T.FLAG(R2) ; YES, SO INDICATE IT
110$:	MOVB	CMD,R1		; GET CMD
	MOVB	CMDLEN(R1),R1	; GET THE COMMAND TEXT LENGTH
	BEQ	130$		; IT HAS NONE
	MOV	#FREEHD,R0	; POINT TO FREE MEMORY LISTHEAD
	MOV	R2,-(SP)	; SAVE TEXT POINTER
;	CALL	$RQCB		; GET A STRING BLOCK			;hah015
;	BCC	120$							;hah015
;	TRAP	NOMEM		; WE RAN OUT OF MEMORY			;hah015
	call	getblk		;Get a string block			;hah015
120$:	MOV	(SP)+,R2	; RESTORE THE TEXT POINTER
	MOV	R0,T.STR(R2)	; SAVE THE TEXT POINTER
	MOV	R0,R5		; PUT IT INTO R5
	MOVB	R1,(R5)+	; STORE THE STRING LENGTH
130$:	MOVB	CMD,R1		; GET THE COMMAND
	select	#table							;hah010
 
psct:	CLR	VAL		; PSECT AND PSECT DISP HAVE NO VALUE
pscadd:	MOV	#NAME,R0	; GET THE PSECT NUMBER
	CALL	PSCNUM
	BR	160$		; AND GO ADD THE LABEL
intrnl:	MOV	CRNPSN,R0	; GET THE CURRENT PSECT NUMBER
160$:	MOV	VAL,R1		; GET THE OFFSET
	CALL	ADDSYM		; AND ADD THE SYMBOL
	BR	200$		; AND THAT'S IT
 
glbl:	MOV	#NAME,R0	; ADD THE NAME
	CALL	ADDR50
	BR	200$		; AND THAT'S ALL
 
gbladd:	MOV	#NAME,R0	; ADD THE GLOBAL SYMBOL
	CALL	ADDR50
	MOVB	#'+,(R5)+	; FOLLOWED BY A PLUS
	cmp	#170000,val	;Negative number?			;hah003
	bhi	intdsp		;Probably not				;hah003
	neg	val		;Make it positive			;hah003
	movb	#'-,-1(r5)	;Put minus sign over plus sign		;hah003
 
intdsp:	MOV	VAL,R0		; ADD THE VALUE
	CALL	ADDOCT
 
200$:	CLRB	(R5)		; SET STRING END INDICATOR
	JMP	10$		; AND WE'RE DONE WITH THIS COMMAND
 
lmt:	BIS	#TF.LMT,T.FLAG(R2) ; SET THE ".LIMIT" BIT
	BIC	#TF.REL,T.FLAG(R2) ; CLEAR THE "RELOCATED" FLAG
	MOV	(R2),R0		; GET ADDRESS OF NEXT TEXT WORD
	bne	211$		;Have address				;hah012
	trap	lmt2nd		;No second word for .LIMIT		;hah012
211$:									;hah012
	MOV	(R0),(R2)	; REMOVE TEXT WORD FROM THE LINKED LIST
	MOV	R0,R2
	TST	T.FLAG(R2)	; IS THE TEXT A NORMAL WORD?
	beq	221$		;Yes, continue				;hah012
	trap	lmtrel		;Cant handle .LIMIT if already relocated;hah012
221$:									;hah012
	MOV	#FREEHD,R0
	MOV	#T.LEN,R1
	CALL	$RLCB		; RELEASE THE TEXT WORD
	JMP	10$		; AND WE'RE DONE WITH THIS COMMAND
 
cmplx:	CALL	DCOM		; DISASSEMBLE A COMPLEX RELOCATION
	JMP	10$		; AND WE'RE DONE
 
illcod:	TRAP	OBJFMT		; OBJECT FORMAT ERROR
 
240$:	CLC			; CLEAR ERROR FLAG
 
250$:	MOV	(SP)+,R2	; RESTORE R2
	RETURN			; AND WE'RE DONE

libbas:									;hah002
	bis	#tf.lib,t.flag(r2) ;Say we have a libr. base		;hah002
	mov	#base,r0	;Start of library base message		;hah002
	call	append		;Store it				;hah002
	mov	val,r0		;Get the offset				;hah002
	cmp	#170000,r0	;Negative number?			;hah003
	bhi	310$		;Probably not				;hah003
	neg	r0		;Make it positive			;hah003
	movb	#'-,(r5)+	;Store it				;hah003
	br	320$		;Continue				;hah003
310$:									;hah003
	movb	#'+,(r5)+	;Store it				;hah003
320$:									;hah003
	call	addoct		;Convert the offset to ASCII		;hah002
	jmp	10$		;Continue				;hah002
 
	.END

