TP3: nested records, record copy, enum subranges, REAL division

CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | position | blocker |
 |---|---|
-| **compiles** | `CALC.PAS` reaches its final `.` — code **27,498** B, data **19,694** B |
+| **compiles** | `CALC.PAS` reaches its final `.` — code **27,484** B, data **19,694** B |
 
 Rungs behind it (now passed):
 
@@ -164,7 +164,7 @@ Rungs ahead:
 | 51322 | CASE/ELSE closing `end;` - DONE |
 | 52316 | string vs CHAR comparison (`S <> Chr($FF)`) - DONE |
 | 56540 | code-image ceiling - DONE (DataStart moved to 0xA000) |
-| **OK** | **CALC.PAS compiles: code 27,498, data 19,694** |
+| **OK** | **CALC.PAS compiles: code 27,484, data 19,694** |
 
 Corrections the measurements force, worth stating plainly because the stage list
 below was written before them:
@@ -1262,15 +1262,15 @@ include directory, boots it under qemu and feeds the default welcome/quit keys.
 `--keys '\r...'`, `--keys-file`, `--com`, `--raw`, `--timeout` and `--verbose`
 are available; input is a static boot-time key stream, not a live terminal.
 
-**CALC.PAS compiles and runs.**  The runtime is 9,570 bytes; the generated
-program is 27,498 bytes of code and 19,694 bytes of data, with
+**CALC.PAS compiles and runs.**  The runtime is 9,597 bytes; the generated
+program is 27,484 bytes of code and 19,694 bytes of data, with
 `DataStart=0xA000` and `CodeMax=0xA000`.  The boot harness now loads images at
 segment `0x1000` and puts its input descriptor at `0x9800`, so the larger image
 no longer collides with the boot sector/BIOS areas.  The loader reads 77
 sectors and accepts images up to 38,656 bytes.  `tests/calc_smoke.py`
 boots CALC.COM under qemu, enters `1+2` in cell A1, checks the resulting
 `3.00` and the welcome/grid/command menu, sends `/Q`, and requires exit code 0.  The original CALC.COM is 27,901 bytes; ours is
-37,071 bytes because the runtime, static links and code layout differ.
+37,084 bytes because the runtime, static links and code layout differ.
 
 **Stage 14 — the CRT identifiers.** `GotoXY` (25), `LowVideo`/`NormVideo`
 (16 + 16), `ClrEol` (10), `ClrScr` (6), `KeyPressed` (3), `Delay` (1),
@@ -1317,8 +1317,8 @@ remaining run-time capacity note.
 | limit | value | CALC needs | verdict |
 |---|---|---|---|
 | `TextLimit` (source buffer) | 62,903 | `CALC.PAS` + `CALC.INC`, normalised = **62,415** | **488 bytes of slack** |
-| `MaxCode` | 0A000h | 27,498 B program + 9,570 B runtime = **37,068 B** | **OK, 3,892 B spare** |
-| code window | `CodeMax = 0A000h`, capped by `MaxCode` | 27,498 B | **OK**; no data gap (§3.2) |
+| `MaxCode` | 0A000h | 27,484 B program + 9,597 B runtime = **37,081 B** | **OK, 3,879 B spare** |
+| code window | `CodeMax = 0A000h`, capped by `MaxCode` | 27,484 B | **OK**; no data gap (§3.2) |
 | data area | fixed image `0A000h`, zeroed by `initmem` | **19,694 B** (generated) | **OK**; CALC boots under qemu |
 | stack | 16,384 min / 655,360 max | 16,384 min | matches the original's `minstk`/`maxstk` |
 | `MaxSym` | 3,000 | 47 routines + locals + params | **inferred** OK, verify |

CORPUS-TEST.md

@@ -78,8 +78,18 @@ TP3 examples — were deliberately kept.
 Before cleanup: **6,810 files**, **4,919 `.pas`**, **907 zips**.
 After cleanup: **1,731 files**, **71 `.pas`**, **858 zips**.
 
