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