	.TITLE	DCOM
	.IDENT	/hah015/
 
;
; VERSION 01
;
; TOM GETZINGER  06-AUG-80
;
; Modified:	07-Nov-83	hah006
;		Handle the library base complex entry
; 		27-Jul-85	hah010
;		Convert SELECT subroutine to support DOB as a I&D space task.
;		17-Aug-85	hah015
;		Call new routine to get a block and extend the task if needed.
;

;
; THIS MODULE DISASSEMBLES COMPLEX RELOCATION
;

	.NLIST	BEX
	.ENABL	LSB

;
; 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	RODATA,RO,D
OPRATR:	.ASCII	"+-*/&!-C"
	.even								;hah010

table:									;hah010
	.BYTE	CT.NOP,ct.max						;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	noop		; NOP					;hah010
	.WORD	math		; ADDITION				;hah010
	.WORD	math		; SUBTRACTION				;hah010
	.WORD	math		; MULTIPLICATION			;hah010
	.WORD	math		; DIVISION				;hah010
	.WORD	math		; AND					;hah010
	.WORD	math		; OR					;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	negcom		; NEGATION				;hah010
	.WORD	negcom		; COMPLEMENT				;hah010
	.WORD	str		; STORE					;hah010
	.WORD	str		; STORE DISPLACED			;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	illcod		; ILLEGAL				;hah010
	.WORD	ftcgbl		; FETCH GLOBAL VALUE			;HAH010
	.WORD	ftcrel		; FETCH RELOCATABLE VALUE		;HAH010
	.WORD	ftcabs		; FETCH ABSOLUTE VALUE			;HAH010
	.word	libbas		;Library base				;hah010
 
	.PSECT	RWDATA,RW,D
LSTOPN:	.BLKW	1		; PONTER TO LAST OPERAND
TEMP:	.BLKW	2		; TEMPORARY STORAGE

	.PSECT	CODE,RO
 
DCOM::	MOV	R2,-(SP)	; SAVE R2
	CLR	LSTOPN		; THERE ARE NO OPERANDS YET
 
noop:	DEC	R4		; ANY MORE TEXT?
	bpl	12$		;Yes, continue				;hah012
	trap	relsiz		;Bad RLD record length			;hah012
12$:									;hah012
	MOVB	(R3)+,R1	; GET THE COMPLEX COMMAND
	select	#table							;hah010
 
ftcgbl:	CALL	ALLOPN		; ALLOCATE AN OPERAND STRING
	MOV	#TEMP,R0
	CALL	GETR50		; GET A RAD50 VALUE
	CALL	ADDR50		; ADD IT TO THE OPERAND STRING
	BR	50$		; AND WE'RE DONE
 
ftcrel:	CALL	ALLOPN		; ALLOCATE AN OPERAND STRING
	CLR	-(SP)		; GET THE PSECT NUMBER
	MOVB	(R3)+,(SP)
	DEC	R4		; ANY MORE TEXT?
	bpl	48$		;Yes, continue				;hah012
	trap	relsiz		;No, abort				;hah012
48$:									;hah012
	CALL	GETWRD		; GET THE ADDRESS
	MOV	R0,R1
	MOV	(SP)+,R0	; GET THE PSECT NUMBER
	CALL	ADDSYM		; ADD A SYMBOL TO THE OPERAND STRING
	BR	50$		; AND WE'RE DONE
 
ftcabs:	CALL	ALLOPN		; ALLOCATE AN OPERAND STRING
	CALL	GETWRD		; GET THE VALUE
	CALL	ADDOCT		; AND ADD IT TO THE OPERAND STRING
 
50$:	CLRB	(R5)		; SET THE STRING END INDICATOR
	BR	noop		; AND GO PROCESS THE NEXT COMMAND
 
illcod:	TRAP	OBJFMT		; STACK OVERFLOW OR UNDERFLOW
 
negcom:	MOV	R1,-(SP)	; SAVE THE COMPLEX COMMAND
	MOV	LSTOPN,R5	; GET THE POINTER TO THE LAST OPERAND
	bne	66$		;Continue				;hah012
	trap	misopr		;Missing operand			;hah012
