--- gforth/prim	2003/05/04 08:28:28	1.127
+++ gforth/prim	2003/08/17 12:21:05	1.136
@@ -106,6 +106,10 @@
 \E set-current
 \E store-optimization on
 \E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump
+\E
+\E include-skipped-insts on \ static superinsts include cells for components
+\E                          \ useful for dynamic programming and
+\E                          \ superinsts across entry points
 
 \ 
 \ 
@@ -1080,19 +1084,19 @@ rdrop	( R:w -- )		gforth
 :
  r> r> drop >r ;
 
-2>r	( w1 w2 -- R:w1 R:w2 )	core-ext	two_to_r
+2>r	( d -- R:d )	core-ext	two_to_r
 :
  swap r> swap >r swap >r >r ;
 
-2r>	( R:w1 R:w2 -- w1 w2 )	core-ext	two_r_from
+2r>	( R:d -- d )	core-ext	two_r_from
 :
  r> r> swap r> swap >r swap ;
 
-2r@	( R:w1 R:w2 -- R:w1 R:w2 w1 w2 )	core-ext	two_r_fetch
+2r@	( R:d -- R:d d )	core-ext	two_r_fetch
 :
  i' j ;
 
-2rdrop	(  R:w1 R:w2 -- )		gforth	two_r_drop
+2rdrop	( R:d -- )		gforth	two_r_drop
 :
  r> r> drop r> drop >r ;
 
@@ -1557,7 +1561,7 @@ c_addr = strerror(n);
 u = strlen(c_addr);
 
 strsignal	( n -- c_addr u )	gforth
-c_addr = strsignal(n);
+c_addr = (Address)strsignal(n);
 u = strlen(c_addr);
 
 call-c	( w -- )	gforth	call_c
