--- gforth/prim	2003/08/16 19:46:11	1.135
+++ gforth/prim	2003/08/18 19:29:14	1.138
@@ -793,11 +793,10 @@ ud = ummul(u1,u2);
 ud = (UDCell)u1 * (UDCell)u2;
 #endif
 :
-   >r >r 0 0 r> r> [ 8 cells ] literal 0
+   0 -rot dup [ 8 cells ] literal -
    DO
-       over >r dup >r 0< and d2*+ drop
-       r> 2* r> swap
-   LOOP 2drop ;
+	dup 0< I' and d2*+ drop
+   LOOP ;
 : d2*+ ( ud n -- ud+n c )
    over MINI
    and >r >r 2dup d+ swap r> + swap r> ;
@@ -1084,19 +1083,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 ;
 
@@ -1316,6 +1315,33 @@ c_addr2 = c_addr1+1;
 
 \g compiler
 
+\+f83headerstring
+
+(f83find)	( c_addr u f83name1 -- f83name2 )	new	paren_f83find
+for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))
+  if ((UCell)F83NAME_COUNT(f83name1)==u &&
+      memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
+    break;
+f83name2=f83name1;
+:
+    BEGIN  dup WHILE  (find-samelen)  dup  WHILE
+	>r 2dup r@ cell+ char+ capscomp  0=
+	IF  2drop r>  EXIT  THEN
+	r> @
+    REPEAT  THEN  nip nip ;
+: (find-samelen) ( u f83name1 -- u f83name2/0 )
+    BEGIN  2dup cell+ c@ $1F and <> WHILE  @  dup 0= UNTIL  THEN ;
+: capscomp ( c_addr1 u c_addr2 -- n )
+ swap bounds
+ ?DO  dup c@ I c@ <>
+     IF  dup c@ toupper I c@ toupper =
+     ELSE  true  THEN  WHILE  1+  LOOP  drop 0
+ ELSE  c@ toupper I c@ toupper - unloop  THEN  sgn ;
+: sgn ( n -- -1/0/1 )
+ dup 0= IF EXIT THEN  0< 2* 1+ ;
+
+\-
+
 (listlfind)	( c_addr u longname1 -- longname2 )	new	paren_listlfind
 longname2=listlfind(c_addr, u, longname1);
 :
@@ -1349,6 +1375,12 @@ longname2 = tablelfind(c_addr, u, a_addr
 	    IF  2drop r> rdrop  EXIT  THEN  THEN
 	rdrop r>
  REPEAT nip nip ;
+: -text ( c_addr1 u c_addr2 -- n )
+ swap bounds
+ ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
+ ELSE  c@ I c@ - unloop  THEN  sgn ;
+: sgn ( n -- -1/0/1 )
+ dup 0= IF EXIT THEN  0< 2* 1+ ;
 
 (hashkey1)	( c_addr u ubits -- ukey )		gforth	paren_hashkey1
 ""ukey is the hash key for the string c_addr u fitting in ubits bits""
@@ -1368,6 +1400,8 @@ Create rot-values
 
 \+
 
+\+
+
 (parse-white)	( c_addr1 u1 -- c_addr2 u2 )	gforth	paren_parse_white
 struct Cellpair r=parse_white(c_addr1, u1);
 c_addr2 = (Char *)(r.n1);
@@ -2191,69 +2225,88 @@ u3 = 0;
 
 \+FFCALL
 
-av-start-void   ( c_addr -- )    gforth  av_start_void
+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	( 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	( 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	( 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	( 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	( 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	( r -- )	gforth  av_float
 av_float(alist, r);
 
-av-double        ( r -- )        gforth  av_double
+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        ( d -- )        gforth  av_longlong
+av-longlong-r	( R:d -- )	gforth  av_longlong_r
 av_longlong(alist, d);
 
-av-ptr        ( c_addr -- )        gforth  av_ptr
+av-ptr-r	( R:c_addr -- )	gforth  av_ptr_r
 av_ptr(alist, void*, c_addr);
 
-av-call-void    ( -- )          gforth  av_call_void
+av-call-void	( -- )	gforth  av_call_void
 SAVE_REGS
 av_call(alist);
 REST_REGS
 
-av-call-int    ( -- w )        gforth  av_call_int
+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
+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
+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
+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
+av-call-ptr	( -- c_addr )	gforth  av_call_ptr
 SAVE_REGS
 av_call(alist);
 REST_REGS