basis/cpu/x86/64/unix/unix.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types arrays assocs
   4 compiler.cfg.builder.alien.boxing cpu.architecture cpu.x86
   5 cpu.x86.assembler cpu.x86.assembler.operands kernel layouts locals
   6 make math math.order namespaces sequences splitting system ;
   7 IN: cpu.x86.64.unix
   8
   9 M: x86.64 param-regs
  10     drop {
  11         { int-regs { RDI RSI RDX RCX R8 R9 } }
  12         { float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
  13     } ;
  14
  15 M: x86.64 reserved-stack-space 0 ;
  16
  17 : struct-types&offset ( struct-type -- pairs )
  18     fields>> [
  19         [ type>> ] [ offset>> ] bi 2array
  20     ] map ;
  21
  22 : split-struct ( pairs -- seq )
  23     [
  24         [ 8 mod zero? [ t , ] when , ] assoc-each
  25     ] { } make { t } split harvest ;
  26
  27 :: flatten-small-struct ( c-type -- seq )
  28     c-type struct-types&offset split-struct [
  29         [ lookup-c-type c-type-rep reg-class-of ] map
  30         int-regs swap member? int-rep double-rep ?
  31         f f 3array
  32     ] map :> reps
  33     int-reg-reps get float-reg-reps get and [
  34         reps reg-reps :> ( int-mems float-mems )
  35         int-reg-reps get int-mems + 6 >
  36         float-reg-reps get float-mems + 8 > or [
  37             reps [ first t f 3array ] map
  38         ] [ reps ] if
  39     ] [ reps ] if ;
  40
  41 M: x86.64 flatten-struct-type ( c-type -- seq )
  42     dup heap-size 16 <=
  43     [ flatten-small-struct record-reg-reps ] [
  44         call-next-method unrecord-reg-reps
  45         [ first t f 3array ] map
  46     ] if ;
  47
  48 M: x86.64 return-struct-in-registers? ( c-type -- ? )
  49     heap-size 2 cells <= ;
  50
  51 M: x86.64 dummy-stack-params? f ;
  52
  53 M: x86.64 dummy-int-params? f ;
  54
  55 M: x86.64 dummy-fp-params? f ;
  56
  57 M: x86.64 %prepare-var-args ( reg-inputs -- )
  58     [ second reg-class-of float-regs? ] count 8 min
  59     [ EAX EAX XOR ] [ <byte> AL swap MOV ] if-zero ;