version 1.67, 2001/01/18 16:57:41
|
version 1.68, 2001/01/18 19:43:02
|
Line 167 variable name-line
|
Line 167 variable name-line
|
2variable name-filename |
2variable name-filename |
2variable last-name-filename |
2variable last-name-filename |
|
|
variable primitive-number -10 primitive-number ! |
|
Variable function-number 0 function-number ! |
Variable function-number 0 function-number ! |
|
|
\ for several reasons stack items of a word are stored in a wordlist |
\ for several reasons stack items of a word are stored in a wordlist |
Line 486 does> ( item -- )
|
Line 485 does> ( item -- )
|
." NAME(" quote forth-name 2@ type quote ." )" cr \ debugging |
." NAME(" quote forth-name 2@ type quote ." )" cr \ debugging |
." {" cr |
." {" cr |
." DEF_CA" cr |
." DEF_CA" cr |
declarations |
|
compute-offsets \ for everything else |
|
print-declarations |
print-declarations |
." NEXT_P0;" cr |
." NEXT_P0;" cr |
flush-tos |
flush-tos |
Line 518 does> ( item -- )
|
Line 515 does> ( item -- )
|
\ generate code for disassembling VM instructions |
\ generate code for disassembling VM instructions |
." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr |
." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr |
." fputs(" quote forth-name 2@ type quote ." , vm_out);" cr |
." fputs(" quote forth-name 2@ type quote ." , vm_out);" cr |
." /* " declarations ." */" cr |
|
compute-offsets |
|
disasm-args |
disasm-args |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." } else " |
." } else " ; |
1 function-number +! ; |
|
|
|
: gen-arg-parm { item -- } |
: gen-arg-parm { item -- } |
item item-stack @ inst-stream = if |
item item-stack @ inst-stream = if |
Line 545 does> ( item -- )
|
Line 539 does> ( item -- )
|
|
|
: output-gen ( -- ) |
: output-gen ( -- ) |
\ generate C code for generating VM instructions |
\ generate C code for generating VM instructions |
." /* " declarations ." */" cr |
|
compute-offsets |
|
." void gen_" c-name 2@ type ." (Inst **ctp" gen-args-parm ." )" cr |
." void gen_" c-name 2@ type ." (Inst **ctp" gen-args-parm ." )" cr |
." {" cr |
." {" cr |
." gen_inst(ctp, vm_prim[" function-number @ 0 .r ." ]);" cr |
." gen_inst(ctp, vm_prim[" function-number @ 0 .r ." ]);" cr |
gen-args-gen |
gen-args-gen |
." }" cr |
." }" cr ; |
1 function-number +! ; |
|
|
|
: stack-used? { stack -- f } |
: stack-used? { stack -- f } |
stack stack-in @ stack stack-out @ or 0<> ; |
stack stack-in @ stack stack-out @ or 0<> ; |
|
|
: output-funclabel ( -- ) |
: output-funclabel ( -- ) |
1 function-number +! |
|
." &I_" c-name 2@ type ." ," cr ; |
." &I_" c-name 2@ type ." ," cr ; |
|
|
: output-forthname ( -- ) |
: output-forthname ( -- ) |
1 function-number +! |
|
'" emit forth-name 2@ type '" emit ." ," cr ; |
'" emit forth-name 2@ type '" emit ." ," cr ; |
|
|
: output-c-func ( -- ) |
: output-c-func ( -- ) |
\ used for word libraries |
\ used for word libraries |
1 function-number +! |
|
." Cell * I_" c-name 2@ type ." (Cell *SP, Cell **FP) /* " forth-name 2@ type |
." Cell * I_" c-name 2@ type ." (Cell *SP, Cell **FP) /* " forth-name 2@ type |
." ( " stack-string 2@ type ." ) */" cr |
." ( " stack-string 2@ type ." ) */" cr |
." /* " doc 2@ type ." */" cr |
." /* " doc 2@ type ." */" cr |
." NAME(" quote forth-name 2@ type quote ." )" cr |
." NAME(" quote forth-name 2@ type quote ." )" cr |
\ debugging |
\ debugging |
." {" cr |
." {" cr |
declarations |
|
compute-offsets \ for everything else |
|
print-declarations |
print-declarations |
inst-stream stack-used? IF ." Cell *ip=IP;" cr THEN |
inst-stream stack-used? IF ." Cell *ip=IP;" cr THEN |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
Line 596 does> ( item -- )
|
Line 582 does> ( item -- )
|
cr ; |
cr ; |
|
|
: output-label ( -- ) |
: output-label ( -- ) |
." (Label)&&I_" c-name 2@ type ." ," cr |
." (Label)&&I_" c-name 2@ type ." ," cr ; |
-1 primitive-number +! ; |
|
|
|
: output-alias ( -- ) |
: output-alias ( -- ) |
( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr |
( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr ; |
-1 primitive-number +! ; |
|
|
|
: output-forth ( -- ) |
: output-forth ( -- ) |
forth-code @ 0= |
forth-code @ 0= |
Line 611 does> ( item -- )
|
Line 595 does> ( item -- )
|
ELSE ." : " forth-name 2@ type ." ( " |
ELSE ." : " forth-name 2@ type ." ( " |
stack-string 2@ type ." )" cr |
stack-string 2@ type ." )" cr |
forth-code 2@ type cr |
forth-code 2@ type cr |
-1 primitive-number +! |
|
THEN ; |
THEN ; |
|
|
: output-tag-file ( -- ) |
: output-tag-file ( -- ) |
Line 811 Variable c-flag
|
Line 794 Variable c-flag
|
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl ** nl white ** )) ** {{ end c-code 2! skipsynclines on }} |
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl ** nl white ** )) ** {{ end c-code 2! skipsynclines on }} |
(( ` : white ** nl |
(( ` : white ** nl |
{{ start }} (( nonl ++ nl white ** )) ++ {{ end forth-code 2! }} |
{{ start }} (( nonl ++ nl white ** )) ++ {{ end forth-code 2! }} |
)) ?? {{ printprim }} |
)) ?? {{ declarations compute-offsets printprim 1 function-number +! }} |
(( nl || eof )) |
(( nl || eof )) |
)) <- primitive ( -- ) |
)) <- primitive ( -- ) |
|
|