! 18/09/84 - insert switch for STFNID in GEN and delete array QUAL
! 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=1
!   =0  (Emas ISO)
!   =1  (VME  EBCDIC)
!*
%INCLUDE "host_host"
!*
%INCLUDE "targ_target"
!*
!%INCLUDE "pf_version"
!*
%INCLUDE "bits_fmts"
!*
%INCLUDE "bits_consts"
!*
%INCLUDE "bits_triadops"
!*
%INCLUDE "bits_optfmts"
!
%INCLUDE "pf_copy"
!*
%INCLUDE "targ_etoinitoe"
!
%INCLUDE "bits_optdfmt"
!
%INCLUDE "targ_fptos"
!
!*
%OWNINTEGER ADICT
%OWNINTEGER ANAMES
%OWNINTEGER ABLOCKS
%OWNINTEGER BLSIZE
!*
%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=""
%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 "
!*
!*
!*
!*
%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 (18) C,S
%INTEGER I
%STRING(1) NL
      NL="
"
      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
!*
%ROUTINE OUTPUTLINE(%INTEGER I)
%SWITCH SW(0:2)
%STRING(17) S17
%STRING(6) S6
%STRING(8) S8,CON
%STRING(1) NL
      S8="        "
      S17="                 "
      S6="      "
      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 %THEN PRINTSTRING(CURRLINE) %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=""
      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
%RECORD(TRIADF) %ARRAYFORMAT TRFMT(0:20000)
%RECORD(DTRECF) %NAME DT
%RECORD (OPTDFMT) %NAME OPTD
      ADICT=DICT0
      ANAMES=NAMES0
      TRIADS==ARRAY(ATRIADS,TRFMT)
      OPTD==RECORD(ADOPTDATA)
      BLSIZE=OPTD_BLSIZE
      ABLOCKS=OPTD_ABLOCKS

!*
!*
!*
!*     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"
!*
      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&7))
      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):
      %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 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
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"
            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(RSUB):
SW(RDIV):
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)
         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=""
      PRINTSTRING("  LINE   LABEL C OPTIMISED TEXT
")
      NEWLINE
      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 %thenstart
            FORMLINE(OP,I,COPYBR) 
      MAXBRK
            OUTPUTLINE(0)  %UNLESS OP=STMT
            ->OUTER
         %finish
OUTER:
       %REPEAT
      OUTPUTLINE(2) %UNLESS OP=EOT
      NEWLINE
%END
%endoffile