cvsuser 03/12/25 13:49:02
Modified: classes ref.pmc
ops ops.num set.ops
t/pmc ref.t
Log:
add deref and assign to references
* proposed by Luke Palmer with profund reasoning I'm just implementing
that, while the crowd (that is 10 additonal family members) is/are?
populating the living room and annihilating my 12 year old Glenfiddich
- a bit of Tullamore Dew was still left though - that's a slight hope.
Revision Changes Path
1.5 +10 -2 parrot/classes/ref.pmc
Index: ref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/ref.pmc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- ref.pmc 20 Oct 2003 17:18:59 -0000 1.4
+++ ref.pmc 25 Dec 2003 21:48:46 -0000 1.5
@@ -1,7 +1,7 @@
/* Ref.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: ref.pmc,v 1.4 2003/10/20 17:18:59 dan Exp $
+ * $Id: ref.pmc,v 1.5 2003/12/25 21:48:46 leo Exp $
* Overview:
* The vtable functions for the Ref base class.
* Data Structure and Algorithms:
@@ -16,7 +16,7 @@
#include "parrot/parrot.h"
#include "parrot/method_util.h"
-pmclass Ref {
+pmclass Ref does ref {
void init () {
internal_exception(1, "Ref init without PMC\n");
@@ -29,6 +29,14 @@
}
else
internal_exception(1, "Ref init with NULL PMC\n");
+ }
+
+ /*
+ * and one method, that isn't delegated - use set to set values
+ * change referee by assign
+ */
+ void set_pmc(PMC* other) {
+ PMC_ptr2p(SELF) = other; /* refer to other PMC */
}
void mark () {
1.16 +1 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- ops.num 10 Dec 2003 11:44:07 -0000 1.15
+++ ops.num 25 Dec 2003 21:48:58 -0000 1.16
@@ -1341,4 +1341,5 @@
ne_addr_sc_sc_ic 1314
ne_addr_p_p_ic 1315
isnull_p_ic 1316
+deref_p_p 1317
1.10 +19 -2 parrot/ops/set.ops
Index: set.ops
===================================================================
RCS file: /cvs/public/parrot/ops/set.ops,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- set.ops 19 Dec 2003 10:01:40 -0000 1.9
+++ set.ops 25 Dec 2003 21:48:58 -0000 1.10
@@ -215,13 +215,21 @@
=item B<assign>(in PMC, in NUM)
+=item B<assign>(in PMC, in STR)
+
=item B<assign>(in PMC, in PMC)
-=item B<assign>(in PMC, in STR)
+Assign a new value $2, to PMC $1. Only the last operation is different
+to the equivalent B<set> opcodes.
+
+=item B<assign>(out STR, in STR)
Assign a new value to a string by reusing the string header.
-=item B<assign>(out STR, in STR)
+=item B<deref>(out PMC, in PMC)
+
+Not strictly an assigment operation: Get the PMC into $1, that the
+reference PMC $2 refers to.
=cut
@@ -247,6 +255,15 @@
inline op assign(out STR, in STR) {
$1 = string_set(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op deref(out PMC, in PMC) {
+ PMC *ref = $2;
+ /* TODO if we have more refs check if $2 does "ref" */
+ if (ref->vtable->base_type != enum_class_Ref)
+ internal_exception(1, "Not a reference PMC");
+ $1 = PMC_ptr2p($2);
goto NEXT();
}
1.2 +35 -1 parrot/t/pmc/ref.t
Index: ref.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/ref.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- ref.t 1 Sep 2003 16:06:08 -0000 1.1
+++ ref.t 25 Dec 2003 21:49:02 -0000 1.2
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 4;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new ref");
@@ -24,3 +24,37 @@
11
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "deref");
+ new P2, .PerlInt
+ new P1, .Ref, P2
+ print "ok 1\n"
+ deref P3, P1
+ typeof S0, P3
+ print S0
+ print "\n"
+ end
+CODE
+ok 1
+PerlInt
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "assign ref");
+ new P2, .PerlInt
+ new P3, .PerlNum
+ set P3, 0.5
+ new P1, .Ref, P2
+ inc P1
+ print P1
+ print "\n"
+ assign P1, P3
+ inc P1
+ print P1
+ print "\n"
+ print P3
+ print "\n"
+ end
+CODE
+1
+1.500000
+1.500000
+OUTPUT
