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

compiler: string concatenation, a + b

TP3's addstr (TPSRC9 194) reaches xconcat (TPSRC2 963), which builds the result
in a scratch string: copy the left operand in, append the right.  This model
addresses strings by pointer (<len><chars>), so the result of a `+' is a
variable, and StrConcat gives it one: a fresh 256-byte global STRING (the @@SC
symbol, NewScratchStr) per `+' in the SOURCE, returned as kind 1.  Assignment,
IoCall and ParseCmp already handle kind 1, so no consumer needed a new arm.

Two calls per `+', both with strstore's argument order (dest [BP+4], src
[BP+6], CX = max):

    strstore (dest, left, 255)      (* selector 17, existing *)
    strcat   (dest, right, 255)     (* selector 19, new *)

strcat preserves AX,BX,CX,DX,SI,DI -- all six pushed -- because the compiler
may be holding a string element's address in DI across the call that pushes the
next operand.  Its overflow path is TP3's: a new length above CX branches to
concerr, which leaves through INT 21h AH=4Ch with AL=16 ("string too long");
that path is 6 bytes, so the short Jae8 fits.

The type rule, and the bug it exposed:

    IF StrOperand (left) OR StrOperand (right) THEN StrConcat (...)
    StrOperand(r) = r.cls = TString OR r.cls = TChar
                    OR (r.cls = TScalar AND r.chr)

The hook at the head of BinOpEmit used to test `cls = TString'.  Two CHARs are
not TString, so 'a' + 'b' fell through to the integer path and printed CHR(195)
-- a silently wrong program, not an error.  Testing StrOperand routes it into
StrConcat, whose guard rejects two CHARs (and a string with a number) with
ETypeErr 56.  t53_strcat_type pins it: RED before the hook change (it compiled
OK, code 42 / data 4), green after (ERR 56 at 663).

Making that error path reachable at once exposed a compiler SEGFAULT.
StrConcat's error path left a half-built res -- kind 2, cls TString, idx never
assigned -- and IoCall dereferences symtab[arg.idx] for ANY value whose class is
TString, so writeln ('a' + 'b') read an arbitrary symbol and died in the write
arm.  Two fixes, both using an idiom the project already had: StrConcat's
placeholder is now a well-formed NON-string (kind 0, cls TScalar, imm 0), and
IoCall checks `IF NOT OK () THEN RETURN' after ParseExpr, the same guard
ParseSub applies before symtab[r.idx].  With both, every nesting shape -- 'a' +
'b', ('a' + 'b') + s, ('a' + 'b') = s, s + (s = s), writeln ('a' + 'b', 'x') --
reports the first error and no longer crashes.

Runtime.mod: MaxLbl 64 -> 96, MaxFix 400 -> 512, and M/AddFix HALT when full.
They used to DROP when full, which produces a wrong-but-well-formed runtime
blob -- the worst shape a failure can have.  Both raised for strcat.

bootcom.s: the INT 21h AH=09h handler kept its cursor at 0702h, the first byte
of the loaded program image, so the CRLF it wrote corrupted the program's own
`call progend' (E8 1A -> FB 03) and the image jumped wild.  It now uses SI as
its cursor and ES:DI for the video store, which also removes the code-window
limit.  bootcom.s still assembles to 512 bytes.  This had to be fixed before
t51/t52/t55 would run at all.

Fixtures: t51_strcat (every operand pairing and consumer -- writeln,
assignment, var+var, literal+var, var+literal, var+char, char+var),
t52_strcat_nest (a + b + '!' with `+' left-associative, a concatenation
compared, and an s[i] element as a `+' operand), t53_strcat_type ('a' + 'b' ->
ERR 56 663), t54_strcat_strnum (s + 1 -> ERR 56 463), t55_strcat_overflow
(readln 128 characters, s := s + s asks for 256 -> exit 16).

Harness moves: run_com_exec.py now reads a .exit sidecar (decimal, default 0)
per fixture and asserts the exit code as well as the output -- the exit code
used to be a claim nobody checked, and t55 is the fixture that needs it.
runtime.golden re-blessed (data addresses move by +0x47 = strcat's 71 bytes,
plus the strcat block itself); RtProbe [0..19]; check_runtime
GOLDEN["strcat"] = its first 12 bytes; rt_exec SST_CAT/SST_CAT0/SST_WORLD plus
four strcat cases; check_8086 BRANCH_SITES/BRANCH_WHY for t52's one `if',
without which its branch went unchecked.  expected.tsv rows for t51..t55 are
re-baselined in the same commit as the change that needs them.

Data-size model behind those rows: data = 4 + the sum of the variable sizes +
256 per `+' + 2 per CHAR operand (the one-char <len><char> scratch).  t51 =
1842, t52 = 1574, t55 = 516 follow it exactly.

Gates: compile matrix 56/56, run_com_exec 48/48 (t55 exit 16 asserted), exec86
48/48, audit_helpers 112/112, rt_exec 56/56, check_8086 clause H 11/11, runtime
770 bytes / code 0..738 / 20 entries / 65 branches, nonvacuity 78 ok 0 failed,
OVERALL: ALL PASS.  tpshell clean build 196088 bytes.

Tag: v-TP3-STRCAT.
Eric Streit 12 часов назад
Родитель
Сommit
1bed3bbc1c

Разница между файлами не показана из-за своего большого размера
+ 0 - 0
SUMMARY.md


+ 18 - 10
TP3-COMPILER.md

@@ -74,7 +74,8 @@ whole-program pass 3 silently caps identifier/error counts — see
     `JMP` over `<len><chars>` -- `cmpstr` returns `AX = -1/0/+1`, and `EmOrAxAx`
     `JMP` over `<len><chars>` -- `cmpstr` returns `AX = -1/0/+1`, and `EmOrAxAx`
     plus the shared `EmRelSetcc` table turn the sign into a Boolean.  The
     plus the shared `EmRelSetcc` table turn the sign into a Boolean.  The
     relational `SETcc` table was factored out of `ParseCmp` so the numeric and
     relational `SETcc` table was factored out of `ParseCmp` so the numeric and
-    string paths cannot drift.  The runtime gained `EmitCmpStr` (selector 18).
+    string paths cannot drift.  The runtime gained `EmitCmpStr` (selector 18)
+    and then `EmitStrCat` (selector 19).
 
 
 The compiler's whole-program 8086-emit, TEXT-equivalent, pastres and
 The compiler's whole-program 8086-emit, TEXT-equivalent, pastres and
 errexit flow are otherwise unchanged (mirrors TP3 TPSRC file, ConvertTP3).
 errexit flow are otherwise unchanged (mirrors TP3 TPSRC file, ConvertTP3).
@@ -254,7 +255,8 @@ the constant-fold arm, because a string literal is not a kind-0 constant:
 
 
 `EmRelSetcc` is the same six-arm `SETcc` table the numeric arm uses, factored
 `EmRelSetcc` is the same six-arm `SETcc` table the numeric arm uses, factored
 out so the two cannot drift; `cmpstr` is runtime selector 18, 83 bytes
 out so the two cannot drift; `cmpstr` is runtime selector 18, 83 bytes
-(`0249h`..`029Bh`).  The runtime is now 699 bytes, code 0..667, 19 entries.
+(`0249h`..`029Bh`), and `strcat` is selector 19 at `029Ch`.  The runtime is now
+770 bytes, code 0..738, 20 entries.
 
 
 **Why the entry returns a value and not the flags.**  TP3's own `cmpstr`
 **Why the entry returns a value and not the flags.**  TP3's own `cmpstr`
 leaves the flags set -- its `MOV SP,BX` (TPSRC2 960) removes its own arguments,
 leaves the flags set -- its `MOV SP,BX` (TPSRC2 960) removes its own arguments,
@@ -342,7 +344,9 @@ an accident; `t38` (`readln (b)` of a `boolean`) → error 66, TP3's "I/O not
 allowed here", for the same reason; `t43_codewindow` emits more than the 4 KiB
 allowed here", for the same reason; `t43_codewindow` emits more than the 4 KiB
 between the runtime and the data base → error 98, "Memory overflow", rather
 between the runtime and the data base → error 98, "Memory overflow", rather
 than a silently corrupt image; `t50_strcmp_type` (`s = 'a'`, a `CHAR` against a
 than a silently corrupt image; `t50_strcmp_type` (`s = 'a'`, a `CHAR` against a
-string) → error 56, because a one-character literal is not a string; and
+string) → error 56, because a one-character literal is not a string;
+`t53_strcat_type` (`'a' + 'b'`, two CHARs and no string) and `t54_strcat_strnum`
+(`s + 1`, a string and a number) both → error 56 for the same reason; and
 `uierror` is a deliberate syntax error used by `uitest.py`.  (`t39_strvar` is the counter-example: a *string*
 `uierror` is a deliberate syntax error used by `uitest.py`.  (`t39_strvar` is the counter-example: a *string*
 variable, `s : string [10]`, assigned a literal and written -- the first
 variable, `s : string [10]`, assigned a literal and written -- the first
 declared type wider than a word that compiles, and run under both oracles.)
 declared type wider than a word that compiles, and run under both oracles.)
@@ -355,13 +359,15 @@ byte is a perfectly well-formed instruction that does something else, so no
 amount of inspecting the compiler's intent will catch it.  This harness closes
 amount of inspecting the compiler's intent will catch it.  This harness closes
 that gap the only way it can be closed -- by running the thing.
 that gap the only way it can be closed -- by running the thing.
 
 
-For each of 45 fixtures it compiles a `.COM`, writes a 1.44 MB floppy with the
+For each of 48 fixtures it compiles a `.COM`, writes a 1.44 MB floppy with the
 image in it, boots `qemu-system-i386 -fda disk.img -serial out.txt`, and
 image in it, boots `qemu-system-i386 -fda disk.img -serial out.txt`, and
 compares `out.txt` to the committed `tests/fixtures/tNN.out` **exactly** --
 compares `out.txt` to the committed `tests/fixtures/tNN.out` **exactly** --
-CRLF included -- plus the exit code the program hands to `INT 21h AH=4Ch`.
+CRLF included -- plus the exit code the program hands to `INT 21h AH=4Ch` (a
+fixture that expects a non-zero exit pins it in an `.exit` file next to its
+`.out`; `t55_strcat_overflow` is the first, expecting 16).
 
 
 ```
 ```
-cd shell && python3 tests/run_com_exec.py            # all 45
+cd shell && python3 tests/run_com_exec.py            # all 48
 cd shell && python3 tests/run_com_exec.py --show     # print the serial file
 cd shell && python3 tests/run_com_exec.py --show     # print the serial file
 cd shell && python3 tests/run_com_exec.py --rebless  # rewrite the .out files
 cd shell && python3 tests/run_com_exec.py --rebless  # rewrite the .out files
 ```
 ```
@@ -390,11 +396,13 @@ partial read or a wrong sector count would have been visible, this was not.
 window at `C000h`; and the copy is executed code, so it is the last thing
 window at `C000h`; and the copy is executed code, so it is the last thing
 that touches the image and no BIOS call follows it.
 that touches the image and no BIOS call follows it.
 
 
-**45 of 51 fixtures execute.**  6 do not: `t14` and `t25` (`ENoLib`, by
+**48 of 56 fixtures execute.**  8 do not: `t14` and `t25` (`ENoLib`, by
 design), `t38` (a boolean read, refused with TP3's error 66, by design),
 design), `t38` (a boolean read, refused with TP3's error 66, by design),
 `t43` (a program whose code exceeds the 4 KiB window, refused with error 98,
 `t43` (a program whose code exceeds the 4 KiB window, refused with error 98,
 by design), `t50_strcmp_type` (a `CHAR` compared with a string, error 56, by
 by design), `t50_strcmp_type` (a `CHAR` compared with a string, error 56, by
-design) and `uierror` (a deliberate syntax error).  The nine control-flow fixtures (`t08`
+design), `t53_strcat_type` (`'a' + 'b'`, error 56, by design),
+`t54_strcat_strnum` (`s + 1`, error 56, by design) and `uierror` (a deliberate
+syntax error).  The nine control-flow fixtures (`t08`
 const, `t09` if, `t10` while, `t11` for, `t12` repeat, `t13` procedure, `t15`
 const, `t09` if, `t10` while, `t11` for, `t12` repeat, `t13` procedure, `t15`
 label, `t27` five locals, `t28` 70 parameters) used to compile without a
 label, `t27` five locals, `t28` 70 parameters) used to compile without a
 `.out` and were never run at all; they now print and are covered, which closed
 `.out` and were never run at all; they now print and are covered, which closed
@@ -412,11 +420,11 @@ plausible byte counts.  See `SUMMARY.md` for the full list.
 **runtime entries** do, which is a different question: a compiled program never
 **runtime entries** do, which is a different question: a compiled program never
 calls `rdint` without a `readln` behind it, never calls `rdbool` twice in a
 calls `rdint` without a `readln` behind it, never calls `rdbool` twice in a
 row, and never exercises the `INT16` extremes one at a time.  It is in
 row, and never exercises the `INT16` extremes one at a time.  It is in
-`run_all.sh` and **52/52 pass** — 51 cases plus the pre-flight below, which is
+`run_all.sh` and **56/56 pass** — 55 cases plus the pre-flight below, which is
 counted as a check because it is one.
 counted as a check because it is one.
 
 
 ```
 ```
-cd shell && python3 tests/rt_exec.py             # all 51 cases + the pre-flight
+cd shell && python3 tests/rt_exec.py             # all 55 cases + the pre-flight
 cd shell && python3 tests/rt_exec.py --probe     # the RtProbe dump alone
 cd shell && python3 tests/rt_exec.py --probe     # the RtProbe dump alone
 cd shell && python3 tests/rt_exec.py --list      # the case list, with expectations
 cd shell && python3 tests/rt_exec.py --list      # the case list, with expectations
 cd shell && python3 tests/rt_exec.py --show      # print a case's wire bytes
 cd shell && python3 tests/rt_exec.py --show      # print a case's wire bytes

+ 184 - 0
shell/Compiler.mod

@@ -283,6 +283,9 @@ VAR
                                 limit in CX *)
                                 limit in CX *)
    TU_CmpStr   : CARDINAL ;  (* string comparison; two addresses on the stack,
    TU_CmpStr   : CARDINAL ;  (* string comparison; two addresses on the stack,
                                 signed -1/0/+1 in AX *)
                                 signed -1/0/+1 in AX *)
+   TU_StrCat   : CARDINAL ;  (* string concatenation; dest and source addresses
+                                on the stack, limit in CX; exit code 16 if the
+                                result would be too long *)
 
 
    abortFac : BOOLEAN ;
    abortFac : BOOLEAN ;
    errNum   : CARDINAL ;        (* NOT "errNo": Compile's formal of that
    errNum   : CARDINAL ;        (* NOT "errNo": Compile's formal of that
@@ -1909,11 +1912,36 @@ BEGIN
    Ebyte (92H)
    Ebyte (92H)
 END EmXchgAxDx ;
 END EmXchgAxDx ;
 
 
+PROCEDURE StrConcat (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ; FORWARD ;
+PROCEDURE StrOperand (r : ERes) : BOOLEAN ; FORWARD ;
+
 PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
 PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
 (* binary operation at one precedence level; folds constant operands *)
 (* binary operation at one precedence level; folds constant operands *)
 VAR f : LONGINT ;
 VAR f : LONGINT ;
     okc : BOOLEAN ;
     okc : BOOLEAN ;
 BEGIN
 BEGIN
+   IF StrOperand (left) OR StrOperand (right) THEN
+      (* A string OPERAND - a STRING or a CHAR, which is a one-character string
+         for this purpose - makes this a string operation, and `+' is the only
+         one ISO Modula-2 defines: every other binary operator reached here
+         (OR, and the multiplicative and additive numeric ops) has no meaning
+         over a STRING, and StrConcat rejects it.
+
+         The test is StrOperand and NOT `cls = TString' because of the two
+         CHAR operands.  `'a' + 'b'' has no STRING in it at all, so a
+         TString-only test let it fall through to the integer path, where the
+         character codes were added and CHR(195) was printed - a silently
+         wrong program rather than an error (see t53_strcat_type).  A CHAR
+         operand is still a string operand, which is also what makes `a + ch'
+         concatenate.
+
+         Handling it here, at the head of the one routine every binary
+         operator funnels through, is what keeps `a + b', `writeln(a + b)',
+         `(a + b) = c' and `s := a + b + c' all going through the same
+         emission. *)
+      StrConcat (op, left, right, res) ;
+      RETURN
+   END ;
    IF op = TkAnd THEN
    IF op = TkAnd THEN
       IF (left.kind = 0) AND (right.kind = 0) THEN
       IF (left.kind = 0) AND (right.kind = 0) THEN
          res.kind := 0 ;
          res.kind := 0 ;
