Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/cobolo.mac
There are 7 other files named cobolo.mac in the archive. Click here to see a list.
; UPD ID= 747 on 1/14/83 at 9:20 AM by NIXON                            
TITLE	COBOLO FOR COBOL V13
SUBTTL	PHASE O - OPTIMIZATION		D. WRIGHT/DAW

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1977, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P,COMUNI,OPCTAB
	%%P==:%%P
	%%COMU==:%%COMU
	DEBUG==:DEBUG

	IFN TOPS20,<SEARCH MONSYM,MACSYM>

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL

COMMENT	\
	COBOLO IS CALLED AFTER COBOLE IF "/O" APPEARED IN THE
COBOL COMMAND, OR "OPTSW" WAS SET TO -1 SOMETIME BEFORE PHASE F.

	COBOLO READS IN AS2FIL, OPTIMIZES INSTRUCTION SEQUENCES, AND
WRITES THE FILE BACK ONTO ITSELF. THEN COBOLF IS CALLED, TO CONTINUE
AS USUAL.

	THE NON-RESIDENT SECTIONS (AS3FIL) ARE NOT OPTIMIZED.
\

;EDITS
;V12A RELEASED  *****
;NAME	DATE		COMMENTS
;DMN	 1-APR-80	[1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
SUBTTL	DEFINITIONS

;FLAGS WE CAN USE IN RH (SW)
FEOF==		1	;EOF ON AS2 FILE SEEN
FASA==		2	;SAW "ALTERNATE CODE SET"
FXWDS==		4	;READING A BUNCH OF XWDS
FMISCS==	10	;READING A BUNCH OF MISC ITEMS
FCONS==		20	;READING A BUNCH OF CONSTANTS
FLTAG==		40	;SAW THE TAG WHICH COMES BEFORE OUR INSERTED TAG
			; (FOR TAG+1)
FPLTAG==	100	;NEXT THING FOR NXTINS TO DO IS INSERT THE "FAKE" TAG
FLIT==		200	;SAW START OF LITERALS


; USEFUL BYTE POINTERS

IPOP$:	IP$OP	<(IPI)>		;OPCODE
IPAC$:	IP$AC	<(IPI)>		;AC FIELD
IPWC$:	IP$WC	<(IPI)>		;WORD COUNT
IPSKA$:	IP$SKA	<(IPI)>		;SKIP ALWAYS BIT
IPSK1$:	IP$SK1	<(IPI)>		;CONDITIONAL SKIP BIT
IPSK2$:	IP$SK2	<(IPI)>		;CONDITIONAL DOUBLE SKIP BIT

;NOTE: THE FOLLOWING USE "TA" AS THE INDEX AC
ASKIP$:	A$SKIP	<OPPART(TA)>
CSKIP$:	C$SKIP	<OPPART(TA)>

TAOP$:	IP$OP	<(TA)>
TAWC$:	IP$WC	<(TA)>


INTERNAL	DELINS,ADDWD,COLLE1
EXTERNAL	PMATCH,OPPART
EXTERNAL	AS.TAG,AS.DOT,AS.MSC

;DEFINED IN "P"
NBACK==NBACK		;NUMBER OF WORDS TO KEEP IN BACK OF CURRENT INST.
NFRONT==NFRONT		;NUMBER OF WORDS TO KEEP IN FRONT OF CURR. INST.
NWINDO==NWINDO		;NUMBER OF WORDS IN "CURRENT" WINDOW
IPI==IPI		;POINTER INTO IPTAB; PMATCH IS CALLED WITH
			; IPI POINTING WITHIN THE "WINDOW"
SUBTTL	DEFINITIONS FROM OPCTAB TABLES

; EXPAND THE TABLES HERE TO GET DEFINITIONS OF OPCODES

DEFINE %OPCT% (A,INTVAL,INTNAM,OPCODE,F1,F2,F3,F4,F5,SKPBIT,OPPARE,L,M,N),<
	INTNAM==INTVAL
	>
DEFINE %OPCU% (NAME,INTVAL,INTNAM,OPCODE,F1,F2,F3,F4,F5,SKPBIT,OPPARE,L,M,N),<
	INTNAM==INTVAL
	>
	OPCTAB;			;GET THE FIRST TABLE DEFS

; GET DEFS FOR ALTERNATE CODE SET
DEFINE %OPCT% (NAME,INTVAL,INTNAM,OPCODE,F1,F2,F3,F4,F5,SKPBIT,OPPARE,L,M,N),<
	INTNAM==INTVAL+200
	>
DEFINE %OPCU% (NAME,INTVAL,INTNAM,OPCODE,F1,F2,F3,F4,F5,SKPBIT,OPPARE,L,M,N),<
	INTNAM==INTVAL+200
	>

	OPCTB2;			;GET THE 2ND TABLE DEFS

.XCREF	%OPCT%,%OPCU%

	EPJPP=:PUSHJ._9+AC17	;SAME AS CMNGEN
SUBTTL	START OF PHASE O

COBOLO:	SETFAZ	O;
	TSWF	FFATAL		;WERE THERE FATAL ERRORS?
	JRST	BYPASS		;YES, FORGET IT

	HLLZS	SW		;CLEAR RH OF "SW"
	SETZM	INDELC##	;NUMBER OF INSTRUCTIONS DELETED
	SETZM	TAGDLC##	;NUMBER OF TAGS DELETED
	SETZM	OBEG##		;CLEAR ALL LOCAL STORAGE
	MOVE	TE,[OBEG,,OBEG+1]
	BLT	TE,OEND##

	SETZB	PC,CT		;START WITH PC 0; SET "EXTRA" COUNT TO 0
;OPEN AS2FIL FOR READING

STARTO:
IFE TOPS20,<
	CLOSE	ASY,		;CLOSE LAST FILE WRITTEN
	MOVEI	TE,'AS2'	;GET SET TO READ AS2FIL
	HRRM	TE,ASYFIL##
>
IFN TOPS20,<
	MOVE	TE,AS2JFN##	;GET JFN FOR AS2 FIL
	EXCH	TE,AS1JFN##	;USE AS1 ROUTINES TO READ
	MOVEM	TE,SAV1JF##	;AND SAVE TRUE JFN
	SETZM	AS2JFN		;SIGNAL NOTHING ON AS2 NOW
>
	PUSHJ	PP,SETASY##	;OPEN IT FOR INPUT

;NOW OPEN AS2FIL FOR OUTPUT (OVERWRITE IT)

IFN TOPS20,<
	PUSHJ	PP,SETAS2##	;OPEN NEW AS2 FILE FOR OUTPUT
>
IFE TOPS20,<
	CLOSE	AS2,		;USE AS2 CHANNEL SO WE CAN USE "PUTAS2"
	MOVEI	TA,AS2DEV##	;GET AS2 PARAM AREA
	MOVE	TA,DEVBUF##(TA)	;GET START OF BUFFER WE USED BEFORE
	MOVEM	TA,.JBFF##	;TELL MONITOR THAT'S OUR BUFFER
	OUTBUF	AS2,2		; GET OUTPUT BUFFERS

	MOVE	TE,ASYFIL##
	HRRI	TE,'AS2'	;GET FILENAME
	MOVE	TD,AS1HDR##+1	; EXTENSION
	SETZB	TC,TB
	ENTER	AS2,TE
	 JRST	CNTENT		; ?CAN'T ENTER -- COMPLAIN
>

; INITIALIZE POINTERS AND THINGS

	MOVEI	TE,INSTBF##	;START OF INSTBF
	MOVEM	TE,NXTIP##	; NEXT INSTRUCTION
	MOVEI	TE,INSTBF##+100	;FAKE END PTR TO START
	MOVEM	TE,BIPTR##
	MOVEI	IPI,IPCUR##	;READ IN 1ST INSTRUCTION
	PUSHJ	PP,NXTINS
	MOVEI	TE,INSTBF##	;GET A REAL END PTR
	MOVEM	TE,BIPTR##	;AND NOW GARBAGE COLLECTOR WILL WORK

; START OUT BY READING IN A BUNCH OF THINGS STARTING AT IPCUR

	MOVEI	IPI,IPCUR##+1	;START HERE
INILUP:	TSWF	FEOF		;EOF SEEN?
	 JRST	DON1RD		;YEP  - AS2 FILE RAN OUT ALREADY!
	PUSHJ	PP,NXTINS	;READ IN NEXT THING
	CAIE	IPI,IPTAB1##-1 ;READ IN ALL WE CAN?
	 AOJA	IPI,INILUP	;NO, LOOP

;FALL INTO DON1RD
DON1RD:	MOVEI	IPI,IPCUR##
	SKIPN	(IPI)		;IS CURRENT INSTR. A ZERO?
	 JRST	CURIS0		;YES--FINISH OUTPUTTING & DONE
CALPM:	PUSHJ	PP,PMATCH	;CALL PMATCH TO TRY AND DELETE
	 CAIA			;IT COULDN'T
	JRST	[MOVEI	IPI,IPCUR-NBACK	;PMATCH DELETED SOMETHING
		JRST	CALPM]	; START AGAIN HALFWAY BACK IN THE
				; OLD BUFFER -- TO CATCH OPTMIZATIONS
				; WHICH MAY NOW BE ENABLED!!
;HERE IF PMATCH FAILED TO DELETE SOMETHING - GO ON
	CAIE	IPI,IPAFT##-1	;TIME TO OUTPUT SOME?
	 AOJA	IPI,CALPM	;NO, LOOP


;OUTPUT NWINDO INSTRUCTIONS FROM THE TOP
	MOVEI	IPI,IPTAB##	;POINT TO THE TOP
CALOUT:	PUSHJ	PP,OUTINS	;OUTPUT THIS GUY
	CAIE	IPI,IPTAB+NWINDO-1 ; DID WE OUTPUT NWINDO THINGS YET?
	 AOJA	IPI,CALOUT	;NO, LOOP

;NOW BLT UP THE TABLE, THEN READ IN SOME MORE AT THE BOTTOM

	MOVE	TA,[IPTAB+NWINDO,,IPTAB]
	MOVEI	TB,IPTAB1##
	SUBI	TB,NWINDO+1
	BLT	TA,(TB)

	HRRZ	TE,IPTAB##	;GET NEW "FIRST WORD WE CAN'T WRITE OVER"
	HRRZM	TE,BIPTR##	;SAVE IN END POINTER

	MOVEI	IPI,IPTAB1-NWINDO

RDMORE:	TSWF	FEOF		;AT EOF?
	 JRST	STRZRO		;YES-- STORE ZEROES
	PUSHJ	PP,NXTINS	;GET ANOTHER
	CAIE	IPI,IPTAB1-1
	 AOJA	IPI,RDMORE
	JRST	DON1RD		;LOOP...

STRZRO:	SETZM	(IPI)		;STORE A ZERO
	CAIE	IPI,IPTAB1-1
	 AOJA	IPI,STRZRO
	JRST	DON1RD


; FINISHED OPTIMIZTIONS - OUTPUT REST OF BUFFER, THEN CALL PHASE F
CURIS0:	MOVEI	IPI,IPTAB##	;POINT TO THE TOP
	PUSHJ	PP,OUTINS	;OUTPUT THIS INSTRUCTION
	CAIE	IPI,IPCUR-1
	 AOJA	IPI,.-2

	MOVEI	TE,INSTBF##+400	;GET A REAL HIGH NUMBER
	HRRZM	TE,BIPTR##	;SO NO MORE GARBAGE COLLECTION HAPPENS
; WE HAVE FINISHED OUTPUTTING THE BUFFER. IF THERE WERE
;LITERALS TO READ IN, DO SO AND OUTPUT THEM

	TSWT	FLIT		;ANY LITERALS?
	 JRST	DONOLT		;NO--FINISH UP
	SWOFF	FEOF		;THEN THIS ISN'T REALLY EOF
	MOVEI	IPI,IPCUR##	;SET IPI TO A RANDOM PLACE

OUTLLP:	PUSHJ	PP,NXTINS	;GET ANOTHER THING
	TSWF	FEOF		;UNTIL EOF
	 JRST	DONOLT		; (THEN OUTPUT EOF)
	PUSHJ	PP,OUTINS	;OUTPUT THE THING
	JRST	OUTLLP		;LOOP

DONOLT:	SETZ	CH,		;OUTPUT A 0 (FOR END-OF-FILE)
	PUSHJ	PP,PUTAS2##

IFE TOPS20,<
	CLOSE	ASY,		;CLOSE INPUT FILE
	CLOSE	AS2,		;CLOSE OUTPUT FILE
>
IFN TOPS20,<
	PUSHJ	PP,RENAS2##	;RENAME AS2 FILE
>
	JRST	CALLF
SUBTTL	NXTINS -  READ IN NEXT INSTRUCTION, PUT IN INSTBF

;ROUTINE TO CALL "GETASY" TO ACTUALLY INPUT THE NEXT AS2FIL ITEM,
; SETUP THE IPTAB ENTRY POINTED TO BY "IPI",
; AND DO PRELIMINARY OPTIMIZATIONS

NXTINS:	TSWF	FEOF		;EOF SEEN?
	 JRST	SBHTHN		;?SHOULDN'T BE HERE, THEN
	SETZM	(IPI)		;CLEAR OLD ENTRY IF ANY
	HRRZ	TA,NXTIP##	; "NEXT" INSTRUCTION LOCATION
	CAIGE	TA,INSEND##-4	;TOO CLOSE TO END OF BUFFER?
	 JRST	NXTINA		;NO
	MOVEI	TA,INSTBF##	;YES - POINT TO START OF BUFFER AGAIN
	MOVEM	TA,NXTIP##
NXTINA:	MOVEM	TA,THISIP##	;SAVE START OF "THIS" ONE
	HRRM	TA,(IPI)	;STORE IN ENTRY, TOO

;CHECK FOR FALLING OFF END OF BUFFER - IF DID, GARBAGE COLLECT
	MOVE	TE,NXTIP##
	CAMLE	TE,BIPTR##	;SKIP IF END IS BEFORE THIS
	 JRST	NXTINB		;NO, ALL OK
	ADDI	TE,3		;AFTER-- DO WE HAVE AT LEAST 3 WORDS FREE?
	CAMLE	TE,BIPTR##
	 PUSHJ	PP,COLLEC	;NO-- GARBAGE COLLECT
NXTINB:	SWOFF	FASA		;CLEAR "ALTERNATE CODE SET" FLAG
	TSWF	FPLTAG		;TIME TO PUT IN "FAKE" TAG?
	 JRST	FAKTAG		;YES--GO DO IT
	JUMPN	CT,MORECT	; JUMP IF WE WERE IN THE MIDDLE OF A BUNCH
				;OF XWDS OR MISC ITEMS
NXTIGT:	PUSHJ	PP,RDA2WD	;READ A WORD
	JUMPE	CH,NXTINE	;EOF
	MOVE	W1,CH		;CHECK IT OUT
	JUMPL	CH,NXTIGM	;JUMP IF NOT AN INSTRUCTION
; WE ARE READING AN INSTRUCTION
	MOVE	TB,W1
	LDB	TE,[POINT 3,W1,20]
	CAIE	TE,6
	CAIN	TE,7
	TLOA	W1,ASINC	;SET INCREMENT FLAG
	TLNE	W1,ASINC	;IF AN INCREMENT
	PUSHJ	PP,RDA2WD	;READ IT
	MOVE	W2,CH		;SAVE IN W2

	PUSHJ	PP,NGETOP	;PUT BITS IN (IPI)
	AOS	NPCIN##		;WE HAVE ANOTHER WORD

	PUSHJ	PP,CHKTP1	;CHECK REF TO TAG+1

	TSWF	FLTAG		;IF WE SAW OUR TAG BEFORE..
	SWON	FPLTAG		;NEXT THING TO DO IS PUT IN FAKE TAG
	POPJ	PP,		;RETURN

; NOT AN INSTRUCTION
NXTIGM:	TSWF	FASA		;BETTER NOT HAVE SEEN ASA JUNK
	 JRST	BADASA		; ? COMPILER ERROR
	LDB	TA,[POINT 3,W1,2] ; GET TYPE OF THING
	JRST	@.+1-4(TA)	;DISPATCH
	EXP	NXBYTE		;A BYTE POINTER
	EXP	NXXWD		;AN XWD
	EXP	NXCONS		;A CONSTANT
	EXP	NXMISC		;MISC.

;HERE IF END-OF-FILE SEEN
NXTINE:	SWON	FEOF		;END OF FILE SEEN
	SETZM	(IPI)		;CLEAR IPTAB ENTRY
	POPJ	PP,		;RETURN
; ITEM WAS A BYTE POINTER

NXBYTE:	PUSHJ	PP,RDA2WD	;GET ANOTHER WORD
	AOS	NPCIN##		;BUMP PC COUNT IN IPTAB
	JRST	CNTDEL

;SET "CAN'T DELETE THIS THING" FOR PMATCH
CNTDH:	SKIPA	TE,[%HDR.]	;SPECIAL HEADER CODE
CNTDEL:	MOVEI	TE,%DATA.
	DPB	TE,IPOP$
	HRRZ	TE,NXTIP##
	SUB	TE,THISIP##
	DPB	TE,IPWC$	;SAVE WORD COUNT
	MOVSI	TE,IP%EXT	;GET "DON'T TOUCH" BIT
	IORM	TE,(IPI)	;SET IT
	POPJ	PP,

;MORE XWDS OR MISC ITEMS TO READ
MORECT:	TSWFZ	FXWDS		;MORE XWDS?
	 JRST	NXXWD1		;YES--GO GET ANOTHER ONE
	TSWFZ	FMISCS		;MORE MISC ITEMS?
	 JRST	NXSPC1		;YES--GO GET ANOTHER ONE
	TSWFZ	FCONS		;MORE CONSTANTS?
	 JRST	NXCONL		;YES--GO GET ANOTHER ONE

	OUTSTR	[ASCIZ/?Can't happen @MORECT+few in COBOLO
/]
	JRST	KILL##

;ITEM WAS AN XWD

NXXWD:	HRRZ	CT,W1		;GET ITEM COUNT (# XWD'S)
NXXWD1:	PUSHJ	PP,RDA2WD	;GET ONE HALF
	PUSHJ	PP,RDA2WD	;GET OTHER HALF
	TSWF	FLTAG
	SWON	FPLTAG
	AOS	NPCIN##		;COUNT WORDS IN IPTAB
	SOJLE	CT,CNTDEL	;JUMP IF NO MORE

	SWON	FXWDS		;REMEMBER THERE ARE MORE XWDS TO READ
	PJRST	CNTDEL		;SET "CAN'T DELETE THIS" & RETURN

;ITEM IS A CONSTANT
NXCONS:	CAMN	W1,[602000,,2]	;CHECK FOR FLOATING PT CONSTANT
	 JRST	NXCON2		;IT TAKES UP 2 WORDS, BUT ONLY 1 PC
	HRRZ	CT,W1		;GET # OF THINGS
NXCONL:	PUSHJ	PP,RDA2WD	;READ THE CONSTANT
	TSWF	FLTAG
	SWON	FPLTAG
	AOS	NPCIN##
	SOJE	CT,CNTDEL	;"CAN'T DELETE THIS"

	SWON	FCONS		;MORE CONSTANTS TO READ
	PJRST	CNTDEL

NXCON2:	PUSHJ	PP,RDA2WD	;READ 2 WORDS
	PUSHJ	PP,RDA2WD
	TSWF	FLTAG
	SWON	FPLTAG
	AOS	NPCIN		;ONLY TAKES UP 1 PC WORD
	PJRST	CNTDEL

;ITEM IS MISC.
NXMISC:	TLNE	W1,ASACS	;ALTERNATE CODE SET?
	 JRST	NXSETA		;YES - SET FLAG
	TLNE	W1,ASTAGN	;A TAG?
	 JRST	NXTAG		;YES
	TLNE	W1,ASSMSC	;SPECIAL MISC?
	 JRST	NXSPCM		;YES
	TLNE	W1,ASREL	;RELOC
	 JRST	NXRELOC		;YES

;IT'S A PARAGRAPH, OR SECTION, OR SOME SUCH
	MOVEI	TE,%PROC.
	DPB	TE,IPOP$
WDCNT1:	MOVEI	TE,1
	DPB	TE,IPWC$	;SAVE WORD COUNT OF 1
	POPJ	PP,		;NO MORE TO READ

;IT'S ALTERNATE CODE SET
NXSETA:	TSWFS	FASA		;SET FLAG, SKIP IF OFF
	JRST	ACSTWC		;ERROR, TWICE IN A ROW
	SOS	NXTIP##		;DON'T PUT ASA WORD IN BUFFER
	JRST	NXTIGT		;GO READ SOME MORE

;IT'S SPECIAL MISC.
NXSPCM:	HRRZ	CT,W1		;HOW MANY ARE THERE
NXSPC1:	PUSHJ	PP,RDA2WD	;GET ONE
	MOVE	W1,CH		;SET IT UP
	HLRZ	W2,CH
	LDB	TD,ADRTYP##
	CAIN	TD,7		;IS IT MISC.?
	 JRST	NXSPC2		;YES
NXSPCD:	TSWF	FLTAG
	SWON	FPLTAG
	AOS	NPCIN##
	SOJLE	CT,CNTDEL	;JUMP IF NO MORE

	SWON	FMISCS		; "MORE MISCS TO READ"
	PJRST	CNTDEL		;SET "CAN'T DELETE" FLAG, RETURN

;MISC THING WITH MISC ADDRESS
NXSPC2:	LDB	TE,MSC.CL##	;WHAT CLASS IS IT?
	SOJN	TE,NXSPCD	;SKIP IF CLASS 1 (SPECIAL VALUES)?
	CAIE	W2,1		;IS "INCREMENT" 1 - "HEADER"?
	 JRST	NXSPCD		;NO-- PROGRAM BASE ADDRESS
	SOJLE	CT,CNTDH	;YES-- GO SET "CAN'T DELETE", DON'T BUMP NPCIN

	OUTSTR	[ASCIZ/?Can't happen @NXSPC2
/]				;SHOULD BE ONLY 1 "HEADER" THING
	JRST	KILL##

;IT'S A RELOC
NXRELOC: TLNN	W1,ASINC	;ANY INCREMENT?
	 JRST	BADRLC		;NO, CAN'T HAPPEN???
	PUSHJ	PP,RDA2WD	;IT HAS TO BE LITERAL BASE...
	CAIE	CH,3B20		;IS THIS THE START OF THE LITERALS
	JRST	BADRLC		;NO

STLIT:	SWON	FLIT!FEOF	;TURN ON LITERAL FLAG, ALSO
				;EOF FLAG SO WE PUT ZEROES IN IPTAB
	JRST	CNTDH		;A "CAN'T TOUCH" FOR THE LITERAL RELOC
SUBTTL	GARBAGE COLLECT ROUTINE

;1) MOVE WORDS TO "GCBUF", FIXING UP IPTAB PTRS AS WE GO
;2) FIXUP NXTIP, THISIP, BIPTR
;3) BLT BUFFER BACK TO "INSTBF"

