/[gcl]/gcl/o/sgbc.c
ViewVC logotype

Diff of /gcl/o/sgbc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.4 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 1  Line 1 
1  /*  Copyright William Schelter. All rights reserved.  /*  Copyright William Schelter. All rights reserved.
2            
3      Stratified Garbage Collection  (SGC)      Stratified Garbage Collection  (SGC)
4        
5      Write protects pages to tell which ones have been written      Write protects pages to tell which ones have been written
6  to recently, for more efficient garbage collection.      to recently, for more efficient garbage collection.
7        
8  */  */
9    
10    
# Line 23  int mprotect(); Line 23  int mprotect();
23    
24  #include <signal.h>  #include <signal.h>
25    
26  void segmentation_catcher();  /*  void segmentation_catcher(void); */
27    
28    
29  #define sgc_mark_pack_list(u)      \  #define sgc_mark_pack_list(u)      \
# Line 35  do {register object xtmp = u;  \ Line 35  do {register object xtmp = u;  \
35    
36    
37  #ifdef SDEBUG  #ifdef SDEBUG
38    object sdebug;  object sdebug;
39  joe1(){;}  joe1(){;}
40  joe() {;}      joe() {;}    
41  #endif  #endif
42    
43  sgc_mark_cons(x)  void
44  object x;  sgc_mark_cons(object x) {
45  {    
46    cs_check(x);    cs_check(x);
47      
48          /*  x is already marked.  */    /*  x is already marked.  */
49      
50  BEGIN:   BEGIN:
51  #ifdef SDEBUG  #ifdef SDEBUG
52        if(x==sdebug) joe1();    if(x==sdebug) joe1();
53  #endif  #endif
54        sgc_mark_object(x->c.c_car);    sgc_mark_object(x->c.c_car);
55  #ifdef OLD  #ifdef OLD
56        IF_WRITABLE(x->c.c_car, goto MARK_CAR;);    IF_WRITABLE(x->c.c_car, goto MARK_CAR;);
57        goto MARK_CDR;    goto MARK_CDR;
58      
59   MARK_CAR:   MARK_CAR:
60     if (x->c.c_car->c.m ==0)    if (x->c.c_car->c.m ==0) {
61          {if (type_of(x->c.c_car) == t_cons)      if (type_of(x->c.c_car) == t_cons) {
62             {        x->c.c_car->c.m = TRUE;
63               x->c.c_car->c.m = TRUE;        sgc_mark_cons(x->c.c_car);
64               sgc_mark_cons(x->c.c_car);      } else
65             }        sgc_mark_object1(x->c.c_car);}
         else  
           sgc_mark_object1(x->c.c_car);}  
 #endif  
66   MARK_CDR:     MARK_CDR:  
67    #endif
68    x = x->c.c_cdr;    x = x->c.c_cdr;
69    IF_WRITABLE(x, goto WRITABLE_CDR;);    IF_WRITABLE(x, goto WRITABLE_CDR;);
70      return;    return;
71   WRITABLE_CDR:   WRITABLE_CDR:
72    if (x->d.m) return;    if (x->d.m) return;
73    if (type_of(x) == t_cons) {    if (type_of(x) == t_cons) {
74                  x->c.m = TRUE;      x->c.m = TRUE;
75                  goto BEGIN;      goto BEGIN;
76          }    }
77    sgc_mark_object1(x);    sgc_mark_object1(x);
78  }  }
79    
# Line 92  BEGIN: Line 90  BEGIN:
90     header, that way we won't have to keep the headers in memory.     header, that way we won't have to keep the headers in memory.
91     This takes only 1.47 as opposed to 1.33 microseconds per set.     This takes only 1.47 as opposed to 1.33 microseconds per set.
92  */  */
93  sgc_mark_object1(x)  void
94  object x;  sgc_mark_object1(object x) {
 {  
         int i, j;  
         object *p;  
         char *cp;  
         object y;  
95    
96          cs_check(x);    int i, j;
97  BEGIN:    object *p;
98      char *cp;
99      
100      cs_check(x);
101     BEGIN:
102  #ifdef SDEBUG  #ifdef SDEBUG
103          if (x == OBJNULL || !ON_WRITABLE_PAGE(x))    if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
104                  return;      return;
105          IF_WRITABLE(x,goto OK);    IF_WRITABLE(x,goto OK);
106          joe();    joe();
107     OK:
108  #endif  #endif
109        OK:    if (x->d.m)
110          if (x->d.m)      return;
                 return;  
111  #ifdef SDEBUG  #ifdef SDEBUG
112          if(x==sdebug) joe1();    if(x==sdebug) joe1();
113  #endif  #endif
114          if (DBEGIN) {    if (DBEGIN)
115            if (NULL_OR_ON_C_STACK(x))      if (NULL_OR_ON_C_STACK(x))
116              return;        return;
117          } /* otherwise if DBEGIN==0 the IF_WRITABLE test will    /* otherwise if DBEGIN==0 the IF_WRITABLE test will
118               always fail on x that satisfy (NULL_OR_ON_C_STACK(x))       always fail on x that satisfy (NULL_OR_ON_C_STACK(x))
119               */    */
120              
121          x->d.m = TRUE;    x->d.m = TRUE;
122          switch (type_of(x)) {    switch (type_of(x)) {
123          case t_fixnum:    case t_fixnum:
124                  break;      break;
125        
126          case t_ratio:    case t_ratio:
127                  sgc_mark_object(x->rat.rat_num);      sgc_mark_object(x->rat.rat_num);
128                  x = x->rat.rat_den;      x = x->rat.rat_den;
129                  IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);      IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
130        
131          case t_shortfloat:    case t_shortfloat:
132                  break;      break;
133        
134          case t_longfloat:    case t_longfloat:
135                  break;      break;
136        
137          case t_complex:    case t_complex:
138                  sgc_mark_object(x->cmp.cmp_imag);      sgc_mark_object(x->cmp.cmp_imag);
139                  x = x->cmp.cmp_real;      x = x->cmp.cmp_real;
140                  IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);      IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
141        
142          case t_character:    case t_character:
143                  break;      break;
144        
145          case t_symbol:    case t_symbol:
146                  IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0)      IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0)
147                              {x->s.s_plist->d.m=TRUE;      {x->s.s_plist->d.m=TRUE;
148                               sgc_mark_cons(x->s.s_plist);});      sgc_mark_cons(x->s.s_plist);});
149                  sgc_mark_object(x->s.s_gfdef);      sgc_mark_object(x->s.s_gfdef);
150                  sgc_mark_object(x->s.s_dbind);      sgc_mark_object(x->s.s_dbind);
151                  if (x->s.s_self == NULL)      if (x->s.s_self == NULL)
152                          break;        break;
153                  /* to do */      /* to do */
154                  if ((int)what_to_collect >= (int)t_contiguous) {      if ((int)what_to_collect >= (int)t_contiguous) {
155                          if (inheap(x->s.s_self)) {        if (inheap(x->s.s_self)) {
156                                  if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
157                                          mark_contblock(x->s.s_self,            mark_contblock(x->s.s_self,
158                                                         x->s.s_fillp);                           x->s.s_fillp);
159                          } else  if(SGC_RELBLOCK_P(x->s.s_self))        } else if(SGC_RELBLOCK_P(x->s.s_self))
160                                  x->s.s_self =          x->s.s_self =
161                                  copy_relblock(x->s.s_self, x->s.s_fillp);            copy_relblock(x->s.s_self, x->s.s_fillp);
162                  }      }
163                  break;      break;
164        
165          case t_package:    case t_package:
166                  sgc_mark_object(x->p.p_name);      sgc_mark_object(x->p.p_name);
167                  sgc_mark_object(x->p.p_nicknames);      sgc_mark_object(x->p.p_nicknames);
168                  sgc_mark_object(x->p.p_shadowings);      sgc_mark_object(x->p.p_shadowings);
169                  sgc_mark_object(x->p.p_uselist);      sgc_mark_object(x->p.p_uselist);
170                  sgc_mark_object(x->p.p_usedbylist);      sgc_mark_object(x->p.p_usedbylist);
171                  if (what_to_collect != t_contiguous)      if (what_to_collect != t_contiguous)
172                          break;        break;
173                  if (x->p.p_internal != NULL)      if (x->p.p_internal != NULL)
174                          mark_contblock((char *)(x->p.p_internal),        mark_contblock((char *)(x->p.p_internal),
175                                         x->p.p_internal_size*sizeof(object));                       x->p.p_internal_size*sizeof(object));
176                  if (x->p.p_external != NULL)      if (x->p.p_external != NULL)
177                          mark_contblock((char *)(x->p.p_external),        mark_contblock((char *)(x->p.p_external),
178                                         x->p.p_external_size*sizeof(object));                       x->p.p_external_size*sizeof(object));
179                  break;      break;
180        
181          case t_cons:    case t_cons:
182  /*      /*
183                  sgc_mark_object(x->c.c_car);        sgc_mark_object(x->c.c_car);
184                  x = x->c.c_cdr;        x = x->c.c_cdr;
185                  goto BEGIN;        goto BEGIN;
186  */      */
187                  sgc_mark_cons(x);      sgc_mark_cons(x);
188                  break;      break;
189        
190          case t_hashtable:    case t_hashtable:
191                  sgc_mark_object(x->ht.ht_rhsize);      sgc_mark_object(x->ht.ht_rhsize);
192                  sgc_mark_object(x->ht.ht_rhthresh);      sgc_mark_object(x->ht.ht_rhthresh);
193                  if (x->ht.ht_self == NULL)      if (x->ht.ht_self == NULL)
194                          break;        break;
195                  for (i = 0, j = x->ht.ht_size;  i < j;  i++) {      for (i = 0, j = x->ht.ht_size;  i < j;  i++) {
196                          sgc_mark_object(x->ht.ht_self[i].hte_key);        sgc_mark_object(x->ht.ht_self[i].hte_key);
197                          sgc_mark_object(x->ht.ht_self[i].hte_value);        sgc_mark_object(x->ht.ht_self[i].hte_value);
198                  }      }
199                  if ((short)what_to_collect >= (short)t_contiguous) {      if ((short)what_to_collect >= (short)t_contiguous) {
200                          if (inheap(x->ht.ht_self)) {        if (inheap(x->ht.ht_self)) {
201                                  if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
202                                      mark_contblock((char *)(x->ht.ht_self),            mark_contblock((char *)(x->ht.ht_self),
203                                                     j * sizeof(struct htent));                           j * sizeof(struct htent));
204                          } else if(SGC_RELBLOCK_P(x->ht.ht_self))        } else if(SGC_RELBLOCK_P(x->ht.ht_self))
205                                  x->ht.ht_self = (struct htent *)          x->ht.ht_self = (struct htent *)
206                                  copy_relblock((char *)(x->ht.ht_self),            copy_relblock((char *)(x->ht.ht_self),
207                                                j * sizeof(struct htent));                          j * sizeof(struct htent));
208                  }      }
209                  break;      break;
210        
211          case t_array:    case t_array:
212                  if ((x->a.a_displaced) != Cnil)      if ((x->a.a_displaced) != Cnil)
213                    sgc_mark_displaced_field(x);        sgc_mark_displaced_field(x);
214                  if ((int)what_to_collect >= (int)t_contiguous &&      if ((int)what_to_collect >= (int)t_contiguous &&
215                      x->a.a_dims != NULL) {          x->a.a_dims != NULL) {
216                          if (inheap(x->a.a_dims)) {        if (inheap(x->a.a_dims)) {
217                                  if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
218                                      mark_contblock((char *)(x->a.a_dims),            mark_contblock((char *)(x->a.a_dims),
219                                                     sizeof(int)*x->a.a_rank);                           sizeof(int)*x->a.a_rank);
220                          } else  if(SGC_RELBLOCK_P(x->a.a_dims))        } else  if(SGC_RELBLOCK_P(x->a.a_dims))
221                                  x->a.a_dims = (int *)          x->a.a_dims = (int *)
222                                  copy_relblock((char *)(x->a.a_dims),            copy_relblock((char *)(x->a.a_dims),
223                                                sizeof(int)*x->a.a_rank);                          sizeof(int)*x->a.a_rank);
224                  }      }
225                  if ((enum aelttype)x->a.a_elttype == aet_ch)      if ((enum aelttype)x->a.a_elttype == aet_ch)
226                          goto CASE_STRING;        goto CASE_STRING;
227                  if ((enum aelttype)x->a.a_elttype == aet_bit)      if ((enum aelttype)x->a.a_elttype == aet_bit)
228                          goto CASE_BITVECTOR;        goto CASE_BITVECTOR;
229                  if ((enum aelttype)x->a.a_elttype == aet_object)      if ((enum aelttype)x->a.a_elttype == aet_object)
230                          goto CASE_GENERAL;        goto CASE_GENERAL;
231        
232          CASE_SPECIAL:    CASE_SPECIAL:
233                  cp = (char *)(x->fixa.fixa_self);      cp = (char *)(x->fixa.fixa_self);
234                  if (cp == NULL)      if (cp == NULL)
235                          break;        break;
236                  /* set j to the size in char of the body of the array */      /* set j to the size in char of the body of the array */
237                        
238                  switch((enum aelttype)x->a.a_elttype){      switch((enum aelttype)x->a.a_elttype){
239                  case aet_lf:      case aet_lf:
240                    j= sizeof(longfloat)*x->lfa.lfa_dim;        j= sizeof(longfloat)*x->lfa.lfa_dim;
241                    if (((int)what_to_collect >= (int)t_contiguous) &&        if (((int)what_to_collect >= (int)t_contiguous) &&
242                          !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))            !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
243                      ROUND_RB_POINTERS_DOUBLE;          ROUND_RB_POINTERS_DOUBLE;
244                    break;        break;
245                  case aet_char:      case aet_char:
246                  case aet_uchar:      case aet_uchar:
247                    j=sizeof(char)*x->a.a_dim;        j=sizeof(char)*x->a.a_dim;
248                    break;        break;
249                  case aet_short:      case aet_short:
250                  case aet_ushort:      case aet_ushort:
251                    j=sizeof(short)*x->a.a_dim;        j=sizeof(short)*x->a.a_dim;
252                    break;        break;
253                  default:      default:
254                    j=sizeof(fixnum)*x->fixa.fixa_dim;}        j=sizeof(fixnum)*x->fixa.fixa_dim;}
255        
256                  goto COPY;      goto COPY;
257        
258          CASE_GENERAL:    CASE_GENERAL:
259                  p = x->a.a_self;      p = x->a.a_self;
260                  if (p == NULL      if (p == NULL
261  #ifdef HAVE_ALLOCA  #ifdef HAVE_ALLOCA
262                     || (char *)p >= core_end          || (char *)p >= core_end
263  #endif    #endif  
264                                
265                      )          )
266                          break;        break;
267                  if (x->a.a_displaced->c.c_car == Cnil)      j=0;
268                          for (i = 0, j = x->a.a_dim;  i < j;  i++)      if (x->a.a_displaced->c.c_car == Cnil)
269                            if (ON_WRITABLE_PAGE(&p[i]))        for (i = 0, j = x->a.a_dim;  i < j;  i++)
270                                  sgc_mark_object(p[i]);          if (ON_WRITABLE_PAGE(&p[i]))
271                  cp = (char *)p;            sgc_mark_object(p[i]);
272                  j *= sizeof(object);      cp = (char *)p;
273          COPY:      j *= sizeof(object);
274                  if ((int)what_to_collect >= (int)t_contiguous) {    COPY:
275                          if (inheap(cp)) {      if ((int)what_to_collect >= (int)t_contiguous) {
276                                  if (what_to_collect == t_contiguous)        if (inheap(cp)) {
277                                          mark_contblock(cp, j);          if (what_to_collect == t_contiguous)
278                          }            mark_contblock(cp, j);
279                          else if (!SGC_RELBLOCK_P(cp)) ;        } else if (!SGC_RELBLOCK_P(cp))
280                          else if (x->a.a_displaced == Cnil){          ;
281          else if (x->a.a_displaced == Cnil) {
282  #ifdef HAVE_ALLOCA  #ifdef HAVE_ALLOCA
283                            if (cp <= core_end)  /* only if body of array not on C stack */          if (cp <= core_end)  /* only if body of array not on C stack */
284  #endif                      #endif                    
285                                  x->a.a_self = (object *)copy_relblock(cp, j);}            x->a.a_self = (object *)copy_relblock(cp, j);
286                          else if (x->a.a_displaced->c.c_car == Cnil) {        }
287                                  i = (int)(object *)copy_relblock(cp, j)        else if (x->a.a_displaced->c.c_car == Cnil) {
288                                    - (int)(x->a.a_self);          i = (int)(object *)copy_relblock(cp, j)
289                                  adjust_displaced(x, i);            - (int)(x->a.a_self);
290                          }          adjust_displaced(x, i);
291                  }        }
292                  break;      }
293        break;
294          case t_vector:      
295                  if ((x->v.v_displaced) != Cnil)    case t_vector:
296                    sgc_mark_displaced_field(x);      if ((x->v.v_displaced) != Cnil)
297                  if ((enum aelttype)x->v.v_elttype == aet_object)        sgc_mark_displaced_field(x);
298                          goto CASE_GENERAL;      if ((enum aelttype)x->v.v_elttype == aet_object)
299                  else        goto CASE_GENERAL;
300                          goto CASE_SPECIAL;      else
301          goto CASE_SPECIAL;
302          case t_bignum:      
303      case t_bignum:
304  #ifdef SDEBUG  #ifdef SDEBUG
305                  if (type_map[page(x->big.big_self)] < t_contiguous)      if (type_map[page(x->big.big_self)] < t_contiguous)
306                    {          printf("bad body for %x (%x)\n",x,cp);
                     printf("bad body for %x (%x)\n",x,cp);  
                       
                   }  
