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"
30 /* HEADERIZER HFILE: none */ /* The visible types are different than what we use in here */
32 /* HEADERIZER BEGIN: static */
33 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
35 static void print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
36 __attribute__nonnull__(1)
37 __attribute__nonnull__(2);
39 static void print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
40 __attribute__nonnull__(1);
42 PARROT_CANNOT_RETURN_NULL
43 static PMC
* set_current_sub(PARROT_INTERP
)
44 __attribute__nonnull__(1);
46 PARROT_CANNOT_RETURN_NULL
47 static PMC
* setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
48 __attribute__nonnull__(1)
49 __attribute__nonnull__(3);
51 #define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
52 PARROT_ASSERT_ARG(interp) \
53 , PARROT_ASSERT_ARG(output))
54 #define ASSERT_ARGS_print_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
55 PARROT_ASSERT_ARG(interp))
56 #define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
57 PARROT_ASSERT_ARG(interp))
58 #define ASSERT_ARGS_setup_argv __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
59 PARROT_ASSERT_ARG(interp) \
60 , PARROT_ASSERT_ARG(argv))
61 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
62 /* HEADERIZER END: static */
64 extern int Parrot_exec_run
;
68 =item C<Parrot_Interp Parrot_new(Parrot_Interp parent)>
70 Returns a new Parrot interpreter.
72 The first created interpreter (C<parent> is C<NULL>) is the last one
80 PARROT_CANNOT_RETURN_NULL
82 Parrot_new(ARGIN_NULLOK(Parrot_Interp parent
))
84 /* inter_create.c:make_interpreter builds a new Parrot_Interp. */
85 return make_interpreter(parent
, PARROT_NO_FLAGS
);
91 =item C<void Parrot_init_stacktop(PARROT_INTERP, void *stack_top)>
93 Initializes the new interpreter when it hasn't been initialized before.
95 Additionally sets the stack top, so that Parrot objects created
96 in inner stack frames will be visible during GC stack walking code.
97 B<stack_top> should be the address of an automatic variable in the caller's
98 stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
99 frames so that they are not destroyed during GC runs.
101 Use this function when you call into Parrot before entering a run loop.
109 Parrot_init_stacktop(PARROT_INTERP
, void *stack_top
)
111 interp
->lo_var_ptr
= stack_top
;
112 init_world_once(interp
);
118 =item C<void Parrot_set_flag(PARROT_INTERP, INTVAL flag)>
120 Sets on any of the following flags, specified by C<flag>, in the interpreter:
123 C<PARROT_BOUNDS_FLAG> enable bounds checking
124 C<PARROT_PROFILE_FLAG> enable profiling,
125 C<PARROT_THR_TYPE_1> disable variable sharing and thread communication
126 C<PARROT_THR_TYPE_2> disable variable sharing but enable thread communication
127 C<PARROT_THR_TYPE_3> enable variable sharing.
135 Parrot_set_flag(PARROT_INTERP
, INTVAL flag
)
137 /* These two macros (from interpreter.h) do exactly what they look like. */
139 Interp_flags_SET(interp
, flag
);
141 case PARROT_BOUNDS_FLAG
:
142 case PARROT_PROFILE_FLAG
:
143 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
153 =item C<void Parrot_set_debug(PARROT_INTERP, UINTVAL flag)>
155 Set a debug flag: C<PARROT_DEBUG_FLAG>.
163 Parrot_set_debug(PARROT_INTERP
, UINTVAL flag
)
165 interp
->debug_flags
|= flag
;
171 =item C<void Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)>
173 Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
182 Parrot_set_executable_name(PARROT_INTERP
, Parrot_String name
)
184 PMC
* const name_pmc
= Parrot_pmc_new(interp
, enum_class_String
);
185 VTABLE_set_string_native(interp
, name_pmc
, name
);
186 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
, IGLOBALS_EXECUTABLE
,
193 =item C<void Parrot_set_trace(PARROT_INTERP, UINTVAL flag)>
195 Set a trace flag: C<PARROT_TRACE_FLAG>
203 Parrot_set_trace(PARROT_INTERP
, UINTVAL flag
)
205 Parrot_pcc_trace_flags_on(interp
, interp
->ctx
, flag
);
206 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
212 =item C<void Parrot_clear_flag(PARROT_INTERP, INTVAL flag)>
214 Clears a flag in the interpreter.
222 Parrot_clear_flag(PARROT_INTERP
, INTVAL flag
)
224 Interp_flags_CLEAR(interp
, flag
);
230 =item C<void Parrot_clear_debug(PARROT_INTERP, UINTVAL flag)>
232 Clears a flag in the interpreter.
240 Parrot_clear_debug(PARROT_INTERP
, UINTVAL flag
)
242 interp
->debug_flags
&= ~flag
;
248 =item C<void Parrot_clear_trace(PARROT_INTERP, UINTVAL flag)>
250 Clears a flag in the interpreter.
258 Parrot_clear_trace(PARROT_INTERP
, UINTVAL flag
)
260 Parrot_pcc_trace_flags_off(interp
, interp
->ctx
, flag
);
266 =item C<Parrot_Int Parrot_test_flag(PARROT_INTERP, INTVAL flag)>
268 Test the interpreter flags specified in C<flag>.
276 Parrot_test_flag(PARROT_INTERP
, INTVAL flag
)
278 return Interp_flags_TEST(interp
, flag
);
284 =item C<UINTVAL Parrot_test_debug(PARROT_INTERP, UINTVAL flag)>
286 Test the interpreter flags specified in C<flag>.
294 Parrot_test_debug(PARROT_INTERP
, UINTVAL flag
)
296 return interp
->debug_flags
& flag
;
302 =item C<UINTVAL Parrot_test_trace(PARROT_INTERP, UINTVAL flag)>
304 Test the interpreter flags specified in C<flag>.
312 Parrot_test_trace(PARROT_INTERP
, UINTVAL flag
)
314 return Parrot_pcc_trace_flags_test(interp
, interp
->ctx
, flag
);
320 =item C<void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
322 Sets the specified run core.
330 Parrot_set_run_core(PARROT_INTERP
, Parrot_Run_core_t core
)
333 case PARROT_SLOW_CORE
:
334 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
336 case PARROT_FAST_CORE
:
337 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "fast"));
339 case PARROT_SWITCH_CORE
:
340 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "switch"));
342 case PARROT_CGP_CORE
:
343 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "cgp"));
345 case PARROT_CGOTO_CORE
:
346 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "cgoto"));
348 case PARROT_EXEC_CORE
:
349 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "exec"));
351 case PARROT_GC_DEBUG_CORE
:
352 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "gc_debug"));
354 case PARROT_DEBUGGER_CORE
:
355 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "debugger"));
357 case PARROT_PROFILING_CORE
:
358 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "profiling"));
361 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_UNIMPLEMENTED
,
362 "Invalid runcore requested\n");
369 =item C<void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)>
371 Activates the given warnings.
379 Parrot_setwarnings(PARROT_INTERP
, Parrot_warnclass wc
)
381 /* Activates the given warnings. (Macro from warnings.h.) */
382 PARROT_WARNINGS_on(interp
, wc
);
388 =item C<PackFile * Parrot_pbc_read(PARROT_INTERP, const char *fullname, const
391 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
398 PARROT_CAN_RETURN_NULL
400 Parrot_pbc_read(PARROT_INTERP
, ARGIN_NULLOK(const char *fullname
), const int debug
)
405 INTVAL is_mapped
= 0;
408 #ifdef PARROT_HAS_HEADER_SYSMMAN
412 if (!fullname
|| STREQ(fullname
, "-")) {
413 /* read from STDIN */
416 /* read 1k at a time */
420 STRING
* const fs
= string_make(interp
, fullname
, strlen(fullname
),
423 /* can't read a file that doesn't exist */
424 if (!Parrot_stat_info_intval(interp
, fs
, STAT_EXISTS
)) {
425 Parrot_io_eprintf(interp
, "Parrot VM: Can't stat %s, code %i.\n",
430 /* we may need to relax this if we want to read bytecode from pipes */
431 if (!Parrot_stat_info_intval(interp
, fs
, STAT_ISREG
)) {
432 Parrot_io_eprintf(interp
,
433 "Parrot VM: '%s', is not a regular file %i.\n",
438 program_size
= Parrot_stat_info_intval(interp
, fs
, STAT_FILESIZE
);
440 #ifndef PARROT_HAS_HEADER_SYSMMAN
441 io
= fopen(fullname
, "rb");
444 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
448 #endif /* PARROT_HAS_HEADER_SYSMMAN */
451 #ifdef PARROT_HAS_HEADER_SYSMMAN
454 /* if we've opened a file (or stdin) with PIO, read it in */
457 size_t chunk_size
= program_size
> 0 ? program_size
: 1024;
458 INTVAL wanted
= program_size
;
461 program_code
= mem_gc_allocate_n_typed(interp
, chunk_size
, char);
462 cursor
= program_code
;
465 while ((read_result
= fread(cursor
, 1, chunk_size
, io
)) > 0) {
466 program_size
+= read_result
;
468 if (program_size
== wanted
)
472 program_code
= mem_gc_realloc_n_typed(interp
, program_code
,
473 program_size
+ chunk_size
, char);
476 Parrot_io_eprintf(interp
,
477 "Parrot VM: Could not reallocate buffer "
478 "while reading packfile from PIO.\n");
483 cursor
= (char *)(program_code
+ program_size
);
487 Parrot_io_eprintf(interp
,
488 "Parrot VM: Problem reading packfile from PIO: code %d.\n",
491 mem_gc_free(interp
, program_code
);
498 /* if we've gotten here, we opted not to use PIO to read the file.
501 #ifdef PARROT_HAS_HEADER_SYSMMAN
503 /* check that fullname isn't NULL, just in case */
505 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
506 "Trying to open a NULL filename");
508 fd
= open(fullname
, O_RDONLY
| O_BINARY
);
511 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
516 program_code
= (char *)mmap(0, (size_t)program_size
,
517 PROT_READ
, MAP_SHARED
, fd
, (off_t
)0);
519 if (program_code
== (void *)MAP_FAILED
) {
520 Parrot_warn(interp
, PARROT_WARNINGS_IO_FLAG
,
521 "Parrot VM: Can't mmap file %s, code %i.\n",
524 /* try again, now with IO reading the file */
525 io
= fopen(fullname
, "rb");
527 Parrot_io_eprintf(interp
,
528 "Parrot VM: Can't open %s, code %i.\n", fullname
, errno
);
536 #else /* PARROT_HAS_HEADER_SYSMMAN */
538 Parrot_io_eprintf(interp
, "Parrot VM: uncaught error occurred reading "
539 "file or mmap not available.\n");
542 #endif /* PARROT_HAS_HEADER_SYSMMAN */
546 /* Now that we have the bytecode, let's unpack it. */
548 pf
= PackFile_new(interp
, is_mapped
);
550 /* Make the cmdline option available to the unpackers */
553 if (!PackFile_unpack(interp
, pf
, (opcode_t
*)program_code
,
554 (size_t)program_size
)) {
555 Parrot_io_eprintf(interp
, "Parrot VM: Can't unpack packfile %s.\n",
560 /* Set :main routine */
561 if (!(pf
->options
& PFOPT_HEADERONLY
))
562 do_sub_pragmas(interp
, pf
->cur_cs
, PBC_PBC
, NULL
);
564 /* Prederefing the sub/the bytecode is done in switch_to_cs before
565 * actual usage of the segment */
567 #ifdef PARROT_HAS_HEADER_SYSMMAN
568 /* the man page states that it's ok to close a mmaped file */
579 =item C<void Parrot_pbc_load(PARROT_INTERP, PackFile *pf)>
581 Loads the C<PackFile> returned by C<Parrot_pbc_read()>.
589 Parrot_pbc_load(PARROT_INTERP
, ARGIN(PackFile
*pf
))
592 Parrot_io_eprintf(interp
, "Invalid packfile\n");
596 interp
->initial_pf
= pf
;
597 interp
->code
= pf
->cur_cs
;
603 =item C<void Parrot_pbc_fixup_loaded(PARROT_INTERP)>
605 Fixups after pbc loading
613 Parrot_pbc_fixup_loaded(PARROT_INTERP
)
615 PackFile_fixup_subs(interp
, PBC_LOADED
, NULL
);
621 =item C<static PMC* setup_argv(PARROT_INTERP, int argc, const char **argv)>
623 Creates and returns C<ARGS> array PMC.
629 PARROT_CANNOT_RETURN_NULL
631 setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
633 ASSERT_ARGS(setup_argv
)
634 PMC
* const userargv
= Parrot_pmc_new(interp
, enum_class_ResizableStringArray
);
637 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
638 Parrot_io_eprintf(interp
,
639 "*** Parrot VM: Setting up ARGV array. Current argc: %d ***\n",
643 /* immediately anchor pmc to root set */
644 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
,
645 (INTVAL
)IGLOBALS_ARGV_LIST
, userargv
);
647 for (i
= 0; i
< argc
; i
++) {
648 /* Run through argv, adding everything to @ARGS. */
650 string_make(interp
, argv
[i
], strlen(argv
[i
]), "unicode",
653 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
))
654 Parrot_io_eprintf(interp
, "\t%vd: %s\n", i
, argv
[i
]);
656 VTABLE_push_string(interp
, userargv
, arg
);
665 =item C<static void print_debug(PARROT_INTERP, int status, void *p)>
674 print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
676 ASSERT_ARGS(print_debug
)
677 if (Interp_debug_TEST(interp
, PARROT_MEM_STAT_DEBUG_FLAG
)) {
678 /* Give souls brave enough to activate debugging an earful about GC. */
680 Parrot_io_eprintf(interp
, "*** Parrot VM: Dumping GC info ***\n");
688 =item C<static PMC* set_current_sub(PARROT_INTERP)>
690 Search the fixup table for a PMC matching the argument. On a match,
691 set up the appropriate context.
693 If no match, set up a dummy PMC entry. In either case, return a
700 PARROT_CANNOT_RETURN_NULL
702 set_current_sub(PARROT_INTERP
)
704 ASSERT_ARGS(set_current_sub
)
707 PackFile_ByteCode
* const cur_cs
= interp
->code
;
708 PackFile_FixupTable
* const ft
= cur_cs
->fixups
;
709 PackFile_ConstTable
* const ct
= cur_cs
->const_table
;
714 * Walk the fixup table. The first Sub-like entry should be our
715 * entry point with the address at our resume_offset.
718 for (i
= 0; i
< ft
->fixup_count
; i
++) {
719 if (ft
->fixups
[i
]->type
== enum_fixup_sub
) {
720 const opcode_t ci
= ft
->fixups
[i
]->offset
;
721 PMC
* const sub_pmc
= ct
->constants
[ci
]->u
.key
;
722 Parrot_Sub_attributes
*sub
;
724 PMC_get_sub(interp
, sub_pmc
, sub
);
725 if (sub
->seg
== cur_cs
) {
726 const size_t offs
= sub
->start_offs
;
728 if (offs
== interp
->resume_offset
) {
729 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), sub_pmc
);
730 Parrot_pcc_set_HLL(interp
, CURRENT_CONTEXT(interp
), sub
->HLL_id
);
739 /* If we didn't find anything, put a dummy PMC into current_sub.
740 The default values set by SUb.init are appropiate for the
741 dummy, don't need additional settings. */
742 new_sub_pmc
= Parrot_pmc_new(interp
, enum_class_Sub
);
743 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), new_sub_pmc
);
751 =item C<void Parrot_runcode(PARROT_INTERP, int argc, const char **argv)>
753 Sets up C<ARGV> and runs the ops.
761 Parrot_runcode(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
763 PMC
*userargv
, *main_sub
;
765 /* Debugging mode nonsense. */
766 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
767 if (Interp_flags_TEST(interp
, PARROT_BOUNDS_FLAG
)) {
768 Parrot_io_eprintf(interp
,
769 "*** Parrot VM: Bounds checking enabled. ***\n");
772 if (Interp_trace_TEST(interp
, PARROT_TRACE_OPS_FLAG
))
773 Parrot_io_eprintf(interp
, "*** Parrot VM: Tracing enabled. ***\n");
775 Parrot_io_eprintf(interp
, "*** Parrot VM: %Ss core ***\n",
776 interp
->run_core
->name
);
779 /* Set up @ARGS (or whatever this language calls it) in userargv. */
780 userargv
= setup_argv(interp
, argc
, argv
);
783 * If any profile information was gathered, print it out
784 * before exiting, then print debug infos if turned on.
786 Parrot_on_exit(interp
, print_debug
, NULL
);
788 /* Let's kick the tires and light the fires--call interpreter.c:runops. */
789 main_sub
= Parrot_pcc_get_sub(interp
, CURRENT_CONTEXT(interp
));
791 /* if no sub was marked being :main, we create a dummy sub with offset 0 */
794 main_sub
= set_current_sub(interp
);
796 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), NULL
);
797 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
799 Parrot_pcc_invoke_sub_from_c_args(interp
, main_sub
, "P->", userargv
);
805 =item C<opcode_t * Parrot_debug(PARROT_INTERP, Parrot_Interp debugger, opcode_t
808 Runs the interpreter's bytecode in debugging mode.
815 PARROT_CAN_RETURN_NULL
817 Parrot_debug(PARROT_INTERP
, ARGIN(Parrot_Interp debugger
), ARGIN(opcode_t
*pc
))
819 PDB_t
* const pdb
= debugger
->pdb
;
821 pdb
->cur_opcode
= pc
;
823 PDB_init(debugger
, NULL
);
825 /* disassemble needs this for now */
827 interp = pdb->debugee;
830 debugger
->lo_var_ptr
= interp
->lo_var_ptr
;
832 PDB_disassemble(interp
, NULL
);
834 while (!(pdb
->state
& PDB_EXIT
)) {
837 PDB_get_command(debugger
);
838 command
= pdb
->cur_command
;
839 PDB_run_command(debugger
, command
);
848 =item C<static void print_constant_table(PARROT_INTERP, PMC *output)>
850 Prints the contents of the constants table.
856 print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
858 ASSERT_ARGS(print_constant_table
)
859 const INTVAL numconstants
= interp
->code
->const_table
->const_count
;
862 /* TODO: would be nice to print the name of the file as well */
863 Parrot_io_fprintf(interp
, output
, "=head1 Constant-table\n\n");
865 for (i
= 0; i
< numconstants
; ++i
) {
866 const PackFile_Constant
* const c
= interp
->code
->const_table
->constants
[i
];
870 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %f\n", i
, c
->u
.number
);
873 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %S\n", i
, c
->u
.string
);
876 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
878 /* Parrot_print_p(interp, c->u.key); */
879 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
880 Parrot_io_fprintf(interp
, output
, "\n");
884 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
886 switch (c
->u
.key
->vtable
->base_type
) {
887 /* each PBC file has a ParrotInterpreter, but it can't
888 * stringify by itself */
889 case enum_class_ParrotInterpreter
:
890 Parrot_io_fprintf(interp
, output
, "'ParrotInterpreter'");
893 /* FixedIntegerArrays used for signatures, handy to print */
894 case enum_class_FixedIntegerArray
:
896 const INTVAL n
= VTABLE_elements(interp
, c
->u
.key
);
898 Parrot_io_fprintf(interp
, output
, "[");
900 for (j
= 0; j
< n
; ++j
) {
901 const INTVAL val
= VTABLE_get_integer_keyed_int(interp
, c
->u
.key
, j
);
902 Parrot_io_fprintf(interp
, output
, "%d", val
);
904 Parrot_io_fprintf(interp
, output
, ",");
906 Parrot_io_fprintf(interp
, output
, "]");
909 case enum_class_NameSpace
:
910 case enum_class_String
:
912 case enum_class_ResizableStringArray
:
914 /*Parrot_print_p(interp, c->u.key);*/
915 STRING
* const s
= VTABLE_get_string(interp
, c
->u
.key
);
917 Parrot_io_fprintf(interp
, output
, "%Ss", s
);
921 Parrot_io_fprintf(interp
, output
, "%S", VTABLE_get_string(interp
, c
->u
.key
));
924 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
928 Parrot_io_fprintf(interp
, output
, "\n");
932 Parrot_io_fprintf(interp
, output
, "wrong constant type in constant table!\n");
933 /* XXX throw an exception? Is it worth the trouble? */
938 Parrot_io_fprintf(interp
, output
, "\n=cut\n\n");
944 =item C<void Parrot_disassemble(PARROT_INTERP, const char *outfile,
945 Parrot_disassemble_options options)>
947 Disassembles and prints out the interpreter's bytecode.
949 This is used by the Parrot disassembler.
957 Parrot_disassemble(PARROT_INTERP
, ARGIN(const char *outfile
), Parrot_disassemble_options options
)
960 PDB_t
* const pdb
= mem_gc_allocate_typed(interp
, PDB_t
);
961 int num_mappings
= 0;
962 int curr_mapping
= 0;
963 int op_code_seq_num
= 0;
967 if (outfile
!= NULL
) {
968 output
= Parrot_io_open(interp
, PMCNULL
,
969 Parrot_str_new(interp
, outfile
, 0),
970 Parrot_str_new_constant(interp
, "tw"));
973 output
= Parrot_io_stdhandle(interp
, PIO_STDOUT_FILENO
, PMCNULL
);
976 pdb
->cur_opcode
= interp
->code
->base
.data
;
978 PDB_disassemble(interp
, NULL
);
980 line
= pdb
->file
->line
;
981 debugs
= (interp
->code
->debugs
!= NULL
);
983 print_constant_table(interp
, output
);
984 if (options
& enum_DIS_HEADER
)
987 if (!(options
& enum_DIS_BARE
))
988 Parrot_io_fprintf(interp
, output
, "# %12s-%12s", "Seq_Op_Num", "Relative-PC");
991 if (!(options
& enum_DIS_BARE
))
992 Parrot_io_fprintf(interp
, output
, " %6s:\n", "SrcLn#");
993 num_mappings
= interp
->code
->debugs
->num_mappings
;
996 Parrot_io_fprintf(interp
, output
, "\n");
1002 /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping,
1003 * num_mappings, op_code_seq_num,
1004 * interp->code->debugs->mappings[curr_mapping]->offset); */
1006 if (debugs
&& curr_mapping
< num_mappings
) {
1007 if (op_code_seq_num
== interp
->code
->debugs
->mappings
[curr_mapping
]->offset
) {
1008 const int filename_const_offset
=
1009 interp
->code
->debugs
->mappings
[curr_mapping
]->filename
;
1010 Parrot_io_fprintf(interp
, output
, "# Current Source Filename '%Ss'\n",
1011 interp
->code
->const_table
->constants
[filename_const_offset
]->u
.string
);
1016 if (!(options
& enum_DIS_BARE
))
1017 Parrot_io_fprintf(interp
, output
, "%012i-%012i",
1018 op_code_seq_num
, line
->opcode
- interp
->code
->base
.data
);
1020 if (debugs
&& !(options
& enum_DIS_BARE
))
1021 Parrot_io_fprintf(interp
, output
, " %06i: ",
1022 interp
->code
->debugs
->base
.data
[op_code_seq_num
]);
1024 /* If it has a label print it */
1026 Parrot_io_fprintf(interp
, output
, "L%li:\t", line
->label
->number
);
1028 Parrot_io_fprintf(interp
, output
, "\t");
1030 c
= pdb
->file
->source
+ line
->source_offset
;
1032 while (c
&& *c
!= '\n')
1033 Parrot_io_fprintf(interp
, output
, "%c", *(c
++));
1035 Parrot_io_fprintf(interp
, output
, "\n");
1039 if (outfile
!= NULL
)
1040 Parrot_io_close(interp
, output
);
1048 =item C<void Parrot_run_native(PARROT_INTERP, native_func_t func)>
1050 Runs the C function C<func> through the program C<[enternative, end]>. This
1051 ensures that the function runs with the same setup as in other run loops.
1053 This function is used in some of the source tests in F<t/src> which use
1054 the interpreter outside a runloop.
1062 Parrot_run_native(PARROT_INTERP
, native_func_t func
)
1064 PackFile
* const pf
= PackFile_new(interp
, 0);
1065 static opcode_t program_code
[2];
1067 program_code
[0] = interp
->op_lib
->op_code(interp
, "enternative", 0);
1068 program_code
[1] = 0; /* end */
1070 pf
->cur_cs
= (PackFile_ByteCode
*)
1071 (pf
->PackFuncs
[PF_BYTEC_SEG
].new_seg
)(interp
, pf
,
1072 Parrot_str_new_constant(interp
, "code"), 1);
1073 pf
->cur_cs
->base
.data
= program_code
;
1074 pf
->cur_cs
->base
.size
= 2;
1076 Parrot_pbc_load(interp
, pf
);
1080 if (interp
->code
&& interp
->code
->const_table
)
1081 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
1083 runops(interp
, interp
->resume_offset
);
1089 =item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
1090 const char *code, Parrot_String *error)>
1092 Compiles a code string.
1100 Parrot_compile_string(PARROT_INTERP
, Parrot_String type
,
1101 const char *code
, Parrot_String
*error
)
1103 /* For the benefit of embedders that do not load any pbc
1104 * before compiling a string */
1106 if (!interp
->initial_pf
) {
1107 /* SIDE EFFECT: PackFile_new_dummy sets interp->initial_pf */
1108 interp
->initial_pf
= PackFile_new_dummy(interp
,
1109 Parrot_str_new_constant(interp
, "compile_string"));
1110 /* Assumption: there is no valid reason to fail to create it.
1111 * If the assumption changes, replace the assertion with a
1113 PARROT_ASSERT(interp
->initial_pf
);
1116 if (Parrot_str_compare(interp
, Parrot_str_new(interp
, "PIR", 3), type
) == 0)
1117 return IMCC_compile_pir_s(interp
, code
, error
);
1119 if (Parrot_str_compare(interp
, Parrot_str_new(interp
, "PASM", 4), type
) == 0)
1120 return IMCC_compile_pasm_s(interp
, code
, error
);
1122 *error
= Parrot_str_new(interp
, "Invalid interpreter type", 0);
1133 F<include/parrot/embed.h> and F<docs/embed.pod>.
1141 * c-file-style: "parrot"
1143 * vim: expandtab shiftwidth=4: