|
|
@@ -140,7 +140,7 @@ CONST
|
|
|
the later Reset/Rewrite. IOResult is an expression; EndOfFile is the
|
|
|
next file increment. *)
|
|
|
BI_Assign = 16 ; BI_Reset = 17 ; BI_Rewrite = 18 ;
|
|
|
- BI_Close = 19 ; BI_IoResult = 20 ;
|
|
|
+ BI_Close = 19 ; BI_IoResult = 20 ; BI_Chr = 21 ;
|
|
|
(* the sub-codes EmCrtSeq takes *)
|
|
|
CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
|
|
|
CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
|
|
|
@@ -1381,6 +1381,9 @@ END EmStDiGlob ;
|
|
|
PROCEDURE EmLdAlDi () ;
|
|
|
BEGIN Ebyte (8AH) ; Ebyte (05H) END EmLdAlDi ; (* 8A 05: AL := [DI] *)
|
|
|
|
|
|
+PROCEDURE EmMovDiAx () ;
|
|
|
+BEGIN Ebyte (89H) ; Ebyte (0C7H) END EmMovDiAx ; (* 89 C7: DI := AX *)
|
|
|
+
|
|
|
PROCEDURE EmLdAxDi () ;
|
|
|
BEGIN Ebyte (8BH) ; Ebyte (05H) END EmLdAxDi ; (* 8B 05: AX := [DI] *)
|
|
|
|
|
|
@@ -2446,7 +2449,25 @@ BEGIN
|
|
|
Err (ESimpType) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF t.kind = 0 THEN
|
|
|
+ IF symtab [r.idx].isVar THEN
|
|
|
+ (* VAR string parameter: the base is the address in the
|
|
|
+ parameter slot, not LEA of the slot. Compute DI once for
|
|
|
+ both constant and variable indices, so LoadAtom and
|
|
|
+ Assignment see the same kind-5 character address they do
|
|
|
+ for an ordinary string. *)
|
|
|
+ EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
|
|
|
+ EmMovDiAx () ;
|
|
|
+ IF t.kind = 0 THEN
|
|
|
+ EmAddDiImm ((r.boff + W16 (t.imm)) MOD 10000H)
|
|
|
+ ELSE
|
|
|
+ IF r.boff # 0 THEN
|
|
|
+ EmAddDiImm (r.boff)
|
|
|
+ END ;
|
|
|
+ LoadAtom (t) ;
|
|
|
+ EmAddDiAx ()
|
|
|
+ END ;
|
|
|
+ r.kind := 5
|
|
|
+ ELSIF t.kind = 0 THEN
|
|
|
(* constant index: fold it into boff, as an array's does, and
|
|
|
r.cls drops to TChar so every consumer below - LoadAtom,
|
|
|
Assignment, IoCall - sees a one-byte value instead of the
|
|
|
@@ -3012,8 +3033,21 @@ BEGIN
|
|
|
`if Sheet[UFX,UFY].Contents <> '' then'. *)
|
|
|
EmPushDi ()
|
|
|
ELSIF r.kind = 1 THEN
|
|
|
- EmPushVarAddr (symtab [r.idx].local,
|
|
|
- (symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
+ IF symtab [r.idx].isVar THEN
|
|
|
+ (* A VAR string parameter: the slot at [BP+off] holds the address of
|
|
|
+ the caller's characters, so push its CONTENTS, not the address of
|
|
|
+ the slot. boff is zero for the whole string; an element/subscript
|
|
|
+ is kind 5 and handled above. *)
|
|
|
+ IF r.boff # 0 THEN
|
|
|
+ Err (ENoLib)
|
|
|
+ ELSE
|
|
|
+ EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
|
|
|
+ EmPushAx ()
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ EmPushVarAddr (symtab [r.idx].local,
|
|
|
+ (symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
+ END
|
|
|
ELSIF r.kind = 3 THEN
|
|
|
EmPushVarAddr (FALSE, EmStrBlob (r)) (* the literal travels inline *)
|
|
|
ELSE
|
|
|
@@ -3919,6 +3953,34 @@ BEGIN
|
|
|
fixture had ever exercised the fold. *)
|
|
|
ParseVar (r) ;
|
|
|
RETURN
|
|
|
+ ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_Chr) THEN
|
|
|
+ (* Chr(n): the character with code n. A constant folds; otherwise the
|
|
|
+ integer is loaded and its class becomes CHAR. The value is one byte,
|
|
|
+ so an assignment stores AL and a CHAR writer uses AL. *)
|
|
|
+ IF NOT MatchDelim ('(') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ ParseExpr (r) ;
|
|
|
+ ExpectDelim (')', ENoSemi) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF (r.cls # TScalar) AND (r.cls # TChar) THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF r.kind = 0 THEN
|
|
|
+ r.imm := VAL (LONGINT, W16 (r.imm) MOD 256) ;
|
|
|
+ r.chr := TRUE
|
|
|
+ ELSE
|
|
|
+ LoadAtom (r) ;
|
|
|
+ r.kind := 2 ;
|
|
|
+ r.chr := FALSE
|
|
|
+ END ;
|
|
|
+ r.cls := TChar ;
|
|
|
+ r.sz := 1 ;
|
|
|
+ RETURN
|
|
|
ELSIF (symtab [idx].tag = KBuiltin) AND (symtab [idx].cls = BI_IoResult) THEN
|
|
|
(* IOResult: the last file operation's DOS status; reading it clears the
|
|
|
slot in the runtime. It is a no-argument function. *)
|
|
|
@@ -4034,7 +4096,15 @@ BEGIN
|
|
|
Err (ETypeErr) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
- IF r.kind = 1 THEN
|
|
|
+ IF (r.kind = 1) AND symtab [r.idx].isVar THEN
|
|
|
+ (* VAR string: the slot holds the address; read the length byte
|
|
|
+ through that pointer. *)
|
|
|
+ IF r.boff # 0 THEN
|
|
|
+ Err (ENoLib)
|
|
|
+ ELSE
|
|
|
+ EmLoadVarInd (symtab [r.idx].off, 1)
|
|
|
+ END
|
|
|
+ ELSIF r.kind = 1 THEN
|
|
|
EmLoadVar (symtab [r.idx].local,
|
|
|
(symtab [r.idx].off + r.boff) MOD 10000H, 1)
|
|
|
ELSIF r.kind = 3 THEN
|
|
|
@@ -4214,7 +4284,28 @@ BEGIN
|
|
|
END ;
|
|
|
ParseExpr (arg) ;
|
|
|
slot := ParmSlot (idx, nArgs) ;
|
|
|
- IF slot > 2 THEN
|
|
|
+ IF ParmIsVar (idx, nArgs) THEN
|
|
|
+ (* A VAR formal in a FUNCTION call: the callee wants the
|
|
|
+ address, exactly as ParseCallArgs does for a procedure. This
|
|
|
+ path was missing, so `Length(s)' inside a function whose
|
|
|
+ formal is `var s' pushed the string's VALUE and the callee
|
|
|
+ would have read it as an address. *)
|
|
|
+ IF arg.kind # 1 THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ IF symtab [arg.idx].isVar THEN
|
|
|
+ IF arg.boff # 0 THEN
|
|
|
+ Err (ENoLib) ;
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
|
|
|
+ EmPushAx ()
|
|
|
+ ELSE
|
|
|
+ EmPushVarAddr (symtab [arg.idx].local,
|
|
|
+ (symtab [arg.idx].off + arg.boff) MOD 10000H)
|
|
|
+ END
|
|
|
+ ELSIF slot > 2 THEN
|
|
|
(* see ParseCallArgs: push the whole string slot *)
|
|
|
IF arg.cls # TString THEN
|
|
|
Err (ETypeErr) ;
|
|
|
@@ -4527,6 +4618,29 @@ BEGIN
|
|
|
END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF (r.kind = 1) AND (r.cls = TString) AND symtab [r.idx].isVar THEN
|
|
|
+ (* A VAR string parameter: the slot holds the caller's string address.
|
|
|
+ Copy through the runtime, exactly as a normal string variable does:
|
|
|
+ source address first, destination address second, limit in CX. This
|
|
|
+ covers literals and whole-string expressions alike; the destination
|
|
|
+ address is loaded from the parameter slot rather than formed with
|
|
|
+ LEA, which would point at the slot itself. *)
|
|
|
+ ParseExpr (src) ;
|
|
|
+ IF NOT OK () THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ IF src.cls # TString THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ EmPushStrAddr (src) ;
|
|
|
+ EmLoadVar (TRUE, symtab [r.idx].off, 2) ;
|
|
|
+ EmPushAx () ;
|
|
|
+ EmMovCxi ((VarSize (r) - 1) MOD 10000H) ;
|
|
|
+ DropC (EmCall (TU_StrStore)) ;
|
|
|
+ EmAddSp (4) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF (r.kind = 1) AND symtab [r.idx].isVar THEN
|
|
|
(* `varparam := expr': store through the address the slot holds. DI is
|
|
|
parked across the right-hand side because that expression may use DI
|
|
|
@@ -5063,6 +5177,11 @@ BEGIN
|
|
|
Write(Contents)') already HAS its address in DI. *)
|
|
|
IF arg.kind = 5 THEN
|
|
|
EmPushDi ()
|
|
|
+ ELSIF symtab [arg.idx].isVar THEN
|
|
|
+ (* VAR string: the slot holds the address of the
|
|
|
+ caller's characters; push that, not the slot. *)
|
|
|
+ EmLoadVar (TRUE, symtab [arg.idx].off, 2) ;
|
|
|
+ EmPushAx ()
|
|
|
ELSE
|
|
|
EmPushVarAddr (symtab [arg.idx].local,
|
|
|
(symtab [arg.idx].off + arg.boff) MOD 10000H)
|
|
|
@@ -6404,11 +6523,13 @@ BEGIN
|
|
|
END ;
|
|
|
ExpectDelim (':', ENoSemi) ; (* formal is 'name : type' *)
|
|
|
ParseType (cls, size, elem) ;
|
|
|
- IF groupVar AND ((size > 2) OR (cls = TString)) THEN
|
|
|
- (* A VAR parameter of a record, array or string would need the
|
|
|
- callee to address through a larger object (or a counted
|
|
|
- string) than the scalar [BX] paths below; refusing is the
|
|
|
- honest answer, not quietly passing it by value. *)
|
|
|
+ IF groupVar AND (size > 2) AND (cls # TString) THEN
|
|
|
+ (* A VAR parameter of a record or array would need the callee
|
|
|
+ to address through a larger object than the scalar [BX]
|
|
|
+ paths; refusing is the honest answer. A VAR STRING is the
|
|
|
+ exception: its slot is the ADDRESS of the characters (two
|
|
|
+ bytes), so the callee can hand that address to the string
|
|
|
+ runtime exactly as it hands a global's address. *)
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
@@ -6728,6 +6849,8 @@ BEGIN
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
i := NewSym ("IORESULT", KBuiltin, BI_IoResult, 0, 0, 0, 0, FALSE) ;
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
+ i := NewSym ("CHR", KBuiltin, BI_Chr, 0, 0, 0, 0, FALSE) ;
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
(* KBD: the console keyboard as a TEXT file. This runtime's read entries
|
|
|
already read the console, so `Read(Kbd, Ch)' drops the file argument and
|
|
|
reads a character exactly as `Read(Ch)' does. *)
|