3 files changed, 108 insertions, 47 deletions

diff --git a/lmem.c b/lmem.c
index 83a9082c..ebbfb56a 100644
--- a/lmem.c
+++ b/lmem.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.c,v 1.90 2015/03/03 18:18:29 roberto Exp roberto $
+** $Id: lmem.c,v 1.91 2015/03/06 19:45:54 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -22,6 +22,14 @@
 #include "lstate.h"
 
 
+#if defined(HARDMEMTESTS)
+#define hardtest(L,os,s)  /* force a GC whenever possible */ \
+  if ((s) > (os) && (G(L))->gcrunning) luaC_fullgc(L, 1);
+#else
+#define hardtest(L,os,s)  ((void)0)
+#endif
+
+
 
 /*
 ** About the realloc function:
@@ -45,10 +53,12 @@
 #define MINSIZEARRAY    4
 
 
-void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,
-                     int limit, const char *what) {
+void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *size,
+                     int size_elems, int limit, const char *what) {
   void *newblock;
   int newsize;
+  if (nelems + 1 <= *size)  /* does one extra element still fit? */
+    return block;  /* nothing to be done */
   if (*size >= limit/2) {  /* cannot double it? */
     if (*size >= limit)  /* cannot grow even a little? */
       luaG_runerror(L, "too many %s (limit is %d)", what, limit);
@@ -65,11 +75,40 @@ void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,
 }
 
 
+void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
+                          int final_n, int size_elem) {
+  global_State *g = G(L);
+  void *newblock;
+  size_t oldsize = cast(size_t, (*size) * size_elem);
+  size_t newsize = cast(size_t, final_n * size_elem);
+  lua_assert(newsize <= oldsize);
+  newblock = (*g->frealloc)(g->ud, block, oldsize, newsize);
+  if (newblock == NULL && final_n > 0)  /* allocation failed? */
+    return block;  /* keep old block */
+  else {
+    g->GCdebt += newsize - oldsize;
+    *size = final_n;
+    return newblock;
+  }
+}
+
+
 l_noret luaM_toobig (lua_State *L) {
   luaG_runerror(L, "memory allocation error: block too big");
 }
 
 
+/*
+** Free memory
+*/
+void luaM_free_ (lua_State *L, void *block, size_t osize) {
+  global_State *g = G(L);
+  lua_assert((block == 0) == (block == NULL));
+  (*g->frealloc)(g->ud, block, osize, 0);
+  g->GCdebt -= osize;
+}
+
+
 
 /*
 ** generic allocation routine.
@@ -77,15 +116,11 @@ l_noret luaM_toobig (lua_State *L) {
 void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
   void *newblock;
   global_State *g = G(L);
-  size_t realosize = (block) ? osize : 0;
-  lua_assert((realosize == 0) == (block == NULL));
-#if defined(HARDMEMTESTS)
-  if (nsize > realosize && g->gcrunning)
-    luaC_fullgc(L, 1);  /* force a GC whenever possible */
-#endif
+  lua_assert((osize == 0) == (block == NULL));
+  hardtest(L, osize, nsize);
   newblock = (*g->frealloc)(g->ud, block, osize, nsize);
   if (newblock == NULL && nsize > 0) {
-    lua_assert(nsize > realosize);  /* cannot fail when shrinking a block */
+    lua_assert(nsize > osize);  /* cannot fail when shrinking a block */
     if (g->version) {  /* is state fully built? */
       luaC_fullgc(L, 1);  /* try to free some memory... */
       newblock = (*g->frealloc)(g->ud, block, osize, nsize);  /* try again */
@@ -94,7 +129,27 @@ void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
       luaD_throw(L, LUA_ERRMEM);
   }
   lua_assert((nsize == 0) == (newblock == NULL));
-  g->GCdebt = (g->GCdebt + nsize) - realosize;
+  g->GCdebt = (g->GCdebt + nsize) - osize;
   return newblock;
 }
 
+
+void *luaM_malloc (lua_State *L, size_t size, int tag) {
+  hardtest(L, 0, size);
+  if (size == 0)
+    return NULL;  /* that's all */
+  else {
+    global_State *g = G(L);
+    void *newblock = (*g->frealloc)(g->ud, NULL, tag, size);
+    if (newblock == NULL) {
+      if (g->version) {  /* is state fully built? */
+        luaC_fullgc(L, 1);  /* try to free some memory... */
+        newblock = (*g->frealloc)(g->ud, NULL, tag, size);  /* try again */
+      }
+      if (newblock == NULL)
+        luaD_throw(L, LUA_ERRMEM);
+    }
+    g->GCdebt += size;
+    return newblock;
+  }
+}
diff --git a/lmem.h b/lmem.h
index 7af316f0..4ccb88ab 100644
--- a/lmem.h
+++ b/lmem.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.h,v 1.42 2014/12/19 13:45:40 roberto Exp roberto $
+** $Id: lmem.h,v 1.43 2014/12/19 17:26:14 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -15,11 +15,9 @@
 
 
 /*
-** This macro reallocs a vector 'b' from 'on' to 'n' elements, where
-** each element has size 'e'. In case of arithmetic overflow of the
-** product 'n'*'e', it raises an error (calling 'luaM_toobig'). Because
-** 'e' is always constant, it avoids the runtime division MAX_SIZET/(e).
-**
+** This macro tests whether it is safe to multiply 'n' by the size of
+** type 't' without overflows. Because 'e' is always constant, it avoids
+** the runtime division MAX_SIZET/(e).
 ** (The macro is somewhat complex to avoid warnings:  The 'sizeof'
 ** comparison avoids a runtime comparison when overflow cannot occur.
 ** The compiler should be able to optimize the real test by itself, but
@@ -27,10 +25,20 @@
 ** false due to limited range of data type"; the +1 tricks the compiler,
 ** avoiding this warning but also this optimization.)
 */
