1 ! Copyright (C) 2020 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators combinators.extras
4 cpu.arm.assembler.opcodes io.binary kernel math
5 math.bitwise namespaces sequences ;
8 ! pre-index mode: computed addres is the base-register + offset
10 ! post-index mode: computed address is the base-register
12 ! in both modes, the base-register is updated
14 TUPLE: arm64-assembler ip labels out ;
15 : <arm64-assembler> ( ip -- arm-assembler )
21 : ip ( -- address ) arm64-assembler get ip>> ;
22 : >out ( instruction -- ) arm64-assembler get out>> push ;
26 ip 12 on-bits unmask - -12 shift
27 [ 2 bits ] [ -2 shift ] bi
28 ] dip ADRP-encode >out ;
30 : BL ( offset -- ) ip - 4 / BL-encode >out ;
31 : BR ( register -- ) BR-encode >out ;
33 : LDR-pre ( imm9 Rn Rt -- ) LDRpre64-encode >out ;
34 : LDR-post ( imm9 Rn Rt -- ) LDRpost64-encode >out ;
35 : LDR-uoff ( imm12 Rn Rt -- ) [ 8 / ] 2dip LDRuoff64-encode >out ;
37 : MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode >out ;
38 : MOVr64 ( Rn Rd -- ) MOVr64-encode >out ;
40 : RET ( register/f -- ) X30 or RET-encode >out ;
42 ! stp x29, x30, [sp,#-16]!
43 ! -16 SP X30 X29 STP-pre
44 : STP-pre ( offset register-offset register-mid register -- )
45 [ 8 / 7 bits ] 3dip swapd STPpre64-encode >out ;
47 : STP-post ( offset register-offset register-mid register -- )
48 [ 8 / 7 bits ] 3dip swapd STPpost64-encode >out ;
50 : STP-signed-offset ( offset register-offset register-mid register -- )
51 [ 8 / 7 bits ] 3dip swapd STPsoff64-encode >out ;
53 ! Some instructions allow an immediate literal of n bits
54 ! or n bits shifted. This means there are invalid immediate
55 ! values, e.g. imm12 of 1, 4096, but not 4097
56 ERROR: imm-out-of-range imm n ;
57 : imm-lower? ( imm n -- ? )
58 on-bits unmask 0 > not ;
60 : imm-upper? ( imm n -- ? )
61 [ on-bits ] [ shift ] bi unmask 0 > not ;
63 : prepare-split-imm ( imm n -- imm upper? )
65 { [ 2dup imm-lower? ] [ drop f ] }
66 { [ 2dup imm-upper? ] [ drop t ] }
70 : ADDi32 ( imm12 Rn Rd -- )
71 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
74 : ADDi64 ( imm12 Rn Rd -- )
75 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
78 : SUBi32 ( imm12 Rn Rd -- )
79 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
82 : SUBi64 ( imm12 Rn Rd -- )
83 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
86 : CMPi32 ( imm12 Rd -- )
87 [ 12 prepare-split-imm 1 0 ? swap ] dip
90 : CMPi64 ( imm12 Rd -- )
91 [ 12 prepare-split-imm 1 0 ? swap ] dip
94 : STRuoff32 ( imm12 Rn Rt -- )
95 [ -2 shift ] 2dip STRuoff32-encode >out ;
97 : STRuoff64 ( imm12 Rn Rt -- )
98 [ -3 shift ] 2dip STRuoff64-encode >out ;
100 : STRr64 ( Rm Rn Rt -- )
101 [ 0 0 ] 2dip STRr64-encode >out ;
103 : ASRi32 ( imm6 Rn Rd -- ) ASRi32-encode >out ;
104 : ASRi64 ( imm6 Rn Rd -- ) ASRi64-encode >out ;
105 : LSLi32 ( imm6 Rn Rd -- ) LSLi32-encode >out ;
106 : LSLi64 ( imm6 Rn Rd -- ) LSLi64-encode >out ;
107 : LSRi32 ( imm6 Rn Rd -- ) LSRi32-encode >out ;
108 : LSRi64 ( imm6 Rn Rd -- ) LSRi64-encode >out ;
110 : SVC ( imm16 -- ) SVC-encode >out ;
112 : with-new-arm64-offset ( offset quot -- arm64-assembler )
113 [ <arm64-assembler> \ arm64-assembler ] dip
114 '[ @ \ arm64-assembler get ] with-variable ; inline
116 : with-new-arm64 ( quot -- arm64-assembler )
117 [ 0 <arm64-assembler> \ arm64-assembler ] dip
118 '[ @ \ arm64-assembler get ] with-variable ; inline
120 : assemble-arm ( quot -- bytes )
121 with-new-arm64 out>> [ 4 >le ] map concat ; inline
123 : offset-test-arm64 ( offset quot -- instuctions )
124 with-new-arm64-offset out>> ; inline
126 : offset-test-arm64-instruction ( offset quot -- instuction )
127 offset-test-arm64 first ; inline
129 : test-arm64 ( quot -- instructions )
130 0 swap offset-test-arm64 ; inline
132 : test-arm64-instruction ( quot -- instructions )
133 0 swap offset-test-arm64-instruction ; inline