|
|
@@ -205,6 +205,8 @@ TYPE
|
|
|
setbase : CARDINAL ; (* ... the first byte's first element,
|
|
|
a multiple of 8 (TP3's hybrid origin) *)
|
|
|
setsize : CARDINAL ; (* ... and how many bytes there are *)
|
|
|
+ sz : CARDINAL ; (* width of a kind-1 value: an element or
|
|
|
+ field's size, not its variable's *)
|
|
|
END ;
|
|
|
|
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
|
@@ -224,6 +226,7 @@ TYPE
|
|
|
n : CARDINAL ; (* number of ranges (1 for array[1..5]) *)
|
|
|
lo, hi : ARRAY [0..3] OF LONGINT ;
|
|
|
elem : CARDINAL ; (* element size in bytes *)
|
|
|
+ ecls : CARDINAL ; (* element CLASS, for a subscripted value *)
|
|
|
END ;
|
|
|
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
@@ -2061,6 +2064,17 @@ PROCEDURE EmCallMost (idx, nk : CARDINAL) ; FORWARD ;
|
|
|
(* expressions (TPSRC9) *)
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
|
|
|
+PROCEDURE VarSize (r : ERes) : CARDINAL ;
|
|
|
+(* The width of a kind-1 value. An element (`b[i]') or a field (`r.f') has a
|
|
|
+ size of its own, which is NOT its variable's; when the parser has recorded
|
|
|
+ one, it wins. Otherwise the variable's declared size is the answer. *)
|
|
|
+BEGIN
|
|
|
+ IF r.sz > 0 THEN
|
|
|
+ RETURN r.sz
|
|
|
+ END ;
|
|
|
+ RETURN symtab [r.idx].size
|
|
|
+END VarSize ;
|
|
|
+
|
|
|
PROCEDURE LoadAtom (VAR r : ERes) ;
|
|
|
(* load value of r into AX (folding constants).
|
|
|
|
|
|
@@ -2104,13 +2118,13 @@ BEGIN
|
|
|
EmMovAxi (W16 (r.imm)) ;
|
|
|
r.kind := 2
|
|
|
ELSIF r.kind = 1 THEN
|
|
|
- IF (symtab [r.idx].size > 2) AND NOT
|
|
|
+ IF (VarSize (r) > 2) AND NOT
|
|
|
((r.cls = TChar) AND (symtab [r.idx].cls = TString)) THEN
|
|
|
Err (ENoLib)
|
|
|
ELSE
|
|
|
(* s[i] indexes one byte of a string, not the string, so its width is
|
|
|
one whatever the variable's declared width is. *)
|
|
|
- emsz := symtab [r.idx].size ;
|
|
|
+ emsz := VarSize (r) ;
|
|
|
IF (r.cls = TChar) AND (symtab [r.idx].cls = TString) THEN
|
|
|
emsz := 1
|
|
|
END ;
|
|
|
@@ -2136,62 +2150,112 @@ PROCEDURE ParseSub (VAR r : ERes) ;
|
|
|
element-size scaling that a one-byte string element does not, and it is
|
|
|
item 2. *)
|
|
|
VAR t : ERes ;
|
|
|
+ ai, fi : CARDINAL ;
|
|
|
+ found : BOOLEAN ;
|
|
|
BEGIN
|
|
|
LOOP
|
|
|
Skip () ;
|
|
|
- IF CurCh () # '[' THEN
|
|
|
- RETURN
|
|
|
- END ;
|
|
|
- DropCh (GetCh ()) ;
|
|
|
- ParseExpr (t) ;
|
|
|
- IF OK () THEN
|
|
|
- IF symtab [r.idx].cls = TString THEN
|
|
|
- (* s[i]: a STRING is a length byte at s[0] followed by the
|
|
|
- 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 ;
|
|
|
- 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) ;
|
|
|
+ IF CurCh () = '.' THEN
|
|
|
+ (* FIELD selection: `r.f'. The field's offset adds to the record
|
|
|
+ base's, and the value's class and WIDTH become the field's - which
|
|
|
+ is the whole reason a width rides on the expression (VarSize). *)
|
|
|
+ DropCh (GetCh ()) ;
|
|
|
+ Skip () ;
|
|
|
+ IF NOT Alpha (CurCh ()) THEN
|
|
|
+ Err (EUnknown) ;
|
|
|
RETURN
|
|
|
- ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
- (* A constant array subscript. The element's WIDTH is not the
|
|
|
- array's, so folding the address here and leaving the size at the
|
|
|
- array's would make `b[1] := 2' store the whole array. Element
|
|
|
- addressing (a width on the expression) is the next increment;
|
|
|
- until then this is LOUD, not a wrong store. *)
|
|
|
- Err (ENoLib) ;
|
|
|
+ END ;
|
|
|
+ GetWord () ;
|
|
|
+ IF symtab [r.idx].fldFirst >= symtab [r.idx].fldLast THEN
|
|
|
+ Err (ESimpType) ; (* not a record *)
|
|
|
RETURN
|
|
|
- ELSE
|
|
|
- Err (ESimpType) ;
|
|
|
+ END ;
|
|
|
+ fi := symtab [r.idx].fldFirst ;
|
|
|
+ found := FALSE ;
|
|
|
+ WHILE (fi < symtab [r.idx].fldLast) AND NOT found DO
|
|
|
+ IF NameEq (fields [fi].name, wrd) THEN
|
|
|
+ found := TRUE
|
|
|
+ ELSE
|
|
|
+ INC (fi)
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ IF NOT found THEN
|
|
|
+ Err (EUnknown) ;
|
|
|
RETURN
|
|
|
- END
|
|
|
- END ;
|
|
|
- ExpectDelim (']', ENoSemi)
|
|
|
+ END ;
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
+ + VAL (LONGINT, fields [fi].off)) ;
|
|
|
+ r.cls := fields [fi].cls ;
|
|
|
+ r.sz := fields [fi].size
|
|
|
+ ELSIF CurCh () = '[' THEN
|
|
|
+ DropCh (GetCh ()) ;
|
|
|
+ ParseExpr (t) ;
|
|
|
+ IF OK () THEN
|
|
|
+ IF symtab [r.idx].cls = TString THEN
|
|
|
+ (* s[i]: a STRING is a length byte at s[0] followed by the
|
|
|
+ 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 ;
|
|
|
+ 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 ;
|
|
|
+ r.sz := 1
|
|
|
+ ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
+ (* A constant array subscript. The element's address is
|
|
|
+ (index - lower bound) * element size from the array base, and
|
|
|
+ the value's width and class become the ELEMENT's - so a store
|
|
|
+ writes two bytes for an `array of Integer', not the whole
|
|
|
+ array. A VARIABLE index needs scaled run-time addressing and
|
|
|
+ is the next increment. *)
|
|
|
+ IF t.kind # 0 THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF symtab [r.idx].arrIdx > 0 THEN
|
|
|
+ ai := symtab [r.idx].arrIdx - 1 ;
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
+ + (t.imm - arrs [ai].lo [0])
|
|
|
+ * VAL (LONGINT, arrs [ai].elem)) ;
|
|
|
+ r.sz := arrs [ai].elem ;
|
|
|
+ r.cls := arrs [ai].ecls
|
|
|
+ ELSE
|
|
|
+ Err (ESimpType) ;
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ ELSIF t.kind # 0 THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ ELSE
|
|
|
+ Err (ESimpType) ;
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ ExpectDelim (']', ENoSemi)
|
|
|
+ ELSE
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
END
|
|
|
END ParseSub ;
|
|
|
|
|
|
@@ -2223,6 +2287,7 @@ BEGIN
|
|
|
r.setbase := symtab [r.idx].elem ;
|
|
|
r.setsize := symtab [r.idx].size
|
|
|
END ;
|
|
|
+ r.sz := symtab [r.idx].size ;
|
|
|
ParseSub (r)
|
|
|
END ParseVar ;
|
|
|
|
|
|
@@ -3270,7 +3335,7 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF (symtab [r.idx].cls = TString) AND (r.cls = TString) THEN
|
|
|
+ IF (r.cls = TString) AND (VarSize (r) > 1) THEN
|
|
|
(* s := <string literal>. TPSRC8 asn2 sends a string through the scalar
|
|
|
store path, and estcpl's string arm emits `MOV CL,max_len' (max_len =
|
|
|
varsize-1) then `CALL strstore', which copies the source - length byte
|
|
|
@@ -3303,14 +3368,14 @@ BEGIN
|
|
|
(symtab [src.idx].off + src.boff) MOD 10000H) ;
|
|
|
EmPushVarAddr (symtab [r.idx].local,
|
|
|
(symtab [r.idx].off + r.boff) MOD 10000H) ;
|
|
|
- EmMovCxi ((symtab [r.idx].size - 1) MOD 10000H) ;
|
|
|
+ EmMovCxi ((VarSize (r) - 1) MOD 10000H) ;
|
|
|
DropC (EmCall (TU_StrStore)) ;
|
|
|
EmAddSp (4) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
n := strLen [src.strx] ;
|
|
|
- IF n > symtab [r.idx].size - 1 THEN
|
|
|
- n := symtab [r.idx].size - 1
|
|
|
+ IF n > VarSize (r) - 1 THEN
|
|
|
+ n := VarSize (r) - 1
|
|
|
END ;
|
|
|
EmMovAxi (n) ;
|
|
|
EmStoreVar (symtab [r.idx].local,
|
|
|
@@ -3324,8 +3389,8 @@ BEGIN
|
|
|
END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF symtab [r.idx].size > 2 THEN
|
|
|
- IF (r.cls # TChar) OR (symtab [r.idx].cls # TString) THEN
|
|
|
+ IF (r.kind = 5) OR (VarSize (r) > 2) THEN
|
|
|
+ IF (r.cls # TChar) OR (r.kind = 1) THEN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -3360,7 +3425,7 @@ BEGIN
|
|
|
LoadAtom (src) ;
|
|
|
EmStoreVar (symtab [r.idx].local,
|
|
|
(symtab [r.idx].off + r.boff) MOD 10000H,
|
|
|
- symtab [r.idx].size)
|
|
|
+ VarSize (r))
|
|
|
END Assignment ;
|
|
|
|
|
|
PROCEDURE Compound () ;
|
|
|
@@ -3483,7 +3548,7 @@ BEGIN
|
|
|
runtime has no byte-register CH/CL setup), and rdstr
|
|
|
leaves the terminator pending so the readln wrapper can
|
|
|
consume the newline. *)
|
|
|
- EmMovCxi ((symtab [arg.idx].size - 1) MOD 10000H) ;
|
|
|
+ EmMovCxi ((VarSize (arg) - 1) MOD 10000H) ;
|
|
|
ent := TU_RdStr
|
|
|
ELSIF acls = TReal THEN
|
|
|
ent := TU_RdInt (* real reads: not yet *)
|
|
|
@@ -3506,7 +3571,7 @@ BEGIN
|
|
|
is *written* as an integer, as in TP3), but reading one
|
|
|
through rdint stored a word - and the second byte of
|
|
|
that word is the byte that FOLLOWS the variable. *)
|
|
|
- IF symtab [arg.idx].size = 1 THEN
|
|
|
+ IF VarSize (arg) = 1 THEN
|
|
|
ent := TU_RdByte
|
|
|
ELSE
|
|
|
ent := TU_RdInt
|
|
|
@@ -3956,6 +4021,7 @@ BEGIN
|
|
|
t.idx := symtab [idx].resvar ;
|
|
|
t.cls := symtab [t.idx].cls
|
|
|
END ;
|
|
|
+ t.sz := symtab [t.idx].size ; (* ParseSub may narrow it further *)
|
|
|
ParseSub (t) ;
|
|
|
IF MatchAssign () THEN
|
|
|
Assignment (t) ;
|
|
|
@@ -3982,6 +4048,7 @@ VAR tok : CARDINAL ;
|
|
|
consumed : BOOLEAN ;
|
|
|
running, groupFirst, i, an : CARDINAL ;
|
|
|
alo, ahi : ARRAY [0..3] OF LONGINT ;
|
|
|
+ ecls2 : CARDINAL ;
|
|
|
BEGIN
|
|
|
cls := TNone ; size := 0 ; elem := 0 ;
|
|
|
consumed := FALSE ;
|
|
|
@@ -4059,6 +4126,7 @@ BEGIN
|
|
|
RETURN
|
|
|
END ;
|
|
|
ParseType (cls, s2, e2) ;
|
|
|
+ ecls2 := cls ;
|
|
|
cls := TArray ;
|
|
|
elem := s2 ;
|
|
|
size := s2 ;
|
|
|
@@ -4073,6 +4141,7 @@ BEGIN
|
|
|
IF arrTop < MaxArrs THEN
|
|
|
arrs [arrTop].n := an ;
|
|
|
arrs [arrTop].elem := s2 ;
|
|
|
+ arrs [arrTop].ecls := ecls2 ;
|
|
|
i := 0 ;
|
|
|
WHILE i < an DO
|
|
|
arrs [arrTop].lo [i] := alo [i] ;
|