void nyx_set_audio_params(double rate, long 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("*SOUND-SRATE*"), flo);
/* Bind selection len to "len" global */
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);
}
/* SHLIB-INIT funtab &optional (version -1) (oldest version) */
LVAL xshlibinit()
{
LVAL subr, val, sym;
xlshlib_modinfo_t *info = getnpaddr(xlganatptr());
FUNDEF *p = info->funs;
FIXCONSTDEF *pfix = info->fixconsts;
FLOCONSTDEF *pflo = info->floconsts;
STRCONSTDEF *pstr = info->strconsts;
struct version_info defversion;
defversion.current = moreargs()?getfixnum(xlgafixnum()):-1;
defversion.oldest = moreargs()?getfixnum(xlgafixnum()):defversion.current;
xllastarg();
if (! check_version(&defsysversion, &(info->sysversion)))
xlfail("shared library not compatible with current system");
if (defversion.current >= 0 &&
! check_version(&defversion, &(info->modversion)))
xlfail("module not compatible with requested version");
xlsave1(val);
val = NIL;
if (p != NULL)
for (val = NIL; (p->fd_subr) != (LVAL(*)(void)) NULL; p++) {
subr = cvsubr(p->fd_subr, p->fd_type & TYPEFIELD, 0);
setmulvalp(subr, (p->fd_type & (TYPEFIELD + 1)) ? TRUE : FALSE);
val = cons(subr, val);
if (p->fd_name != NULL) {
sym = xlenter(p->fd_name);
setfunction(sym, subr);
}
}
if (pfix != NULL)
for (; pfix->name != NULL; pfix++) {
sym = xlenter(pfix->name);
defconstant(sym, cvfixnum(pfix->val));
}
if (pflo != NULL)
for (; pflo->name != NULL; pflo++) {
sym = xlenter(pflo->name);
defconstant(sym, cvflonum(pflo->val));
}
if (pstr != NULL)
for (; pstr->name != NULL; pstr++) {
sym = xlenter(pstr->name);
defconstant(sym, cvstring(pstr->val));
}
if (info->sysversion.current >= MAKEVERSION(0,1)) {
ULONGCONSTDEF *pulong = info->ulongconsts;
if (pulong != NULL)
for (; pulong->name != NULL; pulong++) {
sym = xlenter(pulong->name);
defconstant(sym, ulong2lisp(pulong->val));
}
}
xlpop();
return xlnreverse(val);
}
/* obsymbols - initialize symbols */
void obsymbols(void)
{
/* enter the object related symbols */
s_self = xlenter("SELF");
k_new = xlenter(":NEW");
k_isnew = xlenter(":ISNEW");
/* get the Object and Class symbol values */
object = getvalue(xlenter("OBJECT"));
class = getvalue(xlenter("CLASS"));
}
LVAL Native_Init()
{
LVAL pXReturn;
int iPort;
TVeosErr iErr;
xlsave1(pXReturn);
if (!moreargs())
iPort = TALK_BOGUS_FD;
else
iPort = getfixnum(xlgafixnum());
xllastarg();
/** invoke veos kernel inialization **/
iErr = Kernel_Init(iPort, Native_MessageToLSpace);
if (iErr == VEOS_SUCCESS) {
/** create a lisp based inspace for messages **/
s_InSpace = xlenter("VEOS_INSPACE");
setvalue(s_InSpace, NIL);
NATIVE_INSPACE = &getvalue(s_InSpace);
/** create keyword symbols for nancy prims **/
k_TestTime = xlenter(":TEST-TIME"); /* use with copy only */
k_Freq = xlenter(":FREQ"); /* use with copy, put or get */
/** setup invariant matcher settings in global param blocks **/
Native_InitMatcherPBs();
/** make a uid return value to signify success **/
Uid2XVect(&IDENT_ADDR, &pXReturn);
}
xlpop();
return(pXReturn);
} /* Native_Init */
/* psymbol - parse a symbol name */
LOCAL LVAL psymbol(LVAL fptr)
{
int escflag;
LVAL val;
pname(fptr,&escflag);
return (escflag || !isnumber(buf,&val) ? xlenter(buf) : val);
}
void localsymbols(void)
{
RSLT_sym = xlenter("*RSLT*");
sound_symbols();
samples_symbols();
#ifdef CMTSTUFF
seqext_symbols();
#endif
}
/* xladdmsg - add a message to a class */
void xladdmsg(LVAL cls, const char *msg, int offset)
{
extern FUNDEF *funtab;
LVAL mptr;
/* enter the message selector */
mptr = entermsg(cls,xlenter(msg));
/* store the method for this message */
rplacd(mptr,cvsubr(funtab[offset].fd_subr,funtab[offset].fd_type,offset));
}
/* makesymbol - make a new symbol */
LOCAL LVAL makesymbol(int iflag)
{
LVAL pname;
/* get the print name of the symbol to intern */
pname = xlgastring();
xllastarg();
/* make the symbol */
return (iflag ? xlenter((char *) getstring(pname))
: xlmakesym((char *) getstring(pname)));
}
/* xlsubr - define a builtin function */
LVAL xlsubr P4C(char *, sname, int, type, subrfun, fcn, int, offset)
{
LVAL sym;
sym = xlenter(sname);
#ifdef MULVALS
setfunction(sym,cvsubr(fcn, type&TYPEFIELD, offset));
setmulvalp(getfunction(sym), (type & (TYPEFIELD+1)) ? TRUE : FALSE);
#else
setfunction(sym,cvsubr(fcn,type,offset));
#endif /* MULVALS */
return (sym);
}
void nyx_set_input_audio(nyx_audio_callback callback,
void *userdata,
int num_channels,
long 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 = nyx_susp_fetch;
susp->susp.keep_fetch = NULL;
susp->susp.free = nyx_susp_free;
susp->susp.mark = NULL;
susp->susp.print_tree = 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("S"), val);
xlpop();
}
nyx_rval nyx_eval_expression(const char *expr_string)
{
LVAL expr = NULL;
nyx_expr_string = expr_string;
nyx_expr_len = strlen(nyx_expr_string);
nyx_expr_pos = 0;
nyx_result = NULL;
nyx_parse_error_flag = 0;
xlprot1(expr);
/* setup the error return */
xlbegin(&nyx_cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
if (setjmp(nyx_cntxt.c_jmpbuf))
goto finish;
while(nyx_expr_pos < nyx_expr_len) {
expr = NULL;
/* read an expression */
if (!xlread(getvalue(s_stdin), &expr, FALSE))
break;
#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);
}
xlflush();
finish:
xlend(&nyx_cntxt);
xlpop(); /* unprotect expr */
/* reset the globals to their initial state */
obarray = nyx_old_obarray;
setvalue(xlenter("S"), NULL);
gc();
return nyx_get_type(nyx_result);
}
// 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;
}
/* xlclass - define a class */
LVAL xlclass(const char *name, int vcnt)
{
LVAL sym,cls;
/* create the class */
sym = xlenter(name);
cls = newobject(class,CLASSSIZE);
setvalue(sym,cls);
/* set the instance variable counts */
setivar(cls,IVARCNT,cvfixnum((FIXTYPE)vcnt));
setivar(cls,IVARTOTAL,cvfixnum((FIXTYPE)vcnt));
/* set the superclass to 'Object' */
setivar(cls,SUPERCLASS,object);
/* return the new class */
return (cls);
}
LVAL xosc_enable(void)
{
/* only need arg if OSC is defined, otherwise compiler complains */
#ifdef OSC
LVAL arg =
#endif
xlgetarg();
xllastarg();
#ifdef OSC
if (nosc_enabled == !null(arg)) {
return arg; /* no change */
} else if (null(arg)) { /* nosc_enabled must be true */
nosc_finish();
return s_true;
} else { /* nosc_enabled must be false */
nosc_init();
return NIL;
}
#else
return xlenter("DISABLED");
#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("S"), 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;
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
printf("\nnyx_cleanup\n");
xmem();
#endif
}
/* xlsenter - enter a symbol with a static print name */
NODE *xlsenter(char *name)
{
return (xlenter(name,STATIC));
}
/* xlsymbols - enter all of the symbols used by the interpreter */
void xlsymbols(void)
{
LVAL sym;
/* enter the unbound variable indicator (must be first) */
s_unbound = xlenter("*UNBOUND*");
setvalue(s_unbound,s_unbound);
/* enter the 't' symbol */
s_true = xlenter("T");
setvalue(s_true,s_true);
/* enter some important symbols */
s_dot = xlenter(".");
s_quote = xlenter("QUOTE");
s_function = xlenter("FUNCTION");
s_bquote = xlenter("BACKQUOTE");
s_comma = xlenter("COMMA");
s_comat = xlenter("COMMA-AT");
s_lambda = xlenter("LAMBDA");
s_macro = xlenter("MACRO");
s_eql = xlenter("EQL");
s_ifmt = xlenter("*INTEGER-FORMAT*");
s_ffmt = xlenter("*FLOAT-FORMAT*");
/* symbols set by the read-eval-print loop */
s_1plus = xlenter("+");
s_2plus = xlenter("++");
s_3plus = xlenter("+++");
s_1star = xlenter("*");
s_2star = xlenter("**");
s_3star = xlenter("***");
s_minus = xlenter("-");
/* enter setf place specifiers */
s_setf = xlenter("*SETF*");
s_car = xlenter("CAR");
s_cdr = xlenter("CDR");
s_nth = xlenter("NTH");
s_aref = xlenter("AREF");
s_get = xlenter("GET");
s_svalue = xlenter("SYMBOL-VALUE");
s_sfunction = xlenter("SYMBOL-FUNCTION");
s_splist = xlenter("SYMBOL-PLIST");
/* enter the readtable variable and keywords */
s_rtable = xlenter("*READTABLE*");
k_wspace = xlenter(":WHITE-SPACE");
k_const = xlenter(":CONSTITUENT");
k_nmacro = xlenter(":NMACRO");
k_tmacro = xlenter(":TMACRO");
k_sescape = xlenter(":SESCAPE");
k_mescape = xlenter(":MESCAPE");
/* enter parameter list keywords */
k_test = xlenter(":TEST");
k_tnot = xlenter(":TEST-NOT");
/* "open" keywords */
k_direction = xlenter(":DIRECTION");
k_input = xlenter(":INPUT");
k_output = xlenter(":OUTPUT");
/* enter *print-case* symbol and keywords */
s_printcase = xlenter("*PRINT-CASE*");
k_upcase = xlenter(":UPCASE");
k_downcase = xlenter(":DOWNCASE");
/* other keywords */
k_start = xlenter(":START");
k_end = xlenter(":END");
k_1start = xlenter(":START1");
k_1end = xlenter(":END1");
k_2start = xlenter(":START2");
k_2end = xlenter(":END2");
k_verbose = xlenter(":VERBOSE");
k_print = xlenter(":PRINT");
k_count = xlenter(":COUNT");
k_key = xlenter(":KEY");
/* enter lambda list keywords */
lk_optional = xlenter("&OPTIONAL");
lk_rest = xlenter("&REST");
lk_key = xlenter("&KEY");
lk_aux = xlenter("&AUX");
lk_allow_other_keys = xlenter("&ALLOW-OTHER-KEYS");
/* enter *standard-input*, *standard-output* and *error-output* */
s_stdin = xlenter("*STANDARD-INPUT*");
setvalue(s_stdin,cvfile(stdin));
s_stdout = xlenter("*STANDARD-OUTPUT*");
setvalue(s_stdout,cvfile(stdout));
s_stderr = xlenter("*ERROR-OUTPUT*");
setvalue(s_stderr,cvfile(STDERR));
/* enter *debug-io* and *trace-output* */
s_debugio = xlenter("*DEBUG-IO*");
setvalue(s_debugio,getvalue(s_stderr));
s_traceout = xlenter("*TRACE-OUTPUT*");
setvalue(s_traceout,getvalue(s_stderr));
/* enter the eval and apply hook variables */
s_evalhook = xlenter("*EVALHOOK*");
s_applyhook = xlenter("*APPLYHOOK*");
/* enter the symbol pointing to the list of functions being traced */
s_tracelist = xlenter("*TRACELIST*");
/* enter the error traceback and the error break enable flags */
s_tracenable = xlenter("*TRACENABLE*");
s_tlimit = xlenter("*TRACELIMIT*");
s_breakenable = xlenter("*BREAKENABLE*");
s_profile = xlenter("*PROFILE*");
/* enter the symbol pointing to the list of loading files */
s_loadingfiles = xlenter("*LOADINGFILES*");
/* enter a symbol to control printing of garbage collection messages */
s_gcflag = xlenter("*GC-FLAG*");
s_gchook = xlenter("*GC-HOOK*");
/* enter the symbol for the search path */
s_search_path = xlenter("*SEARCH-PATH*");
/* enter a copyright notice into the oblist */
sym = xlenter("**Copyright-1988-by-David-Betz**");
setvalue(sym,s_true);
/* enter type names */
a_subr = xlenter("SUBR");
a_fsubr = xlenter("FSUBR");
a_cons = xlenter("CONS");
a_symbol = xlenter("SYMBOL");
a_fixnum = xlenter("FIXNUM");
a_flonum = xlenter("FLONUM");
a_string = xlenter("STRING");
a_object = xlenter("OBJECT");
a_stream = xlenter("FILE-STREAM");
a_vector = xlenter("ARRAY");
a_extern = xlenter("EXTERN");
a_closure = xlenter("CLOSURE");
a_char = xlenter("CHARACTER");
a_ustream = xlenter("UNNAMED-STREAM");
/* add the object-oriented programming symbols and os specific stuff */
obsymbols(); /* object-oriented programming symbols */
ossymbols(); /* os specific symbols */
localsymbols(); /* lisp extension symbols */
}
/* xladdivar - enter an instance variable */
void xladdivar(LVAL cls, const char *var)
{
setivar(cls,IVARS,cons(xlenter(var),getivar(cls,IVARS)));
}
/* initwks - build an initial workspace */
LOCAL void initwks(void)
{
FUNDEF *p;
int i;
xlsinit(); /* initialize xlsym.c */
xlsymbols();/* enter all symbols used by the interpreter */
xlrinit(); /* initialize xlread.c */
xloinit(); /* initialize xlobj.c */
/* setup defaults */
setvalue(s_evalhook,NIL); /* no evalhook function */
setvalue(s_applyhook,NIL); /* no applyhook function */
setvalue(s_tracelist,NIL); /* no functions being traced */
setvalue(s_tracenable,NIL); /* traceback disabled */
setvalue(s_tlimit,NIL); /* trace limit infinite */
setvalue(s_breakenable,NIL); /* don't enter break loop on errors */
setvalue(s_loadingfiles,NIL); /* not loading any files initially */
setvalue(s_profile,NIL); /* don't do profiling */
setvalue(s_gcflag,NIL); /* don't show gc information */
setvalue(s_gchook,NIL); /* no gc hook active */
setvalue(s_ifmt,cvstring(IFMT)); /* integer print format */
setvalue(s_ffmt,cvstring("%g")); /* float print format */
setvalue(s_printcase,k_upcase); /* upper case output of symbols */
/* install the built-in functions and special forms */
for (i = 0, p = funtab; p->fd_subr != NULL; ++i, ++p)
if (p->fd_name)
xlsubr(p->fd_name,p->fd_type,p->fd_subr,i);
/* add some synonyms */
setfunction(xlenter("NOT"),getfunction(xlenter("NULL")));
setfunction(xlenter("FIRST"),getfunction(xlenter("CAR")));
setfunction(xlenter("SECOND"),getfunction(xlenter("CADR")));
setfunction(xlenter("THIRD"),getfunction(xlenter("CADDR")));
setfunction(xlenter("FOURTH"),getfunction(xlenter("CADDDR")));
setfunction(xlenter("REST"),getfunction(xlenter("CDR")));
}
void nyx_set_input_audio(nyx_audio_callback callback,
void *userdata,
int num_channels,
long len, double rate)
{
sample_type scale_factor = 1.0;
time_type t0 = 0.0;
nyx_susp_type *susp;
sound_type *snd;
double stretch_len;
LVAL warp;
int ch;
susp = (nyx_susp_type *)malloc(num_channels * sizeof(nyx_susp_type));
snd = (sound_type *)malloc(num_channels * sizeof(sound_type));
for(ch=0; ch < num_channels; ch++) {
falloc_generic(susp[ch], nyx_susp_node, "nyx_set_input_audio");
susp[ch]->callback = callback;
susp[ch]->userdata = userdata;
susp[ch]->len = len;
susp[ch]->channel = ch;
susp[ch]->susp.sr = rate;
susp[ch]->susp.t0 = t0;
susp[ch]->susp.mark = NULL;
susp[ch]->susp.print_tree = nyx_susp_print_tree;
susp[ch]->susp.current = 0;
susp[ch]->susp.fetch = nyx_susp_fetch;
susp[ch]->susp.free = nyx_susp_free;
susp[ch]->susp.name = "nyx";
snd[ch] = sound_create((snd_susp_type)susp[ch], t0,
rate,
scale_factor);
}
/* Bind the sample rate to the "*sound-srate*" global */
setvalue(xlenter("*SOUND-SRATE*"), cvflonum(rate));
/* Bind selection len to "len" global */
setvalue(xlenter("LEN"), cvflonum(len));
if (len > 0)
stretch_len = len / rate;
else
stretch_len = 1.0;
/* Set the "*warp*" global based on the length of the audio */
xlprot1(warp);
warp = cons(cvflonum(0), /* time offset */
cons(cvflonum(stretch_len), /* time stretch */
cons(NULL, /* cont. time warp */
NULL)));
setvalue(xlenter("*WARP*"), warp);
xlpop();
if (num_channels > 1) {
LVAL array = newvector(num_channels);
for(ch=0; ch<num_channels; ch++)
setelement(array, ch, cvsound(snd[ch]));
setvalue(xlenter("S"), array);
}
else {
LVAL s = cvsound(snd[0]);
setvalue(xlenter("S"), s);
}
}
NODE *xlsenter(char *name)
{
return (xlenter(name,1));
}
void nyx_set_audio_params( double rate )
{
/* Bind the sample rate to the "*sound-srate*" global */
setvalue(xlenter("*SOUND-SRATE*"), cvflonum(rate));
}