1 /****************************************************************************
2 * Copyright (C) 2009-2011 by Matteo Franchin *
3 * *
4 * This file is part of Box. *
5 * *
6 * Box is free software: you can redistribute it and/or modify it *
7 * under the terms of the GNU Lesser General Public License as published *
8 * by the Free Software Foundation, either version 3 of the License, or *
9 * (at your option) any later version. *
10 * *
11 * Box is distributed in the hope that it will be useful, *
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
14 * GNU Lesser General Public License for more details. *
15 * *
16 * You should have received a copy of the GNU Lesser General Public *
17 * License along with Box. If not, see <http://www.gnu.org/licenses/>. *
18 ****************************************************************************/
19
20 #include <stdlib.h>
21 #include <assert.h>
22
23 #include "types.h"
24 #include "mem.h"
25 #include "print.h"
26 #include "messages.h"
27 #include "container.h"
28 #include "value.h"
29 #include "vmsymstuff.h"
30 #include "combs.h"
31
32 #include "compiler_priv.h"
33
34
35 /* FIXME: there is a flaw in the design of the Value datastructure.
36 * We keep track of references to Value objects, but we shouldn't do this.
37 * We should rather keep track of resources used by Value objects.
38 * For example, we should keep track of registers used by a Value object
39 * (i.e. keep a reference counter for registers, so that we know how many
40 * Value-s are referring to a given register). I think this should simplify
41 * considerably the compiler code and should make the code cleaner.
42 * The notion of weak copy of a Value should then become unnecessary.
43 * Moreover, Value will become much simpler to use: one should need just to
44 * use them as ordinary objects (remember to call _Init and _Finish methods
45 * properly), rather than having to define how many reference counts every
46 * function consumes, etc...
47 * We should redesign registers.c and value.c with this in mind and also
48 * paying attention to make sure we are not initialising and destroying
49 * continuously BoxArr objects for every couple of [ ] the compiler
50 * encounters.
51 */
Value_Init(Value * v,BoxVMCode * proc)52 void Value_Init(Value *v, BoxVMCode *proc) {
53 v->proc = proc;
54 v->kind = VALUEKIND_ERR;
55 v->type = NULL;
56 v->name = NULL;
57 v->attr.new_or_init = 0;
58 v->attr.own_register = 0;
59 v->attr.ignore = 0;
60 v->num_ref = 1;
61 }
62
Value_Create(BoxVMCode * proc)63 Value *Value_Create(BoxVMCode *proc) {
64 Value *v = Box_Mem_Safe_Alloc(sizeof(Value));
65 Value_Init(v, proc);
66 v->attr.new_or_init = 1;
67 return v;
68 }
69
My_Value_Finalize(Value * v)70 static void My_Value_Finalize(Value *v) {
71 if (v->name != NULL)
72 Box_Mem_Free(v->name);
73
74 switch(v->kind) {
75 case VALUEKIND_ERR:
76 case VALUEKIND_TYPE_NAME:
77 case VALUEKIND_VAR_NAME:
78 case VALUEKIND_TYPE:
79 case VALUEKIND_IMM:
80 return;
81
82 case VALUEKIND_TARGET:
83 case VALUEKIND_TEMP:
84 switch (v->value.cont.categ) {
85 case BOXCONTCATEG_LREG:
86 if (v->attr.own_register) {
87 if (v->value.cont.value.reg >= 0)
88 Reg_Release(& v->proc->reg_alloc,
89 v->value.cont.type, v->value.cont.value.reg);
90 }
91 return;
92
93 case BOXCONTCATEG_GREG:
94 return;
95
96 case BOXCONTCATEG_PTR:
97 if (v->attr.own_register) {
98 assert(!v->value.cont.value.ptr.is_greg);
99 Reg_Release(& v->proc->reg_alloc,
100 BOXTYPEID_OBJ, v->value.cont.value.ptr.reg);
101 }
102 return;
103
104 default:
105 MSG_WARNING("My_Value_Finalize: Destruction not implemented!");
106 return;
107 }
108 }
109 }
110
Value_Unlink(Value * v)111 void Value_Unlink(Value *v) {
112 if (v) {
113 if (v->num_ref > 1)
114 --v->num_ref;
115
116 else {
117 assert(v->num_ref == 1);
118 My_Value_Finalize(v);
119 v->num_ref = 0;
120 if (v->attr.new_or_init)
121 Box_Mem_Free(v);
122 }
123 }
124 }
125
Value_Link(Value * v)126 void Value_Link(Value *v) {
127 v->num_ref += 1;
128 }
129
130 /* Determine if the given value can be recycled, otherwise return Value_New()
131 * REFERENCES: return: new, v: -1;
132 */
Value_Recycle(Value * v)133 Value *Value_Recycle(Value *v) {
134 BoxVMCode *proc = v->proc->cmp->cur_proc; /* Be careful! We want to operate on
135 the cur_proc, not the proc of the
136 old value!!! */
137 if (v->num_ref == 1) {
138 /* one reference means nobody else owns the object, so we can do
139 * whatever we want with it!
140 */
141 int new_or_init = v->attr.new_or_init;
142 Value_Init(v, proc);
143 v->attr.new_or_init = new_or_init;
144 Value_Link(v); /* XXX this seems to be wrong to me */
145 return v;
146
147 } else
148 return Value_New(proc);
149 }
150
ValueKind_To_Str(ValueKind vk)151 const char *ValueKind_To_Str(ValueKind vk) {
152 switch(vk) {
153 case VALUEKIND_ERR: return "an error expression";
154 case VALUEKIND_VAR_NAME: return "an undefined variable";
155 case VALUEKIND_TYPE_NAME: return "an undefined type";
156 case VALUEKIND_TYPE: return "a type expression";
157 case VALUEKIND_IMM: return "a constant expression";
158 case VALUEKIND_TEMP: return "an intermediate expression";
159 case VALUEKIND_TARGET: return "a target expression";
160 default: return "??? (unknown value kind)";
161 }
162 }
163
Value_Want(Value * v,int num_wanted,ValueKind * wanted)164 int Value_Want(Value *v, int num_wanted, ValueKind *wanted) {
165 char *wanted_str = NULL;
166 int i;
167
168 for(i = 0; i < num_wanted; i++)
169 if (v->kind == wanted[i]) return 1;
170
171 for(i = 0; i < num_wanted; i++) {
172 if (i == 0)
173 wanted_str = printdup("%s", ValueKind_To_Str(wanted[i]));
174 else {
175 char *sep = (i < num_wanted - 1) ? ", " : " or ";
176 wanted_str = printdup("%~s%s%s", wanted_str, sep,
177 ValueKind_To_Str(wanted[i]));
178 }
179 }
180
181 MSG_ERROR("Expected %~s, but got %s.",
182 wanted_str, ValueKind_To_Str(v->kind));
183 return 0;
184 }
185
Value_Want_Value(Value * v)186 int Value_Want_Value(Value *v) {
187 if (Value_Is_Value(v))
188 return 1;
189
190 else if (Value_Is_Err(v)) {
191 return 0;
192
193 } else {
194 if (v->name != NULL) {
195 MSG_ERROR("'%s' is undefined: an expression with both value and type is"
196 " expected here.", v->name);
197 } else {
198 MSG_ERROR("Got '%s', but an expression with both value and type is "
199 "expected here.", ValueKind_To_Str(v->kind));
200 }
201 return 0;
202 }
203 }
204
Value_Want_Has_Type(Value * v)205 int Value_Want_Has_Type(Value *v) {
206 if (Value_Has_Type(v))
207 return 1;
208
209 else if (Value_Is_Err(v)) {
210 return 0;
211
212 } else {
213 if (v->name != NULL) {
214 MSG_ERROR("'%s' is undefined: an expression with defined type is "
215 "expected here.", v->name);
216 } else {
217 MSG_ERROR("Got '%s', but an expression with defined type is "
218 "expected here.", ValueKind_To_Str(v->kind));
219 }
220 return 0;
221 }
222 }
223
224 /** Whether we can change the content of the register associated with v
225 * (if any).
226 */
My_Value_Can_Reuse_Reg(Value * v)227 static int My_Value_Can_Reuse_Reg(Value *v) {
228 return v->num_ref == 1 && v->attr.own_register;
229 }
230
Value_Setup_As_Weak_Copy(Value * v_copy,Value * v)231 void Value_Setup_As_Weak_Copy(Value *v_copy, Value *v) {
232 v_copy->proc = v->proc;
233 v_copy->kind = v->kind;
234 v_copy->type = BoxType_Link(v->type);
235 v_copy->value.cont = v->value.cont;
236 v_copy->name = (v->name == NULL) ? NULL : Box_Mem_Strdup(v->name);
237 v_copy->attr.own_register = 0;
238 v_copy->attr.ignore = 0;
239 }
240
Value_Setup_As_Var_Name(Value * v,const char * name)241 void Value_Setup_As_Var_Name(Value *v, const char *name) {
242 v->kind = VALUEKIND_VAR_NAME;
243 v->name = Box_Mem_Strdup(name);
244 }
245
Value_Setup_As_Type_Name(Value * v,const char * name)246 void Value_Setup_As_Type_Name(Value *v, const char *name) {
247 v->kind = VALUEKIND_TYPE_NAME;
248 v->name = Box_Mem_Strdup(name);
249 }
250
Value_Setup_As_Type(Value * v,BoxType * t)251 void Value_Setup_As_Type(Value *v, BoxType *t) {
252 v->kind = VALUEKIND_TYPE;
253 v->type = BoxType_Link(t);
254 v->value.cont.type = BoxType_Get_Cont_Type(v->type);
255 }
256
Value_Setup_As_Imm_Char(Value * v,BoxChar c)257 void Value_Setup_As_Imm_Char(Value *v, BoxChar c) {
258 v->kind = VALUEKIND_IMM;
259 v->type = BoxType_Link(Box_Get_Core_Type(BOXTYPEID_CHAR));
260 BoxCont_Set(& v->value.cont, "ic", c);
261 }
262
Value_Setup_As_Imm_Int(Value * v,BoxInt i)263 void Value_Setup_As_Imm_Int(Value *v, BoxInt i) {
264 v->kind = VALUEKIND_IMM;
265 v->type = BoxType_Link(Box_Get_Core_Type(BOXTYPEID_SINT));
266 BoxCont_Set(& v->value.cont, "ii", i);
267 }
268
Value_Setup_As_Imm_Real(Value * v,BoxReal r)269 void Value_Setup_As_Imm_Real(Value *v, BoxReal r) {
270 v->kind = VALUEKIND_IMM;
271 v->type = BoxType_Link(Box_Get_Core_Type(BOXTYPEID_SREAL));
272 BoxCont_Set(& v->value.cont, "ir", r);
273 }
274
Value_Setup_As_Void(Value * v)275 void Value_Setup_As_Void(Value *v) {
276 v->kind = VALUEKIND_IMM;
277 v->type = BoxType_Link(Box_Get_Core_Type(BOXTYPEID_VOID));
278 v->value.cont.type = BOXCONTTYPE_VOID;
279 }
280
Value_Setup_As_Temp(Value * v,BoxType * t)281 void Value_Setup_As_Temp(Value *v, BoxType *t) {
282 ValContainer vc = {VALCONTTYPE_LREG, -1, 0};
283 Value_Setup_Container(v, t, & vc);
284 Value_Emit_Allocate(v);
285 }
286
BoxValue_Setup_As_Var(BoxValue * v,BoxType * t)287 void BoxValue_Setup_As_Var(BoxValue *v, BoxType *t) {
288 BoxCmp *c = v->proc->cmp;
289 BoxVMCode *p = c->cur_proc;
290 if (BoxVMCode_Get_Style(p) == BOXVMCODESTYLE_MAIN) {
291 /* We are creating the main procedure so variables should get into global
292 * registers
293 */
294 ValContainer vc = {VALCONTTYPE_GVAR, -1, 0};
295 Value_Setup_Container(v, t, & vc);
296
297 } else {
298 /* We are not in the main: variables should go into local registers */
299 ValContainer vc = {VALCONTTYPE_LVAR, -1, 0};
300 Value_Setup_Container(v, t, & vc);
301 }
302 }
303
Value_Setup_As_String(Value * v_str,const char * str)304 void Value_Setup_As_String(Value *v_str, const char *str) {
305 BoxTask success;
306 BoxCmp *c = v_str->proc->cmp;
307 size_t len, addr;
308 Value v_str_data;
309 ValContainer vc = {VALCONTTYPE_GPTR, 0, 0};
310
311 len = strlen(str) + 1;
312 addr = BoxVM_Data_Add(c->vm, str, len, BOXTYPEID_OBJ);
313 assert(addr >= 0);
314
315 vc.addr = addr;
316 Value_Init(& v_str_data, v_str->proc);
317 Value_Setup_Container(& v_str_data, Box_Get_Core_Type(BOXTYPEID_OBJ), & vc);
318
319 Value_Setup_As_Temp(v_str, Box_Get_Core_Type(BOXTYPEID_STR));
320
321 Value_Unlink(Value_Emit_Call(v_str, & v_str_data, & success));
322 if (success != BOXTASK_OK) {
323 MSG_FATAL("Value_Setup_As_String: Failure while emitting string.");
324 assert(0);
325 }
326 }
327
328 /* Create a new empty container. */
Value_Setup_Container(Value * v,BoxType * type,ValContainer * vc)329 void Value_Setup_Container(Value *v, BoxType *type, ValContainer *vc) {
330 RegAlloc *ra = & v->proc->reg_alloc;
331 int use_greg;
332
333 v->type = BoxType_Link(type);
334 v->value.cont.type = BoxType_Get_Cont_Type(v->type);
335
336 switch(vc->type_of_container) {
337 case VALCONTTYPE_IMM:
338 v->kind = VALUEKIND_IMM;
339 v->value.cont.categ = BOXCONTCATEG_IMM;
340 return; break;
341
342 case VALCONTTYPE_LREG:
343 v->kind = VALUEKIND_TEMP;
344 v->value.cont.categ = BOXCONTCATEG_LREG;
345 if (vc->which_one < 0) {
346 /* Automatically chooses the local register.
347 NOTE: if cont.type == BOXTYPEID_VOID this function returns 0, meaning
348 that for this type there is no need for registers. */
349 BoxInt reg = Reg_Occupy(ra, v->value.cont.type);
350 assert(reg >= 0);
351 v->value.cont.value.reg = reg;
352 v->attr.own_register = (reg > 0);
353 return;
354
355 } else {
356 /* The user wants a particular register to be chosen */
357 v->value.cont.value.reg = vc->which_one;
358 return;
359 }
360 break;
361
362 case VALCONTTYPE_GVAR:
363 v->kind = VALUEKIND_TARGET;
364 v->value.cont.categ = BOXCONTCATEG_GREG;
365 if (vc->which_one < 0) {
366 BoxInt reg = -GVar_Occupy(ra, v->value.cont.type);
367 /* Automatically choses the local variables */
368 assert(reg <= 0);
369 v->value.cont.value.reg = reg;
370 return;
371
372 } else {
373 /* The user wants a particolar variable to be chosen */
374 v->value.cont.value.reg = vc->which_one;
375 return;
376 }
377 break;
378
379 case VALCONTTYPE_LVAR:
380 v->kind = VALUEKIND_TARGET;
381 v->value.cont.categ = BOXCONTCATEG_LREG;
382 if (vc->which_one < 0) {
383 /* Automatically choses the local variables */
384 BoxInt reg = -Var_Occupy(ra, v->value.cont.type, 0);
385 assert(reg <= 0);
386 v->value.cont.value.reg = reg;
387 return;
388
389 } else {
390 /* The user wants a particolar variable to be chosen */
391 v->value.cont.value.reg = vc->which_one;
392 return;
393 }
394 break;
395
396 case VALCONTTYPE_GREG:
397 v->value.cont.categ = BOXCONTCATEG_GREG;
398 v->value.cont.value.reg = vc->which_one;
399 return;
400 break;
401
402 case VALCONTTYPE_GPTR:
403 case VALCONTTYPE_LRPTR:
404 case VALCONTTYPE_LVPTR:
405 use_greg = (vc->type_of_container == VALCONTTYPE_GPTR);
406 v->kind = VALUEKIND_TARGET;
407 v->value.cont.categ = BOXCONTCATEG_PTR;
408 v->value.cont.value.ptr.is_greg = use_greg;
409 v->value.cont.value.ptr.reg = vc->which_one;
410 v->value.cont.value.ptr.offset = vc->addr;
411 if (use_greg || vc->addr >= 0) return;
412
413 if (vc->type_of_container == VALCONTTYPE_LRPTR) {
414 BoxInt reg = Reg_Occupy(ra, BOXTYPEID_OBJ);
415 v->value.cont.value.ptr.reg = reg;
416 assert(reg >= 1);
417 return;
418
419 } else {
420 BoxInt reg = -Var_Occupy(ra, BOXTYPEID_OBJ, 0);
421 v->value.cont.value.ptr.reg = reg;
422 assert(reg < 0);
423 }
424
425 return;
426 break;
427
428 default:
429 MSG_FATAL("Value_Setup_Container: wrong type of container!");
430 assert(0);
431 }
432 }
433
434 /* Create a new local register value. */
Value_Setup_As_LReg(Value * v,BoxType * type)435 void Value_Setup_As_LReg(Value *v, BoxType *type) {
436 ValContainer vc = {VALCONTTYPE_LREG, -1, 0};
437 Value_Setup_Container(v, type, & vc);
438 }
439
BoxValue_Emit_Allocate(BoxValue * v)440 void BoxValue_Emit_Allocate(BoxValue *v) {
441 switch(v->kind) {
442 case VALUEKIND_ERR:
443 return;
444 case VALUEKIND_TEMP:
445 case VALUEKIND_TARGET:
446 if (v->value.cont.type == BOXCONTTYPE_OBJ) {
447 BoxCmp *c = v->proc->cmp;
448 BoxVMCode *proc = c->cur_proc;
449 BoxTypeId type_id = BoxVM_Install_Type(c->vm, v->type);
450
451 /* The 'create' instruction automatically invokes the creator
452 * when necessary
453 */
454 Value v_type_id;
455 Value_Init(& v_type_id, proc);
456 Value_Setup_As_Imm_Int(& v_type_id, (BoxInt) type_id);
457 BoxVMCode_Assemble(proc, BOXGOP_CREATE,
458 2, & v->value.cont, & v_type_id.value.cont);
459 }
460 return;
461
462 default:
463 MSG_FATAL("Value_Emit_Allocate: invalid argument (%s).",
464 ValueKind_To_Str(v->kind));
465 assert(0);
466 }
467 }
468
469 /* Doesn't unlink v, for coherence with Value_Emit_Unlink. */
Value_Emit_Link(Value * v)470 void Value_Emit_Link(Value *v) {
471 BoxTypeId cont_type = v->value.cont.type;
472 if (cont_type == BOXTYPEID_OBJ || cont_type == BOXTYPEID_PTR) {
473 assert(v->value.cont.categ == BOXCONTCATEG_LREG
474 || v->value.cont.categ == BOXCONTCATEG_GREG);
475 /* ^^^ for now we don't support the general case... */
476 BoxVMCode_Assemble(v->proc, BOXGOP_MLN, 1, & v->value.cont);
477 }
478 }
479
480 /* Doesn't unlink v, since the function is called by Value_Unlink in the
481 * finalisation.
482 */
Value_Emit_Unlink(Value * v)483 void Value_Emit_Unlink(Value *v) {
484 BoxTypeId cont_type = v->value.cont.type;
485 if (cont_type == BOXTYPEID_OBJ || cont_type == BOXTYPEID_PTR) {
486 assert(v->value.cont.categ == BOXCONTCATEG_LREG
487 || v->value.cont.categ == BOXCONTCATEG_GREG);
488 /* ^^^ for now we don't support the general case... */
489 BoxVMCode_Assemble(v->proc, BOXGOP_MUNLN, 1, & v->value.cont);
490 }
491 }
492
493 /* REFERENCES: v: -1 */
Value_Emit_CJump(Value * v,BoxVMSymID jump_label)494 void Value_Emit_CJump(Value *v, BoxVMSymID jump_label) {
495 BoxCmp *c = v->proc->cmp;
496 BoxVMCode_Assemble_CJump(c->cur_proc, jump_label, & v->value.cont);
497 Value_Unlink(v);
498 }
499
500 /* REFERENCES: return: new, v_ptr: -1; */
Value_To_Temp(Value * v)501 Value *Value_To_Temp(Value *v) {
502 ValContainer vc = {VALCONTTYPE_LREG, -1, 0};
503 BoxCmp *c = v->proc->cmp;
504
505 switch (v->kind) {
506 case VALUEKIND_ERR:
507 case VALUEKIND_TEMP:
508 Value_Link(v);
509 return v;
510
511 case VALUEKIND_VAR_NAME:
512 case VALUEKIND_TYPE_NAME:
513 MSG_ERROR("Got %s ('%s'), but a defined type or value is expected here!",
514 ValueKind_To_Str(v->kind), v->name);
515 return Value_Recycle(v); /* Return an error value (Value_Recycle
516 leaves v with an error, if not initialised
517 with a Value_Setup_* function) */
518
519 case VALUEKIND_TYPE:
520 {
521 BoxType *t = BoxType_Link(v->type);
522 v = Value_Recycle(v);
523 Value_Setup_Container(v, t, & vc);
524 (void) BoxType_Unlink(t);
525 Value_Emit_Allocate(v);
526 return v;
527 }
528
529 case VALUEKIND_IMM:
530 case VALUEKIND_TARGET:
531 {
532 BoxType *t = BoxType_Link(v->type);
533 BoxCont cont = v->value.cont;
534 v = Value_Recycle(v);
535 Value_Setup_Container(v, t, & vc);
536 (void) BoxType_Unlink(t);
537 BoxVMCode_Assemble(c->cur_proc, BOXGOP_MOV,
538 2, & v->value.cont, & cont);
539 return v;
540 }
541 }
542
543 assert(0);
544 return NULL;
545 }
546
Value_To_Temp_Or_Target(Value * v)547 Value *Value_To_Temp_Or_Target(Value *v) {
548 if (v->kind == VALUEKIND_TARGET) {
549 Value_Link(v);
550 return v;
551
552 } else
553 return Value_To_Temp(v);
554 }
555
Value_Promote_Temp_To_Target(Value * v)556 Value *Value_Promote_Temp_To_Target(Value *v) {
557 if (v->kind == VALUEKIND_TEMP)
558 v->kind = VALUEKIND_TARGET;
559 return v;
560 }
561
Value_Set_Ignorable(Value * v,int ignorable)562 void Value_Set_Ignorable(Value *v, int ignorable) {
563 v->attr.ignore = ignorable;
564 }
565
Value_Is_Err(Value * v)566 int Value_Is_Err(Value *v) {
567 return (v->kind == VALUEKIND_ERR);
568 }
569
Value_Is_Temp(Value * v)570 int Value_Is_Temp(Value *v) {
571 return (v->kind == VALUEKIND_TEMP);
572 }
573
BoxValue_Is_Var_Name(BoxValue * v)574 BoxBool BoxValue_Is_Var_Name(BoxValue *v) {
575 return (v->kind == VALUEKIND_VAR_NAME);
576 }
577
Value_Is_Type_Name(Value * v)578 int Value_Is_Type_Name(Value *v) {
579 return (v->kind == VALUEKIND_TYPE_NAME);
580 }
581
Value_Is_Target(Value * v)582 int Value_Is_Target(Value *v) {
583 return (v->kind == VALUEKIND_TARGET);
584 }
585
Value_Is_Value(Value * v)586 int Value_Is_Value(Value *v) {
587 switch(v->kind) {
588 case VALUEKIND_IMM: case VALUEKIND_TEMP: case VALUEKIND_TARGET:
589 return 1;
590 default:
591 return 0;
592 }
593 }
594
Value_Is_Ignorable(Value * v)595 int Value_Is_Ignorable(Value *v) {
596 int ignore = (v->kind == VALUEKIND_ERR)
597 || (v->kind == VALUEKIND_TYPE)
598 || v->attr.ignore;
599 if (ignore)
600 return 1;
601
602 else if (Value_Is_Value(v))
603 return (BoxType_Compare(Box_Get_Core_Type(BOXTYPEID_VOID), v->type)
604 != BOXTYPECMP_DIFFERENT);
605
606 else
607 return 0;
608 }
609
Value_Has_Type(Value * v)610 int Value_Has_Type(Value *v) {
611 switch(v->kind) {
612 case VALUEKIND_TYPE_NAME:
613 case VALUEKIND_VAR_NAME:
614 case VALUEKIND_ERR:
615 return 0;
616 default:
617 return 1;
618 }
619 }
620
621 /**
622 *
623 */
Value_Cast_To_Ptr_2(Value * v)624 Value *Value_Cast_To_Ptr_2(Value *v) {
625 BoxCmp *c = v->proc->cmp;
626 BoxContCateg v_categ = v->value.cont.categ;
627 switch (v->value.cont.type) {
628 case BOXCONTTYPE_OBJ:
629 if (v_categ != BOXCONTCATEG_PTR) {
630 assert(v_categ == BOXCONTCATEG_LREG || v_categ == BOXCONTCATEG_GREG);
631 return v;
632
633 } else {
634 /* v_categ == BOXCONTCATEG_PTR */
635 BoxBool is_greg = v->value.cont.value.ptr.is_greg;
636 BoxInt reg = v->value.cont.value.ptr.reg,
637 offset = v->value.cont.value.ptr.offset;
638 BoxCont cont, *cont_src;
639 Value *v_unlink = NULL;
640
641 if (offset == 0) {
642 /* When offset == 0, we do not need to allocate a new register. We just
643 * need to convert the ``o[reg + 0]'' value into a simple ``reg''
644 * value.
645 */
646 if (v->num_ref == 1) {
647 cont_src = & v->value.cont;
648 } else {
649 assert(v->num_ref > 1);
650 v_unlink = v;
651 v = Value_Create(v->proc);
652 Value_Setup_As_Weak_Copy(v, v_unlink);
653 cont_src = & v->value.cont;
654 }
655 } else {
656 /* When offset != 0, we need to increment the pointer in v. */
657 if (v->num_ref == 1 && v->attr.own_register) {
658 assert(!is_greg);
659 cont_src = & v->value.cont;
660 } else {
661 assert(v->num_ref >= 1);
662 v_unlink = v;
663 v = Value_Create(v->proc);
664 Value_Setup_As_LReg(v, v_unlink->type);
665 cont_src = & cont;
666 }
667 }
668
669 /* Set cont_src to the register containing the base address. */
670 cont_src->categ = (is_greg) ? BOXCONTCATEG_GREG : BOXCONTCATEG_LREG;
671 cont_src->type = BOXCONTTYPE_OBJ;
672 cont_src->value.reg = reg;
673
674 /* Obtain the destination register as base address plus offset. */
675 if (offset != 0) {
676 Value *v_offs = Value_Create(c->cur_proc);
677 Value_Setup_As_Imm_Int(v_offs, offset);
678 BoxVMCode_Assemble(c->cur_proc, BOXGOP_ADD,
679 3, & v->value.cont, & v_offs->value.cont, cont_src);
680 Value_Unlink(v_offs);
681 }
682
683 if (v_unlink)
684 Value_Unlink(v_unlink);
685 return v;
686 }
687 break;
688
689 case BOXCONTTYPE_PTR:
690 return v;
691
692 default:
693 /* Deal with the fast types by creating a NULL-block pointer. */
694 {
695 Value *v_unlink = v;
696 v = Value_Create(c->cur_proc);
697 Value_Setup_As_Temp(v, Box_Get_Core_Type(BOXTYPEID_PTR));
698 BoxVMCode_Assemble(c->cur_proc, BOXGOP_LEA,
699 2, & v->value.cont, & v_unlink->value.cont);
700 Value_Unlink(v_unlink);
701 return v;
702 }
703 }
704
705 return NULL;
706 }
707
708 /**
709 * @brief Weak expansion to a weak boxed type (BoxAny).
710 */
711 static Value *
My_Value_Weak_Box(Value * src)712 My_Value_Weak_Box(Value *src) {
713 BoxType *t_src = src->type;
714 BoxType *t_dst = Box_Get_Core_Type(BOXTYPEID_ANY);
715 BoxCont ri0, src_type_id_cont;
716 BoxCmp *cmp = src->proc->cmp;
717 BoxVMCode *cur_proc = cmp->cur_proc;
718 BoxTypeId src_type_id = BoxVM_Install_Type(cmp->vm, src->type);
719 Value *v_dst = Value_Create(cur_proc);
720
721 if (t_src == t_dst)
722 return src;
723
724 t_src = BoxType_Resolve(t_src,
725 BOXTYPERESOLVE_IDENT | BOXTYPERESOLVE_SPECIES, 0);
726
727 if (t_src == t_dst)
728 return src;
729
730 assert(BoxType_Get_Class(t_dst) == BOXTYPECLASS_ANY);
731
732
733 /* Set up a container representing the register ri0 and one representing
734 * the type integer.
735 */
736 BoxCont_Set(& ri0, "ri", 0);
737 BoxCont_Set(& src_type_id_cont, "ii", (BoxInt) src_type_id);
738
739 /* Create a new ANY type. */
740 Value_Setup_As_Temp(v_dst, Box_Get_Core_Type(BOXTYPEID_ANY));
741
742 /* Generate the boxing instructions. */
743 if (!BoxType_Is_Empty(src->type)) {
744 /* The object has associated data: get data pointer in v_src_ptr. */
745 Value *v_src_ptr = Value_Create(cur_proc), *v_unlink = NULL;
746 Value_Setup_As_Weak_Copy(v_src_ptr, src);
747
748 /* If src is an immediate, we move it into a register, so we can use
749 * the lea instruction to build a pointer to it. We then keep the
750 * register allocated until we have finished with the boxing operation.
751 * Note that the box instruction copies objects passed with NULL-block
752 * pointers. This means that fast types are always copied.
753 */
754 if (v_src_ptr->kind == VALUEKIND_IMM) {
755 v_src_ptr = Value_To_Temp(v_src_ptr);
756 Value_Unlink(v_src_ptr);
757 /* ^^^ FIXME: this is here for a bug in Value_To_Temp */
758
759 /* Keep the register allocated until the box instruction is exec. */
760 v_unlink = v_src_ptr;
761 Value_Link(v_src_ptr);
762 }
763
764 /* Get a pointer to the object and use it in the boxing operation. */
765 v_src_ptr = Value_Cast_To_Ptr_2(v_src_ptr);
766 BoxVMCode_Assemble(cur_proc, BOXGOP_TYPEOF,
767 2, & ri0, & src_type_id_cont);
768 BoxVMCode_Assemble(cur_proc, BOXGOP_WBOX,
769 3, & v_dst->value.cont, & v_src_ptr->value.cont,
770 & ri0);
771
772 /* Now release the register, if required. */
773 if (v_unlink)
774 Value_Unlink(v_unlink);
775
776 Value_Unlink(v_src_ptr);
777
778 } else {
779 BoxVMCode_Assemble(cur_proc, BOXGOP_TYPEOF,
780 2, & ri0, & src_type_id_cont);
781 BoxVMCode_Assemble(cur_proc, BOXGOP_BOX,
782 2, & v_dst->value.cont, & ri0);
783 }
784
785 Value_Unlink(src);
786 return v_dst;
787 }
788
789 /* REFERENCES: parent: 0, child: 0; */
Value_Emit_Call_From_Call_Num(BoxVMCallNum call_num,Value * parent,Value * child)790 void Value_Emit_Call_From_Call_Num(BoxVMCallNum call_num,
791 Value *parent, Value *child) {
792 BoxCmp *c = parent->proc->cmp;
793
794 assert(parent && child && c == child->proc->cmp);
795
796 if (parent->value.cont.type != BOXCONTTYPE_VOID) {
797 BoxGOp op = ((parent->value.cont.type == BOXCONTTYPE_OBJ
798 && parent->value.cont.categ != BOXCONTCATEG_PTR) ?
799 BOXGOP_MOV : BOXGOP_LEA);
800 BoxVMCode_Assemble(c->cur_proc, op,
801 2, & c->cont.pass_parent, & parent->value.cont);
802 }
803
804 if (child->value.cont.type != BOXCONTTYPE_VOID) {
805 Value *v_to_pass = Value_To_Temp_Or_Target(child);
806 BoxGOp op = ((child->value.cont.type == BOXCONTTYPE_OBJ
807 && child->value.cont.categ != BOXCONTCATEG_PTR) ?
808 BOXGOP_REF : BOXGOP_LEA);
809 BoxVMCode_Assemble(c->cur_proc, op,
810 2, & c->cont.pass_child, & v_to_pass->value.cont);
811 Value_Unlink(v_to_pass);
812 }
813
814 BoxVMCode_Assemble_Call(c->cur_proc, call_num);
815 }
816
817 /* REFERENCES: return: new, parent: 0, child: -1; */
818 BoxBool
Value_Emit_Dynamic_Call(Value * v_parent,Value * v_child)819 Value_Emit_Dynamic_Call(Value *v_parent, Value *v_child) {
820 BoxCmp *c = v_parent->proc->cmp;
821
822 assert(BoxType_Is_Any(v_parent->type) && BoxType_Is_Any(v_child->type));
823
824 //v_parent = Value_Cast_To_Ptr_2(v_parent);
825 v_child = Value_Cast_To_Ptr_2(v_child);
826
827 BoxVMCode_Assemble(c->cur_proc, BOXGOP_DYCALL,
828 2, & v_parent->value.cont, & v_child->value.cont);
829 Value_Unlink(v_child);
830 return BOXBOOL_TRUE;
831 }
832
833 /* REFERENCES: return: new, parent: 0, child: -1; */
My_Emit_Call(Value * parent,Value * child,BoxTask * success)834 static Value *My_Emit_Call(Value *parent, Value *child, BoxTask *success) {
835 BoxCmp *c = parent->proc->cmp;
836 BoxCallable *cb;
837 BoxTask dummy;
838 BoxType *expand_type;
839
840 assert(parent && child);
841
842 success = (success) ? success : & dummy;
843
844 if (Value_Is_Err(parent) || Value_Is_Err(child)) {
845 /* In case of error silently exits. */
846 Value_Unlink(child);
847 *success = BOXTASK_OK;
848 return NULL;
849 }
850
851 assert(c == child->proc->cmp);
852
853 /* We expand the child, since things like X.Y@Z are not allowed: in other
854 * words, subtypes can never be children of any type.
855 */
856 child = Value_Expand_Subtype(child);
857
858 /* Types derived from Void are always ignored */
859 if (BoxType_Compare(child->type, Box_Get_Core_Type(BOXTYPEID_VOID))) {
860 Value_Unlink(child);
861 *success = BOXTASK_OK;
862 return NULL;
863 }
864
865 /* Now we search for the procedure associated with *child */
866 BoxTypeCmp expand;
867 BoxType *found_combination =
868 BoxType_Find_Combination(parent->type, BOXCOMBTYPE_AT,
869 child->type, & expand);
870
871 if (!found_combination) {
872 if (!BoxType_Is_Any(child->type)) {
873 *success = BOXTASK_FAILURE;
874 return child; /* return child as it may be processed further */
875
876 } else {
877 /* Dynamic call. */
878 Value_Link(parent);
879 parent = My_Value_Weak_Box(parent);
880 *success = ((parent && Value_Emit_Dynamic_Call(parent, child)) ?
881 BOXTASK_OK : BOXTASK_FAILURE);
882 Value_Unlink(parent);
883 return NULL;
884 }
885 }
886
887 if (!BoxType_Get_Combination_Info(found_combination, & expand_type, & cb))
888 MSG_FATAL("Failed getting combination info");
889
890 if (expand == BOXTYPECMP_MATCHING) {
891 child = Value_Expand(child, expand_type);
892 if (!child) {
893 *success = BOXTASK_ERROR;
894 return NULL; /* Value_Expand did unlink child for us already... */
895 }
896 }
897
898 BoxVMCallNum cn;
899 if (BoxType_Generate_Combination_Call_Num(found_combination, c->vm, & cn)) {
900 Value_Emit_Call_From_Call_Num(cn, parent, child);
901 *success = BOXTASK_OK;
902 Value_Unlink(child);
903 return NULL;
904 }
905
906 *success = BOXTASK_ERROR;
907 Value_Unlink(child);
908 return (Value *) NULL;
909 }
910
Value_Emit_Call(Value * parent,Value * child,BoxTask * success)911 Value *Value_Emit_Call(Value *parent, Value *child, BoxTask *success) {
912 return My_Emit_Call(parent, child, success);
913 }
914
Value_Emit_Call_Or_Blacklist(Value * parent,Value * child)915 BoxTask Value_Emit_Call_Or_Blacklist(Value *parent, Value *child) {
916 BoxTask t;
917 Value_Unlink(My_Emit_Call(parent, child, & t));
918 return t;
919 }
920
921 /*
922 * REFERENCES: return: new, v_ptr: -1;
923 */
Value_Cast_From_Ptr(Value * v_ptr,BoxType * t)924 Value *Value_Cast_From_Ptr(Value *v_ptr, BoxType *t) {
925 BoxCmp *c = v_ptr->proc->cmp;
926
927 assert(v_ptr->value.cont.type == BOXCONTTYPE_PTR);
928
929 if (v_ptr->num_ref == 1) {
930 BoxCont *cont = & v_ptr->value.cont;
931 BoxTypeId new_cont_type = BoxType_Get_Cont_Type(t);
932
933 switch(cont->categ) {
934 case BOXCONTCATEG_GREG:
935 case BOXCONTCATEG_LREG:
936 v_ptr->type = BoxType_Link(t);
937 cont->type = new_cont_type;
938 if (new_cont_type == BOXTYPEID_OBJ || new_cont_type == BOXTYPEID_PTR)
939 return v_ptr;
940
941 else {
942 int is_greg = (cont->categ == BOXCONTCATEG_GREG);
943 BoxInt reg = cont->value.reg;
944 cont->categ = BOXCONTCATEG_PTR;
945 cont->value.ptr.reg = reg;
946 cont->value.ptr.is_greg = is_greg;
947 cont->value.ptr.offset = 0;
948 }
949 return v_ptr;
950
951 case BOXCONTCATEG_PTR:
952 if (My_Value_Can_Reuse_Reg(v_ptr)) {
953 MSG_FATAL("Value_Cast_From_Ptr: cannot reuse register, yet!");
954 /* not implemented */
955
956 } else {
957 BoxCont v_ptr_cont = v_ptr->value.cont;
958 Value_Unlink(v_ptr);
959 v_ptr = Value_New(c->cur_proc);
960 Value_Setup_As_Temp(v_ptr, Box_Get_Core_Type(BOXTYPEID_PTR));
961 BoxVMCode_Assemble(c->cur_proc, BOXGOP_REF, 2,
962 & v_ptr->value.cont, & v_ptr_cont);
963 assert(v_ptr->value.cont.categ == BOXCONTCATEG_LREG);
964 return Value_Cast_From_Ptr(v_ptr, t);
965 }
966
967 default:
968 MSG_FATAL("Value_Cast_From_Ptr: unexpected container category!");
969 assert(0);
970 }
971
972 } else {
973 MSG_FATAL("Value_Cast_From_Ptr: not implemented, yet!");
974 assert(0);
975 }
976
977 assert(0);
978 return NULL;
979 }
980
981 /*
982 Special type is one of Char, Int, Real, Point.
983
984 - special type in local/global register:
985 get a NULL block pointer with LEA
986
987 - special type in immediate:
988 allocate the value and get a NULL block pointer with LEA
989
990 - special type in pointer:
991 failure.
992
993 - object type in local/global register:
994 pass back the register as a PTR object.
995
996 - object type in pointer:
997 use ADD_O to obtain new pointer.
998
999 - pointer type in local/global register.
1000 pass back the register as a PTR.
1001
1002 - pointer type in pointer:
1003 retrieve the pointer with MOVE.
1004
1005 */
1006
Value_Cast_To_Ptr(Value * v)1007 Value *Value_Cast_To_Ptr(Value *v) {
1008 BoxCmp *c = v->proc->cmp;
1009 BoxCont *v_cont = & v->value.cont;
1010
1011 if (v_cont->type == BOXCONTTYPE_OBJ && v_cont->categ != BOXCONTCATEG_PTR) {
1012 /* This is the case where we already have the pointer to the object
1013 * stored inside a register. We then have two cases:
1014 * - such register is already in use. we cannot just change the
1015 * value into a Ptr value. We rather have to move the pointer
1016 * to a new register.
1017 * - the register is fully owned by us, we can recycle it!
1018 */
1019 if (v->num_ref > 1) {
1020 MSG_FATAL("Value_Cast_To_Ptr: not implemented, yet!");
1021 return v;
1022
1023 } else {
1024 assert(v->num_ref == 1);
1025 assert(v_cont->categ == BOXCONTCATEG_LREG
1026 || v_cont->categ == BOXCONTCATEG_GREG);
1027 /* We own the sole reference to v, which is a temporary quantity:
1028 * in other words we can do whathever we want with it!
1029 */
1030 v->type = BoxType_Link(Box_Get_Core_Type(BOXTYPEID_PTR));
1031 v_cont->type = BOXCONTTYPE_PTR;
1032 return v;
1033 }
1034
1035 } else {
1036 /* We have to get the pointer with a lea instruction. */
1037 BoxCont v_cont_val = *v_cont;
1038 Value_Unlink(v);
1039 v = Value_New(c->cur_proc);
1040 Value_Setup_As_Temp(v, Box_Get_Core_Type(BOXTYPEID_PTR));
1041 BoxVMCode_Assemble(c->cur_proc, BOXGOP_LEA,
1042 2, & v->value.cont, & v_cont_val);
1043 return v;
1044 }
1045 }
1046
1047 /*
1048 * REFERENCES: return: new, v_obj: -1;
1049 */
Value_To_Straight_Ptr(Value * v_obj)1050 Value *Value_To_Straight_Ptr(Value *v_obj) {
1051 assert(v_obj->value.cont.type == BOXCONTTYPE_OBJ);
1052
1053 if (v_obj->value.cont.categ == BOXCONTCATEG_PTR) {
1054 ValContainer vc = {VALCONTTYPE_LREG, -1, 0};
1055 Value *v_ret;
1056 BoxCont cont = v_obj->value.cont;
1057 BoxType *t = BoxType_Link(v_obj->type);
1058 BoxVMCode *cur_proc = v_obj->proc->cmp->cur_proc;
1059
1060 Value_Unlink(v_obj);
1061 v_ret = Value_New(cur_proc);
1062 Value_Setup_Container(v_ret, t, & vc);
1063 (void) BoxType_Unlink(t);
1064
1065 assert(v_ret->value.cont.type == BOXCONTTYPE_OBJ);
1066 BoxVMCode_Assemble(v_ret->proc, BOXGOP_LEA, 2, & v_ret->value.cont, & cont);
1067 return v_ret;
1068
1069 } else
1070 return v_obj;
1071 }
1072
1073 /** Return a sub-field of an object type. 'offset' is the address of the
1074 * subfield with respect to the address of the given object 'v_obj',
1075 * 'subf_type' is the type of the sub-field.
1076 * REFERENCES: return: new, v_obj: -1;
1077 */
Value_Get_Subfield(Value * v_obj,size_t offset,BoxType * subf_type)1078 Value *Value_Get_Subfield(Value *v_obj, size_t offset, BoxType *subf_type) {
1079 BoxCont *cont;
1080
1081 if (v_obj->num_ref > 1) {
1082 /* Here we cannot re-use the register, we have to copy it to a new one */
1083 BoxCmp *c = v_obj->proc->cmp;
1084 Value *v_copy = Value_New(c->cur_proc);
1085 Value_Setup_As_Weak_Copy(v_copy, v_obj);
1086 Value_Unlink(v_obj);
1087 v_obj = v_copy;
1088 }
1089
1090 cont = & v_obj->value.cont;
1091
1092 switch(cont->categ) {
1093 case BOXCONTCATEG_GREG:
1094 case BOXCONTCATEG_LREG:
1095 {
1096 BoxInt reg = cont->value.reg;
1097 int is_greg = (cont->categ == BOXCONTCATEG_GREG);
1098 cont->categ = BOXCONTCATEG_PTR;
1099 cont->value.ptr.offset = offset;
1100 cont->value.ptr.reg = reg;
1101 cont->value.ptr.is_greg = is_greg;
1102 cont->type = BoxType_Get_Cont_Type(subf_type);
1103 v_obj->type = BoxType_Link(subf_type);
1104 return v_obj;
1105 }
1106
1107 case BOXCONTCATEG_PTR:
1108 cont->value.ptr.offset += offset;
1109 cont->type = BoxType_Get_Cont_Type(subf_type);
1110 v_obj->type = BoxType_Link(subf_type);
1111 return v_obj;
1112
1113 case BOXCONTCATEG_IMM:
1114 break;
1115 }
1116 MSG_FATAL("Value_Get_Subfield: immediate objects not supported, yet!");
1117 return NULL;
1118 }
1119
My_Point_Get_Member(Value * v_point,const char * memb)1120 static Value *My_Point_Get_Member(Value *v_point, const char *memb) {
1121 int first = memb[0];
1122 if (first != '\0') {
1123 if (memb[1] == '\0') {
1124 BoxGOp g_op = -1;
1125 switch(first) {
1126 case 'x': g_op = BOXGOP_PPTRX; break;
1127 case 'y': g_op = BOXGOP_PPTRY; break;
1128 }
1129 if (g_op != -1) {
1130 BoxCmp *c = v_point->proc->cmp;
1131 Value *v_memb = Value_New(c->cur_proc);
1132 Value_Setup_As_Temp(v_memb, Box_Get_Core_Type(BOXTYPEID_PTR));
1133 BoxVMCode_Assemble(v_memb->proc, g_op, 2,
1134 & v_memb->value.cont, & v_point->value.cont);
1135 Value_Unlink(v_point);
1136 v_memb->kind = VALUEKIND_TARGET;
1137 return Value_Get_Subfield(v_memb, (size_t) 0,
1138 Box_Get_Core_Type(BOXTYPEID_SREAL));
1139 }
1140 }
1141 }
1142 Value_Unlink(v_point);
1143 return NULL;
1144 }
1145
Value_Struc_Get_Member(Value * v_struc,const char * memb)1146 Value *Value_Struc_Get_Member(Value *v_struc, const char *memb) {
1147 /* If v_struc is a subtype, then expand it (subtypes do not have members) */
1148 v_struc = Value_Expand_Subtype(v_struc);
1149
1150 if (v_struc->value.cont.type == BOXCONTTYPE_POINT)
1151 return My_Point_Get_Member(v_struc, memb);
1152
1153 BoxType *struct_type = BoxType_Get_Stem(v_struc->type);
1154 BoxType *node_type = BoxType_Find_Structure_Member(struct_type, memb);
1155
1156 if (node_type) {
1157 size_t offset;
1158 BoxType *member_type;
1159 BoxBool result = BoxType_Get_Structure_Member(node_type, NULL,
1160 & offset, 0, & member_type);
1161 if (result)
1162 return Value_Get_Subfield(v_struc, offset, member_type);
1163 }
1164
1165 Value_Unlink(v_struc);
1166 return NULL;
1167 }
1168
ValueStrucIter_Init(ValueStrucIter * vsi,Value * v_struc,BoxVMCode * proc)1169 void ValueStrucIter_Init(ValueStrucIter *vsi, Value *v_struc, BoxVMCode *proc) {
1170 BoxType *node, *t_struc;
1171
1172 t_struc = BoxType_Get_Stem(v_struc->type);
1173 BoxTypeIter_Init(& vsi->type_iter, t_struc);
1174 vsi->has_next = BoxTypeIter_Get_Next(& vsi->type_iter, & node);
1175 vsi->index = 0;
1176
1177 if (vsi->has_next) {
1178 BoxBool success;
1179 Value *v_member;
1180 size_t offset;
1181
1182 Value_Init(& vsi->v_member, proc);
1183 Value_Setup_As_Weak_Copy(& vsi->v_member, v_struc);
1184
1185 success = BoxType_Get_Structure_Member(node, NULL, & offset,
1186 NULL, & vsi->t_member);
1187 assert(success);
1188
1189 v_member = Value_Get_Subfield(& vsi->v_member, 0, vsi->t_member);
1190 assert(v_member == & vsi->v_member);
1191 }
1192 }
1193
ValueStrucIter_Do_Next(ValueStrucIter * vsi)1194 void ValueStrucIter_Do_Next(ValueStrucIter *vsi) {
1195 BoxType *prev_member_type = vsi->t_member;
1196 BoxType *node;
1197
1198 vsi->has_next = BoxTypeIter_Get_Next(& vsi->type_iter, & node);
1199 ++vsi->index;
1200
1201 if (vsi->has_next) {
1202 size_t offset;
1203 size_t delta_offset = BoxType_Get_Size(prev_member_type);
1204 Value *v_member;
1205
1206 BoxBool success = BoxType_Get_Structure_Member(node, NULL, & offset,
1207 NULL, & vsi->t_member);
1208 assert(success);
1209
1210 v_member =
1211 Value_Get_Subfield(& vsi->v_member, delta_offset, vsi->t_member);
1212 assert(v_member == & vsi->v_member);
1213 }
1214 }
1215
ValueStrucIter_Finish(ValueStrucIter * vsi)1216 void ValueStrucIter_Finish(ValueStrucIter *vsi) {
1217 Value_Unlink(& vsi->v_member);
1218 }
1219
ValueStrucIter_New(Value * v_struc,BoxVMCode * proc)1220 ValueStrucIter *ValueStrucIter_New(Value *v_struc, BoxVMCode *proc) {
1221 ValueStrucIter *vsi = Box_Mem_Safe_Alloc(sizeof(ValueStrucIter));
1222 ValueStrucIter_Init(vsi, v_struc, proc);
1223 return vsi;
1224 }
1225
ValueStrucIter_Destroy(ValueStrucIter * vsi)1226 void ValueStrucIter_Destroy(ValueStrucIter *vsi) {
1227 ValueStrucIter_Finish(vsi);
1228 Box_Mem_Free(vsi);
1229 }
1230
1231 /*
1232 * REFERENCES: src: -1, dest: 0;
1233 */
Value_Move_Content(Value * dest,Value * src)1234 BoxTask Value_Move_Content(Value *dest, Value *src) {
1235 BoxCmp *c = src->proc->cmp;
1236 BoxTypeCmp match = BoxType_Compare(dest->type, src->type);
1237 if (match == BOXTYPECMP_DIFFERENT) {
1238 MSG_ERROR("Cannot move objects of type '%T' into objects of type '%T'",
1239 src->type, dest->type);
1240 return BOXTASK_ERROR;
1241 }
1242
1243 if (match == BOXTYPECMP_MATCHING)
1244 src = Value_Expand(src, dest->type);
1245
1246 if (dest->value.cont.type == BOXCONTTYPE_OBJ) {
1247 /* Object types must be copied and destoyed */
1248
1249 /* Put addresses in registers. EXAMPLE: o[ro2 + 4] is transformed to ro3
1250 * through "lea ro3, o[ro2 + 4]"
1251 */
1252 Value_Link(dest);
1253 src = Value_To_Straight_Ptr(src);
1254 dest = Value_To_Straight_Ptr(dest);
1255
1256 /* We try to use the method provided by the user, if possible */
1257 Value_Link(src);
1258 Value_Link(dest);
1259 if (BoxCmp_Opr_Try_Emit_Conversion(c, dest, src) == BOXTASK_OK) {
1260 /* OK, we found a user defined conversion and we used it! Now we just
1261 * need to return!
1262 */
1263 Value_Unlink(src);
1264 Value_Unlink(dest);
1265 return BOXTASK_OK;
1266
1267 } else {
1268 /* We leave the copy operation to the Box memory management system */
1269 BoxTypeId type_id = BoxVM_Install_Type(c->vm, src->type);
1270 Value v_type_id;
1271 BoxCont ri0;
1272 Value_Init(& v_type_id, c->cur_proc);
1273 Value_Setup_As_Imm_Int(& v_type_id, type_id);
1274 BoxCont_Set(& ri0, "ri", 0);
1275 BoxVMCode_Assemble(c->cur_proc, BOXGOP_TYPEOF,
1276 2, & ri0, & v_type_id.value.cont);
1277 BoxVMCode_Assemble(c->cur_proc, BOXGOP_RELOC,
1278 3, & dest->value.cont, & src->value.cont, & ri0);
1279 Value_Unlink(& v_type_id);
1280 Value_Unlink(src);
1281 Value_Unlink(dest);
1282 return BOXTASK_OK;
1283 }
1284
1285 } else if (dest->value.cont.type == BOXCONTTYPE_PTR) {
1286 /* For pointers we need to pay special care: reference counts! */
1287 BoxVMCode_Assemble(dest->proc, BOXGOP_REF,
1288 2, & dest->value.cont, & src->value.cont);
1289
1290 } else {
1291 /* All the other types can be moved "quickly" with a mov operation */
1292 BoxVMCode_Assemble(dest->proc, BOXGOP_MOV,
1293 2, & dest->value.cont, & src->value.cont);
1294 }
1295
1296 Value_Unlink(src);
1297 return BOXTASK_OK;
1298 }
1299
1300 /*
1301 * REFERENCES: src: -1, dest: 0;
1302 */
BoxValue_Assign(BoxValue * dst,BoxValue * src)1303 BoxTask BoxValue_Assign(BoxValue *dst, BoxValue *src) {
1304 assert(dst->kind == VALUEKIND_VAR_NAME);
1305
1306 /* Set up dst as a variable. */
1307 BoxValue_Setup_As_Var(dst, src->type);
1308
1309 /* We play it safe here: we do not copy src only when src is a temporary
1310 * value and is stored in register form.
1311 */
1312 if (src->kind == VALUEKIND_TEMP &&
1313 src->value.cont.type == BOXCONTTYPE_OBJ &&
1314 src->value.cont.categ == BOXCONTCATEG_LREG) {
1315 BoxInt reg = src->value.cont.value.reg;
1316 if (reg > 0) {
1317 /* We then avoid allocating a dst object and copying src to dst. */
1318 BoxVMCode_Assemble(dst->proc, BOXGOP_REF,
1319 2, & dst->value.cont, & src->value.cont);
1320 return BOXTASK_OK;
1321 }
1322 }
1323
1324 /* Otherwise go for a full copy of the object. */
1325 BoxValue_Emit_Allocate(dst);
1326 return Value_Move_Content(dst, src);
1327 }
1328
1329 /** Emits the conversion from the source expression 'v', to the given type 't'
1330 * REFERENCES: return: new, src: -1;
1331 */
My_Emit_Conversion(BoxCmp * c,Value * src,BoxType * dest)1332 static Value *My_Emit_Conversion(BoxCmp *c, Value *src, BoxType *dest) {
1333 Value *v_dest = Value_Create(c->cur_proc);
1334 Value_Setup_As_Temp(v_dest, dest);
1335 Value_Link(src);
1336 Value_Link(v_dest); /* We want to return a new reference! */
1337 if (BoxCmp_Opr_Try_Emit_Conversion(c, v_dest, src) == BOXTASK_OK) {
1338 Value_Unlink(src);
1339 return v_dest;
1340
1341 } else {
1342 BoxTask t;
1343 Value_Link(v_dest);
1344 Value_Link(src);
1345 Value_Unlink(Value_Emit_Call(v_dest, src, & t));
1346 if (t == BOXTASK_OK)
1347 return v_dest;
1348
1349 else {
1350 MSG_ERROR("Don't know how to convert objects of type %T to %T.",
1351 src->type, dest);
1352 Value_Unlink(v_dest); /* Unlink, since we are not returning it! */
1353 return NULL;
1354 }
1355 }
1356 }
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398 /** Expands the value 'src' as prescribed by the species 'expansion_type'.
1399 * REFERENCES: return: new, src: -1;
1400 */
1401 Value *
Value_Expand(Value * src,BoxType * t_dst)1402 Value_Expand(Value *src, BoxType *t_dst) {
1403 BoxCmp *c = src->proc->cmp;
1404 BoxType *t_src = src->type;
1405
1406 if (t_src == t_dst)
1407 return src;
1408
1409 t_src = BoxType_Resolve(t_src,
1410 BOXTYPERESOLVE_IDENT | BOXTYPERESOLVE_SPECIES, 0);
1411 t_dst = BoxType_Resolve(t_dst, BOXTYPERESOLVE_IDENT, 0);
1412
1413 if (t_src == t_dst)
1414 return src;
1415
1416 switch (BoxType_Get_Class(t_dst)) {
1417 case BOXTYPECLASS_INTRINSIC: /* t_src != t_dst */
1418 MSG_FATAL("Value_Expand: type forbidden in species conversions.");
1419 assert(0);
1420
1421 case BOXTYPECLASS_SPECIES:
1422 {
1423 BoxType *t_species_memb = BoxType_Get_Species_Target(t_dst);
1424
1425 if (t_species_memb) {
1426 BoxTypeCmp match = BoxType_Compare(t_species_memb, t_dst);
1427
1428 if (match != BOXTYPECMP_DIFFERENT) {
1429 if (match == BOXTYPECMP_MATCHING) {
1430 Value *dest = Value_Expand(src, t_species_memb);
1431 Value_Unlink(src);
1432 src = dest;
1433 }
1434
1435 return My_Emit_Conversion(c, src, t_species_memb);
1436 }
1437 }
1438
1439 MSG_FATAL("Value_Expand: type '%T' is not compatible with '%T'.",
1440 t_src, t_dst);
1441 assert(0);
1442 }
1443
1444 case BOXTYPECLASS_STRUCTURE:
1445 {
1446 BoxTypeCmp comparison = BoxType_Compare(t_dst, t_src);
1447
1448 /* We check that the comparison can actually be done */
1449 if (comparison == BOXTYPECMP_DIFFERENT) {
1450 MSG_FATAL("Value_Expand: Expansion involves incompatible types!");
1451 assert(0);
1452 }
1453
1454 /* We have to expand the structure: we have to create a new structure
1455 * which can contain the expanded one.
1456 */
1457 if (comparison == BOXTYPECMP_MATCHING) { /* need expansion */
1458 ValueStrucIter dst_iter, src_iter;
1459 BoxVMCode *cur_proc = src->proc->cmp->cur_proc;
1460 Value *v_dst = Value_Create(cur_proc);
1461 Value_Setup_As_Temp(v_dst, t_dst);
1462
1463 ValueStrucIter_Init(& dst_iter, v_dst, cur_proc);
1464 ValueStrucIter_Init(& src_iter, src, cur_proc);
1465
1466 for (; dst_iter.has_next && src_iter.has_next;
1467 ValueStrucIter_Do_Next(& dst_iter),
1468 ValueStrucIter_Do_Next(& src_iter)) {
1469 Value_Link(& src_iter.v_member);
1470 Value_Move_Content(& dst_iter.v_member, & src_iter.v_member);
1471 }
1472
1473 assert(dst_iter.has_next == src_iter.has_next);
1474
1475 Value_Unlink(src);
1476 ValueStrucIter_Finish(& dst_iter);
1477 ValueStrucIter_Finish(& src_iter);
1478 return v_dst;
1479 }
1480
1481 return src;
1482 }
1483
1484 case BOXTYPECLASS_ANY:
1485 /* The code below implements boxing of data. */
1486 {
1487 BoxCont ri0, src_type_id_cont;
1488 BoxCmp *cmp = src->proc->cmp;
1489 BoxVMCode *cur_proc = cmp->cur_proc;
1490 BoxTypeId src_type_id = BoxVM_Install_Type(cmp->vm, src->type);
1491 Value *v_dst = Value_Create(cur_proc);
1492
1493 /* Set up a container representing the register ri0 and one representing
1494 * the type integer.
1495 */
1496 BoxCont_Set(& ri0, "ri", 0);
1497 BoxCont_Set(& src_type_id_cont, "ii", (BoxInt) src_type_id);
1498
1499 /* Create a new ANY type. */
1500 Value_Setup_As_Temp(v_dst, Box_Get_Core_Type(BOXTYPEID_ANY));
1501
1502 /* Generate the boxing instructions. */
1503 if (!BoxType_Is_Empty(src->type)) {
1504 /* The object has associated data: get data pointer in v_src_ptr. */
1505 Value *v_src_ptr = Value_Create(cur_proc), *v_unlink = NULL;
1506 Value_Setup_As_Weak_Copy(v_src_ptr, src);
1507
1508 /* If src is an immediate, we move it into a register, so we can use
1509 * the lea instruction to build a pointer to it. We then keep the
1510 * register allocated until we have finished with the boxing operation.
1511 * Note that the box instruction copies objects passed with NULL-block
1512 * pointers. This means that fast types are always copied.
1513 */
1514 if (v_src_ptr->kind == VALUEKIND_IMM) {
1515 v_src_ptr = Value_To_Temp(v_src_ptr);
1516 Value_Unlink(v_src_ptr);
1517 /* ^^^ FIXME: this is here for a bug in Value_To_Temp */
1518
1519 /* Keep the register allocated until the box instruction is exec. */
1520 v_unlink = v_src_ptr;
1521 Value_Link(v_src_ptr);
1522 }
1523
1524 /* Get a pointer to the object and use it in the boxing operation. */
1525 v_src_ptr = Value_Cast_To_Ptr_2(v_src_ptr);
1526 BoxVMCode_Assemble(cur_proc, BOXGOP_TYPEOF,
1527 2, & ri0, & src_type_id_cont);
1528 BoxVMCode_Assemble(cur_proc, BOXGOP_BOX,
1529 3, & v_dst->value.cont, & v_src_ptr->value.cont,
1530 & ri0);
1531
1532 /* Now release the register, if required. */
1533 if (v_unlink)
1534 Value_Unlink(v_unlink);
1535
1536 Value_Unlink(v_src_ptr);
1537
1538 } else {
1539 BoxVMCode_Assemble(cur_proc, BOXGOP_TYPEOF,
1540 2, & ri0, & src_type_id_cont);
1541 BoxVMCode_Assemble(cur_proc, BOXGOP_BOX,
1542 2, & v_dst->value.cont, & ri0);
1543 }
1544
1545 Value_Unlink(src);
1546 return v_dst;
1547 }
1548
1549 default:
1550 MSG_FATAL("Value_Expand: not fully implemented!");
1551 assert(0);
1552 }
1553
1554 return NULL;
1555 }
1556
My_Family_Setup(Value * v,BoxType * t,int is_parent)1557 void My_Family_Setup(Value *v, BoxType *t, int is_parent) {
1558 BoxCmp *c = v->proc->cmp;
1559
1560 assert(v->proc == c->cur_proc);
1561
1562 if (!BoxType_Is_Empty(t)) {
1563 BoxVMCode *p = v->proc->cmp->cur_proc;
1564 BoxVMRegNum ro_num =
1565 is_parent ? BoxVMCode_Get_Parent_Reg(p) : BoxVMCode_Get_Child_Reg(p);
1566 ValContainer vc = {VALCONTTYPE_LREG, ro_num, 0};
1567 Value_Setup_Container(v, Box_Get_Core_Type(BOXTYPEID_PTR), & vc);
1568 v = Value_Cast_From_Ptr(v, t);
1569 v->kind = VALUEKIND_TARGET;
1570
1571 } else {
1572 Value_Setup_As_Temp(v, t);
1573 v->kind = VALUEKIND_TARGET;
1574 }
1575 }
1576
Value_Setup_As_Parent(Value * v,BoxType * parent_t)1577 void Value_Setup_As_Parent(Value *v, BoxType *parent_t) {
1578 return My_Family_Setup(v, parent_t, /* is_parent */ 1);
1579 }
1580
Value_Setup_As_Child(Value * v,BoxType * child_t)1581 void Value_Setup_As_Child(Value *v, BoxType *child_t) {
1582 return My_Family_Setup(v, child_t, /* is_parent */ 0);
1583 }
1584
My_Get_Ptr_To_New_Value(BoxVMCode * proc,BoxType * t)1585 static Value *My_Get_Ptr_To_New_Value(BoxVMCode *proc, BoxType *t) {
1586 if (BoxType_Is_Fast(t)) {
1587 /* Create a structure type containing just one item of type t, allocate
1588 * that and get a pointer to it.
1589 * NOTE: this can be improved. We should not keep generating new
1590 * structures each time the function is called, but rather cache them!
1591 */
1592 Value *v = Value_Create(proc);
1593 BoxType *t_struc = BoxType_Create_Structure();
1594 BoxType_Add_Member_To_Structure(t_struc, t, NULL);
1595 Value_Setup_As_Temp(v, t_struc);
1596 return Value_Cast_To_Ptr(v);
1597
1598 } else {
1599 Value *v = Value_Create(proc);
1600 Value_Setup_As_Temp(v, t);
1601 return Value_Cast_To_Ptr(v);
1602 }
1603 }
1604
Value_Subtype_Build(Value * v_parent,const char * subtype_name)1605 Value *Value_Subtype_Build(Value *v_parent, const char *subtype_name) {
1606 BoxCmp *c = v_parent->proc->cmp;
1607 BoxType *found_subtype;
1608 Value *v_subtype = NULL;
1609
1610 /* If the method cannot be found, it could be a method of the child
1611 * of the type. We then resolve the type to its child and try again.
1612 * X.GetPoint = Point
1613 * X.GetPoint[].Norm[] (Norm is a method of Point and not a method
1614 * of GetPoint)
1615 */
1616 while (1) {
1617 found_subtype = BoxType_Find_Subtype(v_parent->type, subtype_name);
1618 if (found_subtype != NULL)
1619 break;
1620
1621 if (BoxType_Is_Subtype(v_parent->type)) {
1622 v_parent = Value_Expand_Subtype(v_parent);
1623 if (v_parent == NULL)
1624 return NULL;
1625
1626 } else {
1627 MSG_ERROR("Type '%T' has not a subtype of name '%s'",
1628 v_parent->type, subtype_name);
1629 Value_Unlink(v_parent);
1630 return NULL;
1631 }
1632 }
1633
1634 assert(found_subtype);
1635
1636 /* First, we create the subtype object (a pair of pointers) */
1637 v_subtype = Value_Create(c->cur_proc);
1638 Value_Setup_As_Temp(v_subtype, found_subtype);
1639
1640 BoxType *t_child;
1641 BoxType_Get_Subtype_Info(found_subtype, NULL, NULL, & t_child);
1642 if (!BoxType_Is_Empty(t_child)) {
1643 /* Next, we create the child and get a pointer to it */
1644 Value *v_ptr = Value_Create(c->cur_proc),
1645 *v_subtype_child;
1646 v_subtype_child = My_Get_Ptr_To_New_Value(c->cur_proc, t_child);
1647
1648 /* We now create a Value corresponding to the first pointer (the child)
1649 * and transfer the child pointer to the subtype.
1650 */
1651 Value_Setup_As_Weak_Copy(v_ptr, v_subtype);
1652 v_ptr = Value_Get_Subfield(v_ptr, /* offset */ 0,
1653 Box_Get_Core_Type(BOXTYPEID_PTR));
1654 (void) Value_Move_Content(v_ptr, v_subtype_child);
1655 Value_Unlink(v_ptr);
1656 }
1657
1658 /* We now create the value for the parent Pointer in the subtype */
1659 if (!BoxType_Is_Empty(v_parent->type)) {
1660 Value *v_subtype_parent = Value_Create(c->cur_proc),
1661 *v_ptr = Value_Create(c->cur_proc);
1662 Value_Setup_As_Weak_Copy(v_ptr, v_subtype);
1663 v_ptr = Value_Get_Subfield(v_ptr, /*offset*/ sizeof(BoxPtr),
1664 Box_Get_Core_Type(BOXTYPEID_PTR));
1665 Value_Setup_As_Weak_Copy(v_subtype_parent, v_parent);
1666 v_subtype_parent = Value_Cast_To_Ptr(v_subtype_parent);
1667 (void) Value_Move_Content(v_ptr, v_subtype_parent);
1668 Value_Unlink(v_ptr);
1669 }
1670
1671 Value_Unlink(v_parent);
1672
1673 return v_subtype;
1674 }
1675
My_Value_Subtype_Get(Value * v_subtype,int get_child)1676 static Value *My_Value_Subtype_Get(Value *v_subtype, int get_child) {
1677 BoxCmp *c = v_subtype->proc->cmp;
1678 Value *v_ret = NULL;
1679
1680 if (Value_Want_Value(v_subtype)) {
1681 if (BoxType_Is_Subtype(v_subtype->type)) {
1682 BoxType *t_parent, *t_child;
1683 BoxBool success = BoxType_Get_Subtype_Info(v_subtype->type, NULL,
1684 & t_parent, & t_child);
1685 assert(success);
1686 BoxType *t_ret = get_child ? t_child : t_parent;
1687 if (BoxType_Is_Empty(t_ret)) {
1688 v_ret = Value_Create(c->cur_proc);
1689 Value_Setup_As_Temp(v_ret, t_ret);
1690
1691 } else {
1692 size_t offset = get_child ? 0 : sizeof(BoxPtr);
1693 v_ret = Value_Create(c->cur_proc);
1694 /* FIXME: see Value_Init */
1695 Value_Setup_As_Weak_Copy(v_ret, v_subtype);
1696 v_ret = Value_Get_Subfield(v_ret, offset,
1697 Box_Get_Core_Type(BOXTYPEID_PTR));
1698 v_ret = Value_Cast_From_Ptr(v_ret, t_ret);
1699
1700 /* Temporary fix: transfer ownership of register, if needed */
1701 if (v_subtype->num_ref == 1) {
1702 v_ret->attr.own_register = v_subtype->attr.own_register;
1703 v_subtype->attr.own_register = 0;
1704 }
1705 }
1706
1707 } else {
1708 const char *what = get_child ? "child" : "parent";
1709 MSG_ERROR("Cannot get the %s of '%T': this is not a subtype!",
1710 what, v_subtype->type);
1711 }
1712 }
1713
1714 Value_Unlink(v_subtype);
1715 return v_ret;
1716 }
1717
Value_Subtype_Get_Child(Value * v_subtype)1718 Value *Value_Subtype_Get_Child(Value *v_subtype) {
1719 return My_Value_Subtype_Get(v_subtype, 1);
1720 }
1721
Value_Subtype_Get_Parent(Value * v_subtype)1722 Value *Value_Subtype_Get_Parent(Value *v_subtype) {
1723 return My_Value_Subtype_Get(v_subtype, 0);
1724 }
1725
Value_Expand_Subtype(Value * v)1726 Value *Value_Expand_Subtype(Value *v) {
1727 if (Value_Is_Value(v)) {
1728 if (BoxType_Is_Subtype(v->type)) {
1729 int subtype_was_target = (v->kind == VALUEKIND_TARGET);
1730 v = Value_Subtype_Get_Child(v);
1731 if (subtype_was_target)
1732 v = Value_Promote_Temp_To_Target(v);
1733 return v;
1734 }
1735 }
1736
1737 return v;
1738 }
1739
Value_Raise(Value * v)1740 Value *Value_Raise(Value *v) {
1741 if (Value_Is_Value(v)) {
1742 BoxType *t = BoxType_Resolve(v->type, BOXTYPERESOLVE_IDENT, 0);
1743 BoxType *unraised_type = BoxType_Unraise(t);
1744 if (unraised_type) {
1745 (void) BoxType_Unlink(v->type);
1746 v->type = unraised_type;
1747 return v;
1748
1749 } else {
1750 Value_Unlink(v);
1751 MSG_ERROR("Raising operator is applied to a non-raised type.");
1752 return NULL;
1753 }
1754
1755 } else {
1756 Value_Unlink(v);
1757 MSG_ERROR("Raising operator got invalid operand.");
1758 return NULL;
1759 }
1760 }
1761