|
|
@@ -75,7 +75,7 @@ CONST
|
|
|
displacement is relative to the END of the jump, so every offset in the
|
|
|
image is EntSize further along than it was before the jump existed. *)
|
|
|
EntSize = 3 ;
|
|
|
- MaxCode = 7F00H ;
|
|
|
+ MaxCode = 8000H ;
|
|
|
(* Program layout, image offsets. The original puts the runtime and the
|
|
|
program's code in CS and the globals in a SEPARATE DS segment, so the
|
|
|
.COM contains no data and the code is not limited by a data gap. We
|
|
|
@@ -85,7 +85,7 @@ CONST
|
|
|
code must end below CodeMax, where the boot harness puts the stdin
|
|
|
descriptor (memory 7000h). *)
|
|
|
DataStart = 8000H ; (* image offset of the first global (memory 8100h) *)
|
|
|
- CodeMax = 7F00H ; (* code must end below memory 7000h *)
|
|
|
+ CodeMax = 8000H ; (* code must end below memory 7000h *)
|
|
|
|
|
|
MaxSym = 3000 ;
|
|
|
MaxPatch = 2000 ;
|
|
|
@@ -144,7 +144,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_Int = 36 ; BI_Delete = 37 ;
|
|
|
(* the sub-codes EmCrtSeq takes *)
|
|
|
CrtClr = 0 ; CrtDl = 1 ; CrtDh = 2 ; CrtCaret = 3 ; CrtEol = 4 ;
|
|
|
CrtLow = 5 ; CrtNorm = 6 ; CrtDelay = 7 ; CrtKey = 8 ;
|
|
|
@@ -423,7 +423,7 @@ VAR
|
|
|
TU_RealAbs : CARDINAL ; TU_RealSqrt : CARDINAL ;
|
|
|
TU_RealLn : CARDINAL ; TU_RealExp : CARDINAL ;
|
|
|
TU_RealSin : CARDINAL ; TU_RealCos : CARDINAL ; TU_RealArctan : CARDINAL ;
|
|
|
- TU_RealIntFunc : CARDINAL ;
|
|
|
+ TU_RealIntFunc : CARDINAL ; TU_StrDelete : CARDINAL ;
|
|
|
TU_CmpStr : CARDINAL ; (* string comparison; two addresses on the stack,
|
|
|
signed -1/0/+1 in AX *)
|
|
|
TU_StrCat : CARDINAL ; (* string concatenation; dest and source addresses
|
|
|
@@ -5624,6 +5624,44 @@ BEGIN
|
|
|
END ;
|
|
|
RETURN
|
|
|
END ;
|
|
|
+ IF which = BI_Delete THEN
|
|
|
+ (* Delete(S, pos, len): S must be a variable (or a DI-addressed field);
|
|
|
+ the runtime mutates it in place. S's address is parked while the
|
|
|
+ two integer expressions are parsed. *)
|
|
|
+ IF NOT MatchDelim ('(') THEN
|
|
|
+ Err (ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ ParseExpr (arg) ;
|
|
|
+ IF OK () AND (arg.cls = TString) AND
|
|
|
+ ((arg.kind = 1) OR (arg.kind = 5)) THEN
|
|
|
+ EmPushStrAddr (arg) ;
|
|
|
+ ExpectDelim (',', ENoSemi) ;
|
|
|
+ ParseExpr (dummy) ;
|
|
|
+ IF OK () AND ((dummy.cls = TScalar) OR (dummy.cls = TChar)) THEN
|
|
|
+ LoadAtom (dummy) ; EmPushAx () ;
|
|
|
+ ExpectDelim (',', ENoSemi) ;
|
|
|
+ ParseExpr (errV) ;
|
|
|
+ IF OK () AND ((errV.cls = TScalar) OR (errV.cls = TChar)) THEN
|
|
|
+ LoadAtom (errV) ; EmPushAx () ;
|
|
|
+ EmPopAx () ; (* len *)
|
|
|
+ EmPopBx () ; (* pos *)
|
|
|
+ EmPopCx () ; (* source *)
|
|
|
+ EmPushAx () ; EmPushBx () ; EmPushCx () ;
|
|
|
+ DropC (EmCall (TU_StrDelete)) ;
|
|
|
+ EmAddSp (6)
|
|
|
+ ELSIF OK () THEN
|
|
|
+ Err (ETypeErr)
|
|
|
+ END
|
|
|
+ ELSIF OK () THEN
|
|
|
+ Err (ETypeErr)
|
|
|
+ END
|
|
|
+ ELSIF OK () THEN
|
|
|
+ Err (ETypeErr)
|
|
|
+ END ;
|
|
|
+ ExpectDelim (')', ENoSemi) ;
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
IF which = BI_Val THEN
|
|
|
(* Val(S, V, E): integer conversion. E receives 0 on success or the
|
|
|
1-based position of the first invalid character; V is left unchanged
|
|
|
@@ -7939,6 +7977,8 @@ BEGIN
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
i := NewSym ("INT", KBuiltin, BI_Int, 0, 0, 0, 0, FALSE) ;
|
|
|
symtab [i].defnd := TRUE ;
|
|
|
+ i := NewSym ("DELETE", KBuiltin, BI_Delete, 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. *)
|
|
|
@@ -8126,6 +8166,7 @@ BEGIN
|
|
|
TU_RealCos := RT_Entry (52) ;
|
|
|
TU_RealArctan := RT_Entry (53) ;
|
|
|
TU_RealIntFunc := RT_Entry (27) ;
|
|
|
+ TU_StrDelete := RT_Entry (54) ;
|
|
|
TU_WrStr := RT_Entry (15) ; (* a string variable is written through
|
|
|
the address on the stack *)
|
|
|
TU_RdStr := RT_Entry (16) ; (* readln(s)/read(s): TPSRC8 prdstr,
|