version 1.24, 1996/08/21 14:58:43
|
version 1.28, 1997/09/13 12:04:59
|
Line 42
|
Line 42
|
|
|
warnings off |
warnings off |
|
|
|
include extend.fs |
|
|
\ require interpretation.fs |
\ require interpretation.fs |
require debugging.fs |
\ require debugs.fs |
[IFUNDEF] vocabulary include search-order.fs [THEN] |
[IFUNDEF] vocabulary include search.fs [THEN] |
[IFUNDEF] environment? include environ.fs [THEN] |
[IFUNDEF] environment? include environ.fs [THEN] |
include gray.fs |
include gray.fs |
|
|
Line 66 variable line \ line number of char poin
|
Line 68 variable line \ line number of char poin
|
1 line ! |
1 line ! |
2variable filename \ filename of original input file |
2variable filename \ filename of original input file |
0 0 filename 2! |
0 0 filename 2! |
|
2variable f-comment |
|
0 0 f-comment 2! |
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 type 0 0 f-comment 2! THEN ; |
|
|
: start ( -- addr ) |
: start ( -- addr ) |
cookedinput @ ; |
cookedinput @ ; |
|
|
Line 224 eof-char singleton charclass eof
|
Line 235 eof-char singleton charclass eof
|
nowhite ++ |
nowhite ++ |
<- name ( -- ) |
<- name ( -- ) |
|
|
(( ` \ nonl ** nl |
(( {{ ?flush-comment start }} ` \ nonl ** nl {{ end |
|
2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} |
)) <- comment ( -- ) |
)) <- 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 ! }} |
Line 595 set-current
|
Line 607 set-current
|
: output-label ( -- ) |
: output-label ( -- ) |
." &&I_" c-name 2@ type ." ," cr ; |
." &&I_" c-name 2@ type ." ," cr ; |
|
|
: output-alias ( -- ) |
: output-alias ( -- ) flush-comment on |
|
?flush-comment |
primitive-number @ . ." alias " forth-name 2@ type cr |
primitive-number @ . ." alias " forth-name 2@ type cr |
-1 primitive-number +! ; |
-1 primitive-number +! ; |
|
|
: output-forth ( -- ) |
: output-forth ( -- ) flush-comment on |
|
?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! |
|
\ JAW |
ELSE ." : " forth-name 2@ type ." ( " |
ELSE ." : " forth-name 2@ type ." ( " |
effect-in effect-in-end @ .stack-list ." -- " |
effect-in effect-in-end @ .stack-list ." -- " |
effect-out effect-out-end @ .stack-list ." )" cr |
effect-out effect-out-end @ .stack-list ." )" cr |