cvsuser 04/04/28 03:06:30
Modified: classes unmanagedstruct.pmc
docs/pdds pdd16_native_call.pod
src call_list.txt nci_test.c
t/op bitwise.t
t/pmc nci.t
Log:
nci updates
* array of structs
* test
* #29200 doc update (Courtesy of chromatic)
* test for shift ops
Revision Changes Path
1.39 +26 -5 parrot/classes/unmanagedstruct.pmc
Index: unmanagedstruct.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/unmanagedstruct.pmc,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -w -r1.38 -r1.39
--- unmanagedstruct.pmc 9 Apr 2004 20:31:57 -0000 1.38
+++ unmanagedstruct.pmc 28 Apr 2004 10:06:02 -0000 1.39
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: unmanagedstruct.pmc,v 1.38 2004/04/09 20:31:57 dan Exp $
+$Id: unmanagedstruct.pmc,v 1.39 2004/04/28 10:06:02 leo Exp $
=head1 NAME
@@ -52,7 +52,8 @@
internal_exception(1, "Missing struct initializer");
n = (size_t)VTABLE_elements(interpreter, PMC_pmc_val(pmc));
if ((size_t)ix >= n)
- internal_exception(1, "Non existent elements in struct");
+ internal_exception(1, "Non existent elements in struct "
+ "ix = %d n=%d", (int)ix, (int)n);
/* use structure init */
*type = (int) VTABLE_get_integer_keyed_int(interpreter,
PMC_pmc_val(pmc), ix);
@@ -119,22 +120,30 @@
int ix;
char *p;
+#ifdef STRUCT_DEBUG
+ trace_key_dump(interpreter, key);
+#endif
ix = key_2_idx(interpreter, pmc, key);
next = key_next(interpreter, key);
p = char_offset_int(interpreter, pmc, ix, type);
ix *= 3;
if (!next)
return p;
+ count = 1;
if (PObj_get_FLAGS(next) & KEY_integer_FLAG)
count = key_integer(interpreter, next);
else
count = 1;
outer_init = init = PMC_pmc_val(pmc);
max = (size_t) VTABLE_get_integer_keyed_int(interpreter, init, ix + 1);
+#ifdef STRUCT_DEBUG
+ PIO_eprintf(interpreter, " count = %d ix = %d max = %d\n",
+ (int)count, (int)ix, (int)max);
+#endif
+
if (*type == enum_type_struct_ptr || *type == enum_type_struct) {
PMC *ptr;
- /* for now ignore count */
- assert((int)max <= 1);
+
/* the struct PMC is hanging off the initializer element
* as property "_struct"
*/
@@ -144,6 +153,16 @@
assert(init && (init->vtable->base_type == enum_class_UnManagedStruct
|| init->vtable->base_type == enum_class_ManagedStruct));
+ if (max > 1) { /* array of structs */
+
+ if (key_next(interpreter, next))
+ next = key_next(interpreter, next);
+ offs = PMC_int_val(init);
+#ifdef STRUCT_DEBUG
+ PIO_eprintf(interpreter, "offs = %d\n", (int)offs);
+#endif
+ p += offs * count;
+ }
if (init->vtable->base_type == enum_class_UnManagedStruct) {
/*
* now point PMC_data of this struct to the real data
@@ -160,7 +179,9 @@
return char_offset_key(interpreter, init, next, type);
}
if (count >= max)
- internal_exception(1, "Non existent array element in struct");
+ internal_exception(1,
+ "Non existent array element in struct: "
+ "count = %d max=%d", (int)count, (int)max);
size = data_types[*type - enum_first_type].size;
return p + count * size;
}
1.8 +13 -1 parrot/docs/pdds/pdd16_native_call.pod
Index: pdd16_native_call.pod
===================================================================
RCS file: /cvs/public/parrot/docs/pdds/pdd16_native_call.pod,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- pdd16_native_call.pod 2 Mar 2004 12:25:01 -0000 1.7
+++ pdd16_native_call.pod 28 Apr 2004 10:06:13 -0000 1.8
@@ -1,5 +1,5 @@
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pdd16_native_call.pod,v 1.7 2004/03/02 12:25:01 dan Exp $
+# $Id: pdd16_native_call.pod,v 1.8 2004/04/28 10:06:13 leo Exp $
=head1 NAME
@@ -74,6 +74,18 @@
=item l
long. An integer type. You know the drill.
+
+=item 2
+
+A pointer to a short, taken from an I register.
+
+=item 3
+
+A pointer to an int, taken from an I register.
+
+=item 4
+
+A pointer to a long, taken from an I register.
=item f
1.30 +4 -0 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- call_list.txt 30 Mar 2004 10:23:25 -0000 1.29
+++ call_list.txt 28 Apr 2004 10:06:17 -0000 1.30
@@ -209,3 +209,7 @@
# Used by library/sdl.imc
p iiil
i ppl
+
+# used by t/pmc/nci.t
+v pP
+p ip
1.23 +17 -0 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- nci_test.c 9 Feb 2004 15:54:47 -0000 1.22
+++ nci_test.c 28 Apr 2004 10:06:17 -0000 1.23
@@ -28,6 +28,14 @@
typedef void (*cb_D1_func)(void*, const char*);
void nci_cb_D1(cb_D1_func, void*);
+typedef struct
+{
+ int x, y;
+ int w, h;
+} Rect_Like;
+
+void nci_pip (int count, Rect_Like *rects);
+
double nci_dd(double d) {
return d * 2.0;
}
@@ -255,6 +263,15 @@
const char *result = "succeeded";
/* call the cb synchronously */
(cb)(user_data, result);
+}
+
+void nci_pip (int count, Rect_Like *rects)
+{
+ int i;
+ printf( "Count: %d\n", count);
+ for (i = 0; i < 4; ++i)
+ printf("X: %d\nY: %d\nW: %d\nH: %d\n",
+ rects[i].x, rects[i].y, rects[i].w, rects[i].h );
}
#ifdef TEST
1.10 +31 -3 parrot/t/op/bitwise.t
Index: bitwise.t
===================================================================
RCS file: /cvs/public/parrot/t/op/bitwise.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- bitwise.t 8 Mar 2004 00:19:58 -0000 1.9
+++ bitwise.t 28 Apr 2004 10:06:24 -0000 1.10
@@ -1,6 +1,6 @@
#!perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: bitwise.t,v 1.9 2004/03/08 00:19:58 chromatic Exp $
+# $Id: bitwise.t,v 1.10 2004/04/28 10:06:24 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 23;
+use Parrot::Test tests => 25;
output_is(<<'CODE', <<'OUTPUT', "shr_i_i_i (>>)");
set I0, 0b001100
@@ -135,7 +135,7 @@
OK
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "lsr_i_i_i (<<)");
+output_is(<<'CODE', <<'OUTPUT', "lsr_i_i_i (>>)");
set I0, -40
set I1, 1
lsr I2, I0, I1
@@ -150,6 +150,34 @@
OK
OUTPUT
+# ... and the missing op signature was untested and wrong in JIT/i386
+output_is(<<'CODE', <<'OUTPUT', "lsr_i_i_ic (>>)");
+ set I0, -40
+ lsr I2, I0, 1
+ lt I2, 0, BAD
+ print "OK\n"
+ end
+BAD:
+ print "Not OK"
+ print "\n"
+ end
+CODE
+OK
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "shr_i_i_ic (>>) negative");
+ set I0, -40
+ shr I2, I0, 1
+ ge I2, 0, BAD
+ print "OK\n"
+ end
+BAD:
+ print "Not OK"
+ print "\n"
+ end
+CODE
+OK
+OUTPUT
output_is(<<'CODE', <<'OUTPUT', "shl_i_i_i (<<)");
set I0, 0b001100
set I1, 0b010100
1.36 +88 -7 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -w -r1.35 -r1.36
--- nci.t 8 Mar 2004 00:20:09 -0000 1.35
+++ nci.t 28 Apr 2004 10:06:29 -0000 1.36
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: nci.t,v 1.35 2004/03/08 00:20:09 chromatic Exp $
+# $Id: nci.t,v 1.36 2004/04/28 10:06:29 leo Exp $
=head1 NAME
@@ -17,18 +17,20 @@
=cut
-use Parrot::Test tests => 29;
+use Parrot::Test tests => 30;
use Parrot::Config;
print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
print STDERR $PConfig{so}, " SO extension\n";
SKIP: {
-if ($PConfig{jitcpuarch} eq 'i386' && -e "libnci" . $PConfig{so}) {
+if (-e "libnci" . $PConfig{so}) {
+ if ($PConfig{jitcpuarch} eq 'i386') {
$ENV{LD_LIBRARY_PATH} = '.';
}
+}
else {
- skip('needs jit/i386 and libnci'.$PConfig{so},
+ skip('Please make libnci'.$PConfig{so},
Test::Builder->expected_tests());
}
@@ -163,9 +165,10 @@
print "dlfunced\n"
set I0, 1 # prototype used - unchecked
set I5, 64
- set I6, 2
+ set I6, 3
invoke
- ne I5, -128, nok_1
+ abs I5 # 3 * 64 as char may be signed/unsigned
+ ne I5, 64, nok_1
print "ok 1\n"
ne I0, 0, nok_2 # test return value convention
ne I1, 1, nok_2
@@ -1015,6 +1018,84 @@
external data: 77
done.
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', 'array of structs');
+
+.include "datatypes.pasm"
+ new P3, .OrderedHash
+ set P3["x"], .DATATYPE_INT
+ push P3, 0
+ push P3, 0
+ set P3["y"], .DATATYPE_INT
+ push P3, 0
+ push P3, 0
+ set P3["w"], .DATATYPE_INT
+ push P3, 0
+ push P3, 0
+ set P3["h"], .DATATYPE_INT
+ push P3, 0
+ push P3, 0
+ new P6, .UnManagedStruct, P3
+
+ new P4, .OrderedHash
+ set P4["Rect"], .DATATYPE_STRUCT
+ set P1, P4[-1]
+ setprop P1, "_struct", P6
+ push P4, 4
+ push P4, 0
+
+ new P5, .ManagedStruct, P4
+ set P5[0;0;'x'], 100
+ set P5[0;0;'y'], 110
+ set P5['Rect';0;'w'], 120
+ set P5[0;0;'h'], 130
+
+ set P5[0;1;'x'], 200
+ set P5[0;1;'y'], 210
+ set P5[0;1;'w'], 220
+ set P5[0;1;'h'], 230
+
+ set P5[0;2;'x'], 300
+ set P5[0;2;'y'], 310
+ set P5[0;2;'w'], 320
+ set P5[0;2;'h'], 330
+
+ set P5[0;3;'x'], 400
+ set P5[0;3;'y'], 410
+ set P5[0;3;'w'], 420
+ set P5[0;3;'h'], 430
+
+
+ set I5, 4
+ set I0, 1
+ set I1, 1
+ set I3, 4
+
+ loadlib P1, "libnci"
+ dlfunc P0, P1, "nci_pip", "pip"
+ invoke
+ end
+
+CODE
+Count: 4
+X: 100
+Y: 110
+W: 120
+H: 130
+X: 200
+Y: 210
+W: 220
+H: 230
+X: 300
+Y: 310
+W: 320
+H: 330
+X: 400
+Y: 410
+W: 420
+H: 430
+OUTPUT
+
} # SKIP
1;
