.TITLE	ORCSUB ORCAM SUBROUTINES
	.IDENT	/V01/
;
; ORCAM SUBROUTINES
;
	.MACRO	FTAB
	JSR	PC,TAB8
	.ENDM	FTAB
;
; INTERPRET OPERAND IN R0
; R1 = CURRENT POSITION IN INPUT LINE
; R2 = CURRENT POSITION IN OUTPUT LINE
;
AMODE::
REG::
	MOV	R0,R4
	BIC	#177770,R4		; ISOLATE
	ASH	#-2,R0
	BIC	#177761,R0		; AND MO
	CMP	R4,#7
	BNE	5$
	MOVB	#'P,R3
	MOVB	#'C,R4
	JMP	@PCMODE(R0)
5$:	CMP	R4,#6
	BEQ	10$
	ADD	#60,R4
	MOVB	#'R,R3
	BR	20$
10$:	MOVB	#'S,R3
	MOVB	#'P,R4
20$:	JMP	@MODES(R0)
;
	.PSECT	ORCDAT,D
MODES:	.WORD	M0,M1,M2,M3,M4,M5,M6,M7
PCMODE:	.WORD	M0,M1,PCM2,PCM3,M4,M5,PCM6,PCM7
;
	.PSECT
M0:	MOVB	R3,(R2)+
	MOVB	R4,(R2)+
	BR	MDONE
MCOM:	MOVB	#'(,(R2)+
	MOVB	R3,(R2)+
	MOVB	R4,(R2)+
	MOVB	#'),(R2)+
	RTS	PC
M1:	JSR	PC,MCOM
	BR	MDONE
M2:	JSR	PC,MCOM
	MOVB	#'+,(R2)+
	BR	MDONE
M3:	MOVB	#'@,(R2)+
	BR	M2
M4:	MOVB	#'-,(R2)+
	BR	M1
M5:	MOVB	#'@,(R2)+
	BR	M4
M6:	CMP	R1,OBJLEN
	BLT	5$
	JSR	PC,NOMORE
	BCS	MDONE
5$:	MOV	(R1)+,OCOBUF
	JSR	PC,SRCHRD
	TST	R0
	BEQ	15$
	JSR	PC,OCO
	MOV	#OCOBUF,R5
10$:	MOVB	(R5)+,(R2)+
	SOB	R0,10$
15$:	ADD	#2,NXTLC
	BR	M1
M7:	MOVB	#'@,(R2)+
	BR	M6
;
PCM2:	MOVB	#'#,(R2)+
	CMP	R1,OBJLEN
	BLT	5$
	JSR	PC,NOMORE
	BCS	MDONE
5$:	MOV	(R1)+,OCOBUF
	JSR	PC,SRCHRD
	TST	R0
	BEQ	15$
	JSR	PC,OCO
	MOV	#OCOBUF,R5
10$:	MOVB	(R5)+,(R2)+
	SOB	R0,10$
15$:	ADD	#2,NXTLC
	BR	MDONE
PCM3:
	MOVB	#'@,(R2)+
	BR	PCM2
PCM6:	
	CMP	R1,OBJLEN
	BLT	5$
	JSR	PC,NOMORE
	BCS	MDONE
5$:	MOV	(R1)+,OCOBUF
	JSR	PC,SRCHRD
	ADD	#2,NXTLC
	ADD	NXTLC,OCOBUF
	TST	R0
	BEQ	10$
	JSR	PC,PLANTL
10$:	BR	MDONE
PCM7:
	MOVB	#'@,(R2)+
	BR	PCM6
MDONE:
	RTS	PC
;
;
;
; CHECK LOCATION COUNTER
;
CHKLC::
	MOV	R1,-(SP)	; SAVE REGISTERS
	MOV	R3,-(SP)
	MOV	#OBLIN2,R1
	CMP	(R1)+,#4	; RLD RE
	BNE	100$
10$:	CMP	R1,OBLEN2
	BGE	100$
	CMP	R1,#OBLEN2-1
	BHI	100$
	MOVB	(R1),R3
	BIC	#177600,R3	; ISOLATE RLD TYPE
	CMP	R3,#10		; LC MODIFICATION ?
	BNE	30$
	JSR	PC,RLDLC	; YES - PROCESS MODIFICATION
30$:	JSR	PC,INCREL	; STEP ON TO NEXT RLD ENTRY
	BR	10$		; AND REPEAT
100$:	MOV	(SP)+,R3	; RESTORE REGISTERS
	MOV	(SP)+,R1
	RTS	PC
;
; PROCESS LC MODIFICATION
; ON ENTRY: R1 POINTS TO RLD ENTRY
;
RLDLC::
	MOV	#OCOBUF,R5
	MOV	2(R1),(R5)	; SET NEW LC
	SUB	MACLC,(R5)	; FIND THE DIFFERENCE
	JSR	PC,MODLC	; MODIFY LC
	MOV	PSNUM,MACPS	; RESTORE PS/LC
	MOV	2(R1),MACLC
	MOV	2(R1),NXTLC
	ADD	#2,NXTLC
	RTS	PC
;
; CHECK PSECT
;
CHKPS::
	MOV	R1,-(SP)	; SAVE REGISTERS
	MOV	R3,-(SP)
	MOV	#OBLIN2,R1
	CMP	(R1)+,#4
	BNE	100$
10$:	CMP	R1,OBLEN2
	BGE	80$
	CMP	R1,#OBLEN2-1
	BHI	80$
	MOVB	(R1),R3
	BIC	#177600,R3	; ISOLATE RLD TYPE
	CMP	R3,#7		; PSECT DEFINITION?
	BEQ	70$
30$:	JSR	PC,INCREL	; INCREMENT REL POINTER
	BR	10$
70$:
	CMP	OBJLIN,#4	; OBJLIN
	BNE	75$		; NO
	CMP	#7,OBJLIN+2
	BNE	75$		; NO
	MOV	#OBJLIN+4,R1	; YES RE
	JSR	PC,RLDPS
	BR	100$		; NOW EX
