--- gforth/prims2x.fs 2003/11/03 20:13:35 1.147 +++ gforth/prims2x.fs 2005/01/22 22:16:59 1.153 @@ -1,6 +1,6 @@ \ 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. @@ -716,6 +716,9 @@ stack inst-stream IP Cell default-ss s state-sss i th ! loop ; +: .state ( state -- ) + 0 >body - >name .name ; + : set-ss ( ss stack state -- ) state-sss swap stack-number @ th ! ; @@ -910,7 +913,9 @@ variable tail-nextp2 \ xt to execute for : output-label2 ( -- ) ." 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 -- } \ the final part of the generated C code, with xt printing LABEL2 or not. @@ -961,7 +966,9 @@ variable tail-nextp2 \ xt to execute for ." LABEL(" prim prim-c-name 2@ type ." )" ; : output-c ( -- ) - print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr + print-entry ." /* " prim prim-name 2@ type + ." ( " prim prim-stack-string 2@ type ." ) " + state-in .state ." -- " state-out .state ." */" cr ." /* " prim prim-doc 2@ type ." */" cr ." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging ." {" cr @@ -1110,8 +1117,11 @@ variable tail-nextp2 \ xt to execute for : output-alias ( -- ) ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; -: output-c-prim-num ( -- ) +defer output-c-prim-num ( -- ) + +:noname ( -- ) ." N_" prim prim-c-name 2@ type ." ," cr ; +is output-c-prim-num : output-forth ( -- ) prim prim-forth-code @ 0= @@ -1559,7 +1569,9 @@ variable offset-super2 0 offset-super2 rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , " prim prim-branch? negate . ." ," 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-prefix @@ -1575,14 +1587,15 @@ variable offset-super2 0 offset-super2 output-name-comment cr ; -: output-costs ( -- ) - \ description of superinstructions and simple instructions - ." {" prim compute-costs - rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," - offset-super2 @ 5 .r ." ," - super2-length dup 2 .r ." }," offset-super2 +! - output-name-comment - cr ; +\ : output-costs ( -- ) +\ \ description of superinstructions and simple instructions +\ ." {" prim compute-costs +\ rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," +\ offset-super2 @ 5 .r ." ," +\ super2-length dup 2 .r ." ," offset-super2 +! +\ inst-stream stack-in @ 1 .r ." }," +\ output-name-comment +\ cr ; : output-super2-simple ( -- ) prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if