COLLEC:	MOVEI	TA,1
	DPB	TA,IPWC$	;STORE A FAKE WORD COUNT
	PUSHJ	PP,COLLE1	;DO THE GARBAGE COLLECT
	HRRZ	TE,THISIP##
	MOVEM	TE,(IPI)	;FIXUP CURRENT PTR
	POPJ	PP,

;COLLE1 -  ROUTINE TO DO THE WORK
;THIS ROUTINE CAN BE CALLED TO MOVE EVERYTHING TO WHERE IT SHOULD
; BE.. ALL POINTERS AND WORD COUNTS BETTER BE RIGHT.  IT RETURNS
; .+1 WITH ALL THE INSTRUCTIONS CONTIGUOUS IN INSTBF.
; IPTAB INFORMATION DOESN'T CHANGE (EXCEPT POINTERS TO INSTRUCTIONS)

COLLE1:	MOVEI	TA,0		;TA:= INDEX INTO INSTBF
	PUSH	PP,IPI		;USE IPI FOR PTR TO IPTAB
	MOVEI	IPI,IPTAB##
	SKIPN	(IPI)
	AOJA	IPI,.-1		;GET TO FIRST NON-ZERO WORD

COLLEA:	HRRZ	TE,(IPI)	;GET PTR TO WORDS FOR THIS ENTRY
	MOVEI	TC,INSTBF(TA)	;NEW PTR TO THIS GUY
	HRRM	TC,(IPI)	;STORE NEW PTR IN ENTRY
	LDB	TC,IPWC$	;TC:= WORD COUNT
	JRST	@.(TC)		;DISPATCH ON WORD COUNT
	EXP	COLL1W
	EXP	COLL2W
	EXP	COLL3W

