|
|
@@ -79,6 +79,8 @@ CONST
|
|
|
MaxSym = 3000 ;
|
|
|
MaxPatch = 2000 ;
|
|
|
MaxPend = 400 ;
|
|
|
+ MaxFields = 2000 ; (* record fields, in a table of their own: a
|
|
|
+ field is scoped to its record, not global *)
|
|
|
|
|
|
(* type codes (TP3 vartp) *)
|
|
|
TNone = 0 ; TArray = 1 ; TRecord = 2 ; TSet = 3 ;
|
|
|
@@ -159,6 +161,8 @@ TYPE
|
|
|
lo, hi : LONGINT ; (* an ORDINAL type's bounds: an enumeration
|
|
|
(0..n-1) or a subrange. Needed so
|
|
|
`set of T' can size its base. *)
|
|
|
+ fldFirst, fldLast : CARDINAL ; (* a RECORD type's field range in the
|
|
|
+ field table (0,0 when not a record) *)
|
|
|
level : CARDINAL ;
|
|
|
local : BOOLEAN ;
|
|
|
resvar : CARDINAL ;
|
|
|
@@ -202,6 +206,16 @@ TYPE
|
|
|
|
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
|
|
|
|
+ FldRec =
|
|
|
+ RECORD
|
|
|
+ name : ARRAY [0..MaxName] OF CHAR ;
|
|
|
+ cls : CARDINAL ;
|
|
|
+ size : CARDINAL ;
|
|
|
+ elem : CARDINAL ;
|
|
|
+ off : CARDINAL ; (* byte offset within the record *)
|
|
|
+ lo, hi : LONGINT ; (* bounds, for a subrange/enum field *)
|
|
|
+ END ;
|
|
|
+
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
(* state *)
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
@@ -223,6 +237,9 @@ VAR
|
|
|
incBuf : ARRAY [0..TextLimit] OF CHAR ;
|
|
|
enumLo, enumHi : LONGINT ; (* bounds of the enumeration ParseType just read,
|
|
|
handed to DefType which owns the type NAME *)
|
|
|
+ fields : ARRAY [0..MaxFields - 1] OF FldRec ;
|
|
|
+ fldTop : CARDINAL ; (* next free field-table slot *)
|
|
|
+ recFldFirst, recFldLast : CARDINAL ; (* field range ParseType just built *)
|
|
|
|
|
|
wrd : ARRAY [0..MaxName] OF CHAR ;
|
|
|
|
|
|
@@ -1432,6 +1449,8 @@ BEGIN
|
|
|
e.lval := v ;
|
|
|
e.lo := 0 ;
|
|
|
e.hi := 0 ;
|
|
|
+ e.fldFirst := 0 ;
|
|
|
+ e.fldLast := 0 ;
|
|
|
e.level := lexnest ;
|
|
|
e.local := local ;
|
|
|
e.resvar := 0 ;
|
|
|
@@ -3940,6 +3959,7 @@ VAR tok : CARDINAL ;
|
|
|
subcls : CARDINAL ;
|
|
|
strf : BOOLEAN ;
|
|
|
consumed : BOOLEAN ;
|
|
|
+ running, groupFirst, i : CARDINAL ;
|
|
|
BEGIN
|
|
|
cls := TNone ; size := 0 ; elem := 0 ;
|
|
|
consumed := FALSE ;
|
|
|
@@ -4029,7 +4049,14 @@ BEGIN
|
|
|
Err (ENoSemi)
|
|
|
END
|
|
|
ELSIF tok = TkRecord THEN
|
|
|
- Err (ENoLib) ;
|
|
|
+ (* record fieldList end, fields NON-COMPACTED and juxtaposed
|
|
|
+ (RESUME-TP3.md §2). Each name in a `a, b : T' group is a field of its
|
|
|
+ own at the running offset; the field table is where `x.f' looks, keyed
|
|
|
+ per record so field names need not be globally unique.
|
|
|
+ recFldFirst/recFldLast hand the range to DefType, or to the enclosing
|
|
|
+ record's field entry when records nest. *)
|
|
|
+ recFldFirst := fldTop ;
|
|
|
+ running := 0 ;
|
|
|
LOOP
|
|
|
PeekKw (tok) ;
|
|
|
IF tok = TkEnd THEN
|
|
|
@@ -4037,15 +4064,55 @@ BEGIN
|
|
|
EXIT
|
|
|
END ;
|
|
|
IF CurCh () = 0C THEN
|
|
|
+ Err (EUnknown) ;
|
|
|
EXIT
|
|
|
END ;
|
|
|
- Skip () ;
|
|
|
- IF Alpha (CurCh ()) THEN
|
|
|
- DropCh (GetCh ())
|
|
|
- ELSE
|
|
|
- DropCh (GetCh ())
|
|
|
+ (* the group's names, then ONE `: type' *)
|
|
|
+ groupFirst := fldTop ;
|
|
|
+ LOOP
|
|
|
+ Skip () ;
|
|
|
+ IF NOT Alpha (CurCh ()) THEN
|
|
|
+ Err (EUnknown) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ GetWord () ;
|
|
|
+ IF fldTop < MaxFields THEN
|
|
|
+ CopyStr (fields [fldTop].name, wrd) ;
|
|
|
+ fields [fldTop].off := 0 ;
|
|
|
+ INC (fldTop)
|
|
|
+ ELSE
|
|
|
+ Err (ECompOvf)
|
|
|
+ END ;
|
|
|
+ IF NOT MatchDelim (',') THEN
|
|
|
+ EXIT
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ ExpectDelim (':', ENoSemi) ;
|
|
|
+ ParseType (subcls, s2, e2) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ (* every name in the group gets the type and its own slot *)
|
|
|
+ i := groupFirst ;
|
|
|
+ WHILE i < fldTop DO
|
|
|
+ fields [i].cls := subcls ;
|
|
|
+ fields [i].size := s2 ;
|
|
|
+ fields [i].elem := e2 ;
|
|
|
+ fields [i].off := running ;
|
|
|
+ fields [i].lo := enumLo ;
|
|
|
+ fields [i].hi := enumHi ;
|
|
|
+ running := running + s2 ;
|
|
|
+ INC (i)
|
|
|
+ END ;
|
|
|
+ IF NOT MatchDelim (';') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
END
|
|
|
- END
|
|
|
+ END ;
|
|
|
+ recFldLast := fldTop ;
|
|
|
+ cls := TRecord ;
|
|
|
+ size := running ;
|
|
|
+ elem := running
|
|
|
ELSIF (tok = TkFile) OR (tok = TkText) THEN
|
|
|
cls := TFile ;
|
|
|
size := 0 ;
|
|
|
@@ -4056,12 +4123,19 @@ BEGIN
|
|
|
IF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
|
|
|
cls := symtab [idx].cls ;
|
|
|
size := symtab [idx].size ;
|
|
|
- elem := symtab [idx].size
|
|
|
+ elem := symtab [idx].size ;
|
|
|
+ enumLo := symtab [idx].lo ;
|
|
|
+ enumHi := symtab [idx].hi ;
|
|
|
+ recFldFirst := symtab [idx].fldFirst ;
|
|
|
+ recFldLast := symtab [idx].fldLast
|
|
|
ELSE
|
|
|
Err (EUnknown)
|
|
|
END
|
|
|
ELSE
|
|
|
- (* subrange lo .. hi *)
|
|
|
+ (* subrange lo .. hi. TP3 sizes it by its bounds: ONE byte when both
|
|
|
+ are inside 0..255, else two (RESUME-TP3.md §2). `0..20' and
|
|
|
+ `'A'..'G'' are one byte - which is what makes CellRec 80 and not
|
|
|
+ 82, and `Sheet' 147*80. The bounds are kept for `set of T'. *)
|
|
|
RdConst (lo, subcls, strf) ;
|
|
|
IF NOT MatchRange () THEN
|
|
|
Err (ESimpType) ;
|
|
|
@@ -4069,8 +4143,14 @@ BEGIN
|
|
|
END ;
|
|
|
RdConst (hi, subcls, strf) ;
|
|
|
cls := TScalar ;
|
|
|
- size := 2 ;
|
|
|
- elem := 2
|
|
|
+ IF (lo >= 0) AND (hi <= 255) AND (lo <= hi) THEN
|
|
|
+ size := 1
|
|
|
+ ELSE
|
|
|
+ size := 2
|
|
|
+ END ;
|
|
|
+ elem := size ;
|
|
|
+ enumLo := lo ;
|
|
|
+ enumHi := hi
|
|
|
END
|
|
|
END
|
|
|
END ParseType ;
|
|
|
@@ -4118,7 +4198,7 @@ BEGIN
|
|
|
ParseType (cls, size, elem) ;
|
|
|
IF OK () THEN
|
|
|
IF lexnest = 0 THEN
|
|
|
- IF (size > 2) AND (cls # TString) THEN
|
|
|
+ IF (size > 2) AND (cls # TString) AND (cls # TRecord) THEN
|
|
|
(* Still the catch-all for a type whose storage this compiler does
|
|
|
not lay out yet (an ARRAY at its point of use, a RECORD, ...).
|
|
|
A STRING is the exception now: its layout is length byte +
|
|
|
@@ -4143,6 +4223,8 @@ BEGIN
|
|
|
WHILE i < symTop DO
|
|
|
symtab [i].cls := cls ; symtab [i].size := size ;
|
|
|
symtab [i].elem := elem ; symtab [i].off := off ;
|
|
|
+ symtab [i].fldFirst := recFldFirst ;
|
|
|
+ symtab [i].fldLast := recFldLast ;
|
|
|
INC (i)
|
|
|
END
|
|
|
ELSE
|
|
|
@@ -4150,13 +4232,15 @@ BEGIN
|
|
|
WHILE i < symTop DO
|
|
|
symtab [i].cls := cls ; symtab [i].size := size ;
|
|
|
symtab [i].elem := elem ; symtab [i].off := dc ;
|
|
|
+ symtab [i].fldFirst := recFldFirst ;
|
|
|
+ symtab [i].fldLast := recFldLast ;
|
|
|
dc := dc + size ;
|
|
|
INC (i)
|
|
|
END
|
|
|
END ;
|
|
|
varspc := varspc + size * (symTop - first)
|
|
|
ELSE
|
|
|
- IF (size > 2) AND (cls # TString) THEN
|
|
|
+ IF (size > 2) AND (cls # TString) AND (cls # TRecord) THEN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -4177,6 +4261,8 @@ BEGIN
|
|
|
WHILE i < symTop DO
|
|
|
symtab [i].cls := cls ; symtab [i].size := size ;
|
|
|
symtab [i].elem := elem ;
|
|
|
+ symtab [i].fldFirst := recFldFirst ;
|
|
|
+ symtab [i].fldLast := recFldLast ;
|
|
|
symtab [i].off := (locFree - size + 1) MOD 10000H ;
|
|
|
locFree := (locFree - size) MOD 10000H ;
|
|
|
INC (i)
|
|
|
@@ -4548,6 +4634,12 @@ BEGIN
|
|
|
symtab [tidx].lo := enumLo ;
|
|
|
symtab [tidx].hi := enumHi
|
|
|
END ;
|
|
|
+ IF cls = TRecord THEN
|
|
|
+ (* and a record's fields live in the field table; the type records
|
|
|
+ which range is its own *)
|
|
|
+ symtab [tidx].fldFirst := recFldFirst ;
|
|
|
+ symtab [tidx].fldLast := recFldLast
|
|
|
+ END ;
|
|
|
DropC (tidx) ;
|
|
|
IF NOT MatchDelim (';') THEN
|
|
|
Err (ENoSemi) ;
|