@@ -2148,6 +2176,145 @@ BEGIN
    END
    END
 END EmPushStrAddr ;
 END EmPushStrAddr ;
 
 
+PROCEDURE NewScratchStr () : CARDINAL ;
+(* Allocate a fresh 256-byte global STRING and return its symbol index.
+
+   A concatenation result needs STORAGE the emitted code can name.  Making the
+   result a string VARIABLE (kind 1) is what keeps every downstream consumer
+   untouched: Assignment, IoCall and ParseCmp already handle kind 1, so `s :=
+   a + b', `writeln(a + b)' and `(a + b) = c' work with no code of their own.
+
+   One scratch PER `+' in the source, so a repeated or nested concatenation
+   never shares a destination - `a + b + c' is two occurrences and gets two
+   scratch strings, and the first result survives until the second consumes it.
+   (A loop reuses its site's scratch, which is correct because each execution
+   writes before it reads.)  Recursion would break that, but this compiler
+   compiles no procedures yet - see the item list.
+
+   256 bytes is the STRING type's own size, length byte plus 255 characters:
+   see ParseType's TkString arm and the predefined STRING in Inittur.  The name
+   is a placeholder (nothing looks a scratch up by name) spelled with '@', as
+   tmpA/tmpB are, so it cannot collide with a Modula-2 identifier. *)
+BEGIN
+   DropC (NewSym ("@@SC", KVar, TString, 256, 1, dc, 0, FALSE)) ;
+   dc := dc + 256 ;
+   RETURN symTop - 1
+END NewScratchStr ;
+
+PROCEDURE StrOperand (r : ERes) : BOOLEAN ;
+(* Is r usable as one operand of `+'?  A STRING, or a CHAR - which can appear
+   three ways: a quoted literal (cls TScalar with chr set), a CHAR variable
+   (cls TChar), and a string element s[i] (cls TChar, kind 5).  A number is
+   not, and neither is a BOOLEAN. *)
+BEGIN
+   RETURN (r.cls = TString) OR (r.cls = TChar) OR
+          ((r.cls = TScalar) AND r.chr)
+END StrOperand ;
+
+PROCEDURE EmPushStrOperand (r : ERes) ;
+(* Push the ADDRESS of one concatenation operand, converting a CHAR to a
+   length-1 string first.
+
+   A STRING operand is pushed exactly as cmpstr pushes one (EmPushStrAddr):
+   a variable's value already IS its address, and a literal travels inline.
+
+   A CHAR operand has no such address, so it is materialised as a
+   `<length 1><character>' string in a fresh 2-byte scratch and the address of
+   THAT is pushed.  This is TPSRC9's addch/addch2, which splice a character
+   into a concatenation by building a one-character string.  The character is
+   loaded into AL (LoadAtom), the character is stored at [coff+1] and the
+   length 1 at [coff].  At most one operand of a concatenation is a CHAR -
+   StrConcat rejects char+char - so at most one such scratch is ever made. *)
+VAR coff : CARDINAL ;
+BEGIN
+   IF r.cls = TString THEN
+      EmPushStrAddr (r)
+   ELSE
+      coff := dc ;
+      dc := dc + 2 ;
+      LoadAtom (r) ;                                   (* AX := the character *)
+      EmStoreVar (FALSE, (coff + 1) MOD 10000H, 1) ;   (* [coff+1] := AL *)
+      EmMovAxi (1) ;                                   (* AX := 1 *)
+      EmStoreVar (FALSE, coff MOD 10000H, 1) ;         (* [coff] := AL = length *)
+      EmPushVarAddr (FALSE, coff MOD 10000H)
+   END
+END EmPushStrOperand ;
+
+PROCEDURE StrConcat (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
+(* `left + right' for strings: TPSRC2's xconcat, emitted as two runtime calls.
+
+   The layout is `<length byte><characters>' and `+' needs a place to build its
+   result, so this allocates one 256-byte global scratch (NewScratchStr) and
+   copies into it: first `dest := left' through the runtime's strstore, then
+   `dest := dest + right' through strcat, which appends.  Using strstore for
+   the left operand and strcat for the right keeps the append logic in one
+   place and gives the compiler exactly one new entry to reach; it also means
+   the two calls have the same argument shape (source pushed first, destination
+   last, limit in CX), so the emission differs only in the entry named.
+
+   The limit is 255 - the scratch's 255 usable characters.  An overflowing
+   result is a RUNTIME ERROR with exit code 16, TP3's `String too long', not a
+   truncation; see Runtime.EmitStrCat.
+
+   The operator rule: `+' concatenates, anything else over a STRING is a type
+   error, and char+char is ALSO a type error.  ISO Modula-2 gives no meaning to
+   two characters summed, and inventing one (a two-character string?) would be
+   a guess this compiler does not make; TP3's own behaviour there is not
+   something the reference pins down.  That char+char choice is the one place
+   this differs from a literal reading of the reference, and it is recorded
+   here and in v-TP3-STRCAT.md rather than left to be discovered.
+
+   The guard below is what ENFORCES that rule, and it only runs because
+   BinOpEmit's hook routes a CHAR operand here too.  A hook that tested for a
+   STRING operand only would send `'a' + 'b'' to the integer path instead and
+   this test would never be reached - which is exactly what it did until
+   t53_strcat_type caught it.  Three ways to fail it: a non-`+' operator over
+   a string operand, an operand that is neither a string nor a CHAR (a number),
+   and two CHARs with no STRING on either side. *)
+VAR dest : CARDINAL ;
+BEGIN
+   (* A placeholder for the paths below that bail out through Err.  Err only
+      records the first error and does not unwind, so the caller goes on to use
+      res regardless: after `Err (ETypeErr)' in the guard, ParseAdd hands res
+      straight back to IoCall, to Assignment or to an enclosing concatenation.
+      The placeholder's SHAPE therefore matters.  It must not claim to be a
+      STRING, because the string consumers reach symtab[res.idx] for any TString
+      (IoCall's `writeln' arm does) and idx is not a symbol here; and it must be
+      something LoadAtom can fold, because the numeric consumers will try.  The
+      integer 0 is both.  Leaving kind-2/TString here, as this once did, turned
+      `writeln('a' + 'b')' - two CHARs, a type error - into a compiler segfault
+      instead of an error message. *)
+   res.kind := 0 ;
+   res.imm := 0 ;
+   res.cls := TScalar ;
+   res.boff := 0 ;
+   res.chr := FALSE ;
+   IF (op # OpAdd) OR NOT StrOperand (left) OR NOT StrOperand (right) OR
+      ((left.cls # TString) AND (right.cls # TString)) THEN
+      Err (ETypeErr) ;           (* a STRING on the wrong operator, a number,
+                                    or two CHARs *)
+      RETURN
+   END ;
+   dest := NewScratchStr () ;
+   (* dest := left *)
+   EmPushStrOperand (left) ;
+   EmPushVarAddr (FALSE, (symtab [dest].off) MOD 10000H) ;
+   EmMovCxi (255) ;
+   DropC (EmCall (TU_StrStore)) ;
+   EmAddSp (4) ;                 (* pop the two addresses strstore took *)
+   (* dest := dest + right *)
+   EmPushStrOperand (right) ;
+   EmPushVarAddr (FALSE, (symtab [dest].off) MOD 10000H) ;
+   EmMovCxi (255) ;
+   DropC (EmCall (TU_StrCat)) ;
+   EmAddSp (4) ;
+   res.kind := 1 ;
+   res.idx := dest ;
+   res.cls := TString ;
+   res.boff := 0 ;
+   res.chr := FALSE
+END StrConcat ;
+
 PROCEDURE ParseCmp (VAR r : ERes) ;
 PROCEDURE ParseCmp (VAR r : ERes) ;
 (* "=" | "<>" | "<" | "<=" | ">" | ">=" *)
 (* "=" | "<>" | "<" | "<=" | ">" | ">=" *)
 VAR op : CARDINAL ;
 VAR op : CARDINAL ;
@@ -2712,6 +2879,22 @@ BEGIN
                EXIT
                EXIT
             END ;
             END ;
             ParseExpr (arg) ;
             ParseExpr (arg) ;
+            IF NOT OK () THEN
+               (* An argument that did not type-check has no value and arg.idx
+                  is not a symbol.  The string arm below dereferences
+                  symtab[arg.idx] for ANY value whose class is TString - unlike
+                  the string assign in Assignment, which can tell a failed
+                  concat from a real one by its kind - so a `writeln' of a
+                  rejected expression read symtab with whatever idx held
+                  before and dereferenced it.  That is exactly how
+                  `writeln('a' + 'b')' - two CHARs, a type error since
+                  v-TP3-STRCAT - segfaulted the compiler instead of reporting
+                  the error.  ParseSub guards its subscript the same way (see
+                  `IF OK () THEN' before symtab[r.idx] there), and the
+                  statement loop stops at the next iteration, so leaving the
+                  rest of this WRITELN unparsed is harmless. *)
+               RETURN
+            END ;
             (* One argument at a time: parse it, give it its own push or its
             (* One argument at a time: parse it, give it its own push or its
                own runtime call, and only then read the next one.  TPSRC8
                own runtime call, and only then read the next one.  TPSRC8
                pwrloop does exactly this, and it has to - a computed argument
                pwrloop does exactly this, and it has to - a computed argument
@@ -3989,6 +4172,7 @@ BEGIN
    TU_StrStore := RT_Entry (17) ;      (* s := t: TPSRC8 asnvar, TPSRC2 strstore *)
    TU_StrStore := RT_Entry (17) ;      (* s := t: TPSRC8 asnvar, TPSRC2 strstore *)
    TU_CmpStr   := RT_Entry (18) ;      (* string compare: TPSRC9 vcompare,
    TU_CmpStr   := RT_Entry (18) ;      (* string compare: TPSRC9 vcompare,
                                           TPSRC2 cmpstr *)
                                           TPSRC2 cmpstr *)
+   TU_StrCat   := RT_Entry (19) ;      (* string concatenation: TPSRC2 xconcat *)
 END Inittur ;
 END Inittur ;
 
 
 PROCEDURE HeadWord (VAR slot : CARDINAL) ;
 PROCEDURE HeadWord (VAR slot : CARDINAL) ;

+ 6 - 0
shell/Runtime.def

@@ -40,6 +40,12 @@ CONST
                                stack, first (left) at [BP+6] and second
                                stack, first (left) at [BP+6] and second
                                (right) at [BP+4]; returns AX = -1/0/+1 for
                                (right) at [BP+4]; returns AX = -1/0/+1 for
                                <, =, >; TPSRC2 cmpstr *)
                                <, =, >; TPSRC2 cmpstr *)
+   E_StrCat  = 19 ;         (* string concatenation: destination and source
+                               addresses on the stack, destination at [BP+4]
+                               and source at [BP+6], limit in CX - strstore's
+                               exact shape; appends src to dest and leaves
+                               exit code 16 (TP3's `String too long') if
+                               dest[0]+src[0] exceeds CX; TPSRC2 xconcat *)
 
 
    (* Where a .COM's first byte ends up.  DOS loads a .COM at CS:0100 (the
    (* Where a .COM's first byte ends up.  DOS loads a .COM at CS:0100 (the
       100 bytes below are the PSP), and CS = DS, so an image offset K is at
       100 bytes below are the PSP), and CS = DS, so an image offset K is at

+ 112 - 17
shell/Runtime.mod

@@ -37,8 +37,18 @@ FROM SYSTEM IMPORT BYTE ;
 
 
 CONST
 CONST
    MaxRt  = 4096 ;
    MaxRt  = 4096 ;
-   MaxLbl = 64 ;
-   MaxFix = 400 ;
+   (* MaxLbl and MaxFix were 64 and 400, and M/AddFix used to DROP once full.
+      That limit does not announce itself: a dropped label leaves its bytes in
+      place, so the runtime still has the right LENGTH and the only symptom is
+      one branch whose rel8 came out as LblOff's "not found" value.  String
+      concatenation added the four labels that crossed 64, and strcat's
+      `jcxz sc_done' ended up pointing 47 bytes past the code - a wrong target
+      that ran the machine into the zero gap.  Sizing them with margin fixes
+      that case; the fill checks below make any future overflow a HALT instead
+      of wrong code.  tests/check_runtime.py's branch-boundary check is what
+      caught this one. *)
+   MaxLbl = 96 ;
+   MaxFix = 512 ;
    MaxNm  = 15 ;
    MaxNm  = 15 ;
 
 
    (* Offsets inside the runtime's own data block.  These must agree with the
    (* Offsets inside the runtime's own data block.  These must agree with the
@@ -117,7 +127,7 @@ VAR
    dataAt : CARDINAL ;
    dataAt : CARDINAL ;
    rtBase : CARDINAL ;
    rtBase : CARDINAL ;
    built  : BOOLEAN ;
    built  : BOOLEAN ;
-   entNm  : ARRAY [0..18] OF ARRAY [0..MaxNm] OF CHAR ;
+   entNm  : ARRAY [0..19] OF ARRAY [0..MaxNm] OF CHAR ;
 
 
 (* ---------------------------------------------------------------- *)
 (* ---------------------------------------------------------------- *)
 (*  name helpers                                                     *)
 (*  name helpers                                                     *)
@@ -173,22 +183,31 @@ END W ;
 PROCEDURE M (nm : ARRAY OF CHAR ) ;
 PROCEDURE M (nm : ARRAY OF CHAR ) ;
 (* mark: nm is the current offset *)
 (* mark: nm is the current offset *)
 BEGIN
 BEGIN
-   IF ltop < MaxLbl THEN
-      SetStr (lbl [ltop].nm, nm) ;
-      lbl [ltop].off := rpos ;
-      INC (ltop)
-   END
+   (* A dropped label is not a smaller runtime, it is a WRONG one: its bytes
+      are still emitted, so only a branch that names it goes off target.  That
+      shows up in neither the size nor the entry table, so refuse to build
+      rather than drop. *)
+   IF ltop >= MaxLbl THEN
+      HALT
+   END ;
+   SetStr (lbl [ltop].nm, nm) ;
+   lbl [ltop].off := rpos ;
+   INC (ltop)
 END M ;
 END M ;
 
 
 PROCEDURE AddFix (kind, place : CARDINAL ; nm : ARRAY OF CHAR ; val : CARDINAL ) ;
 PROCEDURE AddFix (kind, place : CARDINAL ; nm : ARRAY OF CHAR ; val : CARDINAL ) ;
+(* Record a displacement to be patched once every label is known.  A dropped
+   fixup is an address that is never patched - the same silent-wrong-code
+   failure the check in M exists to prevent. *)
 BEGIN
 BEGIN
-   IF nfix < MaxFix THEN
-      fix [nfix].kind := kind ;
-      fix [nfix].place := place ;
-      fix [nfix].val := val ;
-      SetStr (fix [nfix].nm, nm) ;
-      INC (nfix)
-   END
+   IF nfix >= MaxFix THEN
+      HALT
+   END ;
+   fix [nfix].kind := kind ;
+   fix [nfix].place := place ;
+   fix [nfix].val := val ;
+   SetStr (fix [nfix].nm, nm) ;
+   INC (nfix)
 END AddFix ;
 END AddFix ;
 
 
 PROCEDURE LblOff (nm : ARRAY OF CHAR ) : CARDINAL ;
 PROCEDURE LblOff (nm : ARRAY OF CHAR ) : CARDINAL ;
@@ -320,6 +339,8 @@ PROCEDURE PushDx ; BEGIN B (52H) END PushDx ;
 PROCEDURE PopDx  ; BEGIN B (5AH) END PopDx ;
 PROCEDURE PopDx  ; BEGIN B (5AH) END PopDx ;
 PROCEDURE PushDi ; BEGIN B (57H) END PushDi ;
 PROCEDURE PushDi ; BEGIN B (57H) END PushDi ;
 PROCEDURE PopDi  ; BEGIN B (5FH) END PopDi ;
 PROCEDURE PopDi  ; BEGIN B (5FH) END PopDi ;
+PROCEDURE PushSi ; BEGIN B (56H) END PushSi ;
+PROCEDURE PopSi  ; BEGIN B (5EH) END PopSi ;
 
 
 PROCEDURE XorAxAx ; BEGIN B (31H) ; B (0C0H) END XorAxAx ;  (* 11 000 000 *)
 PROCEDURE XorAxAx ; BEGIN B (31H) ; B (0C0H) END XorAxAx ;  (* 11 000 000 *)
 PROCEDURE XorCxCx ; BEGIN B (31H) ; B (0C9H) END XorCxCx ;  (* 11 001 001 *)
 PROCEDURE XorCxCx ; BEGIN B (31H) ; B (0C9H) END XorCxCx ;  (* 11 001 001 *)
@@ -328,6 +349,7 @@ PROCEDURE XorDiDi ; BEGIN B (31H) ; B (0FFH) END XorDiDi ;  (* 11 111 111 *)
 
 
 PROCEDURE IncCx ; BEGIN B (41H) END IncCx ;
 PROCEDURE IncCx ; BEGIN B (41H) END IncCx ;
 PROCEDURE IncSi ; BEGIN B (46H) END IncSi ;
 PROCEDURE IncSi ; BEGIN B (46H) END IncSi ;
+PROCEDURE IncDi ; BEGIN B (47H) END IncDi ;
 PROCEDURE DecSi ; BEGIN B (4EH) END DecSi ;
 PROCEDURE DecSi ; BEGIN B (4EH) END DecSi ;
 PROCEDURE AddDi2 ; BEGIN B (83H) ; B (0C7H) ; B (2) END AddDi2 ;  (* 11 000 111 *)
 PROCEDURE AddDi2 ; BEGIN B (83H) ; B (0C7H) ; B (2) END AddDi2 ;  (* 11 000 111 *)
 
 
@@ -506,6 +528,18 @@ PROCEDURE MovSiBx  ; BEGIN B (89H) ; B (0DEH) END MovSiBx ;  (* 89 DE: MOV SI,BX
 PROCEDURE MovDiDx  ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
 PROCEDURE MovDiDx  ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
 PROCEDURE MovDiAx  ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
 PROCEDURE MovDiAx  ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
 PROCEDURE AddDiAx  ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
 PROCEDURE AddDiAx  ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
+(* The register-pair emitters strcat (EmitStrCat) needs.  Two registers, so
+   the audit's two-register pattern reads them positionally: `AddDxAx' is
+   01 C2 = ADD DX,AX (01 /r is `op r/m16,r16'', DX is r/m and AX is reg), and
+   the mirror `SubDxAx' is 29 C2.  MovCxAx is 89 C1 (89 /r: reg is the
+   source, so CX is r/m and AX is reg).  MovDiSi is 8B FE (8B /r: reg is the
+   destination). *)
+PROCEDURE MovCxAx  ; BEGIN B (89H) ; B (0C1H) END MovCxAx ;  (* 89 C1: MOV CX,AX *)
+PROCEDURE MovDiSi  ; BEGIN B (8BH) ; B (0FEH) END MovDiSi ;  (* 8B FE: MOV DI,SI *)
+PROCEDURE AddDxAx  ; BEGIN B (1H) ; B (0C2H) END AddDxAx ;   (* 01 C2: DX:=DX+AX *)
+PROCEDURE SubDxAx  ; BEGIN B (29H) ; B (0C2H) END SubDxAx ;   (* 29 C2: DX:=DX-AX *)
+PROCEDURE AddDiDx  ; BEGIN B (1H) ; B (0D7H) END AddDiDx ;   (* 01 D7: DI:=DI+DX *)
+PROCEDURE StSiCl   ; BEGIN B (88H) ; B (0CH) END StSiCl ;    (* 88 0C: [SI]:=CL *)
 PROCEDURE IncBx    ; BEGIN B (43H) END IncBx ;
 PROCEDURE IncBx    ; BEGIN B (43H) END IncBx ;
 PROCEDURE LdAlBx   ; BEGIN B (8AH) ; B (07H) END LdAlBx ;   (* 8A 07: AL:=[BX] *)
 PROCEDURE LdAlBx   ; BEGIN B (8AH) ; B (07H) END LdAlBx ;   (* 8A 07: AL:=[BX] *)
 PROCEDURE MovAlBl  ; BEGIN B (8AH) ; B (0C3H) END MovAlBl ; (* 8A C3: AL:=BL *)
 PROCEDURE MovAlBl  ; BEGIN B (8AH) ; B (0C3H) END MovAlBl ; (* 8A C3: AL:=BL *)
@@ -532,6 +566,7 @@ PROCEDURE Jb8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (72H, nm) END Jb8 ;
 PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
 PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
 PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
 PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
 PROCEDURE Ja8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
 PROCEDURE Ja8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
+PROCEDURE Jae8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (73H, nm) END Jae8 ;
 PROCEDURE Jcxz8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E3H, nm) END Jcxz8 ;
 PROCEDURE Jcxz8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E3H, nm) END Jcxz8 ;
 PROCEDURE Loop8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E2H, nm) END Loop8 ;
 PROCEDURE Loop8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E2H, nm) END Loop8 ;
 
 
