--- gforth/prim	2003/08/17 12:21:05	1.136
+++ 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> ;
@@ -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);