cvsuser 04/02/07 08:44:34
Modified: include/parrot string_funcs.h
src dynext.c interpreter.c string.c
t/pmc nci.t
Log:
pdd16-2
* fix GC related segfault (returning a PMC that isn't one was
not the best idea)
* create new string interface const_string()
Revision Changes Path
1.33 +2 -1 parrot/include/parrot/string_funcs.h
Index: string_funcs.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string_funcs.h,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -w -r1.32 -r1.33
--- string_funcs.h 15 Nov 2003 15:30:43 -0000 1.32
+++ string_funcs.h 7 Feb 2004 16:44:24 -0000 1.33
@@ -1,7 +1,7 @@
/* string_funcs.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string_funcs.h,v 1.32 2003/11/15 15:30:43 petergibbs Exp $
+ * $Id: string_funcs.h,v 1.33 2004/02/07 16:44:24 leo Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -59,6 +59,7 @@
INTVAL string_str_index(struct Parrot_Interp *interpreter, const STRING *s,
const STRING *s2, UINTVAL start);
STRING *string_from_cstring(struct Parrot_Interp *, const void *, UINTVAL);
+STRING *const_string(struct Parrot_Interp *, const char *);
char *string_to_cstring(struct Parrot_Interp *, STRING *);
void string_cstring_free(void *);
void string_pin(struct Parrot_Interp *, STRING *);
1.19 +6 -6 parrot/src/dynext.c
Index: dynext.c
===================================================================
RCS file: /cvs/public/parrot/src/dynext.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- dynext.c 26 Jan 2004 23:16:05 -0000 1.18
+++ dynext.c 7 Feb 2004 16:44:30 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dynext.c,v 1.18 2004/01/26 23:16:05 mikescott Exp $
+$Id: dynext.c,v 1.19 2004/02/07 16:44:30 leo Exp $
=head1 NAME
@@ -41,7 +41,7 @@
prop = pmc_new(interpreter, enum_class_PerlString);
VTABLE_set_string_native(interpreter, prop, name);
- key = string_from_cstring(interpreter, what, 0);
+ key = const_string(interpreter, what);
VTABLE_setprop(interpreter, lib_pmc, key, prop);
}
@@ -105,7 +105,7 @@
return NULL;
}
n = VTABLE_elements(interpreter, dyn_libs);
- key = string_from_cstring(interpreter, "_filename", 0);
+ key = const_string(interpreter, "_filename");
/* we could use an ordered hash for faster lookup here */
for (i = 0; i < n; i++) {
lib_pmc = VTABLE_get_pmc_keyed_int(interpreter, dyn_libs, i);
@@ -251,15 +251,15 @@
* s. also build_tools/ops2c.pl and lib/Parrot/Pmc2c.pm
*/
lib_pmc = pmc_new(interpreter, enum_class_ParrotLibrary);
- type = string_from_cstring(interpreter, "NCI", 0);
+ type = const_string(interpreter, "NCI");
}
else {
lib_pmc = (*load_func)(interpreter);
/* we could set a private flag in the PMC header too
* but currently only ops files have struct_val set
*/
- type = string_from_cstring(interpreter,
- lib_pmc->cache.struct_val ? "Ops" : "PMC", 0);
+ type = const_string(interpreter,
+ lib_pmc->cache.struct_val ? "Ops" : "PMC");
}
/*
* call init, if it exists
1.263 +8 -4 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.262
retrieving revision 1.263
diff -u -w -r1.262 -r1.263
--- interpreter.c 7 Feb 2004 12:58:53 -0000 1.262
+++ interpreter.c 7 Feb 2004 16:44:31 -0000 1.263
@@ -1,7 +1,7 @@
/*
################################################################################
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: interpreter.c,v 1.262 2004/02/07 12:58:53 leo Exp $
+$Id: interpreter.c,v 1.263 2004/02/07 16:44:31 leo Exp $
################################################################################
=head1 NAME
@@ -1144,7 +1144,7 @@
PMC*
Parrot_make_cb(Parrot_Interp interpreter, PMC* sub, PMC* user_data)
{
- PMC* interp_pmc;
+ PMC* interp_pmc, *cb;
/*
* we stuff all the information into the Sub PMC and pass that
* on to the external sub
@@ -1168,10 +1168,14 @@
/*
* finally the external lib awaits a function pointer
- * fake a PMC that points to Parrot_callback_C (or _D)
+ * create a PMC that points to Parrot_callback_C (or _D)
+ * it can be passed on with signature 'p'
*/
+ cb = pmc_new(interpreter, enum_class_UnManagedStruct);
+ PMC_data(cb) = F2DPTR(Parrot_callback_C);
+ dod_register_pmc(interpreter, cb);
- return F2DPTR(Parrot_callback_C);
+ return cb;
}
/*
1.171 +20 -5 parrot/src/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.170
retrieving revision 1.171
diff -u -w -r1.170 -r1.171
--- string.c 29 Jan 2004 14:49:39 -0000 1.170
+++ string.c 7 Feb 2004 16:44:31 -0000 1.171
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: string.c,v 1.170 2004/01/29 14:49:39 mikescott Exp $
+$Id: string.c,v 1.171 2004/02/07 16:44:31 leo Exp $
=head1 NAME
@@ -304,18 +304,33 @@
Make a C<STRING *> from a passed in C string.
+=item C<
+STRING *
+const_string(struct Parrot_Interp *interpreter, const char *buffer)>
+
+Make a constant STRING from a const C string.
+
=cut
*/
STRING *
string_from_cstring(struct Parrot_Interp *interpreter, const void *buffer,
- UINTVAL len) {
+ UINTVAL len)
+{
return string_make(interpreter, buffer, len ? len :
buffer ? strlen(buffer) : 0,
NULL, 0, NULL);
}
+STRING *
+const_string(struct Parrot_Interp *interpreter, const char *buffer)
+{
+ /* TODO cache the strings */
+ return string_make(interpreter, buffer, strlen(buffer),
+ NULL, PObj_external_FLAG|PObj_constant_FLAG, NULL);
+}
+
/*
=item C<STRING *
1.29 +1 -2 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- nci.t 7 Feb 2004 12:58:59 -0000 1.28
+++ nci.t 7 Feb 2004 16:44:33 -0000 1.29
@@ -825,7 +825,6 @@
output_is(<<'CODE', <<'OUTPUT', "nci_cb_C1");
bounds 1 # no JIT yet
- sweepoff # SEGV in dynext.c:235
# we need a flag if the call_back is already done
new P10, .PerlInt
store_global "cb_done", P10
@@ -843,7 +842,7 @@
invoke
# now call the external sub, that takes a call_back and user_data
loadlib P1, "libnci"
- dlfunc P0, P1, "nci_cb_C1", "vPP"
+ dlfunc P0, P1, "nci_cb_C1", "vpP"
print "ok 2\n"
# P5 is the cb
# get user_data i.e. the Sub
