Return to inits.c CVS log

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

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

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.