COLL1W:	MOVE	TB,(TE)
	MOVEM	TB,GCBUF##(TA)
	JRST	UPDCOL
COLL2W:	MOVE	TB,(TE)
	MOVEM	TB,GCBUF(TA)
	MOVE	TB,1(TE)
	MOVEM	TB,GCBUF+1(TA)
	JRST	UPDCOL
COLL3W:	MOVE	TB,(TE)
	MOVEM	TB,GCBUF(TA)
	MOVE	TB,1(TE)
	MOVEM	TB,GCBUF+1(TA)
	MOVE	TB,2(TE)
	MOVEM	TB,GCBUF+2(TA)
UPDCOL:	ADD	TA,TC		;UPDATE PTR
	SKIPE	1(IPI)		;CONTINUE TILL 0 WORD APPEARS
	AOJA	IPI,COLLEA	;LOOP

	MOVEI	TE,INSTBF(TA)	;GET NEW NXTIP
	MOVEM	TE,NXTIP##
	MOVEM	TE,THISIP##
	MOVEI	TE,INSTBF##
	MOVEM	TE,BIPTR##	;STORE NEW BIPTR

	MOVE	TE,[GCBUF,,INSTBF]
	BLT	TE,INSTBF+GCLEN-1 ; BLT UP BUFFER
	POP	PP,IPI		;RESTORE CURRENT IPI POINTER
	POPJ	PP,		;DONE GARBAGE COLLECT
