/[gcl]/gcl/o/error.c
ViewVC logotype

Diff of /gcl/o/error.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by camm, Wed Oct 16 03:24:02 2002 UTC revision 1.12 by camm, Sun Feb 9 22:35:18 2003 UTC
# Line 26  Foundation, 675 Mass Ave, Cambridge, MA Line 26  Foundation, 675 Mass Ave, Cambridge, MA
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;
# Line 123  call_error_handler(void) Line 121  call_error_handler(void)
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 */
# Line 136  Icall_error_handler(error_name,error_for Line 130  Icall_error_handler(error_name,error_for
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       }       }
# Line 146  Icall_error_handler(error_name,error_for Line 140  Icall_error_handler(error_name,error_for
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 */
# Line 159  Icall_continue_error_handler(error_name, Line 149  Icall_continue_error_handler(error_name,
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       }       }
# Line 168  Icall_continue_error_handler(error_name, Line 158  Icall_continue_error_handler(error_name,
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;
# Line 182  va_dcl Line 170  va_dcl
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);
# Line 195  va_dcl Line 183  va_dcl
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;
# Line 209  va_dcl Line 195  va_dcl
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);
# Line 218  va_dcl Line 204  va_dcl
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;
# Line 232  va_dcl Line 217  va_dcl
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);
# Line 241  va_dcl Line 226  va_dcl
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;
# Line 256  va_dcl Line 238  va_dcl
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);
# Line 273  va_dcl Line 255  va_dcl
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;
# Line 292  FEerror(s,num,va_alist) Line 271  FEerror(s,num,va_alist)
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)
# Line 437  ILLEGAL: Line 416  ILLEGAL:
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);
# Line 478  ILLEGAL: Line 455  ILLEGAL:
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
# Line 505  object x0; Line 480  object 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    
# Line 521  object x0; Line 495  object x0;
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
# Line 555  ILLEGAL: Line 527  ILLEGAL:
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;
# Line 595  ILLEGAL: Line 565  ILLEGAL:
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 */
# Line 604  DEFUNO("VS-TOP",object,fSvs_top,SI Line 574  DEFUNO("VS-TOP",object,fSvs_top,SI
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;
# Line 631  object x0,x1; Line 599  object x0,x1;
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    
# Line 656  internal error handling mechanism. \ Line 623  internal error handling mechanism. \
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 */
# Line 791  if (type_of(strm) != t_stream) Line 757  if (type_of(strm) != t_stream)
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  }  }

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26