1 /*
2 ugens2.c:
3
4 Copyright (C) 1991 Barry Vercoe, John ffitch, Robin Whittle
5
6 This file is part of Csound.
7
8 The Csound Library is free software; you can redistribute it
9 and/or modify it under the terms of the GNU Lesser General Public
10 License as published by the Free Software Foundation; either
11 version 2.1 of the License, or (at your option) any later version.
12
13 Csound is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU Lesser General Public License for more details.
17
18 You should have received a copy of the GNU Lesser General Public
19 License along with Csound; if not, write to the Free Software
20 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
21 02110-1301 USA
22 */
23
24 #include "csoundCore.h" /* UGENS2.C */
25 #include "ugens2.h"
26 #include <math.h>
27
28 /* Macro form of Istvan's speedup ; constant should be 3fefffffffffffff */
29 /* #define FLOOR(x) (x >= FL(0.0) ? (int64_t)x */
30 /* : (int64_t)((double)x - 0.999999999999999))
31 */
32 /* 1.0-1e-8 is safe for a maximum table length of 16777216 */
33 /* 1.0-1e-15 could incorrectly round down large negative integers, */
34 /* because doubles do not have sufficient resolution for numbers like */
35 /* -1000.999999999999999 (FLOOR(-1000) might possibly be -1001 which is wrong)*/
36 /* it should be noted, though, that the above incorrect result would not be */
37 /* a problem in the case of interpolating table opcodes, as the fractional */
38 /* part would then be exactly 1.0, still giving a correct output value */
39 #define MYFLOOR(x) (x >= FL(0.0) ? (int32_t)x : (int32_t)((double)x - 0.99999999))
40
41
42
phsset(CSOUND * csound,PHSOR * p)43 int32_t phsset(CSOUND *csound, PHSOR *p)
44 {
45 MYFLT phs;
46 int32_t longphs;
47 if ((phs = *p->iphs) >= FL(0.0)) {
48 if (UNLIKELY((longphs = (int32_t)phs))) {
49 csound->Warning(csound, Str("init phase truncation\n"));
50 }
51 p->curphs = phs - (MYFLT)longphs;
52 }
53 return OK;
54 }
55
ephsset(CSOUND * csound,EPHSOR * p)56 int32_t ephsset(CSOUND *csound, EPHSOR *p)
57 {
58 MYFLT phs;
59 int32_t longphs;
60 if ((phs = *p->iphs) >= FL(0.0)) {
61 if (UNLIKELY((longphs = (int32_t)phs))) {
62 csound->Warning(csound, Str("init phase truncation\n"));
63 }
64 p->curphs = phs - (MYFLT)longphs;
65 }
66 p->b = 1.0;
67 return OK;
68 }
69
ephsor(CSOUND * csound,EPHSOR * p)70 int32_t ephsor(CSOUND *csound, EPHSOR *p)
71 {
72 double phase;
73 uint32_t offset = p->h.insdshead->ksmps_offset;
74 uint32_t early = p->h.insdshead->ksmps_no_end;
75 uint32_t n, nsmps = CS_KSMPS;
76 MYFLT *rs, *aphs, onedsr = csound->onedsr;
77 double b = p->b;
78 double incr, R = *p->kR;
79
80 rs = p->sr;
81 if (UNLIKELY(offset)) memset(rs, '\0', offset*sizeof(MYFLT));
82 if (UNLIKELY(early)) {
83 nsmps -= early;
84 memset(&rs[nsmps], '\0', early*sizeof(MYFLT));
85 }
86 aphs = p->aphs;
87 phase = p->curphs;
88 if (IS_ASIG_ARG(p->xcps)) {
89 MYFLT *cps = p->xcps;
90 for (n=offset; n<nsmps; n++) {
91 incr = (double)(cps[n] * onedsr);
92 rs[n] = (MYFLT) b;
93 aphs[n] = (MYFLT) phase;
94 phase += incr;
95 b *= R;
96 if (UNLIKELY(phase >= 1.0)) {
97 phase -= 1.0;
98 b = pow(R, 1.0+phase);
99 }
100 else if (UNLIKELY(phase < 0.0)) {
101 phase += 1.0;
102 b = pow(R, 1.0+phase);
103 }
104 }
105 }
106 else {
107 incr = (double)(*p->xcps * onedsr);
108 for (n=offset; n<nsmps; n++) {
109 rs[n] = (MYFLT) b;
110 aphs[n] = (MYFLT) phase;
111 phase += incr;
112 b *= R;
113 if (UNLIKELY(phase >= 1.0)) {
114 phase -= 1.0;
115 b = pow(R, 1.0+phase);
116 }
117 else if (UNLIKELY(phase < 0.0)) {
118 phase += 1.0;
119 b = pow(R, 1.0+phase);
120 }
121 }
122 }
123 p->curphs = phase;
124 p->b = b;
125 return OK;
126 }
127
kphsor(CSOUND * csound,PHSOR * p)128 int32_t kphsor(CSOUND *csound, PHSOR *p)
129 {
130 IGN(csound);
131 double phs;
132 *p->sr = (MYFLT)(phs = p->curphs);
133 if (UNLIKELY((phs += (double)*p->xcps * CS_ONEDKR) >= 1.0))
134 phs -= 1.0;
135 else if (UNLIKELY(phs < 0.0))
136 phs += 1.0;
137 p->curphs = phs;
138 return OK;
139 }
140
phsor(CSOUND * csound,PHSOR * p)141 int32_t phsor(CSOUND *csound, PHSOR *p)
142 {
143 double phase;
144 uint32_t offset = p->h.insdshead->ksmps_offset;
145 uint32_t early = p->h.insdshead->ksmps_no_end;
146 uint32_t n, nsmps = CS_KSMPS;
147 MYFLT *rs, onedsr = csound->onedsr;
148 double incr;
149
150 rs = p->sr;
151 if (UNLIKELY(offset)) memset(rs, '\0', offset*sizeof(MYFLT));
152 if (UNLIKELY(early)) {
153 nsmps -= early;
154 memset(&rs[nsmps], '\0', early*sizeof(MYFLT));
155 }
156 phase = p->curphs;
157 if (IS_ASIG_ARG(p->xcps)) {
158 MYFLT *cps = p->xcps;
159 for (n=offset; n<nsmps; n++) {
160 incr = (double)(cps[n] * onedsr);
161 rs[n] = (MYFLT)phase;
162 phase += incr;
163 if (UNLIKELY((MYFLT)phase >= FL(1.0))) /* VL convert to MYFLT
164 to avoid rounded output
165 exceeding 1.0 on float version */
166 phase -= 1.0;
167 else if (UNLIKELY((MYFLT)phase < FL(0.0)))
168 phase += 1.0;
169 }
170 }
171 else {
172 incr = (double)(*p->xcps * onedsr);
173 for (n=offset; n<nsmps; n++) {
174 rs[n] = (MYFLT)phase;
175 phase += incr;
176 if (UNLIKELY((MYFLT)phase >= FL(1.0))) {
177 phase -= 1.0;
178 }
179 else if (UNLIKELY((MYFLT)phase < FL(0.0)))
180 phase += 1.0;
181 }
182 }
183 p->curphs = phase;
184 return OK;
185 }
186
187 #ifdef SOME_FINE_DAY
188 /*****************************************************************************/
189 /*****************************************************************************/
190
191 /* Table read code - see TABLE data structure in ugens2.h. */
192
193 /*************************************/
194
195 /* itblchk()
196 *
197 * This is called at init time by tblset() to set up the TABLE data
198 * structure for subsequent k and a rate operations.
199 *
200 * It is also called at init time by itable() and itablei() prior to
201 * them calling ktable() and ktabli() respectively to produce a single
202 * result at init time.
203 *
204 * A similar function - ptblchk() does the same job, but reports
205 * errors in a way suitable for performance time. */
206
207 /* If the specified table number can be found, then the purpose is to
208 * read the three i rate input variables and the function table number
209 * input variable - (which we can assume here is also i rate) to set
210 * up the TABLE data structure ready for the k and a rate functions. */
211
itblchk(CSOUND * csound,TABLE * p)212 static int32_t itblchk(CSOUND *csound, TABLE *p)
213 {
214 if (UNLIKELY((p->ftp = csound->FTnp2Finde(csound, p->xfn)) == NULL))
215 return NOTOK;
216
217 /* Although TABLE has an integer variable for the table number
218 * (p->pfn) we do not need to write it. We know that the k
219 * and a rate functions which will follow will not be
220 * expecting a changed table number.
221 *
222 * p->pfn exists only for checking table number changes for
223 * functions which are expecting a k rate table number. */
224
225 /* Set denormalisation factor to 1 or table length, depending
226 * on the state of ixmode. */
227 if (*p->ixmode)
228 p->xbmul = p->ftp->flen;
229 else
230 p->xbmul = 1L;
231
232 /* Multiply the ixoff value by the xbmul denormalisation
233 * factor and then check it is between 0 and the table length.
234 *
235 * Bug fix: was p->offset * *p->ixoff */
236
237 if (UNLIKELY((p->offset = p->xbmul * *p->ixoff) < FL(0.0) ||
238 p->offset > p->ftp->flen)) {
239 return csound->InitError(csound, Str("Offset %f < 0 or > tablelength"),
240 p->offset);
241 }
242
243 p->wrap = (int32_t)*p->iwrap;
244 return OK;
245 }
246
247 /* ptblchk()
248 *
249 * This is called at init time by tblsetkt() to set up the TABLE data
250 * structure for subsequent k and a rate operations which are
251 * expecting the table number to change at k rate.
252 *
253 * tblsetkt() does very little - just setting up the wrap variable in
254 * TABLE. All the other variables depend on the table number. This is
255 * not available at init time, so the following 4 functions must look
256 * for the changed table number and set up the variables accordingly -
257 * generating error messages in a way which works at performance time.
258 *
259 * k rate a rate
260 *
261 * ktablekt tablekt Non interpolated
262 * ktablikt tablikt Interpolated
263 * */
ptblchk(CSOUND * csound,TABLE * p)264 static int32_t ptblchk(CSOUND *csound, TABLE *p)
265 {
266 IGN(csound); /* Argument is needed to fit structure */
267 /* TABLE has an integer variable for the previous table number
268 * (p->pfn).
269 *
270 * Now (at init time) we do not know the function table number
271 * which will be provided at perf time, so set p->pfn to 0, so
272 * that the k or a rate code will recognise that the first table
273 * number is different from the "previous" one. */
274 p->pfn = 0;
275
276 /* The only other thing to do is write the wrap value into the
277 * immediate copy of it in TABLE. */
278 p->wrap = (int32_t)*p->iwrap;
279 return OK;
280 }
281
282 /*---------------------------------------------------------------------------*/
283
284 /* tblset() */
285
tblset(CSOUND * csound,TABLE * p)286 int32_t tblset(CSOUND *csound, TABLE *p)
287 {
288 if (UNLIKELY(p->XINCODE != p->XOUTCODE)) {
289 const char *opname = csound->GetOpcodeName(p);
290 const char *msg = Str("%s: table index type inconsistent with output");
291 if (UNLIKELY(CS_KSMPS == 1))
292 csound->Warning(csound, msg, opname);
293 else {
294 return csound->InitError(csound, msg, opname);
295 }
296 }
297 p->h.iopadr = (SUBR) itblchk;
298 return itblchk(csound, p);
299 }
300
301 /* tblsetkt() */
302
tblsetkt(CSOUND * csound,TABLE * p)303 int32_t tblsetkt(CSOUND *csound, TABLE *p)
304 {
305 if (UNLIKELY(p->XINCODE != p->XOUTCODE)) {
306 const char *opname = csound->GetOpcodeName(p);
307 const char *msg = Str("%s: table index type inconsistent with output");
308 if (UNLIKELY(CS_KSMPS == 1))
309 csound->Warning(csound, msg, opname);
310 else {
311 return csound->InitError(csound, msg, opname);
312 }
313 }
314 p->h.iopadr = (SUBR) ptblchk;
315 return ptblchk(csound, p);
316 }
317
318 /*************************************/
319
320 /* Special functions to use when the output value is an init time
321 * variable.
322 *
323 * These are called by the opodlst lines for itable and itablei ugens.
324 *
325 * They call itblchk() and if the table was found, they call the k
326 * rate function just once.
327 *
328 * If the table was not found, an error will result from ftfind. */
329 int32_t ktable(CSOUND *,TABLE*);
330 int32_t ktabli(CSOUND *,TABLE*);
331 int32_t ktabl3(CSOUND *,TABLE*);
332
itable(CSOUND * csound,TABLE * p)333 int32_t itable(CSOUND *csound, TABLE *p)
334 {
335 if (LIKELY(itblchk(csound,p)==OK)) return ktable(csound,p);
336 return NOTOK;
337 }
338
itabli(CSOUND * csound,TABLE * p)339 int32_t itabli(CSOUND *csound, TABLE *p)
340 {
341 if (LIKELY(itblchk(csound,p)==OK)) return ktabli(csound,p);
342 return NOTOK;
343 }
344
itabl3(CSOUND * csound,TABLE * p)345 int32_t itabl3(CSOUND *csound, TABLE *p)
346 {
347 if (LIKELY(itblchk(csound,p)==OK)) return ktabl3(csound,p);
348 return NOTOK;
349 }
350
351 /*---------------------------------------------------------------------------*/
352
353 /* Functions which read the table.
354 *
355 * First we have the four basic functions for a and k rate, non
356 * interpolated and interpolated reading. These all assume that the
357 * TABLE data structure has been correctly set up - they are not
358 * expecting the table number to change at k rate.
359 *
360 * These are:
361 * k rate a rate
362 *
363 * ktable table Non interpolated
364 * ktabli tabli Interpolated
365 * ktabl3 tabl3 Interpolated with cubic
366 *
367 * Then we have four more functions which are expecting the table
368 * number to change at k rate. They deal with this, and then call one
369 * of the above functions to do the reading.
370 *
371 * These are:
372 * k rate a rate
373 *
374 * ktablekt tablekt Non interpolated
375 * ktablikt tablikt Interpolated
376 * */
377
378 /* ktable() and ktabli()
379 * ---------------------
380 *
381 * These both read a single value from the table. ktabli() does it
382 * with interpolation.
383 *
384 * This is typically used for k rate reading - where they are called
385 * as a result of being listed in a line in engineState.opcodlst. They are also
386 * called by two functions which after they have coped with any change
387 * in the k rate function table number.
388 *
389 * ktablekt() and ktablikt().
390 *
391 * In addition, they can be called by the init time functions:
392 * itable() and itabli().
393 *
394 *
395 * tablefn() and tabli()
396 * -------------------
397 *
398 * These do the reading at a rate with an a rate index.
399 *
400 * They are called directly via their entries in engineState.opcodlst, and also by
401 * two functions which call them after they have coped with any change
402 * in the k rate function table number.
403 *
404 * tablekt() and tablikt().
405 *
406 * */
407
408 /*************************************/
409
410 /* ktable() */
411
ktable(CSOUND * csound,TABLE * p)412 int32_t ktable(CSOUND *csound, TABLE *p)
413 {
414 FUNC *ftp;
415 int32_t indx, length;
416 MYFLT ndx;
417
418 ftp = p->ftp;
419 if (UNLIKELY(ftp==NULL)) goto err1; /* RWD fix */
420 ndx = *p->xndx;
421 length = ftp->flen;
422 /* Multiply ndx by denormalisation factor, and add in the offset
423 * - already denormalised - by tblchk().
424 * xbmul = 1 or table length depending on state of ixmode. */
425
426 ndx = (ndx * p->xbmul) + p->offset;
427
428 /* ndx now includes the offset and is ready to address the table.
429 *
430 * The original code was:
431 * indx = (int64_t) (ndx + p->offset);
432 *
433 * This is a problem, causes problems with negative numbers.
434 *
435 */
436 indx = (int32_t) MYFLOOR((double)ndx);
437
438 /* Now for "limit mode" - the "non-wrap" function, depending on
439 * iwrap.
440 *
441 * The following section of code limits the final index to 0 and
442 * the last location in the table.
443 *
444 * It is only used when wrap is OFF. The wrapping is achieved by
445 * code after this - when this code is not run. */
446 if (!p->wrap) {
447 /* Previously this code limited the upper range of the indx to
448 * the table length - for instance 8. Then the result was ANDed
449 * with a mask (for instance 7).
450 *
451 * This meant that when the input index was 8 or above, it got
452 * reduced to 0. What we want is for it to stick at the index
453 * which reads the last value from the table - in this example
454 * from location 7.
455 *
456 * So instead of limiting to the table length, we limit to
457 * (table length - 1). */
458 if (UNLIKELY(indx > length - 1))
459 indx = length - 1;
460
461 /* Now limit negative values to zero. */
462 else if (UNLIKELY(indx < 0L))
463 indx = 0L;
464 }
465 /* The following code uses an AND with an integer like 0000 0111
466 * to wrap the current index within the range of the table. In
467 * the original version, this code always ran, but with the new
468 * (length - 1) code above, it would have no effect, so it is now
469 * an else operation - running only when iwrap = 1. This may save
470 * half a usec or so. */
471 else indx &= ftp->lenmask;
472
473 /* Now find the address of the start of the table, add it to the
474 * index, read the value from there and write it to the
475 * destination. */
476 *p->rslt = *(ftp->ftable + indx);
477 return OK;
478 err1:
479 return csound->PerfError(csound, &(p->h),
480 Str("table(krate): not initialised"));
481 }
482
483 /* tablefn() */
484
485 /* table() is similar to ktable() above, except that it processes an
486 * array of input indexes, to send results to another array. These
487 * arrays are ksmps long. */
488 /*sbrandon: NeXT m68k does not like 'table' */
tablefn(CSOUND * csound,TABLE * p)489 int32_t tablefn(CSOUND *csound, TABLE *p)
490 {
491 FUNC *ftp;
492 MYFLT *rslt, *pxndx, *tab;
493 int32_t indx, mask, length;
494 uint32_t koffset = p->h.insdshead->ksmps_offset;
495 uint32_t early = p->h.insdshead->ksmps_no_end;
496 uint32_t n, nsmps = CS_KSMPS;
497 MYFLT ndx, xbmul, offset;
498 int32_t wrap = p->wrap;
499
500 ftp = p->ftp;
501 if (UNLIKELY(ftp==NULL)) goto err1; /* RWD fix */
502 rslt = p->rslt;
503 if (UNLIKELY(koffset)) memset(rslt, '\0', koffset*sizeof(MYFLT));
504 if (UNLIKELY(early)) {
505 nsmps -= early;
506 memset(&rslt[nsmps], '\0', early*sizeof(MYFLT));
507 }
508 length = ftp->flen;
509 pxndx = p->xndx;
510 xbmul = (MYFLT)p->xbmul;
511 offset = p->offset;
512 mask = ftp->lenmask;
513 tab = ftp->ftable;
514 for (n=koffset; n<nsmps; n++) {
515 /* Read in the next raw index and increment the pointer ready
516 * for the next cycle.
517 *
518 * Then multiply the ndx by the denormalising factor and add in
519 * the offset. */
520
521 ndx = (pxndx[n] * xbmul) + offset;
522 indx = (int32_t) MYFLOOR((double)ndx);
523
524 /* Limit = non-wrap. Limits to 0 and (length - 1), or does the
525 * wrap code. See notes above in ktable(). */
526 if (!wrap) {
527 if (UNLIKELY(indx > length - 1))
528 indx = length - 1;
529 else if (UNLIKELY(indx < (int32_t)0))
530 indx = 0L;
531 }
532 /* do the wrap code only if we are not doing the non-wrap code. */
533 else
534 indx &= mask;
535 rslt[n] = tab[indx];
536 }
537 return OK;
538 err1:
539 return csound->PerfError(csound, &(p->h),
540 Str("table: not initialised"));
541 }
542
543 /* ktabli() */
544
545 /* ktabli() is similar to ktable() above, except that it uses the
546 * fractional part of the final index to interpolate between one value
547 * in the table and the next.
548 *
549 * This means that it may read the guard point. In a table of
550 * "length" 8, the guardpoint is at locaton 8. The normal part of the
551 * table is locations 0 to 7.
552 *
553 * In non-wrap mode, when the final index is negative, the output
554 * should be the value in location 0.
555 *
556 * In non-wrap mode, when the final index is >= length, then the
557 * output should be the value in the guard point location. */
ktabli(CSOUND * csound,TABLE * p)558 int32_t ktabli(CSOUND *csound, TABLE *p)
559 {
560 FUNC *ftp;
561 int32_t indx, length;
562 MYFLT v1, v2, fract, ndx;
563
564 ftp = p->ftp;
565 if (UNLIKELY(ftp==NULL)) goto err1;
566 ndx = *p->xndx;
567 length = ftp->flen;
568 /* Multiply ndx by denormalisation factor.
569 * xbmul is 1 or table length depending on state of ixmode.
570 * Add in the offset, which has already been denormalised by
571 * tblchk(). */
572
573 ndx = (ndx * p->xbmul) + p->offset;
574 indx = (int32_t) MYFLOOR((double)ndx);
575
576 /* We need to generate a fraction - How much above indx is ndx?
577 * It will be between 0 and just below 1.0. */
578 fract = ndx - indx;
579
580 /* Start of changes to fix non- wrap bug.
581 *
582 * There are two changes here:
583 *
584 * 1 - We only run the wrap code if iwrap = 1. Previously it was
585 * always run.
586 *
587 * 2 - The other change is similar in concept to limiting the
588 * index to (length - 1) when in non-wrap mode.
589 *
590 * This would be fine - the fractional code would enable us to
591 * interpolate using an index value which is almost as high as the
592 * length of the table. This would be good for 7.99999 etc.
593 * However, to be a little pedantic, what we want is for any index
594 * of 8 or more to produce a result exactly equal to the value at
595 * the guard point.
596 *
597 * We will let all (non negative) values which are less than
598 * length pass through. This deals with all cases 0 to 7.9999
599 * . . .
600 *
601 * However we will look for final indexes of length (8) and above
602 * and take the following steps:
603 *
604 * fract = 1
605 * indx = length - 1
606 *
607 * We then continue with the rest of code. This causes the result
608 * to be the value read from the guard point - which is what we
609 * want.
610 *
611 * Likewise, if the final index is negative, set both fract and
612 * indx to 0. */
613 if (!p->wrap) {
614 if (UNLIKELY(ndx > length)) {
615 indx = length - 1;
616 fract = FL(1.0);
617 }
618 else if (UNLIKELY(indx < 0L)) {
619 indx = 0L;
620 fract = FL(0.0);
621 }
622 }
623 /* We are in wrap mode, so do the wrap function. */
624 else indx &= ftp->lenmask;
625
626 /* Now read the value at indx and the one beyond */
627 v1 = *(ftp->ftable + indx);
628 v2 = *(ftp->ftable + indx + 1);
629 *p->rslt = v1 + (v2 - v1) * fract;
630 return OK;
631 err1:
632 return csound->PerfError(csound, &(p->h),
633 Str("tablei(krate): not initialised"));
634 }
635
636
ktabl3(CSOUND * csound,TABLE * p)637 int32_t ktabl3(CSOUND *csound, TABLE *p)
638 {
639 FUNC *ftp;
640 int32_t indx, length;
641 MYFLT v1, v2, fract, ndx;
642
643 ftp = p->ftp;
644 if (UNLIKELY(ftp==NULL)) goto err1;
645 ndx = *p->xndx;
646 length = ftp->flen;
647 /* Multiply ndx by denormalisation factor.
648 * xbmul is 1 or table length depending on state of ixmode.
649 * Add in the offset, which has already been denormalised by
650 * tblchk(). */
651
652 ndx = (ndx * p->xbmul) + p->offset;
653 indx = (int32_t) MYFLOOR((double)ndx);
654
655 /* We need to generate a fraction - How much above indx is ndx?
656 * It will be between 0 and just below 1.0. */
657 fract = ndx - indx;
658
659 /* Start of changes to fix non- wrap bug.
660 *
661 * There are two changes here:
662 *
663 * 1 - We only run the wrap code if iwrap = 1. Previously it was
664 * always run.
665 *
666 * 2 - The other change is similar in concept to limiting the
667 * index to (length - 1) when in non-wrap mode.
668 *
669 * This would be fine - the fractional code would enable us to
670 * interpolate using an index value which is almost as high as the
671 * length of the table. This would be good for 7.99999 etc.
672 * However, to be a little pedantic, what we want is for any index
673 * of 8 or more to produce a result exactly equal to the value at
674 * the guard point.
675 *
676 * We will let all (non negative) values which are less than
677 * length pass through. This deals with all cases 0 to 7.9999
678 * . . .
679 *
680 * However we will look for final indexes of length (8) and above
681 * and take the following steps:
682 *
683 * fract = 1
684 * indx = length - 1
685 *
686 * We then continue with the rest of code. This causes the result
687 * to be the value read from the guard point - which is what we
688 * want.
689 *
690 * Likewise, if the final index is negative, set both fract and
691 * indx to 0. */
692 if (!p->wrap) {
693 if (UNLIKELY(ndx > length)) {
694 indx = length - 1;
695 fract = FL(1.0);
696 }
697 else if (UNLIKELY(indx < 0L)) {
698 indx = 0L;
699 fract = FL(0.0);
700 }
701 }
702 /* We are in wrap mode, so do the wrap function. */
703 else indx &= ftp->lenmask;
704
705 /* interpolate with cubic if we can, else linear */
706 if (UNLIKELY(indx<1 || indx==length-1 || length <4)) {
707 v1 = *(ftp->ftable + indx);
708 v2 = *(ftp->ftable + indx + 1);
709 *p->rslt = v1 + (v2 - v1) * fract;
710 }
711 else {
712 MYFLT *tab = ftp->ftable;
713 MYFLT ym1 = tab[indx-1], y0 = tab[indx];
714 MYFLT y1 = tab[indx+1], y2 = tab[indx+2];
715 MYFLT frsq = fract*fract;
716 MYFLT frcu = frsq*ym1;
717 MYFLT t1 = y2 + y0+y0+y0;
718 *p->rslt = y0 + FL(0.5)*frcu
719 + fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0))
720 + frsq*fract*(t1/FL(6.0) - FL(0.5)*y1) + frsq*(FL(0.5)* y1 - y0);
721 }
722 return OK;
723 err1:
724 return csound->PerfError(csound, &(p->h),
725 Str("table3(krate): not initialised"));
726 }
727
728 /* tabli() */
729
730 /* tabli() is similar to ktabli() above, except that it processes an
731 * array of input indexes, to send results to another array. */
732
tabli(CSOUND * csound,TABLE * p)733 int32_t tabli(CSOUND *csound, TABLE *p)
734 {
735 FUNC *ftp;
736 int32_t indx, mask, length;
737 uint32_t koffset = p->h.insdshead->ksmps_offset;
738 uint32_t early = p->h.insdshead->ksmps_no_end;
739 uint32_t n, nsmps = CS_KSMPS;
740 MYFLT *rslt, *pxndx, *tab;
741 MYFLT fract, v1, v2, ndx, xbmul, offset;
742
743 ftp = p->ftp;
744 if (UNLIKELY(ftp==NULL)) goto err1;
745 rslt = p->rslt;
746 if (UNLIKELY(koffset)) memset(rslt, '\0', koffset*sizeof(MYFLT));
747 if (UNLIKELY(early)) {
748 nsmps -= early;
749 memset(&rslt[nsmps], '\0', early*sizeof(MYFLT));
750 }
751 length = ftp->flen;
752 pxndx = p->xndx;
753 xbmul = (MYFLT)p->xbmul;
754 offset = p->offset;
755 mask = ftp->lenmask;
756 tab = ftp->ftable;
757 /* As for ktabli() code to handle non wrap mode, and wrap mode. */
758 if (!p->wrap) {
759 for (n=koffset; n<nsmps; n++) {
760 /* Read in the next raw index and increment the pointer ready
761 * for the next cycle.
762 * Then multiply the ndx by the denormalising factor and add in
763 * the offset. */
764 ndx = (pxndx[n] * xbmul) + offset;
765 indx = (int32_t) ndx;
766 if (UNLIKELY(indx <= 0L)) {
767 rslt[n] = tab[0];
768 continue;
769 }
770 if (UNLIKELY(indx >= length)) {
771 rslt[n] = tab[length];
772 continue;
773 }
774 /* We need to generate a fraction - How much above indx is ndx?
775 * It will be between 0 and just below 1.0. */
776 fract = ndx - indx;
777 /* As for ktabli(), read two values and interpolate between
778 * them. */
779 v1 = tab[indx];
780 v2 = tab[indx + 1];
781 rslt[n] = v1 + (v2 - v1)*fract;
782 }
783 }
784 else { /* wrap mode */
785 for (n=koffset; n<nsmps; n++) {
786 /* Read in the next raw index and increment the pointer ready
787 * for the next cycle.
788 * Then multiply the ndx by the denormalising factor and add in
789 * the offset. */
790 ndx = (pxndx[n] * xbmul) + offset;
791 indx = (int32_t) MYFLOOR(ndx);
792 /* We need to generate a fraction - How much above indx is ndx?
793 * It will be between 0 and just below 1.0. */
794 fract = ndx - indx;
795 indx &= mask;
796 /* As for ktabli(), read two values and interpolate between
797 * them. */
798 v1 = tab[indx];
799 v2 = tab[indx + 1];
800 rslt[n] = v1 + (v2 - v1)*fract;
801 }
802 }
803 return OK;
804 err1:
805 return csound->PerfError(csound, &(p->h),
806 Str("tablei: not initialised"));
807 }
808
tabl3(CSOUND * csound,TABLE * p)809 int32_t tabl3(CSOUND *csound, TABLE *p) /* Like tabli but cubic interpolation */
810 {
811 FUNC *ftp;
812 int32_t indx, mask, length;
813 uint32_t koffset = p->h.insdshead->ksmps_offset;
814 uint32_t early = p->h.insdshead->ksmps_no_end;
815 uint32_t n, nsmps = CS_KSMPS;
816 MYFLT *rslt, *pxndx, *tab;
817 MYFLT fract, v1, v2, ndx, xbmul, offset;
818 int32_t wrap = p->wrap;
819
820 ftp = p->ftp;
821 if (UNLIKELY(ftp==NULL)) goto err1;
822 rslt = p->rslt;
823 if (UNLIKELY(koffset)) memset(rslt, '\0', koffset*sizeof(MYFLT));
824 if (UNLIKELY(early)) {
825 nsmps -= early;
826 memset(&rslt[nsmps], '\0', early*sizeof(MYFLT));
827 }
828 length = ftp->flen;
829 pxndx = p->xndx;
830 xbmul = (MYFLT)p->xbmul;
831 offset = p->offset;
832 mask = ftp->lenmask;
833 tab = ftp->ftable;
834 for (n=koffset; n<nsmps; n++) {
835 /* Read in the next raw index and increment the pointer ready
836 * for the next cycle.
837 * Then multiply the ndx by the denormalising factor and add in
838 * the offset. */
839
840 ndx = (pxndx[n] * xbmul) + offset;
841 indx = (int32_t) MYFLOOR((double)ndx);
842
843 /* We need to generate a fraction - How much above indx is ndx?
844 * It will be between 0 and just below 1.0. */
845 fract = ndx - indx;
846 /* As for ktabli() code to handle non wrap mode, and wrap mode. */
847 if (!wrap) {
848 if (UNLIKELY(ndx > length)) {
849 indx = length - 1;
850 fract = FL(1.0);
851 }
852 else if (UNLIKELY(indx < 0L)) {
853 indx = 0L;
854 fract = FL(0.0);
855 }
856 }
857 else
858 indx &= mask;
859 /* interpolate with cubic if we can */
860 if (UNLIKELY(indx <1 || indx == length-1 || length<4)) {
861 /* Too short or at ends */
862 v1 = tab[indx];
863 v2 = tab[indx + 1];
864 rslt[n] = v1 + (v2 - v1)*fract;
865 }
866 else {
867 MYFLT ym1 = tab[indx-1], y0 = tab[indx];
868 MYFLT y1 = tab[indx+1], y2 = tab[indx+2];
869 MYFLT frsq = fract*fract;
870 MYFLT frcu = frsq*ym1;
871 MYFLT t1 = y2 + y0+y0+y0;
872 rslt[n] = y0 + FL(0.5)*frcu +
873 fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0)) +
874 frsq*fract*(t1/FL(6.0) - FL(0.5)*y1) + frsq*(FL(0.5)* y1 - y0);
875 }
876 }
877 return OK;
878 err1:
879 return csound->PerfError(csound, &(p->h),
880 Str("table3: not initialised"));
881 }
882
883 /*************************************/
884
885 /* Four functions to call the above four, after handling the k rate
886 * table number variable.
887 *
888 * tblsetkt() does very little - just setting up the wrap variable in
889 * TABLE. All the other variables depend on the table number. This is
890 * not available at init time, so the following 4 functions must look
891 * for the changed table number and set up the variables accordingly -
892 * generating error messages in a way which works at performance time.
893 * * k rate a rate
894 *
895 * ktablekt tablekt Non interpolated
896 * ktablikt tablikt Interpolated
897 *
898 * Since these perform identical operations, apart from the function
899 * they call, create a common function to do this work:
900 *
901 * ftkrchk() */
902
ftkrchk(CSOUND * csound,TABLE * p)903 static int32_t ftkrchk(CSOUND *csound, TABLE *p)
904 {
905 /* Check the table number is >= 1. Print error and deactivate if
906 * it is not. Return NOTOK to tell calling function not to proceed
907 * with a or k rate operations.
908 *
909 * We must do this to catch the situation where the first call has
910 * a table number of 0, and since that equals pfn, we would
911 * otherwise proceed without checking the table number - and none
912 * of the pointers would have been set up. */
913 if (*p->xfn < 1) goto err1;
914 /* Check to see if table number has changed from previous value.
915 * On the first run through, the previous value will be 0. */
916
917 if (p->pfn != (int32_t)*p->xfn) {
918 /* If it is different, check to see if the table exists.
919 *
920 * If it doesn't, an error message should be produced by
921 * csoundFTFindP() which should also deactivate the instrument.
922 *
923 * Return 0 to tell calling function not to proceed with a or
924 * k rate operations. */
925
926 if (UNLIKELY((p->ftp = csound->FTFindP(csound, p->xfn) ) == NULL)) {
927 return NOTOK;
928 }
929
930 /* p->ftp now points to the FUNC data structure of the newly
931 * selected table.
932 *
933 * Now we set up some variables in TABLE ready for the k or a
934 * rate functions which follow. */
935
936 /* Write the integer version of the table number into pfn so
937 * we can later decide whether subsequent calls to the k and a
938 * rate functions occur with a table number value which points
939 * to a different table. */
940 p->pfn = (int32_t)*p->xfn;
941
942 /* Set denormalisation factor to 1 or table length, depending
943 * on the state of ixmode. */
944 if (*p->ixmode)
945 p->xbmul = p->ftp->flen;
946 else p->xbmul = 1L;
947
948 /* Multiply the ixoff value by the xbmul denormalisation
949 * factor and then check it is between 0 and the table length. */
950
951 if (UNLIKELY((p->offset = p->xbmul * *p->ixoff) < FL(0.0) ||
952 p->offset > p->ftp->flen)) goto err2;
953 }
954 return OK;
955 err1:
956 return csound->PerfError(csound, &(p->h),
957 Str("k rate function table no. %f < 1"),
958 *p->xfn);
959 err2:
960 return csound->PerfError(csound, &(p->h),
961 Str("Offset %f < 0 or > tablelength"),
962 p->offset);
963 }
964
965 /* Now for the four functions, which are called as a result of being
966 * listed in engineState.opcodlst in entry.c */
967
ktablekt(CSOUND * csound,TABLE * p)968 int32_t ktablekt(CSOUND *csound, TABLE *p)
969 {
970 if (LIKELY(ftkrchk(csound,p)==OK)) return ktable(csound,p);
971 return NOTOK;
972 }
973
tablekt(CSOUND * csound,TABLE * p)974 int32_t tablekt(CSOUND *csound, TABLE *p)
975 {
976 if (LIKELY(ftkrchk(csound,p)==OK)) return tablefn(csound,p);
977 return NOTOK;
978 }
979
ktablikt(CSOUND * csound,TABLE * p)980 int32_t ktablikt(CSOUND *csound, TABLE *p)
981 {
982 if (LIKELY(ftkrchk(csound,p)==OK)) return ktabli(csound,p);
983 return NOTOK;
984 }
985
tablikt(CSOUND * csound,TABLE * p)986 int32_t tablikt(CSOUND *csound, TABLE *p)
987 {
988 if (LIKELY(ftkrchk(csound,p)==OK)) return tabli(csound,p);
989 return NOTOK;
990 }
991
ktabl3kt(CSOUND * csound,TABLE * p)992 int32_t ktabl3kt(CSOUND *csound, TABLE *p)
993 {
994 if (LIKELY(ftkrchk(csound,p)==OK)) return ktabl3(csound,p);
995 return NOTOK;
996 }
997
tabl3kt(CSOUND * csound,TABLE * p)998 int32_t tabl3kt(CSOUND *csound, TABLE *p)
999 {
1000 if (LIKELY(ftkrchk(csound,p)==OK)) return tabl3(csound,p);
1001 return NOTOK;
1002 }
1003 #endif /* SOME_FINE_DAY */
1004
ko1set(CSOUND * csound,OSCIL1 * p)1005 int32_t ko1set(CSOUND *csound, OSCIL1 *p)
1006 {
1007 FUNC *ftp;
1008
1009 if (UNLIKELY((ftp = csound->FTFind(csound, p->ifn)) == NULL))
1010 return NOTOK;
1011 if (UNLIKELY(*p->idur <= FL(0.0))) {
1012 /*csound->Warning(csound, Str("duration < zero\n"));*/
1013 p->phs = MAXLEN-1;
1014 }
1015 else p->phs = 0;
1016 p->ftp = ftp;
1017 p->dcnt = (int32_t)(*p->idel * CS_EKR);
1018 p->kinc = (int32_t) (CS_KICVT / *p->idur);
1019 if (p->kinc==0) p->kinc = 1;
1020
1021 return OK;
1022 }
1023
kosc1(CSOUND * csound,OSCIL1 * p)1024 int32_t kosc1(CSOUND *csound, OSCIL1 *p)
1025 {
1026 FUNC *ftp;
1027 int32_t phs, dcnt;
1028 ftp = p->ftp;
1029 if (UNLIKELY(ftp==NULL)) goto err1;
1030 phs = p->phs;
1031 *p->rslt = *(ftp->ftable + (phs >> ftp->lobits)) * *p->kamp;
1032 if ((dcnt = p->dcnt) > 0)
1033 dcnt--;
1034 else if (dcnt == 0) {
1035 phs += p->kinc;
1036 if (UNLIKELY(phs >= MAXLEN)){
1037 phs = MAXLEN;
1038 dcnt--;
1039 }
1040 else if (UNLIKELY(phs < 0)){
1041 phs = 0;
1042 dcnt--;
1043 }
1044 p->phs = phs;
1045 }
1046 p->dcnt = dcnt;
1047 return OK;
1048 err1:
1049 return csound->PerfError(csound, &(p->h),
1050 Str("oscil1(krate): not initialised"));
1051 }
1052
kosc1i(CSOUND * csound,OSCIL1 * p)1053 int32_t kosc1i(CSOUND *csound, OSCIL1 *p)
1054 {
1055 FUNC *ftp;
1056 MYFLT fract, v1, *ftab;
1057 int32_t phs, dcnt;
1058
1059 ftp = p->ftp;
1060 if (UNLIKELY(ftp==NULL)) goto err1;
1061 phs = p->phs;
1062 fract = PFRAC(phs);
1063 ftab = ftp->ftable + (phs >> ftp->lobits);
1064 v1 = *ftab++;
1065 *p->rslt = (v1 + (*ftab - v1) * fract) * *p->kamp;
1066 if ((dcnt = p->dcnt) > 0) {
1067 dcnt--;
1068 p->dcnt = dcnt;
1069 }
1070 else if (dcnt == 0) {
1071 phs += p->kinc;
1072 if (UNLIKELY(phs >= MAXLEN)) {
1073 phs = MAXLEN;
1074 dcnt--;
1075 p->dcnt = dcnt;
1076 } else if (UNLIKELY(phs < 0)){
1077 phs = 0;
1078 dcnt--;
1079 }
1080 p->phs = phs;
1081 }
1082 return OK;
1083 err1:
1084 return csound->PerfError(csound, &(p->h),
1085 Str("oscil1i(krate): not initialised"));
1086 }
1087
oscnset(CSOUND * csound,OSCILN * p)1088 int32_t oscnset(CSOUND *csound, OSCILN *p)
1089 {
1090 FUNC *ftp;
1091 if (LIKELY((ftp = csound->FTnp2Finde(csound, p->ifn)) != NULL)) {
1092 p->ftp = ftp;
1093 p->inc = ftp->flen * *p->ifrq * csound->onedsr;
1094 p->index = FL(0.0);
1095 p->maxndx = ftp->flen - FL(1.0);
1096 p->ntimes = (int32_t)*p->itimes;
1097 return OK;
1098 }
1099 else return NOTOK;
1100 }
1101
osciln(CSOUND * csound,OSCILN * p)1102 int32_t osciln(CSOUND *csound, OSCILN *p)
1103 {
1104 MYFLT *rs = p->rslt;
1105 uint32_t offset = p->h.insdshead->ksmps_offset;
1106 uint32_t early = p->h.insdshead->ksmps_no_end;
1107 uint32_t n, nsmps = CS_KSMPS;
1108
1109 if (UNLIKELY(p->ftp==NULL)) goto err1;
1110 if (UNLIKELY(offset)) memset(rs, '\0', offset*sizeof(MYFLT));
1111 if (UNLIKELY(early)) {
1112 nsmps -= early;
1113 memset(&rs[nsmps], '\0', early*sizeof(MYFLT));
1114 }
1115 if (p->ntimes) {
1116 MYFLT *ftbl = p->ftp->ftable;
1117 MYFLT amp = *p->kamp;
1118 MYFLT ndx = p->index;
1119 MYFLT inc = p->inc;
1120 MYFLT maxndx = p->maxndx;
1121 for (n=offset; n<nsmps; n++) {
1122 rs[n] = ftbl[(int32_t)ndx] * amp;
1123 if (UNLIKELY((ndx += inc) > maxndx)) {
1124 if (--p->ntimes)
1125 ndx -= maxndx;
1126 else if (UNLIKELY(n==nsmps))
1127 return OK;
1128 else
1129 goto putz;
1130 }
1131 }
1132 p->index = ndx;
1133 }
1134 else {
1135 n=0; /* Can jump out of previous loop into this one */
1136 putz:
1137 memset(&rs[n], 0, (nsmps-n)*sizeof(MYFLT));
1138 /* for (; n<nsmps; n++) { */
1139 /* rs[n] = FL(0.0); */
1140 /* } */
1141 }
1142 return OK;
1143 err1:
1144 return csound->PerfError(csound, &(p->h),
1145 Str("osciln: not initialised"));
1146 }
1147
fill_func_from_array(ARRAYDAT * a,FUNC * f)1148 static int32_t fill_func_from_array(ARRAYDAT *a, FUNC *f)
1149 {
1150 int32_t lobits, ltest, flen, i;
1151 int32_t nonpowof2_flag = 0;
1152
1153 flen = f->flen = a->sizes[0];
1154 flen &= -2L;
1155 for (ltest = flen, lobits = 0;
1156 (ltest & MAXLEN) == 0L;
1157 lobits++, ltest <<= 1)
1158 ;
1159 if (UNLIKELY(ltest != MAXLEN)) {
1160 lobits = 0;
1161 nonpowof2_flag = 1;
1162 }
1163 f->ftable = a->data;
1164 f->lenmask = ((flen & (flen - 1L)) ?
1165 0L : (flen - 1L)); /* init hdr w powof2 data */
1166 f->lobits = lobits;
1167 i = (1 << lobits);
1168 f->lomask = (int32_t) (i - 1);
1169 f->lodiv = FL(1.0) / (MYFLT) i; /* & other useful vals */
1170 f->nchanls = 1; /* presume mono for now */
1171 f->flenfrms = flen;
1172 if (nonpowof2_flag)
1173 f->lenmask = 0xFFFFFFFF;
1174 return OK;
1175 }
1176
oscsetA(CSOUND * csound,OSC * p)1177 int32_t oscsetA(CSOUND *csound, OSC *p)
1178 {
1179 FUNC *ftp = &p->FF;
1180 int32_t x;
1181
1182 if (*p->iphs >= 0)
1183 p->lphs = ((int32_t)(*p->iphs * FMAXLEN)) & PHMASK;
1184 //check p->ifn is a valid array with power-of-two length
1185 x = ((ARRAYDAT*)p->ifn)->sizes[0];
1186 if (LIKELY((x != 0) && !(x & (x - 1)))) {
1187 p->ftp = ftp;
1188 fill_func_from_array((ARRAYDAT*)p->ifn, ftp);
1189 return OK;
1190 }
1191 else return csound->InitError(csound, Str("array size not pow-of-two\n"));
1192 }
1193
oscset(CSOUND * csound,OSC * p)1194 int32_t oscset(CSOUND *csound, OSC *p)
1195 {
1196 FUNC *ftp;
1197 if (LIKELY((ftp = csound->FTFind(csound, p->ifn)) != NULL)) {
1198 p->ftp = ftp;
1199 if (*p->iphs >= 0)
1200 p->lphs = ((int32_t)(*p->iphs * FMAXLEN)) & PHMASK;
1201 return OK;
1202 }
1203 return NOTOK;
1204 }
1205
koscil(CSOUND * csound,OSC * p)1206 int32_t koscil(CSOUND *csound, OSC *p)
1207 {
1208 FUNC *ftp;
1209 int32_t phs, inc;
1210
1211 ftp = p->ftp;
1212 if (UNLIKELY(ftp==NULL)) goto err1;
1213 phs = p->lphs;
1214 inc = (int32_t) (*p->xcps * CS_KICVT);
1215 *p->sr = ftp->ftable[phs >> ftp->lobits] * *p->xamp;
1216 phs += inc;
1217 phs &= PHMASK;
1218 p->lphs = phs;
1219 return OK;
1220 err1:
1221 return csound->PerfError(csound, &(p->h),
1222 Str("oscil(krate): not initialised"));
1223 }
1224
osckk(CSOUND * csound,OSC * p)1225 int32_t osckk(CSOUND *csound, OSC *p)
1226 {
1227 FUNC *ftp;
1228 MYFLT amp, *ar, *ftbl;
1229 int32_t phs, inc, lobits;
1230 uint32_t offset = p->h.insdshead->ksmps_offset;
1231 uint32_t early = p->h.insdshead->ksmps_no_end;
1232 uint32_t n, nsmps = CS_KSMPS;
1233
1234 ftp = p->ftp;
1235 if (UNLIKELY(ftp==NULL)) goto err1;
1236 ftbl = ftp->ftable;
1237 phs = p->lphs;
1238 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1239 lobits = ftp->lobits;
1240 amp = *p->xamp;
1241 ar = p->sr;
1242 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1243 if (UNLIKELY(early)) {
1244 nsmps -= early;
1245 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1246 }
1247
1248 for (n=offset;n<nsmps;n++) {
1249 ar[n] = ftbl[phs >> lobits] * amp;
1250 /* phs += inc; */
1251 /* phs &= PHMASK; */
1252 phs = (phs+inc)&PHMASK;
1253 }
1254 p->lphs = phs;
1255 return OK;
1256 err1:
1257 return csound->PerfError(csound, &(p->h),
1258 Str("oscil: not initialised"));
1259 }
1260
oscka(CSOUND * csound,OSC * p)1261 int32_t oscka(CSOUND *csound, OSC *p)
1262 {
1263 FUNC *ftp;
1264 MYFLT *ar, amp, *cpsp, *ftbl;
1265 int32_t phs, lobits;
1266 uint32_t offset = p->h.insdshead->ksmps_offset;
1267 uint32_t early = p->h.insdshead->ksmps_no_end;
1268 uint32_t n, nsmps = CS_KSMPS;
1269 MYFLT sicvt = csound->sicvt;
1270
1271 ftp = p->ftp;
1272 if (UNLIKELY(ftp==NULL)) goto err1;
1273 ftbl = ftp->ftable;
1274 lobits = ftp->lobits;
1275 amp = *p->xamp;
1276 cpsp = p->xcps;
1277 phs = p->lphs;
1278 ar = p->sr;
1279 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1280 if (UNLIKELY(early)) {
1281 nsmps -= early;
1282 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1283 }
1284 for (n=offset;n<nsmps;n++) {
1285 int32_t inc = MYFLT2LONG(cpsp[n] * sicvt);
1286 ar[n] = ftbl[phs >> lobits] * amp;
1287 phs += inc;
1288 phs &= PHMASK;
1289 }
1290 p->lphs = phs;
1291 return OK;
1292 err1:
1293 return csound->PerfError(csound, &(p->h),
1294 Str("oscil: not initialised"));
1295 }
1296
oscak(CSOUND * csound,OSC * p)1297 int32_t oscak(CSOUND *csound, OSC *p)
1298 {
1299 FUNC *ftp;
1300 MYFLT *ar, *ampp, *ftbl;
1301 int32_t phs, inc, lobits;
1302 uint32_t offset = p->h.insdshead->ksmps_offset;
1303 uint32_t early = p->h.insdshead->ksmps_no_end;
1304 uint32_t n, nsmps = CS_KSMPS;
1305
1306 ftp = p->ftp;
1307 if (UNLIKELY(ftp==NULL)) goto err1;
1308 ftbl = ftp->ftable;
1309 lobits = ftp->lobits;
1310 phs = p->lphs;
1311 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1312 ampp = p->xamp;
1313 ar = p->sr;
1314 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1315 if (UNLIKELY(early)) {
1316 nsmps -= early;
1317 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1318 }
1319 for (n=offset;n<nsmps;n++) {
1320 ar[n] = ftbl[phs >> lobits] * ampp[n];
1321 phs = (phs+inc) & PHMASK;
1322 }
1323 p->lphs = phs;
1324 return OK;
1325 err1:
1326 return csound->PerfError(csound, &(p->h),
1327 Str("oscil: not initialised"));
1328 }
1329
oscaa(CSOUND * csound,OSC * p)1330 int32_t oscaa(CSOUND *csound, OSC *p)
1331 {
1332 FUNC *ftp;
1333 MYFLT *ar, *ampp, *cpsp, *ftbl;
1334 int32_t phs, lobits;
1335 uint32_t offset = p->h.insdshead->ksmps_offset;
1336 uint32_t early = p->h.insdshead->ksmps_no_end;
1337 uint32_t n, nsmps = CS_KSMPS;
1338 MYFLT sicvt = csound->sicvt;
1339
1340 ftp = p->ftp;
1341 if (UNLIKELY(ftp==NULL)) goto err1;
1342 ftbl = ftp->ftable;
1343 lobits = ftp->lobits;
1344 phs = p->lphs;
1345 ampp = p->xamp;
1346 cpsp = p->xcps;
1347 ar = p->sr;
1348 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1349 if (UNLIKELY(early)) {
1350 nsmps -= early;
1351 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1352 }
1353 for (n=offset;n<nsmps;n++) {
1354 int32_t inc = MYFLT2LONG(cpsp[n] * sicvt);
1355 ar[n] = ftbl[phs >> lobits] * ampp[n];
1356 phs = (phs+inc) & PHMASK;
1357 }
1358 p->lphs = phs;
1359 return OK;
1360 err1:
1361 return csound->PerfError(csound, &(p->h),
1362 Str("oscil: not initialised"));
1363 }
1364
koscli(CSOUND * csound,OSC * p)1365 int32_t koscli(CSOUND *csound, OSC *p)
1366 {
1367 FUNC *ftp;
1368 int32_t phs, inc;
1369 MYFLT *ftab, fract, v1;
1370
1371 phs = p->lphs;
1372 ftp = p->ftp;
1373 if (UNLIKELY(ftp==NULL)) goto err1;
1374 fract = PFRAC(phs);
1375 ftab = ftp->ftable + (phs >> ftp->lobits);
1376 v1 = ftab[0];
1377 *p->sr = (v1 + (ftab[1] - v1) * fract) * *p->xamp;
1378 inc = (int32_t)(*p->xcps * CS_KICVT);
1379 phs += inc;
1380 phs &= PHMASK;
1381 p->lphs = phs;
1382 return OK;
1383 err1:
1384 return csound->PerfError(csound, &(p->h),
1385 Str("oscili(krate): not initialised"));
1386 }
1387
osckki(CSOUND * csound,OSC * p)1388 int32_t osckki(CSOUND *csound, OSC *p)
1389 {
1390 FUNC *ftp;
1391 MYFLT fract, v1, amp, *ar, *ft, *ftab;
1392 int32_t phs, inc, lobits;
1393 uint32_t offset = p->h.insdshead->ksmps_offset;
1394 uint32_t early = p->h.insdshead->ksmps_no_end;
1395 uint32_t n, nsmps = CS_KSMPS;
1396
1397 if (UNLIKELY((ftp = p->ftp)==NULL)) goto err1;
1398 lobits = ftp->lobits;
1399 phs = p->lphs;
1400 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1401 amp = *p->xamp;
1402 ar = p->sr;
1403 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1404 if (UNLIKELY(early)) {
1405 nsmps -= early;
1406 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1407 }
1408 ft = ftp->ftable;
1409 for (n=offset; n<nsmps; n++) {
1410 fract = PFRAC(phs);
1411 ftab = ft + (phs >> lobits);
1412 v1 = ftab[0];
1413 ar[n] = (v1 + (ftab[1] - v1) * fract) * amp;
1414 phs = (phs+inc) & PHMASK;
1415 }
1416 p->lphs = phs;
1417 return OK;
1418 err1:
1419 return csound->PerfError(csound, &(p->h),
1420 Str("oscili: not initialised"));
1421 }
1422
osckai(CSOUND * csound,OSC * p)1423 int32_t osckai(CSOUND *csound, OSC *p)
1424 {
1425 FUNC *ftp;
1426 MYFLT *ar, amp, *cpsp, fract, v1, *ftab, *ft;
1427 int32_t phs, lobits;
1428 uint32_t offset = p->h.insdshead->ksmps_offset;
1429 uint32_t early = p->h.insdshead->ksmps_no_end;
1430 uint32_t n, nsmps = CS_KSMPS;
1431 MYFLT sicvt = csound->sicvt;
1432
1433 ftp = p->ftp;
1434 if (UNLIKELY(ftp==NULL)) goto err1;
1435 lobits = ftp->lobits;
1436 amp = *p->xamp;
1437 cpsp = p->xcps;
1438 phs = p->lphs;
1439 ar = p->sr;
1440 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1441 if (UNLIKELY(early)) {
1442 nsmps -= early;
1443 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1444 }
1445 ft = ftp->ftable;
1446 for (n=offset;n<nsmps;n++) {
1447 int32_t inc;
1448 inc = MYFLT2LONG(cpsp[n] * sicvt);
1449 fract = PFRAC(phs);
1450 ftab = ft + (phs >> lobits);
1451 v1 = ftab[0];
1452 ar[n] = (v1 + (ftab[1] - v1) * fract) * amp;
1453 phs += inc;
1454 phs &= PHMASK;
1455 }
1456 p->lphs = phs;
1457 return OK;
1458 err1:
1459 return csound->PerfError(csound, &(p->h),
1460 Str("oscili: not initialised"));
1461 }
1462
oscaki(CSOUND * csound,OSC * p)1463 int32_t oscaki(CSOUND *csound, OSC *p)
1464 {
1465 FUNC *ftp;
1466 MYFLT v1, fract, *ar, *ampp, *ftab, *ft;
1467 int32_t phs, inc, lobits;
1468 uint32_t offset = p->h.insdshead->ksmps_offset;
1469 uint32_t early = p->h.insdshead->ksmps_no_end;
1470 uint32_t n, nsmps = CS_KSMPS;
1471
1472 ftp = p->ftp;
1473 if (UNLIKELY(ftp==NULL)) goto err1;
1474 lobits = ftp->lobits;
1475 phs = p->lphs;
1476 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1477 ampp = p->xamp;
1478 ar = p->sr;
1479 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1480 if (UNLIKELY(early)) {
1481 nsmps -= early;
1482 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1483 }
1484 ft = ftp->ftable;
1485 for (n=offset;n<nsmps;n++) {
1486 fract = (MYFLT) PFRAC(phs);
1487 ftab = ft + (phs >> lobits);
1488 v1 = ftab[0];
1489 ar[n] = (v1 + (ftab[1] - v1) * fract) * ampp[n];
1490 phs = (phs+inc) & PHMASK;
1491 }
1492 p->lphs = phs;
1493 return OK;
1494 err1:
1495 return csound->PerfError(csound, &(p->h),
1496 Str("oscili: not initialised"));
1497 }
1498
oscaai(CSOUND * csound,OSC * p)1499 int32_t oscaai(CSOUND *csound, OSC *p)
1500 {
1501 FUNC *ftp;
1502 MYFLT v1, fract, *ar, *ampp, *cpsp, *ftab, *ft;
1503 int32_t phs, lobits;
1504 uint32_t offset = p->h.insdshead->ksmps_offset;
1505 uint32_t early = p->h.insdshead->ksmps_no_end;
1506 uint32_t n, nsmps = CS_KSMPS;
1507 MYFLT sicvt = csound->sicvt;
1508
1509 ftp = p->ftp;
1510 if (UNLIKELY(ftp==NULL)) goto err1;
1511 ft = ftp->ftable;
1512 lobits = ftp->lobits;
1513 phs = p->lphs;
1514 ampp = p->xamp;
1515 cpsp = p->xcps;
1516 ar = p->sr;
1517 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1518 if (UNLIKELY(early)) {
1519 nsmps -= early;
1520 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1521 }
1522 for (n=offset;n<nsmps;n++) {
1523 int32_t inc;
1524 inc = MYFLT2LONG(cpsp[n] * sicvt);
1525 fract = (MYFLT) PFRAC(phs);
1526 ftab = ft + (phs >> lobits);
1527 v1 = ftab[0];
1528 ar[n] = (v1 + (ftab[1] - v1) * fract) * ampp[n];
1529 phs = (phs+inc) & PHMASK;
1530 }
1531 p->lphs = phs;
1532 return OK;
1533 err1:
1534 return csound->PerfError(csound, &(p->h),
1535 Str("oscili: not initialised"));
1536 }
1537
koscl3(CSOUND * csound,OSC * p)1538 int32_t koscl3(CSOUND *csound, OSC *p)
1539 {
1540 FUNC *ftp;
1541 int32_t phs, inc;
1542 MYFLT *ftab, fract;
1543 int32_t x0;
1544 MYFLT y0, y1, ym1, y2, amp = *p->xamp;
1545
1546 phs = p->lphs;
1547 ftp = p->ftp;
1548 if (UNLIKELY(ftp==NULL)) goto err1;
1549 ftab = ftp->ftable;
1550 fract = PFRAC(phs);
1551 x0 = (phs >> ftp->lobits);
1552 x0--;
1553 if (UNLIKELY(x0<0)) {
1554 ym1 = ftab[ftp->flen-1]; x0 = 0;
1555 }
1556 else ym1 = ftab[x0++];
1557 y0 = ftab[x0++];
1558 y1 = ftab[x0++];
1559 if (UNLIKELY(x0>(int32_t)ftp->flen)) y2 = ftab[1]; else y2 = ftab[x0];
1560 {
1561 MYFLT frsq = fract*fract;
1562 MYFLT frcu = frsq*ym1;
1563 MYFLT t1 = y2 + y0+y0+y0;
1564 *p->sr = amp * (y0 + FL(0.5)*frcu +
1565 fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0)) +
1566 frsq*fract*(t1/FL(6.0) - FL(0.5)*y1) +
1567 frsq*(FL(0.5)* y1 - y0));
1568 }
1569 inc = (int32_t)(*p->xcps * CS_KICVT);
1570 phs += inc;
1571 phs &= PHMASK;
1572 p->lphs = phs;
1573 return OK;
1574 err1:
1575 return csound->PerfError(csound, &(p->h),
1576 Str("oscil3(krate): not initialised"));
1577 }
1578
osckk3(CSOUND * csound,OSC * p)1579 int32_t osckk3(CSOUND *csound, OSC *p)
1580 {
1581 FUNC *ftp;
1582 MYFLT fract, amp, *ar, *ftab;
1583 int32_t phs, inc, lobits;
1584 uint32_t offset = p->h.insdshead->ksmps_offset;
1585 uint32_t early = p->h.insdshead->ksmps_no_end;
1586 uint32_t n, nsmps = CS_KSMPS;
1587 int32_t x0;
1588 MYFLT y0, y1, ym1, y2;
1589
1590 ftp = p->ftp;
1591 if (UNLIKELY(ftp==NULL)) goto err1;
1592 ftab = ftp->ftable;
1593 lobits = ftp->lobits;
1594 phs = p->lphs;
1595 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1596 amp = *p->xamp;
1597 ar = p->sr;
1598 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1599 if (UNLIKELY(early)) {
1600 nsmps -= early;
1601 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1602 }
1603 for (n=offset;n<nsmps;n++) {
1604 fract = PFRAC(phs);
1605 x0 = (phs >> lobits);
1606 x0--;
1607 if (UNLIKELY(x0<0)) {
1608 ym1 = ftab[ftp->flen-1]; x0 = 0;
1609 }
1610 else ym1 = ftab[x0++];
1611 y0 = ftab[x0++];
1612 y1 = ftab[x0++];
1613 if (UNLIKELY(x0>(int32_t)ftp->flen)) y2 = ftab[1]; else y2 = ftab[x0];
1614 /* printf("fract = %f; y = %f, %f, %f, %f\n", fract,ym1,y0,y1,y2); */
1615 {
1616 MYFLT frsq = fract*fract;
1617 MYFLT frcu = frsq*ym1;
1618 MYFLT t1 = y2 + y0+y0+y0;
1619 /* MYFLT old = (y0 + (y1 - y0) * fract) * amp; */
1620 /* double x = ((double)(x0-2)+fract)*twopi/32.0; */
1621 /* MYFLT tr = amp*sin(x); */
1622 ar[n] = amp * (y0 + FL(0.5)*frcu +
1623 fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0)) +
1624 frsq*fract*(t1/FL(6.0) - FL(0.5)*y1) +
1625 frsq*(FL(0.5)* y1 - y0));
1626 /* printf("oscilkk3: old=%.4f new=%.4f true=%.4f (%f; %f)\n", */
1627 /* old, *(ar-1), tr, fabs(*(ar-1)-tr), fabs(old-tr)); */
1628 }
1629 phs = (phs+inc) & PHMASK;
1630 }
1631 p->lphs = phs;
1632 return OK;
1633 err1:
1634 return csound->PerfError(csound, &(p->h),
1635 Str("oscil3: not initialised"));
1636 }
1637
oscka3(CSOUND * csound,OSC * p)1638 int32_t oscka3(CSOUND *csound, OSC *p)
1639 {
1640 FUNC *ftp;
1641 MYFLT *ar, amp, *cpsp, fract, *ftab;
1642 int32_t phs, lobits;
1643 uint32_t offset = p->h.insdshead->ksmps_offset;
1644 uint32_t early = p->h.insdshead->ksmps_no_end;
1645 uint32_t n, nsmps = CS_KSMPS;
1646 int32_t x0;
1647 MYFLT y0, y1, ym1, y2;
1648 MYFLT sicvt = csound->sicvt;
1649
1650 ftp = p->ftp;
1651 if (UNLIKELY(ftp==NULL)) goto err1;
1652 ftab = ftp->ftable;
1653 lobits = ftp->lobits;
1654 amp = *p->xamp;
1655 cpsp = p->xcps;
1656 phs = p->lphs;
1657 ar = p->sr;
1658 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1659 if (UNLIKELY(early)) {
1660 nsmps -= early;
1661 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1662 }
1663 for (n=offset;n<nsmps;n++) {
1664 int32_t inc;
1665 inc = MYFLT2LONG(cpsp[n] * sicvt);
1666 fract = PFRAC(phs);
1667 x0 = (phs >> lobits);
1668 x0--;
1669 if (UNLIKELY(x0<0)) {
1670 ym1 = ftab[ftp->flen-1]; x0 = 0;
1671 }
1672 else ym1 = ftab[x0++];
1673 y0 = ftab[x0++];
1674 y1 = ftab[x0++];
1675 if (UNLIKELY(x0>(int32_t)ftp->flen)) y2 = ftab[1]; else y2 = ftab[x0];
1676 {
1677 MYFLT frsq = fract*fract;
1678 MYFLT frcu = frsq*ym1;
1679 MYFLT t1 = y2 + y0+y0+y0;
1680 ar[n] = amp * (y0 + FL(0.5)*frcu +
1681 fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0)) +
1682 frsq*fract*(t1/FL(6.0) - FL(0.5)*y1) + frsq*(FL(0.5)*
1683 y1 - y0));
1684 }
1685 phs = (phs+inc) & PHMASK;
1686 }
1687 p->lphs = phs;
1688 return OK;
1689 err1:
1690 return csound->PerfError(csound, &(p->h),
1691 Str("oscil3: not initialised"));
1692 }
1693
oscak3(CSOUND * csound,OSC * p)1694 int32_t oscak3(CSOUND *csound, OSC *p)
1695 {
1696 FUNC *ftp;
1697 MYFLT fract, *ar, *ampp, *ftab;
1698 int32_t phs, inc, lobits;
1699 uint32_t offset = p->h.insdshead->ksmps_offset;
1700 uint32_t early = p->h.insdshead->ksmps_no_end;
1701 uint32_t n, nsmps = CS_KSMPS;
1702 int32_t x0;
1703 MYFLT y0, y1, ym1, y2;
1704
1705 ftp = p->ftp;
1706 if (UNLIKELY(ftp==NULL)) goto err1;
1707 ftab = ftp->ftable;
1708 lobits = ftp->lobits;
1709 phs = p->lphs;
1710 inc = MYFLT2LONG(*p->xcps * csound->sicvt);
1711 ampp = p->xamp;
1712 ar = p->sr;
1713 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1714 if (UNLIKELY(early)) {
1715 nsmps -= early;
1716 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1717 }
1718 for (n=offset;n<nsmps;n++) {
1719 fract = (MYFLT) PFRAC(phs);
1720 x0 = (phs >> lobits);
1721 x0--;
1722 if (UNLIKELY(x0<0)) {
1723 ym1 = ftab[ftp->flen-1]; x0 = 0;
1724 }
1725 else ym1 = ftab[x0++];
1726 y0 = ftab[x0++];
1727 y1 = ftab[x0++];
1728 if (UNLIKELY(x0>(int32_t)ftp->flen)) y2 = ftab[1]; else y2 = ftab[x0];
1729 {
1730 MYFLT frsq = fract*fract;
1731 MYFLT frcu = frsq*ym1;
1732 MYFLT t1 = y2 + y0+y0+y0;
1733 ar[n] = ampp[n] *(y0 + FL(0.5)*frcu
1734 + fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0))
1735 + frsq*fract*(t1/FL(6.0) - FL(0.5)*y1)
1736 + frsq*(FL(0.5)* y1 - y0));
1737 }
1738 phs = (phs+inc) & PHMASK;
1739 }
1740 p->lphs = phs;
1741 return OK;
1742 err1:
1743 return csound->PerfError(csound, &(p->h),
1744 Str("oscil3: not initialised"));
1745 }
1746
oscaa3(CSOUND * csound,OSC * p)1747 int32_t oscaa3(CSOUND *csound, OSC *p)
1748 {
1749 FUNC *ftp;
1750 MYFLT fract, *ar, *ampp, *cpsp, *ftab;
1751 int32_t phs, lobits;
1752 uint32_t offset = p->h.insdshead->ksmps_offset;
1753 uint32_t early = p->h.insdshead->ksmps_no_end;
1754 uint32_t n, nsmps = CS_KSMPS;
1755 int32_t x0;
1756 MYFLT y0, y1, ym1, y2;
1757 MYFLT sicvt = csound->sicvt;
1758
1759 ftp = p->ftp;
1760 if (UNLIKELY(ftp==NULL)) goto err1;
1761 ftab = ftp->ftable;
1762 lobits = ftp->lobits;
1763 phs = p->lphs;
1764 ampp = p->xamp;
1765 cpsp = p->xcps;
1766 ar = p->sr;
1767 if (UNLIKELY(offset)) memset(ar, '\0', offset*sizeof(MYFLT));
1768 if (UNLIKELY(early)) {
1769 nsmps -= early;
1770 memset(&ar[nsmps], '\0', early*sizeof(MYFLT));
1771 }
1772 for (n=offset;n<nsmps;n++) {
1773 int32_t inc = MYFLT2LONG(cpsp[n] * sicvt);
1774 fract = (MYFLT) PFRAC(phs);
1775 x0 = (phs >> lobits);
1776 x0--;
1777 if (UNLIKELY(x0<0)) {
1778 ym1 = ftab[ftp->flen-1]; x0 = 0;
1779 }
1780 else ym1 = ftab[x0++];
1781 y0 = ftab[x0++];
1782 y1 = ftab[x0++];
1783 if (UNLIKELY(x0>(int32_t)ftp->flen)) y2 = ftab[1]; else y2 = ftab[x0];
1784 {
1785 MYFLT frsq = fract*fract;
1786 MYFLT frcu = frsq*ym1;
1787 MYFLT t1 = y2 + y0+y0+y0;
1788 ar[n] = ampp[n] *(y0 + FL(0.5)*frcu
1789 + fract*(y1 - frcu/FL(6.0) - t1/FL(6.0) - ym1/FL(3.0))
1790 + frsq*fract*(t1/FL(6.0) - FL(0.5)*y1)
1791 + frsq*(FL(0.5)* y1 - y0));
1792 }
1793 phs = (phs+inc) & PHMASK;
1794 }
1795 p->lphs = phs;
1796 return OK;
1797 err1:
1798 return csound->PerfError(csound, &(p->h),
1799 Str("oscil3: not initialised"));
1800 }
1801