Browse Source

calc: CASE/ELSE semicolons and string-vs-CHAR comparisons (ladder 56540)

Allow an optional semicolon between the ELSE statement and the CASE's END;
CALC writes `else begin ... end; end`.  The non-ELSE arm path already tolerated
the same separator.

A CHAR operand in a string comparison (`S <> Chr($FF)`, `S <> 'x'`) is now
materialised as a one-character counted string and compared through cmpstr.
t50_strcmp_type is updated from the old rejection expectation to the accepted
behaviour.

t111_caseelse and t112_strchar execute under qemu and Exec86.  CALC now stops
at ERR 98 56540, the code-image ceiling.

Verified: compile matrix 113/113, ladder 1/1, 99 .COM executions under both
oracles, rt_exec 276/276, nonvacuity 121/121, run_all ALL PASS.
Eric Streit 3 days ago
parent
commit
9770e49641

+ 13 - 6
CALC-COMPILE.md

@@ -97,7 +97,7 @@ Current rung (measured today, normalised position):
 
 
 | position | blocker |
 | position | blocker |
 |---|---|
 |---|---|
-| **51322** | the `end;` closing `CASE ... ELSE ... END` in `GetLine` (`ERR 1`) |
+| **56540** | code-image ceiling — runtime + generated code reaches the `0x8000` data base (`ERR 98`) |
 
 
 Rungs behind it (now passed):
 Rungs behind it (now passed):
 
 
@@ -161,7 +161,9 @@ Rungs ahead:
 | 48461 | local `set of Char` variable - DONE |
 | 48461 | local `set of Char` variable - DONE |
 | 48574 | code-image ceiling - DONE (runtime shrunk) |
 | 48574 | code-image ceiling - DONE (runtime shrunk) |
 | 50744 | `Insert` string builtin - DONE |
 | 50744 | `Insert` string builtin - DONE |
-| 51322 | CASE/ELSE closing `end;` in `GetLine` (`ERR 1`) |
+| 51322 | CASE/ELSE closing `end;` - DONE |
+| 52316 | string vs CHAR comparison (`S <> Chr($FF)`) - DONE |
+| 56540 | code-image ceiling (`ERR 98`) |
 
 
 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:
@@ -600,6 +602,10 @@ Exec86):
 - **`Abs`, `Sqr` and `Sqrt` are landed (`t104_mathbasic`).**  `Abs` clears the
 - **`Abs`, `Sqr` and `Sqrt` are landed (`t104_mathbasic`).**  `Abs` clears the
   MBF sign, `Sqr` lowers to the real multiply entry, and `Sqrt` is Newton over
   MBF sign, `Sqr` lowers to the real multiply entry, and `Sqrt` is Newton over
   the existing real division/addition entries.
   the existing real division/addition entries.
+- **CASE/ELSE and string-vs-CHAR comparisons are landed.**  A semicolon before
+  the CASE's `END` is accepted (`t111_caseelse`), and `S <> Chr($FF)`/`S <> 'x'`
+  compares against a one-character counted scratch (`t112_strchar`).  The old
+  t50 rejection fixture is updated to the new accepted behaviour.
 - **`Insert(Source,Dest,Index)` is landed (`t110_insert`).**  A CHAR source is
 - **`Insert(Source,Dest,Index)` is landed (`t110_insert`).**  A CHAR source is
   materialised as a one-character counted string; string sources and index
   materialised as a one-character counted string; string sources and index
   clamping are covered.  The runtime shifts the tail and copies the source.
   clamping are covered.  The runtime shifts the tail and copies the source.
@@ -1250,10 +1256,11 @@ 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 blocker is the `end;` closing the `CASE ... ELSE ... END` in
-`GetLine` (error 1), not another string runtime entry.  The runtime is 9,373
-bytes; `rt_exec` is at HDR=0x4000 / data 0x5000, and the compiler's code ceiling
-is 0x8000.
+The next blocker is image capacity: runtime plus generated code reaches the
+`0x8000` data base.  The runtime is 9,373 bytes; `rt_exec` is at HDR=0x4000 /
+data 0x5000, and the compiler's code ceiling is 0x8000.  The next change must
+be a deliberate layout move (data base/code ceiling) or a further runtime
+reduction.
 
 
 **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),

+ 6 - 5
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 1` at pos 51322, the CASE/ELSE closing `end;`), the `{$I}` include,
+`ERR 98` at pos 56540, the code-image ceiling), 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`/
@@ -2069,10 +2069,11 @@ standard functions (`Abs`, `Sqr`, `Sqrt`, `Ln`, `Exp`, `Sin`, `Cos`,
 `Arctan`), `Int(REAL)` and forward definitions that repeat only the name are
 `Arctan`), `Int(REAL)` and forward definitions that repeat only the name are
 landed, along with `Delete` and local `set of Char` variables.  The math runtime
 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
 was compacted to guest Horner/square loops, reducing it from 14,063 to 9,203
