ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/V/c/cfun.c

This is cfun.c in view mode; [Download] [Up]

Changes file for /usr/local/src/kcl/./c/cfun.c
Created on Mon Mar 25 12:25:00 1991
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files.  Anything not between
"\n@s[" and  "\n@s]" is a simply a comment.
This file was constructed using emacs and  merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
   by (Bill Schelter)  wfs@carl.ma.utexas.edu 


****Change:(orig (12 12 a))
@s[*/

#include "include.h"


@s|*/

#include "include.h"


#define dcheck_vs do{if (vs_base < vs_org || vs_top < vs_org) error("bad vs");} while (0)
#define dcheck_type(a,b) check_type(a,b) ; dcheck_vs 

#define PADDR(i) ((char *)(siSPinit->s.s_dbind->fixa.fixa_self[fix(i)]))
object siSPinit,siSPmemory;


@s]


****Change:(orig (26 27 c))
@s[	cf->cf.cf_start = start;
	cf->cf.cf_size = size;

@s|	if(data && type_of(data)==t_cfdata)
	  { data->cfd.cfd_start=start; 
	    data->cfd.cfd_size=size;}
	  else if(size) FEerror(0,"Bad call to make_cfun");

@s]


****Change:(orig (29 29 a))
@s[	return(cf);
}

@s|	return(cf);
}
object
make_sfun(name,self,argd, data)
int argd,(*self)();
object name, data;
{object sfn;
       
	sfn = alloc_object(t_sfun);
        if(argd >15) sfn->d.t = (int)t_gfun;
	sfn->sfn.sfn_self = self;
	sfn->sfn.sfn_name = name;
	sfn->sfn.sfn_data = data;
        sfn->sfn.sfn_argd = argd;
	return(sfn);
}

@s]


****Change:(orig (30 30 a))
@s[

@s|
#define VFUN_MIN_ARGS(argd) (argd & 0xff)
#define VFUN_MAX_ARGS(argd) ((argd) >> 8)


@s]


****Change:(orig (32 32 c))
@s[make_cclosure(self, name, env, data, start, size)

@s|make_vfun(name,self,argd, data)
int (*self)(),argd;
object name, data;
{object vfn;
       
	vfn = alloc_object(t_vfun);
	vfn->vfn.vfn_self = self;
	vfn->vfn.vfn_name = name;
	vfn->vfn.vfn_minargs = VFUN_MIN_ARGS(argd);
        vfn->vfn.vfn_maxargs = VFUN_MAX_ARGS(argd);
        vfn->vfn.vfn_data = data;
	return(vfn);
}

object
make_cclosure_new(self, name, env, data)

@s]


****Change:(orig (35 36 d))
@s[object name, env, data;
char *start;
int size;

@s|object name, env, data;

@s]


****Change:(orig (45 46 d))
@s[	cc->cc.cc_start = start;
	cc->cc.cc_size = size;

@s|
@s]


****Change:(orig (50 50 a))
@s[	cc->cc.cc_turbo = NULL;
	return(cc);
}


@s|	cc->cc.cc_turbo = NULL;
	return(cc);
}



@s]


****Change:(orig (52 53 c))
@s[MF(sym, self, start, size, data)
object sym;

@s|make_cclosure(self, name, env, data, start, size)

@s]


****Change:(orig (54 54 a))
@s[int (*self)();

@s|int (*self)();
object name, env, data;

@s]


****Change:(orig (57 57 d))
@s[char *start;
int size;
object data;

@s|char *start;
int size;

@s]


****Change:(orig (58 58 a))
@s[{

@s|{
	if(data && type_of(data)==t_cfdata)
	  { data->cfd.cfd_start=start; 
	    data->cfd.cfd_size=size;}
	  else if(size) FEerror("Bad call to make_cclosure",0);
	return make_cclosure_new(self,name,env,data);

}


siLmc() /* args: (name,address) */
{ dcheck_type(vs_base[0],t_symbol);
  dcheck_type(vs_base[1],t_fixnum);
  dcheck_type(siSPmemory->s.s_dbind,t_cfdata);
  vs_base[0]=make_cclosure_new(PADDR(vs_base[1]),vs_base[0],Cnil,
		     siSPmemory->s.s_dbind);}

object MFsfun(sym,self,argd,data)
     object sym,data;
     int argd,(*self)();
{object sfn;
 if (type_of(sym)!=t_symbol) not_a_symbol(sym);
 if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag)
   sym->s.s_sfdef = NOT_SPECIAL;
 sfn = make_sfun(sym,self,argd,data);
 sym = clear_compiler_properties(sym,sfn);
 sym->s.s_gfdef = sfn;
 sym->s.s_mflag = FALSE;
}

siLmfsfun() /* args: (name,address,argd) */
{  dcheck_type(vs_base[1],t_fixnum);
  MFsfun(vs_base[0],PADDR(vs_base[1]),fix(vs_base[2]),siSPmemory->s.s_dbind);}


object MFvfun(sym,self,argd,data)
     object sym,data;
     int argd,(*self)();
{object vfn;
 if (type_of(sym)!=t_symbol) not_a_symbol(sym);
 if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag)
   sym->s.s_sfdef = NOT_SPECIAL;
 dcheck_type(data,t_cfdata);
 vfn = make_vfun(sym,self,argd,data);
 sym = clear_compiler_properties(sym,vfn);
 sym->s.s_gfdef = vfn;
 sym->s.s_mflag = FALSE;
}

siLmfvfun()
{MFvfun(vs_base[0],PADDR(vs_base[1]),fix(vs_base[2]),siSPmemory->s.s_dbind);}



object MFvfun_key(sym,self,argd,data,keys)
     object sym,data;
     int argd,(*self)();
     char *keys;
{if (data) set_key_struct(keys,data);
 return MFvfun(sym,self,argd,data);
}

siLmfvfun_key() 
{MFvfun_key(vs_base[0],PADDR(vs_base[1]),fix(vs_base[2]),siSPmemory->s.s_dbind,PADDR(vs_base[3]));}


object MFnew(sym,self,data)
     object sym,data;
 int (*self)();
{

@s]


****Change:(orig (65 65 d))
@s[	clear_compiler_properties(sym);

@s|
@s]


****Change:(orig (70 72 c))
@s[	cf->cf.cf_start = start;
	cf->cf.cf_size = size;
	sym->s.s_gfdef = cf;

@s|	sym = clear_compiler_properties(sym,cf);
 	sym->s.s_gfdef = cf;

@s]


****Change:(orig (75 75 a))
@s[	sym->s.s_mflag = FALSE;
}


@s|	sym->s.s_mflag = FALSE;
}

siLmf()
{MFnew(vs_base[0],PADDR(vs_base[1]),siSPmemory->s.s_dbind);}



@s]


****Change:(orig (76 76 a))
@s[object

@s|object
MF(sym, self, start, size, data)
object sym;
int (*self)();
char *start;
int size;
object data;
{ if(data && type_of(data)==t_cfdata)
	  { data->cfd.cfd_start=start; 
	    data->cfd.cfd_size=size;}
	  else if(size) FEerror(0,"Bad call to make_cfun");
  return(MFnew(sym,self,data));
}

object

@s]


****Change:(orig (90 90 d))
@s[	clear_compiler_properties(sym);

@s|
@s]


****Change:(orig (95 96 c))
@s[	cf->cf.cf_start = start;
	cf->cf.cf_size = size;

@s|	data->cfd.cfd_start=start; 
	data->cfd.cfd_size=size;
	sym = 	clear_compiler_properties(sym,cf);

@s]


****Change:(orig (100 100 a))
@s[	sym->s.s_mflag = TRUE;
}


@s|	sym->s.s_mflag = TRUE;
}

siLmm()
{MM(vs_base[0],PADDR(vs_base[1]),
    /* bit wasteful to pass these in just to be reset to themselves..*/
    siSPmemory->s.s_dbind->cfd.cfd_start,
    siSPmemory->s.s_dbind->cfd.cfd_size,
    siSPmemory->s.s_dbind
    );}

  


@s]


****Change:(orig (117 117 a))
@s[	vs_reset;
	return(x);
}

object

@s|	vs_reset;
	return(x);
}

object
make_si_sfun(s, f,argd)
char *s;
int (*f)();
int argd;
{  object x= make_si_ordinary(s);
   x->s.s_gfdef = make_sfun( x,f,argd, Cnil);
   x->s.s_mflag = FALSE;
   return(x);
}

object
make_si_vfun1(s, f,argd)
char *s;
int (*f)();
int argd;
{  object x= make_si_ordinary(s);
   x->s.s_gfdef = make_vfun( x,f,argd, Cnil);
   x->s.s_mflag = FALSE;
   return(x);
}


object

@s]


****Change:(orig (132 132 a))
@s[	vs_reset;
	return(x);
}


@s|	vs_reset;
	return(x);
}





@s]


****Change:(orig (146 146 a))
@s[siLcompiled_function_name()
{
	check_arg(1);

@s|siLcompiled_function_name()
{
	check_arg(1);
	switch(type_of(vs_base[0])) {
	case t_cfun:
	case t_sfun:
	case t_vfun:
	case t_cclosure:
	case t_gfun:
	  vs_base[0] = vs_base[0]->cf.cf_name;
	  break;
	default:
	  FEerror("~S is not a compiled-function.", 1, vs_base[0]);
}}

@s]


****Change:(orig (148 155 d))
@s[	if (type_of(vs_base[0]) == t_cfun)
		vs_base[0] = vs_base[0]->cf.cf_name;
	else if (type_of(vs_base[0]) == t_cclosure)
		vs_base[0] = vs_base[0]->cc.cc_name;

@s,		FEerror("~S is not a compiled-function.", 1, vs_base[0]);
}


@s|
@s]


****Change:(orig (164 164 c))
@s[	fun->cc.cc_turbo = (object *)alloc_contblock(n*sizeof(object));

@s|	fun->cc.cc_turbo = AR_ALLOC(alloc_contblock,n,object);

@s]


****Change:(orig (175 175 a))
@s[		turbo_closure(vs_base[0]);
}


@s|		turbo_closure(vs_base[0]);
}




@s]


****Change:(orig (180 180 a))
@s[	make_si_function("TURBO-CLOSURE", siLturbo_closure);

@s|	make_si_function("TURBO-CLOSURE", siLturbo_closure);
	make_si_function("MFSFUN",siLmfsfun);
	make_si_function("MFVFUN",siLmfvfun);
	make_si_function("MF",siLmf);
	make_si_function("MFVFUN-KEY",siLmfvfun_key);
	make_si_function("MM",siLmm);
	make_si_function("MC",siLmc);
	

@s]


****Change:(orig (181 181 a))
@s[}

@s|}


@s]

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.