!                                                                   foplist1
! 07/11/86 - insert include files
!                                                                   ftnoplist5
! 14/09/86 - allow to function if opt2 only
!                                                                   ftnoplist4
! 06/08/86 - correct mask for intrinsic fns
!                                                                   ftnoplist3
! 05/07/86 - generate for CVT if also assignment (complex)
! 20/02/86 - comment out code at SW(LE) & SW(JIF) IN FORMLINE
! 13/12/85 - copied from oplistb48
!          - new SW(GLALIT) at SW(STKLIT) in GEN (from oplistp46)
!          - new include files incorporated
! 22/10/84 - coorection to OUTPUTTEXT for continuation lines in OPT4
! 15/10/84 - define external routine RESET OPLIST
! 09/10/84 - change OUTPUTLINE to print global line number LINES
! 18/09/84 - insert switch for STFNID in GEN and delete array QUAL
! 24/07/84 set OPSYS 0
! 23/07/84 amend SW(CGT) in FORMLINE to print private labels
! 10/07/84 new version of targetpnx_fptos
! 05/07/84 insert switch SW(INTRIN) in FORMLINE
! 03/07/84 make FPTOS a string function & put in an include file
!          set up string REG1 in targ_target & substitute for "reg-1"
!          remove OPVALS for LOADB & STOREB
!          define INTRINFNS to output new INTRIN fns
! 21/03/84 amend arrays SW, RTOL, ENDS, OPVALS. Delete ST & SZTY & REG
! 19/03/84 add in ADICT on calls to FPTOS
! 08/03/84 change INTEGER mapping increments to W1 etc.
! 28/02/84 FPTOS inserted
! 01/10/1/83 copied from ERCS06.REL90_OPLISTB36
!*
%CONSTINTEGER OPSYS=0
!   =0  (Emas ISO)
!   =1  (VME  EBCDIC)
!*
%INCLUDE "ftn_ht"
!*
{%INCLUDE "ftn_consts1"}
!* modified 10/10/85
!*
!*
%if HOST = PERQPNX %thenstart
!*
   %constinteger WSCALE = 1;! scale word address to byte address
   %constinteger BSCALE = 1;! scaling factor for words to architectural units
   %constinteger CSCALE = 1;! byte offset to architectural unit offset
   %constinteger DSCALE = 1;! dict pointer scaling in RES records
!*
   %constinteger W1 = 2 ;!  1 word  in architectural units
   %constinteger W2 = 4 ;!  2 words in architectural units
   %constinteger W3 = 6 ;!  3 words in architectural units
   %constinteger W4 = 8 ;!  4 words in architectural units
!*
   %constinteger TRIADLENGTH    =  6 ;! size of an individual triad
   %constinteger BLRECSIZE      = 22 ;! size of a block table entry in architectural units
   %constinteger LOOPRECSIZE    =  8 ;! size of a loop table entry
   %constinteger PROPRECSIZE    =  6 ;! size of a propagation table entry
   %constinteger CLOOPSZ        =  6 ;! size of cloop table entry
   %constinteger FRSIZE         =  4 ;! size of freelist created by PUSHFREE
   %constinteger TESZ           = 10
   %constinteger DTSZ           = 10
   %constinteger ARTICSZ        =  2
   %constinteger CTSIZE         =  1 ;! used in OP3
   %constinteger EXTNSIZE       =  2 ;! used in OP3
!*
!* following used in strength reduction
!*
   %constinteger RDSZ           =  4
   %constinteger RUSESZ         =  6
   %constinteger RTESTSZ        =  2
   %constinteger RDEFSZ         =  8
   %constinteger USESZ          = 16
   %constinteger SRUSESZ        =  1
   %constinteger SRSCALE        =  1;! SR==RECORD(ABLOCKS + SRPTR<<SRSCALE)
   %constinteger SRFIXED        = 18
!*
%finishelsestart;! all except PNX
!*
   %constinteger WSCALE = 2;! scale word address to byte address
   %constinteger BSCALE = 0;! scaling factor for words to architectural units
   %constinteger CSCALE = 0;! byte offset to architectural unit offset
   %constinteger DSCALE = 2;! dict pointer scaling in RES records
!*
   %constinteger W1 =  4 ;!  1 word  in architectural units
   %constinteger W2 =  8 ;!  2 words in architectural units
   %constinteger W3 = 12 ;!  3 words in architectural units
   %constinteger W4 = 16 ;!  4 words in architectural units
!*
   %constinteger TRIADLENGTH    = 12 ;! size of an individual triad
   %constinteger BLRECSIZE      = 44 ;! size of a block table entry in architectural units
   %constinteger LOOPRECSIZE    = 16 ;! size of a loop table entry
   %constinteger PROPRECSIZE    = 12 ;! size of a propagation table entry
   %constinteger CLOOPSZ        = 12 ;! size of cloop table entry
   %constinteger FRSIZE         =  8 ;! size of freelist created by PUSHFREE
   %constinteger TESZ           = 20
   %constinteger DTSZ           = 20
   %constinteger ARTICSZ        =  4
   %constinteger CTSIZE         =  2 ;! used in OP3
   %constinteger EXTNSIZE       =  4 ;! used in OP3
!*
!* following used in strength reduction
!*
   %constinteger RDSZ           =  8
   %constinteger RUSESZ         = 12
   %constinteger RTESTSZ        =  4
   %constinteger RDEFSZ         = 16
   %constinteger USESZ          = 32
   %constinteger SRUSESZ        =  2
   %constinteger SRSCALE        =  2;! SR==RECORD(ABLOCKS + SRPTR<<SRSCALE)
   %constinteger SRFIXED        = 36
!*
%finish
!*
%conststring(5) REG1="reg7"
%constinteger GLAOFFSET=32
%constinteger DVAREA=7
!*
!***********************************************************************
!* Constants defining the size of DICT records                         *
!***********************************************************************
!*
   %constinteger IDRECSIZE    = 28;! size of dict entry reserved for a new identifier
   %constinteger CONRECSIZE   = 16
   %constinteger CNSTRECMIN   =  4
   %constinteger IMPDORECSIZE = 12;! size of DATA-implied-DO list item
   %constinteger LABRECSIZE   = 40
   %constinteger PLABRECSIZE  =  8;! N.B. this is a reduced size for compiler using Put interfaces
   %constinteger XREFSIZE     =  8
   %constinteger CMNRECEXT    = 16;! extra space on iden record for common block name
   %constinteger TMPRECSIZE   = 20
   %constinteger DVRECSIZE    = 28
   %constinteger TRIADSIZE    = 12
   %constinteger LBLKSIZE     = 520
!*
!*
!********************* TRIAD qualifiers ********************************
!*
%CONSTINTEGER NULL    = 0
%CONSTINTEGER LABID   = 1
%CONSTINTEGER PLABID  = 2
%CONSTINTEGER PROCID  = 3
%CONSTINTEGER STKLIT  = 4
%CONSTINTEGER GLALIT  = 5
%CONSTINTEGER SRTEMP  = 6
%CONSTINTEGER BREG    = 7
%CONSTINTEGER VALTEMP = 8
%CONSTINTEGER DESTEMP = 9
%CONSTINTEGER LSCALID =16
%CONSTINTEGER OSCALID =17
%CONSTINTEGER CSCALID =18
%CONSTINTEGER ASCALID =19
%CONSTINTEGER PSCALID =20
%CONSTINTEGER ARRID   =21
%CONSTINTEGER TMPID   =22
%CONSTINTEGER PERMID  =23
%CONSTINTEGER STFNID  =24
%CONSTINTEGER ITMPID  =22
%CONSTINTEGER RTMPID  =22
%CONSTINTEGER ETMPID  =22
%CONSTINTEGER TRIAD   =32
%CONSTINTEGER ARREL   =33
%CONSTINTEGER CHAREL  =34
%CONSTINTEGER CHVAL   =35
%CONSTINTEGER LIT     =64
%CONSTINTEGER NEGLIT  =65
%CONSTINTEGER CNSTID  =66
!*
!********************* TRIAD masks *************************************
!*
%CONSTINTEGER CONSTMASK=X'40'
%CONSTINTEGER IDMASK   =X'10'
%CONSTINTEGER TEXTMASK =X'20'
!*
!********************* other useful masks ******************************
!*
%CONSTINTEGER ARRAYBIT  = X'04'
%CONSTINTEGER CMNBIT    = X'02'
%CONSTINTEGER EQUIVBIT  = X'80'
!*
!********************* modes *******************************************
!*
%CONSTINTEGER INT2    = 0, INT4    = 1, INT8    = 2
%CONSTINTEGER REAL4   = 3, REAL8   = 4, REAL16  = 5
%CONSTINTEGER CMPLX8  = 6, CMPLX16 = 7, CMPLX32 = 8
%CONSTINTEGER LOG1    = 9, LOG2    =10, LOG4    =11
%CONSTINTEGER LOG8    =12, CHARMODE=13, HOLMODE =14
%CONSTINTEGER BYTE    =15, HEXCONST=16
!*
!********************* types *******************************************
!*
%CONSTINTEGER INTTYPE   = 1
%CONSTINTEGER REALTYPE  = 2
%CONSTINTEGER CMPLXTYPE = 3
%CONSTINTEGER LOGTYPE   = 4
%CONSTINTEGER CHARTYPE  = 5
!*
!********************* scaling factors *********************************
!*
!*
!********************* length of maximum source statement **************
!*
%CONSTINTEGER INPUT LIMIT = 1328
!*
!********************* mode to size/type *******************************
!*
%CONSTBYTEINTEGERARRAY MODETOST(0:15)=  %C
   X'41',X'51',X'61',X'52',X'62',X'72',
   X'53',X'63',X'73',X'34',X'44',X'54',X'64',5,0,X'31'
