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

calc: REAL function results and value REAL parameters (ladder 32482)

A function returning REAL now writes its six-byte result to a caller-owned
scratch: the call site sets DI to the scratch address, the callee saves it in
a hidden frame local, and SymEpi copies the local result there before leaving.
After the call ParseAtom reloads the scratch address and exposes the result as
a kind-5 REAL value, so it can feed VAR REAL assignment, Str and other
address-based real consumers.  Forward declarations inherit their result type
when the definition repeats only the name.

Value REAL formals reserve six stack bytes.  Call sites copy from a plain
variable, VAR REAL parameter, field or REAL function result; both ParseCall
and ParseCallArgs support it.

t98_realfunc covers a REAL result through a VAR REAL parameter; t99_valreal
covers a value REAL formal whose actual is a VAR REAL and a REAL result.  Both
execute under qemu and Exec86.

The CALC ladder moves 32096 -> 32284 -> 32482; the next blocker is a REAL
constant/comparison (`I > 0.0` in Fact).

Verified: compile matrix 100/100, ladder 1/1, 91 .COM linked, 86 executed
under both qemu and Exec86, rt_exec 276/276, nonvacuity 121/121, run_all ALL
PASS.
Eric Streit 4 дней назад
Родитель
Сommit
884edbaeb5

+ 18 - 9
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | position | blocker |
 |---|---|
 |---|---|
-| **32096** | `function Expression(...):Real;forward` — REAL function results (`ERR 102`) |
+| **32482** | `I > 0.0` in `Fact` — REAL constants and comparisons (`ERR 102`) |
 
 
 Rungs behind it (now passed):
 Rungs behind it (now passed):
 
 
@@ -143,7 +143,9 @@ Rungs ahead:
 | 27759 | `Str(count,st)` - integer Str - DONE |
 | 27759 | `Str(count,st)` - integer Str - DONE |
 | 28074 | `Val(Buffer^[0],...)` - string-to-integer - DONE |
 | 28074 | `Val(Buffer^[0],...)` - string-to-integer - DONE |
 | 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
 | 31758 | `var Value : Real` - by-reference REAL parameter - DONE |
-| 32096 | REAL function result (`Expression:Real`) |
+| 32096 | REAL function result (`Expression:Real`) - DONE |
+| 32284 | value REAL parameter (`Fact(I : Real)`) - DONE |
+| 32482 | REAL constants/comparisons (`I > 0.0`) |
 
 
 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:
@@ -467,8 +469,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,096**, where
-`function Expression(...):Real;forward` asks for REAL function results.
+ladder has moved from the first typed constant at 7,791 to **32,482**, where
+`I > 0.0` asks for REAL constants and comparisons.
 
 
 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
@@ -513,7 +515,8 @@ Exec86):
 | `1aed9cd` | `v-TP3-CALC-POINTER` | `ERR 41 27648` (`Eof`) |
 | `1aed9cd` | `v-TP3-CALC-POINTER` | `ERR 41 27648` (`Eof`) |
 | `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) |
-| *(this commit)* | `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) |
 
 
 - **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
@@ -559,6 +562,13 @@ 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 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
+  copies its result there before returning.  Call sites reload the scratch
+  address after the call and treat the result as a kind-5 REAL address.  Value
+  REAL formals reserve six stack bytes and copy from a variable, VAR
+  parameter, field or function result.
 - **VAR REAL parameters are landed (`t97_varreal`).**  The two-byte slot
 - **VAR REAL parameters are landed (`t97_varreal`).**  The two-byte slot
   holds the caller's address; assignment copies six bytes through it (or
   holds the caller's address; assignment copies six bytes through it (or
   stores a converted constant), and call sites pass record-field addresses
   stores a converted constant), and call sites pass record-field addresses
@@ -1177,10 +1187,9 @@ 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 function result
-(`function Expression(...):Real;forward`).  The probe scaffold has been moved
-to HDR=0x1300 / data 0x2110; the runtime is 4,384 bytes and now has room for
-the remaining work.
+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.
 
 
 **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),

