[_CD4_]<dragon>Modula>M2GImpl.mesa!2

FILE: M2GImpl.mesa

Modula-2 Code-Generator Part 1

Last Edited by: Gutknecht, September 20, 1985 11:33:54 pm PDT

Satterthwaite December 12, 1985 10:43:28 am PST

DIRECTORY

M2D: TYPE USING [WordSize, StrForm, ObjPtr, HeaderPtr, ConstPtr, TypPtr, VarPtr, FieldPtr, ProcPtr, EnumPtr, ModulePtr, StrPtr, RangePtr, SetPtr, PointerPtr, ArrayPtr, ProcTypPtr, PDPtr, CDPtr, ParPtr, mainmod, undftyp, notyp, inttyp, cardtyp, realtyp, dbltyp, booltyp, chartyp, wordtyp, bitstyp, addrtyp, lrltyp, SET, UNION, INTERSECTION, SETDIFF, SYMMDIFF, SUBSET],

M2G: TYPE USING [ItemPtr, Item, LabelRange, LabelTabPtr],

M2I: TYPE USING [Relation, inv, pc, Reloc, PutOI, PutOB, PutODB, PutOQB, PutRR, PutQR, PutLR, PutLRB, PutLRRB, PutJBB, PutRJB, PutExch, PutLod, PutAdd, PutSub, PutBJ, PutFJ, PutROp, PutSOp, FixByte, FixLong, FixJmp, FixLink, MergedLinks],

M2S: TYPE USING [Symbol, Mark];

M2GImpl : CEDAR PROGRAM

IMPORTS M2D, M2I, M2S

EXPORTS M2G =

BEGIN OPEN M2G;

DFC: CARDINAL = 61B; LIQB: CARDINAL = 62B; J5: CARDINAL = 66B; CALL: CARDINAL = 70B; RX: CARDINAL = 102B; BC: CARDINAL = 103B; ADD: CARDINAL = 104B; SUB: CARDINAL = 105B; DUP: CARDINAL = 110B; DIS: CARDINAL = 111B; EXDIS: CARDINAL = 113B; SFC: CARDINAL = 114B; RETN: CARDINAL = 116B; J1: CARDINAL = 126B; SJ: CARDINAL = 127B; LC: CARDINAL = 130B; LR: CARDINAL = 140B; SR: CARDINAL = 160B; QOR: CARDINAL = 200B; QAND: CARDINAL = 201B; QRX: CARDINAL = 202B; QADD: CARDINAL = 204B; QSUB: CARDINAL = 205B; ALS: CARDINAL = 210B; AS: CARDINAL = 213B; CST: CARDINAL = 214B; RET: CARDINAL = 216B; LIB: CARDINAL = 222B; ADDB: CARDINAL = 224B; J2: CARDINAL = 226B; RB: CARDINAL = 230B; RSB: CARDINAL = 232B; WSB: CARDINAL = 233B; LRI: CARDINAL = 240B; SRI: CARDINAL = 260B; ROR: CARDINAL = 300B; RAND: CARDINAL = 301B; RADD: CARDINAL = 304B; RSUB: CARDINAL = 305B; RXOR: CARDINAL = 310B; RFU: CARDINAL = 312B; LFC: CARDINAL = 321B; LIDB: CARDINAL = 322B; LIPC: CARDINAL = 323B; J3: CARDINAL = 326B; JDB: CARDINAL = 327B; RRI: CARDINAL = 332B; WRI: CARDINAL = 333B; RJLB: CARDINAL = 342B; RJLEB: CARDINAL = 343B; RJGEB: CARDINAL = 346B; RJGB: CARDINAL = 347B; JEBB: CARDINAL = 360B; SHL: CARDINAL = 370B; SHR: CARDINAL = 371B; FSDB: CARDINAL = 373B;

Trap: CARDINAL = 0; Move: CARDINAL = 1; Mult: CARDINAL = 2; Div: CARDINAL = 3; Mod: CARDINAL = 4; RealAdd: CARDINAL = 5; RealSub: CARDINAL = 6; RealMult: CARDINAL = 7; RealDiv: CARDINAL = 8; Alloc: CARDINAL = 9; Dealloc: CARDINAL = 10; MakeBit: CARDINAL = 11; MakeBits: CARDINAL = 12;

utilities

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] };

SRTest: PROC [x: ItemPtr] =

{ WITH x^.typ SELECT FROM

range: M2D.RangePtr => x^.typ ← range^.BaseTyp;

ENDCASE };

statements

PutStore: PROC [x, y: ItemPtr] =

