projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| a22cc832 JF |
1 | #include "global.h" |
| 2 | ||
| 3 | /* main *****************************************************************/ | |
| 4 | /* Execution of the lisp system begins here. This is the top level */ | |
| 5 | /* executor which is an infinite loop. The structure is similar to */ | |
| 6 | /* error. */ | |
| 7 | ||
| 8 | extern char _sobuf[]; | |
| 9 | extern lispval reborn; | |
| 10 | extern int rlevel; | |
| 11 | static int virgin = 0; | |
| 12 | int Xargc; | |
| 13 | char **Xargv; | |
| 14 | ||
| 15 | main(argc,argv) | |
| 16 | char **argv; | |
| 17 | { | |
| 18 | lispval temp, matom(); | |
| 19 | extern int errp; | |
| 20 | snpand(0); | |
| 21 | ||
| 22 | setbuf(stdout,_sobuf); | |
| 23 | Xargc = argc; | |
| 24 | Xargv = argv; | |
| 25 | virgin = 0; | |
| 26 | initial(); | |
| 27 | /* printf("poport = 0%o\n",poport); */ | |
| 28 | while(retval = setexit()) | |
| 29 | switch (retval) { | |
| 30 | ||
| 31 | case BRGOTO: error("GOTO LABEL NOT FOUND",FALSE); | |
| 32 | ||
| 33 | case BRRETN: error("NO PROG TO RETURN FROM",FALSE); | |
| 34 | ||
| 35 | case BRRETB: | |
| 36 | default: popnames(orgbnp); | |
| 37 | ||
| 38 | } | |
| 39 | for(EVER) { | |
| 40 | lbot = np = orgnp; | |
| 41 | rlevel = 0; | |
| 42 | depth = 0; | |
| 43 | errp = 0; | |
| 44 | clearerr(piport = stdin); | |
| 45 | clearerr(poport = stdout); | |
| 46 | np++->val = matom("top-level"); | |
| 47 | np++->val = nil; | |
| 48 | Lapply(); | |
| 49 | } | |
| 50 | } | |
| 51 | Ntpl() | |
| 52 | { | |
| 53 | lispval Lread(); | |
| 54 | snpand(0); | |
| 55 | ||
| 56 | if (virgin == 0) { | |
| 57 | fputs("Franz Lisp, Opus 32",poport); | |
| 58 | virgin = 1; | |
| 59 | } | |
| 60 | lbot = np; | |
| 61 | np++->val = P(stdin); | |
| 62 | np++->val = eofa; | |
| 63 | while (TRUE) | |
| 64 | { | |
| 65 | fputs("\n-> ",stdout); | |
| 66 | dmpport(stdout); | |
| 67 | vtemp = Lread(); | |
| 68 | if(vtemp == eofa) exit(0); | |
| 69 | printr(eval(vtemp),stdout); | |
| 70 | } | |
| 71 | } | |
| 72 | ||
| 73 | exit(code) | |
| 74 | { | |
| 75 | extern int fvirgin; | |
| 76 | extern char *stabf; | |
| 77 | if(!fvirgin) unlink(stabf); | |
| 78 | _cleanup(); | |
| 79 | proflush(); | |
| 80 | _exit(code); | |
| 81 | } |