home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / opv.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  29KB  |  875 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 25 Apr 96
  5. FoldElems
  6. Syntax10.Scn.Fnt
  7. PROCEDURE f1():REAL;
  8. BEGIN
  9.      RETURN 8
  10. END f1;
  11. PROCEDURE Do*;
  12. BEGIN
  13.     f:=f1;
  14.      w:=f(); Out.Real(w,8);
  15.      w:=f1(); Out.Real(w,8);
  16. END Do;
  17. MODULE OPV;
  18. (* Control Module for the backend of the Oberon-2-Compiler for Sun-3.
  19.     Diplomarbeit Samuel Urech
  20.     Date: 30.10.92   Current version: 
  21.     Try to fix a bug in Expr. Hope it will work. RD 17.4.96
  22.  had problems    *)
  23.     IMPORT OPT, OPC, OPL, OPM;
  24.     CONST
  25.         (* object modes *)
  26.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  27.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  28.         (* opcodes *)
  29.         ASh = 0; LSh = 1; ROt = 3;
  30.         (* Condition codes *)
  31.         false = 1; true = 0;
  32.         CC = 4; CS = 5; EQ = 7; GE = 12; GT = 14; HI = 2; LE = 15;
  33.         LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; VC = 8; VS = 9;
  34.         (* operation node subclasses *)
  35.         times = 1; slash = 2; div = 3; mod = 4;
  36.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  37.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  38.         in = 15; is = 16; ash = 17; msk = 18; len = 19;
  39.         conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
  40.         (* SYSTEM *)
  41.         adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  42.         (* structure forms *)
  43.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  44.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  45.         Pointer = 13; ProcTyp = 14; Comp = 15;
  46.         (* composite structure forms *)
  47.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  48.         intSet = { SInt, Int, LInt }; realSet = { Real, LReal };
  49.         (* node classes *)
  50.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  51.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  52.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  53.         Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  54.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  55.         (* function numbers *)
  56.         assign = 0; newfn = 1; incfn = 13; decfn = 14;
  57.         inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
  58.         (* SYSTEM function numbers *)
  59.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
  60.         VarParSize = OPM.PointerSize;
  61.         RecVarParSize = 2 * OPM.PointerSize;
  62.         ProcOff = 8;
  63.         (* procedure flags *)
  64.         hasBody = 1; isRedef = 2;
  65.         (* accessibility of objects *)
  66.         internal = 0; external = 1; externalR = 2;
  67.         (* trap numbers *)
  68.         WithTrap = 15;
  69.         CaseTrap = 16;
  70.         FuncTrap = 17;
  71.     VAR assert, findpc, typCheck : BOOLEAN;
  72.             loopEnd : OPL.Label;
  73.     PROCEDURE Init*( opt : SET; bpc : LONGINT );
  74.         CONST ass = 7; fpc = 8; typchk = 3;
  75.     BEGIN
  76.         typCheck := typchk IN opt;
  77.         assert := ass IN opt;
  78.         findpc := fpc IN opt;
  79.         IF findpc THEN OPM.breakpc := bpc ELSE OPM.breakpc := MAX( LONGINT ) END
  80.     END Init;
  81.     PROCEDURE Base( typ : OPT.Struct ) : INTEGER;
  82.     (* Returns the alignment of a type. *)
  83.     BEGIN
  84.         WHILE typ.comp = Array DO typ := typ.BaseTyp END;
  85.         IF typ.form IN { Byte, Bool, Char, SInt } THEN RETURN 1
  86.         ELSE RETURN 2
  87.         END
  88.     END Base;
  89.     PROCEDURE Align( VAR adr : LONGINT; base : LONGINT );
  90.     (* Aligns the given address with the given base. *)
  91.     BEGIN
  92.         IF adr > 0 THEN 
  93.             INC( adr, ( -adr ) MOD base );
  94.         ELSE
  95.             DEC( adr, adr MOD base );
  96.         END;
  97.     END Align;
  98.     PROCEDURE ^TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  99.     PROCEDURE ParamAdr( par : OPT.Object; VAR psize : LONGINT );
  100.     (* Calculates the sizes of the parameters of a procedure and returns their sum in psize. *)
  101.         VAR typ : OPT.Struct;
  102.                 c : INTEGER;
  103.     BEGIN (* ParamAdr *)
  104.         WHILE par # NIL DO
  105.             typ := par.typ; c := typ.comp;
  106.             TypSize( typ, FALSE );
  107.             IF par.mode = VarPar THEN
  108.                 par.adr := psize;
  109.                 IF c = Record THEN INC( psize, RecVarParSize )
  110.                 ELSIF c = DynArr THEN INC( psize, typ.size )
  111.                 ELSE INC( psize, VarParSize )
  112.                 END;
  113.             ELSE
  114.                 IF typ.form IN {Byte, Bool, Char, SInt, Int} THEN
  115.                     INC( psize, OPM.LIntSize );
  116.                 ELSE
  117.                     INC( psize, typ.size );
  118.                 END;
  119.                 par.adr := psize - typ.size;
  120.                 par.linkadr := par.adr;
  121.             END; (* IF *)
  122.             Align( psize, 4 ); (* all parameters are aligned to 4 bytes. *)
  123.             par := par.link;
  124.         END; (* WHILE *)
  125.     END ParamAdr;
  126.     PROCEDURE ^VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  127.     PROCEDURE ^Traverse( obj : OPT.Object; exported : BOOLEAN );
  128.     PROCEDURE ProcSize( obj : OPT.Object; firstpass : BOOLEAN );
  129.     (* Writes the size of the local variables into the field obj.conval.intval and calculates the addresses of all parameters. *)
  130.         VAR oldPos : LONGINT;
  131.                 conval: OPT.Const;
  132.                 typ : OPT.Struct;
  133.                 redef : OPT.Object;
  134.     BEGIN (* ProcSize *)
  135.         conval := obj.conval;
  136.         oldPos := OPM.errpos;
  137.         OPM.errpos := obj.scope.adr;
  138.         IF ( ( obj.vis # internal ) = firstpass ) OR ( obj.mode = TProc ) THEN
  139.             obj.adr := -1;
  140.             obj.linkadr := OPL.NewLabel;
  141.             IF obj.mode IN { XProc, IProc, TProc } THEN
  142.                 IF OPL.entno < OPL.MaxEntry THEN
  143.                     obj.adr := OPL.entno;
  144.                     INC( OPL.entno );
  145.                 ELSE
  146.                     OPM.err( 226 );
  147.                     obj.adr := 1;
  148.                 END;
  149.             END;
  150.             IF obj.mnolev > 0 THEN
  151.                 conval.intval2 := ProcOff + OPM.PointerSize; (* for static link *)
  152.             ELSE
  153.                 conval.intval2 := ProcOff;
  154.             END;
  155.             ParamAdr( obj.link, conval.intval2 );
  156.             IF obj.mode = TProc THEN
  157.                 typ := obj.link.typ;
  158.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  159.                 OPT.FindField( obj.name, typ.BaseTyp, redef );
  160.                 IF redef # NIL THEN
  161.                     obj.adr := 10000H * ( redef.adr DIV 10000H ) (* mthno *) + obj.adr (* entno *);
  162.                     IF ~( isRedef IN obj.conval.setval ) THEN OPM.err( 134 ) END;
  163.                 ELSE
  164.                     INC( obj.adr, 10000H * typ.n );
  165.                     INC( typ.n );
  166.                 END; (* IF *)
  167.             END; (* IF *)
  168.         END; (* IF *)
  169.         IF ~firstpass THEN
  170.             IF ~( hasBody IN conval.setval ) THEN OPM.err( 129 ) END;
  171.             conval.intval := 0;
  172.             VarAdr( obj.scope.scope, conval.intval ); (* local variables *)
  173.             Traverse( obj.scope.right, FALSE ); (* local types and procedures *)
  174.         END;
  175.         OPM.errpos := oldPos
  176.     END ProcSize;
  177.     PROCEDURE TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  178.     (* Writes the size of a type into typ.size. All subordinate type sizes are calculated, all record fields get an offset. *)
  179.         VAR offset, size : LONGINT;
  180.                 fld : OPT.Object;
  181.                 btyp : OPT.Struct;
  182.     BEGIN (* TypSize *)
  183.         IF typ.size = -1 THEN
  184.             CASE typ.form OF
  185.                 Pointer : 
  186.                     typ.size := OPM.PointerSize;
  187.                     IF typ.BaseTyp = OPT.undftyp THEN
  188.                         OPM.Mark( 128, typ.n );
  189.                     ELSE
  190.                         TypSize( typ.BaseTyp, FALSE );
  191.                     END;
  192.                 | ProcTyp :
  193.                     size := ProcOff; typ.size := OPM.ProcSize;
  194.                     ParamAdr( typ.link, size ); (* inserts the addresses of the parameters. *)
  195.                 | Comp :
  196.                     CASE typ.comp OF
  197.                         Record :
  198.                             btyp := typ.BaseTyp;
  199.                             IF btyp = NIL THEN
  200.                                 offset := 0;
  201.                             ELSE
  202.                                 TypSize( btyp, FALSE );
  203.                                 offset := btyp.size;
  204.                             END;
  205.                             fld := typ.link;
  206.                             WHILE ( fld # NIL ) & ( fld.mode = Fld ) DO
  207.                                 btyp := fld.typ;
  208.                                 TypSize( btyp, FALSE );
  209.                                 size := btyp.size;
  210.                                 Align( offset, Base( btyp ) );
  211.                                 fld.adr := offset;
  212.                                 INC( offset, size );
  213.                                 fld := fld.link
  214.                             END; (* WHILE *)
  215.                             Align( offset, 2 ); (* all records are at least 2 Bytes long *)
  216.                             typ.size := offset;
  217.                         | Array :
  218.                             TypSize( typ.BaseTyp, FALSE ); 
  219.                             typ.size := typ.n * typ.BaseTyp.size;
  220.                         | DynArr :
  221.                             btyp := typ.BaseTyp;
  222.                             IF typ.offset < 0 THEN typ.offset := typ.n; END;
  223.                             IF btyp.comp = DynArr THEN btyp.offset := typ.n; END;
  224.                             TypSize( btyp, FALSE );
  225.                             IF btyp.comp = DynArr THEN
  226.                                 typ.size := btyp.size + 4;
  227.                             ELSE
  228.                                 typ.size := 8;
  229.                             END;
  230.                     END; (* CASE *)
  231.             ELSE (* nothing *)
  232.             END; (* CASE typ.form *)
  233.         END; (* IF *)
  234.     END TypSize;
  235.     PROCEDURE VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  236.     (* Inserts entry-numbers and addresses into the variables. Exported variables are entered into the entry list. *)
  237.         VAR typ: OPT.Struct; adr: LONGINT;
  238.     BEGIN
  239.         adr := -dsize;
  240.         WHILE var # NIL DO
  241.             typ := var.typ;
  242.             TypSize( typ, FALSE );
  243.             DEC( adr, typ.size );
  244.             IF typ.form = Comp THEN
  245.                 Align( adr, 4 );
  246.             ELSE
  247.                 Align( adr, Base( typ ) );
  248.             END; (* IF *)
  249.             IF var.vis = internal THEN
  250.                 var.adr := adr;
  251.             ELSE
  252.                 OPL.SetEntry( OPL.entno, adr );
  253.                 var.adr := OPL.entno;
  254.                 INC( OPL.entno );
  255.             END; (* IF *)
  256.             var.linkadr := adr;
  257.             var := var.link
  258.         END; (* WHILE *)
  259.         dsize := -adr;
  260.         Align( dsize, 8 );
  261.     END VarAdr;
  262.     PROCEDURE Traverse( obj : OPT.Object; exported : BOOLEAN );
  263.     (* Completes types and procedures. *)
  264.         VAR typ: OPT.Struct;
  265.         PROCEDURE TraverseRecord( typ : OPT.Struct );
  266.         (* Inserts the type descriptor address into the types and the method numbers into the methods. *)
  267.         BEGIN
  268.             IF typ.tdadr = OPM.TDAdrUndef THEN
  269.                 IF typ.BaseTyp # NIL THEN
  270.                     TraverseRecord( typ.BaseTyp );
  271.                     typ.n := typ.BaseTyp.n;
  272.                 END; (* IF *)
  273.                 Traverse( typ.link, FALSE ); (* traverse methods *)
  274.                 OPL.AllocTypDesc( typ );
  275.             END; (* IF *)
  276.         END TraverseRecord;
  277.     BEGIN (* Traverse *)
  278.         IF obj # NIL THEN
  279.             Traverse( obj.left, exported );
  280.             IF ( obj.mode = Typ ) & ( ( obj.vis # internal ) = exported ) THEN
  281.                 typ := obj.typ;
  282.                 TypSize( typ, FALSE );
  283.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  284.                 IF typ.comp = Record THEN TraverseRecord( typ ) END;
  285.             ELSIF obj.mode IN {LProc, XProc, TProc, CProc, IProc} THEN
  286.                 ProcSize( obj, exported )
  287.             END ;
  288.             Traverse( obj.right, exported )
  289.         END
  290.     END Traverse;
  291.     PROCEDURE AdrAndSize*;
  292.     (* Completes the symbol table: types, variables, record-fields and procedures. *)
  293.     BEGIN (* AdrAndSize *)
  294.         OPL.dsize := 0;
  295.         VarAdr( OPT.topScope.scope, OPL.dsize );
  296.         OPM.errpos := OPT.topScope.adr;    (* text position of the scope *)
  297.         Traverse( OPT.topScope.right, TRUE );  (* first run for all exported types and procedures *)
  298.         Traverse( OPT.topScope.right, FALSE );  (* second run for all local types and procedures *)
  299.     END AdrAndSize;
  300.     PROCEDURE BaseTyp( typ : OPT.Struct ) : OPT.Struct;
  301.     (* Returns the record type belonging to typ. *)
  302.     BEGIN (* BaseTyp *)
  303.         IF typ.form = Pointer THEN RETURN typ.BaseTyp
  304.         ELSE RETURN typ
  305.         END
  306.     END BaseTyp;
  307.     PROCEDURE ^Expr( node : OPT.Node; VAR res : OPL.Item );
  308.     PROCEDURE Designator( node : OPT.Node; VAR res : OPL.Item );
  309.     (* Returns an item for a designator. res.mode is in { regx, pcx }. *)
  310.         VAR index, tag : OPL.Item;
  311.     BEGIN (* Designator *)
  312.         CASE node.class OF
  313.             Nvar, Nvarpar :
  314.                 OPC.MakeVar( node.obj, res );
  315.             | Nfield :
  316.                 Designator( node.left, res );
  317.                 OPC.MakeField( res, node.obj.adr, node.typ );
  318.             | Nderef :
  319.                 Designator( node.left, res );
  320.                 OPC.DeRef( node.typ, res );
  321.             | Nindex :
  322.                 Expr( node.right, index );
  323.                 Designator( node.left, res );
  324.                 OPC.MakeIndex( index, res );
  325.             | Nguard, Neguard :
  326.                 Designator( node.left, res );
  327.                 IF typCheck THEN
  328.                     OPC.saveRegs:=FALSE;
  329.                     OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  330.                     OPC.TypeTest( tag, BaseTyp( node.typ ), TRUE, node.class = Neguard );
  331.                     OPC.saveRegs:=TRUE;
  332.                 END; (* IF *)
  333.             | Nproc :
  334.                 OPC.MakeProc( node.obj, node.subcl, res );
  335.         END; (* CASE *)
  336.         res.typ := node.typ;
  337.     END Designator;
  338.     PROCEDURE AllocParams( formalPar : OPT.Object; VAR psize : LONGINT );
  339.     (* Allocates space on the stack for the parameters and increments psize by their size. *)
  340.     BEGIN (* AllocParams *)
  341.         WHILE formalPar # NIL DO
  342.             IF formalPar.mode = VarPar THEN
  343.                 IF formalPar.typ.comp = Record THEN INC( psize, RecVarParSize )
  344.                 ELSIF formalPar.typ.comp = DynArr THEN INC( psize, formalPar.typ.size )
  345.                 ELSE INC( psize, VarParSize )
  346.                 END;
  347.             ELSE
  348.                 INC( psize, formalPar.typ.size );
  349.             END; (* IF *)
  350.             Align( psize, 4 );
  351.             formalPar := formalPar.link;
  352.         END; (* WHILE *)
  353.         OPC.AddToSP( -psize );
  354.     END AllocParams;
  355.     PROCEDURE AssignParams( formalPar : OPT.Object; actualPar : OPT.Node );
  356.     (* Moves the actual parameters to the stack. *)
  357.         VAR par, par1, tag : OPL.Item;
  358.     BEGIN (* AssignParams *)
  359.         WHILE formalPar # NIL DO
  360.             IF formalPar.typ.comp = DynArr THEN
  361.                 Expr( actualPar, par );
  362.                 OPC.MoveDynArrStack( formalPar.typ, formalPar.adr - ProcOff, par );
  363.             ELSIF formalPar.mode = VarPar THEN
  364.                 Designator( actualPar, par );
  365.                 par1 := par;
  366.                 OPC.MoveAdrStack( formalPar.adr - ProcOff, par );
  367.                 IF formalPar.typ.comp = Record THEN
  368.                     OPC.MakeTag( actualPar.obj, actualPar.typ, par, tag );
  369.                     OPC.MoveStack( formalPar.adr + 4 - ProcOff, tag );
  370.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ # OPT.sysptrtyp ) THEN
  371.                     (* pass static type to enable run time tests *)
  372.                     OPC.StaticTag( actualPar.typ.BaseTyp, tag );
  373.                     OPC.Assign( tag, par1 );
  374.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ = OPT.sysptrtyp ) & ( actualPar.obj.mode # VarPar ) THEN
  375.                     (* pass NIL to disable run time tests *)
  376.                     OPC.MakeIntConst( 0, OPT.linttyp, tag );
  377.                     OPC.Assign( tag, par1 );
  378.                 END; (* IF *)
  379.             ELSE
  380.                 par.tJump := OPL.NewLabel;
  381.                 par.fJump := OPL.NewLabel;
  382.                 Expr( actualPar, par );
  383.                 OPC.Convert( par, formalPar.typ );
  384.                 OPC.MoveStack( formalPar.adr - ProcOff, par );
  385.             END; (* IF *)
  386.             OPL.usedRegs := { };
  387.             actualPar := actualPar.link;
  388.             formalPar := formalPar.link;
  389.         END; (* WHILE *)
  390.     END AssignParams;
  391.     PROCEDURE Expr( node : OPT.Node; VAR res : OPL.Item );
  392.     (* Returns an item for the result of an exression. *)
  393.         VAR expr1, expr2, expression, set, element, procItem, arr, tag : OPL.Item;
  394.                 swap : OPL.Label;
  395.                 savedRegs : SET;
  396.                 psize: LONGINT;
  397.                 Dummy: SHORTINT;
  398.     BEGIN (* Expr *)
  399.         CASE node.class OF
  400.             Nconst :
  401.                 OPC.MakeConst( node.obj, node.conval, node.typ, res );
  402.             | Nupto :
  403.                 Expr( node.left, expr1 );
  404.                 Expr( node.right, expr2 );
  405.                 OPC.UpTo( expr1, expr2, res );
  406.             | Nmop :
  407.                 CASE node.subcl OF
  408.                     not :
  409.                         swap := res.tJump;
  410.                         res.tJump := res.fJump;
  411.                         res.fJump := swap;
  412.                         Expr( node.left, res );
  413.                         swap := res.tJump;
  414.                         res.tJump := res.fJump;
  415.                         res.fJump := swap;
  416.                         OPC.Not( res );
  417.                     | minus :
  418.                         Expr( node.left, res );
  419.                         OPC.Neg( res );
  420.                     | is :
  421.                         Designator( node.left, res );
  422.                         tag.tJump := res.tJump;
  423.                         tag.fJump := res.fJump;
  424.                         OPC.saveRegs:=FALSE;
  425.                         OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  426.                         OPC.TypeTest( tag, BaseTyp( node.obj.typ ), FALSE, FALSE );
  427.                         OPC.saveRegs:=TRUE;
  428.                         res := tag;
  429.                     | conv :
  430.                         Expr( node.left, res );
  431.                         IF node.typ.form = Set THEN
  432.                             OPC.SetElem( res );
  433.                         ELSE
  434.                             OPC.Convert( res, node.typ );
  435.                         END; (* IF *)
  436.                     | abs :
  437.                         Expr( node.left, res );
  438.                         OPC.Abs( res );
  439.                     | cap :
  440.                         Expr( node.left, res );
  441.                         OPC.Cap( res );
  442.                     | odd :
  443.                         Expr( node.left, res );
  444.                         OPC.Odd( res );
  445.                     | adr :
  446.                         Expr( node.left, res );
  447.                         OPC.Adr( res );
  448.                     | cc :
  449.                         OPC.MakeCocItem( SHORT( node.left.conval.intval ), res );
  450.                     | val :
  451.                         res.tJump := OPL.NewLabel;
  452.                         res.fJump := OPL.NewLabel;
  453.                         Expr( node.left, res );
  454.                         IF res.typ.comp = DynArr THEN OPC.GetDynArrVal( res ); END;
  455.                         res.typ := node.typ;
  456.                 END; (* CASE *)
  457.             | Ndop :
  458.                 CASE node.subcl OF
  459.                     times :
  460.                         Expr( node.left, expression );
  461.                         Expr( node.right, res );
  462.                         OPC.Mul( node.typ, expression, res );
  463.                     | slash :
  464.                         Expr( node.left, res );
  465.                         Expr( node.right, expression );
  466.                         OPC.Divide( node.typ, expression, res );
  467.                     | div :
  468.                         Expr( node.left, res );
  469.                         Expr( node.right, expression );
  470.                         OPC.Div( expression, res );
  471.                     | mod :
  472.                         Expr( node.left, res );
  473.                         Expr( node.right, expression );
  474.                         OPC.Mod( expression, res );
  475.                     | and :
  476.                         savedRegs := OPL.usedRegs;
  477.                         expression.tJump := OPL.NewLabel;
  478.                         expression.fJump := res.fJump;
  479.                         Expr( node.left, expression );
  480.                         OPC.FalseJump( expression, expression.fJump );
  481.                         OPL.usedRegs := savedRegs;
  482.                         Expr( node.right, res );
  483.                         OPC.Test( res );
  484.                         res.fJump := OPL.MergedLinks( expression.fJump, res.fJump );
  485.                     | plus :
  486.                         Expr( node.left, res );
  487.                         Expr( node.right, expression );
  488.                         OPC.Plus( node.typ, expression, res );
  489.                     | minus :
  490.                         Expr( node.left, res );
  491.                         Expr( node.right, expression );
  492.                         OPC.Minus( node.typ, expression, res );
  493.                     | or : 
  494.                         savedRegs := OPL.usedRegs;
  495.                         expression.tJump := res.tJump;
  496.                         expression.fJump := OPL.NewLabel;
  497.                         Expr( node.left, expression );
  498.                         OPC.TrueJump( expression, expression.tJump );
  499.                         OPL.usedRegs := savedRegs;
  500.                         Expr( node.right, res );
  501.                         OPC.Test( res );
  502.                         res.tJump := OPL.MergedLinks( expression.tJump, res.tJump );
  503.                     | eql, neq, lss, leq, gtr, geq :
  504.                         expr1.tJump := OPL.NewLabel;
  505.                         expr1.fJump := OPL.NewLabel;
  506.                         expr2.tJump := OPL.NewLabel;
  507.                         expr2.fJump := OPL.NewLabel;
  508.                         Expr( node.left, expr1 );
  509.                         OPC.LoadCC( expr1 );
  510.                         Expr( node.right, expr2 );
  511.                         OPC.Compare( node.subcl, expr1, expr2, res );
  512.                     | in :
  513.                         Expr( node.left, element );
  514.                         Expr( node.right, set );
  515.                         OPC.In( element, set, res );
  516.                     | ash :
  517.                         Expr( node.left, res );
  518.                         Expr( node.right, expression );
  519.                         OPC.Shift( ASh, expression, res );
  520.                     | msk :
  521.                         Expr( node.left, res );
  522.                         OPC.Mask( -node.right.conval.intval-1, res );
  523.                     | len :
  524.                         Designator( node.left, arr );
  525.                         OPC.MakeLen( arr, node.right.conval.intval, res );
  526.                     | bit :
  527.                         Expr( node.left, expr1 );
  528.                         Expr( node.right, expr2 );
  529.                         OPC.SYSBit( expr1, expr2, res );
  530.                     | lsh :
  531.                         Expr( node.left, res );
  532.                         Expr( node.right, expression );
  533.                         OPC.Shift( LSh, expression, res );
  534.                     | rot :
  535.                         Expr( node.left, res );
  536.                         Expr( node.right, expression );
  537.                         OPC.Shift( ROt, expression, res );
  538.                 END; (* CASE *)
  539.             | Ncall :
  540.                 savedRegs := OPL.usedRegs;
  541.                 OPC.PushRegs( OPL.usedRegs );
  542.                 OPL.usedRegs := { };
  543.                 IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  544.                     psize := OPM.PointerSize; (* for static link *)
  545.                 ELSE
  546.                     psize := 0;
  547.                 END;
  548.                 AllocParams( node.obj, psize );
  549.                 OPC.WriteStaticLink( node.left.obj );
  550.                 AssignParams( node.obj, node.right );
  551.                 Designator( node.left, procItem );
  552.                 OPC.Call( procItem, node.left.obj );
  553.                 OPC.AddToSP( psize );
  554.                 OPL.usedRegs := savedRegs;
  555.                 Dummy:=node.left.typ.form;
  556.                 node.left.typ.form:=node.typ.form;
  557.                 OPC.GetResult( node.left.typ, res );
  558.                 node.left.typ.form:=Dummy;
  559.                 OPC.PopRegs( savedRegs );
  560.         ELSE
  561.             Designator( node, res );
  562.         END; (* CASE *)
  563.         res.typ := node.typ;
  564.     END Expr;
  565.     PROCEDURE Checkpc;
  566.     BEGIN
  567.         IF findpc & (OPL.pc > OPM.breakpc) & OPM.noerr THEN OPM.err(255) END
  568.         (* in the case of a call, the breakpc value shown in the trap viewer must point to the call instruction
  569.             and not to the next instruction, i.e. breakpc # return address !! *)
  570.     END Checkpc;
  571.     PROCEDURE StatSeq( node : OPT.Node );
  572.     (* Generates code for a statement sequence. *)
  573.         VAR proc : OPT.Object;
  574.                 designator, expression, sourceAdr, destAdr, procItem, reg, tag : OPL.Item;
  575.                 begLabel, savedLoopEnd : OPL.Label;
  576.                 psize : LONGINT;
  577.         PROCEDURE CaseStatement( node : OPT.Node );
  578.         (* Generates code for a case statement. *)
  579.             VAR expression : OPL.Item;
  580.                     lo, hi, i, jtAdr : LONGINT;
  581.                     elseLabel, endLabel : OPL.Label;
  582.                     case, caseLabel : OPT.Node;
  583.         BEGIN (* CaseStatement *)
  584.             Expr( node.left, expression );
  585.             node := node.right;
  586.             lo := node.conval.intval;
  587.             hi := node.conval.intval2;
  588.             IF hi >= lo THEN
  589.                 elseLabel := OPL.NewLabel;
  590.                 endLabel := OPL.NewLabel;
  591.                 OPC.Case( expression, lo, hi, elseLabel, jtAdr );
  592.                 FOR i := 0 TO hi - lo DO OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); END;
  593.                 OPL.DefineLabel( elseLabel );
  594.             END; (* IF *)
  595.             Checkpc;
  596.             IF node.conval.setval = { } THEN
  597.                 OPC.Trap( CaseTrap );
  598.             ELSE
  599.                 StatSeq( node.right );
  600.             END;
  601.             IF hi >= lo THEN
  602.                 case := node.left;
  603.                 WHILE case # NIL DO
  604.                     OPL.Jump( true, endLabel );
  605.                     caseLabel := case.left;
  606.                     WHILE caseLabel # NIL DO
  607.                         FOR i := caseLabel.conval.intval - lo TO caseLabel.conval.intval2 - lo DO
  608.                             OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); 
  609.                         END; (* FOR *)
  610.                         caseLabel := caseLabel.link;
  611.                     END; (* WHILE *)
  612.                     StatSeq( case.right );
  613.                     case := case.link;
  614.                 END; (* WHILE *)
  615.                 OPL.DefineLabel( endLabel );
  616.             END; (* IF *)
  617.         END CaseStatement;
  618.         PROCEDURE IfStatement( node : OPT.Node; trap : BOOLEAN );
  619.         (* Generates code for an IF-Statement. If trap is true, a Trap is generated in the ELSE-Case. *)
  620.             VAR endLabel : OPL.Label;
  621.                     curNode : OPT.Node;
  622.                     expression : OPL.Item;
  623.         BEGIN (* IfStatement *)
  624.             endLabel := OPL.NewLabel;
  625.             curNode := node.left;
  626.             WHILE curNode # NIL DO
  627.                 expression.tJump := OPL.NewLabel;
  628.                 expression.fJump := OPL.NewLabel;
  629.                 Expr( curNode.left, expression );
  630.                 OPC.FalseJump( expression, expression.fJump ); Checkpc;
  631.                 StatSeq( curNode.right );
  632.                 IF ( curNode.link # NIL ) OR ( node.right # NIL ) OR trap THEN
  633.                 (* last ELSIF part with no ELSE following *)
  634.                     OPL.Jump( true, endLabel );
  635.                 END;
  636.                 OPL.DefineLabel( expression.fJump );
  637.                 curNode := curNode.link;
  638.             END; (* WHILE *)
  639.             IF trap THEN
  640.                 OPC.Trap( WithTrap );
  641.             ELSE
  642.                 StatSeq( node.right );
  643.             END; (* IF *)
  644.             OPL.DefineLabel( endLabel );
  645.         END IfStatement;
  646.         PROCEDURE Size( typ : OPT.Struct; node : OPT.Node; VAR res : OPL.Item );
  647.         (* Returns an item that denotes the size of the memory space in bytes that has to be allocated for a dynamic array. *)
  648.             VAR dim, offsetItem : OPL.Item;
  649.                     noflen : INTEGER;
  650.         BEGIN (* Size *)
  651.             Expr( node, res );
  652.             noflen := 1;
  653.             node := node.link;
  654.             typ := typ.BaseTyp.BaseTyp;
  655.             WHILE node # NIL DO
  656.                 Expr( node, dim );
  657.                 INC( noflen );
  658.                 OPC.Mul( OPT.linttyp, dim, res );
  659.                 node := node.link;
  660.                 typ := typ.BaseTyp;
  661.             END; (* WHILE *)
  662.             IF typ.size > 1 THEN
  663.                 OPC.MakeIntConst( typ.size, OPT.linttyp, dim );
  664.                 OPC.Mul( OPT.linttyp, dim, res );
  665.             END; (* IF *)
  666.             OPC.MakeIntConst( 4 * noflen, OPT.linttyp, offsetItem );
  667.             OPC.Plus( OPT.linttyp, offsetItem, res );
  668.         END Size;
  669.         PROCEDURE EnterLengths( VAR item : OPL.Item; node : OPT.Node );
  670.         (* Writes the lengths in node to the address in item. Used for NEW( p, len1, len2, ... ). *)
  671.             VAR length, adr : OPL.Item;
  672.         BEGIN (* EnterLengths *)
  673.             adr := item;
  674.             OPC.DeRef( OPT.sysptrtyp, adr );
  675.             WHILE node # NIL DO
  676.                 Expr( node, length );
  677.                 OPC.Convert( length, OPT.linttyp );
  678.                 OPL.Move( length, adr );
  679.                 INC( adr.bd, 4 );
  680.                 node := node.link;
  681.             END; (* WHILE *)
  682.         END EnterLengths;
  683.         PROCEDURE Prepend( s : ARRAY OF CHAR );
  684.         (* Writes the given name in parentheses to the reference file. *)
  685.             VAR i : INTEGER;
  686.                     ch : CHAR;
  687.         BEGIN (* Prepend *)
  688.             i := 0;
  689.             ch := s[ 0 ];
  690.             OPM.RefW( "(" );
  691.             WHILE ch # 0X DO
  692.                 OPM.RefW( ch );
  693.                 INC( i );
  694.                 ch := s[ i ];
  695.             END; (* WHILE *)
  696.             OPM.RefW( ")" );
  697.         END Prepend;
  698.     BEGIN (* StatSeq *)
  699.         WHILE ( node # NIL ) & OPM.noerr DO
  700.             OPM.errpos := node.conval.intval;
  701.             OPL.BegStat;
  702.             CASE node.class OF
  703.                 Nenter :
  704.                     IF node.obj = NIL THEN (* module *)
  705.                         OPC.EnterMod;
  706.                         StatSeq( node.right );
  707.                         OPC.Return( NIL, FALSE, expression );
  708.                         OPL.OutRefPoint;
  709.                         OPL.OutRefName( "$" );
  710.                         OPL.OutRefs( OPT.topScope );
  711.                         INC( OPL.level );
  712.                         StatSeq( node.left );
  713.                         DEC( OPL.level );
  714.                     ELSE (* procedure *)
  715.                         proc := node.obj;
  716.                         INC( OPL.level );
  717.                         StatSeq( node.left );
  718.                         DEC( OPL.level );
  719.                         OPC.EnterProc( proc );
  720.                         StatSeq( node.right );
  721.                         IF proc.typ # OPT.notyp THEN OPC.Trap( FuncTrap );
  722.                         ELSE OPC.Return( proc, FALSE, expression );
  723.                         END;
  724.                         OPL.OutRefPoint;
  725.                         IF proc^.mode = TProc THEN Prepend( proc^.link^.typ^.strobj^.name ) END;
  726.                         OPL.OutRefName( proc^.name );
  727.                         OPL.OutRefs( proc^.scope^.right );
  728.                     END; (* IF *)
  729.                 | Ninittd :
  730.                 | Nassign :
  731.                     CASE node.subcl OF
  732.                         assign :
  733.                             expression.tJump := OPL.NewLabel;
  734.                             expression.fJump := OPL.NewLabel;
  735.                             Expr( node.right, expression );
  736.                             OPC.LoadCC( expression );
  737.                             Designator( node.left, designator );
  738.                             OPC.Assign( expression, designator );
  739.                         | newfn :
  740.                             Designator( node.left, designator );
  741.                             OPL.LoadAdr( designator );
  742.                             IF node.right = NIL THEN
  743.                                 IF node.left.typ.BaseTyp.comp = Record THEN
  744.                                     OPC.StaticTag( node.left.typ.BaseTyp, tag );
  745.                                     OPC.New( designator, tag );
  746.                                 ELSE
  747.                                     OPC.MakeIntConst( node.left.typ.BaseTyp.size, OPT.linttyp, expression );
  748.                                     OPC.SYSNew( designator, expression );
  749.                                 END; (* IF *)
  750.                             ELSE
  751.                                 Size( node.left.typ, node.right, expression );
  752.                                 OPC.SYSNew( designator, expression );
  753.                                 EnterLengths( designator, node.right );
  754.                             END; (* IF *)
  755.                         | incfn :
  756.                             Expr( node.right, expression );
  757.                             Designator( node.left, designator );
  758.                             OPL.LoadAdr( designator );
  759.                             OPC.Increment( designator, expression );
  760.                         | decfn :
  761.                             Expr( node.right, expression );
  762.                             Designator( node.left, designator );
  763.                             OPL.LoadAdr( designator );
  764.                             OPC.Decrement( designator, expression );
  765.                         | inclfn :
  766.                             Expr( node.right, expression );
  767.                             Designator( node.left, designator );
  768.                             OPL.LoadAdr( designator );
  769.                             OPC.Include( designator, expression );
  770.                         | exclfn :
  771.                             Expr( node.right, expression );
  772.                             Designator( node.left, designator );
  773.                             OPL.LoadAdr( designator );
  774.                             OPC.Exclude( designator, expression );
  775.                         | copyfn :
  776.                             Expr( node.right, expression );
  777.                             Designator( node.left, designator );
  778.                             OPC.Copy( expression, designator );
  779.                         | getfn :
  780.                             Expr( node.right, sourceAdr );
  781.                             Designator( node.left, designator );
  782.                             OPL.LoadAdr( designator );
  783.                             OPC.SYSGet( sourceAdr, designator );
  784.                         | putfn :
  785.                             Expr( node.left, destAdr );
  786.                             Expr( node.right, expression );
  787.                             OPC.SYSPut( expression, destAdr );
  788.                         | getrfn :
  789.                             OPC.MakeConst( node.obj, node.right.conval, OPT.inttyp, reg );
  790.                             Designator( node.left, designator );
  791.                             OPL.LoadAdr( designator );
  792.                             OPC.SYSGetReg( designator, reg );
  793.                         | putrfn :
  794.                             OPC.MakeConst( node.obj, node.left.conval, OPT.inttyp, reg );
  795.                             Expr( node.right, expression );
  796.                             OPC.SYSPutReg( expression, reg );
  797.                         | sysnewfn :
  798.                             Designator( node.left, designator );
  799.                             OPL.LoadAdr( designator );
  800.                             Expr( node.right, expression );
  801.                             OPC.SYSNew( designator, expression );
  802.                         | movefn :
  803.                             Expr( node.left, sourceAdr );
  804.                             Expr( node.right, destAdr );
  805.                             Expr( node.right.link, expression );
  806.                             OPC.SYSMove( destAdr, sourceAdr, expression );
  807.                     END; (* CASE *)
  808.                 | Ncall :
  809.                     IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  810.                         psize := OPM.PointerSize; (* for static link *)
  811.                     ELSE
  812.                         psize := 0;
  813.                     END;
  814.                     AllocParams( node.obj, psize );
  815.                     OPC.WriteStaticLink( node.left.obj );
  816.                     AssignParams( node.obj, node.right );
  817.                     Designator( node.left, procItem );
  818.                     OPC.Call( procItem, node.left.obj );
  819.                     OPC.AddToSP( psize );
  820.                 | Nifelse :
  821.                     IF ( node^.subcl # assertfn ) OR assert THEN IfStatement( node, FALSE ); END;
  822.                 | Ncase :
  823.                     CaseStatement( node );
  824.                 | Nwhile :
  825.                     begLabel := OPL.NewLabel;
  826.                     OPL.DefineLabel( begLabel );
  827.                     expression.tJump := OPL.NewLabel;
  828.                     expression.fJump := OPL.NewLabel;
  829.                     Expr( node.left, expression );
  830.                     OPC.FalseJump( expression, expression.fJump );
  831.                     StatSeq( node.right );
  832.                     OPL.Jump( true, begLabel );
  833.                     OPL.DefineLabel( expression.fJump );
  834.                 | Nrepeat :
  835.                     expression.tJump := OPL.NewLabel;
  836.                     expression.fJump := OPL.NewLabel;
  837.                     OPL.DefineLabel( expression.fJump );
  838.                     StatSeq( node.left );
  839.                     OPL.BegStat;
  840.                     Expr( node.right, expression );
  841.                     OPC.FalseJump( expression, expression.fJump );
  842.                 | Nloop :
  843.                     savedLoopEnd := loopEnd;
  844.                     begLabel := OPL.NewLabel;
  845.                     loopEnd := OPL.NewLabel;
  846.                     OPL.DefineLabel( begLabel );
  847.                     StatSeq( node.left );
  848.                     OPL.Jump( true, begLabel );
  849.                     OPL.DefineLabel( loopEnd );
  850.                     loopEnd := savedLoopEnd;
  851.                 | Nexit :
  852.                     OPL.Jump( true, loopEnd );
  853.                 | Nreturn :
  854.                     IF node.left # NIL THEN
  855.                         expression.tJump := OPL.NewLabel;
  856.                         expression.fJump := OPL.NewLabel;
  857.                         Expr( node.left, expression )
  858.                     END;
  859.                     OPC.Return( node.obj, node.left # NIL, expression );
  860.                 | Nwith :
  861.                     IfStatement( node, node.subcl = 0 );
  862.                 | Ntrap :
  863.                     IF node.right.conval.intval = 0 THEN node.right.conval.intval := 14 END ; (* should be parameter for front end*)
  864.                     OPC.Trap( SHORT( node.right.conval.intval ) );
  865.             END; (* CASE *)
  866.             Checkpc;
  867.             node := node.link;
  868.         END; (* WHILE *)
  869.     END StatSeq;
  870.     PROCEDURE Module*( prog : OPT.Node );
  871.     BEGIN
  872.         StatSeq( prog )
  873.     END Module;
  874. END OPV.
  875.