| variable skipsynclines \ are sync lines ("#line ...") invisible to the parser? |
variable skipsynclines \ are sync lines ("#line ...") invisible to the parser? |
| skipsynclines on |
skipsynclines on |
| |
|
| Variable flush-comment flush-comment off |
|
| |
|
| : ?flush-comment |
|
| flush-comment @ 0= ?EXIT |
|
| f-comment 2@ nip |
|
| IF cr f-comment 2@ 2 /string 1- |
|
| dup IF |
|
| 2dup s" -" compare 0= |
|
| IF |
|
| flush-comment @ 1 = |
|
| IF ." #else" |
|
| ELSE ." [ELSE]" THEN |
|
| ELSE |
|
| flush-comment @ 1 = |
|
| IF ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP |
|
| ELSE ." has? " type ." [IF]" THEN |
|
| THEN cr |
|
| ELSE flush-comment @ 1 = IF ." #endif" ELSE ." [THEN]" THEN |
|
| cr THEN |
|
| 0 0 f-comment 2! THEN ; |
|
| |
|
| : start ( -- addr ) |
: start ( -- addr ) |
| cookedinput @ ; |
cookedinput @ ; |
| |
|
| {{ end c-flag @ IF type cr ELSE 2drop THEN }} |
{{ end c-flag @ IF type cr ELSE 2drop THEN }} |
| )) <- c-comment ( -- ) |
)) <- c-comment ( -- ) |
| |
|
| (( (( forth-comment || c-comment )) ?? nonl ** )) <- comment-body |
(( ` - nonl ** {{ |
| |
forth-flag @ IF ." [ELSE]" cr THEN |
| |
c-flag @ IF ." #else" cr THEN }} |
| |
)) <- else-comment |
| |
|
| |
(( ` + {{ start }} nonl ** {{ end |
| |
dup |
| |
IF c-flag @ |
| |
IF ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP cr |
| |
THEN |
| |
forth-flag @ |
| |
IF ." has? " type ." [IF]" cr THEN |
| |
ELSE 2drop |
| |
c-flag @ |
| |
IF ." #endif" cr THEN |
| |
forth-flag @ |
| |
IF ." [THEN]" cr THEN |
| |
THEN }} |
| |
)) <- if-comment |
| |
|
| |
(( (( forth-comment || c-comment || else-comment || if-comment )) ?? nonl ** )) <- comment-body |
| |
|
| (( {{ ?flush-comment start }} ` \ comment-body nl {{ end |
(( ` \ comment-body nl )) <- comment ( -- ) |
| 2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} |
|
| )) <- comment ( -- ) |
|
| |
|
| (( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} blank ** )) ** {{ effect-in-end ! }} |
(( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} blank ** )) ** {{ effect-in-end ! }} |
| ` - ` - blank ** |
` - ` - blank ** |
| i item-name 2@ type space |
i item-name 2@ type space |
| item-descr +loop ; |
item-descr +loop ; |
| |
|
| : output-c ( -- ) 1 flush-comment ! |
: output-c ( -- ) |
| ?flush-comment |
|
| ." I_" c-name 2@ type ." : /* " forth-name 2@ type ." ( " stack-string 2@ type ." ) */" cr |
." I_" c-name 2@ type ." : /* " forth-name 2@ type ." ( " stack-string 2@ type ." ) */" cr |
| ." /* " doc 2@ type ." */" cr |
." /* " doc 2@ type ." */" cr |
| ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
| ." }" cr |
." }" cr |
| cr ; |
cr ; |
| |
|
| : output-label ( -- ) 1 flush-comment ! |
: output-label ( -- ) |
| ?flush-comment |
|
| ." (Label)&&I_" c-name 2@ type ." ," cr |
." (Label)&&I_" c-name 2@ type ." ," cr |
| -1 primitive-number +! ; |
-1 primitive-number +! ; |
| |
|
| : output-alias ( -- ) flush-comment on |
: output-alias ( -- ) |
| ?flush-comment |
|
| ( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr |
( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr |
| -1 primitive-number +! ; |
-1 primitive-number +! ; |
| |
|
| : output-forth ( -- ) flush-comment on |
: output-forth ( -- ) |
| ?flush-comment |
|
| forth-code @ 0= |
forth-code @ 0= |
| IF \ output-alias |
IF \ output-alias |
| \ this is bad for ec: an alias is compiled if tho word does not exist! |
\ this is bad for ec: an alias is compiled if tho word does not exist! |
