Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/cobolg.mac
There are 14 other files named cobolg.mac in the archive. Click here to see a list.
; UPD ID= 3556 on 5/15/81 at 11:04 PM by NIXON                          
TITLE	COBOLG FOR COBOL V12B
SUBTTL	PHASE G	- ASSEMBLY	AL BLACKINGTON/CAM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P,COMUNI,TABLES
	SEARCH	OPCTAB
	%%P==:%%P
	%%COMU==:%%COMU
	DBMS==:DBMS
	DEBUG==:DEBUG
	MCS==:MCS
	TCS==:TCS

;EDITS
;NAME	DATE		COMMENTS

;WTK	23-SEP-80	[1055] FIX EDIT 762 TO USE CORRECT ERROR MESSAGE.
;DMN	30-MAY-80	[1024] FIX BUG IN EDIT 762 IF D. P. MANTISSA IS EXACTLY 18 DIGITS.
;LEM	9-APR-80	[1010] FINISH EDIT 774
;DAW   	10-MAR-80	[774] DELETE AS1.TMP  IF USING -,-=FOO/O
;DMN	 1-FEB-80	[762] IMPLEMENT AND USE D. P. FLOATING POINT LITERALS
;DMN	12/28/79	[756] GENERATE REQUEST FOR C.RSET IN COBOL SUBPROGRAMS
;DMN	 3/6/79		[653] TURN ON FFATAL ON ASSEMBLY ERRORS

;V10*****************
;JEC	01/29/76	[402] ADD INSTRUCTION HRRI
;DPL	01/29/76	[401] DON'T OUTPUT USES ADDR IF ONLY DBMS USE PROC
;GPS	3/12/75		ADD CODE FOR SIMULTANEOUS UPDATE
;DBT	1/17/75		;SEARCH COMUNI.UNV FOR DEFINITION OF FIXNUM
;			GET COMSIZ (LIBOL LOW SEG ALLOC) FROM COMUNI ALSO
;			EXPAND THE INFIX% MACRO TO GET INDICES OF
;			THE HEADER BLOCK AND CHECK THAT THEY ARE
;			GENERATED AT THE APPROPRIATE SPOTS
;
;			GENERATE THE NEW HEADER ELEMENTS
;				COBVR.		COMPILER VERSION
;				COBSW.		ASSEMBLY SWITCHES
;				PUSHL.		PUSH DOWN LIST SIZE
;
;DBT	1/17/75		;PUT IN ERROR CHECK RATHER THAN GENERATING
;			UUO' ANY MORE.  COBOLE SHOULD NOT LET ANY THROUGH
;			IF IT DOES IT MEANS THAT THE UUO WAS ENTERED
;			INTO THE ASY FILES BY OTHER THAN A PUTASY CALL
;			THE UUO GENERATOR MUST BE CHANGED
;ACK	22-APR-75	ALLOW EBCDIC LITERALS IN THE ASY FILES.
;********************

; EDIT 266 CALL TO TTYON TO TURN ON TTY 
;	[EDIT 201] GENERATE CODE FOR COBOL START UP  START.: JSP 16,COBST.
;EDIT 110 FIX COMPILE WITH /A WITH AN ALTER TO A PROCEED TO
;	A NON-RESIDENT SEGEMENT

TWOSEG
RELOC	400000
SALL
	INTERNAL CLRDAT,PUTDAT,PDATI,COMSIZ

	EXTERN	SURRT.,SUEQT.,SUFBT.
	EXTERNAL SETASY,GETASY,PUTBIN,KILL
	EXTERNAL PUTLST,LCRLF,HDROUT,LSTMES,KILLF,LNKSET
	EXTERNAL RESTRT,DEVDED
	EXTERNAL PSORT,RELES,RETRN,MERGE,BLKTYP

	DEFBYT	XXFIL,3,1	;FILLER IN WORD 1
	DEFBYT	EXENT,1,1	;1 BIT, WORD 1

COBOLG:	SETFAZ	G;
	SKIPN	NAMNXT		;IF NO NAMTAB,
	SETOM	PRODSW		;  PRETEND '/P' TYPED
	SETZM	GAERAS		;CLEAR ERROR COUNTER
	SETZM	ACSFLG##	;CLEAR ALTERNATE CODE SET FLAG
	SETZM	INDFLG##	;CLEAR INDENT FLAG
	SETZM	OVRWRD		;SO WE OUTPUT SYMBOLS TO NON-OVERLAY PART

IFN FT68274,<
	JRST	NDASY0		;NEVER ASSEMBLE, CVT FILE IS ON BIN CHAN
>
IFE DEBUG,<
	TSWF	FFATAL;
	JRST	NDASY0
>
	SKIPN	BINDEV		;DO WE HAVE TO ASSEMBLE?
	TSWF	FOBJEC;
	JRST	COBLGA		;YES
	SKIPN	OPTSW		;[774] CHECK FOR /O TURNED ON
	JRST	NDASY0		;NO--QUIT
	MOVEI	TA,'AS1'	;[774] SPECIFY AS1 BACK TO CHANNEL 12
	HRRM	TA,ASYFIL	;[774] SO WE CAN DELETE AS1.TMP LATER.
	PUSHJ	PP,SETASY	;[774] DO A LOOKUP 
	JRST	NDASY0		;[1010] NO--QUIT

COBLGA:	MOVSI	TE,(ASCIZ "A")
	MOVEM	TE,HDRPAG
	SETZM	SUBPAG
	SETZM	PAGCNT

	TSWT	FOBJEC		;ANY OBJECT LISTING?
	SWON	FNOLST		;NO--TURN ON "NO LISTING AT ALL"
	HRRZS	OBJSIZ
	MOVE	TA,NONRES	;SET HILOC
	ADDB	TA,HILOC	; (HIGHEST LOC IN LOW SEGMENT)
;11-MAY-79 /DAW  CHECK FOR LOW SEG BEING TOO BIG
	ADDI	TA,COMSIZ+LO.PUR ;GET ABSOLUTE VALUE OF HIGHEST LOC.
	CAIL	TA,MLOWSZ	;MAX EXCEEDED?
	SETOM	FTOOBG##	;YES, MAKE SURE FLAG IS SET

;NOW GO AHEAD AND TRY TO ASSEMBLE ANYWAY

COBLGC:	PUSHJ	PP,INITAL	;INITIALIZE THE PHASE
	JRST	NXTAS2		;START UP
;PICK UP NEXT ASYFIL

NXTASY:	CLOSE	ASY,		;CLOSE THAT ASYFIL
IFN DEBUG,<
	MOVE	TE,CORESW
	TLNN	TE,%KILLG
	TLNE	TE,%KILFG
	JRST	NXTAS0
>
	MOVEI	TE,0		;DELETE
	RENAME	ASY,TE		;  THE ASYFIL,
	  JFCL			;  IGNORING ANY TROUBLE

NXTAS0:	PUSHJ	PP,CLRDAT	;CLEAN OUT GRPDAT
	HRRZ	TA,ASYFIL	;WAS THAT AS3FIL?
	CAIN	TA,(SIXBIT "AS3")
	JRST	ENDASY		;YES--ALL DONE

	AOS	ASYFIL		;NO--SET UP NEXT

	CAIE	TA,(SIXBIT "AS1")	;WAS THAT THE DATA SEGMENT?
	JRST	NXTAS1		;NO


;NEXT INPUT FILE IS FOR THE RESIDENT SECTIONS

	PUSHJ	PP,STARTI

	MOVE	PC,RESDNT	;RESET CURRENT LOCATION COUNTER
	MOVEM	PC,DATGRP+2
	JRST	NXTAS3


;NEXT INPUT FILE IS FOR THE NON-RESIDENT SECTIONS

NXTAS1:	PUSHJ	PP,EXTOUT	;WRITE OUT ANY DUMMIES FOR EXTERNAL REFERENCES
	PUSHJ	PP,SETOVR	;SET UP OVERLAY TABLE
	MOVE	PC,NONRES
	SWON	FASSEG		;SET "THIS IS NON-RESIDENT"

NXTAS3:	MOVEM	PC,CURREL

NXTAS2:	PUSHJ	PP,SETASY
;PICK UP NEXT ITEM IN ASYFIL
GET:	PUSHJ	PP,GETASY	;GET NEXT DATUM
	JUMPE	CH,NXTASY	;JUMP IF FILE FINISHED
	MOVE	W1,CH

	JUMPL	CH,NOTOPR	;IS IT AN INSTRUCTION?

	MOVE	TB,W1		;SET UP LH OF "TB"

	LDB	TE,[POINT 3,W1,20];PICK UP ADDRESS TYPE
	CAIE	TE,6		;CONSTANT OR
	CAIN	TE,7		;  MISCELLANEOUS?
	TLO	W1,ASINC	;YES--SET "INCREMENT FOLLOWS"

	TLNN	W1,ASINC	;ANY INCREMENT?
	TDCA	CH,CH		;NO--USE ZERO
	PUSHJ	PP,GETASY	;YES--GET IT
	MOVE	W2,CH		;IF RH=0, LH=INCREMENT (NEG OR POS)

	PUSHJ	PP,GETOPR
	TSWT	FNOLST		;ANY LISTING?
	PUSHJ	PP,LSTOPR	;YES--LIST IT
	SETZM	ACSFLG		;CLEAR ALTERNATE CODE SET FLAG
	HRLZS	INDFLG		;HALF-CLEAR FLAG SO IT WORKS FOR NEXT DATUM, BUT NOT ONE AFTER
	AOJA	PC,GET		;LOOP

;ITEM WAS NOT AN INSTRUCTION

NOTOPR:	SWOFF	FGDEC;
	LDB	TA,[POINT 3,W1,2];GET CODE
	JRST	@.+1-4(TA)
	EXP	BYTER
	EXP	XWDER
	EXP	CONST
	EXP	MISC
;ITEM IS A BYTE POINTER

BYTER:	PUSHJ	PP,GETASY
	HRRZ	W2,CH
	MOVE	TB,CH

	PUSHJ	PP,GETADR

	PUSHJ	PP,PUTDAT

	TSWT	FNOLST		;ANY LISTING?
	PUSHJ	PP,LSTBYT		;YES--LIST THE BYTE POINTER

	AOJA	PC,GET			;BACK FOR NEXT
;ITEM IS AN XWD

XWDER:	HRRZ	CT,W1		;GRAB ITEM COUNT

XWDER1:	PUSHJ	PP,GETASY	;GRAB LH WORD FROM ASYFIL
	MOVE	W1,CH
	HLRZ	W2,CH

	PUSHJ	PP,GETADR	;RESOLVE ADDRESS

	MOVSS	TB		;PUT IT IN LEFT HALF
	LSH	TA,1		;SHIFT RELOCATION
	PUSH	PP,W1		;SAVE THE WORD
	PUSH	PP,TA		;SAVE RELOCATION

	PUSHJ	PP,GETASY	;GRAB RH WORD FROM ASYFIL
	MOVE	W1,CH
	HLRZ	W2,CH

	PUSHJ	PP,GETADR	;RESOLVE ADDRESS

	POP	PP,TC		;GET LH RELOCATION
	OR	TA,TC		;COMBINE WITH RH
	PUSHJ	PP,PUTDAT	;WRITE OUT WORD

	EXCH	W1,(PP)
	POP	PP,TC
	TSWT	FNOLST		;ANY LISTING?
	PUSHJ	PP,LSTXWD	;YES--LIST IT

	ADDI	PC,1		;KICK UP LOCATION COUNTER

	SOJG	CT,XWDER1	;LOOP IF MORE XWD'S

	JRST	GET		;NO--GO AFTER NEXT ITEM
;ITEM IS A CONSTANT

CONST:	HRRZ	CT,W1
	TLNN	W1,ASCON
	JRST	BADCON

	TLNE	W1,ASCSIX
	JRST	CONSIX
	TLNE	W1,ASCASC
	JRST	CONASC
	TLNE	W1,ASCEBC
	JRST	CONEBC
	TLNE	W1,ASCD1
	MOVEI	OP,0
	TLNE	W1,ASCD2
	MOVEI	OP,1
	TLNE	W1,ASCFLT
	MOVEI	OP,2
	TLNE	W1,ASCOCT
	MOVEI	OP,3
	TLNE	W1,ASCF2	;[762] COMP-2?
	JRST	CONSF2		;[762] YES

CONST1:	PUSHJ	PP,GETASY
	TLNN	W1,ASCFLT	;FLOATING POINT?
	SKIPA	TB,CH		;NO--TAKE IT AS IS
	PUSHJ	PP,FLTCON	;YES--CONSTRUCT CONSTANT

	MOVEI	TA,0
	PUSHJ	PP,PUTDAT

	TSWF	FNOLST;
	JRST	CONST2

	PUSHJ	PP,LSTCOD
	PUSHJ	PP,@CONTAB(OP)
	PUSHJ	PP,LCRLF

CONST2:	ADDI	PC,1
	SOJG	CT,CONST1
	JRST	GET

;TABLE OF ROUTINES WHICH LIST CONSTANTS

CONTAB:	EXP	LSTD1
	EXP	LSTD2
	EXP	LSTFLT
	EXP	LSTOCT
