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 |
|
|
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 |
{ |
{ |