[svn:parrot] r49689 - in branches/embed_api: . compilers/imcc include/parrot src
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Tue Oct 26 23:43:42 UTC 2010
Author: whiteknight
Date: Tue Oct 26 23:43:42 2010
New Revision: 49689
URL: https://trac.parrot.org/parrot/changeset/49689
Log:
creating a new branch to start working on the new embedding API stuff
Added:
branches/embed_api/ (props changed)
- copied from r49679, trunk/
Replaced:
branches/embed_api/DEPRECATED.pod
- copied unchanged from r49680, trunk/DEPRECATED.pod
branches/embed_api/compilers/imcc/main.c
- copied unchanged from r49680, trunk/compilers/imcc/main.c
branches/embed_api/include/parrot/embed.h
- copied unchanged from r49680, trunk/include/parrot/embed.h
branches/embed_api/src/embed.c
- copied unchanged from r49680, trunk/src/embed.c
Modified:
branches/embed_api/src/global_setup.c
branches/embed_api/src/main.c
Copied: branches/embed_api/DEPRECATED.pod (from r49680, trunk/DEPRECATED.pod)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/embed_api/DEPRECATED.pod Tue Oct 26 23:43:42 2010 (r49689, copy of r49680, trunk/DEPRECATED.pod)
@@ -0,0 +1,520 @@
+# $Id$
+
+=head1 Purpose
+
+Provide a list of deprecated and experimental items in parrot.
+All items in this list should have a corresponding Trac ticket[1].
+
+=head1 Experimental Status
+
+These features are not considered supported, even though they may
+have shipped in a supported release of parrot[2]. Use them at your own
+risk, as they can be removed or changed in any release. These
+items are marked below with C<[experimental]>.
+
+=head1 Deprecated Status
+
+Please see F<docs/project/support_policy.pod> for the parrot
+project's policy regarding deprecated features.
+
+Each item shows the first release in which it is eligible for removal, e.g.
+C<[eligible in 1.5]>. If the release listed is one that has already
+shipped, this feature may be removed in B<any> upcoming release, and
+you should no longer rely on it.
+
+If you find a feature you once used was removed after a deprecation
+cycle, L<https://trac.parrot.org/parrot/wiki/Deprecation>. Otherwise
+please open a documentation ticket via Trac[1].
+
+=head1 Are you using any Deprecated Features?
+
+When running parrot, you can receive warnings about deprecations.
+Either run parrot with the C<-w> option to enable all warnings, or
+deprecations specifically by including this snippet:
+
+=begin PIR_FRAGMENT
+
+ .include 'warnings.pasm'
+ warningson .PARROT_WARNINGS_DEPRECATED_FLAG
+
+=end PIR_FRAGMENT
+
+=head1 PMCS
+
+=over 4
+
+=item GzipHandle [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/1580>
+
+=item PackfileDebug [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/1599>
+
+=item CodeString [eligible in 2.7]
+
+L<http://trac.parrot.org/parrot/ticket/1633>
+
+=item multiple dispatch within core PMCs [eligible in 1.1]
+
+L<https://trac.parrot.org/parrot/ticket/452>
+
+=item Method stdhandle in ParrotInterpreter [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/264>
+
+=item Overriding vtable invoke in PIR objects [experimental]
+
+The VTABLE invoke in object.pmc puts SELF at the start of the
+signature call arguments when there is no current object and is
+not already here. This allows the usage of $P0() instead of $P0($P0).
+
+L<https://trac.parrot.org/parrot/ticket/103>
+
+=item UnManagedStruct handling nested structure [eligible in 2.4]
+
+UnManagedStruct will be simplified to only support flat structures. This means
+that elements which themselves have structure - struct pointers and function
+pointers will be stored as C<void *> and C<void (*)(void)> respectively. To use
+these, they will need to be cast to the appropriate signature on access.
+
+L<https://trac.parrot.org/parrot/ticket/1551>
+
+=item UnManagedStruct initializer structure [eligible in 2.4]
+
+The initializer structure will cease to be an array of triples. In stead, an
+array of flags (no counts or offsets), or a string representation of the same
+information may be used.
+
+L<https://trac.parrot.org/parrot/ticket/1552>
+
+=item UnManagedStruct get_integer, set_integer_native [eligible in 2.4]
+
+These will no longer refer to the byte length of the buffer, but to the number
+of times the struct is repeated; emulating an array of structs.
+
+L<https://trac.parrot.org/parrot/ticket/1553>
+
+=item ManagedStruct reallocations based on shape changes [eligible in 2.4]
+
+Since shape changes may simply be used for re-interpreting data, and may also
+occur in several steps, re-allocating after any one shape change may be
+undesirable. In stead, an explicit allocate/reallocate method will be provided.
+
+L<https://trac.parrot.org/parrot/ticket/1554>
+
+=item Auto-vivification of nested aggregates [eligible in 2.4]
+
+E.g.
+
+ $P0 = new ['Hash']
+ $S1 = $P0['foo';'bar';'baz']
+
+will not auto-vivify nested hashes and return PMCNULL early.
+
+L<https://trac.parrot.org/parrot/ticket/1561>
+
+=item Method unescape on String [experimental]
+
+This is a helper method for testing of Parrot_str_unescape_string.
+
+L<https://trac.parrot.org/parrot/ticket/1628>
+
+=item logical_* vtables [eligiblie in 2.7]
+
+These can be replaced by C<get_bool> and intval ops unless you're using them for
+things that aren't really logical ops (don't do that!).
+
+Logical vtables are removed in r49012, and logical ops on PMCs are converted to
+use C<get_bool> internally. Rakudo seems to depend on logical ops on PMCs.
+
+L<https://trac.parrot.org/parrot/ticket/1655>
+
+=item Method getpid on ParrotInterpreter [experimental]
+
+Used to test the experimental function Parrot_getpid
+
+L<https://trac.parrot.org/parrot/ticket/1564>
+
+=back
+
+=head1 Opcodes
+
+=over 4
+
+=item charset, charsetname, find_charset, trans_charset [eligible in 2.10]
+
+L<https://trac.parrot.org/parrot/ticket/1778>
+
+These opcodes will be removed. The corresponding encoding opcodes should be
+used instead.
+
+=item fixed_8 encoding [eligible in 2.10]
+
+L<https://trac.parrot.org/parrot/ticket/1778>
+
+The 'fixed_8' encoding is going away. Use 'ascii' instead. If you want to test
+for a fixed_8 encoding, you have to compare the encoding to 'ascii',
+'iso-8859-1' and 'binary' separately.
+
+=item open and close opcodes will be removed [eligible in 2.7]
+
+L<https://trac.parrot.org/parrot/ticket/1697>
+
+These opcodes will be removed. The open/close methods on File or
+the FileHandle PMC should be used instead.
+
+=item get_addr and set_addr [eligible in 1.5]
+
+L<https://trac.parrot.org/parrot/ticket/218>
+
+These opcodes are being repurposed. They will always return a unique memory
+address of the PMC. Uses of get_addr and set_addr that would set label values
+for Sub, Exception, and related PMC types will instead be handled by
+get_label and set_label.
+
+=item get_results opcode order and features [eligible in 2.1]
+
+get_results no longer used to fetch exception object.
+
+L<https://trac.parrot.org/parrot/ticket/1406>
+
+=item GC_SYS_NAME option to interpinfo_s_i [experimental]
+
+Ability to get the string name of the current GC core from the interpinfo_s_i.
+See r43900 and r43904 for details.
+
+L<https://trac.parrot.org/parrot/ticket/1581>
+
+=item NCI_FB_CB and NCI_FB_UD in iglobals [experimental]
+
+Hooks allowing a runtime-loadable dynamic frame builder.
+
+L<https://trac.parrot.org/parrot/ticket/1582>
+
+=item loadlib_p_s_p [experimental]
+
+Ability to use non-default dynamic loading behaviour.
+
+L<https://trac.parrot.org/parrot/ticket/1583>
+
+=item new_callback_p_p_p_s [eligible in 2.4]
+
+To be replaced with new_callback_p_p_p_p_s.
+
+L<https://trac.parrot.org/parrot/ticket/1548>
+
+=item dlfunc and new_callback signature string format [eligible in 2.4]
+
+These will be changed to allow more flexibility in types.
+
+L<https://trac.parrot.org/parrot/ticket/1565>
+
+=item find_lex [eligible in 2.4]
+
+find_lex will not throw exception for non-existing lexicals.
+
+L<https://trac.parrot.org/parrot/ticket/1207>
+
+=item inplace string updates. [eligible in 2.4]
+
+All "inplace" string update ops are deprecated. E.g. "chopn_s", etc.
+Part of COW removal.
+
+L<https://trac.parrot.org/parrot/ticket/1540>
+
+=item find_codepoint [experimental]
+
+Intended to replace the CodeString charname_to_ord method.
+
+L<https://trac.parrot.org/parrot/ticket/1629>
+
+=item All opcodes that modify non-argument registers. [eligible in 2.7]
+
+E.g. "cleari", etc.
+
+L<https://trac.parrot.org/parrot/ticket/1642>
+
+=item exchange [eligible in 2.7]
+
+This op is too low level for Parrot in its current form.
+
+L<https://trac.parrot.org/parrot/ticket/1643>
+
+=item finalize [experimental]
+
+Finalize exception handler, unrolling inner runloops if needed.
+
+L<https://trac.parrot.org/parrot/ticket/1635>
+
+=item logical PMC ops [eligible in 2.7]
+
+These fall out from the logical vtables deprecation.
+
+L<https://trac.parrot.org/parrot/ticket/1655>
+
+=item errorson, errorsoff operations [eligible in 2.10]
+
+The C<.PARROT_ERRORS_GLOBAL_FLAG> flag will be eliminated. It is not used by Parrot.
+
+=back
+
+=head1 Bytecode
+
+=over 4
+
+=item packfile structure [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/451>
+
+=item opcode numbering [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/451>
+
+=item PMC numbering [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/451>
+
+=back
+
+=head1 Debugger
+
+Assigning to registers [experimental]
+
+=head1 PIR syntax
+
+=over 4
+
+=item Assignment syntax with opcodes [eligible in 1.1]
+
+L<https://trac.parrot.org/parrot/ticket/906>
+
+=item continuation-based ExceptionHandlers [eligible in 2.1]
+
+L<https://trac.parrot.org/parrot/ticket/1091>
+
+=item implicit optional named parameters [eligible in 2.1]
+
+L<https://trac.parrot.org/parrot/ticket/1103>
+
+=item :unique_reg flag [eligible in 2.7]
+
+L<https://trac.parrot.org/parrot/ticket/1622>
+
+=item .nci_call [eligible in 2.7]
+
+As of the latest PCC changes, there is nothing special about calling an NCI sub.
+
+L<https://trac.parrot.org/parrot/ticket/1623>
+
+=item .meth_call [eligible in 2.7]
+
+As of the latest PCC changes, this does nothing different from '.call'.
+
+L<https://trac.parrot.org/parrot/ticket/1624>
+
+=item :main Sub behaviour and selection. [eligible in 2.7]
+
+Currently, if no :main sub is found, the first .sub in a file is used as
+main. Also, arguments are passed to the main sub regardless of the .param
+declarations in that sub.
+
+After this change, if no sub is marked with :main, an exception will be
+raised. Multiple :main declarations will be still be allowed, and all but the
+first will be ignored.
+
+This change will also force all subs, including :main, to have their
+arguments checked - to allow an arbitrary number of arguments, have
+this be the only .param declaration in the sub.
+
+ .param pmc args :slurpy
+
+
+L<https://trac.parrot.org/parrot/ticket/1033>
+L<https://trac.parrot.org/parrot/ticket/1704>
+L<https://trac.parrot.org/parrot/ticket/1705>
+
+=back
+
+=head1 Functions
+
+=over 4
+
+=item mmd_cvt_to_types [eligible in 1.1]
+
+L<https://trac.parrot.org/parrot/ticket/907>
+
+=item C API coding standards cleanup [eligible in 1.1]
+
+All C API functions that aren't currently named according to the
+'Parrot_<system>_*' scheme will be renamed. A list of renamed
+functions will be kept in the ticket at:
+
+L<https://trac.parrot.org/parrot/ticket/443>
+
+=item PMC Attributes Allocation Functions [experimental]
+
+ Parrot_gc_allocate_pmc_attributes
+ Parrot_gc_free_pmc_attributes
+
+These items and related helper functions are added as experimental support
+for L<https://trac.parrot.org/parrot/ticket/1506>
+
+=item STRING Out parameters in Parrot_str_* functions [eligible in 2.1]
+
+All STRING modification functions will return a STRING pointer; capture and use
+this rather than relying on in-place modification of an existing pointer.
+
+L<https://trac.parrot.org/parrot/ticket/1584>
+
+=item STRING COW [eligible in 2.4]
+
+COW strings are to be removed. All "inplace" string modification
+functions and all "inplace" string ops are deprecated.
+
+L<https://trac.parrot.org/parrot/ticket/1540>
+
+=item Parrot_str_unescape_string [experimental]
+
+This function is an experimental addition to enhance and maybe replace
+Parrot_str_unescape
+
+L<https://trac.parrot.org/parrot/ticket/1628>
+
+=item Parrot_getpid [experimental]
+
+Get process id, experimental.
+
+L<https://trac.parrot.org/parrot/ticket/1564>
+
+=item Parrot_load_bytecode_file [experimental]
+
+Load a .pbc file into the interpreter. Experimental.
+
+=back
+
+=head1 Compiler tools
+
+=head2 Parrot Grammar Engine (PGE)
+
+=over 4
+
+=item Action methods in rules
+
+Per Synopsis 5, all regexes will have an implied {*} token at the
+end which cause invocation of an action method if a C<:action>
+object is supplied.
+
+L<https://trac.parrot.org/parrot/ticket/843>
+
+=back
+
+=head2 Parrot Compiler Toolkit
+
+=over 4
+
+=item PCT::HLLCompiler stages [eligible in 1.1]
+
+The interface of various methods for adding, removing, and modifying
+the list stages in a PCT::HLLCompiler object is subject to change.
+The existing actual stages will remain; only the mechanism for specifying
+the order of individual stages is likely to change.
+
+L<https://trac.parrot.org/parrot/ticket/462>
+
+=item PCT::HLLCompiler from Perl 5's Test::Harness [eligible in 1.1]
+
+In order to facilitate using PCT::HLLCompiler with test harnesses,
+the C<command_line> method of PCT::HLLCompiler object exits silently
+if it detects that it is being run in a sample run from Perl's
+Test::Harness. Currently this detection is done by checking the
+second command line argument for "@INC"; future releases may
+use a different detection mechanism or eliminate it altogether.
+
+L<https://trac.parrot.org/parrot/ticket/463>
+
+=item PAST::Val node generation [eligible in 1.5]
+
+The PAST::Compiler may generate the code for PAST::Val nodes
+(i.e., constants) at the beginning of the block (Parrot sub) instead
+of the location where they occur in the PAST tree.
+
+L<https://trac.parrot.org/parrot/ticket/868>
+
+=item Meta-model implementation used by PCT [eligible in 2.7]
+
+PCT is set to switch to a new meta-model implementation for its classes
+and objects. This will most likely only affect those who rely on the
+interface of what is returned from .HOW, or rely on PCT objects exhibiting
+various other peculiarities of the P6object implementation. (Even when that
+is the case, the HOW API will not be changing too drastically, so for most
+PCT users there should be little to no upheavel.)
+
+=back
+
+=head1 Parrot library
+
+=over 4
+
+=item PARROT_LIBRARY and PARROT_INCLUDE environment variables [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/1429>
+
+A way to provide an equivalent of -L and -I parrot command line options
+to language that doesn't support it.
+
+=item Protoobject [eligible in 2.7]
+
+Use P6Object instead.
+
+L<http://trac.parrot.org/parrot/ticket/1337>
+
+=item Archive::Tar & Archive::Zip [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/1598>
+
+=item LWP, HTTP::Message, URI & URI::Escape [experimental]
+
+L<http://trac.parrot.org/parrot/ticket/1637>
+
+=item JSON and Config;JSON [eligible in 1.5]
+
+L<https://trac.parrot.org/parrot/ticket/508>
+
+=item Cross-HLL library loading [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/754>
+
+=item OpenGL bindings and libraries [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/852>
+
+=back
+
+=head1 Experimental
+
+=over 4
+
+=item Threads and Parallelism [experimental]
+
+L<https://trac.parrot.org/parrot/ticket/1601>
+
+=back
+
+=head1 Footnotes
+
+=over 4
+
+=item 1
+
+L<Trac|http://trac.parrot.org/> is parrot's primary issue tracking system.
+
+=item 2
+
+For an item to be considered experimental, it can B<never> have shipped in
+a supported release without the C<[experimental]> tag; otherwise, it must be
+deprecated normally before removal or incompatible change.
+
+=back
+
+=cut
Copied: branches/embed_api/compilers/imcc/main.c (from r49680, trunk/compilers/imcc/main.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/embed_api/compilers/imcc/main.c Tue Oct 26 23:43:42 2010 (r49689, copy of r49680, trunk/compilers/imcc/main.c)
@@ -0,0 +1,710 @@
+/*
+ * $Id$
+ *
+ * Intermediate Code Compiler for Parrot.
+ *
+ * Copyright (C) 2002 Melvin Smith <melvin.smith at mindspring.com>
+ * Copyright (C) 2003-2010, Parrot Foundation.
+ */
+
+/*
+
+=head1 NAME
+
+compilers/imcc/main.c
+
+=head1 DESCRIPTION
+
+IMCC helpers.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "imc.h"
+#include "parrot/embed.h"
+#include "parrot/longopt.h"
+#include "parrot/imcc.h"
+#include "parrot/runcore_api.h"
+#include "pmc/pmc_callcontext.h"
+#include "pbc.h"
+#include "parser.h"
+
+extern int yydebug;
+
+/* HEADERIZER HFILE: none */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void compile_to_bytecode(PARROT_INTERP,
+ ARGIN(const char * const sourcefile),
+ ARGIN_NULLOK(const char * const output_file),
+ ARGIN(yyscan_t yyscanner))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4);
+
+static void determine_input_file_type(PARROT_INTERP,
+ ARGIN(const char * const sourcefile),
+ ARGIN(yyscan_t yyscanner))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+static void determine_output_file_type(PARROT_INTERP,
+ ARGIN(const char *output_file))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void do_pre_process(PARROT_INTERP, yyscan_t yyscanner)
+ __attribute__nonnull__(1);
+
+static void imcc_get_optimization_description(
+ const PARROT_INTERP,
+ int opt_level,
+ ARGMOD(char *opt_desc))
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*opt_desc);
+
+static void imcc_parseflags(PARROT_INTERP,
+ int argc,
+ ARGIN(const char **argv))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+static void imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_PURE_FUNCTION
+static int is_all_hex_digits(ARGIN(const char *s))
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_compile_to_bytecode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sourcefile) \
+ , PARROT_ASSERT_ARG(yyscanner))
+#define ASSERT_ARGS_determine_input_file_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sourcefile) \
+ , PARROT_ASSERT_ARG(yyscanner))
+#define ASSERT_ARGS_determine_output_file_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(output_file))
+#define ASSERT_ARGS_do_pre_process __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_imcc_get_optimization_description \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(opt_desc))
+#define ASSERT_ARGS_imcc_parseflags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(argv))
+#define ASSERT_ARGS_imcc_write_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(output_file))
+#define ASSERT_ARGS_is_all_hex_digits __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(s))
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+
+#define OPT_GC_DEBUG 128
+#define OPT_DESTROY_FLAG 129
+#define OPT_HELP_DEBUG 130
+#define OPT_PBC_OUTPUT 131
+#define OPT_RUNTIME_PREFIX 132
+
+/*
+
+=item C<static int is_all_hex_digits(const char *s)>
+
+Tests all characters in a string are hexadecimal digits.
+Returns 1 if true, 0 as soon as a non-hex found
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_PURE_FUNCTION
+static int
+is_all_hex_digits(ARGIN(const char *s))
+{
+ ASSERT_ARGS(is_all_hex_digits)
+ for (; *s; s++)
+ if (!isxdigit(*s))
+ return 0;
+ return 1;
+}
+
+/*
+
+=item C<static void imcc_parseflags(PARROT_INTERP, int argc, const char **argv)>
+
+Parse flags ans set approptiate state(s)
+
+=cut
+
+*/
+
+static void
+imcc_parseflags(PARROT_INTERP, int argc, ARGIN(const char **argv))
+{
+ ASSERT_ARGS(imcc_parseflags)
+ struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
+
+ /* default state: run pbc */
+ SET_STATE_RUN_PBC(interp);
+
+ while (longopt_get(interp, argc, argv, Parrot_cmd_options(), &opt) > 0) {
+ switch (opt.opt_id) {
+ case 'd':
+ if (opt.opt_arg && is_all_hex_digits(opt.opt_arg)) {
+ IMCC_INFO(interp)->debug = strtoul(opt.opt_arg, NULL, 16);
+ }
+ else {
+ IMCC_INFO(interp)->debug++;
+ }
+ break;
+ case 'w':
+ /* FIXME It's not best way to set warnings... */
+ Parrot_setwarnings(interp, PARROT_WARNINGS_ALL_FLAG);
+ IMCC_INFO(interp)->imcc_warn = 1;
+ break;
+ case 'G':
+ IMCC_INFO(interp)->gc_off = 1;
+ break;
+ case 'a':
+ SET_STATE_PASM_FILE(interp);
+ break;
+ case 'r':
+ if (STATE_RUN_PBC(interp))
+ SET_STATE_RUN_FROM_FILE(interp);
+ SET_STATE_RUN_PBC(interp);
+ break;
+ case 'c':
+ SET_STATE_LOAD_PBC(interp);
+ break;
+ case 'v':
+ IMCC_INFO(interp)->verbose++;
+ break;
+ case 'y':
+ yydebug = 1;
+ break;
+ case 'E':
+ SET_STATE_PRE_PROCESS(interp);
+ break;
+ case 'o':
+ UNSET_STATE_RUN_PBC(interp);
+ interp->output_file = opt.opt_arg;
+ break;
+
+ case OPT_PBC_OUTPUT:
+ UNSET_STATE_RUN_PBC(interp);
+ SET_STATE_WRITE_PBC(interp);
+ if (!interp->output_file)
+ interp->output_file = "-";
+ break;
+
+ case 'O':
+ if (!opt.opt_arg) {
+ IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
+ break;
+ }
+ if (strchr(opt.opt_arg, 'p'))
+ IMCC_INFO(interp)->optimizer_level |= OPT_PASM;
+ if (strchr(opt.opt_arg, 'c'))
+ IMCC_INFO(interp)->optimizer_level |= OPT_SUB;
+
+ /* currently not ok due to different register allocation */
+ if (strchr(opt.opt_arg, '1')) {
+ IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
+ }
+ if (strchr(opt.opt_arg, '2')) {
+ IMCC_INFO(interp)->optimizer_level |= (OPT_PRE | OPT_CFG);
+ }
+ break;
+
+ default:
+ /* skip already processed arguments */
+ break;
+ }
+ }
+}
+
+/*
+
+=item C<static void do_pre_process(PARROT_INTERP, yyscan_t yyscanner)>
+
+Pre-processor step. Turn parser's output codes into Parrot instructions.
+
+=cut
+
+*/
+
+static void
+do_pre_process(PARROT_INTERP, yyscan_t yyscanner)
+{
+ ASSERT_ARGS(do_pre_process)
+ int c;
+ YYSTYPE val;
+
+ IMCC_push_parser_state(interp);
+ c = yylex(&val, yyscanner, interp); /* is reset at end of while loop */
+ while (c) {
+ switch (c) {
+ case EMIT: printf(".emit\n"); break;
+ case EOM: printf(".eom\n"); break;
+ case LOCAL: printf(".local "); break;
+ case ARG: printf(".set_arg "); break;
+ case SUB: printf(".sub "); break;
+ case ESUB: printf(".end"); break;
+ case RESULT: printf(".result "); break;
+ case RETURN: printf(".return "); break;
+ case NAMESPACE: printf(".namespace "); break;
+ case CONST: printf(".const "); break;
+ case PARAM: printf(".param "); break;
+ case MACRO: printf(".macro "); break;
+
+ case GOTO: printf("goto ");break;
+ case IF: printf("if ");break;
+ case UNLESS: printf("unless ");break;
+ case INTV: printf("int ");break;
+ case FLOATV: printf("float ");break;
+ case STRINGV: printf("string ");break;
+ case PMCV: printf("pmc ");break;
+ case SHIFT_LEFT: printf(" << ");break;
+ case SHIFT_RIGHT: printf(" >> ");break;
+ case SHIFT_RIGHT_U: printf(" >>> ");break;
+ case LOG_AND: printf(" && ");break;
+ case LOG_OR: printf(" || ");break;
+ case LOG_XOR: printf(" ~~ ");break;
+ case RELOP_LT: printf(" < ");break;
+ case RELOP_LTE: printf(" <= ");break;
+ case RELOP_GT: printf(" > ");break;
+ case RELOP_GTE: printf(" >= ");break;
+ case RELOP_EQ: printf(" == ");break;
+ case RELOP_NE: printf(" != ");break;
+ case POW: printf(" ** ");break;
+ case COMMA: printf(", ");break;
+ case LABEL: printf("%s:\t", val.s); break;
+ case PCC_BEGIN: printf(".begin_call "); break;
+ case PCC_END: printf(".end_call"); break;
+ case PCC_SUB: printf(".pccsub "); break;
+ case PCC_CALL: printf(".call "); break;
+ case PCC_BEGIN_RETURN: printf(".begin_return"); break;
+ case PCC_END_RETURN: printf(".end_return"); break;
+ case PCC_BEGIN_YIELD: printf(".begin_yield"); break;
+ case PCC_END_YIELD: printf(".end_yield"); break;
+ case FILECOMMENT: printf("setfile \"%s\"\n", val.s); break;
+ case LINECOMMENT: printf("setline %d\n", val.t); break;
+
+ case PLUS_ASSIGN: printf("+= ");break;
+ case MINUS_ASSIGN: printf("-= ");break;
+ case MUL_ASSIGN: printf("*= ");break;
+ case DIV_ASSIGN: printf("/= ");break;
+ case MOD_ASSIGN: printf("%%= ");break;
+ case FDIV_ASSIGN: printf("//= ");break;
+ case BAND_ASSIGN: printf("&= ");break;
+ case BOR_ASSIGN: printf("|= ");break;
+ case BXOR_ASSIGN: printf("~= ");break;
+ case SHR_ASSIGN: printf(">>= ");break;
+ case SHL_ASSIGN: printf("<<= ");break;
+ case SHR_U_ASSIGN: printf(">>>= ");break;
+ case CONCAT_ASSIGN: printf(".= ");break;
+
+ case MAIN: printf(":main");break;
+ case LOAD: printf(":load");break;
+ case INIT: printf(":init");break;
+ case IMMEDIATE: printf(":immediate");break;
+ case POSTCOMP: printf(":postcomp");break;
+ case ANON: printf(":anon");break;
+ case OUTER: printf(":outer");break;
+ case NEED_LEX: printf(":lex");break;
+ case METHOD: printf(":method");break;
+
+ case UNIQUE_REG: printf(":unique_reg");break;
+ case ADV_FLAT: printf(":flat");break;
+ case ADV_SLURPY: printf(":slurpy");break;
+ case ADV_OPTIONAL: printf(":optional");break;
+ case ADV_OPT_FLAG: printf(":opt_flag");break;
+ case ADV_NAMED: printf(":named");break;
+ case ADV_ARROW: printf("=>");break;
+
+ default:
+ if (c < 255)
+ printf("%c", c);
+ else
+ printf("%s ", val.s);
+ break;
+ }
+ c = yylex(&val, yyscanner, interp);
+ }
+ printf("\n");
+ fflush(stdout);
+
+ return;
+}
+
+/*
+
+=item C<static void imcc_get_optimization_description(const PARROT_INTERP, int
+opt_level, char *opt_desc)>
+
+Create list (opt_desc[]) describing optimisation flags.
+
+=cut
+
+*/
+
+static void
+imcc_get_optimization_description(const PARROT_INTERP, int opt_level, ARGMOD(char *opt_desc))
+{
+ ASSERT_ARGS(imcc_get_optimization_description)
+ int i = 0;
+
+ if (opt_level & (OPT_PRE | OPT_CFG))
+ opt_desc[i++] = '2';
+ else
+ if (opt_level & OPT_PRE)
+ opt_desc[i++] = '1';
+
+ if (opt_level & OPT_PASM)
+ opt_desc[i++] = 'p';
+ if (opt_level & OPT_SUB)
+ opt_desc[i++] = 'c';
+
+ opt_desc[i] = '\0';
+ return;
+}
+
+/*
+
+=item C<void imcc_run_pbc(PARROT_INTERP, const char *output_file, int argc,
+const char **argv)>
+
+Write out or run Parrot bytecode.
+
+=cut
+
+*/
+
+void
+imcc_run_pbc(PARROT_INTERP, ARGIN_NULLOK(const char *output_file),
+ int argc, ARGIN(const char **argv))
+{
+ /* ASSERT_ARGS(imcc_run_pbc) */
+
+ IMCC_info(interp, 1, "Running...\n");
+
+ /* runs :init functions */
+ PackFile_fixup_subs(interp, PBC_IMMEDIATE, NULL);
+ PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
+ PackFile_fixup_subs(interp, PBC_MAIN, NULL);
+
+ Parrot_runcode(interp, argc, argv);
+}
+
+/*
+
+=item C<static void imcc_write_pbc(PARROT_INTERP, const char *output_file)>
+
+Output packed bytecode file.
+
+=cut
+
+*/
+
+static void
+imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
+{
+ ASSERT_ARGS(imcc_write_pbc)
+ size_t size;
+ opcode_t *packed;
+ FILE *fp;
+
+ IMCC_info(interp, 1, "Writing %s\n", output_file);
+
+ size = PackFile_pack_size(interp, interp->code->base.pf) *
+ sizeof (opcode_t);
+ IMCC_info(interp, 1, "packed code %d bytes\n", size);
+ packed = (opcode_t*) mem_sys_allocate(size);
+ PackFile_pack(interp, interp->code->base.pf, packed);
+ if (STREQ(output_file, "-"))
+ fp = stdout;
+ else if ((fp = fopen(output_file, "wb")) == NULL)
+ IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
+ "Couldn't open %s\n", output_file);
+
+ if ((1 != fwrite(packed, size, 1, fp)))
+ IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
+ "Couldn't write %s\n", output_file);
+ fclose(fp);
+ IMCC_info(interp, 1, "%s written.\n", output_file);
+ mem_sys_free(packed);
+}
+
+/*
+
+=item C<static void determine_input_file_type(PARROT_INTERP, const char * const
+sourcefile, yyscan_t yyscanner)>
+
+Read in the source and determine whether it's Parrot bytecode or PASM
+
+=cut
+
+*/
+
+static void
+determine_input_file_type(PARROT_INTERP, ARGIN(const char * const sourcefile),
+ ARGIN(yyscan_t yyscanner))
+{
+ ASSERT_ARGS(determine_input_file_type)
+
+ /* Read in the source and check the file extension for the input type;
+ a file extension .pbc means it's parrot bytecode;
+ a file extension .pasm means it's parrot assembly (PASM);
+ otherwise, it's assumed to be PIR.
+ */
+ if (STREQ(sourcefile, "-")) {
+ imc_yyin_set(stdin, yyscanner);
+ }
+ else {
+ const char * const ext = strrchr(sourcefile, '.');
+
+ if (ext && (STREQ(ext, ".pbc"))) { /* a PBC file */
+ SET_STATE_LOAD_PBC(interp);
+ UNSET_STATE_WRITE_PBC(interp);
+ }
+ else if (!STATE_LOAD_PBC(interp)) {
+ if (!(imc_yyin_set(fopen(sourcefile, "r"), yyscanner))) {
+ IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
+ "Error reading source file %s.\n",
+ sourcefile);
+ }
+
+ if (ext && STREQ(ext, ".pasm"))
+ SET_STATE_PASM_FILE(interp);
+ }
+ }
+}
+
+/*
+
+=item C<static void determine_output_file_type(PARROT_INTERP, const char
+*output_file)>
+
+Decide what kind of file we are to output.
+
+=cut
+
+*/
+
+static void
+determine_output_file_type(PARROT_INTERP, ARGIN(const char *output_file))
+{
+ ASSERT_ARGS(determine_output_file_type)
+ const char * const ext = strrchr(output_file, '.');
+
+ if (ext) {
+ if (STREQ(ext, ".pbc"))
+ SET_STATE_WRITE_PBC(interp);
+ }
+}
+
+/*
+
+=item C<static void compile_to_bytecode(PARROT_INTERP, const char * const
+sourcefile, const char * const output_file, yyscan_t yyscanner)>
+
+Compile source code into bytecode (or die trying).
+
+=cut
+
+*/
+
+static void
+compile_to_bytecode(PARROT_INTERP,
+ ARGIN(const char * const sourcefile),
+ ARGIN_NULLOK(const char * const output_file),
+ ARGIN(yyscan_t yyscanner))
+{
+ ASSERT_ARGS(compile_to_bytecode)
+ PackFile *pf;
+ const int per_pbc = STATE_WRITE_PBC(interp) || STATE_RUN_PBC(interp);
+ const int opt_level = IMCC_INFO(interp)->optimizer_level;
+
+ /* Shouldn't be more than five, but five extra is cheap */
+ char opt_desc[10];
+
+ imcc_get_optimization_description(interp, opt_level, opt_desc);
+
+ IMCC_info(interp, 1, "using optimization '-O%s' (%x) \n",
+ opt_desc, opt_level);
+
+ pf = PackFile_new(interp, 0);
+ Parrot_pbc_load(interp, pf);
+
+ IMCC_push_parser_state(interp);
+ IMCC_INFO(interp)->state->file = mem_sys_strdup(sourcefile);
+
+ emit_open(interp, per_pbc, per_pbc ? NULL : output_file);
+
+ IMCC_info(interp, 1, "Starting parse...\n");
+
+ IMCC_INFO(interp)->state->pasm_file = STATE_PASM_FILE(interp) ? 1 : 0;
+
+ imcc_run_compilation(interp, yyscanner);
+ if (IMCC_INFO(interp)->error_code) {
+ char * const error_str = Parrot_str_to_cstring(interp,
+ IMCC_INFO(interp)->error_message);
+
+ IMCC_INFO(interp)->error_code=IMCC_FATAL_EXCEPTION;
+ fprintf(stderr, "error:imcc:%s", error_str);
+ IMCC_print_inc(interp);
+ Parrot_str_free_cstring(error_str);
+ Parrot_exit(interp, IMCC_FATAL_EXCEPTION);
+ }
+
+ imc_cleanup(interp, yyscanner);
+
+ fclose(imc_yyin_get(yyscanner));
+
+ IMCC_info(interp, 1, "%ld lines compiled.\n", IMCC_INFO(interp)->line);
+ if (per_pbc && !IMCC_INFO(interp)->write_pbc)
+ PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
+}
+
+/*
+
+=item C<int imcc_run(PARROT_INTERP, const char *sourcefile, int argc, const char
+**argv)>
+
+Entry point of IMCC, as invoked by Parrot's main function.
+Compile source code (if required), write bytecode file (if required)
+and run. This function always returns 0.
+
+=cut
+
+*/
+
+int
+imcc_run(PARROT_INTERP, ARGIN(const char *sourcefile), int argc,
+ ARGIN(const char **argv))
+{
+ yyscan_t yyscanner;
+ const char * const output_file = interp->output_file;
+
+ imcc_parseflags(interp, argc, argv);
+
+ /* PMCs in IMCC_INFO won't get marked */
+ Parrot_block_GC_mark(interp);
+ Parrot_block_GC_sweep(interp);
+
+ yylex_init_extra(interp, &yyscanner);
+
+ /* Figure out what kind of source file we have -- if we have one */
+ if (!sourcefile || !*sourcefile)
+ IMCC_fatal_standalone(interp, 1, "main: No source file specified.\n");
+ else
+ determine_input_file_type(interp, sourcefile, yyscanner);
+
+ if (STATE_PRE_PROCESS(interp)) {
+ do_pre_process(interp, yyscanner);
+ Parrot_destroy(interp);
+ yylex_destroy(yyscanner);
+
+ return 0;
+ }
+
+ /* Do we need to produce an output file? If so, what type? */
+ if (output_file) {
+ determine_output_file_type(interp, output_file);
+
+ if (STREQ(sourcefile, output_file) && !STREQ(sourcefile, "-"))
+ IMCC_fatal_standalone(interp, 1, "main: outputfile is sourcefile\n");
+ }
+
+ IMCC_INFO(interp)->write_pbc = STATE_WRITE_PBC(interp) ? 1 : 0;
+
+ if (IMCC_INFO(interp)->verbose) {
+ IMCC_info(interp, 1, "debug = 0x%x\n", IMCC_INFO(interp)->debug);
+ IMCC_info(interp, 1, "Reading %s\n",
+ imc_yyin_get(yyscanner) == stdin ? "stdin":sourcefile);
+ }
+
+ /* If the input file is Parrot bytecode, then we simply read it
+ into a packfile, which Parrot then loads */
+ if (STATE_LOAD_PBC(interp)) {
+ const int loaded = Parrot_load_bytecode_file(interp, sourcefile);
+ if (!loaded)
+ IMCC_fatal_standalone(interp, 1, "main: Packfile loading failed\n");
+ }
+ else
+ compile_to_bytecode(interp, sourcefile, output_file, yyscanner);
+
+ /* Produce a PBC output file, if one was requested */
+ if (STATE_WRITE_PBC(interp)) {
+ if (!output_file) {
+ IMCC_fatal_standalone(interp, 1,
+ "main: NULL output_file when trying to write .pbc\n");
+ }
+ imcc_write_pbc(interp, output_file);
+
+ /* If necessary, load the file written above */
+ if (STATE_RUN_FROM_FILE(interp) && !STREQ(output_file, "-")) {
+ PackFile *pf;
+
+ IMCC_info(interp, 1, "Loading %s\n", output_file);
+ pf = Parrot_pbc_read(interp, output_file, 0);
+ if (!pf)
+ IMCC_fatal_standalone(interp, 1, "Packfile loading failed\n");
+ Parrot_pbc_load(interp, pf);
+ SET_STATE_LOAD_PBC(interp);
+ }
+ }
+
+ /* tear down the compilation context */
+ if (IMCC_INFO(interp)->imcc_warn)
+ PARROT_WARNINGS_on(interp, PARROT_WARNINGS_ALL_FLAG);
+ else
+ PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
+
+ if (!IMCC_INFO(interp)->gc_off) {
+ Parrot_unblock_GC_mark(interp);
+ Parrot_unblock_GC_sweep(interp);
+ }
+
+ yylex_destroy(yyscanner);
+
+ /* should the bytecode be run */
+ if (STATE_RUN_PBC(interp))
+ return 1;
+ else
+ return 0;
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/embed_api/include/parrot/embed.h (from r49680, trunk/include/parrot/embed.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/embed_api/include/parrot/embed.h Tue Oct 26 23:43:42 2010 (r49689, copy of r49680, trunk/include/parrot/embed.h)
@@ -0,0 +1,227 @@
+/* embed.h
+ * Copyright (C) 2001-2010, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ * Overview:
+ * This is the Parrot embedding system--the only part of Parrot that
+ * the outside world should see.
+ * References:
+ * embed.c, docs/embed.pod.
+ */
+
+#ifndef PARROT_EMBED_H_GUARD
+#define PARROT_EMBED_H_GUARD
+
+#include "parrot/core_types.h" /* types used */
+#include "parrot/compiler.h" /* compiler capabilities */
+#include "parrot/config.h" /* PARROT_VERSION, PARROT_JIT_CAPABLE... */
+#include "parrot/interpreter.h" /* give us the interpreter flags */
+#include "parrot/warnings.h" /* give us the warnings flags */
+
+typedef int Parrot_warnclass;
+
+typedef enum {
+ enum_DIS_BARE = 1,
+ enum_DIS_HEADER = 2
+} Parrot_disassemble_options;
+
+/* Parrot_set_config_hash exists in *_config.o (e.g install_config.o),
+ so if you make this call then you will need to link with it in
+ addition to libparrot */
+void Parrot_set_config_hash(void);
+
+PARROT_EXPORT
+PARROT_DOES_NOT_RETURN
+PARROT_COLD
+void
+Parrot_exit(PARROT_INTERP, int status);
+
+PARROT_EXPORT
+void Parrot_destroy(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+
+/* HEADERIZER BEGIN: src/embed.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_EXPORT
+void Parrot_clear_debug(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_clear_flag(PARROT_INTERP, Parrot_Int flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_clear_trace(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+Parrot_PMC Parrot_compile_string(PARROT_INTERP,
+ Parrot_String type,
+ ARGIN(const char *code),
+ ARGOUT(Parrot_String *error))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4)
+ FUNC_MODIFIES(*error);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_Opcode * Parrot_debug(PARROT_INTERP,
+ ARGIN(Parrot_Interp debugger),
+ ARGIN(Parrot_Opcode *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+void Parrot_disassemble(PARROT_INTERP,
+ ARGIN_NULLOK(const char *outfile),
+ Parrot_disassemble_options options)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_init_stacktop(PARROT_INTERP, ARGIN(void *stack_top))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+int Parrot_load_bytecode_file(PARROT_INTERP, ARGIN(const char *filename))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_MALLOC
+Parrot_Interp Parrot_new(ARGIN_NULLOK(Parrot_Interp parent));
+
+PARROT_EXPORT
+void Parrot_pbc_fixup_loaded(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_pbc_load(PARROT_INTERP, ARGIN(Parrot_PackFile pf))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_PackFile Parrot_pbc_read(PARROT_INTERP,
+ ARGIN_NULLOK(const char *fullname),
+ const int debug)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_run_native(PARROT_INTERP, native_func_t func)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_runcode(PARROT_INTERP, int argc, ARGIN(const char **argv))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+void Parrot_set_debug(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_set_flag(PARROT_INTERP, Parrot_Int flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_set_trace(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_UInt Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_Int Parrot_test_flag(PARROT_INTERP, Parrot_Int flag)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_UInt Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_Parrot_clear_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_clear_flag __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_clear_trace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_compile_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(code) \
+ , PARROT_ASSERT_ARG(error))
+#define ASSERT_ARGS_Parrot_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(debugger) \
+ , PARROT_ASSERT_ARG(pc))
+#define ASSERT_ARGS_Parrot_disassemble __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_init_stacktop __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(stack_top))
+#define ASSERT_ARGS_Parrot_load_bytecode_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(filename))
+#define ASSERT_ARGS_Parrot_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+#define ASSERT_ARGS_Parrot_pbc_fixup_loaded __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_pbc_load __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(pf))
+#define ASSERT_ARGS_Parrot_pbc_read __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_run_native __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_runcode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(argv))
+#define ASSERT_ARGS_Parrot_set_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_set_executable_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_set_flag __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_set_run_core __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_set_trace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_setwarnings __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_test_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_test_flag __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_test_trace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/embed.c */
+
+
+#endif /* PARROT_EMBED_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/embed_api/src/embed.c (from r49680, trunk/src/embed.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/embed_api/src/embed.c Tue Oct 26 23:43:42 2010 (r49689, copy of r49680, trunk/src/embed.c)
@@ -0,0 +1,1175 @@
+/*
+Copyright (C) 2001-2010, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/embed.c - The Parrot embedding interface
+
+=head1 DESCRIPTION
+
+This file implements the Parrot embedding interface.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+#include "parrot/extend.h"
+#include "parrot/oplib/ops.h"
+#include "pmc/pmc_sub.h"
+#include "pmc/pmc_callcontext.h"
+#include "parrot/runcore_api.h"
+#include "parrot/oplib/core_ops.h"
+
+#include "../compilers/imcc/imc.h"
+
+#include "embed.str"
+
+/* HEADERIZER HFILE: include/parrot/embed.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void print_constant_table(PARROT_INTERP, ARGIN(PMC *output))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void print_debug(PARROT_INTERP, SHIM(int status), SHIM(void *p))
+ __attribute__nonnull__(1);
+
+PARROT_CANNOT_RETURN_NULL
+static PMC* set_current_sub(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_CANNOT_RETURN_NULL
+static PMC* setup_argv(PARROT_INTERP, int argc, ARGIN(const char **argv))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+#define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(output))
+#define ASSERT_ARGS_print_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_setup_argv __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(argv))
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+extern int Parrot_exec_run;
+
+/*
+
+=item C<Parrot_Interp Parrot_new(Parrot_Interp parent)>
+
+Returns a new Parrot interpreter.
+
+The first created interpreter (C<parent> is C<NULL>) is the last one
+to get destroyed.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_MALLOC
+Parrot_Interp
+Parrot_new(ARGIN_NULLOK(Parrot_Interp parent))
+{
+ ASSERT_ARGS(Parrot_new)
+ /* inter_create.c:make_interpreter builds a new Parrot_Interp. */
+ return make_interpreter(parent, PARROT_NO_FLAGS);
+}
+
+
+/*
+
+=item C<void Parrot_init_stacktop(PARROT_INTERP, void *stack_top)>
+
+Initializes the new interpreter when it hasn't been initialized before.
+
+Additionally sets the stack top, so that Parrot objects created
+in inner stack frames will be visible during GC stack walking code.
+B<stack_top> should be the address of an automatic variable in the caller's
+stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
+frames so that they are not destroyed during GC runs.
+
+Use this function when you call into Parrot before entering a run loop.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_init_stacktop(PARROT_INTERP, ARGIN(void *stack_top))
+{
+ ASSERT_ARGS(Parrot_init_stacktop)
+ interp->lo_var_ptr = stack_top;
+ init_world_once(interp);
+}
+
+
+/*
+
+=item C<void Parrot_set_flag(PARROT_INTERP, Parrot_Int flag)>
+
+Sets on any of the following flags, specified by C<flag>, in the interpreter:
+
+Flag Effect
+C<PARROT_BOUNDS_FLAG> enable bounds checking
+C<PARROT_PROFILE_FLAG> enable profiling,
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_flag(PARROT_INTERP, Parrot_Int flag)
+{
+ ASSERT_ARGS(Parrot_set_flag)
+ /* These two macros (from interpreter.h) do exactly what they look like. */
+
+ Interp_flags_SET(interp, flag);
+ switch (flag) {
+ case PARROT_BOUNDS_FLAG:
+ case PARROT_PROFILE_FLAG:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
+ break;
+ default:
+ break;
+ }
+}
+
+
+/*
+
+=item C<void Parrot_set_debug(PARROT_INTERP, Parrot_UInt flag)>
+
+Set a debug flag: C<PARROT_DEBUG_FLAG>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_debug(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_set_debug)
+ interp->debug_flags |= flag;
+}
+
+
+/*
+
+=item C<void Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)>
+
+Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
+C<parrot> binary).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)
+{
+ ASSERT_ARGS(Parrot_set_executable_name)
+ PMC * const name_pmc = Parrot_pmc_new(interp, enum_class_String);
+ VTABLE_set_string_native(interp, name_pmc, name);
+ VTABLE_set_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_EXECUTABLE,
+ name_pmc);
+}
+
+
+/*
+
+=item C<void Parrot_set_trace(PARROT_INTERP, Parrot_UInt flag)>
+
+Set a trace flag: C<PARROT_TRACE_FLAG>
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_trace(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_set_trace)
+ Parrot_pcc_trace_flags_on(interp, interp->ctx, flag);
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
+}
+
+
+/*
+
+=item C<void Parrot_clear_flag(PARROT_INTERP, Parrot_Int flag)>
+
+Clears a flag in the interpreter.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_flag(PARROT_INTERP, Parrot_Int flag)
+{
+ ASSERT_ARGS(Parrot_clear_flag)
+ Interp_flags_CLEAR(interp, flag);
+}
+
+
+/*
+
+=item C<void Parrot_clear_debug(PARROT_INTERP, Parrot_UInt flag)>
+
+Clears a flag in the interpreter.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_debug(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_clear_debug)
+ interp->debug_flags &= ~flag;
+}
+
+
+/*
+
+=item C<void Parrot_clear_trace(PARROT_INTERP, Parrot_UInt flag)>
+
+Clears a flag in the interpreter.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_trace(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_clear_trace)
+ Parrot_pcc_trace_flags_off(interp, interp->ctx, flag);
+}
+
+
+/*
+
+=item C<Parrot_Int Parrot_test_flag(PARROT_INTERP, Parrot_Int flag)>
+
+Test the interpreter flags specified in C<flag>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_Int
+Parrot_test_flag(PARROT_INTERP, Parrot_Int flag)
+{
+ ASSERT_ARGS(Parrot_test_flag)
+ return Interp_flags_TEST(interp, flag);
+}
+
+
+/*
+
+=item C<Parrot_UInt Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)>
+
+Test the interpreter flags specified in C<flag>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_UInt
+Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_test_debug)
+ return interp->debug_flags & flag;
+}
+
+
+/*
+
+=item C<Parrot_UInt Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)>
+
+Test the interpreter flags specified in C<flag>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_PURE_FUNCTION
+Parrot_UInt
+Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)
+{
+ ASSERT_ARGS(Parrot_test_trace)
+ return Parrot_pcc_trace_flags_test(interp, interp->ctx, flag);
+}
+
+
+/*
+
+=item C<void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
+
+Sets the specified run core.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)
+{
+ ASSERT_ARGS(Parrot_set_run_core)
+ switch (core) {
+ case PARROT_SLOW_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
+ break;
+ case PARROT_FAST_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "fast"));
+ break;
+ case PARROT_EXEC_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "exec"));
+ break;
+ case PARROT_GC_DEBUG_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "gc_debug"));
+ break;
+ case PARROT_DEBUGGER_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger"));
+ break;
+ case PARROT_PROFILING_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "profiling"));
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "Invalid runcore requested\n");
+ }
+}
+
+
+/*
+
+=item C<void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)>
+
+Activates the given warnings.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)
+{
+ ASSERT_ARGS(Parrot_setwarnings)
+ /* Activates the given warnings. (Macro from warnings.h.) */
+ PARROT_WARNINGS_on(interp, wc);
+}
+
+
+/*
+
+=item C<Parrot_PackFile Parrot_pbc_read(PARROT_INTERP, const char *fullname,
+const int debug)>
+
+Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_PackFile
+Parrot_pbc_read(PARROT_INTERP, ARGIN_NULLOK(const char *fullname), const int debug)
+{
+ ASSERT_ARGS(Parrot_pbc_read)
+ PackFile *pf;
+ char *program_code;
+ FILE *io = NULL;
+ INTVAL is_mapped = 0;
+ INTVAL program_size;
+
+#ifdef PARROT_HAS_HEADER_SYSMMAN
+ int fd = -1;
+#endif
+
+ if (!fullname || STREQ(fullname, "-")) {
+ /* read from STDIN */
+ io = stdin;
+
+ /* read 1k at a time */
+ program_size = 0;
+ }
+ else {
+ STRING * const fs = Parrot_str_new_init(interp, fullname, strlen(fullname),
+ Parrot_default_encoding_ptr, 0);
+
+ /* can't read a file that doesn't exist */
+ if (!Parrot_stat_info_intval(interp, fs, STAT_EXISTS)) {
+ Parrot_io_eprintf(interp, "Parrot VM: Can't stat %s, code %i.\n",
+ fullname, errno);
+ return NULL;
+ }
+
+ /* we may need to relax this if we want to read bytecode from pipes */
+ if (!Parrot_stat_info_intval(interp, fs, STAT_ISREG)) {
+ Parrot_io_eprintf(interp,
+ "Parrot VM: '%s', is not a regular file %i.\n",
+ fullname, errno);
+ return NULL;
+ }
+
+ program_size = Parrot_stat_info_intval(interp, fs, STAT_FILESIZE);
+
+#ifndef PARROT_HAS_HEADER_SYSMMAN
+ io = fopen(fullname, "rb");
+
+ if (!io) {
+ Parrot_io_eprintf(interp, "Parrot VM: Can't open %s, code %i.\n",
+ fullname, errno);
+ return NULL;
+ }
+#endif /* PARROT_HAS_HEADER_SYSMMAN */
+
+ }
+#ifdef PARROT_HAS_HEADER_SYSMMAN
+again:
+#endif
+ /* if we've opened a file (or stdin) with PIO, read it in */
+ if (io) {
+ char *cursor;
+ size_t chunk_size = program_size > 0 ? program_size : 1024;
+ INTVAL wanted = program_size;
+ size_t read_result;
+
+ program_code = mem_gc_allocate_n_typed(interp, chunk_size, char);
+ cursor = program_code;
+ program_size = 0;
+
+ while ((read_result = fread(cursor, 1, chunk_size, io)) > 0) {
+ program_size += read_result;
+
+ if (program_size == wanted)
+ break;
+
+ chunk_size = 1024;
+ program_code = mem_gc_realloc_n_typed(interp, program_code,
+ program_size + chunk_size, char);
+
+ if (!program_code) {
+ Parrot_io_eprintf(interp,
+ "Parrot VM: Could not reallocate buffer "
+ "while reading packfile from PIO.\n");
+ fclose(io);
+ return NULL;
+ }
+
+ cursor = (char *)(program_code + program_size);
+ }
+
+ if (ferror(io)) {
+ Parrot_io_eprintf(interp,
+ "Parrot VM: Problem reading packfile from PIO: code %d.\n",
+ ferror(io));
+ fclose(io);
+ mem_gc_free(interp, program_code);
+ return NULL;
+ }
+
+ fclose(io);
+ }
+ else {
+ /* if we've gotten here, we opted not to use PIO to read the file.
+ * use mmap */
+
+#ifdef PARROT_HAS_HEADER_SYSMMAN
+
+ /* check that fullname isn't NULL, just in case */
+ if (!fullname)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Trying to open a NULL filename");
+
+ fd = open(fullname, O_RDONLY | O_BINARY);
+
+ if (!fd) {
+ Parrot_io_eprintf(interp, "Parrot VM: Can't open %s, code %i.\n",
+ fullname, errno);
+ return NULL;
+ }
+
+ program_code = (char *)mmap(0, (size_t)program_size,
+ PROT_READ, MAP_SHARED, fd, (off_t)0);
+
+ if (program_code == (void *)MAP_FAILED) {
+ Parrot_warn(interp, PARROT_WARNINGS_IO_FLAG,
+ "Parrot VM: Can't mmap file %s, code %i.\n",
+ fullname, errno);
+
+ /* try again, now with IO reading the file */
+ io = fopen(fullname, "rb");
+ if (!io) {
+ Parrot_io_eprintf(interp,
+ "Parrot VM: Can't open %s, code %i.\n", fullname, errno);
+ return NULL;
+ }
+ goto again;
+ }
+
+ is_mapped = 1;
+
+#else /* PARROT_HAS_HEADER_SYSMMAN */
+
+ Parrot_io_eprintf(interp, "Parrot VM: uncaught error occurred reading "
+ "file or mmap not available.\n");
+ return NULL;
+
+#endif /* PARROT_HAS_HEADER_SYSMMAN */
+
+ }
+
+ /* Now that we have the bytecode, let's unpack it. */
+
+ pf = PackFile_new(interp, is_mapped);
+
+ /* Make the cmdline option available to the unpackers */
+ pf->options = debug;
+
+ if (!PackFile_unpack(interp, pf, (opcode_t *)program_code,
+ (size_t)program_size)) {
+ Parrot_io_eprintf(interp, "Parrot VM: Can't unpack packfile %s.\n",
+ fullname);
+ return NULL;
+ }
+
+ /* Set :main routine */
+ if (!(pf->options & PFOPT_HEADERONLY))
+ do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
+
+ /* Prederefing the sub/the bytecode is done in switch_to_cs before
+ * actual usage of the segment */
+
+#ifdef PARROT_HAS_HEADER_SYSMMAN
+ /* the man page states that it's ok to close a mmaped file */
+ if (fd >= 0)
+ close(fd);
+#endif
+
+ return pf;
+}
+
+
+/*
+
+=item C<void Parrot_pbc_load(PARROT_INTERP, Parrot_PackFile pf)>
+
+Loads the C<PackFile> returned by C<Parrot_pbc_read()>.
+
+TODO: We don't do any error or sanity checking here. The packfile pointer
+should be a valid packfile, not simply a non-null pointer
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pbc_load(PARROT_INTERP, ARGIN(Parrot_PackFile pf))
+{
+ ASSERT_ARGS(Parrot_pbc_load)
+ if (!pf) {
+ Parrot_io_eprintf(interp, "Invalid packfile\n");
+ return;
+ }
+
+ interp->initial_pf = pf;
+ interp->code = pf->cur_cs;
+}
+
+/*
+
+=item C<int Parrot_load_bytecode_file(PARROT_INTERP, const char *filename)>
+
+Load a bytecode file into the interpreter by name. Returns C<0> on failure,
+Success otherwise. Writes error information to the interpreter's error file
+stream.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+int
+Parrot_load_bytecode_file(PARROT_INTERP, ARGIN(const char *filename))
+{
+ PackFile * const pf = Parrot_pbc_read(interp, filename, 0);
+
+ if (!pf)
+ return 0;
+ Parrot_pbc_load(interp, pf);
+ return 1;
+}
+
+/*
+
+=item C<void Parrot_pbc_fixup_loaded(PARROT_INTERP)>
+
+Fixups after pbc loading
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pbc_fixup_loaded(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_pbc_fixup_loaded)
+ PackFile_fixup_subs(interp, PBC_LOADED, NULL);
+}
+
+
+/*
+
+=item C<static PMC* setup_argv(PARROT_INTERP, int argc, const char **argv)>
+
+Creates and returns C<ARGS> array PMC.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static PMC*
+setup_argv(PARROT_INTERP, int argc, ARGIN(const char **argv))
+{
+ ASSERT_ARGS(setup_argv)
+ PMC * const userargv = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ INTVAL i;
+
+ if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
+ Parrot_io_eprintf(interp,
+ "*** Parrot VM: Setting up ARGV array. Current argc: %d ***\n",
+ argc);
+ }
+
+ /* immediately anchor pmc to root set */
+ VTABLE_set_pmc_keyed_int(interp, interp->iglobals,
+ (INTVAL)IGLOBALS_ARGV_LIST, userargv);
+
+ for (i = 0; i < argc; ++i) {
+ /* Run through argv, adding everything to @ARGS. */
+ STRING * const arg = Parrot_str_new_init(interp, argv[i], strlen(argv[i]),
+ Parrot_utf8_encoding_ptr, PObj_external_FLAG);
+
+ if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG))
+ Parrot_io_eprintf(interp, "\t%vd: %s\n", i, argv[i]);
+
+ VTABLE_push_string(interp, userargv, arg);
+ }
+
+ return userargv;
+}
+
+
+/*
+
+=item C<static void print_debug(PARROT_INTERP, int status, void *p)>
+
+Prints GC info.
+
+=cut
+
+*/
+
+static void
+print_debug(PARROT_INTERP, SHIM(int status), SHIM(void *p))
+{
+ ASSERT_ARGS(print_debug)
+ if (Interp_debug_TEST(interp, PARROT_MEM_STAT_DEBUG_FLAG)) {
+ /* Give souls brave enough to activate debugging an earful about GC. */
+
+ Parrot_io_eprintf(interp, "*** Parrot VM: Dumping GC info ***\n");
+ PDB_info(interp);
+ }
+}
+
+
+/*
+
+=item C<static PMC* set_current_sub(PARROT_INTERP)>
+
+Search the fixup table for a PMC matching the argument. On a match,
+set up the appropriate context.
+
+If no match, set up a dummy PMC entry. In either case, return a
+pointer to the PMC.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static PMC*
+set_current_sub(PARROT_INTERP)
+{
+ ASSERT_ARGS(set_current_sub)
+ PMC *new_sub_pmc;
+
+ PackFile_ByteCode * const cur_cs = interp->code;
+ PackFile_ConstTable * const ct = cur_cs->const_table;
+ STRING * const SUB = CONST_STRING(interp, "Sub");
+
+ opcode_t i;
+
+ /*
+ * Walk the fixup table. The first Sub-like entry should be our
+ * entry point with the address at our resume_offset.
+ */
+
+ for (i = 0; i < ct->pmc.const_count; i++) {
+ PMC *sub_pmc = ct->pmc.constants[i];
+ if (VTABLE_isa(interp, sub_pmc, SUB)) {
+ Parrot_Sub_attributes *sub;
+
+ PMC_get_sub(interp, sub_pmc, sub);
+ if (sub->seg == cur_cs) {
+ const size_t offs = sub->start_offs;
+
+ if (offs == interp->resume_offset) {
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
+ return sub_pmc;
+ }
+
+ break;
+ }
+ }
+ }
+
+ /* If we didn't find anything, put a dummy PMC into current_sub.
+ The default values set by SUb.init are appropiate for the
+ dummy, don't need additional settings. */
+ new_sub_pmc = Parrot_pmc_new(interp, enum_class_Sub);
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), new_sub_pmc);
+
+ return new_sub_pmc;
+}
+
+
+/*
+
+=item C<void Parrot_runcode(PARROT_INTERP, int argc, const char **argv)>
+
+Sets up C<ARGV> and runs the ops.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_runcode(PARROT_INTERP, int argc, ARGIN(const char **argv))
+{
+ ASSERT_ARGS(Parrot_runcode)
+ PMC *userargv, *main_sub;
+
+ /* Debugging mode nonsense. */
+ if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
+ if (Interp_flags_TEST(interp, PARROT_BOUNDS_FLAG)) {
+ Parrot_io_eprintf(interp,
+ "*** Parrot VM: Bounds checking enabled. ***\n");
+ }
+
+ if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG))
+ Parrot_io_eprintf(interp, "*** Parrot VM: Tracing enabled. ***\n");
+
+ Parrot_io_eprintf(interp, "*** Parrot VM: %Ss core ***\n",
+ interp->run_core->name);
+ }
+
+ /* Set up @ARGS (or whatever this language calls it) in userargv. */
+ userargv = setup_argv(interp, argc, argv);
+
+ /*
+ * If any profile information was gathered, print it out
+ * before exiting, then print debug infos if turned on.
+ */
+ Parrot_on_exit(interp, print_debug, NULL);
+
+ /* Let's kick the tires and light the fires--call interpreter.c:runops. */
+ main_sub = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
+
+ /* if no sub was marked being :main, we create a dummy sub with offset 0 */
+
+ if (!main_sub)
+ main_sub = set_current_sub(interp);
+
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), NULL);
+ Parrot_pcc_set_constants(interp, interp->ctx, interp->code->const_table);
+
+ Parrot_ext_call(interp, main_sub, "P->", userargv);
+}
+
+
+/*
+
+=item C<Parrot_Opcode * Parrot_debug(PARROT_INTERP, Parrot_Interp debugger,
+Parrot_Opcode *pc)>
+
+Runs the interpreter's bytecode in debugging mode.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_Opcode *
+Parrot_debug(PARROT_INTERP, ARGIN(Parrot_Interp debugger), ARGIN(Parrot_Opcode *pc))
+{
+ ASSERT_ARGS(Parrot_debug)
+ PDB_t * const pdb = debugger->pdb;
+
+ pdb->cur_opcode = pc;
+
+ PDB_init(debugger, NULL);
+
+ /* disassemble needs this for now */
+ /*
+ interp = pdb->debugee;
+ interp->pdb = pdb;
+ */
+ debugger->lo_var_ptr = interp->lo_var_ptr;
+
+ PDB_disassemble(interp, NULL);
+
+ while (!(pdb->state & PDB_EXIT)) {
+ const char *command;
+
+ PDB_get_command(debugger);
+ command = pdb->cur_command;
+ PDB_run_command(debugger, command);
+ }
+
+ return NULL;
+}
+
+
+/*
+
+=item C<static void print_constant_table(PARROT_INTERP, PMC *output)>
+
+Prints the contents of the constants table.
+
+=cut
+
+*/
+static void
+print_constant_table(PARROT_INTERP, ARGIN(PMC *output))
+{
+ ASSERT_ARGS(print_constant_table)
+ const PackFile_ConstTable *ct = interp->code->const_table;
+ INTVAL i;
+
+ /* TODO: would be nice to print the name of the file as well */
+ Parrot_io_fprintf(interp, output, "=head1 Constant-table\n\n");
+
+ for (i = 0; i < ct->num.const_count; i++)
+ Parrot_io_fprintf(interp, output, "NUM_CONST(%d): %f\n", i, ct->num.constants[i]);
+
+ for (i = 0; i < ct->str.const_count; i++)
+ Parrot_io_fprintf(interp, output, "STR_CONST(%d): %S\n", i, ct->str.constants[i]);
+
+ for (i = 0; i < ct->pmc.const_count; i++) {
+ PMC *c = ct->pmc.constants[i];
+ Parrot_io_fprintf(interp, output, "PMC_CONST(%d): ", i);
+
+ switch (c->vtable->base_type) {
+ /* each PBC file has a ParrotInterpreter, but it can't
+ * stringify by itself */
+ case enum_class_ParrotInterpreter:
+ Parrot_io_fprintf(interp, output, "'ParrotInterpreter'");
+ break;
+
+ /* FixedIntegerArrays used for signatures, handy to print */
+ case enum_class_FixedIntegerArray:
+ {
+ const INTVAL n = VTABLE_elements(interp, c);
+ INTVAL j;
+ Parrot_io_fprintf(interp, output, "[");
+
+ for (j = 0; j < n; ++j) {
+ const INTVAL val = VTABLE_get_integer_keyed_int(interp, c, j);
+ Parrot_io_fprintf(interp, output, "%d", val);
+ if (j < n - 1)
+ Parrot_io_fprintf(interp, output, ",");
+ }
+ Parrot_io_fprintf(interp, output, "]");
+ break;
+ }
+ case enum_class_NameSpace:
+ case enum_class_String:
+ case enum_class_Key:
+ case enum_class_ResizableStringArray:
+ {
+ STRING * const s = VTABLE_get_string(interp, c);
+ if (s)
+ Parrot_io_fprintf(interp, output, "%Ss", s);
+ break;
+ }
+ case enum_class_Sub:
+ Parrot_io_fprintf(interp, output, "%S", VTABLE_get_string(interp, c));
+ break;
+ default:
+ Parrot_io_fprintf(interp, output, "(PMC constant)");
+ break;
+ }
+
+ Parrot_io_fprintf(interp, output, "\n");
+ }
+
+ Parrot_io_fprintf(interp, output, "\n=cut\n\n");
+}
+
+
+/*
+
+=item C<void Parrot_disassemble(PARROT_INTERP, const char *outfile,
+Parrot_disassemble_options options)>
+
+Disassembles and prints out the interpreter's bytecode.
+
+This is used by the Parrot disassembler.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_disassemble(PARROT_INTERP,
+ ARGIN_NULLOK(const char *outfile), Parrot_disassemble_options options)
+{
+ ASSERT_ARGS(Parrot_disassemble)
+ PDB_line_t *line;
+ PDB_t * const pdb = mem_gc_allocate_zeroed_typed(interp, PDB_t);
+ int num_mappings = 0;
+ int curr_mapping = 0;
+ int op_code_seq_num = 0;
+ int debugs;
+ PMC *output;
+
+ if (outfile != NULL) {
+ output = Parrot_io_open(interp, PMCNULL,
+ Parrot_str_new(interp, outfile, 0),
+ Parrot_str_new_constant(interp, "tw"));
+ }
+ else
+ output = Parrot_io_stdhandle(interp, PIO_STDOUT_FILENO, PMCNULL);
+
+ interp->pdb = pdb;
+ pdb->cur_opcode = interp->code->base.data;
+
+ PDB_disassemble(interp, NULL);
+
+ line = pdb->file->line;
+ debugs = (interp->code->debugs != NULL);
+
+ print_constant_table(interp, output);
+ if (options & enum_DIS_HEADER)
+ return;
+
+ if (!(options & enum_DIS_BARE))
+ Parrot_io_fprintf(interp, output, "# %12s-%12s", "Seq_Op_Num", "Relative-PC");
+
+ if (debugs) {
+ if (!(options & enum_DIS_BARE))
+ Parrot_io_fprintf(interp, output, " %6s:\n", "SrcLn#");
+ num_mappings = interp->code->debugs->num_mappings;
+ }
+ else {
+ Parrot_io_fprintf(interp, output, "\n");
+ }
+
+ while (line->next) {
+ const char *c;
+
+ /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping,
+ * num_mappings, op_code_seq_num,
+ * interp->code->debugs->mappings[curr_mapping].offset); */
+
+ if (debugs && curr_mapping < num_mappings) {
+ if (op_code_seq_num == interp->code->debugs->mappings[curr_mapping].offset) {
+ const int filename_const_offset =
+ interp->code->debugs->mappings[curr_mapping].filename;
+ Parrot_io_fprintf(interp, output, "# Current Source Filename '%Ss'\n",
+ interp->code->const_table->str.constants[filename_const_offset]);
+ ++curr_mapping;
+ }
+ }
+
+ if (!(options & enum_DIS_BARE))
+ Parrot_io_fprintf(interp, output, "%012i-%012i",
+ op_code_seq_num, line->opcode - interp->code->base.data);
+
+ if (debugs && !(options & enum_DIS_BARE))
+ Parrot_io_fprintf(interp, output, " %06i: ",
+ interp->code->debugs->base.data[op_code_seq_num]);
+
+ /* If it has a label print it */
+ if (line->label)
+ Parrot_io_fprintf(interp, output, "L%li:\t", line->label->number);
+ else
+ Parrot_io_fprintf(interp, output, "\t");
+
+ c = pdb->file->source + line->source_offset;
+
+ while (c && *c != '\n')
+ Parrot_io_fprintf(interp, output, "%c", *(c++));
+
+ Parrot_io_fprintf(interp, output, "\n");
+ line = line->next;
+ ++op_code_seq_num;
+ }
+ if (outfile != NULL)
+ Parrot_io_close(interp, output);
+
+ return;
+}
+
+
+/*
+
+=item C<void Parrot_run_native(PARROT_INTERP, native_func_t func)>
+
+Runs the C function C<func> through the program C<[enternative, end]>. This
+ensures that the function runs with the same setup as in other run loops.
+
+This function is used in some of the source tests in F<t/src> which use
+the interpreter outside a runloop.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_run_native(PARROT_INTERP, native_func_t func)
+{
+ ASSERT_ARGS(Parrot_run_native)
+ op_lib_t *core_ops = PARROT_GET_CORE_OPLIB(interp);
+ PackFile * const pf = PackFile_new(interp, 0);
+ static opcode_t program_code[2] = {
+ 0, /* enternative */
+ 1 /* end */
+ };
+
+ static op_func_t op_func_table[2];
+ op_func_table[0] = core_ops->op_func_table[PARROT_OP_enternative];
+ op_func_table[1] = core_ops->op_func_table[PARROT_OP_end];
+
+
+ pf->cur_cs = (PackFile_ByteCode *)
+ (pf->PackFuncs[PF_BYTEC_SEG].new_seg)(interp, pf,
+ Parrot_str_new_constant(interp, "code"), 1);
+ pf->cur_cs->base.data = program_code;
+ pf->cur_cs->base.size = 2;
+ pf->cur_cs->op_func_table = op_func_table;
+ /* TODO fill out cur_cs with op_mapping */
+
+ Parrot_pbc_load(interp, pf);
+
+ run_native = func;
+
+ if (interp->code && interp->code->const_table)
+ Parrot_pcc_set_constants(interp, interp->ctx, interp->code->const_table);
+
+ runops(interp, interp->resume_offset);
+}
+
+
+/*
+
+=item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
+const char *code, Parrot_String *error)>
+
+Compiles a code string.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+Parrot_PMC
+Parrot_compile_string(PARROT_INTERP, Parrot_String type, ARGIN(const char *code),
+ ARGOUT(Parrot_String *error))
+{
+ ASSERT_ARGS(Parrot_compile_string)
+ /* For the benefit of embedders that do not load any pbc
+ * before compiling a string */
+
+ if (!interp->initial_pf) {
+ /* SIDE EFFECT: PackFile_new_dummy sets interp->initial_pf */
+ interp->initial_pf = PackFile_new_dummy(interp, CONST_STRING(interp, "compile_string"));
+ /* Assumption: there is no valid reason to fail to create it.
+ * If the assumption changes, replace the assertion with a
+ * runtime check */
+ PARROT_ASSERT(interp->initial_pf);
+ }
+
+ if (STRING_equal(interp, CONST_STRING(interp, "PIR"), type))
+ return IMCC_compile_pir_s(interp, code, error);
+
+ if (STRING_equal(interp, CONST_STRING(interp, "PASM"), type))
+ return IMCC_compile_pasm_s(interp, code, error);
+
+ *error = Parrot_str_new(interp, "Invalid interpreter type", 0);
+ return NULL;
+}
+
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<include/parrot/embed.h> and F<docs/embed.pod>.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/embed_api/src/global_setup.c
==============================================================================
--- trunk/src/global_setup.c Mon Oct 25 23:21:47 2010 (r49679)
+++ branches/embed_api/src/global_setup.c Tue Oct 26 23:43:42 2010 (r49689)
@@ -72,8 +72,10 @@
unsigned int parrot_config_size)
{
ASSERT_ARGS(Parrot_set_config_hash_internal)
- parrot_config_stored = parrot_config;
- parrot_config_size_stored = parrot_config_size;
+ if (parrot_config_stored == NULL && parrot_config != NULL) {
+ parrot_config_stored = parrot_config;
+ parrot_config_size_stored = parrot_config_size;
+ }
}
/*
Modified: branches/embed_api/src/main.c
==============================================================================
--- trunk/src/main.c Mon Oct 25 23:21:47 2010 (r49679)
+++ branches/embed_api/src/main.c Tue Oct 26 23:43:42 2010 (r49689)
@@ -130,7 +130,7 @@
Parrot_set_config_hash();
- interp = allocate_interpreter(NULL, PARROT_NO_FLAGS);
+ interp = Parrot_api_make_interpreter(NULL, PARROT_NO_FLAGS);
/* We parse the arguments, but first store away the name of the Parrot
executable, since parsing destroys that and we want to make it
@@ -141,7 +141,7 @@
parseflags_minimal(interp, argc, argv);
/* Now initialize interpreter */
- initialize_interpreter(interp, (void*)&stacktop);
+ Parrot_api_initialize_interpreter(interp, (void*)&stacktop);
/* Parse flags */
sourcefile = parseflags(interp, argc, argv, &pir_argc, &pir_argv, &core, &trace);
More information about the parrot-commits
mailing list