--- gforth/prim	2010/04/25 18:27:09	1.248
+++ gforth/prim	2012/12/31 15:25:18	1.280
@@ -1,6 +1,6 @@
 \ Gforth primitives
 
-\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -612,6 +612,24 @@ SET_IP((Xt *)a_target);
      cell+
  THEN  >r ;
 
+(try1)	( ... a_oldhandler a_recovery -- R:a_recovery R:a_sp R:f_fp R:c_lp R:a_oldhandler a_newhandler ) gforth paren_try1
+a_sp = sp-1;
+f_fp = fp;
+c_lp = lp;
+a_newhandler = rp-5;
+
+(throw1) ( ... wball a_handler -- ... wball ) gforth paren_throw1
+rp = a_handler;
+lp = (Address)rp[1];
+fp = (Float *)rp[2];
+sp = (Cell *)rp[3];
+#ifndef NO_IP
+ip=IP;
+#endif
+SUPER_END;
+VM_JUMP(EXEC1(*(Xt *)rp[4]));
+  
+
 \+
 
 \ don't make any assumptions where the return stack is!!
@@ -1085,6 +1103,34 @@ lshift	( u1 n -- u2 )		core	l_shift
 :
     0 ?DO 2* LOOP ;
 
+umax	( u1 u2 -- u )	core
+if (u1<u2)
+  u = u2;
+else
+  u = u1;
+:
+ 2dup u> select ;
+
+umin	( u1 u2 -- u )	core
+if (u1<u2)
+  u = u1;
+else
+  u = u2;
+:
+ 2dup u< select ;
+
+mux   ( u1 u2 u3 -- u )	   gforth
+""multiplex @i{u1} for 1 bits in @i{u3}, @i{u2} for 0 bits in @i{u3} into @i{u}""
+u = (u3 & u1) | (~u3 & u2);
+:
+ tuck and >r invert and r> ;
+
+select ( u1 u2 f -- u )	   gforth
+""select @i{u1} if @i{f} is true, @i{u2} if false.""
+u = f ? u1 : u2;
+:
+ IF swap THEN nip ;
+
 \g compare
 
 \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)
@@ -1482,6 +1528,17 @@ c_addr2 = c_addr1+1;
 :
  dup 1+ swap c@ ;
 
+cell/ ( n1 -- n2 )	gforth cell_divide
+""@i{n2} is the number of cells that fit into @i{n1}""
+n2 = n1 / sizeof(Cell);
+:
+ [ cell
+ 2/ dup [IF] ] 2/ [ [THEN]
+ 2/ dup [IF] ] 2/ [ [THEN]
+ 2/ dup [IF] ] 2/ [ [THEN]
+ 2/ dup [IF] ] 2/ [ [THEN]
+ drop ] ;
+
 \g compiler
 
 \+f83headerstring
@@ -1666,7 +1723,7 @@ wfileid = (Cell)stderr;
 
 \+os
 
-form	( -- urows ucols )	gforth
+(form)	( -- urows ucols )	gforth	paren_form
 ""The number of lines and columns in the terminal. These numbers may
 change with the window size.  Note that it depends on the OS whether
 this reflects the actual size and changes with the window size
@@ -1701,6 +1758,10 @@ FLUSH_ICACHE((caddr_t)c_addr,u);
 
 (bye)	( n -- )	gforth	paren_bye
 SUPER_END;
+gforth_FP=fp;
+gforth_SP=sp;
+gforth_RP=rp;
+gforth_LP=lp;
 return (Label *)n;
 
 (system)	( c_addr u -- wretval wior )	gforth	paren_system
@@ -1713,13 +1774,17 @@ is the host operating system's expansion
 environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
 in length.""
 /* close ' to keep fontify happy */
-c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1));
+char * string = cstr(c_addr1,u1);
+c_addr2 = (Char *)getenv(string);
 u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2));
+free(string);
 
 open-pipe	( c_addr u wfam -- wfileid wior )	gforth	open_pipe
+char * string = cstr(c_addr,u);
 fflush(stdout);
-wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */
+wfileid=(Cell)popen(string,pfileattr[wfam]); /* ~ expansion of 1st arg? */
 wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */
+free(string);
 
 close-pipe	( wfileid -- wretval wior )		gforth	close_pipe
 wretval = pclose((FILE *)wfileid);
@@ -1786,6 +1851,8 @@ if (a_addr1==NULL)
 else
   a_addr2 = (Cell *)realloc(a_addr1, u);
 wior = IOR(a_addr2==NULL);	/* !! Define a return code */
