cvsuser 04/04/20 00:44:54
Modified: classes default.pmc perlstring.pmc ref.pmc sharedref.pmc
docs/pdds pdd02_vtables.pod
ops set.ops
t/pmc delegate.t perlstring.t ref.t
. vtable.tbl
Log:
assign and set - see p6i announce
Revision Changes Path
1.86 +21 -15 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -w -r1.85 -r1.86
--- default.pmc 9 Apr 2004 20:31:57 -0000 1.85
+++ default.pmc 20 Apr 2004 07:44:39 -0000 1.86
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.85 2004/04/09 20:31:57 dan Exp $
+$Id: default.pmc,v 1.86 2004/04/20 07:44:39 leo Exp $
=head1 NAME
@@ -446,19 +446,6 @@
return DYNSELF.elements_keyed(r_key);
}
-/*
-
-=item C<PMC* get_pmc()>
-
-Returns the PMC itself.
-
-=cut
-
-*/
-
- PMC* get_pmc () {
- return SELF;
- }
/*
@@ -490,6 +477,25 @@
return SELF == value;
}
+/*
+
+=item C<void assign_pmc (PMC* value)>
+
+=item C<void assign_string_native (PMC* value)>
+
+Default falbacks that call C<set_pmc> and C<set_string_native>.
+
+=cut
+
+*/
+
+ void assign_pmc (PMC* value) {
+ DYNSELF.set_pmc(value);
+ }
+
+ void assign_string_native (STRING* value) {
+ DYNSELF.set_string_native(value);
+ }
/*
=item C<void set_integer_keyed_int (INTVAL key, INTVAL value)>
1.68 +17 -10 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -w -r1.67 -r1.68
--- perlstring.pmc 9 Apr 2004 20:31:57 -0000 1.67
+++ perlstring.pmc 20 Apr 2004 07:44:39 -0000 1.68
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.67 2004/04/09 20:31:57 dan Exp $
+$Id: perlstring.pmc,v 1.68 2004/04/20 07:44:39 leo Exp $
=head1 NAME
@@ -185,14 +185,21 @@
Sets the string's value to the value of the specified Parrot string.
+=item C<void assign_string_native(STRING *value)>
+
+Assign a copy of the passed string value.
+
=cut
*/
void set_string_native (STRING * value) {
- PMC_str_val(SELF) = string_set(INTERP, PMC_str_val(SELF), value);
+ PMC_str_val(SELF) = value;
}
+ void assign_string_native (STRING * value) {
+ PMC_str_val(SELF) = string_set(INTERP, PMC_str_val(SELF), value);
+ }
/*
=item C<void set_string_same(PMC *value)>
1.10 +11 -3 parrot/classes/ref.pmc
Index: ref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/ref.pmc,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- ref.pmc 22 Feb 2004 17:48:41 -0000 1.9
+++ ref.pmc 20 Apr 2004 07:44:39 -0000 1.10
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: ref.pmc,v 1.9 2004/02/22 17:48:41 mikescott Exp $
+$Id: ref.pmc,v 1.10 2004/04/20 07:44:39 leo Exp $
=head1 NAME
@@ -89,6 +89,10 @@
Sets the referenced PMC to C<*other>.
+=item C<PMC* get_pmc()>
+
+Get the referenced PMC.
+
=cut
*/
@@ -96,6 +100,10 @@
void set_pmc(PMC* other) {
PObj_active_destroy_CLEAR(SELF);
SELF.init_pmc(other);
+ }
+
+ PMC* get_pmc() {
+ return PMC_pmc_val(SELF);
}
/*
1.7 +7 -12 parrot/classes/sharedref.pmc
Index: sharedref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sharedref.pmc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- sharedref.pmc 22 Feb 2004 17:48:41 -0000 1.6
+++ sharedref.pmc 20 Apr 2004 07:44:39 -0000 1.7
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sharedref.pmc,v 1.6 2004/02/22 17:48:41 mikescott Exp $
+$Id: sharedref.pmc,v 1.7 2004/04/20 07:44:39 leo Exp $
=head1 NAME
@@ -38,15 +38,6 @@
pmclass SharedRef does ref need_ext is_shared extends Ref {
-/*
-
-=item C<>
-
-
-
-=cut
-
-*/
void init () {
internal_exception(1, "SharedRef init without PMC\n");
@@ -125,6 +116,10 @@
void mark () {
SUPER();
+ }
+
+ PMC* get_pmc () {
+ internal_exception(1, "deref not allowed");
}
/*
1.35 +28 -18 parrot/docs/pdds/pdd02_vtables.pod
Index: pdd02_vtables.pod
===================================================================
RCS file: /cvs/public/parrot/docs/pdds/pdd02_vtables.pod,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -w -r1.34 -r1.35
--- pdd02_vtables.pod 28 Feb 2004 09:16:37 -0000 1.34
+++ pdd02_vtables.pod 20 Apr 2004 07:44:43 -0000 1.35
@@ -1,5 +1,5 @@
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pdd02_vtables.pod,v 1.34 2004/02/28 09:16:37 mikescott Exp $
+# $Id: pdd02_vtables.pod,v 1.35 2004/04/20 07:44:43 leo Exp $
=head1 NAME
@@ -354,6 +354,10 @@
Sets the PMC to the passed in string value.
+=item void assign_string_native(INTERP, PMC* self, STRING* value)
+
+Sets the PMC to the copied string value.
+
=item void set_string_same(INTERP, PMC* self, PMC* value)
Sets the PMC to the string value of B<value>.
@@ -388,13 +392,19 @@
Sets the value of the PMC in B<self> to the value of the PMC in B<value>.
-=item void set_pmc_keyed(INTERP, PMC* self, PMC* key, PMC* value, PMC* value_key)
+=item void assign_pmc(INTERP, PMC* self, PMC* value)
+
+Sets the value of the PMC in B<self> to the value of the PMC in B<value> by
+copying the value.
+
+=item void set_pmc_keyed(INTERP, PMC* self, PMC* key, PMC* value)
+
+=item void set_pmc_keyed_int(INTERP, PMC* self, INTVAL key, PMC* value)
-=item void set_pmc_keyed_int(INTERP, PMC* self, INTVAL key, PMC* value, INTVAL*
value_key)
+=item void set_pmc_keyed_str(INTERP, PMC* self, STRING* key, PMC* value)
Sets the value of the PMC keyed by B<key> to the value of the PMC
-in B<value> keyed by B<value_key>. At least one of the two keys
-is guaranteed not to be NULL.
+in B<value>.
=item void set_pointer(INTERP, PMC* self, void* value)
1.15 +15 -9 parrot/ops/set.ops
Index: set.ops
===================================================================
RCS file: /cvs/public/parrot/ops/set.ops,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- set.ops 9 Apr 2004 20:32:36 -0000 1.14
+++ set.ops 20 Apr 2004 07:44:47 -0000 1.15
@@ -215,17 +215,22 @@
=item B<assign>(in PMC, in NUM)
+Assign a new value $2, to PMC $1. Same as the equivalent B<set> opcodes.
+
=item B<assign>(in PMC, in STR)
=item B<assign>(in PMC, in PMC)
-Assign a new value $2, to PMC $1. Only the last operation is different
-to the equivalent B<set> opcodes.
+Assign a new value $2, to PMC $1 by copying the value.
=item B<assign>(out STR, in STR)
Assign a new value to a string by reusing the string header.
+=item B<setref>(in PMC, in PMC)
+
+Make $1 refer to $2 by calling C<set_pmc>.
+
=item B<deref>(out PMC, in PMC)
Not strictly an assigment operation: Get the PMC into $1, that the
@@ -234,7 +239,7 @@
=cut
inline op assign(in PMC, in PMC) :base_core {
- $1->vtable->set_pmc(interpreter, $1, $2);
+ $1->vtable->assign_pmc(interpreter, $1, $2);
goto NEXT();
}
@@ -249,7 +254,7 @@
}
inline op assign(in PMC, in STR) :base_core {
- $1->vtable->set_string_native(interpreter, $1, $2);
+ $1->vtable->assign_string_native(interpreter, $1, $2);
goto NEXT();
}
@@ -258,12 +263,13 @@
goto NEXT();
}
+inline op setref(in PMC, in PMC) :base_core {
+ $1->vtable->set_pmc(interpreter, $1, $2);
+ goto NEXT();
+}
+
inline op deref(out PMC, in PMC) :base_ref {
- 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_pmc_val($2);
+ $1 = $2->vtable->get_pmc(interpreter, $2);
goto NEXT();
}
1.6 +3 -3 parrot/t/pmc/delegate.t
Index: delegate.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/delegate.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- delegate.t 8 Mar 2004 00:20:09 -0000 1.5
+++ delegate.t 20 Apr 2004 07:44:50 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: delegate.t,v 1.5 2004/03/08 00:20:09 chromatic Exp $
+# $Id: delegate.t,v 1.6 2004/04/20 07:44:50 leo Exp $
=head1 NAME
@@ -99,13 +99,13 @@
47.110000
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "delegate set_pmc");
+output_is(<<'CODE', <<'OUTPUT', "delegate assign_pmc");
new P0, .delegate
new P1, .PerlInt
set P1, 42
assign P0, P1
end
-.pcc_sub __set_pmc:
+.pcc_sub __assign_pmc:
print P5
print "\n"
# just return
1.21 +19 -3 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- perlstring.t 9 Apr 2004 20:32:54 -0000 1.20
+++ perlstring.t 20 Apr 2004 07:44:50 -0000 1.21
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.20 2004/04/09 20:32:54 dan Exp $
+# $Id: perlstring.t,v 1.21 2004/04/20 07:44:50 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 33;
+use Parrot::Test tests => 34;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -258,10 +258,26 @@
fnarghGrunties
OUTPUT
-output_is(<<CODE, <<OUTPUT, "Setting string copies");
+output_is(<<CODE, <<OUTPUT, "Setting string references");
new P0, .PerlString
set S0, "C2H5OH + 10H20"
set P0, S0
+ chopn S0, 8
+
+ print S0
+ print "\\n"
+ print P0
+ print "\\n"
+ end
+CODE
+C2H5OH
+C2H5OH
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "Assigning string copies");
+ new P0, .PerlString
+ set S0, "C2H5OH + 10H20"
+ assign P0, S0
chopn S0, 8
print S0
1.6 +31 -4 parrot/t/pmc/ref.t
Index: ref.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/ref.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- ref.t 8 Mar 2004 00:20:09 -0000 1.5
+++ ref.t 20 Apr 2004 07:44:50 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: ref.t,v 1.5 2004/03/08 00:20:09 chromatic Exp $
+# $Id: ref.t,v 1.6 2004/04/20 07:44:50 leo Exp $
=head1 NAME
@@ -12,11 +12,11 @@
=head1 DESCRIPTION
-Tests that method delegation works on a C<Ref> PMC.
+Tests that vtable method delegation works on a C<Ref> PMC.
=cut
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 7;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new ref");
@@ -58,6 +58,30 @@
PerlInt
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "setref ref");
+ new P2, .PerlInt
+ new P3, .PerlNum
+ set P3, 0.5
+ new P1, .Ref, P2
+ inc P1
+ print P1
+ print "\n"
+ setref P1, P3
+ inc P1
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ print P3
+ print "\n"
+ end
+CODE
+1
+1.500000
+1
+1.500000
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "assign ref");
new P2, .PerlInt
new P3, .PerlNum
@@ -70,6 +94,8 @@
inc P1
print P1
print "\n"
+ print P2
+ print "\n"
print P3
print "\n"
end
@@ -77,6 +103,7 @@
1
1.500000
1.500000
+0.500000
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "typeof SharedRef");
@@ -112,5 +139,5 @@
end
CODE
/ok 1
-Not a reference PMC/
+deref not allowed/
OUTPUT
1.57 +3 -1 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -w -r1.56 -r1.57
--- vtable.tbl 3 Apr 2004 20:44:47 -0000 1.56
+++ vtable.tbl 20 Apr 2004 07:44:54 -0000 1.57
@@ -1,4 +1,4 @@
-# $Id: vtable.tbl,v 1.56 2004/04/03 20:44:47 leo Exp $
+# $Id: vtable.tbl,v 1.57 2004/04/20 07:44:54 leo Exp $
# [MAIN] #default section name
void init()
@@ -83,6 +83,7 @@
void set_bignum_keyed_str(STRING* key, BIGNUM* value)
void set_string_native(STRING* value)
+void assign_string_native(STRING* value)
void set_string_same(PMC* value)
void set_string_keyed(PMC* key, STRING* value)
void set_string_keyed_int(INTVAL key, STRING* value)
@@ -94,6 +95,7 @@
void set_bool_keyed_str(STRING* key, INTVAL value)
void set_pmc(PMC* value)
+void assign_pmc(PMC* value)
void set_pmc_keyed(PMC* key, PMC* value)
void set_pmc_keyed_int(INTVAL key, PMC* value)
void set_pmc_keyed_str(STRING* key, PMC* value)
