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

version 1.40, 2009/06/29 20:21:28 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,2008 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 42 Line 42
 #endif  #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 82  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 100  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 108  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 120  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 153  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 309  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, FILE *wfileid)  struct Cellquad read_line(Char *c_addr, UCell u1, FILE *wfileid)
Line 354  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 380  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 420  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 508  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);    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 541  void gforth_ms(UCell u) Line 537  void gforth_ms(UCell u)
   
 UCell gforth_dlopen(Char *c_addr, UCell u)  UCell gforth_dlopen(Char *c_addr, UCell u)
 {  {
   char * file=tilde_cstr(c_addr, u, 1);    char * file=tilde_cstr(c_addr, u);
   UCell lib;    UCell lib;
 #if defined(HAVE_LIBLTDL)  #if defined(HAVE_LIBLTDL)
   lib = (UCell)lt_dlopen(file);    lib = (UCell)lt_dlopen(file);
     free(file);
   if(lib) return lib;    if(lib) return lib;
 #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)  #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
 #ifndef RTLD_GLOBAL  #ifndef RTLD_GLOBAL
 #define RTLD_GLOBAL 0  #define RTLD_GLOBAL 0
 #endif  #endif
   lib = (UCell)dlopen(file, RTLD_GLOBAL | RTLD_LAZY);    lib = (UCell)dlopen(file, RTLD_GLOBAL);
     free(file);
   if(lib) return lib;    if(lib) return lib;
     fprintf(stderr, "%s\n", dlerror());
 #elif defined(_WIN32)  #elif defined(_WIN32)
   lib = (UCell) GetModuleHandle(file);    lib = (UCell) GetModuleHandle(file);
     free(file);
   if(lib) return lib;    if(lib) return lib;
 #endif  #endif
   return 0;    return 0;

Removed from v.1.40  
changed lines
  Added in v.1.51


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