--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser system kernel sequences math math.ranges
+cpu.ppc.assembler combinators compiler.constants
+bootstrap.image.private layouts namespaces ;
+IN: bootstrap.ppc
+
+4 \ cell set
+big-endian on
+
+: reserved-size ( -- n ) 24 ;
+: lr-save ( -- n ) 4 ;
+
+CONSTANT: ds-reg 14
+CONSTANT: rs-reg 15
+CONSTANT: vm-reg 16
+CONSTANT: ctx-reg 17
+CONSTANT: frame-reg 31
+: nv-int-regs ( -- seq ) 13 31 [a,b] ;
+
+: LOAD32 ( r n -- )
+ [ -16 shift 0xffff bitand LIS ]
+ [ [ dup ] dip 0xffff bitand ORI ] 2bi ;
+
+: jit-trap-null ( src -- ) drop ;
+: jit-load-vm ( dst -- )
+ 0 LOAD32 0 rc-absolute-ppc-2/2 jit-vm ;
+: jit-load-dlsym ( dst string -- )
+ [ 0 LOAD32 ] dip rc-absolute-ppc-2/2 jit-dlsym ;
+: jit-load-dlsym-toc ( string -- ) drop ;
+: jit-load-vm-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel ;
+: jit-load-entry-point-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel ;
+: jit-load-this-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel ;
+: jit-load-literal-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel ;
+: jit-load-dlsym-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel ;
+: jit-load-dlsym-toc-arg ( -- ) ;
+: jit-load-here-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel ;
+: jit-load-megamorphic-cache-arg ( dst -- )
+ 0 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel ;
+: jit-load-cell ( dst src offset -- ) LWZ ;
+: jit-load-cell-x ( dst src offset -- ) LWZX ;
+: jit-load-cell-update ( dst src offset -- ) LWZU ;
+: jit-save-cell ( dst src offset -- ) STW ;
+: jit-save-cell-x ( dst src offset -- ) STWX ;
+: jit-save-cell-update ( dst src offset -- ) STWU ;
+: jit-load-int ( dst src offset -- ) LWZ ;
+: jit-save-int ( dst src offset -- ) STW ;
+: jit-shift-tag-bits ( dst src -- ) tag-bits get SRAWI ;
+: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRWI ;
+: jit-shift-fixnum-slot ( dst src -- ) 2 SRAWI ;
+: jit-class-hashcode ( dst src -- ) 1 SRAWI ;
+: jit-shift-left-logical ( dst src n -- ) SLW ;
+: jit-shift-left-logical-imm ( dst src n -- ) SLWI ;
+: jit-shift-right-algebraic ( dst src n -- ) SRAW ;
+: jit-divide ( dst ra rb -- ) DIVW ;
+: jit-multiply-low ( dst ra rb -- ) MULLW ;
+: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLWO. ;
+: jit-compare-cell ( cr ra rb -- ) CMPW ;
+: jit-compare-cell-imm ( cr ra imm -- ) CMPWI ;
+
+: cell-size ( -- n ) 4 ;
+: factor-area-size ( -- n ) 16 ;
+: param-size ( -- n ) 32 ;
+: saved-int-regs-size ( -- n ) 96 ;
+
+<< "vocab:bootstrap/assembler/ppc.factor" parse-file suffix! >>
+call
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser system kernel sequences math math.ranges
+cpu.ppc.assembler combinators compiler.constants
+bootstrap.image.private layouts namespaces ;
+IN: bootstrap.ppc
+
+8 \ cell set
+big-endian on
+
+: reserved-size ( -- n ) 48 ;
+: lr-save ( -- n ) 16 ;
+
+CONSTANT: ds-reg 14
+CONSTANT: rs-reg 15
+CONSTANT: vm-reg 16
+CONSTANT: ctx-reg 17
+CONSTANT: frame-reg 31
+: nv-int-regs ( -- seq ) 13 31 [a,b] ;
+
+: LOAD64 ( r n -- )
+ [ dup ] dip {
+ [ nip -48 shift 0xffff bitand LIS ]
+ [ -32 shift 0xffff bitand ORI ]
+ [ drop 32 SLDI ]
+ [ -16 shift 0xffff bitand ORIS ]
+ [ 0xffff bitand ORI ]
+ } 3cleave ;
+
+: jit-trap-null ( src -- ) drop ;
+: jit-load-vm ( dst -- )
+ 0 LOAD64 0 rc-absolute-ppc-2/2/2/2 jit-vm ;
+: jit-load-dlsym ( dst string -- )
+ [ 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym ;
+: jit-load-dlsym-toc ( string -- )
+ [ 2 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym-toc ;
+: jit-load-vm-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-vm jit-rel ;
+: jit-load-entry-point-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-entry-point jit-rel ;
+: jit-load-this-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-this jit-rel ;
+: jit-load-literal-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-literal jit-rel ;
+: jit-load-dlsym-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym jit-rel ;
+: jit-load-dlsym-toc-arg ( -- )
+ 2 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym-toc jit-rel ;
+: jit-load-here-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-here jit-rel ;
+: jit-load-megamorphic-cache-arg ( dst -- )
+ 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-megamorphic-cache-hits jit-rel ;
+: jit-load-cell ( dst src offset -- ) LD ;
+: jit-load-cell-x ( dst src offset -- ) LDX ;
+: jit-load-cell-update ( dst src offset -- ) LDU ;
+: jit-save-cell ( dst src offset -- ) STD ;
+: jit-save-cell-x ( dst src offset -- ) STDX ;
+: jit-save-cell-update ( dst src offset -- ) STDU ;
+: jit-load-int ( dst src offset -- ) LD ;
+: jit-save-int ( dst src offset -- ) STD ;
+: jit-shift-tag-bits ( dst src -- ) tag-bits get SRADI ;
+: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRDI ;
+: jit-shift-fixnum-slot ( dst src -- ) 1 SRADI ;
+: jit-class-hashcode ( dst src -- ) 1 SRADI ;
+: jit-shift-left-logical ( dst src n -- ) SLD ;
+: jit-shift-left-logical-imm ( dst src n -- ) SLDI ;
+: jit-shift-right-algebraic ( dst src n -- ) SRAD ;
+: jit-divide ( dst ra rb -- ) DIVD ;
+: jit-multiply-low ( dst ra rb -- ) MULLD ;
+: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLDO. ;
+: jit-compare-cell ( cr ra rb -- ) CMPD ;
+: jit-compare-cell-imm ( cr ra imm -- ) CMPDI ;
+
+: cell-size ( -- n ) 8 ;
+: factor-area-size ( -- n ) 32 ;
+: param-size ( -- n ) 64 ;
+: saved-int-regs-size ( -- n ) 192 ;
+
+<< "vocab:bootstrap/assembler/ppc.factor" parse-file suffix! >>
+call
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel kernel.private namespaces
+system cpu.ppc.assembler compiler.units compiler.constants math
+math.private math.ranges layouts words vocabs slots.private
+locals locals.backend generic.single.private fry sequences
+threads.private strings.private ;
+FROM: cpu.ppc.assembler => B ;
+IN: bootstrap.ppc
+
+: jit-call ( string -- )
+ dup
+ 0 swap jit-load-dlsym
+ 0 MTLR
+ jit-load-dlsym-toc
+ BLRL ;
+
+: jit-call-quot ( -- )
+ 4 quot-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTLR
+ BLRL ;
+
+: jit-jump-quot ( -- )
+ 4 quot-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTCTR
+ BCTR ;
+
+: stack-frame ( -- n )
+ reserved-size factor-area-size + 16 align ;
+
+: save-at ( m -- n ) reserved-size + param-size + ;
+
+: save-int ( reg off -- ) [ 1 ] dip save-at jit-save-int ;
+: save-fp ( reg off -- ) [ 1 ] dip save-at STFD ;
+: save-vec ( reg offt -- ) save-at 11 swap LI 11 1 STVXL ;
+: restore-int ( reg off -- ) [ 1 ] dip save-at jit-load-int ;
+: restore-fp ( reg off -- ) [ 1 ] dip save-at LFD ;
+: restore-vec ( reg offt -- ) save-at 11 swap LI 11 1 LVXL ;
+
+! Stop using intervals here.
+: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
+: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
+
+: saved-fp-regs-size ( -- n ) 144 ;
+: saved-vec-regs-size ( -- n ) 192 ;
+
+: callback-frame-size ( -- n )
+ reserved-size
+ param-size +
+ saved-int-regs-size +
+ saved-fp-regs-size +
+ saved-vec-regs-size +
+ 16 align ;
+
+: old-context-save-offset ( -- n )
+ cell-size 20 * saved-fp-regs-size + saved-vec-regs-size + save-at ;
+
+[
+ ! Save old stack pointer
+ 11 1 MR
+
+ 0 MFLR ! Get return address
+ 0 1 lr-save jit-save-cell ! Stash return address
+ 1 1 callback-frame-size neg jit-save-cell-update ! Bump stack pointer and set back chain
+
+ ! Save all non-volatile registers
+ nv-int-regs [ cell-size * save-int ] each-index
+ nv-fp-regs [ 8 * saved-int-regs-size + save-fp ] each-index
+ ! nv-vec-regs [ 16 * saved-int-regs-size saved-fp-regs-size + + save-vec ] each-index
+
+ ! Stick old stack pointer in the frame register so callbacks
+ ! can access their arguments
+ frame-reg 11 MR
+
+ ! Load VM into vm-reg
+ vm-reg jit-load-vm-arg
+
+ ! Save old context
+ 0 vm-reg vm-context-offset jit-load-cell
+ 0 1 old-context-save-offset jit-save-cell
+
+ ! Switch over to the spare context
+ 11 vm-reg vm-spare-context-offset jit-load-cell
+ 11 vm-reg vm-context-offset jit-save-cell
+
+ ! Save C callstack pointer and load Factor callstack
+ 1 11 context-callstack-save-offset jit-save-cell
+ 1 11 context-callstack-bottom-offset jit-load-cell
+
+ ! Load new data and retain stacks
+ rs-reg 11 context-retainstack-offset jit-load-cell
+ ds-reg 11 context-datastack-offset jit-load-cell
+
+ ! Call into Factor code
+ 0 jit-load-entry-point-arg
+ 0 MTLR
+ BLRL
+
+ ! Load VM again, pointlessly
+ vm-reg jit-load-vm-arg
+
+ ! Load C callstack pointer
+ 11 vm-reg vm-context-offset jit-load-cell
+ 1 11 context-callstack-save-offset jit-load-cell
+
+ ! Load old context
+ 0 1 old-context-save-offset jit-load-cell
+ 0 vm-reg vm-context-offset jit-save-cell
+
+ ! Restore non-volatile registers
+ ! nv-vec-regs [ 16 * saved-int-regs-size saved-float-regs-size + + restore-vec ] each-index
+ nv-fp-regs [ 8 * saved-int-regs-size + restore-fp ] each-index
+ nv-int-regs [ cell-size * restore-int ] each-index
+
+ 1 1 callback-frame-size ADDI ! Bump stack back up
+ 0 1 lr-save jit-load-cell ! Fetch return address
+ 0 MTLR ! Set up return
+ BLR ! Branch back
+] callback-stub jit-define
+
+: jit-conditional* ( test-quot false-quot -- )
+ [ '[ 4 + @ ] ] dip jit-conditional ; inline
+
+: jit-load-context ( -- )
+ ctx-reg vm-reg vm-context-offset jit-load-cell ;
+
+: jit-save-context ( -- )
+ jit-load-context
+ 1 ctx-reg context-callstack-top-offset jit-save-cell
+ ds-reg ctx-reg context-datastack-offset jit-save-cell
+ rs-reg ctx-reg context-retainstack-offset jit-save-cell ;
+
+: jit-restore-context ( -- )
+ ds-reg ctx-reg context-datastack-offset jit-load-cell
+ rs-reg ctx-reg context-retainstack-offset jit-load-cell ;
+
+[
+ 12 jit-load-literal-arg
+ 0 profile-count-offset LI
+ 11 12 0 jit-load-cell-x
+ 11 11 1 tag-fixnum ADDI
+ 11 12 0 jit-save-cell-x
+ 0 word-code-offset LI
+ 11 12 0 jit-load-cell-x
+ 11 11 compiled-header-size ADDI
+ 11 MTCTR
+ BCTR
+] jit-profiling jit-define
+
+[
+ 0 MFLR
+ 0 1 lr-save jit-save-cell
+ 0 jit-load-this-arg
+ 0 1 cell-size 2 * neg jit-save-cell
+ 0 stack-frame LI
+ 0 1 cell-size 1 * neg jit-save-cell
+ 1 1 stack-frame neg jit-save-cell-update
+] jit-prolog jit-define
+
+[
+ 3 jit-load-literal-arg
+ 3 ds-reg cell-size jit-save-cell-update
+] jit-push jit-define
+
+[
+ jit-save-context
+ 3 vm-reg MR
+ 4 jit-load-dlsym-arg
+ 4 MTLR
+ jit-load-dlsym-toc-arg ! Restore the TOC/GOT
+ BLRL
+ jit-restore-context
+] jit-primitive jit-define
+
+[ 0 BL rc-relative-ppc-3-pc rt-entry-point-pic jit-rel ] jit-word-call jit-define
+
+[
+ 6 jit-load-here-arg
+ 0 B rc-relative-ppc-3-pc rt-entry-point-pic-tail jit-rel
+] jit-word-jump jit-define
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 0 3 \ f type-number jit-compare-cell-imm
+ [ 0 swap BEQ ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
+ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel
+] jit-if jit-define
+
+: jit->r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 rs-reg cell-size jit-save-cell-update ;
+
+: jit-2>r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell
+ ds-reg dup 2 cell-size * SUBI
+ rs-reg dup 2 cell-size * ADDI
+ 4 rs-reg 0 jit-save-cell
+ 5 rs-reg cell-size neg jit-save-cell ;
+
+: jit-3>r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell
+ 6 ds-reg cell-size neg 2 * jit-load-cell
+ ds-reg dup 3 cell-size * SUBI
+ rs-reg dup 3 cell-size * ADDI
+ 4 rs-reg 0 jit-save-cell
+ 5 rs-reg cell-size neg jit-save-cell
+ 6 rs-reg cell-size neg 2 * jit-save-cell ;
+
+: jit-r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ rs-reg dup cell-size SUBI
+ 4 ds-reg cell-size jit-save-cell-update ;
+
+: jit-2r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ 5 rs-reg cell-size neg jit-load-cell
+ rs-reg dup 2 cell-size * SUBI
+ ds-reg dup 2 cell-size * ADDI
+ 4 ds-reg 0 jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell ;
+
+: jit-3r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ 5 rs-reg cell-size neg jit-load-cell
+ 6 rs-reg cell-size neg 2 * jit-load-cell
+ rs-reg dup 3 cell-size * SUBI
+ ds-reg dup 3 cell-size * ADDI
+ 4 ds-reg 0 jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell
+ 6 ds-reg cell-size neg 2 * jit-save-cell ;
+
+[
+ jit->r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-r>
+] jit-dip jit-define
+
+[
+ jit-2>r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-2r>
+] jit-2dip jit-define
+
+[
+ jit-3>r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-3r>
+] jit-3dip jit-define
+
+[
+ 1 1 stack-frame ADDI
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+] jit-epilog jit-define
+
+[ BLR ] jit-return jit-define
+
+! ! ! Polymorphic inline caches
+
+! Don't touch r6 here; it's used to pass the tail call site
+! address for tail PICs
+
+! Load a value from a stack position
+[
+ 4 ds-reg 0 jit-load-cell rc-absolute-ppc-2 rt-untagged jit-rel
+] pic-load jit-define
+
+[ 4 4 tag-mask get ANDI. ] pic-tag jit-define
+
+[
+ 3 4 MR
+ 4 4 tag-mask get ANDI.
+ 0 4 tuple type-number jit-compare-cell-imm
+ [ 0 swap BNE ]
+ [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
+ jit-conditional*
+] pic-tuple jit-define
+
+[
+ 0 4 0 jit-compare-cell-imm rc-absolute-ppc-2 rt-untagged jit-rel
+] pic-check-tag jit-define
+
+[
+ 5 jit-load-literal-arg
+ 0 4 5 jit-compare-cell
+] pic-check-tuple jit-define
+
+[
+ [ 0 swap BNE ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
+] pic-hit jit-define
+
+! Inline cache miss entry points
+: jit-load-return-address ( -- ) 6 MFLR ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-save-context
+ 3 6 MR
+ 4 vm-reg MR
+ ctx-reg 6 MR
+ "inline_cache_miss" jit-call
+ 6 ctx-reg MR
+ jit-load-context
+ jit-restore-context ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ 3 MTLR BLRL ]
+[ 3 MTCTR BCTR ]
+\ inline-cache-miss define-combinator-primitive
+
+[ jit-inline-cache-miss ]
+[ 3 MTLR BLRL ]
+[ 3 MTCTR BCTR ]
+\ inline-cache-miss-tail define-combinator-primitive
+
+! ! ! Megamorphic caches
+
+[
+ ! class = ...
+ 3 4 MR
+ 4 4 tag-mask get ANDI. ! Mask and...
+ 4 4 tag-bits get jit-shift-left-logical-imm ! shift tag bits to fixnum
+ 0 4 tuple type-number tag-fixnum jit-compare-cell-imm
+ [ 0 swap BNE ]
+ [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
+ jit-conditional*
+ ! cache = ...
+ 3 jit-load-literal-arg
+ ! key = hashcode(class)
+ 5 4 jit-class-hashcode
+ ! key &= cache.length - 1
+ 5 5 mega-cache-size get 1 - 4 * ANDI.
+ ! cache += array-start-offset
+ 3 3 array-start-offset ADDI
+ ! cache += key
+ 3 3 5 ADD
+ ! if(get(cache) == class)
+ 6 3 0 jit-load-cell
+ 0 6 4 jit-compare-cell
+ [ 0 swap BNE ]
+ [
+ ! megamorphic_cache_hits++
+ 4 jit-load-megamorphic-cache-arg
+ 5 4 0 jit-load-cell
+ 5 5 1 ADDI
+ 5 4 0 jit-save-cell
+ ! ... goto get(cache + cell-size)
+ 5 word-entry-point-offset LI
+ 3 3 cell-size jit-load-cell
+ 3 3 5 jit-load-cell-x
+ 3 MTCTR
+ BCTR
+ ]
+ jit-conditional*
+ ! fall-through on miss
+] mega-lookup jit-define
+
+! ! ! Sub-primitives
+
+! Quotations and words
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+]
+[ jit-call-quot ]
+[ jit-jump-quot ] \ (call) define-combinator-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 word-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+]
+[ 4 MTLR BLRL ]
+[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 word-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTCTR BCTR
+] jit-execute jit-define
+
+! Special primitives
+[
+ frame-reg 3 MR
+
+ 3 vm-reg MR
+ "begin_callback" jit-call
+
+ jit-load-context
+ jit-restore-context
+
+ ! Call quotation
+ 3 frame-reg MR
+ jit-call-quot
+
+ jit-save-context
+
+ 3 vm-reg MR
+ "end_callback" jit-call
+] \ c-to-factor define-sub-primitive
+
+[
+ ! Unwind stack frames
+ 1 4 MR
+
+ ! Load VM pointer into vm-reg, since we're entering from
+ ! C code
+ vm-reg jit-load-vm
+
+ ! Load ds and rs registers
+ jit-load-context
+ jit-restore-context
+
+ ! We have changed the stack; load return address again
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+
+ ! Call quotation
+ jit-jump-quot
+] \ unwind-native-frames define-sub-primitive
+
+[
+ 7 0 LI
+ 7 1 lr-save jit-save-cell
+
+ ! Load callstack object
+ 6 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ ! Get ctx->callstack_bottom
+ jit-load-context
+ 3 ctx-reg context-callstack-bottom-offset jit-load-cell
+ ! Get top of callstack object -- 'src' for memcpy
+ 4 6 callstack-top-offset ADDI
+ ! Get callstack length, in bytes --- 'len' for memcpy
+ 7 callstack-length-offset LI
+ 5 6 7 jit-load-cell-x
+ 5 5 jit-shift-tag-bits
+ ! Compute new stack pointer -- 'dst' for memcpy
+ 3 3 5 SUB
+ ! Install new stack pointer
+ 1 3 MR
+ ! Call memcpy; arguments are now in the correct registers
+ 1 1 -16 cell-size * jit-save-cell-update
+ "factor_memcpy" jit-call
+ 1 1 0 jit-load-cell
+ ! Return with new callstack
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+ BLR
+] \ set-callstack define-sub-primitive
+
+[
+ jit-save-context
+ 4 vm-reg MR
+ "lazy_jit_compile" jit-call
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ lazy-jit-compile define-combinator-primitive
+
+! Objects
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 tag-mask get ANDI.
+ 3 3 tag-bits get jit-shift-left-logical-imm
+ 3 ds-reg 0 jit-save-cell
+] \ tag define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell ! Load m
+ 4 ds-reg cell-size neg jit-load-cell-update ! Load obj
+ 3 3 jit-shift-fixnum-slot ! Shift to a cell-size multiple
+ 4 4 jit-mask-tag-bits ! Clear tag bits on obj
+ 3 4 3 jit-load-cell-x ! Load cell at &obj[m]
+ 3 ds-reg 0 jit-save-cell ! Push the result to the stack
+] \ slot define-sub-primitive
+
+[
+ ! load string index from stack
+ 3 ds-reg cell-size neg jit-load-cell
+ 3 3 jit-shift-tag-bits
+ ! load string from stack
+ 4 ds-reg 0 jit-load-cell
+ ! load character
+ 4 4 string-offset ADDI
+ 3 3 4 LBZX
+ 3 3 tag-bits get jit-shift-left-logical-imm
+ ! store character to stack
+ ds-reg ds-reg cell-size SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ string-nth-fast define-sub-primitive
+
+! Shufflers
+[
+ ds-reg dup cell-size SUBI
+] \ drop define-sub-primitive
+
+[
+ ds-reg dup 2 cell-size * SUBI
+] \ 2drop define-sub-primitive
+
+[
+ ds-reg dup 3 cell-size * SUBI
+] \ 3drop define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg dup 2 cell-size * ADDI
+ 3 ds-reg 0 jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+] \ 2dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ ds-reg dup cell-size 3 * ADDI
+ 3 ds-reg 0 jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+ 5 ds-reg cell-size neg 2 * jit-save-cell
+] \ 3dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ nip define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size 2 * SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ 2nip define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ over define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ pick define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 4 ds-reg 0 jit-save-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ dupd define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 3 ds-reg cell-size neg jit-save-cell
+ 4 ds-reg 0 jit-save-cell
+] \ swap define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg jit-load-cell
+ 4 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size neg 2 * jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+] \ swapd define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ 4 ds-reg cell-size neg 2 * jit-save-cell
+ 3 ds-reg cell-size neg jit-save-cell
+ 5 ds-reg 0 jit-save-cell
+] \ rot define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size neg 2 * jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell
+ 4 ds-reg 0 jit-save-cell
+] \ -rot define-sub-primitive
+
+[ jit->r ] \ load-local define-sub-primitive
+
+! Comparisons
+: jit-compare ( insn -- )
+ t jit-literal
+ 3 jit-load-literal-arg
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell-update
+ 0 5 4 jit-compare-cell
+ [ 0 8 ] dip execute( cr offset -- )
+ 3 \ f type-number LI
+ 3 ds-reg 0 jit-save-cell ;
+
+: define-jit-compare ( insn word -- )
+ [ [ jit-compare ] curry ] dip define-sub-primitive ;
+
+\ BEQ \ eq? define-jit-compare
+\ BGE \ fixnum>= define-jit-compare
+\ BLE \ fixnum<= define-jit-compare
+\ BGT \ fixnum> define-jit-compare
+\ BLT \ fixnum< define-jit-compare
+
+! Math
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 3 3 4 OR
+ 3 3 tag-mask get ANDI.
+ 4 \ f type-number LI
+ 0 3 0 jit-compare-cell-imm
+ [ 0 swap BNE ] [ 4 1 tag-fixnum LI ] jit-conditional*
+ 4 ds-reg 0 jit-save-cell
+] \ both-fixnums? define-sub-primitive
+
+: jit-math ( insn -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell-update
+ [ 5 3 4 ] dip execute( dst src1 src2 -- )
+ 5 ds-reg 0 jit-save-cell ;
+
+[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
+
+[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell-update
+ 4 4 jit-shift-tag-bits
+ 5 3 4 jit-multiply-low
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum*fast define-sub-primitive
+
+[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
+
+[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
+
+[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 NOT
+ 3 3 tag-mask get XORI
+ 3 ds-reg 0 jit-save-cell
+] \ fixnum-bitnot define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell ! Load amount to shift
+ 3 3 jit-shift-tag-bits ! Shift out tag bits
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell ! Load value to shift
+ 5 4 3 jit-shift-left-logical ! Shift left
+ 6 3 NEG ! Negate shift amount
+ 7 4 6 jit-shift-right-algebraic ! Shift right
+ 7 7 jit-mask-tag-bits ! Mask out tag bits
+ 0 3 0 jit-compare-cell-imm
+ [ 0 swap BGT ] [ 5 7 MR ] jit-conditional*
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum-shift-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 5 4 3 jit-divide
+ 6 5 3 jit-multiply-low
+ 7 4 6 SUB
+ 7 ds-reg 0 jit-save-cell
+] \ fixnum-mod define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 5 4 3 jit-divide
+ 5 5 tag-bits get jit-shift-left-logical-imm
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum/i-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 4 3 jit-divide
+ 6 5 3 jit-multiply-low
+ 7 4 6 SUB
+ 5 5 tag-bits get jit-shift-left-logical-imm
+ 5 ds-reg cell-size neg jit-save-cell
+ 7 ds-reg 0 jit-save-cell
+] \ fixnum/mod-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 jit-shift-fixnum-slot
+ 3 rs-reg 3 jit-load-cell-x
+ 3 ds-reg 0 jit-save-cell
+] \ get-local define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 3 3 jit-shift-fixnum-slot
+ rs-reg rs-reg 3 SUB
+] \ drop-locals define-sub-primitive
+
+! Overflowing fixnum arithmetic
+:: jit-overflow ( insn func -- )
+ ds-reg ds-reg cell-size SUBI
+ jit-save-context
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size jit-load-cell
+ 0 0 LI
+ 0 MTXER
+ 6 4 3 insn call( d a s -- )
+ 6 ds-reg 0 jit-save-cell
+ [ 0 swap BNS ]
+ [
+ 5 vm-reg MR
+ func jit-call
+ ]
+ jit-conditional* ;
+
+[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ ds-reg ds-reg cell-size SUBI
+ jit-save-context
+ 3 ds-reg 0 jit-load-cell
+ 3 3 jit-shift-tag-bits
+ 4 ds-reg cell-size jit-load-cell
+ 0 0 LI
+ 0 MTXER
+ 6 3 4 jit-multiply-low-ov-rc
+ 6 ds-reg 0 jit-save-cell
+ [ 0 swap BNS ]
+ [
+ 4 4 jit-shift-tag-bits
+ 5 vm-reg MR
+ "overflow_fixnum_multiply" jit-call
+ ]
+ jit-conditional*
+] \ fixnum* define-sub-primitive
+
+! Contexts
+:: jit-switch-context ( reg -- )
+ 7 0 LI
+ 7 1 lr-save jit-save-cell
+
+ ! Make the new context the current one
+ ctx-reg reg MR
+ ctx-reg vm-reg vm-context-offset jit-save-cell
+
+ ! Load new stack pointer
+ 1 ctx-reg context-callstack-top-offset jit-load-cell
+
+ ! Load new ds, rs registers
+ jit-restore-context ;
+
+: jit-pop-context-and-param ( -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 alien-offset LI
+ 3 3 4 jit-load-cell-x
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg ds-reg cell-size 2 * SUBI ;
+
+: jit-push-param ( -- )
+ ds-reg ds-reg cell-size ADDI
+ 4 ds-reg 0 jit-save-cell ;
+
+: jit-set-context ( -- )
+ jit-pop-context-and-param
+ jit-save-context
+ 3 jit-switch-context
+ jit-push-param ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-pop-quot-and-param ( -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg ds-reg cell-size 2 * SUBI ;
+
+: jit-start-context ( -- )
+ ! Create the new context in return-reg. Have to save context
+ ! twice, first before calling new_context() which may GC,
+ ! and again after popping the two parameters from the stack.
+ jit-save-context
+ 3 vm-reg MR
+ "new_context" jit-call
+
+ 6 3 MR
+ jit-pop-quot-and-param
+ jit-save-context
+ 6 jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+ jit-load-context
+ 3 vm-reg MR
+ 4 ctx-reg MR
+ "delete_context" jit-call ;
+
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+: jit-start-context-and-delete ( -- )
+ jit-load-context
+ 3 vm-reg MR
+ 4 ctx-reg MR
+ "reset_context" jit-call
+ jit-pop-quot-and-param
+ ctx-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[
+ jit-start-context-and-delete
+] \ (start-context-and-delete) define-sub-primitive
+
+[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
--- /dev/null
+! Copyright (C) 2007, 2011 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel kernel.private namespaces
+system cpu.x86.assembler cpu.x86.assembler.operands layouts
+vocabs parser compiler.constants compiler.codegen.relocation
+sequences math math.private generic.single.private
+threads.private locals ;
+IN: bootstrap.x86
+
+4 \ cell set
+
+: leaf-stack-frame-size ( -- n ) 4 bootstrap-cells ;
+: signal-handler-stack-frame-size ( -- n ) 12 bootstrap-cells ;
+: stack-frame-size ( -- n ) 8 bootstrap-cells ;
+: shift-arg ( -- reg ) ECX ;
+: div-arg ( -- reg ) EAX ;
+: mod-arg ( -- reg ) EDX ;
+: temp0 ( -- reg ) EAX ;
+: temp1 ( -- reg ) ECX ;
+: temp2 ( -- reg ) EBX ;
+: temp3 ( -- reg ) EDX ;
+: pic-tail-reg ( -- reg ) EDX ;
+: stack-reg ( -- reg ) ESP ;
+: frame-reg ( -- reg ) EBP ;
+: vm-reg ( -- reg ) EBX ;
+: ctx-reg ( -- reg ) EBP ;
+: nv-regs ( -- seq ) { ESI EDI EBX } ;
+: volatile-regs ( -- seq ) { EAX ECX EDX } ;
+: nv-reg ( -- reg ) ESI ;
+: ds-reg ( -- reg ) ESI ;
+: rs-reg ( -- reg ) EDI ;
+: link-reg ( -- reg ) EBX ;
+: fixnum>slot@ ( -- ) temp0 2 SAR ;
+: rex-length ( -- n ) 0 ;
+: red-zone-size ( -- n ) 0 ;
+
+: jit-call ( name -- )
+ 0 CALL f rc-relative rel-dlsym ;
+
+[
+ pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
+ 0 JMP f rc-relative rel-word-pic-tail
+] jit-word-jump jit-define
+
+: jit-load-vm ( -- )
+ vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
+
+: jit-load-context ( -- )
+ ! VM pointer must be in vm-reg already
+ ctx-reg vm-reg vm-context-offset [+] MOV ;
+
+: jit-save-context ( -- )
+ jit-load-context
+ ECX ESP -4 [+] LEA
+ ctx-reg context-callstack-top-offset [+] ECX MOV
+ ctx-reg context-datastack-offset [+] ds-reg MOV
+ ctx-reg context-retainstack-offset [+] rs-reg MOV ;
+
+: jit-restore-context ( -- )
+ ds-reg ctx-reg context-datastack-offset [+] MOV
+ rs-reg ctx-reg context-retainstack-offset [+] MOV ;
+
+[
+ ! ctx-reg is preserved across the call because it is
+ ! non-volatile in the C ABI
+ jit-load-vm
+ jit-save-context
+ ! call the primitive
+ ESP [] vm-reg MOV
+ 0 CALL f f rc-relative rel-dlsym
+ jit-restore-context
+] jit-primitive jit-define
+
+: jit-jump-quot ( -- )
+ EAX quot-entry-point-offset [+] JMP ;
+
+: jit-call-quot ( -- )
+ EAX quot-entry-point-offset [+] CALL ;
+
+[
+ jit-load-vm
+ ESP [] vm-reg MOV
+ EAX EBP 8 [+] MOV
+ ESP 4 [+] EAX MOV
+ "begin_callback" jit-call
+
+ jit-call-quot
+
+ jit-load-vm
+ ESP [] vm-reg MOV
+ "end_callback" jit-call
+] \ c-to-factor define-sub-primitive
+
+: signal-handler-save-regs ( -- regs )
+ { EAX ECX EDX EBX EBP ESI EDI } ;
+
+[
+ EAX ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ (call) define-combinator-primitive
+
+! unwind-native-frames is marked as "special" in vm/quotations.cpp
+! so it does not have a standard prolog
+[
+ ! Load ds and rs registers
+ jit-load-vm
+ jit-load-context
+ jit-restore-context
+
+ ! clear the fault flag
+ vm-reg vm-fault-flag-offset [+] 0 MOV
+
+ ! Windows-specific setup
+ ctx-reg jit-update-seh
+
+ ! Load arguments
+ EAX ESP bootstrap-cell [+] MOV
+ EDX ESP 2 bootstrap-cells [+] MOV
+
+ ! Unwind stack frames
+ ESP EDX MOV
+
+ jit-jump-quot
+] \ unwind-native-frames define-sub-primitive
+
+[
+ ESP 2 SUB
+ ESP [] FNSTCW
+ FNINIT
+ AX ESP [] MOV
+ ESP 2 ADD
+] \ fpu-state define-sub-primitive
+
+[
+ ESP stack-frame-size [+] FLDCW
+] \ set-fpu-state define-sub-primitive
+
+[
+ ! Load callstack object
+ temp3 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ ! Get ctx->callstack_bottom
+ jit-load-vm
+ jit-load-context
+ temp0 ctx-reg context-callstack-bottom-offset [+] MOV
+ ! Get top of callstack object -- 'src' for memcpy
+ temp1 temp3 callstack-top-offset [+] LEA
+ ! Get callstack length, in bytes --- 'len' for memcpy
+ temp2 temp3 callstack-length-offset [+] MOV
+ temp2 tag-bits get SHR
+ ! Compute new stack pointer -- 'dst' for memcpy
+ temp0 temp2 SUB
+ ! Install new stack pointer
+ ESP temp0 MOV
+ ! Call memcpy
+ temp2 PUSH
+ temp1 PUSH
+ temp0 PUSH
+ "factor_memcpy" jit-call
+ ESP 12 ADD
+ ! Return with new callstack
+ 0 RET
+] \ set-callstack define-sub-primitive
+
+[
+ jit-load-vm
+ jit-save-context
+
+ ! Store arguments
+ ESP [] EAX MOV
+ ESP 4 [+] vm-reg MOV
+
+ ! Call VM
+ "lazy_jit_compile" jit-call
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ lazy-jit-compile define-combinator-primitive
+
+[
+ temp1 0xffffffff CMP f rc-absolute-cell rel-literal
+] pic-check-tuple jit-define
+
+! Inline cache miss entry points
+: jit-load-return-address ( -- )
+ pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-load-vm
+ jit-save-context
+ ESP 4 [+] vm-reg MOV
+ ESP [] pic-tail-reg MOV
+ 0 CALL rc-relative rel-inline-cache-miss
+ jit-restore-context ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ EAX CALL ]
+[ EAX JMP ]
+\ inline-cache-miss define-combinator-primitive
+
+[ jit-inline-cache-miss ]
+[ EAX CALL ]
+[ EAX JMP ]
+\ inline-cache-miss-tail define-combinator-primitive
+
+! Overflowing fixnum arithmetic
+: jit-overflow ( insn func -- )
+ ds-reg 4 SUB
+ jit-load-vm
+ jit-save-context
+ EAX ds-reg [] MOV
+ EDX ds-reg 4 [+] MOV
+ EBX EAX MOV
+ [ [ EBX EDX ] dip call( dst src -- ) ] dip
+ ds-reg [] EBX MOV
+ [ JNO ]
+ [
+ ESP [] EAX MOV
+ ESP 4 [+] EDX MOV
+ jit-load-vm
+ ESP 8 [+] vm-reg MOV
+ jit-call
+ ]
+ jit-conditional ;
+
+[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ ds-reg 4 SUB
+ jit-load-vm
+ jit-save-context
+ EBX ds-reg [] MOV
+ EAX EBX MOV
+ EBP ds-reg 4 [+] MOV
+ EBP tag-bits get SAR
+ EBP IMUL
+ ds-reg [] EAX MOV
+ [ JNO ]
+ [
+ EBX tag-bits get SAR
+ ESP [] EBX MOV
+ ESP 4 [+] EBP MOV
+ jit-load-vm
+ ESP 8 [+] vm-reg MOV
+ "overflow_fixnum_multiply" jit-call
+ ]
+ jit-conditional
+] \ fixnum* define-sub-primitive
+
+! Contexts
+: jit-switch-context ( reg -- )
+ ! Push a bogus return address so the GC can track this frame back
+ ! to the owner
+ 0 CALL
+
+ ! Make the new context the current one
+ ctx-reg swap MOV
+ vm-reg vm-context-offset [+] ctx-reg MOV
+
+ ! Load new stack pointer
+ ESP ctx-reg context-callstack-top-offset [+] MOV
+
+ ! Windows-specific setup
+ ctx-reg jit-update-tib
+
+ ! Load new ds, rs registers
+ jit-restore-context ;
+
+: jit-set-context ( -- )
+ ! Load context and parameter from datastack
+ EAX ds-reg [] MOV
+ EAX EAX alien-offset [+] MOV
+ EDX ds-reg -4 [+] MOV
+ ds-reg 8 SUB
+
+ ! Save ds, rs registers
+ jit-load-vm
+ jit-save-context
+
+ ! Make the new context active
+ EAX jit-switch-context
+
+ ! Windows-specific setup
+ ctx-reg jit-update-seh
+
+ ! Twiddle stack for return
+ ESP 4 ADD
+
+ ! Store parameter to datastack
+ ds-reg 4 ADD
+ ds-reg [] EDX MOV ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-save-quot-and-param ( -- )
+ EDX ds-reg MOV
+ ds-reg 8 SUB ;
+
+: jit-push-param ( -- )
+ EAX EDX -4 [+] MOV
+ ds-reg 4 ADD
+ ds-reg [] EAX MOV ;
+
+: jit-start-context ( -- )
+ ! Create the new context in return-reg
+ jit-load-vm
+ jit-save-context
+ ESP [] vm-reg MOV
+ "new_context" jit-call
+
+ jit-save-quot-and-param
+
+ ! Make the new context active
+ jit-load-vm
+ jit-save-context
+ EAX jit-switch-context
+
+ jit-push-param
+
+ ! Windows-specific setup
+ jit-install-seh
+
+ ! Push a fake return address
+ 0 PUSH
+
+ ! Jump to initial quotation
+ EAX EDX [] MOV
+ jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+ jit-load-vm
+ jit-load-context
+ ESP [] vm-reg MOV
+ ESP 4 [+] ctx-reg MOV
+ "delete_context" jit-call ;
+
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+: jit-start-context-and-delete ( -- )
+ jit-load-vm
+ jit-load-context
+ ESP [] vm-reg MOV
+ ESP 4 [+] ctx-reg MOV
+ "reset_context" jit-call
+
+ jit-save-quot-and-param
+ ctx-reg jit-switch-context
+ jit-push-param
+
+ EAX EDX [] MOV
+ jit-jump-quot ;
+
+[
+ 0 EAX MOVABS rc-absolute rel-safepoint
+] \ jit-safepoint jit-define
+
+[
+ jit-start-context-and-delete
+] \ (start-context-and-delete) define-sub-primitive
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel parser sequences ;
+IN: bootstrap.x86
+
+<< "vocab:bootstrap/assembler/x86.unix.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.32.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.factor" parse-file suffix! >> call
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private compiler.constants
+compiler.codegen.relocation cpu.x86.assembler
+cpu.x86.assembler.operands kernel layouts locals parser
+sequences ;
+IN: bootstrap.x86
+
+: tib-segment ( -- ) FS ;
+: tib-temp ( -- reg ) EAX ;
+
+<< "vocab:bootstrap/assembler/x86.windows.factor" parse-file suffix! >> call
+
+: jit-install-seh ( -- )
+ ! Create a new exception record and store it in the TIB.
+ ! Clobbers tib-temp.
+ ! Align stack
+ ESP 3 bootstrap-cells ADD
+ ! Exception handler address filled in by callback.cpp
+ tib-temp 0 MOV rc-absolute-cell rel-exception-handler
+ tib-temp PUSH
+ ! No next handler
+ 0 PUSH
+ ! This is the new exception handler
+ tib-exception-list-offset [] ESP tib-segment MOV ;
+
+:: jit-update-seh ( ctx-reg -- )
+ ! Load exception record structure that jit-install-seh
+ ! created from the bottom of the callstack.
+ ! Clobbers tib-temp.
+ tib-temp ctx-reg context-callstack-bottom-offset [+] MOV
+ tib-temp bootstrap-cell ADD
+ ! Store exception record in TIB.
+ tib-exception-list-offset [] tib-temp tib-segment MOV ;
+
+<< "vocab:bootstrap/assembler/x86.32.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.factor" parse-file suffix! >> call
--- /dev/null
+! Copyright (C) 2007, 2011 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel kernel.private namespaces
+system layouts vocabs parser compiler.constants
+compiler.codegen.relocation math math.private cpu.x86.assembler
+cpu.x86.assembler.operands sequences generic.single.private
+threads.private locals ;
+IN: bootstrap.x86
+
+8 \ cell set
+
+: shift-arg ( -- reg ) RCX ;
+: div-arg ( -- reg ) RAX ;
+: mod-arg ( -- reg ) RDX ;
+: temp0 ( -- reg ) RAX ;
+: temp1 ( -- reg ) RCX ;
+: temp2 ( -- reg ) RDX ;
+: temp3 ( -- reg ) RBX ;
+: pic-tail-reg ( -- reg ) RBX ;
+: return-reg ( -- reg ) RAX ;
+: nv-reg ( -- reg ) RBX ;
+: stack-reg ( -- reg ) RSP ;
+: frame-reg ( -- reg ) RBP ;
+: link-reg ( -- reg ) R11 ;
+: ctx-reg ( -- reg ) R12 ;
+: vm-reg ( -- reg ) R13 ;
+: ds-reg ( -- reg ) R14 ;
+: rs-reg ( -- reg ) R15 ;
+: fixnum>slot@ ( -- ) temp0 1 SAR ;
+: rex-length ( -- n ) 1 ;
+
+: jit-call ( name -- )
+ RAX 0 MOV f rc-absolute-cell rel-dlsym
+ RAX CALL ;
+
+[
+ pic-tail-reg 5 [RIP+] LEA
+ 0 JMP f rc-relative rel-word-pic-tail
+] jit-word-jump jit-define
+
+: jit-load-vm ( -- )
+ ! no-op on x86-64. in factor contexts vm-reg always contains the
+ ! vm pointer.
+ ;
+
+: jit-load-context ( -- )
+ ctx-reg vm-reg vm-context-offset [+] MOV ;
+
+: jit-save-context ( -- )
+ jit-load-context
+ R11 RSP -8 [+] LEA
+ ctx-reg context-callstack-top-offset [+] R11 MOV
+ ctx-reg context-datastack-offset [+] ds-reg MOV
+ ctx-reg context-retainstack-offset [+] rs-reg MOV ;
+
+: jit-restore-context ( -- )
+ ds-reg ctx-reg context-datastack-offset [+] MOV
+ rs-reg ctx-reg context-retainstack-offset [+] MOV ;
+
+[
+ ! ctx-reg is preserved across the call because it is non-volatile
+ ! in the C ABI
+ jit-save-context
+ ! call the primitive
+ arg1 vm-reg MOV
+ RAX 0 MOV f f rc-absolute-cell rel-dlsym
+ RAX CALL
+ jit-restore-context
+] jit-primitive jit-define
+
+: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
+
+: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
+
+[
+ arg2 arg1 MOV
+ arg1 vm-reg MOV
+ "begin_callback" jit-call
+
+ ! call the quotation
+ arg1 return-reg MOV
+ jit-call-quot
+
+ arg1 vm-reg MOV
+ "end_callback" jit-call
+] \ c-to-factor define-sub-primitive
+
+: signal-handler-save-regs ( -- regs )
+ { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
+
+[
+ arg1 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ (call) define-combinator-primitive
+
+[
+ ! Unwind stack frames
+ RSP arg2 MOV
+
+ ! Load VM pointer into vm-reg, since we're entering from
+ ! C code
+ vm-reg 0 MOV 0 rc-absolute-cell rel-vm
+
+ ! Load ds and rs registers
+ jit-load-context
+ jit-restore-context
+
+ ! Clear the fault flag
+ vm-reg vm-fault-flag-offset [+] 0 MOV
+
+ ! Call quotation
+ jit-jump-quot
+] \ unwind-native-frames define-sub-primitive
+
+[
+ RSP 2 SUB
+ RSP [] FNSTCW
+ FNINIT
+ AX RSP [] MOV
+ RSP 2 ADD
+] \ fpu-state define-sub-primitive
+
+[
+ RSP 2 SUB
+ RSP [] arg1 16-bit-version-of MOV
+ RSP [] FLDCW
+ RSP 2 ADD
+] \ set-fpu-state define-sub-primitive
+
+[
+ ! Load callstack object
+ arg4 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ ! Get ctx->callstack_bottom
+ jit-load-context
+ arg1 ctx-reg context-callstack-bottom-offset [+] MOV
+ ! Get top of callstack object -- 'src' for memcpy
+ arg2 arg4 callstack-top-offset [+] LEA
+ ! Get callstack length, in bytes --- 'len' for memcpy
+ arg3 arg4 callstack-length-offset [+] MOV
+ arg3 tag-bits get SHR
+ ! Compute new stack pointer -- 'dst' for memcpy
+ arg1 arg3 SUB
+ ! Install new stack pointer
+ RSP arg1 MOV
+ ! Call memcpy; arguments are now in the correct registers
+ ! Create register shadow area for Win64
+ RSP 32 SUB
+ "factor_memcpy" jit-call
+ ! Tear down register shadow area
+ RSP 32 ADD
+ ! Return with new callstack
+ 0 RET
+] \ set-callstack define-sub-primitive
+
+[
+ jit-save-context
+ arg2 vm-reg MOV
+ "lazy_jit_compile" jit-call
+ arg1 return-reg MOV
+]
+[ return-reg quot-entry-point-offset [+] CALL ]
+[ jit-jump-quot ]
+\ lazy-jit-compile define-combinator-primitive
+
+[
+ temp2 0xffffffff MOV f rc-absolute-cell rel-literal
+ temp1 temp2 CMP
+] pic-check-tuple jit-define
+
+! Inline cache miss entry points
+: jit-load-return-address ( -- )
+ RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-save-context
+ arg1 RBX MOV
+ arg2 vm-reg MOV
+ RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
+ RAX CALL
+ jit-load-context
+ jit-restore-context ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ RAX CALL ]
+[ RAX JMP ]
+\ inline-cache-miss define-combinator-primitive
+
+[ jit-inline-cache-miss ]
+[ RAX CALL ]
+[ RAX JMP ]
+\ inline-cache-miss-tail define-combinator-primitive
+
+! Overflowing fixnum arithmetic
+: jit-overflow ( insn func -- )
+ ds-reg 8 SUB
+ jit-save-context
+ arg1 ds-reg [] MOV
+ arg2 ds-reg 8 [+] MOV
+ arg3 arg1 MOV
+ [ [ arg3 arg2 ] dip call ] dip
+ ds-reg [] arg3 MOV
+ [ JNO ]
+ [ arg3 vm-reg MOV jit-call ]
+ jit-conditional ; inline
+
+[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ ds-reg 8 SUB
+ jit-save-context
+ RCX ds-reg [] MOV
+ RBX ds-reg 8 [+] MOV
+ RBX tag-bits get SAR
+ RAX RCX MOV
+ RBX IMUL
+ ds-reg [] RAX MOV
+ [ JNO ]
+ [
+ arg1 RCX MOV
+ arg1 tag-bits get SAR
+ arg2 RBX MOV
+ arg3 vm-reg MOV
+ "overflow_fixnum_multiply" jit-call
+ ]
+ jit-conditional
+] \ fixnum* define-sub-primitive
+
+! Contexts
+: jit-switch-context ( reg -- )
+ ! Push a bogus return address so the GC can track this frame back
+ ! to the owner
+ 0 CALL
+
+ ! Make the new context the current one
+ ctx-reg swap MOV
+ vm-reg vm-context-offset [+] ctx-reg MOV
+
+ ! Load new stack pointer
+ RSP ctx-reg context-callstack-top-offset [+] MOV
+
+ ! Load new ds, rs registers
+ jit-restore-context
+
+ ctx-reg jit-update-tib ;
+
+: jit-pop-context-and-param ( -- )
+ arg1 ds-reg [] MOV
+ arg1 arg1 alien-offset [+] MOV
+ arg2 ds-reg -8 [+] MOV
+ ds-reg 16 SUB ;
+
+: jit-push-param ( -- )
+ ds-reg 8 ADD
+ ds-reg [] arg2 MOV ;
+
+: jit-set-context ( -- )
+ jit-pop-context-and-param
+ jit-save-context
+ arg1 jit-switch-context
+ RSP 8 ADD
+ jit-push-param ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-pop-quot-and-param ( -- )
+ arg1 ds-reg [] MOV
+ arg2 ds-reg -8 [+] MOV
+ ds-reg 16 SUB ;
+
+: jit-start-context ( -- )
+ ! Create the new context in return-reg. Have to save context
+ ! twice, first before calling new_context() which may GC,
+ ! and again after popping the two parameters from the stack.
+ jit-save-context
+ arg1 vm-reg MOV
+ "new_context" jit-call
+
+ jit-pop-quot-and-param
+ jit-save-context
+ return-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+ jit-load-context
+ arg1 vm-reg MOV
+ arg2 ctx-reg MOV
+ "delete_context" jit-call ;
+
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+: jit-start-context-and-delete ( -- )
+ jit-load-context
+ arg1 vm-reg MOV
+ arg2 ctx-reg MOV
+ "reset_context" jit-call
+
+ jit-pop-quot-and-param
+ ctx-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[
+ 0 [RIP+] EAX MOV rc-relative rel-safepoint
+] \ jit-safepoint jit-define
+
+[
+ jit-start-context-and-delete
+] \ (start-context-and-delete) define-sub-primitive
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private cpu.x86.assembler
+cpu.x86.assembler.operands kernel layouts namespaces parser
+sequences system vocabs ;
+IN: bootstrap.x86
+
+: leaf-stack-frame-size ( -- n ) 2 bootstrap-cells ;
+: signal-handler-stack-frame-size ( -- n ) 20 bootstrap-cells ;
+: stack-frame-size ( -- n ) 4 bootstrap-cells ;
+: nv-regs ( -- seq ) { RBX R12 R13 R14 R15 } ;
+: volatile-regs ( -- seq ) { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
+
+! The first four parameter registers according to the Unix 64bit
+! calling convention.
+: arg1 ( -- reg ) RDI ;
+: arg2 ( -- reg ) RSI ;
+: arg3 ( -- reg ) RDX ;
+: arg4 ( -- reg ) RCX ;
+: red-zone-size ( -- n ) 128 ;
+
+<< "vocab:bootstrap/assembler/x86.unix.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.64.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.factor" parse-file suffix! >> call
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel namespaces system layouts
+vocabs sequences cpu.x86.assembler parser
+cpu.x86.assembler.operands ;
+IN: bootstrap.x86
+
+DEFER: stack-reg
+
+: leaf-stack-frame-size ( -- n ) 2 bootstrap-cells ;
+: signal-handler-stack-frame-size ( -- n ) 24 bootstrap-cells ;
+: stack-frame-size ( -- n ) 8 bootstrap-cells ;
+: nv-regs ( -- seq ) { RBX RSI RDI R12 R13 R14 R15 } ;
+: volatile-regs ( -- seq ) { RAX RCX RDX R8 R9 R10 R11 } ;
+: arg1 ( -- reg ) RCX ;
+: arg2 ( -- reg ) RDX ;
+: arg3 ( -- reg ) R8 ;
+: arg4 ( -- reg ) R9 ;
+
+: tib-segment ( -- ) GS ;
+: tib-temp ( -- reg ) R11 ;
+
+: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
+: jit-update-seh ( ctx-reg -- ) drop ;
+
+: red-zone-size ( -- n ) 0 ;
+
+<< "vocab:bootstrap/assembler/x86.windows.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.64.factor" parse-file suffix! >> call
+<< "vocab:bootstrap/assembler/x86.factor" parse-file suffix! >> call
--- /dev/null
+! Copyright (C) 2007, 2011 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private compiler.constants
+compiler.codegen.relocation compiler.units cpu.x86.assembler
+cpu.x86.assembler.operands kernel kernel.private layouts
+locals locals.backend make math math.private namespaces sequences
+slots.private strings.private vocabs ;
+IN: bootstrap.x86
+
+big-endian off
+
+! C to Factor entry point
+[
+ ! Optimizing compiler's side of callback accesses
+ ! arguments that are on the stack via the frame pointer.
+ ! On x86-32 fastcall, and x86-64, some arguments are passed
+ ! in registers, and so the only registers that are safe for
+ ! use here are frame-reg, nv-reg and vm-reg.
+ frame-reg PUSH
+ frame-reg stack-reg MOV
+
+ ! Save all non-volatile registers
+ nv-regs [ PUSH ] each
+
+ jit-save-tib
+
+ ! Load VM into vm-reg
+ vm-reg 0 MOV 0 rc-absolute-cell rel-vm
+
+ ! Save old context
+ nv-reg vm-reg vm-context-offset [+] MOV
+ nv-reg PUSH
+
+ ! Switch over to the spare context
+ nv-reg vm-reg vm-spare-context-offset [+] MOV
+ vm-reg vm-context-offset [+] nv-reg MOV
+
+ ! Save C callstack pointer
+ nv-reg context-callstack-save-offset [+] stack-reg MOV
+
+ ! Load Factor stack pointers
+ stack-reg nv-reg context-callstack-bottom-offset [+] MOV
+ nv-reg jit-update-tib
+ jit-install-seh
+
+ rs-reg nv-reg context-retainstack-offset [+] MOV
+ ds-reg nv-reg context-datastack-offset [+] MOV
+
+ ! Call into Factor code
+ link-reg 0 MOV f rc-absolute-cell rel-word
+ link-reg CALL
+
+ ! Load VM into vm-reg; only needed on x86-32, but doesn't
+ ! hurt on x86-64
+ vm-reg 0 MOV 0 rc-absolute-cell rel-vm
+
+ ! Load C callstack pointer
+ nv-reg vm-reg vm-context-offset [+] MOV
+ stack-reg nv-reg context-callstack-save-offset [+] MOV
+
+ ! Load old context
+ nv-reg POP
+ vm-reg vm-context-offset [+] nv-reg MOV
+
+ ! Restore non-volatile registers
+ jit-restore-tib
+
+ nv-regs <reversed> [ POP ] each
+
+ frame-reg POP
+
+ ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
+ ! need a parameter here.
+
+ ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
+ 0xffff RET f rc-absolute-2 rel-untagged
+] callback-stub jit-define
+
+[
+ ! load literal
+ temp0 0 MOV f rc-absolute-cell rel-literal
+ ! increment datastack pointer
+ ds-reg bootstrap-cell ADD
+ ! store literal on datastack
+ ds-reg [] temp0 MOV
+] jit-push jit-define
+
+[
+ 0 CALL f rc-relative rel-word-pic
+] jit-word-call jit-define
+
+! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp
+! not to trigger generation of a stack frame, so they can
+! peform their own prolog/epilog preserving registers.
+
+: jit-signal-handler-prolog ( -- )
+ ! minus a cell each for flags, return address
+ ! use LEA so we don't dirty flags
+ stack-reg stack-reg signal-handler-stack-frame-size
+ 2 bootstrap-cells - neg [+] LEA
+
+ signal-handler-save-regs
+ [| r i | stack-reg i bootstrap-cells [+] r MOV ] each-index
+
+ PUSHF
+
+ jit-load-vm ;
+
+: jit-signal-handler-epilog ( -- )
+ POPF
+
+ signal-handler-save-regs
+ [| r i | r stack-reg i bootstrap-cells [+] MOV ] each-index
+
+ stack-reg stack-reg signal-handler-stack-frame-size
+ 2 bootstrap-cells - [+] LEA ;
+
+[| |
+ jit-signal-handler-prolog
+ jit-save-context
+ temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
+ temp0 CALL
+ jit-signal-handler-epilog
+ 0 RET
+] \ signal-handler define-sub-primitive
+
+[| |
+ jit-signal-handler-prolog
+ jit-save-context
+ temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
+ temp0 CALL
+ jit-signal-handler-epilog
+ ! Pop the fake leaf frame along with our return address
+ leaf-stack-frame-size bootstrap-cell - RET
+] \ leaf-signal-handler define-sub-primitive
+
+[| |
+ jit-signal-handler-prolog
+ temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
+ temp0 CALL
+ jit-signal-handler-epilog
+ red-zone-size RET
+] \ ffi-signal-handler define-sub-primitive
+
+[| |
+ jit-signal-handler-prolog
+ temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
+ temp0 CALL
+ jit-signal-handler-epilog
+ red-zone-size 16 bootstrap-cell - + RET
+] \ ffi-leaf-signal-handler define-sub-primitive
+
+[
+ ! load boolean
+ temp0 ds-reg [] MOV
+ ! pop boolean
+ ds-reg bootstrap-cell SUB
+ ! compare boolean with f
+ temp0 \ f type-number CMP
+ ! jump to true branch if not equal
+ 0 JNE f rc-relative rel-word
+ ! jump to false branch if equal
+ 0 JMP f rc-relative rel-word
+] jit-if jit-define
+
+: jit->r ( -- )
+ rs-reg bootstrap-cell ADD
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ rs-reg [] temp0 MOV ;
+
+: jit-2>r ( -- )
+ rs-reg 2 bootstrap-cells ADD
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ ds-reg 2 bootstrap-cells SUB
+ rs-reg [] temp0 MOV
+ rs-reg -1 bootstrap-cells [+] temp1 MOV ;
+
+: jit-3>r ( -- )
+ rs-reg 3 bootstrap-cells ADD
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ temp2 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg 3 bootstrap-cells SUB
+ rs-reg [] temp0 MOV
+ rs-reg -1 bootstrap-cells [+] temp1 MOV
+ rs-reg -2 bootstrap-cells [+] temp2 MOV ;
+
+: jit-r> ( -- )
+ ds-reg bootstrap-cell ADD
+ temp0 rs-reg [] MOV
+ rs-reg bootstrap-cell SUB
+ ds-reg [] temp0 MOV ;
+
+: jit-2r> ( -- )
+ ds-reg 2 bootstrap-cells ADD
+ temp0 rs-reg [] MOV
+ temp1 rs-reg -1 bootstrap-cells [+] MOV
+ rs-reg 2 bootstrap-cells SUB
+ ds-reg [] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp1 MOV ;
+
+: jit-3r> ( -- )
+ ds-reg 3 bootstrap-cells ADD
+ temp0 rs-reg [] MOV
+ temp1 rs-reg -1 bootstrap-cells [+] MOV
+ temp2 rs-reg -2 bootstrap-cells [+] MOV
+ rs-reg 3 bootstrap-cells SUB
+ ds-reg [] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp1 MOV
+ ds-reg -2 bootstrap-cells [+] temp2 MOV ;
+
+[
+ jit->r
+ 0 CALL f rc-relative rel-word
+ jit-r>
+] jit-dip jit-define
+
+[
+ jit-2>r
+ 0 CALL f rc-relative rel-word
+ jit-2r>
+] jit-2dip jit-define
+
+[
+ jit-3>r
+ 0 CALL f rc-relative rel-word
+ jit-3r>
+] jit-3dip jit-define
+
+[
+ ! load from stack
+ temp0 ds-reg [] MOV
+ ! pop stack
+ ds-reg bootstrap-cell SUB
+]
+[ temp0 word-entry-point-offset [+] CALL ]
+[ temp0 word-entry-point-offset [+] JMP ]
+\ (execute) define-combinator-primitive
+
+[
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ temp0 word-entry-point-offset [+] JMP
+] jit-execute jit-define
+
+[
+ stack-reg stack-frame-size bootstrap-cell - SUB
+] jit-prolog jit-define
+
+[
+ stack-reg stack-frame-size bootstrap-cell - ADD
+] jit-epilog jit-define
+
+[ 0 RET ] jit-return jit-define
+
+! ! ! Polymorphic inline caches
+
+! The PIC stubs are not permitted to touch pic-tail-reg.
+
+! Load a value from a stack position
+[
+ temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged
+] pic-load jit-define
+
+[ temp1 tag-mask get AND ] pic-tag jit-define
+
+[
+ temp0 temp1 MOV
+ temp1 tag-mask get AND
+ temp1 tuple type-number CMP
+ [ JNE ]
+ [ temp1 temp0 tuple-class-offset [+] MOV ]
+ jit-conditional
+] pic-tuple jit-define
+
+[
+ temp1 0x7f CMP f rc-absolute-1 rel-untagged
+] pic-check-tag jit-define
+
+[ 0 JE f rc-relative rel-word ] pic-hit jit-define
+
+! ! ! Megamorphic caches
+
+[
+ ! class = ...
+ temp0 temp1 MOV
+ temp1 tag-mask get AND
+ temp1 tag-bits get SHL
+ temp1 tuple type-number tag-fixnum CMP
+ [ JNE ]
+ [ temp1 temp0 tuple-class-offset [+] MOV ]
+ jit-conditional
+ ! cache = ...
+ temp0 0 MOV f rc-absolute-cell rel-literal
+ ! key = hashcode(class)
+ temp2 temp1 MOV
+ bootstrap-cell 4 = [ temp2 1 SHR ] when
+ ! key &= cache.length - 1
+ temp2 mega-cache-size get 1 - bootstrap-cell * AND
+ ! cache += array-start-offset
+ temp0 array-start-offset ADD
+ ! cache += key
+ temp0 temp2 ADD
+ ! if(get(cache) == class)
+ temp0 [] temp1 CMP
+ [ JNE ]
+ [
+ ! megamorphic_cache_hits++
+ temp1 0 MOV rc-absolute-cell rel-megamorphic-cache-hits
+ temp1 [] 1 ADD
+ ! goto get(cache + bootstrap-cell)
+ temp0 temp0 bootstrap-cell [+] MOV
+ temp0 word-entry-point-offset [+] JMP
+ ! fall-through on miss
+ ] jit-conditional
+] mega-lookup jit-define
+
+! ! ! Sub-primitives
+
+! Objects
+[
+ ! load from stack
+ temp0 ds-reg [] MOV
+ ! compute tag
+ temp0 tag-mask get AND
+ ! tag the tag
+ temp0 tag-bits get SHL
+ ! push to stack
+ ds-reg [] temp0 MOV
+] \ tag define-sub-primitive
+
+[
+ ! load slot number
+ temp0 ds-reg [] MOV
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! load object
+ temp1 ds-reg [] MOV
+ ! turn slot number into offset
+ fixnum>slot@
+ ! mask off tag
+ temp1 tag-bits get SHR
+ temp1 tag-bits get SHL
+ ! load slot value
+ temp0 temp1 temp0 [+] MOV
+ ! push to stack
+ ds-reg [] temp0 MOV
+] \ slot define-sub-primitive
+
+[
+ ! load string index from stack
+ temp0 ds-reg bootstrap-cell neg [+] MOV
+ temp0 tag-bits get SHR
+ ! load string from stack
+ temp1 ds-reg [] MOV
+ ! load character
+ temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
+ temp0 temp0 8-bit-version-of MOVZX
+ temp0 tag-bits get SHL
+ ! store character to stack
+ ds-reg bootstrap-cell SUB
+ ds-reg [] temp0 MOV
+] \ string-nth-fast define-sub-primitive
+
+! Shufflers
+[
+ ds-reg bootstrap-cell SUB
+] \ drop define-sub-primitive
+
+[
+ ds-reg 2 bootstrap-cells SUB
+] \ 2drop define-sub-primitive
+
+[
+ ds-reg 3 bootstrap-cells SUB
+] \ 3drop define-sub-primitive
+
+[
+ ds-reg 4 bootstrap-cells SUB
+] \ 4drop define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell ADD
+ ds-reg [] temp0 MOV
+] \ dup define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg bootstrap-cell neg [+] MOV
+ ds-reg 2 bootstrap-cells ADD
+ ds-reg [] temp0 MOV
+ ds-reg bootstrap-cell neg [+] temp1 MOV
+] \ 2dup define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ temp3 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg 3 bootstrap-cells ADD
+ ds-reg [] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp1 MOV
+ ds-reg -2 bootstrap-cells [+] temp3 MOV
+] \ 3dup define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ temp2 ds-reg -2 bootstrap-cells [+] MOV
+ temp3 ds-reg -3 bootstrap-cells [+] MOV
+ ds-reg 4 bootstrap-cells ADD
+ ds-reg [] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp1 MOV
+ ds-reg -2 bootstrap-cells [+] temp2 MOV
+ ds-reg -3 bootstrap-cells [+] temp3 MOV
+] \ 4dup define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ ds-reg [] temp0 MOV
+] \ nip define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ ds-reg 2 bootstrap-cells SUB
+ ds-reg [] temp0 MOV
+] \ 2nip define-sub-primitive
+
+[
+ temp0 ds-reg -1 bootstrap-cells [+] MOV
+ ds-reg bootstrap-cell ADD
+ ds-reg [] temp0 MOV
+] \ over define-sub-primitive
+
+[
+ temp0 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg bootstrap-cell ADD
+ ds-reg [] temp0 MOV
+] \ pick define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ ds-reg [] temp1 MOV
+ ds-reg bootstrap-cell ADD
+ ds-reg [] temp0 MOV
+] \ dupd define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg bootstrap-cell neg [+] MOV
+ ds-reg bootstrap-cell neg [+] temp0 MOV
+ ds-reg [] temp1 MOV
+] \ swap define-sub-primitive
+
+[
+ temp0 ds-reg -1 bootstrap-cells [+] MOV
+ temp1 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg -2 bootstrap-cells [+] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp1 MOV
+] \ swapd define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ temp3 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg -2 bootstrap-cells [+] temp1 MOV
+ ds-reg -1 bootstrap-cells [+] temp0 MOV
+ ds-reg [] temp3 MOV
+] \ rot define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ temp1 ds-reg -1 bootstrap-cells [+] MOV
+ temp3 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg -2 bootstrap-cells [+] temp0 MOV
+ ds-reg -1 bootstrap-cells [+] temp3 MOV
+ ds-reg [] temp1 MOV
+] \ -rot define-sub-primitive
+
+[ jit->r ] \ load-local define-sub-primitive
+
+! Comparisons
+: jit-compare ( insn -- )
+ ! load t
+ temp3 0 MOV t rc-absolute-cell rel-literal
+ ! load f
+ temp1 \ f type-number MOV
+ ! load first value
+ temp0 ds-reg [] MOV
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! compare with second value
+ ds-reg [] temp0 CMP
+ ! move t if true
+ [ temp1 temp3 ] dip execute( dst src -- )
+ ! store
+ ds-reg [] temp1 MOV ;
+
+: define-jit-compare ( insn word -- )
+ [ [ jit-compare ] curry ] dip define-sub-primitive ;
+
+\ CMOVE \ eq? define-jit-compare
+\ CMOVGE \ fixnum>= define-jit-compare
+\ CMOVLE \ fixnum<= define-jit-compare
+\ CMOVG \ fixnum> define-jit-compare
+\ CMOVL \ fixnum< define-jit-compare
+
+! Math
+: jit-math ( insn -- )
+ ! load second input
+ temp0 ds-reg [] MOV
+ ! pop stack
+ ds-reg bootstrap-cell SUB
+ ! compute result
+ [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
+
+[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
+
+[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
+
+[
+ ! load second input
+ temp0 ds-reg [] MOV
+ ! pop stack
+ ds-reg bootstrap-cell SUB
+ ! load first input
+ temp1 ds-reg [] MOV
+ ! untag second input
+ temp0 tag-bits get SAR
+ ! multiply
+ temp0 temp1 IMUL2
+ ! push result
+ ds-reg [] temp0 MOV
+] \ fixnum*fast define-sub-primitive
+
+[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
+
+[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
+
+[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
+
+[
+ ! complement
+ ds-reg [] NOT
+ ! clear tag bits
+ ds-reg [] tag-mask get XOR
+] \ fixnum-bitnot define-sub-primitive
+
+[
+ ! load shift count
+ shift-arg ds-reg [] MOV
+ ! untag shift count
+ shift-arg tag-bits get SAR
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! load value
+ temp3 ds-reg [] MOV
+ ! make a copy
+ temp2 temp3 MOV
+ ! compute positive shift value in temp2
+ temp2 CL SHL
+ shift-arg NEG
+ ! compute negative shift value in temp3
+ temp3 CL SAR
+ temp3 tag-mask get bitnot AND
+ shift-arg 0 CMP
+ ! if shift count was negative, move temp0 to temp2
+ temp2 temp3 CMOVGE
+ ! push to stack
+ ds-reg [] temp2 MOV
+] \ fixnum-shift-fast define-sub-primitive
+
+: jit-fixnum-/mod ( -- )
+ ! load second parameter
+ temp1 ds-reg [] MOV
+ ! load first parameter
+ div-arg ds-reg bootstrap-cell neg [+] MOV
+ ! make a copy
+ mod-arg div-arg MOV
+ ! sign-extend
+ mod-arg bootstrap-cell-bits 1 - SAR
+ ! divide
+ temp1 IDIV ;
+
+[
+ jit-fixnum-/mod
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! push to stack
+ ds-reg [] mod-arg MOV
+] \ fixnum-mod define-sub-primitive
+
+[
+ jit-fixnum-/mod
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! tag it
+ div-arg tag-bits get SHL
+ ! push to stack
+ ds-reg [] div-arg MOV
+] \ fixnum/i-fast define-sub-primitive
+
+[
+ jit-fixnum-/mod
+ ! tag it
+ div-arg tag-bits get SHL
+ ! push to stack
+ ds-reg [] mod-arg MOV
+ ds-reg bootstrap-cell neg [+] div-arg MOV
+] \ fixnum/mod-fast define-sub-primitive
+
+[
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ temp0 ds-reg [] OR
+ temp0 tag-mask get TEST
+ temp0 \ f type-number MOV
+ temp1 1 tag-fixnum MOV
+ temp0 temp1 CMOVE
+ ds-reg [] temp0 MOV
+] \ both-fixnums? define-sub-primitive
+
+[
+ ! load local number
+ temp0 ds-reg [] MOV
+ ! turn local number into offset
+ fixnum>slot@
+ ! load local value
+ temp0 rs-reg temp0 [+] MOV
+ ! push to stack
+ ds-reg [] temp0 MOV
+] \ get-local define-sub-primitive
+
+[
+ ! load local count
+ temp0 ds-reg [] MOV
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! turn local number into offset
+ fixnum>slot@
+ ! decrement retain stack pointer
+ rs-reg temp0 SUB
+] \ drop-locals define-sub-primitive
+
+[ "bootstrap.x86" forget-vocab ] with-compilation-unit
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cpu.x86.assembler cpu.x86.assembler.operands kernel
+layouts ;
+IN: bootstrap.x86
+
+DEFER: stack-reg
+
+: jit-save-tib ( -- ) ;
+: jit-restore-tib ( -- ) ;
+: jit-update-tib ( ctx-reg -- ) drop ;
+: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
+: jit-update-seh ( ctx-reg -- ) drop ;
--- /dev/null
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private compiler.constants
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts
+locals parser sequences ;
+IN: bootstrap.x86
+
+: tib-exception-list-offset ( -- n ) 0 bootstrap-cells ;
+: tib-stack-base-offset ( -- n ) 1 bootstrap-cells ;
+: tib-stack-limit-offset ( -- n ) 2 bootstrap-cells ;
+
+: jit-save-tib ( -- )
+ tib-exception-list-offset [] tib-segment PUSH
+ tib-stack-base-offset [] tib-segment PUSH
+ tib-stack-limit-offset [] tib-segment PUSH ;
+
+: jit-restore-tib ( -- )
+ tib-stack-limit-offset [] tib-segment POP
+ tib-stack-base-offset [] tib-segment POP
+ tib-exception-list-offset [] tib-segment POP ;
+
+:: jit-update-tib ( ctx-reg -- )
+ ! There's a redundant load here because we're not allowed
+ ! to clobber ctx-reg. Clobbers tib-temp.
+ ! Save callstack base in TIB
+ tib-temp ctx-reg context-callstack-seg-offset [+] MOV
+ tib-temp tib-temp segment-end-offset [+] MOV
+ tib-stack-base-offset [] tib-temp tib-segment MOV
+ ! Save callstack limit in TIB
+ tib-temp ctx-reg context-callstack-seg-offset [+] MOV
+ tib-temp tib-temp segment-start-offset [+] MOV
+ tib-stack-limit-offset [] tib-temp tib-segment MOV ;
+++ /dev/null
-! Copyright (C) 2011 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: parser system kernel sequences math math.ranges
-cpu.ppc.assembler combinators compiler.constants
-bootstrap.image.private layouts namespaces ;
-IN: bootstrap.ppc
-
-4 \ cell set
-big-endian on
-
-: reserved-size ( -- n ) 24 ;
-: lr-save ( -- n ) 4 ;
-
-CONSTANT: ds-reg 14
-CONSTANT: rs-reg 15
-CONSTANT: vm-reg 16
-CONSTANT: ctx-reg 17
-CONSTANT: frame-reg 31
-: nv-int-regs ( -- seq ) 13 31 [a,b] ;
-
-: LOAD32 ( r n -- )
- [ -16 shift 0xffff bitand LIS ]
- [ [ dup ] dip 0xffff bitand ORI ] 2bi ;
-
-: jit-trap-null ( src -- ) drop ;
-: jit-load-vm ( dst -- )
- 0 LOAD32 0 rc-absolute-ppc-2/2 jit-vm ;
-: jit-load-dlsym ( dst string -- )
- [ 0 LOAD32 ] dip rc-absolute-ppc-2/2 jit-dlsym ;
-: jit-load-dlsym-toc ( string -- ) drop ;
-: jit-load-vm-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel ;
-: jit-load-entry-point-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel ;
-: jit-load-this-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel ;
-: jit-load-literal-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel ;
-: jit-load-dlsym-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel ;
-: jit-load-dlsym-toc-arg ( -- ) ;
-: jit-load-here-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel ;
-: jit-load-megamorphic-cache-arg ( dst -- )
- 0 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel ;
-: jit-load-cell ( dst src offset -- ) LWZ ;
-: jit-load-cell-x ( dst src offset -- ) LWZX ;
-: jit-load-cell-update ( dst src offset -- ) LWZU ;
-: jit-save-cell ( dst src offset -- ) STW ;
-: jit-save-cell-x ( dst src offset -- ) STWX ;
-: jit-save-cell-update ( dst src offset -- ) STWU ;
-: jit-load-int ( dst src offset -- ) LWZ ;
-: jit-save-int ( dst src offset -- ) STW ;
-: jit-shift-tag-bits ( dst src -- ) tag-bits get SRAWI ;
-: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRWI ;
-: jit-shift-fixnum-slot ( dst src -- ) 2 SRAWI ;
-: jit-class-hashcode ( dst src -- ) 1 SRAWI ;
-: jit-shift-left-logical ( dst src n -- ) SLW ;
-: jit-shift-left-logical-imm ( dst src n -- ) SLWI ;
-: jit-shift-right-algebraic ( dst src n -- ) SRAW ;
-: jit-divide ( dst ra rb -- ) DIVW ;
-: jit-multiply-low ( dst ra rb -- ) MULLW ;
-: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLWO. ;
-: jit-compare-cell ( cr ra rb -- ) CMPW ;
-: jit-compare-cell-imm ( cr ra imm -- ) CMPWI ;
-
-: cell-size ( -- n ) 4 ;
-: factor-area-size ( -- n ) 16 ;
-: param-size ( -- n ) 32 ;
-: saved-int-regs-size ( -- n ) 96 ;
-
-<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
-call
+++ /dev/null
-! Copyright (C) 2011 Erik Charlebois.
-! See http://factorcode.org/license.txt for BSD license.
-USING: parser system kernel sequences math math.ranges
-cpu.ppc.assembler combinators compiler.constants
-bootstrap.image.private layouts namespaces ;
-IN: bootstrap.ppc
-
-8 \ cell set
-big-endian on
-
-: reserved-size ( -- n ) 48 ;
-: lr-save ( -- n ) 16 ;
-
-CONSTANT: ds-reg 14
-CONSTANT: rs-reg 15
-CONSTANT: vm-reg 16
-CONSTANT: ctx-reg 17
-CONSTANT: frame-reg 31
-: nv-int-regs ( -- seq ) 13 31 [a,b] ;
-
-: LOAD64 ( r n -- )
- [ dup ] dip {
- [ nip -48 shift 0xffff bitand LIS ]
- [ -32 shift 0xffff bitand ORI ]
- [ drop 32 SLDI ]
- [ -16 shift 0xffff bitand ORIS ]
- [ 0xffff bitand ORI ]
- } 3cleave ;
-
-: jit-trap-null ( src -- ) drop ;
-: jit-load-vm ( dst -- )
- 0 LOAD64 0 rc-absolute-ppc-2/2/2/2 jit-vm ;
-: jit-load-dlsym ( dst string -- )
- [ 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym ;
-: jit-load-dlsym-toc ( string -- )
- [ 2 0 LOAD64 ] dip rc-absolute-ppc-2/2/2/2 jit-dlsym-toc ;
-: jit-load-vm-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-vm jit-rel ;
-: jit-load-entry-point-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-entry-point jit-rel ;
-: jit-load-this-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-this jit-rel ;
-: jit-load-literal-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-literal jit-rel ;
-: jit-load-dlsym-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym jit-rel ;
-: jit-load-dlsym-toc-arg ( -- )
- 2 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-dlsym-toc jit-rel ;
-: jit-load-here-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-here jit-rel ;
-: jit-load-megamorphic-cache-arg ( dst -- )
- 0 LOAD64 rc-absolute-ppc-2/2/2/2 rt-megamorphic-cache-hits jit-rel ;
-: jit-load-cell ( dst src offset -- ) LD ;
-: jit-load-cell-x ( dst src offset -- ) LDX ;
-: jit-load-cell-update ( dst src offset -- ) LDU ;
-: jit-save-cell ( dst src offset -- ) STD ;
-: jit-save-cell-x ( dst src offset -- ) STDX ;
-: jit-save-cell-update ( dst src offset -- ) STDU ;
-: jit-load-int ( dst src offset -- ) LD ;
-: jit-save-int ( dst src offset -- ) STD ;
-: jit-shift-tag-bits ( dst src -- ) tag-bits get SRADI ;
-: jit-mask-tag-bits ( dst src -- ) tag-bits get CLRRDI ;
-: jit-shift-fixnum-slot ( dst src -- ) 1 SRADI ;
-: jit-class-hashcode ( dst src -- ) 1 SRADI ;
-: jit-shift-left-logical ( dst src n -- ) SLD ;
-: jit-shift-left-logical-imm ( dst src n -- ) SLDI ;
-: jit-shift-right-algebraic ( dst src n -- ) SRAD ;
-: jit-divide ( dst ra rb -- ) DIVD ;
-: jit-multiply-low ( dst ra rb -- ) MULLD ;
-: jit-multiply-low-ov-rc ( dst ra rb -- ) MULLDO. ;
-: jit-compare-cell ( cr ra rb -- ) CMPD ;
-: jit-compare-cell-imm ( cr ra imm -- ) CMPDI ;
-
-: cell-size ( -- n ) 8 ;
-: factor-area-size ( -- n ) 32 ;
-: param-size ( -- n ) 64 ;
-: saved-int-regs-size ( -- n ) 192 ;
-
-<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
-call
+++ /dev/null
-! Copyright (C) 2011 Erik Charlebois
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel kernel.private namespaces
-system cpu.ppc.assembler compiler.units compiler.constants math
-math.private math.ranges layouts words vocabs slots.private
-locals locals.backend generic.single.private fry sequences
-threads.private strings.private ;
-FROM: cpu.ppc.assembler => B ;
-IN: bootstrap.ppc
-
-: jit-call ( string -- )
- dup
- 0 swap jit-load-dlsym
- 0 MTLR
- jit-load-dlsym-toc
- BLRL ;
-
-: jit-call-quot ( -- )
- 4 quot-entry-point-offset LI
- 4 3 4 jit-load-cell-x
- 4 MTLR
- BLRL ;
-
-: jit-jump-quot ( -- )
- 4 quot-entry-point-offset LI
- 4 3 4 jit-load-cell-x
- 4 MTCTR
- BCTR ;
-
-: stack-frame ( -- n )
- reserved-size factor-area-size + 16 align ;
-
-: save-at ( m -- n ) reserved-size + param-size + ;
-
-: save-int ( reg off -- ) [ 1 ] dip save-at jit-save-int ;
-: save-fp ( reg off -- ) [ 1 ] dip save-at STFD ;
-: save-vec ( reg offt -- ) save-at 11 swap LI 11 1 STVXL ;
-: restore-int ( reg off -- ) [ 1 ] dip save-at jit-load-int ;
-: restore-fp ( reg off -- ) [ 1 ] dip save-at LFD ;
-: restore-vec ( reg offt -- ) save-at 11 swap LI 11 1 LVXL ;
-
-! Stop using intervals here.
-: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
-: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
-
-: saved-fp-regs-size ( -- n ) 144 ;
-: saved-vec-regs-size ( -- n ) 192 ;
-
-: callback-frame-size ( -- n )
- reserved-size
- param-size +
- saved-int-regs-size +
- saved-fp-regs-size +
- saved-vec-regs-size +
- 16 align ;
-
-: old-context-save-offset ( -- n )
- cell-size 20 * saved-fp-regs-size + saved-vec-regs-size + save-at ;
-
-[
- ! Save old stack pointer
- 11 1 MR
-
- 0 MFLR ! Get return address
- 0 1 lr-save jit-save-cell ! Stash return address
- 1 1 callback-frame-size neg jit-save-cell-update ! Bump stack pointer and set back chain
-
- ! Save all non-volatile registers
- nv-int-regs [ cell-size * save-int ] each-index
- nv-fp-regs [ 8 * saved-int-regs-size + save-fp ] each-index
- ! nv-vec-regs [ 16 * saved-int-regs-size saved-fp-regs-size + + save-vec ] each-index
-
- ! Stick old stack pointer in the frame register so callbacks
- ! can access their arguments
- frame-reg 11 MR
-
- ! Load VM into vm-reg
- vm-reg jit-load-vm-arg
-
- ! Save old context
- 0 vm-reg vm-context-offset jit-load-cell
- 0 1 old-context-save-offset jit-save-cell
-
- ! Switch over to the spare context
- 11 vm-reg vm-spare-context-offset jit-load-cell
- 11 vm-reg vm-context-offset jit-save-cell
-
- ! Save C callstack pointer and load Factor callstack
- 1 11 context-callstack-save-offset jit-save-cell
- 1 11 context-callstack-bottom-offset jit-load-cell
-
- ! Load new data and retain stacks
- rs-reg 11 context-retainstack-offset jit-load-cell
- ds-reg 11 context-datastack-offset jit-load-cell
-
- ! Call into Factor code
- 0 jit-load-entry-point-arg
- 0 MTLR
- BLRL
-
- ! Load VM again, pointlessly
- vm-reg jit-load-vm-arg
-
- ! Load C callstack pointer
- 11 vm-reg vm-context-offset jit-load-cell
- 1 11 context-callstack-save-offset jit-load-cell
-
- ! Load old context
- 0 1 old-context-save-offset jit-load-cell
- 0 vm-reg vm-context-offset jit-save-cell
-
- ! Restore non-volatile registers
- ! nv-vec-regs [ 16 * saved-int-regs-size saved-float-regs-size + + restore-vec ] each-index
- nv-fp-regs [ 8 * saved-int-regs-size + restore-fp ] each-index
- nv-int-regs [ cell-size * restore-int ] each-index
-
- 1 1 callback-frame-size ADDI ! Bump stack back up
- 0 1 lr-save jit-load-cell ! Fetch return address
- 0 MTLR ! Set up return
- BLR ! Branch back
-] callback-stub jit-define
-
-: jit-conditional* ( test-quot false-quot -- )
- [ '[ 4 + @ ] ] dip jit-conditional ; inline
-
-: jit-load-context ( -- )
- ctx-reg vm-reg vm-context-offset jit-load-cell ;
-
-: jit-save-context ( -- )
- jit-load-context
- 1 ctx-reg context-callstack-top-offset jit-save-cell
- ds-reg ctx-reg context-datastack-offset jit-save-cell
- rs-reg ctx-reg context-retainstack-offset jit-save-cell ;
-
-: jit-restore-context ( -- )
- ds-reg ctx-reg context-datastack-offset jit-load-cell
- rs-reg ctx-reg context-retainstack-offset jit-load-cell ;
-
-[
- 12 jit-load-literal-arg
- 0 profile-count-offset LI
- 11 12 0 jit-load-cell-x
- 11 11 1 tag-fixnum ADDI
- 11 12 0 jit-save-cell-x
- 0 word-code-offset LI
- 11 12 0 jit-load-cell-x
- 11 11 compiled-header-size ADDI
- 11 MTCTR
- BCTR
-] jit-profiling jit-define
-
-[
- 0 MFLR
- 0 1 lr-save jit-save-cell
- 0 jit-load-this-arg
- 0 1 cell-size 2 * neg jit-save-cell
- 0 stack-frame LI
- 0 1 cell-size 1 * neg jit-save-cell
- 1 1 stack-frame neg jit-save-cell-update
-] jit-prolog jit-define
-
-[
- 3 jit-load-literal-arg
- 3 ds-reg cell-size jit-save-cell-update
-] jit-push jit-define
-
-[
- jit-save-context
- 3 vm-reg MR
- 4 jit-load-dlsym-arg
- 4 MTLR
- jit-load-dlsym-toc-arg ! Restore the TOC/GOT
- BLRL
- jit-restore-context
-] jit-primitive jit-define
-
-[ 0 BL rc-relative-ppc-3-pc rt-entry-point-pic jit-rel ] jit-word-call jit-define
-
-[
- 6 jit-load-here-arg
- 0 B rc-relative-ppc-3-pc rt-entry-point-pic-tail jit-rel
-] jit-word-jump jit-define
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
- 0 3 \ f type-number jit-compare-cell-imm
- [ 0 swap BEQ ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
- 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel
-] jit-if jit-define
-
-: jit->r ( -- )
- 4 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
- 4 rs-reg cell-size jit-save-cell-update ;
-
-: jit-2>r ( -- )
- 4 ds-reg 0 jit-load-cell
- 5 ds-reg cell-size neg jit-load-cell
- ds-reg dup 2 cell-size * SUBI
- rs-reg dup 2 cell-size * ADDI
- 4 rs-reg 0 jit-save-cell
- 5 rs-reg cell-size neg jit-save-cell ;
-
-: jit-3>r ( -- )
- 4 ds-reg 0 jit-load-cell
- 5 ds-reg cell-size neg jit-load-cell
- 6 ds-reg cell-size neg 2 * jit-load-cell
- ds-reg dup 3 cell-size * SUBI
- rs-reg dup 3 cell-size * ADDI
- 4 rs-reg 0 jit-save-cell
- 5 rs-reg cell-size neg jit-save-cell
- 6 rs-reg cell-size neg 2 * jit-save-cell ;
-
-: jit-r> ( -- )
- 4 rs-reg 0 jit-load-cell
- rs-reg dup cell-size SUBI
- 4 ds-reg cell-size jit-save-cell-update ;
-
-: jit-2r> ( -- )
- 4 rs-reg 0 jit-load-cell
- 5 rs-reg cell-size neg jit-load-cell
- rs-reg dup 2 cell-size * SUBI
- ds-reg dup 2 cell-size * ADDI
- 4 ds-reg 0 jit-save-cell
- 5 ds-reg cell-size neg jit-save-cell ;
-
-: jit-3r> ( -- )
- 4 rs-reg 0 jit-load-cell
- 5 rs-reg cell-size neg jit-load-cell
- 6 rs-reg cell-size neg 2 * jit-load-cell
- rs-reg dup 3 cell-size * SUBI
- ds-reg dup 3 cell-size * ADDI
- 4 ds-reg 0 jit-save-cell
- 5 ds-reg cell-size neg jit-save-cell
- 6 ds-reg cell-size neg 2 * jit-save-cell ;
-
-[
- jit->r
- 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
- jit-r>
-] jit-dip jit-define
-
-[
- jit-2>r
- 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
- jit-2r>
-] jit-2dip jit-define
-
-[
- jit-3>r
- 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
- jit-3r>
-] jit-3dip jit-define
-
-[
- 1 1 stack-frame ADDI
- 0 1 lr-save jit-load-cell
- 0 MTLR
-] jit-epilog jit-define
-
-[ BLR ] jit-return jit-define
-
-! ! ! Polymorphic inline caches
-
-! Don't touch r6 here; it's used to pass the tail call site
-! address for tail PICs
-
-! Load a value from a stack position
-[
- 4 ds-reg 0 jit-load-cell rc-absolute-ppc-2 rt-untagged jit-rel
-] pic-load jit-define
-
-[ 4 4 tag-mask get ANDI. ] pic-tag jit-define
-
-[
- 3 4 MR
- 4 4 tag-mask get ANDI.
- 0 4 tuple type-number jit-compare-cell-imm
- [ 0 swap BNE ]
- [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
- jit-conditional*
-] pic-tuple jit-define
-
-[
- 0 4 0 jit-compare-cell-imm rc-absolute-ppc-2 rt-untagged jit-rel
-] pic-check-tag jit-define
-
-[
- 5 jit-load-literal-arg
- 0 4 5 jit-compare-cell
-] pic-check-tuple jit-define
-
-[
- [ 0 swap BNE ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
-] pic-hit jit-define
-
-! Inline cache miss entry points
-: jit-load-return-address ( -- ) 6 MFLR ;
-
-! These are always in tail position with an existing stack
-! frame, and the stack. The frame setup takes this into account.
-: jit-inline-cache-miss ( -- )
- jit-save-context
- 3 6 MR
- 4 vm-reg MR
- ctx-reg 6 MR
- "inline_cache_miss" jit-call
- 6 ctx-reg MR
- jit-load-context
- jit-restore-context ;
-
-[ jit-load-return-address jit-inline-cache-miss ]
-[ 3 MTLR BLRL ]
-[ 3 MTCTR BCTR ]
-\ inline-cache-miss define-combinator-primitive
-
-[ jit-inline-cache-miss ]
-[ 3 MTLR BLRL ]
-[ 3 MTCTR BCTR ]
-\ inline-cache-miss-tail define-combinator-primitive
-
-! ! ! Megamorphic caches
-
-[
- ! class = ...
- 3 4 MR
- 4 4 tag-mask get ANDI. ! Mask and...
- 4 4 tag-bits get jit-shift-left-logical-imm ! shift tag bits to fixnum
- 0 4 tuple type-number tag-fixnum jit-compare-cell-imm
- [ 0 swap BNE ]
- [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
- jit-conditional*
- ! cache = ...
- 3 jit-load-literal-arg
- ! key = hashcode(class)
- 5 4 jit-class-hashcode
- ! key &= cache.length - 1
- 5 5 mega-cache-size get 1 - 4 * ANDI.
- ! cache += array-start-offset
- 3 3 array-start-offset ADDI
- ! cache += key
- 3 3 5 ADD
- ! if(get(cache) == class)
- 6 3 0 jit-load-cell
- 0 6 4 jit-compare-cell
- [ 0 swap BNE ]
- [
- ! megamorphic_cache_hits++
- 4 jit-load-megamorphic-cache-arg
- 5 4 0 jit-load-cell
- 5 5 1 ADDI
- 5 4 0 jit-save-cell
- ! ... goto get(cache + cell-size)
- 5 word-entry-point-offset LI
- 3 3 cell-size jit-load-cell
- 3 3 5 jit-load-cell-x
- 3 MTCTR
- BCTR
- ]
- jit-conditional*
- ! fall-through on miss
-] mega-lookup jit-define
-
-! ! ! Sub-primitives
-
-! Quotations and words
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
-]
-[ jit-call-quot ]
-[ jit-jump-quot ] \ (call) define-combinator-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
- 4 word-entry-point-offset LI
- 4 3 4 jit-load-cell-x
-]
-[ 4 MTLR BLRL ]
-[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
- 4 word-entry-point-offset LI
- 4 3 4 jit-load-cell-x
- 4 MTCTR BCTR
-] jit-execute jit-define
-
-! Special primitives
-[
- frame-reg 3 MR
-
- 3 vm-reg MR
- "begin_callback" jit-call
-
- jit-load-context
- jit-restore-context
-
- ! Call quotation
- 3 frame-reg MR
- jit-call-quot
-
- jit-save-context
-
- 3 vm-reg MR
- "end_callback" jit-call
-] \ c-to-factor define-sub-primitive
-
-[
- ! Unwind stack frames
- 1 4 MR
-
- ! Load VM pointer into vm-reg, since we're entering from
- ! C code
- vm-reg jit-load-vm
-
- ! Load ds and rs registers
- jit-load-context
- jit-restore-context
-
- ! We have changed the stack; load return address again
- 0 1 lr-save jit-load-cell
- 0 MTLR
-
- ! Call quotation
- jit-jump-quot
-] \ unwind-native-frames define-sub-primitive
-
-[
- 7 0 LI
- 7 1 lr-save jit-save-cell
-
- ! Load callstack object
- 6 ds-reg 0 jit-load-cell
- ds-reg ds-reg cell-size SUBI
- ! Get ctx->callstack_bottom
- jit-load-context
- 3 ctx-reg context-callstack-bottom-offset jit-load-cell
- ! Get top of callstack object -- 'src' for memcpy
- 4 6 callstack-top-offset ADDI
- ! Get callstack length, in bytes --- 'len' for memcpy
- 7 callstack-length-offset LI
- 5 6 7 jit-load-cell-x
- 5 5 jit-shift-tag-bits
- ! Compute new stack pointer -- 'dst' for memcpy
- 3 3 5 SUB
- ! Install new stack pointer
- 1 3 MR
- ! Call memcpy; arguments are now in the correct registers
- 1 1 -16 cell-size * jit-save-cell-update
- "factor_memcpy" jit-call
- 1 1 0 jit-load-cell
- ! Return with new callstack
- 0 1 lr-save jit-load-cell
- 0 MTLR
- BLR
-] \ set-callstack define-sub-primitive
-
-[
- jit-save-context
- 4 vm-reg MR
- "lazy_jit_compile" jit-call
-]
-[ jit-call-quot ]
-[ jit-jump-quot ]
-\ lazy-jit-compile define-combinator-primitive
-
-! Objects
-[
- 3 ds-reg 0 jit-load-cell
- 3 3 tag-mask get ANDI.
- 3 3 tag-bits get jit-shift-left-logical-imm
- 3 ds-reg 0 jit-save-cell
-] \ tag define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell ! Load m
- 4 ds-reg cell-size neg jit-load-cell-update ! Load obj
- 3 3 jit-shift-fixnum-slot ! Shift to a cell-size multiple
- 4 4 jit-mask-tag-bits ! Clear tag bits on obj
- 3 4 3 jit-load-cell-x ! Load cell at &obj[m]
- 3 ds-reg 0 jit-save-cell ! Push the result to the stack
-] \ slot define-sub-primitive
-
-[
- ! load string index from stack
- 3 ds-reg cell-size neg jit-load-cell
- 3 3 jit-shift-tag-bits
- ! load string from stack
- 4 ds-reg 0 jit-load-cell
- ! load character
- 4 4 string-offset ADDI
- 3 3 4 LBZX
- 3 3 tag-bits get jit-shift-left-logical-imm
- ! store character to stack
- ds-reg ds-reg cell-size SUBI
- 3 ds-reg 0 jit-save-cell
-] \ string-nth-fast define-sub-primitive
-
-! Shufflers
-[
- ds-reg dup cell-size SUBI
-] \ drop define-sub-primitive
-
-[
- ds-reg dup 2 cell-size * SUBI
-] \ 2drop define-sub-primitive
-
-[
- ds-reg dup 3 cell-size * SUBI
-] \ 3drop define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 3 ds-reg cell-size jit-save-cell-update
-] \ dup define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- ds-reg dup 2 cell-size * ADDI
- 3 ds-reg 0 jit-save-cell
- 4 ds-reg cell-size neg jit-save-cell
-] \ 2dup define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 5 ds-reg cell-size neg 2 * jit-load-cell
- ds-reg dup cell-size 3 * ADDI
- 3 ds-reg 0 jit-save-cell
- 4 ds-reg cell-size neg jit-save-cell
- 5 ds-reg cell-size neg 2 * jit-save-cell
-] \ 3dup define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size SUBI
- 3 ds-reg 0 jit-save-cell
-] \ nip define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg dup cell-size 2 * SUBI
- 3 ds-reg 0 jit-save-cell
-] \ 2nip define-sub-primitive
-
-[
- 3 ds-reg cell-size neg jit-load-cell
- 3 ds-reg cell-size jit-save-cell-update
-] \ over define-sub-primitive
-
-[
- 3 ds-reg cell-size neg 2 * jit-load-cell
- 3 ds-reg cell-size jit-save-cell-update
-] \ pick define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 4 ds-reg 0 jit-save-cell
- 3 ds-reg cell-size jit-save-cell-update
-] \ dupd define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 3 ds-reg cell-size neg jit-save-cell
- 4 ds-reg 0 jit-save-cell
-] \ swap define-sub-primitive
-
-[
- 3 ds-reg cell-size neg jit-load-cell
- 4 ds-reg cell-size neg 2 * jit-load-cell
- 3 ds-reg cell-size neg 2 * jit-save-cell
- 4 ds-reg cell-size neg jit-save-cell
-] \ swapd define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 5 ds-reg cell-size neg 2 * jit-load-cell
- 4 ds-reg cell-size neg 2 * jit-save-cell
- 3 ds-reg cell-size neg jit-save-cell
- 5 ds-reg 0 jit-save-cell
-] \ rot define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 5 ds-reg cell-size neg 2 * jit-load-cell
- 3 ds-reg cell-size neg 2 * jit-save-cell
- 5 ds-reg cell-size neg jit-save-cell
- 4 ds-reg 0 jit-save-cell
-] \ -rot define-sub-primitive
-
-[ jit->r ] \ load-local define-sub-primitive
-
-! Comparisons
-: jit-compare ( insn -- )
- t jit-literal
- 3 jit-load-literal-arg
- 4 ds-reg 0 jit-load-cell
- 5 ds-reg cell-size neg jit-load-cell-update
- 0 5 4 jit-compare-cell
- [ 0 8 ] dip execute( cr offset -- )
- 3 \ f type-number LI
- 3 ds-reg 0 jit-save-cell ;
-
-: define-jit-compare ( insn word -- )
- [ [ jit-compare ] curry ] dip define-sub-primitive ;
-
-\ BEQ \ eq? define-jit-compare
-\ BGE \ fixnum>= define-jit-compare
-\ BLE \ fixnum<= define-jit-compare
-\ BGT \ fixnum> define-jit-compare
-\ BLT \ fixnum< define-jit-compare
-
-! Math
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg ds-reg cell-size SUBI
- 4 ds-reg 0 jit-load-cell
- 3 3 4 OR
- 3 3 tag-mask get ANDI.
- 4 \ f type-number LI
- 0 3 0 jit-compare-cell-imm
- [ 0 swap BNE ] [ 4 1 tag-fixnum LI ] jit-conditional*
- 4 ds-reg 0 jit-save-cell
-] \ both-fixnums? define-sub-primitive
-
-: jit-math ( insn -- )
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell-update
- [ 5 3 4 ] dip execute( dst src1 src2 -- )
- 5 ds-reg 0 jit-save-cell ;
-
-[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
-
-[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell-update
- 4 4 jit-shift-tag-bits
- 5 3 4 jit-multiply-low
- 5 ds-reg 0 jit-save-cell
-] \ fixnum*fast define-sub-primitive
-
-[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
-
-[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
-
-[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 3 3 NOT
- 3 3 tag-mask get XORI
- 3 ds-reg 0 jit-save-cell
-] \ fixnum-bitnot define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell ! Load amount to shift
- 3 3 jit-shift-tag-bits ! Shift out tag bits
- ds-reg ds-reg cell-size SUBI
- 4 ds-reg 0 jit-load-cell ! Load value to shift
- 5 4 3 jit-shift-left-logical ! Shift left
- 6 3 NEG ! Negate shift amount
- 7 4 6 jit-shift-right-algebraic ! Shift right
- 7 7 jit-mask-tag-bits ! Mask out tag bits
- 0 3 0 jit-compare-cell-imm
- [ 0 swap BGT ] [ 5 7 MR ] jit-conditional*
- 5 ds-reg 0 jit-save-cell
-] \ fixnum-shift-fast define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg ds-reg cell-size SUBI
- 4 ds-reg 0 jit-load-cell
- 5 4 3 jit-divide
- 6 5 3 jit-multiply-low
- 7 4 6 SUB
- 7 ds-reg 0 jit-save-cell
-] \ fixnum-mod define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg ds-reg cell-size SUBI
- 4 ds-reg 0 jit-load-cell
- 5 4 3 jit-divide
- 5 5 tag-bits get jit-shift-left-logical-imm
- 5 ds-reg 0 jit-save-cell
-] \ fixnum/i-fast define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- 5 4 3 jit-divide
- 6 5 3 jit-multiply-low
- 7 4 6 SUB
- 5 5 tag-bits get jit-shift-left-logical-imm
- 5 ds-reg cell-size neg jit-save-cell
- 7 ds-reg 0 jit-save-cell
-] \ fixnum/mod-fast define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- 3 3 jit-shift-fixnum-slot
- 3 rs-reg 3 jit-load-cell-x
- 3 ds-reg 0 jit-save-cell
-] \ get-local define-sub-primitive
-
-[
- 3 ds-reg 0 jit-load-cell
- ds-reg ds-reg cell-size SUBI
- 3 3 jit-shift-fixnum-slot
- rs-reg rs-reg 3 SUB
-] \ drop-locals define-sub-primitive
-
-! Overflowing fixnum arithmetic
-:: jit-overflow ( insn func -- )
- ds-reg ds-reg cell-size SUBI
- jit-save-context
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size jit-load-cell
- 0 0 LI
- 0 MTXER
- 6 4 3 insn call( d a s -- )
- 6 ds-reg 0 jit-save-cell
- [ 0 swap BNS ]
- [
- 5 vm-reg MR
- func jit-call
- ]
- jit-conditional* ;
-
-[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
-
-[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
-
-[
- ds-reg ds-reg cell-size SUBI
- jit-save-context
- 3 ds-reg 0 jit-load-cell
- 3 3 jit-shift-tag-bits
- 4 ds-reg cell-size jit-load-cell
- 0 0 LI
- 0 MTXER
- 6 3 4 jit-multiply-low-ov-rc
- 6 ds-reg 0 jit-save-cell
- [ 0 swap BNS ]
- [
- 4 4 jit-shift-tag-bits
- 5 vm-reg MR
- "overflow_fixnum_multiply" jit-call
- ]
- jit-conditional*
-] \ fixnum* define-sub-primitive
-
-! Contexts
-:: jit-switch-context ( reg -- )
- 7 0 LI
- 7 1 lr-save jit-save-cell
-
- ! Make the new context the current one
- ctx-reg reg MR
- ctx-reg vm-reg vm-context-offset jit-save-cell
-
- ! Load new stack pointer
- 1 ctx-reg context-callstack-top-offset jit-load-cell
-
- ! Load new ds, rs registers
- jit-restore-context ;
-
-: jit-pop-context-and-param ( -- )
- 3 ds-reg 0 jit-load-cell
- 4 alien-offset LI
- 3 3 4 jit-load-cell-x
- 4 ds-reg cell-size neg jit-load-cell
- ds-reg ds-reg cell-size 2 * SUBI ;
-
-: jit-push-param ( -- )
- ds-reg ds-reg cell-size ADDI
- 4 ds-reg 0 jit-save-cell ;
-
-: jit-set-context ( -- )
- jit-pop-context-and-param
- jit-save-context
- 3 jit-switch-context
- jit-push-param ;
-
-[ jit-set-context ] \ (set-context) define-sub-primitive
-
-: jit-pop-quot-and-param ( -- )
- 3 ds-reg 0 jit-load-cell
- 4 ds-reg cell-size neg jit-load-cell
- ds-reg ds-reg cell-size 2 * SUBI ;
-
-: jit-start-context ( -- )
- ! Create the new context in return-reg. Have to save context
- ! twice, first before calling new_context() which may GC,
- ! and again after popping the two parameters from the stack.
- jit-save-context
- 3 vm-reg MR
- "new_context" jit-call
-
- 6 3 MR
- jit-pop-quot-and-param
- jit-save-context
- 6 jit-switch-context
- jit-push-param
- jit-jump-quot ;
-
-[ jit-start-context ] \ (start-context) define-sub-primitive
-
-: jit-delete-current-context ( -- )
- jit-load-context
- 3 vm-reg MR
- 4 ctx-reg MR
- "delete_context" jit-call ;
-
-[
- jit-delete-current-context
- jit-set-context
-] \ (set-context-and-delete) define-sub-primitive
-
-: jit-start-context-and-delete ( -- )
- jit-load-context
- 3 vm-reg MR
- 4 ctx-reg MR
- "reset_context" jit-call
- jit-pop-quot-and-param
- ctx-reg jit-switch-context
- jit-push-param
- jit-jump-quot ;
-
-[
- jit-start-context-and-delete
-] \ (start-context-and-delete) define-sub-primitive
-
-[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
+++ /dev/null
-! Copyright (C) 2007, 2011 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel kernel.private namespaces
-system cpu.x86.assembler cpu.x86.assembler.operands layouts
-vocabs parser compiler.constants compiler.codegen.relocation
-sequences math math.private generic.single.private
-threads.private locals ;
-IN: bootstrap.x86
-
-4 \ cell set
-
-: leaf-stack-frame-size ( -- n ) 4 bootstrap-cells ;
-: signal-handler-stack-frame-size ( -- n ) 12 bootstrap-cells ;
-: stack-frame-size ( -- n ) 8 bootstrap-cells ;
-: shift-arg ( -- reg ) ECX ;
-: div-arg ( -- reg ) EAX ;
-: mod-arg ( -- reg ) EDX ;
-: temp0 ( -- reg ) EAX ;
-: temp1 ( -- reg ) ECX ;
-: temp2 ( -- reg ) EBX ;
-: temp3 ( -- reg ) EDX ;
-: pic-tail-reg ( -- reg ) EDX ;
-: stack-reg ( -- reg ) ESP ;
-: frame-reg ( -- reg ) EBP ;
-: vm-reg ( -- reg ) EBX ;
-: ctx-reg ( -- reg ) EBP ;
-: nv-regs ( -- seq ) { ESI EDI EBX } ;
-: volatile-regs ( -- seq ) { EAX ECX EDX } ;
-: nv-reg ( -- reg ) ESI ;
-: ds-reg ( -- reg ) ESI ;
-: rs-reg ( -- reg ) EDI ;
-: link-reg ( -- reg ) EBX ;
-: fixnum>slot@ ( -- ) temp0 2 SAR ;
-: rex-length ( -- n ) 0 ;
-: red-zone-size ( -- n ) 0 ;
-
-: jit-call ( name -- )
- 0 CALL f rc-relative rel-dlsym ;
-
-[
- pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
- 0 JMP f rc-relative rel-word-pic-tail
-] jit-word-jump jit-define
-
-: jit-load-vm ( -- )
- vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
-
-: jit-load-context ( -- )
- ! VM pointer must be in vm-reg already
- ctx-reg vm-reg vm-context-offset [+] MOV ;
-
-: jit-save-context ( -- )
- jit-load-context
- ECX ESP -4 [+] LEA
- ctx-reg context-callstack-top-offset [+] ECX MOV
- ctx-reg context-datastack-offset [+] ds-reg MOV
- ctx-reg context-retainstack-offset [+] rs-reg MOV ;
-
-: jit-restore-context ( -- )
- ds-reg ctx-reg context-datastack-offset [+] MOV
- rs-reg ctx-reg context-retainstack-offset [+] MOV ;
-
-[
- ! ctx-reg is preserved across the call because it is
- ! non-volatile in the C ABI
- jit-load-vm
- jit-save-context
- ! call the primitive
- ESP [] vm-reg MOV
- 0 CALL f f rc-relative rel-dlsym
- jit-restore-context
-] jit-primitive jit-define
-
-: jit-jump-quot ( -- )
- EAX quot-entry-point-offset [+] JMP ;
-
-: jit-call-quot ( -- )
- EAX quot-entry-point-offset [+] CALL ;
-
-[
- jit-load-vm
- ESP [] vm-reg MOV
- EAX EBP 8 [+] MOV
- ESP 4 [+] EAX MOV
- "begin_callback" jit-call
-
- jit-call-quot
-
- jit-load-vm
- ESP [] vm-reg MOV
- "end_callback" jit-call
-] \ c-to-factor define-sub-primitive
-
-: signal-handler-save-regs ( -- regs )
- { EAX ECX EDX EBX EBP ESI EDI } ;
-
-[
- EAX ds-reg [] MOV
- ds-reg bootstrap-cell SUB
-]
-[ jit-call-quot ]
-[ jit-jump-quot ]
-\ (call) define-combinator-primitive
-
-! unwind-native-frames is marked as "special" in vm/quotations.cpp
-! so it does not have a standard prolog
-[
- ! Load ds and rs registers
- jit-load-vm
- jit-load-context
- jit-restore-context
-
- ! clear the fault flag
- vm-reg vm-fault-flag-offset [+] 0 MOV
-
- ! Windows-specific setup
- ctx-reg jit-update-seh
-
- ! Load arguments
- EAX ESP bootstrap-cell [+] MOV
- EDX ESP 2 bootstrap-cells [+] MOV
-
- ! Unwind stack frames
- ESP EDX MOV
-
- jit-jump-quot
-] \ unwind-native-frames define-sub-primitive
-
-[
- ESP 2 SUB
- ESP [] FNSTCW
- FNINIT
- AX ESP [] MOV
- ESP 2 ADD
-] \ fpu-state define-sub-primitive
-
-[
- ESP stack-frame-size [+] FLDCW
-] \ set-fpu-state define-sub-primitive
-
-[
- ! Load callstack object
- temp3 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- ! Get ctx->callstack_bottom
- jit-load-vm
- jit-load-context
- temp0 ctx-reg context-callstack-bottom-offset [+] MOV
- ! Get top of callstack object -- 'src' for memcpy
- temp1 temp3 callstack-top-offset [+] LEA
- ! Get callstack length, in bytes --- 'len' for memcpy
- temp2 temp3 callstack-length-offset [+] MOV
- temp2 tag-bits get SHR
- ! Compute new stack pointer -- 'dst' for memcpy
- temp0 temp2 SUB
- ! Install new stack pointer
- ESP temp0 MOV
- ! Call memcpy
- temp2 PUSH
- temp1 PUSH
- temp0 PUSH
- "factor_memcpy" jit-call
- ESP 12 ADD
- ! Return with new callstack
- 0 RET
-] \ set-callstack define-sub-primitive
-
-[
- jit-load-vm
- jit-save-context
-
- ! Store arguments
- ESP [] EAX MOV
- ESP 4 [+] vm-reg MOV
-
- ! Call VM
- "lazy_jit_compile" jit-call
-]
-[ jit-call-quot ]
-[ jit-jump-quot ]
-\ lazy-jit-compile define-combinator-primitive
-
-[
- temp1 0xffffffff CMP f rc-absolute-cell rel-literal
-] pic-check-tuple jit-define
-
-! Inline cache miss entry points
-: jit-load-return-address ( -- )
- pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
-
-! These are always in tail position with an existing stack
-! frame, and the stack. The frame setup takes this into account.
-: jit-inline-cache-miss ( -- )
- jit-load-vm
- jit-save-context
- ESP 4 [+] vm-reg MOV
- ESP [] pic-tail-reg MOV
- 0 CALL rc-relative rel-inline-cache-miss
- jit-restore-context ;
-
-[ jit-load-return-address jit-inline-cache-miss ]
-[ EAX CALL ]
-[ EAX JMP ]
-\ inline-cache-miss define-combinator-primitive
-
-[ jit-inline-cache-miss ]
-[ EAX CALL ]
-[ EAX JMP ]
-\ inline-cache-miss-tail define-combinator-primitive
-
-! Overflowing fixnum arithmetic
-: jit-overflow ( insn func -- )
- ds-reg 4 SUB
- jit-load-vm
- jit-save-context
- EAX ds-reg [] MOV
- EDX ds-reg 4 [+] MOV
- EBX EAX MOV
- [ [ EBX EDX ] dip call( dst src -- ) ] dip
- ds-reg [] EBX MOV
- [ JNO ]
- [
- ESP [] EAX MOV
- ESP 4 [+] EDX MOV
- jit-load-vm
- ESP 8 [+] vm-reg MOV
- jit-call
- ]
- jit-conditional ;
-
-[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
-
-[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
-
-[
- ds-reg 4 SUB
- jit-load-vm
- jit-save-context
- EBX ds-reg [] MOV
- EAX EBX MOV
- EBP ds-reg 4 [+] MOV
- EBP tag-bits get SAR
- EBP IMUL
- ds-reg [] EAX MOV
- [ JNO ]
- [
- EBX tag-bits get SAR
- ESP [] EBX MOV
- ESP 4 [+] EBP MOV
- jit-load-vm
- ESP 8 [+] vm-reg MOV
- "overflow_fixnum_multiply" jit-call
- ]
- jit-conditional
-] \ fixnum* define-sub-primitive
-
-! Contexts
-: jit-switch-context ( reg -- )
- ! Push a bogus return address so the GC can track this frame back
- ! to the owner
- 0 CALL
-
- ! Make the new context the current one
- ctx-reg swap MOV
- vm-reg vm-context-offset [+] ctx-reg MOV
-
- ! Load new stack pointer
- ESP ctx-reg context-callstack-top-offset [+] MOV
-
- ! Windows-specific setup
- ctx-reg jit-update-tib
-
- ! Load new ds, rs registers
- jit-restore-context ;
-
-: jit-set-context ( -- )
- ! Load context and parameter from datastack
- EAX ds-reg [] MOV
- EAX EAX alien-offset [+] MOV
- EDX ds-reg -4 [+] MOV
- ds-reg 8 SUB
-
- ! Save ds, rs registers
- jit-load-vm
- jit-save-context
-
- ! Make the new context active
- EAX jit-switch-context
-
- ! Windows-specific setup
- ctx-reg jit-update-seh
-
- ! Twiddle stack for return
- ESP 4 ADD
-
- ! Store parameter to datastack
- ds-reg 4 ADD
- ds-reg [] EDX MOV ;
-
-[ jit-set-context ] \ (set-context) define-sub-primitive
-
-: jit-save-quot-and-param ( -- )
- EDX ds-reg MOV
- ds-reg 8 SUB ;
-
-: jit-push-param ( -- )
- EAX EDX -4 [+] MOV
- ds-reg 4 ADD
- ds-reg [] EAX MOV ;
-
-: jit-start-context ( -- )
- ! Create the new context in return-reg
- jit-load-vm
- jit-save-context
- ESP [] vm-reg MOV
- "new_context" jit-call
-
- jit-save-quot-and-param
-
- ! Make the new context active
- jit-load-vm
- jit-save-context
- EAX jit-switch-context
-
- jit-push-param
-
- ! Windows-specific setup
- jit-install-seh
-
- ! Push a fake return address
- 0 PUSH
-
- ! Jump to initial quotation
- EAX EDX [] MOV
- jit-jump-quot ;
-
-[ jit-start-context ] \ (start-context) define-sub-primitive
-
-: jit-delete-current-context ( -- )
- jit-load-vm
- jit-load-context
- ESP [] vm-reg MOV
- ESP 4 [+] ctx-reg MOV
- "delete_context" jit-call ;
-
-[
- jit-delete-current-context
- jit-set-context
-] \ (set-context-and-delete) define-sub-primitive
-
-: jit-start-context-and-delete ( -- )
- jit-load-vm
- jit-load-context
- ESP [] vm-reg MOV
- ESP 4 [+] ctx-reg MOV
- "reset_context" jit-call
-
- jit-save-quot-and-param
- ctx-reg jit-switch-context
- jit-push-param
-
- EAX EDX [] MOV
- jit-jump-quot ;
-
-[
- 0 EAX MOVABS rc-absolute rel-safepoint
-] \ jit-safepoint jit-define
-
-[
- jit-start-context-and-delete
-] \ (start-context-and-delete) define-sub-primitive
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser sequences ;
-IN: bootstrap.x86
-
-<< "vocab:cpu/x86/unix/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private compiler.constants
-compiler.codegen.relocation cpu.x86.assembler
-cpu.x86.assembler.operands kernel layouts locals parser
-sequences ;
-IN: bootstrap.x86
-
-: tib-segment ( -- ) FS ;
-: tib-temp ( -- reg ) EAX ;
-
-<< "vocab:cpu/x86/windows/bootstrap.factor" parse-file suffix! >> call
-
-: jit-install-seh ( -- )
- ! Create a new exception record and store it in the TIB.
- ! Clobbers tib-temp.
- ! Align stack
- ESP 3 bootstrap-cells ADD
- ! Exception handler address filled in by callback.cpp
- tib-temp 0 MOV rc-absolute-cell rel-exception-handler
- tib-temp PUSH
- ! No next handler
- 0 PUSH
- ! This is the new exception handler
- tib-exception-list-offset [] ESP tib-segment MOV ;
-
-:: jit-update-seh ( ctx-reg -- )
- ! Load exception record structure that jit-install-seh
- ! created from the bottom of the callstack.
- ! Clobbers tib-temp.
- tib-temp ctx-reg context-callstack-bottom-offset [+] MOV
- tib-temp bootstrap-cell ADD
- ! Store exception record in TIB.
- tib-exception-list-offset [] tib-temp tib-segment MOV ;
-
-<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call
+++ /dev/null
-! Copyright (C) 2007, 2011 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel kernel.private namespaces
-system layouts vocabs parser compiler.constants
-compiler.codegen.relocation math math.private cpu.x86.assembler
-cpu.x86.assembler.operands sequences generic.single.private
-threads.private locals ;
-IN: bootstrap.x86
-
-8 \ cell set
-
-: shift-arg ( -- reg ) RCX ;
-: div-arg ( -- reg ) RAX ;
-: mod-arg ( -- reg ) RDX ;
-: temp0 ( -- reg ) RAX ;
-: temp1 ( -- reg ) RCX ;
-: temp2 ( -- reg ) RDX ;
-: temp3 ( -- reg ) RBX ;
-: pic-tail-reg ( -- reg ) RBX ;
-: return-reg ( -- reg ) RAX ;
-: nv-reg ( -- reg ) RBX ;
-: stack-reg ( -- reg ) RSP ;
-: frame-reg ( -- reg ) RBP ;
-: link-reg ( -- reg ) R11 ;
-: ctx-reg ( -- reg ) R12 ;
-: vm-reg ( -- reg ) R13 ;
-: ds-reg ( -- reg ) R14 ;
-: rs-reg ( -- reg ) R15 ;
-: fixnum>slot@ ( -- ) temp0 1 SAR ;
-: rex-length ( -- n ) 1 ;
-
-: jit-call ( name -- )
- RAX 0 MOV f rc-absolute-cell rel-dlsym
- RAX CALL ;
-
-[
- pic-tail-reg 5 [RIP+] LEA
- 0 JMP f rc-relative rel-word-pic-tail
-] jit-word-jump jit-define
-
-: jit-load-vm ( -- )
- ! no-op on x86-64. in factor contexts vm-reg always contains the
- ! vm pointer.
- ;
-
-: jit-load-context ( -- )
- ctx-reg vm-reg vm-context-offset [+] MOV ;
-
-: jit-save-context ( -- )
- jit-load-context
- R11 RSP -8 [+] LEA
- ctx-reg context-callstack-top-offset [+] R11 MOV
- ctx-reg context-datastack-offset [+] ds-reg MOV
- ctx-reg context-retainstack-offset [+] rs-reg MOV ;
-
-: jit-restore-context ( -- )
- ds-reg ctx-reg context-datastack-offset [+] MOV
- rs-reg ctx-reg context-retainstack-offset [+] MOV ;
-
-[
- ! ctx-reg is preserved across the call because it is non-volatile
- ! in the C ABI
- jit-save-context
- ! call the primitive
- arg1 vm-reg MOV
- RAX 0 MOV f f rc-absolute-cell rel-dlsym
- RAX CALL
- jit-restore-context
-] jit-primitive jit-define
-
-: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
-
-: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
-
-[
- arg2 arg1 MOV
- arg1 vm-reg MOV
- "begin_callback" jit-call
-
- ! call the quotation
- arg1 return-reg MOV
- jit-call-quot
-
- arg1 vm-reg MOV
- "end_callback" jit-call
-] \ c-to-factor define-sub-primitive
-
-: signal-handler-save-regs ( -- regs )
- { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
-
-[
- arg1 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
-]
-[ jit-call-quot ]
-[ jit-jump-quot ]
-\ (call) define-combinator-primitive
-
-[
- ! Unwind stack frames
- RSP arg2 MOV
-
- ! Load VM pointer into vm-reg, since we're entering from
- ! C code
- vm-reg 0 MOV 0 rc-absolute-cell rel-vm
-
- ! Load ds and rs registers
- jit-load-context
- jit-restore-context
-
- ! Clear the fault flag
- vm-reg vm-fault-flag-offset [+] 0 MOV
-
- ! Call quotation
- jit-jump-quot
-] \ unwind-native-frames define-sub-primitive
-
-[
- RSP 2 SUB
- RSP [] FNSTCW
- FNINIT
- AX RSP [] MOV
- RSP 2 ADD
-] \ fpu-state define-sub-primitive
-
-[
- RSP 2 SUB
- RSP [] arg1 16-bit-version-of MOV
- RSP [] FLDCW
- RSP 2 ADD
-] \ set-fpu-state define-sub-primitive
-
-[
- ! Load callstack object
- arg4 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- ! Get ctx->callstack_bottom
- jit-load-context
- arg1 ctx-reg context-callstack-bottom-offset [+] MOV
- ! Get top of callstack object -- 'src' for memcpy
- arg2 arg4 callstack-top-offset [+] LEA
- ! Get callstack length, in bytes --- 'len' for memcpy
- arg3 arg4 callstack-length-offset [+] MOV
- arg3 tag-bits get SHR
- ! Compute new stack pointer -- 'dst' for memcpy
- arg1 arg3 SUB
- ! Install new stack pointer
- RSP arg1 MOV
- ! Call memcpy; arguments are now in the correct registers
- ! Create register shadow area for Win64
- RSP 32 SUB
- "factor_memcpy" jit-call
- ! Tear down register shadow area
- RSP 32 ADD
- ! Return with new callstack
- 0 RET
-] \ set-callstack define-sub-primitive
-
-[
- jit-save-context
- arg2 vm-reg MOV
- "lazy_jit_compile" jit-call
- arg1 return-reg MOV
-]
-[ return-reg quot-entry-point-offset [+] CALL ]
-[ jit-jump-quot ]
-\ lazy-jit-compile define-combinator-primitive
-
-[
- temp2 0xffffffff MOV f rc-absolute-cell rel-literal
- temp1 temp2 CMP
-] pic-check-tuple jit-define
-
-! Inline cache miss entry points
-: jit-load-return-address ( -- )
- RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
-
-! These are always in tail position with an existing stack
-! frame, and the stack. The frame setup takes this into account.
-: jit-inline-cache-miss ( -- )
- jit-save-context
- arg1 RBX MOV
- arg2 vm-reg MOV
- RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
- RAX CALL
- jit-load-context
- jit-restore-context ;
-
-[ jit-load-return-address jit-inline-cache-miss ]
-[ RAX CALL ]
-[ RAX JMP ]
-\ inline-cache-miss define-combinator-primitive
-
-[ jit-inline-cache-miss ]
-[ RAX CALL ]
-[ RAX JMP ]
-\ inline-cache-miss-tail define-combinator-primitive
-
-! Overflowing fixnum arithmetic
-: jit-overflow ( insn func -- )
- ds-reg 8 SUB
- jit-save-context
- arg1 ds-reg [] MOV
- arg2 ds-reg 8 [+] MOV
- arg3 arg1 MOV
- [ [ arg3 arg2 ] dip call ] dip
- ds-reg [] arg3 MOV
- [ JNO ]
- [ arg3 vm-reg MOV jit-call ]
- jit-conditional ; inline
-
-[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
-
-[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
-
-[
- ds-reg 8 SUB
- jit-save-context
- RCX ds-reg [] MOV
- RBX ds-reg 8 [+] MOV
- RBX tag-bits get SAR
- RAX RCX MOV
- RBX IMUL
- ds-reg [] RAX MOV
- [ JNO ]
- [
- arg1 RCX MOV
- arg1 tag-bits get SAR
- arg2 RBX MOV
- arg3 vm-reg MOV
- "overflow_fixnum_multiply" jit-call
- ]
- jit-conditional
-] \ fixnum* define-sub-primitive
-
-! Contexts
-: jit-switch-context ( reg -- )
- ! Push a bogus return address so the GC can track this frame back
- ! to the owner
- 0 CALL
-
- ! Make the new context the current one
- ctx-reg swap MOV
- vm-reg vm-context-offset [+] ctx-reg MOV
-
- ! Load new stack pointer
- RSP ctx-reg context-callstack-top-offset [+] MOV
-
- ! Load new ds, rs registers
- jit-restore-context
-
- ctx-reg jit-update-tib ;
-
-: jit-pop-context-and-param ( -- )
- arg1 ds-reg [] MOV
- arg1 arg1 alien-offset [+] MOV
- arg2 ds-reg -8 [+] MOV
- ds-reg 16 SUB ;
-
-: jit-push-param ( -- )
- ds-reg 8 ADD
- ds-reg [] arg2 MOV ;
-
-: jit-set-context ( -- )
- jit-pop-context-and-param
- jit-save-context
- arg1 jit-switch-context
- RSP 8 ADD
- jit-push-param ;
-
-[ jit-set-context ] \ (set-context) define-sub-primitive
-
-: jit-pop-quot-and-param ( -- )
- arg1 ds-reg [] MOV
- arg2 ds-reg -8 [+] MOV
- ds-reg 16 SUB ;
-
-: jit-start-context ( -- )
- ! Create the new context in return-reg. Have to save context
- ! twice, first before calling new_context() which may GC,
- ! and again after popping the two parameters from the stack.
- jit-save-context
- arg1 vm-reg MOV
- "new_context" jit-call
-
- jit-pop-quot-and-param
- jit-save-context
- return-reg jit-switch-context
- jit-push-param
- jit-jump-quot ;
-
-[ jit-start-context ] \ (start-context) define-sub-primitive
-
-: jit-delete-current-context ( -- )
- jit-load-context
- arg1 vm-reg MOV
- arg2 ctx-reg MOV
- "delete_context" jit-call ;
-
-[
- jit-delete-current-context
- jit-set-context
-] \ (set-context-and-delete) define-sub-primitive
-
-: jit-start-context-and-delete ( -- )
- jit-load-context
- arg1 vm-reg MOV
- arg2 ctx-reg MOV
- "reset_context" jit-call
-
- jit-pop-quot-and-param
- ctx-reg jit-switch-context
- jit-push-param
- jit-jump-quot ;
-
-[
- 0 [RIP+] EAX MOV rc-relative rel-safepoint
-] \ jit-safepoint jit-define
-
-[
- jit-start-context-and-delete
-] \ (start-context-and-delete) define-sub-primitive
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private cpu.x86.assembler
-cpu.x86.assembler.operands kernel layouts namespaces parser
-sequences system vocabs ;
-IN: bootstrap.x86
-
-: leaf-stack-frame-size ( -- n ) 2 bootstrap-cells ;
-: signal-handler-stack-frame-size ( -- n ) 20 bootstrap-cells ;
-: stack-frame-size ( -- n ) 4 bootstrap-cells ;
-: nv-regs ( -- seq ) { RBX R12 R13 R14 R15 } ;
-: volatile-regs ( -- seq ) { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
-: arg1 ( -- reg ) RDI ;
-: arg2 ( -- reg ) RSI ;
-: arg3 ( -- reg ) RDX ;
-: arg4 ( -- reg ) RCX ;
-: red-zone-size ( -- n ) 128 ;
-
-<< "vocab:cpu/x86/unix/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel namespaces system layouts
-vocabs sequences cpu.x86.assembler parser
-cpu.x86.assembler.operands ;
-IN: bootstrap.x86
-
-DEFER: stack-reg
-
-: leaf-stack-frame-size ( -- n ) 2 bootstrap-cells ;
-: signal-handler-stack-frame-size ( -- n ) 24 bootstrap-cells ;
-: stack-frame-size ( -- n ) 8 bootstrap-cells ;
-: nv-regs ( -- seq ) { RBX RSI RDI R12 R13 R14 R15 } ;
-: volatile-regs ( -- seq ) { RAX RCX RDX R8 R9 R10 R11 } ;
-: arg1 ( -- reg ) RCX ;
-: arg2 ( -- reg ) RDX ;
-: arg3 ( -- reg ) R8 ;
-: arg4 ( -- reg ) R9 ;
-
-: tib-segment ( -- ) GS ;
-: tib-temp ( -- reg ) R11 ;
-
-: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
-: jit-update-seh ( ctx-reg -- ) drop ;
-
-: red-zone-size ( -- n ) 0 ;
-
-<< "vocab:cpu/x86/windows/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call
+++ /dev/null
-! Copyright (C) 2007, 2011 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private compiler.constants
-compiler.codegen.relocation compiler.units cpu.x86.assembler
-cpu.x86.assembler.operands kernel kernel.private layouts
-locals locals.backend make math math.private namespaces sequences
-slots.private strings.private vocabs ;
-IN: bootstrap.x86
-
-big-endian off
-
-! C to Factor entry point
-[
- ! Optimizing compiler's side of callback accesses
- ! arguments that are on the stack via the frame pointer.
- ! On x86-32 fastcall, and x86-64, some arguments are passed
- ! in registers, and so the only registers that are safe for
- ! use here are frame-reg, nv-reg and vm-reg.
- frame-reg PUSH
- frame-reg stack-reg MOV
-
- ! Save all non-volatile registers
- nv-regs [ PUSH ] each
-
- jit-save-tib
-
- ! Load VM into vm-reg
- vm-reg 0 MOV 0 rc-absolute-cell rel-vm
-
- ! Save old context
- nv-reg vm-reg vm-context-offset [+] MOV
- nv-reg PUSH
-
- ! Switch over to the spare context
- nv-reg vm-reg vm-spare-context-offset [+] MOV
- vm-reg vm-context-offset [+] nv-reg MOV
-
- ! Save C callstack pointer
- nv-reg context-callstack-save-offset [+] stack-reg MOV
-
- ! Load Factor stack pointers
- stack-reg nv-reg context-callstack-bottom-offset [+] MOV
- nv-reg jit-update-tib
- jit-install-seh
-
- rs-reg nv-reg context-retainstack-offset [+] MOV
- ds-reg nv-reg context-datastack-offset [+] MOV
-
- ! Call into Factor code
- link-reg 0 MOV f rc-absolute-cell rel-word
- link-reg CALL
-
- ! Load VM into vm-reg; only needed on x86-32, but doesn't
- ! hurt on x86-64
- vm-reg 0 MOV 0 rc-absolute-cell rel-vm
-
- ! Load C callstack pointer
- nv-reg vm-reg vm-context-offset [+] MOV
- stack-reg nv-reg context-callstack-save-offset [+] MOV
-
- ! Load old context
- nv-reg POP
- vm-reg vm-context-offset [+] nv-reg MOV
-
- ! Restore non-volatile registers
- jit-restore-tib
-
- nv-regs <reversed> [ POP ] each
-
- frame-reg POP
-
- ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
- ! need a parameter here.
-
- ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
- 0xffff RET f rc-absolute-2 rel-untagged
-] callback-stub jit-define
-
-[
- ! load literal
- temp0 0 MOV f rc-absolute-cell rel-literal
- ! increment datastack pointer
- ds-reg bootstrap-cell ADD
- ! store literal on datastack
- ds-reg [] temp0 MOV
-] jit-push jit-define
-
-[
- 0 CALL f rc-relative rel-word-pic
-] jit-word-call jit-define
-
-! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp
-! not to trigger generation of a stack frame, so they can
-! peform their own prolog/epilog preserving registers.
-
-: jit-signal-handler-prolog ( -- )
- ! minus a cell each for flags, return address
- ! use LEA so we don't dirty flags
- stack-reg stack-reg signal-handler-stack-frame-size
- 2 bootstrap-cells - neg [+] LEA
-
- signal-handler-save-regs
- [| r i | stack-reg i bootstrap-cells [+] r MOV ] each-index
-
- PUSHF
-
- jit-load-vm ;
-
-: jit-signal-handler-epilog ( -- )
- POPF
-
- signal-handler-save-regs
- [| r i | r stack-reg i bootstrap-cells [+] MOV ] each-index
-
- stack-reg stack-reg signal-handler-stack-frame-size
- 2 bootstrap-cells - [+] LEA ;
-
-[| |
- jit-signal-handler-prolog
- jit-save-context
- temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
- temp0 CALL
- jit-signal-handler-epilog
- 0 RET
-] \ signal-handler define-sub-primitive
-
-[| |
- jit-signal-handler-prolog
- jit-save-context
- temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
- temp0 CALL
- jit-signal-handler-epilog
- ! Pop the fake leaf frame along with our return address
- leaf-stack-frame-size bootstrap-cell - RET
-] \ leaf-signal-handler define-sub-primitive
-
-[| |
- jit-signal-handler-prolog
- temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
- temp0 CALL
- jit-signal-handler-epilog
- red-zone-size RET
-] \ ffi-signal-handler define-sub-primitive
-
-[| |
- jit-signal-handler-prolog
- temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
- temp0 CALL
- jit-signal-handler-epilog
- red-zone-size 16 bootstrap-cell - + RET
-] \ ffi-leaf-signal-handler define-sub-primitive
-
-[
- ! load boolean
- temp0 ds-reg [] MOV
- ! pop boolean
- ds-reg bootstrap-cell SUB
- ! compare boolean with f
- temp0 \ f type-number CMP
- ! jump to true branch if not equal
- 0 JNE f rc-relative rel-word
- ! jump to false branch if equal
- 0 JMP f rc-relative rel-word
-] jit-if jit-define
-
-: jit->r ( -- )
- rs-reg bootstrap-cell ADD
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- rs-reg [] temp0 MOV ;
-
-: jit-2>r ( -- )
- rs-reg 2 bootstrap-cells ADD
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- ds-reg 2 bootstrap-cells SUB
- rs-reg [] temp0 MOV
- rs-reg -1 bootstrap-cells [+] temp1 MOV ;
-
-: jit-3>r ( -- )
- rs-reg 3 bootstrap-cells ADD
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- temp2 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg 3 bootstrap-cells SUB
- rs-reg [] temp0 MOV
- rs-reg -1 bootstrap-cells [+] temp1 MOV
- rs-reg -2 bootstrap-cells [+] temp2 MOV ;
-
-: jit-r> ( -- )
- ds-reg bootstrap-cell ADD
- temp0 rs-reg [] MOV
- rs-reg bootstrap-cell SUB
- ds-reg [] temp0 MOV ;
-
-: jit-2r> ( -- )
- ds-reg 2 bootstrap-cells ADD
- temp0 rs-reg [] MOV
- temp1 rs-reg -1 bootstrap-cells [+] MOV
- rs-reg 2 bootstrap-cells SUB
- ds-reg [] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp1 MOV ;
-
-: jit-3r> ( -- )
- ds-reg 3 bootstrap-cells ADD
- temp0 rs-reg [] MOV
- temp1 rs-reg -1 bootstrap-cells [+] MOV
- temp2 rs-reg -2 bootstrap-cells [+] MOV
- rs-reg 3 bootstrap-cells SUB
- ds-reg [] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp1 MOV
- ds-reg -2 bootstrap-cells [+] temp2 MOV ;
-
-[
- jit->r
- 0 CALL f rc-relative rel-word
- jit-r>
-] jit-dip jit-define
-
-[
- jit-2>r
- 0 CALL f rc-relative rel-word
- jit-2r>
-] jit-2dip jit-define
-
-[
- jit-3>r
- 0 CALL f rc-relative rel-word
- jit-3r>
-] jit-3dip jit-define
-
-[
- ! load from stack
- temp0 ds-reg [] MOV
- ! pop stack
- ds-reg bootstrap-cell SUB
-]
-[ temp0 word-entry-point-offset [+] CALL ]
-[ temp0 word-entry-point-offset [+] JMP ]
-\ (execute) define-combinator-primitive
-
-[
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- temp0 word-entry-point-offset [+] JMP
-] jit-execute jit-define
-
-[
- stack-reg stack-frame-size bootstrap-cell - SUB
-] jit-prolog jit-define
-
-[
- stack-reg stack-frame-size bootstrap-cell - ADD
-] jit-epilog jit-define
-
-[ 0 RET ] jit-return jit-define
-
-! ! ! Polymorphic inline caches
-
-! The PIC stubs are not permitted to touch pic-tail-reg.
-
-! Load a value from a stack position
-[
- temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged
-] pic-load jit-define
-
-[ temp1 tag-mask get AND ] pic-tag jit-define
-
-[
- temp0 temp1 MOV
- temp1 tag-mask get AND
- temp1 tuple type-number CMP
- [ JNE ]
- [ temp1 temp0 tuple-class-offset [+] MOV ]
- jit-conditional
-] pic-tuple jit-define
-
-[
- temp1 0x7f CMP f rc-absolute-1 rel-untagged
-] pic-check-tag jit-define
-
-[ 0 JE f rc-relative rel-word ] pic-hit jit-define
-
-! ! ! Megamorphic caches
-
-[
- ! class = ...
- temp0 temp1 MOV
- temp1 tag-mask get AND
- temp1 tag-bits get SHL
- temp1 tuple type-number tag-fixnum CMP
- [ JNE ]
- [ temp1 temp0 tuple-class-offset [+] MOV ]
- jit-conditional
- ! cache = ...
- temp0 0 MOV f rc-absolute-cell rel-literal
- ! key = hashcode(class)
- temp2 temp1 MOV
- bootstrap-cell 4 = [ temp2 1 SHR ] when
- ! key &= cache.length - 1
- temp2 mega-cache-size get 1 - bootstrap-cell * AND
- ! cache += array-start-offset
- temp0 array-start-offset ADD
- ! cache += key
- temp0 temp2 ADD
- ! if(get(cache) == class)
- temp0 [] temp1 CMP
- [ JNE ]
- [
- ! megamorphic_cache_hits++
- temp1 0 MOV rc-absolute-cell rel-megamorphic-cache-hits
- temp1 [] 1 ADD
- ! goto get(cache + bootstrap-cell)
- temp0 temp0 bootstrap-cell [+] MOV
- temp0 word-entry-point-offset [+] JMP
- ! fall-through on miss
- ] jit-conditional
-] mega-lookup jit-define
-
-! ! ! Sub-primitives
-
-! Objects
-[
- ! load from stack
- temp0 ds-reg [] MOV
- ! compute tag
- temp0 tag-mask get AND
- ! tag the tag
- temp0 tag-bits get SHL
- ! push to stack
- ds-reg [] temp0 MOV
-] \ tag define-sub-primitive
-
-[
- ! load slot number
- temp0 ds-reg [] MOV
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! load object
- temp1 ds-reg [] MOV
- ! turn slot number into offset
- fixnum>slot@
- ! mask off tag
- temp1 tag-bits get SHR
- temp1 tag-bits get SHL
- ! load slot value
- temp0 temp1 temp0 [+] MOV
- ! push to stack
- ds-reg [] temp0 MOV
-] \ slot define-sub-primitive
-
-[
- ! load string index from stack
- temp0 ds-reg bootstrap-cell neg [+] MOV
- temp0 tag-bits get SHR
- ! load string from stack
- temp1 ds-reg [] MOV
- ! load character
- temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
- temp0 temp0 8-bit-version-of MOVZX
- temp0 tag-bits get SHL
- ! store character to stack
- ds-reg bootstrap-cell SUB
- ds-reg [] temp0 MOV
-] \ string-nth-fast define-sub-primitive
-
-! Shufflers
-[
- ds-reg bootstrap-cell SUB
-] \ drop define-sub-primitive
-
-[
- ds-reg 2 bootstrap-cells SUB
-] \ 2drop define-sub-primitive
-
-[
- ds-reg 3 bootstrap-cells SUB
-] \ 3drop define-sub-primitive
-
-[
- ds-reg 4 bootstrap-cells SUB
-] \ 4drop define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell ADD
- ds-reg [] temp0 MOV
-] \ dup define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg bootstrap-cell neg [+] MOV
- ds-reg 2 bootstrap-cells ADD
- ds-reg [] temp0 MOV
- ds-reg bootstrap-cell neg [+] temp1 MOV
-] \ 2dup define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- temp3 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg 3 bootstrap-cells ADD
- ds-reg [] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp1 MOV
- ds-reg -2 bootstrap-cells [+] temp3 MOV
-] \ 3dup define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- temp2 ds-reg -2 bootstrap-cells [+] MOV
- temp3 ds-reg -3 bootstrap-cells [+] MOV
- ds-reg 4 bootstrap-cells ADD
- ds-reg [] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp1 MOV
- ds-reg -2 bootstrap-cells [+] temp2 MOV
- ds-reg -3 bootstrap-cells [+] temp3 MOV
-] \ 4dup define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- ds-reg [] temp0 MOV
-] \ nip define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- ds-reg 2 bootstrap-cells SUB
- ds-reg [] temp0 MOV
-] \ 2nip define-sub-primitive
-
-[
- temp0 ds-reg -1 bootstrap-cells [+] MOV
- ds-reg bootstrap-cell ADD
- ds-reg [] temp0 MOV
-] \ over define-sub-primitive
-
-[
- temp0 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg bootstrap-cell ADD
- ds-reg [] temp0 MOV
-] \ pick define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- ds-reg [] temp1 MOV
- ds-reg bootstrap-cell ADD
- ds-reg [] temp0 MOV
-] \ dupd define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg bootstrap-cell neg [+] MOV
- ds-reg bootstrap-cell neg [+] temp0 MOV
- ds-reg [] temp1 MOV
-] \ swap define-sub-primitive
-
-[
- temp0 ds-reg -1 bootstrap-cells [+] MOV
- temp1 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg -2 bootstrap-cells [+] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp1 MOV
-] \ swapd define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- temp3 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg -2 bootstrap-cells [+] temp1 MOV
- ds-reg -1 bootstrap-cells [+] temp0 MOV
- ds-reg [] temp3 MOV
-] \ rot define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- temp1 ds-reg -1 bootstrap-cells [+] MOV
- temp3 ds-reg -2 bootstrap-cells [+] MOV
- ds-reg -2 bootstrap-cells [+] temp0 MOV
- ds-reg -1 bootstrap-cells [+] temp3 MOV
- ds-reg [] temp1 MOV
-] \ -rot define-sub-primitive
-
-[ jit->r ] \ load-local define-sub-primitive
-
-! Comparisons
-: jit-compare ( insn -- )
- ! load t
- temp3 0 MOV t rc-absolute-cell rel-literal
- ! load f
- temp1 \ f type-number MOV
- ! load first value
- temp0 ds-reg [] MOV
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! compare with second value
- ds-reg [] temp0 CMP
- ! move t if true
- [ temp1 temp3 ] dip execute( dst src -- )
- ! store
- ds-reg [] temp1 MOV ;
-
-: define-jit-compare ( insn word -- )
- [ [ jit-compare ] curry ] dip define-sub-primitive ;
-
-\ CMOVE \ eq? define-jit-compare
-\ CMOVGE \ fixnum>= define-jit-compare
-\ CMOVLE \ fixnum<= define-jit-compare
-\ CMOVG \ fixnum> define-jit-compare
-\ CMOVL \ fixnum< define-jit-compare
-
-! Math
-: jit-math ( insn -- )
- ! load second input
- temp0 ds-reg [] MOV
- ! pop stack
- ds-reg bootstrap-cell SUB
- ! compute result
- [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
-
-[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
-
-[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
-
-[
- ! load second input
- temp0 ds-reg [] MOV
- ! pop stack
- ds-reg bootstrap-cell SUB
- ! load first input
- temp1 ds-reg [] MOV
- ! untag second input
- temp0 tag-bits get SAR
- ! multiply
- temp0 temp1 IMUL2
- ! push result
- ds-reg [] temp0 MOV
-] \ fixnum*fast define-sub-primitive
-
-[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
-
-[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
-
-[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
-
-[
- ! complement
- ds-reg [] NOT
- ! clear tag bits
- ds-reg [] tag-mask get XOR
-] \ fixnum-bitnot define-sub-primitive
-
-[
- ! load shift count
- shift-arg ds-reg [] MOV
- ! untag shift count
- shift-arg tag-bits get SAR
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! load value
- temp3 ds-reg [] MOV
- ! make a copy
- temp2 temp3 MOV
- ! compute positive shift value in temp2
- temp2 CL SHL
- shift-arg NEG
- ! compute negative shift value in temp3
- temp3 CL SAR
- temp3 tag-mask get bitnot AND
- shift-arg 0 CMP
- ! if shift count was negative, move temp0 to temp2
- temp2 temp3 CMOVGE
- ! push to stack
- ds-reg [] temp2 MOV
-] \ fixnum-shift-fast define-sub-primitive
-
-: jit-fixnum-/mod ( -- )
- ! load second parameter
- temp1 ds-reg [] MOV
- ! load first parameter
- div-arg ds-reg bootstrap-cell neg [+] MOV
- ! make a copy
- mod-arg div-arg MOV
- ! sign-extend
- mod-arg bootstrap-cell-bits 1 - SAR
- ! divide
- temp1 IDIV ;
-
-[
- jit-fixnum-/mod
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! push to stack
- ds-reg [] mod-arg MOV
-] \ fixnum-mod define-sub-primitive
-
-[
- jit-fixnum-/mod
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! tag it
- div-arg tag-bits get SHL
- ! push to stack
- ds-reg [] div-arg MOV
-] \ fixnum/i-fast define-sub-primitive
-
-[
- jit-fixnum-/mod
- ! tag it
- div-arg tag-bits get SHL
- ! push to stack
- ds-reg [] mod-arg MOV
- ds-reg bootstrap-cell neg [+] div-arg MOV
-] \ fixnum/mod-fast define-sub-primitive
-
-[
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- temp0 ds-reg [] OR
- temp0 tag-mask get TEST
- temp0 \ f type-number MOV
- temp1 1 tag-fixnum MOV
- temp0 temp1 CMOVE
- ds-reg [] temp0 MOV
-] \ both-fixnums? define-sub-primitive
-
-[
- ! load local number
- temp0 ds-reg [] MOV
- ! turn local number into offset
- fixnum>slot@
- ! load local value
- temp0 rs-reg temp0 [+] MOV
- ! push to stack
- ds-reg [] temp0 MOV
-] \ get-local define-sub-primitive
-
-[
- ! load local count
- temp0 ds-reg [] MOV
- ! adjust stack pointer
- ds-reg bootstrap-cell SUB
- ! turn local number into offset
- fixnum>slot@
- ! decrement retain stack pointer
- rs-reg temp0 SUB
-] \ drop-locals define-sub-primitive
-
-[ "bootstrap.x86" forget-vocab ] with-compilation-unit
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: cpu.x86.assembler cpu.x86.assembler.operands kernel
-layouts ;
-IN: bootstrap.x86
-
-DEFER: stack-reg
-
-: jit-save-tib ( -- ) ;
-: jit-restore-tib ( -- ) ;
-: jit-update-tib ( ctx-reg -- ) drop ;
-: jit-install-seh ( -- ) stack-reg bootstrap-cell ADD ;
-: jit-update-seh ( ctx-reg -- ) drop ;
+++ /dev/null
-! Copyright (C) 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private compiler.constants
-cpu.x86.assembler cpu.x86.assembler.operands kernel layouts
-locals parser sequences ;
-IN: bootstrap.x86
-
-: tib-exception-list-offset ( -- n ) 0 bootstrap-cells ;
-: tib-stack-base-offset ( -- n ) 1 bootstrap-cells ;
-: tib-stack-limit-offset ( -- n ) 2 bootstrap-cells ;
-
-: jit-save-tib ( -- )
- tib-exception-list-offset [] tib-segment PUSH
- tib-stack-base-offset [] tib-segment PUSH
- tib-stack-limit-offset [] tib-segment PUSH ;
-
-: jit-restore-tib ( -- )
- tib-stack-limit-offset [] tib-segment POP
- tib-stack-base-offset [] tib-segment POP
- tib-exception-list-offset [] tib-segment POP ;
-
-:: jit-update-tib ( ctx-reg -- )
- ! There's a redundant load here because we're not allowed
- ! to clobber ctx-reg. Clobbers tib-temp.
- ! Save callstack base in TIB
- tib-temp ctx-reg context-callstack-seg-offset [+] MOV
- tib-temp tib-temp segment-end-offset [+] MOV
- tib-stack-base-offset [] tib-temp tib-segment MOV
- ! Save callstack limit in TIB
- tib-temp ctx-reg context-callstack-seg-offset [+] MOV
- tib-temp tib-temp segment-start-offset [+] MOV
- tib-stack-limit-offset [] tib-temp tib-segment MOV ;
"vocab:bootstrap/syntax.factor" parse-file
architecture get {
- { "windows-x86.32" "x86/32/windows" }
- { "windows-x86.64" "x86/64/windows" }
- { "unix-x86.32" "x86/32/unix" }
- { "unix-x86.64" "x86/64/unix" }
- { "linux-ppc.32" "ppc/32/linux" }
- { "linux-ppc.64" "ppc/64/linux" }
+ { "windows-x86.32" "x86.32.windows" }
+ { "windows-x86.64" "x86.64.windows" }
+ { "unix-x86.32" "x86.32.unix" }
+ { "unix-x86.64" "x86.64.unix" }
+ { "linux-ppc.32" "ppc.32.linux" }
+ { "linux-ppc.64" "ppc.64.linux" }
} ?at [ "Bad architecture: " prepend throw ] unless
-"vocab:cpu/" "/bootstrap.factor" surround parse-file
+"vocab:bootstrap/assembler/" ".factor" surround parse-file
"vocab:bootstrap/layouts/layouts.factor" parse-file
#define FACTOR_CPU_STRING "x86.32"
/* Must match the leaf-stack-frame-size, signal-handler-stack-frame-size,
-and stack-frame-size constants in cpu/x86/32/bootstrap.factor */
+and stack-frame-size constants in bootstrap/assembler/x86.32.factor */
static const unsigned LEAF_FRAME_SIZE = 16;
static const unsigned SIGNAL_HANDLER_STACK_FRAME_SIZE = 48;
static const unsigned JIT_FRAME_SIZE = 32;
#define UAP_STACK_POINTER_TYPE greg_t
/* Must match the leaf-stack-frame-size, signal-handler-stack-frame-size,
-and stack-frame-size constants in basis/cpu/x86/64/unix/bootstrap.factor */
+and stack-frame-size constants in bootstrap/assembler/x86.64.unix.factor */
static const unsigned LEAF_FRAME_SIZE = 16;
static const unsigned SIGNAL_HANDLER_STACK_FRAME_SIZE = 160;
static const unsigned JIT_FRAME_SIZE = 32;
}
/* Must match the leaf-stack-frame-size, signal-handler-stack-frame-size,
-and stack-frame-size constants in basis/cpu/x86/64/unix/bootstrap.factor */
+and stack-frame-size constants in basis/bootstrap/assembler/x86.64.unix.factor */
static const unsigned LEAF_FRAME_SIZE = 16;
static const unsigned SIGNAL_HANDLER_STACK_FRAME_SIZE = 160;
static const unsigned JIT_FRAME_SIZE = 32;
namespace factor {
void factor_vm::c_to_factor_toplevel(cell quot) {
- /* 32-bit Windows SEH set up in basis/cpu/x86/32/windows/bootstrap.factor */
+ /* 32-bit Windows SEH set up in basis/bootstrap/assembler/x86.32.windows.factor */
c_to_factor(quot);
}
#define MXCSR(ctx) (ctx)->MxCsr
/* Must match the leaf-stack-frame-size, signal-handler-stack-frame-size,
-and stack-frame-size constants in basis/cpu/x86/64/windows/bootstrap.factor */
-
+and stack-frame-size constants in basis/bootstap/assembler/x86.64.windows.factor */
static const unsigned LEAF_FRAME_SIZE = 16;
static const unsigned SIGNAL_HANDLER_STACK_FRAME_SIZE = 192;
static const unsigned JIT_FRAME_SIZE = 64;
in Factor and performs advanced optimizations. See
basis/compiler/compiler.factor.
-The non-optimizing compiler compiles a quotation at a time by concatenating
-machine code chunks; prolog, epilog, call word, jump to word, etc. These machine
-code chunks are generated from Factor code in basis/cpu/.../bootstrap.factor.
+The non-optimizing compiler compiles a quotation at a time by
+concatenating machine code chunks; prolog, epilog, call word, jump to
+word, etc. These machine code chunks are generated from Factor code in
+basis/bootstrap/assembler/.
Calls to words and constant quotations (referenced by conditionals and dips)
are direct jumps to machine code blocks. Literals are also referenced directly
projects / factor.git / commitdiff