[svn:parrot] r38275 - in trunk: . config/auto config/gen/makefiles docs include/parrot src src/interp src/ops src/runcore t/tools/dev/searchops t/tools/ops2pm/samples
chromatic at svn.parrot.org
chromatic at svn.parrot.org
Wed Apr 22 20:06:33 UTC 2009
Author: chromatic
Date: Wed Apr 22 20:06:30 2009
New Revision: 38275
URL: https://trac.parrot.org/parrot/changeset/38275
Log:
Merged the headercleanup branch to trunk as of r38254.
Added:
trunk/include/parrot/runcore_api.h (props changed)
- copied unchanged from r38257, branches/headercleanup/include/parrot/runcore_api.h
trunk/include/parrot/runcore_trace.h (props changed)
- copied unchanged from r38257, branches/headercleanup/include/parrot/runcore_trace.h
trunk/src/interp/
- copied from r38257, branches/headercleanup/src/interp/
trunk/src/runcore/
- copied from r38257, branches/headercleanup/src/runcore/
Replaced:
trunk/src/interp/inter_cb.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/interp/inter_cb.c
trunk/src/interp/inter_create.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/interp/inter_create.c
trunk/src/interp/inter_misc.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/interp/inter_misc.c
trunk/src/runcore/cores.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/runcore/cores.c
trunk/src/runcore/main.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/runcore/main.c
trunk/src/runcore/trace.c (props changed)
- copied unchanged from r38257, branches/headercleanup/src/runcore/trace.c
Deleted:
trunk/src/inter_cb.c
trunk/src/inter_create.c
trunk/src/inter_misc.c
trunk/src/interp_guts.h
trunk/src/interpreter.c
trunk/src/runops_cores.c
trunk/src/runops_cores.h
trunk/src/trace.c
trunk/src/trace.h
Modified:
trunk/ (props changed)
trunk/MANIFEST
trunk/config/auto/cgoto.pm
trunk/config/gen/makefiles/root.in
trunk/docs/debug.pod
trunk/include/parrot/interpreter.h
trunk/src/debug.c
trunk/src/ops/core.ops
trunk/src/pic.c
trunk/t/tools/dev/searchops/samples.pm
trunk/t/tools/ops2pm/samples/core_ops.original
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/MANIFEST Wed Apr 22 20:06:30 2009 (r38275)
@@ -981,6 +981,8 @@
include/parrot/pobj.h [main]include
include/parrot/register.h [main]include
include/parrot/resources.h [main]include
+include/parrot/runcore_api.h [main]include
+include/parrot/runcore_trace.h [main]include
include/parrot/scheduler.h [main]include
include/parrot/scheduler_private.h [main]include
include/parrot/settings.h [main]include
@@ -1271,11 +1273,9 @@
src/global_setup.c []
src/hash.c []
src/hll.c []
-src/inter_cb.c []
-src/inter_create.c []
-src/inter_misc.c []
-src/interp_guts.h []
-src/interpreter.c []
+src/interp/inter_cb.c []
+src/interp/inter_create.c []
+src/interp/inter_misc.c []
src/io/api.c []
src/io/buffer.c []
src/io/core.c []
@@ -1452,8 +1452,9 @@
src/pmc/undef.pmc [devel]src
src/pmc/unmanagedstruct.pmc [devel]src
src/pmc_freeze.c []
-src/runops_cores.c []
-src/runops_cores.h []
+src/runcore/main.c []
+src/runcore/cores.c []
+src/runcore/trace.c []
src/scheduler.c []
src/spf_render.c []
src/spf_vtable.c []
@@ -1483,8 +1484,6 @@
src/string/unicode.h []
src/sub.c []
src/thread.c []
-src/trace.c []
-src/trace.h []
src/tsq.c []
src/utils.c []
src/vtable.tbl [devel]src
Modified: trunk/config/auto/cgoto.pm
==============================================================================
--- trunk/config/auto/cgoto.pm Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/config/auto/cgoto.pm Wed Apr 22 20:06:30 2009 (r38275)
@@ -66,7 +66,7 @@
$(SRC_DIR)/pmc/pmc_parrotlibrary.h
$(OPS_DIR)/core_ops_cgp$(O): $(GENERAL_H_FILES) $(OPS_DIR)/core_ops_cgp.c \
$(SRC_DIR)/pmc/pmc_parrotlibrary.h
-$(SRC_DIR)/runops_cores.c: $(INC_DIR)/oplib/core_ops_cgp.h
+$(SRC_DIR)/runcore/cores.c: $(INC_DIR)/oplib/core_ops_cgp.h
$(INC_DIR)/oplib/core_ops_cg.h: $(OPS_DIR)/core_ops_cg.c
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/config/gen/makefiles/root.in Wed Apr 22 20:06:30 2009 (r38275)
@@ -410,10 +410,9 @@
$(SRC_DIR)/hash$(O) \
$(SRC_DIR)/hll$(O) \
$(SRC_DIR)/call/pcc$(O) \
- $(SRC_DIR)/inter_cb$(O) \
- $(SRC_DIR)/inter_create$(O) \
- $(SRC_DIR)/inter_misc$(O) \
- $(SRC_DIR)/interpreter$(O) \
+ $(SRC_DIR)/interp/inter_cb$(O) \
+ $(SRC_DIR)/interp/inter_create$(O) \
+ $(SRC_DIR)/interp/inter_misc$(O) \
$(SRC_DIR)/call/ops$(O) \
$(SRC_DIR)/key$(O) \
$(SRC_DIR)/library$(O) \
@@ -430,7 +429,8 @@
$(SRC_DIR)/platform$(O) \
$(SRC_DIR)/pmc_freeze$(O) \
$(SRC_DIR)/pmc$(O) \
- $(SRC_DIR)/runops_cores$(O) \
+ $(SRC_DIR)/runcore/main$(O) \
+ $(SRC_DIR)/runcore/cores$(O) \
$(SRC_DIR)/scheduler$(O) \
$(SRC_DIR)/spf_render$(O) \
$(SRC_DIR)/spf_vtable$(O) \
@@ -438,7 +438,7 @@
$(SRC_DIR)/string/primitives$(O) \
$(SRC_DIR)/sub$(O) \
$(SRC_DIR)/thread$(O) \
- $(SRC_DIR)/trace$(O) \
+ $(SRC_DIR)/runcore/trace$(O) \
$(SRC_DIR)/tsq$(O) \
$(SRC_DIR)/utils$(O) \
$(SRC_DIR)/vtables$(O) \
@@ -594,9 +594,9 @@
$(SRC_DIR)/global_setup.str \
$(SRC_DIR)/hll.str \
$(SRC_DIR)/call/pcc.str \
- $(SRC_DIR)/inter_cb.str \
- $(SRC_DIR)/inter_create.str \
- $(SRC_DIR)/inter_misc.str \
+ $(SRC_DIR)/interp/inter_cb.str \
+ $(SRC_DIR)/interp/inter_create.str \
+ $(SRC_DIR)/interp/inter_misc.str \
$(SRC_DIR)/io/api.str \
$(SRC_DIR)/key.str \
$(SRC_DIR)/library.str \
@@ -1095,7 +1095,7 @@
#IF(platform_asm):
$(SRC_DIR)/core_pmcs$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/trace$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
+$(SRC_DIR)/runcore/trace$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
$(SRC_DIR)/debug$(O) : $(GENERAL_H_FILES) $(INC_DIR)/debugger.h \
$(SRC_DIR)/debug.str $(SRC_DIR)/pmc/pmc_key.h $(SRC_DIR)/pmc/pmc_continuation.h
@@ -1123,21 +1123,21 @@
$(SRC_DIR)/extend$(O) : $(GENERAL_H_FILES) $(INC_DIR)/extend.h \
$(SRC_DIR)/pmc/pmc_sub.h
-$(SRC_DIR)/interpreter$(O) : $(SRC_DIR)/interpreter.c $(GENERAL_H_FILES) \
+$(SRC_DIR)/runcore/main$(O) : $(SRC_DIR)/runcore/main.c $(GENERAL_H_FILES) \
$(SRC_DIR)/pmc/pmc_parrotlibrary.h
$(SRC_DIR)/call/pcc$(O) : $(SRC_DIR)/call/pcc.c $(GENERAL_H_FILES) \
$(SRC_DIR)/call/pcc.str $(SRC_DIR)/pmc/pmc_fixedintegerarray.h \
$(SRC_DIR)/pmc/pmc_key.h $(SRC_DIR)/pmc/pmc_continuation.h
-$(SRC_DIR)/inter_cb$(O) : $(SRC_DIR)/inter_cb.c $(GENERAL_H_FILES) \
- $(SRC_DIR)/inter_cb.str
+$(SRC_DIR)/interp/inter_cb$(O) : $(SRC_DIR)/interp/inter_cb.c \
+ $(GENERAL_H_FILES) $(SRC_DIR)/interp/inter_cb.str
-$(SRC_DIR)/inter_misc$(O) : $(SRC_DIR)/inter_misc.c $(GENERAL_H_FILES) \
- $(SRC_DIR)/inter_misc.str
+$(SRC_DIR)/interp/inter_misc$(O) : $(SRC_DIR)/interp/inter_misc.c \
+ $(GENERAL_H_FILES) $(SRC_DIR)/interp/inter_misc.str
-$(SRC_DIR)/inter_create$(O) : $(SRC_DIR)/inter_create.c $(GENERAL_H_FILES) \
- $(SRC_DIR)/inter_create.str
+$(SRC_DIR)/interp/inter_create$(O) : $(SRC_DIR)/interp/inter_create.c \
+ $(GENERAL_H_FILES) $(SRC_DIR)/interp/inter_create.str
$(SRC_DIR)/call/ops$(O) : $(SRC_DIR)/call/ops.c $(GENERAL_H_FILES) \
$(SRC_DIR)/pmc/pmc_continuation.h
@@ -1177,7 +1177,7 @@
$(SRC_DIR)/gc/register$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
-$(SRC_DIR)/runops_cores$(O) : $(GENERAL_H_FILES)
+$(SRC_DIR)/runcore/cores$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/stacks$(O) : $(GENERAL_H_FILES)
@@ -1681,10 +1681,9 @@
install_config.fpmc
$(PERL) $(BUILD_TOOLS_DIR)/c2str.pl --init
$(RM_F) \
- $(SRC_DIR)/string/private_cstring.h \
- "$(SRC_DIR)/*.str" "$(SRC_DIR)/io/*.str" "$(SRC_DIR)/pmc/*.str" \
- "$(SRC_DIR)/call/*.str" "src/pmc/*.c" "src/pmc/pmc_*.h" "src/pmc/*.dump" \
- vtable.dump "*.def" "*.lib" "*.exp"
+ $(STR_FILES) \
+ $(SRC_DIR)/string/private_cstring.h "src/pmc/*.c" "src/pmc/pmc_*.h" \
+ "src/pmc/*.dump" vtable.dump "*.def" "*.lib" "*.exp"
archclean: dynoplibs-clean dynpmc-clean dynext-clean
$(RM_F) \
Modified: trunk/docs/debug.pod
==============================================================================
--- trunk/docs/debug.pod Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/docs/debug.pod Wed Apr 22 20:06:30 2009 (r38275)
@@ -1,4 +1,4 @@
-# Copyright (C) 2001-2004, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -277,14 +277,14 @@
at src/ops/set.ops:159
No locals.
#4 0xb7c9da32 in runops_slow_core (interp=0x804e008, pc=0x825d470)
- at src/runops_cores.c:184
+ at src/runcore/cores.c:184
No locals.
#5 0xb7c67acf in runops_int (interp=0x804e008, offset=0)
- at src/interpreter.c:816
+ at src/interp/interpreter.c:816
pc = (opcode_t * const) 0x8239730
lo_var_ptr = 134537224
core = (opcode_t *(*)(Parrot_Interp,
- opcode_t *)) 0xb7c9d940 <runops_slow_core at src/runops_cores.c:169>
+ opcode_t *)) 0xb7c9d940 <runops_slow_core at src/runcore/cores.c:169>
#6 0xb7c6854e in runops (interp=0x804e008, offs=0) at src/call/ops.c:100
offset = 0
old_runloop_id = 0
Modified: trunk/include/parrot/interpreter.h
==============================================================================
--- trunk/include/parrot/interpreter.h Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/include/parrot/interpreter.h Wed Apr 22 20:06:30 2009 (r38275)
@@ -497,7 +497,7 @@
typedef PMC *(*Parrot_compiler_func_t)(PARROT_INTERP,
const char * program);
-/* HEADERIZER BEGIN: src/inter_create.c */
+/* HEADERIZER BEGIN: src/interp/inter_create.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
@@ -519,9 +519,9 @@
#define ASSERT_ARGS_Parrot_really_destroy __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/inter_create.c */
+/* HEADERIZER END: src/interp/inter_create.c */
-/* HEADERIZER BEGIN: src/inter_cb.c */
+/* HEADERIZER BEGIN: src/interp/inter_cb.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
@@ -574,9 +574,9 @@
|| PARROT_ASSERT_ARG(user_data) \
|| PARROT_ASSERT_ARG(external_data)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/inter_cb.c */
+/* HEADERIZER END: src/interp/inter_cb.c */
-/* HEADERIZER BEGIN: src/inter_misc.c */
+/* HEADERIZER BEGIN: src/interp/inter_misc.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
@@ -678,7 +678,7 @@
#define ASSERT_ARGS_sysinfo_s __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/inter_misc.c */
+/* HEADERIZER END: src/interp/inter_misc.c */
/* interpreter.c */
Copied: trunk/include/parrot/runcore_api.h (from r38257, branches/headercleanup/include/parrot/runcore_api.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/include/parrot/runcore_api.h Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/include/parrot/runcore_api.h)
@@ -0,0 +1,94 @@
+/* runcore_api.h
+ * Copyright (C) 2001-2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ * Overview:
+ * Functions and macros to dispatch opcodes.
+ */
+
+#ifndef PARROT_RUNCORE_API_H_GUARD
+#define PARROT_RUNCORE_API_H_GUARD
+
+#include "parrot/parrot.h"
+#include "parrot/op.h"
+
+# define DO_OP(PC, INTERP) ((PC) = (((INTERP)->op_func_table)[*(PC)])((PC), (INTERP)))
+
+/* HEADERIZER BEGIN: src/runops_cores.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t * runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_runops_cgoto_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_debugger_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_fast_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_gc_debug_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_profile_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_slow_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/runops_cores.c */
+
+opcode_t *runops_fast_core(PARROT_INTERP, opcode_t *);
+
+opcode_t *runops_cgoto_core(PARROT_INTERP, opcode_t *);
+
+opcode_t *runops_slow_core(PARROT_INTERP, opcode_t *);
+
+opcode_t *runops_profile_core(PARROT_INTERP, opcode_t *);
+
+#endif /* PARROT_RUNOPS_CORES_H_GUARD */
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: trunk/include/parrot/runcore_trace.h (from r38257, branches/headercleanup/include/parrot/runcore_trace.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/include/parrot/runcore_trace.h Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/include/parrot/runcore_trace.h)
@@ -0,0 +1,67 @@
+/* runcore_trace.h
+ * Copyright (C) 2001-2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ * Overview:
+ * Tracing runcore.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#ifndef PARROT_TRACE_H_GUARD
+#define PARROT_TRACE_H_GUARD
+
+#include "parrot/parrot.h"
+
+/* HEADERIZER BEGIN: src/runcore/trace.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+int trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+void trace_op(PARROT_INTERP,
+ ARGIN(const opcode_t *code_start),
+ ARGIN(const opcode_t *code_end),
+ ARGIN_NULLOK(const opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+void trace_op_dump(PARROT_INTERP,
+ ARGIN(const opcode_t *code_start),
+ ARGIN(const opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+void trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_trace_key_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(key)
+#define ASSERT_ARGS_trace_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(code_start) \
+ || PARROT_ASSERT_ARG(code_end)
+#define ASSERT_ARGS_trace_op_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(code_start) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_trace_pmc_dump __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/runcore/trace.c */
+
+#endif /* PARROT_TRACE_H_GUARD */
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: trunk/src/debug.c
==============================================================================
--- trunk/src/debug.c Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/src/debug.c Wed Apr 22 20:06:30 2009 (r38275)
@@ -28,8 +28,8 @@
#include "parrot/debugger.h"
#include "parrot/oplib/ops.h"
#include "pmc/pmc_key.h"
-#include "interp_guts.h"
-#include "trace.h"
+#include "parrot/runcore_api.h"
+#include "parrot/runcore_trace.h"
#include "debug.str"
#include "pmc/pmc_continuation.h"
Deleted: trunk/src/inter_cb.c
==============================================================================
--- trunk/src/inter_cb.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,406 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/inter_cb.c - Parrot Interpreter - Callback Function Handling
-
-=head1 DESCRIPTION
-
-NCI callback functions may run whenever the C code executes the callback.
-To be prepared for asynchronous callbacks these are converted to callback
-events.
-
-Often callbacks should run synchronously. This can only happen when
-the C-library calls the callback, because Parrot called a function in
-the C-library.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "inter_cb.str"
-
-
-/* HEADERIZER HFILE: include/parrot/interpreter.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void callback_CD(PARROT_INTERP,
- ARGIN(char *external_data),
- ARGMOD(PMC *user_data))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*user_data);
-
-static void verify_CD(ARGIN(char *external_data), ARGMOD(PMC *user_data))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*user_data);
-
-#define ASSERT_ARGS_callback_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(external_data) \
- || PARROT_ASSERT_ARG(user_data)
-#define ASSERT_ARGS_verify_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(external_data) \
- || PARROT_ASSERT_ARG(user_data)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-/*
-
-=item C<PMC* Parrot_make_cb(PARROT_INTERP, PMC* sub, PMC* user_data, STRING
-*cb_signature)>
-
-Create a callback function according to pdd16.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC*
-Parrot_make_cb(PARROT_INTERP, ARGMOD(PMC* sub), ARGIN(PMC* user_data),
- ARGIN(STRING *cb_signature))
-{
- ASSERT_ARGS(Parrot_make_cb)
- PMC *cb, *cb_sig;
- int type;
- char * sig_str;
- STRING *sc;
- /*
- * we stuff all the information into the user_data PMC and pass that
- * on to the external sub
- */
- PMC * const interp_pmc = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
- (INTVAL) IGLOBALS_INTERPRETER);
-
- /* be sure __LINE__ is consistent */
- sc = CONST_STRING(interp, "_interpreter");
- VTABLE_setprop(interp, user_data, sc, interp_pmc);
- sc = CONST_STRING(interp, "_sub");
- VTABLE_setprop(interp, user_data, sc, sub);
- /* only ASCII signatures are supported */
- sig_str = cb_signature->strstart;
-
- if (strlen(sig_str) != 3)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature '%s' in make_cb", cb_signature->strstart);
-
- ++sig_str; /* Skip callback return type */
-
- if (*sig_str == 'U') {
- type = 'D';
- }
- else {
- ++sig_str;
- if (*sig_str == 'U') {
- type = 'C';
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature '%s' in make_cb", cb_signature->strstart);
- }
- }
-
- cb_sig = pmc_new(interp, enum_class_String);
- VTABLE_set_string_native(interp, cb_sig, cb_signature);
- sc = CONST_STRING(interp, "_signature");
- VTABLE_setprop(interp, user_data, sc, cb_sig);
- /*
- * We are going to be passing the user_data PMC to external code, but
- * it may go out of scope until the callback is called -- we don't know
- * for certain as we don't know when the callback will be called.
- * Therefore, to prevent the PMC from being destroyed by a GC sweep,
- * we need to anchor it.
- *
- */
- gc_register_pmc(interp, user_data);
-
- /*
- * Finally, the external lib awaits a function pointer.
- * Create a PMC that points to Parrot_callback_C (or _D);
- * it can be passed on with signature 'p'.
- */
- cb = pmc_new(interp, enum_class_UnManagedStruct);
- /*
- * Currently, we handle only 2 types:
- * _C ... user_data is 2nd parameter
- * _D ... user_data is 1st parameter
- */
- if (type == 'C')
- VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_C));
- else
- VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_D));
- gc_register_pmc(interp, cb);
-
- return cb;
-}
-
-/*
-
-=item C<static void verify_CD(char *external_data, PMC *user_data)>
-
-Verify user_data PMC then continue with callback_CD
-
-=cut
-
-*/
-
-static void
-verify_CD(ARGIN(char *external_data), ARGMOD(PMC *user_data))
-{
- ASSERT_ARGS(verify_CD)
- PARROT_INTERP = NULL;
- size_t i;
-
- /*
- * 1.) user_data is from external code so:
- * verify that we get a PMC that is one that we have passed in
- * as user data, when we prepared the callback
- */
-
- /* a NULL pointer or a pointer not aligned is very likely wrong */
- if (!user_data || ((UINTVAL)user_data & 3))
- PANIC(interp, "user_data doesn't look like a pointer");
-
- /*
- * We don't yet know which interpreter this PMC is from, so run
- * through all of the existing interpreters and check their PMC
- * pools
- */
- LOCK(interpreter_array_mutex);
- for (i = 0; i < n_interpreters; ++i) {
- if (interpreter_array[i] == NULL)
- continue;
- interp = interpreter_array[i];
- if (interp)
- if (contained_in_pool(interp->arena_base->pmc_pool, user_data))
- break;
- }
- UNLOCK(interpreter_array_mutex);
- if (!interp)
- PANIC(interp, "interpreter not found for callback");
-
- /*
- * 2) some more checks
- * now we should have the interpreter where that callback
- * did originate - do some further checks on the PMC
- */
-
- /* if that doesn't look like a PMC we are still lost */
- if (!PObj_is_PMC_TEST(user_data))
- PANIC(interp, "user_data isn't a PMC");
-
- if (!user_data->vtable)
- PANIC(interp, "user_data hasn't a vtable");
- /*
- * ok fine till here
- */
- callback_CD(interp, external_data, user_data);
-}
-
-/*
-
-=item C<static void callback_CD(PARROT_INTERP, char *external_data, PMC
-*user_data)>
-
-Common callback function handler. See pdd16.
-
-=cut
-
-*/
-
-static void
-callback_CD(PARROT_INTERP, ARGIN(char *external_data), ARGMOD(PMC *user_data))
-{
- ASSERT_ARGS(callback_CD)
-
- PMC *passed_interp; /* the interp that originated the CB */
- PMC *passed_synchronous; /* flagging synchronous execution */
- int synchronous = 0; /* cb is hitting this sub somewhen
- * inmidst, or not */
- STRING *sc;
- /*
- * 3) check interpreter ...
- */
- sc = CONST_STRING(interp, "_interpreter");
- passed_interp = VTABLE_getprop(interp, user_data, sc);
- if (VTABLE_get_pointer(interp, passed_interp) != interp)
- PANIC(interp, "callback gone to wrong interpreter");
-
- sc = CONST_STRING(interp, "_synchronous");
- passed_synchronous = VTABLE_getprop(interp, user_data, sc);
- if (!PMC_IS_NULL(passed_synchronous) &&
- VTABLE_get_bool(interp, passed_synchronous))
- synchronous = 1;
-
- /*
- * 4) check if the call_back is synchronous:
- * - if yes we are inside the NCI call
- * we could run the Sub immediately now (I think)
- * - if no, and that's always safe, post a callback event
- */
-
- if (synchronous) {
- /*
- * just call the sub
- */
- Parrot_run_callback(interp, user_data, external_data);
- }
- else {
- /*
- * create a CB_EVENT, put user_data and data inside and finito
- *
- * *if* this function is finally no void, i.e. the calling
- * C program awaits a return result from the callback,
- * then wait for the CB_EVENT_xx to finish and return the
- * result
- */
- Parrot_cx_schedule_callback(interp, user_data, external_data);
- }
-}
-
-/*
-
-=item C<void Parrot_run_callback(PARROT_INTERP, PMC* user_data, char*
-external_data)>
-
-Run a callback function. The PMC* user_data holds all
-necessary items in its properties.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_run_callback(PARROT_INTERP,
- ARGMOD(PMC* user_data), ARGIN(char* external_data))
-{
- ASSERT_ARGS(Parrot_run_callback)
- PMC *signature;
- PMC *sub;
- STRING *sig_str;
- char *p;
- char pasm_sig[4];
- INTVAL i_param;
- PMC *p_param;
- void *param = NULL; /* avoid -Ox warning */
- STRING *sc;
-
- sc = CONST_STRING(interp, "_sub");
- sub = VTABLE_getprop(interp, user_data, sc);
- sc = CONST_STRING(interp, "_signature");
- signature = VTABLE_getprop(interp, user_data, sc);
-
- sig_str = VTABLE_get_string(interp, signature);
- p = sig_str->strstart;
- ++p; /* Skip return type */
-
- pasm_sig[0] = 'v'; /* no return value supported yet */
- pasm_sig[1] = 'P';
- if (*p == 'U') /* user_data Z in pdd16 */
- ++p; /* p is now type of external data */
- switch (*p) {
- case 'v':
- pasm_sig[2] = 'v';
- break;
-#if 0
- case '2':
- case '3':
- case '4':
-#endif
- case 'l':
- i_param = (INTVAL)(long) external_data;
- goto case_I;
- case 'i':
- i_param = (INTVAL)(int)(long) external_data;
- goto case_I;
- case 's':
- i_param = (INTVAL)(short)(long) external_data;
- goto case_I;
- case 'c':
- i_param = (INTVAL)(char)(long)external_data;
-case_I:
- pasm_sig[2] = 'I';
- param = (void*) i_param;
- break;
-#if 0
- case 'f':
- case 'd':
- /* these types don't fit into a pointer, they will not
- * work
- */
- break;
-#endif
- case 'p':
- /* created a UnManagedStruct */
- p_param = pmc_new(interp, enum_class_UnManagedStruct);
- VTABLE_set_pointer(interp, p_param, external_data);
- pasm_sig[2] = 'P';
- param = (void*) p_param;
- break;
-#if 0
- case 'P':
- pasm_sig[2] = 'P';
- break;
-#endif
- case 't':
- pasm_sig[2] = 'S';
- param = Parrot_str_new(interp, external_data, 0);
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature char '%c' in run_cb", *p);
- }
- pasm_sig[3] = '\0';
- Parrot_runops_fromc_args_event(interp, sub, pasm_sig,
- user_data, param);
-}
-/*
-
-=item C<void Parrot_callback_C(char *external_data, PMC *user_data)>
-
-=item C<void Parrot_callback_D(PMC *user_data, char *external_data)>
-
-NCI callback functions. See pdd16.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_callback_C(ARGIN(char *external_data), ARGMOD(PMC *user_data))
-{
- ASSERT_ARGS(Parrot_callback_C)
- verify_CD(external_data, user_data);
-}
-
-PARROT_EXPORT
-void
-Parrot_callback_D(ARGMOD(PMC *user_data), ARGIN(char *external_data))
-{
- ASSERT_ARGS(Parrot_callback_D)
- verify_CD(external_data, user_data);
-}
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/inter_create.c
==============================================================================
--- trunk/src/inter_create.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,494 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/inter_create.c - Parrot Interpreter Creation and Destruction
-
-=head1 DESCRIPTION
-
-Create or destroy a Parrot interpreter
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-
-#include "parrot/parrot.h"
-#include "parrot/oplib/core_ops.h"
-#include "../compilers/imcc/imc.h"
-#include "inter_create.str"
-
-/* HEADERIZER HFILE: include/parrot/interpreter.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_WARN_UNUSED_RESULT
-static int is_env_var_set(ARGIN(const char* var))
- __attribute__nonnull__(1);
-
-static void setup_default_compreg(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-#define ASSERT_ARGS_is_env_var_set __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(var)
-#define ASSERT_ARGS_setup_default_compreg __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: static */
-
-#if EXEC_CAPABLE
- extern int Parrot_exec_run;
-#endif
-
-#if EXEC_CAPABLE
-Interp interpre;
-#endif
-
-#define ATEXIT_DESTROY
-
-/*
-
-=item C<static int is_env_var_set(const char* var)>
-
-Checks whether the specified environment variable is set.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-static int
-is_env_var_set(ARGIN(const char* var))
-{
- ASSERT_ARGS(is_env_var_set)
- int free_it, retval;
- char* const value = Parrot_getenv(var, &free_it);
- if (value == NULL)
- retval = 0;
- else if (*value == '\0')
- retval = 0;
- else
- retval = !STREQ(value, "0");
- if (free_it)
- mem_sys_free(value);
- return retval;
-}
-
-/*
-
-=item C<static void setup_default_compreg(PARROT_INTERP)>
-
-Setup default compiler for PASM.
-
-=cut
-
-*/
-
-static void
-setup_default_compreg(PARROT_INTERP)
-{
- ASSERT_ARGS(setup_default_compreg)
- STRING * const pasm1 = CONST_STRING(interp, "PASM1");
-
- /* register the nci compiler object */
- Parrot_compreg(interp, pasm1, (Parrot_compiler_func_t)PDB_compile);
-}
-
-/*
-
-=item C<Parrot_Interp make_interpreter(Interp *parent, INTVAL flags)>
-
-Create the Parrot interpreter. Allocate memory and clear the registers.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Interp
-make_interpreter(ARGIN_NULLOK(Interp *parent), INTVAL flags)
-{
- ASSERT_ARGS(make_interpreter)
- int stacktop;
- Interp *interp;
-
- /* Get an empty interpreter from system memory */
-#if EXEC_CAPABLE
- if (Parrot_exec_run)
- interp = &interpre;
- else
-#endif
- interp = mem_allocate_zeroed_typed(Interp);
-
- interp->lo_var_ptr = NULL;
-
- /* the last interpreter (w/o) parent has to cleanup globals
- * so remember parent if any */
- if (parent)
- interp->parent_interpreter = parent;
- else {
- interp->parent_interpreter = NULL;
- PMCNULL = NULL;
- /*
- * we need a global mutex to protect the interpreter array
- */
- MUTEX_INIT(interpreter_array_mutex);
- }
-
- create_initial_context(interp);
- interp->resume_flag = RESUME_INITIAL;
-
- /* main is called as a Sub too - this will get depth 0 then */
- CONTEXT(interp)->recursion_depth = (UINTVAL)-1;
- interp->recursion_limit = RECURSION_LIMIT;
-
- /* Must initialize flags here so the GC_DEBUG stuff is available before
- * mem_setup_allocator() is called. */
- interp->flags = flags;
-
- /* PANIC will fail until this is done */
- interp->piodata = NULL;
- Parrot_io_init(interp);
-
- if (is_env_var_set("PARROT_GC_DEBUG")) {
-#if ! DISABLE_GC_DEBUG
- Interp_flags_SET(interp, PARROT_GC_DEBUG_FLAG);
-#else
- fprintf(stderr, "PARROT_GC_DEBUG is set but the binary was compiled "
- "with DISABLE_GC_DEBUG.\n");
-#endif
- }
-
- /* Set up the memory allocation system */
- mem_setup_allocator(interp, (void*)&stacktop);
- Parrot_block_GC_mark(interp);
- Parrot_block_GC_sweep(interp);
-
- /*
- * Set up the string subsystem
- * This also generates the constant string tables
- */
- Parrot_str_init(interp);
-
- /* Set up the MMD struct */
- interp->binop_mmd_funcs = NULL;
-
- /* MMD cache for builtins. */
- interp->op_mmd_cache = Parrot_mmd_cache_create(interp);
-
- /* create caches structure */
- init_object_cache(interp);
-
- /* initialize classes - this needs mmd func table */
- interp->HLL_info = NULL;
- init_world_once(interp);
-
- /* context data */
- /* Initialize interpreter's flags */
- PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
-
- /* same with errors */
- PARROT_ERRORS_off(interp, PARROT_ERRORS_ALL_FLAG);
-
- /* undefined globals are errors by default */
- PARROT_ERRORS_on(interp, PARROT_ERRORS_GLOBALS_FLAG);
-
- /* param count mismatch is an error by default */
- PARROT_ERRORS_on(interp, PARROT_ERRORS_PARAM_COUNT_FLAG);
-
-#if 0
- /* TODO not yet - too many test failures */
- PARROT_ERRORS_on(interp, PARROT_ERRORS_RESULT_COUNT_FLAG);
-#endif
-
- /* allocate stack chunk cache */
- stack_system_init(interp);
-
- /* And a dynamic environment stack */
- interp->dynamic_env = new_stack(interp, "DynamicEnv");
-
- /* clear context introspection vars */
- CONTEXT(interp)->current_sub = NULL;
- CONTEXT(interp)->current_cont = NULL;
- CONTEXT(interp)->current_object = NULL;
-
- /* Load the core op func and info tables */
- interp->op_lib = PARROT_CORE_OPLIB_INIT(1);
- interp->op_count = interp->op_lib->op_count;
- interp->op_func_table = interp->op_lib->op_func_table;
- interp->op_info_table = interp->op_lib->op_info_table;
- interp->all_op_libs = NULL;
- interp->evc_func_table = NULL;
- interp->save_func_table = NULL;
- interp->code = NULL;
- interp->profile = NULL;
-
- /* create the root set registry */
- interp->gc_registry = pmc_new(interp, enum_class_AddrRegistry);
-
- /* create exceptions list */
- interp->current_runloop_id = 0;
- interp->current_runloop_level = 0;
-
- /* register assembler/compilers */
- setup_default_compreg(interp);
-
- /* setup stdio PMCs */
- Parrot_io_init(interp);
-
- /* init IMCC compiler */
- imcc_init(interp);
-
- /* Done. Return and be done with it */
-
- /* Okay, we've finished doing anything that might trigger GC.
- * Actually, we could enable GC earlier, but here all setup is
- * done
- */
- Parrot_unblock_GC_mark(interp);
- Parrot_unblock_GC_sweep(interp);
-
- /* all sys running, init the event and signal stuff
- * the first or "master" interpreter is handling events and signals
- */
- interp->task_queue = NULL;
- interp->thread_data = NULL;
-
- Parrot_cx_init_scheduler(interp);
-
-#ifdef ATEXIT_DESTROY
- /*
- * if this is not a threaded interpreter, push the interpreter
- * destruction.
- * Threaded interpreters are destructed when the thread ends
- */
- if (!Interp_flags_TEST(interp, PARROT_IS_THREAD))
- Parrot_on_exit(interp, Parrot_really_destroy, NULL);
-#endif
-
- return interp;
-}
-
-/*
-
-=item C<void Parrot_destroy(PARROT_INTERP)>
-
-Does nothing if C<ATEXIT_DESTROY> is defined. Otherwise calls
-C<Parrot_really_destroy()> with exit code 0.
-
-This function is not currently used.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_destroy(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_destroy)
-#ifdef ATEXIT_DESTROY
- UNUSED(interp);
-#else
- Parrot_really_destroy(interp, 0);
-#endif
-}
-
-/*
-
-=item C<void Parrot_really_destroy(PARROT_INTERP, int exit_code, void *arg)>
-
-Waits for any threads to complete, then frees all allocated memory, and
-closes any open file handles, etc.
-
-Note that C<exit_code> is ignored.
-
-=cut
-
-*/
-
-void
-Parrot_really_destroy(PARROT_INTERP, SHIM(int exit_code), SHIM(void *arg))
-{
- ASSERT_ARGS(Parrot_really_destroy)
- /* wait for threads to complete if needed; terminate the event loop */
- if (!interp->parent_interpreter) {
- Parrot_cx_runloop_end(interp);
- pt_join_threads(interp);
- }
-
- /* if something needs destruction (e.g. closing PIOs)
- * we must destroy it now:
- *
- * Be sure that an async collector hasn't live bits set now, so
- * trigger a finish run
- *
- * Need to turn off GC blocking, else things stay alive and IO
- * handles aren't closed
- */
- interp->arena_base->gc_mark_block_level = 0;
- interp->arena_base->gc_sweep_block_level = 0;
-
- if (Interp_trace_TEST(interp, ~0)) {
- Parrot_io_eprintf(interp, "FileHandle objects (like stdout and stderr)"
- "are about to be closed, so clearing trace flags.\n");
- Interp_trace_CLEAR(interp, ~0);
- }
-
- /* Destroys all PMCs, even constants and the FileHandle objects for
- * std{in, out, err}, so don't be verbose about GC'ing. */
- if (interp->thread_data)
- interp->thread_data->state |= THREAD_STATE_SUSPENDED_GC;
-
- Parrot_do_gc_run(interp, GC_finish_FLAG);
-
- /*
- * that doesn't get rid of constant PMCs like these in vtable->data
- * so if such a PMC needs destroying, we get a memory leak, like for
- * the SharedRef PMC
- * TODO sweep constants too or special treatment - depends on how
- * many constant PMCs we'll create
- */
-
- /* destroy IMCC compiler */
- imcc_destroy(interp);
-
- /* Now the PIOData gets also cleared */
- Parrot_io_finish(interp);
-
- /*
- * now all objects that need timely destruction should be finalized
- * so terminate the event loop
- */
- /* if (!interp->parent_interpreter) {
- PIO_internal_shutdown(interp);
- Parrot_kill_event_loop(interp);
- }
- */
-
- /* we destroy all child interpreters and the last one too,
- * if the --leak-test commandline was given
- */
- if (! (interp->parent_interpreter ||
- Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)))
- return;
-
- if (interp->parent_interpreter
- && interp->thread_data
- && (interp->thread_data->state & THREAD_STATE_JOINED)) {
- Parrot_merge_header_pools(interp->parent_interpreter, interp);
- Parrot_merge_memory_pools(interp->parent_interpreter, interp);
- }
-
- if (interp->arena_base->finalize_gc_system)
- interp->arena_base->finalize_gc_system(interp);
-
- /* MMD cache */
- Parrot_mmd_cache_destroy(interp, interp->op_mmd_cache);
-
- /* copies of constant tables */
- Parrot_destroy_constants(interp);
-
- /* buffer headers, PMCs */
- Parrot_destroy_header_pools(interp);
-
- /* memory pools in resources */
- Parrot_destroy_memory_pools(interp);
-
- /* mem subsystem is dead now */
- mem_sys_free(interp->arena_base);
- interp->arena_base = NULL;
-
- /* cache structure */
- destroy_object_cache(interp);
-
- /* packfile */
- if (interp->initial_pf)
- PackFile_destroy(interp, interp->initial_pf);
-
- if (interp->profile) {
- mem_sys_free(interp->profile->data);
- interp->profile->data = NULL;
- mem_sys_free(interp->profile);
- interp->profile = NULL;
- }
-
- /* deinit op_lib */
- (void) PARROT_CORE_OPLIB_INIT(0);
-
- stack_destroy(interp->dynamic_env);
-
- destroy_context(interp);
- destroy_runloop_jump_points(interp);
-
- if (interp->evc_func_table) {
- mem_sys_free(interp->evc_func_table);
- interp->evc_func_table = NULL;
- }
-
- /* strings, charsets, encodings - only once */
- Parrot_str_finish(interp);
-
- if (!interp->parent_interpreter) {
- if (interp->thread_data)
- mem_sys_free(interp->thread_data);
-
- /* free vtables */
- parrot_free_vtables(interp);
-
- /* dynop libs */
- if (interp->n_libs > 0) {
- mem_sys_free(interp->op_info_table);
- mem_sys_free(interp->op_func_table);
- }
-
- MUTEX_DESTROY(interpreter_array_mutex);
- mem_sys_free(interp);
-
- /* finally free other globals */
- mem_sys_free(interpreter_array);
- interpreter_array = NULL;
- }
-
- else {
- /* don't free a thread interpreter, if it isn't joined yet */
- if (!interp->thread_data
- || (interp->thread_data
- && (interp->thread_data->state & THREAD_STATE_JOINED))) {
- if (interp->thread_data) {
- mem_sys_free(interp->thread_data);
- interp->thread_data = NULL;
- }
-
- mem_sys_free(interp);
- }
- }
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/interpreter.h>, F<src/interpreter.c>.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/inter_misc.c
==============================================================================
--- trunk/src/inter_misc.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,496 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/inter_misc.c - Parrot Interpreter miscellaneous functions
-
-=head1 DESCRIPTION
-
-NCI function setup, compiler registration, C<interpinfo>, and C<sysinfo> opcodes.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-
-#include "parrot/parrot.h"
-#include "inter_misc.str"
-#include "../compilers/imcc/imc.h"
-
-#include "parrot/has_header.h"
-
-#ifdef PARROT_HAS_HEADER_SYSUTSNAME
-# include <sys/utsname.h>
-#endif
-
-/* HEADERIZER HFILE: include/parrot/interpreter.h */
-
-/*
-
-=item C<void register_nci_method(PARROT_INTERP, const int type, void *func,
-const char *name, const char *proto)>
-
-Create an entry in the C<nci_method_table> for the given NCI method of PMC
-class C<type>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-register_nci_method(PARROT_INTERP, const int type, ARGIN(void *func),
- ARGIN(const char *name), ARGIN(const char *proto))
-{
- ASSERT_ARGS(register_nci_method)
- PMC * const method = pmc_new(interp, enum_class_NCI);
- STRING * const method_name = string_make(interp, name, strlen(name),
- NULL, PObj_constant_FLAG|PObj_external_FLAG);
-
- /* create call func */
- VTABLE_set_pointer_keyed_str(interp, method,
- string_make(interp, proto, strlen(proto), NULL,
- PObj_constant_FLAG|PObj_external_FLAG),
- func);
-
- /* insert it into namespace */
- VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
- method_name, method);
-}
-
-/*
-
-=item C<void register_raw_nci_method_in_ns(PARROT_INTERP, const int type, void
-*func, const char *name)>
-
-Create an entry in the C<nci_method_table> for the given raw NCI method
-of PMC class C<type>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-register_raw_nci_method_in_ns(PARROT_INTERP, const int type, ARGIN(void *func),
- ARGIN(const char *name))
-{
- ASSERT_ARGS(register_raw_nci_method_in_ns)
- PMC * const method = pmc_new(interp, enum_class_NCI);
- STRING * const method_name = string_make(interp, name, strlen(name),
- NULL, PObj_constant_FLAG|PObj_external_FLAG);
-
- /* setup call func */
- VTABLE_set_pointer(interp, method, func);
-
- /* insert it into namespace */
- VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
- method_name, method);
-}
-
-/*
-
-=item C<void Parrot_mark_method_writes(PARROT_INTERP, int type, const char
-*name)>
-
-Mark the method C<name> on PMC type C<type> as one that modifies the PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_mark_method_writes(PARROT_INTERP, int type, ARGIN(const char *name))
-{
- ASSERT_ARGS(Parrot_mark_method_writes)
- STRING *const str_name = Parrot_str_new_constant(interp, name);
- PMC *const pmc_true = pmc_new(interp, enum_class_Integer);
- PMC *const method = VTABLE_get_pmc_keyed_str(
- interp, interp->vtables[type]->_namespace, str_name);
- VTABLE_set_integer_native(interp, pmc_true, 1);
- VTABLE_setprop(interp, method, CONST_STRING(interp, "write"), pmc_true);
-}
-
-/*
-
-=item C<void Parrot_compreg(PARROT_INTERP, STRING *type, Parrot_compiler_func_t
-func)>
-
-Register a parser/compiler function.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_compreg(PARROT_INTERP, ARGIN(STRING *type),
- NOTNULL(Parrot_compiler_func_t func))
-{
- ASSERT_ARGS(Parrot_compreg)
- PMC* const iglobals = interp->iglobals;
- PMC *nci = pmc_new(interp, enum_class_NCI);
- STRING *sc = CONST_STRING(interp, "PJt");
- PMC *hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
- IGLOBALS_COMPREG_HASH);
-
- if (!hash) {
- hash = pmc_new_noinit(interp, enum_class_Hash);
- VTABLE_init(interp, hash);
- VTABLE_set_pmc_keyed_int(interp, iglobals,
- (INTVAL)IGLOBALS_COMPREG_HASH, hash);
- }
-
- VTABLE_set_pmc_keyed_str(interp, hash, type, nci);
-
- /* build native call interface for the C sub in "func" */
- VTABLE_set_pointer_keyed_str(interp, nci, sc, (void*)func);
-}
-
-/*
-
-=item C<void * Parrot_compile_file(PARROT_INTERP, const char *fullname, STRING
-**error)>
-
-Compile code file.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-void *
-Parrot_compile_file(PARROT_INTERP, ARGIN(const char *fullname), ARGOUT(STRING **error))
-{
- ASSERT_ARGS(Parrot_compile_file)
- return IMCC_compile_file_s(interp, fullname, error);
-}
-
-#ifdef GC_IS_MALLOC
-# if 0
-struct mallinfo {
- int arena; /* non-mmapped space allocated from system */
- int ordblks; /* number of free chunks */
- int smblks; /* number of fastbin blocks */
- int hblks; /* number of mmapped regions */
- int hblkhd; /* space in mmapped regions */
- int usmblks; /* maximum total allocated space */
- int fsmblks; /* space available in freed fastbin blocks */
- int uordblks; /* total allocated space */
- int fordblks; /* total free space */
- int keepcost; /* top-most, releasable (via malloc_trim)
- * space */
-};
-# endif
-extern struct mallinfo mallinfo(void);
-#endif /* GC_IS_MALLOC */
-
-/*
-
-=item C<INTVAL interpinfo(PARROT_INTERP, INTVAL what)>
-
-C<what> specifies the type of information you want about the
-interpreter.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-INTVAL
-interpinfo(PARROT_INTERP, INTVAL what)
-{
- ASSERT_ARGS(interpinfo)
- INTVAL ret = 0;
- int j;
- Arenas *arena_base = interp->arena_base;
-
- switch (what) {
- case TOTAL_MEM_ALLOC:
-#ifdef GC_IS_MALLOC
-# if 0
- interp->memory_allocated = mallinfo().uordblks;
-# endif
-#endif
- ret = arena_base->memory_allocated;
- break;
- case GC_MARK_RUNS:
- ret = arena_base->gc_mark_runs;
- break;
- case GC_LAZY_MARK_RUNS:
- ret = arena_base->gc_lazy_mark_runs;
- break;
- case GC_COLLECT_RUNS:
- ret = arena_base->gc_collect_runs;
- break;
- case ACTIVE_PMCS:
- ret = arena_base->pmc_pool->total_objects -
- arena_base->pmc_pool->num_free_objects;
- break;
- case ACTIVE_BUFFERS:
- ret = 0;
- for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
- Small_Object_Pool * const header_pool =
- arena_base->sized_header_pools[j];
- if (header_pool)
- ret += header_pool->total_objects -
- header_pool->num_free_objects;
- }
- break;
- case TOTAL_PMCS:
- ret = arena_base->pmc_pool->total_objects;
- break;
- case TOTAL_BUFFERS:
- ret = 0;
- for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
- Small_Object_Pool * const header_pool =
- arena_base->sized_header_pools[j];
- if (header_pool)
- ret += header_pool->total_objects;
- }
- break;
- case HEADER_ALLOCS_SINCE_COLLECT:
- ret = arena_base->header_allocs_since_last_collect;
- break;
- case MEM_ALLOCS_SINCE_COLLECT:
- ret = arena_base->mem_allocs_since_last_collect;
- break;
- case TOTAL_COPIED:
- ret = arena_base->memory_collected;
- break;
- case IMPATIENT_PMCS:
- ret = arena_base->num_early_gc_PMCs;
- break;
- case EXTENDED_PMCS:
- ret = arena_base->num_extended_PMCs;
- break;
- case CURRENT_RUNCORE:
- ret = interp->run_core;
- break;
- default: /* or a warning only? */
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "illegal argument in interpinfo");
- }
- return ret;
-}
-
-/*
-
-=item C<PMC* interpinfo_p(PARROT_INTERP, INTVAL what)>
-
-C<what> specifies the type of information you want about the
-interpreter.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-PMC*
-interpinfo_p(PARROT_INTERP, INTVAL what)
-{
- ASSERT_ARGS(interpinfo_p)
- switch (what) {
- case CURRENT_SUB:
- return CONTEXT(interp)->current_sub;
- case CURRENT_CONT:
- {
- PMC * const cont = CONTEXT(interp)->current_cont;
- if (!PMC_IS_NULL(cont) && cont->vtable->base_type ==
- enum_class_RetContinuation)
- return VTABLE_clone(interp, cont);
- return cont;
- }
- case CURRENT_OBJECT:
- return CONTEXT(interp)->current_object;
- case CURRENT_LEXPAD:
- return CONTEXT(interp)->lex_pad;
- default: /* or a warning only? */
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "illegal argument in interpinfo");
- }
-}
-
-/*
-
-=item C<STRING* interpinfo_s(PARROT_INTERP, INTVAL what)>
-
-Takes an interpreter name and an information type as arguments.
-Returns corresponding information strings about the interpreter:
-the full pathname, executable name, or the file stem,
-(or throws an error exception, if the type is not recognised).
-Valid types are EXECUTABLE_FULLNAME, EXECUTABLE_BASENAME,
-and RUNTIME_PREFIX.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-STRING*
-interpinfo_s(PARROT_INTERP, INTVAL what)
-{
- ASSERT_ARGS(interpinfo_s)
- switch (what) {
- case EXECUTABLE_FULLNAME:
- {
- PMC *exe_name = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
- IGLOBALS_EXECUTABLE);
- if (PMC_IS_NULL(exe_name))
- return string_from_literal(interp, "");
- return VTABLE_get_string(interp, exe_name);
- }
- case EXECUTABLE_BASENAME:
- {
- STRING *basename;
- PMC *exe_name = VTABLE_get_pmc_keyed_int(interp,
- interp->iglobals, IGLOBALS_EXECUTABLE);
-
- if (PMC_IS_NULL(exe_name))
- return string_from_literal(interp, "");
-
- else {
- /* Need to strip back to what follows the final / or \. */
- STRING *fullname = VTABLE_get_string(interp, exe_name);
- char *fullname_c = Parrot_str_to_cstring(interp, fullname);
- int pos = strlen(fullname_c) - 1;
-
- while (pos > 0
- && fullname_c[pos] != '/'
- && fullname_c[pos] != '\\')
- pos--;
-
- if (pos > 0)
- pos++;
-
- basename = Parrot_str_new(interp, fullname_c + pos, 0);
- mem_sys_free(fullname_c);
-
- return basename;
- }
- }
- case RUNTIME_PREFIX:
- return Parrot_get_runtime_path(interp);
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "illegal argument in interpinfo");
- }
-}
-
-/*
-
-=item C<INTVAL sysinfo_i(PARROT_INTERP, INTVAL info_wanted)>
-
-Returns the system info.
-
-C<info_wanted> is one of:
-
- PARROT_INTSIZE
- PARROT_FLOATSIZE
- PARROT_POINTERSIZE
- PARROT_INTMAX
- PARROT_INTMIN
-
-In unknown info is requested then -1 is returned.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-INTVAL
-sysinfo_i(SHIM_INTERP, INTVAL info_wanted)
-{
- ASSERT_ARGS(sysinfo_i)
- switch (info_wanted) {
- case PARROT_INTSIZE:
- return sizeof (INTVAL);
- case PARROT_FLOATSIZE:
- return sizeof (FLOATVAL);
- case PARROT_POINTERSIZE:
- return sizeof (void *);
- case PARROT_INTMIN:
- return PARROT_INTVAL_MIN;
- case PARROT_INTMAX:
- return PARROT_INTVAL_MAX;
- default:
- return -1;
- }
-}
-
-/*
-
-=item C<STRING * sysinfo_s(PARROT_INTERP, INTVAL info_wanted)>
-
-Returns the system info string.
-
-C<info_wanted> is one of:
-
- PARROT_OS
- PARROT_OS_VERSION
- PARROT_OS_VERSION_NUMBER
- CPU_ARCH
- CPU_TYPE
-
-If unknown info is requested then an empty string is returned.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-STRING *
-sysinfo_s(PARROT_INTERP, INTVAL info_wanted)
-{
- ASSERT_ARGS(sysinfo_s)
- switch (info_wanted) {
- case PARROT_OS:
- return Parrot_str_new_constant(interp, BUILD_OS_NAME);
- case PARROT_OS_VERSION:
-#ifdef PARROT_HAS_HEADER_SYSUTSNAME
- {
- struct utsname info;
- if (uname(&info) == 0) {
- return string_make(interp, info.version, strlen(info.version), "ascii", 0);
- }
- }
-#endif
- break;
- case PARROT_OS_VERSION_NUMBER:
-#ifdef PARROT_HAS_HEADER_SYSUTSNAME
- {
- struct utsname info;
- if (uname(&info) == 0) {
- return string_make(interp, info.release, strlen(info.version), "ascii", 0);
- }
- }
-#endif
- break;
- case CPU_ARCH:
- return string_make(interp, PARROT_CPU_ARCH, sizeof (PARROT_CPU_ARCH) - 1, "ascii", 0);
- case CPU_TYPE:
- default:
- break;
- }
- return string_from_literal(interp, "");
-}
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Copied: trunk/src/interp/inter_cb.c (from r38257, branches/headercleanup/src/interp/inter_cb.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/interp/inter_cb.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/interp/inter_cb.c)
@@ -0,0 +1,406 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/interp/inter_cb.c - Parrot Interpreter - Callback Function Handling
+
+=head1 DESCRIPTION
+
+NCI callback functions may run whenever the C code executes the callback.
+To be prepared for asynchronous callbacks these are converted to callback
+events.
+
+Often callbacks should run synchronously. This can only happen when
+the C-library calls the callback, because Parrot called a function in
+the C-library.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "inter_cb.str"
+
+
+/* HEADERIZER HFILE: include/parrot/interpreter.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void callback_CD(PARROT_INTERP,
+ ARGIN(char *external_data),
+ ARGMOD(PMC *user_data))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*user_data);
+
+static void verify_CD(ARGIN(char *external_data), ARGMOD(PMC *user_data))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*user_data);
+
+#define ASSERT_ARGS_callback_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(external_data) \
+ || PARROT_ASSERT_ARG(user_data)
+#define ASSERT_ARGS_verify_CD __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(external_data) \
+ || PARROT_ASSERT_ARG(user_data)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+/*
+
+=item C<PMC* Parrot_make_cb(PARROT_INTERP, PMC* sub, PMC* user_data, STRING
+*cb_signature)>
+
+Create a callback function according to pdd16.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC*
+Parrot_make_cb(PARROT_INTERP, ARGMOD(PMC* sub), ARGIN(PMC* user_data),
+ ARGIN(STRING *cb_signature))
+{
+ ASSERT_ARGS(Parrot_make_cb)
+ PMC *cb, *cb_sig;
+ int type;
+ char * sig_str;
+ STRING *sc;
+ /*
+ * we stuff all the information into the user_data PMC and pass that
+ * on to the external sub
+ */
+ PMC * const interp_pmc = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
+ (INTVAL) IGLOBALS_INTERPRETER);
+
+ /* be sure __LINE__ is consistent */
+ sc = CONST_STRING(interp, "_interpreter");
+ VTABLE_setprop(interp, user_data, sc, interp_pmc);
+ sc = CONST_STRING(interp, "_sub");
+ VTABLE_setprop(interp, user_data, sc, sub);
+ /* only ASCII signatures are supported */
+ sig_str = cb_signature->strstart;
+
+ if (strlen(sig_str) != 3)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "unhandled signature '%s' in make_cb", cb_signature->strstart);
+
+ ++sig_str; /* Skip callback return type */
+
+ if (*sig_str == 'U') {
+ type = 'D';
+ }
+ else {
+ ++sig_str;
+ if (*sig_str == 'U') {
+ type = 'C';
+ }
+ else {
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "unhandled signature '%s' in make_cb", cb_signature->strstart);
+ }
+ }
+
+ cb_sig = pmc_new(interp, enum_class_String);
+ VTABLE_set_string_native(interp, cb_sig, cb_signature);
+ sc = CONST_STRING(interp, "_signature");
+ VTABLE_setprop(interp, user_data, sc, cb_sig);
+ /*
+ * We are going to be passing the user_data PMC to external code, but
+ * it may go out of scope until the callback is called -- we don't know
+ * for certain as we don't know when the callback will be called.
+ * Therefore, to prevent the PMC from being destroyed by a GC sweep,
+ * we need to anchor it.
+ *
+ */
+ gc_register_pmc(interp, user_data);
+
+ /*
+ * Finally, the external lib awaits a function pointer.
+ * Create a PMC that points to Parrot_callback_C (or _D);
+ * it can be passed on with signature 'p'.
+ */
+ cb = pmc_new(interp, enum_class_UnManagedStruct);
+ /*
+ * Currently, we handle only 2 types:
+ * _C ... user_data is 2nd parameter
+ * _D ... user_data is 1st parameter
+ */
+ if (type == 'C')
+ VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_C));
+ else
+ VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_D));
+ gc_register_pmc(interp, cb);
+
+ return cb;
+}
+
+/*
+
+=item C<static void verify_CD(char *external_data, PMC *user_data)>
+
+Verify user_data PMC then continue with callback_CD
+
+=cut
+
+*/
+
+static void
+verify_CD(ARGIN(char *external_data), ARGMOD(PMC *user_data))
+{
+ ASSERT_ARGS(verify_CD)
+ PARROT_INTERP = NULL;
+ size_t i;
+
+ /*
+ * 1.) user_data is from external code so:
+ * verify that we get a PMC that is one that we have passed in
+ * as user data, when we prepared the callback
+ */
+
+ /* a NULL pointer or a pointer not aligned is very likely wrong */
+ if (!user_data || ((UINTVAL)user_data & 3))
+ PANIC(interp, "user_data doesn't look like a pointer");
+
+ /*
+ * We don't yet know which interpreter this PMC is from, so run
+ * through all of the existing interpreters and check their PMC
+ * pools
+ */
+ LOCK(interpreter_array_mutex);
+ for (i = 0; i < n_interpreters; ++i) {
+ if (interpreter_array[i] == NULL)
+ continue;
+ interp = interpreter_array[i];
+ if (interp)
+ if (contained_in_pool(interp->arena_base->pmc_pool, user_data))
+ break;
+ }
+ UNLOCK(interpreter_array_mutex);
+ if (!interp)
+ PANIC(interp, "interpreter not found for callback");
+
+ /*
+ * 2) some more checks
+ * now we should have the interpreter where that callback
+ * did originate - do some further checks on the PMC
+ */
+
+ /* if that doesn't look like a PMC we are still lost */
+ if (!PObj_is_PMC_TEST(user_data))
+ PANIC(interp, "user_data isn't a PMC");
+
+ if (!user_data->vtable)
+ PANIC(interp, "user_data hasn't a vtable");
+ /*
+ * ok fine till here
+ */
+ callback_CD(interp, external_data, user_data);
+}
+
+/*
+
+=item C<static void callback_CD(PARROT_INTERP, char *external_data, PMC
+*user_data)>
+
+Common callback function handler. See pdd16.
+
+=cut
+
+*/
+
+static void
+callback_CD(PARROT_INTERP, ARGIN(char *external_data), ARGMOD(PMC *user_data))
+{
+ ASSERT_ARGS(callback_CD)
+
+ PMC *passed_interp; /* the interp that originated the CB */
+ PMC *passed_synchronous; /* flagging synchronous execution */
+ int synchronous = 0; /* cb is hitting this sub somewhen
+ * inmidst, or not */
+ STRING *sc;
+ /*
+ * 3) check interpreter ...
+ */
+ sc = CONST_STRING(interp, "_interpreter");
+ passed_interp = VTABLE_getprop(interp, user_data, sc);
+ if (VTABLE_get_pointer(interp, passed_interp) != interp)
+ PANIC(interp, "callback gone to wrong interpreter");
+
+ sc = CONST_STRING(interp, "_synchronous");
+ passed_synchronous = VTABLE_getprop(interp, user_data, sc);
+ if (!PMC_IS_NULL(passed_synchronous) &&
+ VTABLE_get_bool(interp, passed_synchronous))
+ synchronous = 1;
+
+ /*
+ * 4) check if the call_back is synchronous:
+ * - if yes we are inside the NCI call
+ * we could run the Sub immediately now (I think)
+ * - if no, and that's always safe, post a callback event
+ */
+
+ if (synchronous) {
+ /*
+ * just call the sub
+ */
+ Parrot_run_callback(interp, user_data, external_data);
+ }
+ else {
+ /*
+ * create a CB_EVENT, put user_data and data inside and finito
+ *
+ * *if* this function is finally no void, i.e. the calling
+ * C program awaits a return result from the callback,
+ * then wait for the CB_EVENT_xx to finish and return the
+ * result
+ */
+ Parrot_cx_schedule_callback(interp, user_data, external_data);
+ }
+}
+
+/*
+
+=item C<void Parrot_run_callback(PARROT_INTERP, PMC* user_data, char*
+external_data)>
+
+Run a callback function. The PMC* user_data holds all
+necessary items in its properties.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_run_callback(PARROT_INTERP,
+ ARGMOD(PMC* user_data), ARGIN(char* external_data))
+{
+ ASSERT_ARGS(Parrot_run_callback)
+ PMC *signature;
+ PMC *sub;
+ STRING *sig_str;
+ char *p;
+ char pasm_sig[4];
+ INTVAL i_param;
+ PMC *p_param;
+ void *param = NULL; /* avoid -Ox warning */
+ STRING *sc;
+
+ sc = CONST_STRING(interp, "_sub");
+ sub = VTABLE_getprop(interp, user_data, sc);
+ sc = CONST_STRING(interp, "_signature");
+ signature = VTABLE_getprop(interp, user_data, sc);
+
+ sig_str = VTABLE_get_string(interp, signature);
+ p = sig_str->strstart;
+ ++p; /* Skip return type */
+
+ pasm_sig[0] = 'v'; /* no return value supported yet */
+ pasm_sig[1] = 'P';
+ if (*p == 'U') /* user_data Z in pdd16 */
+ ++p; /* p is now type of external data */
+ switch (*p) {
+ case 'v':
+ pasm_sig[2] = 'v';
+ break;
+#if 0
+ case '2':
+ case '3':
+ case '4':
+#endif
+ case 'l':
+ i_param = (INTVAL)(long) external_data;
+ goto case_I;
+ case 'i':
+ i_param = (INTVAL)(int)(long) external_data;
+ goto case_I;
+ case 's':
+ i_param = (INTVAL)(short)(long) external_data;
+ goto case_I;
+ case 'c':
+ i_param = (INTVAL)(char)(long)external_data;
+case_I:
+ pasm_sig[2] = 'I';
+ param = (void*) i_param;
+ break;
+#if 0
+ case 'f':
+ case 'd':
+ /* these types don't fit into a pointer, they will not
+ * work
+ */
+ break;
+#endif
+ case 'p':
+ /* created a UnManagedStruct */
+ p_param = pmc_new(interp, enum_class_UnManagedStruct);
+ VTABLE_set_pointer(interp, p_param, external_data);
+ pasm_sig[2] = 'P';
+ param = (void*) p_param;
+ break;
+#if 0
+ case 'P':
+ pasm_sig[2] = 'P';
+ break;
+#endif
+ case 't':
+ pasm_sig[2] = 'S';
+ param = Parrot_str_new(interp, external_data, 0);
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "unhandled signature char '%c' in run_cb", *p);
+ }
+ pasm_sig[3] = '\0';
+ Parrot_runops_fromc_args_event(interp, sub, pasm_sig,
+ user_data, param);
+}
+/*
+
+=item C<void Parrot_callback_C(char *external_data, PMC *user_data)>
+
+=item C<void Parrot_callback_D(PMC *user_data, char *external_data)>
+
+NCI callback functions. See pdd16.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_callback_C(ARGIN(char *external_data), ARGMOD(PMC *user_data))
+{
+ ASSERT_ARGS(Parrot_callback_C)
+ verify_CD(external_data, user_data);
+}
+
+PARROT_EXPORT
+void
+Parrot_callback_D(ARGMOD(PMC *user_data), ARGIN(char *external_data))
+{
+ ASSERT_ARGS(Parrot_callback_D)
+ verify_CD(external_data, user_data);
+}
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: trunk/src/interp/inter_create.c (from r38257, branches/headercleanup/src/interp/inter_create.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/interp/inter_create.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/interp/inter_create.c)
@@ -0,0 +1,494 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/interp/inter_create.c - Parrot Interpreter Creation and Destruction
+
+=head1 DESCRIPTION
+
+Create or destroy a Parrot interpreter
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+
+#include "parrot/parrot.h"
+#include "parrot/oplib/core_ops.h"
+#include "../compilers/imcc/imc.h"
+#include "inter_create.str"
+
+/* HEADERIZER HFILE: include/parrot/interpreter.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_WARN_UNUSED_RESULT
+static int is_env_var_set(ARGIN(const char* var))
+ __attribute__nonnull__(1);
+
+static void setup_default_compreg(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_is_env_var_set __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(var)
+#define ASSERT_ARGS_setup_default_compreg __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: static */
+
+#if EXEC_CAPABLE
+ extern int Parrot_exec_run;
+#endif
+
+#if EXEC_CAPABLE
+Interp interpre;
+#endif
+
+#define ATEXIT_DESTROY
+
+/*
+
+=item C<static int is_env_var_set(const char* var)>
+
+Checks whether the specified environment variable is set.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static int
+is_env_var_set(ARGIN(const char* var))
+{
+ ASSERT_ARGS(is_env_var_set)
+ int free_it, retval;
+ char* const value = Parrot_getenv(var, &free_it);
+ if (value == NULL)
+ retval = 0;
+ else if (*value == '\0')
+ retval = 0;
+ else
+ retval = !STREQ(value, "0");
+ if (free_it)
+ mem_sys_free(value);
+ return retval;
+}
+
+/*
+
+=item C<static void setup_default_compreg(PARROT_INTERP)>
+
+Setup default compiler for PASM.
+
+=cut
+
+*/
+
+static void
+setup_default_compreg(PARROT_INTERP)
+{
+ ASSERT_ARGS(setup_default_compreg)
+ STRING * const pasm1 = CONST_STRING(interp, "PASM1");
+
+ /* register the nci compiler object */
+ Parrot_compreg(interp, pasm1, (Parrot_compiler_func_t)PDB_compile);
+}
+
+/*
+
+=item C<Parrot_Interp make_interpreter(Interp *parent, INTVAL flags)>
+
+Create the Parrot interpreter. Allocate memory and clear the registers.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Parrot_Interp
+make_interpreter(ARGIN_NULLOK(Interp *parent), INTVAL flags)
+{
+ ASSERT_ARGS(make_interpreter)
+ int stacktop;
+ Interp *interp;
+
+ /* Get an empty interpreter from system memory */
+#if EXEC_CAPABLE
+ if (Parrot_exec_run)
+ interp = &interpre;
+ else
+#endif
+ interp = mem_allocate_zeroed_typed(Interp);
+
+ interp->lo_var_ptr = NULL;
+
+ /* the last interpreter (w/o) parent has to cleanup globals
+ * so remember parent if any */
+ if (parent)
+ interp->parent_interpreter = parent;
+ else {
+ interp->parent_interpreter = NULL;
+ PMCNULL = NULL;
+ /*
+ * we need a global mutex to protect the interpreter array
+ */
+ MUTEX_INIT(interpreter_array_mutex);
+ }
+
+ create_initial_context(interp);
+ interp->resume_flag = RESUME_INITIAL;
+
+ /* main is called as a Sub too - this will get depth 0 then */
+ CONTEXT(interp)->recursion_depth = (UINTVAL)-1;
+ interp->recursion_limit = RECURSION_LIMIT;
+
+ /* Must initialize flags here so the GC_DEBUG stuff is available before
+ * mem_setup_allocator() is called. */
+ interp->flags = flags;
+
+ /* PANIC will fail until this is done */
+ interp->piodata = NULL;
+ Parrot_io_init(interp);
+
+ if (is_env_var_set("PARROT_GC_DEBUG")) {
+#if ! DISABLE_GC_DEBUG
+ Interp_flags_SET(interp, PARROT_GC_DEBUG_FLAG);
+#else
+ fprintf(stderr, "PARROT_GC_DEBUG is set but the binary was compiled "
+ "with DISABLE_GC_DEBUG.\n");
+#endif
+ }
+
+ /* Set up the memory allocation system */
+ mem_setup_allocator(interp, (void*)&stacktop);
+ Parrot_block_GC_mark(interp);
+ Parrot_block_GC_sweep(interp);
+
+ /*
+ * Set up the string subsystem
+ * This also generates the constant string tables
+ */
+ Parrot_str_init(interp);
+
+ /* Set up the MMD struct */
+ interp->binop_mmd_funcs = NULL;
+
+ /* MMD cache for builtins. */
+ interp->op_mmd_cache = Parrot_mmd_cache_create(interp);
+
+ /* create caches structure */
+ init_object_cache(interp);
+
+ /* initialize classes - this needs mmd func table */
+ interp->HLL_info = NULL;
+ init_world_once(interp);
+
+ /* context data */
+ /* Initialize interpreter's flags */
+ PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
+
+ /* same with errors */
+ PARROT_ERRORS_off(interp, PARROT_ERRORS_ALL_FLAG);
+
+ /* undefined globals are errors by default */
+ PARROT_ERRORS_on(interp, PARROT_ERRORS_GLOBALS_FLAG);
+
+ /* param count mismatch is an error by default */
+ PARROT_ERRORS_on(interp, PARROT_ERRORS_PARAM_COUNT_FLAG);
+
+#if 0
+ /* TODO not yet - too many test failures */
+ PARROT_ERRORS_on(interp, PARROT_ERRORS_RESULT_COUNT_FLAG);
+#endif
+
+ /* allocate stack chunk cache */
+ stack_system_init(interp);
+
+ /* And a dynamic environment stack */
+ interp->dynamic_env = new_stack(interp, "DynamicEnv");
+
+ /* clear context introspection vars */
+ CONTEXT(interp)->current_sub = NULL;
+ CONTEXT(interp)->current_cont = NULL;
+ CONTEXT(interp)->current_object = NULL;
+
+ /* Load the core op func and info tables */
+ interp->op_lib = PARROT_CORE_OPLIB_INIT(1);
+ interp->op_count = interp->op_lib->op_count;
+ interp->op_func_table = interp->op_lib->op_func_table;
+ interp->op_info_table = interp->op_lib->op_info_table;
+ interp->all_op_libs = NULL;
+ interp->evc_func_table = NULL;
+ interp->save_func_table = NULL;
+ interp->code = NULL;
+ interp->profile = NULL;
+
+ /* create the root set registry */
+ interp->gc_registry = pmc_new(interp, enum_class_AddrRegistry);
+
+ /* create exceptions list */
+ interp->current_runloop_id = 0;
+ interp->current_runloop_level = 0;
+
+ /* register assembler/compilers */
+ setup_default_compreg(interp);
+
+ /* setup stdio PMCs */
+ Parrot_io_init(interp);
+
+ /* init IMCC compiler */
+ imcc_init(interp);
+
+ /* Done. Return and be done with it */
+
+ /* Okay, we've finished doing anything that might trigger GC.
+ * Actually, we could enable GC earlier, but here all setup is
+ * done
+ */
+ Parrot_unblock_GC_mark(interp);
+ Parrot_unblock_GC_sweep(interp);
+
+ /* all sys running, init the event and signal stuff
+ * the first or "master" interpreter is handling events and signals
+ */
+ interp->task_queue = NULL;
+ interp->thread_data = NULL;
+
+ Parrot_cx_init_scheduler(interp);
+
+#ifdef ATEXIT_DESTROY
+ /*
+ * if this is not a threaded interpreter, push the interpreter
+ * destruction.
+ * Threaded interpreters are destructed when the thread ends
+ */
+ if (!Interp_flags_TEST(interp, PARROT_IS_THREAD))
+ Parrot_on_exit(interp, Parrot_really_destroy, NULL);
+#endif
+
+ return interp;
+}
+
+/*
+
+=item C<void Parrot_destroy(PARROT_INTERP)>
+
+Does nothing if C<ATEXIT_DESTROY> is defined. Otherwise calls
+C<Parrot_really_destroy()> with exit code 0.
+
+This function is not currently used.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_destroy(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_destroy)
+#ifdef ATEXIT_DESTROY
+ UNUSED(interp);
+#else
+ Parrot_really_destroy(interp, 0);
+#endif
+}
+
+/*
+
+=item C<void Parrot_really_destroy(PARROT_INTERP, int exit_code, void *arg)>
+
+Waits for any threads to complete, then frees all allocated memory, and
+closes any open file handles, etc.
+
+Note that C<exit_code> is ignored.
+
+=cut
+
+*/
+
+void
+Parrot_really_destroy(PARROT_INTERP, SHIM(int exit_code), SHIM(void *arg))
+{
+ ASSERT_ARGS(Parrot_really_destroy)
+ /* wait for threads to complete if needed; terminate the event loop */
+ if (!interp->parent_interpreter) {
+ Parrot_cx_runloop_end(interp);
+ pt_join_threads(interp);
+ }
+
+ /* if something needs destruction (e.g. closing PIOs)
+ * we must destroy it now:
+ *
+ * Be sure that an async collector hasn't live bits set now, so
+ * trigger a finish run
+ *
+ * Need to turn off GC blocking, else things stay alive and IO
+ * handles aren't closed
+ */
+ interp->arena_base->gc_mark_block_level = 0;
+ interp->arena_base->gc_sweep_block_level = 0;
+
+ if (Interp_trace_TEST(interp, ~0)) {
+ Parrot_io_eprintf(interp, "FileHandle objects (like stdout and stderr)"
+ "are about to be closed, so clearing trace flags.\n");
+ Interp_trace_CLEAR(interp, ~0);
+ }
+
+ /* Destroys all PMCs, even constants and the FileHandle objects for
+ * std{in, out, err}, so don't be verbose about GC'ing. */
+ if (interp->thread_data)
+ interp->thread_data->state |= THREAD_STATE_SUSPENDED_GC;
+
+ Parrot_do_gc_run(interp, GC_finish_FLAG);
+
+ /*
+ * that doesn't get rid of constant PMCs like these in vtable->data
+ * so if such a PMC needs destroying, we get a memory leak, like for
+ * the SharedRef PMC
+ * TODO sweep constants too or special treatment - depends on how
+ * many constant PMCs we'll create
+ */
+
+ /* destroy IMCC compiler */
+ imcc_destroy(interp);
+
+ /* Now the PIOData gets also cleared */
+ Parrot_io_finish(interp);
+
+ /*
+ * now all objects that need timely destruction should be finalized
+ * so terminate the event loop
+ */
+ /* if (!interp->parent_interpreter) {
+ PIO_internal_shutdown(interp);
+ Parrot_kill_event_loop(interp);
+ }
+ */
+
+ /* we destroy all child interpreters and the last one too,
+ * if the --leak-test commandline was given
+ */
+ if (! (interp->parent_interpreter ||
+ Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)))
+ return;
+
+ if (interp->parent_interpreter
+ && interp->thread_data
+ && (interp->thread_data->state & THREAD_STATE_JOINED)) {
+ Parrot_merge_header_pools(interp->parent_interpreter, interp);
+ Parrot_merge_memory_pools(interp->parent_interpreter, interp);
+ }
+
+ if (interp->arena_base->finalize_gc_system)
+ interp->arena_base->finalize_gc_system(interp);
+
+ /* MMD cache */
+ Parrot_mmd_cache_destroy(interp, interp->op_mmd_cache);
+
+ /* copies of constant tables */
+ Parrot_destroy_constants(interp);
+
+ /* buffer headers, PMCs */
+ Parrot_destroy_header_pools(interp);
+
+ /* memory pools in resources */
+ Parrot_destroy_memory_pools(interp);
+
+ /* mem subsystem is dead now */
+ mem_sys_free(interp->arena_base);
+ interp->arena_base = NULL;
+
+ /* cache structure */
+ destroy_object_cache(interp);
+
+ /* packfile */
+ if (interp->initial_pf)
+ PackFile_destroy(interp, interp->initial_pf);
+
+ if (interp->profile) {
+ mem_sys_free(interp->profile->data);
+ interp->profile->data = NULL;
+ mem_sys_free(interp->profile);
+ interp->profile = NULL;
+ }
+
+ /* deinit op_lib */
+ (void) PARROT_CORE_OPLIB_INIT(0);
+
+ stack_destroy(interp->dynamic_env);
+
+ destroy_context(interp);
+ destroy_runloop_jump_points(interp);
+
+ if (interp->evc_func_table) {
+ mem_sys_free(interp->evc_func_table);
+ interp->evc_func_table = NULL;
+ }
+
+ /* strings, charsets, encodings - only once */
+ Parrot_str_finish(interp);
+
+ if (!interp->parent_interpreter) {
+ if (interp->thread_data)
+ mem_sys_free(interp->thread_data);
+
+ /* free vtables */
+ parrot_free_vtables(interp);
+
+ /* dynop libs */
+ if (interp->n_libs > 0) {
+ mem_sys_free(interp->op_info_table);
+ mem_sys_free(interp->op_func_table);
+ }
+
+ MUTEX_DESTROY(interpreter_array_mutex);
+ mem_sys_free(interp);
+
+ /* finally free other globals */
+ mem_sys_free(interpreter_array);
+ interpreter_array = NULL;
+ }
+
+ else {
+ /* don't free a thread interpreter, if it isn't joined yet */
+ if (!interp->thread_data
+ || (interp->thread_data
+ && (interp->thread_data->state & THREAD_STATE_JOINED))) {
+ if (interp->thread_data) {
+ mem_sys_free(interp->thread_data);
+ interp->thread_data = NULL;
+ }
+
+ mem_sys_free(interp);
+ }
+ }
+}
+
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+L<include/parrot/interpreter.h>, L<src/interp/interpreter.c>.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: trunk/src/interp/inter_misc.c (from r38257, branches/headercleanup/src/interp/inter_misc.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/interp/inter_misc.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/interp/inter_misc.c)
@@ -0,0 +1,496 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/interp/inter_misc.c - Parrot Interpreter miscellaneous functions
+
+=head1 DESCRIPTION
+
+NCI function setup, compiler registration, C<interpinfo>, and C<sysinfo> opcodes.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+
+#include "parrot/parrot.h"
+#include "inter_misc.str"
+#include "../compilers/imcc/imc.h"
+
+#include "parrot/has_header.h"
+
+#ifdef PARROT_HAS_HEADER_SYSUTSNAME
+# include <sys/utsname.h>
+#endif
+
+/* HEADERIZER HFILE: include/parrot/interpreter.h */
+
+/*
+
+=item C<void register_nci_method(PARROT_INTERP, const int type, void *func,
+const char *name, const char *proto)>
+
+Create an entry in the C<nci_method_table> for the given NCI method of PMC
+class C<type>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+register_nci_method(PARROT_INTERP, const int type, ARGIN(void *func),
+ ARGIN(const char *name), ARGIN(const char *proto))
+{
+ ASSERT_ARGS(register_nci_method)
+ PMC * const method = pmc_new(interp, enum_class_NCI);
+ STRING * const method_name = string_make(interp, name, strlen(name),
+ NULL, PObj_constant_FLAG|PObj_external_FLAG);
+
+ /* create call func */
+ VTABLE_set_pointer_keyed_str(interp, method,
+ string_make(interp, proto, strlen(proto), NULL,
+ PObj_constant_FLAG|PObj_external_FLAG),
+ func);
+
+ /* insert it into namespace */
+ VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
+ method_name, method);
+}
+
+/*
+
+=item C<void register_raw_nci_method_in_ns(PARROT_INTERP, const int type, void
+*func, const char *name)>
+
+Create an entry in the C<nci_method_table> for the given raw NCI method
+of PMC class C<type>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+register_raw_nci_method_in_ns(PARROT_INTERP, const int type, ARGIN(void *func),
+ ARGIN(const char *name))
+{
+ ASSERT_ARGS(register_raw_nci_method_in_ns)
+ PMC * const method = pmc_new(interp, enum_class_NCI);
+ STRING * const method_name = string_make(interp, name, strlen(name),
+ NULL, PObj_constant_FLAG|PObj_external_FLAG);
+
+ /* setup call func */
+ VTABLE_set_pointer(interp, method, func);
+
+ /* insert it into namespace */
+ VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
+ method_name, method);
+}
+
+/*
+
+=item C<void Parrot_mark_method_writes(PARROT_INTERP, int type, const char
+*name)>
+
+Mark the method C<name> on PMC type C<type> as one that modifies the PMC.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_mark_method_writes(PARROT_INTERP, int type, ARGIN(const char *name))
+{
+ ASSERT_ARGS(Parrot_mark_method_writes)
+ STRING *const str_name = Parrot_str_new_constant(interp, name);
+ PMC *const pmc_true = pmc_new(interp, enum_class_Integer);
+ PMC *const method = VTABLE_get_pmc_keyed_str(
+ interp, interp->vtables[type]->_namespace, str_name);
+ VTABLE_set_integer_native(interp, pmc_true, 1);
+ VTABLE_setprop(interp, method, CONST_STRING(interp, "write"), pmc_true);
+}
+
+/*
+
+=item C<void Parrot_compreg(PARROT_INTERP, STRING *type, Parrot_compiler_func_t
+func)>
+
+Register a parser/compiler function.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_compreg(PARROT_INTERP, ARGIN(STRING *type),
+ NOTNULL(Parrot_compiler_func_t func))
+{
+ ASSERT_ARGS(Parrot_compreg)
+ PMC* const iglobals = interp->iglobals;
+ PMC *nci = pmc_new(interp, enum_class_NCI);
+ STRING *sc = CONST_STRING(interp, "PJt");
+ PMC *hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
+ IGLOBALS_COMPREG_HASH);
+
+ if (!hash) {
+ hash = pmc_new_noinit(interp, enum_class_Hash);
+ VTABLE_init(interp, hash);
+ VTABLE_set_pmc_keyed_int(interp, iglobals,
+ (INTVAL)IGLOBALS_COMPREG_HASH, hash);
+ }
+
+ VTABLE_set_pmc_keyed_str(interp, hash, type, nci);
+
+ /* build native call interface for the C sub in "func" */
+ VTABLE_set_pointer_keyed_str(interp, nci, sc, (void *)func);
+}
+
+/*
+
+=item C<void * Parrot_compile_file(PARROT_INTERP, const char *fullname, STRING
+**error)>
+
+Compile code file.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+void *
+Parrot_compile_file(PARROT_INTERP, ARGIN(const char *fullname), ARGOUT(STRING **error))
+{
+ ASSERT_ARGS(Parrot_compile_file)
+ return IMCC_compile_file_s(interp, fullname, error);
+}
+
+#ifdef GC_IS_MALLOC
+# if 0
+struct mallinfo {
+ int arena; /* non-mmapped space allocated from system */
+ int ordblks; /* number of free chunks */
+ int smblks; /* number of fastbin blocks */
+ int hblks; /* number of mmapped regions */
+ int hblkhd; /* space in mmapped regions */
+ int usmblks; /* maximum total allocated space */
+ int fsmblks; /* space available in freed fastbin blocks */
+ int uordblks; /* total allocated space */
+ int fordblks; /* total free space */
+ int keepcost; /* top-most, releasable (via malloc_trim)
+ * space */
+};
+# endif
+extern struct mallinfo mallinfo(void);
+#endif /* GC_IS_MALLOC */
+
+/*
+
+=item C<INTVAL interpinfo(PARROT_INTERP, INTVAL what)>
+
+C<what> specifies the type of information you want about the
+interpreter.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+INTVAL
+interpinfo(PARROT_INTERP, INTVAL what)
+{
+ ASSERT_ARGS(interpinfo)
+ INTVAL ret = 0;
+ int j;
+ Arenas *arena_base = interp->arena_base;
+
+ switch (what) {
+ case TOTAL_MEM_ALLOC:
+#ifdef GC_IS_MALLOC
+# if 0
+ interp->memory_allocated = mallinfo().uordblks;
+# endif
+#endif
+ ret = arena_base->memory_allocated;
+ break;
+ case GC_MARK_RUNS:
+ ret = arena_base->gc_mark_runs;
+ break;
+ case GC_LAZY_MARK_RUNS:
+ ret = arena_base->gc_lazy_mark_runs;
+ break;
+ case GC_COLLECT_RUNS:
+ ret = arena_base->gc_collect_runs;
+ break;
+ case ACTIVE_PMCS:
+ ret = arena_base->pmc_pool->total_objects -
+ arena_base->pmc_pool->num_free_objects;
+ break;
+ case ACTIVE_BUFFERS:
+ ret = 0;
+ for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
+ Small_Object_Pool * const header_pool =
+ arena_base->sized_header_pools[j];
+ if (header_pool)
+ ret += header_pool->total_objects -
+ header_pool->num_free_objects;
+ }
+ break;
+ case TOTAL_PMCS:
+ ret = arena_base->pmc_pool->total_objects;
+ break;
+ case TOTAL_BUFFERS:
+ ret = 0;
+ for (j = 0; j < (INTVAL)arena_base->num_sized; j++) {
+ Small_Object_Pool * const header_pool =
+ arena_base->sized_header_pools[j];
+ if (header_pool)
+ ret += header_pool->total_objects;
+ }
+ break;
+ case HEADER_ALLOCS_SINCE_COLLECT:
+ ret = arena_base->header_allocs_since_last_collect;
+ break;
+ case MEM_ALLOCS_SINCE_COLLECT:
+ ret = arena_base->mem_allocs_since_last_collect;
+ break;
+ case TOTAL_COPIED:
+ ret = arena_base->memory_collected;
+ break;
+ case IMPATIENT_PMCS:
+ ret = arena_base->num_early_gc_PMCs;
+ break;
+ case EXTENDED_PMCS:
+ ret = arena_base->num_extended_PMCs;
+ break;
+ case CURRENT_RUNCORE:
+ ret = interp->run_core;
+ break;
+ default: /* or a warning only? */
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "illegal argument in interpinfo");
+ }
+ return ret;
+}
+
+/*
+
+=item C<PMC* interpinfo_p(PARROT_INTERP, INTVAL what)>
+
+C<what> specifies the type of information you want about the
+interpreter.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+PMC*
+interpinfo_p(PARROT_INTERP, INTVAL what)
+{
+ ASSERT_ARGS(interpinfo_p)
+ switch (what) {
+ case CURRENT_SUB:
+ return CONTEXT(interp)->current_sub;
+ case CURRENT_CONT:
+ {
+ PMC * const cont = CONTEXT(interp)->current_cont;
+ if (!PMC_IS_NULL(cont) && cont->vtable->base_type ==
+ enum_class_RetContinuation)
+ return VTABLE_clone(interp, cont);
+ return cont;
+ }
+ case CURRENT_OBJECT:
+ return CONTEXT(interp)->current_object;
+ case CURRENT_LEXPAD:
+ return CONTEXT(interp)->lex_pad;
+ default: /* or a warning only? */
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "illegal argument in interpinfo");
+ }
+}
+
+/*
+
+=item C<STRING* interpinfo_s(PARROT_INTERP, INTVAL what)>
+
+Takes an interpreter name and an information type as arguments.
+Returns corresponding information strings about the interpreter:
+the full pathname, executable name, or the file stem,
+(or throws an error exception, if the type is not recognised).
+Valid types are EXECUTABLE_FULLNAME, EXECUTABLE_BASENAME,
+and RUNTIME_PREFIX.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+STRING*
+interpinfo_s(PARROT_INTERP, INTVAL what)
+{
+ ASSERT_ARGS(interpinfo_s)
+ switch (what) {
+ case EXECUTABLE_FULLNAME:
+ {
+ PMC *exe_name = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
+ IGLOBALS_EXECUTABLE);
+ if (PMC_IS_NULL(exe_name))
+ return string_from_literal(interp, "");
+ return VTABLE_get_string(interp, exe_name);
+ }
+ case EXECUTABLE_BASENAME:
+ {
+ STRING *basename;
+ PMC *exe_name = VTABLE_get_pmc_keyed_int(interp,
+ interp->iglobals, IGLOBALS_EXECUTABLE);
+
+ if (PMC_IS_NULL(exe_name))
+ return string_from_literal(interp, "");
+
+ else {
+ /* Need to strip back to what follows the final / or \. */
+ STRING *fullname = VTABLE_get_string(interp, exe_name);
+ char *fullname_c = Parrot_str_to_cstring(interp, fullname);
+ int pos = strlen(fullname_c) - 1;
+
+ while (pos > 0
+ && fullname_c[pos] != '/'
+ && fullname_c[pos] != '\\')
+ pos--;
+
+ if (pos > 0)
+ pos++;
+
+ basename = Parrot_str_new(interp, fullname_c + pos, 0);
+ mem_sys_free(fullname_c);
+
+ return basename;
+ }
+ }
+ case RUNTIME_PREFIX:
+ return Parrot_get_runtime_path(interp);
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "illegal argument in interpinfo");
+ }
+}
+
+/*
+
+=item C<INTVAL sysinfo_i(PARROT_INTERP, INTVAL info_wanted)>
+
+Returns the system info.
+
+C<info_wanted> is one of:
+
+ PARROT_INTSIZE
+ PARROT_FLOATSIZE
+ PARROT_POINTERSIZE
+ PARROT_INTMAX
+ PARROT_INTMIN
+
+In unknown info is requested then -1 is returned.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+INTVAL
+sysinfo_i(SHIM_INTERP, INTVAL info_wanted)
+{
+ ASSERT_ARGS(sysinfo_i)
+ switch (info_wanted) {
+ case PARROT_INTSIZE:
+ return sizeof (INTVAL);
+ case PARROT_FLOATSIZE:
+ return sizeof (FLOATVAL);
+ case PARROT_POINTERSIZE:
+ return sizeof (void *);
+ case PARROT_INTMIN:
+ return PARROT_INTVAL_MIN;
+ case PARROT_INTMAX:
+ return PARROT_INTVAL_MAX;
+ default:
+ return -1;
+ }
+}
+
+/*
+
+=item C<STRING * sysinfo_s(PARROT_INTERP, INTVAL info_wanted)>
+
+Returns the system info string.
+
+C<info_wanted> is one of:
+
+ PARROT_OS
+ PARROT_OS_VERSION
+ PARROT_OS_VERSION_NUMBER
+ CPU_ARCH
+ CPU_TYPE
+
+If unknown info is requested then an empty string is returned.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+STRING *
+sysinfo_s(PARROT_INTERP, INTVAL info_wanted)
+{
+ ASSERT_ARGS(sysinfo_s)
+ switch (info_wanted) {
+ case PARROT_OS:
+ return Parrot_str_new_constant(interp, BUILD_OS_NAME);
+ case PARROT_OS_VERSION:
+#ifdef PARROT_HAS_HEADER_SYSUTSNAME
+ {
+ struct utsname info;
+ if (uname(&info) == 0) {
+ return string_make(interp, info.version, strlen(info.version), "ascii", 0);
+ }
+ }
+#endif
+ break;
+ case PARROT_OS_VERSION_NUMBER:
+#ifdef PARROT_HAS_HEADER_SYSUTSNAME
+ {
+ struct utsname info;
+ if (uname(&info) == 0) {
+ return string_make(interp, info.release, strlen(info.version), "ascii", 0);
+ }
+ }
+#endif
+ break;
+ case CPU_ARCH:
+ return string_make(interp, PARROT_CPU_ARCH, sizeof (PARROT_CPU_ARCH) - 1, "ascii", 0);
+ case CPU_TYPE:
+ default:
+ break;
+ }
+ return string_from_literal(interp, "");
+}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Deleted: trunk/src/interp_guts.h
==============================================================================
--- trunk/src/interp_guts.h Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,23 +0,0 @@
-/*
- * $Id$
- * Copyright (C) 2001-2007, Parrot Foundation.
- */
-
-/*
-** interp_guts.h
-*/
-
-#ifndef PARROT_INTERP_GUTS_H_GUARD
-#define PARROT_INTERP_GUTS_H_GUARD
-
-# define DO_OP(PC, INTERP) ((PC) = (((INTERP)->op_func_table)[*(PC)])((PC), (INTERP)))
-
-#endif /* PARROT_INTERP_GUTS_H_GUARD */
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/interpreter.c
==============================================================================
--- trunk/src/interpreter.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,1394 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/interpreter.c - Parrot Interpreter
-
-=head1 DESCRIPTION
-
-The interpreter API handles running the operations.
-
-The predereferenced code chunk is pre-initialized with the opcode
-function pointers, addresses, or opnumbers of the C<prederef__>
-opcode. This opcode then calls the C<do_prederef()> function, which then
-fills in the real function, address or op number.
-
-Because the C<prederef__> opcode returns the same C<pc_prederef> it was
-passed, the runops loop will re-execute the same location, which will
-then have the pointer to the real C<prederef> opfunc and C<prederef>
-args.
-
-Pointer arithmetic is used to determine the index into the bytecode
-corresponding to the currect opcode. The bytecode and prederef arrays
-have the same number of elements because there is a one-to-one mapping.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "interp_guts.h"
-#include "parrot/oplib/core_ops.h"
-#include "parrot/oplib/core_ops_switch.h"
-#include "parrot/oplib/ops.h"
-#include "runops_cores.h"
-#if JIT_CAPABLE
-# include "parrot/exec.h"
-# include "jit.h"
-#endif
-#ifdef HAVE_COMPUTED_GOTO
-# include "parrot/oplib/core_ops_cg.h"
-# include "parrot/oplib/core_ops_cgp.h"
-#endif
-#include "parrot/dynext.h"
-#include "pmc/pmc_parrotlibrary.h"
-
-
-/* HEADERIZER HFILE: none */
-/* XXX Needs to get done at the same time as the other interpreter files */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void dynop_register_switch(size_t n_old, size_t n_new);
-static void dynop_register_xx(PARROT_INTERP,
- size_t n_old,
- size_t n_new,
- oplib_init_f init_func)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static oplib_init_f get_dynamic_op_lib_init(SHIM_INTERP,
- ARGIN(const PMC *lib))
- __attribute__nonnull__(2);
-
-static void init_prederef(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
-static void load_prederef(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
-static void notify_func_table(PARROT_INTERP,
- ARGIN(op_func_t* table),
- int on)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void prederef_args(
- ARGMOD(void **pc_prederef),
- PARROT_INTERP,
- ARGIN(opcode_t *pc),
- ARGIN(const op_info_t *opinfo))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*pc_prederef);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t * runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t * runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t * runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t * runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void stop_prederef(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-static void turn_ev_check(PARROT_INTERP, int on)
- __attribute__nonnull__(1);
-
-#define ASSERT_ARGS_dynop_register_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
-#define ASSERT_ARGS_dynop_register_xx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_core_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_dynamic_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(lib)
-#define ASSERT_ARGS_init_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_load_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_notify_func_table __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(table)
-#define ASSERT_ARGS_prederef_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pc_prederef) \
- || PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc) \
- || PARROT_ASSERT_ARG(opinfo)
-#define ASSERT_ARGS_runops_cgp __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_exec __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_jit __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_stop_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_turn_ev_check __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: static */
-
-#if EXEC_CAPABLE
- extern int Parrot_exec_run;
-#endif
-
-/*
-
-=item C<static void prederef_args(void **pc_prederef, PARROT_INTERP, opcode_t
-*pc, const op_info_t *opinfo)>
-
-Called from C<do_prederef()> to deal with any arguments.
-
-C<pc_prederef> is the current opcode.
-
-=cut
-
-*/
-
-static void
-prederef_args(ARGMOD(void **pc_prederef), PARROT_INTERP,
- ARGIN(opcode_t *pc), ARGIN(const op_info_t *opinfo))
-{
- ASSERT_ARGS(prederef_args)
- const PackFile_ConstTable * const const_table = interp->code->const_table;
-
- const int regs_n = CONTEXT(interp)->n_regs_used[REGNO_NUM];
- const int regs_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
- const int regs_p = CONTEXT(interp)->n_regs_used[REGNO_PMC];
- const int regs_s = CONTEXT(interp)->n_regs_used[REGNO_STR];
-
- /* prederef var part too */
- const int m = opinfo->op_count;
- int n = opinfo->op_count;
- int i;
-
- ADD_OP_VAR_PART(interp, interp->code, pc, n);
- for (i = 1; i < n; i++) {
- const opcode_t arg = pc[i];
- int type;
- if (i >= m) {
- PMC * const sig = (PMC*) pc_prederef[1];
- type = VTABLE_get_integer_keyed_int(interp, sig, i - m);
- type &= (PARROT_ARG_TYPE_MASK | PARROT_ARG_CONSTANT);
- }
- else
- type = opinfo->types[i - 1];
-
- switch (type) {
-
- case PARROT_ARG_KI:
- case PARROT_ARG_I:
- if (arg < 0 || arg >= regs_i)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal register number");
-
- pc_prederef[i] = (void *)REG_OFFS_INT(arg);
- break;
-
- case PARROT_ARG_N:
- if (arg < 0 || arg >= regs_n)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal register number");
-
- pc_prederef[i] = (void *)REG_OFFS_NUM(arg);
- break;
-
- case PARROT_ARG_K:
- case PARROT_ARG_P:
- if (arg < 0 || arg >= regs_p)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal register number");
-
- pc_prederef[i] = (void *)REG_OFFS_PMC(arg);
- break;
-
- case PARROT_ARG_S:
- if (arg < 0 || arg >= regs_s)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal register number");
-
- pc_prederef[i] = (void *)REG_OFFS_STR(arg);
- break;
-
- case PARROT_ARG_KIC:
- case PARROT_ARG_IC:
- pc_prederef[i] = (void *)pc[i];
- break;
-
- case PARROT_ARG_NC:
- if (arg < 0 || arg >= const_table->const_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal constant number");
-
- pc_prederef[i] = (void *)&const_table->constants[arg]->u.number;
- break;
-
- case PARROT_ARG_SC:
- if (arg < 0 || arg >= const_table->const_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal constant number");
-
- pc_prederef[i] = (void *)const_table->constants[arg]->u.string;
- break;
-
- case PARROT_ARG_PC:
- case PARROT_ARG_KC:
- if (arg < 0 || arg >= const_table->const_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal constant number");
-
- pc_prederef[i] = (void *)const_table->constants[arg]->u.key;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ARG_OP_NOT_HANDLED,
- "Unhandled argtype 0x%x\n", type);
- break;
- }
- }
-}
-
-
-/*
-
-=item C<void do_prederef(void **pc_prederef, PARROT_INTERP, int type)>
-
-This is called from within the run cores to predereference the current
-opcode.
-
-C<pc_prederef> is the current opcode, and C<type> is the run core type.
-
-=cut
-
-*/
-
-void
-do_prederef(void **pc_prederef, PARROT_INTERP, int type)
-{
- const size_t offset = pc_prederef - interp->code->prederef.code;
- opcode_t * const pc = ((opcode_t *)interp->code->base.data) + offset;
- const op_info_t *opinfo;
- size_t n;
-
- if (*pc < 0 || *pc >= (opcode_t)interp->op_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
- "Illegal opcode");
-
- opinfo = &interp->op_info_table[*pc];
-
- /* first arguments - PIC needs it */
-
- /* check for RT#58044 */
- PARROT_ASSERT(CONTEXT(interp)->n_regs_used);
-
- prederef_args(pc_prederef, interp, pc, opinfo);
-
- switch (type) {
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- parrot_PIC_prederef(interp, *pc, pc_prederef, type);
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Tried to prederef wrong core");
- break;
- }
-
- /* now remember backward branches, invoke and similar opcodes */
- n = opinfo->op_count;
-
- if (((opinfo->jump & PARROT_JUMP_RELATIVE)
- && opinfo->types[n - 2] == PARROT_ARG_IC
- && pc[n - 1] < 0) /* relative backward branch */
- || (opinfo->jump & PARROT_JUMP_ADDRESS)) {
- Prederef * const pi = &interp->code->prederef;
-
- /* first time prederef.branches == NULL:
- * estimate size to 1/16th of opcodes */
- if (!pi->branches) {
- size_t nb = interp->code->base.size / 16;
- if (nb < 8)
- nb = (size_t)8;
-
- pi->branches = mem_allocate_n_typed(nb, Prederef_branch);
- pi->n_allocated = nb;
- pi->n_branches = 0;
- }
- else if (pi->n_branches >= pi->n_allocated) {
- pi->n_allocated = (size_t) (pi->n_allocated * 1.5);
- mem_realloc_n_typed(pi->branches, pi->n_allocated, Prederef_branch);
- }
-
- pi->branches[pi->n_branches].offs = offset;
- pi->branches[pi->n_branches].op = *pc_prederef;
-
- ++pi->n_branches;
- }
-}
-
-
-/*
-
-=item C<static void turn_ev_check(PARROT_INTERP, int on)>
-
-Turn on or off event checking for prederefed cores.
-
-Fills in the C<event_checker> opcode, or restores original ops in all
-branch locations of the opcode stream.
-
-Note that when C<on> is true, this is being called from the event
-handler thread.
-
-=cut
-
-*/
-
-static void
-turn_ev_check(PARROT_INTERP, int on)
-{
- ASSERT_ARGS(turn_ev_check)
- const Prederef * const pi = &interp->code->prederef;
- size_t i;
-
- if (!pi->branches)
- return;
-
- for (i = 0; i < pi->n_branches; ++i) {
- const size_t offs = pi->branches[i].offs;
- if (on)
- interp->code->prederef.code[offs] =
- ((void **)interp->op_lib->op_func_table)
- [CORE_OPS_check_events__];
- else
- interp->code->prederef.code[offs] = pi->branches[i].op;
- }
-}
-
-
-/*
-
-=item C<static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)>
-
-Returns an opcode's library C<op_lib> init function.
-
-C<which> is the run core type.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static oplib_init_f
-get_core_op_lib_init(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(get_core_op_lib_init)
- oplib_init_f init_func;
- switch (which) {
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- init_func = PARROT_CORE_SWITCH_OPLIB_INIT;
- break;
-#ifdef HAVE_COMPUTED_GOTO
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- init_func = PARROT_CORE_CGP_OPLIB_INIT;
- break;
- case PARROT_CGOTO_CORE:
- init_func = PARROT_CORE_CG_OPLIB_INIT;
- break;
-#endif
- /* normal func core */
- case PARROT_EXEC_CORE:
- case PARROT_JIT_CORE:
- case PARROT_SLOW_CORE:
- case PARROT_FAST_CORE:
- case PARROT_GC_DEBUG_CORE:
- case PARROT_DEBUGGER_CORE:
- init_func = PARROT_CORE_OPLIB_INIT;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Couldn't find init_func for core %d", which);
- }
-
- return init_func;
-}
-
-
-/*
-
-=item C<static oplib_init_f get_dynamic_op_lib_init(PARROT_INTERP, const PMC
-*lib)>
-
-Returns an dynamic oplib's opcode's library C<op_lib> init function.
-
-C<lib> will be a C<ParrotLibrary> PMC.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static oplib_init_f
-get_dynamic_op_lib_init(SHIM_INTERP, ARGIN(const PMC *lib))
-{
- ASSERT_ARGS(get_dynamic_op_lib_init)
- return (oplib_init_f)D2FPTR(
- ((Parrot_ParrotLibrary_attributes *)PMC_data(lib))->oplib_init);
-}
-
-
-/*
-
-=item C<static void load_prederef(PARROT_INTERP, int which)>
-
-C<< interp->op_lib >> = prederefed oplib.
-
-=cut
-
-*/
-
-static void
-load_prederef(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(load_prederef)
- const oplib_init_f init_func = get_core_op_lib_init(interp, which);
-
- int (*get_op)(const char * name, int full);
-
- get_op = interp->op_lib->op_code;
- interp->op_lib = init_func(1);
-
- /* preserve the get_op function */
- interp->op_lib->op_code = get_op;
-
- if (interp->op_lib->op_count != interp->op_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PREDEREF_LOAD_ERROR,
- "Illegal op count (%d) in prederef oplib\n",
- (int)interp->op_lib->op_count);
-}
-
-
-/*
-
-=item C<static void init_prederef(PARROT_INTERP, int which)>
-
-Initialize: load prederef C<func_table>, file prederef.code.
-
-=cut
-
-*/
-
-static void
-init_prederef(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(init_prederef)
- load_prederef(interp, which);
- if (!interp->code->prederef.code) {
- void *pred_func;
- opcode_t *pc = interp->code->base.data;
- const size_t N = interp->code->base.size;
- size_t i, n_pics;
-
-/* Parrot_memalign_if_possible in OpenBSD allocates 256 if you ask for 312
- -- Need to verify this, it may have been a bug elsewhere. If it works now,
- we can remove the mem_sys_allocate_zeroed line below. */
-
-#if 0
- void **temp = (void **)mem_sys_allocate_zeroed(N * sizeof (void *));
-#else
- void **temp = (void **)Parrot_memalign_if_possible(256,
- N * sizeof (void *));
-#endif
- /* calc and remember pred_offset */
- CONTEXT(interp)->pred_offset = pc - (opcode_t *)temp;
-
- /* fill with the prederef__ opcode function */
- if (which == PARROT_SWITCH_CORE || which == PARROT_SWITCH_JIT_CORE)
- pred_func = (void *)CORE_OPS_prederef__;
- else
- pred_func = ((void **)
- interp->op_lib->op_func_table)[CORE_OPS_prederef__];
-
- for (i = n_pics = 0; i < N;) {
- op_info_t * const opinfo = &interp->op_info_table[*pc];
- size_t n = opinfo->op_count;
-
- temp[i] = pred_func;
-
- ADD_OP_VAR_PART(interp, interp->code, pc, n);
-
- /* count ops that need a PIC */
- if (parrot_PIC_op_is_cached(*pc))
- n_pics++;
-
- pc += n;
- i += n;
- }
-
- interp->code->prederef.code = temp;
-
- /* allocate pic store, which starts from 1 */
- if (n_pics)
- parrot_PIC_alloc_store(interp->code, n_pics + 1);
- }
-}
-
-
-/*
-
-=item C<static void stop_prederef(PARROT_INTERP)>
-
-Restore the interpreter's op function tables to their initial state.
-Also recreate the event function pointers. This is only necessary
-for run-core changes, but we don't know the old run core.
-
-=cut
-
-*/
-
-static void
-stop_prederef(PARROT_INTERP)
-{
- ASSERT_ARGS(stop_prederef)
- interp->op_func_table = PARROT_CORE_OPLIB_INIT(1)->op_func_table;
-
- if (interp->evc_func_table) {
- mem_sys_free(interp->evc_func_table);
- interp->evc_func_table = NULL;
- }
-
- Parrot_setup_event_func_ptrs(interp);
-}
-
-
-#if EXEC_CAPABLE
-
-/*
-
-=item C<void exec_init_prederef(PARROT_INTERP, void *prederef_arena)>
-
-C<< interp->op_lib >> = prederefed oplib
-
-The "normal" C<op_lib> has a copy in the interpreter structure - but get
-the C<op_code> lookup function from standard core prederef has no
-C<op_info_table>
-
-=cut
-
-*/
-
-void
-exec_init_prederef(PARROT_INTERP, void *prederef_arena)
-{
- load_prederef(interp, PARROT_CGP_CORE);
-
- if (!interp->code->prederef.code) {
- void **temp = (void **)prederef_arena;
-
- interp->code->prederef.code = temp;
- /* TODO */
- }
-}
-
-#endif
-
-
-/*
-
-=item C<void * init_jit(PARROT_INTERP, opcode_t *pc)>
-
-Initializes JIT function for the specified opcode and returns it.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-void *
-init_jit(PARROT_INTERP, SHIM(opcode_t *pc))
-{
-#if JIT_CAPABLE
- opcode_t *code_start;
- UINTVAL code_size; /* in opcodes */
- opcode_t *code_end;
- Parrot_jit_info_t *jit_info;
-
- if (interp->code->jit_info)
- return ((Parrot_jit_info_t *)interp->code->jit_info)->arena.start;
-
- code_start = interp->code->base.data;
- code_size = interp->code->base.size;
- code_end = code_start + code_size;
-
-# if defined HAVE_COMPUTED_GOTO && PARROT_I386_JIT_CGP
-# ifdef __GNUC__
-# ifdef PARROT_I386
- init_prederef(interp, PARROT_CGP_CORE);
-# endif
-# endif
-# endif
-
- interp->code->jit_info =
- jit_info = parrot_build_asm(interp, code_start, code_end,
- NULL, JIT_CODE_FILE);
-
- return jit_info->arena.start;
-#else
- UNUSED(interp);
- return NULL;
-#endif
-
-}
-
-
-/*
-
-=item C<void prepare_for_run(PARROT_INTERP)>
-
-Prepares to run the interpreter's run core.
-
-=cut
-
-*/
-
-void
-prepare_for_run(PARROT_INTERP)
-{
- void *ignored;
- switch (interp->run_core) {
- case PARROT_JIT_CORE:
- ignored = init_jit(interp, interp->code->base.data);
- UNUSED(ignored);
- break;
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- case PARROT_DEBUGGER_CORE:
- init_prederef(interp, interp->run_core);
- break;
- default:
- break;
- }
-}
-
-
-#ifdef PARROT_EXEC_OS_AIX
-extern void* aix_get_toc();
-#endif
-
-/*
-
-=item C<static opcode_t * runops_jit(PARROT_INTERP, opcode_t *pc)>
-
-Runs the JIT code for the specified opcode.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t *
-runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_jit)
-#if JIT_CAPABLE
-# ifdef PARROT_EXEC_OS_AIX
- /* AIX calling convention requires that function-call-by-ptr be made
- through the following struct: */
- struct ptrgl_t { jit_f functPtr; void *toc; void *env; } ptrgl_t;
-
- ptrgl_t.functPtr = (jit_f) D2FPTR(init_jit(interp, pc));
- ptrgl_t.env = NULL;
-
- /* r2 (TOC) needs to point back here so we can return from non-JIT
- functions */
- ptrgl_t.toc = aix_get_toc();
-
- ((jit_f) D2FPTR(&ptrgl_t)) (interp, pc);
-# else
- jit_f jit_code = (jit_f)(init_jit(interp, pc));
- (jit_code) (interp, pc);
-# endif
-#else
- UNUSED(interp);
- UNUSED(pc);
-#endif
- return NULL;
-}
-
-
-/*
-
-=item C<static opcode_t * runops_exec(PARROT_INTERP, opcode_t *pc)>
-
-Runs the native executable version of the specified opcode.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t *
-runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_exec)
-#if EXEC_CAPABLE
- opcode_t *code_start;
- UINTVAL code_size; /* in opcodes */
- opcode_t *code_end;
-
- code_start = interp->code->base.data;
- code_size = interp->code->base.size;
- code_end = code_start + code_size;
-# if defined HAVE_COMPUTED_GOTO && defined USE_CGP
-# ifdef __GNUC__
-# ifdef PARROT_I386
- init_prederef(interp, PARROT_CGP_CORE);
-# endif
-# endif
-# endif
- if (Parrot_exec_run == 2) {
- void *ignored;
- Parrot_exec_run = 0;
-
- Interp_core_SET(interp, PARROT_JIT_CORE);
- ignored = runops_jit(interp, pc);
- UNUSED(ignored);
-
- Interp_core_SET(interp, PARROT_EXEC_CORE);
- }
- else if (Parrot_exec_run == 1)
- Parrot_exec(interp, pc, code_start, code_end);
- else
- run_native(interp, pc, code_start);
-
-#else
- UNUSED(interp);
- UNUSED(pc);
-#endif
-
- return NULL;
-}
-
-
-/*
-
-=item C<static opcode_t * runops_cgp(PARROT_INTERP, opcode_t *pc)>
-
-Runs the C C<goto>, predereferenced core.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t *
-runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_cgp)
-#ifdef HAVE_COMPUTED_GOTO
- opcode_t * const code_start = (opcode_t *)interp->code->base.data;
- opcode_t *pc_prederef;
-
- init_prederef(interp, PARROT_CGP_CORE);
-
- pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
- return cgp_core(pc_prederef, interp);
-
-#else
- UNUSED(pc);
- Parrot_io_eprintf(interp,
- "Computed goto unavailable in this configuration.\n");
- Parrot_exit(interp, 1);
-#endif
-
-}
-
-
-/*
-
-=item C<static opcode_t * runops_switch(PARROT_INTERP, opcode_t *pc)>
-
-Runs the C<switch> core.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t *
-runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_switch)
- opcode_t * const code_start = (opcode_t *)interp->code->base.data;
- opcode_t *pc_prederef;
-
- init_prederef(interp, PARROT_SWITCH_CORE);
- pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
-
- return switch_core(pc_prederef, interp);
-}
-
-
-/*
-
-=item C<void runops_int(PARROT_INTERP, size_t offset)>
-
-Run Parrot operations of loaded code segment until an end opcode is
-reached. Run core is selected depending on the C<Interp_flags>. When a
-C<restart> opcode is encountered, a different core may be selected and
-evaluation of opcode continues.
-
-=cut
-
-*/
-
-void
-runops_int(PARROT_INTERP, size_t offset)
-{
- opcode_t *(*core) (PARROT_INTERP, opcode_t *) = NULL;
-
- /* setup event function ptrs */
- if (!interp->save_func_table)
- Parrot_setup_event_func_ptrs(interp);
-
- interp->resume_offset = offset;
- interp->resume_flag |= RESUME_RESTART;
-
- while (interp->resume_flag & RESUME_RESTART) {
- opcode_t * const pc = (opcode_t *)
- interp->code->base.data + interp->resume_offset;
-
- interp->resume_offset = 0;
- interp->resume_flag &= ~(RESUME_RESTART | RESUME_INITIAL);
-
- switch (interp->run_core) {
- case PARROT_SLOW_CORE:
- core = runops_slow_core;
-
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
- core = runops_profile_core;
- if (interp->profile == NULL) {
- interp->profile = mem_allocate_zeroed_typed(RunProfile);
- interp->profile->data =
- mem_allocate_n_typed((interp->op_count +
- PARROT_PROF_EXTRA), ProfData);
- }
- }
- break;
- case PARROT_FAST_CORE:
- core = runops_fast_core;
- break;
- case PARROT_CGOTO_CORE:
-#ifdef HAVE_COMPUTED_GOTO
- core = runops_cgoto_core;
-#else
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Error: PARROT_CGOTO_CORE not available");
-#endif
- break;
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
-#ifdef HAVE_COMPUTED_GOTO
- core = runops_cgp;
-#else
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Error: PARROT_CGP_CORE not available");
-#endif
- break;
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- core = runops_switch;
- break;
- case PARROT_JIT_CORE:
-#if !JIT_CAPABLE
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_UNAVAILABLE,
- "Error: PARROT_JIT_FLAG is set, "
- "but interpreter is not JIT_CAPABLE!\n");
-#else
- core = runops_jit;
-#endif
- break;
- case PARROT_EXEC_CORE:
-#if !EXEC_CAPABLE
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXEC_UNAVAILABLE,
- "Error: PARROT_EXEC_FLAG is set, "
- "but interpreter is not EXEC_CAPABLE!\n");
-#else
- core = runops_exec;
-#endif
- break;
- case PARROT_GC_DEBUG_CORE:
- core = runops_gc_debug_core;
- break;
- case PARROT_DEBUGGER_CORE:
- core = runops_debugger_core;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "ambigious runcore switch used");
- break;
- }
-
-
- /* run it finally */
- core(interp, pc);
-
- /* if we have fallen out with resume and we were running CGOTO, set
- * the stacktop again to a sane value, so that restarting the runloop
- * is ok. */
- if (interp->resume_flag & RESUME_RESTART) {
- if ((int)interp->resume_offset < 0)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "branch_cs: illegal resume offset");
- stop_prederef(interp);
- }
- }
-}
-
-
-/*
-
-=item C<void Parrot_setup_event_func_ptrs(PARROT_INTERP)>
-
-Setup a C<func_table> containing pointers (or addresses) of the
-C<check_event__> opcode.
-
-TODO: Free it at destroy. Handle run-core changes.
-
-=cut
-
-*/
-
-void
-Parrot_setup_event_func_ptrs(PARROT_INTERP)
-{
- const size_t n = interp->op_count;
- const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
- op_lib_t * const lib = init_func(1);
-
- /* remember op_func_table */
- interp->save_func_table = lib->op_func_table;
-
- if (!lib->op_func_table)
- return;
-
- /* function or CG core - prepare func_table */
- if (!interp->evc_func_table) {
- size_t i;
-
- interp->evc_func_table = mem_allocate_n_typed(n, op_func_t);
-
- for (i = 0; i < n; ++i)
- interp->evc_func_table[i] = (op_func_t)
- D2FPTR(((void**)lib->op_func_table)[CORE_OPS_check_events__]);
- }
-}
-
-
-/*
-
-=back
-
-=head2 Dynamic Loading Functions
-
-=over 4
-
-=item C<void dynop_register(PARROT_INTERP, PMC *lib_pmc)>
-
-Register a dynamic oplib.
-
-=cut
-
-*/
-
-void
-dynop_register(PARROT_INTERP, PMC *lib_pmc)
-{
- op_lib_t *lib, *core;
- oplib_init_f init_func;
- op_func_t *new_func_table, *new_evc_func_table;
- op_info_t *new_info_table;
- size_t i, n_old, n_new, n_tot;
-
- if (n_interpreters > 1) {
- /* This is not supported because oplibs are always shared.
- * If we mem_sys_reallocate() the op_func_table while another
- * interpreter is running using that exact op_func_table,
- * this will cause problems
- * Also, the mapping from op name to op number is global even for
- * dynops (!). The mapping is done by get_op in core_ops.c (even for
- * dynops) and uses a global hash as a cache and relies on modifications
- * to the static-scoped core_op_lib data structure to see dynops.
- */
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "loading a new dynoplib while "
- "more than one thread is running is not supported.");
- }
-
- if (!interp->all_op_libs)
- interp->all_op_libs = (op_lib_t **)mem_sys_allocate(
- sizeof (op_lib_t *) * (interp->n_libs + 1));
- else
- mem_realloc_n_typed(interp->all_op_libs, interp->n_libs + 1,
- op_lib_t *);
-
- init_func = get_dynamic_op_lib_init(interp, lib_pmc);
- lib = init_func(1);
-
- interp->all_op_libs[interp->n_libs++] = lib;
-
- /* if we are registering an op_lib variant, called from below the base
- * names of this lib and the previous one are the same */
- if (interp->n_libs >= 2
- && (STREQ(interp->all_op_libs[interp->n_libs-2]->name, lib->name))) {
- /* registering is handled below */
- return;
- }
-
- /* when called from yyparse, we have to set up the evc_func_table */
- Parrot_setup_event_func_ptrs(interp);
-
- n_old = interp->op_count;
- n_new = lib->op_count;
- n_tot = n_old + n_new;
- core = PARROT_CORE_OPLIB_INIT(1);
-
- PARROT_ASSERT(interp->op_count == core->op_count);
-
- new_evc_func_table = (op_func_t *)mem_sys_realloc(interp->evc_func_table,
- sizeof (op_func_t) * n_tot);
- if (core->flags & OP_FUNC_IS_ALLOCATED) {
- new_func_table = (op_func_t *)mem_sys_realloc(core->op_func_table,
- sizeof (op_func_t) * n_tot);
- new_info_table = (op_info_t *)mem_sys_realloc(core->op_info_table,
- sizeof (op_info_t) * n_tot);
- }
- else {
- /* allocate new op_func and info tables */
- new_func_table = mem_allocate_n_typed(n_tot, op_func_t);
- new_info_table = mem_allocate_n_typed(n_tot, op_info_t);
-
- /* copy old */
- for (i = 0; i < n_old; ++i) {
- new_func_table[i] = interp->op_func_table[i];
- new_info_table[i] = interp->op_info_table[i];
- }
- }
-
- /* add new */
- for (i = n_old; i < n_tot; ++i) {
- new_func_table[i] = ((op_func_t*)lib->op_func_table)[i - n_old];
- new_info_table[i] = lib->op_info_table[i - n_old];
-
- /*
- * fill new ops of event checker func table
- * if we are running a different core, entries are
- * changed below
- */
- new_evc_func_table[i] = interp->op_func_table[CORE_OPS_check_events__];
- }
-
- interp->evc_func_table = new_evc_func_table;
- interp->save_func_table = new_func_table;
-
- /* deinit core, so that it gets rehashed */
- (void) PARROT_CORE_OPLIB_INIT(0);
-
- /* set table */
- core->op_func_table = interp->op_func_table = new_func_table;
- core->op_info_table = interp->op_info_table = new_info_table;
- core->op_count = interp->op_count = n_tot;
- core->flags = OP_FUNC_IS_ALLOCATED | OP_INFO_IS_ALLOCATED;
-
- /* done for plain core */
-#ifdef HAVE_COMPUTED_GOTO
- dynop_register_xx(interp, n_old, n_new, PARROT_CORE_CGP_OPLIB_INIT);
- dynop_register_xx(interp, n_old, n_new, PARROT_CORE_CG_OPLIB_INIT);
-#endif
-
- dynop_register_switch(n_old, n_new);
-}
-
-
-/*
-
-=item C<static void dynop_register_xx(PARROT_INTERP, size_t n_old, size_t n_new,
-oplib_init_f init_func)>
-
-Register C<op_lib> with other cores.
-
-=cut
-
-*/
-
-static void
-dynop_register_xx(PARROT_INTERP,
- size_t n_old, size_t n_new, oplib_init_f init_func)
-{
- ASSERT_ARGS(dynop_register_xx)
- const size_t n_tot = n_old + n_new;
- op_func_t *ops_addr = NULL;
- op_lib_t *cg_lib = init_func(1);
- op_lib_t *new_lib;
-
-#if 0
- /* related to CG and CGP ops issue below */
- STRING *op_variant;
-#endif
-
- oplib_init_f new_init_func;
- PMC *lib_variant;
-
- if (cg_lib->flags & OP_FUNC_IS_ALLOCATED) {
- ops_addr = (op_func_t *)mem_sys_realloc(cg_lib->op_func_table,
- n_tot * sizeof (op_func_t));
- }
- else {
- size_t i;
-
- ops_addr = mem_allocate_n_typed(n_tot, op_func_t);
- cg_lib->flags = OP_FUNC_IS_ALLOCATED;
-
- for (i = 0; i < n_old; ++i)
- ops_addr[i] = cg_lib->op_func_table[i];
- }
-
- /*
- * XXX running CG and CGP ops currently works only via the wrapper
- *
- * the problem is:
- * The actual runcores cg_core and cgp_core are very big functions.
- * The C compiler usually addresses "spilled" registers in the C stack.
- * The loaded opcode lib is another possibly big function, but with
- * a likely different stack layout. Directly jumping around between
- * code locations in these two opcode functions works, but access
- * to stack-ed (or spilled) variables fails badly.
- *
- * We would need to prepare the assembly source of the opcode
- * lib so that all variable access on the stack has the same
- * layout and compile the prepared assembly to ops_cgp?.o
- *
- * The switched core is different anyway, as we can't extend the
- * compiled big switch statement with the new cases. We have
- * always to use the wrapper__ opcode called from the default case.
- */
-#if 0
- /* check if the lib_pmc exists with a _xx flavor */
- new_init_func = get_op_lib_init(0, 0, lib_pmc);
- new_lib = new_init_func(1);
- op_variant = Parrot_sprintf_c(interp, "%s_ops%s",
- new_lib->name, cg_lib->suffix);
- lib_variant = Parrot_load_lib(interp, op_variant, NULL);
-
- /* XXX running CG and CGP ops currently works only via the wrapper */
- if (0 /*lib_variant */) {
- size_t i;
-
- new_init_func = get_dynamic_op_lib_init(interp, lib_variant);
- new_lib = new_init_func(1);
-
- for (i = n_old; i < n_tot; ++i)
- ops_addr[i] = (new_lib->op_func_table)[i - n_old];
-
- new_lib->op_func_table = ops_addr;
- new_lib->op_count = n_tot;
-
- new_init_func((long) ops_addr);
- }
- else
-#endif
- {
- size_t i;
-
- /* if not install wrappers */
- /* fill new entries with the wrapper op */
- for (i = n_old; i < n_tot; ++i)
- ops_addr[i] = (cg_lib->op_func_table)[CORE_OPS_wrapper__];
- }
-
- /* if we are running this core, update event check ops */
- if ((int)interp->run_core == cg_lib->core_type) {
- size_t i;
-
- for (i = n_old; i < n_tot; ++i)
- interp->evc_func_table[i] =
- (op_func_t)ops_addr[CORE_OPS_check_events__];
- interp->save_func_table = ops_addr;
- }
-
- /* tell the cg_core about the new jump table */
- cg_lib->op_func_table = ops_addr;
- cg_lib->op_count = n_tot;
- init_func((long) ops_addr);
-}
-
-
-/*
-
-=item C<static void dynop_register_switch(size_t n_old, size_t n_new)>
-
-Used only at the end of dynop_register. Sums the old and new op_counts
-storing the result into the operations count field of the interpreter
-object.
-
-=cut
-
-*/
-
-static void
-dynop_register_switch(size_t n_old, size_t n_new)
-{
- ASSERT_ARGS(dynop_register_switch)
- op_lib_t * const lib = PARROT_CORE_SWITCH_OPLIB_INIT(1);
- lib->op_count = n_old + n_new;
-}
-
-
-/*
-
-=item C<static void notify_func_table(PARROT_INTERP, op_func_t* table, int on)>
-
-Tell the interpreter's running core about the new function table.
-
-=cut
-
-*/
-
-static void
-notify_func_table(PARROT_INTERP, ARGIN(op_func_t* table), int on)
-{
- ASSERT_ARGS(notify_func_table)
- const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
-
- init_func((long) table);
- switch (interp->run_core) {
- case PARROT_SLOW_CORE: /* normal func core */
- case PARROT_FAST_CORE: /* normal func core */
- case PARROT_CGOTO_CORE: /* cgoto address list */
- case PARROT_DEBUGGER_CORE:
- PARROT_ASSERT(table);
- interp->op_func_table = table;
- break;
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- turn_ev_check(interp, on);
- break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<void disable_event_checking(PARROT_INTERP)>
-
-Restore old function table.
-
-XXX This is only implemented for the function core at present.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-disable_event_checking(PARROT_INTERP)
-{
- /* restore func table */
- PARROT_ASSERT(interp->save_func_table);
- notify_func_table(interp, interp->save_func_table, 0);
-}
-
-
-/*
-
-=item C<void enable_event_checking(PARROT_INTERP)>
-
-Replace func table with one that does event checking for all opcodes.
-
-NOTE: C<enable_event_checking()> is called async by the event handler
-thread. All action done from here has to be async safe.
-
-XXX This is only implemented for the function core at present.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-enable_event_checking(PARROT_INTERP)
-{
- /* put table in place */
- notify_func_table(interp, interp->evc_func_table, 1);
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/interpreter.h>, F<src/inter_cb.c>, F<src/inter_create.c>,
- F<src/inter_misc.c>, F<src/call/ops.c>.
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/src/ops/core.ops
==============================================================================
--- trunk/src/ops/core.ops Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/src/ops/core.ops Wed Apr 22 20:06:30 2009 (r38275)
@@ -5,7 +5,7 @@
#include "parrot/dynext.h"
#include "parrot/embed.h"
-#include "../interp_guts.h"
+#include "parrot/runcore_api.h"
#include "../pmc/pmc_continuation.h"
#include "../pmc/pmc_parrotlibrary.h"
Modified: trunk/src/pic.c
==============================================================================
--- trunk/src/pic.c Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/src/pic.c Wed Apr 22 20:06:30 2009 (r38275)
@@ -972,8 +972,8 @@
=head1 SEE ALSO
-F<src/multidispatch.c>, F<src/object.c>, F<src/interpreter.c>, F<ops/core_ops_cgp.c>,
-F<include/parrot/pic.h>, F<ops/pic.ops>
+L<src/multidispatch.c>, L<src/object.c>, L<src/interp/interpreter.c>,
+L<ops/core_ops_cgp.c>, L<include/parrot/pic.h>, L<ops/pic.ops>
=cut
Copied: trunk/src/runcore/cores.c (from r38257, branches/headercleanup/src/runcore/cores.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/runcore/cores.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/runcore/cores.c)
@@ -0,0 +1,627 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 Run Cores
+
+During execution, the runcore is like the heart of Parrot. The runcore
+controls calling the various opcodes with the correct data, and making
+sure that program flow moves properly. Some runcores, such as the
+I<precomputed C goto runcore> are optimized for speed and don't perform
+many tasks beyond finding and dispatching opcodes. Other runcores,
+such as the I<GC-Debug>, I<debug> and I<profiling> runcores help with
+typical software maintenance and analysis tasks. We'll talk about all
+of these throughout the chapter.
+
+Runcores must pass execution to each opcode in the incoming bytecode
+stream. This is called I<dispatching> the opcodes. Because the different
+runcores are structured in different ways, the opcodes themselves must
+be formated differently. The opcode compiler compiles opcodes into a
+number of separate formats, depending on what runcores are included in
+the compiled Parrot. Because of this, understanding opcodes first
+requires an understanding of the Parrot runcores.
+
+Parrot has multiple runcores. Some are useful for particular maintenance
+tasks, some are only available as optimizations in certain compilers,
+some are intended for general use, and some are just interesing flights
+of fancy with no practical benefits. Here we list the various runcores,
+their uses, and their benefits.
+
+=head2 Slow Core
+
+The slow core is a basic runcore design that treats each opcode as a
+separate function at the C level. Each function is called, and returns
+the address of the next opcode to be called by the core. The slow core
+performs bounds checking to ensure that the next opcode to be called is
+properly in bounds, and not somewhere random in memory. Because of this
+modular approach where opcodes are treated as separate executable
+entities many other runcores, especially diagnostic and maintenance
+cores are based on this design. The program counter C<pc> is the current
+index into the bytecode stream. Here is a pseudocode representation for
+how the slow core works:
+
+ while(1) {
+ pc = NEXT_OPCODE;
+ if(pc < LOW_BOUND || pc > HIGH_BOUND)
+ throw exception;
+ DISPATCH_OPCODE(pc);
+ UPDATE_INTERPRETER();
+ }
+
+=head2 Fast Core
+
+The fast core is a bare-bones core that doesn't do any of the
+bounds-checking or context updating that the slow core does. The fast
+core is the way Parrot should run, and is used to find and debug places
+where execution strays outside of its normal bounds. In pseudocode, the
+fast core is very much like the slow core except it doesn't do the bounds
+checking between each instruction, and doesn't update the interpreter's
+current context for each dispatch.
+
+ while(1) {
+ pc = NEXT_OPCODE;
+ DISPATCH_OPCODE(pc);
+ }
+
+=head2 Switch Core
+
+As its name implies, the switch core uses a gigantic C C<switch / case>
+structure to execute opcodes. Here's a brief example of how this
+architecture works:
+
+ for( ; ; current_opcode++) {
+ switch(*current_opcode) {
+ case opcode_1:
+ ...
+ case opcode_2:
+ ...
+ case opcode_3:
+ ...
+ }
+ }
+
+This is quite a fast architecture for dispatching opcodes because it all
+happens within a single function. The only operations performed between
+opcodes is a jump back to the top of the loop, incrementing the opcode
+pointer, dereferencing the opcode pointer, and then a jump to the C<case>
+statement for the next opcode.
+
+=head2 Computed Goto Core
+
+I<Computed Goto> is a feature of some C compilers where a label is
+treated as a piece of data that can be stored as a C<void *> pointer. Each
+opcode becomes simply a label in a very large function, and pointers to the
+labels are stored in a large array. Calling an opcode is as easy as taking
+that opcode's number as the index of the label array, and calling the
+associated label. Sound complicated? It is a little, especially to C
+programmers who are not used to using labels, much less treating them as
+first class data items.
+
+Notice that computed goto is a feature only available in some compilers
+such as GCC, and will not be available in every distribution of Parrot,
+depending what compilers were used to build it.
+
+As was mentioned earlier, not all compilers support computed goto, which
+means that this core will not be built on platforms that don't support it.
+However, it's still an interesting topic to study so we will look at it
+briefly here. For compilers that support it, computed goto labels are
+C<void **> values. In the computed goto core, all the labels represent
+different opcodes, so they are stored in an array:
+
+ void *my_labels[] = {
+ &&label1,
+ &&label2,
+ &&label3
+ };
+
+ label1:
+ ...
+ label2:
+ ...
+ label3:
+ ...
+
+Jumping to one of these labels is done with a command like this:
+
+ goto *my_labels[opcode_number];
+
+Actually, opcodes are pointed to by an C<opcode_t *> pointer, and all
+opcodes are stored sequentially in memory, so the actual jump in the
+computed goto core must increment the pointer and then jump to the new
+version. In C it looks something like this:
+
+ goto *my_labels[*(current_opcode += 1)];
+
+Each opcode is an index into the array of labels, and at the end of each
+opcode an instruction like this is performed to move to the next opcode
+in series, or else some kind of control flow occurs that moves it to a
+non-sequential location:
+
+ goto *my_lables[*(current_opcode = destination)];
+
+These are simplifications on what really happens in this core, because
+the actual code has been optimized quite a bit from what has been
+presented here. However, as we shall see with the precomputed goto core,
+it isn't optimized as aggressively as is possible.
+
+=head2 Precomputed Goto Core
+
+The precomputed goto core is an amazingly fast optimized core that uses
+the same computed goto feature, but performs the array dereferencing
+before the core even starts. The compiled bytecode is fed into a
+preprocessor that converts the bytecode instruction numbers into lable
+pointer values. In the computed goto core, you have this
+operation to move to the next opcode:
+
+ goto *my_labels[*(current_opcode += 1)];
+
+This single line of code is deceptively complex. A number of machine code
+operations must be performed to complete this step: The value of
+C<current_opcode> must be incremented to the next value, that value must
+be dereferenced to find the opcode value. In C, arrays are pointers, so
+C<my_labels> gets dereferenced and an offset is taken from it to find
+the stored label reference. That label reference is then dereferenced, and
+the jump is performed.
+
+That's a lot of steps to execute before we can jump to the next opcode.
+What if each opcode value was replaced with the value of the jump
+label beforehand? If C<current_opcode> points to a label pointer directly,
+we don't need to perform an additional dereference on the array at all. We
+can replace that entire mess above with this line:
+
+ goto **(current_opcode += 1);
+
+That's far fewer machine instructions to execute before we can move to the
+next opcode, which means faster throughput. Remember that whatever dispatch
+mechanism is used will be called after every single opcode, and some large
+programs may have millions of opcodes! Every single machine instruction
+that can be cut out of the dispatch mechanism could increase the execution
+speed of Parrot in a significant and noticable way. B<The dispatch mechanism
+used by the various runcores is hardly the largest performance bottleneck in
+Parrot anyway, but we like to use faster cores to shave every little bit of
+speed out of the system>.
+
+The caveat of course is that the predereferenced computed goto core is only
+available with compilers that support computed goto, such as GCC. Parrot
+will not have access to this core if it is built with a different compiler.
+
+=head2 Tracing Core
+
+To come.
+
+=head2 Profiling Core
+
+The profiling core analyzes the performance of Parrot, and helps to
+determine where bottlenecks and trouble spots are in the programs that
+run on top of Parrot. When Parrot calls a PIR subroutine it sets up the
+environment, allocates storage for the passed parameters and the return
+values, passes the parameters, and calls a new runcore to execute it. To
+calculate the amount of time that each subroutine takes, we need to
+measure the amount of time spent in each runcore from the time the core
+begins to the time the core executes. The profiling core does exactly
+this, acting very similarly to a slow core but also measuring the amount
+of time it takes for the core to complete. The tracing core actually
+keeps track of a few additional values, including the number of GC cycles
+run while in the subroutine, the number of each opcode called and the
+number of calls to each subroutine made. All this information is helpfully
+printed to the STDERR output for later analysis.
+
+=head2 GC Debug Core
+
+Parrot's garbage collector has been known as a weakness in the system
+for several years. In fact, the garbage collector and memory management
+subsystem was one of the last systems to be improved and rewritten before
+the release of version 1.0. It's not that garbage collection isn't
+important, but instead that it was so hard to do earlier in the project.
+
+Early on when the GC was such a weakness, and later when the GC was under
+active development, it was useful to have an operational mode that would
+really exercise the GC and find bugs that otherwise could hide by sheer
+chance. The GC debug runcore was this tool. The core executes a complete
+collection iteration between every single opcode. The throughput
+performance is terrible, but that's not the point: it's almost guaranteed
+to find problems in the memory system if they exist.
+
+=head2 Debug Core
+
+The debug core works like a normal software debugger, such as GDB. The
+debug core executes each opcode, and then prompts the user to enter a
+command. These commands can be used to continue execution, step to the
+next opcode, or examine and manipulate data from the executing program.
+
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/runcore_api.h"
+#include "parrot/embed.h"
+#include "parrot/runcore_trace.h"
+
+#ifdef HAVE_COMPUTED_GOTO
+# include "parrot/oplib/core_ops_cg.h"
+#endif
+
+/* HEADERIZER HFILE: include/parrot/runcore_api.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_runops_trace_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+/*
+
+=item C<opcode_t * runops_fast_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations. This performs no bounds checking, profiling, or tracing.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_fast_core)
+
+ /* disable pc */
+ CONTEXT(interp)->current_pc = NULL;
+
+ while (pc) {
+ DO_OP(pc, interp);
+ }
+
+ return pc;
+}
+
+
+/*
+
+=item C<opcode_t * runops_cgoto_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations, using the computed C<goto> core, performing no bounds checking,
+profiling, or tracing.
+
+If computed C<goto> is not available then Parrot exits with exit code 1.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_cgoto_core)
+
+ /* disable pc */
+ CONTEXT(interp)->current_pc = NULL;
+
+#ifdef HAVE_COMPUTED_GOTO
+ pc = cg_core(pc, interp);
+ return pc;
+#else
+ UNUSED(pc);
+ Parrot_io_eprintf(interp,
+ "Computed goto unavailable in this configuration.\n");
+ Parrot_exit(interp, 1);
+#endif
+}
+
+#ifdef code_start
+# undef code_start
+#endif
+#ifdef code_end
+# undef code_end
+#endif
+
+#define code_start interp->code->base.data
+#define code_end (interp->code->base.data + interp->code->base.size)
+
+
+/*
+
+=item C<static opcode_t * runops_trace_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations, using the tracing interpreter.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t *
+runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_trace_core)
+
+ static size_t gc_mark_runs, gc_collect_runs;
+ Arenas * const arena_base = interp->arena_base;
+ Interp *debugger;
+
+ gc_mark_runs = arena_base->gc_mark_runs;
+ gc_collect_runs = arena_base->gc_collect_runs;
+ if (interp->pdb) {
+ debugger = interp->pdb->debugger;
+ PARROT_ASSERT(debugger);
+ }
+ else {
+ PMC *pio;
+
+ /*
+ * using a distinct interpreter for tracing should be ok
+ * - just in case, make it easy to switch
+ */
+#if 0
+ debugger = interp:
+#else
+ Parrot_debugger_init(interp);
+ PARROT_ASSERT(interp->pdb);
+ debugger = interp->pdb->debugger;
+#endif
+ PARROT_ASSERT(debugger);
+
+ /* set the top of the stack so GC can trace it for GC-able pointers
+ * see trace_system_areas() in src/cpu_dep.c */
+ debugger->lo_var_ptr = interp->lo_var_ptr;
+
+ pio = Parrot_io_STDERR(debugger);
+
+ if (Parrot_io_is_tty(debugger, pio))
+ Parrot_io_setlinebuf(debugger, pio);
+ else {
+ /* this is essential (100 x faster!) and should probably
+ * be in init/open code */
+ Parrot_io_setbuf(debugger, pio, 8192);
+ }
+ }
+
+ trace_op(interp, code_start, code_end, pc);
+ while (pc) {
+ if (pc < code_start || pc >= code_end)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "attempt to access code outside of current code segment");
+
+ CONTEXT(interp)->current_pc = pc;
+
+ DO_OP(pc, interp);
+ trace_op(interp, code_start, code_end, pc);
+
+ if (gc_mark_runs != arena_base->gc_mark_runs) {
+ gc_mark_runs = arena_base->gc_mark_runs;
+ Parrot_io_eprintf(debugger, " GC mark\n");
+ }
+
+ if (gc_collect_runs != arena_base->gc_collect_runs) {
+ gc_collect_runs = arena_base->gc_collect_runs;
+ Parrot_io_eprintf(debugger, " GC collect\n");
+ }
+ }
+
+ Parrot_io_flush(debugger, Parrot_io_STDERR(debugger));
+
+ return pc;
+}
+
+
+/*
+
+=item C<opcode_t * runops_slow_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations, with tracing and bounds checking enabled.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_slow_core)
+
+ if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG))
+ return runops_trace_core(interp, pc);
+#if 0
+ if (interp->debugger && interp->debugger->pdb)
+ return Parrot_debug(interp, interp->debugger, pc);
+#endif
+
+ while (pc) {
+ if (pc < code_start || pc >= code_end)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "attempt to access code outside of current code segment");
+
+ CONTEXT(interp)->current_pc = pc;
+
+ DO_OP(pc, interp);
+ }
+
+ return pc;
+}
+
+
+/*
+
+=item C<opcode_t * runops_gc_debug_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations, performing a full GC run before each op. This is very slow, but
+it's also a very quick way to find GC problems.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_gc_debug_core)
+ while (pc) {
+ if (pc < code_start || pc >= code_end)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "attempt to access code outside of current code segment");
+
+ Parrot_do_gc_run(interp, 0);
+ CONTEXT(interp)->current_pc = pc;
+
+ DO_OP(pc, interp);
+ }
+
+ return pc;
+}
+
+#undef code_start
+#undef code_end
+
+
+/*
+
+=item C<opcode_t * runops_profile_core(PARROT_INTERP, opcode_t *pc)>
+
+Runs the Parrot operations starting at C<pc> until there are no more
+operations, with tracing, bounds checking, and profiling enabled.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_profile_core)
+ RunProfile * const profile = interp->profile;
+ const opcode_t old_op = profile->cur_op;
+
+ /* if reentering the runloop, remember old op and calc time 'til now */
+ if (old_op)
+ profile->data[old_op].time +=
+ Parrot_floatval_time() - profile->starttime;
+
+ while (pc) {/* && pc >= code_start && pc < code_end) */
+ opcode_t cur_op;
+
+ CONTEXT(interp)->current_pc = pc;
+ profile->cur_op = cur_op = *pc + PARROT_PROF_EXTRA;
+ profile->starttime = Parrot_floatval_time();
+ profile->data[cur_op].numcalls++;
+
+ DO_OP(pc, interp);
+
+ /* profile->cur_op may be different, if exception was thrown */
+ profile->data[profile->cur_op].time +=
+ Parrot_floatval_time() - profile->starttime;
+ }
+
+ if (old_op) {
+ /* old opcode continues */
+ profile->starttime = Parrot_floatval_time();
+ profile->cur_op = old_op;
+ }
+
+ return pc;
+}
+
+/*
+
+=item C<opcode_t * runops_debugger_core(PARROT_INTERP, opcode_t *pc)>
+
+Used by the debugger, under construction
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+opcode_t *
+runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_debugger_core)
+ /*fprintf(stderr, "Enter runops_debugger_core\n");*/
+
+ PARROT_ASSERT(interp->pdb);
+
+ if (interp->pdb->state & PDB_ENTER) {
+ Parrot_debugger_start(interp, pc);
+ }
+
+ while (pc) {
+ if (pc < interp->code->base.data || pc >= interp->code->base.data + interp->code->base.size)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "attempt to access code outside of current code segment");
+
+ if (interp->pdb->state & PDB_GCDEBUG)
+ Parrot_do_gc_run(interp, 0);
+
+ if (interp->pdb->state & PDB_TRACING) {
+ trace_op(interp,
+ interp->code->base.data,
+ interp->code->base.data +
+ interp->code->base.size,
+ pc);
+ }
+
+ CONTEXT(interp)->current_pc = pc;
+ DO_OP(pc, interp);
+
+ if (interp->pdb->state & PDB_STOPPED) {
+ Parrot_debugger_start(interp, pc);
+ }
+ else
+ {
+ if (PDB_break(interp)) {
+ Parrot_debugger_start(interp, pc);
+ continue;
+ }
+
+ if (interp->pdb->tracing) {
+ if (--interp->pdb->tracing == 0) {
+ Parrot_debugger_start(interp, pc);
+ }
+ }
+ }
+ }
+
+ return pc;
+}
+
+/*
+
+=back
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: trunk/src/runcore/main.c (from r38257, branches/headercleanup/src/runcore/main.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/runcore/main.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/runcore/main.c)
@@ -0,0 +1,1393 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/runcore/main.c - main functions for Parrot runcores
+
+=head1 DESCRIPTION
+
+The runcore API handles running the operations.
+
+The predereferenced code chunk is pre-initialized with the opcode
+function pointers, addresses, or opnumbers of the C<prederef__>
+opcode. This opcode then calls the C<do_prederef()> function, which then
+fills in the real function, address or op number.
+
+Because the C<prederef__> opcode returns the same C<pc_prederef> it was
+passed, the runops loop will re-execute the same location, which will
+then have the pointer to the real C<prederef> opfunc and C<prederef>
+args.
+
+Pointer arithmetic is used to determine the index into the bytecode
+corresponding to the currect opcode. The bytecode and prederef arrays
+have the same number of elements because there is a one-to-one mapping.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/runcore_api.h"
+#include "parrot/oplib/core_ops.h"
+#include "parrot/oplib/core_ops_switch.h"
+#include "parrot/oplib/ops.h"
+#if JIT_CAPABLE
+# include "parrot/exec.h"
+# include "../jit.h"
+#endif
+#ifdef HAVE_COMPUTED_GOTO
+# include "parrot/oplib/core_ops_cg.h"
+# include "parrot/oplib/core_ops_cgp.h"
+#endif
+#include "parrot/dynext.h"
+#include "../pmc/pmc_parrotlibrary.h"
+
+
+/* HEADERIZER HFILE: none */
+/* XXX Needs to get done at the same time as the other interpreter files */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void dynop_register_switch(size_t n_old, size_t n_new);
+static void dynop_register_xx(PARROT_INTERP,
+ size_t n_old,
+ size_t n_new,
+ oplib_init_f init_func)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static oplib_init_f get_dynamic_op_lib_init(SHIM_INTERP,
+ ARGIN(const PMC *lib))
+ __attribute__nonnull__(2);
+
+static void init_prederef(PARROT_INTERP, int which)
+ __attribute__nonnull__(1);
+
+static void load_prederef(PARROT_INTERP, int which)
+ __attribute__nonnull__(1);
+
+static void notify_func_table(PARROT_INTERP,
+ ARGIN(op_func_t* table),
+ int on)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void prederef_args(
+ ARGMOD(void **pc_prederef),
+ PARROT_INTERP,
+ ARGIN(opcode_t *pc),
+ ARGIN(const op_info_t *opinfo))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4)
+ FUNC_MODIFIES(*pc_prederef);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t * runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t * runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void stop_prederef(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+static void turn_ev_check(PARROT_INTERP, int on)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_dynop_register_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+#define ASSERT_ARGS_dynop_register_xx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_core_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_dynamic_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(lib)
+#define ASSERT_ARGS_init_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_load_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_notify_func_table __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(table)
+#define ASSERT_ARGS_prederef_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pc_prederef) \
+ || PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc) \
+ || PARROT_ASSERT_ARG(opinfo)
+#define ASSERT_ARGS_runops_cgp __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_exec __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_jit __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_stop_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_turn_ev_check __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: static */
+
+#if EXEC_CAPABLE
+ extern int Parrot_exec_run;
+#endif
+
+/*
+
+=item C<static void prederef_args(void **pc_prederef, PARROT_INTERP, opcode_t
+*pc, const op_info_t *opinfo)>
+
+Called from C<do_prederef()> to deal with any arguments.
+
+C<pc_prederef> is the current opcode.
+
+=cut
+
+*/
+
+static void
+prederef_args(ARGMOD(void **pc_prederef), PARROT_INTERP,
+ ARGIN(opcode_t *pc), ARGIN(const op_info_t *opinfo))
+{
+ ASSERT_ARGS(prederef_args)
+ const PackFile_ConstTable * const const_table = interp->code->const_table;
+
+ const int regs_n = CONTEXT(interp)->n_regs_used[REGNO_NUM];
+ const int regs_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
+ const int regs_p = CONTEXT(interp)->n_regs_used[REGNO_PMC];
+ const int regs_s = CONTEXT(interp)->n_regs_used[REGNO_STR];
+
+ /* prederef var part too */
+ const int m = opinfo->op_count;
+ int n = opinfo->op_count;
+ int i;
+
+ ADD_OP_VAR_PART(interp, interp->code, pc, n);
+ for (i = 1; i < n; i++) {
+ const opcode_t arg = pc[i];
+ int type;
+ if (i >= m) {
+ PMC * const sig = (PMC*) pc_prederef[1];
+ type = VTABLE_get_integer_keyed_int(interp, sig, i - m);
+ type &= (PARROT_ARG_TYPE_MASK | PARROT_ARG_CONSTANT);
+ }
+ else
+ type = opinfo->types[i - 1];
+
+ switch (type) {
+
+ case PARROT_ARG_KI:
+ case PARROT_ARG_I:
+ if (arg < 0 || arg >= regs_i)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal register number");
+
+ pc_prederef[i] = (void *)REG_OFFS_INT(arg);
+ break;
+
+ case PARROT_ARG_N:
+ if (arg < 0 || arg >= regs_n)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal register number");
+
+ pc_prederef[i] = (void *)REG_OFFS_NUM(arg);
+ break;
+
+ case PARROT_ARG_K:
+ case PARROT_ARG_P:
+ if (arg < 0 || arg >= regs_p)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal register number");
+
+ pc_prederef[i] = (void *)REG_OFFS_PMC(arg);
+ break;
+
+ case PARROT_ARG_S:
+ if (arg < 0 || arg >= regs_s)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal register number");
+
+ pc_prederef[i] = (void *)REG_OFFS_STR(arg);
+ break;
+
+ case PARROT_ARG_KIC:
+ case PARROT_ARG_IC:
+ pc_prederef[i] = (void *)pc[i];
+ break;
+
+ case PARROT_ARG_NC:
+ if (arg < 0 || arg >= const_table->const_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal constant number");
+
+ pc_prederef[i] = (void *)&const_table->constants[arg]->u.number;
+ break;
+
+ case PARROT_ARG_SC:
+ if (arg < 0 || arg >= const_table->const_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal constant number");
+
+ pc_prederef[i] = (void *)const_table->constants[arg]->u.string;
+ break;
+
+ case PARROT_ARG_PC:
+ case PARROT_ARG_KC:
+ if (arg < 0 || arg >= const_table->const_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal constant number");
+
+ pc_prederef[i] = (void *)const_table->constants[arg]->u.key;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ARG_OP_NOT_HANDLED,
+ "Unhandled argtype 0x%x\n", type);
+ break;
+ }
+ }
+}
+
+
+/*
+
+=item C<void do_prederef(void **pc_prederef, PARROT_INTERP, int type)>
+
+This is called from within the run cores to predereference the current
+opcode.
+
+C<pc_prederef> is the current opcode, and C<type> is the run core type.
+
+=cut
+
+*/
+
+void
+do_prederef(void **pc_prederef, PARROT_INTERP, int type)
+{
+ const size_t offset = pc_prederef - interp->code->prederef.code;
+ opcode_t * const pc = ((opcode_t *)interp->code->base.data) + offset;
+ const op_info_t *opinfo;
+ size_t n;
+
+ if (*pc < 0 || *pc >= (opcode_t)interp->op_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INTERP_ERROR,
+ "Illegal opcode");
+
+ opinfo = &interp->op_info_table[*pc];
+
+ /* first arguments - PIC needs it */
+
+ /* check for RT#58044 */
+ PARROT_ASSERT(CONTEXT(interp)->n_regs_used);
+
+ prederef_args(pc_prederef, interp, pc, opinfo);
+
+ switch (type) {
+ case PARROT_SWITCH_CORE:
+ case PARROT_SWITCH_JIT_CORE:
+ case PARROT_CGP_CORE:
+ case PARROT_CGP_JIT_CORE:
+ parrot_PIC_prederef(interp, *pc, pc_prederef, type);
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Tried to prederef wrong core");
+ break;
+ }
+
+ /* now remember backward branches, invoke and similar opcodes */
+ n = opinfo->op_count;
+
+ if (((opinfo->jump & PARROT_JUMP_RELATIVE)
+ && opinfo->types[n - 2] == PARROT_ARG_IC
+ && pc[n - 1] < 0) /* relative backward branch */
+ || (opinfo->jump & PARROT_JUMP_ADDRESS)) {
+ Prederef * const pi = &interp->code->prederef;
+
+ /* first time prederef.branches == NULL:
+ * estimate size to 1/16th of opcodes */
+ if (!pi->branches) {
+ size_t nb = interp->code->base.size / 16;
+ if (nb < 8)
+ nb = (size_t)8;
+
+ pi->branches = mem_allocate_n_typed(nb, Prederef_branch);
+ pi->n_allocated = nb;
+ pi->n_branches = 0;
+ }
+ else if (pi->n_branches >= pi->n_allocated) {
+ pi->n_allocated = (size_t) (pi->n_allocated * 1.5);
+ mem_realloc_n_typed(pi->branches, pi->n_allocated, Prederef_branch);
+ }
+
+ pi->branches[pi->n_branches].offs = offset;
+ pi->branches[pi->n_branches].op = *pc_prederef;
+
+ ++pi->n_branches;
+ }
+}
+
+
+/*
+
+=item C<static void turn_ev_check(PARROT_INTERP, int on)>
+
+Turn on or off event checking for prederefed cores.
+
+Fills in the C<event_checker> opcode, or restores original ops in all
+branch locations of the opcode stream.
+
+Note that when C<on> is true, this is being called from the event
+handler thread.
+
+=cut
+
+*/
+
+static void
+turn_ev_check(PARROT_INTERP, int on)
+{
+ ASSERT_ARGS(turn_ev_check)
+ const Prederef * const pi = &interp->code->prederef;
+ size_t i;
+
+ if (!pi->branches)
+ return;
+
+ for (i = 0; i < pi->n_branches; ++i) {
+ const size_t offs = pi->branches[i].offs;
+ if (on)
+ interp->code->prederef.code[offs] =
+ ((void **)interp->op_lib->op_func_table)
+ [CORE_OPS_check_events__];
+ else
+ interp->code->prederef.code[offs] = pi->branches[i].op;
+ }
+}
+
+
+/*
+
+=item C<static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)>
+
+Returns an opcode's library C<op_lib> init function.
+
+C<which> is the run core type.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static oplib_init_f
+get_core_op_lib_init(PARROT_INTERP, int which)
+{
+ ASSERT_ARGS(get_core_op_lib_init)
+ oplib_init_f init_func;
+ switch (which) {
+ case PARROT_SWITCH_CORE:
+ case PARROT_SWITCH_JIT_CORE:
+ init_func = PARROT_CORE_SWITCH_OPLIB_INIT;
+ break;
+#ifdef HAVE_COMPUTED_GOTO
+ case PARROT_CGP_CORE:
+ case PARROT_CGP_JIT_CORE:
+ init_func = PARROT_CORE_CGP_OPLIB_INIT;
+ break;
+ case PARROT_CGOTO_CORE:
+ init_func = PARROT_CORE_CG_OPLIB_INIT;
+ break;
+#endif
+ /* normal func core */
+ case PARROT_EXEC_CORE:
+ case PARROT_JIT_CORE:
+ case PARROT_SLOW_CORE:
+ case PARROT_FAST_CORE:
+ case PARROT_GC_DEBUG_CORE:
+ case PARROT_DEBUGGER_CORE:
+ init_func = PARROT_CORE_OPLIB_INIT;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Couldn't find init_func for core %d", which);
+ }
+
+ return init_func;
+}
+
+
+/*
+
+=item C<static oplib_init_f get_dynamic_op_lib_init(PARROT_INTERP, const PMC
+*lib)>
+
+Returns an dynamic oplib's opcode's library C<op_lib> init function.
+
+C<lib> will be a C<ParrotLibrary> PMC.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static oplib_init_f
+get_dynamic_op_lib_init(SHIM_INTERP, ARGIN(const PMC *lib))
+{
+ ASSERT_ARGS(get_dynamic_op_lib_init)
+ return (oplib_init_f)D2FPTR(
+ ((Parrot_ParrotLibrary_attributes *)PMC_data(lib))->oplib_init);
+}
+
+
+/*
+
+=item C<static void load_prederef(PARROT_INTERP, int which)>
+
+C<< interp->op_lib >> = prederefed oplib.
+
+=cut
+
+*/
+
+static void
+load_prederef(PARROT_INTERP, int which)
+{
+ ASSERT_ARGS(load_prederef)
+ const oplib_init_f init_func = get_core_op_lib_init(interp, which);
+
+ int (*get_op)(const char * name, int full);
+
+ get_op = interp->op_lib->op_code;
+ interp->op_lib = init_func(1);
+
+ /* preserve the get_op function */
+ interp->op_lib->op_code = get_op;
+
+ if (interp->op_lib->op_count != interp->op_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PREDEREF_LOAD_ERROR,
+ "Illegal op count (%d) in prederef oplib\n",
+ (int)interp->op_lib->op_count);
+}
+
+
+/*
+
+=item C<static void init_prederef(PARROT_INTERP, int which)>
+
+Initialize: load prederef C<func_table>, file prederef.code.
+
+=cut
+
+*/
+
+static void
+init_prederef(PARROT_INTERP, int which)
+{
+ ASSERT_ARGS(init_prederef)
+ load_prederef(interp, which);
+ if (!interp->code->prederef.code) {
+ void *pred_func;
+ opcode_t *pc = interp->code->base.data;
+ const size_t N = interp->code->base.size;
+ size_t i, n_pics;
+
+/* Parrot_memalign_if_possible in OpenBSD allocates 256 if you ask for 312
+ -- Need to verify this, it may have been a bug elsewhere. If it works now,
+ we can remove the mem_sys_allocate_zeroed line below. */
+
+#if 0
+ void **temp = (void **)mem_sys_allocate_zeroed(N * sizeof (void *));
+#else
+ void **temp = (void **)Parrot_memalign_if_possible(256,
+ N * sizeof (void *));
+#endif
+ /* calc and remember pred_offset */
+ CONTEXT(interp)->pred_offset = pc - (opcode_t *)temp;
+
+ /* fill with the prederef__ opcode function */
+ if (which == PARROT_SWITCH_CORE || which == PARROT_SWITCH_JIT_CORE)
+ pred_func = (void *)CORE_OPS_prederef__;
+ else
+ pred_func = ((void **)
+ interp->op_lib->op_func_table)[CORE_OPS_prederef__];
+
+ for (i = n_pics = 0; i < N;) {
+ op_info_t * const opinfo = &interp->op_info_table[*pc];
+ size_t n = opinfo->op_count;
+
+ temp[i] = pred_func;
+
+ ADD_OP_VAR_PART(interp, interp->code, pc, n);
+
+ /* count ops that need a PIC */
+ if (parrot_PIC_op_is_cached(*pc))
+ n_pics++;
+
+ pc += n;
+ i += n;
+ }
+
+ interp->code->prederef.code = temp;
+
+ /* allocate pic store, which starts from 1 */
+ if (n_pics)
+ parrot_PIC_alloc_store(interp->code, n_pics + 1);
+ }
+}
+
+
+/*
+
+=item C<static void stop_prederef(PARROT_INTERP)>
+
+Restore the interpreter's op function tables to their initial state.
+Also recreate the event function pointers. This is only necessary
+for run-core changes, but we don't know the old run core.
+
+=cut
+
+*/
+
+static void
+stop_prederef(PARROT_INTERP)
+{
+ ASSERT_ARGS(stop_prederef)
+ interp->op_func_table = PARROT_CORE_OPLIB_INIT(1)->op_func_table;
+
+ if (interp->evc_func_table) {
+ mem_sys_free(interp->evc_func_table);
+ interp->evc_func_table = NULL;
+ }
+
+ Parrot_setup_event_func_ptrs(interp);
+}
+
+
+#if EXEC_CAPABLE
+
+/*
+
+=item C<void exec_init_prederef(PARROT_INTERP, void *prederef_arena)>
+
+C<< interp->op_lib >> = prederefed oplib
+
+The "normal" C<op_lib> has a copy in the interpreter structure - but get
+the C<op_code> lookup function from standard core prederef has no
+C<op_info_table>
+
+=cut
+
+*/
+
+void
+exec_init_prederef(PARROT_INTERP, void *prederef_arena)
+{
+ load_prederef(interp, PARROT_CGP_CORE);
+
+ if (!interp->code->prederef.code) {
+ void **temp = (void **)prederef_arena;
+
+ interp->code->prederef.code = temp;
+ /* TODO */
+ }
+}
+
+#endif
+
+
+/*
+
+=item C<void * init_jit(PARROT_INTERP, opcode_t *pc)>
+
+Initializes JIT function for the specified opcode and returns it.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+void *
+init_jit(PARROT_INTERP, SHIM(opcode_t *pc))
+{
+#if JIT_CAPABLE
+ opcode_t *code_start;
+ UINTVAL code_size; /* in opcodes */
+ opcode_t *code_end;
+ Parrot_jit_info_t *jit_info;
+
+ if (interp->code->jit_info)
+ return ((Parrot_jit_info_t *)interp->code->jit_info)->arena.start;
+
+ code_start = interp->code->base.data;
+ code_size = interp->code->base.size;
+ code_end = code_start + code_size;
+
+# if defined HAVE_COMPUTED_GOTO && PARROT_I386_JIT_CGP
+# ifdef __GNUC__
+# ifdef PARROT_I386
+ init_prederef(interp, PARROT_CGP_CORE);
+# endif
+# endif
+# endif
+
+ interp->code->jit_info =
+ jit_info = parrot_build_asm(interp, code_start, code_end,
+ NULL, JIT_CODE_FILE);
+
+ return jit_info->arena.start;
+#else
+ UNUSED(interp);
+ return NULL;
+#endif
+
+}
+
+
+/*
+
+=item C<void prepare_for_run(PARROT_INTERP)>
+
+Prepares to run the interpreter's run core.
+
+=cut
+
+*/
+
+void
+prepare_for_run(PARROT_INTERP)
+{
+ void *ignored;
+ switch (interp->run_core) {
+ case PARROT_JIT_CORE:
+ ignored = init_jit(interp, interp->code->base.data);
+ UNUSED(ignored);
+ break;
+ case PARROT_SWITCH_CORE:
+ case PARROT_SWITCH_JIT_CORE:
+ case PARROT_CGP_CORE:
+ case PARROT_CGP_JIT_CORE:
+ case PARROT_DEBUGGER_CORE:
+ init_prederef(interp, interp->run_core);
+ break;
+ default:
+ break;
+ }
+}
+
+
+#ifdef PARROT_EXEC_OS_AIX
+extern void* aix_get_toc();
+#endif
+
+/*
+
+=item C<static opcode_t * runops_jit(PARROT_INTERP, opcode_t *pc)>
+
+Runs the JIT code for the specified opcode.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t *
+runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_jit)
+#if JIT_CAPABLE
+# ifdef PARROT_EXEC_OS_AIX
+ /* AIX calling convention requires that function-call-by-ptr be made
+ through the following struct: */
+ struct ptrgl_t { jit_f functPtr; void *toc; void *env; } ptrgl_t;
+
+ ptrgl_t.functPtr = (jit_f) D2FPTR(init_jit(interp, pc));
+ ptrgl_t.env = NULL;
+
+ /* r2 (TOC) needs to point back here so we can return from non-JIT
+ functions */
+ ptrgl_t.toc = aix_get_toc();
+
+ ((jit_f) D2FPTR(&ptrgl_t)) (interp, pc);
+# else
+ jit_f jit_code = (jit_f)(init_jit(interp, pc));
+ (jit_code) (interp, pc);
+# endif
+#else
+ UNUSED(interp);
+ UNUSED(pc);
+#endif
+ return NULL;
+}
+
+
+/*
+
+=item C<static opcode_t * runops_exec(PARROT_INTERP, opcode_t *pc)>
+
+Runs the native executable version of the specified opcode.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t *
+runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_exec)
+#if EXEC_CAPABLE
+ opcode_t *code_start;
+ UINTVAL code_size; /* in opcodes */
+ opcode_t *code_end;
+
+ code_start = interp->code->base.data;
+ code_size = interp->code->base.size;
+ code_end = code_start + code_size;
+# if defined HAVE_COMPUTED_GOTO && defined USE_CGP
+# ifdef __GNUC__
+# ifdef PARROT_I386
+ init_prederef(interp, PARROT_CGP_CORE);
+# endif
+# endif
+# endif
+ if (Parrot_exec_run == 2) {
+ void *ignored;
+ Parrot_exec_run = 0;
+
+ Interp_core_SET(interp, PARROT_JIT_CORE);
+ ignored = runops_jit(interp, pc);
+ UNUSED(ignored);
+
+ Interp_core_SET(interp, PARROT_EXEC_CORE);
+ }
+ else if (Parrot_exec_run == 1)
+ Parrot_exec(interp, pc, code_start, code_end);
+ else
+ run_native(interp, pc, code_start);
+
+#else
+ UNUSED(interp);
+ UNUSED(pc);
+#endif
+
+ return NULL;
+}
+
+
+/*
+
+=item C<static opcode_t * runops_cgp(PARROT_INTERP, opcode_t *pc)>
+
+Runs the C C<goto>, predereferenced core.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t *
+runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_cgp)
+#ifdef HAVE_COMPUTED_GOTO
+ opcode_t * const code_start = (opcode_t *)interp->code->base.data;
+ opcode_t *pc_prederef;
+
+ init_prederef(interp, PARROT_CGP_CORE);
+
+ pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
+ return cgp_core(pc_prederef, interp);
+
+#else
+ UNUSED(pc);
+ Parrot_io_eprintf(interp,
+ "Computed goto unavailable in this configuration.\n");
+ Parrot_exit(interp, 1);
+#endif
+
+}
+
+
+/*
+
+=item C<static opcode_t * runops_switch(PARROT_INTERP, opcode_t *pc)>
+
+Runs the C<switch> core.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t *
+runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_switch)
+ opcode_t * const code_start = (opcode_t *)interp->code->base.data;
+ opcode_t *pc_prederef;
+
+ init_prederef(interp, PARROT_SWITCH_CORE);
+ pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
+
+ return switch_core(pc_prederef, interp);
+}
+
+
+/*
+
+=item C<void runops_int(PARROT_INTERP, size_t offset)>
+
+Run Parrot operations of loaded code segment until an end opcode is
+reached. Run core is selected depending on the C<Interp_flags>. When a
+C<restart> opcode is encountered, a different core may be selected and
+evaluation of opcode continues.
+
+=cut
+
+*/
+
+void
+runops_int(PARROT_INTERP, size_t offset)
+{
+ opcode_t *(*core) (PARROT_INTERP, opcode_t *) = NULL;
+
+ /* setup event function ptrs */
+ if (!interp->save_func_table)
+ Parrot_setup_event_func_ptrs(interp);
+
+ interp->resume_offset = offset;
+ interp->resume_flag |= RESUME_RESTART;
+
+ while (interp->resume_flag & RESUME_RESTART) {
+ opcode_t * const pc = (opcode_t *)
+ interp->code->base.data + interp->resume_offset;
+
+ interp->resume_offset = 0;
+ interp->resume_flag &= ~(RESUME_RESTART | RESUME_INITIAL);
+
+ switch (interp->run_core) {
+ case PARROT_SLOW_CORE:
+ core = runops_slow_core;
+
+ if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
+ core = runops_profile_core;
+ if (interp->profile == NULL) {
+ interp->profile = mem_allocate_zeroed_typed(RunProfile);
+ interp->profile->data =
+ mem_allocate_n_typed((interp->op_count +
+ PARROT_PROF_EXTRA), ProfData);
+ }
+ }
+ break;
+ case PARROT_FAST_CORE:
+ core = runops_fast_core;
+ break;
+ case PARROT_CGOTO_CORE:
+#ifdef HAVE_COMPUTED_GOTO
+ core = runops_cgoto_core;
+#else
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Error: PARROT_CGOTO_CORE not available");
+#endif
+ break;
+ case PARROT_CGP_CORE:
+ case PARROT_CGP_JIT_CORE:
+#ifdef HAVE_COMPUTED_GOTO
+ core = runops_cgp;
+#else
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Error: PARROT_CGP_CORE not available");
+#endif
+ break;
+ case PARROT_SWITCH_CORE:
+ case PARROT_SWITCH_JIT_CORE:
+ core = runops_switch;
+ break;
+ case PARROT_JIT_CORE:
+#if !JIT_CAPABLE
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_UNAVAILABLE,
+ "Error: PARROT_JIT_FLAG is set, "
+ "but interpreter is not JIT_CAPABLE!\n");
+#else
+ core = runops_jit;
+#endif
+ break;
+ case PARROT_EXEC_CORE:
+#if !EXEC_CAPABLE
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXEC_UNAVAILABLE,
+ "Error: PARROT_EXEC_FLAG is set, "
+ "but interpreter is not EXEC_CAPABLE!\n");
+#else
+ core = runops_exec;
+#endif
+ break;
+ case PARROT_GC_DEBUG_CORE:
+ core = runops_gc_debug_core;
+ break;
+ case PARROT_DEBUGGER_CORE:
+ core = runops_debugger_core;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "ambigious runcore switch used");
+ break;
+ }
+
+
+ /* run it finally */
+ core(interp, pc);
+
+ /* if we have fallen out with resume and we were running CGOTO, set
+ * the stacktop again to a sane value, so that restarting the runloop
+ * is ok. */
+ if (interp->resume_flag & RESUME_RESTART) {
+ if ((int)interp->resume_offset < 0)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "branch_cs: illegal resume offset");
+ stop_prederef(interp);
+ }
+ }
+}
+
+
+/*
+
+=item C<void Parrot_setup_event_func_ptrs(PARROT_INTERP)>
+
+Setup a C<func_table> containing pointers (or addresses) of the
+C<check_event__> opcode.
+
+TODO: Free it at destroy. Handle run-core changes.
+
+=cut
+
+*/
+
+void
+Parrot_setup_event_func_ptrs(PARROT_INTERP)
+{
+ const size_t n = interp->op_count;
+ const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
+ op_lib_t * const lib = init_func(1);
+
+ /* remember op_func_table */
+ interp->save_func_table = lib->op_func_table;
+
+ if (!lib->op_func_table)
+ return;
+
+ /* function or CG core - prepare func_table */
+ if (!interp->evc_func_table) {
+ size_t i;
+
+ interp->evc_func_table = mem_allocate_n_typed(n, op_func_t);
+
+ for (i = 0; i < n; ++i)
+ interp->evc_func_table[i] = (op_func_t)
+ D2FPTR(((void**)lib->op_func_table)[CORE_OPS_check_events__]);
+ }
+}
+
+
+/*
+
+=back
+
+=head2 Dynamic Loading Functions
+
+=over 4
+
+=item C<void dynop_register(PARROT_INTERP, PMC *lib_pmc)>
+
+Register a dynamic oplib.
+
+=cut
+
+*/
+
+void
+dynop_register(PARROT_INTERP, PMC *lib_pmc)
+{
+ op_lib_t *lib, *core;
+ oplib_init_f init_func;
+ op_func_t *new_func_table, *new_evc_func_table;
+ op_info_t *new_info_table;
+ size_t i, n_old, n_new, n_tot;
+
+ if (n_interpreters > 1) {
+ /* This is not supported because oplibs are always shared.
+ * If we mem_sys_reallocate() the op_func_table while another
+ * interpreter is running using that exact op_func_table,
+ * this will cause problems
+ * Also, the mapping from op name to op number is global even for
+ * dynops (!). The mapping is done by get_op in core_ops.c (even for
+ * dynops) and uses a global hash as a cache and relies on modifications
+ * to the static-scoped core_op_lib data structure to see dynops.
+ */
+ Parrot_ex_throw_from_c_args(interp, NULL, 1, "loading a new dynoplib while "
+ "more than one thread is running is not supported.");
+ }
+
+ if (!interp->all_op_libs)
+ interp->all_op_libs = (op_lib_t **)mem_sys_allocate(
+ sizeof (op_lib_t *) * (interp->n_libs + 1));
+ else
+ mem_realloc_n_typed(interp->all_op_libs, interp->n_libs + 1,
+ op_lib_t *);
+
+ init_func = get_dynamic_op_lib_init(interp, lib_pmc);
+ lib = init_func(1);
+
+ interp->all_op_libs[interp->n_libs++] = lib;
+
+ /* if we are registering an op_lib variant, called from below the base
+ * names of this lib and the previous one are the same */
+ if (interp->n_libs >= 2
+ && (STREQ(interp->all_op_libs[interp->n_libs-2]->name, lib->name))) {
+ /* registering is handled below */
+ return;
+ }
+
+ /* when called from yyparse, we have to set up the evc_func_table */
+ Parrot_setup_event_func_ptrs(interp);
+
+ n_old = interp->op_count;
+ n_new = lib->op_count;
+ n_tot = n_old + n_new;
+ core = PARROT_CORE_OPLIB_INIT(1);
+
+ PARROT_ASSERT(interp->op_count == core->op_count);
+
+ new_evc_func_table = (op_func_t *)mem_sys_realloc(interp->evc_func_table,
+ sizeof (op_func_t) * n_tot);
+ if (core->flags & OP_FUNC_IS_ALLOCATED) {
+ new_func_table = (op_func_t *)mem_sys_realloc(core->op_func_table,
+ sizeof (op_func_t) * n_tot);
+ new_info_table = (op_info_t *)mem_sys_realloc(core->op_info_table,
+ sizeof (op_info_t) * n_tot);
+ }
+ else {
+ /* allocate new op_func and info tables */
+ new_func_table = mem_allocate_n_typed(n_tot, op_func_t);
+ new_info_table = mem_allocate_n_typed(n_tot, op_info_t);
+
+ /* copy old */
+ for (i = 0; i < n_old; ++i) {
+ new_func_table[i] = interp->op_func_table[i];
+ new_info_table[i] = interp->op_info_table[i];
+ }
+ }
+
+ /* add new */
+ for (i = n_old; i < n_tot; ++i) {
+ new_func_table[i] = ((op_func_t*)lib->op_func_table)[i - n_old];
+ new_info_table[i] = lib->op_info_table[i - n_old];
+
+ /*
+ * fill new ops of event checker func table
+ * if we are running a different core, entries are
+ * changed below
+ */
+ new_evc_func_table[i] = interp->op_func_table[CORE_OPS_check_events__];
+ }
+
+ interp->evc_func_table = new_evc_func_table;
+ interp->save_func_table = new_func_table;
+
+ /* deinit core, so that it gets rehashed */
+ (void) PARROT_CORE_OPLIB_INIT(0);
+
+ /* set table */
+ core->op_func_table = interp->op_func_table = new_func_table;
+ core->op_info_table = interp->op_info_table = new_info_table;
+ core->op_count = interp->op_count = n_tot;
+ core->flags = OP_FUNC_IS_ALLOCATED | OP_INFO_IS_ALLOCATED;
+
+ /* done for plain core */
+#ifdef HAVE_COMPUTED_GOTO
+ dynop_register_xx(interp, n_old, n_new, PARROT_CORE_CGP_OPLIB_INIT);
+ dynop_register_xx(interp, n_old, n_new, PARROT_CORE_CG_OPLIB_INIT);
+#endif
+
+ dynop_register_switch(n_old, n_new);
+}
+
+
+/*
+
+=item C<static void dynop_register_xx(PARROT_INTERP, size_t n_old, size_t n_new,
+oplib_init_f init_func)>
+
+Register C<op_lib> with other cores.
+
+=cut
+
+*/
+
+static void
+dynop_register_xx(PARROT_INTERP,
+ size_t n_old, size_t n_new, oplib_init_f init_func)
+{
+ ASSERT_ARGS(dynop_register_xx)
+ const size_t n_tot = n_old + n_new;
+ op_func_t *ops_addr = NULL;
+ op_lib_t *cg_lib = init_func(1);
+ op_lib_t *new_lib;
+
+#if 0
+ /* related to CG and CGP ops issue below */
+ STRING *op_variant;
+#endif
+
+ oplib_init_f new_init_func;
+ PMC *lib_variant;
+
+ if (cg_lib->flags & OP_FUNC_IS_ALLOCATED) {
+ ops_addr = (op_func_t *)mem_sys_realloc(cg_lib->op_func_table,
+ n_tot * sizeof (op_func_t));
+ }
+ else {
+ size_t i;
+
+ ops_addr = mem_allocate_n_typed(n_tot, op_func_t);
+ cg_lib->flags = OP_FUNC_IS_ALLOCATED;
+
+ for (i = 0; i < n_old; ++i)
+ ops_addr[i] = cg_lib->op_func_table[i];
+ }
+
+ /*
+ * XXX running CG and CGP ops currently works only via the wrapper
+ *
+ * the problem is:
+ * The actual runcores cg_core and cgp_core are very big functions.
+ * The C compiler usually addresses "spilled" registers in the C stack.
+ * The loaded opcode lib is another possibly big function, but with
+ * a likely different stack layout. Directly jumping around between
+ * code locations in these two opcode functions works, but access
+ * to stack-ed (or spilled) variables fails badly.
+ *
+ * We would need to prepare the assembly source of the opcode
+ * lib so that all variable access on the stack has the same
+ * layout and compile the prepared assembly to ops_cgp?.o
+ *
+ * The switched core is different anyway, as we can't extend the
+ * compiled big switch statement with the new cases. We have
+ * always to use the wrapper__ opcode called from the default case.
+ */
+#if 0
+ /* check if the lib_pmc exists with a _xx flavor */
+ new_init_func = get_op_lib_init(0, 0, lib_pmc);
+ new_lib = new_init_func(1);
+ op_variant = Parrot_sprintf_c(interp, "%s_ops%s",
+ new_lib->name, cg_lib->suffix);
+ lib_variant = Parrot_load_lib(interp, op_variant, NULL);
+
+ /* XXX running CG and CGP ops currently works only via the wrapper */
+ if (0 /*lib_variant */) {
+ size_t i;
+
+ new_init_func = get_dynamic_op_lib_init(interp, lib_variant);
+ new_lib = new_init_func(1);
+
+ for (i = n_old; i < n_tot; ++i)
+ ops_addr[i] = (new_lib->op_func_table)[i - n_old];
+
+ new_lib->op_func_table = ops_addr;
+ new_lib->op_count = n_tot;
+
+ new_init_func((long) ops_addr);
+ }
+ else
+#endif
+ {
+ size_t i;
+
+ /* if not install wrappers */
+ /* fill new entries with the wrapper op */
+ for (i = n_old; i < n_tot; ++i)
+ ops_addr[i] = (cg_lib->op_func_table)[CORE_OPS_wrapper__];
+ }
+
+ /* if we are running this core, update event check ops */
+ if ((int)interp->run_core == cg_lib->core_type) {
+ size_t i;
+
+ for (i = n_old; i < n_tot; ++i)
+ interp->evc_func_table[i] =
+ (op_func_t)ops_addr[CORE_OPS_check_events__];
+ interp->save_func_table = ops_addr;
+ }
+
+ /* tell the cg_core about the new jump table */
+ cg_lib->op_func_table = ops_addr;
+ cg_lib->op_count = n_tot;
+ init_func((long) ops_addr);
+}
+
+
+/*
+
+=item C<static void dynop_register_switch(size_t n_old, size_t n_new)>
+
+Used only at the end of dynop_register. Sums the old and new op_counts
+storing the result into the operations count field of the interpreter
+object.
+
+=cut
+
+*/
+
+static void
+dynop_register_switch(size_t n_old, size_t n_new)
+{
+ ASSERT_ARGS(dynop_register_switch)
+ op_lib_t * const lib = PARROT_CORE_SWITCH_OPLIB_INIT(1);
+ lib->op_count = n_old + n_new;
+}
+
+
+/*
+
+=item C<static void notify_func_table(PARROT_INTERP, op_func_t* table, int on)>
+
+Tell the interpreter's running core about the new function table.
+
+=cut
+
+*/
+
+static void
+notify_func_table(PARROT_INTERP, ARGIN(op_func_t* table), int on)
+{
+ ASSERT_ARGS(notify_func_table)
+ const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
+
+ init_func((long) table);
+ switch (interp->run_core) {
+ case PARROT_SLOW_CORE: /* normal func core */
+ case PARROT_FAST_CORE: /* normal func core */
+ case PARROT_CGOTO_CORE: /* cgoto address list */
+ case PARROT_DEBUGGER_CORE:
+ PARROT_ASSERT(table);
+ interp->op_func_table = table;
+ break;
+ case PARROT_CGP_CORE:
+ case PARROT_CGP_JIT_CORE:
+ turn_ev_check(interp, on);
+ break;
+ default:
+ break;
+ }
+}
+
+
+/*
+
+=item C<void disable_event_checking(PARROT_INTERP)>
+
+Restore old function table.
+
+XXX This is only implemented for the function core at present.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+disable_event_checking(PARROT_INTERP)
+{
+ /* restore func table */
+ PARROT_ASSERT(interp->save_func_table);
+ notify_func_table(interp, interp->save_func_table, 0);
+}
+
+
+/*
+
+=item C<void enable_event_checking(PARROT_INTERP)>
+
+Replace func table with one that does event checking for all opcodes.
+
+NOTE: C<enable_event_checking()> is called async by the event handler
+thread. All action done from here has to be async safe.
+
+XXX This is only implemented for the function core at present.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+enable_event_checking(PARROT_INTERP)
+{
+ /* put table in place */
+ notify_func_table(interp, interp->evc_func_table, 1);
+}
+
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<include/parrot/interpreter.h>, F<src/interp/inter_cb.c>,
+F<src/interp/inter_create.c>, F<src/interp/inter_misc.c>, F<src/call/ops.c>.
+
+=cut
+
+*/
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: trunk/src/runcore/trace.c (from r38257, branches/headercleanup/src/runcore/trace.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/runcore/trace.c Wed Apr 22 20:06:30 2009 (r38275, copy of r38257, branches/headercleanup/src/runcore/trace.c)
@@ -0,0 +1,528 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/trace.c - Tracing
+
+=head1 DESCRIPTION
+
+Tracing support for the C<runops_slow_core()> function in
+F<src/runcore/cores.c>.
+
+This is turned on with Parrot's C<-t> option.
+
+src/test_main.c
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/runcore_trace.h"
+#include "parrot/oplib/ops.h"
+#include "../pmc/pmc_sub.h"
+
+/* HEADERIZER HFILE: src/trace.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static STRING* trace_class_name(PARROT_INTERP, ARGIN(const PMC* pmc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_trace_class_name __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pmc)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+
+/*
+
+=item C<static STRING* trace_class_name(PARROT_INTERP, const PMC* pmc)>
+
+Obtains the class name of the PMC.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static STRING*
+trace_class_name(PARROT_INTERP, ARGIN(const PMC* pmc))
+{
+ ASSERT_ARGS(trace_class_name)
+ STRING *class_name;
+ if (PObj_is_class_TEST(pmc)) {
+ SLOTTYPE * const class_array = (SLOTTYPE *)PMC_data(pmc);
+ PMC * const class_name_pmc = get_attrib_num(class_array,
+ PCD_CLASS_NAME);
+ class_name = VTABLE_get_string(interp, class_name_pmc);
+ }
+ else
+ class_name = pmc->vtable->whoami;
+ return class_name;
+}
+
+/*
+
+=item C<void trace_pmc_dump(PARROT_INTERP, PMC *pmc)>
+
+Prints a PMC to C<stderr>.
+
+=cut
+
+*/
+
+void
+trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
+{
+ ASSERT_ARGS(trace_pmc_dump)
+ Interp * const debugger = interp->pdb->debugger;
+ Parrot_sub *sub;
+
+ if (!pmc) {
+ Parrot_io_eprintf(debugger, "(null)");
+ return;
+ }
+ if (PMC_IS_NULL(pmc)) {
+ Parrot_io_eprintf(debugger, "PMCNULL");
+ return;
+ }
+ if (!pmc->vtable || (UINTVAL)pmc->vtable == 0xdeadbeef) {
+ Parrot_io_eprintf(debugger, "<!!no vtable!!>");
+ return;
+ }
+ if (PObj_on_free_list_TEST(pmc)) {
+ Parrot_io_eprintf(debugger, "**************** PMC is on free list *****\n");
+ }
+ if (pmc->vtable->pmc_class == pmc) {
+ STRING * const name = trace_class_name(interp, pmc);
+ Parrot_io_eprintf(debugger, "Class=%Ss:PMC(%#p)", name, pmc);
+ }
+ else if (pmc->vtable->base_type == enum_class_String) {
+ const STRING * const s = VTABLE_get_string(interp, pmc);
+ if (!s)
+ Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:(NULL))",
+ VTABLE_name(interp, pmc), pmc);
+ else {
+ STRING* const escaped = Parrot_str_escape_truncate(
+ interp, s, 20);
+ if (escaped)
+ Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:\"%Ss\")",
+ VTABLE_name(interp, pmc), pmc,
+ escaped);
+ else
+ Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:\"(null)\")",
+ VTABLE_name(interp, pmc), pmc);
+ }
+ }
+ else if (pmc->vtable->base_type == enum_class_Boolean) {
+ Parrot_io_eprintf(debugger, "Boolean=PMC(%#p: %d)",
+ pmc, VTABLE_get_integer(interp, pmc));
+ }
+ else if (pmc->vtable->base_type == enum_class_Integer) {
+ Parrot_io_eprintf(debugger, "Integer=PMC(%#p: %d)",
+ pmc, VTABLE_get_integer(interp, pmc));
+ }
+ else if (pmc->vtable->base_type == enum_class_BigInt) {
+ STRING * const s = VTABLE_get_string(interp, pmc);
+ Parrot_io_eprintf(debugger, "BigInt=PMC(%#p: %Ss)",
+ pmc, s);
+ }
+ else if (pmc->vtable->base_type == enum_class_Complex) {
+ STRING * const s = VTABLE_get_string(interp, pmc);
+ Parrot_io_eprintf(debugger, "Complex=PMC(%#p: %Ss)",
+ pmc, s);
+ }
+ else if (pmc->vtable->base_type == enum_class_RetContinuation
+ || pmc->vtable->base_type == enum_class_Continuation
+ || pmc->vtable->base_type == enum_class_Sub) {
+ PMC_get_sub(interp, pmc, sub);
+ Parrot_io_eprintf(debugger, "%S=PMC(%#p pc:%d)",
+ VTABLE_name(interp, pmc), pmc, sub->start_offs);
+ }
+ else if (PObj_is_object_TEST(pmc)) {
+ Parrot_io_eprintf(debugger, "Object(%Ss)=PMC(%#p)",
+ VTABLE_get_string(interp, VTABLE_get_class(interp, pmc)), pmc);
+ }
+ else {
+ Parrot_io_eprintf(debugger, "%S=PMC(%#p)",
+ VTABLE_name(interp, pmc), pmc);
+ }
+}
+
+/*
+
+=item C<int trace_key_dump(PARROT_INTERP, PMC *key)>
+
+Prints a key to C<stderr>, returns the length of the output.
+
+=cut
+
+*/
+
+int
+trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
+{
+ ASSERT_ARGS(trace_key_dump)
+ Interp * const debugger = interp->pdb->debugger;
+
+ int len = Parrot_io_eprintf(debugger, "[");
+
+ while (key) {
+ switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
+ case KEY_integer_FLAG:
+ len += Parrot_io_eprintf(debugger, "%vi", VTABLE_get_integer(interp, key));
+ break;
+ case KEY_number_FLAG:
+ len += Parrot_io_eprintf(debugger, "%vg", VTABLE_get_number(interp, key));
+ break;
+ case KEY_string_FLAG:
+ {
+ const STRING * const s = key_string(interp, key);
+ STRING* const escaped = Parrot_str_escape_truncate(
+ interp, s, 20);
+ if (escaped)
+ len += Parrot_io_eprintf(debugger, "\"%Ss\"", escaped);
+ else
+ len += Parrot_io_eprintf(debugger, "\"(null)\"");
+ }
+ break;
+ case KEY_integer_FLAG|KEY_register_FLAG:
+ len += Parrot_io_eprintf(debugger, "I%vd=%vd", VTABLE_get_integer(interp, key),
+ REG_INT(interp, VTABLE_get_integer(interp, key)));
+ break;
+ case KEY_number_FLAG|KEY_register_FLAG:
+ len += Parrot_io_eprintf(debugger, "I%vd=%vd", VTABLE_get_integer(interp, key),
+ REG_NUM(interp, VTABLE_get_integer(interp, key)));
+ break;
+ case KEY_string_FLAG|KEY_register_FLAG:
+ {
+ const STRING * const s = REG_STR(interp, VTABLE_get_integer(interp, key));
+ STRING* const escaped = Parrot_str_escape_truncate(
+ interp, s, 20);
+ if (escaped)
+ len += Parrot_io_eprintf(debugger, "S%vd=\"%Ss\"", VTABLE_get_integer(interp, key),
+ escaped);
+ else
+ len += Parrot_io_eprintf(debugger, "S%vd=\"(null)\"",
+ VTABLE_get_integer(interp, key));
+ }
+ break;
+ case KEY_pmc_FLAG|KEY_register_FLAG:
+ len += Parrot_io_eprintf(debugger, "P%vd=", VTABLE_get_integer(interp, key));
+ trace_pmc_dump(debugger, REG_PMC(interp, VTABLE_get_integer(interp, key)));
+ break;
+ default:
+ len += Parrot_io_eprintf(debugger, "??");
+ key = NULL;
+ break;
+ }
+
+ if (key) {
+ key = (PMC *)PMC_data(key);
+ if (key)
+ len += Parrot_io_eprintf(debugger, ";");
+ }
+ } /* while */
+
+ len += Parrot_io_eprintf(debugger, "]");
+ return len;
+}
+
+/*
+
+=item C<void trace_op_dump(PARROT_INTERP, const opcode_t *code_start, const
+opcode_t *pc)>
+
+Prints the PC, OP and ARGS. Used by C<trace_op()>.
+
+I<Not really part of the API.>
+
+=cut
+
+*/
+
+void
+trace_op_dump(PARROT_INTERP,
+ ARGIN(const opcode_t *code_start),
+ ARGIN(const opcode_t *pc))
+{
+ ASSERT_ARGS(trace_op_dump)
+ INTVAL s, n;
+ int more = 0, var_args;
+ Interp * const debugger = interp->pdb->debugger;
+ op_info_t * const info = &interp->op_info_table[*pc];
+ PMC *sig;
+ int type;
+ int len;
+#define ARGS_COLUMN 40
+
+ PARROT_ASSERT(debugger);
+ sig = NULL; /* silence compiler uninit warning */
+
+ s = 1;
+ len = Parrot_io_eprintf(debugger, "%6vu ", (UINTVAL)(pc - code_start));
+ if (STREQ(info->name, "infix")) {
+ /* this should rather be MMD_opcode_name, which doesn't
+ * exit yet
+ */
+ len += Parrot_io_eprintf(debugger, "%s",
+ Parrot_MMD_method_name(interp, pc[1]) + 2);
+ s = 2;
+ }
+ else if (STREQ(info->name, "n_infix")) {
+ len += Parrot_io_eprintf(debugger, "n_%s",
+ Parrot_MMD_method_name(interp, pc[1]) + 2);
+ s = 2;
+ }
+ else
+ len += Parrot_io_eprintf(debugger, "%s", info->name);
+
+ n = info->op_count;
+ var_args = 0;
+
+ if (*pc == PARROT_OP_set_args_pc ||
+ *pc == PARROT_OP_get_results_pc ||
+ *pc == PARROT_OP_get_params_pc ||
+ *pc == PARROT_OP_set_returns_pc) {
+ sig = interp->code->const_table->constants[pc[1]]->u.key;
+
+ if (!sig)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "NULL sig PMC detected in trace_op_dump");
+
+ var_args = VTABLE_elements(interp, sig);
+ n += var_args;
+ }
+
+ if (n > 1) {
+ INTVAL i;
+ len += Parrot_io_eprintf(debugger, " ");
+ /* pass 1 print arguments */
+ for (i = s; i < n; i++) {
+ const opcode_t o = pc[i];
+ if (i < info->op_count) {
+ type = info->types[i - 1];
+ }
+ else {
+ if (!sig)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "NULL sig PMC detected in trace_op_dump");
+
+ type = VTABLE_get_integer_keyed_int(interp, sig, i - 2) &
+ (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
+ }
+ if (i > s &&
+ type != PARROT_ARG_KC &&
+ type != PARROT_ARG_KIC &&
+ type != PARROT_ARG_KI &&
+ type != PARROT_ARG_K) {
+ len += Parrot_io_eprintf(debugger, ", ");
+ }
+ switch (type) {
+ case PARROT_ARG_IC:
+ len += Parrot_io_eprintf(debugger, "%vd", o);
+ break;
+ case PARROT_ARG_NC:
+ len += Parrot_io_eprintf(debugger, "%vg", PCONST(o)->u.number);
+ break;
+ case PARROT_ARG_PC:
+ if (var_args)
+ len += Parrot_io_eprintf(debugger, "PC%d (%d)",
+ (int)o, var_args);
+ else
+ len += Parrot_io_eprintf(debugger, "PC%d", (int)o);
+ break;
+ case PARROT_ARG_SC:
+ {
+ STRING* const escaped = Parrot_str_escape_truncate(
+ interp,
+ PCONST(o)->u.string, 20);
+ if (escaped)
+ len += Parrot_io_eprintf(debugger, "\"%Ss\"", escaped);
+ else
+ len += Parrot_io_eprintf(debugger, "\"(null)\"");
+ }
+ break;
+ case PARROT_ARG_KC:
+ len += trace_key_dump(interp, PCONST(o)->u.key);
+ break;
+ case PARROT_ARG_KIC:
+ len += Parrot_io_eprintf(debugger, "[%vd]", o);
+ break;
+ case PARROT_ARG_KI:
+ len += Parrot_io_eprintf(debugger, "[I%vd]", o);
+ more = 1;
+ break;
+ case PARROT_ARG_K:
+ len += Parrot_io_eprintf(debugger, "[P%vd]", o);
+ more = 1;
+ break;
+ case PARROT_ARG_I:
+ len += Parrot_io_eprintf(debugger, "I%vd", o);
+ more = 1;
+ break;
+ case PARROT_ARG_N:
+ len += Parrot_io_eprintf(debugger, "N%vd", o);
+ more = 1;
+ break;
+ case PARROT_ARG_P:
+ len += Parrot_io_eprintf(debugger, "P%vd", o);
+ more = 1;
+ break;
+ case PARROT_ARG_S:
+ len += Parrot_io_eprintf(debugger, "S%vd", o);
+ more = 1;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "unhandled type in trace");
+ break;
+ }
+ }
+ if (!more)
+ goto done;
+ if (len < ARGS_COLUMN) {
+ STRING * const fill = Parrot_str_repeat(debugger,
+ Parrot_str_new_constant(debugger, " "),
+ ARGS_COLUMN);
+ Parrot_io_putps(debugger, Parrot_io_STDERR(debugger), fill);
+ }
+ else {
+ Parrot_io_eprintf(debugger, "\t");
+ }
+
+ /* pass 2 print argument details if needed */
+ for (i = 1; i < n; i++) {
+ const opcode_t o = pc[i];
+ if (i < info->op_count)
+ type = info->types[i - 1];
+ else
+ type = VTABLE_get_integer_keyed_int(interp, sig, i - 2) &
+ (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
+ if (i > s) {
+ Parrot_io_eprintf(debugger, " ");
+ }
+ switch (type) {
+ case PARROT_ARG_I:
+ Parrot_io_eprintf(debugger, "I%vd=%vd", o, REG_INT(interp, o));
+ break;
+ case PARROT_ARG_N:
+ Parrot_io_eprintf(debugger, "N%vd=%vf", o, REG_NUM(interp, o));
+ break;
+ case PARROT_ARG_PC:
+ Parrot_io_eprintf(debugger, "PC%vd=", o);
+ trace_pmc_dump(interp, PCONST(o)->u.key);
+ break;
+ case PARROT_ARG_P:
+ Parrot_io_eprintf(debugger, "P%vd=", o);
+ trace_pmc_dump(interp, REG_PMC(interp, o));
+ break;
+ case PARROT_ARG_S:
+ if (REG_STR(interp, o)) {
+ STRING* const escaped = Parrot_str_escape_truncate(
+ interp, REG_STR(interp, o), 20);
+ Parrot_io_eprintf(debugger, "S%vd=\"%Ss\"", o,
+ escaped);
+ }
+ else
+ Parrot_io_eprintf(debugger, "S%vd=\"(null)\"", o);
+ break;
+ case PARROT_ARG_K:
+ Parrot_io_eprintf(debugger, "P%vd=", o);
+ trace_key_dump(interp, REG_PMC(interp, *(pc + i)));
+ break;
+ case PARROT_ARG_KI:
+ Parrot_io_eprintf(debugger, "I%vd=[%vd]", o, REG_INT(interp, o));
+ break;
+ default:
+ break;
+ }
+ }
+ }
+done:
+
+ if (interp->code->annotations) {
+ PMC *annot = PackFile_Annotations_lookup(interp, interp->code->annotations,
+ pc - code_start + 1, NULL);
+ if (!PMC_IS_NULL(annot)) {
+ PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
+ Parrot_str_new_constant(interp, "file"));
+ PMC *pline = VTABLE_get_pmc_keyed_str(interp, annot,
+ Parrot_str_new_constant(interp, "line"));
+ if ((!PMC_IS_NULL(pfile)) && (!PMC_IS_NULL(pline))) {
+ /* The debugger interpreter may not be the same as
+ * the main interpreter, extract values from the
+ * PMC instad of passing them directly
+ */
+ STRING *file = VTABLE_get_string(interp, pfile);
+ INTVAL line = VTABLE_get_integer(interp, pline);
+ Parrot_io_eprintf(debugger, " (%Ss:%li)", file, (long)line);
+ }
+ }
+ }
+
+ Parrot_io_eprintf(debugger, "\n");
+}
+
+/*
+
+=item C<void trace_op(PARROT_INTERP, const opcode_t *code_start, const opcode_t
+*code_end, const opcode_t *pc)>
+
+Prints the PC, OP and ARGS. Used by C<runops_trace()>. With bounds
+checking.
+
+I<Not really part of the API.>
+
+=cut
+
+*/
+
+void
+trace_op(PARROT_INTERP,
+ ARGIN(const opcode_t *code_start),
+ ARGIN(const opcode_t *code_end),
+ ARGIN_NULLOK(const opcode_t *pc))
+{
+ ASSERT_ARGS(trace_op)
+ if (!pc) {
+ return;
+ }
+
+ if (pc >= code_start && pc < code_end)
+ trace_op_dump(interp, code_start, pc);
+ else
+ Parrot_io_eprintf(interp, "PC=%ld; OP=<err>\n", (long)(pc - code_start));
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<src/trace.h>
+
+=cut
+
+*/
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Deleted: trunk/src/runops_cores.c
==============================================================================
--- trunk/src/runops_cores.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,628 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 Run Cores
-
-During execution, the runcore is like the heart of Parrot. The runcore
-controls calling the various opcodes with the correct data, and making
-sure that program flow moves properly. Some runcores, such as the
-I<precomputed C goto runcore> are optimized for speed and don't perform
-many tasks beyond finding and dispatching opcodes. Other runcores,
-such as the I<GC-Debug>, I<debug> and I<profiling> runcores help with
-typical software maintenance and analysis tasks. We'll talk about all
-of these throughout the chapter.
-
-Runcores must pass execution to each opcode in the incoming bytecode
-stream. This is called I<dispatching> the opcodes. Because the different
-runcores are structured in different ways, the opcodes themselves must
-be formated differently. The opcode compiler compiles opcodes into a
-number of separate formats, depending on what runcores are included in
-the compiled Parrot. Because of this, understanding opcodes first
-requires an understanding of the Parrot runcores.
-
-Parrot has multiple runcores. Some are useful for particular maintenance
-tasks, some are only available as optimizations in certain compilers,
-some are intended for general use, and some are just interesing flights
-of fancy with no practical benefits. Here we list the various runcores,
-their uses, and their benefits.
-
-=head2 Slow Core
-
-The slow core is a basic runcore design that treats each opcode as a
-separate function at the C level. Each function is called, and returns
-the address of the next opcode to be called by the core. The slow core
-performs bounds checking to ensure that the next opcode to be called is
-properly in bounds, and not somewhere random in memory. Because of this
-modular approach where opcodes are treated as separate executable
-entities many other runcores, especially diagnostic and maintenance
-cores are based on this design. The program counter C<pc> is the current
-index into the bytecode stream. Here is a pseudocode representation for
-how the slow core works:
-
- while(1) {
- pc = NEXT_OPCODE;
- if(pc < LOW_BOUND || pc > HIGH_BOUND)
- throw exception;
- DISPATCH_OPCODE(pc);
- UPDATE_INTERPRETER();
- }
-
-=head2 Fast Core
-
-The fast core is a bare-bones core that doesn't do any of the
-bounds-checking or context updating that the slow core does. The fast
-core is the way Parrot should run, and is used to find and debug places
-where execution strays outside of its normal bounds. In pseudocode, the
-fast core is very much like the slow core except it doesn't do the bounds
-checking between each instruction, and doesn't update the interpreter's
-current context for each dispatch.
-
- while(1) {
- pc = NEXT_OPCODE;
- DISPATCH_OPCODE(pc);
- }
-
-=head2 Switch Core
-
-As its name implies, the switch core uses a gigantic C C<switch / case>
-structure to execute opcodes. Here's a brief example of how this
-architecture works:
-
- for( ; ; current_opcode++) {
- switch(*current_opcode) {
- case opcode_1:
- ...
- case opcode_2:
- ...
- case opcode_3:
- ...
- }
- }
-
-This is quite a fast architecture for dispatching opcodes because it all
-happens within a single function. The only operations performed between
-opcodes is a jump back to the top of the loop, incrementing the opcode
-pointer, dereferencing the opcode pointer, and then a jump to the C<case>
-statement for the next opcode.
-
-=head2 Computed Goto Core
-
-I<Computed Goto> is a feature of some C compilers where a label is
-treated as a piece of data that can be stored as a C<void *> pointer. Each
-opcode becomes simply a label in a very large function, and pointers to the
-labels are stored in a large array. Calling an opcode is as easy as taking
-that opcode's number as the index of the label array, and calling the
-associated label. Sound complicated? It is a little, especially to C
-programmers who are not used to using labels, much less treating them as
-first class data items.
-
-Notice that computed goto is a feature only available in some compilers
-such as GCC, and will not be available in every distribution of Parrot,
-depending what compilers were used to build it.
-
-As was mentioned earlier, not all compilers support computed goto, which
-means that this core will not be built on platforms that don't support it.
-However, it's still an interesting topic to study so we will look at it
-briefly here. For compilers that support it, computed goto labels are
-C<void **> values. In the computed goto core, all the labels represent
-different opcodes, so they are stored in an array:
-
- void *my_labels[] = {
- &&label1,
- &&label2,
- &&label3
- };
-
- label1:
- ...
- label2:
- ...
- label3:
- ...
-
-Jumping to one of these labels is done with a command like this:
-
- goto *my_labels[opcode_number];
-
-Actually, opcodes are pointed to by an C<opcode_t *> pointer, and all
-opcodes are stored sequentially in memory, so the actual jump in the
-computed goto core must increment the pointer and then jump to the new
-version. In C it looks something like this:
-
- goto *my_labels[*(current_opcode += 1)];
-
-Each opcode is an index into the array of labels, and at the end of each
-opcode an instruction like this is performed to move to the next opcode
-in series, or else some kind of control flow occurs that moves it to a
-non-sequential location:
-
- goto *my_lables[*(current_opcode = destination)];
-
-These are simplifications on what really happens in this core, because
-the actual code has been optimized quite a bit from what has been
-presented here. However, as we shall see with the precomputed goto core,
-it isn't optimized as aggressively as is possible.
-
-=head2 Precomputed Goto Core
-
-The precomputed goto core is an amazingly fast optimized core that uses
-the same computed goto feature, but performs the array dereferencing
-before the core even starts. The compiled bytecode is fed into a
-preprocessor that converts the bytecode instruction numbers into lable
-pointer values. In the computed goto core, you have this
-operation to move to the next opcode:
-
- goto *my_labels[*(current_opcode += 1)];
-
-This single line of code is deceptively complex. A number of machine code
-operations must be performed to complete this step: The value of
-C<current_opcode> must be incremented to the next value, that value must
-be dereferenced to find the opcode value. In C, arrays are pointers, so
-C<my_labels> gets dereferenced and an offset is taken from it to find
-the stored label reference. That label reference is then dereferenced, and
-the jump is performed.
-
-That's a lot of steps to execute before we can jump to the next opcode.
-What if each opcode value was replaced with the value of the jump
-label beforehand? If C<current_opcode> points to a label pointer directly,
-we don't need to perform an additional dereference on the array at all. We
-can replace that entire mess above with this line:
-
- goto **(current_opcode += 1);
-
-That's far fewer machine instructions to execute before we can move to the
-next opcode, which means faster throughput. Remember that whatever dispatch
-mechanism is used will be called after every single opcode, and some large
-programs may have millions of opcodes! Every single machine instruction
-that can be cut out of the dispatch mechanism could increase the execution
-speed of Parrot in a significant and noticable way. B<The dispatch mechanism
-used by the various runcores is hardly the largest performance bottleneck in
-Parrot anyway, but we like to use faster cores to shave every little bit of
-speed out of the system>.
-
-The caveat of course is that the predereferenced computed goto core is only
-available with compilers that support computed goto, such as GCC. Parrot
-will not have access to this core if it is built with a different compiler.
-
-=head2 Tracing Core
-
-To come.
-
-=head2 Profiling Core
-
-The profiling core analyzes the performance of Parrot, and helps to
-determine where bottlenecks and trouble spots are in the programs that
-run on top of Parrot. When Parrot calls a PIR subroutine it sets up the
-environment, allocates storage for the passed parameters and the return
-values, passes the parameters, and calls a new runcore to execute it. To
-calculate the amount of time that each subroutine takes, we need to
-measure the amount of time spent in each runcore from the time the core
-begins to the time the core executes. The profiling core does exactly
-this, acting very similarly to a slow core but also measuring the amount
-of time it takes for the core to complete. The tracing core actually
-keeps track of a few additional values, including the number of GC cycles
-run while in the subroutine, the number of each opcode called and the
-number of calls to each subroutine made. All this information is helpfully
-printed to the STDERR output for later analysis.
-
-=head2 GC Debug Core
-
-Parrot's garbage collector has been known as a weakness in the system
-for several years. In fact, the garbage collector and memory management
-subsystem was one of the last systems to be improved and rewritten before
-the release of version 1.0. It's not that garbage collection isn't
-important, but instead that it was so hard to do earlier in the project.
-
-Early on when the GC was such a weakness, and later when the GC was under
-active development, it was useful to have an operational mode that would
-really exercise the GC and find bugs that otherwise could hide by sheer
-chance. The GC debug runcore was this tool. The core executes a complete
-collection iteration between every single opcode. The throughput
-performance is terrible, but that's not the point: it's almost guaranteed
-to find problems in the memory system if they exist.
-
-=head2 Debug Core
-
-The debug core works like a normal software debugger, such as GDB. The
-debug core executes each opcode, and then prompts the user to enter a
-command. These commands can be used to continue execution, step to the
-next opcode, or examine and manipulate data from the executing program.
-
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "runops_cores.h"
-#include "parrot/embed.h"
-#include "trace.h"
-#include "interp_guts.h"
-
-#ifdef HAVE_COMPUTED_GOTO
-# include "parrot/oplib/core_ops_cg.h"
-#endif
-
-/* HEADERIZER HFILE: src/runops_cores.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t * runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-#define ASSERT_ARGS_runops_trace_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-/*
-
-=item C<opcode_t * runops_fast_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations. This performs no bounds checking, profiling, or tracing.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_fast_core)
-
- /* disable pc */
- CONTEXT(interp)->current_pc = NULL;
-
- while (pc) {
- DO_OP(pc, interp);
- }
-
- return pc;
-}
-
-
-/*
-
-=item C<opcode_t * runops_cgoto_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations, using the computed C<goto> core, performing no bounds checking,
-profiling, or tracing.
-
-If computed C<goto> is not available then Parrot exits with exit code 1.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_cgoto_core)
-
- /* disable pc */
- CONTEXT(interp)->current_pc = NULL;
-
-#ifdef HAVE_COMPUTED_GOTO
- pc = cg_core(pc, interp);
- return pc;
-#else
- UNUSED(pc);
- Parrot_io_eprintf(interp,
- "Computed goto unavailable in this configuration.\n");
- Parrot_exit(interp, 1);
-#endif
-}
-
-#ifdef code_start
-# undef code_start
-#endif
-#ifdef code_end
-# undef code_end
-#endif
-
-#define code_start interp->code->base.data
-#define code_end (interp->code->base.data + interp->code->base.size)
-
-
-/*
-
-=item C<static opcode_t * runops_trace_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations, using the tracing interpreter.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t *
-runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_trace_core)
-
- static size_t gc_mark_runs, gc_collect_runs;
- Arenas * const arena_base = interp->arena_base;
- Interp *debugger;
-
- gc_mark_runs = arena_base->gc_mark_runs;
- gc_collect_runs = arena_base->gc_collect_runs;
- if (interp->pdb) {
- debugger = interp->pdb->debugger;
- PARROT_ASSERT(debugger);
- }
- else {
- PMC *pio;
-
- /*
- * using a distinct interpreter for tracing should be ok
- * - just in case, make it easy to switch
- */
-#if 0
- debugger = interp:
-#else
- Parrot_debugger_init(interp);
- PARROT_ASSERT(interp->pdb);
- debugger = interp->pdb->debugger;
-#endif
- PARROT_ASSERT(debugger);
-
- /* set the top of the stack so GC can trace it for GC-able pointers
- * see trace_system_areas() in src/cpu_dep.c */
- debugger->lo_var_ptr = interp->lo_var_ptr;
-
- pio = Parrot_io_STDERR(debugger);
-
- if (Parrot_io_is_tty(debugger, pio))
- Parrot_io_setlinebuf(debugger, pio);
- else {
- /* this is essential (100 x faster!) and should probably
- * be in init/open code */
- Parrot_io_setbuf(debugger, pio, 8192);
- }
- }
-
- trace_op(interp, code_start, code_end, pc);
- while (pc) {
- if (pc < code_start || pc >= code_end)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "attempt to access code outside of current code segment");
-
- CONTEXT(interp)->current_pc = pc;
-
- DO_OP(pc, interp);
- trace_op(interp, code_start, code_end, pc);
-
- if (gc_mark_runs != arena_base->gc_mark_runs) {
- gc_mark_runs = arena_base->gc_mark_runs;
- Parrot_io_eprintf(debugger, " GC mark\n");
- }
-
- if (gc_collect_runs != arena_base->gc_collect_runs) {
- gc_collect_runs = arena_base->gc_collect_runs;
- Parrot_io_eprintf(debugger, " GC collect\n");
- }
- }
-
- Parrot_io_flush(debugger, Parrot_io_STDERR(debugger));
-
- return pc;
-}
-
-
-/*
-
-=item C<opcode_t * runops_slow_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations, with tracing and bounds checking enabled.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_slow_core)
-
- if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG))
- return runops_trace_core(interp, pc);
-#if 0
- if (interp->debugger && interp->debugger->pdb)
- return Parrot_debug(interp, interp->debugger, pc);
-#endif
-
- while (pc) {
- if (pc < code_start || pc >= code_end)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "attempt to access code outside of current code segment");
-
- CONTEXT(interp)->current_pc = pc;
-
- DO_OP(pc, interp);
- }
-
- return pc;
-}
-
-
-/*
-
-=item C<opcode_t * runops_gc_debug_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations, performing a full GC run before each op. This is very slow, but
-it's also a very quick way to find GC problems.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_gc_debug_core)
- while (pc) {
- if (pc < code_start || pc >= code_end)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "attempt to access code outside of current code segment");
-
- Parrot_do_gc_run(interp, 0);
- CONTEXT(interp)->current_pc = pc;
-
- DO_OP(pc, interp);
- }
-
- return pc;
-}
-
-#undef code_start
-#undef code_end
-
-
-/*
-
-=item C<opcode_t * runops_profile_core(PARROT_INTERP, opcode_t *pc)>
-
-Runs the Parrot operations starting at C<pc> until there are no more
-operations, with tracing, bounds checking, and profiling enabled.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_profile_core)
- RunProfile * const profile = interp->profile;
- const opcode_t old_op = profile->cur_op;
-
- /* if reentering the runloop, remember old op and calc time 'til now */
- if (old_op)
- profile->data[old_op].time +=
- Parrot_floatval_time() - profile->starttime;
-
- while (pc) {/* && pc >= code_start && pc < code_end) */
- opcode_t cur_op;
-
- CONTEXT(interp)->current_pc = pc;
- profile->cur_op = cur_op = *pc + PARROT_PROF_EXTRA;
- profile->starttime = Parrot_floatval_time();
- profile->data[cur_op].numcalls++;
-
- DO_OP(pc, interp);
-
- /* profile->cur_op may be different, if exception was thrown */
- profile->data[profile->cur_op].time +=
- Parrot_floatval_time() - profile->starttime;
- }
-
- if (old_op) {
- /* old opcode continues */
- profile->starttime = Parrot_floatval_time();
- profile->cur_op = old_op;
- }
-
- return pc;
-}
-
-/*
-
-=item C<opcode_t * runops_debugger_core(PARROT_INTERP, opcode_t *pc)>
-
-Used by the debugger, under construction
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_debugger_core)
- /*fprintf(stderr, "Enter runops_debugger_core\n");*/
-
- PARROT_ASSERT(interp->pdb);
-
- if (interp->pdb->state & PDB_ENTER) {
- Parrot_debugger_start(interp, pc);
- }
-
- while (pc) {
- if (pc < interp->code->base.data || pc >= interp->code->base.data + interp->code->base.size)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "attempt to access code outside of current code segment");
-
- if (interp->pdb->state & PDB_GCDEBUG)
- Parrot_do_gc_run(interp, 0);
-
- if (interp->pdb->state & PDB_TRACING) {
- trace_op(interp,
- interp->code->base.data,
- interp->code->base.data +
- interp->code->base.size,
- pc);
- }
-
- CONTEXT(interp)->current_pc = pc;
- DO_OP(pc, interp);
-
- if (interp->pdb->state & PDB_STOPPED) {
- Parrot_debugger_start(interp, pc);
- }
- else
- {
- if (PDB_break(interp)) {
- Parrot_debugger_start(interp, pc);
- continue;
- }
-
- if (interp->pdb->tracing) {
- if (--interp->pdb->tracing == 0) {
- Parrot_debugger_start(interp, pc);
- }
- }
- }
- }
-
- return pc;
-}
-
-/*
-
-=back
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/runops_cores.h
==============================================================================
--- trunk/src/runops_cores.h Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,95 +0,0 @@
-/* runops_cores.h
- * Copyright (C) 2001-2006, Parrot Foundation.
- * SVN Info
- * $Id$
- * Overview:
- * Header for runops cores.
- * Data Structure and Algorithms:
- * History:
- * Notes:
- * References:
- */
-
-#ifndef PARROT_RUNOPS_CORES_H_GUARD
-#define PARROT_RUNOPS_CORES_H_GUARD
-
-#include "parrot/parrot.h"
-#include "parrot/op.h"
-
-/* HEADERIZER BEGIN: src/runops_cores.c */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-#define ASSERT_ARGS_runops_cgoto_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_debugger_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_fast_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_gc_debug_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_profile_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_slow_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/runops_cores.c */
-
-opcode_t *runops_fast_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_cgoto_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_slow_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_profile_core(PARROT_INTERP, opcode_t *);
-
-#endif /* PARROT_RUNOPS_CORES_H_GUARD */
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/trace.c
==============================================================================
--- trunk/src/trace.c Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,527 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/trace.c - Tracing
-
-=head1 DESCRIPTION
-
-Tracing support for the C<runops_slow_core()> function in F<src/runops_cores.c>.
-
-This is turned on with Parrot's C<-t> option.
-
-src/test_main.c
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "trace.h"
-#include "parrot/oplib/ops.h"
-#include "pmc/pmc_sub.h"
-
-/* HEADERIZER HFILE: src/trace.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static STRING* trace_class_name(PARROT_INTERP, ARGIN(const PMC* pmc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-#define ASSERT_ARGS_trace_class_name __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmc)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-/*
-
-=item C<static STRING* trace_class_name(PARROT_INTERP, const PMC* pmc)>
-
-Obtains the class name of the PMC.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static STRING*
-trace_class_name(PARROT_INTERP, ARGIN(const PMC* pmc))
-{
- ASSERT_ARGS(trace_class_name)
- STRING *class_name;
- if (PObj_is_class_TEST(pmc)) {
- SLOTTYPE * const class_array = (SLOTTYPE *)PMC_data(pmc);
- PMC * const class_name_pmc = get_attrib_num(class_array,
- PCD_CLASS_NAME);
- class_name = VTABLE_get_string(interp, class_name_pmc);
- }
- else
- class_name = pmc->vtable->whoami;
- return class_name;
-}
-
-/*
-
-=item C<void trace_pmc_dump(PARROT_INTERP, PMC *pmc)>
-
-Prints a PMC to C<stderr>.
-
-=cut
-
-*/
-
-void
-trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
-{
- ASSERT_ARGS(trace_pmc_dump)
- Interp * const debugger = interp->pdb->debugger;
- Parrot_sub *sub;
-
- if (!pmc) {
- Parrot_io_eprintf(debugger, "(null)");
- return;
- }
- if (PMC_IS_NULL(pmc)) {
- Parrot_io_eprintf(debugger, "PMCNULL");
- return;
- }
- if (!pmc->vtable || (UINTVAL)pmc->vtable == 0xdeadbeef) {
- Parrot_io_eprintf(debugger, "<!!no vtable!!>");
- return;
- }
- if (PObj_on_free_list_TEST(pmc)) {
- Parrot_io_eprintf(debugger, "**************** PMC is on free list *****\n");
- }
- if (pmc->vtable->pmc_class == pmc) {
- STRING * const name = trace_class_name(interp, pmc);
- Parrot_io_eprintf(debugger, "Class=%Ss:PMC(%#p)", name, pmc);
- }
- else if (pmc->vtable->base_type == enum_class_String) {
- const STRING * const s = VTABLE_get_string(interp, pmc);
- if (!s)
- Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:(NULL))",
- VTABLE_name(interp, pmc), pmc);
- else {
- STRING* const escaped = Parrot_str_escape_truncate(
- interp, s, 20);
- if (escaped)
- Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:\"%Ss\")",
- VTABLE_name(interp, pmc), pmc,
- escaped);
- else
- Parrot_io_eprintf(debugger, "%S=PMC(%#p Str:\"(null)\")",
- VTABLE_name(interp, pmc), pmc);
- }
- }
- else if (pmc->vtable->base_type == enum_class_Boolean) {
- Parrot_io_eprintf(debugger, "Boolean=PMC(%#p: %d)",
- pmc, VTABLE_get_integer(interp, pmc));
- }
- else if (pmc->vtable->base_type == enum_class_Integer) {
- Parrot_io_eprintf(debugger, "Integer=PMC(%#p: %d)",
- pmc, VTABLE_get_integer(interp, pmc));
- }
- else if (pmc->vtable->base_type == enum_class_BigInt) {
- STRING * const s = VTABLE_get_string(interp, pmc);
- Parrot_io_eprintf(debugger, "BigInt=PMC(%#p: %Ss)",
- pmc, s);
- }
- else if (pmc->vtable->base_type == enum_class_Complex) {
- STRING * const s = VTABLE_get_string(interp, pmc);
- Parrot_io_eprintf(debugger, "Complex=PMC(%#p: %Ss)",
- pmc, s);
- }
- else if (pmc->vtable->base_type == enum_class_RetContinuation
- || pmc->vtable->base_type == enum_class_Continuation
- || pmc->vtable->base_type == enum_class_Sub) {
- PMC_get_sub(interp, pmc, sub);
- Parrot_io_eprintf(debugger, "%S=PMC(%#p pc:%d)",
- VTABLE_name(interp, pmc), pmc, sub->start_offs);
- }
- else if (PObj_is_object_TEST(pmc)) {
- Parrot_io_eprintf(debugger, "Object(%Ss)=PMC(%#p)",
- VTABLE_get_string(interp, VTABLE_get_class(interp, pmc)), pmc);
- }
- else {
- Parrot_io_eprintf(debugger, "%S=PMC(%#p)",
- VTABLE_name(interp, pmc), pmc);
- }
-}
-
-/*
-
-=item C<int trace_key_dump(PARROT_INTERP, PMC *key)>
-
-Prints a key to C<stderr>, returns the length of the output.
-
-=cut
-
-*/
-
-int
-trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
-{
- ASSERT_ARGS(trace_key_dump)
- Interp * const debugger = interp->pdb->debugger;
-
- int len = Parrot_io_eprintf(debugger, "[");
-
- while (key) {
- switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
- case KEY_integer_FLAG:
- len += Parrot_io_eprintf(debugger, "%vi", VTABLE_get_integer(interp, key));
- break;
- case KEY_number_FLAG:
- len += Parrot_io_eprintf(debugger, "%vg", VTABLE_get_number(interp, key));
- break;
- case KEY_string_FLAG:
- {
- const STRING * const s = key_string(interp, key);
- STRING* const escaped = Parrot_str_escape_truncate(
- interp, s, 20);
- if (escaped)
- len += Parrot_io_eprintf(debugger, "\"%Ss\"", escaped);
- else
- len += Parrot_io_eprintf(debugger, "\"(null)\"");
- }
- break;
- case KEY_integer_FLAG|KEY_register_FLAG:
- len += Parrot_io_eprintf(debugger, "I%vd=%vd", VTABLE_get_integer(interp, key),
- REG_INT(interp, VTABLE_get_integer(interp, key)));
- break;
- case KEY_number_FLAG|KEY_register_FLAG:
- len += Parrot_io_eprintf(debugger, "I%vd=%vd", VTABLE_get_integer(interp, key),
- REG_NUM(interp, VTABLE_get_integer(interp, key)));
- break;
- case KEY_string_FLAG|KEY_register_FLAG:
- {
- const STRING * const s = REG_STR(interp, VTABLE_get_integer(interp, key));
- STRING* const escaped = Parrot_str_escape_truncate(
- interp, s, 20);
- if (escaped)
- len += Parrot_io_eprintf(debugger, "S%vd=\"%Ss\"", VTABLE_get_integer(interp, key),
- escaped);
- else
- len += Parrot_io_eprintf(debugger, "S%vd=\"(null)\"",
- VTABLE_get_integer(interp, key));
- }
- break;
- case KEY_pmc_FLAG|KEY_register_FLAG:
- len += Parrot_io_eprintf(debugger, "P%vd=", VTABLE_get_integer(interp, key));
- trace_pmc_dump(debugger, REG_PMC(interp, VTABLE_get_integer(interp, key)));
- break;
- default:
- len += Parrot_io_eprintf(debugger, "??");
- key = NULL;
- break;
- }
-
- if (key) {
- key = (PMC *)PMC_data(key);
- if (key)
- len += Parrot_io_eprintf(debugger, ";");
- }
- } /* while */
-
- len += Parrot_io_eprintf(debugger, "]");
- return len;
-}
-
-/*
-
-=item C<void trace_op_dump(PARROT_INTERP, const opcode_t *code_start, const
-opcode_t *pc)>
-
-Prints the PC, OP and ARGS. Used by C<trace_op()>.
-
-I<Not really part of the API.>
-
-=cut
-
-*/
-
-void
-trace_op_dump(PARROT_INTERP,
- ARGIN(const opcode_t *code_start),
- ARGIN(const opcode_t *pc))
-{
- ASSERT_ARGS(trace_op_dump)
- INTVAL s, n;
- int more = 0, var_args;
- Interp * const debugger = interp->pdb->debugger;
- op_info_t * const info = &interp->op_info_table[*pc];
- PMC *sig;
- int type;
- int len;
-#define ARGS_COLUMN 40
-
- PARROT_ASSERT(debugger);
- sig = NULL; /* silence compiler uninit warning */
-
- s = 1;
- len = Parrot_io_eprintf(debugger, "%6vu ", (UINTVAL)(pc - code_start));
- if (STREQ(info->name, "infix")) {
- /* this should rather be MMD_opcode_name, which doesn't
- * exit yet
- */
- len += Parrot_io_eprintf(debugger, "%s",
- Parrot_MMD_method_name(interp, pc[1]) + 2);
- s = 2;
- }
- else if (STREQ(info->name, "n_infix")) {
- len += Parrot_io_eprintf(debugger, "n_%s",
- Parrot_MMD_method_name(interp, pc[1]) + 2);
- s = 2;
- }
- else
- len += Parrot_io_eprintf(debugger, "%s", info->name);
-
- n = info->op_count;
- var_args = 0;
-
- if (*pc == PARROT_OP_set_args_pc ||
- *pc == PARROT_OP_get_results_pc ||
- *pc == PARROT_OP_get_params_pc ||
- *pc == PARROT_OP_set_returns_pc) {
- sig = interp->code->const_table->constants[pc[1]]->u.key;
-
- if (!sig)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL sig PMC detected in trace_op_dump");
-
- var_args = VTABLE_elements(interp, sig);
- n += var_args;
- }
-
- if (n > 1) {
- INTVAL i;
- len += Parrot_io_eprintf(debugger, " ");
- /* pass 1 print arguments */
- for (i = s; i < n; i++) {
- const opcode_t o = pc[i];
- if (i < info->op_count) {
- type = info->types[i - 1];
- }
- else {
- if (!sig)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL sig PMC detected in trace_op_dump");
-
- type = VTABLE_get_integer_keyed_int(interp, sig, i - 2) &
- (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
- }
- if (i > s &&
- type != PARROT_ARG_KC &&
- type != PARROT_ARG_KIC &&
- type != PARROT_ARG_KI &&
- type != PARROT_ARG_K) {
- len += Parrot_io_eprintf(debugger, ", ");
- }
- switch (type) {
- case PARROT_ARG_IC:
- len += Parrot_io_eprintf(debugger, "%vd", o);
- break;
- case PARROT_ARG_NC:
- len += Parrot_io_eprintf(debugger, "%vg", PCONST(o)->u.number);
- break;
- case PARROT_ARG_PC:
- if (var_args)
- len += Parrot_io_eprintf(debugger, "PC%d (%d)",
- (int)o, var_args);
- else
- len += Parrot_io_eprintf(debugger, "PC%d", (int)o);
- break;
- case PARROT_ARG_SC:
- {
- STRING* const escaped = Parrot_str_escape_truncate(
- interp,
- PCONST(o)->u.string, 20);
- if (escaped)
- len += Parrot_io_eprintf(debugger, "\"%Ss\"", escaped);
- else
- len += Parrot_io_eprintf(debugger, "\"(null)\"");
- }
- break;
- case PARROT_ARG_KC:
- len += trace_key_dump(interp, PCONST(o)->u.key);
- break;
- case PARROT_ARG_KIC:
- len += Parrot_io_eprintf(debugger, "[%vd]", o);
- break;
- case PARROT_ARG_KI:
- len += Parrot_io_eprintf(debugger, "[I%vd]", o);
- more = 1;
- break;
- case PARROT_ARG_K:
- len += Parrot_io_eprintf(debugger, "[P%vd]", o);
- more = 1;
- break;
- case PARROT_ARG_I:
- len += Parrot_io_eprintf(debugger, "I%vd", o);
- more = 1;
- break;
- case PARROT_ARG_N:
- len += Parrot_io_eprintf(debugger, "N%vd", o);
- more = 1;
- break;
- case PARROT_ARG_P:
- len += Parrot_io_eprintf(debugger, "P%vd", o);
- more = 1;
- break;
- case PARROT_ARG_S:
- len += Parrot_io_eprintf(debugger, "S%vd", o);
- more = 1;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled type in trace");
- break;
- }
- }
- if (!more)
- goto done;
- if (len < ARGS_COLUMN) {
- STRING * const fill = Parrot_str_repeat(debugger,
- Parrot_str_new_constant(debugger, " "),
- ARGS_COLUMN);
- Parrot_io_putps(debugger, Parrot_io_STDERR(debugger), fill);
- }
- else {
- Parrot_io_eprintf(debugger, "\t");
- }
-
- /* pass 2 print argument details if needed */
- for (i = 1; i < n; i++) {
- const opcode_t o = pc[i];
- if (i < info->op_count)
- type = info->types[i - 1];
- else
- type = VTABLE_get_integer_keyed_int(interp, sig, i - 2) &
- (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
- if (i > s) {
- Parrot_io_eprintf(debugger, " ");
- }
- switch (type) {
- case PARROT_ARG_I:
- Parrot_io_eprintf(debugger, "I%vd=%vd", o, REG_INT(interp, o));
- break;
- case PARROT_ARG_N:
- Parrot_io_eprintf(debugger, "N%vd=%vf", o, REG_NUM(interp, o));
- break;
- case PARROT_ARG_PC:
- Parrot_io_eprintf(debugger, "PC%vd=", o);
- trace_pmc_dump(interp, PCONST(o)->u.key);
- break;
- case PARROT_ARG_P:
- Parrot_io_eprintf(debugger, "P%vd=", o);
- trace_pmc_dump(interp, REG_PMC(interp, o));
- break;
- case PARROT_ARG_S:
- if (REG_STR(interp, o)) {
- STRING* const escaped = Parrot_str_escape_truncate(
- interp, REG_STR(interp, o), 20);
- Parrot_io_eprintf(debugger, "S%vd=\"%Ss\"", o,
- escaped);
- }
- else
- Parrot_io_eprintf(debugger, "S%vd=\"(null)\"", o);
- break;
- case PARROT_ARG_K:
- Parrot_io_eprintf(debugger, "P%vd=", o);
- trace_key_dump(interp, REG_PMC(interp, *(pc + i)));
- break;
- case PARROT_ARG_KI:
- Parrot_io_eprintf(debugger, "I%vd=[%vd]", o, REG_INT(interp, o));
- break;
- default:
- break;
- }
- }
- }
-done:
-
- if (interp->code->annotations) {
- PMC *annot = PackFile_Annotations_lookup(interp, interp->code->annotations,
- pc - code_start + 1, NULL);
- if (!PMC_IS_NULL(annot)) {
- PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
- Parrot_str_new_constant(interp, "file"));
- PMC *pline = VTABLE_get_pmc_keyed_str(interp, annot,
- Parrot_str_new_constant(interp, "line"));
- if ((!PMC_IS_NULL(pfile)) && (!PMC_IS_NULL(pline))) {
- /* The debugger interpreter may not be the same as
- * the main interpreter, extract values from the
- * PMC instad of passing them directly
- */
- STRING *file = VTABLE_get_string(interp, pfile);
- INTVAL line = VTABLE_get_integer(interp, pline);
- Parrot_io_eprintf(debugger, " (%Ss:%li)", file, (long)line);
- }
- }
- }
-
- Parrot_io_eprintf(debugger, "\n");
-}
-
-/*
-
-=item C<void trace_op(PARROT_INTERP, const opcode_t *code_start, const opcode_t
-*code_end, const opcode_t *pc)>
-
-Prints the PC, OP and ARGS. Used by C<runops_trace()>. With bounds
-checking.
-
-I<Not really part of the API.>
-
-=cut
-
-*/
-
-void
-trace_op(PARROT_INTERP,
- ARGIN(const opcode_t *code_start),
- ARGIN(const opcode_t *code_end),
- ARGIN_NULLOK(const opcode_t *pc))
-{
- ASSERT_ARGS(trace_op)
- if (!pc) {
- return;
- }
-
- if (pc >= code_start && pc < code_end)
- trace_op_dump(interp, code_start, pc);
- else
- Parrot_io_eprintf(interp, "PC=%ld; OP=<err>\n", (long)(pc - code_start));
-}
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<src/trace.h>
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/trace.h
==============================================================================
--- trunk/src/trace.h Wed Apr 22 20:06:30 2009 (r38274)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,67 +0,0 @@
-/* trace.h
- * Copyright (C) 2001-2007, Parrot Foundation.
- * SVN Info
- * $Id$
- * Overview:
- * Tracing support for runops_cores.c.
- * Data Structure and Algorithms:
- * History:
- * Notes:
- * References:
- */
-
-#ifndef PARROT_TRACE_H_GUARD
-#define PARROT_TRACE_H_GUARD
-
-#include "parrot/parrot.h"
-
-/* HEADERIZER BEGIN: src/trace.c */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-int trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-void trace_op(PARROT_INTERP,
- ARGIN(const opcode_t *code_start),
- ARGIN(const opcode_t *code_end),
- ARGIN_NULLOK(const opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-void trace_op_dump(PARROT_INTERP,
- ARGIN(const opcode_t *code_start),
- ARGIN(const opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-void trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
- __attribute__nonnull__(1);
-
-#define ASSERT_ARGS_trace_key_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(key)
-#define ASSERT_ARGS_trace_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(code_start) \
- || PARROT_ASSERT_ARG(code_end)
-#define ASSERT_ARGS_trace_op_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(code_start) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_trace_pmc_dump __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/trace.c */
-
-#endif /* PARROT_TRACE_H_GUARD */
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/t/tools/dev/searchops/samples.pm
==============================================================================
--- trunk/t/tools/dev/searchops/samples.pm Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/t/tools/dev/searchops/samples.pm Wed Apr 22 20:06:30 2009 (r38275)
@@ -19,7 +19,7 @@
#include "parrot/dynext.h"
#include "parrot/embed.h"
-#include "../interp_guts.h"
+#include "../interp/interp_guts.h"
VERSION = PARROT_VERSION;
Modified: trunk/t/tools/ops2pm/samples/core_ops.original
==============================================================================
--- trunk/t/tools/ops2pm/samples/core_ops.original Wed Apr 22 19:57:35 2009 (r38274)
+++ trunk/t/tools/ops2pm/samples/core_ops.original Wed Apr 22 20:06:30 2009 (r38275)
@@ -5,7 +5,7 @@
#include "parrot/dynext.h"
#include "parrot/embed.h"
-#include "../interp_guts.h"
+#include "../interp/interp_guts.h"
VERSION = PARROT_VERSION;
More information about the parrot-commits
mailing list