2 Copyright (C) 2001-2010, Parrot Foundation.
7 src/embed.c - The Parrot embedding interface
11 This file implements the Parrot embedding interface.
21 #include "parrot/parrot.h"
22 #include "parrot/embed.h"
23 #include "parrot/oplib/ops.h"
24 #include "pmc/pmc_sub.h"
25 #include "pmc/pmc_callcontext.h"
26 #include "parrot/runcore_api.h"
28 #include "../compilers/imcc/imc.h"
32 /* HEADERIZER HFILE: include/parrot/embed.h */
34 /* HEADERIZER BEGIN: static */
35 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
37 static void print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
38 __attribute__nonnull__(1)
39 __attribute__nonnull__(2);
41 static void print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
42 __attribute__nonnull__(1);
44 PARROT_CANNOT_RETURN_NULL
45 static PMC
* set_current_sub(PARROT_INTERP
)
46 __attribute__nonnull__(1);
48 PARROT_CANNOT_RETURN_NULL
49 static PMC
* setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
50 __attribute__nonnull__(1)
51 __attribute__nonnull__(3);
53 #define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
54 PARROT_ASSERT_ARG(interp) \
55 , PARROT_ASSERT_ARG(output))
56 #define ASSERT_ARGS_print_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
57 PARROT_ASSERT_ARG(interp))
58 #define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
59 PARROT_ASSERT_ARG(interp))
60 #define ASSERT_ARGS_setup_argv __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
61 PARROT_ASSERT_ARG(interp) \
62 , PARROT_ASSERT_ARG(argv))
63 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
64 /* HEADERIZER END: static */
66 extern int Parrot_exec_run
;
70 =item C<Parrot_Interp Parrot_new(Parrot_Interp parent)>
72 Returns a new Parrot interpreter.
74 The first created interpreter (C<parent> is C<NULL>) is the last one
82 PARROT_CANNOT_RETURN_NULL
85 Parrot_new(ARGIN_NULLOK(Parrot_Interp parent
))
87 ASSERT_ARGS(Parrot_new
)
88 /* inter_create.c:make_interpreter builds a new Parrot_Interp. */
89 return make_interpreter(parent
, PARROT_NO_FLAGS
);
95 =item C<void Parrot_init_stacktop(PARROT_INTERP, void *stack_top)>
97 Initializes the new interpreter when it hasn't been initialized before.
99 Additionally sets the stack top, so that Parrot objects created
100 in inner stack frames will be visible during GC stack walking code.
101 B<stack_top> should be the address of an automatic variable in the caller's
102 stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
103 frames so that they are not destroyed during GC runs.
105 Use this function when you call into Parrot before entering a run loop.
113 Parrot_init_stacktop(PARROT_INTERP
, ARGIN(void *stack_top
))
115 ASSERT_ARGS(Parrot_init_stacktop
)
116 interp
->lo_var_ptr
= stack_top
;
117 init_world_once(interp
);
123 =item C<void Parrot_set_flag(PARROT_INTERP, Parrot_Int flag)>
125 Sets on any of the following flags, specified by C<flag>, in the interpreter:
128 C<PARROT_BOUNDS_FLAG> enable bounds checking
129 C<PARROT_PROFILE_FLAG> enable profiling,
137 Parrot_set_flag(PARROT_INTERP
, Parrot_Int flag
)
139 ASSERT_ARGS(Parrot_set_flag
)
140 /* These two macros (from interpreter.h) do exactly what they look like. */
142 Interp_flags_SET(interp
, flag
);
144 case PARROT_BOUNDS_FLAG
:
145 case PARROT_PROFILE_FLAG
:
146 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
156 =item C<void Parrot_set_debug(PARROT_INTERP, Parrot_UInt flag)>
158 Set a debug flag: C<PARROT_DEBUG_FLAG>.
166 Parrot_set_debug(PARROT_INTERP
, Parrot_UInt flag
)
168 ASSERT_ARGS(Parrot_set_debug
)
169 interp
->debug_flags
|= flag
;
175 =item C<void Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)>
177 Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
186 Parrot_set_executable_name(PARROT_INTERP
, Parrot_String name
)
188 ASSERT_ARGS(Parrot_set_executable_name
)
189 PMC
* const name_pmc
= Parrot_pmc_new(interp
, enum_class_String
);
190 VTABLE_set_string_native(interp
, name_pmc
, name
);
191 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
, IGLOBALS_EXECUTABLE
,
198 =item C<void Parrot_set_trace(PARROT_INTERP, Parrot_UInt flag)>
200 Set a trace flag: C<PARROT_TRACE_FLAG>
208 Parrot_set_trace(PARROT_INTERP
, Parrot_UInt flag
)
210 ASSERT_ARGS(Parrot_set_trace
)
211 Parrot_pcc_trace_flags_on(interp
, interp
->ctx
, flag
);
212 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
218 =item C<void Parrot_clear_flag(PARROT_INTERP, Parrot_Int flag)>
220 Clears a flag in the interpreter.
228 Parrot_clear_flag(PARROT_INTERP
, Parrot_Int flag
)
230 ASSERT_ARGS(Parrot_clear_flag
)
231 Interp_flags_CLEAR(interp
, flag
);
237 =item C<void Parrot_clear_debug(PARROT_INTERP, Parrot_UInt flag)>
239 Clears a flag in the interpreter.
247 Parrot_clear_debug(PARROT_INTERP
, Parrot_UInt flag
)
249 ASSERT_ARGS(Parrot_clear_debug
)
250 interp
->debug_flags
&= ~flag
;
256 =item C<void Parrot_clear_trace(PARROT_INTERP, Parrot_UInt flag)>
258 Clears a flag in the interpreter.
266 Parrot_clear_trace(PARROT_INTERP
, Parrot_UInt flag
)
268 ASSERT_ARGS(Parrot_clear_trace
)
269 Parrot_pcc_trace_flags_off(interp
, interp
->ctx
, flag
);
275 =item C<Parrot_Int Parrot_test_flag(PARROT_INTERP, Parrot_Int flag)>
277 Test the interpreter flags specified in C<flag>.
285 Parrot_test_flag(PARROT_INTERP
, Parrot_Int flag
)
287 ASSERT_ARGS(Parrot_test_flag
)
288 return Interp_flags_TEST(interp
, flag
);
294 =item C<Parrot_UInt Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)>
296 Test the interpreter flags specified in C<flag>.
304 Parrot_test_debug(PARROT_INTERP
, Parrot_UInt flag
)
306 ASSERT_ARGS(Parrot_test_debug
)
307 return interp
->debug_flags
& flag
;
313 =item C<Parrot_UInt Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)>
315 Test the interpreter flags specified in C<flag>.
323 Parrot_test_trace(PARROT_INTERP
, Parrot_UInt flag
)
325 ASSERT_ARGS(Parrot_test_trace
)
326 return Parrot_pcc_trace_flags_test(interp
, interp
->ctx
, flag
);
332 =item C<void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
334 Sets the specified run core.
342 Parrot_set_run_core(PARROT_INTERP
, Parrot_Run_core_t core
)
344 ASSERT_ARGS(Parrot_set_run_core
)
346 case PARROT_SLOW_CORE
:
347 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
349 case PARROT_FAST_CORE
:
350 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "fast"));
352 case PARROT_EXEC_CORE
:
353 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "exec"));
355 case PARROT_GC_DEBUG_CORE
:
356 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "gc_debug"));
358 case PARROT_DEBUGGER_CORE
:
359 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "debugger"));
361 case PARROT_PROFILING_CORE
:
362 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "profiling"));
365 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_UNIMPLEMENTED
,
366 "Invalid runcore requested\n");
373 =item C<void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)>
375 Activates the given warnings.
383 Parrot_setwarnings(PARROT_INTERP
, Parrot_warnclass wc
)
385 ASSERT_ARGS(Parrot_setwarnings
)
386 /* Activates the given warnings. (Macro from warnings.h.) */
387 PARROT_WARNINGS_on(interp
, wc
);
393 =item C<Parrot_PackFile Parrot_pbc_read(PARROT_INTERP, const char *fullname,
396 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
403 PARROT_CAN_RETURN_NULL
405 Parrot_pbc_read(PARROT_INTERP
, ARGIN_NULLOK(const char *fullname
), const int debug
)
407 ASSERT_ARGS(Parrot_pbc_read
)
411 INTVAL is_mapped
= 0;
414 #ifdef PARROT_HAS_HEADER_SYSMMAN
418 if (!fullname
|| STREQ(fullname
, "-")) {
419 /* read from STDIN */
422 /* read 1k at a time */
426 STRING
* const fs
= string_make(interp
, fullname
, strlen(fullname
),
429 /* can't read a file that doesn't exist */
430 if (!Parrot_stat_info_intval(interp
, fs
, STAT_EXISTS
)) {
431 Parrot_io_eprintf(interp
, "Parrot VM: Can't stat %s, code %i.\n",
436 /* we may need to relax this if we want to read bytecode from pipes */
437 if (!Parrot_stat_info_intval(interp
, fs
, STAT_ISREG
)) {
438 Parrot_io_eprintf(interp
,
439 "Parrot VM: '%s', is not a regular file %i.\n",
444 program_size
= Parrot_stat_info_intval(interp
, fs
, STAT_FILESIZE
);
446 #ifndef PARROT_HAS_HEADER_SYSMMAN
447 io
= fopen(fullname
, "rb");
450 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
454 #endif /* PARROT_HAS_HEADER_SYSMMAN */
457 #ifdef PARROT_HAS_HEADER_SYSMMAN
460 /* if we've opened a file (or stdin) with PIO, read it in */
463 size_t chunk_size
= program_size
> 0 ? program_size
: 1024;
464 INTVAL wanted
= program_size
;
467 program_code
= mem_gc_allocate_n_typed(interp
, chunk_size
, char);
468 cursor
= program_code
;
471 while ((read_result
= fread(cursor
, 1, chunk_size
, io
)) > 0) {
472 program_size
+= read_result
;
474 if (program_size
== wanted
)
478 program_code
= mem_gc_realloc_n_typed(interp
, program_code
,
479 program_size
+ chunk_size
, char);
482 Parrot_io_eprintf(interp
,
483 "Parrot VM: Could not reallocate buffer "
484 "while reading packfile from PIO.\n");
489 cursor
= (char *)(program_code
+ program_size
);
493 Parrot_io_eprintf(interp
,
494 "Parrot VM: Problem reading packfile from PIO: code %d.\n",
497 mem_gc_free(interp
, program_code
);
504 /* if we've gotten here, we opted not to use PIO to read the file.
507 #ifdef PARROT_HAS_HEADER_SYSMMAN
509 /* check that fullname isn't NULL, just in case */
511 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
512 "Trying to open a NULL filename");
514 fd
= open(fullname
, O_RDONLY
| O_BINARY
);
517 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
522 program_code
= (char *)mmap(0, (size_t)program_size
,
523 PROT_READ
, MAP_SHARED
, fd
, (off_t
)0);
525 if (program_code
== (void *)MAP_FAILED
) {
526 Parrot_warn(interp
, PARROT_WARNINGS_IO_FLAG
,
527 "Parrot VM: Can't mmap file %s, code %i.\n",
530 /* try again, now with IO reading the file */
531 io
= fopen(fullname
, "rb");
533 Parrot_io_eprintf(interp
,
534 "Parrot VM: Can't open %s, code %i.\n", fullname
, errno
);
542 #else /* PARROT_HAS_HEADER_SYSMMAN */
544 Parrot_io_eprintf(interp
, "Parrot VM: uncaught error occurred reading "
545 "file or mmap not available.\n");
548 #endif /* PARROT_HAS_HEADER_SYSMMAN */
552 /* Now that we have the bytecode, let's unpack it. */
554 pf
= PackFile_new(interp
, is_mapped
);
556 /* Make the cmdline option available to the unpackers */
559 if (!PackFile_unpack(interp
, pf
, (opcode_t
*)program_code
,
560 (size_t)program_size
)) {
561 Parrot_io_eprintf(interp
, "Parrot VM: Can't unpack packfile %s.\n",
566 /* Set :main routine */
567 if (!(pf
->options
& PFOPT_HEADERONLY
))
568 do_sub_pragmas(interp
, pf
->cur_cs
, PBC_PBC
, NULL
);
570 /* Prederefing the sub/the bytecode is done in switch_to_cs before
571 * actual usage of the segment */
573 #ifdef PARROT_HAS_HEADER_SYSMMAN
574 /* the man page states that it's ok to close a mmaped file */
585 =item C<void Parrot_pbc_load(PARROT_INTERP, Parrot_PackFile pf)>
587 Loads the C<PackFile> returned by C<Parrot_pbc_read()>.
595 Parrot_pbc_load(PARROT_INTERP
, ARGIN(Parrot_PackFile pf
))
597 ASSERT_ARGS(Parrot_pbc_load
)
599 Parrot_io_eprintf(interp
, "Invalid packfile\n");
603 interp
->initial_pf
= pf
;
604 interp
->code
= pf
->cur_cs
;
610 =item C<void Parrot_pbc_fixup_loaded(PARROT_INTERP)>
612 Fixups after pbc loading
620 Parrot_pbc_fixup_loaded(PARROT_INTERP
)
622 ASSERT_ARGS(Parrot_pbc_fixup_loaded
)
623 PackFile_fixup_subs(interp
, PBC_LOADED
, NULL
);
629 =item C<static PMC* setup_argv(PARROT_INTERP, int argc, const char **argv)>
631 Creates and returns C<ARGS> array PMC.
637 PARROT_CANNOT_RETURN_NULL
639 setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
641 ASSERT_ARGS(setup_argv
)
642 PMC
* const userargv
= Parrot_pmc_new(interp
, enum_class_ResizableStringArray
);
645 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
646 Parrot_io_eprintf(interp
,
647 "*** Parrot VM: Setting up ARGV array. Current argc: %d ***\n",
651 /* immediately anchor pmc to root set */
652 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
,
653 (INTVAL
)IGLOBALS_ARGV_LIST
, userargv
);
655 for (i
= 0; i
< argc
; ++i
) {
656 /* Run through argv, adding everything to @ARGS. */
658 string_make(interp
, argv
[i
], strlen(argv
[i
]), "unicode",
661 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
))
662 Parrot_io_eprintf(interp
, "\t%vd: %s\n", i
, argv
[i
]);
664 VTABLE_push_string(interp
, userargv
, arg
);
673 =item C<static void print_debug(PARROT_INTERP, int status, void *p)>
682 print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
684 ASSERT_ARGS(print_debug
)
685 if (Interp_debug_TEST(interp
, PARROT_MEM_STAT_DEBUG_FLAG
)) {
686 /* Give souls brave enough to activate debugging an earful about GC. */
688 Parrot_io_eprintf(interp
, "*** Parrot VM: Dumping GC info ***\n");
696 =item C<static PMC* set_current_sub(PARROT_INTERP)>
698 Search the fixup table for a PMC matching the argument. On a match,
699 set up the appropriate context.
701 If no match, set up a dummy PMC entry. In either case, return a
708 PARROT_CANNOT_RETURN_NULL
710 set_current_sub(PARROT_INTERP
)
712 ASSERT_ARGS(set_current_sub
)
715 PackFile_ByteCode
* const cur_cs
= interp
->code
;
716 PackFile_FixupTable
* const ft
= cur_cs
->fixups
;
717 PackFile_ConstTable
* const ct
= cur_cs
->const_table
;
722 * Walk the fixup table. The first Sub-like entry should be our
723 * entry point with the address at our resume_offset.
726 for (i
= 0; i
< ft
->fixup_count
; ++i
) {
727 if (ft
->fixups
[i
].type
== enum_fixup_sub
) {
728 const opcode_t ci
= ft
->fixups
[i
].offset
;
729 PMC
* const sub_pmc
= ct
->constants
[ci
]->u
.key
;
730 Parrot_Sub_attributes
*sub
;
732 PMC_get_sub(interp
, sub_pmc
, sub
);
733 if (sub
->seg
== cur_cs
) {
734 const size_t offs
= sub
->start_offs
;
736 if (offs
== interp
->resume_offset
) {
737 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), sub_pmc
);
738 Parrot_pcc_set_HLL(interp
, CURRENT_CONTEXT(interp
), sub
->HLL_id
);
747 /* If we didn't find anything, put a dummy PMC into current_sub.
748 The default values set by SUb.init are appropiate for the
749 dummy, don't need additional settings. */
750 new_sub_pmc
= Parrot_pmc_new(interp
, enum_class_Sub
);
751 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), new_sub_pmc
);
759 =item C<void Parrot_runcode(PARROT_INTERP, int argc, const char **argv)>
761 Sets up C<ARGV> and runs the ops.
769 Parrot_runcode(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
771 ASSERT_ARGS(Parrot_runcode
)
772 PMC
*userargv
, *main_sub
;
774 /* Debugging mode nonsense. */
775 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
776 if (Interp_flags_TEST(interp
, PARROT_BOUNDS_FLAG
)) {
777 Parrot_io_eprintf(interp
,
778 "*** Parrot VM: Bounds checking enabled. ***\n");
781 if (Interp_trace_TEST(interp
, PARROT_TRACE_OPS_FLAG
))
782 Parrot_io_eprintf(interp
, "*** Parrot VM: Tracing enabled. ***\n");
784 Parrot_io_eprintf(interp
, "*** Parrot VM: %Ss core ***\n",
785 interp
->run_core
->name
);
788 /* Set up @ARGS (or whatever this language calls it) in userargv. */
789 userargv
= setup_argv(interp
, argc
, argv
);
792 * If any profile information was gathered, print it out
793 * before exiting, then print debug infos if turned on.
795 Parrot_on_exit(interp
, print_debug
, NULL
);
797 /* Let's kick the tires and light the fires--call interpreter.c:runops. */
798 main_sub
= Parrot_pcc_get_sub(interp
, CURRENT_CONTEXT(interp
));
800 /* if no sub was marked being :main, we create a dummy sub with offset 0 */
803 main_sub
= set_current_sub(interp
);
805 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), NULL
);
806 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
808 Parrot_pcc_invoke_sub_from_c_args(interp
, main_sub
, "P->", userargv
);
814 =item C<Parrot_Opcode * Parrot_debug(PARROT_INTERP, Parrot_Interp debugger,
817 Runs the interpreter's bytecode in debugging mode.
824 PARROT_CAN_RETURN_NULL
826 Parrot_debug(PARROT_INTERP
, ARGIN(Parrot_Interp debugger
), ARGIN(Parrot_Opcode
*pc
))
828 ASSERT_ARGS(Parrot_debug
)
829 PDB_t
* const pdb
= debugger
->pdb
;
831 pdb
->cur_opcode
= pc
;
833 PDB_init(debugger
, NULL
);
835 /* disassemble needs this for now */
837 interp = pdb->debugee;
840 debugger
->lo_var_ptr
= interp
->lo_var_ptr
;
842 PDB_disassemble(interp
, NULL
);
844 while (!(pdb
->state
& PDB_EXIT
)) {
847 PDB_get_command(debugger
);
848 command
= pdb
->cur_command
;
849 PDB_run_command(debugger
, command
);
858 =item C<static void print_constant_table(PARROT_INTERP, PMC *output)>
860 Prints the contents of the constants table.
866 print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
868 ASSERT_ARGS(print_constant_table
)
869 const INTVAL numconstants
= interp
->code
->const_table
->const_count
;
872 /* TODO: would be nice to print the name of the file as well */
873 Parrot_io_fprintf(interp
, output
, "=head1 Constant-table\n\n");
875 for (i
= 0; i
< numconstants
; ++i
) {
876 const PackFile_Constant
* const c
= interp
->code
->const_table
->constants
[i
];
880 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %f\n", i
, c
->u
.number
);
883 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %S\n", i
, c
->u
.string
);
886 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
888 /* Parrot_print_p(interp, c->u.key); */
889 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
890 Parrot_io_fprintf(interp
, output
, "\n");
894 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
896 switch (c
->u
.key
->vtable
->base_type
) {
897 /* each PBC file has a ParrotInterpreter, but it can't
898 * stringify by itself */
899 case enum_class_ParrotInterpreter
:
900 Parrot_io_fprintf(interp
, output
, "'ParrotInterpreter'");
903 /* FixedIntegerArrays used for signatures, handy to print */
904 case enum_class_FixedIntegerArray
:
906 const INTVAL n
= VTABLE_elements(interp
, c
->u
.key
);
908 Parrot_io_fprintf(interp
, output
, "[");
910 for (j
= 0; j
< n
; ++j
) {
911 const INTVAL val
= VTABLE_get_integer_keyed_int(interp
, c
->u
.key
, j
);
912 Parrot_io_fprintf(interp
, output
, "%d", val
);
914 Parrot_io_fprintf(interp
, output
, ",");
916 Parrot_io_fprintf(interp
, output
, "]");
919 case enum_class_NameSpace
:
920 case enum_class_String
:
922 case enum_class_ResizableStringArray
:
924 /*Parrot_print_p(interp, c->u.key);*/
925 STRING
* const s
= VTABLE_get_string(interp
, c
->u
.key
);
927 Parrot_io_fprintf(interp
, output
, "%Ss", s
);
931 Parrot_io_fprintf(interp
, output
, "%S", VTABLE_get_string(interp
, c
->u
.key
));
934 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
938 Parrot_io_fprintf(interp
, output
, "\n");
942 Parrot_io_fprintf(interp
, output
, "wrong constant type in constant table!\n");
943 /* XXX throw an exception? Is it worth the trouble? */
948 Parrot_io_fprintf(interp
, output
, "\n=cut\n\n");
954 =item C<void Parrot_disassemble(PARROT_INTERP, const char *outfile,
955 Parrot_disassemble_options options)>
957 Disassembles and prints out the interpreter's bytecode.
959 This is used by the Parrot disassembler.
967 Parrot_disassemble(PARROT_INTERP
,
968 ARGIN_NULLOK(const char *outfile
), Parrot_disassemble_options options
)
970 ASSERT_ARGS(Parrot_disassemble
)
972 PDB_t
* const pdb
= mem_gc_allocate_zeroed_typed(interp
, PDB_t
);
973 int num_mappings
= 0;
974 int curr_mapping
= 0;
975 int op_code_seq_num
= 0;
979 if (outfile
!= NULL
) {
980 output
= Parrot_io_open(interp
, PMCNULL
,
981 Parrot_str_new(interp
, outfile
, 0),
982 Parrot_str_new_constant(interp
, "tw"));
985 output
= Parrot_io_stdhandle(interp
, PIO_STDOUT_FILENO
, PMCNULL
);
988 pdb
->cur_opcode
= interp
->code
->base
.data
;
990 PDB_disassemble(interp
, NULL
);
992 line
= pdb
->file
->line
;
993 debugs
= (interp
->code
->debugs
!= NULL
);
995 print_constant_table(interp
, output
);
996 if (options
& enum_DIS_HEADER
)
999 if (!(options
& enum_DIS_BARE
))
1000 Parrot_io_fprintf(interp
, output
, "# %12s-%12s", "Seq_Op_Num", "Relative-PC");
1003 if (!(options
& enum_DIS_BARE
))
1004 Parrot_io_fprintf(interp
, output
, " %6s:\n", "SrcLn#");
1005 num_mappings
= interp
->code
->debugs
->num_mappings
;
1008 Parrot_io_fprintf(interp
, output
, "\n");
1011 while (line
->next
) {
1014 /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping,
1015 * num_mappings, op_code_seq_num,
1016 * interp->code->debugs->mappings[curr_mapping].offset); */
1018 if (debugs
&& curr_mapping
< num_mappings
) {
1019 if (op_code_seq_num
== interp
->code
->debugs
->mappings
[curr_mapping
].offset
) {
1020 const int filename_const_offset
=
1021 interp
->code
->debugs
->mappings
[curr_mapping
].filename
;
1022 Parrot_io_fprintf(interp
, output
, "# Current Source Filename '%Ss'\n",
1023 interp
->code
->const_table
->constants
[filename_const_offset
]->u
.string
);
1028 if (!(options
& enum_DIS_BARE
))
1029 Parrot_io_fprintf(interp
, output
, "%012i-%012i",
1030 op_code_seq_num
, line
->opcode
- interp
->code
->base
.data
);
1032 if (debugs
&& !(options
& enum_DIS_BARE
))
1033 Parrot_io_fprintf(interp
, output
, " %06i: ",
1034 interp
->code
->debugs
->base
.data
[op_code_seq_num
]);
1036 /* If it has a label print it */
1038 Parrot_io_fprintf(interp
, output
, "L%li:\t", line
->label
->number
);
1040 Parrot_io_fprintf(interp
, output
, "\t");
1042 c
= pdb
->file
->source
+ line
->source_offset
;
1044 while (c
&& *c
!= '\n')
1045 Parrot_io_fprintf(interp
, output
, "%c", *(c
++));
1047 Parrot_io_fprintf(interp
, output
, "\n");
1051 if (outfile
!= NULL
)
1052 Parrot_io_close(interp
, output
);
1060 =item C<void Parrot_run_native(PARROT_INTERP, native_func_t func)>
1062 Runs the C function C<func> through the program C<[enternative, end]>. This
1063 ensures that the function runs with the same setup as in other run loops.
1065 This function is used in some of the source tests in F<t/src> which use
1066 the interpreter outside a runloop.
1074 Parrot_run_native(PARROT_INTERP
, native_func_t func
)
1076 ASSERT_ARGS(Parrot_run_native
)
1077 PackFile
* const pf
= PackFile_new(interp
, 0);
1078 static opcode_t program_code
[2];
1080 program_code
[0] = interp
->op_lib
->op_code(interp
, "enternative", 0);
1081 program_code
[1] = 0; /* end */
1083 pf
->cur_cs
= (PackFile_ByteCode
*)
1084 (pf
->PackFuncs
[PF_BYTEC_SEG
].new_seg
)(interp
, pf
,
1085 Parrot_str_new_constant(interp
, "code"), 1);
1086 pf
->cur_cs
->base
.data
= program_code
;
1087 pf
->cur_cs
->base
.size
= 2;
1089 Parrot_pbc_load(interp
, pf
);
1093 if (interp
->code
&& interp
->code
->const_table
)
1094 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
1096 runops(interp
, interp
->resume_offset
);
1102 =item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
1103 const char *code, Parrot_String *error)>
1105 Compiles a code string.
1113 Parrot_compile_string(PARROT_INTERP
, Parrot_String type
, ARGIN(const char *code
),
1114 ARGOUT(Parrot_String
*error
))
1116 ASSERT_ARGS(Parrot_compile_string
)
1117 /* For the benefit of embedders that do not load any pbc
1118 * before compiling a string */
1120 if (!interp
->initial_pf
) {
1121 /* SIDE EFFECT: PackFile_new_dummy sets interp->initial_pf */
1122 interp
->initial_pf
= PackFile_new_dummy(interp
, CONST_STRING(interp
, "compile_string"));
1123 /* Assumption: there is no valid reason to fail to create it.
1124 * If the assumption changes, replace the assertion with a
1126 PARROT_ASSERT(interp
->initial_pf
);
1129 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PIR"), type
) == 0)
1130 return IMCC_compile_pir_s(interp
, code
, error
);
1132 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PASM"), type
) == 0)
1133 return IMCC_compile_pasm_s(interp
, code
, error
);
1135 *error
= Parrot_str_new(interp
, "Invalid interpreter type", 0);
1146 F<include/parrot/embed.h> and F<docs/embed.pod>.
1154 * c-file-style: "parrot"
1156 * vim: expandtab shiftwidth=4: