.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01+
	.TITLE	AS3D
	.ident	/X01.07/

	.NLIST	BEX
	.ENABL	LC,GBL
	.LIST	MEB,CND						;01-

;
; AS
; CODE MANAGEMENT
;
; VERSION X01
;
; DAVID G. CONROY	02-NOV-77
; LAST UPDATED:		14-SEP-79
;			REPLACE CALL TO "$CAT5"
;
; Edit history
; 01 04-Mar-80 MM	Added RT11 support
; 02 02-Jul-80 MM	Signed division requires sign extension
; 03 26-Feb-81 MM	Added .ident
; 04 26-Feb-82 RBD	Changes for binary tree UST
; 05 29-Jul-82 NWE	Added support for ISD emission
; 06 31-Jul-82 MM	Support '_' marking for C symbols
; 07 07-Aug-82 MM	Hashed symbol table
;

	.GLOBL	GSD
	.GLOBL	WRAPUP
	.GLOBL	PUTB
	.GLOBL	PUTW
	.GLOBL	PUTWA
	.GLOBL	FTAR1
	.GLOBL	CURPS
	.GLOBL	NXTPS
	.GLOBL	LIM
	.GLOBL	OBJIO						;05
	.GLOBL	CAT5B						;03

.IF NE	RSX							;01
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
.ENDC								;01

; EQUIVALENCES
; OBJECT FILE RECORD TYPES

TYGSD	=	1		;GLOBAL SYMBOL DIRECTORY
TYENDG	=	2		;GLOBLA SYMBOL DIRECTORY END
TYTXT	=	3		;TEXT
TYRLD	=	4		;RELOCATION
TYISD	=	5		;INTERNAL SYMBOL DIRECTORY
TYENDM	=	6		;END MODULE

; RELOCATION TYPES

RLINT	=	1		;INTERNAL
RLABD	=	3		;ABSOLUTE DISPLACED
RLGBA	=	5		;GLOBAL SYMBOL ADDITIVE
RLGAD	=	6		;GLOBAL SYMBOL ADDITIVE DISPLACED
RLLCD	=	7		;LOCATION COUNTER DEFINITION
RLLIM	=	11		;PROGRAMME LIMITS
RLPSA	=	15		;PSECTION ADDITIVE
RLPAD	=	16		;PSECTION ADDITIVE DISPLACED

; GSD ITEM TYPES

GSMOD	=	0		;MODULE NAME
GSISD	=	2		;INTERNAL SYMBOL NAME
GSXFR	=	3		;TRANSFER ADDRESS
GSGSD	=	4		;GLOBAL SYMBOL NAME
GSPSD	=	5		;PSECT
GSIDN	=	6		;.IDENT					;03

; DATA
; BUFFERS
; ASSORTED CONSTANTS AND RECORDS
; DIAGNOSTICS

ENDG:	.WORD	TYENDG		;END GSD RECORD
ENDM:	.WORD	TYENDM		;END MODULE RECORD

ABS:	.BLKW	3		;DUMMY SYMBOL TABLE NODE FOR '. ABS.'
	.ASCII	". ABS.  "

REL:				;FOR BUILDING RLD RECORDS
ITEM:	.BLKW	4		;FOR BUILDING GSD ITEMS
TPTR:	.BLKW	1		;TBUF POINTER
RPTR:	.BLKW	1		;RBUF POINTER
CURPS:	.BLKW	1		;POINTER TO CURRENT PSECTION
NXTPS:	.BLKW	1		;POINTER TO NEXT PSECTION

TBUF:	.WORD	TYTXT		;TEXT
	.BLKW	1		;STUFFED WITH LOAD ADDRESS
	.BLKW	19.
TBUFND:

RBUF:	.WORD	TYRLD		;RELOCATION
	.BLKW	19.
RBUFND:


MSG01:	.ASCIZ	":"
MSG02:	.ASCIZ	"Object file I/O error!"

	.EVEN

;+
; ** GSD - FORMAT GSD RECORDS
;
; THIS ROUTINE IS CALLED AT THE END OF PASS 2. THE SIZES OF ALL
; PSECTIONS HAVE BEEN DETERMINED.  IT BUILDS GSD ITEMS AND PUTS
; THEM OUT TO THE OBJECT FILE. AT THE END OF THE GSD AN END GSD
; ITEM GOES OUT, THEN A RLD RECORD CONTAINING A LOCATION COUNT-
; ER SWITCH TO THE FIRST (DEFAULT) PSECTION.
;
; OF COURSE,  OF THE -N OPTION (NFLAG)  IS PRESENT NONE OF THIS
; IS REQUIRED.
;
; USES:
;	ALL
;-
.if ne	0
	.mcall	.print,.ttyout
