Просмотр исходного кода

calc: REAL constants, comparisons and arithmetic (ladder 35135)

REAL literals are converted at run time by real_val from a code-resident
ASCIIZ blob; comparisons use real_cmp over a 12-byte block; + - * / use
real_add/sub/mul/div.  SaveLeft parks a REAL left operand in a scratch,
integer constants are converted to MBF, and unary minus toggles the sign byte.

The prerequisites exposed by Fact/Factor also landed: direct self-recursion
(the result variable shadows the function name; a following '(' resolves to
the function symbol), enum-indexed arrays, string-array typed constants, and
local REAL variables.

t100_realexpr covers literals, comparisons and all four operations;
t101_recursion covers fact(5).  Both execute under qemu and Exec86.

The CALC ladder moves 32482 -> 35135; the next blocker is the Copy string
builtin, then real Val and the transcendental math functions (Abs, Sqrt, Sqr,
Sin, Cos, Arctan, Ln, Exp).

Verified: compile matrix 102/102, ladder 1/1, 93 .COM linked, 88 executed
under both qemu and Exec86, rt_exec 276/276, nonvacuity 121/121, run_all ALL
PASS.
Eric Streit 5 дней назад
Родитель
Сommit
30782f631b

+ 21 - 8
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | position | blocker |
 |---|---|
-| **32482** | `I > 0.0` in `Fact` — REAL constants and comparisons (`ERR 102`) |
+| **35135** | `Copy(Formula,Start,...)` in `Factor` — string Copy builtin (`ERR 41`) |
 
 Rungs behind it (now passed):
 
@@ -145,7 +145,12 @@ Rungs ahead:
 | 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
 | 32096 | REAL function result (`Expression:Real`) - DONE |
 | 32284 | value REAL parameter (`Fact(I : Real)`) - DONE |
-| 32482 | REAL constants/comparisons (`I > 0.0`) |
+| 32482 | REAL constants/comparisons/arithmetic - DONE |
+| 32564 | self-recursion (`Fact`) - DONE |
+| 33374 | enum-indexed array (`array[Standardfunction]`) - DONE |
+| 33537 | string-array typed constant (`StandardfunctionNames`) - DONE |
+| 33778 | local REAL variable (`F : Real`) - DONE |
+| 35135 | `Copy` string builtin |
 
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
@@ -469,8 +474,8 @@ membership, string fields in WRITE, real output, run-time set algebra,
 file control-block operations, VAR string parameters, `Chr`, typed-file
 block I/O, text-file output, `Str`, pointer types with `New`/dereference,
 text `Eof`/`Readln`, integer `Str`, integer `Val`, and VAR REAL parameters). The
-ladder has moved from the first typed constant at 7,791 to **32,482**, where
-`I > 0.0` asks for REAL constants and comparisons.
+ladder has moved from the first typed constant at 7,791 to **35,135**, where
+`Copy(Formula,Start,...)` asks for the string Copy builtin.
 
 The rung commits and their tags, in order (each is one rung with its own
 fixture, red proof, and — where the harness allows — execution under qemu and
@@ -516,7 +521,8 @@ Exec86):
 | `e940a1d` | `v-TP3-CALC-TEXTREAD` | `ERR 41 28074` (`Val`) |
 | `9d4ab01` | `v-TP3-CALC-VALINT` | `ERR 102 31758` (VAR REAL) |
 | `a4e72bf` | `v-TP3-CALC-VARREAL` | `ERR 102 32096` (REAL function result) |
-| *(this commit)* | `v-TP3-CALC-REALFUNC` | **`ERR 102 32482`** (REAL constants) |
+| `884edba` | `v-TP3-CALC-REALFUNC` | `ERR 102 32482` (REAL constants) |
+| *(this commit)* | `v-TP3-CALC-REALEXPR` | **`ERR 41 35135`** (`Copy`) |
 
 - **Code HEAD** is the layout rung (`v-TP3-CALC-LAYOUT`).  Nothing is pushed.
   The terminal-config work (`v-TP3-TERMCFG`) and the editor key map
