![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to init.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / pilib|
Return to init.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / pilib |
1.1 root 1: /*
2: * Initialization and error routines.
3: */
4:
5: #include "../h/rt.h"
6: #include "../h/gc.h"
7: #include <signal.h>
8: #include <sys/types.h>
9: #include <sys/times.h>
10: #define MAXHDRLN 100 /* max len of #! line */
11: #define MAXHDR 1024L /* size of autoloading header--!! must
12: agree with that in link/ilink.c */
13: char *file = ""; /* source program file name */
14: int line = 0; /* source program line number */
15: char *code; /* interpreter code buffer */
16: int *records; /* ptr to record procedure blocks */
17: int *ftab; /* ptr to record/field table */
18: struct descrip *globals, *eglobals; /* ptr to global variables */
19: struct descrip *gnames, *egnames; /* ptr to global variable names */
20: struct descrip *statics, *estatics; /* ptr to static variables */
21: char *ident; /* ptr to identifier table */
22: int *monbuf; /* monitor buffer for profiling */
23: int monres = 0; /* resolution of monitor buffer */
24: int monsize = 0; /* size of monitor buffer */
25:
26: int numbufs = NUMBUF; /* number of i/o buffers */
27: char (*bufs)[BUFSIZ]; /* pointer to buffers */
28: FILE **bufused; /* pointer to buffer use markers */
29:
30: int nstacks = MAXSTACKS; /* initial number of coexpr stacks */
31: int stksize = STACKSIZE; /* coexpression stack size */
32: int dodump; /* if non-zero, core dump on error */
33: int noerrbuf; /* if non-zero, DON'T buffer stderr */
34: int *stacks; /* start of stack space */
35: int *estacks; /* end of stack space */
36: int *esfree; /* stack space free list pointer */
37:
38: int ssize = MAXSTRSPACE; /* initial string space size (bytes) */
39: char *strings; /* start of string space */
40: char *estrings; /* end of string space */
41: char *sfree; /* string space free pointer */
42:
43: int hpsize = MAXHEAPSIZE; /* initial heap size (bytes) */
44: char *hpbase; /* start of heap */
45: char *maxheap; /* end of heap storage */
46: char *hpfree; /* heap free space pointer */
47: unsigned heapneed; /* stated need for heap space */
48: unsigned strneed; /* stated need for string space */
49:
50: struct descrip **sqlist; /* string qualifier list */
51: struct descrip **sqfree; /* s. q. list free pointer */
52: struct descrip **esqlist; /* end of s. q. list */
53:
54: struct descrip current; /* current expression stack pointer */
55:
56: /*
57: * &ascii cset, first 128 bits on, second 128 bits off.
58: */
59: struct b_cset k_ascii = {
60: T_CSET,
61: cset_display(~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0,
62: 0, 0, 0, 0, 0, 0, 0, 0)
63: };
64:
65: /*
66: * &cset cset, all 256 bits on.
67: */
68: struct b_cset k_cset = {
69: T_CSET,
70: cset_display(~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0,
71: ~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0)
72: };
73:
74: /*
75: * File block for &errout.
76: */
77: struct b_file k_errout = {
78: T_FILE,
79: stderr,
80: FS_WRITE,
81: 7,
82: /*"&errout", */
83: };
84:
85: /*
86: * File block for &input.
87: */
88: struct b_file k_input = {
89: T_FILE,
90: stdin,
91: FS_READ,
92: 6,
93: /*"&input",*/
94: };
95:
96: /*
97: * cset for &lcase, bits corresponding to lowercase letters are on.
98: */
99: struct b_cset k_lcase = {
100: T_CSET,
101: cset_display( 0, 0, 0, 0, 0, 0, ~01, 03777,
102: 0, 0, 0, 0, 0, 0, 0, 0)
103: };
104:
105: int k_level = 0; /* &level */
106: struct descrip k_main; /* &main */
107: int k_pos = 1; /* &pos */
108:
109: /*
110: * File block for &output.
111: */
112: struct b_file k_output = {
113: T_FILE,
114: stdout,
115: FS_WRITE,
116: 7,
117: /*"&output",*/
118: };
119:
120: long k_random = 0L; /* &random */
121: struct descrip k_subject = { /* &subject */
122: 0,
123: /*1,*/
124: };
125: int k_trace = 0;
126: /*
127: * cset for &ucase, bits corresponding to uppercase characters are on.
128: */
129: struct b_cset k_ucase = {
130: T_CSET,
131: cset_display(0, 0, 0, 0, ~01, 03777, 0, 0,
132: 0, 0, 0, 0, 0, 0, 0, 0)
133: };
134:
135: /*
136: * maps2 and maps3 are used by the map function as caches.
137: */
138: struct descrip maps2 = {
139: D_NULL,
140: /*0,*/
141: };
142: struct descrip maps3 = {
143: D_NULL,
144: /*0,*/
145: };
146:
147: long starttime; /* starttime of job in milliseconds */
148:
149: struct descrip nulldesc = {D_NULL, /*0*/};
150: struct descrip zerodesc = {D_INTEGER, /*0*/};
151: struct descrip onedesc = {D_INTEGER, /*1*/};
152: struct descrip nullstr = {0, /*""*/};
153: struct descrip blank = {1, /*" "*/};
154: struct descrip letr = {1, /*"r"*/};
155: struct descrip input = {D_FILE, /*&k_input*/};
156: struct descrip errout = {D_FILE, /*&k_errout*/};
157: struct descrip lcase = {26, /*lowercase*/};
158: struct descrip ucase = {26, /*uppercase*/};
159:
160: static struct b_estack mainhead; /* expression stack head for main */
161:
162: /*
163: * init - initialize memory and prepare for Icon execution.
164: */
165:
166: #ifdef VAX
167: init(name)
168: #endif VAX
169: #ifdef PORT
170: init(name)
171: #endif PORT
172: #ifdef PDP11
173: init(nargs, name)
174: int nargs;
175: #endif PDP11
176: char *name;
177: {
178: register int i;
179: int cbread;
180: int f;
181: FILE *ufile;
182: char uheader[MAXHDRLN];
183: int directex;
184: /*
185: * Interpretable file header
186: */
187: struct header {
188: int size; /* size of icode file */
189: int trace; /* initial value of &trace */
190: int records; /* records */
191: int ftab; /* record field table */
192: int globals; /* global array */
193: int gnames; /* global name array */
194: int statics; /* static array */
195: int ident; /* strings for identifiers, etc. */
196: } hdr;
197: struct tms tp;
198: extern char *brk(), end;
199: extern char Pstart, Pstop;
200: extern fpetrap(), segvtrap();
201:
202: /*
203: * Catch floating point traps and memory faults.
204: */
205: signal(SIGFPE, fpetrap);
206: signal(SIGSEGV, segvtrap);
207:
208: /*
209: * Initializations that can't be performed statically.
210: */
211: STRLOC(k_errout.fname) = "&errout";
212: STRLOC(k_input.fname) = "&input";
213: STRLOC(k_output.fname) = "&output";
214: STRLOC(k_subject) = (char *) 1;
215: STRLOC(maps2) = 0;
216: STRLOC(maps3) = 0;
217: STRLOC(nulldesc) = 0;
218: INTVAL(zerodesc) = 0;
219: INTVAL(onedesc) = 1;
220: STRLOC(nullstr) = "";
221: STRLOC(blank) = " ";
222: STRLOC(letr) = "r";
223: BLKLOC(input) = (union block *) &k_input;
224: BLKLOC(errout) = (union block *) &k_errout;
225: STRLOC(lcase) = "abcdefghijklmnopqrstuvwxyz";
226: STRLOC(ucase) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
227:
228: /*
229: * Initialize &main.
230: */
231: mainhead.type = T_ESTACK;
232: mainhead.activator.type = D_NULL;
233: STRLOC(mainhead.activator) = NULL;
234: mainhead.sbase = (int *)(STKBASE);
235: mainhead.sp = NULL;
236: mainhead.boundary = NULL;
237: mainhead.nresults = 0;
238: mainhead.freshblk.type = D_NULL;
239: STRLOC(mainhead.freshblk) = 0;
240:
241: /*
242: * Open the interpretable file and read the header.
243: */
244: i = strlen(name);
245: f = open(name, 0);
246: if (f < 0)
247: error("can't open interpreter file");
248: /*
249: * We check to see if the header starts with #! and if so, we assume
250: * that it is being directly executed and seek past the header.
251: */
252: ufile = fdopen(f,"r");
253: fgets(uheader,MAXHDRLN,ufile);
254: if (strncmp(uheader,"#!",2) != 0) {
255: fseek(ufile,MAXHDR,0);
256: fgets(uheader,MAXHDRLN,ufile);
257: if (strncmp(uheader,"#!",2) == 0)
258: lseek(f,MAXHDR+(long)strlen(uheader),0);
259: else
260: error("invalid format for interpretable file");
261: }
262: else
263: lseek(f,(long)strlen(uheader),0);
264:
265: if (read(f, &hdr, sizeof hdr) != sizeof hdr)
266: error("can't read interpreter file header");
267:
268: /*
269: * Establish pointers to data regions.
270: */
271: code = (char *) sbrk(0);
272: k_trace = hdr.trace;
273: records = (int *) (code + hdr.records);
274: ftab = (int *) (code + hdr.ftab);
275: globals = (struct descrip *) (code + hdr.globals);
276: gnames = eglobals = (struct descrip *) (code + hdr.gnames);
277: statics = egnames = (struct descrip *) (code + hdr.statics);
278: estatics = (struct descrip *) (code + hdr.ident);
279: ident = (char *) estatics;
280:
281: /*
282: * Examine the environment and make appropriate settings.
283: */
284: envlook();
285:
286: /*
287: * Set up stuff for monitoring.
288: */
289: if (monres > 0)
290: monsize = (&Pstop - &Pstart + monres - 1) / monres;
291: monbuf = (int *)((int)(code + hdr.size + 1) & ~01);
292:
293: /*
294: * Set up allocated memory. The regions are:
295: * Monitoring buffer
296: * Co-expression stacks
297: * String space
298: * Heap
299: * String qualifier list
300: */
301: bufs = (char **) (monbuf + monsize);
302: bufused = (FILE **) (bufs + numbufs);
303: stacks = (int *)(((int)(bufused + numbufs) + 63) & ~077);
304: estacks = stacks + nstacks * stksize;
305: sfree = strings = (char *)((int)(estacks + 63) & ~077);
306: hpfree = hpbase = estrings = (char *)((int)(strings + ssize + 63) & ~077);
307: sqlist = sqfree = esqlist =
308: (struct descrip **)(maxheap = (char *)((int)(hpbase + hpsize + 63) & ~077));
309:
310: /*
311: * Try to move the break back to the end of memory to allocate (the
312: * end of the string qualifier list) and die if the space isn't
313: * available.
314: */
315: if (brk(esqlist))
316: error("insufficient memory");
317:
318: /*
319: * Read the interpretable code and data into memory.
320: */
321: if ((cbread = read(f, code, hdr.size)) != hdr.size) {
322: fprintf(stderr,"Tried to read %d bytes of code, and got %d\n",
323: hdr.size,cbread);
324: error("can't read interpreter code");
325: }
326: close(f);
327:
328: /*
329: * Resolve references from icode to runtime system.
330: */
331: resolve();
332:
333: /*
334: * Establish linked list of free co-expression stacks. esfree
335: * is the base.
336: */
337: esfree = NULL;
338: for (i = nstacks-1; i >= 0; i--) {
339: *(stacks + (i * stksize)) = (int) esfree;
340: esfree = stacks + (i * stksize);
341: *(esfree+(stksize-sizeof(struct b_estack)/WORDSIZE)) = T_ESTACK;
342: }
343:
344: /*
345: * Mark all buffers as available.
346: */
347: for (i = 0; i < numbufs; i++)
348: bufused[i] = NULL;
349:
350: /*
351: * Buffer stdin if a buffer is available.
352: */
353: if (numbufs >= 1) {
354: setbuf(stdin, bufs[0]);
355: bufused[0] = stdin;
356: }
357: else
358: setbuf(stdin, NULL);
359:
360: /*
361: * Buffer stdout if a buffer is available.
362: */
363: if (numbufs >= 2) {
364: setbuf(stdout, bufs[1]);
365: bufused[1] = stdout;
366: }
367: else
368: setbuf(stdout, NULL);
369:
370: /*
371: * Buffer stderr if a buffer is available.
372: */
373: if (numbufs >= 3 && !noerrbuf) {
374: setbuf(stderr, bufs[2]);
375: bufused[2] = stderr;
376: }
377: else
378: setbuf(stderr, NULL);
379:
380: /*
381: * Point &main at the stack for the main procedure and set current,
382: * the pointer to the current co-expression to &main.
383: */
384: k_main.type = D_ESTACK;
385: BLKLOC(k_main) = (union block *) &mainhead;
386: current = k_main;
387:
388: #ifdef AZ_NEVER
389: /*
390: * Turn on monitoring if so directed.
391: */
392: if (monres > 0)
393: monitor(&Pstart, &Pstop, monbuf, monsize, 0);
394: #endif AZ_NEVER
395:
396: /*
397: * Get startup time.
398: */
399: times(&tp);
400: starttime = tp.tms_utime;
401: }
402:
403: /*
404: * Check for environment variables that Icon uses and set system
405: * values as is appropriate.
406: */
407: envlook()
408: {
409: register char *p;
410: extern char *getenv();
411:
412: if ((p = getenv("TRACE")) != NULL && *p != '\0')
413: k_trace = atoi(p);
414: if ((p = getenv("NBUFS")) != NULL && *p != '\0')
415: numbufs = atoi(p);
416: if ((p = getenv("NSTACKS")) != NULL && *p != '\0')
417: nstacks = atoi(p);
418: if ((p = getenv("STKSIZE")) != NULL && *p != '\0')
419: stksize = atoi(p);
420: if ((p = getenv("STRSIZE")) != NULL && *p != '\0')
421: ssize = atoi(p);
422: if ((p = getenv("HEAPSIZE")) != NULL && *p != '\0')
423: hpsize = atoi(p);
424: #ifdef AZ_NEVER
425: if ((p = getenv("PROFILE")) != NULL && *p != '\0')
426: monres = atoi(p);
427: #endif AZ_NEVER
428: if ((p = getenv("ICONCORE")) != NULL) {
429: signal(SIGFPE, SIG_DFL);
430: signal(SIGSEGV, SIG_DFL);
431: dodump++;
432: }
433: if ((p = getenv("NOERRBUF")) != NULL)
434: noerrbuf++;
435: }
436:
437: /*
438: * Produce run-time error 204 on floating point traps.
439: */
440: fpetrap()
441: {
442: runerr(204, NULL);
443: }
444:
445: /*
446: * Produce run-time error 304 on segmentation faults.
447: */
448: segvtrap()
449: {
450: runerr(304, NULL);
451: }
452:
453: /*
454: * error - print error message s, used only in startup code.
455: */
456: error(s)
457: char *s;
458: {
459: if (line > 0)
460: fprintf(stderr, "error at line %d in %s\n%s\n", line, file, s);
461: else
462: fprintf(stderr, "error in startup code\n%s\n", s);
463: fflush(stderr);
464: if (dodump)
465: abort();
466: c_exit(2);
467: }
468:
469: /*
470: * syserr - print s as a system error.
471: */
472: syserr(s)
473: char *s;
474: {
475: if (line > 0)
476: fprintf(stderr, "System error at line %d in %s\n%s\n", line, file, s);
477: else
478: fprintf(stderr, "System error in startup code\n%s\n", s);
479: fflush(stderr);
480: if (dodump)
481: abort();
482: c_exit(2);
483: }
484:
485: /*
486: * errtab maps run-time error numbers into messages.
487: */
488: struct errtab {
489: int errno;
490: char *errmsg;
491: } errtab[] = {
492: #include "../h/err.h"
493: 0, 0
494: };
495:
496: /*
497: * runerr - print message corresponding to error n and if v is non-null,
498: * print it as the offending value.
499: */
500: runerr(n, v)
501: register int n;
502: struct descrip *v;
503: {
504: register struct errtab *p;
505:
506: if (line > 0)
507: fprintf(stderr, "Run-time error %d at line %d in %s\n", n, line, file);
508: else
509: fprintf(stderr, "Run-time error %d in startup code\n", n);
510: for (p = errtab; p->errno > 0; p++)
511: if (p->errno == n) {
512: fprintf(stderr, "%s\n", p->errmsg);
513: break;
514: }
515: if (v != NULL) {
516: fprintf(stderr, "offending value: ");
517: outimage(stderr, v, 0);
518: putc('\n', stderr);
519: }
520: fflush(stderr);
521: if (dodump)
522: abort();
523: c_exit(2);
524: }
525:
526: /*
527: * External declarations for blocks of built-in procedures.
528: */
529: extern struct b_proc
530: #define PDEF(p) B/**/p,
531: #include "../h/pdef.h"
532: interp; /* Hack to avoid ,; at end */
533: #undef PDEF
534:
535: /*
536: * Array of addresses of blocks for built-in procedures. It is important
537: * that this table and the one in link/builtin.c agree; the linker
538: * supplies iconx with indices into this array.
539: */
540: struct b_proc *functab[] = {
541: #define PDEF(p) &B/**/p,
542: #include "../h/pdef.h"
543: #undef PDEF
544: 0
545: };
546:
547: /*
548: * resolve - perform various fixups on the data read from the interpretable
549: * file.
550: */
551: resolve()
552: {
553: register int i;
554: register struct b_proc *pp;
555: register struct descrip *dp;
556: extern mkrec();
557:
558: /*
559: * Scan the global variable list for procedures and fill in appropriate
560: * addresses.
561: */
562: for (dp = globals; dp < eglobals; dp++) {
563: if (TYPE(*dp) != T_PROC)
564: continue;
565: /*
566: * The second word of the descriptor for procedure variables tells
567: * where the procedure is. Negative values are used for built-in
568: * procedures and positive values are used for Icon procedures.
569: */
570: i = INTVAL(*dp);
571: if (i < 0) {
572: /*
573: * *dp names a built-in function, negate i and use it as an index
574: * into functab to get the location of the procedure block.
575: */
576: BLKLOC(*dp) = (union block *) functab[-i-1];
577: }
578: else {
579: /*
580: * *dp names an Icon procedure or a record. i is an offset to
581: * location of the procedure block in the code section. Point
582: * pp at the block and replace BLKLOC(*dp).
583: */
584: pp = (struct b_proc *) (code + i);
585: BLKLOC(*dp) = (union block *) pp;
586: /*
587: * Relocate the address of the name of the procedure.
588: */
589: STRLOC(pp->pname) += (int)ident;
590: if (pp->ndynam == -2)
591: /*
592: * This procedure is a record constructor. Make its entry point
593: * be the entry point of mkrec().
594: */
595: pp->entryp = EntryPoint(mkrec);
596: else {
597: /*
598: * This is an Icon procedure. Relocate the entry point and
599: * the names of the parameters, locals, and static variables.
600: */
601: pp->entryp = code + (int)pp->entryp;
602: for (i = 0; i < pp->nparam+pp->ndynam+pp->nstatic; i++)
603: STRLOC(pp->lnames[i]) += (int)ident;
604: }
605: }
606: }
607: /*
608: * Relocate the names of the global variables.
609: */
610: for (dp = gnames; dp < egnames; dp++)
611: STRLOC(*dp) += (int)ident;
612: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.