1 /* sound.c -- nyquist sound data type */
2
3 /* CHANGE LOG
4 * --------------------------------------------------------------------
5 * 28Apr03 dm changes for portability and fix compiler warnings
6 */
7
8 /* define size_t: */
9 #include <limits.h>
10 #ifdef UNIX
11 #include "sys/types.h"
12 #endif
13 #include <stdio.h>
14 #include "xlisp.h"
15 #include "sound.h"
16 #include "falloc.h"
17 #include "samples.h"
18 #include "extern.h"
19 #include "debug.h"
20 #include "assert.h"
21 #ifdef OSC
22 #include "nyq-osc-server.h"
23 #endif
24 #include "cext.h"
25 #include "userio.h"
26
27 /* default maximum sample blocks:
28 * 1GB / (sample_block_len samples/block * 4 bytes/sample) */
29 long max_sample_blocks = 1000000000 / (max_sample_block_len * sizeof(float));
30
31 /* #define GC_DEBUG */
32 #ifdef GC_DEBUG
33 extern sound_type sound_to_watch;
34 #endif
35
36 snd_list_type list_watch; //DBY
37
38 /* #define SNAPSHOTS */
39
40 long table_memory;
41
42 sample_block_type zero_block;
43 sample_block_type internal_zero_block;
44
45 snd_list_type zero_snd_list;
46
47 xtype_desc sound_desc;
48 LVAL a_sound;
49 LVAL s_audio_markers;
50
51 static void sound_xlfree(void *);
52 static void sound_xlprint(LVAL, void *);
53 static void sound_xlsave(FILE *fp, void *s);
54 static unsigned char *sound_xlrestore(FILE *);
55
56 void sound_print_array(LVAL sa, long n);
57 void sound_print_sound(LVAL s_as_lval, long n);
58 void sample_block_unref(sample_block_type sam);
59
60 #ifdef SNAPSHOTS
61 boolean sound_created_flag = false;
62 #endif
63
64 #ifdef OSC
65 int nosc_enabled = false;
66 #endif
67
68 /* m is in bytes */
snd_set_max_audio_mem(int64_t m)69 int64_t snd_set_max_audio_mem(int64_t m)
70 {
71 int64_t r = max_sample_blocks;
72 // avoid overflow since max_sample_blocks is long
73 int64_t msb = m / (max_sample_block_len * sizeof(float));
74 if (msb > LONG_MAX) msb = LONG_MAX;
75 max_sample_blocks = (long) msb;
76 return r * max_sample_block_len * sizeof(float);
77 }
78
79
80 double sound_latency = 0.3; /* default value */
81 /* these are used so get times for *AUDIO-MARKERS* */
82 double sound_srate = 44100.0;
83 int64_t sound_frames = 0;
84
snd_set_latency(double latency)85 double snd_set_latency(double latency)
86 {
87 double r = sound_latency;
88 sound_latency = latency;
89 return r;
90 }
91
92
check_terminate_cnt(int64_t tc)93 int64_t check_terminate_cnt(int64_t tc)
94 {
95 if (tc < 0) {
96 xlfail("duration is less than 0 samples");
97 tc = 0; /* this should not be reached */
98 }
99 return tc;
100 }
101
102
103 /* xlbadsr - report a "bad combination of sample rates" error */
snd_badsr(void)104 LVAL snd_badsr(void)
105 {
106 xlfail("bad combination of sample rates");
107 return NIL; /* never happens */
108 }
109
110
111 /* compute-phase - given a phase in radians, a wavetable specified as
112 * the nominal pitch (in half steps), the table length, and the sample
113 * rate, compute the sample number corresponding to the phase. This
114 * routine makes it easy to initialize the table pointer at the beginning
115 * of various oscillator implementations in Nyquist. Note that the table
116 * may represent several periods, in which case phase 360 is not the same
117 * as 0. Also note that the phase increment is also computed and returned
118 * through incr_ptr.
119 */
compute_phase(phase,key,n,srate,new_srate,freq,incr_ptr)120 double compute_phase(phase, key, n, srate, new_srate, freq, incr_ptr)
121 double phase; /* phase in degrees (depends on ANGLEBASE) */
122 double key; /* the semitone number of the table played at srate */
123 long n; /* number of samples */
124 double srate; /* the sample rate of the table */
125 double new_srate; /* sample rate of the result */
126 double freq; /* the desired frequency */
127 double *incr_ptr; /* the sample increment */
128 {
129 double period = 1.0 / step_to_hz(key);
130
131 /* convert phase to sample units */
132 phase = srate * period * (phase / (double) ANGLEBASE);
133 /* phase is now in sample units; if phase is less than zero, then increase
134 it by some number of sLength's to make it positive:
135 */
136 if (phase < 0)
137 phase += (((int) ((-phase) / n)) + 1) * n;
138
139 /* if phase is longer than the sample length, wrap it by subtracting the
140 integer part of the division by sLength:
141 */
142 if (phase > n)
143 phase -= ((int) (phase / n)) * n;
144
145 /* Now figure the phase increment: to reproduce original pitch
146 required incr = srate / new_srate. To get the new frequency,
147 scale by freq / nominal_freq = freq * period:
148 */
149 *incr_ptr = (srate / new_srate) * freq * period;
150 return phase;
151 }
152 #ifndef GCBUG
153 snd_list_type gcbug_snd_list = 0;
154 long blocks_to_watch_len = 0;
155 sample_block_type blocks_to_watch[blocks_to_watch_max];
156
block_watch(int64_t sample_block)157 void block_watch(int64_t sample_block)
158 {
159 if (blocks_to_watch_len >= blocks_to_watch_max) {
160 stdputstr("block_watch - no more space to save pointers\n");
161 return;
162 }
163 blocks_to_watch[blocks_to_watch_len++] = (sample_block_type) sample_block;
164 nyquist_printf("block_watch - added %d = %x\n",
165 (int)sample_block, (int)sample_block);
166 }
167
168
169 /* fetch_zeros -- the fetch function for appended zeros */
170 /*
171 * zeros are appended when the logical stop time exceeds the
172 * (physical) terminate time. This fetch function is installed
173 * by snd_list_terminate(). When appending zeros, we just return
174 * a pointer to the internal_zero_block and increment current until
175 * it reaches log_stop_cnt. Then we call snd_list_terminate() to
176 * finish off the sound list.
177 */
178
fetch_zeros(snd_susp_type susp,snd_list_type snd_list)179 void fetch_zeros(snd_susp_type susp, snd_list_type snd_list)
180 {
181 int64_t len = MIN(susp->log_stop_cnt - susp->current,
182 max_sample_block_len);
183 /* nyquist_printf("fetch_zeros, lsc %d current %d len %d\n",
184 susp->log_stop_cnt, susp->current, len); */
185 if (len < 0) {
186 char error[80];
187 sprintf(error, "fetch_zeros susp %p (%s) len %" PRId64,
188 susp, susp->name, len);
189 xlabort(error);
190 }
191 if (len == 0) { /* we've reached the logical stop time */
192 /* nyquist_printf("fetch_zeros: reached the logical stop in %s cnt %d\n",
193 susp->name, susp->log_stop_cnt); */
194 snd_list_terminate(snd_list);
195 } else {
196 snd_list->block_len = (short) len;
197 susp->current += len;
198 }
199 }
200
201
202 /* sound_nth_block - fetch the address of the nth sample block of a sound */
203 /*
204 * NOTE: intended to be called from lisp. Lisp can then call block_watch
205 * to keep an eye on the block.
206 */
sound_nth_block(sound_type snd,long n)207 int64_t sound_nth_block(sound_type snd, long n)
208 {
209 long i;
210 snd_list_type snd_list = snd->list;
211 for (i = 0; i < n; i++) {
212 if (i == 1) {
213 gcbug_snd_list = snd_list;
214 nyquist_printf("gcbug_snd_list = 0x%p\n", gcbug_snd_list);
215 }
216 if (!snd_list->block) return 0;
217 snd_list = snd_list->u.next;
218 }
219 if (snd_list->block) return (int64_t) snd_list->block;
220 else return 0;
221 }
222
223 #endif
224
225
226 /****************************************************************************
227 * snd_list_create
228 * Inputs:
229 * snd_susp_type susp: A reference to the suspension
230 * Result: snd_list_type
231 * A newly-created sound list type
232 * Effect:
233 * Allocates and initializes a snd_list node:
234 * block refcnt block_len susp logically_stopped
235 * +--------+--------+-------+-------+---+
236 * |////////| 1 | 0 | susp | F |
237 * +--------+--------+-------+-------+---+
238 ****************************************************************************/
239
240 /* snd_list_create -- alloc and initialize a snd_list node */
241 /**/
snd_list_create(snd_susp_type susp)242 snd_list_type snd_list_create(snd_susp_type susp)
243 {
244 snd_list_type snd_list;
245
246 falloc_snd_list(snd_list, "snd_list_create");
247
248 snd_list->block = NULL; /* no block of samples */
249 snd_list->u.susp = susp; /* point to suspension */
250 snd_list->refcnt = 1; /* one ref */
251 snd_list->block_len = 0; /* no samples */
252 snd_list->logically_stopped = false;/* not stopped */
253 /* nyquist_printf("snd_list_create => %p\n", snd_list);*/
254 return snd_list;
255 }
256
257
258 /****************************************************************************
259 * sound_create
260 * Inputs:
261 * snd_susp_type susp: The suspension block to be used for this sound
262 * time_type t0: The initial time for this sound
263 * rate_type sr: The sampling rate for this sound
264 * sample_type scale: The scaling factor for this sound
265 * sample_block_type (*proc)(...): The get_next_sound method
266 * Result: sound_type
267 *
268 * Effect:
269 * Creates and initializes a sound type
270 * Notes:
271 * The MSDOS conditional is actually a test for ANSI headers; the
272 * presence of float parameters means that an ANSI prototype and
273 * a non-ANSI header are incompatible. Better solution would be
274 * to ANSIfy source.
275 ****************************************************************************/
276
277 sound_type last_sound = NULL;
278
sound_create(snd_susp_type susp,time_type t0,rate_type sr,promoted_sample_type scale)279 sound_type sound_create(
280 snd_susp_type susp,
281 time_type t0,
282 rate_type sr,
283 promoted_sample_type scale)
284 {
285 sound_type sound;
286 falloc_sound(sound, "sound_create");
287 if (((intptr_t) sound) & 3) errputstr("sound not word aligned\n");
288 last_sound = sound; /* debug */
289 if (t0 < 0) xlfail("attempt to create a sound with negative starting time");
290 /* nyquist_printf("sound_create %p gets %g\n", sound, t0); */
291 sound->t0 = sound->true_t0 = sound->time = t0;
292 sound->stop = MAX_STOP;
293 sound->sr = sr;
294 sound->current = 0;
295 sound->scale = (float) scale;
296 sound->list = snd_list_create(susp);
297 sound->get_next = SND_get_first;
298 sound->logical_stop_cnt = UNKNOWN;
299 sound->table = NULL;
300 sound->extra = NULL;
301 /* nyquist_printf("sound_create susp %p snd_list %p\n", susp, sound->list);
302 nyquist_printf("sound_create'd %p\n", sound); */
303 #ifdef SNAPSHOTS
304 sound_created_flag = true;
305 #endif
306 #ifdef GC_DEBUG
307 if (sound == sound_to_watch) {
308 nyquist_printf("Created watched sound\n");
309 watch_snd_list(sound->list);
310 }
311 #endif
312 return sound;
313 }
314
315
316 /* sound_prepend_zeros -- modify sound_type so that it starts at t0 */
317 /*
318 * assumes t0 is earlier than snd->t0, so the sound should return zeros
319 * until snd->t0 is reached, after which we revert to normal computation.
320 * When we return, the new snd->t0 will be t0, meaning that the first
321 * sample returned will be at time t0.
322 * NOTE: t0 may not be an exact multiple of samples earlier than snd->t0,
323 * but Nyquist allows any sound to be shifted by +/- 0.5 samples in
324 * order to achieve alignment. Since sound_prepend_zeros can be called
325 * many times on the same sound_type, there is a chance that rounding
326 * errors could accumulate. My first solution was to return with
327 * snd->t0 computed exactly and not reflecting any fractional sample
328 * shift of the signal, but this caused problems for the caller: a
329 * fractional sample shift at a low sample rate could correspond to
330 * many client samples,fooling the client into thinking that some
331 * initial samples should be discarded (or else requiring the client
332 * to be pretty smart). The solution used here is to return to the
333 * client with snd->t0 exactly equal to t0, but to save snd->true_t0
334 * equal to the time of the first sample with no sound shifting. This
335 * time is used for any future sound_prepend_zeros operations so that
336 * any accumulated rounding errors are due only to floating point
337 * precision and not to accumulated fractional sample shifts of snd.
338 */
sound_prepend_zeros(sound_type snd,time_type t0)339 void sound_prepend_zeros(sound_type snd, time_type t0)
340 {
341 int64_t n;
342
343 /* first, see if we're already prepending some zeros */
344 if (snd->get_next != SND_get_zeros) {
345 /* nyquist_printf("sound_prepend_zeros 1: snd->t0 %g t0 %g\n", snd->t0, t0); */
346
347 /* if not, then initialize some fields that support prepending */
348 snd->prepend_cnt = 0;
349 snd->true_t0 = snd->t0;
350
351 /* save old get_next and plug in special get_next function */
352 snd->after_prepend = snd->get_next;
353 snd->get_next = SND_get_zeros;
354 }
355
356 n = ROUNDBIG((snd->true_t0 - t0) * snd->sr); /* how many samples to prepend */
357
358 /* add to prepend_cnt so first sample will correspond to new t0 */
359 snd->prepend_cnt += n;
360 /* compute the true t0 which corresponds to the time of first sample */
361 snd->true_t0 -= (n / snd->sr);
362 /* make caller happy by claiming the sound now starts at exactly t0;
363 * this is always true within 0.5 samples as allowed by Nyquist. */
364 snd->t0 = t0;
365 /* nyquist_printf("sound_prepend_zeros: snd %p true_t0 %g sr %g n %d\n",
366 snd, snd->true_t0, snd->sr, n);*/
367 }
368
369
370 /* sound_array_copy -- copy an array of sounds */
371 /*
372 * NOTE: be sure to protect the result from gc!
373 */
sound_array_copy(LVAL sa)374 LVAL sound_array_copy(LVAL sa)
375 {
376 long i = getsize(sa);
377 LVAL new_sa = newvector(i);
378 xlprot1(new_sa);
379
380 while (i > 0) {
381 i--;
382 setelement(new_sa, i,
383 cvsound(sound_copy(getsound(getelement(sa, i)))));
384 }
385
386 xlpop();
387 return new_sa;
388 }
389
390
391 /* sound_copy - copy a sound structure, do reference counts */
392 /**/
sound_copy(sound_type snd)393 sound_type sound_copy(sound_type snd)
394 {
395 sound_type sndcopy;
396 falloc_sound(sndcopy, "sound_copy");
397 *sndcopy = *snd; /* copy the whole structure */
398 sndcopy->extra = NULL; /* except for the (private) extra data */
399 snd_list_ref(snd->list); /* copied a reference so fix the count */
400 /* nyquist_printf("sound_copy'd %p to %p\n", snd, sndcopy); */
401 if (snd->table) snd->table->refcount++;
402 #ifdef GC_DEBUG
403 if (sndcopy == sound_to_watch)
404 printf("sndcopy->table %x\n", sndcopy->table);
405 #endif
406 return sndcopy;
407 }
408
409
410 /* convert a sound to a wavetable, set length */
411 /**/
sound_to_table(sound_type s)412 table_type sound_to_table(sound_type s)
413 {
414 long len = (long) snd_length(s, max_table_len);
415 long tx = 0; /* table index */
416 int blocklen;
417 register double scale_factor = s->scale;
418 sound_type original_s = s;
419 table_type table; /* the new table */
420 long table_bytes; /* how big is the table */
421
422 if (s->table) {
423 s->table->refcount++;
424 return s->table;
425 }
426
427 if (len >= max_table_len) {
428 char emsg[100];
429 sprintf(emsg, "maximum table size (%d) exceeded", max_table_len);
430 xlcerror("use truncated sound for table", emsg, NIL);
431 } else if (len == 0) {
432 xlabort("table size must be greater than 0");
433 }
434
435
436 len++; /* allocate extra sample at end of table */
437 s = sound_copy(s);
438
439 /* nyquist_printf("sound_to_table: allocating table of size %d\n", len); */
440 table_bytes = table_size_in_bytes(len);
441 table = (table_type) malloc(table_bytes);
442 if (!table) xlfail("osc_init couldn't allocate memory for table");
443 table_memory += table_bytes;
444
445 table->length = (double) (len - 1);
446
447 while (len > 1) {
448 sample_block_type sampblock = sound_get_next(s, &blocklen);
449 long togo = MIN(blocklen, len);
450 long i;
451 sample_block_values_type sbufp = sampblock->samples;
452 /* nyquist_printf("in sound_to_table, sampblock = %d\n", sampblock);*/
453 for (i = 0; i < togo; i++) {
454 table->samples[tx++] = (float) (*sbufp++ * scale_factor);
455 }
456 len -= togo;
457 }
458 /* for interpolation, duplicate first sample at end of table */
459 table->samples[tx] = table->samples[0];
460 table->refcount = 2; /* one for the user, one from original_s */
461
462 sound_unref(s);
463 s = NULL;
464 original_s->table = table;
465 return table;
466 }
467
468
table_free(table_type table)469 void table_free(table_type table)
470 {
471 long len = (long) (table->length) + 1;
472 long bytes = table_size_in_bytes(len);
473 free(table);
474 table_memory -= bytes;
475 }
476
477
table_unref(table_type table)478 void table_unref(table_type table)
479 {
480 if (!table) return;
481 table->refcount--;
482 if (table->refcount <= 0) {
483 /* nyquist_printf("table refcount went to zero\n"); */
484 table_free(table);
485 }
486 }
487
488
sound_unref(sound_type snd)489 void sound_unref(sound_type snd)
490 /* note that sounds do not have ref counts, so sound_unref
491 * always frees the sound object
492 */
493 {
494 if (!snd) return;
495 snd_list_unref(snd->list);
496 table_unref(snd->table);
497 /* nyquist_printf("\t\t\t\t\tfreeing sound@%p\n", snd);*/
498 if (snd->extra) free(snd->extra);
499 ffree_sound(snd, "sound_unref");
500 }
501
502
snd_list_ref(snd_list_type list)503 void snd_list_ref(snd_list_type list)
504 {
505 list->refcnt++;
506 }
507
508
snd_list_terminate(snd_list_type snd_list)509 void snd_list_terminate(snd_list_type snd_list)
510 {
511 snd_susp_type susp = snd_list->u.next->u.susp;
512 int64_t lsc = susp->log_stop_cnt;
513 int64_t current = susp->current;
514 /* unreference the empty sample block that was allocated: */
515 sample_block_unref(snd_list->block);
516 /* use zero_block instead */
517 snd_list->block = zero_block;
518 /* either fetch more zeros or terminate now */
519 if (lsc != UNKNOWN && lsc > current) {
520 /* nyquist_printf("snd_list_terminate: lsc %d current %d\n",
521 lsc, current); */
522 susp->fetch = fetch_zeros;
523 fetch_zeros(susp, snd_list);
524 } else {
525 snd_list->block_len = max_sample_block_len;
526 snd_list->logically_stopped = true;
527 snd_list_unref(snd_list->u.next);
528 snd_list->u.next = zero_snd_list; /* be zero forever */
529 }
530 }
531
532
snd_list_unref(snd_list_type list)533 void snd_list_unref(snd_list_type list)
534 {
535 if (list == NULL) {
536 nyquist_printf("why did snd_list_unref get %p?\n", list);
537 return;
538 }
539
540 while (list && (list != zero_snd_list)) {
541 snd_list_type next = NULL;
542
543 list->refcnt--;
544 if (list->refcnt != 0) {
545 break; // the rest of the list is shared, nothing more to free
546 }
547
548 // list nodes either point to a block of samples or this is the
549 // last list node (list->block == NULL) which points to a suspension
550 // lists can also terminate at the zero_block, which is an infinite
551 // shared list (zero_block->block == zero_block) of zero samples
552 if (list->block && list->block != zero_block) {
553 /* there is a next snd_list */
554 next = list->u.next;
555 sample_block_unref(list->block);
556 } else if (list->block == NULL) { /* the next thing is the susp */
557 /* free suspension structure */
558 /* nyquist_printf("freeing susp@%p\n", list->u.susp); */
559 (*(list->u.susp->free))(list->u.susp);
560 }
561 /* if (list == list_watch)
562 printf("freeing watched snd_list %p\n", list); */
563 ffree_snd_list(list, "snd_list_unref");
564 list = next;
565 }
566 }
567
568
sample_block_ref(sample_block_type sam)569 void sample_block_ref(sample_block_type sam)
570 {
571 sam->refcnt++;
572 }
573
574
sample_block_test(sample_block_type sam,char * s)575 void sample_block_test(sample_block_type sam, char *s)
576 {
577 /* see if this block is being watched */
578 int i;
579 for (i = 0; i < blocks_to_watch_len; i++) {
580 if ((sam > (blocks_to_watch[i] - 1)) &&
581 (sam < (blocks_to_watch[i] + 1))) {
582 nyquist_printf(
583 "WOOPS! %s(0x%p) refers to a block 0x%p on the watch list!\n",
584 s, sam, blocks_to_watch[i]);
585 }
586 }
587 }
588
589
sample_block_unref(sample_block_type sam)590 void sample_block_unref(sample_block_type sam)
591 {
592 sam->refcnt--;
593 if (sam->refcnt == 0) {
594 #ifndef GCBUG
595 sample_block_test(sam, "sample_block_unref");
596 #endif
597 /* nyquist_printf("freeing sample block %p\n", sam); */
598 ffree_sample_block(sam, "sample_block_unref");
599 }
600 }
601
602
603
604 /****************************************************************************
605 * interp_style
606 * Inputs:
607 * sound_type s: The sound we are using
608 * rate_type sr: The sampling rate
609 * Result: int
610 * A small integer which is one of the symbolic values:
611 * The values are ordered, smallest to largest, as
612 * INTERP_n - none
613 * INTERP_s - scale
614 * INTERP_i - interpolated
615 * INTERP_r - ramp
616 *
617 * Notes:
618 * The sampling rate s->sr and scale factor s->scale are compared
619 * with other values exactly (no fuzz).
620 ****************************************************************************/
621
interp_style(sound_type s,rate_type sr)622 int interp_style(sound_type s, rate_type sr)
623 {
624 if (s->sr == sr)
625 { /* same sample rate */
626 return ((s->scale == 1.0) ? INTERP_n : INTERP_s);
627 } /* same sample rate */
628 else
629 if (s->sr * 10.0 > sr)
630 { /* 10x sample rate */
631 return INTERP_i;
632 } /* 10x sample rate */
633 else
634 return INTERP_r;
635 }
636
637
638 /****************************************************************************
639 * snd_sort_2
640 * Inputs:
641 * sound_type * s1_ptr:
642 * sound_type * s2_ptr:
643 * rate_type sr:
644 * Result: void
645 *
646 * Effect:
647 * If the interp_style of s1 dominates the interp_style of s2,
648 * the sound_types input are interchanged.
649 ****************************************************************************/
650
651 /* snd_sort_2 -- sort 2 arguments by interpolation method */
snd_sort_2(sound_type * s1_ptr,sound_type * s2_ptr,rate_type sr)652 void snd_sort_2(sound_type *s1_ptr, sound_type *s2_ptr, rate_type sr)
653 {
654 if (interp_style(*s1_ptr, sr) > interp_style(*s2_ptr, sr)) {
655 sound_type s = *s1_ptr;
656 *s1_ptr = *s2_ptr;
657 *s2_ptr = s;
658 }
659 }
660
661
662 /* snd_sref -- access a sound at a given time point */
663 /**/
snd_sref(sound_type s,time_type t)664 double snd_sref(sound_type s, time_type t)
665 {
666 double exact_cnt; /* how many fractional samples to scan */
667 int64_t cnt; /* how many samples to flush */
668 sample_block_type sampblock = NULL;
669 int blocklen;
670 sample_type x1, x2; /* interpolate between these samples */
671
672 /* changed true_t0 to just t0 based on comment that true_t0 is only
673 * for use by snd_prepend_zeros -RBD
674 */
675 exact_cnt = (t - s->t0) * s->sr;
676 if (exact_cnt < 0.0) return 0.0;
677
678 s = sound_copy(s); /* don't modify s, create new reader */
679 cnt = (int64_t) exact_cnt; /* rounds down */
680 exact_cnt -= cnt; /* remember fractional remainder */
681
682 /* now flush cnt samples */
683 while (cnt >= 0) {
684 sampblock = sound_get_next(s, &blocklen);
685 cnt -= blocklen;
686 if (sampblock == zero_block) {
687 sound_unref(s);
688 return 0.0;
689 }
690 }
691 /* -blocklen <= cnt <= -1 */
692
693 /* get next 2 samples and interpolate */
694 x1 = sampblock->samples[blocklen + cnt];
695 if (cnt == -1) {
696 sampblock = sound_get_next(s, &blocklen);
697 cnt -= blocklen;
698 }
699 x2 = sampblock->samples[blocklen + cnt + 1];
700 sound_unref(s); /* free the reader */
701
702 return (x1 + exact_cnt * (x2 - x1)) * s->scale;
703 }
704
705
706 /* snd_sref_inverse -- find time point corresponding to some value */
707 /**/
snd_sref_inverse(sound_type s,double val)708 double snd_sref_inverse(sound_type s, double val)
709 {
710 double exact_cnt; /* how many fractional samples to scan */
711 int i;
712 sample_block_type sampblock;
713 int blocklen;
714 sample_type x1, x2; /* interpolate between these samples */
715
716 if (val < 0) {
717 xlcerror("return 0", "negative value", cvflonum(val));
718 return 0.0;
719 }
720 s = sound_copy(s); /* don't modify s, create new reader */
721
722 x1 = 0.0F;
723 /* now flush cnt samples */
724 while (true) {
725 sampblock = sound_get_next(s, &blocklen);
726 x2 = sampblock->samples[blocklen - 1];
727 if (x2 >= val) break;
728 x1 = x2;
729 if (sampblock == zero_block) {
730 xlcerror("return 0", "too large, no inverse", cvflonum(val));
731 sound_unref(s);
732 return 0.0;
733 }
734 }
735 /* x1 = last sample of previous block,
736 sampblock contains a value larger than val
737 blocklen is the length of sampblock */
738
739 /* search for first element exceeding val - could
740 * use binary search, but maximum block size places
741 * an upper bound on how bad this can get and we
742 * search for the right block linearly anyway.
743 */
744 for (i = 0; i < blocklen && sampblock->samples[i] <= val; i++) ;
745
746 /* now i is index of element exceeding val */
747 if (i > 1) x1 = sampblock->samples[i - 1];
748 x2 = sampblock->samples[i];
749
750 /* now interpolate to get fractional part */
751 if (x2 == x1) exact_cnt = 0;
752 else exact_cnt = (val - x1) / (x2 - x1);
753
754 /* and add the sample count of x1 */
755 exact_cnt += (s->current - blocklen) + (i - 1);
756
757 /* negative counts are possible because the first x1 is at
758 * sample -1, so force the location to be at least 0
759 */
760 if (exact_cnt < 0) exact_cnt = 0;
761
762 /* compute time = t0 + count / samplerate; */
763 exact_cnt = s->t0 + exact_cnt / s->sr;
764
765 sound_unref(s); /* free the reader */
766 return exact_cnt;
767 }
768
769
snd_stop_time(sound_type s)770 time_type snd_stop_time(sound_type s)
771 {
772 if (s->stop == MAX_STOP) return MAX_STOP_TIME;
773 /* I think placing the stop time 0.5 samples later than the last
774 is to avoid rounding errors somewhere. Sounds are supposed
775 to be open-ended on the right, and I would guess s->stop
776 should be one greater than the actual number of samples.
777 Therefore, it seems that 0.5 should be 0.0 so that
778 converting back to sample count will round to s->stop.
779 I'm not changing this because it has been this way for
780 a long time and Nyquist seems to get it right. -RBD */
781 else return s->t0 + (s->stop + 0.5) / s->sr;
782 }
783
784
785 /* snd_xform -- return a sound with transformations applied */
786 /*
787 * The "logical" sound starts at snd->time and runs until some
788 * as yet unknown termination time. (There is also a possibly
789 * as yet unknown logical stop time that is irrelevant here.)
790 * The sound is clipped (zero) until snd->t0 and after snd->stop,
791 * the latter being a sample count, not a time_type.
792 * So, the "physical" sound starts at snd->t0 and runs for up to
793 * snd->stop samples (or less if the sound terminates beforehand).
794 *
795 * The snd_xform procedure operates at the "logical" level, shifting
796 * the sound from its snd->time to time. The sound is stretched as
797 * a result of setting the sample rate to sr. It is then (further)
798 * clipped between start_time and stop_time. If initial samples
799 * are clipped, the sound is shifted again so that it still starts
800 * at time. The sound is then scaled by scale.
801 *
802 * To support clipping of initial samples, the "physical" start time
803 * t0 is set to when the first unclipped sample will be returned, but
804 * the number of samples to clip is saved as a negative count. The
805 * fetch routine SND_flush is installed to flush the clipped samples
806 * at the time of the first fetch. SND_get_first is then installed
807 * for future fetches.
808 *
809 * An empty (zero) sound will be returned if all samples are clipped.
810 *
811 */
snd_xform(sound_type snd,rate_type sr,time_type time,time_type start_time,time_type stop_time,promoted_sample_type scale)812 sound_type snd_xform(sound_type snd,
813 rate_type sr,
814 time_type time,
815 time_type start_time,
816 time_type stop_time,
817 promoted_sample_type scale)
818 {
819 int64_t start_cnt, stop_cnt; /* clipping samples (sample 0 at new t0) */
820
821 /* start_cnt should reflect max of where the sound starts (t0)
822 * and the new start_time.
823 */
824 if (start_time == MIN_START_TIME) {
825 start_cnt = 0;
826 } else {
827 double new_start_cnt = ((start_time - time) * sr) + 0.5;
828 start_cnt = ((new_start_cnt > 0) ? (int64_t) new_start_cnt : 0);
829 }
830 /* if (start_cnt < -(snd->current)) start_cnt = -(snd->current); */
831
832 /* stop_cnt should reflect min of the new stop_time and the previous
833 * snd->stop.
834 */
835 if (stop_time == MAX_STOP_TIME) {
836 stop_cnt = MAX_STOP;
837 } else {
838 double new_stop_cnt = ((stop_time - time) * sr) + 0.5;
839 if (new_stop_cnt < MAX_STOP) {
840 stop_cnt = (int64_t) new_stop_cnt;
841 } else {
842 errputstr("Warning: stop count overflow in snd_xform\n");
843 stop_cnt = MAX_STOP;
844 }
845 }
846
847 if (stop_cnt > snd->stop) {
848 stop_cnt = snd->stop;
849 }
850
851 if (stop_cnt < 0 || start_cnt >= stop_cnt) {
852 snd = sound_create(NULL, time, sr, 1.0);
853 /* sound_create goes ahead and allocates a snd_list node, so
854 * we need to free it.
855 * Calling snd_list_unref here seems like the right thing, but
856 * it assumes too much structure is in place. ffree_snd_list
857 * is simpler and more direct:
858 */
859 ffree_snd_list(snd->list, "snd_xform");
860 snd->list = zero_snd_list;
861 /* nyquist_printf("snd_xform: (stop_time < t0 or start >= stop) "
862 "-> zero sound = %p\n", snd); */
863 } else {
864 snd = sound_copy(snd);
865 snd->t0 = time;
866 if (start_cnt) {
867 snd->current -= start_cnt; /* indicate flush with negative num. */
868 /* the following code assumes that SND_get_first is the
869 routine to be called to get the first samples from this
870 sound. We're going to replace it with SND_flush. First,
871 make sure that the assumption is correct:
872 */
873 if ((snd->get_next != SND_get_first) &&
874 (snd->get_next != SND_flush)) {
875 errputstr("snd_xform: SND_get_first expected\n");
876 EXIT(1);
877 }
878 /* this will flush -current samples and revert to SND_get_first */
879 snd->get_next = SND_flush;
880 stop_cnt -= start_cnt;
881 }
882 snd->stop = stop_cnt;
883 snd->sr = sr;
884 snd->scale *= (float) scale;
885 }
886 return snd;
887 }
888
889
890 /* SND_flush -- the get_next function for flushing clipped samples */
891 /*
892 * this only gets called once: it flushes -current samples (a
893 * non-real-time operation) and installs SND_get_next to return
894 * blocks normally from then on.
895 */
SND_flush(sound_type snd,int * cnt)896 sample_block_type SND_flush(sound_type snd, int *cnt)
897 {
898 int mycnt;
899 sample_block_type block = SND_get_first(snd, &mycnt);
900 /* changed from < to <= because we want to read at least the first sample */
901 while (snd->current <= 0) {
902 block = SND_get_next(snd, &mycnt);
903 }
904 /* at this point, we've read to and including the block with
905 * the first samples we want to return. If the block boundary
906 * is in the right place, we can do a minimal fixup and return:
907 */
908 if (snd->current == snd->list->block_len) {
909 *cnt = (int) snd->current; /* == snd->list->block_len */
910 /* snd->get_next = SND_get_next; -- done by SND_get_first */
911 return block;
912 } else /* snd->current < snd->list->block_len */ {
913 int64_t i;
914 sample_block_values_type from_ptr;
915 /* we have to return a partial block */
916 /* NOTE: if we had been smart, we would have had SND_get_next
917 * return a pointer to samples rather than a pointer to the
918 * block, which has a reference count. Since the caller
919 * expects a pointer to a reference count, we have to copy
920 * snd->current samples to a new block
921 */
922 snd_list_type snd_list = snd_list_create((snd_susp_type) snd->list->u.next);
923 snd_list->u.next->refcnt++;
924 falloc_sample_block(snd_list->block, "SND_flush");
925 /* now copy samples */
926 from_ptr = block->samples + snd->list->block_len - snd->current;
927 for (i = 0; i < snd->current; i++) {
928 snd_list->block->samples[i] = from_ptr[i];
929 }
930 snd_list_unref(snd->list);
931 snd->list = snd_list;
932 *cnt = (int) snd->current;
933 return snd_list->block;
934 }
935 }
936
937
938 /* SND_get_zeros -- the get_next function for prepended zeros */
939 /*
940 * when prepending zeros, we just return a pointer to the internal_zero_block
941 * and decrement the prepend_cnt until it goes to zero. Then we revert to
942 * the normal (original) get_next function.
943 *
944 */
SND_get_zeros(sound_type snd,int * cnt)945 sample_block_type SND_get_zeros(sound_type snd, int *cnt)
946 {
947 int64_t len = MIN(snd->prepend_cnt, max_sample_block_len);
948 /* stdputstr("SND_get_zeros: "); */
949 if (len < 0) {
950 char error[80];
951 sprintf(error, "SND_get_zeros snd %p len %" PRId64, snd, len);
952 xlabort(error);
953 }
954 if (len == 0) { /* we've finished prepending zeros */
955 snd->get_next = snd->after_prepend;
956 /* stdputstr("done, calling sound_get_next\n"); fflush(stdout); */
957 return sound_get_next(snd, cnt);
958 } else {
959 *cnt = (int) len;
960 snd->current += len;
961 snd->prepend_cnt -= len;
962 /* nyquist_printf("returning internal_zero_block@%p\n", internal_zero_block);
963 fflush(stdout); */
964 return internal_zero_block;
965 }
966 }
967
968
969 /****************************************************************************
970 * SND_get_next
971 * Inputs:
972 * sound_type snd: The iterator whose next block is to be computed
973 * int * cnt: Place to put count of samples returned
974 * Result: snd_list_type
975 * Pointer to the sample block computed ---------------------------+
976 * Effect: |
977 * force suspension to compute next block of samples |
978 * |
979 * Here's the protocol for using this and related functions: |
980 * Every client (sample reader) has a private sound_type (an iterator), |
981 * and the sound_type's 'list' field points to a header (of type |
982 * snd_list_type). The header in turn points to a block of samples. |
983 * |
984 * +---------------------------------------+
985 * |
986 * |
987 * | sample_block_type
988 * (snd) V +---+--+--+--+--+--+--+-...-+--+
989 * sound_type: snd_list_type +-->|ref| | | | |//|//| |//|
990 * +---------+ +----------+ | +---+--+--+--+--+--+--+-...-+--+
991 * | list +------->| block +--+ ^
992 * +---------+ +----------+ :
993 * | t0 | | block_len|....................:
994 * +---------+ +----------+
995 * | sr | | refcnt |
996 * +---------+ +-+--------+
997 * | current | | next +---->... Note: the union u
998 * +---------+ |u|........| snd_list_type points to only one
999 * | rate | | | susp +---->... of the indicated
1000 * +---------+ +-+--------+ susp_type types
1001 * | scalse | |log_stop |
1002 * +---------+ +----------+
1003 * | lsc |
1004 * +---------+
1005 * |get_next +-----> SND_get_next()
1006 * +---------+
1007 *
1008 * The sound_type keeps track of where the next sample block will
1009 * come from. The field 'current' is the number of the first sample of
1010 * the next block to be returned, where sample numbers start
1011 * at zero. The normal fetch procedure is this one, although special
1012 * cases may generate special block generators, e.g., CONST does not need
1013 * to allocate and refill a block and can reuse the same block over and
1014 * over again, so it may have its own fetch procedure. This is the
1015 * general fetch procedure, which assumes that the generator function
1016 * actually produces a slightly different value for each sample.
1017 *
1018 * The distinguishing characteristic of whether the 'u' field is to be
1019 * interpreted as 'next', a link to the next list element, or 'susp', a
1020 * reference to the suspension for generating a new sample block, is
1021 * whether the 'block' parameter is NULL or not. If it is NULL, then
1022 * u.susp tells how to generate the block; if it is not NULL, u.next is
1023 * a pointer to the next sound block in the list.
1024 *
1025 * When the 'block' pointer is NULL, we create a block of samples, and
1026 * create a new sound list element which follows it which has a NULL
1027 * 'block' pointer; the 'u' field of the current list element is now
1028 * interpreted as 'u.next'.
1029 *
1030 * The client calls SND_get_next to get a pointer to a block of samples.
1031 * The count of samples generated is returned via a ref parameter, and
1032 * SND_get_next will not be called again until this set is exhausted.
1033 *
1034 * The next time SND_get_next is called, it knows that the sample block
1035 * has been exhausted. It releases its reference to the block (and if
1036 * that was the last reference, frees the block to the block allocation
1037 * pool), allocates a new block from the block pool, and proceeds to
1038 * fill it with samples.
1039 *
1040 * Note that as an optimization, if the refcnt field goes to 0 it
1041 * could immediately re-use the block without freeing back to the block
1042 * pool and reallocating it.
1043 *
1044 * Because of the way we handle sound sample blocks, the sound sample blocks
1045 * themselves are ref-counted, so freeing the snd_list_type may not free
1046 * the sample block it references. At the level of this procedure, that
1047 * is transparently handled by the snd_list_unref function.
1048 *
1049 * Logical stop:
1050 *
1051 * Logical stop is handled by several mechanisms. The /intrinsic/ logical
1052 * stop is an immutable property of the signal, and is determined by the
1053 * specification in the algorithm description file. When it is encountered,
1054 * the 'logically_stopped' flag of the snd_list_node is set.
1055 * The generators guarantee that the first time this is encountered, it
1056 * will always be constructed so that the first sample of the block it
1057 * references is the logical stop time.
1058 *
1059 * In addition, the client may have set the /explicit logical stop time/ of
1060 * the iterator (e.g., in nyquist, the (set-logical-stop sound time) call copies
1061 * the sound, altering its logical stop). The logical stop time, when set
1062 * in this way, causes the logical_stop_cnt ('lsc' in the above diagram)
1063 * to be set to the count of the last sample to be generated before the
1064 * <logical stop time. This will guarantee that the sound will indicate that
1065 * it has reached its logical stop time when the indicated sample is
1066 * generated.
1067 ****************************************************************************/
1068
1069 /* for debugging */
1070 void add_s1_s2_nn_fetch(snd_susp_type a_susp, snd_list_type snd_list);
1071
1072 /* SND_get_first -- the standard fn to get a block, after returning
1073 * the first block, plug in SND_get_next for successive blocks
1074 */
SND_get_first(sound_type snd,int * cnt)1075 sample_block_type SND_get_first(sound_type snd, int *cnt)
1076 {
1077 snd_list_type snd_list = snd->list;
1078 /*
1079 * If there is not a block of samples, we need to generate one.
1080 */
1081 if (snd_list->block == NULL) {
1082 /*
1083 * Call the 'fetch' method for this sound_type to generate
1084 * a new block of samples.
1085 */
1086 snd_susp_type susp = snd_list->u.susp;
1087
1088 snd_list->u.next = snd_list_create(susp);
1089 snd_list->block = internal_zero_block;
1090 /* nyquist_printf("SND_get_first: susp->fetch %p\n",
1091 susp->fetch); */
1092 assert(susp->log_stop_cnt == UNKNOWN || susp->log_stop_cnt >= 0);
1093 (*(susp->fetch))(susp, snd_list);
1094 #ifdef GC_DEBUG
1095 snd_list_debug(snd_list, "SND_get_first");
1096 #endif
1097 /* nyquist_printf("SND_get_first: snd_list %p, block %p, length %d\n",
1098 snd_list, snd_list->block, snd_list->block_len); */
1099 }
1100 if ((snd->logical_stop_cnt == UNKNOWN) && snd_list->logically_stopped) {
1101 /* nyquist_printf("SND_get_first/next: snd %p logically stopped at %d\n",
1102 snd, snd->current); */
1103 snd->logical_stop_cnt = snd->current;
1104 }
1105
1106 /* see if clipping needs to be applied */
1107 if (snd->current + snd_list->block_len > snd->stop) {
1108 /* need to clip: is clip on a block boundary? */
1109 if (snd->current == snd->stop) {
1110 /* block boundary: replace with zero sound */
1111 snd->list = zero_snd_list;
1112 snd_list_unref(snd_list);
1113 // the idea here is that we have reached snd->stop, which
1114 // means the next samples have to be zero, but we are reading
1115 // from the middle of a block of samples. Maybe, for example,
1116 // snd was constructed by snd_xform that imposed a new stop
1117 // time. Since we haven't read the next sample, we can take
1118 // care of this by just creating a new snd_list with a shorter
1119 // block_len to take whatever samples we need before stop, then
1120 // link ot zero_snd_list so that subsequent samples are zero.
1121 // However, if we actually start reading zeros from zero_snd_list,
1122 // the test above for > snd->stop will bring us back here. We
1123 // ignore these cases just below by testing if the current list
1124 // is the zero_snd_list. If so, we're just reading zeros, we're
1125 // past the stop time, and we can just keep reading zeros, so
1126 // do nothing.
1127 } else if (snd->list != zero_snd_list) {
1128 /* not a block boundary: build new list */
1129 snd->list = snd_list_create((snd_susp_type) zero_snd_list);
1130 snd->list->block_len = (short) (snd->stop - snd->current);
1131 snd->list->block = snd_list->block;
1132 snd->list->block->refcnt++;
1133 snd_list_unref(snd_list);
1134 }
1135 snd_list = snd->list; /* used below to return block ptr */
1136 }
1137
1138 *cnt = snd_list->block_len;
1139 assert(snd_list->block_len >= 0);
1140 /* this should never happen */
1141 if (*cnt == 0) {
1142 stdputstr("SND_get_first returned 0 samples\n");
1143 #if DEBUG_MEM
1144 dbg_mem_print("snd_list info:", snd_list);
1145 dbg_mem_print("block info:", snd_list->block);
1146 #endif
1147 sound_print_tree(snd);
1148 stdputstr("It is possible that you created a recursive sound\n");
1149 stdputstr("using something like: (SETF X (SEQ (SOUND X) ...))\n");
1150 stdputstr("Nyquist aborts from non-recoverable error\n");
1151 abort();
1152 }
1153 snd->current += snd_list->block_len; /* count how many we read */
1154 snd->get_next = SND_get_next;
1155 return snd_list->block;
1156 }
1157
1158
SND_get_next(sound_type snd,int * cnt)1159 sample_block_type SND_get_next(sound_type snd, int *cnt)
1160 {
1161 snd_list_type snd_list = snd->list;
1162 /*
1163 * SND_get_next is installed by SND_get_first, so we know
1164 * when we are called that we are done with the current block
1165 * of samples, so free it now.
1166 */
1167 snd_list_type cur = snd_list;
1168 snd->list = snd_list = cur->u.next;
1169 snd_list_ref(snd_list);
1170 snd_list_unref(cur); /* release the reference to the current block */
1171
1172 /* now that we've deallocated, we can use SND_get_first to finish the job */
1173 return SND_get_first(snd, cnt);
1174 }
1175
1176
1177
1178 /****************************************************************************
1179 * make_zero_block
1180 * Inputs:
1181 *
1182 * Result:
1183 *
1184 * Effect:
1185 *
1186 ****************************************************************************/
1187
make_zero_block(void)1188 sample_block_type make_zero_block(void)
1189 {
1190 sample_block_type zb;
1191 int i;
1192
1193 falloc_sample_block(zb, "make_zero_block");
1194 /* leave room for lots more references before overflow,
1195 but set the count high so that even a large number of
1196 dereferences will not lead to a deallocation */
1197 zb->refcnt = 0x6FFFFFFF;
1198
1199 for (i = 0; i < max_sample_block_len; i++)
1200 { /* fill with zeros */
1201 zb->samples[i] = 0.0F;
1202 } /* fill with zeros */
1203 return zb;
1204 }
1205
1206
1207 /* min_cnt -- help compute the logical stop or terminate as minimum */
1208 /*
1209 * take the sound (which has just logically stopped or terminated at
1210 * current sample) and
1211 * convert the stop sample into the equivalent sample count as produced by
1212 * susp (which may have a different sample rate). If the count is less than
1213 * the current *cnt_ptr, overwrite cnt_ptr with a new minimum. By calling
1214 * this when each of S1, S2, ... Sn reach their logical stop or termiate
1215 * points, *cnt_ptr will end up with the minimum stop count, which is what
1216 * we want. NOTE: the logical stop time and terminate for signal addition
1217 * should be the MAX of logical stop times of arguments, so this routine
1218 * would not be used.
1219 */
min_cnt(int64_t * cnt_ptr,sound_type sound,snd_susp_type susp,long cnt)1220 void min_cnt(int64_t *cnt_ptr, sound_type sound, snd_susp_type susp, long cnt)
1221 {
1222 int64_t c = ROUNDBIG((((sound->current - cnt) / sound->sr + sound->t0) - susp->t0) *
1223 susp->sr);
1224 /* if *cnt_ptr is uninitialized, just plug in c, otherwise compute min */
1225 if ((*cnt_ptr == UNKNOWN) || (*cnt_ptr > c)) {
1226 /* nyquist_printf("min_cnt %p: new count is %d\n", susp, c);*/
1227 /* if (c == 0) sound_print_tree(printing_this_sound);*/
1228 *cnt_ptr = c;
1229 }
1230 }
1231
1232
1233
1234 /****************************************************************************
1235 * sound_init
1236 * Result: void
1237 *
1238 * Effect:
1239 * Module initialization
1240 * Allocates the 'zero block', the infinitely linked block of
1241 * 0-valued sounds. This is referenced by a list element which
1242 * refers to itself.
1243 ****************************************************************************/
1244
sound_init(void)1245 void sound_init(void)
1246 {
1247 zero_block = make_zero_block();
1248 internal_zero_block = make_zero_block();
1249
1250 falloc_snd_list(zero_snd_list, "sound_init");
1251
1252 zero_snd_list->block = zero_block;
1253 zero_snd_list->u.next = zero_snd_list;
1254 zero_snd_list->refcnt = 2;
1255 zero_snd_list->block_len = max_sample_block_len;
1256 zero_snd_list->logically_stopped = true;
1257 #ifdef GC_DEBUG
1258 { long s;
1259 stdputstr("sound_to_watch: ");
1260 scanf("%p", &s);
1261 watch_sound((sound_type) s);
1262 }
1263 #endif
1264 sound_desc = create_desc("SOUND", sound_xlfree, sound_xlprint,
1265 sound_xlsave, sound_xlrestore, sound_xlmark);
1266 }
1267
1268
1269 /* sound_scale -- copy and change scale factor of a sound */
1270 /**/
sound_scale(double factor,sound_type snd)1271 sound_type sound_scale(double factor, sound_type snd)
1272 {
1273 sound_type sndcopy = sound_copy(snd);
1274 sndcopy->scale *= (float) factor;
1275 return sndcopy;
1276 }
1277
1278
1279
1280
1281 /****************************************************************************
1282 * set_logical_stop_time
1283 * Inputs:
1284 * sound_type sound: The sound for which the logical stop time is
1285 * being set
1286 * time_type when: The logical stop time, expressed as an absolute
1287 * time.
1288 * Result: void
1289 *
1290 * Effect:
1291 * Converts the time 'when' into a count of samples.
1292 ****************************************************************************/
1293
set_logical_stop_time(sound_type sound,time_type when)1294 void set_logical_stop_time(sound_type sound, time_type when)
1295 {
1296 /*
1297 'when' is an absolute time. The number of samples to
1298 be generated is the number of samples between 't0' and
1299 'when'.
1300
1301 -----------+---+---+---+---+---+---+---+---+---+
1302 | |
1303 t0 when
1304 */
1305 int64_t n = ROUNDBIG((when - sound->t0) * sound->sr);
1306 if (n < 0) {
1307 xlcerror("retain the current logical stop",
1308 "logical stop sample count is negative", NIL);
1309 } else {
1310 sound->logical_stop_cnt = n;
1311 }
1312 }
1313
1314
1315
1316
1317 /* for debugging
1318 sound_type printing_this_sound = NULL;
1319 void ((**watch_me)()) = NULL;
1320
1321
1322 void set_watch(where)
1323 void ((**where)());
1324 {
1325 if (watch_me == NULL) {
1326 watch_me = where;
1327 nyquist_printf("set_watch: watch_me = %p\n", watch_me);
1328 }
1329 }
1330 */
1331
1332 /*
1333 * additional routines
1334 */
1335
1336 /* snd_list_len - for debugging: how many sample blocks held? */
snd_list_len(void * inst)1337 long snd_list_len(void *inst)
1338 {
1339 int i = 0;
1340 sound_type snd = (sound_type) inst;
1341 snd_list_type list = snd->list;
1342 while (list->block && list->block != zero_block && list->block_len != 0) {
1343 i++;
1344 list = list->u.next;
1345 }
1346 return i;
1347 }
1348
1349
1350 /* sound_print - implement SND-PRINT, based on sound_save in sndwritepa.c */
1351 /**/
sound_print(snd_expr,n)1352 void sound_print(snd_expr, n)
1353 LVAL snd_expr;
1354 long n;
1355 {
1356 LVAL result;
1357
1358 result = xleval(snd_expr);
1359 /* BE CAREFUL - DO NOT ALLOW GC TO RUN WHILE RESULT IS UNPROTECTED */
1360 if (vectorp(result)) {
1361 /* make sure all elements are of type a_sound */
1362 long i = getsize(result);
1363 while (i > 0) {
1364 i--;
1365 if (!exttypep(getelement(result, i), a_sound)) {
1366 xlerror("SND-PRINT: array has non-sound element",
1367 result);
1368 }
1369 }
1370 sound_print_array(result, n);
1371 } else if (soundp(result)) {
1372 sound_print_sound(result, n);
1373 } else {
1374 xlprot1(result);
1375 xlerror("sound_print: expression did not return a sound",
1376 result);
1377 xlpop();
1378 }
1379 }
1380
1381
1382 /* sound_print_sound - implements SND-PRINT for mono signal */
1383 /**/
sound_print_sound(LVAL s_as_lval,long n)1384 void sound_print_sound(LVAL s_as_lval, long n)
1385 {
1386 int ntotal = 0;
1387 sound_type s;
1388 int blocklen;
1389 sample_block_type sampblock;
1390
1391 /* for debugging
1392 printing_this_sound = s;
1393 */
1394
1395 xlprot1(s_as_lval);
1396 s = sound_copy(getsound(s_as_lval));
1397 s_as_lval = cvsound(s); /* destroys our reference to original */
1398
1399 nyquist_printf("SND-PRINT: start at time %g\n", s->t0);
1400
1401 while (ntotal < n) {
1402 if (s->logical_stop_cnt != UNKNOWN) {
1403 nyquist_printf("logical stop time (in samples): %d ",
1404 (int)s->logical_stop_cnt);
1405 }
1406 sound_print_tree(s);
1407 sampblock = sound_get_next(s, &blocklen);
1408 if (sampblock == zero_block || blocklen == 0) {
1409 break;
1410 }
1411 print_sample_block_type("SND-PRINT", sampblock,
1412 MIN(blocklen, n - ntotal));
1413 ntotal += blocklen;
1414 }
1415 nyquist_printf("total samples: %d\n", ntotal);
1416 xlpop();
1417 }
1418
1419
sound_print_array(LVAL sa,long n)1420 void sound_print_array(LVAL sa, long n)
1421 {
1422 int blocklen;
1423 long i, chans;
1424 LVAL sa_copy;
1425 long upper = 0;
1426 sample_block_type sampblock;
1427 time_type t0, tmax;
1428
1429 chans = getsize(sa);
1430 if (chans == 0) {
1431 stdputstr("SND-PRINT: 0 channels!\n");
1432 return;
1433 }
1434
1435 xlprot1(sa);
1436 sa_copy = newvector(chans);
1437 xlprot1(sa_copy);
1438
1439 /* To be non-destructive, copy sounds from sa to sa_copy. */
1440 for (i = 0; i < chans; i++) {
1441 sound_type s = getsound(getelement(sa, i));
1442 setelement(sa_copy, i, cvsound(sound_copy(s)));
1443 }
1444 /* If sa and sounds in sa are not accessible, we do not want to retain
1445 * them because they will accumulate the computed samples.
1446 */
1447 sa = sa_copy; /* destroy original reference to (maybe) allow GC */
1448
1449 /* take care of prepending zeros if necessary */
1450 t0 = tmax = (getsound(getelement(sa, 0)))->t0;
1451 for (i = 1; i < chans; i++) {
1452 sound_type s = getsound(getelement(sa, i));
1453 t0 = MIN(s->t0, t0);
1454 tmax = MAX(s->t0, tmax);
1455 }
1456
1457 /* if necessary, prepend zeros */
1458 if (t0 != tmax) {
1459 stdputstr("prepending zeros to channels: ");
1460 for (i = 0; i < chans; i++) {
1461 sound_type s = getsound(getelement(sa, i));
1462 if (t0 < s->t0) {
1463 nyquist_printf(" %d ", (int)i);
1464 sound_prepend_zeros(s, t0);
1465 }
1466 }
1467 stdputstr("\n");
1468 }
1469
1470 nyquist_printf("SND-PRINT: start at time %g\n", t0);
1471
1472 while (upper < n) {
1473 int i;
1474 boolean done = true;
1475 for (i = 0; i < chans; i++) {
1476 sound_type s = getsound(getelement(sa, i));
1477 int64_t current = -1; /* always get first block */
1478 while (current < upper) {
1479 sampblock = sound_get_next(s, &blocklen);
1480 if (sampblock != zero_block && blocklen != 0) {
1481 done = false;
1482 }
1483 current = s->current - blocklen;
1484 nyquist_printf("chan %d current %d:\n", i, (int)current);
1485 print_sample_block_type("SND-PRINT", sampblock,
1486 (int) MIN(blocklen, n - current));
1487 current = s->current;
1488 upper = (long) MAX(upper, current);
1489 }
1490 }
1491 if (done) break;
1492 }
1493 nyquist_printf("total: %d samples x %d channels\n",
1494 (int)upper, (int)chans);
1495 xlpopn(2); // sa and sa_copy
1496 }
1497
1498
1499 /* sound_play -- compute sound, do not retain samples */
1500 /*
1501 * NOTE: we want the capability of computing a sound without
1502 * retaining samples. This requires that no references to
1503 * the sound exist, but if the sound is passed as an argument,
1504 * the argument stack will have a reference. So, we pass in
1505 * an expression that evaluates to the sound we want. The
1506 * expression is eval'd, the result copied (in case the
1507 * expression was a sound or a global variable and we really
1508 * want to preserve the sound), and then GC will
1509 * get rid of the original if there really are no other
1510 * references.
1511 */
1512
sound_play(snd_expr)1513 int64_t sound_play(snd_expr)
1514 LVAL snd_expr;
1515 {
1516 int64_t ntotal;
1517 int blocklen;
1518 sample_block_type sampblock;
1519 LVAL result;
1520 sound_type s;
1521
1522 xlsave1(result);
1523 result = xleval(snd_expr);
1524 if (!exttypep(result, a_sound)) {
1525 xlerror("SND-PLAY: expression did not return a sound",
1526 result);
1527 }
1528
1529 ntotal = 0;
1530 /* if snd_expr was simply a symbol, then result now points to
1531 a shared sound_node. If we read samples from it, then
1532 the sound bound to the symbol will be destroyed, so
1533 copy it first. If snd_expr was a real expression that
1534 computed a new value, then the next garbage collection
1535 will reclaim the sound_node.
1536 */
1537 s = sound_copy(getsound(result));
1538 result = cvsound(s);
1539
1540 while (1) {
1541 #ifdef OSC
1542 if (nosc_enabled) nosc_poll();
1543 #endif
1544 sampblock = sound_get_next(s, &blocklen);
1545 if (sampblock == zero_block || blocklen == 0) {
1546 break;
1547 }
1548 /* print_sample_block_type("sound_play", sampblock, blocklen); */
1549 ntotal += blocklen;
1550 }
1551 nyquist_printf("total samples: %" PRId64 "\n", ntotal);
1552 xlpop();
1553 return ntotal;
1554 }
1555
1556
1557 /* sound_print_tree -- print a tree version of sound structure */
1558 /**/
sound_print_tree(snd)1559 void sound_print_tree(snd)
1560 sound_type snd;
1561 {
1562 /* nyquist_printf("sample_block_free %p\n", sample_block_free);*/
1563 nyquist_printf("SOUND PRINT TREE of %p\n", snd);
1564 sound_print_tree_1(snd, 0);
1565 }
1566
1567
indent(int n)1568 void indent(int n)
1569 {
1570 while (n-- > 0) stdputstr(" ");
1571 }
1572
1573
sound_print_tree_1(snd,n)1574 void sound_print_tree_1(snd, n)
1575 sound_type snd;
1576 int n;
1577 {
1578 int i;
1579 snd_list_type snd_list;
1580 if (n > 100) {
1581 stdputstr("... (skipping remainder of sound)\n");
1582 return;
1583 }
1584 if (!snd) {
1585 stdputstr("\n");
1586 return;
1587 }
1588 nyquist_printf("sound_type@%p(%s@%p)t0 "
1589 "%g stop %d sr %g lsc %d scale %g pc %d",
1590 snd,
1591 (snd->get_next == SND_get_next ? "SND_get_next" :
1592 (snd->get_next == SND_get_first ? "SND_get_first" : "?")),
1593 snd->get_next, snd->t0, (int)snd->stop, snd->sr,
1594 (int)snd->logical_stop_cnt, snd->scale,
1595 (int)snd->prepend_cnt);
1596 snd_list = snd->list;
1597 nyquist_printf("->snd_list@%p", snd_list);
1598 if (snd_list == zero_snd_list) {
1599 stdputstr(" = zero_snd_list\n");
1600 return;
1601 }
1602 for (i = 0; ; i++) {
1603 if (snd_list == zero_snd_list) {
1604 if (i > 1) nyquist_printf(" (skipping %d) ", i-1);
1605 stdputstr("->zero_snd_list\n");
1606 return;
1607 }
1608 if (!snd_list->block) {
1609 if (i > 0) nyquist_printf(" (skipping %d) ", i);
1610 stdputstr("->\n");
1611 indent(n + 2);
1612
1613 nyquist_printf("susp@%p(%s)toss_cnt %d "
1614 "current %d lsc %d sr %g t0 %g %p\n",
1615 snd_list->u.susp, snd_list->u.susp->name,
1616 (int)snd_list->u.susp->toss_cnt,
1617 (int)snd_list->u.susp->current,
1618 (int)snd_list->u.susp->log_stop_cnt,
1619 snd_list->u.susp->sr,
1620 snd_list->u.susp->t0, snd_list);
1621 susp_print_tree(snd_list->u.susp, n + 4);
1622 return;
1623 }
1624 snd_list = snd_list->u.next;
1625 }
1626 }
1627
1628
1629 /* mark_audio_time -- record the current playback time
1630 *
1631 * The global variable *audio-markers* is treated as a list.
1632 * When the user types ^Q, this function pushes the current
1633 * playback time onto the list
1634 */
mark_audio_time()1635 void mark_audio_time()
1636 {
1637 double playback_time = sound_frames / sound_srate - sound_latency;
1638 LVAL time_node = cvflonum(playback_time);
1639 setvalue(s_audio_markers, cons(time_node, getvalue(s_audio_markers)));
1640 gprintf(TRANS, " %g ", playback_time);
1641 fflush(stdout);
1642 }
1643
1644
1645 /* compute constants p1 and p2:
1646 pitchconvert(0) * 2 = pitchconvert(12) - octaves
1647 exp(p2) * 2 = exp(12 * p1 + p2)
1648 2 = exp(12 * p1)
1649 log(2) = 12 * p1
1650
1651 p1 = log(2.0)/12;
1652
1653 pitchconvert(69) gives 440Hz
1654 exp(69 * p1 + p2) = 440
1655 69 * p1 + p2 = log(440)
1656
1657 p2 = log(440.0) - (69 * p1);
1658 */
1659
1660 #define p1 0.0577622650466621
1661 #define p2 2.1011784386926213
1662
1663
hz_to_step(double hz)1664 double hz_to_step(double hz)
1665 {
1666 return (log(hz) - p2) / p1;
1667 }
1668
1669
step_to_hz(double steps)1670 double step_to_hz(double steps)
1671 {
1672 return exp(steps * p1 + p2);
1673 }
1674
1675
1676 /*
1677 * from old stuff...
1678 */
1679
sound_xlfree(void * s)1680 static void sound_xlfree(void *s)
1681 {
1682 sound_unref((sound_type)s);
1683 }
1684
1685
sound_xlprint(LVAL fptr,void * s)1686 static void sound_xlprint(LVAL fptr, void *s)
1687 {
1688 /* the type cast from s to LVAL is OK because
1689 * putatm does not dereference the 3rd parameter */
1690 putatm(fptr, "Sound", (LVAL) s);
1691 }
1692
1693
sound_xlsave(FILE * fp,void * s)1694 static void sound_xlsave(FILE *fp, void *s)
1695 {
1696 stdputstr("sound_save called\n");
1697 }
1698
1699
sound_xlrestore(FILE * fp)1700 static unsigned char *sound_xlrestore(FILE *fp)
1701 {
1702 stdputstr("sound_restore called\n");
1703 return NULL;
1704 }
1705
1706
1707 /* sound_xlmark -- mark LVAL nodes reachable from this sound */
1708 /**/
sound_xlmark(void * a_sound)1709 void sound_xlmark(void *a_sound)
1710 {
1711 sound_type s = (sound_type) a_sound;
1712 snd_list_type snd_list;
1713 long counter = 0;
1714 #ifdef TRACESNDGC
1715 nyquist_printf("sound_xlmark(%p)\n", s);
1716 #endif
1717 if (!s) return; /* pointers to sounds are sometimes NULL */
1718 snd_list = s->list;
1719 while (snd_list->block != NULL) {
1720 if (snd_list == zero_snd_list) {
1721 #ifdef TRACESNDGC
1722 stdputstr(" terminates at zero_snd_list\n");
1723 #endif
1724 return;
1725 } else if (counter > max_sample_blocks) {
1726 /* exceded maximum length of sound in memory */
1727 } else if (counter > 1000000) {
1728 stdputstr("You created a recursive sound! This is a Nyquist bug.\n");
1729 stdputstr("The only known way to do this is by a SETF on a\n");
1730 stdputstr("local variable or parameter that is being passed to\n");
1731 stdputstr("SEQ or SEQREP. The garbage collector assumes that\n");
1732 stdputstr("sounds are not recursive or circular, and follows\n");
1733 stdputstr("sounds to their end. After following 1M nodes,\n");
1734 stdputstr("I'm pretty sure that there is a\n");
1735 stdputstr("cycle here, but since this is a bug, I cannot promise\n");
1736 stdputstr("to recover. Prepare to crash. If you cannot locate\n");
1737 stdputstr("the cause of this, contact the author -RBD.\n");
1738 }
1739 snd_list = snd_list->u.next;
1740 counter++;
1741 }
1742 if (snd_list->u.susp->mark) {
1743 #ifdef TRACESNDGC
1744 nyquist_printf(" found susp (%s) at %p with mark method\n",
1745 snd_list->u.susp->name, snd_list->u.susp);
1746 #endif
1747 (*(snd_list->u.susp->mark))(snd_list->u.susp);
1748 } else {
1749 #ifdef TRACESNDGC
1750 nyquist_printf(" no mark method on susp %p (%s)\n",
1751 snd_list->u.susp, snd_list->u.susp->name);
1752 #endif
1753 }
1754 }
1755
1756
sound_symbols()1757 void sound_symbols()
1758 {
1759 a_sound = xlenter("SOUND");
1760 s_audio_markers = xlenter("*AUDIO-MARKERS*");
1761 setvalue(s_audio_markers, NIL);
1762 }
1763
1764
1765 /* The SOUND Type: */
1766
1767
soundp(LVAL s)1768 boolean soundp(LVAL s)
1769 {
1770 return (exttypep(s, a_sound));
1771 }
1772
1773
1774 /* sound_zero - create and return a zero that terminates now */
1775 /**/
sound_zero(time_type t0,rate_type sr)1776 sound_type sound_zero(time_type t0,rate_type sr)
1777 {
1778 sound_type sound;
1779 falloc_sound(sound, "sound_zero");
1780
1781 sound->get_next = SND_get_first;
1782 sound->list = zero_snd_list;
1783 sound->logical_stop_cnt = sound->current = 0;
1784 sound->true_t0 = sound->t0 = sound->time = t0;
1785 sound->stop = MAX_STOP;
1786 sound->sr = sr;
1787 sound->scale = 1.0F;
1788 sound->table = NULL;
1789 sound->extra = NULL;
1790
1791 return sound;
1792 }
1793
1794
cvsound(sound_type s)1795 LVAL cvsound(sound_type s)
1796 {
1797 /* nyquist_printf("cvsound(%p)\n", s);*/
1798 return (cvextern(sound_desc, (unsigned char *) s));
1799 }
1800
1801