Return to fexr.c CVS log

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

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

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

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