home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / opc.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  58KB  |  1,824 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Syntax10b.Scn.Fnt
  5. (* Notify Ralf for maintenance of Non-FPU source *)
  6. MODULE OPC;
  7. (* Code Generator for MC68020.
  8.  Diplomarbeit Samuel Urech
  9.  Date: 6.11.92   Current version: 26.2.93
  10.  Bug concerning record assignment (projection) in Convert fixed by cn/shml 30 Jun 94
  11.  Nil-Check by rd/cn 22.05.95 *)
  12.  IMPORT SYSTEM, OPT, OPL, OPM;
  13.  CONST
  14.   (* object modes *)
  15.   Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  16.   SProc = 8; CProc = 9; IProc = 10; Head = 12; TProc = 13;
  17.   (* accessibility of objects *)
  18.   internal = 0; external = 1; externalR = 2;
  19.   (* structure forms *)
  20.   Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  21.   Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  22.   Pointer = 13; ProcTyp = 14; Comp = 15;
  23.   (* composite structure forms *)
  24.   Basic = 1; Array = 2; DynArr = 3; Record = 4;
  25.   IntSet = { SInt .. LInt };
  26.   RealSet = { Real, LReal };
  27.   ByteSet = { SInt, Byte, Char, Bool };
  28.   WordSet = { Int };
  29.   LongSet = { LInt, Set, Pointer, ProcTyp };
  30.   (* item modes *)
  31.   dreg = 0; areg = 1; freg = 2; postinc = 3; predec = 4; regx = 5; abs = 7; imm = 8; immL = 9; pcx = 10; coc = 12; fcoc = 13;
  32.   (* sizes *)
  33.   byte = 0; word = 1; long = 2;
  34.   (* opcodes *)
  35.   ADD = 13; AND = 12; oR = 8; SUB = 9;
  36.   BCHG = 1; BCLR = 2; BSET = 3; BTST = 0;
  37.   ADDI = 6; ANDI = 2; CMPI = 12; EORI = 10; ORI = 0; SUBI = 4;
  38.   ADDQ = 0; SUBQ = 1;
  39.   CLR = 2; NEG = 4; NEGX = 0; NOT = 6; TST = 10;
  40.   BFCHG = 10; BFCLR = 12; BFSET = 14; BFTST = 8;
  41.   DIVS = 81C0H; DIVU = 80C0H; MULS = 0C1C0H; MULU = 0C0C0H;
  42.   ASh = 0; LSh = 1; ROt = 3; ROX = 2;
  43.   JMP = 3BH; JSR = 3AH; PEA = 21H; NBCD = 20H; TAS = 2BH;
  44.   (* Coprocessor opcodes *)
  45.   FABS = 18H; FACOS = 1CH; FADD = 22H; FASIN = 0CH; FATAN = 0AH; FATANH = 0DH; FCMP = 38H;
  46.   FCOS = 1DH; FCOSH = 19H; FDIV = 20H; FETOX = 10H; FETOXM1 = 8; FGETEXP = 1EH; FGETMAN = 1FH;
  47.   FINT = 1; FINTRZ = 3; FLOG10 = 15H; FLOG2 = 16H; FLOGN = 14H; FLOGNP1 = 6; FMOD = 21H; FMOVE = 0;
  48.   FMUL = 23H; FNEG = 1AH; FREM = 25H; FSCALE = 26H; FSGLDIV = 24H; FSGLMUL = 27H; FSIN = 0EH;
  49.   FSINH = 2; FSQRT = 4; FSUB = 28H; FTAN = 0FH; FTANH = 9; FTENTOX = 12H; FTST = 3AH; FTWOTOX = 11H;
  50.   (* Compare kinds *)
  51.   eql = 9; neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  52.   (* Condition Codes *)
  53.   CC = 4; CS = 5; EQ = 7; false = 1; GE = 12; GT = 14; HI = 2; LE = 15;
  54.   LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; true = 0; VC = 8; VS = 9;
  55.   (* Floating Point Condition Codes *)
  56.   FEQ = 1; FNE = 0EH; FGT = 12H; FNGT = 1DH; FGE = 13H; FNGE = 1CH; FLT = 14H; FNLT = 1BH; FLE = 15H;
  57.   FNLE = 1AH; Ffalse = 0; Ftrue = 0FH;
  58.   (* Floating Point Control Registers *)
  59.   FPCR = 4; FPSR = 2; FPIAR = 1;
  60.   (* Traps, not used ? *)
  61.   inxTrap = 8; rngTrap = 9; guardTrap = 18; eqGuardTrap = 19;
  62.   super = 1;
  63.   None = -1;
  64.  VAR FP, SP : OPL.Item;
  65.    indexCheck, rangeCheck, nilCheck, ptrinit, saveRegs* : BOOLEAN;
  66.  PROCEDURE Init*( options : SET );
  67.  BEGIN
  68.   indexCheck := 0 IN options;
  69.   rangeCheck := 2 IN options;
  70.   nilCheck := 9 IN options;
  71.   ptrinit := 5 IN options
  72.  END Init;
  73.  PROCEDURE MakeLen*( VAR arr : OPL.Item; n : LONGINT; VAR item : OPL.Item );
  74.  (* Makes an item that denotes the length in the n-th dimension of a dynamic array. *)
  75.  BEGIN (* MakeLen *)
  76.   item := arr;
  77.   IF item.nolen = 0 THEN
  78.    item.bd := arr.bd + 4 * ( n + 1 )
  79.   ELSE
  80.    item.bd := arr.bd + 4 * n
  81.   END; (* IF *)
  82.   item.typ := OPT.linttyp
  83.  END MakeLen;
  84.  PROCEDURE MakeIntConst*( val : LONGINT; typ : OPT.Struct; VAR item : OPL.Item );
  85.  (* Makes an immediate item of a given type from a number. *)
  86.  BEGIN (* MakeIntConst *)
  87.   item.mode := imm;
  88.   item.typ := typ;
  89.   item.bd := val
  90.  END MakeIntConst;
  91.  PROCEDURE MakeVar*( obj : OPT.Object; VAR item : OPL.Item );
  92.  (* Makes an item from a variable. *)
  93.   VAR aregItem : OPL.Item;
  94.   PROCEDURE GetVarBase( obj : OPT.Object ) : INTEGER;
  95.   (* Returns the register to which the given variable is relative. *)
  96.    VAR diff, reg : INTEGER;
  97.      source, dest : OPL.Item;
  98.   BEGIN (* GetVarBase *)
  99.    diff := OPL.level - obj.mnolev;
  100.    IF diff = 0 THEN
  101.     reg := FP.reg
  102.    ELSE (* follow static link *)
  103.     reg := OPL.GetAdrReg( );
  104.     source.mode := regx;
  105.     source.typ := OPT.sysptrtyp;
  106.     source.reg := FP.reg;
  107.     source.bd := 8;
  108.     source.inxReg := None;
  109.     source.offsReg := None;
  110.     dest.mode := areg;
  111.     dest.typ := OPT.sysptrtyp;
  112.     dest.reg := reg;
  113.     OPL.Move( source, dest );
  114.     source.reg := reg;
  115.     WHILE diff > 1 DO
  116.      OPL.Move( source, dest );
  117.      DEC( diff )
  118.     END; (* WHILE *)
  119.    END; (* IF *)
  120.    RETURN reg
  121.   END GetVarBase;
  122.  BEGIN (* MakeVar *)
  123.   IF ( obj.mode = VarPar ) & ( obj.typ.comp # DynArr ) THEN
  124.    item.mode := regx;
  125.    item.reg := GetVarBase( obj );
  126.    item.typ := OPT.sysptrtyp;
  127.    item.bd := obj.adr;
  128.    item.inxReg := None;
  129.    aregItem.mode := areg;
  130.    aregItem.reg := OPL.GetAdrReg( );
  131.    OPL.Move( item, aregItem );
  132.    OPL.FreeReg( item );
  133.    item.mode := regx;
  134.    item.reg := aregItem.reg;
  135.    item.bd := 0
  136.   ELSIF obj.mnolev < 0 THEN (* imported variable *)
  137.    item.mode := abs;
  138.    item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr
  139.   ELSIF obj.mnolev = 0 THEN (* global variable *)
  140.    item.mode := pcx;
  141.    item.bd := obj.linkadr
  142.   ELSE (* local variable *)
  143.    item.mode := regx;
  144.    item.reg := GetVarBase( obj );
  145.    item.bd := obj.adr
  146.   END; (* IF *)
  147.   item.typ := obj.typ;
  148.   item.inxReg := None;
  149.   item.offsReg := None;
  150.   item.nolen := 0
  151.  END MakeVar;
  152.  PROCEDURE DeRef*( typ : OPT.Struct; VAR item : OPL.Item );
  153.  (* Makes a dereferentiation of an item. *)
  154.   VAR aregItem, dregItem : OPL.Item;
  155.     inxReg : INTEGER;
  156.  BEGIN (* DeRef *)
  157.   aregItem.mode := areg;
  158.   (* If item is (Ax) with x<6, use Ax again *)
  159.   IF saveRegs & (item.mode=regx) & (item.reg<14) THEN
  160.       aregItem.reg:=item.reg
  161.   ELSE
  162.       aregItem.reg := OPL.GetAdrReg( )
  163.   END;
  164.   item.typ := OPT.sysptrtyp;
  165.   inxReg := item.offsReg;
  166.   OPL.Move( item, aregItem );
  167.   IF nilCheck & (~(item.mode=immL)) THEN
  168.    dregItem.mode:=dreg;
  169.    dregItem.reg:=OPL.GetReg();
  170.    NEW(aregItem.typ);aregItem.typ.size:=4;
  171.    OPL.Move( aregItem, dregItem);
  172.    OPL.Trapcc(EQ, 2);
  173.    OPL.FreeReg(dregItem)
  174.   END;
  175.   item.mode := regx;
  176.   item.typ := typ;
  177.   item.reg := aregItem.reg;
  178.   item.bd := 0;
  179.   item.inxReg := inxReg; (* xsize and scale keep their values *)
  180.   IF typ.comp = DynArr THEN
  181.    item.nolen := SHORT( typ.n ) + 1
  182.   ELSE
  183.    item.nolen := 0
  184.   END; (* IF *)
  185.  END DeRef;
  186.  PROCEDURE StaticTag*( typ : OPT.Struct; VAR tag : OPL.Item );
  187.  (* Returns the type tag of a type. *)
  188.  BEGIN (* StaticTag *)
  189.   tag.mode := immL;
  190.   tag.typ := OPT.sysptrtyp;
  191.   tag.bd := SYSTEM.LSH( LONG( LONG( typ.mno ) ), 8 ) + typ.tdadr
  192.  END StaticTag;
  193.  PROCEDURE MakeTag*( obj : OPT.Object; typ : OPT.Struct; VAR item, tag : OPL.Item );
  194.  (* Makes an item that denotes the type tag of the given object and item. *)
  195.  BEGIN (* MakeTag *)
  196.   IF item.typ.form = Pointer THEN
  197.    tag := item;
  198.    DeRef( OPT.sysptrtyp, tag );
  199.    tag.bd := -4
  200.   ELSIF ( obj # NIL ) & ( obj.mode = VarPar ) THEN
  201.    tag.mode := regx;
  202.    tag.typ := OPT.sysptrtyp;
  203.    tag.reg := FP.reg;
  204.    tag.bd := obj.adr + 4;
  205.    tag.inxReg := None;
  206.    tag.offsReg := None
  207.   ELSE
  208.    StaticTag( typ, tag )
  209.   END; (* IF *)
  210.  END MakeTag;
  211.  PROCEDURE MakeConst*( obj : OPT.Object; const : OPT.Const; typ : OPT.Struct; VAR item : OPL.Item );
  212.  (* Makes an item from a constant. *)
  213.   VAR realval : REAL;
  214.  BEGIN (* MakeConst *)
  215.   item.typ := typ;
  216.   CASE typ.form OF
  217.    Set :
  218.     MakeIntConst( SYSTEM.VAL( LONGINT, const.setval ), typ, item )
  219.    | String :
  220.     OPL.AllocConst( obj, typ, const.ext^, const.intval2, item );
  221.     item.nolen := SHORT( const.intval2 )
  222.    | Real :
  223.     realval :=  SHORT( const.realval );
  224.     OPL.AllocConst( obj, typ, realval, 4, item )
  225.    | LReal :
  226.     OPL.AllocConst( obj, typ, const.realval, 8, item )
  227.   ELSE
  228.    MakeIntConst( const.intval, typ, item )
  229.   END; (* CASE *)
  230.  END MakeConst;
  231.  PROCEDURE BaseTypSize( VAR arr, size : OPL.Item; VAR scale : INTEGER );
  232.  (* Returns the size of the base type of a dynamic array if the base type is a dynamic array itself. *)
  233.   VAR i : LONGINT;
  234.     typ : OPT.Struct;
  235.     len : OPL.Item;
  236.  BEGIN (* BaseTypSize *)
  237.   typ := arr.typ.BaseTyp;
  238.   WHILE typ.comp = DynArr DO
  239.    typ := typ.BaseTyp
  240.   END; (* WHILE *)
  241.   IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
  242.    scale := SHORT( typ.size );
  243.    MakeLen( arr, arr.typ.offset, size )
  244.   ELSE
  245.    scale := 1;
  246.    MakeIntConst( typ.size, OPT.linttyp, size );
  247.    MakeLen( arr, arr.typ.offset, len );
  248.    OPL.Format12( MULS, len, size );
  249.    OPL.FreeReg( len )
  250.   END; (* IF *)
  251.   FOR i := arr.typ.offset - arr.typ.n + 1 TO arr.typ.offset - 1 DO
  252.    MakeLen( arr, i, len );
  253.    OPL.Format12( MULS, len, size );
  254.    OPL.FreeReg( len )
  255.   END; (* FOR *)
  256.  END BaseTypSize;
  257.  PROCEDURE Size( VAR arr, size : OPL.Item; VAR scale : INTEGER );
  258.  (* Returns the size of a dynamic array and a scale factor. *)
  259.   VAR len : OPL.Item;
  260.     typ : OPT.Struct;
  261.  BEGIN (* Size *)
  262.   MakeLen( arr, arr.typ.offset - arr.typ.n, len );
  263.   typ := arr.typ.BaseTyp;
  264.   IF typ.comp = DynArr THEN
  265.    BaseTypSize( arr, size, scale );
  266.    OPL.Format12( MULS, len, size );
  267.    OPL.FreeReg( len )
  268.   ELSE
  269.    IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
  270.     scale := SHORT( typ.size );
  271.     size := len
  272.    ELSE
  273.     scale := 1;
  274.     MakeIntConst( typ.size, OPT.linttyp, size );
  275.     OPL.Format12( MULS, len, size );
  276.     OPL.FreeReg( len )
  277.    END; (* IF *)
  278.   END; (* IF *)
  279.  END Size;
  280.  PROCEDURE ElimIndex( VAR item : OPL.Item );
  281.  (* Eliminates the index register in the item. *)
  282.   VAR newReg : INTEGER;
  283.  BEGIN (* ElimIndex *)
  284.   IF item.inxReg # None THEN (* load old address *)
  285.    newReg := OPL.GetAdrReg( );
  286.    OPL.Lea( item, newReg );
  287.    item.mode := regx;
  288.    item.bd := 0;
  289.    item.reg := newReg;
  290.    item.inxReg := None
  291.   END; (* IF *)
  292.  END ElimIndex;
  293.  PROCEDURE SetElem*( VAR item : OPL.Item );
  294.  (* Makes a set-element from an integer element and sets the corresponding bit. *)
  295.   VAR source : OPL.Item;
  296.  BEGIN (* SetElem *)
  297.   source :=  item;
  298.   item.mode := dreg;
  299.   item.typ := OPT.settyp;
  300.   item.reg := OPL.GetReg( );
  301.   OPL.Format7( CLR, item );
  302.   OPL.Format5( BSET, source, item )
  303.  END SetElem;
  304.  PROCEDURE RoundDown;
  305.  (* Sets the rounding mode of the coprocessor to -inf. *)
  306.   VAR temp : OPL.Item;
  307.  BEGIN (* RoundDown *)
  308.   MakeIntConst( 20H, OPT.linttyp, temp );
  309.   OPL.FMovecr( temp, 0, FPCR )
  310.  END RoundDown;
  311.  PROCEDURE RoundNearest;
  312.  (* Sets the rounding mode of the coprocessor to nearest. *)
  313.   VAR temp : OPL.Item;
  314.  BEGIN (* RoundNearest *)
  315.   MakeIntConst( 0, OPT.linttyp, temp );
  316.   OPL.FMovecr( temp, 0, FPCR )
  317.  END RoundNearest;
  318.  PROCEDURE Convert*( VAR source : OPL.Item; desttyp : OPT.Struct );
  319.  (* Converts the given item to desttyp. *)
  320.   VAR sf, sc, df, dc : SHORTINT;
  321.     dest : OPL.Item;
  322.  BEGIN (* Convert *)
  323.   sf := source.typ.form;
  324.   sc := source.typ.comp;
  325.   df := desttyp.form;
  326.   dc := desttyp.comp;
  327.   IF df = ProcTyp THEN (* handles assignments of functions to proc vars *) source.typ := desttyp; RETURN END;
  328.   IF (df = Comp) & (sf = Comp) & (dc = Record) & (sc = Record) THEN
  329.     (* handles record assignment including projection *)
  330.    source.typ := desttyp;
  331.    RETURN
  332.   END;
  333.   IF ( sf # Pointer ) & ( ( sf # df ) OR ( sc # dc ) ) THEN
  334.    IF df IN LongSet THEN
  335.     IF sf = Char THEN
  336.      dest.mode := dreg;
  337.      dest.typ := desttyp;
  338.      dest.reg := OPL.GetReg( );
  339.      OPL.Format7( CLR, dest );
  340.      OPL.Move( source, dest );
  341.      source := dest
  342.     ELSIF sf IN ByteSet + WordSet THEN
  343.      OPL.Ext( source, long )
  344.     ELSIF sf IN RealSet THEN
  345.      OPL.FLoad( source );
  346.      RoundDown;
  347.      source.typ := desttyp;
  348.      OPL.Load( source );
  349.      RoundNearest
  350.     END; (* IF *)
  351.    ELSIF df IN WordSet THEN
  352.     IF sf IN LongSet THEN
  353.      OPL.Load( source )
  354.     ELSIF sf = Char THEN
  355.      dest.mode := dreg;
  356.      dest.typ := desttyp;
  357.      dest.reg := OPL.GetReg( );
  358.      OPL.Format7( CLR, dest );
  359.      OPL.Move( source, dest );
  360.      source := dest
  361.     ELSIF sf IN ByteSet THEN
  362.      OPL.Ext( source, word )
  363.     ELSIF sf IN RealSet THEN
  364.      OPL.FLoad( source );
  365.      RoundDown;
  366.      source.typ := desttyp;
  367.      OPL.Load( source );
  368.      RoundNearest
  369.     END; (* IF *)
  370.    ELSIF df IN ByteSet THEN
  371.     IF sf IN WordSet + LongSet THEN
  372.      OPL.Load( source )
  373.     ELSIF sf IN RealSet THEN
  374.      OPL.FLoad( source );
  375.      RoundDown;
  376.      source.typ := desttyp;
  377.      OPL.Load( source );
  378.      RoundNearest
  379.     END; (* IF *)
  380.    ELSIF df IN RealSet THEN
  381.     OPL.FLoad( source )
  382.    END; (* IF *)
  383.    source.typ := desttyp
  384.   END; (* IF *)
  385.  END Convert;
  386.  PROCEDURE GetDynArrVal*( VAR item : OPL.Item );
  387.  (* Returns an item containing the actual value of a dynamic array. *)
  388.  BEGIN (* GetDynArrVal *)
  389.   IF item.nolen = 0 THEN
  390.    DeRef( OPT.sysptrtyp, item )
  391.   ELSE
  392.    INC( item.bd, LONG( item.nolen ) * 4 );
  393.    item.nolen := 0;
  394.    item.typ := OPT.sysptrtyp;
  395.    item.inxReg := item.offsReg;
  396.    item.offsReg := None
  397.   END; (* IF *)
  398.  END GetDynArrVal;
  399.  PROCEDURE GetDynArrAdr( VAR item, adr : OPL.Item );
  400.  (* Returns an item containing the address of a dynamic array. *)
  401.   VAR adrReg : OPL.Item;
  402.  BEGIN (* GetDynArrAdr *)
  403.   adr.typ := OPT.sysptrtyp;
  404.   adr.nolen := 0;
  405.   IF item.nolen = 0 THEN
  406.    IF item.offsReg # None THEN
  407.     DeRef( OPT.sysptrtyp, item );
  408.     adr.mode := areg;
  409.     adr.reg := OPL.GetAdrReg( );
  410.     OPL.Lea( item, adr.reg )
  411.    ELSE
  412.     adr.mode := item.mode;
  413.     adr.reg := item.reg;
  414.     adr.bd := item.bd;
  415.     adr.inxReg := None;
  416.     adr.offsReg := None
  417.    END
  418.   ELSE
  419.    adr.mode := item.mode;
  420.    adr.reg := item.reg;
  421.    adr.bd := item.bd + item.nolen * 4;
  422.    adr.inxReg := item.offsReg;
  423.    adr.xsize := item.xsize;
  424.    adr.scale := item.scale;
  425.    adr.offsReg := None;
  426.    adrReg.mode := areg;
  427.    adrReg.typ := OPT.sysptrtyp;
  428.    adrReg.reg := OPL.GetAdrReg( );
  429.    OPL.Lea( adr, adrReg.reg );
  430.    adr := adrReg
  431.   END; (* IF *)
  432.  END GetDynArrAdr;
  433.  PROCEDURE MakeField*( VAR item : OPL.Item; offset : LONGINT; typ : OPT.Struct );
  434.  (* Increments the address of item by offset and sets its type to typ. *)
  435.  BEGIN (* MakeField *)
  436.   OPL.LoadExternal( item );
  437.   INC( item.bd, offset );
  438.   item.typ := typ
  439.  END MakeField;
  440.  PROCEDURE MakeIndex*( VAR index, res : OPL.Item );
  441.  (* Makes an indexed item from an item and an index. res := res[ index ].
  442.   The generated item has always got an index register or an offset register. *)
  443.   VAR baseTyp : OPT.Struct;
  444.     sizeItem, chkItem, offset : OPL.Item;
  445.     size : LONGINT;
  446.     scale : INTEGER;
  447.  BEGIN (* MakeIndex *)
  448.   baseTyp := res.typ.BaseTyp;
  449.   size := baseTyp.size;
  450.   OPL.LoadExternal( res );
  451.   IF ( res.typ.comp # DynArr ) & ( index.mode = imm ) THEN
  452.    INC( res.bd, size * index.bd )
  453.   ELSE
  454.    ElimIndex( res );
  455.    IF index.typ.form = SInt  THEN Convert( index, OPT.inttyp ) END;
  456.    IF ( ( index.mode # imm ) OR ( index.bd # 0 ) ) & (indexCheck) THEN
  457.     IF res.typ.comp = DynArr THEN
  458.      MakeLen( res, res.typ.offset - res.typ.n, chkItem );
  459.      Convert( index, OPT.linttyp )
  460.     ELSE
  461.      MakeIntConst( res.typ.n - 1, index.typ, chkItem )
  462.     END; (* IF *)
  463.     OPL.Chk( index, chkItem );
  464.     (* OPL.FreeReg( chkItem ); *) (* Need this for CHK opti *)
  465.    END; (* IF *)
  466.    OPL.Load( index );
  467.    IF baseTyp.comp # Basic THEN
  468.     IF baseTyp.comp = DynArr THEN
  469.      Convert( index, OPT.linttyp );
  470.      BaseTypSize( res, sizeItem, scale );
  471.      OPL.Format12( MULS, sizeItem, index );
  472.      OPL.FreeReg( sizeItem )
  473.     ELSE
  474.      IF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) OR ( size = 8 ) THEN
  475.       scale := SHORT( size )
  476.      ELSE
  477.       scale := 1;
  478.       MakeIntConst( size, index.typ, sizeItem );
  479.       IF index.typ.form = LInt THEN
  480.        OPL.Format12( MULS, sizeItem, index )
  481.       ELSE
  482.        OPL.Format11( MULS, sizeItem, index )
  483.       END; (* IF *)
  484.       OPL.FreeReg( sizeItem )
  485.      END; (* IF *)
  486.     END; (* IF *)
  487.     size := 1
  488.    ELSE scale := SHORT( size )
  489.    END; (* IF *)
  490.    IF baseTyp.comp = DynArr THEN
  491.     IF res.offsReg # None THEN
  492.      offset.mode := dreg;
  493.      offset.typ := OPT.linttyp;
  494.      offset.reg := res.offsReg;
  495.      OPL.Format2( ADD, offset, index )
  496.     END; (* IF *)
  497.     res.offsReg := index.reg
  498.    ELSE
  499.     IF res.typ.comp = DynArr THEN
  500.      GetDynArrVal( res );
  501.      ElimIndex( res )
  502.     END; (* IF *)
  503.     res.inxReg := index.reg
  504.    END; (* IF *)
  505.    IF index.typ.form = LInt THEN
  506.     res.xsize := 1
  507.    ELSE
  508.     res.xsize := 0
  509.    END; (* IF *)
  510.    CASE scale OF
  511.     1 : res.scale := 0
  512.     | 2 : res.scale := 1
  513.     | 4 : res.scale := 2
  514.     | 8 : res.scale := 3
  515.    END; (* CASE *)
  516.   END; (* IF *)
  517.   res.typ := baseTyp
  518.  END MakeIndex;
  519.  PROCEDURE MakeProc*( obj : OPT.Object; subcl : SHORTINT; VAR item : OPL.Item );
  520.  (* Makes an item from a procedure object. *)
  521.  BEGIN (* MakeProc *)
  522.   IF obj.mode = XProc THEN (* external procedure *)
  523.    item.mode := immL;
  524.    item.typ := OPT.sysptrtyp;
  525.    item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr;
  526.    item.offsReg := None
  527.   ELSIF obj.mode = TProc THEN
  528.    (* receiver is on top of the stack *)
  529.    IF obj.link.mode = VarPar THEN
  530.     item.mode := regx;
  531.     item.typ := OPT.sysptrtyp;
  532.     item.reg := SP.reg;
  533.     item.bd := 4;
  534.     item.inxReg := None;
  535.     item.offsReg := None
  536.    ELSE
  537.     item.mode := regx;
  538.     item.typ := OPT.sysptrtyp;
  539.     item.reg := SP.reg;
  540.     item.bd := 0;
  541.     item.inxReg := None;
  542.     item.offsReg := None;
  543.     DeRef( OPT.sysptrtyp, item );
  544.     item.bd := -4
  545.    END; (* IF *)
  546.    DeRef( OPT.sysptrtyp, item );
  547.    IF subcl = super THEN
  548.     item.bd := OPL.BaseTypeOffs + 4 * ( obj.link.typ.BaseTyp.extlev - 1 );
  549.     DeRef( OPT.sysptrtyp, item )
  550.    END; (* IF *)
  551.    item.bd := OPL.MethodOffs - 4 * ( obj.adr DIV 10000H + 1 )
  552.   ELSE
  553.    MakeIntConst( obj.linkadr, OPT.linttyp, item )
  554.   END; (* IF *)
  555.  END MakeProc;
  556.  PROCEDURE MakePostInc( typ : OPT.Struct; VAR item : OPL.Item );
  557.  (* Makes a post-increment item from the given item. *)
  558.   VAR dest : OPL.Item;
  559.  BEGIN (* MakePostInc *)
  560.   IF item.mode # postinc THEN
  561.    IF ( item.mode = regx ) & ( item.bd = 0 ) & ( item.inxReg = None ) & ~ ( item.reg IN { FP.reg, SP.reg } ) THEN
  562.     item.mode := postinc;
  563.     item.typ := typ
  564.    ELSE
  565.     dest.mode := postinc;
  566.     dest.typ := typ;
  567.     dest.reg := OPL.GetAdrReg( );
  568.     OPL.Lea( item, dest.reg );
  569.     item := dest
  570.    END
  571.   END
  572.  END MakePostInc;
  573.  PROCEDURE MakeSPPredec( VAR res : OPL.Item );
  574.  (* Makes a pre-decrement item with the stack pointer. *)
  575.  BEGIN (* MakeSPPredec *)
  576.   res.mode := predec;
  577.   res.reg := SP.reg;
  578.   res.typ := SP.typ
  579.  END MakeSPPredec;
  580.  PROCEDURE MakeCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
  581.  (* Makes a coc item with the true-condition trueCond. *)
  582.  BEGIN (* MakeCocItem *)
  583.   res.mode := coc;
  584.   res.typ := OPT.booltyp;
  585.   res.bd := OPL.TFConds( trueCond );
  586.   (* leave tJump and fJump unchanged! *)
  587.  END MakeCocItem;
  588.  PROCEDURE MakeFCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
  589.  (* Makes an fcoc item with the true-condition trueCond. *)
  590.  BEGIN (* MakeFCocItem *)
  591.   res.mode := fcoc;
  592.   res.typ := OPT.booltyp;
  593.   res.bd := OPL.TFFConds( trueCond );
  594.   (* leave tJump and fJump unchanged! *)
  595.  END MakeFCocItem;
  596.  PROCEDURE Swap( x : SET ) : INTEGER;
  597.  (* Writes bits 15 to 0 to the positions 0 to 15 of the result. Used for MOVEM. *)
  598.   VAR y : SET;
  599.     i : INTEGER;
  600.  BEGIN (* Swap *)
  601.   y := { };
  602.   FOR i := 0 TO 15 DO
  603.    IF i IN x THEN INCL( y, 15 - i ) END
  604.   END; (* FOR *)
  605.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  606.  END Swap;
  607.  PROCEDURE SwappedFloats( x : SET ) : INTEGER;
  608.  (* Writes bits 23 to 16 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  609.   VAR y : SET;
  610.     i : INTEGER;
  611.  BEGIN (* SwappedFloats *)
  612.   y := { };
  613.   FOR i := 16 TO 23 DO
  614.    IF i IN x THEN INCL( y, 23 - i ) END
  615.   END; (* FOR *)
  616.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  617.  END SwappedFloats;
  618.  PROCEDURE Floats( x : SET ) : INTEGER;
  619.  (* Writes bits 16 to 23 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  620.   VAR y : SET;
  621.     i : INTEGER;
  622.  BEGIN (* Floats *)
  623.   y := { };
  624.   FOR i := 16 TO 23 DO
  625.    IF i IN x THEN INCL( y, i - 16 ) END
  626.   END; (* FOR *)
  627.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  628.  END Floats;
  629.  PROCEDURE PushRegs*( regs : SET );
  630.  (* Pushes the given registers onto the stack. *)
  631.   VAR sppredec : OPL.Item;
  632.     regList : INTEGER;
  633.  BEGIN (* PushRegs *)
  634.   MakeSPPredec( sppredec );
  635.   regList := Swap( regs );
  636.   IF regList # 0 THEN
  637.    OPL.Movem( 0, regList, sppredec )
  638.   END; (* IF *)
  639.   regList := Floats( regs );
  640.   IF regList # 0 THEN
  641.    OPL.FMovem( 0, regList , sppredec )
  642.   END; (* IF *)
  643.  END PushRegs;
  644.  PROCEDURE PopRegs*( regs : SET );
  645.  (* Pops the given registers from the stack. *)
  646.   VAR sppostinc : OPL.Item;
  647.     regList : INTEGER;
  648.  BEGIN (* PopRegs *)
  649.   sppostinc.mode := postinc;
  650.   sppostinc.reg := SP.reg;
  651.   sppostinc.typ := SP.typ;
  652.   regList := SwappedFloats( regs );
  653.   IF regList # 0 THEN
  654.    OPL.FMovem( 1, regList, sppostinc )
  655.   END; (* IF *)
  656.   regList := SHORT( SYSTEM.VAL( LONGINT, regs ) );
  657.   IF regList # 0 THEN
  658.    OPL.Movem( 1, regList, sppostinc )
  659.   END; (* IF *)
  660.  END PopRegs;
  661.  PROCEDURE TrueJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
  662.  (* Generates a conditional branch to the given label with the true condition. *)
  663.  BEGIN (* TrueJump *)
  664.   IF expression.mode = imm THEN
  665.    IF expression.bd # 0  THEN
  666.     OPL.Jump( true, label )
  667.    END; (* IF *)
  668.   ELSIF expression.mode = coc THEN
  669.    OPL.Jump( SHORT( expression.bd DIV 10000H ), label )
  670.   ELSIF expression.mode = fcoc THEN
  671.    OPL.FJump( SHORT( expression.bd DIV 10000H ), label )
  672.   ELSE
  673.    OPL.Load( expression );
  674.    OPL.Format7( TST, expression );
  675.    OPL.Jump( NE, label )
  676.   END; (* IF *)
  677.   OPL.DefineLabel( expression.fJump )
  678.  END TrueJump;
  679.  PROCEDURE FalseJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
  680.  (* Generates a conditional branch to the given label with the false condition. *)
  681.  BEGIN (* FalseJump *)
  682.   IF expression.mode = imm THEN
  683.    IF expression.bd = 0 THEN
  684.     OPL.Jump( true, label )
  685.    END; (* IF *)
  686.   ELSIF expression.mode = coc THEN
  687.    OPL.Jump( SHORT( expression.bd MOD 10000H ), label )
  688.   ELSIF expression.mode = fcoc THEN
  689.    OPL.FJump( SHORT( expression.bd MOD 10000H ), label )
  690.   ELSE
  691.    OPL.Load( expression );
  692.    OPL.Format7( TST, expression );
  693.    OPL.Jump( EQ, label )
  694.   END; (* IF *)
  695.   OPL.DefineLabel( expression.tJump )
  696.  END FalseJump;
  697.  PROCEDURE MoveBlock( scale : INTEGER; VAR size, source, dest : OPL.Item );
  698.  (* Moves a block of data of length size from source to dest. *)
  699.   VAR i : LONGINT;
  700.     losize : OPL.Item;
  701.     label : OPL.Label;
  702.  BEGIN (* MoveBlock *)
  703.   IF scale = 1 THEN
  704.    MakePostInc( OPT.sinttyp, source );
  705.    MakePostInc( OPT.sinttyp, dest )
  706.   ELSIF scale = 2 THEN
  707.    MakePostInc( OPT.inttyp, source );
  708.    MakePostInc( OPT.inttyp, dest )
  709.   ELSE
  710.    MakePostInc( OPT.linttyp, source );
  711.    MakePostInc( OPT.linttyp, dest )
  712.   END; (* IF *)
  713.   IF ( size.mode = imm ) & ( size.bd <= 6 ) THEN
  714.    i := 0;
  715.    WHILE i < size.bd DO
  716.     OPL.Move( source, dest );
  717.     INC( i )
  718.    END; (* WHILE *)
  719.   ELSE
  720.    IF size.mode = imm THEN
  721.     DEC( size.bd )
  722.    ELSE
  723.     OPL.Load( size );
  724.     OPL.Format1( SUBQ, 1, size )
  725.    END; (* IF *)
  726.    IF ( ( size.mode = imm ) & ( size.bd <= MAX( INTEGER ) ) ) OR ( size.typ # OPT.linttyp ) THEN
  727.     OPL.Load( size );
  728.     Convert( size, OPT.inttyp );
  729.     label := OPL.NewLabel;
  730.     OPL.DefineLabel( label );
  731.     OPL.Move( source, dest );
  732.     IF scale = 8 THEN OPL.Move( source, dest ) END;
  733.     OPL.DBcc( false, size.reg, label )
  734.    ELSE
  735.     OPL.Load( size );
  736.     losize.mode := dreg;
  737.     losize.typ := OPT.inttyp;
  738.     losize.reg := OPL.GetReg( );
  739.     OPL.Move( size, losize );
  740.     OPL.Swap( size );
  741.     label := OPL.NewLabel;
  742.     OPL.DefineLabel( label );
  743.     OPL.Move( source, dest );
  744.     IF scale = 8 THEN OPL.Move( source, dest ) END;
  745.     OPL.DBcc( false, losize.reg, label );
  746.     OPL.DBcc( false, size.reg, label )
  747.    END; (* IF *)
  748.   END; (* IF *)
  749.  END MoveBlock;
  750.  PROCEDURE Assign*( VAR source, dest : OPL.Item );
  751.  (* Generates code for the assignment dest := source.  *)
  752.   VAR size : LONGINT;
  753.     length, src : OPL.Item;
  754.     label : OPL.Label;
  755.     scale : INTEGER;
  756.  BEGIN (* Assign *)
  757.   Convert( source, dest.typ );
  758.   size := source.typ.size;
  759.   OPL.LoadAdr( dest );
  760.   IF source.mode = freg THEN
  761.    OPL.FMove( source, dest )
  762.   ELSIF source.typ.form = Real THEN
  763.    OPL.Move( source, dest )
  764.   ELSIF source.typ.form = LReal THEN
  765.    OPL.LoadAdr( source );
  766.    OPL.LoadExternal( source );
  767.    OPL.LoadExternal( dest );
  768.    source.typ := OPT.linttyp;
  769.    dest.typ := OPT.linttyp;
  770.    OPL.Move( source, dest );
  771.    INC( source.bd, 4 );
  772.    INC( dest.bd, 4 );
  773.    OPL.Move( source, dest );
  774.    DEC( dest.bd, 4 );
  775.    dest.typ := OPT.lrltyp
  776.   ELSIF source.mode IN { coc, fcoc } THEN
  777.    src.mode := imm;
  778.    src.typ := OPT.booltyp;
  779.    label := OPL.NewLabel;
  780.    IF source.mode = coc THEN
  781.     OPL.Jump( SHORT( source.bd MOD 10000H ), source.fJump )
  782.    ELSE
  783.     OPL.FJump( SHORT( source.bd MOD 10000H ), source.fJump )
  784.    END;
  785.    OPL.DefineLabel( source.tJump );
  786.    src.bd := 1;
  787.    OPL.Move( src, dest );
  788.    OPL.Jump( true, label );
  789.    OPL.DefineLabel( source.fJump );
  790.    src.bd := 0;
  791.    OPL.Move( src, dest );
  792.    OPL.DefineLabel( label )
  793.   ELSIF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) THEN
  794.    OPL.Move( source, dest )
  795.   ELSE (* complex data structure *)
  796.    IF source.typ.comp = DynArr THEN
  797.     Size( source, length, scale );
  798.     GetDynArrVal( source )
  799.    ELSE
  800.     IF size MOD 4 = 0 THEN
  801.      scale := 4;
  802.      MakeIntConst( size DIV 4, OPT.linttyp, length )
  803.     ELSIF size MOD 2 = 0 THEN
  804.      scale := 2;
  805.      MakeIntConst( size DIV 2, OPT.linttyp, length )
  806.     ELSE
  807.      scale := 1;
  808.      MakeIntConst( size, OPT.linttyp, length )
  809.     END; (* IF *)
  810.    END; (* IF *)
  811.    MoveBlock( scale, length, source, dest )
  812.   END; (* IF *)
  813.  END Assign;
  814.  PROCEDURE MoveDynArrStack*( formalTyp : OPT.Struct; offset : LONGINT; VAR item : OPL.Item );
  815.  (* Moves the address and the length(s) of the given item to (offset, A7). *)
  816.   VAR source, dest, adr, length, len1 : OPL.Item;
  817.     typ : OPT.Struct;
  818.     i, dim : LONGINT;
  819.     lengthMade : BOOLEAN;
  820.  BEGIN (* MoveDynArrStack *)
  821.   dim := formalTyp.n + 1;
  822.   typ := item.typ;
  823.   dest.mode := regx;
  824.   dest.typ := OPT.linttyp;
  825.   dest.reg := SP.reg;
  826.   dest.bd := offset;
  827.   dest.inxReg := None;
  828.   IF typ.comp = DynArr THEN
  829.    source := item;
  830.    GetDynArrAdr( source, adr )
  831.   ELSE
  832.    adr.mode := areg;
  833.    adr.typ := OPT.sysptrtyp;
  834.    adr.reg := OPL.GetAdrReg( );
  835.    OPL.Lea( item, adr.reg )
  836.   END;
  837.   OPL.Move( adr, dest );
  838.   i := typ.offset - typ.n;
  839.   WHILE ( typ.comp = DynArr ) & ( dim > 1 ) DO
  840.    INC( dest.bd, 4 );
  841.    MakeLen( item, i, length );
  842.    OPL.Move( length, dest );
  843.    INC( i );
  844.    DEC( dim );
  845.    typ := typ.BaseTyp;
  846.    formalTyp := formalTyp.BaseTyp
  847.   END; (* WHILE *)
  848.   WHILE dim > 1 DO
  849.    INC( dest.bd, 4 );
  850.    IF typ.form = String THEN
  851.     MakeIntConst( item.nolen, OPT.linttyp, length )
  852.    ELSE
  853.     MakeIntConst( typ.n, OPT.linttyp, length )
  854.    END; (* IF *)
  855.    OPL.Move( length, dest );
  856.    INC( i );
  857.    DEC( dim );
  858.    typ := typ.BaseTyp;
  859.    formalTyp := formalTyp.BaseTyp
  860.   END; (* WHILE *)
  861.   IF ( formalTyp.comp = DynArr ) & ( formalTyp.BaseTyp = OPT.bytetyp ) THEN
  862.    IF typ.comp = DynArr THEN
  863.     lengthMade := TRUE;
  864.     MakeLen( item, i, length );
  865.     INC( i );
  866.     DEC( dim );
  867.     typ := typ.BaseTyp;
  868.     WHILE typ.comp = DynArr DO
  869.      MakeLen( item, i, len1 );
  870.      OPL.Format12( MULS, len1, length );
  871.      INC( i );
  872.      DEC( dim );
  873.      typ := typ.BaseTyp
  874.     END; (* WHILE *)
  875.    ELSE
  876.     lengthMade := FALSE
  877.    END; (* IF *)
  878.    IF typ.form = String THEN
  879.     MakeIntConst( item.nolen, OPT.linttyp, len1 )
  880.    ELSE
  881.     MakeIntConst( typ.size, OPT.linttyp, len1 )
  882.    END; (* IF *)
  883.    IF lengthMade THEN
  884.     IF len1.bd > 1 THEN OPL.Format12( MULS, len1, length ) END
  885.    ELSE
  886.     length := len1
  887.    END; (* IF *)
  888.   ELSIF typ.comp = DynArr THEN
  889.    MakeLen( item, i, length )
  890.   ELSIF typ.form = String THEN
  891.    MakeIntConst( item.nolen, OPT.linttyp, length )
  892.   ELSE
  893.    MakeIntConst( typ.n, OPT.linttyp, length )
  894.   END; (* IF *)
  895.   INC( dest.bd, 4 );
  896.   OPL.Move( length, dest )
  897.  END MoveDynArrStack;
  898.  PROCEDURE MoveAdrStack*( offset : LONGINT; VAR item : OPL.Item );
  899.  (* Moves the address of the given item to (offset, SP). *)
  900.   VAR dest, adrReg : OPL.Item;
  901.  BEGIN (* MoveAdrStack *)
  902.   dest.mode := regx;
  903.   dest.typ := OPT.sysptrtyp;
  904.   dest.reg := SP.reg;
  905.   dest.bd := offset;
  906.   dest.inxReg := None;
  907.   dest.offsReg := None;
  908.   adrReg.mode := areg;
  909.   adrReg.typ := OPT.sysptrtyp;
  910.   adrReg.reg := OPL.GetAdrReg( );
  911.   OPL.Lea( item, adrReg.reg );
  912.   OPL.Move( adrReg, dest )
  913.  END MoveAdrStack;
  914.  PROCEDURE MoveStack*( offset : LONGINT; VAR item : OPL.Item );
  915.  (* Moves the given item to (offset, SP). *)
  916.   VAR dest : OPL.Item;
  917.  BEGIN (* MoveStack *)
  918.   dest.mode := regx;
  919.   dest.typ := item.typ;
  920.   dest.reg := SP.reg;
  921.   dest.bd := offset;
  922.   dest.inxReg := None;
  923.   dest.offsReg := None;
  924.   Assign( item, dest )
  925.  END MoveStack;
  926.  PROCEDURE Copy*( VAR source, dest : OPL.Item );
  927.  (* Generates code for COPY( source, dest ). dest may not be bigger than 32kB. *)
  928.   VAR destlen : OPL.Item;
  929.     label : OPL.Label;
  930.     src, dst : OPL.Item;
  931.  BEGIN (* Copy *)
  932.   src := source;
  933.   dst := dest;
  934.   IF src.typ.comp = DynArr THEN
  935.    GetDynArrVal( src )
  936.   END; (* IF *)
  937.   IF dst.typ.comp = DynArr THEN
  938.    MakeLen( dst, 0, destlen );
  939.    GetDynArrVal( dst );
  940.    OPL.Load( destlen );
  941.    OPL.Format1( SUBQ, 2, destlen )
  942.   ELSE
  943.    MakeIntConst( dst.typ.n - 2, OPT.linttyp, destlen );
  944.    OPL.Load( destlen )
  945.   END; (* IF *)
  946.   MakePostInc( OPT.chartyp, src );
  947.   MakePostInc( OPT.chartyp, dst );
  948.   label := OPL.NewLabel;
  949.   OPL.DefineLabel( label );
  950.   OPL.Move( src, dst );
  951.   OPL.DBcc( EQ, destlen.reg, label );
  952.   MakeIntConst( 0, OPT.chartyp, src );
  953.   OPL.Move( src, dst )
  954.  END Copy;
  955.  PROCEDURE Decrement*( VAR designator, expression : OPL.Item );
  956.  (* Decrements the value of designator by expression *)
  957.  BEGIN (* Decrement *)
  958.   IF expression.mode = imm THEN
  959.    IF ( expression.bd >= 0 ) & ( expression.bd <= 8 ) THEN
  960.     OPL.Format1( SUBQ, SHORT( expression.bd ), designator )
  961.    ELSE
  962.     OPL.Format6( SUBI, expression.bd, designator )
  963.    END; (* IF *)
  964.   ELSE
  965.    OPL.Format2( SUB, expression, designator )
  966.   END; (* IF *)
  967.  END Decrement;
  968.  PROCEDURE Increment*( VAR designator, expression : OPL.Item );
  969.  (* Increments the value of designator by expression *)
  970.  BEGIN (* Increment *)
  971.   IF expression.mode = imm THEN
  972.    IF ( expression.bd >= 0 ) & ( expression.bd <= 8 ) THEN
  973.     OPL.Format1( ADDQ, SHORT( expression.bd ), designator )
  974.    ELSE
  975.     OPL.Format6( ADDI, expression.bd, designator )
  976.    END; (* IF *)
  977.   ELSE
  978.    OPL.Format2( ADD, expression, designator )
  979.   END; (* IF *)
  980.  END Increment;
  981.  PROCEDURE Include*( VAR set, element : OPL.Item );
  982.  (* set := set + { element } *)
  983.   VAR temp : OPL.Item;
  984.  BEGIN (* Include *)
  985.   temp := set;
  986.   IF element.mode = imm THEN
  987.    OPL.Format4( BSET, element.bd, temp )
  988.   ELSE
  989.    OPL.Format5( BSET, element, temp )
  990.   END; (* IF *)
  991.   OPL.Move( temp, set )
  992.  END Include;
  993.  PROCEDURE Exclude*( VAR set, element : OPL.Item );
  994.  (* set := set - { element } *)
  995.   VAR temp : OPL.Item;
  996.  BEGIN (* Exclude *)
  997.   temp := set;
  998.   IF element.mode = imm THEN
  999.    OPL.Format4( BCLR, element.bd, temp )
  1000.   ELSE
  1001.    OPL.Format5( BCLR, element, temp )
  1002.   END; (* IF *)
  1003.   OPL.Move( temp, set )
  1004.  END Exclude;
  1005.  PROCEDURE EnterMod*;
  1006.  (* Generates code for the entry into the module. *)
  1007.  BEGIN (* EnterMod *)
  1008.   OPL.SetEntry( 0, OPL.pc );
  1009.   OPL.Enter( 0 )
  1010.  END EnterMod;
  1011.  PROCEDURE CopyDynArrs( par : OPT.Object );
  1012.  (* Copys the dynamic arrays which are value-parameters to the stack. *)
  1013.   VAR source, dest, ptr, size, negsize, newSP : OPL.Item;
  1014.     scale : INTEGER;
  1015.  BEGIN (* CopyDynArrs *)
  1016.   WHILE par # NIL DO
  1017.    OPL.usedRegs := { };
  1018.    IF ( par.typ.comp = DynArr ) & ( par.mode = Var ) THEN
  1019.     MakeVar( par, source );
  1020.     Size( source, size, scale );
  1021.     OPL.Load( size );
  1022.     GetDynArrVal( source );
  1023.     IF scale = 1 THEN (* align size to 4 bytes *)
  1024.      OPL.Format1( ADDQ, 3, size );
  1025.      OPL.Format13( ASh, -2, size );
  1026.      scale := 4
  1027.     ELSIF scale = 2 THEN
  1028.      OPL.Format1( ADDQ, 1, size );
  1029.      OPL.Format13( ASh, -1, size );
  1030.      scale := 4
  1031.     END; (* IF *)
  1032.     negsize.mode := dreg;
  1033.     negsize.typ := OPT.linttyp;
  1034.     negsize.reg := OPL.GetReg( );
  1035.     OPL.Move( size, negsize );
  1036.     OPL.Format7( NEG, negsize );
  1037.     newSP.mode := regx;
  1038.     newSP.typ := OPT.sysptrtyp;
  1039.     newSP.reg := SP.reg;
  1040.     newSP.bd := 0;
  1041.     newSP.inxReg := negsize.reg;
  1042.     IF size.typ.form = LInt THEN newSP.xsize := 1 ELSE newSP.xsize := 0 END;
  1043.     newSP.scale := OPL.Scale( scale );
  1044.     OPL.Lea( newSP, SP.reg );
  1045.     dest.mode := areg;
  1046.     dest.typ := OPT.sysptrtyp;
  1047.     dest.reg := OPL.GetAdrReg( );
  1048.     OPL.Move( SP, dest );
  1049.     dest.mode := regx;
  1050.     dest.typ := par.typ;
  1051.     dest.bd := 0;
  1052.     dest.inxReg := None;
  1053.     MoveBlock( scale, size, source, dest );
  1054.     ptr.mode := regx;
  1055.     ptr.typ := OPT.sysptrtyp;
  1056.     ptr.reg := FP.reg;
  1057.     ptr.bd := par.adr;
  1058.     ptr.inxReg := None;
  1059.     OPL.Move( SP, ptr )
  1060.    END; (* IF *)
  1061.    par := par.link
  1062.   END; (* WHILE *)
  1063.  END CopyDynArrs;
  1064.  PROCEDURE EnterProc*( proc : OPT.Object );
  1065.  (* Generates code for the entry into a procedure. If ptrinit is set, the whole local variable area is initialized. *)
  1066.   VAR source, dest, losize, hisize, adrReg : OPL.Item;
  1067.     dsize, i : LONGINT;
  1068.     label : OPL.Label;
  1069.  BEGIN (* EnterProc *)
  1070.   OPL.DefineLabel( proc.linkadr );
  1071.   IF proc.adr # -1 THEN
  1072.    OPL.SetEntry( SHORT( proc.adr MOD 10000H ), OPL.pc )
  1073.   END; (* IF *)
  1074.   dsize := proc.conval.intval;
  1075.   OPL.Enter( -dsize );
  1076.   IF ptrinit THEN
  1077.    MakeIntConst( 0, OPT.linttyp, source );
  1078.    dest.mode := regx;
  1079.    dest.typ := OPT.linttyp;
  1080.    dest.reg := SP.reg;
  1081.    dest.bd := 0;
  1082.    dest.inxReg := None;
  1083.    dest.offsReg := None;
  1084.    IF dsize > 8 THEN   (* old was 24 *)
  1085.     adrReg.mode := areg;
  1086.     adrReg.typ := OPT.sysptrtyp;
  1087.     adrReg.reg := OPL.GetAdrReg( );
  1088.     OPL.Move( SP, adrReg );
  1089.     adrReg.mode := postinc;
  1090.     IF dsize > 20 THEN    (* if the constant is small, the code will be shorter, but slower; 20 is the shortest way *)
  1091.      IF dsize > 4 * MAX( INTEGER ) THEN
  1092.       MakeIntConst( ( dsize DIV 4 - 1 ) DIV 10000H, OPT.inttyp, hisize );
  1093.       OPL.Load( hisize );
  1094.       MakeIntConst( ( dsize DIV 4 - 1 ) MOD 10000H, OPT.inttyp, losize );
  1095.       OPL.Load( losize );
  1096.       label := OPL.NewLabel;
  1097.       OPL.DefineLabel( label );
  1098.       OPL.Move( source, adrReg );
  1099.       OPL.DBcc( false, losize.reg, label );
  1100.       OPL.DBcc( false, hisize.reg, label )
  1101.      ELSE
  1102.       MakeIntConst( dsize DIV 4 - 1, OPT.inttyp, losize );
  1103.       OPL.Load( losize );
  1104.       label := OPL.NewLabel;
  1105.       OPL.DefineLabel( label );
  1106.       OPL.Move( source, adrReg );
  1107.       OPL.DBcc( false, losize.reg, label )
  1108.      END; (* IF *)
  1109.     ELSE
  1110.      FOR i := 1 TO (dsize DIV 4) DO
  1111.       OPL.Move( source, adrReg )
  1112.      END
  1113.     END
  1114.    ELSE
  1115.     FOR i := 1 TO dsize DIV 4 DO
  1116.      OPL.Move( source, dest );
  1117.      INC( dest.bd, 4 )
  1118.     END; (* FOR *)
  1119.    END; (* IF *)
  1120.   END; (* IF *)
  1121.   CopyDynArrs( proc.link )
  1122.  END EnterProc;
  1123.  PROCEDURE Return*( proc : OPT.Object; withRes : BOOLEAN;  VAR result : OPL.Item );
  1124.  (* Generates code for returning from a procedure or a module (proc = NIL).
  1125.   result contains the value that has to be returned in D0 or FP0, if withRes is TRUE.
  1126.   D0 and FP0 can be used because all registers are free. *)
  1127.   VAR d0, fp0 : OPL.Item;
  1128.  BEGIN (* Return *)
  1129.   IF withRes THEN
  1130.    IF proc.typ.form IN RealSet THEN (* result is returned in FP0 *)
  1131.     IF ( result.mode # freg ) OR ( result.reg # 16 ) THEN
  1132.      fp0.mode := freg;
  1133.      fp0.reg := 16;
  1134.      fp0.typ := proc.typ;
  1135.      OPL.FMove( result, fp0 )
  1136.     END; (* IF *)
  1137.    ELSIF ( result.mode # dreg ) OR ( result.reg # 0 ) THEN
  1138.     d0.mode := dreg;
  1139.     d0.reg := 0;
  1140.     d0.typ := proc.typ;
  1141.     Assign( result, d0 ); (* Assign, not Move because of BOOLEAN return values. *)
  1142.    END; (* IF *)
  1143.   END; (* IF *)
  1144.   OPL.Return
  1145.  END Return;
  1146.  PROCEDURE WriteStaticLink*( obj : OPT.Object );
  1147.  (* Writes the static link of the given object to (A7) if necessary. *)
  1148.   VAR source, dest : OPL.Item;
  1149.     diff : INTEGER;
  1150.  BEGIN (* WriteStaticLink *)
  1151.   IF ( obj # NIL ) & ( obj.mnolev > 0 ) & ( obj.mode = LProc ) THEN (* static link needed *)
  1152.    diff := OPL.level - obj.mnolev;
  1153.    IF diff = 0 THEN (* local procedure *)
  1154.     source := FP
  1155.    ELSE
  1156.     source.mode := regx;
  1157.     source.typ := OPT.sysptrtyp;
  1158.     source.reg := FP.reg;
  1159.     source.bd := 8;
  1160.     source.inxReg := None;
  1161.     source.offsReg := None;
  1162.     IF diff > 1 THEN
  1163.      dest.mode := areg;
  1164.      dest.typ := OPT.sysptrtyp;
  1165.      dest.reg := OPL.GetAdrReg( );
  1166.      OPL.Move( source, dest );
  1167.      source.reg := dest.reg;
  1168.      WHILE diff > 2 DO
  1169.       OPL.Move( source, dest );
  1170.       DEC( diff )
  1171.      END; (* WHILE *)
  1172.     END; (* IF *)
  1173.    END; (* IF *)
  1174.    MoveStack( 0, source )
  1175.   END; (* IF *)
  1176.  END WriteStaticLink;
  1177.  PROCEDURE Call*( VAR item : OPL.Item; obj : OPT.Object );
  1178.  (* Calls the given procedure. *)
  1179.  BEGIN (* Call *)
  1180.   IF ( obj # NIL ) & ( obj.mode = CProc ) THEN
  1181.    OPL.WriteCProc( obj^.conval^.ext )
  1182.   ELSIF item.mode = imm THEN
  1183.    OPL.Bsr( item.bd );
  1184.    obj.linkadr := item.bd
  1185.   ELSE
  1186.    DeRef( OPT.sysptrtyp, item );
  1187.    OPL.Format15( JSR, item )
  1188.   END; (* IF *)
  1189.  END Call;
  1190.  PROCEDURE GetResult*( typ : OPT.Struct; VAR res : OPL.Item );
  1191.  (* Returns the result of a function call. *)
  1192.   VAR d0, fp0 : OPL.Item;
  1193.  BEGIN (* GetResult *)
  1194.   IF typ.form IN RealSet THEN
  1195.    IF 16 IN OPL.usedRegs THEN
  1196.     fp0.mode := freg;
  1197.     fp0.typ := typ;
  1198.     fp0.reg := 16;
  1199.     res.mode := freg;
  1200.     res.typ := typ;
  1201.     res.reg := OPL.GetFReg( );
  1202.     OPL.FMove( fp0, res )
  1203.    ELSE
  1204.     res.mode := freg;
  1205.     res.typ := typ;
  1206.     res.reg := 16;
  1207.     INCL( OPL.usedRegs, 16 )
  1208.    END; (* IF *)
  1209.   ELSIF 0 IN OPL.usedRegs THEN
  1210.    res.mode := dreg;
  1211.    res.typ := typ;
  1212.    res.reg := OPL.GetReg( );
  1213.    d0.mode := dreg;
  1214.    d0.typ := typ;
  1215.    d0.reg := 0;
  1216.    OPL.Move( d0, res )
  1217.   ELSE
  1218.    res.mode := dreg;
  1219.    res.typ := typ;
  1220.    res.reg := 0;
  1221.    INCL( OPL.usedRegs, 0 )
  1222.   END; (* IF *)
  1223.  END GetResult;
  1224.  PROCEDURE TypeTest*( VAR item : OPL.Item; typ : OPT.Struct; guard, equal : BOOLEAN );
  1225.  (* Generates code for a type test. If equal is true, the two types have to be equal, if guard is true, a Trap is generated
  1226.   if the test fails. If both are false, only the condition codes are set. *)
  1227.   VAR tag : OPL.Item;
  1228.     savedRegs : SET;
  1229.  BEGIN (* TypeTest *)
  1230.   savedRegs := OPL.usedRegs;
  1231.   IF ~ equal THEN
  1232.    DeRef( OPT.sysptrtyp, item );
  1233.    INC( item.bd, LONG( LONG( OPL.BaseTypeOffs + 4 * typ.extlev ) ) )
  1234.   END; (* IF *)
  1235.   OPL.Load( item );
  1236.   StaticTag( typ, tag );
  1237.   OPL.Cmp( tag, item );
  1238.   IF equal THEN
  1239.    OPL.Trapcc( NE, eqGuardTrap )
  1240.   ELSIF guard THEN
  1241.    OPL.Trapcc( NE, guardTrap )
  1242.   ELSE
  1243.    MakeCocItem( EQ, item )
  1244.   END; (* IF *)
  1245.   OPL.usedRegs := savedRegs;
  1246.  END TypeTest;
  1247.  PROCEDURE Case*( VAR expression : OPL.Item; lo, hi : LONGINT; VAR label : OPL.Label; VAR jtAdr : LONGINT );
  1248.  (* Generates the initializing part of a case statement and allocates the jump table.
  1249.   label denotes the else part of the case statement, jtAdr is the address of the jump table. *)
  1250.   VAR loItem, jumpTabEntry, jumpAddress : OPL.Item;
  1251.     jumpTab : ARRAY OPM.MaxCaseRange OF INTEGER;
  1252.  BEGIN (* Case *)
  1253.   OPL.Load( expression );
  1254.   IF expression.typ.form IN ByteSet THEN Convert( expression, OPT.inttyp ) END;
  1255.   MakeIntConst( lo, expression.typ, loItem );
  1256.   OPL.Format2( SUB, loItem, expression );
  1257.   OPL.Format6( CMPI, hi - lo, expression );
  1258.   OPL.Jump( HI, label );
  1259.   OPL.AllocBytes( jumpTab, 2 * ( hi - lo + 1 ), jtAdr );
  1260.   jumpTabEntry.mode := pcx;
  1261.   jumpTabEntry.typ := OPT.inttyp;
  1262.   jumpTabEntry.bd := jtAdr - OPL.ConstSize - OPL.dsize;
  1263.   jumpTabEntry.inxReg := expression.reg;
  1264.   IF expression.typ.size = 4 THEN
  1265.    jumpTabEntry.xsize := 1
  1266.   ELSE
  1267.    jumpTabEntry.xsize := 0;
  1268.    Convert( expression, OPT.inttyp )
  1269.   END; (* IF *)
  1270.   jumpTabEntry.scale := 1; (* 2 bytes *)
  1271.   OPL.Load( jumpTabEntry );
  1272.   jumpAddress.mode := pcx;
  1273.   jumpAddress.typ := OPT.sysptrtyp;
  1274.   jumpAddress.bd := 0;
  1275.   jumpAddress.inxReg := jumpTabEntry.reg;
  1276.   jumpAddress.xsize := 0; (* word *)
  1277.   jumpAddress.scale := 1; (* *2 *)
  1278.   OPL.Format15( JMP, jumpAddress )
  1279.  END Case;
  1280.  PROCEDURE AddToSP*( data : LONGINT );
  1281.  (* Subtracts the immediate value 'data' from the stack pointer. *)
  1282.  (* no ADDQ/SUBQ, new OPL does it in a better way *)
  1283.   VAR source : OPL.Item;
  1284.  BEGIN (* AddToSP *)
  1285.   IF data > 0 THEN
  1286.    (*IF data < 8 THEN
  1287.     OPL.Format1( ADDQ, SHORT( data ), SP )
  1288.    ELSE*)
  1289.     MakeIntConst( data, OPT.linttyp, source );
  1290.     OPL.Format3( ADD, source, SP.reg );
  1291.    (*END; (* IF *)*)
  1292.   ELSIF data < 0 THEN
  1293.    data := -data;
  1294.    (*IF data < 8 THEN
  1295.     OPL.Format1( SUBQ, SHORT( data ), SP )
  1296.    ELSE*)
  1297.     MakeIntConst( data, OPT.linttyp, source );
  1298.     OPL.Format3( SUB, source, SP.reg );
  1299.    (*END; (* IF *)*)
  1300.   END; (* IF *)
  1301.  END AddToSP;
  1302.  PROCEDURE Test*( VAR item : OPL.Item );
  1303.  (* Tests a boolean item and makes a coc item. fcoc items are left unchanged. *)
  1304.  BEGIN (* Test *)
  1305.   IF ( item.mode # coc ) & ( item.mode # fcoc ) THEN
  1306.    OPL.Load( item );
  1307.    OPL.Format7( TST, item );
  1308.    MakeCocItem( NE, item )
  1309.   END; (* IF *)
  1310.  END Test;
  1311.  PROCEDURE UpTo*( VAR low, high, res : OPL.Item );
  1312.  (* set constructor res := { low .. high }. *)
  1313.   VAR chkItem, leftShift, rightShift : OPL.Item;
  1314.  BEGIN (* UpTo *)
  1315.   res.mode := dreg;
  1316.   res.typ := OPT.settyp;
  1317.   res.reg := OPL.GetReg( );
  1318.   IF rangeCheck THEN
  1319.    MakeIntConst( OPM.MaxSet, high.typ, chkItem );
  1320.    IF low.mode # imm THEN OPL.Chk( low, chkItem ) END;
  1321.    IF high.mode # imm THEN OPL.Chk( high, chkItem ) END
  1322.   END; (* IF *)
  1323.   rightShift.mode := dreg;
  1324.   rightShift.typ := high.typ;
  1325.   rightShift.reg := OPL.GetReg( );
  1326.   leftShift.mode := dreg;
  1327.   leftShift.typ := high.typ;
  1328.   leftShift.reg := OPL.GetReg( );
  1329.   OPL.Moveq( OPM.MaxSet, rightShift.reg );
  1330.   OPL.Format2( SUB, high, rightShift );
  1331.   OPL.Move( rightShift, leftShift );
  1332.   OPL.Format2( ADD, low, leftShift );
  1333.   OPL.Moveq( -1, res.reg );
  1334.   OPL.Format14( LSh, 1, leftShift, res );
  1335.   OPL.Format14( LSh, 0, rightShift, res );
  1336.   OPL.FreeReg( high );
  1337.   OPL.FreeReg( low );
  1338.   OPL.FreeReg( leftShift );
  1339.   OPL.FreeReg( rightShift )
  1340.  END UpTo;
  1341.  PROCEDURE Abs*( VAR item : OPL.Item );
  1342.  (* Generates code for the calculation of the absolute value of the given item. *)
  1343.   VAR label : OPL.Label;
  1344.  BEGIN (* Abs *)
  1345.   IF item.typ.form IN RealSet THEN
  1346.    OPL.Format8( FABS, item, item )
  1347.   ELSE
  1348.    OPL.Load( item );
  1349.    label := OPL.NewLabel;
  1350.    OPL.Format7( TST, item );
  1351.    OPL.Jump( GE, label );
  1352.    OPL.Format7( NEG, item );
  1353.    OPL.DefineLabel( label )
  1354.   END; (* IF *)
  1355.  END Abs;
  1356.  PROCEDURE Adr*( VAR item : OPL.Item );
  1357.  (* Generates code for the calculation of the address of the given item. *)
  1358.   VAR reg : INTEGER;
  1359.     adr : OPL.Item;
  1360.  BEGIN (* Adr *)
  1361.   IF item.typ.comp = DynArr THEN
  1362.    GetDynArrAdr( item, adr );
  1363.    item := adr
  1364.   ELSIF item.mode IN { regx, pcx } THEN
  1365.    reg := OPL.GetAdrReg( );
  1366.    OPL.Lea( item, reg );
  1367.    item.mode := areg;
  1368.    item.reg := reg
  1369.   ELSIF item.mode = abs THEN
  1370.    item.mode := immL
  1371.   ELSE
  1372.    HALT( 94 )
  1373.   END; (* IF *)
  1374.   item.typ := OPT.sysptrtyp
  1375.  END Adr;
  1376.  PROCEDURE Cap*( VAR item : OPL.Item );
  1377.  (* Generates code for the calculation of CAP( item ). For characters only. *)
  1378.  BEGIN (* Cap *)
  1379.   OPL.Load( item );
  1380.   OPL.Format4( BCLR, 5, item )
  1381.  END Cap;
  1382.  PROCEDURE Neg*( VAR item : OPL.Item );
  1383.  (* Generates code for the calculation of -item. *)
  1384.  BEGIN (* Neg *)
  1385.   IF item.typ.form IN RealSet THEN
  1386.    OPL.Format8( FNEG, item, item )
  1387.   ELSIF item.typ.form = Set THEN
  1388.    OPL.Load( item );
  1389.    OPL.Format7( NOT, item )
  1390.   ELSE
  1391.    OPL.Load( item );
  1392.    OPL.Format7( NEG, item )
  1393.   END; (* IF *)
  1394.  END Neg;
  1395.  PROCEDURE Not*( VAR item : OPL.Item );
  1396.  (* Generates code for the calculation of ~ item. For Booleans only. *)
  1397.   VAR tcond, fcond : LONGINT;
  1398.  BEGIN (* Not *)
  1399.   IF ( item.mode = coc ) OR ( item.mode = fcoc ) THEN
  1400.    tcond := item.bd DIV 10000H;
  1401.    fcond := item.bd MOD 10000H;
  1402.    item.bd := 10000H * fcond + tcond
  1403.   ELSE
  1404.    OPL.Load( item );
  1405.    OPL.Format7( TST, item );
  1406.    MakeCocItem( EQ, item )
  1407.   END; (* IF *)
  1408.  END Not;
  1409.  PROCEDURE Odd*( VAR item : OPL.Item );
  1410.  (* Generates code for the calculation of ODD( item ). *)
  1411.  BEGIN (* Odd *)
  1412.   OPL.Load( item );
  1413.   OPL.Format4( BTST, 0, item );
  1414.   MakeCocItem( NE, item )
  1415.  END Odd;
  1416.  PROCEDURE Plus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1417.  (* Generates code for the addition dest := dest + source. *)
  1418.  BEGIN (* Plus *)
  1419.   OPL.AssertDestReg( typ, source, dest );
  1420.   IF typ.form = Set THEN
  1421.    OPL.Format2( oR, source, dest )
  1422.   ELSIF typ.form IN RealSet THEN
  1423.    OPL.Format8( FADD, source, dest )
  1424.   ELSE
  1425.    OPL.Format2( ADD, source, dest )
  1426.   END; (* IF *)
  1427.   OPL.FreeReg( source )
  1428.  END Plus;
  1429.  PROCEDURE Minus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1430.  (* Generates code for the subtraktion dest := dest - source. *)
  1431.  BEGIN (* Minus *)
  1432.   IF typ.form = Set THEN
  1433.    OPL.Load( dest );
  1434.    OPL.Load( source );
  1435.    OPL.Format7( NOT, source );
  1436.    OPL.Format2( AND, source, dest )
  1437.   ELSIF typ.form IN RealSet THEN
  1438.    OPL.FLoad( dest );
  1439.    OPL.Format8( FSUB, source, dest )
  1440.   ELSE
  1441.    OPL.Load( dest );
  1442.    OPL.Format2( SUB, source, dest )
  1443.   END; (* IF *)
  1444.   OPL.FreeReg( source )
  1445.  END Minus;
  1446.  PROCEDURE Mul*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1447.  (* Generates code for the multiplication dest := dest * source. *)
  1448.  BEGIN (* Mul *)
  1449.   OPL.AssertDestReg( typ, source, dest );
  1450.   IF typ.form = Set THEN
  1451.    OPL.Format2( AND, source, dest )
  1452.   ELSIF typ.form IN RealSet THEN
  1453.    OPL.Format8( FMUL, source, dest )
  1454.   ELSIF typ.form = SInt THEN
  1455.    Convert( source, OPT.inttyp );
  1456.    Convert( dest, OPT.inttyp );
  1457.    OPL.Format11( MULS, source, dest )
  1458.   ELSIF typ.form = Int THEN
  1459.    OPL.Format11( MULS, source, dest )
  1460.   ELSIF typ.form = LInt THEN
  1461.    Convert( source, OPT.linttyp );
  1462.    Convert( dest, OPT.linttyp );
  1463.    OPL.Format12( MULS, source, dest )
  1464.   END; (* IF *)
  1465.   OPL.FreeReg( source )
  1466.  END Mul;
  1467.  PROCEDURE Divide*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1468.  (* Generates code for the division dest := dest / source. *)
  1469.  BEGIN (* Divide *)
  1470.   IF typ.form = Set THEN
  1471.    OPL.Load( dest );
  1472.    OPL.Eor( source, dest )
  1473.   ELSE
  1474.    OPL.Format8( FDIV, source, dest )
  1475.   END; (* IF *)
  1476.   OPL.FreeReg( source )
  1477.  END Divide;
  1478.  PROCEDURE Div*( VAR source, dest : OPL.Item );
  1479.  (* Generates code for the integer division dest := dest DIV source. *)
  1480.   VAR label : OPL.Label;
  1481.     remainder : OPL.Item;
  1482.  BEGIN (* Div *)
  1483.   OPL.Load( dest );
  1484.   Convert( dest, OPT.linttyp );
  1485.   IF source.typ.form = LInt THEN
  1486.    remainder.mode := dreg;
  1487.    remainder.reg := OPL.GetReg( );
  1488.    remainder.typ := OPT.linttyp;
  1489.    OPL.Divsl( source, remainder, dest );
  1490.    OPL.Format4( BTST, 31, remainder )
  1491.   ELSE
  1492.    Convert( source, OPT.inttyp );
  1493.    OPL.Format11( DIVS, source, dest );
  1494.    OPL.Format4( BTST, 31, dest )
  1495.   END; (* IF *)
  1496.   label := OPL.NewLabel;
  1497.   OPL.Jump( EQ, label );
  1498.   OPL.Format1( SUBQ, 1, dest );
  1499.   OPL.DefineLabel( label );
  1500.   OPL.FreeReg( source )
  1501.  END Div;
  1502.  PROCEDURE Mod*( VAR source, dest : OPL.Item );
  1503.  (* Generates code for the remainder dest := dest MOD source.*)
  1504.   VAR label : OPL.Label;
  1505.     remainder : OPL.Item;
  1506.  BEGIN (* Mod *)
  1507.   OPL.Load( source ); (* because it is used twice and may be a pc-item. *)
  1508.   OPL.Load( dest );
  1509.   Convert( dest, OPT.linttyp );
  1510.   IF source.typ.form = LInt THEN
  1511.    remainder.mode := dreg;
  1512.    remainder.typ := OPT.linttyp;
  1513.    remainder.reg := OPL.GetReg( );
  1514.    OPL.Divsl( source, remainder, dest );
  1515.    dest := remainder;
  1516.    OPL.Format4( BTST, 31, dest )
  1517.   ELSE
  1518.    Convert( source, OPT.inttyp );
  1519.    OPL.Format11( DIVS, source, dest );
  1520.    OPL.Swap( dest );
  1521.    OPL.Format4( BTST, 15, dest )
  1522.   END; (* IF *)
  1523.   label := OPL.NewLabel;
  1524.   OPL.Jump( EQ, label );
  1525.   OPL.Format2( ADD, source, dest );
  1526.   OPL.DefineLabel( label );
  1527.   OPL.FreeReg( source )
  1528.  END Mod;
  1529.  PROCEDURE Mask*( mask : LONGINT; VAR dest : OPL.Item );
  1530.  (* Generates code for the calculation of dest := dest & ~mask. Used for MOD. *)
  1531.  BEGIN (* Mask *)
  1532.   OPL.Load( dest );
  1533.   OPL.Format6( ANDI, mask, dest )
  1534.  END Mask;
  1535.  PROCEDURE In*( VAR element, set, dest : OPL.Item );
  1536.  (* Generates code for the calculation of dest := element IN set. *)
  1537.  BEGIN (* In *)
  1538.   IF element.mode = imm THEN
  1539.    OPL.Format4( BTST, element.bd, set )
  1540.   ELSE
  1541.    OPL.Format5( BTST, element, set )
  1542.   END; (* IF *)
  1543.   MakeCocItem( NE, dest )
  1544.  END In;
  1545.  PROCEDURE LoadCC*( VAR item : OPL.Item );
  1546.  (* If item.mode is coc or fcoc, the item is loaded into a data register. *)
  1547.   VAR temp : OPL.Item;
  1548.  BEGIN (* LoadCC *)
  1549.   IF item.mode IN { coc, fcoc } THEN
  1550.    temp := item;
  1551.    item.mode := dreg;
  1552.    item.typ := OPT.booltyp;
  1553.    item.reg := OPL.GetReg( );
  1554.    Assign( temp, item )
  1555.   END; (* IF *)
  1556.  END LoadCC;
  1557.  PROCEDURE Compare*( kind : SHORTINT; VAR left, right, res : OPL.Item );
  1558.  (* Compares left and right and generates a coc- or fcoc-item. *)
  1559.   VAR tCond : INTEGER;
  1560.     dreg1, dreg2 : OPL.Item;
  1561.     begLabel, endLabel : OPL.Label;
  1562.  BEGIN (* Compare *)
  1563.   IF left.typ.form IN RealSet THEN
  1564.    OPL.Format8( FCMP, right, left );
  1565.    CASE kind OF
  1566.     eql : tCond := FEQ
  1567.     | neq : tCond := FNE
  1568.     | lss : tCond := FLT
  1569.     | leq : tCond := FLE
  1570.     | gtr : tCond := FGT
  1571.     | geq : tCond := FGE
  1572.    END; (* CASE *)
  1573.    MakeFCocItem( tCond, res )
  1574.   ELSE
  1575.    IF ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
  1576.     IF left.typ.comp = DynArr THEN GetDynArrVal( left ) END;
  1577.     MakePostInc( OPT.chartyp, left );
  1578.     IF right.typ.comp = DynArr THEN GetDynArrVal( right ) END;
  1579.     MakePostInc( OPT.chartyp, right );
  1580.     dreg1.mode := dreg;
  1581.     dreg1.typ := OPT.chartyp;
  1582.     dreg1.reg := OPL.GetReg( );
  1583.     dreg2.mode := dreg;
  1584.     dreg2.typ := OPT.chartyp;
  1585.     dreg2.reg := OPL.GetReg( );
  1586.     begLabel := OPL.NewLabel;
  1587.     endLabel := OPL.NewLabel;
  1588.     OPL.DefineLabel( begLabel );
  1589.     OPL.Move( left, dreg1 );
  1590.     OPL.Move( right, dreg2 );
  1591.     OPL.Cmp( dreg2, dreg1 );
  1592.     OPL.Jump( NE, endLabel );
  1593.     OPL.Format7( TST, dreg1 );
  1594.     OPL.Jump( NE, begLabel );
  1595.     OPL.DefineLabel( endLabel );
  1596.     OPL.Cmp( dreg2, dreg1 )
  1597.    ELSE
  1598.     IF right.typ = OPT.niltyp THEN Convert( right, OPT.sysptrtyp ) END;
  1599.     LoadCC( left );
  1600.     LoadCC( right );
  1601.     OPL.Cmp( right, left )
  1602.    END; (* IF *)
  1603.    IF ( left.typ.form = Char ) OR ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
  1604.     CASE kind OF
  1605.      eql : tCond := EQ
  1606.      | neq : tCond := NE
  1607.      | lss : tCond := CS
  1608.      | leq : tCond := LS
  1609.      | gtr : tCond := HI
  1610.      | geq : tCond := CC
  1611.     END; (* CASE *)
  1612.    ELSE
  1613.     CASE kind OF
  1614.      eql : tCond := EQ
  1615.      | neq : tCond := NE
  1616.      | lss : tCond := LT
  1617.      | leq : tCond := LE
  1618.      | gtr : tCond := GT
  1619.      | geq : tCond := GE
  1620.     END; (* CASE *)
  1621.    END; (* IF *)
  1622.    MakeCocItem( tCond, res )
  1623.   END; (* IF *)
  1624.  END Compare;
  1625.  PROCEDURE Shift*( opcode : INTEGER; VAR shift, dest : OPL.Item );
  1626.  (* Generates code for the calculation of ASH( dest, shift ), SYSTEM.LSH( dest, shift ) and SYSTEM.ROT( dest, shift ). *)
  1627.   VAR elseLabel, endLabel : OPL.Label;
  1628.  BEGIN (* Shift *)
  1629.   IF shift.mode = imm THEN
  1630.    IF shift.bd # 0 THEN
  1631.     IF ( shift.bd >= -8 ) & ( shift.bd <= 8 ) THEN
  1632.      OPL.Format13( opcode, SHORT( shift.bd ), dest )
  1633.     ELSE
  1634.      IF shift.bd < 0 THEN
  1635.       MakeIntConst( -shift.bd, OPT.inttyp, shift );
  1636.       OPL.Format14( opcode, 0, shift, dest )
  1637.      ELSE
  1638.       MakeIntConst( shift.bd, OPT.inttyp, shift );
  1639.       OPL.Format14( opcode, 1, shift, dest )
  1640.      END; (* IF *)
  1641.     END; (* IF *)
  1642.    END; (* IF *)
  1643.   ELSE (* shift must be tested, because the machine instructions only take positive shifts. *)
  1644.    elseLabel := OPL.NewLabel;
  1645.    endLabel := OPL.NewLabel;
  1646.    OPL.Load( shift );
  1647.    OPL.Load( dest );
  1648.    OPL.Format7( TST, shift );
  1649.    OPL.Jump( LT, elseLabel );
  1650.    OPL.Format14( opcode, 1, shift, dest );
  1651.    OPL.Jump( true, endLabel );
  1652.    OPL.DefineLabel( elseLabel );
  1653.    OPL.Format7( NEG, shift );
  1654.    OPL.Format14( opcode, 0, shift, dest );
  1655.    OPL.DefineLabel( endLabel )
  1656.   END; (* IF *)
  1657.  END Shift;
  1658.  PROCEDURE Trap*( nr : INTEGER );
  1659.  (* Generates code for a trap. *)
  1660.  BEGIN (* Trap *)
  1661.   OPL.Trapcc( true, nr )
  1662.  END Trap;
  1663.  PROCEDURE RunTime( nr : INTEGER );
  1664.  (* Calls the given run-time routine. *)
  1665.    VAR proc : OPL.Item;
  1666.  BEGIN (* RunTime *)
  1667.   proc.mode := abs;
  1668.   proc.typ := OPT.sysptrtyp;
  1669.   proc.bd := SYSTEM.LSH( LONG( 255 ), 8 ) + nr;
  1670.   OPL.Format15( JSR, proc )
  1671.  END RunTime;
  1672.  PROCEDURE PtrCheck( typ : OPT.Struct );
  1673.   VAR ptrTab : ARRAY 1 OF LONGINT;
  1674.     nofptrs : INTEGER;
  1675.  BEGIN (* PtrCheck *)
  1676.   nofptrs := 0;
  1677.   OPL.FindPtrs( typ, 0, ptrTab, nofptrs );
  1678.   IF nofptrs > 0 THEN OPM.err( -303 ) END
  1679.  END PtrCheck;
  1680.  PROCEDURE New*( VAR designator, tag : OPL.Item );
  1681.  (* Generates the code for calling NEW( designator ). *)
  1682.   VAR sppredec, res : OPL.Item;
  1683.     savedRegs : SET;
  1684.  BEGIN (* New *)
  1685.   savedRegs := OPL.usedRegs;
  1686.   PushRegs( savedRegs );
  1687.   MakeSPPredec( sppredec );
  1688.   OPL.Move( tag, sppredec );
  1689.   RunTime( 0 );
  1690.   AddToSP( 4 );
  1691.   GetResult( OPT.sysptrtyp, res );
  1692.   PopRegs( savedRegs );
  1693.   OPL.Move( res, designator )
  1694.  END New;
  1695.  PROCEDURE SYSNew*( VAR designator, size : OPL.Item );
  1696.  (* Generates the code for calling SYSTEM.NEW( designator, size ). *)
  1697.   VAR sppredec, res : OPL.Item;
  1698.     savedRegs : SET;
  1699.  BEGIN (* SYSNew *)
  1700.   PtrCheck( designator.typ.BaseTyp );
  1701.   savedRegs := OPL.usedRegs;
  1702.   PushRegs( savedRegs );
  1703.   MakeSPPredec( sppredec );
  1704.   Convert( size, OPT.linttyp );
  1705.   OPL.Move( size, sppredec );
  1706.   RunTime( 1 );
  1707.   AddToSP( 4 );
  1708.   GetResult( OPT.sysptrtyp, res );
  1709.   PopRegs( savedRegs );
  1710.   OPL.Move( res, designator )
  1711.  END SYSNew;
  1712.  PROCEDURE SYSMove*( VAR sourceAdr, destAdr, length : OPL.Item );
  1713.  (* Generates code for SYSTEM.MOVE( sourceAdr, destAdr, length ). *)
  1714.   VAR source, dest : OPL.Item;
  1715.  BEGIN (* SYSMove *)
  1716.   source.mode := areg;
  1717.   source.typ := OPT.linttyp;
  1718.   source.reg := OPL.GetAdrReg( );
  1719.   Convert( sourceAdr, OPT.linttyp );
  1720.   OPL.Move( sourceAdr, source );
  1721.   source.mode := postinc;
  1722.   source.typ := OPT.sinttyp;
  1723.   dest.mode := areg;
  1724.   dest.typ := OPT.linttyp;
  1725.   dest.reg := OPL.GetAdrReg( );
  1726.   Convert( destAdr, OPT.linttyp );
  1727.   OPL.Move( destAdr, dest );
  1728.   dest.mode := postinc;
  1729.   dest.typ := OPT.sinttyp;
  1730.   MoveBlock( 1, length, source, dest )
  1731.  END SYSMove;
  1732.  PROCEDURE SYSGet*( VAR adr, dest : OPL.Item );
  1733.  (* Generates code for SYSTEM.GET( adr, dest ). *)
  1734.   VAR adrReg : OPL.Item;
  1735.  BEGIN (* SYSGet *)
  1736.   adrReg.mode := areg;
  1737.   adrReg.typ := OPT.linttyp;
  1738.   adrReg.reg := OPL.GetAdrReg( );
  1739.   OPL.Move( adr, adrReg );
  1740.   adrReg.mode := regx;
  1741.   adrReg.bd := 0;
  1742.   adrReg.typ := dest.typ;
  1743.   adrReg.inxReg := None;
  1744.   Assign( adrReg, dest )
  1745.  END SYSGet;
  1746.  PROCEDURE SYSPut*( VAR source, address : OPL.Item );
  1747.  (* Generates code for SYSTEM.PUT( source, address ). *)
  1748.   VAR adrReg : OPL.Item;
  1749.  BEGIN (* SYSPut *)
  1750.   adrReg.mode := areg;
  1751.   adrReg.typ := OPT.linttyp;
  1752.   adrReg.reg := OPL.GetAdrReg( );
  1753.   address.typ := OPT.sysptrtyp;
  1754.   OPL.Move( address, adrReg );
  1755.   adrReg.mode := regx;
  1756.   adrReg.typ := source.typ;
  1757.   adrReg.bd := 0;
  1758.   adrReg.inxReg := None;
  1759.   Assign( source, adrReg )
  1760.  END SYSPut;
  1761.  PROCEDURE SYSGetReg*( VAR dest, sourceReg : OPL.Item );
  1762.  (* Generates code for SYSTEM.GETREG( sourceReg, dest ). *)
  1763.  BEGIN (* SYSGetReg *)
  1764.   sourceReg.reg := SHORT( sourceReg.bd );
  1765.   sourceReg.typ := dest.typ;
  1766.   IF ( sourceReg.bd >= 0 ) & ( sourceReg.bd <= 7 ) THEN
  1767.    sourceReg.mode := dreg;
  1768.    OPL.Move( sourceReg, dest )
  1769.   ELSIF ( sourceReg.bd >= 8 ) & ( sourceReg.bd <= 15 ) THEN
  1770.    sourceReg.mode := areg;
  1771.    OPL.Move( sourceReg, dest )
  1772.   ELSIF ( sourceReg.bd >= 16 ) & ( sourceReg.bd <= 23 ) THEN
  1773.    sourceReg.mode := freg;
  1774.    OPL.FMove( sourceReg, dest )
  1775.   ELSE
  1776.    OPM.err( 220 )
  1777.   END; (* IF *)
  1778.  END SYSGetReg;
  1779.  PROCEDURE SYSPutReg*( VAR source, destReg : OPL.Item );
  1780.  (* Generates code for SYSTEM.PUTREG( destReg, source ). *)
  1781.  BEGIN (* SYSPutReg *)
  1782.   destReg.reg := SHORT( destReg.bd );
  1783.   IF ( destReg.bd >= 0 ) & ( destReg.bd <= 7 ) THEN
  1784.    destReg.mode := dreg;
  1785.    OPL.Move( source, destReg )
  1786.   ELSIF ( destReg.bd >= 8 ) & ( destReg.bd <= 15 ) THEN
  1787.    destReg.mode := areg;
  1788.    OPL.Move( source, destReg )
  1789.   ELSIF ( destReg.bd >= 16 ) & ( destReg.bd <= 23 ) THEN
  1790.    destReg.mode := freg;
  1791.    OPL.FMove( source, destReg )
  1792.   ELSE
  1793.    OPM.err( 220 )
  1794.   END; (* IF *)
  1795.  END SYSPutReg;
  1796.  PROCEDURE SYSBit*( VAR adr, bitnr, res : OPL.Item );
  1797.  (* Generates code for SYSTEM.BIT( adr, bitnr ). *)
  1798.   VAR adrItem : OPL.Item;
  1799.  BEGIN (* SYSBit *)
  1800.   adrItem.mode := areg;
  1801.   adrItem.reg := OPL.GetAdrReg( );
  1802.   adrItem.typ := OPT.sysptrtyp;
  1803.   adr.typ := OPT.sysptrtyp;
  1804.   OPL.Move( adr, adrItem );
  1805.   adrItem.mode := regx;
  1806.   adrItem.bd := 0;
  1807.   adrItem.inxReg := None;
  1808.   IF bitnr.mode = imm THEN
  1809.    OPL.Format4( BTST, bitnr.bd, adrItem )
  1810.   ELSE
  1811.    OPL.Format5( BTST, bitnr, adrItem )
  1812.   END; (* IF *)
  1813.   MakeCocItem( NE, res )
  1814.  END SYSBit;
  1815. BEGIN (* OPC *)
  1816.  FP.mode := areg;
  1817.  FP.typ := OPT.sysptrtyp;
  1818.  FP.reg := 14;
  1819.  SP.mode := areg;
  1820.  SP.typ := OPT.sysptrtyp;
  1821.  SP.reg := 15;
  1822.  saveRegs:=TRUE
  1823. END OPC.
  1824.