[svn:parrot] r43745 - in branches/gc_encapsulate: . compilers/ncigen/config/makefiles config/auto config/gen/makefiles config/init docs include/parrot lib/Parrot/Configure/Options/Conf lib/Parrot/Docs/Section lib/Parrot/Pmc2c runtime/parrot/library src src/gc src/pmc t/benchmark t/configure t/tools/pmc2cutils tools/build tools/dev
bacek at svn.parrot.org
bacek at svn.parrot.org
Sun Feb 7 06:12:58 UTC 2010
Author: bacek
Date: Sun Feb 7 06:12:55 2010
New Revision: 43745
URL: https://trac.parrot.org/parrot/changeset/43745
Log:
Sinc branch with trunk.
Conflicts:
PBC_COMPAT
config/gen/makefiles/root.in
src/pmc_freeze.c
t/native_pbc/annotations.pbc
t/native_pbc/integer_1.pbc
t/native_pbc/number_1.pbc
t/native_pbc/string_1.pbc
tools/build/nativecall.pl
Added:
branches/gc_encapsulate/src/pmc/imageio.pmc
branches/gc_encapsulate/tools/build/cc_flags.pl
- copied, changed from r43744, branches/gc_encapsulate/tools/dev/cc_flags.pl
branches/gc_encapsulate/tools/build/nativecall.pir
Deleted:
branches/gc_encapsulate/tools/build/dynpmc.pl
branches/gc_encapsulate/tools/dev/cc_flags.pl
Modified:
branches/gc_encapsulate/Configure.pl
branches/gc_encapsulate/DEPRECATED.pod
branches/gc_encapsulate/MANIFEST
branches/gc_encapsulate/MANIFEST.SKIP
branches/gc_encapsulate/PBC_COMPAT
branches/gc_encapsulate/compilers/ncigen/config/makefiles/ncigen.in
branches/gc_encapsulate/config/auto/icu.pm
branches/gc_encapsulate/config/gen/makefiles/root.in
branches/gc_encapsulate/config/init/hints.pm
branches/gc_encapsulate/docs/compiler_faq.pod
branches/gc_encapsulate/include/parrot/pmc_freeze.h
branches/gc_encapsulate/lib/Parrot/Configure/Options/Conf/Shared.pm
branches/gc_encapsulate/lib/Parrot/Docs/Section/Tools.pm
branches/gc_encapsulate/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/gc_encapsulate/runtime/parrot/library/distutils.pir
branches/gc_encapsulate/src/gc/gc_ms.c
branches/gc_encapsulate/src/gc/gc_private.h
branches/gc_encapsulate/src/gc/mark_sweep.c
branches/gc_encapsulate/src/hash.c
branches/gc_encapsulate/src/packdump.c
branches/gc_encapsulate/src/pbc_merge.c
branches/gc_encapsulate/src/pmc/class.pmc
branches/gc_encapsulate/src/pmc/default.pmc
branches/gc_encapsulate/src/pmc/eval.pmc
branches/gc_encapsulate/src/pmc/fixedbooleanarray.pmc
branches/gc_encapsulate/src/pmc/fixedintegerarray.pmc
branches/gc_encapsulate/src/pmc/fixedpmcarray.pmc
branches/gc_encapsulate/src/pmc/fixedstringarray.pmc
branches/gc_encapsulate/src/pmc/float.pmc
branches/gc_encapsulate/src/pmc/hash.pmc
branches/gc_encapsulate/src/pmc/integer.pmc
branches/gc_encapsulate/src/pmc/key.pmc
branches/gc_encapsulate/src/pmc/lexinfo.pmc
branches/gc_encapsulate/src/pmc/object.pmc
branches/gc_encapsulate/src/pmc/orderedhash.pmc
branches/gc_encapsulate/src/pmc/parrotinterpreter.pmc
branches/gc_encapsulate/src/pmc/resizablebooleanarray.pmc
branches/gc_encapsulate/src/pmc/resizableintegerarray.pmc
branches/gc_encapsulate/src/pmc/retcontinuation.pmc
branches/gc_encapsulate/src/pmc/scheduler.pmc
branches/gc_encapsulate/src/pmc/schedulermessage.pmc
branches/gc_encapsulate/src/pmc/string.pmc
branches/gc_encapsulate/src/pmc/sub.pmc
branches/gc_encapsulate/src/pmc/task.pmc
branches/gc_encapsulate/src/pmc_freeze.c
branches/gc_encapsulate/src/vtable.tbl
branches/gc_encapsulate/t/benchmark/benchmarks.t
branches/gc_encapsulate/t/configure/033-step.t
branches/gc_encapsulate/t/tools/pmc2cutils/02-find_file.t
branches/gc_encapsulate/t/tools/pmc2cutils/04-dump_pmc.t
branches/gc_encapsulate/t/tools/pmc2cutils/05-gen_c.t
branches/gc_encapsulate/tools/build/nativecall.pl
Modified: branches/gc_encapsulate/Configure.pl
==============================================================================
--- branches/gc_encapsulate/Configure.pl Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/Configure.pl Sun Feb 7 06:12:55 2010 (r43745)
@@ -201,6 +201,10 @@
=over 4
+=item C<--hintsfile=filename>
+
+Use filename as the hints file.
+
=item C<--darwin_no_fink>
On Darwin, do not probe for Fink libraries.
Modified: branches/gc_encapsulate/DEPRECATED.pod
==============================================================================
--- branches/gc_encapsulate/DEPRECATED.pod Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/DEPRECATED.pod Sun Feb 7 06:12:55 2010 (r43745)
@@ -48,12 +48,6 @@
L<https://trac.parrot.org/parrot/ticket/452>
-=item Hash changes to AssociativePMCArray [eligible in 1.5]
-
-Also OrderedHash to OrderedAssociativePMCArray.
-
-L<https://trac.parrot.org/parrot/ticket/679>
-
=item Method stdhandle in ParrotInterpreter [experimental]
L<https://trac.parrot.org/parrot/ticket/264>
@@ -75,16 +69,6 @@
L<https://trac.parrot.org/parrot/ticket/918>
-=item The visit_info structure and associated VTABLEs. [eligible in 2.1]
-
-The current freeze/thaw implementation makes heavy use of the visit_info
-structure and the VTABLE interface attached to it. This structure will
-be replaced with a PMC of equivalent functionality and with a possibly
-similar interface. The freeze, thaw, and visit vtables of all PMCs should be
-updated to the provided interim API before this change is made.
-
-L<https://trac.parrot.org/parrot/ticket/1305>
-
=item Overriding vtable invoke in PIR objects [experimental]
The VTABLE invoke in object.pmc puts SELF at the start of the
@@ -154,15 +138,15 @@
=over 4
-=item packfile structure [eligible in 1.1]
+=item packfile structure [experimental]
L<https://trac.parrot.org/parrot/ticket/451>
-=item opcode numbering [eligible in 1.1]
+=item opcode numbering [experimental]
L<https://trac.parrot.org/parrot/ticket/451>
-=item PMC numbering [eligible in 1.1]
+=item PMC numbering [experimental]
L<https://trac.parrot.org/parrot/ticket/451>
@@ -369,18 +353,6 @@
=back
-=head1 build tools
-
-=over 4
-
-=item tools/build/dynpmc.pl [eligible in 1.1]
-
-Replaced with makefiles.
-
-L<https://trac.parrot.org/parrot/ticket/338>
-
-=back
-
=head1 Parrot library
=over 4
Modified: branches/gc_encapsulate/MANIFEST
==============================================================================
--- branches/gc_encapsulate/MANIFEST Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/MANIFEST Sun Feb 7 06:12:55 2010 (r43745)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Jan 26 00:27:14 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Feb 2 19:27:59 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1428,6 +1428,7 @@
src/pmc/hash.pmc [devel]src
src/pmc/hashiterator.pmc [devel]src
src/pmc/hashiteratorkey.pmc [devel]src
+src/pmc/imageio.pmc [devel]src
src/pmc/integer.pmc [devel]src
src/pmc/iterator.pmc [devel]src
src/pmc/key.pmc [devel]src
@@ -2128,10 +2129,11 @@
t/tools/testdata [test]
tools/build/addopstags.pl []
tools/build/c2str.pl []
-tools/build/dynpmc.pl []
+tools/build/cc_flags.pl []
tools/build/fixup_gen_file.pl []
tools/build/h2inc.pl []
tools/build/headerizer.pl []
+tools/build/nativecall.pir []
tools/build/nativecall.pl []
tools/build/ops2c.pl [devel]
tools/build/ops2pm.pl []
@@ -2144,7 +2146,6 @@
tools/dev/as2c.pl []
tools/dev/bench_op.pir []
tools/dev/branch_status.pl []
-tools/dev/cc_flags.pl []
tools/dev/checkdepend.pl []
tools/dev/create_language.pl [devel]
tools/dev/debian_docs.sh []
Modified: branches/gc_encapsulate/MANIFEST.SKIP
==============================================================================
--- branches/gc_encapsulate/MANIFEST.SKIP Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/MANIFEST.SKIP Sun Feb 7 06:12:55 2010 (r43745)
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jan 27 09:57:54 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Feb 2 06:21:51 2010 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
Modified: branches/gc_encapsulate/PBC_COMPAT
==============================================================================
--- branches/gc_encapsulate/PBC_COMPAT Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/PBC_COMPAT Sun Feb 7 06:12:55 2010 (r43745)
@@ -27,6 +27,7 @@
# please insert tab separated entries at the top of the list
+6.2 2010.01.31 cotto serialization-related changes to ParrotInterpreter
6.1 2010.01.30 whiteknight remove Array PMC
6.0 2010.01.19 chromatic released 2.0.0
5.1 2009.08.06 cotto remove branch_cs opcode
Modified: branches/gc_encapsulate/compilers/ncigen/config/makefiles/ncigen.in
==============================================================================
--- branches/gc_encapsulate/compilers/ncigen/config/makefiles/ncigen.in Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/compilers/ncigen/config/makefiles/ncigen.in Sun Feb 7 06:12:55 2010 (r43745)
@@ -16,7 +16,6 @@
CP = @cp@
PARROT = ../../parrot at exe@
CAT = @cat@
-BUILD_DYNPMC = $(PERL) $(BUILD_DIR)/tools/build/dynpmc.pl
RECONFIGURE = $(PERL) $(BUILD_DIR)/tools/dev/reconfigure.pl
## places to look for things
@@ -30,15 +29,12 @@
all: ncigen.pbc
-C_GROUP = $(PMC_DIR)/c_group$(LOAD_EXT)
-
SOURCES = ncigen.pir \
src/gen_grammar.pir \
src/gen_actions.pir \
src/gen_builtins.pir \
src/NCIGENAST.pir \
- src/NCIPIR.pir \
-# $(C_GROUP)
+ src/NCIPIR.pir
BUILTINS_PIR = \
src/builtins/say.pir \
@@ -62,12 +58,6 @@
src/gen_builtins.pir: $(BUILTINS_PIR)
$(CAT) $(BUILTINS_PIR) >src/gen_builtins.pir
-$(C_GROUP): $(PARROT) $(PMC_SOURCES)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) generate $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) compile $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) linklibs $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) copy --destination=$(PARROT_DYNEXT) $(PMCS)
-
# This is a listing of all targets, that are meant to be called by users
help:
@echo ""
Modified: branches/gc_encapsulate/config/auto/icu.pm
==============================================================================
--- branches/gc_encapsulate/config/auto/icu.pm Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/config/auto/icu.pm Sun Feb 7 06:12:55 2010 (r43745)
@@ -322,6 +322,11 @@
$without = 1;
}
}
+
+ # on MacOS X there's sometimes an errornous \c at the end of the
+ # output line. Remove it.
+ $icushared =~ s/\s\\c$//;
+
return ($icushared, $without);
}
Modified: branches/gc_encapsulate/config/gen/makefiles/root.in
==============================================================================
--- branches/gc_encapsulate/config/gen/makefiles/root.in Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/config/gen/makefiles/root.in Sun Feb 7 06:12:55 2010 (r43745)
@@ -574,14 +574,14 @@
# arguments (etc) injected in the middle.
# There is probably a better way to do this, but I can't work it out right now.
.c$(O) : # suffix rule (limited support)
- @$(PERL) tools/dev/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
+ @$(PERL) tools/build/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
# XXX probably should detect assembler, but right now this is only used on Sparc
.s$(O) : # suffix rule (limited support)
- @$(PERL) tools/dev/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
+ @$(PERL) tools/build/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
#UNLESS(win32).S$(O) : # suffix rule (limited support)
-#UNLESS(win32) @$(PERL) tools/dev/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
+#UNLESS(win32) @$(PERL) tools/build/cc_flags.pl ./CFLAGS $(CC) "" $(CFLAGS) -I$(@D) @cc_o_out@$@ -c $<
.pir.pbc : # suffix rule (limited support)
$(PARROT) -o $@ $<
@@ -796,14 +796,14 @@
world : all parrot_utils
-parrot_utils : $(PDUMP) $(DIS) $(PDB) $(PBC_MERGE) $(PBC_TO_EXE) $(PARROT_CONFIG)
+parrot_utils : $(PDUMP) $(DIS) $(PDB) $(PBC_MERGE) $(PBC_TO_EXE) $(PARROT_CONFIG) src/install_config$(O)
installable: all $(INSTALLABLEPARROT) $(INSTALLABLEPDUMP) $(INSTALLABLEDIS) $(INSTALLABLEPDB) $(INSTALLABLEPBC_MERGE) $(INSTALLABLEPBCTOEXE) $(INSTALLABLECONFIG) $(INSTALLABLENQP)
flags_dummy :
@echo "Compiling with:"
- @$(PERL) tools/dev/cc_flags.pl ./CFLAGS echo $(CC) $(CFLAGS) -I$(@D) @cc_o_out@ xx$(O) -c xx.c
+ @$(PERL) tools/build/cc_flags.pl ./CFLAGS echo $(CC) $(CFLAGS) -I$(@D) @cc_o_out@ xx$(O) -c xx.c
runtime/parrot/include/parrotlib.pbc: runtime/parrot/library/parrotlib.pir $(PARROT) $(GEN_PASM_INCLUDES)
$(PARROT) -o $@ runtime/parrot/library/parrotlib.pir
Modified: branches/gc_encapsulate/config/init/hints.pm
==============================================================================
--- branches/gc_encapsulate/config/init/hints.pm Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/config/init/hints.pm Sun Feb 7 06:12:55 2010 (r43745)
@@ -35,12 +35,16 @@
print "\n[ " if $verbose;
my $hints_used = 0;
+ my $hints_file;
my $osname = lc( $conf->data->get('OSNAME_provisional') );
$osname = 'linux' if ($osname eq 'gnukfreebsd');
- my $hints_file = catfile('config', 'init', 'hints', "$osname.pm");
+
+ my $hints_file_name = $conf->options->get('hintsfile') || $osname ;
+ $hints_file = catfile('config', 'init', 'hints', "$hints_file_name.pm");
+
if ( -f $hints_file ) {
- my $hints_pkg = "init::hints::" . $osname;
+ my $hints_pkg = "init::hints::" . $hints_file_name;
print "$hints_pkg " if $verbose;
Modified: branches/gc_encapsulate/docs/compiler_faq.pod
==============================================================================
--- branches/gc_encapsulate/docs/compiler_faq.pod Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/docs/compiler_faq.pod Sun Feb 7 06:12:55 2010 (r43745)
@@ -669,22 +669,8 @@
to extend Parrot with additional types. For more information about writing
PMCs, see L<tools/build/pmc2c.pl> and L<docs/pmc.pod>.
-To build dynamic PMCs, add something like the following to your Makefile:
-
- PERL = /usr/bin/perl
- PMCBUILD = $(PERL) /path/to/parrot/tools/build/dynpmc.pl
- DESTDIR = /path/to/parrot/runtime/parrot/dynext
- LOAD_EXT = .so
-
- PMCDIR = pmc
- PMCS = MyInteger MyFloat MyString MyObject
- PMC_FILES = MyInteger.pmc MyFloat.pmc MyString.pmc MyObject.pmc
-
- dynpmcs : $(PMC_FILES)
- @cd $(PMCDIR) && $(PMCBUILD) generate $(PMCS)
- @cd $(PMCDIR) && $(PMCBUILD) compile $(PMCS)
- @cd $(PMCDIR) && $(PMCBUILD) linklibs $(PMCS)
- @cd $(PMCDIR) && $(PMCBUILD) copy "--destination=$(DESTDIR)" $(PMCS)
+See L<src/dynpmc/Makefile> for an example of how to build your dynamic
+PMCS.
=head2 How do I add another op to Parrot?
Modified: branches/gc_encapsulate/include/parrot/pmc_freeze.h
==============================================================================
--- branches/gc_encapsulate/include/parrot/pmc_freeze.h Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/include/parrot/pmc_freeze.h Sun Feb 7 06:12:55 2010 (r43745)
@@ -14,7 +14,7 @@
#define PARROT_PMC_FREEZE_H_GUARD
struct _visit_info;
-typedef void (*visit_f)(PARROT_INTERP, ARGIN_NULLOK(PMC*), ARGIN(struct _visit_info*));
+typedef void (*visit_f)(PARROT_INTERP, ARGIN_NULLOK(PMC*), ARGIN(PMC*));
typedef enum {
VISIT_HOW_PMC_TO_VISITOR = 0x00, /* push to visitor */
@@ -40,53 +40,11 @@
#define VISIT_THAW_NORMAL (VISIT_HOW_VISITOR_TO_PMC | VISIT_WHAT_PMC)
#define VISIT_THAW_CONSTANTS VISIT_THAW_NORMAL
-struct _visit_info;
-typedef INTVAL (*get_integer_f) (PARROT_INTERP, struct _visit_info*);
-typedef void (*push_integer_f) (PARROT_INTERP, struct _visit_info*, INTVAL);
-typedef void (*push_string_f) (PARROT_INTERP, struct _visit_info*, STRING*);
-typedef void (*push_number_f) (PARROT_INTERP, struct _visit_info*, FLOATVAL);
-typedef void (*push_pmc_f) (PARROT_INTERP, struct _visit_info*, PMC*);
-typedef INTVAL (*shift_integer_f) (PARROT_INTERP, struct _visit_info*);
-typedef STRING* (*shift_string_f) (PARROT_INTERP, struct _visit_info*);
-typedef FLOATVAL (*shift_number_f) (PARROT_INTERP, struct _visit_info*);
-typedef PMC* (*shift_pmc_f) (PARROT_INTERP, struct _visit_info*);
-
-typedef struct _image_funcs {
- get_integer_f get_integer;
- push_integer_f push_integer;
- push_string_f push_string;
- push_number_f push_float;
- push_pmc_f push_pmc;
- shift_integer_f shift_integer;
- shift_string_f shift_string;
- shift_number_f shift_float;
- shift_pmc_f shift_pmc;
-} image_funcs;
-
typedef enum {
EXTRA_IS_NULL,
EXTRA_IS_PROP_HASH,
} extra_flags_enum;
-typedef struct _visit_info {
- visit_f visit_pmc_now;
- size_t pos; /* current read/write position in buffer */
- Buffer *buffer;
- size_t input_length; /* */
- INTVAL what;
- PMC **thaw_ptr; /* where to thaw a new PMC */
- PMC *seen; /* seen hash */
- PMC *todo; /* todo list */
- PMC *id_list; /* seen list used by thaw */
- UINTVAL id; /* freze ID of PMC */
- INTVAL extra_flags; /* concerning to extra */
- struct PackFile *pf;
- const image_funcs *vtable;
- struct _visit_info *image_io; /* dummy backwards-compat pointer. */
-} visit_info;
-
-#define IMAGE_IO visit_info
-
#define VISIT_PMC(interp, visit, pmc) do {\
const INTVAL _visit_pmc_flags = VTABLE_get_integer((interp), (visit)); \
if (_visit_pmc_flags & VISIT_WHAT_PMC) { \
Modified: branches/gc_encapsulate/lib/Parrot/Configure/Options/Conf/Shared.pm
==============================================================================
--- branches/gc_encapsulate/lib/Parrot/Configure/Options/Conf/Shared.pm Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/lib/Parrot/Configure/Options/Conf/Shared.pm Sun Feb 7 06:12:55 2010 (r43745)
@@ -30,6 +30,7 @@
fatal-step
floatval
help
+ hintsfile
icu-config
icuheaders
icushared
Modified: branches/gc_encapsulate/lib/Parrot/Docs/Section/Tools.pm
==============================================================================
--- branches/gc_encapsulate/lib/Parrot/Docs/Section/Tools.pm Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/lib/Parrot/Docs/Section/Tools.pm Sun Feb 7 06:12:55 2010 (r43745)
@@ -45,7 +45,7 @@
'Configuration',
'',
$self->new_item( '', 'tools/dev/as2c.pl' ),
- $self->new_item( '', 'tools/dev/cc_flags.pl' ),
+ $self->new_item( '', 'tools/build/cc_flags.pl' ),
$self->new_item( '', 'tools/build/nativecall.pl' ),
$self->new_item( '', 'tools/build/vtable_h.pl' ),
$self->new_item( '', 'tools/build/vtable_extend.pl' ),
@@ -55,7 +55,6 @@
'',
$self->new_item( '', 'docs/configuration.pod' ),
$self->new_item( '', 'tools/build/c2str.pl' ),
- $self->new_item( '', 'tools/build/dynpmc.pl' ),
$self->new_item( '', 'tools/build/ops2c.pl' ),
$self->new_item( '', 'tools/build/ops2pm.pl' ),
$self->new_item( '', 'tools/build/parrot_config_c.pl' ),
Modified: branches/gc_encapsulate/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/gc_encapsulate/lib/Parrot/Pmc2c/PMCEmitter.pm Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/lib/Parrot/Pmc2c/PMCEmitter.pm Sun Feb 7 06:12:55 2010 (r43745)
@@ -97,6 +97,7 @@
$c->emit( $self->get_vtable_func );
$c->emit( $self->get_mro_func );
$c->emit( $self->get_isa_func );
+ $c->emit( $self->pmc_class_init_func );
$c->emit( $self->init_func );
$c->emit( $self->postamble );
@@ -474,6 +475,34 @@
return $cache->{$name} = "mfl_$count";
}
+=item C<pmc_class_init_func()>
+
+Returns the C code for the PMC's class_init function as a static
+function to be called from the exported class_init.
+
+=cut
+
+sub pmc_class_init_func {
+ my ($self) = @_;
+ my $class_init_code = "";
+
+ if ($self->has_method('class_init')) {
+ $class_init_code .= $self->get_method('class_init')->body;
+
+ $class_init_code =~ s/INTERP/interp/g;
+
+ # fix indenting
+ $class_init_code =~ s/^/ /mg;
+ $class_init_code = <<ENDOFCODE
+static void thispmc_class_init(PARROT_INTERP, int entry)
+{
+$class_init_code
+}
+ENDOFCODE
+ }
+ return $class_init_code;
+}
+
=item C<init_func()>
Returns the C code for the PMC's initialization method, or an empty
@@ -528,12 +557,7 @@
my $class_init_code = "";
if ($self->has_method('class_init')) {
- $class_init_code = $self->get_method('class_init')->body;
-
- $class_init_code =~ s/INTERP/interp/g;
-
- # fix indenting
- $class_init_code =~ s/^/ /mg;
+ $class_init_code .= " thispmc_class_init(interp, entry);\n";
}
my %extra_vt;
@@ -703,10 +727,10 @@
# include any class specific init code from the .pmc file
if ($class_init_code) {
$cout .= <<"EOC";
+
/* class_init */
- {
$class_init_code
- }
+
EOC
}
Modified: branches/gc_encapsulate/runtime/parrot/library/distutils.pir
==============================================================================
--- branches/gc_encapsulate/runtime/parrot/library/distutils.pir Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/runtime/parrot/library/distutils.pir Sun Feb 7 06:12:55 2010 (r43745)
@@ -1759,6 +1759,8 @@
If t/harness exists, run : t/harness
+If parrot-tapir exists, run it with t/*.t
+
Else run : prove t/*.t
=cut
@@ -1770,6 +1772,11 @@
unless $I0 goto L1
.tailcall _test_harness(kv :flat :named)
L1:
+ $S0 = get_executable('parrot-tapir')
+ $I0 = file_exists($S0)
+ unless $I0 goto L2
+ .tailcall _test_tapir($S0, kv :flat :named)
+ L2:
.tailcall _test_prove(kv :flat :named)
.end
@@ -1820,11 +1827,48 @@
.param pmc kv :slurpy :named
.local string cmd
cmd = "prove"
- $S0 = get_executable('parrot-tapir')
- $I0 = file_exists($S0)
- unless $I0 goto L0
- cmd = $S0
- L0:
+ $I0 = exists kv['prove_exec']
+ unless $I0 goto L1
+ $S0 = get_prove_version()
+ $S0 = substr $S0, 0, 1
+ unless $S0 == "3" goto L3
+ cmd .= " --exec="
+ goto L4
+ L3:
+ cmd .= " --perl="
+ L4:
+ $S0 = kv['prove_exec']
+ $I0 = index $S0, ' '
+ if $I0 < 0 goto L2
+ cmd .= "\""
+ L2:
+ cmd .= $S0
+ if $I0 < 0 goto L1
+ cmd .= "\""
+ L1:
+ cmd .= " "
+ $S0 = get_value('prove_files', "t/*.t" :named('default'), kv :flat :named)
+ cmd .= $S0
+ system(cmd, 1 :named('verbose'))
+.end
+
+.sub 'get_prove_version' :anon
+ $P0 = open 'prove --version', 'rp'
+ $S0 = $P0.'readline'()
+ $P0.'close'()
+ $I1 = index $S0, "Test::Harness v"
+ $I1 += 15
+ $I2 = index $S0, " ", $I1
+ $I3 = $I2 - $I1
+ $S0 = substr $S0, $I1, $I3
+ .return ($S0)
+.end
+
+.sub '_test_tapir' :anon
+ .param string tapir
+ .param pmc kv :slurpy :named
+ .local string cmd
+ cmd = tapir
$I0 = exists kv['prove_exec']
unless $I0 goto L1
cmd .= " --exec="
@@ -1854,7 +1898,12 @@
run_step('build', kv :flat :named)
$I0 = file_exists('t/harness')
if $I0 goto L1
+ $S0 = get_prove_version()
+ $S0 = substr $S0, 0, 1
+ unless $S0 == "3" goto L2
.tailcall _smoke_prove(kv :flat :named)
+ L2:
+ die "Require Test::Harness v3.x (option --archive)."
L1:
die "Don't known how to smoke with t/harness."
.end
Modified: branches/gc_encapsulate/src/gc/gc_ms.c
==============================================================================
--- branches/gc_encapsulate/src/gc/gc_ms.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/gc/gc_ms.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -818,9 +818,9 @@
{
ASSERT_ARGS(gc_ms_more_traceable_objects)
- if (pool->skip)
- pool->skip = 0;
- else {
+ if (pool->skip == GC_ONE_SKIP)
+ pool->skip = GC_NO_SKIP;
+ else if (pool->skip == GC_NO_SKIP) {
Fixed_Size_Arena * const arena = pool->last_Arena;
if (arena
&& arena->used == arena->total_objects)
Modified: branches/gc_encapsulate/src/gc/gc_private.h
==============================================================================
--- branches/gc_encapsulate/src/gc/gc_private.h Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/gc/gc_private.h Sun Feb 7 06:12:55 2010 (r43745)
@@ -87,6 +87,13 @@
INF /*infinite memory core*/
} gc_sys_type_enum;
+/* how often to skip a full GC when this pool has nothing free */
+typedef enum _gc_skip_type_enum {
+ GC_NO_SKIP = 0,
+ GC_ONE_SKIP,
+ GC_ALWAYS_SKIP
+} gc_skip_type_enum;
+
typedef struct GC_Subsystem {
/* Which GC subsystem are we using? See PARROT_GC_DEFAULT_TYPE in
* include/parrot/settings.h for possible values */
Modified: branches/gc_encapsulate/src/gc/mark_sweep.c
==============================================================================
--- branches/gc_encapsulate/src/gc/mark_sweep.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/gc/mark_sweep.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -891,6 +891,7 @@
/* Init the constant string header pool */
mem_pools->constant_string_header_pool = new_string_pool(interp, mem_pools, 1);
mem_pools->constant_string_header_pool->name = "constant_string_header";
+ mem_pools->constant_string_header_pool->skip = GC_ALWAYS_SKIP;
/* Init the buffer header pool
*
@@ -909,6 +910,7 @@
/* constant PMCs */
mem_pools->constant_pmc_pool = new_pmc_pool(interp, mem_pools);
mem_pools->constant_pmc_pool->name = "constant_pmc";
+ mem_pools->constant_pmc_pool->skip = GC_ALWAYS_SKIP;
mem_pools->constant_pmc_pool->objects_per_alloc =
CONSTANT_PMC_HEADERS_PER_ALLOC;
}
Modified: branches/gc_encapsulate/src/hash.c
==============================================================================
--- branches/gc_encapsulate/src/hash.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/hash.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -55,7 +55,7 @@
static void hash_freeze(PARROT_INTERP,
ARGIN(const Hash * const hash),
- ARGMOD(visit_info *info))
+ ARGMOD(PMC *info))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -63,7 +63,7 @@
static void hash_thaw(PARROT_INTERP,
ARGMOD(Hash *hash),
- ARGMOD(visit_info *info))
+ ARGMOD(PMC *info))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -541,7 +541,7 @@
/*
-=item C<static void hash_thaw(PARROT_INTERP, Hash *hash, visit_info *info)>
+=item C<static void hash_thaw(PARROT_INTERP, Hash *hash, PMC *info)>
Visits the contents of a hash during freeze/thaw.
@@ -552,7 +552,7 @@
*/
static void
-hash_thaw(PARROT_INTERP, ARGMOD(Hash *hash), ARGMOD(visit_info *info))
+hash_thaw(PARROT_INTERP, ARGMOD(Hash *hash), ARGMOD(PMC *info))
{
ASSERT_ARGS(hash_thaw)
@@ -608,8 +608,8 @@
/*
-=item C<static void hash_freeze(PARROT_INTERP, const Hash * const hash,
-visit_info *info)>
+=item C<static void hash_freeze(PARROT_INTERP, const Hash * const hash, PMC
+*info)>
Freezes hash into a string.
@@ -623,7 +623,7 @@
*/
static void
-hash_freeze(PARROT_INTERP, ARGIN(const Hash * const hash), ARGMOD(visit_info *info))
+hash_freeze(PARROT_INTERP, ARGIN(const Hash * const hash), ARGMOD(PMC *info))
{
ASSERT_ARGS(hash_freeze)
size_t i;
@@ -677,7 +677,7 @@
parrot_hash_visit(PARROT_INTERP, ARGMOD(Hash *hash), ARGMOD(void *pinfo))
{
ASSERT_ARGS(parrot_hash_visit)
- visit_info* const info = (visit_info*) pinfo;
+ PMC* const info = (PMC*) pinfo;
switch (VTABLE_get_integer(interp, info)) {
case VISIT_THAW_NORMAL:
Modified: branches/gc_encapsulate/src/packdump.c
==============================================================================
--- branches/gc_encapsulate/src/packdump.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/packdump.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -138,7 +138,7 @@
INTVAL idx = 0;
int printed_flag_p = 0;
- Parrot_io_printf(interp, "\tFLAGS => 0x%04lx (", flags);
+ Parrot_io_printf(interp, "\t\tFLAGS => 0x%04lx (", flags);
while (flags) {
if (flags & 1) {
if (printed_flag_p)
@@ -284,9 +284,9 @@
const int n = VTABLE_get_integer(interp, pmc);
STRING* const out_buffer = VTABLE_get_repr(interp, pmc);
Parrot_io_printf(interp,
- "\tclass => %Ss,\n"
- "\telement count => %d,\n"
- "\telements => %Ss,\n",
+ "\t\tclass => %Ss,\n"
+ "\t\telement count => %d,\n"
+ "\t\telements => %Ss,\n",
pmc->vtable->whoami,
n,
out_buffer);
@@ -318,15 +318,15 @@
namespace_description = null;
}
Parrot_io_printf(interp,
- "\tclass => %Ss,\n"
- "\tstart_offs => %d,\n"
- "\tend_offs => %d,\n"
- "\tname => '%Ss',\n"
- "\tsubid => '%Ss',\n"
- "\tmethod => '%Ss',\n"
- "\tnsentry => '%Ss',\n"
- "\tnamespace => %Ss\n"
- "\tHLL_id => %d,\n",
+ "\t\tclass => %Ss,\n"
+ "\t\tstart_offs => %d,\n"
+ "\t\tend_offs => %d,\n"
+ "\t\tname => '%Ss',\n"
+ "\t\tsubid => '%Ss',\n"
+ "\t\tmethod => '%Ss',\n"
+ "\t\tnsentry => '%Ss',\n"
+ "\t\tnamespace => %Ss\n"
+ "\t\tHLL_id => %d,\n",
pmc->vtable->whoami,
sub->start_offs,
sub->end_offs,
@@ -339,15 +339,15 @@
break;
case enum_class_FixedIntegerArray:
Parrot_io_printf(interp,
- "\tclass => %Ss,\n"
- "\trepr => '%Ss'\n",
+ "\t\tclass => %Ss,\n"
+ "\t\trepr => '%Ss'\n",
pmc->vtable->whoami,
VTABLE_get_repr(interp, pmc));
break;
default:
- Parrot_io_printf(interp, "\tno dump info for PMC %ld %Ss\n",
+ Parrot_io_printf(interp, "\t\tno dump info for PMC %ld %Ss\n",
pmc->vtable->base_type, pmc->vtable->whoami);
- Parrot_io_printf(interp, "\tclass => %Ss,\n", pmc->vtable->whoami);
+ Parrot_io_printf(interp, "\t\tclass => %Ss,\n", pmc->vtable->whoami);
}
}
Parrot_io_printf(interp, " } ],\n");
Modified: branches/gc_encapsulate/src/pbc_merge.c
==============================================================================
--- branches/gc_encapsulate/src/pbc_merge.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pbc_merge.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -45,12 +45,14 @@
/* This struct describes an input file. */
typedef struct pbc_merge_input {
- const char *filename; /* Filename of the input file. */
- PackFile *pf; /* The loaded packfile. */
- opcode_t code_start; /* Where the bytecode is located in the merged
- bytecode. */
- opcode_t const_start; /* Where the const table is located in the merged
- one. */
+ const char *filename; /* name of the input file */
+ PackFile *pf; /* loaded packfile struct */
+ opcode_t code_start; /* where the bytecode is located in the merged
+ packfile */
+ opcode_t const_start;/* where the const table is located within the
+ merged table */
+ opcode_t *const_map; /* map constants from input files to their location
+ in the output file */
} pbc_merge_input;
/* HEADERIZER HFILE: none */
@@ -268,12 +270,6 @@
program_code =
(char *)mem_sys_realloc(program_code, program_size + chunk_size);
- if (!program_code) {
- Parrot_io_eprintf(interp,
- "PBC Merge: Could not reallocate buffer");
- Parrot_exit(interp, 1);
- }
-
cursor = (char *)program_code + program_size;
}
@@ -318,15 +314,17 @@
{
ASSERT_ARGS(pbc_merge_bytecode)
int i;
- opcode_t *bc = mem_allocate_typed(opcode_t);
+ opcode_t *bc = mem_allocate_typed(opcode_t);
opcode_t cursor = 0;
/* Add a bytecode segment. */
PackFile_ByteCode * const bc_seg =
(PackFile_ByteCode *)PackFile_Segment_new_seg(interp,
&pf->directory, PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, 1);
- if (bc_seg == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Error creating bytecode segment.");
+
+ if (!bc_seg) {
+ Parrot_io_eprintf(interp,
+ "PBC Merge: Error creating bytecode segment.");
Parrot_exit(interp, 1);
}
@@ -343,10 +341,6 @@
/* Re-allocate the current buffer. */
mem_realloc_n_typed(bc, cursor + in_seg->base.size, opcode_t);
- if (bc == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Cannot reallocate memory\n");
- Parrot_exit(interp, 1);
- }
/* Copy data and store cursor. */
memcpy(bc + cursor, in_seg->base.data,
@@ -380,16 +374,22 @@
PARROT_CANNOT_RETURN_NULL
static PackFile_ConstTable*
pbc_merge_constants(PARROT_INTERP, ARGMOD(pbc_merge_input **inputs),
- int num_inputs, ARGMOD(PackFile *pf), ARGMOD(PackFile_ByteCode *bc))
+ int num_inputs, ARGMOD(PackFile *pf),
+ ARGMOD(PackFile_ByteCode *bc))
{
ASSERT_ARGS(pbc_merge_constants)
- int i, j;
PackFile_Constant **constants = mem_allocate_typed(PackFile_Constant *);
- opcode_t cursor = 0;
+
+ opcode_t cursor = 0;
+ opcode_t output_const_num = 0;
+ opcode_t input_const_num = 0;
+ int i, j;
/* Add a constant table segment. */
- PackFile_ConstTable * const const_seg = (PackFile_ConstTable*)PackFile_Segment_new_seg(
- interp, &pf->directory, PF_CONST_SEG, CONSTANT_SEGMENT_NAME, 1);
+ PackFile_ConstTable * const const_seg = (PackFile_ConstTable *)
+ PackFile_Segment_new_seg(interp, &pf->directory,
+ PF_CONST_SEG, CONSTANT_SEGMENT_NAME, 1);
+
if (const_seg == NULL) {
Parrot_io_eprintf(interp,
"PBC Merge: Error creating constant table segment.");
@@ -398,6 +398,7 @@
/* Loop over input files. */
for (i = 0; i < num_inputs; i++) {
+
/* Get the constant table segment from the input file. */
PackFile_ConstTable * const in_seg = inputs[i]->pf->cur_cs->const_table;
if (in_seg == NULL) {
@@ -409,28 +410,18 @@
/* Store cursor as position where constant table starts. */
inputs[i]->const_start = cursor;
+ input_const_num = 0;
/* Allocate space for the constant list, provided we have some. */
- if (in_seg->const_count > 0) {
+ if (in_seg->const_count > 0)
constants = (PackFile_Constant **)mem_sys_realloc(constants,
(cursor + in_seg->const_count) * sizeof (Parrot_Pointer));
- if (constants == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Out of memory");
- Parrot_exit(interp, 1);
- }
- }
/* Loop over the constants and copy them to the output PBC. */
for (j = 0; j < in_seg->const_count; j++) {
/* Get the entry and allocate space for copy. */
PackFile_Constant *cur_entry = in_seg->constants[j];
- PackFile_Constant *copy = mem_allocate_typed(
- PackFile_Constant);
- if (copy == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Out of memory");
- Parrot_exit(interp, 1);
- }
-
+ PackFile_Constant *copy = mem_allocate_typed(PackFile_Constant);
STRUCT_COPY(copy, cur_entry);
/* If it's a sub PMC, need to deal with offsets. */
@@ -450,6 +441,10 @@
}
}
+ inputs[i]->const_map[input_const_num] = output_const_num;
+ input_const_num++;
+ output_const_num++;
+
/* Slot it into the list. */
constants[cursor] = copy;
cursor++;
@@ -481,10 +476,10 @@
int num_inputs, ARGMOD(PackFile *pf), ARGMOD(PackFile_ByteCode *bc))
{
ASSERT_ARGS(pbc_merge_fixups)
- int i, j;
- PackFile_FixupTable *fixup_seg;
+ PackFile_FixupTable *fixup_seg;
PackFile_FixupEntry **fixups = mem_allocate_typed(PackFile_FixupEntry *);
- opcode_t cursor = 0;
+ opcode_t cursor = 0;
+ int i, j;
/* Add a fixup table segment. */
fixup_seg = (PackFile_FixupTable*)PackFile_Segment_new_seg(
@@ -510,10 +505,6 @@
if (in_seg->fixup_count > 0) {
fixups = (PackFile_FixupEntry **)mem_sys_realloc(fixups,
(cursor + in_seg->fixup_count) * sizeof (Parrot_Pointer));
- if (fixups == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Out of memory");
- Parrot_exit(interp, 1);
- }
}
/* Loop over the fixups and copy them to the output PBC, correcting
@@ -525,10 +516,6 @@
PackFile_FixupEntry);
char *name_copy = (char *)mem_sys_allocate(
strlen(cur_entry->name) + 1);
- if (copy == NULL || name_copy == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Out of memory");
- Parrot_exit(interp, 1);
- }
/* Copy type and name. */
copy->type = cur_entry->type;
@@ -576,14 +563,16 @@
int num_inputs, ARGMOD(PackFile *pf), ARGMOD(PackFile_ByteCode *bc))
{
ASSERT_ARGS(pbc_merge_debugs)
- int i, j;
- PackFile_Debug *debug_seg;
- opcode_t *lines = mem_allocate_typed(opcode_t);
+ PackFile_Debug *debug_seg;
+ opcode_t *lines = mem_allocate_typed(opcode_t);
PackFile_DebugFilenameMapping **mappings =
mem_allocate_typed(PackFile_DebugFilenameMapping *);
+
opcode_t num_mappings = 0;
opcode_t num_lines = 0;
+ int i, j;
+
/* We need to merge both the mappings and the list of line numbers.
The line numbers can just be concatenated. The mappings must have
their offsets fixed up. */
@@ -593,10 +582,7 @@
/* Concatenate line numbers. */
lines = (opcode_t *)mem_sys_realloc(lines,
(num_lines + in_seg->base.size) * sizeof (opcode_t));
- if (lines == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Cannot reallocate memory\n");
- Parrot_exit(interp, 1);
- }
+
memcpy(lines + num_lines, in_seg->base.data,
in_seg->base.size * sizeof (opcode_t));
@@ -608,7 +594,7 @@
PackFile_DebugFilenameMapping *mapping = mem_allocate_typed(
PackFile_DebugFilenameMapping);
STRUCT_COPY(mapping, in_seg->mappings[j]);
- mapping->offset += num_lines;
+ mapping->offset += num_lines;
mapping->filename += inputs[i]->const_start;
mappings[num_mappings + j] = mapping;
}
@@ -676,7 +662,7 @@
case PARROT_ARG_PC:
case PARROT_ARG_SC:
case PARROT_ARG_KC:
- ops[cur_op] += inputs[cur_input]->const_start;
+ ops[cur_op] = inputs[cur_input]->const_map[ ops[cur_op] ];
break;
default:
break;
@@ -702,7 +688,7 @@
case PARROT_ARG_PC:
case PARROT_ARG_SC:
case PARROT_ARG_KC:
- ops[cur_op] += inputs[cur_input]->const_start;
+ ops[cur_op] = inputs[cur_input]->const_map[ ops[cur_op] ];
break;
default:
break;
@@ -732,6 +718,8 @@
ASSERT_ARGS(pbc_merge_begin)
PackFile_ByteCode *bc;
PackFile_ConstTable *ct;
+ opcode_t const_count = 0;
+ int i;
/* Create a new empty packfile. */
PackFile * const merged = PackFile_new(interp, 0);
@@ -740,6 +728,19 @@
Parrot_exit(interp, 1);
}
+ /* calculate how many constants are stored in the packfiles to be merged */
+ for (i = 0; i < num_inputs; i++) {
+ PackFile_Directory *pf_dir = &inputs[i]->pf->directory;
+ unsigned int j = 0;
+ for (j = 0; j < pf_dir->num_segments; j++) {
+ PackFile_Segment *seg = (PackFile_Segment *)pf_dir->segments[j];
+ if (seg->type == PF_CONST_SEG) {
+ opcode_t const_count = ((PackFile_ConstTable *)seg)->const_count;
+ inputs[i]->const_map = mem_allocate_n_typed(const_count, opcode_t);
+ }
+ }
+ }
+
/* Merge the various stuff. */
bc = pbc_merge_bytecode(interp, inputs, num_inputs, merged);
ct = pbc_merge_constants(interp, inputs, num_inputs, merged, bc);
@@ -751,6 +752,10 @@
/* Walk bytecode and fix ops that reference the constants table. */
pbc_merge_ctpointers(interp, inputs, num_inputs, bc);
+ for (i = 0; i < num_inputs; i++) {
+ mem_sys_free(inputs[i]->const_map);
+ }
+
/* Return merged result. */
return merged;
}
@@ -778,10 +783,6 @@
/* Allocate memory. */
opcode_t * const pack = (opcode_t*) mem_sys_allocate(size);
- if (pack == NULL) {
- Parrot_io_eprintf(interp, "PBC Merge: Out of memory");
- Parrot_exit(interp, 1);
- }
/* Write and clean up. */
PackFile_pack(interp, pf, pack);
Modified: branches/gc_encapsulate/src/pmc/class.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/class.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/class.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -1421,7 +1421,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the class.
@@ -1431,7 +1431,7 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
/* 1) visit the attribute description hash */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, attrib_metadata);
@@ -1453,7 +1453,7 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the class.
@@ -1461,7 +1461,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
Parrot_Class_attributes * const class_data = PARROT_CLASS(SELF);
STRING *serial_namespace = CONST_STRING(interp, "");
@@ -1483,7 +1483,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the class.
@@ -1491,7 +1491,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
/* The class might already exist in the interpreter, so create it as an
* anonymous class and later decide whether to link it into the
* namespace. */
@@ -1549,7 +1549,7 @@
/*
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Called after the class has been thawed.
@@ -1557,7 +1557,7 @@
*/
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
UNUSED(info)
Modified: branches/gc_encapsulate/src/pmc/default.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/default.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/default.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -1043,7 +1043,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
Used by GC to mark the PMC.
@@ -1051,7 +1051,7 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
}
/*
@@ -1070,7 +1070,7 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Does nothing.
@@ -1078,14 +1078,14 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
UNUSED(info)
/* default - no action */
}
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Initializes the PMC during unarchiving.
@@ -1093,14 +1093,14 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
/* default - initialize the PMC */
SELF.init();
}
/*
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Does nothing.
@@ -1108,7 +1108,7 @@
*/
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
UNUSED(info)
/* default - no action */
}
Modified: branches/gc_encapsulate/src/pmc/eval.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/eval.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/eval.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -320,11 +320,11 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Archives the evaled code
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Unarchives the code.
@@ -332,14 +332,14 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
STRING *packed = SELF.get_string();
VTABLE_push_string(INTERP, info, packed);
SUPER(info);
}
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
STRING *packed = VTABLE_shift_string(INTERP, info);
PackFile *pf;
PackFile_Segment *seg;
Modified: branches/gc_encapsulate/src/pmc/fixedbooleanarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/fixedbooleanarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/fixedbooleanarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -506,14 +506,14 @@
=over 4
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the string.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
UINTVAL size, resize_threshold;
unsigned char * bit_array;
STRING * s;
@@ -530,14 +530,14 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the string.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
{
Modified: branches/gc_encapsulate/src/pmc/fixedintegerarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/fixedintegerarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/fixedintegerarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -537,17 +537,17 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the array.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the array.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the array.
@@ -555,11 +555,11 @@
*/
- /*VTABLE void visit(visit_info *info) {
+ /*VTABLE void visit(PMC *info) {
SUPER(info);
}*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
INTVAL *int_array;
INTVAL i, n;
@@ -573,7 +573,7 @@
VTABLE_push_integer(INTERP, info, int_array[i]);
}
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
INTVAL n;
SUPER(info);
Modified: branches/gc_encapsulate/src/pmc/fixedpmcarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/fixedpmcarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/fixedpmcarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -690,17 +690,17 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the array.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the array.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the array.
@@ -708,25 +708,24 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
INTVAL i;
const INTVAL n = VTABLE_elements(INTERP, SELF);
PMC **pos = PMC_array(SELF);
for (i = 0; i < n; ++i, ++pos) {
- info->thaw_ptr = pos;
- (info->visit_pmc_now)(INTERP, *pos, info);
+ VISIT_PMC(INTERP, info, *pos);
}
SUPER(info);
}
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
SUPER(info);
VTABLE_push_integer(INTERP, info, VTABLE_elements(INTERP, SELF));
}
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
SELF.set_integer_native(VTABLE_shift_integer(INTERP, info));
}
Modified: branches/gc_encapsulate/src/pmc/fixedstringarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/fixedstringarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/fixedstringarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -559,14 +559,14 @@
=over 4
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the string.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
STRING **str_array;
UINTVAL size, i;
@@ -580,14 +580,14 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the string.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
UINTVAL i, size;
STRING **str_array;
Modified: branches/gc_encapsulate/src/pmc/float.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/float.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/float.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -344,28 +344,28 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the number.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
SUPER(info);
VTABLE_push_float(INTERP, info, SELF.get_number());
}
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the number.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
SET_ATTR_fv(INTERP, SELF, VTABLE_shift_float(INTERP, info));
}
Modified: branches/gc_encapsulate/src/pmc/hash.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/hash.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/hash.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -1078,7 +1078,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
Used during archiving to visit the elements in the hash.
@@ -1086,14 +1086,14 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
parrot_hash_visit(INTERP, (Hash *)SELF.get_pointer(), info);
SUPER(info);
}
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the hash.
@@ -1101,7 +1101,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
Hash * const hash = (Hash *)SELF.get_pointer();;
SUPER(info);
@@ -1112,7 +1112,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the hash.
@@ -1120,7 +1120,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
{
Added: branches/gc_encapsulate/src/pmc/imageio.pmc
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc_encapsulate/src/pmc/imageio.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -0,0 +1,590 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/imageio.pmc - ImageIO PMC
+
+=head1 DESCRIPTION
+
+Freezes and thaws other PMCs.
+
+*/
+
+#define GROW_TO_16_BYTE_BOUNDARY(size) ((size) + ((size) % 16 ? 16 - (size) % 16 : 0))
+
+/* when thawing a string longer then this size, we first do a GC run and then
+ * block GC - the system can't give us more headers */
+
+#define THAW_BLOCK_GC_SIZE 100000
+
+/* preallocate freeze image for aggregates with this estimation */
+#define FREEZE_BYTES_PER_ITEM 9
+
+/* macros/constants to handle packing/unpacking of PMC IDs and flags
+ * the 2 LSBs are used for flags, all other bits are used for PMC ID
+ */
+#define PackID_new(id, flags) (((UINTVAL)(id) * 4) | ((UINTVAL)(flags) & 3))
+#define PackID_get_PMCID(id) ((UINTVAL)(id) / 4)
+#define PackID_set_PMCID(lv, id) (lv) = PackID_new((id), PackID_get_FLAGS(lv))
+#define PackID_get_FLAGS(id) ((UINTVAL)(id) & 3)
+#define PackID_set_FLAGS(lv, flags) (lv) = PackID_new(PackID_get_PMCID(lv), (flags))
+
+enum {
+ enum_PackID_normal = 0,
+ enum_PackID_seen = 1,
+};
+
+PARROT_INLINE
+static opcode_t *
+GET_VISIT_CURSOR(PMC *pmc){
+ char *buf = (char *)Buffer_bufstart(PARROT_IMAGEIO(pmc)->buffer);
+ size_t pos = PARROT_IMAGEIO(pmc)->pos;
+ return (opcode_t *)(buf + pos);
+}
+
+PARROT_INLINE
+static void
+SET_VISIT_CURSOR(PMC *pmc, char *cursor) {
+ char *bufstart = (char *)Buffer_bufstart(PARROT_IMAGEIO(pmc)->buffer);
+ PARROT_IMAGEIO(pmc)->pos = (cursor - bufstart);
+}
+
+PARROT_INLINE
+static void
+INC_VISIT_CURSOR(PMC *pmc, UINTVAL inc) {
+ PARROT_IMAGEIO(pmc)->pos += inc;
+}
+
+#define BYTECODE_SHIFT_OK(pmc) PARROT_ASSERT( \
+ PARROT_IMAGEIO(pmc)->pos <= PARROT_IMAGEIO(pmc)->input_length)
+
+
+
+static void
+create_buffer(PARROT_INTERP, PMC *pmc, PMC *info)
+{
+ INTVAL len;
+
+ if (!PMC_IS_NULL(pmc)) {
+ STRING *array = CONST_STRING(interp, "array");
+ STRING *hash = CONST_STRING(interp, "hash");
+ INTVAL items = 1;
+
+ if (VTABLE_does(interp, pmc, array) || VTABLE_does(interp, pmc, hash)) {
+ items += VTABLE_elements(interp, pmc);
+ }
+ len = items * FREEZE_BYTES_PER_ITEM;
+ }
+ else
+ len = FREEZE_BYTES_PER_ITEM;
+
+ PARROT_IMAGEIO(info)->buffer =
+ (Buffer *)Parrot_gc_new_bufferlike_header(interp, sizeof (Buffer));
+ Parrot_gc_allocate_buffer_storage_aligned(interp,
+ PARROT_IMAGEIO(info)->buffer, len);
+ SET_VISIT_CURSOR(info, (char *)Buffer_bufstart(PARROT_IMAGEIO(info)->buffer));
+}
+
+
+/*
+static void ensure_buffer_size(PARROT_INTERP, PMC *io, size_t len)
+
+Checks the size of the buffer to see if it can accommodate 'len' more
+bytes. If not, expands the buffer.
+
+*/
+
+PARROT_INLINE
+static void
+ensure_buffer_size(PARROT_INTERP, ARGIN(PMC *io), size_t len)
+{
+ Buffer *buf = PARROT_IMAGEIO(io)->buffer;
+ const size_t used = PARROT_IMAGEIO(io)->pos;
+ const int need_free = Buffer_buflen(buf) - used - len;
+
+ /* grow by factor 1.5 or such */
+ if (need_free <= 16) {
+ size_t new_size = (size_t) (Buffer_buflen(buf) * 1.5);
+ if (new_size < Buffer_buflen(buf) - need_free + 512)
+ new_size = Buffer_buflen(buf) - need_free + 512;
+ Parrot_gc_reallocate_buffer_storage(interp, buf, new_size);
+ PARROT_ASSERT(Buffer_buflen(buf) - used - len >= 15);
+ }
+
+#ifndef DISABLE_GC_DEBUG
+ Parrot_gc_compact_memory_pool(INTERP);
+#endif
+
+}
+
+PARROT_INLINE
+static INTVAL
+INFO_HAS_DATA(ARGIN(PMC *io)) {
+ return PARROT_IMAGEIO(io)->pos < PARROT_IMAGEIO(io)->input_length;
+}
+
+PARROT_INLINE
+static PMC*
+id_list_get(PARROT_INTERP, PMC *io, UINTVAL id) {
+ return VTABLE_get_pmc_keyed_int(interp, PARROT_IMAGEIO(io)->id_list, id);
+}
+
+PARROT_INLINE
+static void
+visit_todo_list_thaw(PARROT_INTERP, SHIM(PMC* pmc_not_used), ARGIN(PMC* info))
+{
+ UINTVAL n = VTABLE_shift_integer(interp, info);
+ UINTVAL id = PackID_get_PMCID(n);
+ int packid_flags = PackID_get_FLAGS(n);
+ PMC *pmc = PMCNULL;
+
+ PARROT_ASSERT(PARROT_IMAGEIO(info)->what == VISIT_THAW_NORMAL);
+
+ switch (packid_flags) {
+ case enum_PackID_seen:
+ if (id) /* got a non-NULL PMC */
+ pmc = id_list_get(interp, info, id);
+ break;
+ case enum_PackID_normal:
+ {
+ INTVAL type = VTABLE_shift_integer(interp, info);
+ if (type <= 0 || type > interp->n_vtable_max)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown PMC type to thaw %d", type);
+
+ pmc = pmc_new_noinit(interp, type);
+ VTABLE_thaw(interp, pmc, info);
+
+ {
+ PMC * const todo = PARROT_IMAGEIO(info)->todo;
+ PMC * const id_list = PARROT_IMAGEIO(info)->id_list;
+ VTABLE_set_pmc_keyed_int(interp, id_list, id, pmc);
+ /* remember nested aggregates depth first */
+ VTABLE_push_pmc(interp, todo, pmc);
+ }
+ }
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown PMC id args thaw %d", packid_flags);
+ break;
+ }
+
+ *(PARROT_IMAGEIO(info)->thaw_ptr) = pmc;
+}
+
+static void
+visit_todo_list_freeze(PARROT_INTERP, PMC* pmc, PMC* info)
+{
+ UINTVAL id;
+ int packid_type;
+
+ PARROT_ASSERT(PARROT_IMAGEIO(info)->what == VISIT_FREEZE_NORMAL);
+
+ if (PMC_IS_NULL(pmc)) {
+ id = 0;
+ packid_type = enum_PackID_seen;
+ }
+ else {
+ Hash *hash = (Hash *)VTABLE_get_pointer(interp, PARROT_IMAGEIO(info)->seen);
+ HashBucket * const b = parrot_hash_get_bucket(interp, hash, pmc);
+ if (b) {
+ id = (UINTVAL) b->value;
+ packid_type = enum_PackID_seen;
+ }
+ else {
+ PARROT_IMAGEIO(info)->id++; /* next id to freeze */
+ id = PARROT_IMAGEIO(info)->id;
+ packid_type = enum_PackID_normal;
+ }
+ }
+
+ VTABLE_push_integer(interp, info, PackID_new(id, packid_type));
+
+ if (packid_type == enum_PackID_normal) {
+ Hash *hash = (Hash *)VTABLE_get_pointer(interp, PARROT_IMAGEIO(info)->seen);
+ PARROT_ASSERT(pmc);
+ VTABLE_push_integer(interp, info,
+ PObj_is_object_TEST(pmc) ? enum_class_Object : pmc->vtable->base_type);
+ parrot_hash_put(interp, hash, pmc, (void *)id);
+ VTABLE_push_pmc(interp, PARROT_IMAGEIO(info)->todo, pmc);
+ VTABLE_freeze(interp, pmc, info);
+ }
+}
+
+static void
+visit_loop_todo_list(PARROT_INTERP, PMC *current, PMC *info)
+{
+ PMC * const todo = PARROT_IMAGEIO(info)->todo;
+ const int thawing = PARROT_IMAGEIO(info)->what == VISIT_THAW_NORMAL;
+
+ (PARROT_IMAGEIO(info)->visit_pmc_now)(interp, current, info);
+
+ /* can't cache upper limit, visit may append items */
+ while (VTABLE_get_bool(interp, todo)) {
+ current = VTABLE_pop_pmc(interp, todo);
+ if (!current)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "NULL current PMC in visit_loop_todo_list");
+
+ PARROT_ASSERT(current->vtable);
+
+ VTABLE_visit(interp, current, info);
+
+ VISIT_PMC(interp, info, PMC_metadata(current));
+ }
+
+ if (thawing)
+ /* we're done reading the image */
+ PARROT_ASSERT(!INFO_HAS_DATA(info));
+
+ if (thawing) {
+ /* on thawing call thawfinish for each processed PMC */
+ const INTVAL n = VTABLE_elements(interp, PARROT_IMAGEIO(info)->id_list);
+ int i;
+
+ /*
+ * Thaw in reverse order. We have to fully thaw younger PMCs
+ * before use them in older.
+ *
+ * XXX There are no younger or older pmcs in a directed graph
+ * that allows cycles. Any code that requires a specific
+ * order here is likely broken.
+ */
+ for (i = n-1; i >= 0; --i) {
+ current = VTABLE_get_pmc_keyed_int(interp, PARROT_IMAGEIO(info)->id_list, i);
+ if (!PMC_IS_NULL(current))
+ VTABLE_thawfinish(interp, current, info);
+ }
+ }
+}
+
+pmclass ImageIO auto_attrs {
+ ATTR visit_f visit_pmc_now;
+ ATTR Buffer *buffer; /* buffer to store the image */
+ ATTR size_t pos; /* current read/write position in buffer */
+ ATTR size_t input_length;
+ ATTR INTVAL what;
+ ATTR PMC **thaw_ptr; /* where to thaw a new PMC */
+ ATTR PMC *seen; /* seen hash */
+ ATTR PMC *todo; /* todo list */
+ ATTR PMC *id_list; /* seen list used by thaw */
+ ATTR UINTVAL id; /* freze ID of PMC */
+ ATTR INTVAL extra_flags; /* concerning to extra */
+ ATTR struct PackFile *pf;
+
+/*
+
+=head1 VTABLES
+
+=over 4
+
+=cut
+
+*/
+
+/*
+
+=item C<void init()>
+
+Initializes the PMC.
+
+=cut
+
+*/
+ VTABLE void init() {
+ PARROT_IMAGEIO(SELF)->thaw_ptr = NULL;
+ PARROT_IMAGEIO(SELF)->buffer = NULL;
+ PARROT_IMAGEIO(SELF)->todo = pmc_new(INTERP, enum_class_ResizablePMCArray);
+ PARROT_IMAGEIO(SELF)->seen = PMCNULL;
+ PARROT_IMAGEIO(SELF)->id_list = PMCNULL;
+ PARROT_IMAGEIO(SELF)->id = 0;
+ PARROT_IMAGEIO(SELF)->extra_flags = EXTRA_IS_NULL;
+ PARROT_IMAGEIO(SELF)->pf = PackFile_new(INTERP, 0);
+
+ PObj_custom_mark_destroy_SETALL(SELF);
+ }
+
+
+/*
+
+=item C<void destroy()>
+
+Destroys the PMC.
+
+=cut
+
+*/
+ VTABLE void destroy() {
+ PackFile_destroy(INTERP, PARROT_IMAGEIO(SELF)->pf);
+ }
+
+/*
+
+=item C<void mark()>
+
+Marks the PMC as alive.
+
+=cut
+
+*/
+ VTABLE void mark() {
+ Parrot_gc_mark_PObj_alive(INTERP, (PObj *)(PARROT_IMAGEIO(SELF)->buffer));
+ Parrot_gc_mark_PMC_alive(INTERP, PARROT_IMAGEIO(SELF)->todo);
+ Parrot_gc_mark_PMC_alive(INTERP, PARROT_IMAGEIO(SELF)->seen);
+ Parrot_gc_mark_PMC_alive(INTERP, PARROT_IMAGEIO(SELF)->id_list);
+ }
+
+/*
+
+=item C<STRING *get_string()>
+
+Returns the content of the image as a string.
+
+=cut
+
+*/
+
+ VTABLE STRING *get_string() {
+ return Parrot_str_new_from_buffer(INTERP,
+ PARROT_IMAGEIO(SELF)->buffer,
+ PARROT_IMAGEIO(SELF)->pos);
+ }
+/*
+
+/*
+
+=item C<VTABLE void set_pointer()>
+
+Sets the location where to thaw a new PMC.
+
+=cut
+
+*/
+
+VTABLE void set_pointer(void* value) {
+ PARROT_IMAGEIO(SELF)->thaw_ptr = (PMC**)value;
+}
+
+/*
+
+=item C<VTABLE INTVAL get_integer()>
+
+Returns the flags describing the visit action
+
+=cut
+
+*/
+
+VTABLE INTVAL get_integer() {
+ return PARROT_IMAGEIO(SELF)->what;
+}
+
+/*
+
+=item C<VTABLE void push_integer(INTVAL v)>
+
+Pushes the integer C<v> onto the end of the image.
+
+=cut
+
+*/
+
+VTABLE void push_integer(INTVAL v) {
+ size_t len = PF_size_integer() * sizeof (opcode_t);
+ ensure_buffer_size(interp, SELF, len);
+ SET_VISIT_CURSOR(SELF, (char *)PF_store_integer(GET_VISIT_CURSOR(SELF), v));
+}
+
+
+/*
+
+=item C<VTABLE void push_float(FLOATVAL v)>
+
+Pushes the float C<v> onto the end of the image.
+
+=cut
+
+*/
+
+VTABLE void push_float(FLOATVAL v)
+{
+ size_t len = PF_size_number() * sizeof (opcode_t);
+ ensure_buffer_size(interp, SELF, len);
+ SET_VISIT_CURSOR(SELF, (char *)PF_store_number(GET_VISIT_CURSOR(SELF), &v));
+}
+
+
+/*
+
+=item C<VTABLE void push_string(STRING *v)>
+
+Pushes the string C<*v> onto the end of the image.
+
+=cut
+
+*/
+
+VTABLE void push_string(STRING *v)
+{
+ size_t len = PF_size_string(v) * sizeof (opcode_t);
+ ensure_buffer_size(INTERP, SELF, len);
+ SET_VISIT_CURSOR(SELF, (char *)PF_store_string(GET_VISIT_CURSOR(SELF), v));
+}
+
+/*
+
+=item C<VTABLE void push_pmc(PMC *v)>
+
+Pushes a reference to pmc C<*v> onto the end of the image. If C<*v>
+hasn't been seen yet, it is also pushed onto the todo list.
+
+=cut
+
+*/
+
+VTABLE void push_pmc(PMC *v) {
+ VTABLE_set_pointer(interp, SELF, &v);
+ (PARROT_IMAGEIO(SELF)->visit_pmc_now)(INTERP, v, SELF);
+}
+
+/*
+
+=item C<VTABLE INTVAL shift_integer()>
+
+Removes and returns an integer from the start of the image.
+
+=cut
+
+*/
+
+VTABLE INTVAL shift_integer()
+{
+ opcode_t *pos = GET_VISIT_CURSOR(SELF);
+ const INTVAL i = PF_fetch_integer(PARROT_IMAGEIO(SELF)->pf, (const opcode_t **)&pos);
+ SET_VISIT_CURSOR(SELF, (char *)pos);
+ BYTECODE_SHIFT_OK(SELF);
+ return i;
+}
+
+
+/*
+
+=item C<VTABLE FLOATVAL shift_float()>
+
+Removes and returns an number from the start of the image.
+
+=cut
+
+*/
+
+VTABLE FLOATVAL shift_float() {
+ opcode_t *pos = GET_VISIT_CURSOR(SELF);
+ const FLOATVAL f = PF_fetch_number(PARROT_IMAGEIO(SELF)->pf, (const opcode_t **)&pos);
+ SET_VISIT_CURSOR(SELF, (char *)pos);
+ BYTECODE_SHIFT_OK(SELF);
+ return f;
+}
+
+
+/*
+
+=item C<VTABLE STRING* shift_string()>
+
+Removes and returns a string from the start of the image.
+
+=cut
+
+*/
+
+VTABLE STRING *shift_string()
+{
+ opcode_t *pos = GET_VISIT_CURSOR(SELF);
+ STRING * const s = PF_fetch_string(interp, PARROT_IMAGEIO(SELF)->pf, (const opcode_t **)&pos);
+ SET_VISIT_CURSOR(SELF, (char *)pos);
+ BYTECODE_SHIFT_OK(SELF);
+ return s;
+}
+
+/*
+
+=item C<static PMC *shift_pmc()>
+
+Removes and returns a reference to a pmc from the start of the image.
+
+=cut
+
+*/
+
+VTABLE PMC *shift_pmc() {
+ PMC *result;
+ VTABLE_set_pointer(interp, SELF, &result);
+ (PARROT_IMAGEIO(SELF)->visit_pmc_now)(interp, NULL, SELF);
+ return result;
+}
+
+VTABLE void set_pmc(PMC *p)
+{
+ UINTVAL header_length = GROW_TO_16_BYTE_BOUNDARY(PACKFILE_HEADER_BYTES);
+
+ PARROT_IMAGEIO(SELF)->what = VISIT_FREEZE_NORMAL;
+ PARROT_IMAGEIO(SELF)->visit_pmc_now = visit_todo_list_freeze;
+ create_buffer(INTERP, p, SELF);
+ ensure_buffer_size(INTERP, SELF, header_length);
+ mem_sys_memcopy(GET_VISIT_CURSOR(SELF),
+ PARROT_IMAGEIO(SELF)->pf->header, PACKFILE_HEADER_BYTES);
+ INC_VISIT_CURSOR(SELF, header_length);
+
+ PARROT_IMAGEIO(SELF)->seen = pmc_new(INTERP, enum_class_Hash);
+ VTABLE_set_pointer(INTERP, PARROT_IMAGEIO(SELF)->seen,
+ parrot_new_intval_hash(INTERP));
+
+ visit_loop_todo_list(INTERP, p, SELF);
+}
+
+VTABLE void set_string_native(STRING *image) {
+ UINTVAL header_length = GROW_TO_16_BYTE_BOUNDARY(PACKFILE_HEADER_BYTES);
+ int unpacked_length;
+
+ PARROT_IMAGEIO(SELF)->what = VISIT_THAW_NORMAL;
+ PARROT_IMAGEIO(SELF)->visit_pmc_now = visit_todo_list_thaw;
+ PARROT_IMAGEIO(SELF)->buffer = (Buffer *)image;
+ PARROT_IMAGEIO(SELF)->id_list = pmc_new(INTERP, enum_class_ResizablePMCArray);
+
+ PARROT_ASSERT(image->_bufstart == image->strstart);
+
+ SET_VISIT_CURSOR(SELF, (char *)Buffer_bufstart(PARROT_IMAGEIO(SELF)->buffer));
+ PARROT_IMAGEIO(SELF)->input_length = image->strlen;
+
+ PARROT_IMAGEIO(SELF)->pf->options |= PFOPT_PMC_FREEZE_ONLY;
+ unpacked_length = PackFile_unpack(interp, PARROT_IMAGEIO(SELF)->pf,
+ GET_VISIT_CURSOR(SELF), PARROT_IMAGEIO(SELF)->input_length);
+
+ if (!unpacked_length) {
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_STRING_REPRESENTATION,
+ "PackFile header failed during unpack");
+ }
+ else {
+ INC_VISIT_CURSOR(SELF, header_length);
+ }
+
+ visit_loop_todo_list(interp, pmc, SELF);
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/gc_encapsulate/src/pmc/integer.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/integer.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/integer.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -1304,14 +1304,14 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the integer.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
SUPER(info);
VTABLE_push_integer(INTERP, info, SELF.get_integer());
}
@@ -1319,14 +1319,14 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the integer.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
SELF.set_integer_native(VTABLE_shift_integer(INTERP, info));
}
Modified: branches/gc_encapsulate/src/pmc/key.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/key.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/key.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -283,19 +283,19 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the Key.
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Archives the Key.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Unarchives the Key.
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Called after the Key has been thawed: convert last PMC_NULL key to NULL.
@@ -303,7 +303,7 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
/* Sometimes visit gets an uninitialized Key. Initialize it. */
if (!PMC_data(SELF))
SELF.init();
@@ -311,7 +311,7 @@
VISIT_PMC_ATTR(INTERP, info, SELF, Key, next_key);
}
- void freeze(visit_info *info) {
+ void freeze(PMC *info) {
/* write flags */
const INTVAL flags = (PObj_get_FLAGS(SELF) & KEY_type_FLAGS);
@@ -340,7 +340,7 @@
}
}
- void thaw(visit_info *info) {
+ void thaw(PMC *info) {
const INTVAL flags = VTABLE_shift_integer(INTERP, info) & KEY_type_FLAGS;
PObj_get_FLAGS(SELF) |= flags;
@@ -367,7 +367,7 @@
}
}
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
PMC *key = SELF;
UNUSED(info)
Modified: branches/gc_encapsulate/src/pmc/lexinfo.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/lexinfo.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/lexinfo.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -125,11 +125,11 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Freeze/thaw interface used during freeze/thaw of the Sub PMC.
The implementation of the Hash PMC is called.
@@ -139,7 +139,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
const INTVAL elems = VTABLE_shift_integer(INTERP, info);
const INTVAL k_type = VTABLE_shift_integer(INTERP, info);
const INTVAL v_type = VTABLE_shift_integer(INTERP, info);
Modified: branches/gc_encapsulate/src/pmc/object.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/object.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/object.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -725,7 +725,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the object.
@@ -735,24 +735,19 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
Parrot_Object_attributes * const obj_data = PARROT_OBJECT(SELF);
- PMC **pos;
/* 1) visit class */
- pos = &obj_data->_class;
- info->thaw_ptr = pos;
- (info->visit_pmc_now)(INTERP, *pos, info);
+ VISIT_PMC(INTERP, info, obj_data->_class);
/* 2) visit the attributes */
- pos = &obj_data->attrib_store;
- info->thaw_ptr = pos;
- (info->visit_pmc_now)(INTERP, *pos, info);
+ VISIT_PMC(INTERP, info, obj_data->attrib_store);
}
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the object.
@@ -760,13 +755,13 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
return;
}
/*
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Called after the object has been thawed.
@@ -774,7 +769,7 @@
*/
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_SET(SELF);
PObj_custom_destroy_SET(SELF);
Modified: branches/gc_encapsulate/src/pmc/orderedhash.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/orderedhash.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/orderedhash.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -726,15 +726,15 @@
}
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
Used during archiving to visit the elements in the hash.
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the hash.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the hash.
@@ -742,12 +742,12 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
VISIT_PMC_ATTR(INTERP, info, SELF, OrderedHash, hash);
SUPER(info);
}
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
Parrot_OrderedHash_attributes *attrs = PARROT_ORDEREDHASH(SELF);
find_bounds(INTERP, attrs->hash, &attrs->first, &attrs->last);
SUPER(info);
Modified: branches/gc_encapsulate/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/parrotinterpreter.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/parrotinterpreter.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -658,24 +658,24 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the interpreter.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the interpreter. Actually not the whole interpreter is
frozen but the state of the interpreter, which includes everything that
has changes since creating an empty interpreter.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the interpreter. This merges the changes into this
interpreter instance.
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Finish thawing.
@@ -683,8 +683,7 @@
*/
- VTABLE void visit(visit_info *info) {
- PMC **pos;
+ VTABLE void visit(PMC *info) {
/*
* the information frozen here is part of all PBCs
* we probably need to freeze all dynamic extensible
@@ -710,16 +709,14 @@
/* HLL_info */
if (VTABLE_get_integer(INTERP, info) == VISIT_THAW_NORMAL ||
VTABLE_get_integer(INTERP, info) == VISIT_THAW_CONSTANTS) {
- pos = &PMC_args(SELF);
+ VISIT_PMC(interp, info, PMC_args(SELF));
}
else
- pos = &INTERP->HLL_info;
+ VISIT_PMC(interp, info, INTERP->HLL_info);
- info->thaw_ptr = pos;
- (info->visit_pmc_now)(INTERP, *pos, info);
}
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
if (!PMC_data(SELF)) {
Parrot_ParrotInterpreter_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
@@ -730,7 +727,7 @@
PMC_interp(SELF) = INTERP;
}
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
PMC * const new_info = PMC_args(SELF);
const INTVAL m = VTABLE_elements(INTERP, new_info);
INTVAL i;
@@ -845,5 +842,3 @@
* End:
* vim: expandtab shiftwidth=4:
*/
-
-
Modified: branches/gc_encapsulate/src/pmc/resizablebooleanarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/resizablebooleanarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/resizablebooleanarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -404,14 +404,14 @@
=over 4
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the string.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
/* XXX Dino - I'm concerned about freezing the entire
allocated block of memory, it's dependent on the
BITS_PER_CHAR value.
@@ -438,14 +438,14 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the string.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
unsigned char *bit_array;
const UINTVAL head_pos = VTABLE_shift_integer(INTERP, info);
const UINTVAL tail_pos = VTABLE_shift_integer(INTERP, info);
Modified: branches/gc_encapsulate/src/pmc/resizableintegerarray.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/resizableintegerarray.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/resizableintegerarray.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -279,11 +279,11 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the array.
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the array.
@@ -291,7 +291,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
INTVAL *int_array;
INTVAL i, n, rt;
@@ -308,7 +308,7 @@
VTABLE_push_integer(INTERP, info, int_array[i]);
}
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
const INTVAL n = VTABLE_shift_integer(INTERP, info);
const INTVAL rt = VTABLE_shift_integer(INTERP, info);
Modified: branches/gc_encapsulate/src/pmc/retcontinuation.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/retcontinuation.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/retcontinuation.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -85,7 +85,6 @@
/* recycle this PMC and make sure it doesn't get marked */
if (!PMC_IS_NULL(from_ctx))
Parrot_pcc_set_continuation(interp, from_ctx, NULL);
- Parrot_gc_free_pmc_header(interp, SELF);
if (INTERP->code != seg)
Parrot_switch_to_cs(INTERP, seg, 1);
Modified: branches/gc_encapsulate/src/pmc/scheduler.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/scheduler.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/scheduler.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -277,7 +277,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
Visits the contents of the scheduler (used by freeze/thaw).
@@ -287,7 +287,7 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
/* 1) visit task list */
VISIT_PMC_ATTR(INTERP, info, SELF, Scheduler, task_list);
@@ -298,7 +298,7 @@
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Archives the scheduler.
@@ -306,7 +306,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
Parrot_Scheduler_attributes * const core_struct = PARROT_SCHEDULER(SELF);
/* 1) freeze scheduler id */
@@ -319,7 +319,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Unarchives the scheduler.
@@ -327,7 +327,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
/* 1. thaw scheduler id */
const INTVAL id = VTABLE_shift_integer(INTERP, info);
@@ -347,7 +347,7 @@
/*
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Finishes thawing the scheduler.
@@ -355,7 +355,7 @@
*/
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
Parrot_cx_refresh_task_list(INTERP, SELF);
}
Modified: branches/gc_encapsulate/src/pmc/schedulermessage.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/schedulermessage.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/schedulermessage.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -206,7 +206,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the scheduler message.
@@ -216,20 +216,14 @@
*/
- VTABLE void visit(visit_info *info) {
- Parrot_SchedulerMessage_attributes * const core_struct =
- PARROT_SCHEDULERMESSAGE(SELF);
- PMC **pos;
-
- /* 1) visit message data */
- pos = &core_struct->data;
- info->thaw_ptr = pos;
- (info->visit_pmc_now)(INTERP, *pos, info);
+ VTABLE void visit(PMC *info) {
+ /* visit message data */
+ VISIT_PMC(INTERP, info, PARROT_SCHEDULERMESSAGE(SELF)->data);
}
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the scheduler message.
@@ -237,7 +231,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
Parrot_SchedulerMessage_attributes * const core_struct =
PARROT_SCHEDULERMESSAGE(SELF);
@@ -250,7 +244,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the scheduler message.
@@ -258,7 +252,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
/* 1. thaw message id */
const INTVAL id = VTABLE_shift_integer(INTERP, info);
Modified: branches/gc_encapsulate/src/pmc/string.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/string.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/string.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -778,28 +778,28 @@
=over 4
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the string.
=cut
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
SUPER(info);
VTABLE_push_string(INTERP, info, VTABLE_get_string(INTERP, SELF));
}
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the string.
=cut
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
SUPER(info);
SET_ATTR_str_val(INTERP, SELF, VTABLE_shift_string(INTERP, info));
}
Modified: branches/gc_encapsulate/src/pmc/sub.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/sub.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/sub.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -619,11 +619,11 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the sub.
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Archives the subroutine.
@@ -631,7 +631,7 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
VISIT_PMC_ATTR(INTERP, info, SELF, Sub, namespace_name);
VISIT_PMC_ATTR(INTERP, info, SELF, Sub, multi_signature);
@@ -651,7 +651,7 @@
SUPER(info);
}
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
Parrot_Sub_attributes *sub;
STRING *hll_name;
int i;
@@ -709,7 +709,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Unarchives the subroutine.
@@ -717,7 +717,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
Parrot_Sub_attributes *sub;
INTVAL flags;
int i;
Modified: branches/gc_encapsulate/src/pmc/task.pmc
==============================================================================
--- branches/gc_encapsulate/src/pmc/task.pmc Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc/task.pmc Sun Feb 7 06:12:55 2010 (r43745)
@@ -385,7 +385,7 @@
/*
-=item C<void visit(visit_info *info)>
+=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the task.
@@ -395,14 +395,14 @@
*/
- VTABLE void visit(visit_info *info) {
+ VTABLE void visit(PMC *info) {
/* 1) visit code block */
VISIT_PMC_ATTR(INTERP, info, SELF, Task, codeblock);
}
/*
-=item C<void freeze(visit_info *info)>
+=item C<void freeze(PMC *info)>
Used to archive the task.
@@ -410,7 +410,7 @@
*/
- VTABLE void freeze(visit_info *info) {
+ VTABLE void freeze(PMC *info) {
const Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF);
/* 1) freeze task id */
@@ -434,7 +434,7 @@
/*
-=item C<void thaw(visit_info *info)>
+=item C<void thaw(PMC *info)>
Used to unarchive the task.
@@ -442,7 +442,7 @@
*/
- VTABLE void thaw(visit_info *info) {
+ VTABLE void thaw(PMC *info) {
/* 1. thaw task id */
const INTVAL id = VTABLE_shift_integer(INTERP, info);
@@ -486,7 +486,7 @@
/*
-=item C<void thawfinish(visit_info *info)>
+=item C<void thawfinish(PMC *info)>
Called after the task has been thawed.
@@ -494,7 +494,7 @@
*/
- VTABLE void thawfinish(visit_info *info) {
+ VTABLE void thawfinish(PMC *info) {
Parrot_Task_attributes * core_struct = PARROT_TASK(SELF);
UNUSED(core_struct); /* TODO: Rebuild the task index. */
Modified: branches/gc_encapsulate/src/pmc_freeze.c
==============================================================================
--- branches/gc_encapsulate/src/pmc_freeze.c Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/pmc_freeze.c Sun Feb 7 06:12:55 2010 (r43745)
@@ -18,10 +18,6 @@
Container PMCs call a "todo-callback" for all contained PMCs. The
individual action vtable (freeze/thaw) is then called for all todo-PMCs.
-In the current implementation C<visit_info> is a stand-in for some kind of
-serializer PMC which will eventually be written. It associates a Parrot
-C<STRING> with a vtable.
-
=cut
*/
@@ -30,745 +26,13 @@
#include "pmc/pmc_callcontext.h"
#include "pmc_freeze.str"
-/* HEADERIZER HFILE: include/parrot/pmc_freeze.h */
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void create_buffer(PARROT_INTERP,
- ARGIN_NULLOK(PMC *pmc),
- ARGMOD(visit_info *info))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*info);
-
-PARROT_INLINE
-static void ensure_buffer_size(PARROT_INTERP,
- ARGIN(visit_info *io),
- size_t len)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static INTVAL get_visit_integer(PARROT_INTERP, ARGIN(visit_info *io))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_INLINE
-static INTVAL INFO_HAS_DATA(ARGIN(visit_info *io))
- __attribute__nonnull__(1);
-
-PARROT_INLINE
-static INTVAL OUTPUT_LENGTH(ARGIN(visit_info *io))
- __attribute__nonnull__(1);
-
-static void push_opcode_integer(PARROT_INTERP,
- ARGIN(visit_info *io),
- INTVAL v)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void push_opcode_number(PARROT_INTERP,
- ARGIN(visit_info *io),
- FLOATVAL v)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void push_opcode_string(PARROT_INTERP,
- ARGIN(visit_info *io),
- ARGIN(STRING *v))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-static INTVAL shift_opcode_integer(SHIM_INTERP, ARGIN(visit_info *io))
- __attribute__nonnull__(2);
-
-static FLOATVAL shift_opcode_number(SHIM_INTERP, ARGIN(visit_info *io))
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static STRING* shift_opcode_string(PARROT_INTERP, ARGIN(visit_info *io))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void visit_info_init(PARROT_INTERP,
- ARGOUT(visit_info *info),
- visit_enum_type what,
- ARGIN(STRING *input),
- ARGIN(PMC *pmc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*info);
-
-static void visit_loop_todo_list(PARROT_INTERP,
- ARGIN_NULLOK(PMC *current),
- ARGIN(visit_info *info))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-static void visit_todo_list_freeze(PARROT_INTERP,
- ARGIN_NULLOK(PMC* pmc),
- ARGIN(visit_info* info))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-PARROT_INLINE
-static void visit_todo_list_thaw(PARROT_INTERP,
- SHIM(PMC* pmc_not_used),
- ARGIN(visit_info* info))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-#define ASSERT_ARGS_create_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(info))
-#define ASSERT_ARGS_ensure_buffer_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_get_visit_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_INFO_HAS_DATA __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_OUTPUT_LENGTH __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_push_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_push_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_push_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io) \
- , PARROT_ASSERT_ARG(v))
-#define ASSERT_ARGS_shift_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_shift_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_shift_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(io))
-#define ASSERT_ARGS_visit_info_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(info) \
- , PARROT_ASSERT_ARG(input) \
- , PARROT_ASSERT_ARG(pmc))
-#define ASSERT_ARGS_visit_loop_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(info))
-#define ASSERT_ARGS_visit_todo_list_freeze __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(info))
-#define ASSERT_ARGS_visit_todo_list_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(info))
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
/* when thawing a string longer then this size, we first do a GC run and then
* block GC - the system can't give us more headers */
#define THAW_BLOCK_GC_SIZE 100000
-/* preallocate freeze image for aggregates with this estimation */
-#define FREEZE_BYTES_PER_ITEM 9
-
-/* macros/constants to handle packing/unpacking of PMC IDs and flags
- * the 2 LSBs are used for flags, all other bits are used for PMC ID
- */
-#define PackID_new(id, flags) (((UINTVAL)(id) * 4) | ((UINTVAL)(flags) & 3))
-#define PackID_get_PMCID(id) ((UINTVAL)(id) / 4)
-#define PackID_set_PMCID(lv, id) (lv) = PackID_new((id), PackID_get_FLAGS(lv))
-#define PackID_get_FLAGS(id) ((UINTVAL)(id) & 3)
-#define PackID_set_FLAGS(lv, flags) (lv) = PackID_new(PackID_get_PMCID(lv), (flags))
-
-enum {
- enum_PackID_normal = 0,
- enum_PackID_seen = 1,
-};
-
-/*
-
-=head2 C<opcode_t> IO Functions
-
-=over 4
-
-=item C<static void ensure_buffer_size(PARROT_INTERP, visit_info *io, size_t
-len)>
-
-Checks the size of the "stream" buffer to see if it can accommodate
-C<len> more bytes. If not, expands the buffer.
-
-=cut
-
-*/
-
-#define GET_VISIT_CURSOR(io) \
- ((opcode_t *)(((char *)Buffer_bufstart((io)->buffer) + (io)->pos)))
-#define SET_VISIT_CURSOR(io, x) do {\
- (io)->pos = ((char *)(x) - (char *)Buffer_bufstart((io)->buffer)); \
-} while (0)
-#define INC_VISIT_CURSOR(io, x) do {\
- (io)->pos += (x); \
-} while (0)
-
-#define BYTECODE_SHIFT_OK(io) PARROT_ASSERT((io)->pos <= (io)->input_length)
-
-
-PARROT_INLINE
-static void
-ensure_buffer_size(PARROT_INTERP, ARGIN(visit_info *io), size_t len)
-{
- ASSERT_ARGS(ensure_buffer_size)
- Buffer *buf = io->buffer;
- const size_t used = io->pos;
- const int need_free = Buffer_buflen(buf) - used - len;
-
- /* grow by factor 1.5 or such */
- if (need_free <= 16) {
- size_t new_size = (size_t) (Buffer_buflen(buf) * 1.5);
- if (new_size < Buffer_buflen(buf) - need_free + 512)
- new_size = Buffer_buflen(buf) - need_free + 512;
- Parrot_gc_reallocate_buffer_storage(interp, buf, new_size);
-
- PARROT_ASSERT(Buffer_buflen(buf) - used - len >= 15);
- }
-
-#ifndef DISABLE_GC_DEBUG
- Parrot_gc_compact_memory_pool(interp);
-#endif
-
-}
-
-/*
-
-=item C<static INTVAL OUTPUT_LENGTH(visit_info *io)>
-
-XXX TODO
-
-=cut
-
-*/
-
-PARROT_INLINE
-static INTVAL
-OUTPUT_LENGTH(ARGIN(visit_info *io)) {
- ASSERT_ARGS(OUTPUT_LENGTH)
- return io->pos;
-}
-
-/*
-
-=item C<static INTVAL INFO_HAS_DATA(visit_info *io)>
-
-XXX TODO
-
-=cut
-
-*/
-
-PARROT_INLINE
-static INTVAL
-INFO_HAS_DATA(ARGIN(visit_info *io)) {
- ASSERT_ARGS(INFO_HAS_DATA)
- return io->pos < io->input_length;
-}
-
-
-/*
-
-=item C<static INTVAL get_visit_integer(PARROT_INTERP, visit_info *io)>
-
-get the flags describing the visit action
-
-=cut
-
-*/
-
-static INTVAL
-get_visit_integer(PARROT_INTERP, ARGIN(visit_info *io)) {
- ASSERT_ARGS(get_visit_integer)
- return io->what;
-}
-
-/*
-
-=item C<static void push_opcode_integer(PARROT_INTERP, visit_info *io, INTVAL
-v)>
-
-Pushes the integer C<v> onto the end of the C<*io> "stream".
-
-XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
-
-=cut
-
-*/
-
-static void
-push_opcode_integer(PARROT_INTERP, ARGIN(visit_info *io), INTVAL v)
-{
- ASSERT_ARGS(push_opcode_integer)
- size_t len = PF_size_integer() * sizeof (opcode_t);
- ensure_buffer_size(interp, io, len);
- SET_VISIT_CURSOR(io, PF_store_integer(GET_VISIT_CURSOR(io), v));
-}
-
-
-/*
-
-=item C<static void push_opcode_number(PARROT_INTERP, visit_info *io, FLOATVAL
-v)>
-
-Pushes the number C<v> onto the end of the C<*io> "stream".
-
-=cut
-
-*/
-
-static void
-push_opcode_number(PARROT_INTERP, ARGIN(visit_info *io), FLOATVAL v)
-{
- ASSERT_ARGS(push_opcode_number)
- size_t len = PF_size_number() * sizeof (opcode_t);
- ensure_buffer_size(interp, io, len);
- SET_VISIT_CURSOR(io, PF_store_number(GET_VISIT_CURSOR(io), &v));
-}
-
-
-/*
-
-=item C<static void push_opcode_string(PARROT_INTERP, visit_info *io, STRING
-*v)>
-
-Pushes the string C<*v> onto the end of the C<*io> "stream".
-
-=cut
-
-*/
-
-static void
-push_opcode_string(PARROT_INTERP, ARGIN(visit_info *io), ARGIN(STRING *v))
-{
- ASSERT_ARGS(push_opcode_string)
- size_t len = PF_size_string(v) * sizeof (opcode_t);
- ensure_buffer_size(interp, io, len);
- SET_VISIT_CURSOR(io, PF_store_string(GET_VISIT_CURSOR(io), v));
-}
-
-/*
-
-=item C<static void push_opcode_pmc(PARROT_INTERP, visit_info *io, PMC *v)>
-
-Pushes a reference to pmc C<*v> onto the end of the C<*io> "stream". If C<*v>
-hasn't been seen yet, it is also pushed onto the todo list.
-
-=cut
-
-*/
-
-static void
-push_opcode_pmc(PARROT_INTERP, ARGIN(visit_info *io), ARGIN(PMC *v)) {
- io->thaw_ptr = &v;
- (io->visit_pmc_now)(interp, v, io);
-}
-
-/*
-
-=item C<static INTVAL shift_opcode_integer(PARROT_INTERP, visit_info *io)>
-
-Removes and returns an integer from the start of the C<*io> "stream".
-
-=cut
-
-*/
-
-static INTVAL
-shift_opcode_integer(SHIM_INTERP, ARGIN(visit_info *io))
-{
- ASSERT_ARGS(shift_opcode_integer)
- opcode_t *pos = GET_VISIT_CURSOR(io);
- const INTVAL i = PF_fetch_integer(io->pf, (const opcode_t **)&pos);
- SET_VISIT_CURSOR(io, pos);
- BYTECODE_SHIFT_OK(io);
- return i;
-}
-
-
-/*
-
-=item C<static FLOATVAL shift_opcode_number(PARROT_INTERP, visit_info *io)>
-
-Removes and returns an number from the start of the C<*io> "stream".
-
-=cut
-
-*/
-
-static FLOATVAL
-shift_opcode_number(SHIM_INTERP, ARGIN(visit_info *io))
-{
- ASSERT_ARGS(shift_opcode_number)
- opcode_t *pos = GET_VISIT_CURSOR(io);
- const FLOATVAL f = PF_fetch_number(io->pf, (const opcode_t **)&pos);
- SET_VISIT_CURSOR(io, pos);
- BYTECODE_SHIFT_OK(io);
- return f;
-}
-
-
-/*
-
-=item C<static STRING* shift_opcode_string(PARROT_INTERP, visit_info *io)>
-
-Removes and returns a string from the start of the C<*io> "stream".
-
-=cut
-
-*/
-
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static STRING*
-shift_opcode_string(PARROT_INTERP, ARGIN(visit_info *io))
-{
- ASSERT_ARGS(shift_opcode_string)
- opcode_t *pos = GET_VISIT_CURSOR(io);
- STRING * const s = PF_fetch_string(interp, io->pf, (const opcode_t **)&pos);
- SET_VISIT_CURSOR(io, pos);
- BYTECODE_SHIFT_OK(io);
- return s;
-}
-
-/*
-
-=item C<static PMC *shift_opcode_pmc(PARROT_INTERP, visit_info *io)>
-
-Removes and returns a reference to a pmc from the start of the C<*io> "stream".
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static PMC *
-shift_opcode_pmc(PARROT_INTERP, ARGIN(visit_info *io)) {
- PMC *result;
- io->thaw_ptr = &result;
- (io->visit_pmc_now)(interp, NULL, io);
- return result;
-}
-
-/*
-
-=back
-
-=head2 Helper Functions
-
-=over 4
-
-=cut
-
-*/
-
-/*
- * this function setup stuff may be replaced by a real PMC
- * in the future
- * TODO add read/write header functions, e.g. vtable->init_pmc
- */
-
-static image_funcs opcode_funcs = {
- get_visit_integer,
- push_opcode_integer,
- push_opcode_string,
- push_opcode_number,
- push_opcode_pmc,
- shift_opcode_integer,
- shift_opcode_string,
- shift_opcode_number,
- shift_opcode_pmc
-};
-
-/*
-
-=item C<static void visit_info_init(PARROT_INTERP, visit_info *info,
-visit_enum_type what, STRING *input, PMC *pmc)>
-
-Initializes the C<*info> lists.
-
-=cut
-
-*/
-#define GROW_TO_16_BYTE_BOUNDARY(size) ((size) + ((size) % 16 ? 16 - (size) % 16 : 0))
-
-static void
-visit_info_init(PARROT_INTERP, ARGOUT(visit_info *info),
- visit_enum_type what, ARGIN(STRING *input), ARGIN(PMC *pmc))
-{
- ASSERT_ARGS(visit_info_init)
- /* We want to store a 16-byte aligned header, but the actual * header may be shorter. */
- const unsigned int header_length = GROW_TO_16_BYTE_BOUNDARY(PACKFILE_HEADER_BYTES);
-
- PackFile *pf = info->pf = PackFile_new(interp, 0);
- info->what = what;
- info->vtable = &opcode_funcs;
- info->image_io = info; /* backwards-compat hack */
-
- if (info->what == VISIT_FREEZE_NORMAL) {
- info->visit_pmc_now = visit_todo_list_freeze;
- create_buffer(interp, pmc, info);
- ensure_buffer_size(interp, info, header_length);
- mem_sys_memcopy(GET_VISIT_CURSOR(info), pf->header, PACKFILE_HEADER_BYTES);
- INC_VISIT_CURSOR(info, header_length);
- }
- else { /* VISIT_THAW_ */
- int unpacked_length;
- info->visit_pmc_now = visit_todo_list_thaw;
- info->buffer = (Buffer *)input;
- PARROT_ASSERT(input->_bufstart == input->strstart);
- SET_VISIT_CURSOR(info, Buffer_bufstart(info->buffer));
- info->input_length = input->strlen;
-
- pf->options |= PFOPT_PMC_FREEZE_ONLY;
- unpacked_length = PackFile_unpack(interp, pf, GET_VISIT_CURSOR(info), info->input_length);
- if (!unpacked_length) {
- PackFile_destroy(interp, info->pf);
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_STRING_REPRESENTATION,
- "PackFile header failed during unpack");
- }
- else {
- INC_VISIT_CURSOR(info, header_length);
- }
- }
-
- /* we must use PMCs here so that they get marked properly */
- info->todo = pmc_new(interp, enum_class_ResizablePMCArray);
- if (info->what == VISIT_FREEZE_NORMAL) {
- info->seen = pmc_new(interp, enum_class_Hash);
- VTABLE_set_pointer(interp, info->seen, parrot_new_intval_hash(interp));
- info->id_list = PMCNULL;
- }
- else {
- info->seen = PMCNULL;
- info->id_list = pmc_new(interp, enum_class_ResizablePMCArray);
- }
- info->id = 0;
- info->extra_flags = EXTRA_IS_NULL;
-
- visit_loop_todo_list(interp, pmc, info);
- PackFile_destroy(interp, info->pf);
-}
-
-
-PARROT_INLINE
-static PMC*
-id_list_get(PARROT_INTERP, ARGIN(visit_info *info), UINTVAL id) {
- PMC *pos = VTABLE_get_pmc_keyed_int(interp, info->id_list, id);
-
- if (pos && pos != ((void *)-1))
- return pos;
- return NULL;
-}
-
/*
-=item C<static void visit_todo_list_thaw(PARROT_INTERP, PMC* pmc_not_used,
-visit_info* info)>
-
-Callback for thaw - action first.
-thaws and return a PMC.
-
-=cut
-
-*/
-
-PARROT_INLINE
-static void
-visit_todo_list_thaw(PARROT_INTERP, SHIM(PMC* pmc_not_used), ARGIN(visit_info* info))
-{
- ASSERT_ARGS(visit_todo_list_thaw)
-
- UINTVAL n = VTABLE_shift_integer(interp, info);
- UINTVAL id = PackID_get_PMCID(n);
- int packid_flags = PackID_get_FLAGS(n);
- PMC *pmc = PMCNULL;
-
- PARROT_ASSERT(info->what == VISIT_THAW_NORMAL);
-
- switch (packid_flags) {
- case enum_PackID_seen:
- if (id) /* got a non-NULL PMC */
- pmc = id_list_get(interp, info, id);
- break;
- case enum_PackID_normal:
- {
- INTVAL type = VTABLE_shift_integer(interp, info);
- if (type <= 0 || type > interp->n_vtable_max)
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown PMC type to thaw %d", type);
-
- pmc = pmc_new_noinit(interp, type);
- VTABLE_thaw(interp, pmc, info);
-
- VTABLE_set_pmc_keyed_int(interp, info->id_list, id, pmc);
- /* remember nested aggregates depth first */
- VTABLE_unshift_pmc(interp, info->todo, pmc);
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown PMC id args thaw %d", packid_flags);
- break;
- }
-
- *info->thaw_ptr = pmc;
-}
-
-
-/*
-
-=item C<static void visit_todo_list_freeze(PARROT_INTERP, PMC* pmc, visit_info*
-info)>
-
-Checks the seen PMC via the todo list.
-
-=cut
-
-*/
-
-static void
-visit_todo_list_freeze(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info* info))
-{
- ASSERT_ARGS(visit_todo_list_freeze)
- UINTVAL id;
- int packid_type;
-
- PARROT_ASSERT(info->what == VISIT_FREEZE_NORMAL);
-
- if (PMC_IS_NULL(pmc)) {
- id = 0;
- packid_type = enum_PackID_seen;
- }
- else {
- Hash *hash = (Hash *)VTABLE_get_pointer(interp, info->seen);
- HashBucket * const b = parrot_hash_get_bucket(interp, hash, pmc);
- if (b) {
- id = (UINTVAL) b->value;
- packid_type = enum_PackID_seen;
- }
- else {
- info->id++; /* next id to freeze */
- id = info->id;
- packid_type = enum_PackID_normal;
- }
- }
-
- VTABLE_push_integer(interp, info, PackID_new(id, packid_type));
-
- if (packid_type == enum_PackID_normal) {
- Hash *hash = (Hash *)VTABLE_get_pointer(interp, info->seen);
- PARROT_ASSERT(pmc);
- VTABLE_push_integer(interp, info,
- PObj_is_object_TEST(pmc) ? enum_class_Object : pmc->vtable->base_type);
- parrot_hash_put(interp, hash, pmc, (void *)id);
- VTABLE_unshift_pmc(interp, info->todo, pmc);
- VTABLE_freeze(interp, pmc, info);
- }
-}
-
-
-/*
-
-=item C<static void visit_loop_todo_list(PARROT_INTERP, PMC *current, visit_info
-*info)>
-
-The thaw loop.
-
-=cut
-
-*/
-
-static void
-visit_loop_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC *current),
- ARGIN(visit_info *info))
-{
- ASSERT_ARGS(visit_loop_todo_list)
- const int thawing = (info->what == VISIT_THAW_NORMAL);
- PMC * const todolist = info->todo;
-
- (info->visit_pmc_now)(interp, current, info);
-
- /* can't cache upper limit, visit may append items */
- while (VTABLE_elements(interp, todolist)) {
- current = VTABLE_shift_pmc(interp, todolist);
- if (!current)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL current PMC in visit_loop_todo_list");
-
- PARROT_ASSERT(current->vtable);
- VTABLE_visit(interp, current, info);
- VISIT_PMC(interp, info, PMC_metadata(current));
- }
-
- if (thawing)
- /* we're done reading the image */
- PARROT_ASSERT(!INFO_HAS_DATA(info));
-
- if (thawing) {
- /* on thawing call thawfinish for each processed PMC */
- const INTVAL n = VTABLE_elements(interp, info->id_list);
- int i;
-
- /* Thaw in reverse order. We have to fully thaw younger PMCs before use them in older */
- for (i = n-1; i >= 0; --i) {
- current = VTABLE_get_pmc_keyed_int(interp, info->id_list, i);
- if (!PMC_IS_NULL(current))
- VTABLE_thawfinish(interp, current, info);
- }
- }
-}
-
-
-/*
-
-=item C<static void create_buffer(PARROT_INTERP, PMC *pmc, visit_info *info)>
-
-Allocate buffer to some estimated size.
-
-=cut
-
-*/
-
-static void
-create_buffer(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGMOD(visit_info *info))
-{
- ASSERT_ARGS(create_buffer)
- STRING *array = CONST_STRING(interp, "array");
- STRING *hash = CONST_STRING(interp, "hash");
- INTVAL len;
-
- if (!PMC_IS_NULL(pmc)
- && (VTABLE_does(interp, pmc, array) || VTABLE_does(interp, pmc, hash))) {
- const INTVAL items = VTABLE_elements(interp, pmc);
- /* TODO check e.g. first item of aggregate and estimate size */
- len = (items ? items : 1) * FREEZE_BYTES_PER_ITEM;
- }
- else
- len = FREEZE_BYTES_PER_ITEM;
-
- info->buffer = (Buffer *)Parrot_gc_new_string_header(interp, sizeof (Buffer));
- Parrot_gc_allocate_buffer_storage_aligned(interp, info->buffer, len);
- SET_VISIT_CURSOR(info, Buffer_bufstart(info->buffer));
-}
-
-
-/*
-
-=back
-
=head2 Public Interface
=over 4
@@ -788,10 +52,9 @@
Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc))
{
ASSERT_ARGS(Parrot_freeze)
- visit_info info;
-
- visit_info_init(interp, &info, VISIT_FREEZE_NORMAL, STRINGNULL, pmc);
- return Parrot_str_new_from_buffer(interp, info.buffer, OUTPUT_LENGTH(&info));
+ PMC *image = pmc_new(interp, enum_class_ImageIO);
+ VTABLE_set_pmc(interp, image, pmc);
+ return VTABLE_get_string(interp, image);
}
@@ -819,7 +82,7 @@
{
ASSERT_ARGS(Parrot_thaw)
- visit_info info;
+ PMC *info = pmc_new(interp, enum_class_ImageIO);
int gc_block = 0;
PMC *result;
@@ -840,9 +103,8 @@
gc_block = 1;
}
- info.thaw_ptr = &result;
- visit_info_init(interp, &info, VISIT_THAW_NORMAL, image, PMCNULL);
- BYTECODE_SHIFT_OK(&info);
+ VTABLE_set_pointer(interp, info, &result);
+ VTABLE_set_string_native(interp, info, image);
if (gc_block) {
Parrot_unblock_GC_mark(interp);
Modified: branches/gc_encapsulate/src/vtable.tbl
==============================================================================
--- branches/gc_encapsulate/src/vtable.tbl Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/src/vtable.tbl Sun Feb 7 06:12:55 2010 (r43745)
@@ -348,10 +348,10 @@
PMC* inspect()
PMC* inspect_str(STRING* what)
-void freeze(visit_info* info)
-void thaw (visit_info* info) :write
-void thawfinish (visit_info* info) :write
-void visit (visit_info* info)
+void freeze(PMC* info)
+void thaw (PMC* info) :write
+void thawfinish (PMC* info) :write
+void visit (PMC* info)
void share()
Modified: branches/gc_encapsulate/t/benchmark/benchmarks.t
==============================================================================
--- branches/gc_encapsulate/t/benchmark/benchmarks.t Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/t/benchmark/benchmarks.t Sun Feb 7 06:12:55 2010 (r43745)
@@ -32,10 +32,6 @@
q{array_access.pir} => qr/
1\s\*\s1000\s=\s1000\n
100\s\*\s1000\s=\s100000\n
-Array:\s\d+\.\d+s\n
-\n
-1\s\*\s1000\s=\s1000\n
-100\s\*\s1000\s=\s100000\n
FixedFloatArray:\s\d+\.\d+s\n
\n
1\s\*\s1000\s=\s1000\n
Modified: branches/gc_encapsulate/t/configure/033-step.t
==============================================================================
--- branches/gc_encapsulate/t/configure/033-step.t Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/t/configure/033-step.t Sun Feb 7 06:12:55 2010 (r43745)
@@ -139,7 +139,10 @@
{
my %tf_params = ( UNLINK => 1, );
- $tf_params{SUFFIX} = '.exe' if 'MSWin32' eq $^O;
+ $tf_params{SUFFIX} = '.exe' if (
+ ( $^O eq 'MSWin32' ) ||
+ ( $^O eq 'cygwin' )
+ );
my ( $tmpfile, $fname ) = tempfile(%tf_params);
local $ENV{PATH} = dirname($fname);
@@ -151,7 +154,10 @@
{
my %tf_params = ( UNLINK => 1, );
- $tf_params{SUFFIX} = '.exe' if 'MSWin32' eq $^O;
+ $tf_params{SUFFIX} = '.exe' if (
+ ( $^O eq 'MSWin32' ) ||
+ ( $^O eq 'cygwin' )
+ );
my ( $tmpfile, $fname ) = tempfile(%tf_params);
local $ENV{PATH} = dirname($fname);
@@ -173,7 +179,10 @@
{
my %tf_params = ( UNLINK => 1, );
- $tf_params{SUFFIX} = '.exe' if 'MSWin32' eq $^O;
+ $tf_params{SUFFIX} = '.exe' if (
+ ( $^O eq 'MSWin32' ) ||
+ ( $^O eq 'cygwin' )
+ );
my ( $tmpfile, $fname ) = tempfile(%tf_params);
local $ENV{PATH} = dirname($fname);
Modified: branches/gc_encapsulate/t/tools/pmc2cutils/02-find_file.t
==============================================================================
--- branches/gc_encapsulate/t/tools/pmc2cutils/02-find_file.t Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/t/tools/pmc2cutils/02-find_file.t Sun Feb 7 06:12:55 2010 (r43745)
@@ -37,7 +37,7 @@
);
my ( $file, $path );
-$file = q{array.pmc};
+$file = q{resizablepmcarray.pmc};
$path = $self->find_file($file);
ok( -f $path, "$file found" );
Modified: branches/gc_encapsulate/t/tools/pmc2cutils/04-dump_pmc.t
==============================================================================
--- branches/gc_encapsulate/t/tools/pmc2cutils/04-dump_pmc.t Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/t/tools/pmc2cutils/04-dump_pmc.t Sun Feb 7 06:12:55 2010 (r43745)
@@ -84,7 +84,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -95,7 +95,7 @@
is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" );
my @include = ( $tdir, $temppmcdir, @include_orig );
- @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/array.pmc}, );
+ @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, );
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
@@ -120,7 +120,7 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -136,7 +136,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -163,7 +163,7 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- @args = (qq{$temppmcdir/array.pmc});
+ @args = (qq{$temppmcdir/resizablepmcarray.pmc});
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
@@ -174,7 +174,7 @@
);
isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
ok( $self->dump_pmc(), "dump_pmc succeeded" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -349,7 +349,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -385,7 +385,7 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -399,7 +399,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -443,7 +443,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -454,7 +454,7 @@
is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" );
my @include = ( $tdir, $temppmcdir, @include_orig );
- @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/array.pmc}, );
+ @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, );
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
@@ -479,25 +479,25 @@
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
my @mtimes;
$mtimes[0]{default} = ( stat(qq{$temppmcdir/default.dump}) )[9];
- $mtimes[0]{array} = ( stat(qq{$temppmcdir/array.dump}) )[9];
+ $mtimes[0]{array} = ( stat(qq{$temppmcdir/resizablepmcarray.dump}) )[9];
sleep(2);
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
$mtimes[1]{default} = ( stat(qq{$temppmcdir/default.dump}) )[9];
- $mtimes[1]{array} = ( stat(qq{$temppmcdir/array.dump}) )[9];
+ $mtimes[1]{array} = ( stat(qq{$temppmcdir/resizablepmcarray.dump}) )[9];
# is( $mtimes[0]{default}, $mtimes[1]{default},
# "default.dump correctly not overwritten");
# isnt( $mtimes[0]{array}, $mtimes[1]{array},
- # "array.dump correctly overwritten");
+ # "resizablepmcarray.dump correctly overwritten");
ok( chdir $cwd, "changed back to original directory" );
}
@@ -511,7 +511,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc", );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc", );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -522,7 +522,7 @@
is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" );
my @include = ( $tdir, $temppmcdir, @include_orig );
- @args = ( qq{$temppmcdir/array.pmc}, );
+ @args = ( qq{$temppmcdir/resizablepmcarray.pmc}, );
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
@@ -546,7 +546,7 @@
)->dump_pmc();
ok( $self->dump_pmc(), "dump_pmc succeeded" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
ok( chdir $cwd, "changed back to original directory" );
Modified: branches/gc_encapsulate/t/tools/pmc2cutils/05-gen_c.t
==============================================================================
--- branches/gc_encapsulate/t/tools/pmc2cutils/05-gen_c.t Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/t/tools/pmc2cutils/05-gen_c.t Sun Feb 7 06:12:55 2010 (r43745)
@@ -48,7 +48,7 @@
ok( mkdir($_), "created $_ under tempdir" );
}
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc" );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -92,7 +92,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc" );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -103,7 +103,7 @@
is( $copycount, $pmcfilecount, "all src/pmc/*.pmc files copied to tempdir" );
my @include = ( $tdir, $temppmcdir, @include_orig );
- @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/array.pmc}, );
+ @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, );
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
@@ -127,10 +127,10 @@
)->dump_pmc();
ok( $self->dump_pmc(), "dump_pmc succeeded" );
ok( -f qq{$temppmcdir/default.dump}, "default.dump created as expected" );
- ok( -f qq{$temppmcdir/array.dump}, "array.dump created as expected" );
+ ok( -f qq{$temppmcdir/resizablepmcarray.dump}, "resizablepmcarray.dump created as expected" );
$rv = $self->gen_c();
- ok( $rv, "gen_c completed successfully; args: default.pmc and array.pmc" );
+ ok( $rv, "gen_c completed successfully; args: default.pmc and resizablepmcarray.pmc" );
ok( chdir $cwd, "changed back to original directory" );
}
@@ -146,7 +146,7 @@
my $temppmcdir = qq{$tdir/src/pmc};
ok( ( mkdir $temppmcdir ), "created src/pmc/ under tempdir" );
- my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/array.pmc" );
+ my @pmcfiles = ( "$main::topdir/src/pmc/default.pmc", "$main::topdir/src/pmc/resizablepmcarray.pmc" );
my $pmcfilecount = scalar(@pmcfiles);
my $copycount;
foreach my $pmcfile (@pmcfiles) {
@@ -157,7 +157,7 @@
is( $copycount, $pmcfilecount, "src/pmc/*.pmc files copied to tempdir" );
my @include = ( $tdir, $temppmcdir, @include_orig );
- @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/array.pmc}, );
+ @args = ( qq{$temppmcdir/default.pmc}, qq{$temppmcdir/resizablepmcarray.pmc}, );
$self = Parrot::Pmc2c::Pmc2cMain->new(
{
include => \@include,
Copied and modified: branches/gc_encapsulate/tools/build/cc_flags.pl (from r43744, branches/gc_encapsulate/tools/dev/cc_flags.pl)
==============================================================================
--- branches/gc_encapsulate/tools/dev/cc_flags.pl Sun Feb 7 06:10:49 2010 (r43744, copy source)
+++ branches/gc_encapsulate/tools/build/cc_flags.pl Sun Feb 7 06:12:55 2010 (r43745)
@@ -6,11 +6,11 @@
=head1 NAME
-tools/dev/cc_flags.pl - Process compiler flags
+tools/build/cc_flags.pl - Process compiler flags
=head1 SYNOPSIS
- % perl tools/dev/cc_flags.pl transform compiler flags
+ % perl tools/build/cc_flags.pl transform compiler flags
=head1 DESCRIPTION
@@ -19,10 +19,6 @@
See F<config/gen/makefiles/CFLAGS.in> for the transformation file format.
-=head1 SEE ALSO
-
-F<config/gen/cflags/root.in>.
-
=cut
################################################################################
@@ -30,13 +26,6 @@
use strict;
use warnings;
-my $verbose;
-
-if ($ARGV[0] eq '-v') {
- $verbose = 1;
- shift;
-}
-
my $cflags = shift;
open my $F, '<', $cflags or die "open $cflags: $!\n";
@@ -118,8 +107,6 @@
}
}
- # print "@ARGV\n";
-
# Visual C++ already prints the source file name...
if ( $ARGV[0] =~ /cl(?:\.exe)?/i ) {
@@ -134,10 +121,6 @@
}
}
-if ($verbose) {
- print join ' ', @ARGV;
-}
-
exit system(@ARGV) / 256;
# Local Variables:
Deleted: branches/gc_encapsulate/tools/build/dynpmc.pl
==============================================================================
--- branches/gc_encapsulate/tools/build/dynpmc.pl Sun Feb 7 06:12:55 2010 (r43744)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,292 +0,0 @@
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-tools/build/dynpmc.pl - Build script for dynamic PMCs
-
-=head1 DESCRIPTION
-
-This script is used for building dynamic PMCs. It is deprecated,
-L<http://trac.parrot.org/parrot/ticket/338>.
-
-=cut
-
-use strict;
-use warnings;
-use FindBin;
-use lib "$FindBin::Bin/../..";
-use lib "$FindBin::Bin/../../lib";
-
-use File::Copy qw(copy);
-use Storable;
-
-use Parrot::Config qw/%PConfig/;
-
-# Config stuff
-our $CC = $PConfig{cc} . ' -c';
-our $LD = $PConfig{ld};
-our $LDFLAGS = $PConfig{ldflags} . ' ' . $PConfig{ld_debug} . ' ' . $PConfig{rpath_blib};
-our $LD_LOAD_FLAGS = $PConfig{ld_load_flags};
-our $LOAD_EXT = $PConfig{load_ext};
-our $O = $PConfig{o};
-our $CFLAGS = $PConfig{ccflags} . ' '. $PConfig{cc_shared} . ' ' . $PConfig{cc_debug} . ' ' . $PConfig{ccwarn} . ' ' . $PConfig{cc_hasjit} . ' ' . $PConfig{cg_flag} . ' ' . $PConfig{gc_flag};
-our $BUILD_DIR = $PConfig{build_dir};
-
-our $LIBPARROT = q[];
-if ($PConfig{parrot_is_shared}) {
- $LIBPARROT = $PConfig{libparrot_ldflags};
-}
-
-# PMC2C Config
-our $SLASH = $PConfig{slash};
-our $PMC2C = "$^X \"" . join($SLASH, qw/tools build pmc2c.pl/) . '"';
-
-# Actual commands
-sub compile_cmd {
- my ($target, $source) = @_;
-
- my $dynpmc_include = '';
- if (defined $ENV{DYNPMC_INCLUDE} )
- {
- $dynpmc_include = $ENV{DYNPMC_INCLUDE};
- $dynpmc_include =~ s/,/" -I"/g;
- $dynpmc_include = '-I"' . $dynpmc_include . '" ';
- }
-
- return
- $CC . ' ' .
- $PConfig{cc_o_out} . $target . ' ' .
- '-I"' . $BUILD_DIR . $SLASH . 'include' .
- "$dynpmc_include $CFLAGS $source";
-};
-
-sub partial_link_cmd {
- my ($target, $libs, $sources) = @_;
-
- my $liblist;
- if ($^O =~ /mswin32/i) {
- # Need to put various libraries in the link line.
- if ($CC =~ /gcc/i) {
- $liblist = join( ' ', map { "-l$_" } keys %$libs );
- $liblist =~ s/-lgdbm/-llibgdbm/i;
- }
- else {
- $liblist = join( ' ', map { "$_.lib" } keys %$libs );
- }
- my $extraLibs = $PConfig{libs} . ' ' . $PConfig{icu_shared};
- $extraLibs =~ s/blib/..\\blib/g;
- $extraLibs =~ s/\Q$(A)\E/.lib/g;
- $liblist .= ' ' . $extraLibs;
-
- # Also note that we may need to look in the Parrot blib directory.
- if ($CC =~ /gcc/i) {
- $liblist .= qq{ -Wl,-L "$BUILD_DIR/blib/lib"};
- }
- else {
- $liblist .= qq{ /LIBPATH:"$BUILD_DIR/blib/lib"};
- }
- }
- else {
- $liblist = join( ' ', map { "-l$_" } keys %$libs );
- $liblist .= ' ' . $PConfig{libs} . ' ' . $PConfig{icu_shared};
- }
-
- if (defined $ENV{DYNPMC_LINK}) {
- push @{$sources}, split /,/, $ENV{DYNPMC_LINK};
- }
-
- return
- $LD . ' ' . $PConfig{ld_out} .
- $target . ' ' .
- join(' ', map {"\"$_\""} @$sources) .
- " $liblist $LDFLAGS $LD_LOAD_FLAGS $LIBPARROT";
-}
-
-our $NOW = time();
-
-################### MAIN PROGRAM ################
-
-my ($mode, @pmcs) = @ARGV;
-
-if ($mode eq 'generate') {
- # Convert X.pmc -> X.dump and X.c and also create any lib-GROUP.c files
-
- generate_dump($_) foreach (@pmcs);
- generate_c($_) foreach (@pmcs);
-
- my ($group_files, $group_libs, $pmc_group, $pmc_libs) =
- gather_groups_and_libs(@pmcs);
-
- while (my ($group, $pmcs) = each %$group_files) {
- my @pmcfiles = map { "$_.pmc" } @$pmcs;
- if (needs_build("$group.c", @pmcfiles)) {
- run("$PMC2C --library $group --c " . join(" ", at pmcfiles))
- or die "pmc2c library creation failed ($?)\n";
- }
- }
-}
-elsif ($mode eq 'compile') {
- my ($group_files, $group_libs, $pmc_group, $pmc_libs) =
- gather_groups_and_libs(@pmcs);
-
- # Convert X.c -> X.o for all X.c
- compile($_) foreach (@pmcs);
-
- # lib-GROUP.c
- for my $group (keys %$group_files) {
- compile("$group", "lib-$group")
- or die "compile $group.c failed ($?)\n";
- }
-}
-elsif ($mode eq 'linklibs') {
- my ($group_files, $group_libs, $pmc_group, $pmc_libs) =
- gather_groups_and_libs(@pmcs);
-
- # Convert lib-GROUP.so + A.so + B.so ... -> GROUP.so
- while (my ($group, $pmcs) = each %$group_files) {
- partial_link($group, $group_libs->{$group}, [ "lib-$group", @$pmcs ] )
- or die "partial link of $group failed ($?)\n";
- }
-
- # Link non-grouped PMCs individually
- my @ungrouped_pmcs = grep { ! exists $pmc_group->{$_} } @pmcs;
- partial_link($_, $pmc_libs->{$_}, [ $_ ] ) foreach (@ungrouped_pmcs);
-}
-elsif ($mode eq 'copy') {
- # Copy *.so -> destination, where destination is the first
- # argument, given as --destination=DIRECTORY
- shift(@pmcs) =~ /--destination=(.*)/
- or die "copy command requires destination";
- my $dest = $1;
-
- my ($group_files, $group_libs, $pmc_group, $pmc_libs) =
- gather_groups_and_libs(@pmcs);
- my @ungrouped_pmcs = grep { ! exists $pmc_group->{$_} } @pmcs;
-
- my (@list_to_process) = (@ungrouped_pmcs, keys %$group_files);
-
- die "nothing found to copy" unless @list_to_process;
-
- foreach (@list_to_process) {
- copy("$_$LOAD_EXT", $dest) or die "Copy $_$LOAD_EXT failed ($?)\n";
-
- # Execute permissions on libraries is especially important on
- # some platforms
- if ($^O eq 'hpux' or $^O eq 'cygwin') {
- chmod 0755, "$dest at slash@$_$LOAD_EXT";
- }
-
- }
-}
-else {
- die "invalid command '$mode'\nmust be one of generate, compile, linklibs, or copy\n";
-}
-
-sub run {
- print join(" ", @_), "\n";
-
- return system(@_) == 0;
-}
-
-sub gather_groups_and_libs {
- my @pmcs = @_;
-
- my ( %group_files, %group_libs, %pmc_group, %pmc_libs );
- for my $pmc (@pmcs) {
- our $class = retrieve("$pmc.dump");
-
- # there can be many libs
- my %libs = %{ $class->{flags}{lib} || {} };
- $pmc_libs{$pmc} = \%libs;
-
- # There should be at most a single group
- my $group = $class->{flags}{group}
- or next;
- $pmc_group{$pmc} = $group;
- push @{ $group_files{$group} }, $pmc;
- $group_libs{$group} ||= {};
- foreach my $lib ( keys %libs ) {
- $group_libs{$group}->{$lib} = 1;
- }
- }
-
- return (\%group_files, \%group_libs, \%pmc_group, \%pmc_libs);
-}
-
-sub modtime {
- my $ago = (-M shift);
-
- if (defined $ago) {
- return $NOW - $ago;
- }
- else {
- return;
- }
-}
-
-sub needs_build {
- my ($target, @sources) = @_;
-
- my $target_mod = modtime($target)
- or return 1;
- for my $source (@sources) {
- return 1 if modtime($source) > $target_mod;
- }
-
- return 0;
-}
-
-sub generate_dump {
- my ($pmc) = @_;
-
- if (needs_build("$pmc.dump", "$pmc.pmc")) {
- run("$PMC2C --dump $pmc.pmc")
- or die "pmc2c dump failed ($?)\n";
- }
-
- return;
-}
-
-sub generate_c {
- my ($pmc) = @_;
-
- if (needs_build("$pmc.c", "$pmc.pmc")) {
- run("$PMC2C --c $pmc.pmc")
- or die "pmc2c code generation failed ($?)\n";
- }
-
- return;
-}
-
-sub compile {
- my ($src_stem, $dest_stem) = @_;
-
- $dest_stem ||= $src_stem;
- if (needs_build("$dest_stem$O", "$src_stem.c")) {
- run(compile_cmd("$dest_stem$O", "$src_stem.c"))
- or die "compile $src_stem.c failed ($?)\n";
- }
- return 1;
-}
-
-sub partial_link {
- my ($group, $libs, $stems) = @_;
-
- my @sources = map { "$_$O" } @$stems;
- if (needs_build("$group$LOAD_EXT", @sources)) {
- return run(partial_link_cmd("$group$LOAD_EXT", $libs, \@sources))
- or die "partial link $group$LOAD_EXT failed ($?)\n";
- }
- else {
- return 1;
- }
-}
-
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Added: branches/gc_encapsulate/tools/build/nativecall.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc_encapsulate/tools/build/nativecall.pir Sun Feb 7 06:12:55 2010 (r43745)
@@ -0,0 +1,891 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+tools/build/nativecall.pir - Build up the native call routines
+
+=head1 SYNOPSIS
+
+ % ./parrot tools/build/nativecall.pir <src/call_list.txt >src/nci.c
+
+=head1 DESCRIPTION
+
+This script creates the Native Call Interface file F<src/nci.c>. It
+parses a file of function signatures of the form:
+
+ <return-type-specifier><ws><parameter-type-specifiers>[<ws>][#<comment>]
+ ...
+Empty lines and lines containing only whitespace or comment are ignored.
+The types specifiers are documented in F<src/call_list.txt>.
+
+=head1 SEE ALSO
+
+F<src/call_list.txt>.
+F<docs/pdds/pdd16_native_call.pod>.
+
+=cut
+
+.sub 'main' :main
+ .local pmc sig_table, sigs
+ sig_table = 'gen_sigtable'()
+ sigs = 'read_sigs'()
+
+ $S0 = 'get_head'(sig_table, sigs)
+ say $S0
+ $S0 = 'get_thunks'(sig_table, sigs)
+ say $S0
+ $S0 = 'get_loader'(sig_table, sigs)
+ say $S0
+ $S0 = 'get_coda'(sig_table, sigs)
+ say $S0
+.end
+
+# get_{head,thunks,loader,coda} {{{
+
+.sub 'get_head'
+ .param pmc ignored :slurpy
+ .return (<<'HEAD')
+/* ex: set ro ft=c:
+ * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ *
+ * This file is generated automatically by tools/build/nativecall.pir
+ *
+ * Any changes made here will be lost!
+ *
+ */
+
+/* nci.c
+ * Copyright (C) 2001-2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ * Overview:
+ * Native Call Interface routines. The code needed to build a
+ * parrot to C call frame is in here
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+#include "parrot/parrot.h"
+#include "parrot/hash.h"
+#include "parrot/oplib/ops.h"
+#include "pmc/pmc_managedstruct.h"
+#include "pmc/pmc_nci.h"
+#include "pmc/pmc_pointer.h"
+#include "pmc/pmc_callcontext.h"
+#include "nci.str"
+
+/* HEADERIZER HFILE: none */
+/* HEADERIZER STOP */
+
+/*
+ * if the architecture can build some or all of these signatures
+ * enable the define below
+ * - the JITed function will be called first
+ * - if it returns NULL, the hardcoded version will do the job
+ */
+
+#include "frame_builder.h"
+
+/* All our static functions that call in various ways. Yes, terribly
+ hackish, but that is just fine */
+
+HEAD
+.end
+
+.sub 'get_thunks'
+ .param pmc sig_table
+ .param pmc sigs
+ .local string code
+ .local int i, n
+ code = ''
+ i = 0
+ n = sigs
+ loop:
+ if i >= n goto end_loop
+
+ .local pmc sig
+ sig = sigs[i]
+ $S0 = 'sig_to_fn_code'(sig_table, sig :flat)
+ code = concat code, $S0
+
+ inc i
+ goto loop
+ end_loop:
+ .return (code)
+.end
+
+.sub 'get_loader'
+ .param pmc sig_table
+ .param pmc sigs
+ .local string code
+ .local int i, n
+ code = <<'FN_HEADER'
+
+
+/* This function serves a single purpose. It takes the function
+ signature for a C function we want to call and returns a pointer
+ to a function that can call it. */
+void *
+build_call_func(PARROT_INTERP,
+#if defined(CAN_BUILD_CALL_FRAMES)
+PMC *pmc_nci, NOTNULL(STRING *signature), NOTNULL(int *jitted))
+#else
+SHIM(PMC *pmc_nci), NOTNULL(STRING *signature), SHIM(int *jitted))
+#endif
+{
+ char *c;
+ STRING *ns, *message;
+ PMC *b;
+ PMC *iglobals;
+ PMC *temp_pmc;
+
+ PMC *HashPointer = NULL;
+
+ /* And in here is the platform-independent way. Which is to say
+ "here there be hacks" */
+
+ /* fixup empty signatures */
+ if (STRING_IS_EMPTY(signature))
+ signature = CONST_STRING(interp, "v");
+
+ iglobals = interp->iglobals;
+
+ if (PMC_IS_NULL(iglobals))
+ PANIC(interp, "iglobals isn't created yet");
+ HashPointer = VTABLE_get_pmc_keyed_int(interp, iglobals,
+ IGLOBALS_NCI_FUNCS);
+
+ if (!HashPointer) {
+ HashPointer = pmc_new(interp, enum_class_Hash);
+ VTABLE_set_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS,
+ HashPointer);
+ }
+
+#if defined(CAN_BUILD_CALL_FRAMES)
+ /* Try if JIT code can build that signature. If yes, we are done */
+ b = VTABLE_get_pmc_keyed_str(interp, HashPointer, signature);
+
+ PARROT_ASSERT(PMC_IS_NULL(b) || b->vtable);
+
+ if ((!PMC_IS_NULL(b)) && b->vtable->base_type == enum_class_ManagedStruct) {
+ *jitted = 1;
+ return F2DPTR(VTABLE_get_pointer(interp, b));
+ }
+ else {
+ int jit_size;
+ void * const result = Parrot_jit_build_call_func(interp, pmc_nci, signature, &jit_size);
+ if (result) {
+ struct jit_buffer_private_data *priv;
+ *jitted = 1;
+ temp_pmc = pmc_new(interp, enum_class_ManagedStruct);
+ VTABLE_set_pointer(interp, temp_pmc, (void *)result);
+#ifdef PARROT_HAS_EXEC_PROTECT
+ priv = (struct jit_buffer_private_data *)
+ mem_sys_allocate(sizeof(struct jit_buffer_private_data));
+ priv->size = jit_size;
+ SETATTR_ManagedStruct_custom_free_func(interp, temp_pmc, Parrot_jit_free_buffer);
+ SETATTR_ManagedStruct_custom_free_priv(interp, temp_pmc, priv);
+ SETATTR_ManagedStruct_custom_clone_func(interp, temp_pmc, Parrot_jit_clone_buffer);
+ SETATTR_ManagedStruct_custom_clone_priv(interp, temp_pmc, priv);
+#endif /* PARROT_HAS_EXEC_PROTECT */
+ VTABLE_set_pmc_keyed_str(interp, HashPointer, signature, temp_pmc);
+ return result;
+ }
+ }
+
+#endif
+
+ b = VTABLE_get_pmc_keyed_str(interp, HashPointer, signature);
+
+ if (PMC_IS_NULL(b)) {
+FN_HEADER
+
+ i = 0
+ n = sigs
+ loop:
+ if i >= n goto end_loop
+
+ .local pmc sig
+ sig = shift sigs
+
+ .local string fn_name
+ fn_name = 'sig_to_fn_name'(sig_table, sig :flat)
+
+ .local string key
+ key = join '', sig
+
+ $S0 = 'sprintf'(<<'TEMPLATE', fn_name, key)
+ temp_pmc = pmc_new(interp, enum_class_UnManagedStruct);
+ VTABLE_set_pointer(interp, temp_pmc, (void *)%s);
+ VTABLE_set_pmc_keyed_str(interp, HashPointer, CONST_STRING(interp, "%s"), temp_pmc);
+TEMPLATE
+ code = concat code, $S0
+
+ inc i
+ goto loop
+ end_loop:
+
+ code = concat code, <<'FN_FOOTER'
+
+ b = VTABLE_get_pmc_keyed_str(interp, HashPointer, signature);
+ }
+
+ PARROT_ASSERT(PMC_IS_NULL(b) || b->vtable);
+
+ if ((!PMC_IS_NULL(b)) && b->vtable->base_type == enum_class_UnManagedStruct)
+ return F2DPTR(VTABLE_get_pointer(interp, b));
+
+ /*
+ These three lines have been added to aid debugging. I want to be able to
+ see which signature has an unknown type. I am sure someone can come up
+ with a neater way to do this.
+ */
+ ns = string_make(interp, " is an unknown signature type", 29, "ascii", 0);
+ message = Parrot_str_concat(interp, signature, ns, 0);
+
+#if defined(CAN_BUILD_CALL_FRAMES)
+ ns = string_make(interp, ".\\nCAN_BUILD_CALL_FRAMES is enabled, this should not happen", 58, "ascii", 0);
+#else
+ ns = string_make(interp, ".\\nCAN_BUILD_CALL_FRAMES is disabled, add the signature to src/call_list.txt", 75, "ascii", 0);
+#endif
+ message = Parrot_str_concat(interp, message, ns, 0);
+
+ /*
+ * I think there may be memory issues with this but if we get to here we are
+ * aborting.
+ */
+ c = Parrot_str_to_cstring(interp, message);
+ PANIC(interp, c);
+}
+
+FN_FOOTER
+ .return (code)
+.end
+
+.sub 'get_coda'
+ .param pmc ignored :slurpy
+ .return (<<'CODA')
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+CODA
+.end
+
+# }}}
+
+# sig_to_* {{{
+
+.sub 'sig_to_fn_code'
+ .param pmc args :slurpy
+
+ .local string fn_decl
+ fn_decl = 'sig_to_fn_decl'(args :flat)
+
+ .local string var_decls
+ var_decls = 'sig_to_var_decls'(args :flat)
+
+ .local string preamble
+ preamble = 'sig_to_preamble'(args :flat)
+
+ .local string call
+ call = 'sig_to_call'(args :flat)
+
+ .local string postamble
+ postamble = 'sig_to_postamble'(args :flat)
+
+ .local string fn_code
+ fn_code = 'sprintf'("%s{\n%s%s%s%s}\n", fn_decl, var_decls, preamble, call, postamble)
+ .return (fn_code)
+.end
+
+.sub 'sig_to_postamble'
+ .param pmc sig_table
+ .param string ret
+ .param string params
+
+ .local string final_assign
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'ret_assign')
+ final_assign = $P0[0]
+
+ .local string extra_postamble
+ $P0 = 'map_from_sig_table'(sig_table, params, 'postamble_tmpl')
+ 'fill_tmpls_ascending_ints'($P0)
+ extra_postamble = join "\n", $P0
+
+ .local string postamble
+ postamble = 'sprintf'(<<'TEMPLATE', final_assign, extra_postamble)
+ %s
+ %s
+TEMPLATE
+ .return (postamble)
+.end
+
+.sub 'sig_to_call'
+ .param pmc sig_table
+ .param string ret
+ .param string params
+
+ .local string return_assign
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'func_call_assign')
+ return_assign = $P0[0]
+
+ .local string ret_cast
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'as_return')
+ ret_cast = $P0[0]
+ if ret_cast == 'void' goto void_fn
+ ret_cast = 'sprintf'('(%s)', ret_cast)
+ goto end_ret_cast
+ void_fn:
+ ret_cast = ''
+ end_ret_cast:
+
+ .local string call_params
+ $P0 = 'map_from_sig_table'(sig_table, params, 'call_param_tmpl')
+ 'fill_tmpls_ascending_ints'($P0)
+ call_params = join ', ', $P0
+
+ .local string call
+ call = 'sprintf'(<<'TEMPLATE', return_assign, ret_cast, call_params)
+ GETATTR_NCI_orig_func(interp, self, orig_func);
+ fn_pointer = (func_t)D2FPTR(orig_func);
+ %s %s(*fn_pointer)(%s);
+TEMPLATE
+ .return (call)
+.end
+
+.sub 'sig_to_preamble'
+ .param pmc sig_table
+ .param string ret
+ .param string params
+
+ unless params goto return
+
+ .local string sig
+ $P0 = 'map_from_sig_table'(sig_table, params, 'sig_char')
+ sig = join "", $P0
+
+ .local string fill_params
+ $P0 = 'map_from_sig_table'(sig_table, params, 'fill_params_tmpl')
+ 'fill_tmpls_ascending_ints'($P0)
+ fill_params = join "", $P0
+
+ .local string extra_preamble
+ $P0 = 'map_from_sig_table'(sig_table, params, 'preamble_tmpl')
+ 'fill_tmpls_ascending_ints'($P0)
+ extra_preamble = join "", $P0
+
+ .local string preamble
+ preamble = 'sprintf'(<<'TEMPLATE', sig, fill_params, extra_preamble)
+ Parrot_pcc_fill_params_from_c_args(interp, call_object, "%s" %s);
+ %s
+TEMPLATE
+
+ return:
+ .return (preamble)
+.end
+
+.sub 'sig_to_var_decls'
+ .param pmc sig_table
+ .param string ret
+ .param string params
+
+ .local string ret_csig
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'as_return')
+ ret_csig = $P0[0]
+
+ .local string params_csig
+ $P0 = 'map_from_sig_table'(sig_table, params, 'as_proto')
+ params_csig = join ', ', $P0
+
+ .local string ret_tdecl
+ ret_tdecl = ""
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'return_type')
+ $S0 = $P0[0]
+ unless $S0 goto end_ret_type
+ if $S0 == 'void' goto end_ret_type
+ $S0 = 'sprintf'("%s return_data;\n", $S0)
+ ret_tdecl = concat ret_tdecl, $S0
+ end_ret_type:
+ $P0 = 'map_from_sig_table'(sig_table, ret, 'final_dest')
+ $S0 = $P0[0]
+ unless $S0 goto end_final_dest
+ $S0 = concat $S0, "\n"
+ ret_tdecl = concat ret_tdecl, $S0
+ end_final_dest:
+
+ .local string params_tdecl
+ $P0 = 'map_from_sig_table'(sig_table, params, 'temp_tmpl')
+ 'fill_tmpls_ascending_ints'($P0)
+ $P0 = 'grep_for_true'($P0)
+ params_tdecl = join ";\n ", $P0
+
+ .local string var_decls
+ var_decls = 'sprintf'(<<'TEMPLATE', ret_csig, params_csig, ret_tdecl, params_tdecl)
+ typedef %s(* func_t)(%s);
+ func_t fn_pointer;
+ void *orig_func;
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
+ %s
+ %s;
+TEMPLATE
+
+ .return (var_decls)
+.end
+
+.sub 'sig_to_fn_decl'
+ .param pmc sig_table
+ .param pmc sig :slurpy
+ .local string fn_name, fn_decl
+ fn_name = 'sig_to_fn_name'(sig_table, sig :flat)
+ fn_decl = 'sprintf'(<<'TEMPLATE', fn_name)
+static void
+%s(PARROT_INTERP, PMC *self)
+TEMPLATE
+ .return (fn_decl)
+.end
+
+.sub 'sig_to_fn_name'
+ .param pmc sig_table
+ .param string ret
+ .param string params
+
+ .local string fix_params
+ $P0 = 'map_from_sig_table'(sig_table, params, 'cname')
+ fix_params = join '', $P0
+
+ $S0 = 'sprintf'('pcf_%s_%s', ret, fix_params)
+ .return ($S0)
+.end
+
+.sub 'map_from_sig_table'
+ .param pmc sig_table
+ .param string sig
+ .param string field_name
+
+ $P0 = split '', sig
+
+ .local pmc result
+ result = new ['ResizableStringArray']
+ $I0 = $P0
+ result = $I0
+
+ $I0 = $P0
+ $I1 = 0
+ loop:
+ if $I1 >= $I0 goto end_loop
+ $S0 = $P0[$I1]
+ $S1 = sig_table[$S0; field_name]
+ result[$I1] = $S1
+ inc $I1
+ goto loop
+ end_loop:
+
+ .return (result)
+.end
+
+# }}}
+
+# read_sigs {{{
+
+.sub 'read_sigs'
+ .local pmc stdin, seen, sigs
+ stdin = getstdin
+ seen = new ['Hash']
+ sigs = new ['ResizablePMCArray']
+
+ .local int lineno
+ lineno = 0
+ read_loop:
+ unless stdin goto end_read_loop
+
+ .local string ret_sig, param_sig, full_sig
+ (ret_sig, param_sig) = 'read_one_sig'(stdin)
+ inc lineno
+ full_sig = concat ret_sig, param_sig
+
+ # filter out empty sigs (and empty lines)
+ unless full_sig goto read_loop
+
+ # de-dup sigs
+ $I0 = seen[full_sig]
+ unless $I0 goto unseen
+ $S0 = 'sprintf'("Ignored signature '%s' on line %d (previously seen on line %d)\n", full_sig, lineno, $I0)
+ printerr $S0
+ goto read_loop
+ unseen:
+ seen[full_sig] = lineno
+
+ .local pmc sig
+ sig = new ['ResizableStringArray']
+ sig = 2
+ sig[0] = ret_sig
+ sig[1] = param_sig
+ push sigs, sig
+
+ goto read_loop
+ end_read_loop:
+
+ .return (sigs)
+.end
+
+.sub 'read_one_sig'
+ .param pmc fh
+
+ .local string line
+ line = readline fh
+
+ # handle comments
+ $I0 = index line, '#'
+ if $I0 < 0 goto end_comment
+ line = substr line, 0, $I0
+ end_comment:
+
+ # convert whitespace into spaces
+ $S0 = '\t'
+ whitespace_loop:
+ $I0 = index line, $S0
+ if $I0 < 0 goto end_whitespace_loop
+ substr line, $I0, 1, ' '
+ goto whitespace_loop
+ end_whitespace_loop:
+
+ if $S0 == "\n" goto end_whitespace
+ $S0 = "\n"
+ goto whitespace_loop
+ end_whitespace:
+
+ # turn multiple spaces into a single space
+ multispace_loop:
+ $I0 = index line, ' '
+ if $I0 < 0 goto end_multispace_loop
+ $S0 = substr line, $I0, 2, ' '
+ goto multispace_loop
+ end_multispace_loop:
+
+ # remove leading whitespace
+ $S0 = substr line, 0, 1
+ unless $S0 == ' ' goto end_leading
+ $S0 = substr line, 0, 1, ''
+ end_leading:
+
+ # handle empty (or whitespace only) lines
+ if line == '' goto ret
+ if line == ' ' goto ret
+
+ # remove trailing whitespace
+ $S0 = substr line, -1, 1
+ unless $S0 == ' ' goto end_trailing
+ $S0 = substr line, -1, 1, ''
+ end_trailing:
+
+ # read the signature
+ .local string ret_sig, param_sig
+ $P0 = split ' ', line
+ ret_sig = $P0[0]
+ param_sig = $P0[1]
+
+ ret:
+ .return (ret_sig, param_sig)
+.end
+
+#}}}
+
+# gen_sigtable {{{
+
+.sub 'gen_sigtable'
+ $S0 = 'sigtable_json'()
+ $P0 = 'decode_table'($S0)
+ 'fixup_table'($P0)
+ .return ($P0)
+.end
+
+.sub 'decode_table'
+ .param string json
+
+ .local pmc compiler
+ load_bytecode 'data_json.pbc'
+ compiler = compreg 'data_json'
+
+ .local pmc table
+ $P0 = compiler.'compile'(json)
+ table = $P0()
+
+ .return (table)
+.end
+
+.sub 'fixup_table'
+ .param pmc table
+
+ .local pmc table_iter
+ table_iter = iter table
+ iter_loop:
+ unless table_iter goto iter_end
+
+ .local string k
+ .local pmc v
+ k = shift table_iter
+ v = table[k]
+
+ $I0 = exists v['cname']
+ if $I0 goto has_cname
+ v['cname'] = k
+ has_cname:
+
+ $I0 = exists v['as_return']
+ if $I0 goto has_as_return
+ $S0 = v['as_proto']
+ v['as_return'] = $S0
+ has_as_return:
+
+ $I0 = exists v['return_type']
+ if $I0 goto has_return_type
+ $S0 = v['as_proto']
+ v['return_type'] = $S0
+ has_return_type:
+
+ $I0 = exists v['ret_assign']
+ $I1 = exists v['sig_char']
+ $I1 = !$I1
+ $I0 = $I0 || $I1 # not (not exists v[ret_assign] and exists v[sig_char])
+ if $I0 goto has_ret_assign
+ $S0 = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
+ $S1 = v['sig_char']
+ $S0 = concat $S0, $S1
+ $S0 = concat $S0, '", return_data);'
+ v['ret_assign'] = $S0
+ has_ret_assign:
+
+ $I0 = exists v['func_call_assign']
+ if $I0 goto has_func_call_assign
+ v['func_call_assign'] = 'return_data = '
+ has_func_call_assign:
+
+ $I0 = exists v['temp_tmpl']
+ if $I0 goto has_temp_tmpl
+ $S0 = v['return_type']
+ $S0 = concat $S0, " t_%i"
+ v['temp_tmpl'] = $S0
+ has_temp_tmpl:
+
+ $I0 = exists v['fill_params_tmpl']
+ if $I0 goto has_fill_params_tmpl
+ v['fill_params_tmpl'] = ', &t_%i'
+ has_fill_params_tmpl:
+
+ $I0 = exists v['call_param_tmpl']
+ if $I0 goto has_call_param_tmpl
+ v['call_param_tmpl'] = 't_%i'
+ has_call_param_tmpl:
+
+ goto iter_loop
+ iter_end:
+
+ .return ()
+.end
+
+.sub 'sigtable_json'
+ .const string retv = <<'JSON'
+{
+ "p": { "as_proto": "void *",
+ "final_dest": "PMC * final_destination = PMCNULL;",
+ "temp_tmpl": "PMC *t_%i",
+ "sig_char": "P",
+ "call_param_tmpl": "PMC_IS_NULL((PMC*)t_%i) ? (void *)NULL : VTABLE_get_pointer(interp, t_%i)",
+ "ret_assign": "if (return_data != NULL) {
+ final_destination = pmc_new(interp, enum_class_UnManagedStruct);
+ VTABLE_set_pointer(interp, final_destination, return_data);
+ }
+ Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);" },
+ "i": { "as_proto": "int", "sig_char": "I",
+ "return_type": "INTVAL" },
+ "l": { "as_proto": "long", "sig_char": "I", "return_type": "INTVAL" },
+ "c": { "as_proto": "char", "sig_char": "I", "return_type": "INTVAL" },
+ "s": { "as_proto": "short", "sig_char": "I", "return_type": "INTVAL" },
+ "f": { "as_proto": "float", "sig_char": "N", "return_type": "FLOATVAL" },
+ "d": { "as_proto": "double", "sig_char": "N", "return_type": "FLOATVAL" },
+ "t": { "as_proto": "char *",
+ "final_dest": "STRING *final_destination;",
+ "ret_assign": "final_destination = Parrot_str_new(interp, return_data, 0);
+ Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
+ "sig_char": "S",
+ "temp_tmpl": "char *t_%i; STRING *ts_%i",
+ "fill_params_tmpl": ", &ts_%i",
+ "preamble_tmpl": "t_%i = ts_%i ? Parrot_str_to_cstring(interp, ts_%i) : (char *)NULL;",
+ "postamble_tmpl": "if (t_%i) Parrot_str_free_cstring(t_%i);" },
+ "v": { "as_proto": "void",
+ "return_type": "void *",
+ "sig_char": "v",
+ "ret_assign": "",
+ "func_call_assign": "" },
+ "P": { "as_proto": "PMC *", "sig_char": "P" },
+ "O": { "as_proto": "PMC *", "returns": "", "sig_char": "Pi" },
+ "J": { "as_proto": "PARROT_INTERP",
+ "returns": "",
+ "fill_params_tmpl": "",
+ "call_param_tmpl": "interp",
+ "temp_tmpl": "",
+ "sig_char": "" },
+ "S": { "as_proto": "STRING *", "sig_char": "S" },
+ "I": { "as_proto": "INTVAL", "sig_char": "I" },
+ "N": { "as_proto": "FLOATVAL", "sig_char": "N" },
+ "b": { "as_proto": "void *",
+ "as_return": "",
+ "sig_char": "S",
+ "temp_tmpl":"STRING *t_%i",
+ "call_param_tmpl": "Buffer_bufstart(t_%i)" },
+ "B": { "as_proto": "char **",
+ "as_return": "",
+ "sig_char": "S",
+ "fill_params_tmpl": ", &ts_%i",
+ "temp_tmpl": "char *t_%i; STRING *ts_%i",
+ "preamble_tmpl": "t_%i = ts_%i ? Parrot_str_to_cstring(interp, ts_%i) : (char *) NULL;",
+ "call_param_tmpl": "&t_%i",
+ "postamble_tmpl": "if (t_%i) Parrot_str_free_cstring(t_%i);" },
+ "2": { "as_proto": "short *",
+ "sig_char": "P",
+ "return_type": "short",
+ "ret_assign": "Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"I\", return_data);",
+ "temp_tmpl": "PMC *t_%i; short i_%i",
+ "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
+ "call_param_tmpl": "&i_%i",
+ "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
+ "3": { "as_proto": "int *",
+ "sig_char": "P",
+ "return_type": "int",
+ "ret_assign": "Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"I\", return_data);",
+ "temp_tmpl": "PMC *t_%i; int i_%i",
+ "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
+ "call_param_tmpl": "&i_%i",
+ "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
+ "4": { "as_proto": "long *",
+ "sig_char": "P",
+ "return_type": "long",
+ "ret_assign": "Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"I\", return_data);",
+ "temp_tmpl": "PMC *t_%i; long i_%i",
+ "preamble_tmpl": "i_%i = VTABLE_get_integer(interp, t_%i);",
+ "call_param_tmpl": "&i_%i",
+ "postamble_tmpl": "VTABLE_set_integer_native(interp, t_%i, i_%i);" },
+ "L": { "as_proto": "long *", "as_return": "" },
+ "T": { "as_proto": "char **", "as_return": "" },
+ "V": { "as_proto": "void **",
+ "as_return": "",
+ "sig_char": "P",
+ "temp_tmpl": "PMC *t_%i; void *v_%i",
+ "preamble_tmpl": "v_%i = VTABLE_get_pointer(interp, t_%i);",
+ "call_param_tmpl": "&v_%i",
+ "postamble_tmpl": "VTABLE_set_pointer(interp, t_%i, v_%i);" },
+ "@": { "as_proto": "PMC *", "as_return": "", "cname": "xAT_", "sig_char": "Ps" }
+}
+JSON
+ .return (retv)
+.end
+
+# }}}
+
+# utility fn's {{{
+
+.sub 'sprintf'
+ .param string tmpl
+ .param pmc args :slurpy
+ $S0 = sprintf tmpl, args
+ .return ($S0)
+.end
+
+.sub 'fill_tmpls_ascending_ints'
+ .param pmc tmpls
+ .local int idx, n
+
+ idx = 0
+ n = tmpls
+ loop:
+ if idx >= n goto end_loop
+ $S0 = tmpls[idx]
+ $I0 = 'printf_arity'($S0)
+ $P0 = 'xtimes'(idx, $I0)
+ $S1 = sprintf $S0, $P0
+ tmpls[idx] = $S1
+ inc idx
+ goto loop
+ end_loop:
+.end
+
+.sub 'printf_arity'
+ .param string tmpl
+
+ .local int count, idx
+ idx = 0
+ count = 0
+
+ loop:
+ idx = index tmpl, '%', idx
+ if idx < 0 goto end_loop
+
+ # check against '%%' escapes
+ $I0 = idx + 1
+ $S0 = substr tmpl, $I0, 1
+ unless $S0 == '%' goto is_valid_placeholder
+ idx = idx + 2 # skip both '%'s
+ goto loop
+ is_valid_placeholder:
+
+ inc idx
+ inc count
+ goto loop
+ end_loop:
+
+ .return (count)
+.end
+
+.sub 'xtimes'
+ .param pmc what
+ .param int times
+
+ .local pmc retv
+ retv = new ['ResizablePMCArray']
+ retv = times
+
+ $I0 = 0
+ loop:
+ if $I0 >= times goto end_loop
+ retv[$I0] = what
+ inc $I0
+ goto loop
+ end_loop:
+
+ .return (retv)
+.end
+
+.sub 'grep_for_true'
+ .param pmc input
+ .local pmc output
+ .local int i, n
+ output = new ['ResizableStringArray']
+ i = 0
+ n = input
+ loop:
+ if i >= n goto end_loop
+ $S0 = input[i]
+ unless $S0 goto end_cond
+ push output, $S0
+ end_cond:
+ inc i
+ goto loop
+ end_loop:
+ .return (output)
+.end
+
+# }}}
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Modified: branches/gc_encapsulate/tools/build/nativecall.pl
==============================================================================
--- branches/gc_encapsulate/tools/build/nativecall.pl Sun Feb 7 06:10:49 2010 (r43744)
+++ branches/gc_encapsulate/tools/build/nativecall.pl Sun Feb 7 06:12:55 2010 (r43745)
@@ -89,7 +89,6 @@
for (values %sig_table) {
if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} }
if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} }
- if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} }
if (not exists $_->{ret_assign} and exists $_->{sig_char}) {
$_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
. $_->{sig_char} . '", return_data);';
@@ -151,7 +150,7 @@
push @nci_defs, create_function(
$sig, $ret,
$args, [@arg],
- $ret_sig->{as_return}, $ret_sig->{return_type_decl},
+ $ret_sig->{as_return}, $ret_sig->{return_type},
$ret_sig->{func_call_assign}, $ret_sig->{final_dest},
$ret_sig->{ret_assign}, \@temps,
\@fill_params, \@extra_preamble, \@extra_postamble,
@@ -162,7 +161,7 @@
print {$NCI} create_function(
$sig, $ret,
$args, [@arg],
- $ret_sig->{as_return}, $ret_sig->{return_type_decl},
+ $ret_sig->{as_return}, $ret_sig->{return_type},
$ret_sig->{func_call_assign}, $ret_sig->{final_dest},
$ret_sig->{ret_assign}, \@temps,
\@fill_params, \@extra_preamble, \@extra_postamble,
Deleted: branches/gc_encapsulate/tools/dev/cc_flags.pl
==============================================================================
--- branches/gc_encapsulate/tools/dev/cc_flags.pl Sun Feb 7 06:12:55 2010 (r43744)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,148 +0,0 @@
-#! perl
-################################################################################
-# Copyright (C) 2001-2003, Parrot Foundation.
-# $Id$
-################################################################################
-
-=head1 NAME
-
-tools/dev/cc_flags.pl - Process compiler flags
-
-=head1 SYNOPSIS
-
- % perl tools/dev/cc_flags.pl transform compiler flags
-
-=head1 DESCRIPTION
-
-This script is used in a F<Makefile> to process the flags to pass to the
-compiler for each C file.
-
-See F<config/gen/makefiles/CFLAGS.in> for the transformation file format.
-
-=head1 SEE ALSO
-
-F<config/gen/cflags/root.in>.
-
-=cut
-
-################################################################################
-
-use strict;
-use warnings;
-
-my $verbose;
-
-if ($ARGV[0] eq '-v') {
- $verbose = 1;
- shift;
-}
-
-my $cflags = shift;
-
-open my $F, '<', $cflags or die "open $cflags: $!\n";
-
-my @options;
-
-while (<$F>) {
- chomp;
- s/#.*//;
- next unless /\S/;
-
- my $regex;
- if (s/^\{(.*?)\}\s*//) {
- next unless $1;
- $regex = qr/$1/;
- }
- elsif (s/^(\S+)\s*//) {
- $regex = qr/^\Q$1\E$/;
- }
- else {
- die "syntax error in $cflags: line $., $_\n";
- }
-
- for ( ; ; ) {
- if (s/^([-+])\{(.*?)\}\s*//) {
- next unless $2;
- my ( $sign, $options ) = ( $1, $2 );
- foreach my $option ( split ' ', $options ) {
- push @options, [ $regex, $sign, $option ];
- }
- }
- elsif (s{s(.)(.*?)\1(.*?)\1([imsx]*)\s*}{}) {
- my $mod = "";
- $mod = "(?$4)" if $4;
-
- push @options, [ $regex, 's', "$mod$2", $3 ];
- }
- elsif (/\S/) {
- die "syntax error in $cflags: line $., $_\n";
- }
- else {
- last;
- }
- }
-}
-
-my ($cfile) = grep /\.c$/, @ARGV;
-
-my ( $inject_point, $where );
-
-foreach (@ARGV) {
- last if $_ eq '';
- ++$where;
-}
-if ($where) {
-
- # Found a "" - remove it
- splice @ARGV, $where, 1;
- $inject_point = $where;
-}
-else {
- $inject_point = 1;
-}
-
-if ($cfile) {
- foreach my $option (@options) {
- if ( $cfile =~ $option->[0] ) {
- if ( $option->[1] eq '+' ) {
- splice @ARGV, $inject_point, 0, $option->[2];
- }
- elsif ( $option->[1] eq '-' ) {
- @ARGV = grep { $_ ne $option->[2] } @ARGV;
- }
- else {
- foreach my $arg (@ARGV) {
- $arg =~ s/$option->[2]/$option->[3]/;
- }
- }
- }
- }
-
- # print "@ARGV\n";
-
- # Visual C++ already prints the source file name...
- if ( $ARGV[0] =~ /cl(?:\.exe)?/i ) {
-
- # ...but only the file name, so we print the path
- # to the directory first
- if ( $cfile =~ /(.*[\/\\])/ ) {
- print $1;
- }
- }
- else {
- print "$cfile\n";
- }
-}
-
-if ($verbose) {
- print join ' ', @ARGV;
-}
-
-exit system(@ARGV) / 256;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list