|
@@ -311,6 +311,17 @@ VAR
|
|
|
|
|
|
|
|
caseJmp : ARRAY [0..63] OF CARDINAL ;
|
|
caseJmp : ARRAY [0..63] OF CARDINAL ;
|
|
|
caseN : CARDINAL ;
|
|
caseN : CARDINAL ;
|
|
|
|
|
+
|
|
|
|
|
+ (* the active WITH scopes, innermost last. A DI-based base (an array
|
|
|
|
|
+ element addressed at run time) is parked in a two-byte data slot: the
|
|
|
|
|
+ body may clobber DI, so each field access reloads it. *)
|
|
|
|
|
+ withN : CARDINAL ;
|
|
|
|
|
+ withIsDI : ARRAY [0..3] OF BOOLEAN ;
|
|
|
|
|
+ withIdx : ARRAY [0..3] OF CARDINAL ;
|
|
|
|
|
+ withBoff : ARRAY [0..3] OF CARDINAL ;
|
|
|
|
|
+ withSlot : ARRAY [0..3] OF CARDINAL ;
|
|
|
|
|
+ withFF : ARRAY [0..3] OF CARDINAL ;
|
|
|
|
|
+ withFL : ARRAY [0..3] OF CARDINAL ;
|
|
|
lblLo, lblHi : ARRAY [0..31] OF LONGINT ; (* one arm's label list *)
|
|
lblLo, lblHi : ARRAY [0..31] OF LONGINT ; (* one arm's label list *)
|
|
|
lblJmp : ARRAY [0..63] OF CARDINAL ; (* its body jumps: 1 or 2 per label *)
|
|
lblJmp : ARRAY [0..63] OF CARDINAL ; (* its body jumps: 1 or 2 per label *)
|
|
|
|
|
|
|
@@ -1318,6 +1329,27 @@ END EmLeaDi ;
|
|
|
PROCEDURE EmAddDiAx () ;
|
|
PROCEDURE EmAddDiAx () ;
|
|
|
BEGIN Ebyte (01H) ; Ebyte (0C7H) END EmAddDiAx ; (* 01 C7: DI := DI + AX *)
|
|
BEGIN Ebyte (01H) ; Ebyte (0C7H) END EmAddDiAx ; (* 01 C7: DI := DI + AX *)
|
|
|
|
|
|
|
|
|
|
+PROCEDURE EmAddDiImm (n : CARDINAL) ;
|
|
|
|
|
+(* ADD DI,imm16: a record field's offset when the element's address is already
|
|
|
|
|
+ in DI (`Sheet[I,J].Field', `with Sheet[I,J] do'). *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Ebyte (81H) ; Ebyte (0C7H) ; Eword (n MOD 10000H)
|
|
|
|
|
+END EmAddDiImm ;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE EmLdDiGlob (off : CARDINAL) ;
|
|
|
|
|
+(* MOV DI,[off]: recover the base address WITH saved in a scratch word. The
|
|
|
|
|
+ body of a WITH may clobber DI, so the address is parked in the data area
|
|
|
|
|
+ and reloaded for every field access. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Ebyte (8BH) ; Ebyte (3EH) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
|
|
+END EmLdDiGlob ;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE EmStDiGlob (off : CARDINAL) ;
|
|
|
|
|
+(* MOV [off],DI: the WITH statement's base-address scratch. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Ebyte (89H) ; Ebyte (3EH) ; Eword ((off + LoadBias) MOD 10000H)
|
|
|
|
|
+END EmStDiGlob ;
|
|
|
|
|
+
|
|
|
PROCEDURE EmLdAlDi () ;
|
|
PROCEDURE EmLdAlDi () ;
|
|
|
BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ; (* 8A 05: AL := [DI] *)
|
|
BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ; (* 8A 05: AL := [DI] *)
|
|
|
|
|
|
|
@@ -2253,7 +2285,9 @@ PROCEDURE ParseSub (VAR r : ERes) ;
|
|
|
element-size scaling that a one-byte string element does not, and it is
|
|
element-size scaling that a one-byte string element does not, and it is
|
|
|
item 2. *)
|
|
item 2. *)
|
|
|
VAR t : ERes ;
|
|
VAR t : ERes ;
|
|
|
- ai, fi : CARDINAL ;
|
|
|
|
|
|
|
+ ai, fi, nd, k, st : CARDINAL ;
|
|
|
|
|
+ coff : LONGINT ;
|
|
|
|
|
+ accOnStack, haveVar, more : BOOLEAN ;
|
|
|
found : BOOLEAN ;
|
|
found : BOOLEAN ;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
LOOP
|
|
LOOP
|
|
@@ -2262,12 +2296,6 @@ BEGIN
|
|
|
(* FIELD selection: `r.f'. The field's offset adds to the record
|
|
(* 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
|
|
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). *)
|
|
is the whole reason a width rides on the expression (VarSize). *)
|
|
|
- IF r.kind = 5 THEN
|
|
|
|
|
- (* the element is addressed through DI, not by idx+boff; its field
|
|
|
|
|
- table would have to travel with the expression *)
|
|
|
|
|
- Err (ENoLib) ;
|
|
|
|
|
- RETURN
|
|
|
|
|
- END ;
|
|
|
|
|
DropCh (GetCh ()) ;
|
|
DropCh (GetCh ()) ;
|
|
|
Skip () ;
|
|
Skip () ;
|
|
|
IF NOT Alpha (CurCh ()) THEN
|
|
IF NOT Alpha (CurCh ()) THEN
|
|
@@ -2292,18 +2320,28 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
- r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
|
|
- + VAL (LONGINT, fields [fi].off)) ;
|
|
|
|
|
|
|
+ IF r.kind = 5 THEN
|
|
|
|
|
+ (* The element's address is in DI: a field is a fixed offset from
|
|
|
|
|
+ it. The array symbol already carries the element record's
|
|
|
|
|
+ field range (DefVar copies recFldFirst/recFldLast), which is
|
|
|
|
|
+ why the lookup above works for `Sheet[I,J].Field' too. *)
|
|
|
|
|
+ IF fields [fi].off # 0 THEN
|
|
|
|
|
+ EmAddDiImm (fields [fi].off)
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff)
|
|
|
|
|
+ + VAL (LONGINT, fields [fi].off)) ;
|
|
|
|
|
+ END ;
|
|
|
r.cls := fields [fi].cls ;
|
|
r.cls := fields [fi].cls ;
|
|
|
r.sz := fields [fi].size
|
|
r.sz := fields [fi].size
|
|
|
ELSIF CurCh () = '[' THEN
|
|
ELSIF CurCh () = '[' THEN
|
|
|
DropCh (GetCh ()) ;
|
|
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 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. *)
|
|
|
|
|
+ ParseExpr (t) ;
|
|
|
|
|
+ IF OK () THEN
|
|
|
IF r.cls = TChar THEN
|
|
IF r.cls = TChar THEN
|
|
|
Err (ESimpType) ;
|
|
Err (ESimpType) ;
|
|
|
RETURN
|
|
RETURN
|
|
@@ -2331,65 +2369,120 @@ BEGIN
|
|
|
END ;
|
|
END ;
|
|
|
r.cls := TChar ;
|
|
r.cls := TChar ;
|
|
|
r.sz := 1
|
|
r.sz := 1
|
|
|
- ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
|
|
- (* An 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. *)
|
|
|
|
|
- IF symtab [r.idx].arrIdx = 0 THEN
|
|
|
|
|
- Err (ESimpType) ;
|
|
|
|
|
|
|
+ END ;
|
|
|
|
|
+ ExpectDelim (']', ENoSemi)
|
|
|
|
|
+ ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
|
|
+ (* An array subscript LIST: one expression per dimension, comma
|
|
|
|
|
+ separated. The byte offset is
|
|
|
|
|
+ sum over k of (i[k] - lo[k]) * stride[k]
|
|
|
|
|
+ where stride[k] is the element size times the count of every
|
|
|
|
|
+ LATER dimension (row-major: the LAST dimension varies fastest).
|
|
|
|
|
+ A constant index folds into coff; a run-time one is scaled as
|
|
|
|
|
+ soon as it is parsed and summed on the STACK, because parsing
|
|
|
|
|
+ the next index may clobber AX and DI. *)
|
|
|
|
|
+ IF (r.kind = 5) OR (symtab [r.idx].arrIdx = 0) THEN
|
|
|
|
|
+ Err (ESimpType) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ ai := symtab [r.idx].arrIdx - 1 ;
|
|
|
|
|
+ nd := 0 ;
|
|
|
|
|
+ coff := 0 ;
|
|
|
|
|
+ accOnStack := FALSE ;
|
|
|
|
|
+ haveVar := FALSE ;
|
|
|
|
|
+ LOOP
|
|
|
|
|
+ IF nd >= arrs [ai].n THEN
|
|
|
|
|
+ Err (ETypeErr) ;
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
- ai := symtab [r.idx].arrIdx - 1 ;
|
|
|
|
|
|
|
+ ParseExpr (t) ;
|
|
|
|
|
+ IF NOT OK () THEN
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ st := arrs [ai].elem ;
|
|
|
|
|
+ k := nd + 1 ;
|
|
|
|
|
+ WHILE k < arrs [ai].n DO
|
|
|
|
|
+ st := st * W16 (arrs [ai].hi [k] - arrs [ai].lo [k] + 1) ;
|
|
|
|
|
+ INC (k)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ Skip () ;
|
|
|
|
|
+ more := CurCh () = ',' ;
|
|
|
IF t.kind = 0 THEN
|
|
IF t.kind = 0 THEN
|
|
|
- (* constant index: fold it into boff, as before *)
|
|
|
|
|
- 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
|
|
|
|
|
- ELSIF arrs [ai].n = 1 THEN
|
|
|
|
|
- (* Run-time index, one dimension: AX := (i - lo) * elem,
|
|
|
|
|
- then DI := base + AX. The element's address rides in DI
|
|
|
|
|
- exactly as a string element's does, so LoadAtom,
|
|
|
|
|
- Assignment, IoCall and SaveLeft already know the shape;
|
|
|
|
|
- only the WIDTH is new (1 or 2 bytes, not always a char). *)
|
|
|
|
|
- IF r.kind = 5 THEN
|
|
|
|
|
- (* a second subscript on an element already addressed
|
|
|
|
|
- through DI: 2-D run-time indexing is not implemented *)
|
|
|
|
|
- Err (ENoLib) ;
|
|
|
|
|
- RETURN
|
|
|
|
|
- END ;
|
|
|
|
|
|
|
+ coff := coff + (t.imm - arrs [ai].lo [nd])
|
|
|
|
|
+ * VAL (LONGINT, st)
|
|
|
|
|
+ ELSE
|
|
|
LoadAtom (t) ;
|
|
LoadAtom (t) ;
|
|
|
- EmMovCxi (W16 (arrs [ai].lo [0])) ;
|
|
|
|
|
- EmSubAxCx () ;
|
|
|
|
|
- IF arrs [ai].elem # 1 THEN
|
|
|
|
|
- EmMovCxi (arrs [ai].elem) ;
|
|
|
|
|
|
|
+ IF arrs [ai].lo [nd] # 0 THEN
|
|
|
|
|
+ EmMovCxi (W16 (arrs [ai].lo [nd])) ;
|
|
|
|
|
+ EmSubAxCx ()
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF st # 1 THEN
|
|
|
|
|
+ EmMovCxi (st) ;
|
|
|
EmMulAxCx ()
|
|
EmMulAxCx ()
|
|
|
END ;
|
|
END ;
|
|
|
- EmLeaDi (symtab [r.idx].local,
|
|
|
|
|
- (symtab [r.idx].off + r.boff) MOD 10000H) ;
|
|
|
|
|
- EmAddDiAx () ;
|
|
|
|
|
- r.kind := 5 ;
|
|
|
|
|
- r.sz := arrs [ai].elem ;
|
|
|
|
|
- r.cls := arrs [ai].ecls
|
|
|
|
|
|
|
+ IF more THEN
|
|
|
|
|
+ (* the next dimension's expression will clobber AX: park
|
|
|
|
|
+ the running sum. A SINGLE index skips this entirely,
|
|
|
|
|
+ so 1-D code is byte-identical to the old path. *)
|
|
|
|
|
+ IF accOnStack THEN
|
|
|
|
|
+ EmPopCx () ;
|
|
|
|
|
+ EmAddAxCx () ;
|
|
|
|
|
+ EmPushAx ()
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EmPushAx () ;
|
|
|
|
|
+ accOnStack := TRUE
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ (* last dimension: AX is the total *)
|
|
|
|
|
+ IF accOnStack THEN
|
|
|
|
|
+ EmPopCx () ;
|
|
|
|
|
+ EmAddAxCx () ;
|
|
|
|
|
+ accOnStack := FALSE
|
|
|
|
|
+ END ;
|
|
|
|
|
+ haveVar := TRUE
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ INC (nd) ;
|
|
|
|
|
+ IF more THEN
|
|
|
|
|
+ DropCh (GetCh ())
|
|
|
ELSE
|
|
ELSE
|
|
|
- (* two or more dimensions and a run-time index: the row
|
|
|
|
|
- stride is (hi1 - lo1 + 1) * elem, which is the next
|
|
|
|
|
- increment; loud, not a wrong address. *)
|
|
|
|
|
- Err (ENoLib) ;
|
|
|
|
|
- RETURN
|
|
|
|
|
|
|
+ EXIT
|
|
|
END
|
|
END
|
|
|
- ELSIF t.kind # 0 THEN
|
|
|
|
|
- Err (ENoLib) ;
|
|
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF nd # arrs [ai].n THEN
|
|
|
|
|
+ (* fewer subscripts than dimensions: the value would be a
|
|
|
|
|
+ sub-array, which has no scalar representation *)
|
|
|
|
|
+ Err (ETypeErr) ;
|
|
|
RETURN
|
|
RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ ExpectDelim (']', ENoSemi) ;
|
|
|
|
|
+ IF accOnStack THEN
|
|
|
|
|
+ (* the last dimensions were constant: the parked sum is still
|
|
|
|
|
+ on the stack, and AX is the total *)
|
|
|
|
|
+ EmPopAx () ;
|
|
|
|
|
+ accOnStack := FALSE
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF haveVar THEN
|
|
|
|
|
+ EmLeaDi (symtab [r.idx].local,
|
|
|
|
|
+ (symtab [r.idx].off + r.boff
|
|
|
|
|
+ + W16 (coff)) MOD 10000H) ;
|
|
|
|
|
+ EmAddDiAx () ;
|
|
|
|
|
+ r.kind := 5
|
|
|
ELSE
|
|
ELSE
|
|
|
- Err (ESimpType) ;
|
|
|
|
|
- RETURN
|
|
|
|
|
- END
|
|
|
|
|
- END ;
|
|
|
|
|
- ExpectDelim (']', ENoSemi)
|
|
|
|
|
|
|
+ r.boff := W16 (VAL (LONGINT, r.boff) + coff)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ r.sz := arrs [ai].elem ;
|
|
|
|
|
+ r.cls := arrs [ai].ecls
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ ParseExpr (t) ;
|
|
|
|
|
+ IF OK () THEN
|
|
|
|
|
+ IF t.kind # 0 THEN
|
|
|
|
|
+ Err (ENoLib)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Err (ESimpType)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ ExpectDelim (']', ENoSemi)
|
|
|
|
|
+ END
|
|
|
ELSE
|
|
ELSE
|
|
|
RETURN
|
|
RETURN
|
|
|
END
|
|
END
|
|
@@ -2720,7 +2813,11 @@ PROCEDURE EmPushStrAddr (r : ERes) ;
|
|
|
is a type error rather than a length-1 string compare. That is deliberate
|
|
is a type error rather than a length-1 string compare. That is deliberate
|
|
|
- it is the same rule `c := 'a'` relies on - and the caller rejects it. *)
|
|
- it is the same rule `c := 'a'` relies on - and the caller rejects it. *)
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- IF r.kind = 1 THEN
|
|
|
|
|
|
|
+ IF r.kind = 5 THEN
|
|
|
|
|
+ (* a string element/field addressed through DI: the counted-string
|
|
|
|
|
+ consumers take a symbol+offset, not an address in DI *)
|
|
|
|
|
+ Err (ENoLib)
|
|
|
|
|
+ ELSIF r.kind = 1 THEN
|
|
|
EmPushVarAddr (symtab [r.idx].local,
|
|
EmPushVarAddr (symtab [r.idx].local,
|
|
|
(symtab [r.idx].off + r.boff) MOD 10000H)
|
|
(symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
ELSIF r.kind = 3 THEN
|
|
ELSIF r.kind = 3 THEN
|
|
@@ -3274,6 +3371,51 @@ BEGIN
|
|
|
ParseAtom (r)
|
|
ParseAtom (r)
|
|
|
END ParseNeg ;
|
|
END ParseNeg ;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE WithLookup (nm : ARRAY OF CHAR ; VAR r : ERes) : BOOLEAN ;
|
|
|
|
|
+(* Resolve a bare identifier against the active WITH scopes, innermost first.
|
|
|
|
|
+ ISO Pascal lets a record field shadow an outer declaration, so this is
|
|
|
|
|
+ consulted BEFORE Search. The result is filled exactly as a variable
|
|
|
|
|
+ reference: kind 1 (base symbol + boff) for a record variable or a
|
|
|
|
|
+ constant-index element, kind 5 (address in DI) for a run-time-indexed one,
|
|
|
|
|
+ where the base is reloaded from the WITH slot because the body may have
|
|
|
|
|
+ used DI. *)
|
|
|
|
|
+VAR w, fi : CARDINAL ;
|
|
|
|
|
+ found : BOOLEAN ;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ w := withN ;
|
|
|
|
|
+ WHILE w > 0 DO
|
|
|
|
|
+ DEC (w) ;
|
|
|
|
|
+ fi := withFF [w] ;
|
|
|
|
|
+ found := FALSE ;
|
|
|
|
|
+ WHILE (fi < withFL [w]) AND NOT found DO
|
|
|
|
|
+ IF NameEq (fields [fi].name, nm) THEN
|
|
|
|
|
+ found := TRUE
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ INC (fi)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF found THEN
|
|
|
|
|
+ IF withIsDI [w] THEN
|
|
|
|
|
+ EmLdDiGlob (withSlot [w]) ;
|
|
|
|
|
+ IF fields [fi].off # 0 THEN
|
|
|
|
|
+ EmAddDiImm (fields [fi].off)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ r.kind := 5
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ r.kind := 1 ;
|
|
|
|
|
+ r.boff := W16 (VAL (LONGINT, withBoff [w])
|
|
|
|
|
+ + VAL (LONGINT, fields [fi].off))
|
|
|
|
|
+ END ;
|
|
|
|
|
+ r.idx := withIdx [w] ;
|
|
|
|
|
+ r.cls := fields [fi].cls ;
|
|
|
|
|
+ r.sz := fields [fi].size ;
|
|
|
|
|
+ r.chr := FALSE ;
|
|
|
|
|
+ RETURN TRUE
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ RETURN FALSE
|
|
|
|
|
+END WithLookup ;
|
|
|
|
|
+
|
|
|
PROCEDURE ParseAtom (VAR r : ERes) ;
|
|
PROCEDURE ParseAtom (VAR r : ERes) ;
|
|
|
(* const | variable | func(params) | '(' expr ')' | '[' set ']' *)
|
|
(* const | variable | func(params) | '(' expr ')' | '[' set ']' *)
|
|
|
VAR idx : CARDINAL ;
|
|
VAR idx : CARDINAL ;
|
|
@@ -3340,6 +3482,10 @@ BEGIN
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
GetWord () ;
|
|
GetWord () ;
|
|
|
|
|
+ IF WithLookup (wrd, r) THEN
|
|
|
|
|
+ ParseSub (r) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF NOT Search (wrd, idx) THEN
|
|
IF NOT Search (wrd, idx) THEN
|
|
|
Err (EUnknown) ;
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
RETURN
|
|
@@ -3661,6 +3807,13 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
|
|
+ IF (r.kind = 5) AND (r.cls = TString) THEN
|
|
|
|
|
+ (* A whole string field of a run-time-indexed record element: the
|
|
|
|
|
+ string paths address by symbol+boff, which is not this element.
|
|
|
|
|
+ Loud until a counted-string copy through DI exists. *)
|
|
|
|
|
+ Err (ENoLib) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF (r.kind = 1) AND symtab [r.idx].isVar THEN
|
|
IF (r.kind = 1) AND symtab [r.idx].isVar THEN
|
|
|
(* `varparam := expr': store through the address the slot holds. DI is
|
|
(* `varparam := expr': store through the address the slot holds. DI is
|
|
|
parked across the right-hand side because that expression may use DI
|
|
parked across the right-hand side because that expression may use DI
|
|
@@ -4025,6 +4178,11 @@ BEGIN
|
|
|
IF (acls = TString) AND (arg.cls = TChar) THEN
|
|
IF (acls = TString) AND (arg.cls = TChar) THEN
|
|
|
acls := TChar
|
|
acls := TChar
|
|
|
END ;
|
|
END ;
|
|
|
|
|
+ IF (acls = TString) AND (arg.kind = 5) THEN
|
|
|
|
|
+ (* a string field of a DI-addressed element *)
|
|
|
|
|
+ Err (ENoLib) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF arg.kind = 5 THEN
|
|
IF arg.kind = 5 THEN
|
|
|
(* A variable index: ParseSub computed the element's address
|
|
(* A variable index: ParseSub computed the element's address
|
|
|
into DI, and nothing has been emitted since, so that is
|
|
into DI, and nothing has been emitted since, so that is
|
|
@@ -4112,6 +4270,12 @@ BEGIN
|
|
|
END ;
|
|
END ;
|
|
|
pushed := FALSE (* nothing was pushed for this one *)
|
|
pushed := FALSE (* nothing was pushed for this one *)
|
|
|
ELSE
|
|
ELSE
|
|
|
|
|
+ IF (acls = TString) AND (arg.kind = 5) THEN
|
|
|
|
|
+ (* a string field of a DI-addressed element: there is no
|
|
|
|
|
+ symbol+offset address to push *)
|
|
|
|
|
+ Err (ENoLib) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF acls = TString THEN
|
|
IF acls = TString THEN
|
|
|
(* A string *variable*. Its value IS its address, so it is
|
|
(* A string *variable*. Its value IS its address, so it is
|
|
|
passed exactly the way READ passes an address: push it
|
|
passed exactly the way READ passes an address: push it
|
|
@@ -4213,6 +4377,7 @@ VAR tok : CARDINAL ;
|
|
|
nm : ARRAY [0..MaxName] OF CHAR ;
|
|
nm : ARRAY [0..MaxName] OF CHAR ;
|
|
|
strf : BOOLEAN ;
|
|
strf : BOOLEAN ;
|
|
|
dow : BOOLEAN ;
|
|
dow : BOOLEAN ;
|
|
|
|
|
+ savedWith : CARDINAL ;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
Skip () ;
|
|
Skip () ;
|
|
|
IF Digit (CurCh ()) THEN
|
|
IF Digit (CurCh ()) THEN
|
|
@@ -4620,9 +4785,71 @@ BEGIN
|
|
|
END
|
|
END
|
|
|
END
|
|
END
|
|
|
ELSIF tok = TkWith THEN
|
|
ELSIF tok = TkWith THEN
|
|
|
- Err (ENoLib)
|
|
|
|
|
|
|
+ (* WITH base (, base)* DO statement. The record's field range comes from
|
|
|
|
|
+ the base symbol: DefVar copies the ELEMENT record's recFldFirst/
|
|
|
|
|
+ recFldLast onto an array variable, which is what makes
|
|
|
|
|
+ `Sheet[I,J].Field' and `with Sheet[I,J] do' work. Each base is
|
|
|
|
|
+ pushed on the scope stack and popped after the statement. *)
|
|
|
|
|
+ savedWith := withN ;
|
|
|
|
|
+ LOOP
|
|
|
|
|
+ ParseExpr (t) ;
|
|
|
|
|
+ IF NOT OK () THEN
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF t.cls # TRecord THEN
|
|
|
|
|
+ Err (ETypeErr) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF withN >= 4 THEN
|
|
|
|
|
+ Err (ECompOvf) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF symtab [t.idx].fldFirst >= symtab [t.idx].fldLast THEN
|
|
|
|
|
+ Err (ETypeErr) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF t.kind = 5 THEN
|
|
|
|
|
+ (* the base address is in DI; park it. Allocating two data bytes
|
|
|
|
|
+ here is safe: the statement is parsed once, and the store
|
|
|
|
|
+ executes wherever the WITH does. *)
|
|
|
|
|
+ withSlot [withN] := dc ;
|
|
|
|
|
+ dc := dc + 2 ;
|
|
|
|
|
+ EmStDiGlob (withSlot [withN]) ;
|
|
|
|
|
+ withIsDI [withN] := TRUE ;
|
|
|
|
|
+ withBoff [withN] := 0
|
|
|
|
|
+ ELSIF t.kind = 1 THEN
|
|
|
|
|
+ withIsDI [withN] := FALSE ;
|
|
|
|
|
+ withBoff [withN] := t.boff
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Err (ENoLib) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ withIdx [withN] := t.idx ;
|
|
|
|
|
+ withFF [withN] := symtab [t.idx].fldFirst ;
|
|
|
|
|
+ withFL [withN] := symtab [t.idx].fldLast ;
|
|
|
|
|
+ INC (withN) ;
|
|
|
|
|
+ IF MatchDelim (',') THEN
|
|
|
|
|
+ (* another base; the last one is innermost *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EXIT
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF NOT (MatchKey (tok) AND (tok = TkDo)) THEN
|
|
|
|
|
+ Err (ENoSemi) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ Statmnt () ;
|
|
|
|
|
+ withN := savedWith
|
|
|
ELSE
|
|
ELSE
|
|
|
(* identifier statement: assignment or call *)
|
|
(* identifier statement: assignment or call *)
|
|
|
|
|
+ IF WithLookup (wrd, t) THEN
|
|
|
|
|
+ IF MatchAssign () THEN
|
|
|
|
|
+ Assignment (t) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ Err (ENoSemi) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF NOT Search (wrd, idx) THEN
|
|
IF NOT Search (wrd, idx) THEN
|
|
|
Err (EUnknown) ;
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
RETURN
|
|
@@ -4673,7 +4900,7 @@ VAR tok : CARDINAL ;
|
|
|
subcls : CARDINAL ;
|
|
subcls : CARDINAL ;
|
|
|
strf : BOOLEAN ;
|
|
strf : BOOLEAN ;
|
|
|
consumed : BOOLEAN ;
|
|
consumed : BOOLEAN ;
|
|
|
- running, groupFirst, i, an : CARDINAL ;
|
|
|
|
|
|
|
+ running, groupFirst, i, an, recStart : CARDINAL ;
|
|
|
alo, ahi : ARRAY [0..3] OF LONGINT ;
|
|
alo, ahi : ARRAY [0..3] OF LONGINT ;
|
|
|
ecls2 : CARDINAL ;
|
|
ecls2 : CARDINAL ;
|
|
|
BEGIN
|
|
BEGIN
|
|
@@ -4815,6 +5042,7 @@ BEGIN
|
|
|
per record so field names need not be globally unique.
|
|
per record so field names need not be globally unique.
|
|
|
recFldFirst/recFldLast hand the range to DefType, or to the enclosing
|
|
recFldFirst/recFldLast hand the range to DefType, or to the enclosing
|
|
|
record's field entry when records nest. *)
|
|
record's field entry when records nest. *)
|
|
|
|
|
+ recStart := fldTop ;
|
|
|
recFldFirst := fldTop ;
|
|
recFldFirst := fldTop ;
|
|
|
running := 0 ;
|
|
running := 0 ;
|
|
|
LOOP
|
|
LOOP
|
|
@@ -4869,6 +5097,15 @@ BEGIN
|
|
|
RETURN
|
|
RETURN
|
|
|
END
|
|
END
|
|
|
END ;
|
|
END ;
|
|
|
|
|
+ (* The field TYPES are parsed by ParseType, and its named-type arm
|
|
|
|
|
+ copies the TYPE's field range into recFldFirst/recFldLast - for
|
|
|
|
|
+ `Integer' that is 0/0. So recFldFirst set at the top of this branch
|
|
|
|
|
+ is overwritten by every field type. It happens to be right for the
|
|
|
|
|
+ FIRST record in a compile (fldTop is 0 then), and wrong for every
|
|
|
|
|
+ later one: t77's second record started at 2 but recorded 0, which
|
|
|
|
|
+ made a WITH field lookup scan the previous record's fields. Restore
|
|
|
|
|
+ the saved start here, after the last field type has been parsed. *)
|
|
|
|
|
+ recFldFirst := recStart ;
|
|
|
recFldLast := fldTop ;
|
|
recFldLast := fldTop ;
|
|
|
cls := TRecord ;
|
|
cls := TRecord ;
|
|
|
size := running ;
|
|
size := running ;
|
|
@@ -5528,7 +5765,15 @@ BEGIN
|
|
|
symtab [tidx].fldLast := recFldLast
|
|
symtab [tidx].fldLast := recFldLast
|
|
|
END ;
|
|
END ;
|
|
|
IF cls = TArray THEN
|
|
IF cls = TArray THEN
|
|
|
- symtab [tidx].arrIdx := newArrIdx
|
|
|
|
|
|
|
+ symtab [tidx].arrIdx := newArrIdx ;
|
|
|
|
|
+ (* ...and the ELEMENT's field table, if it is a record. A variable
|
|
|
|
|
+ declared `Sheet : Cells' gets its field metadata through the named
|
|
|
|
|
+ type; without this, `Sheet[I,J].Field' and `with Sheet[I,J]' found
|
|
|
|
|
+ fldFirst = fldLast = 0 and reported "not a record". An INLINE
|
|
|
|
|
+ `array ... of Rec' worked because ParseType's element call left
|
|
|
|
|
+ the globals set for DefVar; the named form had lost them. *)
|
|
|
|
|
+ symtab [tidx].fldFirst := recFldFirst ;
|
|
|
|
|
+ symtab [tidx].fldLast := recFldLast
|
|
|
END ;
|
|
END ;
|
|
|
DropC (tidx) ;
|
|
DropC (tidx) ;
|
|
|
IF NOT MatchDelim (';') THEN
|
|
IF NOT MatchDelim (';') THEN
|
|
@@ -5713,6 +5958,13 @@ BEGIN
|
|
|
rdStrX := 0 ;
|
|
rdStrX := 0 ;
|
|
|
varspc := 0 ;
|
|
varspc := 0 ;
|
|
|
symTop := 0 ;
|
|
symTop := 0 ;
|
|
|
|
|
+ (* Per-compile tables. They used to survive into the next file when the
|
|
|
|
|
+ driver compiles several in one process (the compile matrix does exactly
|
|
|
|
|
+ that): array indices kept growing, and a record's field range could be
|
|
|
|
|
+ read against a stale table. One compile must not depend on the last. *)
|
|
|
|
|
+ fldTop := 0 ;
|
|
|
|
|
+ arrTop := 0 ;
|
|
|
|
|
+ withN := 0 ;
|
|
|
nPatch := 0 ;
|
|
nPatch := 0 ;
|
|
|
nPend := 0 ;
|
|
nPend := 0 ;
|
|
|
exitCnt := 0 ;
|
|
exitCnt := 0 ;
|