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

Diff of /gcl/o/makefun.c

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

revision 1.5 by camm, Sun Feb 9 22:35:18 2003 UTC revision 1.6 by camm, Sat Feb 15 00:38:28 2003 UTC
# Line 20  object MakeAfun(object (*addr)(object,ob Line 20  object MakeAfun(object (*addr)(object,ob
20  }  }
21    
22    
23  object  static object
24  fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd)  fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd)
25  {object ans = MakeAfun(addr,argd,  {object ans = MakeAfun(addr,argd,
26                        (sSPmemory && sSPmemory->s.s_dbind &&                        (sSPmemory && sSPmemory->s.s_dbind &&
# Line 30  fSmakefun(object sym, object (*addr) (/* Line 30  fSmakefun(object sym, object (*addr) (/*
30   return ans;   return ans;
31  }  }
32    
33  object  /* static object */
34  ImakeClosure(object (*addr)(),int argd,int n,...)  /* ImakeClosure(object (*addr)(),int argd,int n,...) */
35  { object x = fSmakefun(Cnil,addr,argd);  /* { object x = fSmakefun(Cnil,addr,argd); */
36    va_list ap;  /*   va_list ap; */
37    va_start(ap,n);  /*   va_start(ap,n); */
38    IsetClosure(x,n,ap);  /*   IsetClosure(x,n,ap); */
39    va_end(ap);  /*   va_end(ap); */
40    return x;  /*   return x; */
41  }  /* } */
42    
43  void      static void    
44  IsetClosure(object x, int n, va_list ap)  IsetClosure(object x, int n, va_list ap)
45  {  /* this will change so that we can allocate 'hunks' which will be little  {  /* this will change so that we can allocate 'hunks' which will be little
46     blocks the size of an array header say with only one header word.   This     blocks the size of an array header say with only one header word.   This
# Line 115  LISP_makefun(char *strg, object (*fn) (/ Line 115  LISP_makefun(char *strg, object (*fn) (/
115  }  }
116    
117    
118  object  /* static object  */
119  MakeClosure(int n,int argd,object data,object (*fn)(),...)  /* MakeClosure(int n,int argd,object data,object (*fn)(),...) */
120  { object x;  /* { object x; */
121    va_list ap;  /*   va_list ap; */
122    x = alloc_object(t_closure);  /*   x = alloc_object(t_closure); */
123    x->cl.cl_name = Cnil;  /*   x->cl.cl_name = Cnil; */
124    x->cl.cl_self = fn;  /*   x->cl.cl_self = fn; */
125    x->cl.cl_data = data;  /*   x->cl.cl_data = data; */
126    x->cl.cl_argd = argd;  /*   x->cl.cl_argd = argd; */
127    x->cl.cl_env = 0;  /*   x->cl.cl_env = 0; */
128    x->cl.cl_env = (object *)alloc_contblock(n*sizeof(object));  /*   x->cl.cl_env = (object *)alloc_contblock(n*sizeof(object)); */
129    x->cl.cl_envdim=n;  /*   x->cl.cl_envdim=n; */
130    va_start(ap,fn);  /*   va_start(ap,fn); */
131    { object *p = x->cl.cl_env;  /*   { object *p = x->cl.cl_env; */
132    while (--n>= 0)  /*   while (--n>= 0) */
133      { *p++ = va_arg(ap,object);}  /*     { *p++ = va_arg(ap,object);} */
134    va_end(ap);  /*   va_end(ap); */
135    }  /*   } */
136    return x;  /*   return x; */
137  }  /* } */
138                
139  DEFUN_NEW("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,(object x),  DEFUN_NEW("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,(object x),
140        "Invoke a C function whose body is at INDEX in the VV array")        "Invoke a C function whose body is at INDEX in the VV array")

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