Return to fexr.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / franz

Annotation of 43BSDReno/pgrm/lisp/franz/fexr.c, revision 1.1.1.1

1.1       root        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:        }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.