cvsuser 03/12/26 12:58:47
Modified: build_tools build_nativecall.pl
docs/pdds pdd03_calling_conventions.pod
include/parrot misc.h
src call_list.txt utils.c
Log:
Add in support for the T and L NCI types. (char pointer array and long array)
Revision Changes Path
1.31 +31 -3 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- build_nativecall.pl 21 Dec 2003 10:15:03 -0000 1.30
+++ build_nativecall.pl 26 Dec 2003 20:58:40 -0000 1.31
@@ -18,6 +18,12 @@
# B => [0,0,1,0,0], # Returns a buffer
);
+my $tempcounter = 0;
+my @extra_preamble = ();
+my $extra_preamble;
+my @extra_postamble = ();
+my $extra_postamble;
+
my (%ret_type) = (p => "void *",
i => "int",
@@ -52,6 +58,8 @@
P => "PMC *",
b => "void *",
B => "void **",
+ L => "long *",
+ T => "char **",
);
my (%other_decl) = (p => "PMC *final_destination = pmc_new(interpreter,
enum_class_UnManagedStruct);",
@@ -125,7 +133,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.30 2003/12/21 10:15:03 leo Exp $
+ * $Id: build_nativecall.pl,v 1.31 2003/12/26 20:58:40 dan Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -165,7 +173,9 @@
s/^\s*//;
s/\s*$//;
next unless $_;
- my ($ret, $args) = split /\s/, $_;
+ @extra_preamble = ();
+ @extra_postamble = ();
+ my ($ret, $args) = split /\s+/, $_;
my @arg;
my %reg_count;
@reg_count{qw(p i s n)} = (5, 5, 5, 5);
@@ -267,7 +277,19 @@
/P/ && do {my $regnum = $reg_ref->{p}++;
return "REG_PMC($regnum) == PMCNULL ? NULL : REG_PMC($regnum)";
};
+ /L/ && do {my $regnum = $reg_ref->{p}++;
+ my $tempnum = $tempcounter++;
+ push @extra_preamble, "long *tempvar$tempnum =
Parrot_make_la(interpreter, REG_PMC($regnum));\n";
+ push @extra_postamble, "Parrot_destroy_la(tempvar$tempnum);\n";
+ return "tempvar$tempnum";
+ };
+ /T/ && do {my $regnum = $reg_ref->{p}++;
+ my $tempnum = $tempcounter++;
+ push @extra_preamble, "char **tempvar$tempnum =
Parrot_make_cpa(interpreter, REG_PMC($regnum));\n";
+ push @extra_postamble, "Parrot_destroy_cpa(tempvar$tempnum);\n";
+ return "tempvar$tempnum";
+ };
}
sub set_return_count {
@@ -288,6 +310,8 @@
if (defined $params) {
my $proto = join ', ', map { $proto_type{$_} } split '', $params;
+ $extra_preamble = join("", @extra_preamble);
+ $extra_postamble = join("", @extra_postamble);
print NCI <<HEADER;
static void
pcf_${return}_$params(struct Parrot_Interp *interpreter, PMC *self)
@@ -296,10 +320,12 @@
func_t pointer;
$ret_type_decl return_data;
$other_decl
+ $extra_preamble
pointer = (func_t)D2FPTR(self->cache.struct_val);
$return_assign ($ret_type)(*pointer)($call_params);
$final_assign
+ $extra_postamble
HEADER
}
else {
@@ -310,10 +336,12 @@
$ret_type (*pointer)(void);
$ret_type_decl return_data;
$other_decl
+ $extra_preamble
pointer = ($ret_type (*)(void))D2FPTR(self->cache.struct_val);
$return_assign ($ret_type)(*pointer)();
$final_assign
+ $extra_postamble
HEADER
}
1.20 +3 -1 parrot/docs/pdds/pdd03_calling_conventions.pod
Index: pdd03_calling_conventions.pod
===================================================================
RCS file: /cvs/public/parrot/docs/pdds/pdd03_calling_conventions.pod,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- pdd03_calling_conventions.pod 19 Nov 2003 09:57:25 -0000 1.19
+++ pdd03_calling_conventions.pod 26 Dec 2003 20:58:43 -0000 1.20
@@ -154,7 +154,9 @@
=item P2
-Holds the object the sub was called on. (For method calls)
+Holds the object the sub was called on. (For method calls) This
+register I<must> be null (either NULL or the Null PMC) for non-method
+calls.
=item P3
1.15 +6 -1 parrot/include/parrot/misc.h
Index: misc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/misc.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- misc.h 11 Nov 2003 15:17:16 -0000 1.14
+++ misc.h 26 Dec 2003 20:58:45 -0000 1.15
@@ -1,7 +1,7 @@
/* misc.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: misc.h,v 1.14 2003/11/11 15:17:16 leo Exp $
+ * $Id: misc.h,v 1.15 2003/12/26 20:58:45 dan Exp $
* Overview:
* Miscellaneous functions, mainly the Parrot_sprintf family
* Data Structure and Algorithms:
@@ -35,6 +35,11 @@
INTVAL Parrot_int_rand(INTVAL how_random);
INTVAL Parrot_range_rand(INTVAL from, INTVAL to, INTVAL how_random);
void Parrot_srand(INTVAL seed);
+
+void *Parrot_make_la(struct Parrot_Interp *, PMC *);
+void *Parrot_make_cpa(struct Parrot_Interp *, PMC *);
+void Parrot_destroy_la(long *);
+void Parrot_destroy_cpa(char **);
/*
* misc.c
1.22 +8 -1 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- call_list.txt 26 Dec 2003 16:38:12 -0000 1.21
+++ call_list.txt 26 Dec 2003 20:58:47 -0000 1.22
@@ -26,6 +26,9 @@
# 0 - insert a NULL (pointer) - doesn't comsume a register
# I - Parrot_Interp param
#
+# Arrayish things, terminated with NULL/0
+# L - Long array
+# T - Array of string pointers (Converted to cstrings)
#Return params
#p b
c v
@@ -157,10 +160,14 @@
t B
v P
-# For threads
+# Needed for parrot threads
v IPP
+# Oddball ones for postgres
+p ptiLTLLi
+
# The following are used by library/pcre.imc
p tiB3P
i pPtiiipi
i tpiibi
+
1.5 +59 -1 parrot/src/utils.c
Index: utils.c
===================================================================
RCS file: /cvs/public/parrot/src/utils.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- utils.c 22 Nov 2003 09:55:49 -0000 1.4
+++ utils.c 26 Dec 2003 20:58:47 -0000 1.5
@@ -1,7 +1,7 @@
/* utils.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: utils.c,v 1.4 2003/11/22 09:55:49 leo Exp $
+ * $Id: utils.c,v 1.5 2003/12/26 20:58:47 dan Exp $
* Overview:
* Some utility functions
* Data Structure and Algorithms:
@@ -211,6 +211,64 @@
Parrot_srand(INTVAL seed)
{
_srand48(seed);
+}
+
+void *
+Parrot_make_la(struct Parrot_Interp *interpreter, PMC *array) {
+ INTVAL arraylen = VTABLE_elements(interpreter, array);
+ long *out_array = NULL;
+ INTVAL cur = 0;
+
+ /* Allocate the array and set the last element to 0. Since we
+ always allocate one element more than we use we're guaranteed
+ to actually have an array, even if the inbound array is
+ completely empty
+ */
+ out_array = mem_sys_allocate((sizeof(long)) * (arraylen + 1));
+ out_array[arraylen] = 0;
+
+ for (cur = 0; cur < arraylen; cur++) {
+ out_array[cur] = VTABLE_get_integer_keyed_int(interpreter, array, cur);
+ }
+
+ return out_array;
+}
+
+void
+Parrot_destroy_la(long *array) {
+ mem_sys_free(array);
+}
+
+void *
+Parrot_make_cpa(struct Parrot_Interp *interpreter, PMC *array) {
+ INTVAL arraylen = VTABLE_elements(interpreter, array);
+ char **out_array = NULL;
+ INTVAL cur = 0;
+
+ /* Allocate the array and set the last element to 0. Since we
+ always allocate one element more than we use we're guaranteed
+ to actually have an array, even if the inbound array is
+ completely empty
+ */
+ out_array = mem_sys_allocate((sizeof(char *)) * (arraylen + 1));
+ out_array[arraylen] = 0;
+
+ for (cur = 0; cur < arraylen; cur++) {
+ out_array[cur] = string_to_cstring(interpreter,
VTABLE_get_string_keyed_int(interpreter, array, cur));
+ }
+
+ return out_array;
+}
+
+void
+Parrot_destroy_cpa(char **array) {
+ UINTVAL offset = 0;
+ /* Free each piece */
+ while (array[offset] != NULL) {
+ string_cstring_free(array[offset]);
+ }
+ /* And then the holding array */
+ mem_sys_free(array);
}
/*