307  #endif  #endif
308  #ifndef GMP  #ifndef GMP
309                  if ((int)what_to_collect >= (int)t_contiguous) {      if ((int)what_to_collect >= (int)t_contiguous) {
310                  j = x->big.big_length;        j = x->big.big_length;
311                  cp = (char *)x->big.big_self;        cp = (char *)x->big.big_self;
312                  if (cp == NULL)        if (cp == NULL)
313                          break;          break;
314                  if  (j != lg(MP(x))  &&        if  (j != lg(MP(x))  &&
315                        /* we don't bother to zero this register,             /* we don't bother to zero this register,
316                           and its contents may get over written */                and its contents may get over written */
317                        ! (x ==  big_register_1 &&             ! (x ==  big_register_1 &&
318                           (int)(cp) <= top &&                (int)(cp) <= top &&
319                           (int) cp >= bot))                (int) cp >= bot))
320                              
321                    printf("bad length 0x%x ",x);          printf("bad length 0x%x ",x);
322                  j = j * sizeof(int);        j = j * sizeof(int);
323          
324                  if (inheap(cp)) {        if (inheap(cp)) {
325                    if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
326                      mark_contblock(cp, j);            mark_contblock(cp, j);
327                  } else {        } else {
328                    if (SGC_RELBLOCK_P(cp))          if (SGC_RELBLOCK_P(cp))
329                      x->big.big_self = (plong *)copy_relblock(cp, j);}}            x->big.big_self = (plong *)copy_relblock(cp, j);}}
330  #endif /* no gmp */  #endif /* no gmp */
331  #ifndef GMP_USE_MALLOC  #ifndef GMP_USE_MALLOC
332                  if ((int)what_to_collect >= (int)t_contiguous) {      if ((int)what_to_collect >= (int)t_contiguous) {
333                    j = MP_ALLOCATED(x);        j = MP_ALLOCATED(x);
334                    cp = (char *)MP_SELF(x);        cp = (char *)MP_SELF(x);
335                    if (cp == 0)        if (cp == 0)
336                      break;          break;
337  #ifdef PARI  #ifdef PARI
338                    if (j != lg(MP(x))  &&        if (j != lg(MP(x))  &&
339                        /* we don't bother to zero this register,            /* we don't bother to zero this register,
340                           and its contents may get over written */               and its contents may get over written */
341                        ! (x == big_register_1 &&            ! (x == big_register_1 &&
342                           (int)(cp) <= top &&               (int)(cp) <= top &&
343                           (int) cp >= bot))               (int) cp >= bot))
344                      printf("bad length 0x%x ",x);          printf("bad length 0x%x ",x);
345  #endif  #endif
346                    j = j * MP_LIMB_SIZE;        j = j * MP_LIMB_SIZE;
347                    if (inheap(cp)) {        if (inheap(cp)) {
348                      if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
349                        mark_contblock(cp, j);            mark_contblock(cp, j);
350                    } else{        } else
351                      if (SGC_RELBLOCK_P(cp))          if (SGC_RELBLOCK_P(cp))
352                         MP_SELF(x) = (void *) copy_relblock(cp, j);}}            MP_SELF(x) = (void *) copy_relblock(cp, j);
353        }
354  #endif /* not GMP_USE_MALLOC */  #endif /* not GMP_USE_MALLOC */
355                  break;      break;
356                        
357        
358          CASE_STRING:    CASE_STRING:
359          case t_string:    case t_string:
360                  if ((x->st.st_displaced) != Cnil)      if ((x->st.st_displaced) != Cnil)
361                    sgc_mark_displaced_field(x);        sgc_mark_displaced_field(x);
362                  j = x->st.st_dim;      j = x->st.st_dim;
363                  cp = x->st.st_self;      cp = x->st.st_self;
364                  if (cp == NULL)      if (cp == NULL)
365                          break;        break;
366        
367          COPY_STRING:    COPY_STRING:
368                  if ((int)what_to_collect >= (int)t_contiguous) {      if ((int)what_to_collect >= (int)t_contiguous) {
369                          if (inheap(cp)) {        if (inheap(cp)) {
370                                  if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
371                                          mark_contblock(cp, j);            mark_contblock(cp, j);
372                          }        }
373                          else if (!SGC_RELBLOCK_P(cp)) ;        else if (!SGC_RELBLOCK_P(cp)) ;
374                          else if (x->st.st_displaced == Cnil)        else if (x->st.st_displaced == Cnil)
375                                  x->st.st_self = copy_relblock(cp, j);          x->st.st_self = copy_relblock(cp, j);
376                          else if (x->st.st_displaced->c.c_car == Cnil) {        else if (x->st.st_displaced->c.c_car == Cnil) {
377                                  i = copy_relblock(cp, j) - cp;          i = copy_relblock(cp, j) - cp;
378                                  adjust_displaced(x, i);          adjust_displaced(x, i);
379                          }        }
380                  }      }
381                  break;      break;
382        
383          CASE_BITVECTOR:    CASE_BITVECTOR:
384          case t_bitvector:    case t_bitvector:
385                  if ((x->bv.bv_displaced) != Cnil)      if ((x->bv.bv_displaced) != Cnil)
386                    sgc_mark_displaced_field(x);        sgc_mark_displaced_field(x);
387  /* We make bitvectors multiple of sizeof(int) in size allocated      /* We make bitvectors multiple of sizeof(int) in size allocated
388   Assume 8 = number of bits in char */         Assume 8 = number of bits in char */
389        
390  #define W_SIZE (8*sizeof(int))  #define W_SIZE (8*sizeof(int))
391                  j= sizeof(int) *      j= sizeof(int) *
392                     ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);        ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
393                  cp = x->bv.bv_self;      cp = x->bv.bv_self;
394                  if (cp == NULL)      if (cp == NULL)
395                          break;        break;
396                  goto COPY_STRING;      goto COPY_STRING;
397        
398          case t_structure:    case t_structure:
399                  sgc_mark_object(x->str.str_def);      sgc_mark_object(x->str.str_def);
400                  p = x->str.str_self;      p = x->str.str_self;
401                  if (p == NULL)      if (p == NULL)
402                          break;        break;
403                  {object def=x->str.str_def;      {
404                   unsigned char * s_type = &SLOT_TYPE(def,0);        object def=x->str.str_def;
405                   unsigned short *s_pos= & SLOT_POS(def,0);        unsigned char * s_type = &SLOT_TYPE(def,0);
406                   for (i = 0, j = S_DATA(def)->length;  i < j;  i++)        unsigned short *s_pos= & SLOT_POS(def,0);
407                     if (s_type[i]==0 &&        for (i = 0, j = S_DATA(def)->length;  i < j;  i++)
408                         ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i]))          if (s_type[i]==0 &&
409                         )              ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i]))
410                       sgc_mark_object(STREF(object,x,s_pos[i]));              )
411                   if ((int)what_to_collect >= (int)t_contiguous) {            sgc_mark_object(STREF(object,x,s_pos[i]));
412                       if (inheap(x->str.str_self)) {        if ((int)what_to_collect >= (int)t_contiguous) {
413                         if (what_to_collect == t_contiguous)          if (inheap(x->str.str_self)) {
414                           mark_contblock((char *)p,            if (what_to_collect == t_contiguous)
415                                          S_DATA(def)->size);              mark_contblock((char *)p,
416                               S_DATA(def)->size);
417                       } else if(SGC_RELBLOCK_P(p))            
418                         x->str.str_self = (object *)          } else if(SGC_RELBLOCK_P(p))
419                           copy_relblock((char *)p, S_DATA(def)->size);            x->str.str_self = (object *)
420                     }}              copy_relblock((char *)p, S_DATA(def)->size);
421                  break;        }
422        }
423          case t_stream:      break;
424                  switch (x->sm.sm_mode) {      
425                  case smm_input:    case t_stream:
426                  case smm_output:      switch (x->sm.sm_mode) {
427                  case smm_io:      case smm_input:
428                  case smm_socket:        case smm_output:
429                  case smm_probe:      case smm_io:
430                          sgc_mark_object(x->sm.sm_object0);      case smm_socket:  
431                          sgc_mark_object(x->sm.sm_object1);      case smm_probe:
432                          if (saving_system)        sgc_mark_object(x->sm.sm_object0);
433                            {FILE *fp = x->sm.sm_fp;        sgc_mark_object(x->sm.sm_object1);
434                               if (fp != 0 && fp != stdin && fp !=stdout        if (saving_system) {
435                                   )          FILE *fp = x->sm.sm_fp;
436                               {fclose(fp);          if (fp != 0 && fp != stdin && fp !=stdout) {
437                                x->sm.sm_fp=0;            fclose(fp);
438                              }}            x->sm.sm_fp=0;
439                          else          }
440                          if (what_to_collect == t_contiguous &&        }
441                              x->sm.sm_fp &&        else
442                              x->sm.sm_buffer)          if (what_to_collect == t_contiguous &&
443                                  mark_contblock(x->sm.sm_buffer, BUFSIZ);              x->sm.sm_fp &&
444                          break;              x->sm.sm_buffer)
445              mark_contblock(x->sm.sm_buffer, BUFSIZ);
446                  case smm_synonym:        break;
447                          sgc_mark_object(x->sm.sm_object0);        
448                          break;      case smm_synonym:
449          sgc_mark_object(x->sm.sm_object0);
450                  case smm_broadcast:        break;
451                  case smm_concatenated:        
452                          sgc_mark_object(x->sm.sm_object0);      case smm_broadcast:
453                          break;      case smm_concatenated:
454          sgc_mark_object(x->sm.sm_object0);
455                  case smm_two_way:        break;
456                  case smm_echo:        
457                          sgc_mark_object(x->sm.sm_object0);      case smm_two_way:
458                          sgc_mark_object(x->sm.sm_object1);      case smm_echo:
459                          break;        sgc_mark_object(x->sm.sm_object0);
460          sgc_mark_object(x->sm.sm_object1);
461                  case smm_string_input:        break;
462                  case smm_string_output:        
463                          sgc_mark_object(x->sm.sm_object0);      case smm_string_input:
464                          break;      case smm_string_output:
465          sgc_mark_object(x->sm.sm_object0);
466          break;
467  #ifdef USER_DEFINED_STREAMS  #ifdef USER_DEFINED_STREAMS
468                  case smm_user_defined:      case smm_user_defined:
469                          sgc_mark_object(x->sm.sm_object0);        sgc_mark_object(x->sm.sm_object0);
470                          sgc_mark_object(x->sm.sm_object1);        sgc_mark_object(x->sm.sm_object1);
471                          break;        break;
472  #endif  #endif
473                  default:      default:
474                          error("mark stream botch");        error("mark stream botch");
475                  }      }
476                  break;      break;
477        
478          case t_random:    case t_random:
479                  break;      break;
480        
481          case t_readtable:    case t_readtable:
482                  if (x->rt.rt_self == NULL)      if (x->rt.rt_self == NULL)
483                          break;        break;
484                  if (what_to_collect == t_contiguous)      if (what_to_collect == t_contiguous)
485                          mark_contblock((char *)(x->rt.rt_self),        mark_contblock((char *)(x->rt.rt_self),
486                                         RTABSIZE*sizeof(struct rtent));                       RTABSIZE*sizeof(struct rtent));
487                  for (i = 0;  i < RTABSIZE;  i++) {      for (i = 0;  i < RTABSIZE;  i++) {
488                          sgc_mark_object(x->rt.rt_self[i].rte_macro);        sgc_mark_object(x->rt.rt_self[i].rte_macro);
489                          if (x->rt.rt_self[i].rte_dtab != NULL) {        if (x->rt.rt_self[i].rte_dtab != NULL) {
 /**/  
490          if (what_to_collect == t_contiguous)          if (what_to_collect == t_contiguous)
491                  mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),            mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
492                                 RTABSIZE*sizeof(object));                           RTABSIZE*sizeof(object));
493          for (j = 0;  j < RTABSIZE;  j++)          for (j = 0;  j < RTABSIZE;  j++)
494                  sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);            sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
495  /**/        }
496                          }      }
497                  }      break;
498                  break;      
499      case t_pathname:
500          case t_pathname:      sgc_mark_object(x->pn.pn_host);
501                  sgc_mark_object(x->pn.pn_host);      sgc_mark_object(x->pn.pn_device);
502                  sgc_mark_object(x->pn.pn_device);      sgc_mark_object(x->pn.pn_directory);
503                  sgc_mark_object(x->pn.pn_directory);      sgc_mark_object(x->pn.pn_name);
504                  sgc_mark_object(x->pn.pn_name);      sgc_mark_object(x->pn.pn_type);
505                  sgc_mark_object(x->pn.pn_type);      sgc_mark_object(x->pn.pn_version);
506                  sgc_mark_object(x->pn.pn_version);      break;
507                  break;      
508      case t_closure:
509        case t_closure:      {
510         { int i ;        int i ;
511           if (what_to_collect == t_contiguous)        if (what_to_collect == t_contiguous)
512                mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim);          mark_contblock(x->cc.cc_turbo,x->cc.cc_envdim);
513           for (i= 0 ; i < x->cc.cc_envdim ; i++) {        for (i= 0 ; i < x->cc.cc_envdim ; i++)
514             sgc_mark_object(x->cc.cc_turbo[i]);}}          sgc_mark_object(x->cc.cc_turbo[i]);
515        }
516        
517          case t_cfun:    case t_cfun:
518          case t_sfun:    case t_sfun:
519          case t_vfun:    case t_vfun:
520          case t_afun:    case t_afun:
521          case t_gfun:    case t_gfun:
522                  sgc_mark_object(x->cf.cf_name);      sgc_mark_object(x->cf.cf_name);
523                  sgc_mark_object(x->cf.cf_data);      sgc_mark_object(x->cf.cf_data);
524                  break;      break;
525                        
526          case t_cfdata:    case t_cfdata:
527        
528                  if (x->cfd.cfd_self != NULL)      if (x->cfd.cfd_self != NULL) {
529                    {int i=x->cfd.cfd_fillp;        int i=x->cfd.cfd_fillp;
530                     while(i-- > 0)        while(i-- > 0)
531                       sgc_mark_object(x->cfd.cfd_self[i]);}          sgc_mark_object(x->cfd.cfd_self[i]);
532                  if (x->cfd.cfd_start == NULL)      }
533                          break;      if (x->cfd.cfd_start == NULL)
534                  if (what_to_collect == t_contiguous) {        break;
535                          if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||      if (what_to_collect == t_contiguous) {
536                              get_mark_bit((int *)(x->cfd.cfd_start)))        if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||
537                                  break;            get_mark_bit((int *)(x->cfd.cfd_start)))
538                          mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);}          break;
539                  break;        mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
540          case t_cclosure:      }
541                  sgc_mark_object(x->cc.cc_name);      break;
542                  sgc_mark_object(x->cc.cc_env);    case t_cclosure:
543                  sgc_mark_object(x->cc.cc_data);      sgc_mark_object(x->cc.cc_name);
544                  if (what_to_collect == t_contiguous) {      sgc_mark_object(x->cc.cc_env);
545                    if (x->cc.cc_turbo != NULL)      sgc_mark_object(x->cc.cc_data);
546                      mark_contblock((char *)(x->cc.cc_turbo-1),      if (what_to_collect == t_contiguous) {
547                                     (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));        if (x->cc.cc_turbo != NULL)
548                  }          mark_contblock((char *)(x->cc.cc_turbo-1),
549                  break;                         (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
550        }
551          case t_spice:      break;
552                  break;      
553      case t_spice:
554          default:      break;
555        
556      default:
557  #ifdef DEBUG  #ifdef DEBUG
558                  if (debug)      if (debug)
559                          printf("\ttype = %d\n", type_of(x));        printf("\ttype = %d\n", type_of(x));
560  #endif  #endif
561                  error("mark botch");      error("mark botch");
562          }    }
563              
564  }  }
565    
566    void
567    sgc_mark_stack_carefully(void *topv, void *bottomv, int offset) {
568      
569      int p,m,pageoffset;
570      object x;
571      struct typemanager *tm;
572      register long *j;
573      long *top=topv,*bottom=bottomv;
574      
575      /* if either of these happens we are marking the C stack
576         and need to use a local */
577      
578      if (top==0) top = c_stack_where;
579      if (bottom==0) bottom= c_stack_where;
580      
581      /* On machines which align local pointers on multiple of 2 rather
582         than 4 we need to mark twice
583      */
584      
585      if (offset)
586        sgc_mark_stack_carefully((((char *) top) +offset),bottom,0);
587      for (j=top ; j >= bottom ; j--) {
588        if (VALID_DATA_ADDRESS_P(*j)
589            && type_map[(p=page(*j))]< (char)t_end) {
590          pageoffset=((char *)*j - pagetochar(p));
591          tm=tm_of((enum type) type_map[p]);
592          x= (object)
593            ((char *)(*j) -
594             ((pageoffset=((char *)*j - pagetochar(p))) %
595              tm->tm_size));
596          if ((pageoffset <  (tm->tm_size * tm->tm_nppage))
597              && (m=x->d.m) != FREE) {
598            if (m==TRUE) continue;
599            if (m!=0) {
600              fprintf(stdout,
601                      "**bad value %d of d.m in gbc page %d skipping mark**"
602                      ,m,p);fflush(stdout);
603              continue;
604            }
605            sgc_mark_object(x);
606          }
607        }
608      }
609    }
610    
611    void
612    sgc_mark_phase(void) {
613    
614  sgc_mark_stack_carefully(top,bottom,offset)    STATIC int i, j;
615  long *bottom,*top;    STATIC struct package *pp;
616  {int p,m,pageoffset;    STATIC bds_ptr bdp;
617   object x;    STATIC frame_ptr frp;
618   struct typemanager *tm;    STATIC ihs_ptr ihsp;
619   register long *j;    
620      sgc_mark_object(Cnil);
621   /* if either of these happens we are marking the C stack    sgc_mark_object(Ct);
622      and need to use a local */    
623      /* mark all non recent data on writable pages */
624   if (top==0) top = c_stack_where;    {
625   if (bottom==0) bottom= c_stack_where;      int t,i=page(heap_end);
626        struct typemanager *tm;
627   /* On machines which align local pointers on multiple of 2 rather      char *p;
628      than 4 we need to mark twice      
629     */      while (--i >= 0) {
630          if (WRITABLE_PAGE_P(i)
631   if (offset) {sgc_mark_stack_carefully((((char *) top) +offset),bottom,0);}            && (t=type_map[i]) < (int) t_end)
632   for (j=top ; j >= bottom ; j--)          ;
633     {if (VALID_DATA_ADDRESS_P(*j)        else
634          && type_map[(p=page(*j))]< (char)t_end)          continue;
635        {pageoffset=((char *)*j - pagetochar(p));        tm=tm_of(t);
636         tm=tm_of((enum type) type_map[p]);        p=pagetochar(i);
637         x= (object)        if ( t == t_cons)
638           ((char *)(*j) -          for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons)) {
639            ((pageoffset=((char *)*j - pagetochar(p))) %            object x = (object) p;
640             tm->tm_size));            if (SGC_OR_M(x))
641         if ((pageoffset <  (tm->tm_size * tm->tm_nppage))              continue;
642             && (m=x->d.m) != FREE)            if (x->d.t==t_cons) {
643         {if (m==TRUE) continue;              x->d.m = TRUE;
644            if (m!=0)              sgc_mark_cons(x);
645              {fprintf(stdout,            } else
646                       "**bad value %d of d.m in gbc page %d skipping mark**"              sgc_mark_object1(x);
                      ,m,p);fflush(stdout);  
              continue;  
            };  
           sgc_mark_object(x);}}}}  
   
   
 sgc_mark_phase()  
 {  
         STATIC object *p;  
         STATIC int i, j, k, n;  
         STATIC struct package *pp;  
         STATIC object s, l, *lp;  
         STATIC bds_ptr bdp;  
         STATIC frame_ptr frp;  
         STATIC ihs_ptr ihsp;  
         STATIC char *cp;  
   
         sgc_mark_object(Cnil);  
         sgc_mark_object(Ct);  
   
           
   
     /* mark all non recent data on writable pages */  
         {int t,i=page(heap_end);  
          struct typemanager *tm;  
          char *p;  
           
          while (--i >= 0)  
            {if (WRITABLE_PAGE_P(i)  
                   && (t=type_map[i]) < (int) t_end);  
            else continue;  
             tm=tm_of(t);  
             p=pagetochar(i);  
             if ( t == t_cons)  
               for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons))  
               {object x = (object) p;  
                if (SGC_OR_M(x)) continue;  
                if (x->d.t==t_cons) {x->d.m = TRUE; sgc_mark_cons(x);}  
                else  
                  sgc_mark_object1(x);  
              }  
             else  
               {int size=tm->tm_size;  
                for (j = tm->tm_nppage; --j >= 0; p += size)  
                  {object x = (object) p;  
                   if (SGC_OR_M(x)) continue;  
                   sgc_mark_object1(x);  
             }}}}  
   
   
         sgc_mark_stack_carefully(vs_top-1,vs_org,0);  
         clear_stack(vs_top,vs_limit);  
         sgc_mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);  
         /*  
         for (p = vs_org;  p < vs_top;  p++) {  
           if (p && (inheap(*p)))  
                 sgc_mark_object(*p);  
647          }          }
648          */        else {
649  #ifdef DEBUG          int size=tm->tm_size;
650          if (debug) {          for (j = tm->tm_nppage; --j >= 0; p += size) {
651                  printf("value stack marked\n");            object x = (object) p;
652                  fflush(stdout);            if (SGC_OR_M(x)) continue;
653              sgc_mark_object1(x);
654          }          }
655          }
656        }
657      }
658      
659      sgc_mark_stack_carefully(vs_top-1,vs_org,0);
660      clear_stack(vs_top,vs_limit);
661      sgc_mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
662      /*
663         for (p = vs_org;  p < vs_top;  p++) {
664         if (p && (inheap(*p)))
665         sgc_mark_object(*p);
666         }
667      */
668    #ifdef DEBUG
669      if (debug) {
670        printf("value stack marked\n");
671        fflush(stdout);
672      }
673  #endif  #endif
674      
675          for (bdp = bds_org;  bdp<=bds_top;  bdp++) {    for (bdp = bds_org;  bdp<=bds_top;  bdp++) {
676                  sgc_mark_object(bdp->bds_sym);      sgc_mark_object(bdp->bds_sym);
677                  sgc_mark_object(bdp->bds_val);      sgc_mark_object(bdp->bds_val);
678          }    }
679      
680          for (frp = frs_org;  frp <= frs_top;  frp++)    for (frp = frs_org;  frp <= frs_top;  frp++)
681                  sgc_mark_object(frp->frs_val);      sgc_mark_object(frp->frs_val);
682      
683          for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++)    for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++)
684                  sgc_mark_object(ihsp->ihs_function);      sgc_mark_object(ihsp->ihs_function);
685      
686          for (i = 0;  i < mark_origin_max;  i++)    for (i = 0;  i < mark_origin_max;  i++)
687                  sgc_mark_object(*mark_origin[i]);      sgc_mark_object(*mark_origin[i]);
688          for (i = 0;  i < mark_origin_block_max;  i++)    for (i = 0;  i < mark_origin_block_max;  i++)
689                  for (j = 0;  j < mark_origin_block[i].mob_size;  j++)      for (j = 0;  j < mark_origin_block[i].mob_size;  j++)
690                          sgc_mark_object(mark_origin_block[i].mob_addr[j]);        sgc_mark_object(mark_origin_block[i].mob_addr[j]);
691      
692          for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)    for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)
693                  sgc_mark_object((object)pp);      sgc_mark_object((object)pp);
694  #ifdef KCLOVM  #ifdef KCLOVM
695          if (ovm_process_created)    if (ovm_process_created)
696            sgc_mark_all_stacks();      sgc_mark_all_stacks();
697  #endif  #endif
698      
699  #ifdef DEBUG  #ifdef DEBUG
700          if (debug) {    if (debug) {
701                  printf("symbol navigation\n");      printf("symbol navigation\n");
702                  fflush(stdout);      fflush(stdout);
703          }    }
704  #endif    #endif  
705          {int size;    {
706                int size;
707           for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {    
708                          size = pp->p_internal_size;      for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {
709                          if (pp->p_internal != NULL)        size = pp->p_internal_size;
710                                  for (i = 0;  i < size;  i++)        if (pp->p_internal != NULL)
711                                          sgc_mark_pack_list(pp->p_internal[i]);          for (i = 0;  i < size;  i++)
712                          size = pp->p_external_size;            sgc_mark_pack_list(pp->p_internal[i]);
713                          if (pp->p_external != NULL)        size = pp->p_external_size;
714                                  for (i = 0;  i < size;  i++)        if (pp->p_external != NULL)
715                                          sgc_mark_pack_list(pp->p_external[i]);          for (i = 0;  i < size;  i++)
716                  }}            sgc_mark_pack_list(pp->p_external[i]);
717        }
718      }
719          mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully);    
720      mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully);
721      
722  }  }
723    
724  sgc_sweep_phase()  void
725  {  sgc_sweep_phase(void) {
726          STATIC int i, j, k;    STATIC int i, j, k;
727          STATIC object x;    STATIC object x;
728          STATIC char *p;    STATIC char *p;
729          STATIC int *ip;    STATIC struct typemanager *tm;
730          STATIC struct typemanager *tm;    STATIC object f;
731          STATIC object f;    int size;
732          int size;    
733      Cnil->s.m = FALSE;
734          Cnil->s.m = FALSE;    Ct->s.m = FALSE;
735          Ct->s.m = FALSE;    
   
736  #ifdef DEBUG  #ifdef DEBUG
737          if (debug)    if (debug)
738                  printf("type map\n");      printf("type map\n");
739  #endif  #endif
740          for (i = 0;  i < maxpage;  i++) {    for (i = 0;  i < maxpage;  i++) {
741                  if (type_map[i] == (int)t_contiguous) {      if (type_map[i] == (int)t_contiguous) {
742                          if (debug) {        if (debug) {
743                                  printf("-");          printf("-");
                         /*  
                                 fflush(stdout);  
                         */  
                                 continue;  
                         }  
                 }  
                 if (type_map[i] >= (int)t_end)  
                         continue;  
   
                 tm = tm_of((enum type)type_map[i]);  
   
744          /*          /*
745                  general sweeper            fflush(stdout);
746          */          */
747            continue;
748          }
749        }
750        if (type_map[i] >= (int)t_end)
751          continue;
752        
753        tm = tm_of((enum type)type_map[i]);
754        
755        /*
756          general sweeper
757        */
758        
759  #ifdef DEBUG  #ifdef DEBUG
760                  if (debug) {      if (debug) {
761                          printf("%c", tm->tm_name[0]);        printf("%c", tm->tm_name[0]);
762                  /*        /*
763                          fflush(stdout);          fflush(stdout);
764                  */        */
765                  }      }
766  #endif  #endif
767                  if (!WRITABLE_PAGE_P(i)) continue;      if (!WRITABLE_PAGE_P(i))
768                  p = pagetochar(i);        continue;
769                  f = tm->tm_free;      p = pagetochar(i);
770                  k = 0;      f = tm->tm_free;
771                  size=tm->tm_size;      k = 0;
772                  if (SGC_PAGE_P(i)) {      size=tm->tm_size;
773                  for (j = tm->tm_nppage; --j >= 0;  p += size) {      if (SGC_PAGE_P(i)) {
774                          x = (object)p;        for (j = tm->tm_nppage; --j >= 0;  p += size) {
775            x = (object)p;
776                          if (x->d.m == FREE)          
777                                  continue;          if (x->d.m == FREE)
778                          else if (x->d.m) {            continue;
779                                  x->d.m = FALSE;          else if (x->d.m) {
780                                  continue;            x->d.m = FALSE;
781                          }            continue;
782                          if(x->d.s == SGC_NORMAL)          }
783                            continue;          if(x->d.s == SGC_NORMAL)
784                                      continue;
785                          /* it is ok to free x */          
786                                    /* it is ok to free x */
787            
788  #ifdef OLD_DISPLACE  #ifdef OLD_DISPLACE
789                          /* old_displace: from might be free, to not */          /* old_displace: from might be free, to not */
790                          if(x->d.t >=t_array && x->d.t <= t_bitvector)          if(x->d.t >=t_array && x->d.t <= t_bitvector) {
791                            {            /*                    case t_array:
792                              /*                  case t_array:                                  case t_vector:
793                                                  case t_vector:                                  case t_string:
794                                                  case t_string:                                  case t_bitvector:
795                                                  case t_bitvector:            */                    
796                                                  */                                  if (x->a.a_displaced->c.c_car != Cnil) {
797                                  if (x->a.a_displaced->c.c_car != Cnil)              undisplace(x);
798                                    {undisplace(x);              /* The cons x->a.a_displaced cons has been saved,
799                   /* The cons x->a.a_displaced cons has been saved,                 so as to save the pointer to x->a.a_displaced->c.c_car;
800                      so as to save the pointer to x->a.a_displaced->c.c_car;                 However any arrays in its cdr, must have been
801                      However any arrays in its cdr, must have been                 freed, or we would not be freeing x.   To avoid
802                      freed, or we would not be freeing x.   To avoid                 having a cons with trash in the cdr we set the
803                      having a cons with trash in the cdr we set the                 cdr to nil
804                      cdr to nil              */                              
805                      */                                            x->a.a_displaced->c.c_cdr = Cnil;
806                               x->a.a_displaced->c.c_cdr = Cnil;}            }
807                          }          }
808  #endif OLD_DISPLACE  #endif OLD_DISPLACE
809  #ifdef GMP_USE_MALLOC                    #ifdef GMP_USE_MALLOC                  
810                          if (x->d.t == t_bignum) {          if (x->d.t == t_bignum)
811                            mpz_clear(MP(x));            mpz_clear(MP(x));
812                          }  #endif
813  #endif          
814            SET_LINK(x,f);
815                          SET_LINK(x,f);          x->d.m = FREE;
816                          x->d.m = FREE;          x->d.s = (int)SGC_RECENT;
817                          x->d.s = (int)SGC_RECENT;          f = x;
818                          f = x;          k++;
819                          k++;        }
820                  }        tm->tm_free = f;
821                  tm->tm_free = f;        tm->tm_nfree += k;
822                  tm->tm_nfree += k;      }
823                }      else /*non sgc_page */
824                  else /*non sgc_page */        for (j = tm->tm_nppage; --j >= 0;  p += size) {
825                  for (j = tm->tm_nppage; --j >= 0;  p += size) {          x = (object)p;
826                          x = (object)p;          if (x->d.m == TRUE) x->d.m=FALSE;
827          }
828                          if (x->d.m == TRUE) x->d.m=FALSE;      
829                  }    }
                     
   
         NEXT_PAGE:  
                 ;  
         }  
830  #ifdef DEBUG  #ifdef DEBUG
831          if (debug) {    if (debug) {
832                  putchar('\n');      putchar('\n');
833                  fflush(stdout);      fflush(stdout);
834          }    }
835  #endif  #endif
836  }  }
837    
838    
839  sgc_contblock_sweep_phase()  void
840  {  sgc_contblock_sweep_phase(void) {
841          STATIC int i, j;  
842          STATIC char *s, *e, *p, *q;    STATIC int i, j;
843          STATIC struct contblock *cbp;    STATIC char *s, *e, *p, *q;
844      STATIC struct contblock *cbp;
845          cb_pointer = NULL;    
846          ncb = 0;    cb_pointer = NULL;
847          for (i = 0;  i < maxpage;) {    ncb = 0;
848                  if (type_map[i] != (int)t_contiguous    for (i = 0;  i < maxpage;) {
849                      || !SGC_PAGE_P(i))      if (type_map[i] != (int)t_contiguous
850                       {          || !SGC_PAGE_P(i)) {
851                          i++;        i++;
852                          continue;        continue;
853                  }      }
854                  for (j = i+1;      for (j = i+1;
855                       j < maxpage && type_map[j] == (int)t_contiguous           j < maxpage && type_map[j] == (int)t_contiguous
856                       && SGC_PAGE_P(j)             && SGC_PAGE_P(j);
857                       ;           j++);
858                       j++)      s = pagetochar(i);
859                          ;            e = pagetochar(j);
860                  s = pagetochar(i);      for (p = s;  p < e;) {
861                  e = pagetochar(j);        if (get_mark_bit((int *)p)) {
862                  for (p = s;  p < e;) {          p += PTR_ALIGN;
863                          if (get_mark_bit((int *)p)) {          continue;
864                                  p += PTR_ALIGN;        }
865                                  continue;        q = p + PTR_ALIGN;
866                          }        while (q < e) {
867                          q = p + PTR_ALIGN;          if (!get_mark_bit((int *)q)) {
868                          while (q < e) {            q += PTR_ALIGN;
869                                  if (!get_mark_bit((int *)q)) {            continue;
                                         q += PTR_ALIGN;  
                                         continue;  
                                 }  
                                 break;  
                         }  
                         insert_contblock(p, q - p);  
                         p = q + PTR_ALIGN;  
                 }  
                 i = j + 1;  
870          }          }
871            break;
872          }
873          insert_contblock(p, q - p);
874          p = q + PTR_ALIGN;
875        }
876        i = j + 1;
877      }
878  #ifdef DEBUG  #ifdef DEBUG
879          if (debug) {    if (debug) {
880                  for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)      for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
881                          printf("%d-byte contblock\n", cbp->cb_size);        printf("%d-byte contblock\n", cbp->cb_size);
882                  fflush(stdout);      fflush(stdout);
883          }    }
884  #endif  #endif
885  }  }
886    
# Line 891  char *old_rb_start; Line 893  char *old_rb_start;
893    
894  #undef tm  #undef tm
895    
   
   
896  #ifdef SDEBUG  #ifdef SDEBUG
897  sgc_count(yy)  sgc_count(object yy) {
898       object yy;    int count=0;
899  {int count=0;    object y=yy;
900   object y=yy;    while(y)
901   while(y)      {count++;
    {count++;  
902      y=OBJ_LINK(y);}      y=OBJ_LINK(y);}
903   printf("[length %x = %d]",yy,count);    printf("[length %x = %d]",yy,count);
904   fflush(stdout);    fflush(stdout);
905  }  }
906    
907  #endif  #endif
908  /* count writable pages excluding the hole */  /* count writable pages excluding the hole */
909  sgc_count_writable(end)  int
910       int end;  sgc_count_writable(int end) {
911  { int j = first_protectable_page -1;  
912      int j = first_protectable_page -1;
913    int count = 0;    int count = 0;
914    int hp_end= page(heap_end);    int hp_end= page(heap_end);
915    while(j++ < hp_end)    while(j++ < hp_end)
# Line 917  sgc_count_writable(end) Line 917  sgc_count_writable(end)
917    j= page(rb_start);    j= page(rb_start);
918    while(j++ < end)    while(j++ < end)
919      if (WRITABLE_PAGE_P(j)) count++;      if (WRITABLE_PAGE_P(j)) count++;
920    return count;}    return count;
921    }
922    
923    
924    int
925    sgc_count_type(int t) {
926    
927  sgc_count_type(t)    int j = first_protectable_page -1;
      int t;  
 {int j = first_protectable_page -1;  
928    int end = page(core_end);    int end = page(core_end);
929    int count=0;    int count=0;
930    while(j++ < end)    while(j++ < end)
931      if (type_map[j]==t && SGC_PAGE_P(j))      if (type_map[j]==t && SGC_PAGE_P(j))
932        count++;        count++;
933    return count;}    return count;
934    }
   
   
935    
936    int
937    sgc_start(void) {
938    
939  sgc_start()    int i;
940  {int i;    int np;
941   int np;    short free_map[MAXPAGE];
942   int bug;    object f;
943   short free_map[MAXPAGE];    struct typemanager *tm;
944   object f, fr[(int)t_end];    int npages;
945   struct typemanager *tm;    if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE)
946   int npages;      perm_writable(&sgc_type_map[0],sizeof(sgc_type_map));
947   if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE )    if (sgc_enabled)
948     {perm_writable(&sgc_type_map[0],sizeof(sgc_type_map));      return 1;
949    }    sgc_type_map[0]=0;
950   if (sgc_enabled)    i=npages=page(core_end);
951       return 1;    while (i--> 0)
952   sgc_type_map[0]=0;      sgc_type_map[i] = sgc_type_map[i]  & SGC_PERM_WRITABLE ;
953  AGAIN:    
954   i=npages=page(core_end);    for (i= t_start; i < t_contiguous ; i++)
955   while (i--> 0)      if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc))
956     sgc_type_map[i] = sgc_type_map[i]  & SGC_PERM_WRITABLE ;        FIND_FREE_PAGES:
957        {
958   for (i= t_start; i < t_contiguous ; i++)        int maxp=0;
959     if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc))        int j;
960       FIND_FREE_PAGES:        int minfree = tm->tm_sgc_minfree;
961       {        int count;
962         int maxp=0;        bzero(free_map,npages*sizeof(short));
963         int j;        f = tm->tm_free;
964         int minfree = tm->tm_sgc_minfree;        count=0;
965         int count,tm_sgc;        while (f!=0) {
966         bzero(free_map,npages*sizeof(short));          free_map[j=page(f)]++;
967         f = tm->tm_free;          if (j>=maxp) maxp=j;
        count=0;  
        while (f!=0)  
          {free_map[j=page(f)]++;  
           if (j>=maxp) maxp=j;  
968  #ifdef DEBUG  #ifdef DEBUG
969            count++;          count++;
970  #endif      #endif    
971            f= OBJ_LINK(f);          f= OBJ_LINK(f);
972          }        }
973  #ifdef DEBUG        #ifdef DEBUG      
974         if (count!=tm->tm_nfree)        if (count!=tm->tm_nfree)
975           {printf("[Count differed type(%d)nfree= %d in freelist %d]\n"          printf("[Count differed type(%d)nfree= %d in freelist %d]\n"
976                   ,tm->tm_type,tm->tm_nfree,                 ,tm->tm_type,tm->tm_nfree,
977                   count);fflush(stdout);}                 count);fflush(stdout);
978  #endif        #endif      
979         for(j=0,count=0; j <= maxp ;j++)        for(j=0,count=0; j <= maxp ;j++) {
980           {if (free_map[j] >= minfree)          if (free_map[j] >= minfree) {
981              {sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);            sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
982               ++count;            ++count;
983              if (count >= tm->tm_sgc_max)            if (count >= tm->tm_sgc_max)
984                 break;              break;
985             }}            }
986          }
987         /* don't do any more allocations  for this type if saving system */        
988         if (saving_system) continue;        /* don't do any more allocations  for this type if saving system */
989                if (saving_system)
990         if (count < tm->tm_sgc)          continue;
991           /* try to get some more free pages of type i */        
992           { int n = tm->tm_sgc - count;        if (count < tm->tm_sgc) {
993             int again=0,nfree = tm->tm_nfree;          /* try to get some more free pages of type i */
994             char *p=alloc_page(n);          int n = tm->tm_sgc - count;
995             if (tm->tm_nfree > nfree) again=1;  /* gc freed some objects */          int again=0,nfree = tm->tm_nfree;
996             while (n-- > 0)          char *p=alloc_page(n);
997               {(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0);          if (tm->tm_nfree > nfree) again=1;  /* gc freed some objects */
998                p += PAGESIZE;}          while (n-- > 0) {
999             if (again) goto FIND_FREE_PAGES;      }}            (sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0);
1000              p += PAGESIZE;
1001            }
1002            if (again)
1003              goto FIND_FREE_PAGES;  
1004          }
1005        }
1006    /* Now  allocate the sgc relblock.   We do this as the tail    /* Now  allocate the sgc relblock.   We do this as the tail
1007      end of the ordinary rb.     */         end of the ordinary rb.     */  
1008    {int want;    {
1009    char *new;      int want;
1010    tm=tm_of(t_relocatable);      char *new;
1011    want =((int) (rb_end - rb_pointer) >> PAGEWIDTH);      tm=tm_of(t_relocatable);
1012    if (want < tm->tm_sgc) want = tm->tm_sgc;      want =((int) (rb_end - rb_pointer) >> PAGEWIDTH);
1013     else { want  = (want < 4 ? want : want -2);}      if (want < tm->tm_sgc) want = tm->tm_sgc;
1014        else
1015   FINALE:        want  = (want < 4 ? want : want -2);
1016    {old_rb_start=rb_start;      
1017     if(!saving_system)      {
1018     { new=alloc_relblock(want*PAGESIZE);        old_rb_start=rb_start;
1019       /* the above may cause a gc, shifting the relblock */        if(!saving_system) {
1020       old_rb_start=rb_start;          new=alloc_relblock(want*PAGESIZE);
1021      new= PAGE_ROUND_UP(new);          /* the above may cause a gc, shifting the relblock */
1022      rb_start=rb_pointer=new;          old_rb_start=rb_start;
1023    }}}          new= PAGE_ROUND_UP(new);
1024     /* the relblock has been allocated */          rb_start=rb_pointer=new;
1025          }
1026        }
1027      }
1028      /* the relblock has been allocated */
1029      
1030    /* now move the sgc free lists into place.   alt_free should    /* now move the sgc free lists into place.   alt_free should
1031       contain the others */       contain the others */
1032      
1033    for (i= t_start; i < t_contiguous ; i++)    for (i= t_start; i < t_contiguous ; i++)
1034      if (TM_BASE_TYPE_P(i)      if (TM_BASE_TYPE_P(i)
1035          && (np=(tm=tm_of(i))->tm_sgc))          && (np=(tm=tm_of(i))->tm_sgc)) {
1036        {object f=tm->tm_free ,x,y,next;        object f=tm->tm_free ,x,y,next;
1037         int count=0;        int count=0;
1038         x=y=0;        x=y=0;
1039          
1040            while (f!=0)        while (f!=0) {
1041              {next=OBJ_LINK(f);          next=OBJ_LINK(f);
1042  #ifdef SDEBUG          #ifdef SDEBUG        
1043               if (f->d.m!=FREE)          if (f->d.m!=FREE)
1044                 printf("Not FREE in freelist f=%d",f);            printf("Not FREE in freelist f=%d",f);
1045  #endif  #endif
1046               if (ON_SGC_PAGE(f))          if (ON_SGC_PAGE(f)) {
1047                 { SET_LINK(f,x);            SET_LINK(f,x);
1048                   f->d.s = SGC_RECENT;            f->d.s = SGC_RECENT;
1049                   x=f;            x=f;
1050                   count++;            count++;
1051                 }          } else {
1052               else            SET_LINK(f,y);
1053                 {SET_LINK(f,y);            f->d.s = SGC_NORMAL;
1054                  f->d.s = SGC_NORMAL;            y=f;
1055                  y=f;}          }
1056               f=next;          f=next;
1057             }        }
1058          tm->tm_free = x;        tm->tm_free = x;
1059          tm->tm_alt_free = y;        tm->tm_alt_free = y;
1060          tm->tm_alt_nfree = tm->tm_nfree - count;        tm->tm_alt_nfree = tm->tm_nfree - count;
1061          tm->tm_nfree=count;        tm->tm_nfree=count;
1062       }      }
1063        
1064     /* Whew.   We have now allocated the sgc space    /* Whew.   We have now allocated the sgc space
1065        and modified the tm_table;       and modified the tm_table;
1066        Turn  memory protection on for the pages which are writable.       Turn  memory protection on for the pages which are writable.
1067      */    */
1068     memory_protect(1);    memory_protect(1);
1069     sgc_enabled=1;    sgc_enabled=1;
1070    if(sSAnotify_gbcA->s.s_dbind != Cnil)    if (sSAnotify_gbcA->s.s_dbind != Cnil) {
1071     {printf("[SGC on]"); fflush(stdout);}      printf("[SGC on]");
1072        fflush(stdout);
1073      }
1074    
1075      return 1;
1076      
1077  }  }
1078    
1079  sgc_quit()  int
1080  { struct typemanager *tm;  sgc_quit(void) {
1081    
1082      struct typemanager *tm;
1083    int i,np;    int i,np;
1084    
1085    memory_protect(0);    memory_protect(0);
1086    if(sSAnotify_gbcA->s.s_dbind != Cnil)    if(sSAnotify_gbcA->s.s_dbind != Cnil)
1087     {printf("[SGC off]"); fflush(stdout);}      printf("[SGC off]"); fflush(stdout);
1088    if (sgc_enabled==0) return 0;    if (sgc_enabled==0)
1089        return 0;
1090    sgc_enabled=0;    sgc_enabled=0;
1091    rb_start = old_rb_start;    rb_start = old_rb_start;
1092    for (i= t_start; i < t_contiguous ; i++)    for (i= t_start; i < t_contiguous ; i++)
1093     if (TM_BASE_TYPE_P(i))      if (TM_BASE_TYPE_P(i)) {
1094       {tm=tm_of(i);        tm=tm_of(i);
1095       if (np=tm->tm_sgc)        if ((np=tm->tm_sgc)) {
1096         {object f,y;          object f,y;
1097          f=tm->tm_free;          f=tm->tm_free;
1098          if (f==0) tm->tm_free=tm->tm_alt_free;          if (f==0)
1099          else            tm->tm_free=tm->tm_alt_free;
1100            else {
1101            /* tack the alt_free onto the end of free */            /* tack the alt_free onto the end of free */
           {  
1102  #ifdef SDEBUG  #ifdef SDEBUG
1103              int count=0;            int count=0;
1104              f=tm->tm_free;            f=tm->tm_free;
1105              while(y= (object) F_LINK(f))            while(y= (object) F_LINK(f)) {
1106                {if(y->d.s != SGC_RECENT)              if(y->d.s != SGC_RECENT)
1107                  printf("[bad %d]",y);                printf("[bad %d]",y);
1108                 count++; f=y;}              count++; f=y;
1109              }
1110              count=0;            
1111              if (f=tm->tm_alt_free)            count=0;
1112                while(y= F_LINK(f))            if (f=tm->tm_alt_free)
1113                  {              while(y= F_LINK(f)) {
1114                    if(y->d.s != SGC_NORMAL)                if(y->d.s != SGC_NORMAL)
1115                      printf("[alt_bad %d]",y);                  printf("[alt_bad %d]",y);
1116                    count++; f=y;}                count++; f=y;
1117                            }
1118  #endif            
1119              f=tm->tm_free;  #endif
1120              while(y= (object) F_LINK(f))            f=tm->tm_free;
1121               f=y;            while((y= (object) F_LINK(f)))
1122             F_LINK(f)= (long)(tm->tm_alt_free);              f=y;
1123             }            F_LINK(f)= (long)(tm->tm_alt_free);
1124            }
1125          /* tm->tm_free has all of the free objects */          /* tm->tm_free has all of the free objects */
1126          tm->tm_nfree += tm->tm_alt_nfree;          tm->tm_nfree += tm->tm_alt_nfree;
1127          tm->tm_alt_nfree = 0;          tm->tm_alt_nfree = 0;
1128          tm->tm_alt_free = 0;          tm->tm_alt_free = 0;
1129                    
1130          /* remove the recent flag from any objects on sgc pages */          /* remove the recent flag from any objects on sgc pages */
1131          {int hp=page(heap_end);          {
1132           int i,j;            int hp=page(heap_end);
1133           char t = (char) tm->tm_type;            int i,j;
1134           char *p;            char t = (char) tm->tm_type;
1135             for (i=0 ; i < hp; i++)            char *p;
1136               if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG))            for (i=0 ; i < hp; i++)
1137                  for (p= pagetochar(i),j = tm->tm_nppage;              if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG))
1138                       j > 0; --j, p += tm->tm_size)                for (p= pagetochar(i),j = tm->tm_nppage;
1139                    {((object) p)->d.s = SGC_NORMAL;}}                     j > 0; --j, p += tm->tm_size)
1140                    ((object) p)->d.s = SGC_NORMAL;
1141            }
1142          }
1143        }
1144    
1145      return 0;
1146    
       }}  
