예제 #1
0
main(int argc, char **argv)
{
CONTEXT cntxt;
NODE *expr;
int i;
osinit("XLISP version 1.6, Copyright (c) 1985, by David Betz");
xlbegin(&cntxt,64|8,(NODE *) 1);
if (setjmp(cntxt.c_jmpbuf)) {
printf("fatal initialization error\n");
osfinish();
exit(1);
}
xlinit();
xlend(&cntxt);
xlbegin(&cntxt,64|8,true);
if (setjmp(cntxt.c_jmpbuf) == 0)
xlload("init.lsp",0,0);
if (setjmp(cntxt.c_jmpbuf) == 0)
for (i = 1; i < argc; i++)
if (!xlload(argv[i],1,0))
xlfail("can't load file");
xlsave(&expr,(NODE **)0);
while (1) {
if (i = setjmp(cntxt.c_jmpbuf)) {
if (i == 64)
stdputstr("[ back to the top level ]\n");
((s_evalhook)->n_info.n_xsym.xsy_value = ((NODE *)0));
((s_applyhook)->n_info.n_xsym.xsy_value = ((NODE *)0));
xldebug = 0;
xlflush();
}
if (!xlread(((s_stdin)->n_info.n_xsym.xsy_value),&expr,0))
break;
expr = xleval(expr);
stdprint(expr);
}
xlend(&cntxt);
osfinish ();
exit (0);
}
예제 #2
0
파일: nyx.c 프로젝트: andreipaga/audacity
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);
}
예제 #3
0
파일: xlobj.c 프로젝트: MindFy/audacity
/* evmethod - evaluate a method */
LOCAL LVAL evmethod(LVAL obj, LVAL msgcls, LVAL method)
{
    LVAL oldenv,oldfenv,cptr,name,val=NULL;
    XLCONTEXT cntxt;

    /* protect some pointers */
    xlstkcheck(3);
    xlsave(oldenv);
    xlsave(oldfenv);
    xlsave(cptr);

    /* create an 'object' stack entry and a new environment frame */
    oldenv = xlenv;
    oldfenv = xlfenv;
    xlenv = cons(cons(obj,msgcls),closure_getenv(method));
    xlenv = xlframe(xlenv);
    xlfenv = getfenv(method);

    /* bind the formal parameters */
    xlabind(method,xlargc,xlargv);

    /* setup the implicit block */
    if ((name = getname(method)))
        xlbegin(&cntxt,CF_RETURN,name);

    /* execute the block */
    if (name && _setjmp(cntxt.c_jmpbuf))
        val = xlvalue;
    else
        for (cptr = getbody(method); consp(cptr); cptr = cdr(cptr))
            val = xleval(car(cptr));

    /* finish the block context */
    if (name)
        xlend(&cntxt);

    /* restore the environment */
    xlenv = oldenv;
    xlfenv = oldfenv;

    /* restore the stack */
    xlpopn(3);

    /* return the result value */
    return (val);
}
예제 #4
0
/* evfun - evaluate a function */
LOCAL LVAL evfun(LVAL fun, int argc, LVAL *argv)
{
    LVAL oldenv,oldfenv,cptr,name,val;
    XLCONTEXT cntxt;

    /* protect some pointers */
    xlstkcheck(4);
    xlsave(oldenv);
    xlsave(oldfenv);
    xlsave(cptr);
    xlprotect(fun);     /* (RBD) Otherwise, fun is unprotected */

    /* create a new environment frame */
    oldenv = xlenv;
    oldfenv = xlfenv;
    xlenv = xlframe(closure_getenv(fun));
    xlfenv = getfenv(fun);

    /* bind the formal parameters */
    xlabind(fun,argc,argv);

    /* setup the implicit block */
    if (name = getname(fun))
        xlbegin(&cntxt,CF_RETURN,name);

    /* execute the block */
    if (name && setjmp(cntxt.c_jmpbuf))
        val = xlvalue;
    else
        for (val = NIL, cptr = getbody(fun); consp(cptr); cptr = cdr(cptr))
            val = xleval(car(cptr));

    /* finish the block context */
    if (name)
        xlend(&cntxt);

    /* restore the environment */
    xlenv = oldenv;
    xlfenv = oldfenv;

    /* restore the stack */
    xlpopn(4);

    /* return the result value */
    return (val);
}
예제 #5
0
static int breakloop(char *hdr, char *cmsg, char *emsg, NODE *arg, int cflag)
{
NODE ***oldstk,*expr,*val;
CONTEXT cntxt;
int type;
xlerrprint(hdr,cmsg,emsg,arg);
xlflush();
if (((s_tracenable)->n_info.n_xsym.xsy_value)) {
val = ((s_tlimit)->n_info.n_xsym.xsy_value);
xlbaktrace(((val) && (val)->n_type == 5) ? (int)((val)->n_info.n_xint.xi_int) : -1);
}
oldstk = xlsave(&expr,(NODE **)0);
xldebug++;
xlbegin(&cntxt,8|16|32,true);
for (type = 0; type == 0; ) {
if (type = setjmp(cntxt.c_jmpbuf))
switch (type) {
case 8:
xlflush();
type = 0;
continue;
case 16:
continue;
case 32:
if (cflag) {
stdputstr("[ continue from break loop ]\n");
continue;
}
else xlabort("this error can't be continued");
}
if (!xlread(((s_stdin)->n_info.n_xsym.xsy_value),&expr,0)) {
type = 16;
break;
}
expr = xleval(expr);
xlprint(((s_stdout)->n_info.n_xsym.xsy_value),expr,1);
xlterpri(((s_stdout)->n_info.n_xsym.xsy_value));
}
xlend(&cntxt);
xldebug--;
xlstack = oldstk;
if (type == 16) {
stdputstr("[ abort to previous level ]\n");
xlsignal(0,(NODE *)0);
}
}
예제 #6
0
파일: nyx.c 프로젝트: andreipaga/audacity
void nyx_get_audio(nyx_audio_callback callback, void *userdata)
{
   sample_block_type block;
   sound_type snd;
   sound_type *snds;
   float *buffer;
   long bufferlen;
   long *totals;
   long cnt;
   int result = 0;
   int num_channels;
   int ch, i;

   if (nyx_get_type(nyx_result) != nyx_audio)
      return;

   num_channels = nyx_get_audio_num_channels();
   snds = (sound_type *)malloc(num_channels * sizeof(sound_type));
   totals = (long *)malloc(num_channels * sizeof(long));

   /* setup the error return */
   xlbegin(&nyx_cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
   if (setjmp(nyx_cntxt.c_jmpbuf))
      goto finish;

   for(ch=0; ch<num_channels; ch++) {
      if (num_channels == 1)
         snd = getsound(nyx_result);
      else
         snd = getsound(getelement(nyx_result, ch));
      snds[ch] = snd;
      totals[ch] = 0;
   }

   buffer = NULL;
   bufferlen = 0;

   while(result==0) {
      for(ch=0; ch<num_channels; ch++) {
         snd = snds[ch];
         cnt = 0;
         block = snd->get_next(snd, &cnt);
         if (block == zero_block || cnt == 0) {
            result = -1;
            break;
         }

         /* copy the data to a temporary buffer and scale it
            by the appropriate scale factor */

         if (cnt > bufferlen) {
            if (buffer)
               free(buffer);
            buffer = (float *)malloc(cnt * sizeof(float));
            bufferlen = cnt;
         }

         memcpy(buffer, block->samples, cnt * sizeof(float));

         for(i=0; i<cnt; i++)
            buffer[i] *= snd->scale;

         result = callback(buffer, ch,
                           totals[ch], cnt, userdata);

         if (result == 0)
            totals[ch] += cnt;
      }
   }

 finish:
      if (buffer)
         free(buffer);
   free(snds);
   free(totals);

   xlend(&nyx_cntxt);
}
예제 #7
0
/* xlload - load a file of xlisp expressions */
int xlload(char *fname, int vflag, int pflag)
{
    char fullname[STRMAX+1];
    char *ptr;
    LVAL fptr,expr;
    XLCONTEXT cntxt;
    FILE *fp;
    int sts;

    /* protect some pointers */
    xlstkcheck(2);
    xlsave(fptr);
    xlsave(expr);

    /* space for copy + extension? */
    if (strlen(fname) > STRMAX - 4) goto toolong;
    strcpy(fullname,fname);
#ifdef WINDOWS
#ifdef WINGUI
    if (strcmp(fullname, "*") == 0) {
        if (sfn_valid) {
            strcpy(fullname, save_file_name);
        } else {
            strcpy(fullname, "*.*");
        }
    }
    if (strcmp(fullname, "*.*") == 0) {
        char *name = getfilename(NULL, "lsp", "r", "Load file");
        if (name) {
            strcpy(fullname, name);
            strcpy(save_file_name, name);
            sfn_valid = TRUE;
        } else {
            xlpopn(2);
            return FALSE;
        }
    }
#endif
    /* replace "/" with "\" so that (current-path) will work */
    for (ptr = fullname; *ptr; ptr++) {
        if (*ptr == '/') *ptr = '\\';
    }
#endif

    /* default the extension if there is room */
    if (needsextension(fullname)) {
        strcat(fullname,".lsp");
    }

    /* allocate a file node */
    fptr = cvfile(NULL);

    /* open the file */
    if ((fp = osaopen(fullname,"r")) == NULL) {
#ifdef UNIX
        if (fname[0] != '/') {
            char *paths = getenv("XLISPPATH");
            if (!paths || !*paths) {
                char msg[512];
                sprintf(msg, "\n%s\n%s\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in the environment.",
  "If you are using Nyquist, probably you should cd to the",
  "nyquist directory and type:",
  "    setenv XLISPPATH `pwd`/runtime:`pwd`/lib",
  "or set XLISPPATH in your .login or .cshrc file.");
                errputstr(msg);
            }
            /* make sure we got paths, and the list is not empty */
            while (paths && *paths) {
                char *ptr = fullname;
                /* skip over separator */
                while (*paths == ':') paths++;
                /* scan next directory into fullname */
                while (*paths && (*paths != ':')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *paths++;
                }
                /* add "/" if needed */
                if (ptr[-1] != '/') *ptr++ = '/';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX) 
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
#ifdef WINDOWS
        /* is this a relative path? */
        if (fname[0] != '\\' && (strlen(fname) < 2 || fname[1] != ':')) {
#define paths_max 1024
            char paths[paths_max];
            char *p = paths;
            get_xlisp_path(paths, paths_max);
            /* make sure we got paths, and the list is not empty */
            if (!*p) {
                sprintf(paths, "\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in the Registry.",
  "You should follow the installation instructions. Enter an",
  "empty string if you really want no search path.");
                errputstr(paths);
                *p = 0;
            }
            while (*p) {
                    char *ptr = fullname;
                /* skiip over separator */
                while (*p == ',') p++;
                /* scan next directory into fullname */
                while (*p && (*p != ',')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *p++;
                }
                /* add "\" if needed */
                if (ptr[-1] != '\\') *ptr++ = '\\';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX)
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                /* printf("Trying to open \"%s\"\n", fullname);	*/
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
#ifdef MACINTOSH
        /* is this a relative path? I don't know how to do this
         * correctly, so we'll assume it's relative if there is no
         * embedded colon (:)
         */
        if (strchr(fname, ':') == NULL) {
#define paths_max 1024
            char paths[paths_max];
            char *p = paths;
            int prefs_found = false;
            get_xlisp_path(paths, paths_max, &prefs_found);
            /* make sure we got paths, and the list is not empty */
            if (!*p) {
                if (prefs_found) {
                    sprintf(paths, "\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in XLisp Preferences.",
  "You should probably delete XLisp Preferences and let XLisp",
  "create a new one for you.");
                } else {
                    sprintf(paths, "\n%s\n%s\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLisp Preferences.",
  "You should manually locate and load the file runtime:init.lsp",
  "Nyquist will create an XLisp Preferences file to automatically",
  "find the file next time. You may edit XLisp Preferences to add",
  "additional search paths, using a comma as separator.");
                }
                errputstr(paths);
                *p = 0;
            }
            while (*p) {
                char *ptr = fullname;
                /* skiip over separator */
                while (*p == ',') p++;
                /* scan next directory into fullname */
                while (*p && (*p != ',')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *p++;
                }
                /* add ":" if needed */
                if (ptr[-1] != ':') *ptr++ = ':';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX)
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                /* printf("Trying to open \"%s\"\n", fullname);	*/
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
        xlpopn(2);
        return (FALSE);
    }
gotfile:
#ifdef MACINTOSH
    /* We found the file ok, call setup_preferences to create
     * XLisp Preferences file (this only happens if previous
     * attempt to find the file failed
     */
    setup_preferences(fullname);
#endif
    setfile(fptr,fp);
    setvalue(s_loadingfiles, cons(fptr, getvalue(s_loadingfiles)));
    setvalue(s_loadingfiles, cons(cvstring(fullname), getvalue(s_loadingfiles)));

    /* print the information line */
    if (vflag)
        { sprintf(buf,"; loading \"%s\"\n",fullname); stdputstr(buf); }

    /* read, evaluate and possibly print each expression in the file */
    xlbegin(&cntxt,CF_ERROR,s_true);
    if (setjmp(cntxt.c_jmpbuf))
        sts = FALSE;
    else {
        while (xlread(fptr,&expr,FALSE)) {
            expr = xleval(expr);
            if (pflag)
                stdprint(expr);
        }
        sts = TRUE;
    }
    xlend(&cntxt);

    /* close the file */
    osclose(getfile(fptr));
    setfile(fptr,NULL);
    if (consp(getvalue(s_loadingfiles)) && 
        consp(cdr(getvalue(s_loadingfiles))) &&
        car(cdr(getvalue(s_loadingfiles))) == fptr) {
        setvalue(s_loadingfiles, cdr(cdr(getvalue(s_loadingfiles))));
    }

    /* restore the stack */
    xlpopn(2);

    /* return status */
    return (sts);

toolong:
    xlcerror("ignore file", "file name too long", NIL);
    xlpopn(2);
    return FALSE;
}