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