|
@@ -7502,7 +7502,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
|
|
|
isStr : BOOLEAN ;
|
|
isStr : BOOLEAN ;
|
|
|
tok : CARDINAL ;
|
|
tok : CARDINAL ;
|
|
|
typed, setTyped, arrTyped : BOOLEAN ;
|
|
typed, setTyped, arrTyped : BOOLEAN ;
|
|
|
- nb, k, divi, w, slen : CARDINAL ;
|
|
|
|
|
|
|
+ nb, k, divi, w, slen, eltCls : CARDINAL ;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
LOOP
|
|
LOOP
|
|
|
PeekKw (tok) ;
|
|
PeekKw (tok) ;
|
|
@@ -7555,12 +7555,16 @@ BEGIN
|
|
|
DropC (NewSym (nm, KVar, TSet, typSize, typElem, soff, 0, FALSE))
|
|
DropC (NewSym (nm, KVar, TSet, typSize, typElem, soff, 0, FALSE))
|
|
|
END
|
|
END
|
|
|
ELSIF OK () AND arrTyped THEN
|
|
ELSIF OK () AND arrTyped THEN
|
|
|
- (* array typed constant: `(v1, v2, ...)' in element order, each value
|
|
|
|
|
- written little-endian in typElem bytes. CALC's is XPOS (seven
|
|
|
|
|
- Integers, 14 bytes). An element that is a STRING (CALC.INC's
|
|
|
|
|
- StandardfunctionNames) is a later increment, and is refused here. *)
|
|
|
|
|
|
|
+ (* array typed constant: `(v1, v2, ...)' in element order. Integers
|
|
|
|
|
+ are written little-endian in typElem bytes; a STRING element is
|
|
|
|
|
+ <length><chars>. CALC uses both XPOS (Integers) and
|
|
|
|
|
+ StandardfunctionNames (string[6]). *)
|
|
|
ExpectDelim ('=', ENoSemi) ;
|
|
ExpectDelim ('=', ENoSemi) ;
|
|
|
ExpectDelim ('(', ENoSemi) ;
|
|
ExpectDelim ('(', ENoSemi) ;
|
|
|
|
|
+ eltCls := 0 ;
|
|
|
|
|
+ IF newArrIdx > 0 THEN
|
|
|
|
|
+ eltCls := arrs [newArrIdx - 1].ecls
|
|
|
|
|
+ END ;
|
|
|
nb := 0 ;
|
|
nb := 0 ;
|
|
|
LOOP
|
|
LOOP
|
|
|
RdConst (v, cls, isStr) ;
|
|
RdConst (v, cls, isStr) ;
|
|
@@ -7568,25 +7572,43 @@ BEGIN
|
|
|
Err (ECompOvf) ;
|
|
Err (ECompOvf) ;
|
|
|
EXIT
|
|
EXIT
|
|
|
END ;
|
|
END ;
|
|
|
- IF isStr THEN
|
|
|
|
|
|
|
+ IF isStr OR ((eltCls = TString) AND (v >= 0) AND (v <= 255)) THEN
|
|
|
(* A string element is <length><chars>, padded with NULs to
|
|
(* A string element is <length><chars>, padded with NULs to
|
|
|
- typElem bytes. StandardfunctionNames is array of string[6]. *)
|
|
|
|
|
- slen := strLen [rdStrX] ;
|
|
|
|
|
- IF slen > typElem - 1 THEN
|
|
|
|
|
- slen := typElem - 1
|
|
|
|
|
|
|
+ typElem bytes. StandardfunctionNames is array of string[6].
|
|
|
|
|
+ A single-character literal ('I') is a TScalar, not a
|
|
|
|
|
+ string, so an array of STRING must still store it as a
|
|
|
|
|
+ one-character element. Treating it as an integer divided
|
|
|
|
|
+ by 256 once per byte and hit DIV by zero at the fourth. *)
|
|
|
|
|
+ IF isStr THEN
|
|
|
|
|
+ slen := strLen [rdStrX] ;
|
|
|
|
|
+ IF slen > typElem - 1 THEN
|
|
|
|
|
+ slen := typElem - 1
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ slen := 1
|
|
|
END ;
|
|
END ;
|
|
|
constBlob [nb] := CHR (slen) ;
|
|
constBlob [nb] := CHR (slen) ;
|
|
|
k := 0 ;
|
|
k := 0 ;
|
|
|
WHILE k < typElem - 1 DO
|
|
WHILE k < typElem - 1 DO
|
|
|
IF k < slen THEN
|
|
IF k < slen THEN
|
|
|
- constBlob [nb + 1 + k] :=
|
|
|
|
|
- strPool [strOff [rdStrX] + k]
|
|
|
|
|
|
|
+ IF isStr THEN
|
|
|
|
|
+ constBlob [nb + 1 + k] :=
|
|
|
|
|
+ strPool [strOff [rdStrX] + k]
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ constBlob [nb + 1 + k] := CHR (v)
|
|
|
|
|
+ END
|
|
|
ELSE
|
|
ELSE
|
|
|
constBlob [nb + 1 + k] := CHR (0)
|
|
constBlob [nb + 1 + k] := CHR (0)
|
|
|
END ;
|
|
END ;
|
|
|
INC (k)
|
|
INC (k)
|
|
|
END ;
|
|
END ;
|
|
|
nb := nb + typElem
|
|
nb := nb + typElem
|
|
|
|
|
+ ELSIF typElem > 2 THEN
|
|
|
|
|
+ (* An array of records/reals has no scalar encoding here.
|
|
|
|
|
+ Refuse loudly instead of shifting a 16-bit value through
|
|
|
|
|
+ divi until it wraps to zero and aborts the compiler. *)
|
|
|
|
|
+ Err (ENoLib) ;
|
|
|
|
|
+ EXIT
|
|
|
ELSE
|
|
ELSE
|
|
|
w := VAL (CARDINAL, W16 (v)) ;
|
|
w := VAL (CARDINAL, W16 (v)) ;
|
|
|
divi := 1 ;
|
|
divi := 1 ;
|