![[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] / 43BSDReno / pgrm / lisp / franz|
Return to inits.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / franz |
1.1 root 1: #ifndef lint
2: static char *rcsid =
3: "$Header: inits.c,v 1.7 85/03/24 11:03:12 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(), sginth();
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,sginth);
40: if( signal(SIGHUP,SIG_IGN) != SIG_IGN)
41: signal(SIGHUP,sginth);
42: signal(SIGFPE,sginth);
43: signal(SIGALRM,sginth);
44: signal(SIGPIPE,sginth);
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: np = lbot = orgnp;
56: Nioreset();
57: stabf = 0;
58: fvirgin = 1;
59: loading->a.clb = nil;
60: gcrebear();
61:
62: /* set up SIGBUS and SIGSEGV from current value
63: of status flag dumpcore
64: */
65: Isstatus(matom("dumpcore"),
66: (Istsrch(matom("dumpcore")))->d.cdr->d.cdr->d.cdr);
67:
68: makenv();
69: return;
70: }
71: for (hash=0;hash<hashtop;hash++) hasht[hash] = (struct atom *) CNIL;
72:
73: sbrk( LBPG-(((int)sbrk(0)) % LBPG) ); /* even up the break */
74: makevals();
75:
76: orgnp = np;
77: makenv();
78:
79: }
80:
81: static
82: makenv()
83: {
84: register lispval env, temp;
85: register char *p, *q;
86: char **envp, envstr[STRBLEN];
87: extern char **environ;
88:
89: lbot = np;
90: env = nil;
91: np++->val = env;
92: for (envp=environ; *envp!=NULL; envp++) ;
93: while (--envp >= environ) {
94: for(p= *envp,q=envstr; *p!='=' ; p++)
95: if(q < envstr + STRBLEN)
96: *q++ = *p;
97: *q = 0; p++;
98: /* at this point lbot->val==env, so it is protected
99: from gc */
100: lbot->val = temp = newdot();
101: temp->d.cdr = env;
102: env = temp;
103: temp = newdot();
104: env->d.car = temp;
105: temp->d.car = matom(envstr);
106: temp->d.cdr = matom(p);
107: }
108: matom("environment")->a.clb = env;
109: np--;
110: }
111:
112: sginth(signo){
113: re_enable(signo,sginth);
114: sigstruck |= (1 << signo);
115: /* handle SIGINT differently since it is the only
116: asychronous interrupt we handle */
117: if( signo == SIGINT) {
118: if( ++sigintcnt == 1)
119: { /* if this is the first interrupt, we just set a flag
120: which will be checked in qfuncl and eval. This will
121: allow us to handle these interrupts when we are
122: ready.
123: */
124: exception = TRUE;
125: /*putchar('A');*/
126: fflush(stdout);
127: sigstruck &= ~(1 << signo);
128: return;
129: }
130: else if (sigintcnt == 2)
131: { /* the setting of exception was ignored, we better
132: make sure that all calls from compiled code
133: go through qlinker
134: */
135: signal(SIGINT,SIG_IGN); /* this may take a while, dont allow ints*/
136: clrtt(0);
137: /*putchar('B');*/
138: fflush(stdout);
139: signal(SIGINT,sginth); /* ok to interrupt again */
140: sigstruck &= ~(1 << signo);
141: return;
142: }
143: else {
144: /*putchar('C');*/
145: fflush(stdout);
146: }
147: }
148:
149: sigcall(signo);
150: }
151: sigcall(which)
152: register which;
153: {
154: extern lispval Lfuncal();
155: Savestack(1);
156:
157: if(which == SIGINT) { sigintcnt = 0; exception = 0; }
158:
159: if(sigacts[which]!=((lispval) 0)) {
160: pbuf pb;
161: int mustpop = 0;
162: if(errp && errp->class==F_TO_FORT) {
163: np = errp->svnp;
164: mustpop = 1;
165: errp = Pushframe(F_TO_LISP,nil,nil);
166: }
167: lbot = np;
168: np -> val = sigacts[which];
169: INRNP;
170: np -> val = inewint((long)which);
171: INRNP;
172: {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}
173: Lfuncal();
174: if (mustpop) errp = Popframe();
175: {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}
176: }
177: sigstruck &= ~ (1<<which);
178: Restorestack();
179: }
180: delayoff(){
181: sigdelay = FALSE;
182: if(sigstruck)
183: dosig();
184: }
185: dosig()
186: {
187: register int i; int which;
188: if(!sigdelay)
189: for(which=0, i = 1; i <= 65536; which++,i<<=1) {
190: keywait = FALSE;
191: if(sigstruck & i)
192: sigcall(which);
193: }
194: }
195: badmr(number)
196: {
197: signal(number,badmr);
198: fflush(stdout);
199: error("Internal bad memory reference, you are advised to (reset).",FALSE);
200: }
201:
202: #define mask(s) (1 << ((s)-1))
203: static
204: re_enable(signo,handler)
205: int (*handler)();
206: {
207: #if (os_4_2| os_4_3)
208: sigsetmask(sigblock(0) &~ mask(signo));
209: #else
210: signal(signo,handler);
211: #endif
212: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.