DIRECTORY M2D USING [StrForm, VarPtr, StrPtr, EnumPtr, RangePtr, ArrayPtr, notyp, inttyp, cardtyp, dbltyp, realtyp, lrltyp, chartyp, bitstyp], M2G USING [GenSingSet, PrepAss, GenAssign], M2H USING [ItemPtr, Item, Load, LoadStk, LoadAdrStk, GenOp], M2I USING [PutOB, PutRR, PutRJB], M2S USING [Mark], M2F; M2FImpl : CEDAR PROGRAM IMPORTS M2D, M2I, M2H, M2G, M2S EXPORTS M2F = BEGIN OPEN M2F; LIB: CARDINAL = 222B; RAND: CARDINAL = 301B; RSUB: CARDINAL = 305B; RXOR: CARDINAL = 310B; RJLB: CARDINAL = 342B; err: PROC [n: CARDINAL] = { M2S.Mark [n] }; SRTest: PROC [x: M2H.ItemPtr] = { IF (x^.typ # NIL) AND (x^.typ^.form = Range) THEN { range: M2D.RangePtr _ NARROW [x^.typ^.ext]; x^.typ _ range^.BaseTyp }}; GenStParam: PUBLIC PROC [p, x: M2H.ItemPtr, fctno, parno: CARDINAL] = { restyp: M2D.StrPtr; f: M2D.StrForm; u: M2H.ItemPtr _ NEW [M2H.Item]; v: M2H.ItemPtr _ NEW [M2H.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 { M2H.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 { M2H.Load [x]; restyp _ M2D.realtyp } ELSE err [144] }; 3 => { SRTest [x]; -- CAP -- IF x^.typ = M2D.chartyp THEN { M2H.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 M2H.Load [x] ELSE err [144] }; 5 => { SRTest [x]; -- ODD -- IF (x^.typ = M2D.cardtyp) OR (x^.typ = M2D.inttyp) THEN { M2H.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 M2H.Load [x] ELSE err [144] }; 7 => { -- TRUNC -- IF x^.typ = M2D.realtyp THEN M2H.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 => { M2H.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 _ 0C }; 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^.ext]; 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^.ext]; x^.val.C _ enum^.NofConst - 1 }; Range => { range: M2D.RangePtr _ NARROW [x^.typ^.ext]; 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^.ext]; IF array^.dyn THEN { var: M2D.VarPtr _ NARROW [x^.obj^.ext]; 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^.ext]; 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]; M2G.PrepAss [x]; restyp _ x^.typ } ELSE err [144] }; 18, 19 => { IF x^.typ^.form = Set THEN -- INCL, EXCL -- { M2G.PrepAss [x]; restyp _ x^.typ } ELSE err [144] }; 20 => { SRTest [x]; -- SHIFT -- IF (x^.typ = M2D.cardtyp) OR (x^.typ = M2D.inttyp) THEN M2H.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^; M2H.Load [u]; M2H.Load [x]; M2H.GenOp [plus, u, x]; M2G.GenAssign [p, u] } ELSE IF fctno = 17 THEN -- DEC -- { u^ _ p^; M2H.Load [u]; M2H.Load [x]; M2H.GenOp [minus, u, x]; M2G.GenAssign [p, u] } ELSE IF fctno = 18 THEN -- INCL -- { u^ _ p^; v^.typ _ p^.typ; M2G.GenSingSet [v, x]; M2H.LoadStk [v]; M2H.GenOp [plus, u, v]; M2G.GenAssign [p, u]; p^.typ _ M2D.notyp } ELSE IF fctno = 19 THEN -- EXCL -- { u^ _ p^; v^.typ _ p^.typ; M2G.GenSingSet [v, x]; M2H.LoadStk [v]; M2I.PutRR [RXOR, 1,1,1,0, 12, 6, 12]; M2H.GenOp [times, u, v]; M2G.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: M2H.ItemPtr, fctno, parno: CARDINAL] = { x: M2H.ItemPtr _ NEW [M2H.Item]; u: M2H.ItemPtr _ NEW [M2H.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^; M2H.Load [u]; M2H.Load [x]; M2H.GenOp [plus, u, x]; M2G.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^; M2H.Load [u]; M2H.Load [x]; M2H.GenOp [minus, u, x]; M2G.GenAssign [p, u] }; p^.typ _ M2D.notyp } ELSE IF (fctno > 17) AND (parno < 2) THEN err [65] }; END. vFILE: M2FImpl.mesa Modula-2 Code-Generator Part 1 Last Edited by: Gutknecht, September 18, 1985 0:21:48 am PDT Êö˜Jšœ™Jšœ™Jšœ<™JšœŸ ˜Jšœœœ˜:Jšœ˜Jšœœœ˜CJšœœ ˜JšœŸ ˜Jšœœœœ ˜GJšœœ ˜JšœŸ ˜Jšœœœœ ˜>Jšœœœ˜6Jšœ œŸ˜-Jšœœ˜$J˜+J˜ Jšœ-Ÿ œ˜8Jšœ œœŸ ˜*J˜'Jšœœ˜Jšœœ˜"J˜ Jšœ#˜#Jšœ˜J˜:J˜6Jšœ˜Jšœ&œ˜;Jšœ˜Jšœœ˜Jšœœ ˜JšœœœŸ ˜)J˜'Jšœœ˜Jšœœ˜!J˜"Jšœ"˜"Jšœ$˜$J˜9J˜;Jšœ#œ˜8Jšœ(˜(Jšœ&œ˜;Jšœ˜Jšœœ˜Jšœœ ˜Jšœ œœœŸ ˜HJšœœ˜1Jšœœ ˜Jšœœ˜.Jšœœ#Ÿ ˜@J˜,Jšœœœ˜?Jšœ,˜,Jšœ ˜ Jšœœ ˜JšœŸ ˜Jšœœœœ ˜FJšœ˜JšœŸ ˜Jšœœœ˜ Jšœœœœ˜&Jšœœœœ˜˜>J˜—šœœ œŸ ˜"Jšœ2˜2Jšœœ˜6Jšœ.˜.J˜—šœœ œŸ ˜#Jšœ˜Jšœœ˜7Jšœ˜Jšœ ˜Jš œœœœœ ˜y—Jšœ ˜ —Jšœ ˜J˜———šžœœœ œ˜AJšœœœ ˜CJšœ œ ˜šœœ œŸ ˜!Jšœœ œ6˜IJ˜=Jšœ˜Jšœ˜—šœœ œŸ œ˜"Jšœœ œ6˜IJ˜>Jšœ˜Jšœ˜—Jšœœœ œ ˜5J˜—Jšœ˜J˜—…—4