--- gforth/prims2x.fs	2002/09/22 09:00:04	1.114
+++ gforth/prims2x.fs	2002/09/22 14:21:30	1.116
@@ -89,6 +89,11 @@ variable out-nls \ newlines in output (f
 variable store-optimization \ use store optimization?
 store-optimization off
 
+variable include-skipped-insts
+\ does the threaded code for a combined instruction include the cells
+\ for the component instructions (true) or only the cells for the
+\ inline arguments (false)
+include-skipped-insts off
 
 : th ( addr1 n -- addr2 )
     cells + ;
@@ -947,6 +952,7 @@ stack inst-stream IP Cell
     prim to combined
     0 num-combined !
     current-depth max-stacks cells erase
+    include-skipped-insts @ current-depth 0 th !
     max-depth     max-stacks cells erase
     min-depth     max-stacks cells erase
     prim prim-effect-in  prim prim-effect-in-end  !
@@ -958,11 +964,16 @@ stack inst-stream IP Cell
 : min! ( n addr -- )
     tuck @ min swap ! ;
 
+: inst-stream-correction ( nin1 nstack -- nin2 )
+    0= if
+	include-skipped-insts @ -
+    endif ;
+
 : add-depths { p -- }
     \ combine stack effect of p with *-depths
     max-stacks 0 ?do
 	current-depth i th @
-	p prim-stacks-in  i th @ +
+	p prim-stacks-in  i th @ + i inst-stream-correction
 	dup max-depth i th max!
 	p prim-stacks-out i th @ -
 	dup min-depth i th min!
@@ -1105,12 +1116,12 @@ stack inst-stream IP Cell
     cr ;
 
 
-\ superinstruction data for a sophisticated combiner (e.g., shortest path)
+\ cost and superinstruction data for a sophisticated combiner (e.g.,
+\ shortest path)
 
 \ This is intended as initializer for a structure like this
 
-\  struct super {
-\    int super;       /* index in vm_prims */
+\  struct cost {
 \    int loads;       /* number of stack loads */
 \    int stores;      /* number of stack stores */
 \    int updates;     /* number of stack pointer updates */
@@ -1118,15 +1129,38 @@ stack inst-stream IP Cell
 \    int *components; /* array of vm_prim indexes of components */
 \  };
 
+\ How do you know which primitive or combined instruction this
+\ structure refers to?  By the order of cost structures, as in most
+\ other cases.
+
+: compute-costs { p -- nloads nstores nupdates }
+    \ compute the number of loads, stores, and stack pointer updates
+    \ of a primitive or combined instruction; does not take TOS
+    \ caching into account, nor that IP updates are combined with
+    \ other stuff
+    0 max-stacks 0 +do
+	p prim-stacks-in i th @ +
+    loop
+    0 max-stacks 0 +do
+	p prim-stacks-out i th @ +
+    loop
+    0 max-stacks 0 +do
+	p prim-stacks-in i th @ p prim-stacks-out i th @ <> -
+    loop ;
 
 : output-num-part ( p -- )
     prim-num @ 4 .r ." ," ;
 
-: output-supers ( -- )
-    ." {" combined prim-num @ 4 .r
-    ." ,0,0,0," \ counting this stuff is not yet implemented
-    num-combined @ 2 .r
-    ." , ((int []){" ['] output-num-part map-combined ." })}"
+: output-costs ( -- )
+    ." {" prim compute-costs
+    rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ,"
+    combined if
+	num-combined @ 2 .r
+	." , ((int []){" ['] output-num-part map-combined ." })}, /* "
+    else
+	."  1, ((int []){" prim prim-num @ 4 .r ." })}, /* "
+    endif
+    prim prim-name 2@ type ."  */"
     cr ;
 
 \ the parser