; SUBROUTINE DISRLD.MAC
; TO DECODE A RELOCATION DIRECTORY COMMAND AND PROVIDE AN
; ASCII STRING DESCRIPTOR FOR THE DECODED COMMAND
; ON CALL R3 CONTAINS POINTER TO RLD ENTRY
; ON RETURN R4 CONTAINS LENGTH OF STRING
;           R5 CONTAINS ADDRESS OF STRING
;           R3 CONTAINS POINTER TO NEXT RLD ENTRY
; OTHER REGISTERS USED: R0,R1,R2
;
; MACRO DEFINITIONS
;
	.MACRO	FERR,X,P1,P2,P3,P4
.IIF NB <P1>,	MOV	P1,ARGBLK	;Arguments for insertion
.IIF NB <P2>,	MOV	P2,ARGBLK+2
.IIF NB <P3>,	MOV	P3,ARGBLK+4
.IIF NB <P4>,	MOV	P4,ARGBLK+6
	MOV	#I.'X,R1			;Address of Error String
	JMP	FERR
	.ENDM
	.MACRO	DIAG,X,P1,P2,P3,P4
.IIF NB <P1>,	MOV	P1,ARGBLK
.IIF NB <P2>,	MOV	P2,ARGBLK+2
.IIF NB <P3>,	MOV	P3,ARGBLK+4
.IIF NB <P4>,	MOV	P4,ARGBLK+6
	MOV	#I.'X,R1
	CALL	DIAG
	.ENDM
	.MACRO	WORDIN	RG	;GET A WORD THAT MAY BE ACROSS WORD BOUNDARIES
	CLR	RG
	BISB	(R3)+,RG
	SWAB	RG
	BISB	(R3)+,RG
	SWAB	RG
	.ENDM	WORDIN
	.MACRO	SETUP	P1	;INITIAL SETUP ROUTINE
	MOV	P1,R0
	MOV	R0,R5
	WORDIN	R1
	CLR	R2
	.ENDM	SETUP
	.MACRO	FINISH
	MOV	R0,R4
	SUB	R5,R4
	RTS	PC
	.ENDM	FINISH
	.MACRO	BLNKLN	ADD,LEN
	MOV	ADD,R0
	MOV	LEN,R1
	JSR	PC,BLNKIT
	.ENDM	BLNKLN
	.CSECT
	.TITLE	DISRLD
;
; GLOBALS DEFINED ELSEWHERE
;
	.GLOBL	BLNKIT	$CBOSG	$C5TA	$CBOMG	PSCBUF
	.GLOBL	PSCCNT
;
; GLOBALS DEFINED HERE
;
	.GLOBL	DISRLD
STRSTK:	.BLKB	80.		;COMPLEX STRING STACK
STRBUF:	.BLKB	80.
STRBF1:	.ASCII	/> /
DISRLD:	BLNKLN	#STRBUF,#80.	;BLANK OUT THE ASCII LINE BUFFER
	WORDIN	R0		;GET RLD COMMAND IN R0
	BIC	#177600,R0	;CLEAR DISP AND MOD BITS
	DEC	R0		;MAKE IT A JUMP
	ASL	R0		;POINTER
	JSR	PC,@JMPTBL(R0)	;DO APPROPRIATE ROUTINE
	RTS	PC
JMPTBL:	.WORD	RLCNST		;INTERNAL RELOCATION
	.WORD	GLOBAL		;GLOBAL RELOCATION
	.WORD	CNSTNT		;INTERNAL DISPLACED RELOCATION
	.WORD	GLOBAL		;GLOBAL DISPLACED RELOCATION
	.WORD	GLBADD		;GLOBAL ADDITIVE RELOCATION
	.WORD	GLBADD		;GLOBAL ADDITIVE DISPLACED REL
	.WORD	DPSECT		;LOCATION COUNTER DEFINITION
	.WORD	PCMODF		;LOCATION COUNTER MODIFICATION
	.WORD	DLIMIT		;PROGRAM LIMITS
	.WORD	RPSECT		;PSECT RELOCATION
	.WORD	0		;NOT USED
	.WORD	RPSECT		;PSECT DISPLACED RELOCATION
	.WORD	ADDPSC		;PSECT ADDITIVE RELOCATION
	.WORD	ADDPSC		;PSECT ADDITIVE DISPLACED RELOCATION
	.WORD	COMPLX		;COMPLEX RELOCATION
