--- gforth/prim	2005/09/27 13:50:43	1.177
+++ gforth/prim	2006/02/19 17:27:12	1.189
@@ -1,6 +1,6 @@
 \ Gforth primitives
 
-\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -719,6 +719,15 @@ c2 = toupper(c1);
 :
  dup [char] a - [ char z char a - 1 + ] Literal u<  bl and - ;
 
+capscompare	( c_addr1 u1 c_addr2 u2 -- n )	string
+""Compare two strings lexicographically. If they are equal, @i{n} is 0; if
+the first string is smaller, @i{n} is -1; if the first string is larger, @i{n}
+is 1. Currently this is based on the machine's character
+comparison. In the future, this may change to consider the current
+locale and its collation order.""
+/* close ' to keep fontify happy */ 
+n = capscompare(c_addr1, u1, c_addr2, u2);
+
 /string	( c_addr1 u1 n -- c_addr2 u2 )	string	slash_string
 ""Adjust the string specified by @i{c-addr1, u1} to remove @i{n}
 characters from the start of the string.""
@@ -873,7 +882,7 @@ division by 2 (note that @code{/} not ne
 n2 = n1>>1;
 :
  dup MINI and IF 1 ELSE 0 THEN
- [ bits/byte cell * 1- ] literal 
+ [ bits/char cell * 1- ] literal 
  0 DO 2* swap dup 2* >r MINI and 
      IF 1 ELSE 0 THEN or r> swap
  LOOP nip ;
@@ -1229,7 +1238,7 @@ useraddr	( #u -- a_addr )	new
 a_addr = (Cell *)(up+u);
 
 up!	( a_addr -- )	gforth	up_store
-UP=up=(char *)a_addr;
+gforth_UP=up=(char *)a_addr;
 :
  up ! ;
 Variable UP
@@ -1672,6 +1681,10 @@ with the window size.""
 urows=rows;
 ucols=cols;
 
+wcwidth	( u -- n )	gforth
+""The number of fixed-width characters per unicode character u""
+n = wcwidth(u);
+
 flush-icache	( c_addr u -- )	gforth	flush_icache
 ""Make sure that the instruction cache of the processor (if there is
 one) does not contain stale data at @i{c-addr} and @i{u} bytes
@@ -1788,11 +1801,11 @@ access the stack itself. The stack point
 variables @code{SP} and @code{FP}.""
 /* This is a first attempt at support for calls to C. This may change in
    the future */
-FP=fp;
-SP=sp;
+gforth_FP=fp;
+gforth_SP=sp;
 ((void (*)())w)();
-sp=SP;
-fp=FP;
+sp=gforth_SP;
+fp=gforth_FP;
 
 \+
 \+file
@@ -2440,9 +2453,33 @@ u3 = 0;
 #endif
 
 wcall	( ... u -- ... )	gforth
-FP=fp;
-sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);
-fp=FP;
+gforth_FP=fp;
+sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &gforth_FP);
+fp=gforth_FP;
+
+uw@ ( c_addr -- u )	gforth u_w_fetch
+""@i{u} is the zero-extended 16-bit value stored at @i{c_addr}.""
+u = *(UWyde*)(c_addr);
+
+sw@ ( c_addr -- n )	gforth s_w_fetch
+""@i{n} is the sign-extended 16-bit value stored at @i{c_addr}.""
+n = *(Wyde*)(c_addr);
+
+w! ( w c_addr -- )	gforth w_store
+""Store the bottom 16 bits of @i{w} at @i{c_addr}.""
+*(Wyde*)(c_addr) = w;
+
+ul@ ( c_addr -- u )	gforth u_l_fetch
+""@i{u} is the zero-extended 32-bit value stored at @i{c_addr}.""
+u = *(UTetrabyte*)(c_addr);
+
+sl@ ( c_addr -- n )	gforth s_l_fetch
+""@i{n} is the sign-extended 32-bit value stored at @i{c_addr}.""
+n = *(Tetrabyte*)(c_addr);
+
+l! ( w c_addr -- )	gforth l_store
+""Store the bottom 32 bits of @i{w} at @i{c_addr}.""
+*(Tetrabyte*)(c_addr) = w;
 
 \+FFCALL
 
@@ -2547,7 +2584,7 @@ REST_REGS
 c_addr = prv;
 
 alloc-callback	( a_ip -- c_addr )	gforth	alloc_callback
-c_addr = (char *)alloc_callback(engine_callback, (Xt *)a_ip);
+c_addr = (char *)alloc_callback(gforth_callback, (Xt *)a_ip);
 
 va-start-void	( -- )	gforth	va_start_void
 va_start_void(clist);
@@ -2639,17 +2676,19 @@ ffi-prep-cif ( a_atypes n a_rtype a_cif
 w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes);
 
 ffi-call ( a_avalues a_rvalue a_ip a_cif -- )	gforth ffi_call
+SAVE_REGS
 ffi_call(a_cif, a_ip, a_rvalue, a_avalues);
+REST_REGS
 
 ffi-prep-closure ( a_ip a_cif a_closure -- w )	gforth ffi_prep_closure
-w = ffi_prep_closure(a_closure, a_cif, ffi_callback, a_ip);
+w = ffi_prep_closure(a_closure, a_cif, gforth_callback, a_ip);
 
 ffi-2@ ( a_addr -- d )	gforth ffi_2fetch
 #ifdef BUGGY_LONG_LONG
 DLO_IS(d, (Cell*)(*a_addr));
 DHI_IS(d, 0);
 #else
-d = *(DCell*)(*a_addr);
+d = *(DCell*)(a_addr);
 #endif
 
 ffi-2! ( d a_addr -- )	gforth ffi_2store
@@ -2660,7 +2699,7 @@ ffi-2! ( d a_addr -- )	gforth ffi_2store
 #endif
 
 ffi-arg-int ( -- w )	gforth ffi_arg_int
-w = *(Cell*)(*clist++);
+w = *(int *)(*clist++);
 
 ffi-arg-longlong ( -- d )	gforth ffi_arg_longlong
 #ifdef BUGGY_LONG_LONG
@@ -2679,24 +2718,32 @@ r = *(float*)(*clist++);
 ffi-arg-double ( -- r )	gforth ffi_arg_double
 r = *(double*)(*clist++);
 
-ffi-ret-int ( -- w )	gforth ffi_ret_int
+ffi-ret-void ( -- )	gforth ffi_ret_void
+return 0;
+
+ffi-ret-int ( w -- )	gforth ffi_ret_int
 *(int*)(ritem) = w;
+return 0;
 
-ffi-ret-longlong ( -- d )	gforth ffi_ret_longlong
+ffi-ret-longlong ( d -- )	gforth ffi_ret_longlong
 #ifdef BUGGY_LONG_LONG
 *(Cell*)(ritem) = DLO(d);
 #else
 *(DCell*)(ritem) = d;
 #endif
+return 0;
 
-ffi-ret-ptr ( -- c_addr )	gforth ffi_ret_ptr
+ffi-ret-ptr ( c_addr -- )	gforth ffi_ret_ptr
 *(char **)(ritem) = c_addr;
+return 0;
 
-ffi-ret-float ( -- r )	gforth ffi_ret_float
+ffi-ret-float ( r -- )	gforth ffi_ret_float
 *(float*)(ritem) = r;
+return 0;
 
-ffi-ret-double ( -- r )	gforth ffi_ret_double
+ffi-ret-double ( r -- )	gforth ffi_ret_double
 *(double*)(ritem) = r;
+return 0;
 
 \+