1 ! Copyright (C) 2020 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators cpu.arm.assembler.opcodes io.binary
4 kernel math math.bitwise namespaces sequences ;
7 ! pre-index mode: computed addres is the base-register + offset
9 ! post-index mode: computed address is the base-register
11 ! in both modes, the base-register is updated
13 TUPLE: arm64-assembler ip labels out ;
14 : <arm64-assembler> ( ip -- arm-assembler )
20 : ip ( -- address ) arm64-assembler get ip>> ;
21 : >out ( instruction -- ) arm64-assembler get out>> push ;
24 [ [ 2 bits ] [ 19 bits ] bi ] dip ADR-encode >out ;
26 : ADRP ( imm21 Rd -- )
27 [ [ 2 bits ] [ 19 bits ] bi ] dip ADRP-encode >out ;
29 : BL ( offset -- ) ip - 4 / BL-encode >out ;
30 : BR ( register -- ) BR-encode >out ;
32 : LDR-pre ( imm9 Rn Rt -- ) LDRpre64-encode >out ;
33 : LDR-post ( imm9 Rn Rt -- ) LDRpost64-encode >out ;
34 : LDR-uoff ( imm12 Rn Rt -- ) [ 8 / ] 2dip LDRuoff64-encode >out ;
36 : MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode >out ;
37 : MOVr64 ( Rn Rd -- ) MOVr64-encode >out ;
39 : RET ( register/f -- ) X30 or RET-encode >out ;
41 ! stp x29, x30, [sp,#-16]!
42 ! -16 SP X30 X29 STP-pre
43 : STP-pre ( offset register-offset register-mid register -- )
44 [ 8 / 7 bits ] 3dip swapd STPpre64-encode >out ;
46 : STP-post ( offset register-offset register-mid register -- )
47 [ 8 / 7 bits ] 3dip swapd STPpost64-encode >out ;
49 : STP-signed-offset ( offset register-offset register-mid register -- )
50 [ 8 / 7 bits ] 3dip swapd STPsoff64-encode >out ;
52 ! Some instructions allow an immediate literal of n bits
53 ! or n bits shifted. This means there are invalid immediate
54 ! values, e.g. imm12 of 1, 4096, but not 4097
55 ERROR: imm-out-of-range imm n ;
56 : imm-lower? ( imm n -- ? )
57 on-bits unmask 0 > not ;
59 : imm-upper? ( imm n -- ? )
60 [ on-bits ] [ shift ] bi unmask 0 > not ;
62 : prepare-split-imm ( imm n -- imm upper? )
64 { [ 2dup imm-lower? ] [ drop f ] }
65 { [ 2dup imm-upper? ] [ drop t ] }
69 : ADDi32 ( imm12 Rn Rd -- )
70 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
73 : ADDi64 ( imm12 Rn Rd -- )
74 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
77 : SUBi32 ( imm12 Rn Rd -- )
78 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
81 : SUBi64 ( imm12 Rn Rd -- )
82 [ 12 prepare-split-imm 1 0 ? swap ] 2dip
85 : CMPi32 ( imm12 Rd -- )
86 [ 12 prepare-split-imm 1 0 ? swap ] dip
89 : CMPi64 ( imm12 Rd -- )
90 [ 12 prepare-split-imm 1 0 ? swap ] dip
93 : STRuoff32 ( imm12 Rn Rt -- )
94 [ -2 shift ] 2dip STRuoff32-encode >out ;
96 : STRuoff64 ( imm12 Rn Rt -- )
97 [ -3 shift ] 2dip STRuoff64-encode >out ;
99 : STRr64 ( Rm Rn Rt -- )
100 [ 0 0 ] 2dip STRr64-encode >out ;
102 : ASRi32 ( imm6 Rn Rd -- ) ASRi32-encode >out ;
103 : ASRi64 ( imm6 Rn Rd -- ) ASRi64-encode >out ;
104 : LSLi32 ( imm6 Rn Rd -- ) LSLi32-encode >out ;
105 : LSLi64 ( imm6 Rn Rd -- ) LSLi64-encode >out ;
106 : LSRi32 ( imm6 Rn Rd -- ) LSRi32-encode >out ;
107 : LSRi64 ( imm6 Rn Rd -- ) LSRi64-encode >out ;
109 : SVC ( imm16 -- ) SVC-encode >out ;
111 : with-output-variable ( value variable quot -- value )
112 over [ get ] curry compose with-variable ; inline
114 : with-new-arm64-offset ( offset quot -- arm64-assembler )
115 [ <arm64-assembler> \ arm64-assembler ] dip with-output-variable ; inline
117 : with-new-arm64 ( quot -- arm64-assembler )
118 [ 0 <arm64-assembler> \ arm64-assembler ] dip with-output-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