/[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.4 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.5 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 90  object index,val; Line 90  object index,val;
90  DEF_ORDINARY("%MEMORY",sSPmemory,SI,"");  DEF_ORDINARY("%MEMORY",sSPmemory,SI,"");
91  DEF_ORDINARY("%INIT",sSPinit,SI,"");  DEF_ORDINARY("%INIT",sSPinit,SI,"");
92    
93  void Lidentity();  void Lidentity(void);
94  init_cmpaux()  void
95    init_cmpaux(void)
96  {  {
97    
98    
# Line 102  init_cmpaux() Line 103  init_cmpaux()
103    
104        
105  int  int
106  ifloor(x, y)  ifloor(int x, int y)
 int x, y;  
107  {  {
108          if (y == 0)    if (y == 0) {
109                  FEerror("Zero divizor", 0);      FEerror("Zero divizor", 0);
110          else if (y > 0)      return 0;
111                  if (x >= 0)    }
112                          return(x/y);    if (y > 0) {
113                  else      if (x >= 0)
114                          return(-((-x+y-1))/y);        return(x/y);
115          else      else
116                  if (x >= 0)        return(-((-x+y-1))/y);
117                          return(-((x-y-1)/(-y)));    }
118                  else    if (x >= 0)
119                          return((-x)/(-y));      return(-((x-y-1)/(-y)));
120      else
121        return((-x)/(-y));
122  }  }
123    
124  int  int
125  imod(x, y)  imod(int x, int y)
 int x, y;  
126  {  {
127          return(x - ifloor(x, y)*y);    return(x - ifloor(x, y)*y);
128  }  }
129    
130  set_VV_data(VV,n,data,start,size)  void
131  object VV[],data;  set_VV_data(object *VV, int n, object data, char *start, int size)
 int size,n;  
 char *start;  
132  {set_VV(VV,n,data);  {set_VV(VV,n,data);
133   data->cfd.cfd_start=start;   data->cfd.cfd_start=start;
134   data->cfd.cfd_size = size;   data->cfd.cfd_size = size;
135  }  }
136    
137  set_VV(VV, n, data)  void
138  object VV[];  set_VV(object *VV, int n, object data)
 int n;  
 object data;  
139  {  {
140          object *p, *q;          object *p, *q;
141    
# Line 154  object data; Line 151  object data;
151  */  */
152    
153  char  char
154  object_to_char(x)  object_to_char(object x)
 object x;  
155  {  {
156          int c;          int c=0;
157    
158          switch (type_of(x)) {          switch (type_of(x)) {
159          case t_fixnum:          case t_fixnum:
# Line 181  object x; Line 177  object x;
177  }  }
178    
179  int  int
180  object_to_int(x)  object_to_int(object x)
 object x;  
181  {  {
182          int i;          int i=0;
183    
184          switch (type_of(x)) {          switch (type_of(x)) {
185          case t_character:          case t_character:
# Line 207  object x; Line 202  object x;
202  }  }
203    
204  float  float
205  object_to_float(x)  object_to_float(object x)
 object x;  
206  {  {
207          float f;          float f=0.0;
208    
209          switch (type_of(x)) {          switch (type_of(x)) {
210          case t_character:          case t_character:
# Line 231  object x; Line 225  object x;
225  }  }
226    
227  double  double
228  object_to_double(x)  object_to_double(object x)
 object x;  
229  {  {
230          double d;          double d=0.0;
231    
232          switch (type_of(x)) {          switch (type_of(x)) {
233          case t_character:          case t_character:
# Line 259  object x; Line 252  object x;
252     have a null character in the fillpointer position. */     have a null character in the fillpointer position. */
253    
254  char *  char *
255  object_to_string(x)  object_to_string(object x)
      object x;  
256  { unsigned int leng;  { unsigned int leng;
257    if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);    if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);
258    leng= x->st.st_fillp;    leng= x->st.st_fillp;
# Line 281  object_to_string(x) Line 273  object_to_string(x)
273     }}     }}
274    
275    
276  typedef int (*FUNC)();  /*  typedef int (*FUNC)(); */
277    
278  /* perform the actual invocation of the init function durint a fasload  /* perform the actual invocation of the init function durint a fasload
279     init_address is the offset from the place in memory where the code is loaded     init_address is the offset from the place in memory where the code is loaded
# Line 290  typedef int (*FUNC)(); Line 282  typedef int (*FUNC)();
282     where f1 f2 are forms to be evaled.     where f1 f2 are forms to be evaled.
283  */  */
284    
285  call_init(init_address,memory,fasl_vec,fptr)  void
286       int init_address;  call_init(int init_address, object memory, object fasl_vec, FUNC fptr)
      object memory,fasl_vec;  
      FUNC fptr;  
         
287  {object form;  {object form;
288   FUNC at;   FUNC at;
289    
# Line 335  call_init(init_address,memory,fasl_vec,f Line 324  call_init(init_address,memory,fasl_vec,f
324    
325     */     */
326    
327  do_init(statVV)  void
328       object *statVV;  do_init(object *statVV)
       
   
329  {object fasl_vec=sSPinit->s.s_dbind;  {object fasl_vec=sSPinit->s.s_dbind;
330   object data = sSPmemory->s.s_dbind;   object data = sSPmemory->s.s_dbind;
331   {object *p,*q,x,y;   {object *p,*q,y;
332    int n=fasl_vec->v.v_fillp -1;    int n=fasl_vec->v.v_fillp -1;
333    int i;    int i;
334    object form;    object form;
# Line 412  char *s; Line 399  char *s;
399  #endif  #endif
400    
401  void  void
402  init_or_load1(fn,file)  init_or_load1(int (*fn) (/* ??? */), char *file)
      int (*fn)();  
      char *file;  
403  {int n=strlen(file);  {int n=strlen(file);
404   if (file[n-1]=='o')   if (file[n-1]=='o')
405     { object memory;     { object memory;

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

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