Browse Source

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 4 ngày trước cách đây
mục cha
commit
30782f631b

+ 21 - 8
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | 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):
 Rungs behind it (now passed):
 
 
@@ -145,7 +145,12 @@ Rungs ahead:
 | 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
 | 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
 | 32096 | REAL function result (`Expression:Real`) - DONE |
 | 32096 | REAL function result (`Expression:Real`) - DONE |
 | 32284 | value REAL parameter (`Fact(I : 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
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
 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
 file control-block operations, VAR string parameters, `Chr`, typed-file
 block I/O, text-file output, `Str`, pointer types with `New`/dereference,
 block I/O, text-file output, `Str`, pointer types with `New`/dereference,
 text `Eof`/`Readln`, integer `Str`, integer `Val`, and VAR REAL parameters). The
 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
 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
 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`) |
 | `e940a1d` | `v-TP3-CALC-TEXTREAD` | `ERR 41 28074` (`Val`) |
 | `9d4ab01` | `v-TP3-CALC-VALINT` | `ERR 102 31758` (VAR REAL) |
 | `9d4ab01` | `v-TP3-CALC-VALINT` | `ERR 102 31758` (VAR REAL) |
 | `a4e72bf` | `v-TP3-CALC-VARREAL` | `ERR 102 32096` (REAL function result) |
 | `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.
 - **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
   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`,
   parameter slot holds the caller's address; assignment, `Read`, `Length`,
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `writeln`, concatenation, comparison and `x[i]` all go through that address.
   `Chr(n)` folds or loads an ordinal and yields a CHAR.
   `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**
 - **REAL function results and value REAL parameters are landed**
   (`t98_realfunc`, `t99_valreal`).  A REAL function's caller supplies a
   (`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
   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`),
 harness has no filesystem.  `Str` real formatting is done (`t92_strreal`),
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 pointer types with `New`/`Dispose`/dereference are done (`t93_pointer`), and
 text `Eof`/`Readln` plus integer `Str` are done (`t94_textread`/`t95_strint`).
 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`
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),
 (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
 features through **file control-block operations and the original memory
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 layout** are landed: the ladder (`tests/calc_ladder.sh` +
 `tests/fixtures/calc_ladder.tsv`, run by `run_all.sh`; CALC.PAS now stops at
 `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),
 `^X`/`#nn`, scalar typed constants, sets, enums, records (CellRec = 80),
 subranges, arrays, element/field access, file types, string value parameters,
 subranges, arrays, element/field access, file types, string value parameters,
 `Length`, the CRT identifiers (`ClrScr`/`GotoXY`/`ClrEol`/`LowVideo`/
 `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
 text-file output (`t91`, compile-only), `Str` real formatting (`t92`), and
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 pointer types with `New`/`Dispose`/dereference (`t93`), text `Eof`/`Readln`
 (`t94`), integer `Str` (`t95`), and integer `Val` (`t96`). The next rung is
 (`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
 scaffold is nearly full, so the next runtime addition must move HDR. Items 1-4
 below are independent of both tracks.
 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
       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
       why n * n with n a CONST was correct and a * b with a a variable was
       not. *)
       not. *)
-   OpAdd = 1 ;  OpSub = 2 ;  OpMul = 3 ;
+   OpAdd = 1 ;  OpSub = 2 ;  OpMul = 3 ;  OpDiv = 4 ;
 
 
    (* TP3 error numbers *)
    (* TP3 error numbers *)
    ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
    ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
@@ -388,6 +388,9 @@ VAR
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : CARDINAL ;
    TU_WrReal   : CARDINAL ;  TU_RealWrite : CARDINAL ;  TU_RealFmt : 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_WrLn     : CARDINAL ;
    TU_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
@@ -1323,6 +1326,10 @@ BEGIN
    END
    END
 END EmLoadVar ;
 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) ;
 PROCEDURE EmStoreVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
 BEGIN
 BEGIN
    IF nbytes = 1 THEN
    IF nbytes = 1 THEN
@@ -2371,6 +2378,11 @@ PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
 PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ; FORWARD ;
 PROCEDURE EmCallMost (idx, cleanup : CARDINAL) ; FORWARD ;
 PROCEDURE SlotSize (cls, size : CARDINAL) : CARDINAL ; FORWARD ;
 PROCEDURE SlotSize (cls, size : CARDINAL) : CARDINAL ; FORWARD ;
 PROCEDURE ParamSlotBytes (e : SymEntry) : 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)                                           *)
 (*  expressions  (TPSRC9)                                           *)
