basis/cpu/ppc/assembler/backend/backend.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: compiler.generator.fixup kernel namespaces sequences
   4 words math math.bitwise io.binary parser lexer ;
   5 IN: cpu.ppc.assembler.backend
   6
   7 : insn ( operand opcode -- ) { 26 0 } bitfield , ;
   8
   9 : a-insn ( d a b c xo rc opcode -- )
  10     [ { 0 1 6 11 16 21 } bitfield ] dip insn ;
  11
  12 : b-insn ( bo bi bd aa lk opcode -- )
  13     [ { 0 1 2 16 21 } bitfield ] dip insn ;
  14
  15 : s>u16 ( s -- u ) HEX: ffff bitand ;
  16
  17 : d-insn ( d a simm opcode -- )
  18     [ s>u16 { 0 16 21 } bitfield ] dip insn ;
  19
  20 : define-d-insn ( word opcode -- )
  21     [ d-insn ] curry (( d a simm -- )) define-declared ;
  22
  23 : D: CREATE scan-word define-d-insn ; parsing
  24
  25 : sd-insn ( d a simm opcode -- )
  26     [ s>u16 { 0 21 16 } bitfield ] dip insn ;
  27
  28 : define-sd-insn ( word opcode -- )
  29     [ sd-insn ] curry (( d a simm -- )) define-declared ;
  30
  31 : SD: CREATE scan-word define-sd-insn ; parsing
  32
  33 : i-insn ( li aa lk opcode -- )
  34     [ { 0 1 0 } bitfield ] dip insn ;
  35
  36 : x-insn ( a s b rc xo opcode -- )
  37     [ { 1 0 11 21 16 } bitfield ] dip insn ;
  38
  39 : (X) ( -- word quot )
  40     CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
  41
  42 : X: (X) (( a s b -- )) define-declared ; parsing
  43
  44 : (1) ( quot -- quot' ) [ 0 ] prepose ;
  45
  46 : X1: (X) (1) (( a s -- )) define-declared ; parsing
  47
  48 : xfx-insn ( d spr xo opcode -- )
  49     [ { 1 11 21 } bitfield ] dip insn ;
  50
  51 : CREATE-MF ( -- word ) scan "MF" prepend create-in ;
  52
  53 : MFSPR:
  54     CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry
  55     (( d -- )) define-declared ; parsing
  56
  57 : CREATE-MT ( -- word ) scan "MT" prepend create-in ;
  58
  59 : MTSPR:
  60     CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry
  61     (( d -- )) define-declared ; parsing
  62
  63 : xo-insn ( d a b oe rc xo opcode -- )
  64     [ { 1 0 10 11 16 21 } bitfield ] dip insn ;
  65
  66 : (XO) ( -- word quot )
  67     CREATE scan-word scan-word scan-word scan-word
  68     [ xo-insn ] 2curry 2curry ;
  69
  70 : XO: (XO) (( a s b -- )) define-declared ; parsing
  71
  72 : XO1: (XO) (1) (( a s -- )) define-declared ; parsing
  73
  74 GENERIC# (B) 2 ( dest aa lk -- )
  75 M: integer (B) 18 i-insn ;
  76 M: word (B) 0 -rot (B) rc-relative-ppc-3 rel-word ;
  77 M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
  78
  79 GENERIC: BC ( a b c -- )
  80 M: integer BC 0 0 16 b-insn ;
  81 M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ;
  82 M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ;
  83
  84 : CREATE-B ( -- word ) scan "B" prepend create-in ;
  85
  86 : BC:
  87     CREATE-B scan-word scan-word
  88     [ rot BC ] 2curry (( c -- )) define-declared ; parsing
  89
  90 : B:
  91     CREATE-B scan-word scan-word scan-word scan-word scan-word
  92     [ b-insn ] curry curry curry curry curry
  93     (( bo -- )) define-declared ; parsing