TP3: complete dynamic sets, text-file reads, and DOS helpers

CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 | position | blocker |
 |---|---|
-| **compiles** | `CALC.PAS` reaches its final `.` — code **27,488** B, data **19,694** B |
+| **compiles** | `CALC.PAS` reaches its final `.` — code **27,519** 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,488, data 19,694** |
+| **OK** | **CALC.PAS compiles: code 27,519, 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,744 bytes; the generated
-program is 27,488 bytes of code and 19,694 bytes of data, with
+**CALC.PAS compiles and runs.**  The runtime is 10,268 bytes; the generated
+program is 27,519 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,235 bytes because the runtime, static links and code layout differ.
+37,790 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,488 B program + 9,744 B runtime = **37,232 B** | **OK, 3,728 B spare** |
-| code window | `CodeMax = 0A000h`, capped by `MaxCode` | 27,488 B | **OK**; no data gap (§3.2) |
+| `MaxCode` | 0A000h | 27,519 B program + 10,268 B runtime = **37,787 B** | **OK, 3,173 B spare** |
+| code window | `CodeMax = 0A000h`, capped by `MaxCode` | 27,519 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,19 +78,16 @@ 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 **65 OK / 6 errors** with the
-current compiler.  The recent upgrades cover long identifiers, named labels,
+The remaining 71 Pascal files compile as **71 OK / 0 errors** with the
+current compiler.  The 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, a leading set constructor in a set expression, Round/Trunc,
 integer-to-REAL assignment, SHL/SHR, address-based pointers, char arrays,
-Msdos/Intr, and variant records.  The remaining 6 are TP3-feature gaps, not
-unit/Delphi noise:
+Msdos/Intr, and variant records.  The TP3-feature gaps are now closed; the
+corpus is clean:
 
