![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to error.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / lisp|
Return to error.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / lisp |
1.1 ! root 1: ! 2: static char *sccsid = "@(#)error.c 34.3 11/7/80"; ! 3: ! 4: #include "global.h" ! 5: /* error ****************************************************************/ ! 6: /* this routine is always called on a non-fatal error. The first argu- */ ! 7: /* ment is printed out. The second a boolean flag indicating if the */ ! 8: /* error routine is permitted to return a pointer to a lisp value if */ ! 9: /* the "cont" command is executed. */ ! 10: ! 11: /* error from lisp C code, this temporarily replaces the old error ! 12: * allowing us to interface with the new errset scheme with minimum ! 13: * difficulty. We assume that an error which comes to this routine ! 14: * is of an "undefined error type" ER%misc . Soon all calls to this ! 15: * routine will be removed. ! 16: * ! 17: */ ! 18: ! 19: lispval ! 20: error(mesg,contvl) ! 21: char *mesg; ! 22: lispval contvl; ! 23: { ! 24: lispval errorh(); ! 25: ! 26: return(errorh(Vermisc,mesg,nil,contvl,0)); ! 27: } ! 28: ! 29: ! 30: /* new error handler, works with errset ! 31: * ! 32: * call is errorh(type,message,valret,contuab) where ! 33: * type is an atom which classifys the error, and whose clb, if not nil ! 34: * is the name of a function to call to handle the error. ! 35: * message is a character string to print to describe the error ! 36: * valret is the value to return to an errset if one is found, ! 37: * and contuab is non nil if this error is continuable. ! 38: */ ! 39: ! 40: #include "catchfram.h" ! 41: ! 42: lispval ! 43: errorh(type,message,valret,contuab,uniqid) ! 44: lispval type,valret; ! 45: int uniqid,contuab; ! 46: char *message; ! 47: { ! 48: register struct catchfr *curp; /* must be first register decl */ ! 49: register lispval handy; ! 50: lispval *work = 1 + (lispval *) &uniqid; int limit = nargs() - 5; ! 51: lispval Lread(), calhan(); ! 52: lispval contatm; ! 53: lispval handy2; ! 54: struct argent *savedlbot = lbot; ! 55: struct nament * savedbnp = bnp; ! 56: int curdep ; /* error depth */ ! 57: typedef struct catchfr *cp; ! 58: extern long errp; ! 59: long myerrp = errp, what; ! 60: int pass,founduw; ! 61: int saveme[SAVSIZE]; ! 62: snpand(2); ! 63: ! 64: contatm = (contuab == TRUE ? tatom : nil); ! 65: ! 66: /* if there is a catch every error handler */ ! 67: if((handy = Verall->a.clb) != nil) ! 68: { ! 69: handy = Verall->a.clb; ! 70: Verall->a.clb = nil; /* turn off before calling */ ! 71: handy = calhan(limit,work,type,uniqid,contatm,message,handy); ! 72: if(contuab && (TYPE(handy) == DTPR)) ! 73: return(handy->d.car); ! 74: } ! 75: ! 76: if((handy = type->a.clb) != nil) /* if there is an error handler */ ! 77: { ! 78: handy = calhan(limit,work,type,uniqid,contatm,message,handy); ! 79: if(contuab && (TYPE(handy) == DTPR)) ! 80: return(handy->d.car); ! 81: } ! 82: ! 83: pass = 1; ! 84: /* search stack for error catcher */ ! 85: ps2: ! 86: founduw = FALSE; ! 87: ! 88: for (curp = (cp) errp ; curp != (cp) nil ; curp = curp->link) ! 89: { ! 90: if(curp->labl == Veruwpt) founduw = TRUE; ! 91: if(((pass == 2) && founduw) ! 92: || (curp->labl == type) ! 93: || ( (TYPE(curp->labl) == DTPR) && (curp->labl->d.car == Verall))) ! 94: { ! 95: if((pass == 1) && founduw) ! 96: { pass = 2; ! 97: goto ps2; ! 98: } ! 99: ! 100: if(founduw) ! 101: { protect(handy2 = newdot()); ! 102: handy2->d.car = Veruwpt; ! 103: handy = handy2->d.cdr = newdot(); ! 104: handy->d.car = nil; /* indicates error */ ! 105: handy = handy->d.cdr = newdot(); ! 106: handy->d.car = type; ! 107: handy = handy->d.cdr = newdot(); ! 108: handy->d.car = matom(message); ! 109: handy = handy->d.cdr = newdot(); ! 110: handy->d.car = valret; ! 111: handy = handy->d.cdr = newdot(); ! 112: handy->d.car = inewint(uniqid); ! 113: handy = handy->d.cdr = newdot(); ! 114: handy->d.car = inewint(contuab); ! 115: while (limit-- > 0) /* put in optional args */ ! 116: { handy = handy->d.cdr = newdot(); ! 117: handy->d.car = *work++; ! 118: } ! 119: valret = handy2; /* return this as value */ ! 120: } ! 121: else if( (curp->flag != nil) ! 122: && (type != Vererr)) { ! 123: /* print the full error message */ ! 124: printf("%s ",message); ! 125: while(limit-->0) { ! 126: printr(*work++,stdout); ! 127: fflush(stdout); ! 128: } ! 129: fputc('\n',stdout); ! 130: fflush(stdout); ! 131: } ! 132: if(!founduw && ((handy=Verrset->a.clb) != nil)) ! 133: { ! 134: calhan(limit,work,type,uniqid,contatm,message,handy); ! 135: } ! 136: popnames(curp->svbnp); /* un shallow bind */ ! 137: errp = (int) curp->link; /* set error to next frame */ ! 138: /* ! 139: * return value goes into r7 until after movc3 instruction ! 140: * which clobbers r0 ! 141: */ ! 142: asm(" movl 12(ap),r7"); /* set return value (valret)*/ ! 143: asm(" addl3 $16,r11,sp"); /* skip link,flag,labl,svbnp */ ! 144: asm(" movc3 $44,(sp),_setsav");/*restore (return) context*/ ! 145: asm(" movab 44(sp),sp"); /* skip past "" "" */ ! 146: asm(" popr $0x2540"); /* restore registers */ ! 147: asm(" movl r7,r0"); ! 148: asm(" rsb"); /* return to errset */ ! 149: /* NOT REACHED */ ! 150: } ! 151: } ! 152: ! 153: /* no one will catch this error, we must see if there is an ! 154: error-goes-to-top-level catcher */ ! 155: ! 156: if (Vertpl->a.clb != nil) ! 157: { ! 158: ! 159: handy = calhan(limit,work,type,uniqid,contatm,message,Vertpl->a.clb); ! 160: if( contuab && (TYPE(handy) == DTPR)) ! 161: return(handy->d.car); ! 162: } ! 163: ! 164: /* at this point, print error mssage and break, just like ! 165: the current error scheme */ ! 166: printf("%s ",message); ! 167: while(limit-->0) { ! 168: printr(*work++,stdout); ! 169: fflush(stdout); ! 170: } ! 171: ! 172: ! 173: /* If automatic-reset is set ! 174: we will now jump to top level, calling the reset function ! 175: if it exists, or using the c rest function if it does not ! 176: */ ! 177: ! 178: if(Sautor) ! 179: { ! 180: if ((handy = reseta->a.fnbnd) != nil) ! 181: { lbot = np; ! 182: protect(reseta); ! 183: protect(nil); ! 184: Lapply(); ! 185: } ! 186: contval = 0; ! 187: reset(BRRETB); ! 188: } ! 189: ! 190: curdep = ++depth; ! 191: getexit(saveme); ! 192: while(what = setexit()) { ! 193: errp = myerrp; ! 194: depth = curdep; ! 195: switch(what) { ! 196: case BRRETB: ! 197: if (curdep == (int) contval) { ! 198: popnames(savedbnp); ! 199: lbot = savedlbot; ! 200: continue; ! 201: } ! 202: default: ! 203: resexit(saveme); ! 204: reset(what); ! 205: ! 206: case BRRETN: ! 207: if (contuab) ! 208: { ! 209: popnames(savedbnp); ! 210: lbot = savedlbot; ! 211: depth = curdep -1; ! 212: resexit(saveme); ! 213: return(contval); ! 214: } ! 215: printf("CAN'T CONTINUE\n"); ! 216: ! 217: } ! 218: } ! 219: lbot = np; ! 220: np++->val = P(stdin); ! 221: np++->val = eofa; ! 222: while(TRUE) { ! 223: ! 224: depth = curdep; /* In case of freturn, reset this global */ ! 225: fprintf(stdout,"\n%d:>",curdep); ! 226: dmpport(stdout); ! 227: vtemp = Lread(); ! 228: if(vtemp == eofa) exit(0); ! 229: printr(eval(vtemp),stdout); ! 230: } ! 231: } ! 232: lispval ! 233: calhan(limit,work,type,uniqid,contuab,message,handler) ! 234: register lispval *work; ! 235: lispval handler,type,contuab; ! 236: register limit; ! 237: register char *message; ! 238: int uniqid; ! 239: { ! 240: register lispval handy; ! 241: register struct argent *lbot, *np; ! 242: lbot = np; ! 243: protect(handler); /* funcall the handler */ ! 244: protect(handy = newdot()); /* with a list consisting of */ ! 245: handy->d.car = type; /* type, */ ! 246: handy = (handy->d.cdr = newdot()); ! 247: handy->d.car = inewint(uniqid); /* identifying number, */ ! 248: handy = (handy->d.cdr = newdot()); ! 249: handy->d.car = contuab; ! 250: handy = (handy->d.cdr = newdot()); ! 251: handy->d.car = matom(message); /* message to be typed out, */ ! 252: while(limit-- > 0) ! 253: { /* any other args. */ ! 254: handy = handy->d.cdr = newdot(); ! 255: handy->d.car = *work++; ! 256: } ! 257: handy->d.cdr = nil; ! 258: ! 259: handy = Lfuncal(); ! 260: np=lbot; ! 261: return(handy); ! 262: } ! 263: ! 264: /* lispend **************************************************************/ ! 265: /* Fatal errors come here, with their epitaph. */ ! 266: lispend(mesg) ! 267: char mesg[]; ! 268: { ! 269: dmpport(poport); ! 270: fprintf(errport,"%s\n",mesg); ! 271: dmpport(errport); ! 272: exit(0); ! 273: } ! 274: ! 275: /* namerr ***************************************************************/ ! 276: /* handles namestack overflow, at present by simply giving a message */ ! 277: ! 278: namerr() ! 279: { ! 280: if((nplim = np + NAMINC) > orgnp + NAMESIZE) ! 281: { ! 282: printf("Unrecoverable Namestack Overflow, (reset) is forced\n"); ! 283: fflush(stdout); ! 284: nplim = orgnp + NAMESIZE - 4*NAMINC; ! 285: lbot = np = nplim - NAMINC; ! 286: protect(matom("reset")); ! 287: Lfuncal(); ! 288: } ! 289: error("NAMESTACK OVERFLOW",FALSE); ! 290: /* NOT REACHED */ ! 291: } ! 292: binderr() ! 293: { ! 294: bnp -= 10; ! 295: error("Bindstack overflow.",FALSE); ! 296: } ! 297: rtaberr() ! 298: { ! 299: bindfix(Vreadtable,strtab,nil); ! 300: error("Illegal read table.",FALSE); ! 301: } ! 302: badmem() ! 303: { ! 304: error("Attempt to allocate beyond static structures.",FALSE); ! 305: } ! 306: argerr(msg) ! 307: char *msg; ! 308: { ! 309: Lshostk(); ! 310: errorh(Vermisc,"incorrect number of args to", ! 311: nil,FALSE,0,matom(msg)); ! 312: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.