75$:	TST	(R1)+		; POINT
	JSR	PC,RLDPS
80$:	MOV	#OBLIN2,R1
	MOV	#OBLEN2,R2
	JSR	PC,RD$OBJ	; READ A LINE
	BCC	90$
	BR	100$
;	JMP	EOM
90$:	MOV	#OBLIN2,R1
	CMP	(R1)+,#4	; IS IT RLD?
	BNE	100$
	CMP	(R1)+,#7	; IF SO,
	BNE	100$
	JSR	PC,RLDPS	; PROCES
100$:	MOV	(SP)+,R3
	MOV	(SP)+,R1
	RTS	PC
;
; GET INSTRUCTION
;
GETINS::CMP	R1,OBJLEN
	BLT	10$
	JSR	PC,CHKLC
	MOV	MACLC,OLDLC	; SAVE CURRENT LC
	MOV	MACPS,OLDPS	; AND PSECT NO.
	JSR	PC,CHKPS
	JSR	PC,NOMORE
	BCS	100$		; BRANCH IF EOM SEEN
	MOV	LOADAD,MACLC	; SET UP NEW LC FROM LOAD ADDRESS
	MOV	MACLC,NXTLC
	ADD	#2,NXTLC
	CMP	OLDPS,MACPS	; SAME PSECT AS BEFORE?
	BNE	10$
	CMP	OLDLC,MACLC	; IF SO - COMPARE OLD AND NEW LC'S
	BEQ	10$		; EQUAL - BRANCH
	MOV	#OCOBUF,R5	; NEED TO REDEFINE LC
	MOV	MACLC,(R5)
	SUB	OLDLC,(R5)	; HOW MUCH TO UPDATE BY
	MOV	MACLC,R4	; SAVE NEW LC
	MOV	OLDLC,MACLC	; SET OLD LC
	JSR	PC,MODLC	; MODIFY LC
	MOV	#MACPS,R2
	MOV	PSNUM,(R2)+	; RESET CURRENT PS
	MOV	R4,(R2)+	; AND LC
	MOV	R4,NXTLC
	ADD	#2,NXTLC
10$:	MOVB	(R1)+,CURINS
	MOVB	(R1)+,CURINS+1
	MOV	#MACLIN,R2
	FTAB
;
	.IF DF	O$$FLP
	MOV	FLIPS,R0	; CHECK FOR A FLIP
	BEQ	50$
	MOV	#FLIPS+2,R3
20$:	CMP	MACPS,(R3)+
	BNE	30$
	CMP	MACLC,(R3)
	BEQ	40$
30$:	TST	(R3)+
	SOB	R0,20$
	BR	50$
40$:	INC	DIFLAG		; FLIP DIFLAG
	BIC	#177776,DIFLAG
50$:
	.ENDC	; DF O$$FLP
;
	CLC
100$:	RTS	PC
;
; INCREL - INCREMENT RLD POINTER
; ON ENTRY: R1 POINTS TO RLD RECORD
;	    R3 IS RLD TYPE
;
INCREL::
	CMP	R3,#17		; COMPLEX REL?
	BEQ	10$
	TST	R3
	BLE	100$
	CMP	R3,#16.
	BHI	100$
	MOVB	INCRLD-1(R3),R3
	ADD	R3,R1
	BR	100$
10$:	ADD	#2,R1		; STEP OVER RLD TYPE AND DISP
20$:	MOVB	(R1)+,R3	; STEP THROUGH RECORD
	CMP	R3,#12		; TERMINATOR?
	BEQ	100$		; YES - EXIT
	BLT	20$		; OPERATOR - NEXT BYTE
	CMP	R3,#13		; TERMINATOR?
	BEQ	100$		; YES - EXIT
	NEG	R3		; FETCH TYPE COMMAND - 16-20
	ADD	#22,R3		; CONVERT TO RANGE 2-4
	ADD	R3,R1		; STEP ON POINTER
	BR	20$		; NEXT BYTE
100$:
	BIT	#1,R1		; odd address (can cause problems)
	BEQ	110$		; ok
	MOV	#177776,R1	; some kind of error, get next record
110$:
	RTS	PC
;
; DEFINE MACRO TO SEARCH OP TABLE
;
	.MACRO	SEARCH,XOPTAB
	MOV	#XOPTAB,R3
	JSR	PC,SRCHOP
	.ENDM	SEARCH
;
; INTERPRET TEXT RECORDS
;
INTTXT::
	MOV	(R1)+,MACLC
	MOV	MACLC,LOADAD
	MOV	MACLC,NXTLC
GO:	ADD	#2,NXTLC
	JSR	PC,GETINS	; GET AN INSTRUCTION
	BCC	1$
	RTS	PC		; RETURN IF EOM SEEN
;
1$:
	TST	DIFLAG		; DATA OR INSTRUCTION?
	BEQ	2$
	JMP	DATAPS
2$:	MOV	CURINS,R0
	BIC	#107777,R0
	SEARCH	OPTAB1
	BCS	10$
	MOV	CURINS,R0
	JSR	PC,WB
5$:	MOV	CURINS,R0
	ASH	#-6,R0
	BIC	#177700,R0
	JSR	PC,AMODE	; PROCESS
6$:	MOVB	#',,(R2)+
7$:	MOV	CURINS,R0
	BIC	#177700,R0
	JSR	PC,AMODE	; PROCESS
	JMP	OPMACL
10$:	MOV	CURINS,R0
	BIC	#7777,R0
	SEARCH	OPTAB2
	BCC	5$
	MOV	CURINS,R0
	BIC	#777,R0
	SEARCH	OPTAB3
	BCS	30$
	MOV	CURINS,R0
	BIC	#177700,R0
	JSR	PC,AMODE
	MOVB	#',,(R2)+
	MOV	CURINS,R0
	ASH	#-6,R0
	BIC	#177770,R0
	JSR	PC,REG	
	JMP	OPMACL