SUBTTL	ADDWD - ADD A WORD TO AN INSTRUCTION

;ROUTINE TO FIXUP BUFFER TO ALLOW PMATCH TO PUT AN INCREMENT ON AN
; INSTRUCTION.
;CALL: TA POINTS TO IPTAB ENTRY OF THE INSTRUCTION
;	PUSHJ PP,ADDWD
;	<RETURN HERE> ; CONTENTS OF THE NEW WORD IS JUNK

ADDWD:	LDB	TB,TAWC$	;GET WORD COUNT NOW
	CAIE	TB,1
	 JRST	E$ADD		;?NOT 1 - WE SHOULDN'T BE HERE
	MOVEI	TB,2		;SET IT TO 2
	DPB	TB,TAWC$
	PJRST	COLLE1		;CALL COLLECT ROUTINE, THEN RETURN
SUBTTL	"COMING IN" OPTIMIZATIONS

COMMENT \
		TAG FIXUPS

  WHEN THE "SEARCH ALL..." OPTION IS USED, THE COMPILER GENERATES
REFERENCES TO "TAG+1", AS IN:

	JUMPE	%2+1
	<CODE>
%2:	<INSTRUCTION>
	...

  IN ORDER TO MAKE LIFE EASIER FOR THE PMATCH ROUTINE, THE FOLLOWING
