|
|
@@ -147,6 +147,7 @@ CONST
|
|
|
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_Ord = 39 ;
|
|
|
+ BI_Round = 40 ; BI_Trunc = 41 ; BI_Msdos = 42 ; BI_Intr = 43 ;
|
|
|
(* the sub-codes EmCrtSeq takes *)
|
|
|
CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
|
|
|
CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
|
|
|
@@ -174,6 +175,7 @@ CONST
|
|
|
why n * n with n a CONST was correct and a * b with a a variable was
|
|
|
not. *)
|
|
|
OpAdd = 1 ; OpSub = 2 ; OpMul = 3 ; OpDiv = 4 ;
|
|
|
+ OpShl = 5 ; OpShr = 6 ;
|
|
|
|
|
|
(* TP3 error numbers *)
|
|
|
ENoSemi = 1 ; EPointExp = 10 ; ESimpType = 30 ;
|
|
|
@@ -254,6 +256,7 @@ TYPE
|
|
|
field's size, not its variable's *)
|
|
|
fldFirst, fldLast : CARDINAL ; (* current record metadata *)
|
|
|
arrIdx : CARDINAL ; (* current array shape, if any *)
|
|
|
+ ptrElem : CARDINAL ; (* pointee type, for pointer arrays *)
|
|
|
END ;
|
|
|
|
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
|
@@ -268,6 +271,7 @@ TYPE
|
|
|
lo, hi : LONGINT ; (* bounds, for a subrange/enum field *)
|
|
|
fldFirst, fldLast : CARDINAL ; (* nested record metadata *)
|
|
|
arrIdx : CARDINAL ;
|
|
|
+ ptrElem : CARDINAL ;
|
|
|
END ;
|
|
|
|
|
|
ArrRec =
|
|
|
@@ -277,6 +281,11 @@ TYPE
|
|
|
elem : CARDINAL ; (* element size in bytes *)
|
|
|
ecls : CARDINAL ; (* element CLASS, for a subscripted value *)
|
|
|
fldFirst, fldLast : CARDINAL ; (* leaf record metadata *)
|
|
|
+ elemType : CARDINAL ;
|
|
|
+ fieldPtrElem : CARDINAL ;
|
|
|
+ variantBase, armRunning, armMax, savePosVar : CARDINAL ;
|
|
|
+ moreFields : BOOLEAN ;
|
|
|
+ tagName : ARRAY [0..MaxName] OF CHAR ; (* pointer target / named element type *)
|
|
|
END ;
|
|
|
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
@@ -401,6 +410,8 @@ VAR
|
|
|
TU_WrChar : CARDINAL ; TU_WrBool : CARDINAL ;
|
|
|
TU_WrCharW : CARDINAL ; TU_WrBoolW : CARDINAL ; TU_WrStrW : CARDINAL ;
|
|
|
TU_MemCopy : CARDINAL ;
|
|
|
+ TU_RealToInt : CARDINAL ;
|
|
|
+ TU_Msdos : CARDINAL ;
|
|
|
TU_WrReal : CARDINAL ; TU_RealWrite : CARDINAL ; TU_RealFmt : CARDINAL ;
|
|
|
TU_RealVal : CARDINAL ; TU_RealCmp : CARDINAL ;
|
|
|
TU_RealAdd : CARDINAL ; TU_RealSub : CARDINAL ;
|
|
|
@@ -1689,6 +1700,12 @@ BEGIN Ebyte (80H) ; Ebyte (0E1H) ; Ebyte (VAL (BYTE, v)) END EmAndClImm ;
|
|
|
PROCEDURE EmShrAx1 () ;
|
|
|
BEGIN Ebyte (0D1H) ; Ebyte (0E8H) END EmShrAx1 ; (* SHR AX,1 *)
|
|
|
|
|
|
+PROCEDURE EmShlAxCl () ;
|
|
|
+BEGIN Ebyte (0D3H) ; Ebyte (0E0H) END EmShlAxCl ; (* SHL AX,CL *)
|
|
|
+
|
|
|
+PROCEDURE EmShrAxCl () ;
|
|
|
+BEGIN Ebyte (0D3H) ; Ebyte (0E8H) END EmShrAxCl ; (* SHR AX,CL *)
|
|
|
+
|
|
|
PROCEDURE EmMovBxi (v : CARDINAL) ;
|
|
|
BEGIN Ebyte (0BBH) ; Eword (v MOD 10000H) END EmMovBxi ; (* MOV BX,imm16 *)
|
|
|
|
|
|
@@ -2603,6 +2620,15 @@ BEGIN
|
|
|
RETURN symtab [r.idx].size
|
|
|
END VarSize ;
|
|
|
|
|
|
+PROCEDURE IsCharArray (r : ERes) : BOOLEAN ;
|
|
|
+(* A fixed `array[..] of char', as opposed to a counted STRING. *)
|
|
|
+BEGIN
|
|
|
+ IF (r.cls # TArray) OR (r.arrIdx = 0) THEN
|
|
|
+ RETURN FALSE
|
|
|
+ END ;
|
|
|
+ RETURN arrs [r.arrIdx - 1].ecls = TChar
|
|
|
+END IsCharArray ;
|
|
|
+
|
|
|
PROCEDURE LoadAtom (VAR r : ERes) ;
|
|
|
(* load value of r into AX (folding constants).
|
|
|
|
|
|
@@ -2704,15 +2730,21 @@ VAR t : ERes ;
|
|
|
BEGIN
|
|
|
LOOP
|
|
|
Skip () ;
|
|
|
- IF (r.kind = 1) AND (symtab [r.idx].cls = TPtr) AND
|
|
|
- (CurCh () = '^') THEN
|
|
|
- (* Dereference in a statement/assignment path, which reaches ParseSub
|
|
|
- without going through ParseVar. The pointer word is the base
|
|
|
- address; r.idx becomes the pointee TYPE symbol for array/record
|
|
|
- metadata, exactly as in ParseVar. *)
|
|
|
+ IF ((r.cls = TPtr) OR ((r.kind = 1) AND (symtab [r.idx].cls = TPtr)))
|
|
|
+ AND (CurCh () = '^') THEN
|
|
|
+ (* Dereference after a variable, a field or an array element. The
|
|
|
+ pointer word may be an ordinary symbol (kind 1) or the element
|
|
|
+ address already in DI (kind 5, e.g. Friend[Index]^). *)
|
|
|
DropCh (GetCh ()) ;
|
|
|
- p := symtab [r.idx].elem ;
|
|
|
- LoadSymVar (r.idx, symtab [r.idx].off, 2) ;
|
|
|
+ p := r.ptrElem ;
|
|
|
+ IF p = 0 THEN
|
|
|
+ p := symtab [r.idx].elem
|
|
|
+ END ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmLdAxDi () ;
|
|
|
+ ELSE
|
|
|
+ LoadSymVar (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H, 2)
|
|
|
+ END ;
|
|
|
EmMovDiAx () ;
|
|
|
r.idx := p ;
|
|
|
r.kind := 5 ;
|
|
|
@@ -2721,7 +2753,8 @@ BEGIN
|
|
|
r.sz := symtab [p].size ;
|
|
|
r.fldFirst := symtab [p].fldFirst ;
|
|
|
r.fldLast := symtab [p].fldLast ;
|
|
|
- r.arrIdx := symtab [p].arrIdx
|
|
|
+ r.arrIdx := symtab [p].arrIdx ;
|
|
|
+ r.ptrElem := symtab [p].elem
|
|
|
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
|
|
|
@@ -2767,6 +2800,7 @@ BEGIN
|
|
|
r.fldFirst := fields [fi].fldFirst ;
|
|
|
r.fldLast := fields [fi].fldLast ;
|
|
|
r.arrIdx := fields [fi].arrIdx ;
|
|
|
+ r.ptrElem := fields [fi].ptrElem ;
|
|
|
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
|
|
|
@@ -2940,7 +2974,8 @@ BEGIN
|
|
|
r.cls := arrs [ai].ecls ;
|
|
|
r.fldFirst := arrs [ai].fldFirst ;
|
|
|
r.fldLast := arrs [ai].fldLast ;
|
|
|
- r.arrIdx := 0
|
|
|
+ r.arrIdx := 0 ;
|
|
|
+ r.ptrElem := arrs [ai].elemType
|
|
|
ELSE
|
|
|
ParseExpr (t) ;
|
|
|
IF OK () THEN
|
|
|
@@ -2984,6 +3019,7 @@ BEGIN
|
|
|
r.fldFirst := symtab [p].fldFirst ;
|
|
|
r.fldLast := symtab [p].fldLast ;
|
|
|
r.arrIdx := symtab [p].arrIdx ;
|
|
|
+ r.ptrElem := symtab [p].elem ;
|
|
|
ParseSub (r) ;
|
|
|
RETURN
|
|
|
END
|
|
|
@@ -3012,6 +3048,7 @@ BEGIN
|
|
|
r.fldFirst := symtab [r.idx].fldFirst ;
|
|
|
r.fldLast := symtab [r.idx].fldLast ;
|
|
|
r.arrIdx := symtab [r.idx].arrIdx ;
|
|
|
+ r.ptrElem := symtab [r.idx].elem ;
|
|
|
ParseSub (r)
|
|
|
END ParseVar ;
|
|
|
|
|
|
@@ -3084,24 +3121,42 @@ BEGIN
|
|
|
IF (left.kind = 0) AND (right.kind = 0) THEN
|
|
|
res.kind := 0 ;
|
|
|
res.imm := BitAnd (left.imm, right.imm) ;
|
|
|
- res.cls := TBool ;
|
|
|
+ IF (left.cls = TBool) OR (right.cls = TBool) THEN
|
|
|
+ res.cls := TBool
|
|
|
+ ELSE
|
|
|
+ res.cls := left.cls
|
|
|
+ END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
LoadPair (left, right) ;
|
|
|
EmAndAxCx () ;
|
|
|
- res.kind := 2 ; res.cls := TBool ;
|
|
|
+ res.kind := 2 ;
|
|
|
+ IF (left.cls = TBool) OR (right.cls = TBool) THEN
|
|
|
+ res.cls := TBool
|
|
|
+ ELSE
|
|
|
+ res.cls := left.cls
|
|
|
+ END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
IF op = TkOr THEN
|
|
|
IF (left.kind = 0) AND (right.kind = 0) THEN
|
|
|
res.kind := 0 ;
|
|
|
res.imm := BitOr (left.imm, right.imm) ;
|
|
|
- res.cls := TBool ;
|
|
|
+ IF (left.cls = TBool) OR (right.cls = TBool) THEN
|
|
|
+ res.cls := TBool
|
|
|
+ ELSE
|
|
|
+ res.cls := left.cls
|
|
|
+ END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
LoadPair (left, right) ;
|
|
|
EmOrAxCx () ;
|
|
|
- res.kind := 2 ; res.cls := TBool ;
|
|
|
+ res.kind := 2 ;
|
|
|
+ IF (left.cls = TBool) OR (right.cls = TBool) THEN
|
|
|
+ res.cls := TBool
|
|
|
+ ELSE
|
|
|
+ res.cls := left.cls
|
|
|
+ END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
IF (left.kind = 0) AND (right.kind = 0) THEN
|
|
|
@@ -3134,6 +3189,8 @@ BEGIN
|
|
|
OpAdd : EmAddAxCx ;
|
|
|
| OpSub : EmSubAxCx ;
|
|
|
| OpMul : EmMulAxCx ;
|
|
|
+ | OpShl : EmShlAxCl ;
|
|
|
+ | OpShr : EmShrAxCl ;
|
|
|
| TkDiv : EmIDivAxCx ;
|
|
|
| TkMod : EmIDivAxCx ; EmXchgAxDx ;
|
|
|
ELSE
|
|
|
@@ -4257,6 +4314,10 @@ BEGIN
|
|
|
GetWord () ; op := TkMod
|
|
|
ELSIF KwAhead ("AND") THEN
|
|
|
GetWord () ; op := TkAnd
|
|
|
+ ELSIF KwAhead ("SHL") THEN
|
|
|
+ GetWord () ; op := OpShl
|
|
|
+ ELSIF KwAhead ("SHR") THEN
|
|
|
+ GetWord () ; op := OpShr
|
|
|
ELSE
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -4394,6 +4455,7 @@ BEGIN
|
|
|
r.fldFirst := fields [fi].fldFirst ;
|
|
|
r.fldLast := fields [fi].fldLast ;
|
|
|
r.arrIdx := fields [fi].arrIdx ;
|
|
|
+ r.ptrElem := fields [fi].ptrElem ;
|
|
|
IF r.cls = TSet THEN
|
|
|
r.setbase := fields [fi].elem ;
|
|
|
r.setsize := fields [fi].size
|
|
|
@@ -4847,6 +4909,48 @@ BEGIN
|
|
|
r.cls := TScalar ;
|
|
|
r.chr := FALSE ;
|
|
|
RETURN
|
|
|
+ ELSIF (symtab [idx].tag = KBuiltin) AND
|
|
|
+ ((symtab [idx].cls = BI_Round) OR (symtab [idx].cls = BI_Trunc)) THEN
|
|
|
+ IF NOT MatchDelim ('(') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ ParseExpr (r) ;
|
|
|
+ ExpectDelim (')', ENoSemi) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF r.cls = TReal THEN
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ ELSIF r.kind = 1 THEN
|
|
|
+ EmPushSymAddr (r.idx, (symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
+ ELSE
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF symtab [idx].cls = BI_Round THEN
|
|
|
+ EmMovAxi (1)
|
|
|
+ ELSE
|
|
|
+ EmMovAxi (0)
|
|
|
+ END ;
|
|
|
+ EmPushAx () ;
|
|
|
+ DropC (EmCall (TU_RealToInt)) ;
|
|
|
+ EmAddSp (4) ;
|
|
|
+ r.kind := 2 ;
|
|
|
+ r.cls := TScalar ;
|
|
|
+ r.sz := 2 ;
|
|
|
+ RETURN
|
|
|
+ ELSIF (r.cls = TScalar) OR (r.cls = TChar) OR (r.cls = TEnum) THEN
|
|
|
+ LoadAtom (r) ;
|
|
|
+ r.kind := 2 ;
|
|
|
+ r.cls := TScalar ;
|
|
|
+ r.sz := 2 ;
|
|
|
+ RETURN
|
|
|
+ ELSE
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
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
|
|
|
@@ -5326,7 +5430,7 @@ END RealUnary ;
|
|
|
PROCEDURE Assignment (r : ERes) ;
|
|
|
(* ':=' already consumed by the caller; store expression into r *)
|
|
|
VAR src : ERes ;
|
|
|
- k, n, savePos : CARDINAL ;
|
|
|
+ k, n, savePos, scratch : CARDINAL ;
|
|
|
sbuf : ARRAY [0..31] OF CHAR ;
|
|
|
rbuf : ARRAY [0..5] OF CHAR ;
|
|
|
BEGIN
|
|
|
@@ -5334,6 +5438,39 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF IsCharArray (r) AND ((r.kind = 1) OR (r.kind = 5)) THEN
|
|
|
+ (* Fixed CHAR arrays are Pascal strings too, but they have no length
|
|
|
+ byte: a literal fills the array and pads the tail with spaces. *)
|
|
|
+ ParseExpr (src) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF src.kind = 3 THEN
|
|
|
+ n := VarSize (r) ;
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < n DO
|
|
|
+ IF k < strLen [src.strx] THEN
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmStDiImm (k, ORD (strPool [strOff [src.strx] + k]))
|
|
|
+ ELSE
|
|
|
+ EmMovAxi (ORD (strPool [strOff [src.strx] + k])) ;
|
|
|
+ StoreSymVar (r.idx, (symtab [r.idx].off + r.boff + k) MOD 10000H, 1)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmStDiImm (k, ORD (' '))
|
|
|
+ ELSE
|
|
|
+ EmMovAxi (ORD (' ')) ;
|
|
|
+ StoreSymVar (r.idx, (symtab [r.idx].off + r.boff + k) MOD 10000H, 1)
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ INC (k)
|
|
|
+ END ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ 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
|
|
|
@@ -5424,13 +5561,37 @@ BEGIN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPushDi ()
|
|
|
+ END ;
|
|
|
ParseExpr (src) ;
|
|
|
IF NOT OK () THEN
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF (src.cls # TReal) AND (src.cls # TString) AND (src.cls # TSet)
|
|
|
+ AND (src.kind # 0) AND ((r.kind = 1) OR (r.kind = 5)) THEN
|
|
|
+ (* INTEGER/CHAR/BOOLEAN -> REAL, e.g. Size := Count in CONVERT. *)
|
|
|
+ scratch := NewScratchReal () ;
|
|
|
+ RealOperand (src, symtab [scratch].off) ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmPopDi ()
|
|
|
+ END ;
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < 6 DO
|
|
|
+ LoadSymVar (scratch, (symtab [scratch].off + k) MOD 10000H, 1) ;
|
|
|
+ IF r.kind = 5 THEN
|
|
|
+ EmStDiAlOff (k)
|
|
|
+ ELSE
|
|
|
+ StoreSymVar (r.idx, (symtab [r.idx].off + r.boff + k) MOD 10000H, 1)
|
|
|
+ END ;
|
|
|
+ INC (k)
|
|
|
+ END ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF (src.kind = 0) AND (src.cls # TString) AND (src.cls # TSet) THEN
|
|
|
IntToMbf (src.imm, rbuf) ;
|
|
|
IF r.kind = 5 THEN
|
|
|
+ EmPopDi () ;
|
|
|
k := 0 ;
|
|
|
WHILE k < 6 DO
|
|
|
EmStDiImm (k, ORD (rbuf [k])) ;
|
|
|
@@ -5448,6 +5609,17 @@ BEGIN
|
|
|
END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF (src.kind = 5) AND (src.cls = TReal) AND (r.kind = 5) THEN
|
|
|
+ EmPushDi () ; (* source address *)
|
|
|
+ EmPopSi () ;
|
|
|
+ EmPopDi () ; (* destination address *)
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < 6 DO
|
|
|
+ EmLdAlSi () ; EmStDiAl () ; EmIncSi () ; EmIncDi () ;
|
|
|
+ INC (k)
|
|
|
+ END ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF (src.kind = 5) AND (src.cls = TReal) AND (r.kind = 1) THEN
|
|
|
EmPushDi () ;
|
|
|
EmPopSi () ;
|
|
|
@@ -5466,6 +5638,7 @@ BEGIN
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ EmPopDi () ;
|
|
|
k := 0 ;
|
|
|
WHILE k < 6 DO
|
|
|
LoadSymVar (src.idx, (symtab [src.idx].off + src.boff + k) MOD 10000H, 1) ;
|
|
|
@@ -5852,8 +6025,8 @@ VAR arg : ERes ;
|
|
|
a field width *)
|
|
|
reading : BOOLEAN ;
|
|
|
pushed : BOOLEAN ;
|
|
|
- skipArg : BOOLEAN ;
|
|
|
- n, p, scratch, cap : CARDINAL ;
|
|
|
+ skipArg, handled : BOOLEAN ;
|
|
|
+ k, n, p, scratch, cap : CARDINAL ;
|
|
|
dummy, errV : ERes ;
|
|
|
BEGIN
|
|
|
which := symtab [idx].cls ; (* BI_* *)
|
|
|
@@ -5871,11 +6044,19 @@ BEGIN
|
|
|
allocation. *)
|
|
|
IF MatchDelim ('(') THEN
|
|
|
ParseExpr (arg) ;
|
|
|
- IF OK () AND (arg.kind = 1) AND (arg.cls = TPtr) THEN
|
|
|
- p := symtab [arg.idx].elem ;
|
|
|
+ IF OK () AND ((arg.kind = 1) OR (arg.kind = 5)) AND
|
|
|
+ (arg.cls = TPtr) THEN
|
|
|
+ p := arg.ptrElem ;
|
|
|
+ IF p = 0 THEN
|
|
|
+ p := symtab [arg.idx].elem
|
|
|
+ END ;
|
|
|
EmMovAxi (symtab [p].size) ;
|
|
|
EmPushAx () ; (* size -> [BP+6] *)
|
|
|
- EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
+ IF arg.kind = 5 THEN
|
|
|
+ EmPushDi () (* element pointer slot *)
|
|
|
+ ELSE
|
|
|
+ EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
|
|
|
+ END ;
|
|
|
DropC (EmCall (TU_HeapNew)) ;
|
|
|
EmAddSp (4)
|
|
|
ELSIF OK () THEN
|
|
|
@@ -5895,7 +6076,8 @@ BEGIN
|
|
|
Dispose would need a real free list. *)
|
|
|
IF MatchDelim ('(') THEN
|
|
|
ParseExpr (arg) ;
|
|
|
- IF OK () AND NOT ((arg.kind = 1) AND (arg.cls = TPtr)) THEN
|
|
|
+ IF OK () AND NOT (((arg.kind = 1) OR (arg.kind = 5))
|
|
|
+ AND (arg.cls = TPtr)) THEN
|
|
|
Err (ETypeErr)
|
|
|
END ;
|
|
|
ExpectDelim (')', ENoSemi)
|
|
|
@@ -6186,6 +6368,30 @@ BEGIN
|
|
|
ExpectDelim (')', ENoSemi) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF (which = BI_Msdos) OR (which = BI_Intr) THEN
|
|
|
+ IF MatchDelim ('(') THEN
|
|
|
+ IF which = BI_Intr THEN
|
|
|
+ ParseExpr (dummy) ;
|
|
|
+ IF OK () AND NOT ((dummy.kind = 0) AND (W16 (dummy.imm) = 21H)) THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ ExpectDelim (',', ENoSemi)
|
|
|
+ END ;
|
|
|
+ ParseExpr (arg) ;
|
|
|
+ IF OK () AND (arg.kind = 1) AND (arg.cls = TRecord) THEN
|
|
|
+ EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
+ DropC (EmCall (TU_Msdos)) ;
|
|
|
+ EmAddSp (2)
|
|
|
+ ELSIF OK () THEN
|
|
|
+ Err (ETypeErr)
|
|
|
+ END ;
|
|
|
+ ExpectDelim (')', ENoSemi)
|
|
|
+ ELSE
|
|
|
+ Err (ENoSemi)
|
|
|
+ END ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF which = BI_Assign THEN
|
|
|
(* Assign(F, Name): the file variable's address and the counted
|
|
|
string's address. The runtime copies the characters into the file
|
|
|
@@ -6277,6 +6483,7 @@ BEGIN
|
|
|
argument as the last argument's value, and pushed an argument
|
|
|
that an earlier inline string's call had already overwritten. *)
|
|
|
skipArg := FALSE ;
|
|
|
+ handled := FALSE ;
|
|
|
IF (nArgs = 0) AND (arg.cls = TText) THEN
|
|
|
(* A leading TEXT file argument. KBD is the console keyboard
|
|
|
and this runtime's read entries already read the console, so
|
|
|
@@ -6306,6 +6513,28 @@ BEGIN
|
|
|
EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
DropC (EmCall (TU_FileReadln)) ;
|
|
|
EmAddSp (6)
|
|
|
+ ELSIF OK () AND IsCharArray (dummy) AND (dummy.kind = 1) THEN
|
|
|
+ (* Readln(F, Place): file_readln writes a counted string;
|
|
|
+ use a scratch, prefill the tail with spaces, then copy
|
|
|
+ the fixed width over the CHAR array. *)
|
|
|
+ scratch := NewScratchStr () ;
|
|
|
+ k := 1 ;
|
|
|
+ WHILE k <= VarSize (dummy) DO
|
|
|
+ EmMovAxi (ORD (' ')) ;
|
|
|
+ EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
|
|
|
+ INC (k)
|
|
|
+ END ;
|
|
|
+ EmMovAxi (VarSize (dummy)) ;
|
|
|
+ EmPushAx () ;
|
|
|
+ EmPushVarAddr (FALSE, symtab [scratch].off) ;
|
|
|
+ EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
+ DropC (EmCall (TU_FileReadln)) ;
|
|
|
+ EmAddSp (6) ;
|
|
|
+ EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
|
|
|
+ EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
|
|
|
+ EmMovCxi (VarSize (dummy)) ;
|
|
|
+ DropC (EmCall (TU_MemCopy)) ;
|
|
|
+ EmAddSp (4)
|
|
|
ELSIF OK () THEN
|
|
|
Err (ETypeErr)
|
|
|
END ;
|
|
|
@@ -6394,7 +6623,44 @@ BEGIN
|
|
|
ExpectDelim (')', ENoSemi) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF NOT skipArg THEN
|
|
|
+ IF NOT skipArg AND IsCharArray (arg) AND (arg.kind = 1) THEN
|
|
|
+ IF reading THEN
|
|
|
+ (* Readln(Place): read through a temporary counted string,
|
|
|
+ then copy its fixed-width bytes over the char array.
|
|
|
+ The temporary is pre-filled with spaces so a short line
|
|
|
+ leaves the array padded, and rdstr leaves the newline
|
|
|
+ pending for the Readln wrapper. *)
|
|
|
+ scratch := NewScratchStr () ;
|
|
|
+ k := 1 ;
|
|
|
+ WHILE k <= VarSize (arg) DO
|
|
|
+ EmMovAxi (ORD (' ')) ;
|
|
|
+ EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
|
|
|
+ INC (k)
|
|
|
+ END ;
|
|
|
+ EmPushVarAddr (FALSE, symtab [scratch].off) ;
|
|
|
+ EmMovCxi (VarSize (arg)) ;
|
|
|
+ DropC (EmCall (TU_RdStr)) ;
|
|
|
+ EmAddSp (2) ;
|
|
|
+ EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
|
|
|
+ EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
|
|
|
+ EmMovCxi (VarSize (arg)) ;
|
|
|
+ DropC (EmCall (TU_MemCopy)) ;
|
|
|
+ EmAddSp (4)
|
|
|
+ ELSE
|
|
|
+ (* Write a fixed char array one byte at a time. *)
|
|
|
+ k := 0 ;
|
|
|
+ WHILE k < VarSize (arg) DO
|
|
|
+ LoadSymVar (arg.idx, (symtab [arg.idx].off + arg.boff + k) MOD 10000H, 1) ;
|
|
|
+ EmMovAh0 () ;
|
|
|
+ EmPushAx () ;
|
|
|
+ DropC (EmCall (TU_WrChar)) ;
|
|
|
+ EmAddSp (2) ;
|
|
|
+ INC (k)
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ handled := TRUE
|
|
|
+ END ;
|
|
|
+ IF NOT skipArg AND NOT handled THEN
|
|
|
pushed := TRUE ; (* default: value is on the stack -> call + pop *)
|
|
|
argBytes := 2 ;
|
|
|
IF reading THEN
|
|
|
@@ -7240,6 +7506,7 @@ BEGIN
|
|
|
t.fldFirst := symtab [t.idx].fldFirst ;
|
|
|
t.fldLast := symtab [t.idx].fldLast ;
|
|
|
t.arrIdx := symtab [t.idx].arrIdx ;
|
|
|
+ t.ptrElem := symtab [t.idx].elem ;
|
|
|
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
|
|
|
@@ -7276,6 +7543,11 @@ VAR tok : CARDINAL ;
|
|
|
running, groupFirst, i, an, recStart : CARDINAL ;
|
|
|
innerIdx, innerN, leafElem, leafCls, j : CARDINAL ;
|
|
|
elemFldFirst, elemFldLast, fieldFldFirst, fieldFldLast, fieldArrIdx : CARDINAL ;
|
|
|
+ elemType : CARDINAL ;
|
|
|
+ fieldPtrElem : CARDINAL ;
|
|
|
+ variantBase, armRunning, armMax, savePosVar : CARDINAL ;
|
|
|
+ moreFields : BOOLEAN ;
|
|
|
+ tagName : ARRAY [0..MaxName] OF CHAR ;
|
|
|
alo, ahi : ARRAY [0..3] OF LONGINT ;
|
|
|
ecls2 : CARDINAL ;
|
|
|
BEGIN
|
|
|
@@ -7406,6 +7678,10 @@ BEGIN
|
|
|
innerIdx := newArrIdx ;
|
|
|
elemFldFirst := recFldFirst ;
|
|
|
elemFldLast := recFldLast ;
|
|
|
+ elemType := 0 ;
|
|
|
+ IF cls = TPtr THEN
|
|
|
+ elemType := e2
|
|
|
+ END ;
|
|
|
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
|
|
|
@@ -7415,6 +7691,7 @@ BEGIN
|
|
|
leafCls := arrs [innerIdx - 1].ecls ;
|
|
|
elemFldFirst := arrs [innerIdx - 1].fldFirst ;
|
|
|
elemFldLast := arrs [innerIdx - 1].fldLast ;
|
|
|
+ elemType := arrs [innerIdx - 1].elemType ;
|
|
|
innerN := arrs [innerIdx - 1].n
|
|
|
ELSE
|
|
|
leafElem := s2 ;
|
|
|
@@ -7438,6 +7715,7 @@ BEGIN
|
|
|
arrs [arrTop].ecls := leafCls ;
|
|
|
arrs [arrTop].fldFirst := elemFldFirst ;
|
|
|
arrs [arrTop].fldLast := elemFldLast ;
|
|
|
+ arrs [arrTop].elemType := elemType ;
|
|
|
i := 0 ;
|
|
|
WHILE i < an DO
|
|
|
arrs [arrTop].lo [i] := alo [i] ;
|
|
|
@@ -7503,6 +7781,141 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
|
EXIT
|
|
|
END ;
|
|
|
+ IF tok = TkCase THEN
|
|
|
+ (* Variant part: fields in all arms overlay at the same base.
|
|
|
+ The tag, when named, is an ordinary field before the arms. *)
|
|
|
+ DropB (MatchKey (tok)) ;
|
|
|
+ Skip () ;
|
|
|
+ tagName [0] := CHR (0) ;
|
|
|
+ savePosVar := srcPos ;
|
|
|
+ IF Alpha (CurCh ()) THEN
|
|
|
+ GetWord () ;
|
|
|
+ Skip () ;
|
|
|
+ IF CurCh () = ':' THEN
|
|
|
+ CopyStr (tagName, wrd) ;
|
|
|
+ DropCh (GetCh ()) ;
|
|
|
+ ParseType (subcls, s2, e2) ;
|
|
|
+ IF OK () THEN
|
|
|
+ IF fldTop < MaxFields THEN
|
|
|
+ CopyStr (fields [fldTop].name, tagName) ;
|
|
|
+ fields [fldTop].cls := subcls ;
|
|
|
+ fields [fldTop].size := s2 ;
|
|
|
+ fields [fldTop].elem := e2 ;
|
|
|
+ fields [fldTop].off := running ;
|
|
|
+ fields [fldTop].fldFirst := recFldFirst ;
|
|
|
+ fields [fldTop].fldLast := recFldLast ;
|
|
|
+ fields [fldTop].arrIdx := newArrIdx ;
|
|
|
+ fields [fldTop].ptrElem := 0 ;
|
|
|
+ INC (fldTop) ;
|
|
|
+ running := running + s2
|
|
|
+ ELSE
|
|
|
+ Err (ECompOvf)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ srcPos := savePosVar ;
|
|
|
+ ParseType (subcls, s2, e2) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ ParseType (subcls, s2, e2) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ IF NOT (MatchKey (tok) AND (tok = TkOf)) THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ variantBase := running ;
|
|
|
+ armMax := 0 ;
|
|
|
+ LOOP
|
|
|
+ Skip () ;
|
|
|
+ PeekKw (tok) ;
|
|
|
+ IF tok = TkEnd THEN
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ RdConst (lo, subcls, strf) ;
|
|
|
+ IF NOT MatchDelim (':') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF NOT MatchDelim ('(') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ armRunning := variantBase ;
|
|
|
+ moreFields := TRUE ;
|
|
|
+ WHILE moreFields AND (CurCh () # ')') DO
|
|
|
+ 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 ;
|
|
|
+ fieldFldFirst := recFldFirst ;
|
|
|
+ fieldFldLast := recFldLast ;
|
|
|
+ fieldArrIdx := newArrIdx ;
|
|
|
+ fieldPtrElem := 0 ;
|
|
|
+ IF subcls = TPtr THEN
|
|
|
+ fieldPtrElem := e2
|
|
|
+ END ;
|
|
|
+ i := groupFirst ;
|
|
|
+ WHILE i < fldTop DO
|
|
|
+ fields [i].cls := subcls ;
|
|
|
+ fields [i].size := s2 ;
|
|
|
+ fields [i].elem := e2 ;
|
|
|
+ fields [i].off := armRunning ;
|
|
|
+ fields [i].lo := enumLo ;
|
|
|
+ fields [i].hi := enumHi ;
|
|
|
+ fields [i].fldFirst := fieldFldFirst ;
|
|
|
+ fields [i].fldLast := fieldFldLast ;
|
|
|
+ fields [i].arrIdx := fieldArrIdx ;
|
|
|
+ fields [i].ptrElem := fieldPtrElem ;
|
|
|
+ armRunning := armRunning + s2 ;
|
|
|
+ INC (i)
|
|
|
+ END ;
|
|
|
+ IF MatchDelim (';') THEN
|
|
|
+ (* another field group in this arm *)
|
|
|
+ ELSE
|
|
|
+ moreFields := FALSE
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ ExpectDelim (')', ENoSemi) ;
|
|
|
+ IF armRunning - variantBase > armMax THEN
|
|
|
+ armMax := armRunning - variantBase
|
|
|
+ END ;
|
|
|
+ IF MatchDelim (';') THEN
|
|
|
+ (* another variant arm *)
|
|
|
+ ELSE
|
|
|
+ EXIT
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ running := variantBase + armMax ;
|
|
|
+ (* the record's own END is read by the outer loop *)
|
|
|
+ ELSE
|
|
|
(* the group's names, then ONE `: type' *)
|
|
|
groupFirst := fldTop ;
|
|
|
LOOP
|
|
|
@@ -7531,6 +7944,10 @@ BEGIN
|
|
|
fieldFldFirst := recFldFirst ;
|
|
|
fieldFldLast := recFldLast ;
|
|
|
fieldArrIdx := newArrIdx ;
|
|
|
+ fieldPtrElem := 0 ;
|
|
|
+ IF subcls = TPtr THEN
|
|
|
+ fieldPtrElem := e2
|
|
|
+ END ;
|
|
|
(* every name in the group gets the type and its own slot *)
|
|
|
i := groupFirst ;
|
|
|
WHILE i < fldTop DO
|
|
|
@@ -7543,6 +7960,7 @@ BEGIN
|
|
|
fields [i].fldFirst := fieldFldFirst ;
|
|
|
fields [i].fldLast := fieldFldLast ;
|
|
|
fields [i].arrIdx := fieldArrIdx ;
|
|
|
+ fields [i].ptrElem := fieldPtrElem ;
|
|
|
running := running + s2 ;
|
|
|
INC (i)
|
|
|
END ;
|
|
|
@@ -7550,7 +7968,8 @@ BEGIN
|
|
|
Err (ENoSemi) ;
|
|
|
RETURN
|
|
|
END
|
|
|
- END ;
|
|
|
+ END ; (* the variant IF *)
|
|
|
+ END ; (* the record field LOOP *)
|
|
|
(* 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
|
|
|
@@ -7677,6 +8096,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
|
|
|
v : LONGINT ;
|
|
|
off : CARDINAL ;
|
|
|
first, i : CARDINAL ;
|
|
|
+ segAbs : BOOLEAN ;
|
|
|
BEGIN
|
|
|
LOOP
|
|
|
Skip () ; (* after the VAR keyword: skip blanks *)
|
|
|
@@ -7725,9 +8145,23 @@ BEGIN
|
|
|
PeekKw (tok) ;
|
|
|
IF tok = TkAbsolute THEN
|
|
|
DropB (MatchKey (tok)) ;
|
|
|
+ Skip () ;
|
|
|
+ segAbs := FALSE ;
|
|
|
+ IF Alpha (CurCh ()) THEN
|
|
|
+ (* Turbo's `Cseg:$80' / `Dseg:$80'. Our globals carry
|
|
|
+ LoadBias in their direct addresses, so subtract it from
|
|
|
+ the requested absolute address. *)
|
|
|
+ GetWord () ;
|
|
|
+ ExpectDelim (':', ENoSemi) ;
|
|
|
+ segAbs := TRUE
|
|
|
+ END ;
|
|
|
IF (CurCh () = '$') OR (Digit (CurCh ())) THEN
|
|
|
RdIntConst (v) ;
|
|
|
- off := W16 (v)
|
|
|
+ IF segAbs THEN
|
|
|
+ off := W16 (v - VAL (LONGINT, LoadBias))
|
|
|
+ ELSE
|
|
|
+ off := W16 (v)
|
|
|
+ END
|
|
|
ELSE
|
|
|
Err (EUnknown) ;
|
|
|
off := 0
|
|
|
@@ -7757,6 +8191,38 @@ BEGIN
|
|
|
END ;
|
|
|
varspc := varspc + size * (symTop - first)
|
|
|
ELSE
|
|
|
+ PeekKw (tok) ;
|
|
|
+ IF tok = TkAbsolute THEN
|
|
|
+ DropB (MatchKey (tok)) ;
|
|
|
+ Skip () ;
|
|
|
+ segAbs := FALSE ;
|
|
|
+ IF Alpha (CurCh ()) THEN
|
|
|
+ GetWord () ;
|
|
|
+ ExpectDelim (':', ENoSemi) ;
|
|
|
+ segAbs := TRUE
|
|
|
+ END ;
|
|
|
+ IF (CurCh () = '$') OR (Digit (CurCh ())) THEN
|
|
|
+ RdIntConst (v) ;
|
|
|
+ IF segAbs THEN
|
|
|
+ off := W16 (v - VAL (LONGINT, LoadBias))
|
|
|
+ ELSE
|
|
|
+ off := W16 (v)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ Err (EUnknown) ;
|
|
|
+ off := 0
|
|
|
+ END ;
|
|
|
+ i := first ;
|
|
|
+ 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 ;
|
|
|
+ symtab [i].arrIdx := newArrIdx ;
|
|
|
+ symtab [i].local := FALSE ;
|
|
|
+ INC (i)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
IF (size > 2) AND (cls # TString) AND (cls # TRecord)
|
|
|
AND (cls # TArray) AND (cls # TFile) AND (cls # TText)
|
|
|
AND (cls # TUntyp) AND (cls # TReal) AND (cls # TSet) THEN
|
|
|
@@ -7788,6 +8254,7 @@ BEGIN
|
|
|
INC (i)
|
|
|
END ;
|
|
|
locBytes := locBytes + size * (symTop - first)
|
|
|
+ END
|
|
|
END
|
|
|
END ;
|
|
|
IF MatchDelim (',') THEN
|
|
|
@@ -8544,6 +9011,14 @@ BEGIN
|
|
|
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 ("ROUND", KBuiltin, BI_Round, 0, 0, 0, 0, FALSE) ;
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
+ i := NewSym ("TRUNC", KBuiltin, BI_Trunc, 0, 0, 0, 0, FALSE) ;
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
+ i := NewSym ("MSDOS", KBuiltin, BI_Msdos, 0, 0, 0, 0, FALSE) ;
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
+ i := NewSym ("INTR", KBuiltin, BI_Intr, 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 ;
|
|
|
@@ -8599,7 +9074,10 @@ BEGIN
|
|
|
already read the console, so `Read(Kbd, Ch)' drops the file argument and
|
|
|
reads a character exactly as `Read(Ch)' does. *)
|
|
|
i := NewSym ("KBD", KVar, TText, FileVarSize, 1, 0, 0, FALSE) ;
|
|
|
- symtab [i].isKbd := TRUE
|
|
|
+ symtab [i].isKbd := TRUE ;
|
|
|
+ (* LST is TP3's printer device. The corpus uses it for listings; define
|
|
|
+ the identifier as a TEXT variable so Write(Lst, ...) type-checks. *)
|
|
|
+ i := NewSym ("LST", KVar, TText, FileVarSize, 1, 0, 0, FALSE)
|
|
|
END DefBuiltins ;
|
|
|
|
|
|
PROCEDURE Inittur () ;
|
|
|
@@ -8747,6 +9225,8 @@ BEGIN
|
|
|
TU_WrBoolW := RT_Entry (57) ;
|
|
|
TU_WrStrW := RT_Entry (58) ;
|
|
|
TU_MemCopy := RT_Entry (59) ;
|
|
|
+ TU_RealToInt := RT_Entry (60) ;
|
|
|
+ TU_Msdos := RT_Entry (61) ;
|
|
|
TU_WrReal := RT_Entry (6) ;
|
|
|
TU_RealWrite := RT_Entry (30) ; (* fmtreal + padding + output *)
|
|
|
TU_RealFmt := RT_Entry (28) ; (* fmtreal into a string variable *)
|
