1 /**********************************************************************
2
3 nyx.c
4
5 Nyx: A very simple external interface to Nyquist
6
7 Dominic Mazzoni
8
9 **********************************************************************/
10
11 /* system includes */
12 #include <stdio.h>
13 #include <stdlib.h>
14 #include <string.h>
15 #include <errno.h>
16 #include <math.h>
17
18 #ifndef WIN32
19 #include <unistd.h>
20 #else
21 #include <windows.h>
22 #include <direct.h>
23 #endif
24
25 /* nyx includes */
26 #include "nyx.h"
27
28 /* xlisp includes */
29 #include "switches.h"
30 #include "xlisp.h"
31 #include "cext.h"
32
33 /* nyquist includes */
34 #include "sound.h"
35 #include "samples.h"
36 #include "falloc.h"
37
38 /* use full copy */
39 #define NYX_FULL_COPY 1
40
41 /* show memory stats */
42 // #define NYX_MEMORY_STATS 1
43
44 /* show details of obarray copy */
45 // #define NYX_DEBUG_COPY 1
46
47 /* macro to compute the size of a segment (taken from xldmem.h) */
48 #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
49
50 /* xldmem external variables */
51 extern long nnodes;
52 extern long nfree;
53 extern long total;
54 extern int nsegs;
55 extern SEGMENT *segs;
56 extern SEGMENT *lastseg;
57 extern LVAL fnodes;
58
59 /* nyquist externs */
60 extern LVAL a_sound;
61 extern snd_list_type zero_snd_list;
62
63 /* globals */
64 LOCAL nyx_os_callback nyx_os_cb = NULL;
65 LOCAL void *nyx_os_ud;
66 LOCAL nyx_output_callback nyx_output_cb;
67 LOCAL void *nyx_output_ud;
68 LOCAL int nyx_expr_pos;
69 LOCAL int nyx_expr_len;
70 LOCAL const char *nyx_expr_string;
71 LOCAL LVAL nyx_result;
72 LOCAL nyx_rval nyx_result_type = nyx_error;
73 LOCAL XLCONTEXT nyx_cntxt;
74 LOCAL int nyx_first_time = 1;
75 LOCAL LVAL nyx_obarray;
76 LOCAL FLOTYPE nyx_warp_stretch;
77 LOCAL long nyx_input_length = 0;
78 LOCAL char *nyx_audio_name = NULL;
79
80 /* Suspension node */
81 typedef struct nyx_susp_struct {
82 snd_susp_node susp; // Must be first
83 nyx_audio_callback callback;
84 void *userdata;
85 long len;
86 int channel;
87 } nyx_susp_node, *nyx_susp_type;
88
89 #if defined(NYX_DEBUG_COPY) && NYX_DEBUG_COPY
90 static const char *_types_[] =
91 {
92 "FREE_NODE",
93 "SUBR",
94 "FSUBR",
95 "CONS",
96 "SYMBOL",
97 "FIXNUM",
98 "FLONUM",
99 "STRING",
100 "OBJECT",
101 "STREAM",
102 "VECTOR",
103 "CLOSURE",
104 "CHAR",
105 "USTREAM",
106 "EXTERN"
107 };
108
109 // Dump the contents of the obarray
nyx_show_obarray()110 LOCAL void nyx_show_obarray()
111 {
112 LVAL array = getvalue(obarray);
113 LVAL sym;
114 int i;
115
116 for (i = 0; i < HSIZE; i++) {
117 for (sym = getelement(array, i); sym; sym = cdr(sym)) {
118 LVAL syma = car(sym);
119
120 printf("_sym_ = ");
121 xlprint(getvalue(s_stdout), syma, TRUE);
122
123 if (getvalue(syma)) {
124 printf(" _type_ = %s _val_ = ", _types_[ntype(getvalue(syma))]);
125 xlprint(getvalue(s_stdout), getvalue(syma), TRUE);
126 }
127
128 if (getfunction(syma)) {
129 printf(" _type_ = %s _fun_ = ", _types_[ntype(getfunction(syma))]);
130 xlprint(getvalue(s_stdout), getfunction(syma), TRUE);
131 }
132
133 printf("\n");
134 }
135 }
136 }
137 #endif
138
139 //
140 // Free empty segments
141 //
freesegs()142 LOCAL void freesegs()
143 {
144 SEGMENT *seg;
145 SEGMENT *next;
146
147 // Free up as many nodes as possible
148 gc();
149
150 // Reset free node tracking
151 fnodes = NIL;
152 nfree = 0L;
153
154 // Reset the last segment pointer
155 lastseg = NULL;
156
157 // Scan all segments
158 for (seg = segs; seg != NULL; seg = next) {
159 int n = seg->sg_size;
160 int empty = TRUE;
161 int i;
162 LVAL p;
163
164 // Check this segment for in-use nodes
165 p = &seg->sg_nodes[0];
166 for (i = n; --i >= 0; ++p) {
167 if (ntype(p) != FREE_NODE) {
168 empty = FALSE;
169 break;
170 }
171 }
172
173 // Retain pointer to next segment
174 next = seg->sg_next;
175
176 // Was the current segment empty?
177 if (empty) {
178 // Free the segment;
179 free((void *) seg);
180
181 // Unlink it from the list. No need to worry about a NULL lastseg
182 // pointer here since the fixnum and char segments will always exist
183 // at the head of the list and they will always have nodes. So, lastseg
184 // will have been set before we find any empty nodes.
185 lastseg->sg_next = next;
186
187 // Reduce the stats
188 total -= (long) segsize(n);
189 nsegs--;
190 nnodes -= n;
191 }
192 else {
193 // Not empty, so remember this node as the last segment
194 lastseg = seg;
195
196 // Add all of the free nodes in this segment to the free list
197 p = &seg->sg_nodes[0];
198 for (i = n; --i >= 0; ++p) {
199 if (ntype(p) == FREE_NODE) {
200 rplaca(p, NIL);
201 rplacd(p, fnodes);
202 fnodes = p;
203 nfree++;
204 }
205 }
206 }
207 }
208 }
209
210 #if defined(NYX_FULL_COPY) && NYX_FULL_COPY
211
212 // Copy a node (recursively if appropriate)
nyx_dup_value(LVAL val)213 LOCAL LVAL nyx_dup_value(LVAL val)
214 {
215 LVAL nval = val;
216
217 // Protect old and new values
218 xlprot1(val);
219 xlprot1(nval);
220
221 // Copy the node
222 if (val != NIL) {
223 switch (ntype(val))
224 {
225 case FIXNUM:
226 nval = cvfixnum(getfixnum(val));
227 break;
228
229 case FLONUM:
230 nval = cvflonum(getflonum(val));
231 break;
232
233 case CHAR:
234 nval = cvchar(getchcode(val));
235 break;
236
237 case STRING:
238 nval = cvstring((char *) getstring(val));
239 break;
240
241 case VECTOR:
242 {
243 int len = getsize(val);
244 int i;
245
246 nval = newvector(len);
247 nval->n_type = ntype(val);
248
249 for (i = 0; i < len; i++) {
250 if (getelement(val, i) == val) {
251 setelement(nval, i, val);
252 }
253 else {
254 setelement(nval, i, nyx_dup_value(getelement(val, i)));
255 }
256 }
257 }
258 break;
259
260 case CONS:
261 nval = nyx_dup_value(cdr(val));
262 nval = cons(nyx_dup_value(car(val)), nval);
263 break;
264
265 case SUBR:
266 case FSUBR:
267 nval = cvsubr(getsubr(val), ntype(val), getoffset(val));
268 break;
269
270 // Symbols should never be copied since their addresses are cached
271 // all over the place.
272 case SYMBOL:
273 nval = val;
274 break;
275
276 // Streams are not copied (although USTREAM could be) and reference
277 // the original value.
278 case USTREAM:
279 case STREAM:
280 nval = val;
281 break;
282
283 // Externals aren't copied because I'm not entirely certain they can be.
284 case EXTERN:
285 nval = val;
286 break;
287
288 // For all other types, just allow them to reference the original
289 // value. Probably not the right thing to do, but easier.
290 case OBJECT:
291 case CLOSURE:
292 default:
293 nval = val;
294 break;
295 }
296 }
297
298 xlpop();
299 xlpop();
300
301 return nval;
302 }
303
304 // Make a copy of the original obarray, leaving the original in place
nyx_save_obarray()305 LOCAL void nyx_save_obarray()
306 {
307 LVAL newarray;
308 int i;
309
310 // This provide permanent protection for nyx_obarray as we do not want it
311 // to be garbage-collected.
312 xlprot1(nyx_obarray);
313 nyx_obarray = getvalue(obarray);
314
315 // Create and set the new vector. This allows us to use xlenter() to
316 // properly add the new symbol. Probably slower than adding directly,
317 // but guarantees proper hashing.
318 newarray = newvector(HSIZE);
319 setvalue(obarray, newarray);
320
321 // Scan all obarray vectors
322 for (i = 0; i < HSIZE; i++) {
323 LVAL sym;
324
325 // Scan all elements
326 for (sym = getelement(nyx_obarray, i); sym; sym = cdr(sym)) {
327 LVAL syma = car(sym);
328 char *name = (char *) getstring(getpname(syma));
329 LVAL nsym = xlenter(name);
330
331 // Ignore *OBARRAY* since there's no need to copy it
332 if (strcmp(name, "*OBARRAY*") == 0) {
333 continue;
334 }
335
336 // Ignore *SCRATCH* since it's allowed to be updated
337 if (strcmp(name, "*SCRATCH*") == 0) {
338 continue;
339 }
340
341 // Duplicate the symbol's values
342 setvalue(nsym, nyx_dup_value(getvalue(syma)));
343 setplist(nsym, nyx_dup_value(getplist(syma)));
344 setfunction(nsym, nyx_dup_value(getfunction(syma)));
345 }
346 }
347
348 // Swap the obarrays, so that the original is put back into service
349 setvalue(obarray, nyx_obarray);
350 nyx_obarray = newarray;
351 }
352
353 // Restore the symbol values to their original value and remove any added
354 // symbols.
nyx_restore_obarray()355 LOCAL void nyx_restore_obarray()
356 {
357 LVAL obvec = getvalue(obarray);
358 LVAL sscratch = xlenter("*SCRATCH*"); // one-time lookup
359 int i;
360
361 // Scan all obarray vectors
362 for (i = 0; i < HSIZE; i++) {
363 LVAL last = NULL;
364 LVAL dcon;
365
366 // Scan all elements
367 for (dcon = getelement(obvec, i); dcon; dcon = cdr(dcon)) {
368 LVAL dsym = car(dcon);
369 char *name = (char *)getstring(getpname(dsym));
370 LVAL scon;
371
372 // Ignore *OBARRAY* since setting it causes the input array to be
373 // truncated.
374 if (strcmp(name, "*OBARRAY*") == 0) {
375 continue;
376 }
377
378 // Ignore *SCRATCH* since it's allowed to be updated
379 if (strcmp(name, "*SCRATCH*") == 0) {
380 continue;
381 }
382
383 // Find the symbol in the original obarray.
384 for (scon = getelement(nyx_obarray, hash(name, HSIZE)); scon; scon = cdr(scon)) {
385 LVAL ssym = car(scon);
386
387 // If found, then set the current symbols value to the original.
388 if (strcmp(name, (char *)getstring(getpname(ssym))) == 0) {
389 setvalue(dsym, nyx_dup_value(getvalue(ssym)));
390 setplist(dsym, nyx_dup_value(getplist(ssym)));
391 setfunction(dsym, nyx_dup_value(getfunction(ssym)));
392 break;
393 }
394 }
395
396 // If we didn't find the symbol in the original obarray, then it
397 // must've been added and must be removed from the current obarray.
398 // Exception: if the new symbol is a property symbol of *scratch*,
399 // then allow the symbol to stay; otherwise, property lookups will
400 // fail.
401 if (scon == NULL) {
402 // check property list of scratch
403 if (findprop(sscratch, dsym) == NIL) {
404 if (last) {
405 rplacd(last, cdr(dcon));
406 }
407 else {
408 setelement(obvec, i, cdr(dcon));
409 }
410 } // otherwise, keep new property symbol
411 }
412
413 // Must track the last dcon for symbol removal
414 last = dcon;
415 }
416 }
417 }
418
419 #else
420
copylist(LVAL from)421 LOCAL LVAL copylist(LVAL from)
422 {
423 if (from == NULL) {
424 return NULL;
425 }
426
427 return cons(car(from), copylist(cdr(from)));
428 }
429
430 /* Make a copy of the obarray so that we can erase any
431 changes the user makes to global variables */
nyx_copy_obarray()432 LOCAL void nyx_copy_obarray()
433 {
434 LVAL newarray;
435 int i;
436
437 // Create and set the new vector.
438 newarray = newvector(HSIZE);
439 setvalue(obarray, newarray);
440
441 for (i = 0; i < HSIZE; i++) {
442 LVAL from = getelement(nyx_obarray, i);
443 if (from) {
444 setelement(newarray, i, copylist(from));
445 }
446 }
447 }
448
449 #endif
450
nyx_init()451 void nyx_init()
452 {
453 if (nyx_first_time) {
454 char *argv[1];
455 argv[0] = "nyquist";
456 xlisp_main_init(1, argv);
457
458 nyx_audio_name = NULL;
459 nyx_os_cb = NULL;
460 nyx_output_cb = NULL;
461
462 nyx_first_time = 0;
463
464 #if defined(NYX_FULL_COPY) && NYX_FULL_COPY
465 // Save a copy of the original obarray's contents.
466 nyx_save_obarray();
467 #else
468 // Permanently protect the original obarray value. This is needed since
469 // it would be unreferenced in the new obarray and would be garbage
470 // collected. We want to keep it around so we can make copies of it to
471 // refresh the execution state.
472 xlprot1(nyx_obarray);
473 nyx_obarray = getvalue(obarray);
474 #endif
475 }
476
477 #if !defined(NYX_FULL_COPY) || !NYX_FULL_COPY
478 // Create a copy of the original obarray
479 nyx_copy_obarray();
480 #endif
481
482 // Keep nyx_result from being garbage-collected
483 xlprot1(nyx_result);
484
485 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
486 printf("\nnyx_init\n");
487 xmem();
488 #endif
489 }
490
nyx_cleanup()491 void nyx_cleanup()
492 {
493 // Garbage-collect nyx_result
494 xlpop();
495
496 #if defined(NYX_FULL_COPY) && NYX_FULL_COPY
497
498 // Restore the original symbol values
499 nyx_restore_obarray();
500
501 #else
502
503 // Restore obarray to original state...but not the values
504 setvalue(obarray, nyx_obarray);
505
506 #endif
507
508 // Make sure the sound nodes can be garbage-collected. Sounds are EXTERN
509 // nodes whose value does not get copied during a full copy of the obarray.
510 setvalue(xlenter(nyx_get_audio_name()), NIL);
511
512 // Free excess memory segments - does a gc()
513 freesegs();
514
515 // Free unused memory pools
516 falloc_gc();
517
518 // No longer need the callbacks
519 nyx_output_cb = NULL;
520 nyx_os_cb = NULL;
521
522 // Reset vars
523 nyx_input_length = 0;
524
525 if (nyx_audio_name) {
526 free(nyx_audio_name);
527 nyx_audio_name = NULL;
528 }
529
530 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
531 printf("\nnyx_cleanup\n");
532 xmem();
533 #endif
534 }
535
nyx_set_xlisp_path(const char * path)536 void nyx_set_xlisp_path(const char *path)
537 {
538 set_xlisp_path(path);
539 }
540
nyx_susp_fetch(nyx_susp_type susp,snd_list_type snd_list)541 LOCAL void nyx_susp_fetch(nyx_susp_type susp, snd_list_type snd_list)
542 {
543 sample_block_type out;
544 sample_block_values_type out_ptr;
545 long n;
546 int err;
547
548 falloc_sample_block(out, "nyx_susp_fetch");
549 out_ptr = out->samples;
550 snd_list->block = out;
551
552 n = max_sample_block_len;
553 if (susp->susp.current + n > susp->len) {
554 n = susp->len - susp->susp.current;
555 }
556
557 err = susp->callback(out_ptr, susp->channel,
558 susp->susp.current, n, 0, susp->userdata);
559 if (err) {
560 // The user canceled or some other error occurred, so we use
561 // xlsignal() to jump back to our error handler.
562 xlsignal(NULL, NULL);
563 // never get here.
564 }
565
566 snd_list->block_len = (short)n;
567 susp->susp.current += n;
568
569 if (n == 0) {
570 /* we didn't read anything, but can't return length zero, so
571 convert snd_list to pointer to zero block */
572 snd_list_terminate(snd_list);
573 }
574 else if (n < max_sample_block_len) {
575 /* should free susp */
576 snd_list_unref(snd_list->u.next);
577 /* if something is in buffer, terminate by pointing to zero block */
578 snd_list->u.next = zero_snd_list;
579 }
580 }
581
nyx_susp_free(nyx_susp_type susp)582 LOCAL void nyx_susp_free(nyx_susp_type susp)
583 {
584 ffree_generic(susp, sizeof(nyx_susp_node), "nyx_susp_free");
585 }
586
nyx_susp_print_tree(nyx_susp_type susp,int n)587 LOCAL void nyx_susp_print_tree(nyx_susp_type susp, int n)
588 {
589 }
590
nyx_capture_output(nyx_output_callback callback,void * userdata)591 void nyx_capture_output(nyx_output_callback callback, void *userdata)
592 {
593 nyx_output_cb = callback;
594 nyx_output_ud = userdata;
595 }
596
nyx_get_audio_name()597 char *nyx_get_audio_name()
598 {
599 if (!nyx_audio_name) {
600 nyx_audio_name = strdup("S");
601 }
602
603 return nyx_audio_name;
604 }
605
nyx_set_audio_name(const char * name)606 void nyx_set_audio_name(const char *name)
607 {
608 if (nyx_audio_name) {
609 free(nyx_audio_name);
610 nyx_audio_name = NULL;
611 }
612
613 nyx_audio_name = strdup(name);
614 }
615
nyx_set_audio_params(double rate,long len)616 void nyx_set_audio_params(double rate, long len)
617 {
618 LVAL flo;
619 LVAL con;
620
621 xlstkcheck(2);
622 xlsave(flo);
623 xlsave(con);
624
625 /* Bind the sample rate to the "*sound-srate*" global */
626 flo = cvflonum(rate);
627 setvalue(xlenter("*DEFAULT-SOUND-SRATE*"), flo);
628 setvalue(xlenter("*SOUND-SRATE*"), flo);
629
630 /* Bind the control sample rate to "*control-srate*" globals */
631 flo = cvflonum((double) rate / 20.0);
632 setvalue(xlenter("*DEFAULT-CONTROL-SRATE*"), flo);
633 setvalue(xlenter("*CONTROL-SRATE*"), flo);
634
635 /* Bind selection len to "len" global */
636 nyx_input_length = len;
637 flo = cvflonum(len);
638 setvalue(xlenter("LEN"), flo);
639
640 /* Set the "*warp*" global based on the length of the audio */
641 con = cons(NULL, NULL);
642 flo = cvflonum(len > 0 ? (double) len / rate : 1.0);
643 con = cons(flo, con);
644 flo = cvflonum(0);
645 con = cons(flo, con);
646 setvalue(xlenter("*WARP*"), con);
647
648 xlpopn(2);
649 }
650
nyx_set_input_audio(nyx_audio_callback callback,void * userdata,int num_channels,long len,double rate)651 void nyx_set_input_audio(nyx_audio_callback callback,
652 void *userdata,
653 int num_channels,
654 long len, double rate)
655 {
656 LVAL val;
657 int ch;
658
659 nyx_set_audio_params(rate, len);
660
661 if (num_channels > 1) {
662 val = newvector(num_channels);
663 }
664
665 xlprot1(val);
666
667 for (ch = 0; ch < num_channels; ch++) {
668 nyx_susp_type susp;
669 sound_type snd;
670
671 falloc_generic(susp, nyx_susp_node, "nyx_set_input_audio");
672
673 susp->callback = callback;
674 susp->userdata = userdata;
675 susp->len = len;
676 susp->channel = ch;
677
678 susp->susp.fetch = (snd_fetch_fn)nyx_susp_fetch;
679 susp->susp.keep_fetch = NULL;
680 susp->susp.free = (snd_free_fn)nyx_susp_free;
681 susp->susp.mark = NULL;
682 susp->susp.print_tree = (snd_print_tree_fn)nyx_susp_print_tree;
683 susp->susp.name = "nyx";
684 susp->susp.toss_cnt = 0;
685 susp->susp.current = 0;
686 susp->susp.sr = rate;
687 susp->susp.t0 = 0.0;
688 susp->susp.log_stop_cnt = 0;
689
690 snd = sound_create((snd_susp_type) susp, 0.0, rate, 1.0);
691 if (num_channels > 1) {
692 setelement(val, ch, cvsound(snd));
693 }
694 else {
695 val = cvsound(snd);
696 }
697 }
698
699 setvalue(xlenter(nyx_get_audio_name()), val);
700
701 xlpop();
702 }
703
nyx_is_labels(LVAL expr)704 LOCAL int nyx_is_labels(LVAL expr)
705 {
706 /* make sure that we have a list whose first element is a
707 list of the form (time "label") */
708
709 LVAL label;
710 LVAL first;
711 LVAL second;
712 LVAL third;
713
714 if (expr == NULL) {
715 return 0;
716 }
717
718 while (expr != NULL) {
719 if (!consp(expr)) {
720 return 0;
721 }
722
723 label = car(expr);
724
725 if (!consp(label)) {
726 return 0;
727 }
728
729 first = car(label);
730 if (!(floatp(first) || fixp(first))) {
731 return 0;
732 }
733
734 if (!consp(cdr(label))) {
735 return 0;
736 }
737
738 second = car(cdr(label));
739
740 if (floatp(second) || fixp(second)) {
741 if (!consp(cdr(cdr(label)))) {
742 return 0;
743 }
744 third = car(cdr(cdr(label)));
745 if (!(stringp(third))) {
746 return 0;
747 }
748 }
749 else {
750 if (!(stringp(second))) {
751 return 0;
752 }
753 }
754
755 expr = cdr(expr);
756 }
757
758 return 1;
759 }
760
nyx_get_type(LVAL expr)761 nyx_rval nyx_get_type(LVAL expr)
762 {
763 if (nyx_result_type != nyx_error) {
764 return nyx_result_type;
765 }
766
767 nyx_result_type = nyx_error;
768
769 if (expr == NULL) {
770 return nyx_result_type;
771 }
772
773 switch (ntype(expr))
774 {
775 case FIXNUM:
776 nyx_result_type = nyx_int;
777 break;
778
779 case FLONUM:
780 nyx_result_type = nyx_double;
781 break;
782
783 case STRING:
784 nyx_result_type = nyx_string;
785 break;
786
787 case VECTOR:
788 {
789 /* make sure it's a vector of sounds */
790 int i;
791 nyx_result_type = nyx_audio;
792 for (i = 0; i < getsize(expr); i++) {
793 if (!soundp(getelement(expr, i))) {
794 nyx_result_type = nyx_error;
795 break;
796 }
797 }
798 }
799 break;
800
801 case CONS:
802 {
803 /* see if it's a list of time/string pairs representing a
804 label track */
805 if (nyx_is_labels(expr)) {
806 nyx_result_type = nyx_labels;
807 } else {
808 nyx_result_type = nyx_list;
809 }
810 }
811 break;
812
813 case EXTERN:
814 {
815 if (soundp(expr)) {
816 nyx_result_type = nyx_audio;
817 }
818 }
819 break;
820 } /* switch */
821
822 return nyx_result_type;
823 }
824
nyx_eval_expression(const char * expr_string)825 nyx_rval nyx_eval_expression(const char *expr_string)
826 {
827 LVAL expr = NULL;
828
829 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
830 printf("\nnyx_eval_expression before\n");
831 xmem();
832 #endif
833
834 nyx_result = NULL;
835 nyx_result_type = nyx_error;
836
837 // Check argument
838 if (!expr_string || !strlen(expr_string)) {
839 return nyx_get_type(nyx_result);
840 }
841
842 nyx_expr_string = expr_string;
843 nyx_expr_len = strlen(nyx_expr_string);
844 nyx_expr_pos = 0;
845
846 // Protect the expression from being garbage collected
847 xlprot1(expr);
848
849 // Setup a new context
850 xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
851
852 // Set the context jump destination
853 if (_setjmp(nyx_cntxt.c_jmpbuf)) {
854 // If the script is cancelled or some other condition occurs that causes
855 // the script to exit and return to this level, then we don't need to
856 // restore the previous context.
857 goto finish;
858 }
859
860 while (nyx_expr_pos < nyx_expr_len) {
861 expr = NULL;
862
863 // Read an expression
864 if (!xlread(getvalue(s_stdin), &expr, FALSE)) {
865 break;
866 }
867
868 #if 0
869 /* save the input expression (so the user can refer to it
870 as +, ++, or +++) */
871 xlrdsave(expr);
872 #endif
873
874 // Evaluate the expression
875 nyx_result = xleval(expr);
876 }
877
878 // This will unwind the xlisp context and restore internals to a point just
879 // before we issued our xlbegin() above. This is important since the internal
880 // xlisp stacks will contain pointers to invalid objects otherwise.
881 //
882 // Also note that execution will jump back up to the statement following the
883 // _setjmp() above.
884 xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
885 // Never reached
886
887 finish:
888
889 xlflush();
890
891 xlpop(); // unprotect expr
892
893 setvalue(xlenter(nyx_get_audio_name()), NIL);
894
895 gc();
896
897 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
898 printf("\nnyx_eval_expression after\n");
899 xmem();
900 #endif
901
902 return nyx_get_type(nyx_result);
903 }
904
nyx_get_audio_num_channels()905 int nyx_get_audio_num_channels()
906 {
907 if (nyx_get_type(nyx_result) != nyx_audio) {
908 return 0;
909 }
910
911 if (vectorp(nyx_result)) {
912 if (getsize(nyx_result) == 1) {
913 return -1; // invalid number of channels in array
914 } else {
915 return getsize(nyx_result);
916 }
917 }
918
919 return 1;
920 }
921
nyx_get_audio(nyx_audio_callback callback,void * userdata)922 int nyx_get_audio(nyx_audio_callback callback, void *userdata)
923 {
924 float *buffer = NULL;
925 sound_type *snds = NULL;
926 long *totals = NULL;
927 long *lens = NULL;
928 sound_type snd;
929 int result = 0;
930 int num_channels;
931 int ch;
932
933 // Any variable whose value is set between the _setjmp() and the "finish" label
934 // and that is used after the "finish" label, must be marked volatile since
935 // any routine outside of the current one that calls _longjmp() will cause values
936 // cached in registers to be lost.
937 volatile int success = FALSE;
938
939 if (nyx_get_type(nyx_result) != nyx_audio) {
940 return FALSE;
941 }
942
943 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
944 printf("\nnyx_get_audio before\n");
945 xmem();
946 #endif
947
948 num_channels = nyx_get_audio_num_channels();
949
950 buffer = (sample_type *) malloc(max_sample_block_len * sizeof(sample_type));
951 if (buffer == NULL) {
952 goto finish;
953 }
954
955 snds = (sound_type *) malloc(num_channels * sizeof(sound_type));
956 if (snds == NULL) {
957 goto finish;
958 }
959
960 totals = (long *) malloc(num_channels * sizeof(long));
961 if (totals == NULL) {
962 goto finish;
963 }
964
965 lens = (long *) malloc(num_channels * sizeof(long));
966 if (lens == NULL) {
967 goto finish;
968 }
969
970 // Setup a new context
971 xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
972
973 // Set the context jump destination
974 if (_setjmp(nyx_cntxt.c_jmpbuf)) {
975 // If the script is cancelled or some other condition occurs that causes
976 // the script to exit and return to this level, then we don't need to
977 // restore the previous context.
978 goto finish;
979 }
980
981 if (nyx_input_length == 0) {
982 LVAL val = getvalue(xlenter("LEN"));
983 if (val != s_unbound) {
984 if (ntype(val) == FLONUM) {
985 nyx_input_length = (long) getflonum(val);
986 }
987 else if (ntype(val) == FIXNUM) {
988 nyx_input_length = (long) getfixnum(val);
989 }
990 }
991 }
992
993 for (ch = 0; ch < num_channels; ch++) {
994 if (num_channels == 1) {
995 snd = getsound(nyx_result);
996 }
997 else {
998 snd = getsound(getelement(nyx_result, ch));
999 }
1000 snds[ch] = snd;
1001 totals[ch] = 0;
1002 lens[ch] = nyx_input_length;
1003 }
1004
1005 while (result == 0) {
1006 for (ch =0 ; ch < num_channels; ch++) {
1007 sample_block_type block;
1008 long cnt;
1009 int i;
1010
1011 snd = snds[ch];
1012
1013 cnt = 0;
1014 block = sound_get_next(snd, &cnt);
1015 if (block == zero_block || cnt == 0) {
1016 success = TRUE;
1017 result = -1;
1018 break;
1019 }
1020
1021 // Copy and scale the samples
1022 for (i = 0; i < cnt; i++) {
1023 buffer[i] = block->samples[i] * snd->scale;
1024 }
1025
1026 result = callback((float *)buffer, ch,
1027 totals[ch], cnt, lens[ch] ? lens[ch] : cnt, userdata);
1028
1029 if (result != 0) {
1030 result = -1;
1031 break;
1032 }
1033
1034 totals[ch] += cnt;
1035 }
1036 }
1037
1038 // This will unwind the xlisp context and restore internals to a point just
1039 // before we issued our xlbegin() above. This is important since the internal
1040 // xlisp stacks will contain pointers to invalid objects otherwise.
1041 //
1042 // Also note that execution will jump back up to the statement following the
1043 // _setjmp() above.
1044 xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
1045 // Never reached
1046
1047 finish:
1048
1049 if (buffer) {
1050 free(buffer);
1051 }
1052
1053 if (lens) {
1054 free(lens);
1055 }
1056
1057 if (totals) {
1058 free(totals);
1059 }
1060
1061 if (snds) {
1062 free(snds);
1063 }
1064
1065 gc();
1066
1067 #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
1068 printf("\nnyx_get_audio after\n");
1069 xmem();
1070 #endif
1071
1072 return success;
1073 }
1074
nyx_get_int()1075 int nyx_get_int()
1076 {
1077 if (nyx_get_type(nyx_result) != nyx_int) {
1078 return -1;
1079 }
1080
1081 return getfixnum(nyx_result);
1082 }
1083
nyx_get_double()1084 double nyx_get_double()
1085 {
1086 if (nyx_get_type(nyx_result) != nyx_double) {
1087 return -1.0;
1088 }
1089
1090 return getflonum(nyx_result);
1091 }
1092
nyx_get_string()1093 const char *nyx_get_string()
1094 {
1095 if (nyx_get_type(nyx_result) != nyx_string) {
1096 return NULL;
1097 }
1098
1099 return (const char *)getstring(nyx_result);
1100 }
1101
nyx_get_num_labels()1102 unsigned int nyx_get_num_labels()
1103 {
1104 LVAL s;
1105 int count = 0;
1106
1107 if (nyx_get_type(nyx_result) != nyx_labels) {
1108 return 0;
1109 }
1110
1111 for (s = nyx_result; s; s = cdr(s)) {
1112 count++;
1113 }
1114
1115 return count;
1116 }
1117
nyx_get_label(unsigned int index,double * start_time,double * end_time,const char ** label)1118 void nyx_get_label(unsigned int index,
1119 double *start_time,
1120 double *end_time,
1121 const char **label)
1122 {
1123 LVAL s = nyx_result;
1124 LVAL label_expr;
1125 LVAL t0_expr;
1126 LVAL t1_expr;
1127 LVAL str_expr;
1128
1129 if (nyx_get_type(nyx_result) != nyx_labels) {
1130 return;
1131 }
1132
1133 while (index) {
1134 index--;
1135 s = cdr(s);
1136 if (s == NULL) {
1137 // index was larger than number of labels
1138 return;
1139 }
1140 }
1141
1142 /* We either have (t0 "label") or (t0 t1 "label") */
1143
1144 label_expr = car(s);
1145 t0_expr = car(label_expr);
1146 t1_expr = car(cdr(label_expr));
1147 if (stringp(t1_expr)) {
1148 str_expr = t1_expr;
1149 t1_expr = t0_expr;
1150 }
1151 else {
1152 str_expr = car(cdr(cdr(label_expr)));
1153 }
1154
1155 if (floatp(t0_expr)) {
1156 *start_time = getflonum(t0_expr);
1157 }
1158 else if (fixp(t0_expr)) {
1159 *start_time = (double)getfixnum(t0_expr);
1160 }
1161
1162 if (floatp(t1_expr)) {
1163 *end_time = getflonum(t1_expr);
1164 }
1165 else if (fixp(t1_expr)) {
1166 *end_time = (double)getfixnum(t1_expr);
1167 }
1168
1169 *label = (const char *)getstring(str_expr);
1170 }
1171
nyx_get_error_str()1172 const char *nyx_get_error_str()
1173 {
1174 return NULL;
1175 }
1176
nyx_set_os_callback(nyx_os_callback callback,void * userdata)1177 void nyx_set_os_callback(nyx_os_callback callback, void *userdata)
1178 {
1179 nyx_os_cb = callback;
1180 nyx_os_ud = userdata;
1181 }
1182
nyx_stop()1183 void nyx_stop()
1184 {
1185 xlflush();
1186 xltoplevel();
1187 }
1188
nyx_break()1189 void nyx_break()
1190 {
1191 xlflush();
1192 xlbreak("BREAK", s_unbound);
1193 }
1194
nyx_continue()1195 void nyx_continue()
1196 {
1197 xlflush();
1198 xlcontinue();
1199 }
1200
ostgetc()1201 int ostgetc()
1202 {
1203 if (nyx_expr_pos < nyx_expr_len) {
1204 fflush(stdout);
1205 return (nyx_expr_string[nyx_expr_pos++]);
1206 }
1207 else if (nyx_expr_pos == nyx_expr_len) {
1208 /* Add whitespace at the end so that the parser
1209 knows that this is the end of the expression */
1210 nyx_expr_pos++;
1211 return '\n';
1212 }
1213
1214 return EOF;
1215 }
1216
1217 /* osinit - initialize */
osinit(const char * banner)1218 void osinit(const char *banner)
1219 {
1220 }
1221
1222 /* osfinish - clean up before returning to the operating system */
osfinish(void)1223 void osfinish(void)
1224 {
1225 }
1226
1227 /* oserror - print an error message */
oserror(const char * msg)1228 void oserror(const char *msg)
1229 {
1230 errputstr(msg);
1231 }
1232
osrand(long n)1233 long osrand(long n)
1234 {
1235 return (((int) rand()) % n);
1236 }
1237
1238 /* cd ..
1239 open - open an ascii file */
osaopen(const char * name,const char * mode)1240 FILE *osaopen(const char *name, const char *mode)
1241 {
1242 return fopen(name, mode);
1243 }
1244
1245 /* osbopen - open a binary file */
osbopen(const char * name,const char * mode)1246 FILE *osbopen(const char *name, const char *mode)
1247 {
1248 char bmode[10];
1249
1250 strncpy(bmode, mode, 8);
1251 strcat(bmode, "b");
1252
1253 return fopen(name,bmode);
1254 }
1255
1256 /* osclose - close a file */
osclose(FILE * fp)1257 int osclose(FILE *fp)
1258 {
1259 return fclose(fp);
1260 }
1261
1262 /* osagetc - get a character from an ascii file */
osagetc(FILE * fp)1263 int osagetc(FILE *fp)
1264 {
1265 return getc(fp);
1266 }
1267
1268 /* osaputc - put a character to an ascii file */
osaputc(int ch,FILE * fp)1269 int osaputc(int ch, FILE *fp)
1270 {
1271 return putc(ch,fp);
1272 }
1273
1274 /* osoutflush - flush output to a file */
osoutflush(FILE * fp)1275 void osoutflush(FILE *fp)
1276 {
1277 fflush(fp);
1278 }
1279
1280 /* osbgetc - get a character from a binary file */
osbgetc(FILE * fp)1281 int osbgetc(FILE *fp)
1282 {
1283 return getc(fp);
1284 }
1285
1286 /* osbputc - put a character to a binary file */
osbputc(int ch,FILE * fp)1287 int osbputc(int ch, FILE *fp)
1288 {
1289 return putc(ch, fp);
1290 }
1291
1292 /* ostputc - put a character to the terminal */
ostputc(int ch)1293 void ostputc(int ch)
1294 {
1295 oscheck(); /* check for control characters */
1296
1297 if (nyx_output_cb) {
1298 nyx_output_cb(ch, nyx_output_ud);
1299 }
1300 else {
1301 putchar((char) ch);
1302 }
1303 }
1304
1305 /* ostoutflush - flush output buffer */
ostoutflush()1306 void ostoutflush()
1307 {
1308 if (!nyx_output_cb) {
1309 fflush(stdout);
1310 }
1311 }
1312
1313 /* osflush - flush the terminal input buffer */
osflush(void)1314 void osflush(void)
1315 {
1316 }
1317
1318 /* oscheck - check for control characters during execution */
oscheck(void)1319 void oscheck(void)
1320 {
1321 if (nyx_os_cb) {
1322 nyx_os_cb(nyx_os_ud);
1323 }
1324 /* if they hit control-c:
1325 xflush(); xltoplevel(); return;
1326 */
1327 }
1328
1329 /* xsystem - execute a system command */
xsystem()1330 LVAL xsystem()
1331 {
1332 if (moreargs()) {
1333 unsigned char *cmd;
1334 cmd = (unsigned char *)getstring(xlgastring());
1335 fprintf(stderr, "Will not execute system command: %s\n", cmd);
1336 }
1337 return s_true;
1338 }
1339
1340 /* xsetdir -- set current directory of the process */
xsetdir()1341 LVAL xsetdir()
1342 {
1343 char *dir = (char *)getstring(xlgastring());
1344 int result;
1345 LVAL cwd = NULL;
1346 int verbose = TRUE;
1347
1348 if (moreargs()) {
1349 verbose = (xlgetarg() != NIL);
1350 }
1351
1352 xllastarg();
1353
1354 result = chdir(dir);
1355 if (result) {
1356 /* perror("SETDIR"); -- Nyquist uses SETDIR to search for directories
1357 * at startup, so failures are normal, and seeing error messages
1358 * could be confusing, so don't print them. The NULL return indicates
1359 * an error, but doesn't tell which one it is.
1360 * But now, SETDIR has a second verbose parameter that is nil when
1361 * searching for directories. -RBD
1362 */
1363 if (verbose) perror("Directory Setting Error");
1364 return NULL;
1365 }
1366
1367 dir = getcwd(NULL, 1000);
1368 if (dir) {
1369 cwd = cvstring(dir);
1370 free(dir);
1371 }
1372
1373 return cwd;
1374 }
1375
1376 /* xgetkey - get a key from the keyboard */
xgetkey()1377 LVAL xgetkey()
1378 {
1379 xllastarg();
1380 return (cvfixnum((FIXTYPE)getchar()));
1381 }
1382
1383 /* ossymbols - enter os specific symbols */
ossymbols(void)1384 void ossymbols(void)
1385 {
1386 }
1387
1388 /* xsetupconsole -- used to configure window in Win32 version */
xsetupconsole()1389 LVAL xsetupconsole()
1390 {
1391 return NULL;
1392 }
1393
1394 #if defined(WIN32)
1395 const char os_pathchar = '\\';
1396 const char os_sepchar = ',';
1397 #else
1398 const char os_pathchar = '/';
1399 const char os_sepchar = ':';
1400 #endif
1401
1402 /* control-C handling */
ctcinit()1403 void ctcinit()
1404 {
1405 }
1406
1407 /* xechoenabled -- set/clear echo_enabled flag (unix only) */
xechoenabled()1408 LVAL xechoenabled()
1409 {
1410 return NULL;
1411 }
1412
1413 #if defined(WIN32)
1414
1415 static WIN32_FIND_DATA FindFileData;
1416 static HANDLE hFind = INVALID_HANDLE_VALUE;
1417 #define OSDIR_LIST_READY 0
1418 #define OSDIR_LIST_STARTED 1
1419 #define OSDIR_LIST_DONE 2
1420 static int osdir_list_status = OSDIR_LIST_READY;
1421 #define OSDIR_MAX_PATH 256
1422 static char osdir_path[OSDIR_MAX_PATH];
1423
1424 // osdir_list_start -- prepare to list a directory
osdir_list_start(const char * path)1425 int osdir_list_start(const char *path)
1426 {
1427 if (strlen(path) >= OSDIR_MAX_PATH - 2) {
1428 xlcerror("LISTDIR path too big", "return nil", NULL);
1429 return FALSE;
1430 }
1431 strcpy(osdir_path, path);
1432 strcat(osdir_path, "/*"); // make a pattern to match all files
1433
1434 if (osdir_list_status != OSDIR_LIST_READY) {
1435 osdir_list_finish(); // close previously interrupted listing
1436 }
1437
1438 hFind = FindFirstFile(osdir_path, &FindFileData); // get the "."
1439 if (hFind == INVALID_HANDLE_VALUE) {
1440 return FALSE;
1441 }
1442 if (FindNextFile(hFind, &FindFileData) == 0) {
1443 return FALSE; // get the ".."
1444 }
1445
1446 osdir_list_status = OSDIR_LIST_STARTED;
1447
1448 return TRUE;
1449 }
1450
1451 /* osdir_list_next -- read the next entry from a directory */
osdir_list_next()1452 const char *osdir_list_next()
1453 {
1454 if (FindNextFile(hFind, &FindFileData) == 0) {
1455 osdir_list_status = OSDIR_LIST_DONE;
1456 return NULL;
1457 }
1458 return FindFileData.cFileName;
1459 }
1460
1461 /* osdir_list_finish -- close an open directory */
osdir_list_finish()1462 void osdir_list_finish()
1463 {
1464 if (osdir_list_status != OSDIR_LIST_READY) {
1465 FindClose(hFind);
1466 }
1467 osdir_list_status = OSDIR_LIST_READY;
1468 }
1469
1470 #else
1471
1472 #include <dirent.h>
1473 #define OSDIR_LIST_READY 0
1474 #define OSDIR_LIST_STARTED 1
1475 #define OSDIR_LIST_DONE 2
1476 static int osdir_list_status = OSDIR_LIST_READY;
1477 static DIR *osdir_dir;
1478
1479 /* osdir_list_start -- open a directory listing */
osdir_list_start(const char * path)1480 int osdir_list_start(const char *path)
1481 {
1482 if (osdir_list_status != OSDIR_LIST_READY) {
1483 osdir_list_finish(); /* close current listing */
1484 }
1485 osdir_dir = opendir(path);
1486 if (!osdir_dir) {
1487 return FALSE;
1488 }
1489 osdir_list_status = OSDIR_LIST_STARTED;
1490 return TRUE;
1491 }
1492
1493 /* osdir_list_next -- read the next entry from a directory */
osdir_list_next()1494 const char *osdir_list_next()
1495 {
1496 struct dirent *entry;
1497
1498 if (osdir_list_status != OSDIR_LIST_STARTED) {
1499 return NULL;
1500 }
1501
1502 entry = readdir(osdir_dir);
1503 if (!entry) {
1504 osdir_list_status = OSDIR_LIST_DONE;
1505 return NULL;
1506 }
1507 return entry->d_name;
1508 }
1509
1510 /* osdir_list_finish -- close an open directory */
osdir_list_finish()1511 void osdir_list_finish()
1512 {
1513 if (osdir_list_status != OSDIR_LIST_READY) {
1514 closedir(osdir_dir);
1515 }
1516 osdir_list_status = OSDIR_LIST_READY;
1517 }
1518
1519 #endif
1520
1521 /* xget_temp_path -- get a path to create temp files */
xget_temp_path()1522 LVAL xget_temp_path()
1523 {
1524 char *tmp;
1525
1526 #if defined(WINDOWS)
1527 tmp = getenv("TEMP");
1528 #else
1529 tmp = getenv("TMPDIR");
1530 #endif
1531
1532 if (!tmp || !*tmp) {
1533 tmp = getenv("TMP");
1534 if (!tmp || !*tmp) {
1535 #if defined(WINDOWS)
1536 tmp = "/";
1537 #else
1538 tmp = "/tmp/";
1539 #endif
1540 }
1541 }
1542
1543 return cvstring(tmp);
1544 }
1545
1546 /* xget_user -- get a string identifying the user, for use in file names */
xget_user()1547 LVAL xget_user()
1548 {
1549 char *user = getenv("USER");
1550
1551 if (!user || !*user) {
1552 user = getenv("USERNAME");
1553 if (!user || !*user) {
1554 errputstr("Warning: could not get user ID, using 'nyquist'\n");
1555 user = "nyquist";
1556 }
1557 }
1558
1559 return cvstring(user);
1560 }
1561
1562 #if defined(WINDOWS)
1563 /* get_xlisp_path -- return path to xlisp */
get_xlisp_path(char * p,long p_max)1564 void get_xlisp_path(char *p, long p_max)
1565 {
1566 char *paths = getenv("XLISPPATH");
1567
1568 if (!paths || !*paths) {
1569 *p = 0;
1570 return;
1571 }
1572
1573 strncpy(p, paths, p_max);
1574 p[p_max-1] = 0;
1575 }
1576 #endif
1577
1578