RLBUFF:	.ASCII	/$$$$ST+/
RLBUF1:	.BLKB	7
	.EVEN
RLCNST:	MOV	#RLBUFF,R0	; Copy in proper PSECT value
	MOV	#PSCNAM,R1	;
	MOV	#6,R2		;
;
10$:
	MOVB	(R1)+,(R0)+	;
	SOB	R2,10$		;
	SETUP	#RLBUF1
	JSR	PC,$CBOSG
	MOV	#RLBUFF,R5
	FINISH
CNSTNT:	SETUP	#STRBUF
	JSR	PC,$CBOSG
	FINISH
GLOBAL:	SETUP	#STRBUF
	JSR	PC,C5TASC
	WORDIN	R1
	JSR	PC,C5TASC
	FINISH
GLBADD:	JSR	PC,GLOBAL
	WORDIN	R1
	TST	R1
	BMI	1$
	MOVB	#'+,(R0)+
	BR	2$
1$:	NEG	R1
	MOVB	#'-,(R0)+
2$:	CLR	R2
	JSR	PC,$CBOMG
	FINISH
PSTRNG:	.ASCII	/	.PSECT	/
PSTRG1:	.BLKB	6
	.EVEN
DPSECT:	BLNKLN	#PSTRG1,#6	;BLANK OUT THE ASCII LINE BUFFER
	SETUP	#PSTRG1
	JSR	PC,C5TASC
	WORDIN	R1
	JSR	PC,C5TASC
	MOVB	-5(R3),-(R3)		; Pretend we have a Location Counter..
	MOVB	-5(R3),-(R3)		; ..Modification to force the .=n
	INCB	(R3)			;
	MOV	R0,-(SP)		; Save work registers
	MOV	R1,-(SP)		;
	MOV	R2,-(SP)		;
	MOV	#PSTRG1+2,R0		; Set up address to copy PSECT name
	MOV	#MSTRG2,R1		;
	MOV	#PSCNAM,R2		;
	MOVB	#'.,(R1)+		; .$ at front
	MOVB	#'.,(R2)+		; .$ at front
	MOVB	#'$,(R1)+		;
	MOVB	#'$,(R2)+		;
	MOV	#4,R5			; 4 of the rest
;
10$:
	MOVB	(R0),(R1)+		;
	MOVB	(R0)+,(R2)+		;
	SOB	R5,10$			;
	MOV	(SP)+,R2		; Restore work registers
	MOV	(SP)+,R1		;
	MOV	(SP)+,R0		;
	MOV	#PSTRNG,R5
	FINISH
MSTRNG:	.ASCII	/.=/
MSTRG2:	.BLKB	6
	.ASCII	/+/
MSTRG1:	.BLKB	6
	.EVEN
PCMODF:	SETUP	#MSTRG1
	JSR	PC,$CBOMG
	MOV	#MSTRNG,R5
	FINISH
LSTRNG:	.ASCII	/.LIMIT/
	.EVEN
DLIMIT:	MOV	#LSTRNG,R5
	MOV	#6,R4
	RTS	PC
RPSECT:	SETUP	#STRBUF
	JSR	PC,C5TASC
	MOVB	#'.,STRBUF	; Overwrite start of PSECT
	MOVB	#'$,STRBUF+1	; with .$
	WORDIN	R1
	JSR	PC,C5TASC
	FINISH
ADDPSC:	JSR	PC,RPSECT
	WORDIN	R1
	TST	R1
	BMI	1$
	MOVB	#'+,(R0)+
	BR	2$
1$:	NEG	R1
	MOVB	#'-,(R0)+
2$:	CLR	R2
	JSR	PC,$CBOMG
	FINISH
