|
|
@@ -176,7 +176,9 @@ TYPE
|
|
|
RECORD
|
|
|
cls : CARDINAL ;
|
|
|
kind : CARDINAL ; (* 0 const, 1 var, 2 value in AX,
|
|
|
- 3 string literal (cls = TString) *)
|
|
|
+ 3 string literal (cls = TString),
|
|
|
+ 4 value on the stack (SaveLeft),
|
|
|
+ 5 string element, address in DI *)
|
|
|
imm : LONGINT ;
|
|
|
idx : CARDINAL ;
|
|
|
boff : CARDINAL ; (* constant fold-in for subscripts *)
|
|
|
@@ -834,7 +836,7 @@ BEGIN
|
|
|
Ebyte (48H)
|
|
|
END EmDecAx ;
|
|
|
|
|
|
-PROCEDURE EmBpDisp (off : CARDINAL) ;
|
|
|
+PROCEDURE EmBpDisp (off, regf : CARDINAL) ;
|
|
|
(* Emit the ModR/M byte and displacement for a [BP+off] operand, picking the
|
|
|
encoding from the size of off. This is the ONE place that choice is made,
|
|
|
because getting it wrong is invisible: 8B 46 d8 and 8B 86 lo hi are both
|
|
|
@@ -865,10 +867,14 @@ PROCEDURE EmBpDisp (off : CARDINAL) ;
|
|
|
broken -- a bug nobody had hit yet, which is exactly why it wanted a
|
|
|
test rather than an argument. *)
|
|
|
BEGIN
|
|
|
+ (* mod=01 rm=110 -> 40H + regf*8 + 6H, mod=10 rm=110 -> 80H + regf*8 + 6H.
|
|
|
+ regf is the ModR/M reg field: 0 when the opcode's register is the
|
|
|
+ accumulator (every original caller), 7 for the DI forms EmLeaDi needs.
|
|
|
+ rm is 110 ([BP+disp]) in both. *)
|
|
|
IF off <= 127 THEN
|
|
|
- Ebyte (46H) ; Ebyte (VAL (BYTE, off))
|
|
|
+ Ebyte (VAL (BYTE, 40H + regf * 8 + 6H)) ; Ebyte (VAL (BYTE, off))
|
|
|
ELSE
|
|
|
- Ebyte (86H) ; Eword (off)
|
|
|
+ Ebyte (VAL (BYTE, 80H + regf * 8 + 6H)) ; Eword (off)
|
|
|
END
|
|
|
END EmBpDisp ;
|
|
|
|
|
|
@@ -879,13 +885,13 @@ PROCEDURE EmLoadVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
|
|
|
BEGIN
|
|
|
IF nbytes = 1 THEN
|
|
|
IF local THEN
|
|
|
- Ebyte (8AH) ; EmBpDisp (off)
|
|
|
+ Ebyte (8AH) ; EmBpDisp (off, 0)
|
|
|
ELSE
|
|
|
Ebyte (0A0H) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
END
|
|
|
ELSE
|
|
|
IF local THEN
|
|
|
- Ebyte (8BH) ; EmBpDisp (off)
|
|
|
+ Ebyte (8BH) ; EmBpDisp (off, 0)
|
|
|
ELSE
|
|
|
Ebyte (0A1H) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
END
|
|
|
@@ -896,13 +902,13 @@ PROCEDURE EmStoreVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
|
|
|
BEGIN
|
|
|
IF nbytes = 1 THEN
|
|
|
IF local THEN
|
|
|
- Ebyte (88H) ; EmBpDisp (off)
|
|
|
+ Ebyte (88H) ; EmBpDisp (off, 0)
|
|
|
ELSE
|
|
|
Ebyte (0A2H) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
END
|
|
|
ELSE
|
|
|
IF local THEN
|
|
|
- Ebyte (89H) ; EmBpDisp (off)
|
|
|
+ Ebyte (89H) ; EmBpDisp (off, 0)
|
|
|
ELSE
|
|
|
Ebyte (0A3H) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
END
|
|
|
@@ -918,13 +924,52 @@ PROCEDURE EmPushVarAddr (local : BOOLEAN ; off : CARDINAL) ;
|
|
|
are displacements and so do not. *)
|
|
|
BEGIN
|
|
|
IF local THEN
|
|
|
- Ebyte (8DH) ; EmBpDisp (off)
|
|
|
+ Ebyte (8DH) ; EmBpDisp (off, 0)
|
|
|
ELSE
|
|
|
Ebyte (8DH) ; Ebyte (06H) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
END ;
|
|
|
EmPushAx ()
|
|
|
END EmPushVarAddr ;
|
|
|
|
|
|
+PROCEDURE EmLeaDi (local : BOOLEAN ; off : CARDINAL) ;
|
|
|
+(* LEA DI,[BP+disp] / LEA DI,[off] - the run-time address of an indexed
|
|
|
+ string's element, computed once in ParseSub and read by LoadAtom,
|
|
|
+ Assignment and IoCall.
|
|
|
+
|
|
|
+ It is the same three encodings EmPushVarAddr uses for AX - 8D 7E disp8,
|
|
|
+ 8D BE disp16, 8D 3E off - with the ModR/M reg field set to DI (111)
|
|
|
+ instead of the accumulator, which is why EmBpDisp now takes that field and
|
|
|
+ this is still the one place the disp8/disp16 choice is made. A local is
|
|
|
+ [BP+disp] with no bias; a global is [off] and carries LoadBias, absolute.
|
|
|
+
|
|
|
+ The later `MOV AL,[DI]` / `MOV [DI],AL` read through DS rather than SS.
|
|
|
+ That is correct here for the same reason TP3's own string ops use DI with
|
|
|
+ the default segment: a .COM loads with DS=SS=CS=ES, and nothing in this
|
|
|
+ compiler or its runtime ever reloads a segment register, so a BP-relative
|
|
|
+ frame address held in DI addresses the same byte. *)
|
|
|
+BEGIN
|
|
|
+ IF local THEN
|
|
|
+ Ebyte (8DH) ; EmBpDisp (off, 7)
|
|
|
+ ELSE
|
|
|
+ Ebyte (8DH) ; Ebyte (3EH) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
+ END
|
|
|
+END EmLeaDi ;
|
|
|
+
|
|
|
+PROCEDURE EmAddDiAx () ;
|
|
|
+BEGIN Ebyte (01H) ; Ebyte (0C7H) END EmAddDiAx ; (* 01 C7: DI := DI + AX *)
|
|
|
+
|
|
|
+PROCEDURE EmLdAlDi () ;
|
|
|
+BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ; (* 8A 05: AL := [DI] *)
|
|
|
+
|
|
|
+PROCEDURE EmStDiAl () ;
|
|
|
+BEGIN Ebyte (88H) ; Ebyte (05H) END EmStDiAl ; (* 88 05: [DI] := AL *)
|
|
|
+
|
|
|
+PROCEDURE EmPushDi () ;
|
|
|
+BEGIN Ebyte (57H) END EmPushDi ; (* PUSH DI *)
|
|
|
+
|
|
|
+PROCEDURE EmPopDi () ;
|
|
|
+BEGIN Ebyte (5FH) END EmPopDi ; (* POP DI *)
|
|
|
+
|
|
|
PROCEDURE EmSubSp (n : CARDINAL) ;
|
|
|
BEGIN
|
|
|
Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
|
|
|
@@ -1655,6 +1700,20 @@ BEGIN
|
|
|
r.kind := 2 ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ (* A string element with a variable index: ParseSub already computed its
|
|
|
+ address into DI (LEA DI,[base] / ADD DI,AX), so the byte is at [DI].
|
|
|
+ Zeroing AH keeps the value a clean 16-bit char, the same thing the
|
|
|
+ size-1 load below does, because every consumer of a CHAR expects the
|
|
|
+ high half to be zero. The read must happen HERE, before anything
|
|
|
+ else is emitted: the caller reaches this immediately after parsing
|
|
|
+ the subscript, or - for a binary operator - SaveLeft has already
|
|
|
+ materialised it, so DI is still the element's address. *)
|
|
|
+ EmLdAlDi () ;
|
|
|
+ EmMovAh0 () ;
|
|
|
+ r.kind := 2 ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF r.kind = 0 THEN
|
|
|
EmMovAxi (W16 (r.imm)) ;
|
|
|
r.kind := 2
|
|
|
@@ -1681,8 +1740,15 @@ BEGIN
|
|
|
END LoadAtom ;
|
|
|
|
|
|
PROCEDURE ParseSub (VAR r : ERes) ;
|
|
|
-(* consume '[' constExpr ']' while present, folding the index into the
|
|
|
- base offset (constant indexing only) *)
|
|
|
+(* consume '[' expr ']' while present.
|
|
|
+
|
|
|
+ A CONSTANT index folds into the base offset boff, exactly as before. A
|
|
|
+ VARIABLE index on a STRING cannot fold - off+i is a run-time value - so it
|
|
|
+ is computed once here into DI and r.kind drops to 5, which is how LoadAtom,
|
|
|
+ Assignment and IoCall are told the element's address is in DI. Arrays
|
|
|
+ still accept only a constant index: a variable array subscript needs the
|
|
|
+ element-size scaling that a one-byte string element does not, and it is
|
|
|
+ item 2. *)
|
|
|
VAR t : ERes ;
|
|
|
BEGIN
|
|
|
LOOP
|
|
|
@@ -1693,28 +1759,42 @@ BEGIN
|
|
|
DropCh (GetCh ()) ;
|
|
|
ParseExpr (t) ;
|
|
|
IF OK () THEN
|
|
|
- IF t.kind # 0 THEN
|
|
|
- Err (ENoLib) ;
|
|
|
- RETURN
|
|
|
- END ;
|
|
|
- IF symtab [r.idx].cls = TArray THEN
|
|
|
- r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
- + t.imm * VAL (LONGINT, symtab [r.idx].elem))
|
|
|
- ELSIF symtab [r.idx].cls = TString THEN
|
|
|
+ IF symtab [r.idx].cls = TString THEN
|
|
|
(* s[i]: a STRING is a length byte at s[0] followed by the
|
|
|
- characters (TPSRC8's `string' type), so index i selects the one
|
|
|
- byte at off+i. A constant index folds into boff exactly as an
|
|
|
- array's does, and r.cls drops to TChar so every consumer below
|
|
|
- - LoadAtom, Assignment, IoCall - sees a one-byte value instead
|
|
|
- of the whole string. A second subscript on a character is not
|
|
|
- a type. A variable index reaches here only after failing the
|
|
|
- `t.kind # 0' test above and is ENoLib, same as an array's. *)
|
|
|
+ characters, so index i selects the one byte at off+i. A second
|
|
|
+ subscript on a character is not a type. *)
|
|
|
IF r.cls = TChar THEN
|
|
|
Err (ESimpType) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- r.boff := W16 (VAL (LONGINT, r.boff) + t.imm) ;
|
|
|
+ IF t.kind = 0 THEN
|
|
|
+ (* constant index: fold it into boff, as an array's does, and
|
|
|
+ r.cls drops to TChar so every consumer below - LoadAtom,
|
|
|
+ Assignment, IoCall - sees a one-byte value instead of the
|
|
|
+ whole string. *)
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff) + t.imm)
|
|
|
+ ELSE
|
|
|
+ (* Variable index. Compute the element address once, now:
|
|
|
+ the index is evaluated into AX (LoadAtom is a no-op for a
|
|
|
+ kind-2 value and re-reads [DI] for a nested subscript), then
|
|
|
+ DI := base + AX. This is TP3's indstr/ialoop shape (TPSRC9
|
|
|
+ 1100-1111, 1200-1229), which likewise holds the address in
|
|
|
+ DI until the byte is loaded or stored; a register is what
|
|
|
+ lets a later LoadAtom read [DI] and a later assignment PUSH
|
|
|
+ DI across its right-hand side. *)
|
|
|
+ LoadAtom (t) ;
|
|
|
+ EmLeaDi (symtab [r.idx].local,
|
|
|
+ (symtab [r.idx].off + r.boff) MOD 10000H) ;
|
|
|
+ EmAddDiAx () ;
|
|
|
+ r.kind := 5
|
|
|
+ END ;
|
|
|
r.cls := TChar
|
|
|
+ ELSIF t.kind # 0 THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
+ + t.imm * VAL (LONGINT, symtab [r.idx].elem))
|
|
|
ELSE
|
|
|
Err (ESimpType) ;
|
|
|
RETURN
|
|
|
@@ -1894,6 +1974,19 @@ BEGIN
|
|
|
IF left.kind = 2 THEN
|
|
|
EmPushAx () ;
|
|
|
left.kind := 4 (* 4 = on the top of the stack *)
|
|
|
+ ELSIF left.kind = 5 THEN
|
|
|
+ (* A string element whose address is in DI. This is the one place the
|
|
|
+ address must be spent BEFORE the right-hand operand is parsed: DI
|
|
|
+ cannot survive it, because the right operand may hold a subscript of
|
|
|
+ its own (which reuses DI) or call a routine (which may clobber it).
|
|
|
+ Reading [DI] now - which LoadAtom does, turning kind 5 into kind 2 -
|
|
|
+ and pushing the value is exactly what the kind-2 case above does
|
|
|
+ next, so the two branches converge on kind 4. A subscript on the
|
|
|
+ RIGHT is fine: it sets DI after this point and LoadPair reads it
|
|
|
+ immediately, with no parse in between. *)
|
|
|
+ LoadAtom (left) ; (* AL := [DI], AH := 0; kind := 2 *)
|
|
|
+ EmPushAx () ;
|
|
|
+ left.kind := 4
|
|
|
END
|
|
|
END SaveLeft ;
|
|
|
|
|
|
@@ -1915,6 +2008,10 @@ PROCEDURE LoadPair (VAR left, right : ERes) ;
|
|
|
neither Both can still be materialised from scratch, and
|
|
|
neither is at risk, so this is the original sequence.
|
|
|
|
|
|
+ A kind-5 right-hand operand takes that last shape, and is safe there: the
|
|
|
+ only instruction emitted before its LoadAtom is the left's, and MOV AX,[var]
|
|
|
+ and MOV AX,imm do not touch DI, so [DI] still holds the element address.
|
|
|
+
|
|
|
Whichever shape is taken, exactly one push is matched by exactly one
|
|
|
pop. *)
|
|
|
BEGIN
|
|
|
@@ -2325,7 +2422,7 @@ PROCEDURE Assignment (r : ERes) ;
|
|
|
VAR src : ERes ;
|
|
|
k, n : CARDINAL ;
|
|
|
BEGIN
|
|
|
- IF r.kind # 1 THEN
|
|
|
+ IF (r.kind # 1) AND (r.kind # 5) THEN
|
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -2388,14 +2485,31 @@ BEGIN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- (* s[i] := c : one byte at off+boff. The whole-string path above was
|
|
|
- skipped because r.cls is TChar, not TString, so this is the element
|
|
|
- store; a plain char variable has size 1 and takes the scalar path
|
|
|
- below instead. *)
|
|
|
+ (* s[i] := c : one byte, either at off+boff (a constant index) or at [DI]
|
|
|
+ (a variable one, r.kind = 5). The whole-string path above was skipped
|
|
|
+ because r.cls is TChar, not TString, so this is the element store; a
|
|
|
+ plain char variable has size 1 and takes the scalar path below
|
|
|
+ instead.
|
|
|
+
|
|
|
+ For a variable index the destination address is in DI, and the
|
|
|
+ right-hand side is parsed next, so DI has to be saved first - the RHS
|
|
|
+ may hold a subscript of its own, which reuses DI, or call a routine
|
|
|
+ that clobbers it. This is TPSRC8 asnscal2/asnscal3 (758-760,
|
|
|
+ 786-789), which set flgpshdi around the expression for the same
|
|
|
+ reason. After the save, DI is free for the RHS, and the store reads
|
|
|
+ it back. *)
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ END ;
|
|
|
ParseExpr (src) ;
|
|
|
LoadAtom (src) ;
|
|
|
- EmStoreVar (symtab [r.idx].local,
|
|
|
- (symtab [r.idx].off + r.boff) MOD 10000H, 1) ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPopDi () ; (* DI := the destination again *)
|
|
|
+ EmStDiAl () (* [DI] := AL *)
|
|
|
+ ELSE
|
|
|
+ EmStoreVar (symtab [r.idx].local,
|
|
|
+ (symtab [r.idx].off + r.boff) MOD 10000H, 1)
|
|
|
+ END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
ParseExpr (src) ;
|
|
|
@@ -2478,7 +2592,7 @@ BEGIN
|
|
|
that an earlier inline string's call had already overwritten. *)
|
|
|
pushed := TRUE ; (* default: value is on the stack -> call + pop *)
|
|
|
IF reading THEN
|
|
|
- IF arg.kind # 1 THEN
|
|
|
+ IF (arg.kind # 1) AND (arg.kind # 5) THEN
|
|
|
Err (ETypeErr) ; (* READ needs a variable *)
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -2492,8 +2606,16 @@ BEGIN
|
|
|
IF (acls = TString) AND (arg.cls = TChar) THEN
|
|
|
acls := TChar
|
|
|
END ;
|
|
|
- EmPushVarAddr (symtab [arg.idx].local,
|
|
|
- (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
+ IF arg.kind = 5 THEN
|
|
|
+ (* A variable index: ParseSub computed the element's address
|
|
|
+ into DI, and nothing has been emitted since, so that is
|
|
|
+ the address READ wants. A constant index folds into boff
|
|
|
+ and takes the LEA path below. *)
|
|
|
+ EmPushDi ()
|
|
|
+ ELSE
|
|
|
+ EmPushVarAddr (symtab [arg.idx].local,
|
|
|
+ (symtab [arg.idx].off + arg.boff) MOD 10000H)
|
|
|
+ END ;
|
|
|
IF acls = TString THEN
|
|
|
(* readln(s)/read(s) of a string variable: TPSRC8 prdstr
|
|
|
pushes the address, emits MOV CL,max_len and CALL
|