1 /****************************************************************************
2 * Copyright (C) 2008-2013 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 <stdio.h>
22 #include <string.h>
23 #include <ctype.h>
24 #include <assert.h>
25 #include <math.h>
26
27 #include "types.h"
28 #include "combs.h"
29 #include "defaults.h"
30 #include "messages.h"
31 #include "array.h"
32 #include "strutils.h"
33 #include "vm_priv.h"
34 #include "vmproc.h"
35 #include "vmsym.h"
36 #include "vmsymstuff.h"
37 #include "registers.h"
38 #include "builtins.h"
39 #include "bltinstr.h"
40 #include "str.h"
41 #include "bltinio.h"
42
43 #include "compiler_priv.h"
44
45
46 /*******************************BOX-PROCEDURES********************************/
47
My_Subtype_Init(BoxVMX * vmx)48 static BoxTask My_Subtype_Init(BoxVMX *vmx) {
49 BoxSubtype *s = BoxVMX_Get_Parent_Target(vmx);
50 BoxPtr_Nullify(& s->parent);
51 BoxPtr_Nullify(& s->child);
52 return BOXTASK_OK;
53 }
54
My_Subtype_Finish(BoxVMX * vmx)55 static BoxTask My_Subtype_Finish(BoxVMX *vmx) {
56 BoxSubtype *s = BoxVMX_Get_Parent_Target(vmx);
57 (void) BoxPtr_Unlink(& s->parent);
58 (void) BoxPtr_Unlink(& s->child);
59 return BOXTASK_OK;
60 }
61
62 /**********************
63 * IO *
64 **********************/
65
66 BOXEXPORT BoxException *
Box_Runtime_Pause_At_Print(BoxPtr * parent,BoxPtr * child)67 Box_Runtime_Pause_At_Print(BoxPtr *parent, BoxPtr *child) {
68 fputs("\n", stdout);
69 return NULL;
70 }
71
72 BOXEXPORT BoxException *
Box_Runtime_CHAR_At_Print(BoxPtr * parent,BoxPtr * child)73 Box_Runtime_CHAR_At_Print(BoxPtr *parent, BoxPtr *child) {
74 printf(SChar, *((BoxChar *) BoxPtr_Get_Target(child)));
75 return NULL;
76 }
77
78 BOXEXPORT BoxException *
Box_Runtime_INT_At_Print(BoxPtr * parent,BoxPtr * child)79 Box_Runtime_INT_At_Print(BoxPtr *parent, BoxPtr *child) {
80 printf(SInt, *((BoxInt *) BoxPtr_Get_Target(child)));
81 return NULL;
82 }
83
84 BOXEXPORT BoxException *
Box_Runtime_REAL_At_Print(BoxPtr * parent,BoxPtr * child)85 Box_Runtime_REAL_At_Print(BoxPtr *parent, BoxPtr *child){
86 printf(SReal, *((BoxReal *) BoxPtr_Get_Target(child)));
87 return NULL;
88 }
89
90 BOXEXPORT BoxException *
Box_Runtime_Point_At_Print(BoxPtr * parent,BoxPtr * child)91 Box_Runtime_Point_At_Print(BoxPtr *parent, BoxPtr *child){
92 BoxPoint *p = BoxPtr_Get_Target(child);
93 printf(SPoint, p->x, p->y);
94 return NULL;
95 }
96
97 BOXEXPORT BoxException *
Box_Runtime_Str_At_Print(BoxPtr * parent,BoxPtr * child)98 Box_Runtime_Str_At_Print(BoxPtr *parent, BoxPtr *child) {
99 BoxStr *s = BoxPtr_Get_Target(child);
100 if (s->ptr != NULL)
101 fputs(s->ptr, stdout);
102 return NULL;
103 }
104
105 /**********************
106 * Math *
107 **********************/
108
109 #define MY_DEFINE_FN_REAL_AT_REAL(dst_fn, src_fn) \
110 static BoxTask dst_fn(BoxVMX *vmx) { \
111 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = \
112 src_fn(*((BoxReal *) BoxVMX_Get_Child_Target(vmx))); \
113 return BOXTASK_OK; \
114 } \
115
MY_DEFINE_FN_REAL_AT_REAL(My_Math_Cos,cos)116 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Cos, cos)
117 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Sin, sin)
118 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Tan, tan)
119 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Asin, asin)
120 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Acos, acos)
121 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Atan, atan)
122
123
124 static BoxTask My_Math_Atan2(BoxVMX *vmx) {
125 BoxPoint *p = BoxVMX_Get_Child_Target(vmx);
126 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = atan2(p->y, p->x);
127 return BOXTASK_OK;
128 }
129
MY_DEFINE_FN_REAL_AT_REAL(My_Math_Exp,exp)130 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Exp, exp)
131 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Log, log)
132 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Log10, log10)
133 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Sqrt, sqrt)
134 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Ceil, ceil)
135 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Floor, floor)
136 MY_DEFINE_FN_REAL_AT_REAL(My_Math_Abs, fabs)
137
138 static BoxTask My_Math_Norm(BoxVMX *vmx) {
139 BoxPoint *p = BoxVMX_Get_Child_Target(vmx);
140 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = sqrt(p->x*p->x + p->y*p->y);
141 return BOXTASK_OK;
142 }
143
My_Math_Norm2(BoxVMX * vmx)144 static BoxTask My_Math_Norm2(BoxVMX *vmx) {
145 BoxPoint *p = BoxVMX_Get_Child_Target(vmx);
146 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = p->x*p->x + p->y*p->y;
147 return BOXTASK_OK;
148 }
149
My_Min_Open(BoxVMX * vmx)150 static BoxTask My_Min_Open(BoxVMX *vmx) {
151 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = BOXREAL_MAX;
152 return BOXTASK_OK;
153 }
154
My_Min_Real(BoxVMX * vmx)155 static BoxTask My_Min_Real(BoxVMX *vmx) {
156 BoxReal *cp = BoxVMX_Get_Parent_Target(vmx), c = *cp,
157 x = *((BoxReal *) BoxVMX_Get_Child_Target(vmx));
158 *cp = (x < c) ? x : c;
159 return BOXTASK_OK;
160 }
161
My_Max_Open(BoxVMX * vmx)162 static BoxTask My_Max_Open(BoxVMX *vmx) {
163 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx)) = BOXREAL_MIN;
164 return BOXTASK_OK;
165 }
166
My_Max_Real(BoxVMX * vmx)167 static BoxTask My_Max_Real(BoxVMX *vmx) {
168 BoxReal *cp = BoxVMX_Get_Parent_Target(vmx), c = *cp,
169 x = *((BoxReal *) BoxVMX_Get_Child_Target(vmx));
170 *cp = (x > c) ? x : c;
171 return BOXTASK_OK;
172 }
173
My_Vec_Real(BoxVMX * vmx)174 static BoxTask My_Vec_Real(BoxVMX *vmx) {
175 BoxReal *angle = BoxVMX_Get_Child_Target(vmx);
176 BoxPoint *p = BoxVMX_Get_Parent_Target(vmx);
177 p->x = cos(*angle);
178 p->y = sin(*angle);
179 return BOXTASK_OK;
180 }
181
My_Point_At_Ort(BoxVMX * vm)182 static BoxTask My_Point_At_Ort(BoxVMX *vm) {
183 BoxPoint *p_out = BoxVMX_Get_Parent_Target(vm);
184 BoxPoint *p_in = BoxVMX_Get_Child_Target(vm);
185 p_out->x = -p_in->y;
186 p_out->y = p_in->x;
187 return BOXTASK_OK;
188 }
189
190 /**********************
191 * Conversions *
192 **********************/
193
My_2R_To_P(BoxVMX * vmx)194 static BoxTask My_2R_To_P(BoxVMX *vmx) {
195 *((BoxPoint *) BoxVMX_Get_Parent_Target(vmx))
196 = *((BoxPoint *) BoxVMX_Get_Child_Target(vmx));
197 return BOXTASK_OK;
198 }
199
200 /**********************
201 * Sys *
202 **********************/
203
204 /* This function is not politically correct!!! */
My_Exit_Int(BoxVMX * vmx)205 static BoxTask My_Exit_Int(BoxVMX *vmx) {
206 exit(*((BoxInt *) BoxVMX_Get_Child_Target(vmx)));
207 }
208
My_Fail_Clear_Msg(BoxVMX * vmx)209 static BoxTask My_Fail_Clear_Msg(BoxVMX *vmx) {
210 BoxVM_Set_Fail_Msg(vmx->vm, NULL);
211 return BOXTASK_OK;
212 }
213
My_Fail(BoxVMX * vmx)214 static BoxTask My_Fail(BoxVMX *vmx) {
215 return BOXTASK_FAILURE;
216 }
217
My_Fail_Msg(BoxVMX * vmx)218 static BoxTask My_Fail_Msg(BoxVMX *vmx) {
219 BoxStr *s = BoxVMX_Get_Child_Target(vmx);
220 char *msg = BoxStr_To_C_String(s);
221 BoxVM_Set_Fail_Msg(vmx->vm, msg);
222 Box_Mem_Free(msg);
223 return BOXTASK_OK;
224 }
225
My_Num_Init(BoxVMX * vm)226 static BoxTask My_Num_Init(BoxVMX *vm) {
227 BoxInt *length = BoxVMX_Get_Parent_Target(vm);
228 *length = 0;
229 return BOXTASK_OK;
230 }
231
My_IsValid_Init(BoxVMX * vm)232 static BoxTask My_IsValid_Init(BoxVMX *vm) {
233 BoxInt *valid = BoxVMX_Get_Parent_Target(vm);
234 *valid = 1;
235 return BOXTASK_OK;
236 }
237
My_Int_At_IsValid(BoxVMX * vm)238 static BoxTask My_Int_At_IsValid(BoxVMX *vm) {
239 BoxInt *valid = BoxVMX_Get_Parent_Target(vm);
240 BoxInt *child = BoxVMX_Get_Child_Target(vm);
241 *valid = (*valid && *child);
242 return BOXTASK_OK;
243 }
244
My_Compare_Init(BoxVMX * vm)245 static BoxTask My_Compare_Init(BoxVMX *vm) {
246 BoxInt *compare = BoxVMX_Get_Parent_Target(vm);
247 *compare = 0;
248 return BOXTASK_OK;
249 }
250
251 /*****************************************************************************
252 * FUNCTIONS FOR CONVERSION *
253 *****************************************************************************/
254
My_Char_Char(BoxVMX * vmx)255 static BoxTask My_Char_Char(BoxVMX *vmx) {
256 *((BoxChar *) BoxVMX_Get_Parent_Target(vmx))
257 = *((BoxChar *) BoxVMX_Get_Child_Target(vmx));
258 return BOXTASK_OK;
259 }
260
My_Char_Int(BoxVMX * vmx)261 static BoxTask My_Char_Int(BoxVMX *vmx) {
262 *((BoxChar *) BoxVMX_Get_Parent_Target(vmx))
263 = (BoxChar) *((BoxInt *) BoxVMX_Get_Child_Target(vmx));
264 return BOXTASK_OK;
265 }
266
My_Char_Real(BoxVMX * vmx)267 static BoxTask My_Char_Real(BoxVMX *vmx) {
268 *((BoxChar *) BoxVMX_Get_Parent_Target(vmx))
269 = (BoxChar) *((BoxReal *) BoxVMX_Get_Child_Target(vmx));
270 return BOXTASK_OK;
271 }
272
My_Int_Int(BoxVMX * vmx)273 static BoxTask My_Int_Int(BoxVMX *vmx) {
274 *((BoxInt *) BoxVMX_Get_Parent_Target(vmx))
275 = *((BoxInt *) BoxVMX_Get_Child_Target(vmx));
276 return BOXTASK_OK;
277 }
278
My_Int_Real(BoxVMX * vmx)279 static BoxTask My_Int_Real(BoxVMX *vmx) {
280 *((BoxInt *) BoxVMX_Get_Parent_Target(vmx))
281 = (BoxInt) *((BoxReal *) BoxVMX_Get_Child_Target(vmx));
282 return BOXTASK_OK;
283 }
284
My_Real_Real(BoxVMX * vmx)285 static BoxTask My_Real_Real(BoxVMX *vmx) {
286 *((BoxReal *) BoxVMX_Get_Parent_Target(vmx))
287 = *((BoxReal *) BoxVMX_Get_Child_Target(vmx));
288 return BOXTASK_OK;
289 }
290
My_Point_RealNumCouple(BoxVMX * vmx)291 static BoxTask My_Point_RealNumCouple(BoxVMX *vmx) {
292 *((BoxPoint *) BoxVMX_Get_Parent_Target(vmx))
293 = *((BoxPoint *) BoxVMX_Get_Child_Target(vmx));
294 return BOXTASK_OK;
295 }
296
My_If_Int(BoxVMX * vmx)297 static BoxTask My_If_Int(BoxVMX *vmx) {
298 *((BoxInt *) BoxVMX_Get_Parent_Target(vmx))
299 = !*((BoxInt *) BoxVMX_Get_Child_Target(vmx));
300 return BOXTASK_OK;
301 }
302
My_For_Int(BoxVMX * vmx)303 static BoxTask My_For_Int(BoxVMX *vmx) {
304 *((BoxInt *) BoxVMX_Get_Parent_Target(vmx))
305 = *((BoxInt *) BoxVMX_Get_Child_Target(vmx));
306 return BOXTASK_OK;
307 }
308
309 /****************************************************************************/
310 /* NEW COMPILER */
311
312 #include "value.h"
313 #include "operator.h"
314 #include "namespace.h"
315 #include "compiler.h"
316
Bltin_Proc_Add(BoxCmp * c,const char * proc_name,BoxTask (* c_fn)(BoxVMX *))317 BoxVMCallNum Bltin_Proc_Add(BoxCmp *c, const char *proc_name,
318 BoxTask (*c_fn)(BoxVMX *)) {
319 BoxVMCallNum call_num;
320
321 /* We finally install the code (a C function) for the procedure */
322 call_num = BoxVM_Allocate_Call_Num(c->vm);
323 if (call_num == BOXVMCALLNUM_NONE)
324 return BOXVMSYMID_NONE;
325
326 if (!BoxVM_Install_Proc_CCode(c->vm, call_num, c_fn)) {
327 (void) BoxVM_Deallocate_Call_Num(c->vm, call_num);
328 return BOXVMSYMID_NONE;
329 }
330
331 (void) BoxVM_Set_Proc_Names(c->vm, call_num, NULL, proc_name);
332 return call_num;
333 }
334
Bltin_Comb_Def_With_Ids(BoxTypeId child,BoxCombType comb_type,BoxTypeId parent,BoxTask (* c_fn)(BoxVMX *))335 void Bltin_Comb_Def_With_Ids(BoxTypeId child, BoxCombType comb_type,
336 BoxTypeId parent, BoxTask (*c_fn)(BoxVMX *)) {
337 /* We tell to the compiler that some procedures are associated to call_num */
338 BoxType *child_new = Box_Get_Core_Type(child),
339 *parent_new = Box_Get_Core_Type(parent);
340 Bltin_Comb_Def(child_new, comb_type, parent_new, c_fn);
341 }
342
Bltin_Comb_Def(BoxType * child,BoxCombType comb_type,BoxType * parent,BoxTask (* c_fn)(BoxVMX *))343 void Bltin_Comb_Def(BoxType *child, BoxCombType comb_type,
344 BoxType *parent, BoxTask (*c_fn)(BoxVMX *)) {
345 /* We tell to the compiler that some procedures are associated to call_num */
346 BoxCallable *callable;
347 BoxType *comb;
348 char *uid;
349
350 callable = BoxCallable_Create_Undefined(parent, child);
351 callable = BoxCallable_Define_From_CCallOld(callable, c_fn);
352 comb = BoxType_Define_Combination(parent, comb_type, child, callable);
353 assert(comb);
354
355 uid = BoxType_Get_Repr(comb);
356 BoxCallable_Set_Uid(callable, uid);
357 Box_Mem_Free(uid);
358 }
359
Bltin_Proc_Def(BoxType * parent,BoxType * child,BoxTask (* c_fn)(BoxVMX *))360 void Bltin_Proc_Def(BoxType *parent, BoxType *child,
361 BoxTask (*c_fn)(BoxVMX *)) {
362 Bltin_Comb_Def(child, BOXCOMBTYPE_AT, parent, c_fn);
363 }
364
Bltin_Proc_Def_With_Id(BoxType * parent,BoxTypeId child_id,BoxTask (* c_fn)(BoxVMX *))365 void Bltin_Proc_Def_With_Id(BoxType *parent, BoxTypeId child_id,
366 BoxTask (*c_fn)(BoxVMX *)) {
367 BoxType *child = Box_Get_Core_Type(child_id);
368 assert(child);
369 Bltin_Comb_Def(child, BOXCOMBTYPE_AT, parent, c_fn);
370 }
371
Bltin_Proc_Def_With_Ids(BoxTypeId parent,BoxTypeId child,BoxTask (* c_fn)(BoxVMX *))372 void Bltin_Proc_Def_With_Ids(BoxTypeId parent, BoxTypeId child,
373 BoxTask (*c_fn)(BoxVMX *)) {
374 Bltin_Comb_Def_With_Ids(child, BOXCOMBTYPE_AT, parent, c_fn);
375 }
376
377 /* Register the core types in the current namespace, so that Box programs
378 * can access and use them.
379 */
My_Register_Core_Types(BoxCmp * c)380 static void My_Register_Core_Types(BoxCmp *c) {
381 struct {
382 const char *name;
383 BoxTypeId type;
384 } *row, rows[] = {
385 {"Char", BOXTYPEID_CHAR},
386 {"INT", BOXTYPEID_INT},
387 {"REAL", BOXTYPEID_REAL},
388 {"POINT", BOXTYPEID_POINT},
389 {"Int", BOXTYPEID_SINT},
390 {"Real", BOXTYPEID_SREAL},
391 {"Point", BOXTYPEID_SPOINT},
392 {"Num", BOXTYPEID_NUM},
393 {"Str", BOXTYPEID_STR},
394 {"Void", BOXTYPEID_VOID},
395 {"Ptr", BOXTYPEID_PTR},
396 {"CPtr", BOXTYPEID_CPTR},
397 {"If", BOXTYPEID_IF},
398 {"Else", BOXTYPEID_ELSE},
399 /*{"Elif", BOXTYPEID_ELIF},*/
400 {"For", BOXTYPEID_FOR},
401 {"Print", BOXTYPEID_PRINT},
402 {"Repr", BOXTYPEID_REPR},
403 {"Any", BOXTYPEID_ANY},
404 {"Compare", BOXTYPEID_COMPARE},
405 {"Get", BOXTYPEID_Get},
406 {"Set", BOXTYPEID_Set},
407 {"ARRAY", BOXTYPEID_ARRAY},
408 {"Array", BOXTYPEID_Array},
409 {(char *) NULL, BOXTYPEID_NONE}
410 };
411
412 for(row = & rows[0]; row->name; ++row) {
413 Value *v = Value_Create(c->cur_proc);
414 Value_Setup_As_Type(v, Box_Get_Core_Type(row->type));
415 Namespace_Add_Value(& c->ns, NMSPFLOOR_DEFAULT, row->name, v);
416 Value_Unlink(v);
417 }
418 }
419
420 /* Used to make the table of operations more compact in
421 * My_Register_BinOps. This function maps a character to a BoxType
422 * value. Example: My_Type_Of_Char(c, 'I') returns BOXTYPEID_INT,
423 * My_Type_Of_Char(c, 'R') returns BOXTYPEID_REAL, etc.
424 */
My_Type_Of_Char(BoxCmp * c,char t)425 static BoxType *My_Type_Of_Char(BoxCmp *c, char t) {
426 switch(t) {
427 case ' ': return NULL;
428 case 'C': return Box_Get_Core_Type(BOXTYPEID_CHAR);
429 case 'I': return Box_Get_Core_Type(BOXTYPEID_INT);
430 case 'R': return Box_Get_Core_Type(BOXTYPEID_REAL);
431 case 'P': return Box_Get_Core_Type(BOXTYPEID_POINT);
432 case 'i': return Box_Get_Core_Type(BOXTYPEID_SINT);
433 case 'r': return Box_Get_Core_Type(BOXTYPEID_SREAL);
434 case 'p': return Box_Get_Core_Type(BOXTYPEID_SPOINT);
435 default:
436 MSG_FATAL("My_Type_Of_Char: unexpected character.");
437 return NULL;
438 }
439 }
440
My_OprAttr_Of_Str(const char * s)441 static OprAttr My_OprAttr_Of_Str(const char *s) {
442 if (s == NULL)
443 return OPR_ATTR_ALL;
444
445 else {
446 OprAttr a = 0;
447 for(;*s != '\0'; s++) {
448 switch(*s) {
449 case 'a': a |= OPR_ATTR_ASSIGNMENT; break;
450 case 'i': a |= OPR_ATTR_IGNORE_RES; break;
451 case 'c': a |= OPR_ATTR_COMMUTATIVE; break;
452 case 'r': a |= OPR_ATTR_UN_RIGHT; break;
453 default:
454 MSG_FATAL("My_OprAttr_Of_Str: error parsing string.");
455 assert(0);
456 return BOXTYPEID_NONE;
457 }
458 }
459 return a;
460 }
461 }
462
463 /* Register all the core unary operations for the Box compiler. */
My_Register_UnOps(BoxCmp * c)464 static void My_Register_UnOps(BoxCmp *c) {
465 struct {
466 const char *types; /* Two characters describing the types of the result
467 and of the operand, following the map character->type
468 implemented by My_Type_Of_Char) */
469 ASTUnOp op; /* Operator to which the operation refers */
470 const char *mask, /* Mask of attributes (a string which is converted
471 to an OprAttr by calling My_OprAttr_Of_Str) */
472 *attr; /* Attributes to set */
473 BoxGOp g_op; /* Generic opcode to use for assembling the operation */
474
475 } *unop, unops[] = {
476 { "Pp", ASTUNOP_NEG, "", NULL, BOXGOP_NEG},
477 { "Rr", ASTUNOP_NEG, "", NULL, BOXGOP_NEG},
478 { "Ii", ASTUNOP_NEG, "", NULL, BOXGOP_NEG},
479 { "Rr", ASTUNOP_LINC, "a", NULL, BOXGOP_INC},
480 { "Ii", ASTUNOP_LINC, "a", NULL, BOXGOP_INC},
481 { "Rr", ASTUNOP_LDEC, "a", NULL, BOXGOP_DEC},
482 { "Ii", ASTUNOP_LDEC, "a", NULL, BOXGOP_DEC},
483 { "Rr", ASTUNOP_RINC, "ar", NULL, BOXGOP_INC},
484 { "Ii", ASTUNOP_RINC, "ar", NULL, BOXGOP_INC},
485 { "Rr", ASTUNOP_RDEC, "ar", NULL, BOXGOP_DEC},
486 { "Ii", ASTUNOP_RDEC, "ar", NULL, BOXGOP_DEC},
487 { "Ii", ASTUNOP_BNOT, "", NULL, BOXGOP_BNOT},
488 { "Ii", ASTUNOP_NOT, "", NULL, BOXGOP_LNOT},
489
490
491 { NULL, 0, NULL, NULL, 0}
492 };
493
494 for(unop = & unops[0]; unop->types != NULL; ++unop) {
495 Operator *opr = BoxCmp_UnOp_Get(c, unop->op);
496 BoxType *result = My_Type_Of_Char(c, unop->types[0]),
497 *operand = My_Type_Of_Char(c, unop->types[1]);
498 OprAttr mask = My_OprAttr_Of_Str(unop->mask),
499 attr = My_OprAttr_Of_Str(unop->attr);
500 Operation *opn = Operator_Add_Opn(opr, operand, NULL, result);
501 Operation_Attr_Set(opn, mask, attr);
502 opn->implem.opcode = unop->g_op;
503 }
504 }
505
506 /* Register all the core binary operations for the Box compiler. */
My_Register_BinOps(BoxCmp * c)507 static void My_Register_BinOps(BoxCmp *c) {
508 struct {
509 const char *types; /* Three characters describing the types of the result,
510 of the left and right operands (following the map
511 character->type implemented by My_Type_Of_Char) */
512 ASTBinOp op; /* Operator to which the operation refers */
513 const char *mask, /* Mask of attributes (a string which is converted
514 to an OprAttr by calling My_OprAttr_Of_Str) */
515 *attr; /* Attributes to set */
516 BoxGOp g_op; /* Generic opcode to use for assembling the operation */
517
518 } *binop, binops[] = {
519 {"Ppp", ASTBINOP_ASSIGN, "ai", NULL, BOXGOP_MOV},
520 {"Rrr", ASTBINOP_ASSIGN, "ai", NULL, BOXGOP_MOV},
521 {"Iii", ASTBINOP_ASSIGN, "ai", NULL, BOXGOP_MOV},
522 {"CCC", ASTBINOP_ASSIGN, "ai", NULL, BOXGOP_MOV},
523 {"Ppp", ASTBINOP_ADD, "c", NULL, BOXGOP_ADD},
524 {"Rrr", ASTBINOP_ADD, "c", NULL, BOXGOP_ADD},
525 {"Iii", ASTBINOP_ADD, "c", NULL, BOXGOP_ADD},
526 {"Ppp", ASTBINOP_SUB, "", NULL, BOXGOP_SUB},
527 {"Rrr", ASTBINOP_SUB, "", NULL, BOXGOP_SUB},
528 {"Iii", ASTBINOP_SUB, "", NULL, BOXGOP_SUB},
529 {"Ppr", ASTBINOP_MUL, "", NULL, BOXGOP_PMULR},
530 {"Prp", ASTBINOP_MUL, "", NULL, BOXGOP_PMULR},
531 {"Rrr", ASTBINOP_MUL, "c", NULL, BOXGOP_MUL},
532 {"Iii", ASTBINOP_MUL, "c", NULL, BOXGOP_MUL},
533 {"Ppr", ASTBINOP_DIV, "", NULL, BOXGOP_PDIVR},
534 {"Rrr", ASTBINOP_DIV, "", NULL, BOXGOP_DIV},
535 {"Iii", ASTBINOP_DIV, "", NULL, BOXGOP_DIV},
536 {"Iii", ASTBINOP_REM, "", NULL, BOXGOP_REM},
537 {"Rrr", ASTBINOP_POW, "", NULL, BOXGOP_POW},
538 {"Iii", ASTBINOP_POW, "", NULL, BOXGOP_POW},
539 {"Iii", ASTBINOP_BAND, "c", NULL, BOXGOP_BAND},
540 {"Iii", ASTBINOP_BXOR, "c", NULL, BOXGOP_BXOR},
541 {"Iii", ASTBINOP_BOR, "c", NULL, BOXGOP_BOR},
542 {"Iii", ASTBINOP_SHL, "", NULL, BOXGOP_SHL},
543 {"Iii", ASTBINOP_SHR, "", NULL, BOXGOP_SHR},
544 {"Iii", ASTBINOP_LAND, "c", NULL, BOXGOP_LAND},
545 {"Iii", ASTBINOP_LOR, "c", NULL, BOXGOP_LOR},
546 {"Ppp", ASTBINOP_APLUS, "ai", NULL, BOXGOP_ADD},
547 {"Rrr", ASTBINOP_APLUS, "ai", NULL, BOXGOP_ADD},
548 {"Iii", ASTBINOP_APLUS, "ai", NULL, BOXGOP_ADD},
549 {"Ppp", ASTBINOP_AMINUS, "ai", NULL, BOXGOP_SUB},
550 {"Rrr", ASTBINOP_AMINUS, "ai", NULL, BOXGOP_SUB},
551 {"Iii", ASTBINOP_AMINUS, "ai", NULL, BOXGOP_SUB},
552 {"Rrr", ASTBINOP_ATIMES, "ai", NULL, BOXGOP_MUL},
553 {"Iii", ASTBINOP_ATIMES, "ai", NULL, BOXGOP_MUL},
554 {"Rrr", ASTBINOP_ADIV, "ai", NULL, BOXGOP_DIV},
555 {"Iii", ASTBINOP_ADIV, "ai", NULL, BOXGOP_DIV},
556 {"Iii", ASTBINOP_AREM, "ai", NULL, BOXGOP_REM},
557 {"Iii", ASTBINOP_ASHL, "ai", NULL, BOXGOP_SHL},
558 {"Iii", ASTBINOP_ASHR, "ai", NULL, BOXGOP_SHR},
559 {"Iii", ASTBINOP_ABAND, "ai", NULL, BOXGOP_BAND},
560 {"Iii", ASTBINOP_ABXOR, "ai", NULL, BOXGOP_BXOR},
561 {"Iii", ASTBINOP_ABOR, "ai", NULL, BOXGOP_BOR},
562 {"Ipp", ASTBINOP_EQ, "c", NULL, BOXGOP_EQ},
563 {"Irr", ASTBINOP_EQ, "c", NULL, BOXGOP_EQ},
564 {"Iii", ASTBINOP_EQ, "c", NULL, BOXGOP_EQ},
565 {"Ipp", ASTBINOP_NE, "c", NULL, BOXGOP_NE},
566 {"Irr", ASTBINOP_NE, "c", NULL, BOXGOP_NE},
567 {"Iii", ASTBINOP_NE, "c", NULL, BOXGOP_NE},
568 {"Irr", ASTBINOP_LT, "", NULL, BOXGOP_LT},
569 {"Iii", ASTBINOP_LT, "", NULL, BOXGOP_LT},
570 {"Irr", ASTBINOP_LE, "", NULL, BOXGOP_LE},
571 {"Iii", ASTBINOP_LE, "", NULL, BOXGOP_LE},
572 {"Irr", ASTBINOP_GT, "", NULL, BOXGOP_GT},
573 {"Iii", ASTBINOP_GT, "", NULL, BOXGOP_GT},
574 {"Irr", ASTBINOP_GE, "", NULL, BOXGOP_GE},
575 {"Iii", ASTBINOP_GE, "", NULL, BOXGOP_GE},
576 { NULL, 0, NULL, NULL, 0}
577 };
578
579 for(binop = & binops[0]; binop->types != NULL; ++binop) {
580 Operator *opr = BoxCmp_BinOp_Get(c, binop->op);
581 BoxType *result = My_Type_Of_Char(c, binop->types[0]),
582 *left = My_Type_Of_Char(c, binop->types[1]),
583 *right = My_Type_Of_Char(c, binop->types[2]);
584 OprAttr mask = My_OprAttr_Of_Str(binop->mask),
585 attr = My_OprAttr_Of_Str(binop->attr);
586 Operation *opn = Operator_Add_Opn(opr, left, right, result);
587 Operation_Attr_Set(opn, mask, attr);
588 opn->implem.opcode = binop->g_op;
589 }
590 }
591
592 /* Register all the conversion operations for the Box compiler. */
My_Register_Conversions(BoxCmp * c)593 static void My_Register_Conversions(BoxCmp *c) {
594 Operator *convert = & c->convert;
595 BoxVMCallNum struc_to_point_call_num;
596
597 struct {
598 const char *types; /* Two characters describing the types of the source
599 and destination of the conversion, following the map
600 character->type implemented by My_Type_Of_Char) */
601 const char *mask, /* Mask of attributes (a string which is converted
602 to an OprAttr by calling My_OprAttr_Of_Str) */
603 *attr; /* Attributes to set */
604 BoxGOp g_op; /* Generic opcode to use for assembling the operation */
605
606 } *conv, convs[] = {
607 { "IR", "", NULL, BOXGOP_REAL},
608 { "CR", "", NULL, BOXGOP_REAL},
609 { "RI", "", NULL, BOXGOP_INT},
610 { "CI", "", NULL, BOXGOP_INT},
611 { NULL, NULL, NULL, 0}
612 };
613
614 for(conv = & convs[0]; conv->types != NULL; ++conv) {
615 BoxType *src = My_Type_Of_Char(c, conv->types[0]),
616 *dst = My_Type_Of_Char(c, conv->types[1]);
617 OprAttr mask = My_OprAttr_Of_Str(conv->mask),
618 attr = My_OprAttr_Of_Str(conv->attr);
619 Operation *opn = Operator_Add_Opn(convert, src, NULL, dst);
620 Operation_Attr_Set(opn, mask, attr);
621 opn->implem.opcode = conv->g_op;
622 }
623
624 /* Conversion (Real, Real) -> Point */
625 Operation *opn =
626 Operator_Add_Opn(convert,
627 Box_Get_Core_Type(BOXTYPEID_REAL_COUPLE),
628 NULL, My_Type_Of_Char(c, 'P'));
629
630 struc_to_point_call_num = Bltin_Proc_Add(c, "conv_2r_to_point", My_2R_To_P);
631 Operation_Set_User_Implem(opn, struc_to_point_call_num);
632 }
633
Bltin_Simple_Fn_Def(BoxCmp * c,const char * name,BoxTypeId ret,BoxTypeId arg,BoxVMFunc fn)634 BoxType *Bltin_Simple_Fn_Def(BoxCmp *c, const char *name,
635 BoxTypeId ret, BoxTypeId arg, BoxVMFunc fn) {
636 BoxType *new_type;
637 Value *v;
638
639 new_type = BoxType_Create_Ident(BoxType_Link(Box_Get_Core_Type(ret)), name);
640
641 (void) Bltin_Proc_Def_With_Id(new_type, arg, fn);
642 v = Value_Create(c->cur_proc);
643 Value_Setup_As_Type(v, new_type);
644 (void) BoxType_Unlink(new_type);
645 Namespace_Add_Value(& c->ns, NMSPFLOOR_DEFAULT, name, v);
646 Value_Unlink(v);
647 return new_type;
648 }
649
My_Register_Std_IO(BoxCmp * c)650 static void My_Register_Std_IO(BoxCmp *c) {
651 BoxType *t_print = Box_Get_Core_Type(BOXTYPEID_PRINT);
652 BoxCombDef defs[] =
653 {BOXCOMBDEF_I_AT_T(BOXTYPEID_PAUSE, t_print, Box_Runtime_Pause_At_Print),
654 BOXCOMBDEF_I_AT_T(BOXTYPEID_CHAR, t_print, Box_Runtime_CHAR_At_Print),
655 BOXCOMBDEF_I_AT_T(BOXTYPEID_INT, t_print, Box_Runtime_INT_At_Print),
656 BOXCOMBDEF_I_AT_T(BOXTYPEID_REAL, t_print, Box_Runtime_REAL_At_Print),
657 BOXCOMBDEF_I_AT_T(BOXTYPEID_SPOINT, t_print, Box_Runtime_Point_At_Print),
658 BOXCOMBDEF_I_AT_T(BOXTYPEID_STR, t_print, Box_Runtime_Str_At_Print)};
659 size_t num_defs = sizeof(defs)/sizeof(BoxCombDef);
660 (void) BoxCombDef_Define(defs, num_defs);
661 }
662
My_Register_Std_Procs(BoxCmp * c)663 static void My_Register_Std_Procs(BoxCmp *c) {
664 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_CHAR, BOXTYPEID_CHAR, My_Char_Char);
665 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_CHAR, BOXTYPEID_INT, My_Char_Int);
666 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_CHAR, BOXTYPEID_REAL, My_Char_Real);
667 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_INT, BOXTYPEID_SINT, My_Int_Int);
668 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_INT, BOXTYPEID_REAL, My_Int_Real);
669 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_REAL, BOXTYPEID_SREAL, My_Real_Real);
670 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_POINT, BOXTYPEID_SPOINT,
671 My_Point_RealNumCouple);
672 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_IF, BOXTYPEID_SINT, My_If_Int);
673 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_ELIF, BOXTYPEID_SINT, My_If_Int);
674 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_FOR, BOXTYPEID_SINT, My_For_Int);
675
676 c->bltin.subtype_init = Bltin_Proc_Add(c, "subtype_init", My_Subtype_Init);
677 c->bltin.subtype_finish = Bltin_Proc_Add(c, "subtype_finish",
678 My_Subtype_Finish);
679 }
680
My_Register_Math(BoxCmp * c)681 static void My_Register_Math(BoxCmp *c) {
682 BoxTypeId t_real = BOXTYPEID_SREAL,
683 t_point = BOXTYPEID_SPOINT;
684 struct {
685 const char *name;
686 BoxTypeId parent,
687 child;
688 BoxVMFunc func_begin,
689 func;
690 } *fn, fns[] = {
691 { "Sqrt", BOXTYPEID_REAL, t_real, NULL, My_Math_Sqrt},
692 { "Sin", BOXTYPEID_REAL, t_real, NULL, My_Math_Sin},
693 { "Cos", BOXTYPEID_REAL, t_real, NULL, My_Math_Cos},
694 { "Tan", BOXTYPEID_REAL, t_real, NULL, My_Math_Tan},
695 { "Asin", BOXTYPEID_REAL, t_real, NULL, My_Math_Asin},
696 { "Acos", BOXTYPEID_REAL, t_real, NULL, My_Math_Acos},
697 { "Atan", BOXTYPEID_REAL, t_real, NULL, My_Math_Atan},
698 {"Atan2", BOXTYPEID_REAL, t_point, NULL, My_Math_Atan2},
699 { "Exp", BOXTYPEID_REAL, t_real, NULL, My_Math_Exp},
700 { "Log", BOXTYPEID_REAL, t_real, NULL, My_Math_Log},
701 {"Log10", BOXTYPEID_REAL, t_real, NULL, My_Math_Log10},
702 { "Ceil", BOXTYPEID_INT, t_real, NULL, My_Math_Ceil},
703 {"Floor", BOXTYPEID_INT, t_real, NULL, My_Math_Floor},
704 { "Abs", BOXTYPEID_REAL, t_real, NULL, My_Math_Abs},
705 { "Norm", BOXTYPEID_REAL, t_point, NULL, My_Math_Norm},
706 {"Norm2", BOXTYPEID_REAL, t_point, NULL, My_Math_Norm2},
707 { "Vec", BOXTYPEID_POINT, t_real, NULL, My_Vec_Real},
708 { "Ort", BOXTYPEID_POINT, t_point, NULL, My_Point_At_Ort},
709 { "Min", BOXTYPEID_REAL, t_real, My_Min_Open, My_Min_Real},
710 { "Max", BOXTYPEID_REAL, t_real, My_Max_Open, My_Max_Real},
711 { NULL, BOXTYPEID_NONE, BOXTYPEID_NONE, NULL, NULL}
712 };
713
714 for(fn = fns; fn->func != NULL; fn++) {
715 BoxType *func_type =
716 Bltin_Simple_Fn_Def(c, fn->name, fn->parent, fn->child, fn->func);
717 if (fn->func_begin != NULL)
718 (void) Bltin_Proc_Def_With_Id(func_type, BOXTYPEID_BEGIN, fn->func_begin);
719 }
720 }
721
My_Register_Sys(BoxCmp * c)722 static void My_Register_Sys(BoxCmp *c) {
723 BoxType *fail_t = Bltin_Simple_Fn_Def(c, "Fail", BOXTYPEID_VOID,
724 BOXTYPEID_STR, My_Fail_Msg);
725
726 (void) Bltin_Proc_Def_With_Id(fail_t, BOXTYPEID_BEGIN, My_Fail_Clear_Msg);
727 (void) Bltin_Proc_Def_With_Id(fail_t, BOXTYPEID_END, My_Fail);
728 (void) Bltin_Simple_Fn_Def(c, "Exit", BOXTYPEID_VOID, BOXTYPEID_SINT,
729 My_Exit_Int);
730
731 (void) Bltin_Proc_Def_With_Id(Box_Get_Core_Type(BOXTYPEID_NUM),
732 BOXTYPEID_BEGIN, My_Num_Init);
733
734 BoxType *isvalid =
735 Bltin_Simple_Fn_Def(c, "IsValid", BOXTYPEID_INT,
736 BOXTYPEID_BEGIN, My_IsValid_Init);
737 (void) Bltin_Proc_Def_With_Id(isvalid, BOXTYPEID_INT, My_Int_At_IsValid);
738
739 (void) Bltin_Proc_Def_With_Ids(BOXTYPEID_COMPARE, BOXTYPEID_BEGIN,
740 My_Compare_Init);
741 }
742
743 /* Register bultin types, operation and functions */
Bltin_Init(BoxCmp * c)744 void Bltin_Init(BoxCmp *c) {
745 My_Register_Core_Types(c);
746 My_Register_UnOps(c);
747 My_Register_BinOps(c);
748 My_Register_Conversions(c);
749 My_Register_Std_IO(c);
750 My_Register_Std_Procs(c);
751 My_Register_Math(c);
752 My_Register_Sys(c);
753 Bltin_Str_Register_Procs(c);
754 Bltin_IO_Register(c);
755 }
756
Bltin_Finish(BoxCmp * c)757 void Bltin_Finish(BoxCmp *c) {
758 Bltin_IO_Unregister(c);
759 }
760
761 /*****************************************************************************
762 * Generic procedures for builtin stuff defined inside other files.
763 */
764
Bltin_Create_Type(BoxCmp * c,const char * type_name,size_t type_size,size_t alignment)765 BoxType *Bltin_Create_Type(BoxCmp *c, const char *type_name,
766 size_t type_size, size_t alignment) {
767 Value *v = Value_Create(c->cur_proc);
768 BoxType *t;
769 t = BoxType_Create_Ident(BoxType_Create_Intrinsic(type_size, alignment),
770 type_name);
771 Value_Setup_As_Type(v, t);
772 (void) BoxType_Unlink(t);
773 Namespace_Add_Value(& c->ns, NMSPFLOOR_DEFAULT, type_name, v);
774 Value_Unlink(v);
775 return t;
776 }
777