diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index f1245527ec..137f7748ed 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -105,24 +105,35 @@ sequences vectors words ; : binary-op ( node op -- ) >r load-inputs first2 swap dup r> execute , out-1 ; inline -[ - [[ fixnum+ %fixnum+ ]] - [[ fixnum- %fixnum- ]] - [[ fixnum* %fixnum* ]] - [[ fixnum/i %fixnum/i ]] - [[ fixnum-bitand %fixnum-bitand ]] - [[ fixnum-bitor %fixnum-bitor ]] - [[ fixnum-bitxor %fixnum-bitxor ]] - [[ fixnum<= %fixnum<= ]] - [[ fixnum< %fixnum< ]] - [[ fixnum>= %fixnum>= ]] - [[ fixnum> %fixnum> ]] - [[ eq? %eq? ]] -] [ - uncons [ literalize , \ binary-op , ] [ ] make +{ + { fixnum+ %fixnum+ } + { fixnum- %fixnum- } + { fixnum* %fixnum* } + { fixnum/i %fixnum/i } + { fixnum-bitand %fixnum-bitand } + { fixnum-bitor %fixnum-bitor } + { fixnum-bitxor %fixnum-bitxor } +} [ + first2 [ literalize , \ binary-op , ] [ ] make "intrinsic" set-word-prop ] each +: binary-jump ( node label op -- ) + >r >r node-in-d values>vregs + dup length neg %inc-d , first2 swap + r> r> execute , ; inline + +{ + { fixnum<= %jump-fixnum<= } + { fixnum< %jump-fixnum< } + { fixnum>= %jump-fixnum>= } + { fixnum> %jump-fixnum> } + { eq? %jump-eq? } +} [ + first2 [ literalize , \ binary-jump , ] [ ] make + "ifte-intrinsic" set-word-prop +] each + \ fixnum-mod [ ! This is not clever. Because of x86, %fixnum-mod is ! hard-coded to put its output in vreg 2, which happends to diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor index 845080b4be..d8856d9a39 100644 --- a/library/compiler/linearizer.factor +++ b/library/compiler/linearizer.factor @@ -35,24 +35,33 @@ M: #label linearize* ( node -- ) : intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ; +: ifte-intrinsic ( #call -- quot ) + dup node-successor #ifte? + [ node-param "ifte-intrinsic" word-prop ] [ drop f ] ifte ; + +: linearize-ifte ( node label -- ) + #! Assume the quotation emits a VOP that jumps to the label + #! if some condition holds; we linearize the false branch, + #! then the label, then the true branch. + >r node-children first2 linearize* r> %label , linearize* ; + M: #call linearize* ( node -- ) - dup intrinsic [ - dupd call linearize-next + dup ifte-intrinsic [ + >r