-bytes.  `Insert` is also landed; the ladder now stops at the `end;` closing
-`CASE ... ELSE ... END` in `GetLine` (`ERR 1 51322`).  The runtime is 9,373
-bytes / 56 entries; the rt_exec scaffold is at HDR=0x4000 / data 0x5000.
-Items 1-4 below are independent of both tracks.
+bytes.  `Insert`, CASE/ELSE trailing semicolons and string-vs-CHAR comparisons
+are also landed; the ladder now stops at the code-image ceiling
+(`ERR 98 56540`).  The runtime is 9,373 bytes / 56 entries; the rt_exec
+scaffold is at HDR=0x4000 / data 0x5000.  Items 1-4 below are independent of
+both tracks.
 
 
 1. The rest of the string language. `v-TP3-STRVAR`/`v-TP3-STRREAD-ASSIGN` cover
 1. The rest of the string language. `v-TP3-STRVAR`/`v-TP3-STRREAD-ASSIGN` cover
    string variables, `s := 'literal'`, `writeln (s)`, `readln (s)`/`read (s)`
    string variables, `s := 'literal'`, `writeln (s)`, `readln (s)`/`read (s)`

+ 27 - 1
shell/Compiler.mod

@@ -3898,8 +3898,27 @@ BEGIN
             a comparison used as a VALUE (writeln(a = b)) is not one. *)
             a comparison used as a VALUE (writeln(a = b)) is not one. *)
          EmPushStrAddr (left) ;
          EmPushStrAddr (left) ;
          ParseAdd (right) ;
          ParseAdd (right) ;
+         IF (right.cls = TChar) OR ((right.cls = TScalar) AND right.chr) THEN
+            (* `S <> Chr($FF)' / `S <> 'x'': a CHAR is a one-character string.
+               Materialise it as a counted scratch so cmpstr sees the same
+               layout as every other string operand. *)
+            scratch := NewScratchStr () ;
+            IF right.kind = 0 THEN
+               EmMovAxi (W16 (right.imm)) ;
+               EmStoreVar (FALSE, (symtab [scratch].off + 1) MOD 10000H, 1) ;
+               EmMovAxi (1) ;
+               EmStoreVar (FALSE, symtab [scratch].off, 1)
+            ELSE
+               LoadAtom (right) ;
+               EmStoreVar (FALSE, (symtab [scratch].off + 1) MOD 10000H, 1) ;
+               EmMovAxi (1) ;
+               EmStoreVar (FALSE, symtab [scratch].off, 1)
+            END ;
+            right.kind := 1 ; right.idx := scratch ; right.cls := TString ;
+            right.sz := 256 ; right.boff := 0
+         END ;
          IF right.cls # TString THEN
          IF right.cls # TString THEN
-            Err (ETypeErr) ;         (* a string compared with a number/char *)
+            Err (ETypeErr) ;         (* a string compared with a number *)
             RETURN
             RETURN
          END ;
          END ;
          EmPushStrAddr (right) ;
          EmPushStrAddr (right) ;
@@ -6689,6 +6708,13 @@ BEGIN
       IF tok = TkElse THEN
       IF tok = TkElse THEN
          DropB (MatchKey (tok)) ;
          DropB (MatchKey (tok)) ;
          Statmnt () ;
          Statmnt () ;
+         (* A semicolon between the ELSE statement and the CASE's END is an
+            empty statement, and TP3/CALC writes it after a compound body:
+            `else begin ... end; end`.  The non-ELSE path already tolerates
+            the same separator at the top of the arm loop. *)
+         IF MatchDelim (';') THEN
+            Skip ()
+         END ;
          IF NOT (MatchKey (tok) AND (tok = TkEnd)) THEN
          IF NOT (MatchKey (tok) AND (tok = TkEnd)) THEN
             Err (ENoSemi)
             Err (ENoSemi)
          END
          END

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

@@ -25,7 +25,7 @@
 # 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): the `end;` closing the CASE/ELSE in GetLine.
+# Current rung (2026-10-23): the code image reaches the 0x8000 data boundary.
 # UpCase, run-time set membership, string fields through DI, the original memory
 # UpCase, run-time set membership, string fields through DI, the original memory
 # layout, untyped-file declarations, file control-block operations, VAR string
 # layout, untyped-file declarations, file control-block operations, VAR string
 # parameters, Chr, typed-file block I/O, text-file output, Str,
 # parameters, Chr, typed-file block I/O, text-file output, Str,
