Author: jkeenan
Date: Sat Dec 1 06:27:34 2007
New Revision: 23311
Modified:
branches/initp5/compilers/nqp/README.pod
branches/initp5/compilers/nqp/TODO.pod
branches/initp5/compilers/pirc/pirc.c
branches/initp5/examples/sdl/blue_rect.pl
branches/initp5/include/parrot/interpreter.h
branches/initp5/src/pmc/eventhandler.pmc
branches/initp5/src/pmc/task.pmc
branches/initp5/t/configure/115-auto_warnings.t
branches/initp5/t/library/range.t
branches/initp5/t/pmc/task.t
Log:
Synching initp5 with changes to trunk between r23293 and r23308.
Modified: branches/initp5/compilers/nqp/README.pod
==============================================================================
--- branches/initp5/compilers/nqp/README.pod (original)
+++ branches/initp5/compilers/nqp/README.pod Sat Dec 1 06:27:34 2007
@@ -63,6 +63,7 @@
=item * for # iterative loop
+=item * PIR q<>, PIR q:to:<END> # inline PIR
=back
Modified: branches/initp5/compilers/nqp/TODO.pod
==============================================================================
--- branches/initp5/compilers/nqp/TODO.pod (original)
+++ branches/initp5/compilers/nqp/TODO.pod Sat Dec 1 06:27:34 2007
@@ -26,25 +26,6 @@
return statements for developing action grammars, so this is no
longer as much of a priority as it was.
-=item * inline PIR
-
-It would be nice to have a way to embed PIR instructions
-directly into NQP source files. Even better would be to do
-with a Perl 6 compatible syntax. One approach easily understood
-by non-Perl 6 programmers would be to use labeled blocks like
-
- PIR {
- $S0 = 'foo'
- say $S0
- }
-
-but this probably isn't valid Perl 6. So, another approach would
-be to embed it in something that is syntactically a Perl 6 comment.
-
-(There's also the possibility of doing something like 'eval',
-but eval probably implies more of a runtime evaluation than
-inline code generation.)
-
=item * Named argument (not param) support
C<PAST> now supports named arguments in subroutines, we simply need
Modified: branches/initp5/compilers/pirc/pirc.c
==============================================================================
--- branches/initp5/compilers/pirc/pirc.c (original)
+++ branches/initp5/compilers/pirc/pirc.c Sat Dec 1 06:27:34 2007
@@ -7,14 +7,43 @@
#include <stdlib.h>
#include <string.h>
+/*
+
+=head1 NAME
+
+compilers/pirc/pirc.c
+
+=head1 DESCRIPTION
+
+TODO: Not yet documented!!!
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
typedef enum arg_flags {
FLAG_PREPROCESS = 0x01,
FLAG_ONLY_HEREDOC = 0x02,
} arg_flag;
-#define SET_FLAG(obj,flag) obj |= flag
-#define TEST_FLAG(obj,flag) obj & flag
+#define SET_FLAG(obj, flag) obj |= flag
+#define TEST_FLAG(obj, flag) obj & flag
+
+/*
+
+=item C<static void
+print_help(void)>
+
+Prints help message and usage information
+
+=cut
+
+*/
static void
print_help(void) {
@@ -25,7 +54,7 @@
" -E pre-process only, do not parse\n"
" -H only heredoc processing\n"
/*" -o <file> write output to the specified file\n" */
- );
+ "");
}
/*
@@ -110,6 +139,14 @@
return 0;
}
+/*
+
+=back
+
+=cut
+
+*/
+
/*
* Local variables:
Modified: branches/initp5/examples/sdl/blue_rect.pl
==============================================================================
--- branches/initp5/examples/sdl/blue_rect.pl (original)
+++ branches/initp5/examples/sdl/blue_rect.pl Sat Dec 1 06:27:34 2007
@@ -1,3 +1,8 @@
+# $Id$
+
+## no critic TestingAndDebugging::RequireUseStrict
+## no critic TestingAndDebugging::RequireUseWarnings
+
=head1 TITLE
blue_rect.pl - draw a blue rectangle using the SDL library and NQP
@@ -60,8 +65,8 @@
=cut
# Local Variables:
-# mode: pir
+# mode: cperl
+# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
-
Modified: branches/initp5/include/parrot/interpreter.h
==============================================================================
--- branches/initp5/include/parrot/interpreter.h (original)
+++ branches/initp5/include/parrot/interpreter.h Sat Dec 1 06:27:34 2007
@@ -308,7 +308,6 @@
PMC *class_hash; /* Hash of classes */
VTABLE **vtables; /* array of vtable ptrs */
- PMC *pmc_proxies; /* PMC array of PMC Proxy
objects */
int n_vtable_max; /* highest used type */
int n_vtable_alloced; /* alloced vtable space */
Modified: branches/initp5/src/pmc/eventhandler.pmc
==============================================================================
--- branches/initp5/src/pmc/eventhandler.pmc (original)
+++ branches/initp5/src/pmc/eventhandler.pmc Sat Dec 1 06:27:34 2007
@@ -86,10 +86,14 @@
code = data;
}
else if (VTABLE_isa(INTERP, data, CONST_STRING(INTERP, "Hash"))) {
- code = VTABLE_get_pmc_keyed_str(INTERP, data,
CONST_STRING(INTERP, "code"));
- interpreter = VTABLE_get_pmc_keyed_str(INTERP, data,
CONST_STRING(INTERP, "interp"));
- type = VTABLE_get_string_keyed_str(INTERP, data,
CONST_STRING(INTERP, "type"));
- priority = VTABLE_get_integer_keyed_str(INTERP, data,
CONST_STRING(INTERP, "priority"));
+ code =
+ VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"code"));
+ interpreter =
+ VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"interp"));
+ type =
+ VTABLE_get_string_keyed_str(INTERP, data, CONST_STRING(INTERP,
"type"));
+ priority =
+ VTABLE_get_integer_keyed_str(INTERP, data,
CONST_STRING(INTERP, "priority"));
}
else {
real_exception(INTERP, NULL, INVALID_OPERATION,
@@ -220,11 +224,12 @@
/* can't invoke on INTERP and can't return its result; this may not be
* the right interpreter */
if (e) {
- unused = VTABLE_invoke(e->interp, e->code, next);
+ unused = VTABLE_invoke(PMC_data_typed(e->interp, Parrot_Interp),
+ e->code, next);
UNUSED(unused);
}
- return next;
+ return (opcode_t *)next;
}
}
Modified: branches/initp5/src/pmc/task.pmc
==============================================================================
--- branches/initp5/src/pmc/task.pmc (original)
+++ branches/initp5/src/pmc/task.pmc Sat Dec 1 06:27:34 2007
@@ -50,6 +50,99 @@
core_struct->interp = PMCNULL;
}
+/*
+
+=item C<void init_pmc(PMC *data)>
+
+Initializes a new Task with a C<Hash> PMC with any or all of the keys:
+
+=over 4
+
+=item C<id>
+
+An C<Integer> representing the task's unique identifier.
+
+=item C<type>
+
+A C<String> representing the type of the task.
+
+=item C<priority>
+
+An C<Integer> representing the task's priority, from 0 to 100.
+
+=item C<status>
+
+A C<String> representing the task's status, one of C<created>, C<invoked>,
+C<inprocess>, or C<completed>.
+
+=item C<birthtime>
+
+The time at which this Task was inserted into the task list.
+
+=item C<code>
+
+A C<Sub> or descendent PMC related to this task.
+
+=item C<interp>
+
+An interpreter in which to execute this task.
+
+=back
+
+*/
+
+ void init_pmc(PMC *data) {
+ PMC *elem;
+ Parrot_Task *core_struct;
+
+ if (! VTABLE_isa(INTERP, data, CONST_STRING(INTERP, "Hash")))
+ real_exception(INTERP, NULL, INVALID_OPERATION,
+ "Task initializer must be a Hash");
+
+ core_struct = mem_allocate_zeroed_typed(Parrot_Task);
+
+ /* Set flags for custom DOD mark and destroy. */
+ PObj_custom_mark_SET(SELF);
+ PObj_active_destroy_SET(SELF);
+
+ /* Set up the core struct. */
+ PMC_data(SELF) = core_struct;
+
+ elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"id"));
+ if (! PMC_IS_NULL(elem))
+ core_struct->id = VTABLE_get_integer(INTERP, elem);
+ else
+ core_struct->id = 0;
+
+ elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"type"));
+ if (! PMC_IS_NULL(elem))
+ core_struct->type = VTABLE_get_string(INTERP, elem);
+ else
+ core_struct->type = CONST_STRING(INTERP, "");
+
+ elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"priority"));
+ if (! PMC_IS_NULL(elem))
+ core_struct->priority = VTABLE_get_integer(INTERP, elem);
+ else
+ core_struct->priority = 0;
+
+ elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"status"));
+ if (! PMC_IS_NULL(elem))
+ core_struct->status = VTABLE_get_string(INTERP, elem);
+ else
+ core_struct->status = CONST_STRING(INTERP, "created");
+
+ elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"birthtime"));
+ if (! PMC_IS_NULL(elem))
+ core_struct->birthtime = VTABLE_get_integer(INTERP, elem);
+ else
+ core_struct->birthtime = 0;
+
+ core_struct->codeblock =
+ VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"code"));
+ core_struct->interp =
+ VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP,
"interp"));
+ }
/*
Modified: branches/initp5/t/configure/115-auto_warnings.t
==============================================================================
--- branches/initp5/t/configure/115-auto_warnings.t (original)
+++ branches/initp5/t/configure/115-auto_warnings.t Sat Dec 1 06:27:34 2007
@@ -24,8 +24,8 @@
my $step = 'dummy';
my $conf = Parrot::Configure->new;
-$conf->data->set('cc', 'cc'); # XXX Cannot assume there iss a compiler 'cc'
-$conf->data->set('ccflags', '-I/usr/include'); # XXX Cannot assume this.
+$conf->data->set('cc', 'cc'); # RT#47395 Cannot assume there is a compiler 'cc'
+$conf->data->set('ccflags', '-I/usr/include'); # RT#47395 Cannot assume this.
my $cwd = cwd();
my $warning;
@@ -33,7 +33,7 @@
TODO: {
# http://rt.perl.org/rt3/Ticket/Display.html?id=47395
local $TODO = q<Not all compilers support -Wall>;
- $warning = "-Wall"; # XXX Cannot assume all compilers accept -Wall.
+ $warning = "-Wall"; # RT#47395 Cannot assume all compilers accept -Wall.
{
my $verbose = 0;
my $rv = auto::warnings::try_warning($step, $conf, $warning);
Modified: branches/initp5/t/library/range.t
==============================================================================
--- branches/initp5/t/library/range.t (original)
+++ branches/initp5/t/library/range.t Sat Dec 1 06:27:34 2007
@@ -18,6 +18,7 @@
.sub main :main
.include 'include/test_more.pir'
+ load_bytecode 'Range.pir'
plan(78)
Modified: branches/initp5/t/pmc/task.t
==============================================================================
--- branches/initp5/t/pmc/task.t (original)
+++ branches/initp5/t/pmc/task.t Sat Dec 1 06:27:34 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
=head1 NAME
@@ -79,6 +79,57 @@
100000000
OUT
+pir_output_is( <<'CODE', <<'OUT', 'create a task and set attributes in init' );
+ .sub main :main
+ .local pmc data
+ data = new 'Hash'
+
+ $P2 = new 'String'
+ $P2 = 'inprocess'
+ data['status'] = $P2
+
+ $P2 = new 'String'
+ $P2 = 'event'
+ data['type'] = $P2
+
+ $P2 = new 'Integer'
+ $P2 = 10
+ data['priority'] = $P2
+
+ $P2 = new 'Integer'
+ $P2 = 7405
+ data['id'] = $P2
+
+ $P2 = new 'Integer'
+ $P2 = 100000000
+ data['birthtime'] = $P2
+
+ $P0 = new 'Task', data
+
+ $P3 = getattribute $P0, 'status'
+ say $P3
+
+ $P3 = getattribute $P0, 'type'
+ say $P3
+
+ $P3 = getattribute $P0, 'priority'
+ say $P3
+
+ $P3 = getattribute $P0, 'id'
+ say $P3
+
+ $P3 = getattribute $P0, 'birthtime'
+ say $P3
+ end
+ .end
+CODE
+inprocess
+event
+10
+7405
+100000000
+OUT
+
pir_output_is( <<'CODE', <<'OUT', "freeze and thaw a task" );
.sub main :main
$P0 = new "Task"
