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