|
@@ -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])
|