!*
!********************* mode to bytes etc. ******************************
!*
%CONSTBYTEINTEGERARRAY CSIZE(0:15)=  %c
   2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoBytes(0:15)=  %c
   2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoTempBytes(0:15)=  %c
   4,4,8,4,8,16,8,16,32,4,4,4,8,4,4,4
%CONSTBYTEINTEGERARRAY SETMODE(0:63)= %C
0(4),10,13,0(11),1,3,6,11,0(12),2,4,7,8,0(12),15,5,8,9,0(11)
!*
!********************** location of pseudo common record in dict *******
!*
%CONSTINTEGER PSEUDOCMN=20
!*
!********************** location of blank common record in dict ********
!*
%CONSTINTEGER BLCMPTR=96
!*
!********************** other useful consts ****************************
!*
%CONSTINTEGER NO  = 0
%CONSTINTEGER YES = 1
%CONSTINTEGER FULL= 2
!*
!********************** area identifiers *******************************
!*
%constinteger STACK   = 0
%CONSTINTEGER GLA     = 2
%CONSTINTEGER SST     = 4
%CONSTINTEGER GST     = 5
%CONSTINTEGER DIAGS   = 6
%CONSTINTEGER SCALARS = 7
%CONSTINTEGER IOAREA  = 8
%CONSTINTEGER ZEROGST = 9
%CONSTINTEGER CONSTS  =10
!*
!********************** system procedures ******************************
!*
%constinteger F77AUX   = 0
%constinteger F77STOP  = 1
%constinteger F77PAUSE = 2
%constinteger F77IOA   = 3
%constinteger F77IOB   = 4
%constinteger F77IOC   = 5
%constinteger F77IOD   = 6
%constinteger F77IOE   = 7
%constinteger F77IOF   = 8
%constinteger F77FILE  = 9
%constinteger IMPSTOP  =10
%constinteger F77RTERR =11
%constinteger F77IOAR  =12
%constinteger F77IOBR  =13
%constinteger F77IOG   =14
%constinteger F77CPSTR =15
%constinteger F77CONCAT=16
%constinteger F77INDEX =17
%constinteger FIBITS   =18
%constinteger FISHFTC  =19
%constinteger F77PCHECK=20
%constinteger INITMAIN =21
%constinteger INITGLA  =22
%constinteger CRMULT   =23
%constinteger CDMULT   =24
%constinteger CRDIV    =25
%constinteger CDDIV    =26
%constinteger FCPYSTR  =27
!*
!***********************************************************************
!***********************************************************************
!*
!*
{%INCLUDE "ftn_fmts2"}
!* 09/12/85 - add recordformat SUBFMT
!* modified 14/03/85
!*
!***********************************************************************
!* Formats for accessing dictionary records                            *
!***********************************************************************
!*
%recordformat PRECF(%byteinteger CLASS,TYPE,X0,X1,
                    %integer LINK1, LINK2,
                   (%shortinteger COORD,LINK3  %OR %integer LAST   %C
                        %OR %integer CONSTRES %OR %integer INF3),
                    %integer ADDR4,
                    %shortinteger DISP,LEN,IDEN,IIN,
                    %integer LINE,XREF,CMNLENGTH,CMNREFAD)
!*
%recordformat SRECF(%integer INF0, LINK1, INF2, INF3, INF4)
!*
%recordformat RESF((%integer W %OR %shortinteger H0,
                      (%shortinteger H1 %OR %byteinteger FORM,MODE)))
!*
%recordformat DORECF( %C
    %integer LABEL, LINK1,
    %record(RESF) LOOPAD, ENDREF, INDEXRD, INCRD, FINALRD, ICRD,
    %integer LABLIST,LINE)
!*
%recordformat BFMT(%integer L,U,M)
!*
%recordformat ARRAYDVF(%integer DIMS, ADDRDV,ADDRZERO,  %C
            %integer ZEROTOFIRST, ADFIRST, NUMELS, ELLENGTH,  %C
            %record(BFMT) %ARRAY B(1 : 7))
!*
!*
%recordformat LRECF(%integer NOTFLAG,LINK1,
                    %record(RESF) ORLAB,ANDLAB,
                    %integer RELOP)
!*
%recordformat IFRECF(%integer TYPE,LINK1,
                     %record(RESF) ENDIFLAB,FALSELAB,
                     %integer LABLIST,LINE)
!*
%recordformat LABRECF(%shortinteger BLKIND,%byteinteger X0,X1,  %C
            %integer LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE,  %C
            %shortinteger DOSTART,DOEND,IFSTART,IFEND)
!*
%recordformat PLABF(%shortinteger BLKIND,%byteinteger USE,X1,
                    %integer INDEX,CODEAD,REF,REFCHAIN)
!*
%recordformat IMPDORECF(%integer VAL,LINK,IDEN)
!*
%recordformat CONSTRECF(%shortinteger MODE,LENGTH,
                      (%integer VALUE %OR %integer LINK1),
                      %integer DADDR,CADDR)
!*
%recordformat TMPF((%byteinteger CLASS,TYPE,
                        %shortinteger LEN %OR %integer W0),
                    %integer LINK1,
                    %byteinteger REG,MODE,%shortinteger INDEX,
                    %shortinteger COORD,USECNT,
                    %integer ADDR)
!*
%recordformat CHARF(%integer ADESC,LINK,LEN)
!*
%recordformat FNRECF(%integer FPTR,LINK1,HEAD,PCT)
!*
%recordformat TERECF(%shortinteger MODE,LOOP,
                      %integer CHAIN,DISP1,INDEX,
                      %shortinteger COORD,FLAGS)
!*
%recordformat DTRECF(%shortinteger MODE,IDENT,
                      %integer CHAIN,DISP2,
                      %shortinteger FLAGS,INDEX,
                     (%integer LOOP %OR %record(RESF) CONST))
!*
!*
!***********************************************************************
!* TRIAD record format                                                 *
!***********************************************************************
!*
%recordformat TRIADF(  %C
               %byteinteger OP,
               (%byteinteger USE %OR %byteinteger VAL2),
               %shortinteger CHAIN,
               (%record(RESF) RES1      %OR     %C
               (%shortinteger OPD1,%byteinteger QOPD1,MODE  %OR  %C
               (%integer SLN %OR %integer VAL1))),
               (%record(RESF) RES2      %OR   %C
                %shortinteger OPD2,%byteinteger QOPD2,MODE2))
!*
!***********************************************************************
!* COM record format                                                   *
!***********************************************************************
!*
%recordformat COMFMT(%integer CONTROL,OPT,OPTIONS1,OPTIONS2,PTRACE,
      ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR,
      MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD,
      SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST,
      RESCOM1,RESCOM2,F77PARM,FNO,FAULTY,LINEST,CMNIIN,SFMK,
      LISTL,LISTSTREAM,DIAGSTREAM,LISTMODE,XREF,
      PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR,
      HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN,
      NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT,
      UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR,
      FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT,
      COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR,
      CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN,
      ADEXT,MAXDICT,MAXNAMES,MAXOUTPUT,MAXEXT,
      ACOMP,ASUBNAMES,MAXPSTACK,
      ATRIADS,TRFILEID,TRBLOCK,CMNCNT,SCANONLY,NOISY,
      MAXANAL,MAXGEN,SAVEANAL,SAVEGEN,OPTFLAGS,NEXTBIT,
      ACMNBITS,NEXTTEMP,ASSGOTOS,TMPPTR,DESTEMPS,OBJADDR,
      AREAADDR,PASTART,ADOPTDATA,TMINDEX,VRETURN,ENTRIES,
      EQUCHK,LABWARN,LINENO,MAXIBUFF,
      COMMENTS,DIAGLEVEL,WARNNOT77,WARNLENGTH,ALLOWUNIX,ALLOWVAX,
      ONETRIP,HOST,TARGET,MONERRS,CODECA,
      GLACA,DIAGCA,SSTCA,GSTCA,CONSTCA,SCALARCA,IOAREACA,ZGSTCA,STACKCA,
      W1,W2,W4,STATORDERMODE,CURSTATCLASS,LISTPOINT,STACKBASE,
      NEXTTRIAD,ASAVE,MAXSAVE,SUBTAB,LASTSUBTAB,
      INHIBOP4,ARGCNT,IDCNT,LABCNT,TMLIST,MAINPROG,PROCINDEX,CONSOLE)
!*
!***********************************************************************
!* record format for communicating with optimiser                      *
!***********************************************************************
!*
%recordformat OBJFMT(%string(35) MODULE,%integer MAINEP,I,J,K,
                     ADATE,ATIME,OPTIONS2,EXTPROCS,ATRIADS,MAXTRIADS,
                     ABLOCKS,MAXBLOCKS,ALOOP,MAXLOOP,ATABS,MAXTABS,
                     SRFLAGS,INHIBMASK,OPT,OPTFLAGS,OPTDESC0,OPTDESC1,
                     D1,D2,D3,D4)
!*
!***********************************************************************
!*
!*
%RECORDFORMAT SUBRECF(%INTEGER LINK,FLAGS,TRIADS,DICT,NAMES,PTRS,PROG,
      LABCNT,ARGCNT,IDCNT,TRCNT,REFSCNT,SUBSCNT,
      DPTR,NEXTTRIAD,NAMESFREE,NEXTBIT,SUBPROGTYPE,SUBPROGPTR,
      CBNPTR,SCPTR,CMNIIN,FUNRESDISP,CMNCNT,ASSGOTOS,VRETURN,ENTRIES,
      TMLIST,ALABS,ALHEADS,NEXTPLAB,
      %STRING(32) NAME,%INTEGERARRAY COORDS(0:15))