1147  }  }
1148    
1149  void  void
1150  make_writable(beg,i)  make_writable(int beg, int i) {
1151       int beg,i;  
1152  {if (i > beg)    if (i > beg) {
1153     {beg=ROUND_DOWN_PAGE_NO(beg);      beg=ROUND_DOWN_PAGE_NO(beg);
1154      i=ROUND_UP_PAGE_NO(i);      i=ROUND_UP_PAGE_NO(i);
1155      {int k=beg;      {
1156       while(k <i )        int k=beg;
1157         sgc_type_map[k++] |= SGC_TEMP_WRITABLE;        while(k <i )
1158       }          sgc_type_map[k++] |= SGC_TEMP_WRITABLE;
1159        }
1160      sgc_mprotect(beg, i-beg, SGC_WRITABLE);      sgc_mprotect(beg, i-beg, SGC_WRITABLE);
1161      ;}    }
1162  }  }
1163    
1164  int debug_fault =0;  int debug_fault =0;
1165  int fault_count =0;  int fault_count =0;
1166  extern char etext;  extern char etext;
1167  void memprotect_handler();  /*  void memprotect_handler(int sig, int code, struct sigcontext *scp, char *addr); */
1168  void  void
1169  memprotect_handler(sig, code, scp, addr)  memprotect_handler(int sig, int code, struct sigcontext *scp, char *addr) {
1170            int sig, code;    
1171            struct sigcontext *scp;    int p;
1172            char *addr;        int j=page_multiple;
1173  {int p;    char *faddr;  /* Needed because we must not modify signal handler
1174   int j=page_multiple;                     arguments on the stack! */
  char *faddr;  /* Needed because we must not modify signal handler  
                   arguments on the stack! */  
1175  #ifdef GET_FAULT_ADDR  #ifdef GET_FAULT_ADDR
1176    faddr=GET_FAULT_ADDR(sig,code,scp,addr);    faddr=GET_FAULT_ADDR(sig,code,scp,addr);
1177   debug_fault = (int) faddr;    debug_fault = (int) faddr;
1178  #ifdef DEBUG_MPROTECT  #ifdef DEBUG_MPROTECT
1179   printf("fault:0x%x [%d] (%d)  ",faddr,page(faddr),faddr >= core_end);    printf("fault:0x%x [%d] (%d)  ",faddr,page(faddr),faddr >= core_end);
1180  #endif  #endif
1181   if (faddr >= core_end || (unsigned int)faddr < DBEGIN)    if (faddr >= core_end || (unsigned int)faddr < DBEGIN) {
1182     {if (fault_count > 300) error("fault count too high");      if (fault_count > 300) error("fault count too high");
1183        fault_count ++;      fault_count ++;
1184          INSTALL_MPROTECT_HANDLER;      INSTALL_MPROTECT_HANDLER;
1185      return;}      return;
1186      }
1187  #else  #else
1188   faddr = addr;    faddr = addr;
1189  #endif  #endif
1190   p = page(faddr);    p = page(faddr);
1191   p = ROUND_DOWN_PAGE_NO(p);    p = ROUND_DOWN_PAGE_NO(p);
1192   if (p >= first_protectable_page    if (p >= first_protectable_page
1193       && faddr < core_end        && faddr < core_end
1194       && !(WRITABLE_PAGE_P(p)))        && !(WRITABLE_PAGE_P(p))) {
1195     {/*   CHECK_RANGE(p,1); */      /*   CHECK_RANGE(p,1); */
1196  #ifdef DEBUG_MPROTECT  #ifdef DEBUG_MPROTECT
1197       printf("mprotect(0x%x,0x%x,0x%x)\n",      printf("mprotect(0x%x,0x%x,0x%x)\n",
1198              pagetochar(p),page_multiple * PAGESIZE, sbrk(0));             pagetochar(p),page_multiple * PAGESIZE, sbrk(0));
1199       fflush(stdout);      fflush(stdout);
1200  #endif      #endif    
1201       mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE);      mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE);
1202      while (--j >= 0)      while (--j >= 0)
1203        sgc_type_map[p+j] = sgc_type_map[p+j] | SGC_TEMP_WRITABLE;        sgc_type_map[p+j] = sgc_type_map[p+j] | SGC_TEMP_WRITABLE;
1204        
1205  #ifndef BSD  #ifndef BSD
1206   INSTALL_MPROTECT_HANDLER;      INSTALL_MPROTECT_HANDLER;
1207  #endif  #endif
1208        
1209      return;      return;
1210    }    }
1211      
1212  #ifndef  BSD  #ifndef  BSD
1213   INSTALL_MPROTECT_HANDLER;    INSTALL_MPROTECT_HANDLER;
1214  #endif  #endif
1215  /* if (SIGSEGV == SIGPROTV) */    /* if (SIGSEGV == SIGPROTV) */
1216   END:    segmentation_catcher(SIGSEGV);
1217   segmentation_catcher();  
  return;  
