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.