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

Diff of /gcl/o/cmpaux.c

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

revision 1.20 by camm, Fri Oct 10 02:39:17 2003 UTC revision 1.21 by camm, Mon Oct 13 15:10:28 2003 UTC
# Line 31  Foundation, 675 Mass Ave, Cambridge, MA Line 31  Foundation, 675 Mass Ave, Cambridge, MA
31  #include "include.h"  #include "include.h"
32  #define dcheck_type(a,b) check_type(a,b)  #define dcheck_type(a,b) check_type(a,b)
33    
 #if 0  
 #define CMPAUX_DEBUG  
 #endif  
   
34  DEFUNO_NEW("SPECIALP",object,fSspecialp,SI  DEFUNO_NEW("SPECIALP",object,fSspecialp,SI
35         ,1,1,NONE,OO,OO,OO,OO,void,siLspecialp,(object sym),"")         ,1,1,NONE,OO,OO,OO,OO,void,siLspecialp,(object sym),"")
36  {  {
# Line 102  gcl_init_cmpaux(void) Line 98  gcl_init_cmpaux(void)
98  }  }
99    
100        
101  int  /* Now inlined directly by optimizer  */
102  ifloor(int x, int y)  /* int */
103  {  /* ifloor(int x, int y) */
104    if (y == 0) {  /* { */
105      FEerror("Zero divizor", 0);  /*   if (y == 0) { */
106      return 0;  /*     FEerror("Zero divizor", 0); */
107    }  /*     return 0; */
108    if (y > 0) {  /*   } */
109      if (x >= 0)  /*   if (y > 0) { */
110        return(x/y);  /*     if (x >= 0) */
111      else  /*       return(x/y); */
112    /*     else */
113        /* FIXME, deal with possible overflow here*/        /* FIXME, deal with possible overflow here*/
114        return(-((-x-1))/y-1);  /*       return(-((-x-1))/y-1); */
115    }  /*   } */
116    if (x >= 0)  /*   if (x >= 0) */
117        /* FIXME, deal with possible overflow here*/        /* FIXME, deal with possible overflow here*/
118      return(-((x-1)/(-y))-1);  /*     return(-((x-1)/(-y))-1); */
119    else  /*   else */
120      return((-x)/(-y));  /*     return((-x)/(-y)); */
121  }  /* } */
122    
123  int  /* int */
124  imod(int x, int y)  /* imod(int x, int y) */
125  {  /* { */
126    return(x - ifloor(x, y)*y);  /*   return(x - ifloor(x, y)*y); */
127  }  /* } */
128    
129  /* static void */  /* static void */
130  /* set_VV(object *, int, object); */  /* set_VV(object *, int, object); */
# Line 296  object_to_string(object x) Line 293  object_to_string(object x)
293  /* #endif */  /* #endif */
294    
295  void  void
296  call_init ( int init_address, object memory, object fasl_vec, FUNC fptr )  call_init(int init_address, object memory, object fasl_vec, FUNC fptr)
297  {  {object form;
298      object form;   FUNC at;
299      FUNC at;  /* #ifdef CLEAR_CACHE */
300    /*  static int n; */
301    /*  static sigset_t ss; */
302    
303      check_type ( fasl_vec, t_vector );  /*  if (!n) { */
304      form = ( fasl_vec->v.v_self [ fasl_vec->v.v_fillp - 1 ] );  /*      struct sigaction sa={{(void *)sigh},{{0}},SA_RESTART|SA_SIGINFO,NULL}; */
305    
306      if (fptr) {  /*      sigaction(SIGILL,&sa,NULL); */
307          at = fptr;  /*      sigemptyset(&ss); */
308      } else {  /*      sigaddset(&ss,SIGILL); */
309          at = (FUNC) ( memory->cfd.cfd_start + init_address );  /*      sigprocmask(SIG_BLOCK,&ss,NULL); */
310      }  /*      n=1; */
311    /*  } */
312    /* #endif */
313    
314    
315      check_type(fasl_vec,t_vector);
316      form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]);
317    
318     if (fptr) at = fptr;
319      else
320     at=(FUNC)(memory->cfd.cfd_start+ init_address );
321    
322  #ifdef VERIFY_INIT  #ifdef VERIFY_INIT
323      VERIFY_INIT;   VERIFY_INIT
324  #endif  #endif
325        
326      if ( type_of ( form ) == t_cons &&   if (type_of(form)==t_cons &&
327           form->c.c_car == sSPinit ) {       form->c.c_car == sSPinit)
328          bds_bind(sSPinit,fasl_vec);     {bds_bind(sSPinit,fasl_vec);
329          bds_bind(sSPmemory,memory);      bds_bind(sSPmemory,memory);
330          (*at)();  /* #ifdef CLEAR_CACHE */
331          bds_unwind1;  /*     sigprocmask(SIG_UNBLOCK,&ss,NULL); */
332          bds_unwind1;  /* #endif */
333      } else {      (*at)();
334          /* old style three arg init, with all init being done by C code. */  /* #ifdef CLEAR_CACHE */
335          memory->cfd.cfd_self = fasl_vec->v.v_self;  /*     sigprocmask(SIG_BLOCK,&ss,NULL); */
336          memory->cfd.cfd_fillp = fasl_vec->v.v_fillp;  /* #endif */
337          (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory);      bds_unwind1;
338      }      bds_unwind1;
339  }    }
340     else
341       /* old style three arg init, with all init being done by C code. */
342       {memory->cfd.cfd_self = fasl_vec->v.v_self;
343        memory->cfd.cfd_fillp = fasl_vec->v.v_fillp;
344    /* #ifdef CLEAR_CACHE */
345    /*     sigprocmask(SIG_UNBLOCK,&ss,NULL); */
346    /* #endif */
347        (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory);
348    /* #ifdef CLEAR_CACHE */
349    /*     sigprocmask(SIG_BLOCK,&ss,NULL); */
350    /* #endif */
351    }}
352    
353  /* statVV is the address of some static storage, which is used by the  /* statVV is the address of some static storage, which is used by the
354     cfunctions to refer to global variables,..     cfunctions to refer to global variables,..
# Line 348  do_init(object *statVV) Line 369  do_init(object *statVV)
369    int n=fasl_vec->v.v_fillp -1;    int n=fasl_vec->v.v_fillp -1;
370    int i;    int i;
371    object form;    object form;
 #ifdef CMPAUX_DEBUG  
          fprintf ( stderr,  
                    "do_init: START\n" );  
          fflush ( stderr );  
 #endif /* CMPAUX_DEBUG */          
