--- gforth/prims2x.fs	1994/05/07 14:56:04	1.1
+++ gforth/prims2x.fs	1994/09/08 17:20:12	1.7
@@ -15,12 +15,13 @@
 \ 5) Words that call NEXT themselves have to be done very carefully.
 \
 \ To do:
-\ add the store optimization for doubles
 \ regarding problem 1 above: It would be better (for over) to implement
 \ 	the alternative
 
+warnings off
+
+[IFUNDEF] vocabulary  include search-order.fs [THEN]
 include gray.fs
-include search-order.fs
 
 100 constant max-effect \ number of things on one side of a stack effect
 4096 constant batch-size \ no meaning, just make sure it's >0
@@ -87,7 +88,7 @@ variable effect-out-end ( pointer )
 2variable effect-in-size
 2variable effect-out-size
 
-variable primitive-number -8 primitive-number !
+variable primitive-number -9 primitive-number !
 
 \ for several reasons stack items of a word are stored in a wordlist
 \ since neither forget nor marker are implemented yet, we make a new
@@ -195,7 +196,9 @@ nowhite ++
 
 (( (( primitive {{ printprim }} )) **  eof ))
 parser primitives2something
+warnings @ [IF]
 .( parser generated ok ) cr
+[THEN]
 
 : primfilter ( file-id xt -- )
 \ fileid is for the input file, xt ( -- ) is for the output word
@@ -204,6 +207,7 @@ parser primitives2something
  here swap read-whole-file
  dup endinput !
  here - allot
+ align
  primitives2something ;
 
 \ types
@@ -220,7 +224,7 @@ constant type-description
 \ n1 is the offset of the accessed item, n2, n3 are effect-*-size
  drop swap - 1- dup
  if
-   ." sp[" . ." ]"
+   ." sp[" 0 .r ." ]"
  else
    drop ." TOS"
  endif ;
@@ -229,7 +233,7 @@ constant type-description
 \ n1 is the offset of the accessed item, n2, n3 are effect-*-size
  nip swap - 1- dup
  if
-   ." fp[" . ." ]"
+   ." fp[" 0 .r ." ]"
  else
    drop ." FTOS"
  endif ;
@@ -300,8 +304,8 @@ constant type-description
  >r
  ." {Double_Store _d; _d.dcell = " r@ item-name 2@ type ." ; "
  r@ item-d-offset @ dup    effect-out-size 2@ data-stack-access 
- ."  =  _d.cells.low; " 1+ effect-out-size 2@ data-stack-access
- ." =  _d.cells.high;}" cr
+ ."  = _d.cells.low; " 1+ effect-out-size 2@ data-stack-access
+ ." = _d.cells.high;}" cr
  rdrop ;
 
 : f-same-as-in? ( item -- f )
@@ -489,8 +493,8 @@ set-current
  effect-out-size 2@
  rot swap - ( d-in d-out f-diff )
  rot rot - ( f-diff d-diff )
- ." sp += " . ." ;" cr
- ." fp += " . ." ;" cr ;
+ ?dup IF  ." sp += " 0 .r ." ;" cr  THEN
+ ?dup IF  ." fp += " 0 .r ." ;" cr  THEN ;
 
 : store ( item -- )
 \ f is true if the item should be stored
@@ -503,7 +507,7 @@ set-current
  item-descr +loop ; 
 
 : output-c ( -- )
- ." I_" c-name 2@ type ." : /* " forth-name 2@ type ."  ( " stack-string 2@ type ."  ) */" cr
+ ." I_" c-name 2@ type ." :	/* " forth-name 2@ type ."  ( " stack-string 2@ type ."  ) */" cr
  ." /* " doc 2@ type ."  */" cr
  ." {" cr
  ." DEF_CA" cr
@@ -511,7 +515,7 @@ set-current
  compute-offsets \ for everything else
  flush-tos
  fetches
- stack-pointer-updates
+ stack-pointer-updates cr
  ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging
  ." {" cr
  c-code 2@ type
@@ -519,7 +523,7 @@ set-current
  ." NEXT_P1;" cr
  stores
  fill-tos
- ." NEXT1_P2;" cr
+ ." NEXT_P2;" cr
  ." }" cr
  cr
 ;
@@ -536,5 +540,7 @@ set-current
  if
    ." cannot open file" cr abort
  endif
- ." ------------ CUT HERE -------------" cr
+ warnings @ if
+ ." ------------ CUT HERE -------------" cr  endif
  r> primfilter ;
+