foo1:	.ascii /put out the ident:	"/
	.byte	200
foo2:	.ascii /pst definition:		"/
	.byte	200
foo3:	.ascii /names in this psect:	"/
	.byte	200
foo4:	.ascii /global ref or abs sym:	"/
	.byte	200
foo5:	.ascii	/global ref/
	.byte	0
foo7:	.asciz	/global def/
	.even
.iftf

GSD:	TSTB	NFLAG		;-N
	BNE	5$		;NO, DO IT				;07
	JMP	140$		;YES, SKIP THIS MESS			;07
5$:				;					;07
	MOV	#TBUF+4,R0	;START OFF THE FIRST RECORD
	MOV	#TYGSD,(R0)+	;TYPE IS GSD
	MOV	TITLE,(R0)+	;PUT OUT TITLE RECORD TO INSURE
	MOV	TITLE+2,(R0)+	;NON NULL GSD
	CLR	(R0)+
	CLR	(R0)+
	MOV	R0,TPTR		;SAVE BUFFER POINTER

	MOV	IDENT,ITEM	;PUT OUT THE .IDENT		;03+
	MOV	IDENT+2,ITEM+2	;BOTH WORDS
	MOV	#GSIDN*400+0,ITEM+4 ; .IDENT TYPE
	CLR	ITEM+6		;
	CALL	PUTITM		;OUTPUT IT			;03-/07

; LOOP THROUGH ALL OF THE PSECTIONS, PUTTING OUT PSECTION DEFN.
; RECORDS; THEN SEARCH THE USER SYMBOL TABLE FOR ALL NAMES WITH
; THE CORRECT TYPE AND PUT THEM OUT.
; (Registers were changed around, but not noted by edit marks)	;07

	MOV	#PSECT2,R3	;R3 -> POINT AT PSECTIONS	;01
10$:	CMP	R3,PSECT	;LOOP TIL ALL DONE
	BHIS	50$

	MOVB	P.F(R3),ITEM+4	;PSECTION FLAGS
	MOVB	#GSPSD,ITEM+5	;PSECTION DEFINITION
	MOV	P.L(R3),ITEM+6	;PSECTION LENGTH
	MOV	R3,R0		;FILL IN RAD50 NAME
	ADD	#P.N,R0		;TABLE STYLE NODE		;04
.ift
	mov	r0,-(sp)
	.print	#foo2
	mov	(sp),r0
	.print
	mov	(sp)+,r0
.iftf
	CALL	PUTGSD

	CLR	R0		;HIGH-ORDER DIVIDEND		;02
	MOV	R3,R1		;COMPUTE THE TYPE A SYMBOL WILL
	SUB	#PSECT2,R1	;HAVE IF IT IS IN THIS PSECTION	;01
	BPL	15$		;CONTINUE IF POSITIVE		;02
	COM	R0		;NEG. SIGN-EXTEND R0		;02
15$:								;02
	MOV	#P.N+8.,-(SP)
	CALL	$DIVR0
	TST	(SP)+
	MOV	R0,R2		;AND SAVE IT IN R2
	ADD	#ST.REL,R2
	MOV	#20$,R5		;Loop through all symbols		;07+
	CALL	SYWALK		;Do it
	ADD	#P.SIZE,R3	;Go for the next psect
	BR	10$		;Back for more

20$:	CMP	R5,#DOT		;NEVER PUT '.' IN SYMBOL TABLE
	BEQ	45$
	CMP	S.T(R5),R2	;INSURE CORRECT PSECTION
	BNE	45$
	MOVB	#PF.REL+PF.BT3,ITEM+4	;REL + DEF		;01
	BIT	#SF.GBL,S.F(R5)	;IS IT GLOBAL OR LOCAL
	BEQ	30$		;LOCAL
	BIS	#PF.GBL,ITEM+4	;GLOBAL, SET THE BIT, TOO	;01
.ift
	mov	r0,-(sp)
	.print	#foo7
	mov	(sp)+,r0
.iftf
	MOVB	#GSGSD,ITEM+5	;GLOBAL, SET GLOBAL DEFINITION
	BR	40$

