/[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.4 by camm, Sat Jul 20 14:38:21 2002 UTC revision 1.5 by camm, Sun Feb 9 22:35:18 2003 UTC
# Line 31  fSmakefun(object sym, object (*addr) (/* Line 31  fSmakefun(object sym, object (*addr) (/*
31  }  }
32    
33  object  object
34  ImakeClosure(addr,argd,n,va_alist)  ImakeClosure(object (*addr)(),int argd,int n,...)
      object (*addr)();  
      int argd;  
      int n;  
      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,n);
38    IsetClosure(x,n,ap);    IsetClosure(x,n,ap);
39    va_end(ap);    va_end(ap);
40    return x;    return x;
# Line 64  IsetClosure(object x, int n, va_list ap) Line 60  IsetClosure(object x, int n, va_list ap)
60      }      }
61  }  }
62    
63  DEFUN("INITFUN",object,fSinitfun,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO,  DEFUN_NEW("INITFUN",object,fSinitfun,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO,
64          (object sym,object addr_ind,object argd,...),
65        "Store a compiled function on SYMBOL whose body is in the VV array at \        "Store a compiled function on SYMBOL whose body is in the VV array at \
66  INDEX, and whose argd descriptor is ARGD.  If more arguments IND1, IND2,.. \  INDEX, and whose argd descriptor is ARGD.  If more arguments IND1, IND2,.. \
67  are supplied these are indices in the VV array for the environment of this \  are supplied these are indices in the VV array for the environment of this \
68  closure.")  closure.")
      (sym,addr_ind,argd,va_alist)  
 object sym,addr_ind,argd; va_dcl  
69  { int nargs = F_NARGS(VFUN_NARGS) -3;  { int nargs = F_NARGS(VFUN_NARGS) -3;
70    va_list ap;    va_list ap;
71    object fun = fSmakefun(IisSymbol(sym),PADDR(addr_ind),Mfix(argd));    object fun = fSmakefun(IisSymbol(sym),PADDR(addr_ind),Mfix(argd));
72    if (nargs > 0)    if (nargs > 0)
73      { va_start(ap);      { va_start(ap,argd);
74        IsetClosure(fun,nargs,ap);        IsetClosure(fun,nargs,ap);
75        while (--nargs >= 0)        while (--nargs >= 0)
76          /* the things put in by IsetClosure were only the indices          /* the things put in by IsetClosure were only the indices
# Line 87  object sym,addr_ind,argd; va_dcl Line 82  object sym,addr_ind,argd; va_dcl
82    return sym;    return sym;
83  }  }
84    
85  DEFUN("INITMACRO",object,fSinitmacro,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO,  DEFUN_NEW("INITMACRO",object,fSinitmacro,SI,4,ARG_LIMIT,NONE,OO,OO,OO,OO,(object first,...),
86        "Like INITFUN, but makes then sets the 'macro' flag on this symbol")        "Like INITFUN, but makes then sets the 'macro' flag on this symbol")
  (va_alist)  
 va_dcl      
87  {va_list ap;  {va_list ap;
88   object res;   object res;
89   va_start(ap);   va_start(ap,first);
90   res = Iapply_ap(fSinitfun,ap);   res = Iapply_ap_new((object (*)())fSinitfun,first,ap);
91   va_end(ap);   va_end(ap);
92   res->s.s_mflag = 1;   res->s.s_mflag = 1;
93   return res;   return res;
94  }  }
95    
96  DEFUN("SET-KEY-STRUCT",object,fSset_key_struct,SI,1,1,NONE,OO,OO,OO,OO,  DEFUN_NEW("SET-KEY-STRUCT",object,fSset_key_struct,SI,1,1,NONE,OO,OO,OO,OO,(object key_struct_ind),
97        "Called inside the loader.  The keystruct is set up in the file with \        "Called inside the loader.  The keystruct is set up in the file with \
98     indexes rather than the actual entries.  We change these indices to \     indexes rather than the actual entries.  We change these indices to \
99     the objects")     the objects")
      (key_struct_ind)  
 object key_struct_ind;  
   
100  { set_key_struct(PADDR(key_struct_ind),sSPmemory->s.s_dbind);  { set_key_struct(PADDR(key_struct_ind),sSPmemory->s.s_dbind);
101    return Cnil;    return Cnil;
102  }  }
# Line 126  LISP_makefun(char *strg, object (*fn) (/ Line 116  LISP_makefun(char *strg, object (*fn) (/
116    
117    
118  object  object
119  MakeClosure(n,argd,data,fn,va_alist)  MakeClosure(int n,int argd,object data,object (*fn)(),...)
      int n;  
      int argd;  
      object data;  
      object (*fn)();  
      va_dcl  
120  { object x;  { object x;
121    va_list ap;    va_list ap;
122    x = alloc_object(t_closure);    x = alloc_object(t_closure);
# Line 142  MakeClosure(n,argd,data,fn,va_alist) Line 127  MakeClosure(n,argd,data,fn,va_alist)
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);    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);}
# Line 151  MakeClosure(n,argd,data,fn,va_alist) Line 136  MakeClosure(n,argd,data,fn,va_alist)
136    return x;    return x;
137  }  }
138                
139  DEFUN("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,  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")
  (x)  
 object x;  
141  { int (*fn)();  { int (*fn)();
142    fn = (void *) PADDR(x);    fn = (void *) PADDR(x);
143    (*fn)();    (*fn)();

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