1218  }  }
1219    
1220  sgc_mprotect(pbeg,n,writable)  void
1221  { /* CHECK_RANGE(pbeg,n);  */  sgc_mprotect(int pbeg, int n, int writable) {
1222      /* CHECK_RANGE(pbeg,n);  */
1223  #ifdef DEBUG_MPROTECT  #ifdef DEBUG_MPROTECT
1224    printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,    printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,
1225           (writable  & SGC_WRITABLE ? "writable" : "not writable"));           (writable  & SGC_WRITABLE ? "writable" : "not writable"));
# Line 1208  sgc_mprotect(pbeg,n,writable) Line 1228  sgc_mprotect(pbeg,n,writable)
1228    fflush(stdout);    fflush(stdout);
1229  #endif    #endif  
1230    if(mprotect(pagetochar(pbeg),n*PAGESIZE,    if(mprotect(pagetochar(pbeg),n*PAGESIZE,
1231               (writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ)))                (writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ)))
1232     FEerror("Couldn't protect",0);}      FEerror("Couldn't protect",0);
1233    }
1234    
1235    
1236  /* for page numbers from beg below end,  /* for page numbers from beg below end,
1237     if one page in a a page_multiple grouping is writable,the     if one page in a a page_multiple grouping is writable,the
1238     rest must be */     rest must be */
1239    
1240  fix_for_page_multiple(beg,end)  void
1241  {int i,j;  fix_for_page_multiple(int beg, int end) {
1242   char *p;  
1243   int writable;    int i,j;
1244   beg = ROUND_DOWN_PAGE_NO(beg);    char *p;
1245   for (i = beg ; i < end; i = i+ page_multiple){    int writable;
1246     p = sgc_type_map + i;  
1247     j = page_multiple;    beg = ROUND_DOWN_PAGE_NO(beg);
1248     writable = ((*p++) & SGC_WRITABLE);    for (i = beg ; i < end; i = i+ page_multiple){
1249     if (writable)      p = sgc_type_map + i;
1250       /* all pages must be */      j = page_multiple;
1251       { while (--j)      writable = ((*p++) & SGC_WRITABLE);
1252           if (((*p++) & SGC_WRITABLE)  == 0)      if (writable) {
1253             goto FIXIT;}        /* all pages must be */
1254     else        while (--j)
1255       { while (--j)          if (((*p++) & SGC_WRITABLE)  == 0)
1256           if ((*p++) & SGC_WRITABLE )            goto FIXIT;}
1257             goto FIXIT;}      else
1258     continue;        while (--j)
1259   FIXIT:          if ((*p++) & SGC_WRITABLE )
1260     j = page_multiple;            goto FIXIT;
1261     p = sgc_type_map + i;      continue;
1262     while (--j >= 0 )    FIXIT:
1263       { (*p++) |= SGC_WRITABLE;}}}      j = page_multiple;
1264            p = sgc_type_map + i;
1265        while (--j >= 0 )
1266  memory_protect(on)        (*p++) |= SGC_WRITABLE;
1267       int on;    }
1268  { int i,beg,end= page(core_end);  }
1269    
1270    
1271    void
1272    memory_protect(int on) {
1273    
1274      int i,beg,end= page(core_end);
1275    int writable=1;    int writable=1;
1276    extern void   install_segmentation_catcher();    extern void   install_segmentation_catcher(void);
1277    if (first_protectable_page==0)  
1278    {    if (first_protectable_page==0) {
1279      for (i=page_multiple; i< maxpage ; i++)      for (i=page_multiple; i< maxpage ; i++)
1280        if (type_map[i]!=t_other)        if (type_map[i]!=t_other)
1281          break;          break;
1282        else {        else {
1283          /* We want page(0) to be non writable since that          /* We want page(0) to be non writable since that
1284             is the only check for 0 pointer in sgc */             is the only check for 0 pointer in sgc */
1285            sgc_type_map[i] = SGC_PERM_WRITABLE;}          sgc_type_map[i] = SGC_PERM_WRITABLE;
1286      first_protectable_page= ROUND_DOWN_PAGE_NO(i);}        }
1287        first_protectable_page= ROUND_DOWN_PAGE_NO(i);
1288      }
1289    if(page_multiple > 1)    if(page_multiple > 1)
1290      fix_for_page_multiple(first_protectable_page,end);      fix_for_page_multiple(first_protectable_page,end);
1291      /* turning it off */    /* turning it off */
1292    if (on==0) {sgc_mprotect((first_protectable_page),    if (on==0) {sgc_mprotect((first_protectable_page),
1293                         (end - first_protectable_page), SGC_WRITABLE);                             (end - first_protectable_page), SGC_WRITABLE);
1294                install_segmentation_catcher();    install_segmentation_catcher();
1295                return;}    return;
1296      }
1297    /* write protect some pages by first write protecting them    /* write protect some pages by first write protecting them
1298       all and then selectively disabling */       all and then selectively disabling */
1299  /*  sgc_mprotect((first_protectable_page),    /*  sgc_mprotect((first_protectable_page),
1300                         (end - first_protectable_page), 0);        (end - first_protectable_page), 0);
1301  */    */
1302    INSTALL_MPROTECT_HANDLER;    INSTALL_MPROTECT_HANDLER;
1303    beg=first_protectable_page;    beg=first_protectable_page;
1304    writable = WRITABLE_PAGE_P(beg);    writable = WRITABLE_PAGE_P(beg);
1305    for (i=beg ; ++i<= end; )    for (i=beg ; ++i<= end; ) {
1306      {int wri = WRITABLE_PAGE_P(i);      int wri = WRITABLE_PAGE_P(i);
1307       if ((wri==0 && writable)      if ((wri==0 && writable)
1308           || (writable ==0  && wri)          || (writable ==0  && wri)
1309           || i == end)          || i == end) {
1310         /* it is changing */        /* it is changing */
1311         {if (writable)        if (writable)
1312            make_writable(beg,i);          make_writable(beg,i);
1313          else        else
1314           sgc_mprotect(beg,i-beg,writable);          sgc_mprotect(beg,i-beg,writable);
1315          writable = wri;        writable = wri;
1316          beg = i;}        beg = i;
1317     }      }
1318      }
1319  }  }
1320    
1321  void  void
1322  siLsgc_on()  siLsgc_on(void) {
 {if (vs_base==vs_top)  
    {vs_base[0]=(sgc_enabled ? Ct :Cnil);  
     vs_top=vs_base+1; return;}  
  check_arg(1);  
  if(vs_base[0]==Cnil)  
      {sgc_quit();}  
  else {sgc_start();}}  
1323    
1324      if (vs_base==vs_top) {
1325        vs_base[0]=(sgc_enabled ? Ct :Cnil);
1326        vs_top=vs_base+1; return;
1327      }
1328      check_arg(1);
1329      if(vs_base[0]==Cnil)
1330        sgc_quit();
1331      else sgc_start();
1332    }
1333    
1334  /* make permanently writable pages containing pointers p thru p+n-1 */  /* make permanently writable pages containing pointers p thru p+n-1 */
1335      
     