;
30$:	MOV	CURINS,R0
	BIC	#777,R0
	SEARCH	OPTABX
	BCS	35$
	MOV	CURINS,R0
	ASH	#-6,R0
	BIC	#177770,R0
	JSR	PC,REG
	BR	6$
;
35$:	MOV	CURINS,R0
	BIC	#777,R0
	SEARCH	OPTABY
	BCS	40$
	MOV	CURINS,R0
	ASH	#-6,R0
	BIC	#177770,R0
	JSR	PC,REG
	MOVB	#',,(R2)+
	MOV	CURINS,R0
	BIC	#177700,R0
	NEG	R0
	JSR	PC,OFFSET
	JMP	OPMACL
;
40$:	MOV	CURINS,R0
	CLRB	R0
	SEARCH	OPTAB4
	BCS	45$
	MOVB	CURINS,R0
	JSR	PC,OFFSET
	JMP	OPMACL
;
45$:	MOV	CURINS,R0
	CLRB	R0
	SEARCH	OPTABZ
	BCS	50$
	CLR	OCOBUF
	MOVB	CURINS,OCOBUF
46$:	JSR	PC,OCO
	MOV	#OCOBUF,R5
48$:	MOVB	(R5)+,(R2)+
	SOB	R0,48$
	JMP	OPMACL
;
50$:	MOV	CURINS,R0
	BIC	#100077,R0
	SEARCH	OPTAB5
	BCS	60$
	MOV	CURINS,R0
	JSR	PC,WB
	JMP	7$
;
60$:	MOV	CURINS,R0
	BIC	#77,R0
	SEARCH	OPTAB6
	BCS	65$
	JMP	7$
;
65$:	MOV	CURINS,R0
	BIC	#77,R0
	SEARCH	OPTABP
	BCS	70$
	MOV	CURINS,OCOBUF
	BIC	#177700,OCOBUF
	BR	46$
;
70$:	MOV	CURINS,R0
	BIC	#7,R0
	SEARCH	OPTAB7
	BCS	75$
	MOV	CURINS,R0
	BIC	#177770,R0
	JSR	PC,REG
79$:	JMP	OPMACL
;
75$:	MOV	CURINS,R0
	BIC	#7,R0
	SEARCH	OPTABQ
	BCS	80$
	MOV	CURINS,OCOBUF
	BIC	#177770,OCOBUF
	BR	46$
;
80$:	MOV	CURINS,R0
	SEARCH	OPTAB8
	BCC	79$
;
CCODES:	MOV	CURINS,R0
	BMI	60$
	CMP	R0,#240
	BLE	INVOP
	CMP	R0,#300
	BGE	INVOP
	BIT	#20,R0
	BNE	10$
	MOVB	#'C,R3
	MOVB	#'L,R4
	BR	20$
10$:	MOVB	#'S,R3
	MOVB	#'E,R4
20$:	BIC	#177760,R0
	CMP	R0,#17
	BNE	30$
	MOVB	R3,(R2)+
	MOVB	#'C,(R2)+
	MOVB	#'C,(R2)+
	BR	OPMACL
30$:	MOV	R1,-(SP)	; SAVE R1
	CLR	OCOBUF		; USE OCOBUF AS FLAG
	MOV	#1,R1		; BIT TO BE TESTED
	MOV	#4,R5		; LOOP COUNTER
40$:	BIT	R1,R0
	BEQ	50$
	CMP	OCOBUF,#1
	BLT	45$
	BGT	44$
	MOVB	-(R2),-(SP)	; PUT THE INSTRUCTION ON THE STACK
	MOVB	-(R2),-(SP)
	MOVB	-(R2),-(SP)
	MOV	#".W,(R2)+
	MOV	#"OR,(R2)+
	MOV	#"D ,(R2)+
	MOV	#"  ,(R2)+
	MOVB	(SP)+,(R2)+	; NOW PUT IT BACK AGAIN
	MOVB	(SP)+,(R2)+
	MOVB	(SP)+,(R2)+
44$:	MOVB	#'!,(R2)+
45$:	MOVB	R3,(R2)+
	MOVB	R4,(R2)+
	MOVB	CCS-1(R5),(R2)+
	INC	OCOBUF
50$:	ASL	R1
	SOB	R5,40$
	MOV	(SP)+,R1	; RESTORE R1
	BR	OPMACL
60$:
;
;  NOT CC INSTRUCTION SO LOOK FOR FPP INS
;
	BIC	#377,R0
	SEARCH	OPTAB9
	BCS	INVOP
	MOV	CURINS,R0
	BIC	#377,R0		; CHECK
	MOV	#4,R3
	MOV	#FPPTRA,R4	; TRANSP
70$:	CMP	(R4)+,R0
	BEQ	SETFI		; TRANSP
	SOB	R3,70$
	MOV	CURINS,R0	; O/P SS
	BIC	#^C77,R0	; ISOLAT
	JSR	PC,AMODE
	MOVB	#',,(R2)+	; O/P ,
	MOVB	#'%,(R2)+	; PREFIX
				; TO DIF
	MOV	CURINS,R0
	ASH	#-6,R0		; GET RE
	BIC	#^C3,R0		; ISOLAT
	ADD	#60,R0
	MOVB	R0,(R2)+	; PUT RE
	BR	OPMACL		; OP INS
SETFI:
;
;  FPP INSTRUCTION IS SETF SO O/P OPERAND
;
	MOV	CURINS,R0
	ASH	#-6,R0
	BIC	#^C3,R0
	ADD	#60,R0
	MOVB	#'%,(R2)+
	MOVB	R0,(R2)+
	MOVB	#',,(R2)+
	MOV	CURINS,R0
	BIC	#^C77,R0
	JSR	PC,AMODE
	BR	OPMACL
INVOP:	MOV	CURINS,OCOBUF
	JSR	PC,OCO
	MOV	#OCOBUF,R5
	MOV	#6,R4
	SUB	R0,R4
	BEQ	7$
6$:	MOVB	#'0,(R2)+
	SOB	R4,6$
7$:	MOVB	(R5)+,(R2)+
	SOB	R0,7$
	MOV	#INVOPL,R3
	MOV	#28.,R0