"OPTIMIZATION" IS PERFORMED AS THE INSTRUCTIONS ARE ACTUALLY READ IN FROM
THE ASY FILE:
  WHEN A REFERENCE TO "TAG+1" IS SEEN, COBOLO CREATES A NEW TAG, AND CHANGES
THE REFERENCE TO "NEWTAG". THEN, WHEN "TAG:" APPEARS IN THE ASY FILE, COBOLO
WAITS UNTIL THE NEXT INSTRUCTION, THEN INSERTS THE TAG "NEWTAG", AS IF IT
WERE OUTPUT BY PHASE E.
  REFERENCE COUNTS WORK THE SAME AS USUAL FOR THESE NEW TAGS.
  AFTER THE NEW TAG HAS BEEN INSERTED, WE KNOW THAT NO MORE REFS TO
%OLDTAG+1 WILL BE IN THE CODE. THEN, THE TAGTAB ENTRIES ARE FIXED UP
TO LOOK LIKE THE TAGS ARE ALL "REAL" TAGS.
\

;HERE WHEN A "TAG:" IS INPUT
NXTAG:	HRRZ	TC,W1		;IS THIS THE TAG WE WANT?
	CAMN	TC,WANTG1##
	SWON	FLTAG		;YES--SET FLAG
NXTAGA:	MOVEI	TE,%TAG.
	DPB	TE,IPOP$	;SET OPCODE FIELD TO BE "TAG"
	PJRST	WDCNT1		;SET WORD COUNT TO 1, RETURN FROM "NXTINS"

;HERE WHEN IT'S TIME TO INSERT A "FAKE" TAG
FAKTAG:	SWOFF	FLTAG!FPLTAG	;CLEAR FLAGS

;WE HAVE PUT IT IN TAGTAG BEFORE -- NOW FIND IT

	MOVE	TA,TAGLOC##	;GET START OF TAG TABLE

GETFTB:	MOVE	TB,(TA)		;GET A TAG
	TLNE	TB,(1B1)	;IS THIS A "TAG+1"?
	 JRST	GETFTC		;YES-- SEE IF IT'S THE RIGHT ONE
GETFT1:	AOBJN	TA,GETFTB	;LOOP

	OUTSTR	[ASCIZ/?Couldn't find TAG @GETFT1
/]
	JRST	KILL##
GETFTC:	HRRZ	TC,WANTG1##	;GET TAG # WE WANT
	ANDI	TC,77777
	CAIE	TC,(TB)		;THIS THE ONE?
	 JRST	GETFT1		;NO, CONTINUE SEARCH

	SETZM	WANTG1##	;CLEAR UNTIL NEXT TIME
	MOVE	CH,[720000,,AS.TAG] ; GET CODE FOR TAG
	HRRZ	TB,TAGLOC##
	HRRZ	TC,TA
	SUB	TC,TB		;GET TAG NUMBER
	IORI	CH,(TC)
	PUSHJ	PP,RED2WW	;PRETEND IT WAS JUST READ IN

;FIXUP TAGTAB ENTRIES
	ADD	TC,TAGLOC	;POINT TO NEW TAG
	MOVE	TB,(TC)
	TLZ	TB,(1B1)	;CLEAR "TAG HAS SAME VALUE AS OLDTAG+1"
	MOVEM	TB,(TC)		;PUT BACK ENTRY
	HRRZ	TA,TB		;WHERE WAS THE OLD ENTRY?
	ADD	TA,TAGLOC
	MOVE	TB,(TA)
	TLZ	TB,(1B2)	;CLEAR "TAG HAS A 'TAG+1' ENTRY"
	MOVEM	TB,(TA)		;*** TAGTAB FIXUPS DONE ***
	PJRST	NXTAGA		; AND FINISH UP

;CHECK FOR REFERENCE TO %NN+1, IF SO, CHANGE IT TO %MM ( A NEW TAG )
; AND STORE AS.TAG+NN IN WANTG1
CHKTP1:	HRRZ	TA,THISIP##	;TA= PTR TO START OF INSTRUCTION
	MOVE	TB,(TA)		;GET FIRST WORD
	TRC	TB,AS.TAG	;DOES IT SMELL LIKE A TAG?
	TRNN	TB,700000	; (AND ONLY A TAG)
	TLNN	TB,ASINC	;YES, AN INCREMENT?
	  POPJ	PP,		;NO, JUST A NORMAL TAG REF
	MOVE	TC,1(TA)	;GET NEXT WORD THEN
	CAIE	TC,1		;SKIP IF A 1
	 JRST	BADTIN		;?BAD TAG INCREMENT!!

;FOUND ONE!
	PUSH	PP,TA
	HRRZ	TA,TB
	ANDI	TA,77777	;GET TAG NUMBER
	PUSHJ	PP,DRFTAG##	;UNREFERENCE THE TAG
	 JFCL			;DON'T CARE IF IT REACHED 0
	POP	PP,TA
	HRRZ	TE,TB
	ADD	TE,TAGLOC##	;TE= INDEX INTO TAGTAB
	MOVE	TC,(TE)		;GET TAGTAB WORD
	TLOE	TC,(1B2)	;DOES AN ENTRY ALREADY EXIST?
	 JRST	GOFINT		;YES-- GO FIND IT

;IF THIS IS NOT A FORWARD REFERENCE, FORGET IT
	HRRZ	TD,NPCIN##
	ADD	TD,PC		;WHERE I AM NOW
	ADD	TD,INDELC##	;PLUS # DELETED SO FAR
	CAIL	TD,(TC)		;SKIP IF WE ARE BEFORE WHERE TAG IS
	 POPJ	PP,		;NO-- FORGET IT

	MOVEM	TC,(TE)		;SAVE NEW ENTRY FOR OLD TAG
	SKIPE	WANTG1##	;THIS BETTER BE 0
	 JRST	BADWG1		; ?UH OH, A CASE WE DIDN'T PLAN FOR!
	HRRZ	TB,(TA)		;REGET "TAG" WORD
	HRRZM	TB,WANTG1##	;SAVE TAG TO LOOK FOR
	ANDI	TB,77777	;MAKE TB= OLD TAG NUMBER

