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; |