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 combinators.extras
   4 cpu.arm.assembler.opcodes io.binary kernel math
   5 math.bitwise namespaces sequences ;
   6 IN: cpu.arm.assembler
   7
   8 ! pre-index mode: computed addres is the base-register + offset
   9 ! ldr X1, [X2, #4]!
  10 ! post-index mode: computed address is the base-register
  11 ! ldr X1, [X2], #4
  12 ! in both modes, the base-register is updated
  13
  14 TUPLE: arm64-assembler ip labels out ;
  15 : <arm64-assembler> ( ip -- arm-assembler )
  16     arm64-assembler new
  17         swap >>ip
  18         H{ } clone >>labels
  19         V{ } clone >>out ;
  20
  21 : ip ( -- address ) arm64-assembler get ip>> ;
  22 : >out ( instruction -- ) arm64-assembler get out>> push ;
  23
  24 : ADR ( imm21 Rd -- )
  25     [ [ 2 bits ] [ -2 shift 19 bits ] bi ] dip ADR-encode >out ;
  26
  27 : ADRP ( imm21 Rd -- )
  28     [ [ 2 bits ] [ -2 shift 19 bits ] bi ] dip ADRP-encode >out ;
  29
  30 : BL ( offset -- ) ip - 4 / BL-encode >out ;
  31 : BR ( register -- ) BR-encode >out ;
  32
  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 ;
  36
  37 : MOVwi64 ( imm Rt -- ) [ 0 ] 2dip MOVwi64-encode >out ;
  38 : MOVr64 ( Rn Rd -- ) MOVr64-encode >out ;
  39
  40 : RET ( register/f -- ) X30 or RET-encode >out ;
  41
  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 ;
  46
  47 : STP-post ( offset register-offset register-mid register -- )
  48     [ 8 / 7 bits ] 3dip swapd STPpost64-encode >out ;
  49
  50 : STP-signed-offset ( offset register-offset register-mid register -- )
  51     [ 8 / 7 bits ] 3dip swapd STPsoff64-encode >out ;
  52
  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 ;
  59
  60  : imm-upper? ( imm n -- ? )
  61     [ on-bits ] [ shift ] bi unmask 0 > not ;
  62
  63 : prepare-split-imm ( imm n -- imm upper? )
  64     {
  65         { [ 2dup imm-lower? ] [ drop f ] }
  66         { [ 2dup imm-upper? ] [ drop t ] }
  67         [ imm-out-of-range ]
  68     } cond ;
  69
  70 : ADDi32 ( imm12 Rn Rd -- )
  71     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  72     ADDi32-encode >out ;
  73
  74 : ADDi64 ( imm12 Rn Rd -- )
  75     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  76     ADDi64-encode >out ;
  77
  78 : SUBi32 ( imm12 Rn Rd -- )
  79     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  80     SUBi32-encode >out ;
  81
  82 : SUBi64 ( imm12 Rn Rd -- )
  83     [ 12 prepare-split-imm 1 0 ? swap ] 2dip
  84     SUBi64-encode >out ;
  85
  86 : CMPi32 ( imm12 Rd -- )
  87     [ 12 prepare-split-imm 1 0 ? swap ] dip
  88     CMPi32-encode >out ;
  89
  90 : CMPi64 ( imm12 Rd -- )
  91     [ 12 prepare-split-imm 1 0 ? swap ] dip
  92     CMPi64-encode >out ;
  93
  94 : STRuoff32 ( imm12 Rn Rt -- )
  95     [ -2 shift ] 2dip STRuoff32-encode >out ;
  96
  97 : STRuoff64 ( imm12 Rn Rt -- )
  98     [ -3 shift ] 2dip STRuoff64-encode >out ;
  99
 100 : STRr64 ( Rm Rn Rt -- )
 101     [ 0 0 ] 2dip STRr64-encode >out ;
 102
 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 ;
 109
 110 : SVC ( imm16 -- ) SVC-encode >out ;
 111
 112 : with-new-arm64-offset ( offset quot -- arm64-assembler )
 113     [ <arm64-assembler> \ arm64-assembler ] dip
 114     '[ @ \ arm64-assembler get ] with-variable ; inline
 115
 116 : with-new-arm64 ( quot -- arm64-assembler )
 117     [ 0 <arm64-assembler> \ arm64-assembler ] dip
 118     '[ @ \ arm64-assembler get ] with-variable ; inline
 119
 120 : assemble-arm ( quot -- bytes )
 121     with-new-arm64 out>> [ 4 >le ] map concat ; 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 : ADC32 ( Rm Rn Rd -- ) ADC32-encode >out ;
 136 : ADCS32 ( Rm Rn Rd -- ) ADCS32-encode >out ;
 137 : ADC64 ( Rm Rn Rd -- ) ADC64-encode >out ;
 138 : ADCS64 ( Rm Rn Rd -- ) ADCS64-encode >out ;
 139
 140 : BRK ( imm16 -- ) BRK-encode >out ;