[BACK]Return to support.c CVS log [TXT] [DIR] Up to [gforth] / gforth / engine

Diff for /gforth/engine/support.c between versions 1.32 and 1.51

version 1.32, 2008/08/09 13:24:25 version 1.51, 2012/12/31 15:25:19
Line 1 Line 1
 /* Gforth support functions  /* Gforth support functions
   
   Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2006,2007 Free Software Foundation, Inc.    Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
   
   This file is part of Gforth.    This file is part of Gforth.
   
Line 37 Line 37
 #include <fcntl.h>  #include <fcntl.h>
 #include <time.h>  #include <time.h>
 #endif  #endif
   #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */
   #include <dlfcn.h>
   #endif
   
 #ifdef HAS_FILE  #ifdef HAS_FILE
 char *cstr(Char *from, UCell size, int clear)  char *cstr(Char *from, UCell size)
 /* return a C-string corresponding to the Forth string ( FROM SIZE ).  /* return a C-string corresponding to the Forth string ( FROM SIZE ).
    the C-string lives until the next call of cstr with CLEAR being true */     the C-string lives until free */
 {  {
   static struct cstr_buffer {    char * string = malloc(size+1);
     char *buffer;    memcpy(string,from,size);
     size_t size;    string[size]='\0';
   } *buffers=NULL;    return string;
   static int nbuffers=0;  
   static int used=0;  
   struct cstr_buffer *b;  
   
   if (buffers==NULL)  
     buffers=malloc(0);  
   if (clear)  
     used=0;  
   if (used>=nbuffers) {  
     buffers=realloc(buffers,sizeof(struct cstr_buffer)*(used+1));  
     buffers[used]=(struct cstr_buffer){malloc(0),0};  
     nbuffers=used+1;  
   }  
   b=&buffers[used];  
   if (size+1 > b->size) {  
     b->buffer = realloc(b->buffer,size+1);  
     b->size = size+1;  
   }  
   memcpy(b->buffer,from,size);  
   b->buffer[size]='\0';  
   used++;  
   return b->buffer;  
 }  }
   
 char *tilde_cstr(Char *from, UCell size, int clear)  char *tilde_cstr(Char *from, UCell size)
 /* like cstr(), but perform tilde expansion on the string */  /* like cstr(), but perform tilde expansion on the string */
 {  {
   char *s1,*s2;    char *s1,*s2;
Line 79  char *tilde_cstr(Char *from, UCell size, Line 60  char *tilde_cstr(Char *from, UCell size,
   struct passwd *getpwnam (), *user_entry;    struct passwd *getpwnam (), *user_entry;
   
   if (size<1 || from[0]!='~')    if (size<1 || from[0]!='~')
     return cstr(from, size, clear);      return cstr(from, size);
   if (size<2 || from[1]=='/') {    if (size<2 || from[1]=='/') {
     s1 = (char *)getenv ("HOME");      s1 = (char *)getenv ("HOME");
     if(s1 == NULL)      if(s1 == NULL)
Line 97  char *tilde_cstr(Char *from, UCell size, Line 78  char *tilde_cstr(Char *from, UCell size,
     for (i=1; i<size && from[i]!='/'; i++)      for (i=1; i<size && from[i]!='/'; i++)
       ;        ;
     if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */      if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */
       return cstr(from+3, size<3?0:size-3,clear);        return cstr(from+3, size<3?0:size-3);
     {      {
       char user[i];        char user[i];
       memcpy(user,from+1,i-1);        memcpy(user,from+1,i-1);
Line 105  char *tilde_cstr(Char *from, UCell size, Line 86  char *tilde_cstr(Char *from, UCell size,
       user_entry=getpwnam(user);        user_entry=getpwnam(user);
     }      }
     if (user_entry==NULL)      if (user_entry==NULL)
       return cstr(from, size, clear);        return cstr(from, size);
     s1 = user_entry->pw_dir;      s1 = user_entry->pw_dir;
     s2 = (char *)from+i;      s2 = (char *)from+i;
     s2_len = size-i;      s2_len = size-i;
Line 117  char *tilde_cstr(Char *from, UCell size, Line 98  char *tilde_cstr(Char *from, UCell size,
     char path[s1_len+s2_len];      char path[s1_len+s2_len];
     memcpy(path,s1,s1_len);      memcpy(path,s1,s1_len);
     memcpy(path+s1_len,s2,s2_len);      memcpy(path+s1_len,s2,s2_len);
     return cstr((Char *)path,s1_len+s2_len,clear);      return cstr((Char *)path,s1_len+s2_len);
   }    }
 }  }
   
Line 150  DCell timeval2us(struct timeval *tvp) Line 131  DCell timeval2us(struct timeval *tvp)
 #endif  #endif
 }  }
   
   DCell timespec2ns(struct timespec *tvp)
   {
   #ifndef BUGGY_LONG_LONG
     return (tvp->tv_sec*(DCell)1000000000LL)+tvp->tv_nsec;
   #else
     DCell d2;
     DCell d1=mmul(tvp->tv_sec,1000000000);
     d2.lo = d1.lo+tvp->tv_nsec;
     d2.hi = d1.hi + (d2.lo<d1.lo);
     return d2;
   #endif
   }
   
 DCell double2ll(Float r)  DCell double2ll(Float r)
 {  {
 #ifndef BUGGY_LONG_LONG  #ifndef BUGGY_LONG_LONG
Line 306  struct Cellpair parse_white(Char *c_addr Line 300  struct Cellpair parse_white(Char *c_addr
 #ifdef HAS_FILE  #ifdef HAS_FILE
 Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2)  Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2)
 {  {
   char *s1=tilde_cstr(c_addr2, u2, 1);    char *s1=tilde_cstr(c_addr2, u2);
   return IOR(rename(tilde_cstr(c_addr1, u1, 0), s1)==-1);    char *s2=tilde_cstr(c_addr1, u1);
     return IOR(rename(s2, s1)==-1);
     free(s1);
     free(s2);
 }  }
   
 struct Cellquad read_line(Char *c_addr, UCell u1, Cell wfileid)  struct Cellquad read_line(Char *c_addr, UCell u1, FILE *wfileid)
 {  {
   UCell u2, u3;    UCell u2, u3;
   Cell flag, wior;    Cell flag, wior;
Line 319  struct Cellquad read_line(Char *c_addr, Line 316  struct Cellquad read_line(Char *c_addr,
   
   flag=-1;    flag=-1;
   u3=0;    u3=0;
     if (u1>0)
       gf_regetc(wfileid);
   for(u2=0; u2<u1; u2++) {    for(u2=0; u2<u1; u2++) {
     c = getc((FILE *)wfileid);      c = getc(wfileid);
     u3++;      u3++;
     if (c=='\n') break;      if (c=='\n') break;
     if (c=='\r') {      if (c=='\r') {
       if ((c = getc((FILE *)wfileid))!='\n')        if ((c = getc(wfileid))!='\n')
         ungetc(c,(FILE *)wfileid);          gf_ungetc(c,wfileid);
       else        else
         u3++;          u3++;
       break;        break;
Line 336  struct Cellquad read_line(Char *c_addr, Line 335  struct Cellquad read_line(Char *c_addr,
     }      }
     c_addr[u2] = (Char)c;      c_addr[u2] = (Char)c;
   }    }
   wior=FILEIO(ferror((FILE *)wfileid));    wior=FILEIO(ferror(wfileid));
   r.n1 = u2;    r.n1 = u2;
   r.n2 = flag;    r.n2 = flag;
   r.n3 = u3;    r.n3 = u3;
Line 349  struct Cellpair file_status(Char *c_addr Line 348  struct Cellpair file_status(Char *c_addr
   struct Cellpair r;    struct Cellpair r;
   Cell wfam;    Cell wfam;
   Cell wior;    Cell wior;
   char *filename=tilde_cstr(c_addr, u, 1);    char *filename=tilde_cstr(c_addr, u);
   
   if (access (filename, F_OK) != 0) {    if (access (filename, F_OK) != 0) {
     wfam=0;      wfam=0;
Line 375  struct Cellpair file_status(Char *c_addr Line 374  struct Cellpair file_status(Char *c_addr
   }    }
   r.n1 = wfam;    r.n1 = wfam;
   r.n2 = wior;    r.n2 = wior;
     free(filename);
   return r;    return r;
 }  }
   
 Cell to_float(Char *c_addr, UCell u, Float *rp)  Cell to_float(Char *c_addr, UCell u, Float *rp, Char dot)
 {  {
   /* convertible string := <significand>[<exponent>]    /* convertible string := <significand>[<exponent>]
      <significand> := [<sign>]{<digits>[.<digits0>] | .<digits> }       <significand> := [<sign>]{<digits>[.<digits0>] | .<digits> }
Line 415  Cell to_float(Char *c_addr, UCell u, Flo Line 415  Cell to_float(Char *c_addr, UCell u, Flo
   aftersign:     aftersign: 
   if (s >= send)    if (s >= send)
     goto exponent;      goto exponent;
   switch (c=*s) {    if((c=*s)==dot) { *t++ = '.'; ndots++; s++; goto aftersign; }
     switch (c) {
   case '0' ... '9': *t++ = c; ndigits++; s++; goto aftersign;    case '0' ... '9': *t++ = c; ndigits++; s++; goto aftersign;
   case '.':         *t++ = c; ndots++;   s++; goto aftersign;  
   default:                                    goto exponent;    default:                                    goto exponent;
   }    }
  exponent:   exponent:
Line 503  int gforth_system(Char *c_addr, UCell u) Line 503  int gforth_system(Char *c_addr, UCell u)
   char *prefix = getenv("GFORTHSYSTEMPREFIX") ? : DEFAULTSYSTEMPREFIX;    char *prefix = getenv("GFORTHSYSTEMPREFIX") ? : DEFAULTSYSTEMPREFIX;
   size_t prefixlen = strlen(prefix);    size_t prefixlen = strlen(prefix);
   char buffer[prefixlen+u+1];    char buffer[prefixlen+u+1];
     int MAYBE_UNUSED old_tp;
     fflush(stdout);
 #ifndef MSDOS  #ifndef MSDOS
   int old_tp=terminal_prepped;    old_tp=terminal_prepped;
   deprep_terminal();    deprep_terminal();
 #endif  #endif
   memcpy(buffer,prefix,prefixlen);    memcpy(buffer,prefix,prefixlen);
Line 532  void gforth_ms(UCell u) Line 534  void gforth_ms(UCell u)
   (void)select(0,0,0,0,&timeout);    (void)select(0,0,0,0,&timeout);
 #endif /* !defined(HAVE_NANOSLEEP) */  #endif /* !defined(HAVE_NANOSLEEP) */
 }  }
   
   UCell gforth_dlopen(Char *c_addr, UCell u)
   {
     char * file=tilde_cstr(c_addr, u);
     UCell lib;
   #if defined(HAVE_LIBLTDL)
     lib = (UCell)lt_dlopen(file);
     free(file);
     if(lib) return lib;
   #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
   #ifndef RTLD_GLOBAL
   #define RTLD_GLOBAL 0
   #endif
     lib = (UCell)dlopen(file, RTLD_GLOBAL);
     free(file);
     if(lib) return lib;
     fprintf(stderr, "%s\n", dlerror());
   #elif defined(_WIN32)
     lib = (UCell) GetModuleHandle(file);
     free(file);
     if(lib) return lib;
   #endif
     return 0;
   }
   
 #endif /* !defined(STANDALONE) */  #endif /* !defined(STANDALONE) */
   
   
Line 563  typedef UDCell UDWtype; Line 590  typedef UDCell UDWtype;
   
 #include "longlong.h"  #include "longlong.h"
   
   
 #if defined(udiv_qrnnd) && !defined(__alpha) && UDIV_NEEDS_NORMALIZATION  #if defined(udiv_qrnnd) && !defined(__alpha) && UDIV_NEEDS_NORMALIZATION
   
   #if defined(count_leading_zeros)
   const UQItype __clz_tab[256] =
   {
     0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
     6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
     7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
     7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
     8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
     8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
     8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
     8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
   };
   #endif
   
 static Cell MAYBE_UNUSED nlz(UCell x)  static Cell MAYBE_UNUSED nlz(UCell x)
      /* number of leading zeros, adapted from "Hacker's Delight" */       /* number of leading zeros, adapted from "Hacker's Delight" */
 {  {
Removed from v.1.32  
changed lines
  Added in v.1.51

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