projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 149490c5 C |
1 | #ifndef lint |
| 2 | static char *rcsid = | |
| 3 | "$Header: lisp.c,v 1.3 83/11/26 12:00:58 sklower Exp $"; | |
| 4 | #endif | |
| 5 | ||
| 6 | /* -[Sat Jan 29 13:24:33 1983 by jkf]- | |
| 7 | * lisp.c $Locker: $ | |
| 8 | * main program | |
| 9 | * | |
| 10 | * (c) copyright 1982, Regents of the University of California | |
| 11 | */ | |
| 12 | ||
| 13 | #include "global.h" | |
| 14 | #include "frame.h" | |
| 15 | ||
| 16 | /* main *****************************************************************/ | |
| 17 | /* Execution of the lisp system begins here. This is the top level */ | |
| 18 | /* executor which is an infinite loop. The structure is similar to */ | |
| 19 | /* error. */ | |
| 20 | ||
| 21 | extern lispval reborn; | |
| 22 | extern int rlevel; | |
| 23 | static int virgin = 0; | |
| 24 | int Xargc; | |
| 25 | char **Xargv; | |
| 26 | extern char **environ; | |
| 27 | ||
| 28 | main(argc,argv,arge) | |
| 29 | char **argv,**arge; | |
| 30 | { | |
| 31 | lispval matom(), Lapply(); | |
| 32 | extern struct frame *errp; | |
| 33 | extern int holbeg,holend,usehole; | |
| 34 | extern int *curhbeg; | |
| 35 | pbuf pb; | |
| 36 | ||
| 37 | environ = arge; | |
| 38 | #if sun_4_2 || sun_4_2beta | |
| 39 | setlinebuf(stdout); | |
| 40 | #else | |
| 41 | {extern char _sobuf[]; setbuf(stdout,_sobuf);} | |
| 42 | #endif | |
| 43 | Xargc = argc; | |
| 44 | Xargv = argv; | |
| 45 | virgin = 0; | |
| 46 | errp = (struct frame *)0; | |
| 47 | initial(); | |
| 48 | ||
| 49 | errp = Pushframe(F_RESET,nil,nil); | |
| 50 | switch(retval) | |
| 51 | { | |
| 52 | case C_RESET: break; /* what to do? */ | |
| 53 | case C_INITIAL: break; /* first time */ | |
| 54 | } | |
| 55 | ||
| 56 | for(EVER) { | |
| 57 | lbot = np = orgnp; | |
| 58 | rlevel = 0; | |
| 59 | depth = 0; | |
| 60 | clearerr(piport = stdin); | |
| 61 | clearerr(poport = stdout); | |
| 62 | np++->val = matom("top-level"); | |
| 63 | np++->val = nil; | |
| 64 | Lapply(); | |
| 65 | } | |
| 66 | } | |
| 67 | ||
| 68 | lispval | |
| 69 | Ntpl() | |
| 70 | { | |
| 71 | lispval Lread(),Istsrch(); | |
| 72 | ||
| 73 | if (virgin == 0) { | |
| 74 | fputs((char *)Istsrch(matom("version"))->d.cdr->d.cdr->d.cdr,poport); | |
| 75 | virgin = 1; | |
| 76 | } | |
| 77 | lbot = np; | |
| 78 | np++->val = P(stdin); | |
| 79 | np++->val = eofa; | |
| 80 | while (TRUE) | |
| 81 | { | |
| 82 | fputs("\n-> ",stdout); | |
| 83 | dmpport(stdout); | |
| 84 | vtemp = Lread(); | |
| 85 | if(vtemp == eofa) exit(0); | |
| 86 | printr(eval(vtemp),stdout); | |
| 87 | } | |
| 88 | } | |
| 89 | ||
| 90 | /* franzexit :: give up the ghost | |
| 91 | * this function is called whenever one decides to kill this process. | |
| 92 | * We clean up a bit then call then standard exit routine. C code | |
| 93 | * in franz should never call exit() directly. | |
| 94 | */ | |
| 95 | franzexit(code) | |
| 96 | { | |
| 97 | extern int fvirgin; | |
| 98 | extern char *stabf; | |
| 99 | if(!fvirgin) unlink(stabf); /* give up any /tmp symbol tables */ | |
| 100 | exit(code); | |
| 101 | /* is this something special?? _cleanup(); | |
| 102 | * proflush(); | |
| 103 | * _exit(code); | |
| 104 | */ | |
| 105 | ||
| 106 | } |