|
|
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b3mai.c,v 1.4 85/08/22 17:15:36 timo Exp $
5: */
6:
7:
8: /* B driver for interpreter */
9:
10: #include "b.h"
11: #include "b0fea.h"
12: #include "b1obj.h"
13: #include "b1mem.h"
14: #include "b2nod.h"
15: #include "b2syn.h"
16: #include "b2par.h"
17: #include "b3env.h"
18: #include "b3scr.h"
19: #include "b3err.h"
20: #include "b3fil.h"
21: #include "b3sig.h"
22: #include "b3sem.h"
23: #include "b3sou.h"
24:
25: value evalthread();
26:
27: Hidden bool call_error, in_process;
28:
29: #ifdef INTEGRATION
30: bool dflag= No; /* -d: debugging output wanted */
31: bool slowterminal= No;
32: bool hushbaby= No;
33: #endif INTEGRATION
34:
35: Visible bool timing; /* Set if timing output wanted */
36: Visible bool extcmds; /* Set if must recognize extended commands */
37:
38: main(argc, argv) int argc; string argv[]; {
39: #ifdef START_MESSAGE
40: fprintf(stderr, "Interactive B version %s\n%s\n", rcsid,
41: "Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985.");
42: #endif
43: in_process= No; call_error= No;
44: call(argc, argv);
45: if (call_error) exit(-1);
46: in_process= Yes;
47: init();
48: call(argc, argv);
49: bye(0);
50: }
51:
52: #define Cllerr stderr
53:
54: Hidden string pname; /* program name */
55:
56: Hidden Procedure erm(m, n, argc, pargc, pargv) string m, n; int argc, pargc; string pargv[]; {
57: fprintf(Cllerr,
58: "*** There is something I don't quite get in your call of %s\n", pname);
59: show_call(argc, pargc, pargv);
60: fprintf(Cllerr, "*** The problem is: %s %s\n", m, n);
61: if (in_process) bye(-1);
62: call_error= Yes;
63: }
64:
65: Hidden Procedure call(pargc, pargv) int pargc; string pargv[]; {
66: int argc; string *argv;
67:
68: pname = pargv[0];
69: argc = pargc-1;
70: argv = pargv+1;
71: while (argc >= 0)
72: if (argc > 0 && argv[0][0] == '-' && argv[0][1] != '\0') {
73: if (argv[0][1] == 'q') { if (in_process) bye(0);
74: #ifndef INTEGRATION
75: } else if (argv[0][1] == 'i') {
76: filtered= Yes;
77: cmd_prompt= "\001>";
78: eg_prompt= "\001E";
79: raw_prompt= "\001R";
80: qn_prompt= "\001Y";
81: #endif
82: } else if (argv[0][1] == 'T') {
83: timing = Yes;
84: } else if (argv[0][1] == 'E') {
85: extcmds = Yes;
86: #ifdef INTEGRATION
87: #ifndef NDEBUG
88: } else if (argv[0][1] == 'd') {
89: dflag= Yes;
90: #endif NDEBUG
91: #endif INTEGRATION
92: } else erm("I never learned about the option", argv[0], argc, pargc, pargv);
93: argc -= 1;
94: argv += 1;
95: } else {
96: if (argc == 0 || (argv[0][0] == '-' && argv[0][1] == '\0')) {
97: release(iname);
98: iname = Vnil;
99: ifile = stdin;
100: } else {
101: release(iname);
102: iname = mk_text(*argv);
103: ifile = fopen(*argv, "r");
104: }
105: if (ifile != NULL) { if (in_process) process();
106: } else erm("can't open input file", *argv, argc, pargc, pargv);
107: if (ifile != NULL && ifile != stdin) fclose(ifile);
108: ++argv; --argc;
109: }
110: }
111:
112: Hidden Procedure show_call(eargc, pargc, pargv)
113: int eargc, pargc; string pargv[]; {
114: int argc= pargc; string *argv= pargv;
115: intlet p, pos= 4;
116: fprintf(Cllerr, " ");
117: while (argc > 0) {
118: fprintf(Cllerr, *argv);
119: pos+= strlen(*argv);
120: if (argc == eargc) p= pos-1;
121: ++argv; --argc;
122: if (argc > 0) {
123: putc(' ', Cllerr);
124: pos++;
125: }
126: }
127: putc('\n', Cllerr);
128: for (pos= 0; pos < p; pos++) putc(' ', Cllerr);
129: fprintf(Cllerr, "^\n");
130: }
131:
132: #ifdef STATMEM
133: #ifndef IBMPC
134: #undef STATMEM
135: #endif
136: #endif
137:
138: #ifdef ebug
139: #ifdef IBMPC
140: #define PCLEAK
141: #ifndef STATMEM
142: #define STATMEM
143: #endif STATMEM
144: #endif IBMPC
145: #endif ebug
146:
147: #ifdef IBMPC
148: Visible unsigned _stack= 6000; /* Default stack size */
149: #endif
150:
151: #ifdef STATMEM
152: Hidden long alloccnt= 0;
153: #endif
154:
155: /* Quick hack to print memory statistics */
156: Visible Procedure memstat(where) string where; {
157: #ifdef STATMEM
158: long sizmem();
159: fprintf(stderr, "*** %s: sizmem=%ld, sizmalloc=%ld.\n",
160: where, sizmem(), alloccnt);
161: #endif
162: }
163:
164: Visible char*
165: qmalloc(syze)
166: unsigned syze;
167: {
168: #ifdef STATMEM
169: char *p;
170: long before, sizmem();
171: before= sizmem();
172: p= malloc(syze);
173: alloccnt += (before - sizmem());
174: return p;
175: #else
176: return malloc(syze);
177: #endif
178: }
179:
180: Hidden Procedure init() {
181: #ifdef STATMEM
182: allmem();
183: memstat("before init");
184: #endif
185: set_file_names();
186: #ifdef INTEGRATION
187: initgram(); /* set refcnt to infinity */
188: initsugg(); /* set refcnt to infinity */
189: memstat("after gram/sugg");
190: #endif
191: #ifdef PCLEAK
192: initsou();
193: initfpr();
194: #endif
195: initmem();
196: initenv();
197: initnum();
198: initsyn();
199: #ifndef PCLEAK
200: initsou();
201: initfpr();
202: #endif
203: init_scr();
204: initerr();
205: initsig();
206: initint();
207: #ifdef TYPE_CHECK
208: initpol();
209: inittyp();
210: #endif
211: #ifdef INTEGRATION
212: initfile();
213: initkeys();
214: #ifdef unix
215: initunix();
216: #endif
217: initterm();
218: initbtop();
219: #endif
220: end_init();
221: setprmnv();
222: getprmnv();
223: memstat("after init");
224: showtime("after initialization");
225: }
226:
227: Visible Procedure
228: endall()
229: {
230: endsou();
231: endsyn();
232: endnum();
233: endenv();
234: endsta();
235: #ifdef INTEGRATION
236: endscr();
237: endterm();
238: /* enddemo(); ? */
239: endbtop();
240: #ifdef unix
241: endunix();
242: #endif
243: enderro();
244: endsugg();
245: #endif INTEGRATION
246: }
247:
248: /* ******************************************************************** */
249: /* immediate command */
250: /* ******************************************************************** */
251:
252: Hidden bool sa_expr(e) parsetree *e; {
253: return is_expr(Char(tx)) ? (*e= expr(ceol), Yes) : No;
254: }
255:
256: Hidden Procedure special() {
257: switch(Char(tx++)) {
258: case ':': skipsp(&tx);
259: if (Char(tx) == ':') lst_uhds();
260: else edit_unit();
261: break;
262: case '=': skipsp(&tx);
263: if (Char(tx) == '=') lst_ttgs();
264: else edit_target();
265: break;
266: case '!': system(tx); break;
267: /* Obey the rest of the line as an OS command */
268: default: syserr(MESS(3700, "special"));
269: }
270: }
271:
272: Visible Procedure imm_command() {
273: parsetree codeseq= NilTree;
274: parsetree c= NilTree, d= NilTree, e= NilTree; value v; int level;
275: cntxt= In_command; still_ok= Yes; interrupted= No;
276: terminated= No;
277: resexp= Voi; lino= 0;
278: level= ilev();
279: if (!still_ok) return;
280: if (level > 0) parerr(MESS(3701, "outer indentation not zero"));
281: else if (findceol(), Ceol(tx));
282: else if (Char(tx) == ':' || Char(tx) == '=' || Char(tx) == '!')
283: if (interactive) special();
284: else parerr(MESS(3702, "special commands only interactively"));
285: else if (sa_expr(&e)) {
286: if (still_ok) fix_nodes(&e, &codeseq);
287: showtime("after fix_nodes");
288: curline= e; curlino= one;
289: v= evalthread(codeseq);
290: if (still_ok) { wri(v, Yes, No, No); newline(); }
291: release(v); release(e);
292: showtime("after evaluation");
293: } else if (unit_keyword()) {
294: create_unit();
295: } else if (quit_keyword()) terminated= Yes;
296: else if (term_com(&c)) {
297: release(c);
298: parerr(MESS(3703, "terminating commands only allowed in units and refinements"));
299: } else if (control_command(&c) || simple_command(&c, &d)) {
300: /* control_command MUST come before simple above */
301: if (still_ok) fix_nodes(&c, &codeseq);
302: showtime("after fix_nodes");
303: curline= c; curlino= one;
304: execthread(codeseq);
305: release(c); release(d);
306: showtime("after execution");
307: } else parerr(MESS(3704, "I don't recognise this as a command"));
308: }
309:
310: Hidden Procedure process() {
311: re_screen();
312: re_env();
313: f_lino= 0;
314: while (!Eof && !terminated) {
315: #ifdef EXT_COMMAND
316: e_done();
317: #endif
318: imm_command();
319: if (!interactive && !still_ok) bye(1);
320: }
321: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.