!*
%CONSTINTEGER SUBSIZE=232
%CONSTINTEGER LABSIZE=128
%CONSTINTEGER LHEADSIZE=620
!*
!*
{%INCLUDE "ftn_triadops1"}
!*
!*********************** TRIAD operator values *************************
!*
%constinteger ADD    = X'02'
%constinteger SUB    = X'03'
%constinteger MULT   = X'04'
%constinteger DIV    = X'05'
%constinteger NEG    = X'06'
%constinteger ASMT   = X'07'
%constinteger CVT    = X'08'
%constinteger ARR    = X'09'
%constinteger ARR1   = X'0A'
%constinteger BOP    = X'0B'
%constinteger ASGN   = X'0C'
%constinteger EXP    = X'0E'
%constinteger EXP3   = X'0F'
%constinteger AND    = X'10'
%constinteger OR     = X'11'
%constinteger NOT    = X'12'
%constinteger EQUIV  = X'13'
%constinteger NEQ    = X'14'
%constinteger GT     = X'15'
%constinteger LT     = X'16'
%constinteger NE     = X'17'
%constinteger EQ     = X'18'
%constinteger GE     = X'19'
%constinteger LE     = X'1A'
%constinteger SUBSTR = X'1B'
%constinteger CHAR   = X'1C'
%constinteger CONCAT = X'1D'
%constinteger CHHEAD = X'1E'
%constinteger STOD1  = X'20'
%constinteger STOD2  = X'21'
%constinteger EOD1   = X'24'
%constinteger EOD2   = X'25'
%constinteger BRK    = X'28'
%constinteger DARR   = X'29'
%constinteger DEFARR = X'29'
%constinteger RRSUB  = X'2A'
%constinteger RRDIV  = X'2B'
%constinteger DCHAR  = X'2C'
%constinteger ASH    = X'2D'
%constinteger STRTIO = X'30'
%constinteger IOITEM = X'31'
%constinteger IODO   = X'32'
%constinteger IOSPEC = X'33'
%constinteger IO     = X'34'
%constinteger ENDIO  = X'34'
%constinteger DIOITEM= X'35'
%constinteger SUBS   = X'38'
%constinteger ARGARR = X'39'
%constinteger INIT   = X'3A'
%constinteger INCR   = X'3B'
%constinteger DECR   = X'3C'
%constinteger DINIT  = X'3D'
%constinteger PINCR  = X'3E'
%constinteger NOOP   = X'40'
%constinteger FUN    = X'41'
%constinteger SUBR   = X'42'
%constinteger ARG    = X'43'
%constinteger STRTSF = X'44'
%constinteger ENDSF  = X'45'
%constinteger CALLSF = X'46'
%constinteger IFUN   = X'47'
%constinteger DARG   = X'48'
%constinteger IARG   = X'49'
%constinteger REPL   = X'4A'
%constinteger REF    = X'4B'
%constinteger LOADB  = X'4C'
%constinteger STOREB = X'4D'
%constinteger MOO    = X'4E'
%constinteger JIT    = X'50'
%constinteger JIF    = X'51'
%constinteger JINN   = X'52'
%constinteger JINP   = X'53'
%constinteger JINZ   = X'54'
%constinteger JIN    = X'55'
%constinteger JIP    = X'56'
%constinteger JIZ    = X'57'
%constinteger CGT    = X'58'
%constinteger GOTO   = X'59'
%constinteger RET    = X'5A'
%constinteger STOP   = X'5B'
%constinteger PAUSE  = X'5C'
%constinteger EOT    = X'5D'
%constinteger NINT   = X'5E'
%constinteger ANINT  = X'5F'
%constinteger STMT   = X'60'
%constinteger ITS    = X'61'
%constinteger PA     = X'62'
%constinteger TOCHAR = X'63'
%constinteger DIM    = X'64'
%constinteger DMULT  = X'65'
%constinteger AINT   = X'66'
%constinteger ABS    = X'67'
%constinteger MOD    = X'68'
%constinteger SIGN   = X'69'
%constinteger MIN    = X'6A'
%constinteger MAX    = X'6B'
%constinteger REALL  = X'6C'
%constinteger IMAG   = X'6D'
%constinteger CMPLX  = X'6E'
%constinteger CONJG  = X'6F'
%constinteger LEN    = X'70'
%constinteger ICHAR  = X'71'
%constinteger CHIND  = X'72'
%constinteger DCMPLX = X'73'
%constinteger INTRIN = X'74'
!*
!*
{%INCLUDE "ftn_optfmts1"}
!*
!***********************************************************************
!* Optimiser record formats                                            *
!***********************************************************************
!*
%RECORDFORMAT BLRECF(%BYTEINTEGER FLAGS,DEPTH,%SHORTINTEGER CHAIN,
                     %INTEGER FCON,
                     %INTEGER BCON,BDOM,BTARG,TEXT,
                     %INTEGER CORRUPT,BUB1,
                     %INTEGER USE,DEF,BOE)
!*
%RECORDFORMAT CONRECF((%INTEGER COUNT %OR %INTEGERARRAY BLOCK(0:1000)))
!*
%RECORDFORMAT LOOPRECF(%INTEGER BLOCK,DOWN,ACROSS,ST)
!*
%RECORDFORMAT CLOOPRECF(%INTEGER BLOCK,PDCHAIN,PDBACKCHAIN)
!*
%RECORDFORMAT PROPRECF(%SHORTINTEGER DEFCT,TEXT,DEFN,
                       %BYTEINTEGER FLAGS,COORD2,
                       %RECORD(RESF) REPL)
!*
%RECORDFORMAT SREDF(%SHORTINTEGER MODE,IDENT,LOOP,DUMP,INIT,
                    %BYTEINTEGER FLAGS,SPARE1,
                    %SHORTINTEGER USECT,SPARE2,
                    %INTEGER WEIGHT,
                    %INTEGER CHAIN,
                   (%SHORTINTEGERARRAY INCR(1:3),TEST(1:3),USE(1:1000) %C
                           %OR %SHORTINTEGERARRAY ALLREFS(1:1006)))
!*
!***********************************************************************
!* Constant definitions                                                *
!***********************************************************************
!*
%CONSTINTEGER USE            =  0 ;! variable usage
%CONSTINTEGER DEF            =  1 ;!
!*
%CONSTINTEGER TDUMP          =  1 ;! dump triads before optimiastion
%CONSTINTEGER BDUMP          =  2 ;! dump block tables
%CONSTINTEGER LDUMP          =  4 ;! dump loop tables
%CONSTINTEGER T1DUMP         =  8 ;! dump triads after OP1
%CONSTINTEGER T2DUMP         = 16 ;! dump triads after OP2
%CONSTINTEGER T3DUMP         = X'200' ;! dump triads after OP3
%CONSTINTEGER SDUMP          = 32 ;! give reconstructed source
%CONSTINTEGER S1DUMP         = X'800' ;! reconstructed source after OP1
%CONSTINTEGER S2DUMP         = X'1000' ;! reconstructed source after OP2
%CONSTINTEGER EDUMP          = 64 ;! dump elimination info
%CONSTINTEGER CDUMP          = X'80' ;! constant elimination
%CONSTINTEGER PDUMP          = X'100';! proptabs
%CONSTINTEGER SEOBDUMP       = X'400' ;! dump triads for block after SUBSEOB
%CONSTINTEGER SSDUMP         = X'2000' ;! trace path through SUBSUM
!*
%CONSTINTEGER INHIBSUBSUM  =  1
%CONSTINTEGER INHIBOP2A    =  2
%CONSTINTEGER INHIBEXPOPTS =  4
%CONSTINTEGER INHIBBMOVE   =  8
%CONSTINTEGER INHIBEXPELIM = 16
%CONSTINTEGER INHIBSTR = 32
!*
%CONSTINTEGER FUNCBIT        = X'80' ;! block contains a function call
%CONSTINTEGER RETBIT         = X'20' ;! block is a procedure return block
%CONSTINTEGER LEBIT          = X'10' ;! block is a loop entry block
%CONSTINTEGER ARTICBIT       = X'08' ;! block is an articulation block
!*
%CONSTINTEGER EBBIT          = X'08' ;! entry block marker in label table
!*
%CONSTINTEGER SOB            = X'80' ;! start of block marker in STMT triad
%CONSTINTEGER BMBIT          = x'80' ;! in TR_OP indicates it has been backward moved
%CONSTINTEGER BMBIT OFF      = x'7F' ;! mask for deleting BMBIT
%CONSTINTEGER BMBIT SHIFT    = 7
!*
%CONSTINTEGER TESTREPBIT     = 2
%CONSTINTEGER REVTESTBIT     = 1
%CONSTINTEGER BREGBIT        = 4
%CONSTINTEGER SCANDBIT       = 8
!*
%CONSTINTEGER SRTEMPBIT      = 1
%CONSTINTEGER ACTARGBIT      = 2
%CONSTINTEGER INITLOADBIT    = 4
!*
%CONSTINTEGER FROM           = 0 ;! param to BUSYONX
%CONSTINTEGER TO             = 1 ;! ditto
%CONSTINTEGER BUSY           = 1
%CONSTINTEGER NOT BUSY       = 0
!*
%CONSTBYTEINTEGERARRAY DEFTEST(0:116)=   %C
   0(7),1,0(4),1,0(38),5,0,1,0(11),3,4,0(3),6,0,2,0(44);! ASMT,ASGN,FUN,CALL,DARG
!*
!*
%RECORDFORMAT OPTDFMT(     %C
%INTEGER ADICT     ,{ @ of dictionary area}
%INTEGER MAXDICT   ,{ currect available length of dictionary}
%INTEGER ANAMES    ,{ @ of name table}
%INTEGER ABLOCKS   ,{ @ of block table}
%INTEGER MAXBLOCKS ,{ current available length of block table area}
%INTEGER NEXTBLOCK ,{ next available block index}
%INTEGER FREEBLOCKS,
%INTEGER CBNPTR    ,{ listhead of common block records}
%INTEGER SCPTR     ,{ listhead of local identifiers}
%INTEGER ATABS     ,{ @ of area for assorted optimiser tables}
%INTEGER MAXTABS   ,{ curent available length of opt table area}
%INTEGER FREETABS  ,{ next free location in opt table area}
%INTEGER EXBPTR    ,{ exit block table}
%INTEGER ENTBPTR   ,{ entry block table}
%INTEGER ALOOPS    ,{ @ loop table area}
%INTEGER MAXLOOPS  ,{ current available length of loop table area}
%INTEGER FREELOOPS ,{ next free location in loop table area}
%INTEGER ATRIADS   ,{ @ of triad area}
%INTEGER LASTTRIAD ,{ last allocated triad index}
%INTEGER MAXTRIADS ,{ current available number of triads}
%INTEGER FREETRIADS,{ listhead of released triads}
%INTEGER BLSIZE    ,{ length (in architecture units) of a block entry}
%INTEGER BSBITS    ,{ length (in bits) of bit string}
%INTEGER BSSIZE    ,{ length (in architecture units) of a bit strip}
%INTEGER BSWORDS   ,{ length in 2900 words of a bit strip}
%INTEGER OPT       ,{ optimisation level 0, 1 or 2}
%INTEGER OPTFLAGS  ,{ tracing level   1 Triads  2 Blocks  4 Loops }
%INTEGER INHIBMASK ,{ inhibits specific optimisations}
%INTEGER SRFLAGS   ,{ strength reduction diagnostic flags}
%INTEGER SRHEAD,
%INTEGER SRCH,
%INTEGER APROPTABS ,{ @ bsbits * prop table entries}
%INTEGER CLOOPHEAD ,{ head of list of all blocks in current loop }
%INTEGER PLOOPHEAD ,{ subset of CLOOPHEAD list already processed}
%INTEGER DLOOPHEAD ,{ CLOOPHEAD list - PLOOPHEAD list}
%INTEGER CLOOPTAIL,
%INTEGER PLOOPTAIL,
%INTEGER DLOOPTAIL,
%INTEGER DLOOPPTR  ,{ current DLOOP record}
%INTEGER LOOP      ,{ current pointer to looptab}
%INTEGER BACKTARG  ,{ blocktab index of back target block}
%INTEGER BTARGTRIAD,{ index of triad within back target block to which new triads chained}
%INTEGER OLDBTARGTRIAD,
%INTEGER LOOPDEPTH ,{ depth of current loop}
%INTEGER LOOPENT   ,{ blocktab index of loop entry block}
%INTEGER CURRBLK   ,{ blocktab index of current block}
%INTEGER CURRTRIAD ,{ triad index of triad currently being processed}
%INTEGER PREVTRIAD ,{ previous triad (for rechaining)}
%INTEGER ACMNCOORDS,{ @ CMNCOORDS}
%INTEGER ACURRDEF  ,{ @ CURRDEF}
%INTEGER ASTFNDEF,
%INTEGER ARGRISK,
%INTEGER VALTEMPHEAD,
%INTEGER DESTEMPHEAD,
%INTEGER DTINDEX,
%INTEGER TEINDEX,
%INTEGER TECH,
%INTEGER DTCH)
!*
!
{%INCLUDE "ftn_copy1"}
!* modified 12/01/85
!*
%routine Copy(%integer Length,Fbase,Fdisp,Tbase,Tdisp)
!***********************************************************************
!* copy Length bytes from fbase(fdisp) to tbase(tdisp)                 *
!***********************************************************************
%integer I,From,To
      %if Length<=0 %then %return
      %if HOST=PERQPNX %thenstart
         From=Fbase<<1+Fdisp
         To=Tbase<<1+Tdisp
      %finishelsestart
         From=Fbase+Fdisp
         To=Tbase+Tdisp
      %finish
      %cycle I=0,1,Length-1
         byteinteger(To+I)=byteinteger(From+I)
      %repeat
%end;! Copy
!*
%routine Fill(%integer Length,Fbase,Fdisp,Filler)
!***********************************************************************
!* fill Length bytes from fbase(fdisp) with Filler                     *
!***********************************************************************
%integer I,From
      %if Length<=0 %then %return
      %if HOST=PERQPNX %thenstart
         From=Fbase<<1+Fdisp
      %finishelsestart
         From=Fbase+Fdisp
      %finish
      %cycle I=0,1,Length-1
         byteinteger(From+I)=Filler
      %repeat
%end;! Fill
!*
%routine Zero(%integer Addr,Length)
!***********************************************************************
!* Set Length (a multiple of 4) bytes to zero                          *
!***********************************************************************
%integer I
      %if HOST=PERQPNX %thenstart
         Length=Length>>1
      %finish
      I=0
      %while I<Length %cycle
         integer(Addr+I)=0
         %if HOST=PERQPNX %thenstart
            I=I+2 {words}
         %finishelsestart
            I=I+4 {bytes}
         %finish
      %repeat
%end;! Zero
!*
%routine Putbyte(%integer Val,Base,Offset)
      %if HOST=PERQPNX %thenstart
         byteinteger(Base+Base+Offset)=Val
      %finishelse byteinteger(Base+Offset)=VAL
%end;! Putbyte
!*
%integerfn Getbyte(%integer Base,Offset)
      %if HOST=PERQPNX %thenstart
         %result=byteinteger(Base+Base+Offset)
      %finishelse %result=byteinteger(Base+Offset)
%end;! Putbyte
!*
%routine Puthalf(%integer Val,Base)
      shortinteger(Base)=Val
%end;! Puthalf
!*
%integerfn Gethalf(%integer Base)
      %result=shortinteger(Base)
%end;! Puthalf
!*
!*
! %INCLUDE "targ_etoinitoe"
! *************************************************************************
! include EBCDIC/ISO conversion routines if required
! *************************************************************************
!
!
%externalstringfnspec Fptos(%integer ad,mode)
!
%OWNINTEGER ADICT
%OWNINTEGER ANAMES
%OWNINTEGER ABLOCKS
%OWNINTEGER BLSIZE
%OWNINTEGER OPT
!*
%OWNINTEGERARRAY SWCOND(0:5)=26,25,24,23,22,21
%OWNINTEGER JIFTYPE=0
%OWNBYTEINTEGERARRAY ORDER(0:43)=0(2),1,2,3,4,2,0(35),2,4
%OWNINTEGER INTRIN0=0
%OWNINTEGER NOLHS=0
%OWNINTEGER COPYFLAG
%OWNINTEGER TEXTPTR=0
%OWNINTEGER NEXTTRNO=0
%OWNINTEGER NEXTBLK=0
%OWNSTRING(12) INDENTS=""
%OWNSTRING(100) %ARRAY TEXTARRAY(0:13)
%OWNSTRING(32) COPYSTR=""
%OWNSTRING(32) NAM=""
%OWNSTRING(6) CURRLINE=""
%OWNSTRING(8) CURRLABEL=""
%OWNSTRING(255) CURRTEXT=""
%OWNSTRING(36) FPSTR=""
%OWNSTRING (31) INTSTR=""
%OWNSTRING(32) DESCSTR=""
%OWNSTRING(32) VALSTR=""
%OWNSTRING(8) CURRMARK=""
%OWNINTEGER LINES=0
%OWNINTEGER COPYBR=0
%OWNINTEGER MINMAX=0
%OWNINTEGER TEXTSET=0
%OWNINTEGER STRINGSET=0
%OWNINTEGER LINESET=0
%OWNINTEGER LABELSET=0
%OWNINTEGER SAVENEXT
!IN RTOL     1  =  PROCESS RHS FIRST
!            2  = NO LHS /IGNORE
!            4  = MOO OR IFUN SPECIAL FUNCTIONS
!         8  CHHEAD/CONCAT/min/max
!        16 SUBSTRING
!        32 NOT/NEG/BRK
%CONSTBYTEINTEGERARRAY RTOL(0:116)=%C
    0,   0,   64,   64,   64,   64,   96,  0,   0,   0,
    0,   0,   0,   0,   0,   2,   0,   0,   32,  0,
    0,   0,   0,   0,   0,   0,   0,   16,  0,   9,
    9,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   65,   65,   0,   0,   0,   0,   0,   0,
    32,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   4,   0,   0,   0,   0,   0,   0,   4,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   8,   8,   0,   0,   0,   8,
    8,   8,   8,   8,   8,   8,   8,   8,   8,   8,
    8,   8,   8,   8,   8,   8,   4
%CONSTBYTEINTEGERARRAY ENDS(0:116)=%C
    0,   0,   0,   0,   0,   0,   0,   1,   0,   0,
    0,   0,   1,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   1,   1,
    0,   1,   1,   1,   0,   0,   0,   0,   1,   1,
    1,   1,   1,   0,   0,   0,   1,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   1,   1,   0,   0,
    1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
    1,   1,   1,   1,   0,   0,   1,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
    0,   0,   0,   0,   0,   0,   0
