Commit a0bf65ea authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Thrown out static vocabulary stack 

Changed cross to make mixed threading workable
parent 99a0a501

cross.fs

+16 −11
Original line number Diff line number Diff line
@@ -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

+4 −0
Original line number Diff line number Diff line
@@ -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

+2 −2
Original line number Diff line number Diff line
@@ -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

+8 −8
Original line number Diff line number Diff line
@@ -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

+7 −2
Original line number Diff line number Diff line
@@ -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)