1 /*
2 csound_orc_semantics.c:
3
4 Copyright (C) 2006
5 John ffitch, Steven Yi
6
7 This file is part of Csound.
8
9 The Csound Library is free software; you can redistribute it
10 and/or modify it under the terms of the GNU Lesser General Public
11 License as published by the Free Software Foundation; either
12 version 2.1 of the License, or (at your option) any later version.
13
14 Csound is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU Lesser General Public License for more details.
18
19 You should have received a copy of the GNU Lesser General Public
20 License along with Csound; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
22 02110-1301 USA
23 */
24
25 #include <stdio.h>
26 #include <stdlib.h>
27 #include <ctype.h>
28 //#include <stdbool.h>
29 #include "csoundCore.h"
30 #include "csound_orc.h"
31 #include "namedins.h"
32 #include "parse_param.h"
33 #include "csound_type_system.h"
34 #include "csound_standard_types.h"
35 #include "csound_orc_expressions.h"
36 #include "csound_orc_semantics.h"
37
38 extern char *csound_orcget_text ( void *scanner );
39 static int is_label(char* ident, CONS_CELL* labelList);
40
41 extern uint64_t csound_orcget_locn(void *);
42 extern char argtyp2(char*);
43 extern int tree_arg_list_count(TREE *);
44 void print_tree(CSOUND *, char *, TREE *);
45
46 /* from csound_orc_compile.c */
47 extern int argsRequired(char* arrayName);
48 extern char** splitArgs(CSOUND* csound, char* argString);
49 extern int pnum(char*);
50
51 OENTRIES* find_opcode2(CSOUND*, char*);
52 char* resolve_opcode_get_outarg(CSOUND* csound,
53 OENTRIES* entries, char* inArgTypes);
54 int check_out_args(CSOUND* csound, char* outArgsFound, char* opOutArgs);
55 char* get_arg_string_from_tree(CSOUND* csound, TREE* tree,
56 TYPE_TABLE* typeTable);
57 char* convert_internal_to_external(CSOUND* csound, char* arg);
58 char* convert_external_to_internal(CSOUND* csound, char* arg);
59 void do_baktrace(CSOUND *csound, uint64_t files);
60
61 const char* SYNTHESIZED_ARG = "_synthesized";
62
cs_strdup(CSOUND * csound,char * str)63 char* cs_strdup(CSOUND* csound, char* str) {
64 size_t len;
65 char* retVal;
66
67 if (str == NULL) return NULL;
68
69 len = strlen(str);
70 retVal = csound->Malloc(csound, len + 1);
71
72 if (len > 0) {
73 memcpy(retVal, str, len);
74 }
75 retVal[len] = '\0';
76
77 return retVal;
78 }
79
cs_strndup(CSOUND * csound,char * str,size_t size)80 char* cs_strndup(CSOUND* csound, char* str, size_t size) {
81 size_t len;
82 char* retVal;
83
84 if (str == NULL || size == 0) return NULL;
85 len = strlen(str);
86
87 if (size > len) { // catches if str is empty string
88 return cs_strdup(csound, str);
89 }
90
91 retVal = csound->Malloc(csound, size + 1);
92 memcpy(retVal, str, size);
93 retVal[size] = '\0';
94
95 return retVal;
96 }
97
get_expression_opcode_type(CSOUND * csound,TREE * tree)98 char* get_expression_opcode_type(CSOUND* csound, TREE* tree) {
99 switch(tree->type) {
100 case '+':
101 return "##add";
102 case '-':
103 return "##sub";
104 case '*':
105 return "##mul";
106 case '%':
107 return "##mod";
108 case '/':
109 return "##div";
110 case '^':
111 return "##pow";
112 case S_UMINUS:
113 return "##mul";
114 case '|':
115 return "##or";
116 case '&':
117 return "##and";
118 case S_BITSHIFT_RIGHT:
119 return "##shr";
120 case S_BITSHIFT_LEFT:
121 return "##shl";
122 case '#':
123 return "##xor";
124 case '~':
125 return "##not";
126 case T_ARRAY:
127 return "##array_get";
128 case S_ADDIN:
129 return "##addin";
130 }
131 csound->Warning(csound, Str("Unknown function type found: %d [%c]\n"),
132 tree->type, tree->type);
133 return NULL;
134 }
135
get_boolean_expression_opcode_type(CSOUND * csound,TREE * tree)136 char* get_boolean_expression_opcode_type(CSOUND* csound, TREE* tree) {
137 switch(tree->type) {
138 case S_EQ:
139 return "==";
140 case S_NEQ:
141 return "!=";
142 case S_GE:
143 return ">=";
144 case S_LE:
145 return "<=";
146 case S_GT:
147 return ">";
148 case S_LT:
149 return "<";
150 case S_AND:
151 return "&&";
152 case S_OR:
153 return "||";
154 case S_UNOT:
155 return "!";
156 }
157 csound->Warning(csound,
158 Str("Unknown boolean expression type found: %d\n"),
159 tree->type);
160 return NULL;
161 }
162
163 //FIXME - current just returns subtype but assumes single char type name,
164 // should check for long type names, as well as check dimensions and remove one
get_array_sub_type(CSOUND * csound,char * arrayName)165 char* get_array_sub_type(CSOUND* csound, char* arrayName) {
166 char temp[2];
167 char *t = arrayName;
168
169 if (*t == '#') t++;
170 if (*t == 'g') t++;
171
172 if (*t == 't') { /* Support legacy t-vars by mapping to k subtypes */
173 return cs_strdup(csound, "k");
174 }
175
176 while (*t == '[') {
177 t++;
178 }
179 temp[0] = *t;
180 temp[1] = 0;
181 return cs_strdup(csound, temp);
182 }
183
create_array_arg_type(CSOUND * csound,CS_VARIABLE * arrayVar)184 char* create_array_arg_type(CSOUND* csound, CS_VARIABLE* arrayVar) {
185
186 int i, len = arrayVar->dimensions + 3;
187 if (arrayVar->subType!=NULL) {
188 char* retVal = csound->Malloc(csound, len);
189 retVal[len - 1] = '\0';
190 retVal[len - 2] = ']';
191 retVal[len - 3] = *arrayVar->subType->varTypeName;
192 for (i = len - 4; i >= 0; i--) {
193 retVal[i] = '[';
194 }
195 return retVal;
196 }
197 else
198 return NULL;
199 }
200
201 /* this checks if the annotated type exists */
check_annotated_type(CSOUND * csound,OENTRIES * entries,char * outArgTypes)202 char *check_annotated_type(CSOUND* csound, OENTRIES* entries,
203 char* outArgTypes) {
204 int i;
205 for (i = 0; i < entries->count; i++) {
206 OENTRY* temp = entries->entries[i];
207 if (check_out_args(csound, outArgTypes, temp->outypes))
208 return outArgTypes;
209 }
210 return NULL;
211 }
212
isirate(TREE * t)213 static int isirate(/*CSOUND *csound,*/ TREE *t)
214 { /* check that argument is an i-rate constant or variable */
215 //print_tree(csound, "isirate", t);
216 if (t->type == INTEGER_TOKEN) {
217 //printf("integer case\n");
218 return 1;
219 }
220 else if (t->type == T_IDENT) {
221 //printf("identifier case\n");
222 if (t->value->lexeme[0] != 'p' &&
223 t->value->lexeme[0] != 'i' &&
224 (t->value->lexeme[0] != 'g' ||
225 t->value->lexeme[1] != 'i')) return 0;
226 return 1;
227 }
228 else if (t->type == T_ARRAY) {
229 //printf("array case\n");
230 if (isirate(/*csound, */t->right)==0) return 0;
231 t = t->next;
232 while (t) {
233 //printf("t=%p t->type=%d\n", t, t->type);
234 if (isirate(/*csound,*/ t)==0) return 0;
235 t = t->next;
236 }
237 return 1;
238 }
239 else return 0;
240 }
241
242 /* This function gets arg type with checking type table */
get_arg_type2(CSOUND * csound,TREE * tree,TYPE_TABLE * typeTable)243 char* get_arg_type2(CSOUND* csound, TREE* tree, TYPE_TABLE* typeTable)
244 {
245 char* s;
246 char* t;
247 //CS_TYPE* type;
248 CS_VARIABLE* var;
249
250 if (is_expression_node(tree)) {
251 TREE* nodeToCheck = tree;
252
253 if (tree->type == T_ARRAY) {
254 char* leftArgType = get_arg_type2(csound, tree->left, typeTable);
255
256 //FIXME - should use CS_TYPE and not interrogate string
257 if (leftArgType[0] == '[') {
258 return get_array_sub_type(csound, tree->left->value->lexeme);
259 }
260 else {
261 char* rightArgType = get_arg_string_from_tree(csound, tree->right,
262 typeTable);
263
264 leftArgType =
265 csound->ReAlloc(csound, leftArgType,
266 strlen(leftArgType) + strlen(rightArgType) + 1);
267 char* argString = strcat(leftArgType, rightArgType);
268
269 OENTRIES* opentries = find_opcode2(csound, "##array_get");
270 char* outype = resolve_opcode_get_outarg(csound,
271 opentries,
272 argString);
273
274 csound->Free(csound, opentries);
275 if (UNLIKELY(outype == NULL)) {
276 synterr(csound,
277 Str("unable to find array operator for "
278 "types %s line %d\n"),
279 argString, tree->line);
280 do_baktrace(csound, tree->locn);
281 return NULL;
282 }
283
284 csound->Free(csound, leftArgType);
285 csound->Free(csound, rightArgType);
286 return cs_strdup(csound, outype);
287 }
288 }
289
290 if (tree->type == '?') {
291 char* arg1, *arg2, *ans, *out;
292 char condInTypes[64];
293
294 ans = get_arg_type2(csound, tree->left, typeTable);
295 if (UNLIKELY(ans == NULL || (*ans != 'b' && *ans != 'B'))) {
296 synterr(csound,
297 Str("non-boolean expression found for ternary operator,"
298 " line %d\n"), tree->line);
299 do_baktrace(csound, tree->locn);
300 return NULL;
301 }
302 arg1 = get_arg_type2(csound, tree->right->left, typeTable);
303 arg2 = get_arg_type2(csound, tree->right->right, typeTable);
304
305 snprintf(condInTypes, 64, "%s%s%s", ans, arg1, arg2);
306
307 OENTRIES* opentries = find_opcode2(csound, ":cond");
308 out = resolve_opcode_get_outarg(csound,
309 opentries,
310 condInTypes);
311
312 csound->Free(csound, opentries);
313 if (UNLIKELY(out == NULL)) {
314 synterr(csound,
315 Str("unable to find ternary operator for "
316 "types '%s ? %s : %s' line %d\n"),
317 ans, arg1, arg2, tree->line);
318 do_baktrace(csound, tree->locn);
319 return NULL;
320 }
321
322 csound->Free(csound, arg1);
323 csound->Free(csound, arg2);
324 csound->Free(csound, ans);
325 return cs_strdup(csound, out);
326
327 }
328
329 // Deal with odd case of i(expressions)
330 if (tree->type == T_FUNCTION && !strcmp(tree->value->lexeme, "i")) {
331 //print_tree(csound, "i()", tree);
332 if (tree->right->type == T_ARRAY &&
333 tree->right->left->type == T_IDENT &&
334 isirate(/*csound,*/ tree->right->right)) {
335 synterr(csound, Str("Use of i() with array element ill formed\n"));
336 }
337 else
338 if (UNLIKELY(tree->right->type != LABEL_TOKEN))
339 synterr(csound,
340 Str("Use of i() with expression not permitted on line %d\n"),
341 tree->line);
342 }
343
344 if (tree->type == T_FUNCTION) {
345 char* argTypeRight = get_arg_string_from_tree(csound,
346 tree->right, typeTable);
347 char* opname = tree->value->lexeme;
348 OENTRIES* entries = find_opcode2(csound, opname);
349 char * out;
350
351 if (tree->value->optype != NULL) /* if there is type annotation */
352 out = check_annotated_type(csound, entries, tree->value->optype);
353 else out = resolve_opcode_get_outarg(csound, entries, argTypeRight);
354
355
356 if (UNLIKELY(out == 0)) {
357 synterr(csound, Str("error: opcode '%s' for expression with arg "
358 "types %s not found, line %d\n"),
359 opname, argTypeRight, tree->line);
360 do_baktrace(csound, tree->locn);
361 return NULL;
362 }
363 csound->Free(csound, argTypeRight);
364 csound->Free(csound, entries);
365 return cs_strdup(csound, out);
366
367 }
368
369 char* argTypeRight = get_arg_type2(csound,
370 nodeToCheck->right, typeTable);
371
372 if (nodeToCheck->left != NULL) {
373 char* argTypeLeft = get_arg_type2(csound, nodeToCheck->left, typeTable);
374
375 char* opname = get_expression_opcode_type(csound, nodeToCheck);
376 int len1, len2;
377 char* inArgTypes;
378 char* out;
379
380 if (UNLIKELY(argTypeLeft == NULL || argTypeRight == NULL)) {
381 synterr(csound,
382 Str("Unable to verify arg types for expression '%s'\n"
383 "Line %d\n"),
384 opname, tree->line);
385 do_baktrace(csound, tree->locn);
386 return NULL;
387 }
388
389 OENTRIES* entries = find_opcode2(csound, opname);
390
391 argTypeLeft = convert_internal_to_external(csound, argTypeLeft);
392 argTypeRight = convert_internal_to_external(csound, argTypeRight);
393
394 len1 = strlen(argTypeLeft);
395 len2 = strlen(argTypeRight);
396 inArgTypes = csound->Malloc(csound, len1 + len2 + 1);
397
398 memcpy(inArgTypes, argTypeLeft, len1);
399 memcpy(inArgTypes + len1, argTypeRight, len2);
400
401 inArgTypes[len1 + len2] = '\0';
402
403 out = resolve_opcode_get_outarg(csound, entries, inArgTypes);
404 csound->Free(csound, entries);
405
406 if (UNLIKELY(out == NULL)) {
407 synterr(csound, Str("error: opcode '%s' for expression with arg "
408 "types %s not found, line %d\n"),
409 opname, inArgTypes, tree->line);
410 do_baktrace(csound, tree->locn);
411 csound->Free(csound, inArgTypes);
412 return NULL;
413 }
414
415 csound->Free(csound, argTypeLeft);
416 csound->Free(csound, argTypeRight);
417
418 csound->Free(csound, inArgTypes);
419 return cs_strdup(csound, out);
420
421 } else {
422 return argTypeRight;
423 }
424
425 }
426
427 if (is_boolean_expression_node(tree)) {
428 if (tree->type == S_UNOT) {
429 return get_arg_type2(csound, tree->left, typeTable);
430 }
431 else {
432 char* argTypeLeft = get_arg_type2(csound, tree->left, typeTable);
433 char* argTypeRight = get_arg_type2(csound, tree->right, typeTable);
434
435 char* opname = get_boolean_expression_opcode_type(csound, tree);
436 int len1, len2;
437 char* inArgTypes;
438 char* out;
439 OENTRIES* entries;
440
441 if (UNLIKELY(argTypeLeft == NULL || argTypeRight == NULL)) {
442 synterr(csound,
443 Str("Unable to verify arg types for boolean expression '%s'\n"
444 "Line %d\n"),
445 opname, tree->line);
446 do_baktrace(csound, tree->locn);
447 return NULL;
448 }
449
450 entries = find_opcode2(csound, opname);
451
452 len1 = strlen(argTypeLeft);
453 len2 = strlen(argTypeRight);
454 inArgTypes = csound->Malloc(csound, len1 + len2 + 1);
455
456 memcpy(inArgTypes, argTypeLeft, len1);
457 memcpy(inArgTypes + len1, argTypeRight, len2);
458
459 inArgTypes[len1 + len2] = '\0';
460
461 out = resolve_opcode_get_outarg(csound, entries, inArgTypes);
462 csound->Free(csound, entries);
463
464 if (UNLIKELY(out == NULL)) {
465 synterr(csound, Str("error: boolean expression '%s' with arg "
466 "types %s not found, line %d\n"),
467 opname, inArgTypes, tree->line);
468 do_baktrace(csound, tree->locn);
469 csound->Free(csound, inArgTypes);
470 return NULL;
471 }
472
473 csound->Free(csound, argTypeLeft);
474 csound->Free(csound, argTypeRight);
475 csound->Free(csound, inArgTypes);
476 return cs_strdup(csound, out);
477
478 }
479 }
480
481 switch(tree->type) {
482 case NUMBER_TOKEN:
483 case INTEGER_TOKEN:
484 return cs_strdup(csound, "c"); /* const */
485 case STRING_TOKEN:
486 return cs_strdup(csound, "S"); /* quoted String */
487 case SRATE_TOKEN:
488 case KRATE_TOKEN:
489 case KSMPS_TOKEN:
490 case A4_TOKEN:
491 case ZERODBFS_TOKEN:
492 case NCHNLS_TOKEN:
493 case NCHNLSI_TOKEN:
494 return cs_strdup(csound, "r"); /* rsvd */
495 case LABEL_TOKEN:
496 //FIXME: Need to review why label token is used so much in parser,
497 //for now treat as T_IDENT
498 case T_ARRAY_IDENT:
499 case T_IDENT:
500
501 s = tree->value->lexeme;
502 if (s == NULL) {
503 /* VL: 8/3/2018
504 something very wrong happened.
505 To prevent a crash, we get out
506 here. Not sure if any other
507 diagnostics are due */
508 return NULL;
509 }
510
511 if (is_label(s, typeTable->labelList)) {
512 return cs_strdup(csound, "l");
513 }
514
515 if (*s == 't') { /* Support legacy t-vars by mapping to k-array */
516 return cs_strdup(csound, "[k]");
517 }
518
519 if ((*s >= '1' && *s <= '9') || *s == '.' || *s == '-' || *s == '+' ||
520 (*s == '0' && strcmp(s, "0dbfs") != 0))
521 return cs_strdup(csound, "c"); /* const */
522 if (*s == '"')
523 return cs_strdup(csound, "S");
524
525 if (pnum(s) >= 0)
526 return cs_strdup(csound, "p"); /* pnum */
527
528 if (*s == '#')
529 s++;
530
531 /* VL: 16/01/2014
532 in a second compilation, the
533 typeTable->globalPool is incorrect and will not
534 contain the correct addresses of global variables,
535 which are stored correctly in the engineState.varPool.
536 Ideally we should remove typeTable->globalPool and only use
537 the varPool in the engineState
538 */
539
540 if (*s == 'g') {
541 var = csoundFindVariableWithName(csound, csound->engineState.varPool,
542 tree->value->lexeme);
543 if (var == NULL)
544 var = csoundFindVariableWithName(csound, typeTable->globalPool,
545 tree->value->lexeme);
546 //printf("var: %p %s\n", var, var->varName);
547 } else
548 var = csoundFindVariableWithName(csound, typeTable->localPool,
549 tree->value->lexeme);
550
551 if (UNLIKELY(var == NULL)) {
552 synterr(csound, Str("Variable '%s' used before defined\n"
553 "Line %d\n"),
554 tree->value->lexeme, tree->line-1); /* -1 as read next line! */
555 do_baktrace(csound, tree->locn);
556 return NULL;
557 }
558
559 if (var->varType == &CS_VAR_TYPE_ARRAY) {
560 char *res = create_array_arg_type(csound, var);
561 if (res==NULL) { /* **REVIEW** this double syntax error */
562 synterr(csound, Str("Array of unknown type\n"));
563 csoundMessage(csound, Str("Line: %d\n"), tree->line-1);
564 do_baktrace(csound, tree->locn);
565 }
566 return res;
567 } else {
568 return cs_strdup(csound, var->varType->varTypeName);
569 }
570
571
572 case T_ARRAY:
573
574 s = tree->value->lexeme;
575
576 if (*s == '#') s++;
577 if (*s == 'g') s++;
578
579 if (*s == 't') { /* Support legacy t-vars by mapping to k-array */
580 return cs_strdup(csound, "[k]");
581 }
582
583 t = s;
584
585 int len = 1;
586 while (*t == '[') {
587 t++;
588 len++;
589 }
590
591 char* retVal = csound->Malloc(csound, (len + 2) * sizeof(char));
592 memcpy(retVal, s, len);
593 retVal[len] = ']';
594 retVal[len + 1] = '\0';
595
596 return retVal;
597
598 default:
599 csoundWarning(csound, Str("Unknown arg type: %d\n"), tree->type);
600 print_tree(csound, "Arg Tree\n", tree);
601 return NULL;
602 }
603 }
604
605
606
get_opcode_short_name(CSOUND * csound,char * opname)607 char* get_opcode_short_name(CSOUND* csound, char* opname) {
608
609 char* dot = strchr(opname, '.');
610 if (dot != NULL) {
611 int opLen = dot - opname;
612 return cs_strndup(csound, opname, opLen);
613 }
614 return opname;
615 }
616
617 /* find opcode with the specified name in opcode list */
618 /* returns index to opcodlst[], or zero if the opcode cannot be found */
619
find_opcode(CSOUND * csound,char * opname)620 OENTRY* find_opcode(CSOUND *csound, char *opname)
621 {
622 char *shortName;
623 CONS_CELL* head;
624 OENTRY* retVal;
625
626 if (opname[0] == '\0' || isdigit(opname[0]))
627 return 0;
628
629 shortName = get_opcode_short_name(csound, opname);
630
631 head = cs_hash_table_get(csound, csound->opcodes, shortName);
632
633 retVal = (head != NULL) ? head->value : NULL;
634 if (shortName != opname) csound->Free(csound, shortName);
635
636 return retVal;
637 }
638
get_entries(CSOUND * csound,int count)639 static OENTRIES* get_entries(CSOUND* csound, int count)
640 {
641 OENTRIES* x = csound->Calloc(csound, sizeof(OENTRIES*)+sizeof(OENTRY*)*count);
642 x->count = count;
643 return x;
644 }
645
646 /* Finds OENTRIES that match the given opcode name. May return multiple
647 * OENTRY*'s for each entry in a polyMorphic opcode.
648 */
find_opcode2(CSOUND * csound,char * opname)649 OENTRIES* find_opcode2(CSOUND* csound, char* opname)
650 {
651 int i = 0;
652 char *shortName;
653 CONS_CELL *head;
654 OENTRIES* retVal;
655
656 if (UNLIKELY(opname == NULL)) {
657 return NULL;
658 }
659
660 shortName = get_opcode_short_name(csound, opname);
661 head = cs_hash_table_get(csound, csound->opcodes, shortName);
662 retVal = get_entries(csound, cs_cons_length(head));
663 while (head != NULL) {
664 retVal->entries[i++] = head->value;
665 head = head->next;
666 }
667
668 if (shortName != opname) {
669 csound->Free(csound, shortName);
670 }
671
672 return retVal;
673
674 }
675
is_in_optional_arg(char arg)676 inline static int is_in_optional_arg(char arg) {
677 return (strchr("opqvjhOJVP?", arg) != NULL);
678 }
679
is_in_var_arg(char arg)680 inline static int is_in_var_arg(char arg) {
681 return (strchr("mMNnWyzZ*", arg) != NULL);
682 }
683
check_array_arg(char * found,char * required)684 int check_array_arg(char* found, char* required) {
685 char* f = found;
686 char* r = required;
687
688 while (*r == '[') r++;
689
690 if (*r == '.' || *r == '?' || *r == '*') {
691 return 1;
692 }
693
694 while (*f == '[') f++;
695
696 return (*f == *r);
697 }
698
check_in_arg(char * found,char * required)699 int check_in_arg(char* found, char* required) {
700 char* t;
701 int i;
702 if (UNLIKELY(found == NULL || required == NULL)) {
703 return 0;
704 }
705
706 if (strcmp(found, required) == 0) {
707 return 1;
708 }
709
710 if (*required == '.' || *required == '?' || *required == '*') {
711 return 1;
712 }
713
714 if (*found == '[' || *required == '[') {
715 if (*found != *required) {
716 return 0;
717 }
718 return check_array_arg(found, required);
719 }
720
721 t = (char*)POLY_IN_TYPES[0];
722
723 for (i = 0; t != NULL; i += 2) {
724 if (strcmp(required, t) == 0) {
725 return (strchr(POLY_IN_TYPES[i + 1], *found) != NULL);
726 }
727 t = (char*)POLY_IN_TYPES[i + 2];
728 }
729
730 if (is_in_optional_arg(*required)) {
731 t = (char*)OPTIONAL_IN_TYPES[0];
732 for (i = 0; t != NULL; i += 2) {
733 if (strcmp(required, t) == 0) {
734 return (strchr(OPTIONAL_IN_TYPES[i + 1], *found) != NULL);
735 }
736 t = (char*)OPTIONAL_IN_TYPES[i + 2];
737 }
738 }
739
740 if (!is_in_var_arg(*required)) {
741 return 0;
742 }
743
744 t = (char*)VAR_ARG_IN_TYPES[0];
745 for (i = 0; t != NULL; i += 2) {
746 if (strcmp(required, t) == 0) {
747 return (strchr(VAR_ARG_IN_TYPES[i + 1], *found) != NULL);
748 }
749 t = (char*)VAR_ARG_IN_TYPES[i + 2];
750 }
751 return 0;
752 }
753
check_in_args(CSOUND * csound,char * inArgsFound,char * opInArgs)754 int check_in_args(CSOUND* csound, char* inArgsFound, char* opInArgs) {
755 if ((inArgsFound == NULL || strlen(inArgsFound) == 0) &&
756 (opInArgs == NULL || strlen(opInArgs) == 0)) {
757 return 1;
758 }
759
760 if (UNLIKELY(opInArgs == NULL)) {
761 return 0;
762 }
763
764 {
765 int argsFoundCount = argsRequired(inArgsFound);
766 int argsRequiredCount = argsRequired(opInArgs);
767 char** argsRequired = splitArgs(csound, opInArgs);
768 char** argsFound;
769 int i;
770 int argTypeIndex = 0;
771 char* varArg = NULL;
772 int returnVal = 1;
773
774 if (argsRequired == NULL) {
775 return 0;
776 }
777 if (argsFoundCount>=VARGMAX) {
778 return -1;
779 }
780
781 if ((argsFoundCount > argsRequiredCount) &&
782 !(is_in_var_arg(*argsRequired[argsRequiredCount - 1]))) {
783 csound->Free(csound, argsRequired);
784 return 0;
785 }
786
787 argsFound = splitArgs(csound, inArgsFound);
788
789 if (argsFoundCount == 0) {
790 if (is_in_var_arg(*argsRequired[0])) {
791 varArg = argsRequired[0];
792 }
793 } else {
794 for (i = 0; i < argsFoundCount; i++) {
795 char* argFound = argsFound[i];
796
797 if (varArg != NULL) {
798 if (!check_in_arg(argFound, varArg)) {
799 returnVal = 0;
800 break;
801 }
802 } else {
803 char* argRequired = argsRequired[argTypeIndex++];
804 if (!check_in_arg(argFound, argRequired)) {
805 returnVal = 0;
806 break;
807 }
808 if (is_in_var_arg(*argRequired)) {
809 varArg = argRequired;
810 }
811 }
812 }
813 }
814
815 if (returnVal && varArg == NULL) {
816 while (argTypeIndex < argsRequiredCount) {
817 char c = *argsRequired[argTypeIndex++];
818
819 if (!is_in_optional_arg(c) && !is_in_var_arg(c)) {
820 returnVal = 0;
821 break;
822 }
823 }
824
825 }
826 //printf("delete %p\n", argsFound);
827 int n;
828 for (n=0; argsFound[n] != NULL; n++) {
829 // printf("delete %p\n", argsFound[n]);
830 csound->Free(csound, argsFound[n]);
831 }
832 csound->Free(csound, argsFound);
833 //printf("delete %p\n", argsRequired);
834 for (n=0; argsRequired[n] != NULL; n++) {
835 //printf("delete %p\n", argsRequired[n]);
836 csound->Free(csound, argsRequired[n]);
837 }
838 csound->Free(csound, argsRequired);
839
840 return returnVal;
841 }
842 }
843
is_out_var_arg(char arg)844 inline static int is_out_var_arg(char arg) {
845 return (strchr("mzIXNF*", arg) != NULL);
846 }
847
check_out_arg(char * found,char * required)848 int check_out_arg(char* found, char* required) {
849 char* t;
850 int i;
851
852 if (UNLIKELY(found == NULL || required == NULL)) {
853 return 0;
854 }
855
856 // constants not allowed in out args
857 if (strcmp(found, "c") == 0) {
858 return 0;
859 }
860
861 if (*required == '.' || *required == '?' || *required == '*') {
862 return 1;
863 }
864
865 if (*found == '[' || *required == '[') {
866 if (*found != *required) {
867 return 0;
868 }
869 return check_array_arg(found, required);
870 }
871
872 if (strcmp(found, required) == 0) {
873 return 1;
874 }
875
876 t = (char*)POLY_OUT_TYPES[0];
877 for (i = 0; t != NULL; i += 2) {
878 if (strcmp(required, t) == 0) {
879 return (strchr(POLY_OUT_TYPES[i + 1], *found) != NULL);
880 }
881 t = (char*)POLY_OUT_TYPES[i + 2];
882 }
883
884 if (!is_out_var_arg(*required)) {
885 return 0;
886 }
887
888 t = (char*)VAR_ARG_OUT_TYPES[0];
889 for (i = 0; t != NULL; i += 2) {
890 if (strcmp(required, t) == 0) {
891 return (strchr(VAR_ARG_OUT_TYPES[i + 1], *found) != NULL);
892 }
893 t = (char*)VAR_ARG_OUT_TYPES[i + 2];
894 }
895 return 0;
896 }
897
check_out_args(CSOUND * csound,char * outArgsFound,char * opOutArgs)898 int check_out_args(CSOUND* csound, char* outArgsFound, char* opOutArgs)
899 {
900
901 if ((outArgsFound == NULL || strlen(outArgsFound) == 0) &&
902 (opOutArgs == NULL || strlen(opOutArgs) == 0)) {
903 return 1;
904 }
905
906 {
907 int argsFoundCount = argsRequired(outArgsFound);
908 int argsRequiredCount = argsRequired(opOutArgs);
909 char** argsRequired = splitArgs(csound, opOutArgs);
910 char** argsFound;
911 int i;
912 int argTypeIndex = 0;
913 char* varArg = NULL;
914 int returnVal = 1;
915
916 if ((argsFoundCount > argsRequiredCount) &&
917 !(is_out_var_arg(*argsRequired[argsRequiredCount - 1]))) {
918 csound->Free(csound, argsRequired);
919 return 0;
920 }
921
922 argsFound = splitArgs(csound, outArgsFound);
923
924 for (i = 0; i < argsFoundCount; i++) {
925 char* argFound = argsFound[i];
926
927 if (varArg != NULL) {
928 if (!check_out_arg(argFound, varArg)) {
929 returnVal = 0;
930 break;
931 }
932 } else {
933 char* argRequired = argsRequired[argTypeIndex++];
934 if (!check_out_arg(argFound, argRequired)) {
935 returnVal = 0;
936 break;
937 }
938 if (is_out_var_arg(*argRequired)) {
939 varArg = argRequired;
940 }
941 }
942 }
943
944 if (returnVal && varArg == NULL) {
945
946 if (argTypeIndex < argsRequiredCount) {
947 char* argRequired = argsRequired[argTypeIndex];
948 returnVal = is_out_var_arg(*argRequired);
949 } else {
950 returnVal = 1;
951 }
952 }
953 //printf("delete %p\n", argsFound);
954 int n;
955 for (n=0; argsFound[n] != NULL; n++) {
956 // printf("delete %p\n", argsFound[n]);
957 csound->Free(csound, argsFound[n]);
958 }
959 csound->Free(csound, argsFound);
960 //printf("delete %p\n", argsRequired);
961 for (n=0; argsRequired[n] != NULL; n++) {
962 //printf("delete %p\n", argsRequired[n]);
963 csound->Free(csound, argsRequired[n]);
964 }
965 csound->Free(csound, argsRequired);
966
967 return returnVal;
968 }
969 }
970
971
972 /* Given an OENTRIES list, resolve to a single OENTRY* based on the
973 * found in- and out- argtypes. Returns NULL if opcode could not be
974 * resolved. If more than one entry matches, mechanism assumes there
975 * are multiple opcode entries with same types and last one should
976 * override previous definitions.
977 */
resolve_opcode(CSOUND * csound,OENTRIES * entries,char * outArgTypes,char * inArgTypes)978 OENTRY* resolve_opcode(CSOUND* csound, OENTRIES* entries,
979 char* outArgTypes, char* inArgTypes) {
980
981 // OENTRY* retVal = NULL;
982 int i, check;
983
984 for (i = 0; i < entries->count; i++) {
985 OENTRY* temp = entries->entries[i];
986 // if (temp->intypes == NULL && temp->outypes == NULL) {
987 // if (outArgTypes == NULL && inArgTypes == NULL) {
988 //
989 // }
990 // continue;
991 // }
992 if ((check = check_in_args(csound, inArgTypes, temp->intypes)) &&
993 check_out_args(csound, outArgTypes, temp->outypes)) {
994 // if (retVal != NULL) {
995 // return NULL;
996 // }
997 // retVal = temp;
998 if (check == -1)
999 synterr(csound,
1000 Str("Found %d inputs for %s which is more than "
1001 "the %d allowed\n"),
1002 argsRequired(inArgTypes), temp->opname, VARGMAX);
1003
1004 return temp;
1005 }
1006 }
1007 return NULL;
1008 // return retVal;
1009 }
1010
resolve_opcode_exact(CSOUND * csound,OENTRIES * entries,char * outArgTypes,char * inArgTypes)1011 OENTRY* resolve_opcode_exact(CSOUND* csound, OENTRIES* entries,
1012 char* outArgTypes, char* inArgTypes) {
1013 IGN(csound);
1014 OENTRY* retVal = NULL;
1015 int i;
1016
1017 char* outTest = (!strcmp("0", outArgTypes)) ? "" : outArgTypes;
1018 for (i = 0; i < entries->count; i++) {
1019 OENTRY* temp = entries->entries[i];
1020 if (temp->intypes != NULL && !strcmp(inArgTypes, temp->intypes) &&
1021 temp->outypes != NULL && !strcmp(outTest, temp->outypes)) {
1022 retVal = temp;
1023 }
1024 }
1025 return retVal;
1026 }
1027
1028 /* used when creating T_FUNCTION's */
resolve_opcode_get_outarg(CSOUND * csound,OENTRIES * entries,char * inArgTypes)1029 char* resolve_opcode_get_outarg(CSOUND* csound, OENTRIES* entries,
1030 char* inArgTypes) {
1031 int i;
1032
1033 for (i = 0; i < entries->count; i++) {
1034 OENTRY* temp = entries->entries[i];
1035 if (temp->intypes == NULL && temp->outypes == NULL) {
1036 continue;
1037 }
1038 if (check_in_args(csound, inArgTypes, temp->intypes)) {
1039 // FIXME this is only returning the first match, we need to check
1040 // if there are multiple matches and if so, return NULL to signify
1041 // ambiguity
1042 return temp->outypes;
1043 }
1044 }
1045 return NULL;
1046 }
1047
1048 /* Converts internal array specifier from [[a] to a[][].
1049 Used by get_arg_string_from_tree to create an arg string that is
1050 compatible with the ones found in OENTRY's. splitArgs converts back
1051 to internal representation. */
convert_internal_to_external(CSOUND * csound,char * arg)1052 char* convert_internal_to_external(CSOUND* csound, char* arg) {
1053 int i, dimensions;
1054 char* retVal;
1055
1056 if (arg == NULL || *arg != '[') {
1057 return arg;
1058 }
1059
1060 dimensions = 0;
1061 while (*arg == '[') {
1062 arg++;
1063 dimensions++;
1064 }
1065
1066 retVal = csound->Malloc(csound, sizeof(char) * ((dimensions * 2) + 2));
1067 retVal[0] = *arg;
1068 for (i = 0; i < dimensions * 2; i += 2) {
1069 retVal[i + 1] = '[';
1070 retVal[i + 2] = ']';
1071 }
1072 retVal[dimensions * 2 + 1] = '\0';
1073 //csound->Free(csound, arg);
1074 return retVal;
1075 }
1076
1077 /* ASSUMES VALID ARRAY SPECIFIER! */
convert_external_to_internal(CSOUND * csound,char * arg)1078 char* convert_external_to_internal(CSOUND* csound, char* arg) {
1079 int i, dimensions;
1080 char* retVal;
1081
1082 if (arg == NULL || *(arg + 1) != '[') {
1083 return arg;
1084 }
1085
1086 dimensions = (strlen(arg) - 1) / 2;
1087
1088 retVal = csound->Malloc(csound, sizeof(char) * (dimensions + 3));
1089 retVal[dimensions + 2] = '\0';
1090 retVal[dimensions + 1] = ']';
1091 retVal[dimensions] = *arg;
1092
1093 for (i = 0; i < dimensions; i++) {
1094 retVal[i] = '[';
1095 }
1096 //csound->Free(csound, arg);
1097 return retVal;
1098 }
1099
1100
get_arg_string_from_tree(CSOUND * csound,TREE * tree,TYPE_TABLE * typeTable)1101 char* get_arg_string_from_tree(CSOUND* csound, TREE* tree,
1102 TYPE_TABLE* typeTable) {
1103
1104 int len = tree_arg_list_count(tree);
1105 int i;
1106
1107 if (len == 0) {
1108 return NULL;
1109 }
1110
1111 char** argTypes = csound->Malloc(csound, len * sizeof(char*));
1112 char* argString = NULL;
1113 TREE* current = tree;
1114 int index = 0;
1115 int argsLen = 0;
1116
1117 while (current != NULL) {
1118 char* argType = get_arg_type2(csound, current, typeTable);
1119
1120 //FIXME - fix if argType is NULL and remove the below hack
1121 if (argType == NULL) {
1122 argsLen += 1;
1123 argTypes[index++] = cs_strdup(csound, "@");
1124 } else {
1125 argType = convert_internal_to_external(csound, argType);
1126 argsLen += strlen(argType);
1127 argTypes[index++] = argType;
1128 }
1129
1130 current = current->next;
1131 }
1132
1133 argString = csound->Malloc(csound, (argsLen + 1) * sizeof(char));
1134 char* temp = argString;
1135
1136 for (i = 0; i < len; i++) {
1137 int size = strlen(argTypes[i]);
1138 memcpy(temp, argTypes[i], size);
1139 temp += size;
1140 csound->Free(csound, argTypes[i]);
1141 }
1142
1143
1144 argString[argsLen] = '\0';
1145
1146 csound->Free(csound, argTypes);
1147 return argString;
1148
1149 }
1150
1151
1152
find_opcode_new(CSOUND * csound,char * opname,char * outArgsFound,char * inArgsFound)1153 OENTRY* find_opcode_new(CSOUND* csound, char* opname,
1154 char* outArgsFound, char* inArgsFound) {
1155
1156 // csound->Message(csound, "Searching for opcode: %s | %s | %s\n",
1157 // outArgsFound, opname, inArgsFound);
1158
1159 OENTRIES* opcodes = find_opcode2(csound, opname);
1160
1161 if (opcodes->count == 0) {
1162 return NULL;
1163 }
1164 OENTRY* retVal = resolve_opcode(csound, opcodes, outArgsFound, inArgsFound);
1165
1166 csound->Free(csound, opcodes);
1167
1168 return retVal;
1169 }
1170
find_opcode_exact(CSOUND * csound,char * opname,char * outArgsFound,char * inArgsFound)1171 OENTRY* find_opcode_exact(CSOUND* csound, char* opname,
1172 char* outArgsFound, char* inArgsFound) {
1173
1174 OENTRIES* opcodes = find_opcode2(csound, opname);
1175
1176 if (opcodes->count == 0) {
1177 return NULL;
1178 }
1179
1180
1181 OENTRY* retVal = resolve_opcode_exact(csound, opcodes,
1182 outArgsFound, inArgsFound);
1183
1184 csound->Free(csound, opcodes);
1185
1186 return retVal;
1187 }
1188
1189
1190 //FIXME - this needs to be updated to take into account array names
1191 // that could clash with non-array names, i.e. kVar and kVar[]
check_args_exist(CSOUND * csound,TREE * tree,TYPE_TABLE * typeTable)1192 int check_args_exist(CSOUND* csound, TREE* tree, TYPE_TABLE* typeTable) {
1193 CS_VARIABLE *var = 0;
1194 TREE* current;
1195 char* argType;
1196 char* varName;
1197 CS_VAR_POOL* pool;
1198
1199 if (tree == NULL) {
1200 return 1;
1201 }
1202
1203 current = tree;
1204
1205 while (current != NULL) {
1206
1207 if (is_expression_node(tree) || is_boolean_expression_node(tree)) {
1208 if (!(check_args_exist(csound, tree->left, typeTable) &&
1209 check_args_exist(csound, tree->right, typeTable))) {
1210 return 0;
1211 }
1212 } else {
1213 switch (current->type) {
1214 case LABEL_TOKEN:
1215 case T_IDENT:
1216 varName = current->value->lexeme;
1217
1218 if (is_label(varName, typeTable->labelList)) {
1219 break;
1220 }
1221
1222 argType = get_arg_type2(csound, current, typeTable);
1223 if (UNLIKELY(argType==NULL)) {
1224 synterr(csound,
1225 Str("Variable type for %s could not be determined.\n"), varName);
1226 do_baktrace(csound, tree->locn);
1227 return 0;
1228 }
1229
1230 //FIXME - this feels like a hack
1231 if (*argType == 'c' || *argType == 'r' || *argType == 'p') {
1232 csound->Free(csound, argType);
1233 break;
1234 }
1235 csound->Free(csound, argType);
1236 pool = (*varName == 'g') ?
1237 typeTable->globalPool : typeTable->localPool;
1238 var = csoundFindVariableWithName(csound, pool, varName);
1239 if (UNLIKELY(var == NULL)) {
1240 /* VL: 13-06-13
1241 if it is not found, we still check the global (merged) pool */
1242 if (*varName == 'g')
1243 var = csoundFindVariableWithName(csound, csound->engineState.varPool,
1244 varName);
1245 if (UNLIKELY(var == NULL)) {
1246 synterr(csound,
1247 Str("Variable '%s' used before defined\nline %d"),
1248 varName, tree->line);
1249 do_baktrace(csound, tree->locn);
1250 return 0;
1251 }
1252 }
1253
1254 break;
1255 case T_ARRAY:
1256 varName = current->left->value->lexeme;
1257
1258 pool = (*varName == 'g') ?
1259 typeTable->globalPool : typeTable->localPool;
1260
1261 if (UNLIKELY(csoundFindVariableWithName(csound, pool, varName) == NULL)) {
1262 CS_VARIABLE *var = 0;
1263 /* VL: 13-06-13
1264 if it is not found, we still check the global (merged) pool */
1265 if (var == NULL && *varName == 'g')
1266 var = csoundFindVariableWithName(csound, csound->engineState.varPool,
1267 varName);
1268 if (UNLIKELY(var == NULL)) {
1269 synterr(csound,
1270 Str("Variable '%s' used before defined\nLine %d\n"),
1271 varName, current->left->line);
1272 do_baktrace(csound, current->left->locn);
1273 return 0;
1274 }
1275 }
1276 break;
1277 default:
1278 //synterr(csound, "Unknown arg type: %s\n", current->value->lexeme);
1279 //printf("\t->FOUND OTHER: %s %d\n", current->value->lexeme,
1280 // current->type);
1281 break;
1282 }
1283
1284 }
1285
1286 current = current->next;
1287 }
1288
1289 return 1;
1290 }
1291
add_arg(CSOUND * csound,char * varName,TYPE_TABLE * typeTable)1292 void add_arg(CSOUND* csound, char* varName, TYPE_TABLE* typeTable) {
1293
1294 CS_TYPE* type;
1295 CS_VARIABLE* var;
1296 char *t;
1297 CS_VAR_POOL* pool;
1298 char argLetter[2];
1299 ARRAY_VAR_INIT varInit;
1300 void* typeArg = NULL;
1301
1302 t = varName;
1303 if (*t == '#') t++;
1304 pool = (*t == 'g') ? typeTable->globalPool : typeTable->localPool;
1305
1306 var = csoundFindVariableWithName(csound, pool, varName);
1307 if (var == NULL) {
1308 t = varName;
1309 argLetter[1] = 0;
1310
1311 if (*t == '#') t++;
1312 if (*t == 'g') t++;
1313
1314 if (*t == '[' || *t == 't') { /* Support legacy t-vars */
1315 int dimensions = 1;
1316 CS_TYPE* varType;
1317 char* b = t + 1;
1318
1319 while (*b == '[') {
1320 b++;
1321 dimensions++;
1322 }
1323 argLetter[0] = (*b == 't') ? 'k' : *b; /* Support legacy t-vars */
1324
1325 varType = csoundGetTypeWithVarTypeName(csound->typePool, argLetter);
1326
1327 varInit.dimensions = dimensions;
1328 varInit.type = varType;
1329 typeArg = &varInit;
1330 }
1331
1332 argLetter[0] = (*t == 't') ? '[' : *t; /* Support legacy t-vars */
1333
1334 type = csoundGetTypeForVarName(csound->typePool, argLetter);
1335
1336 var = csoundCreateVariable(csound, csound->typePool,
1337 type, varName, typeArg);
1338 csoundAddVariable(csound, pool, var);
1339 } else {
1340 //TODO - implement reference count increment
1341 }
1342
1343 }
1344
add_array_arg(CSOUND * csound,char * varName,int dimensions,TYPE_TABLE * typeTable)1345 void add_array_arg(CSOUND* csound, char* varName, int dimensions,
1346 TYPE_TABLE* typeTable) {
1347
1348 CS_VARIABLE* var;
1349 char *t;
1350 CS_VAR_POOL* pool;
1351 char argLetter[2];
1352 ARRAY_VAR_INIT varInit;
1353 void* typeArg = NULL;
1354
1355 pool = (*varName == 'g') ? typeTable->globalPool : typeTable->localPool;
1356
1357 var = csoundFindVariableWithName(csound, pool, varName);
1358 if (var == NULL) {
1359 CS_TYPE* varType;
1360
1361 t = varName;
1362 argLetter[1] = 0;
1363
1364 if (*t == '#') t++;
1365 if (*t == 'g') t++;
1366
1367 argLetter[0] = (*t == 't') ? 'k' : *t; /* Support legacy t-vars */
1368
1369 varType = csoundGetTypeWithVarTypeName(csound->typePool, argLetter);
1370
1371 varInit.dimensions = dimensions;
1372 varInit.type = varType;
1373 typeArg = &varInit;
1374
1375 var = csoundCreateVariable(csound, csound->typePool,
1376 (CS_TYPE*) &CS_VAR_TYPE_ARRAY,
1377 varName, typeArg);
1378 csoundAddVariable(csound, pool, var);
1379 } else {
1380 //TODO - implement reference count increment
1381 }
1382 }
1383
1384 /* return 1 on succcess, 0 on failure */
add_args(CSOUND * csound,TREE * tree,TYPE_TABLE * typeTable)1385 int add_args(CSOUND* csound, TREE* tree, TYPE_TABLE* typeTable)
1386 {
1387 TREE* current;
1388 char* varName;
1389
1390 if (tree == NULL) {
1391 return 1;
1392 }
1393
1394 current = tree;
1395
1396 while (current != NULL) {
1397
1398 switch (current->type) {
1399 case T_ARRAY_IDENT:
1400 varName = current->value->lexeme;
1401 add_array_arg(csound, varName,
1402 tree_arg_list_count(current->right), typeTable);
1403
1404 break;
1405
1406 case LABEL_TOKEN:
1407 case T_IDENT:
1408 varName = current->value->lexeme;
1409
1410 if (UNLIKELY(*varName == 't')) { /* Support legacy t-vars */
1411 add_array_arg(csound, varName, 1, typeTable);
1412 } else {
1413 add_arg(csound, varName, typeTable);
1414 }
1415
1416 break;
1417
1418 case T_ARRAY:
1419 varName = current->left->value->lexeme;
1420 // FIXME - this needs to work for array and a-names
1421 add_arg(csound, varName, typeTable);
1422 break;
1423
1424 default:
1425 //synterr(csound, "Unknown arg type: %s\n", current->value->lexeme);
1426 //printf("\t->FOUND OTHER: %s %d\n",
1427 // current->value->lexeme, current->type);
1428 break;
1429 }
1430
1431 current = current->next;
1432 }
1433
1434 return 1;
1435 }
1436
1437
1438 /*
1439 * Verifies:
1440 * -number of args correct
1441 * -types of arg correct
1442 * -expressions are valid and types correct
1443 */
verify_opcode(CSOUND * csound,TREE * root,TYPE_TABLE * typeTable)1444 int verify_opcode(CSOUND* csound, TREE* root, TYPE_TABLE* typeTable) {
1445
1446 TREE* left = root->left;
1447 TREE* right = root->right;
1448 char* leftArgString;
1449 char* rightArgString;
1450 char* opcodeName;
1451
1452 if (root->value == NULL) return 0;
1453
1454 if (!check_args_exist(csound, root->right, typeTable)) {
1455 return 0;
1456 }
1457
1458 add_args(csound, root->left, typeTable);
1459
1460 opcodeName = root->value->lexeme;
1461 //printf("%p %p (%s)\n", root, root->value, opcodeName);
1462 leftArgString = get_arg_string_from_tree(csound, left, typeTable);
1463 rightArgString = get_arg_string_from_tree(csound, right, typeTable);
1464
1465 if (!strcmp(opcodeName, "xin")) {
1466 int nreqd = tree_arg_list_count(root->right);
1467
1468 if (nreqd > OPCODENUMOUTS_LOW) {
1469 opcodeName = (nreqd > OPCODENUMOUTS_HIGH) ? "##xin256" : "##xin64";
1470 }
1471 }
1472
1473 OENTRIES* entries = find_opcode2(csound, opcodeName);
1474 if (UNLIKELY(entries == NULL || entries->count == 0)) {
1475 synterr(csound, Str("Unable to find opcode with name: %s\n"),
1476 root->value->lexeme);
1477 if (entries != NULL) {
1478 csound->Free(csound, entries);
1479 }
1480 return 0;
1481 }
1482
1483 OENTRY* oentry;
1484 if (root->value->optype == NULL)
1485 oentry = resolve_opcode(csound, entries,
1486 leftArgString, rightArgString);
1487 /* if there is type annotation, try to resolve it */
1488 else oentry = resolve_opcode(csound, entries,
1489 root->value->optype, rightArgString);
1490
1491
1492 if (UNLIKELY(oentry == NULL)) {
1493 synterr(csound, Str("Unable to find opcode entry for \'%s\' "
1494 "with matching argument types:\n"),
1495 opcodeName);
1496 csoundMessage(csound, Str("Found: %s %s %s\n"),
1497 leftArgString, root->value->lexeme, rightArgString);
1498 if (root->left && root->left->value && root->right && root->right->value)
1499 csoundMessage(csound, Str(" %s %s %s ...\n"),
1500 root->left->value->lexeme, root->value->lexeme,
1501 root->right->value->lexeme);
1502 csoundMessage(csound, Str("Line: %d\n"),
1503 root->line);
1504 do_baktrace(csound, root->locn);
1505
1506 csound->Free(csound, leftArgString);
1507 csound->Free(csound, rightArgString);
1508 csound->Free(csound, entries);
1509
1510 return 0;
1511 }
1512 else {
1513 //fprintf(stderr, "left=%p\n", left);
1514 //fprintf(stderr, "left->value=%p\n", left->value);
1515 //fprintf(stderr, "left->value->lexeme=%p\n", left->value->lexeme);
1516 //fprintf(stderr, "opname = %s\n", oentry->opname);
1517 if (csound->oparms->sampleAccurate &&
1518 (strcmp(oentry->opname, "=.a")==0) &&
1519 (left!=NULL) && (left->value!=NULL) &&
1520 (left->value->lexeme[0]=='a')) { /* Deal with sample accurate assigns */
1521 int i = 0;
1522 while (strcmp(entries->entries[i]->opname, "=.l")) {
1523 //printf("not %d %s\n",i, entries->entries[i]->opname);
1524 i++;
1525 }
1526 oentry = entries->entries[i];
1527 }
1528 else {
1529 if (csound->oparms->sampleAccurate &&
1530 (strcmp(oentry->opname, "=._")==0) &&
1531 (left->value->lexeme[0]=='a'))
1532 {
1533 int i = 0;
1534 while (strcmp(entries->entries[i]->opname, "=.L")) {
1535 //printf("not %d %s\n",i, entries->entries[i]->opname);
1536 i++;
1537 }
1538 oentry = entries->entries[i];
1539 }
1540 }
1541 root->markup = oentry;
1542 }
1543 csound->Free(csound, leftArgString);
1544 csound->Free(csound, rightArgString);
1545 csound->Free(csound, entries);
1546 return 1;
1547 }
1548
1549 /* Walks tree and finds all label: definitions */
get_label_list(CSOUND * csound,TREE * root)1550 CONS_CELL* get_label_list(CSOUND* csound, TREE* root) {
1551 CONS_CELL* head = NULL, *ret = NULL;
1552 TREE* current = root;
1553 char* labelText;
1554
1555 while (current != NULL) {
1556 switch(current->type) {
1557 case LABEL_TOKEN:
1558 labelText = current->value->lexeme;
1559 head = cs_cons(csound, cs_strdup(csound, labelText), head);
1560 break;
1561
1562 case IF_TOKEN:
1563 case ELSEIF_TOKEN:
1564 if (current->right->type == THEN_TOKEN ||
1565 current->right->type == KTHEN_TOKEN ||
1566 current->right->type == ITHEN_TOKEN) {
1567
1568 ret = get_label_list(csound, current->right->right);
1569 head = cs_cons_append(head, ret);
1570 ret = get_label_list(csound, current->right->next);
1571 head = cs_cons_append(head, ret);
1572 }
1573 break;
1574
1575 case ELSE_TOKEN:
1576 case UNTIL_TOKEN:
1577 case WHILE_TOKEN:
1578 ret = get_label_list(csound, current->right);
1579 head = cs_cons_append(head, ret);
1580 break;
1581
1582 default:
1583 break;
1584 }
1585
1586 current = current->next;
1587 }
1588
1589 return head;
1590 }
1591
is_label(char * ident,CONS_CELL * labelList)1592 static int is_label(char* ident, CONS_CELL* labelList) {
1593 CONS_CELL* current;
1594
1595 if (labelList == NULL) return 0;
1596
1597 current = labelList;
1598
1599 while (current != NULL) {
1600 if (strcmp((char*)current->value, ident) == 0) {
1601 return 1;
1602 }
1603 current = current->next;
1604 }
1605 return 0;
1606 }
1607
verify_if_statement(CSOUND * csound,TREE * root,TYPE_TABLE * typeTable)1608 int verify_if_statement(CSOUND* csound, TREE* root, TYPE_TABLE* typeTable) {
1609
1610 char* outArg;
1611
1612 TREE* right = root->right;
1613
1614 if (right->type == IGOTO_TOKEN ||
1615 right->type == KGOTO_TOKEN ||
1616 right->type == GOTO_TOKEN) {
1617
1618 if (!check_args_exist(csound, root->left, typeTable)) {
1619 return 0;
1620 }
1621
1622 outArg = get_arg_type2(csound, root->left, typeTable);
1623
1624 return (outArg != NULL && (*outArg == 'b' || *outArg == 'B'));
1625
1626 }
1627 else if (right->type == THEN_TOKEN ||
1628 right->type == ITHEN_TOKEN ||
1629 right->type == KTHEN_TOKEN) {
1630
1631 //TREE *tempLeft;
1632 //TREE *tempRight;
1633 TREE* current = root;
1634
1635 while (current != NULL) {
1636 //tempLeft = current->left;
1637 //tempRight = current->right;
1638
1639 if (current->type == ELSE_TOKEN) {
1640 break;
1641 }
1642
1643 if (!check_args_exist(csound, current->left, typeTable)) {
1644 return 0;
1645 }
1646
1647 outArg = get_arg_type2(csound, current->left, typeTable);
1648
1649 if (outArg == NULL || (*outArg != 'b' && *outArg != 'B')) {
1650 csound->Free(csound, outArg);
1651 return 0;
1652 }
1653 csound->Free(csound, outArg);
1654 current = (current->right == NULL) ? NULL : current->right->next;
1655 }
1656
1657 }
1658
1659 return 1;
1660
1661 }
1662
verify_until_statement(CSOUND * csound,TREE * root,TYPE_TABLE * typeTable)1663 int verify_until_statement(CSOUND* csound, TREE* root, TYPE_TABLE* typeTable) {
1664 char* outArg;
1665
1666 if (!check_args_exist(csound, root->left, typeTable)) {
1667 return 0;
1668 };
1669
1670 outArg = get_arg_type2(csound, root->left, typeTable);
1671
1672
1673 if (UNLIKELY(outArg == NULL || (*outArg != 'b' && *outArg != 'B'))) {
1674 synterr(csound,
1675 Str("expression for until/while statement not a boolean "
1676 "expression, line %d\n"),
1677 root->line);
1678 do_baktrace(csound, root->locn);
1679 return 0;
1680 }
1681 return 1;
1682 }
1683
1684 /** Verifies if xin and xout statements are correct for UDO
1685 needs to check:
1686 xin/xout number of args matches UDO input/output arg specifications
1687 xin/xout statements exist if UDO in and out args are not 0 */
verify_xin_xout(CSOUND * csound,TREE * udoTree,TYPE_TABLE * typeTable)1688 int verify_xin_xout(CSOUND *csound, TREE *udoTree, TYPE_TABLE *typeTable) {
1689 if (udoTree->right == NULL) {
1690 return 1;
1691 }
1692 TREE* outArgsTree = udoTree->left->left;
1693 TREE* inArgsTree = udoTree->left->right;
1694 TREE* current = udoTree->right;
1695 TREE* xinArgs = NULL;
1696 TREE* xoutArgs = NULL;
1697 char* inArgs = inArgsTree->value->lexeme;
1698 char* outArgs = outArgsTree->value->lexeme;
1699 unsigned int i;
1700
1701 for (i = 0; i < strlen(inArgs);i++) {
1702 if (inArgs[i] == 'K') {
1703 inArgs[i] = 'k';
1704 }
1705 }
1706
1707 for (i = 0; i < strlen(outArgs);i++) {
1708 if (outArgs[i] == 'K') {
1709 outArgs[i] = 'k';
1710 }
1711 }
1712
1713 while (current != NULL) {
1714 if (current->value != NULL) {
1715 if (strcmp("xin", current->value->lexeme) == 0) {
1716 if (UNLIKELY(xinArgs != NULL)) {
1717 synterr(csound,
1718 Str("Multiple xin statements found. "
1719 "Only one is allowed."));
1720 return 0;
1721 }
1722 xinArgs = current->left;
1723 }
1724 if (strcmp("xout", current->value->lexeme) == 0) {
1725 if (UNLIKELY(xoutArgs != NULL)) {
1726 synterr(csound,
1727 Str("Multiple xout statements found. "
1728 "Only one is allowed."));
1729 return 0;
1730 }
1731 xoutArgs = current->right;
1732 }
1733 }
1734 current = current->next;
1735 }
1736
1737 char* inArgsFound = get_arg_string_from_tree(csound, xinArgs, typeTable);
1738 char* outArgsFound = get_arg_string_from_tree(csound, xoutArgs, typeTable);
1739
1740
1741 if (!check_in_args(csound, inArgsFound, inArgs)) {
1742 if (UNLIKELY(!(strcmp("0", inArgs) == 0 && xinArgs == NULL))) {
1743 synterr(csound,
1744 Str("invalid xin statement for UDO: defined '%s', found '%s'\n"),
1745 inArgs, inArgsFound);
1746 return 0;
1747 }
1748 }
1749
1750 if (!check_in_args(csound, outArgsFound, outArgs)) {
1751 if (UNLIKELY(!(strcmp("0", outArgs) == 0 && xoutArgs == NULL))) {
1752 synterr(csound,
1753 Str("invalid xout statement for UDO: defined '%s', found '%s'\n"),
1754 outArgs, outArgsFound);
1755 return 0;
1756 }
1757 }
1758
1759 return 1;
1760 }
1761
verify_tree(CSOUND * csound,TREE * root,TYPE_TABLE * typeTable)1762 TREE* verify_tree(CSOUND * csound, TREE *root, TYPE_TABLE* typeTable)
1763 {
1764 TREE *anchor = NULL;
1765 TREE *current = root;
1766 TREE *previous = NULL;
1767 TREE* newRight;
1768
1769
1770 CONS_CELL* parentLabelList = typeTable->labelList;
1771 typeTable->labelList = get_label_list(csound, root);
1772
1773 //if (root->value)
1774 //printf("###verify %p %p (%s)\n", root, root->value, root->value->lexeme);
1775
1776 if (UNLIKELY(PARSER_DEBUG)) csound->Message(csound, "Verifying AST\n");
1777
1778 while (current != NULL) {
1779 switch(current->type) {
1780 case INSTR_TOKEN:
1781 csound->inZero = 0;
1782 if (UNLIKELY(PARSER_DEBUG)) csound->Message(csound, "Instrument found\n");
1783 typeTable->localPool = csoundCreateVarPool(csound);
1784 current->markup = typeTable->localPool;
1785
1786 if (current->right) {
1787
1788 newRight = verify_tree(csound, current->right, typeTable);
1789
1790 if (newRight == NULL) {
1791 cs_cons_free(csound, typeTable->labelList);
1792 typeTable->labelList = parentLabelList;
1793 return NULL;
1794 }
1795
1796 current->right = newRight;
1797 newRight = NULL;
1798 }
1799
1800 typeTable->localPool = typeTable->instr0LocalPool;
1801
1802 break;
1803 case UDO_TOKEN:
1804 csound->inZero = 0;
1805 if (UNLIKELY(PARSER_DEBUG)) csound->Message(csound, "UDO found\n");
1806
1807 typeTable->localPool = csoundCreateVarPool(csound);
1808 current->markup = typeTable->localPool;
1809
1810 if (current->right != NULL) {
1811
1812 newRight = verify_tree(csound, current->right, typeTable);
1813
1814 if (newRight == NULL) {
1815 cs_cons_free(csound, typeTable->labelList);
1816 typeTable->labelList = parentLabelList;
1817 return NULL;
1818 }
1819
1820 current->right = newRight;
1821
1822 if (!verify_xin_xout(csound, current, typeTable)) {
1823 return 0;
1824 }
1825
1826 newRight = NULL;
1827 }
1828
1829 typeTable->localPool = typeTable->instr0LocalPool;
1830
1831 break;
1832
1833 case IF_TOKEN:
1834 if (!verify_if_statement(csound, current, typeTable)) {
1835 return 0;
1836 }
1837
1838 current = expand_if_statement(csound, current, typeTable);
1839
1840 if (previous != NULL) {
1841 previous->next = current;
1842 }
1843
1844 continue;
1845
1846 case UNTIL_TOKEN:
1847 case WHILE_TOKEN:
1848 if (!verify_until_statement(csound, current, typeTable)) {
1849 return 0;
1850 }
1851
1852 current = expand_until_statement(csound, current,
1853 typeTable, current->type==WHILE_TOKEN);
1854
1855 if (previous != NULL) {
1856 previous->next = current;
1857 }
1858
1859 continue;
1860
1861 case LABEL_TOKEN:
1862 break;
1863
1864 case '+':
1865 case '-':
1866 case '*':
1867 case '/':
1868 //printf("Folding case?\n");
1869 current->left = verify_tree(csound, current->left, typeTable);
1870 current->right = verify_tree(csound, current->right, typeTable);
1871 if ((current->left->type == INTEGER_TOKEN ||
1872 current->left->type == NUMBER_TOKEN) &&
1873 (current->right->type == INTEGER_TOKEN ||
1874 current->right->type == NUMBER_TOKEN)) {
1875 MYFLT lval, rval;
1876 lval = (current->left->type == INTEGER_TOKEN ?
1877 (double)current->left->value->value :
1878 current->left->value->fvalue);
1879 rval = (current->right->type == INTEGER_TOKEN ?
1880 (double)current->right->value->value :
1881 current->right->value->fvalue);
1882 switch (current->type) {
1883 case '+':
1884 lval = lval + rval;
1885 break;
1886 case '-':
1887 lval = lval - rval;
1888 break;
1889 case '*':
1890 lval = lval * rval;
1891 break;
1892 case '/':
1893 lval = lval / rval;
1894 break;
1895 }
1896 current->type = NUMBER_TOKEN;
1897 current->value->fvalue = lval;
1898 csound->Free(csound, current->left); csound->Free(csound, current->right);
1899 }
1900 break;
1901 case ENDIN_TOKEN:
1902 case UDOEND_TOKEN:
1903 csound->inZero = 1;
1904 /* fall through */
1905 default:
1906 if (!verify_opcode(csound, current, typeTable)) {
1907 return 0;
1908 }
1909 //print_tree(csound, "verify_tree", current);
1910 if (is_statement_expansion_required(current)) {
1911 current = expand_statement(csound, current, typeTable);
1912
1913 if (previous != NULL) {
1914 previous->next = current;
1915 }
1916 continue;
1917 } else {
1918 handle_optional_args(csound, current);
1919 }
1920 }
1921
1922 if (anchor == NULL) {
1923 anchor = current;
1924 }
1925
1926 previous = current;
1927 current = current->next;
1928
1929 }
1930
1931 if (PARSER_DEBUG) csound->Message(csound, "[End Verifying AST]\n");
1932
1933 cs_cons_free(csound, typeTable->labelList);
1934 typeTable->labelList = parentLabelList;
1935
1936 return anchor;
1937 }
1938
1939
1940 /* BISON PARSER FUNCTION */
csound_orcwrap(void * dummy)1941 int csound_orcwrap(void* dummy)
1942 {
1943 IGN(dummy);
1944 #ifdef DEBUG
1945 printf("\n === END OF INPUT ===\n");
1946 #endif
1947 return (1);
1948 }
1949
1950 /* UTILITY FUNCTIONS */
1951
1952 extern int csound_orcget_lineno(void*);
1953 extern char *csound_orcget_current_pointer(void *);
1954 /* BISON PARSER FUNCTION */
csound_orcerror(PARSE_PARM * pp,void * yyscanner,CSOUND * csound,TREE ** astTree,const char * str)1955 void csound_orcerror(PARSE_PARM *pp, void *yyscanner,
1956 CSOUND *csound, TREE **astTree, const char *str)
1957 {
1958 IGN(pp);
1959 IGN(astTree);
1960 char ch;
1961 char *p = csound_orcget_current_pointer(yyscanner)-1;
1962 int line = csound_orcget_lineno(yyscanner);
1963 uint64_t files = csound_orcget_locn(yyscanner);
1964 if (UNLIKELY(*p=='\0' || *p=='\n')) line--;
1965 //printf("LINE: %d\n", line);
1966
1967 csound->Message(csound, Str("\nerror: %s (token \"%s\")"),
1968 str, csound_orcget_text(yyscanner));
1969 do_baktrace(csound, files);
1970 csound->Message(csound, Str(" line %d:\n>>>"), line);
1971 while ((ch=*--p) != '\n' && ch != '\0');
1972 do {
1973 ch = *++p;
1974 if (UNLIKELY(ch == '\n')) break;
1975 // Now get rid of any continuations
1976 if (ch=='#' && strncmp(p,"sline ",6)) {
1977 p+=7; while (isdigit(*p)) p++;
1978 }
1979 else csound->Message(csound, "%c", ch);
1980 } while (ch != '\n' && ch != '\0');
1981 csound->Message(csound, " <<<\n");
1982 }
1983
do_baktrace(CSOUND * csound,uint64_t files)1984 void do_baktrace(CSOUND *csound, uint64_t files)
1985 {
1986 while (files) {
1987 unsigned int ff = files&0xff;
1988 files = files >>8;
1989 csound->Message(csound, Str(" from file %s (%d)\n"),
1990 csound->filedir[ff], ff);
1991 }
1992 }
1993
1994 /**
1995 * Appends TREE * node to TREE * node using ->next field in struct; walks
1996 * down list to append at end; checks for NULL's and returns
1997 * appropriate nodes
1998 */
appendToTree(CSOUND * csound,TREE * first,TREE * newlast)1999 TREE* appendToTree(CSOUND * csound, TREE *first, TREE *newlast)
2000 {
2001 IGN(csound);
2002 TREE *current;
2003 if (first == NULL) {
2004 return newlast;
2005 }
2006
2007 if (newlast == NULL) {
2008 return first;
2009 }
2010
2011 /* HACK - Checks to see if first node is uninitialized (sort of)
2012 * This occurs for rules like in topstatement where the left hand
2013 * topstatement the first time around is not initialized to anything
2014 * useful; the number 400 is arbitrary, chosen as it seemed to be a
2015 * value higher than all the type numbers that were being printed out
2016 */
2017 if (first->type > 400 || first-> type < 0) {
2018 return newlast;
2019 }
2020
2021 current = first;
2022
2023 while (current->next != NULL) {
2024 current = current->next;
2025 }
2026
2027 current->next = newlast;
2028
2029 return first;
2030 }
2031
2032
2033 /* USED BY PARSER TO ASSEMBLE TREE NODES */
make_node(CSOUND * csound,int line,int locn,int type,TREE * left,TREE * right)2034 TREE* make_node(CSOUND *csound, int line, int locn, int type,
2035 TREE* left, TREE* right)
2036 {
2037 TREE *ans;
2038 ans = (TREE*)csound->Malloc(csound, sizeof(TREE));
2039 if (UNLIKELY(ans==NULL)) {
2040 /* fprintf(stderr, "Out of memory\n"); */
2041 exit(1);
2042 }
2043 ans->type = type;
2044 ans->left = left;
2045 ans->right = right;
2046 ans->value = NULL; /* New code -- JPff */
2047 ans->next = NULL;
2048 ans->len = 2;
2049 ans->rate = -1;
2050 ans->line = line;
2051 ans->locn = locn;
2052 ans->markup = NULL;
2053 //printf("make node %p %p %p\n", ans, ans->left, ans->right);
2054 //csound->DebugMsg(csound, "%s(%d) line = %d\n", __FILE__, __LINE__, line);
2055 return ans;
2056 }
2057
make_leaf(CSOUND * csound,int line,int locn,int type,ORCTOKEN * v)2058 TREE* make_leaf(CSOUND *csound, int line, int locn, int type, ORCTOKEN *v)
2059 {
2060 TREE *ans;
2061 ans = (TREE*)csound->Calloc(csound, sizeof(TREE));
2062 if (UNLIKELY(ans==NULL)) {
2063 /* fprintf(stderr, "Out of memory\n"); */
2064 exit(1);
2065 }
2066 ans->type = type;
2067 ans->left = NULL;
2068 ans->right = NULL;
2069 ans->next = NULL;
2070 ans->len = 0;
2071 ans->rate = -1;
2072 ans->value = v;
2073 ans->line = line;
2074 ans->locn = locn;
2075 ans->markup = NULL;
2076 //if (ans->value)
2077 // printf("make leaf %p %p (%s)\n", ans, ans->value, ans->value->lexeme);
2078 csound->DebugMsg(csound, "csound_orc_semantics(%d) line = %d\n",
2079 __LINE__, line);
2080 return ans;
2081 }
2082
delete_tree(CSOUND * csound,TREE * l)2083 void delete_tree(CSOUND *csound, TREE *l)
2084 {
2085 while (1) {
2086 TREE *old = l;
2087
2088 if (UNLIKELY(l==NULL)) {
2089 return;
2090 } //else printf("l = %p\n", l);
2091
2092 if (l->value) {
2093 if (l->value->lexeme) {
2094 //printf("Free %p %p (%s)\n", l, l->value, l->value->lexeme);
2095 csound->Free(csound, l->value->lexeme);
2096 //l->value->lexeme = NULL;
2097 }
2098 //printf("Free val %p\n", l->value);
2099 csound->Free(csound, l->value);
2100 //l->value = NULL;
2101 }
2102 // printf("left %p right %p\n", l->left, l->right);
2103 delete_tree(csound, l->left);
2104 //l->left = NULL;
2105 delete_tree(csound, l->right);
2106 //l->right = NULL;
2107 l = l->next;
2108 //printf("Free old %p next: %p\n", old, l);
2109 csound->Free(csound, old);
2110 }
2111 }
2112
csoundDeleteTree(CSOUND * csound,TREE * tree)2113 PUBLIC void csoundDeleteTree(CSOUND *csound, TREE *tree)
2114 {
2115 //printf("Tree %p\n", tree);
2116 delete_tree(csound, tree);
2117 }
2118
2119
2120 /* DEBUGGING FUNCTIONS */
print_tree_i(CSOUND * csound,TREE * l,int n)2121 void print_tree_i(CSOUND *csound, TREE *l, int n)
2122 {
2123 int i;
2124 if (UNLIKELY(l==NULL)) {
2125 return;
2126 }
2127 for (i=0; i<n; i++) {
2128 csound->Message(csound, " ");
2129 }
2130
2131 csound->Message(csound, "TYPE: %d ", l->type);
2132
2133 switch (l->type) {
2134 case ',':
2135 case '?':
2136 case ':':
2137 case '!':
2138 case '+':
2139 case '-':
2140 case '*':
2141 case '/':
2142 case '%':
2143 case '^':
2144 case '(':
2145 case ')':
2146 case '=':
2147 csound->Message(csound,"%c:(%d:%s)\n", l->type,
2148 l->line, csound->filedir[(l->locn)&0xff]); break;
2149 case NEWLINE:
2150 csound->Message(csound,"NEWLINE:(%d:%s)\n",
2151 l->line, csound->filedir[(l->locn)&0xff]); break;
2152 case S_NEQ:
2153 csound->Message(csound,"S_NEQ:(%d:%s)\n",
2154 l->line, csound->filedir[(l->locn)&0xff]); break;
2155 case S_AND:
2156 csound->Message(csound,"S_AND:(%d:%s)\n",
2157 l->line, csound->filedir[(l->locn)&0xff]); break;
2158 case S_OR:
2159 csound->Message(csound,"S_OR:(%d:%s)\n",
2160 l->line, csound->filedir[(l->locn)&0xff]); break;
2161 case S_LT:
2162 csound->Message(csound,"S_LT:(%d:%s)\n",
2163 l->line, csound->filedir[(l->locn)&0xff]); break;
2164 case S_LE:
2165 csound->Message(csound,"S_LE:(%d:%s)\n",
2166 l->line, csound->filedir[(l->locn)&0xff]); break;
2167 case S_EQ:
2168 csound->Message(csound,"S_EQ:(%d:%s)\n",
2169 l->line, csound->filedir[(l->locn)&0xff]); break;
2170 case S_UNOT:
2171 csound->Message(csound,"S_UNOT:(%d:%s)\n",
2172 l->line, csound->filedir[(l->locn)&0xff]); break;
2173 case S_GT:
2174 csound->Message(csound,"S_GT:(%d:%s)\n",
2175 l->line, csound->filedir[(l->locn)&0xff]); break;
2176 case S_GE:
2177 csound->Message(csound,"S_GE:(%d:%s)\n",
2178 l->line, csound->filedir[(l->locn)&0xff]); break;
2179 case LABEL_TOKEN:
2180 csound->Message(csound,"LABEL_TOKEN: %s\n", l->value->lexeme); break;
2181 case IF_TOKEN:
2182 csound->Message(csound,"IF_TOKEN:(%d:%s)\n",
2183 l->line, csound->filedir[(l->locn)&0xff]); break;
2184 case THEN_TOKEN:
2185 csound->Message(csound,"THEN_TOKEN:(%d:%s)\n",
2186 l->line, csound->filedir[(l->locn)&0xff]); break;
2187 case ITHEN_TOKEN:
2188 csound->Message(csound,"ITHEN_TOKEN:(%d:%s)\n",
2189 l->line, csound->filedir[(l->locn)&0xff]); break;
2190 case KTHEN_TOKEN:
2191 csound->Message(csound,"KTHEN_TOKEN:(%d:%s)\n",
2192 l->line, csound->filedir[(l->locn)&0xff]); break;
2193 case ELSEIF_TOKEN:
2194 csound->Message(csound,"ELSEIF_TOKEN:(%d:%s)\n",
2195 l->line, csound->filedir[(l->locn)&0xff]); break;
2196 case ELSE_TOKEN:
2197 csound->Message(csound,"ELSE_TOKEN:(%d:%s)\n",
2198 l->line, csound->filedir[(l->locn)&0xff]); break;
2199 case UNTIL_TOKEN:
2200 csound->Message(csound,"UNTIL_TOKEN:(%d:%s)\n",
2201 l->line, csound->filedir[(l->locn)&0xff]); break;
2202 case WHILE_TOKEN:
2203 csound->Message(csound,"WHILE_TOKEN:(%d:%s)\n",
2204 l->line, csound->filedir[(l->locn)&0xff]); break;
2205 case DO_TOKEN:
2206 csound->Message(csound,"DO_TOKEN:(%d:%s)\n",
2207 l->line, csound->filedir[(l->locn)&0xff]); break;
2208 case OD_TOKEN:
2209 csound->Message(csound,"OD_TOKEN:(%d:%s)\n",
2210 l->line, csound->filedir[(l->locn)&0xff]); break;
2211 case GOTO_TOKEN:
2212 csound->Message(csound,"GOTO_TOKEN:(%d:%s)\n",
2213 l->line, csound->filedir[(l->locn)&0xff]); break;
2214 case IGOTO_TOKEN:
2215 csound->Message(csound,"IGOTO_TOKEN:(%d:%s)\n",
2216 l->line, csound->filedir[(l->locn)&0xff]); break;
2217 case KGOTO_TOKEN:
2218 csound->Message(csound,"KGOTO_TOKEN:(%d:%s)\n",
2219 l->line, csound->filedir[(l->locn)&0xff]); break;
2220 case SRATE_TOKEN:
2221 csound->Message(csound,"SRATE_TOKEN:(%d:%s)\n",
2222 l->line, csound->filedir[(l->locn)&0xff]); break;
2223 case KRATE_TOKEN:
2224 csound->Message(csound,"KRATE_TOKEN:(%d:%s)\n",
2225 l->line, csound->filedir[(l->locn)&0xff]); break;
2226 case ZERODBFS_TOKEN:
2227 csound->Message(csound,"ZERODFFS_TOKEN:(%d:%s)\n",
2228 l->line, csound->filedir[(l->locn)&0xff]); break;
2229 case A4_TOKEN:
2230 csound->Message(csound,"A4_TOKEN:(%d:%s)\n",
2231 l->line, csound->filedir[(l->locn)&0xff]); break;
2232 case KSMPS_TOKEN:
2233 csound->Message(csound,"KSMPS_TOKEN:(%d:%s)\n",
2234 l->line, csound->filedir[(l->locn)&0xff]); break;
2235 case NCHNLS_TOKEN:
2236 csound->Message(csound,"NCHNLS_TOKEN:(%d:%s)\n",
2237 l->line, csound->filedir[(l->locn)&0xff]); break;
2238 case NCHNLSI_TOKEN:
2239 csound->Message(csound,"NCHNLSI_TOKEN:(%d:%s)\n",
2240 l->line, csound->filedir[(l->locn)&0xff]); break;
2241 case INSTR_TOKEN:
2242 csound->Message(csound,"INSTR_TOKEN:(%d:%s)\n",
2243 l->line, csound->filedir[(l->locn)&0xff]); break;
2244 case STRING_TOKEN:
2245 csound->Message(csound,"STRING_TOKEN: %s\n", l->value->lexeme); break;
2246 case T_IDENT:
2247 csound->Message(csound,"T_IDENT: %s\n", l->value->lexeme); break;
2248 case INTEGER_TOKEN:
2249 csound->Message(csound,"INTEGER_TOKEN: %d\n", l->value->value); break;
2250 case NUMBER_TOKEN:
2251 csound->Message(csound,"NUMBER_TOKEN: %f\n", l->value->fvalue); break;
2252 case S_ANDTHEN:
2253 csound->Message(csound,"S_ANDTHEN:(%d:%s)\n",
2254 l->line, csound->filedir[(l->locn)&0xff]); break;
2255 case S_APPLY:
2256 csound->Message(csound,"S_APPLY:(%d:%s)\n",
2257 l->line, csound->filedir[(l->locn)&0xff]); break;
2258 case T_OPCODE0:
2259 csound->Message(csound,"T_OPCODE0: %s\n",
2260 l->value->lexeme); break;
2261 case T_OPCODE:
2262 csound->Message(csound,"T_OPCODE: %s\n",
2263 l->value->lexeme); break;
2264 case T_FUNCTION:
2265 csound->Message(csound,"T_FUNCTION: %s\n",
2266 l->value->lexeme); break;
2267 case S_UMINUS:
2268 csound->Message(csound,"S_UMINUS:(%d:%s)\n",
2269 l->line, csound->filedir[(l->locn)&0xff]); break;
2270 case T_INSTLIST:
2271 csound->Message(csound,"T_INSTLIST:(%d:%s)\n",
2272 l->line, csound->filedir[(l->locn)&0xff]); break;
2273 case '[':
2274 csound->Message(csound,"[:(%d:%s)\n",
2275 l->line, csound->filedir[(l->locn)&0xff]); break;
2276 default:
2277 csound->Message(csound,"unknown:%d(%d:%s)\n",
2278 l->type, l->line, csound->filedir[(l->locn)&0xff]);
2279 }
2280
2281 print_tree_i(csound, l->left,n+1);
2282 print_tree_i(csound, l->right,n+1);
2283
2284 if (l->next != NULL) {
2285 print_tree_i(csound, l->next, n);
2286 }
2287 }
2288
2289 enum {TREE_NONE, TREE_LEFT, TREE_RIGHT, TREE_NEXT};
print_tree_xml(CSOUND * csound,TREE * l,int n,int which)2290 static void print_tree_xml(CSOUND *csound, TREE *l, int n, int which)
2291 {
2292 int i;
2293 char *child[4] = {"", "left", "right", "next"};
2294 if (l==NULL) {
2295 return;
2296 }
2297 for (i=0; i<n; i++) {
2298 csound->Message(csound, " ");
2299 }
2300
2301 csound->Message(csound,
2302 "<tree%s (%p : %p) type=\"%d\" ",
2303 child[which],l, l->value, l->type);
2304
2305 switch (l->type) {
2306 case ',':
2307 case '?':
2308 case ':':
2309 case '!':
2310 case '+':
2311 case '-':
2312 case '*':
2313 case '/':
2314 case '%':
2315 case '^':
2316 case '(':
2317 case ')':
2318 case '=':
2319 case '|':
2320 case '&':
2321 case '#':
2322 case '~':
2323 csound->Message(csound,"name=\"%c\"", l->type); break;
2324 case NEWLINE:
2325 csound->Message(csound,"name=\"NEWLINE\""); break;
2326 case S_NEQ:
2327 csound->Message(csound,"name=\"S_NEQ\""); break;
2328 case S_AND:
2329 csound->Message(csound,"name=\"S_AND\""); break;
2330 case S_OR:
2331 csound->Message(csound,"name=\"S_OR\""); break;
2332 case S_LT:
2333 csound->Message(csound,"name=\"S_LT\""); break;
2334 case S_LE:
2335 csound->Message(csound,"name=\"S_LE\""); break;
2336 case S_EQ:
2337 csound->Message(csound,"name=\"S_EQ\""); break;
2338 case S_UNOT:
2339 csound->Message(csound,"name=\"S_UNOT\""); break;
2340 case S_GT:
2341 csound->Message(csound,"name=\"S_GT\""); break;
2342 case S_GE:
2343 csound->Message(csound,"name=\"S_GE\""); break;
2344 case S_BITSHIFT_RIGHT:
2345 csound->Message(csound,"name=\"S_BITSHIFT_RIGHT\""); break;
2346 case S_BITSHIFT_LEFT:
2347 csound->Message(csound,"name=\"S_BITSHIFT_LEFT\""); break;
2348 case LABEL_TOKEN:
2349 csound->Message(csound,"name=\"LABEL_TOKEN\" label=\"%s\"",
2350 l->value->lexeme); break;
2351 case IF_TOKEN:
2352 csound->Message(csound,"name=\"IF_TOKEN\""); break;
2353 case THEN_TOKEN:
2354 csound->Message(csound,"name=\"THEN_TOKEN\""); break;
2355 case ITHEN_TOKEN:
2356 csound->Message(csound,"name=\"ITHEN_TOKEN\""); break;
2357 case KTHEN_TOKEN:
2358 csound->Message(csound,"name=\"KTHEN_TOKEN\""); break;
2359 case ELSEIF_TOKEN:
2360 csound->Message(csound,"name=\"ELSEIF_TOKEN\""); break;
2361 case ELSE_TOKEN:
2362 csound->Message(csound,"name=\"ELSE_TOKEN\""); break;
2363 case UNTIL_TOKEN:
2364 csound->Message(csound,"name=\"UNTIL_TOKEN\""); break;
2365 case WHILE_TOKEN:
2366 csound->Message(csound,"name=\"WHILE_TOKEN\""); break;
2367 case DO_TOKEN:
2368 csound->Message(csound,"name=\"DO_TOKEN\""); break;
2369 case OD_TOKEN:
2370 csound->Message(csound,"name=\"OD_TOKEN\""); break;
2371 case GOTO_TOKEN:
2372 csound->Message(csound,"name=\"GOTO_TOKEN\""); break;
2373 case IGOTO_TOKEN:
2374 csound->Message(csound,"name=\"IGOTO_TOKEN\""); break;
2375 case KGOTO_TOKEN:
2376 csound->Message(csound,"name=\"KGOTO_TOKEN\""); break;
2377 case SRATE_TOKEN:
2378 csound->Message(csound,"name=\"SRATE_TOKEN\""); break;
2379 case KRATE_TOKEN:
2380 csound->Message(csound,"name=\"KRATE_TOKEN\""); break;
2381 case ZERODBFS_TOKEN:
2382 csound->Message(csound,"name=\"ZERODBFS_TOKEN\""); break;
2383 case A4_TOKEN:
2384 csound->Message(csound,"name=\"A4_TOKEN\""); break;
2385 case KSMPS_TOKEN:
2386 csound->Message(csound,"name=\"KSMPS_TOKEN\""); break;
2387 case NCHNLS_TOKEN:
2388 csound->Message(csound,"name=\"NCHNLS_TOKEN\""); break;
2389 case NCHNLSI_TOKEN:
2390 csound->Message(csound,"name=\"NCHNLSI_TOKEN\""); break;
2391 case INSTR_TOKEN:
2392 csound->Message(csound,"name=\"INSTR_TOKEN\""); break;
2393 case STRING_TOKEN:
2394 csound->Message(csound,"name=\"T_STRCONST\" str=\"%s\"",
2395 l->value->lexeme); break;
2396 case T_IDENT:
2397 csound->Message(csound,"name=\"T_IDENT\" varname=\"%s\"",
2398 l->value->lexeme); break;
2399
2400 case T_ARRAY:
2401 csound->Message(csound,"name=\"T_ARRAY\""); break;
2402
2403 case T_ARRAY_IDENT:
2404 csound->Message(csound,"name=\"T_ARRAY_IDENT\" varname=\"%s\"",
2405 l->value->lexeme); break;
2406
2407 case INTEGER_TOKEN:
2408 csound->Message(csound,"name=\"INTEGER_TOKEN\" value=\"%d\"",
2409 l->value->value); break;
2410 case NUMBER_TOKEN:
2411 csound->Message(csound,"name=\"NUMBER_TOKEN\" value=\"%f\"",
2412 l->value->fvalue); break;
2413 case S_ANDTHEN:
2414 csound->Message(csound,"name=\"S_ANDTHEN\""); break;
2415 case S_APPLY:
2416 csound->Message(csound,"name=\"S_APPLY\""); break;
2417 case T_OPCODE0:
2418 csound->Message(csound,"name=\"T_OPCODE0\" opname0=\"%s\"",
2419 l->value->lexeme); break;
2420 case T_OPCODE:
2421 csound->Message(csound,"name=\"T_OPCODE\" opname=\"%s\"",
2422 l->value->lexeme); break;
2423 case T_FUNCTION:
2424 csound->Message(csound,"name=\"T_FUNCTION\" fname=\"%s\"",
2425 l->value->lexeme); break;
2426 case S_UMINUS:
2427 csound->Message(csound,"name=\"S_UMINUS\""); break;
2428 case T_INSTLIST:
2429 csound->Message(csound,"name=\"T_INSTLIST\""); break;
2430 case UDO_TOKEN:
2431 csound->Message(csound,"name=\"UDO_TOKEN\""); break;
2432 case UDO_ANS_TOKEN:
2433 csound->Message(csound,"name=\"UDO_ANS_TOKEN\" signature=\"%s\"",
2434 l->value->lexeme); break;
2435 case UDO_ARGS_TOKEN:
2436 csound->Message(csound,"name=\"UDO_ARGS_TOKEN\" signature=\"%s\"",
2437 l->value->lexeme); break;
2438 case S_ELIPSIS:
2439 csound->Message(csound,"name=\"S_ELIPSIS\""); break;
2440 case S_ADDIN:
2441 csound->Message(csound,"name=\"##addin\""); break;
2442 // case T_MAPI:
2443 // csound->Message(csound,"name=\"T_MAPI\""); break;
2444 // case T_MAPK:
2445 // csound->Message(csound,"name=\"T_MAPK\""); break;
2446 // case T_TADD:
2447 // csound->Message(csound,"name=\"T_TADD\""); break;
2448 // case T_SUB:
2449 // csound->Message(csound,"name=\"T_SUB\""); break;
2450 // case S_TUMINUS:
2451 // csound->Message(csound,"name=\"S_TUMINUS\""); break;
2452 // case T_TMUL:
2453 // csound->Message(csound,"name=\"T_TMUL\""); break;
2454 // case T_TDIV:
2455 // csound->Message(csound,"name=\"T_TDIV\""); break;
2456 // case T_TREM:
2457 // csound->Message(csound,"name=\"T_TREM\""); break;
2458 default:
2459 csound->Message(csound,"name=\"unknown\"(%d)", l->type);
2460 }
2461
2462 csound->Message(csound, " loc=\"%d:%s\">\n",
2463 l->line, csound->filedir[(l->locn)&0xff]);
2464
2465 print_tree_xml(csound, l->left,n+1, TREE_LEFT);
2466 print_tree_xml(csound, l->right,n+1, TREE_RIGHT);
2467
2468 for (i=0; i<n; i++) {
2469 csound->Message(csound, " ");
2470 }
2471
2472 csound->Message(csound, "</tree%s>\n", child[which]);
2473
2474 if (l->next != NULL) {
2475 print_tree_xml(csound, l->next, n, TREE_NEXT);
2476 }
2477 }
2478
print_tree(CSOUND * csound,char * msg,TREE * l)2479 void print_tree(CSOUND * csound, char* msg, TREE *l)
2480 {
2481 if (msg)
2482 csound->Message(csound, "%s", msg);
2483 else
2484 csound->Message(csound, "Printing Tree\n");
2485 csound->Message(csound, "<ast>\n");
2486 print_tree_xml(csound, l, 0, TREE_NONE);
2487 csound->Message(csound, "</ast>\n");
2488 }
2489
handle_optional_args(CSOUND * csound,TREE * l)2490 void handle_optional_args(CSOUND *csound, TREE *l)
2491 {
2492 if (l == NULL || l->type == LABEL_TOKEN) return;
2493 {
2494
2495 OENTRY *ep = (OENTRY*)l->markup;
2496 int nreqd = 0;
2497 int incnt = tree_arg_list_count(l->right);
2498 TREE * temp;
2499 char** inArgParts = NULL;
2500
2501 if (UNLIKELY(ep==NULL)) { /* **** FIXME **** */
2502 printf("THIS SHOULD NOT HAPPEN -- ep NULL csound_orc-semantics(%d)\n",
2503 __LINE__);
2504 }
2505 if (ep->intypes != NULL) {
2506 nreqd = argsRequired(ep->intypes);
2507 inArgParts = splitArgs(csound, ep->intypes);
2508 }
2509
2510 if (UNLIKELY(PARSER_DEBUG)) {
2511 csound->Message(csound, "Handling Optional Args for opcode %s, %d, %d",
2512 ep->opname, incnt, nreqd);
2513 csound->Message(csound, "ep->intypes = >%s<\n", ep->intypes);
2514 }
2515 if (incnt < nreqd) { /* or set defaults: */
2516 do {
2517 switch (*inArgParts[incnt]) {
2518 case 'O': /* Will this work? Doubtful code.... */
2519 case 'o':
2520 temp = make_leaf(csound, l->line, l->locn, INTEGER_TOKEN,
2521 make_int(csound, "0"));
2522 temp->markup = &SYNTHESIZED_ARG;
2523 if (l->right==NULL) l->right = temp;
2524 else appendToTree(csound, l->right, temp);
2525 break;
2526 case 'P':
2527 case 'p':
2528 temp = make_leaf(csound, l->line, l->locn, INTEGER_TOKEN,
2529 make_int(csound, "1"));
2530 temp->markup = &SYNTHESIZED_ARG;
2531 if (l->right==NULL) l->right = temp;
2532 else appendToTree(csound, l->right, temp);
2533 break;
2534 case 'q':
2535 temp = make_leaf(csound, l->line, l->locn, INTEGER_TOKEN,
2536 make_int(csound, "10"));
2537 temp->markup = &SYNTHESIZED_ARG;
2538 if (l->right==NULL) l->right = temp;
2539 else appendToTree(csound, l->right, temp);
2540 break;
2541
2542 case 'V':
2543 case 'v':
2544 temp = make_leaf(csound, l->line, l->locn, NUMBER_TOKEN,
2545 make_num(csound, ".5"));
2546 temp->markup = &SYNTHESIZED_ARG;
2547 if (l->right==NULL) l->right = temp;
2548 else appendToTree(csound, l->right, temp);
2549 break;
2550 case 'h':
2551 temp = make_leaf(csound, l->line, l->locn, INTEGER_TOKEN,
2552 make_int(csound, "127"));
2553 temp->markup = &SYNTHESIZED_ARG;
2554 if (l->right==NULL) l->right = temp;
2555 else appendToTree(csound, l->right, temp);
2556 break;
2557 case 'J':
2558 case 'j':
2559 temp = make_leaf(csound, l->line, l->locn, INTEGER_TOKEN,
2560 make_int(csound, "-1"));
2561 temp->markup = &SYNTHESIZED_ARG;
2562 if (l->right==NULL) l->right = temp;
2563 else appendToTree(csound, l->right, temp);
2564 break;
2565 case 'M':
2566 case 'N':
2567 case 'm':
2568 case 'W':
2569 nreqd--;
2570 break;
2571 default:
2572 synterr(csound,
2573 Str("insufficient required arguments for opcode %s"
2574 " on line %d:\n"),
2575 ep->opname, l->line);
2576 do_baktrace(csound, l->locn);
2577 }
2578 incnt++;
2579 } while (incnt < nreqd);
2580 }
2581 // printf("delete %p\n", inArgParts);
2582 if (inArgParts != NULL) {
2583 int n;
2584 for (n=0; inArgParts[n] != NULL; n++) {
2585 //printf("delete %p\n", inArgParts[n]);
2586 csound->Free(csound, inArgParts[n]);
2587 }
2588 csound->Free(csound, inArgParts);
2589 }
2590 }
2591 }
2592
tree_argtyp(CSOUND * csound,TREE * tree)2593 char tree_argtyp(CSOUND *csound, TREE *tree) {
2594 IGN(csound);
2595 if (tree->type == INTEGER_TOKEN || tree->type == NUMBER_TOKEN) {
2596 return 'i';
2597 }
2598
2599 return argtyp2( tree->value->lexeme);
2600 }
2601