26 |
Errors |
Errors |
27 |
*/ |
*/ |
28 |
|
|
|
/* #define _GNU_SOURCE */ |
|
29 |
#include <stdlib.h> |
#include <stdlib.h> |
30 |
#include "include.h" |
#include "include.h" |
|
#include <varargs.h> |
|
31 |
object siSuniversal_error_handler; |
object siSuniversal_error_handler; |
32 |
|
|
33 |
static object null_string; |
static object null_string; |
121 |
|
|
122 |
|
|
123 |
object |
object |
124 |
Icall_error_handler(error_name,error_format_string,nfmt_args,va_alist) |
Icall_error_handler(object error_name,object error_format_string,int nfmt_args,...) |
|
object error_name,error_format_string; |
|
|
int nfmt_args; |
|
|
va_dcl |
|
|
/* n is the total number of args passed to this function */ |
|
125 |
{ object b[20]; |
{ object b[20]; |
126 |
b[0]= error_name; |
b[0]= error_name; |
127 |
b[1]= Cnil; /* continue format */ |
b[1]= Cnil; /* continue format */ |
130 |
b[4] = error_format_string; |
b[4] = error_format_string; |
131 |
{int i = 0; |
{int i = 0; |
132 |
va_list ap; |
va_list ap; |
133 |
va_start(ap); |
va_start(ap,nfmt_args); |
134 |
while (i++ < nfmt_args) |
while (i++ < nfmt_args) |
135 |
{ b[i+4]= va_arg(ap,object); |
{ b[i+4]= va_arg(ap,object); |
136 |
} |
} |
140 |
} |
} |
141 |
|
|
142 |
static object |
static object |
143 |
Icall_continue_error_handler(error_name,error_format_string,nfmt_args,va_alist) |
Icall_continue_error_handler(object error_name,object error_format_string,int nfmt_args,...) |
|
object error_name,error_format_string; |
|
|
int nfmt_args; |
|
|
va_dcl |
|
|
/* n is the total number of args passed to this function */ |
|
144 |
{ object b[20]; |
{ object b[20]; |
145 |
b[0]= error_name; |
b[0]= error_name; |
146 |
b[1]= Ct; /* continue format */ |
b[1]= Ct; /* continue format */ |
149 |
b[4] = error_format_string; |
b[4] = error_format_string; |
150 |
{int i = 0; |
{int i = 0; |
151 |
va_list ap; |
va_list ap; |
152 |
va_start(ap); |
va_start(ap,nfmt_args); |
153 |
while (i++ < nfmt_args) |
while (i++ < nfmt_args) |
154 |
{ b[i+4]= va_arg(ap,object); |
{ b[i+4]= va_arg(ap,object); |
155 |
} |
} |
158 |
return IapplyVector(sSuniversal_error_handler,nfmt_args+5,b); |
return IapplyVector(sSuniversal_error_handler,nfmt_args+5,b); |
159 |
} |
} |
160 |
|
|
161 |
DEFUNO("ERROR",object,fLerror,LISP |
DEFUNO_NEW("ERROR",object,fLerror,LISP |
162 |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lerror,"")(fmt_string,va_alist) |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lerror,(object fmt_string,...),"") |
|
object fmt_string; |
|
|
va_dcl |
|
163 |
{ int n = VFUN_NARGS,i=0; |
{ int n = VFUN_NARGS,i=0; |
164 |
object b[F_ARG_LIMIT]; |
object b[F_ARG_LIMIT]; |
165 |
va_list ap; |
va_list ap; |
170 |
b[3]=null_string; |
b[3]=null_string; |
171 |
b[4]=fmt_string; |
b[4]=fmt_string; |
172 |
i=4; |
i=4; |
173 |
va_start(ap); |
va_start(ap,fmt_string); |
174 |
while (--n) |
while (--n) |
175 |
b[++i]=va_arg(ap,object); |
b[++i]=va_arg(ap,object); |
176 |
va_end(ap); |
va_end(ap); |
183 |
/* &ap)); */ |
/* &ap)); */ |
184 |
} |
} |
185 |
|
|
186 |
DEFUNO("SPECIFIC-ERROR",object,fLspecific_error,LISP |
DEFUNO_NEW("SPECIFIC-ERROR",object,fLspecific_error,LISP |
187 |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lspecific_error,"")(error_name,fmt_string,va_alist) |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lspecific_error,(object error_name,object fmt_string,...),"") |
|
object error_name,fmt_string; |
|
|
va_dcl |
|
188 |
{ int n = VFUN_NARGS,i=0; |
{ int n = VFUN_NARGS,i=0; |
189 |
object b[F_ARG_LIMIT]; |
object b[F_ARG_LIMIT]; |
190 |
va_list ap; |
va_list ap; |
195 |
b[3]=null_string; |
b[3]=null_string; |
196 |
b[4]=fmt_string; |
b[4]=fmt_string; |
197 |
i=4; |
i=4; |
198 |
va_start(ap); |
va_start(ap,fmt_string); |
199 |
n--; |
n--; |
200 |
while (--n) |
while (--n) |
201 |
b[++i]=va_arg(ap,object); |
b[++i]=va_arg(ap,object); |
204 |
} |
} |
205 |
|
|
206 |
|
|
207 |
DEFUNO("SPECIFIC-CORRECTABLE-ERROR",object,fLspecific_correctable_error,LISP |
DEFUNO_NEW("SPECIFIC-CORRECTABLE-ERROR",object,fLspecific_correctable_error,LISP |
208 |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lspecific_correctable_error,"")(error_name,fmt_string,va_alist) |
,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lspecific_correctable_error, |
209 |
object error_name,fmt_string; |
(object error_name,object fmt_string,...),"") |
|
va_dcl |
|
210 |
{ int n = VFUN_NARGS,i=0; |
{ int n = VFUN_NARGS,i=0; |
211 |
object b[F_ARG_LIMIT]; |
object b[F_ARG_LIMIT]; |
212 |
va_list ap; |
va_list ap; |
217 |
b[3]=null_string; |
b[3]=null_string; |
218 |
b[4]=fmt_string; |
b[4]=fmt_string; |
219 |
i=4; |
i=4; |
220 |
va_start(ap); |
va_start(ap,fmt_string); |
221 |
n--; |
n--; |
222 |
while (--n) |
while (--n) |
223 |
b[++i]=va_arg(ap,object); |
b[++i]=va_arg(ap,object); |
226 |
} |
} |
227 |
|
|
228 |
|
|
229 |
DEFUNO("CERROR",object,fLcerror,LISP |
DEFUNO_NEW("CERROR",object,fLcerror,LISP |
230 |
,2,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lcerror,"") |
,2,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lcerror,(object continue_fmt_string,object fmt_string,...),"") |
|
(continue_fmt_string,fmt_string,va_alist) |
|
|
object continue_fmt_string,fmt_string; |
|
|
va_dcl |
|
231 |
{ int n = VFUN_NARGS,i=0; |
{ int n = VFUN_NARGS,i=0; |
232 |
object b[F_ARG_LIMIT]; |
object b[F_ARG_LIMIT]; |
233 |
va_list ap; |
va_list ap; |
238 |
b[3]=null_string; |
b[3]=null_string; |
239 |
b[4]=fmt_string; |
b[4]=fmt_string; |
240 |
i=4; |
i=4; |
241 |
va_start(ap); |
va_start(ap,fmt_string); |
242 |
while (--n) |
while (--n) |
243 |
b[++i]=va_arg(ap,object); |
b[++i]=va_arg(ap,object); |
244 |
va_end(ap); |
va_end(ap); |
255 |
/* void */ |
/* void */ |
256 |
/* FEerror(char *s, int num, object arg1, object arg2, object arg3, object arg4) */ |
/* FEerror(char *s, int num, object arg1, object arg2, object arg3, object arg4) */ |
257 |
void |
void |
258 |
FEerror(s,num,va_alist) |
FEerror(char *s,int num,...) |
|
char *s; |
|
|
int num; |
|
|
va_dcl |
|
259 |
{ |
{ |
260 |
char *p = s; |
char *p = s; |
261 |
int last = 0; |
int last = 0; |
271 |
|
|
272 |
arg1=arg2=arg3=arg4=Cnil; |
arg1=arg2=arg3=arg4=Cnil; |
273 |
i=VFUN_NARGS; |
i=VFUN_NARGS; |
274 |
va_start(args); |
va_start(args,num); |
275 |
if (i && --i) |
if (i && --i) |
276 |
arg1=va_arg(args,object); |
arg1=va_arg(args,object); |
277 |
if (i && --i) |
if (i && --i) |
416 |
return(NULL); |
return(NULL); |
417 |
} |
} |
418 |
|
|
419 |
DEFUNO("IHS-TOP",object,fSihs_top,SI |
DEFUNO_NEW("IHS-TOP",object,fSihs_top,SI |
420 |
,0,0,NONE,OO,OO,OO,OO,siLihs_top,"")() |
,0,0,NONE,OO,OO,OO,OO,siLihs_top,(void),"") |
421 |
|
|
422 |
{ |
{ |
423 |
/* 0 args */ |
/* 0 args */ |
424 |
RETURN1(make_fixnum(ihs_top - ihs_org)); |
RETURN1(make_fixnum(ihs_top - ihs_org)); |
425 |
} |
} |
426 |
|
|
427 |
DEFUNO("IHS-FUN",object,fSihs_fun,SI |
DEFUNO_NEW("IHS-FUN",object,fSihs_fun,SI |
428 |
,1,1,NONE,OO,OO,OO,OO,siLihs_fun,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLihs_fun,(object x0),"") |
|
object x0; |
|
429 |
{ |
{ |
430 |
/* 1 args */ |
/* 1 args */ |
431 |
x0 = get_ihs_ptr(x0)->ihs_function; |
x0 = get_ihs_ptr(x0)->ihs_function; |
432 |
RETURN1(x0); |
RETURN1(x0); |
433 |
} |
} |
434 |
|
|
435 |
DEFUNO("IHS-VS",object,fSihs_vs,SI |
DEFUNO_NEW("IHS-VS",object,fSihs_vs,SI |
436 |
,1,1,NONE,OO,OO,OO,OO,siLihs_vs,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLihs_vs,(object x0),"") |
|
object x0; |
|
437 |
{ |
{ |
438 |
/* 1 args */ |
/* 1 args */ |
439 |
x0 = make_fixnum(get_ihs_ptr(x0)->ihs_base - vs_org); |
x0 = make_fixnum(get_ihs_ptr(x0)->ihs_base - vs_org); |
455 |
return NULL; |
return NULL; |
456 |
} |
} |
457 |
|
|
458 |
DEFUNO("FRS-TOP",object,fSfrs_top,SI |
DEFUNO_NEW("FRS-TOP",object,fSfrs_top,SI |
459 |
,0,0,NONE,OO,OO,OO,OO,siLfrs_top,"")() |
,0,0,NONE,OO,OO,OO,OO,siLfrs_top,(void),"") |
460 |
|
|
461 |
{ |
{ |
462 |
/* 0 args */ |
/* 0 args */ |
463 |
RETURN1((make_fixnum(frs_top - frs_org))); |
RETURN1((make_fixnum(frs_top - frs_org))); |
464 |
} |
} |
465 |
|
|
466 |
DEFUNO("FRS-VS",object,fSfrs_vs,SI |
DEFUNO_NEW("FRS-VS",object,fSfrs_vs,SI |
467 |
,1,1,NONE,OO,OO,OO,OO,siLfrs_vs,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLfrs_vs,(object x0),"") |
|
object x0; |
|
468 |
{ |
{ |
469 |
/* 1 args */ |
/* 1 args */ |
470 |
x0 = make_fixnum(get_frame_ptr(x0)->frs_lex - vs_org); |
x0 = make_fixnum(get_frame_ptr(x0)->frs_lex - vs_org); |
471 |
RETURN1(x0); |
RETURN1(x0); |
472 |
} |
} |
473 |
|
|
474 |
DEFUNO("FRS-BDS",object,fSfrs_bds,SI |
DEFUNO_NEW("FRS-BDS",object,fSfrs_bds,SI |
475 |
,1,1,NONE,OO,OO,OO,OO,siLfrs_bds,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLfrs_bds,(object x0),"") |
|
object x0; |
|
476 |
{ |
{ |
477 |
/* 1 args */ |
/* 1 args */ |
478 |
x0 |
x0 |
480 |
RETURN1(x0); |
RETURN1(x0); |
481 |
} |
} |
482 |
|
|
483 |
DEFUNO("FRS-CLASS",object,fSfrs_class,SI |
DEFUNO_NEW("FRS-CLASS",object,fSfrs_class,SI |
484 |
,1,1,NONE,OO,OO,OO,OO,siLfrs_class,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLfrs_class,(object x0),"") |
|
object x0; |
|
485 |
{ |
{ |
486 |
enum fr_class c; |
enum fr_class c; |
487 |
|
|
495 |
RETURN1(x0); |
RETURN1(x0); |
496 |
} |
} |
497 |
|
|
498 |
DEFUNO("FRS-TAG",object,fSfrs_tag,SI |
DEFUNO_NEW("FRS-TAG",object,fSfrs_tag,SI |
499 |
,1,1,NONE,OO,OO,OO,OO,siLfrs_tag,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLfrs_tag,(object x0),"") |
|
object x0; |
|
500 |
{ |
{ |
501 |
/* 1 args */ |
/* 1 args */ |
502 |
x0 = get_frame_ptr(x0)->frs_val; |
x0 = get_frame_ptr(x0)->frs_val; |
503 |
RETURN1(x0); |
RETURN1(x0); |
504 |
} |
} |
505 |
|
|
506 |
DEFUNO("FRS-IHS",object,fSfrs_ihs,SI |
DEFUNO_NEW("FRS-IHS",object,fSfrs_ihs,SI |
507 |
,1,1,NONE,OO,OO,OO,OO,siLfrs_ihs,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLfrs_ihs,(object x0),"") |
|
object x0; |
|
508 |
{ |
{ |
509 |
/* 1 args */ |
/* 1 args */ |
510 |
x0 |
x0 |
527 |
return NULL; |
return NULL; |
528 |
} |
} |
529 |
|
|
530 |
DEFUNO("BDS-TOP",object,fSbds_top,SI |
DEFUNO_NEW("BDS-TOP",object,fSbds_top,SI |
531 |
,0,0,NONE,OO,OO,OO,OO,siLbds_top,"")() |
,0,0,NONE,OO,OO,OO,OO,siLbds_top,(void),"") |
532 |
|
|
533 |
{ |
{ |
534 |
/* 0 args */ |
/* 0 args */ |
535 |
RETURN1((make_fixnum(bds_top - bds_org))); |
RETURN1((make_fixnum(bds_top - bds_org))); |
536 |
} |
} |
537 |
|
|
538 |
DEFUNO("BDS-VAR",object,fSbds_var,SI |
DEFUNO_NEW("BDS-VAR",object,fSbds_var,SI |
539 |
,1,1,NONE,OO,OO,OO,OO,siLbds_var,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLbds_var,(object x0),"") |
|
object x0; |
|
540 |
{ |
{ |
541 |
/* 1 args */ |
/* 1 args */ |
542 |
x0 = get_bds_ptr(x0)->bds_sym; |
x0 = get_bds_ptr(x0)->bds_sym; |
543 |
RETURN1(x0); |
RETURN1(x0); |
544 |
} |
} |
545 |
|
|
546 |
DEFUNO("BDS-VAL",object,fSbds_val,SI |
DEFUNO_NEW("BDS-VAL",object,fSbds_val,SI |
547 |
,1,1,NONE,OO,OO,OO,OO,siLbds_val,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLbds_val,(object x0),"") |
|
object x0; |
|
548 |
{ |
{ |
549 |
/* 1 args */ |
/* 1 args */ |
550 |
x0 = get_bds_ptr(x0)->bds_val; |
x0 = get_bds_ptr(x0)->bds_val; |
565 |
return NULL; |
return NULL; |
566 |
} |
} |
567 |
|
|
568 |
DEFUNO("VS-TOP",object,fSvs_top,SI |
DEFUNO_NEW("VS-TOP",object,fSvs_top,SI |
569 |
,0,0,NONE,OO,OO,OO,OO,siLvs_top,"")() |
,0,0,NONE,OO,OO,OO,OO,siLvs_top,(void),"") |
570 |
{ |
{ |
571 |
object x; |
object x; |
572 |
/* 0 args */ |
/* 0 args */ |
574 |
RETURN1(x); |
RETURN1(x); |
575 |
} |
} |
576 |
|
|
577 |
DEFUNO("VS",object,fSvs,SI |
DEFUNO_NEW("VS",object,fSvs,SI |
578 |
,1,1,NONE,OO,OO,OO,OO,siLvs,"")(x0) |
,1,1,NONE,OO,OO,OO,OO,siLvs,(object x0),"") |
|
object x0; |
|
579 |
{ |
{ |
580 |
/* 1 args */ |
/* 1 args */ |
581 |
x0 = *get_vs_ptr(x0); |
x0 = *get_vs_ptr(x0); |
582 |
RETURN1(x0); |
RETURN1(x0); |
583 |
} |
} |
584 |
|
|
585 |
DEFUNO("SCH-FRS-BASE",object,fSsch_frs_base,SI |
DEFUNO_NEW("SCH-FRS-BASE",object,fSsch_frs_base,SI |
586 |
,2,2,NONE,OO,OO,OO,OO,siLsch_frs_base,"") (x0,x1) |
,2,2,NONE,OO,OO,OO,OO,siLsch_frs_base,(object x0,object x1),"") |
|
object x0,x1; |
|
587 |
{ |
{ |
588 |
frame_ptr x; |
frame_ptr x; |
589 |
ihs_ptr y; |
ihs_ptr y; |
599 |
RETURN1(x0); |
RETURN1(x0); |
600 |
} |
} |
601 |
|
|
602 |
DEFUNO("INTERNAL-SUPER-GO",object,fSinternal_super_go,SI |
DEFUNO_NEW("INTERNAL-SUPER-GO",object,fSinternal_super_go,SI |
603 |
,3,3,NONE,OO,OO,OO,OO,siLinternal_super_go,"")(tag,x1,x2) |
,3,3,NONE,OO,OO,OO,OO,siLinternal_super_go,(object tag,object x1,object x2),"") |
|
object tag,x1,x2; |
|
604 |
{ |
{ |
605 |
frame_ptr fr; |
frame_ptr fr; |
606 |
|
|
623 |
Args: (error-name correctable function-name \ |
Args: (error-name correctable function-name \ |
624 |
continue-format-string error-format-string \ |
continue-format-string error-format-string \ |
625 |
&rest args)"); |
&rest args)"); |
626 |
DEFUNO("UNIVERSAL-ERROR-HANDLER",object,fSuniversal_error_handler,SI |
DEFUNO_NEW("UNIVERSAL-ERROR-HANDLER",object,fSuniversal_error_handler,SI |
627 |
,5,F_ARG_LIMIT,NONE,OO,OO,OO,OO, |
,5,F_ARG_LIMIT,NONE,OO,OO,OO,OO, |
628 |
siLuniversal_error_handler,"")(x0,x1,x2,x3,error_fmt_string) |
siLuniversal_error_handler,(object x0,object x1,object x2,object x3,object error_fmt_string),"") |
|
object x0,x1,x2,x3,error_fmt_string; |
|
629 |
{ |
{ |
630 |
int i; |
int i; |
631 |
/* 5 args */ |
/* 5 args */ |
757 |
} |
} |
758 |
|
|
759 |
object |
object |
760 |
LVerror(va_alist) |
LVerror(object first,...) |
|
va_dcl |
|
761 |
{va_list ap; |
{va_list ap; |
762 |
va_start(ap); |
va_start(ap,first); |
763 |
fcall.fun= make_cfun(Lerror,Cnil,Cnil,0,0); |
fcall.fun= make_cfun(Lerror,Cnil,Cnil,0,0); |
764 |
fcalln_general(ap); |
fcalln_general(first,ap); |
765 |
va_end(ap); |
va_end(ap); |
766 |
return Cnil; |
return Cnil; |
767 |
} |
} |