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