1 /*
2 Copyright (C) 2001-2014, Parrot Foundation.
3 
4 =head1 NAME
5 
6 src/extend.c - Parrot extension interface
7 
8 =head1 DESCRIPTION
9 
10 These are utility functions which extension code may use, but which are
11 typically not used by Parrot internally. These functions are for EXTENDING
12 use only, not for EMBEDDING. Embedding should be handed through the embedding
13 API with c files in directory src/embed/.
14 
15 Extending situations are things like NCI function libraries, dyn-pmc and
16 dyn-op libraries which are loaded into Parrot and called from Parrot (as
17 opposed to embedding, where an external program calls into Parrot). These
18 functions assume the existence of an interpreter, memory management through
19 GC and stackwalking, and the presence of an exception-handling infrastructure.
20 
21 =head2 Functions
22 
23 =over 4
24 
25 =cut
26 
27 */
28 
29 /* DO NOT CALL THESE FUNCTIONS WITHOUT LIBPARROT, OR FROM OUTSIDE LIBPARROT!!
30 
31    These functions presume that GC is available and is properly configured
32    (setting the stacktop for stack walking, etc) and that there is an active
33    exception-handling infrastructure. Calling these functions when there are
34    no exception handlers available, including a default top-level handler, or
35    when the GC is not properly initialized can lead to big problems. Be sure
36    to understand the difference between an embedding and an extending
37    situation. Using the wrong kind of function in the wrong situation, or
38    combining some functions from the Embedding API with functions from the
39    Extending API is a recipe for disaster. We (Parrot developers) will not be
40    held responsible if you insist on making these kinds of mistakes.
41 
42    If there are utility functions that *YOU* as a user of parrot need from
43    either the extending or the embedding API, please request them or attempt
44    to write them yourself. Blindly mixing things from the wrong API, or
45    calling a function in the wrong context will cause you problems.
46 
47    You have been warned.
48 
49    Notice that the "Extending API" is a loosely-defined concept which is
50    currently understood to mean the sum of public APIs for various subsystems.
51    This definition may change in the future, but this is what we mean by the
52    phrase right now. The functions in this file do not belong to any
53    particular subsystem, and are always part of the extending API. Functions
54    named "Parrot_xxx_..." where "xxx" is a 2- or 3-letter subsystem
55    abbreviation and which are marked with "PARROT_EXPORT" can generally be
56    considered to be part of the public API. Subsystems which are properly
57    arranged will typically have a folder src/xxx/, and an "api.c" file
58    therein for holding API functions from that subsystem. Many of the bigger
59    systems are arranged in this way (and the rest of the systems will be
60    eventually). If so, that is the canonical source of information regarding
61    API functions for that subsystem.
62 
63    Other documentation sources, such as the PDDs or other files in the
64    docs/ directory may include other information about the extending API.
65 
66 */
67 
68 #include "parrot/parrot.h"
69 #include "parrot/extend.h"
70 #include "parrot/events.h"
71 #include "pmc/pmc_sub.h"
72 #include "pmc/pmc_callcontext.h"
73 
74 /* HEADERIZER BEGIN: static */
75 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
76 
77 static void restore_context(PARROT_INTERP,
78     ARGIN(Parrot_Context * const initialctx))
79         __attribute__nonnull__(1)
80         __attribute__nonnull__(2);
81 
82 #define ASSERT_ARGS_restore_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
83        PARROT_ASSERT_ARG(interp) \
84     , PARROT_ASSERT_ARG(initialctx))
85 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
86 /* HEADERIZER END: static */
87 
88 /* HEADERIZER HFILE: include/parrot/extend.h */
89 
90 /*
91 
92 =item C<Parrot_Int Parrot_PMC_typenum(PARROT_INTERP, const char *_class)>
93 
94 Returns the internal identifier that represents the named class.
95 
96 DEPRECATED. Use Parrot_pmc_get_type_str instead.
97 
98 =cut
99 
100 */
101 
102 PARROT_EXPORT
103 Parrot_Int
Parrot_PMC_typenum(PARROT_INTERP,ARGIN_NULLOK (const char * _class))104 Parrot_PMC_typenum(PARROT_INTERP, ARGIN_NULLOK(const char *_class))
105 {
106     ASSERT_ARGS(Parrot_PMC_typenum)
107     Parrot_Int retval = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, _class, 0));
108     return retval;
109 }
110 
111 /*
112 
113 =item C<void Parrot_ext_call(PARROT_INTERP, Parrot_PMC sub_pmc, const char
114 *signature, ...)>
115 
116 Call a Parrot subroutine or method with the given function signature. The
117 function signature holds one type character for each argument or return, these
118 are:
119 
120     I ... Parrot_Int
121     N ... Parrot_Float
122     S ... Parrot_String
123     P ... Parrot_PMC
124 
125 Returns come after the arguments, separated by an arrow, so "PN->S" takes a PMC
126 and a float as arguments and returns a string.
127 
128 Pass the variables for the arguments and returns in the same order as the
129 signature, with returns as reference to the variable (so it can be modified).
130 
131     Parrot_ext_call(interp, sub, "P->S", pmc_arg, &string_result);
132 
133 To call a method, pass the object for the method as the first argument, and
134 mark it in the signature as "Pi" ("i" stands for "invocant").
135 
136     Parrot_ext_call(interp, sub, "PiP->S", object_arg, pmc_arg, &string_result);
137 
138 =cut
139 
140 */
141 
142 PARROT_EXPORT
143 void
Parrot_ext_call(PARROT_INTERP,ARGIN (Parrot_PMC sub_pmc),ARGIN (const char * signature),...)144 Parrot_ext_call(PARROT_INTERP, ARGIN(Parrot_PMC sub_pmc),
145                  ARGIN(const char *signature), ...)
146 {
147     ASSERT_ARGS(Parrot_ext_call)
148     va_list args;
149     PMC  *call_obj = NULL;
150     const char *arg_sig = NULL, *ret_sig = NULL;
151     PMC * old_call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
152 
153     if (signature[0] == '-' && signature[1] == '>' && !signature[2]) {
154         call_obj = Parrot_pmc_new(interp, enum_class_CallContext);
155         Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, call_obj);
156     }
157     else {
158         Parrot_pcc_split_signature_string(signature, &arg_sig, &ret_sig);
159 
160         va_start(args, signature);
161         call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL,
162             arg_sig, &args);
163 
164         Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, call_obj);
165         call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
166         Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
167             PARROT_ERRORS_RESULT_COUNT_FLAG);
168         va_end(args);
169     }
170     Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_call_obj);
171 }
172 
173 /*
174 
175 =item C<static void restore_context(PARROT_INTERP, Parrot_Context * const
176 initialctx)>
177 
178 Helper function to restore the caller context in Parrot_ext_try.
179 
180 =cut
181 
182 */
183 
184 static void
restore_context(PARROT_INTERP,ARGIN (Parrot_Context * const initialctx))185 restore_context(PARROT_INTERP, ARGIN(Parrot_Context * const initialctx))
186 {
187     ASSERT_ARGS(restore_context)
188     Parrot_Context *curctx = CONTEXT(interp);
189     if (curctx != initialctx) {
190         Parrot_warn((interp), PARROT_WARNINGS_NONE_FLAG,
191                 "popping context in Parrot_ext_try");
192         do {
193             Parrot_pop_context(interp);
194             curctx = CONTEXT(interp);
195             if (curctx == NULL)
196                 PANIC(interp, "cannot restore context");
197         } while (curctx != initialctx);
198     }
199 }
200 
201 /*
202 
203 =item C<void Parrot_ext_try(PARROT_INTERP, void (*cfunction(Parrot_Interp, void
204 *)), void (*chandler(Parrot_Interp, PMC *, void *)), void *data)>
205 
206 Executes the cfunction argument wrapped in a exception handler.
207 If the function throws, the provided handler function is invoked
208 
209 =cut
210 
211 */
212 
213 PARROT_EXPORT
214 void
Parrot_ext_try(PARROT_INTERP,ARGIN_NULLOK (void (* cfunction)(Parrot_Interp,ARGIN_NULLOK (void *))),ARGIN_NULLOK (void (* chandler)(Parrot_Interp,ARGIN_NULLOK (PMC *),ARGIN_NULLOK (void *))),ARGIN_NULLOK (void * data))215 Parrot_ext_try(PARROT_INTERP,
216     ARGIN_NULLOK(void (*cfunction)(Parrot_Interp, ARGIN_NULLOK(void *))),
217     ARGIN_NULLOK(void (*chandler)(Parrot_Interp, ARGIN_NULLOK(PMC *), ARGIN_NULLOK(void *))),
218     ARGIN_NULLOK(void *data))
219 {
220     ASSERT_ARGS(Parrot_ext_try)
221     if (cfunction) {
222         Parrot_runloop jmp;
223         Parrot_Context * const initialctx = CONTEXT(interp);
224         switch (setjmp(jmp.resume)) {
225           case 0: /* try */
226             Parrot_ex_add_c_handler(interp, &jmp);
227             (*cfunction)(interp, data);
228             restore_context(interp, initialctx);
229             Parrot_cx_delete_handler_local(interp);
230             break;
231           default: /* catch */
232             {
233                 PMC *exception = jmp.exception;
234                 restore_context(interp, initialctx);
235                 Parrot_cx_delete_handler_local(interp);
236                 if (chandler)
237                     (*chandler)(interp, exception, data);
238             }
239         }
240     }
241 }
242 
243 /*
244 
245 =item C<Parrot_PMC Parrot_compile_string(PARROT_INTERP, Parrot_String type,
246 const char *code, Parrot_String *error)>
247 
248 Compiles a code string.
249 
250 =cut
251 
252 */
253 
254 PARROT_EXPORT
255 Parrot_PMC
Parrot_compile_string(PARROT_INTERP,Parrot_String type,ARGIN (const char * code),ARGOUT (Parrot_String * error))256 Parrot_compile_string(PARROT_INTERP, Parrot_String type, ARGIN(const char *code),
257         ARGOUT(Parrot_String *error))
258 {
259     ASSERT_ARGS(Parrot_compile_string)
260     Parrot_PMC result = PMCNULL;
261     int is_pasm = (0 == Parrot_str_compare(interp, Parrot_str_new_constant(interp, "PASM"), type));
262     PMC * const compiler = Parrot_pmc_new_init_int(interp, enum_class_IMCCompiler, is_pasm);
263     STRING * const code_str =  Parrot_str_new(interp, code, 0);
264     if (PMC_IS_NULL(compiler)) {
265         *error = Parrot_str_new(interp, "Invalid interpreter or compiler", 0);
266         return NULL;
267     }
268     Parrot_interp_set_compiler(interp, VTABLE_get_string(interp, compiler), compiler);
269     Parrot_pcc_invoke_method_from_c_args(interp, compiler,
270         Parrot_str_new(interp, "compile", 0),
271         "S->P", code_str, &result);
272     return result;
273 }
274 
275 /*
276 
277 =back
278 
279 =head1 SEE ALSO
280 
281 See F<include/parrot/extend.h> and F<docs/pdds/pdd11_extending.pod>.
282 
283 =head1 HISTORY
284 
285 Initial version by Dan Sugalski.
286 
287 =cut
288 
289 */
290 
291 
292 /*
293  * Local variables:
294  *   c-file-style: "parrot"
295  * End:
296  * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
297  */
298