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     ! 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.