;MAKE A NEW TAG
	PUSHJ	PP,GETTAG##	;GET A TAG NUMBER
				;NOTE: SHOULDN'T USE ANY AC'S EXCEPT CH
	ANDI	CH,77777
	ADD	CH,TAGLOC##	;GET AT NEW TAGTAB ENTRY
	MOVSI	TC,200001	;1B1+ REF. COUNT,,0
	HRR	TC,TB		; RH = OLD TAG NUMBER
	MOVEM	TC,(CH)		;STORE ENTRY
	JRST	DONTEN		; THAT'S ALL, FOLKS

;HERE TO FIND ENTRY IN TAGTAB AND UPDATE REFERENCE COUNT
GOFINT:	MOVEM	TC,(TE)		;STORE NEW "OLD" ENTRY
	MOVE	CH,TAGLOC##	;-LEN,,TAGTAB
	ANDI	TB,77777	;TB = OLD TAG NUMBER
GOFIN1:	MOVE	TD,(CH)		;GET A TAG ENTRY
	TLNE	TD,(1B1)	; IS THIS A %TAG+1 ENTRY?
	 JRST	GOFIN3		;YES--CHECK IT OUT
GOFIN2:	AOBJN	CH,GOFIN1	;LOOP

	OUTSTR	[ASCIZ/?Couldn't find TAG @GOFIN2
/]
	JRST	KILL##

GOFIN3:	CAIE	TB,(TD)		;IS THIS THE TAG WE WANT?
	 JRST	GOFIN2		;NO, LOOP
	MOVSI	TB,1
	ADDM	TB,(CH)		;UPDATE REFERENCE COUNT

;HERE WITH CH POINTING TO THE NEW ENTRY
DONTEN:	HRRZ	CH,CH
	HRRZ	TB,TAGLOC##
	SUB	CH,TB		;CH= TAG # OF NEW TAG
	MOVE	TB,(TA)		;GET REF
	TLZ	TB,ASINC	; TURN OFF INCR. FLAG
	DPB	CH,[POINT 15,TB,35] ;REFERENCE NEW TAG
	MOVEM	TB,(TA)		;AND SAVE THIS IN INSTRUCTION
	LDB	TA,IPWC$	; UPDATE WORD COUNT OF INSTRUCTION
	SOJ	TA,
	DPB	TA,IPWC$
	SOS	NXTIP##		; LET NEXT INST. START WHERE THE INCR WAS
	POPJ	PP,		;THEN RETURN
SUBTTL	NGETOP - SET IPTAG BITS FOR INSTRUCTION

;SET THE VARIOUS BITS IN IPTAB, INCLUDING IPWC$
NGETOP:	LDB	TA,ASOP##	;GET OPERATOR
	TSWF	FASA		;IN ALTERNATE CODE SET?
	ADDI	TA,200		;YES--GET TABLE INDEX
	CAIN	TA,JRST.	;IF JRST .+2, CHANGE TO "SKIPA"
	 JRST	CHKDT2
NGETO1:	DPB	TA,IPOP$	;STORE IN ENTRY
	LDB	TE,[POINT 4,W1,12] ;GET AC FIELD FROM W1
	DPB	TE,IPAC$	;STORE IN CORRECT PLACE
	HRRZ	TE,NXTIP##	;GET WORD COUNT
	SUB	TE,THISIP##
	DPB	TE,IPWC$	;STORE IN IPTAB ENTRY

;CHECK FOR "PUSHJ PP,LIBOL-ROUTINE"
; AND THEN SEE IF IT SKIPS 1 OR 2
	TSWF	FASA		;SKIP IF NOT ALTERNATE
	 JRST	NGETP1		; NOT A PUSHJ
	HLRZ	TE,W1		;GET RH
	CAIE	TE,EPJPP	; "PUSHJ PP,"?
	 JRST	NGETP1		;NO
	HRRZ	TE,W1		;GET ADDRESS IN RH (TE)
	CAIN	TE,CVTDB.##	; POPULAR CONVERSION ROUTINE?
	 JRST	CNVRT		; YES-- TURN OPCODE INTO SPECIAL THINGY
	MOVSI	TD,-NUMEX1	;-NUMBER OF EXTAB1 ENTRIES,,0
CHKPJ1:	CAME	TE,PJEXT1(TD)	;THIS ONE?
	 JRST	NOPJ1		;NO

YESPJ1:	MOVEI	TE,1
	DPB	TE,IPSK1$
	POPJ	PP,

PJEXT1:	EXP	PERF%##		;LIBOL ROUTINES THAT HAVE 2 RETURNS
	EXP	POS%6##
	EXP	POS%7##
	EXP	POS%9##
	EXP	NEG%6##
	EXP	NEG%7##
	EXP	NEG%9##
	EXP	NUM%3##
	EXP	NUM%6##
	EXP	NUM%7##
	EXP	NUM%9##
	EXP	READ%##
	EXP	STR.O##
	EXP	UNS.O##
	EXP	LRENQ.##
	EXP	LRDEQ.##
	EXP	RETRN.##
	EXP	RDNXT%##
	EXP	C.STRT##
	EXP	CMP%E##
	EXP	CMP%G##
	EXP	CMP%GE##
	EXP	CMP%L##
	EXP	CMP%LE##
	EXP	CMP%N##
	EXP	LIN.RH##
	EXP	SWT.ON##
	EXP	SWT.OF##
NUMEX1==.-PJEXT1

NOPJ1:	AOBJN	TD,CHKPJ1
	MOVSI	TD,-NUMEX2	;-NUMBER OF EXTAB ENTRIES,,0
CHKPJ2:	CAMN	TE,PJEXT2(TD)	;THIS ONE?
	 JRST	YESPJ2		;YES-- SET FLAG
	AOBJN	TD,CHKPJ2
	POPJ	PP,		;NOT ONE OF THE SKIP ROUTINES

YESPJ2:	MOVEI	TE,1
	DPB	TE,IPSK1$
	DPB	TE,IPSK2$
	POPJ	PP,

PJEXT2:	EXP	COMP%##		;LIBOL ROUTINES THAT HAVE 3 RETURNS
	EXP	CMP%76##
	EXP	CMP%96##
	EXP	CMP%97##
	EXP	WRITE%##
	EXP	RERIT%##
	EXP	DELET%##
	EXP	CMP.67##	;[1004]
	EXP	CMP.69##	;[1004]
	EXP	CMP.79##	;[1004]
	EXP	COMP.6##	;[1004]
	EXP	COMP.7##	;[1004]
	EXP	COMP.9##	;[1004]
NUMEX2==.-PJEXT2

NGETP1:	LDB	TE,ASKIP$	;GET "ALWAYS SKIPS" FLAG
	DPB	TE,IPSKA$	;PUT IN IPTAB FIELD
	LDB	TE,CSKIP$	;CONDITIONAL SKIP FLAG
	DPB	TE,IPSK1$	;SET FLAG IN ENTRY
	POPJ	PP,

;HERE TO TURN ON "%CNVD." FOR "PUSHJ PP,CNVDB."
CNVRT:	MOVEI	TE,%CNVD.	;GET THE OPCODE TO STORE
	DPB	TE,IPOP$
	POPJ	PP,

;"JRST" SEEN - IF "JRST .+2", CHANGE TO "SKIPA"
CHKDT2:	TLNE	W1,ASINC	;INCREMENT FLAG ON?
	CAIE	W2,AS.DOT+2	;.+2?
	 JRST	NGETO1		;NO, NOT JRST .+2
	HRRZ	TB,W1
	CAIE	TB,AS.MSC	;MAKE SURE +2 NOT -2
	 JRST	NGETO1

;CHANGE TO SKIPA
	MOVEI	TA,SKIPA.
IFGE <SKIPA.-200>,< SWON FASA	;SET FASA IF SKIPA IN 2ND SET
	MOVEI	TB,-200(TA)	;GET REAL OPCODE TO STORE
>
IFL <SKIPA.-200>,< SWOFF FASA	;SKIPA IN 1ST CODE SET- FASA SHOULD BE OFF..
	MOVEI 	TB,(TA)		;GET OPCODE
>
	HRLZ	W1,TB
	LSH	W1,9		;SHIFT OPCODE TO CORRECT PLACE
	SETZ	W2,		;NO INCREMENT
	HRRZ	TB,THISIP##	;GET START LOCATION OF THE INSTRUCTION
	MOVEM	W1,(TB)		;STORE THE WORD
	SOS	NXTIP##		;ONLY TAKES ONE WORD, NOT 2
	JRST	NGETO1		;GO STORE BITS FOR IT
SUBTTL	DELINS - DELETE AN INSTRUCTION
;ENTER WITH TA POINTING TO THE IPTAB ENTRY TO DELETE
;
;THIS ROUTINE WILL CALL NXTINS TO KEEP A FULL IPTAB

DELINS:	LDB	TB,TAOP$	;GET OPCODE FIELD
	CAIN	TB,%TAG.	;DELETING A TAG?
	 AOSA	TAGDLC##	;YES--BUMP COUNTER
	AOS	INDELC##	;NO-- UPDATE INSTRUCTION DELETE COUNTER
	MOVE	TB,(TA)		;GET ENTRY TO DELETE

	LDB	TB,[IP$OP TB]	;GET OPCODE
	CAIE	TB,%TAG.	;TAGS DON'T TAKE UP A PC
	SOS	NPCIN##		;BUT EVERYTHING ELSE THAT'S DELETEABLE DOES

NODEPC:	HRLI	TB,1(TA)	;"FROM"
	HRR	TB,TA		;" TO"
	BLT	TB,IPTAB1##-1	;MOVE UP EVERYBODY BELOW IT

;GET ANOTHER GUY
	TSWF	FEOF		;AT THE END OF OUR ROPE?
	 JRST	DELINZ		;YES--STORE A ZERO
	PUSH	PP,IPI		;SAVE THE POINTER
	MOVEI	IPI,IPTAB1##-1	;READ INTO HERE
	PUSHJ	PP,NXTINS
	POP	PP,IPI		;RESTORE POINTER
	POPJ	PP,		;AND RETURN TO PMATCH

DELINZ:	SETZM	IPTAB1##-1	;MAKE SURE ENTRY IS A 0
	POPJ	PP,		;RETURN
SUBTTL	OUTINS - OUTPUT INSTRUCTION FROM (IPI)

;ROUTINE TO OUTPUT INSTRUCTION (OR WHATEVER) THAT IS POINTED TO BY IPI
; PUT IN PC IF TAG OR PARAGRAPH NAME IS DEFINED, THEN UPDATE PC

OUTINS:	SKIPN	TA,(IPI)	;IS IT 0?
	  JRST	OUTIND		;YES, DON'T OUTPUT ANYTHING
	LDB	TB,IPOP$	;GET OPCODE FIELD
	CAIL	TB,%CNVD.	;SKIP IF AN "ORDINARY" INSTRUCTION
	 JRST	SPECIL		;SOMETHING SPECIAL, USE TABLE DISPATCH
	CAIN	TB,SKIPA.	;IS IT "SKIPA"?
	 JRST	OUTSKA		;YES-- CHANGE TO JRST .+2 IF SKIPA AC IS 0

;A NORMAL INSTRUCTION
OUTNRM:	MOVSI	CH,701000	;GET AN ASA WORD
	CAIL	TB,200		;IF OPCODE IS IN ALT CODE SET
	PUSHJ	PP,PUTAS2##	;PUT IT OUT

; WE HAVE A DATUM. ASSUME PC WILL BE UPDATED BY 1, AND # WORDS TO
; OUTPUT MAY BE 0
OUTINA:	LDB	TB,IPWC$	;GET # WORDS TO OUTPUT
OUTINL:	SOJL	TB,OUTINN	;JUMP WHEN DONE TO UPDATE PC
	MOVE	CH,(TA)		;GET A WORD FROM INSTBF
	PUSHJ	PP,PUTAS2##	;OUTPUT IT
	AOJA	TA,OUTINL	;LOOP



