/[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.2 by camm, Fri May 17 04:23:15 2002 UTC revision 1.3 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 1  Line 1 
1  #include "include.h"  #include "include.h"
2  #include "funlink.h"  #include "funlink.h"
3    
4  #define PADDR(i) ((char *)(sSPinit->s.s_dbind->fixa.fixa_self[Mfix(i)]))  #define PADDR(i) ((void *)(sSPinit->s.s_dbind->fixa.fixa_self[Mfix(i)]))
5  /* eg:  /* eg:
6  MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0);  MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0);
7  MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0);  MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0);
8  */  */
9  object MakeAfun(addr,argd,data)  object MakeAfun(object (*addr)(object,object), unsigned int argd, object data)
 object data;  
 int (*addr) ();  
 unsigned int argd;  
10  {int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun);  {int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun);
11    object x = alloc_object(type);    object x = alloc_object(type);
12    x->sfn.sfn_name = Cnil;    x->sfn.sfn_name = Cnil;
# Line 24  unsigned int argd; Line 21  unsigned int argd;
21    
22    
23  object  object
24  fSmakefun(sym,addr,argd)  fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd)
 object sym, (*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 &&
27                         type_of(sSPmemory->s.s_dbind)==t_cfdata) ?                         type_of(sSPmemory->s.s_dbind)==t_cfdata) ?
# Line 36  unsigned int argd; Line 31  unsigned int argd;
31  }  }
32    
33  object  object
34  ImakeClosure(addr,argd,n,va_alist)  ImakeClosure(object (*addr) (/* ??? */), int argd, int n, __builtin_va_alist_t __builtin_va_alist)
      object (*addr)();  
      int n,argd;  
      va_dcl  
35  { object x = fSmakefun(Cnil,addr,argd);  { object x = fSmakefun(Cnil,addr,argd);
36    va_list ap;    va_list ap;
37    va_start(ap);    va_start(ap);
# Line 47  ImakeClosure(addr,argd,n,va_alist) Line 39  ImakeClosure(addr,argd,n,va_alist)
39    va_end(ap);    va_end(ap);
40    return x;    return x;
41  }  }
42        
43  IsetClosure(x,n,ap)  void    
44  object x;  IsetClosure(object x, int n, va_list ap)
 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
47     will be more economical. Because of gc, we can't allocate relblock, it     will be more economical. Because of gc, we can't allocate relblock, it
# Line 97  DEFUN("INITMACRO",object,fSinitmacro,SI, Line 88  DEFUN("INITMACRO",object,fSinitmacro,SI,
88   (va_alist)   (va_alist)
89  va_dcl      va_dcl    
90  {va_list ap;  {va_list ap;
91   object res,name;   object res;
92   va_start(ap);   va_start(ap);
93   res = Iapply_ap(fSinitfun,ap);   res = Iapply_ap(fSinitfun,ap);
94   va_end(ap);   va_end(ap);
# Line 118  object key_struct_ind; Line 109  object key_struct_ind;
109            
110    
111  void  void
112  SI_makefun(strg,fn,argd)  SI_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd)
      char *strg;  
      unsigned int argd;  
      object (*fn)();  
113  { object sym = make_si_ordinary(strg);  { object sym = make_si_ordinary(strg);
114   fSfset(sym, fSmakefun(sym,fn,argd));   fSfset(sym, fSmakefun(sym,fn,argd));
115  }  }
116    
117  void  void
118  LISP_makefun(strg,fn,argd)  LISP_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd)
      char *strg;  
      unsigned int argd;  
      object (*fn)();  
119  { object sym = make_ordinary(strg);  { object sym = make_ordinary(strg);
120   fSfset(sym, fSmakefun(sym,fn,argd));   fSfset(sym, fSmakefun(sym,fn,argd));
121  }  }
122    
123    
124  object  object
125  MakeClosure(n,argd,data,fn,va_alist)  MakeClosure(int n, int argd, object data, object (*fn)(), __builtin_va_alist_t __builtin_va_alist)
 int n;  
 int (*fn)();  
 object data;  
 va_dcl  
126  { object x;  { object x;
127    va_list ap;    va_list ap;
128    x = alloc_object(t_closure);    x = alloc_object(t_closure);

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