4.3BSD - /usr/src/ucb/lisp/franz/inits.c

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

Defined functions

Defined variables

Defined macros