# New Ticket Created by  Angel Faus 
# Please include the string:  [perl #15425]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=15425 >


Hi,

This patch does the following things:
  - it includes patch #15358, that tries to make the regex engine 
GC-safe

  - it fixes a bug on the rx engine, that caused the Intstack on 
rxinfo not to be ever freed.

As a result of this bugfix, very simple regular expressions get a 
noticable speed-up. 

For example, this is the data of matching the pattern /^zza/ against 
"zzabbbbbbbbbcdcdcdcdzz" 100.000 times, with the loop inside parrot 
(or perl5)

parrot, without the patch         12.834 seconds
parrot, with the patch               1.216 seconds

perl 5                                      0.21 seconds

This is of course not representative data, the speed-up is much 
smaller for the average regex. 

-àngel


-- attachment  1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/31153/26111/ffdaea/perlreinfo.pmc

-- attachment  2 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/31153/26112/cf3c94/rx_patch.diff

/* Pointer.pmc
 *  Copyright: (When this is determined...it will go here)
 *  CVS Info
 *     $Id: pointer.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 dod 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;
	}
	fprintf(stderr, "Been here\n");
	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;
    }
}
--- 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 */
 
--- 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];
@@ -110,7 +111,10 @@
     /* Our refcount */
     PMC_refcount_field = 1 << 16 | 1 << 17,
     /* Constant flag */
-    PMC_constant_FLAG = 1 << 18
+    PMC_constant_FLAG = 1 << 18,
+    /* Immunity flag, for ensuring a PMC survives DOD. Used internally
+     * by the GC: should not be used in PMC code. */
+    PMC_immune_FLAG = 1 << 19
 } PMC_flags;
 
 /* XXX add various bit test macros once we have need of them */
--- parrot/include/parrot/rxstacks.h	Wed May 15 07:02:55 2002
+++ parrot_rx/include/parrot/rxstacks.h	Wed Jul 24 05:45:07 2002
@@ -38,6 +38,8 @@
 
 INTVAL intstack_pop(struct Parrot_Interp *, IntStack);
 
+void intstack_free(struct Parrot_Interp *, IntStack);
+
 #endif
 
 /*
--- parrot/rxstacks.c	Thu Jul  4 20:50:42 2002
+++ parrot_rx/rxstacks.c	Wed Jul 24 05:53:41 2002
@@ -101,6 +101,18 @@
     return entry->value;
 }
 
+
+void intstack_free (struct Parrot_Interp *interpreter, IntStack stack)
+{
+    IntStack chunk, temp;
+
+    for (chunk = stack->next; chunk != stack; chunk = temp) {
+        temp = chunk->next;        
+        mem_sys_free(chunk);
+    }
+
+    mem_sys_free(stack);
+}   
 /*
  * Local variables:
  * c-indentation-style: bsd
--- parrot/rx.ops	Thu Jul  4 20:32:38 2002
+++ parrot_rx/rx.ops	Wed Jul 24 06:09:55 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;
 
@@ -198,9 +198,10 @@
 }
 
 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;
 	
@@ -245,6 +246,7 @@
 =cut
 
 op rx_freeinfo(inout pmc) {
+	intstack_free( interpreter, ((rxinfo*)$1->data)->stack );
 	mem_sys_free($1->data);
 	$1->data=NULL;
 	

Reply via email to