1 /*
2 csound_orc_compile.c:
3 (Based on otran.c)
4
5 Copyright (C) 1991, 1997, 2003, 2006, 2012
6 Barry Vercoe, John ffitch, Steven Yi, Victor Lazzarini
7
8 This file is part of Csound.
9
10 The Csound Library is free software; you can redistribute it
11 and/or modify it under the terms of the GNU Lesser General Public
12 License as published by the Free Software Foundation; either
13 version 2.1 of the License, or (at your option) any later version.
14
15 Csound is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU Lesser General Public License for more details.
19
20 You should have received a copy of the GNU Lesser General Public
21 License along with Csound; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
23 02110-1301 USA
24 */
25
26 #include "csoundCore.h"
27 #include "csound_orc.h"
28 #include "parse_param.h"
29 #include <ctype.h>
30 #include <inttypes.h>
31 #include <math.h>
32 #include <string.h>
33
34 #include "insert.h"
35 #include "oload.h"
36 #include "pstream.h"
37 //#include "typetabl.h"
38 #include "csound_orc_semantics.h"
39 #include "csound_standard_types.h"
40
41 MYFLT csoundInitialiseIO(CSOUND *csound);
42 void iotranset(CSOUND *), sfclosein(CSOUND*), sfcloseout(CSOUND*);
43 static const char *INSTR_NAME_FIRST = "::^inm_first^::";
44 static ARG *createArg(CSOUND *csound, INSTRTXT *ip, char *s,
45 ENGINE_STATE *engineState);
46 static void insprep(CSOUND *, INSTRTXT *, ENGINE_STATE *engineState);
47 static void lgbuild(CSOUND *, INSTRTXT *, char *, int inarg,
48 ENGINE_STATE *engineState);
49 int pnum(char *s);
50 static void unquote_string(char *, const char *);
51 void print_tree(CSOUND *, char *, TREE *);
52 void close_instrument(CSOUND *csound, ENGINE_STATE *engineState, INSTRTXT *ip);
53 char argtyp2(char *s);
54 void debugPrintCsound(CSOUND *csound);
55
56 void named_instr_assign_numbers(CSOUND *csound, ENGINE_STATE *engineState);
57 int named_instr_alloc(CSOUND *csound, char *s, INSTRTXT *ip, int32 insno,
58 ENGINE_STATE *engineState, int merge);
59 int check_instr_name(char *s);
60 void free_instr_var_memory(CSOUND *, INSDS *);
61 void mergeState_enqueue(CSOUND *csound, ENGINE_STATE *e, TYPE_TABLE *t,
62 OPDS *ids);
63
64 extern const char *SYNTHESIZED_ARG;
65
66 #ifdef FLOAT_COMPARE
67 #undef FLOAT_COMPARE
68 #endif
69 #ifdef USE_DOUBLE
70 #define FLOAT_COMPARE(x, y) (fabs((double)(x) / (double)(y)-1.0) > 1.0e-12)
71 #else
72 #define FLOAT_COMPARE(x, y) (fabs((double)(x) / (double)(y)-1.0) > 5.0e-7)
73 #endif
74 /* ------------------------------------------------------------------------ */
75
strsav_string(CSOUND * csound,ENGINE_STATE * engineState,char * key)76 char *strsav_string(CSOUND *csound, ENGINE_STATE *engineState, char *key) {
77 char *retVal =
78 cs_hash_table_get_key(csound, csound->engineState.stringPool, key);
79
80 if (retVal == NULL) {
81 // printf("strsav_string: %s\n", key);
82 retVal = cs_hash_table_put_key(csound, engineState->stringPool, key);
83 }
84 return retVal;
85 }
86
pnum(char * s)87 int pnum(char *s) /* check a char string for pnum format */
88 /* and return the pnum ( >= 0 ) */
89 { /* else return -1 */
90 int n;
91
92 if (*s == 'p' || *s == 'P')
93 if (sscanf(++s, "%d", &n))
94 return (n);
95 return (-1);
96 }
97
98 #if 0
99 static int argCount(ARG* arg)
100 {
101 int retVal = -1;
102 if (arg != NULL) {
103 retVal = 0;
104 while (arg != NULL) {
105 arg = arg->next;
106 retVal++;
107 }
108 }
109 return retVal;
110 }
111 #endif
112
113 /* get size of string in MYFLT units */
114 /*static inline int strlen_to_samples(const char *s)
115 {
116 int n = (int) strlen(s);
117 n = (n + (int) sizeof(MYFLT)) / (int) sizeof(MYFLT);
118 return n;
119 }
120 */
121
122 /* convert string constant */
unquote_string(char * dst,const char * src)123 void unquote_string(char *dst, const char *src) {
124 int i, j, n = (int)strlen(src) - 1;
125 for (i = 1, j = 0; i < n; i++) {
126 // printf("char - %c\n", src[i]);
127 if (src[i] != '\\')
128 dst[j++] = src[i];
129 else {
130 // printf("char-- - %c\n", src[i]);
131 switch (src[++i]) {
132
133 case 'a':
134 dst[j++] = '\a';
135 break;
136 case 'b':
137 dst[j++] = '\b';
138 break;
139 case 'f':
140 dst[j++] = '\f';
141 break;
142 case 'n':
143 dst[j++] = '\n';
144 break;
145 case 'r':
146 dst[j++] = '\r';
147 break;
148 case 't':
149 dst[j++] = '\t';
150 break;
151 case 'v':
152 dst[j++] = '\v';
153 break;
154 case '"':
155 dst[j++] = '"';
156 break;
157 case '\\':
158 dst[j++] = '\\'; /*printf("char-- + %c\n", src[i]);*/
159 break;
160
161 default:
162 // printf("char-- ++ %c\n", src[i]);
163 if (src[i] >= '0' && src[i] <= '7') {
164 int k = 0, l = (int)src[i] - '0';
165 while (++k < 3 && src[i + 1] >= '0' && src[i + 1] <= '7')
166 l = (l << 3) | ((int)src[++i] - '0');
167 dst[j++] = (char)l;
168 } else {
169 dst[j++] = '\\';
170 i--;
171 }
172 }
173 }
174 }
175 dst[j] = '\0';
176 }
177
tree_arg_list_count(TREE * root)178 int tree_arg_list_count(TREE *root) {
179 int count = 0;
180 TREE *current = root;
181
182 while (current != NULL) {
183 current = current->next;
184 count++;
185 }
186 return count;
187 }
188
189 /**
190 * Returns last OPTXT of OPTXT chain optxt
191 */
last_optxt(OPTXT * optxt)192 static OPTXT *last_optxt(OPTXT *optxt) {
193 OPTXT *current = optxt;
194
195 while (current->nxtop != NULL) {
196 current = current->nxtop;
197 }
198 return current;
199 }
200
201 /**
202 * Append OPTXT op2 to end of OPTXT chain op1
203 */
204 /*
205 static inline void append_optxt(OPTXT *op1, OPTXT *op2)
206 {
207 last_optxt(op1)->nxtop = op2;
208 }
209 */
210
211 /** Counts number of args in argString, taking into account array identifiers */
argsRequired(char * argString)212 int argsRequired(char *argString) {
213 int retVal = 0;
214 char *t = argString;
215
216 if (t != NULL) {
217 while (*t != '\0') {
218 retVal++;
219 t++;
220 while (*t == '[') {
221 t++;
222 if (*t != ']') {
223 // ERROR HERE, unmatched array identifier, perhaps should report...
224 return -1;
225 }
226 t++;
227 }
228 }
229 }
230 return retVal;
231 }
232
233 /** Splits args in argString into char**, taking into account array identifiers
234 */
splitArgs(CSOUND * csound,char * argString)235 char **splitArgs(CSOUND *csound, char *argString) {
236 int argCount = argsRequired(argString);
237 char **args = csound->Malloc(csound, sizeof(char *) * (argCount + 1));
238 // printf("alloc %p\n", args);
239 char *t = argString;
240 int i = 0;
241
242 if (t != NULL) {
243 while (*t != '\0') {
244 char *part;
245 int dimensions = 0;
246
247 if (*(t + 1) == '[') {
248 char *start = t;
249 int len = 1;
250 int j;
251 t++;
252
253 while (*t == '[') {
254 t++;
255 len++;
256
257 if (UNLIKELY(*t != ']')) {
258 // FIXME: needs more precise error information
259 csound->Message(csound,
260 Str("ERROR: Unmatched bracket found in array"
261 "argument type specification\n"));
262 return NULL;
263 }
264
265 t++;
266 len++;
267 dimensions++;
268 }
269 part = csound->Malloc(csound, sizeof(char) * (dimensions + 3));
270 // printf("alloc %p\n", part);
271 part[dimensions + 2] = '\0';
272 part[dimensions + 1] = ']';
273 part[dimensions] = *start;
274 for (j = 0; j < dimensions; j++) {
275 part[j] = '[';
276 }
277
278 } else {
279 part = csound->Malloc(csound, sizeof(char) * 2);
280 // printf("alloc %p\n", part);
281 part[0] = *t;
282 part[1] = '\0';
283 t++;
284 }
285 args[i] = part;
286 i++;
287 }
288 }
289
290 args[argCount] = NULL;
291
292 return args;
293 }
294
295 OENTRY *find_opcode(CSOUND *, char *);
296 /**
297 * Create an Opcode (OPTXT) from the AST node given for a given engineState
298 */
create_opcode(CSOUND * csound,TREE * root,INSTRTXT * ip,ENGINE_STATE * engineState)299 OPTXT *create_opcode(CSOUND *csound, TREE *root, INSTRTXT *ip,
300 ENGINE_STATE *engineState) {
301 TEXT *tp;
302 TREE *inargs, *outargs;
303 OPTXT *optxt;
304 char *arg;
305 int n; // nreqd;
306 optxt = (OPTXT *)csound->Calloc(csound, (int32)sizeof(OPTXT));
307 tp = &(optxt->t);
308 tp->linenum = root->line; tp->locn = root->locn;
309 OENTRY *labelOpcode;
310
311 switch (root->type) {
312 case LABEL_TOKEN:
313 labelOpcode = find_opcode(csound, "$label");
314 /* TODO - Need to verify here or elsewhere that this label is not
315 already defined */
316 tp->oentry = labelOpcode;
317 tp->opcod = strsav_string(csound, engineState, root->value->lexeme);
318
319 tp->outlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
320 tp->outlist->count = 0;
321 tp->inlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
322 tp->inlist->count = 0;
323
324 // ip->mdepends |= labelOpcode->flags;
325 ip->opdstot += labelOpcode->dsblksiz;
326
327 break;
328 case '=':
329 case GOTO_TOKEN:
330 case IGOTO_TOKEN:
331 case KGOTO_TOKEN:
332 case T_OPCODE:
333 case T_OPCODE0:
334 if (UNLIKELY(PARSER_DEBUG))
335 csound->Message(csound, "create_opcode: Found node for opcode %s\n",
336 root->value->lexeme);
337
338 // FIXME THIS RESULT IS NOT USED -- VL I don't think it's needed
339 // nreqd = tree_arg_list_count(root->left); /* outcount */
340 /* replace opcode if needed */
341
342 /* INITIAL SETUP */
343 tp->oentry = (OENTRY *)root->markup;
344 tp->opcod = strsav_string(csound, engineState, tp->oentry->opname);
345 //tp->linenum = root->line; tp->locn = root->locn;
346 // ip->mdepends |= tp->oentry->flags;
347 ip->opdstot += tp->oentry->dsblksiz;
348
349 /* BUILD ARG LISTS */
350 {
351 int incount = tree_arg_list_count(root->right);
352 int outcount = tree_arg_list_count(root->left);
353 int argcount = 0;
354 size_t m = sizeof(ARGLST) + (incount - 1) * sizeof(char *);
355 tp->inlist = (ARGLST *)csound->ReAlloc(csound, tp->inlist, m);
356 tp->inlist->count = incount;
357
358 m = sizeof(ARGLST) + (outcount - 1) * sizeof(char *);
359 tp->outlist = (ARGLST *)csound->ReAlloc(csound, tp->outlist, m);
360 tp->outlist->count = outcount;
361
362 tp->inArgCount = 0;
363
364 for (inargs = root->right; inargs != NULL; inargs = inargs->next) {
365 /* INARGS */
366 arg = inargs->value->lexeme;
367 // printf("arg: %s\n", arg);
368 tp->inlist->arg[argcount++] = strsav_string(csound, engineState, arg);
369
370 if ((n = pnum(arg)) >= 0) {
371 if (n > ip->pmax)
372 ip->pmax = n;
373 }
374 /* VL 14/12/11 : calling lgbuild here seems to be problematic for
375 undef arg checks */
376 else {
377 lgbuild(csound, ip, arg, 1, engineState);
378 }
379 if (inargs->markup != &SYNTHESIZED_ARG) {
380 tp->inArgCount++;
381 }
382 }
383 }
384 /* VERIFY ARG LISTS MATCH OPCODE EXPECTED TYPES */
385 {
386
387 OENTRY *ep = tp->oentry;
388 int argcount = 0;
389 for (outargs = root->left; outargs != NULL; outargs = outargs->next) {
390 arg = outargs->value->lexeme;
391 tp->outlist->arg[argcount++] = strsav_string(csound, engineState, arg);
392 }
393
394 tp->outArgCount = 0;
395
396 /* OUTARGS */
397 for (outargs = root->left; outargs != NULL; outargs = outargs->next) {
398
399 arg = outargs->value->lexeme;
400
401 if ((n = pnum(arg)) >= 0) {
402 if (n > ip->pmax)
403 ip->pmax = n;
404 } else {
405 csound->DebugMsg(csound, "Arg: %s\n", arg);
406 lgbuild(csound, ip, arg, 0, engineState);
407 }
408 tp->outArgCount++;
409 }
410
411 if (root->right != NULL) {
412 if (ep->intypes[0] != 'l') { /* intype defined by 1st inarg */
413 tp->intype = argtyp2(tp->inlist->arg[0]);
414 } else {
415 tp->intype = 'l'; /* (unless label) */
416 }
417 }
418
419 if (root->left != NULL) { /* pftype defined by outarg */
420 tp->pftype = argtyp2(root->left->value->lexeme);
421 } else { /* else by 1st inarg */
422 tp->pftype = tp->intype;
423 }
424 }
425 break;
426 default:
427 csound->Message(csound, Str("create_opcode: No rule to handle statement of "
428 "type %d\n"),
429 root->type);
430 if (PARSER_DEBUG)
431 print_tree(csound, NULL, root);
432 }
433
434 return optxt;
435 }
436
437 /**
438 * Add a global variable and allocate memory
439 * Globals, unlike locals, keep their memory space
440 * in separate blocks, pointed by var->memBlock
441 */
addGlobalVariable(CSOUND * csound,ENGINE_STATE * engineState,CS_TYPE * type,char * name,void * typeArg)442 void addGlobalVariable(CSOUND *csound, ENGINE_STATE *engineState, CS_TYPE *type,
443 char *name, void *typeArg) {
444 CS_VARIABLE *var =
445 csoundCreateVariable(csound, csound->typePool, type, name, typeArg);
446 size_t memSize = CS_VAR_TYPE_OFFSET + var->memBlockSize;
447 CS_VAR_MEM *varMem = csound->Malloc(csound, memSize);
448 csoundAddVariable(csound, engineState->varPool, var);
449
450 varMem->varType = var->varType;
451 var->memBlock = varMem;
452 if (var->initializeVariableMemory != NULL) {
453 var->initializeVariableMemory((void *)csound, var, &varMem->value);
454 }
455 }
456
find_or_add_constant(CSOUND * csound,CS_HASH_TABLE * constantsPool,const char * name,MYFLT value)457 void *find_or_add_constant(CSOUND *csound, CS_HASH_TABLE *constantsPool,
458 const char *name, MYFLT value) {
459 void *retVal = cs_hash_table_get(csound, constantsPool, (char *)name);
460 if (retVal == NULL) {
461 CS_VAR_MEM *memValue = csound->Calloc(csound, sizeof(CS_VAR_MEM));
462 memValue->varType = (CS_TYPE *)&CS_VAR_TYPE_C;
463 memValue->value = value;
464 cs_hash_table_put(csound, constantsPool, (char *)name, memValue);
465 retVal = cs_hash_table_get(csound, constantsPool, (char *)name);
466 }
467 return retVal;
468 }
469
470 /**
471 * NB - instr0 to be created only once, in the first compilation
472 * and stored in csound->instr0
473 * Create an Instrument (INSTRTXT) from the AST node given for use as
474 * Instrument0. Called from csound_orc_compile.
475 */
create_instrument0(CSOUND * csound,TREE * root,ENGINE_STATE * engineState,CS_VAR_POOL * varPool)476 INSTRTXT *create_instrument0(CSOUND *csound, TREE *root,
477 ENGINE_STATE *engineState, CS_VAR_POOL *varPool) {
478 INSTRTXT *ip;
479 OPTXT *op;
480 TREE *current;
481 MYFLT sr = FL(-1.0), kr = FL(-1.0), ksmps = FL(-1.0), nchnls = DFLT_NCHNLS,
482 inchnls = -FL(1.0), _0dbfs = FL(-1.0);
483 int krdef = 0; //, ksmpsdef = 0, srdef = 0;
484 double A4 = 0.0;
485 CS_TYPE *rType = (CS_TYPE *)&CS_VAR_TYPE_R;
486
487 addGlobalVariable(csound, engineState, rType, "sr", NULL);
488 addGlobalVariable(csound, engineState, rType, "kr", NULL);
489 addGlobalVariable(csound, engineState, rType, "ksmps", NULL);
490 addGlobalVariable(csound, engineState, rType, "nchnls", NULL);
491 addGlobalVariable(csound, engineState, rType, "nchnls_i", NULL);
492 addGlobalVariable(csound, engineState, rType, "0dbfs", NULL);
493 addGlobalVariable(csound, engineState, rType, "A4", NULL);
494 addGlobalVariable(csound, engineState, rType, "$sr", NULL);
495 addGlobalVariable(csound, engineState, rType, "$kr", NULL);
496 addGlobalVariable(csound, engineState, rType, "$ksmps", NULL);
497
498 find_or_add_constant(csound, engineState->constantsPool, "0", 0.0);
499
500 ip = (INSTRTXT *)csound->Calloc(csound, sizeof(INSTRTXT));
501 ip->varPool = varPool;
502 op = (OPTXT *)ip;
503
504 current = root;
505
506 /* initialize */
507
508 // ip->mdepends = 0;
509 ip->opdstot = 0;
510 ip->nocheckpcnt = 0;
511
512 ip->pmax = 3L;
513
514 /* start chain */
515 ip->t.oentry = find_opcode(csound, "instr");
516 /* to hold global assigns */
517 ip->t.opcod = strsav_string(csound, engineState, "instr");
518
519 /* The following differs from otran and needs review. otran keeps a
520 * nulllist to point to for empty lists, while this is creating a new list
521 * regardless
522 */
523 ip->t.outlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
524 ip->t.outlist->count = 0;
525 ip->t.inlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
526 ip->t.inlist->count = 1;
527
528 ip->t.inlist->arg[0] = strsav_string(csound, engineState, "0");
529
530 while (current != NULL) {
531 unsigned int uval;
532 if (current->type != INSTR_TOKEN && current->type != UDO_TOKEN) {
533 OENTRY *oentry = (OENTRY *)current->markup;
534 if (UNLIKELY(PARSER_DEBUG))
535 csound->Message(csound, "In INSTR 0: %s\n", current->value->lexeme);
536
537 if (current->type == '=' && strcmp(oentry->opname, "=.r") == 0) {
538
539 // FIXME - perhaps should add check as it was in
540 // constndx? Not sure if necessary due to assumption
541 // that tree will be verified
542 MYFLT val = (MYFLT)cs_strtod(current->right->value->lexeme, NULL);
543 // systems constants get set here and are not
544 // compiled into i-time code
545 find_or_add_constant(csound, csound->engineState.constantsPool,
546 (const char *)current->right->value->lexeme, val);
547
548 /* modify otran defaults*/
549 /* removed assignments to csound->tran_* */
550 if (current->left->type == SRATE_TOKEN) {
551 sr = val;
552 // srdef = 1;
553 } else if (current->left->type == KRATE_TOKEN) {
554 kr = val;
555 krdef = 1;
556 } else if (current->left->type == KSMPS_TOKEN) {
557 uval = (val <= 0 ? 1u : (unsigned int)val);
558 ksmps = uval;
559 // ksmpsdef = 1;
560 } else if (current->left->type == NCHNLS_TOKEN) {
561 uval = (val <= 0 ? 1u : (unsigned int)val);
562 nchnls = uval;
563 } else if (current->left->type == NCHNLSI_TOKEN) {
564 uval = (val < 0 ? 1u : (unsigned int)val);
565 inchnls = uval;
566 } else if (current->left->type == ZERODBFS_TOKEN) {
567 _0dbfs = val;
568 } else if (current->left->type == A4_TOKEN) {
569 A4 = val;
570 }
571 } else {
572 op->nxtop = create_opcode(csound, current, ip, engineState);
573 op = last_optxt(op);
574 }
575 }
576 current = current->next;
577 }
578
579 /* Deal with defaults and consistency */
580 if (ksmps == FL(-1.0)) {
581 if (sr == FL(-1.0))
582 sr = DFLT_SR;
583 if (kr == FL(-1.0))
584 kr = DFLT_KR;
585 ksmps = (MYFLT)((int)(sr / kr + FL(0.5)));
586 kr = sr / ksmps; /* VL - avoid inconsistency */
587 } else if (kr == FL(-1.0)) {
588 if (sr == FL(-1.0))
589 sr = DFLT_SR;
590 kr = sr / ksmps;
591 } else if (sr == FL(-1.0)) {
592 sr = kr * ksmps;
593 }
594 /* That deals with missing values, however we do need ksmps to be integer */
595 {
596 CSOUND *p = (CSOUND *)csound;
597 char err_msg[128];
598 CS_SPRINTF(err_msg, "sr = %.7g, kr = %.7g, ksmps = %.7g\nerror:", sr, kr,
599 ksmps);
600 if (UNLIKELY(sr <= FL(0.0)))
601 synterr(p, Str("%s invalid sample rate"), err_msg);
602 if (UNLIKELY(kr <= FL(0.0)))
603 synterr(p, Str("%s invalid control rate"), err_msg);
604 if (UNLIKELY(ksmps <= FL(0.0)))
605 synterr(p, Str("%s invalid number of samples"), err_msg);
606 else if (UNLIKELY(ksmps < FL(0.75) ||
607 FLOAT_COMPARE(ksmps, MYFLT2LRND(ksmps)))) {
608 /* VL 14/11/18: won't fail but correct values to make ksmps integral */
609 csound->Warning(p, Str("%s invalid ksmps value, needs to be integral."),
610 err_msg);
611 ksmps = floor(ksmps);
612 kr = sr/ksmps;
613 csound->Warning(p, "resetting orc parameters to: "
614 "sr = %.7g, kr = %.7g, ksmps = %.7g", sr, kr,
615 ksmps);
616 }
617 else if (UNLIKELY(FLOAT_COMPARE(sr, (double)kr * ksmps)))
618 synterr(p, Str("%s inconsistent sr, kr, ksmps\n"), err_msg);
619 else if (UNLIKELY(ksmps > sr))
620 synterr(p, Str("%s inconsistent sr, kr, ksmps\n"), err_msg);
621 }
622
623 csound->ksmps = ksmps;
624 csound->nchnls = nchnls;
625 if (inchnls < 0)
626 csound->inchnls = nchnls;
627 else
628 csound->inchnls = inchnls;
629 csound->esr = sr;
630 csound->ekr = kr;
631 if (_0dbfs < 0)
632 csound->e0dbfs = DFLT_DBFS;
633 else
634 csound->e0dbfs = _0dbfs;
635 if (A4 == 0)
636 csound->A4 = 440.0;
637 else {
638 extern void csound_aops_init_tables(CSOUND *);
639 csound->A4 = A4;
640 csound_aops_init_tables(csound);
641 }
642 if (UNLIKELY(csound->e0dbfs <= FL(0.0))) {
643 csound->Warning(csound, Str("bad value for 0dbfs: must be positive. "
644 "Setting default value."));
645 csound->e0dbfs = DFLT_DBFS;
646 }
647
648 OPARMS *O = csound->oparms;
649 if (O->nchnls_override > 0)
650 csound->nchnls = csound->inchnls = O->nchnls_override;
651 if (O->nchnls_i_override > 0)
652 csound->inchnls = O->nchnls_i_override;
653 if (O->e0dbfs_override > 0)
654 csound->e0dbfs = O->e0dbfs_override;
655
656 // VL 01-05-2019
657 // if --use-system-sr is applied, then we need to
658 // initialise IO early to get the sampling rate
659 // at this stage we have enough data on channels
660 // to do this. Only applies to audio device output
661 if(O->sr_override == -1.0 &&
662 !strncmp(O->outfilename, "dac",3)) {
663 MYFLT tmp_sr = csound->esr;
664 csound->esr = -1.0;
665 O->sr_override = csoundInitialiseIO(csound);
666 if(O->sr_override > 0)
667 csound->Message(csound, "Using system sampling rate %.1f\n", O->sr_override);
668 else {
669 csound->Message(csound, "System sr not available\n");
670 O->sr_override = FL(0.0);
671 }
672 csound->esr = tmp_sr;
673 }
674
675 if (UNLIKELY(O->odebug))
676 csound->Message(csound, "esr = %7.1f, ekr = %7.1f, ksmps = %d, nchnls = %d "
677 "0dbfs = %.1f\n",
678 csound->esr, csound->ekr, csound->ksmps, csound->nchnls,
679 csound->e0dbfs);
680
681 if (O->sr_override || O->kr_override ||
682 O->ksmps_override) { /* if command-line overrides, apply now */
683 MYFLT ensmps;
684
685 if (!O->ksmps_override) {
686 csound->esr = (MYFLT)(O->sr_override ? O->sr_override : csound->esr);
687 if (krdef) {
688 csound->ekr = (MYFLT)(O->kr_override ? O->kr_override : csound->ekr);
689 csound->ksmps =
690 (int)((ensmps = ((MYFLT)csound->esr / (MYFLT)csound->ekr)) +
691 FL(0.5));
692 } else {
693 csound->ekr = csound->esr / csound->ksmps;
694 ensmps = csound->ksmps;
695 }
696 } else {
697 csound->ksmps = (ensmps = O->ksmps_override);
698 if (O->sr_override) {
699 csound->ekr = O->sr_override / csound->ksmps;
700 csound->esr = O->sr_override;
701 } else if (O->kr_override) {
702 csound->esr = O->kr_override * csound->ksmps;
703 csound->ekr = O->kr_override;
704 } else {
705 csound->ekr = csound->esr / csound->ksmps;
706 }
707 }
708
709 /* chk consistency one more time */
710 {
711 char s[256];
712 CS_SPRINTF(s, Str("sr = %.7g, kr = %.7g, ksmps = %.7g\n"),
713 csound->esr, csound->ekr, ensmps);
714 if (UNLIKELY(csound->ksmps < 1 || FLOAT_COMPARE(ensmps, csound->ksmps))) {
715 /* VL 14/11/18: won't fail but correct values to make ksmps integral */
716 csound->Warning(csound,
717 Str("%s invalid ksmps value, needs to be integral."), s);
718 ensmps = csound->ksmps = floor(ensmps);
719 csound->ekr = csound->esr/csound->ksmps;
720 csound->Warning(csound, Str("resetting orc parameters to: "
721 "sr = %.7g, kr = %.7g, ksmps = %u"),
722 csound->esr, csound->ekr, csound->ksmps);
723 }
724 if (UNLIKELY(csound->esr <= FL(0.0)))
725 csoundDie(csound, Str("%s invalid sample rate"), s);
726 if (UNLIKELY(csound->ekr <= FL(0.0)))
727 csoundDie(csound, Str("%s invalid control rate"), s);
728 if (UNLIKELY(FLOAT_COMPARE(csound->esr, (double)csound->ekr * ensmps)))
729 csoundDie(csound, Str("%s inconsistent sr, kr, ksmps"), s);
730 }
731 csound->Message(csound, Str("sample rate overrides: "
732 "esr = %7.4f, ekr = %7.4f, ksmps = %d\n"),
733 csound->esr, csound->ekr, csound->ksmps);
734 }
735
736 csound->tpidsr = TWOPI_F / csound->esr; /* now set internal */
737 csound->mtpdsr = -(csound->tpidsr); /* consts */
738 csound->pidsr = PI_F / csound->esr;
739 csound->mpidsr = -(csound->pidsr);
740 csound->onedksmps = FL(1.0) / (MYFLT)csound->ksmps;
741 csound->sicvt = FMAXLEN / csound->esr;
742 csound->kicvt = FMAXLEN / csound->ekr;
743 csound->onedsr = FL(1.0) / csound->esr;
744 csound->onedkr = FL(1.0) / csound->ekr;
745 csound->global_kcounter = csound->kcounter;
746
747 if (csound->ksmps != DFLT_KSMPS) {
748 reallocateVarPoolMemory(csound, engineState->varPool);
749 // csound->Message(csound, "recalculate varpool\n");
750 }
751 close_instrument(csound, engineState, ip);
752
753 return ip;
754 }
755
756 /**
757 This global instrument replaces instr 0 in
758 subsequent compilations. It does not allow the
759 setting of system parameters such as ksmps etc,
760 but it allows i-time code to be compiled and run.
761 **/
create_global_instrument(CSOUND * csound,TREE * root,ENGINE_STATE * engineState,CS_VAR_POOL * varPool)762 INSTRTXT *create_global_instrument(CSOUND *csound, TREE *root,
763 ENGINE_STATE *engineState,
764 CS_VAR_POOL *varPool) {
765 INSTRTXT *ip;
766 OPTXT *op;
767 TREE *current;
768
769 // csound->inZero = 1;
770 find_or_add_constant(csound, engineState->constantsPool, "0", 0);
771
772 ip = (INSTRTXT *)csound->Calloc(csound, sizeof(INSTRTXT));
773 ip->varPool = varPool;
774 op = (OPTXT *)ip;
775
776 current = root;
777
778 /* initialize */
779 // ip->mdepends = 0;
780 ip->opdstot = 0;
781 ip->pmax = 3L;
782
783 /* start chain */
784 ip->t.oentry = find_opcode(csound, "instr");
785 /* to hold global assigns */
786 ip->t.opcod = strsav_string(csound, engineState, "instr");
787
788 /* The following differs from otran and needs review. otran keeps a
789 * nulllist to point to for empty lists, while this is creating a new list
790 * regardless
791 */
792 ip->t.outlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
793 ip->t.outlist->count = 0;
794 ip->t.inlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
795 ip->t.inlist->count = 1;
796
797 ip->t.inlist->arg[0] = strsav_string(csound, engineState, "0");
798
799 while (current != NULL) {
800 if (current->type != INSTR_TOKEN && current->type != UDO_TOKEN) {
801 OENTRY *oentry = (OENTRY *)current->markup;
802 if (UNLIKELY(PARSER_DEBUG))
803 csound->Message(csound, "In INSTR GLOBAL: %s\n",
804 current->value->lexeme);
805 if (UNLIKELY(current->type == '=' && strcmp(oentry->opname, "=.r") == 0))
806 csound->Warning(csound, Str("system constants can only be set once\n"));
807 else {
808 op->nxtop = create_opcode(csound, current, ip, engineState);
809 op = last_optxt(op);
810 }
811 }
812 current = current->next;
813 }
814
815 close_instrument(csound, engineState, ip);
816 // csound->inZero = 0;
817 return ip;
818 }
819
tree_contains_fn_p(CSOUND * csound,TREE * t)820 int tree_contains_fn_p(CSOUND *csound, TREE *t) {
821 // print_tree(csound, "\ntree_contains_fn_p", t);
822 while (t != NULL) {
823 if (t->type == T_OPCODE && strcmp(t->value->lexeme, "p") == 0)
824 return 1;
825 if (t->left && tree_contains_fn_p(csound, t->left))
826 return 1;
827 if (t->right && tree_contains_fn_p(csound, t->right))
828 return 1;
829 t = t->next;
830 }
831 return 0;
832 }
833
834 /**
835 * Create an Instrument (INSTRTXT) from the AST node given. Called from
836 * csound_orc_compile.
837 */
create_instrument(CSOUND * csound,TREE * root,ENGINE_STATE * engineState)838 INSTRTXT *create_instrument(CSOUND *csound, TREE *root,
839 ENGINE_STATE *engineState) {
840 INSTRTXT *ip;
841 OPTXT *op;
842 char *c;
843 TREE *statements, *current;
844
845 ip = (INSTRTXT *)csound->Calloc(csound, sizeof(INSTRTXT));
846 ip->varPool = (CS_VAR_POOL *)root->markup;
847 op = (OPTXT *)ip;
848 statements = root->right;
849 // ip->mdepends = 0;
850 ip->opdstot = 0;
851 ip->nocheckpcnt = tree_contains_fn_p(csound, root->right);
852 ip->pmax = 3L;
853
854 /* Initialize */
855 ip->t.oentry = find_opcode(csound, "instr");
856 /* to hold global assigns */
857 ip->t.opcod = strsav_string(csound, engineState, "instr");
858
859 /* The following differs from otran and needs review. otran keeps a
860 * nulllist to point to for empty lists, while this is creating a new list
861 * regardless
862 */
863 ip->t.outlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
864 ip->t.outlist->count = 0;
865 ip->t.inlist = (ARGLST *)csound->Malloc(csound, sizeof(ARGLST));
866 ip->t.inlist->count = 1;
867
868 /* create local ksmps variable */
869 CS_TYPE *rType = (CS_TYPE *)&CS_VAR_TYPE_R;
870 CS_VARIABLE *var =
871 csoundCreateVariable(csound, csound->typePool, rType, "ksmps", NULL);
872 csoundAddVariable(csound, ip->varPool, var);
873 /* same for kr */
874 var = csoundCreateVariable(csound, csound->typePool, rType, "kr", NULL);
875 csoundAddVariable(csound, ip->varPool, var);
876
877 /* Maybe should do this assignment at end when instr is setup?
878 * Note: look into how "instr 4,5,6,8" is handled, i.e. if copies
879 * are made or if they are all set to point to the same INSTRTXT
880 *
881 * Note2: For now am not checking if root->left is a list (i.e. checking
882 * root->left->next is NULL or not to indicate list)
883 */
884 if (root->left->type == INTEGER_TOKEN) { /* numbered instrument */
885 int32 instrNum = (int32)root->left->value->value; /* Not used! */
886
887 c = csound->Malloc(csound, 10); /* arbritrarily chosen number of digits */
888 snprintf(c, 10, "%" PRIi32, instrNum);
889
890 if (PARSER_DEBUG)
891 csound->Message(csound, Str("create_instrument: instr num %" PRIi32 "\n"),
892 instrNum);
893
894 ip->t.inlist->arg[0] = strsav_string(csound, engineState, c);
895
896 csound->Free(csound, c);
897 } else if (root->left->type == T_IDENT &&
898 !(root->left->left != NULL &&
899 root->left->left->type ==
900 UDO_ANS_TOKEN)) { /* named instrument */
901 int32 insno_priority = -1L;
902 c = root->left->value->lexeme;
903
904 if (PARSER_DEBUG)
905 csound->Message(csound, "create_instrument: instr name %s\n", c);
906
907 if (UNLIKELY(root->left->rate == (int)'+')) {
908 insno_priority--;
909 }
910
911 ip->insname = csound->Malloc(csound, strlen(c) + 1);
912 strcpy(ip->insname, c);
913 }
914 current = statements;
915 while (current != NULL) {
916 OPTXT *optxt = create_opcode(csound, current, ip, engineState);
917 op->nxtop = optxt;
918 op = last_optxt(op);
919 current = current->next;
920 }
921 close_instrument(csound, engineState, ip);
922 return ip;
923 }
924
close_instrument(CSOUND * csound,ENGINE_STATE * engineState,INSTRTXT * ip)925 void close_instrument(CSOUND *csound, ENGINE_STATE *engineState, INSTRTXT *ip) {
926 OPTXT *bp, *current;
927 int n;
928 bp = (OPTXT *)csound->Calloc(csound, (int32)sizeof(OPTXT));
929
930 bp->t.oentry = find_opcode(csound, "endin"); /* send an endin to */
931 bp->t.opcod =
932 strsav_string(csound, engineState, "endin"); /* term instr 0 blk */
933 bp->t.outlist = bp->t.inlist = NULL;
934
935 bp->nxtop = NULL; /* terminate the optxt chain */
936
937 current = (OPTXT *)ip;
938
939 while (current->nxtop != NULL) {
940 current = current->nxtop;
941 }
942
943 current->nxtop = bp;
944 ip->pextrab = ((n = ip->pmax - 3L) > 0 ? (int)n * sizeof(MYFLT) : 0);
945 ip->pextrab = ((int)ip->pextrab + 7) & (~7);
946 ip->muted = 1;
947 }
948
949 void deleteVarPoolMemory(void *csound, CS_VAR_POOL *pool);
950
951 /**
952 This function deletes an inactive instrument which has been replaced
953 */
free_instrtxt(CSOUND * csound,INSTRTXT * instrtxt)954 void free_instrtxt(CSOUND *csound, INSTRTXT *instrtxt) {
955 INSTRTXT *ip = instrtxt;
956 INSDS *active = ip->instance;
957 while (active != NULL) { /* remove instance memory */
958 INSDS *nxt = active->nxtinstance;
959 if (active->fdchp != NULL)
960 fdchclose(csound, active);
961 if (active->auxchp != NULL)
962 auxchfree(csound, active);
963 free_instr_var_memory(csound, active);
964 if (active->opcod_iobufs != NULL)
965 csound->Free(csound, active->opcod_iobufs);
966 csound->Free(csound, active);
967 active = nxt;
968 }
969 OPTXT *t = ip->nxtop;
970 while (t) {
971 OPTXT *s = t->nxtop;
972 TEXT *ttp = &t->t;
973 // printf("%s\n", ttp->opcod);
974 ARG *current = ttp->outArgs;
975 while (current != NULL) {
976 ARG *tmp = current;
977 // printf("delete %p\n", tmp);
978 current = current->next;
979 csound->Free(csound, tmp);
980 }
981 csound->Free(csound, t->t.outlist);
982 current = ttp->inArgs;
983 while (current != NULL) {
984 ARG *tmp = current;
985 // printf("delete %p\n", tmp);
986 current = current->next;
987 csound->Free(csound, tmp);
988 }
989 csound->Free(csound, t->t.inlist);
990 csound->Free(csound, t);
991 t = s;
992 }
993
994 csound->Free(csound, ip->t.outlist);
995 csound->Free(csound, ip->t.inlist);
996 CS_VARIABLE *var = ip->varPool->head;
997 while (var != NULL) {
998 CS_VARIABLE *tmp = var;
999 var = var->next;
1000 csound->Free(csound, tmp->varName);
1001 }
1002
1003 csoundFreeVarPool(csound, ip->varPool);
1004 csound->Free(csound, ip);
1005 if (UNLIKELY(csound->oparms->odebug))
1006 csound->Message(csound, Str("-- deleted instr from deadpool\n"));
1007 }
1008
1009 /**
1010 * This function has two purposes:
1011 * 1) check deadpool for active instances, and
1012 * if none is active, send it to be deleted
1013 * 2) add a dead instr to deadpool (because it still has active instances)
1014 */
add_to_deadpool(CSOUND * csound,INSTRTXT * instrtxt)1015 void add_to_deadpool(CSOUND *csound, INSTRTXT *instrtxt) {
1016 /* check current items in deadpool to see if they need deleting */
1017 int i;
1018 for (i = 0; i < csound->dead_instr_no; i++) {
1019 if (csound->dead_instr_pool[i] != NULL) {
1020 INSDS *active = csound->dead_instr_pool[i]->instance;
1021 while (active != NULL) {
1022 if (active->actflg) {
1023 // add_to_deadpool(csound,csound->dead_instr_pool[i]);
1024 break;
1025 }
1026 active = active->nxtinstance;
1027 }
1028 /* no active instances */
1029 if (active == NULL) {
1030 if (UNLIKELY(csound->oparms->odebug))
1031 csound->Message(csound, Str(" -- free instr def %p %p\n"),
1032 csound->dead_instr_pool[i]->instance,
1033 csound->dead_instr_pool[i]);
1034 free_instrtxt(csound, csound->dead_instr_pool[i]);
1035 csound->dead_instr_pool[i] = NULL;
1036 }
1037 }
1038 }
1039 /* add latest instr to deadpool */
1040 /* check for free slots */
1041 for (i = 0; i < csound->dead_instr_no; i++) {
1042 if (csound->dead_instr_pool[i] == NULL) {
1043 csound->dead_instr_pool[i] = instrtxt;
1044 if (UNLIKELY(csound->oparms->odebug))
1045 csound->Message(csound, Str(" -- added to deadpool slot %d\n"), i);
1046 return;
1047 }
1048 }
1049 /* no free slots, expand pool */
1050 csound->dead_instr_pool = (INSTRTXT **)csound->ReAlloc(
1051 csound, csound->dead_instr_pool,
1052 ++csound->dead_instr_no * sizeof(INSTRTXT *));
1053 csound->dead_instr_pool[csound->dead_instr_no - 1] = instrtxt;
1054 if (UNLIKELY(csound->oparms->odebug))
1055 csound->Message(csound, Str(" -- added to deadpool slot %d\n"),
1056 csound->dead_instr_no - 1);
1057 }
1058
1059 int32 named_instr_find(CSOUND *csound, char *s);
1060 int32 named_instr_find_in_engine(CSOUND *csound, char *s,
1061 ENGINE_STATE *engineState);
1062 /**
1063 allocate entry for named instrument ip with name s
1064 instrument number is set to insno
1065 If named instr exists, it is replaced.
1066 */
named_instr_alloc(CSOUND * csound,char * s,INSTRTXT * ip,int32 insno,ENGINE_STATE * engineState,int merge)1067 int named_instr_alloc(CSOUND *csound, char *s, INSTRTXT *ip, int32 insno,
1068 ENGINE_STATE *engineState, int merge) {
1069 INSTRNAME *inm, *inm2, *inm_head;
1070 int ret = 1, no = insno;
1071
1072 if (UNLIKELY(!engineState->instrumentNames))
1073 engineState->instrumentNames = cs_hash_table_create(csound);
1074
1075 /* now check if instrument is already defined */
1076 inm = cs_hash_table_get(csound, engineState->instrumentNames, s);
1077 if (inm != NULL) {
1078 int i;
1079 ret = 0;
1080 if (!merge)
1081 return ret;
1082 inm->ip->isNew = 1;
1083 /* redefinition does not raise an error now, just a warning */
1084 if (UNLIKELY(csound->oparms->odebug))
1085 csound->Warning(csound, Str("named instr %" PRIi32 " redefined, "
1086 "replacing previous definition"),
1087 inm->instno);
1088 // VL 26.05.2018 get the existing instr allocated number
1089 no = inm->instno;
1090 /* here we should move the old instrument definition into a deadpool
1091 which will be checked for active instances and freed when there are no
1092 further ones
1093 */
1094 for (i = 0; i < engineState->maxinsno; i++) {
1095 /* check for duplicate numbers and do nothing */
1096 if (i != inm->instno &&
1097 engineState->instrtxtp[i] == engineState->instrtxtp[inm->instno]) {
1098 // csound->Message(csound, "duplicate %d %d\n", i, inm->instno);
1099 // so fill this with the new instrument pointer
1100 engineState->instrtxtp[i] = ip;
1101 goto cont;
1102 }
1103 }
1104 INSDS *active = engineState->instrtxtp[inm->instno]->instance;
1105 while (active != NULL) {
1106 if (active->actflg) {
1107 /* FIXME: */
1108 /* this seems to be wiping memory that is still being used */
1109 // add_to_deadpool(csound, engineState->instrtxtp[inm->instno]);
1110 /* this marks the instrument number ready for replacement */
1111 engineState->instrtxtp[inm->instno] = NULL;
1112 break;
1113 }
1114 active = active->nxtinstance;
1115 }
1116 /* no active instances */
1117 if (active == NULL) {
1118 if (UNLIKELY(csound->oparms->odebug))
1119 csound->Message(csound, Str("no active instances\n"));
1120 free_instrtxt(csound, engineState->instrtxtp[inm->instno]);
1121 engineState->instrtxtp[inm->instno] = NULL;
1122 }
1123 inm->ip->instance = inm->ip->act_instance = inm->ip->lst_instance = NULL;
1124 }
1125 cont:
1126
1127 /* allocate entry, */
1128 inm = (INSTRNAME *)csound->Calloc(csound, sizeof(INSTRNAME));
1129
1130 /* and store parameters */
1131 inm->name = cs_strdup(csound, s);
1132 inm->ip = ip;
1133 // VL 26.05.2018 copy existing number
1134 if(no > 0)
1135 inm->instno = no;
1136
1137 //printf("insno %d %s\n", insno, s);
1138 /* link into chain */
1139 cs_hash_table_put(csound, engineState->instrumentNames, s, inm);
1140
1141 if(!merge) {
1142 /* temporary chain for use by named_instr_assign_numbers()
1143 this is not needed at merge stage
1144 */
1145 inm2 = (INSTRNAME *)csound->Calloc(csound, sizeof(INSTRNAME));
1146 inm2->instno = insno;
1147 inm2->name = (char *) inm; /* hack */
1148 inm_head = cs_hash_table_get(csound, engineState->instrumentNames,
1149 (char *)INSTR_NAME_FIRST);
1150
1151 if (inm_head == NULL) {
1152 cs_hash_table_put(csound, engineState->instrumentNames,
1153 (char *)INSTR_NAME_FIRST, inm2);
1154 } else {
1155 while (inm_head->next != NULL) {
1156 inm_head = inm_head->next;
1157 }
1158 inm_head->next = inm2;
1159 }
1160 }
1161
1162 if (UNLIKELY(csound->oparms->odebug) && engineState == &csound->engineState)
1163 csound->Message(csound, "named instr name = \"%s\", txtp = %p,\n", s,
1164 (void *)ip);
1165 return ret;
1166 }
1167
1168
1169 /**
1170 assign instrument numbers to all named instruments
1171 */
named_instr_assign_numbers(CSOUND * csound,ENGINE_STATE * engineState)1172 void named_instr_assign_numbers(CSOUND *csound, ENGINE_STATE *engineState) {
1173 INSTRNAME *inm, *inm2, *inm_first;
1174 int num = 0, inum, insno_priority = 0;
1175
1176 if (!engineState->instrumentNames)
1177 return; /* no named instruments */
1178 inm_first = cs_hash_table_get(csound, engineState->instrumentNames,
1179 (char *)INSTR_NAME_FIRST);
1180
1181 while (--insno_priority > -3) {
1182 if (insno_priority == -2) {
1183 /* check both this state & current state */
1184 num = engineState->maxinsno >
1185 csound->engineState.maxinsno ?
1186 engineState->maxinsno :
1187 csound->engineState.maxinsno; /* find last used instr number */
1188
1189 /* check both this state & current state */
1190 while ((!engineState->instrtxtp[num] ||
1191 !csound->engineState.instrtxtp[num]) &&
1192 --num)
1193 ;
1194
1195 }
1196 for (inm = inm_first; inm; inm = inm->next) {
1197 INSTRNAME *temp = (INSTRNAME *)inm->name;
1198 int no = 0;
1199 if ((int)inm->instno != insno_priority)
1200 continue;
1201 no = named_instr_find(csound, temp->name);
1202
1203 if (no == 0) { // if there is no allocated number
1204 /* find an unused number and use it */
1205 /* VL, start from instr 1 */
1206 num = 1;
1207 /* check both this state & current state */
1208 while (num <= engineState->maxinsno
1209 && (engineState->instrtxtp[num]
1210 || csound->engineState.instrtxtp[num])) num++;
1211
1212 /* we may need to expand the instrument array */
1213 if (num > engineState->maxinsno) {
1214 int m = engineState->maxinsno;
1215 engineState->maxinsno += MAXINSNO; /* Expand */
1216 engineState->instrtxtp = (INSTRTXT **)csound->ReAlloc(
1217 csound, engineState->instrtxtp,
1218 (1 + engineState->maxinsno) * sizeof(INSTRTXT *));
1219 /* Array expected to be nulled so.... */
1220 while (++m <= engineState->maxinsno)
1221 engineState->instrtxtp[m] = NULL;
1222 }
1223 inum = num;
1224 } else
1225 inum = no; // else use existing number
1226 /* hack: "name" actually points to the corresponding INSTRNAME */
1227 inm2 = (INSTRNAME *)(inm->name); /* entry in the table */
1228
1229 inm2->instno = (int32)inum;
1230 engineState->instrtxtp[inum] = inm2->ip;
1231
1232 //if(&csound->engineState == engineState) {
1233 /* print message only after merge */
1234 if (UNLIKELY((csound->oparms->odebug) || (csound->oparms->msglevel > 0)))
1235 csound->Message(csound, Str("instr %s uses instrument number %d\n"),
1236 inm2->name, inum);
1237 //}
1238 }
1239 }
1240 /* clear temporary chains */
1241 inm = inm_first;
1242 while (inm) {
1243 INSTRNAME *nxtinm = inm->next;
1244 csound->Free(csound, inm);
1245 inm = nxtinm;
1246 }
1247 cs_hash_table_remove(csound, engineState->instrumentNames,
1248 (char *)INSTR_NAME_FIRST);
1249 }
1250
1251 /**
1252 Insert INSTRTXT into an engineState list of INSTRTXT's,
1253 checking to see if number is greater than number of pointers currently
1254 allocated and if so expand pool of instruments
1255 */
insert_instrtxt(CSOUND * csound,INSTRTXT * instrtxt,int32 instrNum,ENGINE_STATE * engineState,int merge)1256 void insert_instrtxt(CSOUND *csound, INSTRTXT *instrtxt, int32 instrNum,
1257 ENGINE_STATE *engineState, int merge) {
1258 int i;
1259
1260 if (UNLIKELY(instrNum >= engineState->maxinsno)) {
1261 int old_maxinsno = engineState->maxinsno;
1262
1263 /* expand */
1264 while (instrNum >= engineState->maxinsno) {
1265 engineState->maxinsno += MAXINSNO;
1266 }
1267
1268 engineState->instrtxtp = (INSTRTXT **)csound->ReAlloc(
1269 csound, engineState->instrtxtp,
1270 (1 + engineState->maxinsno) * sizeof(INSTRTXT *));
1271
1272 /* Array expected to be nulled so.... */
1273 for (i = old_maxinsno + 1; i <= engineState->maxinsno; i++) {
1274 engineState->instrtxtp[i] = NULL;
1275 }
1276 }
1277
1278 if (UNLIKELY(engineState->instrtxtp[instrNum] != NULL)) {
1279 instrtxt->isNew = 1;
1280
1281 /* redefinition does not raise an error now, just a warning */
1282 /* unless we are not merging */
1283 if (!merge)
1284 synterr(csound, Str("instr %d redefined\n"), instrNum);
1285 if (UNLIKELY(instrNum && csound->oparms->odebug))
1286 csound->Warning(csound, Str("instr %" PRIi32 " redefined, "
1287 "replacing previous definition"),
1288 instrNum);
1289 /* inherit active & maxalloc flags */
1290 instrtxt->active = engineState->instrtxtp[instrNum]->active;
1291 instrtxt->maxalloc = engineState->instrtxtp[instrNum]->maxalloc;
1292
1293 /* here we should move the old instrument definition into a deadpool
1294 which will be checked for active instances and freed when there are no
1295 further ones
1296 */
1297 for (i = 0; i < engineState->maxinsno; i++) {
1298 /* check for duplicate numbers and do nothing */
1299 if (i != instrNum &&
1300 engineState->instrtxtp[i] == engineState->instrtxtp[instrNum]) {
1301 csound->Message(csound, "duplicate %d %d\n", i, instrNum);
1302 // VL 26.05.2018
1303 // so fill this with the new instrument pointer
1304 engineState->instrtxtp[i] = instrtxt;
1305 goto end;
1306 }
1307 }
1308 INSDS *active = engineState->instrtxtp[instrNum]->instance;
1309 while (active != NULL && instrNum != 0) {
1310 if (active->actflg) {
1311 add_to_deadpool(csound, engineState->instrtxtp[instrNum]);
1312 break;
1313 }
1314 active = active->nxtinstance;
1315 }
1316
1317 /* no active instances */
1318 /* instr0 is freed elsewhere */
1319 if (active == NULL && instrNum != 0) {
1320 if (UNLIKELY(csound->oparms->odebug))
1321 csound->Message(csound, Str("no active instances of instr %d\n"),
1322 instrNum);
1323 free_instrtxt(csound, engineState->instrtxtp[instrNum]);
1324 }
1325
1326 /* err++; continue; */
1327 }
1328 end:
1329
1330 instrtxt->instance = instrtxt->act_instance = instrtxt->lst_instance = NULL;
1331 engineState->instrtxtp[instrNum] = instrtxt;
1332 //csound->Message(csound, "instrument %d of %d: %p \n",
1333 // instrNum, engineState->maxinsno, instrtxt);
1334 }
1335
insert_opcodes(CSOUND * csound,OPCODINFO * opcodeInfo,ENGINE_STATE * engineState)1336 void insert_opcodes(CSOUND *csound, OPCODINFO *opcodeInfo,
1337 ENGINE_STATE *engineState) {
1338 if (opcodeInfo) {
1339 int num = engineState->maxinsno; /* store after any other instruments */
1340 OPCODINFO *inm = opcodeInfo;
1341 while (inm) {
1342 /* we may need to expand the instrument array */
1343 if (UNLIKELY(++num > engineState->maxopcno)) {
1344 int i;
1345 i = (engineState->maxopcno > 0 ? engineState->maxopcno
1346 : engineState->maxinsno);
1347 engineState->maxopcno = i + MAXINSNO;
1348 engineState->instrtxtp = (INSTRTXT **)csound->ReAlloc(
1349 csound, engineState->instrtxtp,
1350 (1 + engineState->maxopcno) * sizeof(INSTRTXT *));
1351 /* Array expected to be nulled so.... */
1352 while (++i <= engineState->maxopcno)
1353 engineState->instrtxtp[i] = NULL;
1354 }
1355 inm->instno = num;
1356 // csound->Message(csound, Str("UDO INSTR NUM: %d\n"), num);
1357 engineState->instrtxtp[num] = inm->ip;
1358 inm = inm->prv;
1359 }
1360 }
1361 }
1362
find_opcode_info(CSOUND * csound,char * opname,char * outargs,char * inargs)1363 OPCODINFO *find_opcode_info(CSOUND *csound, char *opname, char *outargs,
1364 char *inargs) {
1365 OPCODINFO *opinfo = csound->opcodeInfo;
1366 if (UNLIKELY(opinfo == NULL)) {
1367 csound->Message(csound, Str("!!! csound->opcodeInfo is NULL !!!\n"));
1368 return NULL;
1369 }
1370
1371 while (opinfo != NULL) {
1372 if (UNLIKELY(strcmp(opinfo->name, opname) == 0 &&
1373 strcmp(opinfo->intypes, inargs) == 0 &&
1374 strcmp(opinfo->outtypes, outargs) == 0)) {
1375 return opinfo;
1376 }
1377 opinfo = opinfo->prv; /* Move on: JPff suggestion */
1378 }
1379
1380 return NULL;
1381 }
1382
1383 /**
1384 Merge a new engineState into csound->engineState
1385 1) Add to stringPool, constantsPool and varPool (globals)
1386 2) Add to opinfo and UDOs
1387 3) Call insert_instrtxt() on csound->engineState for each new instrument
1388 4) Call insprep() and recalculateVarPoolMemory() for each new instrument
1389 5) patch up nxtinstxt order
1390 */
engineState_merge(CSOUND * csound,ENGINE_STATE * engineState)1391 int engineState_merge(CSOUND *csound, ENGINE_STATE *engineState) {
1392 int i, end = engineState->maxinsno;
1393 ENGINE_STATE *current_state = &csound->engineState;
1394 INSTRTXT *current, *old_instr0;
1395 int count = 0;
1396
1397 // cs_hash_table_merge(csound,
1398 // current_state->stringPool, engineState->stringPool);
1399
1400 cs_hash_table_merge(csound, current_state->constantsPool,
1401 engineState->constantsPool);
1402
1403 /* for (count = 0; count < engineState->constantsPool->count; count++) {
1404 if (UNLIKELY(csound->oparms->odebug))
1405 csound->Message(csound, Str(" merging constants %d) %f\n"),
1406 count, engineState->constantsPool->values[count].value);
1407 myflt_pool_find_or_add(csound, current_state->constantsPool,
1408 engineState->constantsPool->values[count].value);
1409 }*/
1410
1411 CS_VARIABLE *gVar = engineState->varPool->head;
1412 while (gVar != NULL) {
1413 CS_VARIABLE *var;
1414 if (UNLIKELY(csound->oparms->odebug))
1415 csound->Message(csound, Str(" merging %p %d) %s:%s\n"), gVar, count,
1416 gVar->varName, gVar->varType->varTypeName);
1417 var = csoundFindVariableWithName(csound, current_state->varPool,
1418 gVar->varName);
1419 if (var == NULL) {
1420 ARRAY_VAR_INIT varInit;
1421 varInit.dimensions = gVar->dimensions;
1422 varInit.type = gVar->subType;
1423 var = csoundCreateVariable(csound, csound->typePool, gVar->varType,
1424 gVar->varName, &varInit);
1425 csoundAddVariable(csound, current_state->varPool, var);
1426 /* memory has already been allocated, so we just point to it */
1427 /* when disposing of the engineState global vars, we do not
1428 delete the memBlock */
1429 var->memBlock = gVar->memBlock;
1430 if (UNLIKELY(csound->oparms->odebug))
1431 csound->Message(csound, Str(" adding %p %d) %s:%s\n"), var, count,
1432 gVar->varName, gVar->varType->varTypeName);
1433 gVar = gVar->next;
1434 } else {
1435 // if variable exists
1436 // free variable mem block
1437 // printf("free %p\n", gVar->memBlock);
1438 // the CS_VARIABLE itself will be freed on engine_free()
1439 csound->Free(csound, gVar->memBlock);
1440 csound->Free(csound, gVar->varName);
1441 gVar = gVar->next;
1442 }
1443 }
1444
1445 /* merge opcodinfo */
1446
1447 /* VL probably not the right place, since instr list
1448 might grow
1449 insert_opcodes(csound, csound->opcodeInfo, current_state);
1450 */
1451
1452 old_instr0 = current_state->instrtxtp[0];
1453 insert_instrtxt(csound, engineState->instrtxtp[0], 0, current_state, 1);
1454 for (i = 1; i < end; i++) {
1455 current = engineState->instrtxtp[i];
1456
1457 if (current != NULL) {
1458 // csound->Message(csound, "INSTR %d \n", i);
1459 if (current->insname == NULL) {
1460 if (csound->oparms->odebug)
1461 csound->Message(csound, Str("merging instr %d\n"), i);
1462 /* a first attempt at this merge is to make it use
1463 insert_instrtxt again */
1464 /* insert instrument in current engine */
1465 insert_instrtxt(csound, current, i, current_state, 1);
1466 } else {
1467 if (UNLIKELY(csound->oparms->odebug))
1468 csound->Message(csound, Str("merging named instr %s\n"),
1469 current->insname);
1470 /* allocate a named_instr string in the current engine */
1471 /* find the assigned number in the engineState and use it for
1472 the current engine */
1473 int32 nnum =
1474 named_instr_find_in_engine(csound, current->insname, engineState);
1475 named_instr_alloc(csound, current->insname, current, nnum, current_state,
1476 1);
1477 /* place it in the corresponding slot */
1478 current_state->instrtxtp[i] = current;
1479 }
1480 }
1481 }
1482 /* VL 30.6.2018 commented this out so all the assignment
1483 occurs earlier on before merge
1484 */
1485 // csound->Message(csound, "assign numbers; %p\n", current_state);
1486 //named_instr_assign_numbers(csound, current_state);
1487
1488 /* VL MOVED here after all instruments are merged so
1489 that we get the correct number */
1490 insert_opcodes(csound, csound->opcodeInfo, current_state);
1491 /* this needs to be called in a separate loop
1492 in case of multiple instr numbers, so insprep() is called only once */
1493 current = (&(engineState->instxtanchor)); //->nxtinstxt;
1494 while ((current = current->nxtinstxt) != NULL) {
1495 if (UNLIKELY(csound->oparms->odebug))
1496 csound->Message(csound, "insprep %p\n", current);
1497 insprep(csound, current, current_state); /* run insprep() to connect ARGS */
1498 recalculateVarPoolMemory(csound,
1499 current->varPool); /* recalculate var pool */
1500 }
1501 /* now we need to patch up instr order */
1502 end = current_state->maxinsno;
1503 end = end < current_state->maxopcno ? current_state->maxopcno : end;
1504 for (i = 0; i < end; i++) {
1505 int j;
1506 current = current_state->instrtxtp[i];
1507 if (current != NULL) {
1508 if (UNLIKELY(csound->oparms->odebug))
1509 csound->Message(csound, "instr %d:%p\n", i, current);
1510 current->nxtinstxt = NULL;
1511 j = i;
1512 while (++j < end - 1) {
1513 if (current_state->instrtxtp[j] != NULL) {
1514 current->nxtinstxt = current_state->instrtxtp[j];
1515 break;
1516 }
1517 }
1518 }
1519 }
1520 (&(current_state->instxtanchor))->nxtinstxt = csound->instr0;
1521 /* now free old instr 0 */
1522 free_instrtxt(csound, old_instr0);
1523 return 0;
1524 }
1525
engineState_free(CSOUND * csound,ENGINE_STATE * engineState)1526 int engineState_free(CSOUND *csound, ENGINE_STATE *engineState) {
1527
1528 // csound->Free(csound, engineState->instrumentNames);
1529 cs_hash_table_free(csound, engineState->constantsPool);
1530 // cs_hash_table_free(csound, engineState->stringPool);
1531 csoundFreeVarPool(csound, engineState->varPool);
1532 csound->Free(csound, engineState->instrtxtp);
1533 csound->Free(csound, engineState);
1534 return 0;
1535 }
1536
free_typetable(CSOUND * csound,TYPE_TABLE * typeTable)1537 void free_typetable(CSOUND *csound, TYPE_TABLE *typeTable) {
1538 cs_cons_free_complete(csound, typeTable->labelList);
1539 csound->Free(csound, typeTable);
1540 }
1541
node2string(int type)1542 static char *node2string(int type) {
1543 /* Add new nodes here as necessary -- JPff */
1544 switch (type) {
1545 /* case LABEL_TOKEN: */
1546 /* return "label"; */
1547 default:
1548 return "??";
1549 }
1550 }
1551
1552 /** Merge and Dispose of engine state and type table,
1553 and run global i-time code
1554 */
merge_state(CSOUND * csound,ENGINE_STATE * engineState,TYPE_TABLE * typetable,OPDS * ids)1555 void merge_state(CSOUND *csound, ENGINE_STATE *engineState,
1556 TYPE_TABLE *typetable, OPDS *ids) {
1557 if (csound->init_pass_threadlock)
1558 csoundLockMutex(csound->init_pass_threadlock);
1559 engineState_merge(csound, engineState);
1560 engineState_free(csound, engineState);
1561 free_typetable(csound, typetable);
1562 /* run global i-time code */
1563 init0(csound);
1564 csound->ids = ids;
1565 if (csound->init_pass_threadlock)
1566 csoundUnlockMutex(csound->init_pass_threadlock);
1567 }
1568
1569 /**
1570 * Compile the given TREE node into structs
1571
1572 In the the first compilation run, it:
1573 1) Uses the empty csound->engineState
1574 2) Creates instrument 0
1575 3) Creates other instruments and UDOs
1576 4) Runs insprep() and recalculateVarpool() for each instrument
1577
1578 In any subsequent compilation run, it:
1579 1) Creates a new engineState
1580 2) instrument 0 is treated as a global i-time instrument, header constants
1581 are ignored.
1582 3) Creates other instruments
1583 4) Calls engineState_merge() and engineState_free()
1584
1585 async determines asynchronous operation of the
1586 merge stage.
1587
1588 VL 20-12-12
1589
1590 * ASSUMES: TREE has been validated prior to compilation
1591 *
1592 *
1593 */
csoundCompileTreeInternal(CSOUND * csound,TREE * root,int async)1594 int csoundCompileTreeInternal(CSOUND *csound, TREE *root, int async) {
1595 INSTRTXT *instrtxt = NULL;
1596 INSTRTXT *ip = NULL;
1597 INSTRTXT *prvinstxt;
1598 OPTXT *bp;
1599 char *opname;
1600 TREE *current = root;
1601 ENGINE_STATE *engineState;
1602 CS_VARIABLE *var;
1603 TYPE_TABLE *typeTable = (TYPE_TABLE *)current->markup;
1604
1605 current = current->next;
1606 if (csound->instr0 == NULL) {
1607 engineState = &csound->engineState;
1608 engineState->varPool = typeTable->globalPool;
1609
1610 csound->instr0 = create_instrument0(csound, current, engineState,
1611 typeTable->instr0LocalPool);
1612 cs_hash_table_put_key(csound, engineState->stringPool, "\"\"");
1613 prvinstxt = &(engineState->instxtanchor);
1614 engineState->instrtxtp = (INSTRTXT **)csound->Calloc(
1615 csound, (1 + engineState->maxinsno) * sizeof(INSTRTXT *));
1616 prvinstxt = prvinstxt->nxtinstxt = csound->instr0;
1617 insert_instrtxt(csound, csound->instr0, 0, engineState, 0);
1618 } else {
1619 engineState = (ENGINE_STATE *)csound->Calloc(csound, sizeof(ENGINE_STATE));
1620 engineState->stringPool = csound->engineState.stringPool;
1621 // cs_hash_table_create(csound);
1622 engineState->constantsPool = cs_hash_table_create(csound);
1623 engineState->varPool = typeTable->globalPool;
1624 prvinstxt = &(engineState->instxtanchor);
1625 engineState->instrtxtp = (INSTRTXT **)csound->Calloc(
1626 csound, (1 + engineState->maxinsno) * sizeof(INSTRTXT *));
1627 /* VL: allowing global code to be evaluated in
1628 subsequent compilations */
1629 csound->instr0 = create_global_instrument(csound, current, engineState,
1630 typeTable->instr0LocalPool);
1631
1632 insert_instrtxt(csound, csound->instr0, 0, engineState, 1);
1633
1634 prvinstxt = prvinstxt->nxtinstxt = csound->instr0;
1635 // engineState->maxinsno = 1;
1636 }
1637
1638 // allocate memory for global vars
1639 // if this variable already exists,
1640 // memory will be freed on merge.
1641 var = typeTable->globalPool->head;
1642 while (var != NULL) {
1643 size_t memSize = CS_VAR_TYPE_OFFSET + var->memBlockSize;
1644 CS_VAR_MEM *varMem = (CS_VAR_MEM *)csound->Calloc(csound, memSize);
1645 // printf("alloc %p -- %s\n", varMem, var->varName);
1646 varMem->varType = var->varType;
1647 var->memBlock = varMem;
1648 if (var->initializeVariableMemory != NULL) {
1649 var->initializeVariableMemory((void *)csound, var, &varMem->value);
1650 } else
1651 memset(&varMem->value, 0, var->memBlockSize);
1652 var = var->next;
1653 }
1654
1655 while (current != NULL) {
1656
1657 switch (current->type) {
1658 case '=':
1659 /* csound->Message(csound, "Assignment found\n"); */
1660 break;
1661 case INSTR_TOKEN:
1662 // print_tree(csound, "Instrument found\n", current);
1663 instrtxt = create_instrument(csound, current, engineState);
1664
1665 prvinstxt = prvinstxt->nxtinstxt = instrtxt;
1666
1667 /* Handle Inserting into CSOUND here by checking ids (name or
1668 * numbered) and using new insert_instrtxt?
1669 */
1670 /* Temporarily using the following code */
1671 if (current->left->type == INTEGER_TOKEN) { /* numbered instrument, eg.:
1672 instr 1
1673 */
1674 int32 instrNum = (int32)current->left->value->value;
1675 insert_instrtxt(csound, instrtxt, instrNum, engineState, 0);
1676
1677 } else if (current->left->type == T_IDENT) { /* named instrument, eg.:
1678 instr Hello
1679 */
1680 int32 insno_priority = -1L;
1681 char *c;
1682 c = current->left->value->lexeme;
1683
1684 if (UNLIKELY(current->left->rate == (int)'+')) {
1685 insno_priority--;
1686 }
1687 if (UNLIKELY(!check_instr_name(c))) {
1688 synterr(csound, Str("invalid name for instrument"));
1689 }
1690
1691 named_instr_alloc(csound, c, instrtxt, insno_priority, engineState, 0);
1692 if(engineState != &csound->engineState)
1693 named_instr_assign_numbers(csound, engineState);
1694 /* VL 10.10.14: check for redefinition */
1695 // if (UNLIKELY(!named_instr_alloc(csound, c,
1696 // instrtxt, insno_priority,
1697 // engineState, 0))) {
1698 // synterr(csound, Str("instr %s redefined\n"), c);
1699 //}
1700
1701 instrtxt->insname = csound->Malloc(csound, strlen(c) + 1);
1702 strcpy(instrtxt->insname, c);
1703 } else if (current->left->type == T_INSTLIST) {
1704 /* list of instr names, eg:
1705 instr Hello, 1, 2
1706 */
1707
1708 TREE *p = current->left;
1709 while (p) {
1710 if (PARSER_DEBUG)
1711 print_tree(csound, "Top of loop\n", p);
1712 if (p->left) {
1713
1714 if (p->left->type == INTEGER_TOKEN) {
1715 //csound->Message(csound, "instrument %d \n",
1716 // (int) p->left->value->value);
1717 insert_instrtxt(csound, instrtxt, p->left->value->value,
1718 engineState, 0);
1719 } else if (p->left->type == T_IDENT) {
1720 int32 insno_priority = -1L;
1721 char *c;
1722 c = p->left->value->lexeme;
1723 if (UNLIKELY(p->left->rate == (int)'+')) {
1724 insno_priority--;
1725 }
1726 if (UNLIKELY(!check_instr_name(c))) {
1727 synterr(csound, Str("invalid name for instrument"));
1728 }
1729 // VL 25.05.2018
1730 // this should only be run here in the
1731 // first compilation
1732 if(engineState == &csound->engineState)
1733 named_instr_alloc(csound, c, instrtxt, insno_priority,
1734 engineState, 0);
1735 /* if (UNLIKELY(!named_instr_alloc(csound, c, */
1736 /* instrtxt, insno_priority, */
1737 /* engineState,0))) { */
1738 /* synterr(csound, Str("instr %s redefined"), c); */
1739 /* } */
1740
1741 instrtxt->insname = csound->Malloc(csound, strlen(c) + 1);
1742 strcpy(instrtxt->insname, c);
1743 }
1744 } else {
1745 if (p->type == INTEGER_TOKEN) {
1746
1747 insert_instrtxt(csound, instrtxt, p->value->value, engineState,
1748 0);
1749 } else if (p->type == T_IDENT) {
1750
1751 int32 insno_priority = -1L;
1752 char *c;
1753 c = p->value->lexeme;
1754
1755 if (UNLIKELY(p->rate == (int)'+')) {
1756 insno_priority--;
1757 }
1758 if (UNLIKELY(!check_instr_name(c))) {
1759 synterr(csound, Str("invalid name for instrument"));
1760 }
1761 // VL 25.05.2018
1762 // this should only be run here in the
1763 // first compilation
1764 // if(engineState == &csound->engineState)
1765 named_instr_alloc(csound, c, instrtxt, insno_priority,
1766 engineState, 0);
1767
1768 /* if (UNLIKELY(!named_instr_alloc(csound, c, */
1769 /* instrtxt, insno_priority, */
1770 /* engineState,0))) { */
1771 /* synterr(csound, Str("instr %s redefined"), c); */
1772 /* } */
1773 instrtxt->insname = csound->Malloc(csound, strlen(c) + 1);
1774 strcpy(instrtxt->insname, c);
1775 }
1776 break;
1777 }
1778 p = p->right;
1779 }
1780 }
1781 break;
1782 case UDO_TOKEN:
1783 /* csound->Message(csound, "UDO found\n"); */
1784 instrtxt = create_instrument(csound, current, engineState);
1785 prvinstxt = prvinstxt->nxtinstxt = instrtxt;
1786 opname = current->left->value->lexeme;
1787 OPCODINFO *opinfo =
1788 find_opcode_info(csound, opname, current->left->left->value->lexeme,
1789 current->left->right->value->lexeme);
1790
1791 if (UNLIKELY(opinfo == NULL)) {
1792 csound->Message(csound,
1793 Str("ERROR: Could not find OPCODINFO for opname: %s\n"),
1794 opname);
1795 } else {
1796 opinfo->ip = instrtxt;
1797 instrtxt->insname = cs_strdup(csound, opname);
1798 instrtxt->opcode_info = opinfo;
1799 }
1800
1801 /* Handle Inserting into CSOUND here by checking id's (name or
1802 * numbered) and using new insert_instrtxt?
1803 */
1804
1805 break;
1806 case T_OPCODE:
1807 case T_OPCODE0:
1808 case LABEL:
1809 case LABEL_TOKEN:
1810 break;
1811
1812 default:
1813 csound->Message(csound,
1814 Str("Unknown TREE node of type %d (%s) found in root.\n"),
1815 current->type, node2string(current->type));
1816 if (PARSER_DEBUG)
1817 print_tree(csound, NULL, current);
1818 }
1819 current = current->next;
1820 }
1821
1822 if (UNLIKELY(csound->synterrcnt)) {
1823 print_opcodedir_warning(csound);
1824 csound->Warning(csound, Str("%d syntax errors in orchestra. "
1825 "compilation invalid\n"),
1826 csound->synterrcnt);
1827 free_typetable(csound, typeTable);
1828 return CSOUND_ERROR;
1829 }
1830
1831 /* now add the instruments with names, assigning them fake instr numbers */
1832 named_instr_assign_numbers(csound, engineState);
1833 if (engineState != &csound->engineState) {
1834 OPDS *ids = csound->ids;
1835 /* any compilation other than the first one */
1836 /* merge ENGINE_STATE */
1837 /* lock to ensure thread-safety */
1838 if (!async) {
1839 if (!csound->oparms->realtime)
1840 csoundLockMutex(csound->API_lock);
1841 merge_state(csound, engineState, typeTable, ids);
1842 if (!csound->oparms->realtime)
1843 csoundUnlockMutex(csound->API_lock);
1844 } else {
1845 if (csound->oparms->realtime)
1846 csoundSpinLock(&csound->alloc_spinlock);
1847 mergeState_enqueue(csound, engineState, typeTable, ids);
1848 if (csound->oparms->realtime)
1849 csoundSpinUnLock(&csound->alloc_spinlock);
1850 }
1851 } else {
1852 /* first compilation */
1853 insert_opcodes(csound, csound->opcodeInfo, engineState);
1854 ip = engineState->instxtanchor.nxtinstxt;
1855 bp = (OPTXT *)ip;
1856 while (bp != (OPTXT *)NULL && (bp = bp->nxtop) != NULL) {
1857 /* chk instr 0 for illegal perfs */
1858 int thread;
1859 OENTRY *oentry = bp->t.oentry;
1860 if (strcmp(oentry->opname, "endin") == 0)
1861 break;
1862 if (strcmp(oentry->opname, "$label") == 0)
1863 continue;
1864 if (PARSER_DEBUG)
1865 csound->DebugMsg(csound, "Instr 0 check on opcode=%s\n", bp->t.opcod);
1866 if (UNLIKELY((thread = oentry->thread) & 06 ||
1867 (!thread && bp->t.pftype != 'b'))) {
1868 csound->DebugMsg(csound, "***opcode=%s thread=%d pftype=%c\n",
1869 bp->t.opcod, thread, bp->t.pftype);
1870 /* synterr(csound,
1871 Str("perf-pass statements illegal in header blk (%s)\n"),
1872 oentry->opname);*/
1873 csound->Warning(csound,
1874 Str("%s: perf-time code in global space, ignored"),
1875 oentry->opname);
1876 }
1877 }
1878
1879 ip = &(engineState->instxtanchor);
1880 while ((ip = ip->nxtinstxt) != NULL) { /* add all other entries */
1881 insprep(csound, ip, engineState); /* as combined offsets */
1882 recalculateVarPoolMemory(csound, ip->varPool);
1883 }
1884
1885 CS_VARIABLE *var;
1886 var = csoundFindVariableWithName(csound, engineState->varPool, "sr");
1887 var->memBlock->value = csound->esr;
1888 var = csoundFindVariableWithName(csound, engineState->varPool, "kr");
1889 var->memBlock->value = csound->ekr;
1890 var = csoundFindVariableWithName(csound, engineState->varPool, "ksmps");
1891 var->memBlock->value = csound->ksmps;
1892 var = csoundFindVariableWithName(csound, engineState->varPool, "nchnls");
1893 var->memBlock->value = csound->nchnls;
1894 if (csound->inchnls < 0)
1895 csound->inchnls = csound->nchnls;
1896 var = csoundFindVariableWithName(csound, engineState->varPool, "nchnls_i");
1897 var->memBlock->value = csound->inchnls;
1898 var = csoundFindVariableWithName(csound, engineState->varPool, "0dbfs");
1899 var->memBlock->value = csound->e0dbfs;
1900 var = csoundFindVariableWithName(csound, engineState->varPool, "A4");
1901 var->memBlock->value = csound->A4;
1902 }
1903
1904 return CSOUND_SUCCESS;
1905 }
1906
1907 #ifdef EMSCRIPTEN
sanitize(CSOUND * csound)1908 void sanitize(CSOUND *csound) {}
1909 #else
1910 extern void sanitize(CSOUND *csound);
1911 #endif
1912
1913 /**
1914 Parse and compile an orchestra given on an string (OPTIONAL)
1915 if str is NULL the string is taken from the internal corfile
1916 containing the initial orchestra file passed to Csound.
1917 Also evaluates any global space code.
1918 async determines asynchronous operation of the
1919 merge stage.
1920 */
csoundCompileOrcInternal(CSOUND * csound,const char * str,int async)1921 int csoundCompileOrcInternal(CSOUND *csound, const char *str, int async) {
1922 TREE *root;
1923 int retVal = 1;
1924 volatile jmp_buf tmpExitJmp;
1925
1926 memcpy((void *)&tmpExitJmp, (void *)&csound->exitjmp, sizeof(jmp_buf));
1927 if ((retVal = setjmp(csound->exitjmp))) {
1928 memcpy((void *)&csound->exitjmp, (void *)&tmpExitJmp, sizeof(jmp_buf));
1929 return retVal;
1930 }
1931 // retVal = 1;
1932 root = csoundParseOrc(csound, str);
1933 if (LIKELY(root != NULL)) {
1934 retVal = csoundCompileTreeInternal(csound, root, async);
1935 // Sanitise semantic sets here
1936 sanitize(csound);
1937 csoundDeleteTree(csound, root);
1938 } else {
1939 // csoundDeleteTree(csound, root);
1940 memcpy((void *)&csound->exitjmp, (void *)&tmpExitJmp, sizeof(jmp_buf));
1941 return CSOUND_ERROR;
1942 }
1943
1944 if (UNLIKELY(csound->oparms->odebug))
1945 debugPrintCsound(csound);
1946 memcpy((void *)&csound->exitjmp, (void *)&tmpExitJmp, sizeof(jmp_buf));
1947 return retVal;
1948 }
1949
1950 /* prep an instr template for efficient allocs */
1951 /* repl arg refs by offset ndx to lcl/gbl space */
insprep(CSOUND * csound,INSTRTXT * tp,ENGINE_STATE * engineState)1952 static void insprep(CSOUND *csound, INSTRTXT *tp, ENGINE_STATE *engineState) {
1953 OPARMS *O = csound->oparms;
1954 OPTXT *optxt;
1955 OENTRY *ep;
1956 char **argp;
1957
1958 int n, inreqd;
1959 char **argStringParts;
1960 ARGLST *outlist, *inlist;
1961
1962 OENTRY *pset = find_opcode(csound, "pset");
1963
1964 optxt = (OPTXT *)tp;
1965 while ((optxt = optxt->nxtop) != NULL) { /* for each op in instr */
1966 TEXT *ttp = &optxt->t;
1967 ep = ttp->oentry;
1968
1969 if (strcmp(ep->opname, "endin") == 0 /* (until ENDIN) */
1970 || strcmp(ep->opname, "endop") == 0)
1971 break;
1972 if (strcmp(ep->opname, "$label") == 0) {
1973 continue;
1974 }
1975
1976 if (UNLIKELY(O->odebug))
1977 csound->Message(csound, "%s args:", ep->opname);
1978 if ((outlist = ttp->outlist) == NULL || !outlist->count)
1979 ttp->outArgs = NULL;
1980 else {
1981 n = outlist->count;
1982 argp = outlist->arg; /* get outarg indices */
1983 while (n--) {
1984 ARG *arg = createArg(csound, tp, *argp++, engineState);
1985 if (ttp->outArgs == NULL) {
1986 ttp->outArgs = arg;
1987 } else {
1988 ARG *current = ttp->outArgs;
1989 while (current->next != NULL) {
1990 current = current->next;
1991 }
1992 current->next = arg;
1993 arg->next = NULL;
1994 }
1995 }
1996 }
1997 if ((inlist = ttp->inlist) == NULL || !inlist->count)
1998 ttp->inArgs = NULL;
1999 else {
2000 inreqd = argsRequired(ep->intypes);
2001 argStringParts = splitArgs(csound, ep->intypes);
2002 argp = inlist->arg; /* get inarg indices */
2003 for (n = 0; n < inlist->count; n++, argp++) {
2004 ARG *arg = NULL;
2005 if (n < inreqd && *argStringParts[n] == 'l') {
2006 arg = csound->Calloc(csound, sizeof(ARG));
2007 arg->type = ARG_LABEL;
2008 arg->argPtr = csound->Malloc(csound, strlen(*argp) + 1);
2009 strcpy(arg->argPtr, *argp);
2010 if (UNLIKELY(O->odebug))
2011 csound->Message(csound, "\t%s:", *argp); /* if arg is label, */
2012 } else {
2013 char *s = *argp;
2014 arg = createArg(csound, tp, s, engineState);
2015 }
2016
2017 if (ttp->inArgs == NULL) {
2018 ttp->inArgs = arg;
2019 // printf("yinarg %p -- opcode %s\n", arg, ttp->opcod);
2020 } else {
2021 ARG *current = ttp->inArgs;
2022 // printf("xinarg %p %p -- opcode %s\n", current, arg, ttp->opcod);
2023 while (current->next != NULL) {
2024 // printf("inarg %p %p -- opcode %s\n", current, arg, ttp->opcod);
2025 current = current->next;
2026 }
2027 current->next = arg;
2028
2029 arg->next = NULL;
2030 }
2031 }
2032
2033 if (ttp->oentry == pset) {
2034 MYFLT *fp1;
2035 int n;
2036 ARG *inArgs = ttp->inArgs;
2037 // CS_VARIABLE* var;
2038
2039 if (tp->insname)
2040 csound->Message(csound, "PSET: isname=\"%s\", pmax=%d\n", tp->insname,
2041 tp->pmax);
2042 else
2043 csound->Message(csound, "PSET: isno=??, pmax=%d\n", tp->pmax);
2044 if (UNLIKELY((n = ttp->inArgCount) != tp->pmax)) {
2045 // csound->Warning(csound, Str("i%d pset args != pmax"), (int) insno);
2046 csound->Warning(csound, Str("i[fixme] pset args != pmax"));
2047 if (n < tp->pmax)
2048 n = tp->pmax; /* cf pset, pmax */
2049 }
2050 tp->psetdata = (MYFLT *)csound->Calloc(csound, n * sizeof(MYFLT));
2051
2052 for (n = 0, fp1 = tp->psetdata; n < (int)ttp->inArgCount;
2053 n++, inArgs = inArgs->next) {
2054 switch (inArgs->type) {
2055 case ARG_CONSTANT:
2056
2057 *fp1++ = ((CS_VAR_MEM *)inArgs->argPtr)->value;
2058 break;
2059
2060 // case ARG_LOCAL:
2061 // *fp1++ = 44.0;
2062 // break;
2063 //
2064 // case ARG_GLOBAL:
2065 // var = (CS_VARIABLE*)inArgs->argPtr;
2066 // *fp1++ = *((MYFLT*)var->memBlock);
2067 // break;
2068
2069 /* FIXME - to note, because this is done during
2070 compile time, pset does not work with local and
2071 global variables as they have not been initialized
2072 yet. Csound5 also did not work with local/global
2073 variables. In the future, use the test in
2074 tests/commandline/contrib/test_pset.csd for testing.
2075 */
2076 default:
2077 *fp1++ = 0.0;
2078 break;
2079 }
2080
2081 // csound->Message(csound, "..%f..", *(fp1-1));
2082 }
2083
2084 csound->Message(csound, "\n");
2085 }
2086 // printf("delete %p\n", argStringParts);
2087 for (n = 0; argStringParts[n] != NULL; n++) {
2088 // printf("delete %p\n", argStringParts[n]);
2089 csound->Free(csound, argStringParts[n]);
2090 }
2091 csound->Free(csound, argStringParts);
2092 }
2093
2094 if (UNLIKELY(O->odebug))
2095 csound->Message(csound, "\n");
2096 }
2097 }
2098
2099 /* build pool of floating const values */
2100 /* build lcl/gbl list of ds names, offsets */
2101 /* (no need to save the returned values) */
lgbuild(CSOUND * csound,INSTRTXT * ip,char * s,int inarg,ENGINE_STATE * engineState)2102 static void lgbuild(CSOUND *csound, INSTRTXT *ip, char *s, int inarg,
2103 ENGINE_STATE *engineState) {
2104 IGN(ip);
2105 IGN(inarg);
2106 char c;
2107 char *temp;
2108
2109 c = *s;
2110 /* must trap 0dbfs as name starts with a digit! */
2111 if ((c >= '1' && c <= '9') || c == '.' || c == '-' || c == '+' ||
2112 (c == '0' && strcmp(s, "0dbfs") != 0)) {
2113 if (cs_hash_table_get(csound, csound->engineState.constantsPool, s) ==
2114 NULL) {
2115 find_or_add_constant(csound, engineState->constantsPool, s,
2116 cs_strtod(s, NULL));
2117 }
2118 } else if (c == '"') {
2119 temp = csound->Calloc(csound, strlen(s) + 1);
2120 // csound->Message(csound, "%c\n", s[1]);
2121 unquote_string(temp, s);
2122 cs_hash_table_put_key(csound, engineState->stringPool, temp);
2123 csound->Free(csound, temp);
2124 }
2125 }
2126
2127 /* get storage ndx of const, pnum, lcl or gbl */
2128 /* argument const/gbl indexes are positiv+1, */
2129 /* pnum/lcl negativ-1 called only after */
2130 /* poolcount & lclpmax are finalised */
createArg(CSOUND * csound,INSTRTXT * ip,char * s,ENGINE_STATE * engineState)2131 static ARG *createArg(CSOUND *csound, INSTRTXT *ip, char *s,
2132 ENGINE_STATE *engineState) {
2133 char c;
2134 char *temp;
2135 int n;
2136
2137 c = *s;
2138
2139 ARG *arg = csound->Calloc(csound, sizeof(ARG));
2140
2141 if (UNLIKELY(csound->oparms->odebug))
2142 csound->Message(csound, "\t%s", s); /* if arg is label, */
2143
2144 /* must trap 0dbfs as name starts with a digit! */
2145 if ((c >= '1' && c <= '9') || c == '.' || c == '-' || c == '+' ||
2146 (c == '0' && strcmp(s, "0dbfs") != 0)) {
2147 arg->type = ARG_CONSTANT;
2148 // printf("create constant %p: %c\n", arg, c);
2149
2150 if ((arg->argPtr = cs_hash_table_get(
2151 csound, csound->engineState.constantsPool, s)) != NULL) {
2152 arg->argPtr = find_or_add_constant(csound, engineState->constantsPool, s,
2153 cs_strtod(s, NULL));
2154 }
2155 } else if (c == '"') {
2156 size_t memSize = CS_VAR_TYPE_OFFSET + sizeof(STRINGDAT);
2157 CS_VAR_MEM *varMem = csound->Calloc(csound, memSize);
2158 STRINGDAT *str = (STRINGDAT *)&varMem->value;
2159 // printf("create string %p: %s\n", arg, str->data);
2160 varMem->varType = (CS_TYPE *)&CS_VAR_TYPE_S;
2161 arg->type = ARG_STRING;
2162 temp = csound->Calloc(csound, strlen(s) + 1);
2163 unquote_string(temp, s);
2164 str->data =
2165 cs_hash_table_get_key(csound, csound->engineState.stringPool, temp);
2166 str->size = strlen(temp) + 1;
2167 csound->Free(csound, temp);
2168 arg->argPtr = str;
2169 if (str->data == NULL) {
2170 str->data = cs_hash_table_put_key(csound, engineState->stringPool, temp);
2171 }
2172 } else if ((n = pnum(s)) >= 0) {
2173 arg->type = ARG_PFIELD;
2174 arg->index = n;
2175 }
2176 /* trap local ksmps and kr */
2177 else if ((strcmp(s, "ksmps") == 0 &&
2178 csoundFindVariableWithName(csound, ip->varPool, s)) ||
2179 (strcmp(s, "kr") == 0 &&
2180 csoundFindVariableWithName(csound, ip->varPool, s))) {
2181 arg->type = ARG_LOCAL;
2182 arg->argPtr = csoundFindVariableWithName(csound, ip->varPool, s);
2183 } else if (c == 'g' || (c == '#' && *(s + 1) == 'g') ||
2184 csoundFindVariableWithName(csound, csound->engineState.varPool,
2185 s) != NULL) {
2186 // FIXME - figure out why string pool searched with gexist
2187 //|| string_pool_indexof(csound->engineState.stringPool, s) > 0) {
2188 arg->type = ARG_GLOBAL;
2189 arg->argPtr = csoundFindVariableWithName(csound, engineState->varPool, s);
2190 // printf("create global %p: %s\n", arg->argPtr, s);
2191 } else {
2192 arg->type = ARG_LOCAL;
2193 arg->argPtr = csoundFindVariableWithName(csound, ip->varPool, s);
2194 // printf("create local %p: %s\n", arg, s);
2195 if (arg->argPtr == NULL) {
2196 csound->Message(csound, Str("Missing local arg: %s\n"), s);
2197 }
2198 }
2199 /* csound->Message(csound, " [%s -> %d (%x)]\n", s, indx, indx); */
2200
2201 return arg;
2202 }
2203
argtyp2(char * s)2204 char argtyp2(char *s) { /* find arg type: d, w, a, k, i, c, p, r, S, B, b, t */
2205 char c = *s; /* also set lgprevdef if !c && !p && !S */
2206
2207 /* trap this before parsing for a number! */
2208 /* two situations: defined at header level: 0dbfs = 1.0
2209 * and returned as a value: idb = 0dbfs
2210 */
2211
2212 if ((c >= '1' && c <= '9') || c == '.' || c == '-' || c == '+' ||
2213 (c == '0' && strcmp(s, "0dbfs") != 0))
2214 return ('c'); /* const */
2215 if (pnum(s) >= 0)
2216 return ('p'); /* pnum */
2217 if (c == '"')
2218 return ('S'); /* quoted String */
2219 if (strcmp(s, "sr") == 0 || strcmp(s, "kr") == 0 || strcmp(s, "0dbfs") == 0 ||
2220 strcmp(s, "nchnls_i") == 0 || strcmp(s, "ksmps") == 0 ||
2221 strcmp(s, "nchnls") == 0)
2222 return ('r'); /* rsvd */
2223 if (c == 'w') /* N.B. w NOT YET #TYPE OR GLOBAL */
2224 return (c);
2225 if (c == '#')
2226 c = *(++s);
2227 if (c == 'g')
2228 c = *(++s);
2229 if (c == '[') {
2230 while (c == '[') {
2231 c = *(++s);
2232 }
2233 }
2234 if (c == 't') { /* Support legacy t-vars by mapping to k subtypes */
2235 return 'k';
2236 }
2237 if (strchr("akiBbfSt", c) != NULL)
2238 return (c);
2239 else
2240 return ('?');
2241 }
2242
2243 /* For diagnostics map file name or macro name to an index */
file_to_int(CSOUND * csound,const char * name)2244 uint8_t file_to_int(CSOUND *csound, const char *name) {
2245 // extern char *strdup(const char *);
2246 uint8_t n = 0;
2247 char **filedir = csound->filedir;
2248 while (n < 255 && filedir[n] && n < 255) { /* Do we have it already? */
2249 if (strcmp(filedir[n], name) == 0)
2250 return n; /* yes */
2251 n++; /* look again */
2252 }
2253 // Not there so add
2254 // ensure long enough?
2255 if (UNLIKELY(n == 255)) {
2256 filedir[n] = cs_strdup(csound, Str("**unrecorded**"));
2257 } else {
2258 filedir[n] = cs_strdup(csound, (char *)name);
2259 filedir[n + 1] = NULL;
2260 }
2261 return n;
2262 }
2263
debugPrintCsound(CSOUND * csound)2264 void debugPrintCsound(CSOUND *csound) {
2265 INSTRTXT *current;
2266 CONS_CELL *val = cs_hash_table_keys(csound, csound->engineState.stringPool);
2267 CONS_CELL *const_val =
2268 cs_hash_table_values(csound, csound->engineState.constantsPool);
2269 int count = 0;
2270 csound->Message(csound, "Compile State:\n");
2271 csound->Message(csound, "String Pool:\n");
2272
2273 while (val != NULL) {
2274 csound->Message(csound, " %d) %s\n", count++, (char *)val->value);
2275 val = val->next;
2276 }
2277
2278 csound->Message(csound, "Constants Pool:\n");
2279 while (const_val != NULL) {
2280 CS_VAR_MEM *mem = (CS_VAR_MEM *)const_val->value;
2281 csound->Message(csound, " %d) %f\n", count++, mem->value);
2282 const_val = const_val->next;
2283 }
2284
2285 csound->Message(csound, "Global Variables:\n");
2286 CS_VARIABLE *gVar = csound->engineState.varPool->head;
2287 count = 0;
2288 while (gVar != NULL) {
2289 csound->Message(csound, " %d) %s:%s\n", count++, gVar->varName,
2290 gVar->varType->varTypeName);
2291 gVar = gVar->next;
2292 }
2293
2294 /* bad practice to declare variables in middle of block */
2295 current = &(csound->engineState.instxtanchor);
2296 current = current->nxtinstxt;
2297 count = 0;
2298 while (current != NULL) {
2299 csound->Message(csound, "Instrument %d %p %p\n", count, current,
2300 current->nxtinstxt);
2301 csound->Message(csound, "Variables\n");
2302
2303 if (current->varPool != NULL) {
2304 CS_VARIABLE *var = current->varPool->head;
2305 int index = 0;
2306 while (var != NULL) {
2307 if (var->varType == &CS_VAR_TYPE_ARRAY) {
2308 csound->Message(csound, " %d) %s:[%s]\n", index++, var->varName,
2309 var->subType->varTypeName);
2310 } else {
2311 csound->Message(csound, " %d) %s:%s\n", index++, var->varName,
2312 var->varType->varTypeName);
2313 }
2314
2315 var = var->next;
2316 }
2317 }
2318 count++;
2319 current = current->nxtinstxt;
2320 }
2321 }
2322
2323 #include "interlocks.h"
query_deprecated_opcode(CSOUND * csound,ORCTOKEN * o)2324 void query_deprecated_opcode(CSOUND *csound, ORCTOKEN *o) {
2325 char *name = o->lexeme;
2326 OENTRY *ep = find_opcode(csound, name);
2327 if (UNLIKELY((ep->flags &_QQ) && !(csound->oparms_.msglevel&NOQQ)))
2328 csound->Warning(csound, Str("Opcode \"%s\" is deprecated\n"), name);
2329 }
2330
query_reversewrite_opcode(CSOUND * csound,ORCTOKEN * o)2331 int query_reversewrite_opcode(CSOUND *csound, ORCTOKEN *o) {
2332 char *name = o->lexeme;
2333 OENTRY *ep = find_opcode(csound, name);
2334 return (ep->flags & WI);
2335 }
2336