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 >
Wrap
Oberon Text
|
1977-12-31
|
29KB
|
875 lines
Syntax10.Scn.Fnt
StampElems
Alloc
25 Apr 96
FoldElems
Syntax10.Scn.Fnt
PROCEDURE f1():REAL;
BEGIN
RETURN 8
END f1;
PROCEDURE Do*;
BEGIN
f:=f1;
w:=f(); Out.Real(w,8);
w:=f1(); Out.Real(w,8);
END Do;
MODULE OPV;
(* Control Module for the backend of the Oberon-2-Compiler for Sun-3.
Diplomarbeit Samuel Urech
Date: 30.10.92 Current version:
Try to fix a bug in Expr. Hope it will work. RD 17.4.96
had problems *)
IMPORT OPT, OPC, OPL, OPM;
CONST
(* object modes *)
Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
(* opcodes *)
ASh = 0; LSh = 1; ROt = 3;
(* Condition codes *)
false = 1; true = 0;
CC = 4; CS = 5; EQ = 7; GE = 12; GT = 14; HI = 2; LE = 15;
LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; VC = 8; VS = 9;
(* operation node subclasses *)
times = 1; slash = 2; div = 3; mod = 4;
and = 5; plus = 6; minus = 7; or = 8; eql = 9;
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
in = 15; is = 16; ash = 17; msk = 18; len = 19;
conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
(* SYSTEM *)
adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
(* 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, Int, LInt }; realSet = { Real, LReal };
(* node classes *)
Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
Nreturn = 26; Nwith = 27; Ntrap = 28;
(* function numbers *)
assign = 0; newfn = 1; incfn = 13; decfn = 14;
inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
(* SYSTEM function numbers *)
getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
VarParSize = OPM.PointerSize;
RecVarParSize = 2 * OPM.PointerSize;
ProcOff = 8;
(* procedure flags *)
hasBody = 1; isRedef = 2;
(* accessibility of objects *)
internal = 0; external = 1; externalR = 2;
(* trap numbers *)
WithTrap = 15;
CaseTrap = 16;
FuncTrap = 17;
VAR assert, findpc, typCheck : BOOLEAN;
loopEnd : OPL.Label;
PROCEDURE Init*( opt : SET; bpc : LONGINT );
CONST ass = 7; fpc = 8; typchk = 3;
BEGIN
typCheck := typchk IN opt;
assert := ass IN opt;
findpc := fpc IN opt;
IF findpc THEN OPM.breakpc := bpc ELSE OPM.breakpc := MAX( LONGINT ) END
END Init;
PROCEDURE Base( typ : OPT.Struct ) : INTEGER;
(* Returns the alignment of a type. *)
BEGIN
WHILE typ.comp = Array DO typ := typ.BaseTyp END;
IF typ.form IN { Byte, Bool, Char, SInt } THEN RETURN 1
ELSE RETURN 2
END
END Base;
PROCEDURE Align( VAR adr : LONGINT; base : LONGINT );
(* Aligns the given address with the given base. *)
BEGIN
IF adr > 0 THEN
INC( adr, ( -adr ) MOD base );
ELSE
DEC( adr, adr MOD base );
END;
END Align;
PROCEDURE ^TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
PROCEDURE ParamAdr( par : OPT.Object; VAR psize : LONGINT );
(* Calculates the sizes of the parameters of a procedure and returns their sum in psize. *)
VAR typ : OPT.Struct;
c : INTEGER;
BEGIN (* ParamAdr *)
WHILE par # NIL DO
typ := par.typ; c := typ.comp;
TypSize( typ, FALSE );
IF par.mode = VarPar THEN
par.adr := psize;
IF c = Record THEN INC( psize, RecVarParSize )
ELSIF c = DynArr THEN INC( psize, typ.size )
ELSE INC( psize, VarParSize )
END;
ELSE
IF typ.form IN {Byte, Bool, Char, SInt, Int} THEN
INC( psize, OPM.LIntSize );
ELSE
INC( psize, typ.size );
END;
par.adr := psize - typ.size;
par.linkadr := par.adr;
END; (* IF *)
Align( psize, 4 ); (* all parameters are aligned to 4 bytes. *)
par := par.link;
END; (* WHILE *)
END ParamAdr;
PROCEDURE ^VarAdr( var : OPT.Object; VAR dsize : LONGINT );
PROCEDURE ^Traverse( obj : OPT.Object; exported : BOOLEAN );
PROCEDURE ProcSize( obj : OPT.Object; firstpass : BOOLEAN );
(* Writes the size of the local variables into the field obj.conval.intval and calculates the addresses of all parameters. *)
VAR oldPos : LONGINT;
conval: OPT.Const;
typ : OPT.Struct;
redef : OPT.Object;
BEGIN (* ProcSize *)
conval := obj.conval;
oldPos := OPM.errpos;
OPM.errpos := obj.scope.adr;
IF ( ( obj.vis # internal ) = firstpass ) OR ( obj.mode = TProc ) THEN
obj.adr := -1;
obj.linkadr := OPL.NewLabel;
IF obj.mode IN { XProc, IProc, TProc } THEN
IF OPL.entno < OPL.MaxEntry THEN
obj.adr := OPL.entno;
INC( OPL.entno );
ELSE
OPM.err( 226 );
obj.adr := 1;
END;
END;
IF obj.mnolev > 0 THEN
conval.intval2 := ProcOff + OPM.PointerSize; (* for static link *)
ELSE
conval.intval2 := ProcOff;
END;
ParamAdr( obj.link, conval.intval2 );
IF obj.mode = TProc THEN
typ := obj.link.typ;
IF typ.form = Pointer THEN typ := typ.BaseTyp END;
OPT.FindField( obj.name, typ.BaseTyp, redef );
IF redef # NIL THEN
obj.adr := 10000H * ( redef.adr DIV 10000H ) (* mthno *) + obj.adr (* entno *);
IF ~( isRedef IN obj.conval.setval ) THEN OPM.err( 134 ) END;
ELSE
INC( obj.adr, 10000H * typ.n );
INC( typ.n );
END; (* IF *)
END; (* IF *)
END; (* IF *)
IF ~firstpass THEN
IF ~( hasBody IN conval.setval ) THEN OPM.err( 129 ) END;
conval.intval := 0;
VarAdr( obj.scope.scope, conval.intval ); (* local variables *)
Traverse( obj.scope.right, FALSE ); (* local types and procedures *)
END;
OPM.errpos := oldPos
END ProcSize;
PROCEDURE TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
(* Writes the size of a type into typ.size. All subordinate type sizes are calculated, all record fields get an offset. *)
VAR offset, size : LONGINT;
fld : OPT.Object;
btyp : OPT.Struct;
BEGIN (* TypSize *)
IF typ.size = -1 THEN
CASE typ.form OF
Pointer :
typ.size := OPM.PointerSize;
IF typ.BaseTyp = OPT.undftyp THEN
OPM.Mark( 128, typ.n );
ELSE
TypSize( typ.BaseTyp, FALSE );
END;
| ProcTyp :
size := ProcOff; typ.size := OPM.ProcSize;
ParamAdr( typ.link, size ); (* inserts the addresses of the parameters. *)
| Comp :
CASE typ.comp OF
Record :
btyp := typ.BaseTyp;
IF btyp = NIL THEN
offset := 0;
ELSE
TypSize( btyp, FALSE );
offset := btyp.size;
END;
fld := typ.link;
WHILE ( fld # NIL ) & ( fld.mode = Fld ) DO
btyp := fld.typ;
TypSize( btyp, FALSE );
size := btyp.size;
Align( offset, Base( btyp ) );
fld.adr := offset;
INC( offset, size );
fld := fld.link
END; (* WHILE *)
Align( offset, 2 ); (* all records are at least 2 Bytes long *)
typ.size := offset;
| Array :
TypSize( typ.BaseTyp, FALSE );
typ.size := typ.n * typ.BaseTyp.size;
| DynArr :
btyp := typ.BaseTyp;
IF typ.offset < 0 THEN typ.offset := typ.n; END;
IF btyp.comp = DynArr THEN btyp.offset := typ.n; END;
TypSize( btyp, FALSE );
IF btyp.comp = DynArr THEN
typ.size := btyp.size + 4;
ELSE
typ.size := 8;
END;
END; (* CASE *)
ELSE (* nothing *)
END; (* CASE typ.form *)
END; (* IF *)
END TypSize;
PROCEDURE VarAdr( var : OPT.Object; VAR dsize : LONGINT );
(* Inserts entry-numbers and addresses into the variables. Exported variables are entered into the entry list. *)
VAR typ: OPT.Struct; adr: LONGINT;
BEGIN
adr := -dsize;
WHILE var # NIL DO
typ := var.typ;
TypSize( typ, FALSE );
DEC( adr, typ.size );
IF typ.form = Comp THEN
Align( adr, 4 );
ELSE
Align( adr, Base( typ ) );
END; (* IF *)
IF var.vis = internal THEN
var.adr := adr;
ELSE
OPL.SetEntry( OPL.entno, adr );
var.adr := OPL.entno;
INC( OPL.entno );
END; (* IF *)
var.linkadr := adr;
var := var.link
END; (* WHILE *)
dsize := -adr;
Align( dsize, 8 );
END VarAdr;
PROCEDURE Traverse( obj : OPT.Object; exported : BOOLEAN );
(* Completes types and procedures. *)
VAR typ: OPT.Struct;
PROCEDURE TraverseRecord( typ : OPT.Struct );
(* Inserts the type descriptor address into the types and the method numbers into the methods. *)
BEGIN
IF typ.tdadr = OPM.TDAdrUndef THEN
IF typ.BaseTyp # NIL THEN
TraverseRecord( typ.BaseTyp );
typ.n := typ.BaseTyp.n;
END; (* IF *)
Traverse( typ.link, FALSE ); (* traverse methods *)
OPL.AllocTypDesc( typ );
END; (* IF *)
END TraverseRecord;
BEGIN (* Traverse *)
IF obj # NIL THEN
Traverse( obj.left, exported );
IF ( obj.mode = Typ ) & ( ( obj.vis # internal ) = exported ) THEN
typ := obj.typ;
TypSize( typ, FALSE );
IF typ.form = Pointer THEN typ := typ.BaseTyp END;
IF typ.comp = Record THEN TraverseRecord( typ ) END;
ELSIF obj.mode IN {LProc, XProc, TProc, CProc, IProc} THEN
ProcSize( obj, exported )
END ;
Traverse( obj.right, exported )
END
END Traverse;
PROCEDURE AdrAndSize*;
(* Completes the symbol table: types, variables, record-fields and procedures. *)
BEGIN (* AdrAndSize *)
OPL.dsize := 0;
VarAdr( OPT.topScope.scope, OPL.dsize );
OPM.errpos := OPT.topScope.adr; (* text position of the scope *)
Traverse( OPT.topScope.right, TRUE ); (* first run for all exported types and procedures *)
Traverse( OPT.topScope.right, FALSE ); (* second run for all local types and procedures *)
END AdrAndSize;
PROCEDURE BaseTyp( typ : OPT.Struct ) : OPT.Struct;
(* Returns the record type belonging to typ. *)
BEGIN (* BaseTyp *)
IF typ.form = Pointer THEN RETURN typ.BaseTyp
ELSE RETURN typ
END
END BaseTyp;
PROCEDURE ^Expr( node : OPT.Node; VAR res : OPL.Item );
PROCEDURE Designator( node : OPT.Node; VAR res : OPL.Item );
(* Returns an item for a designator. res.mode is in { regx, pcx }. *)
VAR index, tag : OPL.Item;
BEGIN (* Designator *)
CASE node.class OF
Nvar, Nvarpar :
OPC.MakeVar( node.obj, res );
| Nfield :
Designator( node.left, res );
OPC.MakeField( res, node.obj.adr, node.typ );
| Nderef :
Designator( node.left, res );
OPC.DeRef( node.typ, res );
| Nindex :
Expr( node.right, index );
Designator( node.left, res );
OPC.MakeIndex( index, res );
| Nguard, Neguard :
Designator( node.left, res );
IF typCheck THEN
OPC.saveRegs:=FALSE;
OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
OPC.TypeTest( tag, BaseTyp( node.typ ), TRUE, node.class = Neguard );
OPC.saveRegs:=TRUE;
END; (* IF *)
| Nproc :
OPC.MakeProc( node.obj, node.subcl, res );
END; (* CASE *)
res.typ := node.typ;
END Designator;
PROCEDURE AllocParams( formalPar : OPT.Object; VAR psize : LONGINT );
(* Allocates space on the stack for the parameters and increments psize by their size. *)
BEGIN (* AllocParams *)
WHILE formalPar # NIL DO
IF formalPar.mode = VarPar THEN
IF formalPar.typ.comp = Record THEN INC( psize, RecVarParSize )
ELSIF formalPar.typ.comp = DynArr THEN INC( psize, formalPar.typ.size )
ELSE INC( psize, VarParSize )
END;
ELSE
INC( psize, formalPar.typ.size );
END; (* IF *)
Align( psize, 4 );
formalPar := formalPar.link;
END; (* WHILE *)
OPC.AddToSP( -psize );
END AllocParams;
PROCEDURE AssignParams( formalPar : OPT.Object; actualPar : OPT.Node );
(* Moves the actual parameters to the stack. *)
VAR par, par1, tag : OPL.Item;
BEGIN (* AssignParams *)
WHILE formalPar # NIL DO
IF formalPar.typ.comp = DynArr THEN
Expr( actualPar, par );
OPC.MoveDynArrStack( formalPar.typ, formalPar.adr - ProcOff, par );
ELSIF formalPar.mode = VarPar THEN
Designator( actualPar, par );
par1 := par;
OPC.MoveAdrStack( formalPar.adr - ProcOff, par );
IF formalPar.typ.comp = Record THEN
OPC.MakeTag( actualPar.obj, actualPar.typ, par, tag );
OPC.MoveStack( formalPar.adr + 4 - ProcOff, tag );
ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ # OPT.sysptrtyp ) THEN
(* pass static type to enable run time tests *)
OPC.StaticTag( actualPar.typ.BaseTyp, tag );
OPC.Assign( tag, par1 );
ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ = OPT.sysptrtyp ) & ( actualPar.obj.mode # VarPar ) THEN
(* pass NIL to disable run time tests *)
OPC.MakeIntConst( 0, OPT.linttyp, tag );
OPC.Assign( tag, par1 );
END; (* IF *)
ELSE
par.tJump := OPL.NewLabel;
par.fJump := OPL.NewLabel;
Expr( actualPar, par );
OPC.Convert( par, formalPar.typ );
OPC.MoveStack( formalPar.adr - ProcOff, par );
END; (* IF *)
OPL.usedRegs := { };
actualPar := actualPar.link;
formalPar := formalPar.link;
END; (* WHILE *)
END AssignParams;
PROCEDURE Expr( node : OPT.Node; VAR res : OPL.Item );
(* Returns an item for the result of an exression. *)
VAR expr1, expr2, expression, set, element, procItem, arr, tag : OPL.Item;
swap : OPL.Label;
savedRegs : SET;
psize: LONGINT;
Dummy: SHORTINT;
BEGIN (* Expr *)
CASE node.class OF
Nconst :
OPC.MakeConst( node.obj, node.conval, node.typ, res );
| Nupto :
Expr( node.left, expr1 );
Expr( node.right, expr2 );
OPC.UpTo( expr1, expr2, res );
| Nmop :
CASE node.subcl OF
not :
swap := res.tJump;
res.tJump := res.fJump;
res.fJump := swap;
Expr( node.left, res );
swap := res.tJump;
res.tJump := res.fJump;
res.fJump := swap;
OPC.Not( res );
| minus :
Expr( node.left, res );
OPC.Neg( res );
| is :
Designator( node.left, res );
tag.tJump := res.tJump;
tag.fJump := res.fJump;
OPC.saveRegs:=FALSE;
OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
OPC.TypeTest( tag, BaseTyp( node.obj.typ ), FALSE, FALSE );
OPC.saveRegs:=TRUE;
res := tag;
| conv :
Expr( node.left, res );
IF node.typ.form = Set THEN
OPC.SetElem( res );
ELSE
OPC.Convert( res, node.typ );
END; (* IF *)
| abs :
Expr( node.left, res );
OPC.Abs( res );
| cap :
Expr( node.left, res );
OPC.Cap( res );
| odd :
Expr( node.left, res );
OPC.Odd( res );
| adr :
Expr( node.left, res );
OPC.Adr( res );
| cc :
OPC.MakeCocItem( SHORT( node.left.conval.intval ), res );
| val :
res.tJump := OPL.NewLabel;
res.fJump := OPL.NewLabel;
Expr( node.left, res );
IF res.typ.comp = DynArr THEN OPC.GetDynArrVal( res ); END;
res.typ := node.typ;
END; (* CASE *)
| Ndop :
CASE node.subcl OF
times :
Expr( node.left, expression );
Expr( node.right, res );
OPC.Mul( node.typ, expression, res );
| slash :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Divide( node.typ, expression, res );
| div :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Div( expression, res );
| mod :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Mod( expression, res );
| and :
savedRegs := OPL.usedRegs;
expression.tJump := OPL.NewLabel;
expression.fJump := res.fJump;
Expr( node.left, expression );
OPC.FalseJump( expression, expression.fJump );
OPL.usedRegs := savedRegs;
Expr( node.right, res );
OPC.Test( res );
res.fJump := OPL.MergedLinks( expression.fJump, res.fJump );
| plus :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Plus( node.typ, expression, res );
| minus :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Minus( node.typ, expression, res );
| or :
savedRegs := OPL.usedRegs;
expression.tJump := res.tJump;
expression.fJump := OPL.NewLabel;
Expr( node.left, expression );
OPC.TrueJump( expression, expression.tJump );
OPL.usedRegs := savedRegs;
Expr( node.right, res );
OPC.Test( res );
res.tJump := OPL.MergedLinks( expression.tJump, res.tJump );
| eql, neq, lss, leq, gtr, geq :
expr1.tJump := OPL.NewLabel;
expr1.fJump := OPL.NewLabel;
expr2.tJump := OPL.NewLabel;
expr2.fJump := OPL.NewLabel;
Expr( node.left, expr1 );
OPC.LoadCC( expr1 );
Expr( node.right, expr2 );
OPC.Compare( node.subcl, expr1, expr2, res );
| in :
Expr( node.left, element );
Expr( node.right, set );
OPC.In( element, set, res );
| ash :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Shift( ASh, expression, res );
| msk :
Expr( node.left, res );
OPC.Mask( -node.right.conval.intval-1, res );
| len :
Designator( node.left, arr );
OPC.MakeLen( arr, node.right.conval.intval, res );
| bit :
Expr( node.left, expr1 );
Expr( node.right, expr2 );
OPC.SYSBit( expr1, expr2, res );
| lsh :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Shift( LSh, expression, res );
| rot :
Expr( node.left, res );
Expr( node.right, expression );
OPC.Shift( ROt, expression, res );
END; (* CASE *)
| Ncall :
savedRegs := OPL.usedRegs;
OPC.PushRegs( OPL.usedRegs );
OPL.usedRegs := { };
IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
psize := OPM.PointerSize; (* for static link *)
ELSE
psize := 0;
END;
AllocParams( node.obj, psize );
OPC.WriteStaticLink( node.left.obj );
AssignParams( node.obj, node.right );
Designator( node.left, procItem );
OPC.Call( procItem, node.left.obj );
OPC.AddToSP( psize );
OPL.usedRegs := savedRegs;
Dummy:=node.left.typ.form;
node.left.typ.form:=node.typ.form;
OPC.GetResult( node.left.typ, res );
node.left.typ.form:=Dummy;
OPC.PopRegs( savedRegs );
ELSE
Designator( node, res );
END; (* CASE *)
res.typ := node.typ;
END Expr;
PROCEDURE Checkpc;
BEGIN
IF findpc & (OPL.pc > OPM.breakpc) & OPM.noerr THEN OPM.err(255) END
(* in the case of a call, the breakpc value shown in the trap viewer must point to the call instruction
and not to the next instruction, i.e. breakpc # return address !! *)
END Checkpc;
PROCEDURE StatSeq( node : OPT.Node );
(* Generates code for a statement sequence. *)
VAR proc : OPT.Object;
designator, expression, sourceAdr, destAdr, procItem, reg, tag : OPL.Item;
begLabel, savedLoopEnd : OPL.Label;
psize : LONGINT;
PROCEDURE CaseStatement( node : OPT.Node );
(* Generates code for a case statement. *)
VAR expression : OPL.Item;
lo, hi, i, jtAdr : LONGINT;
elseLabel, endLabel : OPL.Label;
case, caseLabel : OPT.Node;
BEGIN (* CaseStatement *)
Expr( node.left, expression );
node := node.right;
lo := node.conval.intval;
hi := node.conval.intval2;
IF hi >= lo THEN
elseLabel := OPL.NewLabel;
endLabel := OPL.NewLabel;
OPC.Case( expression, lo, hi, elseLabel, jtAdr );
FOR i := 0 TO hi - lo DO OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); END;
OPL.DefineLabel( elseLabel );
END; (* IF *)
Checkpc;
IF node.conval.setval = { } THEN
OPC.Trap( CaseTrap );
ELSE
StatSeq( node.right );
END;
IF hi >= lo THEN
case := node.left;
WHILE case # NIL DO
OPL.Jump( true, endLabel );
caseLabel := case.left;
WHILE caseLabel # NIL DO
FOR i := caseLabel.conval.intval - lo TO caseLabel.conval.intval2 - lo DO
OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 );
END; (* FOR *)
caseLabel := caseLabel.link;
END; (* WHILE *)
StatSeq( case.right );
case := case.link;
END; (* WHILE *)
OPL.DefineLabel( endLabel );
END; (* IF *)
END CaseStatement;
PROCEDURE IfStatement( node : OPT.Node; trap : BOOLEAN );
(* Generates code for an IF-Statement. If trap is true, a Trap is generated in the ELSE-Case. *)
VAR endLabel : OPL.Label;
curNode : OPT.Node;
expression : OPL.Item;
BEGIN (* IfStatement *)
endLabel := OPL.NewLabel;
curNode := node.left;
WHILE curNode # NIL DO
expression.tJump := OPL.NewLabel;
expression.fJump := OPL.NewLabel;
Expr( curNode.left, expression );
OPC.FalseJump( expression, expression.fJump ); Checkpc;
StatSeq( curNode.right );
IF ( curNode.link # NIL ) OR ( node.right # NIL ) OR trap THEN
(* last ELSIF part with no ELSE following *)
OPL.Jump( true, endLabel );
END;
OPL.DefineLabel( expression.fJump );
curNode := curNode.link;
END; (* WHILE *)
IF trap THEN
OPC.Trap( WithTrap );
ELSE
StatSeq( node.right );
END; (* IF *)
OPL.DefineLabel( endLabel );
END IfStatement;
PROCEDURE Size( typ : OPT.Struct; node : OPT.Node; VAR res : OPL.Item );
(* Returns an item that denotes the size of the memory space in bytes that has to be allocated for a dynamic array. *)
VAR dim, offsetItem : OPL.Item;
noflen : INTEGER;
BEGIN (* Size *)
Expr( node, res );
noflen := 1;
node := node.link;
typ := typ.BaseTyp.BaseTyp;
WHILE node # NIL DO
Expr( node, dim );
INC( noflen );
OPC.Mul( OPT.linttyp, dim, res );
node := node.link;
typ := typ.BaseTyp;
END; (* WHILE *)
IF typ.size > 1 THEN
OPC.MakeIntConst( typ.size, OPT.linttyp, dim );
OPC.Mul( OPT.linttyp, dim, res );
END; (* IF *)
OPC.MakeIntConst( 4 * noflen, OPT.linttyp, offsetItem );
OPC.Plus( OPT.linttyp, offsetItem, res );
END Size;
PROCEDURE EnterLengths( VAR item : OPL.Item; node : OPT.Node );
(* Writes the lengths in node to the address in item. Used for NEW( p, len1, len2, ... ). *)
VAR length, adr : OPL.Item;
BEGIN (* EnterLengths *)
adr := item;
OPC.DeRef( OPT.sysptrtyp, adr );
WHILE node # NIL DO
Expr( node, length );
OPC.Convert( length, OPT.linttyp );
OPL.Move( length, adr );
INC( adr.bd, 4 );
node := node.link;
END; (* WHILE *)
END EnterLengths;
PROCEDURE Prepend( s : ARRAY OF CHAR );
(* Writes the given name in parentheses to the reference file. *)
VAR i : INTEGER;
ch : CHAR;
BEGIN (* Prepend *)
i := 0;
ch := s[ 0 ];
OPM.RefW( "(" );
WHILE ch # 0X DO
OPM.RefW( ch );
INC( i );
ch := s[ i ];
END; (* WHILE *)
OPM.RefW( ")" );
END Prepend;
BEGIN (* StatSeq *)
WHILE ( node # NIL ) & OPM.noerr DO
OPM.errpos := node.conval.intval;
OPL.BegStat;
CASE node.class OF
Nenter :
IF node.obj = NIL THEN (* module *)
OPC.EnterMod;
StatSeq( node.right );
OPC.Return( NIL, FALSE, expression );
OPL.OutRefPoint;
OPL.OutRefName( "$" );
OPL.OutRefs( OPT.topScope );
INC( OPL.level );
StatSeq( node.left );
DEC( OPL.level );
ELSE (* procedure *)
proc := node.obj;
INC( OPL.level );
StatSeq( node.left );
DEC( OPL.level );
OPC.EnterProc( proc );
StatSeq( node.right );
IF proc.typ # OPT.notyp THEN OPC.Trap( FuncTrap );
ELSE OPC.Return( proc, FALSE, expression );
END;
OPL.OutRefPoint;
IF proc^.mode = TProc THEN Prepend( proc^.link^.typ^.strobj^.name ) END;
OPL.OutRefName( proc^.name );
OPL.OutRefs( proc^.scope^.right );
END; (* IF *)
| Ninittd :
| Nassign :
CASE node.subcl OF
assign :
expression.tJump := OPL.NewLabel;
expression.fJump := OPL.NewLabel;
Expr( node.right, expression );
OPC.LoadCC( expression );
Designator( node.left, designator );
OPC.Assign( expression, designator );
| newfn :
Designator( node.left, designator );
OPL.LoadAdr( designator );
IF node.right = NIL THEN
IF node.left.typ.BaseTyp.comp = Record THEN
OPC.StaticTag( node.left.typ.BaseTyp, tag );
OPC.New( designator, tag );
ELSE
OPC.MakeIntConst( node.left.typ.BaseTyp.size, OPT.linttyp, expression );
OPC.SYSNew( designator, expression );
END; (* IF *)
ELSE
Size( node.left.typ, node.right, expression );
OPC.SYSNew( designator, expression );
EnterLengths( designator, node.right );
END; (* IF *)
| incfn :
Expr( node.right, expression );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.Increment( designator, expression );
| decfn :
Expr( node.right, expression );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.Decrement( designator, expression );
| inclfn :
Expr( node.right, expression );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.Include( designator, expression );
| exclfn :
Expr( node.right, expression );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.Exclude( designator, expression );
| copyfn :
Expr( node.right, expression );
Designator( node.left, designator );
OPC.Copy( expression, designator );
| getfn :
Expr( node.right, sourceAdr );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.SYSGet( sourceAdr, designator );
| putfn :
Expr( node.left, destAdr );
Expr( node.right, expression );
OPC.SYSPut( expression, destAdr );
| getrfn :
OPC.MakeConst( node.obj, node.right.conval, OPT.inttyp, reg );
Designator( node.left, designator );
OPL.LoadAdr( designator );
OPC.SYSGetReg( designator, reg );
| putrfn :
OPC.MakeConst( node.obj, node.left.conval, OPT.inttyp, reg );
Expr( node.right, expression );
OPC.SYSPutReg( expression, reg );
| sysnewfn :
Designator( node.left, designator );
OPL.LoadAdr( designator );
Expr( node.right, expression );
OPC.SYSNew( designator, expression );
| movefn :
Expr( node.left, sourceAdr );
Expr( node.right, destAdr );
Expr( node.right.link, expression );
OPC.SYSMove( destAdr, sourceAdr, expression );
END; (* CASE *)
| Ncall :
IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
psize := OPM.PointerSize; (* for static link *)
ELSE
psize := 0;
END;
AllocParams( node.obj, psize );
OPC.WriteStaticLink( node.left.obj );
AssignParams( node.obj, node.right );
Designator( node.left, procItem );
OPC.Call( procItem, node.left.obj );
OPC.AddToSP( psize );
| Nifelse :
IF ( node^.subcl # assertfn ) OR assert THEN IfStatement( node, FALSE ); END;
| Ncase :
CaseStatement( node );
| Nwhile :
begLabel := OPL.NewLabel;
OPL.DefineLabel( begLabel );
expression.tJump := OPL.NewLabel;
expression.fJump := OPL.NewLabel;
Expr( node.left, expression );
OPC.FalseJump( expression, expression.fJump );
StatSeq( node.right );
OPL.Jump( true, begLabel );
OPL.DefineLabel( expression.fJump );
| Nrepeat :
expression.tJump := OPL.NewLabel;
expression.fJump := OPL.NewLabel;
OPL.DefineLabel( expression.fJump );
StatSeq( node.left );
OPL.BegStat;
Expr( node.right, expression );
OPC.FalseJump( expression, expression.fJump );
| Nloop :
savedLoopEnd := loopEnd;
begLabel := OPL.NewLabel;
loopEnd := OPL.NewLabel;
OPL.DefineLabel( begLabel );
StatSeq( node.left );
OPL.Jump( true, begLabel );
OPL.DefineLabel( loopEnd );
loopEnd := savedLoopEnd;
| Nexit :
OPL.Jump( true, loopEnd );
| Nreturn :
IF node.left # NIL THEN
expression.tJump := OPL.NewLabel;
expression.fJump := OPL.NewLabel;
Expr( node.left, expression )
END;
OPC.Return( node.obj, node.left # NIL, expression );
| Nwith :
IfStatement( node, node.subcl = 0 );
| Ntrap :
IF node.right.conval.intval = 0 THEN node.right.conval.intval := 14 END ; (* should be parameter for front end*)
OPC.Trap( SHORT( node.right.conval.intval ) );
END; (* CASE *)
Checkpc;
node := node.link;
END; (* WHILE *)
END StatSeq;
PROCEDURE Module*( prog : OPT.Node );
BEGIN
StatSeq( prog )
END Module;
END OPV.