Author: chromatic
Date: Thu Feb 21 17:20:35 2008
New Revision: 25964
Modified:
trunk/languages/lua/pmc/lua.pmc
Log:
[Lua] Cleaned up Lua PMC.
As part of this, I made it clean itself up on initialization, so that you can
run multiple Lua processes cleanly from multiple Parrot sessions through
embedding.
Modified: trunk/languages/lua/pmc/lua.pmc
==============================================================================
--- trunk/languages/lua/pmc/lua.pmc (original)
+++ trunk/languages/lua/pmc/lua.pmc Thu Feb 21 17:20:35 2008
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2006-2007, The Perl Foundation.
+Copyright (C) 2006-2008, The Perl Foundation.
$Id$
=head1 NAME
@@ -35,19 +35,21 @@
static STRING*
context_infostr(PARROT_INTERP, parrot_context_t *ctx)
{
- struct Parrot_Context_info info;
+ Parrot_Context_info info;
STRING *res = NULL;
Parrot_block_DOD(interp);
+
if (Parrot_Context_get_info(interp, ctx, &info)) {
char *file = info.file;
- res = Parrot_sprintf_c(interp, "\t%s:%d in function '%Ss'\n",
+ res = Parrot_sprintf_c(interp, "\t%s:%d in function '%Ss'\n",
file, info.line, info.subname);
/* free the non-constant string, but not the constant one */
if (strncmp("(unknown file)", file, 14) < 0)
string_cstring_free(file);
}
+
Parrot_unblock_DOD(interp);
return res;
@@ -63,6 +65,8 @@
* Class initialization.
*/
void class_init() {
+ Lua_PMC = NULL;
+
if (pass) {
dynpmc_LuaBoolean = pmc_type(INTERP,
const_string(INTERP, "LuaBoolean"));
@@ -99,8 +103,8 @@
return Lua_PMC;
}
- void set_pointer(void* ptr) {
- Lua_PMC = (PMC*) ptr;
+ void set_pointer(void *ptr) {
+ Lua_PMC = (PMC *)ptr;
}
/*
@@ -117,8 +121,9 @@
while (1) {
PMC *cont;
if (PMC_metadata(ctx->current_sub) != NULL) {
- struct Parrot_Context_info info;
+ Parrot_Context_info info;
Parrot_block_DOD(INTERP);
+
if (Parrot_Context_get_info(INTERP, ctx, &info)) {
/* free the non-constant string, but not the constant one
*/
if (strncmp("(unknown file)", info.file, 14) < 0)
@@ -132,9 +137,12 @@
}
cont = ctx->current_cont;
+
if (!cont)
break;
+
ctx = PMC_cont(cont)->to_ctx;
+
if (!ctx)
break;
}
@@ -150,46 +158,45 @@
*/
METHOD PMC* clock() {
- PMC *retval = pmc_new(INTERP, dynpmc_LuaNumber);
- FLOATVAL f = ((FLOATVAL)clock())/(FLOATVAL)CLOCKS_PER_SEC;
+ PMC *retval = pmc_new(INTERP, dynpmc_LuaNumber);
+ FLOATVAL f = ((FLOATVAL)clock())/(FLOATVAL)CLOCKS_PER_SEC;
VTABLE_set_number_native(INTERP, retval, f);
return retval;
}
/*
-=item C<PMC* frexp(PMC* x)>
+=item C<PMC* frexp(PMC *x)>
=cut
*/
- METHOD PMC* frexp(PMC* x) {
- PMC *y;
- PMC *expn;
- PMC *retval;
- int e;
+ METHOD PMC* frexp(PMC *x) {
+ PMC *y = pmc_new(INTERP, dynpmc_LuaNumber);
+ PMC *expn = pmc_new(INTERP, dynpmc_LuaNumber);
+ PMC *retval = pmc_new(INTERP, enum_class_Array);
+ int e;
- y = pmc_new(INTERP, dynpmc_LuaNumber);
- expn = pmc_new(INTERP, dynpmc_LuaNumber);
VTABLE_set_number_native(INTERP, y,
frexp(VTABLE_get_number(INTERP, x), &e));
VTABLE_set_integer_native(INTERP, expn, e);
- retval = pmc_new(INTERP, enum_class_Array);
VTABLE_set_integer_native(INTERP, retval, 2);
VTABLE_set_pmc_keyed_int(INTERP, retval, 0, y);
VTABLE_set_pmc_keyed_int(INTERP, retval, 1, expn);
+
return retval;
}
/*
-=item C<PMC* ldexp(PMC* x, PMC* expn)>
+=item C<PMC* ldexp(PMC *x, PMC *expn)>
=cut
*/
- METHOD PMC* ldexp(PMC* x, PMC* expn) {
+ METHOD PMC* ldexp(PMC *x, PMC *expn) {
PMC *retval = pmc_new(INTERP, dynpmc_LuaNumber);
+
VTABLE_set_number_native(INTERP, retval,
ldexp(VTABLE_get_number(INTERP, x),
VTABLE_get_integer(INTERP, expn)));
@@ -198,86 +205,84 @@
/*
-=item C<PMC* mktime(PMC* tm)>
+=item C<PMC* mktime(PMC *tm)>
=cut
*/
- METHOD PMC* mktime(PMC* tm) {
- PMC *retval;
+ METHOD PMC* mktime(PMC *tm) {
time_t t;
struct tm ts;
- ts.tm_sec = VTABLE_get_integer_keyed_int(INTERP, tm, 0);
- ts.tm_min = VTABLE_get_integer_keyed_int(INTERP, tm, 1);
- ts.tm_hour = VTABLE_get_integer_keyed_int(INTERP, tm, 2);
- ts.tm_mday = VTABLE_get_integer_keyed_int(INTERP, tm, 3);
- ts.tm_mon = VTABLE_get_integer_keyed_int(INTERP, tm, 4);
- ts.tm_year = VTABLE_get_integer_keyed_int(INTERP, tm, 5);
+ ts.tm_sec = VTABLE_get_integer_keyed_int(INTERP, tm, 0);
+ ts.tm_min = VTABLE_get_integer_keyed_int(INTERP, tm, 1);
+ ts.tm_hour = VTABLE_get_integer_keyed_int(INTERP, tm, 2);
+ ts.tm_mday = VTABLE_get_integer_keyed_int(INTERP, tm, 3);
+ ts.tm_mon = VTABLE_get_integer_keyed_int(INTERP, tm, 4);
+ ts.tm_year = VTABLE_get_integer_keyed_int(INTERP, tm, 5);
ts.tm_isdst = VTABLE_get_integer_keyed_int(INTERP, tm, 8);
+
t = mktime(&ts);
- if (t == -1) {
- retval = pmc_new(INTERP, dynpmc_LuaNil);
- }
+
+ if (t == -1)
+ return pmc_new(INTERP, dynpmc_LuaNil);
else {
- retval = pmc_new(INTERP, dynpmc_LuaNumber);
+ PMC *retval = pmc_new(INTERP, dynpmc_LuaNumber);
VTABLE_set_integer_native(INTERP, retval, t);
+ return retval;
}
- return retval;
}
/*
-=item C<PMC* modf(PMC* x)>
+=item C<PMC* modf(PMC *x)>
=cut
*/
- METHOD PMC* modf(PMC* x) {
- PMC *y;
- PMC *d;
- PMC *retval;
+ METHOD PMC* modf(PMC *x) {
+ PMC *y = pmc_new(INTERP, dynpmc_LuaNumber);
+ PMC *d = pmc_new(INTERP, dynpmc_LuaNumber);
+ PMC *retval = pmc_new(INTERP, enum_class_Array);
FLOATVAL _d;
- y = pmc_new(INTERP, dynpmc_LuaNumber);
- d = pmc_new(INTERP, dynpmc_LuaNumber);
VTABLE_set_number_native(INTERP, y,
modf(VTABLE_get_number(INTERP, x), &_d));
VTABLE_set_number_native(INTERP, d, _d);
- retval = pmc_new(INTERP, enum_class_Array);
VTABLE_set_integer_native(INTERP, retval, 2);
VTABLE_set_pmc_keyed_int(INTERP, retval, 0, d);
VTABLE_set_pmc_keyed_int(INTERP, retval, 1, y);
+
return retval;
}
/*
-=item C<PMC* setlocale(INTVAL category, STRING* locale)>
+=item C<PMC* setlocale(INTVAL category, STRING *locale)>
=cut
*/
- METHOD PMC* setlocale(INTVAL category, STRING* locale) {
- PMC *retval;
+ METHOD PMC* setlocale(INTVAL category, STRING *locale) {
static const int cat[] = {
LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, LC_TIME
};
+
char *loc = (locale != NULL) ? string_to_cstring(INTERP, locale) :
NULL;
- char *p = setlocale(cat[category], loc);
- if (p == NULL) {
- retval = pmc_new(INTERP, dynpmc_LuaNil);
- }
- else {
- retval = pmc_new(INTERP, dynpmc_LuaString);
+ char *p = setlocale(cat[category], loc);
+
+ if (p) {
+ PMC *retval = pmc_new(INTERP, dynpmc_LuaString);
VTABLE_set_string_native(INTERP, retval,
string_from_cstring(INTERP, p, 0));
+ return retval;
}
- return retval;
+ else
+ return pmc_new(INTERP, dynpmc_LuaNil);
}
/*
-=item C<STRING* strftime(STRING* fmt, PMC* tm)>
+=item C<STRING* strftime(STRING *fmt, PMC *tm)>
=cut
@@ -298,7 +303,10 @@
stm.tm_yday = VTABLE_get_integer_keyed_int(INTERP, tm, 7);
stm.tm_isdst = VTABLE_get_integer_keyed_int(INTERP, tm, 8);
- reslen = strftime(b, sizeof b, s, &stm);
+ reslen = strftime(b, sizeof b, s, &stm);
+
+ string_cstring_free(s);
+
return string_from_cstring(INTERP, b, reslen);
}
@@ -317,14 +325,16 @@
#else
strcpy(buff, "/tmp/lua_XXXXXX");
e = mkstemp(buff);
- if (e != -1) close(e);
+
+ if (e != -1)
+ close(e);
+
e = (e == -1);
#endif
- if (e) {
+ if (e)
real_exception(INTERP, NULL, 1,
"unable to generate a unique filename");
- return NULL;
- }
+
return string_from_cstring(INTERP, buff, 0);
}
@@ -336,31 +346,34 @@
*/
METHOD STRING* traceback(INTVAL level) {
- STRING *bt;
+ STRING *bt = string_from_literal(INTERP, "stack traceback:\n");
STRING *str;
- parrot_context_t *ctx;
- bt = string_from_literal(INTERP, "stack traceback:\n");
/* information about the current sub */
- ctx = CONTEXT(INTERP->ctx);
+ parrot_context_t *ctx = CONTEXT(INTERP->ctx);
if (level == 0) {
str = context_infostr(INTERP, ctx);
- bt = string_append(INTERP, bt, str);
+ bt = string_append(INTERP, bt, str);
}
/* backtrace: follow the continuation chain */
while (1) {
PMC *cont = ctx->current_cont;
+
if (!cont)
break;
+
ctx = PMC_cont(cont)->to_ctx;
+
if (!ctx)
break;
str = context_infostr(INTERP, ctx);
+
if (!str)
break;
+
bt = string_append(INTERP, bt, str);
}
@@ -381,13 +394,15 @@
while (1) {
PMC *cont;
PMC *sub = ctx->current_sub;
- if (PMC_metadata(sub) != NULL
- && VTABLE_isa(INTERP, sub, const_string(INTERP, "LuaClosure"))) {
- struct Parrot_Context_info info;
+ if (PMC_metadata(sub)
+ && VTABLE_isa(INTERP, sub, const_string(INTERP, "LuaClosure"))) {
+ Parrot_Context_info info;
Parrot_block_DOD(INTERP);
+
if (Parrot_Context_get_info(INTERP, ctx, &info)) {
STRING* res = Parrot_sprintf_c(INTERP, "%s:%d:",
info.file, info.line);
+
/* free the non-constant string, but not the constant one
*/
if (strncmp("(unknown file)", info.file, 14) < 0)
string_cstring_free(info.file);
@@ -400,16 +415,18 @@
}
cont = ctx->current_cont;
+
if (!cont)
break;
+
ctx = PMC_cont(cont)->to_ctx;
+
if (!ctx)
break;
}
return const_string(INTERP, "_._:0:");
}
-
}
/*
