
<<FILE: M2GImpl.mesa>>
<<Modula-2 Code-Generator Part 1>>
<<Last Edited by: Gutknecht, September 20, 1985 11:33:54 pm PDT>>
    <<Satterthwaite December 11, 1985 3:24:23 pm 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 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 BOOLEAN;

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.
