Diff for /gforth/prim between versions 1.260 and 1.274

version 1.260, 2011/11/21 19:05:01 version 1.274, 2012/07/23 13:27:47
Line 1 Line 1
 \ Gforth primitives  \ Gforth primitives
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010,2011 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 1103  lshift ( u1 n -- u2 )  core l_shift Line 1103  lshift ( u1 n -- u2 )  core l_shift
 :  :
     0 ?DO 2* LOOP ;      0 ?DO 2* LOOP ;
   
   umax    ( u1 u2 -- u )  core
   if (u1<u2)
     u = u2;
   else
     u = u1;
   :
    2dup u< IF swap THEN drop ;
   
   umin    ( u1 u2 -- u )  core
   if (u1<u2)
     u = u1;
   else
     u = u2;
   :
    2dup u> IF swap THEN drop ;
   
 \g compare  \g compare
   
 \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)  \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)
Line 1718  cache."" Line 1734  cache.""
 FLUSH_ICACHE((caddr_t)c_addr,u);  FLUSH_ICACHE((caddr_t)c_addr,u);
   
 (bye)   ( n -- )        gforth  paren_bye  (bye)   ( n -- )        gforth  paren_bye
   gforth_FP=fp;
   gforth_SP=sp;
   gforth_RP=rp;
   gforth_LP=lp;
 SUPER_END;  SUPER_END;
 return (Label *)n;  return (Label *)n;
   
Line 1731  is the host operating system's expansion Line 1751  is the host operating system's expansion
 environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters  environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
 in length.""  in length.""
 /* close ' to keep fontify happy */  /* close ' to keep fontify happy */
 c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1));  char * string = cstr(c_addr1,u1);
   c_addr2 = (Char *)getenv(string);
 u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2));  u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2));
   free(string);
   
 open-pipe       ( c_addr u wfam -- wfileid wior )       gforth  open_pipe  open-pipe       ( c_addr u wfam -- wfileid wior )       gforth  open_pipe
   char * string = cstr(c_addr,u);
 fflush(stdout);  fflush(stdout);
 wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */  wfileid=(Cell)popen(string,pfileattr[wfam]); /* ~ expansion of 1st arg? */
 wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */  wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */
   free(string);
   
 close-pipe      ( wfileid -- wretval wior )             gforth  close_pipe  close-pipe      ( wfileid -- wretval wior )             gforth  close_pipe
 wretval = pclose((FILE *)wfileid);  wretval = pclose((FILE *)wfileid);
Line 1829  gforth_LP=lp; Line 1853  gforth_LP=lp;
 #ifdef HAS_LINKBACK  #ifdef HAS_LINKBACK
 ((void (*)())w)();  ((void (*)())w)();
 #else  #else
 ((void (*)(void *))w)(gforth_pointers);  ((void (*)(void *))w)(&gforth_pointers);
 #endif  #endif
 sp=gforth_SP;  sp=gforth_SP;
 fp=gforth_FP;  fp=gforth_FP;
Line 1844  close-file ( wfileid -- wior )  file clo Line 1868  close-file ( wfileid -- wior )  file clo
 wior = IOR(fclose((FILE *)wfileid)==EOF);  wior = IOR(fclose((FILE *)wfileid)==EOF);
   
 open-file       ( c_addr u wfam -- wfileid wior )       file    open_file  open-file       ( c_addr u wfam -- wfileid wior )       file    open_file
 wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, 0, &wior);  char * string = tilde_cstr(c_addr,u);
   wfileid = opencreate_file(string, wfam, 0, &wior);
   free(string);
   
 create-file     ( c_addr u wfam -- wfileid wior )       file    create_file  create-file     ( c_addr u wfam -- wfileid wior )       file    create_file
 wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, O_CREAT|O_TRUNC, &wior);  char * string = tilde_cstr(c_addr,u);
   wfileid = opencreate_file(string, wfam, O_CREAT|O_TRUNC, &wior);
   free(string);
   
 delete-file     ( c_addr u -- wior )            file    delete_file  delete-file     ( c_addr u -- wior )            file    delete_file
 wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1);  char * string = tilde_cstr(c_addr,u);
   wior = IOR(unlink(string)==-1);
   free(string);
   
 rename-file     ( c_addr1 u1 c_addr2 u2 -- wior )       file-ext        rename_file  rename-file     ( c_addr1 u1 c_addr2 u2 -- wior )       file-ext        rename_file
 ""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}""  ""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}""
Line 1929  flag = FLAG(feof((FILE *) wfileid)); Line 1959  flag = FLAG(feof((FILE *) wfileid));
 open-dir        ( c_addr u -- wdirid wior )     gforth  open_dir  open-dir        ( c_addr u -- wdirid wior )     gforth  open_dir
 ""Open the directory specified by @i{c-addr, u}  ""Open the directory specified by @i{c-addr, u}
 and return @i{dir-id} for futher access to it.""  and return @i{dir-id} for futher access to it.""
 wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));  char * string = tilde_cstr(c_addr,u);
   wdirid = (Cell)opendir(string);
 wior =  IOR(wdirid == 0);  wior =  IOR(wdirid == 0);
   free(string);
   
 read-dir        ( c_addr u1 wdirid -- u2 flag wior )    gforth  read_dir  read-dir        ( c_addr u1 wdirid -- u2 flag wior )    gforth  read_dir
 ""Attempt to read the next entry from the directory specified  ""Attempt to read the next entry from the directory specified
Line 1965  close-dir ( wdirid -- wior ) gforth clos Line 1997  close-dir ( wdirid -- wior ) gforth clos
 wior = IOR(closedir((DIR *)wdirid));  wior = IOR(closedir((DIR *)wdirid));
   
 filename-match  ( c_addr1 u1 c_addr2 u2 -- flag )       gforth  match_file  filename-match  ( c_addr1 u1 c_addr2 u2 -- flag )       gforth  match_file
 char * string = cstr(c_addr1, u1, 1);  char * string = cstr(c_addr1, u1);
 char * pattern = cstr(c_addr2, u2, 0);  char * pattern = cstr(c_addr2, u2);
 flag = FLAG(!fnmatch(pattern, string, 0));  flag = FLAG(!fnmatch(pattern, string, 0));
   free(string);
   free(pattern);
   
 set-dir ( c_addr u -- wior )    gforth set_dir  set-dir ( c_addr u -- wior )    gforth set_dir
 ""Change the current directory to @i{c-addr, u}.  ""Change the current directory to @i{c-addr, u}.
 Return an error if this is not possible""  Return an error if this is not possible""
 wior = IOR(chdir(tilde_cstr(c_addr, u, 1)));  char * string = tilde_cstr(c_addr, u);
   wior = IOR(chdir(string));
   free(string);
   
 get-dir ( c_addr1 u1 -- c_addr2 u2 )    gforth get_dir  get-dir ( c_addr1 u1 -- c_addr2 u2 )    gforth get_dir
 ""Store the current directory in the buffer specified by @i{c-addr1, u1}.  ""Store the current directory in the buffer specified by @i{c-addr1, u1}.