1336  void  void
1337  perm_writable(p,n)  perm_writable(char *p, int n) {
1338       char *p;  
1339       int n;    int beg=page(p);
1340  {int beg=page(p);    int end=page(PAGE_ROUND_UP(p+n));
1341   int end=page(PAGE_ROUND_UP(p+n));    int i,must_protect=0;
1342   int i,must_protect=0;  
1343   beg = ROUND_DOWN_PAGE_NO(beg);    beg = ROUND_DOWN_PAGE_NO(beg);
1344   end = ROUND_UP_PAGE_NO(end);    end = ROUND_UP_PAGE_NO(end);
1345   for (i=beg ; i < end ; i++)    for (i=beg ; i < end ; i++) {
1346     {if (sgc_enabled & !(WRITABLE_PAGE_P(i))) must_protect = 1;      if (sgc_enabled & !(WRITABLE_PAGE_P(i)))
1347      sgc_type_map [i] |= SGC_PERM_WRITABLE;}        must_protect = 1;
1348   if(must_protect) make_writable(beg,end);}      sgc_type_map [i] |= SGC_PERM_WRITABLE;
1349      }
1350      if(must_protect)
1351        make_writable(beg,end);
1352    }
1353    
1354    void
1355    system_error(void) {
1356      FEerror("System error",0);
1357    }
1358    
1359    
1360    
1361    
1362    
1363    
1364    
1365    
1366    
1367    
1368    
1369    
1370    
1371    
1372    
1373    
1374    
1375    
1376    
1377    
1378    
1379    
1380    
1381    
1382    
1383    
1384    
1385    
1386    
1387    
1388    
1389    
1390    
1391    
1392    
1393    
1394    
1395    
1396    
1397    
1398    
1399    
1400    
1401    
1402    
1403    
1404    
1405    
1406    
1407    
1408    
1409    
1410    
1411    
1412    
1413    
1414    
1415    
1416    
1417    
1418    
1419    
1420    
1421    
1422    
1423    
1424    
1425    
1426    
1427    
1428    
1429    
1430    
1431    
1432    
1433    
1434    
1435    
1436    
1437    
1438    
1439    
1440    
1441    
1442    
1443    
1444    
 system_error()  
 {FEerror("System error",0);}  
1445    
1446    
1447    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26