language: add true SHORTREAL and C bool support

compiler/run_tests.sh

@@ -169,6 +169,10 @@ expect_run t_chain.mod 42
 expect_run t_goto.mod 42
 expect_fail t_gotobad.mod "undeclared identifier"
 expect_run t_under.mod 42
+expect_run t_f32.mod 42
+expect_run t_f32proc.mod 42
+expect_run t_f32field.mod 42
+expect_run t_f32conv.mod 42
 expect_run t_extern_alias.mod 42
 expect_run t_with.mod 114
 expect_run t_set.mod 131
@@ -347,6 +351,7 @@ expect_run_files TCStringProg 42 t_cstring.def t_cstring_prog.mod
 expect_run_files TCStringQualProg 42 t_cstring.def t_cstring_qual_prog.mod
 expect_run_files CStrProg 42 ../runtime/syslib/CStr.def ../runtime/syslib/CStr.mod tests/cstr_test.def tests/cstr_prog.mod
 expect_run_files LinkNameProg 42 linkname.def linkname_prog.mod
+expect_run_files CAbiScalarsProg 42 cabi_scalars.def cabi_scalars_prog.mod
 expect_run_files EEnumProg 42 e_enum.def e_enum_re.def e_enum_prog.mod
 expect_run_files TClassDefProg 8 t_classdef.def t_classdef_prog.mod
 expect_run_files DQualProg 46 d_basic.def d_basic.mod d_qual_prog.mod

compiler/src/Lower.mod

@@ -1077,6 +1077,10 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
         ELSIF cls = SymTab.ClReal THEN
           (* a real CONST lives in its data symbol; load it *)
           QbeGen.LoadVar(nm, TRUE, q)
+        ELSIF cls = SymTab.ClSReal THEN
+          QbeGen.LoadShortReal(nm, q)
+        ELSIF cls = SymTab.ClCBool THEN
+          QbeGen.LoadShortVar(nm, FALSE, 1, q)
         ELSE QbeGen.CopyOp("0", q)
         END
       END
@@ -1093,6 +1097,8 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
          OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
          OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) THEN
         QbeGen.LoadVar(nm, cls = SymTab.ClReal, q)
+      ELSIF cls = SymTab.ClSReal THEN
+        QbeGen.LoadShortReal(nm, q)
       ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
         QbeGen.LoadPtr(nm, q)
       ELSIF cls = SymTab.ClLong THEN
@@ -1254,7 +1260,10 @@ PROCEDURE AppendArg (val: ARRAY OF CHAR; ft: SymTab.TypeIndex;
    descriptor/view argument. *)
   VAR cl: CHAR;
   BEGIN
-    IF isCABI THEN
+    IF SymTab.IsShortReal(ft) THEN
+      QbeGen.ConvSR(val, tmp);
+      cl := "s"
+    ELSIF isCABI THEN
       QbeGen.CArg(val, ft, tmp, cl)
     ELSE
       QbeGen.CopyOp(val, tmp);
@@ -1406,8 +1415,13 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
                      AND SymTab.IsOpenArray(ft);
           isExtern := ext OR isC;
           IF va THEN
-            (* permissive C variadic argument *)
-            QbeGen.CArgAdd(qe, at, qa, cl)
+            (* C varargs: float is promoted to double; strings still
+               become char pointers. *)
+            IF SymTab.IsShortReal(at) THEN
+              IF NOT QbeGen.CallArg(qe, "d") THEN END
+            ELSE
+              QbeGen.CArgAdd(qe, at, qa, cl)
+            END
           ELSIF isV THEN
             IF isOpen1 AND NOT isExtern THEN
               IF lastView OR (SymTab.ClassOf(at) = SymTab.ClArray)
@@ -1529,13 +1543,12 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
                 QbeGen.CopySetVal(qt, ft, qe, at);
                 QbeGen.CopyOp(qt, qe)
               END;
-              conv := (SymTab.ClassOf(ft) = SymTab.ClReal)
-                      AND SymTab.IsIntFamily(at);
+              conv := SymTab.IsRealType(ft) AND SymTab.IsIntFamily(at);
               IF conv THEN
                 QbeGen.ConvIR(qe, qt);
-                IF NOT QbeGen.CallArg(qt, "d") THEN END
+                AppendArg(qt, ft, cabi, qa)
               ELSE
-                IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+                AppendArg(qe, ft, cabi, qa)
               END
             END
           END;
@@ -1552,6 +1565,11 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
     END;
     IF want THEN
       t := res; QbeGen.CallEnd(TRUE, q);
+      IF SymTab.IsShortReal(res) THEN
+        QbeGen.ConvRS(q, qt); QbeGen.CopyOp(qt, q)
+      ELSIF SymTab.IsCBool(res) THEN
+        QbeGen.MaskCBool(q, qt); QbeGen.CopyOp(qt, q)
+      END;
       IF CompositeRes(res) THEN QbeGen.CopyOp(qres, q) END
     ELSE
       t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
@@ -1625,7 +1643,7 @@ PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
       QbeGen.CopyOp(qa, q); t := SymTab.BoolType()
     ELSIF SymTab.Equal(nm, "ABS") THEN
       LowerExpr(AST.Child(n, 1), et, q);
-      QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal);
+      QbeGen.AbsQ(q, qa, SymTab.IsRealType(et));
       QbeGen.CopyOp(qa, q); t := et
     ELSIF SymTab.Equal(nm, "CAP") THEN
       LowerExpr(AST.Child(n, 1), et, q);
@@ -1667,9 +1685,13 @@ PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
     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 SymTab.ClassOf(dt) = SymTab.ClSReal THEN
         IF isMax THEN QbeGen.NormReal("3.402823e38", q)
         ELSE QbeGen.NormReal("-3.402823e38", q) END;
+        t := SymTab.ShortRealType()
+      ELSIF SymTab.ClassOf(dt) = SymTab.ClReal THEN
+        IF isMax THEN QbeGen.NormReal("1.7976931348623157e308", q)
+        ELSE QbeGen.NormReal("-1.7976931348623157e308", q) END;
         t := SymTab.RealType()
       ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
         IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
@@ -1750,16 +1772,22 @@ PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
         ELSIF ((c1 = SymTab.ClInt) OR (c1 = SymTab.ClByte)
             OR (c1 = SymTab.ClSByte) OR (c1 = SymTab.ClWord16)
             OR (c1 = SymTab.ClSWord16))
-           AND (c2 = SymTab.ClReal) THEN
+           AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
           QbeGen.ConvIR(q, qa); QbeGen.CopyOp(qa, q); t := vt
-        ELSIF (c1 = SymTab.ClLong) AND (c2 = SymTab.ClReal) THEN
+        ELSIF (c1 = SymTab.ClLong)
+           AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
           QbeGen.ConvLR(q, qa); QbeGen.CopyOp(qa, q); t := vt
-        ELSIF (c1 = SymTab.ClReal) AND ((c2 = SymTab.ClInt)
+        ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
+           AND ((c2 = SymTab.ClInt)
             OR (c2 = SymTab.ClByte) OR (c2 = SymTab.ClSByte)
             OR (c2 = SymTab.ClWord16) OR (c2 = SymTab.ClSWord16)) THEN
           QbeGen.ConvRI(q, qa); QbeGen.CopyOp(qa, q); t := vt
-        ELSIF (c1 = SymTab.ClReal) AND (c2 = SymTab.ClLong) THEN
+        ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
+           AND (c2 = SymTab.ClLong) THEN
           QbeGen.ConvRL(q, qa); QbeGen.CopyOp(qa, q); t := vt
+        ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
+           AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
+          t := vt
         ELSIF (c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt) THEN
           (* a set as its (first) machine word *)
           QbeGen.LoadW(q, qa); QbeGen.CopyOp(qa, q); t := vt
@@ -2012,7 +2040,7 @@ PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex;
           IF NOT QbeGen.CallArg(qa, "l") THEN END
         END
       ELSE
-        conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at);
+        conv := SymTab.IsRealType(ft) AND SymTab.IsIntFamily(at);
         IF conv THEN
           QbeGen.ConvIR(qe, qt);
           IF NOT QbeGen.CallArg(qt, "d") THEN END
@@ -2333,7 +2361,7 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
       IF AST.Op(n) = AST.OpSub THEN
         IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q)
         ELSE QbeGen.NewTemp(qt);