10$:	MOVB	(R3)+,(R2)+
	SOB	R0,10$
;
OPMACL:	JSR	PC,WR$SCR
	MOV	NXTLC,MACLC
	JMP	GO
;
	.PSECT	ORCDAT,D
FPPTRA:	.WORD	174000
	.WORD	175000
	.WORD	175400
	.WORD	176000
;
	.PSECT
;
DATAPS::
	CMP	R1,OBJLEN	; CHECK FOR ONLY ONE BYTE LEFT TO DO
	BGT	5$		; BRANCH IF SO
	BIT	#1,MACLC	; IS LC ODD?
	BEQ	30$
5$:	DEC	R1		; REPOSITION POINTER
	MOV	#BYTXT,R4
	MOV	#8.,R0
10$:	MOVB	(R4)+,(R2)+	; ".BYTE"
	SOB	R0,10$
	JSR	PC,SDATRD	; CHECK FOR RELOCATION
	TST	R0
	BPL	20$		; YES - BRANCH
	CLR	OCOBUF
	MOVB	CURINS,OCOBUF
	JSR	PC,OCO		; OTHERWISE OUTPUT OCTAL NUMBER
	MOV	#OCOBUF,R5
15$:	MOVB	(R5)+,(R2)+
	SOB	R0,15$
	CMPB	CURINS,#40	; COULD IT BE ASCII?
	BLT	20$
	CMPB	CURINS,#137
	BGT	20$
	MOV	#ASCLIN,R4	; IF SO, OUTPUT ASCII AS COMMENT
	MOV	#13.,R0
18$:	MOVB	(R4)+,(R2)+
	SOB	R0,18$
	MOVB	CURINS,(R2)+
	MOVB	#'/,(R2)+
20$:	DEC	NXTLC		; NXTLC
	BR	100$		; EXIT
;
30$:	MOV	#WOTXT,R4
	MOV	#8.,R0		; ASSUME ".WORD"
35$:	MOVB	(R4)+,(R2)+
	SOB	R0,35$
	JSR	PC,SDATRD	; CHECK FOR RELOCATION
	TST	R0
	BEQ	100$		; WORD RELOCATED
	BPL	50$		; BYTE RELOCATED
	INC	NXTLC		; NO RELOCATION -
	JSR	PC,SDATRD	; CHECK SECOND BYTE
	DEC	NXTLC
	TST	R0
	BMI	38$		; NO RELOCATION
	CLR	OCOBUF		; 2ND BYTE RELOCATED
	MOVB	CURINS,OCOBUF	; PUT OUT FIRST BYTE
	JSR	PC,OCO
	MOV	#OCOBUF,R5
	MOV	#MACLIN+16.,R2
36$:	MOVB	(R5)+,(R2)+
	SOB	R0,36$
	BR	50$		; NOW DO SECOND BYTE
;
38$:	MOV	CURINS,OCOBUF	; NO RELOCATION
	JSR	PC,OCO		; PUT OUT WORD
	MOV	#OCOBUF,R5
40$:	MOVB	(R5)+,(R2)+
	SOB	R0,40$
	MOV	CURINS,R0
	CMP	R0,#20040	; TWO SPACES?
	BEQ	44$		; YES - OUTPUT ASCII
	MOV	#2,R4		; CHECK FOR ASCII
41$:	CMPB	R0,#40
	BLT	42$
	CMPB	R0,#137
	BLE	43$
42$:	CLRB	R0
	BISB	#40,R0		; CONVERT NON-ASCII CHARS TO SPACES
43$:	SWAB	R0		; TRY THE SECOND BYTE
	SOB	R4,41$
	CMP	R0,#20040	; IF SPACES
	BEQ	100$		; ... THEN NOT ASCII
44$:	MOV	R0,-(SP)	; SAVE ASCII CHARS
	MOV	#ASCLIN,R4	; PUT OUT ASCII COMMENT
	MOV	#13.,R0
45$:	MOVB	(R4)+,(R2)+
	SOB	R0,45$
	MOV	(SP)+,R0	; ASCII
	MOVB	R0,(R2)+
	SWAB	R0
	MOVB	R0,(R2)+
	MOVB	#'/,(R2)+
	BR	100$
50$:	MOV	#MACLIN+8.,R5
	MOV	#BYTXT,R4	; OVERWRITE WORD WITH BYTE
	MOV	#5,R0
55$:	MOVB	(R4)+,(R5)+
	SOB	R0,55$
	MOVB	#',,(R2)+	; COMMA
	INC	NXTLC
	JSR	PC,SDATRD	; CHECK
	DEC	NXTLC
	TST	R0
	BPL	100$
	CLR	OCOBUF
	MOVB	CURINS+1,OCOBUF	; NO REL
	JSR	PC,OCO
	MOV	#OCOBUF,R5
60$:	MOVB	(R5)+,(R2)+
	SOB	R0,60$
100$:
	JSR	PC,WR$SCR
	MOV	NXTLC,MACLC
	JMP	GO
;
;
; MODLC - MODIFY LOCATION COUNTER BY OUTPUTTING
;	.=.+NNNN IF INSTRUCTION OR IF NNNN IS NEGATIVE
;	.BLKB NNNN IF DATA AND NNNN POSITIVE
; ON ENTRY:    R5 -> OCOBUF WHICH CONTAINS OFFSET
; R0 IS CORRUPTED BY THIS ROUTINE
;
MODLC:
	MOV	#MACPS,R2	; OUTPUT LINE
	TST	DIFLAG		; INSTRUCTION?
	BEQ	45$		; BRANCH IF YES
	TST	(R5)		; OFFSET NEGATIVE?
	BMI	45$		; BRANCH IF YES
	CMP	(R2)+,(R2)+	; POINT TO TEXT PART OF LINE
	FTAB
	MOV	#".B,(R2)+	; DATA - USE BLKB
	MOV	#"LK,(R2)+
	MOV	#"B ,(R2)+
	MOV	#"  ,(R2)+
	BR	60$		; PUT IN VALUE