@@ -2829,6 +2841,10 @@ PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
 VAR f : LONGINT ;
 VAR f : LONGINT ;
     okc : BOOLEAN ;
     okc : BOOLEAN ;
 BEGIN
 BEGIN
+   IF (left.cls = TReal) OR (right.cls = TReal) THEN
+      RealBin (op, left, right, res) ;
+      RETURN
+   END ;
    IF StrOperand (left) OR StrOperand (right) THEN
    IF StrOperand (left) OR StrOperand (right) THEN
       (* A string OPERAND - a STRING or a CHAR, which is a one-character string
       (* 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
          for this purpose - makes this a string operation, and `+' is the only
@@ -2939,6 +2955,7 @@ END ConstCmp ;
 (* ---------------------------------------------------------------- *)
 (* ---------------------------------------------------------------- *)
 
 
 PROCEDURE SaveLeft (VAR left : ERes) ;
 PROCEDURE SaveLeft (VAR left : ERes) ;
+VAR sk : CARDINAL ;
 (* Called the moment the operator has been recognised, i.e. *before* the
 (* Called the moment the operator has been recognised, i.e. *before* the
    right-hand operand is parsed.
    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
    ORed the *second* comparison's result with itself - which is why it
    printed FALSE for TRUE or FALSE. *)
    printed FALSE for TRUE or FALSE. *)
 BEGIN
 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 () ;
       EmPushAx () ;
       left.kind := 4                      (* 4 = on the top of the stack *)
       left.kind := 4                      (* 4 = on the top of the stack *)
    ELSIF left.kind = 5 THEN
    ELSIF left.kind = 5 THEN
@@ -3050,6 +3077,28 @@ BEGIN
    RETURN here
    RETURN here
 END EmStrBlob ;
 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) ;
 PROCEDURE EmPushSetAddr (r : ERes) ;
 (* Push the ADDRESS of a set value: the runtime's set entries take addresses.
 (* 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
    A set literal/typed constant is code-resident (kind 7), a set-expression
@@ -3238,6 +3287,34 @@ BEGIN
    Ebyte (0E2H) ; Ebyte (0F8H)        (* LOOP back *)
    Ebyte (0E2H) ; Ebyte (0F8H)        (* LOOP back *)
 END EmPushRealSlot ;
 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) ;
 PROCEDURE EmPushStrSlot (r : ERes ; reserve, copyN : CARDINAL) ;
 (* Push a STRING VALUE argument's whole slot: reserve `reserve' bytes on the
 (* 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
    stack and copy `copyN' of the source string's <len><chars> into them, so
@@ -3584,6 +3661,14 @@ BEGIN
    RETURN symTop - 1
    RETURN symTop - 1
 END NewScratchReal ;
 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 ;
 PROCEDURE StrOperand (r : ERes) : BOOLEAN ;
 (* Is r usable as one operand of `+'?  A STRING, or a CHAR - which can appear
 (* 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
    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 ;
 VAR op : CARDINAL ;
     left, right : ERes ;
     left, right : ERes ;
     f : LONGINT ;
     f : LONGINT ;
-    size, base : CARDINAL ;
+    size, base, block : CARDINAL ;
 BEGIN
 BEGIN
    ParseAdd (r) ;
    ParseAdd (r) ;
    LOOP
    LOOP
@@ -3807,6 +3892,34 @@ BEGIN
          EmRelSetcc (op) ;
          EmRelSetcc (op) ;
          r.kind := 2 ;
          r.kind := 2 ;
          r.cls := TBool
          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
       ELSE
          SaveLeft (left) ;
          SaveLeft (left) ;
          ParseAdd (right) ;
          ParseAdd (right) ;
@@ -3903,7 +4016,7 @@ BEGIN
       IF CurCh () = '*' THEN
       IF CurCh () = '*' THEN
          op := OpMul ; DropCh (GetCh ())   (* OpAdd here meant a*b -> a+b *)
          op := OpMul ; DropCh (GetCh ())   (* OpAdd here meant a*b -> a+b *)
       ELSIF CurCh () = '/' THEN
       ELSIF CurCh () = '/' THEN
-         op := 2 ; DropCh (GetCh ()) ; Err (ENoLib)
+         op := OpDiv ; DropCh (GetCh ())
       ELSIF KwAhead ("DIV") THEN
       ELSIF KwAhead ("DIV") THEN
          GetWord () ; op := TkDiv
          GetWord () ; op := TkDiv
       ELSIF KwAhead ("MOD") THEN
       ELSIF KwAhead ("MOD") THEN
@@ -3913,9 +4026,6 @@ BEGIN
       ELSE
       ELSE
          RETURN
          RETURN
       END ;
       END ;
-      IF op = 2 THEN
-         RETURN
-      END ;
       left := r ;
       left := r ;
       IF left.cls = TSet THEN
       IF left.cls = TSet THEN
          (* Set intersection.  Same push-before-the-right rule as ParseAdd. *)
          (* Set intersection.  Same push-before-the-right rule as ParseAdd. *)
@@ -3959,7 +4069,15 @@ BEGIN
    ELSIF CurCh () = '-' THEN
    ELSIF CurCh () = '-' THEN
       DropCh (GetCh ()) ;
       DropCh (GetCh ()) ;
       ParseNeg (r) ;
       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))
          r.imm := VAL (LONGINT, W16 (0 - r.imm))
       ELSE
       ELSE
          LoadAtom (r) ;
          LoadAtom (r) ;
@@ -4058,6 +4176,7 @@ VAR idx : CARDINAL ;
     ssize, sbase : CARDINAL ;
     ssize, sbase : CARDINAL ;
     sbuf : ARRAY [0..31] OF CHAR ;
     sbuf : ARRAY [0..31] OF CHAR ;
     uj1, uj2 : CARDINAL ;
     uj1, uj2 : CARDINAL ;
+    litStart, scratch, asciiAddr : CARDINAL ;
 BEGIN
 BEGIN
    r.chr := FALSE ;            (* default: not a quoted char literal *)
    r.chr := FALSE ;            (* default: not a quoted char literal *)
    Skip () ;
    Skip () ;
@@ -4092,11 +4211,25 @@ BEGIN
          caret (^M) or decimal (#27) character constant is a character too. *)
          caret (^M) or decimal (#27) character constant is a character too. *)
       quoted := (ORD (CurCh ()) = AposC) OR (CurCh () = '^')
       quoted := (ORD (CurCh ()) = AposC) OR (CurCh () = '^')
                 OR (CurCh () = '#') ;
                 OR (CurCh () = '#') ;
+      litStart := srcPos ;
       RdConst (r.imm, r.cls, strf) ;
       RdConst (r.imm, r.cls, strf) ;
       r.chr := quoted AND (r.cls = TScalar) AND NOT strf ;
       r.chr := quoted AND (r.cls = TScalar) AND NOT strf ;
       IF r.cls = TReal THEN
       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
          RETURN
       END ;
       END ;
       IF strf THEN
       IF strf THEN
@@ -4125,6 +4258,15 @@ BEGIN
       Err (EUnknown) ;
       Err (EUnknown) ;
       RETURN
       RETURN
    END ;
    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
    IF symtab [idx].tag = KConst THEN
       r.kind := 0 ;
       r.kind := 0 ;
       r.imm := symtab [idx].lval ;
       r.imm := symtab [idx].lval ;
@@ -4689,6 +4831,39 @@ BEGIN
    END
    END
 END IntToMbf ;
 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) ;
 PROCEDURE Assignment (r : ERes) ;
 (* ':=' already consumed by the caller; store expression into r *)
 (* ':=' already consumed by the caller; store expression into r *)
 VAR src : ERes ;
 VAR src : ERes ;
@@ -4776,6 +4951,19 @@ BEGIN
          END ;
          END ;
          RETURN
          RETURN
       END ;
       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 (src.kind = 1) AND (src.cls = TReal) THEN
          IF r.kind = 5 THEN
          IF r.kind = 5 THEN
             IF src.kind = 5 THEN
             IF src.kind = 5 THEN
@@ -6485,12 +6673,26 @@ BEGIN
       ExpectDelim ('[', ENoSemi) ;
       ExpectDelim ('[', ENoSemi) ;
       an := 0 ;
       an := 0 ;
       LOOP
       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 ;
          END ;
-         RdConst (hi, subcls, strf) ;
          IF an < 4 THEN
          IF an < 4 THEN
             alo [an] := lo ;
             alo [an] := lo ;
             ahi [an] := hi ;
             ahi [an] := hi ;
@@ -6757,7 +6959,7 @@ BEGIN
          IF lexnest = 0 THEN
          IF lexnest = 0 THEN
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
                AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
                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
                (* 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, ...).
                   not lay out yet (an ARRAY at its point of use, a RECORD, ...).
                   A STRING is the exception now: its layout is length byte +
                   A STRING is the exception now: its layout is length byte +
@@ -6803,7 +7005,7 @@ BEGIN
          ELSE
          ELSE
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
             IF (size > 2) AND (cls # TString) AND (cls # TRecord)
                AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
                AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
-               AND (cls # TUntyp) THEN
+               AND (cls # TUntyp) AND (cls # TReal) THEN
                Err (ENoLib) ;
                Err (ENoLib) ;
                RETURN
                RETURN
             END ;
             END ;
@@ -6859,7 +7061,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
     isStr : BOOLEAN ;
     isStr : BOOLEAN ;
     tok : CARDINAL ;
     tok : CARDINAL ;
     typed, setTyped, arrTyped : BOOLEAN ;
     typed, setTyped, arrTyped : BOOLEAN ;
-    nb, k, divi, w : CARDINAL ;
+    nb, k, divi, w, slen : CARDINAL ;
 BEGIN
 BEGIN
    LOOP
    LOOP
       PeekKw (tok) ;
       PeekKw (tok) ;
@@ -6921,18 +7123,39 @@ BEGIN
          nb := 0 ;
          nb := 0 ;
          LOOP
          LOOP
             RdConst (v, cls, isStr) ;
             RdConst (v, cls, isStr) ;
-            IF isStr OR (nb + typElem > 512) THEN
-               Err (ENoLib) ;
+            IF nb + typElem > 512 THEN
+               Err (ECompOvf) ;
                EXIT
                EXIT
             END ;
             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 ;
             END ;
             IF MatchDelim (',') THEN
             IF MatchDelim (',') THEN
                (* another element *)
                (* another element *)
@@ -7239,6 +7462,7 @@ BEGIN
       resultVar := NewSym (nm, KVar, cls, size, elem,
       resultVar := NewSym (nm, KVar, cls, size, elem,
                            (locFree - size + 1) MOD 10000H, 0, TRUE) ;
                            (locFree - size + 1) MOD 10000H, 0, TRUE) ;
       symtab [old].resvar := resultVar ;
       symtab [old].resvar := resultVar ;
+      symtab [resultVar].resvar := old ;   (* reverse link for self-calls *)
       locFree := (locFree - size) MOD 10000H ;
       locFree := (locFree - size) MOD 10000H ;
       locBytes := locBytes + size ;
       locBytes := locBytes + size ;
       resultIsReal := (cls = TReal) ;
       resultIsReal := (cls = TReal) ;
@@ -7644,6 +7868,12 @@ BEGIN
    TU_WrReal   := RT_Entry (6) ;
    TU_WrReal   := RT_Entry (6) ;
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
    TU_RealFmt   := RT_Entry (28) ;     (* fmtreal into a string variable *)
    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_WrLn     := RT_Entry (7) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdInt    := RT_Entry (8) ;
    TU_RdChar   := RT_Entry (9) ;
    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
         "InlineCh": COMP,      # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "InlineCrLf": COMP,    # emits a string blob, not one instruction
         "PushRealAddr": COMP, "PushRealSlot": COMP,
         "PushRealAddr": COMP, "PushRealSlot": COMP,
+        "AsciiZLiteral": COMP, "XorByteGlob": COMP,
+        "CopyRealTo": COMP,
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
         "AddSp": PARAM, "SubSp": PARAM, "Setcc": PARAM,
         "MovChImm": PARAM,
         "MovChImm": PARAM,
         "Call": COMP, "Jcc": COMP, "JmpNear": COMP,
         "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
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 # 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
 #   t99_valreal          value REAL parameters: a six-byte stack slot copied
 #                   from a VAR REAL actual and returned through a REAL function.
 #                   from a VAR REAL actual and returned through a REAL function.
 t99_valreal	OK	334	28
 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
 # 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
 # be "SaveLeft parks nothing" - it would be a half-disabled SaveLeft, and the
 # case would be testing something narrower than it says.
 # 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'
 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(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)
 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')
 s = s.replace(g5, '   ELSIF left.kind = 99 THEN\n')
 open(p, 'w').write(s)
 open(p, 'w').write(s)
 PYX
 PYX