Mercurial > vba-clojure

     1 /*

     2 ** $Id: lfunc.c,v 2.12.1.2 2007/12/28 14:58:43 roberto Exp $

     3 ** Auxiliary functions to manipulate prototypes and closures

     4 ** See Copyright Notice in lua.h

     5 */

     6 

     7 

     8 #include <stddef.h>

     9 

    10 #define lfunc_c

    11 #define LUA_CORE

    12 

    13 #include "lua.h"

    14 

    15 #include "lfunc.h"

    16 #include "lgc.h"

    17 #include "lmem.h"

    18 #include "lobject.h"

    19 #include "lstate.h"

    20 

    21 

    22 

    23 Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e) {

    24   Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));

    25   luaC_link(L, obj2gco(c), LUA_TFUNCTION);

    26   c->c.isC = 1;

    27   c->c.env = e;

    28   c->c.nupvalues = cast_byte(nelems);

    29   return c;

    30 }

    31 

    32 

    33 Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e) {

    34   Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));

    35   luaC_link(L, obj2gco(c), LUA_TFUNCTION);

    36   c->l.isC = 0;

    37   c->l.env = e;

    38   c->l.nupvalues = cast_byte(nelems);

    39   while (nelems--) c->l.upvals[nelems] = NULL;

    40   return c;

    41 }

    42 

    43 

    44 UpVal *luaF_newupval (lua_State *L) {

    45   UpVal *uv = luaM_new(L, UpVal);

    46   luaC_link(L, obj2gco(uv), LUA_TUPVAL);

    47   uv->v = &uv->u.value;

    48   setnilvalue(uv->v);

    49   return uv;

    50 }

    51 

    52 

    53 UpVal *luaF_findupval (lua_State *L, StkId level) {

    54   global_State *g = G(L);

    55   GCObject **pp = &L->openupval;

    56   UpVal *p;

    57   UpVal *uv;

    58   while (*pp != NULL && (p = ngcotouv(*pp))->v >= level) {

    59     lua_assert(p->v != &p->u.value);

    60     if (p->v == level) {  /* found a corresponding upvalue? */

    61       if (isdead(g, obj2gco(p)))  /* is it dead? */

    62         changewhite(obj2gco(p));  /* ressurect it */

    63       return p;

    64     }

    65     pp = &p->next;

    66   }

    67   uv = luaM_new(L, UpVal);  /* not found: create a new one */

    68   uv->tt = LUA_TUPVAL;

    69   uv->marked = luaC_white(g);

    70   uv->v = level;  /* current value lives in the stack */

    71   uv->next = *pp;  /* chain it in the proper position */

    72   *pp = obj2gco(uv);

    73   uv->u.l.prev = &g->uvhead;  /* double link it in `uvhead' list */

    74   uv->u.l.next = g->uvhead.u.l.next;

    75   uv->u.l.next->u.l.prev = uv;

    76   g->uvhead.u.l.next = uv;

    77   lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);

    78   return uv;

    79 }

    80 

    81 

    82 static void unlinkupval (UpVal *uv) {

    83   lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);

    84   uv->u.l.next->u.l.prev = uv->u.l.prev;  /* remove from `uvhead' list */

    85   uv->u.l.prev->u.l.next = uv->u.l.next;

    86 }

    87 

    88 

    89 void luaF_freeupval (lua_State *L, UpVal *uv) {

    90   if (uv->v != &uv->u.value)  /* is it open? */

    91     unlinkupval(uv);  /* remove from open list */

    92   luaM_free(L, uv);  /* free upvalue */

    93 }

    94 

    95 

    96 void luaF_close (lua_State *L, StkId level) {

    97   UpVal *uv;

    98   global_State *g = G(L);

    99   while (L->openupval != NULL && (uv = ngcotouv(L->openupval))->v >= level) {

   100     GCObject *o = obj2gco(uv);

   101     lua_assert(!isblack(o) && uv->v != &uv->u.value);

   102     L->openupval = uv->next;  /* remove from `open' list */

   103     if (isdead(g, o))

   104       luaF_freeupval(L, uv);  /* free upvalue */

   105     else {

   106       unlinkupval(uv);

   107       setobj(L, &uv->u.value, uv->v);

   108       uv->v = &uv->u.value;  /* now current value lives here */

   109       luaC_linkupval(L, uv);  /* link upvalue into `gcroot' list */

   110     }

   111   }

   112 }

   113 

   114 

   115 Proto *luaF_newproto (lua_State *L) {

   116   Proto *f = luaM_new(L, Proto);

   117   luaC_link(L, obj2gco(f), LUA_TPROTO);

   118   f->k = NULL;

   119   f->sizek = 0;

   120   f->p = NULL;

   121   f->sizep = 0;

   122   f->code = NULL;

   123   f->sizecode = 0;

   124   f->sizelineinfo = 0;

   125   f->sizeupvalues = 0;

   126   f->nups = 0;

   127   f->upvalues = NULL;

   128   f->numparams = 0;

   129   f->is_vararg = 0;

   130   f->maxstacksize = 0;

   131   f->lineinfo = NULL;

   132   f->sizelocvars = 0;

   133   f->locvars = NULL;

   134   f->linedefined = 0;

   135   f->lastlinedefined = 0;

   136   f->source = NULL;

   137   return f;

   138 }

   139 

   140 

   141 void luaF_freeproto (lua_State *L, Proto *f) {

   142   luaM_freearray(L, f->code, f->sizecode, Instruction);

   143   luaM_freearray(L, f->p, f->sizep, Proto *);

   144   luaM_freearray(L, f->k, f->sizek, TValue);

   145   luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);

   146   luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);

   147   luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);

   148   luaM_free(L, f);

   149 }

   150 

   151 

   152 void luaF_freeclosure (lua_State *L, Closure *c) {

   153   int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) :

   154                           sizeLclosure(c->l.nupvalues);

   155   luaM_freemem(L, c, size);

   156 }

   157 

   158 

   159 /*

   160 ** Look for n-th local variable at line `line' in function `func'.

   161 ** Returns NULL if not found.

   162 */

   163 const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {

   164   int i;

   165   for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {

   166     if (pc < f->locvars[i].endpc) {  /* is variable active? */

   167       local_number--;

   168       if (local_number == 0)

   169         return getstr(f->locvars[i].varname);

   170     }

   171   }

   172   return NULL;  /* not found */

   173 }

   174
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 24 May 2012 17:33:25 -0500
parents	27763b933818
children