Thrown out static vocabulary stack

Changed cross to make mixed threading workable

cross.fs

@@ -902,7 +902,9 @@ Defer is-forward
 Defer do-refered
 
 : prim-forward   ( ghost -- )
-  colonmark, 1 do-refered ; \ compile space for call
+  colonmark, 0 do-refered ; \ compile space for call
+: doer-forward   ( ghost -- )
+  colonmark, 2 do-refered ; \ compile space for doer
 ' prim-forward IS is-forward
 
 : (ghostheader) ( -- )
@@ -1068,8 +1070,6 @@ Ghost branch    Ghost ?branch                   2drop
 Ghost unloop    Ghost ;S                        2drop
 Ghost lit       Ghost !                         2drop
 Ghost noop                                      drop
-Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
-Ghost :dovar					drop
 Ghost over      Ghost =         Ghost drop      2drop drop
 Ghost 2drop drop
 Ghost 2dup drop
@@ -1085,6 +1085,13 @@ Ghost lit-perform drop
 Ghost lit+ drop
 Ghost does-exec drop
 
+' doer-forward IS is-forward
+
+Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
+Ghost :dovar					drop
+
+' prim-forward IS is-forward
+
 \ \ Parameter for target systems                         06oct92py
 
 
@@ -2183,13 +2190,14 @@ Defer setup-prim-semantics
   Ghost tuck swap resolve <do:> swap tuck >magic !
   asmprimname, ;
 
-: Alias:   ( cfa -- ) \ name
+: Doer:   ( cfa -- ) \ name
   >in @ skip? IF  2drop  EXIT  THEN  >in !
   dup 0< s" prims" T $has? H 0= and
   IF
       .sourcepos ." needs doer: " >in @ bl word count type >in ! cr
   THEN
-  Ghost tuck swap resolve <do:> swap >magic ! ;
+  Ghost
+  tuck swap resolve <do:> swap >magic ! ;
 
 Variable prim#
 : first-primitive ( n -- )  prim# ! ;
@@ -2199,11 +2207,9 @@ Variable prim#
   IF
      .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
   THEN
