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

Diff of /gcl/o/eval.c

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

revision 1.5 by camm, Sat Jul 20 14:38:21 2002 UTC revision 1.6 by camm, Thu Aug 1 22:15:06 2002 UTC
# Line 52  object sSAbreak_pointsA; Line 52  object sSAbreak_pointsA;
52  object sSAbreak_stepA;  object sSAbreak_stepA;
53    
54    
55    /* This is a temporary workaround.  m68k cannot find the result
56       of a function returning long when invoked via a function pointer
57       declared as a function returning a pointer, in this case, an
58       object.  A proper fix will require rewriting sections of the lisp
59       compiler to separate the calling procedures for functions returning
60       an object from functions returning a long.  CM  20020801 */
61    #if defined(__mc68020__)
62    #define LCAST(a) (object)(*(long(*)())a)
63    #else
64    #define LCAST(a) (*a)
65    #endif
66    
67  #define SET_TO_APPLY(res,f,n,x) \  #define SET_TO_APPLY(res,f,n,x) \
68   switch(n) {\   switch(n) {\
69   case 0:   res=(*f)(); break;\   case 0:   res=LCAST(f)(); break;\
70    case 1:  res=(*f)(x[0]); break; \    case 1:  res=LCAST(f)(x[0]); break; \
71    case 2:  res=(*f)(x[0],x[1]);break; \    case 2:  res=LCAST(f)(x[0],x[1]);break; \
72    case 3:  res=(*f)(x[0],x[1],x[2]);break; \    case 3:  res=LCAST(f)(x[0],x[1],x[2]);break; \
73    case 4:  res=(*f)(x[0],x[1],x[2],x[3]);break; \    case 4:  res=LCAST(f)(x[0],x[1],x[2],x[3]);break; \
74    case 5:  res=(*f)(x[0],x[1],x[2],x[3],x[4]);break; \    case 5:  res=LCAST(f)(x[0],x[1],x[2],x[3],x[4]);break; \
75    case 6:  res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5]);  break;\    case 6:  res=LCAST(f)(x[0],x[1],x[2],x[3],x[4],x[5]);  break;\
76    case 7:  res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6]); break;\    case 7:  res=LCAST(f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6]); break;\
77    case 8:  res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6],x[7]); break;\    case 8:  res=LCAST(f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6],x[7]); break;\
78    case 9:  res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]);break;\    case 9:  res=LCAST(f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]);break;\
79    case 10: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]);break;\    case 10: res=LCAST(f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]);break;\
80     default: res=c_apply_n(*f,n,x); break;}     default: res=c_apply_n(*f,n,x); break;}
81    
82  /*  /*
# Line 98  quick_call_sfun(object fun) Line 110  quick_call_sfun(object fun)
110       for (j=0; j<n ; j++)       for (j=0; j<n ; j++)
111         {enum ftype typ=SFUN_NEXT_TYPE(i);         {enum ftype typ=SFUN_NEXT_TYPE(i);
112          x[j]=COERCE_ARG(vs_base[j],typ);}}          x[j]=COERCE_ARG(vs_base[j],typ);}}
113    SET_TO_APPLY(res,(object (*)())fun->sfn.sfn_self,n,x);    SET_TO_APPLY(res,fun->sfn.sfn_self,n,x);
114    base[0]=    base[0]=
115      (restype==f_object ?  res :      (restype==f_object ?  res :
116       restype==f_fixnum ? make_fixnum((long)res)       restype==f_fixnum ? make_fixnum((long)res)
# Line 115  call_sfun_no_check(object fun) Line 127  call_sfun_no_check(object fun)
127    int n;    int n;
128    object *base=vs_base;    object *base=vs_base;
129    n=vs_top - base;    n=vs_top - base;
130    SET_TO_APPLY(base[0],(object (*)())fun->sfn.sfn_self,n,base);    SET_TO_APPLY(base[0],fun->sfn.sfn_self,n,base);
131    vs_top=(vs_base=base)+1;    vs_top=(vs_base=base)+1;
132    CHECK_AVMA;    CHECK_AVMA;
133    return;    return;
# Line 131  call_vfun(object fun) Line 143  call_vfun(object fun)
143    if (n > fun->vfn.vfn_maxargs)    if (n > fun->vfn.vfn_maxargs)
144      {FEtoo_many_arguments(base,vs_top); return;}      {FEtoo_many_arguments(base,vs_top); return;}
145    VFUN_NARGS = n;    VFUN_NARGS = n;
146    SET_TO_APPLY(base[0],(object (*)())fun->sfn.sfn_self,n,base);    SET_TO_APPLY(base[0],fun->sfn.sfn_self,n,base);
147    vs_top=(vs_base=base)+1;    vs_top=(vs_base=base)+1;
148    CHECK_AVMA;    CHECK_AVMA;
149    return;    return;

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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