45$:	MOV	#-1,(R2)+
	MOV	#-1,(R2)+
	MOV	#".=,(R2)+	; INSTRUCTION
	TST	(R5)		; USE .=.+NNNN
	BMI	50$
	MOV	#".+,(R2)+
	BR	60$
50$:	MOV	#".-,(R2)+
	NEG	(R5)
60$:	JSR	PC,OCO		; CONVERT TO ASCII
65$:	MOVB	(R5)+,(R2)+	; MOVE INTO LINE
	SOB	R0,65$
	JSR	PC,WR$SCR	; OUTPUT LINE
	RTS	PC
;
; NOMORE - TXT LINE EXHAUSTED - GET SOME MORE
;
NOMORE::
	MOV	R2,-(SP)	; SAVE R2
	TST	EOF
	BNE	200$
	MOV	#OBJLIN,R1
	MOV	#OBLIN2,R2
	CMP	(R2),#3
	BNE	10$
NOW==<BUFSIZ/2>+1
	MOV	#NOW,R0		; LINE 2 IS TXT
5$:	MOV	(R2)+,(R1)+	; MOV LINE 2 INTO LINE 1
	SOB	R0,5$
	SUB	#OFSET,-(R1)
	BR	100$		; GO TO GET NEW LINE 2
;
10$:	CMP	(R2),#6		; LINE 2 = EOM?
	BEQ	200$		; IF SO - FINISHED
20$:
	MOV	#OBJLIN,R1	; READ NEW LINE 1
	MOV	#OBJLEN,R2	;
	JSR	PC,RD$OBJ
	BCS	200$
	MOV	#OBJLIN,R1
	CMP	(R1),#3		; IS IT TXT?
	BEQ	100$
	CMP	(R1),#6		; IS IT EOM?
	BEQ	200$
	CMP	(R1),#4		; IS IT RLD?
	BNE	20$		; NO - READ ANOTHER RECORD
	TST	(R1)+		; POINT TO FIRST RLD ENTRY
30$:	CMP	R1,OBJLEN	; FINISHED PROCESSING?
	BGE	20$
	MOVB	(R1),R3		; GET RLD TYPE
	BIC	#177600,R3
	CMP	R3,#7		; LC DEFINITION?
	BNE	40$
	MOV	R1,-(SP)
	TST	(R1)+		; YES - POINT TO PSECT NAME
	JSR	PC,RLDPS	; PROCESS LC DEFINITION
	MOV	(SP)+,R1
	BR	50$
40$:	CMP	R3,#10		; LC MODIFICATION?
	BNE	50$		; NO OTHER TYPE ALLOWED
	JSR	PC,RLDLC	; PROCESS LC MODIFICATION
50$:	JSR	PC,INCREL	; STEP TO NEXT RLD ENTRY
	BR	30$		; AND REPEAT
100$:
	MOV	#OBLIN2,R1
	MOV	#OBLEN2,R2
	JSR	PC,RD$OBJ
;	BCS	200$
	MOV	#OBJLIN+2,R1
	MOV	(R1)+,LOADAD
	CLC
	BR	300$
200$:
	SEC			; EOM SEEN
300$:
	MOV	(SP)+,R2	; RESTORE R2
	RTS	PC
;
;
OFFSET::ASL	R0		; R0 CON
	ADD	#2,R0
	ADD	MACLC,R0
	MOV	R0,OCOBUF
PLANTL:	CMP	LABELS,#LABMAX
	BGE	20$
	INC	LABELS
	MOV	LABELS,R0
	ASH	#2,R0
	MOV	MACPS,LABELS-2(R0)
	MOV	OCOBUF,LABELS(R0) ; SET LABEL
	TST	OCOBUF
	BNE	40$
	INC	OCOBUF		; 0$ NOT VALID - CALL IT 1$
40$:	JSR	PC,OCO
	MOV	#OCOBUF,R5
10$:	MOVB	(R5)+,(R2)+
	SOB	R0,10$
	MOVB	#'$,(R2)+
	RTS	PC
;
20$:
	BIT	#OV$LAB,$OVSTS	; LABEL
	BNE	30$
	MOV	#ERR16,MESNO	; TELL USER
	JSR	PC,MOCALL
	BIS	#OV$LAB,$OVSTS
30$:	CLR	OCOBUF
	BR	40$
;
;
; PROCESS PSECT DEFINITION
;
RLDPS::
	MOV	R3,-(SP)	; SAVE R3
	MOV	PSECTS,R3
	MOV	#PSECTS+2,R4
	MOV	PSNUM,R0	; GET PSECT NO.
	BEQ	5$		; BRANCH IF FIRST TIME THROUGH
	ASH	#3,R0
	MOV	MACLC,PSECTS(R0); SAVE CURRENT MACLC FOR PSECT
	MOV	PSNUM,R0	; SAVE CURRENT PSECT NO.
	CLR	PSNUM
5$:	INC	PSNUM
	CMP	(R1),(R4)+
	BNE	10$
	CMP	2(R1),(R4)
	BEQ	20$
10$:	ADD	#6,R4
	SOB	R3,5$
20$:	CMP	PSNUM,R0	; SAME PSECT AS BEFORE?
	BNE	21$		; IF SO - DON'T BOTHER WITH IT
	JMP	50$
21$:	MOV	#MACPS,R2
	MOV	#-1,(R2)+
	MOV	#-1,(R2)+
	TST	LSB		; IN LSB?
	BEQ	25$
	MOV	#DSLSB,R3
	MOV	#11.,R5
22$:	MOVB	(R3)+,(R2)+
	SOB	R5,22$
	JSR	PC,WR$SCR
	MOV	#MACLIN,R2
	CLR	LSB