30$:	MOVB	#GSISD,ITEM+5	;LOCAL,  SET INTERNAL DEFINTION
40$:	MOV	S.V(R5),ITEM+6	;ADDRESS
	MOV	S.N(R5),R0	;TREE STYLE NODE
.ift
	mov	r0,-(sp)
	.print	#foo3
	mov	(sp),r0
	.print
	mov	(sp)+,r0
.iftf
	CALL	PUTID		;FILL IN NAME, PUT IT OUT	;06

45$:	RETURN							;04-/07-

; NOW PUT OUT THE ABSOLUTE SYMBOLS AND GLOBAL REFERENCES. A PSECT
; SELECT FOR '. ABS.' GOES OUT FIRST (IN CASE THERE ARE ABSOLUTES
; IN THE CROWD). THE REFERENCES CAN GO ANYWHERE.

50$:	MOVB	#PF.GBL+PF.BT3+PF.OVR,ITEM+4	;SELECT .ASECT	;01
	MOVB	#GSPSD,ITEM+5
	CLR	ITEM+6
	MOV	#ABS+P.N,R0	;TABLE STYLE NODE			;04
	CALL	PUTGSD
	MOV	#60$,R5		;Walk the table again			;07+
	CALL	SYWALK		;Do it
	BR	120$		;Onward

60$:	CMP	S.T(R5),#ST.ABS	;IS THIS AN ABSOLUTE SYMBOL
	BNE	90$		;NO
	MOVB	#PF.GBL+PF.BT3,ITEM+4	;YES, DEF + ABS		;01
	BIT	#SF.GBL,S.F(R5)	;GLOBAL OR LOCAL
	BEQ	70$		;BR ON LOCAL
	MOVB	#GSGSD,ITEM+5	;MAKE GLOBAL DEFINITION
	BR	80$
70$:	MOVB	#GSISD,ITEM+5	;MAKE INTERNAL DEFINTION
80$:	MOV	S.V(R5),ITEM+6	;VALUE
	BR	100$

90$:	CMP	S.T(R5),#ST.UND	;UNDEFINED
	BNE	105$		;NO
	BIT	#SF.GBL,S.F(R5)	;IS IT UNDEFINED GLOBAL
	BEQ	105$		;NO
.ift
	.print	#foo5
.iftf
	MOVB	#PF.GBL,ITEM+4	;REF				;01
	MOVB	#GSGSD,ITEM+5	;GLOBAL SYMBOL REFERENCE
	CLR	ITEM+6		;VALUE IS IGNORED, BUT BE NEAT
100$:	MOV	S.N(R5),R0	;TREE STYLE NODE
.ift
	mov	r0,-(sp)
	.print	#foo4
	mov	(sp),r0
	.print	r0
	mov	(sp)+,r0
.endc
	CALL	PUTID		;FILL IN NAME, PUT OUT RECORD	;06
105$:	RETURN							;07-

; IF THERE WAS A .ENTRY STATEMENT (ETYPE IS NON ZERO) PUT OUT
; AN ENTRY DEFINITION ITEM. ABSOLUTE THINGS WORK, BUT I DON'T
; EXPECT THEM TO BE USEFUL.

120$:	MOV	ETYPE,R1	;GET ENTRY TYPE
	BEQ	135$		;TIS NONE
	CLRB	ITEM+4		;MAKE ENTRY ITEM
	MOVB	#GSXFR,ITEM+5
	MOV	EADDR,ITEM+6

	MOV	#ABS,R0		;DEFAULT SECTION IS '. ABS.'
	SUB	#ST.REL,R1	;CORRECT
	BLT	130$		;BR IF YES
	MOV	#P.N+8.,-(SP)	;COMPUTE POINTER TO
	CALL	$MULR1		;PSECT
	TST	(SP)+		;TABLE
	ADD	#PSECT2,R1	;				;01
	MOV	R1,R0

130$:	ADD	#P.N,R0		;TABLE STYLE NODE		;04
	CALL	PUTID		;THEN FILL IN NAME AND PUT IT OUT ;06

; END OF THE GSD
; FLUSH OUT WHATEVER IS IN THE BUFFERS.
; PUT OUT THE 'END GSD' ITEM.
; PUT OUT THE INITIAL 'RLD' ITEM.

135$:	CALL	FLHGSD		;FLUSH OUT GSD ITEMS

	MOV	#OFILE,R0	;OBJECT FILE			;01+
	MOV	#2,-(SP)	;ONE WORD IS TWO BYTES
	MOV	#ENDG,-(SP)	;FROM HERE
	CALL	PUTBIN		;PUT OUT 1 WORD 'END GSD' ITEM
	BIT	(SP)+,(SP)+	;TRASH THE STACK		;01-
	BCS	OBJIO		;I/O ERROR

	CLR	DOT+S.V		;MAKE SURE CORRECT LOAD ADDRESS
	CLR	CURPS		;PUT OUT INITIAL RLD ITEM
	MOV	#PSECT2,NXTPS					;01
	CALL	SETAR

140$:	RETURN			;DONE

;+
; ** OBJIO - OBJECT FILE I/O ERROR MANAGER
;
; THIS ROUTINE IS CALLED (VIA A JMP) ON ALL I/O ERRORS ON THE
; OBJECT FILE. A DIAGNOSTIC IS WRITTEN TO THE TI:,  THE STACK
; IS BACKED UP AND A RETURN (TO ASM) IS EXECUTED.
;-

OBJIO:								;01
.IF NE	RSX							;01
	TST	ARGV+2		;1 FILE?
	BEQ	10$		;YES, NO NAME NEEDED
	MOV	@ARGVPT,R4	;GET FILE NAME
	BEQ	10$		;ALREADY GOT PUT OUT
	MOV	#MSG01,R5	;FILE:
	CALL	FMSG
.ENDC								;01

10$:	MOV	#MSG02,R5		;OBJECT I/O ERROR
	CALL	MSG
	MOV	SPSAVE,SP
	RETURN			;THIS IS A RETURN FROM ASEMBL

;+
; ** PUTID  - PUT OUT A NAME, STRIPPING OUT LEADING '_'
; ** PUTGSD - PUT OUT A GSD ITEM
; ** PUTITM - PUT OUT A FULLY QUALIFIED GSD ITEM
;
; PUTID AND PUTGSD PACK THE FIRST 6 CHARACTERS OF THE NAME OF THE
; SPECIFIED SYMBOL INTO ITEM AND ITEM+2, THEN PUTS OUT THE GSD
; ITEM TO THE OBJECT FILE.
;
; PUTITM JUST OUTPUTS THE FULLY BUILT DATUM IN ITEM
;
; INPUTS:
;	R0=POINTER TO ASCII STRING FOR THIS NAME			;04
;     ITEM=THE GSD ITEM ITSELF
;     TPTR=GSD BUFFER POINTER (USES TBUF)
;
; MODIFIES R0
;-

PUTITM:	MOV	R1,-(SP)	;SAVE REGISTERS				;07+
	MOV	R2,-(SP)	;
	BR	PUT1		;DO COMMON OUTPUT			;07-

PUTID:				;OUTPUT AN ID				;06+
	CMPB	(R0)+,#'_	;IS THIS A MARKED SYMBOL?
	BEQ	PUTGSD		;SKIP IT IF SO
	DEC	R0		;RECOVER ORIGINAL STRING
	.BR	PUTGSD		;

PUTGSD:				;					;06-
	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)

	CALL	CAT5B		;MAKE RADIX 50
	MOV	R1,ITEM		;
	CALL	CAT5B		;
	MOV	R1,ITEM+2	;

PUT1:	CMP	TPTR,#TBUFND-7	;DO WE HAVE 8 BYTES FREE		;07
	BLO	10$		;YES
	CALL	FLHGSD		;NO, FLUSH IT

10$:	MOV	#ITEM,R0	;COPY TO BUFFER
	MOV	TPTR,R1
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+
	MOV	R1,TPTR

	MOV	(SP)+,R2	;DONE
	MOV	(SP)+,R1
	RETURN

;+
; ** FLHGSD - FLUSH GSD BUFFER
;-

FLHGSD:	MOV	TPTR,R1		;SEE HOW MUCH TO FLUSH
	SUB	#TBUF+4,R1
	CMP	R1,#2		;DON'T PUT OUT NULL RECORDS
	BLOS	10$
	MOV	#OFILE,R0	;PUT OUT THE OBJECT RECORD	;01+
	MOV	R1,-(SP)	;LENGTH
	MOV	#TBUF+4,-(SP)	;BUFFER
	CALL	PUTBIN		;DO IT
	BIT	(SP)+,(SP)+	;TRASH THE STACK		;01-
	BCS	20$		;ERROR
	MOV	#TYGSD,TBUF+4	;START OFF ANOTHER GSD RECORD
	MOV	#TBUF+6,TPTR
10$:	RETURN

20$:	JMP	OBJIO		;I/O ERROR

;+
; ** WRAPUP - WRAPUP AN OBJECT FILE
;
; THIS ROUTINE IS CALLED FROM ASEMBL TO FINISH OFF THE CURRECT
; OBJECT FILE. THIS ENTAILS FLUSHING THE TBUF AND RBUF AND PUT
; ING OUT THE END MODULE RECORD
;
; IF THE -N FLAG IS SET DO NOTHING.
;
; USES:
;	R0
;-

WRAPUP:
	TSTB	NFLAG		;IF -N DO NOTHING
	BEQ	10$		;BR IF NO OBJECTS		;01
	CALL	FTAR		;FLUSH TBUF AND RBUF
	call	isd		;emit ISD records from the UST	;05
	MOV	#OFILE,R0	;PUT OUT THE OBJECT RECORD	;01+
	MOV	#2,-(SP)	;LENGTH
	MOV	#ENDM,-(SP)	;BUFFER
	CALL	PUTBIN		;DO IT
	BIT	(SP)+,(SP)+	;TRASH THE STACK		;01-
	BCS	20$		;ERROR
10$:
	RETURN

20$:	JMP	OBJIO		;I/O ERROR

;+
; ** LIM - .LIMIT
;
; THIS ROUTINE IS CALLED TO OUTPUT A .LIMIT DIRECTIVE AT THE CURRENT
; LOCATION. TWO WORDS OF ZEROS ARE WRITTEN TO THE TEXT. THIS IS  NOT
; REALLY NECESSARY, BUT IT IS NEAT.
;-

LIM:	MOV	#LM.A,LMODE	;SET ADDRESS LISTING MODE

	CMPB	PASS,#3		;PASS 3
	BNE	30$		;NO
	TSTB	NFLAG		;NO CODE
	BEQ	30$		;YES				;01

	CMP	TPTR,#TBUFND-3	;NEED 4 BYTES OF TEXT
	BHIS	10$
	CMP	RPTR,#RBUFND-1	;AND 1 BYTE OF RELOACATION
	BLO	20$
10$:	CALL	FTAR

20$:	MOV	TPTR,R0		;TWO WORDS OF ZEROS
	CLR	(R0)+
	CLR	(R0)+
	MOV	R0,TPTR		;UPDATE TEXT POINTER
	SUB	#TBUF+4,R0	;COMPUTE DISPLACEMENT
	SWAB	R0
	BIC	#377,R0
	BIS	#RLLIM,R0	;MAKE .LIMIT ITEM
	MOV	R0,@RPTR	;PUT IN RELOCATION BUFFER
	ADD	#2,RPTR

30$:	ADD	#4,DOT+S.V	;FIX DOT
	RETURN

;+
; ** PUTB - PUT BYTE (ABSOLUTE)
;
; THIS ROUTINE PUTS OUT AN ABSOLUTE BYTE TO THE OBJECT FILE,  AND
; ADVANCES '.' BY 1. IF -N IS SET OR IT IS NOT PASS 3 THE BYTE IS
; DISCARDED.
;
; INPUTS:
;	R0=BYTE
;-

PUTB:	CALL	LCB		;FOR LISTING

	CMPB	PASS,#3		;PASS 3
	BNE	20$
	TSTB	NFLAG		;-N
	BEQ	20$		;NO OBJECTS, BRANCH		;01

	CMP	TPTR,#TBUFND	;DO WE HAVE ROOM FOR A BYTE
	BLO	10$		;YES
	CALL	FTAR		;WE DO NOW
10$:	MOVB	R0,@TPTR	;PUT IN TEXT BUFFER
	INC	TPTR		;FIX TEXT BUFFER POINTER

20$:	INC	DOT+S.V		;BUMP '.'
	RETURN

;+
; ** PUTWA - PUT WORD (ABSOLUTE)
;
; THIS ROUTINE IS LIKE PUTB, EXCEPT THAT IT PUTS OUT A WORD AND
; BUMPS '.' BY 2.
;
; INPUTS:
;	R0=WORD
;-

PUTWA:	CALL	LCW		;FOR LISTING

	CMPB	PASS,#3		;PASS 3
	BNE	20$
	TSTB	NFLAG		;-N
	BEQ	20$		;NO OBJECTS, BRANCH		;01

	CMP	TPTR,#TBUFND-1	;DO WE HAVE 2 BYTES
	BLO	10$		;YES
	CALL	FTAR		;WE DO NOW
10$:	MOV	R0,@TPTR	;PUT WORD IN THE BUFFER
	ADD	#2,TPTR		;FIX BUFFER POINTER

20$:	ADD	#2,DOT+S.V	;BUMP '.'
	RETURN

;+
; ** PUTW - PUT WORD
;
; A MORE COMPLEX BIG BROTHER TO PUTB AND PUTWA; THIS ONE HANDLES
; RELOCATION.
;
; INPUTS:
;	R0=WORD
;	R1=TYPE
;-

PUTW:	MOV	R2,-(SP)	;SAVE THE WORLD
	MOV	R1,-(SP)
	MOV	R0,-(SP)

	CALL	LCW		;FOR LISTING

	CMPB	PASS,#3		;PASS 3
	BNE	15$
	TSTB	NFLAG		;-N
	BEQ	15$		;NO OBJECTS, BRANCH		;01

	MOV	R1,R2		;GET A COPY OF THE TYPE
	BIC	#PCREL+SYREL,R1	;REMOVE FLAGS

; CHECK FOR SYMBOL  BASED RELOCATION.  THE SYMBOL MUST BE A GLOBAL
; OR SOMETHING IS WRONG. PUT OUT A TYPE 5 (GLOBAL ADDITIVE, RLGBA)
; OR A TYPE 6 (GLOBAL ADDITIVE DISPLACED, RLGAD) ITEM.

	CLR	REL		;REL = 0 => NO RELOCATION
	BIT	#SYREL,R2	;SYMBOL RELATIVE
	BEQ	17$		;NO
	MOV	R0,REL+6	;VALUE IS THE RELOCATION CONSTANT
	MOVB	#RLGBA,REL	;SET RELOCATION TYPE
	BIT	#PCREL,R2
	BEQ	10$
	MOVB	#RLGAD,REL
;
; For the hashed UST, we now must locate the symbol table
; node, given the type field.  The type field (with the PCREL
; and SYREL flags cleared) is the 'tag' value for the tree node.
; We now have to search through the tree for the node with the
; matching tag field.  It's suprisingly easy. If we can't find
; the node, something's very nasty ... CRASH.
;
; When finished, r1 --> node in the table.
;
10$:	MOV	R5,-(SP)	;Not clear if this is needed		;07+
	MOV	R4,-(SP)
	MOV	R1,R0		;r0 = tag to search for
	CLR	R1		;Will be set when found.
	MOV	#100$,R5	;Handler routine
	CALL	SYWALK
	MOV	(SP)+,R4	;Restore registers
	MOV	(SP)+,R5	;
	TST	R1		;IF R1 = 0, NOT FOUND (GAD)
	BEQ	12$		;CRASH
	MOV	S.N(R1),R0	;R0 --> ASCII (TREE STYLE NODE)
	BIT	#SF.GBL,S.F(R1)	;MUST BE GLOBAL
	BNE	35$		;BR IF IT IS
12$:	CRASH			;SHOULD NEVER HAPPEN

100$:	CMP	R0,S.U(R5)	;IS THIS NODE THE ONE WE WANT?
	BNE	110$		;NOPE
	MOV	R5,R1		;YES, SAVE THE NODE WE WANT
	ADD	#SY.STK,SP	;POP THE STACK

110$:	RETURN			;RETURN

15$:	JMP	90$		;FOR MAKING A BRANCH REACH

; NOT SYMBOL BASED RELOCATION.
; IF TYPE < ST.REL, MAKE IT ABSOLUTE. IF PCREL ABSOLUTE, USE TYPE
; 3 (ABSOLUTE DISPLACED, RLABD) ITEM.

17$:	CMP	R1,#ST.REL	;TEST FOR ABSOLUTE
	BHIS	20$		;NOT ABSOLUTE
	BIT	#PCREL,R2	;IS IT PC REL
	BEQ	40$		;NO, JUST PUT OUT TBUF ENTRY
	MOVB	#RLABD,REL	;SET RELOCATION
	MOV	R0,REL+2	;AND RELOCATION CONSTANT
	CLR	R0		;PUT OUT 0 TEXT
	BR	40$		;

; TYPE 1 (INTERNAL, RLINT) ITEM IS USED. CURRENT PSECT PC RELATIVE
; SHOULD HAVE BEEN TURNED INTO ABSOLUTE BY NOW.