@@ -34,7 +34,7 @@
 # self-recursion, enum-indexed arrays, string-array typed constants, local REAL
 # self-recursion, enum-indexed arrays, string-array typed constants, local REAL
 # variables, Copy, real Val, Abs/Sqr/Sqrt, Ln/Exp/Sin/Cos/Arctan, Int(REAL),
 # variables, Copy, real Val, Abs/Sqr/Sqrt, Ln/Exp/Sin/Cos/Arctan, Int(REAL),
 # forward definitions, Delete, local set of Char variables, the compact
 # forward definitions, Delete, local set of Char variables, the compact
-# Horner/square runtime and Insert moved the ladder 15911 -> ... -> 50744 ->
-# 51322.  The next blocker is the CASE/ELSE closing `end;` in GetLine (TP3
-# error 1).
-CALC.PAS	ERR	1	51322
+# Horner/square runtime, Insert, CASE/ELSE trailing semicolons and
+# string-vs-CHAR comparisons moved the ladder 15911 -> ... -> 51322 -> 56540.
+# The next blocker is the image layout/code ceiling (TP3 error 98).
+CALC.PAS	ERR	98	56540

+ 5 - 1
shell/tests/fixtures/expected.tsv

@@ -383,7 +383,7 @@ t49_strcmp_lit	OK	1011	16
 #                   does NOT: the zero-length string is a string, which is why
 #                   does NOT: the zero-length string is a string, which is why
 #                   t49 may compare against it.)  Pins the new mixed-operand
 #                   t49 may compare against it.)  Pins the new mixed-operand
 #                   guard; ETypeErr at the comparison.
 #                   guard; ETypeErr at the comparison.
-t50_strcmp_type	ERR	56	600
+t50_strcmp_type	OK	111	270
 #   t51_strcat             string concatenation, `a + b', where its result can
 #   t51_strcat             string concatenation, `a + b', where its result can
 #                   go: a writeln argument, an assignment source, and then an
 #                   go: a writeln argument, an assignment source, and then an
 #                   operand again.  The pairings are var+var, literal+var,
 #                   operand again.  The pairings are var+var, literal+var,
@@ -728,3 +728,7 @@ t109_localset	OK	322	5
 
 
 #   t110_insert           Insert(Source,Dest,Index): char/string, clamping.
 #   t110_insert           Insert(Source,Dest,Index): char/string, clamping.
 t110_insert	OK	405	1051
 t110_insert	OK	405	1051
+
+t111_caseelse	OK	93	7
+
+t112_strchar	OK	230	784

+ 2 - 0
shell/tests/fixtures/t111_caseelse.out

@@ -0,0 +1,2 @@
+other
+done

+ 11 - 0
shell/tests/fixtures/t111_caseelse.pas

@@ -0,0 +1,11 @@
+program ce;
+var X:integer;
+begin
+ X:=2;
+ case X of
+  1: writeln('one');
+ else
+  begin writeln('other') end;
+ end;
+ writeln('done')
+end.

+ 3 - 0
shell/tests/fixtures/t112_strchar.out

@@ -0,0 +1,3 @@
+ne
+eq
+ne2

+ 9 - 0
shell/tests/fixtures/t112_strchar.pas

@@ -0,0 +1,9 @@
+program t112_strchar;
+var S:string[10];
+begin
+ S := 'abc';
+ if S <> Chr($FF) then writeln('ne');
+ S := Chr($FF);
+ if S = Chr($FF) then writeln('eq');
+ if S <> 'x' then writeln('ne2')
+end.

+ 5 - 7
shell/tests/fixtures/t50_strcmp_type.pas

@@ -1,11 +1,9 @@
-{ t50_strcmp_type: comparing a string with a CHAR is a type error.
+{ t50_strcmp_type: comparing a string with a CHAR is accepted.
 
 
-  A one-character literal is a CHAR constant in ISO Modula-2 - not a string -
-  so `s = 'a'` mixes TString with TScalar and must be rejected.  The empty
-  literal '' is different: it is the zero-length STRING, which is why t49 uses
-  it.  This pins ParseCmp's mixed-operand guard, which is new: before string
-  comparison existed, this program failed later and with the wrong diagnosis.
-  Expected: ETypeErr (56) at the comparison. }
+  A one-character literal is a CHAR constant in ISO Modula-2, but TP3's
+  string comparison treats it as a one-character string; CALC needs this for
+  `S <> Chr($FF)`.  The compiler materialises the CHAR as a counted scratch
+  and compares it with cmpstr.  This fixture used to pin the old rejection. }
 program t50_strcmp_type (input, output);
 program t50_strcmp_type (input, output);
 var
 var
    s : string[8];
    s : string[8];