[Indigo]<Dragon>Modula>M2HImpl.mesa!1

FILE: M2HImpl.mesa

Modula-2 Code-Generator, Part 3

Last Edited by: Gutknecht, September 20, 1985 1:11:00 pm PDT

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] =

x and y loaded in right order (if necessary on stack, constants may be in conMd)

{ 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.