Diff for /gforth/prim between versions 1.184 and 1.188

version 1.184, 2005/12/31 15:46:10 version 1.188, 2006/02/04 22:09:11
Line 719  c2 = toupper(c1); Line 719  c2 = toupper(c1);
 :  :
  dup [char] a - [ char z char a - 1 + ] Literal u<  bl and - ;   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  /string ( c_addr1 u1 n -- c_addr2 u2 )  string  slash_string
 ""Adjust the string specified by @i{c-addr1, u1} to remove @i{n}  ""Adjust the string specified by @i{c-addr1, u1} to remove @i{n}
 characters from the start of the string.""  characters from the start of the string.""
Line 873  division by 2 (note that @code{/} not ne Line 882  division by 2 (note that @code{/} not ne
 n2 = n1>>1;  n2 = n1>>1;
 :  :
  dup MINI and IF 1 ELSE 0 THEN   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    0 DO 2* swap dup 2* >r MINI and 
      IF 1 ELSE 0 THEN or r> swap       IF 1 ELSE 0 THEN or r> swap
  LOOP nip ;   LOOP nip ;
Line 1229  useraddr ( #u -- a_addr ) new Line 1238  useraddr ( #u -- a_addr ) new
 a_addr = (Cell *)(up+u);  a_addr = (Cell *)(up+u);
   
 up!     ( a_addr -- )   gforth  up_store  up!     ( a_addr -- )   gforth  up_store
 UP=up=(char *)a_addr;  gforth_UP=up=(char *)a_addr;
 :  :
  up ! ;   up ! ;
 Variable UP  Variable UP
Line 1788  access the stack itself. The stack point Line 1797  access the stack itself. The stack point
 variables @code{SP} and @code{FP}.""  variables @code{SP} and @code{FP}.""
 /* This is a first attempt at support for calls to C. This may change in  /* This is a first attempt at support for calls to C. This may change in
    the future */     the future */
 FP=fp;  gforth_FP=fp;
 SP=sp;  gforth_SP=sp;
 ((void (*)())w)();  ((void (*)())w)();
 sp=SP;  sp=gforth_SP;
 fp=FP;  fp=gforth_FP;
   
 \+  \+
 \+file  \+file
Line 2440  u3 = 0; Line 2449  u3 = 0;
 #endif  #endif
   
 wcall   ( ... u -- ... )        gforth  wcall   ( ... u -- ... )        gforth
 FP=fp;  gforth_FP=fp;
 sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);  sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &gforth_FP);
 fp=FP;  fp=gforth_FP;
   
 w@ ( a_addr -- u )      gforth wfetch  uw@ ( c_addr -- u )     gforth u_w_fetch
 u = *(UWyde*)(a_addr);  ""@i{u} is the zero-extended 16-bit value stored at @i{c_addr}.""
   u = *(UWyde*)(c_addr);
 sw@ ( a_addr -- u )     gforth swfetch  
 u = *(Wyde*)(a_addr);  sw@ ( c_addr -- n )     gforth s_w_fetch
   ""@i{n} is the sign-extended 16-bit value stored at @i{c_addr}.""
 w! ( u a_addr -- )      gforth wstore  n = *(Wyde*)(c_addr);
 *(Wyde*)(a_addr) = u;  
   w! ( w c_addr -- )      gforth w_store
 l@ ( a_addr -- u )      gforth lfetch  ""Store the bottom 16 bits of @i{w} at @i{c_addr}.""
 u = *(UTetrabyte*)(a_addr);  *(Wyde*)(c_addr) = w;
   
 sl@ ( a_addr -- u )     gforth slfetch  ul@ ( c_addr -- u )     gforth u_l_fetch
 u = *(Tetrabyte*)(a_addr);  ""@i{u} is the zero-extended 32-bit value stored at @i{c_addr}.""
   u = *(UTetrabyte*)(c_addr);
 l! ( u a_addr -- )      gforth lstore  
 *(Tetrabyte*)(a_addr) = u;  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  \+FFCALL
   
Line 2565  REST_REGS Line 2580  REST_REGS
 c_addr = prv;  c_addr = prv;
   
 alloc-callback  ( a_ip -- c_addr )      gforth  alloc_callback  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   ( -- )  gforth  va_start_void
 va_start_void(clist);  va_start_void(clist);
Line 2662  ffi_call(a_cif, a_ip, a_rvalue, a_avalue Line 2677  ffi_call(a_cif, a_ip, a_rvalue, a_avalue
 REST_REGS  REST_REGS
   
 ffi-prep-closure ( a_ip a_cif a_closure -- w )  gforth ffi_prep_closure  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  ffi-2@ ( a_addr -- d )  gforth ffi_2fetch
 #ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG

Removed from v.1.184  
changed lines
  Added in v.1.188


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>