The attached patch implements a Parrot_sprintf function. It doesn't do
quite what you think--it just wraps the system sprintf. However, it
provides I and F sizes and is designed to interact with STRINGs. For
example:
FLOATVAL f;
INTVAL i;
STRING *str;
Parrot_sprintf(&str, "Decimal: %Id\nOctal: %Io\nDecimal: %Ff\nExponent:
%Fe", i, i, f, f);
It keeps away from messing up flags--%+3.2Ff will do what it should.
However, it has one big weakness. Currently, you'll get a buffer
overflow if the resulting string is greater than 1024 characters.
The patch doesn't actually change anything to use Parrot_sprintf; it
just defines the function and the Configure machinery needed to support
it. It's currently in string.[hc]; I'm not sure if this is the right
place. I won't be surprised if this isn't high-quality enough to
actually be applied.
--Brent Dax
[EMAIL PROTECTED]
Configure pumpking for Perl 6
"Nothing important happened today."
--George III of England's diary entry for 4-Jul-1776
--- ..\..\parrot-cvs\parrot\string.c Thu Dec 20 01:09:02 2001
+++ string.c Thu Dec 20 21:05:10 2001
@@ -331,6 +331,117 @@
return cmp;
}
+/* XXX do these really belong here? */
+
+static void
+vsprintf_munge_size(char *patstart, char *patcur, char type);
+
+/*
+=for api string Parrot_sprintf
+
+A thin wrapper around Parrot_vsprintf() which takes varargs instead of a varargs
+list.
+See L</Parrot_vsprintf> for more information.
+
+=cut
+*/
+
+
+INTVAL
+Parrot_sprintf(struct Parrot_Interp *interpreter, STRING **targ, char *pat, ...) {
+ va_list list;
+ INTVAL ret;
+ va_start(list, pat);
+
+ ret=Parrot_vsprintf(interpreter, targ, pat, list);
+
+ va_end(list);
+ return ret;
+}
+
+/*
+=for api string Parrot_vsprintf
+
+A thin wrapper around vsprintf(); it implements %Ix and %Fx, sizes which correspond
+to
+INTVAL and FLOATVAL respectively. It also puts its output in a STRING instead of a
+char *.
+Note: it has a buffer overflow if the resulting string is over 1024 characters.
+
+Parrot_vsprintf(interpreter, &ptr_to_string, "pattern", va_list)
+
+=cut
+*/
+
+INTVAL
+Parrot_vsprintf(struct Parrot_Interp *interpreter, STRING ** targ, char *pat, va_list
+list) {
+ BOOL percent=0;
+ char *virttarg;
+ char *pat2;
+ INTVAL retval;
+
+ /* we can't modify strings in the constant table */
+ pat=strcpy(mem_sys_allocate(strlen(pat)+1), pat);
+
+ for(pat2=pat; *pat2; pat2++) {
+
+ if(*pat2=='%') {
+ percent=!percent;
+ }
+ else if(percent) {
+ switch(*pat2) {
+ case 'I':
+ vsprintf_munge_size(pat, pat2,
+PRINTF_INTVAL_PATTERN);
+ percent=0;
+ break;
+ case 'O':
+ vsprintf_munge_size(pat, pat2,
+PRINTF_OPCODE_T_PATTERN);
+ percent=0;
+ break;
+ case 'F':
+ vsprintf_munge_size(pat, pat2,
+PRINTF_FLOATVAL_PATTERN);
+ percent=0;
+ break;
+ default:
+ /* if this was a letter, we should assume we
+don't have to munge this pattern */
+ if((*pat2 >= 'a' && *pat2 <= 'z') || (*pat2 >=
+'A' && *pat2 <= 'Z')) {
+ percent=0;
+ }
+ }
+ }
+ }
+
+ virttarg=mem_sys_allocate(1024); /* XXX dangerous! */
+
+ retval=(INTVAL)vsprintf(virttarg, pat, list);
+ *targ=string_make(interpreter, virttarg, strlen(virttarg), 0, 0, 0);
+
+ mem_sys_free(virttarg);
+ mem_sys_free(pat);
+
+ return retval;
+}
+
+
+/* these aren't the droids you're looking for--move along! */
+static void
+vsprintf_munge_size(char *patstart, char *patcur, char type) {
+ *patcur=type;
+
+ if(type==0) {
+ strcat(patstart, patcur+1);
+ /* do I get the "most interesting mis-use of a standard library
+function" award for this? */
+
+ /* Okay, that deserves some explanation. Let's say we're handling
+%Io. *
+ * If INTVAL==long, we'll want to transmogrify that into %lo, so
+ *
+ * PRINTF_INTVAL_PATTERN is set to 'l'. However, if INTVAL==int, we
+ *
+ * don't want anything there. When we don't want anything, we set
+ *
+ * PRINTF_INTVAL_PATTERN to null. That means we get the pattern
+ *
+ * %\0o. Obviously, that has the problem of horribly confusing
+vsprintf. *
+ * To get rid of that null, we concatenate the front of the pattern
+ *
+ * with everything after the null. This gets rid of the null
+completely. *
+ * No memory reallocation is necessary because we can only shrink the
+string. */
+ }
+}
+
+
/* A number is such that:
sign = '+' | '-'
digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'
--- ..\..\parrot-cvs\parrot\include\parrot\string.h Thu Dec 20 01:09:06 2001
+++ include\parrot\string.h Thu Dec 20 01:18:38 2001
@@ -64,6 +64,13 @@
void
string_init(void);
+/* XXX do these really belong here? */
+
+INTVAL
+Parrot_sprintf(struct Parrot_Interp *interpreter, STRING **targ, char *pat, ...);
+INTVAL
+Parrot_vsprintf(struct Parrot_Interp *interpreter, STRING ** targ, char *pat, va_list
+list);
+
#endif
/*
--- ..\..\parrot-cvs\parrot\Configure.pl Thu Dec 20 21:58:20 2001
+++ Configure.pl Thu Dec 20 20:59:20 2001
@@ -20,7 +20,7 @@
);
if($opt_version) {
- print '$Id: Configure.pl,v 1.42 2001/12/20 21:28:45 gregor Exp $' . "\n";
+ print '$Id: Configure.pl,v 1.41 2001/12/20 13:10:01 gregor Exp $' . "\n";
exit;
}
@@ -70,7 +70,7 @@
$jitarchname = $archname;
$jitarchname =~ s/-(net|free|open)bsd$/-bsd/i;
-$jitarchname = 'i386-nojit' unless -e "Parrot/Jit/$jitarchname.pm";
+$jitarchname = 'i386-nojit' unless -e "Parrot/Jit/$archname.pm";
($jitcpuarch, $jitosname) = split('-', $jitarchname);
@@ -192,8 +192,8 @@
print <<"END";
-Done. Now I'm figuring out what formats to pass to pack() for the
-various Parrot internal types.
+Done. Now I'm figuring out what formats to pass to pack() and
+sprintf() for the various Parrot internal types.
END
@@ -215,6 +215,39 @@
}
}
+#figure out patterns for Parrot_sprintf
+#NOTE: '\0' is in single quotes on purpose
+for($c{iv}) {
+ $c{intval_pattern}=do {
+ /long long/ && '?' #XXX what should this be?
+ ||
+ /long/ && 'l'
+ ||
+ /int/ && '\0'
+ || die "I'm confoosed about what $_ should map to!"
+ };
+}
+
+for($c{opcode_t}) {
+ $c{opcode_t_pattern}=do {
+ /long long/ && '?' #XXX what should this be?
+ ||
+ /long/ && 'l'
+ ||
+ /int/ && '\0'
+ || die "I'm confoosed about what $_ should map to!"
+ };
+}
+
+for($c{nv}) {
+ $c{floatval_pattern}=do {
+ /long double/ && '?' #XXX what should this be?
+ ||
+ /double/ && '\0'
+ || die "I'm confoosed about what $_ should map to!";
+ };
+}
+
$c{packtype_n} = 'd';
print <<"END";
--- ..\..\parrot-cvs\parrot\config_h.in Wed Oct 24 13:08:38 2001
+++ config_h.in Thu Dec 20 20:59:38 2001
@@ -32,6 +32,9 @@
#define MASK_STR_CHUNK_LOW_BITS ${strlow}
#define MASK_PMC_CHUNK_LOW_BITS ${pmclow}
+#define PRINTF_INTVAL_PATTERN '${intval_pattern}'
+#define PRINTF_FLOATVAL_PATTERN '${floatval_pattern}'
+#define PRINTF_OPCODE_T_PATTERN '${opcode_t_pattern}'
${headers}
