|
|
@@ -0,0 +1,1622 @@
|
|
|
+IMPLEMENTATION MODULE MGen;
|
|
|
+
|
|
|
+IMPORT FileIO, SymTab, AST, M2compP;
|
|
|
+
|
|
|
+FROM M2compP IMPORT SemError;
|
|
|
+
|
|
|
+CONST
|
|
|
+ MaxCode = 8191;
|
|
|
+ MaxImg = 16383;
|
|
|
+ MaxLab = 255;
|
|
|
+ MaxFix = 2047;
|
|
|
+ MaxGlb = 255;
|
|
|
+ MaxProc = 64;
|
|
|
+ MaxScope = 64;
|
|
|
+ MaxVar = 2048;
|
|
|
+ MaxCst = 512;
|
|
|
+ MaxLoop = 15;
|
|
|
+ MaxInit = 8;
|
|
|
+
|
|
|
+ (* opcodes, see mc64-spec.md §11 *)
|
|
|
+ OPdup = 20H; OPswap = 21H;
|
|
|
+ OPloadGlb = 2DH; OPstoreGlb = 3DH;
|
|
|
+ OPloadLocal = 2CH; OPstoreLocal = 3CH;
|
|
|
+ OPloadOuterN = 11H;
|
|
|
+ OPloadIndir0 = 60H; OPstoreIndir0 = 70H;
|
|
|
+ OPloadIndir = 41H; OPstoreIndir = 51H;
|
|
|
+ OPlocalAddr = 80H; OPglobalAddr = 81H; OPstkAddr = 82H;
|
|
|
+ OPext = 40H; SUBdrop = 00H;
|
|
|
+ OPenter = 0D4H; OPprocLeave = 84H; OPfctLeave = 85H;
|
|
|
+ OPprocCall = 0EDH; OPnestedCall = 0ECH; OPcallFrame = 0EEH;
|
|
|
+ OPimmB = 8DH; OPimmW = 8EH; OPimm0 = 90H;
|
|
|
+ OPadd = 0A6H; OPsub = 0A7H; OPumul = 0A8H;
|
|
|
+ OPudiv = 0A9H; OPumod = 0AAH;
|
|
|
+ OPaeq0 = 0ABH; OPinc = 0ACH; OPdec = 0ADH;
|
|
|
+ OPeq = 0A0H; OPne = 0A1H;
|
|
|
+ OPilt = 0B2H; OPigt = 0B3H; OPile = 0B4H; OPige = 0B5H;
|
|
|
+ OPnot = 0B6H;
|
|
|
+ OPimul = 0B8H; OPidiv = 0B9H;
|
|
|
+ OPintToLong = 0BDH; OPlongToReal = 0BEH;
|
|
|
+ OPrCmp = 0D5H; OPrAdd = 0D6H; OPrSub = 0D7H;
|
|
|
+ OPrMul = 0D8H; OPrDiv = 0D9H;
|
|
|
+ OPor = 0E6H; OPbitIn = 0E7H; OPand = 0E8H;
|
|
|
+ OPbitXor = 0E9H; OPpower2 = 0EAH;
|
|
|
+ OPjp = 0E0H; OPjz = 0E1H;
|
|
|
+ OPsys = 0C3H; OPend = 50H;
|
|
|
+ OPcallRel = 8CH; OPcopyBlock = 30H; OPstrComp = 0C4H;
|
|
|
+
|
|
|
+ (* image layout *)
|
|
|
+ HeadSize = 64;
|
|
|
+ DName = 264; DChecksum = 288; DFlags = 292;
|
|
|
+ DVarCount = 293; DDepCount = 294; DProcs = 296;
|
|
|
+ DVarSizes = 304;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ FixRec = RECORD
|
|
|
+ pos : CARDINAL;
|
|
|
+ lab : INTEGER;
|
|
|
+ END;
|
|
|
+ RealView = RECORD CASE : BOOLEAN OF
|
|
|
+ | TRUE : r : REAL;
|
|
|
+ | FALSE : w : LONGCARD;
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ ScopeRec = RECORD
|
|
|
+ tag : SymTab.Name;
|
|
|
+ pnum : INTEGER;
|
|
|
+ depth : CARDINAL;
|
|
|
+ parent : INTEGER;
|
|
|
+ isMod : BOOLEAN;
|
|
|
+ END;
|
|
|
+ VarRec = RECORD
|
|
|
+ scope : INTEGER;
|
|
|
+ name : SymTab.Name;
|
|
|
+ kind : INTEGER;
|
|
|
+ typ : INTEGER;
|
|
|
+ slot : INTEGER;
|
|
|
+ size : CARDINAL;
|
|
|
+ depth : CARDINAL;
|
|
|
+ global : BOOLEAN;
|
|
|
+ isAddr : BOOLEAN;
|
|
|
+ END;
|
|
|
+ CstRec = RECORD
|
|
|
+ scope : INTEGER;
|
|
|
+ name : SymTab.Name;
|
|
|
+ ck : INTEGER; (* 0 int, 1 real bits, 2 string text *)
|
|
|
+ ival : INTEGER;
|
|
|
+ bits : LONGCARD;
|
|
|
+ text : SymTab.Name;
|
|
|
+ ok : BOOLEAN;
|
|
|
+ END;
|
|
|
+
|
|
|
+VAR
|
|
|
+ code : ARRAY [0 .. MaxCode] OF CHAR;
|
|
|
+ nCode : CARDINAL;
|
|
|
+ img : ARRAY [0 .. MaxImg] OF CHAR;
|
|
|
+ modName : SymTab.Name;
|
|
|
+ labs : ARRAY [0 .. MaxLab] OF INTEGER;
|
|
|
+ nLab : CARDINAL;
|
|
|
+ fixs : ARRAY [0 .. MaxFix] OF FixRec;
|
|
|
+ nFix : CARDINAL;
|
|
|
+ gBase : ARRAY [0 .. MaxGlb] OF CARDINAL;
|
|
|
+ gSize : ARRAY [0 .. MaxGlb] OF CARDINAL;
|
|
|
+ nG : CARDINAL;
|
|
|
+ nGlb : CARDINAL;
|
|
|
+ procAddr : ARRAY [0 .. MaxProc] OF INTEGER;
|
|
|
+ procDepth : ARRAY [0 .. MaxProc] OF CARDINAL;
|
|
|
+ procParent : ARRAY [0 .. MaxProc] OF INTEGER;
|
|
|
+ maxNum : CARDINAL;
|
|
|
+ mainAddr : CARDINAL;
|
|
|
+ initNums : ARRAY [0 .. MaxInit - 1] OF INTEGER;
|
|
|
+ nInits : CARDINAL;
|
|
|
+ nextInit : CARDINAL;
|
|
|
+ scopes : ARRAY [0 .. MaxScope - 1] OF ScopeRec;
|
|
|
+ nScopes : CARDINAL;
|
|
|
+ curScope : INTEGER;
|
|
|
+ vars : ARRAY [0 .. MaxVar - 1] OF VarRec;
|
|
|
+ nV : CARDINAL;
|
|
|
+ csts : ARRAY [0 .. MaxCst - 1] OF CstRec;
|
|
|
+ nC : CARDINAL;
|
|
|
+ curDepth : CARDINAL;
|
|
|
+ curProc : INTEGER;
|
|
|
+ loopSt : ARRAY [0 .. MaxLoop - 1] OF INTEGER;
|
|
|
+ loopTop : CARDINAL;
|
|
|
+ ok : BOOLEAN;
|
|
|
+
|
|
|
+(* ---------------- small helpers ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
|
|
|
+ RETURN i
|
|
|
+ END StrLen;
|
|
|
+
|
|
|
+PROCEDURE StrCpy (VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < HIGH(d)) & (i < HIGH(s)) & (s[i] # 0C) DO
|
|
|
+ d[i] := s[i]; INC(i)
|
|
|
+ END;
|
|
|
+ IF i <= HIGH(d) THEN d[i] := 0C END
|
|
|
+ END StrCpy;
|
|
|
+
|
|
|
+PROCEDURE Fail230 ();
|
|
|
+ BEGIN
|
|
|
+ M2compP.SemError(230);
|
|
|
+ ok := FALSE
|
|
|
+ END Fail230;
|
|
|
+
|
|
|
+(* ---------------- emission primitives ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE EmitByte (b: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ IF nCode <= MaxCode THEN
|
|
|
+ code[nCode] := CHR(b MOD 256); INC(nCode)
|
|
|
+ END
|
|
|
+ END EmitByte;
|
|
|
+
|
|
|
+PROCEDURE EmitOp (o: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ EmitByte(o)
|
|
|
+ END EmitOp;
|
|
|
+
|
|
|
+PROCEDURE EmitOpB (o, b: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ EmitByte(o); EmitByte(b)
|
|
|
+ END EmitOpB;
|
|
|
+
|
|
|
+PROCEDURE EmitW64 (v: LONGCARD);
|
|
|
+ VAR j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ FOR j := 0 TO 7 DO
|
|
|
+ EmitByte(VAL(CARDINAL, v MOD 256)); v := v DIV 256
|
|
|
+ END
|
|
|
+ END EmitW64;
|
|
|
+
|
|
|
+PROCEDURE EmitS64 (rel: INTEGER);
|
|
|
+ VAR mag : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF rel >= 0 THEN EmitW64(VAL(LONGCARD, VAL(CARDINAL, rel)))
|
|
|
+ ELSE
|
|
|
+ IF rel = -2147483647 - 1 THEN mag := 80000000H
|
|
|
+ ELSE mag := VAL(CARDINAL, -rel)
|
|
|
+ END;
|
|
|
+ EmitW64(0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H)
|
|
|
+ END
|
|
|
+ END EmitS64;
|
|
|
+
|
|
|
+PROCEDURE WriteS64At (off: CARDINAL; rel: INTEGER);
|
|
|
+ VAR mag : CARDINAL;
|
|
|
+ bits : LONGCARD;
|
|
|
+ j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF rel >= 0 THEN bits := VAL(LONGCARD, VAL(CARDINAL, rel))
|
|
|
+ ELSE
|
|
|
+ IF rel = -2147483647 - 1 THEN mag := 80000000H
|
|
|
+ ELSE mag := VAL(CARDINAL, -rel)
|
|
|
+ END;
|
|
|
+ bits := 0FFFFFFFFFFFFFFFFH - VAL(LONGCARD, mag) + 1H
|
|
|
+ END;
|
|
|
+ FOR j := 0 TO 7 DO
|
|
|
+ code[off + j] := CHR(VAL(CARDINAL, bits MOD 256));
|
|
|
+ bits := bits DIV 256
|
|
|
+ END
|
|
|
+ END WriteS64At;
|
|
|
+
|
|
|
+PROCEDURE EmitMag (mag: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ IF mag <= 15 THEN EmitOp(OPimm0 + mag)
|
|
|
+ ELSE EmitOp(OPimmW); EmitW64(VAL(LONGCARD, mag))
|
|
|
+ END
|
|
|
+ END EmitMag;
|
|
|
+
|
|
|
+PROCEDURE PushInt (v: INTEGER);
|
|
|
+ VAR mag : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF (v >= 0) & (v <= 15) THEN EmitOp(OPimm0 + VAL(CARDINAL, v))
|
|
|
+ ELSIF v < 0 THEN
|
|
|
+ IF v = -2147483647 - 1 THEN mag := 80000000H
|
|
|
+ ELSE mag := VAL(CARDINAL, -v)
|
|
|
+ END;
|
|
|
+ EmitOp(OPimm0); EmitMag(mag); EmitOp(OPsub)
|
|
|
+ ELSE EmitMag(VAL(CARDINAL, v))
|
|
|
+ END
|
|
|
+ END PushInt;
|
|
|
+
|
|
|
+PROCEDURE PushBits (b: LONGCARD);
|
|
|
+ BEGIN
|
|
|
+ EmitOp(OPimmW); EmitW64(b)
|
|
|
+ END PushBits;
|
|
|
+
|
|
|
+PROCEDURE EmitSlotB (op: CARDINAL; sl: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ IF sl >= 0 THEN EmitOpB(op, VAL(CARDINAL, sl))
|
|
|
+ ELSE EmitOpB(op, 256 - VAL(CARDINAL, -sl))
|
|
|
+ END
|
|
|
+ END EmitSlotB;
|
|
|
+
|
|
|
+PROCEDURE LoadLocal (sl: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitSlotB(OPloadLocal, sl)
|
|
|
+ END LoadLocal;
|
|
|
+
|
|
|
+PROCEDURE StoreLocal (sl: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitSlotB(OPstoreLocal, sl)
|
|
|
+ END StoreLocal;
|
|
|
+
|
|
|
+PROCEDURE LoadIndir0;
|
|
|
+ BEGIN
|
|
|
+ EmitOp(OPloadIndir0)
|
|
|
+ END LoadIndir0;
|
|
|
+
|
|
|
+PROCEDURE StoreIndir0;
|
|
|
+ BEGIN
|
|
|
+ EmitOp(OPstoreIndir0)
|
|
|
+ END StoreIndir0;
|
|
|
+
|
|
|
+PROCEDURE LoadIndir;
|
|
|
+ BEGIN
|
|
|
+ EmitOp(OPloadIndir)
|
|
|
+ END LoadIndir;
|
|
|
+
|
|
|
+PROCEDURE StoreIndir;
|
|
|
+ BEGIN
|
|
|
+ EmitOp(OPstoreIndir)
|
|
|
+ END StoreIndir;
|
|
|
+
|
|
|
+PROCEDURE FrameAddr (sl: INTEGER; np: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPloadOuterN, np);
|
|
|
+ IF sl >= 0 THEN EmitOpB(OPstkAddr, VAL(CARDINAL, sl))
|
|
|
+ ELSE
|
|
|
+ PushInt(sl * 8);
|
|
|
+ EmitOp(OPadd)
|
|
|
+ END
|
|
|
+ END FrameAddr;
|
|
|
+
|
|
|
+PROCEDURE NewLabel (): INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF nLab > MaxLab THEN Fail230(); RETURN 0 END;
|
|
|
+ labs[nLab] := -1;
|
|
|
+ INC(nLab);
|
|
|
+ RETURN VAL(INTEGER, nLab - 1)
|
|
|
+ END NewLabel;
|
|
|
+
|
|
|
+PROCEDURE DefLabel (id: INTEGER);
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ rel : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (id < 0) OR (id >= VAL(INTEGER, nLab)) THEN RETURN END;
|
|
|
+ labs[id] := VAL(INTEGER, nCode);
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nFix DO
|
|
|
+ IF fixs[i].lab = id THEN
|
|
|
+ rel := labs[id] - VAL(INTEGER, fixs[i].pos + 9);
|
|
|
+ WriteS64At(fixs[i].pos + 1, rel);
|
|
|
+ fixs[i].lab := -1
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END DefLabel;
|
|
|
+
|
|
|
+PROCEDURE Jump (op: CARDINAL; id: INTEGER);
|
|
|
+ VAR pos : CARDINAL;
|
|
|
+ j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ pos := nCode;
|
|
|
+ EmitOp(op);
|
|
|
+ IF (id >= 0) & (id < VAL(INTEGER, nLab)) & (labs[id] >= 0) THEN
|
|
|
+ EmitS64(labs[id] - VAL(INTEGER, pos + 9))
|
|
|
+ ELSE
|
|
|
+ FOR j := 0 TO 7 DO EmitByte(0) END;
|
|
|
+ IF (nFix <= MaxFix) & (id >= 0) & (id < VAL(INTEGER, nLab)) THEN
|
|
|
+ fixs[nFix].pos := pos; fixs[nFix].lab := id; INC(nFix)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END Jump;
|
|
|
+
|
|
|
+PROCEDURE Jmp (id: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ Jump(OPjp, id)
|
|
|
+ END Jmp;
|
|
|
+
|
|
|
+PROCEDURE Jz (id: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ Jump(OPjz, id)
|
|
|
+ END Jz;
|
|
|
+
|
|
|
+PROCEDURE TempGlobal (): INTEGER;
|
|
|
+ VAR idx : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (nG > MaxGlb) OR (nGlb > MaxGlb) THEN Fail230(); RETURN 4 END;
|
|
|
+ idx := VAL(INTEGER, nGlb);
|
|
|
+ gBase[nG] := VAL(CARDINAL, idx);
|
|
|
+ gSize[nG] := 1;
|
|
|
+ INC(nG);
|
|
|
+ nGlb := nGlb + 1;
|
|
|
+ RETURN idx
|
|
|
+ END TempGlobal;
|
|
|
+
|
|
|
+PROCEDURE LoadTemp (t: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPloadGlb, VAL(CARDINAL, t))
|
|
|
+ END LoadTemp;
|
|
|
+
|
|
|
+PROCEDURE StoreTemp (t: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPstoreGlb, VAL(CARDINAL, t))
|
|
|
+ END StoreTemp;
|
|
|
+
|
|
|
+(* ---------------- literal parsing ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE DigVal (ch: CHAR): INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (ch >= "0") & (ch <= "9") THEN RETURN ORD(ch) - ORD("0") END;
|
|
|
+ IF (ch >= "A") & (ch <= "F") THEN RETURN ORD(ch) - ORD("A") + 10 END;
|
|
|
+ IF (ch >= "a") & (ch <= "f") THEN RETURN ORD(ch) - ORD("a") + 10 END;
|
|
|
+ RETURN -1
|
|
|
+ END DigVal;
|
|
|
+
|
|
|
+PROCEDURE ParseReal (s: ARRAY OF CHAR; VAR b: LONGCARD): BOOLEAN;
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ neg, esign : BOOLEAN;
|
|
|
+ m, scale : REAL;
|
|
|
+ e, d : CARDINAL;
|
|
|
+ rv : RealView;
|
|
|
+ BEGIN
|
|
|
+ b := 0H;
|
|
|
+ i := 0; neg := FALSE;
|
|
|
+ IF s[0] = "-" THEN neg := TRUE; INC(i) END;
|
|
|
+ IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
|
|
|
+ m := 0.0;
|
|
|
+ WHILE (s[i] >= "0") & (s[i] <= "9") DO
|
|
|
+ m := m * 10.0 + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0")));
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ IF s[i] = "." THEN
|
|
|
+ INC(i);
|
|
|
+ IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
|
|
|
+ scale := 10.0;
|
|
|
+ WHILE (s[i] >= "0") & (s[i] <= "9") DO
|
|
|
+ m := m + VAL(REAL, VAL(CARDINAL, ORD(s[i]) - ORD("0"))) / scale;
|
|
|
+ scale := scale * 10.0;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF (s[i] = "E") OR (s[i] = "e") THEN
|
|
|
+ INC(i); esign := FALSE;
|
|
|
+ IF s[i] = "+" THEN INC(i)
|
|
|
+ ELSIF s[i] = "-" THEN esign := TRUE; INC(i)
|
|
|
+ END;
|
|
|
+ IF (s[i] < "0") OR (s[i] > "9") THEN RETURN FALSE END;
|
|
|
+ e := 0;
|
|
|
+ WHILE (s[i] >= "0") & (s[i] <= "9") DO
|
|
|
+ d := VAL(CARDINAL, ORD(s[i]) - ORD("0"));
|
|
|
+ IF e <= 9999 THEN e := e * 10 + d END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ WHILE e > 0 DO
|
|
|
+ IF esign THEN m := m / 10.0 ELSE m := m * 10.0 END;
|
|
|
+ DEC(e)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF s[i] # 0C THEN RETURN FALSE END;
|
|
|
+ IF neg THEN m := -m END;
|
|
|
+ rv.r := m;
|
|
|
+ b := rv.w;
|
|
|
+ RETURN TRUE
|
|
|
+ END ParseReal;
|
|
|
+
|
|
|
+(* ---------------- scopes, variables, constants ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE PushScope (tag: ARRAY OF CHAR; pnum: INTEGER;
|
|
|
+ depth: CARDINAL; isMod: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ IF nScopes >= MaxScope THEN Fail230(); RETURN END;
|
|
|
+ StrCpy(scopes[nScopes].tag, tag);
|
|
|
+ scopes[nScopes].pnum := pnum;
|
|
|
+ scopes[nScopes].depth := depth;
|
|
|
+ scopes[nScopes].parent := curScope;
|
|
|
+ scopes[nScopes].isMod := isMod;
|
|
|
+ curScope := VAL(INTEGER, nScopes);
|
|
|
+ INC(nScopes)
|
|
|
+ END PushScope;
|
|
|
+
|
|
|
+PROCEDURE PopScope;
|
|
|
+ BEGIN
|
|
|
+ IF curScope < 0 THEN RETURN END;
|
|
|
+ curScope := scopes[curScope].parent
|
|
|
+ END PopScope;
|
|
|
+
|
|
|
+PROCEDURE EnterVar (name: ARRAY OF CHAR; kind, typ, slot: INTEGER;
|
|
|
+ size: CARDINAL; depth: CARDINAL;
|
|
|
+ global, isAddr: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ IF nV >= MaxVar THEN Fail230(); RETURN END;
|
|
|
+ vars[nV].scope := curScope;
|
|
|
+ StrCpy(vars[nV].name, name);
|
|
|
+ vars[nV].kind := kind;
|
|
|
+ vars[nV].typ := typ;
|
|
|
+ vars[nV].slot := slot;
|
|
|
+ vars[nV].size := size;
|
|
|
+ vars[nV].depth := depth;
|
|
|
+ vars[nV].global := global;
|
|
|
+ vars[nV].isAddr := isAddr;
|
|
|
+ INC(nV)
|
|
|
+ END EnterVar;
|
|
|
+
|
|
|
+PROCEDURE FindVar (name: ARRAY OF CHAR): INTEGER;
|
|
|
+(* Innermost visible variable (scope chain walk). *)
|
|
|
+ VAR sc, i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ sc := curScope;
|
|
|
+ WHILE sc >= 0 DO
|
|
|
+ i := VAL(INTEGER, nV);
|
|
|
+ WHILE i > 0 DO
|
|
|
+ DEC(i);
|
|
|
+ IF (vars[i].scope = sc) & SymTab.Equal(vars[i].name, name) THEN
|
|
|
+ RETURN i
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ sc := scopes[sc].parent
|
|
|
+ END;
|
|
|
+ RETURN -1
|
|
|
+ END FindVar;
|
|
|
+
|
|
|
+PROCEDURE FindModVar (mod, name: ARRAY OF CHAR): INTEGER;
|
|
|
+(* Innermost (highest scope index) variable of a module scope. *)
|
|
|
+ VAR i: INTEGER;
|
|
|
+ best: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ best := -1;
|
|
|
+ i := 0;
|
|
|
+ WHILE VAL(CARDINAL, i) < nV DO
|
|
|
+ IF scopes[vars[i].scope].isMod
|
|
|
+ & SymTab.Equal(scopes[vars[i].scope].tag, mod)
|
|
|
+ & SymTab.Equal(vars[i].name, name) THEN
|
|
|
+ best := i
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ RETURN best
|
|
|
+ END FindModVar;
|
|
|
+
|
|
|
+PROCEDURE NoteConst (name: ARRAY OF CHAR; ck, ival: INTEGER;
|
|
|
+ bits: LONGCARD; tx: ARRAY OF CHAR; isOk: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ IF nC >= MaxCst THEN Fail230(); RETURN END;
|
|
|
+ csts[nC].scope := curScope;
|
|
|
+ StrCpy(csts[nC].name, name);
|
|
|
+ csts[nC].ck := ck;
|
|
|
+ csts[nC].ival := ival;
|
|
|
+ csts[nC].bits := bits;
|
|
|
+ StrCpy(csts[nC].text, tx);
|
|
|
+ csts[nC].ok := isOk;
|
|
|
+ INC(nC)
|
|
|
+ END NoteConst;
|
|
|
+
|
|
|
+PROCEDURE ConstFind (name: ARRAY OF CHAR): INTEGER;
|
|
|
+ VAR sc, i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ sc := curScope;
|
|
|
+ WHILE sc >= 0 DO
|
|
|
+ i := VAL(INTEGER, nC);
|
|
|
+ WHILE i > 0 DO
|
|
|
+ DEC(i);
|
|
|
+ IF (csts[i].scope = sc) & SymTab.Equal(csts[i].name, name) THEN
|
|
|
+ RETURN i
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ sc := scopes[sc].parent
|
|
|
+ END;
|
|
|
+ RETURN -1
|
|
|
+ END ConstFind;
|
|
|
+
|
|
|
+PROCEDURE EvalConstInt (n: AST.Node; VAR v: INTEGER): BOOLEAN;
|
|
|
+ VAR a, b: INTEGER;
|
|
|
+ ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ v := 0;
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN FALSE END;
|
|
|
+ IF n^.kind = AST.nkInt THEN
|
|
|
+ v := n^.num; RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkChar THEN
|
|
|
+ v := n^.num; RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkUn THEN
|
|
|
+ IF ~EvalConstInt(n^.left, a) THEN RETURN FALSE END;
|
|
|
+ IF n^.op = AST.opNeg THEN v := -a
|
|
|
+ ELSIF n^.op = AST.opPos THEN v := a
|
|
|
+ ELSE RETURN FALSE
|
|
|
+ END;
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkBin THEN
|
|
|
+ IF ~EvalConstInt(n^.left, a) THEN RETURN FALSE END;
|
|
|
+ IF ~EvalConstInt(n^.right, b) THEN RETURN FALSE END;
|
|
|
+ IF n^.op = SymTab.OpAdd THEN v := a + b
|
|
|
+ ELSIF n^.op = SymTab.OpSub THEN v := a - b
|
|
|
+ ELSIF n^.op = SymTab.OpTimes THEN v := a * b
|
|
|
+ ELSIF n^.op = SymTab.OpDiv THEN
|
|
|
+ IF b = 0 THEN RETURN FALSE END;
|
|
|
+ v := a DIV b
|
|
|
+ ELSIF n^.op = SymTab.OpMod THEN
|
|
|
+ IF b = 0 THEN RETURN FALSE END;
|
|
|
+ v := a MOD b
|
|
|
+ ELSIF n^.op = SymTab.OpEq THEN v := ORD(a = b)
|
|
|
+ ELSIF (n^.op = SymTab.OpNeq1) OR (n^.op = SymTab.OpNeq2) THEN
|
|
|
+ v := ORD(a # b)
|
|
|
+ ELSIF n^.op = SymTab.OpLt THEN v := ORD(a < b)
|
|
|
+ ELSIF n^.op = SymTab.OpLe THEN v := ORD(a <= b)
|
|
|
+ ELSIF n^.op = SymTab.OpGt THEN v := ORD(a > b)
|
|
|
+ ELSIF n^.op = SymTab.OpGe THEN v := ORD(a >= b)
|
|
|
+ ELSIF n^.op = SymTab.OpAnd THEN v := ORD(ODD(a) & ODD(b))
|
|
|
+ ELSIF n^.op = SymTab.OpOr THEN v := ORD(ODD(a) OR ODD(b))
|
|
|
+ ELSE RETURN FALSE
|
|
|
+ END;
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkName THEN
|
|
|
+ ci := ConstFind(n^.name);
|
|
|
+ IF (ci < 0) OR (csts[ci].ck # 0) THEN RETURN FALSE END;
|
|
|
+ v := csts[ci].ival;
|
|
|
+ RETURN TRUE
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END EvalConstInt;
|
|
|
+
|
|
|
+PROCEDURE EvalConstBits (n: AST.Node; VAR b: LONGCARD): BOOLEAN;
|
|
|
+ VAR rv, r2: RealView;
|
|
|
+ a: INTEGER;
|
|
|
+ ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ b := 0H;
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN FALSE END;
|
|
|
+ IF n^.kind = AST.nkReal THEN
|
|
|
+ RETURN ParseReal(n^.text, b)
|
|
|
+ ELSIF n^.kind = AST.nkUn THEN
|
|
|
+ IF ~EvalConstBits(n^.left, b) THEN RETURN FALSE END;
|
|
|
+ IF n^.op = AST.opNeg THEN
|
|
|
+ IF b DIV 8000000000000000H = 1 THEN
|
|
|
+ b := b - 8000000000000000H
|
|
|
+ ELSE b := b + 8000000000000000H
|
|
|
+ END
|
|
|
+ ELSIF n^.op # AST.opPos THEN RETURN FALSE
|
|
|
+ END;
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkBin THEN
|
|
|
+ IF ~EvalConstBits(n^.left, rv.w) THEN RETURN FALSE END;
|
|
|
+ IF ~EvalConstBits(n^.right, r2.w) THEN RETURN FALSE END;
|
|
|
+ IF n^.op = SymTab.OpAdd THEN rv.r := rv.r + r2.r
|
|
|
+ ELSIF n^.op = SymTab.OpSub THEN rv.r := rv.r - r2.r
|
|
|
+ ELSIF n^.op = SymTab.OpTimes THEN rv.r := rv.r * r2.r
|
|
|
+ ELSIF n^.op = SymTab.OpSlash THEN
|
|
|
+ IF r2.r = 0.0 THEN RETURN FALSE END;
|
|
|
+ rv.r := rv.r / r2.r
|
|
|
+ ELSE RETURN FALSE
|
|
|
+ END;
|
|
|
+ b := rv.w;
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkName THEN
|
|
|
+ ci := ConstFind(n^.name);
|
|
|
+ IF (ci < 0) OR (csts[ci].ck # 1) THEN RETURN FALSE END;
|
|
|
+ b := csts[ci].bits;
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkInt THEN
|
|
|
+ IF ~EvalConstInt(n, a) THEN RETURN FALSE END;
|
|
|
+ rv.r := VAL(REAL, a);
|
|
|
+ b := rv.w;
|
|
|
+ RETURN TRUE
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END EvalConstBits;
|
|
|
+
|
|
|
+PROCEDURE EvalConstText (n: AST.Node; VAR tx: ARRAY OF CHAR): BOOLEAN;
|
|
|
+ VAR ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ tx[0] := 0C;
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN FALSE END;
|
|
|
+ IF n^.kind = AST.nkStr THEN
|
|
|
+ StrCpy(tx, n^.text);
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF n^.kind = AST.nkName THEN
|
|
|
+ ci := ConstFind(n^.name);
|
|
|
+ IF (ci < 0) OR (csts[ci].ck # 2) THEN RETURN FALSE END;
|
|
|
+ StrCpy(tx, csts[ci].text);
|
|
|
+ RETURN TRUE
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END EvalConstText;
|
|
|
+
|
|
|
+(* ---------------- procedures ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE OpenModule (name: ARRAY OF CHAR);
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ StrCpy(modName, name);
|
|
|
+ nCode := 0;
|
|
|
+ nLab := 0; nFix := 0;
|
|
|
+ nG := 0; nGlb := 4;
|
|
|
+ nScopes := 0; curScope := -1;
|
|
|
+ nV := 0; nC := 0;
|
|
|
+ maxNum := 0; mainAddr := 0;
|
|
|
+ nInits := 0;
|
|
|
+ curDepth := 0; curProc := 0;
|
|
|
+ loopTop := 0;
|
|
|
+ ok := TRUE;
|
|
|
+ i := 0;
|
|
|
+ WHILE i <= MaxProc DO
|
|
|
+ procAddr[i] := -1;
|
|
|
+ procDepth[i] := 0;
|
|
|
+ procParent[i] := -1;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END OpenModule;
|
|
|
+
|
|
|
+PROCEDURE ProcEntry (num: INTEGER; nLoc: CARDINAL);
|
|
|
+ VAR k : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF (num >= 0) & (num <= MaxProc) THEN
|
|
|
+ procAddr[num] := VAL(INTEGER, nCode);
|
|
|
+ IF VAL(CARDINAL, num) > maxNum THEN
|
|
|
+ maxNum := VAL(CARDINAL, num)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF nLoc > 255 THEN k := 255 ELSE k := nLoc END;
|
|
|
+ EmitOpB(OPenter, 255 - k)
|
|
|
+ END ProcEntry;
|
|
|
+
|
|
|
+PROCEDURE Leave (nPar: CARDINAL; func: BOOLEAN);
|
|
|
+ BEGIN
|
|
|
+ IF nPar > 255 THEN nPar := 255 END;
|
|
|
+ IF func THEN EmitOpB(OPfctLeave, nPar)
|
|
|
+ ELSE EmitOpB(OPprocLeave, nPar)
|
|
|
+ END
|
|
|
+ END Leave;
|
|
|
+
|
|
|
+PROCEDURE CallProc (num: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPprocCall, VAL(CARDINAL, num))
|
|
|
+ END CallProc;
|
|
|
+
|
|
|
+PROCEDURE CallNested (num: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPnestedCall, VAL(CARDINAL, num))
|
|
|
+ END CallNested;
|
|
|
+
|
|
|
+PROCEDURE CallDisplay (num: INTEGER; np: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPloadOuterN, np);
|
|
|
+ EmitOpB(OPcallFrame, VAL(CARDINAL, num))
|
|
|
+ END CallDisplay;
|
|
|
+
|
|
|
+PROCEDURE CallByRule (pnum: INTEGER);
|
|
|
+(* ED for frameless-parent callees, EC for direct children,
|
|
|
+ EE with display walk otherwise. *)
|
|
|
+ VAR pd, pp, np: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (pnum < 1) OR (pnum > MaxProc) THEN Fail230(); RETURN END;
|
|
|
+ pd := VAL(INTEGER, procDepth[pnum]);
|
|
|
+ pp := procParent[pnum];
|
|
|
+ IF pd <= 1 THEN CallProc(pnum)
|
|
|
+ ELSIF pp = curProc THEN CallNested(pnum)
|
|
|
+ ELSIF (pp < 0) OR (curProc = 0) THEN Fail230()
|
|
|
+ ELSE
|
|
|
+ np := VAL(INTEGER, curDepth) - 1 - VAL(INTEGER, procDepth[pp]);
|
|
|
+ IF np < 0 THEN Fail230(); RETURN END;
|
|
|
+ CallDisplay(pnum, VAL(CARDINAL, np))
|
|
|
+ END
|
|
|
+ END CallByRule;
|
|
|
+
|
|
|
+(* ---------------- image assembly ---------------- *)
|
|
|
+
|
|
|
+PROCEDURE Put32At (off: CARDINAL; v: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ img[off] := CHR(v MOD 256);
|
|
|
+ img[off + 1] := CHR((v DIV 256) MOD 256);
|
|
|
+ img[off + 2] := CHR((v DIV 65536) MOD 256);
|
|
|
+ img[off + 3] := CHR(v DIV 16777216)
|
|
|
+ END Put32At;
|
|
|
+
|
|
|
+PROCEDURE Put64At (off: CARDINAL; v: LONGCARD);
|
|
|
+ VAR j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ FOR j := 0 TO 7 DO
|
|
|
+ img[off + j] := CHR(VAL(CARDINAL, v MOD 256));
|
|
|
+ v := v DIV 256
|
|
|
+ END
|
|
|
+ END Put64At;
|
|
|
+
|
|
|
+PROCEDURE PutS64At (off, addr, slot: CARDINAL);
|
|
|
+ VAR mag : LONGCARD;
|
|
|
+ bits : LONGCARD;
|
|
|
+ j : CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF addr >= slot THEN bits := VAL(LONGCARD, addr - slot)
|
|
|
+ ELSE
|
|
|
+ mag := VAL(LONGCARD, slot - addr);
|
|
|
+ bits := 0FFFFFFFFFFFFFFFFH - mag + 1H
|
|
|
+ END;
|
|
|
+ FOR j := 0 TO 7 DO
|
|
|
+ img[off + j] := CHR(VAL(CARDINAL, bits MOD 256));
|
|
|
+ bits := bits DIV 256
|
|
|
+ END
|
|
|
+ END PutS64At;
|
|
|
+
|
|
|
+PROCEDURE EmitPrint;
|
|
|
+ VAR l1, l2 : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ EmitOpB(OPenter, 250);
|
|
|
+ EmitOpB(OPimmB, 16); EmitOp(0D2H); EmitOpB(OPstoreGlb, 0);
|
|
|
+ EmitOp(OPimm0); EmitOp(OPimm0);
|
|
|
+ EmitOpB(OPstoreGlb, 1); EmitOpB(OPstoreGlb, 2);
|
|
|
+ EmitOp(03H);
|
|
|
+ l1 := NewLabel(); DefLabel(l1);
|
|
|
+ EmitOpB(OPloadGlb, 1); EmitOp(OPinc); EmitOpB(OPstoreGlb, 1);
|
|
|
+ EmitOp(OPdup); EmitOpB(OPimmB, 10); EmitOp(OPumod);
|
|
|
+ EmitOp(OPswap); EmitOpB(OPimmB, 10); EmitOp(OPudiv);
|
|
|
+ EmitOp(OPdup); EmitOp(OPaeq0);
|
|
|
+ Jz(l1);
|
|
|
+ EmitOp(OPext); EmitOp(SUBdrop);
|
|
|
+ l2 := NewLabel(); DefLabel(l2);
|
|
|
+ EmitOpB(OPimmB, 48); EmitOp(OPadd); EmitOpB(OPstoreGlb, 3);
|
|
|
+ EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
|
|
|
+ EmitOp(OPimm0); EmitOpB(OPloadGlb, 3); EmitOp(1DH);
|
|
|
+ EmitOpB(OPloadGlb, 2); EmitOp(OPinc); EmitOpB(OPstoreGlb, 2);
|
|
|
+ EmitOpB(OPloadGlb, 1); EmitOp(OPdec); EmitOpB(OPstoreGlb, 1);
|
|
|
+ EmitOpB(OPloadGlb, 1); EmitOp(OPaeq0);
|
|
|
+ Jz(l2);
|
|
|
+ EmitOpB(OPloadGlb, 0); EmitOpB(OPloadGlb, 2); EmitOp(OPadd);
|
|
|
+ EmitOp(OPimm0); EmitOp(OPimm0); EmitOp(1DH);
|
|
|
+ EmitOpB(OPloadGlb, 0);
|
|
|
+ EmitOpB(OPimmB, 1); EmitOp(OPsys);
|
|
|
+ EmitOpB(OPimmB, 3); EmitOp(0D2H);
|
|
|
+ EmitOp(OPdup); EmitOp(OPimm0); EmitOpB(OPimmB, 13); EmitOp(1DH);
|
|
|
+ EmitOp(OPdup); EmitOpB(OPimmB, 1); EmitOpB(OPimmB, 10); EmitOp(1DH);
|
|
|
+ EmitOp(OPdup); EmitOpB(OPimmB, 2); EmitOp(OPimm0); EmitOp(1DH);
|
|
|
+ EmitOpB(OPimmB, 1); EmitOp(OPsys);
|
|
|
+ EmitOpB(OPfctLeave, 0)
|
|
|
+ END EmitPrint;
|
|
|
+
|
|
|
+PROCEDURE EndModule;
|
|
|
+ VAR i : CARDINAL;
|
|
|
+ codeOff, p1, pt, prNum, tabBytes : CARDINAL;
|
|
|
+ k : CARDINAL;
|
|
|
+ addr : CARDINAL;
|
|
|
+ exitIdx : INTEGER;
|
|
|
+ sum : CARDINAL;
|
|
|
+ fname : ARRAY [0 .. 127] OF CHAR;
|
|
|
+ f : FileIO.File;
|
|
|
+ ch : CHAR;
|
|
|
+ BEGIN
|
|
|
+ prNum := maxNum + 1;
|
|
|
+ exitIdx := -1;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < VAL(CARDINAL, nV) DO
|
|
|
+ IF (vars[i].scope = 0) & (vars[i].kind = SymTab.KindVar)
|
|
|
+ & SymTab.Equal(vars[i].name, "ExitCode")
|
|
|
+ & SymTab.IsIntFamily(vars[i].typ) THEN
|
|
|
+ exitIdx := vars[i].slot
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ IF exitIdx >= 0 THEN
|
|
|
+ EmitOpB(OPloadGlb, VAL(CARDINAL, exitIdx));
|
|
|
+ EmitOpB(OPprocCall, prNum);
|
|
|
+ EmitOp(OPext); EmitOp(SUBdrop)
|
|
|
+ END;
|
|
|
+ EmitOp(OPend);
|
|
|
+ p1 := nCode;
|
|
|
+ EmitPrint;
|
|
|
+ i := 0;
|
|
|
+ WHILE i <= MaxImg DO img[i] := 0C; INC(i) END;
|
|
|
+ img[0] := "M"; img[1] := "C"; img[2] := "6"; img[3] := "4";
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < 16) & (modName[i] # 0C) DO
|
|
|
+ img[HeadSize + DName + i] := modName[i]; INC(i)
|
|
|
+ END;
|
|
|
+ img[HeadSize + DFlags] := CHR(4);
|
|
|
+ img[HeadSize + DVarCount] := CHR(nG MOD 256);
|
|
|
+ img[HeadSize + DDepCount] := 0C;
|
|
|
+ codeOff := DVarSizes + nG * 8;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nCode DO
|
|
|
+ img[HeadSize + codeOff + i] := code[i]; INC(i)
|
|
|
+ END;
|
|
|
+ pt := codeOff + nCode;
|
|
|
+ tabBytes := (maxNum + 2) * 8;
|
|
|
+ Put64At(HeadSize + DProcs, VAL(LONGCARD, pt));
|
|
|
+ k := 0;
|
|
|
+ WHILE k <= maxNum + 1 DO
|
|
|
+ IF k = 0 THEN addr := codeOff + mainAddr
|
|
|
+ ELSIF k <= maxNum THEN
|
|
|
+ IF procAddr[k] < 0 THEN addr := pt + k * 8
|
|
|
+ ELSE addr := VAL(CARDINAL, procAddr[k]) + codeOff
|
|
|
+ END
|
|
|
+ ELSE addr := codeOff + p1
|
|
|
+ END;
|
|
|
+ PutS64At(HeadSize + pt + k * 8, addr, pt + k * 8);
|
|
|
+ INC(k)
|
|
|
+ END;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nG DO
|
|
|
+ Put64At(HeadSize + DVarSizes + i * 8,
|
|
|
+ VAL(LONGCARD, gSize[i] * 8));
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ sum := 0;
|
|
|
+ i := HeadSize;
|
|
|
+ WHILE i < HeadSize + pt + tabBytes DO
|
|
|
+ IF ~((i >= 352) & (i <= 355)) THEN
|
|
|
+ sum := sum + ORD(img[i])
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ Put32At(HeadSize + DChecksum, sum);
|
|
|
+ fname[0] := 0C;
|
|
|
+ StrCpy(fname, modName);
|
|
|
+ i := StrLen(fname);
|
|
|
+ fname[i] := "."; fname[i + 1] := "M"; fname[i + 2] := "C";
|
|
|
+ fname[i + 3] := "4"; fname[i + 4] := 0C;
|
|
|
+ FileIO.Open(f, fname, TRUE);
|
|
|
+ IF FileIO.Okay THEN
|
|
|
+ i := 0;
|
|
|
+ WHILE i < HeadSize + pt + tabBytes DO
|
|
|
+ ch := img[i];
|
|
|
+ FileIO.Write(f, ch);
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ FileIO.Close(f)
|
|
|
+ END
|
|
|
+ END EndModule;
|
|
|
+
|
|
|
+(* ---------------- expression lowering ---------------- *)
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE IsRealTyp (t: INTEGER): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
+ END IsRealTyp;
|
|
|
+
|
|
|
+PROCEDURE EmitLoadEntry (vi: INTEGER);
|
|
|
+(* Pushes a scalar variable value. *)
|
|
|
+ VAR np: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF (vi < 0) OR (vi >= VAL(INTEGER, nV)) THEN
|
|
|
+ Fail230(); PushInt(0); RETURN
|
|
|
+ END;
|
|
|
+ IF vars[vi].global THEN
|
|
|
+ EmitOpB(OPloadGlb, VAL(CARDINAL, vars[vi].slot))
|
|
|
+ ELSIF vars[vi].depth = curDepth THEN
|
|
|
+ IF vars[vi].isAddr THEN
|
|
|
+ LoadLocal(vars[vi].slot); LoadIndir0
|
|
|
+ ELSE LoadLocal(vars[vi].slot)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ np := curDepth - 1 - vars[vi].depth;
|
|
|
+ FrameAddr(vars[vi].slot, np);
|
|
|
+ LoadIndir;
|
|
|
+ IF vars[vi].isAddr THEN LoadIndir0 END
|
|
|
+ END
|
|
|
+ END EmitLoadEntry;
|
|
|
+
|
|
|
+PROCEDURE EmitStoreEntry (vi: INTEGER);
|
|
|
+(* Pops into a scalar variable (direct only). *)
|
|
|
+ BEGIN
|
|
|
+ IF (vi < 0) OR (vi >= VAL(INTEGER, nV)) THEN
|
|
|
+ Fail230(); EmitOp(OPext); EmitOp(SUBdrop); RETURN
|
|
|
+ END;
|
|
|
+ IF vars[vi].global THEN
|
|
|
+ EmitOpB(OPstoreGlb, VAL(CARDINAL, vars[vi].slot))
|
|
|
+ ELSIF vars[vi].depth = curDepth THEN
|
|
|
+ IF vars[vi].isAddr THEN StoreIndir0
|
|
|
+ ELSE StoreLocal(vars[vi].slot)
|
|
|
+ END
|
|
|
+ ELSE Fail230()
|
|
|
+ END
|
|
|
+ END EmitStoreEntry;
|
|
|
+
|
|
|
+PROCEDURE EmitAddrEntry (vi: INTEGER);
|
|
|
+(* Pushes a variable address (for VAR actuals and indirect stores). *)
|
|
|
+ VAR np: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF (vi < 0) OR (vi >= VAL(INTEGER, nV)) THEN
|
|
|
+ Fail230(); PushInt(0); RETURN
|
|
|
+ END;
|
|
|
+ IF vars[vi].global THEN
|
|
|
+ EmitOpB(OPglobalAddr, VAL(CARDINAL, vars[vi].slot))
|
|
|
+ ELSIF vars[vi].depth = curDepth THEN
|
|
|
+ IF vars[vi].isAddr THEN LoadLocal(vars[vi].slot)
|
|
|
+ ELSE EmitSlotB(OPlocalAddr, vars[vi].slot)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ np := curDepth - 1 - vars[vi].depth;
|
|
|
+ FrameAddr(vars[vi].slot, np);
|
|
|
+ IF vars[vi].isAddr THEN LoadIndir END
|
|
|
+ END
|
|
|
+ END EmitAddrEntry;
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE ResolveName (n: AST.Node): INTEGER;
|
|
|
+(* Variable entry for a designator head (tag-aware). *)
|
|
|
+ BEGIN
|
|
|
+ IF n = NIL THEN Fail230(); RETURN -1 END;
|
|
|
+ IF n^.tag[0] # 0C THEN
|
|
|
+ RETURN FindModVar(n^.tag, n^.name)
|
|
|
+ END;
|
|
|
+ RETURN FindVar(n^.name)
|
|
|
+ END ResolveName;
|
|
|
+
|
|
|
+PROCEDURE EmitAddr (n: AST.Node);
|
|
|
+(* Pushes the address of a designator (byte address). *)
|
|
|
+ VAR vi: INTEGER;
|
|
|
+ arrTyp, elemTyp: INTEGER;
|
|
|
+ ix: AST.Node;
|
|
|
+ lo: INTEGER;
|
|
|
+ eb: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ IF n^.kind = AST.nkName THEN
|
|
|
+ vi := ResolveName(n);
|
|
|
+ IF vi < 0 THEN Fail230(); PushInt(0); RETURN END;
|
|
|
+ EmitAddrEntry(vi)
|
|
|
+ ELSIF n^.kind = AST.nkField THEN
|
|
|
+ IF n^.tag[0] # 0C THEN
|
|
|
+ vi := FindModVar(n^.tag, n^.name);
|
|
|
+ IF vi < 0 THEN Fail230(); PushInt(0); RETURN END;
|
|
|
+ EmitOpB(OPglobalAddr, VAL(CARDINAL, vars[vi].slot))
|
|
|
+ ELSE
|
|
|
+ EmitAddr(n^.left);
|
|
|
+ IF SymTab.FieldOffset(n^.left^.typ, n^.name) > 0 THEN
|
|
|
+ PushInt(SymTab.FieldOffset(n^.left^.typ, n^.name) * 8);
|
|
|
+ EmitOp(OPadd)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSIF n^.kind = AST.nkIndex THEN
|
|
|
+ EmitAddr(n^.left);
|
|
|
+ arrTyp := n^.left^.typ;
|
|
|
+ ix := n^.right;
|
|
|
+ WHILE (ix # NIL) & ok DO
|
|
|
+ elemTyp := SymTab.ArrayElem(arrTyp);
|
|
|
+ lo := SymTab.ArrayLo(arrTyp);
|
|
|
+ eb := SymTab.TypeSlots(elemTyp) * 8;
|
|
|
+ EmitExpr(ix);
|
|
|
+ PushInt(lo);
|
|
|
+ EmitOp(OPsub);
|
|
|
+ PushInt(VAL(INTEGER, eb));
|
|
|
+ EmitOp(OPumul);
|
|
|
+ EmitOp(OPadd);
|
|
|
+ arrTyp := elemTyp;
|
|
|
+ ix := ix^.next
|
|
|
+ END
|
|
|
+ ELSIF n^.kind = AST.nkDeref THEN
|
|
|
+ EmitExpr(n^.left)
|
|
|
+ ELSE Fail230()
|
|
|
+ END
|
|
|
+ END EmitAddr;
|
|
|
+
|
|
|
+PROCEDURE PushConstName (n: AST.Node);
|
|
|
+(* Pushes a CONST value (inlined; strings handled by caller path). *)
|
|
|
+ VAR ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ ci := ConstFind(n^.name);
|
|
|
+ IF (ci < 0) OR ~csts[ci].ok THEN
|
|
|
+ IF SymTab.Equal(n^.name, "NIL") THEN PushInt(0)
|
|
|
+ ELSE Fail230(); PushInt(0)
|
|
|
+ END;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ IF csts[ci].ck = 0 THEN PushInt(csts[ci].ival)
|
|
|
+ ELSIF csts[ci].ck = 1 THEN PushBits(csts[ci].bits)
|
|
|
+ ELSE Fail230(); PushBits(0H)
|
|
|
+ END
|
|
|
+ END PushConstName;
|
|
|
+
|
|
|
+PROCEDURE ConstTextOf (n: AST.Node; VAR tx: ARRAY OF CHAR): BOOLEAN;
|
|
|
+(* TRUE + text when n names a defined string CONST. *)
|
|
|
+ VAR ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ tx[0] := 0C;
|
|
|
+ IF (n = NIL) OR (n^.kind # AST.nkName) THEN RETURN FALSE END;
|
|
|
+ ci := ConstFind(n^.name);
|
|
|
+ IF (ci < 0) OR ~csts[ci].ok OR (csts[ci].ck # 2) THEN
|
|
|
+ RETURN FALSE
|
|
|
+ END;
|
|
|
+ StrCpy(tx, csts[ci].text);
|
|
|
+ RETURN TRUE
|
|
|
+ END ConstTextOf;
|
|
|
+
|
|
|
+PROCEDURE EmitCall (callee, actuals: AST.Node; pnum: INTEGER;
|
|
|
+ wantValue: BOOLEAN);
|
|
|
+ VAR ts: ARRAY [0 .. 63] OF INTEGER;
|
|
|
+ n, i: CARDINAL;
|
|
|
+ a: AST.Node;
|
|
|
+ ft: INTEGER;
|
|
|
+ fv: BOOLEAN;
|
|
|
+ ret: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (pnum < 1) OR (pnum > MaxProc) THEN Fail230(); RETURN END;
|
|
|
+ n := 0;
|
|
|
+ a := actuals;
|
|
|
+ WHILE (a # NIL) & (n <= 63) & ok DO
|
|
|
+ ft := SymTab.ParamTypeByNum(pnum, n);
|
|
|
+ fv := SymTab.ParamIsVarByNum(pnum, n);
|
|
|
+ ts[n] := TempGlobal();
|
|
|
+ IF fv THEN EmitAddr(a)
|
|
|
+ ELSE
|
|
|
+ EmitExpr(a);
|
|
|
+ IF IsRealTyp(ft) & ~IsRealTyp(a^.typ) THEN
|
|
|
+ EmitOp(OPintToLong); EmitOp(OPlongToReal)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ StoreTemp(ts[n]);
|
|
|
+ INC(n);
|
|
|
+ a := a^.next
|
|
|
+ END;
|
|
|
+ IF a # NIL THEN Fail230(); RETURN END;
|
|
|
+ i := n;
|
|
|
+ WHILE i > 0 DO
|
|
|
+ DEC(i);
|
|
|
+ LoadTemp(ts[i])
|
|
|
+ END;
|
|
|
+ CallByRule(pnum);
|
|
|
+ ret := SymTab.ProcRetByNum(pnum);
|
|
|
+ IF ~wantValue & (ret # SymTab.InvalidType) THEN
|
|
|
+ EmitOp(OPext); EmitOp(SUBdrop)
|
|
|
+ END
|
|
|
+ END EmitCall;
|
|
|
+
|
|
|
+PROCEDURE EmitExpr (n: AST.Node);
|
|
|
+ VAR vi: INTEGER;
|
|
|
+ isR: BOOLEAN;
|
|
|
+ t: INTEGER;
|
|
|
+ b: LONGCARD;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ t := n^.typ;
|
|
|
+ IF n^.kind = AST.nkInt THEN PushInt(n^.num)
|
|
|
+ ELSIF n^.kind = AST.nkChar THEN PushInt(n^.num)
|
|
|
+ ELSIF n^.kind = AST.nkReal THEN
|
|
|
+ IF ~ParseReal(n^.text, b) THEN Fail230(); PushBits(0H)
|
|
|
+ ELSE PushBits(b)
|
|
|
+ END
|
|
|
+ ELSIF n^.kind = AST.nkStr THEN Fail230()
|
|
|
+ ELSIF n^.kind = AST.nkName THEN
|
|
|
+ vi := ResolveName(n);
|
|
|
+ IF vi >= 0 THEN EmitLoadEntry(vi)
|
|
|
+ ELSE PushConstName(n)
|
|
|
+ END
|
|
|
+ ELSIF n^.kind = AST.nkBin THEN
|
|
|
+ isR := IsRealTyp(t);
|
|
|
+ IF (SymTab.ClassOf(n^.left^.typ) = SymTab.ClArray)
|
|
|
+ OR (SymTab.ClassOf(n^.right^.typ) = SymTab.ClArray) THEN
|
|
|
+ Fail230(); PushInt(0); RETURN
|
|
|
+ END;
|
|
|
+ EmitExpr(n^.left);
|
|
|
+ EmitExpr(n^.right);
|
|
|
+ IF (n^.op = SymTab.OpEq) OR (n^.op = SymTab.OpNeq1)
|
|
|
+ OR (n^.op = SymTab.OpNeq2) OR (n^.op = SymTab.OpLt)
|
|
|
+ OR (n^.op = SymTab.OpLe) OR (n^.op = SymTab.OpGt)
|
|
|
+ OR (n^.op = SymTab.OpGe) THEN
|
|
|
+ isR := IsRealTyp(n^.left^.typ)
|
|
|
+ END;
|
|
|
+ IF n^.op = SymTab.OpAdd THEN
|
|
|
+ IF isR THEN EmitOp(OPrAdd) ELSE EmitOp(OPadd) END
|
|
|
+ ELSIF n^.op = SymTab.OpSub THEN
|
|
|
+ IF isR THEN EmitOp(OPrSub) ELSE EmitOp(OPsub) END
|
|
|
+ ELSIF n^.op = SymTab.OpTimes THEN
|
|
|
+ IF isR THEN EmitOp(OPrMul) ELSE EmitOp(OPumul) END
|
|
|
+ ELSIF n^.op = SymTab.OpSlash THEN
|
|
|
+ IF isR THEN EmitOp(OPrDiv) ELSE EmitOp(OPidiv) END
|
|
|
+ ELSIF n^.op = SymTab.OpDiv THEN EmitOp(OPidiv)
|
|
|
+ ELSIF n^.op = SymTab.OpMod THEN
|
|
|
+ vi := TempGlobal();
|
|
|
+ StoreTemp(vi);
|
|
|
+ EmitOp(OPdup);
|
|
|
+ LoadTemp(vi);
|
|
|
+ EmitOp(OPidiv);
|
|
|
+ LoadTemp(vi);
|
|
|
+ EmitOp(OPimul);
|
|
|
+ EmitOp(OPsub)
|
|
|
+ ELSIF n^.op = SymTab.OpOr THEN EmitOp(OPor)
|
|
|
+ ELSIF n^.op = SymTab.OpAnd THEN EmitOp(OPand)
|
|
|
+ ELSIF n^.op = SymTab.OpEq THEN
|
|
|
+ IF isR THEN
|
|
|
+ EmitOp(OPrCmp); EmitOp(OPor); EmitOp(OPnot)
|
|
|
+ ELSE EmitOp(OPeq)
|
|
|
+ END
|
|
|
+ ELSIF (n^.op = SymTab.OpNeq1) OR (n^.op = SymTab.OpNeq2) THEN
|
|
|
+ IF isR THEN EmitOp(OPrCmp); EmitOp(OPor)
|
|
|
+ ELSE EmitOp(OPne)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = SymTab.OpLt THEN
|
|
|
+ IF isR THEN
|
|
|
+ EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop)
|
|
|
+ ELSE EmitOp(OPilt)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = SymTab.OpLe THEN
|
|
|
+ IF isR THEN
|
|
|
+ EmitOp(OPext); EmitOp(SUBdrop); EmitOp(OPnot)
|
|
|
+ ELSE EmitOp(OPile)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = SymTab.OpGt THEN
|
|
|
+ IF isR THEN EmitOp(OPext); EmitOp(SUBdrop)
|
|
|
+ ELSE EmitOp(OPigt)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = SymTab.OpGe THEN
|
|
|
+ IF isR THEN
|
|
|
+ EmitOp(OPswap); EmitOp(OPext); EmitOp(SUBdrop);
|
|
|
+ EmitOp(OPnot)
|
|
|
+ ELSE EmitOp(OPige)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = SymTab.OpIn THEN EmitOp(OPbitIn)
|
|
|
+ ELSE Fail230()
|
|
|
+ END
|
|
|
+ ELSIF n^.kind = AST.nkUn THEN
|
|
|
+ EmitExpr(n^.left);
|
|
|
+ IF n^.op = AST.opNeg THEN
|
|
|
+ IF IsRealTyp(t) THEN
|
|
|
+ PushBits(0H); EmitOp(OPswap); EmitOp(OPrSub)
|
|
|
+ ELSE
|
|
|
+ EmitOp(OPimm0); EmitOp(OPswap); EmitOp(OPsub)
|
|
|
+ END
|
|
|
+ ELSIF n^.op = AST.opNot THEN EmitOp(OPnot)
|
|
|
+ END
|
|
|
+ ELSIF (n^.kind = AST.nkField) OR (n^.kind = AST.nkIndex)
|
|
|
+ OR (n^.kind = AST.nkDeref) THEN
|
|
|
+ IF SymTab.TypeSlots(t) # 1 THEN Fail230(); PushInt(0); RETURN END;
|
|
|
+ EmitAddr(n);
|
|
|
+ LoadIndir
|
|
|
+ ELSIF n^.kind = AST.nkCallExpr THEN
|
|
|
+ EmitCall(n^.left, n^.right, n^.num, TRUE)
|
|
|
+ ELSE Fail230()
|
|
|
+ END
|
|
|
+ END EmitExpr;
|
|
|
+
|
|
|
+PROCEDURE EmitStrCopy (dst: AST.Node; tx: ARRAY OF CHAR);
|
|
|
+(* dst[i] := char slots + NUL terminator for a literal. *)
|
|
|
+ VAR L, i: CARDINAL;
|
|
|
+ q: CHAR;
|
|
|
+ BEGIN
|
|
|
+ L := StrLen(tx);
|
|
|
+ IF L < 2 THEN Fail230(); RETURN END;
|
|
|
+ q := tx[0];
|
|
|
+ i := 1;
|
|
|
+ WHILE (i < L) & (tx[i] # q) & (tx[i] # 0C) DO
|
|
|
+ EmitAddr(dst);
|
|
|
+ PushInt(VAL(INTEGER, i - 1) * 8);
|
|
|
+ EmitOp(OPadd);
|
|
|
+ PushInt(ORD(tx[i]));
|
|
|
+ StoreIndir0;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ EmitAddr(dst);
|
|
|
+ PushInt(VAL(INTEGER, i - 1) * 8);
|
|
|
+ EmitOp(OPadd);
|
|
|
+ PushInt(0);
|
|
|
+ StoreIndir0
|
|
|
+ END EmitStrCopy;
|
|
|
+
|
|
|
+PROCEDURE EmitAssign (dst, src: AST.Node);
|
|
|
+ VAR dt, st: INTEGER;
|
|
|
+ sz: CARDINAL;
|
|
|
+ vi: INTEGER;
|
|
|
+ tx: ARRAY [0 .. 63] OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF (dst = NIL) OR (src = NIL) OR ~ok THEN RETURN END;
|
|
|
+ dt := dst^.typ; st := src^.typ;
|
|
|
+ IF SymTab.TypeSlots(dt) > 1 THEN
|
|
|
+ IF src^.kind = AST.nkStr THEN
|
|
|
+ EmitStrCopy(dst, src^.text)
|
|
|
+ ELSIF (src^.kind = AST.nkName) & ConstTextOf(src, tx) THEN
|
|
|
+ EmitStrCopy(dst, tx)
|
|
|
+ ELSIF SymTab.TypeSlots(st) > 1 THEN
|
|
|
+ EmitAddr(dst);
|
|
|
+ EmitAddr(src);
|
|
|
+ sz := SymTab.TypeSlots(dt) * 8;
|
|
|
+ PushInt(VAL(INTEGER, sz));
|
|
|
+ EmitOp(OPcopyBlock)
|
|
|
+ ELSE Fail230()
|
|
|
+ END;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ IF (dst^.kind = AST.nkName) THEN
|
|
|
+ vi := ResolveName(dst);
|
|
|
+ IF (vi >= 0)
|
|
|
+ & (vars[vi].global OR (vars[vi].depth = curDepth)) THEN
|
|
|
+ IF ~vars[vi].global & vars[vi].isAddr THEN
|
|
|
+ LoadLocal(vars[vi].slot)
|
|
|
+ END;
|
|
|
+ EmitExpr(src);
|
|
|
+ IF IsRealTyp(dt) & ~IsRealTyp(st) THEN
|
|
|
+ EmitOp(OPintToLong); EmitOp(OPlongToReal)
|
|
|
+ END;
|
|
|
+ EmitStoreEntry(vi);
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ EmitAddr(dst);
|
|
|
+ EmitExpr(src);
|
|
|
+ IF IsRealTyp(dt) & ~IsRealTyp(st) THEN
|
|
|
+ EmitOp(OPintToLong); EmitOp(OPlongToReal)
|
|
|
+ END;
|
|
|
+ StoreIndir0
|
|
|
+ END EmitAssign;
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE EmitStoreName (n: AST.Node);
|
|
|
+ VAR vi: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ vi := ResolveName(n);
|
|
|
+ IF vi < 0 THEN
|
|
|
+ Fail230();
|
|
|
+ EmitOp(OPext); EmitOp(SUBdrop);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ EmitStoreEntry(vi)
|
|
|
+ END EmitStoreName;
|
|
|
+
|
|
|
+(* ---------------- statement lowering ---------------- *)
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE EmitStmts (n: AST.Node);
|
|
|
+ BEGIN
|
|
|
+ WHILE (n # NIL) & ok DO
|
|
|
+ EmitStmt(n);
|
|
|
+ n := n^.next
|
|
|
+ END
|
|
|
+ END EmitStmts;
|
|
|
+
|
|
|
+PROCEDURE EmitStmt (n: AST.Node);
|
|
|
+ VAR l1, l2: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ IF n^.kind = AST.nkAssign THEN
|
|
|
+ EmitAssign(n^.left, n^.right)
|
|
|
+ ELSIF n^.kind = AST.nkCall THEN
|
|
|
+ EmitCall(n^.left, n^.right, n^.num, FALSE)
|
|
|
+ ELSIF n^.kind = AST.nkIf THEN
|
|
|
+ l1 := NewLabel(); l2 := NewLabel();
|
|
|
+ EmitExpr(n^.left);
|
|
|
+ Jz(l1);
|
|
|
+ EmitStmts(n^.right);
|
|
|
+ Jmp(l2);
|
|
|
+ DefLabel(l1);
|
|
|
+ EmitStmts(n^.extra);
|
|
|
+ DefLabel(l2)
|
|
|
+ ELSIF n^.kind = AST.nkWhile THEN
|
|
|
+ l1 := NewLabel(); l2 := NewLabel();
|
|
|
+ DefLabel(l1);
|
|
|
+ EmitExpr(n^.left);
|
|
|
+ Jz(l2);
|
|
|
+ EmitStmts(n^.right);
|
|
|
+ Jmp(l1);
|
|
|
+ DefLabel(l2)
|
|
|
+ ELSIF n^.kind = AST.nkRepeat THEN
|
|
|
+ l1 := NewLabel();
|
|
|
+ DefLabel(l1);
|
|
|
+ EmitStmts(n^.left);
|
|
|
+ EmitExpr(n^.right);
|
|
|
+ Jz(l1)
|
|
|
+ ELSIF n^.kind = AST.nkLoop THEN
|
|
|
+ l1 := NewLabel(); l2 := NewLabel();
|
|
|
+ IF loopTop > MaxLoop THEN Fail230(); RETURN END;
|
|
|
+ loopSt[loopTop] := l2; INC(loopTop);
|
|
|
+ DefLabel(l1);
|
|
|
+ EmitStmts(n^.left);
|
|
|
+ Jmp(l1);
|
|
|
+ DefLabel(l2);
|
|
|
+ DEC(loopTop)
|
|
|
+ ELSIF n^.kind = AST.nkExit THEN
|
|
|
+ IF loopTop = 0 THEN Fail230(); RETURN END;
|
|
|
+ Jmp(loopSt[loopTop - 1])
|
|
|
+ ELSIF n^.kind = AST.nkFor THEN EmitFor(n)
|
|
|
+ ELSIF n^.kind = AST.nkReturn THEN
|
|
|
+ IF curProc < 1 THEN Fail230(); RETURN END;
|
|
|
+ IF n^.left # NIL THEN EmitExpr(n^.left) END;
|
|
|
+ IF SymTab.ProcRetByNum(curProc) = SymTab.InvalidType THEN
|
|
|
+ Leave(SymTab.ProcNParByNum(curProc), FALSE)
|
|
|
+ ELSE
|
|
|
+ Leave(SymTab.ProcNParByNum(curProc), TRUE)
|
|
|
+ END
|
|
|
+ ELSE Fail230()
|
|
|
+ END
|
|
|
+ END EmitStmt;
|
|
|
+
|
|
|
+(* ---------------- declaration walking ---------------- *)
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE AllocGlobal (size: CARDINAL): INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (nG > MaxGlb) OR (nGlb + size - 1 > MaxGlb) THEN
|
|
|
+ Fail230(); RETURN 4
|
|
|
+ END;
|
|
|
+ gBase[nG] := nGlb;
|
|
|
+ gSize[nG] := size;
|
|
|
+ INC(nG);
|
|
|
+ nGlb := nGlb + size;
|
|
|
+ RETURN VAL(INTEGER, gBase[nG - 1])
|
|
|
+ END AllocGlobal;
|
|
|
+
|
|
|
+PROCEDURE EmitDecls (n: AST.Node);
|
|
|
+ VAR sz: CARDINAL;
|
|
|
+ sl: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ WHILE (n # NIL) & ok DO
|
|
|
+ IF n^.kind = AST.nkVar THEN
|
|
|
+ IF scopes[curScope].isMod THEN
|
|
|
+ sz := SymTab.TypeSlots(n^.typ);
|
|
|
+ IF sz = 0 THEN sz := 1 END;
|
|
|
+ sl := AllocGlobal(sz);
|
|
|
+ EnterVar(n^.name, SymTab.KindVar, n^.typ, sl, sz, 0,
|
|
|
+ TRUE, FALSE)
|
|
|
+ END
|
|
|
+ (* proc-scope vars are laid out by LayoutLocals *)
|
|
|
+ ELSIF n^.kind = AST.nkProc THEN
|
|
|
+ EmitProc(n)
|
|
|
+ ELSIF (n^.kind = AST.nkConst) OR (n^.kind = AST.nkTypeDecl)
|
|
|
+ OR (n^.kind = AST.nkImport) OR (n^.kind = AST.nkExport)
|
|
|
+ OR (n^.kind = AST.nkParam) OR (n^.kind = AST.nkMember) THEN
|
|
|
+ (* no code; consts fold via NoteDeclConst *)
|
|
|
+ IF n^.kind = AST.nkConst THEN NoteDeclConst(n) END
|
|
|
+ ELSIF n^.kind = AST.nkModule THEN
|
|
|
+ EmitModuleDecl(n)
|
|
|
+ ELSE Fail230()
|
|
|
+ END;
|
|
|
+ n := n^.next
|
|
|
+ END
|
|
|
+ END EmitDecls;
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE NoteDeclConst (n: AST.Node);
|
|
|
+(* Records a foldable CONST for inline use (ok=FALSE when dynamic). *)
|
|
|
+ VAR v: INTEGER;
|
|
|
+ b: LONGCARD;
|
|
|
+ tx: ARRAY [0 .. 63] OF CHAR;
|
|
|
+ cls: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ cls := SymTab.ClassOf(n^.typ);
|
|
|
+ IF cls = SymTab.ClReal THEN
|
|
|
+ IF EvalConstBits(n^.left, b) THEN
|
|
|
+ NoteConst(n^.name, 1, 0, b, "", TRUE)
|
|
|
+ ELSE NoteConst(n^.name, 1, 0, 0H, "", FALSE)
|
|
|
+ END
|
|
|
+ ELSIF cls = SymTab.ClStr THEN
|
|
|
+ IF EvalConstText(n^.left, tx) THEN
|
|
|
+ NoteConst(n^.name, 2, 0, 0H, tx, TRUE)
|
|
|
+ ELSE NoteConst(n^.name, 2, 0, 0H, "", FALSE)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF EvalConstInt(n^.left, v) THEN
|
|
|
+ NoteConst(n^.name, 0, v, 0H, "", TRUE)
|
|
|
+ ELSE NoteConst(n^.name, 0, 0, 0H, "", FALSE)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END NoteDeclConst;
|
|
|
+
|
|
|
+PROCEDURE EmitProc (n: AST.Node);
|
|
|
+ VAR pnum, saveProc: INTEGER;
|
|
|
+ saveDepth: CARDINAL;
|
|
|
+ p: AST.Node;
|
|
|
+ prm: CARDINAL;
|
|
|
+ loc: INTEGER;
|
|
|
+ blk: AST.Node;
|
|
|
+ endL: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ pnum := n^.num;
|
|
|
+ IF (pnum < 1) OR (pnum > MaxProc) THEN Fail230(); RETURN END;
|
|
|
+ saveProc := curProc;
|
|
|
+ saveDepth := curDepth;
|
|
|
+ procDepth[pnum] := curDepth + 1;
|
|
|
+ IF curProc = 0 THEN procParent[pnum] := -1
|
|
|
+ ELSE procParent[pnum] := curProc
|
|
|
+ END;
|
|
|
+ curProc := pnum;
|
|
|
+ curDepth := curDepth + 1;
|
|
|
+ PushScope("", pnum, curDepth, FALSE);
|
|
|
+ endL := NewLabel();
|
|
|
+ Jmp(endL);
|
|
|
+ prm := 3;
|
|
|
+ p := n^.left;
|
|
|
+ WHILE (p # NIL) & ok DO
|
|
|
+ EnterVar(p^.name, SymTab.KindParam, p^.typ,
|
|
|
+ VAL(INTEGER, prm), 1, curDepth, FALSE,
|
|
|
+ p^.op # 0);
|
|
|
+ INC(prm);
|
|
|
+ p := p^.next
|
|
|
+ END;
|
|
|
+ blk := n^.right;
|
|
|
+ loc := 1;
|
|
|
+ IF (blk # NIL) & (blk^.left # NIL) THEN
|
|
|
+ loc := LayoutLocals(blk^.left, 1)
|
|
|
+ END;
|
|
|
+ ProcEntry(pnum, VAL(CARDINAL, loc - 1));
|
|
|
+ IF blk # NIL THEN
|
|
|
+ EmitDecls(blk^.left);
|
|
|
+ EmitStmts(blk^.right);
|
|
|
+ IF SymTab.ProcRetByNum(pnum) # SymTab.InvalidType THEN
|
|
|
+ PushInt(0)
|
|
|
+ END;
|
|
|
+ Leave(SymTab.ProcNParByNum(pnum),
|
|
|
+ SymTab.ProcRetByNum(pnum) # SymTab.InvalidType)
|
|
|
+ ELSE
|
|
|
+ Leave(SymTab.ProcNParByNum(pnum), FALSE)
|
|
|
+ END;
|
|
|
+ DefLabel(endL);
|
|
|
+ PopScope;
|
|
|
+ curProc := saveProc;
|
|
|
+ curDepth := saveDepth
|
|
|
+ END EmitProc;
|
|
|
+
|
|
|
+
|
|
|
+PROCEDURE LayoutLocals (n: AST.Node; sl: INTEGER): INTEGER;
|
|
|
+(* Assigns negative frame slots to VAR decls; returns next free. *)
|
|
|
+ VAR sz: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ WHILE (n # NIL) & ok DO
|
|
|
+ IF n^.kind = AST.nkVar THEN
|
|
|
+ sz := SymTab.TypeSlots(n^.typ);
|
|
|
+ IF sz = 0 THEN sz := 1 END;
|
|
|
+ EnterVar(n^.name, SymTab.KindVar, n^.typ, -sl, sz,
|
|
|
+ curDepth, FALSE, FALSE);
|
|
|
+ sl := sl + VAL(INTEGER, sz)
|
|
|
+ ELSIF (n^.kind = AST.nkConst) OR (n^.kind = AST.nkTypeDecl)
|
|
|
+ OR (n^.kind = AST.nkImport) OR (n^.kind = AST.nkExport)
|
|
|
+ OR (n^.kind = AST.nkParam) OR (n^.kind = AST.nkMember) THEN
|
|
|
+ ELSIF (n^.kind = AST.nkProc) OR (n^.kind = AST.nkModule) THEN
|
|
|
+ ELSE Fail230()
|
|
|
+ END;
|
|
|
+ n := n^.next
|
|
|
+ END;
|
|
|
+ RETURN sl
|
|
|
+ END LayoutLocals;
|
|
|
+
|
|
|
+PROCEDURE EmitModuleDecl (n: AST.Node);
|
|
|
+ VAR blk: AST.Node;
|
|
|
+ inum: INTEGER;
|
|
|
+ endL: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ PushScope(n^.name, -1, curDepth, TRUE);
|
|
|
+ EmitDecls(n^.left);
|
|
|
+ blk := n^.right;
|
|
|
+ IF (blk # NIL) & (blk^.right # NIL) THEN
|
|
|
+ IF (nextInit > 63) OR (nInits >= MaxInit) THEN
|
|
|
+ Fail230(); PopScope; RETURN
|
|
|
+ END;
|
|
|
+ inum := VAL(INTEGER, nextInit);
|
|
|
+ INC(nextInit);
|
|
|
+ IF VAL(CARDINAL, inum) > maxNum THEN
|
|
|
+ maxNum := VAL(CARDINAL, inum)
|
|
|
+ END;
|
|
|
+ initNums[nInits] := inum; INC(nInits);
|
|
|
+ endL := NewLabel();
|
|
|
+ Jmp(endL);
|
|
|
+ ProcEntry(inum, 0);
|
|
|
+ EmitStmts(blk^.right);
|
|
|
+ Leave(0, FALSE);
|
|
|
+ DefLabel(endL)
|
|
|
+ END;
|
|
|
+ PopScope
|
|
|
+ END EmitModuleDecl;
|
|
|
+
|
|
|
+PROCEDURE EmitBlock (blk: AST.Node; pnum: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ IF (blk = NIL) OR ~ok THEN RETURN END;
|
|
|
+ EmitDecls(blk^.left);
|
|
|
+ EmitStmts(blk^.right)
|
|
|
+ END EmitBlock;
|
|
|
+
|
|
|
+PROCEDURE EmitFor (n: AST.Node);
|
|
|
+ VAR vi: INTEGER;
|
|
|
+ lTop, lChk, lNeg, lEnd: INTEGER;
|
|
|
+ tH, tB: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (n = NIL) OR ~ok THEN RETURN END;
|
|
|
+ vi := FindVar(n^.name);
|
|
|
+ IF (vi < 0) OR vars[vi].isAddr THEN Fail230(); RETURN END;
|
|
|
+ IF vars[vi].global THEN
|
|
|
+ ELSIF vars[vi].depth # curDepth THEN Fail230(); RETURN
|
|
|
+ END;
|
|
|
+ EmitExpr(n^.left);
|
|
|
+ EmitStoreEntry(vi);
|
|
|
+ EmitExpr(n^.right);
|
|
|
+ tH := TempGlobal();
|
|
|
+ StoreTemp(tH);
|
|
|
+ IF n^.extra # NIL THEN EmitExpr(n^.extra)
|
|
|
+ ELSE PushInt(1)
|
|
|
+ END;
|
|
|
+ tB := TempGlobal();
|
|
|
+ StoreTemp(tB);
|
|
|
+ lTop := NewLabel(); lChk := NewLabel();
|
|
|
+ lNeg := NewLabel(); lEnd := NewLabel();
|
|
|
+ Jmp(lChk);
|
|
|
+ DefLabel(lTop);
|
|
|
+ EmitStmts(n^.more);
|
|
|
+ EmitLoadEntry(vi);
|
|
|
+ LoadTemp(tB);
|
|
|
+ EmitOp(OPadd);
|
|
|
+ EmitStoreEntry(vi);
|
|
|
+ DefLabel(lChk);
|
|
|
+ LoadTemp(tB);
|
|
|
+ PushInt(0);
|
|
|
+ EmitOp(OPige);
|
|
|
+ Jz(lNeg);
|
|
|
+ EmitLoadEntry(vi);
|
|
|
+ LoadTemp(tH);
|
|
|
+ EmitOp(OPile);
|
|
|
+ Jz(lEnd);
|
|
|
+ Jmp(lTop);
|
|
|
+ DefLabel(lNeg);
|
|
|
+ EmitLoadEntry(vi);
|
|
|
+ LoadTemp(tH);
|
|
|
+ EmitOp(OPige);
|
|
|
+ Jz(lEnd);
|
|
|
+ Jmp(lTop);
|
|
|
+ DefLabel(lEnd)
|
|
|
+ END EmitFor;
|
|
|
+
|
|
|
+PROCEDURE Prescan (n: AST.Node; VAR maxP, nIni: CARDINAL);
|
|
|
+ BEGIN
|
|
|
+ WHILE (n # NIL) & ok DO
|
|
|
+ IF n^.kind = AST.nkProc THEN
|
|
|
+ IF VAL(CARDINAL, n^.num) > maxP THEN
|
|
|
+ maxP := VAL(CARDINAL, n^.num)
|
|
|
+ END;
|
|
|
+ IF n^.right # NIL THEN Prescan(n^.right^.left, maxP, nIni) END
|
|
|
+ ELSIF n^.kind = AST.nkModule THEN
|
|
|
+ IF (n^.right # NIL) & (n^.right^.right # NIL) THEN
|
|
|
+ INC(nIni)
|
|
|
+ END;
|
|
|
+ Prescan(n^.left, maxP, nIni)
|
|
|
+ END;
|
|
|
+ n := n^.next
|
|
|
+ END
|
|
|
+ END Prescan;
|
|
|
+
|
|
|
+PROCEDURE EmitModule (root: AST.Node): BOOLEAN;
|
|
|
+ VAR blk: AST.Node;
|
|
|
+ i: CARDINAL;
|
|
|
+ maxP, nIni: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF root = NIL THEN RETURN FALSE END;
|
|
|
+ IF root^.kind # AST.nkModule THEN Fail230(); RETURN FALSE END;
|
|
|
+ OpenModule(root^.name);
|
|
|
+ maxP := 0; nIni := 0;
|
|
|
+ Prescan(root^.left, maxP, nIni);
|
|
|
+ IF maxP + nIni + 1 > 63 THEN Fail230(); RETURN FALSE END;
|
|
|
+ maxNum := maxP;
|
|
|
+ nextInit := maxP + 1;
|
|
|
+ PushScope("", 0, 0, TRUE);
|
|
|
+ NoteConst("TRUE", 0, 1, 0H, "", TRUE);
|
|
|
+ NoteConst("FALSE", 0, 0, 0H, "", TRUE);
|
|
|
+ EmitDecls(root^.left);
|
|
|
+ blk := root^.right;
|
|
|
+ mainAddr := nCode;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nInits DO
|
|
|
+ CallProc(initNums[i]);
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ IF blk # NIL THEN EmitStmts(blk^.right) END;
|
|
|
+ PopScope;
|
|
|
+ EndModule;
|
|
|
+ RETURN ok
|
|
|
+ END EmitModule;
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ nCode := 0;
|
|
|
+ nLab := 0; nFix := 0;
|
|
|
+ nG := 0; nGlb := 4;
|
|
|
+ nScopes := 0; curScope := -1;
|
|
|
+ nV := 0; nC := 0;
|
|
|
+ maxNum := 0; mainAddr := 0;
|
|
|
+ nInits := 0;
|
|
|
+ curDepth := 0; curProc := 0;
|
|
|
+ loopTop := 0;
|
|
|
+ ok := TRUE;
|
|
|
+ modName[0] := 0C
|
|
|
+END MGen.
|
