/[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.2 by camm, Thu Jun 13 00:00:46 2002 UTC revision 1.3 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 26  Foundation, 675 Mass Ave, Cambridge, MA Line 26  Foundation, 675 Mass Ave, Cambridge, MA
26          Errors          Errors
27  */  */
28    
29    /*  #define _GNU_SOURCE */
30  #include "include.h"  #include "include.h"
31  #include <varargs.h>  #include <varargs.h>
32  object siSuniversal_error_handler;  object siSuniversal_error_handler;
# Line 34  static object null_string; Line 35  static object null_string;
35    
36  object sSterminal_interrupt;  object sSterminal_interrupt;
37    
38  terminal_interrupt(correctable)  void
39    terminal_interrupt(int correctable)
40  {  {
41      signals_allowed = sig_normal;      signals_allowed = sig_normal;
42      ifuncall1(sSterminal_interrupt, correctable?Ct:Cnil);      ifuncall1(sSterminal_interrupt, correctable?Ct:Cnil);
43  }  }
44    
45  object  object
46  ihs_function_name(x)  ihs_function_name(object x)
 object x;  
47  {  {
48          object y;          object y;
49    
# Line 98  object x; Line 99  object x;
99  }  }
100    
101  object  object
102  ihs_top_function_name(h)  ihs_top_function_name(ihs_ptr h)
         ihs_ptr h;  
103  {  {
104          object x;          object x;
105    
# Line 113  ihs_top_function_name(h) Line 113  ihs_top_function_name(h)
113          return(Cnil);          return(Cnil);
114  }  }
115    
116    void
117  call_error_handler()  call_error_handler(void)
118  {  {
119          super_funcall(siSuniversal_error_handler);          super_funcall(siSuniversal_error_handler);
120  }  }
# Line 123  call_error_handler() Line 123  call_error_handler()
123    
124  object  object
125  Icall_error_handler(error_name,error_format_string,nfmt_args,va_alist)  Icall_error_handler(error_name,error_format_string,nfmt_args,va_alist)
126  int nfmt_args;       object error_name,error_format_string;
127  object error_name,error_format_string;       int nfmt_args;
128  va_dcl       va_dcl
129       /* n is the total number of args passed to this function */       /* n is the total number of args passed to this function */
130  { object b[20];  { object b[20];
131    b[0]= error_name;    b[0]= error_name;
# Line 148  DEFUNO("ERROR",object,fLerror,LISP Line 148  DEFUNO("ERROR",object,fLerror,LISP
148     ,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lerror,"")(fmt_string,va_alist)     ,1,F_ARG_LIMIT,NONE,OO,OO,OO,OO,Lerror,"")(fmt_string,va_alist)
149  object fmt_string;  object fmt_string;
150  va_dcl  va_dcl
151  { int n = VFUN_NARGS;  { int n = VFUN_NARGS,i=0;
152      object b[F_ARG_LIMIT];
153    va_list ap;    va_list ap;
154    
155      b[0]=sKerror;
156      b[1]=Cnil;
157      b[2]=ihs_top_function_name(ihs_top-1);
158      b[3]=null_string;
159      b[4]=fmt_string;
160      i=4;
161    va_start(ap);    va_start(ap);
162    RETURN1(Iapply_fun_n2(sSuniversal_error_handler,5,n-1,    while (--n)
163                            sKerror,      b[++i]=va_arg(ap,object);
164                            Cnil,    va_end(arg);
165                            ihs_top_function_name(ihs_top-1),    RETURN1(IapplyVector(sSuniversal_error_handler,++i,b));
166                            null_string,fmt_string,  /*    RETURN1(Iapply_fun_n2(sSuniversal_error_handler,5,n-1, */
167                         &ap));  /*                        sKerror, */
168    /*                        Cnil, */
169    /*                        ihs_top_function_name(ihs_top-1), */
170    /*                        null_string,fmt_string, */
171    /*                     &ap)); */
172    va_end(ap);    va_end(ap);
173  }  }
174    
# Line 166  DEFUNO("CERROR",object,fLcerror,LISP Line 178  DEFUNO("CERROR",object,fLcerror,LISP
178       (continue_fmt_string,fmt_string,va_alist)       (continue_fmt_string,fmt_string,va_alist)
179  object continue_fmt_string,fmt_string;  object continue_fmt_string,fmt_string;
180  va_dcl  va_dcl
181  { int n = VFUN_NARGS;  { int n = VFUN_NARGS,i=0;
182      object b[F_ARG_LIMIT];
183    va_list ap;    va_list ap;
184    
185      b[0]=sKerror;
186      b[1]=Cnil;
187      b[2]=ihs_top_function_name(ihs_top-1);
188      b[3]=null_string;
189      b[4]=fmt_string;
190      i=4;
191    va_start(ap);    va_start(ap);
192    RETURN1(Iapply_fun_n2(sSuniversal_error_handler,5,n-2,    while (--n)
193                            sKerror,      b[++i]=va_arg(ap,object);
194                            Ct,    va_end(arg);
195                            ihs_top_function_name(ihs_top-1),    RETURN1(IapplyVector(sSuniversal_error_handler,++i,b));
196                         continue_fmt_string,fmt_string,  /*    RETURN1(Iapply_fun_n2(sSuniversal_error_handler,5,n-2, */
197                         &ap));  /*                        sKerror, */
198    /*                        Ct, */
199    /*                        ihs_top_function_name(ihs_top-1), */
200    /*                     continue_fmt_string,fmt_string, */
201    /*                     &ap)); */
202    va_end(ap);    va_end(ap);
203  }  }
204    
205    
206    /*  void */
207    /*  FEerror(char *s, int num, object arg1, object arg2, object arg3, object arg4) */
208  void  void
209  FEerror(s, num, arg1, arg2, arg3, arg4)  FEerror(s,num,va_alist)
210  char *s;       char *s;
211  int num;       int num;
212  object arg1, arg2, arg3, arg4;       va_dcl
213  {  char *p = s;  {  
214      char *p = s;
215    int last = 0;    int last = 0;
216    int count = 0;    int count = 0;
217      int i;
218      object arg1,arg2,arg3,arg4;
219      va_list args;
220    
221    while (*p) {    if (*p=='~' && last != '~')    while (*p) {    if (*p=='~' && last != '~')
222                      count ++;                      count ++;
223                    last = *p ; p++;}                    last = *p ; p++;}
224     VFUN_NARGS = (count == 0 ? 1 : (num > 50 ? count+1 : num+1));    VFUN_NARGS = (count == 0 ? 1 : (num > 50 ? count+1 : num+1));
225    
226      arg1=arg2=arg3=arg4=Cnil;
227      i=VFUN_NARGS;
228      va_start(args);
229      if (i && --i)
230        arg1=va_arg(args,object);
231      if (i && --i)
232        arg2=va_arg(args,object);
233      if (i && --i)
234        arg3=va_arg(args,object);
235      if (i && --i)
236        arg4=va_arg(args,object);
237      va_end(args);
238    
239    fLerror(make_simple_string(s),arg1,arg2,arg3,arg4);    fLerror(make_simple_string(s),arg1,arg2,arg3,arg4);
240        
241  }  }
242    
243    
244    void
245  FEwrong_type_argument(type, value)  FEwrong_type_argument(object type, object value)
 object type, value;  
246  {Icall_error_handler(sKwrong_type_argument,  {Icall_error_handler(sKwrong_type_argument,
247                       make_simple_string("~S is not of type ~S."),                       make_simple_string("~S is not of type ~S."),
248                       2,(value),(type));                       2,(value),(type));
249  }  }
250    
251  FEtoo_few_arguments(base, top)  void
252  object *base, *top;  FEtoo_few_arguments(object *base, object *top)
253  {    Icall_error_handler(sKtoo_few_arguments,  {    Icall_error_handler(sKtoo_few_arguments,
254                           (make_simple_string("~S [or a callee] requires more than ~R argument~:p.")),                           (make_simple_string("~S [or a callee] requires more than ~R argument~:p.")),
255                           2,(ihs_top_function_name(ihs_top)),                           2,(ihs_top_function_name(ihs_top)),
# Line 215  object *base, *top; Line 257  object *base, *top;
257    
258  }  }
259    
260  FEtoo_few_argumentsF(args)  void
261  object args;  FEtoo_few_argumentsF(object args)
262  {Icall_error_handler(sKtoo_few_arguments,  {Icall_error_handler(sKtoo_few_arguments,
263                       make_simple_string("Too few arguments."),                       make_simple_string("Too few arguments."),
264                       2,(ihs_top_function_name(ihs_top)),                       2,(ihs_top_function_name(ihs_top)),
265                       (args));                       (args));
266  }  }
267    
268  FEtoo_many_arguments(base, top)  void
269  object *base, *top;  FEtoo_many_arguments(object *base, object *top)
270  {      Icall_error_handler(sKtoo_many_arguments,  {      Icall_error_handler(sKtoo_many_arguments,
271                             (make_simple_string("~S [or a callee] requires less than ~R argument~:p.")),                             (make_simple_string("~S [or a callee] requires less than ~R argument~:p.")),
272                             2,(ihs_top_function_name(ihs_top)),(make_fixnum(top - base)));                             2,(ihs_top_function_name(ihs_top)),(make_fixnum(top - base)));
273  }  }
274    
275  FEtoo_many_argumentsF(args)  void
276  object args;  FEtoo_many_argumentsF(object args)
277  {  {
278    Icall_error_handler(sKtoo_many_arguments,    Icall_error_handler(sKtoo_many_arguments,
279                        make_simple_string("Too many arguments."),0);                        make_simple_string("Too many arguments."),0);
280  }  }
281    
282  FEinvalid_macro_call()  void
283    FEinvalid_macro_call(void)
284  {Icall_error_handler(sKinvalid_form,  {Icall_error_handler(sKinvalid_form,
285                       (make_simple_string("Invalid macro call to ~S.")),                       (make_simple_string("Invalid macro call to ~S.")),
286                       1,(ihs_top_function_name(ihs_top)));                       1,(ihs_top_function_name(ihs_top)));
287  }  }
288    
289  FEunexpected_keyword(key)  void
290  object key;  FEunexpected_keyword(object key)
291  {       if (!keywordp(key))  {       if (!keywordp(key))
292                  not_a_keyword(key);                  not_a_keyword(key);
293    
# Line 254  object key; Line 297  object key;
297                                            
298  }  }
299    
300  FEinvalid_form(s, form)  void
301  char *s;  FEinvalid_form(char *s, object form)
 object form;  
302  {Icall_error_handler(sKinvalid_form,make_simple_string(s),  {Icall_error_handler(sKinvalid_form,make_simple_string(s),
303                       1,(form));                       1,(form));
304    
305  }  }
306    
307  FEunbound_variable(sym)  void
308  object sym;  FEunbound_variable(object sym)
309  {Icall_error_handler(sKunbound_variable,  {Icall_error_handler(sKunbound_variable,
310                       make_simple_string("The variable ~S is unbound."),                       make_simple_string("The variable ~S is unbound."),
311                       1,(sym));                       1,(sym));
312  }  }
313    
314  FEinvalid_variable(s, obj)  void
315  char *s;  FEinvalid_variable(char *s, object obj)
 object obj;  
316  {Icall_error_handler(sKinvalid_variable,make_simple_string(s),  {Icall_error_handler(sKinvalid_variable,make_simple_string(s),
317                       1,(obj));                       1,(obj));
318  }  }
319    
320  FEundefined_function(fname)  void
321  object fname;  FEundefined_function(object fname)
322  {Icall_error_handler(sKundefined_function,  {Icall_error_handler(sKundefined_function,
323                       make_simple_string("The function ~S is undefined."),                       make_simple_string("The function ~S is undefined."),
324                       1,(fname));                       1,(fname));
325  }  }
326    
327  FEinvalid_function(obj)  void
328  object obj;  FEinvalid_function(object obj)
329  {Icall_error_handler(sKinvalid_function,  {Icall_error_handler(sKinvalid_function,
330                       make_simple_string("~S is invalid as a function."),                       make_simple_string("~S is invalid as a function."),
331                       1,(obj));                       1,(obj));
# Line 293  object obj; Line 334  object obj;
334    
335    
336  object  object
337  CEerror(error_str, cont_str, num, arg1, arg2, arg3, arg4)  CEerror(char *error_str, char *cont_str, int num, object arg1, object arg2, object arg3, object arg4)
 char *error_str, *cont_str;  
 int num;  
 object arg1, arg2, arg3, arg4;  
338  {  {
339          VFUN_NARGS=num+2;          VFUN_NARGS=num+2;
340          return fLcerror(make_simple_string(cont_str),          return fLcerror(make_simple_string(cont_str),
# Line 309  object arg1, arg2, arg3, arg4; Line 347  object arg1, arg2, arg3, arg4;
347          Lisp interface to IHS          Lisp interface to IHS
348  */  */
349    
350  ihs_ptr get_ihs_ptr(x)  ihs_ptr get_ihs_ptr(object x)
 object x;  
351  {  {
352          ihs_ptr p;          ihs_ptr p;
353    
# Line 322  object x; Line 359  object x;
359                  return(p);                  return(p);
360  ILLEGAL:  ILLEGAL:
361          FEerror("~S is an illegal ihs index.", 1, x);          FEerror("~S is an illegal ihs index.", 1, x);
362            return(NULL);
363  }  }
364    
365  DEFUNO("IHS-TOP",object,fSihs_top,SI  DEFUNO("IHS-TOP",object,fSihs_top,SI
# Line 350  object x0; Line 388  object x0;
388          RETURN1(x0);          RETURN1(x0);
389  }  }
390    
391  frame_ptr get_frame_ptr(x)  frame_ptr get_frame_ptr(object x)
 object(x);  
392  {  {
393          frame_ptr p;          frame_ptr p;
394    
# Line 363  object(x); Line 400  object(x);
400                  return(p);                  return(p);
401  ILLEGAL:  ILLEGAL:
402          FEerror("~S is an illegal frs index.", 1, x);          FEerror("~S is an illegal frs index.", 1, x);
403            return NULL;
404  }  }
405    
406  DEFUNO("FRS-TOP",object,fSfrs_top,SI  DEFUNO("FRS-TOP",object,fSfrs_top,SI
# Line 427  object x0; Line 465  object x0;
465          RETURN1(x0);          RETURN1(x0);
466  }  }
467    
468  bds_ptr get_bds_ptr(x)  bds_ptr get_bds_ptr(object x)
 object(x);  
469  {  {
470          bds_ptr p;          bds_ptr p;
471    
# Line 440  object(x); Line 477  object(x);
477                  return(p);                  return(p);
478  ILLEGAL:  ILLEGAL:
479          FEerror("~S is an illegal bds index.", 1, x);          FEerror("~S is an illegal bds index.", 1, x);
480            return NULL;
481  }  }
482    
483  DEFUNO("BDS-TOP",object,fSbds_top,SI  DEFUNO("BDS-TOP",object,fSbds_top,SI
# Line 468  object x0; Line 506  object x0;
506          RETURN1(x0);          RETURN1(x0);
507  }  }
508    
509  object *get_vs_ptr(x)  object *get_vs_ptr(object x)
 object(x);  
510  {  {
511          object *p;          object *p;
512    
# Line 480  object(x); Line 517  object(x);
517                  return(p);                  return(p);
518  ILLEGAL:  ILLEGAL:
519          FEerror("~S is an illegal vs index.", 1, x);          FEerror("~S is an illegal vs index.", 1, x);
520            return NULL;
521  }  }
522    
523  DEFUNO("VS-TOP",object,fSvs_top,SI  DEFUNO("VS-TOP",object,fSvs_top,SI
# Line 557  object x0,x1,x2,x3,error_fmt_string; Line 595  object x0,x1,x2,x3,error_fmt_string;
595          RETURN1(x0);          RETURN1(x0);
596  }  }
597    
598  check_arg_failed(n)  void
599  int n;  check_arg_failed(int n)
600  {  {
601    FEerror("Expected ~S args but received ~S args",2,    FEerror("Expected ~S args but received ~S args",2,
602           make_fixnum(n),make_fixnum(vs_top-vs_base));           make_fixnum(n),make_fixnum(vs_top-vs_base));
603  }  }
604    
605  too_few_arguments()  void
606    too_few_arguments(void)
607  {  {
608          FEtoo_few_arguments(vs_base, vs_top);          FEtoo_few_arguments(vs_base, vs_top);
609  }  }
610    
611  too_many_arguments()  void
612    too_many_arguments(void)
613  {  {
614          FEtoo_many_arguments(vs_base, vs_top);          FEtoo_many_arguments(vs_base, vs_top);
615  }  }
616    
617  ck_larg_at_least(n, x)  void
618  int n; object x;  ck_larg_at_least(int n, object x)
619  {       object endp_temp;  {       object endp_temp;
620          for(; n > 0; n--, x = x->c.c_cdr)          for(; n > 0; n--, x = x->c.c_cdr)
621                  if(endp(x))                  if(endp(x))
622                    FEerror("APPLY sended too few arguments to LAMBDA.", 0);                    FEerror("APPLY sended too few arguments to LAMBDA.", 0);
623  }  }
624    
625  ck_larg_exactly(n, x)  void
626  int n; object x;  ck_larg_exactly(int n, object x)
627  {       object endp_temp;  {       object endp_temp;
628          for(; n > 0; n--, x = x->c.c_cdr)          for(; n > 0; n--, x = x->c.c_cdr)
629                  if(endp(x))                  if(endp(x))
# Line 591  int n; object x; Line 631  int n; object x;
631          if(!endp(x)) FEerror("APPLY sended too many arguments to LAMBDA.", 0);          if(!endp(x)) FEerror("APPLY sended too many arguments to LAMBDA.", 0);
632  }  }
633    
634  invalid_macro_call()  void
635    invalid_macro_call(void)
636  {  {
637          FEinvalid_macro_call();          FEinvalid_macro_call();
638  }  }
639    
640  keyword_value_mismatch()  void
641    keyword_value_mismatch(void)
642  {  {
643          FEerror("Keywords and values do not match.", 0);          FEerror("Keywords and values do not match.", 0);
644  }  }
645    
646  not_a_keyword(x)  void
647  object x;  not_a_keyword(object x)
648  {  {
649          FEerror("~S is not a keyword.", 1, x);          FEerror("~S is not a keyword.", 1, x);
650  }  }
651    
652  unexpected_keyword(key)  void
653  object key;  unexpected_keyword(object key)
654  {  {
655          FEunexpected_keyword(key);          FEunexpected_keyword(key);
656  }  }
657    
658  object  object
659  wrong_type_argument(typ, obj)  wrong_type_argument(object typ, object obj)
 object typ, obj;  
660  {  {
661          FEwrong_type_argument(typ, obj);          FEwrong_type_argument(typ, obj);
662          /*  no return  */          /*  no return  */
663            return(Cnil);
664  }  }
665    
666  illegal_declare(form)  void
667    illegal_declare(object form)
668  {  {
669          FEinvalid_form("~S is an illegal declaration form.", form);          FEinvalid_form("~S is an illegal declaration form.", form);
670  }  }
671    
672  not_a_string(obj)  void
673  object obj;  not_a_string(object obj)
674  { FEwrong_type_argument(sLstring,obj);  { FEwrong_type_argument(sLstring,obj);
675  }  }
676    
677  not_a_string_or_symbol(x)  void
678       object x;  not_a_string_or_symbol(object x)
679  {  {
680    FEerror("~S is not a string or symbol.", 1, x);    FEerror("~S is not a string or symbol.", 1, x);
681  }  }
682    
683  not_a_symbol(obj)  void
684  object obj;  not_a_symbol(object obj)
685  {  {
686          FEinvalid_variable("~S is not a symbol.", obj);          FEinvalid_variable("~S is not a symbol.", obj);
687  }  }
688    
689  not_a_variable(obj)  int
690  object obj;  not_a_variable(object obj)
691  {  {
692          FEinvalid_variable("~S is not a variable.", obj);          FEinvalid_variable("~S is not a variable.", obj);
693            return -1;
694  }  }
695    
696  illegal_index(x, i)  void
697  object x, i;  illegal_index(object x, object i)
698  {  {
699          FEerror("~S is an illegal index to ~S.", 2, i, x);          FEerror("~S is an illegal index to ~S.", 2, i, x);
700  }  }
701    
702  void  void
703  check_socket(x)  check_socket(object x)
 object x;  
704  {  {
705    
706   if (type_of(x) != t_stream || x->sm.sm_mode != smm_socket)   if (type_of(x) != t_stream || x->sm.sm_mode != smm_socket)
# Line 666  object x; Line 709  object x;
709  }  }
710    
711  void  void
712  check_stream(strm)  check_stream(object strm)
 object strm;  
713  {  {
714  if (type_of(strm) != t_stream)  if (type_of(strm) != t_stream)
715                          FEwrong_type_argument(sLstream, strm);                          FEwrong_type_argument(sLstream, strm);
716  }  }
717    
718  object  object
719  LVerror(va_alist)  LVerror(__builtin_va_alist_t __builtin_va_alist)
      va_dcl  
720  {va_list ap;  {va_list ap;
721   va_start(ap);   va_start(ap);
722   fcall.fun= make_cfun(Lerror,Cnil,Cnil,0,0);   fcall.fun= make_cfun(Lerror,Cnil,Cnil,0,0);
# Line 683  LVerror(va_alist) Line 725  LVerror(va_alist)
725   return Cnil;   return Cnil;
726  }  }
727            
728  int  void
729  vfun_wrong_number_of_args(x)  vfun_wrong_number_of_args(object x)
      object x;  
730  {  {
731    
732    FEerror("Expected ~S args but received ~S args",2,    FEerror("Expected ~S args but received ~S args",2,
# Line 693  vfun_wrong_number_of_args(x) Line 734  vfun_wrong_number_of_args(x)
734  }  }
735    
736    
737  check_arg_range(n,m)  void
738       int n,m;  check_arg_range(int n, int m)
739  {  if (VFUN_NARGS < n)  {  if (VFUN_NARGS < n)
740       Icall_error_handler(       Icall_error_handler(
741                           sKtoo_few_arguments,                           sKtoo_few_arguments,
# Line 723  DEF_ORDINARY("PROTECT",sKprotect,KEYWORD Line 764  DEF_ORDINARY("PROTECT",sKprotect,KEYWORD
764  DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,"");  DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,"");
765    
766    
767  init_error()  void
768    init_error(void)
769  {  {
770          make_function("ERROR", Lerror);          make_function("ERROR", Lerror);
771          make_function("CERROR", Lcerror);          make_function("CERROR", Lcerror);
772          make_si_function("IHS-TOP", siLihs_top);          make_si_function("IHS-TOP", siLihs_top);
   
   
   
   
   
   
   
773          null_string = make_simple_string("");          null_string = make_simple_string("");
774          enter_mark_origin(&null_string);          enter_mark_origin(&null_string);
   
   
   
775  }  }

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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