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