66$:									;hah012
	MOVB	3(R5),R1	; GET THE OPERAND LENGTH
	INC	R1		; MAKE ROOM FOR THE OPERATOR
	CMPB	(SP),#CT.COM	; IS THE OPERATOR '^C'?
	BNE	70$		; NO
	INC	R1		; YES, SO MAKE ROOM FOR THE SECOND CHARACTER
70$:	CMPB	2(R5),#2	; IS THE OPERAND A BINARY EXPRESSION?
	BNE	80$		; NO
	ADD	#2,R1		; YES, SO MAKE ROOM FOR THE PARENTHESES
80$:	MOV	#FREEHD,R0
	NEG	R1		; SET FIRST-FIT FLAG
;	CALL	$RQCB		; GET A MEMORY BLOCK FOR THE OPERAND	;hah015
;	BCS	145$		; THERE WASN'T ENOUGH MEMORY		;hah015
	call	getblk		;Get a memory block for the operand	;hah015
	MOV	R0,LSTOPN	; THIS IS THE NEW LAST OPERAND
	MOV	(R5),(R0)+	; SETUP LINK
	MOVB	#1,(R0)+	; SET UNARY EXPRESSION INDICATOR
	MOVB	R1,(R0)+	; SAVE OPERAND LENGTH
	MOV	(SP)+,R1	; RESTORE THE COMPLEX COMMAND
	CMPB	R1,#CT.COM	; IS IT '^C'?
	BNE	90$		; NO
	MOVB	#'^,(R0)+	; YES, SO OUTPUT THE FIRST CHARACTER
90$:	MOVB	OPRATR-CT.ADD(R1),(R0)+ ; ADD THE OPERATOR
95$:	CMPB	2(R5),#2	; IS THE OPERAND A BINARY EXPRESSION?
	BNE	100$		; NO
	MOVB	#'<,(R0)+	; YES, SO ADD A PARENTHESIS
100$:	MOV	R5,R1
	ADD	#4,R1		; POINT TO TEXT
110$:	MOVB	(R1)+,(R0)+	; ADD THE OLD OPERAND
	BNE	110$		; UNTIL WE HIT A NULL
	CMPB	2(R5),#2	; IS THE OLD OPERAND A BINARY EXPRESSION?
	BNE	115$		; NO
	DEC	R0		; YES
	MOVB	#'>,(R0)+	; SO ADD A CLOSE PARENTHESIS
	CLRB	(R0)
115$:	MOV	#FREEHD,R0
	MOVB	3(R5),R1	; GET OLD OPERAND LENGTH
	MOV	R5,R2		; GET OLD OPERAND ADDRESS
	CALL	$RLCB		; AND FREE IT
	BR	noop		; AND GO PROCESS THE NEXT COMMAND
 
math:	MOVB	OPRATR-CT.ADD(R1),-(SP) ; SAVE OPERATOR
	MOV	LSTOPN,R5	; GET POINTER TO LAST OPERAND
	bne	128$		;Continue				;hah012
	trap	misopr		;Missing oerand				;hah012
128$:									;hah012
	MOV	(R5),R2		; GET POINTER TO OPERAND BEFORE THAT
	MOVB	3(R5),R1	; GET THE LENGTH OF THE SECOND OPERAND
	MOVB	3(R2),R0	; GET THE LENGTH OF THE FIRST OPERAND
	ADD	R0,R1		; ADD THE LENGTHS
	SUB	#4,R1
	CMPB	2(R5),#2	; IS THE 2ND OPERAND A BINARY EXPRESSION?
	BNE	130$		; NO
	ADD	#2,R1		; YES, SO MAKE ROOM FOR PARENTHESES
130$:	MOV	#FREEHD,R0
	NEG	R1		; SET FIRST-FIT INDICATOR
