/* plist - parse a list */ LOCAL LVAL plist(LVAL fptr) { LVAL val,expr,lastnptr,nptr; /* protect some pointers */ xlstkcheck(2); xlsave(val); xlsave(expr); /* keep appending nodes until a closing paren is found */ for (lastnptr = NIL; nextch(fptr) != ')'; ) /* get the next expression */ switch (readone(fptr,&expr)) { case EOF: badeof(fptr); case TRUE: /* check for a dotted tail */ if (expr == s_dot) { /* make sure there's a node */ if (lastnptr == NIL) xlfail("invalid dotted pair"); /* parse the expression after the dot */ if (!xlread(fptr,&expr,TRUE)) badeof(fptr); rplacd(lastnptr,expr); /* make sure its followed by a close paren */ if (nextch(fptr) != ')') xlfail("invalid dotted pair"); } /* otherwise, handle a normal list element */ else { nptr = consa(expr); if (lastnptr == NIL) val = nptr; else rplacd(lastnptr,nptr); lastnptr = nptr; } break; } /* skip the closing paren */ xlgetc(fptr); /* restore the stack */ xlpopn(2); /* return successfully */ return (val); }
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); }
/* xread - read an expression */ LVAL xread(void) { LVAL fptr,eof,rflag,val; /* get file pointer and eof value */ fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin)); eof = (moreargs() ? xlgetarg() : NIL); rflag = (moreargs() ? xlgetarg() : NIL); xllastarg(); /* read an expression */ if (!xlread(fptr,&val,rflag != NIL)) val = eof; /* return the expression */ return (val); }
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); } }
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); }
/* pquote - parse a quoted expression */ LOCAL LVAL pquote(LVAL fptr, LVAL sym) { LVAL val,p; /* protect some pointers */ xlsave1(val); /* allocate two nodes */ val = consa(sym); rplacd(val,consa(NIL)); /* initialize the second to point to the quoted expression */ if (!xlread(fptr,&p,TRUE)) badeof(fptr); rplaca(cdr(val),p); /* restore the stack */ xlpop(); /* return the quoted expression */ return (val); }
nyx_rval nyx_eval_expression(const char *expr_string) { LVAL expr = NULL; #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS printf("\nnyx_eval_expression before\n"); xmem(); #endif nyx_result = NULL; nyx_result_type = nyx_error; // Check argument if (!expr_string || !strlen(expr_string)) { return nyx_get_type(nyx_result); } nyx_expr_string = expr_string; nyx_expr_len = strlen(nyx_expr_string); nyx_expr_pos = 0; // Protect the expression from being garbage collected xlprot1(expr); // Setup a new context xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true); // Set the context jump destination if (setjmp(nyx_cntxt.c_jmpbuf)) { // If the script is cancelled or some other condition occurs that causes // the script to exit and return to this level, then we don't need to // restore the previous context. goto finish; } while (nyx_expr_pos < nyx_expr_len) { expr = NULL; // 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); } // This will unwind the xlisp context and restore internals to a point just // before we issued our xlbegin() above. This is important since the internal // xlisp stacks will contain pointers to invalid objects otherwise. // // Also note that execution will jump back up to the statement following the // setjmp() above. xljump(&nyx_cntxt, CF_TOPLEVEL, NIL); // Never reached finish: xlflush(); xlpop(); // unprotect expr gc(); #if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS printf("\nnyx_eval_expression after\n"); xmem(); #endif return nyx_get_type(nyx_result); }
/* 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; }