cvsuser 03/06/14 05:40:42
Modified: classes perlstring.pmc scalar.pmc
. core.ops spf_render.c string.c
examples/assembly life.pasm
include/parrot string_funcs.h
t/op string.t
Log:
new string ops: assign and substr_r
Revision Changes Path
1.40 +5 -3 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- perlstring.pmc 3 Jun 2003 08:54:42 -0000 1.39
+++ perlstring.pmc 14 Jun 2003 12:40:33 -0000 1.40
@@ -1,7 +1,7 @@
/* perlstring.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: perlstring.pmc,v 1.39 2003/06/03 08:54:42 leo Exp $
+ * $Id: perlstring.pmc,v 1.40 2003/06/14 12:40:33 leo Exp $
* Overview:
* These are the vtable functions for the PerlString base class
* Data Structure and Algorithms:
@@ -355,10 +355,12 @@
void substr (INTVAL offset, INTVAL length, PMC* dest) {
DYNSELF.morph(enum_class_PerlString);
- dest->cache.string_val = string_substr(INTERP, SELF->cache.string_val,
offset, length, NULL);
+ dest->cache.string_val = string_substr(INTERP,
+ SELF->cache.string_val, offset, length, NULL, 0);
}
STRING* substr_str (INTVAL offset, INTVAL length) {
- return string_substr(INTERP, SELF->cache.string_val, offset, length, NULL);
+ return string_substr(INTERP, SELF->cache.string_val, offset,
+ length, NULL, 0);
}
}
1.6 +1 -1 parrot/classes/scalar.pmc
Index: scalar.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/scalar.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- scalar.pmc 6 Jun 2003 15:14:59 -0000 1.5
+++ scalar.pmc 14 Jun 2003 12:40:34 -0000 1.6
@@ -1201,7 +1201,7 @@
STRING* substr_str(INTVAL offset, INTVAL length) {
return string_substr(INTERP, VTABLE_get_string(INTERP,SELF),
- offset, length, NULL);
+ offset, length, NULL, 0);
}
STRING* substr_str_keyed_int (INTVAL* key, INTVAL offset, INTVAL length) {
1.281 +19 -3 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.280
retrieving revision 1.281
diff -u -w -r1.280 -r1.281
--- core.ops 13 Jun 2003 23:15:31 -0000 1.280
+++ core.ops 14 Jun 2003 12:40:36 -0000 1.281
@@ -483,6 +483,10 @@
=item B<assign>(inout PMC, in STR)
+Assign a new value to a string by reusing the string header.
+
+=item B<assign>(inout STR, in STR)
+
=cut
inline op assign(inout PMC, in PMC) {
@@ -505,6 +509,10 @@
goto NEXT();
}
+inline op assign(inout STR, in STR) {
+ $1 = string_set(interpreter, $1, $2);
+ goto NEXT();
+}
########################################
=head2 Keyed set operations: Px[ INTKEY ] = Bx
@@ -1993,10 +2001,18 @@
The third form is optimized for replace only, ignoring the replaced
substring and does not waste a register to do the string replace.
+The B<_r> variants reuse an existing string header and therefore normally
+do not create a new string in the destination register.
+
=cut
inline op substr(out STR, in STR, in INT, in INT) {
- $1 = string_substr(interpreter, $2, $3, $4, &$1);
+ $1 = string_substr(interpreter, $2, $3, $4, &$1, 0);
+ goto NEXT();
+}
+
+inline op substr_r(out STR, in STR, in INT, in INT) {
+ $1 = string_substr(interpreter, $2, $3, $4, &$1, 1);
goto NEXT();
}
1.20 +4 -4 parrot/spf_render.c
Index: spf_render.c
===================================================================
RCS file: /cvs/public/parrot/spf_render.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- spf_render.c 21 Jan 2003 12:56:36 -0000 1.19
+++ spf_render.c 14 Jun 2003 12:40:36 -0000 1.20
@@ -1,7 +1,7 @@
/* spf_render.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: spf_render.c,v 1.19 2003/01/21 12:56:36 leo Exp $
+ * $Id: spf_render.c,v 1.20 2003/06/14 12:40:36 leo Exp $
* Overview:
* Implements the main function that drives the Parrot_sprintf
* family and its utility functions.
@@ -131,7 +131,7 @@
if (info->flags & FLAG_ZERO
&& (string_ord(str,0) == '-' || string_ord(str,0) == '+')) {
STRING *temp = 0;
- string_substr(interpreter, str, 1, len-1, &temp);
+ string_substr(interpreter, str, 1, len-1, &temp, 0);
string_chopn(str, -1);
string_append(interpreter, str, fill, 0);
string_append(interpreter, str, temp, 0);
@@ -232,7 +232,7 @@
for (i = old = len = 0; i < (INTVAL) string_length(pat); i++) {
if (string_ord(pat, i) == '%') { /* % */
if (len) {
- string_substr(interpreter, pat, old, len, &substr);
+ string_substr(interpreter, pat, old, len, &substr, 1);
string_append(interpreter, targ, substr, 0);
}
len = 0;
@@ -661,7 +661,7 @@
}
}
if (len) {
- string_substr(interpreter, pat, old, len, &substr);
+ string_substr(interpreter, pat, old, len, &substr, 1);
string_append(interpreter, targ, substr, 0);
}
1.130 +9 -9 parrot/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.129
retrieving revision 1.130
diff -u -w -r1.129 -r1.130
--- string.c 1 Jun 2003 00:17:44 -0000 1.129
+++ string.c 14 Jun 2003 12:40:36 -0000 1.130
@@ -1,7 +1,7 @@
/* string.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: string.c,v 1.129 2003/06/01 00:17:44 josh Exp $
+ * $Id: string.c,v 1.130 2003/06/14 12:40:36 leo Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -683,7 +683,7 @@
*/
STRING *
string_substr(struct Parrot_Interp *interpreter, STRING *src,
- INTVAL offset, INTVAL length, STRING **d)
+ INTVAL offset, INTVAL length, STRING **d, int replace_dest)
{
STRING *dest;
UINTVAL substart_off; /* Offset from start of string to our
@@ -714,12 +714,12 @@
true_length = (UINTVAL)(src->strlen - true_offset);
}
- /* do in-place i.e. make a COW string */
-#if 0
+ /* do in-place i.e. reuse existing header if one */
+ if (replace_dest)
dest = string_set(interpreter, *d, src);
-#else
+ else
dest = make_COW_reference(interpreter, src);
-#endif
+
if (src->encoding->index == enum_encoding_singlebyte) {
dest->strstart = (char *)dest->strstart + true_offset;
dest->bufused = true_length;
@@ -1034,7 +1034,7 @@
string_transcode(interpreter, output, dest_encoding, NULL, &output);
if(bytelen > 0 && bytelen < (INTVAL)string_length(output)) {
- string_substr(interpreter, output, 0, bytelen, &output);
+ string_substr(interpreter, output, 0, bytelen, &output, 1);
}
if(dest == NULL) {
1.16 +11 -10 parrot/examples/assembly/life.pasm
Index: life.pasm
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/life.pasm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- life.pasm 21 Feb 2003 12:48:28 -0000 1.15
+++ life.pasm 14 Jun 2003 12:40:38 -0000 1.16
@@ -117,7 +117,8 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ # S0 is always overwritten, so reuse it
+ substr_r S0, S15, I3, 1
ne S0, "*", North
inc I2
North:
@@ -125,7 +126,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", NE
inc I2
NE:
@@ -133,7 +134,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", West
inc I2
West:
@@ -141,7 +142,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", East
inc I2
East:
@@ -149,7 +150,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", SW
inc I2
SW:
@@ -157,7 +158,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", South
inc I2
South:
@@ -165,7 +166,7 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", SE
inc I2
SE:
@@ -173,11 +174,11 @@
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
- substr S0, S15, I3, 1
+ substr_r S0, S15, I3, 1
ne S0, "*", check
inc I2
check:
- substr S0, S15, I1, 1
+ substr_r S0, S15, I1, 1
eq S0, "*", check_alive
# If eq 3, put a star in else a space
@@ -216,7 +217,7 @@
set I0, 0
set I1, 14
printloop:
- substr S0, S15, I0, 15
+ substr_r S0, S15, I0, 15
print S0
print "\n"
add I0, I0, 15
1.25 +2 -2 parrot/include/parrot/string_funcs.h
Index: string_funcs.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string_funcs.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- string_funcs.h 6 May 2003 03:04:56 -0000 1.24
+++ string_funcs.h 14 Jun 2003 12:40:39 -0000 1.25
@@ -1,7 +1,7 @@
/* string_funcs.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: string_funcs.h,v 1.24 2003/05/06 03:04:56 dan Exp $
+ * $Id: string_funcs.h,v 1.25 2003/06/14 12:40:39 leo Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -26,7 +26,7 @@
STRING **);
STRING *string_chopn(STRING *, INTVAL);
STRING *string_substr(struct Parrot_Interp *, STRING *, INTVAL,
- INTVAL, STRING **);
+ INTVAL, STRING **, int replace_dest);
STRING *string_replace(struct Parrot_Interp *, STRING *, INTVAL, INTVAL,
STRING *, STRING **);
STRING *string_nprintf(struct Parrot_Interp *,
1.48 +62 -1 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -w -r1.47 -r1.48
--- string.t 20 May 2003 11:11:11 -0000 1.47
+++ string.t 14 Jun 2003 12:40:42 -0000 1.48
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 102;
+use Parrot::Test tests => 106;
use Test::More;
output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
@@ -1681,6 +1681,67 @@
ok 2
ok 3
ok 4
+OUTPUT
+
+output_is( <<'CODE', <<'OUTPUT', "substr_r_s_s|sc_i|ic_i|ic" );
+ set S4, "12345JAPH01"
+ set I4, 5
+ set I5, 4
+ substr S5, S4, I4, I5
+ print S5
+ substr S5, S4, I4, 4
+ print S5
+ substr S5, S4, 5, I5
+ print S5
+ substr S5, S4, 5, 4
+ print S5
+ substr S5, "12345JAPH01", I4, I5
+ print S5
+ substr S5, "12345JAPH01", I4, 4
+ print S5
+ substr S5, "12345JAPH01", 5, I5
+ print S5
+ substr S5, "12345JAPH01", 5, 4
+ print S5
+ print "\n"
+ end
+CODE
+JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "assign" );
+ set S4, "JAPH\n"
+ assign S5, S4
+ print S4
+ print S5
+ end
+CODE
+JAPH
+JAPH
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "assign & globber" );
+ set S4, "JAPH\n"
+ assign S5, S4
+ assign S4, "Parrot\n"
+ print S4
+ print S5
+ end
+CODE
+Parrot
+JAPH
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "assign & globber 2" );
+ set S4, "JAPH\n"
+ set S5, S4
+ assign S4, "Parrot\n"
+ print S4
+ print S5
+ end
+CODE
+Parrot
+Parrot
OUTPUT
# Set all string registers to values given by &$_[0](reg num)