{ IF x^.mode = regMd THEN

IF y^.mode = opnMd THEN M2I.PutROp [y^.opr, x^.reg, y^.opt, y^.reg, y^.opt2, y^.reg2]

ELSE { LoadStk [y]; M2I.PutLR [SR+x^.reg] }

ELSE { LoadStk [y];

IF x^.mode = ladrMd THEN M2I.PutLRB [SRI+x^.reg, x^.off]

ELSE IF x^.mode = sadrMd THEN M2I.PutOB [WSB, x^.off]

ELSE IF x^.mode # stkMd THEN err [300] }};

GenItem: PUBLIC PROC [x: ItemPtr, y: M2D.ObjPtr, Scope: M2D.HeaderPtr] =

{ IF y # NIL THEN { x^.typ ← y^.typ;

WITH y SELECT FROM

const: M2D.ConstPtr => {

x^.mode ← conMd;

x^.val.D0 ← const^.conval.D0; x^.val.D1 ← const^.conval.D1;

x^.val.D2 ← const^.conval.D2; x^.val.D3 ← const^.conval.D3 };

typ: M2D.TypPtr => { x^.mode ← typMd };

var: M2D.VarPtr => { x^.mode ← varMd; x^.obj ← y };

field: M2D.FieldPtr => {

IF (x^.contxt^.lev # 0) AND (Scope^.cell < 16) THEN

{ x^.mode ← ladrMd; x^.reg ← Scope^.cell }

ELSE { M2I.PutLRB [LRI+x^.contxt^.LNK+1, Scope^.cell];

x^.mode ← sadrMd };

x^.off ← field^.offset };

proc: M2D.ProcPtr => {

x^.mode ← (IF proc^.bd^.form = Block THEN procMd ELSE codMd);

x^.obj ← y; x^.typ ← M2D.undftyp };

mod: M2D.ModulePtr => { x^.mode ← stkMd; err [107] }

ENDCASE }

ELSE { err [50]; x^.typ ← M2D.undftyp; x^.mode ← stkMd }};

GenIndex: PUBLIC PROC [x, y: ItemPtr] =

{ SRTest [y]; -- (x^.mode = ladrMd) OR (x^.mode = sadrMd)

WITH x^.typ SELECT FROM

array: M2D.ArrayPtr => {

eltyp: M2D.StrPtr = array^.ElemTyp;

IF array^.dyn THEN { LoadStk [y];

IF (y^.typ # M2D.cardtyp) AND (y^.typ # M2D.inttyp) THEN err [109];

IF rngchk THEN

{ var: M2D.VarPtr = NARROW [x^.obj];

M2I.PutLR [LR+var^.cell+1]; M2I.PutOI [BC] };

IF x^.mode = sadrMd THEN x^.mode ← sinxMd ELSE x^.mode ← linxMd }

ELSE

{ range: M2D.RangePtr = NARROW [array^.IndexTyp];

inxtyp: M2D.StrPtr ← range^.BaseTyp;

m: INTEGER = range^.min; n: INTEGER = range^.max;

IF y^.mode = conMd THEN { sz: CARDINAL; i: INTEGER ← y^.val.I;

IF inxtyp # y^.typ THEN

IF (i < 0) OR (inxtyp = M2D.cardtyp) AND (y^.typ # M2D.inttyp) OR (inxtyp = M2D.inttyp) AND (y^.typ # M2D.cardtyp) THEN err [109];

IF (m <= i) AND (i <= n) THEN i ← i - m ELSE { err [108]; i ← 0 };

sz ← eltyp^.size * i;

IF eltyp^.form = Char THEN {};

IF x^.off + sz < 256 THEN x^.off ← x^.off + sz

ELSE { M2I.PutLod [x^.off + sz];

IF x^.mode = sadrMd THEN x^.mode ← sinxMd ELSE x^.mode ← linxMd }}

ELSE { LoadStk [y];

IF (inxtyp # y^.typ) AND ((inxtyp # M2D.cardtyp) OR (y^.typ # M2D.inttyp)) AND ((inxtyp # M2D.inttyp) OR (y^.typ # M2D.cardtyp)) THEN { err [109] };

IF m # 0 THEN M2I.PutSub [m];

IF rngchk THEN { M2I.PutLod [n+1-m]; M2I.PutOI [BC] };

IF eltyp^.size # 1 THEN

IF clog [eltyp^.size] = 1 THEN M2I.PutODB [SHL, 32*64+exp]

ELSE { M2I.PutLod [eltyp^.size]; M2I.PutOQB [CALL, Mult] };

IF x^.mode = sadrMd THEN x^.mode ← sinxMd ELSE x^.mode ← linxMd }};

x^.typ ← eltyp };

ENDCASE => err [109] };

GenField: PUBLIC PROC [x: ItemPtr, f: M2D.ObjPtr] =

{ -- x^.typ^.form = Record --

WITH f SELECT FROM

field: M2D.FieldPtr => {

LoadAdr [x];

IF x^.off + field^.offset < 256 THEN x^.off ← x^.off + field^.offset

ELSE { M2I.PutLod [x^.off + field^.offset];

IF x^.mode = sadrMd THEN M2I.PutOI [ADD]

ELSE { M2I.PutQR [QADD, 0, 0, x^.reg]; x^.mode ← sadrMd };

x^.off ← 0 };

x^.typ ← f^.typ };

const: M2D.ConstPtr => {

x^.mode ← conMd; x^.typ ← f^.typ;

x^.val.D0 ← const^.conval.D0; x^.val.D1 ← const^.conval.D1;

x^.val.D2 ← const^.conval.D2; x^.val.D3 ← const^.conval.D3 };

ENDCASE => { err [110];

x^.typ ← M2D.undftyp; x^.mode ← sadrMd; x^.off ← 0 }};

GenDeRef: PUBLIC PROC [x: ItemPtr] =

{ WITH x^.typ SELECT FROM

pointer: M2D.PointerPtr => { Load [x]; x^.typ ← pointer^.BaseTyp };

ENDCASE =>

IF x^.typ = M2D.addrtyp THEN { Load [x]; x^.typ ← M2D.wordtyp }

ELSE err [111];

IF x^.mode = regMd THEN x^.mode ← ladrMd ELSE x^.mode ← sadrMd;

x^.off ← 0 };

GenSingSet: PUBLIC PROC [x, e: ItemPtr] =

{ -- x^.typ^.form = Set

set: M2D.SetPtr = NARROW [x^.typ];

s: M2D.StrPtr ← set^.BaseTyp;

x^.mode ← stkMd; SRTest [e];

IF s^.form = Range THEN

{ range: M2D.RangePtr = NARROW [s]; s ← range^.BaseTyp };

IF e^.typ = s THEN

IF e^.mode = conMd THEN

{ x^.mode ← conMd; x^.val.S ← ALL [FALSE];

IF e^.val.C < M2D.WordSize THEN x^.val.S [e^.val.C] ← TRUE

ELSE err [202] }

ELSE { LoadStk [e]; M2I.PutOQB [CALL, MakeBit] }

ELSE err [116] };

GenSet: PUBLIC PROC [x, e1, e2: ItemPtr] =

{ -- x^.typ^.form = Set

set: M2D.SetPtr = NARROW [x^.typ];

s: M2D.StrPtr ← set^.BaseTyp;

x^.mode ← stkMd; SRTest [e1]; SRTest [e2];

IF s^.form = Range THEN

{ range: M2D.RangePtr = NARROW [s]; s ← range^.BaseTyp };

IF (e1^.typ = s) AND (e2^.typ = s) THEN

IF (e1^.mode = conMd) AND (e2^.mode = conMd) THEN

{ x^.mode ← conMd; x^.val.S ← ALL [FALSE];

IF (e1^.val.C <= e2^.val.C) AND (e2^.val.C < M2D.WordSize) THEN

{ i: CARDINAL ← e1^.val.C;

DO x^.val.S [i] ← TRUE;

IF i = e2^.val.C THEN EXIT;

i ← i + 1

ENDLOOP }

ELSE err [202] }

ELSE { LoadStk [e1]; LoadStk [e2]; M2I.PutOQB [CALL, MakeBits];

LoadStk [x]; M2I.PutRR [ROR, 1, 1, 1, 0, 13, 14, 13] }

ELSE err [116] };

MoveDyn: PROC [x, y: ItemPtr] =

{ var: M2D.VarPtr = NARROW [x^.obj];

xarray: M2D.ArrayPtr = NARROW [x^.typ];

LoadStk [y]; M2I.PutLR [LR+var^.cell+1];

IF xarray^.ElemTyp^.size # 1 THEN

{ M2I.PutLod [xarray^.ElemTyp^.size]; M2I.PutOQB [CALL, Mult] };

M2I.PutOQB [CALL, Move] };

PrepAss: PUBLIC PROC [x: ItemPtr] =

{ IF (x^.mode = conMd) OR (x^.mode = procMd) THEN err [142];

IF (x^.typ^.form = Array) OR (x^.typ^.form = Record) THEN LoadAdrStk [x]

ELSE

{ IF x^.mode = varMd THEN

{ var: M2D.VarPtr = NARROW [x^.obj];

IF (x^.contxt^.lev = var^.lev) AND (var^.lev # 0) AND (var^.cell < 16) AND NOT var^.varpar THEN { x^.opt ← 0; x^.reg ← var^.cell; x^.mode ← regMd }

ELSE LoadAdr [x] }

ELSE IF x^.mode = linxMd THEN

{ M2I.PutQR [QADD, 0, 0, x^.reg]; x^.mode ← sadrMd; x^.off ← 0 }

ELSE IF x^.mode = sinxMd THEN

{ M2I.PutOI [ADD]; x^.mode ← sadrMd; x^.off ← 0 }}};

GenAssign: PUBLIC PROC [x, y: ItemPtr] =

{ f: M2D.StrForm ← x^.typ^.form; g: M2D.StrForm ← y^.typ^.form;

xp, yp: M2D.ParPtr; s, vsz: INTEGER;

SRTest [y];

IF f = Range THEN

{ range: M2D.RangePtr = NARROW [x^.typ];

IF rngchk THEN

IF y^.mode = conMd THEN

{ IF (y^.val.I < range^.min) OR (y^.val.I > range^.max) THEN err [138] }

ELSE { IF x^.mode # stkMd THEN LoadStk [x];

IF range^.min = 0 THEN { M2I.PutLod [range^.max+1]; M2I.PutOI [BC] }

ELSE { M2I.PutOI [DUP]; M2I.PutSub [range^.min] };

M2I.PutLod [range^.max+1-range^.min]; M2I.PutOI [BC]; M2I.PutOI [DIS] };

x^.typ ← range^.BaseTyp };

SELECT f FROM

Undef => IF (x^.typ = M2D.wordtyp) AND (y^.typ^.size = 1) THEN PutStore [x, y]

ELSE err [133];

Bool => IF y^.mode = jmpMd THEN { [] ← GenCFJ [y];

M2I.PutOI [LC+1]; M2I.PutODB [JDB, 4];

M2I.FixLink [y^.Fjmp, M2I.pc]; M2I.PutOI [LC+0];

PutStore [x, y] }

ELSE IF g = Bool THEN PutStore [x, y]

ELSE err [133];

Char => IF g = Char THEN PutStore [x, y] ELSE err [133];

Card => IF (g = Card) OR (g = Double) THEN PutStore [x, y]

ELSE IF g = Int THEN

{ IF y^.mode = conMd THEN { IF y^.val.I < 0 THEN err [132] }

ELSE LoadStk [y]; -- emit check

PutStore [x, y] }

ELSE err [133];

Int => IF (g = Int) OR (g = Double) THEN

IF (y^.mode = opnMd) AND (x^.mode = regMd) THEN

M2I.PutRR [y^.opr, x^.opt, y^.opt, y^.opt2, 0, x^.reg, y^.reg, y^.reg2]

ELSE PutStore [x, y]

ELSE IF g = Card THEN

{ IF y^.mode = conMd THEN { IF y^.val.C > MaxInt THEN err [208] }

ELSE LoadStk [y]; -- emit check --

PutStore [x, y] }

ELSE err [133];

Double => IF (g = Double) OR (g = Int) OR (g = Card) OR

(x^.typ = M2D.addrtyp) AND (g = Pointer) THEN PutStore [x, y]

ELSE err [133];

Real => IF (g = Real) OR (g = LongReal) THEN PutStore [x, y]

ELSE err [133];

LongReal => IF (g = Real) OR (g = LongReal) THEN PutStore [x, y]

ELSE err [133];

Enum => IF x^.typ = y^.typ THEN PutStore [x, y]

ELSE err [133];

Range => {};

Pointer, Opaque => IF (x^.typ = y^.typ) OR (y^.typ = M2D.addrtyp) THEN

PutStore [x, y]

ELSE err [133];

Set => IF x^.typ = y^.typ THEN PutStore [x, y]

ELSE err [133];

Array => { xarray: M2D.ArrayPtr = NARROW [x^.typ];

IF xarray^.dyn THEN { var: M2D.VarPtr = NARROW [x^.obj];

IF y^.typ^.form = Array THEN

{ yarray: M2D.ArrayPtr = NARROW [y^.typ];

IF (yarray^.ElemTyp = xarray^.ElemTyp) OR

(xarray^.ElemTyp = M2D.wordtyp) AND

(yarray^.ElemTyp^.size = 1) THEN MoveDyn [x, y]

ELSE err [133] }

ELSE IF (xarray^.ElemTyp = M2D.chartyp) AND (g = String) THEN

MoveDyn [x, y]

ELSE err [133] }

ELSE IF x^.typ = y^.typ THEN { LoadStk [y];

M2I.PutLod [x^.typ^.size]; M2I.PutOQB [CALL, Move] }

ELSE IF (xarray^.ElemTyp = M2D.chartyp) THEN

IF g = String THEN

{ range: M2D.RangePtr = NARROW [xarray^.IndexTyp];

LoadStk [y];

s ← y^.val.D1; -- check length --

vsz ← range^.max - range^.min + 1;

IF s < vsz THEN s ← s + 1 ELSE IF s > vsz THEN err [146];

M2I.PutLod [s]; M2I.PutOQB [CALL, Move] }

ELSE IF g = Char THEN err [200]

ELSE err [133]

ELSE err [133] };

Record => IF x^.typ = y^.typ THEN { LoadStk [y];

IF x^.mode = sadrMd THEN

{ M2I.PutLod [x^.typ^.size]; M2I.PutOQB [CALL, Move] }}

ELSE err [133];

ProcTyp => IF y^.mode = procMd THEN

{ -- procedure to proc. variable; check compatibility

xproc: M2D.ProcTypPtr = NARROW [x^.typ];

yproc: M2D.ProcPtr = NARROW [y^.obj];

ypd: M2D.PDPtr = NARROW [yproc^.bd];

IF ypd^.lev # 1 THEN err [127]

ELSE IF xproc^.resTyp # y^.obj^.typ THEN err [128]

ELSE { xp ← xproc^.firstPar; yp ← yproc^.firstParam;

WHILE xp # NIL DO

IF yp # NIL THEN

{ IF (xp^.varpar) # (yp^.varpar) THEN err [129]

ELSE IF xp^.typ # yp^.typ THEN

IF (xp^.typ^.form # Array) OR

(yp^.typ^.form # Array) THEN err [129]

ELSE

{ xarray: M2D.ArrayPtr = NARROW [xp^.typ];

yarray: M2D.ArrayPtr = NARROW [yp^.typ];

IF NOT xarray^.dyn OR NOT yarray^.dyn OR

(xarray^.ElemTyp # yarray^.ElemTyp) THEN err [129] };

yp ← yp^.next }

ELSE err [130];

xp ← xp^.next

ENDLOOP;

IF yp # NIL THEN err [131];

M2I.PutODB [LIPC, ypd^.num]; y^.mode ← stkMd;

PutStore [x, y] }}

ELSE IF x^.typ = y^.typ THEN PutStore [x, y]

ENDCASE };

LoadDyn: PROC [x: ItemPtr] =

{ var: M2D.VarPtr = NARROW[x^.obj];

dl: CARDINAL ← x^.contxt^.lev - var^.lev;

pd: M2D.PDPtr;

(var^.lev # 0) AND (var^.cell < 16)

IF dl = 0 THEN { M2I.PutLR [LR+var^.cell]; M2I.PutLR [LR+var^.cell+1] }

ELSE { SL: CARDINAL = x^.contxt^.LNK;

pd ← x^.contxt;

IF dl >= 2 THEN

{ M2I.PutLRB [LRI+SL, 0]; pd ← pd^.pAnc; dl ← dl - 2;

WHILE dl # 0 DO M2I.PutOB [RB, 0]; pd ← pd^.pAnc; dl ← dl - 1 ENDLOOP }

ELSE M2I.PutLR [LR+SL];

M2I.PutOB [RSB, IF var^.cell # 0 THEN var^.cell ELSE SL];

M2I.PutExch; M2I.PutOB [RB, var^.cell+1];

pd^.impRegs [var^.cell] ← TRUE; pd^.impRegs [var^.cell+1] ← TRUE };

x^.mode ← stkMd };

GenParam: PUBLIC PROC [ap: ItemPtr, f: M2D.ParPtr] =

{ fp: ItemPtr = NEW [Item];

IF f^.typ^.form = Array THEN

{ farray: M2D.ArrayPtr = NARROW [f^.typ];

IF farray^.dyn THEN

IF ap^.typ^.form = Array THEN

{ aarray: M2D.ArrayPtr = NARROW [ap^.typ];

IF (farray^.ElemTyp = aarray^.ElemTyp) OR (farray^.ElemTyp = M2D.wordtyp) AND (aarray^.ElemTyp^.size = 1) THEN

IF aarray^.dyn THEN LoadDyn [ap]

ELSE { range: M2D.RangePtr = NARROW [aarray^.IndexTyp];

LoadStk [ap]; M2I.PutLod [range^.max+1-range^.min] }

ELSE err [133] }

ELSE IF (farray^.ElemTyp = M2D.chartyp) THEN

IF ap^.typ^.form = String THEN { LoadStk [ap]; M2I.PutLod [ap^.val.D1] }

ELSE IF ap^.typ^.form = Char THEN { LoadStk [ap]; M2I.PutLod [1] }

ELSE err [133]

ELSE IF f^.typ = ap^.typ THEN LoadStk [ap]

ELSE IF farray^.ElemTyp = M2D.chartyp THEN

IF ap^.typ^.form = String THEN LoadStk [ap]

ELSE IF ap^.typ^.form = Char THEN err [200]

ELSE err [133]

ELSE err [133] }

ELSE IF f^.typ^.form = Record THEN

IF f^.typ = ap^.typ THEN LoadStk [ap]

ELSE err [133]

ELSE IF f^.varpar THEN

{ IF (ap^.typ = f^.typ) OR (f^.typ = M2D.wordtyp) AND (ap^.typ^.size = 1) OR (f^.typ = M2D.addrtyp) AND (ap^.typ^.form = Pointer) THEN

{ LoadAdrStk [ap]; ap^.mode ← stkMd }

ELSE err [137] }

ELSE { fp^.mode ← stkMd; fp^.typ ← f^.typ; GenAssign [fp, ap] }};

MoveRegs: PROC [x: ItemPtr, op: CARDINAL] =

{ empty: M2D.SET = ALL [FALSE];

rset: M2D.SET = x^.expRegs; pd: M2D.PDPtr = x^.contxt;

i: CARDINAL;

IF rset # empty THEN

{ SL: CARDINAL = pd^.LNK; FRX: CARDINAL = SL+1;

IF rset [0] THEN M2I.PutLRRB [op, SL, 0, FRX];

i ← 1;

DO IF rset [i] THEN M2I.PutLRRB [op, i, i, FRX];

IF i = M2D.WordSize-1 THEN EXIT;

i ← i + 1

ENDLOOP;

pd^.needsBUP ← TRUE }};

PrepCall: PUBLIC PROC [x: ItemPtr] RETURNS [fpar: M2D.ParPtr] =

{ IF x^.mode = procMd OR x^.mode = codMd THEN

{ proc: M2D.ProcPtr = NARROW [x^.obj]; fpar ← proc^.firstParam }

ELSE IF x^.typ^.form = ProcTyp THEN

{ proctyp: M2D.ProcTypPtr = NARROW [x^.typ]; fpar ← proctyp^.firstPar }

ELSE { err [136]; fpar ← NIL; x^.typ ← M2D.undftyp }};

GenCall: PUBLIC PROC [x: ItemPtr] =

{ i, dl, len: CARDINAL;

IF x^.mode = procMd THEN

{ pd: M2D.PDPtr = NARROW [NARROW [x^.obj, M2D.ProcPtr]^.bd];

IF pd^.mod = 0 THEN -- internal call

IF x^.contxt^.lev = 0 THEN M2I.PutODB [LFC, pd^.pc - M2I.pc]

ELSE

{ IF pd^.lev > 1 THEN -- provide SL

{ SL: CARDINAL = x^.contxt^.LNK; FRX: CARDINAL = SL+1;

IF x^.contxt^.lev >= pd^.lev THEN

{ dl ← x^.contxt^.lev - pd^.lev;

IF dl >= 1 THEN { M2I.PutLRB [LRI+SL, 0]; dl ← dl - 1;

WHILE dl # 0 DO M2I.PutOB [RB, 0]; dl ← dl - 1 ENDLOOP }

ELSE M2I.PutLR [LR+SL] }

ELSE -- nested proc call

{ x^.expRegs ← M2D.UNION [x^.expRegs, pd^.impRegs];

x^.contxt^.needsBUP ← TRUE; M2I.PutLR [LR+FRX] }};

MoveRegs [x, WRI]; M2I.PutODB [LFC, pd^.pc - M2I.pc]; MoveRegs [x, RRI] }

ELSE IF x^.contxt^.lev = 0 THEN M2I.PutOQB [DFC, pd^.mod*256 + pd^.num]

ELSE { MoveRegs [x, WRI];

M2I.Reloc; M2I.PutOQB [DFC, pd^.mod*256 + pd^.num]; MoveRegs [x, RRI] };

x^.typ ← x^.obj^.typ }

ELSE IF x^.mode = codMd THEN

{ cd: M2D.CDPtr = NARROW [NARROW [x^.obj, M2D.ProcPtr]^.bd];

len ← cd^.length; i ← 0;

WHILE i < len DO M2I.FixByte [cd^.cod[i]]; i ← i + 1 ENDLOOP;

x^.typ ← x^.obj^.typ }

ELSE IF x^.typ^.form = ProcTyp THEN

{ proctyp: M2D.ProcTypPtr = NARROW [x^.typ];

LoadStk [x]; M2I.PutOI [SFC];

x^.typ ← proctyp^.resTyp };

x^.mode ← stkMd };

InitMods: PROC [obj: M2D.ObjPtr] =

{ WHILE obj # NIL DO

IF obj^.class = Module THEN

{ module: M2D.ModulePtr = NARROW [obj];

InitMods [module^.firstObj]; M2I.PutODB [LFC, module^.pc - M2I.pc] };

obj ← obj^.next

ENDLOOP };

InitFRXVars: PROC [obj: M2D.ObjPtr, FRX, A, a: CARDINAL] RETURNS [CARDINAL] =

{ WHILE obj # NIL DO

WITH obj SELECT FROM

var: M2D.VarPtr => {

IF (obj^.typ^.form = Array) OR (obj^.typ^.form = Record) THEN

{ sz: CARDINAL = obj^.typ^.size; a ← a + sz;

IF a # A THEN

{ M2I.PutOI [DUP]; M2I.PutLRB [SRI+FRX, var^.cell]; M2I.PutAdd [sz] }

ELSE M2I.PutLRB [SRI+FRX, var^.cell] }};

module: M2D.ModulePtr =>

a ← InitFRXVars [module^.firstObj, FRX, A, a];

ENDCASE;

obj ← obj^.next

ENDLOOP;

RETURN [a] };

GenEnterM: PUBLIC PROC [mod: M2D.ModulePtr] =

{ IF mod^.prio > 0 THEN {}};

GenInitM: PUBLIC PROC [mod: M2D.ModulePtr, modno: CARDINAL] RETURNS [loc: CARDINAL ] = { -- main module --

s, a, A: CARDINAL;

FRX: CARDINAL = mod^.pAnc^.LNK+1;

M2I.Reloc; M2I.PutOQB [LIQB, 0]; M2I.PutOB [ALS, 0]; -- adr [literals]

M2I.Reloc; M2I.PutOQB [LIQB, 1]; -- to global FRX

M2I.PutLRRB [WRI, 0, 0, 1]; -- init adr [literals] in mem

M2I.PutOI [LC+1]; M2I.PutOI [LC+0];

M2I.PutOB [CST, 1]; M2I.PutJBB [JEBB, 5, 0]; -- check init flag

M2I.PutOB [RET, 127]; M2I.PutOB [AS, 126];

a ← 0; A ← mod^.pAnc^.adr; loc ← M2I.pc;

IF a # A THEN

{ M2I.PutOI [J1]; M2I.PutOB [J2, 0] }; -- ld offset mem var space

[] ← InitFRXVars [mod^.firstObj, FRX, mod^.pAnc^.adr, 0];

s ← 1; -- init imports --

WHILE s < modno DO s ← s + 1 ENDLOOP;

InitMods [mod^.firstObj] };

GenEnterP: PUBLIC PROC [proc: M2D.ProcPtr] RETURNS [loc1, loc2: CARDINAL] =

{ pd: M2D.PDPtr = NARROW [proc^.bd];

IF pd^.lev = 1 THEN { M2I.Reloc; M2I.PutOQB [LIQB, 1] };

M2I.PutOB [ALS, 128 - pd^.LNK];

alloc FRX

loc1 ← M2I.pc; M2I.PutODB [J3, 0]; M2I.PutOQB [J5, 0];

gen SL in FRX

loc2 ← M2I.pc; M2I.PutODB [J3, 0];

IF pd^.mAnc^.prio # 0 THEN {}};

GenInitP: PUBLIC PROC [proc: M2D.ProcPtr] RETURNS [loc1, loc2, cell: CARDINAL]=

{ a, A, r: CARDINAL; obj: M2D.ObjPtr; par: M2D.ParPtr;

pd: M2D.PDPtr = NARROW [proc^.bd];

InitPar: PROC [reg, sz: CARDINAL] =

{ a ← a + sz;

IF a # A THEN { M2I.PutOI [DUP]; M2I.PutOI [DUP];

M2I.PutLR [LR+reg]; M2I.PutLod [sz]; M2I.PutOQB [CALL, Move];

M2I.PutLR [SR+reg]; M2I.PutAdd [sz] }

ELSE { M2I.PutOI [DUP];

M2I.PutLR [LR+reg]; M2I.PutLod [sz]; M2I.PutOQB [CALL, Move];

M2I.PutLR [SR+reg] }};

InitVars: PROC [obj: M2D.ObjPtr] =

{ DO

IF obj = NIL THEN EXIT;

WITH obj SELECT FROM

var: M2D.VarPtr => {

IF var^.cell >= 16 THEN EXIT;

IF (obj^.typ^.form = Array) OR (obj^.typ^.form = Record) THEN

{ sz: CARDINAL ← obj^.typ^.size; a ← a + sz;

IF a # A THEN { M2I.PutOI [DUP]; M2I.PutAdd [sz] }}

ELSE M2I.PutOI [DUP] };

module: M2D.ModulePtr => InitVars [module^.firstObj];

ENDCASE;

obj ← obj^.next

ENDLOOP;

[] ← InitFRXVars [obj, pd^.LNK+1, A, a] };

a ← 0; A ← pd^.adr; loc1 ← M2I.pc;

IF a # A THEN { M2I.PutOI [J1]; M2I.PutOB [J2, 0] }; -- ld data offset

par ← proc^.firstParam; obj ← pd^.firstLocal;

WHILE par # NIL DO

IF (obj^.typ^.form = Array) OR (obj^.typ^.form = Record) THEN

{ var: M2D.VarPtr = NARROW [obj];

IF NOT var^.varpar THEN

IF obj^.typ^.form = Array THEN

{ array: M2D.ArrayPtr = NARROW [obj^.typ];

IF array^.dyn THEN

{ M2I.PutLR [LR+var^.cell+1]; M2I.PutOQB [CALL, Alloc];

M2I.PutOI [DUP]; M2I.PutLR [LR+var^.cell];

M2I.PutLR [LR+var^.cell+1]; M2I.PutOQB [CALL, Move];

M2I.PutLR [SR+var^.cell] }

ELSE InitPar [var^.cell, obj^.typ^.size] }

ELSE InitPar [var^.cell, obj^.typ^.size] };

par ← par^.next; obj ← obj^.next

ENDLOOP;

InitVars [obj];

provide cells for WITH bases

loc2 ← M2I.pc; cell ← pd^.cell; r ← pd^.cell;

WHILE r < 15 DO M2I.PutOI [J1]; r ← r + 1 ENDLOOP;

InitMods [obj] };

GenReturn: PUBLIC PROC [x: ItemPtr, ancestor: M2D.ObjPtr, loc: CARDINAL] RETURNS [Loc: CARDINAL] =

{ res: ItemPtr = NEW [Item];

DeallocDyn: PROC [par: M2D.ParPtr] =

{ reg: CARDINAL ← 0;

WHILE par # NIL DO

IF par^.typ^.form = Array THEN

{ array: M2D.ArrayPtr = NARROW [par^.typ];

IF array^.dyn THEN

{ IF NOT par^.varpar THEN

{ M2I.PutLR [LR+reg]; M2I.PutOQB [CALL, Dealloc] };

reg ← reg + 2 }

ELSE reg ← reg + 1 }

ELSE reg ← reg + 1;

par ← par^.next

ENDLOOP };

Loc ← loc;

IF x^.typ = NIL THEN

{ IF ancestor^.typ # M2D.notyp THEN err [139];

IF ancestor^.class = Proc THEN

{ proc: M2D.ProcPtr = NARROW [ancestor];

pd: M2D.PDPtr = NARROW [proc^.bd];

IF pd^.mAnc^.prio > 0 THEN {};

DeallocDyn [proc^.firstParam];

Dealloc FRX

Loc ← M2I.pc; M2I.PutODB [J3, loc]; M2I.PutODB [J3, 0];

M2I.PutOB [RET, 127] }

ELSE IF ancestor = M2D.mainmod THEN M2I.PutOB [RET, 127]

ELSE M2I.PutOI [RETN] }

ELSE IF ancestor^.class = Proc THEN

{ proc: M2D.ProcPtr = NARROW [ancestor];

pd: M2D.PDPtr = NARROW [proc^.bd];

IF pd^.mAnc^.prio > 0 THEN {};

IF x^.mode < opnMd THEN LoadStk [x];

DeallocDyn [proc^.firstParam];

Dealloc FRX

Loc ← M2I.pc; M2I.PutODB [J3, loc]; M2I.PutODB [J3, 0];

res^.mode ← regMd; res^.opt ← 0; res^.reg ← 0; res^.typ ← ancestor^.typ;

GenAssign [res, x];

M2I.PutOB [RET, 0] }

ELSE err [300] };

GenTrap: PUBLIC PROC [n: CARDINAL] = { M2I.PutOB [LIB, n]; M2I.PutOQB [CALL, Trap] };

GenCase1: PUBLIC PROC [x: ItemPtr] RETURNS [L0: CARDINAL] =

{ f: M2D.StrForm = x^.typ^.form;

IF (f <= Int) OR (f = Enum) OR (f = Range) THEN

{ LoadStk [x]; L0 ← M2I.pc;

M2I.PutOQB [LIQB, 0]; -- low limit --

M2I.PutRJB [RJGEB, 1, 0, 1, 0, 13, 6];

M2I.PutODB [JDB, 0]; -- else jump --

M2I.PutOQB [LIQB, 0]; -- high limit --

M2I.PutRJB [RJLEB, 1, 0, 1, 0, 13, 6];

M2I.PutODB [JDB, 0]; -- else jump --

M2I.PutODB [JDB, 0] }

ELSE { err [140]; L0 ← M2I.pc }};

GenCase2: PUBLIC PROC [l2: CARDINAL] RETURNS [L2: CARDINAL] =

{ L2 ← M2I.pc; M2I.PutODB [JDB, l2] };

GenCase3: PUBLIC PROC [L0, L1, L2, n: CARDINAL, tab: LabelTabPtr] =

{ i: CARDINAL; j: INTEGER;

IF n > 0 THEN

{ M2I.FixLong [L0+1, tab[0].low]; M2I.FixLong [L0+12, tab[n-1].high] };

M2I.FixJmp [L0+8, L1]; M2I.FixJmp [L0+19, L1]; M2I.FixJmp [L0+22, M2I.pc];

M2I.PutSub [tab[0].low]; M2I.PutOI [DUP]; M2I.PutOI [DUP];

M2I.PutOI [ADD]; M2I.PutOI [ADD]; M2I.PutOB [ADDB, 1];

M2I.PutOI [SJ];

i ← 0; j ← tab[0].low;

WHILE i < n DO

WHILE j < tab[i].low DO

M2I.PutODB [JDB, L1 - M2I.pc]; j ← j + 1 -- ELSE --

ENDLOOP;

WHILE j <= tab[i].high DO

M2I.PutODB [JDB, tab[i].label - M2I.pc]; j ← j + 1

ENDLOOP;

i ← i + 1

ENDLOOP;

M2I.FixLink [L2, M2I.pc] };

GenFor1: PUBLIC PROC [v, e1: ItemPtr] =

{ f: M2D.StrForm;

SRTest [v]; f ← v^.typ^.form;

IF (f <= Int) OR (f = Enum) THEN { SRTest [e1]; GenAssign [v, e1] }

ELSE err [142] };

GenFor2: PUBLIC PROC [v, e2: ItemPtr] =

{ SRTest [v]; SRTest [e2];

IF (v^.typ = e2^.typ) OR (v^.typ = M2D.inttyp) AND (e2^.typ = M2D.cardtyp) AND (e2^.mode = conMd) AND (e2^.val.C < MaxInt) THEN LoadStk [e2]

ELSE err [117] };

GenFor3: PUBLIC PROC [v, e2, e3: ItemPtr] RETURNS [L0, L1: CARDINAL] =

{ L0 ← M2I.pc; Load [v];

IF e3^.val.I > 0 THEN

IF v^.mode = stkMd THEN M2I.PutRJB [RJGEB, 0, 1, 1, 0, 12, 6]

ELSE IF (v^.mode = regMd) AND (v^.opt = 0) THEN

M2I.PutRJB [RJGEB, 0, 0, 0, 0, v^.reg, 6]

ELSE err [141]

ELSE IF e3^.val.I < 0 THEN

IF v^.mode = stkMd THEN M2I.PutRJB [RJLEB, 0, 1, 1, 0, 12, 6]

ELSE IF (v^.mode = regMd) AND (v^.opt = 0) THEN

M2I.PutRJB [RJLEB, 0, 0, 0, 0, v^.reg, 6]

ELSE err [141]

ELSE err [141];

L1 ← M2I.pc; M2I.PutODB [JDB, 0] };

GenFor4: PUBLIC PROC [v, e3: ItemPtr, L0, L1: CARDINAL] =

{ w: ItemPtr = NEW [Item];

SRTest [v]; w^ ← v^; PrepAss [v]; Load [w];

GenOp [plus, w, e3]; GenAssign [v, w];

GenBJ [L0]; M2I.FixJmp [L1, M2I.pc] };

GenWith: PUBLIC PROC [v, x: ItemPtr] = { PutStore [v, x] };

expressions

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 BOOL;

f: PROC [cell, cell0: CARDINAL] RETURNS [CARDINAL] = INLINE

{ IF cell # 0 THEN RETURN [cell] ELSE RETURN [cell0] };

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; pd: M2D.PDPtr;

var: M2D.VarPtr = NARROW[x^.obj];

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 { pd ← x^.contxt;

IF dl >= 2 THEN

{ M2I.PutLRB [LRI+x^.contxt^.LNK, 0]; pd ← pd^.pAnc; dl ← dl - 2;

WHILE dl # 0 DO M2I.PutOB [RB, 0]; pd ← pd^.pAnc; dl ← dl - 1 ENDLOOP;

x^.mode ← sadrMd; x^.off ← f[var^.cell, pd^.pAnc^.LNK] }

ELSE { x^.mode ← ladrMd;

x^.reg ← x^.contxt^.LNK; x^.off ← f[var^.cell, pd^.pAnc^.LNK] };

IF var^.cell < 16 THEN pd^.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; pd: M2D.PDPtr;

var: M2D.VarPtr = NARROW[x^.obj];

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 { pd ← x^.contxt;

IF dl >= 2 THEN

{ M2I.PutLRB [LRI+x^.contxt^.LNK, 0]; pd ← pd^.pAnc; dl ← dl - 2;

WHILE dl # 0 DO M2I.PutOB [RB, 0]; pd ← pd^.pAnc; dl ← dl - 1 ENDLOOP ;

M2I.PutOB [RB, f[var^.cell, pd^.pAnc^.LNK]] }

ELSE M2I.PutLRB [LRI+x^.contxt^.LNK, f[var^.cell, pd^.pAnc^.LNK]];

x^.mode ← stkMd;

IF var^.cell < 16 THEN pd^.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];

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

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

y^.typ ← set^.BaseTyp;

IF y^.typ^.form = Range THEN

{ range: M2D.RangePtr = NARROW [y^.typ];

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 };

GenStParam: PUBLIC PROC [p, x: ItemPtr, fctno, parno: CARDINAL] =

{ restyp: M2D.StrPtr; f: M2D.StrForm;

u: ItemPtr = NEW [Item]; v: ItemPtr = NEW [Item];

IF fctno < 20 THEN

IF parno = 0 THEN -- first parameter --

{ restyp ← p^.obj^.typ;

SELECT fctno FROM

0, 1 => {};

2 => { SRTest [x]; -- ABS --

IF x^.typ = M2D.inttyp THEN

{ LoadStk [x]; M2I.PutRJB [RJLB, 0, 0, 1, 0, 0, 6];

M2I.PutRR [RSUB, 1, 1, 1, 0, 12, 0, 12]; restyp ← M2D.inttyp }

ELSE IF x^.typ = M2D.realtyp THEN

{ Load [x]; restyp ← M2D.realtyp }

ELSE err [144] };

3 => { SRTest [x]; -- CAP --

IF x^.typ = M2D.chartyp THEN { LoadStk [x];

M2I.PutOB [LIB, 137B]; M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] }

ELSE err [144] };

4 => { SRTest [x]; -- FLOAT --

IF x^.typ = M2D.cardtyp THEN Load [x] ELSE err [144] };

5 => { SRTest [x]; -- ODD --

IF (x^.typ = M2D.cardtyp) OR (x^.typ = M2D.inttyp) THEN

{ LoadStk [x];

M2I.PutOB [LIB, 1B]; M2I.PutRR [RAND, 1, 1, 1, 0, 13, 14, 13] }

ELSE err [144] };

6 => { SRTest [x]; -- ORD --

IF (x^.typ^.form <= Card) OR (x^.typ^.form = Enum) THEN Load [x]

ELSE err [144] };

7 => { -- TRUNC --

IF x^.typ = M2D.realtyp THEN Load [x] ELSE err [144] };

8 => { IF (x^.mode = typMd) OR (x^.mode = varMd) THEN

x^.val.I ← x^.typ^.size -- SIZE, TSIZE --

ELSE { err [145]; x^.val.I ← 1 };

x^.mode ← conMd; restyp ← M2D.cardtyp };

9 => {};

10 => { LoadAdrStk [x]; x^.mode ← stkMd -- ADR --};

11 => { IF x^.mode = typMd THEN -- MIN --

{ x^.mode ← conMd; restyp ← x^.typ;

SELECT x^.typ^.form FROM

Bool => { x^.val.B ← FALSE };

Char => { x^.val.Ch ← '\000 };

Int => { x^.val.C ← 100000B };

Card => { x^.val.C ← 0 };

Real => { x^.val.D0 ← 177577B; x^.val.D1 ← 177777B };

Double => { x^.val.D0 ← 100000B; x^.val.D1 ← 0 };

Enum => { x^.val.C ← 0 };

Range => { range: M2D.RangePtr = NARROW [x^.typ];

x^.val.I ← range^.min }

ENDCASE => err [144] }

ELSE err [145] };

12 => {IF x^.mode = typMd THEN -- MAX --

{ x^.mode ← conMd; restyp ← x^.typ;

SELECT x^.typ^.form FROM

Bool => { x^.val.B ← TRUE };

Char => { x^.val.Ch ← 377C };

Int => { x^.val.C ← 77777B };

Card => { x^.val.C ← 177777B };

Real => { x^.val.D0 ← 77577B; x^.val.D1 ← 177777B };

Double => { x^.val.D0 ← 77777B; x^.val.D1 ← 177777B };

Enum => { enum: M2D.EnumPtr = NARROW [x^.typ];

x^.val.C ← enum^.NofConst - 1 };

Range => { range: M2D.RangePtr = NARROW [x^.typ];

x^.val.I ← range^.max }

ENDCASE => err [144] }

ELSE err [145] };

13 => { IF (x^.mode = varMd) AND (x^.typ^.form = Array) THEN -- HIGH --

{ array: M2D.ArrayPtr = NARROW [x^.typ];

IF array^.dyn THEN

{ var: M2D.VarPtr = NARROW [x^.obj];

M2I.PutRR [RSUB, 1, 0, 1, 0, 15, var^.cell+1, 1]; -- SIZE-1

x^.mode ← stkMd; restyp ← M2D.cardtyp }

ELSE { range: M2D.RangePtr = NARROW [array^.IndexTyp];

x^.mode ← conMd; x^.val.I ← range^.max;

restyp ← array^.IndexTyp }}

ELSE err [144] };

14 => { SRTest [x]; -- CHR --

IF (x^.typ # M2D.cardtyp) AND (x^.typ # M2D.inttyp) THEN err [144];

restyp ← M2D.chartyp };

15 => { SRTest [x]; -- LONG --

IF x^.typ^.form = Int THEN {}

ELSE IF x^.typ^.form = Card THEN {}

ELSE IF x^.typ^.form = Real THEN {restyp ← M2D.lrltyp }};

16, 17 => { f ← x^.typ^.form; -- INC, DEC --

IF (f <= Double) OR (f = Range) OR (f = Enum) THEN

{ SRTest [x]; PrepAss [x]; restyp ← x^.typ }

ELSE err [144] };

18, 19 => { IF x^.typ^.form = Set THEN -- INCL, EXCL --

{ PrepAss [x]; restyp ← x^.typ }

ELSE err [144] };

20 => { SRTest [x]; -- SHIFT --

IF (x^.typ = M2D.cardtyp) OR (x^.typ = M2D.inttyp) THEN Load [x]

ELSE err [144] }

ENDCASE;

p^ ← x^; p^.typ ← restyp }

ELSE

IF parno = 1 THEN-- second parameter --

IF fctno = 16 THEN -- INC --

{ u^ ← p^; Load [u]; Load [x];

GenOp [plus, u, x]; GenAssign [p, u] }

ELSE IF fctno = 17 THEN -- DEC --

{ u^ ← p^; Load [u]; Load [x];

GenOp [minus, u, x]; GenAssign [p, u] }

ELSE IF fctno = 18 THEN -- INCL --

{ u^ ← p^; v^.typ ← p^.typ; GenSingSet [v, x];

LoadStk [v]; GenOp [plus, u, v]; GenAssign [p, u];

p^.typ ← M2D.notyp }

ELSE IF fctno = 19 THEN -- EXCL --

{ u^ ← p^; v^.typ ← p^.typ; GenSingSet [v, x];

LoadStk [v]; M2I.PutRR [RXOR, 1,1,1,0, 12, 6, 12];

GenOp [times, u, v]; GenAssign [p, u];

p^.typ ← M2D.notyp }

ELSE IF fctno = 20 THEN -- SHIFT --

{ SRTest [p]; SRTest [x];

IF (x^.typ = M2D.cardtyp) OR (x^.typ = M2D.inttyp) THEN

x^.typ ← M2D.chartyp

ELSE err [144];

IF (p^.typ # M2D.inttyp) AND (p^.typ # M2D.cardtyp) AND (p^.typ # M2D.bitstyp) AND (p^.typ # M2D.dbltyp) THEN err [144] }

ELSE err [64]

ELSE err [64] };

GenStFct: PUBLIC PROC [p: ItemPtr, fctno, parno: CARDINAL] =

{ x: ItemPtr = NEW [Item]; u: ItemPtr = NEW [Item];

IF parno < 1 THEN err [65]

ELSE IF fctno = 16 THEN -- INC --

{ IF parno = 1 THEN { x^.mode ← conMd; x^.typ ← M2D.inttyp; x^.val.C ← 1;

u^ ← p^; Load [u]; Load [x]; GenOp [plus, u, x];

GenAssign [p, u] };

p^.typ ← M2D.notyp }

ELSE IF fctno = 17 THEN -- DEC --

{ IF parno = 1 THEN { x^.mode ← conMd; x^.typ ← M2D.inttyp; x^.val.C ← 1;

u^ ← p^; Load [u]; Load [x]; GenOp [minus, u, x];

GenAssign [p, u] };

p^.typ ← M2D.notyp }

ELSE IF (fctno > 17) AND (parno < 2) THEN err [65] };

END.