core/cpu/x86/64/64.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types arrays cpu.x86.assembler
   4 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
   5 cpu.x86.allot cpu.architecture kernel kernel.private math
   6 namespaces sequences generator.registers generator.fixup system
   7 alien ;
   8 IN: cpu.x86.64
   9
  10 PREDICATE: x86-backend amd64-backend
  11     x86-backend-cell 8 = ;
  12
  13 M: amd64-backend ds-reg R14 ;
  14 M: amd64-backend rs-reg R15 ;
  15 M: amd64-backend stack-reg RSP ;
  16
  17 M: temp-reg v>operand drop R11 ;
  18
  19 M: int-regs return-reg drop RAX ;
  20 M: int-regs vregs drop { RAX RCX RDX RSI RDI RBP R8 R9 R10 } ;
  21 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
  22
  23 M: float-regs return-reg drop XMM0 ;
  24
  25 M: float-regs vregs
  26     drop {
  27         XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
  28         XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
  29     } ;
  30
  31 M: float-regs param-regs
  32     drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
  33
  34 M: amd64-backend address-operand ( address -- operand )
  35     #! On AMD64, we have to load 64-bit addresses into a
  36     #! scratch register first. The usage of R11 here is a hack.
  37     #! This word can only be called right before a subroutine
  38     #! call, where all vregs have been flushed anyway.
  39     temp-reg v>operand [ swap MOV ] keep ;
  40
  41 : compile-c-call ( symbol dll -- )
  42     0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
  43
  44 M: amd64-backend fixnum>slot@ drop ;
  45
  46 M: amd64-backend prepare-division CQO ;
  47
  48 M: amd64-backend load-indirect ( literal reg -- )
  49     0 [] MOV rc-relative rel-literal ;
  50
  51 M: stack-params %load-param-reg
  52     drop
  53     >r temp-reg v>operand swap stack@ MOV
  54     r> stack@ temp-reg v>operand MOV ;
  55
  56 M: stack-params %save-param-reg
  57     >r stack-frame* + cell + swap r> %load-param-reg ;
  58
  59 M: amd64-backend %prepare-unbox ( -- )
  60     ! First parameter is top of stack
  61     RDI R14 [] MOV
  62     R14 cell SUB ;
  63
  64 M: amd64-backend %unbox ( n reg-class func -- )
  65     ! Call the unboxer
  66     f compile-c-call
  67     ! Store the return value on the C stack
  68     over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
  69
  70 M: amd64-backend %unbox-long-long ( n func -- )
  71     T{ int-regs } swap %unbox ;
  72
  73 M: amd64-backend %unbox-struct-1 ( -- )
  74     #! Alien must be in RDI.
  75     "alien_offset" f compile-c-call
  76     ! Load first cell
  77     RAX RAX [] MOV ;
  78
  79 M: amd64-backend %unbox-struct-2 ( -- )
  80     #! Alien must be in RDI.
  81     "alien_offset" f compile-c-call
  82     ! Load second cell
  83     RDX RAX cell [+] MOV
  84     ! Load first cell
  85     RAX RAX [] MOV ;
  86
  87 M: amd64-backend %unbox-large-struct ( n size -- )
  88     ! Source is in RDI
  89     ! Load destination address
  90     RSI RSP roll [+] LEA
  91     ! Load structure size
  92     RDX swap MOV
  93     ! Copy the struct to the C stack
  94     "to_value_struct" f compile-c-call ;
  95
  96 : load-return-value ( reg-class -- )
  97     0 over param-reg swap return-reg
  98     2dup eq? [ 2drop ] [ MOV ] if ;
  99
 100 M: amd64-backend %box ( n reg-class func -- )
 101     rot [
 102         rot [ 0 swap param-reg ] keep %load-param-reg
 103     ] [
 104         swap load-return-value
 105     ] if*
 106     f compile-c-call ;
 107
 108 M: amd64-backend %box-long-long ( n func -- )
 109     T{ int-regs } swap %box ;
 110
 111 M: amd64-backend struct-small-enough? ( size -- ? ) 2 cells <= ;
 112
 113 M: amd64-backend %box-small-struct ( size -- )
 114     #! Box a <= 16-byte struct returned in RAX:RDX.
 115     RDI RAX MOV
 116     RSI RDX MOV
 117     RDX swap MOV
 118     "box_small_struct" f compile-c-call ;
 119
 120 M: amd64-backend %box-large-struct ( n size -- )
 121     ! Struct size is parameter 2
 122     RSI over MOV
 123     ! Compute destination address
 124     swap struct-return@ RDI RSP rot [+] LEA
 125     ! Copy the struct from the C stack
 126     "box_value_struct" f compile-c-call ;
 127
 128 M: amd64-backend %prepare-box-struct ( size -- )
 129     ! Compute target address for value struct return
 130     RAX RSP rot f struct-return@ [+] LEA
 131     RSP 0 [+] RAX MOV ;
 132
 133 : reset-sse RAX RAX XOR ;
 134
 135 M: amd64-backend %alien-invoke ( symbol dll -- )
 136     reset-sse compile-c-call ;
 137
 138 M: amd64-backend %prepare-alien-indirect ( -- )
 139     "unbox_alien" f compile-c-call
 140     cell temp@ RAX MOV ;
 141
 142 M: amd64-backend %alien-indirect ( -- )
 143     reset-sse
 144     cell temp@ CALL ;
 145
 146 M: amd64-backend %alien-callback ( quot -- )
 147     RDI load-indirect "run_callback" f compile-c-call ;
 148
 149 M: amd64-backend %callback-value ( ctype -- )
 150     ! Save top of data stack
 151     %prepare-unbox
 152     ! Put former top of data stack in RDI
 153     temp@ RDI MOV
 154     ! Restore data/call/retain stacks
 155     "unnest_stacks" f %alien-invoke
 156     ! Put former top of data stack in RDI
 157     RDI temp@ MOV
 158     ! Unbox former top of data stack to return registers
 159     unbox-return ;
 160
 161 M: amd64-backend %cleanup ( alien-node -- ) drop ;
 162
 163 M: amd64-backend %unwind ( n -- ) drop %epilogue-later 0 RET ;
 164
 165 USE: cpu.x86.intrinsics
 166
 167 ! On 64-bit systems, the result of reading 4 bytes from memory
 168 ! is a fixnum.
 169 \ alien-unsigned-4 small-reg-32 define-unsigned-getter
 170 \ set-alien-unsigned-4 small-reg-32 define-setter
 171
 172 \ alien-signed-4 small-reg-32 define-signed-getter
 173 \ set-alien-signed-4 small-reg-32 define-setter
 174
 175 T{ x86-backend f 8 } compiler-backend set-global