Generate if-intrinsics in more cases

library/compiler/generator/generator.factor

@@ -12,16 +12,19 @@ M: object stack-reserve* drop 0 ;
 : stack-reserve ( node -- n )
     0 swap [ stack-reserve* max ] each-node ;
 
+: intrinsic ( #call -- quot )
+    node-param "intrinsic" word-prop ;
+
 : if-intrinsic ( #call -- quot )
-    dup node-successor #if?
+    node-param "if-intrinsic" word-prop ;
-    [ node-param "if-intrinsic" word-prop ] [ drop f ] if ;
 
 DEFER: #terminal?
 
 PREDICATE: #merge #terminal-merge node-successor #terminal? ;
 
 PREDICATE: #call #terminal-call
-    dup node-successor node-successor #terminal?
+    dup node-successor #if?
+    over node-successor node-successor #terminal? and
     swap if-intrinsic and ;
 
 UNION: #terminal
@@ -108,10 +111,13 @@ M: #label generate-node ( node -- next )
     swap node-child generate-word r> ;
 
 ! #if
+: end-false-branch ( label -- )
+    tail-call? [ %return drop ] [ %jump-label ] if ;
+
 : generate-if ( node label -- next )
     <label> [
         >r >r node-children first2 generate-nodes
-        r> r> %jump-label save-xt generate-nodes
+        r> r> end-false-branch save-xt generate-nodes
     ] keep save-xt iterate-next ;
 
 M: #if generate-node ( node -- next )
@@ -129,19 +135,32 @@ M: #if generate-node ( node -- next )
 : define-intrinsic ( word quot template -- | quot: -- )
     [with-template] "intrinsic" set-word-prop ;
 
-: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ;
-
 : define-if-intrinsic ( word quot template -- | quot: label -- )
     [with-template] "if-intrinsic" set-word-prop ;
 
-M: #call generate-node ( node -- next )
+: if>boolean-intrinsic ( label -- )
-    dup if-intrinsic [
+    <label> "end" set
-        >r <label> dup r> call
+    f T{ vreg f 0 } load-literal
-        >r node-successor r> generate-if node-successor
+    "end" get %jump-label
+    save-xt
+    t T{ vreg f 0 } load-literal
+    "end" get save-xt
+    T{ vreg f 0 } phantom-d get phantom-push ;
+
+: do-if-intrinsic ( node -- next )
+    [ <label> dup ] keep if-intrinsic call
+    >r node-successor dup #if? [
+        r> generate-if node-successor
     ] [
-        dup intrinsic
+        drop r> if>boolean-intrinsic iterate-next
-        [ call iterate-next ] [ node-param generate-call ] ?if
+    ] if ;
-    ] if* ;
+
+M: #call generate-node ( node -- next )
+    {
+        { [ dup if-intrinsic ] [ do-if-intrinsic ] }
+        { [ dup intrinsic ] [ intrinsic call iterate-next ] }
+        { [ t ] [ node-param generate-call ] }
+    } cond ;
 
 ! #call-label
 M: #call-label generate-node ( node -- next )

library/compiler/generator/templates.factor

@@ -211,6 +211,9 @@ SYMBOL: phantom-r
     over length swap cut-phantom
     swap phantom-vregs ;
 
+: phantom-push ( obj stack -- )
+    1 over adjust-phantom push ;
+
 : phantom-append ( seq stack -- )
     over length over adjust-phantom swap nappend ;
 
@@ -251,7 +254,7 @@ SYMBOL: +clobber
     append ;
 
 : guess-vregs ( -- n )
-    +input get dup { } additional-vregs# +scratch get length + ;
+    +input get { } additional-vregs# +scratch get length + ;
 
 : alloc-scratch ( -- )
     +scratch get [ alloc-vregs [ <vreg> ] map ] keep
@@ -263,7 +266,7 @@ SYMBOL: +clobber
     guess-vregs ensure-vregs
     ! Split the template into available (fast) parts and those
     ! that require allocating registers and reading the stack
-    match-template fast-input
+    +input get match-template fast-input
     used-vregs adjust-free-vregs
     slow-input
     alloc-scratch

library/compiler/ppc/intrinsics.factor

@@ -106,11 +106,10 @@ math-internals namespaces sequences words ;
     ! divide x by y, store result in x
     "r" operand "x" operand "y" operand DIVW
     generate-fixnum-mod
-    "x" operand "s" operand MR
 ] H{
     { +input { { f "x" } { f "y" } } }
     { +scratch { { f "r" } { f "s" } } }
-    { +output { "x" } }
+    { +output { "s" } }
 } define-intrinsic
 
 \ fixnum-bitnot [