Return to fexr.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / lisp

Annotation of 40BSD/cmd/lisp/fexr.c, revision 1.1.1.1

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

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