@@ -1212,6 +1247,65 @@ BEGIN
    MovSpBp ; PopBp ; RetR
    MovSpBp ; PopBp ; RetR
 END EmitCmpStr ;
 END EmitCmpStr ;
 
 
+PROCEDURE EmitStrCat ;
+(* strcat: dest := dest + src, TPSRC2's xconcat (963) with the two strings
+   taken as ADDRESSES rather than pushed by value.
+
+   The caller pushes the SOURCE first and the DESTINATION last, sets CX = the
+   destination's capacity in characters, calls, and pops both words (caller
+   pops).  That is exactly strstore's argument shape, so the compiler's two
+   emitted calls for `a + b' differ only in which entry they name - see
+   Compiler.StrConcat.
+
+   TP3's xconcat adds the two length bytes (`ADD.B DL,CL') and takes the CARRY
+   as "string too long" (`JB concerr'), then concerr loads runerr's code 16;
+   the copy itself is the same append this does.  So an overflowing
+   concatenation is a RUNTIME ERROR, not a silent truncation: if dest[0] +
+   src[0] exceeds CX the process leaves through INT 21h AH=4Ch with exit code
+   16 (10H), which is where TP3's error 16 ends up.  (strstore truncates
+   instead, which is also what TP3 does there - the two entries deliberately
+   do not agree, because TP3's two routines do not.)
+
+   AX, BX, CX, DX, SI and DI are all preserved: the compiler may hold a string
+   element's address in DI across the call that pushes the operand AFTER this
+   one (see Compiler.EmPushStrOperand), so strcat cannot be the entry that
+   quietly clobbers it. *)
+BEGIN
+   M ("strcat") ;
+   PushBp ; MovBpSp ;
+   PushAx ; PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
+   MovAxBp4 ; MovSiAx ;      (* SI := dest *)
+   MovBxBp6 ;                (* BX := src *)
+   XorDxDx ;
+   MovDlSi ;                 (* DL := dest[0], the destination length *)
+   XorAxAx ;
+   LdAlBx ;                  (* AL := src[0]; AX is now the source length *)
+   AddDxAx ;                 (* DX := dest length + source length *)
+   CmpCxDx ;                 (* CMP CX (max), DX (total) *)
+   Jae8 ("sc_ok") ;          (* max >= total: it fits *)
+   MovAlD (10H) ;            (* 10H = 16: TP3's `String too long' error code *)
+   MovAh (4CH) ;             (* AH = 4Ch: terminate *)
+   Int21 ;                   (* leaving now; the caller's stack is abandoned *)
+   M ("sc_ok") ;
+   MovCxDx ;                 (* CX := the new length *)
+   StSiCl ;                  (* dest[0] := new length (CL) *)
+   SubDxAx ;                 (* DX := total - source length = old dest length *)
+   MovDiSi ;                 (* DI := dest *)
+   IncDi ;                   (* -> first character *)
+   AddDiDx ;                 (* -> the append position, dest+1+old length *)
+   IncBx ;                   (* BX -> the source's first character *)
+   MovCxAx ;                 (* CX := source length, LOOP's count *)
+   Jcxz8 ("sc_done") ;       (* an empty source appends nothing *)
+   M ("sc_loop") ;
+   LdAlBx ;                  (* AL := src char *)
+   StDiAl ;                  (* dest char := AL *)
+   IncBx ; IncDi ;
+   Loop8 ("sc_loop") ;
+   M ("sc_done") ;
+   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ; PopAx ;
+   MovSpBp ; PopBp ; RetR
+END EmitStrCat ;
+
 PROCEDURE Str5 (s : ARRAY OF CHAR ; n : CARDINAL) ;
 PROCEDURE Str5 (s : ARRAY OF CHAR ; n : CARDINAL) ;
 (* emit n characters, so the strings below are visibly the same length as the
 (* emit n characters, so the strings below are visibly the same length as the
    D_ constants claim and an off-by-one in either place is a compile-time
    D_ constants claim and an off-by-one in either place is a compile-time
@@ -1320,7 +1414,7 @@ BEGIN
    EmitRdInt ; EmitRdScan ; EmitRdByte ;
    EmitRdInt ; EmitRdScan ; EmitRdByte ;
    EmitRdChar ; EmitRdBool ; EmitRdLn ;
    EmitRdChar ; EmitRdBool ; EmitRdLn ;
    EmitGetCh ; EmitUnGetCh ;
    EmitGetCh ; EmitUnGetCh ;
-   EmitRdStr ; EmitStrStore ; EmitCmpStr ;
+   EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ;
    EmitData ;
    EmitData ;
    FixUp ;
    FixUp ;
    SetStr (entNm [0], "initmem") ;
    SetStr (entNm [0], "initmem") ;
@@ -1342,6 +1436,7 @@ BEGIN
    SetStr (entNm [16], "rdstr") ;
    SetStr (entNm [16], "rdstr") ;
    SetStr (entNm [17], "strstore") ;
    SetStr (entNm [17], "strstore") ;
    SetStr (entNm [18], "cmpstr") ;
    SetStr (entNm [18], "cmpstr") ;
+   SetStr (entNm [19], "strcat") ;
    built := TRUE
    built := TRUE
 END RT_Build ;
 END RT_Build ;
 
 
@@ -1369,7 +1464,7 @@ BEGIN
    IF NOT built THEN
    IF NOT built THEN
       RT_Build (0)
       RT_Build (0)
    END ;
    END ;
-   IF i > 18 THEN
+   IF i > 19 THEN
       RETURN 0
       RETURN 0
    END ;
    END ;
    RETURN rtBase + LblOff (entNm [i])
    RETURN rtBase + LblOff (entNm [i])

+ 4 - 4
shell/tests/RtProbe.mod

@@ -108,7 +108,7 @@ END PENT ;
 
 
 PROCEDURE Main ;
 PROCEDURE Main ;
 VAR i, n, base : CARDINAL ;
 VAR i, n, base : CARDINAL ;
-    names : ARRAY [0..18] OF ARRAY [0..15] OF CHAR ;
+    names : ARRAY [0..19] OF ARRAY [0..15] OF CHAR ;
 BEGIN
 BEGIN
    base := GetBase () ;
    base := GetBase () ;
    RT_Build (base) ;
    RT_Build (base) ;
@@ -121,7 +121,7 @@ BEGIN
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    PS ("code ends at ") ; PCARD (RT_CodeEnd ()) ; NL ;
    i := 0 ;
    i := 0 ;
-   WHILE i <= 15 DO
+   WHILE i <= 19 DO
       names [i] := "" ;
       names [i] := "" ;
       INC (i)
       INC (i)
    END ;
    END ;
@@ -131,9 +131,9 @@ BEGIN
    names [9] := "rdchar" ;  names [10] := "rdbool" ; names [11] := "rdln" ;
    names [9] := "rdchar" ;  names [10] := "rdbool" ; names [11] := "rdln" ;
    names [12] := "halt" ;   names [13] := "wrtinl" ;  names [14] := "rdbyte" ;
    names [12] := "halt" ;   names [13] := "wrtinl" ;  names [14] := "rdbyte" ;
    names [15] := "wrstr" ;  names [16] := "rdstr" ;  names [17] := "strstore" ;
    names [15] := "wrstr" ;  names [16] := "rdstr" ;  names [17] := "strstore" ;
-   names [18] := "cmpstr" ;
+   names [18] := "cmpstr" ; names [19] := "strcat" ;
    i := 0 ;
    i := 0 ;
-   WHILE i <= 18 DO
+   WHILE i <= 19 DO
       PENT (i, names [i]) ;
       PENT (i, names [i]) ;
       INC (i)
       INC (i)
    END ;
    END ;

+ 6 - 0
shell/tests/check_8086.py

@@ -240,6 +240,10 @@ BRANCH_SITES = {
     # thirteen in t49; every one is a plain IF, so every declared nibble is 4.
     # thirteen in t49; every one is a plain IF, so every declared nibble is 4.
     "t48_strcmp": [4] * 30,
     "t48_strcmp": [4] * 30,
     "t49_strcmp_lit": [4] * 13,
     "t49_strcmp_lit": [4] * 13,
+    # One `if (a + b) = 'helloworld'' -- a comparison whose LEFT operand is a
+    # concatenation result, so the branch is new even though the shape is the
+    # same plain IF as t48/t49.
+    "t52_strcat_nest": [4],
 }
 }
 BRANCH_WHY = {
 BRANCH_WHY = {
     "t09_if":     "three `if' statements",
     "t09_if":     "three `if' statements",
@@ -252,6 +256,8 @@ BRANCH_WHY = {
     "t32_forexit": "a `for .. to' and an `if .. exit'",
     "t32_forexit": "a `for .. to' and an `if .. exit'",
     "t48_strcmp": "five blocks of six `if <string compare>'",
     "t48_strcmp": "five blocks of six `if <string compare>'",
     "t49_strcmp_lit": "three blocks of `if <string literal compare>'",
     "t49_strcmp_lit": "three blocks of `if <string literal compare>'",
+    "t52_strcat_nest": "one `if (a + b) = 'helloworld'', a concatenation "
+                       "result compared",
 }
 }
 
 
 
 

+ 10 - 0
shell/tests/check_runtime.py

@@ -216,6 +216,16 @@ GOLDEN = {
     # AX is a RESULT here, so there is nothing to save; the three-register
     # AX is a RESULT here, so there is nothing to save; the three-register
     # frame is the fix, and the sign is pinned by t48/t49 on qemu.
     # frame is the fix, and the sign is pinned by t48/t49 on qemu.
     "cmpstr": "55 8B EC 53 51 52",
     "cmpstr": "55 8B EC 53 51 52",
+    # strcat: s := s + t.  The same argument shape as strstore - the caller
+    # pushes the source then the destination, so dest is [BP+4] - but a
+    # SIX-register frame: PUSH BP; MOV BP,SP; PUSH AX,BX,CX,DX,SI,DI.  SI and
+    # DI are saved because a string operand may be an ELEMENT (`a[i] + b'),
+    # whose address the compiler is holding in DI while it pushes the operand
+    # after it; the append loop walks the destination in DI and the source in
+    # BX, and cmpstr's three-register frame is not enough.  This is the
+    # runtime's largest frame, and the prefix pins both the frame and the
+    # argument convention the two emitted calls depend on.
+    "strcat": "55 8B EC 50 53 51 52 56 57 8B 46 04",
 }
 }
 
 
 
 

+ 16 - 24
shell/tests/exec/bootcom.s

@@ -39,22 +39,16 @@
 #     2000h sits past the end of any fixture and is simply part of the disk
 #     2000h sits past the end of any fixture and is simply part of the disk
 #     image the harness writes, so the addresses here are assembly constants.
 #     image the harness writes, so the addresses here are assembly constants.
 #
 #
-#     The one piece of scratch the handler keeps INSIDE the loaded region is
-#     0702h, the output string cursor.  Since 0100h is image offset 0, that is
-#     image offset 602h -- which is inside every fixture's image, because a
-#     .COM is padded out to the data base at rtSz+1000h = 11B4h.  It is in the
-#     ZERO GAP between the end of the code and that data base, so it is
-#     harmless today, and nothing reads it before writing it.  But it is a
-#     real limit and belongs in writing rather than in a discovery later: an
-#     AH=09h against a program whose code reaches 602h scribbles over that
-#     program's own code.  The code starts at 1C7h and the longest fixture's
-#     ends at 468h, so the margin is 19Ah = 410 bytes of code -- and it is the
-#     same unenforced 4 KiB code window the linker documents, seen from the
-#     other end.  Moving the cursor above everything the read covers would
-#     remove the limit; it stays at 0702h because nothing needs it yet, and
-#     because every address in this file is restated in run_com_exec.py, which
-#     is the thing that would have to change with it.  See the layout block at
-#     the end of this file.
+#     The handler owns no scratch inside the loaded region.  It used to keep
+#     the AH=09h cursor in memory at 0702h -- image offset 602h, inside every
+#     fixture's image, because a .COM is padded out to the data base at
+#     rtSz+1000h.  That was a real limit, and it was hit: string concatenation
+#     emits enough code that a program's code can reach 602h, and the AH=09h
+#     that prints a writeln's CRLF then overwrote that program's own `call
+#     progend'.  The cursor lives in SI now, not in memory at all -- lodsb
+#     advances SI and ser_put leaves SI alone -- so the handler cannot scribble
+#     on the program, and the code window is the linker's 4 KiB again rather
+#     than this handler's 602h.  See the layout block at the end of this file.
 #
 #
 # Built and driven by tests/run_com_exec.py.  tests/exec/rtdrv.s assembles the
 # Built and driven by tests/run_com_exec.py.  tests/exec/rtdrv.s assembles the
 # other half of this machinery -- the driver that calls runtime entries directly
 # other half of this machinery -- the driver that calls runtime entries directly
@@ -177,14 +171,12 @@ handler:
 	jmp	.Ldone
 	jmp	.Ldone
 
 
 .Lh09:					# display the $-terminated string at DS:DX
 .Lh09:					# display the $-terminated string at DS:DX
-	movw	%dx, 0x0702		# ser_put clobbers DX, so keep the pointer
-.Lh09next:
-	movw	0x0702, %si		# lodsb: AL = [DS:SI].  Register-indirect
-	lodsb				# addressing with no displacement is not
-	cmpb	$0x24, %al		# expressible in gas .code16 syntax, and
-	je	.Lh09done		# keeping the cursor in memory means the
-	call	ser_put		# pointer survives ser_put's use of DX.
-	incw	0x0702
+	movw	%dx, %si		# SI is the cursor.  lodsb walks it forward,
+.Lh09next:				# and ser_put leaves SI alone -- it clobbers
+	lodsb				# only DX, which is why the pointer cannot
+	cmpb	$0x24, %al		# simply stay in DX across the call.
+	je	.Lh09done
+	call	ser_put
 	jmp	.Lh09next
 	jmp	.Lh09next
 .Lh09done:
 .Lh09done:
 	clc
 	clc

+ 22 - 1
shell/tests/exec/rtdrv.s

@@ -107,6 +107,11 @@
 	.set	SST_LONG, 0x08D0	# a source longer than a small max
 	.set	SST_LONG, 0x08D0	# a source longer than a small max
 	.set	SST_EMPTY, 0x08E0	# an empty source string
 	.set	SST_EMPTY, 0x08E0	# an empty source string
 	.set	SST_DST, 0x08F0		# destination for the strstore cases
 	.set	SST_DST, 0x08F0		# destination for the strstore cases
+	.set	SST_CAT, 0x0900		# destination for the strcat cases, with a
+					# length to append to -- unlike SST_DST,
+					# which strstore overwrites
+	.set	SST_CAT0, 0x0910	# ...and one that starts empty
+	.set	SST_WORLD, 0x0920	# a source distinct from SST_HELLO
 
 
 	.code16
 	.code16
 	.text
 	.text
@@ -367,7 +372,7 @@ HDR:
 	.org	D_DUMPLEN
 	.org	D_DUMPLEN
 	.zero	6			# D_DUMPLEN, D_DUMPADR, D_CNT
 	.zero	6			# D_DUMPLEN, D_DUMPADR, D_CNT
 
 
-# --- strings for the two string entries -----------------------------------
+# --- strings for the string entries ----------------------------------------
 # A compiled `string [n]' variable is a length byte and n characters, and that
 # A compiled `string [n]' variable is a length byte and n characters, and that
 # is the layout rdstr writes and strstore reads.  Each DESTINATION is
 # is the layout rdstr writes and strstore reads.  Each DESTINATION is
 # pre-filled with 0xEE so a byte the entry does NOT write is visibly still
 # pre-filled with 0xEE so a byte the entry does NOT write is visibly still
@@ -389,3 +394,19 @@ HDR:
 
 
 	.org	SST_DST
 	.org	SST_DST
 	.fill	16, 1, 0xEE
 	.fill	16, 1, 0xEE
+
+# strcat reads the DESTINATION's length, so its destinations are seeded with a
+# real string rather than 0xEE -- and 0xEE would in fact be a 238-character
+# length, which is exactly the "string too long" error the entry has to raise.
+# SST_CAT holds `hello', SST_CAT0 is empty, and SST_WORLD is a source that is
+# not SST_HELLO so an append is visible as an append and not as a coincidence.
+	.org	SST_CAT
+	.byte	5, 'h', 'e', 'l', 'l', 'o'
+	.fill	10, 1, 0xEE
+
+	.org	SST_CAT0
+	.byte	0			# a length of 0: nothing to append to
+	.fill	15, 1, 0xEE
+
+	.org	SST_WORLD
+	.byte	5, 'w', 'o', 'r', 'l', 'd'

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

@@ -377,3 +377,44 @@ t49_strcmp_lit	OK	1006	15
 #                   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	ERR	56	600
+#   t51_strcat             string concatenation, `a + b', where its result can
+#                   go: a writeln argument, an assignment source, and then an
+#                   operand again.  The pairings are var+var, literal+var,
+#                   var+literal, var+char and char+var - every shape a string
+#                   operand admits except two CHARs, which t53 rejects.  data=
+#                   1842 is a,b,c (string[12] = 13 each), ch (1), the seven
+#                   scratches (7*256), the three CHAR operands ('!', and ch in
+#                   a+ch and in ch+a) at 2 bytes each, and the two @@T
+#                   temporaries (4).
+t51_strcat	OK	537	1842
+#   t52_strcat_nest        nested concatenations - left-associative, so `a+b+'!''
+#                   is two occurrences and two scratches - plus a concatenation
+#                   as a comparison operand and a string ELEMENT as the left
+#                   operand of `+'.  data=1574 is a,b (13 each), the six
+#                   scratches (6*256), the four CHAR operands ('!', '<', '>',
+#                   a[2]) at 2 bytes each, and the two @@T temporaries (4).
+t52_strcat_nest	OK	501	1574
+#   t53_strcat_type        `'a' + 'b'': two CHARs under `+' is a type error.  A
+#                   CHAR is a string operand, so `'a' + b' concatenates; BOTH
+#                   operands being CHARs, with no STRING on either side, is the
+#                   rejection.  This is the one shape the BinOpEmit hook used
+#                   to miss - it tested for a STRING operand only, so two CHARs
+#                   fell through to integer addition and silently produced
+#                   CHR(195).  ETypeErr at the `+' (pos is where the token
+#                   after the right operand starts, as t50's is).
+t53_strcat_type	ERR	56	663
+#   t54_strcat_strnum       s + 1: a STRING operand makes `+' concatenation,
+#                   and both operands must then be strings or CHARs; a number
+#                   is neither.  ETypeErr at the `+'.
+t54_strcat_strnum	ERR	56	463
+#   t55_strcat_overflow    128 characters read into a `string' and then
+#                   `s := s + s' asks for 256, past the 255 the scratch can
+#                   hold: TP3's xconcat raises "string too long" (error 16),
+#                   and the runtime leaves through INT 21h AH=4Ch with AL=16.
+#                   The program therefore exits 16 - pinned by
+#                   t55_strcat_overflow.exit, which is what turns "it stopped"
+#                   into "it overflowed".  The .out stops at `read', before the
+#                   `after' a truncating implementation would have printed.
+#                   data=516 is s (the default string = 256), one scratch
+#                   (256), and the two @@T temporaries (4).
+t55_strcat_overflow	OK	126	516

+ 7 - 0
shell/tests/fixtures/t51_strcat.out

@@ -0,0 +1,7 @@
+helloworld
+say world
+hello!
+helloX
+Xhello
+helloworld
+worldhelloworld

+ 29 - 0
shell/tests/fixtures/t51_strcat.pas

@@ -0,0 +1,29 @@
+{ t51_strcat: string concatenation, `a + b', in the places its result can go.
+
+  A concatenation needs storage for its result before anything can consume it,
+  so each `+' in the source gets its own 256-byte scratch STRING and the result
+  IS that variable.  These are the shapes that consume one: as a `writeln'
+  argument, assigned to a target, and then used again as an operand.
+
+  The operands cover var+var, literal+var, var+literal, var+char and char+var -
+  every pairing a string operand allows except two CHARs, which t53 rejects.
+  The CHAR cases are the reason a one-character literal and a CHAR variable
+  take the same path: a CHAR operand becomes a one-character string on the
+  stack (a length byte and the byte), not a string copied from memory. }
+program t51_strcat (input, output);
+var
+   a, b, c : string[12];
+   ch      : char;
+begin
+   a := 'hello';
+   b := 'world';
+   ch := 'X';
+   writeln (a + b);          { var + var     -> helloworld }
+   writeln ('say ' + b);     { literal + var -> say world }
+   writeln (a + '!');        { var + literal -> hello! }
+   writeln (a + ch);         { var + char    -> helloX }
+   writeln (ch + a);         { char + var    -> Xhello }
+   c := a + b;               { the result assigned to a variable... }
+   writeln (c);
+   writeln (b + c)           { ...and then used as an operand }
+end.

+ 4 - 0
shell/tests/fixtures/t52_strcat_nest.out

@@ -0,0 +1,4 @@
+helloworld!
+<hello>
+concat-eq
+eworld

+ 25 - 0
shell/tests/fixtures/t52_strcat_nest.pas

@@ -0,0 +1,25 @@
+{ t52_strcat_nest: nested concatenations, a concatenation compared, and a
+  string ELEMENT as an operand.
+
+  `+' associates to the left, so `a + b + '!'' is two occurrences and gets two
+  scratch strings, and the first result is still alive when the second consumes
+  it.  A concatenation result is an ordinary string variable, so it can be an
+  operand of `=' (ParseCmp), and `+' can take an `s[i]' element as its left
+  operand, in which case an element ADDRESS is what reaches the runtime rather
+  than a whole-string address.
+
+  a[2] is 'e' - subscripts are 1-based, the length byte is at s[0]. }
+program t52_strcat_nest (input, output);
+var
+   a, b : string[12];
+begin
+   a := 'hello';
+   b := 'world';
+   writeln (a + b + '!');          { (a + b) + '!' }
+   writeln ('<' + a + '>');        { ('<' + a) + '>' }
+   if (a + b) = 'helloworld' then
+      writeln ('concat-eq')
+   else
+      writeln ('concat-ne');
+   writeln (a[2] + b)              { a string element + a string }
+end.

+ 15 - 0
shell/tests/fixtures/t53_strcat_type.pas

@@ -0,0 +1,15 @@
+{ t53_strcat_type: `'a' + 'b'' - two CHARs - is a type error.
+
+  ISO Modula-2 gives `+' no meaning over two CHARs, and this compiler does not
+  invent one (a two-character string? the character codes summed?).  A CHAR is
+  a string operand, so `'a' + b' concatenates and is fine; the error is
+  specifically that BOTH operands are CHARs and neither is a STRING.
+
+  This is the one shape the hook at the head of BinOpEmit used to miss.  It
+  tested only for a STRING operand, so `'a' + 'b'' fell through to integer
+  addition and silently yielded CHR(195).  Expected: ETypeErr (56) at the `+'.
+}
+program t53_strcat_type (input, output);
+begin
+   writeln ('a' + 'b')
+end.

+ 13 - 0
shell/tests/fixtures/t54_strcat_strnum.pas

@@ -0,0 +1,13 @@
+{ t54_strcat_strnum: `s + 1' - a string and a number - is a type error.
+
+  A STRING operand makes `+' the concatenation operator, and then BOTH operands
+  must be strings or CHARs; a number is not one.  The string on the left is
+  what selects the concatenation path, and the number then fails the string
+  operand test.  Expected: ETypeErr (56) at the `+'. }
+program t54_strcat_strnum (input, output);
+var
+   s : string[8];
+begin
+   s := 'abc';
+   writeln (s + 1)
+end.

+ 1 - 0
shell/tests/fixtures/t55_strcat_overflow.exit

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

+ 1 - 0
shell/tests/fixtures/t55_strcat_overflow.in

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

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

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

+ 20 - 0
shell/tests/fixtures/t55_strcat_overflow.pas

@@ -0,0 +1,20 @@
+{ t55_strcat_overflow: concatenating past the maximum is a RUNTIME error.
+
+  A `string' is string[255] - a length byte and 255 characters - so the scratch
+  a concatenation writes into cannot hold more than 255.  Reading 128
+  characters and then doing `s := s + s' asks for 256.  TP3's xconcat raises
+  "string too long" (error 16) instead of truncating, and this runtime leaves
+  through INT 21h AH=4Ch with AL=16.
+
+  `after' must NOT appear: the error path leaves the program, it does not set a
+  flag, truncate, and carry on.  The .out pins where it stopped and the .exit
+  file pins WHY - exit 16, not the 0 progend would give. }
+program t55_strcat_overflow (input, output);
+var
+   s : string;
+begin
+   readln (s);
+   writeln ('read');
+   s := s + s;
+   writeln ('after')
+end.

+ 38 - 1
shell/tests/rt_exec.py

@@ -75,6 +75,9 @@ SST_HELLO = 0x08C0
 SST_LONG = 0x08D0
 SST_LONG = 0x08D0
 SST_EMPTY = 0x08E0
 SST_EMPTY = 0x08E0
 SST_DST = 0x08F0
 SST_DST = 0x08F0
+SST_CAT = 0x0900
+SST_CAT0 = 0x0910
+SST_WORLD = 0x0920
 
 
 # A .COM is loaded at CS:0100, and every address in the image is an image
 # A .COM is loaded at CS:0100, and every address in the image is an image
 # offset.  The load bias is therefore the difference between the two, and
 # offset.  The load bias is therefore the difference between the two, and
@@ -99,7 +102,7 @@ SOH, STX, ETX, EOT = 0x01, 0x02, 0x03, 0x04
 # the lookup fail loudly instead of silently testing offset 0.
 # the lookup fail loudly instead of silently testing offset 0.
 ENTS = ["initmem", "progend", "stackchk", "wrint", "wrchar", "wrbool",
 ENTS = ["initmem", "progend", "stackchk", "wrint", "wrchar", "wrbool",
         "wrreal", "wrln", "rdint", "rdchar", "rdbool", "rdln", "halt",
         "wrreal", "wrln", "rdint", "rdchar", "rdbool", "rdln", "halt",
-        "wrtinl", "rdbyte", "wrstr", "rdstr", "strstore", "cmpstr"]
+        "wrtinl", "rdbyte", "wrstr", "rdstr", "strstore", "cmpstr", "strcat"]
 
 
 # A call slot's flags, as rtdrv.s reads them.
 # A call slot's flags, as rtdrv.s reads them.
 F_STACK = 1     # the argument goes on the stack, popped by the caller
 F_STACK = 1     # the argument goes on the stack, popped by the caller
@@ -602,6 +605,40 @@ def build_cases():
         out=b"", dump=6, dumpbytes=bytes([5]) + b"hello", dumpadr=SST_HELLO,
         out=b"", dump=6, dumpbytes=bytes([5]) + b"hello", dumpadr=SST_HELLO,
         note="the dump is the LEFT operand ([BP+6]); it must come back unchanged")
         note="the dump is the LEFT operand ([BP+6]); it must come back unchanged")
 
 
+    # --- strcat: s := s + t.  The same argument shape as strstore -- source
+    # pushed first, destination at [BP+4], maximum in CX -- but the DESTINATION
+    # is READ as well as written: dest[0] is the existing length, dest[0]+src[0]
+    # is the new one, and the characters are copied to dest[1]+dest[0].  That is
+    # why the destination is seeded: strstore may ignore its destination, but
+    # 0xEE here would read as a length of 238 and raise the overflow error.
+    #
+    # The overflow EXIT cannot be a case: a record dumps memory after the calls
+    # return, and the error path leaves through INT 21h AH=4C, so the record is
+    # never closed.  t55_strcat_overflow runs a whole compiled program and
+    # checks the exit code instead - see run_com_exec.py and the .exit file.
+    add("strcat appends the source to the destination",
+        [s2cx("strcat", SST_CAT + LOAD_BIAS, SST_WORLD + LOAD_BIAS, 20)],
+        out=b"", dump=11, dumpbytes=bytes([10]) + b"helloworld",
+        dumpadr=SST_CAT,
+        note="'hello' + 'world': the new length is the SUM of the two")
+
+    add("strcat appends to an empty destination",
+        [s2cx("strcat", SST_CAT0 + LOAD_BIAS, SST_WORLD + LOAD_BIAS, 20)],
+        out=b"", dump=6, dumpbytes=bytes([5]) + b"world", dumpadr=SST_CAT0,
+        note="a zero destination length is the ordinary case, not a special one")
+
+    add("strcat of an empty source leaves the destination alone",
+        [s2cx("strcat", SST_CAT + LOAD_BIAS, SST_EMPTY + LOAD_BIAS, 20)],
+        out=b"", dump=8, dumpbytes=bytes([5]) + b"hello" + b"\xee" * 2,
+        dumpadr=SST_CAT,
+        note="a zero SOURCE length takes JCXZ; a LOOP would run 65536 times")
+
+    add("strcat at the destination maximum does not overflow",
+        [s2cx("strcat", SST_CAT + LOAD_BIAS, SST_WORLD + LOAD_BIAS, 10)],
+        out=b"", dump=11, dumpbytes=bytes([10]) + b"helloworld",
+        dumpadr=SST_CAT,
+        note="sum == CX is allowed; only sum > CX is the error")
+
     return cs
     return cs
 
 
 
 

+ 28 - 2
shell/tests/run_com_exec.py

@@ -19,6 +19,10 @@ Nothing here trusts the compiler, the linker, or the boot sector:
     exit code, via the isa-debug-exit device.  So no sentinel byte can ever
     exit code, via the isa-debug-exit device.  So no sentinel byte can ever
     collide with real program output, and every byte on the serial port is
     collide with real program output, and every byte on the serial port is
     program output with nothing to strip;
     program output with nothing to strip;
+  * the exit code's VALUE is asserted too, not just that there was one.  Most
+    fixtures end at progend, which exits 0; a fixture that should leave through
+    the runtime error path instead (strcat's overflow exits 16) says so in a
+    `.exit' file next to its `.out';
   * the expected output is a file per fixture, next to the fixture, so a
   * the expected output is a file per fixture, next to the fixture, so a
     wrong expectation shows up as a diff instead of an inline string that
     wrong expectation shows up as a diff instead of an inline string that
     gets quietly edited to match.
     gets quietly edited to match.
@@ -235,7 +239,19 @@ def visible_output(raw):
 
 
 
 
 def cases():
 def cases():
-    """Every fixture that has a .out file, with its optional input."""
+    """Every fixture that has a .out file, with its optional input and exit code.
+
+    A fixture normally ends at progend, which exits through INT 21h AH=4Ch with
+    AL=0, so the expected code is 0.  But a program can also leave through the
+    RUNTIME ERROR path - strcat exits 16 when a concatenation would overflow
+    255 - and 16 is not 0.  Asserting the expected code is what makes "the
+    program stopped because it overflowed" a checked claim instead of a number
+    a human reads off the PASS line; without it, a program that stopped for the
+    wrong reason with the same bytes on the wire would still pass.
+
+    A fixture that should exit non-zero says so in a `.exit' file next to its
+    `.out', holding the decimal code and nothing else.
+    """
     fx = os.path.join(HERE, "fixtures")
     fx = os.path.join(HERE, "fixtures")
     for name in sorted(os.listdir(fx)):
     for name in sorted(os.listdir(fx)):
         if not name.endswith(".out"):
         if not name.endswith(".out"):
@@ -245,10 +261,15 @@ def cases():
         inpath = os.path.join(fx, stem + ".in")
         inpath = os.path.join(fx, stem + ".in")
         if os.path.exists(inpath):
         if os.path.exists(inpath):
             stdin = open(inpath, "rb").read()
             stdin = open(inpath, "rb").read()
+        expath = os.path.join(fx, stem + ".exit")
+        want_exit = 0
+        if os.path.exists(expath):
+            want_exit = int(open(expath).read().strip())
         yield {"name": stem,
         yield {"name": stem,
                "out": os.path.join(fx, name),
                "out": os.path.join(fx, name),
                "in": inpath if os.path.exists(inpath) else None,
                "in": inpath if os.path.exists(inpath) else None,
-               "stdin": stdin}
+               "stdin": stdin,
+               "exit": want_exit}
 
 
 
 
 def main(argv):
 def main(argv):
@@ -313,6 +334,11 @@ def main(argv):
             print("       got   %s" % visible_output(got))
             print("       got   %s" % visible_output(got))
             failed += 1
             failed += 1
             continue
             continue
+        if code != c["exit"]:
+            print("  %-22s FAIL  exit %d, but the program is expected to exit "
+                  "%d" % (c["name"], code, c["exit"]))
+            failed += 1
+            continue
         print("  %-22s PASS  %d bytes, exit %d"
         print("  %-22s PASS  %d bytes, exit %d"
               % (c["name"], len(got), code))
               % (c["name"], len(got), code))
         passed += 1
         passed += 1

+ 52 - 8
shell/tests/runtime.golden

@@ -41,7 +41,7 @@
 0036  58          pop ax
 0036  58          pop ax
 0037  F7 D8       neg ax
 0037  F7 D8       neg ax
 0039  B9 0A 00    mov cx,0ah
 0039  B9 0A 00    mov cx,0ah
-003C  BB A4 03    mov bx,3a4h
+003C  BB EB 03    mov bx,3ebh
 003F  89 DE       mov si,bx
 003F  89 DE       mov si,bx
 0041  31 D2       xor dx,dx
 0041  31 D2       xor dx,dx
 0043  F7 F1       div ax,cx
 0043  F7 F1       div ax,cx
@@ -73,18 +73,18 @@
 0072  83 7E 04 00 cmp word ptr [bp+4h],0h
 0072  83 7E 04 00 cmp word ptr [bp+4h],0h
 0076  89 EC       mov sp,bp
 0076  89 EC       mov sp,bp
 0078  75 05       jne 7fh
 0078  75 05       jne 7fh
-007A  BA A9 03    mov dx,3a9h
+007A  BA F0 03    mov dx,3f0h
 007D  EB 03       jmp 82h
 007D  EB 03       jmp 82h
-007F  BA A4 03    mov dx,3a4h
+007F  BA EB 03    mov dx,3ebh
 0082  B4 09       mov ah,9h
 0082  B4 09       mov ah,9h
 0084  CD 21       int 21h
 0084  CD 21       int 21h
 0086  5D          pop bp
 0086  5D          pop bp
 0087  C3          ret
 0087  C3          ret
-0088  BA B2 03    mov dx,3b2h
+0088  BA F9 03    mov dx,3f9h
 008B  B4 09       mov ah,9h
 008B  B4 09       mov ah,9h
 008D  CD 21       int 21h
 008D  CD 21       int 21h
 008F  C3          ret
 008F  C3          ret
-0090  BA AF 03    mov dx,3afh
+0090  BA F6 03    mov dx,3f6h
 0093  B4 09       mov ah,9h
 0093  B4 09       mov ah,9h
 0095  CD 21       int 21h
 0095  CD 21       int 21h
 0097  C3          ret
 0097  C3          ret
@@ -251,12 +251,12 @@
 01AB  EB EF       jmp 19ch
 01AB  EB EF       jmp 19ch
 01AD  58          pop ax
 01AD  58          pop ax
 01AE  C3          ret
 01AE  C3          ret
-01AF  8B 1E B8 03 mov bx,word ptr [3b8h]
+01AF  8B 1E FF 03 mov bx,word ptr [3ffh]
 01B3  83 FB 00    cmp bx,0h
 01B3  83 FB 00    cmp bx,0h
 01B6  74 09       je 1c1h
 01B6  74 09       je 1c1h
 01B8  8A C3       mov al,bl
 01B8  8A C3       mov al,bl
 01BA  31 DB       xor bx,bx
 01BA  31 DB       xor bx,bx
-01BC  89 1E B8 03 mov word ptr [3b8h],bx
+01BC  89 1E FF 03 mov word ptr [3ffh],bx
 01C0  C3          ret
 01C0  C3          ret
 01C1  B4 08       mov ah,8h
 01C1  B4 08       mov ah,8h
 01C3  CD 21       int 21h
 01C3  CD 21       int 21h
@@ -264,7 +264,7 @@
 01C6  88 C2       mov dl,al
 01C6  88 C2       mov dl,al
 01C8  BB 01 00    mov bx,1h
 01C8  BB 01 00    mov bx,1h
 01CB  8A DA       mov bl,dl
 01CB  8A DA       mov bl,dl
-01CD  89 1E B8 03 mov word ptr [3b8h],bx
+01CD  89 1E FF 03 mov word ptr [3ffh],bx
 01D1  C3          ret
 01D1  C3          ret
 01D2  55          push bp
 01D2  55          push bp
 01D3  8B EC       mov bp,sp
 01D3  8B EC       mov bp,sp
@@ -386,3 +386,47 @@
 0298  89 EC       mov sp,bp
 0298  89 EC       mov sp,bp
 029A  5D          pop bp
 029A  5D          pop bp
 029B  C3          ret
 029B  C3          ret
+029C  55          push bp
+029D  8B EC       mov bp,sp
+029F  50          push ax
+02A0  53          push bx
+02A1  51          push cx
+02A2  52          push dx
+02A3  56          push si
+02A4  57          push di
+02A5  8B 46 04    mov ax,word ptr [bp+4h]
+02A8  8B F0       mov si,ax
+02AA  8B 5E 06    mov bx,word ptr [bp+6h]
+02AD  31 D2       xor dx,dx
+02AF  8A 14       mov dl,byte ptr [si]
+02B1  31 C0       xor ax,ax
+02B3  8A 07       mov al,byte ptr [bx]
+02B5  01 C2       add dx,ax
+02B7  39 D1       cmp cx,dx
+02B9  73 06       jnb 2c1h
+02BB  B0 10       mov al,10h
+02BD  B4 4C       mov ah,4ch
+02BF  CD 21       int 21h
+02C1  8B CA       mov cx,dx
+02C3  88 0C       mov byte ptr [si],cl
+02C5  29 C2       sub dx,ax
+02C7  8B FE       mov di,si
+02C9  47          inc di
+02CA  01 D7       add di,dx
+02CC  43          inc bx
+02CD  89 C1       mov cx,ax
+02CF  E3 08       jcxz 2d9h
+02D1  8A 07       mov al,byte ptr [bx]
+02D3  88 05       mov byte ptr [di],al
+02D5  43          inc bx
+02D6  47          inc di
+02D7  E2 F8       loop 2d1h
+02D9  5F          pop di
+02DA  5E          pop si
+02DB  5A          pop dx
+02DC  59          pop cx
+02DD  5B          pop bx
+02DE  58          pop ax
+02DF  89 EC       mov sp,bp
+02E1  5D          pop bp
+02E2  C3          ret

+ 196 - 0
v-TP3-STRCAT.md

@@ -0,0 +1,196 @@
+v-TP3-STRCAT — Session summary
+==============================
+
+Tag:    v-TP3-STRCAT
+Commit: (the commit that adds this file)
+Covers: v-TP3-STRCAT
+
+This is the resume point for the session that completed "Next work" item 1c —
+string concatenation `+` — in full, with the test harness extensions that the
+change forced. Every claim below is pinned by fixtures in
+`shell/tests/fixtures/expected.tsv` and by the gate suite.
+
+What changed
+------------
+
+1. String concatenation — `a + b`, `writeln(a + b)`, `s := a + b`
+   (`v-TP3-STRCAT`).
+
+   TP3's `xconcat` (TPSRC2:963) builds the result in a scratch string, copies the
+   left operand into it, then appends the right (`addstr`/`addch`). The compiler
+   now does the same:
+
+   - `StrConcat` allocates a fresh 256-byte global scratch STRING per `+` in
+     the source (`NewScratchStr`: `@@SC` of length 256, created at `dc`; `dc +=
+     256`). The scratch is a `KVar` symbol of class `TString` (size 256).
+   - The result `ERes` becomes a **string variable** (kind 1), pointing at that
+     scratch (`res.idx := dest`). This matches how `Assignment`, `IoCall`,
+     `ParseCmp` already handle string operands; no new `ERes` kind was added.
+   - For the left operand: `EmPushStrOperand (left)` → for `TString` calls
+     `EmPushStrAddr`; for a CHAR (one-character literal, `char` variable, or
+     `s[i]` element) it builds a two-byte `<len><char>` on the stack in a
+     per-operand 2-byte scratch slot (`dc += 2`) and pushes its address. This is
+     how TP3 allows `s + 'a'` to be legal while `s = 'a'` is refused.
+   - Emit: `strstore(dest, left, 255)` (existing selector 17) copies left into
+     the scratch. Then `strcat(dest, right, 255)` (new selector 19) appends
+     right. Both share the same argument order as `strstore` (dest at `[BP+4]`,
+     src at `[BP+6]`, CX = maximum).
+   - Overflow: when the new length > 255, `strcat` branches to `concerr` and
+     leaves through `INT 21h AH=4Ch` with `AL=16` (TP3's "string too long").
+     The exit code is now asserted by the execution harness via a per-fixture
+     `.exit` sidecar (default 0).
+
+2. The type rule for string `+`.
+
+   The hook at the **head of `BinOpEmit`** was originally:
+   ```
+   IF (left.cls = TString) OR (right.cls = TString) THEN
+      StrConcat (...)
+   END
+   ```
+   That sent `'a' + 'b'` down the integer path (both are `TScalar`+`chr`,
+   `cls != TString`) producing `CHR(195)` — a silently wrong program, not an
+   error. It now tests the same `StrOperand` predicate that `StrConcat` guards
+   with:
+   ```
+   IF (StrOperand (left) OR StrOperand (right)) THEN
+      StrConcat (...)
+   END
+   ```
+   where `StrOperand(r) := (r.cls = TString) OR (r.cls = TChar) OR
+   ((r.cls = TScalar) AND r.chr)`. This is a **forward-declared** function next
+   to `StrConcat` (added at line 1916). With this hook, two CHARs, or a string
+   plus a number, reach `StrConcat` and are rejected by its guard as
+   `ETypeErr 56`. `t53_strcat_type` (`'a' + 'b'`) pins the refusal; it was
+   **red before the hook change** (ran through integer path) and is green after.
+
+   `StrConcat`'s error path now leaves a **well-formed non-string placeholder**
+   (`res.kind = 0`, `res.cls = TScalar`, `res.imm = 0`) rather than a half-built
+   kind-2/TString with an uninitialised `idx`. That is the invariant: if Err()
+   was called (and abortFac set), the returned `ERes` must not claim to be a
+   string, because string consumers dereference `symtab[res.idx]` for any
+   `TString`.
+
+3. Guard against using failed expression results.
+
+   The compiler's idiom is: after `ParseExpr`, check `IF NOT OK () THEN RETURN
+   END` before dereferencing any symbol from the returned `ERes`. That guard was
+   missing in `IoCall`'s argument loop: when a failed concat returned (kind-2/
+   TString, idx garbage) the write arm did
+   `EmPushVarAddr (symtab [arg.idx].local, symtab [arg.idx].off)`. With the
+   hook now routing error cases into `StrConcat`, `writeln ('a' + 'b')` became a
+   compiler segfault. Adding the `OK ()` guard after `ParseExpr (arg)` in
+   `IoCall` (mirroring `ParseSub`) stops consuming a failed argument and lets the
+   statement loop terminate via `abortFac`. With the safe placeholder in
+   `StrConcat`, nested cases such as `('a' + 'b') + s` also report the first
+   error cleanly.
+
+4. Runtime: `strcat` (selector 19).
+
+   `Runtime.mod` gains `EmitStrCat` which appends the source string to the
+   destination. The implementation preserves **AX,BX,CX,DX,SI,DI** (pushes all
+   six) because the compiler may hold a string element address in `DI` across the
+   call (e.g. `s := s + s[i]` in effect, or expressions that push next operands
+   after a string operation). The path is:
+   - check `CX` (max) <= 255
+   - load `lenD` from `[BP+4]` (destination length byte), `lenS` from `[BP+6]`
+   - `newLen = lenD + lenS`; if `newLen > CX` → `concerr` (exit 16)
+   - else copy `lenS` chars from `src[1]..` to `dst[1 + lenD]..`, set `dst[0] =
+     newLen`, return
+   - `concerr`: `MOV AL,16H; MOV AH,4CH; INT 21H` (6 bytes)
+
+   The runtime's entry table grows to 20 entries; `RT_Entry`/`RT_Build` register
+   entry 19 as `strcat`. `RtProbe.mod` extends the name table to index 19.
+   `check_runtime.py` and `runtime.golden` were reblessed accordingly.
+
+5. Safety guards: HALT on full label/fixup tables.
+
+   `Runtime.mod`'s `MaxLbl` was 64 → **96**, `MaxFix` 400 → **512**. The
+   procedures `M` (add a label) and `AddFix` (add a fixup) now call `HALT` when
+   full instead of silently dropping, so a blown table produces a clean abort
+   rather than a subtly wrong runtime blob.
+
+6. Boot sector output: use SI as cursor.
+
+   `bootcom.s`'s `INT 21h AH=09h` handler kept its cursor at `0702h` (the first
+   byte of the loaded program image at `0602h` in the load window), so writing a
+   CRLF overwrote the start of the loaded code (turning `E8 1A` into a wild
+   jump). The handler now uses `SI` as its cursor and only writes to the video
+   buffer via ES/DI; this removes the code-window limit and fixes the hang seen
+   during bring-up.
+
+7. Execution harness: per-fixture exit codes.
+
+   `tests/run_com_exec.py` now reads a `.exit` sidecar (decimal integer, default
+   0) per fixture (`stem + ".exit"`) via `cases()`, and asserts
+   `exit_code_of(rc) == c["exit"]` after the output comparison. The module
+   docstring documents the convention. This is how `t55_strcat_overflow` asserts
+   exit code 16 while still checking its partial output (`read\r\n`).
+
+Tests
+-----
+
+New fixtures:
+- `t51_strcat.pas` — all operand pairings (var+var, literal+var, var+literal,
+  var+char, char+var, nested concatenation in arguments/assignment), covering
+  multiple consumers (`writeln`, assignment, comparison context). Output committed
+  byte-for-byte.
+- `t52_strcat_nest.pas` — nested `a + b + '!'`, concatenation compared to a
+  string, and a string **element** as a `+` operand. Output committed.
+- `t53_strcat_type.pas` — error: `'a' + 'b'` (two CHARs). Expected `ERR 56 663`.
+- `t54_strcat_strnum.pas` — error: `s + 1` (string + number). Expected `ERR 56
+  463`.
+- `t55_strcat_overflow.pas` — `readln` 128 characters, then `s := s + s` (length
+  becomes 256, >255) → runtime exit 16. Input 128×`x`+LF in `.in`, output
+  `read\r\n` in `.out`, `.exit` `16`.
+
+`expected.tsv` rows for t51–t55 with their verdicts, code/data bytes, and error
+positions (the `pos` is the 0-based offset of the lookahead token when `Err`
+fires).
+
+Gates: `run_compile_tests.sh` 56/56; `run_com_tests.sh` 48/48; `run_com_exec.py`
+48/48 (t55 has exit 16 asserted); `rt_exec.py` 56/56; `check_runtime.py` PASS;
+`check_8086.py` PASS; `nonvacuity.sh` 78 ok/0 failed; `run_all.sh` OVERALL ALL
+PASS.
+
+How to verify
+-------------
+
+    cd shell && make                               # tpshell rebuilt, clean
+    cd shell && tests/run_compile_tests.sh         # 56 passed, 0 failed
+    cd shell && tests/run_com_exec.py              # 48 passed, 0 failed
+    cd shell && tests/rt_exec.py                   # 56 passed, 0 failed
+    cd shell && tests/check_runtime.py             # PASS
+    cd shell && tests/check_8086.py                # PASS
+    cd shell && tests/nonvacuity.sh                # 78 ok, 0 failed
+    cd shell && tests/run_all.sh                   # OVERALL: ALL PASS
+
+At this tag the suite reports:
+
+    compile matrix: 56 passed, 0 failed (of 56)
+    independent .COM check: 48 checked, 0 failed
+    execution: 48 passed, 0 failed (of 48) (t55 asserts exit 16 via .exit)
+    exec86:    48 passed, 0 failed (of 48), cross-checked against qemu
+    runtime entries: 56 passed, 0 failed (of 56) (55 cases + BP pre-flight)
+    runtime: 770 bytes, code 0..738 (739), 20 entries, 65 branches checked
+    check_8086: runtime 770/420, program code 48/48 (9692 bytes), clause H 11/11
+    nonvacuity: 78 ok, 0 failed
+    OVERALL: ALL PASS
+
+Notes
+-----
+
+- The `-fgen-module-list ... || true` link step prints a roll-up error from
+  `Compiler.mod` during the final link of `tpshell`; this is the expected pass-3
+  summary and does **not** indicate a compilation failure (`Compiler.o` was
+  built successfully).
+- `compiletest` is rebuilt when its inputs are newer than the binary (the harness
+  checks staleness). After modifying `Compiler.mod`, `run_compile_tests.sh` will
+  rebuild `compiletest`.
+- The commit message for the code+test changes should name: the `bootcom.s`
+  AH=09h cursor fix (use SI), the `Runtime.mod` `MaxLbl`/`MaxFix` HALT guards
+  and the table increases, the `BinOpEmit` hook change to use `StrOperand`
+  (fixing the `'a' + 'b'` silent wrong program), the `IoCall` `OK()` guard and
+  the `StrConcat` safe-placeholder fix (eliminating the compiler segfault), the
+  new runtime entry `strcat` (selector 19) and register preservation, the
+  `run_com_exec.py` `.exit` sidecar convention, and the new fixtures t51–t55.

Некоторые файлы не были показаны из-за большого количества измененных файлов