core/compiler/x86/architecture.factor

   1 ! Copyright (C) 2005, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien arrays assembler generic kernel kernel-internals
   4 math memory namespaces sequences words ;
   5 IN: compiler
   6
   7 : code-format 1 ; inline
   8
   9 ! x86 register assignments
  10 ! EAX, ECX, EDX integer vregs
  11 ! XMM0 - XMM7 float vregs
  12 ! ESI datastack
  13 ! EDI callstack
  14
  15 ! AMD64 redefines a lot of words in this file
  16
  17 : ds-reg ESI ; inline
  18 : cs-reg EDI ; inline
  19 : allot-tmp-reg EBX ; inline
  20 : stack-reg ESP ; inline
  21 : stack@ stack-reg swap [+] ;
  22
  23 : reg-stack ( n reg -- op ) swap cells neg [+] ;
  24
  25 M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
  26 M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
  27
  28 : %alien-invoke ( symbol dll -- ) (CALL) rel-dlsym ;
  29
  30 : alien-temp ( quot -- )
  31     0 [] swap call "alien_temp" f rel-absolute rel-dlsym ;
  32     inline
  33
  34 : %prepare-alien-indirect ( -- )
  35     "unbox_alien" f %alien-invoke
  36     [ T{ int-regs } return-reg MOV ] alien-temp ;
  37
  38 : %alien-indirect ( -- )
  39     [ CALL ] alien-temp ;
  40
  41 GENERIC: push-return-reg ( reg-class -- )
  42 GENERIC: pop-return-reg ( reg-class -- )
  43 GENERIC: load-return-reg ( stack@ reg-class -- )
  44 GENERIC: store-return-reg ( stack@ reg-class -- )
  45
  46 ! On x86, parameters are never passed in registers.
  47 M: int-regs return-reg drop EAX ;
  48 M: int-regs fastcall-regs drop { } ;
  49 M: int-regs vregs drop { EAX ECX EDX } ;
  50 M: int-regs %freg>stack drop >r stack@ r> MOV ;
  51 M: int-regs %stack>freg drop swap stack@ MOV ;
  52 M: int-regs push-return-reg return-reg PUSH ;
  53 M: int-regs pop-return-reg return-reg POP ;
  54 : load/store-int-return return-reg stack-reg rot [+] ;
  55 M: int-regs load-return-reg load/store-int-return MOV ;
  56 M: int-regs store-return-reg load/store-int-return swap MOV ;
  57
  58 : MOVSS/D float-regs-size 4 = [ MOVSS ] [ MOVSD ] if ;
  59
  60 M: float-regs fastcall-regs drop { } ;
  61 M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
  62 M: float-regs %freg>stack >r >r stack@ r> r> MOVSS/D ;
  63 M: float-regs %stack>freg >r swap stack@ r> MOVSS/D ;
  64
  65 : FSTP 4 = [ FSTPS ] [ FSTPL ] if ;
  66
  67 M: float-regs push-return-reg
  68     stack-reg swap reg-size [ SUB  stack-reg [] ] keep FSTP ;
  69
  70 : FLD 4 = [ FLDS ] [ FLDL ] if ;
  71
  72 : drop-return-reg stack-reg swap reg-size ADD ;
  73
  74 M: float-regs pop-return-reg
  75     stack-reg [] over reg-size FLD drop-return-reg ;
  76
  77 : load/store-float-return reg-size >r stack-reg swap [+] r> ;
  78 M: float-regs load-return-reg load/store-float-return FLD ;
  79 M: float-regs store-return-reg load/store-float-return FSTP ;
  80
  81 : address-operand ( address -- operand )
  82     #! On x86, we can always use an address as an operand
  83     #! directly.
  84     ; inline
  85
  86 : fixnum>slot@ 1 SHR ; inline
  87
  88 : prepare-division CDQ ; inline
  89
  90 M: immediate load-literal
  91     v>operand swap v>operand MOV ;
  92
  93 : load-indirect ( literal reg -- )
  94     0 [] MOV rel-absolute-cell rel-literal ;
  95
  96 M: object load-literal
  97     v>operand load-indirect ;
  98
  99 : %prologue ( n -- )
 100     drop
 101     EBP PUSH
 102     EBP ESP MOV ;
 103
 104 : %epilogue ( -- )
 105     LEAVE ;
 106
 107 : (%call) ( label -- label )
 108     dup (compile) dup primitive? [ address-operand ] when ;
 109
 110 : %call ( label -- ) (%call) CALL ;
 111
 112 : %jump ( label -- ) %epilogue (%call) JMP ;
 113
 114 : %jump-label ( label -- ) JMP ;
 115
 116 : %jump-t ( label -- ) "flag" operand f v>operand CMP JNE ;
 117
 118 : compile-aligned ( -- )
 119     compiled-offset [ 8 align ] keep - 0 <array> % ;
 120
 121 : %dispatch ( -- )
 122     #! Compile a piece of code that jumps to an offset in a
 123     #! jump table indexed by the fixnum at the top of the stack.
 124     #! The jump table must immediately follow this macro.
 125     [
 126         ! Untag and multiply to get a jump table offset
 127         "end" define-label
 128         "n" operand fixnum>slot@
 129         ! Add to jump table base. We use a temporary register
 130         ! since on AMD64 we have to load a 64-bit immediate. On
 131         ! x86, this is redundant.
 132         "scratch" operand HEX: ffffffff MOV
 133         "end" get rel-absolute-cell rel-label
 134         "n" operand "scratch" operand ADD
 135         ! Jump to jump table entry
 136         "n" operand [] JMP
 137         ! Align for better performance
 138         compile-aligned
 139         ! Fix up jump table pointer
 140         "end" resolve-label
 141     ] H{
 142         { +input+ { { f "n" } } }
 143         { +scratch+ { { f "scratch" } } }
 144     } with-template ;
 145
 146 : %target ( label -- ) 0 cell, rel-absolute-cell rel-label ;
 147
 148 : %return ( -- ) %epilogue RET ;
 149
 150 : %move-int>int ( dst src -- )
 151     [ v>operand ] 2apply MOV ;
 152
 153 : %move-int>float ( dst src -- )
 154     [ v>operand ] 2apply float-offset [+] MOVSD ;
 155
 156 M: int-regs (%peek) drop %move-int>int ;
 157
 158 M: int-regs (%replace) drop swap %move-int>int ;
 159
 160 : (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
 161
 162 : %inc-d ( n -- ) ds-reg (%inc) ;
 163
 164 : %inc-r ( n -- ) cs-reg (%inc) ;
 165
 166 M: object %stack>freg 3drop ;
 167
 168 M: object %freg>stack 3drop ;