25$:	MOVB	#';,(R2)+
	JSR	PC,WR$SCR	; PUT OUT SEMICOLON
	MOV	#MACLIN,R2
	FTAB
	MOV	#".P,(R2)+
	MOV	#"SE,(R2)+
	MOV	#"CT,(R2)+
	MOV	#"  ,(R2)+
	MOV	R1,-(SP)
	MOV	R2,R0
	JSR	PC,R5ASC	; CONVERT NAME TO ASCII
	MOV	R0,R2		; UPDATE MACRO LINE POINTER
	MOV	(SP)+,R1	; RESTORE OBJECT LINE POINTER
	TST	(R4)+
	TSTB	1(R4)
	BEQ	38$
	BIT	#200,(R4)
	BEQ	30$
	MOV	#",D,(R2)+
	BR	31$
30$:	MOV	#",I,(R2)+
31$:	BIT	#100,(R4)
	BEQ	32$
	MOV	#",G,(R2)+
	MOV	#"BL,(R2)+
	BR	33$
32$:	MOV	#",L,(R2)+
	MOV	#"CL,(R2)+
33$:	MOV	#",R,(R2)+
	BIT	#20,(R4)
	BEQ	34$
	MOV	#"O,,(R2)+
	BR	35$
34$:	MOV	#"W,,(R2)+
35$:	BIT	#4,(R4)
	BEQ	36$
	MOV	#"OV,(R2)+
	MOVB	#'R,(R2)+
	BR	37$
36$:	MOV	#"CO,(R2)+
	MOVB	#'N,(R2)+
37$:	CLRB	1(R4)
	MOV	PSNUM,OLDPS	; SET UP OLDPS=PSECT NO
	CLR	OLDLC		; PREVIOUS OFFSET = 0
	BR	40$
38$:	MOV	PSNUM,R0	; NOT A NEW PSECT -
	MOV	R0,OLDPS	; SET OLD PSECT NO.
	ASH	#3,R0
	MOV	PSECTS(R0),OLDLC ; SET OLD LC
40$:	JSR	PC,WR$SCR
	BIT	#200,(R4)
	BEQ	45$
	MOV	#1,DIFLAG
	BR	50$
45$:	CLR	DIFLAG
	MOV	#1,LSB		; SET UP A LSB
	MOV	#MACLIN,R2
	MOVB	#';,(R2)+
	JSR	PC,WR$SCR
	MOV	#MACLIN,R2
	MOV	#ENLSB,R3
	MOV	#11.,R5
46$:	MOVB	(R3)+,(R2)+
	SOB	R5,46$
	JSR	PC,WR$SCR
50$:	MOV	PSNUM,MACPS
	CMP	(R1)+,(R1)+
	MOV	(R1),MACLC
	MOV	(R1),NXTLC
	ADD	#2,NXTLC
	MOV	(SP)+,R3	; RESTORE R3
	RTS	PC
;
;
SDATRD::
	MOV	R1,-(SP)
	MOV	R3,-(SP)
	MOV	NXTLC,R0
	SUB	LOADAD,R0
	ADD	#2,R0		; CALCUL
	MOV	#OBLIN2,R1
	CMP	(R1)+,#4
	BNE	90$
10$:	CMP	R1,OBLEN2
	BGE	90$
20$:	MOVB	(R1),R3
	CMPB	1(R1),R0
	BEQ	40$
	BIC	#177600,R3
	JSR	PC,INCREL
	BR	10$
40$:	ADD	#2,R1
	CLR	R0		; ANSWER
	TST	R3
	BPL	45$		; WORD R
	INC	R0		; BYTE R
45$:	MOV	R0,-(SP)	; SAVE A
	BIC	#177600,R3
	ASL	R3
	BEQ	80$
	CMP	R3,#30.
	BHI	80$
	JSR	PC,@RLDTYP-2(R3)
	MOV	(SP)+,R0	; RESTOR
	BR	100$
80$:	MOV	(SP)+,R0
90$:	MOV	#-1,R0		; NO REL
100$:	MOV	(SP)+,R3	; RESTOR
	MOV	(SP)+,R1
	RTS	PC
;
; SRCHOP - SEARCH OP TABLE FOR OPCODE
; ON ENTRY: R0 = OPCODE
;	    R2 -> OUTPUT LINE
;	    R3 -> OP TABLE
; ON EXIT:  CC IF OP FOUND (INSERTED IN LINE)
;	    CS IF NOT FOUND
;
SRCHOP::MOV	(R3)+,R4	; GET NO OF CODES IN TABLE
10$:	CMP	(R3)+,R0	; COMPARE CODES
	BEQ	20$
	ADD	#6.,R3
	SOB	R4,10$
	SEC			; CODE NOT FOUND
	BR	30$
20$:	MOV	(R3)+,(R2)+	; MOVE MNEMONIC INTO LINE
	MOV	(R3)+,(R2)+
	MOV	(R3)+,(R2)+
	MOV	#"  ,(R2)+	; NEXT TAB POSITION
	CLC			; SHOW CODE FOUND
30$:	RTS	PC
;
;
;
SRCHRD::
	MOV	R1,-(SP)	; SAVE R
	MOV	R3,-(SP)
	MOV	NXTLC,R0
	SUB	LOADAD,R0	; GET DI
	ADD	#4,R0
	MOV	#OBLIN2,R1
	CMP	(R1)+,#4
	BNE	100$
10$:	CMP	R1,OBLEN2
	BGE	100$
	CMP	R1,#OBLEN2-1
	BHI	100$
	MOVB	(R1),R3
	BIC	#177600,R3
	CMPB	1(R1),R0	; DISP S
	BNE	30$
	ADD	#2,R1		; NOTE: R1 MAY BE ODD
	ASL	R3
	BEQ	100$
	CMP	R3,#30.
	BHI	100$
	JSR	PC,@RLDTYP-2(R3)
	BR	110$
30$:	JSR	PC,INCREL	; INCREMENT REL POINTER
	BR	10$
;
100$:	MOV	#1,R0
	BR	120$
110$:	CLR	R0
120$:	MOV	(SP)+,R3
	MOV	(SP)+,R1
	RTS	PC
;
	.PSECT	ORCDAT,D
;
RLDTYP:	.WORD	RLD1,RLD2,RLD3,RLD4,RLD5,RLD6,RLD7,RLD10
	.WORD	RLD11,RLD12,RLD13,RLD14,RLD15,RLD16,RLD17