-\  ['] prim-forward IS is-forward
   prim# @ (THeader ( S xt ghost )
   dup >ghost-flags <primitive> set-flag
   over resolve T A, H alias-mask flag!
-\  ['] call-forward IS is-forward
   -1 prim# +! ;
 >CROSS
 
@@ -2287,10 +2293,10 @@ T 2 cells H Value xt>body
   there xt>body + ca>native T a, H 1 fillcfa ;		' (doprim,) plugin-of doprim,
 
 : (doeshandler,) ( -- ) 
-  T cfalign H compile :doesjump T 0 , H ; 		' (doeshandler,) plugin-of doeshandler,
+  T cfalign H [G'] :doesjump addr, T 0 , H ; 		' (doeshandler,) plugin-of doeshandler,
 
 : (dodoes,) ( does-action-ghost -- )
-  ]comp [G'] :dodoes gexecute comp[
+  ]comp [G'] :dodoes addr, comp[
   addr,
   \ the relocator in the c engine, does not like the
   \ does-address to marked for relocation
@@ -2505,7 +2511,6 @@ Defer instant-interpret-does>-hook
 
 : does-resolved ( ghost -- )
     compile does-exec g>xt T a, H ;
-\    dup g>body alit, >do:ghost @ g>xt 0 t>body - colon, ;
 
 : resolve-does>-part ( -- )
 \ resolve words made by builders
@@ -2796,7 +2801,7 @@ T has? peephole H [IF]
 : (callc) compile call T >body a, H ;		' (callc) plugin-of colon,
 : (call-res) >tempdp resolved gexecute tempdp> drop ;
                                                 ' (call-res) plugin-of colon-resolve
-: (prim) dup 0< IF  ( $4000 - ) ELSE
+: (prim) dup 0< IF  $4000 -  ELSE
     ." wrong usage of (prim) "
     dup gdiscover IF  .ghost  ELSE  .  THEN  cr -2 throw  THEN
     T a, H ;					' (prim) plugin-of prim,

engine/main.c

@@ -177,6 +177,10 @@ void relocate(Cell *image, const char *bitstring,
 	    default          :
 /*	      printf("Code field generation image[%x]:=CA(%x)\n",
 		     i, CF(image[i])); */
+#if !defined(DOUBLY_INDIRECT)
+	      if (((token | 0x4000) >= CF(DODOES)) && (token < -0x4000))
+		fprintf(stderr,"Doer %d used in this image at $%lx is marked as Xt; executing this code will crash.\n",CF((token | 0x4000)),(long)&image[i],VERSION);
+#endif
 	      token |= 0x4000; /* only meaningful for hybrid engines */
 	      if (CF(token)<max_symbols)
 		image[i]=(Cell)CA(CF(token));

engine/signals.c

@@ -367,8 +367,8 @@ void install_signal_handlers(void)
   for (i = 0; i < DIM (sigs_to_quit); i++)
     bsd_signal(sigs_to_quit [i], graceful_exit);
 #ifdef SA_SIGINFO
-  install_signal_handler(SIGFPE, fpe_handler);
-  install_signal_handler(SIGSEGV, segv_handler);
+  install_signal_handler(SIGFPE, die_on_signal ? graceful_exit : fpe_handler);
+  install_signal_handler(SIGSEGV, die_on_signal ? graceful_exit : segv_handler);
 #endif
 #ifdef SIGCONT
     bsd_signal(SIGCONT, termprep);

kernel/aliases0.fs

@@ -18,12 +18,12 @@
 \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 
--2 Alias: :docol
--3 Alias: :docon
--4 Alias: :dovar
--5 Alias: :douser
--6 Alias: :dodefer
--7 Alias: :dofield
--8 Alias: :dodoes
--9 Alias: :doesjump
+-2 Doer: :docol
+-3 Doer: :docon
+-4 Doer: :dovar
+-5 Doer: :douser
+-6 Doer: :dodefer
+-7 Doer: :dofield
+-8 Doer: :dodoes
+-9 Doer: :doesjump
 -&10 first-primitive

prim

@@ -2427,9 +2427,14 @@ does-exec ( #a_cfa -- R:nest a_pfa )	new	does_exec
 a_pfa = PFA(a_cfa);
 nest = (Cell)ip;
 IF_spTOS(spTOS = sp[0]);
-SUPER_END;
+#ifdef DEBUG
+    {
+      CFA_TO_NAME(a_cfa);
+      fprintf(stderr,"%08lx: does %08lx %.*s\n",
+	      (Cell)ip,(Cell)a_cfa,len,name);
+    }
+#endif
 SET_IP(DOES_CODE1(a_cfa));
-SUPER_END;
 
 include(peeprules.vmg)
 

search.fs

@@ -18,13 +18,9 @@
 \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 
-$10 value maxvp			\ current size of search order stack
-$400 constant maxvp-limit	\ upper limit for resizing search order stack
-Variable static-vp
-  0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
-  0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A,
-0 Value vp
-static-vp ' vp >body A!
+$10 Value maxvp		\ current size of search order stack
+$400 Value maxvp-limit	\ upper limit for resizing search order stack
+0 AValue vp		\ will be initialized later (dynamic)
 
 : get-current  ( -- wid ) \ search
   \G @i{wid} is the identifier of the current compilation word list.
@@ -76,21 +72,10 @@ Variable slowvoc   0 slowvoc !
 : check-maxvp ( n -- )
    dup maxvp-limit > -49 and throw
    dup maxvp > IF
-      vp static-vp = -49 and throw
-      BEGIN  dup  maxvp 2* dup TO maxvp  > 0= UNTIL
+      BEGIN  dup  maxvp 2* dup TO maxvp  <= UNTIL
       vp  maxvp 1+ cells resize throw TO vp
    THEN drop ;
 
-: init-vp  ( n -- )
-   $10 TO maxvp
-   maxvp 1+ cells allocate throw TO vp
-   static-vp dup @ 1+ cells  vp swap move ;
-
-:noname
-   DEFERS 'cold
-   init-vp ;
-IS 'cold
-
 : >order ( wid -- ) \ gforth to-order
     \g Push @var{wid} on the search order.
     vp @ 1+ dup check-maxvp vp! context ! ;
@@ -164,12 +149,21 @@ Vocabulary Root ( -- ) \ gforth
   \G order (for Gforth, this is the word list @code{Root}).
   1 vp! Root also ;
 
+: init-vp  ( -- )
+   $10 TO maxvp
+   maxvp 1+ cells allocate throw TO vp
+   Only Forth also definitions ;
+
+:noname
+   init-vp DEFERS 'cold ;
+IS 'cold
+
+init-vp
+
 \ set initial search order                             14may93py
 
 Forth-wordlist wordlist-id @ ' Forth >body wordlist-id !
 
-0 vp! also Root also definitions
-Only Forth also definitions
 lookup ! \ our dictionary search order becomes the law ( -- )
 
 ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid