--- gforth/prim	1997/06/06 17:27:57	1.2
+++ gforth/prim	1998/07/28 12:29:37	1.10
@@ -128,7 +128,7 @@ EXEC(*(Xt *)a_addr);
 :
  @ execute ;
 
-\+has-locals [IF]
+\+has? glocals [IF]
 
 branch-lp+!#	--	gforth	branch_lp_plus_store_number
 /* this will probably not be used */
@@ -157,7 +157,7 @@ else
     INC_IP(1);
 $4
 
-\+has-locals [IF]
+\+has? glocals [IF]
 
 $1-lp+!#	$2_lp_plus_store_number
 $3    goto branch_adjust_lp;
@@ -171,12 +171,17 @@ else
 condbranch(?branch,f --		f83	question_branch,
 if (f==0) {
     IF_TOS(TOS = sp[0]);
-,)
+,:
+ 0= dup     \ !f !f
+ r> dup @   \ !f !f IP branchoffset
+ rot and +  \ !f IP|IP+branchoffset
+ swap 0= cell and + \ IP''
+ >r ;)
 
 \ we don't need an lp_plus_store version of the ?dup-stuff, because it
 \ is only used in if's (yet)
 
-\+has-xconds [IF]
+\+has? xconds [IF]
 
 ?dup-?branch	f -- f	new	question_dupe_question_branch
 ""The run-time procedure compiled by @code{?DUP-IF}.""
@@ -245,7 +250,7 @@ if ((olddiff^(olddiff+n))>=0   /* the li
  IF    >r + >r dup @ + >r
  ELSE  >r >r drop cell+ >r THEN ;)
 
-\+has-xconds [IF]
+\+has? xconds [IF]
 
 condbranch((-loop),u --		gforth	paren_minus_loop,
 /* !! check this thoroughly */
@@ -320,7 +325,7 @@ else {
        cell+ >r
   THEN ;				\ --> CORE-EXT
 
-\+has-xconds [IF]
+\+has? xconds [IF]
 
 (+do)	nlimit nstart --	gforth	paren_plus_do
 *--rp = nlimit;
@@ -404,26 +409,36 @@ else {
 
 \+[THEN]
 
+\ don't make any assumptions where the return stack is!!
+\ implement this in machine code if it should run quickly!
+
 i	-- n		core
 n = *rp;
 :
- rp@ cell+ @ ;
+\ rp@ cell+ @ ;
+  r> r> tuck >r >r ;
 
 i'	-- w		gforth		i_tick
 ""loop end value""
 w = rp[1];
 :
- rp@ cell+ cell+ @ ;
+\ rp@ cell+ cell+ @ ;
+  r> r> r> dup itmp ! >r >r >r itmp @ ;
+variable itmp
 
 j	-- n		core
 n = rp[2];
 :
- rp@ cell+ cell+ cell+ @ ;
+\ rp@ cell+ cell+ cell+ @ ;
+  r> r> r> r> dup itmp ! >r >r >r >r itmp @ ;
+[IFUNDEF] itmp variable itmp [THEN]
 
 k	-- n		gforth
 n = rp[4];
 :
- rp@ [ 5 cells ] Literal + @ ;
+\ rp@ [ 5 cells ] Literal + @ ;
+  r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ;
+[IFUNDEF] itmp variable itmp [THEN]
 
 \ digit is high-level: 0/0%
 
@@ -508,7 +523,7 @@ else if (n>0)
 
 -trailing	c_addr u1 -- c_addr u2		string	dash_trailing
 u2 = u1;
- while (u2>0 && c_addr[u2-1] == ' ')
+while (u2>0 && c_addr[u2-1] == ' ')
   u2--;
 :
  BEGIN  1- 2dup + c@ bl =  WHILE
@@ -607,7 +622,7 @@ n2 = n1>>1;
 :
  dup MINI and IF 1 ELSE 0 THEN
  [ bits/byte cell * 1- ] literal 
- 0 DO 2* swap dup 2* >r U-HIGHBIT and 
+ 0 DO 2* swap dup 2* >r MINI and 
      IF 1 ELSE 0 THEN or r> swap
  LOOP nip ;
 
@@ -694,10 +709,10 @@ u2 = ud%u1;
 #endif
 :
    0 swap [ 8 cells 1 + ] literal 0
-   ?DO >r /modstep r> 
+   ?DO /modstep
    LOOP drop swap 1 rshift or swap ;
 : /modstep ( ud c R: u -- ud-?u c R: u )
-   over I' u< 0= or IF I' - 1 ELSE 0 THEN  d2*+ ;
+   >r over r@ u< 0= or IF r@ - 1 ELSE 0 THEN  d2*+ r> ;
 : d2*+ ( ud n -- ud+n c )
    over MINI
    and >r >r 2dup d+ swap r> + swap r> ;
@@ -890,7 +905,7 @@ f = FLAG($4>=$5);
 
 )
 
-\+has-dcomps [IF]
+\+has? dcomps [IF]
 
 dcomparisons(d, d1 d2, d_, d1, d2, double, gforth, double, gforth)
 dcomparisons(d0, d, d_zero_, d, DZERO, double, gforth, double, gforth)
@@ -916,7 +931,7 @@ a_addr = rp;
 rp!	a_addr --		gforth		rpstore
 rp = a_addr;
 
-\+has-floats [IF]
+\+has? floating [IF]
 
 fp@	-- f_addr	gforth	fp_fetch
 f_addr = fp;
@@ -1002,7 +1017,7 @@ Variable (rot)
 
 nip	w1 w2 -- w2		core-ext
 :
- >r drop r> ;
+ swap drop ;
 
 tuck	w1 w2 -- w2 w1 w2	core-ext
 :
@@ -1176,7 +1191,7 @@ f83name2=f83name1;
 : (find-samelen) ( u f83name1 -- u f83name2/0 )
     BEGIN  2dup cell+ c@ $1F and <> WHILE  @  dup 0= UNTIL  THEN ;
 
-\+has-hash [IF]
+\+has? hash [IF]
 
 (hashfind)	c_addr u a_addr -- f83name2	new	paren_hashfind
 F83Name *f83name1;
@@ -1312,7 +1327,7 @@ a_addr = (Cell *)DOES_CODE(xt);
 code-address!		c_addr xt --		gforth	code_address_store
 ""Creates a code field with code address c_addr at xt""
 MAKE_CF(xt, c_addr);
-CACHE_FLUSH(xt,PFA(0));
+CACHE_FLUSH(xt,(size_t)PFA(0));
 :
     ! ;
 
@@ -1320,7 +1335,7 @@ does-code!	a_addr xt --		gforth	does_cod
 ""creates a code field at xt for a defining-word-defined word; a_addr
 is the start of the Forth code after DOES>""
 MAKE_DOES_CF(xt, a_addr);
-CACHE_FLUSH(xt,PFA(0));
+CACHE_FLUSH(xt,(size_t)PFA(0));
 :
     dodoes: over ! cell+ ! ;
 
@@ -1328,7 +1343,7 @@ does-handler!	a_addr --	gforth	does_hand
 ""creates a DOES>-handler at address a_addr. a_addr usually points
 just behind a DOES>.""
 MAKE_DOES_HANDLER(a_addr);
-CACHE_FLUSH(a_addr,DOES_HANDLER_SIZE);
+CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE);
 :
     drop ;
 
@@ -1354,7 +1369,7 @@ n=1;
 :
  1 ;
 
-\+has-os [IF]
+\+has? os [IF]
 
 (key)	-- n		gforth	paren_key
 fflush(stdout);
@@ -1478,7 +1493,7 @@ fp=FP;
 IF_TOS(TOS=sp[0]);
 IF_FTOS(FTOS=fp[0]);
 
-\+[THEN] ( has-os ) has-files [IF]
+\+[THEN] ( has? os ) has? file [IF]
 
 close-file	wfileid -- wior		file	close_file
 wior = IOR(fclose((FILE *)wfileid)==EOF);
@@ -1559,7 +1574,7 @@ else {
   u2=0;
 }
 
-\+[THEN]  has-files [IF] -1 [ELSE] has-os [THEN] [IF]
+\+[THEN]  has? file [IF] -1 [ELSE] has? os [THEN] [IF]
 
 write-file	c_addr u1 wfileid -- wior	file	write_file
 /* !! fwrite does not guarantee enough */
@@ -1575,7 +1590,7 @@ wior = FILEIO(putc(c, (FILE *)wfileid)==
 if (wior)
   clearerr((FILE *)wfileid);
 
-\+[THEN]  has-files [IF]
+\+[THEN]  has? file [IF]
 
 flush-file	wfileid -- wior		file-ext	flush_file
 wior = IOR(fflush((FILE *) wfileid)==EOF);
@@ -1604,7 +1619,7 @@ else {
   wior=0;
 }
 
-\+[THEN] ( has-files ) has-floats [IF]
+\+[THEN] ( has? file ) has? floating [IF]
 
 comparisons(f, r1 r2, f_, r1, r2, gforth, gforth, float, gforth)
 comparisons(f0, r, f_zero_, r, 0., float, gforth, float, gforth)
@@ -1795,7 +1810,11 @@ r2 = exp(r1);
 fexpm1		r1 -- r2	float-ext
 ""@i{r2}=@i{e}**@i{r1}@minus{}1""
 #ifdef HAVE_EXPM1
-extern double expm1(double);
+extern double
+#ifdef NeXT
+              const
+#endif
+                    expm1(double);
 r2 = expm1(r1);
 #else
 r2 = exp(r1)-1.;
@@ -1807,7 +1826,11 @@ r2 = log(r1);
 flnp1		r1 -- r2	float-ext
 ""@i{r2}=ln(@i{r1}+1)""
 #ifdef HAVE_LOG1P
-extern double log1p(double);
+extern double
+#ifdef NeXT
+              const
+#endif
+                    log1p(double);
 r2 = log1p(r1);
 #else
 r2 = log(r1+1.);
@@ -1891,7 +1914,7 @@ df_addr = (DFloat *)((((Cell)c_addr)+(si
 \   INDIRECT-THREADED, TOS-CACHED, FTOS-CACHED, CODEFIELD-DOES */
 
 \ local variable implementation primitives
-\+[THEN] ( has-floats ) has-locals [IF]
+\+[THEN] ( has? floats ) has? glocals [IF]
 
 @local#		-- w	gforth	fetch_local_number
 w = *(Cell *)(lp+(Cell)NEXT_INST);
@@ -1909,7 +1932,7 @@ w = *(Cell *)(lp+2*sizeof(Cell));
 @local3	-- w	new	fetch_local_twelve
 w = *(Cell *)(lp+3*sizeof(Cell));
 
-\+has-floats [IF]
+\+has? floating [IF]
 
 f@local#	-- r	gforth	f_fetch_local_number
 r = *(Float *)(lp+(Cell)NEXT_INST);
@@ -1951,15 +1974,15 @@ lp = (Address)c_addr;
 lp -= sizeof(Cell);
 *(Cell *)lp = w;
 
-\+has-floats [IF]
+\+has? floating [IF]
 
 f>l	r --	gforth	f_to_l
 lp -= sizeof(Float);
 *(Float *)lp = r;
 
-\+[THEN]  [THEN] \ has-locals
+\+[THEN]  [THEN] \ has? glocals
 
-\+has-OS [IF]
+\+has? OS [IF]
 
 define(`uploop',
        `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')')
@@ -1981,19 +2004,22 @@ define(argclist,
 \ icall(argnum)
 define(icall,
 `icall$1	argflist($1)u -- uret	gforth
-uret = ((Cell(*)(argdlist($1)))u)(argclist($1));
+uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1));
 
 ')
 define(fcall,
 `fcall$1	argflist($1)u -- rret	gforth
-rret = ((Float(*)(argdlist($1)))u)(argclist($1));
+rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1));
 
 ')
 
 
 open-lib	c_addr1 u1 -- u2	gforth	open_lib
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
-u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_LAZY);
+#ifndef RTLD_GLOBAL
+#define RTLD_GLOBAL 0
+#endif
+u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY);
 #else
 #  ifdef HAVE_LIBKERNEL32
 u2 = (Cell) GetModuleHandle(cstr(c_addr1, u1, 1));
@@ -2020,7 +2046,7 @@ icall(20)
 uploop(i, 0, 7, `fcall(i)')
 fcall(20)
 
-\+[THEN] \ has-OS
+\+[THEN] \ has? OS
 
 up!	a_addr --	gforth	up_store
 UP=up=(char *)a_addr;