|
|
@@ -974,6 +974,11 @@ BEGIN
|
|
|
Ebyte (5AH)
|
|
|
END EmPopDx ;
|
|
|
|
|
|
+PROCEDURE EmPopSi () ;
|
|
|
+BEGIN
|
|
|
+ Ebyte (5EH) (* POP SI *)
|
|
|
+END EmPopSi ;
|
|
|
+
|
|
|
(* 91 = XCHG AX,CX, and NOT 93. LoadPair hands the operator the left
|
|
|
operand in CX and the right in AX (in the original, and still the
|
|
|
commonest, shape: it pushes the left, loads the right, then pops the
|
|
|
@@ -2528,6 +2533,36 @@ BEGIN
|
|
|
END
|
|
|
END LoadPair ;
|
|
|
|
|
|
+PROCEDURE EmStrBlob (r : ERes) : CARDINAL ;
|
|
|
+(* Emit a string literal's <len><chars> in the code stream behind a JMP and
|
|
|
+ return the image offset of the LENGTH byte. Shared by EmPushStrAddr (which
|
|
|
+ pushes that address) and EmPushStrSlot (which copies the bytes onto the
|
|
|
+ stack for a string value parameter). *)
|
|
|
+VAR n, len, here : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ len := strLen [r.strx] ;
|
|
|
+ IF len > 255 THEN
|
|
|
+ (* As in IoCall: the length is one byte, so a longer literal would wrap
|
|
|
+ and silently carry only its first (length MOD 256) characters.
|
|
|
+ TP3 strings are at most 255 characters. *)
|
|
|
+ Err (EConstRange) ;
|
|
|
+ RETURN 0
|
|
|
+ END ;
|
|
|
+ IF len + 1 <= 127 THEN
|
|
|
+ Ebyte (0EBH) ; Ebyte (VAL (BYTE, len + 1)) (* JMP rel8 over it *)
|
|
|
+ ELSE
|
|
|
+ Ebyte (0E9H) ; Eword (len + 1) (* JMP rel16 over it *)
|
|
|
+ END ;
|
|
|
+ here := pc ; (* the length byte: the literal's address *)
|
|
|
+ Ebyte (VAL (BYTE, len)) ;
|
|
|
+ n := 0 ;
|
|
|
+ WHILE n < len DO
|
|
|
+ Ebyte (VAL (BYTE, ORD (strPool [strOff [r.strx] + n]))) ;
|
|
|
+ INC (n)
|
|
|
+ END ;
|
|
|
+ RETURN here
|
|
|
+END EmStrBlob ;
|
|
|
+
|
|
|
PROCEDURE EmPushStrAddr (r : ERes) ;
|
|
|
(* Push the ADDRESS of a whole-string operand - the argument shape cmpstr
|
|
|
takes, one per operand.
|
|
|
@@ -2561,38 +2596,52 @@ PROCEDURE EmPushStrAddr (r : ERes) ;
|
|
|
(its character code), so `s = 'a'` compares a string with a character and
|
|
|
is a type error rather than a length-1 string compare. That is deliberate
|
|
|
- it is the same rule `c := 'a'` relies on - and the caller rejects it. *)
|
|
|
-VAR n, len, here : CARDINAL ;
|
|
|
BEGIN
|
|
|
IF r.kind = 1 THEN
|
|
|
EmPushVarAddr (symtab [r.idx].local,
|
|
|
(symtab [r.idx].off + r.boff) MOD 10000H)
|
|
|
ELSIF r.kind = 3 THEN
|
|
|
- len := strLen [r.strx] ;
|
|
|
- IF len > 255 THEN
|
|
|
- (* As in IoCall: the length is one byte, so a longer literal would
|
|
|
- wrap and silently compare only its first (length MOD 256)
|
|
|
- characters. TP3 strings are at most 255 characters. *)
|
|
|
- Err (EConstRange) ;
|
|
|
- RETURN
|
|
|
- END ;
|
|
|
- IF len + 1 <= 127 THEN
|
|
|
- Ebyte (0EBH) ; Ebyte (VAL (BYTE, len + 1)) (* JMP rel8 over it *)
|
|
|
- ELSE
|
|
|
- Ebyte (0E9H) ; Eword (len + 1) (* JMP rel16 over it *)
|
|
|
- END ;
|
|
|
- here := pc ; (* the length byte: the literal's address *)
|
|
|
- Ebyte (VAL (BYTE, len)) ;
|
|
|
- n := 0 ;
|
|
|
- WHILE n < len DO
|
|
|
- Ebyte (VAL (BYTE, ORD (strPool [strOff [r.strx] + n]))) ;
|
|
|
- INC (n)
|
|
|
- END ;
|
|
|
- EmPushVarAddr (FALSE, here) (* LEA AX,[here]; PUSH AX *)
|
|
|
+ EmPushVarAddr (FALSE, EmStrBlob (r)) (* the literal travels inline *)
|
|
|
ELSE
|
|
|
Err (ENoLib) (* a computed string is not a value *)
|
|
|
END
|
|
|
END EmPushStrAddr ;
|
|
|
|
|
|
+PROCEDURE EmPushStrSlot (r : ERes ; reserve, copyN : CARDINAL) ;
|
|
|
+(* Push a STRING VALUE argument's whole slot: reserve `reserve' bytes on the
|
|
|
+ stack and copy `copyN' of the source string's <len><chars> into them, so
|
|
|
+ that after the CALL the callee's BP+4 is the length byte and the characters
|
|
|
+ follow it.
|
|
|
+
|
|
|
+ <push the source address, then POP SI> ; local/global/literal alike
|
|
|
+ SUB SP,reserve ; MOV DI,SP ; MOV CX,copyN
|
|
|
+ loop: MOV AL,[SI] ; MOV [DI],AL ; INC SI ; INC DI ; LOOP loop
|
|
|
+
|
|
|
+ The address comes from EmPushStrAddr, which already knows how to form it for
|
|
|
+ a local ([BP+off]), a global (absolute) or a literal (inline blob) - so a
|
|
|
+ caller's LOCAL string can be passed too, not just a global.
|
|
|
+
|
|
|
+ A byte loop, not REP MOVSB, on purpose: MOVS/STOS address through ES, and a
|
|
|
+ .COM's ES happens to equal DS but nothing in this compiler establishes that
|
|
|
+ contract. Every access here is DS-relative, which is the one segment the
|
|
|
+ image already guarantees. `copyN' is at most `reserve' (a shorter actual
|
|
|
+ string than the formal leaves the tail of the slot untouched, harmless
|
|
|
+ because the length byte bounds every read). *)
|
|
|
+BEGIN
|
|
|
+ EmPushStrAddr (r) ; (* push the source address *)
|
|
|
+ EmPopSi () ; (* SI := source *)
|
|
|
+ EmSubSp (reserve) ;
|
|
|
+ Ebyte (89H) ; Ebyte (0E7H) ; (* MOV DI,SP *)
|
|
|
+ EmMovCxi (copyN) ;
|
|
|
+ IF copyN > 0 THEN
|
|
|
+ Ebyte (8AH) ; Ebyte (04H) ; (* MOV AL,[SI] *)
|
|
|
+ Ebyte (88H) ; Ebyte (05H) ; (* MOV [DI],AL *)
|
|
|
+ Ebyte (46H) ; (* INC SI *)
|
|
|
+ Ebyte (47H) ; (* INC DI *)
|
|
|
+ Ebyte (0E2H) ; Ebyte (0F8H) (* LOOP -8: back to MOV AL,[SI] *)
|
|
|
+ END
|
|
|
+END EmPushStrSlot ;
|
|
|
+
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
(* sets - type sizing, literals, compile-time membership *)
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
@@ -3252,7 +3301,7 @@ PROCEDURE ParseCallArgs (idx : CARDINAL) ;
|
|
|
first argument goes on first and so ends up farthest from BP, and the LAST
|
|
|
declared parameter is the one at BP+4 (RESUME-TP3.md 3.11). *)
|
|
|
VAR arg : ERes ;
|
|
|
- nArgs, cleanup, slot : CARDINAL ;
|
|
|
+ nArgs, cleanup, slot, nCopy : CARDINAL ;
|
|
|
BEGIN
|
|
|
nArgs := 0 ;
|
|
|
cleanup := 0 ;
|
|
|
@@ -3267,15 +3316,32 @@ BEGIN
|
|
|
ParseExpr (arg) ;
|
|
|
slot := ParmSlot (idx, nArgs) ;
|
|
|
IF slot > 2 THEN
|
|
|
- (* A value parameter wider than a word (a string): its whole slot
|
|
|
- must be pushed, which is step 3 of the calling-convention work.
|
|
|
- Loud, because pushing two bytes of a 71-byte argument would be
|
|
|
- a silent miscompile. *)
|
|
|
- Err (ENoLib) ;
|
|
|
- EXIT
|
|
|
+ (* A STRING VALUE parameter: push its whole slot, copied.
|
|
|
+ `copyN' is at most the slot: an actual shorter than the formal
|
|
|
+ leaves the tail untouched, which is harmless because the length
|
|
|
+ byte bounds every read. *)
|
|
|
+ IF arg.cls # TString THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ nCopy := slot ;
|
|
|
+ IF arg.kind = 1 THEN
|
|
|
+ IF VarSize (arg) < nCopy THEN
|
|
|
+ nCopy := VarSize (arg)
|
|
|
+ END
|
|
|
+ ELSIF arg.kind = 3 THEN
|
|
|
+ IF strLen [arg.strx] + 1 < nCopy THEN
|
|
|
+ nCopy := strLen [arg.strx] + 1
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ Err (ENoLib) ; (* a computed string is not a value *)
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ EmPushStrSlot (arg, slot, nCopy)
|
|
|
+ ELSE
|
|
|
+ LoadAtom (arg) ;
|
|
|
+ EmPushAx ()
|
|
|
END ;
|
|
|
- LoadAtom (arg) ;
|
|
|
- EmPushAx () ;
|
|
|
cleanup := cleanup + slot ;
|
|
|
INC (nArgs) ;
|
|
|
IF NOT MatchDelim (',') THEN
|
|
|
@@ -3291,7 +3357,7 @@ PROCEDURE ParseCall (idx : CARDINAL) ;
|
|
|
(* procedure/function call; '(' optional - same parse-then-push as above,
|
|
|
reached from ParseAtom when a FUNCTION is called in an expression *)
|
|
|
VAR arg : ERes ;
|
|
|
- nArgs, cleanup, slot : CARDINAL ;
|
|
|
+ nArgs, cleanup, slot, nCopy : CARDINAL ;
|
|
|
BEGIN
|
|
|
nArgs := 0 ;
|
|
|
cleanup := 0 ;
|
|
|
@@ -3305,12 +3371,29 @@ BEGIN
|
|
|
ParseExpr (arg) ;
|
|
|
slot := ParmSlot (idx, nArgs) ;
|
|
|
IF slot > 2 THEN
|
|
|
- (* see ParseCallArgs: a string slot needs its whole width *)
|
|
|
- Err (ENoLib) ;
|
|
|
- EXIT
|
|
|
+ (* see ParseCallArgs: push the whole string slot *)
|
|
|
+ IF arg.cls # TString THEN
|
|
|
+ Err (ETypeErr) ;
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ nCopy := slot ;
|
|
|
+ IF arg.kind = 1 THEN
|
|
|
+ IF VarSize (arg) < nCopy THEN
|
|
|
+ nCopy := VarSize (arg)
|
|
|
+ END
|
|
|
+ ELSIF arg.kind = 3 THEN
|
|
|
+ IF strLen [arg.strx] + 1 < nCopy THEN
|
|
|
+ nCopy := strLen [arg.strx] + 1
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ Err (ENoLib) ;
|
|
|
+ EXIT
|
|
|
+ END ;
|
|
|
+ EmPushStrSlot (arg, slot, nCopy)
|
|
|
+ ELSE
|
|
|
+ LoadAtom (arg) ;
|
|
|
+ EmPushAx ()
|
|
|
END ;
|
|
|
- LoadAtom (arg) ;
|
|
|
- EmPushAx () ;
|
|
|
cleanup := cleanup + slot ;
|
|
|
INC (nArgs) ;
|
|
|
IF NOT MatchDelim (',') THEN
|
|
|
@@ -4732,7 +4815,10 @@ BEGIN
|
|
|
END ;
|
|
|
ExpectDelim (':', ENoSemi) ; (* formal is 'name : type' *)
|
|
|
ParseType (cls, size, elem) ;
|
|
|
- IF size > 2 THEN
|
|
|
+ IF (size > 2) AND (cls # TString) THEN
|
|
|
+ (* A string VALUE parameter is a whole-slot copy (n+1 bytes on
|
|
|
+ the stack); any other type wider than a word - a record, an
|
|
|
+ array, a set - is still refused. *)
|
|
|
Err (ENoLib) ;
|
|
|
RETURN
|
|
|
END ;
|