Syntax24b.Scn.Fnt
ParcElems
Alloc
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
(* Amiga NonFPU *) 
MODULE OPC;
(* Code Generator for MC68020.
 Diplomarbeit Samuel Urech
 Date: 6.11.92   Current version: 26.2.93 
 Bug concerning record assignment (projection) in Convert fixed by cn/shml 30 Jun 94
 Nil-Check by rd/cn 22.05.95 *)
 IMPORT SYSTEM, OPT, OPL, OPM, AmigaMathL;
 CONST
  (* object modes *)
  Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  SProc = 8; CProc = 9; IProc = 10; Head = 12; TProc = 13;
  (* accessibility of objects *)
  internal = 0; external = 1; externalR = 2;
  (* structure forms *)
  Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  Pointer = 13; ProcTyp = 14; Comp = 15;
  (* composite structure forms *)
  Basic = 1; Array = 2; DynArr = 3; Record = 4;
  IntSet = { SInt .. LInt };
  RealSet = { Real, LReal };
  ByteSet = { SInt, Byte, Char, Bool };
  WordSet = { Int };
  LongSet = { LInt, Set, Pointer, ProcTyp };
  (* item modes *)
  dreg = 0; areg = 1; freg = 2; postinc = 3; predec = 4; regx = 5; abs = 7; imm = 8; immL = 9; pcx = 10; coc = 12; fcoc = 13;
  (* sizes *)
  byte = 0; word = 1; long = 2;
  (* opcodes *)
  ADD = 13; AND = 12; oR = 8; SUB = 9;
  BCHG = 1; BCLR = 2; BSET = 3; BTST = 0;
  ADDI = 6; ANDI = 2; CMPI = 12; EORI = 10; ORI = 0; SUBI = 4;
  ADDQ = 0; SUBQ = 1;
  CLR = 2; NEG = 4; NEGX = 0; NOT = 6; TST = 10;
  BFCHG = 10; BFCLR = 12; BFSET = 14; BFTST = 8;
  DIVS = 81C0H; DIVU = 80C0H; MULS = 0C1C0H; MULU = 0C0C0H;
  ASh = 0; LSh = 1; ROt = 3; ROX = 2;
  JMP = 3BH; JSR = 3AH; PEA = 21H; NBCD = 20H; TAS = 2BH;
  (* Coprocessor opcodes *)
  FABS = 18H; FACOS = 1CH; FADD = 22H; FASIN = 0CH; FATAN = 0AH; FATANH = 0DH; FCMP = 38H;
  FCOS = 1DH; FCOSH = 19H; FDIV = 20H; FETOX = 10H; FETOXM1 = 8; FGETEXP = 1EH; FGETMAN = 1FH;
  FINT = 1; FINTRZ = 3; FLOG10 = 15H; FLOG2 = 16H; FLOGN = 14H; FLOGNP1 = 6; FMOD = 21H; FMOVE = 0;
  FMUL = 23H; FNEG = 1AH; FREM = 25H; FSCALE = 26H; FSGLDIV = 24H; FSGLMUL = 27H; FSIN = 0EH;
  FSINH = 2; FSQRT = 4; FSUB = 28H; FTAN = 0FH; FTANH = 9; FTENTOX = 12H; FTST = 3AH; FTWOTOX = 11H;
  (* Compare kinds *)
  eql = 9; neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  (* Condition Codes *)
  CC = 4; CS = 5; EQ = 7; false = 1; GE = 12; GT = 14; HI = 2; LE = 15;
  LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; true = 0; VC = 8; VS = 9;
  (* Floating Point Condition Codes *)
  FEQ = 1; FNE = 0EH; FGT = 12H; FNGT = 1DH; FGE = 13H; FNGE = 1CH; FLT = 14H; FNLT = 1BH; FLE = 15H;
  FNLE = 1AH; Ffalse = 0; Ftrue = 0FH;
  (* Floating Point Control Registers *)
  FPCR = 4; FPSR = 2; FPIAR = 1;
  (* Traps, not used ? *)
  inxTrap = 8; rngTrap = 9; guardTrap = 18; eqGuardTrap = 19;
  super = 1;
  None = -1;
 VAR FP, SP : OPL.Item;
   indexCheck, rangeCheck, nilCheck, ptrinit, saveRegs* : BOOLEAN;
 PROCEDURE Init*( options : SET );
 BEGIN
  indexCheck := 0 IN options;
  rangeCheck := 2 IN options;
  nilCheck := 9 IN options;
  ptrinit := 5 IN options;
 END Init;
 PROCEDURE MakeLen*( VAR arr : OPL.Item; n : LONGINT; VAR item : OPL.Item );
 (* Makes an item that denotes the length in the n-th dimension of a dynamic array. *)
 BEGIN (* MakeLen *)
  item := arr;
  IF item.nolen = 0 THEN
   item.bd := arr.bd + 4 * ( n + 1 );
  ELSE
   item.bd := arr.bd + 4 * n;
  END; (* IF *)
  item.typ := OPT.linttyp;
 END MakeLen;
 PROCEDURE MakeIntConst*( val : LONGINT; typ : OPT.Struct; VAR item : OPL.Item );
 (* Makes an immediate item of a given type from a number. *)
 BEGIN (* MakeIntConst *)
  item.mode := imm;
  item.typ := typ;
  item.bd := val;
 END MakeIntConst;
 PROCEDURE MakeVar*( obj : OPT.Object; VAR item : OPL.Item );
 (* Makes an item from a variable. *)
  VAR aregItem : OPL.Item;
  PROCEDURE GetVarBase( obj : OPT.Object ) : INTEGER;
  (* Returns the register to which the given variable is relative. *)
   VAR diff, reg : INTEGER;
     source, dest : OPL.Item;
  BEGIN (* GetVarBase *)
   diff := OPL.level - obj.mnolev;
   IF diff = 0 THEN
    reg := FP.reg;
   ELSE (* follow static link *)
    reg := OPL.GetAdrReg( );
    source.mode := regx;
    source.typ := OPT.sysptrtyp;
    source.reg := FP.reg;
    source.bd := 8;
    source.inxReg := None;
    source.offsReg := None;
    dest.mode := areg;
    dest.typ := OPT.sysptrtyp;
    dest.reg := reg;
    OPL.Move( source, dest );
    source.reg := reg;
    WHILE diff > 1 DO
     OPL.Move( source, dest );
     DEC( diff );
    END; (* WHILE *)
   END; (* IF *)
   RETURN reg
  END GetVarBase;
 BEGIN (* MakeVar *)
  IF ( obj.mode = VarPar ) & ( obj.typ.comp # DynArr ) THEN
   item.mode := regx;
   item.reg := GetVarBase( obj );
   item.typ := OPT.sysptrtyp;
   item.bd := obj.adr;
   item.inxReg := None;
   aregItem.mode := areg;
   aregItem.reg := OPL.GetAdrReg( );
   OPL.Move( item, aregItem );
   OPL.FreeReg( item );
   item.mode := regx;
   item.reg := aregItem.reg;
   item.bd := 0;
  ELSIF obj.mnolev < 0 THEN (* imported variable *)
   item.mode := abs;
   item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr;
  ELSIF obj.mnolev = 0 THEN (* global variable *)
   item.mode := pcx;
   item.bd := obj.linkadr;
  ELSE (* local variable *)
   item.mode := regx;
   item.reg := GetVarBase( obj );
   item.bd := obj.adr;
  END; (* IF *)
  item.typ := obj.typ;
  item.inxReg := None;
  item.offsReg := None;
  item.nolen := 0;
 END MakeVar;
 PROCEDURE DeRef*( typ : OPT.Struct; VAR item : OPL.Item );
 (* Makes a dereferentiation of an item. *)
  VAR aregItem, dregItem : OPL.Item;
    inxReg : INTEGER;
 BEGIN (* DeRef *)
  aregItem.mode := areg;
  (* If item is (Ax) with x<6, use Ax again *)
  IF saveRegs & (item.mode=regx) & (item.reg<14) THEN
  	aregItem.reg:=item.reg
  ELSE
  	aregItem.reg := OPL.GetAdrReg( )
  END;
  item.typ := OPT.sysptrtyp;
  inxReg := item.offsReg;
  OPL.Move( item, aregItem );
  IF nilCheck & (~(item.mode=immL)) THEN
   dregItem.mode:=dreg;
   dregItem.reg:=OPL.GetReg();
   NEW(aregItem.typ);aregItem.typ.size:=4;
   OPL.Move( aregItem, dregItem);
   OPL.Trapcc(EQ, 2);
   OPL.FreeReg(dregItem);
  END;
  item.mode := regx;
  item.typ := typ;
  item.reg := aregItem.reg;
  item.bd := 0;
  item.inxReg := inxReg; (* xsize and scale keep their values *)
  IF typ.comp = DynArr THEN
   item.nolen := SHORT( typ.n ) + 1;
  ELSE
   item.nolen := 0;
  END; (* IF *)
 END DeRef;
 PROCEDURE StaticTag*( typ : OPT.Struct; VAR tag : OPL.Item );
 (* Returns the type tag of a type. *)
 BEGIN (* StaticTag *)
  tag.mode := immL;
  tag.typ := OPT.sysptrtyp;
  tag.bd := SYSTEM.LSH( LONG( LONG( typ.mno ) ), 8 ) + typ.tdadr;
 END StaticTag;
 PROCEDURE MakeTag*( obj : OPT.Object; typ : OPT.Struct; VAR item, tag : OPL.Item );
 (* Makes an item that denotes the type tag of the given object and item. *)
 BEGIN (* MakeTag *)
  IF item.typ.form = Pointer THEN
   tag := item;
   DeRef( OPT.sysptrtyp, tag );
   tag.bd := -4;
  ELSIF ( obj # NIL ) & ( obj.mode = VarPar ) THEN
   tag.mode := regx;
   tag.typ := OPT.sysptrtyp;
   tag.reg := FP.reg;
   tag.bd := obj.adr + 4;
   tag.inxReg := None;
   tag.offsReg := None;
  ELSE
   StaticTag( typ, tag );
  END; (* IF *)
 END MakeTag;
 PROCEDURE MakeConst*( obj : OPT.Object; const : OPT.Const; typ : OPT.Struct; VAR item : OPL.Item );
 (* Makes an item from a constant. *)
  VAR realval : REAL;
 BEGIN (* MakeConst *)
  item.typ := typ;
  CASE typ.form OF
   Set :
    MakeIntConst( SYSTEM.VAL( LONGINT, const.setval ), typ, item );
   | String :
    OPL.AllocConst( obj, typ, const.ext^, const.intval2, item );
    item.nolen := SHORT( const.intval2 );
   | Real :
   	AmigaMathL.Short(const.realval, realval);
(*    realval :=  SHORT( const.realval );*)
    OPL.AllocConst( obj, typ, realval, 4, item );
   | LReal :
    OPL.AllocConst( obj, typ, const.realval, 8, item );
  ELSE
   MakeIntConst( const.intval, typ, item );
  END; (* CASE *)
 END MakeConst;
 PROCEDURE BaseTypSize( VAR arr, size : OPL.Item; VAR scale : INTEGER );
 (* Returns the size of the base type of a dynamic array if the base type is a dynamic array itself. *)
  VAR i : LONGINT;
    typ : OPT.Struct;
    len : OPL.Item;
 BEGIN (* BaseTypSize *)
  typ := arr.typ.BaseTyp;
  WHILE typ.comp = DynArr DO
   typ := typ.BaseTyp;
  END; (* WHILE *)
  IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
   scale := SHORT( typ.size );
   MakeLen( arr, arr.typ.offset, size );
  ELSE
   scale := 1;
   MakeIntConst( typ.size, OPT.linttyp, size );
   MakeLen( arr, arr.typ.offset, len );
   OPL.Format12( MULS, len, size );
   OPL.FreeReg( len );
  END; (* IF *)
  FOR i := arr.typ.offset - arr.typ.n + 1 TO arr.typ.offset - 1 DO
   MakeLen( arr, i, len );
   OPL.Format12( MULS, len, size );
   OPL.FreeReg( len );
  END; (* FOR *)
 END BaseTypSize;
 PROCEDURE Size( VAR arr, size : OPL.Item; VAR scale : INTEGER );
 (* Returns the size of a dynamic array and a scale factor. *)
  VAR len : OPL.Item;
    typ : OPT.Struct;
 BEGIN (* Size *)
  MakeLen( arr, arr.typ.offset - arr.typ.n, len );
  typ := arr.typ.BaseTyp;
  IF typ.comp = DynArr THEN
   BaseTypSize( arr, size, scale );
   OPL.Format12( MULS, len, size );
   OPL.FreeReg( len );
  ELSE
   IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
    scale := SHORT( typ.size );
    size := len;
   ELSE
    scale := 1;
    MakeIntConst( typ.size, OPT.linttyp, size );
    OPL.Format12( MULS, len, size );
    OPL.FreeReg( len );
   END; (* IF *)
  END; (* IF *)
 END Size;
 PROCEDURE ElimIndex( VAR item : OPL.Item );
 (* Eliminates the index register in the item. *)
  VAR newReg : INTEGER;
 BEGIN (* ElimIndex *)
  IF item.inxReg # None THEN (* load old address *)
   newReg := OPL.GetAdrReg( );
   OPL.Lea( item, newReg );
   item.mode := regx;
   item.bd := 0;
   item.reg := newReg;
   item.inxReg := None;
  END; (* IF *)
 END ElimIndex;
 PROCEDURE SetElem*( VAR item : OPL.Item );
 (* Makes a set-element from an integer element and sets the corresponding bit. *)
  VAR source : OPL.Item;
 BEGIN (* SetElem *)
  source :=  item;
  item.mode := dreg;
  item.typ := OPT.settyp;
  item.reg := OPL.GetReg( );
  OPL.Format7( CLR, item );
  OPL.Format5( BSET, source, item );
 END SetElem;
 PROCEDURE RoundDown;
 (* Sets the rounding mode of the coprocessor to -inf. *)
  VAR temp : OPL.Item;
 BEGIN (* RoundDown *)
  MakeIntConst( 20H, OPT.linttyp, temp );
  OPL.FMovecr( temp, 0, FPCR );
 END RoundDown;
 PROCEDURE RoundNearest;
 (* Sets the rounding mode of the coprocessor to nearest. *)
  VAR temp : OPL.Item;
 BEGIN (* RoundNearest *)
  MakeIntConst( 0, OPT.linttyp, temp );
  OPL.FMovecr( temp, 0, FPCR );
 END RoundNearest;
 PROCEDURE Convert*( VAR source : OPL.Item; desttyp : OPT.Struct );
 (* Converts the given item to desttyp. *)
  VAR sf, sc, df, dc : SHORTINT;
    dest : OPL.Item;
 BEGIN (* Convert *)
  sf := source.typ.form;
  sc := source.typ.comp;
  df := desttyp.form;
  dc := desttyp.comp;
  IF df = ProcTyp THEN (* handles assignments of functions to proc vars *) source.typ := desttyp; RETURN END;
  IF (df = Comp) & (sf = Comp) & (dc = Record) & (sc = Record) THEN 
    (* handles record assignment including projection *) 
   source.typ := desttyp; 
   RETURN
  END;
  IF ( sf # Pointer ) & ( ( sf # df ) OR ( sc # dc ) ) THEN
   IF df IN LongSet THEN
    IF sf = Char THEN
     dest.mode := dreg;
     dest.typ := desttyp;
     dest.reg := OPL.GetReg( );
     OPL.Format7( CLR, dest );
     OPL.Move( source, dest );
     source := dest;
    ELSIF sf IN ByteSet + WordSet THEN
     OPL.Ext( source, long );
    ELSIF sf IN RealSet THEN
     OPL.FLoad( source );
     RoundDown;
     source.typ := desttyp;
     OPL.Load( source );
     RoundNearest;
    END; (* IF *)
   ELSIF df IN WordSet THEN
    IF sf IN LongSet THEN
     OPL.Load( source );
    ELSIF sf = Char THEN
     dest.mode := dreg;
     dest.typ := desttyp;
     dest.reg := OPL.GetReg( );
     OPL.Format7( CLR, dest );
     OPL.Move( source, dest );
     source := dest;
    ELSIF sf IN ByteSet THEN
     OPL.Ext( source, word );
    ELSIF sf IN RealSet THEN
     OPL.FLoad( source );
     RoundDown;
     source.typ := desttyp;
     OPL.Load( source );
     RoundNearest;
    END; (* IF *)
   ELSIF df IN ByteSet THEN
    IF sf IN WordSet + LongSet THEN
     OPL.Load( source );
    ELSIF sf IN RealSet THEN
     OPL.FLoad( source );
     RoundDown;
     source.typ := desttyp;
     OPL.Load( source );
     RoundNearest;
    END; (* IF *)
   ELSIF df IN RealSet THEN
    OPL.FLoad( source );
   END; (* IF *)
   source.typ := desttyp;
  END; (* IF *)
 END Convert;
 PROCEDURE GetDynArrVal*( VAR item : OPL.Item );
 (* Returns an item containing the actual value of a dynamic array. *)
 BEGIN (* GetDynArrVal *)
  IF item.nolen = 0 THEN
   DeRef( OPT.sysptrtyp, item );
  ELSE
   INC( item.bd, LONG( item.nolen ) * 4 );
   item.nolen := 0;
   item.typ := OPT.sysptrtyp;
   item.inxReg := item.offsReg;
   item.offsReg := None;
  END; (* IF *)
 END GetDynArrVal;
 PROCEDURE GetDynArrAdr( VAR item, adr : OPL.Item );
 (* Returns an item containing the address of a dynamic array. *)
  VAR adrReg : OPL.Item;
 BEGIN (* GetDynArrAdr *)
  adr.typ := OPT.sysptrtyp;
  adr.nolen := 0;
  IF item.nolen = 0 THEN
   IF item.offsReg # None THEN
    DeRef( OPT.sysptrtyp, item );
    adr.mode := areg;
    adr.reg := OPL.GetAdrReg( );
    OPL.Lea( item, adr.reg );
   ELSE
    adr.mode := item.mode;
    adr.reg := item.reg;
    adr.bd := item.bd;
    adr.inxReg := None;
    adr.offsReg := None;
   END;
  ELSE
   adr.mode := item.mode;
   adr.reg := item.reg;
   adr.bd := item.bd + item.nolen * 4;
   adr.inxReg := item.offsReg;
   adr.xsize := item.xsize;
   adr.scale := item.scale;
   adr.offsReg := None;
   adrReg.mode := areg;
   adrReg.typ := OPT.sysptrtyp;
   adrReg.reg := OPL.GetAdrReg( );
   OPL.Lea( adr, adrReg.reg );
   adr := adrReg;
  END; (* IF *)
 END GetDynArrAdr;
 PROCEDURE MakeField*( VAR item : OPL.Item; offset : LONGINT; typ : OPT.Struct );
 (* Increments the address of item by offset and sets its type to typ. *)
 BEGIN (* MakeField *)
  OPL.LoadExternal( item );
  INC( item.bd, offset );
  item.typ := typ;
 END MakeField;
 PROCEDURE MakeIndex*( VAR index, res : OPL.Item );
 (* Makes an indexed item from an item and an index. res := res[ index ].
  The generated item has always got an index register or an offset register. *)
  VAR baseTyp : OPT.Struct;
    sizeItem, chkItem, offset : OPL.Item;
    size : LONGINT;
    scale : INTEGER;
 BEGIN (* MakeIndex *)
  baseTyp := res.typ.BaseTyp;
  size := baseTyp.size;
  OPL.LoadExternal( res );
  IF ( res.typ.comp # DynArr ) & ( index.mode = imm ) THEN
   INC( res.bd, size * index.bd );
  ELSE
   ElimIndex( res );
   IF index.typ.form = SInt  THEN Convert( index, OPT.inttyp ); END;
   IF ( ( index.mode # imm ) OR ( index.bd # 0 ) ) & (indexCheck) THEN
    IF res.typ.comp = DynArr THEN
     MakeLen( res, res.typ.offset - res.typ.n, chkItem );
     Convert( index, OPT.linttyp );
    ELSE
     MakeIntConst( res.typ.n - 1, index.typ, chkItem );
    END; (* IF *)
    OPL.Chk( index, chkItem );
    (* OPL.FreeReg( chkItem ); *) (* Need this for CHK opti *)
   END; (* IF *)
   OPL.Load( index );
   IF baseTyp.comp # Basic THEN
    IF baseTyp.comp = DynArr THEN
     Convert( index, OPT.linttyp );
     BaseTypSize( res, sizeItem, scale );
     OPL.Format12( MULS, sizeItem, index );
     OPL.FreeReg( sizeItem );
    ELSE
     IF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) OR ( size = 8 ) THEN
      scale := SHORT( size );
     ELSE
      scale := 1;
      MakeIntConst( size, index.typ, sizeItem );
      IF index.typ.form = LInt THEN
       OPL.Format12( MULS, sizeItem, index );
      ELSE
       OPL.Format11( MULS, sizeItem, index );
      END; (* IF *)
      OPL.FreeReg( sizeItem );
     END; (* IF *)
    END; (* IF *)
    size := 1;
   ELSE scale := SHORT( size );
   END; (* IF *)
   IF baseTyp.comp = DynArr THEN
    IF res.offsReg # None THEN
     offset.mode := dreg;
     offset.typ := OPT.linttyp;
     offset.reg := res.offsReg;
     OPL.Format2( ADD, offset, index );
    END; (* IF *)
    res.offsReg := index.reg;
   ELSE
    IF res.typ.comp = DynArr THEN
     GetDynArrVal( res );
     ElimIndex( res );
    END; (* IF *)
    res.inxReg := index.reg;
   END; (* IF *)
   IF index.typ.form = LInt THEN
    res.xsize := 1;
   ELSE
    res.xsize := 0;
   END; (* IF *)
   CASE scale OF
    1 : res.scale := 0;
    | 2 : res.scale := 1;
    | 4 : res.scale := 2;
    | 8 : res.scale := 3;
   END; (* CASE *)
  END; (* IF *)
  res.typ := baseTyp;
 END MakeIndex;
 PROCEDURE MakeProc*( obj : OPT.Object; subcl : SHORTINT; VAR item : OPL.Item );
 (* Makes an item from a procedure object. *)
 BEGIN (* MakeProc *)
  IF obj.mode = XProc THEN (* external procedure *)
   item.mode := immL;
   item.typ := OPT.sysptrtyp;
   item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr;
   item.offsReg := None;
  ELSIF obj.mode = TProc THEN
   (* receiver is on top of the stack *)
   IF obj.link.mode = VarPar THEN
    item.mode := regx;
    item.typ := OPT.sysptrtyp;
    item.reg := SP.reg;
    item.bd := 4;
    item.inxReg := None;
    item.offsReg := None;
   ELSE
    item.mode := regx;
    item.typ := OPT.sysptrtyp;
    item.reg := SP.reg;
    item.bd := 0;
    item.inxReg := None;
    item.offsReg := None;
    DeRef( OPT.sysptrtyp, item );
    item.bd := -4;
   END; (* IF *)
   DeRef( OPT.sysptrtyp, item );
   IF subcl = super THEN
    item.bd := OPL.BaseTypeOffs + 4 * ( obj.link.typ.BaseTyp.extlev - 1 );
    DeRef( OPT.sysptrtyp, item );
   END; (* IF *)
   item.bd := OPL.MethodOffs - 4 * ( obj.adr DIV 10000H + 1 );
  ELSE
   MakeIntConst( obj.linkadr, OPT.linttyp, item );
  END; (* IF *)
 END MakeProc;
 PROCEDURE MakePostInc( typ : OPT.Struct; VAR item : OPL.Item );
 (* Makes a post-increment item from the given item. *)
  VAR dest : OPL.Item;
 BEGIN (* MakePostInc *)
  IF item.mode # postinc THEN
   IF ( item.mode = regx ) & ( item.bd = 0 ) & ( item.inxReg = None ) & ~ ( item.reg IN { FP.reg, SP.reg } ) THEN
    item.mode := postinc;
    item.typ := typ;
   ELSE
    dest.mode := postinc;
    dest.typ := typ;
    dest.reg := OPL.GetAdrReg( );
    OPL.Lea( item, dest.reg );
    item := dest;
   END;
  END;
 END MakePostInc;
 PROCEDURE MakeSPPredec( VAR res : OPL.Item );
 (* Makes a pre-decrement item with the stack pointer. *)
 BEGIN (* MakeSPPredec *)
  res.mode := predec;
  res.reg := SP.reg;
  res.typ := SP.typ;
 END MakeSPPredec;
 PROCEDURE MakeCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
 (* Makes a coc item with the true-condition trueCond. *)
 BEGIN (* MakeCocItem *)
  res.mode := coc;
  res.typ := OPT.booltyp;
  res.bd := OPL.TFConds( trueCond );
  (* leave tJump and fJump unchanged! *)
 END MakeCocItem;
 PROCEDURE MakeFCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
 (* Makes an fcoc item with the true-condition trueCond. *)
 BEGIN (* MakeFCocItem *)
  res.mode := fcoc;
  res.typ := OPT.booltyp;
  res.bd := OPL.TFFConds( trueCond );
  (* leave tJump and fJump unchanged! *)
 END MakeFCocItem;
 PROCEDURE Swap( x : SET ) : INTEGER;
 (* Writes bits 15 to 0 to the positions 0 to 15 of the result. Used for MOVEM. *)
  VAR y : SET;
    i : INTEGER;
 BEGIN (* Swap *)
  y := { };
  FOR i := 0 TO 15 DO
   IF i IN x THEN INCL( y, 15 - i ); END;
  END; (* FOR *)
  RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
 END Swap;
 PROCEDURE SwappedFloats( x : SET ) : INTEGER;
 (* Writes bits 23 to 16 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  VAR y : SET;
    i : INTEGER;
 BEGIN (* SwappedFloats *)
  y := { };
  FOR i := 16 TO 23 DO
   IF i IN x THEN INCL( y, 23 - i ); END;
  END; (* FOR *)
  RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
 END SwappedFloats;
 PROCEDURE Floats( x : SET ) : INTEGER;
 (* Writes bits 16 to 23 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  VAR y : SET;
    i : INTEGER;
 BEGIN (* Floats *)
  y := { };
  FOR i := 16 TO 23 DO
   IF i IN x THEN INCL( y, i - 16 ); END;
  END; (* FOR *)
  RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
 END Floats;
 PROCEDURE PushRegs*( regs : SET );
 (* Pushes the given registers onto the stack. *)
  VAR sppredec : OPL.Item;
    regList : INTEGER;
 BEGIN (* PushRegs *)
  MakeSPPredec( sppredec );
  regList := Swap( regs );
  IF regList # 0 THEN
   OPL.Movem( 0, regList, sppredec );
  END; (* IF *)
  regList := Floats( regs );
  IF regList # 0 THEN
   OPL.FMovem( 0, regList , sppredec );
  END; (* IF *)
 END PushRegs;
 PROCEDURE PopRegs*( regs : SET );
 (* Pops the given registers from the stack. *)
  VAR sppostinc : OPL.Item;
    regList : INTEGER;
 BEGIN (* PopRegs *)
  sppostinc.mode := postinc;
  sppostinc.reg := SP.reg;
  sppostinc.typ := SP.typ;
  regList := SwappedFloats( regs );
  IF regList # 0 THEN
   OPL.FMovem( 1, regList, sppostinc );
  END; (* IF *)
  regList := SHORT( SYSTEM.VAL( LONGINT, regs ) );
  IF regList # 0 THEN
   OPL.Movem( 1, regList, sppostinc );
  END; (* IF *)
 END PopRegs;
 PROCEDURE TrueJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
 (* Generates a conditional branch to the given label with the true condition. *)
 BEGIN (* TrueJump *)
  IF expression.mode = imm THEN
   IF expression.bd # 0  THEN
    OPL.Jump( true, label );
   END; (* IF *)
  ELSIF expression.mode = coc THEN
   OPL.Jump( SHORT( expression.bd DIV 10000H ), label );
  ELSIF expression.mode = fcoc THEN
   OPL.FJump( SHORT( expression.bd DIV 10000H ), label );
  ELSE
   OPL.Load( expression );
   OPL.Format7( TST, expression );
   OPL.Jump( NE, label );
  END; (* IF *)
  OPL.DefineLabel( expression.fJump );
 END TrueJump;
 PROCEDURE FalseJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
 (* Generates a conditional branch to the given label with the false condition. *)
 BEGIN (* FalseJump *)
  IF expression.mode = imm THEN
   IF expression.bd = 0 THEN
    OPL.Jump( true, label );
   END; (* IF *)
  ELSIF expression.mode = coc THEN
   OPL.Jump( SHORT( expression.bd MOD 10000H ), label );
  ELSIF expression.mode = fcoc THEN
   OPL.FJump( SHORT( expression.bd MOD 10000H ), label );
  ELSE
   OPL.Load( expression );
   OPL.Format7( TST, expression );
   OPL.Jump( EQ, label );
  END; (* IF *)
  OPL.DefineLabel( expression.tJump );
 END FalseJump;
 PROCEDURE MoveBlock( scale : INTEGER; VAR size, source, dest : OPL.Item );
 (* Moves a block of data of length size from source to dest. *)
  VAR i : LONGINT;
    losize : OPL.Item;
    label : OPL.Label;
 BEGIN (* MoveBlock *)
  IF scale = 1 THEN
   MakePostInc( OPT.sinttyp, source );
   MakePostInc( OPT.sinttyp, dest );
  ELSIF scale = 2 THEN
   MakePostInc( OPT.inttyp, source );
   MakePostInc( OPT.inttyp, dest );
  ELSE
   MakePostInc( OPT.linttyp, source );
   MakePostInc( OPT.linttyp, dest );
  END; (* IF *)
  IF ( size.mode = imm ) & ( size.bd <= 6 ) THEN
   i := 0;
   WHILE i < size.bd DO
    OPL.Move( source, dest );
    INC( i );
   END; (* WHILE *)
  ELSE
   IF size.mode = imm THEN
    DEC( size.bd );
   ELSE
    OPL.Load( size );
    OPL.Format1( SUBQ, 1, size );
   END; (* IF *)
   IF ( ( size.mode = imm ) & ( size.bd <= MAX( INTEGER ) ) ) OR ( size.typ # OPT.linttyp ) THEN
    OPL.Load( size );
    Convert( size, OPT.inttyp );
    label := OPL.NewLabel;
    OPL.DefineLabel( label );
    OPL.Move( source, dest );
    IF scale = 8 THEN OPL.Move( source, dest ); END;
    OPL.DBcc( false, size.reg, label );
   ELSE
    OPL.Load( size );
    losize.mode := dreg;
    losize.typ := OPT.inttyp;
    losize.reg := OPL.GetReg( );
    OPL.Move( size, losize );
    OPL.Swap( size );
    label := OPL.NewLabel;
    OPL.DefineLabel( label );
    OPL.Move( source, dest );
    IF scale = 8 THEN OPL.Move( source, dest ); END;
    OPL.DBcc( false, losize.reg, label );
    OPL.DBcc( false, size.reg, label );
   END; (* IF *)
  END; (* IF *)
 END MoveBlock;
 PROCEDURE Assign*( VAR source, dest : OPL.Item );
 (* Generates code for the assignment dest := source.  *)
  VAR size : LONGINT;
    length, src : OPL.Item;
    label : OPL.Label;
    scale : INTEGER;
 BEGIN (* Assign *)
  Convert( source, dest.typ );
  size := source.typ.size;
  OPL.LoadAdr( dest );
  IF source.mode = freg THEN
   OPL.FMove( source, dest );
  ELSIF source.typ.form = Real THEN
   OPL.Move( source, dest );
  ELSIF source.typ.form = LReal THEN
   OPL.LoadAdr( source );
   OPL.LoadExternal( source );
   OPL.LoadExternal( dest );
   source.typ := OPT.linttyp;
   dest.typ := OPT.linttyp;
   OPL.Move( source, dest );
   INC( source.bd, 4 );
   INC( dest.bd, 4 );
   OPL.Move( source, dest );
   DEC( dest.bd, 4 );
   dest.typ := OPT.lrltyp;
  ELSIF source.mode IN { coc, fcoc } THEN
   src.mode := imm;
   src.typ := OPT.booltyp;
   label := OPL.NewLabel;
   IF source.mode = coc THEN
    OPL.Jump( SHORT( source.bd MOD 10000H ), source.fJump );
   ELSE
    OPL.FJump( SHORT( source.bd MOD 10000H ), source.fJump );
   END;
   OPL.DefineLabel( source.tJump );
   src.bd := 1;
   OPL.Move( src, dest );
   OPL.Jump( true, label );
   OPL.DefineLabel( source.fJump );
   src.bd := 0;
   OPL.Move( src, dest );
   OPL.DefineLabel( label );
  ELSIF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) THEN
   OPL.Move( source, dest );
  ELSE (* complex data structure *)
   IF source.typ.comp = DynArr THEN
    Size( source, length, scale );
    GetDynArrVal( source );
   ELSE
    IF size MOD 4 = 0 THEN
     scale := 4;
     MakeIntConst( size DIV 4, OPT.linttyp, length );
    ELSIF size MOD 2 = 0 THEN
     scale := 2;
     MakeIntConst( size DIV 2, OPT.linttyp, length );
    ELSE
     scale := 1;
     MakeIntConst( size, OPT.linttyp, length );
    END; (* IF *)
   END; (* IF *)
   MoveBlock( scale, length, source, dest );
  END; (* IF *)
 END Assign;
 PROCEDURE MoveDynArrStack*( formalTyp : OPT.Struct; offset : LONGINT; VAR item : OPL.Item );
 (* Moves the address and the length(s) of the given item to (offset, A7). *)
  VAR source, dest, adr, length, len1 : OPL.Item;
    typ : OPT.Struct;
    i, dim : LONGINT;
    lengthMade : BOOLEAN;
 BEGIN (* MoveDynArrStack *)
  dim := formalTyp.n + 1;
  typ := item.typ;
  dest.mode := regx;
  dest.typ := OPT.linttyp;
  dest.reg := SP.reg;
  dest.bd := offset;
  dest.inxReg := None;
  IF typ.comp = DynArr THEN
   source := item;
   GetDynArrAdr( source, adr );
  ELSE
   adr.mode := areg;
   adr.typ := OPT.sysptrtyp;
   adr.reg := OPL.GetAdrReg( );
   OPL.Lea( item, adr.reg );
  END;
  OPL.Move( adr, dest );
  i := typ.offset - typ.n;
  WHILE ( typ.comp = DynArr ) & ( dim > 1 ) DO
   INC( dest.bd, 4 );
   MakeLen( item, i, length );
   OPL.Move( length, dest );
   INC( i );
   DEC( dim );
   typ := typ.BaseTyp;
   formalTyp := formalTyp.BaseTyp;
  END; (* WHILE *)
  WHILE dim > 1 DO
   INC( dest.bd, 4 );
   IF typ.form = String THEN
    MakeIntConst( item.nolen, OPT.linttyp, length );
   ELSE
    MakeIntConst( typ.n, OPT.linttyp, length );
   END; (* IF *)
   OPL.Move( length, dest );
   INC( i );
   DEC( dim );
   typ := typ.BaseTyp;
   formalTyp := formalTyp.BaseTyp;
  END; (* WHILE *)
  IF ( formalTyp.comp = DynArr ) & ( formalTyp.BaseTyp = OPT.bytetyp ) THEN
   IF typ.comp = DynArr THEN
    lengthMade := TRUE;
    MakeLen( item, i, length );
    INC( i );
    DEC( dim );
    typ := typ.BaseTyp;
    WHILE typ.comp = DynArr DO
     MakeLen( item, i, len1 );
     OPL.Format12( MULS, len1, length );
     INC( i );
     DEC( dim );
     typ := typ.BaseTyp;
    END; (* WHILE *)
   ELSE
    lengthMade := FALSE;
   END; (* IF *)
   IF typ.form = String THEN
    MakeIntConst( item.nolen, OPT.linttyp, len1 );
   ELSE
    MakeIntConst( typ.size, OPT.linttyp, len1 );
   END; (* IF *)
   IF lengthMade THEN
    IF len1.bd > 1 THEN OPL.Format12( MULS, len1, length ); END;
   ELSE
    length := len1;
   END; (* IF *)
  ELSIF typ.comp = DynArr THEN
   MakeLen( item, i, length );
  ELSIF typ.form = String THEN
   MakeIntConst( item.nolen, OPT.linttyp, length );
  ELSE
   MakeIntConst( typ.n, OPT.linttyp, length );
  END; (* IF *)
  INC( dest.bd, 4 );
  OPL.Move( length, dest );
 END MoveDynArrStack;
 PROCEDURE MoveAdrStack*( offset : LONGINT; VAR item : OPL.Item );
 (* Moves the address of the given item to (offset, SP). *)
  VAR dest, adrReg : OPL.Item;
 BEGIN (* MoveAdrStack *)
  dest.mode := regx;
  dest.typ := OPT.sysptrtyp;
  dest.reg := SP.reg;
  dest.bd := offset;
  dest.inxReg := None;
  dest.offsReg := None;
  adrReg.mode := areg;
  adrReg.typ := OPT.sysptrtyp;
  adrReg.reg := OPL.GetAdrReg( );
  OPL.Lea( item, adrReg.reg );
  OPL.Move( adrReg, dest );
 END MoveAdrStack;
 PROCEDURE MoveStack*( offset : LONGINT; VAR item : OPL.Item );
 (* Moves the given item to (offset, SP). *)
  VAR dest : OPL.Item;
 BEGIN (* MoveStack *)
  dest.mode := regx;
  dest.typ := item.typ;
  dest.reg := SP.reg;
  dest.bd := offset;
  dest.inxReg := None;
  dest.offsReg := None;
  Assign( item, dest );
 END MoveStack;
 PROCEDURE Copy*( VAR source, dest : OPL.Item );
 (* Generates code for COPY( source, dest ). dest may not be bigger than 32kB. *)
  VAR destlen : OPL.Item;
    label : OPL.Label;
    src, dst : OPL.Item;
 BEGIN (* Copy *)
  src := source;
  dst := dest;
  IF src.typ.comp = DynArr THEN
   GetDynArrVal( src );
  END; (* IF *)
  IF dst.typ.comp = DynArr THEN
   MakeLen( dst, 0, destlen );
   GetDynArrVal( dst );
   OPL.Load( destlen );
   OPL.Format1( SUBQ, 2, destlen );
  ELSE
   MakeIntConst( dst.typ.n - 2, OPT.linttyp, destlen );
   OPL.Load( destlen );
  END; (* IF *)
  MakePostInc( OPT.chartyp, src );
  MakePostInc( OPT.chartyp, dst );
  label := OPL.NewLabel;
  OPL.DefineLabel( label );
  OPL.Move( src, dst );
  OPL.DBcc( EQ, destlen.reg, label );
  MakeIntConst( 0, OPT.chartyp, src );
  OPL.Move( src, dst );
 END Copy;
 PROCEDURE Decrement*( VAR designator, expression : OPL.Item );
 (* Decrements the value of designator by expression *)
 BEGIN (* Decrement *)
  IF expression.mode = imm THEN
   IF ( expression.bd >= 0 ) & ( expression.bd <= 8 ) THEN
    OPL.Format1( SUBQ, SHORT( expression.bd ), designator );
   ELSE
    OPL.Format6( SUBI, expression.bd, designator );
   END; (* IF *)
  ELSE
   OPL.Format2( SUB, expression, designator );
  END; (* IF *)
 END Decrement;
 PROCEDURE Increment*( VAR designator, expression : OPL.Item );
 (* Increments the value of designator by expression *)
 BEGIN (* Increment *)
  IF expression.mode = imm THEN
   IF ( expression.bd >= 0 ) & ( expression.bd <= 8 ) THEN
    OPL.Format1( ADDQ, SHORT( expression.bd ), designator );
   ELSE
    OPL.Format6( ADDI, expression.bd, designator );
   END; (* IF *)
  ELSE
   OPL.Format2( ADD, expression, designator );
  END; (* IF *)
 END Increment;
 PROCEDURE Include*( VAR set, element : OPL.Item );
 (* set := set + { element } *)
  VAR temp : OPL.Item;
 BEGIN (* Include *)
  temp := set;
  IF element.mode = imm THEN
   OPL.Format4( BSET, element.bd, temp );
  ELSE
   OPL.Format5( BSET, element, temp );
  END; (* IF *)
  OPL.Move( temp, set );
 END Include;
 PROCEDURE Exclude*( VAR set, element : OPL.Item );
 (* set := set - { element } *)
  VAR temp : OPL.Item;
 BEGIN (* Exclude *)
  temp := set;
  IF element.mode = imm THEN
   OPL.Format4( BCLR, element.bd, temp );
  ELSE
   OPL.Format5( BCLR, element, temp );
  END; (* IF *)
  OPL.Move( temp, set );
 END Exclude;
 PROCEDURE EnterMod*;
 (* Generates code for the entry into the module. *)
 BEGIN (* EnterMod *)
  OPL.SetEntry( 0, OPL.pc );
  OPL.Enter( 0 );
 END EnterMod;
 PROCEDURE CopyDynArrs( par : OPT.Object );
 (* Copys the dynamic arrays which are value-parameters to the stack. *)
  VAR source, dest, ptr, size, negsize, newSP : OPL.Item;
    scale : INTEGER;
 BEGIN (* CopyDynArrs *)
  WHILE par # NIL DO
   OPL.usedRegs := { };
   IF ( par.typ.comp = DynArr ) & ( par.mode = Var ) THEN
    MakeVar( par, source );
    Size( source, size, scale );
    OPL.Load( size );
    GetDynArrVal( source );
    IF scale = 1 THEN (* align size to 4 bytes *)
     OPL.Format1( ADDQ, 3, size );
     OPL.Format13( ASh, -2, size );
     scale := 4;
    ELSIF scale = 2 THEN
     OPL.Format1( ADDQ, 1, size );
     OPL.Format13( ASh, -1, size );
     scale := 4;
    END; (* IF *)
    negsize.mode := dreg;
    negsize.typ := OPT.linttyp;
    negsize.reg := OPL.GetReg( );
    OPL.Move( size, negsize );
    OPL.Format7( NEG, negsize );
    newSP.mode := regx;
    newSP.typ := OPT.sysptrtyp;
    newSP.reg := SP.reg;
    newSP.bd := 0;
    newSP.inxReg := negsize.reg;
    IF size.typ.form = LInt THEN newSP.xsize := 1; ELSE newSP.xsize := 0; END;
    newSP.scale := OPL.Scale( scale );
    OPL.Lea( newSP, SP.reg );
    dest.mode := areg;
    dest.typ := OPT.sysptrtyp;
    dest.reg := OPL.GetAdrReg( );
    OPL.Move( SP, dest );
    dest.mode := regx;
    dest.typ := par.typ;
    dest.bd := 0;
    dest.inxReg := None;
    MoveBlock( scale, size, source, dest );
    ptr.mode := regx;
    ptr.typ := OPT.sysptrtyp;
    ptr.reg := FP.reg;
    ptr.bd := par.adr;
    ptr.inxReg := None;
    OPL.Move( SP, ptr );
   END; (* IF *)
   par := par.link;
  END; (* WHILE *)
 END CopyDynArrs;
 PROCEDURE EnterProc*( proc : OPT.Object );
 (* Generates code for the entry into a procedure. If ptrinit is set, the whole local variable area is initialized. *)
  VAR source, dest, losize, hisize, adrReg : OPL.Item;
    dsize, i : LONGINT;
    label : OPL.Label;
 BEGIN (* EnterProc *)
  OPL.DefineLabel( proc.linkadr );
  IF proc.adr # -1 THEN
   OPL.SetEntry( SHORT( proc.adr MOD 10000H ), OPL.pc );
  END; (* IF *)
  dsize := proc.conval.intval;
  OPL.Enter( -dsize );
  IF ptrinit THEN
   MakeIntConst( 0, OPT.linttyp, source );
   dest.mode := regx;
   dest.typ := OPT.linttyp;
   dest.reg := SP.reg;
   dest.bd := 0;
   dest.inxReg := None;
   dest.offsReg := None;
   IF dsize > 8 THEN   (* old was 24 *)
    adrReg.mode := areg;
    adrReg.typ := OPT.sysptrtyp;
    adrReg.reg := OPL.GetAdrReg( );
    OPL.Move( SP, adrReg );
    adrReg.mode := postinc;
    IF dsize > 20 THEN    (* if the constant is small, the code will be shorter, but slower; 20 is the shortest way *) 
     IF dsize > 4 * MAX( INTEGER ) THEN
      MakeIntConst( ( dsize DIV 4 - 1 ) DIV 10000H, OPT.inttyp, hisize );
      OPL.Load( hisize );
      MakeIntConst( ( dsize DIV 4 - 1 ) MOD 10000H, OPT.inttyp, losize );
      OPL.Load( losize );
      label := OPL.NewLabel;
      OPL.DefineLabel( label );
      OPL.Move( source, adrReg );
      OPL.DBcc( false, losize.reg, label );
      OPL.DBcc( false, hisize.reg, label );
     ELSE
      MakeIntConst( dsize DIV 4 - 1, OPT.inttyp, losize );
      OPL.Load( losize );
      label := OPL.NewLabel;
      OPL.DefineLabel( label );
      OPL.Move( source, adrReg );
      OPL.DBcc( false, losize.reg, label );
     END; (* IF *)
    ELSE
     FOR i := 1 TO (dsize DIV 4) DO
      OPL.Move( source, adrReg );
     END;
    END;
   ELSE
    FOR i := 1 TO dsize DIV 4 DO
     OPL.Move( source, dest );
     INC( dest.bd, 4 );
    END; (* FOR *)
   END; (* IF *)
  END; (* IF *)
  CopyDynArrs( proc.link );
 END EnterProc;
 PROCEDURE Return*( proc : OPT.Object; withRes : BOOLEAN;  VAR result : OPL.Item );
 (* Generates code for returning from a procedure or a module (proc = NIL). 
  result contains the value that has to be returned in D0 or FP0, if withRes is TRUE.
  D0 and FP0 can be used because all registers are free. *)
  VAR d0, fp0 : OPL.Item;
 BEGIN (* Return *)
  IF withRes THEN
   IF proc.typ.form IN RealSet THEN (* result is returned in FP0 *)
    IF ( result.mode # freg ) OR ( result.reg # 16 ) THEN
     fp0.mode := freg;
     fp0.reg := 16;
     fp0.typ := proc.typ;
     OPL.FMove( result, fp0 );
    END; (* IF *)
   ELSIF ( result.mode # dreg ) OR ( result.reg # 0 ) THEN
    d0.mode := dreg;
    d0.reg := 0;
    d0.typ := proc.typ;
    Assign( result, d0 ); (* Assign, not Move because of BOOLEAN return values. *)
   END; (* IF *)
  END; (* IF *)
  OPL.Return;
 END Return;
 PROCEDURE WriteStaticLink*( obj : OPT.Object );
 (* Writes the static link of the given object to (A7) if necessary. *)
  VAR source, dest : OPL.Item;
    diff : INTEGER;
 BEGIN (* WriteStaticLink *)
  IF ( obj # NIL ) & ( obj.mnolev > 0 ) & ( obj.mode = LProc ) THEN (* static link needed *)
   diff := OPL.level - obj.mnolev;
   IF diff = 0 THEN (* local procedure *)
    source := FP;
   ELSE
    source.mode := regx;
    source.typ := OPT.sysptrtyp;
    source.reg := FP.reg;
    source.bd := 8;
    source.inxReg := None;
    source.offsReg := None;
    IF diff > 1 THEN
     dest.mode := areg;
     dest.typ := OPT.sysptrtyp;
     dest.reg := OPL.GetAdrReg( );
     OPL.Move( source, dest );
     source.reg := dest.reg;
     WHILE diff > 2 DO
      OPL.Move( source, dest );
      DEC( diff );
     END; (* WHILE *)
    END; (* IF *)
   END; (* IF *)
   MoveStack( 0, source );
  END; (* IF *)
 END WriteStaticLink;
 PROCEDURE Call*( VAR item : OPL.Item; obj : OPT.Object );
 (* Calls the given procedure. *)
 BEGIN (* Call *)
  IF ( obj # NIL ) & ( obj.mode = CProc ) THEN
   OPL.WriteCProc( obj^.conval^.ext );
  ELSIF item.mode = imm THEN
   OPL.Bsr( item.bd );
   obj.linkadr := item.bd;
  ELSE
   DeRef( OPT.sysptrtyp, item );
   OPL.Format15( JSR, item );
  END; (* IF *)
 END Call;
 PROCEDURE GetResult*( typ : OPT.Struct; VAR res : OPL.Item );
 (* Returns the result of a function call. *)
  VAR d0, fp0 : OPL.Item;
 BEGIN (* GetResult *)
  IF typ.form IN RealSet THEN
   IF 16 IN OPL.usedRegs THEN
    fp0.mode := freg;
    fp0.typ := typ;
    fp0.reg := 16;
    res.mode := freg;
    res.typ := typ;
    res.reg := OPL.GetFReg( );
    OPL.FMove( fp0, res );
   ELSE
    res.mode := freg;
    res.typ := typ;
    res.reg := 16;
    INCL( OPL.usedRegs, 16 );
   END; (* IF *)
  ELSIF 0 IN OPL.usedRegs THEN
   res.mode := dreg;
   res.typ := typ;
   res.reg := OPL.GetReg( );
   d0.mode := dreg;
   d0.typ := typ;
   d0.reg := 0;
   OPL.Move( d0, res );
  ELSE
   res.mode := dreg;
   res.typ := typ;
   res.reg := 0;
   INCL( OPL.usedRegs, 0 );
  END; (* IF *)
 END GetResult;
 PROCEDURE TypeTest*( VAR item : OPL.Item; typ : OPT.Struct; guard, equal : BOOLEAN );
 (* 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
  if the test fails. If both are false, only the condition codes are set. *)
  VAR tag : OPL.Item;
    savedRegs : SET;
 BEGIN (* TypeTest *)
  savedRegs := OPL.usedRegs;
  IF ~ equal THEN
   DeRef( OPT.sysptrtyp, item );
   INC( item.bd, LONG( LONG( OPL.BaseTypeOffs + 4 * typ.extlev ) ) );
  END; (* IF *)
  OPL.Load( item );
  StaticTag( typ, tag );
  OPL.Cmp( tag, item );
  IF equal THEN
   OPL.Trapcc( NE, eqGuardTrap );
  ELSIF guard THEN
   OPL.Trapcc( NE, guardTrap );
  ELSE
   MakeCocItem( EQ, item );
  END; (* IF *)
  OPL.usedRegs := savedRegs;
 END TypeTest;
 PROCEDURE Case*( VAR expression : OPL.Item; lo, hi : LONGINT; VAR label : OPL.Label; VAR jtAdr : LONGINT );
 (* Generates the initializing part of a case statement and allocates the jump table.
  label denotes the else part of the case statement, jtAdr is the address of the jump table. *)
  VAR loItem, jumpTabEntry, jumpAddress : OPL.Item;
    jumpTab : ARRAY OPM.MaxCaseRange OF INTEGER;
 BEGIN (* Case *)
  OPL.Load( expression );
  IF expression.typ.form IN ByteSet THEN Convert( expression, OPT.inttyp ); END;
  MakeIntConst( lo, expression.typ, loItem );
  OPL.Format2( SUB, loItem, expression );
  OPL.Format6( CMPI, hi - lo, expression );
  OPL.Jump( HI, label );
  OPL.AllocBytes( jumpTab, 2 * ( hi - lo + 1 ), jtAdr );
  jumpTabEntry.mode := pcx;
  jumpTabEntry.typ := OPT.inttyp;
  jumpTabEntry.bd := jtAdr - OPL.ConstSize - OPL.dsize;
  jumpTabEntry.inxReg := expression.reg;
  IF expression.typ.size = 4 THEN
   jumpTabEntry.xsize := 1;
  ELSE
   jumpTabEntry.xsize := 0;
   Convert( expression, OPT.inttyp );
  END; (* IF *)
  jumpTabEntry.scale := 1; (* 2 bytes *)
  OPL.Load( jumpTabEntry );
  jumpAddress.mode := pcx;
  jumpAddress.typ := OPT.sysptrtyp;
  jumpAddress.bd := 0;
  jumpAddress.inxReg := jumpTabEntry.reg;
  jumpAddress.xsize := 0; (* word *)
  jumpAddress.scale := 1; (* *2 *)
  OPL.Format15( JMP, jumpAddress );
 END Case;
 PROCEDURE AddToSP*( data : LONGINT );
 (* Subtracts the immediate value 'data' from the stack pointer. *)
 (* no ADDQ/SUBQ, new OPL does it in a better way *)
  VAR source : OPL.Item;
 BEGIN (* AddToSP *)
  IF data > 0 THEN
   (*IF data < 8 THEN
    OPL.Format1( ADDQ, SHORT( data ), SP );
   ELSE*)
    MakeIntConst( data, OPT.linttyp, source );
    OPL.Format3( ADD, source, SP.reg );
   (*END; (* IF *)*)
  ELSIF data < 0 THEN
   data := -data;
   (*IF data < 8 THEN
    OPL.Format1( SUBQ, SHORT( data ), SP );
   ELSE*)
    MakeIntConst( data, OPT.linttyp, source );
    OPL.Format3( SUB, source, SP.reg );
   (*END; (* IF *)*)
  END; (* IF *)
 END AddToSP;
 PROCEDURE Test*( VAR item : OPL.Item );
 (* Tests a boolean item and makes a coc item. fcoc items are left unchanged. *)
 BEGIN (* Test *)
  IF ( item.mode # coc ) & ( item.mode # fcoc ) THEN
   OPL.Load( item );
   OPL.Format7( TST, item );
   MakeCocItem( NE, item );
  END; (* IF *)
 END Test;
 PROCEDURE UpTo*( VAR low, high, res : OPL.Item );
 (* set constructor res := { low .. high }. *)
  VAR chkItem, leftShift, rightShift : OPL.Item;
 BEGIN (* UpTo *)
  res.mode := dreg;
  res.typ := OPT.settyp;
  res.reg := OPL.GetReg( );
  IF rangeCheck THEN
   MakeIntConst( OPM.MaxSet, high.typ, chkItem );
   IF low.mode # imm THEN OPL.Chk( low, chkItem ); END;
   IF high.mode # imm THEN OPL.Chk( high, chkItem ); END;
  END; (* IF *)
  rightShift.mode := dreg;
  rightShift.typ := high.typ;
  rightShift.reg := OPL.GetReg( );
  leftShift.mode := dreg;
  leftShift.typ := high.typ;
  leftShift.reg := OPL.GetReg( );
  OPL.Moveq( OPM.MaxSet, rightShift.reg );
  OPL.Format2( SUB, high, rightShift );
  OPL.Move( rightShift, leftShift );
  OPL.Format2( ADD, low, leftShift );
  OPL.Moveq( -1, res.reg );
  OPL.Format14( LSh, 1, leftShift, res );
  OPL.Format14( LSh, 0, rightShift, res );
  OPL.FreeReg( high );
  OPL.FreeReg( low );
  OPL.FreeReg( leftShift );
  OPL.FreeReg( rightShift );
 END UpTo;
 PROCEDURE Abs*( VAR item : OPL.Item );
 (* Generates code for the calculation of the absolute value of the given item. *)
  VAR label : OPL.Label;
 BEGIN (* Abs *)
  IF item.typ.form IN RealSet THEN
   OPL.Format8( FABS, item, item );
  ELSE
   OPL.Load( item );
   label := OPL.NewLabel;
   OPL.Format7( TST, item );
   OPL.Jump( GE, label );
   OPL.Format7( NEG, item );
   OPL.DefineLabel( label );
  END; (* IF *)
 END Abs;
 PROCEDURE Adr*( VAR item : OPL.Item );
 (* Generates code for the calculation of the address of the given item. *)
  VAR reg : INTEGER;
    adr : OPL.Item;
 BEGIN (* Adr *)
  IF item.typ.comp = DynArr THEN
   GetDynArrAdr( item, adr );
   item := adr;
  ELSIF item.mode IN { regx, pcx } THEN
   reg := OPL.GetAdrReg( );
   OPL.Lea( item, reg );
   item.mode := areg;
   item.reg := reg;
  ELSIF item.mode = abs THEN
   item.mode := immL;
  ELSE
   HALT( 94 );
  END; (* IF *)
  item.typ := OPT.sysptrtyp;
 END Adr;
 PROCEDURE Cap*( VAR item : OPL.Item );
 (* Generates code for the calculation of CAP( item ). For characters only. *)
 BEGIN (* Cap *)
  OPL.Load( item );
  OPL.Format4( BCLR, 5, item );
 END Cap;
 PROCEDURE Neg*( VAR item : OPL.Item );
 (* Generates code for the calculation of -item. *)
 BEGIN (* Neg *)
  IF item.typ.form IN RealSet THEN
   OPL.Format8( FNEG, item, item );
  ELSIF item.typ.form = Set THEN
   OPL.Load( item );
   OPL.Format7( NOT, item );
  ELSE
   OPL.Load( item );
   OPL.Format7( NEG, item );
  END; (* IF *)
 END Neg;
 PROCEDURE Not*( VAR item : OPL.Item );
 (* Generates code for the calculation of ~ item. For Booleans only. *)
  VAR tcond, fcond : LONGINT;
 BEGIN (* Not *)
  IF ( item.mode = coc ) OR ( item.mode = fcoc ) THEN
   tcond := item.bd DIV 10000H;
   fcond := item.bd MOD 10000H;
   item.bd := 10000H * fcond + tcond;
  ELSE
   OPL.Load( item );
   OPL.Format7( TST, item );
   MakeCocItem( EQ, item );
  END; (* IF *)
 END Not;
 PROCEDURE Odd*( VAR item : OPL.Item );
 (* Generates code for the calculation of ODD( item ). *)
 BEGIN (* Odd *)
  OPL.Load( item );
  OPL.Format4( BTST, 0, item );
  MakeCocItem( NE, item );
 END Odd;
 PROCEDURE Plus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
 (* Generates code for the addition dest := dest + source. *)
 BEGIN (* Plus *)
  OPL.AssertDestReg( typ, source, dest );
  IF typ.form = Set THEN
   OPL.Format2( oR, source, dest );
  ELSIF typ.form IN RealSet THEN
   OPL.Format8( FADD, source, dest );
  ELSE
   OPL.Format2( ADD, source, dest );
  END; (* IF *)
  OPL.FreeReg( source );
 END Plus;
 PROCEDURE Minus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
 (* Generates code for the subtraktion dest := dest - source. *)
 BEGIN (* Minus *)
  IF typ.form = Set THEN
   OPL.Load( dest );
   OPL.Load( source );
   OPL.Format7( NOT, source );
   OPL.Format2( AND, source, dest );
  ELSIF typ.form IN RealSet THEN
   OPL.FLoad( dest );
   OPL.Format8( FSUB, source, dest );
  ELSE
   OPL.Load( dest );
   OPL.Format2( SUB, source, dest );
  END; (* IF *)
  OPL.FreeReg( source );
 END Minus;
 PROCEDURE Mul*( typ : OPT.Struct; VAR source, dest : OPL.Item );
 (* Generates code for the multiplication dest := dest * source. *)
 BEGIN (* Mul *)
  OPL.AssertDestReg( typ, source, dest );
  IF typ.form = Set THEN
   OPL.Format2( AND, source, dest );
  ELSIF typ.form IN RealSet THEN
   OPL.Format8( FMUL, source, dest );
  ELSIF typ.form = SInt THEN
   Convert( source, OPT.inttyp );
   Convert( dest, OPT.inttyp );
   OPL.Format11( MULS, source, dest );
  ELSIF typ.form = Int THEN
   OPL.Format11( MULS, source, dest );
  ELSIF typ.form = LInt THEN
   Convert( source, OPT.linttyp );
   Convert( dest, OPT.linttyp );
   OPL.Format12( MULS, source, dest );
  END; (* IF *)
  OPL.FreeReg( source );
 END Mul;
 PROCEDURE Divide*( typ : OPT.Struct; VAR source, dest : OPL.Item );
 (* Generates code for the division dest := dest / source. *)
 BEGIN (* Divide *)
  IF typ.form = Set THEN
   OPL.Load( dest );
   OPL.Eor( source, dest );
  ELSE
   OPL.Format8( FDIV, source, dest );
  END; (* IF *)
  OPL.FreeReg( source );
 END Divide;
 PROCEDURE Div*( VAR source, dest : OPL.Item );
 (* Generates code for the integer division dest := dest DIV source. *)
  VAR label : OPL.Label;
    remainder : OPL.Item;
 BEGIN (* Div *)
  OPL.Load( dest );
  Convert( dest, OPT.linttyp );
  IF source.typ.form = LInt THEN
   remainder.mode := dreg;
   remainder.reg := OPL.GetReg( );
   remainder.typ := OPT.linttyp;
   OPL.Divsl( source, remainder, dest );
   OPL.Format4( BTST, 31, remainder );
  ELSE
   Convert( source, OPT.inttyp );
   OPL.Format11( DIVS, source, dest );
   OPL.Format4( BTST, 31, dest );
  END; (* IF *)
  label := OPL.NewLabel;
  OPL.Jump( EQ, label );
  OPL.Format1( SUBQ, 1, dest );
  OPL.DefineLabel( label );
  OPL.FreeReg( source );
 END Div;
 PROCEDURE Mod*( VAR source, dest : OPL.Item );
 (* Generates code for the remainder dest := dest MOD source.*)
  VAR label : OPL.Label;
    remainder : OPL.Item;
 BEGIN (* Mod *)
  OPL.Load( source ); (* because it is used twice and may be a pc-item. *)
  OPL.Load( dest );
  Convert( dest, OPT.linttyp );
  IF source.typ.form = LInt THEN
   remainder.mode := dreg;
   remainder.typ := OPT.linttyp;
   remainder.reg := OPL.GetReg( );
   OPL.Divsl( source, remainder, dest );
   dest := remainder;
   OPL.Format4( BTST, 31, dest );
  ELSE
   Convert( source, OPT.inttyp );
   OPL.Format11( DIVS, source, dest );
   OPL.Swap( dest );
   OPL.Format4( BTST, 15, dest );
  END; (* IF *)
  label := OPL.NewLabel;
  OPL.Jump( EQ, label );
  OPL.Format2( ADD, source, dest );
  OPL.DefineLabel( label );
  OPL.FreeReg( source );
 END Mod;
 PROCEDURE Mask*( mask : LONGINT; VAR dest : OPL.Item );
 (* Generates code for the calculation of dest := dest & ~mask. Used for MOD. *)
 BEGIN (* Mask *)
  OPL.Load( dest );
  OPL.Format6( ANDI, mask, dest );
 END Mask;
 PROCEDURE In*( VAR element, set, dest : OPL.Item );
 (* Generates code for the calculation of dest := element IN set. *)
 BEGIN (* In *)
  IF element.mode = imm THEN
   OPL.Format4( BTST, element.bd, set );
  ELSE
   OPL.Format5( BTST, element, set );
  END; (* IF *)
  MakeCocItem( NE, dest );
 END In;
 PROCEDURE LoadCC*( VAR item : OPL.Item );
 (* If item.mode is coc or fcoc, the item is loaded into a data register. *)
  VAR temp : OPL.Item;
 BEGIN (* LoadCC *)
  IF item.mode IN { coc, fcoc } THEN
   temp := item;
   item.mode := dreg;
   item.typ := OPT.booltyp;
   item.reg := OPL.GetReg( );
   Assign( temp, item );
  END; (* IF *)
 END LoadCC;
 PROCEDURE Compare*( kind : SHORTINT; VAR left, right, res : OPL.Item );
 (* Compares left and right and generates a coc- or fcoc-item. *)
  VAR tCond : INTEGER;
    dreg1, dreg2 : OPL.Item;
    begLabel, endLabel : OPL.Label;
 BEGIN (* Compare *)
  IF left.typ.form IN RealSet THEN
   OPL.Format8( FCMP, right, left );
   CASE kind OF
    eql : tCond := FEQ;
    | neq : tCond := FNE;
    | lss : tCond := FLT;
    | leq : tCond := FLE;
    | gtr : tCond := FGT;
    | geq : tCond := FGE;
   END; (* CASE *)
   MakeFCocItem( tCond, res );
  ELSE
   IF ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
    IF left.typ.comp = DynArr THEN GetDynArrVal( left ); END;
    MakePostInc( OPT.chartyp, left );
    IF right.typ.comp = DynArr THEN GetDynArrVal( right ); END;
    MakePostInc( OPT.chartyp, right );
    dreg1.mode := dreg;
    dreg1.typ := OPT.chartyp;
    dreg1.reg := OPL.GetReg( );
    dreg2.mode := dreg;
    dreg2.typ := OPT.chartyp;
    dreg2.reg := OPL.GetReg( );
    begLabel := OPL.NewLabel;
    endLabel := OPL.NewLabel;
    OPL.DefineLabel( begLabel );
    OPL.Move( left, dreg1 );
    OPL.Move( right, dreg2 );
    OPL.Cmp( dreg2, dreg1 );
    OPL.Jump( NE, endLabel );
    OPL.Format7( TST, dreg1 );
    OPL.Jump( NE, begLabel );
    OPL.DefineLabel( endLabel );
    OPL.Cmp( dreg2, dreg1 );
   ELSE
    IF right.typ = OPT.niltyp THEN Convert( right, OPT.sysptrtyp ); END;
    LoadCC( left );
    LoadCC( right );
    OPL.Cmp( right, left );
   END; (* IF *)
   IF ( left.typ.form = Char ) OR ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
    CASE kind OF
     eql : tCond := EQ;
     | neq : tCond := NE;
     | lss : tCond := CS;
     | leq : tCond := LS;
     | gtr : tCond := HI;
     | geq : tCond := CC;
    END; (* CASE *)
   ELSE
    CASE kind OF
     eql : tCond := EQ;
     | neq : tCond := NE;
     | lss : tCond := LT;
     | leq : tCond := LE;
     | gtr : tCond := GT;
     | geq : tCond := GE;
    END; (* CASE *)
   END; (* IF *)
   MakeCocItem( tCond, res );
  END; (* IF *)
 END Compare; 
 PROCEDURE Shift*( opcode : INTEGER; VAR shift, dest : OPL.Item );
 (* Generates code for the calculation of ASH( dest, shift ), SYSTEM.LSH( dest, shift ) and SYSTEM.ROT( dest, shift ). *)
  VAR elseLabel, endLabel : OPL.Label;
 BEGIN (* Shift *)
  IF shift.mode = imm THEN
   IF shift.bd # 0 THEN
    IF ( shift.bd >= -8 ) & ( shift.bd <= 8 ) THEN
     OPL.Format13( opcode, SHORT( shift.bd ), dest );
    ELSE
     IF shift.bd < 0 THEN
      MakeIntConst( -shift.bd, OPT.inttyp, shift );
      OPL.Format14( opcode, 0, shift, dest );
     ELSE
      MakeIntConst( shift.bd, OPT.inttyp, shift );
      OPL.Format14( opcode, 1, shift, dest );
     END; (* IF *)
    END; (* IF *)
   END; (* IF *)
  ELSE (* shift must be tested, because the machine instructions only take positive shifts. *)
   elseLabel := OPL.NewLabel;
   endLabel := OPL.NewLabel;
   OPL.Load( shift );
   OPL.Load( dest );
   OPL.Format7( TST, shift );
   OPL.Jump( LT, elseLabel );
   OPL.Format14( opcode, 1, shift, dest );
   OPL.Jump( true, endLabel );
   OPL.DefineLabel( elseLabel );
   OPL.Format7( NEG, shift );
   OPL.Format14( opcode, 0, shift, dest );
   OPL.DefineLabel( endLabel );
  END; (* IF *)
 END Shift;
 PROCEDURE Trap*( nr : INTEGER );
 (* Generates code for a trap. *)
 BEGIN (* Trap *)
  OPL.Trapcc( true, nr );
 END Trap;
 PROCEDURE RunTime( nr : INTEGER );
 (* Calls the given run-time routine. *)
   VAR proc : OPL.Item;
 BEGIN (* RunTime *)
  proc.mode := abs;
  proc.typ := OPT.sysptrtyp;
  proc.bd := SYSTEM.LSH( LONG( 255 ), 8 ) + nr;
  OPL.Format15( JSR, proc );
 END RunTime;
 PROCEDURE PtrCheck( typ : OPT.Struct );
  VAR ptrTab : ARRAY 1 OF LONGINT;
    nofptrs : INTEGER;
 BEGIN (* PtrCheck *)
  nofptrs := 0;
  OPL.FindPtrs( typ, 0, ptrTab, nofptrs );
  IF nofptrs > 0 THEN OPM.err( -303 ) END;
 END PtrCheck;
 PROCEDURE New*( VAR designator, tag : OPL.Item );
 (* Generates the code for calling NEW( designator ). *)
  VAR sppredec, res : OPL.Item;
    savedRegs : SET;
 BEGIN (* New *)
  savedRegs := OPL.usedRegs;
  PushRegs( savedRegs );
  MakeSPPredec( sppredec );
  OPL.Move( tag, sppredec );
  RunTime( 0 );
  AddToSP( 4 );
  GetResult( OPT.sysptrtyp, res );
  PopRegs( savedRegs );
  OPL.Move( res, designator );
 END New;
 PROCEDURE SYSNew*( VAR designator, size : OPL.Item );
 (* Generates the code for calling SYSTEM.NEW( designator, size ). *)
  VAR sppredec, res : OPL.Item;
    savedRegs : SET;
 BEGIN (* SYSNew *)
  PtrCheck( designator.typ.BaseTyp );
  savedRegs := OPL.usedRegs;
  PushRegs( savedRegs );
  MakeSPPredec( sppredec );
  Convert( size, OPT.linttyp );
  OPL.Move( size, sppredec );
  RunTime( 1 );
  AddToSP( 4 );
  GetResult( OPT.sysptrtyp, res );
  PopRegs( savedRegs );
  OPL.Move( res, designator );
 END SYSNew;
 PROCEDURE SYSMove*( VAR sourceAdr, destAdr, length : OPL.Item );
 (* Generates code for SYSTEM.MOVE( sourceAdr, destAdr, length ). *)
  VAR source, dest : OPL.Item;
 BEGIN (* SYSMove *)
  source.mode := areg;
  source.typ := OPT.linttyp;
  source.reg := OPL.GetAdrReg( );
  Convert( sourceAdr, OPT.linttyp );
  OPL.Move( sourceAdr, source );
  source.mode := postinc;
  source.typ := OPT.sinttyp;
  dest.mode := areg;
  dest.typ := OPT.linttyp;
  dest.reg := OPL.GetAdrReg( );
  Convert( destAdr, OPT.linttyp );
  OPL.Move( destAdr, dest );
  dest.mode := postinc;
  dest.typ := OPT.sinttyp;
  MoveBlock( 1, length, source, dest );
 END SYSMove;
 PROCEDURE SYSGet*( VAR adr, dest : OPL.Item );
 (* Generates code for SYSTEM.GET( adr, dest ). *)
  VAR adrReg : OPL.Item;
 BEGIN (* SYSGet *)
  adrReg.mode := areg;
  adrReg.typ := OPT.linttyp;
  adrReg.reg := OPL.GetAdrReg( );
  OPL.Move( adr, adrReg );
  adrReg.mode := regx;
  adrReg.bd := 0;
  adrReg.typ := dest.typ;
  adrReg.inxReg := None;
  Assign( adrReg, dest );
 END SYSGet;
 PROCEDURE SYSPut*( VAR source, address : OPL.Item );
 (* Generates code for SYSTEM.PUT( source, address ). *)
  VAR adrReg : OPL.Item;
 BEGIN (* SYSPut *)
  adrReg.mode := areg;
  adrReg.typ := OPT.linttyp;
  adrReg.reg := OPL.GetAdrReg( );
  address.typ := OPT.sysptrtyp;
  OPL.Move( address, adrReg );
  adrReg.mode := regx;
  adrReg.typ := source.typ;
  adrReg.bd := 0;
  adrReg.inxReg := None;
  Assign( source, adrReg );
 END SYSPut;
 PROCEDURE SYSGetReg*( VAR dest, sourceReg : OPL.Item );
 (* Generates code for SYSTEM.GETREG( sourceReg, dest ). *)
 BEGIN (* SYSGetReg *)
  sourceReg.reg := SHORT( sourceReg.bd );
  sourceReg.typ := dest.typ;
  IF ( sourceReg.bd >= 0 ) & ( sourceReg.bd <= 7 ) THEN
   sourceReg.mode := dreg;
   OPL.Move( sourceReg, dest );
  ELSIF ( sourceReg.bd >= 8 ) & ( sourceReg.bd <= 15 ) THEN
   sourceReg.mode := areg;
   OPL.Move( sourceReg, dest );
  ELSIF ( sourceReg.bd >= 16 ) & ( sourceReg.bd <= 23 ) THEN
   sourceReg.mode := freg;
   OPL.FMove( sourceReg, dest );
  ELSE
   OPM.err( 220 );
  END; (* IF *)
 END SYSGetReg;
 PROCEDURE SYSPutReg*( VAR source, destReg : OPL.Item );
 (* Generates code for SYSTEM.PUTREG( destReg, source ). *)
 BEGIN (* SYSPutReg *)
  destReg.reg := SHORT( destReg.bd );
  IF ( destReg.bd >= 0 ) & ( destReg.bd <= 7 ) THEN
   destReg.mode := dreg;
   OPL.Move( source, destReg );
  ELSIF ( destReg.bd >= 8 ) & ( destReg.bd <= 15 ) THEN
   destReg.mode := areg;
   OPL.Move( source, destReg );
  ELSIF ( destReg.bd >= 16 ) & ( destReg.bd <= 23 ) THEN
   destReg.mode := freg;
   OPL.FMove( source, destReg );
  ELSE
   OPM.err( 220 );
  END; (* IF *)
 END SYSPutReg;
 PROCEDURE SYSBit*( VAR adr, bitnr, res : OPL.Item );
 (* Generates code for SYSTEM.BIT( adr, bitnr ). *)
  VAR adrItem : OPL.Item;
 BEGIN (* SYSBit *)
  adrItem.mode := areg;
  adrItem.reg := OPL.GetAdrReg( );
  adrItem.typ := OPT.sysptrtyp;
  adr.typ := OPT.sysptrtyp;
  OPL.Move( adr, adrItem );
  adrItem.mode := regx;
  adrItem.bd := 0;
  adrItem.inxReg := None;
  IF bitnr.mode = imm THEN
   OPL.Format4( BTST, bitnr.bd, adrItem );
  ELSE
   OPL.Format5( BTST, bitnr, adrItem );
  END; (* IF *)
  MakeCocItem( NE, res );
 END SYSBit;
BEGIN (* OPC *)
 FP.mode := areg;
 FP.typ := OPT.sysptrtyp;
 FP.reg := 14;
 SP.mode := areg;
 SP.typ := OPT.sysptrtyp;
 SP.reg := 15;
 saveRegs:=TRUE
END OPC.