.TITLE	AS3D
	.IDENT	/X01/
 
	.NLIST	BEX
 
;
; AS
; CODE MANAGEMENT
;
; VERSION X01
;
; DAVID G. CONROY	2-NOV-77
;
 
	.GLOBL	GSD
	.GLOBL	WRAPUP
	.GLOBL	PUTB
	.GLOBL	PUTW
	.GLOBL	PUTWA
	.GLOBL	FTAR1
	.GLOBL	CURPS
	.GLOBL	NXTPS
	.GLOBL	LIM
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
	.MCALL	PUT$S
 
; 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
 
; 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
;-
 
GSD:	TSTB	NFLAG		;-N
	BNE	47$		;YES, SKIP ALL THIS
 
	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
 
; 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.
 
	MOV	#PSECT+2,R5	;POINT AT PSECTIONS
10$:	CMP	R5,PSECT	;LOOP TIL ALL DONE
	BHIS	50$
 
	MOVB	P.F(R5),ITEM+4	;PSECTION FLAGS
	MOVB	#GSPSD,ITEM+5	;PSECTION DEFINITION
	MOV	P.L(R5),ITEM+6	;PSECTION LENGTH
	MOV	R5,R0		;FILL IN RAD50 NAME
	CALL	PUTGSD
 
	MOV	R5,R1		;COMPUTE THE TYPE A SYMBOL WILL
	SUB	#PSECT+2,R1	;HAVE IF IT IS IN THIS PSECTION
	CLR	R0
	MOV	#P.N+8.,-(SP)
	CALL	$DIVR0
	TST	(SP)+
	MOV	R0,R4		;AND SAVE IT IN R4
	ADD	#ST.REL,R4
 
	MOV	#UST+2,R0	;TOP OF SYMBOL TABLE SEARCH
20$:	CMP	R0,UST		;LOOP TIL ALL DONE
	BHIS	45$
	CMP	R0,#DOT		;NEVER PUT '.' IN SYMBOL TABLE
	BEQ	43$
	CMP	S.T(R0),R4	;INSURE CORRECT PSECTION
	BNE	43$
	MOVB	#50,ITEM+4	;REL + DEF
	BIT	#SF.GBL,S.F(R0)	;IS IT GLOBAL OR LOCAL
	BEQ	30$		;LOCAL
	MOVB	#GSGSD,ITEM+5	;GLOBAL, SET GLOBAL DEFINITION
	BR	40$
30$:	MOVB	#GSISD,ITEM+5	;LOCAL,  SET INTERNAL DEFINTION
40$:	MOV	S.V(R0),ITEM+6	;ADDRESS
	CALL	PUTGSD		;FILL IN NAME, PUT IT OUT
43$:	ADD	#S.SIZE,R0	;MOVE TO NEXT ENTRY AND
	BR	20$		;DO MORE
45$:	ADD	#P.SIZE,R5	;MOVE TO NEXT PSECTION
	BR	10$
 
47$:	JMP	140$		;FOR MAKING A BRANCH REACH
 
; 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	#304,ITEM+4	;SELECT ABSOLUTE PSECTION
	MOVB	#GSPSD,ITEM+5
	CLR	ITEM+6
	MOV	#ABS,R0
	CALL	PUTGSD

	MOV	#UST+2,R0	;POINT AT USER SYMBOL TABLE
60$:	CMP	R0,UST		;LOOP TIL DONE
	BHIS	120$
 
	CMP	S.T(R0),#ST.ABS	;IS THIS AN ABSOLUTE SYMBOL
	BNE	90$		;NO
	MOVB	#10,ITEM+4	;YES, DEF + ABS
	BIT	#SF.GBL,S.F(R0)	;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(R0),ITEM+6	;VALUE
	BR	100$
 
90$:	CMP	S.T(R0),#ST.UND	;UNDEFINED
	BNE	110$		;NO
	BIT	#SF.GBL,S.F(R0)	;IS IT UNDEFINED GLOBAL
	BEQ	110$		;NO
	CLRB	ITEM+4		;REF
	MOVB	#GSGSD,ITEM+5	;GLOBAL SYMBOL REFERENCE
	CLR	ITEM+6		;VALUE IS IGNORED, BUT BE NEAT
