BSD 3 development

[unix-history] / usr / src / cmd / lisp / fexr.c

#include "global.h"

/* Ngcafter *************************************************************/
/*									*/
/*  Default garbage collector routine which does nothing.		*/

lispval 
Ngcafter()
	{
	return(nil);
	}

/*  Nopval  *************************************************************/
/*									*/
/*  Routine which allows system registers and options to be examined	*/
/*  and modified.  Calls copval, the routine which is called by c code	*/
/*  to do the same thing from inside the system.			*/

lispval 
Nopval()
	{
	lispval quant;
	snpand(0);

	if( TYPE(lbot->val) != DTPR )
		return(error("BAD CALL TO OPVAL",TRUE));
	quant = eval(lbot->val->car);	/*  evaluate name of sys variable  */
	while( TYPE(quant) != ATOM )
		quant = error("FIRST ARG TO OPVAL MUST BE AN ATOM",TRUE);

	if( (vtemp=lbot->val->cdr) != nil && TYPE(lbot->val->cdr) != DTPR )
		return(error("BAD ARG LIST FOR OPVAL",TRUE));
	return(copval(
		quant,
		vtemp==nil ? (lispval)CNIL : eval(vtemp->car)
		));
	}
/*  copval  *************************************************************/
/*  This routine keeps track of system quantities, and is called from	*/
/*  C code.  If the second argument is CNIL, no change is made in the	*/
/*  quantity.								*/
/*  Since this routine may call newdot() if the second argument is not	*/
/*  CNIL, the arguments should be protected somehow in that case.	*/

lispval 
copval(option,value)
	lispval option, value;
	{
	struct dtpr fake;
	lispval rval;
	snpand(0);


	if( option->plist == nil && value != (lispval) CNIL)
		{
		protect(option); protect(value);
		option->plist = newdot();
		option->plist->car = sysa;
		option->plist->cdr = newdot();
		option->plist->cdr->car = value;
		unprot(); unprot();
		return(nil);
		}


	if( option->plist == nil ) return(nil);

	fake.cdr = option->plist;
	option = (lispval) (&fake);

	while( option->cdr != nil )	/*  can't be nil first time through  */
		{
		option = option->cdr;
		if( option->car == sysa )
			{
			rval = option->cdr->car;
			if( value != (lispval)CNIL )
				option->cdr->car = value;
			return(rval);
			}
		option = option->cdr;
		}

	if( value != (lispval)CNIL )
		{
		protect(option); protect(value);
		option->cdr = newdot();
		option->cdr->car = sysa;
		option->cdr->cdr = newdot();
		option->cdr->cdr->car = value;
		unprot(); unprot();
		}


	return(nil);
	}