+ 3 - 2
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 32096, `function Expression(...):Real;forward`), the `{$I}` include,
+`ERR 102` at pos 32482, `I > 0.0` in Fact), 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,7 +2064,8 @@ 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 (`function Expression(...):Real`). The runtime is 3,907 bytes / 39 entries and its probe
+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
 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.
 
 

+ 154 - 41
shell/Compiler.mod

@@ -427,6 +427,9 @@ VAR
    lexnest  : CARDINAL ;
    lexnest  : CARDINAL ;
    curIsFunc : BOOLEAN ;
    curIsFunc : BOOLEAN ;
    resultVar : CARDINAL ;
    resultVar : CARDINAL ;
+   resultIsReal : BOOLEAN ;       (* the CURRENT function returns TReal *)
+   resultPtrOff : CARDINAL ;      (* hidden local: caller's 6-byte result dest *)
+   callScratch : CARDINAL ;       (* per-site real-result scratch symbol *)
 
 
    locFree  : CARDINAL ;       (* next local slot (BP-relative, 8-bit) *)
    locFree  : CARDINAL ;       (* next local slot (BP-relative, 8-bit) *)
    locBytes : CARDINAL ;       (* frame size for SUB SP *)
    locBytes : CARDINAL ;       (* frame size for SUB SP *)
@@ -1416,6 +1419,9 @@ BEGIN Ebyte (47H) END EmIncDi ;
 PROCEDURE EmMovDiAx () ;
 PROCEDURE EmMovDiAx () ;
 BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ;  (* 89 C7: DI := AX *)
 BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ;  (* 89 C7: DI := AX *)
 
 
+PROCEDURE EmMovAxDi () ;
+BEGIN Ebyte (89H) ; Ebyte (0F8H) END EmMovAxDi ;  (* 89 F8: AX := DI *)
+
 PROCEDURE EmLdAxDi () ;
 PROCEDURE EmLdAxDi () ;
 BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
 BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ;    (* 8B 05: AX := [DI] *)
 
 
@@ -3199,6 +3205,39 @@ BEGIN
    END
    END
 END EmPushStrAddr ;
 END EmPushStrAddr ;
 
 
+PROCEDURE EmPushRealAddr (r : ERes) ;
+(* Push the address of a six-byte REAL actual: ordinary variable, VAR REAL
+   parameter (slot holds the address), or a kind-5 field/function result. *)
+BEGIN
+   IF r.kind = 5 THEN
+      EmPushDi ()
+   ELSIF r.kind = 1 THEN
+      IF symtab [r.idx].isVar THEN
+         EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
+         EmPushAx ()
+      ELSE
+         EmPushVarAddr (symtab [r.idx].local,
+                        (symtab [r.idx].off + r.boff) MOD 10000H)
+      END
+   ELSE
+      Err (ENoLib)
+   END
+END EmPushRealAddr ;
+
+PROCEDURE EmPushRealSlot (r : ERes ; reserve : CARDINAL) ;
+(* Push a six-byte value REAL argument's whole slot onto the stack. *)
+BEGIN
+   EmPushRealAddr (r) ;
+   EmPopSi () ;
+   EmSubSp (reserve) ;
+   Ebyte (89H) ; Ebyte (0E7H) ;       (* MOV DI,SP *)
+   EmMovCxi (reserve) ;
+   Ebyte (8AH) ; Ebyte (04H) ;        (* MOV AL,[SI] *)
+   Ebyte (88H) ; Ebyte (05H) ;        (* MOV [DI],AL *)
+   Ebyte (46H) ; Ebyte (47H) ;        (* INC SI / INC DI *)
+   Ebyte (0E2H) ; Ebyte (0F8H)        (* LOOP back *)
+END EmPushRealSlot ;
+
 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
@@ -3537,6 +3576,14 @@ BEGIN
    RETURN symTop - 1
    RETURN symTop - 1
 END NewScratchStr ;
 END NewScratchStr ;
 
 
+PROCEDURE NewScratchReal () : CARDINAL ;
+(* Six bytes of storage for a REAL function result, one per call site. *)
+BEGIN
+   DropC (NewSym ("@@RL", KVar, TReal, 6, 6, dc, 0, FALSE)) ;
+   dc := dc + 6 ;
+   RETURN symTop - 1
+END NewScratchReal ;
+
 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
@@ -4085,8 +4132,17 @@ BEGIN
       RETURN
       RETURN
    ELSIF symtab [idx].tag = KFunc THEN
    ELSIF symtab [idx].tag = KFunc THEN
       ParseCall (idx) ;
       ParseCall (idx) ;
-      r.kind := 2 ;
-      r.cls := symtab [idx].cls ;
+      IF symtab [idx].cls = TReal THEN
+         (* A REAL function returns into the caller's six-byte scratch; DI is
+            reloaded with its address so real consumers can use the value. *)
+         EmLeaDi (FALSE, symtab [callScratch].off) ;
+         r.kind := 5 ;
+         r.cls := TReal ;
+         r.sz := 6
+      ELSE
+         r.kind := 2 ;
+         r.cls := symtab [idx].cls
+      END ;
       RETURN
       RETURN
    ELSIF (symtab [idx].tag = KVar) OR (symtab [idx].tag = KType) THEN
    ELSIF (symtab [idx].tag = KVar) OR (symtab [idx].tag = KType) THEN
       (* ParseVar initialises boff to 0 and then ParseSub folds any constant
       (* ParseVar initialises boff to 0 and then ParseSub folds any constant
@@ -4406,24 +4462,27 @@ BEGIN
                `copyN' is at most the slot: an actual shorter than the formal
                `copyN' is at most the slot: an actual shorter than the formal
                leaves the tail untouched, which is harmless because the length
                leaves the tail untouched, which is harmless because the length
                byte bounds every read. *)
                byte bounds every read. *)
-            IF arg.cls # TString THEN
-               Err (ETypeErr) ;
-               EXIT
-            END ;
-            nCopy := slot ;
-            IF arg.kind = 1 THEN
-               IF VarSize (arg) < nCopy THEN
-                  nCopy := VarSize (arg)
-               END
-            ELSIF arg.kind = 3 THEN
-               IF strLen [arg.strx] + 1 < nCopy THEN
-                  nCopy := strLen [arg.strx] + 1
-               END
+            IF arg.cls = TString THEN
+               nCopy := slot ;
+               IF arg.kind = 1 THEN
+                  IF VarSize (arg) < nCopy THEN
+                     nCopy := VarSize (arg)
+                  END
+               ELSIF arg.kind = 3 THEN
+                  IF strLen [arg.strx] + 1 < nCopy THEN
+                     nCopy := strLen [arg.strx] + 1
+                  END
+               ELSE
+                  Err (ENoLib) ;          (* a computed string is not a value *)
+                  EXIT
+               END ;
+               EmPushStrSlot (arg, slot, nCopy)
+            ELSIF arg.cls = TReal THEN
+               EmPushRealSlot (arg, slot)
             ELSE
             ELSE
-               Err (ENoLib) ;          (* a computed string is not a value *)
+               Err (ETypeErr) ;
                EXIT
                EXIT
-            END ;
-            EmPushStrSlot (arg, slot, nCopy)
+            END
          ELSE
          ELSE
             LoadAtom (arg) ;
             LoadAtom (arg) ;
             EmPushAx ()
             EmPushAx ()
@@ -4480,24 +4539,27 @@ BEGIN
                END
                END
             ELSIF slot > 2 THEN
             ELSIF slot > 2 THEN
                (* see ParseCallArgs: push the whole string slot *)
                (* see ParseCallArgs: push the whole string slot *)
-               IF arg.cls # TString THEN
-                  Err (ETypeErr) ;
-                  EXIT
-               END ;
-               nCopy := slot ;
-               IF arg.kind = 1 THEN
-                  IF VarSize (arg) < nCopy THEN
-                     nCopy := VarSize (arg)
-                  END
-               ELSIF arg.kind = 3 THEN
-                  IF strLen [arg.strx] + 1 < nCopy THEN
-                     nCopy := strLen [arg.strx] + 1
-                  END
+               IF arg.cls = TString THEN
+                  nCopy := slot ;
+                  IF arg.kind = 1 THEN
+                     IF VarSize (arg) < nCopy THEN
+                        nCopy := VarSize (arg)
+                     END
+                  ELSIF arg.kind = 3 THEN
+                     IF strLen [arg.strx] + 1 < nCopy THEN
+                        nCopy := strLen [arg.strx] + 1
+                     END
+                  ELSE
+                     Err (ENoLib) ;
+                     EXIT
+                  END ;
+                  EmPushStrSlot (arg, slot, nCopy)
+               ELSIF arg.cls = TReal THEN
+                  EmPushRealSlot (arg, slot)
                ELSE
                ELSE
-                  Err (ENoLib) ;
+                  Err (ETypeErr) ;
                   EXIT
                   EXIT
-               END ;
-               EmPushStrSlot (arg, slot, nCopy)
+               END
             ELSE
             ELSE
                LoadAtom (arg) ;
                LoadAtom (arg) ;
                EmPushAx ()
                EmPushAx ()
@@ -4513,6 +4575,11 @@ BEGIN
          DropCh (GetCh ())
          DropCh (GetCh ())
       END
       END
    END ;
    END ;
+   callScratch := 0 ;
+   IF symtab [idx].cls = TReal THEN
+      callScratch := NewScratchReal () ;
+      EmLeaDi (FALSE, symtab [callScratch].off)
+   END ;
    EmCallMost (idx, cleanup)
    EmCallMost (idx, cleanup)
 END ParseCall ;
 END ParseCall ;
 
 
@@ -6936,11 +7003,24 @@ BEGIN
 END IfMatchSemi ;
 END IfMatchSemi ;
 
 
 PROCEDURE SymEpi () ;
 PROCEDURE SymEpi () ;
-(* function result: AX := result var *)
+(* function result: AX := result var for a scalar, or copy six bytes to the
+   caller's result scratch for a REAL function. *)
+VAR k : CARDINAL ;
 BEGIN
 BEGIN
    IF curIsFunc THEN
    IF curIsFunc THEN
       IF OK () THEN
       IF OK () THEN
-         EmLoadVar (TRUE, symtab [resultVar].off, symtab [resultVar].size)
+         IF resultIsReal THEN
+            EmLoadVar (TRUE, resultPtrOff, 2) ;
+            EmMovDiAx () ;
+            k := 0 ;
+            WHILE k < 6 DO
+               EmLoadVar (TRUE, symtab [resultVar].off + k, 1) ;
+               EmStDiAlOff (k) ;
+               INC (k)
+            END
+         ELSE
+            EmLoadVar (TRUE, symtab [resultVar].off, symtab [resultVar].size)
+         END
       END
       END
    END
    END
 END SymEpi ;
 END SymEpi ;
@@ -6978,7 +7058,9 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
     cls, size, elem : CARDINAL ;
     cls, size, elem : CARDINAL ;
     isFunc, groupVar : BOOLEAN ;
     isFunc, groupVar : BOOLEAN ;
     saveNest, saveLoc, saveRes, saveF : CARDINAL ;
     saveNest, saveLoc, saveRes, saveF : CARDINAL ;
-    saveLB, savePO : CARDINAL ;
+    saveLB, savePO, saveRP : CARDINAL ;
+    saveR : BOOLEAN ;
+    realResult : BOOLEAN ;
     nestMark : CARDINAL ;             (* symTop just inside this procedure *)
     nestMark : CARDINAL ;             (* symTop just inside this procedure *)
     i, first : CARDINAL ;
     i, first : CARDINAL ;
 BEGIN
 BEGIN
@@ -7008,6 +7090,8 @@ BEGIN
    saveF := VAL (CARDINAL, ORD (curIsFunc)) ;
    saveF := VAL (CARDINAL, ORD (curIsFunc)) ;
    saveLB := locBytes ;
    saveLB := locBytes ;
    savePO := parmOff ;
    savePO := parmOff ;
+   saveRP := resultPtrOff ;
+   saveR := resultIsReal ;
    INC (lexnest) ;
    INC (lexnest) ;
    nestMark := symTop ;          (* after the proc's own name, before its params *)
    nestMark := symTop ;          (* after the proc's own name, before its params *)
    locFree := 0FFFFH ;
    locFree := 0FFFFH ;
@@ -7055,8 +7139,7 @@ BEGIN
                Err (ENoLib) ;
                Err (ENoLib) ;
                RETURN
                RETURN
             END ;
             END ;
-            IF (size > 2) AND (cls # TString)
-               AND NOT (groupVar AND (cls = TReal)) THEN
+            IF (size > 2) AND (cls # TString) AND (cls # TReal) THEN
                (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
                (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
                   the stack); any other type wider than a word - a record, an
                   the stack); any other type wider than a word - a record, an
                   array, a set - is still refused.  A VAR REAL is allowed:
                   array, a set - is still refused.  A VAR REAL is allowed:
@@ -7132,15 +7215,22 @@ BEGIN
       symtab [old].parmFirst := nestMark ;
       symtab [old].parmFirst := nestMark ;
       symtab [old].parmCount := symTop - nestMark
       symtab [old].parmCount := symTop - nestMark
    END ;
    END ;
+   realResult := FALSE ;
    IF isFunc THEN
    IF isFunc THEN
       IF MatchDelim (':') THEN
       IF MatchDelim (':') THEN
          ParseType (cls, size, elem)
          ParseType (cls, size, elem)
+      ELSIF symtab [old].fwd AND (symtab [old].cls # TNone) THEN
+         (* The definition of a forward repeats only the name; inherit the
+            result type declared by the forward. *)
+         cls := symtab [old].cls ;
+         size := symtab [old].size ;
+         elem := symtab [old].elem
       ELSE
       ELSE
          cls := TScalar ;
          cls := TScalar ;
          size := 2 ;
          size := 2 ;
          elem := 2
          elem := 2
       END ;
       END ;
-      IF size > 2 THEN
+      IF (size > 2) AND (cls # TReal) THEN
          Err (ENoLib) ;
          Err (ENoLib) ;
          RETURN
          RETURN
       END ;
       END ;
@@ -7150,7 +7240,17 @@ BEGIN
                            (locFree - size + 1) MOD 10000H, 0, TRUE) ;
                            (locFree - size + 1) MOD 10000H, 0, TRUE) ;
       symtab [old].resvar := resultVar ;
       symtab [old].resvar := resultVar ;
       locFree := (locFree - size) MOD 10000H ;
       locFree := (locFree - size) MOD 10000H ;
-      locBytes := locBytes + size
+      locBytes := locBytes + size ;
+      resultIsReal := (cls = TReal) ;
+      IF resultIsReal THEN
+         (* Hidden two-byte local holding the caller's result destination.
+            The caller passes it in DI before the CALL. *)
+         resultPtrOff := (locFree - 1) MOD 10000H ;
+         locFree := (locFree - 2) MOD 10000H ;
+         locBytes := locBytes + 2
+      ELSE
+         resultPtrOff := 0
+      END
    END ;
    END ;
    IfMatchSemi () ;
    IfMatchSemi () ;
    PeekKw (tok2) ;
    PeekKw (tok2) ;
@@ -7164,6 +7264,8 @@ BEGIN
       lexnest := saveNest ;
       lexnest := saveNest ;
       locFree := saveLoc ;
       locFree := saveLoc ;
       resultVar := saveRes ;
       resultVar := saveRes ;
+      resultIsReal := saveR ;
+      resultPtrOff := saveRP ;
       curIsFunc := (saveF # 0) ;
       curIsFunc := (saveF # 0) ;
       locBytes := saveLB ;
       locBytes := saveLB ;
       parmOff := savePO ;
       parmOff := savePO ;
@@ -7174,6 +7276,12 @@ BEGIN
    symtab [old].defnd := TRUE ;
    symtab [old].defnd := TRUE ;
    EmPushBp () ;
    EmPushBp () ;
    EmMovBpSp () ;
    EmMovBpSp () ;
+   IF resultIsReal THEN
+      (* The caller put the six-byte result destination in DI.  Save it
+         before declarations/body can reuse DI. *)
+      EmMovAxDi () ;
+      EmStoreVar (TRUE, resultPtrOff, 2)
+   END ;
    DefPart () ;                       (* nested declarations; stops at BEGIN *)
    DefPart () ;                       (* nested declarations; stops at BEGIN *)
    IF locBytes > 0 THEN
    IF locBytes > 0 THEN
       EmSubSp (locBytes)
       EmSubSp (locBytes)
@@ -7198,6 +7306,8 @@ BEGIN
    lexnest := saveNest ;
    lexnest := saveNest ;
    locFree := saveLoc ;
    locFree := saveLoc ;
    resultVar := saveRes ;
    resultVar := saveRes ;
+   resultIsReal := saveR ;
+   resultPtrOff := saveRP ;
    curIsFunc := (saveF # 0) ;
    curIsFunc := (saveF # 0) ;
    locBytes := saveLB ;
    locBytes := saveLB ;
    parmOff := savePO
    parmOff := savePO
@@ -7477,6 +7587,9 @@ BEGIN
    lexnest := 0 ;
    lexnest := 0 ;
    curIsFunc := FALSE ;
    curIsFunc := FALSE ;
    resultVar := 0 ;
    resultVar := 0 ;
+   resultIsReal := FALSE ;
+   resultPtrOff := 0 ;
+   callScratch := 0 ;
    locFree := 0FFFFH ;
    locFree := 0FFFFH ;
    locBytes := 0 ;
    locBytes := 0 ;
    parmOff := 4 ;
    parmOff := 4 ;

+ 1 - 0
shell/tests/audit_helpers.py

@@ -161,6 +161,7 @@ NON_ONE_LINE = {
         "FileIo": COMP,        # typed-file INT 21h sequence; see EmFileIo
         "FileIo": COMP,        # typed-file INT 21h sequence; see EmFileIo
         "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,
         "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,

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

@@ -25,13 +25,13 @@
 # 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): `function Expression(...):Real;forward;'.  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) and
-# VAR REAL parameters moved the ladder 15911 -> 18267 -> 19847 -> 20912 ->
-# 22253 -> 22280 -> 22706 -> 22859 -> 23700 -> 25674 -> 26066 -> 26924 ->
-# 27648 -> 28074 -> 31758 -> 32096.  The next blocker is a REAL function
-# result (TP3 error 102).
-CALC.PAS	ERR	102	32096
+# 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

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

@@ -688,3 +688,11 @@ t96_valint	OK	328	20
 #                   copy through the two-byte address slot, using record fields
 #                   copy through the two-byte address slot, using record fields
 #                   as actual parameters.
 #                   as actual parameters.
 t97_varreal	OK	282	28
 t97_varreal	OK	282	28
+
+#   t98_realfunc         a REAL function result, copied through a VAR REAL
+#                   parameter and formatted with Str.
+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

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

@@ -0,0 +1 @@
+3

+ 31 - 0
shell/tests/fixtures/t98_realfunc.pas

@@ -0,0 +1,31 @@
+program t98_realfunc;
+
+{ t98 -- a REAL function result.  `three' returns six bytes through the
+  caller's scratch address; a VAR REAL parameter copies it into a record
+  field, which Str then formats. }
+
+type
+  R = record
+    V : real;
+  end;
+
+var
+  A : R;
+  S : string[10];
+
+function three : real;
+begin
+  three := 3
+end;
+
+procedure put (var Z : real);
+begin
+  Z := three
+end;
+
+begin
+  A.V := 0;
+  put (A.V);
+  Str (A.V : 0 : 0, S);
+  writeln (S)
+end.

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

@@ -0,0 +1 @@
+3

+ 30 - 0
shell/tests/fixtures/t99_valreal.pas

@@ -0,0 +1,30 @@
+program t99_valreal;
+
+{ t99 -- value REAL parameters.  `id(X : real)' receives a six-byte copy on
+  the stack; the argument is a VAR REAL parameter inside `put'. }
+
+type
+  R = record
+    V : real;
+  end;
+
+var
+  A : R;
+  S : string[10];
+
+function id (X : real) : real;
+begin
+  id := X
+end;
+
+procedure put (var Z : real);
+begin
+  Z := id (Z)
+end;
+
+begin
+  A.V := 3;
+  put (A.V);
+  Str (A.V : 0 : 0, S);
+  writeln (S)
+end.