-          QbeGen.NegQ(q, qt, SymTab.ClassOf(t) = SymTab.ClReal);
+          QbeGen.NegQ(q, qt, SymTab.IsRealType(t));
           QbeGen.CopyOp(qt, q)
         END
       ELSE
@@ -2395,7 +2423,7 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
           QbeGen.CmpLong(rop, q, q2, qt);
           t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
         ELSE
-          isR := (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClReal);
+          isR := (t # SymTab.InvalidType) AND SymTab.IsRealType(t);
           t := SymTab.BoolType();
           QbeGen.Cmp(rop, q, q2, qt, isR);
           QbeGen.CopyOp(qt, q)
@@ -2502,15 +2530,14 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
           t := SymTab.NewUStr(); QbeGen.CopyOp(qt, q)
         ELSE
           lt := t; rt := t2;
-          IF (SymTab.ClassOf(lt) = SymTab.ClReal)
-             OR (SymTab.ClassOf(rt) = SymTab.ClReal) THEN
+          IF SymTab.IsRealType(lt) OR SymTab.IsRealType(rt) THEN
             t := SymTab.RealType()
           ELSIF SymTab.IsLongFamily(lt) OR SymTab.IsLongFamily(rt) THEN
             t := SymTab.LongType()
           ELSE t := SymTab.IntType()
           END;
           isL := SymTab.IsLongFamily(t);
-          isR := SymTab.ClassOf(t) = SymTab.ClReal;
+          isR := SymTab.IsRealType(t);
           kind := 0;
           IF op = AST.OpSub THEN kind := 1
           ELSIF op = AST.OpMul THEN kind := 2
@@ -2602,7 +2629,7 @@ PROCEDURE LowerStmt (seq: AST.Node);
         QbeGen.CopyOp("0", qe); et := SymTab.CharType()
       END;
       CheckSub(dt, qe);
-      isR := (dt # SymTab.InvalidType) AND (SymTab.ClassOf(dt) = SymTab.ClReal);
+      isR := (dt # SymTab.InvalidType) AND SymTab.IsRealType(dt);
       conv := isR AND SymTab.IsIntFamily(et);
       wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt)
                AND SymTab.IsIntFamily(et);
@@ -2648,7 +2675,14 @@ PROCEDURE LowerStmt (seq: AST.Node);
           IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql)
           ELSE QbeGen.StoreLong(qn, qe)
           END
-        ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE)
+        ELSIF conv THEN
+          QbeGen.ConvIR(qe, qt);
+          IF SymTab.IsShortReal(dt) THEN
+            QbeGen.StoreShortReal(qn, qt)
+          ELSE QbeGen.StoreVar(qn, qt, TRUE)
+          END
+        ELSIF SymTab.IsShortReal(dt) THEN
+          QbeGen.StoreShortReal(qn, qe)
         ELSE QbeGen.StoreVar(qn, qe, isR)
         END
       END
@@ -2791,9 +2825,18 @@ PROCEDURE LowerStmt (seq: AST.Node);
           END;
           QbeGen.EmitRet("0", FALSE)
         ELSE
-          conv := (SymTab.ClassOf(SymTab.CurRes()) = SymTab.ClReal)
-                  AND SymTab.IsIntFamily(t);
-          IF conv THEN QbeGen.ConvIR(q, qt); QbeGen.EmitRet(qt, TRUE)
+          IF (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs)) THEN
+            t2 := procRes[emitProc]
+          ELSE t2 := SymTab.CurRes()
+          END;
+          conv := SymTab.IsRealType(t2) AND SymTab.IsIntFamily(t);
+          IF conv THEN
+            QbeGen.ConvIR(q, qt);
+            IF SymTab.IsShortReal(t2) THEN
+              QbeGen.ConvSR(qt, q); QbeGen.EmitRet(q, TRUE)
+            ELSE QbeGen.EmitRet(qt, TRUE) END
+          ELSIF SymTab.IsShortReal(t2) THEN
+            QbeGen.ConvSR(q, qt); QbeGen.EmitRet(qt, TRUE)
           ELSE QbeGen.EmitRet(q, TRUE)
           END
         END

compiler/src/M2.atg

@@ -548,7 +548,7 @@ PROCEDURE ConsOk (cons: INTEGER; t: SymTab.TypeIndex): BOOLEAN;
           OR (SymTab.ClassOf(t) = SymTab.ClSByte)
           OR (SymTab.ClassOf(t) = SymTab.ClWord16)
           OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
-    ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
+    ELSIF cons = 3 THEN RETURN SymTab.IsRealType(t)
     ELSIF cons = 4 THEN RETURN SymTab.ClassOf(t) = SymTab.ClPtr
     ELSIF cons = 5 THEN
       RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
@@ -560,7 +560,7 @@ PROCEDURE ConsOk (cons: INTEGER; t: SymTab.TypeIndex): BOOLEAN;
           OR (SymTab.ClassOf(t) = SymTab.ClSByte)
           OR (SymTab.ClassOf(t) = SymTab.ClWord16)
           OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
-          OR (SymTab.ClassOf(t) = SymTab.ClReal)
+          OR SymTab.IsRealType(t)
     END;
     RETURN TRUE
   END ConsOk;
@@ -578,6 +578,11 @@ PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
         OR (c = SymTab.ClWord16) OR (c = SymTab.ClSWord16)
   END OrdClass;
 
