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