Return to inits.c CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / franz

Annotation of 43BSD/ucb/lisp/franz/inits.c, revision 1.1

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.