+PROCEDURE RealCls (c: INTEGER): BOOLEAN;
+  BEGIN
+    RETURN (c = SymTab.ClReal) OR (c = SymTab.ClSReal)
+  END RealCls;
+
 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32): BOOLEAN;
 (* Records an outermost body span for the re-parse pass (milestone 2).
    FALSE when the span table is full (an implementation limit): the
@@ -2192,6 +2197,8 @@ PRODUCTIONS
  AND (cls # SymTab.ClRecord)
  AND (cls # SymTab.ClPtr)
  AND (cls # SymTab.ClLong)
+ AND (cls # SymTab.ClSReal)
+ AND (cls # SymTab.ClCBool)
  AND (cls # SymTab.ClProc)
  AND (cls # SymTab.ClUChar)
  AND (cls # SymTab.ClUStr)
@@ -2653,8 +2660,7 @@ PRODUCTIONS
                                            SemError(230) END;
                                          isR := (dt #
                                                  SymTab.InvalidType)
- AND (SymTab.ClassOf(dt)
-                                                   = SymTab.ClReal);
+ AND SymTab.IsRealType(dt);
                                          conv := isR
  AND SymTab.IsIntFamily(et);
                                          wconv := (dt #
@@ -3233,6 +3239,10 @@ PRODUCTIONS
                                                         = SymTab.ClEnum)
                                                     OR (cls
                                                         = SymTab.ClReal)
+                                                    OR (cls
+                                                        = SymTab.ClSReal)
+                                                    OR (cls
+                                                        = SymTab.ClCBool)
                                                     OR (cls
                                                         = SymTab.ClLong)
                                                     OR (cls
@@ -3256,10 +3266,17 @@ PRODUCTIONS
                                                       OR (cls = SymTab.ClSByte)
                                                       OR (cls = SymTab.ClWord16)
                                                       OR (cls = SymTab.ClSWord16)
+                                                      OR (cls = SymTab.ClSReal)
+                                                      OR (cls = SymTab.ClCBool)
                                                       OR (cls = SymTab.ClBool))
   AND SymTab.GetSymVal(n, cv)
   AND QbeGen.IsImm(cv) THEN
                                                      QbeGen.CopyOp(cv, q)
+                                                   ELSIF cls = SymTab.ClSReal THEN
+                                                     QbeGen.LoadShortReal(n, q)
+                                                   ELSIF cls = SymTab.ClCBool THEN
+                                                     QbeGen.LoadShortVar(n,
+                                                       FALSE, 1, q)
                                                    ELSE
                                                      QbeGen.LoadVar(n,
                                                        cls = SymTab.ClReal,
@@ -3296,6 +3313,8 @@ PRODUCTIONS
                                                   AND (cls # SymTab.ClUChar)
                                                   AND (cls # SymTab.ClEnum)
                                                   AND (cls # SymTab.ClReal)
+                                                  AND (cls # SymTab.ClSReal)
+                                                  AND (cls # SymTab.ClCBool)
                                                   AND (cls # SymTab.ClPtr)
                                                   AND (cls # SymTab.ClProc)
                                                   AND (cls # SymTab.ClLong)
@@ -3750,7 +3769,7 @@ PRODUCTIONS
              ELSE SemError(211); t := SymTab.InvalidType END;
              IF t # SymTab.InvalidType THEN
                isL := SymTab.IsLongFamily(t);
-               isR := SymTab.ClassOf(t) = SymTab.ClReal;
+               isR := SymTab.IsRealType(t);
                folded := FALSE;
                IF (NOT isL) AND (NOT isR)
   AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
@@ -3825,7 +3844,7 @@ PRODUCTIONS
            ELSE SemError(211); t := SymTab.InvalidType END;
            IF t # SymTab.InvalidType THEN
              isL := SymTab.IsLongFamily(t);
-             isR := SymTab.ClassOf(t) = SymTab.ClReal;
+             isR := SymTab.IsRealType(t);
              folded := FALSE;
              IF (NOT isL) AND (NOT isR)
   AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
@@ -4204,7 +4223,7 @@ PRODUCTIONS
    IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
    astCur := astNode; astIsLit := TRUE;
                                            IF (dt # SymTab.InvalidType)
- AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
+ AND SymTab.IsRealType(dt) THEN
                                              (* REAL/LONGREAL: the
                                                 implementation bounds *)
                                              IF isMax THEN
@@ -4340,8 +4359,7 @@ PRODUCTIONS
    astCur := astNode; astIsLit := TRUE; .)
                                         (. IF (et # SymTab.InvalidType)
  AND NOT SymTab.IsIntFamily(et)
- AND (SymTab.ClassOf(et) #
-                                                SymTab.ClReal) THEN
+ AND NOT SymTab.IsRealType(et) THEN
                                              SemError(211)
                                             ELSIF QbeGen.IsImm(q)
   AND SymTab.ConstInt(q, lo) THEN
@@ -4419,23 +4437,23 @@ PRODUCTIONS
                                                ELSIF ((c1 = SymTab.ClInt)
     OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
     OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
-  AND (c2 = SymTab.ClReal) THEN
+  AND RealCls(c2) THEN
                                                  IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
                                                  QbeGen.CopyOp(qa, q);
                                                  t := vt
                                                ELSIF (c1 = SymTab.ClLong)
-  AND (c2 = SymTab.ClReal) THEN
+  AND RealCls(c2) THEN
                                                  IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
                                                  QbeGen.CopyOp(qa, q);
                                                  t := vt
-                                               ELSIF (c1 = SymTab.ClReal)
+                                               ELSIF RealCls(c1)
   AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
     OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
     OR (c2 = SymTab.ClSWord16)) THEN
                                                  QbeGen.ConvRI(q, qa);
                                                  QbeGen.CopyOp(qa, q);
                                                  t := vt
-                                               ELSIF (c1 = SymTab.ClReal)
+                                               ELSIF RealCls(c1)
   AND (c2 = SymTab.ClLong) THEN
                                                  QbeGen.ConvRL(q, qa);
                                                  QbeGen.CopyOp(qa, q);
@@ -4482,8 +4500,8 @@ PRODUCTIONS
   OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
   OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
                                                  t := vt
-                                               ELSIF (c1 = SymTab.ClReal)
- AND (c2 = SymTab.ClReal) THEN
+                                               ELSIF RealCls(c1)
+ AND RealCls(c2) THEN
                                                  t := vt
                                                ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
   OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN

compiler/src/QbeGen.def

@@ -213,6 +213,9 @@ PROCEDURE LoadShortVar (name: ARRAY OF CHAR; signed: BOOLEAN;
                         bytes: CARDINAL; VAR q: QVal);
 (* Load a BYTE/SBYTE (bytes=1) or WORD16/INTEGER16 (bytes=2) variable:
    loadub/loadsb or loaduh/loadsh; locals use their recorded type. *)
+
+PROCEDURE LoadShortReal (name: ARRAY OF CHAR; VAR q: QVal);
+(* Load a SHORTREAL/REAL32 and widen it to a double expression value. *)
 PROCEDURE StoreShortVar (name: ARRAY OF CHAR; bytes: CARDINAL;
                          q: ARRAY OF CHAR);
 (* Store a 1- or 2-byte variable (storeb/storeh truncates). *)
@@ -229,6 +232,9 @@ PROCEDURE LoadDesignator (name: ARRAY OF CHAR; t: INTEGER; k: INTEGER;
 PROCEDURE StoreVar (name: ARRAY OF CHAR; q: ARRAY OF CHAR; isReal: BOOLEAN);
 (* "storew q, $name" (isReal reserved; step 1: FALSE). *)
 
+PROCEDURE StoreShortReal (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
+(* Narrow a double expression value and store it as a 4-byte float. *)
+
 PROCEDURE StorePtr (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
 (* "storel q, $name". *)
 
@@ -269,6 +275,15 @@ PROCEDURE ConvLR (a: ARRAY OF CHAR; VAR q: QVal);
 PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
 (* q := fresh double holding "swtof a" (INTEGER -> REAL widening). *)
 
+PROCEDURE ConvSR (a: ARRAY OF CHAR; VAR q: QVal);
+(* q := fresh single holding "truncd a" (double -> SHORTREAL). *)
+
+PROCEDURE ConvRS (a: ARRAY OF CHAR; VAR q: QVal);
+(* q := fresh double holding "exts a" (SHORTREAL -> double). *)
+
+PROCEDURE MaskCBool (a: ARRAY OF CHAR; VAR q: QVal);
+(* Normalize a C _Bool result/load to 0 or 1. *)
+
 PROCEDURE CopyOp (s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
 
 PROCEDURE NoteAddr (val: ARRAY OF CHAR; addr: ARRAY OF CHAR);

compiler/src/QbeGen.mod

@@ -17,6 +17,7 @@ VAR
   nR     : CARDINAL;  (* non-zero REAL consts flushed at BeginBody *)
   rNames : ARRAY [0 .. 31] OF QVal;
   rVals  : ARRAY [0 .. 31] OF QVal;
+  rShort : ARRAY [0 .. 31] OF BOOLEAN;
   nStr   : CARDINAL;  (* string-literal data counter *)
   strNams : ARRAY [0 .. 4095] OF QVal;
   strTexts : ARRAY [0 .. 4095] OF ARRAY [0 .. 255] OF CHAR;
@@ -650,6 +651,16 @@ PROCEDURE DataLine (name: ARRAY OF CHAR; isReal: BOOLEAN;
     WL(" }")
   END DataLine;
 
+PROCEDURE DataLineS (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
+(* A 4-byte single-precision global. *)
+  BEGIN
+    IF NOT opened THEN RETURN END;
+    W("export data $"); W(name);
+    W(" = { s ");
+    W(init);
+    WL(" }")
+  END DataLineS;
+
 PROCEDURE DataLineB (name: ARRAY OF CHAR; init: ARRAY OF CHAR);
 (* A one-byte global (BYTE/SBYTE). *)
   BEGIN
@@ -710,6 +721,7 @@ PROCEDURE DeclVar (name: ARRAY OF CHAR; t: INTEGER);
     Cpy(g, curModName); App(g, "_"); App(g, name);
     IF SymTab.IsBigSet(t) THEN DataLineL(g, "0")
     ELSIF SymTab.ClassOf(t) = SymTab.ClReal THEN DataLine(g, TRUE, "0")
+    ELSIF SymTab.ClassOf(t) = SymTab.ClSReal THEN DataLineS(g, "0")
     ELSIF SymTab.IsByteType(t) THEN DataLineB(g, "0")
     ELSIF SymTab.IsWord16Type(t) THEN DataLineH(g, "0")
     ELSIF SymTab.ClassOf(t) = SymTab.ClArray THEN DeclArr(g, t)
@@ -770,7 +782,14 @@ PROCEDURE DeclConst (name: ARRAY OF CHAR; val: ARRAY OF CHAR; t: INTEGER);
          non-zero REALs flush at BeginBody. *)
       DataLine(mang, TRUE, "0");
       IF NOT IsZeroReal(val) AND (nR <= HIGH(rNames)) THEN
-        Cpy(rNames[nR], mang); Cpy(rVals[nR], val); INC(nR)
+        Cpy(rNames[nR], mang); Cpy(rVals[nR], val);
+        rShort[nR] := FALSE; INC(nR)
+      END
+    ELSIF cls = SymTab.ClSReal THEN
+      DataLineS(mang, "0");
+      IF NOT IsZeroReal(val) AND (nR <= HIGH(rNames)) THEN
+        Cpy(rNames[nR], mang); Cpy(rVals[nR], val);
+        rShort[nR] := TRUE; INC(nR)
       END
     ELSE DataLine(mang, FALSE, val)
     END
@@ -837,9 +856,15 @@ PROCEDURE BeginBody;
     inBody := TRUE;
     i := 0;
     WHILE i < nR DO
-      NewTemp(t);
-      W("  "); W(t); W(" =d copy "); WL(rVals[i]);
-      StoreVar(rNames[i], t, TRUE);
+      IF rShort[i] THEN
+        NewTemp(t);
+        W("  "); W(t); W(" =s truncd "); WL(rVals[i]);
+        W("  stores "); W(t); W(", $"); WL(rNames[i])
+      ELSE
+        NewTemp(t);
+        W("  "); W(t); W(" =d copy "); WL(rVals[i]);
+        StoreVar(rNames[i], t, TRUE)
+      END;
       INC(i)
     END;
     i := 0;
@@ -1083,6 +1108,7 @@ PROCEDURE ResClass (t: INTEGER): CHAR;
   BEGIN
     cls := SymTab.ClassOf(t);
     IF cls = SymTab.ClReal THEN RETURN "d" END;
+    IF cls = SymTab.ClSReal THEN RETURN "s" END;
     IF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
        OR (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
        OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
@@ -1183,11 +1209,15 @@ PROCEDURE AllocLocal (t: INTEGER; VAR slot: QVal);
     ELSIF cls = SymTab.ClReal THEN
       W(" =l alloc8 8"); WL("");
       W("  stored d_0.0, "); WL(slot)
+    ELSIF cls = SymTab.ClSReal THEN
+      W(" =l alloc4 4"); WL("");
+      W("  stores s_0.0, "); WL(slot)
     ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClLong)
        OR (cls = SymTab.ClProc) THEN
       W(" =l alloc8 8"); WL("");
       W("  storel 0, "); WL(slot)
-    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
+    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte)
+       OR (cls = SymTab.ClCBool) THEN
       W(" =l alloc4 4"); WL("");
       W("  storeb 0, "); WL(slot)
     ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
@@ -1333,11 +1363,15 @@ PROCEDURE EndFuncHeader;
         ELSIF cls = SymTab.ClReal THEN
           Revive;
           W("  stored "); W(parTmp[i]); W(", "); WL(slot)
+        ELSIF cls = SymTab.ClSReal THEN
+          Revive;
+          W("  stores "); W(parTmp[i]); W(", "); WL(slot)
         ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
            OR (cls = SymTab.ClLong) THEN
           Revive;
           W("  storel "); W(parTmp[i]); W(", "); WL(slot)
-        ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
+        ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte)
+           OR (cls = SymTab.ClCBool) THEN
           Revive;
           W("  storeb "); W(parTmp[i]); W(", "); WL(slot)
         ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
@@ -1377,6 +1411,7 @@ PROCEDURE EndFunc (resT: INTEGER);
          language functionException instead of silently returning 0. *)
       TrapCode(4)
     ELSIF rc = "d" THEN WL("  ret d_0.0")
+    ELSIF rc = "s" THEN WL("  ret s_0.0")
     ELSIF rc = "l" THEN WL("  ret 0")
     ELSE WL("  ret 0")
     END;
@@ -1663,11 +1698,22 @@ PROCEDURE NewTemp (VAR t: QVal);
 PROCEDURE LocLoadFlat (idx: INTEGER; long: BOOLEAN; VAR q: QVal);
 (* Loads a same-scope entry: slots/data by class (or long for
    pointers), addr entries via ElemLoad. *)
+  VAR raw: QVal;
   BEGIN
     IF locTag[idx] = 2 THEN
       ElemLoad(locRep[idx], locTyp[idx], q);
       RETURN
     END;
+    IF (NOT long) AND (locCls[idx] = "s") THEN
+      NewTemp(raw);
+      Revive;
+      W("  "); W(raw); W(" =s loads ");
+      IF locTag[idx] = 1 THEN W("$") END;
+      WL(locRep[idx]);
+      NewTemp(q);
+      W("  "); W(q); W(" =d exts "); WL(raw);
+      RETURN
+    END;
     NewTemp(q);
     Revive;
     W("  "); W(q);
@@ -1690,11 +1736,21 @@ PROCEDURE LocLoadFlat (idx: INTEGER; long: BOOLEAN; VAR q: QVal);
 PROCEDURE LocStoreFlat (idx: INTEGER; q: ARRAY OF CHAR; long: BOOLEAN);
 (* Stores a same-scope entry: slots/data by class (or long), addr
    via ElemStore. Data stores are grammar-unreachable (consts). *)
+  VAR tmp: QVal;
   BEGIN
     IF locTag[idx] = 2 THEN
       ElemStore(locRep[idx], q, locTyp[idx]);
       RETURN
     END;
+    IF (NOT long) AND (locCls[idx] = "s") THEN
+      NewTemp(tmp);
+      Revive;
+      W("  "); W(tmp); W(" =s truncd "); WL(q);
+      W("  stores "); W(tmp); W(", ");
+      IF locTag[idx] = 1 THEN W("$") END;
+      WL(locRep[idx]);
+      RETURN
+    END;
     Revive;
     IF long THEN W("  storel ")
     ELSIF locCls[idx] = "d" THEN W("  stored ")
@@ -1715,6 +1771,14 @@ PROCEDURE UpLoad (flat: INTEGER; levels: CARDINAL; long: BOOLEAN;
     rel : CARDINAL;
   BEGIN
     IF locTag[flat] = 1 THEN
+      IF (NOT long) AND (locCls[flat] = "s") THEN
+        NewTemp(a);
+        Revive;
+        W("  "); W(a); W(" =s loads $"); WL(locRep[flat]);
+        NewTemp(q);
+        W("  "); W(q); W(" =d exts "); WL(a);
+        RETURN
+      END;
       NewTemp(q);
       Revive;
       W("  "); W(q);
@@ -1744,6 +1808,13 @@ PROCEDURE UpStore (flat: INTEGER; levels: CARDINAL; q: ARRAY OF CHAR;
     rel : CARDINAL;
   BEGIN
     IF locTag[flat] = 1 THEN
+      IF (NOT long) AND (locCls[flat] = "s") THEN
+        NewTemp(a);
+        Revive;
+        W("  "); W(a); W(" =s truncd "); WL(q);
+        W("  stores "); W(a); W(", $"); WL(locRep[flat]);
+        RETURN
+      END;
       Revive;
       IF long THEN W("  storel ")
       ELSIF locCls[flat] = "d" THEN W("  stored ")
@@ -1803,6 +1874,10 @@ PROCEDURE LoadDesignator (name: ARRAY OF CHAR; t: INTEGER; k: INTEGER;
          OR (cls = SymTab.ClChar) OR (cls = SymTab.ClEnum)
          OR (cls = SymTab.ClReal) THEN
         LoadVar(name, cls = SymTab.ClReal, q); RETURN TRUE
+      ELSIF cls = SymTab.ClSReal THEN
+        LoadShortReal(name, q); RETURN TRUE
+      ELSIF cls = SymTab.ClCBool THEN
+        LoadShortVar(name, FALSE, 1, q); RETURN TRUE
       ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
         LoadPtr(name, q); RETURN TRUE
       ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClSet)
@@ -1984,6 +2059,43 @@ PROCEDURE StorePtr (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
     W("  storel "); W(q); W(", "); WL(ref)
   END StorePtr;
 
+PROCEDURE LoadShortReal (name: ARRAY OF CHAR; VAR q: QVal);
+  VAR idx : INTEGER;
+    levels : CARDINAL;
+    ref, raw : QVal;
+  BEGIN
+    IF LocFindUp(name, levels, idx) THEN
+      IF levels = 0 THEN LocLoadFlat(idx, FALSE, q)
+      ELSE UpLoad(idx, levels, FALSE, q)
+      END;
+      RETURN
+    END;
+    NewTemp(raw);
+    Revive;
+    SymRef(name, ref);
+    W("  "); W(raw); W(" =s loads "); WL(ref);
+    NewTemp(q);
+    W("  "); W(q); W(" =d exts "); WL(raw)
+  END LoadShortReal;
+
+PROCEDURE StoreShortReal (name: ARRAY OF CHAR; q: ARRAY OF CHAR);
+  VAR idx : INTEGER;
+    levels : CARDINAL;
+    ref, raw : QVal;
+  BEGIN
+    IF LocFindUp(name, levels, idx) THEN
+      IF levels = 0 THEN LocStoreFlat(idx, q, FALSE)
+      ELSE UpStore(idx, levels, q, FALSE)
+      END;
+      RETURN
+    END;
+    NewTemp(raw);
+    Revive;
+    SymRef(name, ref);
+    W("  "); W(raw); W(" =s truncd "); WL(q);
+    W("  stores "); W(raw); W(", "); WL(ref)
+  END StoreShortReal;
+
 PROCEDURE Op3 (mn: ARRAY OF CHAR; res, l, r: ARRAY OF CHAR;
                isReal: BOOLEAN);
   BEGIN
@@ -2028,6 +2140,29 @@ PROCEDURE ConvIR (a: ARRAY OF CHAR; VAR q: QVal);
     W("  "); W(q); W(" =d swtof "); WL(a)
   END ConvIR;
 
+PROCEDURE ConvSR (a: ARRAY OF CHAR; VAR q: QVal);
+(* REAL (double expression value) -> SHORTREAL storage/ABI (s). *)
+  BEGIN
+    NewTemp(q);
+    Revive;
+    W("  "); W(q); W(" =s truncd "); WL(a)
+  END ConvSR;
+
+PROCEDURE ConvRS (a: ARRAY OF CHAR; VAR q: QVal);
+(* SHORTREAL (s) -> REAL (double expression value) (exts). *)
+  BEGIN
+    NewTemp(q);
+    Revive;
+    W("  "); W(q); W(" =d exts "); WL(a)
+  END ConvRS;
+
+PROCEDURE MaskCBool (a: ARRAY OF CHAR; VAR q: QVal);
+  BEGIN
+    NewTemp(q);
+    Revive;
+    W("  "); W(q); W(" =w and "); W(a); WL(", 1")
+  END MaskCBool;
+
 PROCEDURE NarrowLong (a: ARRAY OF CHAR; VAR q: QVal);
 (* LONGINT (l) -> INTEGER (w): keep the low 32 bits. *)
   BEGIN
@@ -2236,9 +2371,10 @@ PROCEDURE ElemSize (t: SymTab.TypeIndex): CARDINAL;
     et := SymTab.ArrayElem(t);
     cls := SymTab.ClassOf(et);
     IF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
-       OR (cls = SymTab.ClSByte) THEN RETURN 1
+       OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN RETURN 1
     ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN RETURN 2
     ELSIF cls = SymTab.ClReal THEN RETURN 8
+    ELSIF cls = SymTab.ClSReal THEN RETURN 4
     ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
        OR (cls = SymTab.ClLong) THEN RETURN 8
     ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass)
@@ -2372,8 +2508,10 @@ PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
          ft := SymTab.FieldType(rt, fn);
          cls := SymTab.ClassOf(ft);
          IF cls = SymTab.ClReal THEN Sep; W("d 0")
+         ELSIF cls = SymTab.ClSReal THEN Sep; W("s 0")
          ELSIF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
-            OR (cls = SymTab.ClSByte) THEN Sep; W("b 0")
+            OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN
+           Sep; W("b 0")
          ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
            Sep; W("h 0")
          ELSIF cls = SymTab.ClArray THEN
@@ -2438,10 +2576,12 @@ PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
         IntStr(VAL(INTEGER, (n + 1) * 4), bv);
         W(bv)
       ELSE
-        IF (ecls = SymTab.ClByte) OR (ecls = SymTab.ClSByte) THEN esz := 1
+        IF (ecls = SymTab.ClByte) OR (ecls = SymTab.ClSByte)
+           OR (ecls = SymTab.ClCBool) THEN esz := 1
         ELSIF (ecls = SymTab.ClWord16) OR (ecls = SymTab.ClSWord16) THEN esz := 2
         ELSIF (ecls = SymTab.ClReal) OR (ecls = SymTab.ClPtr)
            OR (ecls = SymTab.ClProc) OR (ecls = SymTab.ClLong) THEN esz := 8
+        ELSIF ecls = SymTab.ClSReal THEN esz := 4
         ELSIF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass)
            OR (ecls = SymTab.ClSet) THEN
           (* inline footprint, not a fixed 4 (same fix as ElemSize) *)
@@ -2597,8 +2737,10 @@ PROCEDURE RecItems (t: SymTab.TypeIndex; prefix: ARRAY OF CHAR;
       ft := SymTab.FieldType(t, fn);
       cls := SymTab.ClassOf(ft);
       IF cls = SymTab.ClReal THEN Sep; W("d 0")
+      ELSIF cls = SymTab.ClSReal THEN Sep; W("s 0")
       ELSIF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
-         OR (cls = SymTab.ClSByte) THEN Sep; W("b 0")
+         OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN
+        Sep; W("b 0")
       ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
         Sep; W("h 0")
       ELSIF cls = SymTab.ClArray THEN
@@ -3663,7 +3805,8 @@ PROCEDURE ViewToOpen1D (view: ARRAY OF CHAR; ft: INTEGER;
     NewTemp(total);
     Op3L("mul", total, count, elem);
     cls := SymTab.ClassOf(SymTab.ArrayElem(ft));
-    IF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
+    IF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte)
+       OR (cls = SymTab.ClCBool) THEN
       CopyOp(total, count)
     END;
     extra := 0;
@@ -3749,9 +3892,17 @@ PROCEDURE OpenSize (desc: ARRAY OF CHAR; ft: INTEGER; VAR q: QVal);
 PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
 (* Loads one element of (element-)type t. Nested/pointer elements
    are addresses (loadl). *)
-  VAR cls: INTEGER;
+  VAR cls: INTEGER; raw: QVal;
   BEGIN
     cls := SymTab.ClassOf(t);
+    IF cls = SymTab.ClSReal THEN
+      NewTemp(raw);
+      Revive;
+      W("  "); W(raw); W(" =s loads "); WL(addr);
+      NewTemp(q);
+      W("  "); W(q); W(" =d exts "); WL(raw);
+      RETURN
+    END;
     NewTemp(q);
     Revive;
     W("  "); W(q);
@@ -3768,7 +3919,7 @@ PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
         W(" =w loaduh ")
       ELSE W(" =w loadw ")
       END
-    ELSIF cls = SymTab.ClByte THEN W(" =w loadub ")
+    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClCBool) THEN W(" =w loadub ")
     ELSIF cls = SymTab.ClSByte THEN W(" =w loadsb ")
     ELSIF cls = SymTab.ClWord16 THEN W(" =w loaduh ")
     ELSIF cls = SymTab.ClSWord16 THEN W(" =w loadsh ")
@@ -3778,9 +3929,16 @@ PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
   END ElemLoad;
 
 PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
-  VAR cls: INTEGER;
+  VAR cls: INTEGER; raw: QVal;
   BEGIN
     cls := SymTab.ClassOf(t);
+    IF cls = SymTab.ClSReal THEN
+      NewTemp(raw);
+      Revive;
+      W("  "); W(raw); W(" =s truncd "); WL(v);
+      W("  stores "); W(raw); W(", "); WL(addr);
+      RETURN
+    END;
     Revive;
     IF cls = SymTab.ClReal THEN W("  stored ")
     ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
@@ -3795,7 +3953,8 @@ PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
         W("  storeh ")
       ELSE W("  storew ")
       END
-    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN W("  storeb ")
+    ELSIF (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte)
+       OR (cls = SymTab.ClCBool) THEN W("  storeb ")
     ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN W("  storeh ")
     ELSE W("  storew ")
     END;
@@ -4281,12 +4440,14 @@ PROCEDURE CtorItem (VAR buf: ARRAY OF CHAR; v: ARRAY OF CHAR;
   BEGIN
     App(buf, ", ");
     IF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
-       OR (cls = SymTab.ClSByte) THEN
+       OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN
       App(buf, "b ")
     ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
       App(buf, "h ")
     ELSIF cls = SymTab.ClReal THEN
       App(buf, "d ")
+    ELSIF cls = SymTab.ClSReal THEN
+      App(buf, "s ")
     ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
        OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray) THEN
       App(buf, "l ")
@@ -4301,8 +4462,11 @@ PROCEDURE RecItem (VAR s: ARRAY OF CHAR; VAR first: BOOLEAN;
 (* Record field item with a leading separator when not first. *)
   BEGIN
     IF first THEN first := FALSE ELSE App(s, ", ") END;
-    IF cls = SymTab.ClChar THEN App(s, "b ")
+    IF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
+       OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN
+      App(s, "b ")
     ELSIF cls = SymTab.ClReal THEN App(s, "d ")
+    ELSIF cls = SymTab.ClSReal THEN App(s, "s ")
     ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
        OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray) THEN
       App(s, "l ")
@@ -4335,6 +4499,8 @@ PROCEDURE ArrZeroBody (VAR s: ARRAY OF CHAR; t: INTEGER);
       IF (ecls = SymTab.ClReal) OR (ecls = SymTab.ClPtr)
          OR (ecls = SymTab.ClProc) OR (ecls = SymTab.ClArray)
          OR (ecls = SymTab.ClLong) THEN esz := 8
+      ELSIF (ecls = SymTab.ClByte) OR (ecls = SymTab.ClSByte)
+         OR (ecls = SymTab.ClCBool) THEN esz := 1
       ELSE esz := 4
       END;
       IF n > 0 THEN
@@ -4372,7 +4538,9 @@ PROCEDURE RecItemDefaults (VAR s: ARRAY OF CHAR; VAR first: BOOLEAN;
       cls := SymTab.ClassOf(ft);
       IF first THEN first := FALSE ELSE App(s, ", ") END;
       IF cls = SymTab.ClReal THEN App(s, "d 0")
-      ELSIF cls = SymTab.ClChar THEN App(s, "b 0")
+      ELSIF cls = SymTab.ClSReal THEN App(s, "s 0")
+      ELSIF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
+         OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN App(s, "b 0")
       ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
       ELSIF cls = SymTab.ClSet THEN
         w := VAL(INTEGER, SymTab.SetWords(ft));
@@ -4718,7 +4886,9 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
       ELSE
         IF first THEN first := FALSE ELSE App(s, ", ") END;
         IF cls = SymTab.ClReal THEN App(s, "d 0")
-        ELSIF cls = SymTab.ClChar THEN App(s, "b 0")
+        ELSIF cls = SymTab.ClSReal THEN App(s, "s 0")
+        ELSIF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
+           OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN App(s, "b 0")
         ELSIF cls = SymTab.ClArray THEN
           IF SymTab.IsMultiArray(ft) THEN
             AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
@@ -4865,10 +5035,11 @@ PROCEDURE CtorEnd (VAR q: QVal);
           ELSIF (SymTab.ClassOf(ft) = SymTab.ClArray)
              AND SymTab.IsMultiArray(ft) THEN
             ClearMultiField(a, ft)
-          ELSIF (SymTab.ClassOf(ft) = SymTab.ClReal)
+          ELSIF SymTab.IsRealType(ft)
              OR (SymTab.ClassOf(ft) = SymTab.ClChar)
              OR (SymTab.ClassOf(ft) = SymTab.ClInt)
              OR (SymTab.ClassOf(ft) = SymTab.ClBool)
+             OR (SymTab.ClassOf(ft) = SymTab.ClCBool)
              OR (SymTab.ClassOf(ft) = SymTab.ClEnum)
              OR (SymTab.ClassOf(ft) = SymTab.ClLong)
              OR (SymTab.ClassOf(ft) = SymTab.ClPtr)

compiler/src/SymTab.def

@@ -51,6 +51,8 @@ CONST
   ClSByte   = 18;
   ClWord16  = 19;
   ClSWord16 = 20;
+  ClSReal   = 21;  (* SHORTREAL/REAL32: 4-byte float *)
+  ClCBool   = 22;  (* CBool: 1-byte C _Bool *)
 
   (* operator codes for RelCheck *)
   OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
@@ -517,8 +519,10 @@ PROCEDURE IntType (): TypeIndex;
 PROCEDURE UCharType (): TypeIndex;
 (* UCHAR: 32-bit Unicode codepoint (QBE w). *)
 PROCEDURE RealType (): TypeIndex;
+PROCEDURE ShortRealType (): TypeIndex;
 PROCEDURE CharType (): TypeIndex;
 PROCEDURE BoolType (): TypeIndex;
+PROCEDURE CBoolType (): TypeIndex;
 PROCEDURE LongType (): TypeIndex;
 (* LONGINT/LONGCARD: 64-bit integer (QBE l). *)
 PROCEDURE AddrType (): TypeIndex;
@@ -535,6 +539,15 @@ PROCEDURE ClassOf (t: TypeIndex): INTEGER;
 PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
 (* INTEGER, CARDINAL or subrange thereof (Invalid suppresses). *)
 
+PROCEDURE IsRealType (t: TypeIndex): BOOLEAN;
+(* TRUE for REAL/LONGREAL or SHORTREAL/REAL32. *)
+
+PROCEDURE IsShortReal (t: TypeIndex): BOOLEAN;
+(* TRUE for the 4-byte SHORTREAL/REAL32 representation. *)
+
+PROCEDURE IsCBool (t: TypeIndex): BOOLEAN;
+(* TRUE for the 1-byte C _Bool representation. *)
+
 PROCEDURE IsByteType (t: TypeIndex): BOOLEAN;
 (* BYTE/SBYTE (8-bit storage; values are passed as 32-bit words). *)
 

compiler/src/SymTab.mod

@@ -21,6 +21,7 @@ CONST
   FClass = 13; FOpenArr = 14; FNil = 15; FLong = 16; FProc = 17;
   FUChar = 18; FUStr = 19; FByte = 20; FSByte = 21;
   FWord16 = 22; FSWord16 = 23; FPackSet = 24; FBigSet = 25;
+  FReal32 = 26; FCBool = 27;
 
   (* signatures compared by the strict 231 check are bounded to this many
      formals (self-hosting uses far fewer). *)
@@ -153,6 +154,7 @@ VAR
   nProc : CARDINAL;
   nextUid : CARDINAL;
   dInt, dCard, dReal, dChar, dBool, dNil, dAddr, dLong : TypeIndex;
+  dSReal, dCBool : TypeIndex;
   dOpenChar : TypeIndex; (* ARRAY OF CHAR: the printf format formal *)
   dUChar : TypeIndex;    (* UCHAR: 32-bit codepoint *)
   dByte, dSByte : TypeIndex;  (* true 8-bit BYTE / SBYTE *)
@@ -1151,10 +1153,27 @@ PROCEDURE LongType (): TypeIndex;
   BEGIN RETURN dLong END LongType;
 PROCEDURE RealType (): TypeIndex;
   BEGIN RETURN dReal END RealType;
+PROCEDURE ShortRealType (): TypeIndex;
+  BEGIN RETURN dSReal END ShortRealType;
 PROCEDURE CharType (): TypeIndex;
   BEGIN RETURN dChar END CharType;
 PROCEDURE BoolType (): TypeIndex;
   BEGIN RETURN dBool END BoolType;
+PROCEDURE CBoolType (): TypeIndex;
+  BEGIN RETURN dCBool END CBoolType;
+
+PROCEDURE IsRealType (t: TypeIndex): BOOLEAN;
+  VAR c: INTEGER;
+  BEGIN
+    c := ClassOf(t);
+    RETURN (c = ClReal) OR (c = ClSReal)
+  END IsRealType;
+
+PROCEDURE IsShortReal (t: TypeIndex): BOOLEAN;
+  BEGIN RETURN ClassOf(t) = ClSReal END IsShortReal;
+
+PROCEDURE IsCBool (t: TypeIndex): BOOLEAN;
+  BEGIN RETURN ClassOf(t) = ClCBool END IsCBool;
 
 PROCEDURE ClassOf (t: TypeIndex): INTEGER;
   VAR r: TypeIndex;
@@ -1176,6 +1195,8 @@ PROCEDURE ClassOf (t: TypeIndex): INTEGER;
     | FSWord16 : RETURN ClSWord16
     | FLong : RETURN ClLong
     | FReal : RETURN ClReal
+    | FReal32 : RETURN ClSReal
+    | FCBool : RETURN ClCBool
     | FChar : RETURN ClChar
     | FBool : RETURN ClBool
     | FEnum : RETURN ClEnum
@@ -1210,7 +1231,7 @@ PROCEDURE IsByteType (t: TypeIndex): BOOLEAN;
   VAR c: INTEGER;
   BEGIN
     c := ClassOf(t);
-    RETURN (c = ClByte) OR (c = ClSByte)
+    RETURN (c = ClByte) OR (c = ClSByte) OR (c = ClCBool)
   END IsByteType;
 
 PROCEDURE IsSignedByte (t: TypeIndex): BOOLEAN;
@@ -1234,7 +1255,7 @@ PROCEDURE IsSmallInt (t: TypeIndex): BOOLEAN;
   VAR c: INTEGER;
   BEGIN
     c := ClassOf(t);
-    RETURN (c = ClByte) OR (c = ClSByte)
+    RETURN (c = ClByte) OR (c = ClSByte) OR (c = ClCBool)
         OR (c = ClWord16) OR (c = ClSWord16)
   END IsSmallInt;
 
@@ -1242,7 +1263,7 @@ PROCEDURE SmallIntBytes (t: TypeIndex): CARDINAL;
   VAR c: INTEGER;
   BEGIN
     c := ClassOf(t);
-    IF (c = ClByte) OR (c = ClSByte) THEN RETURN 1 END;
+    IF (c = ClByte) OR (c = ClSByte) OR (c = ClCBool) THEN RETURN 1 END;
     IF (c = ClWord16) OR (c = ClSWord16) THEN RETURN 2 END;
     RETURN 0
   END SmallIntBytes;
@@ -1635,7 +1656,8 @@ PROCEDURE ElemBytes (t: TypeIndex): CARDINAL;
   VAR cls: INTEGER;
   BEGIN
     cls := ClassOf(ArrayElem(t));
-    IF (cls = ClChar) OR (cls = ClByte) OR (cls = ClSByte) THEN
+    IF (cls = ClChar) OR (cls = ClByte) OR (cls = ClSByte)
+       OR (cls = ClCBool) THEN
       RETURN 1
     END;
     IF (cls = ClWord16) OR (cls = ClSWord16) THEN
@@ -1643,6 +1665,7 @@ PROCEDURE ElemBytes (t: TypeIndex): CARDINAL;
     END;
     IF cls = ClSet THEN RETURN TypeSize(ArrayElem(t)) END;
     IF cls = ClReal THEN RETURN 8 END;
+    IF cls = ClSReal THEN RETURN 4 END;
     IF (cls = ClArray) OR (cls = ClPtr) OR (cls = ClRecord)
        OR (cls = ClClass) OR (cls = ClProc) THEN
       RETURN 8
@@ -1678,12 +1701,14 @@ PROCEDURE ArrayLeafBytes (t: TypeIndex): CARDINAL;
     END;
     IF cur = InvalidType THEN RETURN 0 END;
     cls := ClassOf(cur);
-    IF (cls = ClChar) OR (cls = ClByte) OR (cls = ClSByte) THEN RETURN 1
+    IF (cls = ClChar) OR (cls = ClByte) OR (cls = ClSByte)
+       OR (cls = ClCBool) THEN RETURN 1
     ELSIF (cls = ClWord16) OR (cls = ClSWord16) THEN RETURN 2
     ELSIF (cls = ClRecord) OR (cls = ClClass) OR (cls = ClSet) THEN
       RETURN TypeSize(cur)
     ELSIF (cls = ClReal) OR (cls = ClLong) OR (cls = ClPtr)
        OR (cls = ClProc) OR (cls = ClStr) THEN RETURN 8
+    ELSIF cls = ClSReal THEN RETURN 4
     ELSIF cls = ClInvalid THEN RETURN 0
     ELSE RETURN 4
     END
@@ -1757,10 +1782,11 @@ PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
     IF r = InvalidType THEN RETURN 0 END;
     CASE tform[r] OF
       FInt, FBool, FChar, FUChar : RETURN 4
-    | FByte, FSByte : RETURN 1
+    | FByte, FSByte, FCBool : RETURN 1
     | FWord16, FSWord16 : RETURN 2
     | FLong : RETURN 8
     | FReal : RETURN 8
+    | FReal32 : RETURN 4
     | FEnum, FSub : RETURN 4
     | FSet : RETURN SetWords(t) * 4
     | FBigSet : RETURN 8
@@ -3568,7 +3594,16 @@ PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
     IF IsIntFamily(src) AND (ClassOf(dst) = ClLong) THEN
       RETURN TRUE
     END;
-    IF IsIntFamily(src) AND (ClassOf(dst) = ClReal) THEN
+    IF IsIntFamily(src) AND IsRealType(dst) THEN
+      RETURN TRUE
+    END;
+    IF IsRealType(src) AND IsRealType(dst) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClCBool) AND (ClassOf(dst) = ClBool) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClBool) AND (ClassOf(dst) = ClCBool) THEN
       RETURN TRUE
     END;
     RETURN FALSE
@@ -3587,16 +3622,18 @@ PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
     IF IsIntFamily(l) AND IsIntFamily(r) THEN
       res := dInt; RETURN TRUE
     END;
-    IF NOT divmod AND (ClassOf(l) = ClReal) AND (ClassOf(r) = ClReal) THEN
+    IF NOT divmod AND IsRealType(l) AND IsRealType(r) THEN
       res := dReal; RETURN TRUE
     END;
     RETURN FALSE
   END ArithCheck;
 
 PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+  VAR c: INTEGER;
   BEGIN
     IF Resolve(t) = InvalidType THEN RETURN TRUE END;
-    RETURN ClassOf(t) = ClBool
+    c := ClassOf(t);
+    RETURN (c = ClBool) OR (c = ClCBool)
   END BoolCheck;
 
 PROCEDURE IsStrType (t: TypeIndex): BOOLEAN;
@@ -3694,7 +3731,10 @@ PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
     END;
     IF (ClassOf(l) = ClLong) AND IsIntFamily(r) THEN RETURN TRUE END;
     IF IsIntFamily(l) AND (ClassOf(r) = ClLong) THEN RETURN TRUE END;
-    IF (ClassOf(l) = ClReal) AND (ClassOf(r) = ClReal) THEN
+    IF IsRealType(l) AND IsRealType(r) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClCBool) AND (ClassOf(r) = ClCBool) THEN
       RETURN TRUE
     END;
     IF (ClassOf(l) = ClChar) AND (ClassOf(r) = ClChar) THEN
@@ -3728,7 +3768,10 @@ PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
     END;
     IF (ClassOf(l) = ClLong) AND IsIntFamily(r) THEN RETURN TRUE END;
     IF IsIntFamily(l) AND (ClassOf(r) = ClLong) THEN RETURN TRUE END;
-    IF (ClassOf(l) = ClReal) AND (ClassOf(r) = ClReal) THEN
+    IF IsRealType(l) AND IsRealType(r) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClCBool) AND (ClassOf(r) = ClCBool) THEN
       RETURN TRUE
     END;
     IF (ClassOf(l) = ClChar) AND (ClassOf(r) = ClChar) THEN
@@ -3888,6 +3931,8 @@ PROCEDURE Init;
     dInt := NewDesc(FInt, InvalidType);
     dCard := NewDesc(FInt, InvalidType);
     dReal := NewDesc(FReal, InvalidType);
+    dSReal := NewDesc(FReal32, InvalidType);
+    dCBool := NewDesc(FCBool, InvalidType);
     dChar := NewDesc(FChar, InvalidType);
     dOpenChar := NewOpenArray(dChar);      (* printf format: ARRAY OF CHAR *)
     dBool := NewDesc(FBool, InvalidType);
@@ -3930,9 +3975,11 @@ PROCEDURE Init;
     Predef("LOC", KindPredef, dAddr);
     (* gm2 sized/scalar names (mapped onto V3's families) *)
     Predef("LONGCARD", KindPredef, dLong);
-    Predef("SHORTREAL", KindPredef, dReal);
-    Predef("REAL32", KindPredef, dReal);
+    Predef("SHORTREAL", KindPredef, dSReal);
+    Predef("REAL32", KindPredef, dSReal);
     Predef("REAL64", KindPredef, dReal);
+    Predef("CBool", KindPredef, dCBool);
+    Predef("CBOOL", KindPredef, dCBool);
     Predef("INTEGER8", KindPredef, dSByte);
     Predef("INTEGER16", KindPredef, dSW16);
     Predef("INTEGER32", KindPredef, dInt);

compiler/tests/cabi_scalars.def

@@ -0,0 +1,11 @@
+DEFINITION MODULE FOR "C" CAbiScalars;
+(* 4-byte float and 1-byte C _Bool boundary test. *)
+
+EXPORT UNQUALIFIED f32_add, cbool_not;
+
+PROCEDURE f32_add (a, b : SHORTREAL) : SHORTREAL;
+  EXTERNAL "m2_f32_add";
+PROCEDURE cbool_not (b : CBool) : CBool;
+  EXTERNAL "m2_cbool_not";
+
+END CAbiScalars.

compiler/tests/cabi_scalars_prog.mod

@@ -0,0 +1,17 @@
+MODULE CAbiScalarsProg;
+FROM CAbiScalars IMPORT f32_add, cbool_not;
+
+VAR
+  ExitCode : INTEGER;
+  x : SHORTREAL;
+  b : CBool;
+
+BEGIN
+  x := f32_add(1.5, 2.25);
+  b := cbool_not(TRUE);
+  IF (x = 3.75) AND (NOT b) THEN
+    ExitCode := 42
+  ELSE
+    ExitCode := 1
+  END
+END CAbiScalarsProg.

compiler/tests/t_f32.mod

@@ -0,0 +1,14 @@
+MODULE TF32;
+VAR
+  ExitCode : INTEGER;
+  x : SHORTREAL;
+  z : REAL32;
+  y : REAL;
+  b : CBool;
+BEGIN
+  x := 1.5;
+  z := 2.25;
+  y := x + z;
+  b := TRUE;
+  IF (y = 3.75) AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TF32.

compiler/tests/t_f32conv.mod

@@ -0,0 +1,6 @@
+MODULE TF32Conv;
+VAR ExitCode : INTEGER; x : SHORTREAL;
+BEGIN
+  x := SHORTREAL(1.5);
+  IF x = 1.5 THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TF32Conv.

compiler/tests/t_f32field.mod

@@ -0,0 +1,18 @@
+MODULE TF32Field;
+TYPE R = RECORD x : SHORTREAL; b : CBool; END;
+VAR ExitCode : INTEGER;
+    r : R;
+    a : ARRAY [0..1] OF SHORTREAL;
+BEGIN
+  r.x := 1.5;
+  r.b := TRUE;
+  a[0] := 2.25;
+  a[1] := 3.0;
+  IF (r.x = 1.5) AND r.b
+     AND (a[0] = 2.25) AND (a[1] = 3.0)
+     AND (SIZE(SHORTREAL) = 4) AND (SIZE(CBool) = 1) THEN
+    ExitCode := 42
+  ELSE
+    ExitCode := 1
+  END
+END TF32Field.

compiler/tests/t_f32proc.mod

@@ -0,0 +1,16 @@
+MODULE TF32Proc;
+VAR ExitCode : INTEGER;
+PROCEDURE add (a, b : SHORTREAL) : SHORTREAL;
+BEGIN
+  RETURN a + b
+END add;
+PROCEDURE flag (x : CBool) : CBool;
+BEGIN
+  RETURN x
+END flag;
+VAR x : SHORTREAL; b : CBool;
+BEGIN
+  x := add(1.5, 2.25);
+  b := flag(TRUE);
+  IF (x = 3.75) AND b THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TF32Proc.

docs/comparison-PIM4-gm2-V3.md

@@ -85,7 +85,7 @@ change individual cells.
 | Complex types (`COMPLEX`, `LONGCOMPLEX`) | ❌ | ✅ (ISO) | ❌ (not in the base R10 grammar) | ❌ | ❌ (`COMPLEX64` is a `REAL` placeholder) |
 | SYSTEM sized types (`WORD32`, `CARDINAL8`, `BITSET32`, …) | ❌ | ✅ | 🔄 `OCTET` (8-bit), `LONGCARD`, `LONGBITSET` | 🔄 `SHORTINT`/`LONGINT`/`SHORTCARD`/`LONGCARD` family | ✅ 8/16/32 names; `WORD`/`WORD32` 32-bit |
 | `BYTE` granularity | ✅ 8-bit | ✅ 8-bit | ✅ `OCTET` 8-bit | ✅ (PIM `BYTE`) | ✅ `BYTE`/`SBYTE`/`WORD8`/`CARDINAL8`/`INTEGER8` are 8-bit; `ARRAY OF BYTE` is a real buffer |
-| `SHORTREAL` (32-bit) | ❌ | ✅ | ❌ (REAL/LONGREAL) | ⚠️ dialect-dependent | ❌ (all reals are 8 bytes) |
+| `SHORTREAL` (32-bit) | ❌ | ✅ | ❌ (REAL/LONGREAL) | ⚠️ dialect-dependent | ✅ true 4-byte `SHORTREAL`/`REAL32` |
 | `ADDRESS` arithmetic (`ADDADR`/`SUBADR`/`DIFADR`) | ❌ | ✅ | ❌ | ❌ | ❌ |
 | Absolute variables `VAR [addr]: T` | ❌ | ✅ (extension) | ✅ (pragma `ADDR`) | ❌ | ❌ |
 | Set ordering (`<`, `<=`, `>`, `>=`) | ❌ (`=`/`#`/`IN` only) | ✅ (extension) | ❌ | ❌ | ❌ |
@@ -179,8 +179,9 @@ change individual cells.
 - **Word model:** `BYTE`/`SBYTE`/`WORD8`/`CARDINAL8`/`INTEGER8` are
   true 8-bit types (`SIZE` 1), `WORD16`/`CARDINAL16`/`INTEGER16` are
   true 16-bit types (`SIZE` 2); `INTEGER`/`CARDINAL`/`WORD`/`WORD32`
-  are 32-bit; `LONGINT`/`LONGCARD` are 64-bit; every `REAL`/`SHORTREAL`
-  is 8 bytes; `COMPLEX*` is a placeholder.
+  are 32-bit; `LONGINT`/`LONGCARD` are 64-bit; `REAL`/`LONGREAL`
+  are 8 bytes, while `SHORTREAL`/`REAL32` are true 4-byte floats;
+  `COMPLEX*` is a placeholder.
 - **Sets:** bases limited to bool/char/byte/16-bit/enum/small subranges;
   bounded `SET` spans up to 1,000,000 bits; `SET OF CARDINAL` and
   `SET OF INTEGER` use sorted range lists over the full base range.

docs/features.md

@@ -92,6 +92,11 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
 - ✅ `EXTERNAL "c_symbol"` link aliases, in implementations and
   `FOR "C"` definitions; external link names use a 256-character
   `SymTab.LinkName`, so short Modula-2 names can bind long C symbols.
+- ✅ True 4-byte `SHORTREAL`/`REAL32` storage and C ABI (`s`): scalar
+  variables, parameters, results, records, arrays, conversions and
+  arithmetic (expressions use double internally).
+- ✅ `CBool`/`CBOOL`: 1-byte C `_Bool` storage and ABI; loads/stores
+  use byte access and external results are normalized to 0/1.
 - ✅ Set builtins `INCL`/`EXCL` and `SHIFT`/`ROTATE`; `SET OF <enum>`
   and `SET OF <char-range>`; bounded sets up to 1,000,000 bits;
   `SET OF CARDINAL` and `SET OF INTEGER` use a sorted range-list

runtime/syslib/shim.c

@@ -429,6 +429,17 @@ long m2_this_is_a_very_long_c_symbol_name_for_link_alias_test_0123456789(
     return a + b;
 }
 
+/* C ABI scalar tests: 4-byte float and 1-byte _Bool. */
+float m2_f32_add(float a, float b)
+{
+    return a + b;
+}
+
+_Bool m2_cbool_not(_Bool b)
+{
+    return !b;
+}
+
 /* UString length: the codepoint count is the descriptor's header. */
 long m2ustrlen(long *s)
 {