;
	.PSECT
RLD1:
	MOV	(R1),OCOBUF
	TST	DIFLAG
	BEQ	10$
	MOV	PSNUM,R0	; FOR DA
	BR	RLDX
10$:	JSR	PC,PLANTL	; FOR IN
	RTS	PC
RLD2:
RLD4:
	MOV	R1,-(SP)
	MOV	R2,R0
	JSR	PC,R5ASC	; CONVERT NAME TO ASCII
	MOV	R0,R2
	MOV	(SP)+,R1
10$:	CMPB	-(R2),#40	; SQUEEZE OUT THE SPACES
	BEQ	10$
	TSTB	(R2)+
	RTS	PC
RLD3:				;
	MOV	(R1),OCOBUF
	JSR	PC,OCO
	MOV	#OCOBUF,R5
10$:	MOVB	(R5)+,(R2)+
	SOB	R0,10$
	RTS	PC
RLD7:				; PSECT DEFINITION - DONE ELSEWHERE
RLD10:				; LC MOD - DONE ELSEWHERE
RLD11:				; PROGRAM LIMITS - IGNORED
RLD13:				; RLD TYPE 13 - UNUSED
	RTS	PC
	.ENABL	LSB
RLD5:
RLD6:
	JSR	PC,RLD4		; GET GL
	CMP	(R1)+,(R1)+	; POINT
	MOV	(R1),OCOBUF
	BEQ	30$
	BLT	RLDM
	MOVB	#'+,(R2)+
	BR	20$
RLDM:	MOVB	#'-,(R2)+
	NEG	OCOBUF
20$:	JSR	PC,OCO
	MOV	#OCOBUF,R5
25$:	MOVB	(R5)+,(R2)+
	SOB	R0,25$
30$:	RTS	PC
	.DSABL	LSB
RLD12:
RLD14:
	CLR	OCOBUF		; OFFSET = 0
	BR	RLDP		; REST IS LIKE TYPES 15/16
	RTS	PC
RLD15:
RLD16:
	MOV	4(R1),OCOBUF	; OFFSET
RLDP:
	MOV	R1,R0
	JSR	PC,GETPS	; GET IT
RLDX:
	MOV	OCOBUF,R3
	BPL	5$
	CLR	OCOBUF
5$:	BIC	#1,OCOBUF	; MAKE SURE ADDRESS IS EVEN
	JSR	PC,PLLL		; PLANT A LOCAL SYMBOL
	ADD	#100,R0		; CONVERT PSECT TO A LETTER
	MOVB	R0,(R2)+	; INSERT IN LINE
	BIS	#100000,OCOBUF	; ENSURE 6 CHARACTERS
	JSR	PC,OCO
	MOV	#OCOBUF+1,R5
	DEC	R0
10$:	MOVB	(R5)+,(R2)+
	SOB	R0,10$
	MOV	R3,OCOBUF
	BMI	RLDM
	BIT	#1,R3		; WAS IT AN ODD ADDRESS ?
	BEQ	20$
	MOVB	#'+,(R2)+	; NEED "+1"
	MOVB	#'1,(R2)+
20$:	RTS	PC
	.ENABL	LSB
RLD17:
	MOV	R4,-(SP)	; SAVE R4
	MOV	#CXSTK1,R4	; POINT TO COMPLEX STACK 1
10$:
	CMP	R4,#CXSTK2-2	;CHECK IF STACK HAS OVERFLOWED
	BHI	100$
	MOVB	(R1)+,R0	; GET OPERATOR
	ASL	R0
	CMP	R0,#32.
	BHI	100$
	JMP	@CXOP(R0)	; PROCESS IT
CX0:
	BR	10$		; NO OP
CX1:
	CLR	(R4)+		; 0 = OPERATOR
	MOV	#'+,(R4)+	; NAME OF OPERATOR
20$:	MOV	#2,(R4)+	; NO. OF OPERANDS
	BR	10$
CX2:
	CLR	(R4)+		; SUBTRACT
	MOV	#'-,(R4)+
	BR	20$
CX3:
	CLR	(R4)+		; MULTIPLY
	MOV	#'*,(R4)+
	BR	20$
CX4:
	CLR	(R4)+		; DIVIDE
	MOV	#'/,(R4)+
	BR	20$
CX5:
	CLR	(R4)+		; LOGICAL AND
	MOV	#'&,(R4)+
	BR	20$
CX6:
	CLR	(R4)+		; LOGICAL OR
	MOV	#'!,(R4)+
	BR	20$
CX10:
	CLR	(R4)+		; NEGATE
	MOV	#'-,(R4)+
30$:	MOV	#1,(R4)+	; NO. OF OPERANDS
	BR	10$
CX11:
	CLR	(R4)+		; COMPLEMENT
	MOV	#"^C,(R4)+
	BR	30$
CX12:
CX13:
	BR	100$		; COMMAND TERMINATORS
CX16:
	MOV	#CXSTK2,R5	; USE AS WORKSPACE
	MOV	#4,R0
40$:	MOVB	(R1)+,(R5)+	; GET RAD50 NAME
	SOB	R0,40$
	MOV	R1,-(SP)
	MOV	#CXNAME,R0
	MOV	#CXSTK2,R1
	JSR	PC,R5ASC
	MOV	(SP)+,R1
	MOV	#CXNAME,R0	; PUT ON TO STACK 1
	MOV	(R0)+,(R4)+
	MOV	(R0)+,(R4)+
	MOV	(R0)+,(R4)+
	BR	10$
CX17:
	MOVB	(R1)+,R0	; GET PSECT NO.
	INC	R0
	MOVB	(R1)+,OCOBUF	; GET OFFSET
	MOVB	(R1)+,OCOBUF+1
	JSR	PC,PLLL		; PLANT LOCAL SYMBOL
	ADD	#100,R0		; CONVERT PSECT TO A LETTER
	MOVB	R0,(R4)+	; INSERT IN LINE
	BIS	#100000,OCOBUF	; ENSURE 6 CHARACTERS
	JSR	PC,OCO
	MOV	#OCOBUF+1,R5
	DEC	R0