;CONT'D
;OUTINS ROUTINE (CONT'D)

;HERE FOR "SPECIAL" DISPATCH

SPECIL:	MOVEI	TC,400
	SUB	TC,TB
	JRST	@.(TC)
	EXP	OUTINT		;TAG
	EXP	OUTINP		;PROC
	EXP	OUTDTC		;HDR
	EXP	OUTINA		;DATA
	EXP	OUTINA		;CVTD

;HERE TO OUTPUT A TAG
OUTINT:	HRRZ	TB,(TA)		;GET TAG
	ANDI	TB,77777
	ADD	TB,TAGLOC##
	MOVE	TC,(TB)		;GET THE ENTRY
	TLNN	TC,(1B0)	;IS RH = ANOTHER TAG?
	HRRM	PC,(TB)		;NO, STORE PC
OUTIN3:	MOVE	CH,(TA)		;GET THE WORD TO OUTPUT
	PUSHJ	PP,PUTAS2##
	JRST	OUTIND		;THEN WE'RE DONE

;HERE TO OUTPUT A PARAGRAPH NAME
OUTINP:	MOVE	TB,(TA)		;GET THE WORD
	HRRZ	DT,TB
	ANDI	DT,77777
	TLNE	TB,ASENTN	;ENTRY?
	 JRST	OUTIP1		;YES--IF 1ST ONE, FIXUP "PRGENT"
	ADD	DT,PROLOC##	;GET DT=INDEX INTO PROTAB
	HRRM	PC,1(DT)	;STORE PC
	JRST	OUTIN3		;THEN OUTPUT IT

;HERE TO OUTPUT AN ENTRY POINT
; NOTE: PC IS FIXUP UP IN COBOLG @MISENT. HOWEVER,
;WE MUST STORE THE REAL PC OF THE MAIN ENTRY POINT.

OUTIP1:	SKIPE	SAWENT##	;DID WE SEE 1ST ENTRY POINT ?
	 JRST	OUTIN3		;YES, DON'T DO THIS
	SETOM	SAWENT##	;REMEMBER WE SAW IT
	HRRZM	PC,PRGENT##	;SAVE "MAIN ENTRY POINT" OF PROGRAM
	JRST	OUTIN3		;AND CONTINUE

;HERE WHEN IT'S HEADER CODE
OUTDTC:	LDB	TB,IPWC$	;GET # WORDS TO OUTPUT
OUTDTL:	SOJL	TB,OUTIND	;DON'T UPDATE PC WHEN DONE
	MOVE	CH,(TA)
	PUSHJ	PP,PUTAS2##
	AOJA	TA,OUTDTL

OUTINN:	AOJ	PC,		;UPDATE PC
	SOSGE	NPCIN##		;1 LESS PC IN CORE NOW
	 JRST	BADNPC		;? COUNT BECAME NEGATIVE!
OUTIND:	POPJ	PP,


OUTSKA:	LDB	TC,IPAC$	;GET AC FIELD OF SKIPA
	JUMPN	TC,OUTNRM	; NON-ZERO, LEAVE AS IS
;OUTPUT "JRST .+2"
IFGE <JRST.-200>,< MOVSI CH,701000 ;IF IN 2ND CODE SET, PUT OUT ASA WORD
	PUSHJ	PP,PUTAS2##
	MOVSI	CH,JRST.-200
>
IFL <JRST.-200>, MOVSI CH,JRST.	;1ST CODE SET
	LSH	CH,9		;SHIFT TO REAL OPCODE FIELD
	TLO	CH,ASINC	;TURN ON ASINC
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTAS2##	;PUT OUT 1ST WORD
	MOVEI	CH,AS.DOT+2
	PUSHJ	PP,PUTAS2##	;PUT OUT INCREMENT WORD
	JRST	OUTINN		;THEN GO UPDATE PC & RETURN
SUBTTL	RDA2WD - READ IN A WORD FROM AS2FIL, PUT IT IN INSTBF

RDA2WD:	PUSHJ	PP,GETASY##	;CALL GETASY TO READ IT IN
RED2WW:	AOS	TA,NXTIP##	;GET NEXT POINTER
	MOVEM	CH,-1(TA)	;SAVE CURRENT WORD
	POPJ	PP,		;AND RETURN
SUBTTL	ERRORS

;HERE IF PUTASA CODE WORD SET TWICE IN A ROW

ACSTWC:	OUTSTR	[ASCIZ/?Alternate code set flag twice in a row
/]
	JRST	KILL##		;BAD COMPILER!

BADRLC:	OUTSTR	[ASCIZ/?Unexpected reloc in AS2 file
/]
	JRST	KILL##		;I DON'T THINK THIS CAN HAPPEN...

;HERE FROM NXTINS IF "FEOF" WAS SET ON ENTRY

SBHTHN:	OUTSTR	[ASCIZ/?Bad call to NXTINS
/]
	JRST	KILL##

;HERE FROM NXTINS IF ASYFIL THING WAS NOT AN INSTRUCTION, BUT WE HAD
; SET "FASA".

BADASA:	OUTSTR	[ASCIZ/?ASA word seen before a non-instruction in AS2FIL
/]
	JRST	KILL##

;HERE IF TAG INCREMENT WAS NOT 1
BADTIN:	OUTSTR	[ASCIZ/?TAG increment not 1
/]
	JRST	KILL##

;HERE IF WE GOT RID OF %OLDTAG+1 REFERENCE, SUBTRACTED ONE FROM %OLDTAG
; REFERENCE COUNT, AND THE COUNT BECAME NEGATIVE (I.E., PROBABLY PHASE E
; DIDN'T COUNT THE REFERENCES CORRECTLY)

BADRFC:	OUTSTR	[ASCIZ/?Bad reference count for OLDTAG
/]
	JRST	KILL##

;HERE IF WE SAW A REFERENCE TO %TAGA+1, THEN A REFERENCE TO %TAGB+1
; BEFORE SEEING "%TAGA:".  TO IMPLEMENT THIS, WE WOULD HAVE TO LOOK
; FOR MORE THAN ONE TAG AT ONCE, SO GIVE UP

BADWG1:	OUTSTR	[ASCIZ/?Unexpected increnented TAG reference
/]
	JRST	KILL##

;HERE IF WE LOST TRACK OF NUMBER OF PC'S IN CORE
BADNPC:	OUTSTR	[ASCIZ/?NPCIN became negative
/]
	JRST	KILL##

E$ADD:	OUTSTR	[ASCIZ/?ADDWD called when word count not = 1
/]
	JRST	KILL##
;SOME RECOVERABLE ERRORS

DEFINE OERR (ERRTXT),<
	JSP	TE,OERR$
	ASCIZ /ERRTXT/
>;END OERR DEFINITION

IFE TOPS20,<
CNTENT:	OERR	<Can't ENTER AS2FIL>
>

OERR$:
IFE TOPS20,<
	OUTSTR	[ASCIZ/?Optimizer aborted - /]
	OUTSTR	(TE)		;TYPE REASON
>
IFN TOPS20,<
	PUSH	PP,T1
	HRROI	T1,[ASCIZ/?Optimizer aborted - /]
	PSOUT%
	HRRO	T1,TE		;TYPE REASON
	PSOUT%
	POP	PP,T1
>
	JRST	CALLF		;GO CALL PHASE F


; THERE WERE PROGRAM ERRORS. OPTIMIZATION IS USELESS, BECAUSE CODE
;CAN'T BE EXECUTED.

BYPASS:	OUTSTR	[ASCIZ/[Optimizer bypassed - program errors]
/]
	JRST	CALLF
SUBTTL	CALL PHASE F

; HERE TO CALL PHASE F

CALLF:	MOVE	TE,NONRES##	;GET START OF "NON-RES" CODE
	SUB	TE,INDELC##	;UPDATE IT
	MOVEM	TE,NONRES##
	MOVE	TE,EAS2PC##	;ALSO PRETEND PHASE E ONLY OUTPUT THE
	SUB	TE,INDELC##	;NUMBER OF THINGS WE NOW HAVE IN AS2FIL
	MOVEM	TE,EAS2PC##
IFN TOPS20,<
	MOVE	TE,SAV1JF	;GET TRUE AS1 JFN
	MOVEM	TE,AS1JFN	;RESTORE IT
>
	ENDFAZ	O;		;*** END OF PHASE O ***
	JRST	COBOLF##	;GO TO PHASE F

END	COBOLO