diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index 34a998abe1..1f53b6d535 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -123,6 +123,7 @@ namespaces sequences words ; "y" get "x" get "out" get %fixnum-mod , ] H{ { +input { { 0 "x" } { 1 "y" } } } + ! { +scratch { { 2 "out" } } } { +output { "out" } } } with-template ] "intrinsic" set-word-prop @@ -131,13 +132,13 @@ namespaces sequences words ; ! See the remark on fixnum-mod for vreg usage [ finalize-contents - T{ vreg f 0 } "quo" set T{ vreg f 2 } "rem" set "y" get "x" get 2array - "rem" get "quo" get 2array %fixnum/mod , + "rem" get "x" get 2array %fixnum/mod , ] H{ { +input { { 0 "x" } { 1 "y" } } } - { +output { "quo" "rem" } } + ! { +scratch { { 2 "rem" } } } + { +output { "x" "rem" } } } with-template ] "intrinsic" set-word-prop diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor index d36e214473..f26a1506b4 100644 --- a/library/compiler/linearizer.factor +++ b/library/compiler/linearizer.factor @@ -15,10 +15,23 @@ DEFER: #terminal? PREDICATE: #merge #terminal-merge node-successor #terminal? ; -UNION: #terminal POSTPONE: f #return #values #terminal-merge ; +: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ; + +: if-intrinsic ( #call -- quot ) + dup node-successor #if? + [ node-param "if-intrinsic" word-prop ] [ drop f ] if ; + +PREDICATE: #call #terminal-call + dup node-successor node-successor #terminal? + swap if-intrinsic and ; + +UNION: #terminal + POSTPONE: f #return #values #terminal-merge ; : tail-call? ( -- ? ) - node-stack get [ node-successor ] map [ #terminal? ] all? ; + node-stack get [ + dup #terminal-call? swap node-successor #terminal? or + ] all? ; GENERIC: linearize* ( node -- next ) @@ -74,12 +87,6 @@ M: #label linearize* ( node -- next ) dup node-param dup linearize-call-label >r renamed-label swap node-child linearize-1 r> ; -: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ; - -: if-intrinsic ( #call -- quot ) - dup node-successor #if? - [ node-param "if-intrinsic" word-prop ] [ drop f ] if ; - : linearize-if ( node label -- next )