Return to error.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / lisp

Annotation of 3BSD/cmd/lisp/error.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: /* error ****************************************************************/
        !             3: /* this routine is always called on a non-fatal error.  The first argu-        */
        !             4: /* ment is printed out.  The second a boolean flag indicating if the   */
        !             5: /* error routine is permitted to return a pointer to a lisp value if   */
        !             6: /* the "cont" command is executed.                                     */
        !             7: 
        !             8: /* error from lisp C code, this temporarily replaces the old error
        !             9:  * allowing us to interface with the new errset scheme with minimum
        !            10:  * difficulty.  We assume that an error which comes to this routine
        !            11:  * is of an "undefined error type" ER%misc .  Soon all calls to this
        !            12:  * routine will be removed.
        !            13:  *
        !            14:  */
        !            15: 
        !            16: lispval
        !            17: error(mesg,contvl)
        !            18: char *mesg;
        !            19: lispval contvl;
        !            20: {
        !            21:     lispval errorh();
        !            22: 
        !            23:     return(errorh(Vermisc,mesg,nil,contvl,0));
        !            24: }
        !            25: 
        !            26: 
        !            27: /* new error handler, works with errset 
        !            28:  * 
        !            29:  * call is errorh(type,message,valret,contuab) where
        !            30:  * type is an atom which classifys the error, and whose clb, if not nil
        !            31:  * is the name of a function to call to handle the error.
        !            32:  * message is a character string to print to describe the error
        !            33:  * valret is the value to return to an errset if one is found,
        !            34:  * and contuab is non nil if this error is continuable.
        !            35:  */
        !            36:  
        !            37: #include "catchframe.h"
        !            38: 
        !            39: lispval
        !            40: errorh(type,message,valret,contuab,uniqid)
        !            41: lispval type,valret;
        !            42: int uniqid,contuab;
        !            43: char *message;
        !            44: {
        !            45:        register struct catchfr *curp; /* must be first register decl */
        !            46:        register lispval handy;
        !            47:        lispval *work = 1 + (lispval *) &uniqid; int limit = nargs() - 5;
        !            48:        lispval Lread(), calhan();
        !            49:        struct argent *savedlbot = lbot;
        !            50:        struct nament * savedbnp = bnp;
        !            51:        int curdep ;    /* error depth */
        !            52:        typedef struct catchfr *cp;
        !            53:        extern int errp;
        !            54:        int myerrp = errp, what;
        !            55:        int saveme[SAVSIZE];
        !            56:        snpand(2);
        !            57: 
        !            58:        if(type->clb != nil)    /* if there is an error handler */
        !            59:        {
        !            60:            handy = calhan(limit,work,type->clb,uniqid,message);
        !            61:            if(contuab && (TYPE(handy) == DTPR))
        !            62:                return(handy->car);
        !            63:        }
        !            64: 
        !            65:        /* search stack for error catcher */
        !            66: 
        !            67:        for (curp = (cp) errp ; curp != (cp) nil ; curp = curp->link)
        !            68:        {
        !            69:           if((curp->labl == type)  
        !            70:              || ( (TYPE(curp->labl) == DTPR) && (curp->labl->car == Verall)))
        !            71:           {
        !            72:               if((curp->flag != nil)
        !            73:                  && (type != Vererr)) {
        !            74:                        /* print the full error message */
        !            75:                        printf("%s  ",message);
        !            76:                        while(limit-->0) {
        !            77:                                printr(*work++,stdout);
        !            78:                                fflush(stdout);
        !            79:                        }
        !            80:                        fputc('\n',stdout);
        !            81:                        fflush(stdout);
        !            82:               }
        !            83:               popnames(curp->svbnp);   /* un shallow bind */
        !            84:               errp = (int) curp->link; /* set error to next frame */
        !            85:               asm("    addl3   $16,r11,sp");   /* skip link,flag,labl,svbnp */
        !            86:               asm("    movc3   $40,(sp),_setsav");/*restore (return) context*/
        !            87:               asm("    movab   40(sp),sp");       /* skip past ""     "" */
        !            88:               asm("    popr    $0x2540");      /* restore registers */
        !            89:               asm("    movl    12(ap),r0");    /* set return value */
        !            90:               asm("    rsb");          /* return to errset */
        !            91:               /* NOT REACHED */
        !            92:           }
        !            93:        }
        !            94:            
        !            95:        /* no one will catch this error, we must see if there is an
        !            96:           error-goes-to-top-level catcher */
        !            97:        
        !            98:        if (Vertpl->clb != nil)
        !            99:        {
        !           100:            
        !           101:            handy = calhan(limit,work,Vertpl,uniqid,message);
        !           102:            if( contuab  && (TYPE(handy) == DTPR))
        !           103:                   return(handy->car);
        !           104:        }
        !           105: 
        !           106:        /* at this point, print error mssage and break, just like
        !           107:           the current error scheme */
        !           108:        printf("%s: ",message);
        !           109:        while(limit-->0) {
        !           110:                printr(*work++,stdout);
        !           111:                fflush(stdout);
        !           112:        }
        !           113: 
        !           114:        curdep = ++depth;
        !           115:        getexit(saveme);
        !           116:        while(what = setexit()) {
        !           117:                errp = myerrp;
        !           118:                depth = curdep;
        !           119:                switch(what) {
        !           120:                case BRRETB:
        !           121:                        if (curdep == (int) contval) {
        !           122:                                popnames(savedbnp);
        !           123:                                lbot = savedlbot;
        !           124:                                continue;
        !           125:                        }
        !           126:                default:
        !           127:                        resexit(saveme);
        !           128:                        reset(what);
        !           129: 
        !           130:                case    BRRETN:
        !           131:                        if (contuab)
        !           132:                        {
        !           133:                                popnames(savedbnp);
        !           134:                                lbot = savedlbot;
        !           135:                                depth = curdep -1;
        !           136:                                resexit(saveme);
        !           137:                                return(contval);
        !           138:                        }
        !           139:                        printf("CAN'T CONTINUE\n");
        !           140:                        
        !           141:                }
        !           142:        }
        !           143:        lbot = np;
        !           144:        np++->val = P(stdin);
        !           145:        np++->val = eofa;
        !           146:        while(TRUE) {
        !           147:                
        !           148:                fprintf(stdout,"\n%d:>",curdep);
        !           149:                dmpport(stdout);
        !           150:                vtemp = Lread();
        !           151:                if(vtemp == eofa) exit(0);
        !           152:                printr(eval(vtemp),stdout);
        !           153:        }
        !           154: }
        !           155: static lispval
        !           156: calhan(limit,work,handler,uniqid,message)
        !           157: register lispval *work;
        !           158: lispval handler;
        !           159: register limit;
        !           160: register char *message;
        !           161: int uniqid;
        !           162: {
        !           163:            register lispval handy;
        !           164:            register struct argent *lbot, *np;
        !           165:            lbot = np;
        !           166:            protect(handler->clb);              /* funcall the handler */
        !           167:            protect(handy = newdot());          /* with a list consisting of */
        !           168:            handy->car = inewint(uniqid);       /* identifying number, */
        !           169:            handy = handy->cdr = newdot();
        !           170:            handy->car = matom(message);        /* message to be typed out, */
        !           171:            while(limit-- > 0)
        !           172:            {                                   /* any other args. */
        !           173:                    handy = handy->cdr = newdot();
        !           174:                    handy->car = *work++;
        !           175:            }
        !           176:            handy->cdr = nil;
        !           177: 
        !           178:            handy = Lfuncal();
        !           179:            np=lbot;
        !           180: }
        !           181: 
        !           182: /* lispend **************************************************************/
        !           183: /* Fatal errors come here, with their epitaph.                         */
        !           184: lispend(mesg)
        !           185:        char    mesg[];
        !           186:        {
        !           187:        dmpport(poport);
        !           188:        fprintf(errport,"%s\n",mesg);
        !           189:        dmpport(errport);
        !           190:        exit(0);
        !           191:        }
        !           192: 
        !           193: /* namerr ***************************************************************/
        !           194: /* handles namestack overflow, at present by simply giving a message   */
        !           195: 
        !           196: namerr()
        !           197: {
        !           198:        np -= 10;
        !           199:        error("NAMESTACK OVERFLOW",FALSE);
        !           200:        /* NOT REACHED */
        !           201: }
        !           202: binderr()
        !           203: {
        !           204:        bnp -= 10;
        !           205:        error("Bindstack overflow.",FALSE);
        !           206: }
        !           207: rtaberr()
        !           208: {
        !           209:        bindfix(Vreadtable,strtab,nil);
        !           210:        error("Illegal read table.",FALSE);
        !           211: }
        !           212: badmem()
        !           213: {
        !           214:        error("Attempt to allocate beyond static structures.",FALSE);
        !           215: }

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