--- gforth/prims2x.fs 2004/12/31 13:23:58 1.152 +++ gforth/prims2x.fs 2005/01/26 21:24:15 1.155 @@ -913,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. @@ -924,6 +926,16 @@ variable tail-nextp2 \ xt to execute for fill-state xt execute ; +: output-c-vm-jump-tail ( -- ) + \ !! this functionality not yet implemented for superinstructions + output-super-end + print-debug-results + stores + fill-state + ." LABEL2(" prim prim-c-name 2@ type ." )" cr + ." LABEL3(" prim prim-c-name 2@ type ." )" cr + ." DO_GOTO;" cr ; + : output-c-tail1-no-stores { xt -- } \ the final part of the generated C code for combinations output-super-end @@ -935,7 +947,11 @@ variable tail-nextp2 \ xt to execute for tail-nextp2 @ output-c-tail1 ; : output-c-tail2 ( -- ) - ['] output-label2 output-c-tail1 ; + prim prim-c-code 2@ s" VM_JUMP(" search nip nip if + output-c-vm-jump-tail + else + ['] output-label2 output-c-tail1 + endif ; : output-c-tail-no-stores ( -- ) tail-nextp2 @ output-c-tail1-no-stores ; @@ -962,9 +978,15 @@ variable tail-nextp2 \ xt to execute for : print-entry ( -- ) ." 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 ( -- ) - print-entry ." /* " prim prim-name 2@ type + 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 @@ -1044,7 +1066,7 @@ variable tail-nextp2 \ xt to execute for prim prim-branch? 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 - negate 0 .r ." , /* " prim prim-name 2@ type ." */" cr ; + negate 0 .r ." , /* " prim prim-name 2@ prim-type ." */" cr ; : gen-arg-parm { item -- } item item-stack @ inst-stream = if @@ -1450,7 +1472,7 @@ variable reprocessed-num 0 reprocessed-n : output-part ( p -- ) 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 ." {" cr print-declarations @@ -1558,7 +1580,7 @@ variable reprocessed-num 0 reprocessed-n \ prim-num @ 4 .r ." ," ; : 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