klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kmem.c (2951B)

      1 /*
      2 ** kmem.c
      3 ** Interface to Memory Manager
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 
      8 /*
      9 ** SOURCE NOTE: This is from Lua, but greatly shortened
     10 */
     11 
     12 /*
     13 ** LOCK: Whoever calls these should have already acquired the GIL.
     14 */
     15 
     16 #include <stddef.h>
     17 #include <stdio.h>
     18 #include <assert.h>
     19 
     20 #include "klisp.h"
     21 #include "kstate.h"
     22 #include "klimits.h"
     23 #include "kmem.h"
     24 #include "kerror.h"
     25 #include "kgc.h"
     26 
     27 #define MINSIZEARRAY	4
     28 
     29 /*
     30 ** About the realloc function:
     31 ** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
     32 ** (`osize' is the old size, `nsize' is the new size)
     33 **
     34 ** klisp ensures that (ptr == NULL) iff (osize == 0).
     35 **
     36 ** * frealloc(ud, NULL, 0, x) creates a new block of size `x'
     37 **
     38 ** * frealloc(ud, p, x, 0) frees the block `p'
     39 ** (in this specific case, frealloc must return NULL).
     40 ** particularly, frealloc(ud, NULL, 0, 0) does nothing
     41 ** (which is equivalent to free(NULL) in ANSI C)
     42 **
     43 ** frealloc returns NULL if it cannot create or reallocate the area
     44 ** (any reallocation to an equal or smaller size cannot fail!)
     45 */
     46 
     47 void *klispM_growaux_ (klisp_State *K, void *block, int *size, size_t size_elems,
     48                        int32_t limit, const char *errormsg) {
     49     void *newblock;
     50     int32_t newsize;
     51     if (*size >= limit/2) {  /* cannot double it? */
     52         if (*size >= limit)  /* cannot grow even a little? */
     53             klispE_throw_simple(K, (char *) errormsg); /* XXX */
     54         newsize = limit;  /* still have at least one free place */
     55     }
     56     else {
     57         newsize = (*size)*2;
     58         if (newsize < MINSIZEARRAY)
     59             newsize = MINSIZEARRAY;  /* minimum size */
     60     }
     61     newblock = klispM_reallocv(K, block, *size, newsize, size_elems);
     62     *size = newsize;  /* update only when everything else is OK */
     63     return newblock;
     64 }
     65 
     66 
     67 void *klispM_toobig (klisp_State *K) {
     68     /* TODO better msg */
     69     klispE_throw_simple(K, "(mem) block too big");
     70     return NULL;  /* to avoid warnings */
     71 }
     72 
     73 
     74 /*
     75 ** generic allocation routine.
     76 */
     77 void *klispM_realloc_ (klisp_State *K, void *block, size_t osize, size_t nsize) {
     78     klisp_assert((osize == 0) == (block == NULL));
     79 
     80     /* TEMP: for now only Stop the world GC */
     81     /* TEMP: prevent recursive call of klispC_fullgc() */
     82 #ifdef KUSE_GC
     83     if (nsize > 0 && G(K)->totalbytes - osize + nsize >= G(K)->GCthreshold) {
     84 #ifdef KDEBUG_GC
     85         printf("GC START, total_bytes: %d\n", G(K)->totalbytes);
     86 #endif
     87         klispC_fullgc(K);
     88 #ifdef KDEBUG_GC
     89         printf("GC END, total_bytes: %d\n", G(K)->totalbytes);
     90 #endif
     91     }
     92 #endif
     93 
     94     block = (*G(K)->frealloc)(G(K)->ud, block, osize, nsize);
     95 
     96     if (block == NULL && nsize > 0) {
     97         /* TEMP: try GC if there is no more mem */
     98         /* TODO: make this a catchable error */
     99         klisp_unlock_all(K);
    100         fprintf(stderr, MEMERRMSG);
    101         abort();
    102     }
    103     klisp_assert((nsize == 0) == (block == NULL));
    104     G(K)->totalbytes = (G(K)->totalbytes - osize) + nsize;
    105     return block;
    106 }