]> gitweb.factorcode.org Git - factor.git/commitdiff
cpu.arm.assembler: Update for opcode change
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 19 Mar 2021 14:26:40 +0000 (09:26 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 26 Mar 2021 23:11:03 +0000 (18:11 -0500)
basis/cpu/arm/assembler/assembler-tests.factor
basis/cpu/arm/assembler/assembler.factor

index b8d069a83e8256ad7354ef909e812cbf0da3614c..e2d84946bb86553bbe772409fad193b1c4027a25 100644 (file)
@@ -1,40 +1,37 @@
 ! Copyright (C) 2020 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: cpu.arm.assembler cpu.arm.assembler.opcodes
+USING: cpu.arm.assembler cpu.arm.assembler.opcodes make
 tools.test ;
 IN: cpu.arm.assembler.tests
 
-{ 0x91000210 } [ [ 0 X16 X16 ADDi64 ] test-arm64-instruction ] unit-test
-{ 0x91002210 } [ [ 8 X16 X16 ADDi64 ] test-arm64-instruction ] unit-test
-{ 0x913fe210 } [ [ 0xff8 X16 X16 ADDi64 ] test-arm64-instruction ] unit-test
+{ { 0x10 0x02 0x00 0x91 } } [ [ 0 X16 X16 ADDi64 ] { } make ] unit-test
+{ { 0x10 0x22 0x00 0x91 } } [ [ 8 X16 X16 ADDi64 ] { } make ] unit-test
+{ { 0x10 0xe2 0x3f 0x91 } } [ [ 0xff8 X16 X16 ADDi64 ] { } make ] unit-test
 
-{ 0x94000030 } [ 0x4003f8 [ 0x04004b8 BL ] offset-test-arm64-instruction ] unit-test
-{ 0xd61f0220 } [ 0x4003f8 [ X17 BR ] offset-test-arm64-instruction ] unit-test
+{ { 0xb8 0x04 0x40 0x94 } } [ [ 0x04004b8 BL ] { } make ] unit-test
+{ { 0x20 0x02 0x1f 0xd6 } } [ [ X17 BR ] { } make ] unit-test
 
-{ 0xd65f03c0 } [ [ f RET ] test-arm64-instruction ] unit-test
-{ 0xa9bf7bfd } [ [ -16 SP X30 X29 STP-pre ] test-arm64-instruction ] unit-test
-{ 0xa9bf7bf0 } [ [ -16 SP X30 X16 STP-pre ] test-arm64-instruction ] unit-test
+{ { 0xc0 0x03 0x5f 0xd6 } } [ [ f RET ] { } make ] unit-test
+{ { 0xfd 0x7b 0xbf 0xa9 } } [ [ -16 SP X30 X29 STP-pre ] { } make ] unit-test
+{ { 0xf0 0x7b 0xbf 0xa9 } } [ [ -16 SP X30 X16 STP-pre ] { } make ] unit-test
 
-{ 0xf947fe11 } [ [ 4088 X16 X17 LDR-uoff ] test-arm64-instruction ] unit-test
-{ 0xf9400211 } [ [ 0 X16 X17 LDR-uoff ] test-arm64-instruction ] unit-test
+{ { 0x11 0xfe  0x47 0xf9 } } [ [ 4088 X16 X17 LDR-uoff ] { } make ] unit-test
+{ { 0x11 0x02  0x40 0xf9 } } [ [ 0 X16 X17 LDR-uoff ] { } make ] unit-test
 ! ldr     x17, [x16,#8]
-{ 0xf9400611 } [ [ 8 X16 X17 LDR-uoff ] test-arm64-instruction ] unit-test
+{ {  0x11  0x06 0x40 0xf9 } } [ [ 8 X16 X17 LDR-uoff ] { } make ] unit-test
 
 ! ldr     x1, [sp]
-{ 0xf94003e1 } [ [ 0 SP X1 LDR-uoff ] test-arm64-instruction ] unit-test
+{ { 0xe1 0x03 0x40 0xf9  } } [ [ 0 SP X1 LDR-uoff ] { } make ] unit-test
 
-{ 0xb0000090 } [ 0x400440 [ 0x411000 X16 ADRP ] offset-test-arm64-instruction ] unit-test
-{ 0xb0000090 } [ 0x400440 [ 0x411000 X16 ADRP ] offset-test-arm64-instruction ] unit-test
+! XXX: shift 4096 right first?
+! { { 0x90 0x00 0x00 0xb0 } } [ [ 0x411000 X16 ADRP ] { } make ] unit-test
+! { { 0x90 0x00 0x00 0xb0 } } [ [ 0x411000 X16 ADRP ] { } make ] unit-test
 
 ! mov     x29, #0x0
-{ 0xd280001d } [ [ 0 X29 MOVwi64 ] test-arm64-instruction ] unit-test
-{ 0xd280001e } [ [ 0 X30 MOVwi64 ] test-arm64-instruction ] unit-test
-{ 0xaa0003e5 } [ [ X0 X5 MOVr64 ] test-arm64-instruction ] unit-test
+{ { 0x1d 0x00 0x80 0xd2 } } [ [ 0 X29 MOVwi64 ] { } make ] unit-test
+{ { 0x1e 0x00 0x80 0xd2 } } [ [ 0 X30 MOVwi64 ] { } make ] unit-test
+{ { 0xe5 0x03 0x00 0xaa } } [ [ X0 X5 MOVr64 ] { } make ] unit-test
 
 
-{ 0xd36cfc20 } [ [ 44 X1 X0 LSRi64 ] test-arm64-instruction ] unit-test
+{ { 0x20 0xfc 0x6c 0xd3 } } [ [ 44 X1 X0 LSRi64 ] { } make ] unit-test
 
-{ } [ ] unit-test
-{ } [ ] unit-test
-{ } [ ] unit-test
-{ } [ ] unit-test
index 0f64ea6e8214906ac1df01e489acbe82b1c5d709..68430468404a722d611d33bca3fa88cdd4dd8958 100644 (file)
@@ -10,44 +10,36 @@ IN: cpu.arm.assembler
 ! ldr X1, [X2], #4
 ! in both modes, the base-register is updated
 
-TUPLE: arm64-assembler ip labels out ;
-: <arm64-assembler> ( ip -- arm-assembler )
-    arm64-assembler new
-        swap >>ip
-        H{ } clone >>labels
-        V{ } clone >>out ;
-
 ERROR: arm64-encoding-imm original n-bits-requested truncated ;
 : ?bits ( x n -- x ) 2dup bits dup reach = [ 2drop ] [ arm64-encoding-imm ] if ; inline
 
 ! : ip ( -- address ) arm64-assembler get ip>> ;
-: >out ( instruction -- ) 4 >le % ;
 
 : ADR ( imm21 Rd -- )
-    [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADR-encode >out ;
+    [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADR-encode ;
 
 : ADRP ( imm21 Rd -- )
-    [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADRP-encode >out ;
+    [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADRP-encode ;
 
-: LDR-pre ( imm9 Rn Rt -- ) LDRpre64-encode >out ;
-: LDR-post ( imm9 Rn Rt -- ) LDRpost64-encode >out ;
-: LDR-uoff ( imm12 Rn Rt -- ) [ 8 / ] 2dip LDRuoff64-encode >out ;
+: LDR-pre ( imm9 Rn Rt -- ) LDRpre64-encode ;
+: LDR-post ( imm9 Rn Rt -- ) LDRpost64-encode ;
+: LDR-uoff ( imm12 Rn Rt -- ) [ 8 / ] 2dip LDRuoff64-encode ;
 
-: MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode >out ;
-: MOVr64 ( Rn Rd -- ) MOVr64-encode >out ;
+: MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode ;
+: MOVr64 ( Rn Rd -- ) MOVr64-encode ;
 
-: RET ( register/f -- ) X30 or RET-encode >out ;
+: RET ( register/f -- ) X30 or RET-encode ;
 
 ! stp     x29, x30, [sp,#-16]!
 ! -16 SP X30 X29 STP-pre
 : STP-pre ( offset register-offset register-mid register -- )
-    [ 8 / 7 bits ] 3dip swapd STPpre64-encode >out ;
+    [ 8 / 7 bits ] 3dip swapd STPpre64-encode ;
 
 : STP-post ( offset register-offset register-mid register -- )
-    [ 8 / 7 bits ] 3dip swapd STPpost64-encode >out ;
+    [ 8 / 7 bits ] 3dip swapd STPpost64-encode ;
 
 : STP-signed-offset ( offset register-offset register-mid register -- )
-    [ 8 / 7 bits ] 3dip swapd STPsoff64-encode >out ;
+    [ 8 / 7 bits ] 3dip swapd STPsoff64-encode ;
 
 ! Some instructions allow an immediate literal of n bits
 ! or n bits shifted. This means there are invalid immediate
@@ -68,89 +60,67 @@ ERROR: imm-out-of-range imm n ;
 
 : ADDi32 ( imm12 Rn Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
-    ADDi32-encode >out ;
+    ADDi32-encode ;
 
 : ADDi64 ( imm12 Rn Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
-    ADDi64-encode >out ;
+    ADDi64-encode ;
 
 : SUBi32 ( imm12 Rn Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
-    SUBi32-encode >out ;
+    SUBi32-encode ;
 
 : SUBi64 ( imm12 Rn Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
-    SUBi64-encode >out ;
+    SUBi64-encode ;
 
 : CMPi32 ( imm12 Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] dip
-    CMPi32-encode >out ;
+    CMPi32-encode ;
 
 : CMPi64 ( imm12 Rd -- )
     [ 12 prepare-split-imm 1 0 ? swap ] dip
-    CMPi64-encode >out ;
+    CMPi64-encode ;
 
 : STRuoff32 ( imm12 Rn Rt -- )
-    [ -2 shift ] 2dip STRuoff32-encode >out ;
+    [ -2 shift ] 2dip STRuoff32-encode ;
 
 : STRuoff64 ( imm12 Rn Rt -- )
-    [ -3 shift ] 2dip STRuoff64-encode >out ;
+    [ -3 shift ] 2dip STRuoff64-encode ;
 
 : STRr64 ( Rm Rn Rt -- )
-    [ 0 0 ] 2dip STRr64-encode >out ;
+    [ 0 0 ] 2dip STRr64-encode ;
 
-: ASRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi32-encode >out ;
-: ASRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi64-encode >out ;
-: LSLi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi32-encode >out ;
-: LSLi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi64-encode >out ;
-: LSRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi32-encode >out ;
-: LSRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi64-encode >out ;
+: ASRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi32-encode ;
+: ASRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi64-encode ;
+: LSLi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi32-encode ;
+: LSLi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi64-encode ;
+: LSRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi32-encode ;
+: LSRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi64-encode ;
 
-: SVC ( imm16 -- ) 16 ?bits SVC-encode >out ;
+: SVC ( imm16 -- ) 16 ?bits SVC-encode ;
 
 : with-output-variable ( value variable quot -- value )
     over [ get ] curry compose with-variable ; inline
 
-: with-new-arm64-offset ( offset quot -- arm64-assembler )
-    [ <arm64-assembler> \ arm64-assembler ] dip with-output-variable ; inline
-
-: with-new-arm64 ( quot -- arm64-assembler )
-    [ 0 <arm64-assembler> \ arm64-assembler ] dip with-output-variable ; inline
-
-: assemble-arm ( quot -- bytes )
-    call ; inline
-
-: offset-test-arm64 ( offset quot -- instuctions )
-    with-new-arm64-offset out>> ; inline
-
-: offset-test-arm64-instruction ( offset quot -- instuction )
-    offset-test-arm64 first ; inline
-
-: test-arm64 ( quot -- instructions )
-    0 swap offset-test-arm64 ; inline
-
-: test-arm64-instruction ( quot -- instructions )
-    0 swap offset-test-arm64-instruction ; inline
-
-
-: ADC32 ( Rm Rn Rd -- ) ADC32-encode >out ;
-: ADCS32 ( Rm Rn Rd -- ) ADCS32-encode >out ;
-: ADC64 ( Rm Rn Rd -- ) ADC64-encode >out ;
-: ADCS64 ( Rm Rn Rd -- ) ADCS64-encode >out ;
+: ADC32 ( Rm Rn Rd -- ) ADC32-encode ;
+: ADCS32 ( Rm Rn Rd -- ) ADCS32-encode ;
+: ADC64 ( Rm Rn Rd -- ) ADC64-encode ;
+: ADCS64 ( Rm Rn Rd -- ) ADCS64-encode ;
 
-: BRK ( imm16 -- ) 16 ?bits BRK-encode >out ;
-: HLT ( imm16 -- ) 16 ?bits HLT-encode >out ;
+: BRK ( imm16 -- ) 16 ?bits BRK-encode ;
+: HLT ( imm16 -- ) 16 ?bits HLT-encode ;
 
-: CBNZ ( imm19 Rt -- ) [ 19 ?bits ] dip CBNZ64-encode >out ;
+: CBNZ ( imm19 Rt -- ) [ 19 ?bits ] dip CBNZ64-encode ;
 ! cond4 is EQ NE CS HS CC LO MI PL VS VC HI LS GE LT GT LE AL NV
-: CSEL ( Rm Rn Rd cond4 -- ) -rot CSEL64-encode >out ;
-: CSET ( Rd cond4 -- ) swap CSET64-encode >out ;
-: CSETM ( Rd cond4 -- ) swap CSETM64-encode >out ;
+: CSEL ( Rm Rn Rd cond4 -- ) -rot CSEL64-encode ;
+: CSET ( Rd cond4 -- ) swap CSET64-encode ;
+: CSETM ( Rd cond4 -- ) swap CSETM64-encode ;
 
 ! B but that is breakpoint
-: Br ( imm26 -- ) 26 ?bits B-encode >out ;
-: B.cond ( imm19 cond4 -- ) [ 19 ?bits ] dip B.cond-encode >out ;
-! : BL ( offset -- ) ip - 4 / BL-encode >out ;
-: BL ( offset -- ) BL-encode >out ;
-: BR ( Rn -- ) BR-encode >out ;
-: BLR ( Rn -- ) BLR-encode >out ;
+: Br ( imm26 -- ) 26 ?bits B-encode ;
+: B.cond ( imm19 cond4 -- ) [ 19 ?bits ] dip B.cond-encode ;
+! : BL ( offset -- ) ip - 4 / BL-encode ;
+: BL ( offset -- ) BL-encode ;
+: BR ( Rn -- ) BR-encode ;
+: BLR ( Rn -- ) BLR-encode ;