Dan --
Here's a first version that works with the regular core.
You have to explicitly define PARANOID, or the added code
won't get compiled.
I imagine this will have to be adapted to work with the other
core types, but I wanted to throw this out as a starting point.
I'll leave it up to you whether its worth committing it or
starting over fresh thinking about all cores simultaneously.
Regards,
-- Gregor
On Fri, 2003-10-03 at 11:29, Dan Sugalski wrote:
> Okay, it's time to start in, at least a little, on safe mode for parrot.
>
> While there's a *lot* to ultimately do, the initial part, a paranoid set
> of ops and a runloop that understands it, is relatively simple. What we
> need is someone to thump the code that generates the core_ops.c files (and
> their kindred) to getnerate an alternate set of runloops and op functions.
> These functions, to start, are relatively simple. All that needs to be
> done is for there to be a preamble emitted for each op function that does
> simple validation of the parameters. That means the register number must
> be between 0 and 31, and that any P or S register that is an 'in'
> parameter must be non-NULL.
>
> Anyone care to take a shot?
>
> Dan
--
Gregor Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
Index: lib/Parrot/Op.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Op.pm,v
retrieving revision 1.11
diff -u -r1.11 Op.pm
--- lib/Parrot/Op.pm 20 May 2003 08:37:14 -0000 1.11
+++ lib/Parrot/Op.pm 4 Oct 2003 06:27:16 -0000
@@ -98,6 +98,17 @@
#
+# arg_count()
+#
+
+sub arg_count
+{
+ my $self = shift;
+ return scalar(@{$self->{ARGS}});
+}
+
+
+#
# arg_types()
#
@@ -176,7 +187,66 @@
{
my $self = shift;
- my $body = $self->body;
+ my $preamble = "";
+
+ if ($self->arg_count > 1) {
+ $preamble .= <<END_C;
+#ifdef PARANOID
+END_C
+
+ my $full_name = $self->full_name;
+
+ for(my $i = 1; $i < $self->arg_count; $i++) {
+ my $type = $self->arg_type($i);
+ my $dir = $self->arg_dir($i);
+
+ $preamble .= <<END_C;
+ /* Arg $i: TYPE => '$type', DIR => '$dir' */
+END_C
+
+ if ($self->arg_type($i) =~ m/^(i|n|p|s)$/i ) {
+ $preamble .= <<END_C;
+ if (cur_opcode[$i] < 0 || cur_opcode[$i] > 31) {
+ PANIC("Register number out of range for arg $i of op '$full_name'!");
+ }
+END_C
+ }
+
+ if ($self->arg_type($i) =~ m/^(p|s)$/i and $self->arg_dir($i) =~ m/^i$/i) {
+ $preamble .= <<END_C;
+ if ([EMAIL PROTECTED] == NULL) {
+ PANIC("NULL value in P or S register for arg $i of op '$full_name'!");
+ }
+END_C
+ }
+
+ if ($self->arg_type($i) =~ m/^([knps])c$/i) {
+ my $const_type_tag;
+ if (lc $1 eq 'k') { $const_type_tag = "PFC_KEY"; }
+ elsif (lc $1 eq 'n') { $const_type_tag = "PFC_NUMBER"; }
+ elsif (lc $1 eq 'p') { $const_type_tag = "PFC_PMC"; }
+ elsif (lc $1 eq 's') { $const_type_tag = "PFC_STRING"; }
+
+ $preamble .= <<END_C;
+ if (cur_opcode[$i] < 0 || cur_opcode[$i] >= interpreter->code->const_table->const_count) {
+ PANIC("Constant number out of range for arg $i of op '$full_name'!");
+ }
+ if (interpreter->code->const_table->constants[cur_opcode[$i]]->type != $const_type_tag) {
+ PANIC("Constant of wrong type for arg $i of op '$full_name'!");
+ }
+END_C
+ }
+
+ }
+
+ $preamble .= <<END_C;
+#endif /* PARANOID */
+
+END_C
+
+ }
+
+ my $body = $preamble . $self->body;
$body .= sprintf(" {{+=%d}};\n", $self->size)
if $self->type eq 'auto';
