# New Ticket Created by Angel Faus
# Please include the string: [perl #15358]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=15358 >
This patch apparently makes the rx engine behave well with the GC:
It creates a new pmc class PerlReInfo, that is exactly like
PerlPointer, but with the "mark" method implemented, so the string in
rxinfo gets doesn't get collected.
-àngel
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/31020/25999/42a3c8/safe_rx.diff
diff -urN parrot/classes/perlreinfo.pmc parrot_rx/classes/perlreinfo.pmc
--- parrot/classes/perlreinfo.pmc Thu Jan 1 01:00:00 1970
+++ parrot_rx/classes/perlreinfo.pmc Tue Jul 23 07:18:03 2002
@@ -0,0 +1,137 @@
+/* PerlReInfo.pmc
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: perlreinfo.pmc,v 1.1 2002/07/04 18:30:00 mrjoltcola Exp $
+ * Overview:
+ * These are the vtable functions for the PerlReInfo class
+ * It's just a Pointer class, with a mark method added.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes: The actual pointer is in ->data
+ * References:
+ */
+
+#include "parrot/parrot.h"
+#include "parrot/rx.h"
+
+#define POINTER_ERROR internal_exception(PARROT_POINTER_ERROR, "An illegal operation was performed on a Pointer (vtable function at %s line %d).\n", __FILE__, __LINE__);
+
+pmclass PerlReInfo {
+
+ void init () {
+ SELF->data=NULL;
+ SELF->flags=PMC_private_GC_FLAG;
+ }
+
+ PMC* mark (PMC* tail) {
+ rxinfo *rx = SELF->data;
+ if (rx != NULL) {
+ rx->string->flags |= BUFFER_live_FLAG;
+ }
+ return tail;
+ }
+
+ void morph (INTVAL type) {
+ }
+
+ void destroy () {
+ }
+
+ INTVAL type () {
+ return enum_class_Pointer;
+ }
+
+ STRING* name () {
+ return whoami;
+ }
+
+ PMC* clone () {
+ PMC *dest;
+ dest = pmc_new(INTERP, enum_class_Pointer);
+ dest->data=SELF->data;
+ return dest;
+ }
+
+ INTVAL get_integer () {
+ return (INTVAL)SELF->data;
+ }
+
+ FLOATVAL get_number () {
+ return (FLOATVAL)(INTVAL)SELF->data;
+ }
+
+ STRING* get_string () {
+ STRING* ret;
+ char *target=mem_sys_allocate(64);
+
+ /* XXX Dangerous if you have a 196-bit system or above
+ (and if you do, you have too comfortable a life and
+ deserve to be tormented by coredumps). */
+ sprintf(target, "Pointer=0x%p", SELF->data);
+ ret=string_make(interpreter, target, strlen(target), 0, 0, 0);
+
+ mem_sys_free(target);
+ return ret;
+ }
+
+ INTVAL get_bool () {
+ return (INTVAL)(SELF->data != NULL);
+ }
+
+ INTVAL is_same (PMC* pmc2) {
+ return (INTVAL)(SELF->vtable == pmc2->vtable && SELF->data == pmc2->data);
+ }
+
+ void set_integer (PMC* value) {
+ POINTER_ERROR;
+ }
+
+ void set_integer_native (INTVAL value) {
+ POINTER_ERROR;
+ }
+
+ void set_integer_bignum (BIGNUM* value) {
+ POINTER_ERROR;
+ }
+
+ void set_integer_same (PMC* value) {
+ POINTER_ERROR;
+ }
+
+ void set_number (PMC* value) {
+ POINTER_ERROR;
+ }
+
+ void set_number_native (FLOATVAL value) {
+ POINTER_ERROR;
+ }
+
+ void set_number_bignum (BIGNUM* value) {
+ POINTER_ERROR;
+ }
+
+ void set_number_same (PMC* value) {
+ POINTER_ERROR;
+ }
+
+ void set_string (PMC* value) {
+ POINTER_ERROR;
+ }
+
+ void set_string_native (STRING* value) {
+ POINTER_ERROR;
+ }
+
+ void set_string_unicode (STRING* value) {
+ POINTER_ERROR;
+ }
+
+ void set_string_other (STRING* value) {
+ POINTER_ERROR;
+ }
+
+ void set_string_same (PMC* value) {
+ POINTER_ERROR;
+ }
+}
diff -urN parrot/global_setup.c parrot_rx/global_setup.c
--- parrot/global_setup.c Thu Jul 4 20:32:38 2002
+++ parrot_rx/global_setup.c Tue Jul 23 07:17:45 2002
@@ -32,6 +32,7 @@
Parrot_IntQueue_class_init(enum_class_IntQueue);
Parrot_Sub_class_init(enum_class_Sub);
Parrot_Coroutine_class_init(enum_class_Coroutine);
+ Parrot_PerlReInfo_class_init(enum_class_PerlReInfo);
/* Now register the names of the PMCs */
diff -urN parrot/include/parrot/pmc.h parrot_rx/include/parrot/pmc.h
--- parrot/include/parrot/pmc.h Thu Jul 18 06:30:42 2002
+++ parrot_rx/include/parrot/pmc.h Tue Jul 23 07:18:39 2002
@@ -1,7 +1,7 @@
/* pmc.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: pmc.h,v 1.32 2002/07/18 04:30:42 mongo Exp $
+ * $Id: pmc.h,v 1.31 2002/07/04 18:31:20 mrjoltcola Exp $
* Overview:
* This is the api header for the pmc subsystem
* Data Structure and Algorithms:
@@ -27,6 +27,7 @@
enum_class_Coroutine,
enum_class_Closure,
enum_class_Continuation,
+ enum_class_PerlReInfo,
enum_class_max = 100
};
VAR_SCOPE VTABLE Parrot_base_vtables[enum_class_max];
diff -urN parrot/rx.ops parrot_rx/rx.ops
--- parrot/rx.ops Thu Jul 4 20:32:38 2002
+++ parrot_rx/rx.ops Tue Jul 23 07:19:01 2002
@@ -190,7 +190,7 @@
op rx_allocinfo(out pmc, in str) {
rxinfo *rx=rx_allocate_info(interpreter, $2);
- $1=pmc_new(interpreter, enum_class_Pointer);
+ $1=pmc_new(interpreter, enum_class_PerlReInfo);
$1->data=(void*)rx;
@@ -200,7 +200,7 @@
op rx_allocinfo(out pmc, in pmc) {
rxinfo *rx=rx_allocate_info(interpreter, $2->vtable->get_string(interpreter, $2));
- $1=pmc_new(interpreter, enum_class_Pointer);
+ $1=pmc_new(interpreter, enum_class_PerlReInfo);
$1->data=(void*)rx;