@@ -2158,6 +2162,184 @@ r = fp[u+1]; /* +1, because update of fp
 
 \g syslib
 
+open-lib	( c_addr1 u1 -- u2 )	gforth	open_lib
+#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
+#ifndef RTLD_GLOBAL
+#define RTLD_GLOBAL 0
+#endif
+u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY);
+#else
+#  ifdef _WIN32
+u2 = (Cell) GetModuleHandle(cstr(c_addr1, u1, 1));
+#  else
+#warning Define open-lib!
+u2 = 0;
+#  endif
+#endif
+
+lib-sym	( c_addr1 u1 u2 -- u3 )	gforth	lib_sym
+#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
+u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));
+#else
+#  ifdef _WIN32
+u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));
+#  else
+#warning Define lib-sym!
+u3 = 0;
+#  endif
+#endif
+
+\+FFCALL
+
+av-start-void	( c_addr -- )	gforth  av_start_void
+av_start_void(alist, c_addr);
+
+av-start-int	( c_addr -- )	gforth  av_start_int
+av_start_int(alist, c_addr, &irv);
+
+av-start-float	( c_addr -- )	gforth  av_start_float
+av_start_float(alist, c_addr, &frv);
+
+av-start-double	( c_addr -- )	gforth  av_start_double
+av_start_double(alist, c_addr, &drv);
+
+av-start-longlong	( c_addr -- )	gforth  av_start_longlong
+av_start_longlong(alist, c_addr, &llrv);
+
+av-start-ptr	( c_addr -- )	gforth  av_start_ptr
+av_start_ptr(alist, c_addr, void*, &prv);
+
+av-int  ( w -- )  gforth  av_int
+av_int(alist, w);
+
+av-float	( r -- )	gforth  av_float
+av_float(alist, r);
+
+av-double	( r -- )	gforth  av_double
+av_double(alist, r);
+
+av-longlong	( d -- )	gforth  av_longlong
+av_longlong(alist, d);
+
+av-ptr	( c_addr -- )	gforth  av_ptr
+av_ptr(alist, void*, c_addr);
+
+av-int-r  ( R:w -- )  gforth  av_int_r
+av_int(alist, w);
+
+av-float-r	( -- )	gforth  av_float_r
+float r = *(Float*)lp;
+lp += sizeof(Float);
+av_float(alist, r);
+
+av-double-r	( -- )	gforth  av_double_r
+double r = *(Float*)lp;
+lp += sizeof(Float);
+av_double(alist, r);
+
+av-longlong-r	( R:d -- )	gforth  av_longlong_r
+av_longlong(alist, d);
+
+av-ptr-r	( R:c_addr -- )	gforth  av_ptr_r
+av_ptr(alist, void*, c_addr);
+
+av-call-void	( -- )	gforth  av_call_void
+SAVE_REGS
+av_call(alist);
+REST_REGS
+
+av-call-int	( -- w )	gforth  av_call_int
+SAVE_REGS
+av_call(alist);
+REST_REGS
+w = irv;
+
+av-call-float	( -- r )	gforth  av_call_float
+SAVE_REGS
+av_call(alist);
+REST_REGS
+r = frv;
+
+av-call-double	( -- r )	gforth  av_call_double
+SAVE_REGS
+av_call(alist);
+REST_REGS
+r = drv;
+
+av-call-longlong	( -- d )	gforth  av_call_longlong
+SAVE_REGS
+av_call(alist);
+REST_REGS
+d = llrv;
+
+av-call-ptr	( -- c_addr )	gforth  av_call_ptr
+SAVE_REGS
+av_call(alist);
+REST_REGS
+c_addr = prv;
+
+alloc-callback	( a_ip -- c_addr )	gforth	alloc_callback
+c_addr = (char *)alloc_callback(engine_callback, (Xt *)a_ip);
+
+va-start-void	( -- )	gforth	va_start_void
+va_start_void(clist);
+
+va-start-int	( -- )	gforth	va_start_int
+va_start_int(clist);
+
+va-start-longlong	( -- )	gforth	va_start_longlong
+va_start_longlong(clist);
+
+va-start-ptr	( -- )	gforth	va_start_ptr
+va_start_ptr(clist, (char *));
+
+va-start-float	( -- )	gforth	va_start_float
+va_start_float(clist);
+
+va-start-double	( -- )	gforth	va_start_double
+va_start_double(clist);
+
+va-arg-int	( -- w )	gforth	va_arg_int
+w = va_arg_int(clist);
+
+va-arg-longlong	( -- d )	gforth	va_arg_longlong
+d = va_arg_longlong(clist);
+
+va-arg-ptr	( -- c_addr )	gforth	va_arg_ptr
+c_addr = (char *)va_arg_ptr(clist,char*);
+
+va-arg-float	( -- r )	gforth	va_arg_float
+r = va_arg_float(clist);
+
+va-arg-double	( -- r )	gforth	va_arg_double
+r = va_arg_double(clist);
+
+va-return-void ( -- )	gforth va_return_void
+va_return_void(clist);
+return 0;
+
+va-return-int ( w -- )	gforth va_return_int
+va_return_int(clist, w);
+return 0;
+
+va-return-ptr ( c_addr -- )	gforth va_return_ptr
+va_return_ptr(clist, void *, c_addr);
+return 0;
+
+va-return-longlong ( d -- )	gforth va_return_longlong
+va_return_longlong(clist, d);
+return 0;
+
+va-return-float ( r -- )	gforth va_return_float
+va_return_float(clist, r);
+return 0;
+
+va-return-double ( r -- )	gforth va_return_double
+va_return_double(clist, r);
+return 0;
+
+\-
+
 define(`uploop',
        `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')')
 define(`_uploop',
@@ -2189,39 +2371,13 @@ rret = (SYSCALL(Float(*)(argdlist($1)))u
 
 \ close ' to keep fontify happy
 
-open-lib	( c_addr1 u1 -- u2 )	gforth	open_lib
-#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
-#ifndef RTLD_GLOBAL
-#define RTLD_GLOBAL 0
-#endif
-u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY);
-#else
-#  ifdef _WIN32
-u2 = (Cell) GetModuleHandle(cstr(c_addr1, u1, 1));
-#  else
-#warning Define open-lib!
-u2 = 0;
-#  endif
-#endif
-
-lib-sym	( c_addr1 u1 u2 -- u3 )	gforth	lib_sym
-#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
-u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));
-#else
-#  ifdef _WIN32
-u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));
-#  else
-#warning Define lib-sym!
-u3 = 0;
-#  endif
-#endif
-
 uploop(i, 0, 7, `icall(i)')
 icall(20)
 uploop(i, 0, 7, `fcall(i)')
 fcall(20)
 
 \+
+\+
 
 wcall	( u -- )	gforth
 IF_fpTOS(fp[0]=fpTOS);
@@ -2269,8 +2425,18 @@ JUMP(a_callee);
 assert(0);
 #endif
 
+tag-offsets ( -- a_addr ) gforth tag_offsets
+extern Cell groups[32];
+a_addr = groups;
+
 \+
 
+\g static_super
+
+\C #if !defined(GFORTH_DEBUGGING) && !defined(INDIRECT_THREADED) && !defined(DOUBLY_INDIRECT) && !defined(VM_PROFILING)
+
 include(peeprules.vmg)
 
+\C #endif
+
 \g end