20$:	SUB	#ST.REL,R1	;GET POINTER TO PSECT
	MOV	#P.N+8.,-(SP)
	CALL	$MULR1
	TST	(SP)+
	ADD	#PSECT2,R1					;01
	CMP	R1,CURPS	;CURRENT PSECTION
	BNE	30$		;NO
	BIT	#PCREL,R2	;YES, PC REL
	BNE	25$		;YES, SOMETHING IS WRONG
	MOVB	#RLINT,REL	;RELOCATION OPCODE
	MOV	R0,REL+2	;RELOCATION CONSTANT
	BR	40$

25$:	CRASH			;URK

30$:	MOV	R0,REL+6	;RELOCATION CONSTANT
	MOVB	#RLPSA,REL	;PSECTION ADDITIVE
	MOV	R1,R0		;GET ASCII ADDRESS FOR TABLE STYLE NODE	;04
	ADD	#P.N,R0							;04
	BIT	#PCREL,R2	;PC REL ?
	BEQ	35$		;NO
	MOVB	#RLPAD,REL	;YES, PSECTION ADDITIVE DISPLACED
	BR	36$		;AND DON'T EAT '_'			;06

; PUT IN THE RAD50 NAME, FOR ITEMS THAT REQUIRE IT. R1 IS A POINTER
; TO A SYMBOL TABLE NODE.
;
; R0 MUST POINT TO THE ASCII STRING AT THIS POINT.			;04

35$:
	CMPB	(R0)+,#'_	;GLOBAL NAME FROM C			;06+
	BEQ	36$		;IF SO, EAT LEADING '_'
	DEC	R0		;KEEP IT IF NOT.
36$:				;					;06-
	CALL	CAT5B		;CONVERT TO RADIX 50			;04
	MOV	R1,REL+2	;
	CALL	CAT5B		;
	MOV	R1,REL+4	;
	CLR	R0		;PUT A ZERO INTO THE TEXT

40$:	CMP	TPTR,#TBUFND-1	;NEED 2 BYTES IN THE TBUF
	BHIS	60$		;NO ROOM

	TSTB	REL		;IS THERE ANY RELOCATION
	BEQ	70$		;NO
	CMPB	REL,#RLABD	;RLABD OR RLINT
	BHI	50$		;NO
	CMP	RPTR,#RBUFND-3	;YES, NEED 4 BYTES
	BLO	70$
	BR	60$
50$:	CMP	RPTR,#RBUFND-7	;NEED 8 BYTES
	BLO	70$
60$:	CALL	FTAR		;INSURE ROOM

70$:	MOV	R0,@TPTR	;TEXT TO TEXT BUFFER
	ADD	#2,TPTR

	TSTB	REL		;ANY RELOCATION
	BEQ	90$		;NO
	MOV	TPTR,R1		;SET RELOCATION DISPLACEMENT
	SUB	#TBUF+2,R1
	MOVB	R1,REL+1
	MOV	RPTR,R0		;MOVE RELOCATION ITEM TO RBUF
	MOV	#REL,R1
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	CMPB	REL,#RLABD	;IS IT 2 OR 4 WORDS
	BLOS	80$		;2
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
80$:	MOV	R0,RPTR		;REPLACE RBUF POINTER

90$:	ADD	#2,DOT+S.V	;FIX '.'
	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	RETURN

;+
; ** FTAR  - FLUSH TBUF AND RBUF
; ** FTAR1 - FLUSH TBUF AND RBUF (ALTERNATE ENTRY)
;
; THE TBUF AND RBUF ARE WRITTEN, IF NON EMPTY, TO THE OBJECT FILE.
; THE ENTRY FTAR ASSUMES THAT THE NEXT PSECTION IS THE SAME AS THE
; CURRENT PSECTION; THE ENTRY FTAR1 ASSUMES THE USER HAS SET NXTPS
; UP HIMSELF.
;-

FTAR:	MOV	CURPS,NXTPS	;NEXT PSECT IS CURRENT PSECT

FTAR1:	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R0,-(SP)

	CALL	FTAR2		;FLUSH RBUF AND TBUF
	CALL	SETAR		;SET UP POINTERS, ETC.

	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	RETURN

FTAR2:	MOV	TPTR,R1		;FLUSH TBUF
	SUB	#TBUF,R1
	CMP	R1,#4
	BLOS	10$
	MOV	#OFILE,R0	;PUT OUT THE OBJECT RECORD	;01+
	MOV	R1,-(SP)	;LENGTH
	MOV	#TBUF,-(SP)	;BUFFER
	CALL	PUTBIN		;DO IT
	BIT	(SP)+,(SP)+	;TRASH THE STACK		;01-
	BCS	30$

