|
@@ -32,6 +32,8 @@ VAR
|
|
|
parVar : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN;
|
|
parVar : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN;
|
|
|
parName : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR;
|
|
parName : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR;
|
|
|
nProcs : CARDINAL;
|
|
nProcs : CARDINAL;
|
|
|
|
|
+ withRec : ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
|
|
+ withTop : CARDINAL;
|
|
|
|
|
|
|
|
PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
|
|
PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
|
|
|
VAR i: CARDINAL;
|
|
VAR i: CARDINAL;
|
|
@@ -171,6 +173,28 @@ PROCEDURE ParamInfo (nm: ARRAY OF CHAR; i: CARDINAL;
|
|
|
RETURN TRUE
|
|
RETURN TRUE
|
|
|
END ParamInfo;
|
|
END ParamInfo;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE WithField (nm: ARRAY OF CHAR; VAR k: INTEGER;
|
|
|
|
|
+ VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal): BOOLEAN;
|
|
|
|
|
+(* Resolves a bare ident as a field of an open WITH record (innermost
|
|
|
|
|
+ first), leaving the field address in q and k=KindField. *)
|
|
|
|
|
+ VAR wt: CARDINAL; fo: INTEGER; qb: QbeGen.QVal;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ wt := withTop;
|
|
|
|
|
+ WHILE wt > 0 DO
|
|
|
|
|
+ DEC(wt);
|
|
|
|
|
+ IF SymTab.FieldExists(withRec[wt], nm) THEN
|
|
|
|
|
+ t := SymTab.FieldType(withRec[wt], nm);
|
|
|
|
|
+ fo := SymTab.FieldOffset(withRec[wt], nm);
|
|
|
|
|
+ k := SymTab.KindField;
|
|
|
|
|
+ IF QbeGen.TopWith(qb) THEN QbeGen.FieldAddr(qb, fo, q)
|
|
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN TRUE
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN FALSE
|
|
|
|
|
+ END WithField;
|
|
|
|
|
+
|
|
|
PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR);
|
|
PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR);
|
|
|
BEGIN
|
|
BEGIN
|
|
|
IF n = AST.NoNode THEN s[0] := CHR(0)
|
|
IF n = AST.NoNode THEN s[0] := CHR(0)
|
|
@@ -279,6 +303,46 @@ PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
OR (cls = SymTab.ClPtr)
|
|
OR (cls = SymTab.ClPtr)
|
|
|
END CanType;
|
|
END CanType;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE CanWithField (nm: ARRAY OF CHAR; VAR t: SymTab.TypeIndex): BOOLEAN;
|
|
|
|
|
+ VAR wt: CARDINAL;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ wt := withTop;
|
|
|
|
|
+ WHILE wt > 0 DO
|
|
|
|
|
+ DEC(wt);
|
|
|
|
|
+ IF SymTab.FieldExists(withRec[wt], nm) THEN
|
|
|
|
|
+ t := SymTab.FieldType(withRec[wt], nm); RETURN TRUE
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN FALSE
|
|
|
|
|
+ END CanWithField;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE DesignTypeOf (n: AST.Node): SymTab.TypeIndex;
|
|
|
|
|
+(* Static type of a designator (no emit); used to push WITH scopes. *)
|
|
|
|
|
+ VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
|
|
|
|
|
+ i: CARDINAL; sel: AST.Node;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF (n = AST.NoNode) OR (AST.Kind(n) # AST.NkDesignator) THEN
|
|
|
|
|
+ RETURN SymTab.InvalidType
|
|
|
|
|
+ END;
|
|
|
|
|
+ Name(AST.Child(n, 0), nm);
|
|
|
|
|
+ IF NOT Resolve(nm, k, t) THEN
|
|
|
|
|
+ IF NOT CanWithField(nm, t) THEN RETURN SymTab.InvalidType END
|
|
|
|
|
+ END;
|
|
|
|
|
+ i := 1;
|
|
|
|
|
+ WHILE i < AST.NChild(n) DO
|
|
|
|
|
+ sel := AST.Child(n, i);
|
|
|
|
|
+ IF AST.Op(sel) = AST.SelField THEN
|
|
|
|
|
+ Name(AST.Child(sel, 0), fn); t := SymTab.FieldType(t, fn)
|
|
|
|
|
+ ELSIF AST.Op(sel) = AST.SelIndex THEN
|
|
|
|
|
+ t := SymTab.ArrayElem(t)
|
|
|
|
|
+ ELSIF AST.Op(sel) = AST.SelDeref THEN
|
|
|
|
|
+ t := SymTab.PtrBase(t)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN t
|
|
|
|
|
+ END DesignTypeOf;
|
|
|
|
|
+
|
|
|
PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
|
|
PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
|
|
|
VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
|
|
VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
|
|
|
i: CARDINAL; sel: AST.Node;
|
|
i: CARDINAL; sel: AST.Node;
|
|
@@ -286,9 +350,14 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
|
|
|
IF AST.Kind(n) # AST.NkDesignator THEN RETURN FALSE END;
|
|
IF AST.Kind(n) # AST.NkDesignator THEN RETURN FALSE END;
|
|
|
IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
|
|
IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
|
|
|
Name(AST.Child(n, 0), nm);
|
|
Name(AST.Child(n, 0), nm);
|
|
|
- IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
|
|
|
|
|
|
|
+ IF NOT Resolve(nm, k, t) THEN
|
|
|
|
|
+ IF NOT CanWithField(nm, t) THEN RETURN FALSE END;
|
|
|
|
|
+ k := SymTab.KindField
|
|
|
|
|
+ END;
|
|
|
IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
|
|
IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
|
|
|
- AND (k # SymTab.KindConst) THEN RETURN FALSE END;
|
|
|
|
|
|
|
+ AND (k # SymTab.KindConst) AND (k # SymTab.KindField) THEN
|
|
|
|
|
+ RETURN FALSE
|
|
|
|
|
+ END;
|
|
|
IF NOT CanType(t) THEN RETURN FALSE END;
|
|
IF NOT CanType(t) THEN RETURN FALSE END;
|
|
|
i := 1;
|
|
i := 1;
|
|
|
WHILE i < AST.NChild(n) DO
|
|
WHILE i < AST.NChild(n) DO
|
|
@@ -319,13 +388,36 @@ PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
|
|
|
RETURN TRUE
|
|
RETURN TRUE
|
|
|
END CanDesign;
|
|
END CanDesign;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE CanBuiltin (n: AST.Node): BOOLEAN;
|
|
|
|
|
+ VAR i: CARDINAL;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ i := 1;
|
|
|
|
|
+ WHILE i < AST.NChild(n) DO
|
|
|
|
|
+ IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN TRUE
|
|
|
|
|
+ END CanBuiltin;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE CanCaseLabel (lab: AST.Node): BOOLEAN;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF AST.Kind(lab) = AST.NkSubrange THEN
|
|
|
|
|
+ RETURN CanExpr(AST.Child(lab, 0)) AND CanExpr(AST.Child(lab, 1))
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN CanExpr(lab)
|
|
|
|
|
+ END CanCaseLabel;
|
|
|
|
|
+
|
|
|
PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
|
|
PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
|
|
|
- VAR op: INTEGER;
|
|
|
|
|
|
|
+ VAR op: INTEGER; nm: SymTab.Name;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
IF n = AST.NoNode THEN RETURN FALSE END;
|
|
IF n = AST.NoNode THEN RETURN FALSE END;
|
|
|
IF AST.Kind(n) = AST.NkIntLit THEN RETURN TRUE END;
|
|
IF AST.Kind(n) = AST.NkIntLit THEN RETURN TRUE END;
|
|
|
IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END;
|
|
IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END;
|
|
|
- IF AST.Kind(n) = AST.NkCall THEN RETURN IsCall(n) AND CanCallArgs(n) END;
|
|
|
|
|
|
|
+ IF AST.Kind(n) = AST.NkCall THEN
|
|
|
|
|
+ CalleeName(n, nm);
|
|
|
|
|
+ IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
|
|
|
|
|
+ RETURN IsCall(n) AND CanCallArgs(n)
|
|
|
|
|
+ END;
|
|
|
IF AST.Kind(n) = AST.NkUnary THEN
|
|
IF AST.Kind(n) = AST.NkUnary THEN
|
|
|
op := AST.Op(n);
|
|
op := AST.Op(n);
|
|
|
IF (op # AST.OpSub) AND (op # AST.OpNot) THEN RETURN FALSE END;
|
|
IF (op # AST.OpSub) AND (op # AST.OpNot) THEN RETURN FALSE END;
|
|
@@ -342,7 +434,8 @@ PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
|
|
|
END CanExpr;
|
|
END CanExpr;
|
|
|
|
|
|
|
|
PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
|
|
PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
|
|
|
- VAR i: CARDINAL; k: INTEGER; by: AST.Node;
|
|
|
|
|
|
|
+ VAR i: CARDINAL; k: INTEGER; by: AST.Node; nm: SymTab.Name;
|
|
|
|
|
+ arm: AST.Node; j: CARDINAL; withSave: CARDINAL; ok: BOOLEAN;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
IF n = AST.NoNode THEN RETURN TRUE END;
|
|
IF n = AST.NoNode THEN RETURN TRUE END;
|
|
|
k := AST.Kind(n);
|
|
k := AST.Kind(n);
|
|
@@ -377,6 +470,43 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
|
|
|
AND CanExpr(AST.Child(n, 1)) AND CanExpr(AST.Child(n, 2))
|
|
AND CanExpr(AST.Child(n, 1)) AND CanExpr(AST.Child(n, 2))
|
|
|
AND CanStmt(AST.Child(n, 4))
|
|
AND CanStmt(AST.Child(n, 4))
|
|
|
END;
|
|
END;
|
|
|
|
|
+ IF k = AST.NkWith THEN
|
|
|
|
|
+ withSave := withTop;
|
|
|
|
|
+ j := 0;
|
|
|
|
|
+ WHILE j + 1 < AST.NChild(n) DO
|
|
|
|
|
+ IF NOT CanDesign(AST.Child(n, j)) THEN
|
|
|
|
|
+ withTop := withSave; RETURN FALSE
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF withTop <= HIGH(withRec) THEN
|
|
|
|
|
+ withRec[withTop] := DesignTypeOf(AST.Child(n, j)); INC(withTop)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(j)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ok := CanStmt(AST.Child(n, AST.NChild(n) - 1));
|
|
|
|
|
+ withTop := withSave;
|
|
|
|
|
+ RETURN ok
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF k = AST.NkCase THEN
|
|
|
|
|
+ IF NOT CanExpr(AST.Child(n, 0)) THEN RETURN FALSE END;
|
|
|
|
|
+ i := 1;
|
|
|
|
|
+ WHILE i < AST.NChild(n) DO
|
|
|
|
|
+ arm := AST.Child(n, i);
|
|
|
|
|
+ IF AST.Op(arm) = 1 THEN
|
|
|
|
|
+ IF NOT CanStmt(AST.Child(arm, 0)) THEN RETURN FALSE END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ j := 0;
|
|
|
|
|
+ WHILE j + 1 < AST.NChild(arm) DO
|
|
|
|
|
+ IF NOT CanCaseLabel(AST.Child(arm, j)) THEN RETURN FALSE END;
|
|
|
|
|
+ INC(j)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF NOT CanStmt(AST.Child(arm, AST.NChild(arm) - 1)) THEN
|
|
|
|
|
+ RETURN FALSE
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN TRUE
|
|
|
|
|
+ END;
|
|
|
IF k = AST.NkHalt THEN
|
|
IF k = AST.NkHalt THEN
|
|
|
IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
|
|
IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
|
|
|
RETURN CanExpr(AST.Child(n, 0))
|
|
RETURN CanExpr(AST.Child(n, 0))
|
|
@@ -385,7 +515,11 @@ PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
|
|
|
IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
|
|
IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
|
|
|
RETURN CanExpr(AST.Child(n, 0))
|
|
RETURN CanExpr(AST.Child(n, 0))
|
|
|
END;
|
|
END;
|
|
|
- IF k = AST.NkCall THEN RETURN IsCall(n) AND CanCallArgs(n) END;
|
|
|
|
|
|
|
+ IF k = AST.NkCall THEN
|
|
|
|
|
+ CalleeName(n, nm);
|
|
|
|
|
+ IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
|
|
|
|
|
+ RETURN IsCall(n) AND CanCallArgs(n)
|
|
|
|
|
+ END;
|
|
|
RETURN FALSE
|
|
RETURN FALSE
|
|
|
END CanStmt;
|
|
END CanStmt;
|
|
|
|
|
|
|
@@ -431,6 +565,7 @@ PROCEDURE CanDecls (seq: AST.Node): BOOLEAN;
|
|
|
|
|
|
|
|
PROCEDURE CanLower (unit: AST.Node): BOOLEAN;
|
|
PROCEDURE CanLower (unit: AST.Node): BOOLEAN;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
|
|
+ withTop := 0;
|
|
|
IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END;
|
|
IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END;
|
|
|
IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END;
|
|
IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END;
|
|
|
IF AST.Child(unit, 3) # AST.NoNode THEN RETURN FALSE END;
|
|
IF AST.Child(unit, 3) # AST.NoNode THEN RETURN FALSE END;
|
|
@@ -483,7 +618,10 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
QbeGen.CopyOp(nm, qn);
|
|
QbeGen.CopyOp(nm, qn);
|
|
|
sfx := FALSE;
|
|
sfx := FALSE;
|
|
|
IF NOT Resolve(nm, k, t) THEN
|
|
IF NOT Resolve(nm, k, t) THEN
|
|
|
- t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
|
|
|
|
|
|
|
+ IF NOT WithField(nm, k, t, q) THEN
|
|
|
|
|
+ t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
|
|
|
|
|
+ END;
|
|
|
|
|
+ sfx := TRUE
|
|
|
END;
|
|
END;
|
|
|
IF k = SymTab.KindConst THEN
|
|
IF k = SymTab.KindConst THEN
|
|
|
IF SymTab.Equal(nm, "TRUE") THEN
|
|
IF SymTab.Equal(nm, "TRUE") THEN
|
|
@@ -508,6 +646,8 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
QbeGen.LoadLong(nm, q)
|
|
QbeGen.LoadLong(nm, q)
|
|
|
ELSE QbeGen.AddrOf(nm, q)
|
|
ELSE QbeGen.AddrOf(nm, q)
|
|
|
END
|
|
END
|
|
|
|
|
+ ELSIF k = SymTab.KindField THEN
|
|
|
|
|
+ (* q already holds the field address (WithField) *)
|
|
|
ELSE QbeGen.CopyOp("0", q)
|
|
ELSE QbeGen.CopyOp("0", q)
|
|
|
END;
|
|
END;
|
|
|
i := 1;
|
|
i := 1;
|
|
@@ -602,6 +742,213 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
|
|
|
END
|
|
END
|
|
|
END LowerCall;
|
|
END LowerCall;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE IsBuiltin (nm: ARRAY OF CHAR): BOOLEAN;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ RETURN SymTab.Equal(nm, "ABS") OR SymTab.Equal(nm, "CAP")
|
|
|
|
|
+ OR SymTab.Equal(nm, "CHR") OR SymTab.Equal(nm, "ORD")
|
|
|
|
|
+ OR SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE")
|
|
|
|
|
+ OR SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX")
|
|
|
|
|
+ OR SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE")
|
|
|
|
|
+ OR SymTab.Equal(nm, "ADR")
|
|
|
|
|
+ OR SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC")
|
|
|
|
|
+ OR SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL")
|
|
|
|
|
+ OR SymTab.Equal(nm, "NEW") OR SymTab.Equal(nm, "DISPOSE")
|
|
|
|
|
+ END IsBuiltin;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
|
|
|
|
|
+ VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
|
|
|
|
|
+(* Value builtins (Fact). *)
|
|
|
|
|
+ VAR et, et2, dt: SymTab.TypeIndex; qa, qt, q2, qd: QbeGen.QVal;
|
|
|
|
|
+ k, lo, hi: INTEGER; qn: SymTab.Name; sfx: BOOLEAN; isMax: BOOLEAN;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF SymTab.Equal(nm, "ABS") THEN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 1), et, q);
|
|
|
|
|
+ QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal);
|
|
|
|
|
+ QbeGen.CopyOp(qa, q); t := et
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "CAP") THEN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 1), et, q);
|
|
|
|
|
+ QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType()
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "CHR") THEN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType()
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "ORD") THEN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "SIZE") THEN
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
|
|
|
|
|
+ QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q);
|
|
|
|
|
+ t := SymTab.IntType()
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN
|
|
|
|
|
+ isMax := SymTab.Equal(nm, "MAX");
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
|
|
|
|
|
+ IF SymTab.ClassOf(dt) = SymTab.ClReal THEN
|
|
|
|
|
+ IF isMax THEN QbeGen.NormReal("3.402823e38", q)
|
|
|
|
|
+ ELSE QbeGen.NormReal("-3.402823e38", q) END;
|
|
|
|
|
+ t := SymTab.RealType()
|
|
|
|
|
+ ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
|
|
|
|
|
+ IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
|
|
|
|
|
+ ELSE QbeGen.CopyOp("-9223372036854775808", q) END;
|
|
|
|
|
+ t := SymTab.LongType()
|
|
|
|
|
+ ELSIF SymTab.TypeBounds(dt, lo, hi) THEN
|
|
|
|
|
+ IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END;
|
|
|
|
|
+ t := SymTab.IntType()
|
|
|
|
|
+ ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 1), et, q);
|
|
|
|
|
+ LowerExpr(AST.Child(n, 2), et2, q2);
|
|
|
|
|
+ QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et),
|
|
|
|
|
+ SymTab.Equal(nm, "ROTATE"), qt);
|
|
|
|
|
+ t := et; QbeGen.CopyOp(qt, q)
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "ADR") THEN
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
|
|
|
|
|
+ IF sfx THEN QbeGen.CopyOp(qd, q)
|
|
|
|
|
+ ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
|
|
|
|
|
+ QbeGen.AddrOf(qn, q)
|
|
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
|
|
+ END;
|
|
|
|
|
+ t := SymTab.AddrType()
|
|
|
|
|
+ ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
|
|
|
|
|
+ END
|
|
|
|
|
+ END LowerBuiltinExpr;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
|
|
|
|
|
+(* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *)
|
|
|
|
|
+ VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER;
|
|
|
|
|
+ qd, qv, qe, qn2, qstep, qm: QbeGen.QVal;
|
|
|
|
|
+ qn: SymTab.Name; sfx, isInc: BOOLEAN;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN
|
|
|
|
|
+ isInc := SymTab.Equal(nm, "INC");
|
|
|
|
|
+ QbeGen.CopyOp("1", qstep);
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
|
|
|
|
|
+ IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END;
|
|
|
|
|
+ IF dt = SymTab.InvalidType THEN
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
|
|
|
|
|
+ ELSE QbeGen.LoadVar(qn, FALSE, qv)
|
|
|
|
|
+ END;
|
|
|
|
|
+ QbeGen.NewTemp(qn2);
|
|
|
|
|
+ IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE)
|
|
|
|
|
+ ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt)
|
|
|
|
|
+ ELSE QbeGen.StoreVar(qn, qn2, FALSE)
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN
|
|
|
|
|
+ isInc := SymTab.Equal(nm, "INCL");
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx);
|
|
|
|
|
+ LowerExpr(AST.Child(n, 2), et2, qe);
|
|
|
|
|
+ IF at = SymTab.InvalidType THEN
|
|
|
|
|
+ ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
|
|
|
|
|
+ ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "NEW") THEN
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
|
|
|
|
|
+ IF dt = SymTab.InvalidType THEN
|
|
|
|
|
+ ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ bt := SymTab.PtrBase(dt);
|
|
|
|
|
+ IF bt # SymTab.InvalidType THEN
|
|
|
|
|
+ QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt);
|
|
|
|
|
+ IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt)
|
|
|
|
|
+ ELSE QbeGen.StorePtr(qn, qm)
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSIF SymTab.Equal(nm, "DISPOSE") THEN
|
|
|
|
|
+ LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
|
|
|
|
|
+ IF dt = SymTab.InvalidType THEN
|
|
|
|
|
+ ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
|
|
|
|
|
+ ELSE QbeGen.LoadPtr(qn, qv)
|
|
|
|
|
+ END;
|
|
|
|
|
+ QbeGen.FreeHeap(qv);
|
|
|
|
|
+ IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt)
|
|
|
|
|
+ ELSE QbeGen.StorePtr(qn, "0")
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ END
|
|
|
|
|
+ END LowerBuiltinStmt;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE LowerCase (n: AST.Node);
|
|
|
|
|
+(* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). *)
|
|
|
|
|
+ VAR i, j: CARDINAL; arm, lab: AST.Node; tsel, t2, t3: SymTab.TypeIndex;
|
|
|
|
|
+ qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ LowerExpr(AST.Child(n, 0), tsel, qsel);
|
|
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
|
|
+ i := 1;
|
|
|
|
|
+ WHILE i < AST.NChild(n) DO
|
|
|
|
|
+ arm := AST.Child(n, i);
|
|
|
|
|
+ IF AST.Op(arm) = 1 THEN
|
|
|
|
|
+ (* ELSE arm: emitted after the alternatives *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter);
|
|
|
|
|
+ j := 0;
|
|
|
|
|
+ WHILE j + 1 < AST.NChild(arm) DO
|
|
|
|
|
+ lab := AST.Child(arm, j);
|
|
|
|
|
+ IF AST.Kind(lab) = AST.NkSubrange THEN
|
|
|
|
|
+ LowerExpr(AST.Child(lab, 0), t2, q2);
|
|
|
|
|
+ QbeGen.NewLabel(lNext);
|
|
|
|
|
+ QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
|
|
|
|
|
+ QbeGen.Jnz(qc, lBody, lNext);
|
|
|
|
|
+ QbeGen.EmitLabel(lNext);
|
|
|
|
|
+ LowerExpr(AST.Child(lab, 1), t3, q3);
|
|
|
|
|
+ QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE);
|
|
|
|
|
+ QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE);
|
|
|
|
|
+ QbeGen.NewTemp(qe);
|
|
|
|
|
+ QbeGen.Op3("and", qe, qc, qd, FALSE);
|
|
|
|
|
+ QbeGen.NewLabel(lNext);
|
|
|
|
|
+ QbeGen.Jnz(qe, lBody, lNext);
|
|
|
|
|
+ QbeGen.EmitLabel(lNext)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ LowerExpr(lab, t2, q2);
|
|
|
|
|
+ QbeGen.NewLabel(lNext);
|
|
|
|
|
+ QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
|
|
|
|
|
+ QbeGen.Jnz(qc, lBody, lNext);
|
|
|
|
|
+ QbeGen.EmitLabel(lNext)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(j)
|
|
|
|
|
+ END;
|
|
|
|
|
+ QbeGen.Jmp(lAfter);
|
|
|
|
|
+ QbeGen.EmitLabel(lBody);
|
|
|
|
|
+ LowerStmt(AST.Child(arm, AST.NChild(arm) - 1));
|
|
|
|
|
+ QbeGen.Jmp(lEnd);
|
|
|
|
|
+ QbeGen.EmitLabel(lAfter)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ i := 1;
|
|
|
|
|
+ WHILE i < AST.NChild(n) DO
|
|
|
|
|
+ arm := AST.Child(n, i);
|
|
|
|
|
+ IF AST.Op(arm) = 1 THEN LowerStmt(AST.Child(arm, 0)) END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ QbeGen.EmitLabel(lEnd)
|
|
|
|
|
+ END LowerCase;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE LowerWith (n: AST.Node);
|
|
|
|
|
+(* WITH: push each record's base address, lower the body, pop. *)
|
|
|
|
|
+ VAR i: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER; qd: QbeGen.QVal;
|
|
|
|
|
+ qn: SymTab.Name; sfx: BOOLEAN;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ WHILE i + 1 < AST.NChild(n) DO
|
|
|
|
|
+ LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx);
|
|
|
|
|
+ QbeGen.PushWith(qd);
|
|
|
|
|
+ IF withTop <= HIGH(withRec) THEN
|
|
|
|
|
+ withRec[withTop] := dt; INC(withTop)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
+ LowerStmt(AST.Child(n, AST.NChild(n) - 1));
|
|
|
|
|
+ WHILE withTop > 0 DO DEC(withTop); QbeGen.PopWith END
|
|
|
|
|
+ END LowerWith;
|
|
|
|
|
+
|
|
|
PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
|
|
PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
|
|
|
VAR q: QbeGen.QVal; VAR k: INTEGER;
|
|
VAR q: QbeGen.QVal; VAR k: INTEGER;
|
|
|
VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
|
|
VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
|
|
@@ -622,7 +969,10 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
|
|
|
ELSIF AST.Kind(n) = AST.NkDesignator THEN
|
|
ELSIF AST.Kind(n) = AST.NkDesignator THEN
|
|
|
LowerDesign(n, t, k, q, qn, sfx)
|
|
LowerDesign(n, t, k, q, qn, sfx)
|
|
|
ELSIF AST.Kind(n) = AST.NkCall THEN
|
|
ELSIF AST.Kind(n) = AST.NkCall THEN
|
|
|
- LowerCall(n, t, q, TRUE)
|
|
|
|
|
|
|
+ CalleeName(n, qn);
|
|
|
|
|
+ IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
|
|
|
|
|
+ ELSE LowerCall(n, t, q, TRUE)
|
|
|
|
|
+ END
|
|
|
ELSIF AST.Kind(n) = AST.NkUnary THEN
|
|
ELSIF AST.Kind(n) = AST.NkUnary THEN
|
|
|
LowerExpr(AST.Child(n, 0), t, q);
|
|
LowerExpr(AST.Child(n, 0), t, q);
|
|
|
IF AST.Op(n) = AST.OpSub THEN
|
|
IF AST.Op(n) = AST.OpSub THEN
|
|
@@ -856,8 +1206,13 @@ PROCEDURE LowerStmt (seq: AST.Node);
|
|
|
ELSE QbeGen.EmitRet(q, TRUE)
|
|
ELSE QbeGen.EmitRet(q, TRUE)
|
|
|
END
|
|
END
|
|
|
END
|
|
END
|
|
|
|
|
+ ELSIF k = AST.NkCase THEN LowerCase(seq)
|
|
|
|
|
+ ELSIF k = AST.NkWith THEN LowerWith(seq)
|
|
|
ELSIF k = AST.NkCall THEN
|
|
ELSIF k = AST.NkCall THEN
|
|
|
- LowerCall(seq, t, q, FALSE)
|
|
|
|
|
|
|
+ CalleeName(seq, qn);
|
|
|
|
|
+ IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
|
|
|
|
|
+ ELSE LowerCall(seq, t, q, FALSE)
|
|
|
|
|
+ END
|
|
|
END
|
|
END
|
|
|
END LowerStmt;
|
|
END LowerStmt;
|
|
|
|
|
|
|
@@ -908,6 +1263,7 @@ PROCEDURE LowerDecls (seq: AST.Node);
|
|
|
PROCEDURE LowerUnit (unit: AST.Node);
|
|
PROCEDURE LowerUnit (unit: AST.Node);
|
|
|
VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL;
|
|
VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
|
|
+ withTop := 0;
|
|
|
Name(AST.Child(unit, 0), nm);
|
|
Name(AST.Child(unit, 0), nm);
|
|
|
i := 0;
|
|
i := 0;
|
|
|
WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO
|
|
WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO
|