BINCHR:	.ASCII	" +-*/&! "	;ASCII OPERATORS
COMPLX:	MOV	#STRBUF,R4	;SET UP COMPLEX STACK POINTER
COMPL1:	MOVB	(R3)+,R2	;GET COMMAND IN R2
	CMPB	R2,#0		;SEE IF IN RANGE
	BLT	ERRORC		;ELSE
	CMPB	R2,#20		;INDICATE
	BGT	ERRORC		;ERROR
	ASL	R2		;MPY BY 2
	JMP	@JMPTB1(R2)	;GO TO APPROPRIATE PROCESSING
JMPTB1:	.WORD	COMPL1	;0 NO-OP
	.WORD	BINOPR	;1 '+'
	.WORD	BINOPR	;2 '-'
	.WORD	BINOPR	;3 '*'
	.WORD	BINOPR	;4 '/'
	.WORD	BINOPR	;5 '&'
	.WORD	BINOPR	;6 '!'
	.WORD	ERRORC	;7 NOT USED
	.WORD	UNAOPR	;10 '-'
	.WORD	UNAOPR	;11 '^C'
	.WORD	STORE	;12 END
	.WORD	STORE	;13 END
	.WORD	ERRORC	;14 NOT USED
	.WORD	ERRORC	;15 NOT USED
	.WORD	FCHGBL	;16 FETCH GLOBAL
	.WORD	FCHREL	;17 FETCH RELOCATABLE
	.WORD	FCHCON	;20 FETCH CONSTANT
ERRORC:	FERR	URL,R2
FCHGBL:	MOV	#STRBUF,R0	;SET UP BUFFER IN R0
	MOV	#2,R2		;DO RAD50 CONVERSION TWICE
1$:	MOV	R2,-(SP)	;SAVE COUNT ON STACK
	WORDIN	R1		;RAD50 WORD IN R1
	JSR	PC,C5TASC	;PERFORM CONVERSION
	MOV	(SP)+,R2	;RESTORE COUNT
	SOB	R2,1$
	MOV	#STRBUF,R5	;START IN R5
	SUB	R5,R0		;LENGTH
	MOV	R0,R2		;IN R2
	JSR	PC,PUSH		;PUT ASCII ON STACK
	BR	COMPL1		;GO GET ANOTHER COMMAND
FCHCON:	MOV	#STRBUF,R0	;SET UP START IN R0
	MOV	R0,R5		;AND R5
	WORDIN	R1		;CONSTANT VALUE IN R1
	CLR	R2		;TRUNCATE LEADING ZEROES
	JSR	PC,$CBOMG	;PERFORM CONVERSION
	SUB	R5,R0		;CALCULATE
	MOV	R0,R2		;LEN IN R2
	JSR	PC,PUSH		;PUT ON STACK
	BR	COMPL1		;GO GET ANOTHER COMMAND
FCHREL:	MOVB	(R3)+,R2	;GET PSECT NUMBER IN R2
	CMP	R2,PSCCNT	;IS IT IN LIMITS
	BHI	ERRORC		;IF NOT, ERROR
	ASL	R2		;MULTIPLY PSECT NO.
	ASL	R2		;BY FOUR
	MOV	#STRBUF,R0	;SET UP START OF BUFFER
	MOV	R0,R5		;IN R0 AND R5
	ADD	#PSCBUF,R2	;ADD START OF PSECT AREA TO R2
	MOV	(R2)+,R1	;FIRST RAD50 WORD
	MOV	R2,-(SP)	;SAVE R2
	JSR	PC,C5TASC	;CONVERTED
	MOVB	#'.,STRBUF	; Overwrite start of PSECT with .$
	MOVB	#'$,STRBUF+1	;
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(R2)+,R1	;AND THEN 
	JSR	PC,C5TASC	;SECOND
	MOVB	#'+,(R0)+	;PUT IN '+'
	WORDIN	R1		;GET OFFSET
	CLR	R2		;INDICATE TRUNCATION
	JSR	PC,$CBOMG	;CONVERT IT
	SUB	R5,R0		;NOW GET COUNT
	MOV	R0,R2		;IN R2
	JSR	PC,PUSH		;AND PUT ON STACK
	BR	COMPL1		;AND GO DO IT AGAIN
