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

Diff of /gcl/o/alloc.c

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

revision 1.8 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.9 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 24  Foundation, 675 Mass Ave, Cambridge, MA Line 24  Foundation, 675 Mass Ave, Cambridge, MA
24          IMPLEMENTATION-DEPENDENT          IMPLEMENTATION-DEPENDENT
25  */  */
26    
27    /*  #define _GNU_SOURCE */
28    #include <string.h>
29    
30  #include "include.h"  #include "include.h"
31  #include "page.h"  #include "page.h"
32    
# Line 31  DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_h Line 34  DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_h
34  DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,"");  DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,"");
35  #define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil)  #define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil)
36    
37  void call_after_gbc_hook();  void call_after_gbc_hook(int t);
38    
39  #ifdef DEBUG_SBRK  #ifdef DEBUG_SBRK
40  int debug;  int debug;
# Line 60  long new_holepage; Line 63  long new_holepage;
63          (real_maxpage-page(heap_end)-new_holepage-2*nrbpage-real_maxpage/32)          (real_maxpage-page(heap_end)-new_holepage-2*nrbpage-real_maxpage/32)
64    
65    
66  #ifdef UNIX  /*  #ifdef UNIX */
67  extern char *sbrk();  /*  extern char *sbrk(int n); */
68  #endif  /*  #endif */
69    
70  #ifdef BSD  #ifdef BSD
71  #include <sys/time.h>  #include <sys/time.h>
# Line 85  int reserve_pages_for_signal_handler =30 Line 88  int reserve_pages_for_signal_handler =30
88     reserve_pages_for_signal_handler pages on hand in the hole     reserve_pages_for_signal_handler pages on hand in the hole
89   */   */
90  char *  char *
91  alloc_page(n)  alloc_page(int n)
 int n;  
92  {  {
93          char *e;          char *e;
94          int m;          int m;
# Line 105  int n; Line 107  int n;
107                            {fprintf(stderr,                            {fprintf(stderr,
108                                     "Cant do relocatable gc in signal handler. \                                     "Cant do relocatable gc in signal handler. \
109  Try to allocate more space to save for allocation during signals: \  Try to allocate more space to save for allocation during signals: \
110  eg to add 20 more do (si::set-hole-size %d %d)\n...start over ", new_holepage, 20+ reserve_pages_for_signal_handler); fflush(stderr); exit(1);}  eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ", new_holepage, 20+ reserve_pages_for_signal_handler); fflush(stderr); exit(1);}
111    
112                          GBC(t_relocatable);                          GBC(t_relocatable);
113                          if (in_sgc)                          if (in_sgc)
# Line 145  eg to add 20 more do (si::set-hole-size Line 147  eg to add 20 more do (si::set-hole-size
147  }  }
148    
149  void  void
150  add_page_to_freelist(p,tm)  add_page_to_freelist(char *p, struct typemanager *tm)
      char *p;  
      struct typemanager *tm;  
151  {short t,size;  {short t,size;
152   int i=tm->tm_nppage,fw;   int i=tm->tm_nppage,fw;
153   int nn;   int nn;
# Line 192  add_page_to_freelist(p,tm) Line 192  add_page_to_freelist(p,tm)
192  }  }
193    
194  object  object
195  type_name(t)  type_name(int t)
      int t;  
196  { return make_simple_string(tm_table[(int)t].tm_name+1);}  { return make_simple_string(tm_table[(int)t].tm_name+1);}
197    
198    
# Line 209  call_after_gbc_hook(t) Line 208  call_after_gbc_hook(t)
208    
209    
210  object  object
211  alloc_object(t)  alloc_object(enum type t)
 enum type t;  
212  {  {
213           object obj;           object obj;
214           struct typemanager *tm;           struct typemanager *tm;
          int i;  
215           char *p;           char *p;
          object x, f;  
216    
217  ONCE_MORE:  ONCE_MORE:
218          tm = tm_of(t);          tm = tm_of(t);
# Line 272  EXHAUSTED: Line 268  EXHAUSTED:
268  Currently, ~D pages are allocated.~%\  Currently, ~D pages are allocated.~%\
269  Use ALLOCATE to expand the space.",  Use ALLOCATE to expand the space.",
270                  "Continues execution.",                  "Continues execution.",
271                  2, vs_top[-2], vs_top[-1]);                  2, vs_top[-2], vs_top[-1], Cnil, Cnil);
272          vs_pop;          vs_popp;
273          vs_pop;          vs_popp;
274          call_after_gbc_hook(t);          call_after_gbc_hook(t);
275          goto ONCE_MORE;          goto ONCE_MORE;
276  }  }
277    
278  grow_linear(old,fract,grow_min,grow_max)  int
279       int old,grow_min,grow_max,fract;  grow_linear(int old, int fract, int grow_min, int grow_max) {
280  {int delt;    
281   if(fract==0) fract=50;    int delt;
282   if(grow_min==0) grow_min=1;    if (fract==0)
283   if(grow_max==0) grow_max=1000;      fract=50;
284   delt=(old*fract)/100;    if (grow_min==0)
285   delt= (delt < grow_min ? grow_min:      grow_min=1;
286          delt > grow_max ? grow_max:    if (grow_max==0)
287          delt);      grow_max=1000;
288   return old + delt;}  
289      delt=(old*fract)/100;
290      delt= (delt < grow_min ? grow_min:
291             delt > grow_max ? grow_max:
292             delt);
293    
294      return old + delt;
295    
296    }
297    
298  object  object
299  make_cons(a, d)  make_cons(object a, object d)
 object a, d;  
