From 868009aaeef0f3ab3c975413facbce842993b23c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Aug 2009 22:20:49 -0500 Subject: [PATCH] compiler.cfg.intrinsics: cleanup: the "intrinsic" word property is now a quotation, not a boolean, making this mechanism more extensible --- .../compiler/cfg/intrinsics/intrinsics.factor | 257 ++++++------------ 1 file changed, 88 insertions(+), 169 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 28d3243ba9..9766c658c9 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: words sequences kernel combinators cpu.architecture +USING: words sequences kernel combinators cpu.architecture assocs compiler.cfg.hats compiler.cfg.instructions compiler.cfg.intrinsics.alien @@ -25,201 +25,120 @@ QUALIFIED: math.floats.private QUALIFIED: math.libm IN: compiler.cfg.intrinsics -: enable-intrinsics ( words -- ) - [ t "intrinsic" set-word-prop ] each ; +: enable-intrinsics ( alist -- ) + [ "intrinsic" set-word-prop ] assoc-each ; { - kernel.private:tag - kernel.private:getenv - math.private:both-fixnums? - math.private:fixnum+ - math.private:fixnum- - math.private:fixnum* - math.private:fixnum+fast - math.private:fixnum-fast - math.private:fixnum-bitand - math.private:fixnum-bitor - math.private:fixnum-bitxor - math.private:fixnum-shift-fast - math.private:fixnum-bitnot - math.private:fixnum*fast - math.private:fixnum< - math.private:fixnum<= - math.private:fixnum>= - math.private:fixnum> - ! math.private:bignum>fixnum - ! math.private:fixnum>bignum - kernel:eq? - slots.private:slot - slots.private:set-slot - strings.private:string-nth - strings.private:set-string-nth-fast - classes.tuple.private: - arrays: - byte-arrays: - byte-arrays:(byte-array) - kernel: - alien: - alien.accessors:alien-unsigned-1 - alien.accessors:set-alien-unsigned-1 - alien.accessors:alien-signed-1 - alien.accessors:set-alien-signed-1 - alien.accessors:alien-unsigned-2 - alien.accessors:set-alien-unsigned-2 - alien.accessors:alien-signed-2 - alien.accessors:set-alien-signed-2 - alien.accessors:alien-cell - alien.accessors:set-alien-cell + { kernel.private:tag [ drop emit-tag ] } + { kernel.private:getenv [ emit-getenv ] } + { math.private:both-fixnums? [ drop emit-both-fixnums? ] } + { math.private:fixnum+ [ drop emit-fixnum+ ] } + { math.private:fixnum- [ drop emit-fixnum- ] } + { math.private:fixnum* [ drop emit-fixnum* ] } + { math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] } + { math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] } + { math.private:fixnum*fast [ drop emit-fixnum*fast ] } + { math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] } + { math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] } + { math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] } + { math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] } + { math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] } + { math.private:fixnum< [ drop cc< emit-fixnum-comparison ] } + { math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] } + { math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] } + { math.private:fixnum> [ drop cc> emit-fixnum-comparison ] } + { kernel:eq? [ drop cc= emit-fixnum-comparison ] } + { slots.private:slot [ emit-slot ] } + { slots.private:set-slot [ emit-set-slot ] } + { strings.private:string-nth [ drop emit-string-nth ] } + { strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] } + { classes.tuple.private: [ emit- ] } + { arrays: [ emit- ] } + { byte-arrays: [ emit- ] } + { byte-arrays:(byte-array) [ emit-(byte-array) ] } + { kernel: [ emit-simple-allot ] } + { alien: [ emit- ] } + { alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] } + { alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] } + { alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] } + { alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] } + { alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] } + { alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] } + { alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] } + { alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] } + { alien.accessors:alien-cell [ emit-alien-cell-getter ] } + { alien.accessors:set-alien-cell [ emit-alien-cell-setter ] } } enable-intrinsics : enable-alien-4-intrinsics ( -- ) { - alien.accessors:alien-unsigned-4 - alien.accessors:set-alien-unsigned-4 - alien.accessors:alien-signed-4 - alien.accessors:set-alien-signed-4 + { alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] } + { alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] } + { alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] } + { alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] } } enable-intrinsics ; : enable-float-intrinsics ( -- ) { - math.private:float+ - math.private:float- - math.private:float* - math.private:float/f - math.private:fixnum>float - math.private:float>fixnum - math.private:float< - math.private:float<= - math.private:float> - math.private:float>= - math.private:float= - alien.accessors:alien-float - alien.accessors:set-alien-float - alien.accessors:alien-double - alien.accessors:set-alien-double + { math.private:float+ [ drop [ ^^add-float ] emit-float-op ] } + { math.private:float- [ drop [ ^^sub-float ] emit-float-op ] } + { math.private:float* [ drop [ ^^mul-float ] emit-float-op ] } + { math.private:float/f [ drop [ ^^div-float ] emit-float-op ] } + { math.private:float< [ drop cc< emit-float-comparison ] } + { math.private:float<= [ drop cc<= emit-float-comparison ] } + { math.private:float>= [ drop cc>= emit-float-comparison ] } + { math.private:float> [ drop cc> emit-float-comparison ] } + { math.private:float= [ drop cc= emit-float-comparison ] } + { math.private:float>fixnum [ drop emit-float>fixnum ] } + { math.private:fixnum>float [ drop emit-fixnum>float ] } + { alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] } + { alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] } + { alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] } + { alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] } } enable-intrinsics ; : enable-fsqrt ( -- ) - \ math.libm:fsqrt t "intrinsic" set-word-prop ; + { + { math.libm:fsqrt [ drop emit-fsqrt ] } + } enable-intrinsics ; : enable-float-min/max ( -- ) { - math.floats.private:float-min - math.floats.private:float-max + { math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] } + { math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] } } enable-intrinsics ; : enable-float-functions ( -- ) ! Everything except for fsqrt { - math.libm:facos - math.libm:fasin - math.libm:fatan - math.libm:fatan2 - math.libm:fcos - math.libm:fsin - math.libm:ftan - math.libm:fcosh - math.libm:fsinh - math.libm:ftanh - math.libm:fexp - math.libm:flog - math.libm:fpow - math.libm:facosh - math.libm:fasinh - math.libm:fatanh + { math.libm:facos [ drop "acos" emit-unary-float-function ] } + { math.libm:fasin [ drop "asin" emit-unary-float-function ] } + { math.libm:fatan [ drop "atan" emit-unary-float-function ] } + { math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] } + { math.libm:fcos [ drop "cos" emit-unary-float-function ] } + { math.libm:fsin [ drop "sin" emit-unary-float-function ] } + { math.libm:ftan [ drop "tan" emit-unary-float-function ] } + { math.libm:fcosh [ drop "cosh" emit-unary-float-function ] } + { math.libm:fsinh [ drop "sinh" emit-unary-float-function ] } + { math.libm:ftanh [ drop "tanh" emit-unary-float-function ] } + { math.libm:fexp [ drop "exp" emit-unary-float-function ] } + { math.libm:flog [ drop "log" emit-unary-float-function ] } + { math.libm:fpow [ drop "pow" emit-binary-float-function ] } + { math.libm:facosh [ drop "acosh" emit-unary-float-function ] } + { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] } + { math.libm:fatanh [ drop "atanh" emit-unary-float-function ] } } enable-intrinsics ; : enable-min/max ( -- ) { - math.integers.private:fixnum-min - math.integers.private:fixnum-max + { math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] } + { math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] } } enable-intrinsics ; : enable-fixnum-log2 ( -- ) - { math.integers.private:fixnum-log2 } enable-intrinsics ; + { + { math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] } + } enable-intrinsics ; : emit-intrinsic ( node word -- ) - { - { \ kernel.private:tag [ drop emit-tag ] } - { \ kernel.private:getenv [ emit-getenv ] } - { \ math.private:both-fixnums? [ drop emit-both-fixnums? ] } - { \ math.private:fixnum+ [ drop emit-fixnum+ ] } - { \ math.private:fixnum- [ drop emit-fixnum- ] } - { \ math.private:fixnum* [ drop emit-fixnum* ] } - { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] } - { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] } - { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] } - { \ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] } - { \ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] } - { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] } - { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] } - { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] } - { \ math.private:fixnum*fast [ drop emit-fixnum*fast ] } - { \ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] } - { \ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] } - { \ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] } - { \ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] } - { \ kernel:eq? [ drop cc= emit-fixnum-comparison ] } - { \ math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] } - { \ math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] } - { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] } - { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] } - { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] } - { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] } - { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] } - { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] } - { \ math.private:float< [ drop cc< emit-float-comparison ] } - { \ math.private:float<= [ drop cc<= emit-float-comparison ] } - { \ math.private:float>= [ drop cc>= emit-float-comparison ] } - { \ math.private:float> [ drop cc> emit-float-comparison ] } - { \ math.private:float= [ drop cc= emit-float-comparison ] } - { \ math.private:float>fixnum [ drop emit-float>fixnum ] } - { \ math.private:fixnum>float [ drop emit-fixnum>float ] } - { \ math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] } - { \ math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] } - { \ math.libm:fsqrt [ drop emit-fsqrt ] } - { \ math.libm:facos [ drop "acos" emit-unary-float-function ] } - { \ math.libm:fasin [ drop "asin" emit-unary-float-function ] } - { \ math.libm:fatan [ drop "atan" emit-unary-float-function ] } - { \ math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] } - { \ math.libm:fcos [ drop "cos" emit-unary-float-function ] } - { \ math.libm:fsin [ drop "sin" emit-unary-float-function ] } - { \ math.libm:ftan [ drop "tan" emit-unary-float-function ] } - { \ math.libm:fcosh [ drop "cosh" emit-unary-float-function ] } - { \ math.libm:fsinh [ drop "sinh" emit-unary-float-function ] } - { \ math.libm:ftanh [ drop "tanh" emit-unary-float-function ] } - { \ math.libm:fexp [ drop "exp" emit-unary-float-function ] } - { \ math.libm:flog [ drop "log" emit-unary-float-function ] } - { \ math.libm:fpow [ drop "pow" emit-binary-float-function ] } - { \ math.libm:facosh [ drop "acosh" emit-unary-float-function ] } - { \ math.libm:fasinh [ drop "asinh" emit-unary-float-function ] } - { \ math.libm:fatanh [ drop "atanh" emit-unary-float-function ] } - { \ slots.private:slot [ emit-slot ] } - { \ slots.private:set-slot [ emit-set-slot ] } - { \ strings.private:string-nth [ drop emit-string-nth ] } - { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] } - { \ classes.tuple.private: [ emit- ] } - { \ arrays: [ emit- ] } - { \ byte-arrays: [ emit- ] } - { \ byte-arrays:(byte-array) [ emit-(byte-array) ] } - { \ kernel: [ emit-simple-allot ] } - { \ alien: [ emit- ] } - { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] } - { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] } - { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] } - { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] } - { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] } - { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] } - { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] } - { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] } - { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] } - { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] } - { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] } - { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] } - { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] } - { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] } - { \ alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] } - { \ alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] } - { \ alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] } - { \ alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] } - } case ; + "intrinsic" word-prop call( node -- ) ;