|
|
@@ -1389,6 +1389,22 @@ BEGIN
|
|
|
EmPushDi ()
|
|
|
END EmStoreVarIndPrep ;
|
|
|
|
|
|
+PROCEDURE EmStDiImm (off, v : CARDINAL) ;
|
|
|
+(* MOV byte [DI+off],imm8: one byte of a set constructor stored through a
|
|
|
+ DI-addressed record field. Sets are at most 32 bytes, so disp8 is enough. *)
|
|
|
+BEGIN
|
|
|
+ Ebyte (0C6H) ; Ebyte (45H) ; Ebyte (VAL (BYTE, off)) ; Ebyte (VAL (BYTE, v))
|
|
|
+END EmStDiImm ;
|
|
|
+
|
|
|
+PROCEDURE EmLdAlDiOff (off : CARDINAL) ;
|
|
|
+(* MOV AL,[DI+off]: the byte of a set variable that holds an element's bit. *)
|
|
|
+BEGIN
|
|
|
+ Ebyte (8AH) ; Ebyte (45H) ; Ebyte (VAL (BYTE, off))
|
|
|
+END EmLdAlDiOff ;
|
|
|
+
|
|
|
+PROCEDURE EmAndAlImm (v : CARDINAL) ;
|
|
|
+BEGIN Ebyte (24H) ; Ebyte (VAL (BYTE, v)) END EmAndAlImm ; (* AND AL,imm8 *)
|
|
|
+
|
|
|
PROCEDURE EmStoreInd (nbytes : CARDINAL) ;
|
|
|
(* [DI] := AL/WORD, after POP DI - the companion of EmStoreVarIndPrep. *)
|
|
|
BEGIN
|
|
|
@@ -2333,7 +2349,15 @@ BEGIN
|
|
|
+ VAL (LONGINT, fields [fi].off)) ;
|
|
|
END ;
|
|
|
r.cls := fields [fi].cls ;
|
|
|
- r.sz := fields [fi].size
|
|
|
+ r.sz := fields [fi].size ;
|
|
|
+ IF r.cls = TSet THEN
|
|
|
+ (* ParseVar set setoff only when the SYMBOL itself was a set; for
|
|
|
+ an array/record the class was still TArray/TRecord then, so the
|
|
|
+ base offset has to be recorded now. *)
|
|
|
+ r.setoff := symtab [r.idx].off ;
|
|
|
+ r.setbase := fields [fi].elem ;
|
|
|
+ r.setsize := fields [fi].size
|
|
|
+ END
|
|
|
ELSIF CurCh () = '[' THEN
|
|
|
DropCh (GetCh ()) ;
|
|
|
IF symtab [r.idx].cls = TString THEN
|
|
|
@@ -2969,7 +2993,8 @@ PROCEDURE FoldSetIn (left, right : ERes ; VAR res : ERes) ;
|
|
|
answers at run time (AH > 255 -> FALSE, else test the bit). A run-time
|
|
|
element or a run-time set is still ENoLib - that is the next milestone, and
|
|
|
it must stay LOUD rather than silently answer wrong. *)
|
|
|
-VAR off, base, size, rel, bidx, bit, m, o : CARDINAL ; isIn : BOOLEAN ;
|
|
|
+VAR off, base, size, rel, bidx, bit, m, o : CARDINAL ;
|
|
|
+ isIn, foldable : BOOLEAN ;
|
|
|
BEGIN
|
|
|
res.kind := 0 ;
|
|
|
res.imm := 0 ;
|
|
|
@@ -2979,6 +3004,50 @@ BEGIN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ (* A code-resident set (an inline literal or a typed constant) folds at
|
|
|
+ compile time. A DATA set - a record field, local or global, or one
|
|
|
+ addressed through DI - must be tested at run time: its byte is in the
|
|
|
+ image's data area, not in cbuf. A typed constant's offset is below
|
|
|
+ dataBase; a global's is at or above it. *)
|
|
|
+ foldable := (right.kind = 7) ;
|
|
|
+ IF (right.kind = 1) AND NOT symtab [right.idx].local
|
|
|
+ AND (right.setoff + right.boff < dataBase) THEN
|
|
|
+ foldable := TRUE
|
|
|
+ END ;
|
|
|
+ IF NOT foldable THEN
|
|
|
+ IF (left.imm >= 0) AND (left.imm <= 255) THEN
|
|
|
+ base := right.setbase ; size := right.setsize ;
|
|
|
+ rel := VAL (CARDINAL, left.imm) ;
|
|
|
+ IF rel >= base THEN
|
|
|
+ bidx := (rel - base) DIV 8 ;
|
|
|
+ IF bidx < size THEN
|
|
|
+ bit := (rel - base) MOD 8 ;
|
|
|
+ m := 1 ;
|
|
|
+ WHILE bit > 0 DO
|
|
|
+ m := m * 2 ; DEC (bit)
|
|
|
+ END ;
|
|
|
+ IF right.kind = 5 THEN
|
|
|
+ EmLdAlDiOff (bidx)
|
|
|
+ ELSIF right.kind = 1 THEN
|
|
|
+ EmLoadVar (symtab [right.idx].local,
|
|
|
+ (right.setoff + right.boff + bidx) MOD 10000H, 1)
|
|
|
+ ELSE
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ EmAndAlImm (m) ;
|
|
|
+ EmMovAh0 () ;
|
|
|
+ EmOrAxAx () ;
|
|
|
+ EmRelSetcc (2) ; (* SETNE: the bit was set *)
|
|
|
+ res.kind := 2 ;
|
|
|
+ res.cls := TBool ;
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ res.imm := 0 ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
isIn := FALSE ;
|
|
|
IF (left.imm >= 0) AND (left.imm <= 255) THEN
|
|
|
off := right.setoff ; base := right.setbase ; size := right.setsize ;
|
|
|
@@ -3403,12 +3472,17 @@ BEGIN
|
|
|
r.kind := 5
|
|
|
ELSE
|
|
|
r.kind := 1 ;
|
|
|
+ r.setoff := symtab [withIdx [w]].off ;
|
|
|
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 ;
|
|
|
+ IF r.cls = TSet THEN
|
|
|
+ r.setbase := fields [fi].elem ;
|
|
|
+ r.setsize := fields [fi].size
|
|
|
+ END ;
|
|
|
r.chr := FALSE ;
|
|
|
RETURN TRUE
|
|
|
END
|
|
|
@@ -3802,11 +3876,49 @@ PROCEDURE Assignment (r : ERes) ;
|
|
|
(* ':=' already consumed by the caller; store expression into r *)
|
|
|
VAR src : ERes ;
|
|
|
k, n : CARDINAL ;
|
|
|
+ sbuf : ARRAY [0..31] OF CHAR ;
|
|
|
BEGIN
|
|
|
IF (r.kind # 1) AND (r.kind # 5) THEN
|
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF r.cls = TSet THEN
|
|
|
+ (* `field := [elements]'. The constructor's TYPE comes from the target:
|
|
|
+ CALC's CellStatus is `set of Attributes' (one byte), not the default
|
|
|
+ 32-byte `set of Char' an untyped literal would become. The bytes are
|
|
|
+ known at compile time; store them at symbol+boff or through DI. *)
|
|
|
+ IF (r.setsize = 0) OR (r.setsize > 32) THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ Skip () ;
|
|
|
+ IF CurCh () # '[' THEN
|
|
|
+ (* set := set, or a set expression: the next increment *)
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF NOT RdSetLiteral (r.setbase, r.setsize, sbuf) THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < r.setsize DO
|
|
|
+ EmStDiImm (k, ORD (sbuf [k])) ;
|
|
|
+ INC (k)
|
|
|
+ END
|
|
|
+ ELSIF r.kind = 1 THEN
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < r.setsize DO
|
|
|
+ EmMovAxi (ORD (sbuf [k])) ;
|
|
|
+ EmStoreVar (symtab [r.idx].local,
|
|
|
+ (symtab [r.idx].off + r.boff + k) MOD 10000H, 1) ;
|
|
|
+ INC (k)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ Err (ENoLib)
|
|
|
+ END ;
|
|
|
+ RETURN
|
|
|
+ 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.
|