cvsuser 04/01/02 08:25:41
Modified: include/parrot misc.h
ops core.ops
src utils.c
t/op calling.t
Log:
move foldup out of core.ops
Revision Changes Path
1.16 +2 -1 parrot/include/parrot/misc.h
Index: misc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/misc.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- misc.h 26 Dec 2003 20:58:45 -0000 1.15
+++ misc.h 2 Jan 2004 16:25:35 -0000 1.16
@@ -1,7 +1,7 @@
/* misc.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: misc.h,v 1.15 2003/12/26 20:58:45 dan Exp $
+ * $Id: misc.h,v 1.16 2004/01/02 16:25:35 leo Exp $
* Overview:
* Miscellaneous functions, mainly the Parrot_sprintf family
* Data Structure and Algorithms:
@@ -29,6 +29,7 @@
INTVAL intval_mod(INTVAL i2, INTVAL i3);
FLOATVAL floatval_mod(FLOATVAL n2, FLOATVAL n3);
+PMC* foldup(Parrot_Interp, INTVAL start);
FLOATVAL Parrot_float_rand(INTVAL how_random);
INTVAL Parrot_uint_rand(INTVAL how_random);
1.344 +2 -76 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.343
retrieving revision 1.344
diff -u -w -r1.343 -r1.344
--- core.ops 31 Dec 2003 11:54:38 -0000 1.343
+++ core.ops 2 Jan 2004 16:25:37 -0000 1.344
@@ -989,86 +989,12 @@
=cut
op foldup(out PMC) {
- /* Should be I3 when we're done */
- INTVAL max_used_reg = REG_INT(2) + 5;
- INTVAL reg;
- INTVAL elems_in_array;
- INTVAL current_offset = 0;
- INTVAL total_size;
- PMC *destination_pmc = NULL;
- PMC *overflow = REG_PMC(3);
-
- destination_pmc = pmc_new_noinit(interpreter, enum_class_Array);
- VTABLE_init(interpreter, destination_pmc);
- /* XXX This needs fixing when IMCC does calling conventions right */
- total_size = REG_INT(2);
- VTABLE_set_integer_native(interpreter, destination_pmc, total_size);
- /* First move over the PMCs in registers */
- for (reg = 5; reg < max_used_reg; reg++) {
- VTABLE_set_pmc_keyed_int(interpreter, destination_pmc, current_offset,
REG_PMC(reg));
- current_offset++;
- }
- /* Next see how many are in the overflow, if any */
- if (max_used_reg == 16 && overflow != NULL &&
- VTABLE_type(interpreter, overflow) != enum_class_Null &&
- ((elems_in_array = VTABLE_get_integer(interpreter, overflow)) != 0)) {
- INTVAL cur_elem;
- total_size += elems_in_array;
- VTABLE_set_integer_native(interpreter, destination_pmc, total_size);
- for (cur_elem = 0; cur_elem < elems_in_array; cur_elem++) {
- VTABLE_set_pmc_keyed_int(interpreter, destination_pmc, current_offset,
VTABLE_get_pmc_keyed_int(interpreter, overflow, cur_elem));
- current_offset++;
- }
- }
-
- $1 = destination_pmc;
+ $1 = foldup(interpreter, 0);
goto NEXT();
}
op foldup(out PMC, in INT) {
- /* Should be I3 when we're done */
- INTVAL max_used_reg = REG_INT(2) + 5;
- INTVAL reg;
- INTVAL elems_in_array;
- INTVAL current_offset = 0;
- INTVAL total_size;
- INTVAL start = 5;
- PMC *destination_pmc = NULL;
- PMC *overflow = REG_PMC(3);
-
- destination_pmc = pmc_new_noinit(interpreter, enum_class_Array);
- VTABLE_init(interpreter, destination_pmc);
- /* XXX This needs fixing when IMCC does calling conventions right */
- total_size = REG_INT(2);
- VTABLE_set_integer_native(interpreter, destination_pmc, total_size);
-
- /* Skip past what we're skipping */
- start += $2;
-
- /* First move over the PMCs in registers */
- for (reg = start; reg < max_used_reg; reg++) {
- VTABLE_set_pmc_keyed_int(interpreter, destination_pmc, current_offset,
REG_PMC(reg));
- current_offset++;
- }
-
- /* Next see how many are in the overflow, if any */
- if (max_used_reg == 16 && overflow != NULL &&
- VTABLE_type(interpreter, overflow) != enum_class_Null &&
- ((elems_in_array = VTABLE_get_integer(interpreter, overflow)) != 0)) {
- INTVAL cur_elem;
- start = 0;
- if ($2 > 11) {
- start = $2 - 11;
- }
- total_size += elems_in_array;
- VTABLE_set_integer_native(interpreter, destination_pmc, total_size);
- for (cur_elem = start; cur_elem < elems_in_array; cur_elem++) {
- VTABLE_set_pmc_keyed_int(interpreter, destination_pmc, current_offset,
VTABLE_get_pmc_keyed_int(interpreter, overflow, cur_elem));
- current_offset++;
- }
- }
-
- $1 = destination_pmc;
+ $1 = foldup(interpreter, $2);
goto NEXT();
}
1.6 +65 -4 parrot/src/utils.c
Index: utils.c
===================================================================
RCS file: /cvs/public/parrot/src/utils.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- utils.c 26 Dec 2003 20:58:47 -0000 1.5
+++ utils.c 2 Jan 2004 16:25:39 -0000 1.6
@@ -1,7 +1,7 @@
/* utils.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: utils.c,v 1.5 2003/12/26 20:58:47 dan Exp $
+ * $Id: utils.c,v 1.6 2004/01/02 16:25:39 leo Exp $
* Overview:
* Some utility functions
* Data Structure and Algorithms:
@@ -15,9 +15,12 @@
#include "parrot/parrot.h"
/*
- * s. the comments in math.ops
+ * opcode helper functions that don't really fit elsewhere
*/
+/*
+ * s. the comments in math.ops
+ */
INTVAL
intval_mod(INTVAL i2, INTVAL i3)
{
@@ -67,6 +70,64 @@
}
/*
+ * s. core.ops
+ */
+PMC*
+foldup(Parrot_Interp interpreter, INTVAL skip)
+{
+ /* Should be I3 when we're done */
+ INTVAL max_used_reg = REG_INT(2) + 5;
+ INTVAL reg;
+ INTVAL elems_in_array = 0;
+ INTVAL current_offset = 0;
+ INTVAL total_size;
+ INTVAL start = 5;
+ PMC *destination_pmc = NULL;
+ PMC *overflow = REG_PMC(3);
+
+ destination_pmc = pmc_new_noinit(interpreter, enum_class_Array);
+ VTABLE_init(interpreter, destination_pmc);
+
+ /* see how many are in the overflow, if any */
+ if (max_used_reg == 16 && !PMC_IS_NULL(overflow) &&
+ VTABLE_type(interpreter, overflow) != enum_class_Null) {
+ elems_in_array = VTABLE_get_integer(interpreter, overflow);
+ }
+ /* XXX This needs fixing when IMCC does calling conventions right */
+ total_size = REG_INT(2) + elems_in_array - skip;
+
+ VTABLE_set_integer_native(interpreter, destination_pmc, total_size);
+
+ /* Skip past what we're skipping */
+ start += skip;
+
+ /* First move over the PMCs in registers */
+ for (reg = start; reg < max_used_reg; reg++) {
+ VTABLE_set_pmc_keyed_int(interpreter, destination_pmc,
+ current_offset, REG_PMC(reg));
+ current_offset++;
+ }
+ if (elems_in_array) {
+ INTVAL cur_elem;
+ start = 0;
+ if (skip > 11) {
+ start = skip - 11;
+ }
+ for (cur_elem = start; cur_elem < elems_in_array; cur_elem++) {
+ VTABLE_set_pmc_keyed_int(interpreter, destination_pmc,
+ current_offset,
+ VTABLE_get_pmc_keyed_int(interpreter, overflow, cur_elem));
+ current_offset++;
+ }
+ }
+ return destination_pmc;
+}
+
+/*
+ * random number generator
+ */
+
+/*
* currently undefined
*/
#ifndef PARROT_HAS_DRAND48
1.3 +65 -1 parrot/t/op/calling.t
Index: calling.t
===================================================================
RCS file: /cvs/public/parrot/t/op/calling.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- calling.t 27 Dec 2003 10:34:10 -0000 1.2
+++ calling.t 2 Jan 2004 16:25:41 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 1;
+use Parrot::Test tests => 2;
use Test::More;
# Test calling convention operations
@@ -54,6 +54,70 @@
print P16
print "\n"
set P16,P17[14]
+ print P16
+ print "\n"
+ set I0,1
+ set I1,0
+ set I2,0
+ set I3,0
+ set I4,0
+ invoke P1
+
+CODE
+Foobar!
+Baxman!
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "foldup_p_i w. skip");
+ new P19, .PerlString
+ new P18, .PerlString
+ new P17, .PerlString
+ new P16, .PerlString
+ new P21, .PerlString
+ new P20, .PerlString
+ new P22, .PerlString
+ new P24, .PerlString
+ new P28, .PerlString
+ new P29, .PerlString
+ new P30, .PerlString
+ new P27, .PerlString
+ new P26, .PerlString
+ new P25, .PerlString
+ new P23, .PerlString
+ set P20,"Foobar!"
+ set P23,"Baxman!"
+ newsub P0, .Sub, _foo
+ set P5,P19
+ set P6,P18
+ set P7,P17
+ set P8,P16
+ set P9,P21
+ set P10,P20
+ set P11,P22
+ set P12,P24
+ set P13,P28
+ set P14,P29
+ set P15,P30
+ new P3, .SArray
+ set P3,15
+ push P3,P27
+ push P3,P26
+ push P3,P25
+ push P3,P23
+ set I0,1
+ set I1,4
+ set I2,11
+ set I3,0
+ savetop
+ invokecc
+ restoretop
+ end
+_foo:
+ foldup P17, 2
+ set P16,P17[3]
+ print P16
+ print "\n"
+ set P16,P17[12]
print P16
print "\n"
set I0,1