10$:	MOV	RPTR,R1		;FLUSH RBUF
	SUB	#RBUF,R1
	CMP	R1,#2
	BLOS	20$
	MOV	#OFILE,R0	;PUT OUT THE OBJECT RECORD	;01+
	MOV	R1,-(SP)	;LENGTH
	MOV	#RBUF,-(SP)	;BUFFER
	CALL	PUTBIN		;DO IT
	BIT	(SP)+,(SP)+	;TRASH THE STACK		;01-
	BCS	30$

20$:	RETURN

30$:	JMP	OBJIO

;+
; ** SETAR - SET UP TBUF AND RBUF POINTERS
;
; USES:
;	R0, R1, R2
;-


SETAR:	MOV	#TBUF+4,TPTR	;SET POINTERS
	MOV	#RBUF+2,RPTR
	CMP	CURPS,NXTPS	;ARE WE SWITCHING PSECTIONS
	BEQ	10$		;NO

	MOV	#RLLCD,RBUF+2	;BUILD LCD ITEM IN THE RBUF
	MOV	NXTPS,R0	;POINTER TO PSECT
	ADD	#P.N,R0		;CONVERT ITS NAME TO RAD50
	CALL	CAT5B		;
	MOV	R1,RBUF+4	;
	CALL	CAT5B		;
	MOV	R1,RBUF+6	;
	MOV	DOT+S.V,RBUF+10	;LOCATION IN THE PSECT
	ADD	#10,RPTR
	CALL	FTAR2
	MOV	NXTPS,CURPS	;MAKE NEW PSECT THE CURRENT ONE
	BR	SETAR		;AND TRY AGAIN

10$:	MOV	DOT+S.V,TBUF+2	;LOAD ADDRESS IN TEXT RECORD
	RETURN

;+
; ** CAT5B -- ASCII TO RADIX 50
;
; ONCE AGAIN, THE DIGITAL SUPPLIED LIBRARY ROUTINE DOES NOT HANDLE LOWER
; CASE ASCII. ONCE AND FOR ALL THIS PROBLEM IS SOLVED.
; THIS ROUTINE DOES NO CHECKING!
;
; NOTE:	'_' IS IDENTICAL TO '.'
;	NULLS ARE TREATED LIKE BLANKS.
;
; INPUTS:
;	R0=PTR TO ASCII
;
; OUTPUTS:
;	R0=UPDATED PTR
;	R1=RADIX 50 WORD
;
; USES:
;	R2
;-

CAT5B:	CLR	R1		;R1 (RESULT) = 0

	CALL	10$		;DO 3 CHARS
	CALL	10$		;

10$:	MOVB	(R0)+,R2	;R2 = CHAR.
	BEQ	60$		;NULL = TREAT AS BLANK.
	CMP	R2,#040		;BLANK.
	BEQ	50$		;YES.

	CMP	R2,#'$		;DOLLAR SIGN.
	BEQ	40$		;YES
	CMP	R2,#'_		;UNDERSCORE?				;06+
	BNE	15$		;CONTINUE IF NOT
	MOV	#'.,R2		;MAKE IT A PERIOD
15$:				;					;06-
	CMP	R2,#'.		;PERIOD ?
	BEQ	30$		;

	CMP	R2,#'0		;DIGITS ?
	BLO	70$		;ERROR.
	CMP	R2,#'9		;WELL ?
	BLOS	30$		;YES!

	CMP	R2,#'A		;UPPER ALPHA ?
	BLO	70$		;ERROR.
	CMP	R2,#'Z		;WELL ?
	BLOS	20$		;YES!

	CMP	R2,#'a		;LOWER ALPHA ?
	BLO	70$		;ERROR.
	CMP	R2,#'z		;WELL ?
	BHI	70$		;ERROR.

	SUB	#40,R2		;MUCH MAGIC.
20$:	SUB	#56,R2		;
30$:	SUB	#11,R2		;
40$:	ADD	#27,R2		;
50$:	SUB	#40,R2		;

60$:	ASL	R1		;R1 = 50 * R1
	ASL	R1		;
	ASL	R1		;
	MOV	R1,-(SP)	;
	ASL	R1		;
	ASL	R1		;
	ADD	(SP)+,R1	;
	ADD	R2,R1		;ADD IN NEW DIGIT

70$:	RETURN			;FIN.
	.END