-The remaining 71 Pascal files compile as **54 OK / 17 errors** after the first
-compiler upgrades (long identifiers, named labels, `Addr`, field widths,
-nested arrays, negative bounds, forward pointer types, `NIL`, and forward
-procedure parameters).  The remaining 17 are TP3-feature gaps, not
-unit/Delphi noise.
+The remaining 71 Pascal files compile as **57 OK / 14 errors** with the
+current compiler.  The recent upgrades cover long identifiers, named labels,
+`Addr`, field widths, nested arrays, negative bounds, forward pointer types,
+`NIL`, forward procedure parameters, nested record fields, whole-record/array
+assignment, integer `/` as REAL division, `Ord`, `Succ`/`Pred` on enums, and
+enum subranges.  The remaining 14 are TP3-feature gaps, not unit/Delphi noise:
+
+`BINOUT`, `CONVERT`, `DYNREC`, `FINDCHRS`, `LIST3`, `OT3`, `READARRY`,
+`READDATA`, `READINTS`, `READSTOR`, `SETS`, `STRARRAY`, `TIMEDATE`, `VARREC`.
+
+They reduce to four groups: `Round`/`Trunc` REAL-to-integer conversion
+(`CONVERT`), pointer-array dereference and variant/`absolute` records
+(`DYNREC`, `LIST3`, `OT3`, `VARREC`), set operations with a literal on the
+left (`FINDCHRS`, `SETS`), and text-file `Read`/`Readln` plus character-array
+and typed-file I/O (`BINOUT`, `READ*`, `STRARRAY`).

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
-**CALC.PAS compiles and runs** (code 27,498, data 19,694), the `{$I}` include,
+**CALC.PAS compiles and runs** (code 27,484, data 19,694), 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`/
@@ -2070,7 +2070,7 @@ standard functions (`Abs`, `Sqr`, `Sqrt`, `Ln`, `Exp`, `Sin`, `Cos`,
 landed, along with `Delete` and local `set of Char` variables.  The math runtime
 was compacted to guest Horner/square loops, reducing it from 14,063 to 9,203
 bytes.  `Insert`, CASE/ELSE trailing semicolons and string-vs-CHAR comparisons
-are also landed.  **CALC.PAS now compiles to its final `.`** with code 27,498
+are also landed.  **CALC.PAS now compiles to its final `.`** with code 27,484
 and data 19,694.  Nested procedures now use a real static link, so a cell can
 be entered and its formula/text edited (the first cell-entry path no longer
 restarts or corrupts the screen).  The boot loader now uses segment 0x1000
@@ -2079,7 +2079,7 @@ in DL as real DOS requires, not only in AL as the private boot handler did;
 CALC is verified under the FreeDOS 1.4 LiveCD (welcome, `1+2` -> `3.00`,
 menu, `/Q`).  `tests/calc_smoke.py` still boots the project harness, enters
 `1+2` in cell A1, checks the resulting `3.00` and quits via `/Q`.  `tests/calc_cli.py` is the manual launcher
-(`--keys`, `--keys-file`, `--com`, `--raw`, `--timeout`).  The runtime is 9,570 bytes / 59 entries; the
+(`--keys`, `--keys-file`, `--com`, `--raw`, `--timeout`).  The runtime is 9,597 bytes / 60 entries; the
 rt_exec scaffold is at HDR=0x4000 / data 0x5000.  Items 1-4 below are
 independent of both tracks.
 

shell/Compiler.mod

@@ -146,7 +146,7 @@ CONST
    BI_New = 23 ; BI_Dispose = 24 ; BI_Eof = 25 ; BI_Val = 26 ;
    BI_Copy = 27 ; BI_Abs = 28 ; BI_Sqrt = 29 ; BI_Sqr = 30 ;
    BI_Ln = 31 ; BI_Exp = 32 ; BI_Sin = 33 ; BI_Cos = 34 ; BI_Arctan = 35 ;
-   BI_Int = 36 ; BI_Delete = 37 ; BI_Insert = 38 ;
+   BI_Int = 36 ; BI_Delete = 37 ; BI_Insert = 38 ; BI_Ord = 39 ;
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -252,6 +252,8 @@ TYPE
          setsize : CARDINAL ;       (* ... and how many bytes there are *)
          sz      : CARDINAL ;       (* width of a kind-1 value: an element or
                                        field's size, not its variable's *)
+         fldFirst, fldLast : CARDINAL ;  (* current record metadata *)
+         arrIdx  : CARDINAL ;       (* current array shape, if any *)
       END ;
 
    DirRec = RECORD  rng, chk : BOOLEAN  END ;
@@ -264,6 +266,8 @@ TYPE
          elem   : CARDINAL ;
          off    : CARDINAL ;        (* byte offset within the record *)
          lo, hi : LONGINT ;         (* bounds, for a subrange/enum field *)
+         fldFirst, fldLast : CARDINAL ;  (* nested record metadata *)
+         arrIdx : CARDINAL ;
       END ;
 
    ArrRec =
@@ -272,6 +276,7 @@ TYPE
          lo, hi : ARRAY [0..3] OF LONGINT ;
          elem   : CARDINAL ;        (* element size in bytes *)
          ecls   : CARDINAL ;        (* element CLASS, for a subscripted value *)
+         fldFirst, fldLast : CARDINAL ;  (* leaf record metadata *)
       END ;
 
 (* ---------------------------------------------------------------- *)
@@ -395,10 +400,12 @@ VAR
    TU_WrInt    : CARDINAL ;  TU_WrIntW : CARDINAL ;
    TU_WrChar   : CARDINAL ;  TU_WrBool : CARDINAL ;
    TU_WrCharW  : CARDINAL ;  TU_WrBoolW : CARDINAL ;  TU_WrStrW : CARDINAL ;
+   TU_MemCopy  : 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_RealFromInt : CARDINAL ;
    TU_WrLn     : CARDINAL ;
    TU_RdInt    : CARDINAL ;  TU_RdChar : CARDINAL ;  TU_RdBool : CARDINAL ;
    TU_RdLn     : CARDINAL ;  TU_Halt   : CARDINAL ;
@@ -2711,7 +2718,10 @@ BEGIN
          r.kind := 5 ;
          r.boff := 0 ;
          r.cls := symtab [p].cls ;
-         r.sz := symtab [p].size
+         r.sz := symtab [p].size ;
+         r.fldFirst := symtab [p].fldFirst ;
+         r.fldLast := symtab [p].fldLast ;
+         r.arrIdx := symtab [p].arrIdx
       ELSIF CurCh () = '.' THEN
          (* FIELD selection: `r.f'.  The field's offset adds to the record
             base's, and the value's class and WIDTH become the field's - which
