!* modified 21/08/85
!*
%ownstring(31) Versiontext="Fortran77 Compiler Version 0.1"
%owninteger Report=1
%owninteger Decode
%owninteger Language
%owninteger Nextprocid
!*
%constinteger IMP      =  1
%constinteger FORTRAN  =  2
%constinteger CCOMP    = 11
%constinteger PASCAL   = 14
!*
!***********************************************************************
!* Exports                                                             *
!***********************************************************************
!*
%routinespec Einitialise(%integer Lang, Avertext, Astackca,
                                                    Aglaca, Options)
%routinespec Eterminate(%integer adareasizes)
%routinespec Ecommon(%integer area, %stringname Name)
%routinespec Eendcommon(%integer area, Length)
%routinespec Elinestart(%integer lineno)
%routinespec Elinedecode
%routinespec Emonon
%routinespec Emonoff
%routinespec Efaulty
%integerfnspec Estkmarker
%routinespec Esetmarker(%integer Markerid, New Value)
%integerfnspec Eswapmode
!*
%routinespec Estklit(%integer Val)
%routinespec Estkconst(%integer Len, Ad)
%routinespec Estkdir(%integer Area, Offset, Adid, Bytes)
%routinespec Estkind(%integer Area, Offset, Adid, Bytes)
%routinespec Estkglobal(%integer Level, Offset, Adid, Bytes)
%routinespec Estkglobalind(%integer Level, Offset, Adid, Bytes)
%routinespec Estkpar(%integer Level, Offset, Adid, Bytes)
%routinespec Estkparind(%integer Level, Offset, Adid, Bytes)
%routinespec Estkresult(%integer Class, Type, Bytes)
%routinespec Erefer(%integer Offset, Bytes)
%routinespec Epromote(%integer Level)
%routinespec Estkaddr(%integer Area, Offset, Adid, Bytes)
%routinespec Estkgaddr(%integer Area, Offset, Adid, Bytes)
%routinespec Estkpaddr(%integer Area, Offset, Adid, Bytes)
!*
%routinespec Elabel(%integer id)
%routinespec Eboundlab(%integer id)
%routinespec Ediscardlabel(%integer id)
%routinespec Ejump(%integer Opcode, Labelid)
%routinespec Etwjump(%integer Opcode, Lab1, Lab2, Lab3)
%routinespec Eswitch(%integer Lower, Upper, Switchid, Errlabid,
                                                     %integername SSTad)
%routinespec EswitchJump(%integer Switchid)
%routinespec EfswitchJump(%integer Switchid)
%routinespec Eswitchentry(%integer Switchid, Entry)
%routinespec Eswitchdef(%integer Switchid)
%routinespec EswitchLabel(%integer Switchid, Entry, Labelid)
!*
%routinespec Ed1(%integer area, Disp, Val)
%routinespec Ed2(%integer area, Disp, Val)
%routinespec Ed4(%integer area, Disp, Val)
%routinespec Edbytes(%integer area, Disp, len, ad)
%routinespec Edpattern(%integer area, Disp, ncopies, len, ad)
%routinespec Efix(%integer area, disp, tgtarea, tgtdisp)
!*
%integerfnspec EXname(%integer type, %string(255)%name Xref)
%routinespec Eprecall(%integer Id)
%routinespec Ecall(%integer Id, Numpars, Paramsize)
%routinespec Eprocref(%integer Id, Level)
%routinespec Esave(%integer Asave, %integername Key)
%routinespec Erestore(%integer Asave, Key, Existing)
!*
%integerfnspec Enextproc
%routinespec Eproc(%stringname Name, %integer Props,
                          Numpars, Paramsize, Astacklen, %integername Id)
%routinespec Eprocend(%integer Localsize, Diagdisp, Astacklen)
%routinespec Eentry(%integer Index,Numpars,Paramsize, Localsize, Diagdisp,
                                                       %stringname Name)
!*
%routinespec Edataentry(%integer Area, Offset, Length,
                                                       %stringname Name)
%routinespec Edataref(%integer Area, Offset, Length,
                                                       %stringname Name)
!*
%routinespec Eop(%integer Opcode)
%routinespec Ef77op(%integer Opcode)
%routinespec Epasop(%integer Opcode)
%routinespec Eccop(%integer Opcode)
!*
!*
!***********************************************************************
!* Imports                                                             *
!***********************************************************************
!*
!%include "ercs12:ib4_specs"
!%include "cfort_xaspecs"
!%include "cfort_ecodes"
!%include "cfort_xamnem"
!
!************************************************************************
!*                                                                      *
!*                                                    G.E.Millard       *
!*   ECODES                                           10/08/85          *
!*                                                                      *
!************************************************************************
!
{00} %constinteger      HALT =   0
!
!--------------------------------------- 32-bit (Etos) ----------------
!
{01} %constinteger      IADD =   1     { (Etos-1) + (Etos) => (Etos)   }
{02} %constinteger      ISUB =   2     { (Etos-1) - (Etos) => (Etos)   }
{03} %constinteger     IMULT =   3     { (Etos-1) * (Etos) => (Etos)   }
{04} %constinteger      IDIV =   4     { (Etos-1) / (Etos) => (Etos)   }
{05} %constinteger      INEG =   5     {          - (Etos) => (Etos)   }
{06} %constinteger      IABS =   6     {     abs( (Etos) ) => (Etos)   }
{07} %constinteger      IREM =   7     { remainder from                }
                                       {  (Etos-1) / (Etos)=> (Etos)   }
