All --
I've created a varargs-ish example by making a new op, print_s_v.
This is pretty rough, and I haven't updated the assembler, but it
seems to work.
I'm attaching a patch, and a test program (pt.pasm).
Enjoy!
-- Gregor
_____________________________________________________________________
/ perl -e 'srand(-2091643526); print chr rand 90 for (0..4)' \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.45
diff -u -r1.45 assemble.pl
--- assemble.pl 2001/09/24 16:01:58 1.45
+++ assemble.pl 2001/09/24 21:25:57
@@ -303,19 +303,55 @@
error("No opcode $opcode ( tried " . join(', ', @tests) . ") in
<$pline>",$file,$line);
}
}
- if (@args != $opcodes{$opcode}{ARGS}) {
- error("Wrong arg count--got ".scalar(@args)." needed
".$opcodes{$opcode}{ARGS}." in <$_>" ,$file,$line);
+
+ my $varop = $opcode =~m/_v$/;
+
+ if ($varop) {
+ if (@args < $opcodes{$opcode}{ARGS}) {
+ error("Wrong arg count--got ".scalar(@args)." needed at
+least".$opcodes{$opcode}{ARGS}." in <$_>" ,$file,$line);
+ }
+ } else {
+ if (@args != $opcodes{$opcode}{ARGS}) {
+ error("Wrong arg count--got ".scalar(@args)." needed
+".$opcodes{$opcode}{ARGS}." in <$_>" ,$file,$line);
+ }
}
+
$bytecode .= pack_op($opcodes{$opcode}{CODE});
$op_pc=$pc;
$pc+=sizeof('op');
+ if ($varop) {
+ splice(@args, $opcodes{$opcode}{ARGS} - 1, 0, scalar(@args)); # Splice in the
+arg count.
+ }
+
foreach (0..$#args) {
my($rtype)=$opcodes{$opcode}{TYPES}[$_];
+
+ if ($varop) {
+ if (not defined $rtype) {
+ if ($args[$_] =~ m/^([INPS])(\d+)$/) {
+ $rtype = $1;
+ } elsif ($args[$_] =~ m/^\d+\.\d+$/) {
+ $rtype = 'n';
+ } elsif ($args[$_] =~ m/^\d+$/) {
+ $rtype = 'i';
+ } elsif ($args[$_] =~ m/^\[\d+\]$/) {
+ $rtype = 's';
+ } else {
+ $rtype = '*';
+ warn "Could not infer arg type!";
+ }
+ } elsif ($rtype eq 'v') {
+ $rtype = 'i';
+ }
+ }
+
if($rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq "S") {
# its a register argument
- $args[$_]=~s/^[INPS](\d+)$/$1/i;
- error("Register $1 out of range (should be 0-31) in
'$opcode'",$file,$line) if $1 < 0 or $1 > 31;
+ $args[$_] =~ m/^[INPS](\d+)$/i;
+ error("Register '" . $args[$_] . "' unparseable in '$opcode'",$file,$line)
+unless defined $1;
+ error("Register '$args[$_]' out of range (should be 0-31) in
+'$opcode'",$file,$line) if $1 < 0 or $1 > 31;
+ $args[$_] = $1;
} elsif($rtype eq "D") {
# a destination
if($args[$_]=~/^\$/) {
Index: basic_opcodes.ops
===================================================================
RCS file: /home/perlcvs/parrot/basic_opcodes.ops,v
retrieving revision 1.24
diff -u -r1.24 basic_opcodes.ops
--- basic_opcodes.ops 2001/09/24 16:27:48 1.24
+++ basic_opcodes.ops 2001/09/24 21:25:57
@@ -6,7 +6,10 @@
#include "parrot/parrot.h"
#include <math.h>
+#include <stdarg.h>
+#define VP(n) cur_opcode[(n) + 2]
+
/* SET Ix, CONSTANT */
AUTO_OP set_i_ic {
INT_REG(P1) = P2;
@@ -141,6 +144,89 @@
/* TIME Ix */
AUTO_OP time_i {
INT_REG(P1) = time(NULL);
+}
+
+/* PRINTF Sx, Vz */
+MANUAL_OP print_s_v {
+ const char * fmt = STR_REG(P1)->bufstart;
+ IV fmt_len = string_length(STR_REG(P1));
+ IV fmt_idx;
+ char fmt_last = '\0';
+ int in_format = 0;
+ STRING * s;
+ IV arg = 0; /* No args so far */
+ const char * str;
+ IV str_len;
+
+ /* TODO: Grab P2 (argc) and make sure we don't overrun it!!! */
+
+ for(fmt_idx = 0; fmt_idx < fmt_len; fmt_idx++) {
+ if (fmt[fmt_idx] == '%' && fmt_last != '\\') {
+ in_format = fmt_idx + 1; /* the char after '%' */
+ continue;
+ }
+
+ /* TODO: DANGER: Assumes IV-sized NVs!!! */
+
+ if (in_format) {
+ switch (fmt[fmt_idx]) {
+ case 'i':
+ /* TODO: inherit the precision, etc. */
+ arg++;
+ printf("%d", VP(arg));
+ in_format = 0;
+ break;
+
+ case 'I':
+ /* TODO: inherit the precision, etc. */
+ arg++;
+ printf("%d", INT_REG(VP(arg)));
+ in_format = 0;
+ break;
+
+ case 'n':
+ /* TODO: inherit the precision, etc. */
+ arg++;
+ printf("%f", VP(arg));
+ in_format = 0;
+ break;
+
+ case 'N':
+ /* TODO: inherit the precision, etc. */
+ arg++;
+ printf("%f", NUM_REG(VP(arg)));
+ in_format = 0;
+ break;
+
+ case 's':
+ /* TODO: inherit the precision, etc. */
+ arg++;
+ str = Parrot_string_constants[VP(arg)]->bufstart;
+ str_len = string_length(Parrot_string_constants[VP(arg)]);
+ printf("%*s", str_len, str);
+ in_format = 0;
+ break;
+
+ case 'S':
+ arg++;
+ /* TODO: inherit the precision, etc. */
+ str = STR_REG(VP(arg))->bufstart;
+ str_len = string_length(STR_REG(VP(arg)));
+ printf("%*s", str_len, str);
+ in_format = 0;
+ break;
+
+ default:
+ /* Just keep scanning until we get a final 'type' character... */
+ break;
+ }
+ } else {
+ putchar(fmt[fmt_idx]);
+ continue;
+ }
+ }
+
+ RETURN(arg + 2);
}
/* PRINT Ix */
Index: opcode_table
===================================================================
RCS file: /home/perlcvs/parrot/opcode_table,v
retrieving revision 1.22
diff -u -r1.22 opcode_table
--- opcode_table 2001/09/24 16:27:48 1.22
+++ opcode_table 2001/09/24 21:25:57
@@ -57,8 +57,6 @@
# String ops
set_s_sc 2 S s
-print_s 1 S
-print_sc 1 s
length_i_s 2 I S
chopn_s_ic 2 S i
substr_s_s_i 4 S S I I
@@ -107,12 +105,18 @@
# Miscellaneous and debugging ops
time_i 1 I
+time_n 1 N
+noop 0
+
+# Printing ops
+
print_i 1 I
print_ic 1 i
-time_n 1 N
print_n 1 N
print_nc 1 n
-noop 0
+print_s 1 S
+print_sc 1 s
+print_s_v 2 S v
# Register ops
Index: process_opfunc.pl
===================================================================
RCS file: /home/perlcvs/parrot/process_opfunc.pl,v
retrieving revision 1.16
diff -u -r1.16 process_opfunc.pl
--- process_opfunc.pl 2001/09/23 00:03:45 1.16
+++ process_opfunc.pl 2001/09/24 21:25:57
@@ -53,6 +53,7 @@
D => 1,
S => 1,
s => 1,
+ v => 0,
);
set S1, "%s, %s! (%s)\n"
print_s_v S1, "Hello", "world", "How are you doing?"
end
