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