!
{08} %constinteger      IAND =   8     { (Etos-1) & (Etos) => (Etos)   }
{09} %constinteger       IOR =   9     { (Etos-1) ! (Etos) => (Etos)   }
{0A} %constinteger      INOT =  10     {          ~ (Etos) => (Etos)   }
{0B} %constinteger      IXOR =  11     { (Etos-1) !! (Etos) => (Etos)  }
{0C} %constinteger     ISHLL =  12     { (Etos-1) << (Etos) => (Etos)  }
{0D} %constinteger     ISHRL =  13     { (Etos-1) >> (Etos) => (Etos)  }
{0E} %constinteger     ISHLA =  14     { arithmetic left shift         }
{0F} %constinteger     ISHRA =  15     { arithmetic right shift        }
!
{10} %constinteger       IGT =  16     { if                            }
{11} %constinteger       ILT =  17     {    (Etos-1) <relop> (Etos)    }
{12} %constinteger       IEQ =  18     { then                          }
{13} %constinteger       INE =  19     {    true  (1) => (Etos)        }
{14} %constinteger       IGE =  20     { else                          }
{15} %constinteger       ILE =  21     {    false (0) => (Etos)        }
!
{18} %constinteger      JIGT =  24     { if                            }
{19} %constinteger      JILT =  25     {    (Etos-1) <relop> (Etos)    }
{1A} %constinteger      JIEQ =  26     { then                          }
{1B} %constinteger      JINE =  27     {    -> <label>                 }
{1C} %constinteger      JIGE =  28     { else                          }
{1D} %constinteger      JILE =  29     {    continue                   }
!
!--------------------------------------- generic (Etos) ---------------
!
{1E} %constinteger    JINTGZ =  30     { if (Etos) > 0 %then -> <lab>  }
{1F} %constinteger    JINTLZ =  31     { if (Etos) < 0 %then -> <lab>  }
{20} %constinteger     JINTZ =  32     { if (Etos) = 0 %then -> <lab>  }
{21} %constinteger    JINTNZ =  33     { if (Etos) # 0 %then -> <lab>  }
{22} %constinteger   JINTGEZ =  34     { if (Etos) >=0 %then -> <lab>  }
{23} %constinteger   JINTLEZ =  35     { if (Etos) <=0 %then -> <lab>  }
! 
{24} %constinteger      ITWB =  36     { if (Etos) < 0 then -> <lab1>  } 
                                       {           = 0 then -> <lab2>  }
                                       {           > 0 then -> <lab3>  }
!
{26} %constinteger      JUMP =  38     { -> <label>                    }
{29} %constinteger       SFA =  41     { SF => (Etos)                  }
{2A} %constinteger    RETURN =  42     { procedure exit                }
{2B} %constinteger      ASF  =  43     { SF = SF + (Etos)              }
!
{2C} %constinteger     IPUSH =  44     { (Etos) => (Mstack)            }
{2D} %constinteger      IPOP =  45     { (Mstack) => (Etos)            }
{2E} %constinteger      EXCH =  46     { (Etos-1) <=> (Etos)           }
{2F} %constinteger      DUPL =  47     { replicate (Etos)              }
{30} %constinteger   DISCARD =  48     { discard (Etos)                }
!
{33} %constinteger    INDEX1 =  51     { (@ Etos-1) + (Etos)           }
                                       {               => (@ Etos)     }
{34} %constinteger    INDEX2 =  52     { (@ Etos-1) + (Etos)*2         }
                                       {               => (@ Etos)     }
{35} %constinteger    INDEX4 =  53     { (@ Etos-1) + (Etos)*4         }
                                       {               => (@ Etos)     }
{36} %constinteger    INDEX8 =  54     { (@ Etos-1) + (Etos)*8         }
                                       {               => (@ Etos)     }
{37} %constinteger     INDEX =  55     { (@ Etos-2)                    }
                                       {     + (Etos-1)*(Etos)         }
                                       {               => (@ Etos)     }
!
{38} %constinteger       MVB =  56     { move (Etos) bytes             }
                                       {  ((@ Etos-2)) => ((@ Etos-1)) }
!
{39} %constinteger       CHK =  57     { check that                    }
                                       { (Etos-1)<=(Etos-2)<=(Etos)    }
                                       { (Etos-2) => (Etos)            }
!
{3A} %constinteger     TMASK =  58     { (Etos-1) & (Etos)             }
                                       { - to be followed by JI[N]Z    }
!
{3E} %constinteger     CPBGT =  62     { if (Etos) bytes               }
{3F} %constinteger     CPBLT =  63     {  ((Etos-2)) <relop> ((Etos-1))}
{40} %constinteger     CPBEQ =  64     { then                          }
{41} %constinteger     CPBNE =  65     {    true  (1) => (Etos)        }
{42} %constinteger     CPBGE =  66     { else                          }
{43} %constinteger     CPBLE =  67     {    false (0) => (Etos)        }
!
!-------------------------------------- generic real operations -------
!
{71} %constinteger     RADD = 113     { (Etos-1) + (Etos) => (Etos)    }
{72} %constinteger     RSUB = 114     { (Etos-1) - (Etos) => (Etos)    }
{73} %constinteger    RMULT = 115     { (Etos-1) * (Etos) => (Etos)    }
{74} %constinteger     RDIV = 116     { (Etos-1) / (Etos) => (Etos)    }
{75} %constinteger     RNEG = 117     {        - (Etos) => (Etos)      }
{76} %constinteger     RABS = 118     {   abs( (Etos) ) => (Etos)      }
!
{88} %constinteger    CVTII = 136     { (int Etos-1) => int size(Etos) }
{89} %constinteger    CVTIR = 137     { (int Etos-1) => real size(Etos)}
{8A} %constinteger    CVTRR = 138     { (real Etos-1)=> real size(Etos)}
{8B} %constinteger    TNCRI = 139     { (real Etos-1)=> int size(Etos) }
{8C} %constinteger    RNDRI = 140     { (real Etos-1)=> int size(Etos) }
!
!--------------------------------------- generic real operations ------
!
{90} %constinteger       RGT = 144     { if                            }
{91} %constinteger       RLT = 145     {    (Etos-1) <relop> (Etos)    }
{92} %constinteger       REQ = 146     { then                          }
{93} %constinteger       RNE = 147     {    1 => (Etos)                }
{94} %constinteger       RGE = 148     { else                          }
{95} %constinteger       RLE = 149     {    0 => (Etos)                }
!
{96} %constinteger      JRGT = 150     { if                            }
{97} %constinteger      JRLT = 151     {    (Etos-1) <relop> (Etos)    }
{98} %constinteger      JREQ = 152     { then                          }
{99} %constinteger      JRNE = 153     {    -> <label>                 }
{9A} %constinteger      JRGE = 154     { else                          }
{9B} %constinteger      JRLE = 155     {    continue                   }
!
{9C} %constinteger      JRGZ = 156     { if (Etos) > 0 %then -> <lab>  }
{9D} %constinteger      JRLZ = 157     { if (Etos) < 0 %then -> <lab>  }
{9E} %constinteger       JRZ = 158     { if (Etos) = 0 %then -> <lab>  }
{9F} %constinteger      JRNZ = 159     { if (Etos) # 0 %then -> <lab>  }
{A0} %constinteger     JRGEZ = 160     { if (Etos) >=0 %then -> <lab>  }
{A1} %constinteger     JRLEZ = 161     { if (Etos) <=0 %then -> <lab>  }
!
{A2} %constinteger      RTWB = 162     { if (Etos) < 0 then -> <lab1>  }
                                       {           = 0 then -> <lab2>  }
                                       {           > 0 then -> <lab3>  }
{A3} %constinteger     JTRUE = 163     { if (Etos) true  then -> <lab  }
{A4} %constinteger    JFALSE = 164     { if (Etos) false then -> <lab> }
!
!----------------------------------------------------------------------
!
{B1} %constinteger    UCHECK = 177    { if (Etos) unassigned diagnose  }
{B8} %constinteger    ESTORE = 184    { ((Etos)) = (Etos-1)            }
{B9} %constinteger EDUPSTORE = 185    { ((Etos)) = (Etos-1)            }
                                      { retain (Etos-1) as new (Etos)  }
{BA} %constinteger   PUSHVAL = 186    { push (Etos) as value param     }
{BB} %constinteger  PUSHADDR = 187    { push (Etos) as ref param       }
{BC} %constinteger      EVAL = 188    { force load of (Etos)           }
{BD} %constinteger  EVALADDR = 189    { force load of @ at (Etos)      }
{BE} %constinteger  EADDRESS = 190    { address(Etos) is required      }
{BF} %constinteger   EINTRES = 191    { (Etos) is integer fn result    }
{C0} %constinteger  EREALRES = 192    { (Etos) is real fn result       }
{C1} %constinteger     ESIZE = 193    { size of (Etos-1) is (Etos)     }

{C2}%constinteger     EPOWER = 194    { (Etos-3) @ result if cx        }
                                      { (Etos-2) base (@ base if cx)   }
                                      { (Etos-1) power(@ power if cx)  }
                                      { (Etos)   procindex             }

{C3}%constinteger    EPOWERI = 195    { (Etos-2) base                  }
                                      { (Etos-1) power (int)           }
                                      { (Etos)   procindex (0-3)       }

                                      { procindex =  0  powii          }
                                      {              1  powri          }
                                      {              2  powdi          }
                                      {              3  powqi          }
                                      {              4  powci          }
                                      {              5  powzi          }
                                      {              6  powzzi         }
                                      {              9  powrr          }
                                      {             10  powdd          }
                                      {             11  powqq          }
                                      {             12  powcc          }
                                      {             13  powzz          }
                                      {             14  powzzz         }
!
!***********************************************************************
!*                                                                     *
!*         Fortran specific codes                                      *
!*                                                                     *
!***********************************************************************
!
%constinteger CXADD       = 257       { ((Etos-3)) = ((Etos-2))        }
%constinteger CXSUB       = 258       {                      op        }
%constinteger CXMULT      = 259       {                      ((Etos-1))}
%constinteger CXDIV       = 260       { (Etos) = variant<<8 ! sizecode }

%constinteger CXNEG       = 261       { ((Etos-2)) = - ((Etos-1))      }
                                      { (Etos) = sizecode              }

%constinteger CXASGN      = 262       { ((Etos-2)) = ((Etos-1))        }
                                      { (Etos) = variant<<8            }
                                      {            ! sizecode(RHS)<<2  }
                                      {              ! sizecode(LHS)   }

%constinteger CXEQ        = 263       { (Etos) =  ((Etos-2))           }
%constinteger CXNE        = 264       {                  op ((Etos-1)) }
                                      { (Etos) = variant<<8 ! sizecode }

%constinteger ECMPLX2     = 287       { ((Etos-3))=((Etos-2),(Etos-2)) }
                                      { (Etos) = sizecode              }

%constinteger ECONJG      = 279       { ((Etos-2) =  conjg((Etos-1))   }
                                      { (Etos) = sizecode              }

                                      { variant  = 0    cx op cx       }
                                      {            1    cx op real     }
                                      {            2  real op cx       }
                                      { sizecode = 0    c*8   (r*4)    }
                                      {            1    c*16  (r*8)    }
                                      {            2    c*32  (r*16)   }

%constinteger EM1EXP      = 267       { (Etos) = (-1) ** (Etos) - int  }

%constinteger EISIGN      = 268       { (Etos) = sign(Etos)            }
%constinteger ESIGN       = 269       {                  * abs(Etos-1) }

%constinteger EIMOD       = 270       { (Etos) = int(Etos-1)/(Etos)    }
%constinteger ERMOD       = 271       {                       * (Etos) }

%constinteger EIDIM       = 272       { (Etos) = if (Etos-1) > (Etos)  }
%constinteger ERDIM       = 273       {          then (Etos-1)-(Etos)  }
                                      {          else 0

%constinteger EIMIN       = 274       { (Etos) = min( (Etos-1),        }
%constinteger ERMIN       = 275       {                (Etos) )        }

%constinteger EIMAX       = 276       { (Etos) = max( (Etos-1),        }
%constinteger ERMAX       = 277       {                (Etos) )        }

%constinteger EDMULT      = 278       { (Etos) = dble((Etos-1)*(Etos)) }

%constinteger ECHAR       = 280       {  ((Etos-1)) = char(Etos)       }
%constinteger EICHAR      = 281       {      (Etos) = ichar((Etos-1))  }

%constinteger EINDEXCHAR  = 282       {      (Etos) = index( C1,C2 )   }
                                      {  ((Etos-3)) = Charad(C1)       }
                                      {   (Etos-2)  = Charlen(C1)      }
                                      {  ((Etos-1)) = Charad(C2)       }
                                      {    (Etos)   = Charlen(C2)      }

%constinteger ECONCAT     = 283       {          C1 = concat list      }
                                      {  ((Etos-3)) = Charad(C1)       }
                                      {   (Etos-2)  = Charlen(C1)      }
                                      {  ((Etos-1)) = @ concat table   }
                                      {    (Etos)   = no. items        }

%constinteger EASGNCHAR   = 284       {          C1 = C2               }
                                      {  ((Etos-3)) = Charad(C1)       }
                                      {   (Etos-2)  = Charlen(C1)      }
                                      {  ((Etos-1)) = Charad(C2)       }
                                      {    (Etos)   = Charlen(C2)      }

%constinteger ECOMPCHAR   = 285       {     (Etos) = compare( C1,C2 )  }
                                      {  ((Etos-4)) = Charad(C1)       }
                                      {   (Etos-3)  = Charlen(C1)      }
                                      {  ((Etos-2)) = Charad(C2)       }
                                      {   (Etos-1)  = Charlen(C2)      }
                                      {    (Etos)   = relop            }
                                      {  relop  =  0 >   1 <   2 =     }
                                      {            3 #   4 >=  5 <=    }

%constinteger EISHFT      = 288       { (Etos) = (Etos-1) << (Etos)    }
%constinteger EIBITS      = 289       { (Etos) = (Etos) bits from      }
                                      {       bit (Etos-1) in (Etos-2) }
%constinteger EIBSET      = 290       { (Etos) = (Etos-1)&(1<<(Etos))  }
%constinteger EIBTEST     = 291       { (Etos) = (Etos-1)!(1<<(Etos))  }
%constinteger EIBCLR      = 292       { (Etos) = (Etos-1)&\(1<<(Etos)) }
%constinteger EISHFTC     = 293       { (Etos) = (Etos-1) <<c (Etos)   }

%constinteger PROCARG     = 294
%constinteger IPROCARG    = 295
%constinteger CHARARG     = 296
%constinteger IPROCCALL   = 297
%constinteger ARGPROCCALL = 298
%constinteger CALLTPLATE  = 299
%constinteger NOTEIORES   = 300
%constinteger STKIORES    = 301

%constinteger EFCVT       = 302       { convert(Etos-1)                }
                                      { (Etos)      convert code       }
%constinteger EFCVTASGN   = 303       { (Etos-1) =  convert(Etos-2)    }
                                      { (Etos)      convert code       }
                                      { convert code=oldmode<<3!newmode}
                                      { mode =[0  bit - futures]       }
                                      {        1  I1 (byte)            }
                                      {        2  I2                   }
                                      {        3  I4                   }
                                      {        4  I8                   }
                                      {        5  R4                   }
                                      {        6  R8                   }
                                      {        7  R16                  }

%constinteger EARGLEN     = 304       { (Etos) is char arg len         }
                                      {   - on Amdahl load bottom half }

%constinteger EFDVACC     = 305       { dope vector special evaluation }
                                      { (Etos-1) => (Etos)             }
                                      { (Etos-2) + (Etos-1)*(Etos)     }
                                      {                => (Etos-1)     }
!
!*
!*
!***********************************************************************
!*        Common declarations                                          *
!***********************************************************************
!*
!*
%conststring(9)%array Eopname(0:255) = %c
{00} "HALT","IADD","ISUB","IMULT",  "IDIV" ,"INEG" ,"IABS" ,"IREM" ,
{08} "IAND","IOR" ,"INOT","IXOR" ,  "ISHLL","ISHRL","ISHLA","ISHRA",
{10} "IGT" ,"ILT" ,"IEQ" ,"INE"  ,  "IGE"  ,"ILE"  ,""     ,""     ,
{18} "JIGT","JILT","JIEQ","JINE" ,  "JIGE" ,"JILE" ,"JINTGZ","JINTLZ",
{20} "JINTZ","JINTNZ","JINTGEZ","JINTLEZ",  "ITWB" ,"","JUMP","",
{28} ""       ,"SFA"  ,"RETURN" ,"ASF" , "IPUSH" ,"IPOP"  ,"EXCH"  ,"DUPL",
{30} "DISCARD",""     ,""     ,"INDEX1", "INDEX2","INDEX4","INDEX8","INDEX",
{38} "MVB"    ,"CHK"  ,"TMASK" ,""     , ""      ,""      ,"CPBGT" ,"CPBLT",
{40} "CPBEQ"  ,"CPBNE","CPBGE","CPBLE" , "","","","", 
{48} "","","","", "","","","",
{50} "","","","", "","","","",
{58} "","","","", "","","","",
{60} "","","","", "","","","",
{68} "","","","", "","","","",
{70} ""     ,"RADD" ,"RSUB" ,"RMULT","RDIV" ,"RNEG" ,"RABS",""   ,
{78} "","","","", "","","","",
{80} "","","","", "","","","",
{88} "CVTII","CVTIR","CVTRR","TNCRI", "RNDRI","FLOOR","","",
{90} "RGT"  ,"RLT"  ,"REQ" ,"RNE"  ,"RGE"   ,"RLE" ,"JRGT","JRLT",
{98} "JREQ" ,"JRNE" ,"JRGE","JRLE" ,"JRGZ"  ,"JRLZ","JRZ" ,"JRNZ",
{A0} "JRGEZ","JRLEZ","RTWB","JTRUE","JFALSE",""    ,""    ,""    ,
{A8} ""     ,""     ,""    ,""     , ""     ,""    ,""    ,""    ,
{B0} ""     ,"UCHECK","FLTR","FLTD","FLTQ"  ,""    ,""    ,""    ,
{B8} "ESTORE","EDUPSTORE","PUSHVAL","PUSHADDR",
{BC} "EVAL" ,"EVALADDR","EADDRESS","EINTRES",
{C0} "EREALRES","ESIZE","EPOWER"  ,"EPOWERI", "","","","",
{C8} "","","","", "","","","",
{D0} "","","","", "","","","",
{D8} "","","","", "","","","",
{E0} "","","","", "","","","",
{E8} "","","","", "","","","",
{F0} "","","","", "","","","",
{F8} "","","","", "","","",""
!*
%conststring(11)%array Ef77opname(256:319)= %c
{100} ""           ,"CXADD"       ,"CXSUB"      ,"CXMULT"     ,
{104} "CXDIV"      ,"CXNEG"       ,"CXASGN"     ,"CXEQ"       ,
{108} "CXNE"       ,"EPOWER"      ,"EPOWERI"    ,"EM1EXP"     ,
{10C} "ESIGN"      ,"ESIGN"       ,"EIMOD"      ,"ERMOD"      ,
{110} "EIDIM"      ,"ERDIM"       ,"EIMIN"      ,"ERMIN"      ,
{114} "EIMAX"      ,"ERMAX"       ,"EDMULT"     ,"ECONJG"     ,
{118} "ECHAR"      ,"EICHAR"      ,"EINDEXCHAR" ,"ECONCAT"    ,
{11C} "EASGNCHAR"  ,"ECOMPCHAR"   ,""           ,"ECMPLX2"    ,
{120} "EISHFT"     ,"EIBITS"      ,"EIBSET"     ,"EIBTEST"    ,
{124} "EIBCLR"     ,"EISHFTC"     ,"PROCARG"    ,"IPROCARG"   ,
{128} "CHARARG"    ,"IPROCCALL"   ,"ARGPROCCALL","CALLTPLATE" ,
{12C} "NOTEIORES"  ,"STKIORES"    ,"EFCVT"      ,"EFCVTASGN"  ,
{130} "EARGLEN"    ,"EFDVACC"     ,""           ,""           ,
{134} ""           ,""            ,""           ,""           ,
{138} ""           ,""            ,""           ,""           ,
{13C} ""           ,""            ,""           ,""           
!*
!***********************************************************************
!*
%constinteger CONST   = 0
%constinteger INREG   = 1
%constinteger INFREG  = 2
%constinteger INTEMP  = 3
%constinteger DIRECT  = 4
%constinteger INDIRECT= 5
%constinteger MODIFIED= 8
%constinteger ADDRESSED=16
!*
%recordformat Stkfmt(%byteinteger Form,Size,Reg,Modreg,
                                  Base,Modbase,Scale,Modform,
                      (%integer Offset %or %integer Intval),
                      (%integer Modoffset %or %integer Modintval),
                      %integer Adid)
!*
%ownrecord(Stkfmt)%array Stk(0:15)
!*
%owninteger Elevel
!*
!*
!***********************************************************************
!*        Amdahl-specific declarations                                 *
!***********************************************************************
!*
!*
%constinteger R0  =  0
%constinteger R1  =  1
%constinteger R2  =  2
%constinteger R3  =  3
%constinteger R4  =  4
%constinteger R5  =  5
%constinteger R6  =  6
%constinteger R7  =  7
%constinteger R8  =  8
%constinteger R9  =  9
%constinteger R10 = 10
%constinteger R11 = 11
%constinteger R12 = 12
%constinteger R13 = 13
%constinteger R14 = 14
%constinteger R15 = 15
!*
%constbyteintegerarray Setcc(0:5)=2,4,8,6,10,12   {GT LT EQ NE GE LE}
%constbyteintegerarray Invcc(0:15)=0,1,4,5,2,3,6,7,8,9,12,13,10,11,14,15
!*
%constinteger Stack Offset=64
%constinteger Param Offset=64
!*
%constintegerarray Cnstinit(0:9)= 0,0,
 X'4E000000', X'80000000',
 X'4E000001', X'00000000',
 X'4F000000', X'08000000',
 X'82828282', X'82828282'
%constinteger TWO31 =  8
%constinteger TWO32 = 16
%constinteger TWO31R= 24
!*
!***********************************************************************
!*
%ownintegerarray Areabase(0:255)
%ownintegerarray Ruse(0:15)
%ownintegerarray Fruse(0:6)
!*
%owninteger Addrstackca, Addrglaca
%owninteger Upperlineno
%owninteger UsingR14, UsingR15, Lastreg, Lastbreg, Lastfreg, Max4k
%owninteger CC, CCset
%owninteger Stackframe
%owninteger Glaf77regs,Glawork,Curdiagca
%owninteger CurCnst
%owninteger Next Param Offset
!*
!*
!***********************************************************************
!*        Code generation procedure specs                              *
!***********************************************************************
!*
!*
!*
!***********************************************************************
!*
%ownstring(8)%array Areas(0:255)=  %c
   "Stack","Code","Gla","","Ust","Gst","Diags","Scalars",
   "Ioarea","","Consts",""(245)
!*
%routine Phex(%integer Val)
%conststring(1)%array C(0:15)=  %c
   "0","1","2","3","4","5","6","7",
   "8","9","A","B","C","D","E","F"
%integer I
      %cycle I=28,-4,0
         printstring(C((Val>>I)&15))
      %repeat
%end
!*
%routine Dump Estack
%integer I,J,K
      %if Elevel<=0 %then %return
      printstring("Estack:
")
      I=Elevel
      %while I>0 %cycle
         J=addr(Stk(I))
         %cycle K=0,4,16
            Phex(integer(J+K))
            space
         %repeat
         I=I-1
         newline
      %repeat
%end;! Dump Estack
!*
!*
!**********************************************************************
!**********************************************************************
!**                      Error reporting                             **
!**********************************************************************
!**********************************************************************
!*
!*
%routine Low Estack(%integer Opcode,Reqlevel)
      printstring("******* Estack error ******
  Op = ".Eopname(Opcode)."  actual/required levels:")
      write(Elevel,4)
      write(Reqlevel,4)
      newline
      Elevel=0
%end;! Low Estack
!*
%routine Abort
       %monitor
       %stop
%end;! Abort
!*
%routine Unsupported Opcode(%integer Opcode)
%string(15) S
      %if Opcode<=255 %then S=Eopname(Opcode) %else S=Ef77opname(Opcode)
      printstring("******* Unsupported Opcode ****** ".S)
      newline
%end;! Unsupported Opcode
!*
!*
!***********************************************************************
!***********************************************************************
!**             Externally visible procedures                         **
!***********************************************************************
!***********************************************************************
!*
!*
!*                    *********************
!*                    *  Administration   *
!*                    *********************
!*
!*
%externalroutine Einitialise(%integer Lang,Aver,Astackca,Aglaca,options)
!***********************************************************************
!* called once at the start of compilation to initialise Eput          *
!***********************************************************************
%integer I,Flags
      Report=options&1
      Decode=Options&X'4000'
      Language=Lang
      %if Report#0 %thenstart
         printstring("Einitialise ")
         newline
      %finish
      Nextprocid=1000
%end;! Einitialise
!*
%externalroutine Eterminate(%integer adareasizes)
!***********************************************************************
!* called once at the end of compilation by the code generator         *
!***********************************************************************
%ownintegerarray S(1:10)
%integer I,J
      %if Report#0 %thenstart
         printstring("Eterminate ")
         newline
      %finish
%end;! Eterminate
!*
%externalroutine Ecommon(%integer area,%stringname Name)
!***********************************************************************
!* define a common area (in range 11-255)                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ecommon   ");Write(Area,1);spaces(4);printstring(Name) 
         Newline
      %finish
%end;! Ecommon
!*
%externalroutine Eendcommon(%integer area,Length)
!***********************************************************************
!* define length of previously defined common                          *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eendcommon   ");write(Area,1);write(Length,6) 
         Newline
      %finish
%end;! Eendcommon
!*
%externalroutine Elinestart(%integer lineno)
!***********************************************************************
!* register start of a line                                            *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Elinestart ");write(Lineno,4)
         newline
      %finish
%end;! Elinestart
!*
%externalroutine Elinedecode
!***********************************************************************
!* decompile code generated from last Elinedecode or Elinestart        *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Elinedecode ");
         newline
      %finish
%end;! Elinedecode
!*
%externalintegerfn Estkmarker
!***********************************************************************
!* turn on internal tracing                                            *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkmarker  ")
         newline
      %finish
      %result=0
%end;! Estkmarker
!*
%externalroutine Esetmarker(%integer Markerid,New Value)
!***********************************************************************
!* turn off internal tracing                                           *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Esetmarker  ");write(Markerid,4)
         write(New Value,4)
         newline
      %finish
%end;! Esetmarker
!*
%externalintegerfn Eswapmode
!***********************************************************************
!* turn on internal tracing                                            *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eswapmode  ")
         newline
      %finish
      %result=0
%end;! Eswapmode
!*
%externalroutine Emonon
!***********************************************************************
!* turn on internal tracing                                            *
!***********************************************************************
      Report=1
%end;! Emonon
!*
%externalroutine Emonoff
!***********************************************************************
!* turn off internal tracing                                           *
!***********************************************************************
      Report=0
%end;! Emonoff
!*
%externalroutine Efaulty
!***********************************************************************
!* compilation has a fault - no object file to be generated            *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Efaulty ");
         newline
      %finish
%end;! Efaulty
!*
!*
!*
!*                 *********************
!*                 * Stack operations  *
!*                 *********************
!*
!*
%externalroutine Estklit(%integer Val)
!***********************************************************************
!* stacks Val as a 32-bit integer literal                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estklit  ");write(Val,6)
         newline
      %finish
%end;! Estklit
!*
%externalroutine Estkconst(%integer Len,Ad)
!***********************************************************************
!* stacks the constant, allocating space for it if necessary           *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkconst     ")
         write(Len,4); spaces(2)
         phex(integer(ad)); space
         %if len>4 %then phex(integer(ad+4))
         newline
      %finish
%end;! Estkconst
!*
%externalroutine Estkrconst(%integer Len,Ad)
!***********************************************************************
!* stacks the constant, allocating space for it if necessary           *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkrconst     ")
         write(Len,4)
         newline
      %finish
%end;! Estkconst
!*
%externalroutine Estkdir(%integer Area,Offset,Adid,Bytes)
!***********************************************************************
!* stacks a direct operand                                             *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkdir   ".Areas(area)." +");write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkdir
!*
%externalroutine Estkind(%integer Area,Offset,Adid,Bytes)
!***********************************************************************
!* stacks an indirect operand                                          *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkind   ".Areas(area)." +");write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkind
!*
%externalroutine Estkglobal(%integer Level,Offset,Adid,Bytes)
!***********************************************************************
!* stacks a direct operand local to an enclosing level                 *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkglobal ");write(Level,1);write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkglobal
!*
%externalroutine Estkglobalind(%integer Level,Offset,Adid,Bytes)
!***********************************************************************
!* stacks an indirect operand local to an enclosing level              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkglobalind ");write(Level,1);write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkglobalind
!*
%externalroutine Estkpar(%integer Level,Offset,Adid,Bytes)
!***********************************************************************
!* stacks a direct parameter operand                                   *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkpar   ");write(Level,1);write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkpar
!*
%externalroutine Estkparind(%integer Level,Offset,Adid,Bytes)
!***********************************************************************
!* stacks an indirect parameter operand                                *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkparind ");write(Level,1);write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkparind
!*
%externalroutine Estkresult(%integer Class,Type,Bytes)
!***********************************************************************
!* defines the result stacked by a function call                       *
!* Type = 1  int                                                       *
!*      = 2  real                                                      *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkresult ")
         write(Class,4);write(Type,4);write(Bytes,4)
         newline
      %finish
%end;! Estkresult
!*
%externalroutine Erefer(%integer Offset,Bytes)
!***********************************************************************
!* stacks the address of a direct operand                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Erefer   ");write(Offset,1);write(Bytes,6)
         newline
      %finish
%end;! Erefer
!*
%externalroutine Epromote(%integer Level)
!***********************************************************************
!* move the entry at Level in Estack to the top of the Estack          *
!*  - the top entry is at level 1                                      *
!***********************************************************************
%record(Stkfmt) E 
%integer I
      %if Report#0 %thenstart
         printstring("Epromote ");write(Level,4)
         newline
      %finish
%end;! Epromote
!*
%externalroutine Edemote(%integer Level)
!***********************************************************************
!* move the entry at Level in Estack to the top of the Estack          *
!*  - the top entry is at level 1                                      *
!***********************************************************************
%record(Stkfmt) E 
%integer I
      %if Report#0 %thenstart
         printstring("Edemote ");write(Level,4)
         newline
      %finish
%end;! Edemote
!*
%externalroutine Estkaddr(%integer Area,Offset,Adid,Bytes)
!***********************************************************************
!* stacks the address of a direct operand                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkaddr   ".Areas(area)." +");write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkaddr
%externalroutine Estkgaddr(%integer Area,Offset,Adid,Bytes)
!***********************************************************************
!* stacks the address of a direct operand                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkgaddr   ".Areas(area)." +");write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkgaddr
%externalroutine Estkpaddr(%integer Area,Offset,Adid,Bytes)
!***********************************************************************
!* stacks the address of a direct operand                              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Estkpaddr   ".Areas(area)." +");write(Offset,1)
         write(Bytes,6)
         %if Adid#0 %then spaces(4) %and printstring(string(Adid))
         newline
      %finish
%end;! Estkpaddr
!*
!*
!*
!*                 *********************
!*                 *  Labels, Jumps    *
!*                 *********************
!*
!*
%externalroutine Elabel(%integer Id)
!***********************************************************************
!* register a label                                                    *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Elabel ");write(Id,4)
         newline
      %finish
%end;! Elabel
%externalroutine Eboundlab(%integer Id)
!***********************************************************************
!* register a label                                                    *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eboundlab ");write(Id,4)
         newline
      %finish
%end;! Eboundlab
!*
%externalroutine Ediscardlabel(%integer Id)
!***********************************************************************
!* advise that  a label can now be discarded - i.e. no future ref       *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ediscardlabel ");write(Id,4)
         newline
      %finish
%end;! Ediscardlabel
!*
%externalroutine Ejump(%integer Opcode, Labelid)
!***********************************************************************
!* generate specified conditional or unconditional jump                *
!***********************************************************************
%switch Op(0:164)
%integer Reg1,Freg1,XAop,Bytes
      %if Report#0 %thenstart
         printstring("Ejump ".Eopname(Opcode));write(Labelid,4)
         newline
      %finish
%end;! Ejump
!*
%externalroutine Etwjump(%integer Opcode,Lab1,Lab2,Lab3)
!***********************************************************************
!* generate the code for a Fortran three-way jump                      *
!* opcode = ITWB or RTWB for integer or real expression on Estack      *
!* Lab1,Lab2,Lab3 are the labels to jump to if Etos <0,=0,>0           *
!*  - if Labi <= 0 that jump is not required                           *
!***********************************************************************
%integer Op,Reg1,Freg1,Bytes
      %if Report#0 %thenstart
         printstring("Etwjump  ".Eopname(Opcode))
         write(Lab1,4);write(Lab2,4);write(Lab3,4)
         newline
      %finish
%end;! Etwjump
!*
%externalroutine Eswitch(%integer Lower, Upper, Switchid, Errlabid,
                                                %integername SSTad)
!***********************************************************************
!* define a switch Switchid to be indexed in the range (Lower:Upper)   *
!* space may be claimed from SST fotr the switch table                 *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eswitch ")
         write(Lower,4);write(Upper,4);write(Switchid,4)
         newline
      %finish
%end;! Eswitch
!*
%externalroutine EswitchJump(%integer Switchid)
!***********************************************************************
!* jump to Switchid( (Etos) )                                          *
!* if (Etos) is outside the bounds defined for Switchid then error     *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("EswitchJump ");write(switchid,4)
         newline
      %finish
%end;! EswitchJump
!*
%externalroutine EfswitchJump(%integer Switchid)
!***********************************************************************
!* jump to Switchid( (Etos) )                                          *
!* if (Etos) is outside the bounds the jump has no effect. Note that   *
!* in this case Switchid(Lower) addresses the next instruction         *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("EfswitchJump ");write(switchid,4)
         newline
      %finish
%end;! EfswitchJump
!*
%externalroutine Eswitchentry(%integer Switchid, Entry)
!***********************************************************************
!* define the current code address as Switchid(Entry)                  *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eswitchentry ");write(Switchid,4);write(Entry,4)
         newline
      %finish
%end;!Eswitchentry
!*
%externalroutine Eswitchdef(%integer Switchid)
!***********************************************************************
!* define the current code address as Switchid(*) - the default        *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eswitchdef ");write(Switchid,4)
         newline
      %finish
%end;!Eswitchdef
!*
%externalroutine EswitchLabel(%integer Switchid, Entry, Labelid)
!***********************************************************************
!* define Labelid as Switchid(Entry)                                   *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("EswitchLabel ");write(switchid,4);write(entry,4)
         newline
      %finish
%end;! EswitchLabel
!*
!*
!*
!*                *******************************
!*                * Data initialisation, fixups *
!*                *******************************
!*
!*
%externalroutine Ed1(%integer area, Disp, Val)
!***********************************************************************
!* intialise an 8-bit location                                         *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ed1   ".Areas(Area)." +");write(Disp,1)
         spaces(4);Phex(Val)
         newline
      %finish
%end;! Ed1
!*
%externalroutine Ed2(%integer area, Disp, Val)
!***********************************************************************
!* intialise a 16-bit location                                         *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ed2   ".Areas(Area)." +");write(Disp,1)
         spaces(4);Phex(Val)
         newline
      %finish
%end;! Ed2
!*
%externalroutine Ed4(%integer area, Disp, Val)
!***********************************************************************
!* intialise a 32-bit location                                         *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ed4   ".Areas(Area)." +");write(Disp,1)
         spaces(4);Phex(Val)
         newline
      %finish
%end;! Ed4
!*
%externalroutine Edbytes(%integer area, Disp, len, ad)
!***********************************************************************
!* intialise a block of data                                           *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Edbytes ")
         write(area,4)
        write(disp,4)
         write(len,4)
         space; phex(integer(ad)); space
         %if len>4 %then phex(integer(ad+4))
         newline
         %cycle
           phex(ad); space
            phex(integer(ad)); space
            phex(integer(ad+4)); space
             phex(integer(ad+8)); space
            phex(integer(ad+12)); newline
            ad=ad+16
             len=len-16
           %repeat %until len<=0
      %finish
%if Area=10 %then %monitor;! should not be allocated any more
%end;! Edbytes
!*
%externalroutine Edpattern(%integer area, Disp, ncopies, len, ad)
!***********************************************************************
!* initialise using a 1,2,4 or 8 byte pattern                          *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Edpattern ")
         newline
      %finish
%end;!Edpattern
!*
%externalroutine Efix(%integer area,disp, tgtarea,tgtdisp)
!***********************************************************************
!* relocate area+disp to tgtarea+tgtdisp  (all are byte addresses)     *
!***********************************************************************
      Area=Area&X'FFF';! in case 'byte' marker had been set (historic)
      %if Report#0 %thenstart
         printstring("Efix  ".Areas(Area)." +");write(Disp,1)
         printstring(" => ".Areas(Tgtarea)." +");write(Tgtdisp,1)
         newline
      %finish
%end
!*
!*
!*
!*                 *********************
!*                 * Procedure call    *
!*                 *********************
!*
!*
%externalintegerfn EXname(%integer type,%string(255)%name Xref)
!***********************************************************************
!* generate an external reference, returning an Id for future reference*
!***********************************************************************
%integer Refad,I
      %if Report#0 %thenstart
         printstring("EXname  ".Xref);write(Type&15,4);write(Type>>4,4)
         newline
      %finish
      Nextprocid=Nextprocid+1
      %result=Nextprocid
%end;! EXname
!*
%externalroutine Eprecall(%integer Id)
!***********************************************************************
!* called prior to planting parameters to a procedure call             *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eprecall ")
         newline
      %finish
%end;! Eprecall
!*
%externalroutine Ecall(%integer Id,Numpars,Paramsize)
!***********************************************************************
!* call the procedure defined by Id                                    *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Ecall    ");! write(id,6)
         newline
      %finish
%end;! Ecall
!*
%externalroutine Eprocref(%integer Id, Level)
!***********************************************************************
!* obtain a pointer to a procedure for use as a parameter              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eprocref ");write(Id,4);write(Level,4)
         newline
      %finish
%end;! Eprocref
!*
%externalroutine Esave(%integer Asave, %integername Key)
!***********************************************************************
!* obtain a pointer to a procedure for use as a parameter              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Esave ");write(Asave,4)
         newline
      %finish
%end;! Esave
!*
%externalroutine Erestore(%integer Asave, Key, Existing)
!***********************************************************************
!* obtain a pointer to a procedure for use as a parameter              *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Erestore ");write(Asave,4)
         newline
      %finish
%end;! Erestore
!*
!*
!*
!*               **********************************
!*               * Procedure definition and entry *
!*               **********************************
!*
!*
%externalintegerfn Enextproc
!***********************************************************************
!* result is an Id to be used for a procedure first encountered as an  *
!* internal spec                                                       *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Enextproc ")
         newline
      %finish
      Nextprocid=Nextprocid+1
      %result=Nextprocid
%end;! Enextproc
!*
%externalroutine Eproc(%stringname Name,%integer Props,
                          Numpars, Paramsize,Astacklen,%integername Id)
!***********************************************************************
!* define the start of a procedure body                                *
!* if Id > 0 this is the Id returned by a previous call of Enextproc   *
!* Astacklen is the address of the word noting the current local       *
!* stack-frame size                                                    *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eproc ");printstring(Name)
         write(numpars,5); write(paramsize,5)
         newline
      %finish
%end;! Eproc
!*
%externalroutine Eprocend(%integer Localsize,Diagdisp,Astacklen)
!***********************************************************************
!* called at procedure end                                             *
!* Localsize is the total stack-frame requirement (excluding red tape) *
!* Astacklen is the address of the word noting the current local       *
!* stack-frame size of th enclosing procedure                          *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eprocend ");write(Localsize,6)
         newline
      %finish
%end;! Eprocend
!*
%externalroutine Eentry(%integer Index,Numpars,Paramsize,Localsize,
                                                Diagdisp,%stringname Name)
!***********************************************************************
!* defines a side entry within the current procedure (used by Fortran) *
!* Localsize is the total stack-frame requirement (excluding red tape) * 
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Eentry  ".Name);write(Index,4)
         newline
      %finish
%end;! Eentry
!*
!*
!*
!*               *********************************
!*               * Data definition and reference *
!*               *********************************
!*
!*
%externalroutine Edataentry(%integer Area,Offset,Length,%stringname Name)
!***********************************************************************
!* defines a data entry Name starting at Offset in Area                *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Edataentry  ".Name);write(Area,4)
         write(Offset,4);write(Length,4)
         newline
      %finish
%end;! Edataentry
!*
%externalroutine Edataref(%integer Area,Offset,Length,%stringname Name)
!***********************************************************************
!* requests a data ref to Name (with at least Length)at Offset in Area *
!***********************************************************************
      %if Report#0 %thenstart
         printstring("Edataref  ".Name);write(Area,4)
         write(Offset,4);write(Length,4)
         newline
      %finish
%end;! Edataref
!*
!*
!*
!*                  ********************
!*                  * Ecode operations *
!*                  ********************
!*
!*
%externalroutine Eop(%integer Opcode)
!***********************************************************************
!* opcodes with general applicability                                  *
!***********************************************************************
%integer Reg1,Freg1,Bytes
%switch Op(0:255)
      %if Report#0 %thenstart
         printstring("Eop    ".Eopname(Opcode))
         newline
         Dump Estack
      %finish
%end;! Eop
!*
%externalroutine Ef77op(%integer Opcode)
!***********************************************************************
!* opcodes specifically defined for use by Fortran                     *
!***********************************************************************
%switch F77op(256:320)
      %if Report#0 %thenstart
         printstring("Ef77op  ".Ef77opname(Opcode))
         newline
         Dump Estack
      %finish
%end;! Ef77op
!*
%externalroutine Epasop(%integer Opcode)
!***********************************************************************
!* opcodes specifically defined for use by Pascal                      *
!***********************************************************************
      %monitor
%end;! Epasop
!*
%externalroutine Eccop(%integer Opcode)
!***********************************************************************
!* opcodes specifically defined for use by C                           *
!***********************************************************************
      %monitor
%end;! Eccop
!*
!*
!*
!***********************************************************************
!*
!*
%externalroutine Egenerate Object(%stringname Objfilename)
!***********************************************************************
!***********************************************************************
%record(Stkfmt) E 
%integer I
      %if Report#0 %thenstart
         printstring("Egenerate Object ")
         newline
      %finish
%end;! Egenerate Object
!*
%externalroutine Euchecklab(%integer Label)
      %if Report#0 %thenstart
         printstring("Euchecklab)")
         write(Label,4)
      %finish
%end;!Euchecklab
!*
%endoffile