The attached patch adds a PMC class that just contains a pointer.  (Yes,
this is based on the Handle stuff I submitted a week or so ago.)  You
generally don't create these in the bytecode, but C functions will
create them and stuff them for you.  Get operations do what you expect;
the string representation is "ParrotPointer=0xADDRE55" (with the
appropriate "addre55" filled in).  Set operations don't work, except for
set_value, which will morph the PMC into whatever type is appropriate.
It does free() the memory for you; however, it doesn't do anything
deeper than that.  If you want a more complicated destructor, you'll
have to subclass it.

No tests are included, since you'd basically have to write new ops to
stuff them for them to work.

I've already cleared the idea with Dan; I'd just like some people to
look over the implementation before it's committed.

This patch is in preparation for regular expressions, which will be
submitted as soon as allocating PerlArrays and then allocating something
else stops segfaulting on native Windows builds.

--Brent Dax
[EMAIL PROTECTED]
Configure pumpking for Perl 6

<obra> mmmm. hawt sysadmin chx0rs
<lathos> This is sad. I know of *a* hawt sysamin chx0r.
<obra> I know more than a few.
<lathos> obra: There are two? Are you sure it's not the same one?
--- /dev/null   Wed Dec 31 16:00:00 1969
+++ classes/parrotpointer.pmc   Tue Jan  8 15:12:50 2002
@@ -0,0 +1,154 @@
+/* parrotpointer.pmc
+ *  Copyright: (When this is determined...it will go here)
+ *  CVS Info
+ *     $Id$
+ *  Overview:
+ *     These are the vtable functions for the ParrotPointer base class
+ *  Data Structure and Algorithms:
+ *  History:
+ *  Notes:  The actual pointer is in ->data
+ *  References:
+ */
+
+#include "parrot/parrot.h"
+#define ERROR fprintf(stderr, "An illegal operation was performed on a ParrotPointer 
+(vtable function at %s line %d).\n", __FILE__, __LINE__); exit(1); return 0;
+
+pmclass ParrotPointer {
+   INTVAL type () {
+      return 0;
+   }
+
+   STRING* name () {
+      return whoami;
+   }
+
+   void init () {
+      SELF->data=NULL;
+   }
+
+   void clone (PMC* dest) {
+      dest->vtable=SELF->vtable;
+      dest->data=SELF->data;
+   }
+
+   void morph (INTVAL type) {
+   }
+
+   BOOLVAL move_to (void * destination) {
+      return 0;
+   }
+
+   INTVAL real_size () {
+      return 0;
+   }
+
+   void destroy () {
+      if(SELF->data) {
+         mem_sys_free(SELF->data);
+      }
+   }
+
+   INTVAL get_integer () {
+      return (INTVAL)SELF->data;
+   }
+
+   FLOATVAL get_number () {
+      return (FLOATVAL)(INTVAL)SELF->data;
+   }
+
+   FLOATVAL get_number_index (INTVAL index) {
+   }
+
+   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, "ParrotPointer=0x%p", SELF->data);
+      ret=string_make(interpreter, target, strlen(target), 0, 0, 0);
+
+      mem_sys_free(target);
+      return ret;
+   }
+
+   BOOLVAL get_bool () {
+      return (BOOLVAL)SELF->data;
+   }
+
+   void* get_value () {
+     return SELF->data;
+   }
+
+   BOOLVAL is_same (PMC* pmc2) {
+      return SELF->vtable == pmc2->vtable && SELF->data == pmc2->data;
+   }
+
+   void set_integer (PMC * value) {
+      ERROR;
+   }
+
+   void set_integer_native (INTVAL value) {
+      ERROR;
+   }
+
+   void set_integer_bigint (BIGINT value) {
+      ERROR;
+   }
+
+   void set_integer_same (PMC * value) {
+      ERROR;
+   }
+
+   void set_integer_index (INTVAL value, INTVAL index) {
+      ERROR;
+   }
+
+   void set_number (PMC * value) {
+      ERROR;
+   }
+
+   void set_number_native (FLOATVAL value) {
+      ERROR;
+   }
+
+   void set_number_bigfloat (BIGFLOAT value) {
+      ERROR;
+   }
+
+   void set_number_same (PMC * value) {
+      ERROR;
+   }
+
+   void set_number_index (FLOATVAL value, INTVAL index) {
+      ERROR;
+   }
+
+   void set_string (PMC * value) {
+      ERROR;
+   }
+
+   void set_string_native (STRING * value) {
+      ERROR;
+   }
+
+   void set_string_unicode (STRING * value) {
+      ERROR;
+   }
+
+   void set_string_other (STRING * value) {
+      ERROR;
+   }
+
+   void set_string_same (PMC * value) {
+      ERROR;
+   }
+
+   void set_string_index (STRING* value, INTVAL index) {
+      ERROR;
+   }
+   
+   void set_value (void * value) {
+   }
+}
--- ..\..\parrot-cvs\parrot\classes/Makefile.in Sat Jan  5 03:58:52 2002
+++ classes/Makefile.in Tue Jan  8 15:18:54 2002
@@ -5,8 +5,9 @@
 
 H_FILES = $(INC)/parrot.h default.h
 
+
 O_FILES = default$(O) perlint$(O) perlstring$(O) perlnum$(O) perlarray$(O) \
-perlhash$(O) perlundef$(O)
+perlhash$(O) perlundef$(O) parrotpointer$(O)
 
 #DO NOT ADD C COMPILER FLAGS HERE
 #Add them in Configure.pl--look for the
@@ -59,6 +60,11 @@
 
 perlundef$(O): $(H_FILES)
 
+parrotpointer.c: parrotpointer.pmc
+       $(PERL) pmc2c.pl parrotpointer.pmc
+
+parrotpointer$(O): $(H_FILES)
+
 clean:
        $(RM_F) *.c *$(O) default.h
 
--- Makefile.in.old     Tue Jan  8 21:01:46 2002
+++ Makefile.in Tue Jan  8 21:02:58 2002
@@ -67,7 +67,7 @@
 
 CLASS_O_FILES = classes/default$(O) classes/perlint$(O) classes/perlstring$(O) \
 classes/perlnum$(O) classes/perlarray$(O) classes/perlundef$(O) \
-classes/perlhash$(O)
+classes/perlhash$(O) classes/parrothandle$(O)
 
 ENCODING_O_FILES = encodings/singlebyte$(O) encodings/utf8$(O) encodings/utf16$(O) \
 encodings/utf32$(O)

Reply via email to