372    check_type(fasl_vec,t_vector);    check_type(fasl_vec,t_vector);
373    form = fasl_vec->v.v_self[n];    form = fasl_vec->v.v_self[n];
374    dcheck_type(form,t_cons);      dcheck_type(form,t_cons);  
# Line 389  do_init(object *statVV) Line 405  do_init(object *statVV)
405    {object *top=vs_top;    {object *top=vs_top;
406        
407     for(i=0 ; i< form->v.v_fillp; i++)     for(i=0 ; i< form->v.v_fillp; i++)
408       {       {
409  #ifdef CMPAUX_DEBUG         eval(form->v.v_self[i]);
          fprintf ( stderr,  
                    "do_init: second for loop - i = %d, form->v.v_fillp = %d, form->v.v_self[%d] = %x....",  
                    i, form->v.v_fillp, i, form->v.v_self[i] );  
          fflush ( stderr );  
 #endif /* CMPAUX_DEBUG */          
         eval(form->v.v_self[i]);  
 #ifdef CMPAUX_DEBUG  
          fprintf ( stderr,  
                    "  eval succeeded\n" );  
          fflush ( stderr );  
 #endif /* CMPAUX_DEBUG */          
410         vs_top=top;         vs_top=top;
411       }       }
412   }   }

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

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