audacia/lib-src/libnyquist/nyx.c

1655 lines
39 KiB
C

/**********************************************************************
nyx.c
Nyx: A very simple external interface to Nyquist
Dominic Mazzoni
**********************************************************************/
/* system includes */
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <math.h>
#include <stdbool.h>
#ifndef WIN32
#include <unistd.h>
#else
#include <windows.h>
#include <direct.h>
#endif
/* nyx includes */
#include "nyx.h"
/* xlisp includes */
#include "switches.h"
#include "xlisp.h"
#include "cext.h"
/* nyquist includes */
#include "sound.h"
#include "samples.h"
#include "falloc.h"
/* use full copy */
#define NYX_FULL_COPY 1
/* show memory stats */
// #define NYX_MEMORY_STATS 1
/* show details of obarray copy */
// #define NYX_DEBUG_COPY 1
/* macro to compute the size of a segment (taken from xldmem.h) */
#define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
/* xldmem external variables */
extern long nnodes;
extern long nfree;
extern long total;
extern int nsegs;
extern SEGMENT *segs;
extern SEGMENT *lastseg;
extern LVAL fnodes;
/* nyquist externs */
extern LVAL a_sound;
extern snd_list_type zero_snd_list;
extern FILE *tfp; /* transcript file pointer */
/* globals */
LOCAL nyx_os_callback nyx_os_cb = NULL;
LOCAL void *nyx_os_ud;
LOCAL nyx_output_callback nyx_output_cb;
LOCAL void *nyx_output_ud;
LOCAL int nyx_expr_pos;
LOCAL int nyx_expr_len;
LOCAL const char *nyx_expr_string;
LOCAL LVAL nyx_result;
LOCAL nyx_rval nyx_result_type = nyx_error;
LOCAL XLCONTEXT nyx_cntxt;
LOCAL int nyx_first_time = 1;
LOCAL LVAL nyx_obarray;
LOCAL FLOTYPE nyx_warp_stretch;
LOCAL int64_t nyx_input_length = 0;
LOCAL char *nyx_audio_name = NULL;
/* Suspension node */
typedef struct nyx_susp_struct {
snd_susp_node susp; // Must be first
nyx_audio_callback callback;
void *userdata;
int64_t len;
int channel;
} nyx_susp_node, *nyx_susp_type;
#if defined(NYX_DEBUG_COPY) && NYX_DEBUG_COPY
static const char *_types_[] =
{
"FREE_NODE",
"SUBR",
"FSUBR",
"CONS",
"SYMBOL",
"FIXNUM",
"FLONUM",
"STRING",
"OBJECT",
"STREAM",
"VECTOR",
"CLOSURE",
"CHAR",
"USTREAM",
"EXTERN"
};
// Dump the contents of the obarray
LOCAL void nyx_show_obarray()
{
LVAL array = getvalue(obarray);
LVAL sym;
int i;
for (i = 0; i < HSIZE; i++) {
for (sym = getelement(array, i); sym; sym = cdr(sym)) {
LVAL syma = car(sym);
printf("_sym_ = ");
xlprint(getvalue(s_stdout), syma, TRUE);
if (getvalue(syma)) {
printf(" _type_ = %s _val_ = ", _types_[ntype(getvalue(syma))]);
xlprint(getvalue(s_stdout), getvalue(syma), TRUE);
}
if (getfunction(syma)) {
printf(" _type_ = %s _fun_ = ", _types_[ntype(getfunction(syma))]);
xlprint(getvalue(s_stdout), getfunction(syma), TRUE);
}
printf("\n");
}
}
}
#endif
//
// Free empty segments
//
LOCAL void freesegs()
{
SEGMENT *seg;
SEGMENT *next;
// Free up as many nodes as possible
gc();
// Reset free node tracking
fnodes = NIL;
nfree = 0L;
// Reset the last segment pointer
lastseg = NULL;
// Scan all segments
for (seg = segs; seg != NULL; seg = next) {
int n = seg->sg_size;
int empty = TRUE;
int i;
LVAL p;
// Check this segment for in-use nodes
p = &seg->sg_nodes[0];
for (i = n; --i >= 0; ++p) {
if (ntype(p) != FREE_NODE) {
empty = FALSE;
break;
}
}
// Retain pointer to next segment
next = seg->sg_next;
// Was the current segment empty?
if (empty) {
// Free the segment;
free((void *) seg);
// Unlink it from the list. No need to worry about a NULL lastseg
// pointer here since the fixnum and char segments will always exist
// at the head of the list and they will always have nodes. So, lastseg
// will have been set before we find any empty nodes.
lastseg->sg_next = next;
// Reduce the stats
total -= (long) segsize(n);
nsegs--;
nnodes -= n;
}
else {
// Not empty, so remember this node as the last segment
lastseg = seg;
// Add all of the free nodes in this segment to the free list
p = &seg->sg_nodes[0];
for (i = n; --i >= 0; ++p) {
if (ntype(p) == FREE_NODE) {
rplaca(p, NIL);
rplacd(p, fnodes);
fnodes = p;
nfree++;
}
}
}
}
}
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
// Copy a node (recursively if appropriate)
LOCAL LVAL nyx_dup_value(LVAL val)
{
LVAL nval = val;
// Protect old and new values
xlprot1(val);
xlprot1(nval);
// Copy the node
if (val != NIL) {
switch (ntype(val))
{
case FIXNUM:
nval = cvfixnum(getfixnum(val));
break;
case FLONUM:
nval = cvflonum(getflonum(val));
break;
case CHAR:
nval = cvchar(getchcode(val));
break;
case STRING:
nval = cvstring((char *) getstring(val));
break;
case VECTOR:
{
int len = getsize(val);
int i;
nval = newvector(len);
nval->n_type = ntype(val);
for (i = 0; i < len; i++) {
if (getelement(val, i) == val) {
setelement(nval, i, val);
}
else {
setelement(nval, i, nyx_dup_value(getelement(val, i)));
}
}
}
break;
case CONS:
nval = nyx_dup_value(cdr(val));
nval = cons(nyx_dup_value(car(val)), nval);
break;
case SUBR:
case FSUBR:
nval = cvsubr(getsubr(val), ntype(val), getoffset(val));
break;
// Symbols should never be copied since their addresses are cached
// all over the place.
case SYMBOL:
nval = val;
break;
// Streams are not copied (although USTREAM could be) and reference
// the original value.
case USTREAM:
case STREAM:
nval = val;
break;
// Externals aren't copied because I'm not entirely certain they can be.
case EXTERN:
nval = val;
break;
// For all other types, just allow them to reference the original
// value. Probably not the right thing to do, but easier.
case OBJECT:
case CLOSURE:
default:
nval = val;
break;
}
}
xlpop();
xlpop();
return nval;
}
// Make a copy of the original obarray, leaving the original in place
LOCAL void nyx_save_obarray()
{
LVAL newarray;
int i;
// This provide permanent protection for nyx_obarray as we do not want it
// to be garbage-collected.
xlprot1(nyx_obarray);
nyx_obarray = getvalue(obarray);
// Create and set the new vector. This allows us to use xlenter() to
// properly add the new symbol. Probably slower than adding directly,
// but guarantees proper hashing.
newarray = newvector(HSIZE);
setvalue(obarray, newarray);
// Scan all obarray vectors
for (i = 0; i < HSIZE; i++) {
LVAL sym;
// Scan all elements
for (sym = getelement(nyx_obarray, i); sym; sym = cdr(sym)) {
LVAL syma = car(sym);
char *name = (char *) getstring(getpname(syma));
LVAL nsym = xlenter(name);
// Ignore *OBARRAY* since there's no need to copy it
if (strcmp(name, "*OBARRAY*") == 0) {
continue;
}
// Ignore *SCRATCH* since it's allowed to be updated
if (strcmp(name, "*SCRATCH*") == 0) {
continue;
}
// Duplicate the symbol's values
setvalue(nsym, nyx_dup_value(getvalue(syma)));
setplist(nsym, nyx_dup_value(getplist(syma)));
setfunction(nsym, nyx_dup_value(getfunction(syma)));
}
}
// Swap the obarrays, so that the original is put back into service
setvalue(obarray, nyx_obarray);
nyx_obarray = newarray;
}
// Restore the symbol values to their original value and remove any added
// symbols.
LOCAL void nyx_restore_obarray()
{
LVAL obvec = getvalue(obarray);
LVAL sscratch = xlenter("*SCRATCH*"); // one-time lookup
int i;
// Scan all obarray vectors
for (i = 0; i < HSIZE; i++) {
LVAL last = NULL;
LVAL dcon;
// Scan all elements
for (dcon = getelement(obvec, i); dcon; dcon = cdr(dcon)) {
LVAL dsym = car(dcon);
char *name = (char *)getstring(getpname(dsym));
LVAL scon;
// Ignore *OBARRAY* since setting it causes the input array to be
// truncated.
if (strcmp(name, "*OBARRAY*") == 0) {
continue;
}
// Ignore *SCRATCH* since it's allowed to be updated
if (strcmp(name, "*SCRATCH*") == 0) {
continue;
}
// Find the symbol in the original obarray.
for (scon = getelement(nyx_obarray, hash(name, HSIZE)); scon; scon = cdr(scon)) {
LVAL ssym = car(scon);
// If found, then set the current symbols value to the original.
if (strcmp(name, (char *)getstring(getpname(ssym))) == 0) {
setvalue(dsym, nyx_dup_value(getvalue(ssym)));
setplist(dsym, nyx_dup_value(getplist(ssym)));
setfunction(dsym, nyx_dup_value(getfunction(ssym)));
break;
}
}
// If we didn't find the symbol in the original obarray, then it
// must've been added and must be removed from the current obarray.
// Exception: if the new symbol is a property symbol of *scratch*,
// then allow the symbol to stay; otherwise, property lookups will
// fail.
if (scon == NULL) {
// check property list of scratch
if (findprop(sscratch, dsym) == NIL) {
if (last) {
rplacd(last, cdr(dcon));
}
else {
setelement(obvec, i, cdr(dcon));
}
} // otherwise, keep new property symbol
}
// Must track the last dcon for symbol removal
last = dcon;
}
}
}
#else
LOCAL LVAL copylist(LVAL from)
{
if (from == NULL) {
return NULL;
}
return cons(car(from), copylist(cdr(from)));
}
/* Make a copy of the obarray so that we can erase any
changes the user makes to global variables */
LOCAL void nyx_copy_obarray()
{
LVAL newarray;
int i;
// Create and set the new vector.
newarray = newvector(HSIZE);
setvalue(obarray, newarray);
for (i = 0; i < HSIZE; i++) {
LVAL from = getelement(nyx_obarray, i);
if (from) {
setelement(newarray, i, copylist(from));
}
}
}
#endif
void nyx_init()
{
if (nyx_first_time) {
char *argv[1];
argv[0] = "nyquist";
xlisp_main_init(1, argv);
nyx_audio_name = NULL;
nyx_os_cb = NULL;
nyx_output_cb = NULL;
nyx_first_time = 0;
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
// Save a copy of the original obarray's contents.
nyx_save_obarray();
#else
// Permanently protect the original obarray value. This is needed since
// it would be unreferenced in the new obarray and would be garbage
// collected. We want to keep it around so we can make copies of it to
// refresh the execution state.
xlprot1(nyx_obarray);
nyx_obarray = getvalue(obarray);
#endif
}
#if !defined(NYX_FULL_COPY) || !NYX_FULL_COPY
// Create a copy of the original obarray
nyx_copy_obarray();
#endif
// Keep nyx_result from being garbage-collected
xlprot1(nyx_result);
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_init\n");
xmem();
#endif
}
void nyx_cleanup()
{
// Garbage-collect nyx_result
xlpop();
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
// Restore the original symbol values
nyx_restore_obarray();
#else
// Restore obarray to original state...but not the values
setvalue(obarray, nyx_obarray);
#endif
// Make sure the sound nodes can be garbage-collected. Sounds are EXTERN
// nodes whose value does not get copied during a full copy of the obarray.
setvalue(xlenter(nyx_get_audio_name()), NIL);
// Free excess memory segments - does a gc()
freesegs();
// Free unused memory pools
falloc_gc();
// No longer need the callbacks
nyx_output_cb = NULL;
nyx_os_cb = NULL;
// Reset vars
nyx_input_length = 0;
if (nyx_audio_name) {
free(nyx_audio_name);
nyx_audio_name = NULL;
}
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_cleanup\n");
xmem();
#endif
}
void nyx_set_xlisp_path(const char *path)
{
set_xlisp_path(path);
}
LOCAL void nyx_susp_fetch(nyx_susp_type susp, snd_list_type snd_list)
{
sample_block_type out;
sample_block_values_type out_ptr;
int64_t n;
int err;
falloc_sample_block(out, "nyx_susp_fetch");
out_ptr = out->samples;
snd_list->block = out;
n = max_sample_block_len;
if (susp->susp.current + n > susp->len) {
n = susp->len - susp->susp.current;
}
err = susp->callback(out_ptr, susp->channel,
susp->susp.current, n, 0, susp->userdata);
if (err) {
// The user canceled or some other error occurred, so we use
// xlsignal() to jump back to our error handler.
xlsignal(NULL, NULL);
// never get here.
}
snd_list->block_len = (short)n;
susp->susp.current += n;
if (n == 0) {
/* we didn't read anything, but can't return length zero, so
convert snd_list to pointer to zero block */
snd_list_terminate(snd_list);
}
else if (n < max_sample_block_len) {
/* should free susp */
snd_list_unref(snd_list->u.next);
/* if something is in buffer, terminate by pointing to zero block */
snd_list->u.next = zero_snd_list;
}
}
LOCAL void nyx_susp_free(nyx_susp_type susp)
{
ffree_generic(susp, sizeof(nyx_susp_node), "nyx_susp_free");
}
LOCAL void nyx_susp_print_tree(nyx_susp_type susp, int n)
{
}
void nyx_capture_output(nyx_output_callback callback, void *userdata)
{
nyx_output_cb = callback;
nyx_output_ud = userdata;
}
char *nyx_get_audio_name()
{
if (!nyx_audio_name) {
nyx_audio_name = strdup("S");
}
return nyx_audio_name;
}
void nyx_set_audio_name(const char *name)
{
if (nyx_audio_name) {
free(nyx_audio_name);
nyx_audio_name = NULL;
}
nyx_audio_name = strdup(name);
}
void nyx_set_audio_params(double rate, int64_t len)
{
LVAL flo;
LVAL con;
xlstkcheck(2);
xlsave(flo);
xlsave(con);
/* Bind the sample rate to the "*sound-srate*" global */
flo = cvflonum(rate);
setvalue(xlenter("*DEFAULT-SOUND-SRATE*"), flo);
setvalue(xlenter("*SOUND-SRATE*"), flo);
/* Bind the control sample rate to "*control-srate*" globals */
flo = cvflonum((double) rate / 20.0);
setvalue(xlenter("*DEFAULT-CONTROL-SRATE*"), flo);
setvalue(xlenter("*CONTROL-SRATE*"), flo);
/* Bind selection len to "len" global */
nyx_input_length = len;
flo = cvflonum(len);
setvalue(xlenter("LEN"), flo);
/* Set the "*warp*" global based on the length of the audio */
con = cons(NULL, NULL);
flo = cvflonum(len > 0 ? (double) len / rate : 1.0);
con = cons(flo, con);
flo = cvflonum(0);
con = cons(flo, con);
setvalue(xlenter("*WARP*"), con);
xlpopn(2);
}
void nyx_set_input_audio(nyx_audio_callback callback,
void *userdata,
int num_channels,
int64_t len, double rate)
{
LVAL val;
int ch;
nyx_set_audio_params(rate, len);
if (num_channels > 1) {
val = newvector(num_channels);
}
xlprot1(val);
for (ch = 0; ch < num_channels; ch++) {
nyx_susp_type susp;
sound_type snd;
falloc_generic(susp, nyx_susp_node, "nyx_set_input_audio");
susp->callback = callback;
susp->userdata = userdata;
susp->len = len;
susp->channel = ch;
susp->susp.fetch = (snd_fetch_fn)nyx_susp_fetch;
susp->susp.keep_fetch = NULL;
susp->susp.free = (snd_free_fn)nyx_susp_free;
susp->susp.mark = NULL;
susp->susp.print_tree = (snd_print_tree_fn)nyx_susp_print_tree;
susp->susp.name = "nyx";
susp->susp.toss_cnt = 0;
susp->susp.current = 0;
susp->susp.sr = rate;
susp->susp.t0 = 0.0;
susp->susp.log_stop_cnt = 0;
snd = sound_create((snd_susp_type) susp, 0.0, rate, 1.0);
if (num_channels > 1) {
setelement(val, ch, cvsound(snd));
}
else {
val = cvsound(snd);
}
}
setvalue(xlenter(nyx_get_audio_name()), val);
xlpop();
}
LOCAL int nyx_is_labels(LVAL expr)
{
/* make sure that we have a list whose first element is a
list of the form (time "label") */
LVAL label;
LVAL first;
LVAL second;
LVAL third;
if (expr == NULL) {
return 0;
}
while (expr != NULL) {
if (!consp(expr)) {
return 0;
}
label = car(expr);
if (!consp(label)) {
return 0;
}
first = car(label);
if (!(floatp(first) || fixp(first))) {
return 0;
}
if (!consp(cdr(label))) {
return 0;
}
second = car(cdr(label));
if (floatp(second) || fixp(second)) {
if (!consp(cdr(cdr(label)))) {
return 0;
}
third = car(cdr(cdr(label)));
if (!(stringp(third))) {
return 0;
}
}
else {
if (!(stringp(second))) {
return 0;
}
}
expr = cdr(expr);
}
return 1;
}
nyx_rval nyx_get_type(LVAL expr)
{
if (nyx_result_type != nyx_error) {
return nyx_result_type;
}
nyx_result_type = nyx_error;
if (expr == NULL) {
return nyx_result_type;
}
switch (ntype(expr))
{
case FIXNUM:
nyx_result_type = nyx_int;
break;
case FLONUM:
nyx_result_type = nyx_double;
break;
case STRING:
nyx_result_type = nyx_string;
break;
case VECTOR:
{
/* make sure it's a vector of sounds */
int i;
nyx_result_type = nyx_audio;
for (i = 0; i < getsize(expr); i++) {
if (!soundp(getelement(expr, i))) {
nyx_result_type = nyx_error;
break;
}
}
}
break;
case CONS:
{
/* see if it's a list of time/string pairs representing a
label track */
if (nyx_is_labels(expr)) {
nyx_result_type = nyx_labels;
} else {
nyx_result_type = nyx_list;
}
}
break;
case EXTERN:
{
if (soundp(expr)) {
nyx_result_type = nyx_audio;
}
}
break;
} /* switch */
return nyx_result_type;
}
nyx_rval nyx_eval_expression(const char *expr_string)
{
LVAL expr = NULL;
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_eval_expression before\n");
xmem();
#endif
nyx_result = NULL;
nyx_result_type = nyx_error;
// Check argument
if (!expr_string || !strlen(expr_string)) {
return nyx_get_type(nyx_result);
}
nyx_expr_string = expr_string;
nyx_expr_len = strlen(nyx_expr_string);
nyx_expr_pos = 0;
// Protect the expression from being garbage collected
xlprot1(expr);
// Setup a new context
xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
// Set the context jump destination
if (_setjmp(nyx_cntxt.c_jmpbuf)) {
// If the script is cancelled or some other condition occurs that causes
// the script to exit and return to this level, then we don't need to
// restore the previous context.
goto finish;
}
while (nyx_expr_pos < nyx_expr_len) {
expr = NULL;
// Simulate the prompt
if (tfp) {
ostputc('>');
ostputc(' ');
}
// Read an expression
if (!xlread(getvalue(s_stdin), &expr, FALSE)) {
break;
}
// Simulate the prompt
if (tfp) {
ostputc('\n');
}
#if 0
/* save the input expression (so the user can refer to it
as +, ++, or +++) */
xlrdsave(expr);
#endif
// Evaluate the expression
nyx_result = xleval(expr);
// Print it
if (tfp) {
stdprint(nyx_result);
}
}
// This will unwind the xlisp context and restore internals to a point just
// before we issued our xlbegin() above. This is important since the internal
// xlisp stacks will contain pointers to invalid objects otherwise.
//
// Also note that execution will jump back up to the statement following the
// _setjmp() above.
xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
// Never reached
finish:
xlflush();
xlpop(); // unprotect expr
setvalue(xlenter(nyx_get_audio_name()), NIL);
gc();
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_eval_expression after\n");
xmem();
#endif
printf("nyx_eval_expression returns %d\n", nyx_get_type(nyx_result));
return nyx_get_type(nyx_result);
}
int nyx_get_audio_num_channels()
{
if (nyx_get_type(nyx_result) != nyx_audio) {
return 0;
}
if (vectorp(nyx_result)) {
if (getsize(nyx_result) == 1) {
return -1; // invalid number of channels in array
} else {
return getsize(nyx_result);
}
}
return 1;
}
// see sndwritepa.c for similar computation. This is a bit simpler
// because we are not writing interleaved samples.
typedef struct {
int cnt; // how many samples are in the current sample block
sample_block_values_type samps; // the next sample
bool terminated; // has the sound reached termination?
} sound_state_node, *sound_state_type;
int nyx_get_audio(nyx_audio_callback callback, void *userdata)
{
sound_state_type states; // tracks progress reading multiple channels
float *buffer = NULL; // samples to push to callback
int64_t total = 0; // total frames computed (samples per channel)
sound_type snd;
int result = 0;
int num_channels;
int ch;
// Any variable whose value is set between the _setjmp() and the "finish" label
// and that is used after the "finish" label, must be marked volatile since
// any routine outside of the current one that calls _longjmp() will cause values
// cached in registers to be lost.
volatile int success = FALSE;
printf("nyx_get_audio type %d\n", nyx_get_type(nyx_result));
if (nyx_get_type(nyx_result) != nyx_audio) {
return FALSE;
}
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_get_audio before\n");
xmem();
#endif
num_channels = nyx_get_audio_num_channels();
buffer = (sample_type *) malloc(max_sample_block_len * sizeof(sample_type));
if (buffer == NULL) {
goto finish;
}
states = (sound_state_type) malloc(num_channels * sizeof(sound_state_node));
if (states == NULL) {
goto finish;
}
for (ch = 0; ch < num_channels; ch++) {
states[ch].cnt = 0; // force initial fetch
states[ch].samps = NULL; // unnecessary initialization
states[ch].terminated = false;
}
// Setup a new context
xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
// Set the context jump destination
if (_setjmp(nyx_cntxt.c_jmpbuf)) {
// If the script is cancelled or some other condition occurs that causes
// the script to exit and return to this level, then we don't need to
// restore the previous context.
goto finish;
}
// at this point, input sounds which were referenced by symbol S
// (or nyx_get_audio_name()) could be referenced by nyx_result, but
// S is now bound to NIL. nyx_result is a protected (garbage
// collected) LVAL bound to a sound or array of sounds, so we must
// either unbind nyx_result or read it destructively. We need the
// GC to know about sounds as we read them, so we might as well
// read nyx_result destructively. However, reading destructively
// will fail if nyx_result is (VECTOR S S) or has two references to
// the same sound. Therefore, we will replace each channel of
// nyx_result (except the first) with a copy. This may make
// needless copies, but if so, the GC will free the originals.
// Note: sound copies are just "readers" of the same underlying
// list of samples (snd_list_nodes) and lazy sample computation
// structure, so here, a sound copy is just one extra object of
// type sound_node.
// To unify single and multi-channel sounds, we'll create an array
// of one element for single-channel sounds.
if (num_channels == 1) {
LVAL array = newvector(1);
setelement(array, 0, nyx_result);
nyx_result = array;
}
for (ch = 0; ch < num_channels; ch++) {
if (ch > 0) { // no need to copy first channel
setelement(nyx_result, ch,
cvsound(sound_copy(getsound(getelement(nyx_result, ch)))));
}
}
// This is the "pump" that pulls samples from Nyquist and pushes samples
// out by calling the callback function. Every block boundary is a potential
// sound termination point, so we pull, scale, and write sample up to the
// next block boundary in any channel.
// First, we look at all channels to determine how many samples we have to
// compute in togo (how many "to go"). Then, we push togo samples from each
// channel to the callback, keeping all the channels in lock step.
while (result == 0) {
bool terminated = true;
// how many samples to compute before calling callback:
int64_t togo = max_sample_block_len;
for (ch = 0; ch < num_channels; ch++) {
sound_state_type state = &states[ch];
sound_type snd = getsound(getelement(nyx_result, ch));
sample_block_type block;
int cnt;
int i;
if (state->cnt == 0) {
state->samps = sound_get_next(snd, &state->cnt)->samples;
if (state->samps == zero_block->samples) {
state->terminated = true;
// Note: samps is a valid pointer to at least cnt zeros
// so we can process this channel as if it still has samples.
}
}
terminated &= state->terminated; // only terminated if ALL terminate
if (state->cnt < togo) togo = state->cnt;
// now togo is the minimum of: how much room is left in buffer and
// how many samples are available in samps
}
if (terminated || togo == 0) {
success = TRUE;
result = -1;
break; // no more samples in any channel
}
for (ch = 0; ch < num_channels; ch++) {
sound_state_type state = &states[ch];
sound_type snd = getsound(getelement(nyx_result, ch));
// Copy and scale the samples
for (int i = 0; i < togo; i++) {
buffer[i] = *(state->samps++) * (float) snd->scale;
}
state->cnt -= togo;
// TODO: What happens here when we don't know the total length,
// i.e. nyx_input_length == 0? Should we pass total+togo instead?
result = callback(buffer, ch, total, togo, nyx_input_length, userdata);
if (result != 0) {
result = -1;
break;
}
}
total += togo;
}
nyx_result = NULL; // unreference sound array so GC can free it
// This will unwind the xlisp context and restore internals to a point just
// before we issued our xlbegin() above. This is important since the internal
// xlisp stacks will contain pointers to invalid objects otherwise.
//
// Also note that execution will jump back up to the statement following the
// _setjmp() above.
xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
// Never reached
finish:
if (buffer) {
free(buffer);
}
if (states) {
free(states);
}
gc();
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_get_audio after\n");
xmem();
#endif
return success;
}
int nyx_get_int()
{
if (nyx_get_type(nyx_result) != nyx_int) {
return -1;
}
return getfixnum(nyx_result);
}
double nyx_get_double()
{
if (nyx_get_type(nyx_result) != nyx_double) {
return -1.0;
}
return getflonum(nyx_result);
}
const char *nyx_get_string()
{
if (nyx_get_type(nyx_result) != nyx_string) {
return NULL;
}
return (const char *)getstring(nyx_result);
}
unsigned int nyx_get_num_labels()
{
LVAL s;
int count = 0;
if (nyx_get_type(nyx_result) != nyx_labels) {
return 0;
}
for (s = nyx_result; s; s = cdr(s)) {
count++;
}
return count;
}
void nyx_get_label(unsigned int index,
double *start_time,
double *end_time,
const char **label)
{
LVAL s = nyx_result;
LVAL label_expr;
LVAL t0_expr;
LVAL t1_expr;
LVAL str_expr;
if (nyx_get_type(nyx_result) != nyx_labels) {
return;
}
while (index) {
index--;
s = cdr(s);
if (s == NULL) {
// index was larger than number of labels
return;
}
}
/* We either have (t0 "label") or (t0 t1 "label") */
label_expr = car(s);
t0_expr = car(label_expr);
t1_expr = car(cdr(label_expr));
if (stringp(t1_expr)) {
str_expr = t1_expr;
t1_expr = t0_expr;
}
else {
str_expr = car(cdr(cdr(label_expr)));
}
if (floatp(t0_expr)) {
*start_time = getflonum(t0_expr);
}
else if (fixp(t0_expr)) {
*start_time = (double)getfixnum(t0_expr);
}
if (floatp(t1_expr)) {
*end_time = getflonum(t1_expr);
}
else if (fixp(t1_expr)) {
*end_time = (double)getfixnum(t1_expr);
}
*label = (const char *)getstring(str_expr);
}
const char *nyx_get_error_str()
{
return NULL;
}
void nyx_set_os_callback(nyx_os_callback callback, void *userdata)
{
nyx_os_cb = callback;
nyx_os_ud = userdata;
}
void nyx_stop()
{
xlflush();
xltoplevel();
}
void nyx_break()
{
xlflush();
xlbreak("BREAK", s_unbound);
}
void nyx_continue()
{
xlflush();
xlcontinue();
}
int ostgetc()
{
if (nyx_expr_pos < nyx_expr_len) {
fflush(stdout);
if (tfp && nyx_expr_string[nyx_expr_pos] != '\n') {
ostputc(nyx_expr_string[nyx_expr_pos]);
}
return (nyx_expr_string[nyx_expr_pos++]);
}
else if (nyx_expr_pos == nyx_expr_len) {
/* Add whitespace at the end so that the parser
knows that this is the end of the expression */
nyx_expr_pos++;
if (tfp) {
ostputc('\n');
}
return '\n';
}
return EOF;
}
/* osinit - initialize */
void osinit(const char *banner)
{
}
/* osfinish - clean up before returning to the operating system */
void osfinish(void)
{
}
/* oserror - print an error message */
void oserror(const char *msg)
{
errputstr(msg);
}
/* cd ..
open - open an ascii file */
FILE *osaopen(const char *name, const char *mode)
{
return fopen(name, mode);
}
/* osbopen - open a binary file */
FILE *osbopen(const char *name, const char *mode)
{
char bmode[10];
strncpy(bmode, mode, 8);
strcat(bmode, "b");
return fopen(name,bmode);
}
/* osclose - close a file */
int osclose(FILE *fp)
{
return fclose(fp);
}
/* osagetc - get a character from an ascii file */
int osagetc(FILE *fp)
{
return getc(fp);
}
/* osaputc - put a character to an ascii file */
int osaputc(int ch, FILE *fp)
{
return putc(ch,fp);
}
/* osoutflush - flush output to a file */
void osoutflush(FILE *fp)
{
fflush(fp);
}
/* osbgetc - get a character from a binary file */
int osbgetc(FILE *fp)
{
return getc(fp);
}
/* osbputc - put a character to a binary file */
int osbputc(int ch, FILE *fp)
{
return putc(ch, fp);
}
/* ostputc - put a character to the terminal */
void ostputc(int ch)
{
oscheck(); /* check for control characters */
if (nyx_output_cb) {
nyx_output_cb(ch, nyx_output_ud);
if (tfp) {
putc(ch, tfp);
}
}
else {
putchar((char) ch);
}
}
/* ostoutflush - flush output buffer */
void ostoutflush()
{
if (!nyx_output_cb) {
fflush(stdout);
}
}
/* osflush - flush the terminal input buffer */
void osflush(void)
{
}
/* oscheck - check for control characters during execution */
void oscheck(void)
{
if (nyx_os_cb) {
nyx_os_cb(nyx_os_ud);
}
/* if they hit control-c:
xflush(); xltoplevel(); return;
*/
}
/* xsystem - execute a system command */
LVAL xsystem()
{
if (moreargs()) {
unsigned char *cmd;
cmd = (unsigned char *)getstring(xlgastring());
fprintf(stderr, "Will not execute system command: %s\n", cmd);
}
return s_true;
}
/* xsetdir -- set current directory of the process */
LVAL xsetdir()
{
char *dir = (char *)getstring(xlgastring());
int result;
LVAL cwd = NULL;
int verbose = TRUE;
if (moreargs()) {
verbose = (xlgetarg() != NIL);
}
xllastarg();
result = chdir(dir);
if (result) {
/* perror("SETDIR"); -- Nyquist uses SETDIR to search for directories
* at startup, so failures are normal, and seeing error messages
* could be confusing, so don't print them. The NULL return indicates
* an error, but doesn't tell which one it is.
* But now, SETDIR has a second verbose parameter that is nil when
* searching for directories. -RBD
*/
if (verbose) perror("Directory Setting Error");
return NULL;
}
dir = getcwd(NULL, 1000);
if (dir) {
cwd = cvstring(dir);
free(dir);
}
return cwd;
}
/* xgetkey - get a key from the keyboard */
LVAL xgetkey()
{
xllastarg();
return (cvfixnum((FIXTYPE)getchar()));
}
/* ossymbols - enter os specific symbols */
void ossymbols(void)
{
}
/* xsetupconsole -- used to configure window in Win32 version */
LVAL xsetupconsole()
{
return NULL;
}
#if defined(WIN32)
const char os_pathchar = '\\';
const char os_sepchar = ',';
#else
const char os_pathchar = '/';
const char os_sepchar = ':';
#endif
/* control-C handling */
void ctcinit()
{
}
/* xechoenabled -- set/clear echo_enabled flag (unix only) */
LVAL xechoenabled()
{
return NULL;
}
#if defined(WIN32)
static WIN32_FIND_DATA FindFileData;
static HANDLE hFind = INVALID_HANDLE_VALUE;
#define OSDIR_LIST_READY 0
#define OSDIR_LIST_STARTED 1
#define OSDIR_LIST_DONE 2
static int osdir_list_status = OSDIR_LIST_READY;
#define OSDIR_MAX_PATH 256
static char osdir_path[OSDIR_MAX_PATH];
// osdir_list_start -- prepare to list a directory
int osdir_list_start(const char *path)
{
if (strlen(path) >= OSDIR_MAX_PATH - 2) {
xlcerror("LISTDIR path too big", "return nil", NULL);
return FALSE;
}
strcpy(osdir_path, path);
strcat(osdir_path, "/*"); // make a pattern to match all files
if (osdir_list_status != OSDIR_LIST_READY) {
osdir_list_finish(); // close previously interrupted listing
}
hFind = FindFirstFile(osdir_path, &FindFileData); // get the "."
if (hFind == INVALID_HANDLE_VALUE) {
return FALSE;
}
if (FindNextFile(hFind, &FindFileData) == 0) {
return FALSE; // get the ".."
}
osdir_list_status = OSDIR_LIST_STARTED;
return TRUE;
}
/* osdir_list_next -- read the next entry from a directory */
const char *osdir_list_next()
{
if (FindNextFile(hFind, &FindFileData) == 0) {
osdir_list_status = OSDIR_LIST_DONE;
return NULL;
}
return FindFileData.cFileName;
}
/* osdir_list_finish -- close an open directory */
void osdir_list_finish()
{
if (osdir_list_status != OSDIR_LIST_READY) {
FindClose(hFind);
}
osdir_list_status = OSDIR_LIST_READY;
}
#else
#include <dirent.h>
#define OSDIR_LIST_READY 0
#define OSDIR_LIST_STARTED 1
#define OSDIR_LIST_DONE 2
static int osdir_list_status = OSDIR_LIST_READY;
static DIR *osdir_dir;
/* osdir_list_start -- open a directory listing */
int osdir_list_start(const char *path)
{
if (osdir_list_status != OSDIR_LIST_READY) {
osdir_list_finish(); /* close current listing */
}
osdir_dir = opendir(path);
if (!osdir_dir) {
return FALSE;
}
osdir_list_status = OSDIR_LIST_STARTED;
return TRUE;
}
/* osdir_list_next -- read the next entry from a directory */
const char *osdir_list_next()
{
struct dirent *entry;
if (osdir_list_status != OSDIR_LIST_STARTED) {
return NULL;
}
entry = readdir(osdir_dir);
if (!entry) {
osdir_list_status = OSDIR_LIST_DONE;
return NULL;
}
return entry->d_name;
}
/* osdir_list_finish -- close an open directory */
void osdir_list_finish()
{
if (osdir_list_status != OSDIR_LIST_READY) {
closedir(osdir_dir);
}
osdir_list_status = OSDIR_LIST_READY;
}
#endif
/* xget_temp_path -- get a path to create temp files */
LVAL xget_temp_path()
{
char *tmp;
#if defined(WINDOWS)
tmp = getenv("TEMP");
#else
tmp = getenv("TMPDIR");
#endif
if (!tmp || !*tmp) {
tmp = getenv("TMP");
if (!tmp || !*tmp) {
#if defined(WINDOWS)
tmp = "/";
#else
tmp = "/tmp/";
#endif
}
}
return cvstring(tmp);
}
/* xget_user -- get a string identifying the user, for use in file names */
LVAL xget_user()
{
char *user = getenv("USER");
if (!user || !*user) {
user = getenv("USERNAME");
if (!user || !*user) {
errputstr("Warning: could not get user ID, using 'nyquist'\n");
user = "nyquist";
}
}
return cvstring(user);
}
#if defined(WINDOWS)
/* get_xlisp_path -- return path to xlisp */
void get_xlisp_path(char *p, long p_max)
{
char *paths = getenv("XLISPPATH");
if (!paths || !*paths) {
*p = 0;
return;
}
strncpy(p, paths, p_max);
p[p_max-1] = 0;
}
/* xgetrealtime - get current time in seconds */
LVAL xgetrealtime()
{
static const uint64_t EPOCH = ((uint64_t)116444736000000000ULL);
SYSTEMTIME system_time;
FILETIME file_time;
uint64_t time;
GetSystemTime(&system_time);
SystemTimeToFileTime(&system_time, &file_time);
time = (uint64_t) file_time.dwLowDateTime;
time += ((uint64_t) file_time.dwHighDateTime) << 32;
time -= EPOCH;
time /= 10000000L;
return cvflonum((double) time + system_time.wMilliseconds * 0.001);
}
#else
#include <sys/time.h>
/* xgetrealtime - get current time in seconds */
LVAL xgetrealtime(void)
{
struct timeval te;
gettimeofday(&te, NULL); // get current time
return cvflonum((double) te.tv_sec + (te.tv_usec * 1e-6));
}
#endif