+if (a_addr2==NULL)
+  a_addr2 = a_addr1;
 
 strerror	( n -- c_addr u )	gforth
 c_addr = (Char *)strerror(n);
@@ -1809,7 +1876,7 @@ gforth_LP=lp;
 #ifdef HAS_LINKBACK
 ((void (*)())w)();
 #else
-((void (*)(void *))w)(gforth_pointers);
+((void (*)(void *))w)(&gforth_pointers);
 #endif
 sp=gforth_SP;
 fp=gforth_FP;
@@ -1824,13 +1891,19 @@ close-file	( wfileid -- wior )		file	clo
 wior = IOR(fclose((FILE *)wfileid)==EOF);
 
 open-file	( c_addr u wfam -- wfileid wior )	file	open_file
-wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, 0, &wior);
+char * string = tilde_cstr(c_addr,u);
+wfileid = opencreate_file(string, wfam, 0, &wior);
+free(string);
 
 create-file	( c_addr u wfam -- wfileid wior )	file	create_file
-wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, O_CREAT|O_TRUNC, &wior);
+char * string = tilde_cstr(c_addr,u);
+wfileid = opencreate_file(string, wfam, O_CREAT|O_TRUNC, &wior);
+free(string);
 
 delete-file	( c_addr u -- wior )		file	delete_file
-wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1);
+char * string = tilde_cstr(c_addr,u);
+wior = IOR(unlink(string)==-1);
+free(string);
 
 rename-file	( c_addr1 u1 c_addr2 u2 -- wior )	file-ext	rename_file
 ""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}""
@@ -1909,8 +1982,10 @@ flag = FLAG(feof((FILE *) wfileid));
 open-dir	( c_addr u -- wdirid wior )	gforth	open_dir
 ""Open the directory specified by @i{c-addr, u}
 and return @i{dir-id} for futher access to it.""
-wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));
+char * string = tilde_cstr(c_addr,u);
+wdirid = (Cell)opendir(string);
 wior =  IOR(wdirid == 0);
+free(string);
 
 read-dir	( c_addr u1 wdirid -- u2 flag wior )	gforth	read_dir
 ""Attempt to read the next entry from the directory specified
@@ -1945,14 +2020,18 @@ close-dir	( wdirid -- wior )	gforth	clos
 wior = IOR(closedir((DIR *)wdirid));
 
 filename-match	( c_addr1 u1 c_addr2 u2 -- flag )	gforth	match_file
-char * string = cstr(c_addr1, u1, 1);
-char * pattern = cstr(c_addr2, u2, 0);
+char * string = cstr(c_addr1, u1);
+char * pattern = cstr(c_addr2, u2);
 flag = FLAG(!fnmatch(pattern, string, 0));
+free(string);
+free(pattern);
 
 set-dir	( c_addr u -- wior )	gforth set_dir
 ""Change the current directory to @i{c-addr, u}.
 Return an error if this is not possible""
-wior = IOR(chdir(tilde_cstr(c_addr, u, 1)));
+char * string = tilde_cstr(c_addr, u);
+wior = IOR(chdir(string));
+free(string);
 
 get-dir	( c_addr1 u1 -- c_addr2 u2 )	gforth get_dir
 ""Store the current directory in the buffer specified by @i{c-addr1, u1}.
@@ -1966,13 +2045,15 @@ if(c_addr2 != NULL) {
 
 =mkdir ( c_addr u wmode -- wior )        gforth equals_mkdir
 ""Create directory @i{c-addr u} with mode @i{wmode}.""
-wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode));
+char * string = tilde_cstr(c_addr,u);
+wior = IOR(mkdir(string,wmode));
+free(string);
 
 \+
 
 newline	( -- c_addr u )	gforth
 ""String containing the newline sequence of the host OS""
-char newline[] = {
+static const char newline[] = {
 #if DIRSEP=='/'
 /* Unix */
 '\n'
@@ -2013,6 +2094,19 @@ duser = timeval2us(&time1);
 dsystem = DZERO;
 #endif
 
+ntime	( -- dtime )	gforth
+""Report the current time in nanoseconds since some epoch.""
+struct timespec time1;
+#ifdef HAVE_CLOCK_GETTIME
+clock_gettime(CLOCK_REALTIME,&time1);
+#else
+struct timeval time2;
+gettimeofday(&time2,NULL);
+time1.tv_sec = time2.tv_sec;
+time1.tv_nsec = time2.tv_usec*1000;
+#endif
+dtime = timespec2ns(&time1);
+
 \+
 
 \+floating
@@ -2104,7 +2198,9 @@ r3 = r1/r2;
 
 f**	( r1 r2 -- r3 )	float-ext	f_star_star
 ""@i{r3} is @i{r1} raised to the @i{r2}th power.""
+CLOBBER_TOS_WORKAROUND_START;
 r3 = pow(r1,r2);
+CLOBBER_TOS_WORKAROUND_END;
 
 fm*	( r1 n -- r2 )	gforth	fm_star
 r2 = r1*n;
@@ -2146,7 +2242,9 @@ n2 = n1*sizeof(Float);
 floor	( r1 -- r2 )	float
 ""Round towards the next smaller integral value, i.e., round toward negative infinity.""
 /* !! unclear wording */
+CLOBBER_TOS_WORKAROUND_START;
 r2 = floor(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fround	( r1 -- r2 )	float	f_round
 ""Round to the nearest integral value.""
@@ -2191,7 +2289,7 @@ representation. If the string represents
 true. Otherwise, @i{flag} is false. A string of blanks is a special
 case and represents the floating-point number 0.""
 Float r;
-flag = to_float(c_addr, u, &r);
+flag = to_float(c_addr, u, &r, '.');
 if (flag) {
   fp--;
   fp[0]=r;
@@ -2201,10 +2299,14 @@ fabs	( r1 -- r2 )	float-ext	f_abs
 r2 = fabs(r1);
 
 facos	( r1 -- r2 )	float-ext	f_a_cos
+CLOBBER_TOS_WORKAROUND_START;
 r2 = acos(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fasin	( r1 -- r2 )	float-ext	f_a_sine
+CLOBBER_TOS_WORKAROUND_START;
 r2 = asin(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fatan	( r1 -- r2 )	float-ext	f_a_tan
 r2 = atan(r1);
@@ -2212,13 +2314,19 @@ r2 = atan(r1);
 fatan2	( r1 r2 -- r3 )	float-ext	f_a_tan_two
 ""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably
 intends this to be the inverse of @code{fsincos}. In gforth it is.""
+CLOBBER_TOS_WORKAROUND_START;
 r3 = atan2(r1,r2);
+CLOBBER_TOS_WORKAROUND_END;
 
 fcos	( r1 -- r2 )	float-ext	f_cos
+CLOBBER_TOS_WORKAROUND_START;
 r2 = cos(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fexp	( r1 -- r2 )	float-ext	f_e_x_p
+CLOBBER_TOS_WORKAROUND_START;
 r2 = exp(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fexpm1	( r1 -- r2 )	float-ext	f_e_x_p_m_one
 ""@i{r2}=@i{e}**@i{r1}@minus{}1""
@@ -2228,16 +2336,23 @@ extern double
               const
 #endif
                     expm1(double);
+CLOBBER_TOS_WORKAROUND_START;
 r2 = expm1(r1);
+CLOBBER_TOS_WORKAROUND_END;
 #else
+CLOBBER_TOS_WORKAROUND_START;
 r2 = exp(r1)-1.;
+CLOBBER_TOS_WORKAROUND_END;
 #endif
 
 fln	( r1 -- r2 )	float-ext	f_l_n
+CLOBBER_TOS_WORKAROUND_START;
 r2 = log(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 flnp1	( r1 -- r2 )	float-ext	f_l_n_p_one
 ""@i{r2}=ln(@i{r1}+1)""
+CLOBBER_TOS_WORKAROUND_START;
 #ifdef HAVE_LOG1P
 extern double
 #ifdef NeXT
@@ -2248,59 +2363,81 @@ r2 = log1p(r1);
 #else
 r2 = log(r1+1.);
 #endif
+CLOBBER_TOS_WORKAROUND_END;
 
 flog	( r1 -- r2 )	float-ext	f_log
 ""The decimal logarithm.""
+CLOBBER_TOS_WORKAROUND_START;
 r2 = log10(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 falog	( r1 -- r2 )	float-ext	f_a_log
 ""@i{r2}=10**@i{r1}""
 extern double pow10(double);
+CLOBBER_TOS_WORKAROUND_START;
 r2 = pow10(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fsin	( r1 -- r2 )	float-ext	f_sine
+CLOBBER_TOS_WORKAROUND_START;
 r2 = sin(r1);
+CLOBBER_TOS_WORKAROUND_END;
 
 fsincos	( r1 -- r2 r3 )	float-ext	f_sine_cos
 ""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""
-r2 = sin(r1);
-r3 = cos(r1);
+CLOBBER_TOS_WORKAROUND_START;
+sincos(r1, &r2, &r3);
+CLOBBER_TOS_WORKAROUND_END;
 
 fsqrt	( r1 -- r2 )	float-ext	f_square_root
 r2 = sqrt(r1);
 
 ftan	( r1 -- r2 )	float-ext	f_tan
+CLOBBER_TOS_WORKAROUND_START;
 r2 = tan(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fsincos f/ ;
 
 fsinh	( r1 -- r2 )	float-ext	f_cinch
+CLOBBER_TOS_WORKAROUND_START;
 r2 = sinh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
 
 fcosh	( r1 -- r2 )	float-ext	f_cosh
+CLOBBER_TOS_WORKAROUND_START;
 r2 = cosh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fexp fdup 1/f f+ f2/ ;
 
 ftanh	( r1 -- r2 )	float-ext	f_tan_h
+CLOBBER_TOS_WORKAROUND_START;
 r2 = tanh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  f2* fexpm1 fdup 2. d>f f+ f/ ;
 
 fasinh	( r1 -- r2 )	float-ext	f_a_cinch
+CLOBBER_TOS_WORKAROUND_START;
 r2 = asinh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
 
 facosh	( r1 -- r2 )	float-ext	f_a_cosh
+CLOBBER_TOS_WORKAROUND_START;
 r2 = acosh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fdup fdup f* 1. d>f f- fsqrt f+ fln ;
 
 fatanh	( r1 -- r2 )	float-ext	f_a_tan_h
+CLOBBER_TOS_WORKAROUND_START;
 r2 = atanh(r1);
+CLOBBER_TOS_WORKAROUND_END;
 :
  fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
  r> IF  fnegate  THEN ;
@@ -2347,6 +2484,29 @@ faxpy(ra, f_x, nstridex, f_y, nstridey,
      fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap
  LOOP 2drop 2drop fdrop ;
 
+>float1	( c_addr u c -- f:... flag )	gforth	to_float1
+""Actual stack effect: ( c_addr u c -- r t | f ).  Attempt to convert the
+character string @i{c-addr u} to internal floating-point
+representation. If the string represents a valid floating-point number
+@i{r} is placed on the floating-point stack and @i{flag} is
+true. Otherwise, @i{flag} is false. A string of blanks is a special
+case and represents the floating-point number 0.""
+Float r;
+flag = to_float(c_addr, u, &r, c);
+if (flag) {
+  fp--;
+  fp[0]=r;
+}
+
+float/ ( n1 -- n2 )	gforth	float_divide
+n2 = n1 / sizeof(Float);
+
+dfloat/ ( n1 -- n2 )	gforth	sfloat_divide
+n2 = n1 / sizeof(DFloat);
+
+sfloat/ ( n1 -- n2 )	gforth	dfloat_divide
+n2 = n1 / sizeof(SFloat);
+
 \+
 
 \ The following words access machine/OS/installation-dependent
@@ -2437,18 +2597,20 @@ open-lib	( c_addr1 u1 -- u2 )	gforth	ope
 u2 = gforth_dlopen(c_addr1, u1);
 
 lib-sym	( c_addr1 u1 u2 -- u3 )	gforth	lib_sym
+char * string = cstr(c_addr1, u1);
 #ifdef HAVE_LIBLTDL
-u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1));
+u3 = (UCell) lt_dlsym((lt_dlhandle)u2, string);
 #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
-u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));
+u3 = (UCell) dlsym((void*)u2,string);
 #else
 #  ifdef _WIN32
-u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));
+u3 = (Cell) GetProcAddress((HMODULE)u2, string);
 #  else
 #warning Define lib-sym!
 u3 = 0;
 #  endif
 #endif
+free(string);
 
 wcall	( ... u -- ... )	gforth
 gforth_FP=fp;
@@ -2492,6 +2654,105 @@ c_addr = "libltdl is not configured";
 u = strlen(c_addr);
 #endif
 
+be-w! ( w c_addr -- )	gforth w_store_be
+""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[0] = w >> 8;
+c_addr[1] = w;
+
+be-l! ( w c_addr -- )	gforth l_store_be
+""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[0] = w >> 24;
+c_addr[1] = w >> 16;
+c_addr[2] = w >> 8;
+c_addr[3] = w;
+
+le-w! ( w c_addr -- )	gforth w_store_le
+""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[1] = w >> 8;
+c_addr[0] = w;
+
+le-l! ( w c_addr -- )	gforth l_store_le
+""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[3] = w >> 24;
+c_addr[2] = w >> 16;
+c_addr[1] = w >> 8;
+c_addr[0] = w;
+
+be-uw@ ( c_addr -- u )	gforth w_fetch_be
+""@i{u} is the zero-extended 16-bit big endian value stored at @i{c_addr}.""
+u = (c_addr[0] << 8) | (c_addr[1]);
+
+be-ul@ ( c_addr -- u )	gforth l_fetch_be
+""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}.""
+u = ((Cell)c_addr[0] << 24) | (c_addr[1] << 16) | (c_addr[2] << 8) | (c_addr[3]);
+
+le-uw@ ( c_addr -- u )	gforth w_fetch_le
+""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}.""
+u = (c_addr[1] << 8) | (c_addr[0]);
+
+le-ul@ ( c_addr -- u )	gforth l_fetch_le
+""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}.""
+u = ((Cell)c_addr[3] << 24) | (c_addr[2] << 16) | (c_addr[1] << 8) | (c_addr[0]);
+
+\+64bit
+
+x! ( w c_addr -- )	gforth x_store
+""Store the bottom 64 bits of @i{w} at 64-bit-aligned @i{c_addr}.""
+*(UOctabyte *)c_addr = w;
+
+ux@ ( c_addr -- u )	gforth u_x_fetch
+""@i{u} is the zero-extended 64-bit value stored at 64-bit-aligned @i{c_addr}.""
+u = *(UOctabyte *)c_addr;
+
+sx@ ( c_addr -- n )	gforth s_x_fetch
+""@i{u} is the sign-extended 64-bit value stored at 64-bit-aligned @i{c_addr}.""
+n = *(Octabyte *)c_addr;
+
+be-x! ( w c_addr -- )	gforth b_e_x_store
+""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[0] = w >> 56;
+c_addr[1] = w >> 48;
+c_addr[2] = w >> 40;
+c_addr[3] = w >> 32;
+c_addr[4] = w >> 24;
+c_addr[5] = w >> 16;
+c_addr[6] = w >> 8;
+c_addr[7] = w;
+
+le-x! ( w c_addr -- )	gforth l_e_x_store
+""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format.""
+c_addr[7] = w >> 56;
+c_addr[6] = w >> 48;
+c_addr[5] = w >> 40;
+c_addr[4] = w >> 32;
+c_addr[3] = w >> 24;
+c_addr[2] = w >> 16;
+c_addr[1] = w >> 8;
+c_addr[0] = w;
+
+be-ux@ ( c_addr -- u )	gforth b_e_u_x_fetch
+""@i{u} is the zero-extended 64-bit big endian value stored at @i{c_addr}.""
+u = (((Cell)(c_addr[0]) << 56) |
+     ((Cell)(c_addr[1]) << 48) |
+     ((Cell)(c_addr[2]) << 40) |
+     ((Cell)(c_addr[3]) << 32) |
+     ((Cell)(c_addr[4]) << 24) |
+     ((Cell)(c_addr[5]) << 16) |
+     ((Cell)(c_addr[6]) << 8) |
+     ((Cell)(c_addr[7])));
+
+le-ux@ ( c_addr -- u )	gforth l_e_u_x_fetch
+""@i{u} is the zero-extended 64-bit little endian value stored at @i{c_addr}.""
+u = (((Cell)(c_addr[7]) << 56) |
+     ((Cell)(c_addr[6]) << 48) |
+     ((Cell)(c_addr[5]) << 40) |
+     ((Cell)(c_addr[4]) << 32) |
+     ((Cell)(c_addr[3]) << 24) |
+     ((Cell)(c_addr[2]) << 16) |
+     ((Cell)(c_addr[1]) << 8) |
+     ((Cell)(c_addr[0])));
+
+\+
 \+
 \g peephole
 
@@ -2559,12 +2820,29 @@ Address body = (Address)PFA(a_cfa);
 sp = (*f)(sp, &fp_mem, body);
 fp = fp_mem;
 
-;code-exec ( #a_cfa -- ) gforth-internal semi_code_exec
-/* routine for performing ;code-defined words */
+lit-execute	( #a_addr -- )	new	lit_execute
+/* for ;code and code words; a static superinstruction would be more general, 
+   but VM_JUMP is currently not supported there */
+#ifndef NO_IP
+ip=IP;
+#endif
 SUPER_END;
-VM_JUMP(EXEC1(a_cfa));
+VM_JUMP(EXEC1((Xt)a_addr));
+
+\+objects
+\g object_pointer
 
+>o ( c_addr -- r:c_old )	new	to_o
+c_old = op;
+op = c_addr;
 
+o> ( r:c_addr -- )		new	o_restore
+op = c_addr;
+
+o#+ ( #w -- c_addr )		new	o_lit_plus
+c_addr = op + w;
+
+\+
 \g static_super
 
 ifdef(`STACK_CACHE_FILE',