version 1.111, 2002/08/20 16:59:01
|
version 1.115, 2002/09/22 09:54:19
|
Line 86 variable skipsynclines \ are sync lines
|
Line 86 variable skipsynclines \ are sync lines
|
skipsynclines on |
skipsynclines on |
variable out-nls \ newlines in output (for output sync lines) |
variable out-nls \ newlines in output (for output sync lines) |
0 out-nls ! |
0 out-nls ! |
|
variable store-optimization \ use store optimization? |
|
store-optimization off |
|
|
|
|
: th ( addr1 n -- addr2 ) |
: th ( addr1 n -- addr2 ) |
cells + ; |
cells + ; |
Line 247 variable in-part \ true if processing a
|
Line 250 variable in-part \ true if processing a
|
create combined-prims max-combined cells allot |
create combined-prims max-combined cells allot |
variable num-combined |
variable num-combined |
|
|
|
: map-combined { xt -- } |
|
\ perform xt for all components of the current combined instruction |
|
num-combined @ 0 +do |
|
combined-prims i th @ xt execute |
|
loop ; |
|
|
table constant combinations |
table constant combinations |
\ the keys are the sequences of pointers to primitives |
\ the keys are the sequences of pointers to primitives |
|
|
Line 380 defer inst-stream-f ( -- stack )
|
Line 389 defer inst-stream-f ( -- stack )
|
rdrop ; |
rdrop ; |
|
|
: store-single ( item -- ) |
: store-single ( item -- ) |
>r |
>r |
r@ same-as-in? |
store-optimization @ r@ same-as-in? and if |
if |
r@ item-in-index 0= r@ item-out-index 0= xor if |
r@ item-in-index 0= r@ item-out-index 0= xor |
." IF_" r@ item-stack @ stack-pointer 2@ type |
if |
." TOS(" r@ really-store-single ." );" cr |
." IF_" r@ item-stack @ stack-pointer 2@ type |
endif |
." TOS(" r@ really-store-single ." );" cr |
else |
endif |
r@ really-store-single cr |
else |
endif |
r@ really-store-single cr |
rdrop ; |
endif |
|
rdrop ; |
|
|
|
: store-double ( item -- ) |
: store-double ( item -- ) |
\ !! store optimization is not performed, because it is not yet needed |
\ !! store optimization is not performed, because it is not yet needed |
Line 732 stack inst-stream IP Cell
|
Line 739 stack inst-stream IP Cell
|
endif |
endif |
." }" cr ; |
." }" cr ; |
|
|
|
: output-profile-part ( p ) |
|
." add_inst(b, " quote |
|
prim-name 2@ type |
|
quote ." );" cr ; |
|
|
: output-profile-combined ( -- ) |
: output-profile-combined ( -- ) |
\ generate code for postprocessing the VM block profile stuff |
\ generate code for postprocessing the VM block profile stuff |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
num-combined @ 0 +do |
['] output-profile-part map-combined |
." add_inst(b, " quote |
|
combined-prims i th @ prim-name 2@ type |
|
quote ." );" cr |
|
loop |
|
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SET_IP" search nip nip |
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SET_IP" search nip nip |
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SUPER_END" search nip nip or if |
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SUPER_END" search nip nip or if |
Line 825 stack inst-stream IP Cell
|
Line 833 stack inst-stream IP Cell
|
: output-alias ( -- ) |
: output-alias ( -- ) |
( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; |
( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; |
|
|
|
: output-prim-num ( -- ) |
|
prim prim-num @ 8 + 4 .r space prim prim-name 2@ type cr ; |
|
|
: output-forth ( -- ) |
: output-forth ( -- ) |
prim prim-forth-code @ 0= |
prim prim-forth-code @ 0= |
IF \ output-alias |
IF \ output-alias |
Line 836 stack inst-stream IP Cell
|
Line 847 stack inst-stream IP Cell
|
THEN ; |
THEN ; |
|
|
: output-tag-file ( -- ) |
: output-tag-file ( -- ) |
name-filename 2@ last-name-filename 2@ compare if |
name-filename 2@ last-name-filename 2@ str= 0= if |
name-filename 2@ last-name-filename 2! |
name-filename 2@ last-name-filename 2! |
#ff emit cr |
#ff emit cr |
name-filename 2@ type |
name-filename 2@ type |
Line 1050 stack inst-stream IP Cell
|
Line 1061 stack inst-stream IP Cell
|
: output-parts ( -- ) |
: output-parts ( -- ) |
prim >r in-part on |
prim >r in-part on |
current-depth max-stacks cells erase |
current-depth max-stacks cells erase |
num-combined @ 0 +do |
['] output-part map-combined |
combined-prims i th @ output-part |
|
loop |
|
in-part off |
in-part off |
r> to prim ; |
r> to prim ; |
|
|
Line 1078 stack inst-stream IP Cell
|
Line 1087 stack inst-stream IP Cell
|
|
|
\ peephole optimization rules |
\ peephole optimization rules |
|
|
|
\ data for a simple peephole optimizer that always tries to combine |
|
\ the currently compiled instruction with the last one. |
|
|
\ in order for this to work as intended, shorter combinations for each |
\ in order for this to work as intended, shorter combinations for each |
\ length must be present, and the longer combinations must follow |
\ length must be present, and the longer combinations must follow |
\ shorter ones (this restriction may go away in the future). |
\ shorter ones (this restriction may go away in the future). |
|
|
: output-peephole ( -- ) |
: output-peephole ( -- ) |
combined-prims num-combined @ 1- cells combinations search-wordlist |
combined-prims num-combined @ 1- cells combinations search-wordlist |
s" the prefix for this combination must be defined earlier" ?print-error |
s" the prefix for this superinstruction must be defined earlier" ?print-error |
." {" |
." {" |
execute prim-num @ 5 .r ." ," |
execute prim-num @ 5 .r ." ," |
combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ," |
combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ," |
Line 1092 stack inst-stream IP Cell
|
Line 1104 stack inst-stream IP Cell
|
combined prim-c-name 2@ type ." */" |
combined prim-c-name 2@ type ." */" |
cr ; |
cr ; |
|
|
: output-forth-peephole ( -- ) |
|
combined-prims num-combined @ 1- cells combinations search-wordlist |
|
s" the prefix for this combination must be defined earlier" ?print-error |
|
execute prim-num @ 5 .r |
|
combined-prims num-combined @ 1- th @ prim-num @ 5 .r |
|
combined prim-num @ 5 .r ." prim, \ " |
|
combined prim-c-name 2@ type |
|
cr ; |
|
|
|
|
\ cost and superinstruction data for a sophisticated combiner (e.g., |
|
\ shortest path) |
|
|
|
\ This is intended as initializer for a structure like this |
|
|
|
\ struct super { |
|
\ int loads; /* number of stack loads */ |
|
\ int stores; /* number of stack stores */ |
|
\ int updates; /* number of stack pointer updates */ |
|
\ int length; /* number of components */ |
|
\ int *components; /* array of vm_prim indexes of components */ |
|
\ }; |
|
|
|
\ How do you know which primitive or combined instruction this |
|
\ structure refers to? By the order of cost structures, as in most |
|
\ other cases. |
|
|
|
: compute-costs { p -- nloads nstores nupdates } |
|
\ compute the number of loads, stores, and stack pointer updates |
|
\ of a primitive or combined instruction; does not take TOS |
|
\ caching into account, nor that IP updates are combined with |
|
\ other stuff |
|
0 max-stacks 0 +do |
|
p prim-stacks-in i th @ + |
|
loop |
|
0 max-stacks 0 +do |
|
p prim-stacks-out i th @ + |
|
loop |
|
0 max-stacks 0 +do |
|
p prim-stacks-in i th @ p prim-stacks-out i th @ <> - |
|
loop ; |
|
|
|
: output-num-part ( p -- ) |
|
prim-num @ 4 .r ." ," ; |
|
|
|
: output-costs ( -- ) |
|
." {" prim compute-costs |
|
rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," |
|
combined if |
|
num-combined @ 2 .r |
|
." , ((int []){" ['] output-num-part map-combined ." })}, /* " |
|
else |
|
." 1, ((int []){" prim prim-num @ 4 .r ." })}, /* " |
|
endif |
|
prim prim-name 2@ type ." */" |
|
cr ; |
|
|
\ the parser |
\ the parser |
|
|
Line 1130 print-token !
|
Line 1180 print-token !
|
\ when input points to a newline, check if the next line is a |
\ when input points to a newline, check if the next line is a |
\ sync line. If it is, perform the appropriate actions. |
\ sync line. If it is, perform the appropriate actions. |
rawinput @ >r |
rawinput @ >r |
s" #line " r@ over compare 0<> if |
s" #line " r@ over str= 0= if |
rdrop 1 line +! EXIT |
rdrop 1 line +! EXIT |
endif |
endif |
0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr ) |
0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr ) |