| 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 | } |