/9	OVERLAY U (TITLE STUFF)
/	15-AUG-78	ALLOWED CHECKING TOC BIT IN LISTWD ON .SBTTL
/	16-AUG-78	FIXED RELOC TO BE LIKE PAL8 AND DUMP LITERALS
/	17-AUG-78	RELOC GIVES ERROR IF RELOC N NOT MATCHED BY RELOC
/			ALLOWED RELOC>
	.INCLUDE MGLOB.MA
	.ASECT OVRU,LEVEL=2,OVERLAY=4
	FIELD 4
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	.EXTERNAL ASEMLV,BACKUP,BRANCH,CREF,CRLF,DPRINT,ENTER,EOS,ERROR,EXPR
	.EXTERNAL FSCHEK,GETCHR,GETKAR,GETSYM,LETTER,LISTER,LOOKUP,ORIG,OUT,PARSYM
	.EXTERNAL PASS3,POP,PUSH,PUNBIT,PUTBIT,PUTSYM,PUXBIN,READLN,ROTL6,SCAN
	.EXTERNAL SETIT,SUBTL,TAB,PRLINO,LIST,HEADING
	.EXTERNAL PRGLIT,ER50SB
	.EXTERNAL SPUSH,SPOP,USRSTK
	.GLOBAL $SBTTL,$TITLE,$EJECT,$RELOC
	.GLOBAL ER207,ER218,ER219
	.GLOBAL $PUSH,$POP
	*2000

	25
/	SETIT MOVED TO ROOT

$SBTTL,	JMS I QQSCAN
	JMS I QQBACKUP
	JMS I (SETIT	/SET NEW TITLE FROM REST OF LINE
	-SUBLEN
	SUBTL-1
	STA
	TAD PASS
	SZA CLA
	JMP I (BYEB	/NOT PASS1
	TAD I (LISTWD
	AND (10
	SZA CLA
	JMP I (BYEB
	ISZ I (SBTKNT
	ISZ TCKNT
	SKP
	JMS SBT2
	TAD QQ40
	DCA PAD
	CLL
	TAD PAGENO
	JMS I QQDPRINT
	JMS I (TAB
	CIF 20
	JMS I (PRLINO
	JMS I (TAB
	JMS I (LIST
	SUBTL
	JMP I (BYEB
$EJECT,	CLA IAC
	DCA FORM	/GO TO NEW PAGE
$TITLE,	JMS I QQSCAN
	JMS I QQBACKUP
	JMS I (SETIT
	-HEADLN
	HEADING-1
	JMP I (BYEB	/TEMP
/*** SHOULDN'T TITLES APPEAR IN T-OF-C?

SBT2,	0
	TAD (-66	/*** MAKE MORE GENERAL
	DCA TCKNT
/	TAD (14
/	JMS I QQLISTER	/FORM FEED
/	JMS I (LIST
/	SBHEAD
/	JMS I QQCRLF
/	JMP I SBT2
/*** WOULD LIKE TO USE ABOVE BUT DON'T WANT
/TO WASTE SPACE IN ROOT IN FIELD 1.
/COULD MODIFY 'LIST' TO WORK FROM GIVEN FIELD.
	TAD (SBHEAD
	DCA PTR
SBLP,	TAD I PTR
	ISZ PTR
	SNA
	JMP I SBT2
	JMS I QQLISTER
	JMP SBLP
PTR,	0
$RELOC,	JMS I QQSCAN	/IGNORE SPACES
	TAD PC
	DCA OLDPC
	JMS I (PRGLIT	/*** FOR SOME REASON I WAS RELUCTANT TO ADD THIS
	TAD CHAR
	TAD (-76
	SZA CLA
	JMS I QQEOS	/AT END OF STATEMENT?
	JMP ENDRLC	/YES, END OF RELOC
	TAD RELOK
	SZA CLA
	JMS I (ER50SB	/LAST RELOC NOT TERMINATED
	JMS I QQBACKUP	/NO, GET READY TO PARSE EXPRESSION
	JMS I QQEXPR	/GET EXPRESSION
	DCA PC
	TAD PC
	CIA
	TAD OLDPC
	DCA RELOK
	TAD EXPREL
	SNA
	TAD EXPCOD
	SZA CLA
ER207,	JMS I QQERROR	/ARGUMENT TO 'RELOC' WAS NOT ABSOLUTE
	JMP RLC1
ENDRLC,	TAD PC
	TAD RELOK
	DCA PC
	DCA RELOK
RLC1,	TAD PC
	DCA BINARY
	INCR PCFLAG
	TAD PC
	JMS I QQORIG	/SINCE LITERAL DUMPING MOVED US
	JMP I (PSEUDO

OLDPC,	0		/ORIGINAL PC BEFORE 'RELOC' DIRECTIVE
SBHEAD,	14;"P;"A;"G;"E
	11;"L;"I;"N;"E
	11;"S;"U;"B;"T;"I;"T;"L;"E
	15;12;15;12;0
	PAGE
$PUSH,	CLA IAC
$POP,	DCA PSHTYP
	SKP
PUSH2,	JMS I QQGETCHR
	JMS I QQSCAN
PUSH3,	JMS I QQLETTER
	JMP ER219
	JMS I QQPARSYM
	JMS I QQLOOKUP
	JMS I QQENTER
	JMS I QQGETSYM
	JMS I QQCREF
	JMS CTYPE	/TYPES 0,4, AND 5 ARE OK
ER218,	JMS I QQERROR	/WAS NOT ONE OF THESE
	TAD FLAG
	AND QQ70
	SZA CLA
	JMP ER218	/CAN'T PUSH OR POP A SECT NAME
	TAD PSHTYP
	SNA CLA		/WHICH IS IT?
	JMP POPX	/POP
	TAD FLAG	/PUSH
	SMA CLA
	JMP ER218	/TRIED TO PUSH AN UNDEFINED SYMBOL
			/*** MAYBE THIS IS OK ON PASS 1
	TAD SYMVAL
	CIF 10
	JMS I (SPUSH
	USRSTK
	TAD SYMSCT
	CIF 10
	JMS I (SPUSH
	USRSTK
PSHOVR,	JMS I QQSCAN
	JMS I QQEOS
	JMP I (PSEUDB
	TAD CHAR
	TAD (-54
	SNA CLA
	JMP PUSH2
ER219,	JMS I QQERROR
	JMS I (IGNORE
	JMP PUSH3

PSHTYP,	0
POPX,	CIF 10
	JMS I (SPOP
	USRSTK
	DCA SYMSCT
	CIF 10
	JMS I (SPOP
	USRSTK
	DCA SYMVAL
	TAD FLAG
	SMA
	TAD (4000
	DCA FLAG
	JMS I QQPUTSYM	/WRITE IT BACK OUT
	JMP PSHOVR
CTYPE,	0
	TAD FLAG
	AND QQ7
	SNA
	JMP OKC
	TAD (-4
	CLL RAR
	SNA CLA
OKC,	ISZ CTYPE
	JMP I CTYPE
	PAGE