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