|
|
1.1 root 1: static char *sccsid = "@(#)inits.c 34.2 10/13/80";
2:
3: #include "global.h"
4: #include <signal.h>
5: /************************************************************************/
6: /* */
7: /* file: inits.i */
8: /* contents: initialization routines */
9: /* */
10:
11:
12: /* initial **************************************************************/
13: /* initializes the parts of the system that cannot be automatically */
14: /* accomplished in the declarations. */
15:
16: int reborn=0; /* flag to tell whether we are in fast-load version */
17: extern char *stabf;
18: extern int fvirgin;
19: extern int keywait;
20: extern sigstruck, sigdelay;
21: initial()
22: {
23: int sigalrmh(), sigfpeh(), siginth();
24: lispval Isstatus(),Istsrch();
25: extern int hashtop;
26:
27: /* clear any memory of pending SIGINT's */
28: exception = FALSE;
29: sigintcnt = 0;
30:
31: if( signal(SIGINT,SIG_IGN) != SIG_IGN)
32: signal(SIGINT,siginth);
33: if( signal(SIGHUP,SIG_IGN) != SIG_IGN)
34: signal(SIGHUP,siginth);
35: signal(SIGFPE,siginth);
36: signal(SIGALRM,siginth);
37: signal(SIGPIPE,siginth);
38: /* signals SIGBUS and SIGSEGV will be set up when the status list
39: is set up when the lisp is virgin, and will be set up according
40: to the current value on the status list if the lisp is reborn
41: */
42:
43: if( reborn ) {
44: register FILE *p = _iob + 3;
45: static FILE empty;
46: for(; p < _iob + _NFILE; p++)
47: *p = empty;
48: np = lbot = orgnp;
49: stabf = 0;
50: fvirgin = 1;
51: loading->a.clb = nil;
52: gcrebear();
53:
54: /* set up SIGBUS and SIGSEGV from current value
55: of status flag dumpcore
56: */
57: Isstatus(matom("dumpcore"),
58: (Istsrch(matom("dumpcore")))->d.cdr->d.cdr->d.cdr);
59:
60: makenv();
61: return;
62: }
63: for (hash=0;hash<hashtop;hash++) hasht[hash] = (struct atom *) CNIL;
64:
65: sbrk( NBPG-(((int)sbrk(0)) % NBPG) ); /* even up the break */
66: makevals();
67:
68: orgnp = np;
69: makenv();
70:
71: }
72:
73: static
74: makenv()
75: {
76: register lispval env, temp;
77: register char *p, *q;
78: register struct argent *lbot, *np;
79: char **envp, envstr[STRBLEN];
80: extern char **environ;
81:
82: #ifdef VMS
83: return;
84: #endif
85: lbot = np;
86: env = nil;
87: np++->val = env;
88: for (envp=environ; *envp!=NULL; envp++) ;
89: while (--envp >= environ) {
90: for(p= *envp,q=envstr; *p!='=' ; p++)
91: if(q < envstr + STRBLEN)
92: *q++ = *p;
93: *q = 0; p++;
94: /* at this point lbot->val==env, so it is protected
95: from gc */
96: lbot->val = temp = newdot();
97: temp->d.cdr = env;
98: env = temp;
99: temp = newdot();
100: temp->d.car = matom(envstr);
101: temp->d.cdr = matom(p);
102: env->d.car = temp;
103: }
104: matom("environment")->a.clb = env;
105: }
106:
107: siginth(signo){
108: signal(signo,siginth);
109: sigstruck |= (1 << signo);
110: /* handle SIGINT differently since it is the only
111: asychronous interrupt we handle */
112: if( signo == SIGINT) {
113: if( ++sigintcnt == 1)
114: { /* if this is the first interrupt, we just set a flag
115: which will be checked in qfuncl and eval. This will
116: allow us to handle these interrupts when we are
117: ready.
118: */
119: exception = TRUE;
120: /*putchar('A');*/
121: fflush(stdout);
122: sigstruck &= ~(1 << signo);
123: return;
124: }
125: else if (sigintcnt == 2)
126: { /* the setting of exception was ignored, we better
127: make sure that all calls from compiled code
128: go through qlinker
129: */
130: signal(SIGINT,SIG_IGN); /* this may take a while, dont allow ints*/
131: clrtt(0);
132: /*putchar('B');*/
133: fflush(stdout);
134: signal(SIGINT,siginth); /* ok to interrupt again */
135: sigstruck &= ~(1 << signo);
136: return;
137: }
138: else {
139: /*putchar('C');*/
140: fflush(stdout);
141: }
142: }
143:
144: sigcall(signo);
145: }
146: sigcall(which)
147: register which;
148: {
149: extern lispval Lfuncal();
150:
151: snpand(1);
152:
153: if(which == SIGINT) { sigintcnt = 0; exception = 0; }
154:
155: if(sigacts[which]!=((lispval) 0)) {
156: lbot = np;
157: np -> val = sigacts[which];
158: INRNP;
159: np -> val = inewint(which);
160: INRNP;
161: {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}
162: Lfuncal();
163: {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}
164: }
165: sigstruck &= ~ (1<<which);
166: }
167: delayoff(){
168: sigdelay = FALSE;
169: if(sigstruck)
170: dosig();
171: }
172: dosig()
173: {
174: register int i; int which;
175: if(!sigdelay)
176: for(which=0, i = 1; i <= 65536; which++,i<<=1) {
177: keywait = FALSE;
178: if(sigstruck & i)
179: sigcall(which);
180: }
181: }
182: badmemr(number)
183: {
184: signal(number,badmemr);
185: fflush(stdout);
186: error("Internal bad memory reference, you are advised to (reset).",FALSE);
187: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.