! 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
! 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
: 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 ;
-
-: 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 ;
-
-: SVC ( imm16 -- ) 16 ?bits SVC-encode >out ;
-
-: with-new-arm64-offset ( offset quot -- arm64-assembler )
- [ <arm64-assembler> \ arm64-assembler ] dip
- '[ @ \ arm64-assembler get ] with-variable ; inline
-
-: with-new-arm64 ( quot -- arm64-assembler )
- [ 0 <arm64-assembler> \ arm64-assembler ] dip
- '[ @ \ arm64-assembler get ] with-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
+ [ 0 0 ] 2dip STRr64-encode ;
-: test-arm64 ( quot -- instructions )
- 0 swap offset-test-arm64 ; inline
+: 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 ;
-: test-arm64-instruction ( quot -- instructions )
- 0 swap offset-test-arm64-instruction ; inline
+: SVC ( imm16 -- ) 16 ?bits SVC-encode ;
-: 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 ;