compiler.tree: remove some code duplication concerning #alien nodes

db4
Slava Pestov 2010-01-07 16:06:07 +13:00
parent 89e9f77b44
commit 44a604fdbe
6 changed files with 8 additions and 26 deletions

View File

@ -185,9 +185,7 @@ M: #recursive check-stack-flow*
M: #copy check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #alien-invoke check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #alien-indirect check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #alien-node check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #alien-callback check-stack-flow* drop ;

View File

@ -28,9 +28,7 @@ M: method-body flushable? "method-generic" word-prop flushable? ;
M: #call mark-live-values*
dup flushable-call? [ drop ] [ look-at-inputs ] if ;
M: #alien-invoke mark-live-values* look-at-inputs ;
M: #alien-indirect mark-live-values* look-at-inputs ;
M: #alien-node mark-live-values* look-at-inputs ;
M: #return mark-live-values* look-at-inputs ;
@ -47,9 +45,7 @@ M: #call compute-live-values* nip look-at-inputs ;
M: #shuffle compute-live-values*
mapping>> at look-at-value ;
M: #alien-invoke compute-live-values* nip look-at-inputs ;
M: #alien-indirect compute-live-values* nip look-at-inputs ;
M: #alien-node compute-live-values* nip look-at-inputs ;
: filter-mapping ( assoc -- assoc' )
live-values get '[ drop _ key? ] assoc-filter ;
@ -127,8 +123,5 @@ M: #terminate remove-dead-code*
[ filter-live ] change-in-d
[ filter-live ] change-in-r ;
M: #alien-invoke remove-dead-code*
maybe-drop-dead-outputs ;
M: #alien-indirect remove-dead-code*
M: #alien-node remove-dead-code*
maybe-drop-dead-outputs ;

View File

@ -86,12 +86,7 @@ M: #call escape-analysis*
M: #return escape-analysis*
in-d>> add-escaping-values ;
M: #alien-invoke escape-analysis*
[ in-d>> add-escaping-values ]
[ out-d>> unknown-allocations ]
bi ;
M: #alien-indirect escape-analysis*
M: #alien-node escape-analysis*
[ in-d>> add-escaping-values ]
[ out-d>> unknown-allocations ]
bi ;

View File

@ -153,8 +153,6 @@ M: #call propagate-after
[ out-d>> ] [ params>> return>> ] bi
[ drop ] [ c-type-class <class-info> swap first set-value-info ] if-void ;
M: #alien-invoke propagate-before propagate-alien-invoke ;
M: #alien-indirect propagate-before propagate-alien-invoke ;
M: #alien-node propagate-before propagate-alien-invoke ;
M: #return annotate-node dup in-d>> (annotate-node) ;

View File

@ -149,7 +149,7 @@ TUPLE: #alien-indirect < #alien-node in-d out-d ;
: #alien-indirect ( params -- node )
\ #alien-indirect new-alien-node ;
TUPLE: #alien-callback < #alien-node ;
TUPLE: #alien-callback < node params ;
: #alien-callback ( params -- node )
\ #alien-callback new

View File

@ -164,9 +164,7 @@ M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #return unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #alien-invoke unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #alien-indirect unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #alien-node unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #alien-callback unbox-tuples* ;