4.3BSD - /usr/src/ucb/lisp/franz/fexr.c

   1: #ifndef lint
   2: static char *rcsid =
   3:    "$Header: /na/franz/franz/RCS/fexr.c,v 1.1 83/01/29 12:48:43 jkf Exp $";
   4: #endif
   5: 
   6: /*					-[Sat Jan 29 12:41:19 1983 by jkf]-
   7:  * 	fexr.c				$Locker:  $
   8:  * nlambda functions
   9:  *
  10:  * (c) copyright 1982, Regents of the University of California
  11:  */
  12: 
  13: 
  14: #include "global.h"
  15: 
  16: /* Ngcafter *************************************************************/
  17: /*									*/
  18: /*  Default garbage collector routine which does nothing.		*/
  19: 
  20: lispval
  21: Ngcafter()
  22:     {
  23:     return(nil);
  24:     }
  25: 
  26: /*  Nopval  *************************************************************/
  27: /*									*/
  28: /*  Routine which allows system registers and options to be examined	*/
  29: /*  and modified.  Calls copval, the routine which is called by c code	*/
  30: /*  to do the same thing from inside the system.			*/
  31: 
  32: lispval
  33: Nopval()
  34:     {
  35:     lispval quant;
  36: 
  37:     if( TYPE(lbot->val) != DTPR )
  38:         return(error("BAD CALL TO OPVAL",TRUE));
  39:     quant = eval(lbot->val->d.car); /*  evaluate name of sys variable  */
  40:     while( TYPE(quant) != ATOM )
  41:         quant = error("FIRST ARG TO OPVAL MUST BE AN ATOM",TRUE);
  42: 
  43:     if( (vtemp=lbot->val->d.cdr) != nil && TYPE(lbot->val->d.cdr) != DTPR )
  44:         return(error("BAD ARG LIST FOR OPVAL",TRUE));
  45:     return(copval(
  46:         quant,
  47:         vtemp==nil ? (lispval)CNIL : eval(vtemp->d.car)
  48:         ));
  49:     }
  50: /*  copval  *************************************************************/
  51: /*  This routine keeps track of system quantities, and is called from	*/
  52: /*  C code.  If the second argument is CNIL, no change is made in the	*/
  53: /*  quantity.								*/
  54: /*  Since this routine may call newdot() if the second argument is not	*/
  55: /*  CNIL, the arguments should be protected somehow in that case.	*/
  56: 
  57: lispval
  58: copval(option,value)
  59:     lispval option, value;
  60:     {
  61:     struct dtpr fake;
  62:     lispval rval;
  63: 
  64:     if( option->a.plist == nil && value != (lispval) CNIL)
  65:         {
  66:         protect(option); protect(value);
  67:         option->a.plist = newdot();
  68:         option->a.plist->d.car = sysa;
  69:         option->a.plist->d.cdr = newdot();
  70:         option->a.plist->d.cdr->d.car = value;
  71:         unprot(); unprot();
  72:         return(nil);
  73:         }
  74: 
  75: 
  76:     if( option->a.plist == nil ) return(nil);
  77: 
  78:     fake.cdr = option->a.plist;
  79:     option = (lispval) (&fake);
  80: 
  81:     while( option->d.cdr != nil )   /*  can't be nil first time through  */
  82:         {
  83:         option = option->d.cdr;
  84:         if( option->d.car == sysa )
  85:             {
  86:             rval = option->d.cdr->d.car;
  87:             if( value != (lispval)CNIL )
  88:                 option->d.cdr->d.car = value;
  89:             return(rval);
  90:             }
  91:         option = option->d.cdr;
  92:         }
  93: 
  94:     if( value != (lispval)CNIL )
  95:         {
  96:         protect(option); protect(value);
  97:         option->d.cdr = newdot();
  98:         option->d.cdr->d.car = sysa;
  99:         option->d.cdr->d.cdr = newdot();
 100:         option->d.cdr->d.cdr->d.car = value;
 101:         unprot(); unprot();
 102:         }
 103: 
 104: 
 105:     return(nil);
 106:     }

Defined functions

Defined variables