|
@@ -63,12 +63,6 @@ END EnterMod;
|
|
|
PROCEDURE Allocate(VAR a:ADDRESS; n:CARDINAL); (* was in Z80 code *)
|
|
PROCEDURE Allocate(VAR a:ADDRESS; n:CARDINAL); (* was in Z80 code *)
|
|
|
BEGIN
|
|
BEGIN
|
|
|
ALLOCATE(a, n);
|
|
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;
|
|
END Allocate;
|
|
|
|
|
|
|
|
PROCEDURE GetStack(VAR m: ADDRESS);
|
|
PROCEDURE GetStack(VAR m: ADDRESS);
|
|
@@ -95,43 +89,66 @@ BEGIN
|
|
|
current := current^.link0;
|
|
current := current^.link0;
|
|
|
END;
|
|
END;
|
|
|
RETURN NIL;
|
|
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;
|
|
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;
|
|
TYPE ByteVec = POINTER TO ARRAY [0..32767] OF CHAR;
|
|
|
PROCEDURE StrCmp(a, b: ADDRESS; c: BOOLEAN):BOOLEAN;
|
|
PROCEDURE StrCmp(a, b: ADDRESS; c: BOOLEAN):BOOLEAN;
|
|
|
VAR x, y: ByteVec;
|
|
VAR x, y: ByteVec;
|
|
|
|
|
+ ch1, ch2: CHAR;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
x := a; y := b;
|
|
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;
|
|
END;
|
|
|
- RETURN FALSE;
|
|
|
|
|
END StrCmp;
|
|
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;
|
|
END StrLen;
|
|
|
|
|
|
|
|
PROCEDURE CopyStr(VAR d: ADDRESS; VAR s: ARRAY OF CHAR);
|
|
PROCEDURE CopyStr(VAR d: ADDRESS; VAR s: ARRAY OF CHAR);
|
|
|
VAR length: CARDINAL;
|
|
VAR length: CARDINAL;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- length := StrLen(s);
|
|
|
|
|
|
|
+ length := StrLen(ADR(s), HIGH(s));
|
|
|
Allocate(d, length+1);
|
|
Allocate(d, length+1);
|
|
|
MOVE(ADR(s), d, length);
|
|
MOVE(ADR(s), d, length);
|
|
|
END CopyStr;
|
|
END CopyStr;
|
|
@@ -260,16 +277,12 @@ BEGIN
|
|
|
INC(column);
|
|
INC(column);
|
|
|
IF flag # 0 THEN
|
|
IF flag # 0 THEN
|
|
|
Texts.WriteChar(3, ch);
|
|
Texts.WriteChar(3, ch);
|
|
|
- RETURN; RETURN; (* padding *)
|
|
|
|
|
|
|
+ RETURN;
|
|
|
END;
|
|
END;
|
|
|
END;
|
|
END;
|
|
|
EchoChar
|
|
EchoChar
|
|
|
END;
|
|
END;
|
|
|
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;
|
|
END NextCh;
|
|
|
|
|
|
|
|
PROCEDURE GetSym;
|
|
PROCEDURE GetSym;
|
|
@@ -390,7 +403,9 @@ PROCEDURE GetSym;
|
|
|
END; (* 0577 *)
|
|
END; (* 0577 *)
|
|
|
IF litType = Compiler.RealType THEN
|
|
IF litType = Compiler.RealType THEN
|
|
|
IF decVal >= 16777216L
|
|
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)
|
|
ELSE realVal := FLOAT(decVal)
|
|
|
END;
|
|
END;
|
|
|
IF expAdj < 0 THEN realVal := realVal / Power10(-expAdj)
|
|
IF expAdj < 0 THEN realVal := realVal / Power10(-expAdj)
|
|
@@ -484,8 +499,6 @@ PROCEDURE GetSym;
|
|
|
RETURN TRUE
|
|
RETURN TRUE
|
|
|
END; (* 0730 *)
|
|
END; (* 0730 *)
|
|
|
RETURN FALSE;
|
|
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;
|
|
END ScanNext;
|
|
|
|
|
|
|
|
VAR tokDone: BOOLEAN;
|
|
VAR tokDone: BOOLEAN;
|