|
|
@@ -146,7 +146,7 @@ CONST
|
|
|
BI_New = 23 ; BI_Dispose = 24 ; BI_Eof = 25 ; BI_Val = 26 ;
|
|
|
BI_Copy = 27 ; BI_Abs = 28 ; BI_Sqrt = 29 ; BI_Sqr = 30 ;
|
|
|
BI_Ln = 31 ; BI_Exp = 32 ; BI_Sin = 33 ; BI_Cos = 34 ; BI_Arctan = 35 ;
|
|
|
- BI_Int = 36 ; BI_Delete = 37 ; BI_Insert = 38 ;
|
|
|
+ BI_Int = 36 ; BI_Delete = 37 ; BI_Insert = 38 ; BI_Ord = 39 ;
|
|
|
(* the sub-codes EmCrtSeq takes *)
|
|
|
CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
|
|
|
CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
|
|
|
@@ -252,6 +252,8 @@ TYPE
|
|
|
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 *)
|
|
|
+ fldFirst, fldLast : CARDINAL ; (* current record metadata *)
|
|
|
+ arrIdx : CARDINAL ; (* current array shape, if any *)
|
|
|
END ;
|
|
|
|
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
|
@@ -264,6 +266,8 @@ TYPE
|
|
|
elem : CARDINAL ;
|
|
|
off : CARDINAL ; (* byte offset within the record *)
|
|
|
lo, hi : LONGINT ; (* bounds, for a subrange/enum field *)
|
|
|
+ fldFirst, fldLast : CARDINAL ; (* nested record metadata *)
|
|
|
+ arrIdx : CARDINAL ;
|
|
|
END ;
|
|
|
|
|
|
ArrRec =
|
|
|
@@ -272,6 +276,7 @@ TYPE
|
|
|
lo, hi : ARRAY [0..3] OF LONGINT ;
|
|
|
elem : CARDINAL ; (* element size in bytes *)
|
|
|
ecls : CARDINAL ; (* element CLASS, for a subscripted value *)
|
|
|
+ fldFirst, fldLast : CARDINAL ; (* leaf record metadata *)
|
|
|
END ;
|
|
|
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
@@ -395,10 +400,12 @@ VAR
|
|
|
TU_WrInt : CARDINAL ; TU_WrIntW : CARDINAL ;
|
|
|
TU_WrChar : CARDINAL ; TU_WrBool : CARDINAL ;
|
|
|
TU_WrCharW : CARDINAL ; TU_WrBoolW : CARDINAL ; TU_WrStrW : CARDINAL ;
|
|
|
+ TU_MemCopy : CARDINAL ;
|
|
|
TU_WrReal : CARDINAL ; TU_RealWrite : CARDINAL ; TU_RealFmt : CARDINAL ;
|
|
|
TU_RealVal : CARDINAL ; TU_RealCmp : CARDINAL ;
|
|
|
TU_RealAdd : CARDINAL ; TU_RealSub : CARDINAL ;
|
|
|
TU_RealMul : CARDINAL ; TU_RealDiv : CARDINAL ;
|
|
|
+ TU_RealFromInt : CARDINAL ;
|
|
|
TU_WrLn : CARDINAL ;
|
|
|
TU_RdInt : CARDINAL ; TU_RdChar : CARDINAL ; TU_RdBool : CARDINAL ;
|
|
|
TU_RdLn : CARDINAL ; TU_Halt : CARDINAL ;
|
|
|
@@ -2711,7 +2718,10 @@ BEGIN
|
|
|
r.kind := 5 ;
|
|
|
r.boff := 0 ;
|
|
|
r.cls := symtab [p].cls ;
|
|
|
- r.sz := symtab [p].size
|
|
|
+ r.sz := symtab [p].size ;
|
|
|
+ r.fldFirst := symtab [p].fldFirst ;
|
|
|
+ r.fldLast := symtab [p].fldLast ;
|
|
|
+ r.arrIdx := symtab [p].arrIdx
|
|
|
ELSIF 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
|
|
|
@@ -2723,13 +2733,13 @@ BEGIN
|
|
|
RETURN
|
|
|
END ;
|
|
|
GetWord () ;
|
|
|
- IF symtab [r.idx].fldFirst >= symtab [r.idx].fldLast THEN
|
|
|
+ IF r.fldFirst >= r.fldLast THEN
|
|
|
Err (ESimpType) ; (* not a record *)
|
|
|
RETURN
|
|
|
END ;
|
|
|
- fi := symtab [r.idx].fldFirst ;
|
|
|
+ fi := r.fldFirst ;
|
|
|
found := FALSE ;
|
|
|
- WHILE (fi < symtab [r.idx].fldLast) AND NOT found DO
|
|
|
+ WHILE (fi < r.fldLast) AND NOT found DO
|
|
|
IF NameEq (fields [fi].name, wrd) THEN
|
|
|
found := TRUE
|
|
|
ELSE
|
|
|
@@ -2754,6 +2764,9 @@ BEGIN
|
|
|
END ;
|
|
|
r.cls := fields [fi].cls ;
|
|
|
r.sz := fields [fi].size ;
|
|
|
+ r.fldFirst := fields [fi].fldFirst ;
|
|
|
+ r.fldLast := fields [fi].fldLast ;
|
|
|
+ r.arrIdx := fields [fi].arrIdx ;
|
|
|
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
|
|
|
@@ -2764,7 +2777,7 @@ BEGIN
|
|
|
END
|
|
|
ELSIF CurCh () = '[' THEN
|
|
|
DropCh (GetCh ()) ;
|
|
|
- IF symtab [r.idx].cls = TString THEN
|
|
|
+ IF r.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. *)
|
|
|
@@ -2816,7 +2829,7 @@ BEGIN
|
|
|
r.sz := 1
|
|
|
END ;
|
|
|
ExpectDelim (']', ENoSemi)
|
|
|
- ELSIF symtab [r.idx].cls = TArray THEN
|
|
|
+ ELSIF r.arrIdx > 0 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]
|
|
|
@@ -2825,12 +2838,8 @@ BEGIN
|
|
|
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 symtab [r.idx].arrIdx = 0 THEN
|
|
|
- Err (ESimpType) ;
|
|
|
- RETURN
|
|
|
- END ;
|
|
|
baseDI := (r.kind = 5) ;
|
|
|
- ai := symtab [r.idx].arrIdx - 1 ;
|
|
|
+ ai := r.arrIdx - 1 ;
|
|
|
nd := 0 ;
|
|
|
coff := 0 ;
|
|
|
accOnStack := FALSE ;
|
|
|
@@ -2928,7 +2937,10 @@ BEGIN
|
|
|
r.boff := W16 (VAL (LONGINT, r.boff) + coff)
|
|
|
END ;
|
|
|
r.sz := arrs [ai].elem ;
|
|
|
- r.cls := arrs [ai].ecls
|
|
|
+ r.cls := arrs [ai].ecls ;
|
|
|
+ r.fldFirst := arrs [ai].fldFirst ;
|
|
|
+ r.fldLast := arrs [ai].fldLast ;
|
|
|
+ r.arrIdx := 0
|
|
|
ELSE
|
|
|
ParseExpr (t) ;
|
|
|
IF OK () THEN
|
|
|
@@ -2969,6 +2981,9 @@ BEGIN
|
|
|
r.boff := 0 ;
|
|
|
r.cls := symtab [p].cls ;
|
|
|
r.sz := symtab [p].size ;
|
|
|
+ r.fldFirst := symtab [p].fldFirst ;
|
|
|
+ r.fldLast := symtab [p].fldLast ;
|
|
|
+ r.arrIdx := symtab [p].arrIdx ;
|
|
|
ParseSub (r) ;
|
|
|
RETURN
|
|
|
END
|
|
|
@@ -2994,6 +3009,9 @@ BEGIN
|
|
|
r.setsize := symtab [r.idx].size
|
|
|
END ;
|
|
|
r.sz := symtab [r.idx].size ;
|
|
|
+ r.fldFirst := symtab [r.idx].fldFirst ;
|
|
|
+ r.fldLast := symtab [r.idx].fldLast ;
|
|
|
+ r.arrIdx := symtab [r.idx].arrIdx ;
|
|
|
ParseSub (r)
|
|
|
END ParseVar ;
|
|
|
|
|
|
@@ -3034,7 +3052,9 @@ PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
|
|
|
VAR f : LONGINT ;
|
|
|
okc : BOOLEAN ;
|
|
|
BEGIN
|
|
|
- IF (left.cls = TReal) OR (right.cls = TReal) THEN
|
|
|
+ IF (left.cls = TReal) OR (right.cls = TReal) OR (op = OpDiv) THEN
|
|
|
+ (* `/` is real division even when both operands are integers; Pascal's
|
|
|
+ `div` is the integer operator and has its own token. *)
|
|
|
RealBin (op, left, right, res) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -4371,6 +4391,9 @@ BEGIN
|
|
|
r.idx := withIdx [w] ;
|
|
|
r.cls := fields [fi].cls ;
|
|
|
r.sz := fields [fi].size ;
|
|
|
+ r.fldFirst := fields [fi].fldFirst ;
|
|
|
+ r.fldLast := fields [fi].fldLast ;
|
|
|
+ r.arrIdx := fields [fi].arrIdx ;
|
|
|
IF r.cls = TSet THEN
|
|
|
r.setbase := fields [fi].elem ;
|
|
|
r.setsize := fields [fi].size
|
|
|
@@ -4674,7 +4697,7 @@ BEGIN
|
|
|
IF NOT OK () THEN
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF (r.cls # TChar) AND (r.cls # TScalar) THEN
|
|
|
+ IF (r.cls # TChar) AND (r.cls # TScalar) AND (r.cls # TEnum) THEN
|
|
|
Err (ETypeErr) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -4804,6 +4827,26 @@ BEGIN
|
|
|
Err (ETypeErr)
|
|
|
END ;
|
|
|
RETURN
|
|
|
+ ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Ord) THEN
|
|
|
+ IF NOT MatchDelim ('(') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ ParseExpr (r) ;
|
|
|
+ ExpectDelim (')', ENoSemi) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF (r.cls # TChar) AND (r.cls # TEnum) AND (r.cls # TScalar)
|
|
|
+ AND (r.cls # TBool) THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ LoadAtom (r) ;
|
|
|
+ r.kind := 2 ;
|
|
|
+ r.cls := TScalar ;
|
|
|
+ r.chr := FALSE ;
|
|
|
+ RETURN
|
|
|
ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Length) THEN
|
|
|
(* LENGTH (s): the string's length byte, loaded inline. No runtime
|
|
|
entry, and no address is pushed - a string's value already carries its
|
|
|
@@ -5204,6 +5247,32 @@ BEGIN
|
|
|
END
|
|
|
END IntToMbf ;
|
|
|
|
|
|
+PROCEDURE RealOperand (r : ERes ; dstOff : CARDINAL) ;
|
|
|
+(* Copy a REAL operand into a 6-byte scratch, converting an ordinal value to
|
|
|
+ REAL first. RealBin and RealUnary used to call EmCopyRealTo directly; an
|
|
|
+ INTEGER variable there was refused, so `E := A/B' could not compile. *)
|
|
|
+VAR tmp : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ IF r.cls = TReal THEN
|
|
|
+ EmCopyRealTo (dstOff, r)
|
|
|
+ ELSIF (r.cls = TSet) OR (r.cls = TString) THEN
|
|
|
+ Err (ETypeErr)
|
|
|
+ ELSE
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ ELSIF r.kind = 1 THEN
|
|
|
+ EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
+ ELSE
|
|
|
+ LoadAtom (r) ;
|
|
|
+ EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
|
|
|
+ EmPushVarAddr (FALSE, symtab [tmpA].off)
|
|
|
+ END ;
|
|
|
+ EmPushVarAddr (FALSE, dstOff) ;
|
|
|
+ DropC (EmCall (TU_RealFromInt)) ;
|
|
|
+ EmAddSp (4)
|
|
|
+ END
|
|
|
+END RealOperand ;
|
|
|
+
|
|
|
PROCEDURE RealBin (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
|
|
|
(* REAL + - * / using the runtime's 12-byte block entries. SaveLeft has
|
|
|
already copied a REAL left operand to a stable scratch; a kind-5 right is
|
|
|
@@ -5212,11 +5281,11 @@ VAR block, ent : CARDINAL ;
|
|
|
BEGIN
|
|
|
block := NewScratchRealBlock () ;
|
|
|
IF right.kind = 5 THEN
|
|
|
- EmCopyRealTo (symtab [block].off + 6, right) ;
|
|
|
- EmCopyRealTo (symtab [block].off, left)
|
|
|
+ RealOperand (right, symtab [block].off + 6) ;
|
|
|
+ RealOperand (left, symtab [block].off)
|
|
|
ELSE
|
|
|
- EmCopyRealTo (symtab [block].off, left) ;
|
|
|
- EmCopyRealTo (symtab [block].off + 6, right)
|
|
|
+ RealOperand (left, symtab [block].off) ;
|
|
|
+ RealOperand (right, symtab [block].off + 6)
|
|
|
END ;
|
|
|
CASE op OF
|
|
|
OpAdd : ent := TU_RealAdd
|
|
|
@@ -5265,6 +5334,46 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF ((r.kind = 1) OR (r.kind = 5)) AND (VarSize (r) > 2)
|
|
|
+ AND ((r.cls = TRecord) OR (r.cls = TArray)) THEN
|
|
|
+ (* Whole record/array assignment: copy VarSize(r) bytes. This is what
|
|
|
+ BIGREC/DYNREC's `Mother := Self', `Father^ := Mother^' and
|
|
|
+ `Friend[Index] := Mother' need. A DI-addressed destination has to
|
|
|
+ be parked before the source expression can reuse DI. *)
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ END ;
|
|
|
+ ParseExpr (src) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF (src.kind # 1) AND (src.kind # 5) THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF VarSize (src) # VarSize (r) THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF src.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ ELSE
|
|
|
+ EmPushSymAddr (src.idx, (symtab [src.idx].off + src.boff) MOD 10000H)
|
|
|
+ END ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ (* stack now holds dest, source; make it source, dest for the ABI *)
|
|
|
+ EmPopAx () ;
|
|
|
+ EmPopBx () ;
|
|
|
+ EmPushAx () ;
|
|
|
+ EmPushBx ()
|
|
|
+ ELSE
|
|
|
+ EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
+ END ;
|
|
|
+ EmMovCxi (VarSize (r)) ;
|
|
|
+ DropC (EmCall (TU_MemCopy)) ;
|
|
|
+ EmAddSp (4) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF r.cls = TReal THEN
|
|
|
(* A 6-byte REAL. A compile-time ordinal constant is converted to the
|
|
|
measured MBF layout; another REAL field is copied byte for byte.
|
|
|
@@ -7043,7 +7152,7 @@ BEGIN
|
|
|
Err (ECompOvf) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF symtab [t.idx].fldFirst >= symtab [t.idx].fldLast THEN
|
|
|
+ IF t.fldFirst >= t.fldLast THEN
|
|
|
Err (ETypeErr) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -7064,8 +7173,8 @@ BEGIN
|
|
|
RETURN
|
|
|
END ;
|
|
|
withIdx [withN] := t.idx ;
|
|
|
- withFF [withN] := symtab [t.idx].fldFirst ;
|
|
|
- withFL [withN] := symtab [t.idx].fldLast ;
|
|
|
+ withFF [withN] := t.fldFirst ;
|
|
|
+ withFL [withN] := t.fldLast ;
|
|
|
INC (withN) ;
|
|
|
IF MatchDelim (',') THEN
|
|
|
(* another base; the last one is innermost *)
|
|
|
@@ -7082,6 +7191,8 @@ BEGIN
|
|
|
ELSE
|
|
|
(* identifier statement: assignment or call *)
|
|
|
IF WithLookup (wrd, t) THEN
|
|
|
+ (* A field inside WITH may be followed by `.subfield' or `[index]'. *)
|
|
|
+ ParseSub (t) ;
|
|
|
IF MatchAssign () THEN
|
|
|
Assignment (t) ;
|
|
|
RETURN
|
|
|
@@ -7115,6 +7226,9 @@ BEGIN
|
|
|
t.cls := symtab [t.idx].cls
|
|
|
END ;
|
|
|
t.sz := symtab [t.idx].size ; (* ParseSub may narrow it further *)
|
|
|
+ t.fldFirst := symtab [t.idx].fldFirst ;
|
|
|
+ t.fldLast := symtab [t.idx].fldLast ;
|
|
|
+ t.arrIdx := symtab [t.idx].arrIdx ;
|
|
|
IF t.cls = TSet THEN
|
|
|
(* The identifier-statement path does not go through ParseVar, so
|
|
|
it must carry the same set metadata: Assignment's set branch
|
|
|
@@ -7150,6 +7264,7 @@ VAR tok : CARDINAL ;
|
|
|
consumed : BOOLEAN ;
|
|
|
running, groupFirst, i, an, recStart : CARDINAL ;
|
|
|
innerIdx, innerN, leafElem, leafCls, j : CARDINAL ;
|
|
|
+ elemFldFirst, elemFldLast, fieldFldFirst, fieldFldLast, fieldArrIdx : CARDINAL ;
|
|
|
alo, ahi : ARRAY [0..3] OF LONGINT ;
|
|
|
ecls2 : CARDINAL ;
|
|
|
BEGIN
|
|
|
@@ -7278,6 +7393,8 @@ BEGIN
|
|
|
ParseType (cls, s2, e2) ;
|
|
|
ecls2 := cls ;
|
|
|
innerIdx := newArrIdx ;
|
|
|
+ elemFldFirst := recFldFirst ;
|
|
|
+ elemFldLast := recFldLast ;
|
|
|
IF (cls = TArray) AND (innerIdx > 0) THEN
|
|
|
(* Flatten array-of-array: the outer symbol must index the same
|
|
|
number of dimensions as `array[a,b]'. A named element array
|
|
|
@@ -7285,6 +7402,8 @@ BEGIN
|
|
|
inner ArrRec; keep only the leaf element size and class here. *)
|
|
|
leafElem := arrs [innerIdx - 1].elem ;
|
|
|
leafCls := arrs [innerIdx - 1].ecls ;
|
|
|
+ elemFldFirst := arrs [innerIdx - 1].fldFirst ;
|
|
|
+ elemFldLast := arrs [innerIdx - 1].fldLast ;
|
|
|
innerN := arrs [innerIdx - 1].n
|
|
|
ELSE
|
|
|
leafElem := s2 ;
|
|
|
@@ -7306,6 +7425,8 @@ BEGIN
|
|
|
arrs [arrTop].n := an + innerN ;
|
|
|
arrs [arrTop].elem := leafElem ;
|
|
|
arrs [arrTop].ecls := leafCls ;
|
|
|
+ arrs [arrTop].fldFirst := elemFldFirst ;
|
|
|
+ arrs [arrTop].fldLast := elemFldLast ;
|
|
|
i := 0 ;
|
|
|
WHILE i < an DO
|
|
|
arrs [arrTop].lo [i] := alo [i] ;
|
|
|
@@ -7396,6 +7517,9 @@ BEGIN
|
|
|
IF NOT OK () THEN
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ fieldFldFirst := recFldFirst ;
|
|
|
+ fieldFldLast := recFldLast ;
|
|
|
+ fieldArrIdx := newArrIdx ;
|
|
|
(* every name in the group gets the type and its own slot *)
|
|
|
i := groupFirst ;
|
|
|
WHILE i < fldTop DO
|
|
|
@@ -7405,6 +7529,9 @@ BEGIN
|
|
|
fields [i].off := running ;
|
|
|
fields [i].lo := enumLo ;
|
|
|
fields [i].hi := enumHi ;
|
|
|
+ fields [i].fldFirst := fieldFldFirst ;
|
|
|
+ fields [i].fldLast := fieldFldLast ;
|
|
|
+ fields [i].arrIdx := fieldArrIdx ;
|
|
|
running := running + s2 ;
|
|
|
INC (i)
|
|
|
END ;
|
|
|
@@ -7459,7 +7586,30 @@ BEGIN
|
|
|
END
|
|
|
ELSE
|
|
|
IF consumed THEN
|
|
|
- IF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
|
|
|
+ IF Search (wrd, idx) AND (symtab [idx].tag = KConst) THEN
|
|
|
+ (* An enum/ordinal subrange written with named constants:
|
|
|
+ `Work = Mon..Fri`. Without this, `Mon' was mistaken for a
|
|
|
+ named TYPE and failed at the first dot. *)
|
|
|
+ lo := symtab [idx].lval ;
|
|
|
+ subcls := symtab [idx].cls ;
|
|
|
+ IF NOT MatchRange () THEN
|
|
|
+ Err (ESimpType) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ RdConst (hi, subcls, strf) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ cls := TEnum ;
|
|
|
+ IF (lo >= 0) AND (hi <= 255) AND (lo <= hi) THEN
|
|
|
+ size := 1
|
|
|
+ ELSE
|
|
|
+ size := 2
|
|
|
+ END ;
|
|
|
+ elem := size ;
|
|
|
+ enumLo := lo ;
|
|
|
+ enumHi := hi
|
|
|
+ ELSIF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
|
|
|
cls := symtab [idx].cls ;
|
|
|
size := symtab [idx].size ;
|
|
|
(* The type's ELEMENT size, not its total size. They are equal for
|
|
|
@@ -8381,6 +8531,8 @@ BEGIN
|
|
|
i := NewSym ("KEYPRESSED", KBuiltin, BI_KeyPressed, 0, 0, 0, 0, FALSE) ;
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
i := NewSym ("UPCASE", KBuiltin, BI_UpCase, 0, 0, 0, 0, FALSE) ;
|
|
|
+ i := NewSym ("ORD", KBuiltin, BI_Ord, 0, 0, 0, 0, FALSE) ;
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
i := NewSym ("SUCC", KBuiltin, BI_Succ, 0, 0, 0, 0, FALSE) ;
|
|
|
i := NewSym ("PRED", KBuiltin, BI_Pred, 0, 0, 0, 0, FALSE) ;
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
@@ -8583,12 +8735,14 @@ BEGIN
|
|
|
TU_WrCharW := RT_Entry (56) ;
|
|
|
TU_WrBoolW := RT_Entry (57) ;
|
|
|
TU_WrStrW := RT_Entry (58) ;
|
|
|
+ TU_MemCopy := RT_Entry (59) ;
|
|
|
TU_WrReal := RT_Entry (6) ;
|
|
|
TU_RealWrite := RT_Entry (30) ; (* fmtreal + padding + output *)
|
|
|
TU_RealFmt := RT_Entry (28) ; (* fmtreal into a string variable *)
|
|
|
TU_RealVal := RT_Entry (29) ; (* ascreal: ASCIIZ -> REAL *)
|
|
|
TU_RealCmp := RT_Entry (26) ; (* recmp: AX = -1/0/+1 *)
|
|
|
TU_RealAdd := RT_Entry (22) ;
|
|
|
+ TU_RealFromInt := RT_Entry (21) ;
|
|
|
TU_RealSub := RT_Entry (23) ;
|
|
|
TU_RealMul := RT_Entry (24) ;
|
|
|
TU_RealDiv := RT_Entry (25) ;
|
