|
|
@@ -76,7 +76,13 @@ CONST
|
|
|
D_RMANT = 32 ; (* 2 bytes: the second operand's saved MSB *)
|
|
|
D_RMANT1 = 33 ; (* its high byte, mixed with operand 1's sign *)
|
|
|
D_CVDEC = 34 ; (* 1 byte: the second exponent during alignment *)
|
|
|
- D_END = 35 ; (* the block is padded to here *)
|
|
|
+ D_RMUL11 = 35 ; (* a's saved AX; D_RMUL11+1 is its high byte (AH) *)
|
|
|
+ D_RMUL12 = 37 ; (* a's saved BX *)
|
|
|
+ D_RMUL13 = 39 ; (* a's saved DX *)
|
|
|
+ D_RMUL21 = 41 ; (* b's saved CX (low byte is the exponent, skipped) *)
|
|
|
+ D_RMUL22 = 43 ; (* b's saved SI *)
|
|
|
+ D_RMUL23 = 45 ; (* b's saved DI *)
|
|
|
+ D_END = 47 ; (* the block is padded to here *)
|
|
|
|
|
|
(* THE LOAD BIAS. Everything above is an offset into the image as this
|
|
|
compiler numbers it: the entry JMP is at image 0. But a DOS .COM is
|
|
|
@@ -133,7 +139,7 @@ VAR
|
|
|
dataAt : CARDINAL ;
|
|
|
rtBase : CARDINAL ;
|
|
|
built : BOOLEAN ;
|
|
|
- entNm : ARRAY [0..23] OF ARRAY [0..MaxNm] OF CHAR ;
|
|
|
+ entNm : ARRAY [0..24] OF ARRAY [0..MaxNm] OF CHAR ;
|
|
|
|
|
|
(* ---------------------------------------------------------------- *)
|
|
|
(* name helpers *)
|
|
|
@@ -620,6 +626,41 @@ PROCEDURE Stc ; BEGIN B (0F9H) END Stc ; (* STC *)
|
|
|
PROCEDURE CmpAlCl ; BEGIN B (38H) ; B (0C8H) END CmpAlCl ; (* CMP AL,CL *)
|
|
|
PROCEDURE CmpCl0 ; BEGIN B (80H) ; B (0F9H) ; B (0) END CmpCl0 ; (* 80 F9 00 *)
|
|
|
PROCEDURE MovBhBl ; BEGIN B (88H) ; B (0DFH) END MovBhBl ; (* BH:=BL *)
|
|
|
+PROCEDURE CmpCh0 ; BEGIN B (80H) ; B (0FDH) ; B (0) END CmpCh0 ;
|
|
|
+PROCEDURE AddAlCl ; BEGIN B (00H) ; B (0C8H) END AddAlCl ; (* AL:=AL+CL *)
|
|
|
+PROCEDURE AddAlImm (v : CARDINAL) ;
|
|
|
+BEGIN B (04H) ; B (v MOD 256) END AddAlImm ;
|
|
|
+PROCEDURE MovSiImm (v : CARDINAL) ;
|
|
|
+BEGIN B (0BEH) ; W (v) END MovSiImm ;
|
|
|
+PROCEDURE RcrCh1 ; BEGIN B (0D0H) ; B (0DDH) END RcrCh1 ; (* RCR CH,1 *)
|
|
|
+PROCEDURE RclCh1 ; BEGIN B (0D0H) ; B (0D5H) END RclCh1 ; (* RCL CH,1 *)
|
|
|
+PROCEDURE Lahf ; BEGIN B (9FH) END Lahf ;
|
|
|
+PROCEDURE Sahf ; BEGIN B (9EH) END Sahf ;
|
|
|
+PROCEDURE XorCxDi ; BEGIN B (31H) ; B (0F9H) END XorCxDi ; (* CX:=CX XOR DI *)
|
|
|
+PROCEDURE NotCh ; BEGIN B (0F6H) ; B (0D5H) END NotCh ; (* NOT CH *)
|
|
|
+PROCEDURE AndChImm (v : CARDINAL) ;
|
|
|
+BEGIN B (80H) ; B (0E5H) ; B (v MOD 256) END AndChImm ;
|
|
|
+PROCEDURE MovDiData (delta : CARDINAL) ;
|
|
|
+BEGIN B (0BFH) ; Dd (delta) END MovDiData ;
|
|
|
+PROCEDURE LdChDiOff ; BEGIN B (8AH) ; B (2DH) END LdChDiOff ; (* CH:=[DI] *)
|
|
|
+PROCEDURE AddAhData (delta : CARDINAL) ;
|
|
|
+BEGIN B (02H) ; B (26H) ; Dd (delta) END AddAhData ; (* ADD AH,[Vx] *)
|
|
|
+PROCEDURE AdcBxData (delta : CARDINAL) ;
|
|
|
+BEGIN B (13H) ; B (1EH) ; Dd (delta) END AdcBxData ; (* ADC BX,[Vx] *)
|
|
|
+PROCEDURE AdcDxData (delta : CARDINAL) ;
|
|
|
+BEGIN B (13H) ; B (16H) ; Dd (delta) END AdcDxData ; (* ADC DX,[Vx] *)
|
|
|
+PROCEDURE StDataCh (delta : CARDINAL) ;
|
|
|
+BEGIN B (88H) ; B (2EH) ; Dd (delta) END StDataCh ;
|
|
|
+PROCEDURE StDataCx (delta : CARDINAL) ;
|
|
|
+BEGIN B (89H) ; B (0EH) ; Dd (delta) END StDataCx ;
|
|
|
+PROCEDURE StDataSi (delta : CARDINAL) ;
|
|
|
+BEGIN B (89H) ; B (36H) ; Dd (delta) END StDataSi ;
|
|
|
+PROCEDURE StDataAx (delta : CARDINAL) ;
|
|
|
+BEGIN B (0A3H) ; Dd (delta) END StDataAx ;
|
|
|
+PROCEDURE StDataBx (delta : CARDINAL) ;
|
|
|
+BEGIN B (89H) ; B (1EH) ; Dd (delta) END StDataBx ;
|
|
|
+PROCEDURE StDataDx (delta : CARDINAL) ;
|
|
|
+BEGIN B (89H) ; B (16H) ; Dd (delta) END StDataDx ;
|
|
|
PROCEDURE SubAhCh ; BEGIN B (28H) ; B (0ECH) END SubAhCh ; (* AH:=AH-CH *)
|
|
|
PROCEDURE MovClImm (v : CARDINAL) ;
|
|
|
BEGIN B (0B1H) ; B (v MOD 256) END MovClImm ;
|
|
|
@@ -678,6 +719,23 @@ BEGIN B (8BH) ; B (75H) ; B (off MOD 256) END LdSiDiOff ;
|
|
|
PROCEDURE LdDiDiOff (off : CARDINAL) ;
|
|
|
BEGIN B (8BH) ; B (7DH) ; B (off MOD 256) END LdDiDiOff ;
|
|
|
PROCEDURE PushBp4 ; BEGIN B (0FFH) ; B (76H) ; B (4) END PushBp4 ; (* PUSH [BP+4] *)
|
|
|
+PROCEDURE JccNear (code : CARDINAL ; nm : ARRAY OF CHAR) ;
|
|
|
+(* A conditional near jump: the 8086 has no Jcc rel16, so an INVERSE Jcc_s
|
|
|
+ +3 over an E9 rel16. The inverse is what makes the E9 run when `code'
|
|
|
+ HOLDS; a raw Jcc here would jump when it does NOT (remult's zero test did
|
|
|
+ exactly that and multiplied everything to zero). Use this when the target
|
|
|
+ is more than 127 bytes away; Jcc's rel8 wraps silently otherwise (the
|
|
|
+ FixUp guard below now refuses that). *)
|
|
|
+BEGIN
|
|
|
+ IF (code MOD 2) = 0 THEN
|
|
|
+ B (code + 1)
|
|
|
+ ELSE
|
|
|
+ B (code - 1)
|
|
|
+ END ;
|
|
|
+ B (3) ; B (0E9H) ; AddFix (1, rpos, nm, 0) ; W (0)
|
|
|
+END JccNear ;
|
|
|
+PROCEDURE JmpNear (nm : ARRAY OF CHAR) ;
|
|
|
+BEGIN B (0E9H) ; AddFix (1, rpos, nm, 0) ; W (0) END JmpNear ;
|
|
|
PROCEDURE Call (nm : ARRAY OF CHAR) ;
|
|
|
BEGIN B (0E8H) ; AddFix (1, rpos, nm, 0) ; W (0) END Call ;
|
|
|
PROCEDURE StVxBx (delta : CARDINAL ) ;
|
|
|
@@ -1714,6 +1772,100 @@ BEGIN
|
|
|
RetR
|
|
|
END EmitRealAddSub ;
|
|
|
|
|
|
+PROCEDURE EmitRealMul ;
|
|
|
+(* remult, TPSRC2 1532-1587, with testexp (TPSRC3 50-78) inlined.
|
|
|
+
|
|
|
+ ABI and register convention are real_add's: [BP+4] is a 12-byte block
|
|
|
+ holding a then b; the result overwrites a; a is AX/BX/DX and b CX/SI/DI.
|
|
|
+
|
|
|
+ testexp is inlined because the reference's version is called and, on
|
|
|
+ underflow or overflow, POPS ITS RETURN ADDRESS to leave remult entirely.
|
|
|
+ That trick cannot survive being called from our wrapper, so the two
|
|
|
+ exponent fault paths jump to this core's zero/error exits instead.
|
|
|
+
|
|
|
+ Multiplication is the reference's shift-and-add over the five mantissa
|
|
|
+ bytes: for each byte, if it is zero the 40-bit result is shifted right
|
|
|
+ eight; otherwise each of its eight bits conditionally adds a's mantissa
|
|
|
+ and shifts the result one. LAHF/SAHF carry the guard bit across the
|
|
|
+ normalisation TEST. Overflow leaves through TP3's error 1 (exit code 1);
|
|
|
+ underflow returns zero. *)
|
|
|
+BEGIN
|
|
|
+ M ("real_mul") ;
|
|
|
+ PushBp ; MovBpSp ;
|
|
|
+ PushBx ; PushDx ; PushSi ; PushDi ;
|
|
|
+ PushBp4 ;
|
|
|
+ MovSiBp4 ;
|
|
|
+ LdAxSi ;
|
|
|
+ LdCxSiOff (2) ; LdDxSiOff (4) ;
|
|
|
+ MovBxCx ;
|
|
|
+ MovDiSi ;
|
|
|
+ LdCxDiOff (6) ; LdSiDiOff (8) ; LdDiDiOff (10) ;
|
|
|
+ Call ("rm_core") ;
|
|
|
+ PopDi ;
|
|
|
+ StDiAx ; StDiOffBx (2) ; StDiOffDx (4) ;
|
|
|
+ PopDi ; PopSi ; PopDx ; PopBx ;
|
|
|
+ MovSpBp ; PopBp ; RetR ;
|
|
|
+
|
|
|
+ M ("rm_core") ;
|
|
|
+ CmpCl0 ; JccNear (74H, "rm_zero") ;
|
|
|
+ CmpAl0 ; JccNear (74H, "rm_ret") ;
|
|
|
+ AddAlCl ;
|
|
|
+ Jb8 ("rm_ovr1") ;
|
|
|
+ AddAlImm (80H) ;
|
|
|
+ Jb8 ("rm_ok") ;
|
|
|
+ JmpNear ("rm_zero") ; (* underflow *)
|
|
|
+ M ("rm_ovr1") ;
|
|
|
+ AddAlImm (80H) ;
|
|
|
+ Jae8 ("rm_ok") ;
|
|
|
+ (* overflow: TP3 error 1 *)
|
|
|
+ MovAlD (1) ; MovAh (4CH) ; Int21 ;
|
|
|
+ M ("rm_ok") ;
|
|
|
+ (* testexp's tail *)
|
|
|
+ StDataCx (D_RMUL21) ;
|
|
|
+ MovCxDx ; XorCxDi ; NotCh ; AndChImm (80H) ; StDataCh (D_RESAVE) ;
|
|
|
+ OrDhImm (80H) ; OrDiImm (8000H) ;
|
|
|
+ StDataSi (D_RMUL22) ; StDataDi (D_RMUL23) ;
|
|
|
+ (* remult *)
|
|
|
+ StDataAx (D_RMUL11) ; StDataBx (D_RMUL12) ; StDataDx (D_RMUL13) ;
|
|
|
+ XorAhAh ; XorBxBx ; XorDxDx ;
|
|
|
+ MovDiData (D_RMUL21) ;
|
|
|
+ MovClImm (5) ;
|
|
|
+ M ("rm_byt") ;
|
|
|
+ IncDi ;
|
|
|
+ LdChDiOff ;
|
|
|
+ CmpCh0 ; Jne8 ("rm_domul") ;
|
|
|
+ MovAhBl ; MovBlBh ; MovBhDl ; MovDlDh ; XorDhDh ;
|
|
|
+ Jmp8 ("rm_nxt") ;
|
|
|
+ M ("rm_domul") ;
|
|
|
+ MovSiImm (8) ;
|
|
|
+ M ("rm_mul") ;
|
|
|
+ RcrCh1 ;
|
|
|
+ Jae8 ("rm_bit0") ;
|
|
|
+ AddAhData (D_RMUL11 + 1) ;
|
|
|
+ AdcBxData (D_RMUL12) ;
|
|
|
+ AdcDxData (D_RMUL13) ;
|
|
|
+ M ("rm_bit0") ;
|
|
|
+ RcrDx1 ; RcrBx1 ; RcrAh1 ;
|
|
|
+ DecSi ; Jne8 ("rm_mul") ;
|
|
|
+ M ("rm_nxt") ;
|
|
|
+ DecCl ; Jne8 ("rm_byt") ;
|
|
|
+ XchgAxCx ;
|
|
|
+ Lahf ;
|
|
|
+ TestDhImm (80H) ; Jne8 ("rm_noadj") ;
|
|
|
+ Sahf ;
|
|
|
+ RclCh1 ; RclBx1 ; RclDx1 ;
|
|
|
+ CmpCl0 ; Je8 ("rm_noadj") ;
|
|
|
+ DecCl ;
|
|
|
+ M ("rm_noadj") ;
|
|
|
+ XchgAxCx ;
|
|
|
+ XorDhData (D_RESAVE) ;
|
|
|
+ CmpAl0 ; Jne8 ("rm_ret") ;
|
|
|
+ M ("rm_zero") ;
|
|
|
+ XorAxAx ; XorBxBx ; XorDxDx ;
|
|
|
+ M ("rm_ret") ;
|
|
|
+ RetR
|
|
|
+END EmitRealMul ;
|
|
|
+
|
|
|
PROCEDURE EmitData ;
|
|
|
(* The runtime's data block. The D_ constants name the offsets in it and are
|
|
|
ASSERTED against what is emitted here, three ways: the starting offset of
|
|
|
@@ -1762,6 +1914,30 @@ BEGIN
|
|
|
HALT
|
|
|
END ;
|
|
|
B (0) ;
|
|
|
+ IF dataAt + D_RMUL11 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
+ IF dataAt + D_RMUL12 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
+ IF dataAt + D_RMUL13 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
+ IF dataAt + D_RMUL21 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
+ IF dataAt + D_RMUL22 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
+ IF dataAt + D_RMUL23 # rpos THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
+ B (0) ; B (0) ;
|
|
|
WHILE rpos < dataAt + D_END DO
|
|
|
B (0)
|
|
|
END ;
|
|
|
@@ -1789,7 +1965,15 @@ BEGIN
|
|
|
t := LblOff (fix [i].nm) ;
|
|
|
IF fix [i].kind = 0 THEN
|
|
|
(* rel8 is measured from the end of the instruction, i.e. one
|
|
|
- byte past the displacement field *)
|
|
|
+ byte past the displacement field. A target beyond +127/-128
|
|
|
+ would wrap silently and send the machine into the middle of
|
|
|
+ an instruction; that happened in remult's early zero/return
|
|
|
+ jumps. Refuse it. *)
|
|
|
+ IF (VAL (LONGINT, t) - VAL (LONGINT, fix [i].place + 1) < -128)
|
|
|
+ OR (VAL (LONGINT, t) - VAL (LONGINT, fix [i].place + 1) > 127)
|
|
|
+ THEN
|
|
|
+ HALT
|
|
|
+ END ;
|
|
|
rel := (t + 100H - (fix [i].place + 1)) MOD 100H ;
|
|
|
rt [fix [i].place] := VAL (BYTE, rel)
|
|
|
ELSE
|
|
|
@@ -1822,7 +2006,7 @@ BEGIN
|
|
|
EmitRdChar ; EmitRdBool ; EmitRdLn ;
|
|
|
EmitGetCh ; EmitUnGetCh ;
|
|
|
EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ;
|
|
|
- EmitRealFromInt ; EmitRealAddSub ;
|
|
|
+ EmitRealFromInt ; EmitRealAddSub ; EmitRealMul ;
|
|
|
EmitData ;
|
|
|
FixUp ;
|
|
|
SetStr (entNm [0], "initmem") ;
|
|
|
@@ -1849,6 +2033,7 @@ BEGIN
|
|
|
SetStr (entNm [21], "real_from_int") ;
|
|
|
SetStr (entNm [22], "real_add") ;
|
|
|
SetStr (entNm [23], "real_sub") ;
|
|
|
+ SetStr (entNm [24], "real_mul") ;
|
|
|
built := TRUE
|
|
|
END RT_Build ;
|
|
|
|
|
|
@@ -1876,7 +2061,7 @@ BEGIN
|
|
|
IF NOT built THEN
|
|
|
RT_Build (0)
|
|
|
END ;
|
|
|
- IF i > 23 THEN
|
|
|
+ IF i > 24 THEN
|
|
|
RETURN 0
|
|
|
END ;
|
|
|
RETURN rtBase + LblOff (entNm [i])
|