+#define luaM_testsize(n,e)  \
+        (sizeof(n) >= sizeof(size_t) && cast(size_t, (n)) + 1 > MAX_SIZET/(e))
+
+#define luaM_checksize(L,n,e)  \
+        (luaM_testsize(n,e) ? luaM_toobig(L) : cast_void(0))
+
+/*
+** This macro reallocs a vector 'b' from 'on' to 'n' elements, where
+** each element has size 'e'. In case of arithmetic overflow of the
+** product 'n'*'e', it raises an error (calling 'luaM_toobig').
+*/
 #define luaM_reallocv(L,b,on,n,e) \
-  (((sizeof(n) >= sizeof(size_t) && cast(size_t, (n)) + 1 > MAX_SIZET/(e)) \
-      ? luaM_toobig(L) : cast_void(0)) , \
-   luaM_realloc_(L, (b), (on)*(e), (n)*(e)))
+  (luaM_checksize(L,n,e), \
+   luaM_realloc_(L, (b), cast(size_t, on)*(e), cast(size_t, n)*(e)))
 
 /*
 ** Arrays of chars do not need any test
@@ -38,32 +46,37 @@
 #define luaM_reallocvchar(L,b,on,n)  \
     cast(char *, luaM_realloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
 
-#define luaM_freemem(L, b, s)   luaM_realloc_(L, (b), (s), 0)
-#define luaM_free(L, b)         luaM_realloc_(L, (b), sizeof(*(b)), 0)
-#define luaM_freearray(L, b, n)   luaM_realloc_(L, (b), (n)*sizeof(*(b)), 0)
+#define luaM_freemem(L, b, s)   luaM_free_(L, (b), (s))
+#define luaM_free(L, b)         luaM_free_(L, (b), sizeof(*(b)))
+#define luaM_freearray(L, b, n)   luaM_free_(L, (b), (n)*sizeof(*(b)))
 
-#define luaM_malloc(L,s)        luaM_realloc_(L, NULL, 0, (s))
-#define luaM_new(L,t)           cast(t *, luaM_malloc(L, sizeof(t)))
+#define luaM_new(L,t)           cast(t *, luaM_malloc(L, sizeof(t), 0))
 #define luaM_newvector(L,n,t) \
-                cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t)))
+  (luaM_checksize(L,n,sizeof(t)), cast(t *, luaM_malloc(L, (n)*sizeof(t), 0)))
 
-#define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s))
+#define luaM_newobject(L,tag,s) luaM_malloc(L, (s), tag)
 
 #define luaM_growvector(L,v,nelems,size,t,limit,e) \
-          if ((nelems)+1 > (size)) \
-            ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e)))
+        ((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t),limit,e)))
 
 #define luaM_reallocvector(L, v,oldn,n,t) \
    ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t))))
 
+#define luaM_shrinkvector(L,v,size,fs,t) \
+   ((v)=cast(t *, luaM_shrinkvector_(L, v, &(size), fs, sizeof(t))))
+
 LUAI_FUNC l_noret luaM_toobig (lua_State *L);
 
 /* not to be called directly */
 LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
                                                           size_t size);
-LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size,
-                               size_t size_elem, int limit,
+LUAI_FUNC void luaM_free_ (lua_State *L, void *block, size_t osize);
+LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int nelems,
+                               int *size, int size_elem, int limit,
                                const char *what);
+LUAI_FUNC void *luaM_shrinkvector_ (lua_State *L, void *block, int *nelem,
+                                    int final_n, int size_elem);
+LUAI_FUNC void *luaM_malloc (lua_State *L, size_t size, int tag);
 
 #endif
 
diff --git a/lparser.c b/lparser.c
index 1d46c6f2..6155a851 100644
--- a/lparser.c
+++ b/lparser.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lparser.c,v 2.168 2017/11/23 16:35:54 roberto Exp roberto $
+** $Id: lparser.c,v 2.169 2017/11/30 13:29:18 roberto Exp roberto $
 ** Lua Parser
 ** See Copyright Notice in lua.h
 */
@@ -569,21 +569,14 @@ static void close_func (LexState *ls) {
   luaK_ret(fs, 0, 0);  /* final return */
   leaveblock(fs);
   luaK_finish(fs);
-  luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);
-  f->sizecode = fs->pc;
-  luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
-  f->sizelineinfo = fs->pc;
-  luaM_reallocvector(L, f->abslineinfo, f->sizeabslineinfo,
-                        fs->nabslineinfo, AbsLineInfo);
-  f->sizeabslineinfo = fs->nabslineinfo;
-  luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue);
-  f->sizek = fs->nk;
-  luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *);
-  f->sizep = fs->np;
-  luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);
-  f->sizelocvars = fs->nlocvars;
-  luaM_reallocvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
-  f->sizeupvalues = fs->nups;
+  luaM_shrinkvector(L, f->code, f->sizecode, fs->pc, Instruction);
+  luaM_shrinkvector(L, f->lineinfo, f->sizelineinfo, fs->pc, ls_byte);
+  luaM_shrinkvector(L, f->abslineinfo, f->sizeabslineinfo,
+                       fs->nabslineinfo, AbsLineInfo);
+  luaM_shrinkvector(L, f->k, f->sizek, fs->nk, TValue);
+  luaM_shrinkvector(L, f->p, f->sizep, fs->np, Proto *);
+  luaM_shrinkvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);
+  luaM_shrinkvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc);
   lua_assert(fs->bl == NULL);
   ls->fs = fs->prev;
   luaC_checkGC(L);