version 1.41, 1999/04/25 21:06:52
|
version 1.43, 1999/05/10 12:54:48
|
Line 74 variable line \ line number of char poin
|
Line 74 variable line \ line number of char poin
|
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 @ ; |
|
|
Line 251 eof-char singleton charclass eof
|
Line 230 eof-char singleton charclass eof
|
nowhite ++ |
nowhite ++ |
<- name ( -- ) |
<- name ( -- ) |
|
|
(( {{ ?flush-comment start }} ` \ nonl ** nl {{ end |
Variable forth-flag |
2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} |
Variable c-flag |
)) <- comment ( -- ) |
|
|
(( (( ` f || ` F )) {{ start }} nonl ** |
|
{{ end forth-flag @ IF type cr ELSE 2drop THEN }} |
|
)) <- forth-comment ( -- ) |
|
|
|
(( (( ` c || ` C )) {{ start }} nonl ** |
|
{{ end c-flag @ IF type cr ELSE 2drop THEN }} |
|
)) <- c-comment ( -- ) |
|
|
|
(( ` - 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 |
|
|
|
(( ` \ comment-body nl )) <- 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 ** |
Line 600 set-current
|
Line 610 set-current
|
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 |
Line 659 set-current
|
Line 668 set-current
|
." }" 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! |