Line 1986  if(c_addr2 != NULL) { Line 2022  if(c_addr2 != NULL) {
   
 =mkdir ( c_addr u wmode -- wior )        gforth equals_mkdir  =mkdir ( c_addr u wmode -- wior )        gforth equals_mkdir
 ""Create directory @i{c-addr u} with mode @i{wmode}.""  ""Create directory @i{c-addr u} with mode @i{wmode}.""
 wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode));  char * string = tilde_cstr(c_addr,u);
   wior = IOR(mkdir(string,wmode));
   free(string);
   
 \+  \+
   
 newline ( -- c_addr u ) gforth  newline ( -- c_addr u ) gforth
 ""String containing the newline sequence of the host OS""  ""String containing the newline sequence of the host OS""
 char newline[] = {  static const char newline[] = {
 #if DIRSEP=='/'  #if DIRSEP=='/'
 /* Unix */  /* Unix */
 '\n'  '\n'
Line 2036  dsystem = DZERO; Line 2074  dsystem = DZERO;
 ntime   ( -- dtime )    gforth  ntime   ( -- dtime )    gforth
 ""Report the current time in nanoseconds since some epoch.""  ""Report the current time in nanoseconds since some epoch.""
 struct timespec time1;  struct timespec time1;
   #ifdef HAVE_CLOCK_GETTIME
 clock_gettime(CLOCK_REALTIME,&time1);  clock_gettime(CLOCK_REALTIME,&time1);
   #else
   struct timeval time2;
   gettimeofday(&time2,NULL);
   time1.tv_sec = time2.tv_sec;1
   time1.tv_nsec = time2.tv_usec*1000;
   #endif
 dtime = timespec2ns(&time1);  dtime = timespec2ns(&time1);
   
 \+  \+
Line 2130  r3 = r1/r2; Line 2175  r3 = r1/r2;
   
 f**     ( r1 r2 -- r3 ) float-ext       f_star_star  f**     ( r1 r2 -- r3 ) float-ext       f_star_star
 ""@i{r3} is @i{r1} raised to the @i{r2}th power.""  ""@i{r3} is @i{r1} raised to the @i{r2}th power.""
   CLOBBER_TOS_WORKAROUND_START;
 r3 = pow(r1,r2);  r3 = pow(r1,r2);
   CLOBBER_TOS_WORKAROUND_END;
   
 fm*     ( r1 n -- r2 )  gforth  fm_star  fm*     ( r1 n -- r2 )  gforth  fm_star
 r2 = r1*n;  r2 = r1*n;
Line 2172  n2 = n1*sizeof(Float); Line 2219  n2 = n1*sizeof(Float);
 floor   ( r1 -- r2 )    float  floor   ( r1 -- r2 )    float
 ""Round towards the next smaller integral value, i.e., round toward negative infinity.""  ""Round towards the next smaller integral value, i.e., round toward negative infinity.""
 /* !! unclear wording */  /* !! unclear wording */
   CLOBBER_TOS_WORKAROUND_START;
 r2 = floor(r1);  r2 = floor(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fround  ( r1 -- r2 )    float   f_round  fround  ( r1 -- r2 )    float   f_round
 ""Round to the nearest integral value.""  ""Round to the nearest integral value.""
Line 2217  representation. If the string represents Line 2266  representation. If the string represents
 true. Otherwise, @i{flag} is false. A string of blanks is a special  true. Otherwise, @i{flag} is false. A string of blanks is a special
 case and represents the floating-point number 0.""  case and represents the floating-point number 0.""
 Float r;  Float r;
 flag = to_float(c_addr, u, &r);  flag = to_float(c_addr, u, &r, '.');
 if (flag) {  if (flag) {
   fp--;    fp--;
   fp[0]=r;    fp[0]=r;
Line 2227  fabs ( r1 -- r2 ) float-ext f_abs Line 2276  fabs ( r1 -- r2 ) float-ext f_abs
 r2 = fabs(r1);  r2 = fabs(r1);
   
 facos   ( r1 -- r2 )    float-ext       f_a_cos  facos   ( r1 -- r2 )    float-ext       f_a_cos
   CLOBBER_TOS_WORKAROUND_START;
 r2 = acos(r1);  r2 = acos(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fasin   ( r1 -- r2 )    float-ext       f_a_sine  fasin   ( r1 -- r2 )    float-ext       f_a_sine
   CLOBBER_TOS_WORKAROUND_START;
 r2 = asin(r1);  r2 = asin(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fatan   ( r1 -- r2 )    float-ext       f_a_tan  fatan   ( r1 -- r2 )    float-ext       f_a_tan
 r2 = atan(r1);  r2 = atan(r1);
Line 2238  r2 = atan(r1); Line 2291  r2 = atan(r1);
 fatan2  ( r1 r2 -- r3 ) float-ext       f_a_tan_two  fatan2  ( r1 r2 -- r3 ) float-ext       f_a_tan_two
 ""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably  ""@i{r1/r2}=tan(@i{r3}). ANS Forth does not require, but probably
 intends this to be the inverse of @code{fsincos}. In gforth it is.""  intends this to be the inverse of @code{fsincos}. In gforth it is.""
   CLOBBER_TOS_WORKAROUND_START;
 r3 = atan2(r1,r2);  r3 = atan2(r1,r2);
   CLOBBER_TOS_WORKAROUND_END;
   
 fcos    ( r1 -- r2 )    float-ext       f_cos  fcos    ( r1 -- r2 )    float-ext       f_cos
   CLOBBER_TOS_WORKAROUND_START;
 r2 = cos(r1);  r2 = cos(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fexp    ( r1 -- r2 )    float-ext       f_e_x_p  fexp    ( r1 -- r2 )    float-ext       f_e_x_p
   CLOBBER_TOS_WORKAROUND_START;
 r2 = exp(r1);  r2 = exp(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fexpm1  ( r1 -- r2 )    float-ext       f_e_x_p_m_one  fexpm1  ( r1 -- r2 )    float-ext       f_e_x_p_m_one
 ""@i{r2}=@i{e}**@i{r1}@minus{}1""  ""@i{r2}=@i{e}**@i{r1}@minus{}1""
Line 2254  extern double Line 2313  extern double
               const                const
 #endif  #endif
                     expm1(double);                      expm1(double);
   CLOBBER_TOS_WORKAROUND_START;
 r2 = expm1(r1);  r2 = expm1(r1);
   CLOBBER_TOS_WORKAROUND_END;
 #else  #else
   CLOBBER_TOS_WORKAROUND_START;
 r2 = exp(r1)-1.;  r2 = exp(r1)-1.;
   CLOBBER_TOS_WORKAROUND_END;
 #endif  #endif
   
 fln     ( r1 -- r2 )    float-ext       f_l_n  fln     ( r1 -- r2 )    float-ext       f_l_n
   CLOBBER_TOS_WORKAROUND_START;
 r2 = log(r1);  r2 = log(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 flnp1   ( r1 -- r2 )    float-ext       f_l_n_p_one  flnp1   ( r1 -- r2 )    float-ext       f_l_n_p_one
 ""@i{r2}=ln(@i{r1}+1)""  ""@i{r2}=ln(@i{r1}+1)""
   CLOBBER_TOS_WORKAROUND_START;
 #ifdef HAVE_LOG1P  #ifdef HAVE_LOG1P
 extern double  extern double
 #ifdef NeXT  #ifdef NeXT
Line 2274  r2 = log1p(r1); Line 2340  r2 = log1p(r1);
 #else  #else
 r2 = log(r1+1.);  r2 = log(r1+1.);
 #endif  #endif
   CLOBBER_TOS_WORKAROUND_END;
   
 flog    ( r1 -- r2 )    float-ext       f_log  flog    ( r1 -- r2 )    float-ext       f_log
 ""The decimal logarithm.""  ""The decimal logarithm.""
   CLOBBER_TOS_WORKAROUND_START;
 r2 = log10(r1);  r2 = log10(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 falog   ( r1 -- r2 )    float-ext       f_a_log  falog   ( r1 -- r2 )    float-ext       f_a_log
 ""@i{r2}=10**@i{r1}""  ""@i{r2}=10**@i{r1}""
 extern double pow10(double);  extern double pow10(double);
   CLOBBER_TOS_WORKAROUND_START;
 r2 = pow10(r1);  r2 = pow10(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fsin    ( r1 -- r2 )    float-ext       f_sine  fsin    ( r1 -- r2 )    float-ext       f_sine
   CLOBBER_TOS_WORKAROUND_START;
 r2 = sin(r1);  r2 = sin(r1);
   CLOBBER_TOS_WORKAROUND_END;
   
 fsincos ( r1 -- r2 r3 ) float-ext       f_sine_cos  fsincos ( r1 -- r2 r3 ) float-ext       f_sine_cos
 ""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""  ""@i{r2}=sin(@i{r1}), @i{r3}=cos(@i{r1})""
 r2 = sin(r1);  CLOBBER_TOS_WORKAROUND_START;
 r3 = cos(r1);  sincos(r1, &r2, &r3);
   CLOBBER_TOS_WORKAROUND_END;
   
 fsqrt   ( r1 -- r2 )    float-ext       f_square_root  fsqrt   ( r1 -- r2 )    float-ext       f_square_root
 r2 = sqrt(r1);  r2 = sqrt(r1);
   
 ftan    ( r1 -- r2 )    float-ext       f_tan  ftan    ( r1 -- r2 )    float-ext       f_tan
   CLOBBER_TOS_WORKAROUND_START;
 r2 = tan(r1);  r2 = tan(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fsincos f/ ;   fsincos f/ ;
   
 fsinh   ( r1 -- r2 )    float-ext       f_cinch  fsinh   ( r1 -- r2 )    float-ext       f_cinch
   CLOBBER_TOS_WORKAROUND_START;
 r2 = sinh(r1);  r2 = sinh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;   fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
   
 fcosh   ( r1 -- r2 )    float-ext       f_cosh  fcosh   ( r1 -- r2 )    float-ext       f_cosh
   CLOBBER_TOS_WORKAROUND_START;
 r2 = cosh(r1);  r2 = cosh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fexp fdup 1/f f+ f2/ ;   fexp fdup 1/f f+ f2/ ;
   
 ftanh   ( r1 -- r2 )    float-ext       f_tan_h  ftanh   ( r1 -- r2 )    float-ext       f_tan_h
   CLOBBER_TOS_WORKAROUND_START;
 r2 = tanh(r1);  r2 = tanh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  f2* fexpm1 fdup 2. d>f f+ f/ ;   f2* fexpm1 fdup 2. d>f f+ f/ ;
   
 fasinh  ( r1 -- r2 )    float-ext       f_a_cinch  fasinh  ( r1 -- r2 )    float-ext       f_a_cinch
   CLOBBER_TOS_WORKAROUND_START;
 r2 = asinh(r1);  r2 = asinh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;   fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
   
 facosh  ( r1 -- r2 )    float-ext       f_a_cosh  facosh  ( r1 -- r2 )    float-ext       f_a_cosh
   CLOBBER_TOS_WORKAROUND_START;
 r2 = acosh(r1);  r2 = acosh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fdup fdup f* 1. d>f f- fsqrt f+ fln ;   fdup fdup f* 1. d>f f- fsqrt f+ fln ;
   
 fatanh  ( r1 -- r2 )    float-ext       f_a_tan_h  fatanh  ( r1 -- r2 )    float-ext       f_a_tan_h
   CLOBBER_TOS_WORKAROUND_START;
 r2 = atanh(r1);  r2 = atanh(r1);
   CLOBBER_TOS_WORKAROUND_END;
 :  :
  fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/   fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
  r> IF  fnegate  THEN ;   r> IF  fnegate  THEN ;
Line 2373  faxpy(ra, f_x, nstridex, f_y, nstridey, Line 2461  faxpy(ra, f_x, nstridex, f_y, nstridey,
      fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap       fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap
  LOOP 2drop 2drop fdrop ;   LOOP 2drop 2drop fdrop ;
   
   >float1 ( c_addr u c -- f:... flag )    gforth  to_float1
   ""Actual stack effect: ( c_addr u c -- r t | f ).  Attempt to convert the
   character string @i{c-addr u} to internal floating-point
   representation. If the string represents a valid floating-point number
   @i{r} is placed on the floating-point stack and @i{flag} is
   true. Otherwise, @i{flag} is false. A string of blanks is a special
   case and represents the floating-point number 0.""
   Float r;
   flag = to_float(c_addr, u, &r, c);
   if (flag) {
     fp--;
     fp[0]=r;
   }
   
 \+  \+
   
 \ The following words access machine/OS/installation-dependent  \ The following words access machine/OS/installation-dependent
Line 2463  open-lib ( c_addr1 u1 -- u2 ) gforth ope Line 2565  open-lib ( c_addr1 u1 -- u2 ) gforth ope
 u2 = gforth_dlopen(c_addr1, u1);  u2 = gforth_dlopen(c_addr1, u1);
   
 lib-sym ( c_addr1 u1 u2 -- u3 ) gforth  lib_sym  lib-sym ( c_addr1 u1 u2 -- u3 ) gforth  lib_sym
   char * string = cstr(c_addr1, u1);
 #ifdef HAVE_LIBLTDL  #ifdef HAVE_LIBLTDL
 u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1));  u3 = (UCell) lt_dlsym((lt_dlhandle)u2, string);
 #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)  #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
 u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));  u3 = (UCell) dlsym((void*)u2,string);
 #else  #else
 #  ifdef _WIN32  #  ifdef _WIN32
 u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));  u3 = (Cell) GetProcAddress((HMODULE)u2, string);
 #  else  #  else
 #warning Define lib-sym!  #warning Define lib-sym!
 u3 = 0;  u3 = 0;
 #  endif  #  endif
 #endif  #endif
   free(string);
   
 wcall   ( ... u -- ... )        gforth  wcall   ( ... u -- ... )        gforth
 gforth_FP=fp;  gforth_FP=fp;
Line 2548  u = (c_addr[0] << 8) | (c_addr[1]); Line 2652  u = (c_addr[0] << 8) | (c_addr[1]);
   
 be-ul@ ( c_addr -- u )  gforth l_fetch_be  be-ul@ ( c_addr -- u )  gforth l_fetch_be
 ""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}.""  ""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}.""
 u = (c_addr[0] << 24) | (c_addr[1] << 16) | (c_addr[2] << 8) | (c_addr[3]);  u = ((Cell)c_addr[0] << 24) | (c_addr[1] << 16) | (c_addr[2] << 8) | (c_addr[3]);
   
 le-uw@ ( c_addr -- u )  gforth w_fetch_le  le-uw@ ( c_addr -- u )  gforth w_fetch_le
 ""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}.""  ""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}.""
Line 2556  u = (c_addr[1] << 8) | (c_addr[0]); Line 2660  u = (c_addr[1] << 8) | (c_addr[0]);
   
 le-ul@ ( c_addr -- u )  gforth l_fetch_le  le-ul@ ( c_addr -- u )  gforth l_fetch_le
 ""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}.""  ""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}.""
 u = (c_addr[3] << 24) | (c_addr[2] << 16) | (c_addr[1] << 8) | (c_addr[0]);  u = ((Cell)c_addr[3] << 24) | (c_addr[2] << 16) | (c_addr[1] << 8) | (c_addr[0]);
   
 \+64bit  \+64bit
   
Line 2693  ip=IP; Line 2797  ip=IP;
 SUPER_END;  SUPER_END;
 VM_JUMP(EXEC1((Xt)a_addr));  VM_JUMP(EXEC1((Xt)a_addr));
   
   \+objects
   \g object_pointer
   
   >o ( c_addr -- r:c_old )        new     to_o
   c_old = op;
   op = c_addr;
   
   o> ( r:c_addr -- )              new     o_restore
   op = c_addr;
   
   o#+ ( #w -- c_addr )            new     o_lit_plus
   c_addr = op + w;
   
   \+
 \g static_super  \g static_super
   
 ifdef(`STACK_CACHE_FILE',  ifdef(`STACK_CACHE_FILE',

Removed from v.1.260  
changed lines
  Added in v.1.274


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