;ITEM IS A CONSTANT  (CONT'D).

;IT IS SIXBIT

CONSIX:	MOVE	TC,CT

CONSX1:	CAIG	TC,^D12
	JRST	CONSX2

	MOVEI	TC,^D12
	PUSHJ	PP,LSTSIX
	MOVNI	TC,^D12
	ADDB	TC,CT
	JRST	CONSX1

CONSX2:	PUSHJ	PP,LSTSIX
	JRST	GET


;IT IS ASCII

CONASC:	MOVE	TC,CT

CONAS1:	CAIG	TC,^D14
	JRST	CONAS2

	MOVEI	TC,^D14
	PUSHJ	PP,LSTASC
	MOVNI	TC,^D14
	ADDB	TC,CT
	JRST	CONAS1

CONAS2:	PUSHJ	PP,LSTASC
	JRST	GET


;IT IS EBCDIC

CONEBC:	MOVE	TC,CT		;NUMBER OF WORDS.
CONEB1:	CAIG	TC,^D18		;MORE THAN 72 CHARS?
	JRST	CONEB2		;NO, GO FINISH UP.

	MOVEI	TC,^D18		;SET THE LIMIT AT 18 WORDS.
	PUSHJ	PP,LSTEBC	;GO PUT THEM OUT.
	MOVNI	TC,^D18
	ADDB	TC,CT		;ADJUST THE COUNTS.
	JRST	CONEB1		;GO WRITE THE REST OUT.

CONEB2:	PUSHJ	PP,LSTEBC	;PUT OUT WHATEVER IS LEFT.
	JRST	GET		;GO GET MORE ASY STUFF.

;[762] IT IS D. P. FLOATING POINT

CONSF2:	PUSHJ	PP,F2CON	;[762] CONSTRUCT 2 WORD CONSTANT IN TB AND TA
	MOVE	TC,TA		;[762] PUT SECOND WORD IN SAFE PLACE
	MOVEI	TA,0		;[762]
	PUSHJ	PP,PUTDAT	;[762]
	MOVEI	TA,0		;[762]
	EXCH	TB,TC		;[762] SECOND WORD
	PUSHJ	PP,PUTDAT	;[762]
	EXCH	TB,TC		;[762]
	TSWF	FNOLST		;[762]
	AOJA	PC,CONST2	;[762] COUNT TWO WORDS
	PUSHJ	PP,LSTCOD	;[762]
	PUSHJ	PP,LSTF2	;[762] LIST IT
	PUSHJ	PP,STRTI9	;[762] LIST <CR-LF> AND BUMP PC
	MOVE	TB,TC		;[762]
	PUSHJ	PP,LSTCOD	;[762] LIST SECOND WORD
	PUSHJ	PP,LCRLF	;[762]
	JRST	CONST2		;[762]
;ITEM IS MISCELLANEOUS

MISC:	TLNE	W1,ASPARN	;PARAGRAPH OR SECTION NAME?
	JRST	MISPRO		;YES
	TLNE	W1,ASTAGN	;NO--SPECIAL TAG?
	JRST	MISTAG		;YES
	TLNE	W1,ASREL	;NO--RELOC?
	JRST	MISREL		;YES
	TLNE	W1,ASENTN	;NO, ENTRY?
	JRST	MISPRO		;YES
	TLNE	W1,ASSMSC	;SPECIAL MISCELLANEOUS?
	JRST	MISSMC		;YES
	TLNE	W1,ASACS	;ALTERNATE CODE SET?
	JRST	MISACS		;YES

	OUTSTR	[ASCIZ "Bad MISC. operator
"]
	JRST	KILL

MISACS:	SETOM	ACSFLG		;SET FLAG
	JRST	GET		;GET INST


;SPECIAL MISCELLANEIOUS ITEMS - ASSUME THEY ARE ADDRESSES.

MISSMC:	HRRZI	CT,(W1)		;SEE HOW MANY THERE ARE.
MISSMH:	PUSHJ	PP,GETASY	;GO GET ONE.
	MOVE	W1,CH		;SET IT UP.
	HLRZ	W2,CH
	PUSHJ	PP,GETADR	;GO SEE WHAT TO DO WITH IT.
	TSWT	FNOLST		;LISTING?
	PUSHJ	PP,LSTADR	;YES, GO DO IT TO IT.
	SOJG	CT,MISSMH	;ANY MORE?
	JRST	GET		;NO GO GET THE NEXT ITEM.
;ITEM IS A PROCEDURE NAME

MISPRO:	TSWF	FNOLST;		;ANY LISTING?
	JRST	MISP1		;NO

	MOVE	TA,TAGOUT	;ANY TAGS BEING PRINTED?
	JUMPLE	TA,MISP1
	PUSHJ	PP,LCRLF	;YES--PUT OUT <C.R.>,<L.F.>
	SWON	FASPAR;
	SETOM	TAGOUT

MISP1:	MOVE	DT,W1		;GET PRODAT ENTRY
	ANDI	DT,77777
	TLNE	W1,ASENTN	;ENTRY?
	JRST	MISENT		;YES
	ADD	DT,PROLOC
	MOVE	CH,2(DT)	;IS THIS A SECTION?
	TRNE	CH,PTSECT
	JRST	MISP5		;NO
;ITEM IS A PROCEDURE NAME  (CONT'D)

;SECTION

	TSWF	FNOLST		;ANY LISTING?
	JRST	MISP4B		;NO
	PUSHJ	PP,HDROUT
	PUSHJ	PP,TABS3
	PUSHJ	PP,LSTNAM
	MOVE	TE,[POINT 7,[ASCIZ " SECTION"]]
	PUSHJ	PP,LSTMES

	MOVE	DT,W1		;GET ADDRESS OF PROTAB ENTRY
	ANDI	DT,77777
	ADD	DT,PROLOC
	LDB	TE,PTSEGN	;GET SEGMENT NUMBER
	JUMPE	TE,MISP4	;IF 0, DON'T PRINT IT

	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	IDIVI	TE,^D10
	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTLST
	MOVEI	CH,"0"(TD)
	PUSHJ	PP,PUTLST

MISP4:	PUSHJ	PP,LCRLF	;PUT OUT <C.R.>,<L.F.>
	PUSHJ	PP,LCRLF
	SWOFF	FASPAR;

MISP4B:	MOVE	DT,W1		;CONVERT PRIORITY NUMBER TO DECIMAL
	ANDI	DT,77777
	ADD	DT,PROLOC
	LDB	TE,PTSEGN
	IDIVI	TE,12
	LSH	TE,6
	ADDI	TE,2020(TD)
	CAMN	TE,DECSEG	;SAME PRIORITY AS PREVIOUS SECTION?
	 JRST	MISP6		;YES
	MOVEM	TE,DECSEG	;NO--SAVE THIS ONE

	PUSHJ	PP,MISP4A	;UPDATE SECTAB POINTER

	PUSHJ	PP,CLRDAT	;CLEAR OUT DATGRP
	PUSHJ	PP,RESOVR	;PUT ENTRY IN OVERLAY TABLE
	HRRZ	PC,NONRES	;RESET PC
	JRST	MISP6

MISP4A:	MOVEI	TA,2
	ADDB	TA,CURSEC
	HLRZ	TB,0(TA)	;UPDATE LITBAS
	ADD	TB,CURREL
	LDB	TE,PTSEGN	;GET SEGMENT NUMBER
	SKIPN	TE		;SKIP IF NON-ZERO
	 SUB	TB,INDELC	;SUBTRACT # OF INSTRUCTIONS DELETED
	MOVEM	TB,LITBAS
	POPJ	PP,
;ITEM IS AN ENTRY POINT

MISENT:	ADD	DT,EXTLOC	;GET ABS EXTAB ADDR
	MOVE	TD,PC		;PUT PC VALUE IN EXTAB ENTRY
	HRRM	TD,1(DT)
	TSWF	FNOLST		;LISTING?
	JRST	GET		;NO

	PUSHJ	PP,LCRLF
	PUSHJ	PP,TABS3	;3 TABS
	MOVE	TE,[POINT 7,[ASCIZ "ENTRY	"]]
	PUSHJ	PP,LSTMES
	PUSHJ	PP,LSTNAM
	PUSHJ	PP,LCRLF
	PUSHJ	PP,TABS3
	PUSHJ	PP,LSTNAM	;"ENTRY-NAME:"
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF
	JRST	GET

TABS3:	MOVEI	CH,11		;PUT OUT 3 TABS
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST
	PJRST	PUTLST
;ITEM IS A PROCEDURE NAME  (CONT'D).

;ITEM IS A PARAGRAPH NAME

MISP5:	TSWF	FNOLST		;ANY LISTING?
	JRST	MISP6		;NO

	TSWTS	FASPAR;		;ANY NAME OUT FOR THIS LINE?
	PUSHJ	PP,LCRLF	;NO--PUT OUT <C.R.>,<L.F.>
	PUSHJ	PP,TABS3

	PUSHJ	PP,LSTNAM	;PUT OUT A PARAGRAPH-NAME
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF


;INSURE THAT THE PROCEDURE-NAME JUST SEEN BELONGS AT THIS ADDRESS

MISP6:	LDB	TE,PTSEGN
	SKIPN	TE		;RESIDENT SEGMENT?
	SKIPA	TD,RESDNT	;YES
	MOVE	TD,NONRES	;NO

	ADD	TD,1(DT)	;RELOCATE THE ADDRESS

	CAIN	PC,(TD)		;OK?
	JRST	GET		;YES--RETURN

	MOVE	TE,[POINT 7,[ASCIZ "

				******** PHASE ERROR ********

"]]
	PUSHJ	PP,LSTMES
	MOVNI	TE,4
	ADDB	TE,PAGCNT
	SKIPG	TE
	PUSHJ	PP,HDROUT

	AOS	GAERAS

	JRST	GET
;ITEM IS MISCELLANEOUS (CONT'D)
;SPECIAL TAG

MISTAG:	TSWF	FNOLST;		;YES--ANY LISTING?
	JRST	GET		;NO--FORGET IT

	SKIPN	OPTSW##		;/OPTIMIZE?
	 JRST	MSTAG1		;NO-- ALL TAGS ARE OK
	SKIPN	TAGOUT		;SKIP IF NO TAG FOR THIS LINE YET
	 JRST	TAGDEL		; WE WON'T EVER PRINT MORE THAN 1 NOW

	HRRZ	TC,W1
	ANDI	TC,77777	;GET TAG NUMBER
	ADD	TC,TAGLOC##
	LDB	TB,[POINT 15,(TC),17] ;GET REF COUNT
	JUMPN	TB,OKTAG	;DON'T PRINT TAGS THAT AREN'T REFERENCED

TAGDEL:	AOS	TAGDLC##	;REMEMBER WE "DELETED" A TAG
	JRST	GET

OKTAG:	MOVE	TB,(TC)		;GET ENTRY
	TLNE	TB,(1B0)	;SAME AS %TAG OR PARAGRAPH?
	 JRST	GET		;YES- DON'T WORRY ABOUT IT
MSTAG1:	AOSE	TA,TAGOUT	;ALREADY ONE FOR THIS LINE?
	JRST	MSTAG2		;YES
	MOVEM	W1,SAVTAG	;NO--SAVE THIS ONE
	JRST	GET

MSTAG2:	CAIE	TA,1		;ANY TAG BEING SAVED?
	JRST	MSTAG3		;NO

	TSWT	FASPAR;		;ANY PARAGRAPH-NAME FOR THIS LINE?
	PUSHJ	PP,LCRLF	;NO--PUT OUT <C.R.>
	PUSHJ	PP,TABS3
	MOVE	TC,SAVTAG	;PRINT THE TAG
	PUSHJ	PP,MSTAG4

MSTAG3:	MOVEI	CH," "		;PRINT A SPACE
	PUSHJ	PP,PUTLST
	MOVE	TC,W1		;PRINT THIS TAG
	PUSHJ	PP,MSTAG4
	JRST	GET

MSTAG4:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	ANDI	TC,77777
	PUSHJ	PP,LSINC5

	MOVEI	CH,":"
	PUSHJ	PP,PUTLST

	MOVE	TE,TAGOUT	;IS PRINT-LINE FULL OF TAGS?
	CAIE	TE,^D11
CPOPJ:	POPJ	PP,

	SWON	FASPAR;		;YES--SET "PARAGRAPH NAME PRINTED"
	SETOM	TAGOUT			;SET "NO TAGS"
	JRST	LCRLF
;ITEM IS MISCELLANEOUS (CONT'D)
;RELOC

MISREL:	TLNN	W1,1		;ANY INCREMENT?
	TDCA	CH,CH		;NO--USE ZERO
	PUSHJ	PP,GETASY	;YES--GET IT
	HRRZ	W2,CH

	PUSHJ	PP,GETADR	;ASSEMBLE ADDRESS INTO RH OF TB
	ANDI	W1,7B20		;WAS THAT A FILE TABLE?
	CAIN	W1,4B20
	SUBI	TB,SZ.DEV	;YES--DEDUCT SIZE OF DEVICE TABLE

	TSWF	FASSEG		;OVERLAY SEGMENT?
	CAIN	PC,(TB)		;YES--IS PC ACTUALLY BEING CHANGED?
	JRST	MISRL5		;YES--TROUBLE

	MOVEI	TE,[POINT 7,[ASCIZ "
				****** IMPROPER RELOC ******

"]]
	PUSHJ	PP,LSTMES
	MOVNI	TE,3
	ADDM	TE,PAGCNT
	AOS	GAERAS
	JRST	GET

MISRL5:	TSWF	FASSEG		;IS THIS AN OVERLAY SEGMENT?
	JRST	MISRL6		;YES
	PUSHJ	PP,CLRDAT	;NO--CLEAR DATGRP
	HRRZ	PC,TB
	MOVEM	PC,DATGRP+2

MISRL6:	TSWF	FNOLST		;ANY LISTING?
	JRST	GET

	PUSHJ	PP,LCRLF

	CAIE	W1,7B20		;WAS THAT A MISCELLANEOUS REFERENCE?
	JRST	GET		;NO--RETURN

	CAIN	W2,3B20		;YES--LITERAL BASE?
	JRST	MISRL8		;YES

	CAIE	W2,1B20		;NO--IMPURE BASE?
	JRST	GET		;NO--RETURN
;ITEM IS MISCELLANEOUS (CONT'D)
;RELOC (CONT'D)

;SPECIAL RELOC--PRINT OUT A TAG

	MOVE	CH,[RADIX50 10,%TEMP]
	MOVEI	TA,2*FIXNUM
	PUSHJ	PP,PUTSYM		;PUT OUT LOCAL SYMBOL
	MOVE	TA,[SIXBIT "%PARAM"]	;PRINT OUT "%PARAM" AS A TAG
	JRST	MISRL9

MISRL8:	MOVEI	CH,HDROUT
	MOVE	TA,PAGCNT
	CAIL	TA,^D30
	MOVEI	CH,LCRLF
	PUSHJ	PP,(CH)
	MOVE	TA,[SIXBIT "%LIT"]	;PRINT OUT "%LITNN" AS A TAG
	IOR	TA,DECSEG


MISRL9:	PUSH	PP,TA			;SAVE SYMBOL
	PUSHJ	PP,TABS3
	PUSHJ	PP,SIXOUT
	MOVEI	CH,":"
	PUSHJ	PP,PUTLST
	SWON	FASPAR!FRELOC
	PUSHJ	PP,LCRLF
	POP	PP,TC			;GET SYMBOL BACK
	PUSHJ	PP,RADX50
	ADD	CH,[<RADIX50 10,>+<1*50*50*50*50*50>]
	MOVE	TA,PC
	PUSHJ	PP,PUTSYM		;OUTPUT AS LOCAL SYMBOL
	JRST	GET
;END OF ASSEMBLY

ENDASY:	PUSHJ	PP,CLRDAT	;CLEAR OUT DATGRP
	TSWT	FASSEG		;HAVE WE DONE ANY NON-RESIDENT SEGMENTS?
	JRST	NDASY2		;NO

	PUSHJ	PP,CLROVR	;YES--CLEAR OUT OVERLAY TABLE
	JRST	NDASY3

NDASY2:	PUSHJ	PP,EXTOUT	;WRITE OUT EXTERNAL REQUESTS

	PUSHJ	PP,ENDBLK	;PUT OUT END BLOCK

NDASY3:	MOVE	OP,HILOC
	TSWF	FREENT		;RE-ENTRANT PROGRAM?
	 JRST	[ADD OP,HPLOC	;YES, ADD HIGH SEG SIZE
		SUBI OP,400000	; (JUST GET TOTAL SIZE)
		JRST .+1]
	SUB	OP,OBJSIZ	;MAX MEMORY WE CAN USE
	JUMPLE	OP,NDASY4	;JUMP IF OK
	OUTSTR	[ASCIZ/%MEMORY SIZE exceeded in object program
/]				;PRINT WARNING TO USER

NDASY4:	TSWF	FNOLST		;ANY LISTING?
	JRST	NDASY0		;NO

	MOVE	TE,[POINT 7,[ASCIZ "
				END"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,[POINT 7,[ASCIZ "	START."]]
	SKIPN	SLASHJ		;FORCE START ADDR?
	SKIPN	SUBPRG		;NO, MAIN PROGRAM?
	PUSHJ	PP,LSTMES	;YES, LIST "END START."
	PUSHJ	PP,LCRLF
	PUSHJ	PP,PBREAK	;PRINT OUT PROGRAM BREAK
	SKIPE	OPTSW##		;SKIP IF OPTIMIZER NOT CALLED
	PUSHJ	PP,OPTSUM	; IT WAS-- GO PRINT SUMMARY

NDASY0:	SKIPE	LSTDEV
	SWOFF	FNOLST;
	PUSHJ	PP,CNTOUT
	SKIPLE	GAERAS		;ANY ASSEMBLY ERRORS?
	PUSHJ	PP,NDASY5
IFE DEBUG!FT68274,<
	TSWF	FFATAL		;IN STANDARD VERSION, IF FATAL
	CLOSE	BIN,$CLS40	;  ERROR, DISCARD NEW REL, KEEP OLD
>
	RELEASE	BIN,		;THROW AWAY BIN DEVICE
	SKIPE	CREFSW		;IF '/C',
	PUSHJ	PP,CREF		;  PUT OUT CREF LISTING
IFN DEBUG,<
 IFE FT68274,<
	PUSHJ	PP,SUMARY
>>
	MOVEI	CH,14
	PUSHJ	PP,PUTLST
	RELEASE LST,

IFN DEBUG,<	EXTERNAL KILL,KILLF,%KILLG,%KILFG,CORESW
	MOVE	TA,CORESW
	TLNE	TA,%KILLG
	JRST	KILL
	TLNE	TA,%KILFG
	JRST	KILLF
>
;DELETE ALL SCRATCH FILES AND RELEASE I/O CHANNELS, THEN RESTART COMPILATION

	MOVE	I0,[RENAME FSC,I1]
	MOVSI	TA,(CLOSE FSC,)
	MOVSI	TB,(RELEASE FSC,)

NDASY1:	CAME	I0,[RENAME LIT,I1]
	JRST	NDAS1A
	SKIPGE	LITBLK
	JRST	NDAS1B
NDAS1A:	CAME	I0,[RENAME CRF,I1]
	JRST	NDAS1C
	SKIPN	CREFSW
	JRST	NDAS1B
NDAS1C:	SETZB	I1,I2
	SETZB	I3,I4
	XCT	TA
	XCT	I0
	  JFCL			;IGNORE ERRORS
	XCT	TB
NDAS1B:	CAMN	I0,[RENAME LSC,I1]
	JRST	RESTRT
	ADD	I0,[1B12]
	ADD	TA,[1B12]
	ADD	TB,[1B12]
	JRST	NDASY1

NDASY5:	SWON	FFATAL		;[653] TURN ON FATAL ERRORS SEEN
	PUSHJ	PP,PUTQRY
	MOVE	TE,GAERAS
	MOVE	TA,[POINT 7,[ASCIZ " ASSEMBLY ERROR"]]
	PUSHJ	PP,CNTO4	;PUT OUT "N ASSEMBLY ERROR(S)"
	MOVE	TA,[POINT 7,[ASCIZ ":	*** COMPILER BUG! ***"]]
	PUSHJ	PP,CNTO6	;PRINT TEXT TO LET USER KNOW IT'S A
				; REAL COMPILER BUG
	TSWT	FLTTY;
	OUTSTR	[ASCIZ "
"]
	JRST	LCRLF		;CRLF TO LISTING

;TYPE OUT "?" AND BUMP JOBERR

PUTQRY:	MOVE	TE,[POINT 7,[ASCIZ "
?"]]
	TSWF	FLTTY		;LISTING ON TTY?
	JRST	PUTQR2		;YES
	OUTSTR	(TE)		;NO


PUTQR1:	AOS	TD,.JBERR##
	TRNN	TD,-1
	SOS	.JBERR
	POPJ	PP,

PUTQR2:	PUSHJ	PP,LSTMES
	SOS	PAGCNT
	JRST	PUTQR1
;PUT OUT MESSAGE FOR NUMBER OF ERRORS

CNTOUT:	PUSHJ	PP,TTYON##	; TURN ON TTY TO GET SUMMARY LINE [266]
	PUSHJ	PP,LCRLF
	PUSHJ	PP,LCRLF
	SKIPE	FTOOBG##	;LOW SEG SIZE TOO BIG?
	 PUSHJ	PP,CNTOU1	;YES, COMPLAIN ABOUT IT
	SKIPE	COUNTF		;ANY FATAL ERRORS?
	PUSHJ	PP,PUTQRY	;YES--TYPE "?"

	MOVE	TD,COUNTW	;ANY ERRORS
	ADD	TD,COUNTF	;  AT ALL?
	JUMPE	TD,CNTO2

	MOVE	TE,COUNTF
	MOVE	TA,[POINT 7,[ASCIZ " Fatal Error"]]
	PUSHJ	PP,CNTO3
	MOVE	TA,[POINT 7,[ASCIZ ", "]]
	PUSHJ	PP,CNTO6
	MOVE	TE,COUNTW
	MOVE	TA,[POINT 7,[ASCIZ " Warning"]]
CNTO1:	PUSHJ	PP,CNTO3
IFN ANS74,<
	SKIPE	FLGSW##		;DID USER ASK FOR FLAGGER?
	PUSHJ	PP,CNTFV	;YES, RECORD VIOLATIONS
>
	TSWT	FLTTY;
	OUTSTR	[ASCIZ "
"]
IFN ANS74,<
	SKIPE	FLGSW##		;DID USER ASK FOR FLAGGER?
	JRST	FLCRLF		;YES
>
	JRST	LCRLF		;NO

CNTO2:	MOVE	TE,[POINT 7,[ASCIZ "No Errors Detected"]]
	PUSHJ	PP,LSTMES
IFN ANS74,<
	SKIPN	FLGSW##		;DID USER ASK FOR FLAGGER?
	JRST	LCRLF		;NO
	MOVE	TE,[POINT 7,[ASCIZ ", "]]
	PUSHJ	PP,LSTMES	;ON LISTING ONLY
	PUSHJ	PP,CNTFV1	;RECORD VIOLATIONS
INTERN	FLCRLF
FLCRLF:	PUSHJ	PP,LCRLF
	MOVE	TE,[POINT 7,[ASCIZ /Flagging requested /]]
	PUSHJ	PP,LSTMES
	SKIPL	TA,FLGSW	;GET FLAGGING REQUESTED
	JRST	FLG1		;NORMAL CASE
	SETCM	TA,FLGSW	;FLAG EXCEPTIONS TO
	MOVE	TE,[POINT 7,[ASCIZ /for /]]
	PUSHJ	PP,LSTMES
	SETO	TE,		;FIPS LEVELS ARE SPECIAL
	TRZE	TA,%LV.H	; AS WE ONLY PRINT THE LOWEST
	MOVEI	TE,^D35-^L<%LV.H>
	TRZE	TA,%LV.HI
	MOVEI	TE,^D35-^L<%LV.HI>
	TRZE	TA,%LV.LI
	MOVEI	TE,^D35-^L<%LV.LI>
	TRZE	TA,%LV.L
	MOVEI	TE,^D35-^L<%LV.L>
	JRST	FLG7		;COMMON CODE

FLG1:	MOVE	TE,[POINT 7,[ASCIZ /at /]]
	PUSHJ	PP,LSTMES
	SETO	TE,		;FIPS LEVELS ARE SPECIAL
	TRZE	TA,%LV.L	; AS WE ONLY PRINT THE HIGHEST
	MOVEI	TE,^D35-^L<%LV.L>
	TRZE	TA,%LV.LI
	MOVEI	TE,^D35-^L<%LV.LI>
	TRZE	TA,%LV.HI
	MOVEI	TE,^D35-^L<%LV.HI>
	TRZE	TA,%LV.H
	MOVEI	TE,^D35-^L<%LV.H>
FLG7:	JUMPL	TE,FLG3		;NO FIPS LEVELS
	MOVE	TE,FIPTBL##(TE)	;GET BYTE POINTER
	PUSHJ	PP,LSTMES
	JUMPE	TA,LCRLF		;NOTHING LEFT TO DO?
FLG2:	SKIPL	FLGSW		;SEE WHICH SEPATATOR TO USE
	SKIPA	TE,[POINT 7,[ASCIZ / + /]]
	MOVE	TE,[POINT 7,[ASCIZ /, /]]
	PUSHJ	PP,LSTMES
FLG3:	SETZ	TE,0
	MOVEI	TD,1		;INITIALIZE LOOP
FLG4:	TDZE	TA,TD		;SEE IF WE HAVE FOUND THE BIT
	JRST	FLG5		;YES
	LSH	TD,1		;NO
	AOJA	TE,FLG4		;TRY NEXT BIT

FLG5:	MOVE	TE,FIPTBL(TE)	;GET MESSAGE
	PUSHJ	PP,LSTMES
	JUMPN	TA,FLG2		;LOOP IF STILL MORE
>
	JRST	LCRLF

;NUMBER OF ERRORS IS IN TE, TA HAS BYTE-POINTER TO TEXT

CNTO3:	JUMPN	TE,CNTO4	;IS NUMBER ZERO?
	MOVEI	CH,"N"		;YES--
	PUSHJ	PP,CNTO10	;  TYPE
	MOVEI	CH,"o"		;  AND PRINT
	PUSHJ	PP,CNTO10	;  'NO'
	SKIPA

CNTO4:	PUSHJ	PP,CNTO9
	PUSHJ	PP,CNTO6
	CAIN	TE,1
	POPJ	PP,

	MOVEI	CH,"s"
	JRST	CNTO10
;PUT OUT ERROR MESSAGE (CONT'D)

;PUT OUT TEXT

CNTO6:	TSWT	FLTTY;
	OUTSTR	(TA)

CNTO7:	ILDB	CH,TA
	JUMPE	CH,CPOPJ
	PUSHJ	PP,PUTLST
	JRST	CNTO7

;PUT OUT NUMBER

CNTO9:	MOVE	TD,TE
CNTO9A:	IDIVI	TD,^D10
	HRLM	TC,(PP)
	SKIPE	TD
	PUSHJ	PP,CNTO9A

	HLRZ	CH,(PP)
	ADDI	CH,"0"

CNTO10:	TSWT	FLTTY;
	OUTCHR	CH
	JRST	PUTLST

IFN ANS74,<
CNTFV:	MOVE	TA,[POINT 7,[ASCIZ ", "]]
	PUSHJ	PP,CNTO6
CNTFV1:	SKIPN	TE,COUNTV##	;ANY VIOLATIONS?
	JRST	CNTFV2		;NO
	MOVE	TA,[POINT 7,[ASCIZ " Flagger Violation"]]
	JRST	CNTO3		;PRINT MESSAGE AND RETURN

CNTFV2:	MOVE	TE,[POINT 7,[ASCIZ "No Flagger Violations Detected"]]
	JRST	LSTMES		;GIVE MESSAGE AND RETURN
>
;PRINT OUT ERROR MESSAGE FOR LOW SEG SIZE EXCEEDED

CNTOU1:	PUSHJ	PP,PUTQRY	;PRINT "?"
	SWON	FFATAL;		; SO .REL FILE GETS DISCARDED
	MOVE	TE,[POINT 7,[ASCIZ/Maximum low segment size exceeded in object program
/]]
	TSWT	FLTTY		;UNLESS LISTING GOING THERE,
	OUTSTR	(TE)		; TYPE ON TTY
	PJRST	LSTMES		;PRINT MESSAGE AND RETURN
;PRINT OUT THE PROGRAM BREAK

PBREAK:	MOVE	OP,HILOC
	TSWF	FREENT		;RE-ENTRANT PROGRAM?
	JRST	PBRAK1		;YES

	MOVE	TE,[POINT 7,[ASCIZ "

Program break is "]]
	JRST	PBRAK2

PBRAK1:	MOVE	TE,[POINT 7,[ASCIZ "

High segment break is "]]
	PUSHJ	PP,LSTMES
	HRRZ	TA,HPLOC
	ADD	OP,HPLOC
	SUBI	OP,400000
	PUSHJ	PP,LSCOD4

	MOVE	TE,[POINT 7,[ASCIZ "
Low segment break is "]]

PBRAK2:	PUSHJ	PP,LSTMES
	HRRZ	TA,HILOC
	PUSHJ	PP,LSCOD4
	SUB	OP,OBJSIZ
	JUMPLE	OP,LCRLF
	MOVE	TE,[POINT 7,[ASCIZ "

'MEMORY SIZE' EXCEEDED BY "]]
	PUSHJ	PP,LSTMES
	MOVE	TA,OP
	PUSHJ	PP,LSINC2
	JRST	LCRLF
;PRINT OPTIMIZER RESULTS

OPTSUM:	MOVE	TE,[POINT 7,[ASCIZ "

Optimizer summery:

Number of instructions deleted:	"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,INDELC##
	PUSHJ	PP,PRTDEC	;PRINT # INSTRUCTIONS DELETED

	MOVE	TE,[POINT 7,[ASCIZ "
Number of tags deleted:		"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,TAGDLC##
	PUSHJ	PP,PRTDEC	;PRINT # TAGS DELETED
	PJRST	LCRLF		;PRINT CRLF, THEN RETURN

;PRINT A NUMBER

PRTDEC:	SKIPA	TC,[^D10]	;BASE 10
PRTOCT:	MOVEI	TC,8		;BASE 8
PRTBAS:	IDIV	TE,TC
	PUSH	PP,TD
	SKIPE	TE
	PUSHJ	PP,PRTBAS
	POP	PP,CH
	ADDI	CH,"0"
	PJRST	PUTLST		;PRINT DIGIT, RECURSE
;PUT OUT A DATA WORD ONTO BINFIL
;ENTER WITH DATA WORD IN TB, RELOCATION BITS IN TA

PUTDAT:	SKIPN	BINDEV			;ANY BINARY FILE?
	POPJ	PP,			;NO--RETURN

	IDPB	TA,RB			;PUT AWAY RELOCATION
	MOVEM	TB,(GP)			;PUT WORD IN NEXT SLOT
	AOS	DATGRP			;KICK UP ITEM COUNT
	CAIN	TA,1B33			;EXTERNAL?
	TRNN	W2,-1			;AND OFFSET
	JRST	PDAT0			;NO
	HRRZ	CH,W1
IFN BIS,<
	CAIN	CH,E0.6##		;E0.6
	MOVE	CH,[RADIX50 60,E0.6]
	CAIN	CH,E0.7##		;E0.7
	MOVE	CH,[RADIX50 60,E0.7]
	CAIN	CH,E0.9##		;E0.9
	MOVE	CH,[RADIX50 60,E0.9]
>
	TLNN	CH,-1			;DID WE GET A VALID EXTERNAL?
	JRST	PDAT0			;NO
	PUSH	PP,CH			;YES
	PUSHJ	PP,CLRDAT		;YES, DUMP BLOCK
	MOVE	CH,[2,,2]		;NEED SYMBOL FIXUP
	PUSHJ	PP,PUTBIN
	MOVSI	CH,(1B3)		;RHS RELOC
	PUSHJ	PP,PUTBIN
	POP	PP,CH
	PUSHJ	PP,PUTBIN
	MOVSI	CH,400000		;RHS FIXUP
	HRR	CH,PC
	JRST	PUTBIN

PDAT0:	AOBJN	GP,PDAT3	;BLOCK FULL YET?
	TSWF	FASSEG		;ARE WE IN OVERLAY SEGMENT?
	JRST	PDAT5		;YES
	MOVEI	TD,^D17		;NO
	MOVE	TE,[XWD -^D20,DATGRP]	;WRITE IT OUT

PDAT1:	AOS	DATGRP

PDAT2:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,PDAT2

	ADDM	TD,DATGRP+2

PDATI:	TSWF	FASSEG		;OVERLAY SEGMENT?
	JRST	PDAT7		;YES--USE OTHER ROUTINE

	MOVSI	TE,1B19		;RELOCATION FOR PC
	MOVEM	TE,DATGRP+1

	HRLZ	TE,BLKTYP
	MOVEM	TE,DATGRP
	MOVE	GP,[XWD -^D17,DATGRP+3]	;RESET POINTER
	MOVE	RB,[POINT 2,DATGRP+1,1]	;RESET RELOCATION BYTE POINTER

PDAT3:	POPJ	PP,			;RETURN
;WRITE OUT ANY ENTRIES IN GRPDAT

CLRDAT:	SKIPN	BINDEV		;FORGET THE WHOLE THING IF
	POPJ	PP,		;  NO BINARY BEING WRITTEN

	HRRZ	TE,DATGRP
	SKIPN	TE		;ANYTHING IN GRPDAT?
	JRST	PDATI

	MOVEI	TD,(TE)
	MOVNI	TE,3(TE)
	MOVSS	TE
	HRRI	TE,DATGRP
	TSWT	FASSEG;
	JRST	PDAT1

	ADD	TE,[XWD 2,1]
	JRST	PDAT6

;WRITE OUT 18 WORDS OF OVERLAY BINARY

PDAT5:	MOVE	TE,[XWD -^D19,DATGRP+1]

PDAT6:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOS	OVRWRD
	AOBJN	TE,PDAT6

PDAT7:	SETZM	DATGRP+1
	SETZM	DATGRP
	MOVE	GP,[XWD -^D18,DATGRP+2]
	MOVE	RB,[POINT 2,DATGRP+1]
	POPJ	PP,
;WRITE OUT A SYMBOL DEFINITION

;ENTER WITH SYMBOL (IN RADIX 50) IN CH;   VALUE IN TA


PUTSYM:	SKIPN	OVRWRD		;DON'T PUT SYMBOLS IN OVERLAY FILE
	SKIPN	BINDEV
	POPJ	PP,

	MOVE	TE,SYMLC1
	MOVEM	CH,0(TE)
	MOVEM	TA,1(TE)

	TSWT	FRELOC		;IF NOT RELOCATABLE,
	TDCA	TE,TE		;  USE 0,
	MOVEI	TE,1		;  ELSE USE 1

	IDPB	TE,SYMREL

	MOVEI	TE,2
	ADDM	TE,SYMLC1
	ADDM	TE,SYMGRP

	MOVE	TE,SYMREL
	TLNE	TE,770000
	POPJ	PP,

	MOVE	TE,[XWD -^D20,SYMGRP]
PSYM1:	MOVE	CH,0(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,PSYM1

PSYMI:	MOVSI	TE,2
	MOVEM	TE,SYMGRP
	SETZM	SYMGRP+1
	MOVEI	TE,SYMGRP+2
	MOVEM	TE,SYMLC1
	MOVE	TE,[POINT 4,SYMGRP+1]
	MOVEM	TE,SYMREL

	POPJ	PP,


;CLEAR OUT SYMGRP

CLRSYM:	HRRZ	TE,SYMGRP
	SKIPE	BINDEV
	SKIPN	TE
	POPJ	PP,

	ADDI	TE,2
	MOVNS	TE
	MOVSS	TE
	HRRI	TE,SYMGRP
	JRST	PSYM1
;ITEM IS INSTRUCTION

GETOPR:	LDB	OP,ASOP			;PICK UP OPERATOR
	CAIE	OP,ENDIT		;END OF INPUT?
	JRST	GETOP1
	LDB	TE,ASAC			;MAYBE--IS AC=17?
	CAIN	TE,17
	JRST	ENDASY			;YES

GETOP1:
	CAIL	OP,FSTUUO		;IS THIS A UUO??
	JRST	[OUTSTR	[ASCIZ	'?Phase G UUO conversion error
']
		SWON	FFATAL		;FATAL ERROR SWITCH
		SETZI	OP,		;ZERO OP
		JRST	.+1	]

	LSH	OP,1
	ADDI	OP,OPTABL
	SKIPE	ACSFLG##		;ALTERNATE CODE SET?
	ADDI	OP,OP2TAB-OPTABL	;YES

	MOVE	TD,(OP)			;PICK UP PDP-10 OP-CODE
	DPB	TD,[POINT 9,TB,8]	;PUT IT INTO TB

	SWOFF	FGDEC!FGNEG	;TURN OFF FLAGS
	TLNE	TD,1		;ARE DECIMAL ADDRESSES ALLOWED?
	SWON	FGDEC		;YES
	TLNE	TD,2		;ALLOWED TO PRINT AS NEGATIVE IF LARGE?
	SWON	FGNEG		;YES

	PUSHJ	PP,GETADR		;GET ADDRESS IN RH OF TB

	JRST	PUTDAT			;PUT OUT ASSEMBLED WORD AND RETURN
;LIST A PDP-10 INSTRUCTION

LSTOPR:	PUSHJ	PP,LSTCOD		;LIST CONTENTS OF TB & ANY TAG
	MOVE	TA,(OP)			;GET FLAGS
	TLNE	TA,(1B2)		;NEED TO INDENT?
	PUSHJ	PP,LST2SP		;YES, LIST 2 SPACES
	MOVE	TA,1(OP)		;GET MNEMONICS FOR OPERATOR
	CAMN	TA,[SIXBIT /PUSHJ/]	;PUSHJ CAN BE SPECIAL
	PUSHJ	PP,INDCHK		;CHECK FOR INDENTING
	PUSHJ	PP,SIXOUT		;PRINT IT OUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	SKIPL	0(OP)			;SHOULD WE PRINT AC?
	TLNE	W1,(17B12)		;ONLY IF NOT ZERO
	TRNA				;YES
	JRST	LOPR1

	MOVEI	CH,"1"			;YES
	TLNE	W1,400			;IS IT > 7?
	PUSHJ	PP,PUTLST		;YES--PRINT A 1

	LDB	CH,[POINT 3,W1,12]	;PRINT LOW-ORDER DIGIT
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST

	MOVEI	CH,","
	PUSHJ	PP,PUTLST

LOPR1:	MOVEI	CH,"@"
	TLNE	W1,20			;IS INDIRECT BIT ON?
	PUSHJ	PP,PUTLST		;YES--PUT OUT "@"

	TDNE	W1,[17,,-1]		;ADDRESS AND (XR) BOTH 0?
	JRST	LOPR2			;YES
	JUMPN	W2,LOPR2		;INCREMENT NON-ZERO
	MOVE	DT,(OP)			;GET FLAGS
	TLNE	DT,(1B1)		;DO WE PRINT ZERO ADDRESSES
LOPR2:	PUSHJ	PP,LSTADR		;LIST ADDRESS

	TLNE	W1,17			;ANY INDEX?
	PUSHJ	PP,PUTXR
	JRST	LCRLF			;NO--END OF LINE

INDCHK:	HRRZ	CH,W1			;GET ADDRESS
	CAIE	CH,C.TRCE##
	CAIN	CH,WRITE%##
	SETOM	INDFLG			;FOLLOWED BY INDENTED XWD
	POPJ	PP,
;LIST A BYTE POINTER

LSTBYT:	PUSHJ	PP,LSTCOD		;LIST CONTENTS OF TB & ANY TAG

	MOVE	TA,[SIXBIT "POINT"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	LDB	TE,[POINT 6,TB,11]	;PUT OUT BYTE SIZE
	PUSHJ	PP,DECIT
	MOVEI	CH,","
	PUSHJ	PP,PUTLST

	MOVEI	CH,"@"			;PUT OUT ANY INDIRECT
	TLNE	TB,20
	PUSHJ	PP,PUTLST

	PUSHJ	PP,LSTADR		;LIST ADDRESS

	HLL	W1,TB			;INCASE INDEX
	TLNE	TB,17			;ANY INDEX?
	PUSHJ	PP,PUTXR		;YES--LIST IT

	LDB	TD,[POINT 6,TB,5]	;GET RESIDUE
	CAIN	TD,^D36			;IS IT 36?
	JRST	LCRLF			;YES--DONE

	MOVEI	CH,","			;NO--LIST IT
	PUSHJ	PP,PUTLST
	MOVEI	TE,^D35
	SUB	TE,TD
	PUSHJ	PP,DECIT
	JRST	LCRLF
;LIST AN XWD

LSTXWD:	PUSH	PP,TC		;SAVE SECOND WORD
	PUSHJ	PP,LSTCOD	;LIST ASSEMBLED WORD AND ANY TAG
	SKIPE	INDFLG		;NEED TO INDENT?
	PUSHJ	PP,LST2SP	;YES
	MOVSI	TA,'XWD'
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	HLRZ	W2,W1		;LIST LEFT-HALF
	PUSHJ	PP,LSTADR

	MOVEI	CH,","		;PUT OUT COMMA
	PUSHJ	PP,PUTLST

	POP	PP,W1		;GET BACK SECOND WORD
	HLRZ	W2,W1		;LIST RIGHT-HALF
	PUSHJ	PP,LSTADR

	JRST	LCRLF		;PUT OUT <C.R.>,<L.F.> AND RETURN

;LIST 2 SPACES

LST2SP:	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	MOVEI	CH," "
	PJRST	PUTLST
;LIST ADDRESS

;LIST THE OPERAND IN THE ADDRESS

LSTADR:	MOVE	DT,W1
	ANDI	DT,77777
	LDB	TD,ADRTYP
	XCT	ADRTB2(TD)

	PUSHJ	PP,LSTNAM
	SWOFF	FASEXT;
	TRNE	W2,700000
	POPJ	PP,
	JRST	LSTINC
;LIST ADDRESSES   (CONT'D)

;EXTERNAL NAME
LSTEXT:	ADD	DT,EXTLOC
	TSWF	FASSEG		;ARE WE IN OVERLAY SEG?
	JRST	LSTEX1		;YES
	TLNE	TB,(Z @0)	;IF INDIRECT BIT IS OFF,
	TSWF	FREENT		;  OR PROGRAM IS RE-ENTRANT,
	JRST	LSTEX2		;  PRINT IN A NORMAL WAY

LSTEX1:	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	MOVE	TE,[POINT 7,[ASCIZ "		;"]]
	PUSHJ	PP,LSTMES
	PUSHJ	PP,LSTNAM
	TSWF	FREENT		;[151-SB]DON'T DO THIS IF REENT
	POPJ	PP,
	TSWF	FASSEG;
	SKIPGE	TE,1(DT)	;TABLE ENTRY = FULL-WORD -1?
				;(NOT SURE THIS EVER HAPPENS)
	POPJ	PP,
	CAIN	TE,-1		;RH ENTRY = -1?
	POPJ	PP,

	AOS	GAERAS
	MOVE	TE,[POINT 7,[ASCIZ "	******NO FLAG IN EXTAB******"]]
	JRST	LSTMES

LSTEX2:	SWON	FASEXT		;NO
	PUSHJ	PP,LSTNAM
	SWOFF	FASEXT;
	MOVE	TE,W1
	ANDI	TE,77777
	ADD	TE,EXTLOC
	LOAD	TE,EXENT,(TE)
	JUMPN	TE,LSTEX3		;DON'T ADD ## IF ENTRY POINT
	MOVEI	CH,"#"
	PUSHJ	PP,PUTLST
	MOVEI	CH,"#"
	PUSHJ	PP,PUTLST
LSTEX3:	TRNN	W2,700000
	JRST	LSTINC
	POPJ	PP,
;LIST ADDRESSES  (CONT'D).

;CONSTANT > 77777
LSTCON:	HRRZ	TA,W2
	TSWT	FGNEG		;COULD IT BE NEGATIVE?
	JRST	LSCONX		;NO
	HRRES	TA		;EXTEND SIGN
	JUMPGE	TA,LSCONX	;ITS NOT
	MOVMS	TA		;GET MAGNITUDE
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST
	JRST	LSCONX

;CONSTANT < 100000
LSCON1:	HRRZ	TA,W1
	ANDI	TE,77777

LSCONX:	TSWT	FGDEC;		;ARE WE ALLOWED TO PRINT IN DECIMAL?
	JRST	LSINC2		;NO
	JRST	LSINC4		;YES--USE DECIMAL


;SPECIAL TAG
LSTTAG:	MOVE	TC,W1
LSTTG1:	ANDI	TC,77777
	HRRZ	TE,TC
	ADD	TE,TAGLOC##
	MOVE	TE,(TE)
	TRC	TE,AS.PRO	;IF SAME AS A PARAGRAPH NAME,
	TRNN	TE,700000
	 JRST	LSTPNM		;LIST IT INSTEAD
	TLNN	TE,(1B0)	;INDIRECTING?
	 JRST	LSTTG2		;NO
	HRRZ	TC,TE		;YES-GET NEW TAG #
	JRST	LSTTG1		;HANDLE MORE LEVELS OF INDIRECTING

LSTTG2:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LSINC5	;LIST CONTENTS OF TC = TAG #
	JRST	LSTINC		;AND CONTENTS OF W2 = INCREMENT (IF NOT ZERO)

LSTPNM:	HRRZ	DT,TE
	ADD	DT,PROLOC
	PUSHJ	PP,LSTNAM	;LIST THE NAME
	JRST	LSTINC		;LIST INCREMENT IF ANY, RETURN

;MISCELLANEOUS
LSTMIS:	LDB	TD,	MSC.CL##	;SEE WHICH CLASS IT IS.
	JRST		@LMSTBL(TD)	;DISPATCH TO THE APPROPRIATE ROUTINE.

LMSTBL:	EXP	LODMSC
	EXP	LMSCL1
	EXP	LMSCL2			;NEG. INCREMENT

LODMSC:	LDB	TD,INCTYP
	ANDI	W2,77777
	XCT	INCTB2(TD)
LODMS5:	PUSHJ	PP,SIXOUT
	JRST	LSTINC

;NEGATIVE INCREMENT
LMSCL2:	LDB	TD,INCTYP
	XCT	INCTB2(TD)
	PUSHJ	PP,SIXOUT
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST
	MOVE	TA,W2
	JRST	LSINC1

LMSCL1:	HLR	TE,	MSCTB1(W2)	;SELECT A ROUTINE.
	JRST		(TE)		;DISPATCH.

LBASAD:	TSWT	FREENT;			;REENTRANT?
	SKIPA	TA,	[SIXBIT "%FILES"]	;NO.
	MOVE	TA,	[SIXBIT "START."]	;YES.
	PJRST		SIXOUT

;INCREMENT TO LITERAL POOL
INCLIT:	MOVE	TA,[SIXBIT "%LIT"]
	IOR	TA,DECSEG
	POPJ	PP,

;INCREMENT TO DATA DIVISION

INCDAT:	HRRZ	TA,W2
	JRST	LSINC1
;LIST ANY INCREMENT (IN W2) IN OCTAL

LSTINC:	TLNE	W2,-1		;ANYTHING IN LH?
	 JRST	LSTINA		;YES--COULD BE INCREMENT OR JUNK
	MOVE	TA,W2
	TRNN	TA,77777
	POPJ	PP,
	MOVEI	CH,"+"
	PUSHJ	PP,PUTLST
LSINC1:	ANDI	TA,77777
LSINC2:	MOVE	TD,[POINT 3,TA,17]	;NO
	ILDB	CH,TD
	TLNE	TD,770000
	JUMPE	CH,.-2

LSINC3:	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNN	TD,770000
	POPJ	PP,
	ILDB	CH,TD
	JRST	LSINC3

;LH(W2) WAS NON-ZERO
LSTINA:	TRNE	W2,-1		;RH BETTER BE 0 THEN
	 JRST	BADINC		;NOPE--BAD INCREMENT
	HLRE	TA,W2
	SKIPGE	TA		;SKIP IF POSITIVE
	 JRST	LSTINB		;NO
	MOVEI	CH,"+"
	PUSHJ	PP,PUTLST
	JRST	LSINC1
LSTINB:	MOVE	TE,[POINT 7,[ASCIZ/ - /]]
	PUSHJ	PP,LSTMES	;SPACES AROUND MINUS SIGN
				; TO DISTIGUISH INCREMENT FROM DATANAME
	MOVM	TA,TA		;GET NUMBER TO PRINT
	JRST	LSINC1


;LIST ANY INCREMENT IN DECIMAL

LSINC4:	HRRZ	TC,TA
	CAIG	TC,7
	JRST	LSINC5
	MOVEI	CH,"^"
	PUSHJ	PP,PUTLST
	MOVEI	CH,"D"
	PUSHJ	PP,PUTLST

;ENTER HERE FROM LSTTAG

LSINC5:	PUSH	PP,TB		;SAVE ANY ASSEMBLED WORD
	HRRZI	TA,0

LSINC6:	IDIVI	TC,^D10
	ADDI	TB,20
	LSHC	TB,-6
	JUMPN	TC,LSINC6

	PUSHJ	PP,SIXOUT	;PRINT THE NUMBER
	POP	PP,TB		;RESTORE THE ASSEMBLED WORD

	POPJ	PP,
;LIST INDEX

PUTXR:	MOVEI	CH,"("
	PUSHJ	PP,PUTLST
	MOVEI	CH,"1"
	TLNE	W1,10		;IS INDEX > 7?
	PUSHJ	PP,PUTLST	;YES--PUT OUT THE "1"
	LDB	CH,[POINT 3,W1,17]
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	MOVEI	CH,")"

	JRST	PUTLST		;PUT OUT PAREN AND RETURN

;LIST A NAMTAB ENTRY
;ENTER WITH RH OF DT CONTAINING THE ADDRESS OF A TABLE ENTRY.

LSTNAM:	HLRZ	TA,0(DT)
	ANDI	TA,LMASKB
	MOVEI	TE,0
	JUMPE	TA,LSNAM1	;ZERO ENTRY?

	ADD	TA,NAMLOC	;NO--GET NAMTAB ADDRESS
	HRRZ	TD,NAMNXT	;IS IT OUT OF NAMTAB?
	CAIGE	TD,(TA)
LSNAM1:	SKIPA	TD,[POINT 6,[SIXBIT "??UNKNOWN??"]]

	MOVE	TD,[POINT 6,1(TA)]	;NO
	JRST	LSNAM3

LSNAM2:	ADDI	TE,1
	PUSHJ	PP,PUTLST
LSNAM3:	ILDB	CH,TD
	TRNN	CH,60		;DONE?
	JRST	[CAIE	CH,'%'		;YES, UNLESS IT'S A %
		POPJ	PP,		;NO--EXIT
		JRST	.+1]

	ADDI	CH,40
	CAIN	CH,";"		;IS IT A SEMI-COLON?
	MOVEI	CH,"."		;YES--USE PERIOD
	CAIE	CH,":"		;IS IT A COLON?
	JRST	LSNAM2		;NO

	TSWT	FASEXT;		;YES--PRINTING AN EXTERNAL-NAME?
	TRCA	CH,27		;NO--USE "-"
	MOVEI	CH,"$"		;YES--USE "$"
	JRST	LSNAM2
;LIST AN EBCDIC CONSTANT.

LSTEBC:	MOVE	DT,	[POINT	9,	TB]
	JRST		LSTASE

;LIST A SIXBIT CONSTANT

LSTSIX:	SKIPA	DT,[POINT 6,TB]


;LIST AN ASCII CONSTANT

LSTASC:	MOVE	DT,[POINT 7,TB]
LSTASE:	MOVE	OP,[POINT 7,GHOLD]
	MOVEI	W2,42
	PUSHJ	PP,GETASY	;GET FIRST WORD
	MOVE	TB,CH
	SETZ	TA,
	TSWF	FNOLST		;ANY LISTING?
	JRST	ASCSX0		;NO
	PUSH	PP,CH		;YES, SAVE WORD
	PUSH	PP,TC		;AND WORD COUNT
	PUSHJ	PP,LSTCOD	;LIST PC AND FIRST WORD
	POP	PP,TC
	POP	PP,CH		;RESTORE FIRST WORD
	TDZA	TA,TA		;PUT OUT TO BINFIL

ASCSX1:	PUSHJ	PP,GETASY
	MOVE	TB,CH
ASCSX0:	PUSHJ	PP,PUTDAT
	ADDI	PC,1
	TSWT	FNOLST		;ANY LISTING?
	JRST	ASCSX2

	SOJG	TC,ASCSX1
	POPJ	PP,

ASCSX2:	ILDB	CH,DT
	TLNE	DT,1000			;IS IT EBCDIC?
	JRST	ASCSX4			;YES, GO CONVERT IT.
	TLNE	DT,100			;SIXBIT?
	JRST	ASCS2I			;NO
	JUMPE	CH,[ADD	TA,[1,,0]		;JUST COUNT SPACES
		JRST	ASCS2J]			;IN CASE TRAILING NULLS
	ADDI	CH,40			;YES, CONVERT TO ASCII
	JUMPE	TA,ASCS2I		;ANY SPACES TO PUT OUT?
	PUSH	PP,CH			;YES
	MOVEI	CH," "
	IDPB	CH,OP
	SUB	TA,[1,,0]
	JUMPN	TA,.-3			;LOOP
	POP	PP,CH
ASCS2I:	CAIN	CH,42			;COME BACK HERE WITH AN ASCII
					;CHAR FROM THE EBCDIC CONVERSION
					;ROUTINE.

	MOVEI	W2,"/"
	JUMPE	CH,.+3			;IGNORE NULL
	CAIGE	CH,	40		;WILL IT PRINT?
	MOVEI	CH,	"\"		;NO, REPLACE IT.
	IDPB	CH,OP
ASCS2J:	TLNE	DT,760000
	JRST	ASCSX2

	HRRI	DT,TB-1
	SOJG	TC,ASCSX1

	MOVEI	CH,0		;SET "END OF CONSTANT"
	IDPB	CH,OP
;LIST A SIXBIT OR ASCII CONSTANT  (CONT'D)

ASCSX3:	SETOM	TAGOUT
	MOVE	TE,[POINT 7,[ASCIZ "SIXBIT	"]];ASSUME SIXBIT.
	TLNN	DT,	100		;IS IT?
	JRST		ASCS3Q		;YES, GO ON.
	TLNE	DT,	1000		;IS IT ASCII OR EBCDIC?
	SKIPA	TE,[POINT 7,[ASCIZ "EBCDIC	"]];MUST BE EBCDIC.
	MOVE	TE,[POINT 7,[ASCIZ "ASCII	"]];MUST BE ASCII.
ASCS3Q:	PUSHJ	PP,LSTMES

	MOVE	CH,W2
	PUSHJ	PP,PUTLST
	MOVE	TE,[POINT 7,GHOLD]
	PUSHJ	PP,LSTMES
	MOVE	CH,W2
	PUSHJ	PP,PUTLST
	JRST	LCRLF

ASCSX4:	ROT	CH,	-2		;FORM THE TABLE INDEX.
	JUMPL	CH,	ASCS4I		;LEFT OR RIGHT HALF.
	HLR	CH,	EBASC.##(CH)	;LEFT.
	CAIA
ASCS4I:	HRR	CH,	EBASC.##(CH)	;RIGHT.
	TLNN	CH,	(1B1)		;IS THE CHAR RIGHT JUSTIFIED?
	LSH	CH,	-^D9		;IT IS NOW.
	ANDI	CH,	177		;GET RID OF ANY JUNK.
	JRST		ASCS2I		;RETURN.
;LIST A ONE-WORD DECIMAL CONSTANT

LSTD1:	MOVSI	TA,'DEC'
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TE,TB
	JRST	DECIT
;LIST A TWO-WORD DECIMAL CONSTANT

LSTD2:	MOVSI	TA,'DEC'
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	PUSHJ	PP,GETASY
	PUSH	PP,CH
	PUSH	PP,TB
	MOVE	TB,CH
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT
	SUBI	CT,1
	POP	PP,TD		;TD_LEFT HALF
	MOVE	TC,(PP)		;TC_RIGHT HALF

	JUMPGE	TD,LSTD2A	;IS IT NEGATIVE?
	MOVEI	CH,"-"		;YES -- PUT OUT MINUS SIGN
	PUSHJ	PP,PUTLST
	SETCA	TD,		;MAKE THE VALUE POSITIVE
	MOVNS	TC
	TLZ	TC,1B18
	SKIPN	TC
	AOJL	TD,[MOVE TE,[POINT 7,[ASCIZ /-1*2**70/]]
		PUSHJ	PP,LSTMES
		JRST	LSTD2C]		;LOW-VALUES

LSTD2A:	JUMPE	TD,LSTD2D
	DIV	TD,[DEC 10000000000]
	PUSH	PP,TC
	MOVE	TE,TD
	PUSHJ	PP,DECIT
	POP	PP,TD

	SKIPA	TB,[XWD -^D9,DECTAB]
LSTD2B:	MOVE	TD,TC
	IDIV	TD,(TB)
	MOVEI	CH,"0"(TD)
	PUSHJ	PP,PUTLST
	AOBJN	TB,LSTD2B

	MOVEI	CH,"0"(TC)
	PUSHJ	PP,PUTLST

LSTD2C:	PUSHJ	PP,STRTI9

	POP	PP,TB
	JRST	LSTCOD

LSTD2D:	MOVE	TE,TC
	PUSHJ	PP,DECIT
	JRST	LSTD2C
;ASSEMBLE A FLOATING POINT CONSTANT

FLTCON:	PUSH	PP,LN		;SAVE LN
	SUBI	CH,^D8		;REDUCE EXPONENT BY 8
	MOVEM	CH,FLTC1	;SAVE EXPONENT
	PUSHJ	PP,GETASY	;GET AND SAVE MANTISSA
	MOVEM	CH,FLTC2

	SUBI	CT,1		;DECREMENT WORD COUNT

	MOVEI	TB,0		;CLEAR TB
	SKIPA	TD,[POINT 4,FLTC2,3]

FLTCN1:	IMULI	TB,^D10		;CREATE MANTISSA
	ILDB	TC,TD
	ADD	TB,TC
	TLNE	TD,770000
	JRST	FLTCN1

	JUMPE	TB,FLTC12	;ZERO?

	MOVEI	LN,243		;MAXIMUM BINARY EXPONENT

	TLNE	TB,777777	;IF MANTISSA
	JRST	FLTCN3		;  IS ZERO IN LEFT-HALF,
	SUBI	LN,^D17		;  DECREMENT EXPONENT AND
	LSH	TB,^D17		;  SHIFT MANTISSA
FLTCN3:	TLNE	TB,777000	;IF MANTISSA
	JRST	FLTCN4		;  IS ZERO IN FIRST 8 BITS,
	LSH	TB,^D8		;  SHIFT LEFT
	SUBI	LN,^D8		;  AND DECREMENT EXPONENT
FLTCN4:	TLNE	TB,(1B1)	;SHIFT MANTISSA
	JRST	FLTCN5		;  UNTIL BIT 1
	LSH	TB,1		;  IS NON-ZERO
	SOJA	LN,FLTCN4

FLTCN5:	MOVM	TE,FLTC1	;GET TENS EXPONENT
	CAILE	TE,^D100	;IF TOO BIG,
	JRST	FLTBIG		;  FORGET IT
	JUMPE	TE,FLTCN9	;IF ZERO, WE'RE DONE

FLTCN6:	MOVEI	TC,0		;SET 'LEFT OVER' TO ZERO
	CAIG	TE,^D38		;IF EXPONENT
	JRST	FLTCN7		;  IS GREATER THAN 38
	MOVEI	TC,-^D38(TE)	;  SAVE 'LEFT OVER'
	MOVEI	TE,^D38		;  AND RESET EXPONENT TO 38

FLTCN7:	LSH	TE,1		;[762] TWO WORDS PER ENTRY
	SKIPGE	FLTC1		;POSITIVE EXPONENT?
	MOVNS	TE		;NO--GET NEGATIVE

	MUL	TB,FLTAB1(TE)	;MULTIPLY BY TABLE VALUE

	TLNE	TB,(1B1)	;IF NOT
	JRST	FLTCN8		;  NORMALIZED,
	LSH	TB,1		;  THEN NORMALIZE IT
	SUBI	LN,1

FLTCN8:	LSH	TE,-1		;[762] TWO WORDS PER ENTRY
	IDIVI	TE,4		;GET EXPONENT FROM
	LDB	TE,FLTAB2(TD)	;  TABLE
	ADDI	LN,-200(TE)	;ADD TO THE ONE WE'VE BEEN CARRYING
	SKIPE	TE,TC		;IF ANY EXPONENT WAS LEFT OVER,
	JRST	FLTCN6		;  MAKE ANOTHER ITERATION

FLTCN9:	ADDI	TB,200		;ROUND THE MANTISSA
	JUMPGE	TB,FLTC10	;IF NECESSARY,
	LSH	TB,-1		;  ADJUST MANTISSA
	ADDI	LN,1		;  AND EXPONENT

FLTC10:	TRNE	LN,777400	;IF EXPONENT IS TOO BIG,
	JRST	FLTBIG		;  WE LOSE
	LSH	TB,-^D8		;MAKE ROOM FOR EXPONENT
	DPB	LN,[POINT 9,TB,8];STASH EXPONENT
	LDB	TA,[POINT 4,FLTC2,3];GET SIGN OF ITEM
	SKIPE	TA		;IF NOT POSITIVE,
	MOVNS	TB		;  NEGATE THE RESULT

FLTC12:	MOVEI	TE,^D8		;BUMP EXPONENT
	ADDM	TE,FLTC1	;  TO ORIGINAL VALUE
FLTC13:	POP	PP,LN		;[762] RESTORE LN
	POPJ	PP,

F2BIG:	SKIPA	TE,[POINT 7,[ASCIZ "
				****** BAD COMP-2 CONSTANT ******

"]]				;[762]
FLTBIG:	MOVE	TE,[POINT 7,[ASCIZ "
				****** BAD COMP-1 CONSTANT ******

"]]
	PUSHJ	PP,LSTMES
	AOS	GAERAS
	MOVNI	TB,3
	ADDM	TB,PAGCNT
	MOVEI	TB,0
	JRST	FLTC12
;LIST A FLOATING POINT CONSTANT

LSTFLT:	MOVE	TA,[SIXBIT "FLOAT"]
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	LDB	CH,[POINT 4,FLTC2,3]	;IS THE VALUE POSITIVE?
	JUMPE	CH,LSFLT1
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST

LSFLT1:	MOVSI	TA,'0. '
	PUSHJ	PP,SIXOUT

	MOVE	TA,FLTC2	;[762] GET MANTISSA
	MOVEI	TB,10

LSFLT2:	LSH	TA,4		;[762] GET NEXT DIGIT LINED UP
	JUMPE	TA,LSFLT3	;[762] ALL DONE WITH MANTISSA
	LDB	CH,[POINT 4,TA,3]	;[762] GET DIGIT
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	SOJG	TB,LSFLT2

LSFLT3:	SKIPN	TE,FLTC1	;[762]
	POPJ	PP,

	MOVEI	CH,"E"
	PUSHJ	PP,PUTLST
	JRST	DECIT
;[762] ASSEMBLE A D. P. FLOATING POINT CONSTANT

F2CON:	PUSH	PP,LN		;[762] SAVE LN
	PUSHJ	PP,GETASY	;[762] GET AND SAVE
	MOVEM	CH,FLTC1	;[762] EXPONENT
	PUSHJ	PP,GETASY	;[762] GET AND SAVE
	MOVEM	CH,FLTC2	;[762] FIRST 8 DIGITS OF MANTISSA
	SUBI	CT,1		;[762] DECREMENT WORD COUNT
	CAIG	CT,1		;[762] ONLY 2 WORDS SUPLIED?
	JRST	F2CNZ1		;[762] YES, ZERO THE SECOND AND THIRD WORDS
	PUSHJ	PP,GETASY	;[762] SAME FOR SECOND WORD
	MOVEM	CH,FLTC2+1	;[762]
	SUBI	CT,1		;[762] DECREMENT WORD COUNT
	CAIG	CT,1		;[762] ONLY 3 WORDS SUPLIED?
	JRST	F2CNZ2		;[762] YES, ZERO THE THIRD WORD
	PUSHJ	PP,GETASY	;[762] SAME FOR SECOND WORD
	MOVEM	CH,FLTC2+2	;[1024] [762]
	SOJA	CT,F2CON0	;[762] DECREMENT THE COUNT

F2CNZ1:	SETZM	FLTC2+1		;[762] ZERO THE SECOND WORD
F2CNZ2:	SETZM	FLTC2+2		;[762] ZERO THE THIRD WORD
F2CON0:	MOVE	CH,FLTC1	;[762] GET EXPONENT INTO SAFE PLACE
	SUBI	CH,^D8		;[762] REDUCE IT BY 8 DIGITS INITIALLY
	SETZB	TB,TA		;[762] CLEAR FRACTION
	SKIPA	TD,[POINT 4,FLTC2,3]	;[762]

F2CN1:	IMULI	TA,^D10		;[762] CREATE MANTISSA
	ILDB	TE,TD		;[762]
	ADD	TA,TE		;[762]
	TLNE	TD,770000	;[762]
	JRST	F2CN1		;[762]

	SKIPN	FLTC2+1		;[762] ARE REMAINING WORDS ZERO?
	SKIPE	FLTC2+2		;[762]
	JRST	F3CON		;[762] NO, NEED DOUBLE PRECISION

F2CN2:	MOVEI	LN,306		;[762] INITIALIZE D. P. BINARY EXPONENT
	JUMPN	TB,F2CN3	;[762] JUMP IF HIGH ORDER WORD NON-ZERO
	EXCH	TB,TA		;[762] NO, MOVE LOW HALF TO HIGH, CLEAR LOW HALF
	SUBI	LN,^D35		;[762] AND ADJUST EXPONENT
F2CN3:	MOVE	TC,TB		;[762] GET HIGH HALF INTO TC
	JFFO	TC,F2CN4	;[762] ANY ONES NOW?
	 JRST	F2C12		;[762] NO, RESULT IS ZERO
F2CN4:	EXCH	TB,TC		;[762] PUT SHIFT COUNTER IN TC
	ASHC	TB,-1(TC)	;[762] NORMALIZE D.P. INTEGER TO PUT BIN POINT BETWEEN BITS 0 AND 1
	SUBI	LN,-1(TC)	;[762] ADJUST EXPONENT TO COMPENSATE FOR SHIFT
F2CN5:	JUMPE	CH,F2CN9	;[762] DECIMAL EXPONENT = 0, NO MUL BY 10 NEEDED
F2CN6:	MOVM	TE,CH		;[762] GET MAGNITUDE OF DECIMAL EXPONENT
	CAILE	TE,PTLEN.	;[762] BETWEEN 0 AND MAX. TABLE SIZE?
	MOVEI	TE,PTLEN.	;[762] NO, SO MAKE IT SO
	SKIPGE	CH		;[762] RESTORE CORRECT SIGN
	MOVNS	TE		;[762]
	SUB	CH,TE		;[762] GET EXCESS EXPONENT
	LSH	TE,1		;[762] TABLE IS 2 WORDS PER ITEM
	DMOVE	TD,TB		;[762] MOVE TO FIRST PAIR OF 4 ACCS
	DMUL	TD,FLTAB1(TE)	;[762] RESULT IN TB & TA
	DMOVE	TB,TD		;[762] GET HIGH PAIR
	TLNE	TB,(1B1)	;[762] NORMALIZED?
	JRST	F2CN7		;[762] YES
	ASHC	TB,1		;[762] NO, SHIFT LEFT ONE PLACE
	SUBI	LN,1		;[762] AND ADJUST EXPONENT

F2CN7:	LSH	TE,-1		;[762] TWO WORDS PER ENTRY
	IDIVI	TE,4		;[762] GET EXPONENT FROM
	LDB	TE,FLTAB2(TD)	;[762]   TABLE
	ADDI	LN,-200(TE)	;[762] ADD TO THE ONE WE'VE BEEN CARRYING
	JUMPN	CH,F2CN6	;[762] IF ANY EXPONENT WAS LEFT OVER, MAKE ANOTHER ITERATION

F2CN9:	TLO	TB,(1B0)	;[762] START ROUNDING (ALLOW FOR OVERFLOW)
	TLO	TA,(1B0)	;[762] ALLOW FOR CARRY'S
	ADDI	TA,200		;[762] LOW WORD ROUNDING
	TLZN	TA,(1B0)	;[762] DID CARRY PROPAGATE INTO HIGH WORD?
	ADDI	TB,1		;[762] YES
	TLZE	TB,(1B0)	;[762] DID CARRY PROPAGATE TO BIT 0?
	JRST	F2CN10		;[762] NO
	ASHC	TB,-1		;[762] YES, RENORMALIZE TO RIGHT
	ADDI	LN,1		;[762] ADJUST BINARY EXPONENT
	TLO	TB,(1B1)	;[762] AND TURN ON HIGH FRACTION BIT
F2CN10:	TRNE	LN,777400	;[762] IF EXPONENT IS TOO BIG,
	JRST	F2BIG		;[1055] [762]   WE LOSE
	ASHC	TB,-^D8		;[762] MAKE ROOM FOR EXPONENT
	DPB	LN,[POINT 9,TB,8]	;[762] STASH EXPONENT
	LDB	TE,[POINT 4,FLTC2,3]	;[762] GET SIGN OF ITEM
	SKIPE	TE		;[762] IF NOT POSITIVE,
	DMOVN	TB,TB		;[762]   NEGATE THE RESULT
	JRST	FLTC13		;[762] RETURN

F2C12:	SETZB	TB,TA		;[762] RESULT IS ZERO
	JRST	FLTC13		;[762] RETURN

;HERE WHEN MORE THAN 8 DIGITS IN NUMBER

F3CON:	SUBI	CH,^D10		;[762] REDUCE EXPONENT BY 10 MORE DIGITS
	IMULI	TB,^D10		;[762] MAKE ROOM FOR NINTH DIGIT
	ILDB	TE,TD		;[762] GET IT
	ADD	TB,TE		;[762]
F3CN1:	ILDB	TE,TD		;[762] GET NEXT DIGIT
F3CN2:	IMULI	TC,^D10		;[762] MULTIPLY HIGH D. P. FRACTIONBY 10
	MULI	TB,^D10		;[762] MULTIPLY LOW D. P. FRACTION BY 10
	ADD	TC,TB		;[762] ADD HIGH PART OF LOW PRODUCT INTO RESULT
	MOVE	TB,TA		;[762] GET LOW PART OR LOW PRODUCT
	TLO	TB,(1B0)	;[762] STOP OVERFLOW IF CARRY INTO HIGH WORD
	ADD	TB,TE		;[762] ADD IN NEXT DIGIT
	TLZN	TB,(1B0)	;[762] SKIP IF NO CARRY
	ADDI	TC,1		;[762] PROPAGATE CARRY INTO HIGH WORD
	TLNE	TD,770000	;[762] ANY MORE DIGITS IN THIS WORD?
	JRST	F3CN1		;[762] YES, GET NEXT DIGIT
	JUMPE	TD,F2CN2	;[762] JOINT MAIN LINE
	ILDB	TE,TD		;[762] GET 18 TH DIGIT
	SETZ	TD,		;[762] SIGNAL END
	JRST	F3CN2		;[762] STORE IT
;[762] LIST A D. P. FLOATING POINT CONSTANT

LSTF2:	SKIPN	FLTC2+1		;[762] SECOND WORD ZERO?
	SKIPE	FLTC2+2		;[762] AND THIRD WORD ZERO?
	SKIPA	TA,[SIXBIT "FLOAT"]	;[762] NO, DO IT THE HARD WAY
	JRST	LSTFLT		;[762] YES, TREAT AS IF COMP-1
	PUSHJ	PP,SIXOUT	;[762]
	MOVEI	CH,11		;[762]
	PUSHJ	PP,PUTLST	;[762]

	LDB	CH,[POINT 4,FLTC2,3]	;[762] IS THE VALUE POSITIVE?
	JUMPE	CH,LSTF2A	;[762]
	MOVEI	CH,"-"		;[762]
	PUSHJ	PP,PUTLST	;[762]

LSTF2A:	MOVSI	TA,'0. '	;[762]
	PUSHJ	PP,SIXOUT	;[762]
	MOVE	TA,[POINT 4,FLTC2,3]	;[762]
	MOVEI	TB,^D8		;[762] PRINT ALL OF FIRST WORD
	SKIPE	FLTC2+2		;[762] AND IF THIRD WORD IS NON-ZERO
	MOVEI	TB,^D18		;[762] ALL 18 DIGITS

LSTF2B:	ILDB	CH,TA		;[762]
	ADDI	CH,"0"		;[762]
	PUSHJ	PP,PUTLST	;[762]
	SOJG	TB,LSTF2B	;[762]

	SKIPE	FLTC2+2		;[762] IF THIRD WORD WAS NON-ZERO
	JRST	LSFLT3		;[762] WE'RE DONE, OTHERWISE
	MOVE	TA,FLTC2+1	;[762] GET SECOND WORD
	MOVEI	TB,10		;[762]
	JRST	LSFLT2		;[762] PRINT SECOND WORD
;PUT LOCATION, ASSEMBLED WORD, AND ANY TAG ONTO LSTFIL

LSTCOD:	PUSHJ	PP,LISTPC

	HLRZ	TD,TB		;PRINT LH OF ASSEMBLED WORD
	MOVE	TE,[POINT 3,TD,17]
	PUSHJ	PP,LSCOD3

	MOVEI	CH," "
	TRNE	TA,1B34
	MOVEI	CH,"'"
	TRNE	TA,1B32
	MOVEI	CH,"*"
	PUSHJ	PP,PUTLST
	MOVEI	CH," "
	PUSHJ	PP,PUTLST

	MOVE	TE,[POINT 3,TB,17]	;PRINT RH OF ASSEMBLED WORD
	PUSHJ	PP,LSCOD3

	MOVEI	CH," "
	TRNE	TA,1B35
	MOVEI	CH,"'"
	TRNE	TA,1B33
	MOVEI	CH,"*"
	PUSHJ	PP,PUTLST

	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	SKIPE	TAGOUT		;A SINGLE TAG TO BE LISTED?
	JRST	LSCOD2		;NO

	MOVE	TC,SAVTAG
	PUSHJ	PP,MSTAG4

LSCOD2:	SETOM	TAGOUT
	MOVEI	CH,11
	JRST	PUTLST		;PUT OUT TAB AND RETURN

LSCOD4:	MOVE	TE,[POINT 3,TA,17]

LSCOD3:	ILDB	CH,TE		;PRINT A HALF-WORD
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNE	TE,770000
	JRST	LSCOD3
	POPJ	PP,
;PRINT OUT CURRENT PC

LISTPC:	SKIPLE	TAGOUT		;ANY TAGS OUT?
	PUSHJ	PP,LCRLF	;YES -- FINISH THE LINE

	TSWTZ	FASPAR;		;ANY PARAGRAPH NAME OUT?
	SKIPL	TAGOUT		;NO -- ANY TAG LINE?
	PUSHJ	PP,LCRLF	;YES -- PUT OUT ANOTHER <C.R.>

	MOVE	TE,[POINT 3,PC,17]	;PRINT LOCATION COUNTER
	PUSHJ	PP,LSCOD3
	MOVEI	CH,"'"
	TSWF	FRELOC;
	PUSHJ	PP,PUTLST
	MOVEI	CH,11
	JRST	PUTLST
;PUT LOCATION IN RH OF "TB", SET RELOCATION IN TA.
;OPERAND IS IN RH OF "W1".

GETADR:	LDB	TD,ADRTYP
	MOVE	TE,W1
	ANDI	TE,77777
	XCT	ADRTB1(TD)
	MOVEI	TA,1
	TLNE	W2,-1		;ANYTHING IN LH?
	 JRST	GETAD1		;YES, INCR. IS IN LH
	ADD	TB,W2
	POPJ	PP,
GETAD1:	HLRE	TE,W2		;GET POS. OR NEG. INCREMENT FROM LH(W2)
	ADD	TB,TE
	POPJ	PP,

;ADDRESS IS A CONSTANT
ADRCON:	MOVEI	TA,0
	HRR	TB,TE
	POPJ	PP,

;ADDRESS IS IN EXTAB

ADREXT:	ADD	TE,EXTLOC	;GET EXTTAB LOCATION
	HRRZ	TD,1(TE)	;PICK UP ADDRESS
	LOAD	TA,EXENT,(TE)	;IS IT AN ENTRY POINT?
	JUMPN	TA,ADEXT2	;YES - JUST USE ADDRESS
	TSWT	FASSEG		;ARE WE IN NON-RESIDENT SEGMENT?
	JRST	ADEXT0		;NO

	SKIPL	1(TE)		;YES--IS FLAG IN EXTAB ON?
	JRST	ADEXT3		;NO--IT SHOULD BE

	TLO	W1,1B31		;YES--SET INDIRECT FLAGS
	TLO	TB,1B31
	JRST	ADEXT1

ADEXT0:	JUMPN	W2,ADEXT4	;ADDITIVE GLOBAL?
	HRRM	PC,1(TE)	;SET LINK TO CURRENT LOCATION
	CAIN	TD,-1		;IS THIS FIRST REFERENCE?
	JRST	ADEXT3		;YES

ADEXT1:	HRR	TB,TD		;GET LINK ADDRESS
	MOVEI	TA,1B33+1B35	;SET RELOCATION TO EXTERNAL AND RELOCATABLE
	POPJ	PP,		;RETURN

ADEXT2:	HRR	TB,TD		;GET LINK ADDRESS
	MOVEI	TA,1B35		;SET RELOCATION ON
	POPJ	PP,		;RETURN

ADEXT3:	HLLZS	TB		;SET ADDRESS TO ZERO
	MOVEI	TA,1B33		;SET RELOCATION TO EXTERNAL
	POPJ	PP,		;RETURN

ADEXT4:	HRR	TB,W2		;SET ADDRESS TO BE ADDITIVE CONSTANT
	MOVEI	TA,1B33		;SET RELOCATION TO EXTERNAL
	POPJ	PP,		;RETURN
;ADDRESS IS IN PROTAB
ADRPRO:	HRRZ	DT,PROLOC	;GET ADDRESS OF PROTAB ENTRY
	ADD	DT,TE
	HRR	TB,1(DT)	;PICK UP THAT LOCATION
	LDB	TE,PTSEGN	;IS IT IN THE RESIDENT SEGMENT?
	JUMPN	TE,ADPRO2
	ADD	TB,RESDNT	;YES--RELOCATE
	POPJ	PP,

ADPRO2:	ADD	TB,NONRES	;RELOCATE TO NON-RESIDENT SEGMENT
	POPJ	PP,

;ADDRESS IS A GENERATED TAG

ADRTAG:	ADD	TE,TAGLOC	;GET ABSOLUTE ADDRESS
	MOVE	TE,(TE)		;GET ENTRY
	TLNN	TE,(1B0)	; USE ANOTHER TAG OR PARA?
	 JRST	ADRTG1		;NO

	TRC	TE,AS.PRO	;IS THIS A PROCEDURE NAME?
	TRNE	TE,700000
	 JRST	ADRTG2		;NO-- A TAG THEN
;ENTRY POINTS TO A PARAGRAPH. GET PC FROM PROTAB
	HRRZ	DT,PROLOC
	HRRZ	TE,TE
	ADD	DT,TE		;GET ADDRESS OF PROTAB ENTRY
	HRR	TE,1(DT)	;GET PC
	LDB	TD,PTSEGN
	JUMPN	TD,ADPRG4	;NON-RES SEC
	ADD	TE,RESDNT	;RESIDENT SECTION
	JRST	ADRTG3
ADPRG4:	ADD	TE,NONRES
	JRST	ADRTG3

ADRTG2:	ANDI	TE,77777	;GET TAG #
	JRST	ADRTAG		;MAYBE MORE LEVELS OF INDIRECTING

ADRTG1:	HRRZ	TE,TE		;GET PC
	TRZE	TE,400000	;IS IT IN RESIDENT AREA?
	JRST	.+3
	ADD	TE,RESDNT	;YES--RELOCATE BY RESIDENT BASE
	SKIPA
	ADD	TE,NONRES	;NO--RELOCATE BY NON-RESIDENT BASE
ADRTG3:	HRR	TB,TE		;PUT ADDRESS IN TB
	POPJ	PP,		;RETURN

;ADDRESS IS FILE-TABLE

ADRFIL:	HRRZ	DT,FILLOC
	ADD	DT,TE
	HRR	TB,1(DT)
	ADD	TB,FILTBL
	POPJ	PP,
;ADDRESS IS IN DATAB

ADRDAT:	HRRZ	TA,DATLOC
	ADD	TA,TE

	LDB	TE,DA.DFS
	JUMPE	TE,ADRD3
	LDB	TE,DA.DEF
	JUMPE	TE,ADRD3

	MOVEI	TE,0
	DPB	TE,DA.DFS
	PUSH	PP,TA		;SAVE IT'S ADDRESS

ADRD1:	LDB	TA,DA.BRO	;GET BROTHER OR FATHER LINK
	LDB	TE,LNKCOD
	CAIN	TE,TB.FIL	;IS IT A FILTAB ENTRY?
	JRST	ADRD2		;YES

	PUSHJ	PP,LNKSET	;NO--GET ADDRESS
	JRST	ADRD1

ADRD2:	SKIPE	TA		;ERROR, JUST GIVE UP
	PUSHJ	PP,LNKSET
	MOVE	DT,TA
	LDB	TC,FTDBAS

	POP	PP,TA
	ADDM	TC,1(TA)

ADRD3:	HRR	TB,1(TA)
	LDB	TE,DA.LKS##	;ITEM IN LINKAGE SECTION?
	MOVEI	TA,0		;IN CASE SO, SET FOR ABSOLUTE ADDR
	SKIPE	TE
	AOSA	(PP)		;IF SO, SKIP RETURN OVER THE MOVEI TA,1
	ADD	TB,DATBAS	;IF NOT ADD IN BASE OF DATA AREA
	POPJ	PP,
;THE INCREMENT IS A CONSTANT

INCCON:	HRR	TB,W2		;SET VALUE
	MOVEI	TA,0		;NO RELOCATION
	POPJ	PP,
;THE INCREMENT IS MISCELLANEOUS

INCMIS:	LDB	TE,	MSC.CL##	;SEE WHICH CLASS IT IS.
	JRST		@MSCTBL(TE)	;DISPATCH TO APPROPRIATE ROUTINE.

MSCTBL:	EXP	OLDMSC			;CLASS 0 OLD TYPE MISCELLANEOUS.
	EXP	MSCCL1			;CLASS 1 SPECIAL VALUES.
	EXP	MSCCL2			;CLASS 2  (NEGATIVE INCREMENT)
	EXP	BADINC
	EXP	BADINC
	EXP	BADINC
	EXP	BADINC
	EXP	BADINC

;CLASS 0 OLD TYPE MISCELLANEOUS:

OLDMSC:	LDB	TE,INCTYP
	XCT	INCTB1(TE)
	MOVE	TD,W2
	ANDI	TD,77777
	ADD	TB,TD
	MOVEI	TA,1		;RELOCATED
	POPJ	PP,

;SAME AS OLDMSC, BUT INCREMENT IS TO BE SUBTRACTED
;FROM BASE ADDRESS.

MSCCL2:	LDB	TE,INCTYP
	XCT	INCTB1(TE)	;SET TB = BASE ADDRESS
	MOVE	TD,W2
	ANDI	TD,77777
	SUB	TB,TD
	MOVEI	TA,1		;RELOCATED
	POPJ	PP,

;IMPROPER INCREMENT

BADINC:	MOVE	TE,[POINT 7,[ASCIZ "

				******** BAD INCREMENT *********
"]]
	PUSHJ	PP,LSTMES
	AOS	GAERAS
	MOVNI	TE,3
	ADDM	TE,PAGCNT
	HRRI	TB,0
	POPJ	PP,

;%TEMP INCREMENTS

TMPINC:	HRR	TB,TEMBAS
	SUBI	TB,2*FIXNUM
	POPJ	PP,

TMPLST:	SUBI	W2,2*FIXNUM
	MOVE	TA,[SIXBIT '%TEMP']
	POPJ	PP,

;INCREMENT IS 'GOTO..'

INCGO:
	MOVEI	TE,GOTO.##
	ANDI	TE,77777
	JRST	ADREXT

;INCREMENT IS '%FILES'

INCFLS:	MOVEI	TA,1		;RELOCATABLE
	HRRI	TB,FILO		;ADDR OF %FILES
	POPJ	PP,


;CLASS 1 INCREMENT IS A SPECIAL VALUE.

MSCCL1:	HRRZI	TE,	(W2)		;SEE WHAT IT IS.
	CAILE	TE,	LAS.M1##	;IF IT'S NOT VALID
	JRST		BADINC		; COMPLAIN.
	HRR	TE,	MSCTB1(TE)	;SELECT A ROUTINE'S ADDR.
	JRST		(TE)		;DISPATCH.

MSCTB1:	XWD	LBASAD,BASADR
	XWD	HDROUT,CPOPJ

;IT'S THE PROGRAM'S BASE ADDRESS.

BASADR:	TSWT	FREENT;			;REENTRENT CODE?
	JRST		INCFLS		;NO, PUT OUT ADDR OF %FILES.
	MOVEI	TB,	400000		;PUT OUT ADDR OF START.
	MOVEI	TA,	1		;RELOCATE IT.
	POPJ	PP,			;RETURN.
;CONVERT A SIXBIT WORD TO RADIX 50.
;ENTER WITH THE WORD IN TC;   EXIT WITH VALUE IN CH.

RADX50:	MOVEI	CH,0
	MOVE	TE,[POINT 6,TC]

RDX50A:	ILDB	TD,TE
	JUMPE	TD,RDX50C
	IMULI	CH,50

	CAIN	TD,';'		;IS IT A SEMI-COLON?
	JRST	RDX50D		;YES

	CAIN	TD,'%'		;PERCENT SIGN
	JRST	[MOVEI	TD,47		;YES, ITS SPECIAL
		JRST	RDX50E]

	CAIGE	TD,'A'
	CAIG	TD,'9'
	SKIPA
	JRST	RDX50B

	CAIN	TD,"."-40
	MOVEI	TD,45+17+7

	SUBI	TD,17
	CAILE	TD,12
	SUBI	TD,7

	CAIG	TD,46
	SKIPGE	TD
RDX50B:	MOVEI	TD,46
RDX50E:	ADD	CH,TD

	TLNE	TE,770000
	JRST	RDX50A

RDX50C:	POPJ	PP,

RDX50D:	MOVEI	TD,45		;CHANGE ";" TO "."
	JRST	RDX50E
;LIST AN OCTAL CONSTANT

LSTOCT:	MOVSI	TA,'OCT'
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TA,[POINT 3,TB]

LSOCT1:	ILDB	CH,TA
	TLNE	TA,770000
	JUMPE	CH,LSOCT1

LSOCT2:	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNN	TA,770000
	POPJ	PP,
	ILDB	CH,TA
	JRST	LSOCT2


;PRINT OUT THE DECIMAL VALUE IN TE

DECIT:	JUMPGE	TE,DECIT1
	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST
	MOVMS	TE
DECIT1:	IDIVI	TE,^D10
	HRLM	TD,(PP)
	SKIPE	TE
	PUSHJ	PP,DECIT1
	HLRZ	CH,(PP)
	ADDI	CH,"0"
	JRST	PUTLST
;PRINT OUT A SIXBIT WORD

SIXOUT:	MOVE	TE,[POINT 6,TA]
SIXOT1:	ILDB	CH,TE
	JUMPE	CH,SIXOT2
	ADDI	CH,40
	PUSHJ	PP,PUTLST
	TLNE	TE,770000
	JRST	SIXOT1
SIXOT2:	POPJ	PP,


;LIST AN XWD:

LSAXWD:	TRNN	TA,	1B34
	TLNE	TB,	-1
	SKIPA	TA,	[SIXBIT "XWD"]
	HRLI	TA,	'EXP'
	PUSHJ	PP,	SIXOUT
	MOVEI	CH,	11
	PUSHJ	PP,	PUTLST
	TLNN	TB,	-1
	JRST		LSAXWH
	MOVSS		TB
	MOVE	TA,	[POINT	3,TB,17]
	PUSHJ	PP,	LSOCT1
	MOVEI	CH,	","
	PUSHJ	PP,	PUTLST
	MOVSS		TB
LSAXWH:	MOVE	TA,	[POINT	3,TB,17]
	PJRST		LSOCT1
;PUT OUT THE FIRST LINES OF CODE:
;	JSP	14,RESET.	;[201]
;	JRST	<PROCEDURE-NAME>

STARTI:	PUSHJ	PP,CLRDAT	;CLEAR DATGRP
	MOVE	PC,RESDNT
	SUB	PC,FIXEDS
	HRRZM	PC,DATGRP+2

;IF ITS /R AND ANY RMS I/O HAS BEEN REQUESTED PUT OUT A GLOBAL REQUEST
; TELLING LINK TO LOAD THE RMS INITIALIZATION ROUTINE.

IFE TOPS20,<
	TSWT	FREENT;			;EXPLICIT /R
>
IFN TOPS20,<
	SKIPN	RENSW##			;EXPLICIT /R
>
	JRST	STRTI1			;NON-REENTRANT
	MOVE	CH,[2,,2]
	PUSHJ	PP,PUTBIN		;PUT OUT GLOBAL REQUEST BLOCK
	SETZ	CH,
	PUSHJ	PP,PUTBIN		;NO RELOCATION INFO
	MOVE	CH,[RADIX50 60,RMS.EV]	;REENTRANT VERSION
	PUSHJ	PP,PUTBIN		;GO PUT IT INTO THE REL FILE.
	SETZ	CH,
	PUSHJ	PP,PUTBIN

;PUT OUT A START BLOCK

STRTI1:	SKIPN	SLASHJ##	;FORCE START ADDR?
	SKIPN	SUBPRG##	;NO, THIS A SUBPROGRAM?
	SKIPA	CH,[7,,1]	;NO, PUT OUT A START ADDR
	JRST	[MOVE	CH,[2,,2]	;[756] YES, OMIT THE MAIN PROGRAM INFO
		PUSHJ	PP,PUTBIN	;[756] BUT PUT OUT GLOBAL REQUEST
		SETZ	CH,		;[756]
		PUSHJ	PP,PUTBIN	;[756]  FOR CBLIO
		MOVE	CH,[RADIX50 60,C.RSET]	;[756]
		PUSHJ	PP,PUTBIN	;[756]  INCASE CALLED BY NON-COBOL SUBROUTINE
		SETZ	CH,		;[756]
		JRST	PUTBIN]		;[756]

	PUSHJ	PP,PUTBIN
	MOVSI	CH,200000
	PUSHJ	PP,PUTBIN
	HRRZ	CH,PC
	PUSHJ	PP,PUTBIN

;PUT OUT A GLOBAL REQUEST TELLING LINK TO LOAD THE APPROPRIATE
; STARTUP ROUTINE.

	MOVE	CH,[2,,2]
	PUSHJ	PP,PUTBIN		;PUT OUT GLOBAL REQUEST BLOCK
	SETZ	CH,
	PUSHJ	PP,PUTBIN		;NO RELOCATION INFO
IFE TOPS20,<
	TSWT	FREENT;			;IF IT'S NOT REENTRANT, USE
					; CON012 INSTEAD OF COR012.
>
IFN TOPS20,<
	SKIPN	RENSW##			;EXPLICIT /R
>
	SKIPA	CH,[RADIX50 60,CN.12]	;NON-REENTRANT
	MOVE	CH,[RADIX50 60,CR.12]	;REENTRANT VERSION
	PUSHJ	PP,PUTBIN		;GO PUT IT INTO THE REL FILE.
	SETZ	CH,
	PUSHJ	PP,PUTBIN

	PUSHJ	PP,HDROUT
	PUSHJ	PP,LCRLF
	MOVE	CH,[RADIX50 10,START.]
	MOVE	TA,PC
	PUSHJ	PP,PUTSYM		;OUTPUT AS LOCAL SYMBOL

SC==0			;[201] INITIAL COUNT OF START INSTRUCTIONS.
;	PUT OUT THE JFCL

	MOVSI	TB,(JFCL)
	SETZ	TA,		;NO RELOCATION.
	PUSHJ	PP,PUTDAT	;ASSEMBLE IT.
	MOVE	TE,[POINT 7, [ASCIZ "START.:	JFCL"]]
	PUSHJ	PP,STRTI8	;PUT INTO LISTING
	SC==SC+1

;	PUT OUT JSP 16,COBST.	;[201]

	MOVSI	TB,(JSP 16,)	;[201]
	MOVEI	W2,0		;[201] NO RELOCATION.
	MOVEI	W1,COBST.##	;[201] EXTAB ADR OF START UP
	PUSHJ	PP,GETADR	;[201] GET ADDRESS
	PUSHJ	PP,PUTDAT	;[201] ASSEMBLE IT.
	MOVE	TE,[POINT 7, [ASCIZ "	JSP	16,COBST.##"]] ; [201]
	PUSHJ	PP,STRTI8	;[201] PUT INTO LISTING
	SC==SC+1		;[201]
;PUT OUT THE "JSP"

IFN CSTATS,<
	SKIPN	METRSW##	;WITH METER--ING?
	 JRST	STRTII		;NO, DON'T SET THE FLAG
	MOVSI	TB,(SETOM)
	MOVEI	W2,0
	MOVEI	W1,METR.##	;METR.
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	SETOM	METR.		;Do METER--ING"]]
	PUSHJ	PP,STRTI8
STRTII:	>
	MOVSI	TB,(JSP 14,)
	MOVEI	W2,0
	MOVEI	W1,C.RSET##	;EXTAB ADDR OF RESET.
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT

	SETOM	TAGOUT

	MOVE	TE,[POINT 7,[ASCIZ "	JSP	14,C.RSET##"]]	; [201]
	PUSHJ	PP,STRTI8
	SC==SC+1

;PUT OUT "XWD 0,PROGRAM-ENTRY+1"

	HRRZ	TB,RESDNT	;GET CODE BASE
	HRRZ	TC,PRGENT##	;ADD ON ENTRY POINT
	ANDI	TC,77777
	ADDI	TB,(TC)
	MOVEI	TA,1		;RELATIVE
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,PROGID
	PUSHJ	PP,SIXOUT
	PUSHJ	PP,STRTI9
	SC==SC+1

;PUT OUT "AOS %CALLFLAG"

	HRRZ	TB,IMPPAR	;GET BASE OF %PARAM
	HRRZ	TC,RETPTR##
	ANDI	TC,77777
	ADDI	TB,(TC)
	HRLI	TB,(AOS)
	MOVEI	TA,1		;RELATIVE
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	AOS	%PARAM"]]
	PUSHJ	PP,LISTIT
	SKIPE	W2,TC
	PUSHJ	PP,LSTINC	;LIST OFFSET
	PUSHJ	PP,STRTI9
	SC==SC+1

IFN ANS74,<
;PUT OUT "JSP	16,DEBST.##"
;OR	 "SETZM	DEBUG.##"

	SKIPN	DEBSW		;IF NO DEBUGGING
	JRST	[MOVSI	TB,(SETZM)	;MAKE SURE DEBUG-SWITCH IS OFF
		SETZ	W2,
		MOVEI	W1,DEBUG.##
		PUSHJ	PP,GETADR
		PUSHJ	PP,PUTDAT
		MOVE	TE,[POINT 7,[ASCIZ "	SETZM	DEBUG.##"]]
		JRST	STRTI7]
	MOVSI	TB,(JSP 16,)
	MOVEI	W2,0
	MOVEI	W1,DEBST.##	;EXTAB ADDR OF DEBST.
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	JSP	16,DEBST.##"]]
STRTI7:	PUSHJ	PP,STRTI8
	SC==SC+1
>
;PUT OUT "JSP 16,CBDDT."

	MOVSI	TB,(JSP 16,)
	MOVEI	W2,0
	MOVEI	W1,CBDDT.##	;EXTAB ADDR OF CBDDT.
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	JSP	16,CBDDT.##"]]
	PUSHJ	PP,STRTI8
	SC==SC+1

;PUT OUT "XWD 0,PROGRAM-ENTRY+1"

	HRRZ	TB,RESDNT	;GET CODE BASE
	HRRZ	TC,PRGENT##	;ADD ON ENTRY POINT
	ANDI	TC,77777
	ADDI	TB,(TC)
	MOVEI	TA,1		;RELATIVE
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,PROGID
	PUSHJ	PP,SIXOUT
	PUSHJ	PP,STRTI9
	SC==SC+1


IFN DBMS,<

;PUT OUT "MOVEI 16,INITDB-ARG-LIST-ADDR"

	SKIPN	SCHSEC##	;[206] WAS THERE A DBMS CALL?
	JRST	NODBMS		;NO
	MOVSI	TB,(MOVEI 16,)
	HRR	TB,LITBAS
	ADD	TB,DBUSES##
	MOVEI	TA,1
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	MOVEI	16,%LIT00"]]
	PUSHJ	PP,LISTIT
	HRRZ	W2,DBUSES	;"+.."
	PUSHJ	PP,LSTINC
	PUSHJ	PP,STRTI9

;PUT OUT "PUSHJ 17,INITDB"

	MOVSI	TB,(PUSHJ 17,)
	MOVEI	W2,0
	MOVEI	W1,INITDB##
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "	PUSHJ	17,INITDB##"]]
	PUSHJ	PP,STRTI8
NODBMS:>


IFN MCS!TCS,<
 IFE TOPS20,<
	SKIPN	FINITL##	;IS THERE AN "INITIAL" CD-ENTRY?
 >
 IFN TOPS20,<
	SKIPN	CSSEEN##	;IS THERE A COMUNICATIONS SECTION?
 >
	JRST	MCSEND		;NO
	MOVSI	TB,(MOVEI	16,)
	MOVEI	TA,1
IFN TOPS20,<
	SKIPN	FINITL##	;WAS THERE?
	SOJA	TA,.+3		;NO
>
	HRR	TB,LITBAS
	ADD	TB,M.IARG##	;GET INIT ARG ADDR
	PUSHJ	PP,PUTDAT
IFN TOPS20,<
	SKIPN	FINITL
	SKIPA	TE,[POINT 7,[ASCIZ /	MOVEI	16,0/]]
>
	MOVE	TE,[POINT 7,[ASCIZ /	MOVEI	16,%LIT00/]]
	PUSHJ	PP,LISTIT
	HRRZ	W2,M.IARG
	PUSHJ	PP,LSTINC	;LIST INCREMENT
	PUSHJ	PP,STRTI9

;PUT OUT "PUSHJ 17,M.INIT" 

	MOVSI	TB,(PUSHJ 17,)
	MOVEI	W2,0
	MOVEI	W1,M.INIT##	;GET M.INIT ADDRESS
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ /	PUSHJ	17,M.INIT##/]]
	PUSHJ	PP,STRTI8
MCSEND:>

IFN ANS74,<
;IF DEBUG MODULE INVOKED FOR PROCEDURE-NAMES
;PUT OUT CODE TO STORE INITIAL LINE NUMBER AND TEXT TYPE

	SKIPE	DEBSW##		;DEBUG MODULE?
	SKIPN	DBPARM##	;AND PROCEDURE-NAME %PARAM GIVEN?
	JRST	DBPEND		;NO
	MOVSI	TB,(SKIPA 16,)
	HRRI	TB,1(PC)
	MOVEI	TA,1		;RELOCATE RHS
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ /	SKIPA	16,.+1/]]
	PUSHJ	PP,STRTI8

	MOVSI	TB,DBP%SP	;START PROGRAM CODE
	HRR	TB,PROGLN##	;LINE NUMBER
	SETZ	TA,
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ /	XWD	1,/]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,PROGLN
	PUSHJ	PP,LSINC4
	PUSHJ	PP,STRTI9

	MOVSI	TB,(MOVEM 16,)
	MOVEI	W1,AS.MSC##
	HRRZ	W2,DBPARM
	IORI	W2,AS.PAR##
	PUSHJ	PP,GETADR
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ /	MOVEM	16,%PARAM/]]
	PUSHJ	PP,LISTIT
	MOVE	W2,DBPARM
	PUSHJ	PP,LSTINC
	PUSHJ	PP,STRTI9
DBPEND:>


;PUT OUT "JRST" TO BEGINNING OF CODE

	MOVSI	W1,076000
	HRR	W1,PROGST
	MOVEI	W2,0
	MOVE	TB,W1
	PUSHJ	PP,GETOPR
	PUSHJ	PP,LSTOPR
	ADDI	PC,1
	SC==SC+1

	JRST	CLRDAT

STRTS==:SC		;NUMBER OF WORDS OF START CODE

;PUT OUT MESSAGE, FOLLOWED BY <C.R.>,<L.F.>, AND BUMP PC

STRTI8:	PUSHJ	PP,LISTIT
STRTI9:	AOJA	PC,LCRLF
;PUT OUT THE FIXED PORTION OF CODE:

;	FILES.: XWD 0,FILTBL
;	USES.:	XWD 0,USEBAS
;	SEGWD.:	XWD RESDNT,NONRES
;	ALTER.:	XWD <IMPURE BASE>,A50BAS
;	OVRFN.: SIXBIT "<BINARY FILE NAME>"
;	POINT.:	'.'
;	COMMA.:	','
;	MONEY.:	'$'

	INFIX%			;GET EXPECTED INDICES OF HEADER ELEMENTS
				;INDEX IS SAME AS NAME WITH % PRECEEDING


	FXNM==0			;USED TO CHECK INDICES FOR CORRECTNESS

;PUT OUT "XWD 0,FILTBL"
FIXED:	PUSHJ	PP,CLRDAT	;CLEAR OUT DATGRP
	HRRZM	PC,DATGRP+2
	PUSHJ	PP,LCRLF

	HRRZ	TB,FILTBL	;ASSUME THERE ARE FILES
	MOVEI	TA,1
	MOVE	TE,FILLOC	;ARE THERE ANY FILES?
	CAMN	TE,FILNXT
	SETZB	TA,TB		;NO--PUT OUT UNRELOCATED ZERO

	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%FILES:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,LCRLF
	MOVE	CH,[RADIX50 10,%FILES]
	MOVE	TA,PC
	PUSHJ	PP,PUTSYM
	ADDI	PC,1

	IFN	FXNM-%FILES,<PRINTX	FILES. ERROR>
	FXNM==FXNM+1
;PUT OUT "XWD 0,USEBAS"
	HRRZ	TB,USEBAS
	MOVEI	TA,1
IFN DBMS,<SKIPE	DBONLY##>	;[401] IF ONLY DBMS USE, DON'T PUT OUT ANYTHING
	CAMN	TB,IMPPAR	;IF NO 'USE' TABLE,
	SETZB	TA,TB		;  PUT OUT ZERO


	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%USES:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%USES.,<PRINTX	USES. ERROR>
	FXNM==FXNM+1

;PUT OUT "SEGWD.: XWD PURE,IMPURE"

	MOVEI	TA,3
	TSWT	FREENT		;RE-ENTRANT PROGRAM?
	TDCA	TB,TB		;NO
	MOVSI	TB,1B18		;YES
	HRR	TB,NONRES
	PUSHJ	PP,PUTDAT

	MOVE	TE,[POINT 7,[ASCIZ "%SEGWD:	XWD	"]]
	PUSHJ	PP,LISTIT

	TSWT	FREENT;
	SKIPA	TE,[POINT 7,[ASCIZ "0,"]]
	MOVE	TE,[POINT 7,[ASCIZ "400000,"]]
	PUSHJ	PP,LSTMES
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%SEGWD,<PRINTX	SEGWD. ERROR>
	FXNM==FXNM+1

;PUT OUT "ALTER.: XWD 0,A50BAS"

	HRRZ	TB,A50BAS
	MOVEI	TA,3
	PUSHJ	PP,PUTDAT

	MOVE	TE,[POINT 7,[ASCIZ "%ALTER:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%ALTER,<PRINTX	ALTER. ERROR>
	FXNM==FXNM+1
;PUT OUT "OVRFN.: SIXBIT "FILE-NAME"

	SKIPE	TB,SEGFLG	;ANY NON-RESIDENT CODING?
	MOVE	TB,BINHDR	;YES--USE REL FILE'S NAME
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT

	JUMPE	TB,FIXD4C	;ANY "OVR" FILE?

	MOVE	TE,[POINT 7,[ASCIZ /%OVRFN:	SIXBIT	"/]]
	PUSHJ	PP,LISTIT
	MOVE	TA,TB
	PUSHJ	PP,SIXOUT
	MOVEI	CH,42
	PUSHJ	PP,PUTLST
	JRST	FIXD4D

FIXD4C:	MOVE	TE,[POINT 7,[ASCIZ "%OVRFN:	OCT	0"]]
	PUSHJ	PP,LISTIT

FIXD4D:	PUSHJ	PP,STRTI9

	IFN	FXNM-%OVRFN,<PRINTX	OVRFN. ERROR>
	FXNM==FXNM+1
;PUT OUT CONSTANTS (E.G. "POINT.")

	MOVE	TC,DCP.

FIXED5:	HRRZ	TB,@(TC)
	SUBI	TB,40		;CONVERT TO SIXBIT
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT

	TSWF	FNOLST		;ANY LISTING?
	AOJA	PC,FIXED6	;NO

	MOVE	TE,[POINT 7,1(TC)]	;YES
	PUSHJ	PP,LISTIT
	MOVEI	CH,40(TB)
	PUSHJ	PP,PUTLST
	MOVEI	CH,"'"
	PUSHJ	PP,PUTLST

	PUSHJ	PP,STRTI9

FIXED6:	ADDI	TC,2
	AOBJN	TC,FIXED5

	IFN	FXNM-%POINT,<PRINTX	POINT. ERROR>
	FXNM==FXNM+1
	IFN	FXNM-%COMMA,<PRINTX	COMMA. ERROR>
	FXNM==FXNM+1
	IFN	FXNM-%MONEY,<PRINTX	MONEY. ERROR>
	FXNM==FXNM+1

;PUT OUT "MEMRY.: OCT <MEMORY-SIZE>"

	HRRZ	TB,OBJSIZ
	SUBI	TB,1
	IORI	TB,1777
	MOVEI	TA,0
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%MEMRY:	OCT	"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%MEMRY,<PRINTX	MEMRY.	ERROR>
	FXNM==FXNM+1
;PUT OUT SYMBOL TABLE POINTERS AS ZERO WORDS

	MOVE	TC,SYM.P
FIXED8:	SETZB	TA,TB
	PUSHJ	PP,PUTDAT	;OUTPUT A ZERO
	SKIPE	PRODSW		;IF SYMBOLS
	JRST	FIXD8A		;  ARE BEING GENERATED,
	MOVEI	TA,1		;  PRINT THE APPROPRIATE VALUES
	TLNN	TC,	1	;DO WE WANT TO RELOCATE THE LEFT HALF TOO?
	MOVEI	TA,	3	;YES.
	MOVE	TB,@0(TC)
FIXD8A:	MOVE	TE,[POINT 7,1(TC)]
	PUSHJ	PP,LISTIT	;LIST SOMETHING
	PUSHJ	PP,LSAXWD
	PUSHJ	PP,STRTI9	;UPDATE PC
	ADDI	TC,2		;LOOP
	AOBJN	TC,FIXED8	;...

	IFN	FXNM-%%NM.,<PRINTX	%NM. ERROR>
	FXNM==FXNM+1
	IFN	FXNM-%%DT.,<PRINTX	%DT. ERROR>
	FXNM==FXNM+1
	IFN	FXNM-%%PR.,<PRINTX	%PR. ERROR>
	FXNM==FXNM+1
; PUT OUT %COBVR	- COMPILER VERSION
	SETZ	TA,		;NO RELOCATION
	MOVE	TB,.JBVER##	;COMPILER VERION
	PUSHJ	PP,PUTDAT

	MOVE	TE,[POINT	7,[ASCIZ	"%COBVR:	"]]
	PUSHJ	PP,LISTIT
	MOVE	TB,.JBVER
	PUSHJ	PP,LSAXWD
	MOVE	TE,[POINT	7,[ASCIZ	"	;COBOL version number"]]
	PUSHJ	PP,LSTMES	;LIST SECOND PART OF MESSAGE
	PUSHJ	PP,STRTI9	;INCREMENT PC

	IFN	FXNM-%COBVR,<PRINTX	COBVR. ERROR>
	FXNM==FXNM+1

;PUT OUT %COBSW - COMPILER ASSEMBLY SWITCHES
	SETZ	TA,		;NO RELOCATION
	MOVE	TB,COBSW%##	;ASSEMBLY SWITCH WORD
	PUSHJ	PP,PUTDAT

	MOVE	TE,[POINT	7,[ASCIZ "%COBSW:	"]]
	PUSHJ	PP,LISTIT
	MOVE	TB,COBSW%
	PUSHJ	PP,LSAXWD
	MOVE	TE,[POINT	7,[ASCIZ "	;Compiler assembly switches"]]
	PUSHJ	PP,LSTMES	;LIST SECOND PART OF MESSAGE
	PUSHJ	PP,STRTI9

	IFN	FXNM-%COBSW,<PRINTX	COBSW. ERROR>
	FXNM==FXNM+1

;PUT OUT PUSHL.: OCT	<PUSHDOWN LIST SIZE>
	SETZI	TA,		;NO RELOCATION
	HRRZ	TB,OJPPSZ##	;STACK SIZE
	ADDI	TB,200
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT	7,[ASCIZ "%PUSHL:	OCT	"]]
	PUSHJ	PP,LISTIT
	HRRZ	TA,TB
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%PUSHL,<PRINTX	PUSHL. ERROR>
	FXNM==FXNM+1

	SETZ	TA,		;GENERATE LENGTH OF RETAINED RECORDS TABLE
	MOVE	TB,SURRT.
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ"%SURRT: XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,SURRT.
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%SURRT,<PRINTX	SURRT ERROR>

	FXNM==FXNM+1

	SETZ	TA,		;GENERATE LENGTH OF ENQ/DEQ TABLES
	MOVE	TB,SUEQT.	
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ"%SUEQT: XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,SUEQT.
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%SUEQT,<PRINTX	SUEQT ERROR>
	FXNM==FXNM+1

	SETZ	TA,		;GENERATE LENGTH OF FILL/FLUSH  BUFFER TABLE
	MOVE	TB,SUFBT.
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ"%SUFBT: XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,SUFBT.
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%SUFBT,<PRINTX	SUFBT ERROR>
	FXNM==FXNM+1

IFN ANS74,<
;PUT OUT %DB:	XWD 0,<DEBUG-ITEM>

	MOVE	TB,DEBSW##	;GET ADDRESS OF DEBUG-ITEM
	SETZ	TA,		;NO RELOCATION
	ANDI	TB,077777	;TABLE ADDRESS ONLY
	MOVEM	TB,DEBSW
	PUSHJ	PP,PUTDAT
	MOVE	TE,[POINT 7,[ASCIZ "%DB:	XWD	0,"]]
	PUSHJ	PP,LISTIT
	MOVE	TA,DEBSW
	PUSHJ	PP,LSINC2
	PUSHJ	PP,STRTI9

	IFN	FXNM-%%DB.,<PRINTX	%DB. ERROR>
	FXNM==FXNM+1

>
	IFN	FXNM-FIXNUM,<PRINTX	FIXNUM ERROR>
;PUT OUT STORAGE SPACE FOR CALLER'S FILES., ETC.

	MOVEI	TC,FIXNUM
FIX11:	SETZB	TA,TB
	PUSHJ	PP,PUTDAT
	ADDI	PC,1
	SOJG	TC,FIX11

	PUSHJ	PP,CLRDAT
	PUSHJ	PP,LCRLF

;NOW PUT OUT CORRECT VALUES AS TYPE 37 BLOCKS

	SKIPE	PRODSW		;IF NO SYMBOLS,
	POPJ	PP,		;  FORGET IT

	PUSHJ	PP,CLRDAT
	MOVE	CH,[XWD 37,4]
	PUSHJ	PP,PUTBIN
	MOVSI	CH,(<BYTE (2)1,1,3,1>)
	PUSHJ	PP,PUTBIN
	MOVEI	CH,-2*FIXNUM+%%NM.(PC)
	PUSHJ	PP,PUTBIN
	HRRZ	CH,NM.PC
	PUSHJ	PP,PUTBIN
	MOVE	CH,DT.PC
	PUSHJ	PP,PUTBIN
	MOVE	CH,PR.PC
	JRST	PUTBIN
;INITIALIZE THE PHASE

INITAL:	MOVE	TA,BINBUF	;SET UP BINARY OUTPUT BUFFERS
	MOVEM	TA,.JBFF
	SKIPE	BINDEV
	OUTBUF	BIN,2
	PUSHJ	PP,HDROUT

	PUSHJ	PP,ENTBLK	;PUT OUT ENTRY BLOCK AT START OF REL FILE

	MOVEI	TA,1		;INIT BLKTYP
	MOVEM	TA,BLKTYP
	PUSHJ	PP,PDATI	;SET UP DATGRP
	PUSHJ	PP,PSYMI	;SET UP SYMGRP

	MOVE	CH,[XWD 6,2]	;PUT OUT NAME BLOCK
	PUSHJ	PP,PUTBIN
	MOVEI	CH,0		;ZERO
	PUSHJ	PP,PUTBIN	;  RELOCATION WORD
	MOVE	TC,PROGID	;PROGRAM-ID
	PUSHJ	PP,RADX50	;  IN
	PUSHJ	PP,PUTBIN	;  RADIX 50
IFN ANS68,<
	MOVSI	CH,2		;"I AM COBOL-68" CODE
>
IFN ANS74,<
	MOVSI	CH,16		; COBOL-74
>
IFN BIS,<
;DELETE THIS UNTIL FIELD-IMAGE LINK IS FIXED
;	TLO	CH,(4B5)	;KL-BIS, LET LINK KNOW
>
IFE TOPS20,<
	TSWT	FREENT;
>
	HRRI	CH,COMSIZ	;RESERVE SPACE FOR LIBOL DATA
	PUSHJ	PP,PUTBIN

	TSWT	FREENT		;RE-ENTRANT CODE?
	JRST	INITL2

	MOVE	CH,[XWD 3,1]	;YES--
	PUSHJ	PP,PUTBIN	;  PUT
	MOVSI	CH,3B19		;  OUT
	PUSHJ	PP,PUTBIN	;  'HISEG'
	MOVE	CH,EAS2PC	;  BLOCK
	ADD	CH,RESDNT
	ADD	CH,EXTCNT
	MOVSS	CH
	HRR	CH,RESDNT	;GET START OF HIGH-SEG
	TRZ	CH,777		;PUT ON PAGE BOUNDARY
	PUSHJ	PP,PUTBIN
;PUT OUT .JBOPS WORD IF THIS IS A MAIN PROGRAM.

INITL2:	SKIPN	SLASHJ##	;/J ON?  (FORCE START ADR)
	SKIPN	SUBPRG##	;NO, /I ON?  (OMIT START ADR) OR IS IT
				; A SUBPROGRAM IN ITS OWN RIGHT?
	JRST	.+2		;NO, MUST BE A MAIN PROG.
	JRST	INITL3		;IT IS A SUBPROG. DON'T PUT OUT EITHER
				; THE .JBOPS WORD OR THE DEFINITION OF
				; LILOW.
	MOVE	CH,[XWD 1,2]
	PUSHJ	PP,PUTBIN
IFN TOPS20,<
	TSWT	FREENT
>
	TDCA	CH,CH
	MOVSI	CH,(1B2)
	PUSHJ	PP,PUTBIN
	MOVEI	CH,.JBOPS
	PUSHJ	PP,PUTBIN
	TSWT	FREENT
	SKIPA	CH,[XWD 140,FIXNUM+140]
	MOVEI	CH,0
	PUSHJ	PP,PUTBIN

;OUTPUT COMPILER VERSION NUMBER

	MOVE	CH,[1,,2]	;2 WORD DATA BLOCK
	PUSHJ	PP,PUTBIN
	SETZ	CH,		;NO RELOCATION
	PUSHJ	PP,PUTBIN
	MOVEI	CH,.JBVER	;LOCATION
	PUSHJ	PP,PUTBIN
	MOVE	CH,.JBVER	;VALUE
	PUSHJ	PP,PUTBIN

;PUT OUT A REFERENCE TO "LILOW."
;THIS WILL ONLY BE DONE FOR NON-REENTRANT MAIN PROGRAMS.

;CODE TO BE GENERATED IS:
;	XWD	2,2
;	EXP	0
;	RADIX50	60,LILOW.
;	EXP	0

;
; THIS WILL CAUSE ROUTINE LILOWS.MAC TO BE LOADED FROM LIBOL.REL
; THIS MODULE WILL DEFINE SYMBOLS FOR THE LIBOL DISPATCH TABLE
; IN ORDER TO RESOLVE EXTERNAL REFERENCES IN THE COBOL PROGRAM


IFE TOPS20,<
	TSWF	FREENT		;ARE WE GENERATING REENTRANT CODE?
>
IFN TOPS20,<
	SKIPE	RENSW		;EXPLICIT /R FOR TOPS-20
>
	JRST	INITL3		;YES, DO NOTHING.

;GET HERE IF WE ARE GENERATING A ONE SEGMENT MAIN PROGRAM.

	MOVE	CH,[XWD	2,2]	;BLOCK TYPE 2(SYMBOLS),,TWO DATA WORDS.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	SETZI	CH,		;NO RELOCATION.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	MOVE	CH,[RADIX50	60,LILOW.]	;GLOBAL DEFINITION.
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
	SETZI	CH,
	PUSHJ	PP,PUTBIN	;PUT IT IN THE REL FILE.
;FINISH UP INITIALIZATION

INITL3:	MOVEI	TA,(SIXBIT "AS1") ;SET UP FOR AS1FIL
	HRRM	TA,ASYFIL

	HLLZS	SW		;CLEAR SWITCHES

	PUSHJ	PP,HDROUT	;PUT OUT HEADING LINE
	MOVE	TA,RESDNT	;RESET CURRENT RELOCATION
	MOVEM	TA,CURREL

	HRRZ	TA,EXTLOC	;SET EXTERNAL LOCATIONS TO -1
	ADDI	TA,1
	MOVE	TB,EXTNXT
INITL4:	HLLOS	1(TA)
	ADDI	TA,2
	HLRZ	TC,-1(TA)	;GET COUNT OF EXTRA WORDS
	ANDI	TC,7
	HRLI	TC,(TC)
	ADD	TA,TC		;ADD TO CTR-PTR
	CAIG	TA,(TB)
	JRST	INITL4

	HRRZ	TA,SECLOC	;SET SECTAB POINTER TO FIRST ENTRY LESS 1
	ADDI	TA,1
	MOVEM	TA,CURSEC
	HLRZ	TB,0(TA)
	ADD	TB,CURREL
	SUB	TB,INDELC##	;SECTAB ENTRIES ARE NOT UPDATED, SO FAKE IT
	MOVEM	TB,LITBAS
	MOVEI	TA,' 00'
	MOVEM	TA,DECSEG

	SETOM	TAGOUT		;SET TAGOUT TO -1

	PUSHJ	PP,DOSYM	;PUT OUT SYMBOLS

	SWON	FRELOC;
	SETZB	PC,DATGRP+2
	PUSHJ	PP,FIXED
	JRST	CLRDAT	
;PUT OUT EXTERNAL REQUESTS TO ALL ITEMS IN EXTAB WHICH HAVE BEEN USED.
;SET UP XWD'S FOR THOSE ITEMS USED BY NON-RESIDENT SEGMENTS.

EXTOUT:	MOVE	OP,EXTLOC	;START AT TOP OF TABLE
	TSWT	FREENT;
	ADD	OP,[XWD NUMEXT,NUMEXT]
	PUSHJ	PP,CLRDAT	;INSURE DATGRP IS CLEAN
	HRRZM	PC,DATGRP+2	;SET LOCATION IN DATGRP

EXTO1:	CAMN	OP,EXTNXT	;DONE?
	JRST	EXTO9		;YES--EMPTY SYMGRP AND RETURN

	AOBJP	OP,EXTBAD	;NO--STEP UP TO NEXT ENTRY

	SKIPL	TB,1(OP)	;IS IT REFERENCED IN NON-RESIDENT SEGMENT?
	JRST	EXTO7		;NO

;AN XWD IS REQUIRED

	TLNN	TB,NR.IND	;YES, BUT IS IT SPECIAL
	TLZA	TB,-1		;NO--CLEAR LEFT HALF
	HRLI	TB,(@)		;YES, TURN ON INDIRECT BIT
	TRC	TB,-1		;HAS IT BEEN REFERENCED YET?
	TRCE	TB,-1
	JRST	EXTO2		;YES
	MOVEI	TA,1B33		;MAKE EXTERNAL
	TRZA	TB,-1		;NO--USE UNRELOCATED ZERO

EXTO2:	MOVEI	TA,1		;YES--RELOCATE
	HRRM	PC,1(OP)	;RESET EXTAB

	PUSHJ	PP,PUTDAT
	PUSHJ	PP,CLRDAT	;INSURE THAT IT'S OUT BEFORE EXTERNAL REQUEST

	TSWF	FNOLST		;ANY OBJECT LISTING?
	AOJA	PC,EXTO7	;NO, BUMP PROGRAM COUNTER

	PUSHJ	PP,LSTCOD	;YES--LIST PC AND ASSEMBLED CODE
;PUT OUT EXTERNAL REQUESTS  (CONT'D).

	MOVE	TE,1(OP)
	TLNE	TE,NR.IND	;SPECIAL
	SKIPA	TE,[POINT 7,[ASCIZ "Z	@"]]
	MOVE	TE,[POINT 7,[ASCIZ "XWD	0,"]]
	PUSHJ	PP,LSTMES
	MOVE	DT,OP
	PUSHJ	PP,LSTNAM	;PRINT EXTERNAL NAME
	MOVEI	CH,"#"
	PUSHJ	PP,PUTLST
	MOVEI	CH,"#"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,STRTI9		;BUMP PROGRAM COUNTER

EXTO7:	AOBJP	OP,EXTBAD	;STEP UP TO SECOND WORD

	HRRZ	TA,0(OP)	;ANY REFERENCE TO IT?
	CAIN	TA,-1
	JRST	EXTO8		;NO

	HLRZ	TC,-1(OP)
	ANDI	TC,77777
	ADD	TC,NAMLOC
	MOVE	TC,1(TC)

	PUSHJ	PP,RADX50
	LDB	TB,[POINT 2,(OP),3]	;ENTRY POINT?
	SKIPE	TB
	TLOA	CH,040000	;YES, GLOBAL DEFINITION
	TLO	CH,600000	;NO, GLOBAL REQUEST
	PUSHJ	PP,PUTSYM

EXTO8:	HLRZ	TC,(OP)		;GET # OF EXTRA WORDS
	ANDI	TC,7
	HRLI	TC,(TC)
	ADD	OP,TC		;ADD TO CTR-PTR
	JRST	EXTO1

EXTO9:	MOVEM	PC,HPLOC
	JRST	CLRSYM


;EXTAB IS IMPROPERLY SET UP

EXTBAD:	OUTSTR	[ASCIZ "EXTNXT improperly set up
"]
	JRST	KILL
;PUT OUT ENTRY BLOCK AT START OF REL FILE

ENTBLK:	SKIPN	BINDEV		;ANY REL OUTPUT?
	POPJ	PP,		;NO

	HRRZ	OP,EXTLOC	;SET UP EXTAB PTR
	ADDI	OP,3

	PUSHJ	PP,CLREN2	;SET UP DATGRP

ENTBL1:	LDB	TA,[POINT 2,1(OP),3]	;ENTRY POINT?
	JUMPE	TA,ENTBL2	;NO

	HLRZ	TC,(OP)		;GET NAMTAB LINK
	ANDI	TC,77777
	ADD	TC,NAMLOC
	MOVE	TC,1(TC)	;GET SYMBOL
	PUSHJ	PP,RADX50	;CONVERT TO RADIX50

	MOVEM	CH,(GP)		;STASH SYMBOL IN DATGRP
	AOS	DATGRP
	AOBJN	GP,ENTBL2	;FILLED DATGRP?

	PUSHJ	PP,CLRENT	;YES, OUTPUT BLOCK

	HRLZI	TE,4		;SET UP ENTRY BLOCK TYPE CODE
	MOVEM	TE,DATGRP
	SETZM	TE,DATGRP+1	;CLR RELOCATION WORD
	MOVE	GP,[-^D18,,DATGRP+2]	;SET UP DATGRP PTR

ENTBL2:	HLRZ	TC,1(OP)		;GET COUNT OF EXTRA WORDS
	ANDI	TC,7
	ADDI	OP,2(TC)	;BUMP EXTAB PTR
	MOVE	TC,EXTNXT##	;AT END OF TABLE?
	CAIG	OP,(TC)
	JRST	ENTBL1		;NO

CLRENT:	HRRZ	TE,DATGRP	;GET BLOCK COUNT
	JUMPE	TE,CPOPJ	;EXIT IF NONE THERE

	MOVNI	TE,2(TE)
	HRLI	TE,(TE)
	HRRI	TE,DATGRP

CLREN1:	MOVE	CH,(TE)
	PUSHJ	PP,PUTBIN
	AOBJN	TE,CLREN1

CLREN2:	HRLZI	TE,4		;SET UP ENTRY BLOCK TYPE CODE
	MOVEM	TE,DATGRP
	SETZM	TE,DATGRP+1	;CLR RELOCATION WORD
	MOVE	GP,[-^D18,,DATGRP+2]	;SET UP DATGRP PTR
	POPJ	PP,
;PUT OUT END BLOCK.

;REENTRANT PROGRAMS HAVE HIGH-BREAK FOLLOWED BY LOW-BREAK.
;NON-REENTRANT PROGRAMS HAVE LOW-BREAK FOLLOWED BY ABSOLUTE BREAK.

;[74] ALSO PUT OUT BLOCK TYPE 12 ITEM 1 TO LINK ALL ENTRY POINTS

ENDBLK:
IFN ANS74,<
	MOVE	CH,[12,,2]
	PUSHJ	PP,PUTBIN
	MOVSI	CH,(1B3)
	PUSHJ	PP,PUTBIN
	MOVEI	CH,1		;ASSUME SUBPROGRAM
	SKIPN	SLASHJ		;FORCED START ADDRESS
	SKIPN	SUBPRG		;NO, THIS A SUBPROGRAM?
	MOVN	CH,CH		;NO, MAIN PROGRAM, SO MAKE HEAD
	PUSHJ	PP,PUTBIN
	MOVE	CH,PRGENT	;GET MAIN ENTRY POINT
	SUBI	CH,3		;BACKUP TO LINK WORD
	ADD	CH,RESDNT	;ADD IN BASE
	PUSHJ	PP,PUTBIN	;OUTPUT LINK ADDRESS
>
	MOVE	CH,[XWD 5,2]	;BLOCK TYPE AND COUNT
	PUSHJ	PP,PUTBIN

	MOVSI	CH,(4B3)	;RELOCATION IF NON-REENTRANT
	TSWF	FREENT
	TLO	CH,(1B3)	;RELOCATION FOR LOW-BREAK
	PUSHJ	PP,PUTBIN

	TSWF	FREENT		;IF RE-ENTRANT,
	SKIPA	CH,HPLOC	;  USE HIGH-BREAK,
	MOVE	CH,END.PC	;  ELSE USE LOW-BREAK
	PUSHJ	PP,PUTBIN

	TSWF	FREENT		;IF RE-ENTRANT
	SKIPA	CH,END.PC	;  USE LOW-BREAK,
	MOVEI	CH,COMSIZ+140	;  ELSE USE COMMON BREAK
	JRST	PUTBIN
;LIST AN INSTRUCTION SET UP BY INITIALIZER

LISTIT:	TSWF	FNOLST;
	POPJ	PP,

	PUSH	PP,TE
	PUSHJ	PP,LSTCOD
	POP	PP,TE

	ILDB	CH,TE		;REPLACE TAB IN LINE WITH
	DPB	CH,LSTBH+1	;  FIRST CHARACTER OF TEXT

	JRST	LSTMES
;SET UP FOR OVERLAY OUTPUT FILE

SETOVR:	SKIPN	BINDEV		;ANY BINARY?
	POPJ	PP,		;NO--FORGET IT

	PUSHJ	PP,CLRDAT	;YES--CLEAR OUT DATA
	PUSHJ	PP,ENDBLK	;PUT OUT END BLOCK
	RELEASE	BIN,		;CLOSE OUT OLD FILE

	MOVE	TE,BINDEV	;IS BINARY GOING TO DISK?
	CALLI	TE,$DEVCH
	MOVSI	TD,(SIXBIT "DSK")
	TLNN	TE,$DSK
	MOVEM	TD,BINDEV	;NO--JAM "DSK" AS OUTPUT DEVICE

	MOVEI	TE,14
	MOVE	TD,BINDEV
	MOVSI	TC,BINBH
	OPEN	BIN,TE
	JRST	SETOV8

	MOVE	TE,BINHDR
	MOVSI	TD,(SIXBIT "OVR")
	SETZM	TC
	MOVE	TB,BINPP
	ENTER	BIN,TE
	JRST	SETOV8

	MOVE	TE,BINBUF
	MOVEM	TE,.JBFF
	OUTBUF	BIN,2

	MOVEI	TE,^D256
	MOVEI	CH,0
	PUSHJ	PP,PUTBIN
	SOJG	TE,.-2
	MOVEI	TE,600
	MOVEM	TE,OVRWRD
	MOVE	TA,LITLOC
	HRRZM	TA,CURLIT
	MOVS	TE,TA
	HRRI	TE,1(TA)
	SETZM	(TA)
	BLT	TE,^D255(TA)

	JRST	PDAT7

;TROUBLE INTIALIZING DEVICE

SETOV8:	OUTSTR	[ASCIZ "?Cannot initialize overlay file
"]
	SETZM	BINDEV
	POPJ	PP,
;PUT ENTRY INTO OVERLAY DIRECTORY (RESIDING IN LITAB).
;ENTER WITH DT POINTING TO NEXT SECTION ENTRY IN PROTAB.

RESOVR:	HRRZ	TE,LITLOC
	CAMN	TE,CURLIT
	JRST	RESOV1

	SUB	PC,NONRES
	MOVE	TE,CURLIT
	MOVNM	PC,1(TE)

RESOV1:	LDB	TE,PTSEGN
	MOVE	TC,TE
	LSH	TE,1
	ADD	TE,LITLOC
	HRRZM	TE,CURLIT

	MOVE	TD,OVRWRD
	MOVEM	TD,0(TE)

	CAIGE	TC,^D50
	POPJ	PP,

	HRRZ	TE,LITLOC
	ADDI	TE,^D200-^D50(TC)

	MOVE	TD,CURSEC
	MOVE	TC,1(TD)
	ADD	TC,NONRES
	MOVSM	TC,0(TE)

	POPJ	PP,
;COPY LITAB TO OVERLAY FILE DIRECTORY

CLROVR:	SKIPN	BINDEV
	POPJ	PP,

	SUB	PC,NONRES
	MOVE	TE,CURLIT
	MOVNM	PC,1(TE)

	CLOSE	BIN,
	MOVE	TD,BINHDR
	MOVSI	TC,(SIXBIT "OVR")
	MOVEI	TB,0
	MOVE	TA,BINPP
	LOOKUP	BIN,TD
	JRST	CLROV5

	MOVE	TA,BINPP
	ENTER	BIN,TD
	JRST	CLROV6

	MOVSI	TD,-^D256
	HRR	TD,LITLOC

CLROV4:	MOVE	CH,(TD)
	PUSHJ	PP,PUTBIN
	AOBJN	TD,CLROV4

	POPJ	PP,

CLROV5:	outstr	[ASCIZ "?Monitor error--could't find OVR file after closing
"]
	POPJ	PP,

CLROV6:	OUTSTR	[ASCIZ "?Monitor error--couldn't update OVR file
"]
	POPJ	PP,
SUBTTL	FINAL SUMMARY FOR COMPILATION

;PRINT OUT TIMES FOR PHASES

IFN DEBUG,<EXTERN	%ATIME,%GTIME,TOPLOC,IMPURE,FREESP
	EXTERN	NAMCT1,NAMCT2,NAMCT3,NAMDIS,DISTSZ,%RTIME,%RGTIM
IFE ONESEG,<EXTERN	%TTIME>

SUMARY:	TSWF	FNOLST		;ANY LISTING?
	POPJ	PP,		;NO--QUIT
	MOVEI	TA,0
	CALLI	TA,$RTIME
	MOVEM	TA,%RGTIM+1
	CALLI	CP,$TIME
	MOVEM	CP,%GTIME+1
	MOVSI	TE,(ASCIZ "S")
	MOVEM	TE,HDRPAG
	SETZM	SUBPAG
	SETZM	PAGCNT
	PUSHJ	PP,HDROUT
	MOVE	TE,[POINT 7,[ASCIZ "Checkout summary

       Elapsed       CP
"]]
	PUSHJ	PP,LSTMES

	MOVEI	TA,%ATIME
	MOVEI	TB,"A"
IFE ONESEG,<
	SETZM	%TTIME
>
	SETZM	%RTIME
TIMLUP:	SKIPN	OPTSW##		;DID WE CALL OPTIMIZER?
	 JRST	TIMLP1		;NO, SKIP CHECKING CODE
	CAIN	TB,"P"		;DID WE DO "O" LAST?
	 JRST	[MOVEI TB,"F"	;YES- DO "F" NOW
		JRST	TIMLP2]
	CAIN	TB,"F"		;DID WE DO "E" LAST?
	MOVEI	TB,"O"		;YES--DO "O" NOW
	JRST	TIMLP2
TIMLP1:	CAIN	TB,"F"		;AT "F"?
	ADDI	TA,4		;YES--SKIP PHASE O TIMES
TIMLP2:	MOVE	CH,TB		;PUT OUT PHASE IDENTIFICATION
	PUSHJ	PP,PUTLST
	ADDI	TB,1
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	PUSHJ	PP,PUTLST

	MOVE	TE,1(TA)	;COMPUTE RUN TIME
	SUB	TE,0(TA)
IFE ONESEG,<
	ADDM	TE,%TTIME	;KEEP A RUNNING TOTAL
>
	PUSHJ	PP,TIMOUT	;PRINT IT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	MOVE	TE,3(TA)	;COMPUTE CP TIME
	SUB	TE,2(TA)
	ADDM	TE,%RTIME	;ACCUMULATE IT
	PUSHJ	PP,TIMOUT
	PUSHJ	PP,LCRLF
	ADDI	TA,4
	CAIG	TA,%GTIME	;DONE?
	JRST	TIMLUP		;NO--LOOP
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT TIMES FOR PHASES  (CONT'D)


	MOVE	TE,[POINT 7,[ASCIZ "
Total elapsed"]]
	PUSHJ	PP,LSTMES

	MOVE	TE,CP
	SUB	TE,%ATIME
	PUSHJ	PP,TIMOUT
IFE ONESEG,<
	MOVE	TE,[POINT 7,[ASCIZ ", not including GETSEG"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,%TTIME
	PUSHJ	PP,TIMOUT
>
	MOVE	TE,[POINT 7,[ASCIZ ", CP time"]]
	PUSHJ	PP,LSTMES
	MOVE	TE,%RTIME
	PUSHJ	PP,TIMOUT
	PUSHJ	PP,LCRLF
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT SIZE OF IMPURE AREA

	MOVE	TE,[POINT 7,[ASCIZ "

Impure size: "]]
	PUSHJ	PP,LSTMES

	HRRZ	TE,TOPLOC
	SUBI	TE,IMPURE-140
	PUSHJ	PP,TABD2
	MOVE	TE,[POINT 7,[ASCIZ "
Free storage:"]]
	PUSHJ	PP,LSTMES

	HLRZ	TE,FREESP
	PUSHJ	PP,TABD2
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT TABLE USAGE.

	MOVE	TE,[POINT 7,[ASCIZ "

	  Orig   Final  Used

"]]
	PUSHJ	PP,LSTMES

	MOVE	TB,TABDX

TABD1:	MOVE	TA,(TB)		;PICK UP TABLE NAME
	PUSHJ	PP,SIXOUT	;PRINT IT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	HLRZ	TE,1(TB)	;PRINT ORIGINAL SIZE
	CAIN	TE,1		;IF 1, REALLY ZERO
	MOVEI	TE,0
	PUSH	PP,TE		;SAVE IT
	PUSHJ	PP,TABD2

	MOVE	TC,1(TB)	;PRINT FINAL SIZE
	HLRE	TE,(TC)
	MOVMS	TE
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	POP	PP,TD		;SAME SIZE AS ORIGINAL?
	CAMN	TE,TD
	PUSHJ	PP,TABD6	;YES--PRINT SPACES AND SKIP
	PUSHJ	PP,TABD2

	HRRZ	TE,1(TC)	;PRINT SIZE USED (MNE'NXT - MNE'LOC)
	HRRZ	TD,0(TC)
	SUB	TE,TD
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	PUSHJ	PP,TABD2

	PUSHJ	PP,LCRLF
	ADDI	TB,1
	AOBJN	TB,TABD1	;LOOP UNTIL DONE
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT OUT NAMTAB PARAMETERS AND BASE LOCATIONS

	PUSHJ	PP,LCRLF
	PUSHJ	PP,LCRLF
	REPEAT 0,<
	MOVE	TE,[POINT 7,[ASCIZ "
SEARCH DISTRIBUTION

"]]
	PUSHJ	PP,LSTMES

	MOVEI	TA,1

NAMCTB:	MOVEI	CH," "
	CAIN	TA,DISTSZ
	MOVEI	CH,76		;"GREATER THAN"
	PUSHJ	PP,PUTLST

	MOVEI	TE,(TA)
	CAIN	TE,DISTSZ
	SUBI	TE,1
	PUSHJ	PP,DECIT

	MOVEI	CH,"-"
	PUSHJ	PP,PUTLST

	MOVE	TE,NAMDIS-1(TA)
	PUSHJ	PP,DECIT
	PUSHJ	PP,LCRLF

	CAIE	TA,DISTSZ
	AOJA	TA,NAMCTB

	>

	JRST	BASLS0
;FINAL SUMMARY FOR COMPILATION  (CONT'D).

	DEFINE BASES,<
	XLIST
	BASLOC	NAMCT1,1
	BASLOC	NAMCT2,1
	BASLOC	NAMCT3,1
	BASLOC	TEMBAS,0
	BASLOC	DATBAS,0
	BASLOC	FILTBL,0
	BASLOC	USEBAS,0
	BASLOC	IMPPAR,0
	BASLOC	A50BAS,0
	BASLOC	RESDNT,0
	BASLOC	NONRES,0
	LIST>
	DEFINE BASLOC (X,Y),<
	XWD	Y*40,X
	SIXBIT	"X"
	>
BASLST:	BASES;
BASXWD:	XWD	<BASLST-.>/2,BASLST

BASLS0:	PUSHJ	PP,LCRLF
	MOVE	TB,BASXWD

BASLS1:	MOVE	TA,1(TB)
	PUSHJ	PP,SIXOUT
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	MOVE	TE,@0(TB)
	MOVE	TA,0(TB)
	TLNE	TA,-40
	JRST	BASLS4

	MOVE	TA,[POINT 3,TE,17]

BASLS2:	ILDB	CH,TA
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNE	TA,770000
	JRST	BASLS2

BASLS3:	PUSHJ	PP,LCRLF
	ADDI	TB,1
	AOBJN	TB,BASLS1

	PJRST	PRNTAG		;GO PRINT OUT TAG TABLE

BASLS4:	PUSHJ	PP,DECIT
	JRST	BASLS3
;FINAL SUMMARY FOR COMPILATION  (CONT'D)
;PRINT OUT TABLE USAGE  (CONT'D)

TABD2:	MOVEI	CT,SIZED
	IDIVI	TE,12		;CONVERT TO 5 DECIMAL DIGITS
	PUSH	PP,TD
	SOJG	CT,.-2

	MOVEI	CT,SIZED-1
	JUMPE	TE,.+4		;MORE THAN 5 DIGITS?
	IDIVI	TE,12		;YES--KEEP CONVERTING
	PUSH	PP,TD
	AOJA	CT,.-3

	MOVEI	CH," "
	PUSHJ	PP,PUTLST

TABD3:	POP	PP,TE		;SUPPRESS LEADING ZEROES
	JUMPN	TE,TABD5
	PUSHJ	PP,PUTLST
	SOJG	CT,TABD3

TABD4:	POP	PP,TE		;PRINT OUT SIGNIFICANT DIGITS
TABD5:	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTLST
	SOJGE	CT,TABD4
	POPJ	PP,


;PRINT OUT SIX SPACES AND SKIP UPON EXITING

TABD6:	AOS	(PP)
	MOVEI	CT,SIZED+1
	MOVEI	CH," "
	PUSHJ	PP,PUTLST
	SOJG	CT,.-1
	POPJ	PP,
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT TAGTAB STATISTICS

PRNTAG:	TSWT	FOBJEC		;ANY OBJECT LISTING?
	POPJ	PP,		;NO, NO TAG TABLE EITHER
	SKIPN	TAGCNT##		;ANY TAGS USED
	JRST	NOTAGS		;NONE???
	PUSHJ	PP,HDROUT	;START NEW PAGE
	MOVEI	TB,LINPAG##-3	;NO. OF LINES LEFT ON FIRST PAGE
	SETZM	TAGOFF##	;OFFSET FOR FIRST COLUMN
	MOVEM	TB,TAGOFF+1	;OFFSET FOR SECOND COLUMN
	ADD	TB,TB
	MOVEM	TB,TAGOFF+2	;OFFSET FOR THIRD COLUMN
	MOVE	TA,TAGCNT	;GET NUMBER OF TAGS
	HRRZ	CH,TAGLOC##	;GET BASE OF TAG TABLE
	CAILE	TA,LINPAG-3	;FIT IN ONE COLUMN?
	SKIPA	TB,[EXP 3-LINPAG]	;NO
	MOVN	TB,TA		;YES
	ADD	TA,TB		;WHATS LEFT
	HRL	TB,CH		;START AT FRONT
	MOVSM	TB,TAGCOL##	;FIRST AOBJN WORD
	CAILE	TA,LINPAG-3
	SKIPA	TB,[EXP 3-LINPAG]
	MOVN	TB,TA
	ADD	TA,TB
	HRLI	TB,LINPAG-3	;OFFSET
	MOVSM	TB,TAGCOL+1	;SECOND AOBJN WORD
	ADDM	CH,TAGCOL+1	;ADD IN BASE
	CAILE	TA,LINPAG-3
	SKIPA	TB,[EXP 3-LINPAG]
	MOVN	TB,TA
	ADD	TA,TB
	HRLI	TB,<LINPAG-3>*2
	MOVSM	TB,TAGCOL+2	;THIRD AOBJN WORD
	ADDM	CH,TAGCOL+2	;ADD IN BASE
	MOVEM	TA,TAGLFT##	;STORE # OF TAGS LEFT AFTER THIS PAGE DONE
	MOVE	TE,[POINT 7,[ASCIZ "TAG table:
(TAG)	(Ref. count)	(PC)			(TAG)	(Ref. count)	(PC)			(TAG)	(Ref. count)	(PC)

"]]
	PUSHJ	PP,LSTMES
	MOVNI	TA,2
	ADDM	TA,PAGCNT##	;GET COUNT RIGHT
	SETZ	TB,		;TB= TAG NUMBER
PRNTG0:	MOVSI	TA,-3		;AOBJN POINTER TO THE AOBJN POINTERS
PRNTG1:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	MOVEI	TE,0(TB)	;PRINT TAG #
	ADD	TE,TAGOFF##(TA)	;ADD IN OFFSET
	PUSHJ	PP,PRTDEC
	MOVEI	CH,11		;TAB
	PUSHJ	PP,PUTLST
	HRRZ	TE,TAGCOL(TA)	;GET RIGHT PART OF TABLE
	LDB	TE,[POINT 15,(TE),17] ;PRINT REF. COUNT
	PUSHJ	PP,PRTDEC
	MOVEI	CH,11
	PUSHJ	PP,PUTLST

	HRRZ	TD,TAGCOL(TA)
	MOVE	TD,(TD)
	TLNE	TD,(1B0)	;
	 JRST	PRINDT		;"INDIRECT REFERENCE"
	HRRZ	TE,TD		;PRINT PC
	ADD	TE,RESDNT	;ADD IN BASE OF RESIDENT SECTION
	PUSHJ	PP,PRTOCT
PRNTG2:	HLRE	TE,TA		;PRINT SEPARATOR
	AOJE	TE,PRNTG3	;UNLESS LAST COLUMN
	MOVE	TE,[POINT 7,[ASCIZ /				/]]	;4 TABS
	PUSHJ	PP,LSTMES
PRNTG3:	AOBJP	TA,PRNTG4	;DONE WITH THIS ROW?
	SKIPGE	TAGCOL(TA)	;NO, IS NEXT COLUMN STILL VALID
	JRST	PRNTG1		;YES, DO IT
PRNTG4:	PUSHJ	PP,LCRLF	;<CRLF>
	ADDI	TB,1		;NEXT TAG
	MOVE	CH,[1,,1]
	ADDM	CH,TAGCOL+1	;ADVANCE THE POINTERS
	ADDM	CH,TAGCOL+2
	ADDB	CH,TAGCOL
	JUMPL	CH,PRNTG0	;STILL MORE TO DO ON THIS PAGE
	SKIPG	TAGLFT		;MORE TO DO?
	POPJ	PP,		;NO, DONE
	ADD	TB,TAGOFF+2	;ADVANCE TAG # BY THREE AREAS
	MOVEI	TE,LINPAG
	MOVEM	TE,TAGOFF+1	;REST OF PAGES ARE LARGER
	ADD	TE,TE
	MOVEM	TE,TAGOFF+2
	MOVE	TE,TAGCOL+2	;THIS IS NEW BASE
	HRRM	TE,TAGCOL
	ADDI	TE,LINPAG
	HRRM	TE,TAGCOL+1
	ADDI	TE,LINPAG
	HRRM	TE,TAGCOL+2
	MOVE	TA,TAGLFT	;GET WHATS LEFT
	CAILE	TA,LINPAG	;FIT ON ONE PAGE?
	SKIPA	TE,[EXP -LINPAG]
	MOVN	TE,TA		;YES
	ADD	TA,TE
	HRLM	TE,TAGCOL	;NEW FIRST AOBJN POINTER
	CAILE	TA,LINPAG
	SKIPA	TE,[EXP -LINPAG]
	MOVN	TE,TA
	ADD	TA,TE
	HRLM	TE,TAGCOL+1	;SECOND WORD
	CAILE	TA,LINPAG
	SKIPA	TE,[EXP -LINPAG]
	MOVN	TE,TA
	ADD	TA,TE
	HRLM	TE,TAGCOL+2
	MOVEM	TA,TAGLFT	;IN CASE NO DONE 
	JRST	PRNTG0		;START AGAIN

PRINDT:	TRC	TD,AS.PRO
	TRZE	TD,700000	;SKIP IF A PARAGRAPH REF
	 JRST	PRNTG5
	HRRZ	DT,PROLOC
	ADDI	DT,(TD)
	PUSH	PP,TA
	PUSH	PP,TB
	PUSHJ	PP,LSTNAM	;LIST PARAGRAPH NAME
	POP	PP,TB
	POP	PP,TA
	HLRE	CH,TA		;PRINT SEPARATOR
	AOJE	CH,PRNTG3	;UNLESS LAST COLUMN
	IDIVI	TE,7		;GET NO. OF TAB STOPS ALREADY PASSED
	SUBI	TE,5		;NO. WE NEED
	JUMPN	TE+1,.+3	;ONE TIME LESS IF NOT EXACT NUMBER
	MOVEI	CH,11
	PUSHJ	PP,PUTLST
	AOJL	TE,.-2		;LOOP UNTIL ENOUGH
	JRST	PRNTG3

PRNTG5:	MOVEI	CH,"%"
	PUSHJ	PP,PUTLST
	HRRZ	TE,TD		;GET TAG NUMBER
	PUSHJ	PP,PRTDEC
	JRST	PRNTG2

NOTAGS:	MOVE	TE,[POINT 7,[ASCIZ "
[TAGTAB found empty]
"]]
	PJRST	LSTMES
;FINAL SUMMARY FOR COMPILATION  (CONT'D)

;PRINT ELAPSED TIME
;ENTER WITH TIME IN "TE".

TIMOUT:	ADDI	TE,5		;ROUND UP 5 MILS
	IDIVI	TE,^D1000	;CONVERT TO SECONDS
	MOVEI	TC,(TD)		;SAVE REMAINDER ROUNDED
	PUSHJ	PP,TABD2	;PRINT SECONDS

	MOVEI	CH,"."		;PRINT FRACTIONS OF A SECOND
	PUSHJ	PP,PUTLST

	MOVE	TE,TC
	IDIVI	TE,^D100
	MOVEI	CH,"0"(TE)
	PUSHJ	PP,PUTLST

	MOVE	TE,TD
	IDIVI	TE,^D10
	MOVEI	CH,"0"(TE)
	JRST	PUTLST


;TABLE OF TABLES

	DEFINE TABSET (A,B,C,E,F,G,H),<
	EXTERNAL A'LOC
	SIXBIT "E"
	XWD	^D'B+1,A'LOC>

TABDT:	TABLES
TABDX:	XWD	<TABDT-.>/2,TABDT

	>			;END OF "IFN DEBUG" FOR SUMMARY
SUBTTL	SYMBOL TABLE DUMPER

;SET TO APPEND TO REL FILE IF AN OVERLAY FILE WAS WRITTEN, ELSE
;JUST CONTINUE WRITING ON CURRENT BIN DEVICE.

DOSYM:	MOVE	PC,HILOC
	MOVEM	PC,END.PC

	SKIPE	BINDEV
	SKIPE	PRODSW		;IF THIS IS FOR PRODUCTION,
	JRST	DOSYM9		;  WE DON'T NEED TABLES

;IF DEBUG MODE IS WANTED CHECK TO SEE IF WE HAVE ANY FAKE CD DATABS TO FIXUP

IFN ANS74,<
 IFN MCS!TCS,<
	SKIPN	DEBSW##		;NEED DEBUG CODE?
	JRST	NODEB		;NO
	MOVEI	TA,1
	MOVEM	TA,CURCD##	;INITIALIZE LOOP
	JRST	DBLOOP

DBTST:	MOVEI	TA,SZ.CD	;GET SIZE OF TABLE
	ADDB	TA,CURCD	;INCREMENT SAFE COUNTER
DBLOOP:	ADD	TA,CDLOC##
	HRRZ	TA,TA
	HRRZ	TB,CDNXT##
	CAIL	TA,(TB)		;STILL IN TABLE?
	JRST	NODEB		;NO, ALL DONE
	LDB	TA,CD.FDL##	;DEBUGGING ON THIS CD-NAME
	JUMPE	TA,DBTST	;NO
	PUSH	PP,TA		;SAVE LINK
	PUSHJ	PP,LNKSET	;GET FAKE DATAB ADDRESS
	LDB	TA,DA.NAM##	;GET NAMTAB LINK
	ADD	TA,NAMLOC
	POP	PP,(TA)		;STORE LINK TO DATAB
	JRST	DBTST		;LOOP FOR ALL CDTAB
NODEB:>>
;INITIALIZE DATGRP AND GET SYMBOL PC

	MOVEI	TE,37
	MOVEM	TE,BLKTYP
	PUSHJ	PP,PDATI
	MOVE	PC,END.PC
	MOVEM	PC,DATGRP+2
	MOVEM	PC,NM.PC	;SAVE NAMTAB VALUE

	PUSHJ	PP,PUTZER	;WRITE ZERO IN FILE
	PUSHJ	PP,TABFIX	;FIX UP TABLES AND PUT OUT NAMTAB

	MOVEM	PC,DT.PC	;SAVE PNTR TO DATAB
	PUSHJ	PP,PUTZER	;ZEROTH WORD OF TABLE
	PUSHJ	PP,DODAT	;PUT OUT DATAB

	MOVEM	PC,PR.PC	;SAVE PNTR TO PROTAB
	PUSHJ	PP,PUTZER	;...
	PUSHJ	PP,DOPRO	;PUT OUT PROTAB
	HRRI	TA,-1(PC)	;SAVE ADDRESS OF THE LAST
	HRLM	TA,DT.PC	; ADDRESS IN THE USER'S PROGRAM.

	MOVEM	PC,%ES.PC

	PUSHJ	PP,CLRDAT
	MOVEI	TE,1
	MOVEM	TE,BLKTYP
	JRST	PDATI

DOSYM9:	SETZM	NM.PC##
	SETZM	DT.PC##
	SETZM	PR.PC##
	POPJ	PP,
;HERE TO PUT OUT DATAB

DODAT:	MOVE	DT,DATLOC
DODAT1:	CAML	DT,DATNXT
	POPJ	PP,		;NO MORE - RETURN
	MOVEI	TA,0
	MOVE	TB,1(DT)	;DUMP FIRST WORD
	HRL	TB,4(DT)	;PICK UP ADJUSTED NAMTAB LINK
	HLLZS	4(DT)		;CLEAR RPWTAB LINK
	PUSHJ	PP,PUTDAT
	HRRZI	TA,1(DT)	;ITEM IN LINKAGE SECTION?
	LDB	TB,DA.LKS##
	JUMPE	TB,DODAT0	;NO
	LDB	TC,DA.LVL##	;GET LEVEL #
	MOVEI	TA,2		;YES, RELOCATE LEFT HALF (LINK PTR)
	HLRZ	TB,2(DT)
	ADD	TB,IMPPAR##	;BASE OF %PARAM
	HRLZI	TB,(TB)
	CAIE	TC,01		;LEVEL 01 OR 77?
	CAIN	TC,77
	MOVEM	TB,CURHLD##	;YES, SAVE PTR
	MOVE	TB,CURHLD	;NO, GET PTR TO 01 LEVEL
	HRR	TB,2(DT)	;KEEP RH ABSOLUTE OFFSET
	JRST	DODAT5
DODAT0:	MOVEI	TA,1		;RELOCATE 2ND WORD
	MOVE	TB,2(DT)
	ADD	TB,DATBAS
DODAT5:	PUSHJ	PP,PUTDAT
	ADDI	PC,2		;ACCOUNT FOR THEM

	MOVEI	W1,5		;ASSUME 5 WORDS ADDITIONAL
	MOVEI	TA,1(DT)

;IF THE FATHER IS A FILENAME, CHANGE THE FILTAB POINTER TO THE FILE NUMBER,
; SO COBDDT CAN DO JUSTIFICATION.
	LDB	TA,DA.POP	;GET FATHER
	JUMPE	TA,DODT5A	; NO FATHER, JUMP
	LDB	TC,LNKCOD	;IS IT A FILENAME?
	CAIE	TC,CD.FIL
	 JRST	DODT5A		;NO, LEAVE AS IS
	ADD	TA,FILLOC##	;LOOK AT FILTAB ENTRY
	LDB	TD,FI.NUM##	;GET NUMBER OF THE FILE
	MOVEI	TA,1(DT)	;STORE IN DATAB ENTRY
	DPB	TD,DA.POP	; IN PLACE OF THE FILTAB ADDRESS

;SEE IF ITEM HAS PICTURE WORDS

DODT5A:	MOVEI	TA,1(DT)
	LDB	TD,DA.PWA
	JUMPE	TD,DODAT2
	MOVEI	W1,DA.EDW+4-2
	LDB	TE,DA.KEY	;ACCOUNT FOR ANY
	ADD	W1,TE		;  KEYS
	JRST	DODAT3

;SEE IF ITEM IS SUBSCRIPTED

DODAT2:	LDB	TD,DA.SUB	;IS FIELD SUBSCRIPTED?
	JUMPE	TD,DODAT4	;NO
	ADDI	W1,2		;YES--ACCOUNT FOR 2 MORE WORDS

DODAT3:	MOVEI	TE,0
	DPB	TE,DA.DEP

DODAT4:	ADD	PC,W1		;ACCOUNT FOR REST OF ENTRY
	HRRZI	TC,3(DT)
	ADDI	W1,1
	HRLS	W1
	ADD	DT,W1
	MOVNI	W1,-1(W1)
	HRL	TC,W1
	MOVEI	TA,0
	MOVE	TB,(TC)
	PUSHJ	PP,PUTDAT
	AOBJN	TC,.-2

	AOBJN	DT,DODAT1
;HERE TO PUT OUT PROTAB

DOPRO:	MOVE	DT,PROLOC
DOPRO1:	CAML	DT,PRONXT
	POPJ	PP,		;EXIT WHEN DONE
	MOVEI	TA,0		;PUT OUT FIRST WORD
	MOVE	TB,1(DT)
	HRL	TB,4(DT)
IFN ANS74,<
;FIX LINK TO PROTAB FOR SAME NAME POINTER
	HRRZ	TE,TB		;GET LINK TO SAME NAME
	TRZ	TE,700000	;GET RID OF BITS
	IDIVI	TE,SZ.PRO
	IMULI	TE,SZ.PR6
	ADD	TE,TD		;ADD BACK IN THE REMAINDER
	DPB	TE,[POINT 15,TB,35]
>;END IFN ANS74
	PUSHJ	PP,PUTDAT

	MOVEI	TA,1		;PUT OUT SECOND WORD
	MOVE	TB,2(DT)
IFN ANS74,<			;FIX POINTER TO SECTION
	HLRZ	TE,TB		;GET COMPILER'S PROTAB POINTER
	TRZ	TE,700000	;GET PROTAB OFFSET
	IDIVI	TE,SZ.PRO	; FIND COMPILER ENTRY NUMBER
	IMULI	TE,SZ.PR6	; FIND LIBOL ENTRY OFFSET
	ADD	TE,TD		;ADD INCREMENT (SHOULD BE 1)
	DPB	TE,[POINT 15,TB,17] ;PUT BACK IN TB
>;END IFN ANS74
	LDB	TE,[POINT 7,3(DT),24]
	JUMPN	TE,DOPRO2
	ADD	TB,RESDNT
	JRST	DOPRO3
DOPRO2:	ADD	TB,NONRES
DOPRO3:	PUSHJ	PP,PUTDAT

	MOVEI	TA,0		;PUT OUT THIRD WORD
	MOVE	TB,3(DT)
	PUSHJ	PP,PUTDAT
IFN ANS68,<
	SETZB	TA,TB		;PUT OUT ZERO FOR FOURTH WORD
	PUSHJ	PP,PUTDAT
>
IFN ANS74,<
	HRRZ	TA,4(DT)	;GET FLOTAB LINK
	ADD	TA,FLOLOC##
	LDB	TB,FL.LN##	;GET LINE#
	SETZ	TA,
	PUSHJ	PP,PUTDAT	;PUT OUT LINE# AS FOURTH WORD
>
	ADDI	PC,SZ.PR6	;INCREMENT BY SIZE OF ENTRY
	ADD	DT,[SZ.PRO,,SZ.PRO]
	JRST	DOPRO1		;LOOP
;HERE TO FIX UP NAMTAB PNTRS AND DUMP CONDENSED NAMTAB

TABFIX:	MOVE	OP,NM2LOC
	MOVEI	CT,1		;INIT OFFSET IN NAMTAB

TABFX1:	SKIPN	TB,0(OP)
	JRST	TABFX7
	ADD	TB,NAMLOC
	HRRZ	TA,0(TB)
	JUMPE	TA,TABFX6	;SKIP ENTRY IF NO POINTER
	MOVE	W1,TB		;SAVE PNTR TO ENTRY

	PUSHJ	PP,TABFX9	;GET FIRST DATAB OR PROTAB LINK
	JUMPE	TA,TABFX6	;IF NONE, FORGET IT
	HRRM	W2,0(W1)	;RESET LINK IN NAMTAB

TABFX2:	HRRM	CT,3(TA)	;SAVE NAMTAB LINK IN ITEM
	HRRZ	TA,0(TA)	;GET 'SAME NAME' LINK
	JUMPE	TA,TABFX5	;IF NONE, WE ARE DONE WITH THIS NAME
	PUSHJ	PP,TABFX9	;GO TO NEXT DATAB OR PROTAB ENTRY
	JUMPN	TA,TABFX2	;LOOP IF ONE FOUND

TABFX5:	HRRZ	DT,NAMLOC
	ADD	DT,0(OP)
	HRRZ	TA,0(DT)
	JUMPE	TA,TABFX6	;JUST SKIP IF NOTHING LEFT
	HLLM	DT,0(DT)	;STORE SIZE
	HLRZ	TA,DT
	ADDI	CT,1(TA)	;UPDATE NAMTAB OFFSET
	MOVNI	TA,1(TA)
	HRL	DT,TA		;FORM AOBJN WORD
	MOVEI	TA,0
	MOVE	TB,0(DT)
	PUSHJ	PP,PUTDAT
	AOBJN	DT,.-2

TABFX6:	AOJA	OP,TABFX1

	HRL	DT,TA		;FORM AOBJN WORD TO DATA ITEM
TABFX7:	ADDI	PC,-1(CT)	;UPDATE PC
PUTZER:	SETZB	TA,TB
	PUSHJ	PP,PUTDAT	;WRITE 0 IN FILE
	AOJA	PC,CPOPJ	;RETURN
;FIND NEXT DATAB OR PROTAB ENTRY

TABFX9:	MOVE	W2,TA		;SAVE THE LINK
	LDB	TC,LNKCOD	;GET TABLE TYPE
	JUMPE	TC,TBFX9A	;IF ZERO, FORGET IT
	PUSHJ	PP,LNKSET	;CONVERT LINK TO ADDRESS
IFN ANS68,<
	CAIE	TC,TB.DAT	;IF DATAB
	CAIN	TC,TB.PRO	;  OR PROTAB
	POPJ	PP,		;  WE WIN
>
IFN ANS74,<
	CAIN	TC,TB.DAT	;IF DATAB
	POPJ	PP,		; WE WIN
	CAIE	TC,TB.PRO	;  OR PROTAB
	JRST	TBFX9B		; NO, WE LOSE
	PUSH	PP,W2+1		;WE NEED NEXT ACC TO HOLD REMAINDER (OF 1)
	ANDI	W2,077777	;ONLY THE TABLE OFFSET
	IDIVI	W2,SZ.PRO	;CONVERT FROM 5 WORDS
	IMULI	W2,SZ.PR6	;TO 4 WORDS
	ADD	W2,W2+1		;PLUS 1
	POP	PP,W2+1
	TRO	W2,TB.PRO*100000
	POPJ	PP,		;  WE WIN

TBFX9B:>
	HRRZ	TA,0(TA)	;IF 'SAME NAME' LINK IS NON-ZERO,
	JUMPN	TA,TABFX9	;  TRY THAT ONE,
	POPJ	PP,		;  ELSE QUIT

TBFX9A:	MOVEI	TA,0
	POPJ	PP,
SUBTTL	PRODUCE CREF LISTING

CREF:	MOVSI	TE,(ASCIZ "C")
	MOVEM	TE,HDRPAG
	SETZM	SUBPAG
	SETZM	PAGCNT

	MOVEM	PP,CRFERA
	MOVE	TA,CRFBUF
	MOVEM	TA,.JBFF##
	INBUF	CRF,2

	MOVE	TD,CRFHDR
	MOVE	TC,CRFHDR+1
	SETZB	TB,TA
	LOOKUP	CRF,TD
	  JRST	KNOCRF

	MOVE	TE,CRFLOC##	;SET JOBFF TO BE AT
	HRRM	TE,.JBFF	;  CRFTAB

	PUSHJ	PP,PSORT	;SET UP SORT

CREF04:	MOVE	TE,[XWD -6,GCREFN-1]
CREF4A:	PUSHJ	PP,GETCRF	;GET CREF WORD
	  JRST	CREF10		;NO MORE, GO DO MERGE

	AOBJP	TE,CREF05
	TLC	CH,1B18
	MOVEM	CH,(TE)
	JRST	CREF4A

CREF05:	TLZ	CH,377774	;GET RID OF SOME CRUD
	TLC	CH,1B18		;REVERSE 'DEFINITION' FLAG SO THAT DEFINITION
				;  OF ITEM SORTS BEFORE NON-DEFINITION
	ROT	CH,^D11		;GET LINE NUMBER INTO LEFT HALF
	MOVEM	CH,(TE)

	LDB	TE,[POINT 6,GCREFN,5];IF IT DOESN'T START WITH "-"
	CAIE	TE,"M"-40	;  (SIXBIT "-" WITH HI-BIT COMPLEMENTED)
	PUSHJ	PP,RELES	;  GIVE ITEM TO SORT
	JRST	CREF04		;GO AFTER ANOTHER
;PRODUCE CREF LISTING (CONT'D)

;END OF INPUT

CREF10:	PUSHJ	PP,MERGE	;MERGE THE SCRATCH FILES

	SETZM	OLDCNM		;CLEAR 'MOST RECENT NAME'
	MOVE	TE,[XWD OLDCNM,OLDCNM+1]
	BLT	TE,OLDCNM+4

	PUSHJ	PP,HDROUT	;PUT OUT HEADING

CREF30:	PUSHJ	PP,RETRN	;GET AN ITEM FROM SORT
	  JRST	LCRLF		;AT END--PUT OUT <C.R.>,<L.F.> AND RETURN

CRF30A:	MOVE	TE,[XWD -5,GCREFN];TURN
	MOVSI	TD,1B18		;  OFF
CREF31:	XORM	TD,(TE)		;  SIGN
	AOBJN	TE,CREF31	;  BIT

	MOVE	TE,[XWD -5,GCREFN]; COMPARE
	MOVEI	TD,OLDCNM	;  THIS
CRF31A:	MOVE	TC,(TE)		;  ONE
	CAME	TC,(TD)		;  WITH
	JRST	CRF31B		;  LAST
	AOBJP	TE,CREF34	;  0NE
	AOJA	TD,CRF31A	;  *

;NEW ONE IS NOT SAME AS OLD ONE

CRF31B:	PUSHJ	PP,LCRLF	;PUT OUT <C.R.>,<L.F.>
	MOVE	TE,[XWD GCREFN,OLDCNM];COPY NEW ONE TO
	BLT	TE,OLDCNM+4	;  OLD ONE

	MOVEI	TE,0		;PUT
	MOVE	TA,[POINT 6,GCREFN]; NEW
CRF31C:	ILDB	CH,TA		;  ONE
	JUMPE	CH,CRF31D	;  ONTO
	ADDI	CH,40		;  LISTING
	PUSHJ	PP,PUTLST	;  FILE
	AOJA	TE,CRF31C	;  *

CRF31D:	TRZ	TE,7		;TAB
CRF31E:	MOVEI	CH,11		;  TO
	PUSHJ	PP,PUTLST	;  COLUMN
	ADDI	TE,10		;  32
	CAIGE	TE,40		;  *
	JRST	CRF31E		;  *
;PRODUCE CREF LISTING (CONT'D)

	MOVEI	TE,^D11		;SET UP
	TSWF	FLTTY		;  COUNT OF
	MOVEI	TE,^D5		;  NUMBERS PER
	MOVEM	TE,GCREFC	;  LINE
	JRST	CREF36

CREF34:	SOSLE	GCREFC		;IS LINE FULL?
	JRST	CREF35		;NO
	PUSHJ	PP,LCRLF	;YES--PUT OUT <C.R.>,<L.F.>
	MOVEI	CH,11		;PUT OUT
	PUSHJ	PP,PUTLST	;  TABS
	PUSHJ	PP,PUTLST	;  TO
	PUSHJ	PP,PUTLST	;  COLUMN 24

	MOVEI	TE,^D11		;SET UP
	TSWF	FLTTY		;  COUNT OF
	MOVEI	TE,^D5		;  NUMBERS PER
	MOVEM	TE,GCREFC	;  LINE
;PRODUCE CREF LISTING (CONT'D)

;PUT OUT LINE NUMBER

CREF35:	MOVEI	CH,11		;PRECEDE IT
	PUSHJ	PP,PUTLST	;  BY TAB

CREF36:	HLRZ	TC,GCREFN+5	;GET LINE NUMBER
	MOVEI	TD,4		;PUT OUT 4 DIGITS

	PUSHJ	PP,CREF38

	MOVE	TA,GCREFN+5	;IS IT A
	TROE	TA,1B25		;  DEFINITION?
	JRST	CREF30		;NO

	PUSH	PP,TA		;YES--SAVE TA
	MOVEI	CH,"#"		;PRINT A
	PUSHJ	PP,PUTLST	;  POUND SIGN

	PUSHJ	PP,RETRN	;GET NEXT ITEM
	  JRST	CREF37		;NO MORE--WE ARE DONE

	POP	PP,TA		;GET PREVIOUS LN,CP
	CAMN	TA,GCREFN+5	;IF SAME AS THIS ONE,
	JRST	CREF30		;  IGNORE THIS ONE,
	JRST	CRF30A		;  ELSE USE THIS ONE

CREF37:	POP	PP,TA		;RESTORE PUSH-DOWN LIST
	JRST	LCRLF		;PUT OUT <C.R.>,<L.F.> AND LEAVE


;PUT OUT 4-DIGIT DECIMAL NUMBER

CREF38:	IDIVI	TC,^D10
	HRLM	TB,(PP)
	SOJLE	TD,.+2
	PUSHJ	PP,CREF38

	HLRZ	CH,(PP)
	ADDI	CH,"0"
	JRST	PUTLST
;GET WORD FROM CREF FILE

GETCRF:	SOSG	CRFBHI+2
	JRST	GTCRF2
GTCRF1:	ILDB	CH,CRFBHI+1
	AOS	(PP)
	POPJ	PP,

GTCRF2:	IN	CRF,
	  JRST	GTCRF1
	STATO	CRF,740000	;IF NO ERROR BITS,
	  POPJ	PP,		;  IT MUST BE END OF FILE

	MOVEI	CH,CRFDEV
	JRST	DEVDED


;NO CREF FILE

KNOCRF:	OUTSTR	[ASCIZ "?Couldn't find cref file"]
	CALLI	12
;TABLE OF ROUTINES TO CREATE ADDRESS, BY ADDRESS TYPE

ADRTB1:	JRST	ADRCON		;CONSTANT
	PUSHJ	PP,ADRDAT	;DATAB
	PUSHJ	PP,ADRPRO	;PROTAB
	JRST	ADREXT		;EXTAB
	PUSHJ	PP,ADRFIL	;FILTAB
	PUSHJ	PP,ADRTAG	;TAGTAB
	JRST	INCCON		;INCREMENT IS A CONSTANT
	JRST	INCMIS		;INCREMENT IS MISCELLANEOUS

;TABLE OF ROUTINES TO HANDLE INCREMENT,BY INCREMENT TYPE

INCTB1:	PUSHJ	PP,BADINC	;ADD INCREMENT TO ADDRESS
	HRR	TB,IMPPAR	;ADD TO PARAMETERS IN IMPURE AREA
	JRST	INCFLS		;REFERENCE TO FILES.
	HRR	TB,LITBAS	;ADD TO LITERAL POOL BASE
	JRST	INCGO		;REFERENCE TO "GOTO.."
	HRR	TB,PC		;ADD TO CURRENT LOCATION
	PUSHJ	PP,TMPINC	;ADD TO TEMPORARY BASE
	HRR	TB,A50BAS	;ADD TO ALTER TABLE FOR SEGS > 49

;TABLE OF ROUTINES USED TO LIST THE ADDRESS

ADRTB2:	JRST	LSCON1		;ADDRESS IS CONSTANT <100000
	ADD	DT,DATLOC	;DATAB
	ADD	DT,PROLOC	;PROTAB
	JRST	LSTEXT		;EXTAB
	ADD	DT,FILLOC	;FILTAB
	JRST	LSTTAG		;TAGTAB
	JRST	LSTCON		;INCREMENT IS CONSTANT >77777
	JRST	LSTMIS		;MISCELLANEOUS

;TABLE OF ROUTINES FOR LISTING MISCELLANEOUS ADDRESSES

INCTB2:	MOVSI	TA," "-40	;NOT USED
	MOVE	TA,[SIXBIT "%PARAM"]
	MOVE	TA,[SIXBIT "%FILES"]
	PUSHJ	PP,INCLIT
	MOVE	TA,[SIXBIT "GOTO.."]
	MOVSI	TA,(SIXBIT /./)
	PUSHJ	PP,TMPLST
	MOVE	TA,[SIXBIT "%ALT50"]
SUBTTL	CONSTANTS

;TABLE OF POWERS OF TEN FOR FLOATING-POINT CONVERSION.
;THE FIRST PARAMETER IS THE EXPONENT, THE SECOND IS THE HI-ORDER 35 BITS
;OF THE MANTISSA, AND THE THIRD IS THE LOW-ORDER 35 BITS OF THE MANTISSA.

;ONLY THE HI-ORDER 35 BITS ARE USED IN THE CONVERSION.

DEFINE .TAB. (A)<
	REPEAT 0,<
	NUMBER 732,357347511265,056017357445	;D-50
	NUMBER 736,225520615661,074611525567
	NUMBER 741,273044761235,213754053125
	NUMBER 744,351656155504,356747065752
	NUMBER 750,222114704413,025260341562
	NUMBER 753,266540065515,332534432117
	NUMBER 756,344270103041,121263540543
	NUMBER 762,216563051724,322660234335
	NUMBER 765,262317664312,007434303425
	NUMBER 770,337003641374,211343364332
	NUMBER 774,213302304735,325716130610	;D-40
	NUMBER 777,256162766125,113301556752
	>
	NUMBER 002,331617563552,236162112545	;D-38
	NUMBER 006,210071650242,242707256537
	NUMBER 011,252110222313,113471132267
	NUMBER 014,324532266776,036407360745
	NUMBER 020,204730362276,323044526457
	NUMBER 023,246116456756,207655654173
	NUMBER 026,317542172552,051631227231
	NUMBER 032,201635314542,132077636440
	NUMBER 035,242204577672,360517606150	;D-30
	NUMBER 040,312645737651,254643547602
	NUMBER 043,375417327624,030014501542
	NUMBER 047,236351506674,217007711035
	NUMBER 052,306044030453,262611673245
	NUMBER 055,367455036566,237354252116
	NUMBER 061,232574123152,043523552261
	NUMBER 064,301333150004,254450504735
	NUMBER 067,361622002005,327562626124
	NUMBER 073,227073201203,246647575664
	NUMBER 076,274712041444,220421535242	;D-20
	NUMBER 101,354074451755,264526064512
	NUMBER 105,223445672164,220725640716
	NUMBER 110,270357250621,265113211102
	NUMBER 113,346453122766,042336053323
	NUMBER 117,220072763671,325412633103
	NUMBER 122,264111560650,112715401724
	NUMBER 125,341134115022,135500702312
	NUMBER 131,214571460113,172410431376
	NUMBER 134,257727774136,131112537675
	NUMBER 137,333715773165,357335267655	;D-10
	NUMBER 143,211340575011,265512262714
	NUMBER 146,253630734214,043034737477
	NUMBER 151,326577123257,053644127417
	NUMBER 155,206157364055,173306466551
	NUMBER 160,247613261070,332170204303
	NUMBER 163,321556135307,020626245364
	NUMBER 167,203044672274,152375747331
	NUMBER 172,243656050753,205075341217
	NUMBER 175,314631463146,146314631463	;D-01
A:	NUMBER 201,200000000000,0	;D00
	NUMBER 204,240000000000,0
	NUMBER 207,310000000000,0
	NUMBER 212,372000000000,0
	NUMBER 216,234200000000,0
	NUMBER 221,303240000000,0
	NUMBER 224,364110000000,0
	NUMBER 230,230455000000,0
	NUMBER 233,276570200000,0
	NUMBER 236,356326240000,0
	NUMBER 242,225005744000,0	;D+10
	NUMBER 245,272207335000,0
	NUMBER 250,350651224200,0
	NUMBER 254,221411634520,0
	NUMBER 257,265714203644,0
	NUMBER 262,343277244615,0
	NUMBER 266,216067446770,040000000000
	NUMBER 271,261505360566,050000000000
	NUMBER 274,336026654723,262000000000
	NUMBER 300,212616214044,117200000000
	NUMBER 303,255361657055,143040000000	;D+20
	NUMBER 306,330656232670,273650000000
	NUMBER 312,207414740623,165311000000
	NUMBER 315,251320130770,122573200000
	NUMBER 320,323604157166,147332040000
	NUMBER 324,204262505412,000510224000
	NUMBER 327,245337226714,200632271000
	NUMBER 332,316627074477,241000747200
	NUMBER 336,201176345707,304500460420
	NUMBER 341,241436037271,265620574524
	NUMBER 344,311745447150,043164733651	;D+30
	NUMBER 347,374336761002,054022122623
	NUMBER 353,235613266501,133413263573
	NUMBER 356,305156144221,262316140531
	NUMBER 361,366411575266,037001570657
	NUMBER 365,232046056261,323301053415
	NUMBER 370,300457471736,110161266320
	NUMBER 373,360573410325,332215544004
	NUMBER 377,226355145205,250330436402	;D+38
	REPEAT 0,<
	NUMBER 402,274050376447,022416546102
	NUMBER 405,353062476160,327122277522	;D+40
	NUMBER 411,222737506706,206363367623
	NUMBER 414,267527430470,050060265567
	NUMBER 417,345455336606,062074343124
	NUMBER 423,217374313163,337245615764
	NUMBER 426,263273376020,327117161361
	NUMBER 431,340152275425,014743015655
	NUMBER 435,214102366355,050055710514
	NUMBER 440,257123064050,162071272637
	NUMBER 443,332747701062,216507551406
	NUMBER 447,210660730537,231114641743	;D+50
	NUMBER 452,253035116667,177340012333
	>
>

DEFINE NUMBER (A,B,C)
<  EXP B,C>		;[762] GENERATE BOTH WORDS

FLTAB0:	.TAB. FLTAB1
XX==<FLTAB1-FLTAB0>/2	;[762] CALCULATE NUMBER OF TABLE ENTRIES BEFORE "FLTAB1"
PTLEN.==XX		;[762] MAX. SIZE OF TABLE
XX==XX-XX/4*4		;CALC XX==XX MOD 4

BINR1==<BINR2==<BINR3==0>>	;INIT THE BINARY

DEFINE NUMBER (A,B,C)<
IFE XX-1,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINR1==<BINR2==<BINR3==0>> >
IFE XX-2,<BINR3==A>
IFE XX-3,<BINR2==A>
IFE XX,<BINR1==A
	XX==4>
XX==XX-1>

	POINT 9,FLTAB3-1(TE),17
	POINT 9,FLTAB3-1(TE),26
	POINT 9,FLTAB3-1(TE),35
FLTAB2:	POINT 9,FLTAB3(TE),8
	POINT 9,FLTAB3(TE),17
	POINT 9,FLTAB3(TE),26
	POINT 9,FLTAB3(TE),35

	.TAB. FLTAB3
	IFN BINR1!BINR2!BINR3,<	BYTE (9) BINR1,BINR2,BINR3,0>
;TABLE OF DECIMAL POWERS OF TEN

DECTAB:	DEC	1000000000
	DEC	100000000
	DEC	10000000
	DEC	1000000
	DEC	100000
	DEC	10000
	DEC	1000
	DEC	100
	DEC	10
;THE CONSTANTS WHICH GO AT TOP OF PROGRAM

	DEFINE CONST (X,Y),<
	EXTERNAL X'PC
	EXP	X'PC
	ASCIZ	/Y:	/
	>

SYM.S:	CONST	NM.,%NM
	CONST	DT.,%DT
	CONST	PR.,%PR

SYM.P:	XWD	-3,SYM.S

	DEFINE CONST (X,Y),<
	EXTERNAL Y
	EXP	Y
	ASCIZ	/X:	'/
	>


DCP.S:	CONST	%POINT,DCPNT.;
	CONST	%COMMA,COMA.;
	CONST	%MONEY,DOLLR.;

DCP.:	XWD	-3,DCP.S

	FILO==0		;RELATIVE POSITION OF 'FILES.'
;TABLE OF  PDP-10 OP-CODES

	SALL
DEFINE %OPCT% (MNEM,B,C,OP10,LISTAC,LISTAD,LIST10,LSTNEG,INDENT,J,K,L,M,N),<
	XWD	LISTAC*1B18+LISTAD*1B19+INDENT*1B20+LIST10+LSTNEG*2,OP10
	SIXBIT	"MNEM">

DEFINE %OPCU%(A,B,C,D,E,F,G,H,I,J,K,L,M,N),<>

	;NOW THAT MACROS ARE DEFINED, BUILD THE TABLE
	OPCTAB	OPTABL	;THE FIRST SET OF OP CODES WITH LABEL FOR TABLE
	OPCTB2	OP2TAB	;THE SECOND SET OF OP CODES WITH LABEL FOR TABLE
	XOPTAB		;GET EXTRA OP CODES ALSO
ASAC:	POINT 4,W1,12	;AC-FIELD OF OPERATOR

FSTUUO==142

	ENDIT==177
	SIZED==5	;SIZE OF LARGEST NUMBER PRINTED AT TABD2

BADCON:	OUTSTR	[ASCIZ "Bad constant type in ASYFIL
"]
	JRST	KILLF

EXTERNAL LNKCOD,TB.FIL
EXTERNAL .JBOPS,COUNTF,COUNTW
EXTERNAL END.PC
EXTERNAL NAMLOC,DATLOC,FILLOC,FILNXT,PROLOC,EXTLOC,EXTNXT,TAGLOC,SECLOC,CURSEC
EXTERNAL LITLOC,TAGOUT,SAVTAG,DATGRP,DECSEG,ASYFIL,NAMNXT,LITBLK
EXTERNAL PRONXT,DATNXT,NM2LOC,%ES.PC
EXTERNAL ASOP,INCTYP,ADRTYP,PTSEGN,RESDNT,NONRES,DATBAS,TEMBAS,USEBAS
EXTERNAL EAS2PC,IMPPAR,LITBAS,ALTBAS,A50BAS,FLTC1,FLTC2,FILTBL
EXTERNAL SYMLC1,SYMREL,CURREL,SYMGRP,LSTBH
EXTERNAL PROGID,PROGST,GHOLD,PAGCNT,GAERAS,NUMEXT,EXTCNT
EXTERNAL BINHDR,BINDEV,BINBUF,BINPP,BINBH,OVRWRD,CURLIT,HILOC,HPLOC,SEGFLG
EXTERNAL LSTDEV,CRFDEV,CRFBHI,CRFBUF,CRFHDR
EXTERNAL FTDBAS,FIXEDS,OBJSIZ,HDRPAG,SUBPAG
EXTERNAL GCREFC,GCREFN,OLDCNM,CREFSW,PRODSW,CRFERA
EXTERNAL LMASKB
EXTERNAL DA.DFS,DA.DEF,DA.BRO,DA.POP
EXTERNAL DA.PWA,DA.EDW,DA.SUB,DA.DEP,DA.KEY
EXTERNAL TB.DAT,TB.PRO
EXTERNAL AS.TAG,AS.PRO

	END	COBOLG