Diff for /gforth/prim between versions 1.7 and 1.14

version 1.7, 1997/12/14 01:15:19 version 1.14, 1998/11/08 23:08:04
Line 1177  c_addr2 = c_addr1+1; Line 1177  c_addr2 = c_addr1+1;
  dup 1+ swap c@ ;   dup 1+ swap c@ ;
   
 (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find  (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find
 for (; f83name1 != NULL; f83name1 = f83name1->next)  for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))
   if ((UCell)F83NAME_COUNT(f83name1)==u &&    if ((UCell)F83NAME_COUNT(f83name1)==u &&
       memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)        memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
     break;      break;
Line 1194  f83name2=f83name1; Line 1194  f83name2=f83name1;
 \+has? hash [IF]  \+has? hash [IF]
   
 (hashfind)      c_addr u a_addr -- f83name2     new     paren_hashfind  (hashfind)      c_addr u a_addr -- f83name2     new     paren_hashfind
 F83Name *f83name1;  struct F83Name *f83name1;
 f83name2=NULL;  f83name2=NULL;
 while(a_addr != NULL)  while(a_addr != NULL)
 {  {
    f83name1=(F83Name *)(a_addr[1]);     f83name1=(struct F83Name *)(a_addr[1]);
    a_addr=(Cell *)(a_addr[0]);     a_addr=(Cell *)(a_addr[0]);
    if ((UCell)F83NAME_COUNT(f83name1)==u &&     if ((UCell)F83NAME_COUNT(f83name1)==u &&
        memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)         memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
Line 1217  while(a_addr != NULL) Line 1217  while(a_addr != NULL)
   
 (tablefind)     c_addr u a_addr -- f83name2     new     paren_tablefind  (tablefind)     c_addr u a_addr -- f83name2     new     paren_tablefind
 ""A case-sensitive variant of @code{(hashfind)}""  ""A case-sensitive variant of @code{(hashfind)}""
 F83Name *f83name1;  struct F83Name *f83name1;
 f83name2=NULL;  f83name2=NULL;
 while(a_addr != NULL)  while(a_addr != NULL)
 {  {
    f83name1=(F83Name *)(a_addr[1]);     f83name1=(struct F83Name *)(a_addr[1]);
    a_addr=(Cell *)(a_addr[0]);     a_addr=(Cell *)(a_addr[0]);
    if ((UCell)F83NAME_COUNT(f83name1)==u &&     if ((UCell)F83NAME_COUNT(f83name1)==u &&
        memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */)         memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
Line 1327  a_addr = (Cell *)DOES_CODE(xt); Line 1327  a_addr = (Cell *)DOES_CODE(xt);
 code-address!           c_addr xt --            gforth  code_address_store  code-address!           c_addr xt --            gforth  code_address_store
 ""Creates a code field with code address c_addr at xt""  ""Creates a code field with code address c_addr at xt""
 MAKE_CF(xt, c_addr);  MAKE_CF(xt, c_addr);
 CACHE_FLUSH(xt,PFA(0));  CACHE_FLUSH(xt,(size_t)PFA(0));
 :  :
     ! ;      ! ;
   
Line 1335  does-code! a_addr xt --  gforth does_cod Line 1335  does-code! a_addr xt --  gforth does_cod
 ""creates a code field at xt for a defining-word-defined word; a_addr  ""creates a code field at xt for a defining-word-defined word; a_addr
 is the start of the Forth code after DOES>""  is the start of the Forth code after DOES>""
 MAKE_DOES_CF(xt, a_addr);  MAKE_DOES_CF(xt, a_addr);
 CACHE_FLUSH(xt,PFA(0));  CACHE_FLUSH(xt,(size_t)PFA(0));
 :  :
     dodoes: over ! cell+ ! ;      dodoes: over ! cell+ ! ;
   
Line 1343  does-handler! a_addr -- gforth does_hand Line 1343  does-handler! a_addr -- gforth does_hand
 ""creates a DOES>-handler at address a_addr. a_addr usually points  ""creates a DOES>-handler at address a_addr. a_addr usually points
 just behind a DOES>.""  just behind a DOES>.""
 MAKE_DOES_HANDLER(a_addr);  MAKE_DOES_HANDLER(a_addr);
 CACHE_FLUSH(a_addr,DOES_HANDLER_SIZE);  CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE);
 :  :
     drop ;      drop ;
   
Line 1371  n=1; Line 1371  n=1;
   
 \+has? os [IF]  \+has? os [IF]
   
 (key)   -- n            gforth  paren_key  key-file        wfileid -- n            gforth  paren_key_file
 fflush(stdout);  fflush(stdout);
 /* !! noecho */  n = key((FILE*)wfileid);
 n = key();  
   
 key?    -- n            facility        key_q  key?-file       wfileid -- n            facility        key_q_file
 fflush(stdout);  fflush(stdout);
 n = key_query;  n = key_query((FILE*)wfileid);
   
   stdin   -- wfileid      gforth
   wfileid = (Cell)stdin;
   
 stdout  -- wfileid      gforth  stdout  -- wfileid      gforth
 wfileid = (Cell)stdout;  wfileid = (Cell)stdout;
Line 1500  wior = IOR(fclose((FILE *)wfileid)==EOF) Line 1502  wior = IOR(fclose((FILE *)wfileid)==EOF)
   
 open-file       c_addr u ntype -- w2 wior       file    open_file  open-file       c_addr u ntype -- w2 wior       file    open_file
 w2 = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]);  w2 = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]);
   #if defined(GO32) && defined(MSDOS)
   if(w2 && !(ntype & 1))
     setbuf((FILE*)w2, NULL);
   #endif
 wior =  IOR(w2 == 0);  wior =  IOR(w2 == 0);
   
 create-file     c_addr u ntype -- w2 wior       file    create_file  create-file     c_addr u ntype -- w2 wior       file    create_file
Line 1507  Cell fd; Line 1513  Cell fd;
 fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_TRUNC|ufileattr[ntype], 0666);  fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_TRUNC|ufileattr[ntype], 0666);
 if (fd != -1) {  if (fd != -1) {
   w2 = (Cell)fdopen(fd, fileattr[ntype]);    w2 = (Cell)fdopen(fd, fileattr[ntype]);
   #if defined(GO32) && defined(MSDOS)
     if(w2 && !(ntype & 1))
       setbuf((FILE*)w2, NULL);
   #endif
   wior = IOR(w2 == 0);    wior = IOR(w2 == 0);
 } else {  } else {
   w2 = 0;    w2 = 0;
Line 1529  reposition-file ud wfileid -- wior file Line 1539  reposition-file ud wfileid -- wior file
 wior = IOR(fseek((FILE *)wfileid, UD2LONG(ud), SEEK_SET)==-1);  wior = IOR(fseek((FILE *)wfileid, UD2LONG(ud), SEEK_SET)==-1);
   
 file-size       wfileid -- ud wior      file    file_size  file-size       wfileid -- ud wior      file    file_size
 #include <sys/stat.h>  
 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 = LONG2UD(buf.st_size);
Line 1980  f>l r -- gforth f_to_l Line 1989  f>l r -- gforth f_to_l
 lp -= sizeof(Float);  lp -= sizeof(Float);
 *(Float *)lp = r;  *(Float *)lp = r;
   
   fpick   u -- r          gforth
   r = fp[u+1]; /* +1, because update of fp happens before this fragment */
   :
    floats fp@ + f@ ;
   
 \+[THEN]  [THEN] \ has? glocals  \+[THEN]  [THEN] \ has? glocals
   
 \+has? OS [IF]  \+has? OS [IF]
Line 2004  define(argclist, Line 2018  define(argclist,
 \ icall(argnum)  \ icall(argnum)
 define(icall,  define(icall,
 `icall$1        argflist($1)u -- uret   gforth  `icall$1        argflist($1)u -- uret   gforth
 uret = ((Cell(*)(argdlist($1)))u)(argclist($1));  uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1));
   
 ')  ')
 define(fcall,  define(fcall,
 `fcall$1        argflist($1)u -- rret   gforth  `fcall$1        argflist($1)u -- rret   gforth
 rret = ((Float(*)(argdlist($1)))u)(argclist($1));  rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1));
   
 ')  ')
   
   
 open-lib        c_addr1 u1 -- u2        gforth  open_lib  open-lib        c_addr1 u1 -- u2        gforth  open_lib
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)  #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
   #ifndef RTLD_GLOBAL
   #define RTLD_GLOBAL 0
   #endif
 u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY);  u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY);
 #else  #else
 #  ifdef HAVE_LIBKERNEL32  #  ifdef HAVE_LIBKERNEL32

Removed from v.1.7  
changed lines
  Added in v.1.14


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