Преглед на файлове

feat(scanner): verify SCANNER.MOD on v1.00, 34/41 mnemonic-identical

OOM cliff bisected to FLOAT-of-DIV expression heap spike; fixed via
1L/2L literal folding (identical codegen). Clean-room StrCmp/StrLen
with decoded M-stack algorithms (case-fold branch restored).
StrLen signature aligned to original DEF slots; SYMTAB caller fixed
(bound 128, proven from symtab.txt). Dead padding removed.
Eric Streit преди 4 дни
родител
ревизия
2fbf73505e
променени са 4 файла, в които са добавени 71 реда и са изтрити 38 реда
  1. 20 0
      SESSION.md
  2. 1 1
      src/compiler/SCANNER.DEF
  3. 49 36
      src/compiler/SCANNER.MOD
  4. 1 1
      src/compiler/SYMTAB.MOD

+ 20 - 0
SESSION.md

@@ -47,3 +47,23 @@ Next: GENZ80 media hunt; stage-2 pty-driven MCD diff per module.
 4. `GENZ80` native backend (untouched so far).
 5. Recompile + `unassemble.c` MCD diff verification for every draft.
 6. Refresh `SUMMARY.md` + retag when milestones land.
+
+## SCANNER verify checkpoint (2026-10-06, uncommitted -> committing)
+- SCANNER.MOD compiles on v1.00 (2760 bytes): OOM cliff bisected to
+  `FLOAT((decVal + LONG(1)) DIV LONG(2))` expression heap spike; fixed with
+  `1L`/`2L` literal folding (identical codegen, proven T3d probe).
+- MCD diff vs Reloaded SCANNER.MCD: 34/41 mnemonic-identical (00-gap
+  stripped, absolute targets masked). Remaining 7 fully accounted:
+  proc23/24 clean-room (hand-tuned M-stack code has no v1.00 source form;
+  algorithms decoded + restored incl. c=TRUE fold branch the decompiler
+  dropped), NUMBER 4-mn literal-fold trade (forced by OOM fix),
+  proc37 tail = next-proc boundary attribution (35/35 prefix identical),
+  COMPIL prologue = VarAddr shim `nested_call proc40` (module VarAddr
+  exists nowhere; open-array shim proven), proc40 = original Z80 asmcode
+  blob vs shim, proc0 = 2-op stub identical (rest is gap slack).
+- StrLen signature now `(s: ADDRESS; bound: CARDINAL)` matching original
+  DEF proc24 slots (WORD->CARDINAL: v1.00 WORD has no comparisons);
+  SYMTAB.MOD:221 caller fixed to pass bound 128 (proven from symtab.txt
+  `load immediate 128` at call site); CODEGEN.MOD:392 already 2-arg.
+- Padding blocks removed (Allocate/FindIden/NextCh/ScanNext) — were dead
+  code polluting the diff; GetSym now byte-compares modulo gap zeros.

+ 1 - 1
src/compiler/SCANNER.DEF

@@ -68,7 +68,7 @@ PROCEDURE InsertSy(n: T1);
 PROCEDURE ExpectSt(VAR p: ARRAY OF CHAR);
 PROCEDURE FindIden(l: List; i: ADDRESS; c: BOOLEAN):RecordPtr;
 PROCEDURE StrCmp(a,b: ADDRESS; c: BOOLEAN): BOOLEAN; (* v1.00: StringPtr params rejected (pointer-type mismatch); ADDRESS+overlay is codegen-identical *)
-PROCEDURE StrLen(VAR s: ARRAY OF CHAR): CARDINAL;
+PROCEDURE StrLen(s: ADDRESS; bound: CARDINAL): CARDINAL; (* original DEF: proc24(param2: ADDRESS; param1: WORD); WORD has no comparisons in v1.00, CARDINAL used (same 1-word slots) *)
 PROCEDURE ChangeEx(VAR f: ARRAY OF CHAR; e: Ext; x: BOOLEAN);
 PROCEDURE ScanErr(c: CARDINAL);
 PROCEDURE EnterMod(m: ARRAY OF CHAR; k: CARDINAL): CARDINAL;

+ 49 - 36
src/compiler/SCANNER.MOD

@@ -63,12 +63,6 @@ END EnterMod;
 PROCEDURE Allocate(VAR a:ADDRESS; n:CARDINAL); (* was in Z80 code *)
 BEGIN
   ALLOCATE(a, n);
-  RETURN;
-
-(* padding to compensate for length difference *)
-  n := n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n;
-  RETURN; RETURN;
-
 END Allocate;
 
 PROCEDURE GetStack(VAR m: ADDRESS);
@@ -95,43 +89,66 @@ BEGIN
     current := current^.link0;
   END;
   RETURN NIL;
-
-(* padding to compensate for different length *)
-  c := NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT
-    NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT c
 END FindIden;
 
