This is alloc.c in view mode; [Download] [Up]
Changes file for /usr/local/src/kcl/c/alloc.c
Created on Wed Jun 12 20:44:23 1991
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files. Anything not between
"\n@s[" and "\n@s]" is a simply a comment.
This file was constructed using emacs and merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
by (Bill Schelter) wfs@carl.ma.utexas.edu
****Change:(orig (18 26 c))
@s[#ifdef AV
#ifdef ATT3B2
#define page(p) (((int)(char *)(p)-0x80800000)>>PAGEWIDTH)
#define pagetochar(x) ((char *)(((x) << PAGEWIDTH) + 0x80800000))
@s,#define pagetochar(x) ((char *)((x) << PAGEWIDTH))
#endif
#endif
@s|#include "page.h"
@s]
****Change:(orig (28 28 c))
@s[
#ifdef MV
@s|
#ifdef DEBUG_SBRK
int debug;
char *
sbrk1(n)
int n;
{char *ans;
if (debug){
printf("\n{sbrk(%d)",n);
fflush(stdout);}
ans= (char *)sbrk(n);
if (debug){
printf("->[0x%x]", ans);
fflush(stdout);
printf("core_end=0x%x,sbrk(0)=0x%x}",core_end,sbrk(0));
fflush(stdout);}
return ans;
}
#define sbrk sbrk1
#endif /* DEBUG_SBRK */
@s]
****Change:(orig (30 33 d))
@s[
#endif
@s|
@s]
****Change:(orig (49 49 c))
@s[struct rlimit data_rlimit;
extern etext;
@s|struct rlimit data_rlimit;
extern char etext;
@s]
****Change:(orig (51 51 a))
@s[#endif
@s|#endif
/* If (n >= 0 ) return pointer to n pages starting at heap end,
These must come from the hole, so if that is exhausted you have
to gc and move the hole.
if (n < 0) return pointer to n pages starting at heap end,
but don't worry about the hole. Basically just make sure
the space is available from the Operating system.
*/
@s]
****Change:(orig (58 61 d))
@s[ int m;
#ifdef AOSVS
#endif
@s| int m;
@s]
****Change:(orig (65 65 a))
@s[ holepage = new_holepage + n;
@s| holepage = new_holepage + n;
{int in_sgc=sgc_enabled;
if (in_sgc) sgc_quit();
@s]
****Change:(orig (66 66 a))
@s[ GBC(t_relocatable);
@s| GBC(t_relocatable);
if (in_sgc)
{sgc_start();
/* starting sgc can use up some pages
and may move heap end, so start over
*/
return alloc_page(n);}
}
@s]
****Change:(orig (71 71 a))
@s[ heap_end += PAGESIZE*n;
return(e);
}
@s| heap_end += PAGESIZE*n;
return(e);
}
else
/* n < 0 , then this says ensure there are -n pages
starting at heap_end, and return pointer to heap_end */
{
@s]
****Change:(orig (77 82 c))
@s[#ifdef BSD
if (core_end != sbrk(0))
error("Someone allocated my memory!");
if (core_end != sbrk(PAGESIZE*(n - m)))
@s, error("Can't allocate. Good-bye!");
#endif
@s| IF_ALLOCATE_ERR error("Can't allocate. Good-bye!");
#ifdef SGC
if (sgc_enabled)
make_writable(page(core_end),page(core_end)+n-m);
@s]
****Change:(orig (84 105 c))
@s[#ifdef ATT
if (PAGESIZE*(n - m) > pagetochar(MAXPAGE) - core_end)
error("Can't allocate. Good-bye!");
#endif
@s,
#ifdef AOSVS
#endif
@s|#endif
@s]
****Change:(orig (106 106 a))
@s[ core_end += PAGESIZE*(n - m);
@s| core_end += PAGESIZE*(n - m);
return(e);}
}
@s]
****Change:(orig (108 110 c))
@s[
#ifdef AOSVS
@s|
void
add_page_to_freelist(p,tm)
char *p;
struct typemanager *tm;
{short t,size;
int i=tm->tm_nppage,fw;
int nn;
object x,f;
t=tm->tm_type;
#ifdef SGC
nn=page(p);
if (sgc_enabled)
{ if (!WRITABLE_PAGE_P(nn)) make_writable(nn,nn+1);}
@s]
****Change:(orig (112 113 c))
@s[#endif
return(e);
@s|#endif
type_map[page(p)]= t;
size=tm->tm_size;
f=tm->tm_free;
x= (object)p;
x->d.t=t;
x->d.m=FREE;
#ifdef SGC
if (sgc_enabled && tm->tm_sgc)
{x->d.s=SGC_RECENT;
sgc_type_map[page(x)] = (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);}
else x->d.s = SGC_NORMAL;
/* array headers must be always writable, since a write to the
body does not touch the header. It may be desirable if there
are many arrays in a system to make the headers not writable,
but just SGC_TOUCH the header each time you write to it. this
is what is done with t_structure */
if (t== (tm_of(t_array)->tm_type))
sgc_type_map[page(x)] |= SGC_PERM_WRITABLE;
#endif
fw= *(int *)x;
while (--i >= 0)
{ *(int *)x=fw;
F_LINK(x)=f;
f=x;
x= (object) ((char *)x + size);
}
tm->tm_free=f;
tm->tm_nfree += tm->tm_nppage;
tm->tm_npage++;
@s]
****Change:(orig (115 115 a))
@s[}
@s|}
@s]
****Change:(orig (146 157 c))
@s[ type_map[page(p)] = (char)tm->tm_type;
f = tm->tm_free;
for (i = tm->tm_nppage; i > 0; --i, p += tm->tm_size) {
x = (object)p;
@s, tm->tm_nfree += tm->tm_nppage;
tm->tm_npage++;
@s| add_page_to_freelist(p,tm);
obj = tm->tm_free;
@s]
****Change:(orig (167 167 c))
@s[ obj->d.m = FALSE;
return(obj);
@s| obj->d.m = FALSE;
return(obj);
#define TOTAL_THIS_TYPE(tm) \
(tm->tm_nppage * (sgc_enabled ? sgc_count_type(tm->tm_type) : tm->tm_npage))
@s]
****Change:(orig (171 171 c))
@s[ (float)tm->tm_nfree * 10.0 < (float)tm->tm_nused)
@s| (float)tm->tm_nfree * 10.0 < (float) TOTAL_THIS_TYPE(tm))
@s]
****Change:(orig (196 196 a))
@s[ vs_pop;
goto ONCE_MORE;
}
@s| vs_pop;
goto ONCE_MORE;
}
grow_linear(old,fract,grow_min,grow_max)
int old,grow_min,grow_max,fract;
{int delt;
if(fract==0) fract=50;
if(grow_min==0) grow_min=1;
if(grow_max==0) grow_max=1000;
delt=(old*fract)/100;
delt= (delt < grow_min ? grow_min:
delt > grow_max ? grow_max:
delt);
return old + delt;}
@s]
****Change:(orig (204 204 a))
@s[ STATIC char *p;
STATIC object x, f;
@s| STATIC char *p;
STATIC object x, f;
struct typemanager *tm=(&tm_table[(int)t_cons]);
/* #define tm (&tm_table[(int)t_cons])*/
@s]
****Change:(orig (206 207 d))
@s[#define tm (&tm_table[(int)t_cons])
@s|
@s]
****Change:(orig (226 237 c))
@s[ type_map[page(p)] = (char)t_cons;
f = tm->tm_free;
for (i = tm->tm_nppage; i > 0; --i, p += tm->tm_size) {
x = (object)p;
@s, tm->tm_nfree += tm->tm_nppage;
tm->tm_npage++;
@s| add_page_to_freelist(p,tm);
obj = tm->tm_free ;
@s]
****Change:(orig (253 253 c))
@s[ (float)tm->tm_nfree * 10.0 < (float)tm->tm_nused)
@s| (float)tm->tm_nfree * 10.0 < (float) TOTAL_THIS_TYPE(tm))
@s]
****Change:(orig (259 262 c))
@s[ if (tm->tm_maxpage/2 <= 0)
tm->tm_maxpage += 1;
else
tm->tm_maxpage += tm->tm_maxpage/2;
@s| tm->tm_maxpage =
grow_linear(tm->tm_maxpage,tm->tm_growth_percent,
tm->tm_min_grow,tm->tm_max_grow);
@s]
****Change:(orig (277 277 a))
@s[ goto ONCE_MORE;
#undef tm
}
@s| goto ONCE_MORE;
#undef tm
}
object on_stack_cons(x,y)
object x,y;
{object p = (object) alloca_val;
p->c.t= (short)t_cons;
p->c.m=FALSE;
p->c.c_car=x;
p->c.c_cdr=y;
return p;
}
@s]
****Change:(orig (324 328 c))
@s[ if (symbol_value(Vignore_maximum_pages) != Cnil) {
if (maxcbpage/2 <= 0)
maxcbpage += 1;
else
@s, maxcbpage += maxcbpage/2;
@s| if (symbol_value(Vignore_maximum_pages) != Cnil)
{struct typemanager *tm = &tm_table[(int)t_contiguous];
maxcbpage=grow_linear(maxcbpage,tm->tm_growth_percent,
tm->tm_min_grow, tm->tm_max_grow);
@s]
****Change:(orig (400 401 c))
@s[ if ((float)(rb_limit - rb_pointer) * 10.0 <
(float)(rb_limit - rb_start))
@s| { float f1 = (float)(rb_limit - rb_pointer),
f2 = (float)(rb_limit - rb_start);
if (f1 * 10.0 < f2)
@s]
****Change:(orig (404 404 a))
@s[ else
goto ONCE_MORE;
@s| else
goto ONCE_MORE;
}
@s]
****Change:(orig (406 419 c))
@s[ if (symbol_value(Vignore_maximum_pages) != Cnil) {
if (nrbpage/2 <= 0)
i = 1;
else
@s, g = FALSE;
goto ONCE_MORE;
@s| if (symbol_value(Vignore_maximum_pages) != Cnil)
{struct typemanager *tm = &tm_table[(int)t_relocatable];
nrbpage=grow_linear(i=nrbpage,tm->tm_growth_percent,
tm->tm_min_grow, tm->tm_max_grow);
if (available_pages < 0)
nrbpage = i;
else {
rb_end += (PAGESIZE* (nrbpage -i));
rb_limit = rb_end - 2*RB_GETA;
if (page(rb_end) - page(heap_end) !=
holepage + nrbpage)
FEerror("bad rb_end");
alloc_page(-( nrbpage + holepage));
g = FALSE;
goto ONCE_MORE;
@s]
****Change:(orig (439 439 c))
@s[init_tm(t, name, elsize, maxpage)
@s|init_tm(t, name, elsize, nelts,sgc)
@s]
****Change:(orig (442 442 c))
@s[char name[];
int elsize, maxpage;
@s|char name[];
int elsize, nelts;
@s]
****Change:(orig (445 445 c))
@s[{
int i, j;
@s|{
int i, j;
int maxpage;
/* round up to next number of pages */
maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
@s]
****Change:(orig (454 454 a))
@s[ tm_table[j].tm_maxpage += maxpage;
@s| tm_table[j].tm_maxpage += maxpage;
#ifdef SGC
tm_table[j].tm_sgc += sgc;
#endif
@s]
****Change:(orig (465 465 a))
@s[ tm_table[(int)t].tm_gbccount = 0;
@s| tm_table[(int)t].tm_gbccount = 0;
#ifdef SGC
tm_table[(int)t].tm_sgc = sgc;
tm_table[(int)t].tm_sgc_max = 3000;
tm_table[(int)t].tm_sgc_minfree = (int)
(0.4 * tm_table[(int)t].tm_nppage);
#endif
@s]
****Change:(orig (470 474 c))
@s[#ifdef BSD
getrlimit(RLIMIT_DATA, &data_rlimit);
real_maxpage = ((int)&etext + data_rlimit.rlim_cur)/PAGESIZE;
if (real_maxpage > MAXPAGE)
@s, real_maxpage = MAXPAGE;
@s| /* This is run in init. Various initializations including getting
maxpage are here */
#ifdef SGC
page_multiple=getpagesize()/PAGESIZE;
if (page_multiple==0) error("PAGESIZE must be factor of getpagesize()");
if (sgc_enabled)
{memory_protect(1);}
if (~(-MAXPAGE) != MAXPAGE-1) error("MAXPAGE must be power of 2");
if (core_end)
bzero(&sgc_type_map[ page(core_end)],MAXPAGE- page(core_end));
#else
page_multiple=1;
@s]
****Change:(orig (475 475 a))
@s[#endif
@s|#endif
SET_REAL_MAXPAGE;
@s]
****Change:(orig (477 479 c))
@s[#ifdef ATT
real_maxpage = MAXPAGE;
#endif
@s| }
@s]
****Change:(orig (481 483 d))
@s[#ifdef E15
real_maxpage = MAXPAGE;
#endif
@s|
@s]
****Change:(orig (485 485 d))
@s[
#ifdef DGUX
@s|
@s]
****Change:(orig (489 495 d))
@s[#endif
#ifdef AOSVS
#endif
@s,}
@s|
@s]
****Change:(orig (503 504 c))
@s[ enum type t;
int c;
#ifdef AOSVS
@s| enum type t;
int c;
#ifdef UNIX
#ifndef DGUX
{
extern object malloc_list;
malloc_list = Cnil;
enter_mark_origin(&malloc_list);
}
@s]
****Change:(orig (506 506 c))
@s[#endif
@s|#endif
#endif
@s]
****Change:(orig (513 518 d))
@s[#ifdef UNIX
heap_end = sbrk(0);
if (i = ((int)heap_end & (PAGESIZE - 1)))
sbrk(PAGESIZE - i);
@s, heap_end = core_end = sbrk(0);
#endif
@s|
@s]
****Change:(orig (520 523 c))
@s[#ifdef ATT
if (brk(pagetochar(MAXPAGE)) < 0)
error("Can't allocate. Good-bye!.");
#endif
@s| INIT_ALLOC;
@s]
****Change:(orig (525 534 d))
@s[#ifdef E15
if (brk(pagetochar(MAXPAGE)) < 0)
error("Can't allocate. Good-bye!.");
#endif
@s,
#ifdef AOSVS
#endif
@s|
@s]
****Change:(orig (539 539 c))
@s[ rb_limit = rb_end - 2*RB_GETA;
@s| rb_limit = rb_end - 2*RB_GETA;
#ifdef SGC
tm_table[(int)t_relocatable].tm_sgc = 50;
#endif
@s]
****Change:(orig (543 549 c))
@s[ init_tm(t_fixnum, "Nfixnum",
sizeof(struct fixnum_struct), 32);
init_tm(t_cons, ".cons", sizeof(struct cons), 384);
init_tm(t_structure, "Sstructure", sizeof(struct structure), 32);
@s, init_tm(t_symbol, "|symbol", sizeof(struct symbol), 64);
@s| init_tm(t_fixnum, "NFIXNUM",
sizeof(struct fixnum_struct), 8192,20);
init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );
init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0 );
init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1 );
init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
init_tm(t_shortfloat, "FSHORT-FLOAT",
sizeof(struct shortfloat_struct), 256 ,0);
init_tm(t_longfloat, "LLONG-FLOAT",
sizeof(struct longfloat_struct), 170 ,0);
init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);
init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE / sizeof(struct package),0);
init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );
init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);
init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);
init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);
init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
init_tm(t_fat_string, "FFAT-STRING", sizeof(struct fat_string), 102
,0);
init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
@s]
****Change:(orig (551 569 d))
@s[ init_tm(t_bignum, "Bbignum", sizeof(struct bignum), 16);
init_tm(t_ratio, "Rratio", sizeof(struct ratio), 1);
init_tm(t_shortfloat, "Fshort-float",
sizeof(struct shortfloat_struct), 1);
@s, init_tm(t_spice, "!spice", sizeof(struct spice), 16);
@s|
@s]
****Change:(orig (573 573 a))
@s[ ncbpage = 0;
maxcbpage = 512;
@s| ncbpage = 0;
maxcbpage = 512;
@s]
****Change:(orig (582 582 c))
@s[ FEerror("Can't get a type.", 0);
}
siLalloc()
@s| FEerror("Can't get a type.", 0);
}
siLallocate()
@s]
****Change:(orig (587 587 a))
@s[ char *p, *pp;
object f, x;
@s| char *p, *pp;
object f, x;
int t;
@s]
****Change:(orig (592 593 c))
@s[ too_many_arguments();
vs_base[0] = coerce_to_string(vs_base[0]);
@s| too_many_arguments();
t= t_from_type(vs_base[0]);
@s]
****Change:(orig (597 619 c))
@s[ if (vs_base[0]->st.st_fillp == 0)
cant_get_a_type();
c = vs_base[0]->st.st_self[0];
for (tm = &tm_table[(int)t_start];
@s, }
cant_get_a_type();
@s| tm = tm_of(t);
if (tm->tm_npage > i) {i=tm->tm_npage;}
tm->tm_maxpage = i;
if (vs_top - vs_base == 3 && vs_base[2] != Cnil &&
tm->tm_maxpage > tm->tm_npage)
goto ALLOCATE;
vs_top = vs_base;
vs_push(Ct);
return;
@s]
****Change:(orig (627 641 c))
@s[ for (; tm->tm_npage < tm->tm_maxpage; pp += PAGESIZE) {
p = pp;
type_map[page(p)] = (char)tm->tm_type;
f = tm->tm_free;
@s, tm->tm_nfree += tm->tm_nppage;
tm->tm_npage++;
}
@s| for (; tm->tm_npage < tm->tm_maxpage; pp += PAGESIZE)
add_page_to_freelist(pp,tm);
@s]
****Change:(orig (646 646 c))
@s[ vs_push(Ct);
}
siLnpage()
@s| vs_push(Ct);
}
t_from_type(type)
object type;
{object typ= coerce_to_string(type);
object c = aref1(typ,0);
int i;
for (i= (int)t_start ; i < (int)t_contiguous ; i++)
{struct typemanager *tm = &tm_table[i];
if(tm->tm_name &&
0==strncmp((tm->tm_name)+1,typ->st.st_self,typ->st.st_fillp)
)
return i;}
FEerror("Unrecognized type");
}
/* When sgc is enabled the TYPE should have at least MIN pages of sgc type,
and at most MAX of them. Each page should be FREE_PERCENT free
when the sgc is turned on. FREE_PERCENT is an integer between 0 and 100.
*/
object
siSallocate_sgc(type,min,max,free_percent)
object type;
int min,max,free_percent;
{int m,t=t_from_type(type);
struct typemanager *tm;
object res;
tm=tm_of(t);
res= list(3,make_fixnum(tm->tm_sgc),
make_fixnum(tm->tm_sgc_max),
make_fixnum((100*tm->tm_sgc_minfree)/tm->tm_nppage));
if(min<0 || max< min || min > 3000 || free_percent < 0 || free_percent > 100)
goto END;
tm->tm_sgc_max=max;
tm->tm_sgc=min;
tm->tm_sgc_minfree= (tm->tm_nppage *free_percent) /100;
END:
return res;
}
/* Growth of TYPE will be by at least MIN pages and at most MAX pages.
It will try to grow PERCENT of the current pages.
*/
object
siSallocate_growth(type,min,max,percent)
int min,max,percent;
object type;
{int t=t_from_type(type);
struct typemanager *tm=tm_of(t);
object res;
res= list(3,make_fixnum(tm->tm_min_grow),
make_fixnum(tm->tm_max_grow),
make_fixnum(tm->tm_growth_percent));
if(min<0 || max< min || min > 3000 || percent < 0 || percent > 500)
goto END;
tm->tm_max_grow=max;
tm->tm_min_grow=min;
tm->tm_growth_percent= percent;
END:
return res;
}
siLallocated_pages()
@s]
****Change:(orig (652 665 c))
@s[ vs_base[0] = coerce_to_string(vs_base[0]);
if (vs_base[0]->st.st_fillp == 0)
cant_get_a_type();
c = vs_base[0]->st.st_self[0];
@s, }
cant_get_a_type();
}
@s| {int t=t_from_type(vs_base[0]);
vs_base[0]=make_fixnum(tm_of(t)->tm_npage);}
}
@s]
****Change:(orig (666 666 a))
@s[
@s|
@s]
****Change:(orig (673 686 c))
@s[ vs_base[0] = coerce_to_string(vs_base[0]);
if (vs_base[0]->st.st_fillp == 0)
cant_get_a_type();
c = vs_base[0]->st.st_self[0];
@s, }
cant_get_a_type();
}
@s| {int t=t_from_type(vs_base[0]);
vs_base[0]=make_fixnum(tm_of(t)->tm_npage);}
}
@s]
****Change:(orig (687 687 a))
@s[
@s|
@s]
****Change:(orig (700 705 c))
@s[ if (ncbpage > i) {
vs_push(make_fixnum(ncbpage));
FEerror("Can't set the limit for contiguous blocks to ~D,~%\
since ~D pages are already allocated.",
@s, 2, vs_base[0], vs_head);
}
@s| if (ncbpage > i)
{ printf("Allocate contiguous %d: %d already there pages",i,ncbpage);
i=ncbpage;}
@s]
****Change:(orig (751 751 a))
@s[ FEerror("Can't set the limit for relocatable blocks to ~D.",
1, vs_base[0]);
@s| FEerror("Can't set the limit for relocatable blocks to ~D.",
1, vs_base[0]);
rb_end += (i-nrbpage)*PAGESIZE;
@s]
****Change:(orig (753 753 d))
@s[ rb_end = rb_start + PAGESIZE*i;
@s|
@s]
****Change:(orig (786 793 c))
@s[ make_si_function("ALLOC", siLalloc);
make_si_function("NPAGE", siLnpage);
make_si_function("MAXPAGE", siLmaxpage);
make_si_function("ALLOC-CONTPAGE", siLalloc_contpage);
@s, make_si_function("NRBPAGE", siLnrbpage);
@s| make_si_function("ALLOCATE", siLallocate);
make_si_function("ALLOCATED-PAGES", siLallocated_pages);
make_si_function("MAXIMUM-ALLOCATABLE-PAGES", siLmaxpage);
make_si_function("ALLOCATE-CONTIGUOUS-PAGES", siLalloc_contpage);
make_si_function("ALLOCATED-CONTIGUOUS-PAGES", siLncbpage);
make_si_function("MAXIMUM-CONTIGUOUS-PAGES", siLmaxcbpage);
make_si_function("ALLOCATE-RELOCATABLE-PAGES", siLalloc_relpage);
make_si_function("ALLOCATED-RELOCATABLE-PAGES", siLnrbpage);
@s]
****Change:(orig (795 795 a))
@s[ make_si_function("SET-HOLE-SIZE", siLset_hole_size);
@s| make_si_function("SET-HOLE-SIZE", siLset_hole_size);
make_si_sfun("ALLOCATE-SGC",siSallocate_sgc,
4 | ARGTYPE(0,f_object) | ARGTYPE(1,f_fixnum) |
ARGTYPE(2,f_fixnum) | ARGTYPE(3,f_fixnum)
| RESTYPE(f_object));
@s]
****Change:(orig (796 796 a))
@s[
@s|
make_si_sfun("ALLOCATE-GROWTH",siSallocate_growth,
4 | ARGTYPE(0,f_object) | ARGTYPE(1,f_fixnum) |
ARGTYPE(2,f_fixnum) | ARGTYPE(3,f_fixnum)
| RESTYPE(f_object));
@s]
****Change:(orig (800 809 d))
@s[#ifdef UNIX
#ifndef DGUX
{
extern object malloc_list;
@s, enter_mark_origin(&malloc_list);
}
#endif
#endif
@s|
@s]
****Change:(orig (823 823 a))
@s[*/
object malloc_list;
@s|*/
object malloc_list;
/* If this is defined, substitute the fast gnu malloc for the slower
version below. If you have many calls to malloc this is worth
your while. I have only tested it slightly under 4.3Bsd. There
the difference in a test run with 120K mallocs and frees,
was 29 seconds to 1.9 seconds */
#ifdef GNU_MALLOC
#include "malloc.c"
#else
@s]
****Change:(orig (829 829 c))
@s[int size;
{
object x;
@s|int size;
{
object x;
#ifdef NOFREE_ERR
if (GBC_enable==0 && initflag ==0)
{
#ifdef SGC
perm_writable(sbrk(0),size);
#endif
return sbrk(size);
}
#endif
@s]
****Change:(orig (832 832 a))
@s[ x->st.st_self = alloc_contblock(size);
@s| x->st.st_self = alloc_contblock(size);
#ifdef SGC
perm_writable(x->st.st_self,size);
#endif
@s]
****Change:(orig (837 837 a))
@s[ return(x->st.st_self);
}
@s| return(x->st.st_self);
}
void
@s]
****Change:(orig (839 839 c))
@s[free(ptr)
char *ptr;
@s|free(ptr)
#ifndef NO_VOID_STAR
void *
#else
char *
#endif
ptr;
@s]
****Change:(orig (843 843 c))
@s[ for (p = &malloc_list; !endp(*p); p = &((*p)->c.c_cdr))
@s| for (p = &malloc_list; *p && !endp(*p); p = &((*p)->c.c_cdr))
@s]
****Change:(orig (849 849 c))
@s[ *p = (*p)->c.c_cdr;
return;
@s| *p = (*p)->c.c_cdr;
return ;
@s]
****Change:(orig (851 851 c))
@s[ FEerror("free(3) error.", 0);
@s|#ifdef NOFREE_ERR
return ;
#else
FEerror("free(3) error.",0);
return;
#endif
@s]
****Change:(orig (880 880 a))
@s[ FEerror("realloc(3) error.", 0);
}
@s| FEerror("realloc(3) error.", 0);
}
#endif /* gnumalloc */
@s]
****Change:(orig (898 898 d))
@s[char *ptr;
{
free(ptr);
}
@s|char *ptr;
{
free(ptr);
@s]
****Change:(orig (899 899 a))
@s[
@s|
}
@s]
****Change:(orig (902 902 a))
@s[#endif
#endif
@s|#endif
#endif
#ifndef GNUMALLOC
char *
memalign(align,size)
int align,size;
{ object x = alloc_simple_string(size);
x->st.st_self = ALLOC_ALIGNED(alloc_contblock,size,align);
malloc_list = make_cons(x, malloc_list);
return x->st.st_self;
}
#ifdef WANT_VALLOC
char *
valloc(size)
int size;
{ return memalign(getpagesize(),size);}
#endif
#endif
@s]
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.