thread-safe cstr (requires explicit mfree\!)

cstr.fs

@@ -18,6 +18,6 @@
 \ along with this program. If not, see http://www.gnu.org/licenses/.
 
 c-library cstr
-c-function cstr       cstr       a n n -- a ( c-addr u fclear -- c-addr2 )
-c-function tilde_cstr tilde_cstr a n n -- a ( c-addr u fclear -- c-addr2 )
+c-function cstr       cstr       a n -- a ( c-addr u -- c-addr2 )
+c-function tilde_cstr tilde_cstr a n -- a ( c-addr u -- c-addr2 )
 end-c-library

engine/forth.h

@@ -391,8 +391,8 @@ typedef Cell *semiabifunc(Cell *sp, Float **fpp, Address body);
 
 /* engine/prim support routines */
 Address gforth_alloc(Cell size);
-char *cstr(Char *from, UCell size, int clear);
-char *tilde_cstr(Char *from, UCell size, int clear);
+char *cstr(Char *from, UCell size);
+char *tilde_cstr(Char *from, UCell size);
 Cell opencreate_file(char *s, Cell wfam, int flags, Cell *wiorp);
 DCell timeval2us(struct timeval *tvp);
 DCell timespec2ns(struct timespec *tvp);
@@ -473,6 +473,8 @@ extern __thread Address gforth_UP;
 extern __thread void * gforth_pointers[];
 #endif
 
+extern void gforth_backlink();
+
 #ifdef HAS_FFCALL
 extern void gforth_callback(Xt* fcall, void * alist);
 #endif

engine/main.c

@@ -2010,11 +2010,12 @@ static char *onlypath(char *filename)
 static FILE *openimage(char *fullfilename)
 {
   FILE *image_file;
-  char * expfilename = tilde_cstr((Char *)fullfilename, strlen(fullfilename), 1);
+  char * expfilename = tilde_cstr((Char *)fullfilename, strlen(fullfilename));
 
   image_file=fopen(expfilename,"rb");
   if (image_file!=NULL && debug)
     fprintf(stderr, "Opened image file: %s\n", expfilename);
+  free(expfilename);
   return image_file;
 }
 
@@ -2315,6 +2316,22 @@ void data_abort_C(void)
 }
 #endif
 
+void gforth_linkback()
+{
+#ifndef HAS_LINKBACK
+  gforth_pointers[0] = (void*)&gforth_SP;
+  gforth_pointers[1] = (void*)&gforth_FP;
+  gforth_pointers[2] = (void*)&gforth_LP;
+  gforth_pointers[3] = (void*)&gforth_RP;
+  gforth_pointers[4] = (void*)&gforth_UP;
+  gforth_pointers[5] = (void*)gforth_engine;
+#ifdef HAS_FILE
+  gforth_pointers[6] = (void*)cstr;
+  gforth_pointers[7] = (void*)tilde_cstr;
+#endif
+#endif
+}
+
 int main(int argc, char **argv, char **env)
 {
 #ifdef HAS_OS
@@ -2337,16 +2354,7 @@ int main(int argc, char **argv, char **env)
 #endif /* defined(__i386) */
 
 #ifndef HAS_LINKBACK
-  gforth_pointers[0] = (void*)&gforth_SP;
-  gforth_pointers[1] = (void*)&gforth_FP;
-  gforth_pointers[2] = (void*)&gforth_LP;
-  gforth_pointers[3] = (void*)&gforth_RP;
-  gforth_pointers[4] = (void*)&gforth_UP;
-  gforth_pointers[5] = (void*)gforth_engine;
-#ifdef HAS_FILE
-  gforth_pointers[6] = (void*)cstr;
-  gforth_pointers[7] = (void*)tilde_cstr;
-#endif
+  gforth_linkback();
 #endif
 	  
 #ifdef MACOSX_DEPLOYMENT_TARGET

engine/support.c

@@ -42,39 +42,17 @@
 #endif
 
 #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 ).
-   the C-string lives until the next call of cstr with CLEAR being true */
-{
-  static struct cstr_buffer {
-    char *buffer;
-    size_t size;
-  } *buffers=NULL;
-  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;
+   the C-string lives until free */
+{
+  char * string = malloc(size+1);
+  memcpy(string,from,size);
+  string[size]='\0';
+  return string;
 }
 
-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 */
 {
   char *s1,*s2;
@@ -82,7 +60,7 @@ char *tilde_cstr(Char *from, UCell size, int clear)
   struct passwd *getpwnam (), *user_entry;
 
   if (size<1 || from[0]!='~')
-    return cstr(from, size, clear);
+    return cstr(from, size);
   if (size<2 || from[1]=='/') {
     s1 = (char *)getenv ("HOME");
     if(s1 == NULL)
@@ -100,7 +78,7 @@ char *tilde_cstr(Char *from, UCell size, int clear)
     for (i=1; i<size && from[i]!='/'; i++)
       ;
     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];
       memcpy(user,from+1,i-1);
@@ -108,7 +86,7 @@ char *tilde_cstr(Char *from, UCell size, int clear)
       user_entry=getpwnam(user);
     }
     if (user_entry==NULL)
-      return cstr(from, size, clear);
+      return cstr(from, size);
     s1 = user_entry->pw_dir;
     s2 = (char *)from+i;
     s2_len = size-i;
@@ -120,7 +98,7 @@ char *tilde_cstr(Char *from, UCell size, int clear)
     char path[s1_len+s2_len];
     memcpy(path,s1,s1_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);
   }
 }
 
@@ -322,8 +300,11 @@ struct Cellpair parse_white(Char *c_addr1, UCell u1)
 #ifdef HAS_FILE
 Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2)
 {
-  char *s1=tilde_cstr(c_addr2, u2, 1);
-  return IOR(rename(tilde_cstr(c_addr1, u1, 0), s1)==-1);
+  char *s1=tilde_cstr(c_addr2, u2);
+  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)
@@ -367,7 +348,7 @@ struct Cellpair file_status(Char *c_addr, UCell u)
   struct Cellpair r;
   Cell wfam;
   Cell wior;
-  char *filename=tilde_cstr(c_addr, u, 1);
+  char *filename=tilde_cstr(c_addr, u);
 
   if (access (filename, F_OK) != 0) {
     wfam=0;
@@ -393,6 +374,7 @@ struct Cellpair file_status(Char *c_addr, UCell u)
   }
   r.n1 = wfam;
   r.n2 = wior;
+  free(filename);
   return r;
 }
 
@@ -555,19 +537,22 @@ void gforth_ms(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;
 #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 | RTLD_LAZY);
+  free(file);
   if(lib) return lib;
 #elif defined(_WIN32)
   lib = (UCell) GetModuleHandle(file);
+  free(file);
   if(lib) return lib;
 #endif
   return 0;

mkdir.fs

@@ -34,7 +34,7 @@
 	c-function f>ior IOR n -- n ( f -- ior )
 	    
 	: =mkdir ( c-addr u mode -- ior )
-	>r 1 tilde_cstr r> mkdir f>ior ;
+	>r 1 tilde_cstr r> over >r mkdir r> free drop f>ior ;
         end-c-library
     [THEN]
 [THEN]

prim

@@ -1747,13 +1747,17 @@ is the host operating system's expansion of that environment variable. If the
 environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
 in length.""
 /* close ' to keep fontify happy */
-c_addr2 = (Char *)getenv(cstr(c_addr1,u1,1));
+char * string = cstr(c_addr1,u1);
+c_addr2 = (Char *)getenv(string);
 u2 = (c_addr2 == NULL ? 0 : strlen((char *)c_addr2));
+free(string);
 
 open-pipe	( c_addr u wfam -- wfileid wior )	gforth	open_pipe
+char * string = cstr(c_addr,u);
 fflush(stdout);
-wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */
+wfileid=(Cell)popen(string,pfileattr[wfam]); /* ~ expansion of 1st arg? */
 wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */
+free(string);
 
 close-pipe	( wfileid -- wretval wior )		gforth	close_pipe
 wretval = pclose((FILE *)wfileid);
@@ -1860,13 +1864,19 @@ close-file	( wfileid -- wior )		file	close_file
 wior = IOR(fclose((FILE *)wfileid)==EOF);
 
 open-file	( c_addr u wfam -- wfileid wior )	file	open_file
-wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, 0, &wior);
+char * string = tilde_cstr(c_addr,u);
+wfileid = opencreate_file(string, wfam, 0, &wior);
+free(string);
 
 create-file	( c_addr u wfam -- wfileid wior )	file	create_file
-wfileid = opencreate_file(tilde_cstr(c_addr,u,1), wfam, O_CREAT|O_TRUNC, &wior);
+char * string = tilde_cstr(c_addr,u);
+wfileid = opencreate_file(string, wfam, O_CREAT|O_TRUNC, &wior);
+free(string);
 
 delete-file	( c_addr u -- wior )		file	delete_file
-wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1);
+char * string = tilde_cstr(c_addr,u);
+wior = IOR(unlink(string)==-1);
+free(string);
 
 rename-file	( c_addr1 u1 c_addr2 u2 -- wior )	file-ext	rename_file
 ""Rename file @i{c_addr1 u1} to new name @i{c_addr2 u2}""
@@ -1945,8 +1955,10 @@ flag = FLAG(feof((FILE *) wfileid));
 open-dir	( c_addr u -- wdirid wior )	gforth	open_dir
 ""Open the directory specified by @i{c-addr, u}
 and return @i{dir-id} for futher access to it.""
-wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));
+char * string = tilde_cstr(c_addr,u);
+wdirid = (Cell)opendir(string);
 wior =  IOR(wdirid == 0);
+free(string);
 
 read-dir	( c_addr u1 wdirid -- u2 flag wior )	gforth	read_dir
 ""Attempt to read the next entry from the directory specified
@@ -1981,14 +1993,18 @@ close-dir	( wdirid -- wior )	gforth	close_dir
 wior = IOR(closedir((DIR *)wdirid));
 
 filename-match	( c_addr1 u1 c_addr2 u2 -- flag )	gforth	match_file
-char * string = cstr(c_addr1, u1, 1);
-char * pattern = cstr(c_addr2, u2, 0);
+char * string = cstr(c_addr1, u1);
+char * pattern = cstr(c_addr2, u2);
 flag = FLAG(!fnmatch(pattern, string, 0));
+free(string);
+free(pattern);
 
 set-dir	( c_addr u -- wior )	gforth set_dir
 ""Change the current directory to @i{c-addr, u}.
 Return an error if this is not possible""
-wior = IOR(chdir(tilde_cstr(c_addr, u, 1)));
+char * string = tilde_cstr(c_addr, u);
+wior = IOR(chdir(string));
+free(string);
 
 get-dir	( c_addr1 u1 -- c_addr2 u2 )	gforth get_dir
 ""Store the current directory in the buffer specified by @i{c-addr1, u1}.
@@ -2002,7 +2018,9 @@ if(c_addr2 != NULL) {
 
 =mkdir ( c_addr u wmode -- wior )        gforth equals_mkdir
 ""Create directory @i{c-addr u} with mode @i{wmode}.""
-wior = IOR(mkdir(tilde_cstr(c_addr,u,1),wmode));
+char * string = tilde_cstr(c_addr,u);
+wior = IOR(mkdir(string,wmode));
+free(string);
 
 \+
 
@@ -2528,18 +2546,20 @@ open-lib	( c_addr1 u1 -- u2 )	gforth	open_lib
 u2 = gforth_dlopen(c_addr1, u1);
 
 lib-sym	( c_addr1 u1 u2 -- u3 )	gforth	lib_sym
+char * string = cstr(c_addr1, u1);
 #ifdef HAVE_LIBLTDL
-u3 = (UCell) lt_dlsym((lt_dlhandle)u2, cstr(c_addr1, u1, 1));
+u3 = (UCell) lt_dlsym((lt_dlhandle)u2, string);
 #elif defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
-u3 = (UCell) dlsym((void*)u2,cstr(c_addr1, u1, 1));
+u3 = (UCell) dlsym((void*)u2,string);
 #else
 #  ifdef _WIN32
-u3 = (Cell) GetProcAddress((HMODULE)u2, cstr(c_addr1, u1, 1));
+u3 = (Cell) GetProcAddress((HMODULE)u2, string);
 #  else
 #warning Define lib-sym!
 u3 = 0;
 #  endif
 #endif
+free(string);
 
 wcall	( ... u -- ... )	gforth
 gforth_FP=fp;

prims2cl.fs

@@ -42,8 +42,6 @@ Create 	InputFile 130 chars allot
  
 : c-header
 	.\ #include "engine/forth.h"
-	.\ extern char *cstr(Char *from, UCell size, int clear);
-	.\ extern char *tilde_cstr(Char *from, UCell size, int clear);
 	.\ 
 	.\ #undef TOS
 	.\ #define TOS sp[0]