/[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.19.4.1.2.2 by camm, Sun Sep 14 02:30:44 2003 UTC revision 1.19.4.1.2.3 by camm, Thu Nov 6 16:16:49 2003 UTC
# Line 837  DEFUN_NEW("STATICP",object,fSstaticp,SI, Line 837  DEFUN_NEW("STATICP",object,fSstaticp,SI,
837  /*   FEerror("Can't get a type.", 0); */  /*   FEerror("Can't get a type.", 0); */
838  /* } */  /* } */
839    
 DEFUN_NEW("ALLOCATE",object,fSallocate,SI  
        ,2,3,NONE,OO,IO,OO,OO,(object type,fixnum npages,...),"")  
 {  
   
   int nargs=VFUN_NARGS;  
   object really_do;  
   va_list ap;  
   struct typemanager *tm;  
   char *pp=NULL;  
   int t;  
     
   really_do=Cnil;  
   if (nargs>=3) {  
     va_start(ap,npages);  
     really_do=va_arg(ap,object);  
     va_end(ap);  
   }  
     
   CHECK_ARG_RANGE(2,3);  
   t= t_from_type(type);  
   if  (npages <= 0)  
     FEerror("Allocate takes positive argument.", 1,  
                         make_fixnum(npages));  
   tm = tm_of(t);  
   if (tm->tm_npage > npages) {npages=tm->tm_npage;}  
   tm->tm_maxpage = npages;  
   if (really_do != Cnil &&  
       tm->tm_maxpage > tm->tm_npage)  
     goto ALLOCATE;  
   
   RETURN1(Ct);  
     
        ALLOCATE:  
   if (t == t_contiguous)  
     FUNCALL(2,fSallocate_contiguous_pages(npages,really_do));  
     
   else  
     if (t==t_relocatable)  
       FUNCALL(2,fSallocate_relocatable_pages(npages,really_do));  
     else {  
         
       if (available_pages < tm->tm_maxpage - tm->tm_npage ||  
           (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL) {  
         FEerror("Can't allocate ~D pages for ~A.", 2,  
                 make_fixnum(npages), (make_simple_string(tm->tm_name+1)));  
       }  
       for (;  tm->tm_npage < tm->tm_maxpage;  pp += PAGESIZE)  
         add_page_to_freelist(pp,tm);}  
     
   RETURN1(Ct);  
   
 }  
   
840  static int  static int
841  t_from_type(object type) {  t_from_type(object type) {
842    
# Line 1057  DEFUN_NEW("ALLOCATE-RELOCATABLE-PAGES",o Line 1004  DEFUN_NEW("ALLOCATE-RELOCATABLE-PAGES",o
1004    
1005  }  }
1006    
1007    DEFUN_NEW("ALLOCATE",object,fSallocate,SI
1008           ,2,3,NONE,OO,IO,OO,OO,(object type,fixnum npages,...),"")
1009    {
1010    
1011      int nargs=VFUN_NARGS;
1012      object really_do;
1013      va_list ap;
1014      struct typemanager *tm;
1015      char *pp=NULL;
1016      int t;
1017      
1018      really_do=Cnil;
1019      if (nargs>=3) {
1020        va_start(ap,npages);
1021        really_do=va_arg(ap,object);
1022        va_end(ap);
1023      }
1024      
1025      CHECK_ARG_RANGE(2,3);
1026      t= t_from_type(type);
1027      if  (npages <= 0)
1028        FEerror("Allocate takes positive argument.", 1,
1029                            make_fixnum(npages));
1030      tm = tm_of(t);
1031      if (tm->tm_npage > npages) {npages=tm->tm_npage;}
1032      tm->tm_maxpage = npages;
1033      if (really_do != Cnil &&
1034          tm->tm_maxpage > tm->tm_npage)
1035        goto ALLOCATE;
1036    
1037      RETURN1(Ct);
1038      
1039           ALLOCATE:
1040      if (t == t_contiguous)
1041        FUNCALL(2,FFN(fSallocate_contiguous_pages)(npages,really_do));
1042      
1043      else
1044        if (t==t_relocatable)
1045          FUNCALL(2,FFN(fSallocate_relocatable_pages)(npages,really_do));
1046        else {
1047          
1048          if (available_pages < tm->tm_maxpage - tm->tm_npage ||
1049              (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL) {
1050            FEerror("Can't allocate ~D pages for ~A.", 2,
1051                    make_fixnum(npages), (make_simple_string(tm->tm_name+1)));
1052          }
1053          for (;  tm->tm_npage < tm->tm_maxpage;  pp += PAGESIZE)
1054            add_page_to_freelist(pp,tm);}
1055      
1056      RETURN1(Ct);
1057    
1058    }
1059    
1060  DEFUN_NEW("ALLOCATED-RELOCATABLE-PAGES",object,fSallocated_relocatable_pages,SI  DEFUN_NEW("ALLOCATED-RELOCATABLE-PAGES",object,fSallocated_relocatable_pages,SI
1061         ,0,0,NONE,OO,OO,OO,OO,(void),"")         ,0,0,NONE,OO,OO,OO,OO,(void),"")
1062  {  {

Legend:
Removed from v.1.19.4.1.2.2  
changed lines
  Added in v.1.19.4.1.2.3

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