ifdef CONFIG
CC = gcc
CPP = g++
- AR = ar
- LD = ld
VERSION = 0.94
@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"
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
$(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 $@ $<
\ 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
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
+: dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ;
+
SYMBOL: libraries
libraries [ H{ } clone ] initialize
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
swap [ name>> current-library get ] dip
'[ _ _ address-of 0 _ alien-value ] ;
-: define-global ( type word -- )
+: set-global-quot ( type word -- quot )
+ swap [ name>> current-library get ] dip
+ '[ _ _ address-of 0 _ set-alien-value ] ;
+
+: define-global-getter ( type word -- )
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
+
+: define-global-setter ( type word -- )
+ [ nip name>> "set-" prepend create-in ]
+ [ set-global-quot ] 2bi (( obj -- )) define-declared ;
+
+: define-global ( type word -- )
+ [ define-global-getter ] [ define-global-setter ] 2bi ;
HELP: C-GLOBAL:
{ $syntax "C-GLOBAL: type name" }
{ $values { "type" "a C type" } { "name" "a C global variable name" } }
-{ $description "Defines a new word named " { $snippet "name" } " which accesses a global variable in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
+{ $description "Defines a getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
ARTICLE: "alien.enums" "Enumeration types"
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
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 ;
: images ( -- seq )
{
"winnt-x86.32" "unix-x86.32"
+ "linux-ppc.32" "linux-ppc.64"
"winnt-x86.64" "unix-x86.64"
} ;
: 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 +
{ 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
IN: command-line
HELP: run-bootstrap-init
-{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } " on Unix and " { $snippet "factor-boot-rc" } " on Windows." } ;
+{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } "." } ;
HELP: run-user-init
-{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } " on Unix and " { $snippet "factor-rc" } " on Windows." } ;
+{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } "." } ;
HELP: load-vocab-roots
-{ $description "Loads the newline-separated list of additional vocabulary roots from the file named " { $snippet ".factor-roots" } " on Unix and " { $snippet "factor-roots" } " on Windows." } ;
+{ $description "Loads the newline-separated list of additional vocabulary roots from the file named " { $snippet ".factor-roots" } "." } ;
HELP: param
{ $values { "param" string } }
{ { $snippet "-quiet" } { "If set, " { $link run-file } " and " { $link require } " will not print load messages." } }
} ;
-ARTICLE: "factor-boot-rc" "Bootstrap initialization file"
-"The bootstrap initialization file is named " { $snippet "factor-boot-rc" } " on Windows and " { $snippet ".factor-boot-rc" } " on Unix. This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts."
+ARTICLE: ".factor-boot-rc" "Bootstrap initialization file"
+"The bootstrap initialization file is named " { $snippet ".factor-boot-rc" } ". This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections run-bootstrap-init }
"For example, if you changed " { $snippet ".factor-boot-rc" } " and do not want to bootstrap again, you can just invoke " { $link run-bootstrap-init } " in the listener." ;
-ARTICLE: "factor-rc" "Startup initialization file"
-"The startup initialization file is named " { $snippet "factor-rc" } " on Windows and " { $snippet ".factor-rc" } " on Unix. If it exists, it is run every time Factor starts."
+ARTICLE: ".factor-rc" "Startup initialization file"
+"The startup initialization file is named " { $snippet ".factor-rc" } ". If it exists, it is run every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections run-user-init } ;
-ARTICLE: "factor-roots" "Additional vocabulary roots file"
-"The vocabulary roots file is named " { $snippet "factor-roots" } " on Windows and " { $snippet ".factor-roots" } " on Unix. If it exists, it is loaded every time Factor starts. It contains a newline-separated list of " { $link "vocabs.roots" } "."
+ARTICLE: ".factor-roots" "Additional vocabulary roots file"
+"The vocabulary roots file is named " { $snippet ".factor-roots" } " on Windows and " { $snippet ".factor-roots" } " on Unix. If it exists, it is loaded every time Factor starts. It contains a newline-separated list of " { $link "vocabs.roots" } "."
$nl
"A word to run this file from an existing Factor session:"
{ $subsections load-vocab-roots } ;
ARTICLE: "rc-files" "Running code on startup"
"Factor looks for three optional files in your home directory."
{ $subsections
- "factor-boot-rc"
- "factor-rc"
- "factor-roots"
+ ".factor-boot-rc"
+ ".factor-rc"
+ ".factor-roots"
}
"The " { $snippet "-no-user-init" } " command line switch will inhibit loading running of these files."
$nl
"If you are unsure where the files should be located, evaluate the following code:"
{ $code
"USE: command-line"
- "\"factor-rc\" rc-path print"
- "\"factor-boot-rc\" rc-path print"
+ "\".factor-rc\" rc-path print"
+ "\".factor-boot-rc\" rc-path print"
}
"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration:"
{ $code
10 special-object sift [ alien>native-string ] map ;
: rc-path ( name -- path )
- os windows? [ "." prepend ] unless
home prepend-path ;
: run-bootstrap-init ( -- )
"user-init" get [
- "factor-boot-rc" rc-path ?run-file
+ ".factor-boot-rc" rc-path ?run-file
] when ;
: run-user-init ( -- )
"user-init" get [
- "factor-rc" rc-path ?run-file
+ ".factor-rc" rc-path ?run-file
] when ;
: load-vocab-roots ( -- )
"user-init" get [
- "factor-roots" rc-path dup exists? [
+ ".factor-roots" rc-path dup exists? [
utf8 file-lines harvest [ add-vocab-root ] each
] [ drop ] if
] when ;
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
[ 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 ;
GENERIC: flatten-c-type ( c-type -- pairs )
M: c-type flatten-c-type
- rep>> f 2array 1array ;
+ rep>> f f 3array 1array ;
M: long-long-type flatten-c-type
- drop 2 [ int-rep long-long-on-stack? 2array ] replicate ;
+ drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
HOOK: flatten-struct-type cpu ( type -- pairs )
+HOOK: flatten-struct-type-return cpu ( type -- pairs )
M: object flatten-struct-type
- heap-size cell align cell /i { int-rep f } <repetition> ;
+ heap-size cell align cell /i { int-rep f f } <repetition> ;
M: struct-c-type flatten-c-type
flatten-struct-type ;
+M: object flatten-struct-type-return
+ flatten-struct-type ;
+
: stack-size ( c-type -- n )
base-type flatten-c-type keys 0 [ rep-size + ] reduce ;
[| 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 ;
[ 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 ;
[ 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 )
[
[
[ [ { } assert-sequence= ] bi@ struct-return-area get ] dip
- explode-struct keys
+ explode-struct-return keys
] keep box
] if ;
! 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 ;
: ?dummy-fp-params ( rep -- )
drop dummy-fp-params? [ float-regs get [ pop* ] unless-empty ] when ;
-GENERIC: next-reg-param ( rep -- reg )
+GENERIC: next-reg-param ( odd-register? rep -- reg )
M: int-rep next-reg-param
- [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi
- int-regs get pop ;
+ [ nip ?dummy-stack-params ]
+ [ nip ?dummy-fp-params ]
+ [ drop [
+ int-regs get last even?
+ [ int-regs get pop* ] when
+ ] when ]
+ 2tri int-regs get pop ;
M: float-rep next-reg-param
- [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
+ nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
float-regs get pop ;
M: double-rep next-reg-param
- [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
+ nip [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
float-regs get pop ;
-: reg-class-full? ( reg-class -- ? ) get empty? ;
+:: reg-class-full? ( reg-class odd-register? -- ? )
+ reg-class get empty?
+ reg-class get length 1 = odd-register? and
+ dup [ reg-class get delete-all ] when or ;
: init-reg-class ( abi reg-class -- )
[ swap param-regs at <reversed> >vector ] keep set ;
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 ;
} 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
[
: 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 ;
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
CONSTANT: rt-cards-offset 10
CONSTANT: rt-decks-offset 11
CONSTANT: rt-exception-handler 12
+CONSTANT: rt-dlsym-toc 13
: rc-absolute? ( n -- ? )
${
! 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 ( -- ? )
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cpu.ppc ;
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser system kernel sequences math math.ranges
+cpu.ppc.assembler combinators compiler.constants
+bootstrap.image.private layouts namespaces ;
+IN: bootstrap.ppc
+
+4 \ cell set
+big-endian on
+
+: reserved-size ( -- n ) 24 ;
+: lr-save ( -- n ) 4 ;
+
+CONSTANT: ds-reg 14
+CONSTANT: rs-reg 15
+CONSTANT: vm-reg 16
+CONSTANT: ctx-reg 17
+CONSTANT: frame-reg 31
+: nv-int-regs ( -- seq ) 13 31 [a,b] ;
+
+: LOAD32 ( r n -- )
+ [ -16 shift 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
--- /dev/null
+! 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 ;
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cpu.ppc ;
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser system kernel sequences math math.ranges
+cpu.ppc.assembler combinators compiler.constants
+bootstrap.image.private layouts namespaces ;
+IN: bootstrap.ppc
+
+8 \ cell set
+big-endian on
+
+: reserved-size ( -- n ) 48 ;
+: lr-save ( -- n ) 16 ;
+
+CONSTANT: ds-reg 14
+CONSTANT: rs-reg 15
+CONSTANT: vm-reg 16
+CONSTANT: ctx-reg 17
+CONSTANT: frame-reg 31
+: nv-int-regs ( -- seq ) 13 31 [a,b] ;
+
+: LOAD64 ( r n -- )
+ [ dup ] dip {
+ [ nip -48 shift 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
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors system kernel layouts combinators
+compiler.cfg.builder.alien.boxing sequences arrays math
+alien.c-types cpu.architecture cpu.ppc alien.complex ;
+IN: cpu.ppc.64.linux
+
+M: linux lr-save 2 cells ;
+
+M: linux has-toc ( -- ? ) t ;
+
+M: linux reserved-area-size ( -- n ) 6 cells ;
+
+M: linux allows-null-dereference ( -- ? ) f ;
+
+M: ppc param-regs
+ drop {
+ { int-regs { 3 4 5 6 7 8 9 10 } }
+ { float-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
+ } ;
+
+M: ppc value-struct? drop t ;
+
+M: ppc dummy-stack-params? t ;
+
+M: ppc dummy-int-params? t ;
+
+M: ppc dummy-fp-params? f ;
+
+M: ppc long-long-on-stack? f ;
+
+M: ppc long-long-odd-register? f ;
+
+M: ppc float-right-align-on-stack? t ;
+
+M: ppc flatten-struct-type ( type -- seq )
+ {
+ { [ dup c-type complex-double c-type = ]
+ [ drop { { double-rep f f } { double-rep f f } } ] }
+ { [ dup c-type complex-float c-type = ]
+ [ drop { { float-rep f f } { float-rep f f } } ] }
+ [ heap-size cell align cell /i { int-rep f f } <repetition> ]
+ } cond ;
+
+M: ppc flatten-struct-type-return ( type -- seq )
+ {
+ { [ dup c-type complex-double c-type = ]
+ [ drop { { double-rep f f } { double-rep f f } } ] }
+ { [ dup c-type complex-float c-type = ]
+ [ drop { { float-rep f f } { float-rep f f } } ] }
+ [ heap-size cell align cell /i { int-rep t f } <repetition> ]
+ } cond ;
--- /dev/null
+! 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
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel kernel.private namespaces
+system cpu.ppc.assembler compiler.units compiler.constants math
+math.private math.ranges layouts words vocabs slots.private
+locals locals.backend generic.single.private fry sequences
+threads.private strings.private ;
+FROM: cpu.ppc.assembler => B ;
+IN: bootstrap.ppc
+
+: jit-call ( string -- )
+ dup
+ 0 swap jit-load-dlsym
+ 0 MTLR
+ jit-load-dlsym-toc
+ BLRL ;
+
+: jit-call-quot ( -- )
+ 4 quot-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTLR
+ BLRL ;
+
+: jit-jump-quot ( -- )
+ 4 quot-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTCTR
+ BCTR ;
+
+: stack-frame ( -- n )
+ reserved-size factor-area-size + 16 align ;
+
+: save-at ( m -- n ) reserved-size + param-size + ;
+
+: save-int ( reg off -- ) [ 1 ] dip save-at jit-save-int ;
+: save-fp ( reg off -- ) [ 1 ] dip save-at STFD ;
+: save-vec ( reg offt -- ) save-at 11 swap LI 11 1 STVXL ;
+: restore-int ( reg off -- ) [ 1 ] dip save-at jit-load-int ;
+: restore-fp ( reg off -- ) [ 1 ] dip save-at LFD ;
+: restore-vec ( reg offt -- ) save-at 11 swap LI 11 1 LVXL ;
+
+! Stop using intervals here.
+: nv-fp-regs ( -- seq ) 14 31 [a,b] ;
+: nv-vec-regs ( -- seq ) 20 31 [a,b] ;
+
+: saved-fp-regs-size ( -- n ) 144 ;
+: saved-vec-regs-size ( -- n ) 192 ;
+
+: callback-frame-size ( -- n )
+ reserved-size
+ param-size +
+ saved-int-regs-size +
+ saved-fp-regs-size +
+ saved-vec-regs-size +
+ 16 align ;
+
+: old-context-save-offset ( -- n )
+ cell-size 20 * saved-fp-regs-size + saved-vec-regs-size + save-at ;
+
+[
+ ! Save old stack pointer
+ 11 1 MR
+
+ 0 MFLR ! Get return address
+ 0 1 lr-save jit-save-cell ! Stash return address
+ 1 1 callback-frame-size neg jit-save-cell-update ! Bump stack pointer and set back chain
+
+ ! Save all non-volatile registers
+ nv-int-regs [ cell-size * save-int ] each-index
+ nv-fp-regs [ 8 * saved-int-regs-size + save-fp ] each-index
+ ! nv-vec-regs [ 16 * saved-int-regs-size saved-fp-regs-size + + save-vec ] each-index
+
+ ! Stick old stack pointer in the frame register so callbacks
+ ! can access their arguments
+ frame-reg 11 MR
+
+ ! Load VM into vm-reg
+ vm-reg jit-load-vm-arg
+
+ ! Save old context
+ 0 vm-reg vm-context-offset jit-load-cell
+ 0 1 old-context-save-offset jit-save-cell
+
+ ! Switch over to the spare context
+ 11 vm-reg vm-spare-context-offset jit-load-cell
+ 11 vm-reg vm-context-offset jit-save-cell
+
+ ! Save C callstack pointer and load Factor callstack
+ 1 11 context-callstack-save-offset jit-save-cell
+ 1 11 context-callstack-bottom-offset jit-load-cell
+
+ ! Load new data and retain stacks
+ rs-reg 11 context-retainstack-offset jit-load-cell
+ ds-reg 11 context-datastack-offset jit-load-cell
+
+ ! Call into Factor code
+ 0 jit-load-entry-point-arg
+ 0 MTLR
+ BLRL
+
+ ! Load VM again, pointlessly
+ vm-reg jit-load-vm-arg
+
+ ! Load C callstack pointer
+ 11 vm-reg vm-context-offset jit-load-cell
+ 1 11 context-callstack-save-offset jit-load-cell
+
+ ! Load old context
+ 0 1 old-context-save-offset jit-load-cell
+ 0 vm-reg vm-context-offset jit-save-cell
+
+ ! Restore non-volatile registers
+ ! nv-vec-regs [ 16 * saved-int-regs-size saved-float-regs-size + + restore-vec ] each-index
+ nv-fp-regs [ 8 * saved-int-regs-size + restore-fp ] each-index
+ nv-int-regs [ cell-size * restore-int ] each-index
+
+ 1 1 callback-frame-size ADDI ! Bump stack back up
+ 0 1 lr-save jit-load-cell ! Fetch return address
+ 0 MTLR ! Set up return
+ BLR ! Branch back
+] callback-stub jit-define
+
+: jit-conditional* ( test-quot false-quot -- )
+ [ '[ 4 + @ ] ] dip jit-conditional ; inline
+
+: jit-load-context ( -- )
+ ctx-reg vm-reg vm-context-offset jit-load-cell ;
+
+: jit-save-context ( -- )
+ jit-load-context
+ 1 ctx-reg context-callstack-top-offset jit-save-cell
+ ds-reg ctx-reg context-datastack-offset jit-save-cell
+ rs-reg ctx-reg context-retainstack-offset jit-save-cell ;
+
+: jit-restore-context ( -- )
+ ds-reg ctx-reg context-datastack-offset jit-load-cell
+ rs-reg ctx-reg context-retainstack-offset jit-load-cell ;
+
+[
+ 12 jit-load-literal-arg
+ 0 profile-count-offset LI
+ 11 12 0 jit-load-cell-x
+ 11 11 1 tag-fixnum ADDI
+ 11 12 0 jit-save-cell-x
+ 0 word-code-offset LI
+ 11 12 0 jit-load-cell-x
+ 11 11 compiled-header-size ADDI
+ 11 MTCTR
+ BCTR
+] jit-profiling jit-define
+
+[
+ 0 MFLR
+ 0 1 lr-save jit-save-cell
+ 0 jit-load-this-arg
+ 0 1 cell-size 2 * neg jit-save-cell
+ 0 stack-frame LI
+ 0 1 cell-size 1 * neg jit-save-cell
+ 1 1 stack-frame neg jit-save-cell-update
+] jit-prolog jit-define
+
+[
+ 3 jit-load-literal-arg
+ 3 ds-reg cell-size jit-save-cell-update
+] jit-push jit-define
+
+[
+ jit-save-context
+ 3 vm-reg MR
+ 4 jit-load-dlsym-arg
+ 4 MTLR
+ jit-load-dlsym-toc-arg ! Restore the TOC/GOT
+ BLRL
+ jit-restore-context
+] jit-primitive jit-define
+
+[ 0 BL rc-relative-ppc-3-pc rt-entry-point-pic jit-rel ] jit-word-call jit-define
+
+[
+ 6 jit-load-here-arg
+ 0 B rc-relative-ppc-3-pc rt-entry-point-pic-tail jit-rel
+] jit-word-jump jit-define
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 0 3 \ f type-number jit-compare-cell-imm
+ [ 0 swap BEQ ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
+ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel
+] jit-if jit-define
+
+: jit->r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 rs-reg cell-size jit-save-cell-update ;
+
+: jit-2>r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell
+ ds-reg dup 2 cell-size * SUBI
+ rs-reg dup 2 cell-size * ADDI
+ 4 rs-reg 0 jit-save-cell
+ 5 rs-reg cell-size neg jit-save-cell ;
+
+: jit-3>r ( -- )
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell
+ 6 ds-reg cell-size neg 2 * jit-load-cell
+ ds-reg dup 3 cell-size * SUBI
+ rs-reg dup 3 cell-size * ADDI
+ 4 rs-reg 0 jit-save-cell
+ 5 rs-reg cell-size neg jit-save-cell
+ 6 rs-reg cell-size neg 2 * jit-save-cell ;
+
+: jit-r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ rs-reg dup cell-size SUBI
+ 4 ds-reg cell-size jit-save-cell-update ;
+
+: jit-2r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ 5 rs-reg cell-size neg jit-load-cell
+ rs-reg dup 2 cell-size * SUBI
+ ds-reg dup 2 cell-size * ADDI
+ 4 ds-reg 0 jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell ;
+
+: jit-3r> ( -- )
+ 4 rs-reg 0 jit-load-cell
+ 5 rs-reg cell-size neg jit-load-cell
+ 6 rs-reg cell-size neg 2 * jit-load-cell
+ rs-reg dup 3 cell-size * SUBI
+ ds-reg dup 3 cell-size * ADDI
+ 4 ds-reg 0 jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell
+ 6 ds-reg cell-size neg 2 * jit-save-cell ;
+
+[
+ jit->r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-r>
+] jit-dip jit-define
+
+[
+ jit-2>r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-2r>
+] jit-2dip jit-define
+
+[
+ jit-3>r
+ 0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
+ jit-3r>
+] jit-3dip jit-define
+
+[
+ 1 1 stack-frame ADDI
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+] jit-epilog jit-define
+
+[ BLR ] jit-return jit-define
+
+! ! ! Polymorphic inline caches
+
+! Don't touch r6 here; it's used to pass the tail call site
+! address for tail PICs
+
+! Load a value from a stack position
+[
+ 4 ds-reg 0 jit-load-cell rc-absolute-ppc-2 rt-untagged jit-rel
+] pic-load jit-define
+
+[ 4 4 tag-mask get ANDI. ] pic-tag jit-define
+
+[
+ 3 4 MR
+ 4 4 tag-mask get ANDI.
+ 0 4 tuple type-number jit-compare-cell-imm
+ [ 0 swap BNE ]
+ [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
+ jit-conditional*
+] pic-tuple jit-define
+
+[
+ 0 4 0 jit-compare-cell-imm rc-absolute-ppc-2 rt-untagged jit-rel
+] pic-check-tag jit-define
+
+[
+ 5 jit-load-literal-arg
+ 0 4 5 jit-compare-cell
+] pic-check-tuple jit-define
+
+[
+ [ 0 swap BNE ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
+] pic-hit jit-define
+
+! Inline cache miss entry points
+: jit-load-return-address ( -- ) 6 MFLR ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-save-context
+ 3 6 MR
+ 4 vm-reg MR
+ ctx-reg 6 MR
+ "inline_cache_miss" jit-call
+ 6 ctx-reg MR
+ jit-load-context
+ jit-restore-context ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ 3 MTLR BLRL ]
+[ 3 MTCTR BCTR ]
+\ inline-cache-miss define-combinator-primitive
+
+[ jit-inline-cache-miss ]
+[ 3 MTLR BLRL ]
+[ 3 MTCTR BCTR ]
+\ inline-cache-miss-tail define-combinator-primitive
+
+! ! ! Megamorphic caches
+
+[
+ ! class = ...
+ 3 4 MR
+ 4 4 tag-mask get ANDI. ! Mask and...
+ 4 4 tag-bits get jit-shift-left-logical-imm ! shift tag bits to fixnum
+ 0 4 tuple type-number tag-fixnum jit-compare-cell-imm
+ [ 0 swap BNE ]
+ [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
+ jit-conditional*
+ ! cache = ...
+ 3 jit-load-literal-arg
+ ! key = hashcode(class)
+ 5 4 jit-class-hashcode
+ ! key &= cache.length - 1
+ 5 5 mega-cache-size get 1 - 4 * ANDI.
+ ! cache += array-start-offset
+ 3 3 array-start-offset ADDI
+ ! cache += key
+ 3 3 5 ADD
+ ! if(get(cache) == class)
+ 6 3 0 jit-load-cell
+ 0 6 4 jit-compare-cell
+ [ 0 swap BNE ]
+ [
+ ! megamorphic_cache_hits++
+ 4 jit-load-megamorphic-cache-arg
+ 5 4 0 jit-load-cell
+ 5 5 1 ADDI
+ 5 4 0 jit-save-cell
+ ! ... goto get(cache + cell-size)
+ 5 word-entry-point-offset LI
+ 3 3 cell-size jit-load-cell
+ 3 3 5 jit-load-cell-x
+ 3 MTCTR
+ BCTR
+ ]
+ jit-conditional*
+ ! fall-through on miss
+] mega-lookup jit-define
+
+! ! ! Sub-primitives
+
+! Quotations and words
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+]
+[ jit-call-quot ]
+[ jit-jump-quot ] \ (call) define-combinator-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 word-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+]
+[ 4 MTLR BLRL ]
+[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 4 word-entry-point-offset LI
+ 4 3 4 jit-load-cell-x
+ 4 MTCTR BCTR
+] jit-execute jit-define
+
+! Special primitives
+[
+ frame-reg 3 MR
+
+ 3 vm-reg MR
+ "begin_callback" jit-call
+
+ jit-load-context
+ jit-restore-context
+
+ ! Call quotation
+ 3 frame-reg MR
+ jit-call-quot
+
+ jit-save-context
+
+ 3 vm-reg MR
+ "end_callback" jit-call
+] \ c-to-factor define-sub-primitive
+
+[
+ ! Unwind stack frames
+ 1 4 MR
+
+ ! Load VM pointer into vm-reg, since we're entering from
+ ! C code
+ vm-reg jit-load-vm
+
+ ! Load ds and rs registers
+ jit-load-context
+ jit-restore-context
+
+ ! We have changed the stack; load return address again
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+
+ ! Call quotation
+ jit-jump-quot
+] \ unwind-native-frames define-sub-primitive
+
+[
+ 7 0 LI
+ 7 1 lr-save jit-save-cell
+
+ ! Load callstack object
+ 6 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ ! Get ctx->callstack_bottom
+ jit-load-context
+ 3 ctx-reg context-callstack-bottom-offset jit-load-cell
+ ! Get top of callstack object -- 'src' for memcpy
+ 4 6 callstack-top-offset ADDI
+ ! Get callstack length, in bytes --- 'len' for memcpy
+ 7 callstack-length-offset LI
+ 5 6 7 jit-load-cell-x
+ 5 5 jit-shift-tag-bits
+ ! Compute new stack pointer -- 'dst' for memcpy
+ 3 3 5 SUB
+ ! Install new stack pointer
+ 1 3 MR
+ ! Call memcpy; arguments are now in the correct registers
+ 1 1 -16 cell-size * jit-save-cell-update
+ "factor_memcpy" jit-call
+ 1 1 0 jit-load-cell
+ ! Return with new callstack
+ 0 1 lr-save jit-load-cell
+ 0 MTLR
+ BLR
+] \ set-callstack define-sub-primitive
+
+[
+ jit-save-context
+ 4 vm-reg MR
+ "lazy_jit_compile" jit-call
+]
+[ jit-call-quot ]
+[ jit-jump-quot ]
+\ lazy-jit-compile define-combinator-primitive
+
+! Objects
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 tag-mask get ANDI.
+ 3 3 tag-bits get jit-shift-left-logical-imm
+ 3 ds-reg 0 jit-save-cell
+] \ tag define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell ! Load m
+ 4 ds-reg cell-size neg jit-load-cell-update ! Load obj
+ 3 3 jit-shift-fixnum-slot ! Shift to a cell-size multiple
+ 4 4 jit-mask-tag-bits ! Clear tag bits on obj
+ 3 4 3 jit-load-cell-x ! Load cell at &obj[m]
+ 3 ds-reg 0 jit-save-cell ! Push the result to the stack
+] \ slot define-sub-primitive
+
+[
+ ! load string index from stack
+ 3 ds-reg cell-size neg jit-load-cell
+ 3 3 jit-shift-tag-bits
+ ! load string from stack
+ 4 ds-reg 0 jit-load-cell
+ ! load character
+ 4 4 string-offset ADDI
+ 3 3 4 LBZX
+ 3 3 tag-bits get jit-shift-left-logical-imm
+ ! store character to stack
+ ds-reg ds-reg cell-size SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ string-nth-fast define-sub-primitive
+
+! Shufflers
+[
+ ds-reg dup cell-size SUBI
+] \ drop define-sub-primitive
+
+[
+ ds-reg dup 2 cell-size * SUBI
+] \ 2drop define-sub-primitive
+
+[
+ ds-reg dup 3 cell-size * SUBI
+] \ 3drop define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg dup 2 cell-size * ADDI
+ 3 ds-reg 0 jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+] \ 2dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ ds-reg dup cell-size 3 * ADDI
+ 3 ds-reg 0 jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+ 5 ds-reg cell-size neg 2 * jit-save-cell
+] \ 3dup define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ nip define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg dup cell-size 2 * SUBI
+ 3 ds-reg 0 jit-save-cell
+] \ 2nip define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ over define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ pick define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 4 ds-reg 0 jit-save-cell
+ 3 ds-reg cell-size jit-save-cell-update
+] \ dupd define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 3 ds-reg cell-size neg jit-save-cell
+ 4 ds-reg 0 jit-save-cell
+] \ swap define-sub-primitive
+
+[
+ 3 ds-reg cell-size neg jit-load-cell
+ 4 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size neg 2 * jit-save-cell
+ 4 ds-reg cell-size neg jit-save-cell
+] \ swapd define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ 4 ds-reg cell-size neg 2 * jit-save-cell
+ 3 ds-reg cell-size neg jit-save-cell
+ 5 ds-reg 0 jit-save-cell
+] \ rot define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 ds-reg cell-size neg 2 * jit-load-cell
+ 3 ds-reg cell-size neg 2 * jit-save-cell
+ 5 ds-reg cell-size neg jit-save-cell
+ 4 ds-reg 0 jit-save-cell
+] \ -rot define-sub-primitive
+
+[ jit->r ] \ load-local define-sub-primitive
+
+! Comparisons
+: jit-compare ( insn -- )
+ t jit-literal
+ 3 jit-load-literal-arg
+ 4 ds-reg 0 jit-load-cell
+ 5 ds-reg cell-size neg jit-load-cell-update
+ 0 5 4 jit-compare-cell
+ [ 0 8 ] dip execute( cr offset -- )
+ 3 \ f type-number LI
+ 3 ds-reg 0 jit-save-cell ;
+
+: define-jit-compare ( insn word -- )
+ [ [ jit-compare ] curry ] dip define-sub-primitive ;
+
+\ BEQ \ eq? define-jit-compare
+\ BGE \ fixnum>= define-jit-compare
+\ BLE \ fixnum<= define-jit-compare
+\ BGT \ fixnum> define-jit-compare
+\ BLT \ fixnum< define-jit-compare
+
+! Math
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 3 3 4 OR
+ 3 3 tag-mask get ANDI.
+ 4 \ f type-number LI
+ 0 3 0 jit-compare-cell-imm
+ [ 0 swap BNE ] [ 4 1 tag-fixnum LI ] jit-conditional*
+ 4 ds-reg 0 jit-save-cell
+] \ both-fixnums? define-sub-primitive
+
+: jit-math ( insn -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell-update
+ [ 5 3 4 ] dip execute( dst src1 src2 -- )
+ 5 ds-reg 0 jit-save-cell ;
+
+[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
+
+[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell-update
+ 4 4 jit-shift-tag-bits
+ 5 3 4 jit-multiply-low
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum*fast define-sub-primitive
+
+[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
+
+[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
+
+[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 NOT
+ 3 3 tag-mask get XORI
+ 3 ds-reg 0 jit-save-cell
+] \ fixnum-bitnot define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell ! Load amount to shift
+ 3 3 jit-shift-tag-bits ! Shift out tag bits
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell ! Load value to shift
+ 5 4 3 jit-shift-left-logical ! Shift left
+ 6 3 NEG ! Negate shift amount
+ 7 4 6 jit-shift-right-algebraic ! Shift right
+ 7 7 jit-mask-tag-bits ! Mask out tag bits
+ 0 3 0 jit-compare-cell-imm
+ [ 0 swap BGT ] [ 5 7 MR ] jit-conditional*
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum-shift-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 5 4 3 jit-divide
+ 6 5 3 jit-multiply-low
+ 7 4 6 SUB
+ 7 ds-reg 0 jit-save-cell
+] \ fixnum-mod define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 4 ds-reg 0 jit-load-cell
+ 5 4 3 jit-divide
+ 5 5 tag-bits get jit-shift-left-logical-imm
+ 5 ds-reg 0 jit-save-cell
+] \ fixnum/i-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ 5 4 3 jit-divide
+ 6 5 3 jit-multiply-low
+ 7 4 6 SUB
+ 5 5 tag-bits get jit-shift-left-logical-imm
+ 5 ds-reg cell-size neg jit-save-cell
+ 7 ds-reg 0 jit-save-cell
+] \ fixnum/mod-fast define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ 3 3 jit-shift-fixnum-slot
+ 3 rs-reg 3 jit-load-cell-x
+ 3 ds-reg 0 jit-save-cell
+] \ get-local define-sub-primitive
+
+[
+ 3 ds-reg 0 jit-load-cell
+ ds-reg ds-reg cell-size SUBI
+ 3 3 jit-shift-fixnum-slot
+ rs-reg rs-reg 3 SUB
+] \ drop-locals define-sub-primitive
+
+! Overflowing fixnum arithmetic
+:: jit-overflow ( insn func -- )
+ ds-reg ds-reg cell-size SUBI
+ jit-save-context
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size jit-load-cell
+ 0 0 LI
+ 0 MTXER
+ 6 4 3 insn call( d a s -- )
+ 6 ds-reg 0 jit-save-cell
+ [ 0 swap BNS ]
+ [
+ 5 vm-reg MR
+ func jit-call
+ ]
+ jit-conditional* ;
+
+[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ ds-reg ds-reg cell-size SUBI
+ jit-save-context
+ 3 ds-reg 0 jit-load-cell
+ 3 3 jit-shift-tag-bits
+ 4 ds-reg cell-size jit-load-cell
+ 0 0 LI
+ 0 MTXER
+ 6 3 4 jit-multiply-low-ov-rc
+ 6 ds-reg 0 jit-save-cell
+ [ 0 swap BNS ]
+ [
+ 4 4 jit-shift-tag-bits
+ 5 vm-reg MR
+ "overflow_fixnum_multiply" jit-call
+ ]
+ jit-conditional*
+] \ fixnum* define-sub-primitive
+
+! Contexts
+:: jit-switch-context ( reg -- )
+ 7 0 LI
+ 7 1 lr-save jit-save-cell
+
+ ! Make the new context the current one
+ ctx-reg reg MR
+ ctx-reg vm-reg vm-context-offset jit-save-cell
+
+ ! Load new stack pointer
+ 1 ctx-reg context-callstack-top-offset jit-load-cell
+
+ ! Load new ds, rs registers
+ jit-restore-context ;
+
+: jit-pop-context-and-param ( -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 alien-offset LI
+ 3 3 4 jit-load-cell-x
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg ds-reg cell-size 2 * SUBI ;
+
+: jit-push-param ( -- )
+ ds-reg ds-reg cell-size ADDI
+ 4 ds-reg 0 jit-save-cell ;
+
+: jit-set-context ( -- )
+ jit-pop-context-and-param
+ jit-save-context
+ 3 jit-switch-context
+ jit-push-param ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-pop-quot-and-param ( -- )
+ 3 ds-reg 0 jit-load-cell
+ 4 ds-reg cell-size neg jit-load-cell
+ ds-reg ds-reg cell-size 2 * SUBI ;
+
+: jit-start-context ( -- )
+ ! Create the new context in return-reg. Have to save context
+ ! twice, first before calling new_context() which may GC,
+ ! and again after popping the two parameters from the stack.
+ jit-save-context
+ 3 vm-reg MR
+ "new_context" jit-call
+
+ 6 3 MR
+ jit-pop-quot-and-param
+ jit-save-context
+ 6 jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+ jit-load-context
+ 3 vm-reg MR
+ 4 ctx-reg MR
+ "delete_context" jit-call ;
+
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+: jit-start-context-and-delete ( -- )
+ jit-load-context
+ 3 vm-reg MR
+ 4 ctx-reg MR
+ "reset_context" jit-call
+ jit-pop-quot-and-param
+ ctx-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[
+ jit-start-context-and-delete
+] \ (start-context-and-delete) define-sub-primitive
+
+[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
--- /dev/null
+! Copyright (C) 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
--- /dev/null
+32-bit and 64-bit PowerPC compiler backends
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 ;
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 <= ;
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? ;
{ $subsections edit }
"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } ":"
{ $code "USE: editors.emacs" }
-"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link "factor-boot-rc" } "."
+"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link ".factor-boot-rc" } "."
$nl
"Editor integration vocabularies store a quotation in a global variable when loaded:"
{ $subsections edit-hook }
: make-event ( fd events -- event )
epoll-event <struct>
swap >>events
- swap >>fd ;
+ swap over data>> fd<< ;
:: do-epoll-ctl ( fd mx what events -- )
mx fd>> what fd fd events make-event epoll_ctl io-error ;
epoll_wait multiplexer-error ;
: handle-event ( event mx -- )
- [ fd>> ] dip
+ [ data>> fd>> ] dip
[ EPOLLIN EPOLLOUT bitor do-epoll-del ]
[ input-available ] [ output-available ] 2tri ;
USING: alien.data kernel bit-arrays sequences assocs math
namespaces accessors math.order locals fry io.ports
io.backend.unix io.backend.unix.multiplexers unix unix.ffi
-unix.time ;
+unix.time layouts ;
IN: io.backend.unix.multiplexers.select
TUPLE: select-mx < mx read-fdset write-fdset ;
! FD_SET to be an array of cells, so we have to account for
! byte order differences on big endian platforms
: munge ( i -- i' )
- little-endian? [ BIN: 11000 bitxor ] unless ; inline
+ little-endian? [
+ cell 4 = [ BIN: 11000 ] [ BIN: 111000 ] if
+ bitxor ] unless ; inline
: <select-mx> ( -- mx )
select-mx new-mx
: wait-for-stdin ( stdin -- size )
[ control>> CHAR: X over io:stream-write1 io:stream-flush ]
- [ size>> ssize_t heap-size swap io:stream-read int deref ]
+ [ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ;
:: refill-stdin ( buffer stdin size -- )
io.backend.unix io.directories io.encodings.binary
io.encodings.utf8 io.files io.pathnames io.files.types kernel
math.bitwise sequences system unix unix.stat vocabs.loader
-classes.struct unix.ffi literals ;
+classes.struct unix.ffi literals libc ;
IN: io.directories.unix
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
M: unix find-next-file ( DIR* -- byte-array )
dirent <struct>
f void* <ref>
- [ readdir_r 0 = [ (io-error) ] unless ] 2keep
+ 0 set-errno
+ [ readdir_r 0 = [ errno 0 = [ (io-error) ] unless ] unless ] 2keep
void* deref [ drop f ] unless ;
: dirent-type>file-type ( ch -- type )
IN: listener
GENERIC: stream-read-quot ( stream -- quot/f )
+GENERIC# prompt. 1 ( stream prompt -- )
+
+: prompt ( -- str )
+ current-vocab name>> auto-use? get [ " - auto" append ] when
+ "( " " )" surround ;
+
+M: object prompt.
+ nip H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl
+ flush ;
: parse-lines-interactive ( lines -- quot/f )
[ parse-lines ] with-compilation-unit ;
] each
] tabular-output nl
] unless-empty ;
-
+
: trimmed-stack. ( seq -- )
dup length max-stack-items get > [
max-stack-items get cut*
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
] [ drop ] if ;
-: prompt. ( -- )
- current-vocab name>> auto-use? get [ " - auto" append ] when "( " " )" surround
- H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
-
:: (listener) ( datastack -- )
error-summary? get [ error-summary ] when
visible-vars.
datastack datastack.
- prompt.
+ input-stream get prompt prompt.
[
read-quot [
blas-fortran-abi
deploy-blas?
}
-"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:"
+"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link ".factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet ".factor-rc" } " would look like this:"
{ $code """
USING: math.blas.config namespaces ;
"X:\\path\\to\\acml.dll" blas-library set-global
-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
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 )
ppc-fpu-env (struct)
set_ppc_vmx_env ;
M: ppc (fp-env-registers)
- <ppc-fpu-env> <ppc-vmx-env> 2array ;
+ <ppc-fpu-env> 1array ;
CONSTANT: ppc-exception-flag-bits HEX: fff8,0700
CONSTANT: ppc-exception-flag>bit
} ;
ARTICLE: "smtp-gmail" "Setting up SMTP with gmail"
-"If you plan to send all email from the same address, then setting variables in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link "factor-boot-rc" } "." $nl
+"If you plan to send all email from the same address, then setting variables in the global namespace is the best option. The code example below does this approach and is meant to go in your " { $link ".factor-boot-rc" } "." $nl
"Several variables need to be set for sending outgoing mail through gmail. First, we set the login and password to a " { $link <plain-auth> } " tuple with our login. Next, we set the gmail server address with an " { $link <inet> } " object. Finally, we tell the SMTP library to use a secure connection."
{ $code
"USING: smtp namespaces io.sockets ;"
\ (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
USING: io.files io.files.temp io words alien kernel math.parser
alien.syntax io.launcher assocs arrays sequences namespaces make
system math io.encodings.ascii accessors tools.disassembler
-tools.disassembler.private ;
+tools.disassembler.private locals ;
IN: tools.disassembler.gdb
SINGLETON: gdb-disassembler
: out-file ( -- path ) "gdb-out.txt" temp-file ;
-: make-disassemble-cmd ( from to -- )
+:: make-disassemble-cmd ( from to -- )
in-file ascii [
"attach " write
current-process-handle number>string print
- "disassemble " write
- [ number>string write bl ] bi@
+ "x/" write to from - 4 / number>string write
+ "i" write bl from number>string write
] with-file-writer ;
: gdb-binary ( -- string ) "gdb" ;
[ home ] dip append-path touch. ;
: scaffold-factor-boot-rc ( -- )
- os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ;
+ ".factor-boot-rc" scaffold-rc ;
: scaffold-factor-rc ( -- )
- os windows? "factor-rc" ".factor-rc" ? scaffold-rc ;
+ ".factor-rc" scaffold-rc ;
HOOK: scaffold-emacs os ( -- )
ui.backend.gtk.io ui.clipboards ui.event-loop ui.gadgets
ui.gadgets.private ui.gadgets.worlds ui.gestures
ui.pixel-formats ui.pixel-formats.private ui.private
-vocabs.loader ;
+vocabs.loader combinators prettyprint io ;
IN: ui.backend.gtk
SINGLETON: gtk-ui-backend
: on-leave ( win event user-data -- ? )
3drop forget-rollover t ;
-: on-button-press ( win event user-data -- ? )
- drop swap [
- mouse-event>gesture [ <button-down> ] dip
- ] dip window send-button-down t ;
-
-: on-button-release ( win event user-data -- ? )
- drop swap [
- mouse-event>gesture [ <button-up> ] dip
- ] dip window send-button-up t ;
+:: on-button-press ( win event user-data -- ? )
+ win window :> world
+ event mouse-event>gesture :> ( modifiers button loc )
+ button {
+ { 8 [ ] }
+ { 9 [ ] }
+ [ modifiers swap <button-down> loc world
+ send-button-down ]
+ } case t ;
+
+:: on-button-release ( win event user-data -- ? )
+ win window :> world
+ event mouse-event>gesture :> ( modifiers button loc )
+ button {
+ { 8 [ world left-action send-action ] }
+ { 9 [ world right-action send-action ] }
+ [ modifiers swap <button-up> loc world
+ send-button-up ]
+ } case t ;
: on-scroll ( win event user-data -- ? )
drop swap [
editor "selection" f {
{ T{ button-down f { S+ } 1 } extend-selection }
{ T{ button-up f { S+ } 1 } com-copy-selection }
- { T{ drag } drag-selection }
+ { T{ drag { # 1 } } drag-selection }
{ gain-focus focus-editor }
{ lose-focus unfocus-editor }
{ delete-action remove-selection }
{ T{ button-down f { S+ } 1 } [ select-to-caret ] }
{ T{ button-up f { S+ } 1 } [ end-selection ] }
{ T{ button-up } [ end-selection ] }
- { T{ drag } [ extend-selection ] }
+ { T{ drag { # 1 } } [ extend-selection ] }
{ copy-action [ com-copy ] }
{ T{ button-down f f 3 } [ pane-menu ] }
} set-gestures
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: unix.linux.epoll
-USING: alien.c-types alien.syntax classes.struct math ;
+USING: alien.c-types alien.syntax classes.struct math unix.types ;
FUNCTION: int epoll_create ( int size ) ;
+UNION-STRUCT: epoll-data
+ { ptr void* }
+ { fd int }
+ { u32 uint32_t }
+ { u64 uint64_t } ;
+
STRUCT: epoll-event
-{ events uint }
-{ fd uint }
-{ padding uint } ;
+ { events uint32_t }
+ { data epoll-data } ;
FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll-event* event ) ;
CONSTANT: EPOLLMSG HEX: 400
CONSTANT: EPOLLERR HEX: 008
CONSTANT: EPOLLHUP HEX: 010
+CONSTANT: EPOLLRDHUP HEX: 2000
: EPOLLONESHOT ( -- n ) 30 2^ ; inline
: EPOLLET ( -- n ) 31 2^ ; inline
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
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
{ "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 )) }
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
{ "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 )
"The first way is to use an environment variable. Factor looks at the " { $snippet "FACTOR_ROOTS" } " environment variable for a list of " { $snippet ":" } "-separated paths (on Unix) or a list of " { $snippet ";" } "-separated paths (on Windows)."
$nl
"The second way is to create a configuration file. You can list additional vocabulary roots in a file that Factor reads at startup:"
-{ $subsections "factor-roots" }
-"Finally, you can add vocabulary roots by calling a word from your " { $snippet "factor-rc" } " file (see " { $link "factor-rc" } "):"
+{ $subsections ".factor-roots" }
+"Finally, you can add vocabulary roots by calling a word from your " { $snippet ".factor-rc" } " file (see " { $link ".factor-rc" } "):"
{ $subsections add-vocab-root } ;
ARTICLE: "vocabs.roots" "Vocabulary roots"
HELP: add-vocab-root
{ $values { "root" "a pathname string" } }
{ $description "Adds a directory pathname to the list of vocabulary roots." }
-{ $see-also "factor-roots" } ;
+{ $see-also ".factor-roots" } ;
HELP: find-vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
+++ /dev/null
-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
+++ /dev/null
-! 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
-
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! 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 ;
-
+++ /dev/null
-PowerPC assembler
--- /dev/null
+USING: alien alien.c-types alien.libraries alien.syntax
+classes.struct combinators system unix.types ;
+IN: llvm.clang.ffi
+
+<<
+"libclang" {
+ { [ os macosx? ] [ "libclang.dylib" ] }
+ { [ os windows? ] [ "clang.dll" ] }
+ { [ os unix? ] [ "/usrlibclang.so" ] }
+} cond cdecl add-library
+>>
+LIBRARY: libclang
+
+C-TYPE: CXTranslationUnitImpl
+
+TYPEDEF: void* CXIndex
+TYPEDEF: CXTranslationUnitImpl* CXTranslationUnit
+TYPEDEF: void* CXClientData
+
+STRUCT: CXUnsavedFile
+ { Filename c-string }
+ { Contents c-string }
+ { Length ulong } ;
+
+ENUM: CXAvailabilityKind
+ CXAvailability_Available
+ CXAvailability_Deprecated
+ CXAvailability_NotAvailable ;
+
+STRUCT: CXString
+ { data void* }
+ { private_flags uint } ;
+
+FUNCTION: c-string clang_getCString ( CXString string ) ;
+FUNCTION: void clang_disposeString ( CXString string ) ;
+
+FUNCTION: CXIndex clang_createIndex ( int excludeDeclarationsFromPCH,
+ int displayDiagnostics ) ;
+FUNCTION: void clang_disposeIndex ( CXIndex index ) ;
+
+TYPEDEF: void* CXFile
+
+FUNCTION: CXString clang_getFileName ( CXFile SFile ) ;
+FUNCTION: time_t clang_getFileTime ( CXFile SFile ) ;
+FUNCTION: uint clang_isFileMultipleIncludeGuarded ( CXTranslationUnit tu, CXFile file ) ;
+FUNCTION: CXFile clang_getFile ( CXTranslationUnit tu, c-string file_name ) ;
+
+STRUCT: CXSourceLocation
+ { ptr_data void*[2] }
+ { int_data uint } ;
+
+STRUCT: CXSourceRange
+ { ptr_data void*[2] }
+ { begin_int_data uint }
+ { end_int_data uint } ;
+
+FUNCTION: CXSourceLocation clang_getNullLocation ( ) ;
+FUNCTION: uint clang_equalLocations ( CXSourceLocation loc1, CXSourceLocation loc2 ) ;
+
+FUNCTION: CXSourceLocation clang_getLocation ( CXTranslationUnit tu, CXFile file, uint line, uint column ) ;
+FUNCTION: CXSourceLocation clang_getLocationForOffset ( CXTranslationUnit tu,
+ CXFile file,
+ uint offset ) ;
+
+FUNCTION: CXSourceRange clang_getNullRange ( ) ;
+
+FUNCTION: CXSourceRange clang_getRange ( CXSourceLocation begin,
+ CXSourceLocation end ) ;
+
+FUNCTION: void clang_getInstantiationLocation ( CXSourceLocation location,
+ CXFile* file,
+ uint* line,
+ uint* column,
+ uint* offset ) ;
+
+FUNCTION: void clang_getSpellingLocation ( CXSourceLocation location,
+ CXFile* file,
+ uint* line,
+ uint* column,
+ uint* offset ) ;
+
+FUNCTION: CXSourceLocation clang_getRangeStart ( CXSourceRange range ) ;
+FUNCTION: CXSourceLocation clang_getRangeEnd ( CXSourceRange range ) ;
+
+ENUM: CXDiagnosticSeverity
+ CXDiagnostic_Ignored
+ CXDiagnostic_Note
+ CXDiagnostic_Warning
+ CXDiagnostic_Error
+ CXDiagnostic_Fatal ;
+
+TYPEDEF: void* CXDiagnostic
+
+FUNCTION: uint clang_getNumDiagnostics ( CXTranslationUnit Unit ) ;
+FUNCTION: CXDiagnostic clang_getDiagnostic ( CXTranslationUnit Unit,
+ uint Index ) ;
+FUNCTION: void clang_disposeDiagnostic ( CXDiagnostic Diagnostic ) ;
+
+ENUM: CXDiagnosticDisplayOptions
+ { CXDiagnostic_DisplaySourceLocation HEX: 01 }
+ { CXDiagnostic_DisplayColumn HEX: 02 }
+ { CXDiagnostic_DisplaySourceRanges HEX: 04 }
+ { CXDiagnostic_DisplayOption HEX: 08 }
+ { CXDiagnostic_DisplayCategoryId HEX: 10 }
+ { CXDiagnostic_DisplayCategoryName HEX: 20 } ;
+
+FUNCTION: CXString clang_formatDiagnostic ( CXDiagnostic Diagnostic,
+ uint Options ) ;
+FUNCTION: uint clang_defaultDiagnosticDisplayOptions ( ) ;
+
+FUNCTION: CXDiagnosticSeverity clang_getDiagnosticSeverity ( CXDiagnostic ) ;
+FUNCTION: CXSourceLocation clang_getDiagnosticLocation ( CXDiagnostic ) ;
+FUNCTION: CXString clang_getDiagnosticSpelling ( CXDiagnostic ) ;
+FUNCTION: CXString clang_getDiagnosticOption ( CXDiagnostic Diag, CXString* Disable ) ;
+FUNCTION: uint clang_getDiagnosticCategory ( CXDiagnostic ) ;
+FUNCTION: CXString clang_getDiagnosticCategoryName ( uint Category ) ;
+FUNCTION: uint clang_getDiagnosticNumRanges ( CXDiagnostic ) ;
+FUNCTION: CXSourceRange clang_getDiagnosticRange ( CXDiagnostic Diagnostic, uint Range ) ;
+FUNCTION: uint clang_getDiagnosticNumFixIts ( CXDiagnostic Diagnostic ) ;
+FUNCTION: CXString clang_getDiagnosticFixIt ( CXDiagnostic Diagnostic,
+ uint FixIt,
+ CXSourceRange* ReplacementRange ) ;
+FUNCTION: CXString clang_getTranslationUnitSpelling ( CXTranslationUnit CTUnit ) ;
+FUNCTION: CXTranslationUnit clang_createTranslationUnitFromSourceFile ( CXIndex CIdx,
+ c-string source_filename,
+ int num_clang_command_line_args,
+ char** clang_command_line_args,
+ uint num_unsaved_files,
+ CXUnsavedFile* unsaved_files ) ;
+FUNCTION: CXTranslationUnit clang_createTranslationUnit ( CXIndex CIdx, c-string ast_filename ) ;
+
+ENUM: CXTranslationUnit_Flags
+ { CXTranslationUnit_None HEX: 00 }
+ { CXTranslationUnit_DetailedPreprocessingRecord HEX: 01 }
+ { CXTranslationUnit_Incomplete HEX: 02 }
+ { CXTranslationUnit_PrecompiledPreamble HEX: 04 }
+ { CXTranslationUnit_CacheCompletionResults HEX: 08 }
+ { CXTranslationUnit_CXXPrecompiledPreamble HEX: 10 }
+ { CXTranslationUnit_CXXChainedPCH HEX: 20 }
+ { CXTranslationUnit_NestedMacroInstantiations HEX: 40 } ;
+
+FUNCTION: uint clang_defaultEditingTranslationUnitOptions ( ) ;
+FUNCTION: CXTranslationUnit clang_parseTranslationUnit ( CXIndex CIdx,
+ c-string source_filename,
+ char** command_line_args,
+ int num_command_line_args,
+ CXUnsavedFile* unsaved_files,
+ uint num_unsaved_files,
+ uint options ) ;
+
+ENUM: CXSaveTranslationUnit_Flags CXSaveTranslationUnit_None ;
+
+FUNCTION: uint clang_defaultSaveOptions ( CXTranslationUnit TU ) ;
+FUNCTION: int clang_saveTranslationUnit ( CXTranslationUnit TU,
+ c-string FileName,
+ uint options ) ;
+FUNCTION: void clang_disposeTranslationUnit ( CXTranslationUnit ) ;
+
+ENUM: CXReparse_Flags CXReparse_None ;
+
+FUNCTION: uint clang_defaultReparseOptions ( CXTranslationUnit TU ) ;
+FUNCTION: int clang_reparseTranslationUnit ( CXTranslationUnit TU,
+ uint num_unsaved_files,
+ CXUnsavedFile* unsaved_files,
+ uint options ) ;
+
+ENUM: CXTUResourceUsageKind
+ { CXTUResourceUsage_AST 1 }
+ { CXTUResourceUsage_Identifiers 2 }
+ { CXTUResourceUsage_Selectors 3 }
+ { CXTUResourceUsage_GlobalCompletionResults 4 }
+ { CXTUResourceUsage_SourceManagerContentCache 5 }
+ { CXTUResourceUsage_AST_SideTables 6 }
+ { CXTUResourceUsage_SourceManager_Membuffer_Malloc 7 }
+ { CXTUResourceUsage_SourceManager_Membuffer_MMap 8 }
+ { CXTUResourceUsage_ExternalASTSource_Membuffer_Malloc 9 }
+ { CXTUResourceUsage_ExternalASTSource_Membuffer_MMap 10 }
+ { CXTUResourceUsage_Preprocessor 11 }
+ { CXTUResourceUsage_PreprocessingRecord 12 }
+ { CXTUResourceUsage_MEMORY_IN_BYTES_BEGIN 1 }
+ { CXTUResourceUsage_MEMORY_IN_BYTES_END 12 }
+ { CXTUResourceUsage_First 1 }
+ { CXTUResourceUsage_Last 12 } ;
+
+FUNCTION: c-string clang_getTUResourceUsageName ( CXTUResourceUsageKind kind ) ;
+
+STRUCT: CXTUResourceUsageEntry
+ { kind CXTUResourceUsageKind }
+ { amount ulong } ;
+
+STRUCT: CXTUResourceUsage
+ { data void* }
+ { numEntries uint }
+ { entries CXTUResourceUsageEntry* } ;
+
+FUNCTION: CXTUResourceUsage clang_getCXTUResourceUsage ( CXTranslationUnit TU ) ;
+FUNCTION: void clang_disposeCXTUResourceUsage ( CXTUResourceUsage usage ) ;
+
+ENUM: CXCursorKind
+ { CXCursor_UnexposedDecl 1 }
+ { CXCursor_StructDecl 2 }
+ { CXCursor_UnionDecl 3 }
+ { CXCursor_ClassDecl 4 }
+ { CXCursor_EnumDecl 5 }
+ { CXCursor_FieldDecl 6 }
+ { CXCursor_EnumConstantDecl 7 }
+ { CXCursor_FunctionDecl 8 }
+ { CXCursor_VarDecl 9 }
+ { CXCursor_ParmDecl 10 }
+ { CXCursor_ObjCInterfaceDecl 11 }
+ { CXCursor_ObjCCategoryDecl 12 }
+ { CXCursor_ObjCProtocolDecl 13 }
+ { CXCursor_ObjCPropertyDecl 14 }
+ { CXCursor_ObjCIvarDecl 15 }
+ { CXCursor_ObjCInstanceMethodDecl 16 }
+ { CXCursor_ObjCClassMethodDecl 17 }
+ { CXCursor_ObjCImplementationDecl 18 }
+ { CXCursor_ObjCCategoryImplDecl 19 }
+ { CXCursor_TypedefDecl 20 }
+ { CXCursor_CXXMethod 21 }
+ { CXCursor_Namespace 22 }
+ { CXCursor_LinkageSpec 23 }
+ { CXCursor_Constructor 24 }
+ { CXCursor_Destructor 25 }
+ { CXCursor_ConversionFunction 26 }
+ { CXCursor_TemplateTypeParameter 27 }
+ { CXCursor_NonTypeTemplateParameter 28 }
+ { CXCursor_TemplateTemplateParameter 29 }
+ { CXCursor_FunctionTemplate 30 }
+ { CXCursor_ClassTemplate 31 }
+ { CXCursor_ClassTemplatePartialSpecialization 32 }
+ { CXCursor_NamespaceAlias 33 }
+ { CXCursor_UsingDirective 34 }
+ { CXCursor_UsingDeclaration 35 }
+ { CXCursor_TypeAliasDecl 36 }
+ { CXCursor_FirstDecl 1 }
+ { CXCursor_LastDecl 36 }
+ { CXCursor_FirstRef 40 }
+ { CXCursor_ObjCSuperClassRef 40 }
+ { CXCursor_ObjCProtocolRef 41 }
+ { CXCursor_ObjCClassRef 42 }
+ { CXCursor_TypeRef 43 }
+ { CXCursor_CXXBaseSpecifier 44 }
+ { CXCursor_TemplateRef 45 }
+ { CXCursor_NamespaceRef 46 }
+ { CXCursor_MemberRef 47 }
+ { CXCursor_LabelRef 48 }
+ { CXCursor_OverloadedDeclRef 49 }
+ { CXCursor_LastRef 49 }
+ { CXCursor_FirstInvalid 70 }
+ { CXCursor_InvalidFile 70 }
+ { CXCursor_NoDeclFound 71 }
+ { CXCursor_NotImplemented 72 }
+ { CXCursor_InvalidCode 73 }
+ { CXCursor_LastInvalid 73 }
+ { CXCursor_FirstExpr 100 }
+ { CXCursor_UnexposedExpr 100 }
+ { CXCursor_DeclRefExpr 101 }
+ { CXCursor_MemberRefExpr 102 }
+ { CXCursor_CallExpr 103 }
+ { CXCursor_ObjCMessageExpr 104 }
+ { CXCursor_BlockExpr 105 }
+ { CXCursor_LastExpr 105 }
+ { CXCursor_FirstStmt 200 }
+ { CXCursor_UnexposedStmt 200 }
+ { CXCursor_LabelStmt 201 }
+ { CXCursor_LastStmt 201 }
+ { CXCursor_TranslationUnit 300 }
+ { CXCursor_FirstAttr 400 }
+ { CXCursor_UnexposedAttr 400 }
+ { CXCursor_IBActionAttr 401 }
+ { CXCursor_IBOutletAttr 402 }
+ { CXCursor_IBOutletCollectionAttr 403 }
+ { CXCursor_LastAttr 403 }
+ { CXCursor_PreprocessingDirective 500 }
+ { CXCursor_MacroDefinition 501 }
+ { CXCursor_MacroInstantiation 502 }
+ { CXCursor_InclusionDirective 503 }
+ { CXCursor_FirstPreprocessing 500 }
+ { CXCursor_LastPreprocessing 503 } ;
+
+STRUCT: CXCursor
+ { kind CXCursorKind }
+ { data void*[3] } ;
+
+FUNCTION: CXCursor clang_getNullCursor ( ) ;
+FUNCTION: CXCursor clang_getTranslationUnitCursor ( CXTranslationUnit ) ;
+FUNCTION: uint clang_equalCursors ( CXCursor c1, CXCursor c2 ) ;
+FUNCTION: uint clang_hashCursor ( CXCursor ) ;
+FUNCTION: CXCursorKind clang_getCursorKind ( CXCursor ) ;
+FUNCTION: uint clang_isDeclaration ( CXCursorKind ) ;
+FUNCTION: uint clang_isReference ( CXCursorKind ) ;
+FUNCTION: uint clang_isExpression ( CXCursorKind ) ;
+FUNCTION: uint clang_isStatement ( CXCursorKind ) ;
+FUNCTION: uint clang_isInvalid ( CXCursorKind ) ;
+FUNCTION: uint clang_isTranslationUnit ( CXCursorKind ) ;
+FUNCTION: uint clang_isPreprocessing ( CXCursorKind ) ;
+FUNCTION: uint clang_isUnexposed ( CXCursorKind ) ;
+
+ENUM: CXLinkageKind
+ CXLinkage_Invalid
+ CXLinkage_NoLinkage
+ CXLinkage_Internal
+ CXLinkage_UniqueExternal
+ CXLinkage_External ;
+
+ENUM: CXLanguageKind
+ CXLanguage_Invalid
+ CXLanguage_C
+ CXLanguage_ObjC
+ CXLanguage_CPlusPlus ;
+
+FUNCTION: CXLinkageKind clang_getCursorLinkage ( CXCursor cursor ) ;
+FUNCTION: CXAvailabilityKind clang_getCursorAvailability ( CXCursor cursor ) ;
+FUNCTION: CXLanguageKind clang_getCursorLanguage ( CXCursor cursor ) ;
+
+C-TYPE: CXCursorSetImpl
+TYPEDEF: CXCursorSetImpl* CXCursorSet
+
+FUNCTION: CXCursorSet clang_createCXCursorSet ( ) ;
+FUNCTION: void clang_disposeCXCursorSet ( CXCursorSet cset ) ;
+FUNCTION: uint clang_CXCursorSet_contains ( CXCursorSet cset, CXCursor cursor ) ;
+FUNCTION: uint clang_CXCursorSet_insert ( CXCursorSet cset, CXCursor cursor ) ;
+FUNCTION: CXCursor clang_getCursorSemanticParent ( CXCursor cursor ) ;
+FUNCTION: CXCursor clang_getCursorLexicalParent ( CXCursor cursor ) ;
+FUNCTION: void clang_getOverriddenCursors ( CXCursor cursor, CXCursor** overridden, uint* num_overridden ) ;
+FUNCTION: void clang_disposeOverriddenCursors ( CXCursor* overridden ) ;
+FUNCTION: CXFile clang_getIncludedFile ( CXCursor cursor ) ;
+FUNCTION: CXCursor clang_getCursor ( CXTranslationUnit TU,
+ CXSourceLocation location ) ;
+FUNCTION: CXSourceLocation clang_getCursorLocation ( CXCursor ) ;
+FUNCTION: CXSourceRange clang_getCursorExtent ( CXCursor ) ;
+
+ENUM: CXTypeKind
+ { CXType_Invalid 0 }
+ { CXType_Unexposed 1 }
+ { CXType_Void 2 }
+ { CXType_Bool 3 }
+ { CXType_Char_U 4 }
+ { CXType_UChar 5 }
+ { CXType_Char16 6 }
+ { CXType_Char32 7 }
+ { CXType_UShort 8 }
+ { CXType_UInt 9 }
+ { CXType_ULong 10 }
+ { CXType_ULongLong 11 }
+ { CXType_UInt128 12 }
+ { CXType_Char_S 13 }
+ { CXType_SChar 14 }
+ { CXType_WChar 15 }
+ { CXType_Short 16 }
+ { CXType_Int 17 }
+ { CXType_Long 18 }
+ { CXType_LongLong 19 }
+ { CXType_Int128 20 }
+ { CXType_Float 21 }
+ { CXType_Double 22 }
+ { CXType_LongDouble 23 }
+ { CXType_NullPtr 24 }
+ { CXType_Overload 25 }
+ { CXType_Dependent 26 }
+ { CXType_ObjCId 27 }
+ { CXType_ObjCClass 28 }
+ { CXType_ObjCSel 29 }
+ { CXType_FirstBuiltin 2 }
+ { CXType_LastBuiltin 29 }
+ { CXType_Complex 100 }
+ { CXType_Pointer 101 }
+ { CXType_BlockPointer 102 }
+ { CXType_LValueReference 103 }
+ { CXType_RValueReference 104 }
+ { CXType_Record 105 }
+ { CXType_Enum 106 }
+ { CXType_Typedef 107 }
+ { CXType_ObjCInterface 108 }
+ { CXType_ObjCObjectPointer 109 }
+ { CXType_FunctionNoProto 110 }
+ { CXType_FunctionProto 111 } ;
+
+STRUCT: CXType
+ { kind CXTypeKind }
+ { data void*[2] } ;
+
+FUNCTION: CXType clang_getCursorType ( CXCursor C ) ;
+FUNCTION: uint clang_equalTypes ( CXType A, CXType B ) ;
+FUNCTION: CXType clang_getCanonicalType ( CXType T ) ;
+FUNCTION: uint clang_isConstQualifiedType ( CXType T ) ;
+FUNCTION: uint clang_isVolatileQualifiedType ( CXType T ) ;
+FUNCTION: uint clang_isRestrictQualifiedType ( CXType T ) ;
+FUNCTION: CXType clang_getPointeeType ( CXType T ) ;
+FUNCTION: CXCursor clang_getTypeDeclaration ( CXType T ) ;
+FUNCTION: CXString clang_getDeclObjCTypeEncoding ( CXCursor C ) ;
+FUNCTION: CXString clang_getTypeKindSpelling ( CXTypeKind K ) ;
+FUNCTION: CXType clang_getResultType ( CXType T ) ;
+FUNCTION: CXType clang_getCursorResultType ( CXCursor C ) ;
+FUNCTION: uint clang_isPODType ( CXType T ) ;
+FUNCTION: uint clang_isVirtualBase ( CXCursor ) ;
+
+ENUM: CX_CXXAccessSpecifier
+ CX_CXXInvalidAccessSpecifier
+ CX_CXXPublic
+ CX_CXXProtected
+ CX_CXXPrivate ;
+
+FUNCTION: CX_CXXAccessSpecifier clang_getCXXAccessSpecifier ( CXCursor ) ;
+FUNCTION: uint clang_getNumOverloadedDecls ( CXCursor cursor ) ;
+FUNCTION: CXCursor clang_getOverloadedDecl ( CXCursor cursor, uint index ) ;
+FUNCTION: CXType clang_getIBOutletCollectionType ( CXCursor ) ;
+
+ENUM: CXChildVisitResult
+ CXChildVisit_Break
+ CXChildVisit_Continue
+ CXChildVisit_Recurse ;
+
+CALLBACK: CXChildVisitResult CXCursorVisitor ( CXCursor cursor,
+ CXCursor parent,
+ CXClientData client_data ) ;
+
+FUNCTION: uint clang_visitChildren ( CXCursor parent,
+ CXCursorVisitor visitor,
+ CXClientData client_data ) ;
+FUNCTION: CXString clang_getCursorUSR ( CXCursor ) ;
+FUNCTION: CXString clang_constructUSR_ObjCClass ( c-string class_name ) ;
+FUNCTION: CXString clang_constructUSR_ObjCCategory ( c-string class_name,
+ c-string category_name ) ;
+FUNCTION: CXString clang_constructUSR_ObjCProtocol ( c-string protocol_name ) ;
+FUNCTION: CXString clang_constructUSR_ObjCIvar ( c-string name,
+ CXString classUSR ) ;
+FUNCTION: CXString clang_constructUSR_ObjCMethod ( c-string name,
+ uint isInstanceMethod,
+ CXString classUSR ) ;
+FUNCTION: CXString clang_constructUSR_ObjCProperty ( c-string property,
+ CXString classUSR ) ;
+FUNCTION: CXString clang_getCursorSpelling ( CXCursor ) ;
+FUNCTION: CXString clang_getCursorDisplayName ( CXCursor ) ;
+FUNCTION: CXCursor clang_getCursorReferenced ( CXCursor ) ;
+FUNCTION: CXCursor clang_getCursorDefinition ( CXCursor ) ;
+FUNCTION: uint clang_isCursorDefinition ( CXCursor ) ;
+FUNCTION: CXCursor clang_getCanonicalCursor ( CXCursor ) ;
+FUNCTION: uint clang_CXXMethod_isStatic ( CXCursor C ) ;
+FUNCTION: uint clang_CXXMethod_isVirtual ( CXCursor C ) ;
+FUNCTION: CXCursorKind clang_getTemplateCursorKind ( CXCursor C ) ;
+FUNCTION: CXCursor clang_getSpecializedCursorTemplate ( CXCursor C ) ;
+
+ENUM: CXTokenKind
+ CXToken_Punctuation
+ CXToken_Keyword
+ CXToken_Identifier
+ CXToken_Literal
+ CXToken_Comment ;
+
+STRUCT: CXToken
+ { int_data uint[4] }
+ { ptr_data void* } ;
+
+FUNCTION: CXTokenKind clang_getTokenKind ( CXToken ) ;
+FUNCTION: CXString clang_getTokenSpelling ( CXTranslationUnit TU,
+ CXToken Token ) ;
+FUNCTION: CXSourceLocation clang_getTokenLocation ( CXTranslationUnit TU,
+ CXToken Token ) ;
+FUNCTION: CXSourceRange clang_getTokenExtent ( CXTranslationUnit TU,
+ CXToken Token ) ;
+FUNCTION: void clang_tokenize ( CXTranslationUnit TU,
+ CXSourceRange Range,
+ CXToken** Tokens,
+ uint* NumTokens ) ;
+FUNCTION: void clang_annotateTokens ( CXTranslationUnit TU,
+ CXToken* Tokens,
+ uint NumTokens,
+ CXCursor* Cursors ) ;
+FUNCTION: void clang_disposeTokens ( CXTranslationUnit TU,
+ CXToken* Tokens,
+ uint NumTokens ) ;
+
+FUNCTION: CXString clang_getCursorKindSpelling ( CXCursorKind Kind ) ;
+FUNCTION: void clang_getDefinitionSpellingAndExtent ( CXCursor cursor,
+ char** startBuf,
+ char** endBuf,
+ uint* startLine,
+ uint* startColumn,
+ uint* endLine,
+ uint* endColumn ) ;
+FUNCTION: void clang_enableStackTraces ( ) ;
+
+CALLBACK: void executeOnThreadCallback ( void* ) ;
+FUNCTION: void clang_executeOnThread ( executeOnThreadCallback* callback,
+ void* user_data,
+ uint stack_size ) ;
+
+TYPEDEF: void* CXCompletionString
+
+STRUCT: CXCompletionResult
+ { CursorKind CXCursorKind }
+ { CompletionString CXCompletionString } ;
+
+ENUM: CXCompletionChunkKind
+ CXCompletionChunk_Optional
+ CXCompletionChunk_TypedText
+ CXCompletionChunk_Text
+ CXCompletionChunk_Placeholder
+ CXCompletionChunk_Informative
+ CXCompletionChunk_CurrentParameter
+ CXCompletionChunk_LeftParen
+ CXCompletionChunk_RightParen
+ CXCompletionChunk_LeftBracket
+ CXCompletionChunk_RightBracket
+ CXCompletionChunk_LeftBrace
+ CXCompletionChunk_RightBrace
+ CXCompletionChunk_LeftAngle
+ CXCompletionChunk_RightAngle
+ CXCompletionChunk_Comma
+ CXCompletionChunk_ResultType
+ CXCompletionChunk_Colon
+ CXCompletionChunk_SemiColon
+ CXCompletionChunk_Equal
+ CXCompletionChunk_HorizontalSpace
+ CXCompletionChunk_VerticalSpace ;
+
+FUNCTION: CXCompletionChunkKind clang_getCompletionChunkKind ( CXCompletionString completion_string,
+ uint chunk_number ) ;
+FUNCTION: CXString clang_getCompletionChunkText ( CXCompletionString completion_string,
+ uint chunk_number ) ;
+FUNCTION: CXCompletionString clang_getCompletionChunkCompletionString ( CXCompletionString completion_string,
+ uint chunk_number ) ;
+FUNCTION: uint clang_getNumCompletionChunks ( CXCompletionString completion_string ) ;
+FUNCTION: uint clang_getCompletionPriority ( CXCompletionString completion_string ) ;
+FUNCTION: CXAvailabilityKind clang_getCompletionAvailability ( CXCompletionString completion_string ) ;
+
+STRUCT: CXCodeCompleteResults
+ { Results CXCompletionResult* }
+ { NumResults uint } ;
+
+ENUM: CXCodeComplete_Flags
+ { CXCodeComplete_IncludeMacros 1 }
+ { CXCodeComplete_IncludeCodePatterns 2 } ;
+
+FUNCTION: uint clang_defaultCodeCompleteOptions ( ) ;
+
+FUNCTION: CXCodeCompleteResults* clang_codeCompleteAt ( CXTranslationUnit TU,
+ c-string complete_filename,
+ uint complete_line,
+ uint complete_column,
+ CXUnsavedFile* unsaved_files,
+ uint num_unsaved_files,
+ uint options ) ;
+
+FUNCTION: void clang_sortCodeCompletionResults ( CXCompletionResult* Results, uint NumResults ) ;
+FUNCTION: void clang_disposeCodeCompleteResults ( CXCodeCompleteResults* Results ) ;
+FUNCTION: uint clang_codeCompleteGetNumDiagnostics ( CXCodeCompleteResults* Results ) ;
+
+FUNCTION: CXDiagnostic clang_codeCompleteGetDiagnostic ( CXCodeCompleteResults* Results,
+ uint Index ) ;
+
+FUNCTION: CXString clang_getClangVersion ( ) ;
+FUNCTION: void clang_toggleCrashRecovery ( uint isEnabled ) ;
+
+CALLBACK: void CXInclusionVisitor ( CXFile included_file,
+ CXSourceLocation* inclusion_stack,
+ uint include_len,
+ CXClientData client_data ) ;
+
+FUNCTION: void clang_getInclusions ( CXTranslationUnit tu,
+ CXInclusionVisitor visitor,
+ CXClientData client_data ) ;
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax vocabs.loader ;
+IN: readline-listener
+
+HELP: readline-listener
+{ $description "Invokes a listener that uses libreadline for editing, history and word completion." } ;
+
+ARTICLE: "readline-listener" "Readline listener"
+{ $vocab-link "readline-listener" }
+$nl
+"By default, the terminal listener does not provide any command history or completion. This vocabulary uses libreadline to provide a listener with history, word completion and more convenient editing facilities."
+$nl
+{ $code "\"readline-listener\" run" }
+;
+
+ABOUT: "readline-listener"
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.data fry io io.encodings.utf8 kernel
+listener namespaces readline sequences threads vocabs
+command-line vocabs.hierarchy sequences.deep locals
+splitting math ;
+QUALIFIED: readline.ffi
+IN: readline-listener
+
+<PRIVATE
+SYMBOL: completions
+
+TUPLE: readline-reader { prompt initial: f } ;
+M: readline-reader stream-readln
+ flush [ prompt>> dup [ " " append ] [ ] if readline ]
+ keep f >>prompt drop ;
+
+M: readline-reader prompt.
+ >>prompt drop ;
+
+: word-names ( -- strs )
+ all-words [ name>> ] map ;
+
+: vocab-names ( -- strs )
+ all-vocabs-recursive no-roots no-prefixes [ name>> ] map ;
+
+: prefixed-words ( prefix -- words )
+ '[ _ head? ] word-names swap filter ;
+
+: prefixed-vocabs ( prefix -- words )
+ '[ _ head? ] vocab-names swap filter ;
+
+: clear-completions ( -- )
+ f completions tset ;
+
+: get-completions ( prefix -- completions )
+ completions tget dup [ nip ] [
+ drop current-line " " split first
+ "USING:" = [
+ prefixed-vocabs
+ ] [
+ prefixed-words
+ ] if dup completions tset
+ ] if ;
+PRIVATE>
+
+: readline-listener ( -- )
+ [
+ swap get-completions ?nth
+ [ clear-completions f ] unless*
+ ] set-completion
+ readline-reader new [ listener ] with-input-stream* ;
+
+MAIN: readline-listener
--- /dev/null
+A listener that uses libreadline.
--- /dev/null
+Erik Charlebois
--- /dev/null
+! Copyright (C) 2010 Erik Charlebois
+! See http:// factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types kernel alien.syntax classes.struct
+accessors libc math make unix.types namespaces system
+combinators alien.libraries ;
+IN: readline.ffi
+
+<<
+"readline" {
+ { [ os windows? ] [ "readline.dll" ] }
+ { [ os macosx? ] [ "libreadline.dylib" ] }
+ { [ os unix? ] [ "libreadline.so" ] }
+} cond cdecl add-library
+>>
+LIBRARY: readline
+
+TYPEDEF: void* histdata_t
+
+STRUCT: HIST_ENTRY
+ { line c-string }
+ { timestamp c-string }
+ { data histdata_t } ;
+
+: HISTENT_BYTES ( hs -- n ) [ line>> strlen ] [ timestamp>> strlen ] bi + ; inline
+
+STRUCT: HISTORY_STATE
+ { entries HIST_ENTRY** }
+ { offset int }
+ { length int }
+ { size int }
+ { flags int } ;
+
+CONSTANT: HS_STIFLED 1
+
+FUNCTION: void using_history ( ) ;
+FUNCTION: HISTORY_STATE* history_get_history_state ( ) ;
+FUNCTION: void history_set_history_state ( HISTORY_STATE* arg1 ) ;
+FUNCTION: void add_history ( c-string arg1 ) ;
+FUNCTION: void add_history_time ( c-string arg1 ) ;
+FUNCTION: HIST_ENTRY* remove_history ( int arg1 ) ;
+FUNCTION: histdata_t free_history_entry ( HIST_ENTRY* arg1 ) ;
+FUNCTION: HIST_ENTRY* replace_history_entry ( int arg1, c-string
+ arg2, histdata_t
+ arg3 ) ;
+FUNCTION: void clear_history ( ) ;
+FUNCTION: void stifle_history ( int arg1 ) ;
+FUNCTION: int unstifle_history ( ) ;
+FUNCTION: int history_is_stifled ( ) ;
+FUNCTION: HIST_ENTRY** history_list ( ) ;
+FUNCTION: int where_history ( ) ;
+FUNCTION: HIST_ENTRY* current_history ( ) ;
+FUNCTION: HIST_ENTRY* history_get ( int arg1 ) ;
+FUNCTION: time_t history_get_time ( HIST_ENTRY* arg1 ) ;
+FUNCTION: int history_total_bytes ( ) ;
+FUNCTION: int history_set_pos ( int arg1 ) ;
+FUNCTION: HIST_ENTRY* previous_history ( ) ;
+FUNCTION: HIST_ENTRY* next_history ( ) ;
+FUNCTION: int history_search ( c-string arg1, int arg2 ) ;
+FUNCTION: int history_search_prefix ( c-string arg1, int arg2 ) ;
+FUNCTION: int history_search_pos ( c-string arg1, int arg2, int
+ arg3 ) ;
+FUNCTION: int read_history ( c-string arg1 ) ;
+FUNCTION: int read_history_range ( c-string arg1, int arg2, int
+ arg3 ) ;
+FUNCTION: int write_history ( c-string arg1 ) ;
+FUNCTION: int append_history ( int arg1, c-string arg2 ) ;
+FUNCTION: int history_expand ( c-string arg1, char** arg2 ) ;
+FUNCTION: c-string history_arg_extract ( int arg1, int arg2,
+ c-string arg3 ) ;
+FUNCTION: c-string get_history_event ( c-string arg1, int* arg2,
+ int arg3 ) ;
+FUNCTION: char** history_tokenize ( c-string arg1 ) ;
+
+CALLBACK: int rl_command_func_t ( int arg1, int arg2 ) ;
+CALLBACK: char* rl_compentry_func_t ( c-string arg1, int arg2 ) ;
+CALLBACK: char** rl_completion_func_t ( c-string arg1, int arg2,
+ int arg3 ) ;
+
+CALLBACK: c-string rl_quote_func_t ( c-string arg1, int arg2,
+ c-string arg3 ) ;
+CALLBACK: c-string rl_dequote_func_t ( c-string arg1, int arg2 ) ;
+CALLBACK: int rl_compignore_func_t ( char** arg1 ) ;
+CALLBACK: void rl_compdisp_func_t ( char** arg1, int arg2, int
+ arg3 ) ;
+CALLBACK: int rl_hook_func_t ( ) ;
+CALLBACK: int rl_getc_func_t ( FILE* arg1 ) ;
+CALLBACK: int rl_linebuf_func_t ( c-string arg1, int arg2 ) ;
+
+STRUCT: KEYMAP_ENTRY
+ { type char }
+ { function rl_command_func_t* } ;
+
+CONSTANT: KEYMAP_SIZE 257
+CONSTANT: ANYOTHERKEY 256
+
+TYPEDEF: KEYMAP_ENTRY[257] KEYMAP_ENTRY_ARRAY
+TYPEDEF: KEYMAP_ENTRY* Keymap
+
+CONSTANT: ISFUNC 0
+CONSTANT: ISKMAP 1
+CONSTANT: ISMACR 2
+
+C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_standard_keymap
+C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_meta_keymap
+C-GLOBAL: KEYMAP_ENTRY_ARRAY emacs_ctlx_keymap
+C-GLOBAL: KEYMAP_ENTRY_ARRAY vi_insertion_keymap
+C-GLOBAL: KEYMAP_ENTRY_ARRAY vi_movement_keymap
+
+FUNCTION: Keymap rl_copy_keymap ( Keymap ) ;
+FUNCTION: Keymap rl_make_keymap ( ) ;
+FUNCTION: void rl_discard_keymap ( Keymap ) ;
+
+CALLBACK: c-string tilde_hook_func_t ( c-string ) ;
+
+C-GLOBAL: tilde_hook_func_t* tilde_expansion_preexpansion_hook
+C-GLOBAL: tilde_hook_func_t* tilde_expansion_failure_hook
+C-GLOBAL: char** tilde_additional_prefixes
+C-GLOBAL: char** tilde_additional_suffixes
+
+FUNCTION: c-string tilde_expand ( c-string ) ;
+FUNCTION: c-string tilde_expand_word ( c-string ) ;
+FUNCTION: c-string tilde_find_word ( c-string arg1, int arg2,
+ int* arg3 ) ;
+
+C-GLOBAL: int history_base
+C-GLOBAL: int history_length
+C-GLOBAL: int history_max_entries
+C-GLOBAL: char history_expansion_char
+C-GLOBAL: char history_subst_char
+C-GLOBAL: c-string history_word_delimiters
+C-GLOBAL: char history_comment_char
+C-GLOBAL: c-string history_no_expand_chars
+C-GLOBAL: c-string history_search_delimiter_chars
+C-GLOBAL: int history_quotes_inhibit_expansion
+C-GLOBAL: int history_write_timestamps
+C-GLOBAL: int max_input_history
+C-GLOBAL: rl_linebuf_func_t* history_inhibit_expansion_function
+
+CALLBACK: int rl_intfunc_t ( int ) ;
+CALLBACK: int rl_icpfunc_t ( c-string ) ;
+CALLBACK: int rl_icppfunc_t ( char** ) ;
+
+CALLBACK: void rl_voidfunc_t ( ) ;
+CALLBACK: void rl_vintfunc_t ( int ) ;
+CALLBACK: void rl_vcpfunc_t ( c-string ) ;
+CALLBACK: void rl_vcppfunc_t ( char** ) ;
+
+CALLBACK: c-string rl_cpvfunc_t ( ) ;
+CALLBACK: c-string rl_cpifunc_t ( int ) ;
+CALLBACK: c-string rl_cpcpfunc_t ( c-string ) ;
+CALLBACK: c-string rl_cpcppfunc_t ( char** ) ;
+
+ENUM: undo_code UNDO_DELETE UNDO_INSERT UNDO_BEGIN UNDO_END ;
+
+STRUCT: UNDO_LIST
+ { next UNDO_LIST* }
+ { start int }
+ { end int }
+ { text char* }
+ { what undo_code } ;
+
+C-GLOBAL: UNDO_LIST* rl_undo_list
+
+STRUCT: FUNMAP
+ { name c-string }
+ { function rl_command_func_t* } ;
+
+C-GLOBAL: FUNMAP** funmap
+
+FUNCTION: int rl_digit_argument ( int arg1, int arg2 ) ;
+FUNCTION: int rl_universal_argument ( int arg, int arg ) ;
+
+FUNCTION: int rl_forward_byte ( int arg1, int arg2 ) ;
+FUNCTION: int rl_forward_char ( int arg1, int arg2 ) ;
+FUNCTION: int rl_forward ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_byte ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_char ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward ( int arg1, int arg2 ) ;
+FUNCTION: int rl_beg_of_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_end_of_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_forward_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_refresh_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_clear_screen ( int arg1, int arg2 ) ;
+FUNCTION: int rl_skip_csi_sequence ( int arg1, int arg2 ) ;
+FUNCTION: int rl_arrow_keys ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_insert ( int arg1, int arg2 ) ;
+FUNCTION: int rl_quoted_insert ( int arg1, int arg2 ) ;
+FUNCTION: int rl_tab_insert ( int arg1, int arg2 ) ;
+FUNCTION: int rl_newline ( int arg1, int arg2 ) ;
+FUNCTION: int rl_do_lowercase_version ( int arg1, int arg2 ) ;
+FUNCTION: int rl_rubout ( int arg1, int arg2 ) ;
+FUNCTION: int rl_delete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_rubout_or_delete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_delete_horizontal_space ( int arg1, int arg2 ) ;
+FUNCTION: int rl_delete_or_show_completions ( int arg1, int arg2 ) ;
+FUNCTION: int rl_insert_comment ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_upcase_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_downcase_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_capitalize_word ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_transpose_words ( int arg1, int arg2 ) ;
+FUNCTION: int rl_transpose_chars ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_char_search ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_char_search ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_beginning_of_history ( int arg1, int arg2 ) ;
+FUNCTION: int rl_end_of_history ( int arg1, int arg2 ) ;
+FUNCTION: int rl_get_next_history ( int arg1, int arg2 ) ;
+FUNCTION: int rl_get_previous_history ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_set_mark ( int arg1, int arg2 ) ;
+FUNCTION: int rl_exchange_point_and_mark ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_vi_editing_mode ( int arg1, int arg2 ) ;
+FUNCTION: int rl_emacs_editing_mode ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_overwrite_mode ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_re_read_init_file ( int arg1, int arg2 ) ;
+FUNCTION: int rl_dump_functions ( int arg1, int arg2 ) ;
+FUNCTION: int rl_dump_macros ( int arg1, int arg2 ) ;
+FUNCTION: int rl_dump_variables ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_complete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_possible_completions ( int arg1, int arg2 ) ;
+FUNCTION: int rl_insert_completions ( int arg1, int arg2 ) ;
+FUNCTION: int rl_old_menu_complete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_menu_complete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_menu_complete ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_kill_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_kill_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_kill_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_backward_kill_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_kill_full_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_unix_word_rubout ( int arg1, int arg2 ) ;
+FUNCTION: int rl_unix_filename_rubout ( int arg1, int arg2 ) ;
+FUNCTION: int rl_unix_line_discard ( int arg1, int arg2 ) ;
+FUNCTION: int rl_copy_region_to_kill ( int arg1, int arg2 ) ;
+FUNCTION: int rl_kill_region ( int arg1, int arg2 ) ;
+FUNCTION: int rl_copy_forward_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_copy_backward_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_yank ( int arg1, int arg2 ) ;
+FUNCTION: int rl_yank_pop ( int arg1, int arg2 ) ;
+FUNCTION: int rl_yank_nth_arg ( int arg1, int arg2 ) ;
+FUNCTION: int rl_yank_last_arg ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_reverse_search_history ( int arg1, int arg2 ) ;
+FUNCTION: int rl_forward_search_history ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_start_kbd_macro ( int arg1, int arg2 ) ;
+FUNCTION: int rl_end_kbd_macro ( int arg1, int arg2 ) ;
+FUNCTION: int rl_call_last_kbd_macro ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_revert_line ( int arg1, int arg2 ) ;
+FUNCTION: int rl_undo_command ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_tilde_expand ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_restart_output ( int arg1, int arg2 ) ;
+FUNCTION: int rl_stop_output ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_abort ( int arg1, int arg2 ) ;
+FUNCTION: int rl_tty_status ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_history_search_forward ( int arg1, int arg2 ) ;
+FUNCTION: int rl_history_search_backward ( int arg1, int arg2 ) ;
+FUNCTION: int rl_noninc_forward_search ( int arg1, int arg2 ) ;
+FUNCTION: int rl_noninc_reverse_search ( int arg1, int arg2 ) ;
+FUNCTION: int rl_noninc_forward_search_again ( int arg1, int arg2 ) ;
+FUNCTION: int rl_noninc_reverse_search_again ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_insert_close ( int arg1, int arg2 ) ;
+
+FUNCTION: void rl_callback_handler_install ( c-string arg1,
+ rl_vcpfunc_t* arg2 ) ;
+FUNCTION: void rl_callback_read_char ( ) ;
+FUNCTION: void rl_callback_handler_remove ( ) ;
+
+FUNCTION: int rl_vi_redo ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_undo ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_yank_arg ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_fetch_history ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_search_again ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_search ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_complete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_tilde_expand ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_prev_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_next_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_end_word ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_insert_beg ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_append_mode ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_append_eol ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_eof_maybe ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_insertion_mode ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_insert_mode ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_movement_mode ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_arg_digit ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_change_case ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_put ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_column ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_delete_to ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_change_to ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_yank_to ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_rubout ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_delete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_back_to_indent ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_first_print ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_char_search ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_match ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_change_char ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_subst ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_overstrike ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_overstrike_delete ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_replace ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_set_mark ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_goto_mark ( int arg1, int arg2 ) ;
+
+FUNCTION: int rl_vi_check ( ) ;
+FUNCTION: int rl_vi_domove ( int arg1, int* arg2 ) ;
+FUNCTION: int rl_vi_bracktype ( int ) ;
+
+FUNCTION: void rl_vi_start_inserting ( int arg1, int arg2, int
+ arg3 ) ;
+
+FUNCTION: int rl_vi_fWord ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_bWord ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_eWord ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_fword ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_bword ( int arg1, int arg2 ) ;
+FUNCTION: int rl_vi_eword ( int arg1, int arg2 ) ;
+
+FUNCTION: char* readline ( c-string ) ;
+
+FUNCTION: int rl_set_prompt ( c-string ) ;
+FUNCTION: int rl_expand_prompt ( c-string ) ;
+
+FUNCTION: int rl_initialize ( ) ;
+
+FUNCTION: int rl_discard_argument ( ) ;
+
+FUNCTION: int rl_add_defun ( c-string arg1, rl_command_func_t*
+ arg2, int arg3 ) ;
+FUNCTION: int rl_bind_key ( int arg1, rl_command_func_t* arg2 ) ;
+FUNCTION: int rl_bind_key_in_map ( int arg1, rl_command_func_t*
+ arg2, Keymap arg3 ) ;
+FUNCTION: int rl_unbind_key ( int ) ;
+FUNCTION: int rl_unbind_key_in_map ( int arg1, Keymap arg2 ) ;
+FUNCTION: int rl_bind_key_if_unbound ( int arg1,
+ rl_command_func_t* arg2 ) ;
+FUNCTION: int rl_bind_key_if_unbound_in_map ( int arg1,
+ rl_command_func_t*
+ arg2, Keymap arg3 ) ;
+FUNCTION: int rl_unbind_function_in_map ( rl_command_func_t*
+ arg1, Keymap arg2 ) ;
+FUNCTION: int rl_unbind_command_in_map ( c-string arg1, Keymap
+ arg2 ) ;
+FUNCTION: int rl_bind_keyseq ( c-string arg1, rl_command_func_t*
+ arg2 ) ;
+FUNCTION: int rl_bind_keyseq_in_map ( c-string arg1,
+ rl_command_func_t* arg2, Keymap
+ arg3 ) ;
+FUNCTION: int rl_bind_keyseq_if_unbound ( c-string arg1,
+ rl_command_func_t* arg2 ) ;
+FUNCTION: int rl_bind_keyseq_if_unbound_in_map ( c-string arg1,
+ rl_command_func_t*
+ arg2, Keymap
+ arg3 ) ;
+FUNCTION: int rl_generic_bind ( int arg1, c-string arg2,
+ c-string arg3, Keymap arg4 ) ;
+
+FUNCTION: c-string rl_variable_value ( c-string ) ;
+FUNCTION: int rl_variable_bind ( c-string arg1, c-string arg2 ) ;
+
+FUNCTION: int rl_set_key ( c-string arg1, rl_command_func_t*
+ arg2, Keymap arg3 ) ;
+FUNCTION: int rl_macro_bind ( c-string arg1, c-string arg2,
+ Keymap arg3 ) ;
+FUNCTION: int rl_translate_keyseq ( c-string arg1, c-string
+ arg2, int* arg3 ) ;
+FUNCTION: c-string rl_untranslate_keyseq ( int ) ;
+FUNCTION: rl_command_func_t* rl_named_function ( c-string ) ;
+FUNCTION: rl_command_func_t* rl_function_of_keyseq ( c-string
+ arg1, Keymap
+ arg2, int*
+ arg3 ) ;
+
+FUNCTION: void rl_list_funmap_names ( ) ;
+FUNCTION: char** rl_invoking_keyseqs_in_map ( rl_command_func_t*
+ arg1, Keymap arg2 ) ;
+FUNCTION: char** rl_invoking_keyseqs ( rl_command_func_t* ) ;
+
+FUNCTION: void rl_function_dumper ( int ) ;
+FUNCTION: void rl_macro_dumper ( int ) ;
+FUNCTION: void rl_variable_dumper ( int ) ;
+
+FUNCTION: int rl_read_init_file ( c-string ) ;
+FUNCTION: int rl_parse_and_bind ( c-string ) ;
+
+FUNCTION: Keymap rl_make_bare_keymap ( ) ;
+
+FUNCTION: Keymap rl_get_keymap_by_name ( c-string ) ;
+FUNCTION: c-string rl_get_keymap_name ( Keymap ) ;
+FUNCTION: void rl_set_keymap ( Keymap ) ;
+FUNCTION: Keymap rl_get_keymap ( ) ;
+FUNCTION: void rl_set_keymap_from_edit_mode ( ) ;
+FUNCTION: c-string rl_get_keymap_name_from_edit_mode ( ) ;
+
+FUNCTION: int rl_add_funmap_entry ( c-string arg1,
+ rl_command_func_t* arg2 ) ;
+FUNCTION: char** rl_funmap_names ( ) ;
+FUNCTION: void rl_initialize_funmap ( ) ;
+
+FUNCTION: void rl_push_macro_input ( c-string ) ;
+
+FUNCTION: void rl_add_undo ( undo_code arg1, int arg2, int
+ arga3, c-string arg4 ) ;
+FUNCTION: void rl_free_undo_list ( ) ;
+FUNCTION: int rl_do_undo ( ) ;
+FUNCTION: int rl_begin_undo_group ( ) ;
+FUNCTION: int rl_end_undo_group ( ) ;
+FUNCTION: int rl_modifying ( int arg1, int arg2 ) ;
+
+FUNCTION: void rl_redisplay ( ) ;
+FUNCTION: int rl_on_new_line ( ) ;
+FUNCTION: int rl_on_new_line_with_prompt ( ) ;
+FUNCTION: int rl_forced_update_display ( ) ;
+FUNCTION: int rl_clear_message ( ) ;
+FUNCTION: int rl_reset_line_state ( ) ;
+FUNCTION: int rl_crlf ( ) ;
+
+! FUNCTION: int rl_message ( c-string arg1, ... ) ;
+FUNCTION: int rl_show_char ( int ) ;
+
+FUNCTION: int rl_character_len ( int arg1, int arg2 ) ;
+
+FUNCTION: void rl_save_prompt ( ) ;
+FUNCTION: void rl_restore_prompt ( ) ;
+
+FUNCTION: void rl_replace_line ( c-string arg1, int arg2 ) ;
+FUNCTION: int rl_insert_text ( c-string arg1 ) ;
+FUNCTION: int rl_delete_text ( int arg1, int arg2 ) ;
+FUNCTION: int rl_kill_text ( int arg1, int arg2 ) ;
+FUNCTION: c-string rl_copy_text ( int arg1, int arg2 ) ;
+
+FUNCTION: void rl_prep_terminal ( int ) ;
+FUNCTION: void rl_deprep_terminal ( ) ;
+FUNCTION: void rl_tty_set_default_bindings ( Keymap ) ;
+FUNCTION: void rl_tty_unset_default_bindings ( Keymap ) ;
+
+FUNCTION: int rl_reset_terminal ( c-string ) ;
+FUNCTION: void rl_resize_terminal ( ) ;
+FUNCTION: void rl_set_screen_size ( int arg1, int arg2 ) ;
+FUNCTION: void rl_get_screen_size ( int* arg1, int* arg2 ) ;
+FUNCTION: void rl_reset_screen_size ( ) ;
+
+FUNCTION: c-string rl_get_termcap ( c-string ) ;
+
+FUNCTION: int rl_stuff_char ( int ) ;
+FUNCTION: int rl_execute_next ( int ) ;
+FUNCTION: int rl_clear_pending_input ( ) ;
+FUNCTION: int rl_read_key ( ) ;
+FUNCTION: int rl_getc ( FILE* ) ;
+FUNCTION: int rl_set_keyboard_input_timeout ( int ) ;
+
+FUNCTION: void rl_extend_line_buffer ( int ) ;
+FUNCTION: int rl_ding ( ) ;
+FUNCTION: int rl_alphabetic ( int ) ;
+FUNCTION: void rl_free ( void* ) ;
+
+FUNCTION: int rl_set_signals ( ) ;
+FUNCTION: int rl_clear_signals ( ) ;
+FUNCTION: void rl_cleanup_after_signal ( ) ;
+FUNCTION: void rl_reset_after_signal ( ) ;
+FUNCTION: void rl_free_line_state ( ) ;
+
+FUNCTION: void rl_echo_signal_char ( int ) ;
+
+FUNCTION: int rl_set_paren_blink_timeout ( int ) ;
+
+FUNCTION: int rl_maybe_save_line ( ) ;
+FUNCTION: int rl_maybe_unsave_line ( ) ;
+FUNCTION: int rl_maybe_replace_line ( ) ;
+
+FUNCTION: int rl_complete_internal ( int ) ;
+FUNCTION: void rl_display_match_list ( char** arg1, int arg2,
+ int arg3 ) ;
+
+FUNCTION: char** rl_completion_matches ( c-string arg1,
+ rl_compentry_func_t*
+ arg2 ) ;
+FUNCTION: c-string rl_username_completion_function ( c-string
+ arg1, int
+ arg2 ) ;
+FUNCTION: c-string rl_filename_completion_function ( c-string
+ arg1, int
+ arg2 ) ;
+
+FUNCTION: int rl_completion_mode ( rl_command_func_t* ) ;
+
+C-GLOBAL: c-string rl_library_version
+C-GLOBAL: int rl_readline_version
+C-GLOBAL: int rl_gnu_readline_p
+C-GLOBAL: int rl_readline_state
+C-GLOBAL: int rl_editing_mode
+C-GLOBAL: int rl_insert_mode
+C-GLOBAL: c-string rl_readline_name
+C-GLOBAL: c-string rl_prompt
+C-GLOBAL: c-string rl_display_prompt
+C-GLOBAL: c-string rl_line_buffer
+C-GLOBAL: int rl_point
+C-GLOBAL: int rl_end
+C-GLOBAL: int rl_mark
+C-GLOBAL: int rl_done
+C-GLOBAL: int rl_pending_input
+C-GLOBAL: int rl_dispatching
+C-GLOBAL: int rl_explicit_arg
+C-GLOBAL: int rl_numeric_arg
+C-GLOBAL: rl_command_func_t* rl_last_func
+C-GLOBAL: c-string rl_terminal_name
+
+C-GLOBAL: FILE* rl_instream
+C-GLOBAL: FILE* rl_outstream
+
+C-GLOBAL: int rl_prefer_env_winsize
+
+C-GLOBAL: rl_hook_func_t* rl_startup_hook
+C-GLOBAL: rl_hook_func_t* rl_pre_input_hook
+C-GLOBAL: rl_hook_func_t* rl_event_hook
+
+C-GLOBAL: rl_getc_func_t* rl_getc_function
+C-GLOBAL: rl_voidfunc_t* rl_redisplay_function
+C-GLOBAL: rl_vintfunc_t* rl_prep_term_function
+C-GLOBAL: rl_voidfunc_t* rl_deprep_term_function
+
+C-GLOBAL: Keymap rl_executing_keymap
+C-GLOBAL: Keymap rl_binding_keymap
+
+C-GLOBAL: int rl_erase_empty_line
+C-GLOBAL: int rl_already_prompted
+C-GLOBAL: int rl_num_chars_to_read
+C-GLOBAL: c-string rl_executing_macro
+
+C-GLOBAL: int rl_catch_signals
+C-GLOBAL: int rl_catch_sigwinch
+C-GLOBAL: rl_compentry_func_t* rl_completion_entry_function
+C-GLOBAL: rl_compentry_func_t* rl_menu_completion_entry_function
+C-GLOBAL: rl_compignore_func_t* rl_ignore_some_completions_function
+C-GLOBAL: rl_completion_func_t* rl_attempted_completion_function
+C-GLOBAL: c-string rl_basic_word_break_characters
+C-GLOBAL: c-string rl_completer_word_break_characters
+C-GLOBAL: rl_cpvfunc_t* rl_completion_word_break_hook
+
+C-GLOBAL: c-string rl_completer_quote_characters
+C-GLOBAL: c-string rl_basic_quote_characters
+C-GLOBAL: c-string rl_filename_quote_characters
+C-GLOBAL: c-string rl_special_prefixes
+C-GLOBAL: rl_icppfunc_t* rl_directory_completion_hook
+
+C-GLOBAL: rl_icppfunc_t* rl_directory_rewrite_hook
+C-GLOBAL: rl_dequote_func_t* rl_filename_rewrite_hook
+C-GLOBAL: rl_compdisp_func_t* rl_completion_display_matches_hook
+C-GLOBAL: int rl_filename_completion_desired
+C-GLOBAL: int rl_filename_quoting_desired
+C-GLOBAL: rl_quote_func_t* rl_filename_quoting_function
+C-GLOBAL: rl_dequote_func_t* rl_filename_dequoting_function
+C-GLOBAL: rl_linebuf_func_t* rl_char_is_quoted_p
+C-GLOBAL: int rl_attempted_completion_over
+C-GLOBAL: int rl_completion_type
+C-GLOBAL: int rl_completion_invoking_key
+C-GLOBAL: int rl_completion_query_items
+C-GLOBAL: int rl_completion_append_character
+C-GLOBAL: int rl_completion_suppress_append
+C-GLOBAL: int rl_completion_quote_character
+C-GLOBAL: int rl_completion_found_quote
+C-GLOBAL: int rl_completion_suppress_quote
+C-GLOBAL: int rl_sort_completion_matches
+C-GLOBAL: int rl_completion_mark_symlink_dirs
+
+C-GLOBAL: int rl_ignore_completion_duplicates
+C-GLOBAL: int rl_inhibit_completion
+
+CONSTANT: READERR -2
+
+CONSTANT: RL_PROMPT_START_IGNORE 1
+CONSTANT: RL_PROMPT_END_IGNORE 2
+
+CONSTANT: NO_MATCH 0
+CONSTANT: SINGLE_MATCH 1
+CONSTANT: MULT_MATCH 2
+
+CONSTANT: RL_STATE_NONE HEX: 0000000
+CONSTANT: RL_STATE_INITIALIZING HEX: 0000001
+CONSTANT: RL_STATE_INITIALIZED HEX: 0000002
+CONSTANT: RL_STATE_TERMPREPPED HEX: 0000004
+CONSTANT: RL_STATE_READCMD HEX: 0000008
+CONSTANT: RL_STATE_METANEXT HEX: 0000010
+CONSTANT: RL_STATE_DISPATCHING HEX: 0000020
+CONSTANT: RL_STATE_MOREINPUT HEX: 0000040
+CONSTANT: RL_STATE_ISEARCH HEX: 0000080
+CONSTANT: RL_STATE_NSEARCH HEX: 0000100
+CONSTANT: RL_STATE_SEARCH HEX: 0000200
+CONSTANT: RL_STATE_NUMERICARG HEX: 0000400
+CONSTANT: RL_STATE_MACROINPUT HEX: 0000800
+CONSTANT: RL_STATE_MACRODEF HEX: 0001000
+CONSTANT: RL_STATE_OVERWRITE HEX: 0002000
+CONSTANT: RL_STATE_COMPLETING HEX: 0004000
+CONSTANT: RL_STATE_SIGHANDLER HEX: 0008000
+CONSTANT: RL_STATE_UNDOING HEX: 0010000
+CONSTANT: RL_STATE_INPUTPENDING HEX: 0020000
+CONSTANT: RL_STATE_TTYCSAVED HEX: 0040000
+CONSTANT: RL_STATE_CALLBACK HEX: 0080000
+CONSTANT: RL_STATE_VIMOTION HEX: 0100000
+CONSTANT: RL_STATE_MULTIKEY HEX: 0200000
+CONSTANT: RL_STATE_VICMDONCE HEX: 0400000
+CONSTANT: RL_STATE_REDISPLAYING HEX: 0800000
+CONSTANT: RL_STATE_DONE HEX: 1000000
+
+: RL_SETSTATE ( x -- ) rl_readline_state get bitor rl_readline_state set ; inline
+: RL_UNSETSTATE ( x -- ) not rl_readline_state get bitand rl_readline_state set ; inline
+: RL_ISSTATE ( x -- ? ) rl_readline_state get bitand 0 = not ; inline
+
+STRUCT: readline_state
+ { point int }
+ { end int }
+ { mark int }
+ { buffer char* }
+ { buflen int }
+ { ul UNDO_LIST* }
+ { prompt char* }
+ { rlstate int }
+ { done int }
+ { kmap Keymap }
+ { lastfunc rl_command_func_t* }
+ { insmode int }
+ { edmode int }
+ { kseqlen int }
+ { inf FILE* }
+ { outf FILE* }
+ { pendingin int }
+ { macro char* }
+ { catchsigs int }
+ { catchsigwinch int }
+ { reserved char[64] } ;
+
+FUNCTION: int rl_save_state ( readline_state* ) ;
+FUNCTION: int rl_restore_state ( readline_state* ) ;
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays help.markup help.syntax math
+sequences.private vectors strings kernel math.order layouts
+quotations generic.single ;
+IN: readline
+
+HELP: readline
+{ $values
+ { "prompt" string }
+ { "str" string }
+}
+{ $description "Read a line from using readline." } ;
+
+HELP: set-completion
+{ $values
+ { "quot" "a quotation with stack effect ( str n -- str )"}
+}
+{ $description "Set the given quotation as the completion hook for readline. The quotation is called with the string to complete and the index in the completion list to return. When all completions have been returned, returning " { $snippet "f" } " terminates the loop." }
+{ $examples
+ { $example "USING: readline sequences combinators kernel ;"
+ "[ nip [ \"keep\" \"dip\" ] ?nth ] set-completion"
+ ""
+ }
+} ;
+
+ARTICLE: "readline" "Readline"
+{ $vocab-link "readline" }
+;
+
+
+ABOUT: "readline"
--- /dev/null
+! Copyright (C) 2011 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings destructors io.encodings.utf8 kernel libc
+sequences macros quotations words compiler.units fry
+alien.data alien.libraries ;
+QUALIFIED: readline.ffi
+IN: readline
+
+: readline ( prompt -- str )
+ [
+ readline.ffi:readline [
+ |free utf8 alien>string [
+ [ ] [ readline.ffi:add_history ] if-empty
+ ] keep
+ ] [ f ] if*
+ ] with-destructors ;
+
+: current-line ( -- str )
+ readline.ffi:rl_line_buffer ;
+
+: has-readline ( -- ? )
+ "readline" dup load-library dlsym-raw >boolean ;
+
+MACRO: set-completion ( quot -- )
+ [
+ '[ @ [ utf8 malloc-string ] [ f ] if* ]
+ '[ _ readline.ffi:rl_compentry_func_t ]
+ (( -- alien )) define-temp
+ ] with-compilation-unit execute
+ '[ _ readline.ffi:set-rl_completion_entry_function ] ;
--- /dev/null
+libreadline bindings
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! Copyright (C) 2007, 2010 Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: bootstrap.image.private kernel kernel.private namespaces\r
-system cpu.ppc.assembler compiler.units compiler.constants math\r
-math.private math.ranges layouts words vocabs slots.private\r
-locals locals.backend generic.single.private fry sequences\r
-threads.private strings.private ;\r
-FROM: cpu.ppc.assembler => B ;\r
-IN: bootstrap.ppc\r
-\r
-4 \ cell set\r
-big-endian on\r
-\r
-CONSTANT: ds-reg 13\r
-CONSTANT: rs-reg 14\r
-CONSTANT: vm-reg 15\r
-CONSTANT: ctx-reg 16\r
-CONSTANT: nv-reg 17\r
-\r
-: jit-call ( string -- )\r
- 0 2 LOAD32 rc-absolute-ppc-2/2 jit-dlsym\r
- 2 MTLR\r
- BLRL ;\r
-\r
-: jit-call-quot ( -- )\r
- 4 3 quot-entry-point-offset LWZ\r
- 4 MTLR\r
- BLRL ;\r
-\r
-: jit-jump-quot ( -- )\r
- 4 3 quot-entry-point-offset LWZ\r
- 4 MTCTR\r
- BCTR ;\r
-\r
-: factor-area-size ( -- n ) 16 ;\r
-\r
-: stack-frame ( -- n )\r
- reserved-size\r
- factor-area-size +\r
- 16 align ;\r
-\r
-: next-save ( -- n ) stack-frame 4 - ;\r
-: xt-save ( -- n ) stack-frame 8 - ;\r
-\r
-: param-size ( -- n ) 32 ;\r
-\r
-: save-at ( m -- n ) reserved-size + param-size + ;\r
-\r
-: save-int ( register offset -- ) [ 1 ] dip save-at STW ;\r
-: restore-int ( register offset -- ) [ 1 ] dip save-at LWZ ;\r
-\r
-: save-fp ( register offset -- ) [ 1 ] dip save-at STFD ;\r
-: restore-fp ( register offset -- ) [ 1 ] dip save-at LFD ;\r
-\r
-: save-vec ( register offset -- ) save-at 2 LI 2 1 STVXL ;\r
-: restore-vec ( register offset -- ) save-at 2 LI 2 1 LVXL ;\r
-\r
-: nv-int-regs ( -- seq ) 13 31 [a,b] ;\r
-: nv-fp-regs ( -- seq ) 14 31 [a,b] ;\r
-: nv-vec-regs ( -- seq ) 20 31 [a,b] ;\r
-\r
-: saved-int-regs-size ( -- n ) 96 ;\r
-: saved-fp-regs-size ( -- n ) 144 ;\r
-: saved-vec-regs-size ( -- n ) 208 ;\r
-\r
-: callback-frame-size ( -- n )\r
- reserved-size\r
- param-size +\r
- saved-int-regs-size +\r
- saved-fp-regs-size +\r
- saved-vec-regs-size +\r
- 4 +\r
- 16 align ;\r
-\r
-: old-context-save-offset ( -- n )\r
- 432 save-at ;\r
-\r
-[\r
- ! Save old stack pointer\r
- 11 1 MR\r
-\r
- ! Create stack frame\r
- 0 MFLR\r
- 1 1 callback-frame-size SUBI\r
- 0 1 callback-frame-size lr-save + STW\r
-\r
- ! Save all non-volatile registers\r
- nv-int-regs [ 4 * save-int ] each-index\r
- nv-fp-regs [ 8 * 80 + save-fp ] each-index\r
- nv-vec-regs [ 16 * 224 + save-vec ] each-index\r
-\r
- ! Stick old stack pointer in a non-volatile register so that\r
- ! callbacks can access their arguments\r
- nv-reg 11 MR\r
-\r
- ! Load VM into vm-reg\r
- 0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
-\r
- ! Save old context\r
- 2 vm-reg vm-context-offset LWZ\r
- 2 1 old-context-save-offset STW\r
-\r
- ! Switch over to the spare context\r
- 2 vm-reg vm-spare-context-offset LWZ\r
- 2 vm-reg vm-context-offset STW\r
-\r
- ! Save C callstack pointer\r
- 1 2 context-callstack-save-offset STW\r
-\r
- ! Load Factor callstack pointer\r
- 1 2 context-callstack-bottom-offset LWZ\r
-\r
- ! Call into Factor code\r
- 0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel\r
- 2 MTLR\r
- BLRL\r
-\r
- ! Load VM again, pointlessly\r
- 0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
-\r
- ! Load C callstack pointer\r
- 2 vm-reg vm-context-offset LWZ\r
- 1 2 context-callstack-save-offset LWZ\r
-\r
- ! Load old context\r
- 2 1 old-context-save-offset LWZ\r
- 2 vm-reg vm-context-offset STW\r
-\r
- ! Restore non-volatile registers\r
- nv-vec-regs [ 16 * 224 + restore-vec ] each-index\r
- nv-fp-regs [ 8 * 80 + restore-fp ] each-index\r
- nv-int-regs [ 4 * restore-int ] each-index\r
-\r
- ! Tear down stack frame and return\r
- 0 1 callback-frame-size lr-save + LWZ\r
- 1 1 callback-frame-size ADDI\r
- 0 MTLR\r
- BLR\r
-] callback-stub jit-define\r
-\r
-: jit-conditional* ( test-quot false-quot -- )\r
- [ '[ 4 /i 1 + @ ] ] dip jit-conditional ; inline\r
-\r
-: jit-load-context ( -- )\r
- ctx-reg vm-reg vm-context-offset LWZ ;\r
-\r
-: jit-save-context ( -- )\r
- jit-load-context\r
- 1 ctx-reg context-callstack-top-offset STW\r
- ds-reg ctx-reg context-datastack-offset STW\r
- rs-reg ctx-reg context-retainstack-offset STW ;\r
-\r
-: jit-restore-context ( -- )\r
- ds-reg ctx-reg context-datastack-offset LWZ\r
- rs-reg ctx-reg context-retainstack-offset LWZ ;\r
-\r
-[\r
- 0 12 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
- 11 12 profile-count-offset LWZ\r
- 11 11 1 tag-fixnum ADDI\r
- 11 12 profile-count-offset STW\r
- 11 12 word-code-offset LWZ\r
- 11 11 compiled-header-size ADDI\r
- 11 MTCTR\r
- BCTR\r
-] jit-profiling jit-define\r
-\r
-[\r
- 0 2 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel\r
- 0 MFLR\r
- 1 1 stack-frame SUBI\r
- 2 1 xt-save STW\r
- stack-frame 2 LI\r
- 2 1 next-save STW\r
- 0 1 lr-save stack-frame + STW\r
-] jit-prolog jit-define\r
-\r
-[\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
- 3 ds-reg 4 STWU\r
-] jit-push jit-define\r
-\r
-[\r
- jit-save-context\r
- 3 vm-reg MR\r
- 0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel\r
- 4 MTLR\r
- BLRL\r
- jit-restore-context\r
-] jit-primitive jit-define\r
-\r
-[ 0 BL rc-relative-ppc-3 rt-entry-point-pic jit-rel ] jit-word-call jit-define\r
-\r
-[\r
- 0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel\r
- 0 B rc-relative-ppc-3 rt-entry-point-pic-tail jit-rel\r
-] jit-word-jump jit-define\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 0 3 \ f type-number CMPI\r
- [ BEQ ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional*\r
- 0 B rc-relative-ppc-3 rt-entry-point jit-rel\r
-] jit-if jit-define\r
-\r
-: jit->r ( -- )\r
- 4 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 4 rs-reg 4 STWU ;\r
-\r
-: jit-2>r ( -- )\r
- 4 ds-reg 0 LWZ\r
- 5 ds-reg -4 LWZ\r
- ds-reg dup 8 SUBI\r
- rs-reg dup 8 ADDI\r
- 4 rs-reg 0 STW\r
- 5 rs-reg -4 STW ;\r
-\r
-: jit-3>r ( -- )\r
- 4 ds-reg 0 LWZ\r
- 5 ds-reg -4 LWZ\r
- 6 ds-reg -8 LWZ\r
- ds-reg dup 12 SUBI\r
- rs-reg dup 12 ADDI\r
- 4 rs-reg 0 STW\r
- 5 rs-reg -4 STW\r
- 6 rs-reg -8 STW ;\r
-\r
-: jit-r> ( -- )\r
- 4 rs-reg 0 LWZ\r
- rs-reg dup 4 SUBI\r
- 4 ds-reg 4 STWU ;\r
-\r
-: jit-2r> ( -- )\r
- 4 rs-reg 0 LWZ\r
- 5 rs-reg -4 LWZ\r
- rs-reg dup 8 SUBI\r
- ds-reg dup 8 ADDI\r
- 4 ds-reg 0 STW\r
- 5 ds-reg -4 STW ;\r
-\r
-: jit-3r> ( -- )\r
- 4 rs-reg 0 LWZ\r
- 5 rs-reg -4 LWZ\r
- 6 rs-reg -8 LWZ\r
- rs-reg dup 12 SUBI\r
- ds-reg dup 12 ADDI\r
- 4 ds-reg 0 STW\r
- 5 ds-reg -4 STW\r
- 6 ds-reg -8 STW ;\r
-\r
-[\r
- jit->r\r
- 0 BL rc-relative-ppc-3 rt-entry-point jit-rel\r
- jit-r>\r
-] jit-dip jit-define\r
-\r
-[\r
- jit-2>r\r
- 0 BL rc-relative-ppc-3 rt-entry-point jit-rel\r
- jit-2r>\r
-] jit-2dip jit-define\r
-\r
-[\r
- jit-3>r\r
- 0 BL rc-relative-ppc-3 rt-entry-point jit-rel\r
- jit-3r>\r
-] jit-3dip jit-define\r
-\r
-[\r
- 0 1 lr-save stack-frame + LWZ\r
- 1 1 stack-frame ADDI\r
- 0 MTLR\r
-] jit-epilog jit-define\r
-\r
-[ BLR ] jit-return jit-define\r
-\r
-! ! ! Polymorphic inline caches\r
-\r
-! Don't touch r6 here; it's used to pass the tail call site\r
-! address for tail PICs\r
-\r
-! Load a value from a stack position\r
-[\r
- 4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel\r
-] pic-load jit-define\r
-\r
-[ 4 4 tag-mask get ANDI ] pic-tag jit-define\r
-\r
-[\r
- 3 4 MR\r
- 4 4 tag-mask get ANDI\r
- 0 4 tuple type-number CMPI\r
- [ BNE ]\r
- [ 4 3 tuple-class-offset LWZ ]\r
- jit-conditional*\r
-] pic-tuple jit-define\r
-\r
-[\r
- 0 4 0 CMPI rc-absolute-ppc-2 rt-untagged jit-rel\r
-] pic-check-tag jit-define\r
-\r
-[\r
- 0 5 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
- 4 0 5 CMP\r
-] pic-check-tuple jit-define\r
-\r
-[\r
- [ BNE ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional*\r
-] pic-hit jit-define\r
-\r
-! Inline cache miss entry points\r
-: jit-load-return-address ( -- ) 6 MFLR ;\r
-\r
-! These are always in tail position with an existing stack\r
-! frame, and the stack. The frame setup takes this into account.\r
-: jit-inline-cache-miss ( -- )\r
- jit-save-context\r
- 3 6 MR\r
- 4 vm-reg MR\r
- "inline_cache_miss" jit-call\r
- jit-load-context\r
- jit-restore-context ;\r
-\r
-[ jit-load-return-address jit-inline-cache-miss ]\r
-[ 3 MTLR BLRL ]\r
-[ 3 MTCTR BCTR ]\r
-\ inline-cache-miss define-combinator-primitive\r
-\r
-[ jit-inline-cache-miss ]\r
-[ 3 MTLR BLRL ]\r
-[ 3 MTCTR BCTR ]\r
-\ inline-cache-miss-tail define-combinator-primitive\r
-\r
-! ! ! Megamorphic caches\r
-\r
-[\r
- ! class = ...\r
- 3 4 MR\r
- 4 4 tag-mask get ANDI\r
- 4 4 tag-bits get SLWI\r
- 0 4 tuple type-number tag-fixnum CMPI\r
- [ BNE ]\r
- [ 4 3 tuple-class-offset LWZ ]\r
- jit-conditional*\r
- ! cache = ...\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
- ! key = hashcode(class)\r
- 5 4 1 SRAWI\r
- ! key &= cache.length - 1\r
- 5 5 mega-cache-size get 1 - 4 * ANDI\r
- ! cache += array-start-offset\r
- 3 3 array-start-offset ADDI\r
- ! cache += key\r
- 3 3 5 ADD\r
- ! if(get(cache) == class)\r
- 6 3 0 LWZ\r
- 6 0 4 CMP\r
- [ BNE ]\r
- [\r
- ! megamorphic_cache_hits++\r
- 0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel\r
- 5 4 0 LWZ\r
- 5 5 1 ADDI\r
- 5 4 0 STW\r
- ! ... goto get(cache + 4)\r
- 3 3 4 LWZ\r
- 3 3 word-entry-point-offset LWZ\r
- 3 MTCTR\r
- BCTR\r
- ]\r
- jit-conditional*\r
- ! fall-through on miss\r
-] mega-lookup jit-define\r
-\r
-! ! ! Sub-primitives\r
-\r
-! Quotations and words\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
-]\r
-[ jit-call-quot ]\r
-[ jit-jump-quot ] \ (call) define-combinator-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 4 3 word-entry-point-offset LWZ\r
-]\r
-[ 4 MTLR BLRL ]\r
-[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 4 3 word-entry-point-offset LWZ\r
- 4 MTCTR BCTR\r
-] jit-execute jit-define\r
-\r
-! Special primitives\r
-[\r
- nv-reg 3 MR\r
-\r
- 3 vm-reg MR\r
- "begin_callback" jit-call\r
-\r
- jit-load-context\r
- jit-restore-context\r
-\r
- ! Call quotation\r
- 3 nv-reg MR\r
- jit-call-quot\r
-\r
- jit-save-context\r
-\r
- 3 vm-reg MR\r
- "end_callback" jit-call\r
-] \ c-to-factor define-sub-primitive\r
-\r
-[\r
- ! Unwind stack frames\r
- 1 4 MR\r
-\r
- ! Load VM pointer into vm-reg, since we're entering from\r
- ! C code\r
- 0 vm-reg LOAD32 0 rc-absolute-ppc-2/2 jit-vm\r
-\r
- ! Load ds and rs registers\r
- jit-load-context\r
- jit-restore-context\r
-\r
- ! We have changed the stack; load return address again\r
- 0 1 lr-save LWZ\r
- 0 MTLR\r
-\r
- ! Call quotation\r
- jit-call-quot\r
-] \ unwind-native-frames define-sub-primitive\r
-\r
-[\r
- ! Load callstack object\r
- 6 ds-reg 0 LWZ\r
- ds-reg ds-reg 4 SUBI\r
- ! Get ctx->callstack_bottom\r
- jit-load-context\r
- 3 ctx-reg context-callstack-bottom-offset LWZ\r
- ! Get top of callstack object -- 'src' for memcpy\r
- 4 6 callstack-top-offset ADDI\r
- ! Get callstack length, in bytes --- 'len' for memcpy\r
- 5 6 callstack-length-offset LWZ\r
- 5 5 tag-bits get SRAWI\r
- ! Compute new stack pointer -- 'dst' for memcpy\r
- 3 5 3 SUBF\r
- ! Install new stack pointer\r
- 1 3 MR\r
- ! Call memcpy; arguments are now in the correct registers\r
- 1 1 -64 STWU\r
- "factor_memcpy" jit-call\r
- 1 1 0 LWZ\r
- ! Return with new callstack\r
- 0 1 lr-save LWZ\r
- 0 MTLR\r
- BLR\r
-] \ set-callstack define-sub-primitive\r
-\r
-[\r
- jit-save-context\r
- 4 vm-reg MR\r
- "lazy_jit_compile" jit-call\r
-]\r
-[ jit-call-quot ]\r
-[ jit-jump-quot ]\r
-\ lazy-jit-compile define-combinator-primitive\r
-\r
-! Objects\r
-[\r
- 3 ds-reg 0 LWZ\r
- 3 3 tag-mask get ANDI\r
- 3 3 tag-bits get SLWI\r
- 3 ds-reg 0 STW\r
-] \ tag define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZU\r
- 3 3 2 SRAWI\r
- 4 4 0 0 31 tag-bits get - RLWINM\r
- 4 3 3 LWZX\r
- 3 ds-reg 0 STW\r
-] \ slot define-sub-primitive\r
-\r
-[\r
- ! load string index from stack\r
- 3 ds-reg -4 LWZ\r
- 3 3 tag-bits get SRAWI\r
- ! load string from stack\r
- 4 ds-reg 0 LWZ\r
- ! load character\r
- 4 4 string-offset ADDI\r
- 3 3 4 LBZX\r
- 3 3 tag-bits get SLWI\r
- ! store character to stack\r
- ds-reg ds-reg 4 SUBI\r
- 3 ds-reg 0 STW\r
-] \ string-nth-fast define-sub-primitive\r
-\r
-! Shufflers\r
-[\r
- ds-reg dup 4 SUBI\r
-] \ drop define-sub-primitive\r
-\r
-[\r
- ds-reg dup 8 SUBI\r
-] \ 2drop define-sub-primitive\r
-\r
-[\r
- ds-reg dup 12 SUBI\r
-] \ 3drop define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 3 ds-reg 4 STWU\r
-] \ dup define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- ds-reg dup 8 ADDI\r
- 3 ds-reg 0 STW\r
- 4 ds-reg -4 STW\r
-] \ 2dup define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 5 ds-reg -8 LWZ\r
- ds-reg dup 12 ADDI\r
- 3 ds-reg 0 STW\r
- 4 ds-reg -4 STW\r
- 5 ds-reg -8 STW\r
-] \ 3dup define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 3 ds-reg 0 STW\r
-] \ nip define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 8 SUBI\r
- 3 ds-reg 0 STW\r
-] \ 2nip define-sub-primitive\r
-\r
-[\r
- 3 ds-reg -4 LWZ\r
- 3 ds-reg 4 STWU\r
-] \ over define-sub-primitive\r
-\r
-[\r
- 3 ds-reg -8 LWZ\r
- 3 ds-reg 4 STWU\r
-] \ pick define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 4 ds-reg 0 STW\r
- 3 ds-reg 4 STWU\r
-] \ dupd define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 3 ds-reg -4 STW\r
- 4 ds-reg 0 STW\r
-] \ swap define-sub-primitive\r
-\r
-[\r
- 3 ds-reg -4 LWZ\r
- 4 ds-reg -8 LWZ\r
- 3 ds-reg -8 STW\r
- 4 ds-reg -4 STW\r
-] \ swapd define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 5 ds-reg -8 LWZ\r
- 4 ds-reg -8 STW\r
- 3 ds-reg -4 STW\r
- 5 ds-reg 0 STW\r
-] \ rot define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 5 ds-reg -8 LWZ\r
- 3 ds-reg -8 STW\r
- 5 ds-reg -4 STW\r
- 4 ds-reg 0 STW\r
-] \ -rot define-sub-primitive\r
-\r
-[ jit->r ] \ load-local define-sub-primitive\r
-\r
-! Comparisons\r
-: jit-compare ( insn -- )\r
- t jit-literal\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
- 4 ds-reg 0 LWZ\r
- 5 ds-reg -4 LWZU\r
- 5 0 4 CMP\r
- 2 swap execute( offset -- ) ! magic number\r
- \ f type-number 3 LI\r
- 3 ds-reg 0 STW ;\r
-\r
-: define-jit-compare ( insn word -- )\r
- [ [ jit-compare ] curry ] dip define-sub-primitive ;\r
-\r
-\ BEQ \ eq? define-jit-compare\r
-\ BGE \ fixnum>= define-jit-compare\r
-\ BLE \ fixnum<= define-jit-compare\r
-\ BGT \ fixnum> define-jit-compare\r
-\ BLT \ fixnum< define-jit-compare\r
-\r
-! Math\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg ds-reg 4 SUBI\r
- 4 ds-reg 0 LWZ\r
- 3 3 4 OR\r
- 3 3 tag-mask get ANDI\r
- \ f type-number 4 LI\r
- 0 3 0 CMPI\r
- [ BNE ] [ 1 tag-fixnum 4 LI ] jit-conditional*\r
- 4 ds-reg 0 STW\r
-] \ both-fixnums? define-sub-primitive\r
-\r
-: jit-math ( insn -- )\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZU\r
- [ 5 3 4 ] dip execute( dst src1 src2 -- )\r
- 5 ds-reg 0 STW ;\r
-\r
-[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive\r
-\r
-[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZU\r
- 4 4 tag-bits get SRAWI\r
- 5 3 4 MULLW\r
- 5 ds-reg 0 STW\r
-] \ fixnum*fast define-sub-primitive\r
-\r
-[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive\r
-\r
-[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive\r
-\r
-[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 3 3 NOT\r
- 3 3 tag-mask get XORI\r
- 3 ds-reg 0 STW\r
-] \ fixnum-bitnot define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 3 3 tag-bits get SRAWI\r
- ds-reg ds-reg 4 SUBI\r
- 4 ds-reg 0 LWZ\r
- 5 4 3 SLW\r
- 6 3 NEG\r
- 7 4 6 SRAW\r
- 7 7 0 0 31 tag-bits get - RLWINM\r
- 0 3 0 CMPI\r
- [ BGT ] [ 5 7 MR ] jit-conditional*\r
- 5 ds-reg 0 STW\r
-] \ fixnum-shift-fast define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg ds-reg 4 SUBI\r
- 4 ds-reg 0 LWZ\r
- 5 4 3 DIVW\r
- 6 5 3 MULLW\r
- 7 6 4 SUBF\r
- 7 ds-reg 0 STW\r
-] \ fixnum-mod define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg ds-reg 4 SUBI\r
- 4 ds-reg 0 LWZ\r
- 5 4 3 DIVW\r
- 5 5 tag-bits get SLWI\r
- 5 ds-reg 0 STW\r
-] \ fixnum/i-fast define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- 5 4 3 DIVW\r
- 6 5 3 MULLW\r
- 7 6 4 SUBF\r
- 5 5 tag-bits get SLWI\r
- 5 ds-reg -4 STW\r
- 7 ds-reg 0 STW\r
-] \ fixnum/mod-fast define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- 3 3 2 SRAWI\r
- rs-reg 3 3 LWZX\r
- 3 ds-reg 0 STW\r
-] \ get-local define-sub-primitive\r
-\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg ds-reg 4 SUBI\r
- 3 3 2 SRAWI\r
- rs-reg 3 rs-reg SUBF\r
-] \ drop-locals define-sub-primitive\r
-\r
-! Overflowing fixnum arithmetic\r
-:: jit-overflow ( insn func -- )\r
- ds-reg ds-reg 4 SUBI\r
- jit-save-context\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg 4 LWZ\r
- 0 0 LI\r
- 0 MTXER\r
- 6 4 3 insn call( d a s -- )\r
- 6 ds-reg 0 STW\r
- [ BNO ]\r
- [\r
- 5 vm-reg MR\r
- func jit-call\r
- ]\r
- jit-conditional* ;\r
-\r
-[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive\r
-\r
-[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive\r
-\r
-[\r
- ds-reg ds-reg 4 SUBI\r
- jit-save-context\r
- 3 ds-reg 0 LWZ\r
- 3 3 tag-bits get SRAWI\r
- 4 ds-reg 4 LWZ\r
- 0 0 LI\r
- 0 MTXER\r
- 6 3 4 MULLWO.\r
- 6 ds-reg 0 STW\r
- [ BNO ]\r
- [\r
- 4 4 tag-bits get SRAWI\r
- 5 vm-reg MR\r
- "overflow_fixnum_multiply" jit-call\r
- ]\r
- jit-conditional*\r
-] \ fixnum* define-sub-primitive\r
-\r
-! Contexts\r
-: jit-switch-context ( reg -- )\r
- ! Save ds, rs registers\r
- jit-save-context\r
-\r
- ! Make the new context the current one\r
- ctx-reg swap MR\r
- ctx-reg vm-reg vm-context-offset STW\r
-\r
- ! Load new stack pointer\r
- 1 ctx-reg context-callstack-top-offset LWZ\r
-\r
- ! Load new ds, rs registers\r
- jit-restore-context ;\r
-\r
-: jit-pop-context-and-param ( -- )\r
- 3 ds-reg 0 LWZ\r
- 3 3 alien-offset LWZ\r
- 4 ds-reg -4 LWZ\r
- ds-reg ds-reg 8 SUBI ;\r
-\r
-: jit-push-param ( -- )\r
- ds-reg ds-reg 4 ADDI\r
- 4 ds-reg 0 STW ;\r
-\r
-: jit-set-context ( -- )\r
- jit-pop-context-and-param\r
- 3 jit-switch-context\r
- jit-push-param ;\r
-\r
-[ jit-set-context ] \ (set-context) define-sub-primitive\r
-\r
-: jit-pop-quot-and-param ( -- )\r
- 3 ds-reg 0 LWZ\r
- 4 ds-reg -4 LWZ\r
- ds-reg ds-reg 8 SUBI ;\r
-\r
-: jit-start-context ( -- )\r
- ! Create the new context in return-reg\r
- 3 vm-reg MR\r
- "new_context" jit-call\r
- 6 3 MR\r
-\r
- jit-pop-quot-and-param\r
-\r
- 6 jit-switch-context\r
-\r
- jit-push-param\r
-\r
- jit-jump-quot ;\r
-\r
-[ jit-start-context ] \ (start-context) define-sub-primitive\r
-\r
-: jit-delete-current-context ( -- )\r
- jit-load-context\r
- 3 vm-reg MR\r
- 4 ctx-reg MR\r
- "delete_context" jit-call ;\r
-\r
-[\r
- jit-delete-current-context\r
- jit-set-context\r
-] \ (set-context-and-delete) define-sub-primitive\r
-\r
-[\r
- jit-delete-current-context\r
- jit-start-context\r
-] \ (start-context-and-delete) define-sub-primitive\r
-\r
-[ "bootstrap.ppc" forget-vocab ] with-compilation-unit\r
+++ /dev/null
-! 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
+++ /dev/null
-! 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 ;
+++ /dev/null
-Linux/PPC ABI support
+++ /dev/null
-not loaded
+++ /dev/null
-! 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
+++ /dev/null
-! 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 ;
+++ /dev/null
-Mac OS X/PPC ABI support
+++ /dev/null
-not loaded
+++ /dev/null
-! 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
+++ /dev/null
-32-bit PowerPC compiler backend
+++ /dev/null
-compiler
-not loaded
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
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
+++ /dev/null
-include vm/Config.linux
-include vm/Config.ppc
-CFLAGS += -mregnames
--- /dev/null
+include vm/Config.linux
+PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
+CFLAGS += -m32
--- /dev/null
+include vm/Config.linux
+PLAF_DLL_OBJS += vm/cpu-ppc.linux.o
+CFLAGS += -m64
include vm/Config.macosx
-include vm/Config.ppc
+PLAF_DLL_OBJS += vm/cpu-ppc.macosx.o
CFLAGS += -arch ppc -force_cpusubtype_ALL
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
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
+++ /dev/null
-PLAF_DLL_OBJS += vm/cpu-ppc.o
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
ctx->push(allot_alien(ffi_dlsym(NULL,sym)));
}
+/* look up a symbol in a native library */
+void factor_vm::primitive_dlsym_raw()
+{
+ data_root<object> library(ctx->pop(),this);
+ data_root<byte_array> name(ctx->pop(),this);
+ name.untag_check(this);
+
+ symbol_char *sym = name->data<symbol_char>();
+
+ if(to_boolean(library.value()))
+ {
+ dll *d = untag_check<dll>(library.value());
+
+ if(d->handle == NULL)
+ ctx->push(false_object);
+ else
+ ctx->push(allot_alien(ffi_dlsym_raw(d,sym)));
+ }
+ else
+ ctx->push(allot_alien(ffi_dlsym_raw(NULL,sym)));
+}
+
+
/* close a native library handle */
void factor_vm::primitive_dlclose()
{
#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
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;
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)
tagged<word> w(ctx->pop());
w.untag_check(this);
- ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->entry_point()));
+
+ void* func = callbacks->add(w.value(),return_rewind)->entry_point();
+ CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
+ ctx->push(allot_alien(func));
}
}
template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
{
data_root<callstack> stack(stack_,this);
- fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
+ fixnum frame_offset = factor::untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
{
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
+ void* undefined_symbol = (void*)factor::undefined_symbol;
+ undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
if(d != NULL && !d->handle)
- return (cell)factor::undefined_symbol;
+ return (cell)undefined_symbol;
switch(tagged<object>(symbol).type())
{
if(sym)
return (cell)sym;
else
- return (cell)factor::undefined_symbol;
+ return (cell)undefined_symbol;
}
case ARRAY_TYPE:
{
if(sym)
return (cell)sym;
}
- return (cell)factor::undefined_symbol;
+ return (cell)undefined_symbol;
}
default:
critical_error("Bad symbol specifier",symbol);
- return (cell)factor::undefined_symbol;
+ return (cell)undefined_symbol;
}
}
+#ifdef FACTOR_PPC
+cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
+{
+ cell symbol = array_nth(literals,index);
+ cell library = array_nth(literals,index + 1);
+
+ dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
+
+ void* undefined_toc = (void*)factor::undefined_symbol;
+ undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
+ if(d != NULL && !d->handle)
+ return (cell)undefined_toc;
+
+ switch(tagged<object>(symbol).type())
+ {
+ case BYTE_ARRAY_TYPE:
+ {
+ symbol_char *name = alien_offset(symbol);
+ void* toc = ffi_dlsym_toc(d,name);
+ if(toc)
+ return (cell)toc;
+ else
+ return (cell)undefined_toc;
+ }
+ case ARRAY_TYPE:
+ {
+ array *names = untag<array>(symbol);
+ for(cell i = 0; i < array_capacity(names); i++)
+ {
+ symbol_char *name = alien_offset(array_nth(names,i));
+ void *toc = ffi_dlsym_toc(d,name);
+
+ if(toc)
+ return (cell)toc;
+ }
+ return (cell)undefined_toc;
+ }
+ default:
+ critical_error("Bad symbol specifier",symbol);
+ return (cell)undefined_toc;
+ }
+}
+#endif
+
+
cell factor_vm::compute_vm_address(cell arg)
{
return (cell)this + untag_fixnum(arg);
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());
+++ /dev/null
-#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
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)
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):);
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;
}
--- /dev/null
+ .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
{
tagged<word> c_to_factor_word(special_objects[C_TO_FACTOR_WORD]);
code_block *c_to_factor_block = callbacks->add(c_to_factor_word.value(),0);
- c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->entry_point();
+ void* func = c_to_factor_block->entry_point();
+ CODE_TO_FUNCTION_POINTER_CALLBACK(this, func);
+ c_to_factor_func = (c_to_factor_func_type)func;
}
-
c_to_factor_func(quot);
}
void factor_vm::unwind_native_frames(cell quot, stack_frame *to)
{
- get_entry_point<unwind_native_frames_func_type>(UNWIND_NATIVE_FRAMES_WORD)(quot,to);
+ tagged<word> entry_point_word(special_objects[UNWIND_NATIVE_FRAMES_WORD]);
+ void *func = entry_point_word->code->entry_point();
+ CODE_TO_FUNCTION_POINTER(func);
+ ((unwind_native_frames_func_type)func)(quot,to);
}
cell factor_vm::get_fpu_state()
{
- return get_entry_point<get_fpu_state_func_type>(GET_FPU_STATE_WORD)();
+ tagged<word> entry_point_word(special_objects[GET_FPU_STATE_WORD]);
+ void *func = entry_point_word->code->entry_point();
+ CODE_TO_FUNCTION_POINTER(func);
+ return ((get_fpu_state_func_type)func)();
}
void factor_vm::set_fpu_state(cell state)
{
- get_entry_point<set_fpu_state_func_type>(GET_FPU_STATE_WORD)(state);
+ tagged<word> entry_point_word(special_objects[SET_FPU_STATE_WORD]);
+ void *func = entry_point_word->code->entry_point();
+ CODE_TO_FUNCTION_POINTER(func);
+ ((set_fpu_state_func_type)func)(state);
}
}
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)
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)
/* 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)
{
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:
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;
/* 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)
{
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);
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;
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 {
/* 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 */
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 {
case RT_VM:
return 1;
case RT_DLSYM:
+ case RT_DLSYM_TOC:
return 2;
case RT_ENTRY_POINT:
case RT_ENTRY_POINT_PIC:
}
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();
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);
#ifndef __FACTOR_MASTER_H__
#define __FACTOR_MASTER_H__
+#ifndef _THREAD_SAFE
#define _THREAD_SAFE
+#endif
+
+#ifndef _REENTRANT
#define _REENTRANT
+#endif
#ifndef WINCE
#include <errno.h>
#include <string.h>
#include <time.h>
#include <wchar.h>
+#include <assert.h>
/* C++ headers */
#include <algorithm>
#include <iostream>
#include <iomanip>
-#define FACTOR_STRINGIZE(x) #x
+#define FACTOR_STRINGIZE_I(x) #x
+#define FACTOR_STRINGIZE(x) FACTOR_STRINGIZE_I(x)
/* Record compiler version */
#if defined(__clang__)
#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"
#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
#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
}
--- /dev/null
+#include <ucontext.h>
+
+namespace factor
+{
+
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
+#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[1]
+#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[32])
+#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
+
+#define CODE_TO_FUNCTION_POINTER(code) (void)0
+#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) (void)0
+#define FUNCTION_CODE_POINTER(ptr) ptr
+#define FUNCTION_TOC_POINTER(ptr) ptr
+
+#define UAP_STACK_POINTER_TYPE unsigned long
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ union {
+ double as_double;
+ unsigned int as_uint[2];
+ } tmp;
+ tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr;
+ return tmp.as_uint[1];
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ union {
+ double as_double;
+ unsigned int as_uint[2];
+ } tmp;
+ tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr;
+ tmp.as_uint[1] &= 0x0007f8ff;
+ ((ucontext_t*) uap)->uc_mcontext.uc_regs->fpregs.fpscr = tmp.as_double;
+}
+
+}
--- /dev/null
+#include <ucontext.h>
+
+namespace factor
+{
+
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 2)
+#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.gp_regs[1]
+#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gp_regs[32])
+#define UAP_SET_TOC_POINTER(uap, ptr) (void)0
+
+#define FACTOR_PPC_TOC 1
+
+#define CODE_TO_FUNCTION_POINTER(code) \
+ void *desc[3]; \
+ code = fill_function_descriptor(desc, code)
+
+#define CODE_TO_FUNCTION_POINTER_CALLBACK(vm, code) \
+ code = fill_function_descriptor(new void*[3], code); \
+ vm->function_descriptors.push_back((void **)code)
+
+#define FUNCTION_CODE_POINTER(ptr) \
+ (function_descriptor_field((void *)ptr, 0))
+
+#define FUNCTION_TOC_POINTER(ptr) \
+ (function_descriptor_field((void *)ptr, 1))
+
+#define UAP_STACK_POINTER_TYPE unsigned long
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ union {
+ double as_double;
+ unsigned int as_uint[2];
+ } tmp;
+ tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.fp_regs[32];
+ return tmp.as_uint[1];
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ union {
+ double as_double;
+ unsigned int as_uint[2];
+ } tmp;
+ tmp.as_double = ((ucontext_t*) uap)->uc_mcontext.fp_regs[32];
+ tmp.as_uint[1] &= 0x0007f8ff;
+ ((ucontext_t*) uap)->uc_mcontext.fp_regs[32] = tmp.as_double;
+}
+
+}
+++ /dev/null
-#include <ucontext.h>
-
-namespace factor
-{
-
-#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
-#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_R1]
-#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_NIP])
-
-}
#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
}
#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
}
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
-
}
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
}
#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
#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
#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
}
#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
}
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)
{
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);
}
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);
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);
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
}
#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)
_(dll_validp) \
_(dlopen) \
_(dlsym) \
+ _(dlsym_raw) \
_(double_bits) \
_(enable_gc_events) \
_(existsp) \
#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++;
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)
{
#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);
delete signal_callstack_seg;
signal_callstack_seg = NULL;
}
+ std::list<void **>::const_iterator iter = function_descriptors.begin();
+ std::list<void **>::const_iterator end = function_descriptors.end();
+ while(iter != end)
+ {
+ delete [] *iter;
+ iter++;
+ }
}
}
/* Next callback ID */
int callback_id;
+ /* List of callback function descriptors for PPC */
+ std::list<void **> function_descriptors;
+
/* Pooling unused contexts to make context allocation cheaper */
std::list<context *> unused_contexts;
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);
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);
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();
projects / factor.git / commitdiff