![[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] / 41BSD / cmd / lisp|
Return to error.c CVS log | Up to [CSRG BSD Unix] / 41BSD / 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.