300  {  {
301           object obj;           object obj;
          int i;  
302           char *p;           char *p;
          object x, f;  
303          struct typemanager *tm=(&tm_table[(int)t_cons]);          struct typemanager *tm=(&tm_table[(int)t_cons]);
 /* #define      tm      (&tm_table[(int)t_cons])*/  
304    
305  ONCE_MORE:  ONCE_MORE:
306          CHECK_INTERRUPT;          CHECK_INTERRUPT;
# Line 352  EXHAUSTED: Line 352  EXHAUSTED:
352  Currently, ~D pages are allocated.~%\  Currently, ~D pages are allocated.~%\
353  Use ALLOCATE to expand the space.",  Use ALLOCATE to expand the space.",
354                  "Continues execution.",                  "Continues execution.",
355                  1, vs_top[-1]);                  1, vs_top[-1],Cnil,Cnil,Cnil);
356          vs_pop;          vs_popp;
357          call_after_gbc_hook(t_cons);          call_after_gbc_hook(t_cons);
358          goto ONCE_MORE;          goto ONCE_MORE;
359  #undef  tm  #undef  tm
360  }  }
361    
362    
363  object on_stack_cons(x,y)  object on_stack_cons(object x, object y)
      object x,y;  
364  {object p = (object) alloca_val;  {object p = (object) alloca_val;
365   p->c.t= (short)t_cons;   p->c.t= (short)t_cons;
366   p->c.m=FALSE;   p->c.m=FALSE;
# Line 459  ONCE_MORE: Line 458  ONCE_MORE:
458                  CEerror("Contiguous blocks exhausted.~%\                  CEerror("Contiguous blocks exhausted.~%\
459  Currently, ~D pages are allocated.~%\  Currently, ~D pages are allocated.~%\
460  Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.",  Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.",
461                          "Continues execution.", 1, vs_head);                          "Continues execution.", 1, vs_head,Cnil,Cnil,Cnil);
462                  vs_pop;                  vs_popp;
463                  g = FALSE;                  g = FALSE;
464                  call_after_gbc_hook(t_contiguous);                  call_after_gbc_hook(t_contiguous);
465                  goto ONCE_MORE;                  goto ONCE_MORE;
# Line 475  Use ALLOCATE-CONTIGUOUS-PAGES to expand Line 474  Use ALLOCATE-CONTIGUOUS-PAGES to expand
474          return(p);          return(p);
475  }  }
476    
477    void
478    insert_contblock(char *p, int s) {
479    
480  insert_contblock(p, s)    struct contblock **cbpp, *cbp;
481  char *p;    
482  int s;    if (s < CBMINSIZE)
483  {      return;
484          struct contblock **cbpp, *cbp;    ncb++;
485      cbp = (struct contblock *)p;
486      cbp->cb_size = s;
487      for (cbpp = &cb_pointer;  *cbpp;  cbpp = &((*cbpp)->cb_link))
488        if ((*cbpp)->cb_size >= s) {
489          cbp->cb_link = *cbpp;
490          *cbpp = cbp;
491          return;
492        }
493      cbp->cb_link = NULL;
494      *cbpp = cbp;
495    
         if (s < CBMINSIZE)  
                 return;  
         ncb++;  
         cbp = (struct contblock *)p;  
         cbp->cb_size = s;  
         for (cbpp = &cb_pointer;  *cbpp;  cbpp = &((*cbpp)->cb_link))  
                 if ((*cbpp)->cb_size >= s) {  
                         cbp->cb_link = *cbpp;  
                         *cbpp = cbp;  
                         return;  
                 }  
         cbp->cb_link = NULL;  
         *cbpp = cbp;  
496  }  }
497    
498  void *  void *
# Line 554  ONCE_MORE: Line 552  ONCE_MORE:
552                  CEerror("Relocatable blocks exhausted.~%\                  CEerror("Relocatable blocks exhausted.~%\
553  Currently, ~D pages are allocated.~%\  Currently, ~D pages are allocated.~%\
554  Use ALLOCATE-RELOCATABLE-PAGES to expand the space.",  Use ALLOCATE-RELOCATABLE-PAGES to expand the space.",
555                          "Continues execution.", 1, vs_head);                          "Continues execution.", 1, vs_head,Cnil,Cnil,Cnil);
556                  vs_pop;                  vs_popp;
557                  g = FALSE;                  g = FALSE;
558                  call_after_gbc_hook(t_relocatable);                  call_after_gbc_hook(t_relocatable);
559                  goto ONCE_MORE;                  goto ONCE_MORE;
# Line 565  Use ALLOCATE-RELOCATABLE-PAGES to expand Line 563  Use ALLOCATE-RELOCATABLE-PAGES to expand
563          return(p);          return(p);
564  }  }
565    
566  init_tm(t, name, elsize, nelts,sgc)  void
567  enum type t;  init_tm(enum type t, char *name, int elsize, int nelts, int sgc) {
568  char name[];  
569  int elsize, nelts;    int i, j;
570  {    int maxpage;
571          int i, j;    /* round up to next number of pages */
572          int maxpage;    maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
573          /*elsize=elsize<sizeof(struct freelist) ? sizeof(struct freelist) : elsize;*/    tm_table[(int)t].tm_name = name;
574          /* round up to next number of pages */    for (j = -1, i = 0;  i < (int)t_end;  i++)
575          maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);      if (tm_table[i].tm_size != 0 &&
576          tm_table[(int)t].tm_name = name;          tm_table[i].tm_size >= elsize &&
577          for (j = -1, i = 0;  i < (int)t_end;  i++)          (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
578                  if (tm_table[i].tm_size != 0 &&        j = i;
579                      tm_table[i].tm_size >= elsize &&    if (j >= 0) {
580                      (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))      tm_table[(int)t].tm_type = (enum type)j;
581                          j = i;      tm_table[j].tm_maxpage += maxpage;
         if (j >= 0) {  
                 tm_table[(int)t].tm_type = (enum type)j;  
                 tm_table[j].tm_maxpage += maxpage;  
582  #ifdef SGC                #ifdef SGC              
583                  tm_table[j].tm_sgc += sgc;      tm_table[j].tm_sgc += sgc;
584  #endif  #endif
585                  return;      return;
586          }    }
587          tm_table[(int)t].tm_type = t;    tm_table[(int)t].tm_type = t;
588          tm_table[(int)t].tm_size = ROUND_UP_PTR(elsize);    tm_table[(int)t].tm_size = ROUND_UP_PTR(elsize);
589          tm_table[(int)t].tm_nppage = PAGESIZE/ROUND_UP_PTR(elsize);    tm_table[(int)t].tm_nppage = PAGESIZE/ROUND_UP_PTR(elsize);
590          tm_table[(int)t].tm_free = OBJNULL;    tm_table[(int)t].tm_free = OBJNULL;
591          tm_table[(int)t].tm_nfree = 0;    tm_table[(int)t].tm_nfree = 0;
592          tm_table[(int)t].tm_nused = 0;    tm_table[(int)t].tm_nused = 0;
593          /*tm_table[(int)t].tm_npage = 0; */  /* dont zero nrbpage.. */    /*tm_table[(int)t].tm_npage = 0; */  /* dont zero nrbpage.. */
594          tm_table[(int)t].tm_maxpage = maxpage;    tm_table[(int)t].tm_maxpage = maxpage;
595          tm_table[(int)t].tm_gbccount = 0;    tm_table[(int)t].tm_gbccount = 0;
596  #ifdef SGC        #ifdef SGC      
597          tm_table[(int)t].tm_sgc = sgc;    tm_table[(int)t].tm_sgc = sgc;
598          tm_table[(int)t].tm_sgc_max = 3000;    tm_table[(int)t].tm_sgc_max = 3000;
599          tm_table[(int)t].tm_sgc_minfree = (int)    tm_table[(int)t].tm_sgc_minfree = (int)
600            (0.4 * tm_table[(int)t].tm_nppage);      (0.4 * tm_table[(int)t].tm_nppage);
601  #endif  #endif
602      
603  }  }
604    
605  set_maxpage()  void
606  {  set_maxpage(void) {
607    
608    /* This is run in init.  Various initializations including getting    /* This is run in init.  Various initializations including getting
609       maxpage are here */       maxpage are here */
610  #ifdef SGC  #ifdef SGC
# Line 618  set_maxpage() Line 614  set_maxpage()
614      {memory_protect(1);}      {memory_protect(1);}
615    if (~(-MAXPAGE) != MAXPAGE-1) error("MAXPAGE must be power of 2");    if (~(-MAXPAGE) != MAXPAGE-1) error("MAXPAGE must be power of 2");
616    if (core_end)    if (core_end)
617       bzero(&sgc_type_map[ page(core_end)],MAXPAGE- page(core_end));      bzero(&sgc_type_map[ page(core_end)],MAXPAGE- page(core_end));
618  #else  #else
619    page_multiple=1;    page_multiple=1;
620  #endif  #endif
621        
622  SET_REAL_MAXPAGE;    SET_REAL_MAXPAGE;
623    
624  }  }
625    
626    
627    
628    
629    void
630    init_alloc(void) {
631    
632  init_alloc()    int i;
633  {    static int initialized;
634          int i, j;    
635          struct typemanager *tm;    if (initialized) return;
636          char *p, *q;    initialized=1;
637          enum type t;    
638          int c;    
         static initialized;  
   
         if (initialized) return;  
         initialized=1;  
           
   
639  #ifndef DONT_NEED_MALLOC          #ifndef DONT_NEED_MALLOC        
640      
641          {    {
642                  extern object malloc_list;      extern object malloc_list;
643                  malloc_list = Cnil;      malloc_list = Cnil;
644                  enter_mark_origin(&malloc_list);      enter_mark_origin(&malloc_list);
645          }    }
646  #endif    #endif  
647      
648          holepage = INIT_HOLEPAGE;    holepage = INIT_HOLEPAGE;
649          new_holepage = HOLEPAGE;    new_holepage = HOLEPAGE;
650          nrbpage = INIT_NRBPAGE;    nrbpage = INIT_NRBPAGE;
651      
652          set_maxpage();    set_maxpage();
653      
654  #ifdef __linux__  #ifdef __linux__
655          /* Some versions of the Linux startup code are broken.    /* Some versions of the Linux startup code are broken.
656             For these, the first call to sbrk() fails, but       For these, the first call to sbrk() fails, but
657             subsequent calls are o.k.       subsequent calls are o.k.
658             */    */
659          if ( (long)sbrk(0) == -1 )    if ( (long)sbrk(0) == -1 )
660            {      {
661              if ( (long)sbrk(0) == -1 )        if ( (long)sbrk(0) == -1 )
662                {          {
663                  fputs("FATAL Linux sbrk() error\n", stderr);            fputs("FATAL Linux sbrk() error\n", stderr);
664                  exit(1);            exit(1);
665                }          }
666              fputs("WARNING: Non-fatal Linux sbrk() error\n", stderr);        fputs("WARNING: Non-fatal Linux sbrk() error\n", stderr);
667            }      }
668  #endif  #endif
669      
670          INIT_ALLOC;    INIT_ALLOC;
671              
672          alloc_page(-(holepage + nrbpage));    alloc_page(-(holepage + nrbpage));
673      
674          rb_start = rb_pointer = heap_end + PAGESIZE*holepage;    rb_start = rb_pointer = heap_end + PAGESIZE*holepage;
675          rb_end = rb_start + PAGESIZE*nrbpage;    rb_end = rb_start + PAGESIZE*nrbpage;
676          rb_limit = rb_end - 2*RB_GETA;    rb_limit = rb_end - 2*RB_GETA;
677  #ifdef SGC        #ifdef SGC      
678          tm_table[(int)t_relocatable].tm_sgc = 50;    tm_table[(int)t_relocatable].tm_sgc = 50;
679  #endif  #endif
680              
681          for (i = 0;  i < MAXPAGE;  i++)    for (i = 0;  i < MAXPAGE;  i++)
682                  type_map[i] = (char)t_other;      type_map[i] = (char)t_other;
683      
684          init_tm(t_fixnum, "NFIXNUM",    init_tm(t_fixnum, "NFIXNUM",
685                  sizeof(struct fixnum_struct), 8192,20);            sizeof(struct fixnum_struct), 8192,20);
686          init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );    init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
687          init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );    init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );
688          init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0  );    init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0  );
689          init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );    init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
690          init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1  );    init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1  );
691          init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );    init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
692          init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );    init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
693          init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );    init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
694          init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );    init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
695          init_tm(t_shortfloat, "FSHORT-FLOAT",    init_tm(t_shortfloat, "FSHORT-FLOAT",
696                  sizeof(struct shortfloat_struct), 256 ,1);            sizeof(struct shortfloat_struct), 256 ,1);
697          init_tm(t_longfloat, "LLONG-FLOAT",    init_tm(t_longfloat, "LLONG-FLOAT",
698                  sizeof(struct longfloat_struct), 170 ,0);            sizeof(struct longfloat_struct), 170 ,0);
699          init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);    init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
700          init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);    init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);
701          init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE / sizeof(struct package),0);    init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE / sizeof(struct package),0);
702          init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );    init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );
703          init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);    init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
704          init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);    init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);
705          init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);    init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
706          init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);    init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);
707          init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);    init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);
708          init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);    init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
709          init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);    init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
710          init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);    init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);
711          init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);    init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
712          init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);    init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
713          init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);    init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
714          init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);    init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
715          init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);    init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
716          init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);    init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
717          init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);    init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
718          tm_table[t_relocatable].tm_nppage = PAGESIZE;    tm_table[t_relocatable].tm_nppage = PAGESIZE;
719          tm_table[t_contiguous].tm_nppage = PAGESIZE;    tm_table[t_contiguous].tm_nppage = PAGESIZE;
720      
721      
722          ncb = 0;    ncb = 0;
723          ncbpage = 0;    ncbpage = 0;
724          maxcbpage = 512;    maxcbpage = 512;
725              
726  }  }
727    
728  DEFUN("STATICP",object,fSstaticp,SI,1,1,NONE,OO,OO,OO,OO,"Tell if the string or vector is static") (x)  DEFUN("STATICP",object,fSstaticp,SI,1,1,NONE,OO,OO,OO,OO,"Tell if the string or vector is static") (x)
# Line 738  object x; Line 730  object x;
730  { RETURN1((inheap(x->ust.ust_self) ? sLt : sLnil));  { RETURN1((inheap(x->ust.ust_self) ? sLt : sLnil));
731  }  }
732    
733  cant_get_a_type()  void
734  {  cant_get_a_type(void) {
735          FEerror("Can't get a type.", 0);    FEerror("Can't get a type.", 0);
736  }  }
737    
738  DEFUNO("ALLOCATE",object,fSallocate,SI  DEFUNO("ALLOCATE",object,fSallocate,SI
739     ,2,3,NONE,OO,IO,OO,OO,siLallocate,"")(type,npages,va_alist)         ,2,3,NONE,OO,IO,OO,OO,siLallocate,"")(type,npages,va_alist)
740  object type;       object type;
741  int npages;       int npages;
742  va_dcl       va_dcl
743  {       int nargs=VFUN_NARGS;  {
         object really_do;  
         va_list ap;  
         struct typemanager *tm;  
         int c, i;  
         char *p, *pp;  
         object f, x;  
         int t;  
   
         {va_start(ap);  
          if (nargs>=3) really_do=va_arg(ap,object);else goto LDEFAULT3;  
          goto LEND_VARARG;  
        LDEFAULT3: really_do = Cnil;  
        LEND_VARARG: va_end(ap);}  
           
   
744    
745          CHECK_ARG_RANGE(2,3);    int nargs=VFUN_NARGS;
746          t= t_from_type(type);    object really_do;
747          if  (npages <= 0)    va_list ap;
748                  FEerror("Allocate takes positive argument.", 1,    struct typemanager *tm;
749      char *pp=NULL;
750      int t;
751      
752      really_do=Cnil;
753      if (nargs>=3) {
754        va_start(ap);
755        really_do=va_arg(ap,object);
756        va_end(ap);
757      }
758      
759      CHECK_ARG_RANGE(2,3);
760      t= t_from_type(type);
761      if  (npages <= 0)
762        FEerror("Allocate takes positive argument.", 1,
763                          make_fixnum(npages));                          make_fixnum(npages));
764          tm = tm_of(t);    tm = tm_of(t);
765          if (tm->tm_npage > npages) {npages=tm->tm_npage;}    if (tm->tm_npage > npages) {npages=tm->tm_npage;}
766          tm->tm_maxpage = npages;    tm->tm_maxpage = npages;
767          if (really_do != Cnil &&    if (really_do != Cnil &&
768              tm->tm_maxpage > tm->tm_npage)        tm->tm_maxpage > tm->tm_npage)
769            goto ALLOCATE;      goto ALLOCATE;
770          RETURN1(Ct);  
771      RETURN1(Ct);
772  ALLOCATE:    
773          if (t == t_contiguous)         ALLOCATE:
774            FUNCALL(2,fSallocate_contiguous_pages(npages,really_do));    if (t == t_contiguous)
775                  FUNCALL(2,fSallocate_contiguous_pages(npages,really_do));
776          else    
777            if (t==t_relocatable)    else
778              FUNCALL(2,fSallocate_relocatable_pages(npages,really_do));      if (t==t_relocatable)
779          else{        FUNCALL(2,fSallocate_relocatable_pages(npages,really_do));
780                  else {
781          if (available_pages < tm->tm_maxpage - tm->tm_npage ||        
782              (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL) {        if (available_pages < tm->tm_maxpage - tm->tm_npage ||
783              (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL) {
784          FEerror("Can't allocate ~D pages for ~A.", 2,          FEerror("Can't allocate ~D pages for ~A.", 2,
785                  make_fixnum(npages), (make_simple_string(tm->tm_name+1)));                  make_fixnum(npages), (make_simple_string(tm->tm_name+1)));
786          }        }
787              for (;  tm->tm_npage < tm->tm_maxpage;  pp += PAGESIZE)        for (;  tm->tm_npage < tm->tm_maxpage;  pp += PAGESIZE)
788                add_page_to_freelist(pp,tm);}          add_page_to_freelist(pp,tm);}
789      
790      RETURN1(Ct);
791    
         RETURN1(Ct);  
792  }  }
793    
794  t_from_type(type)  int
795       object type;  t_from_type(object type) {
 {  
796    
797   int i;    int i;
798   check_type_or_symbol_string(&type);    check_type_or_symbol_string(&type);
799   for (i= (int)t_start ; i < (int)t_other ; i++)    for (i= (int)t_start ; i < (int)t_other ; i++)
800     {struct typemanager *tm = &tm_table[i];      {struct typemanager *tm = &tm_table[i];
801     if(tm->tm_name &&      if(tm->tm_name &&
802        0==strncmp((tm->tm_name)+1,type->st.st_self,type->st.st_fillp)         0==strncmp((tm->tm_name)+1,type->st.st_self,type->st.st_fillp)
803        )         )
804       return i;}        return i;}
805   FEerror("Unrecognized type",0);    FEerror("Unrecognized type",0);
806      return i;
807    
808  }  }
809  /* When sgc is enabled the TYPE should have at least MIN pages of sgc type,  /* When sgc is enabled the TYPE should have at least MIN pages of sgc type,
810     and at most MAX of them.   Each page should be FREE_PERCENT free     and at most MAX of them.   Each page should be FREE_PERCENT free
# Line 818  t_from_type(type) Line 812  t_from_type(type)
812     */     */
813    
814  DEFUN("ALLOCATE-SGC",object,fSallocate_sgc,SI  DEFUN("ALLOCATE-SGC",object,fSallocate_sgc,SI
815     ,4,4,NONE,OO,II,II,OO,"")(type,min,max,free_percent)        ,4,4,NONE,OO,II,II,OO,"")(object type,int min,int max,int free_percent) {
816       object type;  
817       int min,max,free_percent;    int t=t_from_type(type);
818  {int m,t=t_from_type(type);    struct typemanager *tm;
819   struct typemanager *tm;    object res;
820   object res;    tm=tm_of(t);
  tm=tm_of(t);  
821    res= list(3,make_fixnum(tm->tm_sgc),    res= list(3,make_fixnum(tm->tm_sgc),
822             make_fixnum(tm->tm_sgc_max),              make_fixnum(tm->tm_sgc_max),
823             make_fixnum((100*tm->tm_sgc_minfree)/tm->tm_nppage));              make_fixnum((100*tm->tm_sgc_minfree)/tm->tm_nppage));
824      
825   if(min<0 || max< min || min > 3000 || free_percent < 0 || free_percent > 100)    if(min<0 || max< min || min > 3000 || free_percent < 0 || free_percent > 100)
826      goto END;      goto END;
827   tm->tm_sgc_max=max;    tm->tm_sgc_max=max;
828   tm->tm_sgc=min;    tm->tm_sgc=min;
829   tm->tm_sgc_minfree= (tm->tm_nppage *free_percent) /100;    tm->tm_sgc_minfree= (tm->tm_nppage *free_percent) /100;
830   END:        END:
831   RETURN1(res);    RETURN1(res);
832    
833  }  }
834    
835  /* Growth of TYPE will be by at least MIN pages and at most MAX pages.  /* Growth of TYPE will be by at least MIN pages and at most MAX pages.
# Line 868  object type; Line 862  object type;
862    
863    
864  DEFUNO("ALLOCATE-CONTIGUOUS-PAGES",object,fSallocate_contiguous_pages,SI  DEFUNO("ALLOCATE-CONTIGUOUS-PAGES",object,fSallocate_contiguous_pages,SI
865     ,1,2,NONE,OI,OO,OO,OO,siLalloc_contpage,"")(npages,va_alist)         ,1,2,NONE,OI,OO,OO,OO,siLalloc_contpage,"")(npages,va_alist)
866  int npages;       int npages;
867  va_dcl       va_dcl
868  {       int nargs=VFUN_NARGS;  {
869          object really_do;  
870          va_list ap;    int nargs=VFUN_NARGS,i,m;
871          int m;    object really_do;
872          char *p;    va_list ap;
873      char *p=NULL;
874      
875      really_do=Cnil;
876      if (nargs>=2) {
877        va_start(ap);
878        really_do=va_arg(ap,object);
879        va_end(ap);
880      }
881      
882      CHECK_ARG_RANGE(1,2);
883      if  (npages  < 0)
884        FEerror("Allocate requires positive argument.", 0);
885      if (ncbpage > npages) {
886        printf("Allocate contiguous %d: %d already there pages",npages,ncbpage);
887        npages=ncbpage;
888      }
889      maxcbpage = npages;
890      if (really_do == Cnil)
891        RETURN1(Ct);
892      m = maxcbpage - ncbpage;
893      if (available_pages < m || (p = alloc_page(m)) == NULL)
894        FEerror("Can't allocate ~D pages for contiguous blocks.",
895                1, make_fixnum(npages));
896    
897      for (i = 0;  i < m;  i++)
898        type_map[page(p + PAGESIZE*i)] = (char)t_contiguous;
899    
900      ncbpage += m;
901      insert_contblock(p, PAGESIZE*m);
902      RETURN1(Ct);
903    
         { va_start(ap);  
           if (nargs>=2) really_do=va_arg(ap,object);else goto LDEFAULT2;  
           goto LEND_VARARG;  
         LDEFAULT2: really_do = Cnil ;  
         LEND_VARARG: va_end(ap);}  
   
   
         CHECK_ARG_RANGE(1,2);  
         if  (npages  < 0)  
                 FEerror("Allocate requires positive argument.", 0);  
         if (ncbpage > npages)  
           { printf("Allocate contiguous %d: %d already there pages",npages,ncbpage);  
             npages=ncbpage;}  
         maxcbpage = npages;  
         if (really_do == Cnil) { RETURN1(Ct);}  
         m = maxcbpage - ncbpage;  
         if (available_pages < m || (p = alloc_page(m)) == NULL)  
                 FEerror("Can't allocate ~D pages for contiguous blocks.",  
                         1, make_fixnum(npages));  
         {int i ;  
         for (i = 0;  i < m;  i++)  
                 type_map[page(p + PAGESIZE*i)] = (char)t_contiguous;  
         }  
         ncbpage += m;  
         insert_contblock(p, PAGESIZE*m);  
         RETURN1(Ct);  
904  }  }
905    
906    
# Line 922  DEFUNO("MAXIMUM-CONTIGUOUS-PAGES",object Line 920  DEFUNO("MAXIMUM-CONTIGUOUS-PAGES",object
920    
921    
922  DEFUNO("ALLOCATE-RELOCATABLE-PAGES",object,fSallocate_relocatable_pages,SI  DEFUNO("ALLOCATE-RELOCATABLE-PAGES",object,fSallocate_relocatable_pages,SI
923     ,1,2,NONE,OI,OO,OO,OO,siLalloc_relpage,"")(npages,va_alist)         ,1,2,NONE,OI,OO,OO,OO,siLalloc_relpage,"")(npages,va_alist)
924  int npages;       int npages;
925  va_dcl       va_dcl
926  {       int nargs=VFUN_NARGS;  {
927          object really_do;  
928          va_list ap;    int nargs=VFUN_NARGS;
929      object really_do;
930          char *p;    va_list ap;
931      
932          { va_start(ap);    really_do=Cnil;
933            if (nargs>=2) really_do=va_arg(ap,object);else goto LDEFAULT2;    if (nargs>=2) {
934            goto LEND_VARARG;      va_start(ap);
935          LDEFAULT2: really_do = Cnil ;      really_do=va_arg(ap,object);
936          LEND_VARARG: va_end(ap);}      va_end(ap);
937      }
938          CHECK_ARG_RANGE(1,2);      
939          if (npages  <= 0)    CHECK_ARG_RANGE(1,2);
940                  FEerror("Requires positive arg",0);    if (npages  <= 0)
941          if (nrbpage > npages && rb_pointer >= rb_start + PAGESIZE*npages - 2*RB_GETA      FEerror("Requires positive arg",0);
942           || 2*npages > real_maxpage-page(heap_end)-new_holepage-real_maxpage/32)    if ((nrbpage > npages && rb_pointer >= rb_start + PAGESIZE*npages - 2*RB_GETA)
943            FEerror("Can't set the limit for relocatable blocks to ~D.",        || 2*npages > real_maxpage-page(heap_end)-new_holepage-real_maxpage/32)
944                    1, make_fixnum(npages));      FEerror("Can't set the limit for relocatable blocks to ~D.",
945          rb_end += (npages-nrbpage)*PAGESIZE;              1, make_fixnum(npages));
946          nrbpage = npages;    rb_end += (npages-nrbpage)*PAGESIZE;
947          rb_limit = rb_end - 2*RB_GETA;    nrbpage = npages;
948          alloc_page(-(holepage + nrbpage));    rb_limit = rb_end - 2*RB_GETA;
949          vs_top = vs_base;    alloc_page(-(holepage + nrbpage));
950          vs_push(Ct);    vs_top = vs_base;
951          RETURN1(make_fixnum(npages));    vs_push(Ct);
952      RETURN1(make_fixnum(npages));
953    
954  }  }
955    
956  DEFUNO("ALLOCATED-RELOCATABLE-PAGES",object,fSallocated_relocatable_pages,SI  DEFUNO("ALLOCATED-RELOCATABLE-PAGES",object,fSallocated_relocatable_pages,SI
# Line 968  DEFUNO("GET-HOLE-SIZE",object,fSget_hole Line 968  DEFUNO("GET-HOLE-SIZE",object,fSget_hole
968  }  }
969    
970  DEFUNO("SET-HOLE-SIZE",object,fSset_hole_size,SI  DEFUNO("SET-HOLE-SIZE",object,fSset_hole_size,SI
971     ,1,2,NONE,OI,IO,OO,OO,siLset_hole_size,"")(npages,va_alist)         ,1,2,NONE,OI,IO,OO,OO,siLset_hole_size,"")(npages,va_alist)
972  int npages;       int npages;
973  va_dcl       va_dcl
974  {       int nargs=VFUN_NARGS;  {
975          int reserve;  
976          va_list ap;    int nargs=VFUN_NARGS;
977          { va_start(ap);    int reserve;
978            if (nargs>=2) reserve=va_arg(ap,int);else goto LDEFAULT2;    va_list ap;
979            goto LEND_VARARG;  
980          LDEFAULT2: reserve = 30;    reserve=30;
981          LEND_VARARG: va_end(ap);}    if (nargs>=2) {
982        va_start(ap);
983          if (npages < 1 ||      reserve=va_arg(ap,int);
984              npages > real_maxpage - page(heap_end)      va_end(ap);
985              - 2*nrbpage - real_maxpage/32)    }
986                  FEerror("Illegal value for the hole size.", 0);    
987          new_holepage = npages;    if (npages < 1 ||
988          if (VFUN_NARGS ==2)        npages > real_maxpage - page(heap_end)
989            {        - 2*nrbpage - real_maxpage/32)
990              if (reserve <0 || reserve > new_holepage)      FEerror("Illegal value for the hole size.", 0);
991                FEerror("Illegal value for the hole size.", 0);    new_holepage = npages;
992              reserve_pages_for_signal_handler = reserve;}    if (VFUN_NARGS ==2)
993        {
994          if (reserve <0 || reserve > new_holepage)
995            FEerror("Illegal value for the hole size.", 0);
996          reserve_pages_for_signal_handler = reserve;}
997      
998      RETURN2(make_fixnum(npages),
999              make_fixnum(reserve_pages_for_signal_handler));
1000    
         RETURN2(make_fixnum(npages),  
                 make_fixnum(reserve_pages_for_signal_handler));  
1001  }  }
1002    
1003    
1004  init_alloc_function()  void
1005  {  init_alloc_function(void) {
1006  }  }
1007    
1008  object malloc_list;  object malloc_list;
# Line 1121  malloc(size_t size) { Line 1126  malloc(size_t size) {
1126    
1127    
1128  void  void
1129  free(ptr)  free(void *ptr)
1130  #ifndef NO_VOID_STAR  #ifndef NO_VOID_STAR
1131  void *        
1132  #else  #else
1133  char *        
1134  #endif    #endif  
1135    ptr;        
1136  {  {
1137          object *p;          object *p;
1138          object endp_temp;          object endp_temp;
# Line 1155  char * Line 1160  char *
1160    
1161  void *  void *
1162  realloc(void *ptr, size_t size) {  realloc(void *ptr, size_t size) {
         object x;  
         int i, j;  
         object endp_temp;  
         /* was allocated by baby_malloc */  
 #ifdef BABY_MALLOC_SIZE  
         if (ptr >= baby_malloc_data && ptr -baby_malloc_data <BABY_MALLOC_SIZE)  
           {  
             int dim = ((int *)ptr)[-1];  
             if (dim > size)  
               return ptr;  
            else  
           {  char *new= malloc(size);  
              bcopy(ptr,new,dim);  
              return new;  
           }  
1163    
1164            }    object x;
1165      int i, j;
1166      object endp_temp;
1167      /* was allocated by baby_malloc */
1168    #ifdef BABY_MALLOC_SIZE
1169      if (ptr >= baby_malloc_data && ptr -baby_malloc_data <BABY_MALLOC_SIZE)
1170        {
1171          int dim = ((int *)ptr)[-1];
1172          if (dim > size)
1173            return ptr;
1174          else
1175            {  char *new= malloc(size);
1176            bcopy(ptr,new,dim);
1177            return new;
1178            }
1179          
1180        }
1181  #endif /*  BABY_MALLOC_SIZE      */  #endif /*  BABY_MALLOC_SIZE      */
1182      
1183      
1184      if(ptr == NULL) return malloc(size);
1185      for (x = malloc_list;  !endp(x);  x = x->c.c_cdr)
1186        if (x->c.c_car->st.st_self == ptr) {
1187          x = x->c.c_car;
1188          if (x->st.st_dim >= size) {
1189            x->st.st_fillp = size;
1190            return(ptr);
1191          } else {
1192            j = x->st.st_dim;
1193            x->st.st_self = alloc_contblock(size);
1194            x->st.st_fillp = x->st.st_dim = size;
1195            for (i = 0;  i < size;  i++)
1196              x->st.st_self[i] = ((char *)ptr)[i];
1197            insert_contblock(ptr, j);
1198            return(x->st.st_self);
1199          }
1200        }
1201      FEerror("realloc(3) error.", 0);
1202    
1203      return NULL;
1204    
           
         if(ptr == NULL) return malloc(size);  
         for (x = malloc_list;  !endp(x);  x = x->c.c_cdr)  
                 if (x->c.c_car->st.st_self == ptr) {  
                         x = x->c.c_car;  
                         if (x->st.st_dim >= size) {  
                                 x->st.st_fillp = size;  
                                 return(ptr);  
                         } else {  
                                 j = x->st.st_dim;  
                                 x->st.st_self = alloc_contblock(size);  
                                 x->st.st_fillp = x->st.st_dim = size;  
                                 for (i = 0;  i < size;  i++)  
                                         x->st.st_self[i] = ((char *)ptr)[i];  
                                 insert_contblock(ptr, j);  
                                 return(x->st.st_self);  
                         }  
                 }  
         FEerror("realloc(3) error.", 0);  
1205  }  }
1206    
1207  #endif /* gnumalloc */  #endif /* gnumalloc */
1208    
1209    
1210  char *  void *
1211  calloc(nelem, elsize)  calloc(size_t nelem, size_t elsize)
 int nelem, elsize;  
1212  {  {
1213          char *ptr;          char *ptr;
1214          int i;          int i;
# Line 1212  int nelem, elsize; Line 1220  int nelem, elsize;
1220  }  }
1221    
1222    
1223  cfree(ptr)  void
1224  char *ptr;  cfree(void *ptr) {
1225  {    free(ptr);
         free(ptr);  
   
1226  }  }
1227    
1228  #endif  #endif
# Line 1231  memalign(long align,size_t size) { Line 1237  memalign(long align,size_t size) {
1237    return x->st.st_self;    return x->st.st_self;
1238  }  }
1239  #ifdef WANT_VALLOC  #ifdef WANT_VALLOC
1240  char *  void *
1241  valloc(size)  valloc(size_t size)
 int size;      
1242  { return memalign(getpagesize(),size);}  { return memalign(getpagesize(),size);}
1243  #endif  #endif
1244    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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