2 Copyright (C) 2005-2009, Parrot Foundation.
7 src/hll.c - High Level Language support
11 The Parrot core sometimes has to create new PMCs which should map to the
12 current HLL's defaults. The current language and a typemap provides this
20 [ hll_name, hll_lib, { core_type => HLL_type, ... }, namespace, hll_id ],
32 #include "parrot/parrot.h"
33 #include "parrot/dynext.h"
34 #include "pmc/pmc_callcontext.h"
37 /* HEADERIZER HFILE: include/parrot/hll.h */
39 /* HEADERIZER BEGIN: static */
40 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
42 PARROT_CANNOT_RETURN_NULL
43 PARROT_WARN_UNUSED_RESULT
44 static PMC
* new_hll_entry(PARROT_INTERP
, ARGIN_NULLOK(STRING
*entry_name
))
45 __attribute__nonnull__(1);
47 #define ASSERT_ARGS_new_hll_entry __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
48 PARROT_ASSERT_ARG(interp))
49 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
50 /* HEADERIZER END: static */
52 /* for shared HLL data, do COW stuff */
53 #define START_READ_HLL_INFO(interp, hll_info)
54 #define END_READ_HLL_INFO(interp, hll_info)
59 =item C<static PMC* new_hll_entry(PARROT_INTERP, STRING *entry_name)>
61 Create a new HLL information table entry.
62 Takes an interpreter name and (optional) entry name.
63 Returns a pointer to the new entry.
64 Used by Parrot_register_HLL and Parrot_register_HLL_lib.
70 PARROT_CANNOT_RETURN_NULL
71 PARROT_WARN_UNUSED_RESULT
73 new_hll_entry(PARROT_INTERP
, ARGIN_NULLOK(STRING
*entry_name
))
75 ASSERT_ARGS(new_hll_entry
)
76 PMC
* const hll_info
= interp
->HLL_info
;
77 const INTVAL id
= VTABLE_elements(interp
, hll_info
);
81 PMC
* const entry
= Parrot_pmc_new_constant_init_int(interp
,
82 enum_class_FixedPMCArray
, e_HLL_MAX
);
84 if (entry_name
&& !STRING_IS_EMPTY(entry_name
)) {
85 VTABLE_set_pmc_keyed_str(interp
, hll_info
, entry_name
, entry
);
88 VTABLE_push_pmc(interp
, hll_info
, entry
);
90 entry_id
= Parrot_pmc_new_constant_init_int(interp
, enum_class_Integer
, id
);
91 VTABLE_set_pmc_keyed_int(interp
, entry
, e_HLL_id
, entry_id
);
99 =item C<void Parrot_init_HLL(PARROT_INTERP)>
101 Initialises the HLL_info and HLL_namespace fields of the interpreter structure.
102 Registers the default HLL namespace "parrot".
109 Parrot_init_HLL(PARROT_INTERP
)
111 ASSERT_ARGS(Parrot_init_HLL
)
113 Parrot_pmc_new(interp
, enum_class_OrderedHash
);
114 interp
->HLL_namespace
=
115 Parrot_pmc_new_constant(interp
, enum_class_ResizablePMCArray
);
117 Parrot_register_HLL(interp
, CONST_STRING(interp
, "parrot"));
122 =item C<INTVAL Parrot_register_HLL(PARROT_INTERP, STRING *hll_name)>
124 Register the HLL with the given STRING name C<hll_name> in the interpreter.
126 If the HLL has already been registered, the ID of the HLL is returned.
127 Otherwise the HLL is registered, a corresponding HLL namespace is created,
128 and the HLL ID is returned.
130 If there is an error, C<-1> is returned.
138 Parrot_register_HLL(PARROT_INTERP
, ARGIN(STRING
*hll_name
))
140 ASSERT_ARGS(Parrot_register_HLL
)
141 PMC
*entry
, *name
, *type_hash
, *ns_hash
, *hll_info
;
144 /* TODO LOCK or disallow in threads */
146 idx
= Parrot_get_HLL_id(interp
, hll_name
);
151 hll_info
= interp
->HLL_info
;
153 idx
= VTABLE_elements(interp
, hll_info
);
154 entry
= new_hll_entry(interp
, hll_name
);
156 /* register HLL name */
157 name
= Parrot_pmc_new_constant(interp
, enum_class_String
);
159 VTABLE_set_string_native(interp
, name
, hll_name
);
160 VTABLE_set_pmc_keyed_int(interp
, entry
, e_HLL_name
, name
);
162 /* create HLL namespace using the *constant* name */
163 hll_name
= Parrot_str_downcase(interp
, VTABLE_get_string(interp
, name
));
165 /* HLL type mappings aren't yet created, we can't create
166 * a namespace in HLL's flavor yet - maybe promote the
167 * ns_hash to another type, if mappings provide one
170 ns_hash
= Parrot_make_namespace_keyed_str(interp
, interp
->root_namespace
,
173 /* cache HLL's toplevel namespace */
174 VTABLE_set_pmc_keyed_int(interp
, interp
->HLL_namespace
, idx
, ns_hash
);
176 /* create HLL typemap hash */
177 type_hash
= Parrot_pmc_new_constant(interp
, enum_class_Hash
);
178 VTABLE_set_pointer(interp
, type_hash
, parrot_new_intval_hash(interp
));
179 VTABLE_set_pmc_keyed_int(interp
, entry
, e_HLL_typemap
, type_hash
);
186 =item C<INTVAL Parrot_register_HLL_lib(PARROT_INTERP, STRING *hll_lib)>
188 Register an HLL library.
189 Takes a pointer to a library name STRING to add. If the name has already
190 been registered the list position of the library in the HLL Info list is
191 returned. Otherwise, the library is added to the list and 0 is returned.
199 Parrot_register_HLL_lib(PARROT_INTERP
, ARGIN(STRING
*hll_lib
))
201 ASSERT_ARGS(Parrot_register_HLL_lib
)
202 PMC
*hll_info
= interp
->HLL_info
;
203 const INTVAL nelements
= VTABLE_elements(interp
, hll_info
);
206 for (i
= 0; i
< nelements
; ++i
) {
207 PMC
* const entry
= VTABLE_get_pmc_keyed_int(interp
, hll_info
, i
);
208 PMC
* const lib_name
= VTABLE_get_pmc_keyed_int(interp
, entry
, e_HLL_lib
);
210 if (!PMC_IS_NULL(lib_name
)) {
211 const STRING
* const lib_name_str
= VTABLE_get_string(interp
, lib_name
);
212 if (Parrot_str_equal(interp
, lib_name_str
, hll_lib
))
220 PMC
* const new_entry
= new_hll_entry(interp
, NULL
);
223 VTABLE_set_pmc_keyed_int(interp
, new_entry
, e_HLL_name
, PMCNULL
);
225 /* register dynlib */
226 name
= Parrot_pmc_new_constant(interp
, enum_class_String
);
228 VTABLE_set_string_native(interp
, name
, hll_lib
);
229 VTABLE_set_pmc_keyed_int(interp
, new_entry
, e_HLL_lib
, name
);
237 =item C<INTVAL Parrot_get_HLL_id(PARROT_INTERP, STRING *hll_name)>
239 Returns the ID number of the HLL with the given name. The default HLL namespace
240 C<parrot> has an ID number of 0. On error, or if an HLL with the given name
241 does not exist, returns -1.
248 PARROT_WARN_UNUSED_RESULT
250 Parrot_get_HLL_id(PARROT_INTERP
, ARGIN_NULLOK(STRING
*hll_name
))
252 ASSERT_ARGS(Parrot_get_HLL_id
)
254 PMC
* const hll_info
= interp
->HLL_info
;
260 START_READ_HLL_INFO(interp
, hll_info
);
262 entry
= VTABLE_get_pmc_keyed_str(interp
, hll_info
, hll_name
);
264 if (!PMC_IS_NULL(entry
)) {
265 PMC
* const entry_id
= VTABLE_get_pmc_keyed_int(interp
, entry
, e_HLL_id
);
266 i
= VTABLE_get_integer(interp
, entry_id
);
269 END_READ_HLL_INFO(interp
, hll_info
);
276 =item C<STRING * Parrot_get_HLL_name(PARROT_INTERP, INTVAL id)>
278 Returns the STRING name of the HLL with the given C<id> number. If the id
279 is out of range or does not exist, the NULL value is returned instead. Note
280 that some HLLs are anonymous and so might also return NULL.
287 PARROT_WARN_UNUSED_RESULT
288 PARROT_CAN_RETURN_NULL
290 Parrot_get_HLL_name(PARROT_INTERP
, INTVAL id
)
292 ASSERT_ARGS(Parrot_get_HLL_name
)
293 PMC
* const hll_info
= interp
->HLL_info
;
294 const INTVAL nelements
= VTABLE_elements(interp
, hll_info
);
296 PMC
*entry
, *name_pmc
;
298 if (id
< 0 || id
>= nelements
)
301 START_READ_HLL_INFO(interp
, hll_info
);
303 entry
= VTABLE_get_pmc_keyed_int(interp
, hll_info
, id
);
304 name_pmc
= VTABLE_get_pmc_keyed_int(interp
, entry
, e_HLL_name
);
306 END_READ_HLL_INFO(interp
, hll_info
);
308 /* loadlib-created 'HLL's are nameless */
309 if (PMC_IS_NULL(name_pmc
))
312 return VTABLE_get_string(interp
, name_pmc
);
317 =item C<void Parrot_register_HLL_type(PARROT_INTERP, INTVAL hll_id, INTVAL
318 core_type, INTVAL hll_type)>
320 Register a type mapping of C<< core_type => hll_type >> for the given HLL.
328 Parrot_register_HLL_type(PARROT_INTERP
, INTVAL hll_id
,
329 INTVAL core_type
, INTVAL hll_type
)
331 ASSERT_ARGS(Parrot_register_HLL_type
)
332 PMC
*entry
, *type_hash
;
333 PMC
*hll_info
= interp
->HLL_info
;
334 const INTVAL n
= VTABLE_elements(interp
, hll_info
);
337 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_GLOBAL_NOT_FOUND
,
338 "no such HLL ID (%vd)", hll_id
);
340 entry
= VTABLE_get_pmc_keyed_int(interp
, hll_info
, hll_id
);
341 PARROT_ASSERT(!PMC_IS_NULL(entry
));
343 type_hash
= VTABLE_get_pmc_keyed_int(interp
, entry
, e_HLL_typemap
);
344 PARROT_ASSERT(!PMC_IS_NULL(type_hash
));
346 VTABLE_set_integer_keyed_int(interp
, type_hash
, core_type
, hll_type
);
351 =item C<INTVAL Parrot_get_HLL_type(PARROT_INTERP, INTVAL hll_id, INTVAL
354 Get an equivalent HLL type number for the language C<hll_id>. If the given HLL
355 doesn't remap the given type, or if C<hll_id> is the special value
356 C<PARROT_HLL_NONE>, returns C<core_type> unchanged.
364 Parrot_get_HLL_type(PARROT_INTERP
, INTVAL hll_id
, INTVAL core_type
)
366 ASSERT_ARGS(Parrot_get_HLL_type
)
367 PMC
*entry
, *type_hash
, *hll_info
;
370 if (hll_id
== PARROT_HLL_NONE
|| hll_id
== 0)
374 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_GLOBAL_NOT_FOUND
,
375 "no such HLL ID (%vd)", hll_id
);
377 hll_info
= interp
->HLL_info
;
378 n
= VTABLE_elements(interp
, hll_info
);
381 Parrot_ex_throw_from_c_args(interp
, NULL
, EXCEPTION_GLOBAL_NOT_FOUND
,
382 "no such HLL ID (%vd)", hll_id
);
384 START_READ_HLL_INFO(interp
, hll_info
);
385 entry
= VTABLE_get_pmc_keyed_int(interp
, hll_info
, hll_id
);
386 END_READ_HLL_INFO(interp
, hll_info
);
388 type_hash
= VTABLE_get_pmc_keyed_int(interp
, entry
, e_HLL_typemap
);
390 if (PMC_IS_NULL(type_hash
))
393 id
= VTABLE_get_integer_keyed_int(interp
, type_hash
, core_type
);
395 return id
? id
: core_type
;
400 =item C<INTVAL Parrot_get_ctx_HLL_type(PARROT_INTERP, INTVAL core_type)>
402 Return an equivalent PMC type number according to the HLL settings in
403 the current context. If no type is registered, returns C<core_type>.
411 Parrot_get_ctx_HLL_type(PARROT_INTERP
, INTVAL core_type
)
413 ASSERT_ARGS(Parrot_get_ctx_HLL_type
)
414 const INTVAL hll_id
= Parrot_pcc_get_HLL(interp
, CURRENT_CONTEXT(interp
));
416 return Parrot_get_HLL_type(interp
, hll_id
, core_type
);
421 =item C<PMC* Parrot_get_ctx_HLL_namespace(PARROT_INTERP)>
423 Return root namespace of the current HLL.
430 PARROT_WARN_UNUSED_RESULT
431 PARROT_CAN_RETURN_NULL
433 Parrot_get_ctx_HLL_namespace(PARROT_INTERP
)
435 ASSERT_ARGS(Parrot_get_ctx_HLL_namespace
)
436 return Parrot_get_HLL_namespace(interp
, Parrot_pcc_get_HLL(interp
, CURRENT_CONTEXT(interp
)));
441 =item C<PMC* Parrot_get_HLL_namespace(PARROT_INTERP, int hll_id)>
443 Return root namespace of the HLL with the ID of I<hll_id>. If C<hll_id> is the
444 special value C<PARROT_HLL_NONE>, return the global root namespace.
451 PARROT_WARN_UNUSED_RESULT
452 PARROT_CAN_RETURN_NULL
454 Parrot_get_HLL_namespace(PARROT_INTERP
, int hll_id
)
456 ASSERT_ARGS(Parrot_get_HLL_namespace
)
457 if (hll_id
== PARROT_HLL_NONE
)
458 return interp
->root_namespace
;
460 return VTABLE_get_pmc_keyed_int(interp
, interp
->HLL_namespace
, hll_id
);
465 =item C<void Parrot_regenerate_HLL_namespaces(PARROT_INTERP)>
467 Create all HLL namespaces that don't already exist. This is necessary when
468 creating a new interpreter which shares an old interpreter's HLL_info.
476 Parrot_regenerate_HLL_namespaces(PARROT_INTERP
)
478 ASSERT_ARGS(Parrot_regenerate_HLL_namespaces
)
479 const INTVAL n
= VTABLE_elements(interp
, interp
->HLL_info
);
482 /* start at one since the 'parrot' namespace should already have been
485 for (hll_id
= 1; hll_id
< n
; ++hll_id
) {
487 VTABLE_get_pmc_keyed_int(interp
, interp
->HLL_namespace
, hll_id
);
489 if (PMC_IS_NULL(ns_hash
) ||
490 ns_hash
->vtable
->base_type
== enum_class_Undef
)
492 STRING
* hll_name
= Parrot_get_HLL_name(interp
, hll_id
);
496 hll_name
= Parrot_str_downcase(interp
, hll_name
);
498 /* XXX as in Parrot_register_HLL() this needs to be fixed to use
499 * the correct type of namespace. It's relatively easy to do that
500 * here because the typemap already exists, but it is not currently
501 * done for consistency.
503 ns_hash
= Parrot_make_namespace_keyed_str(interp
,
504 interp
->root_namespace
, hll_name
);
506 VTABLE_set_pmc_keyed_int(interp
, interp
->HLL_namespace
,
527 * c-file-style: "parrot"
529 * vim: expandtab shiftwidth=4: