xref: /freebsd/contrib/lua/src/lmem.c (revision 8c784bb8cf36911b828652f0bf7e88f443abec50)
18e3e3a7aSWarner Losh /*
20495ed39SKyle Evans ** $Id: lmem.c $
38e3e3a7aSWarner Losh ** Interface to Memory Manager
48e3e3a7aSWarner Losh ** See Copyright Notice in lua.h
58e3e3a7aSWarner Losh */
68e3e3a7aSWarner Losh 
78e3e3a7aSWarner Losh #define lmem_c
88e3e3a7aSWarner Losh #define LUA_CORE
98e3e3a7aSWarner Losh 
108e3e3a7aSWarner Losh #include "lprefix.h"
118e3e3a7aSWarner Losh 
128e3e3a7aSWarner Losh 
138e3e3a7aSWarner Losh #include <stddef.h>
148e3e3a7aSWarner Losh 
158e3e3a7aSWarner Losh #include "lua.h"
168e3e3a7aSWarner Losh 
178e3e3a7aSWarner Losh #include "ldebug.h"
188e3e3a7aSWarner Losh #include "ldo.h"
198e3e3a7aSWarner Losh #include "lgc.h"
208e3e3a7aSWarner Losh #include "lmem.h"
218e3e3a7aSWarner Losh #include "lobject.h"
228e3e3a7aSWarner Losh #include "lstate.h"
238e3e3a7aSWarner Losh 
248e3e3a7aSWarner Losh 
250495ed39SKyle Evans #if defined(EMERGENCYGCTESTS)
260495ed39SKyle Evans /*
27*8c784bb8SWarner Losh ** First allocation will fail whenever not building initial state.
28*8c784bb8SWarner Losh ** (This fail will trigger 'tryagain' and a full GC cycle at every
29*8c784bb8SWarner Losh ** allocation.)
300495ed39SKyle Evans */
310495ed39SKyle Evans static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
32*8c784bb8SWarner Losh   if (completestate(g) && ns > 0)  /* frees never fail */
330495ed39SKyle Evans     return NULL;  /* fail */
340495ed39SKyle Evans   else  /* normal allocation */
350495ed39SKyle Evans     return (*g->frealloc)(g->ud, block, os, ns);
360495ed39SKyle Evans }
370495ed39SKyle Evans #else
380495ed39SKyle Evans #define firsttry(g,block,os,ns)    ((*g->frealloc)(g->ud, block, os, ns))
390495ed39SKyle Evans #endif
400495ed39SKyle Evans 
410495ed39SKyle Evans 
420495ed39SKyle Evans 
430495ed39SKyle Evans 
448e3e3a7aSWarner Losh 
458e3e3a7aSWarner Losh /*
468e3e3a7aSWarner Losh ** About the realloc function:
478e3e3a7aSWarner Losh ** void *frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
488e3e3a7aSWarner Losh ** ('osize' is the old size, 'nsize' is the new size)
498e3e3a7aSWarner Losh **
500495ed39SKyle Evans ** - frealloc(ud, p, x, 0) frees the block 'p' and returns NULL.
510495ed39SKyle Evans ** Particularly, frealloc(ud, NULL, 0, 0) does nothing,
520495ed39SKyle Evans ** which is equivalent to free(NULL) in ISO C.
538e3e3a7aSWarner Losh **
540495ed39SKyle Evans ** - frealloc(ud, NULL, x, s) creates a new block of size 's'
550495ed39SKyle Evans ** (no matter 'x'). Returns NULL if it cannot create the new block.
568e3e3a7aSWarner Losh **
570495ed39SKyle Evans ** - otherwise, frealloc(ud, b, x, y) reallocates the block 'b' from
580495ed39SKyle Evans ** size 'x' to size 'y'. Returns NULL if it cannot reallocate the
590495ed39SKyle Evans ** block to the new size.
608e3e3a7aSWarner Losh */
618e3e3a7aSWarner Losh 
628e3e3a7aSWarner Losh 
638e3e3a7aSWarner Losh 
640495ed39SKyle Evans 
650495ed39SKyle Evans /*
660495ed39SKyle Evans ** {==================================================================
670495ed39SKyle Evans ** Functions to allocate/deallocate arrays for the Parser
680495ed39SKyle Evans ** ===================================================================
690495ed39SKyle Evans */
700495ed39SKyle Evans 
710495ed39SKyle Evans /*
720495ed39SKyle Evans ** Minimum size for arrays during parsing, to avoid overhead of
730495ed39SKyle Evans ** reallocating to size 1, then 2, and then 4. All these arrays
740495ed39SKyle Evans ** will be reallocated to exact sizes or erased when parsing ends.
750495ed39SKyle Evans */
768e3e3a7aSWarner Losh #define MINSIZEARRAY	4
778e3e3a7aSWarner Losh 
788e3e3a7aSWarner Losh 
790495ed39SKyle Evans void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize,
800495ed39SKyle Evans                      int size_elems, int limit, const char *what) {
818e3e3a7aSWarner Losh   void *newblock;
820495ed39SKyle Evans   int size = *psize;
830495ed39SKyle Evans   if (nelems + 1 <= size)  /* does one extra element still fit? */
840495ed39SKyle Evans     return block;  /* nothing to be done */
850495ed39SKyle Evans   if (size >= limit / 2) {  /* cannot double it? */
86*8c784bb8SWarner Losh     if (l_unlikely(size >= limit))  /* cannot grow even a little? */
878e3e3a7aSWarner Losh       luaG_runerror(L, "too many %s (limit is %d)", what, limit);
880495ed39SKyle Evans     size = limit;  /* still have at least one free place */
898e3e3a7aSWarner Losh   }
908e3e3a7aSWarner Losh   else {
910495ed39SKyle Evans     size *= 2;
920495ed39SKyle Evans     if (size < MINSIZEARRAY)
930495ed39SKyle Evans       size = MINSIZEARRAY;  /* minimum size */
948e3e3a7aSWarner Losh   }
950495ed39SKyle Evans   lua_assert(nelems + 1 <= size && size <= limit);
960495ed39SKyle Evans   /* 'limit' ensures that multiplication will not overflow */
970495ed39SKyle Evans   newblock = luaM_saferealloc_(L, block, cast_sizet(*psize) * size_elems,
980495ed39SKyle Evans                                          cast_sizet(size) * size_elems);
990495ed39SKyle Evans   *psize = size;  /* update only when everything else is OK */
1008e3e3a7aSWarner Losh   return newblock;
1018e3e3a7aSWarner Losh }
1028e3e3a7aSWarner Losh 
1038e3e3a7aSWarner Losh 
1040495ed39SKyle Evans /*
1050495ed39SKyle Evans ** In prototypes, the size of the array is also its number of
1060495ed39SKyle Evans ** elements (to save memory). So, if it cannot shrink an array
1070495ed39SKyle Evans ** to its number of elements, the only option is to raise an
1080495ed39SKyle Evans ** error.
1090495ed39SKyle Evans */
1100495ed39SKyle Evans void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
1110495ed39SKyle Evans                           int final_n, int size_elem) {
1120495ed39SKyle Evans   void *newblock;
1130495ed39SKyle Evans   size_t oldsize = cast_sizet((*size) * size_elem);
1140495ed39SKyle Evans   size_t newsize = cast_sizet(final_n * size_elem);
1150495ed39SKyle Evans   lua_assert(newsize <= oldsize);
1160495ed39SKyle Evans   newblock = luaM_saferealloc_(L, block, oldsize, newsize);
1170495ed39SKyle Evans   *size = final_n;
1180495ed39SKyle Evans   return newblock;
1190495ed39SKyle Evans }
1200495ed39SKyle Evans 
1210495ed39SKyle Evans /* }================================================================== */
1220495ed39SKyle Evans 
1230495ed39SKyle Evans 
1248e3e3a7aSWarner Losh l_noret luaM_toobig (lua_State *L) {
1258e3e3a7aSWarner Losh   luaG_runerror(L, "memory allocation error: block too big");
1268e3e3a7aSWarner Losh }
1278e3e3a7aSWarner Losh 
1288e3e3a7aSWarner Losh 
1290495ed39SKyle Evans /*
1300495ed39SKyle Evans ** Free memory
1310495ed39SKyle Evans */
1320495ed39SKyle Evans void luaM_free_ (lua_State *L, void *block, size_t osize) {
1330495ed39SKyle Evans   global_State *g = G(L);
1340495ed39SKyle Evans   lua_assert((osize == 0) == (block == NULL));
1350495ed39SKyle Evans   (*g->frealloc)(g->ud, block, osize, 0);
1360495ed39SKyle Evans   g->GCdebt -= osize;
1370495ed39SKyle Evans }
1380495ed39SKyle Evans 
1398e3e3a7aSWarner Losh 
1408e3e3a7aSWarner Losh /*
141*8c784bb8SWarner Losh ** In case of allocation fail, this function will do an emergency
142*8c784bb8SWarner Losh ** collection to free some memory and then try the allocation again.
143*8c784bb8SWarner Losh ** The GC should not be called while state is not fully built, as the
144*8c784bb8SWarner Losh ** collector is not yet fully initialized. Also, it should not be called
145*8c784bb8SWarner Losh ** when 'gcstopem' is true, because then the interpreter is in the
146*8c784bb8SWarner Losh ** middle of a collection step.
1470495ed39SKyle Evans */
1480495ed39SKyle Evans static void *tryagain (lua_State *L, void *block,
1490495ed39SKyle Evans                        size_t osize, size_t nsize) {
1500495ed39SKyle Evans   global_State *g = G(L);
151*8c784bb8SWarner Losh   if (completestate(g) && !g->gcstopem) {
1520495ed39SKyle Evans     luaC_fullgc(L, 1);  /* try to free some memory... */
1530495ed39SKyle Evans     return (*g->frealloc)(g->ud, block, osize, nsize);  /* try again */
1540495ed39SKyle Evans   }
1550495ed39SKyle Evans   else return NULL;  /* cannot free any memory without a full state */
1560495ed39SKyle Evans }
1570495ed39SKyle Evans 
1580495ed39SKyle Evans 
1590495ed39SKyle Evans /*
1600495ed39SKyle Evans ** Generic allocation routine.
1618e3e3a7aSWarner Losh */
1628e3e3a7aSWarner Losh void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
1638e3e3a7aSWarner Losh   void *newblock;
1648e3e3a7aSWarner Losh   global_State *g = G(L);
1650495ed39SKyle Evans   lua_assert((osize == 0) == (block == NULL));
1660495ed39SKyle Evans   newblock = firsttry(g, block, osize, nsize);
167*8c784bb8SWarner Losh   if (l_unlikely(newblock == NULL && nsize > 0)) {
1680495ed39SKyle Evans     newblock = tryagain(L, block, osize, nsize);
1690495ed39SKyle Evans     if (newblock == NULL)  /* still no memory? */
1700495ed39SKyle Evans       return NULL;  /* do not update 'GCdebt' */
1718e3e3a7aSWarner Losh   }
1728e3e3a7aSWarner Losh   lua_assert((nsize == 0) == (newblock == NULL));
1730495ed39SKyle Evans   g->GCdebt = (g->GCdebt + nsize) - osize;
1748e3e3a7aSWarner Losh   return newblock;
1758e3e3a7aSWarner Losh }
1768e3e3a7aSWarner Losh 
1770495ed39SKyle Evans 
1780495ed39SKyle Evans void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
1790495ed39SKyle Evans                                                     size_t nsize) {
1800495ed39SKyle Evans   void *newblock = luaM_realloc_(L, block, osize, nsize);
181*8c784bb8SWarner Losh   if (l_unlikely(newblock == NULL && nsize > 0))  /* allocation failed? */
1820495ed39SKyle Evans     luaM_error(L);
1830495ed39SKyle Evans   return newblock;
1840495ed39SKyle Evans }
1850495ed39SKyle Evans 
1860495ed39SKyle Evans 
1870495ed39SKyle Evans void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
1880495ed39SKyle Evans   if (size == 0)
1890495ed39SKyle Evans     return NULL;  /* that's all */
1900495ed39SKyle Evans   else {
1910495ed39SKyle Evans     global_State *g = G(L);
1920495ed39SKyle Evans     void *newblock = firsttry(g, NULL, tag, size);
193*8c784bb8SWarner Losh     if (l_unlikely(newblock == NULL)) {
1940495ed39SKyle Evans       newblock = tryagain(L, NULL, tag, size);
1950495ed39SKyle Evans       if (newblock == NULL)
1960495ed39SKyle Evans         luaM_error(L);
1970495ed39SKyle Evans     }
1980495ed39SKyle Evans     g->GCdebt += size;
1990495ed39SKyle Evans     return newblock;
2000495ed39SKyle Evans   }
2010495ed39SKyle Evans }
202