;	CALL	$RQCB		; GET A MEMORY BLOCK FOR THE NEW OPERAND;hah015
;	BCS	145$		; THERE WASN'T ENOUGH MEMORY		;hah015
	call	getblk		;Get a memory block for the new operand	;hah015
	MOV	R0,LSTOPN	; SET NEW LAST OPERAND POINTER
	MOV	(R5),R2		; GET POINTER TO FIRST OPERAND
	MOV	(R2),(R0)+	; SETUP BACK LINK
	MOVB	#2,(R0)+	; SET BINARY EXPRESSION FLAG
	MOVB	R1,(R0)+	; SAVE OPERAND LENGTH
	MOV	R2,R1
	ADD	#4,R1		; POINT TO TEXT FOR 1ST OPERAND
140$:	MOVB	(R1)+,(R0)+	; AND COPY IT
	BNE	140$		; UNTIL WE HIT A NULL
	DEC	R0		; BACK UP TO THE NULL
	MOVB	(SP)+,(R0)+	; ADD THE OPERATOR
	MOV	R0,-(SP)	; SAVE R0
	MOV	#FREEHD,R0
	MOVB	3(R2),R1	; GET THE 1ST OPERAND LENGTH
	CALL	$RLCB		; AND FREE THE 1ST OPERAND
	MOV	(SP)+,R0	; RESTORE R0
	BR	95$		; GO ADD THE 2ND OPERAND
 
;145$:	TRAP	NOMEM		; WE RAN OUT OF MEMORY			;hah015
 
str:	MOV	LSTOPN,R5	; GET OPERAND POINTER
	bne	155$		;Continue				;hah012
	trap	misopr		;Missing operand			;hah012
155$:									;hah012
	TST	(R5)		; IS THERE ONLY ONE?
	beq	158$		;Yes, continue				;hah012
	trap	toomny		;Too many operands
			;hah012
158$:									;hah012
	MOV	#FREEHD,R0
	MOVB	3(R5),R1
	NEG	R1		; SET FIRST-FIT FLAG
;	CALL	$RQCB		; GET A MEMORY BLOCK FOR THE TEXT STRING;hah015
;	BCS	145$		; THERE WAS'NT ENOUGH MEMORY		;hah015
	call	getblk		;Get a memory block for the text string	;hah015
	MOV	(SP)+,R2	; RESTORE R2
	MOV	R0,T.STR(R2)	; SAVE TEXT POINTER
	MOVB	R1,(R0)+	; SAVE TEXT LENGTH
	ADD	#4,R5		; POINT TO OPERAND STRING
160$:	MOVB	(R5)+,(R0)+	; COPY THE TEXT STRING
	BNE	160$		; UNTIL WE HIT A NULL
	CMPB	-1(R3),#CT.STD	; IS THE TEXT DISPLACED?
	BNE	170$		; NO
	BIS	#TF.DSP,T.FLAG(R2) ; YES, SO SET THE DISPLACED FLAG
170$:	RETURN			; WE'RE DONE

libbas:	call	allbas		;Get a block to store text		;hah006
	mov	#base,r0	;Point to the string to copy		;hah006
	call	append		;Copy it into buffer			;hah006
	jmp	50$		;Finish up				;hah006

allbas:
	mov	#13.,r1		;Length of message+4 bytes		;hah006
	br	allcom		;Finish in common code			;hah006
 
ALLOPN:
	MOV	#-11.,R1
allcom:									;hah006
	MOV	#FREEHD,R0
;	CALL	$RQCB		; GET A TEXT BLOCK FOR THE OPERAND	;hah015
;	BCS	145$		; THERE WASN'T ENOUGH MEMORY		;hah015
	call	getblk		;Get a text block for the operand	;hah015
	MOV	R0,R5		; SAVE OPERAND POINTER
	MOV	LSTOPN,(R5)+	; SET BACK POINTER
	MOV	R0,LSTOPN	; SET NEW LAST OPERAND
	CLRB	(R5)+		; SET OPERAND FLAG
	MOVB	R1,(R5)+	; SAVE OPERAND LENGTH
	RETURN			; AND WE'RE DONE
 
	.END
