basis/cpu/x86/32/bootstrap.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private kernel kernel.private namespaces
   4 system cpu.x86.assembler cpu.x86.assembler.operands layouts
   5 vocabs parser compiler.constants sequences math math.private
   6 generic.single.private ;
   7 IN: bootstrap.x86
   8
   9 4 \ cell set
  10
  11 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
  12 : shift-arg ( -- reg ) ECX ;
  13 : div-arg ( -- reg ) EAX ;
  14 : mod-arg ( -- reg ) EDX ;
  15 : temp0 ( -- reg ) EAX ;
  16 : temp1 ( -- reg ) EDX ;
  17 : temp2 ( -- reg ) ECX ;
  18 : temp3 ( -- reg ) EBX ;
  19 : safe-reg ( -- reg ) EAX ;
  20 : stack-reg ( -- reg ) ESP ;
  21 : ds-reg ( -- reg ) ESI ;
  22 : rs-reg ( -- reg ) EDI ;
  23 : fixnum>slot@ ( -- ) temp0 2 SAR ;
  24 : rex-length ( -- n ) 0 ;
  25
  26 [
  27     ! save stack frame size
  28     stack-frame-size PUSH
  29     ! push XT
  30     0 PUSH rc-absolute-cell rt-this jit-rel
  31     ! alignment
  32     ESP stack-frame-size 3 bootstrap-cells - SUB
  33 ] jit-prolog jit-define
  34
  35 : jit-load-vm ( -- )
  36     EBP 0 MOV 0 rc-absolute-cell jit-vm ;
  37
  38 : jit-save-context ( -- )
  39     ! VM pointer must be in EBP already
  40     ECX EBP [] MOV
  41     ! save ctx->callstack_top
  42     EAX ESP -4 [+] LEA
  43     ECX [] EAX MOV
  44     ! save ctx->datastack
  45     ECX 8 [+] ds-reg MOV
  46     ! save ctx->retainstack
  47     ECX 12 [+] rs-reg MOV ;
  48
  49 : jit-restore-context ( -- )
  50     ! VM pointer must be in EBP already
  51     ECX EBP [] MOV
  52     ! restore ctx->datastack
  53     ds-reg ECX 8 [+] MOV
  54     ! restore ctx->retainstack
  55     rs-reg ECX 12 [+] MOV ;
  56
  57 [
  58     jit-load-vm
  59     ! save ds, rs registers
  60     jit-save-context
  61     ! call the primitive
  62     ESP [] EBP MOV
  63     0 CALL rc-relative rt-primitive jit-rel
  64     ! restore ds, rs registers
  65     jit-restore-context
  66 ] jit-primitive jit-define
  67
  68 [
  69     ! load from stack
  70     EAX ds-reg [] MOV
  71     ! pop stack
  72     ds-reg bootstrap-cell SUB
  73     ! load VM pointer
  74     EDX 0 MOV 0 rc-absolute-cell jit-vm
  75 ]
  76 [ EAX quot-xt-offset [+] CALL ]
  77 [ EAX quot-xt-offset [+] JMP ]
  78 \ (call) define-sub-primitive*
  79
  80 ! Inline cache miss entry points
  81 : jit-load-return-address ( -- )
  82     EBX ESP stack-frame-size bootstrap-cell - [+] MOV ;
  83
  84 ! These are always in tail position with an existing stack
  85 ! frame, and the stack. The frame setup takes this into account.
  86 : jit-inline-cache-miss ( -- )
  87     jit-load-vm
  88     jit-save-context
  89     ESP 4 [+] EBP MOV
  90     ESP [] EBX MOV
  91     0 CALL "inline_cache_miss" f rc-relative jit-dlsym
  92     jit-restore-context ;
  93
  94 [ jit-load-return-address jit-inline-cache-miss ]
  95 [ EAX CALL ]
  96 [ EAX JMP ]
  97 \ inline-cache-miss define-sub-primitive*
  98
  99 [ jit-inline-cache-miss ]
 100 [ EAX CALL ]
 101 [ EAX JMP ]
 102 \ inline-cache-miss-tail define-sub-primitive*
 103
 104 ! Overflowing fixnum arithmetic
 105 : jit-overflow ( insn func -- )
 106     ds-reg 4 SUB
 107     jit-load-vm
 108     jit-save-context
 109     EAX ds-reg [] MOV
 110     EDX ds-reg 4 [+] MOV
 111     ECX EAX MOV
 112     [ [ ECX EDX ] dip call( dst src -- ) ] dip
 113     ds-reg [] ECX MOV
 114     [ JNO ]
 115     [
 116         ESP [] EAX MOV
 117         ESP 4 [+] EDX MOV
 118         ESP 8 [+] EBP MOV
 119         [ 0 CALL ] dip f rc-relative jit-dlsym
 120     ]
 121     jit-conditional ;
 122
 123 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 124
 125 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 126
 127 [
 128     ds-reg 4 SUB
 129     jit-load-vm
 130     jit-save-context
 131     ECX ds-reg [] MOV
 132     EAX ECX MOV
 133     EBX ds-reg 4 [+] MOV
 134     EBX tag-bits get SAR
 135     EBX IMUL
 136     ds-reg [] EAX MOV
 137     [ JNO ]
 138     [
 139         ECX tag-bits get SAR
 140         ESP [] ECX MOV
 141         ESP 4 [+] EBX MOV
 142         ESP 8 [+] EBP MOV
 143         0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
 144     ]
 145     jit-conditional
 146 ] \ fixnum* define-sub-primitive
 147
 148 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 149 call