/* sound.c -- nyquist sound data type */ /* CHANGE LOG * -------------------------------------------------------------------- * 28Apr03 dm changes for portability and fix compiler warnings */ /* define size_t: */ #ifdef UNIX #include "sys/types.h" #endif #include #include "xlisp.h" #include "sound.h" #include "falloc.h" #include "samples.h" #include "extern.h" #include "debug.h" /* #define GC_DEBUG */ #ifdef GC_DEBUG sound_type sound_to_watch; #endif /* #define SNAPSHOTS */ long table_memory; sample_block_type zero_block; sample_block_type internal_zero_block; snd_list_type zero_snd_list; xtype_desc sound_desc; LVAL a_sound; static void sound_xlfree(); static void sound_xlprint(); static void sound_xlsave(); static unsigned char *sound_xlrestore(); void sound_print_array(LVAL sa, long n); void sound_print_sound(sound_type s, long n); void sample_block_unref(sample_block_type sam); #ifdef SNAPSHOTS boolean sound_created_flag = false; #endif /* xlbadsr - report a "bad combination of sample rates" error */ LVAL snd_badsr(void) { xlfail("bad combination of sample rates"); return NIL; /* never happens */ } /* compute-phase - given a phase in radians, a wavetable specified as * the nominal pitch (in half steps), the table length, and the sample * rate, compute the sample number corresponding to the phase. This * routine makes it easy to initialize the table pointer at the beginning * of various oscillator implementations in Fugue. Note that the table * may represent several periods, in which case phase 360 is not the same * as 0. Also note that the phase increment is also computed and returned * through incr_ptr. */ double compute_phase(phase, key, n, srate, new_srate, freq, incr_ptr) double phase; /* phase in degrees (depends on ANGLEBASE) */ double key; /* the semitone number of the table played at srate */ long n; /* number of samples */ double srate; /* the sample rate of the table */ double new_srate; /* sample rate of the result */ double freq; /* the desired frequency */ double *incr_ptr; /* the sample increment */ { double period = 1.0 / step_to_hz(key); /* convert phase to sample units */ phase = srate * period * (phase / (double) ANGLEBASE); /* phase is now in sample units; if phase is less than zero, then increase it by some number of sLength's to make it positive: */ if (phase < 0) phase += (((int) ((-phase) / n)) + 1) * n; /* if phase is longer than the sample length, wrap it by subtracting the integer part of the division by sLength: */ if (phase > n) phase -= ((int) (phase / n)) * n; /* Now figure the phase increment: to reproduce original pitch required incr = srate / new_srate. To get the new frequency, scale by freq / nominal_freq = freq * period: */ *incr_ptr = (srate / new_srate) * freq * period; return phase; } #ifndef GCBUG snd_list_type gcbug_snd_list = 0; long blocks_to_watch_len = 0; sample_block_type blocks_to_watch[blocks_to_watch_max]; void block_watch(long sample_block) { if (blocks_to_watch_len >= blocks_to_watch_max) { stdputstr("block_watch - no more space to save pointers\n"); return; } blocks_to_watch[blocks_to_watch_len++] = (sample_block_type) sample_block; nyquist_printf("block_watch - added %d = %x\n", (int)sample_block, (int)sample_block); } /* fetch_zeros -- the fetch function for appended zeros */ /* * zeros are appended when the logical stop time exceeds the * (physical) terminate time. This fetch function is installed * by snd_list_terminate(). When appending zeros, we just return * a pointer to the internal_zero_block and increment current until * it reaches log_stop_cnt. Then we call snd_list_terminate() to * finish off the sound list. */ void fetch_zeros(snd_susp_type susp, snd_list_type snd_list) { int len = MIN(susp->log_stop_cnt - susp->current, max_sample_block_len); /* nyquist_printf("fetch_zeros, lsc %d current %d len %d\n", susp->log_stop_cnt, susp->current, len); */ if (len < 0) { char error[80]; sprintf(error, "fetch_zeros susp %p (%s) len %d", susp, susp->name, len); xlabort(error); } if (len == 0) { /* we've reached the logical stop time */ /* nyquist_printf("fetch_zeros: reached the logical stop in %s cnt %d\n", susp->name, susp->log_stop_cnt); */ snd_list_terminate(snd_list); } else { snd_list->block_len = len; susp->current += len; } } /* sound_nth_block - fetch the address of the nth sample block of a sound */ /* * NOTE: intended to be called from lisp. Lisp can then call block_watch * to keep an eye on the block. */ long sound_nth_block(sound_type snd, long n) { long i; snd_list_type snd_list = snd->list; for (i = 0; i < n; i++) { if (i == 1) { gcbug_snd_list = snd_list; nyquist_printf("gcbug_snd_list = 0x%p\n", gcbug_snd_list); } if (!snd_list->block) return 0; snd_list = snd_list->u.next; } if (snd_list->block) return (long) snd_list->block; else return 0; } #endif /**************************************************************************** * snd_list_create * Inputs: * snd_susp_type susp: A reference to the suspension * Result: snd_list_type * A newly-created sound list type * Effect: * Allocates and initializes a snd_list node: * block refcnt block_len susp logically_stopped * +--------+--------+-------+-------+---+ * |////////| 1 | 0 | susp | F | * +--------+--------+-------+-------+---+ ****************************************************************************/ /* snd_list_create -- alloc and initialize a snd_list node */ /**/ snd_list_type snd_list_create(snd_susp_type susp) { snd_list_type snd_list; falloc_snd_list(snd_list, "snd_list_create"); snd_list->block = NULL; /* no block of samples */ snd_list->u.susp = susp; /* point to suspension */ snd_list->refcnt = 1; /* one ref */ snd_list->block_len = 0; /* no samples */ snd_list->logically_stopped = false;/* not stopped */ /* nyquist_printf("snd_list_create => %p\n", snd_list);*/ return snd_list; } /**************************************************************************** * sound_create * Inputs: * snd_susp_type susp: The suspension block to be used for this sound * time_type t0: The initial time for this sound * rate_type sr: The sampling rate for this sound * sample_type scale: The scaling factor for this sound * sample_block_type (*proc)(...): The get_next_sound method * Result: sound_type * * Effect: * Creates and initializes a sound type * Notes: * The MSDOS conditional is actually a test for ANSI headers; the * presence of float parameters means that an ANSI prototype and * a non-ANSI header are incompatible. Better solution would be * to ANSIfy source. ****************************************************************************/ sound_type last_sound = NULL; sound_type sound_create( snd_susp_type susp, time_type t0, rate_type sr, promoted_sample_type scale) { sound_type sound; falloc_sound(sound, "sound_create"); if (((long) sound) & 3) errputstr("sound not word aligned\n"); last_sound = sound; /* debug */ /* nyquist_printf("sound_create %p gets %g\n", sound, t0); */ sound->t0 = t0; sound->time = t0; sound->stop = MAX_STOP; sound->sr = sr; sound->current = 0; sound->scale = (float) scale; sound->list = snd_list_create(susp); sound->get_next = SND_get_first; sound->logical_stop_cnt = UNKNOWN; sound->table = NULL; sound->extra = NULL; /* nyquist_printf("sound_create susp %p snd_list %p\n", susp, sound->list); nyquist_printf("sound_create'd %p\n", sound); */ #ifdef SNAPSHOTS sound_created_flag = true; #endif #ifdef GC_DEBUG if (sound == sound_to_watch) { nyquist_printf("Created watched sound\n"); watch_snd_list(sound->list); } #endif return sound; } /* sound_prepend_zeros -- modify sound_type so that it starts at t0 */ /* * assumes t0 is earlier than snd->t0, so the sound should return zeros * until snd->t0 is reached, after which we revert to normal computation. * When we return, the new snd->t0 will be t0, meaning that the first * sample returned will be at time t0. * NOTE: t0 may not be an exact multiple of samples earlier than snd->t0, * but Nyquist allows any sound to be shifted by +/- 0.5 samples in * order to achieve alignment. Since sound_prepend_zeros can be called * many times on the same sound_type, there is a chance that rounding * errors could accumulate. My first solution was to return with * snd->t0 computed exactly and not reflecting any fractional sample * shift of the signal, but this caused problems for the caller: a * fractional sample shift at a low sample rate could correspond to * many client samples,fooling the client into thinking that some * initial samples should be discarded (or else requiring the client * to be pretty smart). The solution used here is to return to the * client with snd->t0 exactly equal to t0, but to save snd->true_t0 * equal to the time of the first sample with no sound shifting. This * time is used for any future sound_prepend_zeros operations so that * any accumulated rounding errors are due only to floating point * precision and not to accumulated fractional sample shifts of snd. */ void sound_prepend_zeros(sound_type snd, time_type t0) { long n; /* first, see if we're already prepending some zeros */ if (snd->get_next != SND_get_zeros) { /* nyquist_printf("sound_prepend_zeros 1: snd->t0 %g t0 %g\n", snd->t0, t0); */ /* if not, then initialize some fields that support prepending */ snd->prepend_cnt = 0; snd->true_t0 = snd->t0; /* save old get_next and plug in special get_next function */ snd->after_prepend = snd->get_next; snd->get_next = SND_get_zeros; } n = (long) (((snd->true_t0 - t0) * snd->sr) + 0.5); /* how many samples to prepend */ /* add to prepend_cnt so first sample will correspond to new t0 */ snd->prepend_cnt += n; /* compute the true t0 which corresponds to the time of first sample */ snd->true_t0 -= (n / snd->sr); /* make caller happy by claiming the sound now starts at exactly t0; * this is always true within 0.5 samples as allowed by Fugue. */ snd->t0 = t0; /* nyquist_printf("sound_prepend_zeros: snd %p true_t0 %g sr %g n %d\n", snd, snd->true_t0, snd->sr, n);*/ } /* sound_array_copy -- copy an array of sounds */ /* * NOTE: be sure to protect the result from gc! */ LVAL sound_array_copy(LVAL sa) { long i = getsize(sa); LVAL new_sa = newvector(i); xlprot1(new_sa); while (i > 0) { i--; setelement(new_sa, i, cvsound(sound_copy(getsound(getelement(sa, i))))); } xlpop(); return new_sa; } /* sound_copy - copy a sound structure, do reference counts */ /**/ sound_type sound_copy(sound_type snd) { sound_type sndcopy; falloc_sound(sndcopy, "sound_copy"); *sndcopy = *snd; /* copy the whole structure */ snd_list_ref(snd->list); /* copied a reference so fix the count */ /* nyquist_printf("sound_copy'd %p to %p\n", snd, sndcopy); */ if (snd->table) snd->table->refcount++; #ifdef GC_DEBUG if (sndcopy == sound_to_watch) abort(); #endif return sndcopy; } /* convert a sound to a wavetable, set length */ /**/ table_type sound_to_table(sound_type s) { long len = snd_length(s, max_table_len); long tx = 0; /* table index */ long blocklen; register double scale_factor = s->scale; sound_type original_s = s; table_type table; /* the new table */ long table_bytes; /* how big is the table */ if (s->table) { s->table->refcount++; return s->table; } if (len >= max_table_len) { char emsg[100]; sprintf(emsg, "maximum table size (%d) exceeded", max_table_len); xlcerror("use truncated sound for table", emsg, NIL); } else if (len == 0) { xlabort("table size must be greater than 0"); } len++; /* allocate extra sample at end of table */ s = sound_copy(s); /* nyquist_printf("sound_to_table: allocating table of size %d\n", len); */ table_bytes = table_size_in_bytes(len); table = (table_type) malloc(table_bytes); if (!table) xlfail("osc_init couldn't allocate memory for table"); table_memory += table_bytes; table->length = (double) (len - 1); while (len > 1) { sample_block_type sampblock = sound_get_next(s, &blocklen); long togo = MIN(blocklen, len); long i; sample_block_values_type sbufp = sampblock->samples; /* nyquist_printf("in sound_to_table, sampblock = %d\n", sampblock);*/ for (i = 0; i < togo; i++) { table->samples[tx++] = (float) (*sbufp++ * scale_factor); } len -= togo; } /* for interpolation, duplicate first sample at end of table */ table->samples[tx] = table->samples[0]; table->refcount = 2; /* one for the user, one from original_s */ sound_unref(s); s = NULL; original_s->table = table; return table; } void table_free(table_type table) { long len = (long) (table->length) + 1; long bytes = table_size_in_bytes(len); free(table); table_memory -= bytes; } void table_unref(table_type table) { if (!table) return; table->refcount--; if (table->refcount <= 0) { /* nyquist_printf("table refcount went to zero\n"); */ table_free(table); } } void sound_unref(sound_type snd) /* note that sounds do not have ref counts, so sound_unref * always frees the sound object */ { if (!snd) return; snd_list_unref(snd->list); table_unref(snd->table); /* nyquist_printf("\t\t\t\t\tfreeing sound@%p\n", snd);*/ if (snd->extra) free(snd->extra); ffree_sound(snd, "sound_unref"); } void snd_list_ref(snd_list_type list) { list->refcnt++; } void snd_list_terminate(snd_list) snd_list_type snd_list; { snd_susp_type susp = snd_list->u.next->u.susp; long lsc = susp->log_stop_cnt; long current = susp->current; /* unreference the empty sample block that was allocated: */ sample_block_unref(snd_list->block); /* use zero_block instead */ snd_list->block = zero_block; /* either fetch more zeros or terminate now */ if (lsc != UNKNOWN && lsc > current) { /* nyquist_printf("snd_list_terminate: lsc %d current %d\n", lsc, current); */ susp->fetch = fetch_zeros; fetch_zeros(susp, snd_list); } else { snd_list->block_len = max_sample_block_len; snd_list->logically_stopped = true; snd_list_unref(snd_list->u.next); snd_list->u.next = zero_snd_list; /* be zero forever */ } } void snd_list_unref(snd_list_type list) { void (*freefunc)(); if (list == NULL || list == zero_snd_list) { if (list == NULL) nyquist_printf("why did snd_list_unref get %p?\n", list); return; } list->refcnt--; /* nyquist_printf("snd_list_unref "); print_snd_list_type(list); stdputstr("\n"); */ if (list->refcnt == 0) { if (list->block && list->block != zero_block) { /* there is a next snd_list */ /* stdputstr("["); */ sample_block_unref(list->block); /* stdputstr("]"); */ snd_list_unref(list->u.next); } else if (list->block == NULL) { /* the next thing is the susp */ /* free suspension structure */ /* nyquist_printf("freeing susp@%p\n", list->u.susp); */ freefunc = list->u.susp->free; (*freefunc)(list->u.susp); } /* nyquist_printf("freeing snd_list@%p\n", list); */ ffree_snd_list(list, "snd_list_unref"); } } void sample_block_ref(sample_block_type sam) { sam->refcnt++; } void sample_block_test(sample_block_type sam, char *s) { /* see if this block is being watched */ int i; for (i = 0; i < blocks_to_watch_len; i++) { if ((sam > (blocks_to_watch[i] - 1)) && (sam < (blocks_to_watch[i] + 1))) { nyquist_printf( "WOOPS! %s(0x%p) refers to a block 0x%p on the watch list!\n", s, sam, blocks_to_watch[i]); } } } void sample_block_unref(sample_block_type sam) { sam->refcnt--; if (sam->refcnt == 0) { #ifndef GCBUG sample_block_test(sam, "sample_block_unref"); #endif /* nyquist_printf("freeing sample block %p\n", sam); */ ffree_sample_block(sam, "sample_block_unref"); } } /**************************************************************************** * interp_style * Inputs: * sound_type s: The sound we are using * rate_type sr: The sampling rate * Result: int * A small integer which is one of the symbolic values: * The values are ordered, smallest to largest, as * INTERP_n - none * INTERP_s - scale * INTERP_i - interpolated * INTERP_r - ramp * * Notes: * The sampling rate s->sr and scale factor s->scale are compared * with other values exactly (no fuzz). ****************************************************************************/ int interp_style(sound_type s, rate_type sr) { if (s->sr == sr) { /* same sample rate */ return ((s->scale == 1.0) ? INTERP_n : INTERP_s); } /* same sample rate */ else if (s->sr * 10.0 > sr) { /* 10x sample rate */ return INTERP_i; } /* 10x sample rate */ else return INTERP_r; } /**************************************************************************** * snd_sort_2 * Inputs: * sound_type * s1_ptr: * sound_type * s2_ptr: * rate_type sr: * Result: void * * Effect: * If the interp_style of s1 dominates the interp_style of s2, * the sound_types input are interchanged. ****************************************************************************/ /* snd_sort_2 -- sort 2 arguments by interpolation method */ void snd_sort_2(sound_type *s1_ptr, sound_type *s2_ptr, rate_type sr) { if (interp_style(*s1_ptr, sr) > interp_style(*s2_ptr, sr)) { sound_type s = *s1_ptr; *s1_ptr = *s2_ptr; *s2_ptr = s; } } /* snd_sref -- access a sound at a given time point */ /**/ double snd_sref(sound_type s, time_type t) { double exact_cnt; /* how many fractional samples to scan */ int cnt; /* how many samples to flush */ sample_block_type sampblock = NULL; long blocklen; sample_type x1, x2; /* interpolate between these samples */ /* changed true_t0 to just t0 based on comment that true_t0 is only * for use by snd_prepend_zeros -RBD */ exact_cnt = (t - s->t0) * s->sr; if (exact_cnt < 0.0) return 0.0; s = sound_copy(s); /* don't modify s, create new reader */ cnt = (long) exact_cnt; /* rounds down */ exact_cnt -= cnt; /* remember fractional remainder */ /* now flush cnt samples */ while (cnt >= 0) { sampblock = sound_get_next(s, &blocklen); cnt -= blocklen; if (sampblock == zero_block) { sound_unref(s); return 0.0; } } /* -blocklen <= cnt <= -1 */ /* get next 2 samples and interpolate */ x1 = sampblock->samples[blocklen + cnt]; if (cnt == -1) { sampblock = sound_get_next(s, &blocklen); cnt -= blocklen; } x2 = sampblock->samples[blocklen + cnt + 1]; sound_unref(s); /* free the reader */ return (x1 + exact_cnt * (x2 - x1)) * s->scale; } /* snd_sref_inverse -- find time point corresponding to some value */ /**/ double snd_sref_inverse(sound_type s, double val) { double exact_cnt; /* how many fractional samples to scan */ int i; sample_block_type sampblock; long blocklen; sample_type x1, x2; /* interpolate between these samples */ if (val < 0) { xlcerror("return 0", "negative value", cvflonum(val)); return 0.0; } s = sound_copy(s); /* don't modify s, create new reader */ x1 = 0.0F; /* now flush cnt samples */ while (true) { sampblock = sound_get_next(s, &blocklen); x2 = sampblock->samples[blocklen - 1]; if (x2 >= val) break; x1 = x2; if (sampblock == zero_block) { xlcerror("return 0", "too large, no inverse", cvflonum(val)); sound_unref(s); return 0.0; } } /* x1 = last sample of previous block, sampblock contains a value larger than val blocklen is the length of sampblock */ /* search for first element exceeding val - could * use binary search, but maximum block size places * an upper bound on how bad this can get and we * search for the right block linearly anyway. */ for (i = 0; i < blocklen && sampblock->samples[i] <= val; i++) ; /* now i is index of element exceeding val */ if (i > 1) x1 = sampblock->samples[i - 1]; x2 = sampblock->samples[i]; /* now interpolate to get fractional part */ if (x2 == x1) exact_cnt = 0; else exact_cnt = (val - x1) / (x2 - x1); /* and add the sample count of x1 */ exact_cnt += (s->current - blocklen) + (i - 1); /* negative counts are possible because the first x1 is at * sample -1, so force the location to be at least 0 */ if (exact_cnt < 0) exact_cnt = 0; /* compute time = t0 + count / samplerate; */ exact_cnt = s->t0 + exact_cnt / s->sr; sound_unref(s); /* free the reader */ return exact_cnt; } time_type snd_stop_time(sound_type s) { if (s->stop == MAX_STOP) return MAX_STOP_TIME; else return s->t0 + (s->stop + 0.5) / s->sr; } /* snd_xform -- return a sound with transformations applied */ /* * The "logical" sound starts at snd->time and runs until some * as yet unknown termination time. (There is also a possibly * as yet unknown logical stop time that is irrelevant here.) * The sound is clipped (zero) until snd->t0 and after snd->stop, * the latter being a sample count, not a time_type. * So, the "physical" sound starts at snd->t0 and runs for up to * snd->stop samples (or less if the sound terminates beforehand). * * The snd_xform procedure operates at the "logical" level, shifting * the sound from its snd->time to time. The sound is stretched as * a result of setting the sample rate to sr. It is then (further) * clipped between start_time and stop_time. If initial samples * are clipped, the sound is shifted again so that it still starts * at time. The sound is then scaled by scale. * * To support clipping of initial samples, the "physical" start time * t0 is set to when the first unclipped sample will be returned, but * the number of samples to clip is saved as a negative count. The * fetch routine SND_flush is installed to flush the clipped samples * at the time of the first fetch. SND_get_first is then installed * for future fetches. * * An empty (zero) sound will be returned if all samples are clipped. * */ sound_type snd_xform(sound_type snd, rate_type sr, time_type time, time_type start_time, time_type stop_time, promoted_sample_type scale) { long start_cnt, stop_cnt; /* clipping samples (sample 0 at new t0) */ /* start_cnt should reflect max of where the sound starts (t0) * and the new start_time. */ if (start_time == MIN_START_TIME) { start_cnt = 0; } else { double new_start_cnt = ((start_time - time) * sr) + 0.5; start_cnt = ((new_start_cnt > 0) ? (long) new_start_cnt : 0); } /* if (start_cnt < -(snd->current)) start_cnt = -(snd->current); */ /* stop_cnt should reflect min of the new stop_time and the previous * snd->stop. */ if (stop_time == MAX_STOP_TIME) { stop_cnt = MAX_STOP; } else { double new_stop_cnt = ((stop_time - time) * sr) + 0.5; if (new_stop_cnt < MAX_STOP) { stop_cnt = (long) new_stop_cnt; } else { errputstr("Warning: stop count overflow in snd_xform\n"); stop_cnt = MAX_STOP; } } if (stop_cnt > snd->stop) { stop_cnt = snd->stop; } if (stop_cnt < 0 || start_cnt >= stop_cnt) { snd = sound_create(NULL, time, sr, 1.0); /* sound_create goes ahead and allocates a snd_list node, so * we need to free it. * Calling snd_list_unref here seems like the right thing, but * it assumes too much structure is in place. ffree_snd_list * is simpler and more direct: */ ffree_snd_list(snd->list, "snd_xform"); snd->list = zero_snd_list; nyquist_printf("snd_xform: (stop_time < t0 or start >= stop) " "-> zero sound = %p\n", snd); } else { snd = sound_copy(snd); snd->t0 = time; if (start_cnt) { snd->current -= start_cnt; /* indicate flush with negative num. */ /* the following code assumes that SND_get_first is the routine to be called to get the first samples from this sound. We're going to replace it with SND_flush. First, make sure that the assumption is correct: */ if ((snd->get_next != SND_get_first) && (snd->get_next != SND_flush)) { errputstr("snd_xform: SND_get_first expected\n"); EXIT(1); } /* this will flush -current samples and revert to SND_get_first */ snd->get_next = SND_flush; stop_cnt -= start_cnt; } snd->stop = stop_cnt; snd->sr = sr; snd->scale *= (float) scale; } return snd; } /* SND_flush -- the get_next function for flushing clipped samples */ /* * this only gets called once: it flushes -current samples (a * non-real-time operation) and installs SND_get_next to return * blocks normally from then on. */ sample_block_type SND_flush(sound_type snd, long * cnt) { long mycnt; sample_block_type block = SND_get_first(snd, &mycnt); while (snd->current < 0) { block = SND_get_next(snd, &mycnt); } /* at this point, we've read to and including the block with * the first samples we want to return. If the block boundary * is in the right place, we can do a minimal fixup and return: */ if (snd->current == snd->list->block_len) { *cnt = snd->current; /* == snd->list->block_len */ /* snd->get_next = SND_get_next; -- done by SND_get_first */ return block; } else /* snd->current < snd->list->block_len */ { long i; sample_block_values_type from_ptr; /* we have to return a partial block */ /* NOTE: if we had been smart, we would have had SND_get_next * return a pointer to samples rather than a pointer to the * block, which has a reference count. Since the caller * expects a pointer to a reference count, we have to copy * snd->current samples to a new block */ snd_list_type snd_list = snd_list_create((snd_susp_type) snd->list->u.next); snd_list->u.next->refcnt++; falloc_sample_block(snd_list->block, "SND_flush"); /* now copy samples */ from_ptr = block->samples + snd->list->block_len - snd->current; for (i = 0; i < snd->current; i++) { snd_list->block->samples[i] = from_ptr[i]; } snd_list_unref(snd->list); snd->list = snd_list; *cnt = snd->current; return snd_list->block; } } /* SND_get_zeros -- the get_next function for prepended zeros */ /* * when prepending zeros, we just return a pointer to the internal_zero_block * and decrement the prepend_cnt until it goes to zero. Then we revert to * the normal (original) get_next function. * */ sample_block_type SND_get_zeros(sound_type snd, long * cnt) { int len = MIN(snd->prepend_cnt, max_sample_block_len); /* stdputstr("SND_get_zeros: "); */ if (len < 0) { char error[80]; sprintf(error, "SND_get_zeros snd %p len %d", snd, len); xlabort(error); } if (len == 0) { /* we've finished prepending zeros */ snd->get_next = snd->after_prepend; /* stdputstr("done, calling sound_get_next\n"); fflush(stdout); */ return sound_get_next(snd, cnt); } else { *cnt = len; snd->current += len; snd->prepend_cnt -= len; /* nyquist_printf("returning internal_zero_block@%p\n", internal_zero_block); fflush(stdout); */ return internal_zero_block; } } /**************************************************************************** * SND_get_next * Inputs: * sound_type snd: The iterator whose next block is to be computed * int * cnt: Place to put count of samples returned * Result: snd_list_type * Pointer to the sample block computed ---------------------------+ * Effect: | * force suspension to compute next block of samples | * | * Here's the protocol for using this and related functions: | * Every client (sample reader) has a private sound_type (an iterator), | * and the sound_type's 'list' field points to a header (of type | * snd_list_type). The header in turn points to a block of samples. | * | * +---------------------------------------+ * | * | * | sample_block_type * (snd) V +---+--+--+--+--+--+--+-...-+--+ * sound_type: snd_list_type +-->|ref| | | | |//|//| |//| * +---------+ +----------+ | +---+--+--+--+--+--+--+-...-+--+ * | list +------->| block +--+ ^ * +---------+ +----------+ : * | t0 | | block_len|....................: * +---------+ +----------+ * | sr | | refcnt | * +---------+ +-+--------+ * | current | | next +---->... Note: the union u * +---------+ |u|........| snd_list_type points to only one * | rate | | | susp +---->... of the indicated * +---------+ +-+--------+ susp_type types * | scalse | |log_stop | * +---------+ +----------+ * | lsc | * +---------+ * |get_next +-----> SND_get_next() * +---------+ * * The sound_type keeps track of where the next sample block will * come from. The field 'current' is the number of the first sample of * the next block to be returned, where sample numbers start * at zero. The normal fetch procedure is this one, although special * cases may generate special block generators, e.g., CONST does not need * to allocate and refill a block and can reuse the same block over and * over again, so it may have its own fetch procedure. This is the * general fetch procedure, which assumes that the generator function * actually produces a slightly different value for each sample. * * The distinguishing characteristic of whether the 'u' field is to be * interpreted as 'next', a link to the next list element, or 'susp', a * reference to the suspension for generating a new sample block, is * whether the 'block' parameter is NULL or not. If it is NULL, then * u.susp tells how to generate the block; if it is not NULL, u.next is * a pointer to the next sound block in the list. * * When the 'block' pointer is NULL, we create a block of samples, and * create a new sound list element which follows it which has a NULL * 'block' pointer; the 'u' field of the current list element is now * interpreted as 'u.next'. * * The client calls SND_get_next to get a pointer to a block of samples. * The count of samples generated is returned via a ref parameter, and * SND_get_next will not be called again until this set is exhausted. * * The next time SND_get_next is called, it knows that the sample block * has been exhausted. It releases its reference to the block (and if * that was the last reference, frees the block to the block allocation * pool), allocates a new block from the block pool, and proceeds to * fill it with samples. * * Note that as an optimization, if the refcnt field goes to 0 it * could immediately re-use the block without freeing back to the block * pool and reallocating it. * * Because of the way we handle sound sample blocks, the sound sample blocks * themselves are ref-counted, so freeing the snd_list_type may not free * the sample block it references. At the level of this procedure, that * is transparently handled by the snd_list_unref function. * * Logical stop: * * Logical stop is handled by several mechanisms. The /intrinsic/ logical * stop is an immutable property of the signal, and is determined by the * specification in the algorithm description file. When it is encountered, * the 'logically_stopped' flag of the snd_list_node is set. * The generators guarantee that the first time this is encountered, it * will always be constructed so that the first sample of the block it * references is the logical stop time. * * In addition, the client may have set the /explicit logical stop time/ of * the iterator (e.g., in nyquist, the (set-logical-stop sound time) call copies * the sound, altering its logical stop). The logical stop time, when set * in this way, causes the logical_stop_cnt ('lsc' in the above diagram) * to be set to the count of the last sample to be generated before the * list; /* * If there is not a block of samples, we need to generate one. */ if (snd_list->block == NULL) { /* * Call the 'fetch' method for this sound_type to generate * a new block of samples. */ snd_susp_type susp = snd_list->u.susp; snd_list->u.next = snd_list_create(susp); snd_list->block = internal_zero_block; /* nyquist_printf("SND_get_first: susp->fetch %p\n", susp->fetch); */ (*(susp->fetch))(susp, snd_list); #ifdef GC_DEBUG snd_list_debug(snd_list, "SND_get_first"); #endif /* nyquist_printf("SND_get_first: snd_list %p, block %p, length %d\n", snd_list, snd_list->block, snd_list->block_len); */ } if ((snd->logical_stop_cnt == UNKNOWN) && snd_list->logically_stopped) { /* nyquist_printf("SND_get_first/next: snd %p logically stopped at %d\n", snd, snd->current); */ snd->logical_stop_cnt = snd->current; } /* see if clipping needs to be applied */ if (snd->current + snd_list->block_len > snd->stop) { /* need to clip: is clip on a block boundary? */ if (snd->current == snd->stop) { /* block boundary: replace with zero sound */ snd->list = zero_snd_list; snd_list_unref(snd_list); } else { /* not a block boundary: build new list */ snd->list = snd_list_create((snd_susp_type) zero_snd_list); snd->list->block_len = (short) (snd->stop - snd->current); snd->list->block = snd_list->block; snd->list->block->refcnt++; snd_list_unref(snd_list); } snd_list = snd->list; /* used below to return block ptr */ } *cnt = snd_list->block_len; /* this should never happen */ if (*cnt == 0) { stdputstr("SND_get_first returned 0 samples\n"); dbg_mem_print("snd_list info:", snd_list); dbg_mem_print("block info:", snd_list->block); sound_print_tree(snd); stdputstr("It is possible that you created a recursive sound\n"); stdputstr("using something like: (SETF X (SEQ (SOUND X) ...))\n"); stdputstr("Nyquist aborts from non-recoverable error\n"); abort(); } snd->current += snd_list->block_len; /* count how many we read */ snd->get_next = SND_get_next; return snd_list->block; } sample_block_type SND_get_next(sound_type snd, long * cnt) { register snd_list_type snd_list = snd->list; /* * SND_get_next is installed by SND_get_first, so we know * when we are called that we are done with the current block * of samples, so free it now. */ snd_list_type cur = snd_list; snd->list = snd_list = cur->u.next; snd_list_ref(snd_list); snd_list_unref(cur); /* release the reference to the current block */ /* now that we've deallocated, we can use SND_get_first to finish the job */ return SND_get_first(snd, cnt); } /**************************************************************************** * make_zero_block * Inputs: * * Result: * * Effect: * ****************************************************************************/ sample_block_type make_zero_block(void) { sample_block_type zb; int i; falloc_sample_block(zb, "make_zero_block"); /* leave room for lots more references before overflow, but set the count high so that even a large number of dereferences will not lead to a deallocation */ zb->refcnt = 0x6FFFFFFF; for (i = 0; i < max_sample_block_len; i++) { /* fill with zeros */ zb->samples[i] = 0.0F; } /* fill with zeros */ return zb; } /* min_cnt -- help compute the logical stop or terminate as minimum */ /* * take the sound (which has just logically stopped or terminated at * current sample) and * convert the stop sample into the equivalent sample count as produced by * susp (which may have a different sample rate). If the count is less than * the current *cnt_ptr, overwrite cnt_ptr with a new minimum. By calling * this when each of S1, S2, ... Sn reach their logical stop or termiate * points, *cnt_ptr will end up with the minimum stop count, which is what * we want. NOTE: the logical stop time and terminate for signal addition * should be the MAX of logical stop times of arguments, so this routine * would not be used. */ void min_cnt(long *cnt_ptr, sound_type sound, snd_susp_type susp, long cnt) { long c = (long) ((((sound->current - cnt) / sound->sr + sound->t0) - susp->t0) * susp->sr + 0.5); /* if *cnt_ptr is uninitialized, just plug in c, otherwise compute min */ if ((*cnt_ptr == UNKNOWN) || (*cnt_ptr > c)) { /* nyquist_printf("min_cnt %p: new count is %d\n", susp, c);*/ /* if (c == 0) sound_print_tree(printing_this_sound);*/ *cnt_ptr = c; } } /**************************************************************************** * sound_init * Result: void * * Effect: * Module initialization * Allocates the 'zero block', the infinitely linked block of * 0-valued sounds. This is referenced by a list element which * refers to itself. ****************************************************************************/ void sound_init(void) { zero_block = make_zero_block(); internal_zero_block = make_zero_block(); falloc_snd_list(zero_snd_list, "sound_init"); zero_snd_list->block = zero_block; zero_snd_list->u.next = zero_snd_list; zero_snd_list->refcnt = 2; zero_snd_list->block_len = max_sample_block_len; zero_snd_list->logically_stopped = true; #ifdef GC_DEBUG { long s; stdputstr("sound_to_watch: "); scanf("%p", &s); watch_sound(s); } #endif sound_desc = create_desc("SOUND", sound_xlfree, sound_xlprint, sound_xlsave, sound_xlrestore, sound_xlmark); } /* sound_scale -- copy and change scale factor of a sound */ /**/ sound_type sound_scale(double factor, sound_type snd) { sound_type sndcopy = sound_copy(snd); sndcopy->scale *= (float) factor; return sndcopy; } /**************************************************************************** * set_logical_stop_time * Inputs: * sound_type sound: The sound for which the logical stop time is * being set * time_type when: The logical stop time, expressed as an absolute * time. * Result: void * * Effect: * Converts the time 'when' into a count of samples. ****************************************************************************/ void set_logical_stop_time(sound_type sound, time_type when) { long n; /* 'when' is an absolute time. The number of samples to be generated is the number of samples between 't0' and 'when'. -----------+---+---+---+---+---+---+---+---+---+ | | t0 when */ n = (long) ((when - sound->t0) * sound->sr + 0.5); /* * n is kept as a local variable for debugging purposes. */ sound->logical_stop_cnt = n; } /* for debugging */ sound_type printing_this_sound = NULL; void ((**watch_me)()) = NULL; void set_watch(where) void ((**where)()); { if (watch_me == NULL) { watch_me = where; nyquist_printf("set_watch: watch_me = %p\n", watch_me); } } /* * additional routines */ void sound_print(snd_expr, n) LVAL snd_expr; long n; { LVAL result; xlsave1(result); result = xleval(snd_expr); if (vectorp(result)) { /* make sure all elements are of type a_sound */ long i = getsize(result); while (i > 0) { i--; if (!exttypep(getelement(result, i), a_sound)) { xlerror("sound_print: array has non-sound element", result); } } sound_print_array(result, n); } else if (exttypep(result, a_sound)) { sound_print_sound(getsound(result), n); } else { xlerror("sound_print: expression did not return a sound", result); } xlpop(); } void sound_print_sound(sound_type s, long n) { int ntotal = 0; long blocklen; sample_block_type sampblock; /* for debugging */ printing_this_sound = s; nyquist_printf("sound_print: start at time %g\n", s->t0); while (ntotal < n) { if (s->logical_stop_cnt != UNKNOWN) nyquist_printf("LST=%d ", (int)s->logical_stop_cnt); sound_print_tree(s); sampblock = sound_get_next(s, &blocklen); if (sampblock == zero_block || blocklen == 0) { break; } print_sample_block_type("sound_print", sampblock, MIN(blocklen, n - ntotal)); ntotal += blocklen; } nyquist_printf("total samples: %d\n", ntotal); } void sound_print_array(LVAL sa, long n) { long blocklen; long i, len; long upper = 0; sample_block_type sampblock; time_type t0, tmax; len = getsize(sa); if (len == 0) { stdputstr("sound_print: 0 channels!\n"); return; } /* take care of prepending zeros if necessary */ t0 = tmax = (getsound(getelement(sa, 0)))->t0; for (i = 1; i < len; i++) { sound_type s = getsound(getelement(sa, i)); t0 = MIN(s->t0, t0); tmax = MAX(s->t0, tmax); } /* if necessary, prepend zeros */ if (t0 != tmax) { stdputstr("prepending zeros to channels: "); for (i = 0; i < len; i++) { sound_type s = getsound(getelement(sa, i)); if (t0 < s->t0) { nyquist_printf(" %d ", (int)i); sound_prepend_zeros(s, t0); } } stdputstr("\n"); } nyquist_printf("sound_print: start at time %g\n", t0); while (upper < n) { int i; boolean done = true; for (i = 0; i < len; i++) { sound_type s = getsound(getelement(sa, i)); long current = -1; /* always get first block */ while (current < upper) { sampblock = sound_get_next(s, &blocklen); if (sampblock != zero_block && blocklen != 0) { done = false; } current = s->current - blocklen; nyquist_printf("chan %d current %d:\n", i, (int)current); print_sample_block_type("sound_print", sampblock, MIN(blocklen, n - current)); current = s->current; upper = MAX(upper, current); } } if (done) break; } nyquist_printf("total: %d samples x %d channels\n", (int)upper, (int)len); } /* sound_play -- compute sound, do not retain samples */ /* * NOTE: we want the capability of computing a sound without * retaining samples. This requires that no references to * the sound exist, but if the sound is passed as an argument, * the argument stack will have a reference. So, we pass in * an expression that evaluates to the sound we want. The * expression is eval'd, the result copied (in case the * expression was a sound or a global variable and we really * want to preserve the sound), and then a GC is run to * get rid of the original if there really are no other * references. Finally, the copy is used to play the * sounds. */ void sound_play(snd_expr) LVAL snd_expr; { int ntotal; long blocklen; sample_block_type sampblock; LVAL result; sound_type s; xlsave1(result); result = xleval(snd_expr); if (!exttypep(result, a_sound)) { xlerror("sound_play: expression did not return a sound", result); } ntotal = 0; s = getsound(result); /* if snd_expr was simply a symbol, then s now points to a shared sound_node. If we read samples from it, then the sound bound to the symbol will be destroyed, so copy it first. If snd_expr was a real expression that computed a new value, then the next garbage collection will reclaim the sound_node. We need to explicitly free the copy since the garbage collector cannot find it. */ s = sound_copy(s); while (1) { sampblock = sound_get_next(s, &blocklen); if (sampblock == zero_block || blocklen == 0) { break; } /* print_sample_block_type("sound_play", sampblock, blocklen); */ ntotal += blocklen; } nyquist_printf("total samples: %d\n", ntotal); sound_unref(s); xlpop(); } /* sound_print_tree -- print a tree version of sound structure */ /**/ void sound_print_tree(snd) sound_type snd; { /* nyquist_printf("sample_block_free %p\n", sample_block_free);*/ nyquist_printf("SOUND PRINT TREE of %p\n", snd); sound_print_tree_1(snd, 0); } void indent(int n) { while (n-- > 0) stdputstr(" "); } void sound_print_tree_1(snd, n) sound_type snd; int n; { int i; snd_list_type snd_list; if (n > 100) { stdputstr("... (skipping remainder of sound)\n"); return; } nyquist_printf("sound_type@%p(%s@%p)t0 " "%g stop %d sr %g lsc %d scale %g pc %d", snd, (snd->get_next == SND_get_next ? "SND_get_next" : (snd->get_next == SND_get_first ? "SND_get_first" : "?")), snd->get_next, snd->t0, (int)snd->stop, snd->sr, (int)snd->logical_stop_cnt, snd->scale, (int)snd->prepend_cnt); if (!snd) { stdputstr("\n"); return; } snd_list = snd->list; nyquist_printf("->snd_list@%p", snd_list); if (snd_list == zero_snd_list) { stdputstr(" = zero_snd_list\n"); return; } for (i = 0; ; i++) { if (snd_list == zero_snd_list) { if (i > 1) nyquist_printf(" (skipping %d) ", i-1); stdputstr("->zero_snd_list\n"); return; } if (!snd_list->block) { if (i > 0) nyquist_printf(" (skipping %d) ", i); stdputstr("->\n"); indent(n + 2); nyquist_printf("susp@%p(%s)toss_cnt %d " "current %d lsc %d sr %g t0 %g %p\n", snd_list->u.susp, snd_list->u.susp->name, (int)snd_list->u.susp->toss_cnt, (int)snd_list->u.susp->current, (int)snd_list->u.susp->log_stop_cnt, snd_list->u.susp->sr, snd_list->u.susp->t0, snd_list); /* stdputstr("HI THERE AGAIN\n");*/ susp_print_tree(snd_list->u.susp, n + 4); return; } snd_list = snd_list->u.next; } } /* compute constants p1 and p2: pitchconvert(0) * 2 = pitchconvert(12) - octaves exp(p2) * 2 = exp(12 * p1 + p2) 2 = exp(12 * p1) log(2) = 12 * p1 p1 = log(2.0)/12; pitchconvert(69) gives 440Hz exp(69 * p1 + p2) = 440 69 * p1 + p2 = log(440) p2 = log(440.0) - (69 * p1); */ #define p1 0.0577622650466621 #define p2 2.1011784386926213 double hz_to_step(double hz) { return (log(hz) - p2) / p1; } double step_to_hz(steps) double steps; { return exp(steps * p1 + p2); } /* * from old stuff... */ static void sound_xlfree(s) sound_type s; { /* nyquist_printf("sound_xlfree(%p)\n", s);*/ sound_unref(s); } static void sound_xlprint(LVAL fptr, sound_type s) { /* the type cast from s to LVAL is OK because * putatm does not dereference the 3rd parameter */ putatm(fptr, "Sound", (LVAL) s); } static void sound_xlsave(fp, s) FILE *fp; sound_type s; { stdputstr("sound_save called\n"); } static unsigned char *sound_xlrestore(FILE *fp) { stdputstr("sound_restore called\n"); return NULL; } /* sound_xlmark -- mark LVAL nodes reachable from this sound */ /**/ void sound_xlmark(s) sound_type s; { snd_list_type snd_list; long counter = 0; #ifdef TRACESNDGC nyquist_printf("sound_xlmark(%p)\n", s); #endif if (!s) return; /* pointers to sounds are sometimes NULL */ snd_list = s->list; while (snd_list->block != NULL) { if (snd_list == zero_snd_list) { #ifdef TRACESNDGC stdputstr(" terminates at zero_snd_list\n"); #endif return; } else if (counter > 1000000) { stdputstr("You created a recursive sound! This is a Nyquist bug.\n"); stdputstr("The only known way to do this is by a SETF on a\n"); stdputstr("local variable or parameter that is being passed to SEQ\n"); stdputstr("or SEQREP. The garbage collector assumes that sounds are\n"); stdputstr("not recursive or circular, and follows sounds to their\n"); stdputstr("end. After following a million nodes, I'm pretty sure\n"); stdputstr("that there is a cycle here, but since this is a bug,\n"); stdputstr("I cannot promise to recover. Prepare to crash. If you\n"); stdputstr("cannot locate the cause of this, contact the author -RBD.\n"); } snd_list = snd_list->u.next; counter++; } if (snd_list->u.susp->mark) { #ifdef TRACESNDGC nyquist_printf(" found susp (%s) at %p with mark method\n", snd_list->u.susp->name, snd_list->u.susp); #endif (*(snd_list->u.susp->mark))(snd_list->u.susp); } else { #ifdef TRACESNDGC nyquist_printf(" no mark method on susp %p (%s)\n", snd_list->u.susp, snd_list->u.susp->name); #endif } } void sound_symbols() { a_sound = xlenter("SOUND"); } /* The SOUND Type: */ boolean soundp(s) LVAL s; { return (exttypep(s, a_sound)); } /* sound_zero - create and return a zero that terminates now */ /**/ sound_type sound_zero(time_type t0,rate_type sr) { sound_type sound; falloc_sound(sound, "sound_zero"); sound->get_next = SND_get_first; sound->list = zero_snd_list; sound->logical_stop_cnt = sound->current = 0; sound->true_t0 = sound->t0 = t0; sound->sr = sr; sound->scale = 1.0F; return sound; } LVAL cvsound(s) sound_type s; { /* nyquist_printf("cvsound(%p)\n", s);*/ return (cvextern(sound_desc, (unsigned char *) s)); }