%CONSTSTRING(11) %ARRAY FNTYPE(1:5)=  %C
"INTEGER ","REAL ","COMPLEX ","LOGICAL ","CHARACTER "
%CONSTSTRING(11) %ARRAY ROUTS(0:3)= %C
"PROGRAM ","FUNCTION ","SUBROUTINE ","ENTRY "
%CONSTSTRING(15)%ARRAY IOSPECS(1:25)=  %C
   "#UNIT = ", "#FMT = ", "#REC = ", "#END = ", "#ERR = ","#IOSTAT = ",
"#FILE = ","#STATUS = ","#ACCESS = ","#FORM = ","#RECL = ","#BLANK = ",
"#EXIST = ","#OPENED = ","#NUMBER = ","#NAMED = ","#NAME = ","#NREC = ",
"#SEQUENTIAL = ","#DIRECT = ","#FORMATTED = ",   "#UNFORMATTED = ",
"#NEXTREC = ","#DESC = ","#"
!*
%CONSTSTRING(9)%ARRAY IOTYPES(1:8) =   %C
   "READ", "WRITE", "REWIND", "BACKSPACE",
   "ENDFILE", "OPEN", "CLOSE", "INQUIRE"
!*
%CONSTSTRING(6)%ARRAY GEN NAME(1:26)=  %C
   "SQRT"  ,"EXP"   ,"LOG"   ,"LOG10" ,
   "SIN"   ,"COS"   ,"TAN"   ,"COT"   ,
   "ASIN"  ,"ACOS"  ,"ATAN"  ,"ATAN2" ,
   "SINH"  ,"COSH"  ,"TANH"  ,"ERF"   ,
   "ERFC"  ,"GAMMA" ,"LGAMMA","ABS",
   "LGE"   ,"LGT",   "LLE",   "LLT",
   "INDEX","CABS"
%CONSTSTRING(4) %ARRAY MOOFNS(1:7)=%C
      "SQRT","LOG","EXP","SIN","COS","TAN","ATAN"
%CONSTSTRING(7) %ARRAY INTRINFNS(1:13)= %c
      "AND","OR","XOR","NOT","ISHIFT","IBITS","IBSET",
       "BTEST","IBCLR","ISHIFTC","IAND","IOR","IEOR"
%CONSTSTRING(10) %ARRAY OPVALS(0:116)=                                      %C
      "",         "",         " + ",      " - ",
      " * ",      " / ",      " - ",      " = ",
      "#CVT(",     "ARR",      "ARR1",     "",
      "ASSIGN ", "",         " ** ",     "(-1) ** ",
      " .AND. ",  " .OR. ",   " .NOT. (",  " .EQV. ",
      " .NEQV. ", " .GT. ",   " .LT. ",   " .NE. ",       
      " .EQ. ",   " .GE. ",  " .LE. ",   ":",
      "",     "//",       "",   "",
      "STOD1",    "STOD2",    "STODA",    "",      
      "EOD1",     "EOD2",     "EODA",     "EODB",
      "(",         "DEFARR",   "-",        "/",    
      "DCHAR",    "#ASH",     "",         "",
      "#STRTIO : ",  "#IOITEM : ",   "IODO",     "IOSPEC",
      "#ENDIO",   "#IOITEM : ",      "",         "",
      "",         "ARGARR",       " = ",      " + ",     
      " - ",      " = @",      " + ",  "",
      "NOOP",     "FUN",      "CALL",     "ARG",
      "STRTSF",   "ENDSF",    "CALLSF",   "IFUN",
      "DARG",     "IARG",     "REPL",     "REF",
      "",         "",         "MOO",      "REF",
      "",         ")",          " .GE. 0",  " .LE. 0 ",
      " .NE. 0",  " .LT. 0",   " .GT. 0",   " .EQ. 0",
      "GOTO (",  "GOTO ",     "RET",      "STOP ",
      "PAUSE ",    "END",      "#NINT(",   "#ANINT(",
      "STMT",     "ITS",      "PA",       "#CHAR(",
      "#DIM(",     "#DPROD(",     "#AINT(",     "#ABS(",
      "#MOD(",      "#SIGN(",     "#MIN(",      "#MAX(",
      "#REAL(",     "#IMAG(",     "#CMPLX(",    "#CONJG(",
      "#LEN(",     "#ICHAR(",     "#INDEX(",    "#DCMPLX(",
      "#INTRIN"

%CONSTBYTEINTEGER %ARRAY C(0:15)='0','1','2','3','4','5','6','7',
                               '8','9','A','B','C','D','E','F'
%CONSTSTRING(2) %ARRAY COMPAR(1:6)="GT","LV","NE","EQ","GE","LE"
%CONSTSTRING(9) %ARRAY LOG(0:1)=" .FALSE. "," .TRUE. "
%CONSTBYTEINTEGERARRAY INDENT(1:9)=10,8,8,14,10,10,10,6,68
%CONSTSTRING(6) TMPRES="IR IN "
!*
!*
!*
!*
%EXTERNALROUTINE RESETOPLIST
LINES=0
%END
!
%INTEGERFN CONOUT(%RECORD(RESF) R)
%RECORD(CONSTRECF)%NAME CON
      %IF R_FORM=LIT %THEN %RESULT=R_H0
      %IF R_FORM=NEGLIT %THEN %RESULT=-R_H0
      CON==RECORD(ADICT+R_H0<<DSCALE)
      %RESULT=INTEGER(ADICT+CON_DADDR)
%END;! CONOUT
!*
!*             OUTPUTTEXT
!*
%ROUTINE OUTPUTTEXT
%STRING (26) C,S
%INTEGER I
%STRING(1) NL
      NL="
"
      %IF OPT=4 %THEN C="                       * " %ELSE %C
      C="               * "
      %IF TEXTPTR=0 %THEN PRINTSTRING(INDENTS.CURRTEXT.NL) %AND %RETURN
      %CYCLE I=0,1,TEXTPTR-1
         %IF I=0 %THEN S="" %ELSE S=C
         PRINTSTRING(S.TEXTARRAY(I))
         NEWLINE
      %REPEAT
      %IF CURRTEXT#"" %THEN PRINTSTRING(C.INDENTS.CURRTEXT.NL)
      %RETURN
%END
!*
!*                             OUTPUTLINE
!*
%ROUTINESPEC ITOS(%INTEGER N)
%ROUTINE OUTPUTLINE(%INTEGER I)
%SWITCH SW(0:2)
%STRING(6) S6
%STRING(14) S14
%STRING(8) S8,CON
%STRING(1) NL
%INTEGER J
      S6="      "
      S8="        "
      S14="              "
      NL="
"
      %IF I#2 %THEN CON="CONTINUE" %ELSE CON="END"
      ->SW(I)
SW(0):
      %IF LINESET&LABELSET#0 %OR TEXTSET=1 %THEN %START
      %IF TEXTSET=0 %THENRETURN
SW(1):
SW(2):
      %IF LINESET=1 %THENSTART
        %IF OPT=4 %THENSTART
          LINES=LINES+1
          ITOS(LINES)
          %IF LENGTH(INTSTR)>=6 %THEN CURRMARK=INTSTR %ELSESTART
            %CYCLE J=1,1,6-LENGTH(INTSTR)
              CURRMARK=" ".CURRMARK
            %REPEAT
            CURRMARK=CURRMARK.INTSTR
          %FINISH
          PRINTSTRING(CURRMARK."  ")
      %FINISH
      PRINTSTRING(CURRLINE)
      %FINISHELSEIF OPT=4 %THEN PRINTSTRING(S14) %ELSE PRINTSTRING(S6)
      %IF LABELSET=1 %THEN PRINTSTRING(CURRLABEL) %ELSE PRINTSTRING(S8)
      PRINTSTRING("   ")
      %IF TEXTSET=1 %THEN  OUTPUTTEXT %ELSE PRINTSTRING(INDENTS.CON.NL)
      %FINISH
RESET3:
      CURRLINE=""
      CURRMARK=""
      LINESET=0
RESET2:
      CURRLABEL=""
      LABELSET=0
RESET1:
      CURRTEXT=""
      TEXTSET=0
      TEXTPTR=0
%END
!*
!*
!*
!*                        SPLIT OUTPUT
!*
%ROUTINE SPLITOUTPUT(%STRING(255) S)
%INTEGER LENS,LENC,I,ADR,LOOP,LENE
      LENC=LENGTH(CURRTEXT)
! EFFECTIVE LENGTH TAKING INDENTATION INTO ACCOUNT
      LENE=100-LENGTH(INDENTS)
      LENS=LENGTH(S)
      %IF LENC+LENS>LENE %THEN %START
         TEXTARRAY(TEXTPTR)=INDENTS.CURRTEXT
         TEXTPTR=TEXTPTR+1
         %IF LENS>LENE %THEN ->LONGCHAR %ELSE CURRTEXT=S
      %FINISHELSE CURRTEXT=CURRTEXT.S
      %RETURN
! IF STRING FOR ONE ITEM > (LENE-INDENTATION) CHARS START IN NEW ARRAY ITEM
LONGCHAR:
      LOOP=LENS//LENE
      ADR=1
      %CYCLE I=0,1,LOOP-1
         COPY(LENE,ADDR(S),ADR,ADDR(TEXTARRAY(TEXTPTR)),1)
        LENGTH(TEXTARRAY(TEXTPTR))=LENE
         TEXTARRAY(TEXTPTR)=INDENTS.TEXTARRAY(TEXTPTR)
         TEXTPTR=TEXTPTR+1
        ADR=ADR+LENE
      %REPEAT
      I=LENS-LOOP*LENE
      %IF I#0 %THENSTART
         COPY(I,ADDR(S),ADR,ADDR(CURRTEXT),1)
         LENGTH(CURRTEXT)=I
      %FINISHELSE CURRTEXT=""
