basis/cpu/x86/64/64.factor

   1 ! Copyright (C) 2005, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays kernel math namespaces make sequences
   4 system layouts alien alien.c-types alien.accessors alien.libraries
   5 slots splitting assocs combinators fry locals compiler.constants
   6 classes.struct compiler.codegen compiler.codegen.fixup
   7 compiler.cfg.instructions compiler.cfg.builder
   8 compiler.cfg.intrinsics compiler.cfg.stack-frame
   9 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
  10 cpu.architecture vm ;
  11 FROM: layouts => cell cells ;
  12 IN: cpu.x86.64
  13
  14 : param-reg ( n -- reg ) int-regs cdecl param-regs at nth ;
  15
  16 : param-reg-0 ( -- reg ) 0 param-reg ; inline
  17 : param-reg-1 ( -- reg ) 1 param-reg ; inline
  18 : param-reg-2 ( -- reg ) 2 param-reg ; inline
  19 : param-reg-3 ( -- reg ) 3 param-reg ; inline
  20
  21 M: x86.64 pic-tail-reg RBX ;
  22
  23 M: x86.64 return-regs
  24     {
  25         { int-regs { RAX EDX } }
  26         { float-regs { XMM0 XMM1 } }
  27     } ;
  28
  29 M: x86.64 ds-reg R14 ;
  30 M: x86.64 rs-reg R15 ;
  31 M: x86.64 stack-reg RSP ;
  32 M: x86.64 frame-reg RBP ;
  33
  34 M: x86.64 extra-stack-space drop 0 ;
  35
  36 M: x86.64 machine-registers
  37     {
  38         { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 } }
  39         { float-regs {
  40             XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
  41             XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
  42         } }
  43     } ;
  44
  45 : vm-reg ( -- reg ) R13 ; inline
  46 : nv-reg ( -- reg ) RBX ; inline
  47
  48 M: x86.64 %mov-vm-ptr ( reg -- )
  49     vm-reg MOV ;
  50
  51 M: x86.64 %vm-field ( dst offset -- )
  52     [ vm-reg ] dip [+] MOV ;
  53
  54 M:: x86.64 %load-vector ( dst val rep -- )
  55     dst 0 [RIP+] rep copy-memory* val rc-relative rel-binary-literal ;
  56
  57 M: x86.64 %set-vm-field ( src offset -- )
  58     [ vm-reg ] dip [+] swap MOV ;
  59
  60 M: x86.64 %vm-field-ptr ( dst offset -- )
  61     [ vm-reg ] dip [+] LEA ;
  62
  63 ! Must be a volatile register not used for parameter passing or
  64 ! integer return
  65 HOOK: temp-reg cpu ( -- reg )
  66
  67 M: x86.64 %prologue ( n -- )
  68     temp-reg -7 [RIP+] LEA
  69     dup PUSH
  70     temp-reg PUSH
  71     stack-reg swap 3 cells - SUB ;
  72
  73 M: x86.64 %prepare-jump
  74     pic-tail-reg xt-tail-pic-offset [RIP+] LEA ;
  75
  76 : load-cards-offset ( dst -- )
  77     0 MOV rc-absolute-cell rel-cards-offset ;
  78
  79 M: x86.64 %mark-card
  80     dup load-cards-offset
  81     [+] card-mark <byte> MOV ;
  82
  83 : load-decks-offset ( dst -- )
  84     0 MOV rc-absolute-cell rel-decks-offset ;
  85
  86 M: x86.64 %mark-deck
  87     dup load-decks-offset
  88     [+] card-mark <byte> MOV ;
  89
  90 M:: x86.64 %dispatch ( src temp -- )
  91     ! Load jump table base.
  92     temp HEX: ffffffff MOV
  93     building get length :> start
  94     0 rc-absolute-cell rel-here
  95     ! Add jump table base
  96     temp src ADD
  97     temp HEX: 7f [+] JMP
  98     building get length :> end
  99     ! Fix up the displacement above
 100     cell alignment
 101     [ end start - + building get dup pop* push ]
 102     [ (align-code) ]
 103     bi ;
 104
 105 M:: x86.64 %load-reg-param ( dst reg rep -- )
 106     dst reg rep %copy ;
 107
 108 M:: x86.64 %store-reg-param ( src reg rep -- )
 109     reg src rep %copy ;
 110
 111 M:: x86.64 %unbox ( dst src func rep -- )
 112     param-reg-0 src tagged-rep %copy
 113     param-reg-1 %mov-vm-ptr
 114     func f %alien-invoke
 115     dst rep %load-return ;
 116
 117 M:: x86.64 %box ( dst src func rep -- )
 118     0 rep reg-class-of cdecl param-regs at nth src rep %copy
 119     rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
 120     func f %alien-invoke
 121     dst int-rep %load-return ;
 122
 123 M:: x86.64 %allot-byte-array ( dst size -- )
 124     param-reg-0 size MOV
 125     param-reg-1 %mov-vm-ptr
 126     "allot_byte_array" f %alien-invoke
 127     dst int-rep %load-return ;
 128
 129 M: x86.64 %alien-invoke
 130     R11 0 MOV
 131     rc-absolute-cell rel-dlsym
 132     R11 CALL ;
 133
 134 M: x86.64 %begin-callback ( -- )
 135     param-reg-0 %mov-vm-ptr
 136     param-reg-1 0 MOV
 137     "begin_callback" f %alien-invoke ;
 138
 139 M: x86.64 %alien-callback ( quot -- )
 140     [ param-reg-0 ] dip %load-reference
 141     param-reg-0 quot-entry-point-offset [+] CALL ;
 142
 143 M: x86.64 %end-callback ( -- )
 144     param-reg-0 %mov-vm-ptr
 145     "end_callback" f %alien-invoke ;
 146
 147 : float-function-param ( i src -- )
 148     [ float-regs cdecl param-regs at nth ] dip double-rep %copy ;
 149
 150 M:: x86.64 %unary-float-function ( dst src func -- )
 151     0 src float-function-param
 152     func "libm" load-library %alien-invoke
 153     dst double-rep %load-return ;
 154
 155 M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
 156     ! src1 might equal dst; otherwise it will be a spill slot
 157     ! src2 is always a spill slot
 158     0 src1 float-function-param
 159     1 src2 float-function-param
 160     func "libm" load-library %alien-invoke
 161     dst double-rep %load-return ;
 162
 163 M:: x86.64 %call-gc ( gc-roots -- )
 164     param-reg-0 gc-roots gc-root-offsets %load-reference
 165     param-reg-1 %mov-vm-ptr
 166     "inline_gc" f %alien-invoke ;
 167
 168 M: x86.64 long-long-on-stack? f ;
 169
 170 M: x86.64 float-on-stack? f ;
 171
 172 M: x86.64 struct-return-on-stack? f ;
 173
 174 ! The result of reading 4 bytes from memory is a fixnum on
 175 ! x86-64.
 176 enable-alien-4-intrinsics
 177
 178 USE: vocabs.loader
 179
 180 {
 181     { [ os unix? ] [ "cpu.x86.64.unix" require ] }
 182     { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }
 183 } cond