--- gforth/prims2x.fs	2002/08/20 16:59:01	1.111
+++ gforth/prims2x.fs	2002/09/22 09:00:04	1.114
@@ -86,6 +86,9 @@ variable skipsynclines \ are sync lines
 skipsynclines on
 variable out-nls \ newlines in output (for output sync lines)
 0 out-nls !
+variable store-optimization \ use store optimization?
+store-optimization off
+
 
 : th ( addr1 n -- addr2 )
     cells + ;
@@ -247,6 +250,12 @@ variable in-part \ true if processing a
 create combined-prims max-combined cells allot
 variable num-combined
 
+: map-combined { xt -- }
+    \ perform xt for all components of the current combined instruction
+    num-combined @ 0 +do
+	combined-prims i th @ xt execute
+    loop ;
+
 table constant combinations
   \ the keys are the sequences of pointers to primitives
 
@@ -380,18 +389,16 @@ defer inst-stream-f ( -- stack )
     rdrop ;
 
 : store-single ( item -- )
- >r
- r@ same-as-in?
- if
-   r@ item-in-index 0= r@ item-out-index 0= xor
-   if
-       ." IF_" r@ item-stack @ stack-pointer 2@ type
-       ." TOS(" r@ really-store-single ." );" cr
-   endif
- else
-   r@ really-store-single cr
- endif
- rdrop ;
+    >r
+    store-optimization @ r@ same-as-in? and if
+	r@ item-in-index 0= r@ item-out-index 0= xor if
+	    ." IF_" r@ item-stack @ stack-pointer 2@ type
+	    ." TOS(" r@ really-store-single ." );" cr
+	endif
+    else
+	r@ really-store-single cr
+    endif
+    rdrop ;
 
 : store-double ( item -- )
 \ !! store optimization is not performed, because it is not yet needed
@@ -732,14 +739,15 @@ stack inst-stream IP Cell
     endif
     ." }" cr ;
 
+: output-profile-part ( p )
+    ."   add_inst(b, " quote
+    prim-name 2@ type
+    quote ." );" cr ;
+    
 : output-profile-combined ( -- )
     \ generate code for postprocessing the VM block profile stuff
     ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
-    num-combined @ 0 +do
-	."   add_inst(b, " quote
-	combined-prims i th @ prim-name 2@ type
-	quote ." );" cr
-    loop
+    ['] output-profile-part map-combined
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
     combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SET_IP"    search nip nip
     combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SUPER_END" search nip nip or if
@@ -825,6 +833,9 @@ stack inst-stream IP Cell
 : output-alias ( -- ) 
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
 
+: output-prim-num ( -- )
+    prim prim-num @ 8 + 4 .r space prim prim-name 2@ type cr ;
+
 : output-forth ( -- )  
     prim prim-forth-code @ 0=
     IF    	\ output-alias
@@ -836,7 +847,7 @@ stack inst-stream IP Cell
     THEN ;
 
 : output-tag-file ( -- )
-    name-filename 2@ last-name-filename 2@ compare if
+    name-filename 2@ last-name-filename 2@ str= 0= if
 	name-filename 2@ last-name-filename 2!
 	#ff emit cr
 	name-filename 2@ type
@@ -1050,9 +1061,7 @@ stack inst-stream IP Cell
 : output-parts ( -- )
     prim >r in-part on
     current-depth max-stacks cells erase
-    num-combined @ 0 +do
-	combined-prims i th @ output-part
-    loop
+    ['] output-part map-combined
     in-part off
     r> to prim ;
 
@@ -1078,13 +1087,16 @@ stack inst-stream IP Cell
 
 \ peephole optimization rules
 
+\ data for a simple peephole optimizer that always tries to combine
+\ the currently compiled instruction with the last one.
+
 \ in order for this to work as intended, shorter combinations for each
 \ length must be present, and the longer combinations must follow
 \ shorter ones (this restriction may go away in the future).
   
 : output-peephole ( -- )
     combined-prims num-combined @ 1- cells combinations search-wordlist
-    s" the prefix for this combination must be defined earlier" ?print-error
+    s" the prefix for this superinstruction must be defined earlier" ?print-error
     ." {"
     execute prim-num @ 5 .r ." ,"
     combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ,"
@@ -1092,15 +1104,30 @@ stack inst-stream IP Cell
     combined prim-c-name 2@ type ."  */"
     cr ;
 
-: output-forth-peephole ( -- )
-    combined-prims num-combined @ 1- cells combinations search-wordlist
-    s" the prefix for this combination must be defined earlier" ?print-error
-    execute prim-num @ 5 .r
-    combined-prims num-combined @ 1- th @ prim-num @ 5 .r
-    combined prim-num @ 5 .r ."  prim, \ "
-    combined prim-c-name 2@ type
-    cr ;
 
+\ 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 */
+\    int loads;       /* number of stack loads */
+\    int stores;      /* number of stack stores */
+\    int updates;     /* number of stack pointer updates */
+\    int length;      /* number of components */
+\    int *components; /* array of vm_prim indexes of components */
+\  };
+
+
+: 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 ." })}"
+    cr ;
 
 \ the parser
 
@@ -1130,7 +1157,7 @@ print-token !
     \ when input points to a newline, check if the next line is a
     \ sync line.  If it is, perform the appropriate actions.
     rawinput @ >r
-    s" #line " r@ over compare 0<> if
+    s" #line " r@ over str= 0= if
 	rdrop 1 line +! EXIT
     endif
     0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr )