This patch adds macros to the config.h file for INTVAL and NUMVAL printf
formats; I called them INTVAL_FMT and NUMVAL_FMT, although if those names
are not appropriate I won't sweat it.
The detection mechanism is not that fancy. It just reads what you have
in $c{iv} and $c{nv} and hopefully recognizes it. The goal here was to
pass some tests, and besides, we're replacing this whole configure thing
sometime (soon?) anyway.
I changed all the printfs that I could locate that print INTVALs and
NUMVALs to use the new format macros; now mixed 32-bit and 64-bit passes a
lot more tests. There's still one in stacks.t that's giving me trouble
though...
Index: Configure.pl
===================================================================
RCS file: /home/perlcvs/parrot/Configure.pl,v
retrieving revision 1.76
diff -u -r1.76 Configure.pl
--- Configure.pl 8 Jan 2002 17:24:29 -0000 1.76
+++ Configure.pl 9 Jan 2002 14:16:51 -0000
@@ -170,6 +170,9 @@
opcode_t => ($Config{ivtype} || 'long'),
longsize => undef,
+ intvalfmt => '%ld',
+ numvalfmt => '%f',
+
cc => $Config{cc},
#
@@ -542,6 +545,28 @@
die <<"AARGH";
Configure.pl: Unable to find an integer type that fits a pointer.
AARGH
+}
+
+#"
+# Determine format strings for INTVAL and FLOATVAL.
+#
+
+if ($c{iv} eq "int") {
+ $c{intvalfmt} = "%d";
+} elsif (($c{iv} eq "long") || ($c{iv} eq "long int")) {
+ $c{intvalfmt} = "%ld";
+} elsif (($c{iv} eq "long long") || ($c{iv} eq "long long int")) {
+ $c{intvalfmt} = "%lld";
+} else {
+ die "Configure.pl: Can't find a printf-style format specifier for type
+\"$c{iv}\"\n";
+}
+
+if ($c{nv} eq "double") {
+ $c{numvalfmt} = "%f";
+} elsif ($c{nv} eq "long double") {
+ $c{numvalfmt} = "%lf";
+} else {
+ die "Configure.pl: Can't find a printf-style format specifier for type
+\"$c{nv}\"\n";
}
#
Index: config_h.in
===================================================================
RCS file: /home/perlcvs/parrot/config_h.in,v
retrieving revision 1.14
diff -u -r1.14 config_h.in
--- config_h.in 1 Jan 2002 03:48:46 -0000 1.14
+++ config_h.in 9 Jan 2002 14:16:51 -0000
@@ -46,6 +46,9 @@
#define PARROT_CORE_OPLIB_NAME "core"
#define PARROT_CORE_OPLIB_INIT Parrot_DynOp_core_${MAJOR}_${MINOR}_${PATCH}
+#define INTVAL_FMT "${intvalfmt}"
+#define NUMVAL_FMT "${numvalfmt}"
+
${headers}
Index: core.ops
===================================================================
RCS file: /home/perlcvs/parrot/core.ops,v
retrieving revision 1.71
diff -u -r1.71 core.ops
--- core.ops 8 Jan 2002 16:33:29 -0000 1.71
+++ core.ops 9 Jan 2002 14:16:51 -0000
@@ -253,14 +253,12 @@
=cut
inline op print(in INT) {
- /* TODO: Configure for format */
- printf("%li", (long) $1);
+ printf(INTVAL_FMT, $1);
goto NEXT();
}
inline op print(in NUM) {
- /* TODO: Configure for format */
- printf("%f", $1);
+ printf(NUMVAL_FMT, $1);
goto NEXT();
}
@@ -303,8 +301,7 @@
break;
default: file = (FILE *)$1;
}
- /* TODO: Configure for format */
- fprintf(file, "%li", (long) $2);
+ fprintf(file, INTVAL_FMT, $2);
goto NEXT();
}
@@ -319,8 +316,7 @@
break;
default: file = (FILE *)$1;
}
- /* TODO: Configure for format */
- fprintf(file, "%f", $2);
+ fprintf(file, NUMVAL_FMT, $2);
goto NEXT();
}
Index: key.c
===================================================================
RCS file: /home/perlcvs/parrot/key.c,v
retrieving revision 1.10
diff -u -r1.10 key.c
--- key.c 8 Jan 2002 20:05:18 -0000 1.10
+++ key.c 9 Jan 2002 14:16:51 -0000
@@ -272,7 +272,7 @@
if(idx != NULL) {
INTVAL hash = key_hash(interpreter,idx);
hash = hash % NUM_BUCKETS;
- pair = find_bucket(interpreter,key->keys[hash].cache.struct_val,idx);
+ pair = find_bucket(interpreter,(BUCKET *)key->keys[hash].cache.struct_val,idx);
if(pair == NULL) {
fprintf(stderr,"*** key_element_value_s pair returning a null key\n");
}
@@ -336,7 +336,7 @@
}
else {
}
- key->keys[hash].cache.struct_val = bucket;
+ key->keys[hash].cache.struct_val = (STRING *)bucket;
key->keys[hash].type = enum_key_bucket;
}
else {
Index: classes/perlint.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/perlint.pmc,v
retrieving revision 1.12
diff -u -r1.12 perlint.pmc
--- classes/perlint.pmc 4 Jan 2002 16:09:01 -0000 1.12
+++ classes/perlint.pmc 9 Jan 2002 14:16:51 -0000
@@ -64,9 +64,9 @@
char* buff = mem_sys_allocate(80);
STRING* s;
#ifdef HAS_SNPRINTF
- snprintf(buff,80,"%ld",SELF->cache.int_val);
+ snprintf(buff,80,INTVAL_FMT,SELF->cache.int_val);
#else
- sprintf(buff,"%ld",SELF->cache.int_val); /* XXX buffer overflow! */
+ sprintf(buff,INTVAL_FMT,SELF->cache.int_val); /* XXX buffer overflow! */
#endif
s = string_make(INTERP,buff,strlen(buff),NULL,0,NULL);
free(buff);
Index: classes/perlnum.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/perlnum.pmc,v
retrieving revision 1.13
diff -u -r1.13 perlnum.pmc
--- classes/perlnum.pmc 4 Jan 2002 16:09:01 -0000 1.13
+++ classes/perlnum.pmc 9 Jan 2002 14:16:51 -0000
@@ -64,9 +64,9 @@
char* buff = mem_sys_allocate(80);
STRING* s;
#ifdef HAS_SNPRINTF
- snprintf(buff,80,"%f",SELF->cache.num_val);
+ snprintf(buff,80,NUMVAL_FMT,SELF->cache.num_val);
#else
- sprintf(buff,"%f",SELF->cache.num_val); /* XXX buffer overflow! */
+ sprintf(buff,NUMVAL_FMT,SELF->cache.num_val); /* XXX buffer overflow! */
#endif
s = string_make(INTERP,buff,strlen(buff),NULL,0,NULL);
free(buff);
- D
<[EMAIL PROTECTED]>
