<> <> <> DIRECTORY M2D USING [WordSize, StrForm, ObjPtr, StrPtr, VarPtr, ProcPtr, RangePtr, SetPtr, booltyp, inttyp, addrtyp, UNION, INTERSECTION, SETDIFF, SYMMDIFF, SUBSET], M2S USING [Symbol, Mark], M2I USING [Relation, inv, pc, Reloc, PutOI, PutOB, PutODB, PutOQB, PutLR, PutLRB, PutRR, PutQR, PutExch, PutLod, PutAdd, PutSub, PutBJ, PutFJ, PutSOp, FixLink, MergedLinks], M2H USING [ItemMode, ItemPtr]; M2HImpl : CEDAR PROGRAM IMPORTS M2D, M2S, M2I EXPORTS M2H = BEGIN OPEN M2H; LIQB: CARDINAL = 62B; CALL: CARDINAL = 70B; RX: CARDINAL = 102B; ADD: CARDINAL = 104B; SUB: CARDINAL = 105B; DIS: CARDINAL = 111B; EXDIS: CARDINAL = 113B; LC: CARDINAL = 130B; LR: CARDINAL = 140B; QOR: CARDINAL = 200B; QAND: CARDINAL = 201B; QRX: CARDINAL = 202B; QADD: CARDINAL = 204B; QSUB: CARDINAL = 205B; RB: CARDINAL = 230B; LRI: CARDINAL = 240B; ROR: CARDINAL = 300B; RAND: CARDINAL = 301B; RADD: CARDINAL = 304B; RSUB: CARDINAL = 305B; RXOR: CARDINAL = 310B; RFU: CARDINAL = 312B; LIDB: CARDINAL = 322B; JDB: CARDINAL = 327B; SHL: CARDINAL = 370B; SHR: CARDINAL = 371B; FSDB: CARDINAL = 373B; Mult: CARDINAL = 2; Div: CARDINAL = 3; Mod: CARDINAL = 4; RealAdd: CARDINAL = 5; RealSub: CARDINAL = 6; RealMult: CARDINAL = 7; RealDiv: CARDINAL = 8; MakeBit: CARDINAL = 11; MakeBits: CARDINAL = 12; MaxCard: CARDINAL = 177777B; MaxInt: INTEGER = 77777B; MinInt: INTEGER = - MaxInt; MaxReal: REAL = 1E38; MinReal: REAL = -1E38; mask: ARRAY [0..M2D.WordSize) OF LONG CARDINAL _ [0B, 1B, 3B, 7B, 17B, 37B, 77B, 177B, 377B, 777B, 1777B, 3777B, 7777B, 17777B, 37777B, 77777B, 177777B, 377777B, 777777B, 1777777B, 3777777B, 77777777B, 17777777B, 37777777B, 77777777B, 177777777B, 377777777B, 777777777B, 1777777777B, 3777777777B, 7777777777B, 17777777777B]; rngchk: PUBLIC BOOLEAN; exp: CARDINAL _ 0; err: PROC [n: CARDINAL] = { M2S.Mark [n] }; clog: PROC [x: CARDINAL] RETURNS [CARDINAL] = { exp _ 0; IF x > 0 THEN WHILE x MOD 2 = 0 DO x _ x/2; exp _ exp + 1 ENDLOOP; RETURN [x] }; f: PROC [cell, cell0: CARDINAL] RETURNS [CARDINAL] = INLINE { IF cell # 0 THEN RETURN [cell] ELSE RETURN [cell0] }; SRTest: PROC [x: ItemPtr] = { IF (x^.typ # NIL) AND (x^.typ^.form = Range) THEN { range: M2D.RangePtr _ NARROW [x^.typ^.ext]; x^.typ _ range^.BaseTyp }}; SetOpn: PROC [opr: CARDINAL, x, y: ItemPtr] = { IF x^.mode = conMd THEN { x^.opt _ 1; x^.reg _ x^.val.C } ELSE IF x^.mode = stkMd THEN { x^.opt _ 1; x^.reg _ 12 }; IF y^.mode = conMd THEN { y^.opt _ 1; y^.reg _ y^.val.C } ELSE IF y^.mode = stkMd THEN { y^.opt _ 1; y^.reg _ 12 }; x^.opr _ opr; x^.opt2 _ y^.opt; x^.reg2 _ y^.reg; x^.mode _ opnMd }; SetJmp: PROC [rel: M2I.Relation, x: ItemPtr, opt, reg: CARDINAL] = { x^.typ _ M2D.booltyp; x^.mode _ jmpMd; x^.rel _ rel; x^.opt _ opt; x^.reg _ reg; x^.Tjmp _ 0; x^.Fjmp _ 0 }; PrepJmp: PROC [rel, iRel: M2I.Relation, x, y: ItemPtr] = { IF x^.mode = conMd THEN IF y^.mode = regMd THEN { LoadStk [x]; SetJmp [rel, x, x^.opt, x^.reg] } ELSE IF x^.val.C >= 5 THEN { LoadStk [x]; SetJmp [iRel, x, 1, 12] } ELSE SetJmp [iRel, x, 1, x^.val.C] ELSE IF x^.mode = regMd THEN { LoadStk [y]; SetJmp [iRel, x, x^.opt, x^.reg] } ELSE IF y^.mode = conMd THEN IF y^.val.C >= 5 THEN { LoadStk [y]; SetJmp [rel, x, 1, 12] } ELSE SetJmp [rel, x, 1, y^.val.C] ELSE IF y^.mode = regMd THEN SetJmp [rel, x, y^.opt, y^.reg] ELSE SetJmp [rel, x, 1, 12]; x^.typ _ M2D.booltyp }; PutLdAdr: PROC [x: ItemPtr] = { -- cell var -- dl: CARDINAL; proc: M2D.ProcPtr; var: M2D.VarPtr _ NARROW[x^.obj^.ext]; IF var^.mod = 0 THEN { dl _ x^.contxt^.lev - var^.lev; IF dl = 0 THEN { x^.mode _ ladrMd; x^.reg _ x^.contxt^.LNK+1; x^.off _ var^.cell; IF var^.cell < 16 THEN x^.expRegs [var^.cell] _ TRUE } ELSE { proc _ x^.contxt; IF dl >= 2 THEN { M2I.PutLRB [LRI+x^.contxt^.LNK, 0]; proc _ proc^.pAnc; dl _ dl - 2; WHILE dl # 0 DO M2I.PutOB [RB, 0]; proc _ proc^.pAnc; dl _ dl - 1 ENDLOOP; x^.mode _ sadrMd; x^.off _ f[var^.cell, proc^.pAnc^.LNK] } ELSE { x^.mode _ ladrMd; x^.reg _ x^.contxt^.LNK; x^.off _ f[var^.cell, proc^.pAnc^.LNK] }; IF var^.cell < 16 THEN proc^.impRegs [var^.cell] _ TRUE }} ELSE { M2I.Reloc; M2I.PutOQB [LIQB, var^.mod*256 + 1]; x^.mode _ sadrMd; x^.off _ var^.cell }}; PutLd: PROC [x: ItemPtr] = { dl: CARDINAL; proc: M2D.ProcPtr; var: M2D.VarPtr _ NARROW[x^.obj^.ext]; IF var^.mod = 0 THEN { dl _ x^.contxt^.lev - var^.lev; IF dl = 0 THEN IF (var^.lev # 0) AND (var^.cell < 16) THEN { x^.opt _ 0; x^.reg _ var^.cell; x^.mode _ regMd } ELSE { M2I.PutLRB [LRI+x^.contxt^.LNK+1, var^.cell]; x^.mode _ stkMd } ELSE { proc _ x^.contxt; IF dl >= 2 THEN { M2I.PutLRB [LRI+x^.contxt^.LNK, 0]; proc _ proc^.pAnc; dl _ dl - 2; WHILE dl # 0 DO M2I.PutOB [RB, 0]; proc _ proc^.pAnc; dl _ dl - 1 ENDLOOP ; M2I.PutOB [RB, f[var^.cell, proc^.pAnc^.LNK]] } ELSE M2I.PutLRB [LRI+x^.contxt^.LNK, f[var^.cell, proc^.pAnc^.LNK]]; x^.mode _ stkMd; IF var^.cell < 16 THEN proc^.impRegs [var^.cell] _ TRUE }} ELSE { M2I.Reloc; M2I.PutOQB [LIQB, var^.mod*256 + 1]; M2I.PutOB [RB, var^.cell]; x^.mode _ stkMd }}; PutCompl: PROC [x: ItemPtr] = { IF x^.mode = conMd THEN LoadStk [x]; IF x^.mode = stkMd THEN M2I.PutRR [RXOR, 1,1,1,0, 12, 6, 12] ELSE -- x^.mode = regMd { M2I.PutRR [RXOR, 1,1,0,0, 15, 6, x^.reg]; x^.mode _ stkMd }}; LoadAdr: PUBLIC PROC [x: ItemPtr] = { SELECT x^.mode FROM typMd => err [104]; procMd, codMd => err [105]; conMd => err [103]; varMd => { var: M2D.VarPtr _ NARROW[x^.obj^.ext]; IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) OR var^.varpar THEN { PutLd [x]; IF x^.mode = regMd THEN x^.mode _ ladrMd ELSE x^.mode _ sadrMd; x^.off _ 0 } ELSE PutLdAdr [x] }; sinxMd => { M2I.PutOI [ADD]; x^.mode _ sadrMd; x^.off _ 0 }; linxMd => { M2I.PutQR [QADD, 0, 0, x^.reg]; x^.mode _ sadrMd; x^.off _ 0 }; sadrMd, ladrMd => {}; regMd, opnMd, stkMd, jmpMd => { err [106]; x^.mode _ sadrMd; x^.off _ 0 } ENDCASE }; LoadAdrStk: PUBLIC PROC [x: ItemPtr] = { LoadAdr [x]; IF x^.mode = ladrMd THEN { M2I.PutLR [LR+x^.reg]; x^.mode _ sadrMd }; IF x^.off # 0 THEN { M2I.PutAdd [x^.off]; x^.off _ 0 }}; Load: PUBLIC PROC [x: ItemPtr] = { dl: CARDINAL; SELECT x^.mode FROM typMd => err [101]; procMd, codMd => err [102]; varMd => { var: M2D.VarPtr _ NARROW[x^.obj^.ext]; PutLd [x]; IF var^.varpar AND (x^.typ^.form # Array) AND (x^.typ^.form # Record) THEN -- regMd -- { M2I.PutLRB [LRI+x^.reg, 0]; x^.mode _ stkMd }}; sinxMd => { IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) THEN M2I.PutOI [ADD] ELSE M2I.PutOI [RX]; x^.mode _ stkMd }; linxMd => { IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) THEN M2I.PutQR [QADD, 0, 0, x^.reg] ELSE M2I.PutQR [QRX, 0, 0, x^.reg]; x^.mode _ stkMd }; sadrMd => { IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) THEN M2I.PutAdd [x^.off] ELSE M2I.PutOB [RB, x^.off]; x^.mode _ stkMd }; ladrMd => { IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) THEN { M2I.PutLR [LR+x^.reg]; M2I.PutAdd [x^.off] } ELSE M2I.PutLRB [LRI+x^.reg, x^.off]; x^.mode _ stkMd }; conMd => IF (x^.typ^.form = String) THEN { SL: CARDINAL = x^.contxt^.LNK; FRX: CARDINAL = SL+1; dl _ x^.contxt^.lev + 1; IF dl >= 2 THEN { M2I.PutLRB [LRI+SL, 0]; dl _ dl - 2; WHILE dl # 0 DO M2I.PutOB [RB, 0]; dl _ dl - 1 ENDLOOP } ELSE IF dl = 1 THEN M2I.PutLR [LR+SL] ELSE M2I.PutLR [LR+FRX]; M2I.PutAdd [x^.val.D0]; x^.mode _ stkMd }; opnMd => { M2I.PutSOp [x^.opr, x^.opt, x^.reg, x^.opt2, x^.reg2]; x^.mode _ stkMd }; regMd, stkMd, jmpMd => {} ENDCASE }; LoadStk: PUBLIC PROC [x: ItemPtr] = { IF x^.mode < regMd THEN Load[x]; IF x^.mode = conMd THEN { M2I.PutLod [x^.val.C]; x^.mode _ stkMd } ELSE IF x^.mode = regMd THEN { IF x^.opt = 0 THEN M2I.PutLR [LR+x^.reg] ELSE M2I.PutOI [LC+x^.reg]; x^.mode _ stkMd }}; GenCFJ: PUBLIC PROC [x: ItemPtr] RETURNS [loc: CARDINAL] = { IF x^.typ^.form = Bool THEN { IF x^.mode < jmpMd THEN { LoadStk [x]; SetJmp [EQ, x, 1, 1] }} ELSE { err [135]; SetJmp [EQ, x, 1, 1] }; loc _ M2I.PutFJ [M2I.inv[x^.rel], x^.opt, x^.reg, x^.Fjmp]; x^.Fjmp _ loc; M2I.FixLink [x^.Tjmp, M2I.pc] }; GenFJ: PUBLIC PROC [loc: CARDINAL] RETURNS [Loc: CARDINAL] = { Loc _ M2I.pc; M2I.PutODB [JDB, loc] }; GenCBJ: PUBLIC PROC [x: ItemPtr, loc: CARDINAL] = { IF x^.typ^.form = Bool THEN { IF x^.mode < jmpMd THEN { LoadStk [x]; SetJmp [EQ, x, 1, 1] }} ELSE { err [135]; SetJmp [EQ, x, 1, 1] }; M2I.PutBJ [M2I.inv[x^.rel], x^.opt, x^.reg, loc]; M2I.FixLink [x^.Fjmp, loc]; M2I.FixLink [x^.Tjmp, M2I.pc] }; GenBJ: PUBLIC PROC [loc: CARDINAL] = { M2I.PutODB [JDB, loc - M2I.pc] }; GenIn: PUBLIC PROC [x, y: ItemPtr] = { f: M2D.StrForm; SRTest [x]; f _ x^.typ^.form; IF ((f >= Bool) AND (f <= Int) OR (f = Enum)) AND (y^.typ^.form = Set) THEN { set: M2D.SetPtr _ NARROW [y^.typ^.ext]; y^.typ _ set^.BaseTyp; IF y^.typ^.form = Range THEN { range: M2D.RangePtr _ NARROW [y^.typ^.ext]; y^.typ _ range^.BaseTyp }; IF x^.typ = y^.typ THEN IF (x^.mode = conMd) AND (y^.mode = conMd) THEN IF x^.val.C < M2D.WordSize THEN x^.val.B _ y^.val.S[x^.val.C] ELSE { x^.val.B _ FALSE; err [202] } ELSE { IF x^.mode = conMd THEN IF x^.val.C < M2D.WordSize THEN { M2I.PutLod [mask[x^.val.C]+1]; x^.mode _ stkMd } ELSE err [202] ELSE -- x^.mode = stkMd { IF y^.mode = stkMd THEN M2I.PutExch; M2I.PutOQB [CALL, MakeBit] }; IF y^.mode = conMd THEN LoadStk [y]; IF y^.mode = stkMd THEN M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] ELSE M2I.PutQR [QAND, y^.opt, 0, y^.reg]; SetJmp [NE, x, 1, 0] } ELSE { err [114]; x^.mode _ stkMd }} ELSE { err [115]; x^.mode _ stkMd }; x^.typ _ M2D.booltyp }; GenNeg: PUBLIC PROC [x: ItemPtr] = { f: M2D.StrForm; SRTest [x]; f _ x^.typ^.form; IF x^.mode = conMd THEN IF (f = Int) OR (f = Card) AND (x^.val.C <= MaxInt) THEN IF x^.val.I >= MinInt THEN { x^.val.I _ - x^.val.C; x^.typ _ M2D.inttyp } ELSE err [201] ELSE IF f = Real THEN x^.val.R _ - x^.val.R ELSE err [112] ELSE { Load [x]; IF f = Int THEN { IF x^.mode = regMd THEN { x^.mode _ opnMd; x^.opr _ RSUB; x^.opt2 _ x^.opt; x^.reg2 _ x^.reg; x^.opt _ 1; x^.reg _ 0 } ELSE M2I.PutRR [RSUB, 1,1,1,0, 12, 0, 12] } ELSE err [112] }}; GenNot: PUBLIC PROC [x: ItemPtr] = { t: CARDINAL; IF x^.typ^.form = Bool THEN IF x^.mode = conMd THEN x^.val.B _ NOT x^.val.B ELSE IF x^.mode = jmpMd THEN { x^.rel _ M2I.inv[x^.rel]; t _ x^.Tjmp; x^.Tjmp _ x^.Fjmp; x^.Fjmp _ t } ELSE { LoadStk [x]; M2I.PutRR [RXOR, 1,1,1,0, 12, 6, 12] } ELSE err [113] }; GenAnd: PUBLIC PROC [x: ItemPtr] = { IF x^.mode = jmpMd THEN { x^.Fjmp _ M2I.PutFJ [M2I.inv[x^.rel], x^.opt, x^.reg, x^.Fjmp]; M2I.FixLink [x^.Tjmp, M2I.pc] } ELSE IF (x^.typ^.form = Bool) AND (x^.mode # conMd) THEN { SetJmp [EQ, x, 1, 1]; x^.Fjmp _ M2I.PutFJ [M2I.inv[x^.rel], x^.opt, x^.reg, x^.Fjmp]; M2I.FixLink [x^.Tjmp, M2I.pc] } ELSE IF x^.typ^.form # Bool THEN { err [122]; x^.mode _ conMd; x^.typ _ M2D.booltyp; x^.val.B _ FALSE }}; GenOr: PUBLIC PROC [x: ItemPtr] = { IF x^.mode = jmpMd THEN { x^.Tjmp _ M2I.PutFJ [x^.rel, x^.opt, x^.reg, x^.Tjmp]; M2I.FixLink [x^.Fjmp, M2I.pc] } ELSE IF (x^.typ^.form = Bool) AND (x^.mode # conMd) THEN { SetJmp [EQ, x, 1, 1]; x^.Tjmp _ M2I.PutFJ [x^.rel, x^.opt, x^.reg, x^.Tjmp]; M2I.FixLink [x^.Fjmp, M2I.pc] } ELSE IF x^.typ^.form # Bool THEN { err [122]; x^.mode _ conMd; x^.typ _ M2D.booltyp; x^.val.B _ TRUE }}; ExecOp: PUBLIC PROC [op: M2S.Symbol, x, y: ItemPtr] = { f: M2D.StrForm _ x^.typ^.form; SELECT op FROM times => { IF f = Card THEN IF y^.val.C <= MaxCard/x^.val.C THEN x^.val.C _ x^.val.C * y^.val.C ELSE err [203] ELSE IF f = Int THEN IF ABS[y^.val.I] <= MaxInt / ABS[x^.val.I] THEN x^.val.I _ x^.val.I * y^.val.I ELSE err [203] ELSE IF f = Real THEN IF (ABS[x^.val.R] <= 1.0) OR (ABS[y^.val.R] <= MaxReal/ABS[x^.val.R]) THEN x^.val.R _ x^.val.R * y^.val.R ELSE err [203] ELSE IF f = Set THEN x^.val.S _ M2D.INTERSECTION [x^.val.S, y^.val.S] ELSE err [118] }; slash, div => { IF f = Card THEN IF y^.val.C > 0 THEN x^.val.C _ x^.val.C / y^.val.C ELSE err [205] ELSE IF f = Int THEN IF y^.val.I # 0 THEN x^.val.I _ x^.val.I / y^.val.I ELSE err [205] ELSE IF (f = Real) AND (op = slash) THEN IF (y^.val.R >= 1.0) OR (ABS[x^.val.R] <= MaxReal * ABS[y^.val.R]) THEN x^.val.R _ x^.val.R / y^.val.R ELSE err [204] ELSE IF (f = Set) AND (op = slash) THEN x^.val.S _ M2D.SYMMDIFF [x^.val.S, y^.val.S] ELSE err [120] }; div, rem => { IF f = Card THEN IF y^.val.C > 0 THEN x^.val.C _ x^.val.C MOD y^.val.C ELSE err [205] ELSE IF f = Int THEN IF (x^.val.I >= 0) AND (y^.val.I > 0) THEN x^.val.I _ x^.val.I MOD y^.val.I ELSE err [205] ELSE err [121] }; and => { IF f = Bool THEN x^.val.B _ x^.val.B AND y^.val.B ELSE err [122] }; plus => { IF f = Card THEN IF y^.val.C <= MaxCard - x^.val.C THEN x^.val.C _ x^.val.C + y^.val.C ELSE err [206] ELSE IF f = Int THEN IF (x^.val.I >= 0) AND (y^.val.I <= MaxInt - x^.val.I) OR (x^.val.I < 0) AND (y^.val.I >= MinInt - x^.val.I) THEN x^.val.I _ x^.val.I + y^.val.I ELSE err [206] ELSE IF f = Real THEN IF (x^.val.R >= 0.0) AND (y^.val.R <= MaxReal - x^.val.R) OR (x^.val.R < 0) AND (y^.val.R >= MinReal - x^.val.R) THEN x^.val.R _ x^.val.R + y^.val.R ELSE err [206] ELSE IF f = Set THEN x^.val.S _ M2D.UNION [x^.val.S, y^.val.S] ELSE err [123] }; minus => { IF f = Card THEN IF y^.val.C <= x^.val.C THEN x^.val.C _ x^.val.C - y^.val.C ELSE IF y^.val.C - x^.val.C <= MaxInt THEN { x^.val.I _ -(y^.val.C - x^.val.C); x^.typ _ M2D.inttyp } ELSE err [207] ELSE IF f = Int THEN IF (x^.val.I >= 0) AND ((y^.val.I >= 0) OR (x^.val.I <= MaxInt + y^.val.I)) OR (x^.val.I < 0) AND ((y^.val.I < 0) OR (x^.val.I >= MinInt + y^.val.I)) THEN x^.val.I _ x^.val.I - y^.val.I ELSE err [207] ELSE IF f = Real THEN IF (x^.val.R >= 0.0) AND ((y^.val.R >= 0.0) OR (x^.val.R <= MaxReal + y^.val.R)) THEN x^.val.R _ x^.val.R - y^.val.R ELSE IF (x^.val.R < 0.0) AND ((y^.val.R < 0.0) OR (x^.val.R >= MinReal + y^.val.R)) THEN x^.val.R _ x^.val.R - y^.val.R ELSE err [207] ELSE IF f = Set THEN x^.val.S _ M2D.SETDIFF [x^.val.S, y^.val.S] ELSE err [124] }; or => { IF f = Bool THEN x^.val.B _ x^.val.B OR y^.val.B ELSE err [125] }; eql => { IF f = Card THEN x^.val.B _ x^.val.C = y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I = y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R = y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B = y^.val.B ELSE IF f = Set THEN x^.val.B _ x^.val.S = y^.val.S ELSE IF f = Char THEN x^.val.B _ x^.val.Ch = y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp }; neq => { IF f = Card THEN x^.val.B _ x^.val.C # y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I # y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R # y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B # y^.val.B ELSE IF f = Set THEN x^.val.B _ x^.val.S # y^.val.S ELSE IF f = Char THEN x^.val.B _ x^.val.Ch # y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp }; lss => { IF f = Card THEN x^.val.B _ x^.val.C < y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I < y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R < y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B < y^.val.B ELSE IF f = Set THEN IF x^.val.S = y^.val.S THEN x^.val.B _ FALSE ELSE x^.val.B _ M2D.SUBSET [x^.val.S, y^.val.S] ELSE IF f = Char THEN x^.val.B _ x^.val.Ch < y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp }; leq => { IF f = Card THEN x^.val.B _ x^.val.C <= y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I <= y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R <= y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B <= y^.val.B ELSE IF f = Set THEN x^.val.B _ M2D.SUBSET [x^.val.S, y^.val.S] ELSE IF f = Char THEN x^.val.B _ x^.val.Ch <= y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp }; gtr => { IF f = Card THEN x^.val.B _ x^.val.C > y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I > y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R > y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B > y^.val.B ELSE IF f = Set THEN IF x^.val.S = y^.val.S THEN x^.val.B _ FALSE ELSE x^.val.B _ M2D.SUBSET [y^.val.S, x^.val.S] ELSE IF f = Char THEN x^.val.B _ x^.val.Ch > y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp }; geq => { IF f = Card THEN x^.val.B _ x^.val.C >= y^.val.C ELSE IF f = Int THEN x^.val.B _ x^.val.I >= y^.val.I ELSE IF f = Real THEN x^.val.B _ x^.val.R >= y^.val.R ELSE IF f = Bool THEN x^.val.B _ x^.val.B >= y^.val.B ELSE IF f = Set THEN x^.val.B _ M2D.SUBSET [y^.val.S, x^.val.S] ELSE IF f = Char THEN x^.val.B _ x^.val.Ch >= y^.val.Ch ELSE err [126]; x^.typ _ M2D.booltyp } ENDCASE }; GenOp: PUBLIC PROC [op: M2S.Symbol, x, y: ItemPtr] = <> { f, g: M2D.StrForm; SRTest [x]; SRTest [y]; f _ x^.typ^.form; IF x^.typ # y^.typ THEN { g _ y^.typ^.form; IF (f = Int) AND (g = Card) THEN IF (y^.mode = conMd) AND (y^.val.C <= MaxInt) THEN { y^.typ _ x^.typ; g _ Int } ELSE IF (x^.mode = conMd) AND (x^.val.I >= 0) THEN { x^.typ _ y^.typ; f _ Card } ELSE IF (f = Card) AND (g = Int) THEN IF (x^.mode = conMd) AND (x^.val.C <= MaxInt) THEN { x^.typ _ y^.typ; f _ Int } ELSE IF (y^.mode = conMd) AND (y^.val.I >= 0) THEN { y^.typ _ x^.typ; g _ Card } ELSE IF (x^.typ = M2D.addrtyp) AND (g = Pointer) THEN f _ Pointer ELSE IF ((f # Pointer) OR (y^.typ # M2D.addrtyp)) AND ((f # Card) OR (g # Card)) THEN err [117] }; IF (x^.mode = conMd) AND (y^.mode = conMd) THEN ExecOp [op, x, y] ELSE SELECT op FROM times => { IF (f = Card) OR (f = Int) THEN { IF (x^.mode = conMd) AND (clog[x^.val.C] = 1) OR (y^.mode = conMd) AND (clog[y^.val.C] = 1) THEN M2I.PutODB [SHL, 32*64+exp] ELSE IF x^.mode = conMd THEN { LoadStk [x]; M2I.PutOQB [CALL, Mult] } ELSE IF y^.mode = conMd THEN { LoadStk [y]; M2I.PutOQB [CALL, Mult] } ELSE M2I.PutOQB [CALL, Mult]; x^.mode _ stkMd } ELSE IF f = Double THEN err [216] ELSE IF f = Set THEN { IF x^.mode = conMd THEN LoadStk [x] ELSE IF y^.mode = conMd THEN LoadStk [y]; SetOpn [RAND, x, y] } ELSE IF f = Real THEN { LoadStk [y]; LoadStk [x]; M2I.PutOQB [CALL, RealMult] } ELSE IF f # Undef THEN err [118] }; slash => { IF f = Set THEN { IF x^.mode = conMd THEN LoadStk [x] ELSE IF y^.mode = conMd THEN LoadStk [y]; SetOpn [RXOR, x, y] } ELSE IF f = Real THEN { LoadStk [y]; IF x^.mode # stkMd THEN { LoadStk [x]; M2I.PutExch }; M2I.PutOQB [CALL, RealDiv] } ELSE err [119] }; div => { IF (f = Card) OR (f = Int) THEN { IF (y^.mode = conMd) AND (clog[y^.val.C] = 1) THEN M2I.PutODB [SHR, 32*64+exp] ELSE IF x^.mode = conMd THEN { LoadStk [x]; M2I.PutOQB [CALL, Div] } ELSE IF y^.mode = conMd THEN { LoadStk [y]; M2I.PutOQB [CALL, Div] } ELSE M2I.PutOQB [CALL, Div]; x^.mode _ stkMd } ELSE IF f = Double THEN err [216] ELSE IF f # Undef THEN err [120] }; mod, rem => { IF (f = Card) OR (f = Int) THEN { IF (y^.mode = conMd) AND (clog[y^.val.C] = 1) THEN { M2I.PutLod [mask[exp]]; M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] } ELSE IF x^.mode = conMd THEN { LoadStk [x]; M2I.PutOQB [CALL, Mod] } ELSE IF y^.mode = conMd THEN { LoadStk [y]; M2I.PutOQB [CALL, Mod] } ELSE M2I.PutOQB [CALL, Mod]; x^.mode _ stkMd } ELSE IF f # Undef THEN err [121] }; and => { IF f = Bool THEN IF x^.mode = conMd THEN { IF y^.mode < jmpMd THEN SetJmp [EQ, y, 1, 1]; IF NOT x^.val.B THEN { x^.rel _ false; x^.Fjmp _ M2I.MergedLinks [y^.Fjmp, y^.Tjmp]; x^.Tjmp _ 0 } ELSE x _ y } ELSE IF y^.mode = conMd THEN { IF NOT y^.val.B THEN { IF y^.Fjmp # 0 THEN x^.Fjmp _ M2I.MergedLinks [x^.Fjmp, y^.Fjmp]; x^.rel _ false; x^.Tjmp _ y^.Tjmp }} ELSE { IF y^.mode < jmpMd THEN SetJmp [EQ, y, 1, 1]; IF y^.Fjmp # 0 THEN x^.Fjmp _ M2I.MergedLinks [x^.Fjmp, y^.Fjmp]; x^.rel _ y^.rel; x^.opt _ y^.opt; x^.reg _ y^.reg; x^.Tjmp _ y^.Tjmp } ELSE IF f # Undef THEN { err [122]; SetJmp [true, x, 0, 0] }}; plus => { IF (f = Card) OR (f = Int) THEN IF (x^.mode = conMd) AND (x^.val.C >= 5) OR (y^.mode = conMd) AND (y^.val.C >= 5) THEN IF x^.mode = conMd THEN IF y^.mode = stkMd THEN { M2I.PutAdd [x^.val.I]; x^.mode _ stkMd } ELSE { LoadStk [x]; SetOpn [RADD, x, y] } ELSE IF x^.mode = stkMd THEN { M2I.PutAdd [y^.val.I]; x^.mode _ stkMd } ELSE { LoadStk [y]; SetOpn [RADD, x, y] } ELSE SetOpn [RADD, x, y] ELSE IF f = Set THEN { IF x^.mode = conMd THEN LoadStk [x] ELSE IF y^.mode = conMd THEN LoadStk [y]; SetOpn [ROR, x, y] } ELSE IF f = Real THEN { LoadStk [y]; LoadStk [x]; M2I.PutOQB [CALL, RealAdd] } ELSE IF f # Undef THEN err [123] }; minus => { IF (f = Card) OR (f = Int) THEN IF (x^.mode = conMd) AND (x^.val.C >= 5) OR (y^.mode = conMd) AND (y^.val.C >= 5) THEN IF x^.mode = conMd THEN { LoadStk [x]; IF y^.mode = stkMd THEN M2I.PutExch; SetOpn [RSUB, x, y] } ELSE IF x^.mode = stkMd THEN { M2I.PutSub [y^.val.I]; x^.mode _ stkMd } ELSE { LoadStk [y]; SetOpn [RSUB, x, y] } ELSE SetOpn [RSUB, x, y] ELSE IF f = Set THEN { PutCompl [y]; IF x^.mode = conMd THEN LoadStk [x]; SetOpn [RAND, x, y] } ELSE IF f = Real THEN { LoadStk [y]; IF x^.mode # stkMd THEN { LoadStk [x]; M2I.PutExch }; M2I.PutOQB [CALL, RealSub] } ELSE IF f # Undef THEN err [123] }; or => { IF f = Bool THEN IF x^.mode = conMd THEN { IF y^.mode < jmpMd THEN SetJmp [EQ, y, 1, 1]; IF x^.val.B THEN { x^.rel _ true; x^.Tjmp _ M2I.MergedLinks [y^.Tjmp, y^.Fjmp]; x^.Fjmp _ 0 } ELSE x _ y } ELSE IF y^.mode = conMd THEN { IF y^.val.B THEN { IF y^.Tjmp # 0 THEN x^.Tjmp _ M2I.MergedLinks [x^.Tjmp, y^.Tjmp]; x^.rel _ true; x^.Fjmp _ y^.Fjmp }} ELSE { IF y^.mode < jmpMd THEN SetJmp [EQ, y, 1, 1]; IF y^.Tjmp # 0 THEN x^.Tjmp _ M2I.MergedLinks [x^.Tjmp, y^.Tjmp]; x^.rel _ y^.rel; x^.opt _ y^.opt; x^.reg _ y^.reg; x^.Fjmp _ y^.Fjmp } ELSE IF f # Undef THEN { err [123]; SetJmp [true, x, 0, 0] }}; eql => { PrepJmp [EQ, EQ, x, y]; IF (f > Int) AND (f # Enum) AND (f # Pointer) AND (f # Set) AND (f # Opaque) AND (f # Real) AND (f # Double) THEN err [126] }; neq => { PrepJmp [NE, NE, x, y]; IF (f > Int) AND (f # Enum) AND (f # Pointer) AND (f # Set) AND (f # Opaque) AND (f # Real) AND (f # Double) THEN err [126] }; lss => { IF (f < Bool) OR (f > LongReal) AND (f # Enum) THEN err [126]; PrepJmp [LS, GT, x, y] }; gtr => { IF (f < Bool) OR (f > LongReal) AND (f # Enum) THEN err [126]; PrepJmp [GT, LS, x, y] }; leq => { IF (f >= Bool) AND (f <= LongReal) OR (f = Enum) THEN PrepJmp [LE, GE, x, y] ELSE IF f = Set THEN { PutCompl [y]; IF x^.mode = conMd THEN LoadStk [x]; IF x^.mode = stkMd THEN M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] ELSE --regMd-- M2I.PutRR [RAND, 1, 0, 1, 0, 12, x^.reg, 12]; SetJmp [EQ, x, 1, 0] } ELSE err [126]; x^.typ _ M2D.booltyp }; geq => { IF (f >= Bool) AND (f <= LongReal) OR (f = Enum) THEN PrepJmp [GE, LE, x, y] ELSE IF f = Set THEN IF x^.mode = conMd THEN { PutCompl [x]; IF y^.mode = conMd THEN LoadStk [y]; IF y^.mode = stkMd THEN M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] ELSE --regMd-- M2I.PutRR [RAND, 1, 0, 1, 0, 12, y^.reg, 12]; SetJmp [EQ, x, 1, 0] } ELSE { PutCompl [y]; IF x^.mode = conMd THEN LoadStk [x]; IF x^.mode = stkMd THEN M2I.PutRR [ROR, 1, 1, 1, 0, 13, 14, 13] ELSE --regMd-- M2I.PutRR [ROR, 1, 0, 1, 0, 12, x^.reg, 12]; SetJmp [EQ, x, 1, 6] } ELSE err [126]; x^.typ _ M2D.booltyp } ENDCASE }; END.