bootstrap.assembler.arm: Fix overflowing fixnum arithmetic

mrjbq7 · Jul 14, 2024 · cc432bd · cc432bd
1 parent 3e8c888
commit cc432bd
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 4 deletions.
diff --git a/basis/bootstrap/assembler/arm.64.factor b/basis/bootstrap/assembler/arm.64.factor
@@ -804,13 +804,25 @@ big-endian off
     ! ## Math
     ! Overflowing fixnum (integer) addition
     { fixnum+ [
-        [ ADDr ] "overflow_fixnum_add" jit-overflow ] }
+        [ ADDSr ] "overflow_fixnum_add" jit-overflow ] }
     ! Overflowing fixnum (integer) subtraction
     { fixnum- [
-        [ SUBr ] "overflow_fixnum_subtract" jit-overflow ] }
+        [ SUBSr ] "overflow_fixnum_subtract" jit-overflow ] }
     ! Overflowing fixnum (integer) multiplication
     { fixnum* [
-        [ MUL ] "overflow_fixnum_multiply" jit-overflow ] }
+        jit-save-context
+        load-arg1/2
+        arg1 untag
+        arg2 arg1 temp0 MUL
+        1 push-down0
+        arg2 arg1 temp1 SMULH
+        63 temp0 temp0 ASRi
+        temp0 temp1 CMPr
+        [ 8 + EQ B.cond ] [
+            vm-reg arg3 MOVr
+            "overflow_fixnum_multiply" jit-call
+        ] jit-conditional
+    ] }
 
     ! ## Misc
     { fpu-state [

diff --git a/basis/cpu/arm/64/assembler/assembler.factor b/basis/cpu/arm/64/assembler/assembler.factor
@@ -210,6 +210,7 @@ PRIVATE>
 
 : ADDi ( uimm12 Rn Rd -- ) 2bw [ swap split-imm ] 2dip ADDi-encode ;
 : ADDr ( Rm Rn Rd -- ) 3bw [ 3 0 ] 2dip ADDer-encode ;
+: ADDSr ( Rm Rn Rd -- ) 3bw [ 3 0 ] 2dip ADDSer-encode ;
 
 : ADDV ( Vn Rd size Q -- ) -roll -rot ADDV-encode ;
 
@@ -291,7 +292,7 @@ PRIVATE>
 
 : LDUR ( simm9 Rn Rt -- ) 2bw [ swap 9 ?sbits ] 2dip LDUR-encode ;
 
-: LSLi ( uimm6 Rn Rd -- ) 2bw 2bw [ spin 6 ?ubits [ 64 swap - ] [ 63 swap - ] bi ] 
+: LSLi ( uimm6 Rn Rd -- ) 2bw 2bw [ spin 6 ?ubits [ 64 swap - ] [ 63 swap - ] bi ]
                                    2dip LSLi-encode ;
 : LSLr ( Rm Rn Rd -- ) 3bw LSLr-encode ;
 
@@ -326,6 +327,8 @@ PRIVATE>
 
 : SDIV ( Rm Rn Rd -- ) 3bw SDIV-encode ;
 
+: SMULH ( Rm Rn Rd -- ) SMULH-encode ;
+
 : STADD ( Rs Rn -- ) 2bw STADD-encode ;
 
 : STPpost ( simm10 Rn Rt2 Rt -- ) (load/store-pair) STPpost-encode ;
@@ -339,6 +342,7 @@ PRIVATE>
 
 : SUBi ( uimm12 Rn Rd -- ) 2bw [ swap split-imm ] 2dip SUBi-encode ;
 : SUBr ( Rm Rn Rd -- ) 3bw [ 3 0 ] 2dip SUBer-encode ;
+: SUBSr ( Rm Rn Rd -- ) 3bw [ 3 0 ] 2dip SUBSer-encode ;
 
 : SVC ( uimm16 -- ) 16 ?ubits SVC-encode ;