/* Copyright 1992, 1995, 1997 J"orn Rennecke */ #include <sys/mman.h> #ifdef linux #include <linux/mman.h> #define MAP_ANON MAP_ANONYMOUS #ifndef MAP_FILE #define MAP_FILE 0 #endif #endif #include "common.h" #include "alloc.h" #include "object.h" #include "uid.h" #include "schedule.h" int out_of_memory; union svalue reserved_user_area, reserved_master_area, reserved_system_area; int malloc_privilege; size_t pagesize; uint8 *smallpnt, *smallend; union svalue ref_inc(union svalue sv) { switch((freeable_type)SV_TYPE(sv)) { case T_STRING: case T_LSTRING: /* make_string_global() decrements ref to sv and inc. ref to return val. */ return make_string_global(sv); case T_ISTRING: SV_REF(sv)--; sv = SV_ISTRING(sv); if (!SV_REFINC(sv)) break; case T_GSTRING: SV_REF(sv) = 0x100 - SV_REF_CYCLELEN; if (!++SV_STRREF(sv)) SV_STRREF(sv)--; break; case T_ILSTRING: SV_REF(sv)--; sv = SV_ISTRING(sv); if (!SV_REFINC(sv)) break; case T_GLSTRING: SV_REF(sv) = 0x100 - SV_REF_CYCLELEN; SV_LSTRREF(sv)++; break; default: fatal("bogus ref_inc\n"); return SV_NULL; case T_MAPPING: { union svalue sv2; SV_REF(sv) = 0x100 - SV_REF_CYCLELEN; if (MAP_HAS_X(&SV_MAPPING(sv))) { MAP_REF(&SV_MAPPING(sv))++; break; } sv2 = ALLOC_TTS(T_INTERNAL, IT_X_MAP, 2, sizeof(char *)+ sizeof(struct map_x)); if (!sv2.i) return sv2; SV_MAPPING(sv).x.x = (struct map_x *)&sv2.p[-1]; break; } case T_ARRAY: { svalue xsv; struct array_x *x; SV_REF(sv) = 0x100 - SV_REF_CYCLELEN; xsv = ALLOC(T_INTERNAL, IT_X_ARRAY, sizeof *x); if (!xsv.p) { SV_REF(sv)--; sv = TO_SVALUE(&nil_array); /* garbage in garbage out */ if (!SV_REFINC(sv)) break; } else { p_int len; x = (struct array_x *)(void *)&xsv.p[3]; #if 0 /* gcc 2.7.0 bug cases extra register to be pushed */ x->len = SV_ARRAY(sv).len; x->uid = SV_ARRAY(sv).x.uid; #else len = SV_ARRAY(sv).len; x->uid = SV_ARRAY(sv).x.uid; x->len = len; #endif SV_LARRAY_REF(sv) = 1; SV_ARRAY(sv).x.x = x; break; } } case T_LARRAY: SV_REF(sv) = 0x100 - SV_REF_CYCLELEN; SV_LARRAY_REF(sv)++; break; case T_CBR_CHAR_LVALUE: { union svalue sv2; SV_REF(sv)--; sv2 = *SV_LVALUE(sv).lvalue; if (sv2.p != SV_LVALUE(sv).parent.p || !SV_IS_2REF_STRING(sv2)) { sv = SV_NULL; break; } sv.i = *SV_LVALUE(sv).index2.p << 1; break; } case T_FLOAT: { union svalue sv2; SV_REF(sv)--; sv2 = ALLOC_FLOAT; if (sv2.p) { /* nomem -> garbage in garbage out */ SV_FLOAT(sv2) = SV_FLOAT(sv); } break; } } return sv; } typedef int balance_t; /* make this the fastest signed integer type */ typedef unsigned ubalance_t; /* and this the matching unsigned type */ struct free_block { p_uint size; struct free_block *parent, *left, *right; balance_t balance; }; static void free_large_block (uint8 *sv, p_uint size); void remove_from_free_tree(struct free_block *p); void add_to_free_tree(struct free_block *r, p_uint size); static union svalue alloc_large_block(p_int type, p_uint size); static union svalue alloc_small_block(p_int type, p_uint size); #define SMALL_BLOCK_MAX 9 #define SMALL_BLOCK_CMAX (SMALL_BLOCK_MAX * sizeof(char *)) #define ALLOC_OVERHEAD (sizeof(char *)) #define SV_NEXTFREE(sv) (*(void **)(void *)&(sv)[-1]) #define SV_FREEBLOCK(sv) (*(struct free_block *)(void *)&(sv)[sizeof(p_int)-1]) #define SV_PREVFREE(sv) (((struct free_block **)(sv-1))[-1]) #define SIZE_P_INDEX(base, size) \ (*(void **)(void *)((char *)base + size - ALLOC_OVERHEAD)) #define SIZE_I_INDEX(base, size) \ (*(p_int *)(void *)((char *)base + size - ALLOC_OVERHEAD)) static uint8 *sftable[SMALL_BLOCK_MAX], *sfmtable[SMALL_BLOCK_MAX], *sfstable[SMALL_BLOCK_MAX]; INLINE void free_block(uint8 *sv, mp_int size) { if (size <= SMALL_BLOCK_CMAX) { SIZE_I_INDEX(adtstat+ALLOC_FREE1, size)++; SV_NEXTFREE(sv) = SIZE_P_INDEX(sftable, size); SIZE_P_INDEX(sftable, size) = sv; return; } else { free_large_block(sv, size); } } void init_alloc() { char *heap, *small; pagesize = getpagesize(); heap = mmap((caddr_t)0, MAX_ALLOCED, PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); if (heap == (caddr_t)-1) switch(errno) { default: perror("mmap"); fatal("mmap failed\n"); } ((p_int *)&heap[MAX_ALLOCED])[-1] = C2PI(T_INTERNAL, IT_HEAPEND, 0, 0); add_to_free_tree( (struct free_block *)(heap+sizeof(p_int)), MAX_ALLOCED - sizeof(p_int) ); small = mmap((caddr_t)0, MAX_SMALL_ALLOCED, PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); if (small == (caddr_t)-1) switch(errno) { default: perror("mmap"); fatal("mmap failed\n"); } smallpnt = small; smallend = small + MAX_SMALL_ALLOCED; } void free_gen(void * p) { free_block( (uint8 *)p - sizeof(char *) + 1, SV_GENLEN((union svalue)((uint8 *)p - sizeof(char *) + 1)) ); } struct searchstr { struct searchstr *next; char block[4]; }; static RISC_INLINE void _free_array(union svalue sv, p_int offset, p_int size) { union svalue *svp, *end, sv2; svp = (union svalue *)(sv.p + offset); end = svp + size; if (svp < end) { do { sv2 = *svp++; FREE_SVALUE(sv2); } while (svp < end); } free_block(sv.p, (uint8 *)end - sv.p + 1); } struct searchlstr { struct searchlstr *next; uint32 len; char block[4]; }; void _free_svalue(union svalue sv) { p_int size; switch((freeable_type)SV_TYPE(sv)) { case T_OBJECT: /* This can only happen if the total ref has exceeded the minor ref * before. */ SV_REF(sv) = SV_REF_CYCLELEN; O_REF(&SV_OBJECT(sv))--; return; case T_DESTRUCTED: if (O_HAS_X(&SV_OBJECT(sv))) { SV_REF(sv) = SV_REF_CYCLELEN; if (--O_REF(&SV_OBJECT(sv))) return; } _free_object(sv); return; case T_LONG: size = sizeof (char *) + sizeof SV_LONG(sv); break; case T_FLOAT: size = sizeof (char *) + sizeof SV_FLOAT(sv); break; case T_VARARGS: free_varargs(sv); return; default: fatal("bogus free_svalue\n"); return; case T_CLOSURE: { union svalue ob = SV_CLOSURE(sv).g.ob; switch(SV_CLOSURE(sv).g.closure_type) { case CLOSURE_ALIEN_LFUN: case CLOSURE_BOGUS_ALIEN: FREE_ALLOCED_SVALUE(ob); ob = SV_CLOSURE(sv).alien.alien; FREE_ALLOCED_SVALUE(ob); size = sizeof SV_CLOSURE(sv).alien; break; case CLOSURE_LFUN: case CLOSURE_IDENTIFIER: case CLOSURE_BOGUS_LFUN: FREE_ALLOCED_SVALUE(ob); size = sizeof SV_CLOSURE(sv).lfun; break; case CLOSURE_BOUND_LAMBDA: { struct lambda_closure *l2; l2 = SV_CLOSURE(sv).bound.lambda; if (--l2->ref) { /* (g)cc should merge this code with the lfun closure code */ FREE_ALLOCED_SVALUE(ob); size = sizeof SV_CLOSURE(sv).bound; break; } free_block(sv.p, sizeof SV_CLOSURE(sv).bound); sv = TO_SVALUE(l2); } case CLOSURE_LAMBDA: case CLOSURE_BOGUS_LAMBDA: FREE_ALLOCED_SVALUE(ob); case CLOSURE_UNBOUND_LAMBDA: _free_lambda_closure(sv); return; /* case CLOSURE_BOGUS */ default: FREE_ALLOCED_SVALUE(ob); size = sizeof SV_CLOSURE(sv).efun; break; } break; } case T_MAPPING: SV_REF(sv) = SV_REF_CYCLELEN; if (MAP_HAS_X(&SV_MAPPING(sv)) && --MAP_REF(&SV_MAPPING(sv))) return; _free_mapping(sv); return; case T_LARRAY: { struct array_x *x; struct uid *uid; SV_REF(sv) = SV_REF_CYCLELEN; if (--SV_LARRAY_REF(sv)) return; x = SV_ARRAY(sv).x.x; #if 0 /* gcc 2.7.0 problem: allocates %esi */ free_block((uint8 *)x - sizeof (char *) + 1, sizeof(struct array_x)); size = x->len; uid = x->uid; #else x = (struct array_x *)((uint8 *)x - sizeof (char *) + 1); free_block((uint8 *)x, sizeof(struct array_x)); size = ((struct array_x *)((uint8 *)x - sizeof (char *) + 1))->len; uid = ((struct array_x *)((uint8 *)x - sizeof (char *) + 1))->uid; #endif goto got_size; case T_ARRAY: size = SV_ARRAY(sv).len; uid = SV_ARRAY(sv).x.uid; got_size: uid->num_array--; uid->total_array -= size; _free_array(sv, offsetof(struct array, member) - 1, size); return; } case T_GLSTRING: { struct searchlstr **search, *curr, *prev; SV_REF(sv) = SV_REF_CYCLELEN; if (--SV_LSTRREF(sv)) return; adtstat[SHS_LFREE]++; search = &SV_LSTRNXT(sv); #if defined(i386) /* save a register push */ sv.p = (uint8 *)search; #define search ((struct searchlstr **)sv.p) #endif curr = *search; do { prev = curr; curr = curr->next; } while(&curr->next != search); prev->next = curr->next; #ifdef search sv.p = (uint8 *)search - sizeof(char *) + 1; #undef search #endif goto free_lstring; #if 0 free_large_block(sv.p, -sizeof(char *) & sizeof(char *)*2 - 1 + sizeof(SV_LSTRNXT(sv)) + sizeof(SV_LSTRLEN(sv)) + SV_LSTRLEN(sv)); return; #endif } case T_ILSTRING: { union svalue sv2 = SV_ILSTRING(sv); FREE_ALLOCED_SVALUE(sv2); } case T_LSTRING: free_lstring: free_large_block(sv.p, -sizeof(char *) & sizeof(char *)*2 - 1 + sizeof(SV_ILSTRING(sv)) + sizeof(SV_LSTRLEN(sv)) + SV_LSTRLEN(sv)); return; case T_GSTRING: { struct searchstr **search, *curr, *prev; SV_REF(sv) = SV_REF_CYCLELEN; if (--SV_STRREF(sv) < 254 || ++SV_STRREF(sv)) return; adtstat[SHS_FREE]++; search = &SV_STRNXT(sv); #if defined(i386) /* save a register push */ sv.p = (uint8 *)search; #define search ((struct searchstr **)sv.p) #endif curr = *search; do { prev = curr; curr = curr->next; } while(&curr->next != search); prev->next = curr->next; #ifdef search sv.p = (uint8 *)search - sizeof(char *) + 1; #endif size = -sizeof(char *) & sizeof(char *)*2 - 1 + sizeof(SV_STRNXT(sv)) + SV_STRLEN(sv); break; } case T_ISTRING: { union svalue sv2 = SV_ISTRING(sv); FREE_ALLOCED_SVALUE(sv2); } case T_STRING: size = -sizeof(char *) & sizeof(char *)*2 - 1 + sizeof(SV_ISTRING(sv)) + SV_STRLEN(sv); break; } free_block(sv.p, size); } static void free_large_block (uint8 *sv, p_uint size) { uint8 type; struct free_block *fb; adtstat[ALLOC_LFREE]++; adtstat[ALLOC_LFREE_TOTAL] += size; type = sv[size-1] & T_MASK; if (SVTYPE_IS_FREE(type)) { if (type & 1) { struct free_block *nxt; fb = &SV_FREEBLOCK(sv); nxt = (struct free_block *)((char *)fb + size); size += nxt->size; remove_from_free_tree(nxt); goto got_fb; } else { size += sv[size]; } } fb = &SV_FREEBLOCK(sv); got_fb: if (((uint8 *)fb)[-sizeof(char *)] & AL_PREV_FREE) { p_int prev_size; if ( !(prev_size = ((uint8 *)fb)[1-2*sizeof(char *)]) ) { prev_size = ((p_int *)fb)[-3]; size += prev_size; fb = (struct free_block *)((char *)fb - prev_size); remove_from_free_tree(fb); } else { size += prev_size; fb = (struct free_block *)((char *)fb - prev_size); } } ((uint8 *)fb)[size-sizeof(char *)] |= AL_PREV_FREE; add_to_free_tree(fb, size); } union svalue alloc(p_int type, p_uint len) { if (len <= SMALL_BLOCK_CMAX) { union svalue sv; SIZE_I_INDEX(adtstat+ALLOC_ALLOC1, len)++; sv = SIZE_P_INDEX(sftable, len); if (sv.i) { SIZE_P_INDEX(sftable, len) = SV_NEXTFREE(sv.p); *(p_int *)&sv.p[-1] = type; return sv; } return alloc_small_block(type, len); } else { return alloc_large_block(type, len); } } void *alloc_gen(mp_int len) { union svalue r; len += sizeof(char *); r = ALLOC_TTS(T_INTERNAL, IT_GENERIC, len, len); if (r.i) r.p += 3; return r.p; }; static union svalue alloc_small_block(p_int type, p_uint len) { /* len <= SMALL_BLOCK_CMAX */ union svalue sv; uint8 *newend; sv.p = smallpnt; newend = sv.p + pagesize; if (newend > smallend) { newend = smallend; } newend -= len; if (sv.p <= newend) { sv.p++; newend++; do { SV_NEXTFREE(sv.p) = SIZE_P_INDEX(sftable, len); SIZE_P_INDEX(sftable, len) = sv.p; sv.p += len; } while (sv.p <= newend); smallpnt = sv.p - 1; return alloc(type, len); } if (malloc_privilege >= ALLOC_MASTER) { sv = SIZE_P_INDEX(sfmtable, len); if (sv.i) { SIZE_P_INDEX(sfmtable, len) = SV_NEXTFREE(sv.p); *(p_int *)&sv.p[-1] = type; return sv; } } if (malloc_privilege >= ALLOC_SYSTEM) { sv = SIZE_P_INDEX(sfstable, len); if (sv.i) { SIZE_P_INDEX(sfmtable, len) = SV_NEXTFREE(sv.p); *(p_int *)&sv.p[-1] = type; return sv; } } SIZE_I_INDEX(adtstat+ALLOC_ALLOC1, len)--; return SV_NULL; } /* prepare two nodes for the free tree that will never be removed, so that we can always assume that the tree is and remains non-empty. */ /* some compilers don't understand forward declarations of static vars. */ extern struct free_block dummy2; static struct free_block dummy = { /*size*/0, /*parent*/&dummy2, /*left*/0, /*right*/0, /*balance*/0 }; struct free_block dummy2 = { /*size*/0, /*parent*/0, /*left*/&dummy, /*right*/0, /*balance*/-1 }; static struct free_block *free_tree = &dummy2; void remove_from_free_tree(struct free_block *p) { struct free_block *q, *r, *s, *t; if (p->left) { if (q = p->right) { /* two childs */ s = q; for ( ; r = q, q = r->left; ); if (r == s) { r->left = s = p->left; s->parent = r; if (r->parent = s = p->parent) { if (p == s->left) { s->left = r; } else { s->right = r; } } else { free_tree = r; } r->balance = p->balance; p = r; goto balance_right; } else { t = r->parent; if (t->left = s = r->right) { s->parent = t; } r->balance = p->balance; r->left = s = p->left; s->parent = r; r->right = s = p->right; s->parent = r; if (r->parent = s = p->parent) { if (p == s->left) { s->left = r; } else { s->right = r; } } else { free_tree = r; } p = t; goto balance_left; } } else /* no right child, but left child */ { /* We set up the free list in a way so that there will remain at least two nodes, and the avl property ensures that the left child is a leaf ==> there is a parent */ s = p; p = s->parent; r = s->left; r->parent = p; if (s == p->left) { p->left = r; goto balance_left; } else { p->right = r; goto balance_right; } } } else /* no left child */ { /* We set up the free list in a way so that there is a node left of all used nodes, so there is a parent */ s = p; p = s->parent; if(q = r = s->right) { r->parent = p; } if (s == p->left) { p->left = r; goto balance_left; } else { p->right = r; goto balance_right; } } balance_q: r = p; p = q; if (r == p->right) { balance_t b; balance_right: b = p->balance; if (b > 0) { p->balance = 0; if (q = p->parent) goto balance_q; return; } else if (b < 0) { r = p->left; b = r->balance; if (b <= 0) { /* R-Rotation */ if (p->left = s = r->right) { s->parent = p; } r->right = p; s = p->parent; p->parent = r; b += 1; r->balance = b; b = -b; if (r->parent = s) { if (p->balance = b) { if (p == s->left) { s->left = r; return; } else { s->right = r; return; } } if (p == s->left) { /* left from parent */ goto balance_left_s; } else { /* right from parent */ p = s; p->right = r; goto balance_right; } } p->balance = b; free_tree = r; return; } else /* r->balance == +1 */ { /* LR-Rotation */ balance_t b2; t = r->right; b = t->balance; if (p->left = s = t->right) { s->parent = p; } if (r->right = s = t->left ) { s->parent = r; } t->left = r; t->right = p; r->parent = t; s = p->parent; p->parent = t; #ifdef NO_BARREL_SHIFT b = -b; b2 = b >> 1; r->balance = b2; b -= b2; p->balance = b; #else b2 = (ubalance_t)b >> (8 * sizeof(b2) - 1); p->balance = b2; b2 = -b2 -b; r->balance = b2; #endif t->balance = 0; if (t->parent = s) { if (p == s->left) { p = s; s->left = t; goto balance_left; } else { p = s; s->right = t; goto balance_right; } } free_tree = t; return; } } else /* p->balance == 0 */ { p->balance = -1; return; } } else /* r == p->left */ { balance_t b; goto balance_left; balance_left_s: p = s; s->left = r; balance_left: b = p->balance; if (b < 0) { p->balance = 0; if (q = p->parent) goto balance_q; return; } else if (b > 0) { r = p->right; b = r->balance; if (b >= 0) { /* L-Rotation */ if (p->right = s = r->left) { s->parent = p; } r->left = p; s = p->parent; p->parent = r; b -= 1; r->balance = b; b = -b; if (r->parent = s) { if (p->balance = b) { if (p == s->left) { s->left = r; return; } else { s->right = r; return; } } if (p == s->left) { /* left from parent */ goto balance_left_s; } else { /* right from parent */ p = s; p->right = r; goto balance_right; } } p->balance = b; free_tree = r; return; } else /* r->balance == -1 */ { /* RL-Rotation */ balance_t b2; t = r->left; b = t->balance; if (p->right = s = t->left ) { s->parent = p; } if (r->left = s = t->right) { s->parent = r; } t->right = r; t->left = p; r->parent = t; s = p->parent; p->parent = t; #ifdef NO_BARREL_SHIFT b = -b; b2 = b >> 1; p->balance = b2; b -= b2; r->balance = b; #else b2 = (ubalance_t)b >> (8 * sizeof(b2) - 1); r->balance = b2; b2 = -b2 -b; p->balance = b2; #endif t->balance = 0; if (t->parent = s) { if (p == s->left) { p = s; s->left = t; goto balance_left; } else { s->right = t; p = s; goto balance_right; } } free_tree = t; return; } } else /* p->balance == 0 */ { p->balance++; return; } } } void add_to_free_tree(struct free_block *r, p_uint size) { struct free_block *p, *q; /* When there is a distinction between data and address registers and/or accesses, gcc will choose data type for q, so an assignment to q will faciliate branching */ ((uint8 *)r)[-sizeof(char *)] = T_LARGEFREE; *(p_int*)&((uint8 *)r)[size - 3*sizeof(char *)] = size; ((uint8 *)r)[size - 2*sizeof(char *)+1] = 0; q = (struct free_block *)size; /* this assignment is a hint for register choice */ q = free_tree; for ( ; ; /*p = q*/) { p = (struct free_block *)q; if (size < p->size) { if (q = p->left) { continue; } /* add left */ p->left = r; break; } else /* >= */ { if (q = p->right) { continue; } /* add right */ p->right = r; break; } } r->size = size; r->parent = p; r->left = 0; r->right = 0; r->balance = 0; do { struct free_block *s; if (r == p->left) { balance_t b; if ( !(b = p->balance) ) { /* growth propagation from left side */ p->balance = -1; } else if (b < 0) { if (r->balance < 0) { /* R-Rotation */ if (p->left = s = r->right) { s->parent = p; } r->right = p; p->balance = 0; r->balance = 0; s = p->parent; p->parent = r; if (r->parent = s) { if ( s->left == p) { s->left = r; } else { s->right = r; } } else { free_tree = r; } } else /* r->balance == +1 */ { /* LR-Rotation */ balance_t b2; struct free_block *t = r->right; if (p->left = s = t->right) { s->parent = p; } /* relocated right subtree */ t->right = p; if (r->right = s = t->left ) { s->parent = r; } /* relocated left subtree */ t->left = r; b = t->balance; #ifdef NO_BARREL_SHIFT b = -b; b2 = b >> 1; r->balance = b2; b -= b2; p->balance = b; #else b2 = (ubalance_t)b >> (8 * sizeof(b2) - 1); p->balance = b2; b2 = -b2 -b; r->balance = b2; #endif t->balance = 0; s = p->parent; p->parent = t; r->parent = t; if (t->parent = s) { if ( s->left == p) { s->left = t; } else { s->right = t; } } else { free_tree = t; } } break; } else /* p->balance == +1 */ { p->balance = 0; /* growth of left side balanced the node */ break; } } else /* r == p->right */ { balance_t b; if ( !(b = p->balance) ) { /* growth propagation from right side */ p->balance++; } else if (b > 0) { if (r->balance > 0) { /* L-Rotation */ if (p->right = s = r->left) { s->parent = p; } r->left = p; p->balance = 0; r->balance = 0; s = p->parent; p->parent = r; if (r->parent = s) { if ( s->left == p) { s->left = r; } else { s->right = r; } } else { free_tree = r; } } else /* r->balance == -1 */ { /* RL-Rotation */ balance_t b2; struct free_block *t = r->left; if (p->right = s = t->left ) { s->parent = p; } /* relocated left subtree */ t->left = p; if (r->left = s = t->right) { s->parent = r; } /* relocated right subtree */ t->right = r; b = t->balance; #ifdef NO_BARREL_SHIFT b = -b; b2 = b >> 1; p->balance = b2; b -= b2; r->balance = b; #else b2 = (ubalance_t)b >> (8 * sizeof(b2) - 1); r->balance = b2; b2 = -b2 -b; p->balance = b2; #endif t->balance = 0; s = p->parent; p->parent = t; r->parent = t; if (t->parent = s) { if ( s->left == p) { s->left = t; } else { s->right = t; } } else { free_tree = t; } } break; } else /* p->balance == -1 */ { p->balance = 0; /* growth of right side balanced the node */ break; } } r = p; p = p->parent; } while (q = p); } static union svalue alloc_large_block(p_int type, p_uint size) { struct free_block *fit, *q; retry: for (fit = 0, q = free_tree; ; ) { struct free_block *p; p_uint tempsize; p = q; tempsize = p->size; if (size < tempsize) { fit = p; /* remember this fit */ if (q = p->left) { continue; } /* We don't need that much, but that's the best fit we have */ break; } else if (size > tempsize) { if (q = p->right) { continue; } break; } else /* size == tempsize */ { fit = p; break; } } /* end for */ if (fit) { p_uint excess_size; remove_from_free_tree(fit); if ((excess_size = fit->size - size)) { if (excess_size > SMALL_BLOCK_CMAX) { add_to_free_tree( (struct free_block *)((uint8 *)fit+size), excess_size ); } else { ((uint8 *)fit)[size-sizeof(char *)] = T_SMALLFREE; ((uint8 *)fit)[size-sizeof(char *)+1] = excess_size; } } else { ((uint8 *)fit)[size-sizeof(char *)] &= ~AL_PREV_FREE; } ((p_int *)fit)[-1] = type | ( ((p_int *)fit)[-1] & AL_PREV_FREE ); return (union svalue)(p_int) ( (uint8 *)fit - sizeof(char *) + 1 ); } else { static char mess1[] = "Temporary out of MEMORY. Freeing user reserve.\n"; static char mess2[] = "Temporary out of MEMORY. Freeing master reserve.\n"; static char mess3[] = "Temporary out of MEMORY. Freeing system reserve.\n"; static char mess4[] = "Totally out of MEMORY.\n"; #define FREE_RESERVED_AREA(area) free_large_block(area.p,((p_int *)(area.p-1))[1]) SET_JOB(garbage_collection); if (reserved_user_area.p) { FREE_RESERVED_AREA(reserved_user_area); reserved_user_area.p = 0; write(2, mess1, sizeof(mess1)-1); goto retry; } if (malloc_privilege >= ALLOC_MASTER && reserved_master_area.p) { FREE_RESERVED_AREA(reserved_master_area); reserved_master_area.p = 0; write(2, mess2, sizeof(mess2)-1); goto retry; } if (malloc_privilege >= ALLOC_SYSTEM) { if (reserved_system_area.p) { FREE_RESERVED_AREA(reserved_system_area); reserved_system_area.p = 0; write(2, mess3, sizeof(mess3)-1); goto retry; } write(2, mess4, sizeof(mess4)-1); fatal("Out of memory\n"); } adtstat[ALLOC_LALLOC]--; adtstat[ALLOC_LALLOC_TOTAL] -= size; out_of_memory = 1; if (!inter_errno) inter_errno = IE_NOMEM; return SV_NULL; } } void *x_alloc(mp_int size) { union svalue block; block = ALLOC(T_INTERNAL, IT_X_ALLOCED, size += sizeof(char *)); if (block.i) { *(p_int *)(block.p + sizeof(char *) - 1) = size; block.p += 2*sizeof(char *) - 1; } return (void *)block.p; } void x_free(void *p) { free_block((char *)p - 2 * sizeof(char *) + 1, ((p_int *)p)[-1]); } void *re_x_alloc(void *old, mp_int size) { void *new; mp_int old_size; new = x_alloc(size); old_size = ((p_int *)old)[-1] - sizeof(char *); if (old_size > size) old_size = size; amemcpy(new, old, old_size); x_free(old); return new; }