/* error ****************************************************************/
/* this routine is always called on a non-fatal error. The first argu- */
/* ment is printed out. The second a boolean flag indicating if the */
/* error routine is permitted to return a pointer to a lisp value if */
/* the "cont" command is executed. */
/* error from lisp C code, this temporarily replaces the old error
* allowing us to interface with the new errset scheme with minimum
* difficulty. We assume that an error which comes to this routine
* is of an "undefined error type" ER%misc . Soon all calls to this
* routine will be removed.
return(errorh(Vermisc
,mesg
,nil
,contvl
,0));
/* new error handler, works with errset
* call is errorh(type,message,valret,contuab) where
* type is an atom which classifys the error, and whose clb, if not nil
* is the name of a function to call to handle the error.
* message is a character string to print to describe the error
* valret is the value to return to an errset if one is found,
* and contuab is non nil if this error is continuable.
errorh(type
,message
,valret
,contuab
,uniqid
)
register struct catchfr
*curp
; /* must be first register decl */
lispval
*work
= 1 + (lispval
*) &uniqid
; int limit
= nargs() - 5;
lispval
Lread(), calhan();
struct argent
*savedlbot
= lbot
;
struct nament
* savedbnp
= bnp
;
int curdep
; /* error depth */
typedef struct catchfr
*cp
;
if(type
->clb
!= nil
) /* if there is an error handler */
handy
= calhan(limit
,work
,type
->clb
,uniqid
,message
);
if(contuab
&& (TYPE(handy
) == DTPR
))
/* search stack for error catcher */
for (curp
= (cp
) errp
; curp
!= (cp
) nil
; curp
= curp
->link
)
|| ( (TYPE(curp
->labl
) == DTPR
) && (curp
->labl
->car
== Verall
)))
/* print the full error message */
popnames(curp
->svbnp
); /* un shallow bind */
errp
= (int) curp
->link
; /* set error to next frame */
asm(" addl3 $16,r11,sp"); /* skip link,flag,labl,svbnp */
asm(" movc3 $40,(sp),_setsav");/*restore (return) context*/
asm(" movab 40(sp),sp"); /* skip past "" "" */
asm(" popr $0x2540"); /* restore registers */
asm(" movl 12(ap),r0"); /* set return value */
asm(" rsb"); /* return to errset */
/* no one will catch this error, we must see if there is an
error-goes-to-top-level catcher */
handy
= calhan(limit
,work
,Vertpl
,uniqid
,message
);
if( contuab
&& (TYPE(handy
) == DTPR
))
/* at this point, print error mssage and break, just like
the current error scheme */
while(what
= setexit()) {
if (curdep
== (int) contval
) {
printf("CAN'T CONTINUE\n");
fprintf(stdout
,"\n%d:>",curdep
);
if(vtemp
== eofa
) exit(0);
printr(eval(vtemp
),stdout
);
calhan(limit
,work
,handler
,uniqid
,message
)
register struct argent
*lbot
, *np
;
protect(handler
->clb
); /* funcall the handler */
protect(handy
= newdot()); /* with a list consisting of */
handy
->car
= inewint(uniqid
); /* identifying number, */
handy
= handy
->cdr
= newdot();
handy
->car
= matom(message
); /* message to be typed out, */
handy
= handy
->cdr
= newdot();
/* lispend **************************************************************/
/* Fatal errors come here, with their epitaph. */
fprintf(errport
,"%s\n",mesg
);
/* namerr ***************************************************************/
/* handles namestack overflow, at present by simply giving a message */
error("NAMESTACK OVERFLOW",FALSE
);
error("Bindstack overflow.",FALSE
);
bindfix(Vreadtable
,strtab
,nil
);
error("Illegal read table.",FALSE
);
error("Attempt to allocate beyond static structures.",FALSE
);