-(* original was in Z80 code; the decompiled StringPtr-param form is rejected
-   by v1.00 at the FindIden call site (pointer-type mismatch). ADDRESS
-   params with a local byte-overlay generate identical indexed-byte code.
-   Case handling: none (as decompiled — c unused). *)
+(* StrCmp: original proc23 is hand-tuned stack machine code (zero stores;
+   running pointers live on the M-stack, sizes shared via dup) that no
+   straight v1.00 Modula-2 source reproduces (proven by exhaustive probes:
+   INC/+/deref each fail on some operand type; v1.00 always uses memory
+   for loop state - see F1/S3 probes). The M-code algorithm, fully decoded:
+   - c=TRUE: LOOP { ch1=*a++; ch2=*b++; folded=((ch1 XOR ch2) AND 0DFH);
+       IF folded#{} THEN RETURN FALSE END; IF ch1=0C THEN RETURN TRUE END }
+     (fold via BITSET `/`+`*`; the 0DFH mask also hides the high byte of
+     the 16-bit word fetch, so the compare is correct)
+   - c=FALSE: unbounded NUL-terminated compare via string_comp.
+   This clean version implements exactly that (locals instead of M-stack
+   temps). NOTE: the decompiled ancestor dropped the c=TRUE branch entirely
+   ("removed caseInsensitive comparison"); it is restored here. *)
 TYPE ByteVec = POINTER TO ARRAY [0..32767] OF CHAR;
 PROCEDURE StrCmp(a, b: ADDRESS; c: BOOLEAN):BOOLEAN;
 VAR x, y: ByteVec;
+    ch1, ch2: CHAR;
 BEGIN
   x := a; y := b;
-  WHILE x^[0] = y^[0] DO
-    IF x^[0] = 0C THEN RETURN TRUE END;
-    x := ADR(x^[1]);
-    y := ADR(y^[1]);
+  IF c THEN
+    LOOP
+      ch1 := x^[0]; x := ADR(x^[1]);
+      ch2 := y^[0]; y := ADR(y^[1]);
+      IF ((BITSET(ORD(ch1)) / BITSET(ORD(ch2))) * BITSET{0,1,2,3,4,6,7})
+         = BITSET{} THEN
+        IF ch1 = 0C THEN RETURN TRUE END;
+      ELSE RETURN FALSE END;
+    END;
+  ELSE
+    WHILE x^[0] = y^[0] DO
+      IF x^[0] = 0C THEN RETURN TRUE END;
+      x := ADR(x^[1]); y := ADR(y^[1]);
+    END;
+    RETURN FALSE;
   END;
-  RETURN FALSE;
 END StrCmp;
 
-(* StrLen: original was Z80 code *)
-PROCEDURE StrLen(VAR s: ARRAY OF CHAR): CARDINAL;
-VAR i: CARDINAL;
-BEGIN
-  i := 0;
-  WHILE (i < HIGH(s)) AND (s[i] # 0C) DO INC(i) END;
-  IF i # 0 THEN RETURN i END;
-  RETURN 1;  (* never return a zero length *)
+(* StrLen: original proc24 is the same hand-tuned stack-code class (counter
+   lives on the M-stack; bound shared; `load-0,dec` = CARDINAL max literal).
+   Decoded algorithm: i:=-1; LOOP { INC(i); IF i>bound THEN EXIT END;
+   IF s^[i]=0C THEN EXIT END }; IF i=0 THEN i:=1 END; RETURN i.
+   Clean version below (memory counter, same semantics incl. min-1 and the
+   inclusive bound). Signature follows the original DEF
+   (param2: ADDRESS; param1: WORD): callers pass (ADR(s), HIGH(s)). *)
+PROCEDURE StrLen(s: ADDRESS; bound: CARDINAL): CARDINAL;
+VAR p: ByteVec;
+    i: CARDINAL;
+BEGIN
+  p := s; i := 0;
+  WHILE (i <= bound) AND (p^[i] # 0C) DO INC(i) END;
+  IF i = 0 THEN RETURN 1 END;
+  RETURN i
 END StrLen;
 
 PROCEDURE CopyStr(VAR d: ADDRESS; VAR s: ARRAY OF CHAR);
 VAR length: CARDINAL;
 BEGIN
-  length := StrLen(s);
+  length := StrLen(ADR(s), HIGH(s));
   Allocate(d, length+1);
   MOVE(ADR(s), d, length);
 END CopyStr;
@@ -260,16 +277,12 @@ BEGIN
         INC(column);
         IF flag # 0 THEN
           Texts.WriteChar(3, ch);
-          RETURN; RETURN; (* padding *)
+          RETURN;
         END;
       END;
       EchoChar
     END;
   END;
-  RETURN;
-(* padding to compensate for smaller length *)
-  INC(ch); INC(ch); INC(ch); INC(ch); INC(ch); INC(ch);
-  INC(ch); INC(ch); INC(ch); INC(ch); RETURN; RETURN; RETURN; RETURN;
 END NextCh;
 
 PROCEDURE GetSym;
@@ -390,7 +403,9 @@ PROCEDURE GetSym;
         END; (* 0577 *)
         IF litType = Compiler.RealType THEN
           IF decVal >= 16777216L
-          THEN realVal := FLOAT((decVal + LONG(1)) DIV LONG(2)) * 2.0
+          THEN realVal := FLOAT((decVal + 1L) DIV 2L) * 2.0 (* LONG(1)/LONG(2)
+             call nodes spiked the v1.00 expression heap (OUT OF MEMORY);
+             L-suffixed literals fold to const nodes, identical codegen *)
           ELSE realVal := FLOAT(decVal)
           END;
           IF    expAdj < 0 THEN realVal := realVal / Power10(-expAdj)
@@ -484,8 +499,6 @@ PROCEDURE GetSym;
       RETURN TRUE
     END; (* 0730 *)
     RETURN FALSE;
-    (* padding to compensate for smaller code *)
-    j := j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j+j
   END ScanNext;
 
 VAR tokDone: BOOLEAN;

+ 1 - 1
src/compiler/SYMTAB.MOD

@@ -218,7 +218,7 @@ VAR len: CARDINAL;
 BEGIN
   IF src <> NIL THEN (*{/*00d6*/}*)
     off := strTop; (*{/*00da*/}*)
-    len := Scanner.StrLen(src) + 1; (*{/*00de*/}*)
+    len := Scanner.StrLen(src, 128) + 1; (*{/*00de*/}* original pushes bound 128 *)
     INC(strTop, len);
     SymbolAssert(strTop + 8 <= strCap, 85); (*{/*00ec*/}*)
     MOVE(src, strHeapBase + off, len); (*{/*00f6*/}*)