BINOPR:	ASR	R2		;GET COMMAND BACK
	MOV	R2,-(SP)	;AND SAVE IT
	MOV	#STRBF1,R5	;END OF BUFFER IN R5
	JSR	PC,POP		;POP ONE STRING OFF
	MOV	(SP)+,R2	;RESTORE COMMAND
	ADD	#BINCHR,R2	;ADD IN START OF ASCII STRING
	MOVB	(R2),-(R5)	;AND PUT IN PROPER OPERATION
	JSR	PC,POP		;GET NEXT ASCII OPERAND
	MOVB	#'<,-(R5)	;ENCLOSE IN LEADING <
	MOV	#STRBF1,R2	;GET COUNT
	SUB	R5,R2		;IN R2
	INC	R2		;INC FOR TRAILING >
	JSR	PC,PUSH		;PUT IT AWAY
	JMP	COMPL1		;AND GET NEXT COMMAND
UNAOPR:	ASR	R2		;GET BACK COMMAND
	SUB	#10,R2		;MAKE IT 0 OR 1
	MOV	R2,-(SP)	;AND SAVE IT
	MOV	#STRBF1,R5	;END IN R5
	JSR	PC,POP		;GET ASCII OPERAND
	MOV	(SP)+,R2	;RESTORE MODIFIED COMMAND
	BNE	1$		;IF 1, DO ^C
	MOVB	#'-,-(R5)	;ELSE PUT IN '-'
	BR	2$		;GO AROUND COMPLEMENT
1$:	MOVB	#'<,-(R5)	;DELIMIT ARGUMENT
	MOVB	#'C,-(R5)	;PUT IN
	MOVB	#'^,-(R5)	;^C
2$:	ADD	#STRBF1,R2	;GET COUNT (INCL TRAILING '>' FOR ^C)
	SUB	R5,R2		;IN R2
	JSR	PC,PUSH		;AND PUT IT AWAY
	JMP	COMPL1		;NEXT COMMAND
STORE:	MOV	#STRBF1,R5	;END OF BUFFER IN R5
	JSR	PC,POP		;GET STRING
	MOV	#STRBF1,R4	;END OF BUFFER IN R4
	CMPB	-1(R4),#'>	;IS THERE TRAILING >
	BNE	1$		;IF NOT, SKIP
	CMPB	(R5),#'<	;AND LEADING?
	BNE	1$		;IF BOTH, THEN
	INC	R5		;DON'T NEED
	DEC	R4		;THEM
1$:	SUB	R5,R4		;LENGTH NOW IN R4
	RTS	PC		;RETURN
;
; SUBROUTINE PUSH
; R4 POINTS TO CURRENT STACK POSITION
; R5 POINTS TO BEGINNING OF STRING
; R2 CONTAINS COUNT
PUSH:	MOV	R2,-(SP)	;SAVE COUNT FOR LATER USE
1$:	MOVB	(R5)+,-(R4)	;TRANSFER
	SOB	R2,1$		;STRING
	MOV	(SP)+,R2	;RESTORE COUNT
	MOVB	R2,-(R4)	;AND PUT IT ON STACK
	RTS	PC
;
; SUBROUTINE POP
; R4 POINTS TO CURRENT STACK POSITION
; R5 POINTS TO LAST OCCUPIED POSITION IN STRBUF
; OTHER REGISTERS USED: R2
POP:	MOVB	(R4)+,R2	;COUNT IN R2
1$:	MOVB	(R4)+,-(R5)
	SOB	R2,1$
	RTS	PC
;
; SUBROUTINE C5TASC
; TO CONVERT RAD50 TO ASCII
; WITH NO TRAILING BLANKS
; CALLS LIBRARY ROUTINE $C5TA
; ON CALL:
;	R0 POINTS TO FIRST STORAGE BYTE
;	R1 CONTAINS RAD50 WORD
; ON RETURN:
;	R0 POINTS PAST LAST NON-BLANK CHAR.
; OTHER REGISTERS USED: R2
C5TASC:	JSR	PC,$C5TA	;PERFORM CONVERSION
2$:	CMPB	-(R0),#40	;IS LAST CHAR BLANK?
	BEQ	2$		;IF SO, TRY ANOTHER
	INC	R0		;POINT PAST NON-BLANK CHAR
	RTS	PC
	.END