version 1.31, 1998/05/31 19:29:23
|
version 1.35, 1998/12/08 22:02:50
|
Line 1
|
Line 1
|
\ converts primitives to, e.g., C code |
\ converts primitives to, e.g., C code |
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 42
|
Line 42
|
|
|
warnings off |
warnings off |
|
|
include search.fs |
require search.fs |
include extend.fs |
require extend.fs |
|
|
\ require interpretation.fs |
\ require interpretation.fs |
\ require debugs.fs |
\ require debugs.fs |
Line 77 skipsynclines on
|
Line 77 skipsynclines on
|
Variable flush-comment flush-comment off |
Variable flush-comment flush-comment off |
|
|
: ?flush-comment |
: ?flush-comment |
flush-comment @ 0= ?EXIT |
flush-comment @ 0= ?EXIT |
f-comment 2@ nip |
f-comment 2@ nip |
IF cr f-comment 2@ 2 /string type 0 0 f-comment 2! THEN ; |
IF cr f-comment 2@ 2 /string 1- |
|
dup IF |
|
flush-comment @ 1 = |
|
IF ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP |
|
ELSE ." has? " type ." [IF]" 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 466 s" DFloat *" single-type starts-with df_
|
Line 473 s" DFloat *" single-type starts-with df_
|
s" SFloat *" single-type starts-with sf_ |
s" SFloat *" single-type starts-with sf_ |
s" Xt" single-type starts-with xt |
s" Xt" single-type starts-with xt |
s" WID" single-type starts-with wid |
s" WID" single-type starts-with wid |
s" F83Name *" single-type starts-with f83name |
s" struct F83Name *" single-type starts-with f83name |
|
|
set-current |
set-current |
|
|
Line 586 set-current
|
Line 593 set-current
|
i item-name 2@ type space |
i item-name 2@ type space |
item-descr +loop ; |
item-descr +loop ; |
|
|
: output-c ( -- ) |
: output-c ( -- ) 1 flush-comment ! |
|
?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 644 set-current
|
Line 652 set-current
|
." }" cr |
." }" cr |
cr ; |
cr ; |
|
|
: output-label ( -- ) |
: output-label ( -- ) 1 flush-comment ! |
." &&I_" c-name 2@ type ." ," cr ; |
?flush-comment |
|
." [" -2 primitive-number @ - 0 .r ." ] " |
|
." (Label)&&I_" c-name 2@ type ." ," cr |
|
-1 primitive-number +! ; |
|
|
: output-alias ( -- ) flush-comment on |
: output-alias ( -- ) flush-comment on |
?flush-comment |
?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 ( -- ) flush-comment on |
: output-forth ( -- ) flush-comment on |
?flush-comment |
?flush-comment |