BSD 4 release

[unix-history] / usr / src / cmd / lisp / inits.c

diff --git a/usr/src/cmd/lisp/inits.c b/usr/src/cmd/lisp/inits.c
index 993c3c0..c161ab4 100644 (file)
--- a/usr/src/cmd/lisp/inits.c
+++ b/usr/src/cmd/lisp/inits.c
@@ -1,3 +1,5 @@
+static char *sccsid = "@(#)inits.c     34.2 10/13/80";
+

 #include "global.h"
 #include <signal.h>
 /************************************************************************/
 #include "global.h"
 #include <signal.h>
 /************************************************************************/


@@ -20,6 +22,11 @@ initial()
 {
        int sigalrmh(), sigfpeh(),  siginth();
        lispval Isstatus(),Istsrch();
 {
        int sigalrmh(), sigfpeh(),  siginth();
        lispval Isstatus(),Istsrch();

+       extern int hashtop;
+
+       /* clear any memory of pending SIGINT's */
+       exception = FALSE;
+       sigintcnt = 0;

 
        if( signal(SIGINT,SIG_IGN) != SIG_IGN)
              signal(SIGINT,siginth);
 
        if( signal(SIGINT,SIG_IGN) != SIG_IGN)
              signal(SIGINT,siginth);


@@ -27,6 +34,7 @@ initial()
              signal(SIGHUP,siginth);
        signal(SIGFPE,siginth);
        signal(SIGALRM,siginth);
              signal(SIGHUP,siginth);
        signal(SIGFPE,siginth);
        signal(SIGALRM,siginth);

+       signal(SIGPIPE,siginth);

        /* signals SIGBUS and SIGSEGV will be set up when the status list
           is set up when the lisp is virgin, and will be set up according
           to the current value on the status list if the lisp is reborn
        /* signals SIGBUS and SIGSEGV will be set up when the status list
           is set up when the lisp is virgin, and will be set up according
           to the current value on the status list if the lisp is reborn


@@ -40,18 +48,19 @@ initial()
                np = lbot = orgnp;
                stabf = 0;
                fvirgin = 1;
                np = lbot = orgnp;
                stabf = 0;
                fvirgin = 1;

-               loading->clb = nil;
+               loading->a.clb = nil;
+               gcrebear();

 
                /* set up SIGBUS and SIGSEGV from current value 
                   of status flag dumpcore
                */
                Isstatus(matom("dumpcore"),
 
                /* set up SIGBUS and SIGSEGV from current value 
                   of status flag dumpcore
                */
                Isstatus(matom("dumpcore"),

-                        (Istsrch(matom("dumpcore")))->cdr->cdr->cdr);
+                        (Istsrch(matom("dumpcore")))->d.cdr->d.cdr->d.cdr);

 
                makenv();
                return;
        }
 
                makenv();
                return;
        }

-       for (hash=0;hash<HASHTOP;hash++) hasht[hash] = (struct atom *) CNIL;
+       for (hash=0;hash<hashtop;hash++) hasht[hash] = (struct atom *) CNIL;

        
        sbrk( NBPG-(((int)sbrk(0)) % NBPG) );   /* even up the break */
        makevals();
        
        sbrk( NBPG-(((int)sbrk(0)) % NBPG) );   /* even up the break */
        makevals();


@@ -67,53 +76,91 @@ makenv()
        register lispval env, temp;
        register char *p, *q;
        register struct argent *lbot, *np;
        register lispval env, temp;
        register char *p, *q;
        register struct argent *lbot, *np;

-       char **envp, envstr[64];
+       char **envp, envstr[STRBLEN];

        extern char **environ;
 
        extern char **environ;
 

+#ifdef VMS
+       return;
+#endif

        lbot = np;
        env = nil;
        np++->val = env;
        for (envp=environ; *envp!=NULL; envp++) ;
        while (--envp >= environ) {
        lbot = np;
        env = nil;
        np++->val = env;
        for (envp=environ; *envp!=NULL; envp++) ;
        while (--envp >= environ) {

-               for(p= *envp,q=envstr; (*q++ = *p++)!='=';);
-               *--q = 0;
+               for(p= *envp,q=envstr; *p!='=' ; p++)
+                       if(q < envstr + STRBLEN)
+                               *q++ = *p;
+               *q = 0; p++;

                /* at this point lbot->val==env, so it is protected
                   from gc */
                lbot->val = temp = newdot();
                /* at this point lbot->val==env, so it is protected
                   from gc */
                lbot->val = temp = newdot();

-               temp->cdr = env;
+               temp->d.cdr = env;

                env = temp;
                temp = newdot();
                env = temp;
                temp = newdot();

-               temp->car = matom(envstr);
-               temp->cdr = matom(p);
-               env->car = temp;
+               temp->d.car = matom(envstr);
+               temp->d.cdr = matom(p);
+               env->d.car = temp;

        }
        }

-       matom("environment")->clb = env;
+       matom("environment")->a.clb = env;

 }
 
 siginth(signo){
        signal(signo,siginth);
        sigstruck |= (1 << signo);
 }
 
 siginth(signo){
        signal(signo,siginth);
        sigstruck |= (1 << signo);

-       /*if(signo==SIGBUS || signo==SIGBUS || keywait)*/
-               sigcall(signo);
+       /* handle SIGINT differently since it is the only
+          asychronous interrupt we handle              */
+       if( signo == SIGINT) {
+           if( ++sigintcnt == 1)
+           {  /* if this is the first interrupt, we just set a flag
+                 which will be checked in qfuncl and eval.  This will
+                 allow us to handle these interrupts when we are
+                 ready.
+              */
+              exception = TRUE;
+              /*putchar('A');*/
+              fflush(stdout);
+              sigstruck &= ~(1 << signo);
+              return;
+           }
+           else if (sigintcnt == 2)
+           {  /* the setting of  exception was ignored, we better
+                 make sure that all calls from compiled code
+                 go through qlinker
+               */
+               signal(SIGINT,SIG_IGN);  /* this may take a while, dont allow ints*/
+               clrtt(0);
+               /*putchar('B');*/
+               fflush(stdout);
+               signal(SIGINT,siginth);  /* ok to interrupt again */
+               sigstruck &= ~(1 << signo);
+               return;
+           }
+           else {
+               /*putchar('C');*/
+               fflush(stdout);
+           }
+       }
+
+       sigcall(signo);

 }
 sigcall(which)
 register which;
 {
        extern lispval Lfuncal();
 }
 sigcall(which)
 register which;
 {
        extern lispval Lfuncal();

-       extern lispval sigacts[16];
-       struct argent *oldlbot, *oldnp, saved;
+
+       snpand(1);
+
+       if(which == SIGINT) { sigintcnt = 0; exception = 0; }

 
        if(sigacts[which]!=((lispval) 0)) {
 
        if(sigacts[which]!=((lispval) 0)) {

-               oldlbot = lbot;
-               oldnp = np;

                lbot = np;
                np -> val = sigacts[which];
                INRNP;
                np -> val = inewint(which);
                INRNP;
                lbot = np;
                np -> val = sigacts[which];
                INRNP;
                np -> val = inewint(which);
                INRNP;

+       {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}

                Lfuncal();
                Lfuncal();

-               lbot = oldlbot;
-               np = oldnp;
+       {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/}

        }
        sigstruck &= ~ (1<<which);
 }
        }
        sigstruck &= ~ (1<<which);
 }