Diff for /gforth/prim between versions 1.102 and 1.109

version 1.102, 2002/11/24 13:54:00 version 1.109, 2002/12/27 16:22:03
Line 105 Line 105
 \E   \E 
 \E set-current  \E set-current
 \E store-optimization on  \E store-optimization on
   \E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump
   
 \   \ 
 \   \ 
Line 1288  while(u1--) Line 1289  while(u1--)
    ASCII strings (larger if ubits is large), and should share no     ASCII strings (larger if ubits is large), and should share no
    divisors with ubits.     divisors with ubits.
 */  */
 unsigned rot = ((char []){5,0,1,2,3,4,5,5,5,5,3,5,5,5,5,7,5,5,5,5,7,5,5,5,5,6,5,5,5,5,7,5,5})[ubits];  static char rot_values[] = {5,0,1,2,3,4,5,5,5,5,3,5,5,5,5,7,5,5,5,5,7,5,5,5,5,6,5,5,5,5,7,5,5};
   unsigned rot = rot_values[ubits];
 Char *cp = c_addr;  Char *cp = c_addr;
 for (ukey=0; cp<c_addr+u; cp++)  for (ukey=0; cp<c_addr+u; cp++)
     ukey = ((((ukey<<rot) | (ukey>>(ubits-rot)))       ukey = ((((ukey<<rot) | (ukey>>(ubits-rot))) 
Line 1604  wior = IOR(rename(tilde_cstr(c_addr1, u1 Line 1606  wior = IOR(rename(tilde_cstr(c_addr1, u1
   
 file-position   ( wfileid -- ud wior )  file    file_position  file-position   ( wfileid -- ud wior )  file    file_position
 /* !! use tell and lseek? */  /* !! use tell and lseek? */
 ud = LONG2UD(ftell((FILE *)wfileid));  ud = OFF2UD(ftello((FILE *)wfileid));
 wior = IOR(UD2LONG(ud)==-1);  wior = IOR(UD2OFF(ud)==-1);
   
 reposition-file ( ud wfileid -- wior )  file    reposition_file  reposition-file ( ud wfileid -- wior )  file    reposition_file
 wior = IOR(fseek((FILE *)wfileid, UD2LONG(ud), SEEK_SET)==-1);  wior = IOR(fseeko((FILE *)wfileid, UD2OFF(ud), SEEK_SET)==-1);
   
 file-size       ( wfileid -- ud wior )  file    file_size  file-size       ( wfileid -- ud wior )  file    file_size
 struct stat buf;  struct stat buf;
 wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);  wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);
 ud = LONG2UD(buf.st_size);  ud = OFF2UD(buf.st_size);
   
 resize-file     ( ud wfileid -- wior )  file    resize_file  resize-file     ( ud wfileid -- wior )  file    resize_file
 wior = IOR(ftruncate(fileno((FILE *)wfileid), UD2LONG(ud))==-1);  wior = IOR(ftruncate(fileno((FILE *)wfileid), UD2OFF(ud))==-1);
   
 read-file       ( c_addr u1 wfileid -- u2 wior )        file    read_file  read-file       ( c_addr u1 wfileid -- u2 wior )        file    read_file
 /* !! fread does not guarantee enough */  /* !! fread does not guarantee enough */
Line 1808  floor ( r1 -- r2 ) float Line 1810  floor ( r1 -- r2 ) float
 /* !! unclear wording */  /* !! unclear wording */
 r2 = floor(r1);  r2 = floor(r1);
   
 (fround)        ( r1 -- r2 )    gforth  paren_f_round  fround  ( r1 -- r2 )    gforth  f_round
 ""Round to the nearest integral value.  Primitive variant (unused)""  ""Round to the nearest integral value.""
 /* !! eliminate this as primitive? */  
 /* !! unclear wording */  
 #ifdef HAVE_RINT  
 r2 = rint(r1);  r2 = rint(r1);
 #else  
 r2 = floor(r1+0.5);  
 /* !! This is not quite true to the rounding rules given in the standard */  
 #endif  
   
 fmax    ( r1 r2 -- r3 ) float   f_max  fmax    ( r1 r2 -- r3 ) float   f_max
 if (r1<r2)  if (r1<r2)
Line 2435  SET_IP((Xt *)a_callee); Line 2430  SET_IP((Xt *)a_callee);
 useraddr        ( #u -- a_addr )        new  useraddr        ( #u -- a_addr )        new
 a_addr = (Cell *)(up+u);  a_addr = (Cell *)(up+u);
   
 compile-prim ( xt1 -- xt2 )     new     compile_prim  compile-prim ( xt1 -- xt2 )     obsolete        compile_prim
 xt2 = (Xt)compile_prim((Label)xt1);  xt2 = (Xt)compile_prim((Label)xt1);
   
 \ lit@ / lit_fetch = lit @  \ lit@ / lit_fetch = lit @
Line 2461  does-exec ( #a_cfa -- R:nest a_pfa ) new Line 2456  does-exec ( #a_cfa -- R:nest a_pfa ) new
 assert(0);  assert(0);
 #else  #else
 a_pfa = PFA(a_cfa);  a_pfa = PFA(a_cfa);
 nest = (Cell)ip;  nest = (Cell)IP;
 IF_spTOS(spTOS = sp[0]);  IF_spTOS(spTOS = sp[0]);
 #ifdef DEBUG  #ifdef DEBUG
     {      {
Line 2750  SUPER_CONTINUE; Line 2745  SUPER_CONTINUE;
      cell+       cell+
  THEN  >r ;   THEN  >r ;
   
   \ set-next-code and call2 do not appear in images and can be
   \ renumbered arbitrarily
   
 set-next-code ( #w -- ) gforth set_next_code  set-next-code ( #w -- ) gforth set_next_code
 #ifdef NO_IP  #ifdef NO_IP
 next_code = (Label)w;  next_code = (Label)w;
Line 2773  finish-code ( -- ) gforth finish_code Line 2771  finish-code ( -- ) gforth finish_code
 flushing).""  flushing).""
 finish_code();  finish_code();
   
   forget-dyncode ( c_code -- f ) gforth-internal forget_dyncode
   f = forget_dyncode(c_code);
   
   decompile-prim ( a_code -- a_prim ) gforth-internal decompile_prim
   ""a_prim is the code address of the primitive that has been
   compile_prim1ed to a_code""
   a_prim = decompile_code(a_code);
   
 \+  \+
   
 include(peeprules.vmg)  include(peeprules.vmg)

Removed from v.1.102  
changed lines
  Added in v.1.109


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