%END
!*
!*                                                                   *!
!*                        PSTRING                                    *!
!*                                                                   *!
%ROUTINE PSTRING(%INTEGER TAB,%STRING(255) S)
%INTEGER LEN,I,J
%SWITCH SW(0:8)
      ->SW(TAB)
SW(3):  !Print textin S
      SPLIT OUTPUT(S)
      TEXTSET=1
       %RETURN
SW(8):
      %IF LABELSET=1 %THEN OUTPUTLINE(1)
      %IF LENGTH(S)>=8 %THEN CURRLABEL=S %AND ->MISS
      %CYCLE I=1,1,8-LENGTH(S)
         CURRLABEL=" ".CURRLABEL
      %REPEAT
      CURRLABEL=CURRLABEL.S
MISS:
      LABELSET=1
      %RETURN
SW(6):
      %IF LINESET=1 %THEN OUTPUTLINE(1)
      %IF LENGTH(S)>=6 %THEN CURRLINE=S %AND -> MISS1
      %CYCLE I=1,1,6-LENGTH(S)
         CURRLINE=" ".CURRLINE
     %REPEAT
      CURRLINE=CURRLINE.S
MISS1:
      LINESET=1
      %RETURN
SW(*):
%RETURN
%END
!*
!*                          MAXBRK
!*
%ROUTINE MAXBRK
      %WHILE MINMAX>0 %CYCLE
         PSTRING(3,")")
         MINMAX=MINMAX-1
      %REPEAT
%END
!*                                                                   *!
!*                           ITOS                                    *!
!*                                                                   *!
%ROUTINE ITOS(%INTEGER N)
%CONSTINTEGERARRAY TENS(0:9)=%C
1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000
%STRING(11) RES
%INTEGER M,R,I,STARTED,J
      %IF N=0 %THEN INTSTR="0" %ANDRETURN;
      %IF N<0 %THEN N=-N %AND RES="-" %ELSE RES=""
      STARTED=0
      %CYCLE I=9,-1,0
      R=TENS(I)
      %IF N>=R %OR STARTED#0 %START
      STARTED=1
      M=N//R
      RES=RES.TOSTRING(M+'0')
      N=N-M*R
      %FINISH
      %REPEAT
      INTSTR=RES
%END

!*                         LIST TRIAD
!*
%CONSTBYTEINTEGERARRAY HEX(0 : 15) =   %C
 '0','1','2','3','4','5','6',
'7','8','9','A','B','C','D','E','F'
%ROUTINE PRHEX(%INTEGER J)
%INTEGER K
      %CYCLE K = 28,-4,0
         PRINT SYMBOL(HEX((J>>K)&15))
      %REPEAT
%END
%ROUTINE DUMP(%INTEGER AD,LEN)
%INTEGER I
      SPACES(38)
      %CYCLE I=1,1,3
         SPACES(2)
         PRHEX(INTEGER(AD))
         AD=AD+W1
      %REPEAT
      NEWLINE
%END;! DUMP

!*
%EXTERNALROUTINE OPTSOURCE(%INTEGER DICT0,NAMES0,ATRIADS,
                                    DESTEMPHEAD,ADOPTDATA,ADJ)
!
!  Routine to convert triads back to source text
%INTEGER I,J,VAL,LINENO,TYPE,LABEL,START,FINISH,K
%INTEGER OP,BRACK
%STRING(32) QL,QR,MODE,NO,SPARE
%STRING(255) INITC,NAM,S
%STRING(255) COMMENT
%RECORD(TRIADF) %ARRAYNAME TRIADS
%OWNRECORD(TRIADF) %ARRAYFORMAT TRFMT(0:20000)
%RECORD(DTRECF) %NAME DT
%RECORD (OPTDFMT) %NAME OPTD
      ADICT=DICT0
      ANAMES=NAMES0
      TRIADS==ARRAY(ATRIADS,TRFMT)
      %if Adoptdata#0 %thenstart
         OPTD==RECORD(ADOPTDATA)
         BLSIZE=OPTD_BLSIZE
         ABLOCKS=OPTD_ABLOCKS
         OPT=OPTD_OPT
      %finish

!*
!*
!*
!*     Entry sequence for each line to be processed serially
!*
%ROUTINESPEC FORMLINE(%INTEGER TYPE,LINE,BR)
!*
%ROUTINE GET DESCTEMP(%INTEGER OPD)
%RECORD (DTRECF) %NAME DT
%RECORD (PRECF) %NAME SCAL
      DT==RECORD(ADICT+OPD<<DSCALE)
      SCAL==RECORD(ADICT+DT_IDENT<<DSCALE)
      NAM=STRING(ANAMES+SCAL_IDEN)
      ITOS(DT_INDEX)
      COPYSTR="TD-".INTSTR."..".NAM
      DESCSTR=COPYSTR
%END
%ROUTINE GET VALTEMP(%INTEGER OPD)
%RECORD (TERECF) %NAME TE
      TE==RECORD(ADICT+OPD<<DSCALE)
      ITOS(TE_INDEX)
      COPYSTR="TT-".INTSTR
      VALSTR=COPYSTR
%END
!*
!*                                GET NEXT TRIAD
!*
%INTEGERFUNCTION GETNEXT TRIAD(%INTEGERNAME NEXT,INDENT)
      %RESULT=0 %IF SAVENEXT=0
      NEXT=SAVENEXT
      SAVENEXT=TRIADS(NEXT)_CHAIN
      INDENT=0
      %RESULT=1
%END
!*                                                                   *!
!*                         GEN                                      *!
!*                                                                   *!
%ROUTINE GEN(%INTEGER INDEX,OPD,LINE)
%SWITCH SW(0:66)
%SWITCH T(0:14)
%STRING(48) S,NAM
%INTEGER J,LEN,ADR,IDEN,I,K,LABEL,LAST,CURR,NO,BR
%REAL X,Y
%LONGREAL XX,YY
%RECORD (CONSTRECF) %NAME CNST
%RECORD (PRECF) %NAME SCAL
%RECORD (PRECF) %NAME PROC
%RECORD (TMPF) %NAME TMP
%RECORD (LABRECF) %NAME LAB
%RECORD(PLABF)%NAME PLAB
      BR=0
      COPYBR=0
      LAST=TRIADS(LINE)_OP
      %IF RTOL(LAST)&2#0 %AND NOLHS=0  %THEN  %RETURN
      %IF RTOL(LAST)&16#0 %THENSTART
         %IF STRINGSET=1 %THENSTART
            STRINGSET=0
            %IF TRIADS(LINE)_QOPD2&32#0 %THEN -> CONT %ELSE -> SET
         %FINISH
         PSTRING(3,"(")
         BRACK=BRACK+1
      %FINISH
CONT:
      %IF LAST=STMT %THEN J=8 %ELSE J=3
    %IF RTOL(LAST)&32#0 %THEN PSTRING(3,OPVALS(LAST)) 
     %IF INDEX&TEXTMASK#0 %THENSTART
         CURR=TRIADS(OPD)_OP
         %IF RTOL(CURR)&8 #0 %THEN PSTRING(3,OPVALS(CURR)) %AND BR=1
       %IF TRIADS(OPD)_USE>1 %AND ENDS(CURR)#1 %AND CURR#REPL %THENSTART
         PSTRING(3,"TA-")
         ITOS(OPD)
         PSTRING(3,INTSTR)
         %IF BR=1 %THEN PSTRING(3,")") %AND BR=0
         %RETURN
         %FINISH
         %IF LAST=NEG %THEN PSTRING(3,"(") %AND BR=1
     %FINISH
      %IF RTOL(LAST)&8#0 %AND TRIADS(LINE)_USE>1  %AND INTRIN0=0 %THENC
       PSTRING(3,OPVALS(LAST)) %AND BR=1
SET:
      COPYBR=BR
      %IF INDEX=LIT %OR INDEX=NEGLIT %THEN ITOS(OPD)
      -> SW(INDEX)
SW(NULL):   !NULL                                             NULL
      %RETURN
SW(LIT):   !LITERAL                                          LIT
      %IF RTOL(LAST)&4#0 %THEN CURR=LAST %AND OPD=LINE %AND -> MOO
      J=TRIADS(LINE)_RES2_MODE
      %IF J>=LOG1 %AND J<=LOG8 %THEN J=OPD %AND ->LOG
      PSTRING(3,INTSTR)
      %RETURN
SW(NEGLIT):
      PSTRING(3,"-")
      PSTRING(3,INTSTR)
      %RETURN
SW(CNSTID):   !CONST RECORD IN DICT                             CNSTID
      CNST==RECORD(OPD<<DSCALE+ADICT)
      ADR=CNST_DADDR
      -> T(CNST_MODE)
T(INT2):
      J=HALFINTEGER(ADR+ADICT)
      -> INT
T(INT4):
      J=INTEGER(ADR+ADICT)
      -> INT
T(INT8):
      J=INTEGER(ADR+ADICT+W1)
INT:
      ITOS(J)
      PSTRING(3,INTSTR)
      %RETURN
T(REAL4):
      J=3
      ->PRINTFP
T(REAL8):
       J=4
      -> PRINTFP
T(REAL16):
      J=5
PRINTFP:
      FPSTR=FPTOS(ADR+ADICT,J)
      PSTRING(3,FPSTR)
      %RETURN
T(CMPLX8):
      J=3
      K=W1
      -> PRCMPLX
T(CMPLX16):
      J=4
      K=W2
      -> PRCMPLX
T(CMPLX32):
      J=5
      K=W4
PRCMPLX:
      PSTRING(3,"(")
      FPSTR=FPTOS(ADR+ADICT,J)
      PSTRING(3,FPSTR)
      PSTRING(3,",")
      FPSTR=FPTOS(ADR+ADICT+K,J)
      PSTRING(3,FPSTR)
      PSTRING(3,")")
      %RETURN
T(LOG4):
      J=INTEGER(ADR+ADICT)
      -> LOG
T(LOG8):
      J=INTEGER(ADR+ADICT+W1)
LOG:
      %IF J=0 %THEN PSTRING(3,LOG(0)) %ELSE PSTRING(3,LOG(1))
      %RETURN
T(CHARMODE):
T(HOLMODE):
      LEN=INTEGER(ADR+ADICT)
      %IF LEN>32 %THEN LEN=32
      COPY(LEN,ADR+ADICT,4,ADDR(S),1)
      LENGTH(S)=LEN
!*
!      %INCLUDE "targ_text1"
! *************************************************************************
! include code for EBCDIC/ISO conversion if required
! *************************************************************************
!*
      PSTRING(3,"'")
      PSTRING(3,S)
      PSTRING(3,"'")
      %RETURN
SW(SRTEMP):  !Strength reducing temporary
      ITOS(OPD)
      S=""
      COPYSTR="sr".INTSTR
      ->SOUT
SW(ARREL):   ! ARRAY ELEMENT TRIAD
SW(CHAREL):   ! CHAR SUBSTRING TRIAD
SW(TRIAD):   !TRIAD                                            TRIAD
      %IF RTOL(CURR)&4#0 %THENSTART  ;! SPECIAL FN (MATHS)
MOO:
      %IF CURR=IFUN %THENSTART
         PROC==RECORD(ADICT+TRIADS(OPD)_OPD1<<DSCALE)
         PSTRING(3,GENNAME(PROC_LINK2>>24))
      %FINISHELSEIF CURR=MOO %THEN PSTRING(3,MOOFNS(TRIADS(OPD)_OPD1&7))  %C
      %ELSE PSTRING(3,INTRINFNS(TRIADS(OPD)_OPD1&15))
      FORMLINE(CURR,OPD,BR) 
      -> BR
      %FINISH
!  PROCESS OPD2 FIRST IF RTOL(I)=1
      I=0
      %IF RTOL(CURR)&64#0 %AND RTOL(LAST)&64#0 %THENSTART
!FORCE BRACKETS
      %IF ORDER(LAST)>ORDER(CURR) %ORC
        (ORDER(LAST)=2 %AND ORDER(CURR)=2) %THEN PSTRING(3,"(") %AND I=1 
      %FINISH
      %IF RTOL(CURR)&1#0 %THENC   
      GEN(TRIADS(OPD)_QOPD2,TRIADS(OPD)_OPD2,OPD) %ELSEC
      GEN(TRIADS(OPD)_QOPD1,TRIADS(OPD)_OPD1,OPD)
      FORMLINE(TRIADS(OPD)_OP,OPD,BR)
      %IF I=1 %THEN PSTRING(3,")") %AND I=0
BR:
      %IF BRACK>0 %THEN PSTRING(3,")") %AND BRACK=BRACK-1
      %RETURN
SW(LSCALID):   !LOCAL SCALAR                                     LSCALID
SW(OSCALID):   !OWN SCALAR                                       OSCALID
SW(CSCALID):   !COMMON SCALAR                                    CSCALID
SW(PSCALID):   !PARAMETER SCALAR                                 PSCALID
SW(ASCALID):
SW(ARRID):   !ARRAY ID                                         ARRID
      SCAL==RECORD(OPD<<DSCALE+ADICT)
      PSTRING(3,STRING(ANAMES+SCAL_IDEN))
      %RETURN
SW(PERMID):
      S="TI-"
      -> SKIP
SW(TMPID):   !TEMP SCALAR                                      TMPID
      S="TI-"
SKIP:
      TMP==RECORD(OPD<<DSCALE+ADICT)
      PSTRING(3,S)
      ITOS(TMP_INDEX)
      PSTRING(3,INTSTR)
      %RETURN
SW(LABID):  !LABEL IDENTIFIER                                 LABID
      LAB==RECORD(OPD<<DSCALE+ADICT)
      ITOS(LAB_LAB)
      PSTRING(J,INTSTR)
      %RETURN
SW(PLABID):  !PRIVATE LABEL IDENTIFIER                         PLABID
      PLAB==RECORD(ADICT+OPD<<DSCALE)
      LABEL=PLAB_INDEX+100000
      ITOS(LABEL)
      PSTRING(J,INTSTR)
      %RETURN
SW(PROCID):  !PROCEDURE IDENTIFIER                             PROCID
SW(STFNID):  ! STMT. FUNCTION IDENTIFIER
      PROC==RECORD(ADICT+OPD<<DSCALE)
      PSTRING(3,STRING(ANAMES+PROC_IDEN))
      %RETURN
SW(VALTEMP):!  VALUE TEMPORARY                       VALTEMP
      GET VALTEMP(OPD)
      COPYSTR=VALSTR
      S=""
      ->SOUT
SW(DESTEMP):! DESCRIPTOR TEMPORARY               DESTEMP
      %IF COPYFLAG=1 %THEN S = "@" %else S=""
      GET DESCTEMP(OPD)
      COPYSTR=DESCSTR
      ->SOUT
SW(BREG):!Reg-1                                 Reg-1
      COPYSTR=REG1
      S=""
SOUT:
      PSTRING(3,S)
      PSTRING(3,COPYSTR)
      %RETURN
SW(STKLIT):
SW(GLALIT):
      %IF ADJ#0 %THENSTART
         ADR=ADJ
NEXT:
         NO=INTEGER(ADR+ADICT)>>16
         %IF OPD=NO %THENSTART
            ITOS(INTEGER(ADR+ADICT+W2)>>16)
            S="TM-".INTSTR.".."
            SCAL==RECORD(ADICT+(INTEGER(ADR+ADICT+W2)&X'0000FFFF')<<DSCALE)
            NAM=STRING(ANAMES+SCAL_IDEN)
            S=S.NAM
            PSTRING(3,S)
            %RETURN
         %FINISH
         ADR=INTEGER(ADR+ADICT+W1)
         %IF ADR#0 %THEN -> NEXT
      %FINISH
      ITOS(OPD)
      PSTRING(3,"sl")
      PSTRING(3,INTSTR)
      %RETURN
SW(*):
      PRINTSTRING("INVALID OP TYPE TO TRIAD")
      NEWLINE
      %RETURN
%END
!*
!*                  FORM LINE
!*
%ROUTINE FORMLINE(%INTEGER TYPE,LINE,BR)
%INTEGER INDEX,I,NO,LABEL,LINENO,OPTYPE,SPTR,LINK,DICT
%INTEGER DEPTH
%STRING(255) S
%SWITCH SW(0:116)
%STRING(10) S10
%STRING(18) S18
%RECORD(BLRECF) %NAME BLK
%RECORD (SRECF) %NAME SS
%RECORD (LABRECF) %NAME LAB
%RECORD (PRECF) %NAME PP
%RECORD (PLABF) %NAME PLAB
      S10="          "
      S18=S10."        "
       -> SW(TYPE)
SW(EXP3):
      NOLHS=1
      ->SW(BOP)
SW(GE):
SW(GT):
SW(LT):
SW(NE):
SW(EQ):
SW(LE):
! OLD JIF CODE
!      -> SW(BOP)
!      %IF JIFTYPE=1 %THEN TYPE=SWCOND(TYPE-21) %AND JIFTYPE=0
SW(BOP):
SW(ADD):
SW(SUB):
SW(MULT):
SW(DMULT):
SW(DIV):
SW(EQUIV):
SW(NEQ):
SW(CHAR):
      PSTRING(3,OPVALS(TYPE)) 
GET:
SW(NOT):
      %IF TYPE=CVT %THEN I=1 %ELSE I=0
      %IF TYPE=NOT %AND TRIADS(LINE)_QOPD2=NULL %THEN I=1 %ELSEC
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      NOLHS=0
      %IF I=1 %THEN PSTRING(3,")")
      %WHILE BRACK>0 %CYCLE
         PSTRING(3,")")
         BRACK=BRACK-1
      %REPEAT
%RETURN
SW(DINIT):
      PSTRING(3,"@")
SW(ASH):
SW(CVT):
SW(ASMT):
SW(INIT):
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      -> SW(BOP)
SW(ASGN):
      PSTRING(3,OPVALS(TYPE))
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      PSTRING(3," TO ")
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      %RETURN
SW(LOADB):
      PSTRING(3,REG1." = ")
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      %RETURN
SW(STOREB):
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      PSTRING(3," = ".REG1)
      %RETURN
SW(NEG):
      %IF BR=1 %THEN PSTRING(3,")") %AND BR=0
      ->REP
SW(SUBSTR):
      STRINGSET=1
      ->SW(BOP)
SW(CONCAT):
SW(CHHEAD):
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      %RETURN
SW(RET):
      PSTRING(3,"RETURN")
      %IF TRIADS(LINE)_QOPD2=0 %THEN %RETURN %ELSE -> GET
      %RETURN
SW(EXP):
      -> SW(BOP)
SW(DARG):
SW(ARG):
SW(IARG):
      %IF TRIADS(LINE)_QOPD2=0 %THEN %RETURN %ELSE PSTRING(3,",")
      LINE=TRIADS(LINE)_OPD2
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      -> SW(ARG)
SW(SUBR):
      PSTRING(3,"CALL ")
       GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      -> SW(FUN)