@@ -2723,13 +2733,13 @@ BEGIN
             RETURN
          END ;
          GetWord () ;
-         IF symtab [r.idx].fldFirst >= symtab [r.idx].fldLast THEN
+         IF r.fldFirst >= r.fldLast THEN
             Err (ESimpType) ;               (* not a record *)
             RETURN
          END ;
-         fi := symtab [r.idx].fldFirst ;
+         fi := r.fldFirst ;
          found := FALSE ;
-         WHILE (fi < symtab [r.idx].fldLast) AND NOT found DO
+         WHILE (fi < r.fldLast) AND NOT found DO
             IF NameEq (fields [fi].name, wrd) THEN
                found := TRUE
             ELSE
@@ -2754,6 +2764,9 @@ BEGIN
          END ;
          r.cls := fields [fi].cls ;
          r.sz := fields [fi].size ;
+         r.fldFirst := fields [fi].fldFirst ;
+         r.fldLast := fields [fi].fldLast ;
+         r.arrIdx := fields [fi].arrIdx ;
          IF r.cls = TSet THEN
             (* ParseVar set setoff only when the SYMBOL itself was a set; for
                an array/record the class was still TArray/TRecord then, so the
@@ -2764,7 +2777,7 @@ BEGIN
          END
       ELSIF CurCh () = '[' THEN
          DropCh (GetCh ()) ;
-         IF symtab [r.idx].cls = TString THEN
+         IF r.cls = TString THEN
             (* s[i]: a STRING is a length byte at s[0] followed by the
                characters, so index i selects the one byte at off+i.  A second
                subscript on a character is not a type. *)
@@ -2816,7 +2829,7 @@ BEGIN
                r.sz := 1
             END ;
             ExpectDelim (']', ENoSemi)
-         ELSIF symtab [r.idx].cls = TArray THEN
+         ELSIF r.arrIdx > 0 THEN
             (* An array subscript LIST: one expression per dimension, comma
                separated.  The byte offset is
                   sum over k of (i[k] - lo[k]) * stride[k]
@@ -2825,12 +2838,8 @@ BEGIN
                A constant index folds into coff; a run-time one is scaled as
                soon as it is parsed and summed on the STACK, because parsing
                the next index may clobber AX and DI. *)
-            IF symtab [r.idx].arrIdx = 0 THEN
-               Err (ESimpType) ;
-               RETURN
-            END ;
             baseDI := (r.kind = 5) ;
-            ai := symtab [r.idx].arrIdx - 1 ;
+            ai := r.arrIdx - 1 ;
             nd := 0 ;
             coff := 0 ;
             accOnStack := FALSE ;
@@ -2928,7 +2937,10 @@ BEGIN
                r.boff := W16 (VAL (LONGINT, r.boff) + coff)
             END ;
             r.sz := arrs [ai].elem ;
-            r.cls := arrs [ai].ecls
+            r.cls := arrs [ai].ecls ;
+            r.fldFirst := arrs [ai].fldFirst ;
+            r.fldLast := arrs [ai].fldLast ;
+            r.arrIdx := 0
          ELSE
             ParseExpr (t) ;
             IF OK () THEN
@@ -2969,6 +2981,9 @@ BEGIN
          r.boff := 0 ;
          r.cls := symtab [p].cls ;
          r.sz := symtab [p].size ;
+         r.fldFirst := symtab [p].fldFirst ;
+         r.fldLast := symtab [p].fldLast ;
+         r.arrIdx := symtab [p].arrIdx ;
          ParseSub (r) ;
          RETURN
       END
@@ -2994,6 +3009,9 @@ BEGIN
       r.setsize := symtab [r.idx].size
    END ;
    r.sz := symtab [r.idx].size ;
+   r.fldFirst := symtab [r.idx].fldFirst ;
+   r.fldLast := symtab [r.idx].fldLast ;
+   r.arrIdx := symtab [r.idx].arrIdx ;
    ParseSub (r)
 END ParseVar ;
 
@@ -3034,7 +3052,9 @@ 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
+   IF (left.cls = TReal) OR (right.cls = TReal) OR (op = OpDiv) THEN
+      (* `/` is real division even when both operands are integers; Pascal's
+         `div` is the integer operator and has its own token. *)
       RealBin (op, left, right, res) ;
       RETURN
    END ;
@@ -4371,6 +4391,9 @@ BEGIN
          r.idx := withIdx [w] ;
          r.cls := fields [fi].cls ;
          r.sz := fields [fi].size ;
+         r.fldFirst := fields [fi].fldFirst ;
+         r.fldLast := fields [fi].fldLast ;
+         r.arrIdx := fields [fi].arrIdx ;
          IF r.cls = TSet THEN
             r.setbase := fields [fi].elem ;
             r.setsize := fields [fi].size
@@ -4674,7 +4697,7 @@ BEGIN
       IF NOT OK () THEN
          RETURN
       END ;
-      IF (r.cls # TChar) AND (r.cls # TScalar) THEN
+      IF (r.cls # TChar) AND (r.cls # TScalar) AND (r.cls # TEnum) THEN
          Err (ETypeErr) ;
          RETURN
       END ;
@@ -4804,6 +4827,26 @@ BEGIN
          Err (ETypeErr)
       END ;
       RETURN
+   ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Ord) THEN
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF (r.cls # TChar) AND (r.cls # TEnum) AND (r.cls # TScalar)
+         AND (r.cls # TBool) THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      LoadAtom (r) ;
+      r.kind := 2 ;
+      r.cls := TScalar ;
+      r.chr := FALSE ;
+      RETURN
    ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Length) THEN
       (* LENGTH (s): the string's length byte, loaded inline.  No runtime
          entry, and no address is pushed - a string's value already carries its
@@ -5204,6 +5247,32 @@ BEGIN
    END
 END IntToMbf ;
 
+PROCEDURE RealOperand (r : ERes ; dstOff : CARDINAL) ;
+(* Copy a REAL operand into a 6-byte scratch, converting an ordinal value to
+   REAL first.  RealBin and RealUnary used to call EmCopyRealTo directly; an
+   INTEGER variable there was refused, so `E := A/B' could not compile. *)
+VAR tmp : CARDINAL ;
+BEGIN
+   IF r.cls = TReal THEN
+      EmCopyRealTo (dstOff, r)
+   ELSIF (r.cls = TSet) OR (r.cls = TString) THEN
+      Err (ETypeErr)
+   ELSE
+      IF r.kind = 5 THEN
+         EmPushDi ()
+      ELSIF r.kind = 1 THEN
+         EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
+      ELSE
+         LoadAtom (r) ;
+         EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
+         EmPushVarAddr (FALSE, symtab [tmpA].off)
+      END ;
+      EmPushVarAddr (FALSE, dstOff) ;
+      DropC (EmCall (TU_RealFromInt)) ;
+      EmAddSp (4)
+   END
+END RealOperand ;
+
 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
@@ -5212,11 +5281,11 @@ VAR block, ent : CARDINAL ;
 BEGIN
    block := NewScratchRealBlock () ;
    IF right.kind = 5 THEN
-      EmCopyRealTo (symtab [block].off + 6, right) ;
-      EmCopyRealTo (symtab [block].off, left)
+      RealOperand (right, symtab [block].off + 6) ;
+      RealOperand (left, symtab [block].off)
    ELSE
-      EmCopyRealTo (symtab [block].off, left) ;
-      EmCopyRealTo (symtab [block].off + 6, right)
+      RealOperand (left, symtab [block].off) ;
+      RealOperand (right, symtab [block].off + 6)
    END ;
    CASE op OF
       OpAdd : ent := TU_RealAdd
@@ -5265,6 +5334,46 @@ BEGIN
       Err (EUnknown) ;
       RETURN
    END ;
+   IF ((r.kind = 1) OR (r.kind = 5)) AND (VarSize (r) > 2)
+      AND ((r.cls = TRecord) OR (r.cls = TArray)) THEN
+      (* Whole record/array assignment: copy VarSize(r) bytes.  This is what
+         BIGREC/DYNREC's `Mother := Self', `Father^ := Mother^' and
+         `Friend[Index] := Mother' need.  A DI-addressed destination has to
+         be parked before the source expression can reuse DI. *)
+      IF r.kind = 5 THEN
+         EmPushDi ()
+      END ;
+      ParseExpr (src) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF (src.kind # 1) AND (src.kind # 5) THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      IF VarSize (src) # VarSize (r) THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      IF src.kind = 5 THEN
+         EmPushDi ()
+      ELSE
+         EmPushSymAddr (src.idx, (symtab [src.idx].off + src.boff) MOD 10000H)
+      END ;
+      IF r.kind = 5 THEN
+         (* stack now holds dest, source; make it source, dest for the ABI *)
+         EmPopAx () ;
+         EmPopBx () ;
+         EmPushAx () ;
+         EmPushBx ()
+      ELSE
+         EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
+      END ;
+      EmMovCxi (VarSize (r)) ;
+      DropC (EmCall (TU_MemCopy)) ;
+      EmAddSp (4) ;
+      RETURN
+   END ;
    IF r.cls = TReal THEN
       (* A 6-byte REAL.  A compile-time ordinal constant is converted to the
          measured MBF layout; another REAL field is copied byte for byte.
@@ -7043,7 +7152,7 @@ BEGIN
             Err (ECompOvf) ;
             RETURN
          END ;
-         IF symtab [t.idx].fldFirst >= symtab [t.idx].fldLast THEN
+         IF t.fldFirst >= t.fldLast THEN
             Err (ETypeErr) ;
             RETURN
          END ;
@@ -7064,8 +7173,8 @@ BEGIN
             RETURN
          END ;
          withIdx [withN] := t.idx ;
-         withFF [withN] := symtab [t.idx].fldFirst ;
-         withFL [withN] := symtab [t.idx].fldLast ;
+         withFF [withN] := t.fldFirst ;
+         withFL [withN] := t.fldLast ;
          INC (withN) ;
          IF MatchDelim (',') THEN
             (* another base; the last one is innermost *)
@@ -7082,6 +7191,8 @@ BEGIN
    ELSE
       (* identifier statement: assignment or call *)
       IF WithLookup (wrd, t) THEN
+         (* A field inside WITH may be followed by `.subfield' or `[index]'. *)
+         ParseSub (t) ;
          IF MatchAssign () THEN
             Assignment (t) ;
             RETURN
@@ -7115,6 +7226,9 @@ BEGIN
             t.cls := symtab [t.idx].cls
          END ;
          t.sz := symtab [t.idx].size ;      (* ParseSub may narrow it further *)
+         t.fldFirst := symtab [t.idx].fldFirst ;
+         t.fldLast := symtab [t.idx].fldLast ;
+         t.arrIdx := symtab [t.idx].arrIdx ;
          IF t.cls = TSet THEN
             (* The identifier-statement path does not go through ParseVar, so
                it must carry the same set metadata: Assignment's set branch
@@ -7150,6 +7264,7 @@ VAR tok : CARDINAL ;
     consumed : BOOLEAN ;
     running, groupFirst, i, an, recStart : CARDINAL ;
     innerIdx, innerN, leafElem, leafCls, j : CARDINAL ;
+    elemFldFirst, elemFldLast, fieldFldFirst, fieldFldLast, fieldArrIdx : CARDINAL ;
     alo, ahi : ARRAY [0..3] OF LONGINT ;
     ecls2 : CARDINAL ;
 BEGIN
@@ -7278,6 +7393,8 @@ BEGIN
       ParseType (cls, s2, e2) ;
       ecls2 := cls ;
       innerIdx := newArrIdx ;
+      elemFldFirst := recFldFirst ;
+      elemFldLast := recFldLast ;
       IF (cls = TArray) AND (innerIdx > 0) THEN
          (* Flatten array-of-array: the outer symbol must index the same
             number of dimensions as `array[a,b]'.  A named element array
@@ -7285,6 +7402,8 @@ BEGIN
             inner ArrRec; keep only the leaf element size and class here. *)
          leafElem := arrs [innerIdx - 1].elem ;
          leafCls := arrs [innerIdx - 1].ecls ;
+         elemFldFirst := arrs [innerIdx - 1].fldFirst ;
+         elemFldLast := arrs [innerIdx - 1].fldLast ;
          innerN := arrs [innerIdx - 1].n
       ELSE
          leafElem := s2 ;
@@ -7306,6 +7425,8 @@ BEGIN
          arrs [arrTop].n := an + innerN ;
          arrs [arrTop].elem := leafElem ;
          arrs [arrTop].ecls := leafCls ;
+         arrs [arrTop].fldFirst := elemFldFirst ;
+         arrs [arrTop].fldLast := elemFldLast ;
          i := 0 ;
          WHILE i < an DO
             arrs [arrTop].lo [i] := alo [i] ;
@@ -7396,6 +7517,9 @@ BEGIN
          IF NOT OK () THEN
             RETURN
          END ;
+         fieldFldFirst := recFldFirst ;
+         fieldFldLast := recFldLast ;
+         fieldArrIdx := newArrIdx ;
          (* every name in the group gets the type and its own slot *)
          i := groupFirst ;
          WHILE i < fldTop DO
@@ -7405,6 +7529,9 @@ BEGIN
             fields [i].off := running ;
             fields [i].lo := enumLo ;
             fields [i].hi := enumHi ;
+            fields [i].fldFirst := fieldFldFirst ;
+            fields [i].fldLast := fieldFldLast ;
+            fields [i].arrIdx := fieldArrIdx ;
             running := running + s2 ;
             INC (i)
          END ;
@@ -7459,7 +7586,30 @@ BEGIN
       END
    ELSE
       IF consumed THEN
-         IF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
+         IF Search (wrd, idx) AND (symtab [idx].tag = KConst) THEN
+            (* An enum/ordinal subrange written with named constants:
+               `Work = Mon..Fri`.  Without this, `Mon' was mistaken for a
+               named TYPE and failed at the first dot. *)
+            lo := symtab [idx].lval ;
+            subcls := symtab [idx].cls ;
+            IF NOT MatchRange () THEN
+               Err (ESimpType) ;
+               RETURN
+            END ;
+            RdConst (hi, subcls, strf) ;
+            IF NOT OK () THEN
+               RETURN
+            END ;
+            cls := TEnum ;
+            IF (lo >= 0) AND (hi <= 255) AND (lo <= hi) THEN
+               size := 1
+            ELSE
+               size := 2
+            END ;
+            elem := size ;
+            enumLo := lo ;
+            enumHi := hi
+         ELSIF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
             cls := symtab [idx].cls ;
             size := symtab [idx].size ;
             (* The type's ELEMENT size, not its total size.  They are equal for
@@ -8381,6 +8531,8 @@ BEGIN
    i := NewSym ("KEYPRESSED", KBuiltin, BI_KeyPressed, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
    i := NewSym ("UPCASE", KBuiltin, BI_UpCase, 0, 0, 0, 0, FALSE) ;
+   i := NewSym ("ORD", KBuiltin, BI_Ord, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
    i := NewSym ("SUCC", KBuiltin, BI_Succ, 0, 0, 0, 0, FALSE) ;
    i := NewSym ("PRED", KBuiltin, BI_Pred, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
@@ -8583,12 +8735,14 @@ BEGIN
    TU_WrCharW  := RT_Entry (56) ;
    TU_WrBoolW  := RT_Entry (57) ;
    TU_WrStrW   := RT_Entry (58) ;
+   TU_MemCopy  := RT_Entry (59) ;
    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_RealFromInt := RT_Entry (21) ;
    TU_RealSub   := RT_Entry (23) ;
    TU_RealMul   := RT_Entry (24) ;
    TU_RealDiv   := RT_Entry (25) ;

shell/Runtime.mod

@@ -1323,6 +1323,28 @@ BEGIN
    RetR
 END EmitWrStr ;
 
+PROCEDURE EmitMemCopy ;
+(* Copy CX bytes from [BP+6] to [BP+4].  Used for whole record/array
+   assignment.  ES is not reloaded: in this flat .COM ES = DS. *)
+BEGIN
+   M ("memcopy") ;
+   PushBp ; MovBpSp ;
+   PushSi ; PushDi ;
+   MovSiBp6 ;
+   MovDiBp4 ;
+   Jcxz8 ("memcopy_done") ;
+   M ("memcopy_loop") ;
+   MovAlSi ; StDiAl ;                  (* byte loop: MOVS/STOS use ES, and the
+                                          shell's interpreter only guarantees
+                                          DS=ES in a .COM *)
+   IncSi ; IncDi ;
+   Loop8 ("memcopy_loop") ;
+   M ("memcopy_done") ;
+   PopDi ; PopSi ;
+   MovSpBp ; PopBp ;
+   RetR
+END EmitMemCopy ;
+
 PROCEDURE EmitWrCharW ;
 (* CHAR with a field width: value at [BP+6], width at [BP+4]. *)
 BEGIN
@@ -4224,7 +4246,7 @@ BEGIN
    EmitRealFromInt ; EmitRealAddSub ; EmitRealMul ;
    EmitRealCmp ; EmitRealInt ; EmitRealMath ; EmitRealConv ; EmitSetOps ;
    EmitStrDelete ; EmitStrInsert ; EmitFileOps ; EmitValReal ;
-   EmitWrCharW ; EmitWrBoolW ; EmitWrStrW ;
+   EmitWrCharW ; EmitWrBoolW ; EmitWrStrW ; EmitMemCopy ;
    EmitData ;
    FixUp ;
    SetStr (entNm [0], "initmem") ;
@@ -4286,6 +4308,7 @@ BEGIN
    SetStr (entNm [56], "wrcharw") ;
    SetStr (entNm [57], "wrboolw") ;
    SetStr (entNm [58], "wrstrw") ;
+   SetStr (entNm [59], "memcopy") ;
    built := TRUE
 END RT_Build ;
 
@@ -4313,7 +4336,7 @@ BEGIN
    IF NOT built THEN
       RT_Build (0)
    END ;
-   IF i > 58 THEN
+   IF i > 59 THEN
       RETURN 0
    END ;
    RETURN rtBase + LblOff (entNm [i])

shell/tests/RtProbe.mod

@@ -108,7 +108,7 @@ END PENT ;
 
 PROCEDURE Main ;
 VAR i, n, base : CARDINAL ;
-    names : ARRAY [0..58] OF ARRAY [0..15] OF CHAR ;
+    names : ARRAY [0..59] OF ARRAY [0..15] OF CHAR ;
 BEGIN
    base := GetBase () ;
    RT_Build (base) ;
@@ -121,7 +121,7 @@ BEGIN
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    i := 0 ;
-   WHILE i <= 58 DO
+   WHILE i <= 59 DO
       names [i] := "" ;
       INC (i)
    END ;
@@ -171,8 +171,9 @@ BEGIN
    names [56] := "wrcharw" ;
    names [57] := "wrboolw" ;
    names [58] := "wrstrw" ;
+   names [59] := "memcopy" ;
    i := 0 ;
-   WHILE i <= 58 DO
+   WHILE i <= 59 DO
       PENT (i, names [i]) ;
       INC (i)
    END ;

shell/tests/audit_helpers.py

@@ -157,6 +157,7 @@ NON_ONE_LINE = {
         # golden; the name grammar cannot read a whole routine.
         "EmitFileOps": COMP,
         "EmitWrCharW": COMP, "EmitWrBoolW": COMP, "EmitWrStrW": COMP,
+        "EmitMemCopy": COMP,
         "AddDiImm": COMP, "AddBxImm": COMP,
     },
     "Compiler.mod": {
@@ -772,7 +773,7 @@ def sweep(src, mod, verbose):
     # Its D_ offsets are asserted against this block by check_runtime.py's
     # golden, so "excluded from the name audit" is not "unchecked": the bytes
     # are pinned, only the name-to-opcode correspondence does not apply.
-    excluded = {"EmitData", "EmitFileOps"}
+    excluded = {"EmitData", "EmitFileOps", "EmitMemCopy"}
     if verbose:
         print("-- %s" % mod)
         print("name                 bytes            FCML decode")
@@ -981,7 +982,7 @@ def sweep(src, mod, verbose):
     # Its D_ offsets are asserted against this block by check_runtime.py's
     # golden, so "excluded from the name audit" is not "unchecked": the bytes
     # are pinned, only the name-to-opcode correspondence does not apply.
-    excluded = {"EmitData", "EmitFileOps"}
+    excluded = {"EmitData", "EmitFileOps", "EmitMemCopy"}
     strip = (lambda s: s[2:]) if mod != "Runtime.mod" else (lambda s: s)
     # The table is written in the names the audit uses (Runtime.mod's own
     # names, Compiler.mod's with the Em prefix already removed), so it is NOT

shell/tests/fixtures/calc_ladder.tsv

@@ -32,4 +32,4 @@
 # data base.  UpCase, set membership, strings, pointers, files, REAL
 # expressions/functions, recursion, forward definitions, Copy/Val/Delete/
 # Insert, local sets and the compact math runtime are all landed.
-CALC.PAS	OK	27498	19694
+CALC.PAS	OK	27484	19694

shell/tests/fixtures/expected.tsv

@@ -756,3 +756,11 @@ t122_addr	OK	91	9
 t123_nestedarray	OK	79	19
 
 t124_forwardptr	OK	94	7
+
+t125_nestedrecord	OK	53	7
+
+t126_recordassign	OK	111	21
+
+t127_enumsub	OK	55	6
+
+t128_intreal	OK	147	27

shell/tests/fixtures/t125_nestedrecord.out

@@ -0,0 +1 @@
+42

shell/tests/fixtures/t125_nestedrecord.pas

@@ -0,0 +1,8 @@
+program nrec;
+type Inner = record A : integer; end;
+     Outer = record N : Inner; end;
+var O : Outer;
+begin
+  O.N.A := 42;
+  writeln(O.N.A)
+end.

shell/tests/fixtures/t126_recordassign.out

@@ -0,0 +1 @@
+42 hi

shell/tests/fixtures/t126_recordassign.pas

@@ -0,0 +1,12 @@
+program record_assign;
+type R = record
+       A : integer;
+       S : string[5];
+     end;
+var X, Y : R;
+begin
+  X.A := 42;
+  X.S := 'hi';
+  Y := X;
+  writeln(Y.A, ' ', Y.S)
+end.

shell/tests/fixtures/t127_enumsub.out

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

shell/tests/fixtures/t127_enumsub.pas

@@ -0,0 +1,8 @@
+program enumsub;
+type Days = (Mon,Tue,Wed,Thu,Fri,Sat,Sun);
+     Work = Mon..Fri;
+var W : Work;
+begin
+  W := Mon;
+  writeln(Ord(W))
+end.

shell/tests/fixtures/t128_intreal.out

@@ -0,0 +1 @@
+4.50

shell/tests/fixtures/t128_intreal.pas

@@ -0,0 +1,9 @@
+program intreal;
+var A, B : integer;
+    E : real;
+begin
+  A := 9;
+  B := 2;
+  E := A / B;
+  writeln(E:0:2)
+end.

shell/tests/rt_exec.py

@@ -118,7 +118,7 @@ ENTS = ["initmem", "progend", "stackchk", "wrint", "wrchar", "wrbool",
         "int_fmt", "val_int", "str_copy", "val_real", "real_abs",
         "real_sqrt", "real_ln", "real_exp", "real_sin", "real_cos",
         "real_arctan", "str_delete", "str_insert",
-        "wrcharw", "wrboolw", "wrstrw"]
+        "wrcharw", "wrboolw", "wrstrw", "memcopy"]
 
 # A call slot's flags, as rtdrv.s reads them.
 F_STACK = 1     # the argument goes on the stack, popped by the caller