1 /*
2 * Copyright (C) 2002-2014, Parrot Foundation.
3 */
4
5 /*
6
7 =head1 NAME
8
9 compilers/imcc/symreg.c
10
11 =head1 DESCRIPTION
12
13 imcc symbol handling
14
15 XXX: SymReg stuff has become overused. SymReg should be for symbolic
16 registers, reg allocation, etc. but we are now using it for extensive
17 symbol table management. Need to convert much of this over the use Symbol
18 and SymbolTable (see symbol.h and symbol.c)
19
20 =head2 Functions
21
22 =over 4
23
24 =cut
25
26 */
27
28
29 #include "imc.h"
30
31 /* Code: */
32
33 /* HEADERIZER HFILE: compilers/imcc/symreg.h */
34
35 /* HEADERIZER BEGIN: static */
36 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
37
38 PARROT_WARN_UNUSED_RESULT
39 PARROT_CAN_RETURN_NULL
40 static SymReg * _get_sym_typed(
41 ARGIN(const SymHash *hsh),
42 ARGIN(const char *name),
43 int t)
44 __attribute__nonnull__(1)
45 __attribute__nonnull__(2);
46
47 PARROT_WARN_UNUSED_RESULT
48 PARROT_CANNOT_RETURN_NULL
49 PARROT_MALLOC
50 static char * _mk_fullname(
51 ARGMOD(imc_info_t * imcc),
52 ARGIN_NULLOK(const Namespace *ns),
53 ARGIN(const char *name))
54 __attribute__nonnull__(1)
55 __attribute__nonnull__(3)
56 FUNC_MODIFIES(* imcc);
57
58 PARROT_WARN_UNUSED_RESULT
59 PARROT_CANNOT_RETURN_NULL
60 static SymReg * _mk_symreg(
61 ARGMOD(imc_info_t * imcc),
62 ARGMOD(SymHash *hsh),
63 ARGIN(const char *name),
64 int t)
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2)
67 __attribute__nonnull__(3)
68 FUNC_MODIFIES(* imcc)
69 FUNC_MODIFIES(*hsh);
70
71 PARROT_WARN_UNUSED_RESULT
72 PARROT_CANNOT_RETURN_NULL
73 PARROT_MALLOC
74 static char * add_ns(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2)
77 FUNC_MODIFIES(* imcc);
78
79 PARROT_WARN_UNUSED_RESULT
80 PARROT_CAN_RETURN_NULL
81 static SymReg * get_sym_by_name(
82 ARGIN(const SymHash *hsh),
83 ARGIN(const char *name))
84 __attribute__nonnull__(1)
85 __attribute__nonnull__(2);
86
87 PARROT_WARN_UNUSED_RESULT
88 static int int_overflows(ARGIN(const SymReg *r))
89 __attribute__nonnull__(1);
90
91 PARROT_CAN_RETURN_NULL
92 PARROT_WARN_UNUSED_RESULT
93 static SymReg * mk_pmc_const_2(
94 ARGMOD(imc_info_t * imcc),
95 ARGMOD(IMC_Unit *unit),
96 ARGIN(SymReg *left),
97 ARGMOD(SymReg *rhs))
98 __attribute__nonnull__(1)
99 __attribute__nonnull__(2)
100 __attribute__nonnull__(3)
101 __attribute__nonnull__(4)
102 FUNC_MODIFIES(* imcc)
103 FUNC_MODIFIES(*unit)
104 FUNC_MODIFIES(*rhs);
105
106 static void resize_symhash(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh))
107 __attribute__nonnull__(1)
108 __attribute__nonnull__(2)
109 FUNC_MODIFIES(* imcc)
110 FUNC_MODIFIES(*hsh);
111
112 #define ASSERT_ARGS__get_sym_typed __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
113 PARROT_ASSERT_ARG(hsh) \
114 , PARROT_ASSERT_ARG(name))
115 #define ASSERT_ARGS__mk_fullname __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
116 PARROT_ASSERT_ARG(imcc) \
117 , PARROT_ASSERT_ARG(name))
118 #define ASSERT_ARGS__mk_symreg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
119 PARROT_ASSERT_ARG(imcc) \
120 , PARROT_ASSERT_ARG(hsh) \
121 , PARROT_ASSERT_ARG(name))
122 #define ASSERT_ARGS_add_ns __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
123 PARROT_ASSERT_ARG(imcc) \
124 , PARROT_ASSERT_ARG(name))
125 #define ASSERT_ARGS_get_sym_by_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
126 PARROT_ASSERT_ARG(hsh) \
127 , PARROT_ASSERT_ARG(name))
128 #define ASSERT_ARGS_int_overflows __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
129 PARROT_ASSERT_ARG(r))
130 #define ASSERT_ARGS_mk_pmc_const_2 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
131 PARROT_ASSERT_ARG(imcc) \
132 , PARROT_ASSERT_ARG(unit) \
133 , PARROT_ASSERT_ARG(left) \
134 , PARROT_ASSERT_ARG(rhs))
135 #define ASSERT_ARGS_resize_symhash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
136 PARROT_ASSERT_ARG(imcc) \
137 , PARROT_ASSERT_ARG(hsh))
138 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
139 /* HEADERIZER END: static */
140
141 /*
142
143 =item C<static SymReg * _get_sym_typed(const SymHash *hsh, const char *name, int
144 t)>
145
146 Gets a symbol from the hash, with the given C<name> of the specific type C<t>.
147
148 =cut
149
150 */
151
152 PARROT_WARN_UNUSED_RESULT
153 PARROT_CAN_RETURN_NULL
154 static SymReg *
_get_sym_typed(ARGIN (const SymHash * hsh),ARGIN (const char * name),int t)155 _get_sym_typed(ARGIN(const SymHash *hsh), ARGIN(const char *name), int t)
156 {
157 ASSERT_ARGS(_get_sym_typed)
158 SymReg *p;
159 const unsigned int i = hash_str(name) % hsh->size;
160
161 for (p = hsh->data[i]; p; p = p->next) {
162 if ((t == p->set) && STREQ(name, p->name))
163 return p;
164 }
165
166 return NULL;
167 }
168
169
170 /*
171
172 =item C<static SymReg * get_sym_by_name(const SymHash *hsh, const char *name)>
173
174 Gets a symbol from the hash, with the given C<name>.
175
176 =cut
177
178 */
179
180 PARROT_WARN_UNUSED_RESULT
181 PARROT_CAN_RETURN_NULL
182 static SymReg *
get_sym_by_name(ARGIN (const SymHash * hsh),ARGIN (const char * name))183 get_sym_by_name(ARGIN(const SymHash *hsh), ARGIN(const char *name))
184 {
185 ASSERT_ARGS(get_sym_by_name)
186
187 SymReg *p;
188 const unsigned int i = hash_str(name) % hsh->size;
189
190 for (p = hsh->data[i]; p; p = p->next) {
191 if (STREQ(name, p->name))
192 return p;
193 }
194
195 return NULL;
196 }
197
198
199 /* symbolic registers */
200
201 /*
202
203 =item C<static SymReg * _mk_symreg(imc_info_t * imcc, SymHash *hsh, const char
204 *name, int t)>
205
206 Makes a new SymReg in the given SymHash from a varname and type.
207
208 =cut
209
210 */
211
212 PARROT_WARN_UNUSED_RESULT
213 PARROT_CANNOT_RETURN_NULL
214 static SymReg *
_mk_symreg(ARGMOD (imc_info_t * imcc),ARGMOD (SymHash * hsh),ARGIN (const char * name),int t)215 _mk_symreg(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh),
216 ARGIN(const char *name), int t)
217 {
218 ASSERT_ARGS(_mk_symreg)
219 SymReg * r = _get_sym_typed(hsh, name, t);
220
221 if (!r) {
222 r = mem_gc_allocate_zeroed_typed(imcc->interp, SymReg);
223 r->set = t;
224 r->type = VTREG;
225 r->name = mem_sys_strdup(name);
226 r->color = -1;
227 r->want_regno = -1;
228
229 _store_symreg(imcc, hsh, r);
230 }
231
232 return r;
233 }
234
235
236 /*
237
238 =item C<SymReg * mk_symreg(imc_info_t * imcc, const char *name, int t)>
239
240 Makes a new SymReg in the current unit, given a varname and type.
241
242 =cut
243
244 */
245
246 PARROT_WARN_UNUSED_RESULT
247 PARROT_CANNOT_RETURN_NULL
248 SymReg *
mk_symreg(ARGMOD (imc_info_t * imcc),ARGIN (const char * name),int t)249 mk_symreg(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int t)
250 {
251 ASSERT_ARGS(mk_symreg)
252 IMC_Unit * const unit = imcc->cur_unit;
253
254 /* Check for the condition that fires up a segfault in TT #162 */
255 PARROT_ASSERT(unit != NULL);
256
257 return _mk_symreg(imcc, &unit->hash, name, t);
258 }
259
260
261 /*
262
263 =item C<char * symreg_to_str(const SymReg *s)>
264
265 Dumps a SymReg to a printable format.
266
267 =cut
268
269 */
270
271 PARROT_MALLOC
272 PARROT_WARN_UNUSED_RESULT
273 PARROT_CANNOT_RETURN_NULL
274 char *
symreg_to_str(ARGIN (const SymReg * s))275 symreg_to_str(ARGIN(const SymReg *s))
276 {
277 ASSERT_ARGS(symreg_to_str)
278 /* NOTE: the below magic number encompasses all the quoted strings which
279 * may be included in the sprintf output (for now) */
280 char * const buf = (char *)mem_sys_allocate(250 + strlen(s->name));
281 const int t = s->type;
282
283 sprintf(buf, "symbol [%s] set [%c] color [" INTVAL_FMT "] type [",
284 s->name, s->set, s->color);
285
286 if (t & VTCONST) { strcat(buf, "VTCONST "); }
287 if (t & VTREG) { strcat(buf, "VTREG "); }
288 if (t & VTIDENTIFIER) { strcat(buf, "VTIDENTIFIER "); }
289 if (t & VTADDRESS) { strcat(buf, "VTADDRESS "); }
290 if (t & VTREGKEY) { strcat(buf, "VTREGKEY "); }
291 if (t & VTPASM) { strcat(buf, "VTPASM "); }
292 if (t & VT_CONSTP) { strcat(buf, "VT_CONSTP "); }
293 if (t & VT_PCC_SUB) { strcat(buf, "VT_PCC_SUB "); }
294 if (t & VT_FLAT) { strcat(buf, "VT_FLAT "); }
295 if (t & VT_OPTIONAL) { strcat(buf, "VT_OPTIONAL "); }
296 if (t & VT_NAMED) { strcat(buf, "VT_NAMED "); }
297 if (t & VT_CALL_SIG) { strcat(buf, "VT_CALL_SIG "); }
298
299 strcat(buf, "]");
300
301 return buf;
302 }
303
304
305 /*
306
307 =item C<SymReg * mk_temp_reg(imc_info_t * imcc, int t)>
308
309 Makes a new unique and temporary SymReg of the specified type C<t>.
310
311 =cut
312
313 */
314
315 PARROT_WARN_UNUSED_RESULT
316 PARROT_CANNOT_RETURN_NULL
317 SymReg *
mk_temp_reg(ARGMOD (imc_info_t * imcc),int t)318 mk_temp_reg(ARGMOD(imc_info_t * imcc), int t)
319 {
320 ASSERT_ARGS(mk_temp_reg)
321 char buf[30];
322
323 ++imcc->unique_count;
324 snprintf(buf, sizeof (buf), "__imcc_temp_%d", imcc->unique_count);
325 return mk_symreg(imcc, buf, t);
326 }
327
328
329 /*
330
331 =item C<SymReg * mk_pcc_sub(imc_info_t * imcc, const char *name, int proto)>
332
333 Makes a SymReg representing a PCC sub of the given C<name> with the specified
334 type.
335
336 =cut
337
338 */
339
340 PARROT_WARN_UNUSED_RESULT
341 PARROT_CANNOT_RETURN_NULL
342 SymReg *
mk_pcc_sub(ARGMOD (imc_info_t * imcc),ARGIN (const char * name),int proto)343 mk_pcc_sub(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int proto)
344 {
345 ASSERT_ARGS(mk_pcc_sub)
346 IMC_Unit * const unit = imcc->cur_unit;
347 SymReg * const r = _mk_symreg(imcc, &unit->hash, name, proto);
348
349 r->type = VT_PCC_SUB;
350 r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t);
351
352 return r;
353 }
354
355
356 /*
357
358 =item C<void add_namespace(imc_info_t * imcc, IMC_Unit *unit)>
359
360 Add the current namespace (and HLL id) to a sub declaration.
361
362 =cut
363
364 */
365
366 void
add_namespace(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit))367 add_namespace(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit))
368 {
369 ASSERT_ARGS(add_namespace)
370 SymReg * const ns = imcc->cur_namespace;
371
372 unit->hll_id = Parrot_pcc_get_HLL(imcc->interp, CURRENT_CONTEXT(imcc->interp));
373
374 if (!ns)
375 return;
376
377 if (unit->_namespace)
378 return;
379
380 if (unit->prev && unit->prev->_namespace == ns)
381 unit->_namespace = ns;
382 else {
383 SymReg * const g = dup_sym(imcc, ns);
384 SymReg * const r = _get_sym(&imcc->ghash, g->name);
385
386 unit->_namespace = g;
387 g->reg = ns;
388 g->type = VT_CONSTP;
389
390 /* this unit should free its namespace only if it's the only thing
391 * holding onto it */
392 if (!r || r->type != VT_CONSTP) {
393 _store_symreg(imcc, &imcc->ghash, g);
394 unit->owns_namespace = 0;
395 }
396 else
397 unit->owns_namespace = 1;
398 }
399 }
400
401
402 /*
403
404 =item C<void add_pcc_arg(imc_info_t * imcc, SymReg *r, SymReg *arg)>
405
406 Adds a register or constant to the function arg list.
407
408 =cut
409
410 */
411
412 void
add_pcc_arg(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r),ARGMOD (SymReg * arg))413 add_pcc_arg(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *arg))
414 {
415 ASSERT_ARGS(add_pcc_arg)
416 pcc_sub_t * const sub = r->pcc_sub;
417 const int n = sub->nargs;
418
419 sub->args = mem_gc_realloc_n_typed(imcc->interp, sub->args, n + 1, SymReg *);
420 sub->arg_flags = mem_gc_realloc_n_typed(imcc->interp, sub->arg_flags, n + 1, int);
421
422 sub->args[n] = arg;
423 sub->arg_flags[n] = arg->type;
424
425 arg->type &= ~(VT_FLAT|VT_OPTIONAL|VT_OPT_FLAG|VT_NAMED|VT_CALL_SIG);
426
427 sub->nargs++;
428 }
429
430
431 /*
432
433 =item C<void add_pcc_result(imc_info_t * imcc, SymReg *r, SymReg *arg)>
434
435 Adds a register or constant to the function's return list.
436
437 =cut
438
439 */
440
441 void
add_pcc_result(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r),ARGMOD (SymReg * arg))442 add_pcc_result(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *arg))
443 {
444 ASSERT_ARGS(add_pcc_result)
445 pcc_sub_t * const sub = r->pcc_sub;
446 const int n = sub->nret;
447
448 sub->ret = mem_gc_realloc_n_typed(imcc->interp, sub->ret, n + 1, SymReg *);
449 sub->ret_flags = mem_gc_realloc_n_typed(imcc->interp, sub->ret_flags, n + 1, int);
450
451 /* we can't keep the flags in the SymReg as the SymReg
452 * maybe used with different flags for different calls */
453 sub->ret[n] = arg;
454 sub->ret_flags[n] = arg->type;
455
456 arg->type &= ~(VT_FLAT|VT_OPTIONAL|VT_OPT_FLAG|VT_NAMED);
457
458 sub->nret++;
459 }
460
461
462 /*
463
464 =item C<void add_pcc_multi(imc_info_t * imcc, SymReg *r, SymReg *arg)>
465
466 Adds a :multi signature to the sub.
467
468 =cut
469
470 */
471
472 void
add_pcc_multi(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r),ARGIN_NULLOK (SymReg * arg))473 add_pcc_multi(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r), ARGIN_NULLOK(SymReg *arg))
474 {
475 ASSERT_ARGS(add_pcc_multi)
476 pcc_sub_t * const sub = r->pcc_sub;
477 const int n = sub->nmulti;
478
479 sub->multi = mem_gc_realloc_n_typed(imcc->interp, sub->multi, n + 1, SymReg *);
480 sub->multi[n] = arg;
481 sub->nmulti++;
482 }
483
484
485 /*
486
487 =item C<void add_pcc_flag_str(imc_info_t * imcc, SymReg * r, SymReg * arg)>
488
489 Associate a tag with a sub.
490
491 =cut
492
493 */
494
495 void
add_pcc_flag_str(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r),ARGIN (SymReg * arg))496 add_pcc_flag_str(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg * r), ARGIN(SymReg * arg))
497 {
498 ASSERT_ARGS(add_pcc_flag_str)
499 pcc_sub_t * const sub = r->pcc_sub;
500 const int n = sub->nflags;
501 sub->flags = mem_gc_realloc_n_typed(imcc->interp, sub->flags, n + 1, SymReg*);
502 sub->flags[n] = arg;
503 sub->nflags++;
504 }
505
506 /*
507
508 =item C<void add_pcc_sub(SymReg *r, SymReg *arg)>
509
510 Sets the current sub in the given SymReg to the second SymReg.
511
512 =cut
513
514 */
515
516 void
add_pcc_sub(ARGMOD (SymReg * r),ARGIN (SymReg * arg))517 add_pcc_sub(ARGMOD(SymReg *r), ARGIN(SymReg *arg))
518 {
519 ASSERT_ARGS(add_pcc_sub)
520 r->pcc_sub->sub = arg;
521 }
522
523
524 /*
525
526 =item C<void add_pcc_cc(SymReg *r, SymReg *arg)>
527
528 Adds a continuation (?) to the current sub.
529
530 =cut
531
532 */
533
534 void
add_pcc_cc(ARGMOD (SymReg * r),ARGIN (SymReg * arg))535 add_pcc_cc(ARGMOD(SymReg *r), ARGIN(SymReg *arg))
536 {
537 ASSERT_ARGS(add_pcc_cc)
538 r->pcc_sub->cc = arg;
539 }
540
541
542 /*
543
544 =item C<SymReg * mk_pasm_reg(imc_info_t * imcc, const char *name)>
545
546 Makes a SymReg representing a PASM register.
547
548 =cut
549
550 */
551
552 PARROT_WARN_UNUSED_RESULT
553 PARROT_CANNOT_RETURN_NULL
554 SymReg *
mk_pasm_reg(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))555 mk_pasm_reg(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
556 {
557 ASSERT_ARGS(mk_pasm_reg)
558 SymReg *r = _get_sym(&imcc->cur_unit->hash, name);
559
560 if (!r) {
561 r = mk_symreg(imcc, name, *name);
562 r->type = VTPASM;
563 r->color = atoi(name + 1);
564
565 if (r->color < 0)
566 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
567 "register number out of range '%s'\n", name);
568 }
569
570 return r;
571 }
572
573
574 /*
575
576 =item C<static char * _mk_fullname(imc_info_t * imcc, const Namespace *ns, const
577 char *name)>
578
579 Combines the namespace and name together, separated by a C<::>. If there's no
580 namespace, the name is returned on its own.
581
582 The returned string must be free()d.
583
584 =cut
585
586 */
587
588 PARROT_WARN_UNUSED_RESULT
589 PARROT_CANNOT_RETURN_NULL
590 PARROT_MALLOC
591 static char *
_mk_fullname(ARGMOD (imc_info_t * imcc),ARGIN_NULLOK (const Namespace * ns),ARGIN (const char * name))592 _mk_fullname(ARGMOD(imc_info_t * imcc), ARGIN_NULLOK(const Namespace *ns), ARGIN(const char *name))
593 {
594 ASSERT_ARGS(_mk_fullname)
595 if (ns) {
596 const size_t len = strlen(name) + strlen(ns->name) + 3;
597 char *result = mem_gc_allocate_n_typed(imcc->interp, len, char);
598 snprintf(result, len, "%s::%s", ns->name, name);
599 return result;
600 }
601
602 return mem_sys_strdup(name);
603 }
604
605
606 /*
607
608 =item C<SymReg * mk_ident(imc_info_t * imcc, const char *name, int t, INTVAL
609 type)>
610
611 Makes a new identifier.
612
613 =cut
614
615 */
616
617 PARROT_CANNOT_RETURN_NULL
618 PARROT_IGNORABLE_RESULT
619 SymReg *
mk_ident(ARGMOD (imc_info_t * imcc),ARGIN (const char * name),int t,INTVAL type)620 mk_ident(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int t, INTVAL type)
621 {
622 ASSERT_ARGS(mk_ident)
623 SymReg *r = get_sym_by_name(&imcc->cur_unit->hash, name);
624 if (r && (r->set != t || r->type != type))
625 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
626 "syntax error, duplicated IDENTIFIER '%s'\n", name);
627
628 r = mk_symreg(imcc, name, t);
629 r->type = type;
630
631 return r;
632 }
633
634
635 /*
636
637 =item C<static SymReg * mk_pmc_const_2(imc_info_t * imcc, IMC_Unit *unit, SymReg
638 *left, SymReg *rhs)>
639
640 Makes a constant PMC and inserts instructions to access it.
641
642 =cut
643
644 */
645
646 PARROT_CAN_RETURN_NULL
647 PARROT_WARN_UNUSED_RESULT
648 static SymReg *
mk_pmc_const_2(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (SymReg * left),ARGMOD (SymReg * rhs))649 mk_pmc_const_2(ARGMOD(imc_info_t * imcc), ARGMOD(IMC_Unit *unit),
650 ARGIN(SymReg *left), ARGMOD(SymReg *rhs))
651 {
652 ASSERT_ARGS(mk_pmc_const_2)
653 /* XXX This always returns NULL. Probably shouldn't return anything then. */
654 SymReg *r[3];
655 char *name;
656 int len;
657
658 if (imcc->state->pasm_file)
659 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
660 "Ident as PMC constant %s\n", left->name);
661
662 r[0] = left;
663
664 /* strip delimiters */
665 name = mem_sys_strdup(rhs->name + 1);
666 len = strlen(name);
667 name[len - 1] = '\0';
668
669 mem_sys_free(rhs->name);
670
671 rhs->name = name;
672 rhs->set = 'P';
673 rhs->pmc_type = left->pmc_type;
674
675 switch (rhs->pmc_type) {
676 case enum_class_Sub:
677 case enum_class_Coroutine:
678 r[1] = rhs;
679 rhs->usage |= U_FIXUP;
680 INS(imcc, unit, "set_p_pc", "", r, 2, 0, 1);
681 return NULL;
682 default:
683 break;
684 }
685
686 r[1] = rhs;
687 INS(imcc, unit, "set_p_pc", "", r, 2, 0, 1);
688
689 return NULL;
690 }
691
692
693 /*
694
695 =item C<SymReg * mk_const_ident(imc_info_t * imcc, const char *name, int t,
696 SymReg *val, int global)>
697
698 Makes a new identifier constant with value val.
699
700 =cut
701
702 */
703
704 PARROT_CANNOT_RETURN_NULL
705 PARROT_IGNORABLE_RESULT
706 SymReg *
mk_const_ident(ARGMOD (imc_info_t * imcc),ARGIN (const char * name),int t,ARGMOD (SymReg * val),int global)707 mk_const_ident(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int t,
708 ARGMOD(SymReg *val), int global)
709 {
710 ASSERT_ARGS(mk_const_ident)
711 SymReg *r;
712
713 /*
714 * Forbid assigning a string to anything other than a string
715 * or PMC constant
716 */
717 if (t == 'N' || t == 'I') {
718 if (val->set == 'S')
719 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "bad const initialisation");
720
721 /* Cast value to const type */
722 val->set = t;
723 }
724
725 if (global) {
726 if (t == 'P')
727 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
728 "global PMC constant not allowed");
729
730 r = _mk_symreg(imcc, &imcc->ghash, name, t);
731
732 r->type = VT_CONSTP;
733 }
734 else {
735 r = mk_ident(imcc, name, t, VT_CONSTP);
736
737 if (t == 'P')
738 return mk_pmc_const_2(imcc, imcc->cur_unit, r, val);
739 }
740
741 r->reg = val;
742
743 return r;
744 }
745
746
747 /*
748
749 =item C<SymReg * _mk_const(imc_info_t * imcc, SymHash *hsh, const char *name,
750 int t)>
751
752 Makes a new constant (internal use only).
753
754 =cut
755
756 */
757
758 PARROT_WARN_UNUSED_RESULT
759 PARROT_CANNOT_RETURN_NULL
760 SymReg *
_mk_const(ARGMOD (imc_info_t * imcc),ARGMOD (SymHash * hsh),ARGIN (const char * name),int t)761 _mk_const(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh),
762 ARGIN(const char *name), int t)
763 {
764 ASSERT_ARGS(_mk_const)
765 SymReg * const r = _mk_symreg(imcc, hsh, name, t);
766 r->type = VTCONST;
767
768 if (t == 'U') {
769 /* charset:"string" */
770 r->set = 'S';
771 r->type |= VT_ENCODED;
772 }
773
774 /* autopromote big ints to floats
775 */
776 if (t == 'I') {
777 if (int_overflows(r))
778 r->set = 'N';
779 }
780
781 r->use_count++;
782
783 return r;
784 }
785
786 /*
787
788 =item C<static int int_overflows(const SymReg *r)>
789
790 Determine whether an integer constant would overflow an C<INTVAL>
791 register.
792
793 =cut
794
795 */
796
797 PARROT_WARN_UNUSED_RESULT
798 static int
int_overflows(ARGIN (const SymReg * r))799 int_overflows(ARGIN(const SymReg *r))
800 {
801 ASSERT_ARGS(int_overflows)
802 int base;
803 const char *digits;
804
805 if (r->type & VT_CONSTP)
806 r = r->reg;
807
808 /* Refactor this code to hoist common from functionality between
809 * this function and IMCC_int_from_reg in pbc.c */
810 digits = r->name;
811 base = 10;
812
813 if (digits[0] == '0') {
814 switch (toupper((unsigned char)digits[1])) {
815 case 'B': base = 2; break;
816 case 'O': base = 8; break;
817 case 'X': base = 16; break;
818 default: break;
819 }
820 }
821
822 errno = 0;
823
824 if (base == 10)
825 (void)strtol(digits, NULL, base);
826 else
827 (void)strtoul(digits + 2, NULL, base);
828
829 return errno ? 1 : 0;
830 }
831
832 /*
833
834 =item C<SymReg * mk_const(imc_info_t * imcc, const char *name, int t)>
835
836 Makes a new constant (and populates the cache of global symbols).
837
838 =cut
839
840 */
841
842 PARROT_WARN_UNUSED_RESULT
843 PARROT_CANNOT_RETURN_NULL
844 SymReg *
mk_const(ARGMOD (imc_info_t * imcc),ARGIN (const char * name),int t)845 mk_const(ARGMOD(imc_info_t * imcc), ARGIN(const char *name), int t)
846 {
847 ASSERT_ARGS(mk_const)
848 SymHash * const h = &imcc->ghash;
849
850 if (!h->data)
851 create_symhash(imcc, h);
852
853 IMCC_debug(imcc, DEBUG_MKCONST, "# mk_const '%s' %c\n", name, t);
854 return _mk_const(imcc, h, name, t);
855 }
856
857
858 /*
859
860 =item C<static char * add_ns(imc_info_t * imcc, const char *name)>
861
862 Adds a namespace to the current sub.
863
864 =cut
865
866 */
867
868 PARROT_WARN_UNUSED_RESULT
869 PARROT_CANNOT_RETURN_NULL
870 PARROT_MALLOC
871 static char *
add_ns(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))872 add_ns(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
873 {
874 ASSERT_ARGS(add_ns)
875 size_t len, l;
876 char *ns_name, *p;
877
878 if (!imcc->cur_namespace
879 || (l = strlen(imcc->cur_namespace->name)) <= 2)
880 return mem_sys_strdup(name);
881
882 /* TODO keyed syntax */
883 len = strlen(name) + l + 4;
884 ns_name = (char*)mem_sys_allocate(len);
885
886 strcpy(ns_name, imcc->cur_namespace->name);
887 *ns_name = '_';
888 ns_name[l - 1] = '\0';
889 strcat(ns_name, "@@@");
890 strcat(ns_name, name);
891
892 p = strstr(ns_name, "\";\""); /* Foo";"Bar -> Foo@@@Bar */
893
894 while (p) {
895 p[0] = '@';
896 p[1] = '@';
897 p[2] = '@';
898 p = strstr(ns_name, "\";\")");
899 }
900
901 return ns_name;
902 }
903
904
905 /*
906
907 =item C<SymReg * _mk_address(imc_info_t * imcc, SymHash *hsh, const char *name,
908 int uniq)>
909
910 Makes a new address (internal use only).
911
912 =cut
913
914 */
915
916 PARROT_WARN_UNUSED_RESULT
917 PARROT_CANNOT_RETURN_NULL
918 SymReg *
_mk_address(ARGMOD (imc_info_t * imcc),ARGMOD (SymHash * hsh),ARGIN (const char * name),int uniq)919 _mk_address(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh),
920 ARGIN(const char *name), int uniq)
921 {
922 ASSERT_ARGS(_mk_address)
923 SymReg *r;
924
925 if (uniq == U_add_all) {
926 int is_lexical = 0;
927 r = get_sym_by_name(&imcc->ghash, name);
928
929 if (r && r->usage & U_LEXICAL)
930 is_lexical = 1;
931
932 r = mem_gc_allocate_zeroed_typed(imcc->interp, SymReg);
933 r->type = VTADDRESS;
934 r->name = mem_sys_strdup(name);
935 _store_symreg(imcc, hsh, r);
936
937 if (is_lexical)
938 r->usage |= U_LEXICAL;
939 }
940 else {
941 /* Aux var to avoid the need of const casts */
942 char *aux_name = NULL;
943 const char * const sub_name = (uniq == U_add_uniq_sub)
944 /* remember to free this name; add_ns malloc()s it */
945 ? (aux_name = add_ns(imcc, name))
946 : name;
947
948 r = _get_sym(hsh, sub_name);
949
950 /* we use this for labels/subs */
951 if (uniq && r && r->type == VTADDRESS && r->lhs_use_count) {
952 if (uniq == U_add_uniq_label)
953 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
954 "Label '%s' already defined\n", sub_name);
955 else if (uniq == U_add_uniq_sub) {
956 mem_sys_free(aux_name);
957 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
958 "Subroutine '%s' already defined\n", name);
959 }
960 }
961
962 r = _mk_symreg(imcc, hsh, sub_name, 0);
963 r->type = VTADDRESS;
964
965 if (uniq) {
966 r->lhs_use_count++;
967 if (uniq == U_add_uniq_sub)
968 mem_sys_free(aux_name);
969 }
970 }
971
972 return r;
973 }
974
975
976 /*
977
978 =item C<SymReg * mk_sub_label(imc_info_t * imcc, const char *name)>
979
980 Makes and stores a new address label for a sub. The label gets a fixup entry.
981
982 =cut
983
984 */
985
986 PARROT_WARN_UNUSED_RESULT
987 PARROT_CANNOT_RETURN_NULL
988 SymReg *
mk_sub_label(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))989 mk_sub_label(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
990 {
991 ASSERT_ARGS(mk_sub_label)
992 SymReg * const s = _mk_address(imcc, &imcc->ghash,
993 name, U_add_uniq_sub);
994
995 s->usage |= U_FIXUP;
996
997 return s;
998 }
999
1000
1001 /*
1002
1003 =item C<SymReg * mk_sub_address(imc_info_t * imcc, const char *name)>
1004
1005 Makes a symbol for a label. The symbol gets a fixup entry.
1006
1007 =cut
1008
1009 */
1010
1011 PARROT_WARN_UNUSED_RESULT
1012 PARROT_CANNOT_RETURN_NULL
1013 SymReg *
mk_sub_address(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1014 mk_sub_address(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
1015 {
1016 ASSERT_ARGS(mk_sub_address)
1017 SymReg * const s = _mk_address(imcc, &imcc->ghash,
1018 name, U_add_all);
1019
1020 s->usage |= U_FIXUP;
1021
1022 return s;
1023 }
1024
1025
1026 /*
1027
1028 =item C<SymReg * mk_local_label(imc_info_t * imcc, const char *name)>
1029
1030 Makes a local symbol, giving it I<no> fixup entry.
1031
1032 =cut
1033
1034 */
1035
1036 PARROT_WARN_UNUSED_RESULT
1037 PARROT_CANNOT_RETURN_NULL
1038 SymReg *
mk_local_label(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1039 mk_local_label(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
1040 {
1041 ASSERT_ARGS(mk_local_label)
1042 IMC_Unit * const unit = imcc->cur_unit;
1043 return _mk_address(imcc, &unit->hash, name, U_add_uniq_label);
1044 }
1045
1046
1047 /*
1048
1049 =item C<SymReg * mk_label_address(imc_info_t * imcc, const char *name)>
1050
1051 Makes a new label address.
1052
1053 =cut
1054
1055 */
1056
1057 PARROT_WARN_UNUSED_RESULT
1058 PARROT_CANNOT_RETURN_NULL
1059 SymReg *
mk_label_address(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1060 mk_label_address(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
1061 {
1062 ASSERT_ARGS(mk_label_address)
1063 IMC_Unit * const unit = imcc->cur_unit;
1064 return _mk_address(imcc, &unit->hash, name, U_add_once);
1065 }
1066
1067
1068 /*
1069
1070 =item C<SymReg * dup_sym(imc_info_t * imcc, const SymReg *r)>
1071
1072 Links keys to a keys structure = SymReg
1073
1074 we might have
1075
1076 what op type pbc.c:build_key()
1077 --------------------------------------------------
1078 int const _kic VTCONST no
1079 int reg _ki VTREG no
1080 str const _kc VTCONST yes
1081 str reg _kc VTREG yes
1082
1083 "key" ';' "key" _kc -> (list of above) yes
1084 "key" ';' $I0 _kc VTREGKEY -> (list of above) yes
1085
1086 The information about which reg should be passed to build_key() is
1087 in the instruction.
1088
1089 A key containing a variable has a special flag VTREGKEY
1090 because this key must be considered for life analysis for
1091 all the chain members, that are variables.
1092
1093 An instruction with a keychain looks like this
1094
1095 e.h. set I0, P["abc";0;I1]
1096
1097 ins->r[2] = keychain 'K'
1098 keychain->nextkey = SymReg(VTCONST) "abc"
1099 ->nextkey = SymReg(VTCONST) 0
1100 ->nextkey = SymReg(VTREG), ...->reg = VTVAR I1
1101 ->nextkey = 0
1102
1103 We can't use the consts or keys in the chain directly,
1104 because a different usage would destroy the ->nextkey pointers
1105 so these are all copies.
1106 XXX and currently not freed
1107
1108 =cut
1109
1110 */
1111
1112 PARROT_MALLOC
1113 PARROT_CANNOT_RETURN_NULL
1114 SymReg *
dup_sym(ARGMOD (imc_info_t * imcc),ARGIN (const SymReg * r))1115 dup_sym(ARGMOD(imc_info_t * imcc), ARGIN(const SymReg *r))
1116 {
1117 ASSERT_ARGS(dup_sym)
1118 SymReg * const new_sym = mem_gc_allocate_zeroed_typed(imcc->interp, SymReg);
1119 STRUCT_COPY(new_sym, r);
1120 if (r->name)
1121 new_sym->name = mem_sys_strdup(r->name);
1122
1123 if (r->nextkey)
1124 new_sym->nextkey = dup_sym(imcc, r->nextkey);
1125
1126 return new_sym;
1127 }
1128
1129
1130 /*
1131
1132 =item C<SymReg * link_keys(imc_info_t * imcc, int nargs, SymReg **keys, int
1133 force)>
1134
1135 Links keys together in a keychain.
1136
1137 =cut
1138
1139 */
1140
1141 PARROT_MALLOC
1142 PARROT_CANNOT_RETURN_NULL
1143 SymReg *
link_keys(ARGMOD (imc_info_t * imcc),int nargs,ARGMOD (SymReg ** keys),int force)1144 link_keys(ARGMOD(imc_info_t * imcc), int nargs, ARGMOD(SymReg **keys), int force)
1145 {
1146 ASSERT_ARGS(link_keys)
1147 char *key_str;
1148 SymReg *key;
1149 SymReg *keychain;
1150 int i;
1151 size_t len = 0;
1152
1153 /* namespace keys are global consts - no cur_unit */
1154 SymHash * const h = imcc->cur_unit ? &imcc->cur_unit->hash : &imcc->ghash;
1155
1156 if (nargs == 0)
1157 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "link_keys: huh? no keys\n");
1158
1159 /* short-circuit simple key unless we've been told not to */
1160 if (nargs == 1 && !force)
1161 return keys[0];
1162
1163 /* calc len of key_str
1164 * also check if this is a slice - the first key might not
1165 * have the slice flag set */
1166 for (i = 0; i < nargs; i++) {
1167 len += 1 + strlen(keys[i]->name);
1168 }
1169
1170 key_str = (char *)mem_sys_allocate(len);
1171 *key_str = '\0';
1172
1173 /* first look, if we already have this exact key chain */
1174 for (i = 0; i < nargs; i++) {
1175 strcat(key_str, keys[i]->name);
1176 /* TODO insert : to compare slices */
1177 if (i < nargs - 1)
1178 strcat(key_str, ";");
1179 }
1180
1181 if ((keychain = _get_sym(h, key_str)) != NULL) {
1182 mem_sys_free(key_str);
1183 return keychain;
1184 }
1185
1186 /* no, need a new one */
1187 keychain = mem_gc_allocate_zeroed_typed(imcc->interp, SymReg);
1188 keychain->type = VTCONST;
1189
1190 ++keychain->use_count;
1191
1192 key = keychain;
1193
1194 for (i = 0; i < nargs; i++) {
1195 /* if any component is a variable, we need to track it in
1196 * life analysis */
1197 if (REG_NEEDS_ALLOC(keys[i]))
1198 keychain->type |= VTREGKEY;
1199
1200 key->nextkey = dup_sym(imcc, keys[i]);
1201 key = key->nextkey;
1202
1203 /* for registers, point ->reg to the original, needed by
1204 * life analysis & coloring */
1205 if (REG_NEEDS_ALLOC(keys[i]))
1206 key->reg = keys[i];
1207 }
1208
1209 keychain->name = key_str;
1210 keychain->set = 'K';
1211 keychain->color = -1;
1212
1213 _store_symreg(imcc, h, keychain);
1214
1215 return keychain;
1216 }
1217
1218
1219 /*
1220
1221 =item C<void free_pcc_sub(pcc_sub_t *sub)>
1222
1223 Frees all memory of the given pcc_sub_t.
1224
1225 =cut
1226
1227 */
1228
1229 void
free_pcc_sub(ARGMOD (pcc_sub_t * sub))1230 free_pcc_sub(ARGMOD(pcc_sub_t *sub))
1231 {
1232 ASSERT_ARGS(free_pcc_sub)
1233
1234 mem_sys_free(sub->multi);
1235 mem_sys_free(sub->args);
1236 mem_sys_free(sub->arg_flags);
1237 mem_sys_free(sub->ret);
1238 mem_sys_free(sub->ret_flags);
1239 mem_sys_free(sub);
1240 }
1241
1242
1243 /*
1244
1245 =item C<void free_sym(SymReg *r)>
1246
1247 Frees all memory of the specified SymReg. If it has a pcc_sub_t entry, frees
1248 all memory of that structure as well.
1249
1250 =cut
1251
1252 */
1253
1254 void
free_sym(ARGMOD (SymReg * r))1255 free_sym(ARGMOD(SymReg *r))
1256 {
1257 ASSERT_ARGS(free_sym)
1258 pcc_sub_t * const sub = r->pcc_sub;
1259
1260 if (sub)
1261 free_pcc_sub(sub);
1262
1263 if (r->set == 'K') {
1264 SymReg *key = r->nextkey;
1265 while (key) {
1266 SymReg *nextkey = key->nextkey;
1267 free_sym(key);
1268 key = nextkey;
1269 }
1270 }
1271
1272 mem_sys_free(r->name);
1273 mem_sys_free(r);
1274 }
1275
1276 /*
1277 * This functions manipulate the hash of symbols.
1278 * XXX: Migrate to use Symbol and SymbolTable
1279 *
1280 */
1281
1282 /*
1283
1284 =item C<void create_symhash(imc_info_t * imcc, SymHash *hash)>
1285
1286 Creates a symbol hash table with space for 16 entries.
1287
1288 =cut
1289
1290 */
1291
1292 void
create_symhash(ARGMOD (imc_info_t * imcc),ARGOUT (SymHash * hash))1293 create_symhash(ARGMOD(imc_info_t * imcc), ARGOUT(SymHash *hash))
1294 {
1295 ASSERT_ARGS(create_symhash)
1296 hash->data = mem_gc_allocate_n_zeroed_typed(imcc->interp, 16, SymReg *);
1297 hash->size = 16;
1298 hash->entries = 0;
1299 }
1300
1301
1302 /*
1303
1304 =item C<static void resize_symhash(imc_info_t * imcc, SymHash *hsh)>
1305
1306 Resizes a symbol hash table.
1307
1308 =cut
1309
1310 */
1311
1312 static void
resize_symhash(ARGMOD (imc_info_t * imcc),ARGMOD (SymHash * hsh))1313 resize_symhash(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh))
1314 {
1315 ASSERT_ARGS(resize_symhash)
1316 const int new_size = hsh->size << 1; /* new size is twice as large */
1317 int n_next = 16;
1318 SymReg **next_r = mem_gc_allocate_n_zeroed_typed(imcc->interp, n_next, SymReg *);
1319 SymHash nh; /* new symbol table */
1320 unsigned int i;
1321
1322 nh.data = mem_gc_allocate_n_zeroed_typed(imcc->interp, new_size, SymReg *);
1323
1324 for (i = 0; i < hsh->size; i++) {
1325 SymReg *r, *next;
1326 int k;
1327 int j = 0;
1328
1329 for (r = hsh->data[i]; r; r = next) {
1330 next = r->next;
1331
1332 /* remember all the chained next pointers and clear r->next */
1333 if (j >= n_next) {
1334 n_next <<= 1;
1335 next_r = mem_gc_realloc_n_typed(imcc->interp, next_r, n_next, SymReg *);
1336 }
1337
1338 r->next = NULL;
1339 next_r[j++] = r;
1340 }
1341
1342 for (k = 0; k < j; ++k) {
1343 int new_i;
1344 r = next_r[k];
1345 /* recompute hash for this symbol: */
1346 new_i = hash_str(r->name) % new_size;
1347 r->next = nh.data[new_i];
1348 nh.data[new_i] = r;
1349 }
1350 }
1351
1352 /* free memory of old hash table */
1353 mem_sys_free(hsh->data);
1354 mem_sys_free(next_r);
1355
1356 /* let the hashtable's data pointers point to the new data */
1357 hsh->data = nh.data;
1358 hsh->size = new_size;
1359 }
1360
1361
1362 /*
1363
1364 =item C<void _store_symreg(imc_info_t * imcc, SymHash *hsh, SymReg *r)>
1365
1366 Stores a symbol in the hash (internal use only).
1367
1368 =cut
1369
1370 */
1371
1372 void
_store_symreg(ARGMOD (imc_info_t * imcc),ARGMOD (SymHash * hsh),ARGMOD (SymReg * r))1373 _store_symreg(ARGMOD(imc_info_t * imcc), ARGMOD(SymHash *hsh),
1374 ARGMOD(SymReg *r))
1375 {
1376 ASSERT_ARGS(_store_symreg)
1377 const int i = hash_str(r->name) % hsh->size;
1378 r->next = hsh->data[i];
1379 hsh->data[i] = r;
1380
1381 hsh->entries++;
1382
1383 if (hsh->entries >= hsh->size)
1384 resize_symhash(imcc, hsh);
1385 }
1386
1387
1388 /*
1389
1390 =item C<void store_symreg(imc_info_t * imcc, SymReg *r)>
1391
1392 Stores a symbol in the hash.
1393
1394 =cut
1395
1396 */
1397
1398 void
store_symreg(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r))1399 store_symreg(ARGMOD(imc_info_t * imcc), ARGMOD(SymReg *r))
1400 {
1401 ASSERT_ARGS(store_symreg)
1402 _store_symreg(imcc, &imcc->cur_unit->hash, r);
1403 }
1404
1405
1406 /*
1407
1408 =item C<SymReg * _get_sym(const SymHash *hsh, const char *name)>
1409
1410 Fetches a symbol from the hash (internal use only).
1411
1412 =cut
1413
1414 */
1415
1416 PARROT_CAN_RETURN_NULL
1417 PARROT_WARN_UNUSED_RESULT
1418 SymReg *
_get_sym(ARGIN (const SymHash * hsh),ARGIN (const char * name))1419 _get_sym(ARGIN(const SymHash *hsh), ARGIN(const char *name))
1420 {
1421 ASSERT_ARGS(_get_sym)
1422 SymReg *p;
1423 const unsigned int i = hash_str(name) % hsh->size;
1424
1425 for (p = hsh->data[i]; p; p = p->next) {
1426 if (STREQ(name, p->name))
1427 return p;
1428 }
1429
1430 return NULL;
1431 }
1432
1433 /*
1434
1435 =item C<SymReg * get_sym(imc_info_t * imcc, const char *name)>
1436
1437 Gets a symbol from the current unit's symbol table.
1438
1439 =cut
1440
1441 */
1442
1443 PARROT_CAN_RETURN_NULL
1444 PARROT_WARN_UNUSED_RESULT
1445 SymReg *
get_sym(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1446 get_sym(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
1447 {
1448 ASSERT_ARGS(get_sym)
1449 return _get_sym(&imcc->cur_unit->hash, name);
1450 }
1451
1452
1453 /*
1454
1455 =item C<SymReg * _find_sym(imc_info_t * imcc, const Namespace *nspace, const
1456 SymHash *hsh, const char *name)>
1457
1458 Find a symbol hash or ghash (internal use only);
1459
1460 =cut
1461
1462 */
1463
1464 PARROT_CAN_RETURN_NULL
1465 PARROT_WARN_UNUSED_RESULT
1466 SymReg *
_find_sym(ARGMOD (imc_info_t * imcc),ARGIN_NULLOK (const Namespace * nspace),ARGIN (const SymHash * hsh),ARGIN (const char * name))1467 _find_sym(ARGMOD(imc_info_t * imcc), ARGIN_NULLOK(const Namespace *nspace),
1468 ARGIN(const SymHash *hsh), ARGIN(const char *name))
1469 {
1470 ASSERT_ARGS(_find_sym)
1471 const Namespace *ns;
1472 SymReg *p;
1473
1474 for (ns = nspace; ns; ns = ns->parent) {
1475 char * const fullname = _mk_fullname(imcc, ns, name);
1476 p = _get_sym(hsh, fullname);
1477
1478 mem_sys_free(fullname);
1479
1480 if (p)
1481 return p;
1482 }
1483
1484 p = _get_sym(hsh, name);
1485
1486 if (p)
1487 return p;
1488
1489 p = _get_sym(&imcc->ghash, name);
1490
1491 if (p)
1492 return p;
1493
1494 return NULL;
1495 }
1496
1497
1498 /*
1499
1500 =item C<SymReg * find_sym(imc_info_t * imcc, const char *name)>
1501
1502 Finds a symbol hash or ghash in the current unit, if it exists. Otherwise
1503 returns NULL.
1504
1505 =cut
1506
1507 */
1508
1509 PARROT_CAN_RETURN_NULL
1510 PARROT_WARN_UNUSED_RESULT
1511 SymReg *
find_sym(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1512 find_sym(ARGMOD(imc_info_t * imcc), ARGIN(const char *name))
1513 {
1514 ASSERT_ARGS(find_sym)
1515 if (imcc->cur_unit)
1516 return _find_sym(imcc, NULL, &imcc->cur_unit->hash,
1517 name);
1518
1519 return NULL;
1520 }
1521
1522
1523 /*
1524
1525 =item C<void clear_sym_hash(SymHash *hsh)>
1526
1527 Frees all memory of the symbols in the specified hash table.
1528
1529 =cut
1530
1531 */
1532
1533 void
clear_sym_hash(ARGMOD (SymHash * hsh))1534 clear_sym_hash(ARGMOD(SymHash *hsh))
1535 {
1536 ASSERT_ARGS(clear_sym_hash)
1537 unsigned int i;
1538
1539 if (!hsh->data)
1540 return;
1541
1542 for (i = 0; i < hsh->size; i++) {
1543 SymReg *p;
1544 for (p = hsh->data[i]; p;) {
1545 SymReg * const next = p->next;
1546 free_sym(p);
1547 p = next;
1548 }
1549
1550 hsh->data[i] = NULL;
1551 }
1552
1553 mem_sys_free(hsh->data);
1554
1555 hsh->data = NULL;
1556 hsh->entries = 0;
1557 hsh->size = 0;
1558 }
1559
1560
1561 /*
1562
1563 =item C<void clear_locals(IMC_Unit *unit)>
1564
1565 Deletes all local symbols and clears life info from the given IMC_Unit.
1566
1567 =cut
1568
1569 */
1570
1571 void
clear_locals(ARGIN_NULLOK (IMC_Unit * unit))1572 clear_locals(ARGIN_NULLOK(IMC_Unit *unit))
1573 {
1574 ASSERT_ARGS(clear_locals)
1575 SymHash * const hsh = &unit->hash;
1576 unsigned int i;
1577
1578 for (i = 0; i < hsh->size; i++) {
1579 SymReg *p;
1580
1581 for (p = hsh->data[i]; p;) {
1582 SymReg * const next = p->next;
1583 free_sym(p);
1584 p = next;
1585 }
1586
1587 hsh->data[i] = NULL;
1588 }
1589
1590 hsh->entries = 0;
1591 }
1592
1593
1594 /*
1595
1596 =item C<void clear_globals(imc_info_t * imcc)>
1597
1598 Clears global symbols.
1599
1600 =cut
1601
1602 */
1603
1604 void
clear_globals(ARGMOD (imc_info_t * imcc))1605 clear_globals(ARGMOD(imc_info_t * imcc))
1606 {
1607 ASSERT_ARGS(clear_globals)
1608 SymHash * const hsh = &imcc->ghash;
1609
1610 if (hsh->data)
1611 clear_sym_hash(hsh);
1612 }
1613
1614
1615 /* utility functions: */
1616
1617 /*
1618
1619 =item C<unsigned int hash_str(const char *str)>
1620
1621 Computes the hash value for the string argument.
1622
1623 =cut
1624
1625 */
1626
1627 PARROT_PURE_FUNCTION
1628 unsigned int
hash_str(ARGIN (const char * str))1629 hash_str(ARGIN(const char *str))
1630 {
1631 ASSERT_ARGS(hash_str)
1632 unsigned long key = 0;
1633 const char *s;
1634
1635 for (s = str; *s; s++)
1636 key = key * 65599 + *s;
1637
1638 return key;
1639 }
1640
1641
1642 /*
1643
1644 =back
1645
1646 =cut
1647
1648 */
1649
1650 /*
1651 * Local variables:
1652 * c-file-style: "parrot"
1653 * End:
1654 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
1655 */
1656