Return to fexr.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / franz

Annotation of 42BSD/ucb/lisp/franz/fexr.c, revision 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.