version 1.148, 2004/01/19 10:11:26
|
version 1.154, 2005/01/25 22:16:29
|
Line 1
|
Line 1
|
\ converts primitives to, e.g., C code |
\ converts primitives to, e.g., C code |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 716 stack inst-stream IP Cell
|
Line 716 stack inst-stream IP Cell
|
default-ss s state-sss i th ! |
default-ss s state-sss i th ! |
loop ; |
loop ; |
|
|
|
: .state ( state -- ) |
|
0 >body - >name .name ; |
|
|
: set-ss ( ss stack state -- ) |
: set-ss ( ss stack state -- ) |
state-sss swap stack-number @ th ! ; |
state-sss swap stack-number @ th ! ; |
|
|
Line 910 variable tail-nextp2 \ xt to execute for
|
Line 913 variable tail-nextp2 \ xt to execute for
|
|
|
: output-label2 ( -- ) |
: output-label2 ( -- ) |
." LABEL2(" prim prim-c-name 2@ type ." )" cr |
." LABEL2(" prim prim-c-name 2@ type ." )" cr |
." NEXT_P2;" cr ; |
." NEXT_P1_5;" cr |
|
." LABEL3(" prim prim-c-name 2@ type ." )" cr |
|
." DO_GOTO;" cr ; |
|
|
: output-c-tail1 { xt -- } |
: output-c-tail1 { xt -- } |
\ the final part of the generated C code, with xt printing LABEL2 or not. |
\ the final part of the generated C code, with xt printing LABEL2 or not. |
Line 959 variable tail-nextp2 \ xt to execute for
|
Line 964 variable tail-nextp2 \ xt to execute for
|
|
|
: print-entry ( -- ) |
: print-entry ( -- ) |
." LABEL(" prim prim-c-name 2@ type ." )" ; |
." LABEL(" prim prim-c-name 2@ type ." )" ; |
|
|
|
: prim-type ( addr u -- ) |
|
\ print out a primitive, but avoid "*/" |
|
2dup s" */" search nip nip IF |
|
bounds ?DO I c@ dup '* = IF drop 'x THEN emit LOOP |
|
ELSE type THEN ; |
|
|
: output-c ( -- ) |
: output-c ( -- ) |
print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
print-entry ." /* " prim prim-name 2@ prim-type |
|
." ( " prim prim-stack-string 2@ type ." ) " |
|
state-in .state ." -- " state-out .state ." */" cr |
." /* " prim prim-doc 2@ type ." */" cr |
." /* " prim prim-doc 2@ type ." */" cr |
." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging |
." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging |
." {" cr |
." {" cr |
Line 1039 variable tail-nextp2 \ xt to execute for
|
Line 1052 variable tail-nextp2 \ xt to execute for
|
prim prim-branch? |
prim prim-branch? |
prim prim-c-code 2@ s" SUPER_END" search nip nip 0<> or |
prim prim-c-code 2@ s" SUPER_END" search nip nip 0<> or |
prim prim-c-code 2@ s" SUPER_CONTINUE" search nip nip 0= and |
prim prim-c-code 2@ s" SUPER_CONTINUE" search nip nip 0= and |
negate 0 .r ." , /* " prim prim-name 2@ type ." */" cr ; |
negate 0 .r ." , /* " prim prim-name 2@ prim-type ." */" cr ; |
|
|
: gen-arg-parm { item -- } |
: gen-arg-parm { item -- } |
item item-stack @ inst-stream = if |
item item-stack @ inst-stream = if |
Line 1445 variable reprocessed-num 0 reprocessed-n
|
Line 1458 variable reprocessed-num 0 reprocessed-n
|
|
|
: output-part ( p -- ) |
: output-part ( p -- ) |
to prim |
to prim |
." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
." /* " prim prim-name 2@ prim-type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging |
." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging |
." {" cr |
." {" cr |
print-declarations |
print-declarations |
Line 1553 variable reprocessed-num 0 reprocessed-n
|
Line 1566 variable reprocessed-num 0 reprocessed-n
|
\ prim-num @ 4 .r ." ," ; |
\ prim-num @ 4 .r ." ," ; |
|
|
: output-name-comment ( -- ) |
: output-name-comment ( -- ) |
." /* " prim prim-name 2@ type ." */" ; |
." /* " prim prim-name 2@ prim-type ." */" ; |
|
|
variable offset-super2 0 offset-super2 ! \ offset into the super2 table |
variable offset-super2 0 offset-super2 ! \ offset into the super2 table |
|
|
Line 1562 variable offset-super2 0 offset-super2
|
Line 1575 variable offset-super2 0 offset-super2
|
rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , " |
rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , " |
prim prim-branch? negate . ." ," |
prim prim-branch? negate . ." ," |
state-in state-number @ 2 .r ." ," |
state-in state-number @ 2 .r ." ," |
state-out state-number @ 2 .r ." ," ; |
state-out state-number @ 2 .r ." ," |
|
inst-stream stack-in @ 1 .r ." ," |
|
; |
|
|
: output-costs-gforth-simple ( -- ) |
: output-costs-gforth-simple ( -- ) |
output-costs-prefix |
output-costs-prefix |
Line 1578 variable offset-super2 0 offset-super2
|
Line 1593 variable offset-super2 0 offset-super2
|
output-name-comment |
output-name-comment |
cr ; |
cr ; |
|
|
: output-costs ( -- ) |
\ : output-costs ( -- ) |
\ description of superinstructions and simple instructions |
\ \ description of superinstructions and simple instructions |
." {" prim compute-costs |
\ ." {" prim compute-costs |
rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," |
\ rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," |
offset-super2 @ 5 .r ." ," |
\ offset-super2 @ 5 .r ." ," |
super2-length dup 2 .r ." }," offset-super2 +! |
\ super2-length dup 2 .r ." ," offset-super2 +! |
output-name-comment |
\ inst-stream stack-in @ 1 .r ." }," |
cr ; |
\ output-name-comment |
|
\ cr ; |
|
|
: output-super2-simple ( -- ) |
: output-super2-simple ( -- ) |
prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if |
prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if |