@@ -562,6 +568,12 @@ Exec86):
   parameter slot holds the caller's address; assignment, `Read`, `Length`,
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `Chr(n)` folds or loads an ordinal and yields a CHAR.
+- **REAL expressions are landed (`t100_realexpr`).**  REAL literals are
+  parsed at run time by `real_val` from a code-resident ASCIIZ blob;
+  comparisons use `real_cmp`; `+ - * /` use `real_add/sub/mul/div` through a
+  12-byte block, with integer constants converted to MBF.  Self-recursion,
+  enum-indexed arrays, string-array typed constants and local REAL variables
+  were the prerequisites exposed along the way (`t101_recursion`).
 - **REAL function results and value REAL parameters are landed**
   (`t98_realfunc`, `t99_valreal`).  A REAL function's caller supplies a
   six-byte scratch address in DI; the callee saves it in a hidden local and
@@ -1187,9 +1199,10 @@ and TEXT file output is done (`t91_textout`), both compile-only because the
 harness has no filesystem.  `Str` real formatting is done (`t92_strreal`),
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 text `Eof`/`Readln` plus integer `Str` are done (`t94_textread`/`t95_strint`).
-The next ladder blocker is a REAL constant/comparison (`I > 0.0` in `Fact`),
-then the rest of real arithmetic.  The probe scaffold is at HDR=0x1300 / data
-0x2110; the runtime is 4,384 bytes and now has room for the remaining work.
+The next ladder blocker is the `Copy` string builtin, then real `Val` and the
+transcendental functions (`Abs`, `Sqrt`, `Sqr`, `Sin`, `Cos`, `Arctan`, `Ln`,
+`Exp`).  The probe scaffold is at HDR=0x1300 / data 0x2110; the runtime is
+4,386 bytes and now has room for the remaining work.
 
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),

+ 4 - 3
SUMMARY.md

@@ -2044,7 +2044,7 @@ the compiler *emitting* a 16,560-byte program). The ratchet and front-end
 features through **file control-block operations and the original memory
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 `tests/fixtures/calc_ladder.tsv`, run by `run_all.sh`; CALC.PAS now stops at
-`ERR 102` at pos 32482, `I > 0.0` in Fact), the `{$I}` include,
+`ERR 41` at pos 35135, `Copy(Formula,...)` in Factor), the `{$I}` include,
 `^X`/`#nn`, scalar typed constants, sets, enums, records (CellRec = 80),
 subranges, arrays, element/field access, file types, string value parameters,
 `Length`, the CRT identifiers (`ClrScr`/`GotoXY`/`ClrEol`/`LowVideo`/
@@ -2064,8 +2064,9 @@ parameters plus `Chr` (`t89`), typed-file block I/O (`t90`, compile-only), and
 text-file output (`t91`, compile-only), `Str` real formatting (`t92`), and
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 (`t94`), integer `Str` (`t95`), and integer `Val` (`t96`). The next rung is
-REAL function results (`t98`) and value REAL parameters (`t99`). The next
-rung is REAL constants/comparisons (`I > 0.0`). The runtime is 3,907 bytes / 39 entries and its probe
+REAL function results (`t98`), value REAL parameters (`t99`), REAL
+literals/comparisons/arithmetic (`t100`) and self-recursion (`t101`). The next
+rung is the `Copy` string builtin, then real `Val` and the transcendentals. The runtime is 3,907 bytes / 39 entries and its probe
 scaffold is nearly full, so the next runtime addition must move HDR. Items 1-4
 below are independent of both tracks.
 

+ 258 - 28
shell/Compiler.mod

@@ -168,7 +168,7 @@ CONST
       compiled to a + b.  Only the constant-folding path was right, which is
       why n * n with n a CONST was correct and a * b with a a variable was
       not. *)
-   OpAdd = 1 ;  OpSub = 2 ;  OpMul = 3 ;
+   OpAdd = 1 ;  OpSub = 2 ;  OpMul = 3 ;  OpDiv = 4 ;
 
    (* TP3 error numbers *)
    ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
@@ -388,6 +388,9 @@ VAR
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : CARDINAL ;
    TU_WrReal   : CARDINAL ;  TU_RealWrite : CARDINAL ;  TU_RealFmt : CARDINAL ;
+   TU_RealVal   : CARDINAL ;  TU_RealCmp : CARDINAL ;
+   TU_RealAdd   : CARDINAL ;  TU_RealSub : CARDINAL ;
+   TU_RealMul   : CARDINAL ;  TU_RealDiv : CARDINAL ;
    TU_WrLn     : CARDINAL ;
    TU_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
@@ -1323,6 +1326,10 @@ BEGIN
    END
 END EmLoadVar ;
 
