| \ different directory with the wordlibraries) |
\ different directory with the wordlibraries) |
| include ./search.fs |
include ./search.fs |
| include ./extend.fs |
include ./extend.fs |
| [THEN] |
|
| include ./stuff.fs |
include ./stuff.fs |
| |
[THEN] |
| |
|
| [IFUNDEF] environment? |
[IFUNDEF] environment? |
| include ./environ.fs |
include ./environ.fs |
| : stores ( -- ) |
: stores ( -- ) |
| prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ; |
prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ; |
| |
|
| |
: output-super-end ( -- ) |
| |
prim prim-c-code 2@ s" SET_IP" search if |
| |
." SUPER_END;" cr |
| |
endif |
| |
2drop ; |
| |
|
| : output-c-tail ( -- ) |
: output-c-tail ( -- ) |
| \ the final part of the generated C code |
\ the final part of the generated C code |
| |
output-super-end |
| ." NEXT_P1;" cr |
." NEXT_P1;" cr |
| stores |
stores |
| fill-tos |
fill-tos |
| ." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
| ." } else " ; |
." } else " ; |
| |
|
| |
: output-profile ( -- ) |
| |
\ generate code for postprocessing the VM block profile stuff |
| |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
| |
." add_inst(b, " quote prim prim-name 2@ type quote ." );" cr |
| |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
| |
prim prim-c-code 2@ s" SET_IP" search nip nip |
| |
prim prim-c-code 2@ s" SUPER_END" search nip nip or if |
| |
." return;" cr |
| |
endif |
| |
." } else " cr ; |
| |
|
| : gen-arg-parm { item -- } |
: gen-arg-parm { item -- } |
| item item-stack @ inst-stream = if |
item item-stack @ inst-stream = if |
| ." , " item item-type @ type-c-name 2@ type space |
." , " item item-type @ type-c-name 2@ type space |
| : process-combined ( -- ) |
: process-combined ( -- ) |
| combined combined-prims num-combined @ cells |
combined combined-prims num-combined @ cells |
| combinations ['] constant insert-wordlist |
combinations ['] constant insert-wordlist |
| |
combined-prims num-combined @ 1- th ( last-part ) |
| |
@ prim-c-code 2@ prim prim-c-code 2! \ used by output-super-end |
| prim compute-effects |
prim compute-effects |
| prim init-effects |
prim init-effects |
| output-combined perform ; |
output-combined perform ; |
| 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 ; |
| |
|
| |
|
| \ the parser |
\ the parser |
| |
|
| )) <- simple-primitive ( -- ) |
)) <- simple-primitive ( -- ) |
| |
|
| (( {{ init-combined }} |
(( {{ init-combined }} |
| ` = (( white ++ {{ start }} forth-ident {{ end add-prim }} )) ++ |
` = white ** (( {{ start }} forth-ident {{ end add-prim }} white ** )) ++ |
| nleof {{ process-combined }} |
nleof {{ process-combined }} |
| )) <- combined-primitive |
)) <- combined-primitive |
| |
|