basis/cpu/arm/assembler/assembler.factor

   1 ! Copyright (C) 2020 Doug Coleman.
   2 ! Copyright (C) 2023 Giftpflanze.
   3 ! See https://factorcode.org/license.txt for BSD license.
   4 USING: combinators cpu.arm.assembler.opcodes grouping kernel
   5 math math.bitwise math.parser 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 ERROR: arm64-encoding-imm original n-bits-requested truncated ;
  15 : ?ubits ( x n -- x )
  16     2dup bits dup reach =
  17     [ 2drop ] [ arm64-encoding-imm ] if ; inline
  18
  19 : ?sbits ( x n -- x )
  20     2dup >signed dup reach =
  21     [ drop bits ] [ arm64-encoding-imm ] if ; inline
  22
  23 ERROR: scaling-error original n-bits-shifted rest ;
  24 : ?>> ( x n -- x )
  25     2dup bits [ neg shift ] [ scaling-error ] if-zero ;
  26
  27 ! Some instructions allow an immediate literal of n bits
  28 ! or n bits shifted. This means there are invalid immediate
  29 ! values, e.g. imm12 of 1, 4096, but not 4097
  30 ERROR: imm-out-of-range imm n ;
  31 : imm-lower? ( imm n -- ? ) on-bits unmask 0 > not ;
  32
  33 : imm-upper? ( imm n -- ? )
  34     [ on-bits ] [ shift ] bi unmask 0 > not ;
  35
  36 : (split-imm) ( imm n -- imm upper? )
  37     {
  38         { [ 2dup imm-lower? ] [ drop f ] }
  39         { [ 2dup imm-upper? ] [ drop t ] }
  40         [ imm-out-of-range ]
  41     } cond ;
  42
  43 : split-imm ( imm -- shift imm ) 12 (split-imm) 1 0 ? swap ;
  44
  45 ERROR: illegal-bitmask-immediate n ;
  46 : ?bitmask ( imm imm-size -- imm )
  47     dupd on-bits 0 [ = ] bi-curry@ bi or
  48     [ dup illegal-bitmask-immediate ] when ;
  49
  50 : element-size ( imm imm-size -- imm element-size )
  51     [ 2dup 2/ [ neg shift ] 2keep '[ _ on-bits bitand ] same? ]
  52     [ 2/ ] while ;
  53
  54 : bit-transitions ( imm element-size -- seq )
  55     [ >bin ] dip CHAR: 0 pad-head 2 circular-clump ;
  56
  57 ERROR: illegal-bitmask-element n ;
  58 : ?element ( imm element-size -- element )
  59     [ bits ] keep dupd bit-transitions
  60     [ first2 = not ] count 2 =
  61     [ dup illegal-bitmask-element ] unless ;
  62
  63 : >Nimms ( element element-size -- N imms )
  64     [ bit-count 1 - ] [ log2 1 + ] bi*
  65     7 [ on-bits ] bi@ bitxor bitor
  66     6 toggle-bit [ -6 shift ] [ 6 bits ] bi ;
  67
  68 : >immr ( element element-size -- immr )
  69     [ bit-transitions "10" swap index 1 + ] keep mod ;
  70
  71 : (encode-bitmask) ( imm imm-size -- (N)immrimms )
  72     [ bits ] [ ?bitmask ] [ element-size ] tri
  73     [ ?element ] keep [ >Nimms ] [ >immr ] 2bi
  74     { 12 0 6 } bitfield* ;
  75
  76 : ADR ( simm21 Rd -- ) [ [ 2 bits ] [ -2 shift 19 ?sbits ] bi ] dip ADR-encode ;
  77
  78 : ADRP ( simm21 Rd -- ) [ 4096 / [ 2 bits ] [ -2 shift 19 ?sbits ] bi ] dip ADRP-encode ;
  79
  80 : RET ( Rn/f -- ) X30 or RET-encode ;
  81
  82 : SVC ( uimm16 -- ) 16 ?ubits SVC-encode ;
  83
  84 : BRK ( uimm16 -- ) 16 ?ubits BRK-encode ;
  85 : HLT ( uimm16 -- ) 16 ?ubits HLT-encode ;
  86
  87 ! B but that is breakpoint
  88 : Br ( simm28 -- ) 2 ?>> 26 ?sbits B-encode ;
  89 : B.cond ( simm21 cond -- ) [ 2 ?>> 19 ?sbits ] dip B.cond-encode ;
  90 : BL ( simm28 -- ) 2 ?>> 26 ?sbits BL-encode ;
  91 : BR ( Rn -- ) BR-encode ;
  92 : BLR ( Rn -- ) BLR-encode ;