100$:	CALL	PUTGSD		;FILL IN NAME, PUT OUT RECORD
110$:	ADD	#S.SIZE,R0	;MOVE TO THE NEXT
	BR	60$
 
; 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	#PSECT+2,R1	;
	MOV	R1,R0
 
130$:	CALL	PUTGSD		;THEN FILL IN NAME AND PUT IT OUT
 
; 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
 
	PUT$S	#OFILE,#ENDG,#2	;PUT OUT 1 WORD 'END GSD' ITEM
	BCS	OBJIO		;I/O ERROR
 
	CLR	DOT+S.V		;MAKE SURE CORRECT LOAD ADDRESS
	CLR	CURPS		;PUT OUT INITIAL RLD ITEM
	MOV	#PSECT+2,NXTPS
	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:	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
 
10$:	MOV	#MSG02,R5		;OBJECT I/O ERROR
	CALL	MSG
	MOV	SPSAVE,SP
	RETURN			;THIS IS A RETURN FROM ASEMBL
 
;+
; ** PUTGSD - PUT OUT A GSD ITEM
;
; THIS ROUTINE PACKS 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.
;
; INPUTS:
;	R0=POINTER TO SYMBOL NODE
;     ITEM=THE GSD ITEM ITSELF
;     TPTR=GSD BUFFER POINTER (USES TBUF)
;-
 
PUTGSD:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
 
	ADD	#S.N,R0		;POINT R0 AT THE ASCII
	MOV	R0,R1		;MAKE NONZERO FOR $CAT5
	CALL	$CAT5
	MOV	R1,ITEM		;FIRST 3 CHARACTERS
	MOV	R0,R1		;THIS IS OVER ZEALOUS
	CALL	$CAT5
	MOV	R1,ITEM+2
 
	CMP	TPTR,#TBUFND-7	;DO WE HAVE 8 BYTES FREE
	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
	MOV	(SP)+,R0
	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$
	PUT$S	#OFILE,#TBUF+4,R1 ;PUT OUT THE OBJECT RECORD
	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
	BNE	10$
	CALL	FTAR		;FLUSH TBUF AND RBUF
	PUT$S	#OFILE,#ENDM,#2	;END MODULE
	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
	BNE	30$		;YES

	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
	BNE	20$
 
	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
	BNE	20$
 
	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
	BNE	15$
 
	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
10$:	MOV	#S.N+8.,-(SP)	;GET POINTER
	CALL	$MULR1		;TO
	TST	(SP)+		;SYMBOL
	ADD	#UST+2,R1
	BIT	#SF.GBL,S.F(R1)	;MUST BE GLOBAL
	BNE	35$		;BR IF IT IS
	IOT			;SHOULD NEVER HAPPEN
 
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	#PSECT+2,R1
	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$:	IOT			;URK
 
30$:	MOV	R0,REL+6	;RELOCATION CONSTANT
	MOVB	#RLPSA,REL	;PSECTION ADDITIVE
	BIT	#PCREL,R2	;PC REL
	BEQ	35$		;NO
	MOVB	#RLPAD,REL	;YES, PSECTION ADDITIVE DISPLACED
 
; PUT IN THE RAD50 NAME, FOR ITEMS THAT REQUIRE IT. R1 IS A POINTER
; TO A SYMBOL TABLE NODE.
 
35$:	MOV	R1,R0		;POINT R0 AT THE ASCII NAME
	ADD	#S.N,R0
	MOV	R0,R1
	CALL	$CAT5
	MOV	R1,REL+2
	MOV	R0,R1
	CALL	$CAT5
	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$
	PUT$S	#OFILE,#TBUF,R1
	BCS	30$
 
10$:	MOV	RPTR,R1		;FLUSH RBUF
	SUB	#RBUF,R1
	CMP	R1,#2
	BLOS	20$
	PUT$S	#OFILE,#RBUF,R1
	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
	MOV	R0,R1
	CALL	$CAT5
	MOV	R1,RBUF+4
	MOV	R0,R1
	CALL	$CAT5
	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
 
	.END