-`FINDCHRS`, `LIST3`, `OT3`, `READDATA`, `READINTS`, `READSTOR`.
-
-They reduce to three groups: a dynamic set constructor such as
-`[Storage[Index]]` (`FINDCHRS`), DOS `Getdir`/text-file formatting
-(`LIST3`, `OT3`), and text-file numeric `Read`/`Readln`
-(`READDATA`, `READINTS`, `READSTOR`).
+The final batch closed dynamic set constructors (`[Storage[Index]]`),
+text-file width formatting (`Write(File, integer:width)` and string widths),
+`Getdir`/`Seg`/`Ofs`/`Mem`, and text-file numeric `Read`/`Readln`.

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,488, data 19,694), the `{$I}` include,
+**CALC.PAS compiles and runs** (code 27,519, 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,488
+are also landed.  **CALC.PAS now compiles to its final `.`** with code 27,519
 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,744 bytes / 62 entries; the
+(`--keys`, `--keys-file`, `--com`, `--raw`, `--timeout`).  The runtime is 10,268 bytes / 68 entries; the
 rt_exec scaffold is at HDR=0x4000 / data 0x5000.  Items 1-4 below are
 independent of both tracks.
 

shell/Compiler.mod

@@ -148,6 +148,7 @@ CONST
    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_Ord = 39 ;
    BI_Round = 40 ; BI_Trunc = 41 ; BI_Msdos = 42 ; BI_Intr = 43 ;
+   BI_GetDir = 44 ; BI_Seg = 45 ; BI_Ofs = 46 ;
    (* the sub-codes EmCrtSeq takes *)
    CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
    CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
@@ -257,6 +258,7 @@ TYPE
          fldFirst, fldLast : CARDINAL ;  (* current record metadata *)
          arrIdx  : CARDINAL ;       (* current array shape, if any *)
          ptrElem : CARDINAL ;       (* pointee type, for pointer arrays *)
+         dynElem : CARDINAL ;       (* element symbol for a dynamic set literal *)
       END ;
 
    DirRec = RECORD  rng, chk : BOOLEAN  END ;
@@ -412,6 +414,7 @@ VAR
    TU_MemCopy  : CARDINAL ;
    TU_RealToInt : CARDINAL ;
    TU_Msdos    : CARDINAL ;
+   TU_GetDir   : CARDINAL ;
    TU_WrReal   : CARDINAL ;  TU_RealWrite : CARDINAL ;  TU_RealFmt : CARDINAL ;
    TU_RealVal   : CARDINAL ;  TU_RealCmp : CARDINAL ;
    TU_RealAdd   : CARDINAL ;  TU_RealSub : CARDINAL ;
@@ -430,6 +433,7 @@ VAR
    TU_SetOp    : CARDINAL ;  (* runtime set operations, entries 31..33 *)
    TU_SetCmp   : CARDINAL ;
    TU_SetCopy  : CARDINAL ;
+   TU_SetSingle : CARDINAL ;
    TU_FileAssign  : CARDINAL ;  (* file control block operations, entries 34..38 *)
    TU_FileReset   : CARDINAL ;
    TU_FileRewrite : CARDINAL ;
@@ -439,7 +443,11 @@ VAR
    TU_HeapNew     : CARDINAL ;  (* bump allocation for New *)
    TU_FileEof     : CARDINAL ;  (* text-file end of file *)
    TU_FileReadln  : CARDINAL ;  (* text-file line read *)
+   TU_FileRdtok   : CARDINAL ;  (* text-file token read *)
+   TU_FileRdln    : CARDINAL ;  (* discard the rest of a text-file line *)
    TU_IntFmt      : CARDINAL ;  (* integer -> counted string *)
+   TU_IntFmtW     : CARDINAL ;  (* integer -> counted string, width-padded *)
+   TU_StrFmtW     : CARDINAL ;  (* string -> fixed-width counted string *)
    TU_ValInt      : CARDINAL ;  (* counted string -> integer *)
    TU_StrCopy     : CARDINAL ;  (* Copy(S,start,len) *)
    TU_ValReal     : CARDINAL ;  (* counted string -> REAL *)
@@ -1639,6 +1647,12 @@ BEGIN Ebyte (88H) ; Ebyte (05H) END EmStDiAl ;    (* 88 05: [DI] := AL *)
 PROCEDURE EmPushDi () ;
 BEGIN Ebyte (57H) END EmPushDi ;                  (* PUSH DI *)
 
+PROCEDURE EmPushSi () ;
+BEGIN Ebyte (56H) END EmPushSi ;                  (* PUSH SI *)
+
+PROCEDURE EmMovAxDs () ;
+BEGIN Ebyte (8CH) ; Ebyte (0D8H) END EmMovAxDs ;  (* MOV AX,DS *)
+
 PROCEDURE EmPopDi () ;
 BEGIN Ebyte (5FH) END EmPopDi ;                   (* POP DI *)
 
@@ -2887,6 +2901,16 @@ BEGIN
                IF NOT OK () THEN
                   RETURN
                END ;
+               Skip () ;
+               IF CurCh () = ':' THEN
+                  (* TP3 segment:offset form in Mem[...]; the segment
+                     expression is consumed and the offset is the index. *)
+                  DropCh (GetCh ()) ;
+                  ParseExpr (t) ;
+                  IF NOT OK () THEN
+                     RETURN
+                  END
+               END ;
                st := arrs [ai].elem ;
                k := nd + 1 ;
                WHILE k < arrs [ai].n DO
@@ -3459,6 +3483,28 @@ BEGIN
    res.setsize := size
 END SetBinEmit ;
 
+PROCEDURE MaterializeDyn (VAR r : ERes ; base, size : CARDINAL) ;
+(* Build a scratch set of `size' bytes with the single dynamic element at
+   `base' set.  Used for TP3's `[Storage[Index]]' constructor. *)
+VAR dest : CARDINAL ;
+BEGIN
+   dest := AllocSetScratch (size) ;
+   IF NOT OK () THEN
+      RETURN
+   END ;
+   EmMovAxi (size) ; EmPushAx () ;
+   EmMovAxi (base) ; EmPushAx () ;
+   LoadSymVar (r.dynElem, symtab [r.dynElem].off, 2) ;
+   EmPushAx () ;
+   EmPushVarAddr (FALSE, dest) ;
+   DropC (EmCall (TU_SetSingle)) ;
+   EmAddSp (8) ;
+   r.kind := 8 ;
+   r.setoff := dest ;
+   r.setbase := base ;
+   r.setsize := size
+END MaterializeDyn ;
+
 PROCEDURE EmPushStrAddr (r : ERes) ;
 (* Push the ADDRESS of a whole-string operand - the argument shape cmpstr
    takes, one per operand.
@@ -3919,6 +3965,14 @@ BEGIN
    RETURN symTop - 1
 END NewScratchStr ;
 
+PROCEDURE NewScratchWord () : CARDINAL ;
+(* Two bytes for a dynamic set literal's element value. *)
+BEGIN
+   DropC (NewSym ("@@DW", KVar, TScalar, 2, 2, dc, 0, FALSE)) ;
+   dc := dc + 2 ;
+   RETURN symTop - 1
+END NewScratchWord ;
+
 PROCEDURE NewScratchReal () : CARDINAL ;
 (* Six bytes of storage for a REAL function result, one per call site. *)
 BEGIN
@@ -4272,6 +4326,9 @@ BEGIN
                Err (ETypeErr) ;
                RETURN
             END ;
+            IF right.kind = 9 THEN
+               MaterializeDyn (right, left.setbase, left.setsize)
+            END ;
             IF op = OpAdd THEN
                SetBinEmit (1, left, right, r)
             ELSE
@@ -4475,7 +4532,8 @@ VAR idx : CARDINAL ;
     ssize, sbase : CARDINAL ;
     sbuf : ARRAY [0..31] OF CHAR ;
     uj1, uj2 : CARDINAL ;
-    litStart, scratch, asciiAddr : CARDINAL ;
+    litStart, scratch, asciiAddr, savePos : CARDINAL ;
+    dyn : ERes ;
 BEGIN
    r.chr := FALSE ;            (* default: not a quoted char literal *)
    Skip () ;
@@ -4486,10 +4544,40 @@ BEGIN
       RETURN
    END ;
    IF CurCh () = '[' THEN
-      (* An inline set literal.  Full TP3 takes its type from context; here it
-         defaults to `set of Char' (0..255), which is what CALC writes
-         (`Ch in ['a'..'z']'), and its bytes are materialised in the code
-         stream.  A typed/larger-base literal is a later milestone. *)
+      (* An inline set literal.  A literal whose first element is a variable
+         (e.g. `[Storage[Index]]') is dynamic: evaluate the element once and
+         mark it kind 9, to be materialised when the target's base/size is
+         known.  Constant literals stay code-resident. *)
+      savePos := srcPos ;
+      DropCh (GetCh ()) ;
+      Skip () ;
+      IF Alpha (CurCh ()) THEN
+         GetWord () ;
+         IF Search (wrd, idx) AND ((symtab [idx].tag = KVar) OR
+                                   (symtab [idx].tag = KFunc)) THEN
+            srcPos := savePos + 1 ;
+            ParseExpr (dyn) ;
+            ExpectDelim (']', ENoSemi) ;
+            IF NOT OK () THEN
+               RETURN
+            END ;
+            IF (dyn.cls # TScalar) AND (dyn.cls # TChar) AND
+               (dyn.cls # TEnum) THEN
+               Err (ETypeErr) ;
+               RETURN
+            END ;
+            scratch := NewScratchWord () ;
+            LoadAtom (dyn) ;
+            EmStoreVar (FALSE, symtab [scratch].off, 2) ;
+            r.kind := 9 ;
+            r.cls := TSet ;
+            r.setbase := 0 ;
+            r.setsize := 0 ;
+            r.dynElem := scratch ;
+            RETURN
+         END
+      END ;
+      srcPos := savePos ;
       ssize := 32 ;
       sbase := 0 ;
       IF RdSetLiteral (sbase, ssize, sbuf) THEN
@@ -4598,6 +4686,51 @@ BEGIN
       r.idx := 0 ;
       RETURN
    END ;
+   IF NameEq (wrd, "SEG") THEN
+      (* TP3 Seg(x): the current DS.  The argument is parsed for its type
+         and side effects; the .COM has one segment. *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      EmMovAxDs () ;                     (* MOV AX,DS *)
+      r.kind := 2 ; r.cls := TScalar ; r.sz := 2 ;
+      RETURN
+   END ;
+   IF NameEq (wrd, "OFS") THEN
+      (* TP3 Ofs(x): the run-time address of x. *)
+      IF NOT MatchDelim ('(') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      Skip () ;
+      IF NOT Alpha (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      GetWord () ;
+      ParseVar (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF r.kind = 5 THEN
+         EmMovAxDi ()
+      ELSIF r.kind = 1 THEN
+         EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H) ;
+         EmPopAx ()
+      ELSE
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      r.kind := 2 ; r.cls := TScalar ; r.sz := 2 ;
+      RETURN
+   END ;
    IF NOT Search (wrd, idx) THEN
       Err (EUnknown) ;
       RETURN
@@ -4630,6 +4763,30 @@ BEGIN
          r.cls := symtab [idx].cls
       END ;
       RETURN
+   ELSIF (symtab [idx].tag = KType) AND (symtab [idx].cls = TChar)
+      AND (CurCh () = '(') THEN
+      (* TP3 also spells the character cast `Char(n)', not only `Chr(n)'. *)
+      DropCh (GetCh ()) ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF (r.cls # TScalar) AND (r.cls # TChar) THEN
+         Err (ETypeErr) ;
+         RETURN
+      END ;
+      IF r.kind = 0 THEN
+         r.imm := VAL (LONGINT, W16 (r.imm) MOD 256) ;
+         r.chr := TRUE
+      ELSE
+         LoadAtom (r) ;
+         r.kind := 2 ;
+         r.chr := FALSE
+      END ;
+      r.cls := TChar ;
+      r.sz := 1 ;
+      RETURN
    ELSIF (symtab [idx].tag = KVar) OR (symtab [idx].tag = KType) THEN
       (* ParseVar initialises boff to 0 and then ParseSub folds any constant
          subscript into it.  Do NOT reset boff here: doing so after ParseVar
@@ -5717,6 +5874,9 @@ BEGIN
          Err (ETypeErr) ;
          RETURN
       END ;
+      IF src.kind = 9 THEN
+         MaterializeDyn (src, r.setbase, r.setsize)
+      END ;
       IF r.kind = 1 THEN
          EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
       ELSIF r.kind # 5 THEN
@@ -5735,17 +5895,16 @@ BEGIN
       RETURN
    END ;
    IF (r.kind = 5) AND (r.cls = TString) THEN
-      (* A string field of a DI-addressed record element (CALC's
-         `with Sheet[I,J] do Contents := ''').  DI is the field's address.
-         A literal's bytes are known: store <len><chars>, truncated to the
-         field's capacity (size-1).  A string VARIABLE source uses strstore,
-         with DI pushed as the destination. *)
+      (* A string field of a DI-addressed record element.  DI is the field's
+         address; park it because the source expression may reuse DI. *)
+      EmPushDi () ;
       ParseExpr (src) ;
       IF NOT OK () THEN
          RETURN
       END ;
       n := VarSize (r) - 1 ;              (* usable characters *)
       IF src.kind = 3 THEN
+         EmPopDi () ;
          IF strLen [src.strx] < n THEN
             n := strLen [src.strx]
          END ;
@@ -5757,10 +5916,20 @@ BEGIN
          END
       ELSIF src.kind = 1 THEN
          EmPushSymAddr (src.idx, (symtab [src.idx].off + src.boff) MOD 10000H) ;
-         EmPushDi () ;                    (* destination = the field *)
+         EmPopDi () ;                    (* destination = the field *)
+         EmPushDi () ;
          EmMovCxi (n) ;                   (* strstore's limit *)
          DropC (EmCall (TU_StrStore)) ;
          EmAddSp (4)
+      ELSIF src.kind = 5 THEN
+         EmPushDi () ;                    (* source field address *)
+         EmPopSi () ;
+         EmPopDi () ;                    (* destination field address *)
+         EmPushSi () ;                     (* source address *)
+         EmPushDi () ;
+         EmMovCxi (n) ;
+         DropC (EmCall (TU_StrStore)) ;
+         EmAddSp (4)
       ELSE
          Err (ENoLib)
       END ;
@@ -6285,11 +6454,27 @@ BEGIN
       END ;
       ParseExpr (arg) ;
       IF OK () AND (arg.cls = TScalar) THEN
-         (* Str(integer, S): no width formatting here; TP3's default width is
-            zero, and CALC uses `Str(count,st)`.  A colon would ask for a field
-            width, which is a separate increment. *)
          IF MatchDelim (':') THEN
-            Err (ENoLib) ;
+            ParseExpr (errV) ;
+            IF NOT OK () THEN
+               RETURN
+            END ;
+            LoadAtom (arg) ; EmPushAx () ;
+            LoadAtom (errV) ; EmPushAx () ;
+            IF NOT MatchDelim (',') THEN
+               Err (ENoSemi) ;
+               RETURN
+            END ;
+            ParseExpr (dummy) ;
+            IF OK () AND (dummy.cls = TString) AND
+               ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
+               EmPushStrAddr (dummy) ;
+               DropC (EmCall (TU_IntFmtW)) ;
+               EmAddSp (6)
+            ELSIF OK () THEN
+               Err (ETypeErr)
+            END ;
+            ExpectDelim (')', ENoSemi) ;
             RETURN
          END ;
          LoadAtom (arg) ;
@@ -6368,6 +6553,30 @@ BEGIN
       ExpectDelim (')', ENoSemi) ;
       RETURN
    END ;
+   IF which = BI_GetDir THEN
+      IF MatchDelim ('(') THEN
+         ParseExpr (arg) ;
+         IF OK () AND ((arg.cls = TScalar) OR (arg.cls = TChar)) THEN
+            LoadAtom (arg) ;
+            EmPushAx () ;                  (* drive *)
+            ExpectDelim (',', ENoSemi) ;
+            ParseExpr (dummy) ;
+            IF OK () AND (dummy.cls = TString) AND (dummy.kind = 1) THEN
+               EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
+               DropC (EmCall (TU_GetDir)) ;
+               EmAddSp (4)
+            ELSIF OK () THEN
+               Err (ETypeErr)
+            END
+         ELSIF OK () THEN
+            Err (ETypeErr)
+         END ;
+         ExpectDelim (')', ENoSemi)
+      ELSE
+         Err (ENoSemi)
+      END ;
+      RETURN
+   END ;
    IF (which = BI_Msdos) OR (which = BI_Intr) THEN
       IF MatchDelim ('(') THEN
          IF which = BI_Intr THEN
@@ -6496,47 +6705,78 @@ BEGIN
                   END ;
                   skipArg := TRUE
                ELSIF reading THEN
-                  (* Readln(F, S): read one line from a text file into the
-                     counted string S.  The runtime takes the file block,
-                     destination and capacity; it consumes CR and terminates
-                     on LF/^Z/physical EOF. *)
+                  (* Text-file reads.  A number is read as a whitespace-
+                     delimited token and handed to ValInt/ValReal; a string
+                     still uses the line reader.  Readln consumes the rest
+                     of the line after all numeric arguments. *)
                   IF NOT MatchDelim (',') THEN
                      Err (ENoSemi) ;
                      RETURN
                   END ;
-                  ParseExpr (dummy) ;
-                  IF OK () AND (dummy.cls = TString) AND
-                     ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
-                     EmMovAxi ((VarSize (dummy) - 1) MOD 10000H) ;
-                     EmPushAx () ;
-                     EmPushStrAddr (dummy) ;
-                     EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
-                     DropC (EmCall (TU_FileReadln)) ;
-                     EmAddSp (6)
-                  ELSIF OK () AND IsCharArray (dummy) AND (dummy.kind = 1) THEN
-                     (* Readln(F, Place): file_readln writes a counted string;
-                        use a scratch, prefill the tail with spaces, then copy
-                        the fixed width over the CHAR array. *)
-                     scratch := NewScratchStr () ;
-                     k := 1 ;
-                     WHILE k <= VarSize (dummy) DO
-                        EmMovAxi (ORD (' ')) ;
-                        EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
-                        INC (k)
+                  LOOP
+                     ParseExpr (dummy) ;
+                     IF NOT OK () THEN
+                        RETURN
                      END ;
-                     EmMovAxi (VarSize (dummy)) ;
-                     EmPushAx () ;
-                     EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                     IF dummy.cls = TString THEN
+                        IF (dummy.kind = 1) OR (dummy.kind = 5) THEN
+                           EmMovAxi ((VarSize (dummy) - 1) MOD 10000H) ;
+                           EmPushAx () ;
+                           EmPushStrAddr (dummy) ;
+                           EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
+                           DropC (EmCall (TU_FileReadln)) ;
+                           EmAddSp (6)
+                        ELSE
+                           Err (ETypeErr) ;
+                           RETURN
+                        END
+                     ELSIF IsCharArray (dummy) AND (dummy.kind = 1) THEN
+                        scratch := NewScratchStr () ;
+                        k := 1 ;
+                        WHILE k <= VarSize (dummy) DO
+                           EmMovAxi (ORD (' ')) ;
+                           EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
+                           INC (k)
+                        END ;
+                        EmMovAxi (VarSize (dummy)) ;
+                        EmPushAx () ;
+                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                        EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
+                        DropC (EmCall (TU_FileReadln)) ;
+                        EmAddSp (6) ;
+                        EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
+                        EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
+                        EmMovCxi (VarSize (dummy)) ;
+                        DropC (EmCall (TU_MemCopy)) ;
+                        EmAddSp (4)
+                     ELSIF (dummy.kind = 1) AND
+                        ((dummy.cls = TScalar) OR (dummy.cls = TReal)) THEN
+                        scratch := NewScratchStr () ;
+                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                        EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
+                        DropC (EmCall (TU_FileRdtok)) ;
+                        EmAddSp (4) ;
+                        EmPushVarAddr (FALSE, symtab [tmpA].off) ;
+                        EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
+                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                        IF dummy.cls = TReal THEN
+                           DropC (EmCall (TU_ValReal))
+                        ELSE
+                           DropC (EmCall (TU_ValInt))
+                        END ;
+                        EmAddSp (6)
+                     ELSE
+                        Err (ETypeErr) ;
+                        RETURN
+                     END ;
+                     IF NOT MatchDelim (',') THEN
+                        EXIT
+                     END
+                  END ;
+                  IF which = BI_ReadLn THEN
                      EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
-                     DropC (EmCall (TU_FileReadln)) ;
-                     EmAddSp (6) ;
-                     EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
-                     EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
-                     EmMovCxi (VarSize (dummy)) ;
-                     DropC (EmCall (TU_MemCopy)) ;
-                     EmAddSp (4)
-                  ELSIF OK () THEN
-                     Err (ETypeErr)
+                     DropC (EmCall (TU_FileRdln)) ;
+                     EmAddSp (2)
                   END ;
                   ExpectDelim (')', ENoSemi) ;
                   RETURN
@@ -6551,34 +6791,138 @@ BEGIN
                      RETURN
                   END ;
                   IF MatchDelim (',') THEN
-                     ParseExpr (dummy) ;
-                     IF NOT OK () THEN
-                        RETURN
-                     END ;
-                     IF dummy.cls = TString THEN
-                        IF dummy.kind = 1 THEN
+                     LOOP
+                        ParseExpr (dummy) ;
+                        IF NOT OK () THEN
+                           RETURN
+                        END ;
+                        IF dummy.cls = TString THEN
+                           IF MatchDelim (':') THEN
+                              ParseExpr (errV) ;
+                              IF NOT OK () THEN
+                                 RETURN
+                              END ;
+                              LoadAtom (errV) ;
+                              EmPushAx () ;          (* width *)
+                              EmPushStrAddr (dummy) ; (* source *)
+                              scratch := NewScratchStr () ;
+                              EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                              DropC (EmCall (TU_StrFmtW)) ;
+                              EmAddSp (6) ;
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 1, FALSE,
+                                        symtab [scratch].off, 0, TRUE)
+                           ELSIF dummy.kind = 1 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 1,
+                                        symtab [dummy.idx].local,
+                                        (symtab [dummy.idx].off + dummy.boff)
+                                           MOD 10000H,
+                                        0, TRUE)
+                           ELSIF dummy.kind = 5 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 5, FALSE,
+                                        0, 0, TRUE)
+                           ELSIF dummy.kind = 3 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 4, FALSE,
+                                        EmStrBlob (dummy), 0, TRUE)
+                           ELSE
+                              Err (ENoLib) ;
+                              RETURN
+                           END
+                        ELSIF (dummy.cls = TChar) OR
+                           ((dummy.cls = TScalar) AND dummy.chr) THEN
+                           IF dummy.kind = 1 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 1,
+                                        symtab [dummy.idx].local,
+                                        (symtab [dummy.idx].off + dummy.boff)
+                                           MOD 10000H,
+                                        1, FALSE)
+                           ELSIF dummy.kind = 5 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 5, FALSE,
+                                        0, 1, FALSE)
+                           ELSIF dummy.kind = 2 THEN
+                              EmStoreVar (FALSE, symtab [tmpA].off, 1) ;
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 1, FALSE,
+                                        symtab [tmpA].off, 1, FALSE)
+                           ELSIF dummy.kind = 0 THEN
+                              EmFileIo (FALSE, symtab [arg.idx].local,
+                                        symtab [arg.idx].off, 4, FALSE,
+                                        EmInlineCh (VAL (CARDINAL, dummy.imm)),
+                                        0, TRUE)
+                           ELSE
+                              Err (ENoLib) ;
+                              RETURN
+                           END
+                        ELSIF dummy.cls = TReal THEN
+                           EmPushRealAddr (dummy) ;
+                           IF MatchDelim (':') THEN
+                              ParseExpr (errV) ;
+                              IF OK () THEN LoadAtom (errV) END ;
+                              IF MatchDelim (':') THEN
+                                 EmPushAx () ;
+                                 ParseExpr (errV) ;
+                                 IF OK () THEN
+                                    LoadAtom (errV) ;
+                                    EmMovChAl () ;
+                                    EmPopAx () ;
+                                    EmMovClAl ()
+                                 END
+                              ELSIF OK () THEN
+                                 EmMovClAl () ;
+                                 EmMovChImm (0FFH)
+                              END
+                           ELSE
+                              EmMovCxi (0FF12H)
+                           END ;
+                           EmMovAxCx () ;
+                           EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
+                           scratch := NewScratchStr () ;
+                           EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                           EmPopAx () ;
+                           EmPopBx () ;
+                           EmPushAx () ;
+                           EmPushBx () ;
+                           EmLoadVar (FALSE, symtab [tmpA].off, 2) ;
+                           EmXchgAxCx () ;
+                           DropC (EmCall (TU_RealFmt)) ;
+                           EmAddSp (4) ;
                            EmFileIo (FALSE, symtab [arg.idx].local,
-                                     symtab [arg.idx].off, 1,
-                                     symtab [dummy.idx].local,
-                                     (symtab [dummy.idx].off + dummy.boff)
-                                        MOD 10000H,
-                                     0, TRUE)
-                        ELSIF dummy.kind = 3 THEN
+                                     symtab [arg.idx].off, 1, FALSE,
+                                     symtab [scratch].off, 0, TRUE)
+                        ELSIF dummy.cls = TScalar THEN
+                           (* integer with the optional TP3 `:width' *)
+                           LoadAtom (dummy) ;
+                           EmPushAx () ;
+                           IF MatchDelim (':') THEN
+                              ParseExpr (errV) ;
+                              IF NOT OK () THEN
+                                 RETURN
+                              END ;
+                              LoadAtom (errV) ;
+                              EmPushAx ()
+                           ELSE
+                              EmMovAxi (0) ;
+                              EmPushAx ()
+                           END ;
+                           scratch := NewScratchStr () ;
+                           EmPushVarAddr (FALSE, symtab [scratch].off) ;
+                           DropC (EmCall (TU_IntFmtW)) ;
+                           EmAddSp (6) ;
                            EmFileIo (FALSE, symtab [arg.idx].local,
-                                     symtab [arg.idx].off, 4, FALSE,
-                                     EmStrBlob (dummy), 0, TRUE)
+                                     symtab [arg.idx].off, 1, FALSE,
+                                     symtab [scratch].off, 0, TRUE)
                         ELSE
                            Err (ENoLib) ;
                            RETURN
+                        END ;
+                        IF NOT MatchDelim (',') THEN
+                           EXIT
                         END
-                     ELSIF (dummy.cls = TScalar) AND dummy.chr THEN
-                        EmFileIo (FALSE, symtab [arg.idx].local,
-                                  symtab [arg.idx].off, 4, FALSE,
-                                  EmInlineCh (VAL (CARDINAL, dummy.imm)),
-                                  0, TRUE)
-                     ELSE
-                        Err (ENoLib) ;
-                        RETURN
                      END
                   END ;
                   IF which = BI_WriteLn THEN
@@ -9019,6 +9363,12 @@ BEGIN
    symtab [i].defnd := TRUE ;
    i := NewSym ("INTR", KBuiltin, BI_Intr, 0, 0, 0, 0, FALSE) ;
    symtab [i].defnd := TRUE ;
+   i := NewSym ("GETDIR", KBuiltin, BI_GetDir, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   i := NewSym ("SEG", KBuiltin, BI_Seg, 0, 0, 0, 0, FALSE) ;
+   symtab [i].defnd := TRUE ;
+   i := NewSym ("OFS", KBuiltin, BI_Ofs, 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 ;
@@ -9184,6 +9534,15 @@ BEGIN
    DropC (NewSym ("STRING" , KType, TString, 256, 1, 0, 0, FALSE)) ;
    DropC (NewSym ("TRUE"   , KConst, TBool, 1, 1, 0, 1, FALSE)) ;
    DropC (NewSym ("FALSE"  , KConst, TBool, 1, 1, 0, 0, FALSE)) ;
+   (* TP3's absolute byte array `Mem[address]'.  The base is chosen so the
+      normal LoadBias addition lands on absolute offset zero. *)
+   arrs [0].n := 1 ; arrs [0].elem := 1 ; arrs [0].ecls := TScalar ;
+   arrs [0].lo [0] := 0 ; arrs [0].hi [0] := 65535 ;
+   arrs [0].fldFirst := 0 ; arrs [0].fldLast := 0 ; arrs [0].elemType := 0 ;
+   i := NewSym ("MEM", KVar, TArray, 65535, 1,
+                W16 (-VAL (LONGINT, LoadBias)), 0, FALSE) ;
+   symtab [i].arrIdx := 1 ;
+   arrTop := 1 ;
    DefBuiltins () ;
    tmpA := NewSym ("@@T1", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
    dc := dc + 2 ;
@@ -9227,6 +9586,7 @@ BEGIN
    TU_MemCopy  := RT_Entry (59) ;
    TU_RealToInt := RT_Entry (60) ;
    TU_Msdos    := RT_Entry (61) ;
+   TU_GetDir   := RT_Entry (64) ;
    TU_WrReal   := RT_Entry (6) ;
    TU_RealWrite := RT_Entry (30) ;     (* fmtreal + padding + output *)
    TU_RealFmt   := RT_Entry (28) ;     (* fmtreal into a string variable *)
@@ -9248,6 +9608,7 @@ BEGIN
    TU_SetOp    := RT_Entry (31) ;
    TU_SetCmp   := RT_Entry (32) ;
    TU_SetCopy  := RT_Entry (33) ;
+   TU_SetSingle := RT_Entry (67) ;
    TU_FileAssign  := RT_Entry (34) ;
    TU_FileReset   := RT_Entry (35) ;
    TU_FileRewrite := RT_Entry (36) ;
@@ -9257,7 +9618,11 @@ BEGIN
    TU_HeapNew     := RT_Entry (40) ;
    TU_FileEof     := RT_Entry (41) ;
    TU_FileReadln  := RT_Entry (42) ;
+   TU_FileRdtok   := RT_Entry (65) ;
+   TU_FileRdln    := RT_Entry (66) ;
    TU_IntFmt      := RT_Entry (43) ;
+   TU_IntFmtW     := RT_Entry (62) ;
+   TU_StrFmtW     := RT_Entry (63) ;
    TU_ValInt      := RT_Entry (44) ;
    TU_StrCopy     := RT_Entry (45) ;
    TU_ValReal     := RT_Entry (46) ;

shell/Runtime.mod

@@ -195,7 +195,7 @@ VAR
    dataAt : CARDINAL ;
    rtBase : CARDINAL ;
    built  : BOOLEAN ;
-   entNm  : ARRAY [0..63] OF ARRAY [0..MaxNm] OF CHAR ;
+   entNm  : ARRAY [0..127] OF ARRAY [0..MaxNm] OF CHAR ;
 
 (* ---------------------------------------------------------------- *)
 (*  name helpers                                                     *)
@@ -3867,6 +3867,58 @@ BEGIN
    PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
    MovSpBp ; PopBp ; RetR ;
 
+   (* Text-file token reader.  frt_get is an internal subroutine: SI must
+      point at the file block; it returns the next byte in AL, using the
+      one-word console pushback slot as a file pushback. *)
+   M ("frt_get") ;
+   LdBxVx (D_PUSH) ;
+   CmpBx0 ; Je8 ("frt_read") ;
+   MovAlBl ; MovDhAl ;
+   MovBxVx (D_PUSH) ; XorAxAx ; StBxAl ; IncBx ; StBxAl ;
+   MovAlDh ; RetR ;
+   M ("frt_read") ;
+   MovSiBp4 ; LdAxSi ; B (89H) ; B (0C3H) ;
+   MovDxVx (D_TXCH) ; MovCxImm (1) ; MovAh (3FH) ; Int21 ;
+   CmpAx0 ; Je8 ("frt_eof") ;
+   LdAlData (D_TXCH) ; RetR ;
+   M ("frt_eof") ; MovAlD (1AH) ; RetR ;
+
+   (* FileRdtok: [BP+4]=file block, [BP+6]=destination counted string. *)
+   M ("file_rdtok") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovDiBp6 ; B (0C6H) ; B (05H) ; B (0) ; IncDi ;
+   StDataImm (D_ITMP, 0) ;
+   M ("frt_skip") ;
+   C8 ("frt_get") ;
+   CmpAl (20H) ; Ja8 ("frt_store") ;
+   CmpAl (1AH) ; Je8 ("frt_done") ;
+   Jmp8 ("frt_skip") ;
+   M ("frt_store") ;
+   MovDlAl ;
+   MovAxData (D_ITMP) ; CmpAxImm (255) ; Jae8 ("frt_done") ;
+   MovAlDl ; StDiAl ; IncDi ;
+   MovAxData (D_ITMP) ; IncAx ; StDataAx (D_ITMP) ;
+   C8 ("frt_get") ;
+   CmpAl (1AH) ; Je8 ("frt_done") ;
+   CmpAl (20H) ; Ja8 ("frt_store") ;
+   MovDhAl ; MovBxVx (D_PUSH) ; MovAlDh ; StBxAl ; IncBx ; MovAlD (1) ; StBxAl ;
+   M ("frt_done") ;
+   MovBxBp6 ; MovAxData (D_ITMP) ; StBxAl ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
+   MovSpBp ; PopBp ; RetR ;
+
+   (* FileRdln: discard the rest of the current text-file line. *)
+   M ("file_rdln") ;
+   PushBp ; MovBpSp ; PushAx ;
+   M ("frd_loop") ;
+   C8 ("frt_get") ;
+   CmpAl (0AH) ; Je8 ("frd_done") ;
+   CmpAl (1AH) ; Je8 ("frd_done") ;
+   Jmp8 ("frd_loop") ;
+   M ("frd_done") ;
+   PopAx ; MovSpBp ; PopBp ; RetR ;
+
    (* IntFmt: decimal integer -> counted string, for Str(integer, S).
       [BP+4]=dest, [BP+6]=value.  D_TXCH carries the sign flag. *)
    M ("int_fmt") ;
@@ -3912,6 +3964,121 @@ BEGIN
    PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
    MovSpBp ; PopBp ; RetR ;
 
+   (* IntFmtW: decimal integer -> counted string, left-padded to width.
+      [BP+4]=dest, [BP+6]=width, [BP+8]=value.  Reuse int_fmt, then shift
+      the digits right by (width-length) and fill the gap with spaces. *)
+   M ("int_fmtw") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovAxBp8 ; PushAx ;                (* value *)
+   MovAxBp4 ; PushAx ;                (* dest *)
+   C8 ("int_fmt") ;
+   AddSp2 ; AddSp2 ;                  (* caller-pops: value and dest *)
+   MovDiBp4 ;
+   LdAlDi ; XorAhAh ; MovCxAx ;        (* CX := current length *)
+   MovDxBp6 ; MovAxDx ;                (* AX := width *)
+   CmpAxCx ; Jbe8 ("ifw_done") ;
+   SubAxCx ;                            (* AX := pad *)
+   StDataAx (D_FMTPAD) ;
+   MovSiDi ; MovAxCx ; AddSiAx ;       (* SI := dest + length *)
+   MovDiSi ; MovAxData (D_FMTPAD) ; AddDiAx ;  (* DI := dest + length + pad *)
+   Jcxz8 ("ifw_fill") ;
+   M ("ifw_shift") ;
+   LdAlSi ; StDiAl ; DecSi ; DecDi ; Loop8 ("ifw_shift") ;
+   M ("ifw_fill") ;
+   MovDiBp4 ; IncDi ;
+   MovAxData (D_FMTPAD) ; MovCxAx ;
+   Jcxz8 ("ifw_len") ;
+   M ("ifw_pad") ;
+   MovAlD (ORD (' ')) ; StDiAl ; IncDi ; Loop8 ("ifw_pad") ;
+   M ("ifw_len") ;
+   MovBxBp4 ; MovAxBp6 ; StBxAl ;      (* dest[0] := width *)
+   M ("ifw_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
+   MovSpBp ; PopBp ; RetR ;
+
+   (* StrFmtW: copy a counted string into a fixed-width counted field.
+      [BP+4]=dest, [BP+6]=source, [BP+8]=width.  The destination is
+      space-padded on the right to width and truncated if the source is
+      longer. *)
+   M ("str_fmtw") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovDiBp4 ;
+   MovAxBp8 ;
+   CmpAxImm (255) ; Jbe8 ("sfw_w") ;
+   MovAxImm (255) ;
+   M ("sfw_w") ;
+   MovDxAx ;                         (* DX := width *)
+   StDiAl ; IncDi ;                  (* dest[0] := width *)
+   MovCxAx ;                         (* CX := width for the space fill *)
+   Jcxz8 ("sfw_copy") ;
+   M ("sfw_pad") ;
+   MovAlD (ORD (' ')) ; StDiAl ; IncDi ; Loop8 ("sfw_pad") ;
+   M ("sfw_copy") ;
+   MovDiBp4 ; IncDi ;                  (* back to the first field byte *)
+   MovSiBp6 ; LdAlSi ; XorAhAh ; MovCxAx ; IncSi ;  (* CX := source len *)
+   CmpCxDx ; Jbe8 ("sfw_count") ;
+   MovCxDx ;                         (* truncate to width *)
+   M ("sfw_count") ;
+   Jcxz8 ("sfw_done") ;
+   M ("sfw_loop") ;
+   LdAlSi ; StDiAl ; IncSi ; IncDi ; Loop8 ("sfw_loop") ;
+   M ("sfw_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
+   MovSpBp ; PopBp ; RetR ;
+
+   (* GetDir: [BP+4]=counted destination string, [BP+6]=DOS drive (1=A).
+      INT 21h AH=47h returns an ASCIIZ current directory; copy it into the
+      counted string.  A failure leaves the destination empty. *)
+   M ("getdir") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovDxVx (D_VALBUF) ;
+   B (8AH) ; B (56H) ; B (6) ;         (* MOV DL,[BP+6] *)
+   MovAxImm (4700H) ; Int21 ;
+   Jb8 ("gd_err") ;
+   MovDiBp4 ;
+   MovBxDataAddr (D_VALBUF) ; MovSiBx ;
+   IncDi ;
+   XorCxCx ;
+   M ("gd_copy") ;
+   LdAlSi ; CmpAl0 ; Je8 ("gd_end") ;
+   StDiAl ; IncSi ; IncDi ; IncCx ;
+   MovAxCx ; CmpAxImm (255) ; Jae8 ("gd_end") ;
+   Jmp8 ("gd_copy") ;
+   M ("gd_end") ;
+   MovBxBp4 ; MovDlCl ; B (88H) ; B (17H) ;  (* dest[0] := count *)
+   Jmp8 ("gd_done") ;
+   M ("gd_err") ;
+   MovBxBp4 ; B (0C6H) ; B (07H) ; B (0) ;  (* dest[0] := 0 *)
+   M ("gd_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
+   MovSpBp ; PopBp ; RetR ;
+
+   (* SetSingle: [BP+4]=dest set, [BP+6]=element, [BP+8]=base,
+      [BP+10]=size.  Zero the destination and set one bit. *)
+   M ("set_single") ;
+   PushBp ; MovBpSp ;
+   PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovDiBp4 ; MovBxBp10 ; B (8BH) ; B (0CBH) ;  (* CX := size *)
+   MovAxBp8 ; MovDxAx ;              (* DX := base *)
+   Jcxz8 ("ssg_done") ;
+   M ("ssg_zero") ;
+   B (0C6H) ; B (05H) ; B (0) ; IncDi ; Loop8 ("ssg_zero") ;
+   MovDiBp4 ;
+   MovAxBp6 ; SubAxDx ;            (* AX := element - base *)
+   B (89H) ; B (0C3H) ;             (* BX := index *)
+   MovCxAx ;
+   MovClAl ; AndClImm (7) ;         (* CL := bit number *)
+   MovDl (1) ; B (0D2H) ; B (0E2H) ;  (* SHL DL,CL: DL := 1 << bit *)
+   MovAxBx ; B (0D1H) ; B (0E8H) ; B (0D1H) ; B (0E8H) ; B (0D1H) ; B (0E8H) ;
+   MovBxBp10 ; B (8BH) ; B (0CBH) ; CmpAxCx ; Jae8 ("ssg_done") ;
+   MovDiBp4 ; AddDiAx ; MovAlDl ; StDiAl ;
+   M ("ssg_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ;
+   MovSpBp ; PopBp ; RetR ;
+
    (* Val integer: [BP+4]=counted string, [BP+6]=dest integer,
       [BP+8]=error position.  Code is 1-based and 0 on success; on error the
       destination is left unchanged, matching TPSRC2's valerr path. *)
@@ -4381,6 +4548,12 @@ BEGIN
    SetStr (entNm [59], "memcopy") ;
    SetStr (entNm [60], "real_to_int") ;
    SetStr (entNm [61], "msdos") ;
+   SetStr (entNm [62], "int_fmtw") ;
+   SetStr (entNm [63], "str_fmtw") ;
+   SetStr (entNm [64], "getdir") ;
+   SetStr (entNm [65], "file_rdtok") ;
+   SetStr (entNm [66], "file_rdln") ;
+   SetStr (entNm [67], "set_single") ;
    built := TRUE
 END RT_Build ;
 
@@ -4408,7 +4581,7 @@ BEGIN
    IF NOT built THEN
       RT_Build (0)
    END ;
-   IF i > 61 THEN
+   IF i > 67 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..61] OF ARRAY [0..15] OF CHAR ;
+    names : ARRAY [0..67] 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 <= 61 DO
+   WHILE i <= 67 DO
       names [i] := "" ;
       INC (i)
    END ;
@@ -174,8 +174,14 @@ BEGIN
    names [59] := "memcopy" ;
    names [60] := "real_to_int" ;
    names [61] := "msdos" ;
+   names [62] := "int_fmtw" ;
+   names [63] := "str_fmtw" ;
+   names [64] := "getdir" ;
+   names [65] := "file_rdtok" ;
+   names [66] := "file_rdln" ;
+   names [67] := "set_single" ;
    i := 0 ;
-   WHILE i <= 61 DO
+   WHILE i <= 67 DO
       PENT (i, names [i]) ;
       INC (i)
    END ;

shell/tests/audit_helpers.py

@@ -398,6 +398,8 @@ PATTERNS = [
     #     divides DX:AX, so the decode has an AX the name has no room for
     (re.compile(r"^Mul(%s)$" % _ALT),   "mul",    ["r:%(1)s"], {0xF7}),
     (re.compile(r"^Div(%s)$" % _ALT),   "div",    ["r:Ax", "r:%(1)s"], {0xF7}),
+    (re.compile(r"^MovAxDs$"), "mov", ["r:Ax", "r:Ds"], {0x8C}),
+
     # --- store: name is St<base><reg>, decode puts the register last --
     (re.compile(r"^St(%s)(%s)$" % (_BASE, _ALT)),
      "mov", ["m:%(1)s", "r:%(2)s"], _STORE),

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	27488	19694
+CALC.PAS	OK	27519	19694

shell/tests/fixtures/expected.tsv

@@ -599,7 +599,7 @@ t78_setfield	OK	279	23
 #                   <len><chars> truncated to the field, a string-variable
 #                   source via strstore, and a short literal length (not the
 #                   capacity).  Also pins the field offset in writeln.
-t79_strfield	OK	361	80
+t79_strfield	OK	363	80
 #   t80_realconst          a REAL field assigned integer constants: the
 #                   measured 6-byte MBF layout, symbol and DI stores, a
 #                   6-byte copy; the integer fields on either side pin the
@@ -668,12 +668,12 @@ t92_strreal	OK	247	36
 #                   bump heap; Dispose is a no-op (CALC allocates once at the
 #                   start of Help and disposes after it).  The .out is derived
 #                   from the two assigned strings and the comparison.
-t93_pointer	OK	196	15
+t93_pointer	OK	200	15
 
 #   t94_textread         text Eof/Readln into a pointer-indexed string, then
 #                   read a string element back.  Compile-only: no filesystem in
 #                   either harness.
-t94_textread	OK	206	147
+t94_textread	OK	217	147
 
 #   t95_strint           Str(integer, S) via int_fmt: positive, negative and
 #                   zero, all into a string[10].
@@ -780,3 +780,5 @@ t134_shifts	OK	95	9
 t135_intrealassign	OK	114	19
 
 t136_variant	OK	53	8
+
+t137_dynset	OK	236	20

shell/tests/fixtures/t137_dynset.out

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

shell/tests/fixtures/t137_dynset.pas

@@ -0,0 +1,10 @@
+program dynset;
+type S = set of 'a'..'z';
+var X : S;
+    C : char;
+begin
+  C := 'q';
+  X := [];
+  X := X + [C];
+  if C in X then writeln('yes') else writeln('no')
+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", "memcopy", "real_to_int", "msdos"]
+        "wrcharw", "wrboolw", "wrstrw", "memcopy", "real_to_int", "msdos", "int_fmtw", "str_fmtw", "getdir", "file_rdtok", "file_rdln", "set_single"]
 
 # A call slot's flags, as rtdrv.s reads them.
 F_STACK = 1     # the argument goes on the stack, popped by the caller
@@ -930,6 +930,15 @@ def build_cases():
         dump=2, dumpbytes=struct.pack("<h", 42), dumpadr=AXOUT,
         note="the same value, rounding mode")
 
+    add("int_fmtw(42,5)",
+        [s3("int_fmtw", STORE + LOAD_BIAS, 5, 42)],
+        dump=6, dumpbytes=bytes([5]) + b"   42", dumpadr=STORE,
+        note="left-pad an integer field to the requested width")
+    add("str_fmtw(hello,8)",
+        [s3("str_fmtw", STORE + LOAD_BIAS, SST_HELLO + LOAD_BIAS, 8)],
+        dump=9, dumpbytes=bytes([8]) + b"hello   ", dumpadr=STORE,
+        note="right-pad a string field to the requested width")
+
     return cs