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>.
286 Parrot_test_flag(PARROT_INTERP
, Parrot_Int flag
)
288 ASSERT_ARGS(Parrot_test_flag
)
289 return Interp_flags_TEST(interp
, flag
);
295 =item C<Parrot_UInt Parrot_test_debug(PARROT_INTERP, Parrot_UInt flag)>
297 Test the interpreter flags specified in C<flag>.
306 Parrot_test_debug(PARROT_INTERP
, Parrot_UInt flag
)
308 ASSERT_ARGS(Parrot_test_debug
)
309 return interp
->debug_flags
& flag
;
315 =item C<Parrot_UInt Parrot_test_trace(PARROT_INTERP, Parrot_UInt flag)>
317 Test the interpreter flags specified in C<flag>.
326 Parrot_test_trace(PARROT_INTERP
, Parrot_UInt flag
)
328 ASSERT_ARGS(Parrot_test_trace
)
329 return Parrot_pcc_trace_flags_test(interp
, interp
->ctx
, flag
);
335 =item C<void Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
337 Sets the specified run core.
345 Parrot_set_run_core(PARROT_INTERP
, Parrot_Run_core_t core
)
347 ASSERT_ARGS(Parrot_set_run_core
)
349 case PARROT_SLOW_CORE
:
350 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "slow"));
352 case PARROT_FAST_CORE
:
353 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "fast"));
355 case PARROT_EXEC_CORE
:
356 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "exec"));
358 case PARROT_GC_DEBUG_CORE
:
359 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "gc_debug"));
361 case PARROT_DEBUGGER_CORE
:
362 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "debugger"));
364 case PARROT_PROFILING_CORE
:
365 Parrot_runcore_switch(interp
, Parrot_str_new_constant(interp
, "profiling"));
368 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_UNIMPLEMENTED
,
369 "Invalid runcore requested\n");
376 =item C<void Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)>
378 Activates the given warnings.
386 Parrot_setwarnings(PARROT_INTERP
, Parrot_warnclass wc
)
388 ASSERT_ARGS(Parrot_setwarnings
)
389 /* Activates the given warnings. (Macro from warnings.h.) */
390 PARROT_WARNINGS_on(interp
, wc
);
396 =item C<Parrot_PackFile Parrot_pbc_read(PARROT_INTERP, const char *fullname,
399 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
406 PARROT_CAN_RETURN_NULL
408 Parrot_pbc_read(PARROT_INTERP
, ARGIN_NULLOK(const char *fullname
), const int debug
)
410 ASSERT_ARGS(Parrot_pbc_read
)
414 INTVAL is_mapped
= 0;
417 #ifdef PARROT_HAS_HEADER_SYSMMAN
421 if (!fullname
|| STREQ(fullname
, "-")) {
422 /* read from STDIN */
425 /* read 1k at a time */
429 STRING
* const fs
= string_make(interp
, fullname
, strlen(fullname
),
432 /* can't read a file that doesn't exist */
433 if (!Parrot_stat_info_intval(interp
, fs
, STAT_EXISTS
)) {
434 Parrot_io_eprintf(interp
, "Parrot VM: Can't stat %s, code %i.\n",
439 /* we may need to relax this if we want to read bytecode from pipes */
440 if (!Parrot_stat_info_intval(interp
, fs
, STAT_ISREG
)) {
441 Parrot_io_eprintf(interp
,
442 "Parrot VM: '%s', is not a regular file %i.\n",
447 program_size
= Parrot_stat_info_intval(interp
, fs
, STAT_FILESIZE
);
449 #ifndef PARROT_HAS_HEADER_SYSMMAN
450 io
= fopen(fullname
, "rb");
453 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
457 #endif /* PARROT_HAS_HEADER_SYSMMAN */
460 #ifdef PARROT_HAS_HEADER_SYSMMAN
463 /* if we've opened a file (or stdin) with PIO, read it in */
466 size_t chunk_size
= program_size
> 0 ? program_size
: 1024;
467 INTVAL wanted
= program_size
;
470 program_code
= mem_gc_allocate_n_typed(interp
, chunk_size
, char);
471 cursor
= program_code
;
474 while ((read_result
= fread(cursor
, 1, chunk_size
, io
)) > 0) {
475 program_size
+= read_result
;
477 if (program_size
== wanted
)
481 program_code
= mem_gc_realloc_n_typed(interp
, program_code
,
482 program_size
+ chunk_size
, char);
485 Parrot_io_eprintf(interp
,
486 "Parrot VM: Could not reallocate buffer "
487 "while reading packfile from PIO.\n");
492 cursor
= (char *)(program_code
+ program_size
);
496 Parrot_io_eprintf(interp
,
497 "Parrot VM: Problem reading packfile from PIO: code %d.\n",
500 mem_gc_free(interp
, program_code
);
507 /* if we've gotten here, we opted not to use PIO to read the file.
510 #ifdef PARROT_HAS_HEADER_SYSMMAN
512 /* check that fullname isn't NULL, just in case */
514 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
515 "Trying to open a NULL filename");
517 fd
= open(fullname
, O_RDONLY
| O_BINARY
);
520 Parrot_io_eprintf(interp
, "Parrot VM: Can't open %s, code %i.\n",
525 program_code
= (char *)mmap(0, (size_t)program_size
,
526 PROT_READ
, MAP_SHARED
, fd
, (off_t
)0);
528 if (program_code
== (void *)MAP_FAILED
) {
529 Parrot_warn(interp
, PARROT_WARNINGS_IO_FLAG
,
530 "Parrot VM: Can't mmap file %s, code %i.\n",
533 /* try again, now with IO reading the file */
534 io
= fopen(fullname
, "rb");
536 Parrot_io_eprintf(interp
,
537 "Parrot VM: Can't open %s, code %i.\n", fullname
, errno
);
545 #else /* PARROT_HAS_HEADER_SYSMMAN */
547 Parrot_io_eprintf(interp
, "Parrot VM: uncaught error occurred reading "
548 "file or mmap not available.\n");
551 #endif /* PARROT_HAS_HEADER_SYSMMAN */
555 /* Now that we have the bytecode, let's unpack it. */
557 pf
= PackFile_new(interp
, is_mapped
);
559 /* Make the cmdline option available to the unpackers */
562 if (!PackFile_unpack(interp
, pf
, (opcode_t
*)program_code
,
563 (size_t)program_size
)) {
564 Parrot_io_eprintf(interp
, "Parrot VM: Can't unpack packfile %s.\n",
569 /* Set :main routine */
570 if (!(pf
->options
& PFOPT_HEADERONLY
))
571 do_sub_pragmas(interp
, pf
->cur_cs
, PBC_PBC
, NULL
);
573 /* Prederefing the sub/the bytecode is done in switch_to_cs before
574 * actual usage of the segment */
576 #ifdef PARROT_HAS_HEADER_SYSMMAN
577 /* the man page states that it's ok to close a mmaped file */
588 =item C<void Parrot_pbc_load(PARROT_INTERP, Parrot_PackFile pf)>
590 Loads the C<PackFile> returned by C<Parrot_pbc_read()>.
598 Parrot_pbc_load(PARROT_INTERP
, ARGIN(Parrot_PackFile pf
))
600 ASSERT_ARGS(Parrot_pbc_load
)
602 Parrot_io_eprintf(interp
, "Invalid packfile\n");
606 interp
->initial_pf
= pf
;
607 interp
->code
= pf
->cur_cs
;
613 =item C<void Parrot_pbc_fixup_loaded(PARROT_INTERP)>
615 Fixups after pbc loading
623 Parrot_pbc_fixup_loaded(PARROT_INTERP
)
625 ASSERT_ARGS(Parrot_pbc_fixup_loaded
)
626 PackFile_fixup_subs(interp
, PBC_LOADED
, NULL
);
632 =item C<static PMC* setup_argv(PARROT_INTERP, int argc, const char **argv)>
634 Creates and returns C<ARGS> array PMC.
640 PARROT_CANNOT_RETURN_NULL
642 setup_argv(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
644 ASSERT_ARGS(setup_argv
)
645 PMC
* const userargv
= Parrot_pmc_new(interp
, enum_class_ResizableStringArray
);
648 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
649 Parrot_io_eprintf(interp
,
650 "*** Parrot VM: Setting up ARGV array. Current argc: %d ***\n",
654 /* immediately anchor pmc to root set */
655 VTABLE_set_pmc_keyed_int(interp
, interp
->iglobals
,
656 (INTVAL
)IGLOBALS_ARGV_LIST
, userargv
);
658 for (i
= 0; i
< argc
; ++i
) {
659 /* Run through argv, adding everything to @ARGS. */
661 string_make(interp
, argv
[i
], strlen(argv
[i
]), "unicode",
664 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
))
665 Parrot_io_eprintf(interp
, "\t%vd: %s\n", i
, argv
[i
]);
667 VTABLE_push_string(interp
, userargv
, arg
);
676 =item C<static void print_debug(PARROT_INTERP, int status, void *p)>
685 print_debug(PARROT_INTERP
, SHIM(int status
), SHIM(void *p
))
687 ASSERT_ARGS(print_debug
)
688 if (Interp_debug_TEST(interp
, PARROT_MEM_STAT_DEBUG_FLAG
)) {
689 /* Give souls brave enough to activate debugging an earful about GC. */
691 Parrot_io_eprintf(interp
, "*** Parrot VM: Dumping GC info ***\n");
699 =item C<static PMC* set_current_sub(PARROT_INTERP)>
701 Search the fixup table for a PMC matching the argument. On a match,
702 set up the appropriate context.
704 If no match, set up a dummy PMC entry. In either case, return a
711 PARROT_CANNOT_RETURN_NULL
713 set_current_sub(PARROT_INTERP
)
715 ASSERT_ARGS(set_current_sub
)
718 PackFile_ByteCode
* const cur_cs
= interp
->code
;
719 PackFile_FixupTable
* const ft
= cur_cs
->fixups
;
720 PackFile_ConstTable
* const ct
= cur_cs
->const_table
;
725 * Walk the fixup table. The first Sub-like entry should be our
726 * entry point with the address at our resume_offset.
729 for (i
= 0; i
< ft
->fixup_count
; ++i
) {
730 if (ft
->fixups
[i
].type
== enum_fixup_sub
) {
731 const opcode_t ci
= ft
->fixups
[i
].offset
;
732 PMC
* const sub_pmc
= ct
->constants
[ci
]->u
.key
;
733 Parrot_Sub_attributes
*sub
;
735 PMC_get_sub(interp
, sub_pmc
, sub
);
736 if (sub
->seg
== cur_cs
) {
737 const size_t offs
= sub
->start_offs
;
739 if (offs
== interp
->resume_offset
) {
740 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), sub_pmc
);
741 Parrot_pcc_set_HLL(interp
, CURRENT_CONTEXT(interp
), sub
->HLL_id
);
750 /* If we didn't find anything, put a dummy PMC into current_sub.
751 The default values set by SUb.init are appropiate for the
752 dummy, don't need additional settings. */
753 new_sub_pmc
= Parrot_pmc_new(interp
, enum_class_Sub
);
754 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), new_sub_pmc
);
762 =item C<void Parrot_runcode(PARROT_INTERP, int argc, const char **argv)>
764 Sets up C<ARGV> and runs the ops.
772 Parrot_runcode(PARROT_INTERP
, int argc
, ARGIN(const char **argv
))
774 ASSERT_ARGS(Parrot_runcode
)
775 PMC
*userargv
, *main_sub
;
777 /* Debugging mode nonsense. */
778 if (Interp_debug_TEST(interp
, PARROT_START_DEBUG_FLAG
)) {
779 if (Interp_flags_TEST(interp
, PARROT_BOUNDS_FLAG
)) {
780 Parrot_io_eprintf(interp
,
781 "*** Parrot VM: Bounds checking enabled. ***\n");
784 if (Interp_trace_TEST(interp
, PARROT_TRACE_OPS_FLAG
))
785 Parrot_io_eprintf(interp
, "*** Parrot VM: Tracing enabled. ***\n");
787 Parrot_io_eprintf(interp
, "*** Parrot VM: %Ss core ***\n",
788 interp
->run_core
->name
);
791 /* Set up @ARGS (or whatever this language calls it) in userargv. */
792 userargv
= setup_argv(interp
, argc
, argv
);
795 * If any profile information was gathered, print it out
796 * before exiting, then print debug infos if turned on.
798 Parrot_on_exit(interp
, print_debug
, NULL
);
800 /* Let's kick the tires and light the fires--call interpreter.c:runops. */
801 main_sub
= Parrot_pcc_get_sub(interp
, CURRENT_CONTEXT(interp
));
803 /* if no sub was marked being :main, we create a dummy sub with offset 0 */
806 main_sub
= set_current_sub(interp
);
808 Parrot_pcc_set_sub(interp
, CURRENT_CONTEXT(interp
), NULL
);
809 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
811 Parrot_pcc_invoke_sub_from_c_args(interp
, main_sub
, "P->", userargv
);
817 =item C<Parrot_Opcode * Parrot_debug(PARROT_INTERP, Parrot_Interp debugger,
820 Runs the interpreter's bytecode in debugging mode.
827 PARROT_CAN_RETURN_NULL
829 Parrot_debug(PARROT_INTERP
, ARGIN(Parrot_Interp debugger
), ARGIN(Parrot_Opcode
*pc
))
831 ASSERT_ARGS(Parrot_debug
)
832 PDB_t
* const pdb
= debugger
->pdb
;
834 pdb
->cur_opcode
= pc
;
836 PDB_init(debugger
, NULL
);
838 /* disassemble needs this for now */
840 interp = pdb->debugee;
843 debugger
->lo_var_ptr
= interp
->lo_var_ptr
;
845 PDB_disassemble(interp
, NULL
);
847 while (!(pdb
->state
& PDB_EXIT
)) {
850 PDB_get_command(debugger
);
851 command
= pdb
->cur_command
;
852 PDB_run_command(debugger
, command
);
861 =item C<static void print_constant_table(PARROT_INTERP, PMC *output)>
863 Prints the contents of the constants table.
869 print_constant_table(PARROT_INTERP
, ARGIN(PMC
*output
))
871 ASSERT_ARGS(print_constant_table
)
872 const INTVAL numconstants
= interp
->code
->const_table
->const_count
;
875 /* TODO: would be nice to print the name of the file as well */
876 Parrot_io_fprintf(interp
, output
, "=head1 Constant-table\n\n");
878 for (i
= 0; i
< numconstants
; ++i
) {
879 const PackFile_Constant
* const c
= interp
->code
->const_table
->constants
[i
];
883 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %f\n", i
, c
->u
.number
);
886 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): %S\n", i
, c
->u
.string
);
889 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
891 /* Parrot_print_p(interp, c->u.key); */
892 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
893 Parrot_io_fprintf(interp
, output
, "\n");
897 Parrot_io_fprintf(interp
, output
, "PMC_CONST(%d): ", i
);
899 switch (c
->u
.key
->vtable
->base_type
) {
900 /* each PBC file has a ParrotInterpreter, but it can't
901 * stringify by itself */
902 case enum_class_ParrotInterpreter
:
903 Parrot_io_fprintf(interp
, output
, "'ParrotInterpreter'");
906 /* FixedIntegerArrays used for signatures, handy to print */
907 case enum_class_FixedIntegerArray
:
909 const INTVAL n
= VTABLE_elements(interp
, c
->u
.key
);
911 Parrot_io_fprintf(interp
, output
, "[");
913 for (j
= 0; j
< n
; ++j
) {
914 const INTVAL val
= VTABLE_get_integer_keyed_int(interp
, c
->u
.key
, j
);
915 Parrot_io_fprintf(interp
, output
, "%d", val
);
917 Parrot_io_fprintf(interp
, output
, ",");
919 Parrot_io_fprintf(interp
, output
, "]");
922 case enum_class_NameSpace
:
923 case enum_class_String
:
925 case enum_class_ResizableStringArray
:
927 /*Parrot_print_p(interp, c->u.key);*/
928 STRING
* const s
= VTABLE_get_string(interp
, c
->u
.key
);
930 Parrot_io_fprintf(interp
, output
, "%Ss", s
);
934 Parrot_io_fprintf(interp
, output
, "%S", VTABLE_get_string(interp
, c
->u
.key
));
937 Parrot_io_fprintf(interp
, output
, "(PMC constant)");
941 Parrot_io_fprintf(interp
, output
, "\n");
945 Parrot_io_fprintf(interp
, output
, "wrong constant type in constant table!\n");
946 /* XXX throw an exception? Is it worth the trouble? */
951 Parrot_io_fprintf(interp
, output
, "\n=cut\n\n");
957 =item C<void Parrot_disassemble(PARROT_INTERP, const char *outfile,
958 Parrot_disassemble_options options)>
960 Disassembles and prints out the interpreter's bytecode.
962 This is used by the Parrot disassembler.
970 Parrot_disassemble(PARROT_INTERP
,
971 ARGIN_NULLOK(const char *outfile
), Parrot_disassemble_options options
)
973 ASSERT_ARGS(Parrot_disassemble
)
975 PDB_t
* const pdb
= mem_gc_allocate_zeroed_typed(interp
, PDB_t
);
976 int num_mappings
= 0;
977 int curr_mapping
= 0;
978 int op_code_seq_num
= 0;
982 if (outfile
!= NULL
) {
983 output
= Parrot_io_open(interp
, PMCNULL
,
984 Parrot_str_new(interp
, outfile
, 0),
985 Parrot_str_new_constant(interp
, "tw"));
988 output
= Parrot_io_stdhandle(interp
, PIO_STDOUT_FILENO
, PMCNULL
);
991 pdb
->cur_opcode
= interp
->code
->base
.data
;
993 PDB_disassemble(interp
, NULL
);
995 line
= pdb
->file
->line
;
996 debugs
= (interp
->code
->debugs
!= NULL
);
998 print_constant_table(interp
, output
);
999 if (options
& enum_DIS_HEADER
)
1002 if (!(options
& enum_DIS_BARE
))
1003 Parrot_io_fprintf(interp
, output
, "# %12s-%12s", "Seq_Op_Num", "Relative-PC");
1006 if (!(options
& enum_DIS_BARE
))
1007 Parrot_io_fprintf(interp
, output
, " %6s:\n", "SrcLn#");
1008 num_mappings
= interp
->code
->debugs
->num_mappings
;
1011 Parrot_io_fprintf(interp
, output
, "\n");
1014 while (line
->next
) {
1017 /* Parrot_io_fprintf(interp, output, "%i < %i %i == %i \n", curr_mapping,
1018 * num_mappings, op_code_seq_num,
1019 * interp->code->debugs->mappings[curr_mapping].offset); */
1021 if (debugs
&& curr_mapping
< num_mappings
) {
1022 if (op_code_seq_num
== interp
->code
->debugs
->mappings
[curr_mapping
].offset
) {
1023 const int filename_const_offset
=
1024 interp
->code
->debugs
->mappings
[curr_mapping
].filename
;
1025 Parrot_io_fprintf(interp
, output
, "# Current Source Filename '%Ss'\n",
1026 interp
->code
->const_table
->constants
[filename_const_offset
]->u
.string
);
1031 if (!(options
& enum_DIS_BARE
))
1032 Parrot_io_fprintf(interp
, output
, "%012i-%012i",
1033 op_code_seq_num
, line
->opcode
- interp
->code
->base
.data
);
1035 if (debugs
&& !(options
& enum_DIS_BARE
))
1036 Parrot_io_fprintf(interp
, output
, " %06i: ",
1037 interp
->code
->debugs
->base
.data
[op_code_seq_num
]);
1039 /* If it has a label print it */
1041 Parrot_io_fprintf(interp
, output
, "L%li:\t", line
->label
->number
);
1043 Parrot_io_fprintf(interp
, output
, "\t");
1045 c
= pdb
->file
->source
+ line
->source_offset
;
1047 while (c
&& *c
!= '\n')
1048 Parrot_io_fprintf(interp
, output
, "%c", *(c
++));
1050 Parrot_io_fprintf(interp
, output
, "\n");
1054 if (outfile
!= NULL
)
1055 Parrot_io_close(interp
, output
);
1063 =item C<void Parrot_run_native(PARROT_INTERP, native_func_t func)>
1065 Runs the C function C<func> through the program C<[enternative, end]>. This
1066 ensures that the function runs with the same setup as in other run loops.
1068 This function is used in some of the source tests in F<t/src> which use
1069 the interpreter outside a runloop.
1077 Parrot_run_native(PARROT_INTERP
, native_func_t func
)
1079 ASSERT_ARGS(Parrot_run_native
)
1080 PackFile
* const pf
= PackFile_new(interp
, 0);
1081 static opcode_t program_code
[2];
1083 program_code
[0] = interp
->op_lib
->op_code(interp
, "enternative", 0);
1084 program_code
[1] = 0; /* end */
1086 pf
->cur_cs
= (PackFile_ByteCode
*)
1087 (pf
->PackFuncs
[PF_BYTEC_SEG
].new_seg
)(interp
, pf
,
1088 Parrot_str_new_constant(interp
, "code"), 1);
1089 pf
->cur_cs
->base
.data
= program_code
;
1090 pf
->cur_cs
->base
.size
= 2;
1092 Parrot_pbc_load(interp
, pf
);
1096 if (interp
->code
&& interp
->code
->const_table
)
1097 Parrot_pcc_set_constants(interp
, interp
->ctx
, interp
->code
->const_table
->constants
);
1099 runops(interp
, interp
->resume_offset
);
1105 =item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
1106 const char *code, Parrot_String *error)>
1108 Compiles a code string.
1116 Parrot_compile_string(PARROT_INTERP
, Parrot_String type
, ARGIN(const char *code
),
1117 ARGOUT(Parrot_String
*error
))
1119 ASSERT_ARGS(Parrot_compile_string
)
1120 /* For the benefit of embedders that do not load any pbc
1121 * before compiling a string */
1123 if (!interp
->initial_pf
) {
1124 /* SIDE EFFECT: PackFile_new_dummy sets interp->initial_pf */
1125 interp
->initial_pf
= PackFile_new_dummy(interp
, CONST_STRING(interp
, "compile_string"));
1126 /* Assumption: there is no valid reason to fail to create it.
1127 * If the assumption changes, replace the assertion with a
1129 PARROT_ASSERT(interp
->initial_pf
);
1132 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PIR"), type
) == 0)
1133 return IMCC_compile_pir_s(interp
, code
, error
);
1135 if (Parrot_str_compare(interp
, CONST_STRING(interp
, "PASM"), type
) == 0)
1136 return IMCC_compile_pasm_s(interp
, code
, error
);
1138 *error
= Parrot_str_new(interp
, "Invalid interpreter type", 0);
1149 F<include/parrot/embed.h> and F<docs/embed.pod>.
1157 * c-file-style: "parrot"
1159 * vim: expandtab shiftwidth=4: