try writable_malloc for sgc/setbuf issues

6 files changed, 18 insertions, 24 deletions

diff --git a/gcl/h/hppa-linux.h b/gcl/h/hppa-linux.h
index 0b6111ba..b9821884 100755
--- a/gcl/h/hppa-linux.h
+++ b/gcl/h/hppa-linux.h
@@ -18,5 +18,3 @@
 
 #define RELOC_H "elf32_hppa_reloc.h"
 #define SPECIAL_RELOC_H "elf32_hppa_reloc_special.h"
-
-#define NO_SETBUF /* FIXME, sgc setbuf instability */
diff --git a/gcl/h/notcomp.h b/gcl/h/notcomp.h
index 2a76ba40..b3567acb 100755
--- a/gcl/h/notcomp.h
+++ b/gcl/h/notcomp.h
@@ -492,3 +492,5 @@ object ihs_top_function_name(ihs_ptr h);
 
 #define massert(a_) if (!(a_)) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__)
 
+extern bool writable_malloc;
+#define writable_malloc_wrap(f_,rt_,a_...) ({rt_ v;bool w=writable_malloc;writable_malloc=1;v=f_(a_);writable_malloc=w;v;})
diff --git a/gcl/o/alloc.c b/gcl/o/alloc.c
index 01d652ee..d979f37a 100644
--- a/gcl/o/alloc.c
+++ b/gcl/o/alloc.c
@@ -995,6 +995,8 @@ gcl_init_alloc(void *cs_start) {
   init_textpage();
 #endif
   
+  malloc_list=Cnil;
+
 #if defined(BSD) && defined(RLIMIT_STACK)
   {
     struct rlimit rl;
@@ -1545,6 +1547,8 @@ static char *baby_malloc(n)
 /*  } */
 /*  #endif */
 
+bool writable_malloc=0;
+
 void *
 malloc(size_t size) {
 
@@ -1562,7 +1566,8 @@ malloc(size_t size) {
   malloc_list = make_cons(Cnil, malloc_list);
   malloc_list->c.c_car = alloc_simple_string(size);
   malloc_list->c.c_car->st.st_self = alloc_contblock(size);
-  
+  malloc_list->c.c_car->st.st_adjustable=writable_malloc;
+
   /* FIXME: this is just to handle clean freeing of the
      monstartup memory allocated automatically on raw image
      startup.  In saved images, monstartup memory is only
diff --git a/gcl/o/file.d b/gcl/o/file.d
index 569b59c6..b268684e 100755
--- a/gcl/o/file.d
+++ b/gcl/o/file.d
@@ -370,7 +370,7 @@ setup_stream_buffer(object x) {
 #ifdef NO_SETBUF
   massert(!setvbuf(x->sm.sm_fp,x->sm.sm_buffer=NULL,_IONBF,0));
 #else
-  massert(!setvbuf(x->sm.sm_fp,x->sm.sm_buffer=alloc_contblock(BUFSIZ),_IOFBF,BUFSIZ));
+  massert(!setvbuf(x->sm.sm_fp,x->sm.sm_buffer=writable_malloc_wrap(malloc,void *,BUFSIZ),_IOFBF,BUFSIZ));
 #endif
 }	
 
diff --git a/gcl/o/sgbc.c b/gcl/o/sgbc.c
index 0537879f..3db3614d 100755
--- a/gcl/o/sgbc.c
+++ b/gcl/o/sgbc.c
@@ -1282,19 +1282,6 @@ sgc_start(void) {
 	SET_WRITABLE(page(pi));
       else
 	tm_of(pi->type)->tm_alt_npage++;
-#ifndef NO_SETBUF /*FIXME, implement restartable getc with read in readc_stream*/
-      {
-	void *v,*ve;
-	if (pi->type!=(tm=tm_of(t_stream))->tm_type) continue;
-	for (v=pagetochar(page(pi)),ve=v+tm->tm_nppage*tm->tm_size;v<ve;v+=tm->tm_size) {
-	  object x=v;
-	  if (type_of(x)!=t_stream || is_free(x)) continue;
-	  if (x->sm.sm_buffer) 
-	    for (i=page(x->sm.sm_buffer);i<=page(x->sm.sm_buffer+BUFSIZ-1);i++)
-	      SET_WRITABLE(i);
-	}
-      }
-#endif
     }
     for (pi=contblock_list_head;pi;pi=pi->next)/*FIXME*/
       if (pi->sgc_flags&SGC_WRITABLE)
@@ -1302,14 +1289,16 @@ sgc_start(void) {
 	  SET_WRITABLE(page(pi)+i);
       else
 	tm_of(t_contiguous)->tm_alt_npage+=pi->in_use;
-#ifdef GCL_GPROF
     {
-      extern object gprof_array;
-      if (gprof_array!=Cnil)
-	for (i=0;i<(gprof_array->st.st_fillp +PAGESIZE-1)/PAGESIZE;i++)
-	  SET_WRITABLE(page(gprof_array->st.st_self)+i);
+      extern object malloc_list;
+      object x;
+
+      for (x=malloc_list;x!=Cnil;x=x->c.c_cdr)
+	if (x->c.c_car->st.st_adjustable)
+	  for (i=page(x->c.c_car->st.st_self);i<=page(x->c.c_car->st.st_self+x->c.c_car->st.st_fillp-1);i++)
+	    SET_WRITABLE(i);
     }
-#endif
+
     for (i=page(heap_end);i<page(old_rb_start);i++)
 	SET_WRITABLE(i);
     tm_of(t_relocatable)->tm_alt_npage=page(rb_start)-page(old_rb_start);
diff --git a/gcl/o/unixfsys.c b/gcl/o/unixfsys.c
index 8d35564d..4b94facb 100755
--- a/gcl/o/unixfsys.c
+++ b/gcl/o/unixfsys.c
@@ -411,7 +411,7 @@ fopen_not_dir(char *filename,char * option) {
   if (!stat(filename,&ss) && S_ISDIR(ss.st_mode))
     return NULL;
   else
-    return fopen(filename,option);
+    return writable_malloc_wrap(fopen,FILE *,filename,option);
 
 }