50$:	MOVB	(R5)+,(R4)+
	SOB	R0,50$
	BR	10$
CX20:
	MOVB	(R1)+,OCOBUF
	MOVB	(R1)+,OCOBUF+1
	JSR	PC,OCO
	MOV	#6,R3
	MOV	#OCOBUF,R5
60$:	MOVB	(R5)+,(R4)+
	DEC	R3
	SOB	R0,60$
	TST	R3
	BEQ	10$
70$:	MOVB	#40,(R4)+	; PAD OUT WITH SPACES
	SOB	R3,70$
	BR	10$
100$:
	INC	R1
	BIC	#1,R1
	MOV	#1,-(SP)	; ONE OPERATOR TO REVERSE
	MOV	#CXSTK2,R5	; COMPLEX STACK 2
	JSR	PC,REVSTK	; REVERSE THE STACK
	TST	(SP)+		; LOSE PARAMETER
	JSR	PC,PRTITM	; PRINT THE COMPLEX ITEM
	MOV	(SP)+,R4	; RESTORE R4
	RTS	PC
	.DSABL	LSB
;
	.PSECT	ORCDAT,D
CXOP:	.WORD	CX0,CX1,CX2,CX3,CX4,CX5,CX6,CX0
	.WORD	CX10,CX11,CX12,CX13,CX0,CX0,CX16,CX17,CX20
CXSTK1:	.BLKB	20.*6
CXSTK2:	.BLKB	20.*6
CXNAME:	.BLKB	6
;
	.PSECT
;
; REVSTK - COPY STACK 1 TO STACK 2, CONVERTING FROM REVERSE POLISH
; TO FORWARD POLISH.
; R4 -> STACK 1, R5 -> STACK 2
;
REVSTK:
	MOV	-(R4),-(SP)	; GET AN ITEM OFF STACK 1
	MOV	-(R4),-(SP)
	MOV	-(R4),-(SP)
	BNE	10$		; BRANCH IF ITS AN OPERAND
	MOV	4(SP),-(SP)	; OPERATOR - GET NO. OF OPERANDS
	JSR	PC,REVSTK	; COPY THE OPERANDS FIRST
	TST	(SP)+
10$:	MOV	(SP)+,(R5)+	; NOW COPY THE ITEM
	MOV	(SP)+,(R5)+
	MOV	(SP)+,(R5)+
	DEC	2(SP)		; DEC ITEM COUNT
	BGT	REVSTK		; DO NEXT ITEM
	RTS	PC
;
; PRTITM - PRINT THE ITEM ON COMPLEX STACK 2
; R5 -> STACK 2, R2-> OUTPUT LINE
;
PRTITM:
	MOV	-(R5),-(SP)	; GET ITEM OFF STACK 2
	MOV	-(R5),-(SP)
	MOV	-(R5),-(SP)
	BEQ	100$		; BRANCH IF ITS AN OPERATOR
	MOV	#6,R0		; OPERAND - OUTPUT IT
	MOV	SP,R4
10$:	MOVB	(R4)+,(R2)+
	SOB	R0,10$
20$:	CMPB	-(R2),#40	; SQUEEZE OUT THE SPACES
	BEQ	20$
	TSTB	(R2)+
	ADD	#6,SP
	BR	900$		; FINISH
100$:
	CMP	4(SP),#2	; OPERATOR - HOW MANY OPERANDS?
	BNE	200$
	MOVB	#'<,(R2)+	; 2 OPERANDS
	JSR	PC,PRTITM	; OUTPUT FIRST OPERAND
	TST	(SP)+
	MOVB	(SP)+,(R2)+	; OUTPUT THE OPERATOR
	TST	(SP)+
	JSR	PC,PRTITM	; OUTPUT SECOND OPERAND
	MOVB	#'>,(R2)+
	BR	900$		; FINISH
200$:
	TST	(SP)+		; 1 OPERAND
	MOVB	(SP),(R2)+	; OUTPUT OPERATOR
	TSTB	1(SP)
	BEQ	210$
	MOVB	1(SP),(R2)+
210$:	CMP	(SP)+,(SP)+
	JSR	PC,PRTITM	; OUTPUT OPERAND
900$:
	RTS	PC
;
; GET THE PSECT NUMBER
; ON ENTRY: R0 -> PSECT NAME
; ON EXIT:  R0 = PSECT NUMBER
;
GETPS::
	MOV	R1,-(SP)	; SAVE R
	MOV	R2,-(SP)
	MOV	#PSECTS,R2
	MOV	(R2)+,R1
10$:	CMP	(R0),(R2)+
	BNE	20$
	CMP	2(R0),(R2)
	BEQ	40$
20$:	ADD	#6,R2
	SOB	R1,10$
40$:	MOV	PSECTS,R0
	INC	R0
	SUB	R1,R0
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC
;
; PLANT A LOCAL SYMBOL
; ON ENTRY: R0 = PSECT NUMBER, OCOBUF = LOCATION COUNTER
;
PLLL::	
	MOV	R1,-(SP)
	CMP	LLLABS,#LLLMAX
	BGE	10$
	INC	LLLABS
	MOV	LLLABS,R1
	ASH	#2,R1
	MOV	R0,LLLABS-2(R1)
	MOV	OCOBUF,LLLABS(R1)
	BR	20$
;
10$:	BIT	#OV$LLL,$OVSTS	; LLLAB
	BNE	20$
	MOV	#ERR17,MESNO	; TELL USER
	JSR	PC,MOCALL
	BIS	#OV$LLL,$OVSTS
20$:	
	MOV	(SP)+,R1
	RTS	PC
;
; WORD OR BYTE CHECK
; IF TOP BIT OF INSTRUCTION (R0) IS SET - APPEND "B" TO OPCODE
;
WB::	TST	R0
	BPL	10$
	MOVB	#'B,-5(R2)
10$:	RTS	PC
;
;
	.END