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