SW(NINT):
SW(ANINT):
SW(CMPLX):
SW(CONJG):
SW(IMAG):
SW(REALL):
SW(SIGN):
SW(MOD):
SW(ABS):
SW(AINT):
SW(LEN):
SW(DIM):
SW(CHIND):
SW(ICHAR):
SW(TOCHAR):
      INTRIN0=1
      %IF TRIADS(LINE)_QOPD1#NULL %THEN PSTRING(3,",")
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      INTRIN0=0
      %IF BR=1 %THEN PSTRING(3,")") %AND BR=0
      %RETURN
SW(MIN):
SW(MAX):
      PSTRING(3,",")
      MINMAX=MINMAX+1
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      %IF TRIADS(LINE)_QOPD2#TRIAD %THENSTART
      MAXBRK
      %FINISH

      %RETURN
SW(DEFARR):
SW(FUN):
SW(ARGARR):
SW(IFUN):
SW(ARR):
SW(ARR1):
SW(MOO):
SW(INTRIN):
      PSTRING(3,"(")
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
SW(BRK):
      PSTRING(3,")")
      %RETURN
SW(STMT):
      %if Adoptdata#0 %thenstart
         %IF LINE#NEXTTRNO %THEN -> CONT
         BLK==RECORD(ABLOCKS+NEXTBLK*BLSIZE)
         %IF BLK_DEPTH <7 %THEN DEPTH=BLK_DEPTH*3 %ELSE DEPTH=18
         NEXTBLK=BLK_CHAIN
   ! TO OBTAIN FIRST TRIAD NO IN NEXT BLOCK
         BLK==RECORD(ABLOCKS+NEXTBLK*BLSIZE)
         NEXTTRNO=BLK_TEXT
         COPY(DEPTH,ADDR(S18),1,ADDR(INDENTS),1)
         LENGTH(INDENTS)=DEPTH
      %finish
CONT:
      %IF TRIADS(LINE)_VAL2&X'7F' = 0 %THENSTART
!PLABID
         PLAB==RECORD(ADICT+TRIADS(LINE)_OPD2<<DSCALE)
         %IF PLAB_X1=9 %THENSTART
!SUBPROGRAM ENTRY
            PP==RECORD(ADICT+TRIADS(LINE)_SLN)
            I=(PP_X1>>4)&3
         %IF I=1 %THEN PSTRING(3,FNTYPE(PP_TYPE&X'F'))
            PSTRING(3,ROUTS(I))
         PSTRING(3,STRING(ANAMES+PP_IDEN))
            LINK=PP_LINK2
               %IF I=0 %OR LINK=0 %THEN -> OUT %ELSE PSTRING(3,"(")
            %UNTIL LINK=0 %CYCLE
            DICT=INTEGER(ADICT+LINK)
            LINK=INTEGER(ADICT+LINK+W1)
            PP==RECORD(ADICT+DICT)
               PSTRING(3,STRING(ANAMES+PP_IDEN))
               %IF LINK#0 %THEN PSTRING(3,",") %ELSE PSTRING(3,")")
            %REPEAT
OUT:
            OUTPUTLINE(0)
            %RETURN
         %FINISH
      %FINISH
      LINENO=TRIADS(LINE)_VAL1
    %IF LINENO#0 %THEN ITOS(LINENO) %AND PSTRING(6,INTSTR) 
      TYPE=TRIADS(LINE)_VAL2&X'F'
      %IF TYPE=0 %OR TYPE=1 %THEN %START
         GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
         %FINISH
      %RETURN
SW(EOT):
SW(STOP):
SW(PAUSE):
      PSTRING(3,OPVALS(TYPE))
      %RETURN %IF TYPE=EOT
      I=TRIADS(LINE)_RES1_H0
      %IF TRIADS(LINE)_RES1_FORM#0 %THEN %START
        I=I<<DSCALE
        %IF TRIADS(LINE)_MODE=INT4 %THEN %C
         ITOS(INTEGER(I+ADICT)) %AND PSTRING(3,INTSTR) %ELSESTART
            J=INTEGER(I+ADICT)
            %IF J>255 %THEN J=255
            COPY(J,ADICT,I+4,ADDR(S),1)
            LENGTH(S)=J
! %INCLUDE "targ_text1"
! ****************************************************************************
! include code for EBCDIC/ISO conversion if required
! ****************************************************************************
            PSTRING(3,"'")
            PSTRING(3,S)
            PSTRING(3,"'")
         %FINISH
      %FINISHELSESTART
          ITOS(I) %AND PSTRING(3,INTSTR) %UNLESS I=0
      %FINISH
      %RETURN
SW(INCR):
SW(DECR):
SW(PINCR):
      COPYFLAG=1
      COPYSTR=""
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      PSTRING(3," = ")
      PSTRING(3,COPYSTR)
      PSTRING(3,OPVALS(TYPE))
      COPYSTR=""
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      COPYFLAG=0
      %RETURN
SW(JIF):
!      ->MISSJIF
!      JIFTYPE=1
MISSJIF:
      OPTYPE=TRIADS(LINE)_QOPD1
      S=".NOT.("
      ->JMP
      %IF OPTYPE&TEXTMASK=0 %THEN S=".NOT. " %AND JIFTYPE=0 %AND ->JMP
SW(JIT):
SW(JINP):
SW(JINN):
SW(JINZ):
SW(JIN):
SW(JIP):
SW(JIZ):
      S=""
JMP:
      PSTRING(3,"IF (")
      PSTRING(3,S)
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      PSTRING(3,OPVALS(TYPE))
      PSTRING(3,") GOTO ")
      GEN(TRIADS(LINE)_QOPD2,TRIADS(LINE)_OPD2,LINE)
      %RETURN
SW(RRSUB):
SW(RRDIV):
SW(CGT):
      PSTRING(3,OPVALS(TYPE))
      SPTR=TRIADS(LINE)_OPD2<<DSCALE
      %WHILE SPTR#0 %CYCLE
         SS==RECORD(ADICT+SPTR)
         SPTR=SS_LINK1
         LAB==RECORD(ADICT+SS_INF0)
         %IF LAB_X1&16#0 %THENSTART
           LABEL=LAB_LINK1+100000
           ITOS(LABEL)
         %FINISHELSE ITOS(LAB_LAB)
         PSTRING(3,INTSTR)
         %IF SPTR#0 %THEN PSTRING(3,",") 
      %REPEAT
      PSTRING(3,"), ")
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      %RETURN
SW(GOTO):
      PSTRING(3,OPVALS(TYPE))
      GEN(TRIADS(LINE)_QOPD1,TRIADS(LINE)_OPD1,LINE)
      %RETURN
SW(STRTIO):
      PSTRING(3,OPVALS(TYPE))
      PSTRING(3,IOTYPES(TRIADS(LINE)_OPD2))
      %RETURN
SW(IO):
      PSTRING(3,OPVALS(TYPE))
      %RETURN
SW(IOSPEC):
      PSTRING(3,S10)
      PSTRING(3,IOSPECS(TRIADS(LINE)_QOPD2))
GETITEM:
      GEN(TRIADS(LINE)_RES1_FORM,TRIADS(LINE)_RES1_H0,LINE)
      %RETURN
SW(IOITEM):
SW(DIOITEM):
      PSTRING(3,OPVALS(TYPE))
      -> GETITEM
SW(NOOP):
SW(ITS):
SW(PA):
SW(SUBS):
SW(REF):
SW(IODO):
SW(AND):
SW(OR):
SW(STOD1):
SW(STOD2):
SW(EOD1):
SW(EOD2):
SW(REPL):
SW(STRTSF):
SW(CALLSF):
SW(ENDSF):
      %RETURN
SW(*): PRINTSTRING(" Not allowed for yet")
      WRITE(TYPE,6)
      NEWLINE
REP: %RETURN
%END
!*
!*
!*
!*
      NEXTBLK=1
      NEXTTRNO=1
      SAVE NEXT=1
      spare=""
      J=0
      COMMENT="
        COMMENT  INITIALISATION PERFORMED BY LOADER:
        COMMENT
"
      %IF DESTEMPHEAD#0 %THENSTART
         I=DESTEMPHEAD
         %WHILE I#0 %CYCLE
         DT==RECORD(ADICT+I<<DSCALE)
         %IF DT_FLAGS&INITLOADBIT#0 %THENSTART
            %IF J=0 %THEN PRINTSTRING(COMMENT) %AND J=1
            GETDESCTEMP(I)
            S=DESCSTR
       PRINTSTRING("        COMMENT  ".S." = @".NAM."(")
      ITOS(CONOUT(DT_CONST))
      PRINTSTRING(INTSTR.")")
      NEWLINE
      NAM=""
         %FINISH
         I=DT_CHAIN
      %REPEAT
      %FINISH
      NEWLINE
      %WHILE GET NEXT TRIAD(I,K)#0 %CYCLE
         MINMAX=0
         BRACK=0
         OP=TRIADS(I)_OP
! USE>1 AND NOT A HEAD THEN CREATE A TA TEMPORARY
      %IF TRIADS(I)_USE >1 %AND ENDS(OP)#1 %AND OP#REPL %THENSTART
         ITOS(I)
         PSTRING(3,"TA-")
         PSTRING(3,INTSTR)
      PSTRING(3," = ")
         GEN(TRIADS(I)_QOPD1,TRIADS(I)_OPD1,I)
         FORMLINE(OP,I,COPYBR) %UNLESS OP=MOO
      MAXBRK
         OUTPUTLINE(0)
      %FINISH
         %if ends(op)=1 %or (Op=CVT %and Triads(I)_Qopd1#0) %thenstart
            FORMLINE(OP,I,COPYBR) 
      MAXBRK
            OUTPUTLINE(0)  %UNLESS OP=STMT
            ->OUTER
         %finish
OUTER:
       %REPEAT
      OUTPUTLINE(2) %UNLESS OP=EOT
      NEWLINE
%END
%endoffile