+PROCEDURE EmXorByteGlob (off, v : CARDINAL) ;
+BEGIN Ebyte (80H) ; Ebyte (36H) ; Eword ((off + LoadBias) MOD 10000H) ;
+      Ebyte (VAL (BYTE, v)) END EmXorByteGlob ;
+
 PROCEDURE EmStoreVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
 BEGIN
    IF nbytes = 1 THEN
@@ -2371,6 +2378,11 @@ PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
 PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ; FORWARD ;
 PROCEDURE SlotSize (cls, size : CARDINAL) : CARDINAL ; FORWARD ;
 PROCEDURE ParamSlotBytes (e : SymEntry) : CARDINAL ; FORWARD ;
+PROCEDURE NewScratchReal () : CARDINAL ; FORWARD ;
+PROCEDURE EmPushRealAddr (r : ERes) ; FORWARD ;
+PROCEDURE EmCopyRealTo (dstOff : CARDINAL ; r : ERes) ; FORWARD ;
+PROCEDURE RealBin (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ; FORWARD ;
+PROCEDURE IntToMbf (v : LONGINT ; VAR b : ARRAY OF CHAR) ; FORWARD ;
 
 (* ---------------------------------------------------------------- *)
 (*  expressions  (TPSRC9)                                           *)
@@ -2829,6 +2841,10 @@ PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
 VAR f : LONGINT ;
     okc : BOOLEAN ;
 BEGIN
+   IF (left.cls = TReal) OR (right.cls = TReal) THEN
+      RealBin (op, left, right, res) ;
+      RETURN
+   END ;
    IF StrOperand (left) OR StrOperand (right) THEN
       (* A string OPERAND - a STRING or a CHAR, which is a one-character string
          for this purpose - makes this a string operation, and `+' is the only
@@ -2939,6 +2955,7 @@ END ConstCmp ;
 (* ---------------------------------------------------------------- *)
 
 PROCEDURE SaveLeft (VAR left : ERes) ;
+VAR sk : CARDINAL ;
 (* Called the moment the operator has been recognised, i.e. *before* the
    right-hand operand is parsed.
 
@@ -2961,7 +2978,17 @@ PROCEDURE SaveLeft (VAR left : ERes) ;
    ORed the *second* comparison's result with itself - which is why it
    printed FALSE for TRUE or FALSE. *)
 BEGIN
-   IF left.kind = 2 THEN
+   IF left.cls = TReal THEN
+      (* Park six bytes in a fresh scratch, exactly as kind-5 does for a
+         scalar: the right-hand parse may reuse DI or call a routine. *)
+      sk := NewScratchReal () ;
+      EmCopyRealTo (symtab [sk].off, left) ;
+      left.idx := sk ;
+      left.kind := 1 ;
+      left.cls := TReal ;
+      left.sz := 6 ;
+      left.boff := 0
+   ELSIF left.kind = 2 THEN
       EmPushAx () ;
       left.kind := 4                      (* 4 = on the top of the stack *)
    ELSIF left.kind = 5 THEN
@@ -3050,6 +3077,28 @@ BEGIN
    RETURN here
 END EmStrBlob ;
 
+PROCEDURE EmAsciiZLiteral (start, stop : CARDINAL) : CARDINAL ;
+(* Emit the source text [start,stop) as a NUL-terminated code-resident string
+   behind a JMP and return its image offset.  Used for REAL literals, which are
+   parsed by the runtime's ascreal rather than by a host-side decimal parser. *)
+VAR here, n, len : CARDINAL ;
+BEGIN
+   len := stop - start ;
+   IF len <= 126 THEN
+      Ebyte (0EBH) ; Ebyte (VAL (BYTE, len + 1))
+   ELSE
+      Ebyte (0E9H) ; Eword (len + 1)
+   END ;
+   here := pc ;
+   n := start ;
+   WHILE n < stop DO
+      Ebyte (VAL (BYTE, ORD (CharAt (n)))) ;
+      INC (n)
+   END ;
+   Ebyte (0) ;
+   RETURN here
+END EmAsciiZLiteral ;
+
 PROCEDURE EmPushSetAddr (r : ERes) ;
 (* Push the ADDRESS of a set value: the runtime's set entries take addresses.
    A set literal/typed constant is code-resident (kind 7), a set-expression
@@ -3238,6 +3287,34 @@ BEGIN
    Ebyte (0E2H) ; Ebyte (0F8H)        (* LOOP back *)
 END EmPushRealSlot ;
 
+PROCEDURE EmCopyRealTo (dstOff : CARDINAL ; r : ERes) ;
+(* Copy six REAL bytes from r's address into the image global at dstOff, or
+   materialise an integer constant there as MBF. *)
+VAR k : CARDINAL ;
+    rbuf : ARRAY [0..5] OF CHAR ;
+BEGIN
+   IF r.cls = TReal THEN
+      EmPushRealAddr (r) ;
+      EmPopSi () ;
+      EmLeaDi (FALSE, dstOff) ;
+      EmMovCxi (6) ;
+      Ebyte (8AH) ; Ebyte (04H) ;      (* MOV AL,[SI] *)
+      Ebyte (88H) ; Ebyte (05H) ;      (* MOV [DI],AL *)
+      Ebyte (46H) ; Ebyte (47H) ;
+      Ebyte (0E2H) ; Ebyte (0F8H)      (* LOOP -8 *)
+   ELSIF (r.cls = TScalar) AND (r.kind = 0) THEN
+      IntToMbf (r.imm, rbuf) ;
+      k := 0 ;
+      WHILE k < 6 DO
+         EmMovAxi (ORD (rbuf [k])) ;
+         EmStoreVar (FALSE, (dstOff + k) MOD 10000H, 1) ;
+         INC (k)
+      END
+   ELSE
+      Err (ENoLib)
+   END
+END EmCopyRealTo ;
+
 PROCEDURE EmPushStrSlot (r : ERes ; reserve, copyN : CARDINAL) ;
 (* Push a STRING VALUE argument's whole slot: reserve `reserve' bytes on the
    stack and copy `copyN' of the source string's <len><chars> into them, so
@@ -3584,6 +3661,14 @@ BEGIN
    RETURN symTop - 1
 END NewScratchReal ;
 
+PROCEDURE NewScratchRealBlock () : CARDINAL ;
+(* Twelve bytes for a binary REAL operation: a followed by b. *)
+BEGIN
+   DropC (NewSym ("@@RB", KVar, TReal, 12, 6, dc, 0, FALSE)) ;
+   dc := dc + 12 ;
+   RETURN symTop - 1
+END NewScratchRealBlock ;
+
 PROCEDURE StrOperand (r : ERes) : BOOLEAN ;
 (* Is r usable as one operand of `+'?  A STRING, or a CHAR - which can appear
    three ways: a quoted literal (cls TScalar with chr set), a CHAR variable
@@ -3703,7 +3788,7 @@ PROCEDURE ParseCmp (VAR r : ERes) ;
 VAR op : CARDINAL ;
     left, right : ERes ;
     f : LONGINT ;
-    size, base : CARDINAL ;
+    size, base, block : CARDINAL ;
 BEGIN
    ParseAdd (r) ;
    LOOP
@@ -3807,6 +3892,34 @@ BEGIN
          EmRelSetcc (op) ;
          r.kind := 2 ;
          r.cls := TBool
+      ELSIF left.cls = TReal THEN
+         (* REAL comparison: recmp takes one 12-byte block holding a then b.
+            SaveLeft parks the left address; the right is copied first when it
+            is DI-addressed, before the block copy clobbers DI. *)
+         SaveLeft (left) ;
+         ParseAdd (right) ;
+         IF NOT OK () THEN
+            RETURN
+         END ;
+         IF right.cls # TReal THEN
+            Err (ETypeErr) ;
+            RETURN
+         END ;
+         block := NewScratchRealBlock () ;
+         IF right.kind = 5 THEN
+            EmCopyRealTo (symtab [block].off + 6, right) ;
+            EmCopyRealTo (symtab [block].off, left)
+         ELSE
+            EmCopyRealTo (symtab [block].off, left) ;
+            EmCopyRealTo (symtab [block].off + 6, right)
+         END ;
+         EmPushVarAddr (FALSE, symtab [block].off) ;
+         DropC (EmCall (TU_RealCmp)) ;
+         EmAddSp (2) ;
+         EmOrAxAx () ;
+         EmRelSetcc (op) ;
+         r.kind := 2 ;
+         r.cls := TBool
       ELSE
          SaveLeft (left) ;
          ParseAdd (right) ;
@@ -3903,7 +4016,7 @@ BEGIN
       IF CurCh () = '*' THEN
          op := OpMul ; DropCh (GetCh ())   (* OpAdd here meant a*b -> a+b *)
       ELSIF CurCh () = '/' THEN
-         op := 2 ; DropCh (GetCh ()) ; Err (ENoLib)
+         op := OpDiv ; DropCh (GetCh ())
       ELSIF KwAhead ("DIV") THEN
          GetWord () ; op := TkDiv
       ELSIF KwAhead ("MOD") THEN
@@ -3913,9 +4026,6 @@ BEGIN
       ELSE
          RETURN
       END ;
-      IF op = 2 THEN
-         RETURN
-      END ;
       left := r ;
       IF left.cls = TSet THEN
          (* Set intersection.  Same push-before-the-right rule as ParseAdd. *)
@@ -3959,7 +4069,15 @@ BEGIN
    ELSIF CurCh () = '-' THEN
       DropCh (GetCh ()) ;
       ParseNeg (r) ;
-      IF r.kind = 0 THEN
+      IF r.cls = TReal THEN
+         r.idx := NewScratchReal () ;
+         EmCopyRealTo (symtab [r.idx].off, r) ;
+         EmXorByteGlob (symtab [r.idx].off + 5, 80H) ;
+         r.kind := 1 ;
+         r.cls := TReal ;
+         r.sz := 6 ;
+         r.boff := 0
+      ELSIF r.kind = 0 THEN
          r.imm := VAL (LONGINT, W16 (0 - r.imm))
       ELSE
          LoadAtom (r) ;
@@ -4058,6 +4176,7 @@ VAR idx : CARDINAL ;
     ssize, sbase : CARDINAL ;
     sbuf : ARRAY [0..31] OF CHAR ;
     uj1, uj2 : CARDINAL ;
+    litStart, scratch, asciiAddr : CARDINAL ;
 BEGIN
    r.chr := FALSE ;            (* default: not a quoted char literal *)
    Skip () ;
@@ -4092,11 +4211,25 @@ BEGIN
          caret (^M) or decimal (#27) character constant is a character too. *)
       quoted := (ORD (CurCh ()) = AposC) OR (CurCh () = '^')
                 OR (CurCh () = '#') ;
+      litStart := srcPos ;
       RdConst (r.imm, r.cls, strf) ;
       r.chr := quoted AND (r.cls = TScalar) AND NOT strf ;
       IF r.cls = TReal THEN
-         Err (ENoLib) ;
-         r.kind := 2 ;
+         (* A REAL literal is converted at run time by ascreal.  Keep the
+            literal text as an ASCIIZ code blob and call real_val into a
+            six-byte scratch; the expression then behaves like a REAL
+            variable whose address is the scratch. *)
+         scratch := NewScratchReal () ;
+         asciiAddr := EmAsciiZLiteral (litStart, srcPos) ;
+         EmPushVarAddr (FALSE, symtab [scratch].off) ;
+         EmPushVarAddr (FALSE, asciiAddr) ;
+         DropC (EmCall (TU_RealVal)) ;
+         EmAddSp (4) ;
+         EmLeaDi (FALSE, symtab [scratch].off) ;
+         r.idx := scratch ;
+         r.kind := 5 ;
+         r.cls := TReal ;
+         r.sz := 6 ;
          RETURN
       END ;
       IF strf THEN
@@ -4125,6 +4258,15 @@ BEGIN
       Err (EUnknown) ;
       RETURN
    END ;
+   IF (symtab [idx].tag = KVar) AND (symtab [idx].resvar # 0) THEN
+      (* A function's result variable shadows its own name inside the body;
+         a following '(' means this is a recursive call, not a read of the
+         result slot. *)
+      Skip () ;
+      IF CurCh () = '(' THEN
+         idx := symtab [idx].resvar
+      END
+   END ;
    IF symtab [idx].tag = KConst THEN
       r.kind := 0 ;
       r.imm := symtab [idx].lval ;
@@ -4689,6 +4831,39 @@ BEGIN
    END
 END IntToMbf ;
 
+PROCEDURE RealBin (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
+(* REAL + - * / using the runtime's 12-byte block entries.  SaveLeft has
+   already copied a REAL left operand to a stable scratch; a kind-5 right is
+   copied first, while its DI address is live. *)
+VAR block, ent : CARDINAL ;
+BEGIN
+   block := NewScratchRealBlock () ;
+   IF right.kind = 5 THEN
+      EmCopyRealTo (symtab [block].off + 6, right) ;
+      EmCopyRealTo (symtab [block].off, left)
+   ELSE
+      EmCopyRealTo (symtab [block].off, left) ;
+      EmCopyRealTo (symtab [block].off + 6, right)
+   END ;
+   CASE op OF
+      OpAdd : ent := TU_RealAdd
+   |  OpSub : ent := TU_RealSub
+   |  OpMul : ent := TU_RealMul
+   |  OpDiv : ent := TU_RealDiv
+   ELSE
+      Err (ETypeErr) ;
+      RETURN
+   END ;
+   EmPushVarAddr (FALSE, symtab [block].off) ;
+   DropC (EmCall (ent)) ;
+   EmAddSp (2) ;
+   res.kind := 1 ;
+   res.idx := block ;
+   res.cls := TReal ;
+   res.sz := 6 ;
+   res.boff := 0
+END RealBin ;
+
 PROCEDURE Assignment (r : ERes) ;
 (* ':=' already consumed by the caller; store expression into r *)
 VAR src : ERes ;
@@ -4776,6 +4951,19 @@ BEGIN
          END ;
          RETURN
       END ;
+      IF (src.kind = 5) AND (src.cls = TReal) AND (r.kind = 1) THEN
+         EmPushDi () ;
+         EmPopSi () ;
+         k := 0 ;
+         WHILE k < 6 DO
+            EmLdAlSi () ;
+            EmStoreVar (symtab [r.idx].local,
+                        (symtab [r.idx].off + r.boff + k) MOD 10000H, 1) ;
+            EmIncSi () ;
+            INC (k)
+         END ;
+         RETURN
+      END ;
       IF (src.kind = 1) AND (src.cls = TReal) THEN
          IF r.kind = 5 THEN
             IF src.kind = 5 THEN
@@ -6485,12 +6673,26 @@ BEGIN
       ExpectDelim ('[', ENoSemi) ;
       an := 0 ;
       LOOP
-         RdConst (lo, subcls, strf) ;
-         IF NOT MatchRange () THEN
-            Err (ESimpType) ;
-            RETURN
+         Skip () ;
+         IF Alpha (CurCh ()) THEN
+            (* An enum/subrange TYPE as the index: `array[Standardfunction]'.
+               Its bounds are on the type symbol. *)
+            GetWord () ;
+            IF NOT Search (wrd, idx) OR (symtab [idx].tag # KType)
+               OR (symtab [idx].cls # TEnum) THEN
+               Err (ESimpType) ;
+               RETURN
+            END ;
+            lo := symtab [idx].lo ;
+            hi := symtab [idx].hi
+         ELSE
+            RdConst (lo, subcls, strf) ;
+            IF NOT MatchRange () THEN
+               Err (ESimpType) ;
+               RETURN
+            END ;
+            RdConst (hi, subcls, strf)
          END ;
-         RdConst (hi, subcls, strf) ;
          IF an < 4 THEN
             alo [an] := lo ;
             ahi [an] := hi ;
@@ -6757,7 +6959,7 @@ BEGIN
          IF lexnest = 0 THEN
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
                AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
-               AND (cls # TUntyp) THEN
+               AND (cls # TUntyp) AND (cls # TReal) THEN
                (* Still the catch-all for a type whose storage this compiler does
                   not lay out yet (an ARRAY at its point of use, a RECORD, ...).
                   A STRING is the exception now: its layout is length byte +
@@ -6803,7 +7005,7 @@ BEGIN
          ELSE
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
                AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
-               AND (cls # TUntyp) THEN
+               AND (cls # TUntyp) AND (cls # TReal) THEN
                Err (ENoLib) ;
                RETURN
             END ;
@@ -6859,7 +7061,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
     isStr : BOOLEAN ;
     tok : CARDINAL ;
     typed, setTyped, arrTyped : BOOLEAN ;
-    nb, k, divi, w : CARDINAL ;
+    nb, k, divi, w, slen : CARDINAL ;
 BEGIN
    LOOP
       PeekKw (tok) ;
@@ -6921,18 +7123,39 @@ BEGIN
          nb := 0 ;
          LOOP
             RdConst (v, cls, isStr) ;
-            IF isStr OR (nb + typElem > 512) THEN
-               Err (ENoLib) ;
+            IF nb + typElem > 512 THEN
+               Err (ECompOvf) ;
                EXIT
             END ;
-            w := VAL (CARDINAL, W16 (v)) ;
-            divi := 1 ;
-            k := 0 ;
-            WHILE k < typElem DO
-               constBlob [nb] := CHR ((w DIV divi) MOD 256) ;
-               divi := divi * 256 ;
-               INC (nb) ;
-               INC (k)
+            IF isStr THEN
+               (* A string element is <length><chars>, padded with NULs to
+                  typElem bytes.  StandardfunctionNames is array of string[6]. *)
+               slen := strLen [rdStrX] ;
+               IF slen > typElem - 1 THEN
+                  slen := typElem - 1
+               END ;
+               constBlob [nb] := CHR (slen) ;
+               k := 0 ;
+               WHILE k < typElem - 1 DO
+                  IF k < slen THEN
+                     constBlob [nb + 1 + k] :=
+                        strPool [strOff [rdStrX] + k]
+                  ELSE
+                     constBlob [nb + 1 + k] := CHR (0)
+                  END ;
+                  INC (k)
+               END ;
+               nb := nb + typElem
+            ELSE
+               w := VAL (CARDINAL, W16 (v)) ;
+               divi := 1 ;
+               k := 0 ;
+               WHILE k < typElem DO
+                  constBlob [nb] := CHR ((w DIV divi) MOD 256) ;
+                  divi := divi * 256 ;
+                  INC (nb) ;
+                  INC (k)
+               END
             END ;
             IF MatchDelim (',') THEN
                (* another element *)
@@ -7239,6 +7462,7 @@ BEGIN
       resultVar := NewSym (nm, KVar, cls, size, elem,
                            (locFree - size + 1) MOD 10000H, 0, TRUE) ;
       symtab [old].resvar := resultVar ;
+      symtab [resultVar].resvar := old ;   (* reverse link for self-calls *)
       locFree := (locFree - size) MOD 10000H ;
       locBytes := locBytes + size ;
       resultIsReal := (cls = TReal) ;
@@ -7644,6 +7868,12 @@ BEGIN
    TU_WrReal   := RT_Entry (6) ;
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
    TU_RealFmt   := RT_Entry (28) ;     (* fmtreal into a string variable *)
+   TU_RealVal   := RT_Entry (29) ;     (* ascreal: ASCIIZ -> REAL *)
+   TU_RealCmp   := RT_Entry (26) ;     (* recmp: AX = -1/0/+1 *)
+   TU_RealAdd   := RT_Entry (22) ;
+   TU_RealSub   := RT_Entry (23) ;
+   TU_RealMul   := RT_Entry (24) ;
+   TU_RealDiv   := RT_Entry (25) ;
    TU_WrLn     := RT_Entry (7) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdChar   := RT_Entry (9) ;

+ 2 - 0
shell/tests/audit_helpers.py

@@ -162,6 +162,8 @@ NON_ONE_LINE = {
         "InlineCh": COMP,      # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "PushRealAddr": COMP, "PushRealSlot": COMP,
+        "AsciiZLiteral": COMP, "XorByteGlob": COMP,
+        "CopyRealTo": COMP,
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
         "MovChImm": PARAM,
         "Call": COMP, "Jcc": COMP, "JmpNear": COMP,

+ 12 - 10
shell/tests/fixtures/calc_ladder.tsv

@@ -25,13 +25,15 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-23): `I > 0.0' in Fact.  UpCase, run-time set
-# membership, string fields through DI, the original memory layout, untyped-file
-# declarations, file control-block operations, VAR string parameters, Chr,
-# typed-file block I/O, text-file output, Str, pointers/New/dereference, text
-# Eof/Readln, Str(integer), Val(integer), VAR REAL parameters, REAL function
-# results and value REAL parameters moved the ladder 15911 -> 18267 -> 19847
-# -> 20912 -> 22253 -> 22280 -> 22706 -> 22859 -> 23700 -> 25674 -> 26066 ->
-# 26924 -> 27648 -> 28074 -> 31758 -> 32096 -> 32284 -> 32482.  The next
-# blocker is REAL constants/comparisons (`I > 0.0', TP3 error 102).
-CALC.PAS	ERR	102	32482
+# Current rung (2026-10-23): `Copy(Formula,...)' inside Factor's real Val.
+# UpCase, run-time set membership, string fields through DI, the original memory
+# layout, untyped-file declarations, file control-block operations, VAR string
+# parameters, Chr, typed-file block I/O, text-file output, Str,
+# pointers/New/dereference, text Eof/Readln, Str(integer), Val(integer), VAR/
+# value REAL and REAL function results, REAL literals/comparisons/arithmetic,
+# self-recursion, enum-indexed arrays, string-array typed constants and local
+# REAL variables moved the ladder 15911 -> 18267 -> 19847 -> 20912 -> 22253 ->
+# 22280 -> 22706 -> 22859 -> 23700 -> 25674 -> 26066 -> 26924 -> 27648 ->
+# 28074 -> 31758 -> 32096 -> 32284 -> 32482 -> 32564 -> 33374 -> 33537 ->
+# 33778 -> 35135.  The next blocker is the Copy string builtin (TP3 error 41).
+CALC.PAS	ERR	41	35135

+ 7 - 0
shell/tests/fixtures/expected.tsv

@@ -696,3 +696,10 @@ t98_realfunc	OK	309	28
 #   t99_valreal          value REAL parameters: a six-byte stack slot copied
 #                   from a VAR REAL actual and returned through a REAL function.
 t99_valreal	OK	334	28
+
+#   t100_realexpr       REAL literals, comparisons and + - * /; each
+#                   operation uses a 12-byte MBF block and the compiler scratch.
+t100_realexpr	OK	1001	140
+
+#   t101_recursion      direct self-recursion: fact(5) = 120.
+t101_recursion	OK	137	5

+ 6 - 0
shell/tests/fixtures/t100_realexpr.out

@@ -0,0 +1,6 @@
+5
+1
+6
+1.5
+1.5
+TRUE

+ 37 - 0
shell/tests/fixtures/t100_realexpr.pas

@@ -0,0 +1,37 @@
+program t100_realexpr;
+
+{ t100 -- REAL literals, comparisons and + - * /.  The runtime's MBF
+  arithmetic entries do the work; the compiler packs each operation into a
+  12-byte block and keeps the result address as a REAL value. }
+
+type
+  R = record
+    V : real;
+  end;
+
+var
+  A, B, C : R;
+  S : string[20];
+begin
+  A.V := 2;
+  B.V := 3;
+  C.V := A.V + B.V;
+  Str (C.V : 0 : 0, S);
+  writeln (S);
+  C.V := B.V - A.V;
+  Str (C.V : 0 : 0, S);
+  writeln (S);
+  C.V := A.V * B.V;
+  Str (C.V : 0 : 0, S);
+  writeln (S);
+  C.V := B.V / A.V;
+  Str (C.V : 0 : 1, S);
+  writeln (S);
+  A.V := 1.5;
+  Str (A.V : 0 : 1, S);
+  writeln (S);
+  if A.V < B.V then
+    writeln ('TRUE')
+  else
+    writeln ('FALSE')
+end.

+ 1 - 0
shell/tests/fixtures/t101_recursion.out

@@ -0,0 +1 @@
+120

+ 17 - 0
shell/tests/fixtures/t101_recursion.pas

@@ -0,0 +1,17 @@
+program t101_recursion;
+
+{ t101 -- direct self-recursion.  The function's result variable shadows its
+  own name inside the body; a following '(' must resolve to the function
+  symbol, not the result slot. }
+
+function fact (N : integer) : integer;
+begin
+  if N <= 1 then
+    fact := 1
+  else
+    fact := N * fact (N - 1)
+end;
+
+begin
+  writeln (fact (5))
+end.

+ 2 - 2
shell/tests/nonvacuity.sh

@@ -843,11 +843,11 @@ s = open(p).read()
 # park unreachable would leave that one alive, so the mutation would no longer
 # be "SaveLeft parks nothing" - it would be a half-disabled SaveLeft, and the
 # case would be testing something narrower than it says.
-g2 = '   IF left.kind = 2 THEN\n'
+g2 = '   ELSIF left.kind = 2 THEN\n'
 g5 = '   ELSIF left.kind = 5 THEN\n'
 assert s.count(g2) == 1, 'the kind-2 guard found %d times -- update this mutation' % s.count(g2)
 assert s.count(g5) == 1, 'the kind-5 guard found %d times -- update this mutation' % s.count(g5)
-s = s.replace(g2, '   IF left.kind = 99 THEN\n')
+s = s.replace(g2, '   ELSIF left.kind = 99 THEN\n')
 s = s.replace(g5, '   ELSIF left.kind = 99 THEN\n')
 open(p, 'w').write(s)
 PYX