32 and 64 bit Linux PPC support
Erik Charlebois
parent
662bc3b07b
commit
64252dbdbc
14
GNUmakefile
14
GNUmakefile
|
|
@ -1,8 +1,6 @@
|
|||
ifdef CONFIG
|
||||
CC = gcc
|
||||
CPP = g++
|
||||
AR = ar
|
||||
LD = ld
|
||||
|
||||
VERSION = 0.94
|
||||
|
||||
|
|
@ -85,7 +83,8 @@ help:
|
|||
@echo "freebsd-x86-64"
|
||||
@echo "linux-x86-32"
|
||||
@echo "linux-x86-64"
|
||||
@echo "linux-ppc"
|
||||
@echo "linux-ppc-32"
|
||||
@echo "linux-ppc-64"
|
||||
@echo "linux-arm"
|
||||
@echo "openbsd-x86-32"
|
||||
@echo "openbsd-x86-64"
|
||||
|
|
@ -141,8 +140,11 @@ linux-x86-32:
|
|||
linux-x86-64:
|
||||
$(MAKE) $(ALL) CONFIG=vm/Config.linux.x86.64
|
||||
|
||||
linux-ppc:
|
||||
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc
|
||||
linux-ppc-32:
|
||||
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc.32
|
||||
|
||||
linux-ppc-64:
|
||||
$(MAKE) $(ALL) CONFIG=vm/Config.linux.ppc.64
|
||||
|
||||
linux-arm:
|
||||
$(MAKE) $(ALL) CONFIG=vm/Config.linux.arm
|
||||
|
|
@ -197,7 +199,7 @@ vm/ffi_test.o: vm/ffi_test.c
|
|||
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.S.o:
|
||||
$(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.mm.o:
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
|
|
|
|||
|
|
@ -436,7 +436,7 @@ M: pointer c-type
|
|||
\ uint c-type \ size_t typedef
|
||||
] if
|
||||
|
||||
cpu ppc? \ uint \ uchar ? c-type clone
|
||||
cpu ppc? os macosx? and \ uint \ uchar ? c-type clone
|
||||
[ >c-bool ] >>unboxer-quot
|
||||
[ c-bool> ] >>boxer-quot
|
||||
object >>boxed-class
|
||||
|
|
|
|||
|
|
@ -9,6 +9,8 @@ IN: alien.libraries
|
|||
|
||||
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
|
||||
|
||||
: dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ;
|
||||
|
||||
SYMBOL: libraries
|
||||
|
||||
libraries [ H{ } clone ] initialize
|
||||
|
|
@ -48,7 +50,7 @@ M: library dispose dll>> [ dispose ] when* ;
|
|||
ERROR: no-such-symbol name library ;
|
||||
|
||||
: address-of ( name library -- value )
|
||||
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
|
||||
2dup load-library dlsym-raw [ 2nip ] [ no-such-symbol ] if* ;
|
||||
|
||||
SYMBOL: deploy-libraries
|
||||
|
||||
|
|
|
|||
|
|
@ -15,10 +15,13 @@ generalizations ;
|
|||
IN: bootstrap.image
|
||||
|
||||
: arch ( os cpu -- arch )
|
||||
[ "winnt" = "winnt" "unix" ? ] dip "-" glue ;
|
||||
2dup [ winnt? ] [ ppc? ] bi* or [
|
||||
[ drop unix ] dip
|
||||
] unless
|
||||
[ name>> ] [ name>> ] bi* "-" glue ;
|
||||
|
||||
: my-arch ( -- arch )
|
||||
os name>> cpu name>> arch ;
|
||||
os cpu arch ;
|
||||
|
||||
: boot-image-name ( arch -- string )
|
||||
"boot." ".image" surround ;
|
||||
|
|
@ -29,6 +32,7 @@ IN: bootstrap.image
|
|||
: images ( -- seq )
|
||||
{
|
||||
"winnt-x86.32" "unix-x86.32"
|
||||
"linux-ppc.32" "linux-ppc.64"
|
||||
"winnt-x86.64" "unix-x86.64"
|
||||
} ;
|
||||
|
||||
|
|
@ -127,6 +131,9 @@ SYMBOL: jit-literals
|
|||
: jit-dlsym ( name rc -- )
|
||||
rt-dlsym jit-rel string>symbol jit-parameter f jit-parameter ;
|
||||
|
||||
: jit-dlsym-toc ( name rc -- )
|
||||
rt-dlsym-toc jit-rel string>symbol jit-parameter f jit-parameter ;
|
||||
|
||||
:: jit-conditional ( test-quot false-quot -- )
|
||||
[ 0 test-quot call ] B{ } make length :> len
|
||||
building get length jit-offset get + len +
|
||||
|
|
|
|||
|
|
@ -460,8 +460,13 @@ cpu ppc? [
|
|||
{ y int }
|
||||
{ x longlong } ;
|
||||
|
||||
[ 12 ] [ ppc-align-test-2 heap-size ] unit-test
|
||||
[ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
|
||||
cpu ppc? 4 cell = and os macosx? and [
|
||||
[ 12 ] [ ppc-align-test-2 heap-size ] unit-test
|
||||
[ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
|
||||
] [
|
||||
[ 16 ] [ ppc-align-test-2 heap-size ] unit-test
|
||||
[ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
|
||||
] if
|
||||
] when
|
||||
|
||||
STRUCT: struct-test-delegate
|
||||
|
|
|
|||
|
|
@ -39,12 +39,12 @@ IN: compiler.cfg.builder.alien
|
|||
dup large-struct? [
|
||||
heap-size cell f ^^local-allot [
|
||||
'[ _ prefix ]
|
||||
[ int-rep struct-return-on-stack? 2array prefix ] bi*
|
||||
[ int-rep struct-return-on-stack? f 3array prefix ] bi*
|
||||
] keep
|
||||
] [ drop f ] if ;
|
||||
|
||||
: (caller-parameters) ( vregs reps -- )
|
||||
[ first2 next-parameter ] 2each ;
|
||||
[ first3 next-parameter ] 2each ;
|
||||
|
||||
: caller-parameters ( params -- reg-inputs stack-inputs )
|
||||
[ abi>> ] [ parameters>> ] [ return>> ] tri
|
||||
|
|
@ -136,16 +136,16 @@ M: #alien-assembly emit-node
|
|||
[ caller-return ]
|
||||
bi ;
|
||||
|
||||
: callee-parameter ( rep on-stack? -- dst )
|
||||
[ next-vreg dup ] 2dip next-parameter ;
|
||||
: callee-parameter ( rep on-stack? odd-register? -- dst )
|
||||
[ next-vreg dup ] 3dip next-parameter ;
|
||||
|
||||
: prepare-struct-callee ( c-type -- vreg )
|
||||
large-struct?
|
||||
[ int-rep struct-return-on-stack? callee-parameter ] [ f ] if ;
|
||||
[ int-rep struct-return-on-stack? f callee-parameter ] [ f ] if ;
|
||||
|
||||
: (callee-parameters) ( params -- vregs reps )
|
||||
[ flatten-parameter-type ] map
|
||||
[ [ [ first2 callee-parameter ] map ] map ]
|
||||
[ [ [ first3 callee-parameter ] map ] map ]
|
||||
[ [ keys ] map ]
|
||||
bi ;
|
||||
|
||||
|
|
|
|||
|
|
@ -15,19 +15,23 @@ SYMBOL: struct-return-area
|
|||
GENERIC: flatten-c-type ( c-type -- pairs )
|
||||
|
||||
M: c-type flatten-c-type
|
||||
rep>> f 2array 1array ;
|
||||
rep>> f f 3array 1array ;
|
||||
|
||||
M: long-long-type flatten-c-type
|
||||
drop 2 [ int-rep long-long-on-stack? 2array ] replicate ;
|
||||
drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
|
||||
|
||||
HOOK: flatten-struct-type cpu ( type -- pairs )
|
||||
HOOK: flatten-struct-type-return cpu ( type -- pairs )
|
||||
|
||||
M: object flatten-struct-type
|
||||
heap-size cell align cell /i { int-rep f } <repetition> ;
|
||||
heap-size cell align cell /i { int-rep f f } <repetition> ;
|
||||
|
||||
M: struct-c-type flatten-c-type
|
||||
flatten-struct-type ;
|
||||
|
||||
M: object flatten-struct-type-return
|
||||
flatten-struct-type ;
|
||||
|
||||
: stack-size ( c-type -- n )
|
||||
base-type flatten-c-type keys 0 [ rep-size + ] reduce ;
|
||||
|
||||
|
|
@ -40,6 +44,12 @@ M: struct-c-type flatten-c-type
|
|||
[| rep offset | src offset rep f ^^load-memory-imm ] 2map
|
||||
reps ;
|
||||
|
||||
:: explode-struct-return ( src c-type -- vregs reps )
|
||||
c-type flatten-struct-type-return :> reps
|
||||
reps keys dup component-offsets
|
||||
[| rep offset | src offset rep f ^^load-memory-imm ] 2map
|
||||
reps ;
|
||||
|
||||
:: implode-struct ( src vregs reps -- )
|
||||
vregs reps dup component-offsets
|
||||
[| vreg rep offset | vreg src offset rep f ##store-memory-imm ] 3each ;
|
||||
|
|
@ -62,11 +72,12 @@ M: c-type unbox
|
|||
[ swap ^^unbox ]
|
||||
} case 1array
|
||||
]
|
||||
[ drop f 2array 1array ] 2bi ;
|
||||
[ drop f f 3array 1array ] 2bi ;
|
||||
|
||||
M: long-long-type unbox
|
||||
[ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long 2array
|
||||
int-rep long-long-on-stack? 2array dup 2array ;
|
||||
int-rep long-long-on-stack? long-long-odd-register? 3array
|
||||
int-rep long-long-on-stack? f 3array 2array ;
|
||||
|
||||
M: struct-c-type unbox ( src c-type -- vregs reps )
|
||||
[ ^^unbox-any-c-ptr ] dip explode-struct ;
|
||||
|
|
@ -85,7 +96,7 @@ M: struct-c-type unbox-parameter
|
|||
[ nip heap-size cell f ^^local-allot dup ]
|
||||
[ [ ^^unbox-any-c-ptr ] dip explode-struct keys ] 2bi
|
||||
implode-struct
|
||||
1array { { int-rep f } }
|
||||
1array { { int-rep f f } }
|
||||
] if ;
|
||||
|
||||
: store-return ( vregs reps -- triples )
|
||||
|
|
@ -165,6 +176,6 @@ M: struct-c-type box-return
|
|||
[
|
||||
[
|
||||
[ [ { } assert-sequence= ] bi@ struct-return-area get ] dip
|
||||
explode-struct keys
|
||||
explode-struct-return keys
|
||||
] keep box
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -1,15 +1,22 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: cpu.architecture fry kernel layouts math math.order
|
||||
namespaces sequences vectors assocs arrays ;
|
||||
namespaces sequences vectors assocs arrays locals ;
|
||||
IN: compiler.cfg.builder.alien.params
|
||||
|
||||
SYMBOL: stack-params
|
||||
|
||||
: alloc-stack-param ( rep -- n )
|
||||
GENERIC: alloc-stack-param ( reg -- n )
|
||||
|
||||
M: object alloc-stack-param ( rep -- n )
|
||||
stack-params get
|
||||
[ rep-size cell align stack-params +@ ] dip ;
|
||||
|
||||
M: float-rep alloc-stack-param ( rep -- n )
|
||||
stack-params get swap rep-size
|
||||
[ cell align stack-params +@ ] keep
|
||||
float-right-align-on-stack? [ + ] [ drop ] if ;
|
||||
|
||||
: ?dummy-stack-params ( rep -- )
|
||||
dummy-stack-params? [ alloc-stack-param drop ] [ drop ] if ;
|
||||
|
||||
|
|
@ -22,21 +29,29 @@ SYMBOL: stack-params
|
|||
: ?dummy-fp-params ( rep -- )
|
||||
drop dummy-fp-params? [ float-regs get [ pop* ] unless-empty ] when ;
|
||||
|
||||
GENERIC: next-reg-param ( rep -- reg )
|
||||
GENERIC: next-reg-param ( odd-register? rep -- reg )
|
||||
|
||||
M: int-rep next-reg-param
|
||||
[ ?dummy-stack-params ] [ ?dummy-fp-params ] bi
|
||||
int-regs get pop ;
|
||||
[ nip ?dummy-stack-params ]
|
||||
[ nip ?dummy-fp-params ]
|
||||
[ drop [
|
||||
int-regs get last even?
|
||||
[ int-regs get pop* ] when
|
||||
] when ]
|
||||
2tri int-regs get pop ;
|
||||
|
||||
M: float-rep next-reg-param
|
||||
[ ?dummy-stack-params ] [ ?dummy-int-params ] bi
|
||||
nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
|
||||
float-regs get pop ;
|
||||
|
||||
M: double-rep next-reg-param
|
||||
[ ?dummy-stack-params ] [ ?dummy-int-params ] bi
|
||||
nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
|
||||
float-regs get pop ;
|
||||
|
||||
: reg-class-full? ( reg-class -- ? ) get empty? ;
|
||||
:: reg-class-full? ( reg-class odd-register? -- ? )
|
||||
reg-class get empty?
|
||||
reg-class get length 1 = odd-register? and
|
||||
dup [ reg-class get delete-all ] when or ;
|
||||
|
||||
: init-reg-class ( abi reg-class -- )
|
||||
[ swap param-regs at <reversed> >vector ] keep set ;
|
||||
|
|
@ -49,9 +64,10 @@ M: double-rep next-reg-param
|
|||
|
||||
SYMBOLS: stack-values reg-values ;
|
||||
|
||||
: next-parameter ( vreg rep on-stack? -- )
|
||||
[ dup dup reg-class-of reg-class-full? ] dip or
|
||||
[ alloc-stack-param stack-values ] [ next-reg-param reg-values ] if
|
||||
:: next-parameter ( vreg rep on-stack? odd-register? -- )
|
||||
vreg rep on-stack?
|
||||
[ dup dup reg-class-of odd-register? reg-class-full? ] dip or
|
||||
[ alloc-stack-param stack-values ] [ odd-register? swap next-reg-param reg-values ] if
|
||||
[ 3array ] dip get push ;
|
||||
|
||||
: next-return-reg ( rep -- reg ) reg-class-of get pop ;
|
||||
|
|
|
|||
|
|
@ -2080,21 +2080,24 @@ cell 8 = [
|
|||
} value-numbering-step
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##load-integer f 2 2147483647 }
|
||||
T{ ##add-imm f 3 0 2147483647 }
|
||||
T{ ##add-imm f 4 3 2147483647 }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##load-integer f 2 2147483647 }
|
||||
T{ ##add f 3 0 2 }
|
||||
T{ ##add f 4 3 2 }
|
||||
} value-numbering-step
|
||||
] unit-test
|
||||
! PPC ADDI can't hold immediates this big.
|
||||
cpu ppc? [
|
||||
[
|
||||
{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##load-integer f 2 2147483647 }
|
||||
T{ ##add-imm f 3 0 2147483647 }
|
||||
T{ ##add-imm f 4 3 2147483647 }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##load-integer f 2 2147483647 }
|
||||
T{ ##add f 3 0 2 }
|
||||
T{ ##add f 4 3 2 }
|
||||
} value-numbering-step
|
||||
] unit-test
|
||||
] unless
|
||||
] when
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -67,6 +67,9 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ;
|
|||
: rel-dlsym ( name dll class -- )
|
||||
[ add-dlsym-parameters ] dip rt-dlsym rel-fixup ;
|
||||
|
||||
: rel-dlsym-toc ( name dll class -- )
|
||||
[ add-dlsym-parameters ] dip rt-dlsym-toc rel-fixup ;
|
||||
|
||||
: rel-word ( word class -- )
|
||||
[ add-literal ] dip rt-entry-point rel-fixup ;
|
||||
|
||||
|
|
|
|||
|
|
@ -45,13 +45,14 @@ CONSTANT: rc-absolute 1
|
|||
CONSTANT: rc-relative 2
|
||||
CONSTANT: rc-absolute-ppc-2/2 3
|
||||
CONSTANT: rc-absolute-ppc-2 4
|
||||
CONSTANT: rc-relative-ppc-2 5
|
||||
CONSTANT: rc-relative-ppc-3 6
|
||||
CONSTANT: rc-relative-ppc-2-pc 5
|
||||
CONSTANT: rc-relative-ppc-3-pc 6
|
||||
CONSTANT: rc-relative-arm-3 7
|
||||
CONSTANT: rc-indirect-arm 8
|
||||
CONSTANT: rc-indirect-arm-pc 9
|
||||
CONSTANT: rc-absolute-2 10
|
||||
CONSTANT: rc-absolute-1 11
|
||||
CONSTANT: rc-absolute-ppc-2/2/2/2 12
|
||||
|
||||
! Relocation types
|
||||
CONSTANT: rt-dlsym 0
|
||||
|
|
@ -67,6 +68,7 @@ CONSTANT: rt-vm 9
|
|||
CONSTANT: rt-cards-offset 10
|
||||
CONSTANT: rt-decks-offset 11
|
||||
CONSTANT: rt-exception-handler 12
|
||||
CONSTANT: rt-dlsym-toc 13
|
||||
|
||||
: rc-absolute? ( n -- ? )
|
||||
${
|
||||
|
|
|
|||
|
|
@ -575,9 +575,18 @@ HOOK: dummy-fp-params? cpu ( -- ? )
|
|||
! If t, long longs are never passed in param regs
|
||||
HOOK: long-long-on-stack? cpu ( -- ? )
|
||||
|
||||
! If t, long longs are aligned on an odd register. On Linux
|
||||
! 32-bit PPC, long longs are 8-byte aligned but passed in
|
||||
! registers so they need to be aligned on an odd numbered
|
||||
! (r3, r5, etc) register.
|
||||
HOOK: long-long-odd-register? cpu ( -- ? )
|
||||
|
||||
! If t, floats are never passed in param regs
|
||||
HOOK: float-on-stack? cpu ( -- ? )
|
||||
|
||||
! If t, put floats in the second word of a double word on the stack
|
||||
HOOK: float-right-align-on-stack? cpu ( -- ? )
|
||||
|
||||
! If t, the struct return pointer is never passed in a param reg
|
||||
HOOK: struct-return-on-stack? cpu ( -- ? )
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,3 @@
|
|||
! Copyright (C) 2011 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: cpu.ppc ;
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
! 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 HEX: ffff bitand LIS ]
|
||||
[ [ dup ] dip HEX: ffff 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
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
! Copyright (C) 2011 Erik Charlebois
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors system kernel layouts combinators
|
||||
compiler.cfg.builder.alien.boxing sequences arrays
|
||||
alien.c-types cpu.architecture cpu.ppc alien.complex ;
|
||||
IN: cpu.ppc.32.linux
|
||||
|
||||
M: linux lr-save ( -- n ) 1 cells ;
|
||||
|
||||
M: linux has-toc ( -- ? ) f ;
|
||||
|
||||
M: linux reserved-area-size ( -- n ) 2 cells ;
|
||||
|
||||
M: linux allows-null-dereference ( -- ? ) f ;
|
||||
|
||||
M: ppc param-regs
|
||||
drop {
|
||||
{ int-regs { 3 4 5 6 7 8 9 10 } }
|
||||
{ float-regs { 1 2 3 4 5 6 7 8 } }
|
||||
} ;
|
||||
|
||||
M: ppc value-struct?
|
||||
c-type [ complex-double c-type = ]
|
||||
[ complex-float c-type = ] bi or ;
|
||||
|
||||
M: ppc dummy-stack-params? f ;
|
||||
|
||||
M: ppc dummy-int-params? f ;
|
||||
|
||||
M: ppc dummy-fp-params? f ;
|
||||
|
||||
M: ppc long-long-on-stack? f ;
|
||||
|
||||
M: ppc long-long-odd-register? t ;
|
||||
|
||||
M: ppc float-right-align-on-stack? f ;
|
||||
|
||||
M: ppc flatten-struct-type ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
[ drop { { int-rep f f } { int-rep f f }
|
||||
{ int-rep f f } { int-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
[ drop { { int-rep f f } { int-rep f f } } ] }
|
||||
[ call-next-method [ first t f 3array ] map ]
|
||||
} cond ;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
! Copyright (C) 2011 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: cpu.ppc ;
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
! 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 HEX: ffff bitand LIS ]
|
||||
[ -32 shift HEX: ffff bitand ORI ]
|
||||
[ drop 32 SLDI ]
|
||||
[ -16 shift HEX: ffff bitand ORIS ]
|
||||
[ HEX: ffff 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
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2011 Erik Charlebois
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors system kernel layouts combinators
|
||||
compiler.cfg.builder.alien.boxing sequences arrays math
|
||||
alien.c-types cpu.architecture cpu.ppc alien.complex ;
|
||||
IN: cpu.ppc.64.linux
|
||||
|
||||
M: linux lr-save 2 cells ;
|
||||
|
||||
M: linux has-toc ( -- ? ) t ;
|
||||
|
||||
M: linux reserved-area-size ( -- n ) 6 cells ;
|
||||
|
||||
M: linux allows-null-dereference ( -- ? ) f ;
|
||||
|
||||
M: ppc param-regs
|
||||
drop {
|
||||
{ int-regs { 3 4 5 6 7 8 9 10 } }
|
||||
{ float-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
|
||||
} ;
|
||||
|
||||
M: ppc value-struct? drop t ;
|
||||
|
||||
M: ppc dummy-stack-params? t ;
|
||||
|
||||
M: ppc dummy-int-params? t ;
|
||||
|
||||
M: ppc dummy-fp-params? f ;
|
||||
|
||||
M: ppc long-long-on-stack? f ;
|
||||
|
||||
M: ppc long-long-odd-register? f ;
|
||||
|
||||
M: ppc float-right-align-on-stack? t ;
|
||||
|
||||
M: ppc flatten-struct-type ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
[ drop { { double-rep f f } { double-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
[ drop { { float-rep f f } { float-rep f f } } ] }
|
||||
[ heap-size cell align cell /i { int-rep f f } <repetition> ]
|
||||
} cond ;
|
||||
|
||||
M: ppc flatten-struct-type-return ( type -- seq )
|
||||
{
|
||||
{ [ dup c-type complex-double c-type = ]
|
||||
[ drop { { double-rep f f } { double-rep f f } } ] }
|
||||
{ [ dup c-type complex-float c-type = ]
|
||||
[ drop { { float-rep f f } { float-rep f f } } ] }
|
||||
[ heap-size cell align cell /i { int-rep t f } <repetition> ]
|
||||
} cond ;
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,845 @@
|
|||
! 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
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1 @@
|
|||
32-bit and 64-bit PowerPC compiler backends
|
||||
|
|
@ -228,7 +228,7 @@ M: x86.32 long-long-on-stack? t ;
|
|||
M: x86.32 float-on-stack? t ;
|
||||
|
||||
M: x86.32 flatten-struct-type
|
||||
call-next-method [ first t 2array ] map ;
|
||||
call-next-method [ first t f 3array ] map ;
|
||||
|
||||
M: x86.32 struct-return-on-stack? os linux? not ;
|
||||
|
||||
|
|
|
|||
|
|
@ -29,12 +29,12 @@ M: x86.64 reserved-stack-space 0 ;
|
|||
struct-types&offset split-struct [
|
||||
[ c-type c-type-rep reg-class-of ] map
|
||||
int-regs swap member? int-rep double-rep ?
|
||||
f 2array
|
||||
f f 3array
|
||||
] map ;
|
||||
|
||||
M: x86.64 flatten-struct-type ( c-type -- seq )
|
||||
dup heap-size 16 <=
|
||||
[ flatten-small-struct ] [ call-next-method [ first t 2array ] map ] if ;
|
||||
[ flatten-small-struct ] [ call-next-method [ first t f 3array ] map ] if ;
|
||||
|
||||
M: x86.64 return-struct-in-registers? ( c-type -- ? )
|
||||
heap-size 2 cells <= ;
|
||||
|
|
|
|||
|
|
@ -691,6 +691,10 @@ M:: x86 %save-context ( temp1 temp2 -- )
|
|||
|
||||
M: x86 value-struct? drop t ;
|
||||
|
||||
M: x86 long-long-odd-register? f ;
|
||||
|
||||
M: x86 float-right-align-on-stack? f ;
|
||||
|
||||
M: x86 immediate-arithmetic? ( n -- ? )
|
||||
HEX: -80000000 HEX: 7fffffff between? ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
USING: accessors alien.c-types alien.syntax arrays assocs
|
||||
USING: accessors alien alien.c-types alien.syntax arrays assocs
|
||||
biassocs classes.struct combinators kernel literals math
|
||||
math.bitwise math.floats.env math.floats.env.private system ;
|
||||
math.bitwise math.floats.env math.floats.env.private system
|
||||
cpu.ppc.assembler ;
|
||||
IN: math.floats.env.ppc
|
||||
|
||||
STRUCT: ppc-fpu-env
|
||||
|
|
@ -10,12 +11,41 @@ STRUCT: ppc-fpu-env
|
|||
STRUCT: ppc-vmx-env
|
||||
{ vscr uint } ;
|
||||
|
||||
! defined in the vm, cpu-ppc*.S
|
||||
FUNCTION: void get_ppc_fpu_env ( ppc-fpu-env* env ) ;
|
||||
FUNCTION: void set_ppc_fpu_env ( ppc-fpu-env* env ) ;
|
||||
: get_ppc_fpu_env ( env -- )
|
||||
void { void* } cdecl [
|
||||
0 MFFS
|
||||
0 3 0 STFD
|
||||
] alien-assembly ;
|
||||
|
||||
FUNCTION: void get_ppc_vmx_env ( ppc-vmx-env* env ) ;
|
||||
FUNCTION: void set_ppc_vmx_env ( ppc-vmx-env* env ) ;
|
||||
: set_ppc_fpu_env ( env -- )
|
||||
void { void* } cdecl [
|
||||
0 3 0 LFD
|
||||
HEX: ff 0 0 0 MTFSF
|
||||
] alien-assembly ;
|
||||
|
||||
: get_ppc_vmx_env ( env -- )
|
||||
void { void* } cdecl [
|
||||
0 MFVSCR
|
||||
4 1 16 SUBI
|
||||
5 HEX: f LI
|
||||
4 4 5 ANDC
|
||||
0 0 4 STVXL
|
||||
5 HEX: c LI
|
||||
6 5 4 LWZX
|
||||
6 3 0 STW
|
||||
] alien-assembly ;
|
||||
|
||||
: set_ppc_vmx_env ( env -- )
|
||||
void { void* } cdecl [
|
||||
3 1 16 SUBI
|
||||
5 HEX: f LI
|
||||
4 4 5 ANDC
|
||||
5 HEX: c LI
|
||||
6 3 0 LWZ
|
||||
6 5 4 STWX
|
||||
0 0 4 LVXL
|
||||
0 MTVSCR
|
||||
] alien-assembly ;
|
||||
|
||||
: <ppc-fpu-env> ( -- ppc-fpu-env )
|
||||
ppc-fpu-env (struct)
|
||||
|
|
@ -32,7 +62,7 @@ M: ppc-vmx-env (set-fp-env-register)
|
|||
set_ppc_vmx_env ;
|
||||
|
||||
M: ppc (fp-env-registers)
|
||||
<ppc-fpu-env> <ppc-vmx-env> 2array ;
|
||||
<ppc-fpu-env> 1array ;
|
||||
|
||||
CONSTANT: ppc-exception-flag-bits HEX: fff8,0700
|
||||
CONSTANT: ppc-exception-flag>bit
|
||||
|
|
|
|||
|
|
@ -282,6 +282,7 @@ M: object infer-call* \ call bad-macro-input ;
|
|||
\ (code-blocks) { } { array } define-primitive \ (code-blocks) make-flushable
|
||||
\ (dlopen) { byte-array } { dll } define-primitive
|
||||
\ (dlsym) { byte-array object } { c-ptr } define-primitive
|
||||
\ (dlsym-raw) { byte-array object } { c-ptr } define-primitive
|
||||
\ (exists?) { string } { object } define-primitive
|
||||
\ (exit) { integer } { } define-primitive
|
||||
\ (format-float) { float byte-array } { byte-array } define-primitive \ (format-float) make-foldable
|
||||
|
|
|
|||
|
|
@ -306,8 +306,8 @@ set_build_info() {
|
|||
MAKE_IMAGE_TARGET=macosx-ppc
|
||||
MAKE_TARGET=macosx-ppc
|
||||
elif [[ $OS == linux && $ARCH == ppc ]] ; then
|
||||
MAKE_IMAGE_TARGET=linux-ppc
|
||||
MAKE_TARGET=linux-ppc
|
||||
MAKE_IMAGE_TARGET=linux-ppc.32
|
||||
MAKE_TARGET=linux-ppc-32
|
||||
elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
|
||||
MAKE_IMAGE_TARGET=winnt-x86.64
|
||||
MAKE_TARGET=winnt-x86-64
|
||||
|
|
|
|||
|
|
@ -19,9 +19,11 @@ H{ } clone sub-primitives set
|
|||
|
||||
architecture get {
|
||||
{ "winnt-x86.32" "x86/32/winnt" }
|
||||
{ "unix-x86.32" "x86/32/unix" }
|
||||
{ "unix-x86.32" "x86/32/unix" }
|
||||
{ "winnt-x86.64" "x86/64/winnt" }
|
||||
{ "unix-x86.64" "x86/64/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
|
||||
|
||||
|
|
@ -419,6 +421,7 @@ tuple
|
|||
{ "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) }
|
||||
{ "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) }
|
||||
{ "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
|
||||
{ "(dlsym-raw)" "alien.libraries" "primitive_dlsym_raw" (( name dll -- alien )) }
|
||||
{ "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
|
||||
{ "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
|
||||
{ "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }
|
||||
|
|
|
|||
|
|
@ -4,9 +4,10 @@ USING: kernel kernel.private sequences math namespaces
|
|||
init splitting assocs system.private layouts words ;
|
||||
IN: system
|
||||
|
||||
SINGLETONS: x86.32 x86.64 arm ppc ;
|
||||
SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
|
||||
|
||||
UNION: x86 x86.32 x86.64 ;
|
||||
UNION: ppc ppc.32 ppc.64 ;
|
||||
|
||||
: cpu ( -- class ) \ cpu get-global ; foldable
|
||||
|
||||
|
|
@ -33,7 +34,8 @@ UNION: unix bsd solaris linux haiku ;
|
|||
{ "x86.32" x86.32 }
|
||||
{ "x86.64" x86.64 }
|
||||
{ "arm" arm }
|
||||
{ "ppc" ppc }
|
||||
{ "ppc.32" ppc.32 }
|
||||
{ "ppc.64" ppc.64 }
|
||||
} at ;
|
||||
|
||||
: string>os ( str -- class )
|
||||
|
|
|
|||
|
|
@ -1,128 +0,0 @@
|
|||
USING: cpu.ppc.assembler tools.test arrays kernel namespaces
|
||||
make vocabs sequences byte-arrays.hex ;
|
||||
FROM: cpu.ppc.assembler => B ;
|
||||
IN: cpu.ppc.assembler.tests
|
||||
|
||||
: test-assembler ( expected quot -- )
|
||||
[ 1array ] [ [ B{ } make ] curry ] bi* unit-test ;
|
||||
|
||||
HEX{ 38 22 00 03 } [ 1 2 3 ADDI ] test-assembler
|
||||
HEX{ 3c 22 00 03 } [ 1 2 3 ADDIS ] test-assembler
|
||||
HEX{ 30 22 00 03 } [ 1 2 3 ADDIC ] test-assembler
|
||||
HEX{ 34 22 00 03 } [ 1 2 3 ADDIC. ] test-assembler
|
||||
HEX{ 38 40 00 01 } [ 1 2 LI ] test-assembler
|
||||
HEX{ 3c 40 00 01 } [ 1 2 LIS ] test-assembler
|
||||
HEX{ 38 22 ff fd } [ 1 2 3 SUBI ] test-assembler
|
||||
HEX{ 1c 22 00 03 } [ 1 2 3 MULI ] test-assembler
|
||||
HEX{ 7c 22 1a 14 } [ 1 2 3 ADD ] test-assembler
|
||||
HEX{ 7c 22 1a 15 } [ 1 2 3 ADD. ] test-assembler
|
||||
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
|
||||
HEX{ 7c 22 1e 15 } [ 1 2 3 ADDO. ] test-assembler
|
||||
HEX{ 7c 22 18 14 } [ 1 2 3 ADDC ] test-assembler
|
||||
HEX{ 7c 22 18 15 } [ 1 2 3 ADDC. ] test-assembler
|
||||
HEX{ 7c 22 1e 14 } [ 1 2 3 ADDO ] test-assembler
|
||||
HEX{ 7c 22 1c 15 } [ 1 2 3 ADDCO. ] test-assembler
|
||||
HEX{ 7c 22 19 14 } [ 1 2 3 ADDE ] test-assembler
|
||||
HEX{ 7c 41 18 38 } [ 1 2 3 AND ] test-assembler
|
||||
HEX{ 7c 41 18 39 } [ 1 2 3 AND. ] test-assembler
|
||||
HEX{ 7c 22 1b d6 } [ 1 2 3 DIVW ] test-assembler
|
||||
HEX{ 7c 22 1b 96 } [ 1 2 3 DIVWU ] test-assembler
|
||||
HEX{ 7c 41 1a 38 } [ 1 2 3 EQV ] test-assembler
|
||||
HEX{ 7c 41 1b b8 } [ 1 2 3 NAND ] test-assembler
|
||||
HEX{ 7c 41 18 f8 } [ 1 2 3 NOR ] test-assembler
|
||||
HEX{ 7c 41 10 f8 } [ 1 2 NOT ] test-assembler
|
||||
HEX{ 60 41 00 03 } [ 1 2 3 ORI ] test-assembler
|
||||
HEX{ 64 41 00 03 } [ 1 2 3 ORIS ] test-assembler
|
||||
HEX{ 7c 41 1b 78 } [ 1 2 3 OR ] test-assembler
|
||||
HEX{ 7c 41 13 78 } [ 1 2 MR ] test-assembler
|
||||
HEX{ 7c 22 18 96 } [ 1 2 3 MULHW ] test-assembler
|
||||
HEX{ 1c 22 00 03 } [ 1 2 3 MULLI ] test-assembler
|
||||
HEX{ 7c 22 18 16 } [ 1 2 3 MULHWU ] test-assembler
|
||||
HEX{ 7c 22 19 d6 } [ 1 2 3 MULLW ] test-assembler
|
||||
HEX{ 7c 41 18 30 } [ 1 2 3 SLW ] test-assembler
|
||||
HEX{ 7c 41 1e 30 } [ 1 2 3 SRAW ] test-assembler
|
||||
HEX{ 7c 41 1c 30 } [ 1 2 3 SRW ] test-assembler
|
||||
HEX{ 7c 41 1e 70 } [ 1 2 3 SRAWI ] test-assembler
|
||||
HEX{ 7c 22 18 50 } [ 1 2 3 SUBF ] test-assembler
|
||||
HEX{ 7c 22 18 10 } [ 1 2 3 SUBFC ] test-assembler
|
||||
HEX{ 7c 22 19 10 } [ 1 2 3 SUBFE ] test-assembler
|
||||
HEX{ 7c 41 07 74 } [ 1 2 EXTSB ] test-assembler
|
||||
HEX{ 68 41 00 03 } [ 1 2 3 XORI ] test-assembler
|
||||
HEX{ 7c 41 1a 78 } [ 1 2 3 XOR ] test-assembler
|
||||
HEX{ 7c 22 00 d0 } [ 1 2 NEG ] test-assembler
|
||||
HEX{ 2c 22 00 03 } [ 1 2 3 CMPI ] test-assembler
|
||||
HEX{ 28 22 00 03 } [ 1 2 3 CMPLI ] test-assembler
|
||||
HEX{ 7c 41 18 00 } [ 1 2 3 CMP ] test-assembler
|
||||
HEX{ 54 22 19 0a } [ 1 2 3 4 5 RLWINM ] test-assembler
|
||||
HEX{ 54 22 18 38 } [ 1 2 3 SLWI ] test-assembler
|
||||
HEX{ 54 22 e8 fe } [ 1 2 3 SRWI ] test-assembler
|
||||
HEX{ 88 22 00 03 } [ 1 2 3 LBZ ] test-assembler
|
||||
HEX{ 8c 22 00 03 } [ 1 2 3 LBZU ] test-assembler
|
||||
HEX{ a8 22 00 03 } [ 1 2 3 LHA ] test-assembler
|
||||
HEX{ ac 22 00 03 } [ 1 2 3 LHAU ] test-assembler
|
||||
HEX{ a0 22 00 03 } [ 1 2 3 LHZ ] test-assembler
|
||||
HEX{ a4 22 00 03 } [ 1 2 3 LHZU ] test-assembler
|
||||
HEX{ 80 22 00 03 } [ 1 2 3 LWZ ] test-assembler
|
||||
HEX{ 84 22 00 03 } [ 1 2 3 LWZU ] test-assembler
|
||||
HEX{ 7c 41 18 ae } [ 1 2 3 LBZX ] test-assembler
|
||||
HEX{ 7c 41 18 ee } [ 1 2 3 LBZUX ] test-assembler
|
||||
HEX{ 7c 41 1a ae } [ 1 2 3 LHAX ] test-assembler
|
||||
HEX{ 7c 41 1a ee } [ 1 2 3 LHAUX ] test-assembler
|
||||
HEX{ 7c 41 1a 2e } [ 1 2 3 LHZX ] test-assembler
|
||||
HEX{ 7c 41 1a 6e } [ 1 2 3 LHZUX ] test-assembler
|
||||
HEX{ 7c 41 18 2e } [ 1 2 3 LWZX ] test-assembler
|
||||
HEX{ 7c 41 18 6e } [ 1 2 3 LWZUX ] test-assembler
|
||||
HEX{ 7c 41 1c 2e } [ 1 2 3 LFSX ] test-assembler
|
||||
HEX{ 7c 41 1c 6e } [ 1 2 3 LFSUX ] test-assembler
|
||||
HEX{ 7c 41 1c ae } [ 1 2 3 LFDX ] test-assembler
|
||||
HEX{ 7c 41 1c ee } [ 1 2 3 LFDUX ] test-assembler
|
||||
HEX{ 7c 41 1d 2e } [ 1 2 3 STFSX ] test-assembler
|
||||
HEX{ 7c 41 1d 6e } [ 1 2 3 STFSUX ] test-assembler
|
||||
HEX{ 7c 41 1d ae } [ 1 2 3 STFDX ] test-assembler
|
||||
HEX{ 7c 41 1d ee } [ 1 2 3 STFDUX ] test-assembler
|
||||
HEX{ 48 00 00 01 } [ 1 B ] test-assembler
|
||||
HEX{ 48 00 00 01 } [ 1 BL ] test-assembler
|
||||
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
|
||||
HEX{ 41 81 00 04 } [ 1 BGT ] test-assembler
|
||||
HEX{ 40 81 00 04 } [ 1 BLE ] test-assembler
|
||||
HEX{ 40 80 00 04 } [ 1 BGE ] test-assembler
|
||||
HEX{ 41 80 00 04 } [ 1 BLT ] test-assembler
|
||||
HEX{ 40 82 00 04 } [ 1 BNE ] test-assembler
|
||||
HEX{ 41 82 00 04 } [ 1 BEQ ] test-assembler
|
||||
HEX{ 41 83 00 04 } [ 1 BO ] test-assembler
|
||||
HEX{ 40 83 00 04 } [ 1 BNO ] test-assembler
|
||||
HEX{ 4c 20 00 20 } [ 1 BCLR ] test-assembler
|
||||
HEX{ 4e 80 00 20 } [ BLR ] test-assembler
|
||||
HEX{ 4e 80 00 21 } [ BLRL ] test-assembler
|
||||
HEX{ 4c 20 04 20 } [ 1 BCCTR ] test-assembler
|
||||
HEX{ 4e 80 04 20 } [ BCTR ] test-assembler
|
||||
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
|
||||
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
|
||||
HEX{ 7c 69 02 a6 } [ 3 MFCTR ] test-assembler
|
||||
HEX{ 7c 61 03 a6 } [ 3 MTXER ] test-assembler
|
||||
HEX{ 7c 68 03 a6 } [ 3 MTLR ] test-assembler
|
||||
HEX{ 7c 69 03 a6 } [ 3 MTCTR ] test-assembler
|
||||
HEX{ 7c 61 02 a6 } [ 3 MFXER ] test-assembler
|
||||
HEX{ 7c 68 02 a6 } [ 3 MFLR ] test-assembler
|
||||
HEX{ c0 22 00 03 } [ 1 2 3 LFS ] test-assembler
|
||||
HEX{ c4 22 00 03 } [ 1 2 3 LFSU ] test-assembler
|
||||
HEX{ c8 22 00 03 } [ 1 2 3 LFD ] test-assembler
|
||||
HEX{ cc 22 00 03 } [ 1 2 3 LFDU ] test-assembler
|
||||
HEX{ d0 22 00 03 } [ 1 2 3 STFS ] test-assembler
|
||||
HEX{ d4 22 00 03 } [ 1 2 3 STFSU ] test-assembler
|
||||
HEX{ d8 22 00 03 } [ 1 2 3 STFD ] test-assembler
|
||||
HEX{ dc 22 00 03 } [ 1 2 3 STFDU ] test-assembler
|
||||
HEX{ fc 20 10 90 } [ 1 2 FMR ] test-assembler
|
||||
HEX{ fc 40 08 90 } [ 2 1 FMR ] test-assembler
|
||||
HEX{ fc 20 10 91 } [ 1 2 FMR. ] test-assembler
|
||||
HEX{ fc 40 08 91 } [ 2 1 FMR. ] test-assembler
|
||||
HEX{ fc 20 10 1e } [ 1 2 FCTIWZ ] test-assembler
|
||||
HEX{ fc 22 18 2a } [ 1 2 3 FADD ] test-assembler
|
||||
HEX{ fc 22 18 2b } [ 1 2 3 FADD. ] test-assembler
|
||||
HEX{ fc 22 18 28 } [ 1 2 3 FSUB ] test-assembler
|
||||
HEX{ fc 22 00 f2 } [ 1 2 3 FMUL ] test-assembler
|
||||
HEX{ fc 22 18 24 } [ 1 2 3 FDIV ] test-assembler
|
||||
HEX{ fc 20 10 2c } [ 1 2 FSQRT ] test-assembler
|
||||
HEX{ fc 41 18 00 } [ 1 2 3 FCMPU ] test-assembler
|
||||
HEX{ fc 41 18 40 } [ 1 2 3 FCMPO ] test-assembler
|
||||
HEX{ 3c 60 12 34 60 63 56 78 } [ HEX: 12345678 3 LOAD ] test-assembler
|
||||
|
|
@ -1,428 +0,0 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces words math math.order locals
|
||||
cpu.ppc.assembler.backend ;
|
||||
IN: cpu.ppc.assembler
|
||||
|
||||
! See the Motorola or IBM documentation for details. The opcode
|
||||
! names are standard, and the operand order is the same as in
|
||||
! the docs, except a few differences, namely, in IBM/Motorola
|
||||
! assembler syntax, loads and stores are written like:
|
||||
!
|
||||
! stw r14,10(r15)
|
||||
!
|
||||
! In Factor, we write:
|
||||
!
|
||||
! 14 15 10 STW
|
||||
|
||||
! D-form
|
||||
D: ADDI 14
|
||||
D: ADDIC 12
|
||||
D: ADDIC. 13
|
||||
D: ADDIS 15
|
||||
D: CMPI 11
|
||||
D: CMPLI 10
|
||||
D: LBZ 34
|
||||
D: LBZU 35
|
||||
D: LFD 50
|
||||
D: LFDU 51
|
||||
D: LFS 48
|
||||
D: LFSU 49
|
||||
D: LHA 42
|
||||
D: LHAU 43
|
||||
D: LHZ 40
|
||||
D: LHZU 41
|
||||
D: LWZ 32
|
||||
D: LWZU 33
|
||||
D: MULI 7
|
||||
D: MULLI 7
|
||||
D: STB 38
|
||||
D: STBU 39
|
||||
D: STFD 54
|
||||
D: STFDU 55
|
||||
D: STFS 52
|
||||
D: STFSU 53
|
||||
D: STH 44
|
||||
D: STHU 45
|
||||
D: STW 36
|
||||
D: STWU 37
|
||||
|
||||
! SD-form
|
||||
SD: ANDI 28
|
||||
SD: ANDIS 29
|
||||
SD: ORI 24
|
||||
SD: ORIS 25
|
||||
SD: XORI 26
|
||||
SD: XORIS 27
|
||||
|
||||
! X-form
|
||||
X: AND 0 28 31
|
||||
X: AND. 1 28 31
|
||||
X: CMP 0 0 31
|
||||
X: CMPL 0 32 31
|
||||
X: EQV 0 284 31
|
||||
X: EQV. 1 284 31
|
||||
X: FCMPO 0 32 63
|
||||
X: FCMPU 0 0 63
|
||||
X: LBZUX 0 119 31
|
||||
X: LBZX 0 87 31
|
||||
X: LFDUX 0 631 31
|
||||
X: LFDX 0 599 31
|
||||
X: LFSUX 0 567 31
|
||||
X: LFSX 0 535 31
|
||||
X: LHAUX 0 375 31
|
||||
X: LHAX 0 343 31
|
||||
X: LHZUX 0 311 31
|
||||
X: LHZX 0 279 31
|
||||
X: LWZUX 0 55 31
|
||||
X: LWZX 0 23 31
|
||||
X: NAND 0 476 31
|
||||
X: NAND. 1 476 31
|
||||
X: NOR 0 124 31
|
||||
X: NOR. 1 124 31
|
||||
X: OR 0 444 31
|
||||
X: OR. 1 444 31
|
||||
X: ORC 0 412 31
|
||||
X: ORC. 1 412 31
|
||||
X: SLW 0 24 31
|
||||
X: SLW. 1 24 31
|
||||
X: SRAW 0 792 31
|
||||
X: SRAW. 1 792 31
|
||||
X: SRAWI 0 824 31
|
||||
X: SRW 0 536 31
|
||||
X: SRW. 1 536 31
|
||||
X: STBUX 0 247 31
|
||||
X: STBX 0 215 31
|
||||
X: STFDUX 0 759 31
|
||||
X: STFDX 0 727 31
|
||||
X: STFSUX 0 695 31
|
||||
X: STFSX 0 663 31
|
||||
X: STHUX 0 439 31
|
||||
X: STHX 0 407 31
|
||||
X: STWUX 0 183 31
|
||||
X: STWX 0 151 31
|
||||
X: XOR 0 316 31
|
||||
X: XOR. 1 316 31
|
||||
X1: EXTSB 0 954 31
|
||||
X1: EXTSB. 1 954 31
|
||||
: FRSP ( a s -- ) [ 0 ] 2dip 0 12 63 x-insn ;
|
||||
: FRSP. ( a s -- ) [ 0 ] 2dip 1 12 63 x-insn ;
|
||||
: FMR ( a s -- ) [ 0 ] 2dip 0 72 63 x-insn ;
|
||||
: FMR. ( a s -- ) [ 0 ] 2dip 1 72 63 x-insn ;
|
||||
: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ;
|
||||
: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ;
|
||||
|
||||
! XO-form
|
||||
XO: ADD 0 0 266 31
|
||||
XO: ADD. 0 1 266 31
|
||||
XO: ADDC 0 0 10 31
|
||||
XO: ADDC. 0 1 10 31
|
||||
XO: ADDCO 1 0 10 31
|
||||
XO: ADDCO. 1 1 10 31
|
||||
XO: ADDE 0 0 138 31
|
||||
XO: ADDE. 0 1 138 31
|
||||
XO: ADDEO 1 0 138 31
|
||||
XO: ADDEO. 1 1 138 31
|
||||
XO: ADDO 1 0 266 31
|
||||
XO: ADDO. 1 1 266 31
|
||||
XO: DIVW 0 0 491 31
|
||||
XO: DIVW. 0 1 491 31
|
||||
XO: DIVWO 1 0 491 31
|
||||
XO: DIVWO. 1 1 491 31
|
||||
XO: DIVWU 0 0 459 31
|
||||
XO: DIVWU. 0 1 459 31
|
||||
XO: DIVWUO 1 0 459 31
|
||||
XO: DIVWUO. 1 1 459 31
|
||||
XO: MULHW 0 0 75 31
|
||||
XO: MULHW. 0 1 75 31
|
||||
XO: MULHWU 0 0 11 31
|
||||
XO: MULHWU. 0 1 11 31
|
||||
XO: MULLW 0 0 235 31
|
||||
XO: MULLW. 0 1 235 31
|
||||
XO: MULLWO 1 0 235 31
|
||||
XO: MULLWO. 1 1 235 31
|
||||
XO: SUBF 0 0 40 31
|
||||
XO: SUBF. 0 1 40 31
|
||||
XO: SUBFC 0 0 8 31
|
||||
XO: SUBFC. 0 1 8 31
|
||||
XO: SUBFCO 1 0 8 31
|
||||
XO: SUBFCO. 1 1 8 31
|
||||
XO: SUBFE 0 0 136 31
|
||||
XO: SUBFE. 0 1 136 31
|
||||
XO: SUBFEO 1 0 136 31
|
||||
XO: SUBFEO. 1 1 136 31
|
||||
XO: SUBFO 1 0 40 31
|
||||
XO: SUBFO. 1 1 40 31
|
||||
XO1: NEG 0 0 104 31
|
||||
XO1: NEG. 0 1 104 31
|
||||
XO1: NEGO 1 0 104 31
|
||||
XO1: NEGO. 1 1 104 31
|
||||
|
||||
! A-form
|
||||
: RLWINM ( d a b c xo -- ) 0 21 a-insn ;
|
||||
: RLWINM. ( d a b c xo -- ) 1 21 a-insn ;
|
||||
: FADD ( d a b -- ) 0 21 0 63 a-insn ;
|
||||
: FADD. ( d a b -- ) 0 21 1 63 a-insn ;
|
||||
: FSUB ( d a b -- ) 0 20 0 63 a-insn ;
|
||||
: FSUB. ( d a b -- ) 0 20 1 63 a-insn ;
|
||||
: FMUL ( d a c -- ) 0 swap 25 0 63 a-insn ;
|
||||
: FMUL. ( d a c -- ) 0 swap 25 1 63 a-insn ;
|
||||
: FDIV ( d a b -- ) 0 18 0 63 a-insn ;
|
||||
: FDIV. ( d a b -- ) 0 18 1 63 a-insn ;
|
||||
: FSQRT ( d b -- ) 0 swap 0 22 0 63 a-insn ;
|
||||
: FSQRT. ( d b -- ) 0 swap 0 22 1 63 a-insn ;
|
||||
|
||||
! Branches
|
||||
: B ( dest -- ) 0 0 (B) ;
|
||||
: BL ( dest -- ) 0 1 (B) ;
|
||||
BC: LT 12 0
|
||||
BC: GE 4 0
|
||||
BC: GT 12 1
|
||||
BC: LE 4 1
|
||||
BC: EQ 12 2
|
||||
BC: NE 4 2
|
||||
BC: O 12 3
|
||||
BC: NO 4 3
|
||||
B: CLR 0 8 0 0 19
|
||||
B: CLRL 0 8 0 1 19
|
||||
B: CCTR 0 264 0 0 19
|
||||
: BLR ( -- ) 20 BCLR ;
|
||||
: BLRL ( -- ) 20 BCLRL ;
|
||||
: BCTR ( -- ) 20 BCCTR ;
|
||||
|
||||
! Special registers
|
||||
MFSPR: XER 1
|
||||
MFSPR: LR 8
|
||||
MFSPR: CTR 9
|
||||
MTSPR: XER 1
|
||||
MTSPR: LR 8
|
||||
MTSPR: CTR 9
|
||||
|
||||
! Pseudo-instructions
|
||||
: LI ( value dst -- ) swap [ 0 ] dip ADDI ; inline
|
||||
: SUBI ( dst src1 src2 -- ) neg ADDI ; inline
|
||||
: LIS ( value dst -- ) swap [ 0 ] dip ADDIS ; inline
|
||||
: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
|
||||
: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
|
||||
: NOT ( dst src -- ) dup NOR ; inline
|
||||
: NOT. ( dst src -- ) dup NOR. ; inline
|
||||
: MR ( dst src -- ) dup OR ; inline
|
||||
: MR. ( dst src -- ) dup OR. ; inline
|
||||
: (SLWI) ( d a b -- d a b x y ) 0 31 pick - ; inline
|
||||
: SLWI ( d a b -- ) (SLWI) RLWINM ;
|
||||
: SLWI. ( d a b -- ) (SLWI) RLWINM. ;
|
||||
: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
|
||||
: SRWI ( d a b -- ) (SRWI) RLWINM ;
|
||||
: SRWI. ( d a b -- ) (SRWI) RLWINM. ;
|
||||
:: LOAD32 ( n r -- )
|
||||
n -16 shift HEX: ffff bitand r LIS
|
||||
r r n HEX: ffff bitand ORI ;
|
||||
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
|
||||
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;
|
||||
|
||||
! Altivec/VMX instructions
|
||||
VA: VMHADDSHS 32 4
|
||||
VA: VMHRADDSHS 33 4
|
||||
VA: VMLADDUHM 34 4
|
||||
VA: VMSUMUBM 36 4
|
||||
VA: VMSUMMBM 37 4
|
||||
VA: VMSUMUHM 38 4
|
||||
VA: VMSUMUHS 39 4
|
||||
VA: VMSUMSHM 40 4
|
||||
VA: VMSUMSHS 41 4
|
||||
VA: VSEL 42 4
|
||||
VA: VPERM 43 4
|
||||
VA: VSLDOI 44 4
|
||||
VA: VMADDFP 46 4
|
||||
VA: VNMSUBFP 47 4
|
||||
|
||||
VX: VADDUBM 0 4
|
||||
VX: VADDUHM 64 4
|
||||
VX: VADDUWM 128 4
|
||||
VX: VADDCUW 384 4
|
||||
VX: VADDUBS 512 4
|
||||
VX: VADDUHS 576 4
|
||||
VX: VADDUWS 640 4
|
||||
VX: VADDSBS 768 4
|
||||
VX: VADDSHS 832 4
|
||||
VX: VADDSWS 896 4
|
||||
|
||||
VX: VSUBUBM 1024 4
|
||||
VX: VSUBUHM 1088 4
|
||||
VX: VSUBUWM 1152 4
|
||||
VX: VSUBCUW 1408 4
|
||||
VX: VSUBUBS 1536 4
|
||||
VX: VSUBUHS 1600 4
|
||||
VX: VSUBUWS 1664 4
|
||||
VX: VSUBSBS 1792 4
|
||||
VX: VSUBSHS 1856 4
|
||||
VX: VSUBSWS 1920 4
|
||||
|
||||
VX: VMAXUB 2 4
|
||||
VX: VMAXUH 66 4
|
||||
VX: VMAXUW 130 4
|
||||
VX: VMAXSB 258 4
|
||||
VX: VMAXSH 322 4
|
||||
VX: VMAXSW 386 4
|
||||
|
||||
VX: VMINUB 514 4
|
||||
VX: VMINUH 578 4
|
||||
VX: VMINUW 642 4
|
||||
VX: VMINSB 770 4
|
||||
VX: VMINSH 834 4
|
||||
VX: VMINSW 898 4
|
||||
|
||||
VX: VAVGUB 1026 4
|
||||
VX: VAVGUH 1090 4
|
||||
VX: VAVGUW 1154 4
|
||||
VX: VAVGSB 1282 4
|
||||
VX: VAVGSH 1346 4
|
||||
VX: VAVGSW 1410 4
|
||||
|
||||
VX: VRLB 4 4
|
||||
VX: VRLH 68 4
|
||||
VX: VRLW 132 4
|
||||
VX: VSLB 260 4
|
||||
VX: VSLH 324 4
|
||||
VX: VSLW 388 4
|
||||
VX: VSL 452 4
|
||||
VX: VSRB 516 4
|
||||
VX: VSRH 580 4
|
||||
VX: VSRW 644 4
|
||||
VX: VSR 708 4
|
||||
VX: VSRAB 772 4
|
||||
VX: VSRAH 836 4
|
||||
VX: VSRAW 900 4
|
||||
|
||||
VX: VAND 1028 4
|
||||
VX: VANDC 1092 4
|
||||
VX: VOR 1156 4
|
||||
VX: VNOR 1284 4
|
||||
VX: VXOR 1220 4
|
||||
|
||||
VXD: MFVSCR 1540 4
|
||||
VXB: MTVSCR 1604 4
|
||||
|
||||
VX: VMULOUB 8 4
|
||||
VX: VMULOUH 72 4
|
||||
VX: VMULOSB 264 4
|
||||
VX: VMULOSH 328 4
|
||||
VX: VMULEUB 520 4
|
||||
VX: VMULEUH 584 4
|
||||
VX: VMULESB 776 4
|
||||
VX: VMULESH 840 4
|
||||
VX: VSUM4UBS 1544 4
|
||||
VX: VSUM4SBS 1800 4
|
||||
VX: VSUM4SHS 1608 4
|
||||
VX: VSUM2SWS 1672 4
|
||||
VX: VSUMSWS 1928 4
|
||||
|
||||
VX: VADDFP 10 4
|
||||
VX: VSUBFP 74 4
|
||||
|
||||
VXDB: VREFP 266 4
|
||||
VXDB: VRSQRTEFP 330 4
|
||||
VXDB: VEXPTEFP 394 4
|
||||
VXDB: VLOGEFP 458 4
|
||||
VXDB: VRFIN 522 4
|
||||
VXDB: VRFIZ 586 4
|
||||
VXDB: VRFIP 650 4
|
||||
VXDB: VRFIM 714 4
|
||||
|
||||
VX: VCFUX 778 4
|
||||
VX: VCFSX 842 4
|
||||
VX: VCTUXS 906 4
|
||||
VX: VCTSXS 970 4
|
||||
|
||||
VX: VMAXFP 1034 4
|
||||
VX: VMINFP 1098 4
|
||||
|
||||
VX: VMRGHB 12 4
|
||||
VX: VMRGHH 76 4
|
||||
VX: VMRGHW 140 4
|
||||
VX: VMRGLB 268 4
|
||||
VX: VMRGLH 332 4
|
||||
VX: VMRGLW 396 4
|
||||
|
||||
VX: VSPLTB 524 4
|
||||
VX: VSPLTH 588 4
|
||||
VX: VSPLTW 652 4
|
||||
|
||||
VXA: VSPLTISB 780 4
|
||||
VXA: VSPLTISH 844 4
|
||||
VXA: VSPLTISW 908 4
|
||||
|
||||
VX: VSLO 1036 4
|
||||
VX: VSRO 1100 4
|
||||
|
||||
VX: VPKUHUM 14 4
|
||||
VX: VPKUWUM 78 4
|
||||
VX: VPKUHUS 142 4
|
||||
VX: VPKUWUS 206 4
|
||||
VX: VPKSHUS 270 4
|
||||
VX: VPKSWUS 334 4
|
||||
VX: VPKSHSS 398 4
|
||||
VX: VPKSWSS 462 4
|
||||
VX: VPKPX 782 4
|
||||
|
||||
VXDB: VUPKHSB 526 4
|
||||
VXDB: VUPKHSH 590 4
|
||||
VXDB: VUPKLSB 654 4
|
||||
VXDB: VUPKLSH 718 4
|
||||
VXDB: VUPKHPX 846 4
|
||||
VXDB: VUPKLPX 974 4
|
||||
|
||||
: -T ( strm a b -- strm-t a b ) [ 16 bitor ] 2dip ;
|
||||
|
||||
XD: DST 0 342 31
|
||||
: DSTT ( strm a b -- ) -T DST ;
|
||||
|
||||
XD: DSTST 0 374 31
|
||||
: DSTSTT ( strm a b -- ) -T DSTST ;
|
||||
|
||||
XD: (DSS) 0 822 31
|
||||
: DSS ( strm -- ) 0 0 (DSS) ;
|
||||
: DSSALL ( -- ) 16 0 0 (DSS) ;
|
||||
|
||||
XD: LVEBX 0 7 31
|
||||
XD: LVEHX 0 39 31
|
||||
XD: LVEWX 0 71 31
|
||||
XD: LVSL 0 6 31
|
||||
XD: LVSR 0 38 31
|
||||
XD: LVX 0 103 31
|
||||
XD: LVXL 0 359 31
|
||||
|
||||
XD: STVEBX 0 135 31
|
||||
XD: STVEHX 0 167 31
|
||||
XD: STVEWX 0 199 31
|
||||
XD: STVX 0 231 31
|
||||
XD: STVXL 0 487 31
|
||||
|
||||
VXR: VCMPBFP 0 966 4
|
||||
VXR: VCMPEQFP 0 198 4
|
||||
VXR: VCMPEQUB 0 6 4
|
||||
VXR: VCMPEQUH 0 70 4
|
||||
VXR: VCMPEQUW 0 134 4
|
||||
VXR: VCMPGEFP 0 454 4
|
||||
VXR: VCMPGTFP 0 710 4
|
||||
VXR: VCMPGTSB 0 774 4
|
||||
VXR: VCMPGTSH 0 838 4
|
||||
VXR: VCMPGTSW 0 902 4
|
||||
VXR: VCMPGTUB 0 518 4
|
||||
VXR: VCMPGTUH 0 582 4
|
||||
VXR: VCMPGTUW 0 646 4
|
||||
|
||||
VXR: VCMPBFP. 1 966 4
|
||||
VXR: VCMPEQFP. 1 198 4
|
||||
VXR: VCMPEQUB. 1 6 4
|
||||
VXR: VCMPEQUH. 1 70 4
|
||||
VXR: VCMPEQUW. 1 134 4
|
||||
VXR: VCMPGEFP. 1 454 4
|
||||
VXR: VCMPGTFP. 1 710 4
|
||||
VXR: VCMPGTSB. 1 774 4
|
||||
VXR: VCMPGTSH. 1 838 4
|
||||
VXR: VCMPGTSW. 1 902 4
|
||||
VXR: VCMPGTUB. 1 518 4
|
||||
VXR: VCMPGTUH. 1 582 4
|
||||
VXR: VCMPGTUW. 1 646 4
|
||||
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,132 +0,0 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces make sequences words math
|
||||
math.bitwise io.binary parser lexer fry ;
|
||||
IN: cpu.ppc.assembler.backend
|
||||
|
||||
: insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ;
|
||||
|
||||
: a-insn ( d a b c xo rc opcode -- )
|
||||
[ { 0 1 6 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: b-insn ( bo bi bd aa lk opcode -- )
|
||||
[ { 0 1 2 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: s>u16 ( s -- u ) HEX: ffff bitand ;
|
||||
|
||||
: d-insn ( d a simm opcode -- )
|
||||
[ s>u16 { 0 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: define-d-insn ( word opcode -- )
|
||||
[ d-insn ] curry (( d a simm -- )) define-declared ;
|
||||
|
||||
SYNTAX: D: CREATE scan-word define-d-insn ;
|
||||
|
||||
: sd-insn ( d a simm opcode -- )
|
||||
[ s>u16 { 0 21 16 } bitfield ] dip insn ;
|
||||
|
||||
: define-sd-insn ( word opcode -- )
|
||||
[ sd-insn ] curry (( d a simm -- )) define-declared ;
|
||||
|
||||
SYNTAX: SD: CREATE scan-word define-sd-insn ;
|
||||
|
||||
: i-insn ( li aa lk opcode -- )
|
||||
[ { 0 1 0 } bitfield ] dip insn ;
|
||||
|
||||
: x-insn ( a s b rc xo opcode -- )
|
||||
[ { 1 0 11 21 16 } bitfield ] dip insn ;
|
||||
|
||||
: xd-insn ( d a b rc xo opcode -- )
|
||||
[ { 1 0 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: (X) ( -- word quot )
|
||||
CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
|
||||
|
||||
: (XD) ( -- word quot )
|
||||
CREATE scan-word scan-word scan-word [ xd-insn ] 3curry ;
|
||||
|
||||
SYNTAX: X: (X) (( a s b -- )) define-declared ;
|
||||
SYNTAX: XD: (XD) (( d a b -- )) define-declared ;
|
||||
|
||||
: (1) ( quot -- quot' ) [ 0 ] prepose ;
|
||||
|
||||
SYNTAX: X1: (X) (1) (( a s -- )) define-declared ;
|
||||
|
||||
: xfx-insn ( d spr xo opcode -- )
|
||||
[ { 1 11 21 } bitfield ] dip insn ;
|
||||
|
||||
: CREATE-MF ( -- word ) scan "MF" prepend create-in ;
|
||||
|
||||
SYNTAX: MFSPR:
|
||||
CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry
|
||||
(( d -- )) define-declared ;
|
||||
|
||||
: CREATE-MT ( -- word ) scan "MT" prepend create-in ;
|
||||
|
||||
SYNTAX: MTSPR:
|
||||
CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry
|
||||
(( d -- )) define-declared ;
|
||||
|
||||
: xo-insn ( d a b oe rc xo opcode -- )
|
||||
[ { 1 0 10 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: (XO) ( -- word quot )
|
||||
CREATE scan-word scan-word scan-word scan-word
|
||||
[ xo-insn ] 2curry 2curry ;
|
||||
|
||||
SYNTAX: XO: (XO) (( d a b -- )) define-declared ;
|
||||
|
||||
SYNTAX: XO1: (XO) (1) (( d a -- )) define-declared ;
|
||||
|
||||
GENERIC# (B) 2 ( dest aa lk -- )
|
||||
M: integer (B) 18 i-insn ;
|
||||
|
||||
GENERIC: BC ( a b c -- )
|
||||
M: integer BC 0 0 16 b-insn ;
|
||||
|
||||
: CREATE-B ( -- word ) scan "B" prepend create-in ;
|
||||
|
||||
SYNTAX: BC:
|
||||
CREATE-B scan-word scan-word
|
||||
'[ [ _ _ ] dip BC ] (( c -- )) define-declared ;
|
||||
|
||||
SYNTAX: B:
|
||||
CREATE-B scan-word scan-word scan-word scan-word scan-word
|
||||
'[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ;
|
||||
|
||||
: va-insn ( d a b c xo opcode -- )
|
||||
[ { 0 6 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: (VA) ( -- word quot )
|
||||
CREATE scan-word scan-word [ va-insn ] 2curry ;
|
||||
|
||||
SYNTAX: VA: (VA) (( d a b c -- )) define-declared ;
|
||||
|
||||
: vx-insn ( d a b xo opcode -- )
|
||||
[ { 0 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: (VX) ( -- word quot )
|
||||
CREATE scan-word scan-word [ vx-insn ] 2curry ;
|
||||
: (VXD) ( -- word quot )
|
||||
CREATE scan-word scan-word '[ 0 0 _ _ vx-insn ] ;
|
||||
: (VXA) ( -- word quot )
|
||||
CREATE scan-word scan-word '[ [ 0 ] dip 0 _ _ vx-insn ] ;
|
||||
: (VXB) ( -- word quot )
|
||||
CREATE scan-word scan-word '[ [ 0 0 ] dip _ _ vx-insn ] ;
|
||||
: (VXDB) ( -- word quot )
|
||||
CREATE scan-word scan-word '[ [ 0 ] dip _ _ vx-insn ] ;
|
||||
|
||||
SYNTAX: VX: (VX) (( d a b -- )) define-declared ;
|
||||
SYNTAX: VXD: (VXD) (( d -- )) define-declared ;
|
||||
SYNTAX: VXA: (VXA) (( a -- )) define-declared ;
|
||||
SYNTAX: VXB: (VXB) (( b -- )) define-declared ;
|
||||
SYNTAX: VXDB: (VXDB) (( d b -- )) define-declared ;
|
||||
|
||||
: vxr-insn ( d a b rc xo opcode -- )
|
||||
[ { 0 10 11 16 21 } bitfield ] dip insn ;
|
||||
|
||||
: (VXR) ( -- word quot )
|
||||
CREATE scan-word scan-word scan-word [ vxr-insn ] 3curry ;
|
||||
|
||||
SYNTAX: VXR: (VXR) (( d a b -- )) define-declared ;
|
||||
|
||||
|
|
@ -1 +0,0 @@
|
|||
PowerPC assembler
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,839 +0,0 @@
|
|||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! 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
|
||||
|
||||
4 \ cell set
|
||||
big-endian on
|
||||
|
||||
CONSTANT: ds-reg 13
|
||||
CONSTANT: rs-reg 14
|
||||
CONSTANT: vm-reg 15
|
||||
CONSTANT: ctx-reg 16
|
||||
CONSTANT: nv-reg 17
|
||||
|
||||
: jit-call ( string -- )
|
||||
0 2 LOAD32 rc-absolute-ppc-2/2 jit-dlsym
|
||||
2 MTLR
|
||||
BLRL ;
|
||||
|
||||
: jit-call-quot ( -- )
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTLR
|
||||
BLRL ;
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR ;
|
||||
|
||||
: factor-area-size ( -- n ) 16 ;
|
||||
|
||||
: stack-frame ( -- n )
|
||||
reserved-size
|
||||
factor-area-size +
|
||||
16 align ;
|
||||
|
||||
: next-save ( -- n ) stack-frame 4 - ;
|
||||
: xt-save ( -- n ) stack-frame 8 - ;
|
||||
|
||||
: param-size ( -- n ) 32 ;
|
||||
|
||||
: save-at ( m -- n ) reserved-size + param-size + ;
|
||||
|
||||
: save-int ( register offset -- ) [ 1 ] dip save-at STW ;
|
||||
: restore-int ( register offset -- ) [ 1 ] dip save-at LWZ ;
|
||||
|
||||
: save-fp ( register offset -- ) [ 1 ] dip save-at STFD ;
|
||||
: restore-fp ( register offset -- ) [ 1 ] dip save-at LFD ;
|
||||
|
||||
: save-vec ( register offset -- ) save-at 2 LI 2 1 STVXL ;
|
||||
: restore-vec ( register offset -- ) save-at 2 LI 2 1 LVXL ;
|
||||
|
||||
: nv-int-regs ( -- seq ) 13 31 [a,b] ;
|
||||
: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
|
||||
: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
|
||||
|
||||
: saved-int-regs-size ( -- n ) 96 ;
|
||||
: saved-fp-regs-size ( -- n ) 144 ;
|
||||
: saved-vec-regs-size ( -- n ) 208 ;
|
||||
|
||||
: callback-frame-size ( -- n )
|
||||
reserved-size
|
||||
param-size +
|
||||
saved-int-regs-size +
|
||||
saved-fp-regs-size +
|
||||
saved-vec-regs-size +
|
||||
4 +
|
||||
16 align ;
|
||||
|
||||
: old-context-save-offset ( -- n )
|
||||
432 save-at ;
|
||||
|
||||
[
|
||||
! Save old stack pointer
|
||||
11 1 MR
|
||||
|
||||
! Create stack frame
|
||||
0 MFLR
|
||||
1 1 callback-frame-size SUBI
|
||||
0 1 callback-frame-size lr-save + STW
|
||||
|
||||
! Save all non-volatile registers
|
||||
nv-int-regs [ 4 * save-int ] each-index
|
||||
nv-fp-regs [ 8 * 80 + save-fp ] each-index
|
||||
nv-vec-regs [ 16 * 224 + save-vec ] each-index
|
||||
|
||||
! Stick old stack pointer in a non-volatile register so that
|
||||
! callbacks can access their arguments
|
||||
nv-reg 11 MR
|
||||
|
||||
! Load VM into vm-reg
|
||||
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
|
||||
! Save old context
|
||||
2 vm-reg vm-context-offset LWZ
|
||||
2 1 old-context-save-offset STW
|
||||
|
||||
! Switch over to the spare context
|
||||
2 vm-reg vm-spare-context-offset LWZ
|
||||
2 vm-reg vm-context-offset STW
|
||||
|
||||
! Save C callstack pointer
|
||||
1 2 context-callstack-save-offset STW
|
||||
|
||||
! Load Factor callstack pointer
|
||||
1 2 context-callstack-bottom-offset LWZ
|
||||
|
||||
! Call into Factor code
|
||||
0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel
|
||||
2 MTLR
|
||||
BLRL
|
||||
|
||||
! Load VM again, pointlessly
|
||||
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
|
||||
! Load C callstack pointer
|
||||
2 vm-reg vm-context-offset LWZ
|
||||
1 2 context-callstack-save-offset LWZ
|
||||
|
||||
! Load old context
|
||||
2 1 old-context-save-offset LWZ
|
||||
2 vm-reg vm-context-offset STW
|
||||
|
||||
! Restore non-volatile registers
|
||||
nv-vec-regs [ 16 * 224 + restore-vec ] each-index
|
||||
nv-fp-regs [ 8 * 80 + restore-fp ] each-index
|
||||
nv-int-regs [ 4 * restore-int ] each-index
|
||||
|
||||
! Tear down stack frame and return
|
||||
0 1 callback-frame-size lr-save + LWZ
|
||||
1 1 callback-frame-size ADDI
|
||||
0 MTLR
|
||||
BLR
|
||||
] callback-stub jit-define
|
||||
|
||||
: jit-conditional* ( test-quot false-quot -- )
|
||||
[ '[ 4 /i 1 + @ ] ] dip jit-conditional ; inline
|
||||
|
||||
: jit-load-context ( -- )
|
||||
ctx-reg vm-reg vm-context-offset LWZ ;
|
||||
|
||||
: jit-save-context ( -- )
|
||||
jit-load-context
|
||||
1 ctx-reg context-callstack-top-offset STW
|
||||
ds-reg ctx-reg context-datastack-offset STW
|
||||
rs-reg ctx-reg context-retainstack-offset STW ;
|
||||
|
||||
: jit-restore-context ( -- )
|
||||
ds-reg ctx-reg context-datastack-offset LWZ
|
||||
rs-reg ctx-reg context-retainstack-offset LWZ ;
|
||||
|
||||
[
|
||||
0 12 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
|
||||
11 12 profile-count-offset LWZ
|
||||
11 11 1 tag-fixnum ADDI
|
||||
11 12 profile-count-offset STW
|
||||
11 12 word-code-offset LWZ
|
||||
11 11 compiled-header-size ADDI
|
||||
11 MTCTR
|
||||
BCTR
|
||||
] jit-profiling jit-define
|
||||
|
||||
[
|
||||
0 2 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
|
||||
0 MFLR
|
||||
1 1 stack-frame SUBI
|
||||
2 1 xt-save STW
|
||||
stack-frame 2 LI
|
||||
2 1 next-save STW
|
||||
0 1 lr-save stack-frame + STW
|
||||
] jit-prolog jit-define
|
||||
|
||||
[
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
|
||||
3 ds-reg 4 STWU
|
||||
] jit-push jit-define
|
||||
|
||||
[
|
||||
jit-save-context
|
||||
3 vm-reg MR
|
||||
0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel
|
||||
4 MTLR
|
||||
BLRL
|
||||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
|
||||
[ 0 BL rc-relative-ppc-3 rt-entry-point-pic jit-rel ] jit-word-call jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel
|
||||
0 B rc-relative-ppc-3 rt-entry-point-pic-tail jit-rel
|
||||
] jit-word-jump jit-define
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
0 3 \ f type-number CMPI
|
||||
[ BEQ ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional*
|
||||
0 B rc-relative-ppc-3 rt-entry-point jit-rel
|
||||
] jit-if jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
4 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
4 rs-reg 4 STWU ;
|
||||
|
||||
: jit-2>r ( -- )
|
||||
4 ds-reg 0 LWZ
|
||||
5 ds-reg -4 LWZ
|
||||
ds-reg dup 8 SUBI
|
||||
rs-reg dup 8 ADDI
|
||||
4 rs-reg 0 STW
|
||||
5 rs-reg -4 STW ;
|
||||
|
||||
: jit-3>r ( -- )
|
||||
4 ds-reg 0 LWZ
|
||||
5 ds-reg -4 LWZ
|
||||
6 ds-reg -8 LWZ
|
||||
ds-reg dup 12 SUBI
|
||||
rs-reg dup 12 ADDI
|
||||
4 rs-reg 0 STW
|
||||
5 rs-reg -4 STW
|
||||
6 rs-reg -8 STW ;
|
||||
|
||||
: jit-r> ( -- )
|
||||
4 rs-reg 0 LWZ
|
||||
rs-reg dup 4 SUBI
|
||||
4 ds-reg 4 STWU ;
|
||||
|
||||
: jit-2r> ( -- )
|
||||
4 rs-reg 0 LWZ
|
||||
5 rs-reg -4 LWZ
|
||||
rs-reg dup 8 SUBI
|
||||
ds-reg dup 8 ADDI
|
||||
4 ds-reg 0 STW
|
||||
5 ds-reg -4 STW ;
|
||||
|
||||
: jit-3r> ( -- )
|
||||
4 rs-reg 0 LWZ
|
||||
5 rs-reg -4 LWZ
|
||||
6 rs-reg -8 LWZ
|
||||
rs-reg dup 12 SUBI
|
||||
ds-reg dup 12 ADDI
|
||||
4 ds-reg 0 STW
|
||||
5 ds-reg -4 STW
|
||||
6 ds-reg -8 STW ;
|
||||
|
||||
[
|
||||
jit->r
|
||||
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
|
||||
jit-r>
|
||||
] jit-dip jit-define
|
||||
|
||||
[
|
||||
jit-2>r
|
||||
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
|
||||
jit-2r>
|
||||
] jit-2dip jit-define
|
||||
|
||||
[
|
||||
jit-3>r
|
||||
0 BL rc-relative-ppc-3 rt-entry-point jit-rel
|
||||
jit-3r>
|
||||
] jit-3dip jit-define
|
||||
|
||||
[
|
||||
0 1 lr-save stack-frame + LWZ
|
||||
1 1 stack-frame ADDI
|
||||
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 LWZ 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 CMPI
|
||||
[ BNE ]
|
||||
[ 4 3 tuple-class-offset LWZ ]
|
||||
jit-conditional*
|
||||
] pic-tuple jit-define
|
||||
|
||||
[
|
||||
0 4 0 CMPI rc-absolute-ppc-2 rt-untagged jit-rel
|
||||
] pic-check-tag jit-define
|
||||
|
||||
[
|
||||
0 5 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
|
||||
4 0 5 CMP
|
||||
] pic-check-tuple jit-define
|
||||
|
||||
[
|
||||
[ BNE ] [ 0 B rc-relative-ppc-3 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
|
||||
"inline_cache_miss" jit-call
|
||||
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
|
||||
4 4 tag-bits get SLWI
|
||||
0 4 tuple type-number tag-fixnum CMPI
|
||||
[ BNE ]
|
||||
[ 4 3 tuple-class-offset LWZ ]
|
||||
jit-conditional*
|
||||
! cache = ...
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
|
||||
! key = hashcode(class)
|
||||
5 4 1 SRAWI
|
||||
! 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 LWZ
|
||||
6 0 4 CMP
|
||||
[ BNE ]
|
||||
[
|
||||
! megamorphic_cache_hits++
|
||||
0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel
|
||||
5 4 0 LWZ
|
||||
5 5 1 ADDI
|
||||
5 4 0 STW
|
||||
! ... goto get(cache + 4)
|
||||
3 3 4 LWZ
|
||||
3 3 word-entry-point-offset LWZ
|
||||
3 MTCTR
|
||||
BCTR
|
||||
]
|
||||
jit-conditional*
|
||||
! fall-through on miss
|
||||
] mega-lookup jit-define
|
||||
|
||||
! ! ! Sub-primitives
|
||||
|
||||
! Quotations and words
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ] \ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
4 3 word-entry-point-offset LWZ
|
||||
]
|
||||
[ 4 MTLR BLRL ]
|
||||
[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
4 3 word-entry-point-offset LWZ
|
||||
4 MTCTR BCTR
|
||||
] jit-execute jit-define
|
||||
|
||||
! Special primitives
|
||||
[
|
||||
nv-reg 3 MR
|
||||
|
||||
3 vm-reg MR
|
||||
"begin_callback" jit-call
|
||||
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Call quotation
|
||||
3 nv-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
|
||||
0 vm-reg LOAD32 0 rc-absolute-ppc-2/2 jit-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 LWZ
|
||||
0 MTLR
|
||||
|
||||
! Call quotation
|
||||
jit-call-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
! Load callstack object
|
||||
6 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-context
|
||||
3 ctx-reg context-callstack-bottom-offset LWZ
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
4 6 callstack-top-offset ADDI
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
5 6 callstack-length-offset LWZ
|
||||
5 5 tag-bits get SRAWI
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
3 5 3 SUBF
|
||||
! Install new stack pointer
|
||||
1 3 MR
|
||||
! Call memcpy; arguments are now in the correct registers
|
||||
1 1 -64 STWU
|
||||
"factor_memcpy" jit-call
|
||||
1 1 0 LWZ
|
||||
! Return with new callstack
|
||||
0 1 lr-save LWZ
|
||||
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 LWZ
|
||||
3 3 tag-mask get ANDI
|
||||
3 3 tag-bits get SLWI
|
||||
3 ds-reg 0 STW
|
||||
] \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
3 3 2 SRAWI
|
||||
4 4 0 0 31 tag-bits get - RLWINM
|
||||
4 3 3 LWZX
|
||||
3 ds-reg 0 STW
|
||||
] \ slot define-sub-primitive
|
||||
|
||||
[
|
||||
! load string index from stack
|
||||
3 ds-reg -4 LWZ
|
||||
3 3 tag-bits get SRAWI
|
||||
! load string from stack
|
||||
4 ds-reg 0 LWZ
|
||||
! load character
|
||||
4 4 string-offset ADDI
|
||||
3 3 4 LBZX
|
||||
3 3 tag-bits get SLWI
|
||||
! store character to stack
|
||||
ds-reg ds-reg 4 SUBI
|
||||
3 ds-reg 0 STW
|
||||
] \ string-nth-fast define-sub-primitive
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg dup 4 SUBI
|
||||
] \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 8 SUBI
|
||||
] \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 12 SUBI
|
||||
] \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg dup 8 ADDI
|
||||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
] \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
ds-reg dup 12 ADDI
|
||||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
5 ds-reg -8 STW
|
||||
] \ 3dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
3 ds-reg 0 STW
|
||||
] \ nip define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 8 SUBI
|
||||
3 ds-reg 0 STW
|
||||
] \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -4 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] \ over define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -8 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] \ pick define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
4 ds-reg 0 STW
|
||||
3 ds-reg 4 STWU
|
||||
] \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
3 ds-reg -4 STW
|
||||
4 ds-reg 0 STW
|
||||
] \ swap define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -4 LWZ
|
||||
4 ds-reg -8 LWZ
|
||||
3 ds-reg -8 STW
|
||||
4 ds-reg -4 STW
|
||||
] \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
4 ds-reg -8 STW
|
||||
3 ds-reg -4 STW
|
||||
5 ds-reg 0 STW
|
||||
] \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
3 ds-reg -8 STW
|
||||
5 ds-reg -4 STW
|
||||
4 ds-reg 0 STW
|
||||
] \ -rot define-sub-primitive
|
||||
|
||||
[ jit->r ] \ load-local define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
t jit-literal
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
|
||||
4 ds-reg 0 LWZ
|
||||
5 ds-reg -4 LWZU
|
||||
5 0 4 CMP
|
||||
2 swap execute( offset -- ) ! magic number
|
||||
\ f type-number 3 LI
|
||||
3 ds-reg 0 STW ;
|
||||
|
||||
: 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 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
3 3 4 OR
|
||||
3 3 tag-mask get ANDI
|
||||
\ f type-number 4 LI
|
||||
0 3 0 CMPI
|
||||
[ BNE ] [ 1 tag-fixnum 4 LI ] jit-conditional*
|
||||
4 ds-reg 0 STW
|
||||
] \ both-fixnums? define-sub-primitive
|
||||
|
||||
: jit-math ( insn -- )
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
[ 5 3 4 ] dip execute( dst src1 src2 -- )
|
||||
5 ds-reg 0 STW ;
|
||||
|
||||
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
4 4 tag-bits get SRAWI
|
||||
5 3 4 MULLW
|
||||
5 ds-reg 0 STW
|
||||
] \ 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 LWZ
|
||||
3 3 NOT
|
||||
3 3 tag-mask get XORI
|
||||
3 ds-reg 0 STW
|
||||
] \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 tag-bits get SRAWI
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
5 4 3 SLW
|
||||
6 3 NEG
|
||||
7 4 6 SRAW
|
||||
7 7 0 0 31 tag-bits get - RLWINM
|
||||
0 3 0 CMPI
|
||||
[ BGT ] [ 5 7 MR ] jit-conditional*
|
||||
5 ds-reg 0 STW
|
||||
] \ fixnum-shift-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
5 4 3 DIVW
|
||||
6 5 3 MULLW
|
||||
7 6 4 SUBF
|
||||
7 ds-reg 0 STW
|
||||
] \ fixnum-mod define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
4 ds-reg 0 LWZ
|
||||
5 4 3 DIVW
|
||||
5 5 tag-bits get SLWI
|
||||
5 ds-reg 0 STW
|
||||
] \ fixnum/i-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 4 3 DIVW
|
||||
6 5 3 MULLW
|
||||
7 6 4 SUBF
|
||||
5 5 tag-bits get SLWI
|
||||
5 ds-reg -4 STW
|
||||
7 ds-reg 0 STW
|
||||
] \ fixnum/mod-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 2 SRAWI
|
||||
rs-reg 3 3 LWZX
|
||||
3 ds-reg 0 STW
|
||||
] \ get-local define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
3 3 2 SRAWI
|
||||
rs-reg 3 rs-reg SUBF
|
||||
] \ drop-locals define-sub-primitive
|
||||
|
||||
! Overflowing fixnum arithmetic
|
||||
:: jit-overflow ( insn func -- )
|
||||
ds-reg ds-reg 4 SUBI
|
||||
jit-save-context
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg 4 LWZ
|
||||
0 0 LI
|
||||
0 MTXER
|
||||
6 4 3 insn call( d a s -- )
|
||||
6 ds-reg 0 STW
|
||||
[ BNO ]
|
||||
[
|
||||
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 4 SUBI
|
||||
jit-save-context
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 tag-bits get SRAWI
|
||||
4 ds-reg 4 LWZ
|
||||
0 0 LI
|
||||
0 MTXER
|
||||
6 3 4 MULLWO.
|
||||
6 ds-reg 0 STW
|
||||
[ BNO ]
|
||||
[
|
||||
4 4 tag-bits get SRAWI
|
||||
5 vm-reg MR
|
||||
"overflow_fixnum_multiply" jit-call
|
||||
]
|
||||
jit-conditional*
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-save-context
|
||||
|
||||
! Make the new context the current one
|
||||
ctx-reg swap MR
|
||||
ctx-reg vm-reg vm-context-offset STW
|
||||
|
||||
! Load new stack pointer
|
||||
1 ctx-reg context-callstack-top-offset LWZ
|
||||
|
||||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
: jit-pop-context-and-param ( -- )
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 alien-offset LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg ds-reg 8 SUBI ;
|
||||
|
||||
: jit-push-param ( -- )
|
||||
ds-reg ds-reg 4 ADDI
|
||||
4 ds-reg 0 STW ;
|
||||
|
||||
: jit-set-context ( -- )
|
||||
jit-pop-context-and-param
|
||||
3 jit-switch-context
|
||||
jit-push-param ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-pop-quot-and-param ( -- )
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg ds-reg 8 SUBI ;
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
3 vm-reg MR
|
||||
"new_context" jit-call
|
||||
6 3 MR
|
||||
|
||||
jit-pop-quot-and-param
|
||||
|
||||
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-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser system kernel sequences ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
: reserved-size ( -- n ) 24 ;
|
||||
: lr-save ( -- n ) 4 ;
|
||||
|
||||
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors system kernel layouts
|
||||
alien.c-types cpu.architecture cpu.ppc ;
|
||||
IN: cpu.ppc.linux
|
||||
|
||||
<<
|
||||
t "longlong" c-type stack-align?<<
|
||||
t "ulonglong" c-type stack-align?<<
|
||||
>>
|
||||
|
||||
M: linux reserved-area-size 2 cells ;
|
||||
|
||||
M: linux lr-save 1 cells ;
|
||||
|
||||
M: ppc param-regs
|
||||
drop {
|
||||
{ int-regs { 3 4 5 6 7 8 9 10 } }
|
||||
{ float-regs { 1 2 3 4 5 6 7 8 } }
|
||||
} ;
|
||||
|
||||
M: ppc value-struct? drop f ;
|
||||
|
||||
M: ppc dummy-stack-params? f ;
|
||||
|
||||
M: ppc dummy-int-params? f ;
|
||||
|
||||
M: ppc dummy-fp-params? f ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Linux/PPC ABI support
|
||||
|
|
@ -1 +0,0 @@
|
|||
not loaded
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser system kernel sequences ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
: reserved-size ( -- n ) 24 ;
|
||||
: lr-save ( -- n ) 8 ;
|
||||
|
||||
<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors system kernel layouts
|
||||
alien.c-types cpu.architecture cpu.ppc ;
|
||||
IN: cpu.ppc.macosx
|
||||
|
||||
M: macosx reserved-area-size 6 cells ;
|
||||
|
||||
M: macosx lr-save 2 cells ;
|
||||
|
||||
M: ppc param-regs
|
||||
drop {
|
||||
{ int-regs { 3 4 5 6 7 8 9 10 } }
|
||||
{ float-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
|
||||
} ;
|
||||
|
||||
M: ppc value-struct? drop t ;
|
||||
|
||||
M: ppc dummy-stack-params? t ;
|
||||
|
||||
M: ppc dummy-int-params? t ;
|
||||
|
||||
M: ppc dummy-fp-params? f ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Mac OS X/PPC ABI support
|
||||
|
|
@ -1 +0,0 @@
|
|||
not loaded
|
||||
|
|
@ -1,826 +0,0 @@
|
|||
! Copyright (C) 2005, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs sequences kernel combinators
|
||||
classes.algebra byte-arrays make math math.order math.ranges
|
||||
system namespaces locals layouts words alien alien.accessors
|
||||
alien.c-types alien.complex alien.data alien.libraries
|
||||
literals cpu.architecture cpu.ppc.assembler cpu.ppc.assembler.backend
|
||||
compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.comparisons compiler.codegen.fixup
|
||||
compiler.cfg.intrinsics compiler.cfg.stack-frame
|
||||
compiler.cfg.build-stack-frame compiler.units compiler.constants
|
||||
compiler.codegen vm ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
FROM: cpu.ppc.assembler => B ;
|
||||
FROM: layouts => cell ;
|
||||
FROM: math => float ;
|
||||
IN: cpu.ppc
|
||||
|
||||
! PowerPC register assignments:
|
||||
! r2-r12: integer vregs
|
||||
! r13: data stack
|
||||
! r14: retain stack
|
||||
! r15: VM pointer
|
||||
! r16-r29: integer vregs
|
||||
! r30: integer scratch
|
||||
! f0-f29: float vregs
|
||||
! f30: float scratch
|
||||
|
||||
! Add some methods to the assembler that are useful to us
|
||||
M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ;
|
||||
M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
|
||||
|
||||
enable-float-intrinsics
|
||||
|
||||
M: ppc machine-registers
|
||||
{
|
||||
{ int-regs $[ 2 12 [a,b] 16 29 [a,b] append ] }
|
||||
{ float-regs $[ 0 29 [a,b] ] }
|
||||
} ;
|
||||
|
||||
CONSTANT: scratch-reg 30
|
||||
CONSTANT: fp-scratch-reg 30
|
||||
|
||||
M: ppc complex-addressing? f ;
|
||||
|
||||
M: ppc fused-unboxing? f ;
|
||||
|
||||
M: ppc %load-immediate ( reg n -- ) swap LOAD ;
|
||||
|
||||
M: ppc %load-reference ( reg obj -- )
|
||||
[ [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-literal ] bi* ]
|
||||
[ \ f type-number swap LI ]
|
||||
if* ;
|
||||
|
||||
M: ppc %alien-global ( register symbol dll -- )
|
||||
[ 0 swap LOAD32 ] 2dip rc-absolute-ppc-2/2 rel-dlsym ;
|
||||
|
||||
CONSTANT: ds-reg 13
|
||||
CONSTANT: rs-reg 14
|
||||
CONSTANT: vm-reg 15
|
||||
|
||||
: %load-vm-addr ( reg -- ) vm-reg MR ;
|
||||
|
||||
M: ppc %vm-field ( dst field -- ) [ vm-reg ] dip LWZ ;
|
||||
|
||||
M: ppc %set-vm-field ( src field -- ) [ vm-reg ] dip STW ;
|
||||
|
||||
GENERIC: loc-reg ( loc -- reg )
|
||||
|
||||
M: ds-loc loc-reg drop ds-reg ;
|
||||
M: rs-loc loc-reg drop rs-reg ;
|
||||
|
||||
: loc>operand ( loc -- reg n )
|
||||
[ loc-reg ] [ n>> cells neg ] bi ; inline
|
||||
|
||||
M: ppc %peek loc>operand LWZ ;
|
||||
M: ppc %replace loc>operand STW ;
|
||||
|
||||
:: (%inc) ( n reg -- ) reg reg n cells ADDI ; inline
|
||||
|
||||
M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
|
||||
M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
|
||||
|
||||
HOOK: reserved-area-size os ( -- n )
|
||||
|
||||
! The start of the stack frame contains the size of this frame
|
||||
! as well as the currently executing code block
|
||||
: factor-area-size ( -- n ) 2 cells ; foldable
|
||||
: next-save ( n -- i ) cell - ; foldable
|
||||
: xt-save ( n -- i ) 2 cells - ; foldable
|
||||
|
||||
! Next, we have the spill area as well as the FFI parameter area.
|
||||
! It is safe for them to overlap, since basic blocks with FFI calls
|
||||
! will never spill -- indeed, basic blocks with FFI calls do not
|
||||
! use vregs at all, and the FFI call is a stack analysis sync point.
|
||||
! In the future this will change and the stack frame logic will
|
||||
! need to be untangled somewhat.
|
||||
|
||||
: param@ ( n -- x ) reserved-area-size + ; inline
|
||||
|
||||
: param-save-size ( -- n ) 8 cells ; foldable
|
||||
|
||||
: local@ ( n -- x )
|
||||
reserved-area-size param-save-size + + ; inline
|
||||
|
||||
: spill@ ( n -- offset )
|
||||
spill-offset local@ ;
|
||||
|
||||
! Some FP intrinsics need a temporary scratch area in the stack
|
||||
! frame, 8 bytes in size. This is in the param-save area so it
|
||||
! does not overlap with spill slots.
|
||||
: scratch@ ( n -- offset )
|
||||
factor-area-size + ;
|
||||
|
||||
! Finally we have the linkage area
|
||||
HOOK: lr-save os ( -- n )
|
||||
|
||||
M: ppc stack-frame-size ( stack-frame -- i )
|
||||
(stack-frame-size)
|
||||
param-save-size +
|
||||
reserved-area-size +
|
||||
factor-area-size +
|
||||
4 cells align ;
|
||||
|
||||
M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
|
||||
|
||||
M: ppc %jump ( word -- )
|
||||
0 6 LOAD32 4 rc-absolute-ppc-2/2 rel-here
|
||||
0 B rc-relative-ppc-3 rel-word-pic-tail ;
|
||||
|
||||
M: ppc %jump-label ( label -- ) B ;
|
||||
M: ppc %return ( -- ) BLR ;
|
||||
|
||||
M:: ppc %dispatch ( src temp -- )
|
||||
0 temp LOAD32
|
||||
3 cells rc-absolute-ppc-2/2 rel-here
|
||||
temp temp src LWZX
|
||||
temp MTCTR
|
||||
BCTR ;
|
||||
|
||||
: (%slot) ( dst obj slot scale tag -- obj dst slot )
|
||||
[ 0 assert= ] bi@ swapd ;
|
||||
|
||||
M: ppc %slot ( dst obj slot scale tag -- ) (%slot) LWZX ;
|
||||
M: ppc %slot-imm ( dst obj slot tag -- ) slot-offset LWZ ;
|
||||
M: ppc %set-slot ( src obj slot scale tag -- ) (%slot) STWX ;
|
||||
M: ppc %set-slot-imm ( src obj slot tag -- ) slot-offset STW ;
|
||||
|
||||
M: ppc %add ADD ;
|
||||
M: ppc %add-imm ADDI ;
|
||||
M: ppc %sub swap SUBF ;
|
||||
M: ppc %sub-imm SUBI ;
|
||||
M: ppc %mul MULLW ;
|
||||
M: ppc %mul-imm MULLI ;
|
||||
M: ppc %and AND ;
|
||||
M: ppc %and-imm ANDI ;
|
||||
M: ppc %or OR ;
|
||||
M: ppc %or-imm ORI ;
|
||||
M: ppc %xor XOR ;
|
||||
M: ppc %xor-imm XORI ;
|
||||
M: ppc %shl SLW ;
|
||||
M: ppc %shl-imm swapd SLWI ;
|
||||
M: ppc %shr SRW ;
|
||||
M: ppc %shr-imm swapd SRWI ;
|
||||
M: ppc %sar SRAW ;
|
||||
M: ppc %sar-imm SRAWI ;
|
||||
M: ppc %not NOT ;
|
||||
M: ppc %neg NEG ;
|
||||
|
||||
:: overflow-template ( label dst src1 src2 cc insn -- )
|
||||
0 0 LI
|
||||
0 MTXER
|
||||
dst src2 src1 insn call
|
||||
cc {
|
||||
{ cc-o [ label BO ] }
|
||||
{ cc/o [ label BNO ] }
|
||||
} case ; inline
|
||||
|
||||
M: ppc %fixnum-add ( label dst src1 src2 cc -- )
|
||||
[ ADDO. ] overflow-template ;
|
||||
|
||||
M: ppc %fixnum-sub ( label dst src1 src2 cc -- )
|
||||
[ SUBFO. ] overflow-template ;
|
||||
|
||||
M: ppc %fixnum-mul ( label dst src1 src2 cc -- )
|
||||
[ MULLWO. ] overflow-template ;
|
||||
|
||||
M: ppc %add-float FADD ;
|
||||
M: ppc %sub-float FSUB ;
|
||||
M: ppc %mul-float FMUL ;
|
||||
M: ppc %div-float FDIV ;
|
||||
|
||||
M: ppc integer-float-needs-stack-frame? t ;
|
||||
|
||||
M:: ppc %integer>float ( dst src -- )
|
||||
HEX: 4330 scratch-reg LIS
|
||||
scratch-reg 1 0 scratch@ STW
|
||||
scratch-reg src MR
|
||||
scratch-reg dup HEX: 8000 XORIS
|
||||
scratch-reg 1 4 scratch@ STW
|
||||
dst 1 0 scratch@ LFD
|
||||
scratch-reg 4503601774854144.0 %load-reference
|
||||
fp-scratch-reg scratch-reg float-offset LFD
|
||||
dst dst fp-scratch-reg FSUB ;
|
||||
|
||||
M:: ppc %float>integer ( dst src -- )
|
||||
fp-scratch-reg src FCTIWZ
|
||||
fp-scratch-reg 1 0 scratch@ STFD
|
||||
dst 1 4 scratch@ LWZ ;
|
||||
|
||||
M: ppc %copy ( dst src rep -- )
|
||||
2over eq? [ 3drop ] [
|
||||
{
|
||||
{ tagged-rep [ MR ] }
|
||||
{ int-rep [ MR ] }
|
||||
{ double-rep [ FMR ] }
|
||||
} case
|
||||
] if ;
|
||||
|
||||
GENERIC: float-function-param* ( dst src -- )
|
||||
|
||||
M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
|
||||
M: integer float-function-param* FMR ;
|
||||
|
||||
: float-function-param ( i src -- )
|
||||
[ float-regs cdecl param-regs at nth ] dip float-function-param* ;
|
||||
|
||||
: float-function-return ( reg -- )
|
||||
float-regs return-regs at first double-rep %copy ;
|
||||
|
||||
M:: ppc %unary-float-function ( dst src func -- )
|
||||
0 src float-function-param
|
||||
func f %c-invoke
|
||||
dst float-function-return ;
|
||||
|
||||
M:: ppc %binary-float-function ( dst src1 src2 func -- )
|
||||
0 src1 float-function-param
|
||||
1 src2 float-function-param
|
||||
func f %c-invoke
|
||||
dst float-function-return ;
|
||||
|
||||
! Internal format is always double-precision on PowerPC
|
||||
M: ppc %single>double-float double-rep %copy ;
|
||||
M: ppc %double>single-float FRSP ;
|
||||
|
||||
M: ppc %unbox-alien ( dst src -- )
|
||||
alien-offset LWZ ;
|
||||
|
||||
M:: ppc %unbox-any-c-ptr ( dst src -- )
|
||||
[
|
||||
"end" define-label
|
||||
0 dst LI
|
||||
! Is the object f?
|
||||
0 src \ f type-number CMPI
|
||||
"end" get BEQ
|
||||
! Compute tag in dst register
|
||||
dst src tag-mask get ANDI
|
||||
! Is the object an alien?
|
||||
0 dst alien type-number CMPI
|
||||
! Add an offset to start of byte array's data
|
||||
dst src byte-array-offset ADDI
|
||||
"end" get BNE
|
||||
! If so, load the offset and add it to the address
|
||||
dst src alien-offset LWZ
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
: alien@ ( n -- n' ) cells alien type-number - ;
|
||||
|
||||
M:: ppc %box-alien ( dst src temp -- )
|
||||
[
|
||||
"f" define-label
|
||||
dst \ f type-number %load-immediate
|
||||
0 src 0 CMPI
|
||||
"f" get BEQ
|
||||
dst 5 cells alien temp %allot
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 1 alien@ STW
|
||||
temp dst 2 alien@ STW
|
||||
src dst 3 alien@ STW
|
||||
src dst 4 alien@ STW
|
||||
"f" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
:: %box-displaced-alien/f ( dst displacement base -- )
|
||||
base dst 1 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
displacement dst 4 alien@ STW ;
|
||||
|
||||
:: %box-displaced-alien/alien ( dst displacement base temp -- )
|
||||
! Set new alien's base to base.base
|
||||
temp base 1 alien@ LWZ
|
||||
temp dst 1 alien@ STW
|
||||
|
||||
! Compute displacement
|
||||
temp base 3 alien@ LWZ
|
||||
temp temp displacement ADD
|
||||
temp dst 3 alien@ STW
|
||||
|
||||
! Compute address
|
||||
temp base 4 alien@ LWZ
|
||||
temp temp displacement ADD
|
||||
temp dst 4 alien@ STW ;
|
||||
|
||||
:: %box-displaced-alien/byte-array ( dst displacement base temp -- )
|
||||
base dst 1 alien@ STW
|
||||
displacement dst 3 alien@ STW
|
||||
temp base byte-array-offset ADDI
|
||||
temp temp displacement ADD
|
||||
temp dst 4 alien@ STW ;
|
||||
|
||||
:: %box-displaced-alien/dynamic ( dst displacement base temp -- )
|
||||
"not-f" define-label
|
||||
"not-alien" define-label
|
||||
|
||||
! Is base f?
|
||||
0 base \ f type-number CMPI
|
||||
"not-f" get BNE
|
||||
|
||||
! Yes, it is f. Fill in new object
|
||||
dst displacement base %box-displaced-alien/f
|
||||
|
||||
"end" get B
|
||||
|
||||
"not-f" resolve-label
|
||||
|
||||
! Check base type
|
||||
temp base tag-mask get ANDI
|
||||
|
||||
! Is base an alien?
|
||||
0 temp alien type-number CMPI
|
||||
"not-alien" get BNE
|
||||
|
||||
dst displacement base temp %box-displaced-alien/alien
|
||||
|
||||
! We are done
|
||||
"end" get B
|
||||
|
||||
! Is base a byte array? It has to be, by now...
|
||||
"not-alien" resolve-label
|
||||
|
||||
dst displacement base temp %box-displaced-alien/byte-array ;
|
||||
|
||||
M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
|
||||
! This is ridiculous
|
||||
[
|
||||
"end" define-label
|
||||
|
||||
! If displacement is zero, return the base
|
||||
dst base MR
|
||||
0 displacement 0 CMPI
|
||||
"end" get BEQ
|
||||
|
||||
! Displacement is non-zero, we're going to be allocating a new
|
||||
! object
|
||||
dst 5 cells alien temp %allot
|
||||
|
||||
! Set expired to f
|
||||
temp \ f type-number %load-immediate
|
||||
temp dst 2 alien@ STW
|
||||
|
||||
dst displacement base temp
|
||||
{
|
||||
{ [ base-class \ f class<= ] [ drop %box-displaced-alien/f ] }
|
||||
{ [ base-class \ alien class<= ] [ %box-displaced-alien/alien ] }
|
||||
{ [ base-class \ byte-array class<= ] [ %box-displaced-alien/byte-array ] }
|
||||
[ %box-displaced-alien/dynamic ]
|
||||
} cond
|
||||
|
||||
"end" resolve-label
|
||||
] with-scope ;
|
||||
|
||||
: (%memory) ( val base displacement scale offset rep c-type -- base val displacement rep c-type )
|
||||
[ [ 0 assert= ] bi@ swapd ] 2dip ; inline
|
||||
|
||||
M: ppc %load-memory-imm ( dst base offset rep c-type -- )
|
||||
[
|
||||
{
|
||||
{ c:char [ [ dup ] 2dip LBZ dup EXTSB ] }
|
||||
{ c:uchar [ LBZ ] }
|
||||
{ c:short [ LHA ] }
|
||||
{ c:ushort [ LHZ ] }
|
||||
{ c:int [ LWZ ] }
|
||||
{ c:uint [ LWZ ] }
|
||||
} case
|
||||
] [
|
||||
{
|
||||
{ int-rep [ LWZ ] }
|
||||
{ float-rep [ LFS ] }
|
||||
{ double-rep [ LFD ] }
|
||||
} case
|
||||
] ?if ;
|
||||
|
||||
M: ppc %load-memory ( dst base displacement scale offset rep c-type -- )
|
||||
(%memory) [
|
||||
{
|
||||
{ c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] }
|
||||
{ c:uchar [ LBZX ] }
|
||||
{ c:short [ LHAX ] }
|
||||
{ c:ushort [ LHZX ] }
|
||||
{ c:int [ LWZX ] }
|
||||
{ c:uint [ LWZX ] }
|
||||
} case
|
||||
] [
|
||||
{
|
||||
{ int-rep [ LWZX ] }
|
||||
{ float-rep [ LFSX ] }
|
||||
{ double-rep [ LFDX ] }
|
||||
} case
|
||||
] ?if ;
|
||||
|
||||
M: ppc %store-memory-imm ( src base offset rep c-type -- )
|
||||
[
|
||||
{
|
||||
{ c:char [ STB ] }
|
||||
{ c:uchar [ STB ] }
|
||||
{ c:short [ STH ] }
|
||||
{ c:ushort [ STH ] }
|
||||
{ c:int [ STW ] }
|
||||
{ c:uint [ STW ] }
|
||||
} case
|
||||
] [
|
||||
{
|
||||
{ int-rep [ STW ] }
|
||||
{ float-rep [ STFS ] }
|
||||
{ double-rep [ STFD ] }
|
||||
} case
|
||||
] ?if ;
|
||||
|
||||
M: ppc %store-memory ( src base displacement scale offset rep c-type -- )
|
||||
(%memory) [
|
||||
{
|
||||
{ c:char [ STBX ] }
|
||||
{ c:uchar [ STBX ] }
|
||||
{ c:short [ STHX ] }
|
||||
{ c:ushort [ STHX ] }
|
||||
{ c:int [ STWX ] }
|
||||
{ c:uint [ STWX ] }
|
||||
} case
|
||||
] [
|
||||
{
|
||||
{ int-rep [ STWX ] }
|
||||
{ float-rep [ STFSX ] }
|
||||
{ double-rep [ STFDX ] }
|
||||
} case
|
||||
] ?if ;
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
vm-reg "nursery" vm-field-offset ADDI ;
|
||||
|
||||
: load-allot-ptr ( nursery-ptr allot-ptr -- )
|
||||
[ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
|
||||
|
||||
:: inc-allot-ptr ( nursery-ptr allot-ptr n -- )
|
||||
scratch-reg allot-ptr n data-alignment get align ADDI
|
||||
scratch-reg nursery-ptr 0 STW ;
|
||||
|
||||
:: store-header ( dst class -- )
|
||||
class type-number tag-header scratch-reg LI
|
||||
scratch-reg dst 0 STW ;
|
||||
|
||||
: store-tagged ( dst tag -- )
|
||||
dupd type-number ORI ;
|
||||
|
||||
M:: ppc %allot ( dst size class nursery-ptr -- )
|
||||
nursery-ptr dst load-allot-ptr
|
||||
nursery-ptr dst size inc-allot-ptr
|
||||
dst class store-header
|
||||
dst class store-tagged ;
|
||||
|
||||
: load-cards-offset ( dst -- )
|
||||
0 swap LOAD32 rc-absolute-ppc-2/2 rel-cards-offset ;
|
||||
|
||||
: load-decks-offset ( dst -- )
|
||||
0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset ;
|
||||
|
||||
:: (%write-barrier) ( temp1 temp2 -- )
|
||||
card-mark scratch-reg LI
|
||||
|
||||
! Mark the card
|
||||
temp1 temp1 card-bits SRWI
|
||||
temp2 load-cards-offset
|
||||
temp1 scratch-reg temp2 STBX
|
||||
|
||||
! Mark the card deck
|
||||
temp1 temp1 deck-bits card-bits - SRWI
|
||||
temp2 load-decks-offset
|
||||
temp1 scratch-reg temp2 STBX ;
|
||||
|
||||
M:: ppc %write-barrier ( src slot scale tag temp1 temp2 -- )
|
||||
scale 0 assert= tag 0 assert=
|
||||
temp1 src slot ADD
|
||||
temp1 temp2 (%write-barrier) ;
|
||||
|
||||
M:: ppc %write-barrier-imm ( src slot tag temp1 temp2 -- )
|
||||
temp1 src slot tag slot-offset ADDI
|
||||
temp1 temp2 (%write-barrier) ;
|
||||
|
||||
M:: ppc %check-nursery-branch ( label size cc temp1 temp2 -- )
|
||||
temp1 vm-reg "nursery" vm-field-offset LWZ
|
||||
temp2 vm-reg "nursery" vm-field-offset 2 cells + LWZ
|
||||
temp1 temp1 size ADDI
|
||||
! is here >= end?
|
||||
temp1 0 temp2 CMP
|
||||
cc {
|
||||
{ cc<= [ label BLE ] }
|
||||
{ cc/<= [ label BGT ] }
|
||||
} case ;
|
||||
|
||||
: gc-root-offsets ( seq -- seq' )
|
||||
[ n>> spill@ ] map f like ;
|
||||
|
||||
M: ppc %call-gc ( gc-roots -- )
|
||||
3 swap gc-root-offsets %load-reference
|
||||
4 %load-vm-addr
|
||||
"inline_gc" f %c-invoke ;
|
||||
|
||||
M: ppc %prologue ( n -- )
|
||||
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
|
||||
0 MFLR
|
||||
{
|
||||
[ [ 1 1 ] dip neg ADDI ]
|
||||
[ [ 11 1 ] dip xt-save STW ]
|
||||
[ 11 LI ]
|
||||
[ [ 11 1 ] dip next-save STW ]
|
||||
[ [ 0 1 ] dip lr-save + STW ]
|
||||
} cleave ;
|
||||
|
||||
M: ppc %epilogue ( n -- )
|
||||
#! At the end of each word that calls a subroutine, we store
|
||||
#! the previous link register value in r0 by popping it off
|
||||
#! the stack, set the link register to the contents of r0,
|
||||
#! and jump to the link register.
|
||||
[ [ 0 1 ] dip lr-save + LWZ ]
|
||||
[ [ 1 1 ] dip ADDI ] bi
|
||||
0 MTLR ;
|
||||
|
||||
:: (%boolean) ( dst temp branch1 branch2 -- )
|
||||
"end" define-label
|
||||
dst \ f type-number %load-immediate
|
||||
"end" get branch1 execute( label -- )
|
||||
branch2 [ "end" get branch2 execute( label -- ) ] when
|
||||
dst \ t %load-reference
|
||||
"end" get resolve-label ; inline
|
||||
|
||||
:: %boolean ( dst cc temp -- )
|
||||
cc negate-cc order-cc {
|
||||
{ cc< [ dst temp \ BLT f (%boolean) ] }
|
||||
{ cc<= [ dst temp \ BLE f (%boolean) ] }
|
||||
{ cc> [ dst temp \ BGT f (%boolean) ] }
|
||||
{ cc>= [ dst temp \ BGE f (%boolean) ] }
|
||||
{ cc= [ dst temp \ BEQ f (%boolean) ] }
|
||||
{ cc/= [ dst temp \ BNE f (%boolean) ] }
|
||||
} case ;
|
||||
|
||||
: (%compare) ( src1 src2 -- ) [ 0 ] dip CMP ; inline
|
||||
|
||||
: (%compare-integer-imm) ( src1 src2 -- )
|
||||
[ 0 ] 2dip CMPI ; inline
|
||||
|
||||
: (%compare-imm) ( src1 src2 -- )
|
||||
[ tag-fixnum ] [ \ f type-number ] if* (%compare-integer-imm) ; inline
|
||||
|
||||
: (%compare-float-unordered) ( src1 src2 -- )
|
||||
[ 0 ] dip FCMPU ; inline
|
||||
|
||||
: (%compare-float-ordered) ( src1 src2 -- )
|
||||
[ 0 ] dip FCMPO ; inline
|
||||
|
||||
:: (%compare-float) ( src1 src2 cc compare -- branch1 branch2 )
|
||||
cc {
|
||||
{ cc< [ src1 src2 \ compare execute( a b -- ) \ BLT f ] }
|
||||
{ cc<= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BEQ ] }
|
||||
{ cc> [ src1 src2 \ compare execute( a b -- ) \ BGT f ] }
|
||||
{ cc>= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BEQ ] }
|
||||
{ cc= [ src1 src2 \ compare execute( a b -- ) \ BEQ f ] }
|
||||
{ cc<> [ src1 src2 \ compare execute( a b -- ) \ BLT \ BGT ] }
|
||||
{ cc<>= [ src1 src2 \ compare execute( a b -- ) \ BNO f ] }
|
||||
{ cc/< [ src1 src2 \ compare execute( a b -- ) \ BGE f ] }
|
||||
{ cc/<= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BO ] }
|
||||
{ cc/> [ src1 src2 \ compare execute( a b -- ) \ BLE f ] }
|
||||
{ cc/>= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BO ] }
|
||||
{ cc/= [ src1 src2 \ compare execute( a b -- ) \ BNE f ] }
|
||||
{ cc/<> [ src1 src2 \ compare execute( a b -- ) \ BEQ \ BO ] }
|
||||
{ cc/<>= [ src1 src2 \ compare execute( a b -- ) \ BO f ] }
|
||||
} case ; inline
|
||||
|
||||
M: ppc %compare [ (%compare) ] 2dip %boolean ;
|
||||
|
||||
M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
|
||||
|
||||
M: ppc %compare-integer-imm [ (%compare-integer-imm) ] 2dip %boolean ;
|
||||
|
||||
M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
|
||||
src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
|
||||
dst temp branch1 branch2 (%boolean) ;
|
||||
|
||||
M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
|
||||
src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
|
||||
dst temp branch1 branch2 (%boolean) ;
|
||||
|
||||
:: %branch ( label cc -- )
|
||||
cc order-cc {
|
||||
{ cc< [ label BLT ] }
|
||||
{ cc<= [ label BLE ] }
|
||||
{ cc> [ label BGT ] }
|
||||
{ cc>= [ label BGE ] }
|
||||
{ cc= [ label BEQ ] }
|
||||
{ cc/= [ label BNE ] }
|
||||
} case ;
|
||||
|
||||
M:: ppc %compare-branch ( label src1 src2 cc -- )
|
||||
src1 src2 (%compare)
|
||||
label cc %branch ;
|
||||
|
||||
M:: ppc %compare-imm-branch ( label src1 src2 cc -- )
|
||||
src1 src2 (%compare-imm)
|
||||
label cc %branch ;
|
||||
|
||||
M:: ppc %compare-integer-imm-branch ( label src1 src2 cc -- )
|
||||
src1 src2 (%compare-integer-imm)
|
||||
label cc %branch ;
|
||||
|
||||
:: (%branch) ( label branch1 branch2 -- )
|
||||
label branch1 execute( label -- )
|
||||
branch2 [ label branch2 execute( label -- ) ] when ; inline
|
||||
|
||||
M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
|
||||
src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
|
||||
label branch1 branch2 (%branch) ;
|
||||
|
||||
M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
|
||||
src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
|
||||
label branch1 branch2 (%branch) ;
|
||||
|
||||
: load-from-frame ( dst n rep -- )
|
||||
{
|
||||
{ int-rep [ [ 1 ] dip LWZ ] }
|
||||
{ tagged-rep [ [ 1 ] dip LWZ ] }
|
||||
{ float-rep [ [ 1 ] dip LFS ] }
|
||||
{ double-rep [ [ 1 ] dip LFD ] }
|
||||
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
|
||||
} case ;
|
||||
|
||||
: next-param@ ( n -- reg x )
|
||||
[ 17 ] dip param@ ;
|
||||
|
||||
: store-to-frame ( src n rep -- )
|
||||
{
|
||||
{ int-rep [ [ 1 ] dip STW ] }
|
||||
{ tagged-rep [ [ 1 ] dip STW ] }
|
||||
{ float-rep [ [ 1 ] dip STFS ] }
|
||||
{ double-rep [ [ 1 ] dip STFD ] }
|
||||
{ stack-params [ [ [ 0 ] dip next-param@ LWZ 0 1 ] dip STW ] }
|
||||
} case ;
|
||||
|
||||
M: ppc %spill ( src rep dst -- )
|
||||
swap [ n>> spill@ ] dip store-to-frame ;
|
||||
|
||||
M: ppc %reload ( dst rep src -- )
|
||||
swap [ n>> spill@ ] dip load-from-frame ;
|
||||
|
||||
M: ppc %loop-entry ;
|
||||
|
||||
M: ppc return-regs
|
||||
{
|
||||
{ int-regs { 3 4 5 6 } }
|
||||
{ float-regs { 1 } }
|
||||
} ;
|
||||
|
||||
M:: ppc %save-param-reg ( stack reg rep -- )
|
||||
reg stack local@ rep store-to-frame ;
|
||||
|
||||
M:: ppc %load-param-reg ( stack reg rep -- )
|
||||
reg stack local@ rep load-from-frame ;
|
||||
|
||||
GENERIC: load-param ( reg src -- )
|
||||
|
||||
M: integer load-param int-rep %copy ;
|
||||
|
||||
M: spill-slot load-param [ 1 ] dip n>> spill@ LWZ ;
|
||||
|
||||
GENERIC: store-param ( reg dst -- )
|
||||
|
||||
M: integer store-param swap int-rep %copy ;
|
||||
|
||||
M: spill-slot store-param [ 1 ] dip n>> spill@ STW ;
|
||||
|
||||
:: call-unbox-func ( src func -- )
|
||||
3 src load-param
|
||||
4 %load-vm-addr
|
||||
func f %c-invoke ;
|
||||
|
||||
M:: ppc %unbox ( src n rep func -- )
|
||||
src func call-unbox-func
|
||||
! Store the return value on the C stack
|
||||
n [ rep reg-class-of return-regs at first rep %save-param-reg ] when* ;
|
||||
|
||||
M:: ppc %unbox-long-long ( src n func -- )
|
||||
src func call-unbox-func
|
||||
! Store the return value on the C stack
|
||||
n [
|
||||
3 1 n local@ STW
|
||||
4 1 n cell + local@ STW
|
||||
] when ;
|
||||
|
||||
M:: ppc %unbox-large-struct ( src n c-type -- )
|
||||
4 src load-param
|
||||
3 1 n local@ ADDI
|
||||
c-type heap-size 5 LI
|
||||
"memcpy" "libc" load-library %c-invoke ;
|
||||
|
||||
M:: ppc %box ( dst n rep func -- )
|
||||
n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
|
||||
rep double-rep? 5 4 ? %load-vm-addr
|
||||
func f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
M:: ppc %box-long-long ( dst n func -- )
|
||||
n [
|
||||
3 1 n local@ LWZ
|
||||
4 1 n cell + local@ LWZ
|
||||
] when
|
||||
5 %load-vm-addr
|
||||
func f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
: struct-return@ ( n -- n )
|
||||
[ stack-frame get params>> ] unless* local@ ;
|
||||
|
||||
M: ppc %prepare-box-struct ( -- )
|
||||
#! Compute target address for value struct return
|
||||
3 1 f struct-return@ ADDI
|
||||
3 1 0 local@ STW ;
|
||||
|
||||
M:: ppc %box-large-struct ( dst n c-type -- )
|
||||
! If n = f, then we're boxing a returned struct
|
||||
! Compute destination address and load struct size
|
||||
3 1 n struct-return@ ADDI
|
||||
c-type heap-size 4 LI
|
||||
5 %load-vm-addr
|
||||
! Call the function
|
||||
"from_value_struct" f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
M:: ppc %restore-context ( temp1 temp2 -- )
|
||||
temp1 %context
|
||||
ds-reg temp1 "datastack" context-field-offset LWZ
|
||||
rs-reg temp1 "retainstack" context-field-offset LWZ ;
|
||||
|
||||
M:: ppc %save-context ( temp1 temp2 -- )
|
||||
temp1 %context
|
||||
1 temp1 "callstack-top" context-field-offset STW
|
||||
ds-reg temp1 "datastack" context-field-offset STW
|
||||
rs-reg temp1 "retainstack" context-field-offset STW ;
|
||||
|
||||
M: ppc %c-invoke ( symbol dll -- )
|
||||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
||||
M: ppc %alien-indirect ( src -- )
|
||||
[ 11 ] dip load-param 11 MTLR BLRL ;
|
||||
|
||||
M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
|
||||
|
||||
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
|
||||
|
||||
M: ppc immediate-store? drop f ;
|
||||
|
||||
M: ppc return-struct-in-registers? ( c-type -- ? )
|
||||
c-type return-in-registers?>> ;
|
||||
|
||||
M:: ppc %box-small-struct ( dst c-type -- )
|
||||
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
|
||||
c-type heap-size 7 LI
|
||||
8 %load-vm-addr
|
||||
"from_medium_struct" f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
: %unbox-struct-1 ( -- )
|
||||
! Alien must be in r3.
|
||||
3 3 0 LWZ ;
|
||||
|
||||
: %unbox-struct-2 ( -- )
|
||||
! Alien must be in r3.
|
||||
4 3 4 LWZ
|
||||
3 3 0 LWZ ;
|
||||
|
||||
: %unbox-struct-4 ( -- )
|
||||
! Alien must be in r3.
|
||||
6 3 12 LWZ
|
||||
5 3 8 LWZ
|
||||
4 3 4 LWZ
|
||||
3 3 0 LWZ ;
|
||||
|
||||
M:: ppc %unbox-small-struct ( src c-type -- )
|
||||
src 3 load-param
|
||||
c-type heap-size {
|
||||
{ [ dup 4 <= ] [ drop %unbox-struct-1 ] }
|
||||
{ [ dup 8 <= ] [ drop %unbox-struct-2 ] }
|
||||
{ [ dup 16 <= ] [ drop %unbox-struct-4 ] }
|
||||
} cond ;
|
||||
|
||||
M: ppc %begin-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"begin_callback" f %c-invoke ;
|
||||
|
||||
M: ppc %alien-callback ( quot -- )
|
||||
3 swap %load-reference
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTLR
|
||||
BLRL ;
|
||||
|
||||
M: ppc %end-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"end_callback" f %c-invoke ;
|
||||
|
||||
enable-float-functions
|
||||
|
||||
USE: vocabs.loader
|
||||
|
||||
{
|
||||
{ [ os macosx? ] [ "cpu.ppc.macosx" require ] }
|
||||
{ [ os linux? ] [ "cpu.ppc.linux" require ] }
|
||||
} cond
|
||||
|
||||
complex-double c-type t >>return-in-registers? drop
|
||||
|
|
@ -1 +0,0 @@
|
|||
32-bit PowerPC compiler backend
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
compiler
|
||||
not loaded
|
||||
|
|
@ -1,4 +1,3 @@
|
|||
include vm/Config.unix
|
||||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-freebsd.o vm/mvm-unix.o
|
||||
CFLAGS += -export-dynamic
|
||||
LIBS = -L/usr/local/lib/ -lm -lrt $(X11_UI_LIBS)
|
||||
LIBS = -L/usr/local/lib/ -lm -lrt $(X11_UI_LIBS) -Wl,--export-dynamic
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
include vm/Config.unix
|
||||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-linux.o vm/mvm-unix.o
|
||||
CFLAGS += -export-dynamic
|
||||
LIBS = -ldl -lm -lrt -lpthread $(X11_UI_LIBS)
|
||||
LIBS = -ldl -lm -lrt -lpthread $(X11_UI_LIBS) -Wl,--export-dynamic
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
include vm/Config.linux
|
||||
include vm/Config.ppc
|
||||
CFLAGS += -mregnames
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
include vm/Config.linux
|
||||
PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
|
||||
CFLAGS += -m32
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
include vm/Config.linux
|
||||
PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
|
||||
CFLAGS += -m64
|
||||
|
|
@ -1,3 +1,3 @@
|
|||
include vm/Config.macosx
|
||||
include vm/Config.ppc
|
||||
PLAF_DLL_OBJS += vm/cpu-ppc.macosx.o
|
||||
CFLAGS += -arch ppc -force_cpusubtype_ALL
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
include vm/Config.unix
|
||||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-netbsd.o vm/mvm-none.o
|
||||
CFLAGS += -export-dynamic
|
||||
LIBPATH = -L/usr/X11R7/lib -Wl,-rpath,/usr/X11R7/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
|
||||
LIBS = -lm -lrt -lssl -lcrypto $(X11_UI_LIBS)
|
||||
LIBS = -lm -lrt -lssl -lcrypto $(X11_UI_LIBS) -Wl,--export-dynamic
|
||||
|
|
|
|||
|
|
@ -2,5 +2,5 @@ include vm/Config.unix
|
|||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o vm/mvm-unix.o
|
||||
CC = egcc
|
||||
CPP = eg++
|
||||
CFLAGS += -export-dynamic -fno-inline-functions
|
||||
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread
|
||||
CFLAGS += -fno-inline-functions
|
||||
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread -Wl,--export-dynamic
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
PLAF_DLL_OBJS += vm/cpu-ppc.o
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
include vm/Config.unix
|
||||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-solaris.o
|
||||
CFLAGS += -D_STDC_C99 -Drestrict="" -export-dynamic
|
||||
CFLAGS += -D_STDC_C99 -Drestrict=""
|
||||
LIBS += -ldl -lsocket -lnsl -lm -lrt -R/opt/PM/lib -R/opt/csw/lib \
|
||||
-R/usr/local/lib -R/usr/sfw/lib -R/usr/X11R6/lib \
|
||||
-R/opt/sfw/lib $(X11_UI_LIBS)
|
||||
-R/opt/sfw/lib $(X11_UI_LIBS) -Wl,--export-dynamic
|
||||
|
|
|
|||
23
vm/alien.cpp
23
vm/alien.cpp
|
|
@ -138,6 +138,29 @@ void factor_vm::primitive_dlsym()
|
|||
ctx->push(allot_alien(ffi_dlsym(NULL,sym)));
|
||||
}
|
||||
|
||||
/* look up a symbol in a native library */
|
||||
void factor_vm::primitive_dlsym_raw()
|
||||
{
|
||||
data_root<object> library(ctx->pop(),this);
|
||||
data_root<byte_array> name(ctx->pop(),this);
|
||||
name.untag_check(this);
|
||||
|
||||
symbol_char *sym = name->data<symbol_char>();
|
||||
|
||||
if(to_boolean(library.value()))
|
||||
{
|
||||
dll *d = untag_check<dll>(library.value());
|
||||
|
||||
if(d->handle == NULL)
|
||||
ctx->push(false_object);
|
||||
else
|
||||
ctx->push(allot_alien(ffi_dlsym_raw(d,sym)));
|
||||
}
|
||||
else
|
||||
ctx->push(allot_alien(ffi_dlsym_raw(NULL,sym)));
|
||||
}
|
||||
|
||||
|
||||
/* close a native library handle */
|
||||
void factor_vm::primitive_dlclose()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -17,9 +17,18 @@ inline cell log2(cell x)
|
|||
#else
|
||||
asm ("bsr %1, %0;":"=r"(n):"r"(x));
|
||||
#endif
|
||||
#elif defined(FACTOR_PPC)
|
||||
asm ("cntlzw %1, %0;":"=r"(n):"r"(x));
|
||||
n = (31 - n);
|
||||
#elif defined(FACTOR_PPC64)
|
||||
#if defined(__GNUC__)
|
||||
n = (63 - __builtin_clzll(x));
|
||||
#else
|
||||
#error Unsupported compiler
|
||||
#endif
|
||||
#elif defined(FACTOR_PPC32)
|
||||
#if defined(__GNUC__)
|
||||
n = (31 - __builtin_clz(x));
|
||||
#else
|
||||
#error Unsupported compiler
|
||||
#endif
|
||||
#else
|
||||
#error Unsupported CPU
|
||||
#endif
|
||||
|
|
@ -38,6 +47,13 @@ inline cell rightmost_set_bit(cell x)
|
|||
|
||||
inline cell popcount(cell x)
|
||||
{
|
||||
#if defined(__GNUC__)
|
||||
#ifdef FACTOR_64
|
||||
return __builtin_popcountll(x);
|
||||
#else
|
||||
return __builtin_popcount(x);
|
||||
#endif
|
||||
#else
|
||||
#ifdef FACTOR_64
|
||||
u64 k1 = 0x5555555555555555ll;
|
||||
u64 k2 = 0x3333333333333333ll;
|
||||
|
|
@ -58,6 +74,7 @@ inline cell popcount(cell x)
|
|||
x = (x * kf) >> ks; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
|
||||
|
||||
return x;
|
||||
#endif
|
||||
}
|
||||
|
||||
inline bool bitmap_p(u8 *bitmap, cell index)
|
||||
|
|
|
|||
|
|
@ -140,7 +140,10 @@ void factor_vm::primitive_callback()
|
|||
tagged<word> w(ctx->pop());
|
||||
|
||||
w.untag_check(this);
|
||||
ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->entry_point()));
|
||||
|
||||
void* func = callbacks->add(w.value(),return_rewind)->entry_point();
|
||||
CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
|
||||
ctx->push(allot_alien(func));
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ keep the callstack in a GC root and use relative offsets */
|
|||
template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
|
||||
{
|
||||
data_root<callstack> stack(stack_,this);
|
||||
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
fixnum frame_offset = factor::untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
|
||||
while(frame_offset >= 0)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -160,8 +160,10 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
|
|||
|
||||
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
|
||||
|
||||
void* undefined_symbol = (void*)factor::undefined_symbol;
|
||||
undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
|
||||
if(d != NULL && !d->handle)
|
||||
return (cell)factor::undefined_symbol;
|
||||
return (cell)undefined_symbol;
|
||||
|
||||
switch(tagged<object>(symbol).type())
|
||||
{
|
||||
|
|
@ -173,7 +175,7 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
|
|||
if(sym)
|
||||
return (cell)sym;
|
||||
else
|
||||
return (cell)factor::undefined_symbol;
|
||||
return (cell)undefined_symbol;
|
||||
}
|
||||
case ARRAY_TYPE:
|
||||
{
|
||||
|
|
@ -186,14 +188,59 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
|
|||
if(sym)
|
||||
return (cell)sym;
|
||||
}
|
||||
return (cell)factor::undefined_symbol;
|
||||
return (cell)undefined_symbol;
|
||||
}
|
||||
default:
|
||||
critical_error("Bad symbol specifier",symbol);
|
||||
return (cell)factor::undefined_symbol;
|
||||
return (cell)undefined_symbol;
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef FACTOR_PPC
|
||||
cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
|
||||
{
|
||||
cell symbol = array_nth(literals,index);
|
||||
cell library = array_nth(literals,index + 1);
|
||||
|
||||
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
|
||||
|
||||
void* undefined_toc = (void*)factor::undefined_symbol;
|
||||
undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
|
||||
if(d != NULL && !d->handle)
|
||||
return (cell)undefined_toc;
|
||||
|
||||
switch(tagged<object>(symbol).type())
|
||||
{
|
||||
case BYTE_ARRAY_TYPE:
|
||||
{
|
||||
symbol_char *name = alien_offset(symbol);
|
||||
void* toc = ffi_dlsym_toc(d,name);
|
||||
if(toc)
|
||||
return (cell)toc;
|
||||
else
|
||||
return (cell)undefined_toc;
|
||||
}
|
||||
case ARRAY_TYPE:
|
||||
{
|
||||
array *names = untag<array>(symbol);
|
||||
for(cell i = 0; i < array_capacity(names); i++)
|
||||
{
|
||||
symbol_char *name = alien_offset(array_nth(names,i));
|
||||
void *toc = ffi_dlsym_toc(d,name);
|
||||
|
||||
if(toc)
|
||||
return (cell)toc;
|
||||
}
|
||||
return (cell)undefined_toc;
|
||||
}
|
||||
default:
|
||||
critical_error("Bad symbol specifier",symbol);
|
||||
return (cell)undefined_toc;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
cell factor_vm::compute_vm_address(cell arg)
|
||||
{
|
||||
return (cell)this + untag_fixnum(arg);
|
||||
|
|
@ -229,6 +276,11 @@ void factor_vm::store_external_address(instruction_operand op)
|
|||
case RT_EXCEPTION_HANDLER:
|
||||
op.store_value((cell)&factor::exception_handler);
|
||||
break;
|
||||
#endif
|
||||
#ifdef FACTOR_PPC
|
||||
case RT_DLSYM_TOC:
|
||||
op.store_value(compute_dlsym_toc_address(parameters,index));
|
||||
break;
|
||||
#endif
|
||||
default:
|
||||
critical_error("Bad rel type in store_external_address()",op.rel_type());
|
||||
|
|
|
|||
73
vm/cpu-ppc.S
73
vm/cpu-ppc.S
|
|
@ -1,73 +0,0 @@
|
|||
#if defined(__APPLE__)
|
||||
#define MANGLE(sym) _##sym
|
||||
#define XX @
|
||||
#else
|
||||
#define MANGLE(sym) sym
|
||||
#define XX ;
|
||||
#endif
|
||||
|
||||
/* The returns and args are just for documentation */
|
||||
#define DEF(returns,symbol,args) .globl MANGLE(symbol) XX \
|
||||
MANGLE(symbol)
|
||||
|
||||
/* Thanks to Joshua Grams for this code.
|
||||
|
||||
On PowerPC processors, we must flush the instruction cache manually
|
||||
after writing to the code heap. */
|
||||
|
||||
DEF(void,flush_icache,(void*, int)):
|
||||
/* compute number of cache lines to flush */
|
||||
add r4,r4,r3
|
||||
/* align addr to next lower cache line boundary */
|
||||
clrrwi r3,r3,5
|
||||
/* then n_lines = (len + 0x1f) / 0x20 */
|
||||
sub r4,r4,r3
|
||||
addi r4,r4,0x1f
|
||||
/* note '.' suffix */
|
||||
srwi. r4,r4,5
|
||||
/* if n_lines == 0, just return. */
|
||||
beqlr
|
||||
/* flush cache lines */
|
||||
mtctr r4
|
||||
/* for each line... */
|
||||
0: dcbf 0,r3
|
||||
sync
|
||||
icbi 0,r3
|
||||
addi r3,r3,0x20
|
||||
bdnz 0b
|
||||
/* finish up */
|
||||
sync
|
||||
isync
|
||||
blr
|
||||
|
||||
DEF(void,get_ppc_fpu_env,(void*)):
|
||||
mffs f0
|
||||
stfd f0,0(r3)
|
||||
blr
|
||||
|
||||
DEF(void,set_ppc_fpu_env,(const void*)):
|
||||
lfd f0,0(r3)
|
||||
mtfsf 0xff,f0
|
||||
blr
|
||||
|
||||
DEF(void,get_ppc_vmx_env,(void*)):
|
||||
mfvscr v0
|
||||
subi r4,r1,16
|
||||
li r5,0xf
|
||||
andc r4,r4,r5
|
||||
stvxl v0,0,r4
|
||||
li r5,0xc
|
||||
lwzx r6,r5,r4
|
||||
stw r6,0(r3)
|
||||
blr
|
||||
|
||||
DEF(void,set_ppc_vmx_env,(const void*)):
|
||||
subi r4,r1,16
|
||||
li r5,0xf
|
||||
andc r4,r4,r5
|
||||
li r5,0xc
|
||||
lwz r6,0(r3)
|
||||
stwx r6,r5,r4
|
||||
lvxl v0,0,r4
|
||||
mtvscr v0
|
||||
blr
|
||||
|
|
@ -1,7 +1,11 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
#define FACTOR_CPU_STRING "ppc"
|
||||
#ifdef FACTOR_64
|
||||
#define FACTOR_CPU_STRING "ppc.64"
|
||||
#else
|
||||
#define FACTOR_CPU_STRING "ppc.32"
|
||||
#endif
|
||||
|
||||
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - 32)
|
||||
|
||||
|
|
@ -16,36 +20,36 @@ static const fixnum xt_tail_pic_offset = 4;
|
|||
|
||||
inline static void check_call_site(cell return_address)
|
||||
{
|
||||
cell insn = *(cell *)return_address;
|
||||
u32 insn = *(u32 *)return_address;
|
||||
/* Check that absolute bit is 0 */
|
||||
assert((insn & 0x2) == 0x0);
|
||||
/* Check that instruction is branch */
|
||||
assert((insn >> 26) == 0x12);
|
||||
}
|
||||
|
||||
static const cell b_mask = 0x3fffffc;
|
||||
static const u32 b_mask = 0x3fffffc;
|
||||
|
||||
inline static void *get_call_target(cell return_address)
|
||||
{
|
||||
return_address -= sizeof(cell);
|
||||
return_address -= 4;
|
||||
check_call_site(return_address);
|
||||
|
||||
cell insn = *(cell *)return_address;
|
||||
cell unsigned_addr = (insn & b_mask);
|
||||
fixnum signed_addr = (fixnum)(unsigned_addr << 6) >> 6;
|
||||
u32 insn = *(u32 *)return_address;
|
||||
u32 unsigned_addr = (insn & b_mask);
|
||||
s32 signed_addr = (s32)(unsigned_addr << 6) >> 6;
|
||||
return (void *)(signed_addr + return_address);
|
||||
}
|
||||
|
||||
inline static void set_call_target(cell return_address, void *target)
|
||||
{
|
||||
return_address -= sizeof(cell);
|
||||
return_address -= 4;
|
||||
check_call_site(return_address);
|
||||
|
||||
cell insn = *(cell *)return_address;
|
||||
u32 insn = *(u32 *)return_address;
|
||||
|
||||
fixnum relative_address = ((cell)target - return_address);
|
||||
insn = ((insn & ~b_mask) | (relative_address & b_mask));
|
||||
*(cell *)return_address = insn;
|
||||
*(u32 *)return_address = insn;
|
||||
|
||||
/* Flush the cache line containing the call we just patched */
|
||||
__asm__ __volatile__ ("icbi 0, %0\n" "sync\n"::"r" (return_address):);
|
||||
|
|
@ -53,8 +57,8 @@ inline static void set_call_target(cell return_address, void *target)
|
|||
|
||||
inline static bool tail_call_site_p(cell return_address)
|
||||
{
|
||||
return_address -= sizeof(cell);
|
||||
cell insn = *(cell *)return_address;
|
||||
return_address -= 4;
|
||||
u32 insn = *(u32 *)return_address;
|
||||
return (insn & 0x1) == 0;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,46 @@
|
|||
.file "cpu-ppc.linux.S"
|
||||
.section ".text"
|
||||
.align 2
|
||||
.globl flush_icache
|
||||
.type flush_icache, @function
|
||||
flush_icache:
|
||||
add 4,4,3 # end += ptr
|
||||
#ifdef _ARCH_PPC64
|
||||
clrrdi 3,3,5 # ptr &= ~0x1f
|
||||
#else
|
||||
clrrwi 3,3,5 # ptr &= ~0x1f
|
||||
#endif
|
||||
sub 4,4,3 # end -= aligned_ptr
|
||||
addi 4,4,0x1f # end += 0x1f
|
||||
#ifdef _ARCH_PPC64
|
||||
srdi. 4,4,5 # end >>= 5, set cr
|
||||
#else
|
||||
srwi. 4,4,5 # end >>= 5, set cr
|
||||
#endif
|
||||
beqlr
|
||||
|
||||
# Loop over the buffer by cache line and flush the data cache.
|
||||
mr 5,3
|
||||
mtctr 4
|
||||
loop1:
|
||||
dcbst 0,5
|
||||
addi 5,5,0x20
|
||||
bdnz loop1
|
||||
|
||||
# Synchronize to ensure the cache line flushes are complete.
|
||||
sync
|
||||
|
||||
# Loop over the buffer by cache line and flush the instruction cache.
|
||||
mr 5,3
|
||||
mtctr 4
|
||||
loop2:
|
||||
icbi 0,5
|
||||
addi 5,5,0x20
|
||||
bdnz loop2
|
||||
|
||||
# Clear instruction pipeline to force reloading of instructions.
|
||||
isync
|
||||
blr
|
||||
|
||||
.size flush_icache,.-flush_icache
|
||||
.section .note.GNU-stack,"",@progbits
|
||||
|
|
@ -13,9 +13,10 @@ void factor_vm::c_to_factor(cell quot)
|
|||
{
|
||||
tagged<word> c_to_factor_word(special_objects[C_TO_FACTOR_WORD]);
|
||||
code_block *c_to_factor_block = callbacks->add(c_to_factor_word.value(),0);
|
||||
c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->entry_point();
|
||||
void* func = c_to_factor_block->entry_point();
|
||||
CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
|
||||
c_to_factor_func = (c_to_factor_func_type)func;
|
||||
}
|
||||
|
||||
c_to_factor_func(quot);
|
||||
}
|
||||
|
||||
|
|
@ -31,17 +32,26 @@ template<typename Func> Func factor_vm::get_entry_point(cell n)
|
|||
|
||||
void factor_vm::unwind_native_frames(cell quot, stack_frame *to)
|
||||
{
|
||||
get_entry_point<unwind_native_frames_func_type>(UNWIND_NATIVE_FRAMES_WORD)(quot,to);
|
||||
tagged<word> entry_point_word(special_objects[UNWIND_NATIVE_FRAMES_WORD]);
|
||||
void *func = entry_point_word->code->entry_point();
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
((unwind_native_frames_func_type)func)(quot,to);
|
||||
}
|
||||
|
||||
cell factor_vm::get_fpu_state()
|
||||
{
|
||||
return get_entry_point<get_fpu_state_func_type>(GET_FPU_STATE_WORD)();
|
||||
tagged<word> entry_point_word(special_objects[GET_FPU_STATE_WORD]);
|
||||
void *func = entry_point_word->code->entry_point();
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
return ((get_fpu_state_func_type)func)();
|
||||
}
|
||||
|
||||
void factor_vm::set_fpu_state(cell state)
|
||||
{
|
||||
get_entry_point<set_fpu_state_func_type>(GET_FPU_STATE_WORD)(state);
|
||||
tagged<word> entry_point_word(special_objects[SET_FPU_STATE_WORD]);
|
||||
void *func = entry_point_word->code->entry_point();
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
((set_fpu_state_func_type)func)(state);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -179,8 +179,9 @@ void factor_vm::stop_factor()
|
|||
|
||||
char *factor_vm::factor_eval_string(char *string)
|
||||
{
|
||||
char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]);
|
||||
return callback(string);
|
||||
void *func = alien_offset(special_objects[OBJ_EVAL_CALLBACK]);
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
return ((char *(*)(char *))func)(string);
|
||||
}
|
||||
|
||||
void factor_vm::factor_eval_free(char *result)
|
||||
|
|
@ -190,14 +191,16 @@ void factor_vm::factor_eval_free(char *result)
|
|||
|
||||
void factor_vm::factor_yield()
|
||||
{
|
||||
void (*callback)() = (void (*)())alien_offset(special_objects[OBJ_YIELD_CALLBACK]);
|
||||
callback();
|
||||
void *func = alien_offset(special_objects[OBJ_YIELD_CALLBACK]);
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
((void (*)())func)();
|
||||
}
|
||||
|
||||
void factor_vm::factor_sleep(long us)
|
||||
{
|
||||
void (*callback)(long) = (void (*)(long))alien_offset(special_objects[OBJ_SLEEP_CALLBACK]);
|
||||
callback(us);
|
||||
void *func = alien_offset(special_objects[OBJ_SLEEP_CALLBACK]);
|
||||
CODE_TO_FUNCTION_POINTER(func);
|
||||
((void (*)(long))func)(us);
|
||||
}
|
||||
|
||||
void factor_vm::start_standalone_factor(int argc, vm_char **argv)
|
||||
|
|
|
|||
|
|
@ -9,12 +9,24 @@ instruction_operand::instruction_operand(relocation_entry rel_, code_block *comp
|
|||
/* Load a 32-bit value from a PowerPC LIS/ORI sequence */
|
||||
fixnum instruction_operand::load_value_2_2()
|
||||
{
|
||||
cell *ptr = (cell *)pointer;
|
||||
u32 *ptr = (u32 *)pointer;
|
||||
cell hi = (ptr[-2] & 0xffff);
|
||||
cell lo = (ptr[-1] & 0xffff);
|
||||
return hi << 16 | lo;
|
||||
}
|
||||
|
||||
/* Load a 64-bit value from a PowerPC LIS/ORI/SLDI/ORIS/ORI sequence */
|
||||
fixnum instruction_operand::load_value_2_2_2_2()
|
||||
{
|
||||
u32 *ptr = (u32 *)pointer;
|
||||
u64 hhi = (ptr[-5] & 0xffff);
|
||||
u64 hlo = (ptr[-4] & 0xffff);
|
||||
u64 lhi = (ptr[-2] & 0xffff);
|
||||
u64 llo = (ptr[-1] & 0xffff);
|
||||
u64 val = hhi << 48 | hlo << 32 | lhi << 16 | llo;
|
||||
return (cell)val;
|
||||
}
|
||||
|
||||
/* Load a value from a bitfield of a PowerPC instruction */
|
||||
fixnum instruction_operand::load_value_masked(cell mask, cell bits, cell shift)
|
||||
{
|
||||
|
|
@ -37,10 +49,10 @@ fixnum instruction_operand::load_value(cell relative_to)
|
|||
return load_value_2_2();
|
||||
case RC_ABSOLUTE_PPC_2:
|
||||
return load_value_masked(rel_absolute_ppc_2_mask,16,0);
|
||||
case RC_RELATIVE_PPC_2:
|
||||
return load_value_masked(rel_relative_ppc_2_mask,16,0) + relative_to - sizeof(cell);
|
||||
case RC_RELATIVE_PPC_3:
|
||||
return load_value_masked(rel_relative_ppc_3_mask,6,0) + relative_to - sizeof(cell);
|
||||
case RC_RELATIVE_PPC_2_PC:
|
||||
return load_value_masked(rel_relative_ppc_2_mask,16,0) + relative_to - 4;
|
||||
case RC_RELATIVE_PPC_3_PC:
|
||||
return load_value_masked(rel_relative_ppc_3_mask,6,0) + relative_to - 4;
|
||||
case RC_RELATIVE_ARM_3:
|
||||
return load_value_masked(rel_relative_arm_3_mask,6,2) + relative_to + sizeof(cell);
|
||||
case RC_INDIRECT_ARM:
|
||||
|
|
@ -51,6 +63,8 @@ fixnum instruction_operand::load_value(cell relative_to)
|
|||
return *(u16 *)(pointer - sizeof(u16));
|
||||
case RC_ABSOLUTE_1:
|
||||
return *(u8 *)(pointer - sizeof(u8));
|
||||
case RC_ABSOLUTE_PPC_2_2_2_2:
|
||||
return load_value_2_2_2_2();
|
||||
default:
|
||||
critical_error("Bad rel class",rel.rel_class());
|
||||
return 0;
|
||||
|
|
@ -75,11 +89,22 @@ code_block *instruction_operand::load_code_block()
|
|||
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
|
||||
void instruction_operand::store_value_2_2(fixnum value)
|
||||
{
|
||||
cell *ptr = (cell *)pointer;
|
||||
u32 *ptr = (u32 *)pointer;
|
||||
ptr[-2] = ((ptr[-2] & ~0xffff) | ((value >> 16) & 0xffff));
|
||||
ptr[-1] = ((ptr[-1] & ~0xffff) | (value & 0xffff));
|
||||
}
|
||||
|
||||
/* Store a 64-bit value into a PowerPC LIS/ORI/SLDI/ORIS/ORI sequence */
|
||||
void instruction_operand::store_value_2_2_2_2(fixnum value)
|
||||
{
|
||||
u64 val = value;
|
||||
u32 *ptr = (u32 *)pointer;
|
||||
ptr[-5] = ((ptr[-5] & ~0xffff) | ((val >> 48) & 0xffff));
|
||||
ptr[-4] = ((ptr[-4] & ~0xffff) | ((val >> 32) & 0xffff));
|
||||
ptr[-2] = ((ptr[-2] & ~0xffff) | ((val >> 16) & 0xffff));
|
||||
ptr[-1] = ((ptr[-1] & ~0xffff) | ((val >> 0) & 0xffff));
|
||||
}
|
||||
|
||||
/* Store a value into a bitfield of a PowerPC instruction */
|
||||
void instruction_operand::store_value_masked(fixnum value, cell mask, cell shift)
|
||||
{
|
||||
|
|
@ -108,11 +133,11 @@ void instruction_operand::store_value(fixnum absolute_value)
|
|||
case RC_ABSOLUTE_PPC_2:
|
||||
store_value_masked(absolute_value,rel_absolute_ppc_2_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_PPC_2:
|
||||
store_value_masked(relative_value + sizeof(cell),rel_relative_ppc_2_mask,0);
|
||||
case RC_RELATIVE_PPC_2_PC:
|
||||
store_value_masked(relative_value + 4,rel_relative_ppc_2_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_PPC_3:
|
||||
store_value_masked(relative_value + sizeof(cell),rel_relative_ppc_3_mask,0);
|
||||
case RC_RELATIVE_PPC_3_PC:
|
||||
store_value_masked(relative_value + 4,rel_relative_ppc_3_mask,0);
|
||||
break;
|
||||
case RC_RELATIVE_ARM_3:
|
||||
store_value_masked(relative_value - sizeof(cell),rel_relative_arm_3_mask,2);
|
||||
|
|
@ -129,6 +154,9 @@ void instruction_operand::store_value(fixnum absolute_value)
|
|||
case RC_ABSOLUTE_1:
|
||||
*(u8 *)(pointer - sizeof(u8)) = (u8)absolute_value;
|
||||
break;
|
||||
case RC_ABSOLUTE_PPC_2_2_2_2:
|
||||
store_value_2_2_2_2(absolute_value);
|
||||
break;
|
||||
default:
|
||||
critical_error("Bad rel class",rel.rel_class());
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -30,7 +30,8 @@ enum relocation_type {
|
|||
type since its used in a situation where relocation arguments cannot
|
||||
be passed in, and so RT_DLSYM is inappropriate (Windows only) */
|
||||
RT_EXCEPTION_HANDLER,
|
||||
|
||||
/* arg is a literal table index, holding a pair (symbol/dll) */
|
||||
RT_DLSYM_TOC,
|
||||
};
|
||||
|
||||
enum relocation_class {
|
||||
|
|
@ -45,9 +46,9 @@ enum relocation_class {
|
|||
/* absolute address in a PowerPC LWZ instruction */
|
||||
RC_ABSOLUTE_PPC_2,
|
||||
/* relative address in a PowerPC LWZ/STW/BC instruction */
|
||||
RC_RELATIVE_PPC_2,
|
||||
RC_RELATIVE_PPC_2_PC,
|
||||
/* relative address in a PowerPC B/BL instruction */
|
||||
RC_RELATIVE_PPC_3,
|
||||
RC_RELATIVE_PPC_3_PC,
|
||||
/* relative address in an ARM B/BL instruction */
|
||||
RC_RELATIVE_ARM_3,
|
||||
/* pointer to address in an ARM LDR/STR instruction */
|
||||
|
|
@ -58,13 +59,15 @@ enum relocation_class {
|
|||
RC_ABSOLUTE_2,
|
||||
/* absolute address in a 1 byte location */
|
||||
RC_ABSOLUTE_1,
|
||||
/* absolute address in a PowerPC LIS/ORI/SLDI/ORIS/ORI sequence */
|
||||
RC_ABSOLUTE_PPC_2_2_2_2,
|
||||
};
|
||||
|
||||
static const cell rel_absolute_ppc_2_mask = 0xffff;
|
||||
static const cell rel_relative_ppc_2_mask = 0xfffc;
|
||||
static const cell rel_relative_ppc_3_mask = 0x3fffffc;
|
||||
static const cell rel_indirect_arm_mask = 0xfff;
|
||||
static const cell rel_relative_arm_3_mask = 0xffffff;
|
||||
static const cell rel_absolute_ppc_2_mask = 0x0000ffff;
|
||||
static const cell rel_relative_ppc_2_mask = 0x0000fffc;
|
||||
static const cell rel_relative_ppc_3_mask = 0x03fffffc;
|
||||
static const cell rel_indirect_arm_mask = 0x00000fff;
|
||||
static const cell rel_relative_arm_3_mask = 0x00ffffff;
|
||||
|
||||
/* code relocation table consists of a table of entries for each fixup */
|
||||
struct relocation_entry {
|
||||
|
|
@ -101,6 +104,7 @@ struct relocation_entry {
|
|||
case RT_VM:
|
||||
return 1;
|
||||
case RT_DLSYM:
|
||||
case RT_DLSYM_TOC:
|
||||
return 2;
|
||||
case RT_ENTRY_POINT:
|
||||
case RT_ENTRY_POINT_PIC:
|
||||
|
|
@ -150,6 +154,7 @@ struct instruction_operand {
|
|||
}
|
||||
|
||||
fixnum load_value_2_2();
|
||||
fixnum load_value_2_2_2_2();
|
||||
fixnum load_value_masked(cell mask, cell bits, cell shift);
|
||||
fixnum load_value(cell relative_to);
|
||||
fixnum load_value();
|
||||
|
|
@ -157,6 +162,7 @@ struct instruction_operand {
|
|||
code_block *load_code_block();
|
||||
|
||||
void store_value_2_2(fixnum value);
|
||||
void store_value_2_2_2_2(fixnum value);
|
||||
void store_value_masked(fixnum value, cell mask, cell shift);
|
||||
void store_value(fixnum value);
|
||||
void store_code_block(code_block *compiled);
|
||||
|
|
|
|||
|
|
@ -1,8 +1,13 @@
|
|||
#ifndef __FACTOR_MASTER_H__
|
||||
#define __FACTOR_MASTER_H__
|
||||
|
||||
#ifndef _THREAD_SAFE
|
||||
#define _THREAD_SAFE
|
||||
#endif
|
||||
|
||||
#ifndef _REENTRANT
|
||||
#define _REENTRANT
|
||||
#endif
|
||||
|
||||
#ifndef WINCE
|
||||
#include <errno.h>
|
||||
|
|
@ -21,6 +26,7 @@
|
|||
#include <string.h>
|
||||
#include <time.h>
|
||||
#include <wchar.h>
|
||||
#include <assert.h>
|
||||
|
||||
/* C++ headers */
|
||||
#include <algorithm>
|
||||
|
|
@ -31,7 +37,8 @@
|
|||
#include <iostream>
|
||||
#include <iomanip>
|
||||
|
||||
#define FACTOR_STRINGIZE(x) #x
|
||||
#define FACTOR_STRINGIZE_I(x) #x
|
||||
#define FACTOR_STRINGIZE(x) FACTOR_STRINGIZE_I(x)
|
||||
|
||||
/* Record compiler version */
|
||||
#if defined(__clang__)
|
||||
|
|
@ -54,7 +61,12 @@
|
|||
#define FACTOR_64
|
||||
#elif defined(i386) || defined(__i386) || defined(__i386__) || defined(_M_IX86)
|
||||
#define FACTOR_X86
|
||||
#elif (defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC)) && (defined(__PPC64__) || defined(__64BIT__))
|
||||
#define FACTOR_PPC64
|
||||
#define FACTOR_PPC
|
||||
#define FACTOR_64
|
||||
#elif defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC)
|
||||
#define FACTOR_PPC32
|
||||
#define FACTOR_PPC
|
||||
#else
|
||||
#error "Unsupported architecture"
|
||||
|
|
|
|||
|
|
@ -8,3 +8,9 @@ extern "C" int getosreldate();
|
|||
#endif
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE __register_t
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
|
|
|||
|
|
@ -9,5 +9,11 @@ void flush_icache(cell start, cell len);
|
|||
|
||||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.arm_sp)
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.arm_pc)
|
||||
#define UAP_STACK_POINTER_TYPE greg_t
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,39 @@
|
|||
#include <ucontext.h>
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
|
||||
#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[1]
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[32])
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE unsigned long
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
union {
|
||||
double as_double;
|
||||
unsigned int as_uint[2];
|
||||
} tmp;
|
||||
tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr;
|
||||
return tmp.as_uint[1];
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
union {
|
||||
double as_double;
|
||||
unsigned int as_uint[2];
|
||||
} tmp;
|
||||
tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr;
|
||||
tmp.as_uint[1] &= 0x0007f8ff;
|
||||
((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr = tmp.as_double;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
#include <ucontext.h>
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 2)
|
||||
#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.gp_regs[1]
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gp_regs[32])
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define FACTOR_PPC_TOC 1
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) \
|
||||
void *desc[3]; \
|
||||
code = fill_function_descriptor(desc, code)
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) \
|
||||
code = fill_function_descriptor(new void*[3], code); \
|
||||
vm->function_descriptors.push_back((void **)code)
|
||||
|
||||
#define FUNCTION_CODE_POINTER(ptr) \
|
||||
(function_descriptor_field((void *)ptr, 0))
|
||||
|
||||
#define FUNCTION_TOC_POINTER(ptr) \
|
||||
(function_descriptor_field((void *)ptr, 1))
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE unsigned long
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
union {
|
||||
double as_double;
|
||||
unsigned int as_uint[2];
|
||||
} tmp;
|
||||
tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.fp_regs[32];
|
||||
return tmp.as_uint[1];
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
union {
|
||||
double as_double;
|
||||
unsigned int as_uint[2];
|
||||
} tmp;
|
||||
tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.fp_regs[32];
|
||||
tmp.as_uint[1] &= 0x0007f8ff;
|
||||
((ucontext_t*) uap)->uc_mcontext.fp_regs[32] = tmp.as_double;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
#include <ucontext.h>
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
|
||||
#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_R1]
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_NIP])
|
||||
|
||||
}
|
||||
|
|
@ -51,5 +51,12 @@ inline static void uap_clear_fpu_status(void *uap)
|
|||
|
||||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[7])
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[14])
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE greg_t
|
||||
}
|
||||
|
|
|
|||
|
|
@ -19,5 +19,12 @@ inline static void uap_clear_fpu_status(void *uap)
|
|||
|
||||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[15])
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[16])
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE greg_t
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,6 +7,4 @@ VM_C_API int inotify_init();
|
|||
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask);
|
||||
VM_C_API int inotify_rm_watch(int fd, u32 wd);
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE greg_t
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,7 +10,13 @@ const char *vm_executable_path();
|
|||
const char *default_image_path();
|
||||
|
||||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_stack.ss_sp)
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE void*
|
||||
#define UAP_STACK_POINTER_TYPE void *
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,3 +3,9 @@
|
|||
#define UAP_PROGRAM_COUNTER(uap) _UC_MACHINE_PC((ucontext_t *)uap)
|
||||
|
||||
#define UAP_STACK_POINTER_TYPE __greg_t
|
||||
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
|
|
|||
|
|
@ -1 +1,7 @@
|
|||
#define UAP_STACK_POINTER_TYPE __register_t
|
||||
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
|
|
|
|||
|
|
@ -6,4 +6,9 @@ namespace factor
|
|||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[ESP])
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[EIP])
|
||||
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,4 +6,9 @@ namespace factor
|
|||
#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[RSP])
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[RIP])
|
||||
|
||||
#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
}
|
||||
|
|
|
|||
|
|
@ -47,12 +47,23 @@ void factor_vm::ffi_dlopen(dll *dll)
|
|||
dll->handle = dlopen(alien_offset(dll->path), RTLD_LAZY);
|
||||
}
|
||||
|
||||
void *factor_vm::ffi_dlsym_raw(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
return dlsym(dll ? dll->handle : null_dll, symbol);
|
||||
}
|
||||
|
||||
void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
void *handle = (dll == NULL ? null_dll : dll->handle);
|
||||
return dlsym(handle,symbol);
|
||||
return FUNCTION_CODE_POINTER(ffi_dlsym_raw(dll, symbol));
|
||||
}
|
||||
|
||||
#ifdef FACTOR_PPC
|
||||
void *factor_vm::ffi_dlsym_toc(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
return FUNCTION_TOC_POINTER(ffi_dlsym_raw(dll, symbol));
|
||||
}
|
||||
#endif
|
||||
|
||||
void factor_vm::ffi_dlclose(dll *dll)
|
||||
{
|
||||
if(dlclose(dll->handle))
|
||||
|
|
@ -116,8 +127,8 @@ segment::~segment()
|
|||
void factor_vm::dispatch_signal(void *uap, void (handler)())
|
||||
{
|
||||
UAP_STACK_POINTER(uap) = (UAP_STACK_POINTER_TYPE)fix_callstack_top((stack_frame *)UAP_STACK_POINTER(uap));
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)handler;
|
||||
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)FUNCTION_CODE_POINTER(handler);
|
||||
UAP_SET_TOC_POINTER(uap, (cell)FUNCTION_TOC_POINTER(handler));
|
||||
ctx->callstack_top = (stack_frame *)UAP_STACK_POINTER(uap);
|
||||
}
|
||||
|
||||
|
|
@ -194,6 +205,7 @@ void factor_vm::unix_init_signals()
|
|||
|
||||
sigaction_safe(SIGBUS,&memory_sigaction,NULL);
|
||||
sigaction_safe(SIGSEGV,&memory_sigaction,NULL);
|
||||
sigaction_safe(SIGTRAP,&memory_sigaction,NULL);
|
||||
|
||||
memset(&fpe_sigaction,0,sizeof(struct sigaction));
|
||||
sigemptyset(&fpe_sigaction.sa_mask);
|
||||
|
|
|
|||
|
|
@ -22,6 +22,11 @@ void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol)
|
|||
return (void *)GetProcAddress(dll ? (HMODULE)dll->handle : hFactorDll, symbol);
|
||||
}
|
||||
|
||||
void *factor_vm::ffi_dlsym_raw(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
return ffi_dlsym(dll, symbol);
|
||||
}
|
||||
|
||||
void factor_vm::ffi_dlclose(dll *dll)
|
||||
{
|
||||
FreeLibrary((HMODULE)dll->handle);
|
||||
|
|
|
|||
|
|
@ -75,4 +75,8 @@ VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, vo
|
|||
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
|
||||
inline static THREADHANDLE thread_id() { return GetCurrentThread(); }
|
||||
|
||||
#define CODE_TO_FUNCTION_POINTER(code) (void)0
|
||||
#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
|
||||
#define FUNCTION_CODE_POINTER(ptr) ptr
|
||||
#define FUNCTION_TOC_POINTER(ptr) ptr
|
||||
}
|
||||
|
|
|
|||
|
|
@ -71,8 +71,10 @@
|
|||
|
||||
#if defined(FACTOR_X86)
|
||||
#include "os-linux-x86.32.hpp"
|
||||
#elif defined(FACTOR_PPC)
|
||||
#include "os-linux-ppc.hpp"
|
||||
#elif defined(FACTOR_PPC64)
|
||||
#include "os-linux-ppc.64.hpp"
|
||||
#elif defined(FACTOR_PPC32)
|
||||
#include "os-linux-ppc.32.hpp"
|
||||
#elif defined(FACTOR_ARM)
|
||||
#include "os-linux-arm.hpp"
|
||||
#elif defined(FACTOR_AMD64)
|
||||
|
|
|
|||
|
|
@ -57,6 +57,7 @@ namespace factor
|
|||
_(dll_validp) \
|
||||
_(dlopen) \
|
||||
_(dlsym) \
|
||||
_(dlsym_raw) \
|
||||
_(double_bits) \
|
||||
_(enable_gc_events) \
|
||||
_(existsp) \
|
||||
|
|
|
|||
|
|
@ -190,6 +190,10 @@ void quotation_jit::iterate_quotation()
|
|||
#endif
|
||||
parameter(obj.value());
|
||||
parameter(false_object);
|
||||
#ifdef FACTOR_PPC_TOC
|
||||
parameter(obj.value());
|
||||
parameter(false_object);
|
||||
#endif
|
||||
emit(parent->special_objects[JIT_PRIMITIVE]);
|
||||
|
||||
i++;
|
||||
|
|
|
|||
|
|
@ -3,6 +3,22 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* Fill in a PPC function descriptor */
|
||||
void *fill_function_descriptor(void *ptr, void *code)
|
||||
{
|
||||
void **descriptor = (void **)ptr;
|
||||
descriptor[0] = code;
|
||||
descriptor[1] = NULL;
|
||||
descriptor[2] = NULL;
|
||||
return descriptor;
|
||||
}
|
||||
|
||||
/* Get a field from a PPC function descriptor */
|
||||
void *function_descriptor_field(void *ptr, size_t idx)
|
||||
{
|
||||
return ptr ? ((void **) ptr)[idx] : ptr;
|
||||
}
|
||||
|
||||
/* If memory allocation fails, bail out */
|
||||
vm_char *safe_strdup(const vm_char *str)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -46,6 +46,9 @@ inline static void memset_cell(void *dst, cell pattern, size_t size)
|
|||
#endif
|
||||
}
|
||||
|
||||
void *fill_function_descriptor(void *ptr, void *code);
|
||||
void *function_descriptor_field(void *ptr, size_t idx);
|
||||
|
||||
vm_char *safe_strdup(const vm_char *str);
|
||||
cell read_cell_hex();
|
||||
VM_C_API void *factor_memcpy(void *dst, void *src, size_t len);
|
||||
|
|
|
|||
|
|
@ -27,6 +27,13 @@ factor_vm::~factor_vm()
|
|||
delete signal_callstack_seg;
|
||||
signal_callstack_seg = NULL;
|
||||
}
|
||||
std::list<void **>::const_iterator iter = function_descriptors.begin();
|
||||
std::list<void **>::const_iterator end = function_descriptors.end();
|
||||
while(iter != end)
|
||||
{
|
||||
delete [] *iter;
|
||||
iter++;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
11
vm/vm.hpp
11
vm/vm.hpp
|
|
@ -34,6 +34,9 @@ struct factor_vm
|
|||
/* Next callback ID */
|
||||
int callback_id;
|
||||
|
||||
/* List of callback function descriptors for PPC */
|
||||
std::list<void **> function_descriptors;
|
||||
|
||||
/* Pooling unused contexts to make context allocation cheaper */
|
||||
std::list<context *> unused_contexts;
|
||||
|
||||
|
|
@ -525,6 +528,9 @@ struct factor_vm
|
|||
void update_word_references(code_block *compiled, bool reset_inline_caches);
|
||||
void undefined_symbol();
|
||||
cell compute_dlsym_address(array *literals, cell index);
|
||||
#ifdef FACTOR_PPC
|
||||
cell compute_dlsym_toc_address(array *literals, cell index);
|
||||
#endif
|
||||
cell compute_vm_address(cell arg);
|
||||
void store_external_address(instruction_operand op);
|
||||
cell compute_here_address(cell arg, cell offset, code_block *compiled);
|
||||
|
|
@ -603,6 +609,7 @@ struct factor_vm
|
|||
void *alien_pointer();
|
||||
void primitive_dlopen();
|
||||
void primitive_dlsym();
|
||||
void primitive_dlsym_raw();
|
||||
void primitive_dlclose();
|
||||
void primitive_dll_validp();
|
||||
char *alien_offset(cell obj);
|
||||
|
|
@ -678,6 +685,10 @@ struct factor_vm
|
|||
void init_ffi();
|
||||
void ffi_dlopen(dll *dll);
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol);
|
||||
void *ffi_dlsym_raw(dll *dll, symbol_char *symbol);
|
||||
#ifdef FACTOR_PPC
|
||||
void *ffi_dlsym_toc(dll *dll, symbol_char *symbol);
|
||||
#endif
|
||||
void ffi_dlclose(dll *dll);
|
||||
void c_to_factor_toplevel(cell quot);
|
||||
void init_signals();
|
||||
|
|
|
|||
Loading…
Reference in New Issue