diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 8c68512d5f..ce8146285d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -12,14 +12,13 @@ - handle recursion with when, when* etc - optimizer rewrite stack ops - alien-call need special nodes -- fix dataflow unit tests +- mutual recursion is borked with certain branch order +- fix inference of + = and others + linearizer/generator: - peephole optimizer - linearize generic, 2generic -- generate conditionals -- generator needs to be aware of labels - getenv/setenv: if literal arg, compile as a load/store - compiler: drop literal peephole optimization diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index 9f39f27def..fd384114f3 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -44,9 +44,15 @@ USE: unparser USE: vectors USE: words +! peephole? +! "whose peephole are we optimizing" "your mom's" + +: begin-compiling ( word -- definition ) + cell compile-aligned dup save-xt word-parameter ; + : (compile) ( word -- ) #! Should be called inside the with-compiler scope. - dup save-xt word-parameter dataflow linearize generate ; + begin-compiling dataflow optimize linearize generate ; : compile-postponed ( -- ) compile-words get [ @@ -56,7 +62,7 @@ USE: words : compile ( word -- ) [ postpone-word compile-postponed ] with-compiler ; -: compiled +: compiled ( -- ) #! Compile the most recently defined word. word compile ; parsing diff --git a/library/compiler/generator-x86.factor b/library/compiler/generator-x86.factor index 86fbfd9eee..92d1504739 100644 --- a/library/compiler/generator-x86.factor +++ b/library/compiler/generator-x86.factor @@ -93,6 +93,43 @@ USE: words "arithmetic_type" SELF-CALL 8 ESP R+I ; -\ #push [ compile-literal ] "generator" set-word-property -\ #call [ CALL compiled-offset defer-xt ] "generator" set-word-property -\ #return [ drop RET ] "generator" set-word-property +#push [ compile-literal ] "generator" set-word-property + +#call [ + dup postpone-word + CALL compiled-offset defer-xt +] "generator" set-word-property + +#call-label [ + CALL compiled-offset defer-xt +] "generator" set-word-property + +#jump-label [ + JUMP compiled-offset defer-xt +] "generator" set-word-property + +#jump-label-t [ + POP-DS + ! condition is now in EAX + f address EAX CMP-I-R + ! jump w/ address added later + JNE compiled-offset defer-xt +] "generator" set-word-property + +#return [ drop RET ] "generator" set-word-property + +#drop [ drop 4 ESI R-I ] "generator" set-word-property +#dup [ + drop + ESI EAX [R]>R + 4 ESI R+I + EAX ESI R>[R] +] "generator" set-word-property + +#swap [ drop \ swap CALL compiled-offset defer-xt ] "generator" set-word-property +#over [ drop \ over CALL compiled-offset defer-xt ] "generator" set-word-property +#nip [ drop \ nip CALL compiled-offset defer-xt ] "generator" set-word-property +#tuck [ drop \ tuck CALL compiled-offset defer-xt ] "generator" set-word-property +#rot [ drop \ rot CALL compiled-offset defer-xt ] "generator" set-word-property +#>r [ drop \ >r CALL compiled-offset defer-xt ] "generator" set-word-property +#r> [ drop \ r> CALL compiled-offset defer-xt ] "generator" set-word-property diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index 030b5e5ef3..2ed5de3d8e 100644 --- a/library/compiler/generator.factor +++ b/library/compiler/generator.factor @@ -47,3 +47,6 @@ USE: words : generate ( linear -- ) #! Compile a word definition from linear IR. [ generate-node ] each ; + +#label [ save-xt ] "generator" set-word-property +#values [ nop ] "generator" set-word-property diff --git a/library/compiler/optimizer.factor b/library/compiler/optimizer.factor index 71a51d4acb..e1a4c42102 100644 --- a/library/compiler/optimizer.factor +++ b/library/compiler/optimizer.factor @@ -114,8 +114,10 @@ USE: logic #! is destructively modified. dup kill-set swap kill-nodes ; -: kill-branches ( literals branchlist -- branchlist ) - [ dupd kill-nodes ] map nip ; +: kill-branches ( literals node -- ) + [ + node-param [ [ dupd kill-nodes ] map nip ] change + ] extend , ; #push [ [ node-param get ] bind , @@ -135,24 +137,15 @@ USE: logic #ifte [ scan-branches ] "scan-literal" set-word-property #ifte [ can-kill-branches? ] "can-kill" set-word-property - -#ifte [ ( literals node -- ) - [ node-param [ kill-branches ] change ] extend , -] "kill-node" set-word-property +#ifte [ kill-branches ] "kill-node" set-word-property #generic [ scan-branches ] "scan-literal" set-word-property #generic [ can-kill-branches? ] "can-kill" set-word-property - -#generic [ ( literals node -- ) - [ node-param [ kill-branches ] change ] extend , -] "kill-node" set-word-property +#generic [ kill-branches ] "kill-node" set-word-property #2generic [ scan-branches ] "scan-literal" set-word-property #2generic [ can-kill-branches? ] "can-kill" set-word-property - -#2generic [ ( literals node -- ) - [ node-param [ kill-branches ] change ] extend , -] "kill-node" set-word-property +#2generic [ kill-branches ] "kill-node" set-word-property ! Don't care about inputs to recursive combinator calls #call-label [ 2drop t ] "can-kill" set-word-property diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor index 63d9f0e1ed..492cacf06c 100644 --- a/library/compiler/xt.factor +++ b/library/compiler/xt.factor @@ -56,7 +56,6 @@ USE: words SYMBOL: compiled-xts : save-xt ( word -- ) - cell compile-aligned compiled-offset swap compiled-xts acons@ ; : commit-xt ( xt word -- ) diff --git a/library/inference/branches.factor b/library/inference/branches.factor index d2c2dfcf50..05b01673b4 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -50,6 +50,7 @@ USE: hashtables copy-interpreter dataflow-graph off infer-quot + ( #values values-node ) branch-effect ] with-scope ; @@ -131,7 +132,7 @@ USE: hashtables #! Infer effects for both branches, unify. 3 ensure-d dataflow-drop, pop-d - dataflow-drop, pop-d 2list + dataflow-drop, pop-d swap 2list >r 1 meta-d get vector-tail* #ifte r> pop-d drop ( condition ) infer-branches ; diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 5a1720790c..286303519a 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -48,6 +48,11 @@ SYMBOL: #ifte SYMBOL: #generic SYMBOL: #2generic +! This is purely a marker for values we retain after a +! conditional. It does not generate code, but merely alerts the +! dataflow optimizer to the fact these values must be retained. +SYMBOL: #values + SYMBOL: #return SYMBOL: #drop diff --git a/library/inference/inference.factor b/library/inference/inference.factor index bef8211519..8a109c81c0 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -143,17 +143,22 @@ DEFER: apply-word 2drop ] ifte ; -: return-node ( -- ) - #! Add a #return node to the dataflow graph. - f #return dataflow, [ +: check-return ( -- ) + #! Raise an error if word leaves values on return stack. + meta-r get vector-length 0 = [ + "Word leaves elements on return stack" throw + ] unless ; + +: values-node ( op -- ) + #! Add a #values or #return node to the graph. + f swap dataflow, [ meta-d get vector>list node-consume-d set - meta-r get vector-length 0 = [ - "Word leaves elements on return stack" throw - ] unless ] bind ; : (infer) ( quot -- ) - f init-inference infer-quot return-node ; + f init-inference + infer-quot + #return values-node check-return ; : infer ( quot -- [ in | out ] ) #! Stack effect of a quotation. diff --git a/library/test/dataflow.factor b/library/test/dataflow.factor index 65eba318be..994f4017db 100644 --- a/library/test/dataflow.factor +++ b/library/test/dataflow.factor @@ -19,7 +19,15 @@ USE: words : dataflow-contains-param? ( object list -- ? ) #! Check if some dataflow node contains a given operation. - [ dupd node-param swap hash = ] some? nip ; + [ + dupd [ + node-op get #label = [ + node-param get dataflow-contains-param? + ] [ + node-param get = + ] ifte + ] bind + ] some? nip ; [ t ] [ \ + [ 2 2 + ] dataflow dataflow-contains-param? >boolean @@ -82,3 +90,10 @@ SYMBOL: #test [ node-param | 5 ] }} "foobar" [ [ node-param get ] bind succ ] apply-dataflow ] unit-test + +! Somebody (cough) got the order of ifte nodes wrong. + +[ t ] [ + #ifte [ [ 1 ] [ 2 ] ifte ] dataflow dataflow-contains-op? car + [ node-param get ] bind car car [ node-param get ] bind 1 = +] unit-test diff --git a/library/test/optimizer.factor b/library/test/optimizer.factor index 2827a19f56..70674dc519 100644 --- a/library/test/optimizer.factor +++ b/library/test/optimizer.factor @@ -11,3 +11,5 @@ USE: combinators [ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test [ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] dataflow kill-set ] unit-test + +[ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test diff --git a/library/test/x86-compiler/ifte.factor b/library/test/x86-compiler/ifte.factor index cd128f6fde..9fe30f155e 100644 --- a/library/test/x86-compiler/ifte.factor +++ b/library/test/x86-compiler/ifte.factor @@ -29,7 +29,7 @@ USE: words [ 1 ] [ dummy-ifte-5 ] unit-test : dummy-ifte-6 - dup 1 <= [ + dup 1 fixnum<= [ drop 1 ] [ 1 fixnum- dup swap 1 fixnum- fixnum+