basis/cpu/arm/assembler/assembler.factor

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