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/extend.h"
24 #include "parrot/oplib/ops.h"
25 #include "pmc/pmc_sub.h"
26 #include "pmc/pmc_callcontext.h"
27 #include "parrot/runcore_api.h"
28 #include "parrot/oplib/core_ops.h"
30 #include "../compilers/imcc/imc.h"
34 /* HEADERIZER HFILE: include/parrot/embed.h */
36 /* HEADERIZER BEGIN: static */
37 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
39 static void print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
40 __attribute__nonnull__(1)
41 __attribute__nonnull__(2);
43 static void print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
44 __attribute__nonnull__(1);
46 PARROT_CANNOT_RETURN_NULL
47 static PMC
* set_current_sub(PARROT_INTERP
)
48 __attribute__nonnull__(1);
50 PARROT_CANNOT_RETURN_NULL
51 static PMC
* setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
52 __attribute__nonnull__(1)
53 __attribute__nonnull__(3);
55 #define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
56 PARROT_ASSERT_ARG(interp) \
57 , PARROT_ASSERT_ARG(output))
58 #define ASSERT_ARGS_print_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
59 PARROT_ASSERT_ARG(interp))
60 #define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
61 PARROT_ASSERT_ARG(interp))
62 #define ASSERT_ARGS_setup_argv __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
63 PARROT_ASSERT_ARG(interp) \
64 , PARROT_ASSERT_ARG(argv))
65 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
66 /* HEADERIZER END: static */
68 extern int Parrot_exec_run
;
72 =item C<Parrot_Interp Parrot_new(Parrot_Interp parent)>
74 Returns a new Parrot interpreter.
76 The first created interpreter (C<parent> is C<NULL>) is the last one
84 PARROT_CANNOT_RETURN_NULL
87 Parrot_new(ARGIN_NULLOK(Parrot_Interp parent
))
89 ASSERT_ARGS(Parrot_new
)
90 /* inter_create.c:make_interpreter builds a new Parrot_Interp. */
91 return make_interpreter(parent
, PARROT_NO_FLAGS
);
97 =item C<void Parrot_init_stacktop(PARROT_INTERP, void *stack_top)>
99 Initializes the new interpreter when it hasn't been initialized before.
101 Additionally sets the stack top, so that Parrot objects created
102 in inner stack frames will be visible during GC stack walking code.
103 B<stack_top> should be the address of an automatic variable in the caller's
104 stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
105 frames so that they are not destroyed during GC runs.
107 Use this function when you call into Parrot before entering a run loop.
115 Parrot_init_stacktop(PARROT_INTERP
, ARGIN(void *stack_top
))
117 ASSERT_ARGS(Parrot_init_stacktop
)
118 interp
->lo_var_ptr
= stack_top
;
119 init_world_once(interp
);
125 =item C<void Parrot_set_flag(PARROT_INTERP, Parrot_Int flag)>
127 Sets on any of the following flags, specified by C<flag>, in the interpreter:
130 C<PARROT_BOUNDS_FLAG> enable bounds checking
131 C<PARROT_PROFILE_FLAG> enable profiling,
139 Parrot_set_flag(PARROT_INTERP
, Parrot_Int flag
)
141 ASSERT_ARGS(Parrot_set_flag
)
142 /* These two macros (from interpreter.h) do exactly what they look like. */
144 Interp_flags_SET(interp
, flag
);
146 case PARROT_BOUNDS_FLAG
:
147 case PARROT_PROFILE_FLAG
:
148 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
158 =item C<void Parrot_set_debug(PARROT_INTERP, Parrot_UInt flag)>
160 Set a debug flag: C<PARROT_DEBUG_FLAG>.
168 Parrot_set_debug(PARROT_INTERP
, Parrot_UInt flag
)
170 ASSERT_ARGS(Parrot_set_debug
)
171 interp
->debug_flags
|= flag
;
177 =item C<void Parrot_set_executable_name(PARROT_INTERP, Parrot_String name)>
179 Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
188 Parrot_set_executable_name(PARROT_INTERP
, Parrot_String name
)
190 ASSERT_ARGS(Parrot_set_executable_name
)
191 PMC
* const name_pmc
= Parrot_pmc_new(interp
, enum_class_String
);
192 VTABLE_set_string_native(interp
, name_pmc
, name
);
193 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
, IGLOBALS_EXECUTABLE
,
200 =item C<void Parrot_set_trace(PARROT_INTERP, Parrot_UInt flag)>
202 Set a trace flag: C<PARROT_TRACE_FLAG>
210 Parrot_set_trace(PARROT_INTERP
, Parrot_UInt flag
)
212 ASSERT_ARGS(Parrot_set_trace
)
213 Parrot_pcc_trace_flags_on(interp
, interp
->ctx
, flag
);
214 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
220 =item C<void Parrot_clear_flag(PARROT_INTERP, Parrot_Int flag)>
222 Clears a flag in the interpreter.
230 Parrot_clear_flag(PARROT_INTERP
, Parrot_Int flag
)
232 ASSERT_ARGS(Parrot_clear_flag
)
233 Interp_flags_CLEAR(interp
, flag
);
239 =item C<void Parrot_clear_debug(PARROT_INTERP, Parrot_UInt flag)>
241 Clears a flag in the interpreter.
249 Parrot_clear_debug(PARROT_INTERP
, Parrot_UInt flag
)
251 ASSERT_ARGS(Parrot_clear_debug
)
252 interp
->debug_flags
&= ~flag
;
258 =item C<void Parrot_clear_trace(PARROT_INTERP, Parrot_UInt flag)>
260 Clears a flag in the interpreter.
268 Parrot_clear_trace(PARROT_INTERP
, Parrot_UInt flag
)
270 ASSERT_ARGS(Parrot_clear_trace
)
271 Parrot_pcc_trace_flags_off(interp
, interp
->ctx
, flag
);
277 =item C<Parrot_Int Parrot_test_flag(PARROT_INTERP, Parrot_Int flag)>
279 Test the interpreter flags specified in C<flag>.
288 Parrot_test_flag(PARROT_INTERP
, Parrot_Int flag
)
290 ASSERT_ARGS(Parrot_test_flag
)
291 return Interp_flags_TEST(interp
, flag
);
297 =item C<Parrot_UInt Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)>
299 Test the interpreter flags specified in C<flag>.
308 Parrot_test_debug(PARROT_INTERP
, Parrot_UInt flag
)
310 ASSERT_ARGS(Parrot_test_debug
)
311 return interp
->debug_flags
& flag
;
317 =item C<Parrot_UInt Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)>
319 Test the interpreter flags specified in C<flag>.
328 Parrot_test_trace(PARROT_INTERP
, Parrot_UInt flag
)
330 ASSERT_ARGS(Parrot_test_trace
)
331 return Parrot_pcc_trace_flags_test(interp
, interp
->ctx
, flag
);
337 =item C<void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
339 Sets the specified run core.
347 Parrot_set_run_core(PARROT_INTERP
, Parrot_Run_core_t core
)
349 ASSERT_ARGS(Parrot_set_run_core
)
351 case PARROT_SLOW_CORE
:
352 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
354 case PARROT_FAST_CORE
:
355 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "fast"));
357 case PARROT_EXEC_CORE
:
358 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "exec"));
360 case PARROT_GC_DEBUG_CORE
:
361 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "gc_debug"));
363 case PARROT_DEBUGGER_CORE
:
364 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "debugger"));
366 case PARROT_PROFILING_CORE
:
367 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "profiling"));
370 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_UNIMPLEMENTED
,
371 "Invalid runcore requested\n");
378 =item C<void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)>
380 Activates the given warnings.
388 Parrot_setwarnings(PARROT_INTERP
, Parrot_warnclass wc
)
390 ASSERT_ARGS(Parrot_setwarnings
)
391 /* Activates the given warnings. (Macro from warnings.h.) */
392 PARROT_WARNINGS_on(interp
, wc
);
398 =item C<Parrot_PackFile Parrot_pbc_read(PARROT_INTERP, const char *fullname,
401 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
408 PARROT_CAN_RETURN_NULL
410 Parrot_pbc_read(PARROT_INTERP
, ARGIN_NULLOK(const char *fullname
), const int debug
)
412 ASSERT_ARGS(Parrot_pbc_read
)
416 INTVAL is_mapped
= 0;
419 #ifdef PARROT_HAS_HEADER_SYSMMAN
423 if (!fullname
|| STREQ(fullname
, "-")) {
424 /* read from STDIN */
427 /* read 1k at a time */
431 STRING
* const fs
= Parrot_str_new_init(interp
, fullname
, strlen(fullname
),
432 Parrot_default_encoding_ptr
, 0);
434 /* can't read a file that doesn't exist */
435 if (!Parrot_stat_info_intval(interp
, fs
, STAT_EXISTS
)) {
436 Parrot_io_eprintf(interp
, "Parrot VM: Can't stat %s, code %i.\n",
441 /* we may need to relax this if we want to read bytecode from pipes */
442 if (!Parrot_stat_info_intval(interp
, fs
, STAT_ISREG
)) {
443 Parrot_io_eprintf(interp
,
444 "Parrot VM: '%s', is not a regular file %i.\n",
449 program_size
= Parrot_stat_info_intval(interp
, fs
, STAT_FILESIZE
);
451 #ifndef PARROT_HAS_HEADER_SYSMMAN
452 io
= fopen(fullname
, "rb");
455 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
459 #endif /* PARROT_HAS_HEADER_SYSMMAN */
462 #ifdef PARROT_HAS_HEADER_SYSMMAN
465 /* if we've opened a file (or stdin) with PIO, read it in */
468 size_t chunk_size
= program_size
> 0 ? program_size
: 1024;
469 INTVAL wanted
= program_size
;
472 program_code
= mem_gc_allocate_n_typed(interp
, chunk_size
, char);
473 cursor
= program_code
;
476 while ((read_result
= fread(cursor
, 1, chunk_size
, io
)) > 0) {
477 program_size
+= read_result
;
479 if (program_size
== wanted
)
483 program_code
= mem_gc_realloc_n_typed(interp
, program_code
,
484 program_size
+ chunk_size
, char);
487 Parrot_io_eprintf(interp
,
488 "Parrot VM: Could not reallocate buffer "
489 "while reading packfile from PIO.\n");
494 cursor
= (char *)(program_code
+ program_size
);
498 Parrot_io_eprintf(interp
,
499 "Parrot VM: Problem reading packfile from PIO: code %d.\n",
502 mem_gc_free(interp
, program_code
);
509 /* if we've gotten here, we opted not to use PIO to read the file.
512 #ifdef PARROT_HAS_HEADER_SYSMMAN
514 /* check that fullname isn't NULL, just in case */
516 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
517 "Trying to open a NULL filename");
519 fd
= open(fullname
, O_RDONLY
| O_BINARY
);
522 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
527 program_code
= (char *)mmap(0, (size_t)program_size
,
528 PROT_READ
, MAP_SHARED
, fd
, (off_t
)0);
530 if (program_code
== (void *)MAP_FAILED
) {
531 Parrot_warn(interp
, PARROT_WARNINGS_IO_FLAG
,
532 "Parrot VM: Can't mmap file %s, code %i.\n",
535 /* try again, now with IO reading the file */
536 io
= fopen(fullname
, "rb");
538 Parrot_io_eprintf(interp
,
539 "Parrot VM: Can't open %s, code %i.\n", fullname
, errno
);
547 #else /* PARROT_HAS_HEADER_SYSMMAN */
549 Parrot_io_eprintf(interp
, "Parrot VM: uncaught error occurred reading "
550 "file or mmap not available.\n");
553 #endif /* PARROT_HAS_HEADER_SYSMMAN */
557 /* Now that we have the bytecode, let's unpack it. */
559 pf
= PackFile_new(interp
, is_mapped
);
561 /* Make the cmdline option available to the unpackers */
564 if (!PackFile_unpack(interp
, pf
, (opcode_t
*)program_code
,
565 (size_t)program_size
)) {
566 Parrot_io_eprintf(interp
, "Parrot VM: Can't unpack packfile %s.\n",
571 /* Set :main routine */
572 if (!(pf
->options
& PFOPT_HEADERONLY
))
573 do_sub_pragmas(interp
, pf
->cur_cs
, PBC_PBC
, NULL
);
575 /* Prederefing the sub/the bytecode is done in switch_to_cs before
576 * actual usage of the segment */
578 #ifdef PARROT_HAS_HEADER_SYSMMAN
579 /* the man page states that it's ok to close a mmaped file */
590 =item C<void Parrot_pbc_load(PARROT_INTERP, Parrot_PackFile pf)>
592 Loads the C<PackFile> returned by C<Parrot_pbc_read()>.
600 Parrot_pbc_load(PARROT_INTERP
, ARGIN(Parrot_PackFile pf
))
602 ASSERT_ARGS(Parrot_pbc_load
)
604 Parrot_io_eprintf(interp
, "Invalid packfile\n");
608 interp
->initial_pf
= pf
;
609 interp
->code
= pf
->cur_cs
;
615 =item C<void Parrot_pbc_fixup_loaded(PARROT_INTERP)>
617 Fixups after pbc loading
625 Parrot_pbc_fixup_loaded(PARROT_INTERP
)
627 ASSERT_ARGS(Parrot_pbc_fixup_loaded
)
628 PackFile_fixup_subs(interp
, PBC_LOADED
, NULL
);
634 =item C<static PMC* setup_argv(PARROT_INTERP, int argc, const char **argv)>
636 Creates and returns C<ARGS> array PMC.
642 PARROT_CANNOT_RETURN_NULL
644 setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
646 ASSERT_ARGS(setup_argv
)
647 PMC
* const userargv
= Parrot_pmc_new(interp
, enum_class_ResizableStringArray
);
650 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
651 Parrot_io_eprintf(interp
,
652 "*** Parrot VM: Setting up ARGV array. Current argc: %d ***\n",
656 /* immediately anchor pmc to root set */
657 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
,
658 (INTVAL
)IGLOBALS_ARGV_LIST
, userargv
);
660 for (i
= 0; i
< argc
; ++i
) {
661 /* Run through argv, adding everything to @ARGS. */
662 STRING
* const arg
= Parrot_str_new_init(interp
, argv
[i
], strlen(argv
[i
]),
663 Parrot_utf8_encoding_ptr
, PObj_external_FLAG
);
665 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
))
666 Parrot_io_eprintf(interp
, "\t%vd: %s\n", i
, argv
[i
]);
668 VTABLE_push_string(interp
, userargv
, arg
);
677 =item C<static void print_debug(PARROT_INTERP, int status, void *p)>
686 print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
688 ASSERT_ARGS(print_debug
)
689 if (Interp_debug_TEST(interp
, PARROT_MEM_STAT_DEBUG_FLAG
)) {
690 /* Give souls brave enough to activate debugging an earful about GC. */
692 Parrot_io_eprintf(interp
, "*** Parrot VM: Dumping GC info ***\n");
700 =item C<static PMC* set_current_sub(PARROT_INTERP)>
702 Search the fixup table for a PMC matching the argument. On a match,
703 set up the appropriate context.
705 If no match, set up a dummy PMC entry. In either case, return a
712 PARROT_CANNOT_RETURN_NULL
714 set_current_sub(PARROT_INTERP
)
716 ASSERT_ARGS(set_current_sub
)
719 PackFile_ByteCode
* const cur_cs
= interp
->code
;
720 PackFile_FixupTable
* const ft
= cur_cs
->fixups
;
721 PackFile_ConstTable
* const ct
= cur_cs
->const_table
;
726 * Walk the fixup table. The first Sub-like entry should be our
727 * entry point with the address at our resume_offset.
730 for (i
= 0; i
< ft
->fixup_count
; ++i
) {
731 if (ft
->fixups
[i
].type
== enum_fixup_sub
) {
732 const opcode_t ci
= ft
->fixups
[i
].offset
;
733 PMC
* const sub_pmc
= ct
->constants
[ci
].u
.key
;
734 Parrot_Sub_attributes
*sub
;
736 PMC_get_sub(interp
, sub_pmc
, sub
);
737 if (sub
->seg
== cur_cs
) {
738 const size_t offs
= sub
->start_offs
;
740 if (offs
== interp
->resume_offset
) {
741 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), sub_pmc
);
742 Parrot_pcc_set_HLL(interp
, CURRENT_CONTEXT(interp
), sub
->HLL_id
);
751 /* If we didn't find anything, put a dummy PMC into current_sub.
752 The default values set by SUb.init are appropiate for the
753 dummy, don't need additional settings. */
754 new_sub_pmc
= Parrot_pmc_new(interp
, enum_class_Sub
);
755 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), new_sub_pmc
);
763 =item C<void Parrot_runcode(PARROT_INTERP, int argc, const char **argv)>
765 Sets up C<ARGV> and runs the ops.
773 Parrot_runcode(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
775 ASSERT_ARGS(Parrot_runcode
)
776 PMC
*userargv
, *main_sub
;
778 /* Debugging mode nonsense. */
779 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
780 if (Interp_flags_TEST(interp
, PARROT_BOUNDS_FLAG
)) {
781 Parrot_io_eprintf(interp
,
782 "*** Parrot VM: Bounds checking enabled. ***\n");
785 if (Interp_trace_TEST(interp
, PARROT_TRACE_OPS_FLAG
))
786 Parrot_io_eprintf(interp
, "*** Parrot VM: Tracing enabled. ***\n");
788 Parrot_io_eprintf(interp
, "*** Parrot VM: %Ss core ***\n",
789 interp
->run_core
->name
);
792 /* Set up @ARGS (or whatever this language calls it) in userargv. */
793 userargv
= setup_argv(interp
, argc
, argv
);
796 * If any profile information was gathered, print it out
797 * before exiting, then print debug infos if turned on.
799 Parrot_on_exit(interp
, print_debug
, NULL
);
801 /* Let's kick the tires and light the fires--call interpreter.c:runops. */
802 main_sub
= Parrot_pcc_get_sub(interp
, CURRENT_CONTEXT(interp
));
804 /* if no sub was marked being :main, we create a dummy sub with offset 0 */
807 main_sub
= set_current_sub(interp
);
809 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), NULL
);
810 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
812 Parrot_ext_call(interp
, main_sub
, "P->", userargv
);
818 =item C<Parrot_Opcode * Parrot_debug(PARROT_INTERP, Parrot_Interp debugger,
821 Runs the interpreter's bytecode in debugging mode.
828 PARROT_CAN_RETURN_NULL
830 Parrot_debug(PARROT_INTERP
, ARGIN(Parrot_Interp debugger
), ARGIN(Parrot_Opcode
*pc
))
832 ASSERT_ARGS(Parrot_debug
)
833 PDB_t
* const pdb
= debugger
->pdb
;
835 pdb
->cur_opcode
= pc
;
837 PDB_init(debugger
, NULL
);
839 /* disassemble needs this for now */
841 interp = pdb->debugee;
844 debugger
->lo_var_ptr
= interp
->lo_var_ptr
;
846 PDB_disassemble(interp
, NULL
);
848 while (!(pdb
->state
& PDB_EXIT
)) {
851 PDB_get_command(debugger
);
852 command
= pdb
->cur_command
;
853 PDB_run_command(debugger
, command
);
862 =item C<static void print_constant_table(PARROT_INTERP, PMC *output)>
864 Prints the contents of the constants table.
870 print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
872 ASSERT_ARGS(print_constant_table
)
873 const INTVAL numconstants
= interp
->code
->const_table
->const_count
;
876 /* TODO: would be nice to print the name of the file as well */
877 Parrot_io_fprintf(interp
, output
, "=head1 Constant-table\n\n");
879 for (i
= 0; i
< numconstants
; ++i
) {
880 const PackFile_Constant
* const c
= &interp
->code
->const_table
->constants
[i
];
884 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %f\n", i
, c
->u
.number
);
887 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %S\n", i
, c
->u
.string
);
890 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
892 /* Parrot_print_p(interp, c->u.key); */
893 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
894 Parrot_io_fprintf(interp
, output
, "\n");
898 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
900 switch (c
->u
.key
->vtable
->base_type
) {
901 /* each PBC file has a ParrotInterpreter, but it can't
902 * stringify by itself */
903 case enum_class_ParrotInterpreter
:
904 Parrot_io_fprintf(interp
, output
, "'ParrotInterpreter'");
907 /* FixedIntegerArrays used for signatures, handy to print */
908 case enum_class_FixedIntegerArray
:
910 const INTVAL n
= VTABLE_elements(interp
, c
->u
.key
);
912 Parrot_io_fprintf(interp
, output
, "[");
914 for (j
= 0; j
< n
; ++j
) {
915 const INTVAL val
= VTABLE_get_integer_keyed_int(interp
, c
->u
.key
, j
);
916 Parrot_io_fprintf(interp
, output
, "%d", val
);
918 Parrot_io_fprintf(interp
, output
, ",");
920 Parrot_io_fprintf(interp
, output
, "]");
923 case enum_class_NameSpace
:
924 case enum_class_String
:
926 case enum_class_ResizableStringArray
:
928 /*Parrot_print_p(interp, c->u.key);*/
929 STRING
* const s
= VTABLE_get_string(interp
, c
->u
.key
);
931 Parrot_io_fprintf(interp
, output
, "%Ss", s
);
935 Parrot_io_fprintf(interp
, output
, "%S", VTABLE_get_string(interp
, c
->u
.key
));
938 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
942 Parrot_io_fprintf(interp
, output
, "\n");
946 Parrot_io_fprintf(interp
, output
, "wrong constant type in constant table!\n");
947 /* XXX throw an exception? Is it worth the trouble? */
952 Parrot_io_fprintf(interp
, output
, "\n=cut\n\n");
958 =item C<void Parrot_disassemble(PARROT_INTERP, const char *outfile,
959 Parrot_disassemble_options options)>
961 Disassembles and prints out the interpreter's bytecode.
963 This is used by the Parrot disassembler.
971 Parrot_disassemble(PARROT_INTERP
,
972 ARGIN_NULLOK(const char *outfile
), Parrot_disassemble_options options
)
974 ASSERT_ARGS(Parrot_disassemble
)
976 PDB_t
* const pdb
= mem_gc_allocate_zeroed_typed(interp
, PDB_t
);
977 int num_mappings
= 0;
978 int curr_mapping
= 0;
979 int op_code_seq_num
= 0;
983 if (outfile
!= NULL
) {
984 output
= Parrot_io_open(interp
, PMCNULL
,
985 Parrot_str_new(interp
, outfile
, 0),
986 Parrot_str_new_constant(interp
, "tw"));
989 output
= Parrot_io_stdhandle(interp
, PIO_STDOUT_FILENO
, PMCNULL
);
992 pdb
->cur_opcode
= interp
->code
->base
.data
;
994 PDB_disassemble(interp
, NULL
);
996 line
= pdb
->file
->line
;
997 debugs
= (interp
->code
->debugs
!= NULL
);
999 print_constant_table(interp
, output
);
1000 if (options
& enum_DIS_HEADER
)
1003 if (!(options
& enum_DIS_BARE
))
1004 Parrot_io_fprintf(interp
, output
, "# %12s-%12s", "Seq_Op_Num", "Relative-PC");
1007 if (!(options
& enum_DIS_BARE
))
1008 Parrot_io_fprintf(interp
, output
, " %6s:\n", "SrcLn#");
1009 num_mappings
= interp
->code
->debugs
->num_mappings
;
1012 Parrot_io_fprintf(interp
, output
, "\n");
1015 while (line
->next
) {
1018 /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping,
1019 * num_mappings, op_code_seq_num,
1020 * interp->code->debugs->mappings[curr_mapping].offset); */
1022 if (debugs
&& curr_mapping
< num_mappings
) {
1023 if (op_code_seq_num
== interp
->code
->debugs
->mappings
[curr_mapping
].offset
) {
1024 const int filename_const_offset
=
1025 interp
->code
->debugs
->mappings
[curr_mapping
].filename
;
1026 Parrot_io_fprintf(interp
, output
, "# Current Source Filename '%Ss'\n",
1027 interp
->code
->const_table
->constants
[filename_const_offset
].u
.string
);
1032 if (!(options
& enum_DIS_BARE
))
1033 Parrot_io_fprintf(interp
, output
, "%012i-%012i",
1034 op_code_seq_num
, line
->opcode
- interp
->code
->base
.data
);
1036 if (debugs
&& !(options
& enum_DIS_BARE
))
1037 Parrot_io_fprintf(interp
, output
, " %06i: ",
1038 interp
->code
->debugs
->base
.data
[op_code_seq_num
]);
1040 /* If it has a label print it */
1042 Parrot_io_fprintf(interp
, output
, "L%li:\t", line
->label
->number
);
1044 Parrot_io_fprintf(interp
, output
, "\t");
1046 c
= pdb
->file
->source
+ line
->source_offset
;
1048 while (c
&& *c
!= '\n')
1049 Parrot_io_fprintf(interp
, output
, "%c", *(c
++));
1051 Parrot_io_fprintf(interp
, output
, "\n");
1055 if (outfile
!= NULL
)
1056 Parrot_io_close(interp
, output
);
1064 =item C<void Parrot_run_native(PARROT_INTERP, native_func_t func)>
1066 Runs the C function C<func> through the program C<[enternative, end]>. This
1067 ensures that the function runs with the same setup as in other run loops.
1069 This function is used in some of the source tests in F<t/src> which use
1070 the interpreter outside a runloop.
1078 Parrot_run_native(PARROT_INTERP
, native_func_t func
)
1080 ASSERT_ARGS(Parrot_run_native
)
1081 op_lib_t
*core_ops
= PARROT_GET_CORE_OPLIB(interp
);
1082 PackFile
* const pf
= PackFile_new(interp
, 0);
1083 static opcode_t program_code
[2] = {
1084 0, /* enternative */
1088 static op_func_t op_func_table
[2];
1089 op_func_table
[0] = core_ops
->op_func_table
[PARROT_OP_enternative
];
1090 op_func_table
[1] = core_ops
->op_func_table
[PARROT_OP_end
];
1093 pf
->cur_cs
= (PackFile_ByteCode
*)
1094 (pf
->PackFuncs
[PF_BYTEC_SEG
].new_seg
)(interp
, pf
,
1095 Parrot_str_new_constant(interp
, "code"), 1);
1096 pf
->cur_cs
->base
.data
= program_code
;
1097 pf
->cur_cs
->base
.size
= 2;
1098 pf
->cur_cs
->op_func_table
= op_func_table
;
1099 /* TODO fill out cur_cs with op_mapping */
1101 Parrot_pbc_load(interp
, pf
);
1105 if (interp
->code
&& interp
->code
->const_table
)
1106 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
1108 runops(interp
, interp
->resume_offset
);
1114 =item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
1115 const char *code, Parrot_String *error)>
1117 Compiles a code string.
1125 Parrot_compile_string(PARROT_INTERP
, Parrot_String type
, ARGIN(const char *code
),
1126 ARGOUT(Parrot_String
*error
))
1128 ASSERT_ARGS(Parrot_compile_string
)
1129 /* For the benefit of embedders that do not load any pbc
1130 * before compiling a string */
1132 if (!interp
->initial_pf
) {
1133 /* SIDE EFFECT: PackFile_new_dummy sets interp->initial_pf */
1134 interp
->initial_pf
= PackFile_new_dummy(interp
, CONST_STRING(interp
, "compile_string"));
1135 /* Assumption: there is no valid reason to fail to create it.
1136 * If the assumption changes, replace the assertion with a
1138 PARROT_ASSERT(interp
->initial_pf
);
1141 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PIR"), type
) == 0)
1142 return IMCC_compile_pir_s(interp
, code
, error
);
1144 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PASM"), type
) == 0)
1145 return IMCC_compile_pasm_s(interp
, code
, error
);
1147 *error
= Parrot_str_new(interp
, "Invalid interpreter type", 0);
1158 F<include/parrot/embed.h> and F<docs/embed.pod>.
1166 * c-file-style: "parrot"
1168 * vim: expandtab shiftwidth=4: