basis/cpu/arm/assembler/assembler.factor

   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 make math math.bitwise namespaces sequences ;
   5 IN: cpu.arm.assembler
   6
   7 ! pre-index mode: computed addres is the base-register + offset
   8 ! ldr X1, [X2, #4]!
   9 ! post-index mode: computed address is the base-register
  10 ! ldr X1, [X2], #4
  11 ! in both modes, the base-register is updated
  12
  13 TUPLE: arm64-assembler ip labels out ;
  14 : <arm64-assembler> ( ip -- arm-assembler )
  15     arm64-assembler new
  16         swap >>ip
  17         H{ } clone >>labels
  18         V{ } clone >>out ;
  19
  20 ERROR: arm64-encoding-imm original n-bits-requested truncated ;
  21 : ?bits ( x n -- x ) 2dup bits dup reach = [ 2drop ] [ arm64-encoding-imm ] if ; inline
  22
  23 ! : ip ( -- address ) arm64-assembler get ip>> ;
  24 : >out ( instruction -- ) 4 >le % ;
  25
  26 : ADR ( imm21 Rd -- )
  27     [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADR-encode >out ;
  28
  29 : ADRP ( imm21 Rd -- )
  30     [ [ 2 bits ] [ -2 shift 19 ?bits ] bi ] dip ADRP-encode >out ;
  31
  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 ;
  35
  36 : MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode >out ;
  37 : MOVr64 ( Rn Rd -- ) MOVr64-encode >out ;
  38
  39 : RET ( register/f -- ) X30 or RET-encode >out ;
  40
  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 ;
  45
  46 : STP-post ( offset register-offset register-mid register -- )
  47     [ 8 / 7 bits ] 3dip swapd STPpost64-encode >out ;
  48
  49 : STP-signed-offset ( offset register-offset register-mid register -- )
  50     [ 8 / 7 bits ] 3dip swapd STPsoff64-encode >out ;
  51
  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 ;
  58
  59  : imm-upper? ( imm n -- ? )
  60     [ on-bits ] [ shift ] bi unmask 0 > not ;
  61
  62 : prepare-split-imm ( imm n -- imm upper? )
  63     {
  64         { [ 2dup imm-lower? ] [ drop f ] }
  65         { [ 2dup imm-upper? ] [ drop t ] }
  66         [ imm-out-of-range ]
  67     } cond ;
  68
  69 : ADDi32 ( imm12 Rn Rd -- )
  70     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  71     ADDi32-encode >out ;
  72
  73 : ADDi64 ( imm12 Rn Rd -- )
  74     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  75     ADDi64-encode >out ;
  76
  77 : SUBi32 ( imm12 Rn Rd -- )
  78     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  79     SUBi32-encode >out ;
  80
  81 : SUBi64 ( imm12 Rn Rd -- )
  82     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  83     SUBi64-encode >out ;
  84
  85 : CMPi32 ( imm12 Rd -- )
  86     [ 12 prepare-split-imm 1 0 ? swap ] dip
  87     CMPi32-encode >out ;
  88
  89 : CMPi64 ( imm12 Rd -- )
  90     [ 12 prepare-split-imm 1 0 ? swap ] dip
  91     CMPi64-encode >out ;
  92
  93 : STRuoff32 ( imm12 Rn Rt -- )
  94     [ -2 shift ] 2dip STRuoff32-encode >out ;
  95
  96 : STRuoff64 ( imm12 Rn Rt -- )
  97     [ -3 shift ] 2dip STRuoff64-encode >out ;
  98
  99 : STRr64 ( Rm Rn Rt -- )
 100     [ 0 0 ] 2dip STRr64-encode >out ;
 101
 102 : ASRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi32-encode >out ;
 103 : ASRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip ASRi64-encode >out ;
 104 : LSLi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi32-encode >out ;
 105 : LSLi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSLi64-encode >out ;
 106 : LSRi32 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi32-encode >out ;
 107 : LSRi64 ( imm6 Rn Rd -- ) [ 6 ?bits ] 2dip LSRi64-encode >out ;
 108
 109 : SVC ( imm16 -- ) 16 ?bits SVC-encode >out ;
 110
 111 : with-output-variable ( value variable quot -- value )
 112     over [ get ] curry compose with-variable ; inline
 113
 114 : with-new-arm64-offset ( offset quot -- arm64-assembler )
 115     [ <arm64-assembler> \ arm64-assembler ] dip with-output-variable ; inline
 116
 117 : with-new-arm64 ( quot -- arm64-assembler )
 118     [ 0 <arm64-assembler> \ arm64-assembler ] dip with-output-variable ; inline
 119
 120 : assemble-arm ( quot -- bytes )
 121     call ; inline
 122
 123 : offset-test-arm64 ( offset quot -- instuctions )
 124     with-new-arm64-offset out>> ; inline
 125
 126 : offset-test-arm64-instruction ( offset quot -- instuction )
 127     offset-test-arm64 first ; inline
 128
 129 : test-arm64 ( quot -- instructions )
 130     0 swap offset-test-arm64 ; inline
 131
 132 : test-arm64-instruction ( quot -- instructions )
 133     0 swap offset-test-arm64-instruction ; inline
 134
 135
 136 : ADC32 ( Rm Rn Rd -- ) ADC32-encode >out ;
 137 : ADCS32 ( Rm Rn Rd -- ) ADCS32-encode >out ;
 138 : ADC64 ( Rm Rn Rd -- ) ADC64-encode >out ;
 139 : ADCS64 ( Rm Rn Rd -- ) ADCS64-encode >out ;
 140
 141 : BRK ( imm16 -- ) 16 ?bits BRK-encode >out ;
 142 : HLT ( imm16 -- ) 16 ?bits HLT-encode >out ;
 143
 144 : CBNZ ( imm19 Rt -- ) [ 19 ?bits ] dip CBNZ64-encode >out ;
 145 ! cond4 is EQ NE CS HS CC LO MI PL VS VC HI LS GE LT GT LE AL NV
 146 : CSEL ( Rm Rn Rd cond4 -- ) -rot CSEL64-encode >out ;
 147 : CSET ( Rd cond4 -- ) swap CSET64-encode >out ;
 148 : CSETM ( Rd cond4 -- ) swap CSETM64-encode >out ;
 149
 150 ! B but that is breakpoint
 151 : Br ( imm26 -- ) 26 ?bits B-encode >out ;
 152 : B.cond ( imm19 cond4 -- ) [ 19 ?bits ] dip B.cond-encode >out ;
 153 ! : BL ( offset -- ) ip - 4 / BL-encode >out ;
 154 : BL ( offset -- ) BL-encode >out ;
 155 : BR ( Rn -- ) BR-encode >out ;
 156 : BLR ( Rn -- ) BLR-encode >out ;