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 machine-registers
  35     {
  36         { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 } }
  37         { float-regs {
  38             XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
  39             XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
  40         } }
  41     } ;
  42
  43 : vm-reg ( -- reg ) R13 ; inline
  44 : nv-reg ( -- reg ) RBX ; inline
  45
  46 M: x86.64 %mov-vm-ptr ( reg -- )
  47     vm-reg MOV ;
  48
  49 M: x86.64 %vm-field ( dst offset -- )
  50     [ vm-reg ] dip [+] MOV ;
  51
  52 M:: x86.64 %load-vector ( dst val rep -- )
  53     dst 0 [RIP+] rep copy-memory* val rc-relative rel-binary-literal ;
  54
  55 M: x86.64 %set-vm-field ( src offset -- )
  56     [ vm-reg ] dip [+] swap MOV ;
  57
  58 M: x86.64 %vm-field-ptr ( dst offset -- )
  59     [ vm-reg ] dip [+] LEA ;
  60
  61 M: x86.64 %prologue ( n -- )
  62     R11 -7 [RIP+] LEA
  63     dup PUSH
  64     R11 PUSH
  65     stack-reg swap 3 cells - SUB ;
  66
  67 M: x86.64 %prepare-jump
  68     pic-tail-reg xt-tail-pic-offset [RIP+] LEA ;
  69
  70 : load-cards-offset ( dst -- )
  71     0 MOV rc-absolute-cell rel-cards-offset ;
  72
  73 M: x86.64 %mark-card
  74     dup load-cards-offset
  75     [+] card-mark <byte> MOV ;
  76
  77 : load-decks-offset ( dst -- )
  78     0 MOV rc-absolute-cell rel-decks-offset ;
  79
  80 M: x86.64 %mark-deck
  81     dup load-decks-offset
  82     [+] card-mark <byte> MOV ;
  83
  84 M:: x86.64 %load-stack-param ( vreg rep n -- )
  85     rep return-reg n next-stack@ rep %copy
  86     vreg rep return-reg rep %copy ;
  87
  88 M:: x86.64 %store-stack-param ( vreg rep n -- )
  89     rep return-reg vreg rep %copy
  90     n reserved-stack-space + stack@ rep return-reg rep %copy ;
  91
  92 M:: x86.64 %load-reg-param ( vreg rep reg -- )
  93     vreg reg rep %copy ;
  94
  95 M:: x86.64 %store-reg-param ( vreg rep reg -- )
  96     reg vreg rep %copy ;
  97
  98 M: x86.64 %discard-reg-param ( rep reg -- )
  99     2drop ;
 100
 101 M:: x86.64 %unbox ( dst src func rep -- )
 102     param-reg-0 src tagged-rep %copy
 103     param-reg-1 %mov-vm-ptr
 104     func f f %c-invoke
 105     dst rep %load-return ;
 106
 107 M:: x86.64 %box ( dst src func rep gc-map -- )
 108     0 rep reg-class-of cdecl param-regs at nth src rep %copy
 109     rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
 110     func f gc-map %c-invoke
 111     dst int-rep %load-return ;
 112
 113 M: x86.64 %c-invoke
 114     [ R11 0 MOV rc-absolute-cell rel-dlsym R11 CALL ] dip
 115     gc-map-here ;
 116
 117 M: x86.64 %begin-callback ( -- )
 118     param-reg-0 %mov-vm-ptr
 119     param-reg-1 0 MOV
 120     "begin_callback" f f %c-invoke ;
 121
 122 M: x86.64 %end-callback ( -- )
 123     param-reg-0 %mov-vm-ptr
 124     "end_callback" f f %c-invoke ;
 125
 126 M: x86.64 %prepare-var-args ( -- ) RAX RAX XOR ;
 127
 128 M: x86.64 stack-cleanup 3drop 0 ;
 129
 130 M: x86.64 %cleanup 0 assert= ;
 131
 132 M: x86.64 long-long-on-stack? f ;
 133
 134 M: x86.64 float-on-stack? f ;
 135
 136 M: x86.64 struct-return-on-stack? f ;
 137
 138 ! The result of reading 4 bytes from memory is a fixnum on
 139 ! x86-64.
 140 enable-alien-4-intrinsics
 141
 142 USE: vocabs.loader
 143
 144 {
 145     { [ os unix? ] [ "cpu.x86.64.unix" require ] }
 146     { [ os windows? ] [ "cpu.x86.64.windows" require ] }
 147 } cond
 148
 149 check-sse