From: Erik Charlebois Date: Fri, 20 May 2011 22:11:50 +0000 (-0400) Subject: 32 and 64 bit Linux PPC support X-Git-Tag: 0.97~4323^2^2~7 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=64252dbdbcebd420f59cef4a1ee4a2dc8b63990c 32 and 64 bit Linux PPC support --- diff --git a/GNUmakefile b/GNUmakefile index 43fba15c0b..528ea0eb2f 100755 --- a/GNUmakefile +++ b/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 $@ $< diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 48f608037b..63c6f72ee6 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -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 diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor index 206db7b188..37ac47307d 100755 --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -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 diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 623b169853..279dd5c158 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -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 + diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 90f60a4205..4bc567ce8b 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -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 diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index d5502ab3ba..d0a4d19723 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -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 ; diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor index 180b22e477..b336d302f5 100644 --- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor @@ -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 } ; + heap-size cell align cell /i { int-rep f f } ; 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 ; diff --git a/basis/compiler/cfg/builder/alien/params/params.factor b/basis/compiler/cfg/builder/alien/params/params.factor index 651e5890a4..ff7d11b4e3 100644 --- a/basis/compiler/cfg/builder/alien/params/params.factor +++ b/basis/compiler/cfg/builder/alien/params/params.factor @@ -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 >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 ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 015368cf98..8e63dfebc7 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -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 [ diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index 7df85c390d..af59ca223d 100644 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -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 ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index f72a2c4ec5..97da3b7516 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -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 -- ? ) ${ diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 3f2100b787..265bb8894e 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -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 ( -- ? ) diff --git a/basis/cpu/ppc/32/32.factor b/basis/cpu/ppc/32/32.factor new file mode 100644 index 0000000000..28680ccee2 --- /dev/null +++ b/basis/cpu/ppc/32/32.factor @@ -0,0 +1,3 @@ +! Copyright (C) 2011 Erik Charlebois. +! See http://factorcode.org/license.txt for BSD license. +USING: cpu.ppc ; diff --git a/basis/cpu/ppc/32/linux/bootstrap.factor b/basis/cpu/ppc/32/linux/bootstrap.factor new file mode 100644 index 0000000000..0d75eb0100 --- /dev/null +++ b/basis/cpu/ppc/32/linux/bootstrap.factor @@ -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 diff --git a/basis/cpu/ppc/32/linux/linux.factor b/basis/cpu/ppc/32/linux/linux.factor new file mode 100644 index 0000000000..27b9f123ae --- /dev/null +++ b/basis/cpu/ppc/32/linux/linux.factor @@ -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 ; diff --git a/basis/cpu/ppc/64/64.factor b/basis/cpu/ppc/64/64.factor new file mode 100644 index 0000000000..28680ccee2 --- /dev/null +++ b/basis/cpu/ppc/64/64.factor @@ -0,0 +1,3 @@ +! Copyright (C) 2011 Erik Charlebois. +! See http://factorcode.org/license.txt for BSD license. +USING: cpu.ppc ; diff --git a/basis/cpu/ppc/64/linux/bootstrap.factor b/basis/cpu/ppc/64/linux/bootstrap.factor new file mode 100644 index 0000000000..9fd9506cc0 --- /dev/null +++ b/basis/cpu/ppc/64/linux/bootstrap.factor @@ -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 diff --git a/basis/cpu/ppc/64/linux/linux.factor b/basis/cpu/ppc/64/linux/linux.factor new file mode 100644 index 0000000000..70a9aed5ca --- /dev/null +++ b/basis/cpu/ppc/64/linux/linux.factor @@ -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 } ] + } 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 } ] + } cond ; diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor new file mode 100644 index 0000000000..1600853af4 --- /dev/null +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -0,0 +1,2005 @@ +! Copyright (C) 2011 Erik Charlebois. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces words math math.order locals math.bitwise io.binary make ; +IN: cpu.ppc.assembler + +! This vocabulary implements the V2.06B Power ISA found at http://www.power.org. +! The names are standard and the operand order is the same as in the specification, +! except that displacement in d-form and ds-form instructions come after the base +! address register. +! +! For example, in assembler syntax, stores are written like: +! stw r14,10(r15) +! In Factor, we write: +! 14 15 10 STW + +: insn ( operand opcode -- ) + { 26 0 } bitfield 4 >be % ; + +: a-insn ( rt ra rb rc 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 ; + +: d-insn ( rt ra d opcode -- ) + [ HEX: ffff bitand { 0 16 21 } bitfield ] dip insn ; + +: ds-insn ( rt ra ds rc opcode -- ) + [ [ HEX: 3fff bitand ] dip { 0 2 16 21 } bitfield ] dip insn ; + +: evx-insn ( rt ra rb xo opcode -- ) + [ { 0 11 16 21 } bitfield ] dip insn ; + +: i-insn ( li aa lk opcode -- ) + [ { 0 1 2 } bitfield ] dip insn ; + +: m-insn ( rs ra sh mb me rc opcode -- ) + [ { 0 1 6 11 16 21 } bitfield ] dip insn ; + +:: md-insn ( rs ra sh mb xo sh5 rc opcode -- ) + mb [ HEX: 1f bitand 1 shift ] [ -5 shift ] bi bitor :> mb + rs ra sh mb xo sh5 rc opcode + [ { 0 1 2 5 11 16 21 } bitfield ] dip insn ; + +:: mds-insn ( rs ra rb mb xo rc opcode -- ) + mb [ HEX: 1f bitand 1 shift ] [ -5 shift ] bi bitor :> mb + rs ra rb mb xo rc opcode + [ { 0 1 5 11 16 21 } bitfield ] dip insn ; + +: sc-insn ( lev opcode -- ) + [ 1 { 1 5 } bitfield ] dip insn ; + +: va-insn ( vrt vra vrb vrc xo opcode -- ) + [ { 0 6 11 16 21 } bitfield ] dip insn ; + +: vc-insn ( vrt vra vrb rc xo opcode -- ) + [ { 0 10 11 16 21 } bitfield ] dip insn ; + +: vx-insn ( vrt vra vrb xo opcode -- ) + [ { 0 11 16 21 } bitfield ] dip insn ; + +: x-insn ( rt ra rb xo rc opcode -- ) + [ { 0 1 11 16 21 } bitfield ] dip insn ; + +: xfl-insn ( l flm w frb xo rc opcode -- ) + [ { 0 1 11 16 17 25 } bitfield ] dip insn ; + +: xfx-insn ( rs spr xo rc opcode -- ) + [ { 0 1 11 21 } bitfield ] dip insn ; + +: xl-insn ( bo bi bb xo lk opcode -- ) + [ { 0 1 11 16 21 } bitfield ] dip insn ; + +: xo-insn ( rt ra rb oe xo rc opcode -- ) + [ { 0 1 10 11 16 21 } bitfield ] dip insn ; + +: xs-insn ( rs ra sh xo sh5 rc opcode -- ) + [ { 0 1 2 11 16 21 } bitfield ] dip insn ; + +:: xx1-insn ( rt ra rb xo opcode -- ) + rt HEX: 1f bitand ra rb xo rt -5 shift + { 0 1 11 16 21 } bitfield opcode insn ; + +:: xx2-insn ( rt ra rb xo opcode -- ) + rt HEX: 1f bitand ra rb HEX: 1f bitand xo + rb -5 shift rt -5 shift + { 0 1 2 11 16 21 } bitfield opcode insn ; + +:: xx3-insn ( rt ra rb xo opcode -- ) + rt HEX: 1f bitand ra HEX: 1f bitand rb HEX: 1f bitand + xo ra -5 shift rb -5 shift rt -5 shift + { 0 1 2 3 11 16 21 } bitfield opcode insn ; + +:: xx3-rc-insn ( rt ra rb rc xo opcode -- ) + rt HEX: 1f bitand ra HEX: 1f bitand rb HEX: 1f bitand + rc xo ra -5 shift rb -5 shift rt -5 shift + { 0 1 2 3 10 11 16 21 } bitfield opcode insn ; + +:: xx3-rc-dm-insn ( rt ra rb rc dm xo opcode -- ) + rt HEX: 1f bitand ra HEX: 1f bitand rb HEX: 1f bitand + rc dm xo ra -5 shift rb -5 shift rt -5 shift + { 0 1 2 3 8 10 11 16 21 } bitfield opcode insn ; + +:: xx4-insn ( rt ra rb rc xo opcode -- ) + rt HEX: 1f bitand ra HEX: 1f bitand rb HEX: 1f bitand + rc HEX: 1f bitand xo rc -5 shift ra -5 shift rb + -5 shift rt -5 shift + { 0 1 2 3 4 6 11 16 21 } bitfield opcode insn ; + +: z22-insn ( bf fra dcm xo rc opcode -- ) + [ { 0 1 10 16 21 } bitfield ] dip insn ; + +: z23-insn ( frt te frb rmc xo rc opcode -- ) + [ { 0 1 9 11 16 21 } bitfield ] dip insn ; + +! 2.4 Branch Instructions +GENERIC: B ( target_addr/label -- ) +M: integer B ( target_addr -- ) -2 shift 0 0 18 i-insn ; + +GENERIC: BL ( target_addr/label -- ) +M: integer BL ( target_addr -- ) -2 shift 0 1 18 i-insn ; + +: BA ( target_addr -- ) -2 shift 1 0 18 i-insn ; +: BLA ( target_addr -- ) -2 shift 1 1 18 i-insn ; + +GENERIC: BC ( bo bi target_addr/label -- ) +M: integer BC ( bo bi target_addr -- ) -2 shift 0 0 16 b-insn ; + +: BCA ( bo bi target_addr -- ) -2 shift 1 0 16 b-insn ; +: BCL ( bo bi target_addr -- ) -2 shift 0 1 16 b-insn ; +: BCLA ( bo bi target_addr -- ) -2 shift 1 1 16 b-insn ; + +: BCLR ( bo bi bh -- ) 16 0 19 xl-insn ; +: BCLRL ( bo bi bh -- ) 16 1 19 xl-insn ; +: BCCTR ( bo bi bh -- ) 528 0 19 xl-insn ; +: BCCTRL ( bo bi bh -- ) 528 1 19 xl-insn ; + +! 2.5.1 Condition Register Logical Instructions +: CRAND ( bt ba bb -- ) 527 0 19 xl-insn ; +: CRNAND ( bt ba bb -- ) 225 0 19 xl-insn ; +: CROR ( bt ba bb -- ) 449 0 19 xl-insn ; +: CRXOR ( bt ba bb -- ) 193 0 19 xl-insn ; +: CRNOR ( bt ba bb -- ) 33 0 19 xl-insn ; +: CREQV ( bt ba bb -- ) 289 0 19 xl-insn ; +: CRANDC ( bt ba bb -- ) 129 0 19 xl-insn ; +: CRORC ( bt ba bb -- ) 417 0 19 xl-insn ; + +! 2.5.2 Condition Register Field Instruction +: MCRF ( bf bfa -- ) [ 2 shift ] bi@ 0 0 0 19 xl-insn ; + +! 2.6 System Call Instruction +: SC ( lev -- ) 17 sc-insn ; + +! 3.3.2 Fixed-Point Load Instructions +: LBZ ( rt ra d -- ) 34 d-insn ; +: LBZU ( rt ra d -- ) 35 d-insn ; +: LHZ ( rt ra d -- ) 40 d-insn ; +: LHZU ( rt ra d -- ) 41 d-insn ; +: LHA ( rt ra d -- ) 42 d-insn ; +: LHAU ( rt ra d -- ) 43 d-insn ; +: LWZ ( rt ra d -- ) 32 d-insn ; +: LWZU ( rt ra d -- ) 33 d-insn ; +: LBZX ( rt ra rb -- ) 87 0 31 x-insn ; +: LBZUX ( rt ra rb -- ) 119 0 31 x-insn ; +: LHZX ( rt ra rb -- ) 279 0 31 x-insn ; +: LHZUX ( rt ra rb -- ) 311 0 31 x-insn ; +: LHAX ( rt ra rb -- ) 343 0 31 x-insn ; +: LHAUX ( rt ra rb -- ) 375 0 31 x-insn ; +: LWZX ( rt ra rb -- ) 23 0 31 x-insn ; +: LWZUX ( rt ra rb -- ) 55 0 31 x-insn ; + +! 3.3.2.1 64-bit Fixed-Point Load Instructions +: LWA ( rt ra ds -- ) -2 shift 2 58 ds-insn ; +: LD ( rt ra ds -- ) -2 shift 0 58 ds-insn ; +: LDU ( rt ra ds -- ) -2 shift 1 58 ds-insn ; +: LWAX ( rt ra rb -- ) 341 0 31 x-insn ; +: LWAUX ( rt ra rb -- ) 373 0 31 x-insn ; +: LDX ( rt ra rb -- ) 21 0 31 x-insn ; +: LDUX ( rt ra rb -- ) 53 0 31 x-insn ; + +! 3.3.3 Fixed-Point Store Instructions +: STB ( rs ra d -- ) 38 d-insn ; +: STBU ( rs ra d -- ) 39 d-insn ; +: STH ( rs ra d -- ) 44 d-insn ; +: STHU ( rs ra d -- ) 45 d-insn ; +: STW ( rs ra d -- ) 36 d-insn ; +: STWU ( rs ra d -- ) 37 d-insn ; +: STBX ( rs ra rb -- ) 215 0 31 x-insn ; +: STBUX ( rs ra rb -- ) 247 0 31 x-insn ; +: STHX ( rs ra rb -- ) 407 0 31 x-insn ; +: STHUX ( rs ra rb -- ) 439 0 31 x-insn ; +: STWX ( rs ra rb -- ) 151 0 31 x-insn ; +: STWUX ( rs ra rb -- ) 183 0 31 x-insn ; + +! 3.3.3.1 64-bit Fixed-Point Store Instructions +: STD ( rs ra ds -- ) -2 shift 0 62 ds-insn ; +: STDU ( rs ra ds -- ) -2 shift 1 62 ds-insn ; +: STDX ( rs ra rb -- ) 149 0 31 x-insn ; +: STDUX ( rs ra rb -- ) 181 0 31 x-insn ; + +! 3.3.4 Fixed-Point Load and Store with Byte Reversal Instructions +: LHBRX ( rt ra rb -- ) 790 0 31 x-insn ; +: LWBRX ( rt ra rb -- ) 534 0 31 x-insn ; +: STHBRX ( rs ra rb -- ) 918 0 31 x-insn ; +: STWBRX ( rs ra rb -- ) 662 0 31 x-insn ; + +! 3.3.4.1 64-bit Fixed-Point Load and Store with Byte Reversal Instructions +: LDBRX ( rt ra rb -- ) 532 0 31 x-insn ; +: STDBRX ( rs ra rb -- ) 660 0 31 x-insn ; + +! 3.3.5 Fixed-Point Load and Store Multiple Instructions +: LMW ( rt ra d -- ) 46 d-insn ; +: STMW ( rs ra d -- ) 47 d-insn ; + +! 3.3.6 Fixed-Point Move Assist Instructions +: LSWI ( rt ra nb -- ) 597 0 31 x-insn ; +: LSWX ( rt ra rb -- ) 533 0 31 x-insn ; +: STSWI ( rs ra nb -- ) 725 0 31 x-insn ; +: STSWX ( rs ra rb -- ) 661 0 31 x-insn ; + +! 3.3.8 Fixed-Point Arithmetic Instructions +: ADDI ( rt ra si -- ) 14 d-insn ; +: ADDIS ( rt ra si -- ) 15 d-insn ; +: ADDIC ( rt ra si -- ) 12 d-insn ; +: ADDIC. ( rt ra si -- ) 13 d-insn ; +: SUBFIC ( rt ra si -- ) 8 d-insn ; +: MULLI ( rt ra si -- ) 7 d-insn ; +: ADD ( rt ra rb -- ) 0 266 0 31 xo-insn ; +: ADD. ( rt ra rb -- ) 0 266 1 31 xo-insn ; +: ADDO ( rt ra rb -- ) 1 266 0 31 xo-insn ; +: ADDO. ( rt ra rb -- ) 1 266 1 31 xo-insn ; +: ADDC ( rt ra rb -- ) 0 10 0 31 xo-insn ; +: ADDC. ( rt ra rb -- ) 0 10 1 31 xo-insn ; +: ADDCO ( rt ra rb -- ) 1 10 0 31 xo-insn ; +: ADDCO. ( rt ra rb -- ) 1 10 1 31 xo-insn ; +: ADDE ( rt ra rb -- ) 0 138 0 31 xo-insn ; +: ADDE. ( rt ra rb -- ) 0 138 1 31 xo-insn ; +: ADDEO ( rt ra rb -- ) 1 138 0 31 xo-insn ; +: ADDEO. ( rt ra rb -- ) 1 138 1 31 xo-insn ; +: ADDME ( rt ra -- ) 0 0 234 0 31 xo-insn ; +: ADDME. ( rt ra -- ) 0 0 234 1 31 xo-insn ; +: ADDMEO ( rt ra -- ) 0 1 234 0 31 xo-insn ; +: ADDMEO. ( rt ra -- ) 0 1 234 1 31 xo-insn ; +: ADDZE ( rt ra -- ) 0 0 202 0 31 xo-insn ; +: ADDZE. ( rt ra -- ) 0 0 202 1 31 xo-insn ; +: ADDZEO ( rt ra -- ) 0 1 202 0 31 xo-insn ; +: ADDZEO. ( rt ra -- ) 0 1 202 1 31 xo-insn ; +: SUBF ( rt ra rb -- ) 0 40 0 31 xo-insn ; +: SUBF. ( rt ra rb -- ) 0 40 1 31 xo-insn ; +: SUBFO ( rt ra rb -- ) 1 40 0 31 xo-insn ; +: SUBFO. ( rt ra rb -- ) 1 40 1 31 xo-insn ; +: SUBFC ( rt ra rb -- ) 0 8 0 31 xo-insn ; +: SUBFC. ( rt ra rb -- ) 0 8 1 31 xo-insn ; +: SUBFCO ( rt ra rb -- ) 1 8 0 31 xo-insn ; +: SUBFCO. ( rt ra rb -- ) 1 8 1 31 xo-insn ; +: SUBFE ( rt ra rb -- ) 0 136 0 31 xo-insn ; +: SUBFE. ( rt ra rb -- ) 0 136 1 31 xo-insn ; +: SUBFEO ( rt ra rb -- ) 1 136 0 31 xo-insn ; +: SUBFEO. ( rt ra rb -- ) 1 136 1 31 xo-insn ; +: SUBFME ( rt ra -- ) 0 0 232 0 31 xo-insn ; +: SUBFME. ( rt ra -- ) 0 0 232 1 31 xo-insn ; +: SUBFMEO ( rt ra -- ) 0 1 232 0 31 xo-insn ; +: SUBFMEO. ( rt ra -- ) 0 1 232 1 31 xo-insn ; +: SUBFZE ( rt ra -- ) 0 0 200 0 31 xo-insn ; +: SUBFZE. ( rt ra -- ) 0 0 200 1 31 xo-insn ; +: SUBFZEO ( rt ra -- ) 0 1 200 0 31 xo-insn ; +: SUBFZEO. ( rt ra -- ) 0 1 200 1 31 xo-insn ; +: NEG ( rt ra -- ) 0 0 104 0 31 xo-insn ; +: NEG. ( rt ra -- ) 0 0 104 1 31 xo-insn ; +: NEGO ( rt ra -- ) 0 1 104 0 31 xo-insn ; +: NEGO. ( rt ra -- ) 0 1 104 1 31 xo-insn ; +: MULLW ( rt ra rb -- ) 0 235 0 31 xo-insn ; +: MULLW. ( rt ra rb -- ) 0 235 1 31 xo-insn ; +: MULLWO ( rt ra rb -- ) 1 235 0 31 xo-insn ; +: MULLWO. ( rt ra rb -- ) 1 235 1 31 xo-insn ; +: MULHW ( rt ra rb -- ) 0 75 0 31 xo-insn ; +: MULHW. ( rt ra rb -- ) 0 75 1 31 xo-insn ; +: MULHWU ( rt ra rb -- ) 0 11 0 31 xo-insn ; +: MULHWU. ( rt ra rb -- ) 0 11 1 31 xo-insn ; +: DIVW ( rt ra rb -- ) 0 491 0 31 xo-insn ; +: DIVW. ( rt ra rb -- ) 0 491 1 31 xo-insn ; +: DIVWO ( rt ra rb -- ) 1 491 0 31 xo-insn ; +: DIVWO. ( rt ra rb -- ) 1 491 1 31 xo-insn ; +: DIVWU ( rt ra rb -- ) 0 459 0 31 xo-insn ; +: DIVWU. ( rt ra rb -- ) 0 459 1 31 xo-insn ; +: DIVWUO ( rt ra rb -- ) 1 459 0 31 xo-insn ; +: DIVWUO. ( rt ra rb -- ) 1 459 1 31 xo-insn ; +: DIVWE ( rt ra rb -- ) 0 427 0 31 xo-insn ; +: DIVWE. ( rt ra rb -- ) 0 427 1 31 xo-insn ; +: DIVWEO ( rt ra rb -- ) 1 427 0 31 xo-insn ; +: DIVWEO. ( rt ra rb -- ) 1 427 1 31 xo-insn ; +: DIVWEU ( rt ra rb -- ) 0 395 0 31 xo-insn ; +: DIVWEU. ( rt ra rb -- ) 0 395 1 31 xo-insn ; +: DIVWEUO ( rt ra rb -- ) 1 395 0 31 xo-insn ; +: DIVWEUO. ( rt ra rb -- ) 1 395 1 31 xo-insn ; + +! 3.3.8.1 64-bit Fixed-Point Arithmetic Instructions +: MULLD ( rt ra rb -- ) 0 233 0 31 xo-insn ; +: MULLD. ( rt ra rb -- ) 0 233 1 31 xo-insn ; +: MULLDO ( rt ra rb -- ) 1 233 0 31 xo-insn ; +: MULLDO. ( rt ra rb -- ) 1 233 1 31 xo-insn ; +: MULHD ( rt ra rb -- ) 0 73 0 31 xo-insn ; +: MULHD. ( rt ra rb -- ) 0 73 1 31 xo-insn ; +: MULHDU ( rt ra rb -- ) 0 9 0 31 xo-insn ; +: MULHDU. ( rt ra rb -- ) 0 9 1 31 xo-insn ; +: DIVD ( rt ra rb -- ) 0 489 0 31 xo-insn ; +: DIVD. ( rt ra rb -- ) 0 489 1 31 xo-insn ; +: DIVDO ( rt ra rb -- ) 1 489 0 31 xo-insn ; +: DIVDO. ( rt ra rb -- ) 1 489 1 31 xo-insn ; +: DIVDU ( rt ra rb -- ) 0 457 0 31 xo-insn ; +: DIVDU. ( rt ra rb -- ) 0 457 1 31 xo-insn ; +: DIVDUO ( rt ra rb -- ) 1 457 0 31 xo-insn ; +: DIVDUO. ( rt ra rb -- ) 1 457 1 31 xo-insn ; +: DIVDE ( rt ra rb -- ) 0 425 0 31 xo-insn ; +: DIVDE. ( rt ra rb -- ) 0 425 1 31 xo-insn ; +: DIVDEO ( rt ra rb -- ) 1 425 0 31 xo-insn ; +: DIVDEO. ( rt ra rb -- ) 1 425 1 31 xo-insn ; +: DIVDEU ( rt ra rb -- ) 0 393 0 31 xo-insn ; +: DIVDEU. ( rt ra rb -- ) 0 393 1 31 xo-insn ; +: DIVDEUO ( rt ra rb -- ) 1 393 0 31 xo-insn ; +: DIVDEUO. ( rt ra rb -- ) 1 393 1 31 xo-insn ; + +! 3.3.9 Fixed-Point Compare Instructions +: CMPI ( bf l ra si -- ) [ [ 2 shift ] dip bitor ] 2dip 11 d-insn ; +: CMPLI ( bf l ra ui -- ) [ [ 2 shift ] dip bitor ] 2dip 10 d-insn ; +: CMP ( bf l ra rb -- ) [ [ 2 shift ] dip bitor ] 2dip 0 0 31 x-insn ; +: CMPL ( bf l ra rb -- ) [ [ 2 shift ] dip bitor ] 2dip 32 0 31 x-insn ; + +! 3.3.10 Fixed-Point Trap Instructions +: TWI ( to ra si -- ) 3 d-insn ; +: TDI ( to ra si -- ) 2 d-insn ; +: TW ( to ra rb -- ) 4 0 31 x-insn ; +: TD ( to ra rb -- ) 68 0 31 x-insn ; + +! 3.3.11 Fixed-Point Select +: ISEL ( rt ra rb bc -- ) 15 0 31 a-insn ; + +! 3.3.12 Fixed-Point Logical Instructions +: ANDI. ( ra rs ui -- ) [ swap ] dip 28 d-insn ; +: ANDIS. ( ra rs ui -- ) [ swap ] dip 29 d-insn ; +: ORI ( ra rs ui -- ) [ swap ] dip 24 d-insn ; +: ORIS ( ra rs ui -- ) [ swap ] dip 25 d-insn ; +: XORI ( ra rs ui -- ) [ swap ] dip 26 d-insn ; +: XORIS ( ra rs ui -- ) [ swap ] dip 27 d-insn ; +: AND ( ra rs rb -- ) [ swap ] dip 28 0 31 x-insn ; +: AND. ( ra rs rb -- ) [ swap ] dip 28 1 31 x-insn ; +: OR ( ra rs rb -- ) [ swap ] dip 444 0 31 x-insn ; +: OR. ( ra rs rb -- ) [ swap ] dip 444 1 31 x-insn ; +: XOR ( ra rs rb -- ) [ swap ] dip 316 0 31 x-insn ; +: XOR. ( ra rs rb -- ) [ swap ] dip 316 1 31 x-insn ; +: NAND ( ra rs rb -- ) [ swap ] dip 476 0 31 x-insn ; +: NAND. ( ra rs rb -- ) [ swap ] dip 476 1 31 x-insn ; +: NOR ( ra rs rb -- ) [ swap ] dip 124 0 31 x-insn ; +: NOR. ( ra rs rb -- ) [ swap ] dip 124 1 31 x-insn ; +: ANDC ( ra rs rb -- ) [ swap ] dip 60 0 31 x-insn ; +: ANDC. ( ra rs rb -- ) [ swap ] dip 60 1 31 x-insn ; +: EQV ( ra rs rb -- ) [ swap ] dip 284 0 31 x-insn ; +: EQV. ( ra rs rb -- ) [ swap ] dip 284 1 31 x-insn ; +: ORC ( ra rs rb -- ) [ swap ] dip 412 0 31 x-insn ; +: ORC. ( ra rs rb -- ) [ swap ] dip 412 1 31 x-insn ; +: CMPB ( ra rs rb -- ) [ swap ] dip 508 0 31 x-insn ; +: EXTSB ( ra rs -- ) swap 0 954 0 31 x-insn ; +: EXTSB. ( ra rs -- ) swap 0 954 1 31 x-insn ; +: EXTSH ( ra rs -- ) swap 0 922 0 31 x-insn ; +: EXTSH. ( ra rs -- ) swap 0 922 1 31 x-insn ; +: CNTLZW ( ra rs -- ) swap 0 26 0 31 x-insn ; +: CNTLZW. ( ra rs -- ) swap 0 26 1 31 x-insn ; +: POPCNTB ( ra rs -- ) swap 0 122 0 31 x-insn ; +: POPCNTW ( ra rs -- ) swap 0 378 0 31 x-insn ; +: PRTYD ( ra rs -- ) swap 0 186 0 31 x-insn ; +: PRTYW ( ra rs -- ) swap 0 154 0 31 x-insn ; + +! 3.3.12.1 64-bit Fixed-Point Logical Instructions +: EXTSW ( ra rs -- ) swap 0 986 0 31 x-insn ; +: EXTSW. ( ra rs -- ) swap 0 986 1 31 x-insn ; +: CNTLZD ( ra rs -- ) swap 0 58 0 31 x-insn ; +: CNTLZD. ( ra rs -- ) swap 0 58 1 31 x-insn ; +: POPCNTD ( ra rs -- ) swap 0 506 0 31 x-insn ; +: BPERMD ( ra rs rb -- ) [ swap ] dip 252 0 31 x-insn ; + +! 3.3.13.1 Fixed-Point Rotate and Shift Instructions +: RLWINM ( ra rs sh mb me -- ) [ swap ] 3dip 0 21 m-insn ; +: RLWINM. ( ra rs sh mb me -- ) [ swap ] 3dip 1 21 m-insn ; +: RLWNM ( ra rs rb mb me -- ) [ swap ] 3dip 0 23 m-insn ; +: RLWNM. ( ra rs rb mb me -- ) [ swap ] 3dip 1 23 m-insn ; +: RLWIMI ( ra rs sh mb me -- ) [ swap ] 3dip 0 20 m-insn ; +: RLWIMI. ( ra rs sh mb me -- ) [ swap ] 3dip 1 20 m-insn ; + +! 3.3.13.1 64-bit Fixed-Point Rotate Instructions +: RLDICL ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 0 swap 0 30 md-insn ; +: RLDICL. ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 0 swap 1 30 md-insn ; +: RLDICR ( ra rs sh me -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 1 swap 0 30 md-insn ; +: RLDICR. ( ra rs sh me -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 1 swap 1 30 md-insn ; +: RLDIC ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 2 swap 0 30 md-insn ; +: RLDIC. ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 2 swap 1 30 md-insn ; +: RLDCL ( ra rs rb mb -- ) [ swap ] 2dip 8 0 30 mds-insn ; +: RLDCL. ( ra rs rb mb -- ) [ swap ] 2dip 8 1 30 mds-insn ; +: RLDCR ( ra rs rb me -- ) [ swap ] 2dip 9 0 30 mds-insn ; +: RLDCR. ( ra rs rb me -- ) [ swap ] 2dip 9 1 30 mds-insn ; +: RLDIMI ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 3 swap 0 30 md-insn ; +: RLDIMI. ( ra rs sh mb -- ) + [ swap ] 2dip over [ HEX: 1f bitand ] [ ] [ -5 shift ] + tri* 3 swap 1 30 md-insn ; + +! 3.3.13.2 Fixed-Point Shift Instructions +: SLW ( ra rs rb -- ) [ swap ] dip 24 0 31 x-insn ; +: SLW. ( ra rs rb -- ) [ swap ] dip 24 1 31 x-insn ; +: SRW ( ra rs rb -- ) [ swap ] dip 536 0 31 x-insn ; +: SRW. ( ra rs rb -- ) [ swap ] dip 536 1 31 x-insn ; +: SRAWI ( ra rs sh -- ) [ swap ] dip 824 0 31 x-insn ; +: SRAWI. ( ra rs sh -- ) [ swap ] dip 824 1 31 x-insn ; +: SRAW ( ra rs rb -- ) [ swap ] dip 792 0 31 x-insn ; +: SRAW. ( ra rs rb -- ) [ swap ] dip 792 1 31 x-insn ; + +! 3.3.13.2.1 64-bit Fixed-Point Shift Instructions +: SLD ( ra rs rb -- ) [ swap ] dip 27 0 31 x-insn ; +: SLD. ( ra rs rb -- ) [ swap ] dip 27 1 31 x-insn ; +: SRD ( ra rs rb -- ) [ swap ] dip 539 0 31 x-insn ; +: SRD. ( ra rs rb -- ) [ swap ] dip 539 1 31 x-insn ; +: SRAD ( ra rs rb -- ) [ swap ] dip 794 0 31 x-insn ; +: SRAD. ( ra rs rb -- ) [ swap ] dip 794 1 31 x-insn ; +: SRADI ( ra rs sh -- ) + [ swap ] dip [ HEX: 1f bitand ] [ -5 shift ] bi + 413 swap 0 31 xs-insn ; +: SRADI. ( ra rs sh -- ) + [ swap ] dip [ HEX: 1f bitand ] [ -5 shift ] bi + 413 swap 1 31 xs-insn ; + +! 3.3.14 BCD Assist Instructions +: CDTBCD ( ra rs -- ) swap 0 282 0 31 x-insn ; +: CBCDTD ( ra rs -- ) swap 0 314 0 31 x-insn ; +: ADDG6S ( rt ra rb -- ) 0 74 0 31 xo-insn ; + +! 3.3.15 Move To/From System Register Instructions +: MTSPR ( spr rs -- ) swap 467 0 31 xfx-insn ; +: MFSPR ( rt spr -- ) 339 0 31 xfx-insn ; +: MTCRF ( fxm rs -- ) swap HEX: ff bitand 1 shift 144 0 31 xfx-insn ; +: MFCR ( rt -- ) 0 19 0 31 xfx-insn ; + +! 3.3.15.1 Move To/From One Condition Register Field Instructions +: MTOCRF ( fxm rs -- ) swap HEX: 100 bitor 1 shift 144 0 31 xfx-insn ; +: MFOCRF ( rt fxm -- ) HEX: 100 bitor 1 shift 19 0 31 xfx-insn ; + +! 3.3.15.2 Move To/From System Registers (Category: Embedded) +: MCRXR ( bf -- ) 2 shift 0 0 512 0 31 x-insn ; +: MTDCRUX ( rs ra -- ) 0 419 0 31 x-insn ; +: MFDCRUX ( rt ra -- ) 0 291 0 31 x-insn ; + +! 4.6.2 Floating-Point Load Instructions +: LFS ( frt ra d -- ) 48 d-insn ; +: LFSU ( frt ra d -- ) 49 d-insn ; +: LFD ( frt ra d -- ) 50 d-insn ; +: LFDU ( frt ra d -- ) 51 d-insn ; +: LFSX ( frt ra rb -- ) 535 0 31 x-insn ; +: LFSUX ( frt ra rb -- ) 567 0 31 x-insn ; +: LFDX ( frt ra rb -- ) 599 0 31 x-insn ; +: LFDUX ( frt ra rb -- ) 631 0 31 x-insn ; +: LFIWAX ( frt ra rb -- ) 855 0 31 x-insn ; +: LFIWZX ( frt ra rb -- ) 887 0 31 x-insn ; + +! 4.6.3 Floating-Point Store Instructions +: STFS ( frs ra d -- ) 52 d-insn ; +: STFSU ( frs ra d -- ) 53 d-insn ; +: STFD ( frs ra d -- ) 54 d-insn ; +: STFDU ( frs ra d -- ) 55 d-insn ; +: STFSX ( frs ra rb -- ) 663 0 31 x-insn ; +: STFSUX ( frs ra rb -- ) 695 0 31 x-insn ; +: STFDX ( frs ra rb -- ) 727 0 31 x-insn ; +: STFDUX ( frs ra rb -- ) 759 0 31 x-insn ; +: STFIWX ( frs ra rb -- ) 983 0 31 x-insn ; + +! 4.6.4 Floating-Point Load Store Doubleword Pair Instructions +: LFDP ( frtp ra ds -- ) 0 57 ds-insn ; deprecated +: STFDP ( frsp ra ds -- ) 0 61 ds-insn ; deprecated +: LFDPX ( frtp ra rb -- ) 791 0 31 x-insn ; deprecated +: STFDPX ( frsp ra rb -- ) 919 0 31 x-insn ; deprecated + +! 4.6.5 Floating-Point Move Instructions +: FMR ( frt frb -- ) [ 0 ] dip 72 0 63 x-insn ; +: FMR. ( frt frb -- ) [ 0 ] dip 72 1 63 x-insn ; +: FABS ( frt frb -- ) [ 0 ] dip 264 0 63 x-insn ; +: FABS. ( frt frb -- ) [ 0 ] dip 264 1 63 x-insn ; +: FNABS ( frt frb -- ) [ 0 ] dip 136 0 63 x-insn ; +: FNABS. ( frt frb -- ) [ 0 ] dip 136 1 63 x-insn ; +: FNEG ( frt frb -- ) [ 0 ] dip 40 0 63 x-insn ; +: FNEG. ( frt frb -- ) [ 0 ] dip 40 1 63 x-insn ; +: FCPSGN ( frt fra frb -- ) 8 0 63 x-insn ; +: FCPSGN. ( frt fra frb -- ) 8 1 63 x-insn ; + +! 4.6.6.1 Floating-Point Elementary Arithmetic Instructions +: FADD ( frt fra frb -- ) 0 21 0 63 a-insn ; +: FADD. ( frt fra frb -- ) 0 21 1 63 a-insn ; +: FADDS ( frt fra frb -- ) 0 21 0 59 a-insn ; +: FADDS. ( frt fra frb -- ) 0 21 1 59 a-insn ; +: FSUB ( frt fra frb -- ) 0 20 0 63 a-insn ; +: FSUB. ( frt fra frb -- ) 0 20 1 63 a-insn ; +: FSUBS ( frt fra frb -- ) 0 20 0 59 a-insn ; +: FSUBS. ( frt fra frb -- ) 0 20 1 59 a-insn ; +: FMUL ( frt fra frc -- ) 0 swap 25 0 63 a-insn ; +: FMUL. ( frt fra frc -- ) 0 swap 25 1 63 a-insn ; +: FMULS ( frt fra frb -- ) 0 25 0 59 a-insn ; +: FMULS. ( frt fra frb -- ) 0 25 1 59 a-insn ; +: FDIV ( frt fra frb -- ) 0 18 0 63 a-insn ; +: FDIV. ( frt fra frb -- ) 0 18 1 63 a-insn ; +: FDIVS ( frt fra frb -- ) 0 18 0 59 a-insn ; +: FDIVS. ( frt fra frb -- ) 0 18 1 59 a-insn ; +: FSQRT ( frt frb -- ) [ 0 ] dip 0 22 0 63 a-insn ; +: FSQRT. ( frt frb -- ) [ 0 ] dip 0 22 1 63 a-insn ; +: FSQRTS ( frt frb -- ) [ 0 ] dip 0 22 0 59 a-insn ; +: FSQRTS. ( frt frb -- ) [ 0 ] dip 0 22 1 59 a-insn ; +: FRE ( frt frb -- ) [ 0 ] dip 0 24 0 63 a-insn ; +: FRE. ( frt frb -- ) [ 0 ] dip 0 24 1 63 a-insn ; +: FRES ( frt frb -- ) [ 0 ] dip 0 24 0 59 a-insn ; +: FRES. ( frt frb -- ) [ 0 ] dip 0 24 1 59 a-insn ; +: FRSQRTE ( frt frb -- ) [ 0 ] dip 0 26 0 63 a-insn ; +: FRSQRTE. ( frt frb -- ) [ 0 ] dip 0 26 1 63 a-insn ; +: FRSQRTES ( frt frb -- ) [ 0 ] dip 0 26 0 59 a-insn ; +: FRSQRTES. ( frt frb -- ) [ 0 ] dip 0 26 1 59 a-insn ; +: FTDIV ( bf fra frb -- ) [ 2 shift ] 2dip 128 0 63 x-insn ; +: FTSQRT ( bf frb -- ) [ 2 shift 0 ] dip 160 0 63 x-insn ; + +! 4.6.6.2 Floating-Point Multiply-Add Instructions +: FMADD ( frt fra frc frb -- ) swap 29 0 63 a-insn ; +: FMADD. ( frt fra frc frb -- ) swap 29 1 63 a-insn ; +: FMADDS ( frt fra frc frb -- ) swap 29 0 59 a-insn ; +: FMADDS. ( frt fra frc frb -- ) swap 29 1 59 a-insn ; +: FMSUB ( frt fra frc frb -- ) swap 28 0 63 a-insn ; +: FMSUB. ( frt fra frc frb -- ) swap 28 1 63 a-insn ; +: FMSUBS ( frt fra frc frb -- ) swap 28 0 59 a-insn ; +: FMSUBS. ( frt fra frc frb -- ) swap 28 1 59 a-insn ; +: FNMADD ( frt fra frc frb -- ) swap 31 0 63 a-insn ; +: FNMADD. ( frt fra frc frb -- ) swap 31 1 63 a-insn ; +: FNMADDS ( frt fra frc frb -- ) swap 31 0 59 a-insn ; +: FNMADDS. ( frt fra frc frb -- ) swap 31 1 59 a-insn ; +: FNMSUB ( frt fra frc frb -- ) swap 30 0 63 a-insn ; +: FNMSUB. ( frt fra frc frb -- ) swap 30 1 63 a-insn ; +: FNMSUBS ( frt fra frc frb -- ) swap 30 0 59 a-insn ; +: FNMSUBS. ( frt fra frc frb -- ) swap 30 1 59 a-insn ; + +! 4.6.7.1 Floating-Point Rounding Instruction +: FRSP ( frt frb -- ) [ 0 ] dip 12 0 63 x-insn ; +: FRSP. ( frt frb -- ) [ 0 ] dip 12 1 63 x-insn ; + +! 4.6.7.2 Floating-Point Convert To/From Integer Instructions +: FCTID ( frt frb -- ) [ 0 ] dip 814 0 63 x-insn ; +: FCTID. ( frt frb -- ) [ 0 ] dip 814 1 63 x-insn ; +: FCTIDZ ( frt frb -- ) [ 0 ] dip 815 0 63 x-insn ; +: FCTIDZ. ( frt frb -- ) [ 0 ] dip 815 1 63 x-insn ; +: FCTIDU ( frt frb -- ) [ 0 ] dip 942 0 63 x-insn ; +: FCTIDU. ( frt frb -- ) [ 0 ] dip 942 1 63 x-insn ; +: FCTIDUZ ( frt frb -- ) [ 0 ] dip 943 0 63 x-insn ; +: FCTIDUZ. ( frt frb -- ) [ 0 ] dip 943 1 63 x-insn ; +: FCTIW ( frt frb -- ) [ 0 ] dip 14 0 63 x-insn ; +: FCTIW. ( frt frb -- ) [ 0 ] dip 14 1 63 x-insn ; +: FCTIWZ ( frt frb -- ) [ 0 ] dip 15 0 63 x-insn ; +: FCTIWZ. ( frt frb -- ) [ 0 ] dip 15 1 63 x-insn ; +: FCTIWU ( frt frb -- ) [ 0 ] dip 142 0 63 x-insn ; +: FCTIWU. ( frt frb -- ) [ 0 ] dip 142 1 63 x-insn ; +: FCTIWUZ ( frt frb -- ) [ 0 ] dip 143 0 63 x-insn ; +: FCTIWUZ. ( frt frb -- ) [ 0 ] dip 143 1 63 x-insn ; +: FCFID ( frt frb -- ) [ 0 ] dip 846 0 63 x-insn ; +: FCFID. ( frt frb -- ) [ 0 ] dip 846 1 63 x-insn ; +: FCFIDU ( frt frb -- ) [ 0 ] dip 974 0 63 x-insn ; +: FCFIDU. ( frt frb -- ) [ 0 ] dip 974 1 63 x-insn ; +: FCFIDS ( frt frb -- ) [ 0 ] dip 846 0 59 x-insn ; +: FCFIDS. ( frt frb -- ) [ 0 ] dip 846 1 59 x-insn ; +: FCFIDUS ( frt frb -- ) [ 0 ] dip 974 0 59 x-insn ; +: FCFIDUS. ( frt frb -- ) [ 0 ] dip 974 1 59 x-insn ; + +! 4.6.7.3 Floating Round to Integer Instructions +: FRIN ( frt frb -- ) [ 0 ] dip 392 0 63 x-insn ; +: FRIN. ( frt frb -- ) [ 0 ] dip 392 1 63 x-insn ; +: FRIZ ( frt frb -- ) [ 0 ] dip 424 0 63 x-insn ; +: FRIZ. ( frt frb -- ) [ 0 ] dip 424 1 63 x-insn ; +: FRIP ( frt frb -- ) [ 0 ] dip 456 0 63 x-insn ; +: FRIP. ( frt frb -- ) [ 0 ] dip 456 1 63 x-insn ; +: FRIM ( frt frb -- ) [ 0 ] dip 488 0 63 x-insn ; +: FRIM. ( frt frb -- ) [ 0 ] dip 488 1 63 x-insn ; + +! 4.6.8 Floating-Point Compare Instructions +: FCMPU ( bf fra frb -- ) [ 2 shift ] 2dip 0 0 63 x-insn ; +: FCMPO ( bf fra frb -- ) [ 2 shift ] 2dip 32 0 63 x-insn ; + +! 4.6.9 Floating-Point Select Instruction +: FSEL ( frt fra frc frb -- ) swap 23 0 63 a-insn ; +: FSEL. ( frt fra frc frb -- ) swap 23 1 63 a-insn ; + +! 4.6.10 Floating-Point Status and Control Register Instructions +: MFFS ( frt -- ) 0 0 583 0 63 x-insn ; +: MFFS. ( frt -- ) 0 0 583 1 63 x-insn ; +: MCRFS ( bf bfa -- ) [ 2 shift ] bi@ 0 64 0 63 x-insn ; +: MTFSFI ( bf u w -- ) swap [ 2 shift ] [ 1 bitand ] [ 1 shift ] +tri* 134 0 63 x-insn ; +: MTFSFI. ( bf u w -- ) swap [ 2 shift ] [ 1 bitand ] [ 1 shift ] +tri* 134 1 63 x-insn ; +:: MTFSF ( flm frb l w -- ) l flm w frb 711 0 63 xfl-insn ; +:: MTFSF. ( flm frb l w -- ) l flm w frb 711 1 63 xfl-insn ; +: MTFSB0 ( bt -- ) 0 0 70 0 63 x-insn ; +: MTFSB0. ( bt -- ) 0 0 70 1 63 x-insn ; +: MTFSB1 ( bt -- ) 0 0 38 0 63 x-insn ; +: MTFSB1. ( bt -- ) 0 0 38 1 63 x-insn ; + +! 5.6.1 DFP Arithmetic Instructions +: DADD ( frt fra frb -- ) 2 0 59 x-insn ; +: DADD. ( frt fra frb -- ) 2 1 59 x-insn ; +: DADDQ ( frtp frap frbp -- ) 2 0 63 x-insn ; +: DADDQ. ( frtp frap frbp -- ) 2 1 63 x-insn ; +: DSUB ( frt fra frb -- ) 514 0 59 x-insn ; +: DSUB. ( frt fra frb -- ) 514 1 59 x-insn ; +: DSUBQ ( frtp frap frbp -- ) 514 0 63 x-insn ; +: DSUBQ. ( frtp frap frbp -- ) 514 1 63 x-insn ; +: DMUL ( frp fra frb -- ) 34 0 59 x-insn ; +: DMUL. ( frt fra frb -- ) 34 1 59 x-insn ; +: DMULQ ( frtp frap frbp -- ) 34 0 63 x-insn ; +: DMULQ. ( frtp frap frbp -- ) 34 1 63 x-insn ; +: DDIV ( frp fra frb -- ) 546 0 59 x-insn ; +: DDIV. ( frt fra frb -- ) 546 1 59 x-insn ; +: DDIVQ ( frtp frap frbp -- ) 546 0 63 x-insn ; +: DDIVQ. ( frtp frap frbp -- ) 546 1 63 x-insn ; + +! 5.6.2 DFP Compare Instructions +: DCMPU ( bf fra frb -- ) [ 2 shift ] 2dip 642 0 59 x-insn ; +: DCMPUQ ( bf frap frbp -- ) [ 2 shift ] 2dip 642 0 63 x-insn ; +: DCMPO ( bf fra frb -- ) [ 2 shift ] 2dip 130 0 59 x-insn ; +: DCMPOQ ( bf frap frbp -- ) [ 2 shift ] 2dip 130 0 63 x-insn ; + +! 5.6.3 DFP Test Instructions +: DTSTDC ( bf fra dcm -- ) [ 2 shift ] 2dip 194 0 59 z22-insn ; +: DTSTDCQ ( bf frap dgm -- ) [ 2 shift ] 2dip 194 0 63 z22-insn ; +: DTSTDG ( bf fra dcm -- ) [ 2 shift ] 2dip 226 0 59 z22-insn ; +: DTSTDGQ ( bf frap dgm -- ) [ 2 shift ] 2dip 226 0 63 z22-insn ; +: DTSTEX ( bf fra frb -- ) [ 2 shift ] 2dip 162 0 59 x-insn ; +: DTSTEXQ ( bf frap frbp -- ) [ 2 shift ] 2dip 162 0 63 x-insn ; +: DTSTSF ( bf fra frb -- ) [ 2 shift ] 2dip 674 0 59 x-insn ; +: DTSTSFQ ( bf frap frbp -- ) [ 2 shift ] 2dip 674 0 63 x-insn ; + +! 5.6.4 DFP Quantum Adjustment Instructions +: DQUAI ( te frt frb rmc -- ) [ swap ] 2dip 67 0 59 z23-insn ; +: DQUAI. ( te frt frb rmc -- ) [ swap ] 2dip 67 1 59 z23-insn ; +: DQUAIQ ( te frtp frbp rmc -- ) [ swap ] 2dip 67 0 63 z23-insn ; +: DQUAIQ. ( te frtp frbp rmc -- ) [ swap ] 2dip 67 1 63 z23-insn ; +: DQUA ( frt fra frb rmc -- ) 3 0 59 z23-insn ; +: DQUA. ( frt fra frb rmc -- ) 3 1 59 z23-insn ; +: DQUAQ ( frtp frap frbp rmc -- ) 3 0 63 z23-insn ; +: DQUAQ. ( frtp frap frbp rmc -- ) 3 1 63 z23-insn ; +: DRRND ( frt fra frb rmc -- ) 35 0 59 z23-insn ; +: DRRND. ( frt fra frb rmc -- ) 35 1 59 z23-insn ; +: DRRNDQ ( frtp frap frbp rmc -- ) 35 0 63 z23-insn ; +: DRRNDQ. ( frtp frap frbp rmc -- ) 35 1 63 z23-insn ; +: DRINTX ( r frt frb rmc -- ) [ swap ] 2dip 99 0 59 z23-insn ; +: DRINTX. ( r frt frb rmc -- ) [ swap ] 2dip 99 1 59 z23-insn ; +: DRINTXQ ( r frtp frbp rmc -- ) [ swap ] 2dip 99 0 63 z23-insn ; +: DRINTXQ. ( r frtp frbp rmc -- ) [ swap ] 2dip 99 1 63 z23-insn ; +: DRINTN ( r frt frb rmc -- ) [ swap ] 2dip 227 0 59 z23-insn ; +: DRINTN. ( r frt frb rmc -- ) [ swap ] 2dip 227 1 59 z23-insn ; +: DRINTNQ ( r frtp frbp rmc -- ) [ swap ] 2dip 227 0 63 z23-insn ; +: DRINTNQ. ( r frtp frbp rmc -- ) [ swap ] 2dip 227 1 63 z23-insn ; + +! 5.6.5.1 DFP Data-Format Conversion Instructions +: DCTDP ( frt frb -- ) 0 swap 258 0 59 x-insn ; +: DCTDP. ( frt frb -- ) 0 swap 258 1 59 x-insn ; +: DCTQPQ ( frtp frbp -- ) 0 swap 258 0 63 x-insn ; +: DCTQPQ. ( frtp frbp -- ) 0 swap 258 1 63 x-insn ; +: DSRP ( frt frb -- ) 0 swap 770 0 59 x-insn ; +: DSRP. ( frt frb -- ) 0 swap 770 1 59 x-insn ; +: DRDPQ ( frtp frbp -- ) 0 swap 770 0 63 x-insn ; +: DRDPQ. ( frtp frbp -- ) 0 swap 770 1 63 x-insn ; + +! 5.6.5.2 DFP Data-Type Conversion Instructions +: DCFFIX ( frt frb -- ) 0 swap 802 0 59 x-insn ; +: DCFFIX. ( frt frb -- ) 0 swap 802 1 59 x-insn ; +: DCFFIXQ ( frtp frbp -- ) 0 swap 802 0 63 x-insn ; +: DCFFIXQ. ( frtp frbp -- ) 0 swap 802 1 63 x-insn ; +: DCTFIX ( frt frb -- ) 0 swap 290 0 59 x-insn ; +: DCTFIX. ( frt frb -- ) 0 swap 290 1 59 x-insn ; +: DCTFIXQ ( frtp frbp -- ) 0 swap 290 0 63 x-insn ; +: DCTFIXQ. ( frtp frbp -- ) 0 swap 290 1 63 x-insn ; + +! 5.6.6 DFP Format Instructions +: DDEDPD ( sp frt frb -- ) [ swap 3 shift ] dip 322 0 59 x-insn ; +: DDEDPD. ( sp frt frb -- ) [ swap 3 shift ] dip 322 1 59 x-insn ; +: DDEDPDQ ( sp frtp frbp -- ) [ swap 3 shift ] dip 322 0 63 x-insn ; +: DDEDPDQ. ( sp frtp frbp -- ) [ swap 3 shift ] dip 322 1 63 x-insn ; +: DENBCD ( s frt frb -- ) [ swap 4 shift ] dip 834 0 59 x-insn ; +: DENBCD. ( s frt frb -- ) [ swap 4 shift ] dip 834 1 59 x-insn ; +: DENBCDQ ( s frtp frbp -- ) [ swap 4 shift ] dip 834 0 63 x-insn ; +: DENBCDQ. ( s frtp frbp -- ) [ swap 4 shift ] dip 834 1 63 x-insn ; +: DXEX ( frt frb -- ) 0 swap 354 0 59 x-insn ; +: DXEX. ( frt frb -- ) 0 swap 354 1 59 x-insn ; +: DXEXQ ( frtp frbp -- ) 0 swap 354 0 63 x-insn ; +: DXEXQ. ( frtp frbp -- ) 0 swap 354 1 63 x-insn ; +: DIEX ( frt fra frb -- ) 866 0 59 x-insn ; +: DIEX. ( frt fra frb -- ) 866 1 59 x-insn ; +: DIEXQ ( frtp frap frbp -- ) 866 0 63 x-insn ; +: DIEXQ. ( frtp frap frbp -- ) 866 1 63 x-insn ; +: DSCLI ( frt fra sh -- ) 66 0 59 z22-insn ; +: DSCLI. ( frt fra sh -- ) 66 1 59 z22-insn ; +: DSCLIQ ( frtp frap sh -- ) 66 0 63 z22-insn ; +: DSCLIQ. ( frtp frap sh -- ) 66 1 63 z22-insn ; +: DSCRI ( frt fra sh -- ) 98 0 59 z22-insn ; +: DSCRI. ( frt fra sh -- ) 98 1 59 z22-insn ; +: DSCRIQ ( frtp frap sh -- ) 98 0 63 z22-insn ; +: DSCRIQ. ( frtp frap sh -- ) 98 1 63 z22-insn ; + +! 6.7.2 Vector Load Instructions +: LVEBX ( vrt ra rb -- ) 7 0 31 x-insn ; +: LVEHX ( vrt ra rb -- ) 39 0 31 x-insn ; +: LVEWX ( vrt ra rb -- ) 71 0 31 x-insn ; +: LVX ( vrt ra rb -- ) 103 0 31 x-insn ; +: LVXL ( vrt ra rb -- ) 359 0 31 x-insn ; + +! 6.7.3 Vector Store Instructions +: STVEBX ( vrs ra rb -- ) 135 0 31 x-insn ; +: STVEHX ( vrs ra rb -- ) 167 0 31 x-insn ; +: STVEWX ( vrs ra rb -- ) 199 0 31 x-insn ; +: STVX ( vrs ra rb -- ) 231 0 31 x-insn ; +: STVXL ( vrs ra rb -- ) 487 0 31 x-insn ; + +! 6.7.4 Vector Alignment Support Instructions +: LVSL ( vrt ra rb -- ) 6 0 31 x-insn ; +: LVSR ( vrt ra rb -- ) 38 0 31 x-insn ; + +! 6.8.1 Vector Pack and Unpack Instructions +: VPKUHUM ( vrt vra vrb -- ) 14 4 vx-insn ; +: VPKUWUM ( vrt vra vrb -- ) 78 4 vx-insn ; +: VPKUHUS ( vrt vra vrb -- ) 142 4 vx-insn ; +: VPKUWUS ( vrt vra vrb -- ) 206 4 vx-insn ; +: VPKSHUS ( vrt vra vrb -- ) 270 4 vx-insn ; +: VPKSWUS ( vrt vra vrb -- ) 334 4 vx-insn ; +: VPKSHSS ( vrt vra vrb -- ) 398 4 vx-insn ; +: VPKSWSS ( vrt vra vrb -- ) 462 4 vx-insn ; +: VPKPX ( vrt vra vrb -- ) 782 4 vx-insn ; +: VUPKHSB ( vrt vrb -- ) 0 swap 526 4 vx-insn ; +: VUPKHSH ( vrt vrb -- ) 0 swap 590 4 vx-insn ; +: VUPKLSB ( vrt vrb -- ) 0 swap 654 4 vx-insn ; +: VUPKLSH ( vrt vrb -- ) 0 swap 718 4 vx-insn ; +: VUPKHPX ( vrt vrb -- ) 0 swap 846 4 vx-insn ; +: VUPKLPX ( vrt vrb -- ) 0 swap 974 4 vx-insn ; + +! 6.8.2 Vector Merge Instructions +: VMRGHB ( vrt vra vrb -- ) 12 4 vx-insn ; +: VMRGHH ( vrt vra vrb -- ) 76 4 vx-insn ; +: VMRGHW ( vrt vra vrb -- ) 140 4 vx-insn ; +: VMRGLB ( vrt vra vrb -- ) 268 4 vx-insn ; +: VMRGLH ( vrt vra vrb -- ) 332 4 vx-insn ; +: VMRGLW ( vrt vra vrb -- ) 396 4 vx-insn ; + +! 6.8.3 Vector Splat Instructions +: VSPLTB ( vrt vrb uim -- ) swap 524 4 vx-insn ; +: VSPLTH ( vrt vrb uim -- ) swap 588 4 vx-insn ; +: VSPLTW ( vrt vrb uim -- ) swap 652 4 vx-insn ; +: VSPLTISB ( vrt sim -- ) 0 780 4 vx-insn ; +: VSPLTISH ( vrt sim -- ) 0 844 4 vx-insn ; +: VSPLTISW ( vrt sim -- ) 0 908 4 vx-insn ; + +! 6.8.4 Vector Permute Instruction +: VPERM ( vrt vra vrb vrc -- ) 43 4 va-insn ; + +! 6.8.5 Vector Select Instruction +: VSEL ( vrt vra vrb vrc -- ) 42 4 va-insn ; + +! 6.8.6 Vector Shift Instructions +: VSL ( vrt vra vrb -- ) 452 4 vx-insn ; +: VSR ( vrt vra vrb -- ) 708 4 vx-insn ; +: VSLO ( vrt vra vrb -- ) 1036 4 vx-insn ; +: VSRO ( vrt vra vrb -- ) 1100 4 vx-insn ; +: VSLDOI ( vrt vra vrb shb -- ) 44 4 va-insn ; + +! 6.9.1.1 Vector Integer Add Instructions +: VADDCUW ( vrt vra vrb -- ) 384 4 vx-insn ; +: VADDSHS ( vrt vra vrb -- ) 832 4 vx-insn ; +: VADDSBS ( vrt vra vrb -- ) 768 4 vx-insn ; +: VADDSWS ( vrt vra vrb -- ) 896 4 vx-insn ; +: VADDUBM ( vrt vra vrb -- ) 0 4 vx-insn ; +: VADDUHM ( vrt vra vrb -- ) 64 4 vx-insn ; +: VADDUWM ( vrt vra vrb -- ) 128 4 vx-insn ; +: VADDUBS ( vrt vra vrb -- ) 512 4 vx-insn ; +: VADDUHS ( vrt vra vrb -- ) 576 4 vx-insn ; +: VADDUWS ( vrt vra vrb -- ) 640 4 vx-insn ; + +! 6.9.1.2 Vector Integer Subtract Instructions +: VSUBCUW ( vrt vra vrb -- ) 1408 4 vx-insn ; +: VSUBSBS ( vrt vra vrb -- ) 1792 4 vx-insn ; +: VSUBSHS ( vrt vra vrb -- ) 1856 4 vx-insn ; +: VSUBSWS ( vrt vra vrb -- ) 1920 4 vx-insn ; +: VSUBUBM ( vrt vra vrb -- ) 1024 4 vx-insn ; +: VSUBUHM ( vrt vra vrb -- ) 1088 4 vx-insn ; +: VSUBUWM ( vrt vra vrb -- ) 1152 4 vx-insn ; +: VSUBUBS ( vrt vra vrb -- ) 1536 4 vx-insn ; +: VSUBUHS ( vrt vra vrb -- ) 1600 4 vx-insn ; +: VSUBUWS ( vrt vra vrb -- ) 1664 4 vx-insn ; + +! 6.9.1.3 Vector Integer Multiply Instructions +: VMULESB ( vrt vra vrb -- ) 776 4 vx-insn ; +: VMULESH ( vrt vra vrb -- ) 840 4 vx-insn ; +: VMULEUB ( vrt vra vrb -- ) 520 4 vx-insn ; +: VMULEUH ( vrt vra vrb -- ) 584 4 vx-insn ; +: VMULOSB ( vrt vra vrb -- ) 264 4 vx-insn ; +: VMULOSH ( vrt vra vrb -- ) 328 4 vx-insn ; +: VMULOUB ( vrt vra vrb -- ) 8 4 vx-insn ; +: VMULOUH ( vrt vra vrb -- ) 72 4 vx-insn ; + +! 6.9.1.4 Vector Integer Multiply-Add/Sum Instructions +: VMHADDSHS ( vrt vra vrb vrc -- ) 32 4 va-insn ; +: VMHRADDSHS ( vrt vra vrb vrc -- ) 33 4 va-insn ; +: VMLADDUHM ( vrt vra vrb vrc -- ) 34 4 va-insn ; +: VMSUMUBM ( vrt vra vrb vrc -- ) 36 4 va-insn ; +: VMSUMMBM ( vrt vra vrb vrc -- ) 37 4 va-insn ; +: VMSUMSHM ( vrt vra vrb vrc -- ) 40 4 va-insn ; +: VMSUMSHS ( vrt vra vrb vrc -- ) 41 4 va-insn ; +: VMSUMUHM ( vrt vra vrb vrc -- ) 38 4 va-insn ; +: VMSUMUHS ( vrt vra vrb vrc -- ) 39 4 va-insn ; + +! 6.9.1.5 Vector Integer Sum-Across Intructions +: VSUMSWS ( vrt vra vrb -- ) 1928 4 vx-insn ; +: VSUM2SWS ( vrt vra vrb -- ) 1672 4 vx-insn ; +: VSUM4SBS ( vrt vra vrb -- ) 1800 4 vx-insn ; +: VSUM4UBS ( vrt vra vrb -- ) 1544 4 vx-insn ; +: VSUM4SHS ( vrt vra vrb -- ) 1608 4 vx-insn ; + +! 6.9.1.6 Vector Integer Average Instructions +: VAVGSB ( vrt vra vrb -- ) 1282 4 vx-insn ; +: VAVGSH ( vrt vra vrb -- ) 1346 4 vx-insn ; +: VAVGSW ( vrt vra vrb -- ) 1410 4 vx-insn ; +: VAVGUB ( vrt vra vrb -- ) 1026 4 vx-insn ; +: VAVGUH ( vrt vra vrb -- ) 1090 4 vx-insn ; +: VAVGUW ( vrt vra vrb -- ) 1154 4 vx-insn ; + +! 6.9.1.7 Vector Integer Maximum and Minimum Instructions +: VMAXSB ( vrt vra vrb -- ) 258 4 vx-insn ; +: VMAXSH ( vrt vra vrb -- ) 322 4 vx-insn ; +: VMAXSW ( vrt vra vrb -- ) 386 4 vx-insn ; +: VMAXUB ( vrt vra vrb -- ) 2 4 vx-insn ; +: VMAXUH ( vrt vra vrb -- ) 66 4 vx-insn ; +: VMAXUW ( vrt vra vrb -- ) 130 4 vx-insn ; +: VMINSB ( vrt vra vrb -- ) 770 4 vx-insn ; +: VMINSH ( vrt vra vrb -- ) 834 4 vx-insn ; +: VMINSW ( vrt vra vrb -- ) 898 4 vx-insn ; +: VMINUB ( vrt vra vrb -- ) 514 4 vx-insn ; +: VMINUH ( vrt vra vrb -- ) 578 4 vx-insn ; +: VMINUW ( vrt vra vrb -- ) 642 4 vx-insn ; + +! 6.9.2 Vector Integer Compare Instructions +: VCMPEQUB ( vrt vra vrb -- ) 0 6 4 vc-insn ; +: VCMPEQUB. ( vrt vra vrb -- ) 1 6 4 vc-insn ; +: VCMPEQUH ( vrt vra vrb -- ) 0 70 4 vc-insn ; +: VCMPEQUH. ( vrt vra vrb -- ) 1 70 4 vc-insn ; +: VCMPEQUW ( vrt vra vrb -- ) 0 134 4 vc-insn ; +: VCMPEQUW. ( vrt vra vrb -- ) 1 134 4 vc-insn ; +: VCMPGTSB ( vrt vra vrb -- ) 0 774 4 vc-insn ; +: VCMPGTSB. ( vrt vra vrb -- ) 1 774 4 vc-insn ; +: VCMPGTSH ( vrt vra vrb -- ) 0 838 4 vc-insn ; +: VCMPGTSH. ( vrt vra vrb -- ) 1 838 4 vc-insn ; +: VCMPGTSW ( vrt vra vrb -- ) 0 902 4 vc-insn ; +: VCMPGTSW. ( vrt vra vrb -- ) 1 902 4 vc-insn ; +: VCMPGTUB ( vrt vra vrb -- ) 0 518 4 vc-insn ; +: VCMPGTUB. ( vrt vra vrb -- ) 1 518 4 vc-insn ; +: VCMPGTUH ( vrt vra vrb -- ) 0 582 4 vc-insn ; +: VCMPGTUH. ( vrt vra vrb -- ) 1 582 4 vc-insn ; +: VCMPGTUW ( vrt vra vrb -- ) 0 646 4 vc-insn ; +: VCMPGTUW. ( vrt vra vrb -- ) 1 646 4 vc-insn ; + +! 6.9.3 Vector Logical Instructions +: VAND ( vrt vra vrb -- ) 1028 4 vx-insn ; +: VANDC ( vrt vra vrb -- ) 1092 4 vx-insn ; +: VNOR ( vrt vra vrb -- ) 1284 4 vx-insn ; +: VOR ( vrt vra vrb -- ) 1156 4 vx-insn ; +: VXOR ( vrt vra vrb -- ) 1220 4 vx-insn ; + +! 6.9.4 Vector Integer Rotate and Shift Instructions +: VRLB ( vrt vra vrb -- ) 4 4 vx-insn ; +: VRLH ( vrt vra vrb -- ) 68 4 vx-insn ; +: VRLW ( vrt vra vrb -- ) 132 4 vx-insn ; +: VSLB ( vrt vra vrb -- ) 260 4 vx-insn ; +: VSLH ( vrt vra vrb -- ) 324 4 vx-insn ; +: VSLW ( vrt vra vrb -- ) 388 4 vx-insn ; +: VSRB ( vrt vra vrb -- ) 516 4 vx-insn ; +: VSRH ( vrt vra vrb -- ) 580 4 vx-insn ; +: VSRW ( vrt vra vrb -- ) 644 4 vx-insn ; +: VSRAB ( vrt vra vrb -- ) 772 4 vx-insn ; +: VSRAH ( vrt vra vrb -- ) 836 4 vx-insn ; +: VSRAW ( vrt vra vrb -- ) 900 4 vx-insn ; + +! 6.10.1 Vector Floating-Point Arithmetic Instructions +: VADDFP ( vrt vra vrb -- ) 10 4 vx-insn ; +: VSUBFP ( vrt vra vrb -- ) 74 4 vx-insn ; +: VMADDFP ( vrt vra vrb -- ) 46 4 vx-insn ; +: VNMSUBFP ( vrt vra vrb -- ) 47 4 vx-insn ; + +! 6.10.2 Vector Floating-Point Maximum and Minimum Instructions +: VMAXFP ( vrt vra vrb -- ) 1034 4 vx-insn ; +: VMINFP ( vrt vra vrb -- ) 1098 4 vx-insn ; + +! 6.10.3 Vector Floating-Point Rounding and Conversion Instructions +: VCTSXS ( vrt vrb uim -- ) swap 970 4 vx-insn ; +: VCTUXS ( vrt vrb uim -- ) swap 906 4 vx-insn ; +: VCFSX ( vrt vrb uim -- ) swap 842 4 vx-insn ; +: VCFUX ( vrt vrb uim -- ) swap 778 4 vx-insn ; +: VRFIM ( vrt vrb -- ) 0 swap 714 4 vx-insn ; +: VRFIN ( vrt vrb -- ) 0 swap 522 4 vx-insn ; +: VRFIP ( vrt vrb -- ) 0 swap 650 4 vx-insn ; +: VRFIX ( vrt vrb -- ) 0 swap 586 4 vx-insn ; + +! 6.10.4 Vector Floating-Point Compare Instructions +: VCMPBFP ( vrt vra vrb -- ) 0 966 4 vc-insn ; +: VCMPBFP. ( vrt vra vrb -- ) 1 966 4 vc-insn ; +: VCMPEQFP ( vrt vra vrb -- ) 0 198 4 vc-insn ; +: VCMPEQFP. ( vrt vra vrb -- ) 1 198 4 vc-insn ; +: VCMPGEFP ( vrt vra vrb -- ) 0 454 4 vc-insn ; +: VCMPGEFP. ( vrt vra vrb -- ) 1 454 4 vc-insn ; +: VCMPGTFP ( vrt vra vrb -- ) 0 710 4 vc-insn ; +: VCMPGTFP. ( vrt vra vrb -- ) 1 710 4 vc-insn ; + +! 6.10.5 Vector Floating-Point Estimate Instructions +: VEXPTEFP ( vrt vrb -- ) 0 swap 394 4 vx-insn ; +: VLOGEFP ( vrt vrb -- ) 0 swap 458 4 vx-insn ; +: VREFP ( vrt vrb -- ) 0 swap 266 4 vx-insn ; +: VRSQRTEFP ( vrt vrb -- ) 0 swap 330 4 vx-insn ; + +! 6.10.6 Vector Status and Control Register Instructions +: MTVSCR ( vrb -- ) [ 0 0 ] dip 1604 4 vx-insn ; +: MFVSCR ( vrt -- ) 0 0 1540 4 vx-insn ; + +! 7.7 VSX Instruction Descriptions +: LXSDX ( xt ra rb -- ) 588 31 xx1-insn ; +: LXVD2X ( xt ra rb -- ) 844 31 xx1-insn ; +: LXVDSX ( xt ra rb -- ) 332 31 xx1-insn ; +: LXVW4X ( xt ra rb -- ) 780 31 xx1-insn ; +: STXSDX ( xs ra rb -- ) 716 31 xx1-insn ; +: STXVD2X ( xs ra rb -- ) 972 31 xx1-insn ; +: STXVW4X ( xs ra rb -- ) 908 31 xx1-insn ; +: XSABSDP ( xt xb -- ) 0 swap 345 60 xx2-insn ; +: XSADDDP ( xt xa xb -- ) 32 60 xx3-insn ; +: XSCMPODP ( bf xa xb -- ) [ 2 shift ] 2dip 43 60 xx3-insn ; +: XSCMPUDP ( bf xa xb -- ) [ 2 shift ] 2dip 35 60 xx3-insn ; +: XSCPSGNDP ( xt xa xb -- ) 176 60 xx3-insn ; +: XSCVDPSP ( xt xb -- ) 0 swap 265 60 xx2-insn ; +: XSCVDPSXDS ( xt xb -- ) 0 swap 344 60 xx2-insn ; +: XSCVDPSXWS ( xt xb -- ) 0 swap 88 60 xx2-insn ; +: XSCVDPUXDS ( xt xb -- ) 0 swap 328 60 xx2-insn ; +: XSCVDPUXWS ( xt xb -- ) 0 swap 72 60 xx2-insn ; +: XSCVSPDP ( xt xb -- ) 0 swap 329 60 xx2-insn ; +: XSCVSXDDP ( xt xb -- ) 0 swap 376 60 xx2-insn ; +: XSCUXDDP ( xt xb -- ) 0 swap 360 60 xx2-insn ; +: XSDIVDP ( xt xa xb -- ) 56 60 xx3-insn ; +: XSMADDADP ( xt xa xb -- ) 33 60 xx3-insn ; +: XSMADDMDP ( xt xa xb -- ) 41 60 xx3-insn ; +: XSMAXDP ( xt xa xb -- ) 160 60 xx3-insn ; +: XSMINDP ( xt xa xb -- ) 168 60 xx3-insn ; +: XSMSUBADP ( xt xa xb -- ) 49 60 xx3-insn ; +: XSMSUBMDP ( xt xa xb -- ) 57 60 xx3-insn ; +: XSMULDP ( xt xa xb -- ) 48 60 xx3-insn ; +: XSNABSDP ( xt xb -- ) 0 swap 361 60 xx2-insn ; +: XSNEGDP ( xt xb -- ) 0 swap 377 60 xx2-insn ; +: XSNMADDADP ( xt xa xb -- ) 161 60 xx3-insn ; +: XSNMADDMDP ( xt xa xb -- ) 169 60 xx3-insn ; +: XSNMSUBADP ( xt xa xb -- ) 177 60 xx3-insn ; +: XSNMSUBMDP ( xt xa xb -- ) 185 60 xx3-insn ; +: XSRDPI ( xt xb -- ) 0 swap 73 60 xx2-insn ; +: XSRDPIC ( xt xb -- ) 0 swap 107 60 xx2-insn ; +: XSRDPIM ( xt xb -- ) 0 swap 121 60 xx2-insn ; +: XSRDPIP ( xt xb -- ) 0 swap 105 60 xx2-insn ; +: XSRDPIZ ( xt xb -- ) 0 swap 89 60 xx2-insn ; +: XSREDP ( xt xb -- ) 0 swap 90 60 xx2-insn ; +: XSRSQRTEDP ( xt xb -- ) 0 swap 74 60 xx2-insn ; +: XSSQRTDP ( xt xb -- ) 0 swap 75 60 xx2-insn ; +: XSSUBDP ( xt xa xb -- ) 40 60 xx3-insn ; +: XSTDIVDP ( bf xa xb -- ) [ 2 shift ] 2dip 61 60 xx3-insn ; +: XSTSQRTDP ( bf xb -- ) [ 2 shift ] dip 0 swap 106 60 xx2-insn ; +: XVABSDP ( xt xb -- ) 0 swap 473 60 xx2-insn ; +: XVABSSP ( xt xb -- ) 0 swap 409 60 xx2-insn ; +: XVADDDP ( xt xa xb -- ) 96 60 xx3-insn ; +: XVADDSP ( xt xa xb -- ) 64 60 xx3-insn ; +: XVCMPEQDP ( xt xa xb -- ) 0 99 60 xx3-rc-insn ; +: XVCMPEQDP. ( xt xa xb -- ) 1 99 60 xx3-rc-insn ; +: XVCMPEQSP ( xt xa xb -- ) 0 67 60 xx3-rc-insn ; +: XVCMPEQSP. ( xt xa xb -- ) 1 67 60 xx3-rc-insn ; +: XVCMPGEDP ( xt xa xb -- ) 0 115 60 xx3-rc-insn ; +: XVCMPGEDP. ( xt xa xb -- ) 1 115 60 xx3-rc-insn ; +: XVCMPGESP ( xt xa xb -- ) 0 83 60 xx3-rc-insn ; +: XVCMPGESP. ( xt xa xb -- ) 1 83 60 xx3-rc-insn ; +: XVCMPGTDP ( xt xa xb -- ) 0 107 60 xx3-rc-insn ; +: XVCMPGTDP. ( xt xa xb -- ) 1 107 60 xx3-rc-insn ; +: XVCMPGTSP ( xt xa xb -- ) 0 75 60 xx3-rc-insn ; +: XVCMPGTSP. ( xt xa xb -- ) 1 75 60 xx3-rc-insn ; +: XVCPSGNDP ( xt xa xb -- ) 240 60 xx3-insn ; +: XVCPSGNSP ( xt xa xb -- ) 208 60 xx3-insn ; +: XVCVDPSP ( xt xb -- ) 0 swap 393 60 xx2-insn ; +: XVCVDPSXDS ( xt xb -- ) 0 swap 472 60 xx2-insn ; +: XVCVDPSXWS ( xt xb -- ) 0 swap 216 60 xx2-insn ; +: XVCVDPUXDS ( xt xb -- ) 0 swap 456 60 xx2-insn ; +: XVCVDPUXWS ( xt xb -- ) 0 swap 200 60 xx2-insn ; +: XVCVSPDP ( xt xb -- ) 0 swap 457 60 xx2-insn ; +: XVCVSPSXDS ( xt xb -- ) 0 swap 408 60 xx2-insn ; +: XVCVSPSXWS ( xt xb -- ) 0 swap 152 60 xx2-insn ; +: XVCVSPUXDS ( xt xb -- ) 0 swap 392 60 xx2-insn ; +: XVCVSPUXWS ( xt xb -- ) 0 swap 136 60 xx2-insn ; +: XVCVSXDDP ( xt xb -- ) 0 swap 504 60 xx2-insn ; +: XVCVSXDSP ( xt xb -- ) 0 swap 440 60 xx2-insn ; +: XVCVSXWDP ( xt xb -- ) 0 swap 248 60 xx2-insn ; +: XVCVSXWSP ( xt xb -- ) 0 swap 184 60 xx2-insn ; +: XVCVUXDDP ( xt xb -- ) 0 swap 488 60 xx2-insn ; +: XVCVUXDSP ( xt xb -- ) 0 swap 424 60 xx2-insn ; +: XVCVUXWDP ( xt xb -- ) 0 swap 232 60 xx2-insn ; +: XVCVUXWSP ( xt xb -- ) 0 swap 168 60 xx2-insn ; +: XVDIVDP ( xt xa xb -- ) 120 60 xx3-insn ; +: XVDIVSP ( xt xa xb -- ) 88 60 xx3-insn ; +: XVMADDADP ( xt xa xb -- ) 97 60 xx3-insn ; +: XVMADDMDP ( xt xa xb -- ) 105 60 xx3-insn ; +: XVMADDASP ( xt xa xb -- ) 65 60 xx3-insn ; +: XVMADDMSP ( xt xa xb -- ) 73 60 xx3-insn ; +: XVMAXDP ( xt xa xb -- ) 224 60 xx3-insn ; +: XVMAXSP ( xt xa xb -- ) 192 60 xx3-insn ; +: XVMINDP ( xt xa xb -- ) 232 60 xx3-insn ; +: XVMINSP ( xt xa xb -- ) 200 60 xx3-insn ; +: XVMSUBADP ( xt xa xb -- ) 113 60 xx3-insn ; +: XVMSUBMDP ( xt xa xb -- ) 121 60 xx3-insn ; +: XVMSUBASP ( xt xa xb -- ) 81 60 xx3-insn ; +: XVMSUBMSP ( xt xa xb -- ) 89 60 xx3-insn ; +: XVMULDP ( xt xa xb -- ) 112 60 xx3-insn ; +: XVMULSP ( xt xa xb -- ) 80 60 xx3-insn ; +: XVNABSDP ( xt xb -- ) 0 swap 489 60 xx2-insn ; +: XVNABSSP ( xt xb -- ) 0 swap 425 60 xx2-insn ; +: XVNEGDP ( xt xb -- ) 0 swap 505 60 xx2-insn ; +: XVNEGSP ( xt xb -- ) 0 swap 441 60 xx2-insn ; +: XVNMADDADP ( xt xa xb -- ) 225 60 xx3-insn ; +: XVNMADDMDP ( xt xa xb -- ) 233 60 xx3-insn ; +: XVNMADDASP ( xt xa xb -- ) 193 60 xx3-insn ; +: XVNMADDMSP ( xt xa xb -- ) 201 60 xx3-insn ; +: XVNMSUBADP ( xt xa xb -- ) 241 60 xx3-insn ; +: XVNMSUBMDP ( xt xa xb -- ) 249 60 xx3-insn ; +: XVNMSUBASP ( xt xa xb -- ) 209 60 xx3-insn ; +: XVNMSUBMSP ( xt xa xb -- ) 217 60 xx3-insn ; +: XVRDPI ( xt xb -- ) 0 swap 201 60 xx2-insn ; +: XVRDPIC ( xt xb -- ) 0 swap 235 60 xx2-insn ; +: XVRDPIM ( xt xb -- ) 0 swap 249 60 xx2-insn ; +: XVRDPIP ( xt xb -- ) 0 swap 233 60 xx2-insn ; +: XVRDPIZ ( xt xb -- ) 0 swap 217 60 xx2-insn ; +: XVREDP ( xt xb -- ) 0 swap 218 60 xx2-insn ; +: XVRESP ( xt xb -- ) 0 swap 154 60 xx2-insn ; +: XVRSPI ( xt xb -- ) 0 swap 137 60 xx2-insn ; +: XVRSPIC ( xt xb -- ) 0 swap 171 60 xx2-insn ; +: XVRSPIM ( xt xb -- ) 0 swap 185 60 xx2-insn ; +: XVRSPIP ( xt xb -- ) 0 swap 169 60 xx2-insn ; +: XVRSPIZ ( xt xb -- ) 0 swap 153 60 xx2-insn ; +: XVRSQRTEDP ( xt xb -- ) 0 swap 202 60 xx2-insn ; +: XVRSQRTESP ( xt xb -- ) 0 swap 138 60 xx2-insn ; +: XVSQRTDP ( xt xb -- ) 0 swap 203 60 xx2-insn ; +: XVSQRTSP ( xt xb -- ) 0 swap 139 60 xx2-insn ; +: XVSUBDP ( xt xb -- ) 0 swap 104 60 xx2-insn ; +: XVSUBSP ( xt xb -- ) 0 swap 72 60 xx2-insn ; +: XVTDIVDP ( bf xa xb -- ) [ 2 shift ] 2dip 125 60 xx3-insn ; +: XVTDIVSP ( bf xa xb -- ) [ 2 shift ] 2dip 93 60 xx3-insn ; +: XVTSQRTDP ( bf xa xb -- ) [ 2 shift ] 2dip 234 60 xx3-insn ; +: XVTSQRTSP ( bf xa xb -- ) [ 2 shift ] 2dip 170 60 xx3-insn ; +: XXLAND ( xt xa xb -- ) 130 60 xx3-insn ; +: XXLANDC ( xt xa xb -- ) 138 60 xx3-insn ; +: XXLNOR ( xt xa xb -- ) 162 60 xx3-insn ; +: XXLOR ( xt xa xb -- ) 146 60 xx3-insn ; +: XXLXOR ( xt xa xb -- ) 154 60 xx3-insn ; +: XXMRGHW ( xt xa xb -- ) 18 60 xx3-insn ; +: XXMRGLW ( xt xa xb -- ) 50 60 xx3-insn ; +: XXPERMDI ( xt xa xb dm -- ) 0 swap 10 60 xx3-rc-dm-insn ; +: XXSEL ( xt xa xb xc -- ) 3 60 xx4-insn ; +: XXSLDWI ( xt xa xb sh -- ) 0 swap 2 60 xx3-rc-dm-insn ; +: XVSPLTW ( xt xb uim -- ) swap 164 60 xx2-insn ; + +! 8.3.9 SPE Instruction Set +: BRINC ( rt ra rb -- ) 527 4 evx-insn ; +: EVABS ( rt ra -- ) 0 520 4 evx-insn ; +: EVADDIW ( rt rb ui -- ) swap 514 4 evx-insn ; +: EVADDSMIAAW ( rt ra -- ) 0 1225 4 evx-insn ; +: EVADDSSIAAW ( rt ra -- ) 0 1217 4 evx-insn ; +: EVADDUMIAAW ( rt ra -- ) 0 1224 4 evx-insn ; +: EVADDUSIAWW ( rt ra -- ) 0 1216 4 evx-insn ; +: EVADDW ( rt ra rb -- ) 512 4 evx-insn ; +: EVAND ( rt ra rb -- ) 529 4 evx-insn ; +: EVANDC ( rt ra rb -- ) 530 4 evx-insn ; +: EVCMPEQ ( bf ra rb -- ) [ 2 shift ] 2dip 564 4 evx-insn ; +: EVCMPGTS ( bf ra rb -- ) [ 2 shift ] 2dip 561 4 evx-insn ; +: EVCMPGTU ( bf ra rb -- ) [ 2 shift ] 2dip 560 4 evx-insn ; +: EVCMPLTS ( bf ra rb -- ) [ 2 shift ] 2dip 563 4 evx-insn ; +: EVCMPLTU ( bf ra rb -- ) [ 2 shift ] 2dip 562 4 evx-insn ; +: EVCNTLSW ( rt ra -- ) 0 526 4 evx-insn ; +: EVCNTLZW ( rt ra -- ) 0 525 4 evx-insn ; +: EVDIVWS ( rt ra rb -- ) 1222 4 evx-insn ; +: EVDIVWU ( rt ra rb -- ) 1223 4 evx-insn ; +: EVEQV ( rt ra rb -- ) 537 4 evx-insn ; +: EVEXTSB ( rt ra -- ) 0 522 4 evx-insn ; +: EVEXTSH ( rt ra -- ) 0 523 4 evx-insn ; +: EVLDD ( rt ra d -- ) 769 4 evx-insn ; +: EVLDDX ( rt ra rb -- ) 768 4 evx-insn ; +: EVLDH ( rt ra d -- ) 773 4 evx-insn ; +: EVLDHX ( rt ra rb -- ) 772 4 evx-insn ; +: EVLDW ( rt ra d -- ) 771 4 evx-insn ; +: EVLDWX ( rt ra rb -- ) 770 4 evx-insn ; +: EVLHHESPLAT ( rt ra d -- ) 777 4 evx-insn ; +: EVLHHESPLATX ( rt ra rb -- ) 776 4 evx-insn ; +: EVLHHOSSPLAT ( rt ra d -- ) 783 4 evx-insn ; +: EVLHHOSSPLATX ( rt ra rb -- ) 782 4 evx-insn ; +: EVLHHOUSPLAT ( rt ra d -- ) 781 4 evx-insn ; +: EVLHHOUSPLATX ( rt ra rb -- ) 780 4 evx-insn ; +: EVLWHE ( rt ra d -- ) 785 4 evx-insn ; +: EVLWHEX ( rt ra rb -- ) 784 4 evx-insn ; +: EVLWHOS ( rt ra d -- ) 791 4 evx-insn ; +: EVLWHOSX ( rt ra rb -- ) 790 4 evx-insn ; +: EVLWHOU ( rt ra d -- ) 789 4 evx-insn ; +: EVLWHOUX ( rt ra rb -- ) 788 4 evx-insn ; +: EVLWHSPLAT ( rt ra d -- ) 797 4 evx-insn ; +: EVLWHSPLATX ( rt ra rb -- ) 796 4 evx-insn ; +: EVLWWSPLAT ( rt ra d -- ) 793 4 evx-insn ; +: EVLWWSPLATX ( rt ra d -- ) 792 4 evx-insn ; +: EVMERGEHI ( rt ra rb -- ) 556 4 evx-insn ; +: EVMERGELO ( rt ra rb -- ) 557 4 evx-insn ; +: EVMERGEHILO ( rt ra rb -- ) 558 4 evx-insn ; +: EVMERGELOHI ( rt ra rb -- ) 559 4 evx-insn ; +: EVMHEGSMFAA ( rt ra rb -- ) 1323 4 evx-insn ; +: EVMHEGSMFAN ( rt ra rb -- ) 1451 4 evx-insn ; +: EVMHEGSMIAA ( rt ra rb -- ) 1321 4 evx-insn ; +: EVMHEGSMIAN ( rt ra rb -- ) 1449 4 evx-insn ; +: EVMHEGUMIAA ( rt ra rb -- ) 1320 4 evx-insn ; +: EVMHEGUMIAN ( rt ra rb -- ) 1448 4 evx-insn ; +: EVMHESMF ( rt ra rb -- ) 1035 4 evx-insn ; +: EVMHESMFA ( rt ra rb -- ) 1067 4 evx-insn ; +: EVMHESMFAAW ( rt ra rb -- ) 1291 4 evx-insn ; +: EVMHESMFANW ( rt ra rb -- ) 1419 4 evx-insn ; +: EVMHESMI ( rt ra rb -- ) 1033 4 evx-insn ; +: EVMHESMIA ( rt ra rb -- ) 1065 4 evx-insn ; +: EVMHESMIAAW ( rt ra rb -- ) 1289 4 evx-insn ; +: EVMHESMIANW ( rt ra rb -- ) 1417 4 evx-insn ; +: EVMHESSF ( rt ra rb -- ) 1027 4 evx-insn ; +: EVMHESSFA ( rt ra rb -- ) 1059 4 evx-insn ; +: EVMHESSFAAW ( rt ra rb -- ) 1283 4 evx-insn ; +: EVMHESSFANW ( rt ra rb -- ) 1411 4 evx-insn ; +: EVMHESSIAAW ( rt ra rb -- ) 1281 4 evx-insn ; +: EVMHESSIANW ( rt ra rb -- ) 1409 4 evx-insn ; +: EVMHEUMI ( rt ra rb -- ) 1032 4 evx-insn ; +: EVMHEUMIA ( rt ra rb -- ) 1064 4 evx-insn ; +: EVMHEUMIAAW ( rt ra rb -- ) 1288 4 evx-insn ; +: EVMHEUMIANW ( rt ra rb -- ) 1416 4 evx-insn ; +: EVMHEUSIAAW ( rt ra rb -- ) 1280 4 evx-insn ; +: EVMHEUSIANW ( rt ra rb -- ) 1408 4 evx-insn ; +: EVMHOGSMFAA ( rt ra rb -- ) 1327 4 evx-insn ; +: EVMHOGSMFAN ( rt ra rb -- ) 1455 4 evx-insn ; +: EVMHOGSMIAA ( rt ra rb -- ) 1325 4 evx-insn ; +: EVMHOGSMIAN ( rt ra rb -- ) 1453 4 evx-insn ; +: EVMHOGUMIAA ( rt ra rb -- ) 1324 4 evx-insn ; +: EVMHOGUMIAN ( rt ra rb -- ) 1452 4 evx-insn ; +: EVMHOSMF ( rt ra rb -- ) 1039 4 evx-insn ; +: EVMHOSMFA ( rt ra rb -- ) 1071 4 evx-insn ; +: EVMHOSMFAAW ( rt ra rb -- ) 1295 4 evx-insn ; +: EVMHOSMFANW ( rt ra rb -- ) 1423 4 evx-insn ; +: EVMHOSMI ( rt ra rb -- ) 1037 4 evx-insn ; +: EVMHOSMIA ( rt ra rb -- ) 1069 4 evx-insn ; +: EVMHOSMIAAW ( rt ra rb -- ) 1293 4 evx-insn ; +: EVMHOSMIANW ( rt ra rb -- ) 1421 4 evx-insn ; +: EVMHOSSF ( rt ra rb -- ) 1031 4 evx-insn ; +: EVMHOSSFA ( rt ra rb -- ) 1063 4 evx-insn ; +: EVMHOSSFAAW ( rt ra rb -- ) 1287 4 evx-insn ; +: EVMHOSSFANW ( rt ra rb -- ) 1415 4 evx-insn ; +: EVMHOSSIAAW ( rt ra rb -- ) 1285 4 evx-insn ; +: EVMHOSSIANW ( rt ra rb -- ) 1413 4 evx-insn ; +: EVMHOUMI ( rt ra rb -- ) 1036 4 evx-insn ; +: EVMHOUMIA ( rt ra rb -- ) 1068 4 evx-insn ; +: EVMHOUMIAAW ( rt ra rb -- ) 1292 4 evx-insn ; +: EVMHOUMIANW ( rt ra rb -- ) 1420 4 evx-insn ; +: EVMHOUSIAAW ( rt ra rb -- ) 1284 4 evx-insn ; +: EVMHOUSIANW ( rt ra rb -- ) 1412 4 evx-insn ; +: EVMRA ( rt ra rb -- ) 1220 4 evx-insn ; +: EVMWHSMF ( rt ra rb -- ) 1103 4 evx-insn ; +: EVMWHSMFA ( rt ra rb -- ) 1135 4 evx-insn ; +: EVMWHSMI ( rt ra rb -- ) 1101 4 evx-insn ; +: EVMWHSMIA ( rt ra rb -- ) 1133 4 evx-insn ; +: EVMWHSSF ( rt ra rb -- ) 1095 4 evx-insn ; +: EVMWHSSFA ( rt ra rb -- ) 1127 4 evx-insn ; +: EVMWHUMI ( rt ra rb -- ) 1100 4 evx-insn ; +: EVMWHUMIA ( rt ra rb -- ) 1132 4 evx-insn ; +: EVMWLSMIAAW ( rt ra rb -- ) 1353 4 evx-insn ; +: EVMWLSMIANW ( rt ra rb -- ) 1481 4 evx-insn ; +: EVMWLSSIAAW ( rt ra rb -- ) 1345 4 evx-insn ; +: EVMWLSSIANW ( rt ra rb -- ) 1473 4 evx-insn ; +: EVMWLUMI ( rt ra rb -- ) 1096 4 evx-insn ; +: EVMWLUMIA ( rt ra rb -- ) 1128 4 evx-insn ; +: EVMWLUMIAAW ( rt ra rb -- ) 1352 4 evx-insn ; +: EVMWLUMIANW ( rt ra rb -- ) 1480 4 evx-insn ; +: EVMWLUSIAAW ( rt ra rb -- ) 1344 4 evx-insn ; +: EVMWLUSIANW ( rt ra rb -- ) 1472 4 evx-insn ; +: EVMWSMF ( rt ra rb -- ) 1115 4 evx-insn ; +: EVMWSMFA ( rt ra rb -- ) 1147 4 evx-insn ; +: EVMWSMFAA ( rt ra rb -- ) 1371 4 evx-insn ; +: EVMWSMFAN ( rt ra rb -- ) 1499 4 evx-insn ; +: EVMWSMI ( rt ra rb -- ) 1113 4 evx-insn ; +: EVMWSMIA ( rt ra rb -- ) 1145 4 evx-insn ; +: EVMWSMIAA ( rt ra rb -- ) 1369 4 evx-insn ; +: EVMWSMIAN ( rt ra rb -- ) 1497 4 evx-insn ; +: EVMWSSF ( rt ra rb -- ) 1107 4 evx-insn ; +: EVMWSSFA ( rt ra rb -- ) 1139 4 evx-insn ; +: EVMWSSFAA ( rt ra rb -- ) 1363 4 evx-insn ; +: EVMWSSFAN ( rt ra rb -- ) 1491 4 evx-insn ; +: EVMWUMI ( rt ra rb -- ) 1112 4 evx-insn ; +: EVMWUMIA ( rt ra rb -- ) 1144 4 evx-insn ; +: EVMWUMIAA ( rt ra rb -- ) 1368 4 evx-insn ; +: EVMWUMIAN ( rt ra rb -- ) 1496 4 evx-insn ; +: EVNAND ( rt ra rb -- ) 542 4 evx-insn ; +: EVNEG ( rt ra rb -- ) 521 4 evx-insn ; +: EVNOR ( rt ra rb -- ) 536 4 evx-insn ; +: EVOR ( rt ra rb -- ) 535 4 evx-insn ; +: EVORC ( rt ra rb -- ) 539 4 evx-insn ; +: EVRLW ( rt ra rb -- ) 552 4 evx-insn ; +: EVRLWI ( rt ra rb -- ) 554 4 evx-insn ; +: EVRNDW ( rt ra rb -- ) 524 4 evx-insn ; +: EVSEL ( rt ra rb -- ) 79 4 evx-insn ; +: EVSLW ( rt ra rb -- ) 548 4 evx-insn ; +: EVSLWI ( rt ra rb -- ) 550 4 evx-insn ; +: EVSPLATFI ( rt ra rb -- ) 555 4 evx-insn ; +: EVSPLATI ( rt ra rb -- ) 553 4 evx-insn ; +: EVSRWIS ( rt ra rb -- ) 547 4 evx-insn ; +: EVSRWIU ( rt ra rb -- ) 546 4 evx-insn ; +: EVSRWS ( rt ra rb -- ) 545 4 evx-insn ; +: EVSRWU ( rt ra rb -- ) 544 4 evx-insn ; +: EVSTDD ( rt ra d -- ) 801 4 evx-insn ; +: EVSTDDX ( rt ra rb -- ) 800 4 evx-insn ; +: EVSTDH ( rt ra d -- ) 805 4 evx-insn ; +: EVSTDHX ( rt ra rb -- ) 804 4 evx-insn ; +: EVSTDW ( rt ra d -- ) 803 4 evx-insn ; +: EVSTDWX ( rt ra rb -- ) 802 4 evx-insn ; +: EVSTWHE ( rt ra d -- ) 817 4 evx-insn ; +: EVSTWHEX ( rt ra rb -- ) 816 4 evx-insn ; +: EVSTWHO ( rt ra d -- ) 821 4 evx-insn ; +: EVSTWHOX ( rt ra rb -- ) 820 4 evx-insn ; +: EVSTWWE ( rt ra d -- ) 825 4 evx-insn ; +: EVSTWWEX ( rt ra rb -- ) 824 4 evx-insn ; +: EVSTWWO ( rt ra d -- ) 829 4 evx-insn ; +: EVSTWWOX ( rt ra rb -- ) 828 4 evx-insn ; +: EVSUBFSMIAAW ( rt ra -- ) 0 1227 4 evx-insn ; +: EVSUBFSSIAAW ( rt ra -- ) 0 1219 4 evx-insn ; +: EVSUBFUMIAAW ( rt ra -- ) 0 1226 4 evx-insn ; +: EVSUBFUSIAAW ( rt ra -- ) 0 1218 4 evx-insn ; +: EVSUBFW ( rt ra rb -- ) 516 4 evx-insn ; +: EVSUBIFW ( rt ui rb -- ) 518 4 evx-insn ; +: EVXOR ( rt ra rb -- ) 534 4 evx-insn ; + +! 9.3.2 SPE Embedded Float Vector Insturctions +: EVFSABS ( rt ra -- ) 0 644 4 evx-insn ; +: EVFSNABS ( rt ra -- ) 0 645 4 evx-insn ; +: EVFSNEG ( rt ra -- ) 0 646 4 evx-insn ; +: EVFSADD ( rt ra rb -- ) 640 4 evx-insn ; +: EVFSSUB ( rt ra rb -- ) 641 4 evx-insn ; +: EVFSMUL ( rt ra rb -- ) 648 4 evx-insn ; +: EVFSDIV ( rt ra rb -- ) 649 4 evx-insn ; +: EVFSCMPGT ( bf ra rb -- ) [ 2 shift ] 2dip 652 4 evx-insn ; +: EVFSCMPLT ( bf ra rb -- ) [ 2 shift ] 2dip 653 4 evx-insn ; +: EVFSCMPEQ ( bf ra rb -- ) [ 2 shift ] 2dip 654 4 evx-insn ; +: EVFSTSTGT ( bf ra rb -- ) [ 2 shift ] 2dip 668 4 evx-insn ; +: EVFSTSTLT ( bf ra rb -- ) [ 2 shift ] 2dip 669 4 evx-insn ; +: EVFSTSTEQ ( bf ra rb -- ) [ 2 shift ] 2dip 670 4 evx-insn ; +: EVFSCFSI ( rt rb -- ) 0 swap 657 4 evx-insn ; +: EVFSCFUI ( rt rb -- ) 0 swap 656 4 evx-insn ; +: EVFSCFSF ( rt rb -- ) 0 swap 659 4 evx-insn ; +: EVFSCFUF ( rt rb -- ) 0 swap 658 4 evx-insn ; +: EVFSCTSI ( rt rb -- ) 0 swap 661 4 evx-insn ; +: EVFSCTSIZ ( rt rb -- ) 0 swap 666 4 evx-insn ; +: EVFSCTUI ( rt rb -- ) 0 swap 660 4 evx-insn ; +: EVFSCTUIZ ( rt rb -- ) 0 swap 664 4 evx-insn ; +: EVFSCTSF ( rt rb -- ) 0 swap 663 4 evx-insn ; +: EVFSCTUF ( rt rb -- ) 0 swap 662 4 evx-insn ; + +! 9.3.3 SPE Embedded Float Scalar Single Instructions +: EFSABS ( rt ra -- ) 0 708 4 evx-insn ; +: EFSNABS ( rt ra -- ) 0 709 4 evx-insn ; +: EFSNEG ( rt ra -- ) 0 710 4 evx-insn ; +: EFSADD ( rt ra rb -- ) 704 4 evx-insn ; +: EFSSUB ( rt ra rb -- ) 705 4 evx-insn ; +: EFSMUL ( rt ra rb -- ) 712 4 evx-insn ; +: EFSDIV ( rt ra rb -- ) 713 4 evx-insn ; +: EFSCMPGT ( bf ra rb -- ) [ 2 shift ] 2dip 716 4 evx-insn ; +: EFSCMPLT ( bf ra rb -- ) [ 2 shift ] 2dip 717 4 evx-insn ; +: EFSCMPEQ ( bf ra rb -- ) [ 2 shift ] 2dip 718 4 evx-insn ; +: EFSTSTGT ( bf ra rb -- ) [ 2 shift ] 2dip 732 4 evx-insn ; +: EFSTSTLT ( bf ra rb -- ) [ 2 shift ] 2dip 733 4 evx-insn ; +: EFSTSTEQ ( bf ra rb -- ) [ 2 shift ] 2dip 734 4 evx-insn ; +: EFSCFSI ( rt rb -- ) 0 swap 721 4 evx-insn ; +: EFSCFUI ( rt rb -- ) 0 swap 720 4 evx-insn ; +: EFSCFSF ( rt rb -- ) 0 swap 723 4 evx-insn ; +: EFSCFUF ( rt rb -- ) 0 swap 722 4 evx-insn ; +: EFSCTSI ( rt rb -- ) 0 swap 725 4 evx-insn ; +: EFSCTUI ( rt rb -- ) 0 swap 724 4 evx-insn ; +: EFSCTSIZ ( rt rb -- ) 0 swap 730 4 evx-insn ; +: EFSCTUIZ ( rt rb -- ) 0 swap 728 4 evx-insn ; +: EFSCTSF ( rt rb -- ) 0 swap 727 4 evx-insn ; +: EFSCTUF ( rt rb -- ) 0 swap 726 4 evx-insn ; + +! 9.3.4 SPE Embedded Float Scalar Double Instructions +: EFDABS ( rt ra -- ) 0 740 4 evx-insn ; +: EFDNABS ( rt ra -- ) 0 741 4 evx-insn ; +: EFDNEG ( rt ra -- ) 0 742 4 evx-insn ; +: EFDADD ( rt ra rb -- ) 736 4 evx-insn ; +: EFDSUB ( rt ra rb -- ) 737 4 evx-insn ; +: EFDMUL ( rt ra rb -- ) 744 4 evx-insn ; +: EFDDIV ( rt ra rb -- ) 745 4 evx-insn ; +: EFDCMPGT ( bf ra rb -- ) [ 2 shift ] 2dip 748 4 evx-insn ; +: EFDCMPLT ( bf ra rb -- ) [ 2 shift ] 2dip 749 4 evx-insn ; +: EFDCMPEQ ( bf ra rb -- ) [ 2 shift ] 2dip 750 4 evx-insn ; +: EFDTSTGT ( bf ra rb -- ) [ 2 shift ] 2dip 764 4 evx-insn ; +: EFDTSTLT ( bf ra rb -- ) [ 2 shift ] 2dip 765 4 evx-insn ; +: EFDTSTEQ ( bf ra rb -- ) [ 2 shift ] 2dip 766 4 evx-insn ; +: EFDCFSI ( rt rb -- ) 0 swap 753 4 evx-insn ; +: EFDCFUI ( rt rb -- ) 0 swap 752 4 evx-insn ; +: EFDCFSID ( rt rb -- ) 0 swap 739 4 evx-insn ; +: EFDCFUID ( rt rb -- ) 0 swap 738 4 evx-insn ; +: EFDCFSF ( rt rb -- ) 0 swap 755 4 evx-insn ; +: EFDCTSI ( rt rb -- ) 0 swap 757 4 evx-insn ; +: EFDCFUF ( rt rb -- ) 0 swap 754 4 evx-insn ; +: EFDCTUI ( rt rb -- ) 0 swap 756 4 evx-insn ; +: EFDCTSIDZ ( rt rb -- ) 0 swap 747 4 evx-insn ; +: EFDCTUIDZ ( rt rb -- ) 0 swap 746 4 evx-insn ; +: EFDCTSIZ ( rt rb -- ) 0 swap 762 4 evx-insn ; +: EFDCTUIZ ( rt rb -- ) 0 swap 760 4 evx-insn ; +: EFDCTSF ( rt rb -- ) 0 swap 759 4 evx-insn ; +: EFDCTUF ( rt rb -- ) 0 swap 758 4 evx-insn ; +: EFDCFS ( rt rb -- ) 0 swap 751 4 evx-insn ; +: EFSCFD ( rt rb -- ) 0 swap 719 4 evx-insn ; + +! 10.0 Legacy Move Assist Instruction +: DLMZB ( ra rs rb -- ) [ swap ] dip 0 78 31 x-insn ; deprecated +: DLMZB. ( ra rs rb -- ) [ swap ] dip 1 78 31 x-insn ; deprecated + +! 11.0 Legacy Integer Multiply-Accumulate Instructions +: MACCHW ( rt ra rb -- ) 0 172 0 4 xo-insn ; deprecated +: MACCHW. ( rt ra rb -- ) 0 172 1 4 xo-insn ; deprecated +: MACCHWO ( rt ra rb -- ) 1 172 0 4 xo-insn ; deprecated +: MACCHWO. ( rt ra rb -- ) 1 172 1 4 xo-insn ; deprecated +: MACCHWS ( rt ra rb -- ) 0 236 0 4 xo-insn ; deprecated +: MACCHWS. ( rt ra rb -- ) 0 236 1 4 xo-insn ; deprecated +: MACCHWSO ( rt ra rb -- ) 1 236 0 4 xo-insn ; deprecated +: MACCHWSO. ( rt ra rb -- ) 1 236 1 4 xo-insn ; deprecated +: MACCHWU ( rt ra rb -- ) 0 140 0 4 xo-insn ; deprecated +: MACCHWU. ( rt ra rb -- ) 0 140 1 4 xo-insn ; deprecated +: MACCHWUO ( rt ra rb -- ) 1 140 0 4 xo-insn ; deprecated +: MACCHWUO. ( rt ra rb -- ) 1 140 1 4 xo-insn ; deprecated +: MACCHWSU ( rt ra rb -- ) 0 204 0 4 xo-insn ; deprecated +: MACCHWSU. ( rt ra rb -- ) 0 204 1 4 xo-insn ; deprecated +: MACCHWSUO ( rt ra rb -- ) 1 204 0 4 xo-insn ; deprecated +: MACCHWSUO. ( rt ra rb -- ) 1 204 1 4 xo-insn ; deprecated +: MACHHW ( rt ra rb -- ) 0 44 0 4 xo-insn ; deprecated +: MACHHW. ( rt ra rb -- ) 0 44 1 4 xo-insn ; deprecated +: MACHHWO ( rt ra rb -- ) 1 44 0 4 xo-insn ; deprecated +: MACHHWO. ( rt ra rb -- ) 1 44 1 4 xo-insn ; deprecated +: MACHHWS ( rt ra rb -- ) 0 108 0 4 xo-insn ; deprecated +: MACHHWS. ( rt ra rb -- ) 0 108 1 4 xo-insn ; deprecated +: MACHHWSO ( rt ra rb -- ) 1 108 0 4 xo-insn ; deprecated +: MACHHWSO. ( rt ra rb -- ) 1 108 1 4 xo-insn ; deprecated +: MACHHWU ( rt ra rb -- ) 0 12 0 4 xo-insn ; deprecated +: MACHHWU. ( rt ra rb -- ) 0 12 1 4 xo-insn ; deprecated +: MACHHWUO ( rt ra rb -- ) 1 12 0 4 xo-insn ; deprecated +: MACHHWUO. ( rt ra rb -- ) 1 12 1 4 xo-insn ; deprecated +: MACHHWSU ( rt ra rb -- ) 0 76 0 4 xo-insn ; deprecated +: MACHHWSU. ( rt ra rb -- ) 0 76 1 4 xo-insn ; deprecated +: MACHHWSUO ( rt ra rb -- ) 1 76 0 4 xo-insn ; deprecated +: MACHHWSUO. ( rt ra rb -- ) 1 76 1 4 xo-insn ; deprecated +: MACLHW ( rt ra rb -- ) 0 428 0 4 xo-insn ; deprecated +: MACLHW. ( rt ra rb -- ) 0 428 1 4 xo-insn ; deprecated +: MACLHWO ( rt ra rb -- ) 1 428 0 4 xo-insn ; deprecated +: MACLHWO. ( rt ra rb -- ) 1 428 1 4 xo-insn ; deprecated +: MACLHWS ( rt ra rb -- ) 0 492 0 4 xo-insn ; deprecated +: MACLHWS. ( rt ra rb -- ) 0 492 1 4 xo-insn ; deprecated +: MACLHWSO ( rt ra rb -- ) 1 492 0 4 xo-insn ; deprecated +: MACLHWSO. ( rt ra rb -- ) 1 492 1 4 xo-insn ; deprecated +: MACLHWU ( rt ra rb -- ) 0 396 0 4 xo-insn ; deprecated +: MACLHWU. ( rt ra rb -- ) 0 396 1 4 xo-insn ; deprecated +: MACLHWUO ( rt ra rb -- ) 1 396 0 4 xo-insn ; deprecated +: MACLHWUO. ( rt ra rb -- ) 1 396 1 4 xo-insn ; deprecated +: MACLHWSU ( rt ra rb -- ) 0 460 0 4 xo-insn ; deprecated +: MACLHWSU. ( rt ra rb -- ) 0 460 1 4 xo-insn ; deprecated +: MACLHWSUO ( rt ra rb -- ) 1 460 0 4 xo-insn ; deprecated +: MACLHWSUO. ( rt ra rb -- ) 1 460 1 4 xo-insn ; deprecated +: MULCHW ( rt ra rb -- ) 168 0 4 x-insn ; deprecated +: MULCHW. ( rt ra rb -- ) 168 1 4 x-insn ; deprecated +: MULCHWU ( rt ra rb -- ) 136 0 4 x-insn ; deprecated +: MULCHWU. ( rt ra rb -- ) 136 1 4 x-insn ; deprecated +: MULHHW ( rt ra rb -- ) 40 0 4 x-insn ; deprecated +: MULHHW. ( rt ra rb -- ) 40 1 4 x-insn ; deprecated +: MULHHWU ( rt ra rb -- ) 8 0 4 x-insn ; deprecated +: MULHHWU. ( rt ra rb -- ) 8 1 4 x-insn ; deprecated +: MULLHW ( rt ra rb -- ) 424 0 4 x-insn ; deprecated +: MULLHW. ( rt ra rb -- ) 424 1 4 x-insn ; deprecated +: MULLHWU ( rt ra rb -- ) 392 0 4 x-insn ; deprecated +: MULLHWU. ( rt ra rb -- ) 392 1 4 x-insn ; deprecated +: NMACCHW ( rt ra rb -- ) 0 174 0 4 xo-insn ; deprecated +: NMACCHW. ( rt ra rb -- ) 0 174 1 4 xo-insn ; deprecated +: NMACCHWO ( rt ra rb -- ) 1 174 0 4 xo-insn ; deprecated +: NMACCHWO. ( rt ra rb -- ) 1 174 1 4 xo-insn ; deprecated +: NMACCHWS ( rt ra rb -- ) 0 238 0 4 xo-insn ; deprecated +: NMACCHWS. ( rt ra rb -- ) 0 238 1 4 xo-insn ; deprecated +: NMACCHWSO ( rt ra rb -- ) 1 238 0 4 xo-insn ; deprecated +: NMACCHWSO. ( rt ra rb -- ) 1 238 1 4 xo-insn ; deprecated +: NMACHHW ( rt ra rb -- ) 0 46 0 4 xo-insn ; deprecated +: NMACHHW. ( rt ra rb -- ) 0 46 1 4 xo-insn ; deprecated +: NMACHHWO ( rt ra rb -- ) 1 46 0 4 xo-insn ; deprecated +: NMACHHWO. ( rt ra rb -- ) 1 46 1 4 xo-insn ; deprecated +: NMACHHWS ( rt ra rb -- ) 0 110 0 4 xo-insn ; deprecated +: NMACHHWS. ( rt ra rb -- ) 0 110 1 4 xo-insn ; deprecated +: NMACHHWSO ( rt ra rb -- ) 1 110 0 4 xo-insn ; deprecated +: NMACHHWSO. ( rt ra rb -- ) 1 110 1 4 xo-insn ; deprecated +: NMACHLW ( rt ra rb -- ) 0 430 0 4 xo-insn ; deprecated +: NMACHLW. ( rt ra rb -- ) 0 430 1 4 xo-insn ; deprecated +: NMACHLWO ( rt ra rb -- ) 1 430 0 4 xo-insn ; deprecated +: NMACHLWO. ( rt ra rb -- ) 1 430 1 4 xo-insn ; deprecated +: NMACHLWS ( rt ra rb -- ) 0 494 0 4 xo-insn ; deprecated +: NMACHLWS. ( rt ra rb -- ) 0 494 1 4 xo-insn ; deprecated +: NMACHLWSO ( rt ra rb -- ) 1 494 0 4 xo-insn ; deprecated +: NMACHLWSO. ( rt ra rb -- ) 1 494 1 4 xo-insn ; deprecated + +! E.2.2 Simple Branch Mnemonics +: BLR ( -- ) HEX: 14 0 0 BCLR ; +: BCTR ( -- ) HEX: 14 0 0 BCCTR ; +: BLRL ( -- ) HEX: 14 0 0 BCLRL ; +: BCTRL ( -- ) HEX: 14 0 0 BCCTRL ; +: BT ( bi target_addr -- ) [ HEX: C ] 2dip BC ; +: BTA ( bi target_addr -- ) [ HEX: C ] 2dip BCA ; +: BTLR ( bi target_addr -- ) [ HEX: C ] 2dip BCLR ; +: BTCTR ( bi target_addr -- ) [ HEX: C ] 2dip BCCTR ; +: BTL ( bi target_addr -- ) [ HEX: C ] 2dip BCL ; +: BTLA ( bi target_addr -- ) [ HEX: C ] 2dip BCLA ; +: BTLRL ( bi target_addr -- ) [ HEX: C ] 2dip BCLRL ; +: BTCTRL ( bi target_addr -- ) [ HEX: C ] 2dip BCCTRL ; +: BF ( bi target_addr -- ) [ HEX: 4 ] 2dip BC ; +: BFA ( bi target_addr -- ) [ HEX: 4 ] 2dip BCA ; +: BFLR ( bi target_addr -- ) [ HEX: 4 ] 2dip BCLR ; +: BFCTR ( bi target_addr -- ) [ HEX: 4 ] 2dip BCCTR ; +: BFL ( bi target_addr -- ) [ HEX: 4 ] 2dip BCL ; +: BFLA ( bi target_addr -- ) [ HEX: 4 ] 2dip BCLA ; +: BFLRL ( bi target_addr -- ) [ HEX: 4 ] 2dip BCLRL ; +: BFCTRL ( bi target_addr -- ) [ HEX: 4 ] 2dip BCCTRL ; +: BDNZ ( target_addr -- ) [ HEX: 10 0 ] dip BC ; +: BDNZA ( target_addr -- ) [ HEX: 10 0 ] dip BCA ; +: BDNZLR ( target_addr -- ) [ HEX: 10 0 ] dip BCLR ; +: BDNZL ( target_addr -- ) [ HEX: 10 0 ] dip BCL ; +: BDNZLA ( target_addr -- ) [ HEX: 10 0 ] dip BCLA ; +: BDNZLRL ( target_addr -- ) [ HEX: 10 0 ] dip BCLRL ; +: BDNZT ( bi target_addr -- ) [ HEX: 8 ] 2dip BC ; +: BDNZTA ( bi target_addr -- ) [ HEX: 8 ] 2dip BCA ; +: BDNZTLR ( bi target_addr -- ) [ HEX: 8 ] 2dip BCLR ; +: BDNZTL ( bi target_addr -- ) [ HEX: 8 ] 2dip BCL ; +: BDNZTLA ( bi target_addr -- ) [ HEX: 8 ] 2dip BCLA ; +: BDNZTLRL ( bi target_addr -- ) [ HEX: 8 ] 2dip BCLRL ; +: BDNZF ( bi target_addr -- ) [ HEX: 0 ] 2dip BC ; +: BDNZFA ( bi target_addr -- ) [ HEX: 0 ] 2dip BCA ; +: BDNZFLR ( bi target_addr -- ) [ HEX: 0 ] 2dip BCLR ; +: BDNZFL ( bi target_addr -- ) [ HEX: 0 ] 2dip BCL ; +: BDNZFLA ( bi target_addr -- ) [ HEX: 0 ] 2dip BCLA ; +: BDNZFLRL ( bi target_addr -- ) [ HEX: 0 ] 2dip BCLRL ; +: BDZ ( target_addr -- ) [ HEX: 12 0 ] dip BC ; +: BDZA ( target_addr -- ) [ HEX: 12 0 ] dip BCA ; +: BDZLR ( target_addr -- ) [ HEX: 12 0 ] dip BCLR ; +: BDZL ( target_addr -- ) [ HEX: 12 0 ] dip BCL ; +: BDZLA ( target_addr -- ) [ HEX: 12 0 ] dip BCLA ; +: BDZLRL ( target_addr -- ) [ HEX: 12 0 ] dip BCLRL ; +: BDZT ( bi target_addr -- ) [ HEX: A ] 2dip BC ; +: BDZTA ( bi target_addr -- ) [ HEX: A ] 2dip BCA ; +: BDZTLR ( bi target_addr -- ) [ HEX: A ] 2dip BCLR ; +: BDZTL ( bi target_addr -- ) [ HEX: A ] 2dip BCL ; +: BDZTLA ( bi target_addr -- ) [ HEX: A ] 2dip BCLA ; +: BDZTLRL ( bi target_addr -- ) [ HEX: A ] 2dip BCLRL ; +: BDZF ( bi target_addr -- ) [ HEX: 2 ] 2dip BC ; +: BDZFA ( bi target_addr -- ) [ HEX: 2 ] 2dip BCA ; +: BDZFLR ( bi target_addr -- ) [ HEX: 2 ] 2dip BCLR ; +: BDZFL ( bi target_addr -- ) [ HEX: 2 ] 2dip BCL ; +: BDZFLA ( bi target_addr -- ) [ HEX: 2 ] 2dip BCLA ; +: BDZFLRL ( bi target_addr -- ) [ HEX: 2 ] 2dip BCLRL ; + +! E.2.3 Branch Mnemonics Incorporating Conditions +: BLT ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BC ; +: BLTA ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCA ; +: BLTLR ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCLR ; +: BLTCTR ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCCTR ; +: BLTL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCL ; +: BLTLA ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCLA ; +: BLTLRL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCLRL ; +: BLTCTRL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 12 ] 2dip BCCTRL ; +: BGT ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BC ; +: BGTA ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCA ; +: BGTLR ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCLR ; +: BGTCTR ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCCTR ; +: BGTL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCL ; +: BGTLA ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCLA ; +: BGTLRL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCLRL ; +: BGTCTRL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 12 ] 2dip BCCTRL ; +: BEQ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BC ; +: BEQA ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCA ; +: BEQLR ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCLR ; +: BEQCTR ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCCTR ; +: BEQL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCL ; +: BEQLA ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCLA ; +: BEQLRL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCLRL ; +: BEQCTRL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 12 ] 2dip BCCTRL ; +: BSO ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BC ; +: BSOA ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCA ; +: BSOLR ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCLR ; +: BSOCTR ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCCTR ; +: BSOL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCL ; +: BSOLA ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCLA ; +: BSOLRL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCLRL ; +: BSOCTRL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 12 ] 2dip BCCTRL ; +: BNL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BC ; +: BNLA ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCA ; +: BNLLR ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCLR ; +: BNLCTR ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCCTR ; +: BNLL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCL ; +: BNLLA ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCLA ; +: BNLLRL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCLRL ; +: BNLCTRL ( cr target_addr -- ) [ 4 * 0 + ] dip [ 4 ] 2dip BCCTRL ; +: BNG ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BC ; +: BNGA ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCA ; +: BNGLR ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCLR ; +: BNGCTR ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCCTR ; +: BNGL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCL ; +: BNGLA ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCLA ; +: BNGLRL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCLRL ; +: BNGCTRL ( cr target_addr -- ) [ 4 * 1 + ] dip [ 4 ] 2dip BCCTRL ; +: BNE ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BC ; +: BNEA ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCA ; +: BNELR ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCLR ; +: BNECTR ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCCTR ; +: BNEL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCL ; +: BNELA ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCLA ; +: BNELRL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCLRL ; +: BNECTRL ( cr target_addr -- ) [ 4 * 2 + ] dip [ 4 ] 2dip BCCTRL ; +: BNS ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BC ; +: BNSA ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCA ; +: BNSLR ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCLR ; +: BNSCTR ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCCTR ; +: BNSL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCL ; +: BNSLA ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCLA ; +: BNSLRL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCLRL ; +: BNSCTRL ( cr target_addr -- ) [ 4 * 3 + ] dip [ 4 ] 2dip BCCTRL ; +: BUN ( cr target_addr -- ) BSO ; +: BUNA ( cr target_addr -- ) BSOA ; +: BUNLR ( cr target_addr -- ) BSOLR ; +: BUNCTR ( cr target_addr -- ) BSOCTR ; +: BUNL ( cr target_addr -- ) BSOL ; +: BUNLA ( cr target_addr -- ) BSOLA ; +: BUNLRL ( cr target_addr -- ) BSOLRL ; +: BUNCTRL ( cr target_addr -- ) BSOCTRL ; +: BNU ( cr target_addr -- ) BNS ; +: BNUA ( cr target_addr -- ) BNSA ; +: BNULR ( cr target_addr -- ) BNSLR ; +: BNUCTR ( cr target_addr -- ) BNSCTR ; +: BNUL ( cr target_addr -- ) BNSL ; +: BNULA ( cr target_addr -- ) BNSLA ; +: BNULRL ( cr target_addr -- ) BNSLRL ; +: BNUCTRL ( cr target_addr -- ) BNSCTRL ; +: BLE ( cr target_addr -- ) BNG ; +: BLEA ( cr target_addr -- ) BNGA ; +: BLELR ( cr target_addr -- ) BNGLR ; +: BLECTR ( cr target_addr -- ) BNGCTR ; +: BLEL ( cr target_addr -- ) BNGL ; +: BLELA ( cr target_addr -- ) BNGLA ; +: BLELRL ( cr target_addr -- ) BNGLRL ; +: BLECTRL ( cr target_addr -- ) BNGCTRL ; +: BGE ( cr target_addr -- ) BNL ; +: BGEA ( cr target_addr -- ) BNLA ; +: BGELR ( cr target_addr -- ) BNLLR ; +: BGECTR ( cr target_addr -- ) BNLCTR ; +: BGEL ( cr target_addr -- ) BNLL ; +: BGELA ( cr target_addr -- ) BNLLA ; +: BGELRL ( cr target_addr -- ) BNLLRL ; +: BGECTRL ( cr target_addr -- ) BNLCTRL ; + +! E.2.4 Branch Prediction +: BT+ ( bi target_addr -- ) [ HEX: F ] 2dip BC ; +: BTA+ ( bi target_addr -- ) [ HEX: F ] 2dip BCA ; +: BTLR+ ( bi target_addr -- ) [ HEX: F ] 2dip BCLR ; +: BTCTR+ ( bi target_addr -- ) [ HEX: F ] 2dip BCCTR ; +: BTL+ ( bi target_addr -- ) [ HEX: F ] 2dip BCL ; +: BTLA+ ( bi target_addr -- ) [ HEX: F ] 2dip BCLA ; +: BTLRL+ ( bi target_addr -- ) [ HEX: F ] 2dip BCLRL ; +: BTCTRL+ ( bi target_addr -- ) [ HEX: F ] 2dip BCCTRL ; +: BF+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BC ; +: BFA+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCA ; +: BFLR+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCLR ; +: BFCTR+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCCTR ; +: BFL+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCL ; +: BFLA+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCLA ; +: BFLRL+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCLRL ; +: BFCTRL+ ( bi target_addr -- ) [ HEX: 7 ] 2dip BCCTRL ; +: BDNZ+ ( target_addr -- ) [ HEX: 19 0 ] dip BC ; +: BDNZA+ ( target_addr -- ) [ HEX: 19 0 ] dip BCA ; +: BDNZLR+ ( target_addr -- ) [ HEX: 19 0 ] dip BCLR ; +: BDNZL+ ( target_addr -- ) [ HEX: 19 0 ] dip BCL ; +: BDNZLA+ ( target_addr -- ) [ HEX: 19 0 ] dip BCLA ; +: BDNZLRL+ ( target_addr -- ) [ HEX: 19 0 ] dip BCLRL ; +: BDZ+ ( target_addr -- ) [ HEX: 1B 0 ] dip BC ; +: BDZA+ ( target_addr -- ) [ HEX: 1B 0 ] dip BCA ; +: BDZLR+ ( target_addr -- ) [ HEX: 1B 0 ] dip BCLR ; +: BDZL+ ( target_addr -- ) [ HEX: 1B 0 ] dip BCL ; +: BDZLA+ ( target_addr -- ) [ HEX: 1B 0 ] dip BCLA ; +: BDZLRL+ ( target_addr -- ) [ HEX: 1B 0 ] dip BCLRL ; +: BT- ( bi target_addr -- ) [ HEX: E ] 2dip BC ; +: BTA- ( bi target_addr -- ) [ HEX: E ] 2dip BCA ; +: BTLR- ( bi target_addr -- ) [ HEX: E ] 2dip BCLR ; +: BTCTR- ( bi target_addr -- ) [ HEX: E ] 2dip BCCTR ; +: BTL- ( bi target_addr -- ) [ HEX: E ] 2dip BCL ; +: BTLA- ( bi target_addr -- ) [ HEX: E ] 2dip BCLA ; +: BTLRL- ( bi target_addr -- ) [ HEX: E ] 2dip BCLRL ; +: BTCTRL- ( bi target_addr -- ) [ HEX: E ] 2dip BCCTRL ; +: BF- ( bi target_addr -- ) [ HEX: 6 ] 2dip BC ; +: BFA- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCA ; +: BFLR- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCLR ; +: BFCTR- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCCTR ; +: BFL- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCL ; +: BFLA- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCLA ; +: BFLRL- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCLRL ; +: BFCTRL- ( bi target_addr -- ) [ HEX: 6 ] 2dip BCCTRL ; +: BDNZ- ( target_addr -- ) [ HEX: 18 0 ] dip BC ; +: BDNZA- ( target_addr -- ) [ HEX: 18 0 ] dip BCA ; +: BDNZLR- ( target_addr -- ) [ HEX: 18 0 ] dip BCLR ; +: BDNZL- ( target_addr -- ) [ HEX: 18 0 ] dip BCL ; +: BDNZLA- ( target_addr -- ) [ HEX: 18 0 ] dip BCLA ; +: BDNZLRL- ( target_addr -- ) [ HEX: 18 0 ] dip BCLRL ; +: BDZ- ( target_addr -- ) [ HEX: 1A 0 ] dip BC ; +: BDZA- ( target_addr -- ) [ HEX: 1A 0 ] dip BCA ; +: BDZLR- ( target_addr -- ) [ HEX: 1A 0 ] dip BCLR ; +: BDZL- ( target_addr -- ) [ HEX: 1A 0 ] dip BCL ; +: BDZLA- ( target_addr -- ) [ HEX: 1A 0 ] dip BCLA ; +: BDZLRL- ( target_addr -- ) [ HEX: 1A 0 ] dip BCLRL ; +: BLT+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BC ; +: BLTA+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCA ; +: BLTLR+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCLR ; +: BLTCTR+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCCTR ; +: BLTL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCL ; +: BLTLA+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCLA ; +: BLTLRL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCLRL ; +: BLTCTRL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 15 ] 2dip BCCTRL ; +: BGT+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BC ; +: BGTA+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCA ; +: BGTLR+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCLR ; +: BGTCTR+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCCTR ; +: BGTL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCL ; +: BGTLA+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCLA ; +: BGTLRL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCLRL ; +: BGTCTRL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 15 ] 2dip BCCTRL ; +: BEQ+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BC ; +: BEQA+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCA ; +: BEQLR+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCLR ; +: BEQCTR+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCCTR ; +: BEQL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCL ; +: BEQLA+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCLA ; +: BEQLRL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCLRL ; +: BEQCTRL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 15 ] 2dip BCCTRL ; +: BSO+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BC ; +: BSOA+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCA ; +: BSOLR+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCLR ; +: BSOCTR+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCCTR ; +: BSOL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCL ; +: BSOLA+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCLA ; +: BSOLRL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCLRL ; +: BSOCTRL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 15 ] 2dip BCCTRL ; +: BNL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BC ; +: BNLA+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCA ; +: BNLLR+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCLR ; +: BNLCTR+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCCTR ; +: BNLL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCL ; +: BNLLA+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCLA ; +: BNLLRL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCLRL ; +: BNLCTRL+ ( cr target_addr -- ) [ 4 * 0 + ] dip [ 7 ] 2dip BCCTRL ; +: BNG+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BC ; +: BNGA+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCA ; +: BNGLR+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCLR ; +: BNGCTR+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCCTR ; +: BNGL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCL ; +: BNGLA+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCLA ; +: BNGLRL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCLRL ; +: BNGCTRL+ ( cr target_addr -- ) [ 4 * 1 + ] dip [ 7 ] 2dip BCCTRL ; +: BNE+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BC ; +: BNEA+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCA ; +: BNELR+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCLR ; +: BNECTR+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCCTR ; +: BNEL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCL ; +: BNELA+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCLA ; +: BNELRL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCLRL ; +: BNECTRL+ ( cr target_addr -- ) [ 4 * 2 + ] dip [ 7 ] 2dip BCCTRL ; +: BNS+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BC ; +: BNSA+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCA ; +: BNSLR+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCLR ; +: BNSCTR+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCCTR ; +: BNSL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCL ; +: BNSLA+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCLA ; +: BNSLRL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCLRL ; +: BNSCTRL+ ( cr target_addr -- ) [ 4 * 3 + ] dip [ 7 ] 2dip BCCTRL ; +: BUN+ ( cr target_addr -- ) BSO+ ; +: BUNA+ ( cr target_addr -- ) BSOA+ ; +: BUNLR+ ( cr target_addr -- ) BSOLR+ ; +: BUNCTR+ ( cr target_addr -- ) BSOCTR+ ; +: BUNL+ ( cr target_addr -- ) BSOL+ ; +: BUNLA+ ( cr target_addr -- ) BSOLA+ ; +: BUNLRL+ ( cr target_addr -- ) BSOLRL+ ; +: BUNCTRL+ ( cr target_addr -- ) BSOCTRL+ ; +: BNU+ ( cr target_addr -- ) BNS+ ; +: BNUA+ ( cr target_addr -- ) BNSA+ ; +: BNULR+ ( cr target_addr -- ) BNSLR+ ; +: BNUCTR+ ( cr target_addr -- ) BNSCTR+ ; +: BNUL+ ( cr target_addr -- ) BNSL+ ; +: BNULA+ ( cr target_addr -- ) BNSLA+ ; +: BNULRL+ ( cr target_addr -- ) BNSLRL+ ; +: BNUCTRL+ ( cr target_addr -- ) BNSCTRL+ ; +: BLE+ ( cr target_addr -- ) BNG+ ; +: BLEA+ ( cr target_addr -- ) BNGA+ ; +: BLELR+ ( cr target_addr -- ) BNGLR+ ; +: BLECTR+ ( cr target_addr -- ) BNGCTR+ ; +: BLEL+ ( cr target_addr -- ) BNGL+ ; +: BLELA+ ( cr target_addr -- ) BNGLA+ ; +: BLELRL+ ( cr target_addr -- ) BNGLRL+ ; +: BLECTRL+ ( cr target_addr -- ) BNGCTRL+ ; +: BGE+ ( cr target_addr -- ) BNL+ ; +: BGEA+ ( cr target_addr -- ) BNLA+ ; +: BGELR+ ( cr target_addr -- ) BNLLR+ ; +: BGECTR+ ( cr target_addr -- ) BNLCTR+ ; +: BGEL+ ( cr target_addr -- ) BNLL+ ; +: BGELA+ ( cr target_addr -- ) BNLLA+ ; +: BGELRL+ ( cr target_addr -- ) BNLLRL+ ; +: BGECTRL+ ( cr target_addr -- ) BNLCTRL+ ; +: BLT- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BC ; +: BLTA- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCA ; +: BLTLR- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCLR ; +: BLTCTR- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCCTR ; +: BLTL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCL ; +: BLTLA- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCLA ; +: BLTLRL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCLRL ; +: BLTCTRL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 14 ] 2dip BCCTRL ; +: BGT- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BC ; +: BGTA- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCA ; +: BGTLR- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCLR ; +: BGTCTR- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCCTR ; +: BGTL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCL ; +: BGTLA- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCLA ; +: BGTLRL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCLRL ; +: BGTCTRL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 14 ] 2dip BCCTRL ; +: BEQ- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BC ; +: BEQA- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCA ; +: BEQLR- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCLR ; +: BEQCTR- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCCTR ; +: BEQL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCL ; +: BEQLA- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCLA ; +: BEQLRL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCLRL ; +: BEQCTRL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 14 ] 2dip BCCTRL ; +: BSO- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BC ; +: BSOA- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCA ; +: BSOLR- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCLR ; +: BSOCTR- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCCTR ; +: BSOL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCL ; +: BSOLA- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCLA ; +: BSOLRL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCLRL ; +: BSOCTRL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 14 ] 2dip BCCTRL ; +: BNL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BC ; +: BNLA- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCA ; +: BNLLR- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCLR ; +: BNLCTR- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCCTR ; +: BNLL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCL ; +: BNLLA- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCLA ; +: BNLLRL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCLRL ; +: BNLCTRL- ( cr target_addr -- ) [ 4 * 0 + ] dip [ 6 ] 2dip BCCTRL ; +: BNG- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BC ; +: BNGA- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCA ; +: BNGLR- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCLR ; +: BNGCTR- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCCTR ; +: BNGL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCL ; +: BNGLA- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCLA ; +: BNGLRL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCLRL ; +: BNGCTRL- ( cr target_addr -- ) [ 4 * 1 + ] dip [ 6 ] 2dip BCCTRL ; +: BNE- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BC ; +: BNEA- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCA ; +: BNELR- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCLR ; +: BNECTR- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCCTR ; +: BNEL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCL ; +: BNELA- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCLA ; +: BNELRL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCLRL ; +: BNECTRL- ( cr target_addr -- ) [ 4 * 2 + ] dip [ 6 ] 2dip BCCTRL ; +: BNS- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BC ; +: BNSA- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCA ; +: BNSLR- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCLR ; +: BNSCTR- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCCTR ; +: BNSL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCL ; +: BNSLA- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCLA ; +: BNSLRL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCLRL ; +: BNSCTRL- ( cr target_addr -- ) [ 4 * 3 + ] dip [ 6 ] 2dip BCCTRL ; +: BUN- ( cr target_addr -- ) BSO- ; +: BUNA- ( cr target_addr -- ) BSOA- ; +: BUNLR- ( cr target_addr -- ) BSOLR- ; +: BUNCTR- ( cr target_addr -- ) BSOCTR- ; +: BUNL- ( cr target_addr -- ) BSOL- ; +: BUNLA- ( cr target_addr -- ) BSOLA- ; +: BUNLRL- ( cr target_addr -- ) BSOLRL- ; +: BUNCTRL- ( cr target_addr -- ) BSOCTRL- ; +: BNU- ( cr target_addr -- ) BNS- ; +: BNUA- ( cr target_addr -- ) BNSA- ; +: BNULR- ( cr target_addr -- ) BNSLR- ; +: BNUCTR- ( cr target_addr -- ) BNSCTR- ; +: BNUL- ( cr target_addr -- ) BNSL- ; +: BNULA- ( cr target_addr -- ) BNSLA- ; +: BNULRL- ( cr target_addr -- ) BNSLRL- ; +: BNUCTRL- ( cr target_addr -- ) BNSCTRL- ; +: BLE- ( cr target_addr -- ) BNG- ; +: BLEA- ( cr target_addr -- ) BNGA- ; +: BLELR- ( cr target_addr -- ) BNGLR- ; +: BLECTR- ( cr target_addr -- ) BNGCTR- ; +: BLEL- ( cr target_addr -- ) BNGL- ; +: BLELA- ( cr target_addr -- ) BNGLA- ; +: BLELRL- ( cr target_addr -- ) BNGLRL- ; +: BLECTRL- ( cr target_addr -- ) BNGCTRL- ; +: BGE- ( cr target_addr -- ) BNL- ; +: BGEA- ( cr target_addr -- ) BNLA- ; +: BGELR- ( cr target_addr -- ) BNLLR- ; +: BGECTR- ( cr target_addr -- ) BNLCTR- ; +: BGEL- ( cr target_addr -- ) BNLL- ; +: BGELA- ( cr target_addr -- ) BNLLA- ; +: BGELRL- ( cr target_addr -- ) BNLLRL- ; +: BGECTRL- ( cr target_addr -- ) BNLCTRL- ; + +! E.3 Condition Register Logical Mnemonics +: CRSET ( bx -- ) dup dup CREQV ; +: CRCLR ( bx -- ) dup dup CRXOR ; +: CRMOVE ( bx by -- ) dup CROR ; +: CRNOT ( bx by -- ) dup CRNOR ; + +! E.4.1 Subtract Immediate +: SUBI ( dst src1 src2 -- ) neg ADDI ; +: SUBIS ( dst src1 src2 -- ) neg ADDIS ; +: SUBIC ( dst src1 src2 -- ) neg ADDIC ; +: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; + +! E.4.2 Subtract +: SUB ( rx ry rz -- ) swap SUBF ; +: SUB. ( rx ry rz -- ) swap SUBF. ; +: SUBO ( rx ry rz -- ) swap SUBFO ; +: SUBO. ( rx ry rz -- ) swap SUBFO. ; +: SUBC ( rx ry rz -- ) swap SUBFC ; +: SUBC. ( rx ry rz -- ) swap SUBFC. ; +: SUBCO ( rx ry rz -- ) swap SUBFCO ; +: SUBCO. ( rx ry rz -- ) swap SUBFCO. ; + +! E.5.1 Double Word Comparisons +: CMPDI ( bf ra si -- ) [ 1 ] 2dip CMPI ; +: CMPD ( bf ra rb -- ) [ 1 ] 2dip CMP ; +: CMPLDI ( bf ra ui -- ) [ 1 ] 2dip CMPLI ; +: CMPLD ( bf ra rb -- ) [ 1 ] 2dip CMPL ; + +! E.5.2 Word Comparisons +: CMPWI ( bf ra si -- ) [ 0 ] 2dip CMPI ; +: CMPW ( bf ra rb -- ) [ 0 ] 2dip CMP ; +: CMPLWI ( bf ra ui -- ) [ 0 ] 2dip CMPLI ; +: CMPLW ( bf ra rb -- ) [ 0 ] 2dip CMPL ; + +! E.6 Trap Mnemonics +: TRAP ( -- ) 31 0 0 TW ; +: TDUI ( rx n -- ) [ 31 ] 2dip TDI ; +: TDU ( rx ry -- ) [ 31 ] 2dip TD ; +: TWUI ( rx n -- ) [ 31 ] 2dip TWI ; +: TWU ( rx ry -- ) [ 31 ] 2dip TW ; +: TDLTI ( rx n -- ) [ 16 ] 2dip TDI ; +: TDLT ( rx ry -- ) [ 16 ] 2dip TD ; +: TWLTI ( rx n -- ) [ 16 ] 2dip TWI ; +: TWLT ( rx ry -- ) [ 16 ] 2dip TW ; +: TDLEI ( rx n -- ) [ 20 ] 2dip TDI ; +: TDLE ( rx ry -- ) [ 20 ] 2dip TD ; +: TWLEI ( rx n -- ) [ 20 ] 2dip TWI ; +: TWLE ( rx ry -- ) [ 20 ] 2dip TW ; +: TDEQI ( rx n -- ) [ 4 ] 2dip TDI ; +: TDEQ ( rx ry -- ) [ 4 ] 2dip TD ; +: TWEQI ( rx n -- ) [ 4 ] 2dip TWI ; +: TWEQ ( rx ry -- ) [ 4 ] 2dip TW ; +: TDGEI ( rx n -- ) [ 12 ] 2dip TDI ; +: TDGE ( rx ry -- ) [ 12 ] 2dip TD ; +: TWGEI ( rx n -- ) [ 12 ] 2dip TWI ; +: TWGE ( rx ry -- ) [ 12 ] 2dip TW ; +: TDGTI ( rx n -- ) [ 8 ] 2dip TDI ; +: TDGT ( rx ry -- ) [ 8 ] 2dip TD ; +: TWGTI ( rx n -- ) [ 8 ] 2dip TWI ; +: TWGT ( rx ry -- ) [ 8 ] 2dip TW ; +: TDNLI ( rx n -- ) [ 12 ] 2dip TDI ; +: TDNL ( rx ry -- ) [ 12 ] 2dip TD ; +: TWNLI ( rx n -- ) [ 12 ] 2dip TWI ; +: TWNL ( rx ry -- ) [ 12 ] 2dip TW ; +: TDNEI ( rx n -- ) [ 24 ] 2dip TDI ; +: TDNE ( rx ry -- ) [ 24 ] 2dip TD ; +: TWNEI ( rx n -- ) [ 24 ] 2dip TWI ; +: TWNE ( rx ry -- ) [ 24 ] 2dip TW ; +: TDNGI ( rx n -- ) [ 20 ] 2dip TDI ; +: TDNG ( rx ry -- ) [ 20 ] 2dip TD ; +: TWNGI ( rx n -- ) [ 20 ] 2dip TWI ; +: TWNG ( rx ry -- ) [ 20 ] 2dip TW ; +: TDLLTI ( rx n -- ) [ 2 ] 2dip TDI ; +: TDLLT ( rx ry -- ) [ 2 ] 2dip TD ; +: TWLLTI ( rx n -- ) [ 2 ] 2dip TWI ; +: TWLLT ( rx ry -- ) [ 2 ] 2dip TW ; +: TDLLEI ( rx n -- ) [ 6 ] 2dip TDI ; +: TDLLE ( rx ry -- ) [ 6 ] 2dip TD ; +: TWLLEI ( rx n -- ) [ 6 ] 2dip TWI ; +: TWLLE ( rx ry -- ) [ 6 ] 2dip TW ; +: TDLGEI ( rx n -- ) [ 5 ] 2dip TDI ; +: TDLGE ( rx ry -- ) [ 5 ] 2dip TD ; +: TWLGEI ( rx n -- ) [ 5 ] 2dip TWI ; +: TWLGE ( rx ry -- ) [ 5 ] 2dip TW ; +: TDLGTI ( rx n -- ) [ 1 ] 2dip TDI ; +: TDLGT ( rx ry -- ) [ 1 ] 2dip TD ; +: TWLGTI ( rx n -- ) [ 1 ] 2dip TWI ; +: TWLGT ( rx ry -- ) [ 1 ] 2dip TW ; +: TDLNLI ( rx n -- ) [ 5 ] 2dip TDI ; +: TDLNL ( rx ry -- ) [ 5 ] 2dip TD ; +: TWLNLI ( rx n -- ) [ 5 ] 2dip TWI ; +: TWLNL ( rx ry -- ) [ 5 ] 2dip TW ; +: TDLNGI ( rx n -- ) [ 6 ] 2dip TDI ; +: TDLNG ( rx ry -- ) [ 6 ] 2dip TD ; +: TWLNGI ( rx n -- ) [ 6 ] 2dip TWI ; +: TWLNG ( rx ry -- ) [ 6 ] 2dip TW ; + +! E.7.1 Operations on Doublewords +: EXTLDI ( ra rs n b -- ) swap 1 - RLDICR ; +: EXTLDI. ( ra rs n b -- ) swap 1 - RLDICR. ; +: EXTRDI ( ra rs n b -- ) [ + ] [ drop 64 swap - ] 2bi RLDICL ; +: EXTRDI. ( ra rs n b -- ) [ + ] [ drop 64 swap - ] 2bi RLDICL. ; +: INSRDI ( ra rs n b -- ) [ + 64 swap - ] [ nip ] 2bi RLDIMI ; +: INSRDI. ( ra rs n b -- ) [ + 64 swap - ] [ nip ] 2bi RLDIMI. ; +: ROTLDI ( ra rs n -- ) 0 RLDICL ; +: ROTLDI. ( ra rs n -- ) 0 RLDICL. ; +: ROTRDI ( ra rs n -- ) 64 swap - 0 RLDICL ; +: ROTRDI. ( ra rs n -- ) 64 swap - 0 RLDICL. ; +: ROTLD ( ra rs rb -- ) 0 RLDCL ; +: ROTLD. ( ra rs rb -- ) 0 RLDCL. ; +: SLDI ( ra rs n -- ) dup 63 swap - RLDICR ; +: SLDI. ( ra rs n -- ) dup 63 swap - RLDICR. ; +: SRDI ( ra rs n -- ) dup [ 64 swap - ] dip RLDICL ; +: SRDI. ( ra rs n -- ) dup [ 64 swap - ] dip RLDICL. ; +: CLRLDI ( ra rs n -- ) 0 swap RLDICL ; +: CLRLDI. ( ra rs n -- ) 0 swap RLDICL. ; +: CLRRDI ( ra rs n -- ) 0 swap 63 swap - RLDICR ; +: CLRRDI. ( ra rs n -- ) 0 swap 63 swap - RLDICR. ; +: CLRLSLDI ( ra rs b n -- ) swap over - RLDIC ; +: CLRLSLDI. ( ra rs b n -- ) swap over - RLDIC. ; + +! E.7.2 Operations on Words +: EXTLWI ( ra rs n b -- ) swap 0 1 - RLWINM ; +: EXTLWI. ( ra rs n b -- ) swap 0 1 - RLWINM. ; +: EXTRWI ( ra rs n b -- ) swap dup [ + ] dip 32 swap - 31 RLWINM ; +: EXTRWI. ( ra rs n b -- ) swap dup [ + ] dip 32 swap - 31 RLWINM. ; +: INSLWI ( ra rs n b -- ) [ [ drop 32 ] dip - ] [ nip ] [ + 1 - ] 2tri RLWIMI ; +: INSLWI. ( ra rs n b -- ) [ [ drop 32 ] dip - ] [ nip ] [ + 1 - ] 2tri RLWIMI. ; +: INSRWI ( ra rs n b -- ) [ + 32 swap - ] [ nip ] [ + 1 - ] 2tri RLWIMI ; +: INSRWI. ( ra rs n b -- ) [ + 32 swap - ] [ nip ] [ + 1 - ] 2tri RLWIMI. ; +: ROTLWI ( ra rs n -- ) 0 31 RLWINM ; +: ROTLWI. ( ra rs n -- ) 0 31 RLWINM. ; +: ROTRWI ( ra rs n -- ) 32 swap - 0 31 RLWINM ; +: ROTRWI. ( ra rs n -- ) 32 swap - 0 31 RLWINM. ; +: ROTLW ( ra rs rb -- ) 0 31 RLWNM ; +: ROTLW. ( ra rs rb -- ) 0 31 RLWNM. ; +: SLWI ( ra rs n -- ) 0 over 31 swap - RLWINM ; +: SLWI. ( ra rs n -- ) 0 over 31 swap - RLWINM. ; +: SRWI ( ra rs n -- ) [ 32 swap - ] [ ] bi 31 RLWINM ; +: SRWI. ( ra rs n -- ) [ 32 swap - ] [ ] bi 31 RLWINM. ; +: CLRLWI ( ra rs n -- ) 0 swap 31 RLWINM ; +: CLRLWI. ( ra rs n -- ) 0 swap 31 RLWINM. ; +: CLRRWI ( ra rs n -- ) [ 0 0 ] dip 31 swap - RLWINM ; +: CLRRWI. ( ra rs n -- ) [ 0 0 ] dip 31 swap - RLWINM. ; +: CLRLSLWI ( ra rs b n -- ) [ nip ] [ - ] [ nip 31 swap - ] 2tri RLWINM ; +: CLRLSLWI. ( ra rs b n -- ) [ nip ] [ - ] [ nip 31 swap - ] 2tri RLWINM. ; + +! E.8 Move To/From Special Purpose Registers Mnemonics +: MFXER ( rx -- ) 1 5 shift MFSPR ; +: MFLR ( rx -- ) 8 5 shift MFSPR ; +: MFCTR ( rx -- ) 9 5 shift MFSPR ; +: MFUAMR ( rx -- ) 13 5 shift MFSPR ; +: MFPPR ( rx -- ) 896 -5 shift MFSPR ; +: MFPPR32 ( rx -- ) 898 -5 shift MFSPR ; +: MTXER ( rx -- ) 1 5 shift swap MTSPR ; +: MTLR ( rx -- ) 8 5 shift swap MTSPR ; +: MTCTR ( rx -- ) 9 5 shift swap MTSPR ; +: MTUAMR ( rx -- ) 13 5 shift swap MTSPR ; +: MTPPR ( rx -- ) 896 -5 shift swap MTSPR ; +: MTPPR32 ( rx -- ) 898 -5 shift swap MTSPR ; + +! E.9 Miscellaneous Mnemonics +: NOP ( -- ) 0 0 0 ORI ; +: XNOP ( -- ) 0 0 0 XORI ; +: LI ( dst value -- ) 0 swap ADDI ; +: LIS ( dst value -- ) 0 swap ADDIS ; +: LA ( rx ry d -- ) ADDI ; +: MR ( dst src -- ) dup OR ; +: MR. ( dst src -- ) dup OR. ; +: NOT ( dst src -- ) dup NOR ; +: NOT. ( dst src -- ) dup NOR. ; +: MTCR ( rx -- ) HEX: ff swap MTCRF ; deprecated diff --git a/basis/cpu/ppc/authors.txt b/basis/cpu/ppc/authors.txt new file mode 100644 index 0000000000..6f03a12101 --- /dev/null +++ b/basis/cpu/ppc/authors.txt @@ -0,0 +1 @@ +Erik Charlebois diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor new file mode 100644 index 0000000000..c0f565e383 --- /dev/null +++ b/basis/cpu/ppc/bootstrap.factor @@ -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 diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor new file mode 100644 index 0000000000..078f9a7bc9 --- /dev/null +++ b/basis/cpu/ppc/ppc.factor @@ -0,0 +1,1084 @@ +! Copyright (C) 2011 Erik Charlebois +! 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 +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 memory fry io prettyprint ; +QUALIFIED-WITH: alien.c-types c +FROM: cpu.ppc.assembler => B ; +FROM: layouts => cell ; +FROM: math => float ; +IN: cpu.ppc + +! PowerPC register assignments: +! r0: reserved for function prolog/epilogues +! r1: call stack register +! r2: toc register / system reserved +! r3-r12: integer vregs +! r13: reserved by OS +! r14: data stack +! r15: retain stack +! r16: VM pointer +! r17-r29: integer vregs +! r30: integer scratch +! r31: frame register +! f0-f29: float vregs +! f30: float scratch +! f31: ? + +HOOK: lr-save os ( -- n ) +HOOK: has-toc os ( -- ? ) +HOOK: reserved-area-size os ( -- n ) +HOOK: allows-null-dereference os ( -- ? ) + +M: label B ( label -- ) [ 0 B ] dip rc-relative-ppc-3-pc label-fixup ; +M: label BL ( label -- ) [ 0 BL ] dip rc-relative-ppc-3-pc label-fixup ; +M: label BC ( bo bi label -- ) [ 0 BC ] dip rc-relative-ppc-2-pc label-fixup ; + +CONSTANT: scratch-reg 30 +CONSTANT: fp-scratch-reg 30 +CONSTANT: ds-reg 14 +CONSTANT: rs-reg 15 +CONSTANT: vm-reg 16 + +enable-float-intrinsics + +M: ppc vector-regs ( -- reg-class ) + float-regs ; + +M: ppc machine-registers ( -- assoc ) + { + { int-regs $[ 3 12 [a,b] 17 29 [a,b] append ] } + { float-regs $[ 0 29 [a,b] ] } + } ; + +M: ppc frame-reg ( -- reg ) 31 ; +M: ppc.32 vm-stack-space ( -- n ) 16 ; +M: ppc.64 vm-stack-space ( -- n ) 32 ; +M: ppc complex-addressing? ( -- ? ) f ; + +! PW1-PW8 parameter save slots +: param-save-size ( -- n ) 8 cells ; foldable +! here be spill slots +! xt, size +: factor-area-size ( -- n ) 2 cells ; foldable + +: spill@ ( n -- offset ) + spill-offset reserved-area-size + param-save-size + ; + +: param@ ( n -- offset ) + reserved-area-size + ; + +M: ppc gc-root-offset ( spill-slot -- n ) + n>> spill@ cell /i ; + +: LOAD32 ( r n -- ) + [ -16 shift HEX: ffff bitand LIS ] + [ [ dup ] dip HEX: ffff bitand ORI ] 2bi ; + +: 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 ; + +HOOK: %clear-tag-bits cpu ( dst src -- ) +M: ppc.32 %clear-tag-bits tag-bits get CLRRWI ; +M: ppc.64 %clear-tag-bits tag-bits get CLRRDI ; + +HOOK: %store-cell cpu ( dst src offset -- ) +M: ppc.32 %store-cell STW ; +M: ppc.64 %store-cell STD ; + +HOOK: %store-cell-x cpu ( dst src offset -- ) +M: ppc.32 %store-cell-x STWX ; +M: ppc.64 %store-cell-x STDX ; + +HOOK: %store-cell-update cpu ( dst src offset -- ) +M: ppc.32 %store-cell-update STWU ; +M: ppc.64 %store-cell-update STDU ; + +HOOK: %load-cell cpu ( dst src offset -- ) +M: ppc.32 %load-cell LWZ ; +M: ppc.64 %load-cell LD ; + +HOOK: %trap-null cpu ( src -- ) +M: ppc.32 %trap-null + allows-null-dereference [ 0 TWEQI ] [ drop ] if ; +M: ppc.64 %trap-null + allows-null-dereference [ 0 TDEQI ] [ drop ] if ; + +HOOK: %load-cell-x cpu ( dst src offset -- ) +M: ppc.32 %load-cell-x LWZX ; +M: ppc.64 %load-cell-x LDX ; + +HOOK: %load-cell-imm cpu ( dst imm -- ) +M: ppc.32 %load-cell-imm LOAD32 ; +M: ppc.64 %load-cell-imm LOAD64 ; + +HOOK: %compare-cell cpu ( cr lhs rhs -- ) +M: ppc.32 %compare-cell CMPW ; +M: ppc.64 %compare-cell CMPD ; + +HOOK: %compare-cell-imm cpu ( cr lhs imm -- ) +M: ppc.32 %compare-cell-imm CMPWI ; +M: ppc.64 %compare-cell-imm CMPDI ; + +HOOK: %load-cell-imm-rc cpu ( -- rel-class ) +M: ppc.32 %load-cell-imm-rc rc-absolute-ppc-2/2 ; +M: ppc.64 %load-cell-imm-rc rc-absolute-ppc-2/2/2/2 ; + +M: ppc.32 %load-immediate ( reg val -- ) + dup HEX: -8000 HEX: 7fff between? [ LI ] [ LOAD32 ] if ; +M: ppc.64 %load-immediate ( reg val -- ) + dup HEX: -8000 HEX: 7fff between? [ LI ] [ LOAD64 ] if ; + +M: ppc %load-reference ( reg obj -- ) + [ [ 0 %load-cell-imm ] [ %load-cell-imm-rc rel-literal ] bi* ] + [ \ f type-number LI ] + if* ; + +M:: ppc %load-float ( dst val -- ) + scratch-reg 0 %load-cell-imm val %load-cell-imm-rc rel-binary-literal + dst scratch-reg 0 LFS ; + +M:: ppc %load-double ( dst val -- ) + scratch-reg 0 %load-cell-imm val %load-cell-imm-rc rel-binary-literal + dst scratch-reg 0 LFD ; + +M:: ppc %load-vector ( dst val rep -- ) + scratch-reg 0 %load-cell-imm val %load-cell-imm-rc rel-binary-literal + dst 0 scratch-reg LVX ; + +GENERIC: loc-reg ( loc -- reg ) +M: ds-loc loc-reg drop ds-reg ; +M: rs-loc loc-reg drop rs-reg ; + +! Load value at stack location loc into vreg. +M: ppc %peek ( vreg loc -- ) + [ loc-reg ] [ n>> cells neg ] bi %load-cell ; + +! Replace value at stack location loc with value in vreg. +M: ppc %replace ( vreg loc -- ) + [ loc-reg ] [ n>> cells neg ] bi %store-cell ; + +! Replace value at stack location with an immediate value. +M:: ppc %replace-imm ( src loc -- ) + loc loc-reg :> reg + loc n>> cells neg :> offset + src { + { [ dup not ] [ + drop scratch-reg \ f type-number LI ] } + { [ dup fixnum? ] [ + [ scratch-reg ] dip tag-fixnum LI ] } + [ scratch-reg 0 LI rc-absolute rel-literal ] + } cond + scratch-reg reg offset %store-cell ; + +! Increment data stack pointer by n cells. +M: ppc %inc-d ( n -- ) + [ ds-reg ds-reg ] dip cells ADDI ; + +! Increment retain stack pointer by n cells. +M: ppc %inc-r ( n -- ) + [ rs-reg rs-reg ] dip cells ADDI ; + +M: ppc stack-frame-size ( stack-frame -- i ) + (stack-frame-size) + reserved-area-size + + param-save-size + + factor-area-size + + 16 align ; + +M: ppc %call ( word -- ) + 0 BL rc-relative-ppc-3-pc rel-word-pic ; + +: instrs ( n -- b ) 4 * ; inline + +M: ppc %jump ( word -- ) + 6 0 %load-cell-imm 1 instrs %load-cell-imm-rc rel-here + 0 B rc-relative-ppc-3-pc rel-word-pic-tail ; + +M: ppc %dispatch ( src temp -- ) + [ nip 0 %load-cell-imm 3 instrs %load-cell-imm-rc rel-here ] + [ swap dupd %load-cell-x ] + [ nip MTCTR ] 2tri BCTR ; + +M: ppc %slot ( dst obj slot scale tag -- ) + [ 0 assert= ] bi@ %load-cell-x ; + +M: ppc %slot-imm ( dst obj slot tag -- ) + slot-offset scratch-reg swap LI + scratch-reg %load-cell-x ; + +M: ppc %set-slot ( src obj slot scale tag -- ) + [ 0 assert= ] bi@ %store-cell-x ; + +M: ppc %set-slot-imm ( src obj slot tag -- ) + slot-offset [ scratch-reg ] dip LI scratch-reg %store-cell-x ; + +M: ppc %jump-label B ; +M: ppc %return BLR ; +M: ppc %add ADD ; +M: ppc %add-imm ADDI ; +M: ppc %sub SUB ; +M: ppc %sub-imm SUBI ; +M: ppc.32 %mul MULLW ; +M: ppc.64 %mul MULLD ; +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.32 %shl SLW ; +M: ppc.64 %shl SLD ; +M: ppc.32 %shl-imm SLWI ; +M: ppc.64 %shl-imm SLDI ; +M: ppc.32 %shr SRW ; +M: ppc.64 %shr SRD ; +M: ppc.32 %shr-imm SRWI ; +M: ppc.64 %shr-imm SRDI ; +M: ppc.32 %sar SRAW ; +M: ppc.64 %sar SRAD ; +M: ppc.32 %sar-imm SRAWI ; +M: ppc.64 %sar-imm SRADI ; +M: ppc.32 %min [ 0 CMPW ] [ 0 ISEL ] 2bi ; +M: ppc.64 %min [ 0 CMPD ] [ 0 ISEL ] 2bi ; +M: ppc.32 %max [ 0 CMPW ] [ swap 0 ISEL ] 2bi ; +M: ppc.64 %max [ 0 CMPD ] [ swap 0 ISEL ] 2bi ; +M: ppc %not NOT ; +M: ppc %neg NEG ; +M: ppc.32 %log2 [ CNTLZW ] [ drop dup NEG ] [ drop dup 31 ADDI ] 2tri ; +M: ppc.64 %log2 [ CNTLZD ] [ drop dup NEG ] [ drop dup 63 ADDI ] 2tri ; +M: ppc.32 %bit-count POPCNTW ; +M: ppc.64 %bit-count POPCNTD ; + +M: ppc %copy ( dst src rep -- ) + 2over eq? [ 3drop ] [ + { + { tagged-rep [ MR ] } + { int-rep [ MR ] } + { float-rep [ FMR ] } + { double-rep [ FMR ] } + { vector-rep [ dup VOR ] } + { scalar-rep [ dup VOR ] } + } case + ] if ; + +:: overflow-template ( label dst src1 src2 cc insn -- ) + scratch-reg 0 LI + scratch-reg MTXER + dst src2 src1 insn call + cc { + { cc-o [ 0 label BSO ] } + { cc/o [ 0 label BNS ] } + } 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.32 %fixnum-mul ( label dst src1 src2 cc -- ) + [ MULLWO. ] overflow-template ; +M: ppc.64 %fixnum-mul ( label dst src1 src2 cc -- ) + [ MULLDO. ] overflow-template ; + +M: ppc %add-float FADD ; +M: ppc %sub-float FSUB ; +M: ppc %mul-float FMUL ; +M: ppc %div-float FDIV ; + +M: ppc %min-float ( dst src1 src2 -- ) + 2dup [ scratch-reg ] 2dip FSUB + [ scratch-reg ] 2dip FSEL ; + +M: ppc %max-float ( dst src1 src2 -- ) + 2dup [ scratch-reg ] 2dip FSUB + [ scratch-reg ] 2dip FSEL ; + +M: ppc %sqrt FSQRT ; +M: ppc %single>double-float FMR ; +M: ppc %double>single-float FRSP ; + +M: ppc integer-float-needs-stack-frame? t ; + +: scratch@ ( n -- offset ) + reserved-area-size + ; + +M:: ppc.32 %integer>float ( dst src -- ) + ! Sign extend to a doubleword and store. + scratch-reg src 31 %sar-imm + scratch-reg 1 0 scratch@ STW + src 1 4 scratch@ STW + ! Load back doubleword into FPR and convert from integer. + dst 1 0 scratch@ LFD + dst dst FCFID ; + +M:: ppc.64 %integer>float ( dst src -- ) + src 1 0 scratch@ STD + dst 1 0 scratch@ LFD + dst dst FCFID ; + +M:: ppc.32 %float>integer ( dst src -- ) + fp-scratch-reg src FRIZ + fp-scratch-reg fp-scratch-reg FCTIWZ + fp-scratch-reg 1 0 scratch@ STFD + dst 1 4 scratch@ LWZ ; + +M:: ppc.64 %float>integer ( dst src -- ) + fp-scratch-reg src FRIZ + fp-scratch-reg fp-scratch-reg FCTID + fp-scratch-reg 1 0 scratch@ STFD + dst 1 0 scratch@ LD ; + +! Scratch registers by register class. +: scratch-regs ( -- regs ) + { + { int-regs { 30 } } + { float-regs { 30 } } + } ; + +! Return values of this class go here +M: ppc return-regs ( -- regs ) + { + { int-regs { 3 4 5 6 } } + { float-regs { 1 2 3 4 } } + } ; + +! Is this structure small enough to be returned in registers? +M: ppc return-struct-in-registers? ( c-type -- ? ) + c-type return-in-registers?>> ; + +! If t, floats are never passed in param regs +M: ppc float-on-stack? ( -- ? ) f ; + +! If t, the struct return pointer is never passed in a param reg +M: ppc struct-return-on-stack? ( -- ? ) f ; + +GENERIC: load-param ( reg src -- ) +M: integer load-param ( reg src -- ) int-rep %copy ; +M: spill-slot load-param ( reg src -- ) [ 1 ] dip n>> spill@ %load-cell ; + +GENERIC: store-param ( reg dst -- ) +M: integer store-param ( reg dst -- ) swap int-rep %copy ; +M: spill-slot store-param ( reg dst -- ) [ 1 ] dip n>> spill@ %store-cell ; + +M:: ppc %unbox ( dst src func rep -- ) + 3 src load-param + 4 vm-reg MR + func f f %c-invoke + 3 dst store-param ; + +M:: ppc %unbox-long-long ( dst1 dst2 src func -- ) + 3 src load-param + 4 vm-reg MR + func f f %c-invoke + 3 dst1 store-param + 4 dst2 store-param ; + +M:: ppc %local-allot ( dst size align offset -- ) + dst 1 offset local-allot-offset reserved-area-size + ADDI ; + +: param-reg ( n rep -- reg ) + reg-class-of cdecl param-regs at nth ; + +M:: ppc %box ( dst src func rep gc-map -- ) + 3 src load-param + 4 vm-reg MR + func f gc-map %c-invoke + 3 dst store-param ; + +M:: ppc %box-long-long ( dst src1 src2 func gc-map -- ) + 3 src1 load-param + 4 src2 load-param + 5 vm-reg MR + func f gc-map %c-invoke + 3 dst store-param ; + +M:: ppc %save-context ( temp1 temp2 -- ) + temp1 %context + 1 temp1 "callstack-top" context-field-offset %store-cell + ds-reg temp1 "datastack" context-field-offset %store-cell + rs-reg temp1 "retainstack" context-field-offset %store-cell ; + +M:: ppc %c-invoke ( name dll gc-map -- ) + 11 0 %load-cell-imm name dll %load-cell-imm-rc rel-dlsym + has-toc [ + 2 0 %load-cell-imm name dll %load-cell-imm-rc rel-dlsym-toc + ] when + 11 MTCTR + BCTRL + gc-map gc-map-here ; + +: return-reg ( rep -- reg ) + reg-class-of return-regs at first ; + +: scratch-reg-class ( rep -- reg ) + reg-class-of scratch-regs at first ; + +:: store-stack-param ( vreg rep n -- ) + rep scratch-reg-class rep vreg %reload + rep scratch-reg-class n param@ rep { + { int-rep [ [ 1 ] dip %store-cell ] } + { tagged-rep [ [ 1 ] dip %store-cell ] } + { float-rep [ [ 1 ] dip STFS ] } + { double-rep [ [ 1 ] dip STFD ] } + { vector-rep [ scratch-reg swap LI 1 scratch-reg STVX ] } + { scalar-rep [ scratch-reg swap LI 1 scratch-reg STVX ] } + } case ; + +:: store-reg-param ( vreg rep reg -- ) + reg rep vreg %reload ; + +: discard-reg-param ( rep reg -- ) + 2drop ; + +:: load-reg-param ( vreg rep reg -- ) + reg rep vreg %spill ; + +:: load-stack-param ( vreg rep n -- ) + rep scratch-reg-class n param@ rep { + { int-rep [ [ frame-reg ] dip %load-cell ] } + { tagged-rep [ [ frame-reg ] dip %load-cell ] } + { float-rep [ [ frame-reg ] dip LFS ] } + { double-rep [ [ frame-reg ] dip LFD ] } + { vector-rep [ scratch-reg swap LI frame-reg scratch-reg LVX ] } + { scalar-rep [ scratch-reg swap LI frame-reg scratch-reg LVX ] } + } case + rep scratch-reg-class rep vreg %spill ; + +:: emit-alien-insn ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- ) + stack-inputs [ first3 store-stack-param ] each + reg-inputs [ first3 store-reg-param ] each + quot call + reg-outputs [ first3 load-reg-param ] each + dead-outputs [ first2 discard-reg-param ] each + ; inline + +M: ppc %alien-invoke ( reg-inputs stack-inputs reg-outputs + dead-outputs cleanup stack-size + symbols dll gc-map -- ) + '[ _ _ _ %c-invoke ] emit-alien-insn ; + +M:: ppc %alien-indirect ( src reg-inputs stack-inputs + reg-outputs dead-outputs cleanup + stack-size gc-map -- ) + reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size [ + has-toc [ + 11 src load-param + 2 11 1 cells %load-cell + 11 11 0 cells %load-cell + ] [ + 11 src load-param + ] if + 11 MTCTR + BCTRL + gc-map gc-map-here + ] emit-alien-insn ; + +M: ppc %alien-assembly ( reg-inputs stack-inputs reg-outputs + dead-outputs cleanup stack-size quot + gc-map -- ) + '[ _ _ gc-map set call( -- ) ] emit-alien-insn ; + +M: ppc %callback-inputs ( reg-outputs stack-outputs -- ) + [ [ first3 load-reg-param ] each ] + [ [ first3 load-stack-param ] each ] bi* + 3 vm-reg MR + 4 0 LI + "begin_callback" f f %c-invoke ; + +M: ppc %callback-outputs ( reg-inputs -- ) + 3 vm-reg MR + "end_callback" f f %c-invoke + [ first3 store-reg-param ] each ; + +M: ppc stack-cleanup ( stack-size return abi -- n ) + 3drop 0 ; + +M: ppc fused-unboxing? f ; + +M: ppc %alien-global ( register symbol dll -- ) + [ 0 %load-cell-imm ] 2dip %load-cell-imm-rc rel-dlsym ; + +M: ppc %vm-field ( dst field -- ) [ vm-reg ] dip %load-cell ; +M: ppc %set-vm-field ( src field -- ) [ vm-reg ] dip %store-cell ; + +M: ppc %unbox-alien ( dst src -- ) + scratch-reg alien-offset LI scratch-reg %load-cell-x ; + +! Convert a c-ptr object to a raw C pointer. +! if (src == F_TYPE) +! dst = NULL; +! else if ((src & tag_mask) == ALIEN_TYPE) +! dst = ((alien*)src)->address; +! else // Assume (src & tag_mask) == BYTE_ARRAY_TYPE +! dst = ((byte_array*)src) + 1; +M:: ppc %unbox-any-c-ptr ( dst src -- ) + [ + "end" define-label + ! Is the object f? + dst 0 LI + 0 src \ f type-number %compare-cell-imm + 0 "end" get BEQ + + ! Is the object an alien? + dst src tag-mask get ANDI. + ! Assume unboxing a byte-array. + 0 dst alien type-number %compare-cell-imm + dst src byte-array-offset ADDI + 0 "end" get BNE + + ! Unbox the alien. + scratch-reg alien-offset LI + dst src scratch-reg %load-cell-x + "end" resolve-label + ] with-scope ; + +! Be very careful with this. It cannot be used as an immediate +! offset to a load or store. +: alien@ ( n -- n' ) cells alien type-number - ; + +! Convert a raw C pointer to a c-ptr object. +! if (src == NULL) +! dst = F_TYPE; +! else { +! dst = allot_alien(NULL); +! dst->base = F_TYPE; +! dst->expired = F_TYPE; +! dst->displacement = src; +! dst->address = src; +! } +M:: ppc %box-alien ( dst src temp -- ) + [ + "f" define-label + + ! Is the object f? + dst \ f type-number LI + 0 src 0 %compare-cell-imm + 0 "f" get BEQ + + ! Allocate and initialize an alien object. + dst 5 cells alien temp %allot + temp \ f type-number LI + scratch-reg dst %clear-tag-bits + temp scratch-reg 1 cells %store-cell + temp scratch-reg 2 cells %store-cell + src scratch-reg 3 cells %store-cell + src scratch-reg 4 cells %store-cell + + "f" resolve-label + ] with-scope ; + +! dst->base = base; +! dst->displacement = displacement; +! dst->displacement = displacement; +:: box-displaced-alien/f ( dst displacement base -- ) + scratch-reg dst %clear-tag-bits + base scratch-reg 1 cells %store-cell + displacement scratch-reg 3 cells %store-cell + displacement scratch-reg 4 cells %store-cell ; + +! dst->base = base->base; +! dst->displacement = base->displacement + displacement; +! dst->address = base->address + displacement; +:: box-displaced-alien/alien ( dst displacement base temp -- ) + ! Set new alien's base to base.base + scratch-reg 1 alien@ LI + temp base scratch-reg %load-cell-x + temp dst scratch-reg %store-cell-x + + ! Compute displacement + scratch-reg 3 alien@ LI + temp base scratch-reg %load-cell-x + temp temp displacement ADD + temp dst scratch-reg %store-cell-x + + ! Compute address + scratch-reg 4 alien@ LI + temp base scratch-reg %load-cell-x + temp temp displacement ADD + temp dst scratch-reg %store-cell-x ; + +! dst->base = base; +! dst->displacement = displacement +! dst->address = base + sizeof(byte_array) + displacement +:: box-displaced-alien/byte-array ( dst displacement base temp -- ) + scratch-reg dst %clear-tag-bits + base scratch-reg 1 cells %store-cell + displacement scratch-reg 3 cells %store-cell + temp base byte-array-offset ADDI + temp temp displacement ADD + temp scratch-reg 4 cells %store-cell ; + +! if (base == F_TYPE) +! box_displaced_alien_f(dst, displacement, base); +! else if ((base & tag_mask) == ALIEN_TYPE) +! box_displaced_alien_alien(dst, displacement, base, temp); +! else +! box_displaced_alien_byte_array(dst, displacement, base, temp); +:: box-displaced-alien/dynamic ( dst displacement base temp -- ) + "not-f" define-label + "not-alien" define-label + + ! Is base f? + 0 base \ f type-number %compare-cell-imm + 0 "not-f" get BNE + dst displacement base box-displaced-alien/f + "end" get B + + ! Is base an alien? + "not-f" resolve-label + temp base tag-mask get ANDI. + 0 temp alien type-number %compare-cell-imm + 0 "not-alien" get BNE + dst displacement base temp box-displaced-alien/alien + "end" get B + + ! Assume base is a byte array. + "not-alien" resolve-label + dst displacement base temp box-displaced-alien/byte-array ; + +! if (displacement == 0) +! dst = base; +! else { +! dst = allot_alien(NULL); +! dst->expired = F_TYPE; +! if (is_subclass(base_class, F_TYPE)) +! box_displaced_alien_f(dst, displacement, base); +! else if (is_subclass(base_class, ALIEN_TYPE)) +! box_displaced_alien_alien(dst, displacement, base, temp); +! else if (is_subclass(base_class, BYTE_ARRAY_TYPE)) +! box_displaced_alien_byte_array(dst, displacement, base, temp); +! else +! box_displaced_alien_dynamic(dst, displacement, base, temp); +! } +M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- ) + [ + "end" define-label + + ! If displacement is zero, return the base. + dst base MR + 0 displacement 0 %compare-cell-imm + 0 "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 + scratch-reg 2 alien@ LI + temp dst scratch-reg %store-cell-x + + 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 ; + +M:: ppc.32 %convert-integer ( dst src c-type -- ) + c-type { + { c:char [ dst src 24 CLRLWI dst dst EXTSB ] } + { c:uchar [ dst src 24 CLRLWI ] } + { c:short [ dst src 16 CLRLWI dst dst EXTSH ] } + { c:ushort [ dst src 16 CLRLWI ] } + { c:int [ ] } + { c:uint [ ] } + } case ; + +M:: ppc.64 %convert-integer ( dst src c-type -- ) + c-type { + { c:char [ dst src 56 CLRLDI dst dst EXTSB ] } + { c:uchar [ dst src 56 CLRLDI ] } + { c:short [ dst src 48 CLRLDI dst dst EXTSH ] } + { c:ushort [ dst src 48 CLRLDI ] } + { c:int [ dst src 32 CLRLDI dst dst EXTSW ] } + { c:uint [ dst src 32 CLRLDI ] } + { c:longlong [ ] } + { c:ulonglong [ ] } + } case ; + +M: ppc.32 %load-memory-imm ( dst base offset rep c-type -- ) + [ + pick %trap-null + { + { 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.64 %load-memory-imm ( dst base offset rep c-type -- ) + [ + pick %trap-null + { + { c:char [ [ dup ] 2dip LBZ dup EXTSB ] } + { c:uchar [ LBZ ] } + { c:short [ LHA ] } + { c:ushort [ LHZ ] } + { c:int [ LWZ ] } + { c:uint [ LWZ ] } + { c:longlong [ [ scratch-reg ] dip LI scratch-reg LDX ] } + { c:ulonglong [ [ scratch-reg ] dip LI scratch-reg LDX ] } + } case + ] [ + { + { int-rep [ [ scratch-reg ] dip LI scratch-reg LDX ] } + { float-rep [ [ scratch-reg ] dip LI scratch-reg LFSX ] } + { double-rep [ [ scratch-reg ] dip LI scratch-reg LFDX ] } + } case + ] ?if ; + + +M: ppc.32 %load-memory ( dst base displacement scale offset rep c-type -- ) + [ [ 0 assert= ] bi@ ] 2dip + [ + pick %trap-null + { + { 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.64 %load-memory ( dst base displacement scale offset rep c-type -- ) + [ [ 0 assert= ] bi@ ] 2dip + [ + pick %trap-null + { + { c:char [ [ LBZX ] [ drop dup EXTSB ] 2bi ] } + { c:uchar [ LBZX ] } + { c:short [ LHAX ] } + { c:ushort [ LHZX ] } + { c:int [ LWZX ] } + { c:uint [ LWZX ] } + { c:longlong [ LDX ] } + { c:ulonglong [ LDX ] } + } case + ] [ + { + { int-rep [ LDX ] } + { float-rep [ LFSX ] } + { double-rep [ LFDX ] } + } case + ] ?if ; + + +M: ppc.32 %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.64 %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 ] } + { c:longlong [ [ scratch-reg ] dip LI scratch-reg STDX ] } + { c:ulonglong [ [ scratch-reg ] dip LI scratch-reg STDX ] } + } case + ] [ + { + { int-rep [ [ scratch-reg ] dip LI scratch-reg STDX ] } + { float-rep [ [ scratch-reg ] dip LI scratch-reg STFSX ] } + { double-rep [ [ scratch-reg ] dip LI scratch-reg STFDX ] } + } case + ] ?if ; + +M: ppc.32 %store-memory ( src base displacement scale offset rep c-type -- ) + [ [ 0 assert= ] bi@ ] 2dip + [ + { + { 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 ; + +M: ppc.64 %store-memory ( src base displacement scale offset rep c-type -- ) + [ [ 0 assert= ] bi@ ] 2dip + [ + { + { c:char [ STBX ] } + { c:uchar [ STBX ] } + { c:short [ STHX ] } + { c:ushort [ STHX ] } + { c:int [ STWX ] } + { c:uint [ STWX ] } + { c:longlong [ STDX ] } + { c:ulonglong [ STDX ] } + } case + ] [ + { + { int-rep [ STDX ] } + { float-rep [ STFSX ] } + { double-rep [ STFDX ] } + } case + ] ?if ; + +M:: ppc %allot ( dst size class nursery-ptr -- ) + ! dst = vm->nursery.here; + nursery-ptr vm-reg "nursery" vm-field-offset ADDI + dst nursery-ptr 0 %load-cell + ! vm->nursery.here += align(size, data_alignment); + scratch-reg dst size data-alignment get align ADDI + scratch-reg nursery-ptr 0 %store-cell + ! ((object*) dst)->header = type_number << 2; + scratch-reg class type-number tag-header LI + scratch-reg dst 0 %store-cell + ! dst |= type_number + dst dst class type-number ORI ; + +:: (%write-barrier) ( temp1 temp2 -- ) + scratch-reg card-mark LI + ! *(char *)(cards_offset + ((cell)slot_ptr >> card_bits)) + ! = card_mark_mask; + temp1 temp1 card-bits %shr-imm + temp2 0 %load-cell-imm %load-cell-imm-rc rel-cards-offset + scratch-reg temp1 temp2 STBX + ! *(char *)(decks_offset + ((cell)slot_ptr >> deck_bits)) + ! = card_mark_mask; + temp1 temp1 deck-bits card-bits - %shr-imm + temp2 0 %load-cell-imm %load-cell-imm-rc rel-decks-offset + scratch-reg temp1 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 -- ) + ! if (vm->nursery.here + size >= vm->nursery.end) ... + temp1 vm-reg "nursery" vm-field-offset %load-cell + temp2 vm-reg "nursery" vm-field-offset 2 cells + %load-cell + temp1 temp1 size ADDI + 0 temp1 temp2 %compare-cell + cc { + { cc<= [ 0 label BLE ] } + { cc/<= [ 0 label BGT ] } + } case ; + +M: ppc %call-gc ( gc-map -- ) + \ minor-gc %call gc-map-here ; + +M:: ppc %prologue ( stack-size -- ) + 0 MFLR + 0 1 lr-save %store-cell + 11 0 %load-cell-imm %load-cell-imm-rc rel-this + 11 1 2 cells neg %store-cell + 11 stack-size LI + 11 1 1 cells neg %store-cell + 1 1 stack-size neg %store-cell-update ; + +! 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. +M:: ppc %epilogue ( stack-size -- ) + 1 1 stack-size ADDI + 0 1 lr-save %load-cell + 0 MTLR ; + +:: (%boolean) ( dst temp branch1 branch2 -- ) + "end" define-label + dst \ f type-number %load-immediate + 0 "end" get branch1 execute( n addr -- ) + branch2 [ 0 "end" get branch2 execute( n addr -- ) ] 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 ] 2dip %compare-cell ; inline + +: (%compare-integer-imm) ( src1 src2 -- ) + [ 0 ] 2dip %compare-cell-imm ; inline + +: (%compare-imm) ( src1 src2 -- ) + [ tag-fixnum ] [ \ f type-number ] if* (%compare-integer-imm) ; inline + +: (%compare-float-unordered) ( src1 src2 -- ) + [ 0 ] 2dip FCMPU ; inline + +: (%compare-float-ordered) ( src1 src2 -- ) + [ 0 ] 2dip 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 -- ) \ BNS f ] } + { cc/< [ src1 src2 \ compare execute( a b -- ) \ BGE f ] } + { cc/<= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BSO ] } + { cc/> [ src1 src2 \ compare execute( a b -- ) \ BLE f ] } + { cc/>= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BSO ] } + { cc/= [ src1 src2 \ compare execute( a b -- ) \ BNE f ] } + { cc/<> [ src1 src2 \ compare execute( a b -- ) \ BEQ \ BSO ] } + { cc/<>= [ src1 src2 \ compare execute( a b -- ) \ BSO 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< [ 0 label BLT ] } + { cc<= [ 0 label BLE ] } + { cc> [ 0 label BGT ] } + { cc>= [ 0 label BGE ] } + { cc= [ 0 label BEQ ] } + { cc/= [ 0 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 -- ) + 0 label branch1 execute( cr label -- ) + branch2 [ 0 label branch2 execute( cr 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) ; + +M: ppc %spill ( src rep dst -- ) + n>> spill@ swap { + { int-rep [ [ 1 ] dip %store-cell ] } + { tagged-rep [ [ 1 ] dip %store-cell ] } + { float-rep [ [ 1 ] dip STFS ] } + { double-rep [ [ 1 ] dip STFD ] } + { vector-rep [ scratch-reg swap LI 1 scratch-reg STVX ] } + { scalar-rep [ scratch-reg swap LI 1 scratch-reg STVX ] } + } case ; + +M: ppc %reload ( dst rep src -- ) + n>> spill@ swap { + { int-rep [ [ 1 ] dip %load-cell ] } + { tagged-rep [ [ 1 ] dip %load-cell ] } + { float-rep [ [ 1 ] dip LFS ] } + { double-rep [ [ 1 ] dip LFD ] } + { vector-rep [ scratch-reg swap LI 1 scratch-reg LVX ] } + { scalar-rep [ scratch-reg swap LI 1 scratch-reg LVX ] } + } case ; + +M: ppc %loop-entry ( -- ) ; +M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ; +M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ; +M: ppc immediate-store? ( n -- ? ) immediate-comparand? ; + +USE: vocabs.loader +{ + { [ os linux? ] [ + { + { [ cpu ppc.32? ] [ "cpu.ppc.32.linux" require ] } + { [ cpu ppc.64? ] [ "cpu.ppc.64.linux" require ] } + [ ] + } cond + ] } + [ ] +} cond + +complex-double c-type t >>return-in-registers? drop diff --git a/basis/cpu/ppc/summary.txt b/basis/cpu/ppc/summary.txt new file mode 100644 index 0000000000..2bf50836e2 --- /dev/null +++ b/basis/cpu/ppc/summary.txt @@ -0,0 +1 @@ +32-bit and 64-bit PowerPC compiler backends diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 0f93e5e4a4..b1f96726e8 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -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 ; diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index 2ce959d29a..c5c7da6ac9 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -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 <= ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 6f72e44b9a..01a224791c 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -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? ; diff --git a/basis/math/floats/env/ppc/ppc.factor b/basis/math/floats/env/ppc/ppc.factor index f635a2a0f1..1387009425 100644 --- a/basis/math/floats/env/ppc/ppc.factor +++ b/basis/math/floats/env/ppc/ppc.factor @@ -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 ) ; - -FUNCTION: void get_ppc_vmx_env ( ppc-vmx-env* env ) ; -FUNCTION: void set_ppc_vmx_env ( ppc-vmx-env* env ) ; +: get_ppc_fpu_env ( env -- ) + void { void* } cdecl [ + 0 MFFS + 0 3 0 STFD + ] alien-assembly ; + +: 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 (struct) @@ -32,7 +62,7 @@ M: ppc-vmx-env (set-fp-env-register) set_ppc_vmx_env ; M: ppc (fp-env-registers) - 2array ; + 1array ; CONSTANT: ppc-exception-flag-bits HEX: fff8,0700 CONSTANT: ppc-exception-flag>bit diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 43bff4e96a..22ad8d2d72 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -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 diff --git a/build-support/factor.sh b/build-support/factor.sh index b070abe0b3..d01fdb8c30 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -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 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 90b48c6a37..7ce47a0d97 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -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 )) } diff --git a/core/system/system.factor b/core/system/system.factor index ecd5047fba..7f0872b464 100644 --- a/core/system/system.factor +++ b/core/system/system.factor @@ -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 ) diff --git a/extra/cpu/ppc/assembler/assembler-tests.factor b/extra/cpu/ppc/assembler/assembler-tests.factor deleted file mode 100644 index a30556444e..0000000000 --- a/extra/cpu/ppc/assembler/assembler-tests.factor +++ /dev/null @@ -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 diff --git a/extra/cpu/ppc/assembler/assembler.factor b/extra/cpu/ppc/assembler/assembler.factor deleted file mode 100644 index 30beabc09c..0000000000 --- a/extra/cpu/ppc/assembler/assembler.factor +++ /dev/null @@ -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 - diff --git a/extra/cpu/ppc/assembler/authors.txt b/extra/cpu/ppc/assembler/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/extra/cpu/ppc/assembler/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/extra/cpu/ppc/assembler/backend/backend.factor b/extra/cpu/ppc/assembler/backend/backend.factor deleted file mode 100644 index 47222a89fe..0000000000 --- a/extra/cpu/ppc/assembler/backend/backend.factor +++ /dev/null @@ -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 ; - diff --git a/extra/cpu/ppc/assembler/summary.txt b/extra/cpu/ppc/assembler/summary.txt deleted file mode 100644 index 336eaf9f5a..0000000000 --- a/extra/cpu/ppc/assembler/summary.txt +++ /dev/null @@ -1 +0,0 @@ -PowerPC assembler diff --git a/unmaintained/ppc/authors.txt b/unmaintained/ppc/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/unmaintained/ppc/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/unmaintained/ppc/bootstrap.factor b/unmaintained/ppc/bootstrap.factor deleted file mode 100644 index 68ebbf9f4f..0000000000 --- a/unmaintained/ppc/bootstrap.factor +++ /dev/null @@ -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 diff --git a/unmaintained/ppc/linux/bootstrap.factor b/unmaintained/ppc/linux/bootstrap.factor deleted file mode 100644 index 2f463dea00..0000000000 --- a/unmaintained/ppc/linux/bootstrap.factor +++ /dev/null @@ -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 diff --git a/unmaintained/ppc/linux/linux.factor b/unmaintained/ppc/linux/linux.factor deleted file mode 100644 index 9191b6c202..0000000000 --- a/unmaintained/ppc/linux/linux.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/ppc/linux/summary.txt b/unmaintained/ppc/linux/summary.txt deleted file mode 100644 index a35c0374b9..0000000000 --- a/unmaintained/ppc/linux/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Linux/PPC ABI support diff --git a/unmaintained/ppc/linux/tags.txt b/unmaintained/ppc/linux/tags.txt deleted file mode 100644 index ebb74b4d5f..0000000000 --- a/unmaintained/ppc/linux/tags.txt +++ /dev/null @@ -1 +0,0 @@ -not loaded diff --git a/unmaintained/ppc/macosx/bootstrap.factor b/unmaintained/ppc/macosx/bootstrap.factor deleted file mode 100644 index 0960011c70..0000000000 --- a/unmaintained/ppc/macosx/bootstrap.factor +++ /dev/null @@ -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 diff --git a/unmaintained/ppc/macosx/macosx.factor b/unmaintained/ppc/macosx/macosx.factor deleted file mode 100644 index 989426b8d2..0000000000 --- a/unmaintained/ppc/macosx/macosx.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/ppc/macosx/summary.txt b/unmaintained/ppc/macosx/summary.txt deleted file mode 100644 index 52ace04cc8..0000000000 --- a/unmaintained/ppc/macosx/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Mac OS X/PPC ABI support diff --git a/unmaintained/ppc/macosx/tags.txt b/unmaintained/ppc/macosx/tags.txt deleted file mode 100644 index ebb74b4d5f..0000000000 --- a/unmaintained/ppc/macosx/tags.txt +++ /dev/null @@ -1 +0,0 @@ -not loaded diff --git a/unmaintained/ppc/ppc.factor b/unmaintained/ppc/ppc.factor deleted file mode 100644 index 7fcce4ccfd..0000000000 --- a/unmaintained/ppc/ppc.factor +++ /dev/null @@ -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 diff --git a/unmaintained/ppc/summary.txt b/unmaintained/ppc/summary.txt deleted file mode 100644 index 9850905e2f..0000000000 --- a/unmaintained/ppc/summary.txt +++ /dev/null @@ -1 +0,0 @@ -32-bit PowerPC compiler backend diff --git a/unmaintained/ppc/tags.txt b/unmaintained/ppc/tags.txt deleted file mode 100644 index f5bb856b53..0000000000 --- a/unmaintained/ppc/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -compiler -not loaded diff --git a/vm/Config.freebsd b/vm/Config.freebsd index 4dc56cfaed..1878e994b1 100644 --- a/vm/Config.freebsd +++ b/vm/Config.freebsd @@ -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 diff --git a/vm/Config.linux b/vm/Config.linux index 00ff73522a..536e66dd03 100644 --- a/vm/Config.linux +++ b/vm/Config.linux @@ -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 diff --git a/vm/Config.linux.ppc b/vm/Config.linux.ppc deleted file mode 100644 index 1ee3b35c9a..0000000000 --- a/vm/Config.linux.ppc +++ /dev/null @@ -1,3 +0,0 @@ -include vm/Config.linux -include vm/Config.ppc -CFLAGS += -mregnames diff --git a/vm/Config.linux.ppc.32 b/vm/Config.linux.ppc.32 new file mode 100644 index 0000000000..87a197cd9f --- /dev/null +++ b/vm/Config.linux.ppc.32 @@ -0,0 +1,3 @@ +include vm/Config.linux +PLAF_DLL_OBJS += vm/cpu-ppc.linux.o +CFLAGS += -m32 diff --git a/vm/Config.linux.ppc.64 b/vm/Config.linux.ppc.64 new file mode 100644 index 0000000000..f87195ee7c --- /dev/null +++ b/vm/Config.linux.ppc.64 @@ -0,0 +1,3 @@ +include vm/Config.linux +PLAF_DLL_OBJS += vm/cpu-ppc.linux.o +CFLAGS += -m64 diff --git a/vm/Config.macosx.ppc b/vm/Config.macosx.ppc index 9fb84d6185..b4bf8e338f 100644 --- a/vm/Config.macosx.ppc +++ b/vm/Config.macosx.ppc @@ -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 diff --git a/vm/Config.netbsd b/vm/Config.netbsd index 2838f9d4c5..29782c2209 100644 --- a/vm/Config.netbsd +++ b/vm/Config.netbsd @@ -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 diff --git a/vm/Config.openbsd b/vm/Config.openbsd index 6983223b74..8290d77056 100644 --- a/vm/Config.openbsd +++ b/vm/Config.openbsd @@ -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 diff --git a/vm/Config.ppc b/vm/Config.ppc deleted file mode 100644 index 1ded04dda1..0000000000 --- a/vm/Config.ppc +++ /dev/null @@ -1 +0,0 @@ -PLAF_DLL_OBJS += vm/cpu-ppc.o diff --git a/vm/Config.solaris b/vm/Config.solaris index a2d7b1f271..cb99c2239a 100644 --- a/vm/Config.solaris +++ b/vm/Config.solaris @@ -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 diff --git a/vm/alien.cpp b/vm/alien.cpp index 71708a5fa1..98b68b45af 100755 --- a/vm/alien.cpp +++ b/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 library(ctx->pop(),this); + data_root name(ctx->pop(),this); + name.untag_check(this); + + symbol_char *sym = name->data(); + + if(to_boolean(library.value())) + { + dll *d = untag_check(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() { diff --git a/vm/bitwise_hacks.hpp b/vm/bitwise_hacks.hpp index ddff576bef..d337b29df7 100755 --- a/vm/bitwise_hacks.hpp +++ b/vm/bitwise_hacks.hpp @@ -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) diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp index 38479a3cb4..e54957434b 100755 --- a/vm/callbacks.cpp +++ b/vm/callbacks.cpp @@ -140,7 +140,10 @@ void factor_vm::primitive_callback() tagged 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)); } } diff --git a/vm/callstack.hpp b/vm/callstack.hpp index 9f0693eb76..a8e4407cd7 100755 --- a/vm/callstack.hpp +++ b/vm/callstack.hpp @@ -11,7 +11,7 @@ keep the callstack in a GC root and use relative offsets */ template void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator) { data_root 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) { diff --git a/vm/code_blocks.cpp b/vm/code_blocks.cpp index e8c6216d8d..1f8be8b96a 100755 --- a/vm/code_blocks.cpp +++ b/vm/code_blocks.cpp @@ -160,8 +160,10 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index) dll *d = (to_boolean(library) ? untag(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(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(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(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(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()); diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S deleted file mode 100644 index 835ed14cc2..0000000000 --- a/vm/cpu-ppc.S +++ /dev/null @@ -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 diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp index e6244e366e..80eb7fb1d8 100644 --- a/vm/cpu-ppc.hpp +++ b/vm/cpu-ppc.hpp @@ -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; } diff --git a/vm/cpu-ppc.linux.S b/vm/cpu-ppc.linux.S new file mode 100644 index 0000000000..3b7061714d --- /dev/null +++ b/vm/cpu-ppc.linux.S @@ -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 diff --git a/vm/entry_points.cpp b/vm/entry_points.cpp index 9f4c827ddf..da4ed9d9ce 100755 --- a/vm/entry_points.cpp +++ b/vm/entry_points.cpp @@ -13,9 +13,10 @@ void factor_vm::c_to_factor(cell quot) { tagged 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 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_WORD)(quot,to); + tagged 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_WORD)(); + tagged 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(GET_FPU_STATE_WORD)(state); + tagged 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); } } diff --git a/vm/factor.cpp b/vm/factor.cpp index 3f85c71a05..02e4205743 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -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) diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index b11db279a5..7b7802297a 100644 --- a/vm/instruction_operands.cpp +++ b/vm/instruction_operands.cpp @@ -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; diff --git a/vm/instruction_operands.hpp b/vm/instruction_operands.hpp index 475e48d206..563972ab17 100644 --- a/vm/instruction_operands.hpp +++ b/vm/instruction_operands.hpp @@ -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); diff --git a/vm/master.hpp b/vm/master.hpp index d4cd70f867..43e02fe4d4 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -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 @@ -21,6 +26,7 @@ #include #include #include +#include /* C++ headers */ #include @@ -31,7 +37,8 @@ #include #include -#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" diff --git a/vm/os-freebsd.hpp b/vm/os-freebsd.hpp index 177a920d87..cd49e07a1b 100644 --- a/vm/os-freebsd.hpp +++ b/vm/os-freebsd.hpp @@ -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 diff --git a/vm/os-linux-arm.hpp b/vm/os-linux-arm.hpp index 3af92fda99..d739dfc2f8 100644 --- a/vm/os-linux-arm.hpp +++ b/vm/os-linux-arm.hpp @@ -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 } diff --git a/vm/os-linux-ppc.32.hpp b/vm/os-linux-ppc.32.hpp new file mode 100644 index 0000000000..7eac07e104 --- /dev/null +++ b/vm/os-linux-ppc.32.hpp @@ -0,0 +1,39 @@ +#include + +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; +} + +} diff --git a/vm/os-linux-ppc.64.hpp b/vm/os-linux-ppc.64.hpp new file mode 100644 index 0000000000..9d9360e043 --- /dev/null +++ b/vm/os-linux-ppc.64.hpp @@ -0,0 +1,50 @@ +#include + +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; +} + +} diff --git a/vm/os-linux-ppc.hpp b/vm/os-linux-ppc.hpp deleted file mode 100644 index 51e017bdad..0000000000 --- a/vm/os-linux-ppc.hpp +++ /dev/null @@ -1,10 +0,0 @@ -#include - -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]) - -} diff --git a/vm/os-linux-x86.32.hpp b/vm/os-linux-x86.32.hpp index 53a93d17de..40ba68fefa 100644 --- a/vm/os-linux-x86.32.hpp +++ b/vm/os-linux-x86.32.hpp @@ -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 } diff --git a/vm/os-linux-x86.64.hpp b/vm/os-linux-x86.64.hpp index 7d764d61e3..ced11635e6 100644 --- a/vm/os-linux-x86.64.hpp +++ b/vm/os-linux-x86.64.hpp @@ -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 } diff --git a/vm/os-linux.hpp b/vm/os-linux.hpp index 6c490de260..de13896b9a 100644 --- a/vm/os-linux.hpp +++ b/vm/os-linux.hpp @@ -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 - } diff --git a/vm/os-macosx.hpp b/vm/os-macosx.hpp index 27eba77215..5a7f9ab842 100644 --- a/vm/os-macosx.hpp +++ b/vm/os-macosx.hpp @@ -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 } diff --git a/vm/os-netbsd.hpp b/vm/os-netbsd.hpp index e79d1bf375..fa27b23287 100644 --- a/vm/os-netbsd.hpp +++ b/vm/os-netbsd.hpp @@ -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 diff --git a/vm/os-openbsd.hpp b/vm/os-openbsd.hpp index b3b47c08b3..1eca1ec03b 100644 --- a/vm/os-openbsd.hpp +++ b/vm/os-openbsd.hpp @@ -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 diff --git a/vm/os-solaris-x86.32.hpp b/vm/os-solaris-x86.32.hpp index 2ec8bc138f..d098ac8f93 100644 --- a/vm/os-solaris-x86.32.hpp +++ b/vm/os-solaris-x86.32.hpp @@ -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 } diff --git a/vm/os-solaris-x86.64.hpp b/vm/os-solaris-x86.64.hpp index 72a7b5c2fd..d13f5c6bc6 100644 --- a/vm/os-solaris-x86.64.hpp +++ b/vm/os-solaris-x86.64.hpp @@ -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 } diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index 8f0f8b85cd..91aca6e7be 100755 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -47,11 +47,22 @@ 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) { @@ -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); diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index a54a5e15d7..795a80e5c7 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -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); diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index 79f3e0d0aa..70e05d00de 100755 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -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 } diff --git a/vm/platform.hpp b/vm/platform.hpp index cdfe7fa45a..9494b7de56 100755 --- a/vm/platform.hpp +++ b/vm/platform.hpp @@ -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) diff --git a/vm/primitives.hpp b/vm/primitives.hpp index 573f91b072..6f2cd6c4a9 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -57,6 +57,7 @@ namespace factor _(dll_validp) \ _(dlopen) \ _(dlsym) \ + _(dlsym_raw) \ _(double_bits) \ _(enable_gc_events) \ _(existsp) \ diff --git a/vm/quotations.cpp b/vm/quotations.cpp index b3c4f14887..9a1f7aa28a 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -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++; diff --git a/vm/utilities.cpp b/vm/utilities.cpp index 11d3de78cc..91bf48abc6 100755 --- a/vm/utilities.cpp +++ b/vm/utilities.cpp @@ -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) { diff --git a/vm/utilities.hpp b/vm/utilities.hpp index e75d3ece12..5f37644213 100755 --- a/vm/utilities.hpp +++ b/vm/utilities.hpp @@ -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); diff --git a/vm/vm.cpp b/vm/vm.cpp index e9ade19cc6..ee469f7445 100755 --- a/vm/vm.cpp +++ b/vm/vm.cpp @@ -27,6 +27,13 @@ factor_vm::~factor_vm() delete signal_callstack_seg; signal_callstack_seg = NULL; } + std::list::const_iterator iter = function_descriptors.begin(); + std::list::const_iterator end = function_descriptors.end(); + while(iter != end) + { + delete [] *iter; + iter++; + } } } diff --git a/vm/vm.hpp b/vm/vm.hpp index 38eb5033d7..9539ba04e1 100755 --- a/vm/vm.hpp +++ b/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 function_descriptors; + /* Pooling unused contexts to make context allocation cheaper */ std::list 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();