Return to lam2.c CVS log

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

Annotation of 42BSD/ucb/lisp/franz/lam2.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char *rcsid =
        !             3:    "$Header: /na/franz/franz/RCS/lam2.c,v 1.3 83/08/06 08:37:23 jkf Exp $";
        !             4: #endif
        !             5: 
        !             6: /*                                     -[Fri Aug  5 12:46:16 1983 by jkf]-
        !             7:  *     lam2.c                          $Locker:  $
        !             8:  * lambda functions
        !             9:  *
        !            10:  * (c) copyright 1982, Regents of the University of California
        !            11:  */
        !            12: 
        !            13: # include "global.h"
        !            14: # include <signal.h>
        !            15: # include "structs.h"
        !            16: # include "chars.h"
        !            17: # include "chkrtab.h"
        !            18: /*
        !            19:  * (flatc 'thing ['max]) returns the smaller of max and the number of chars
        !            20:  * required to print thing linearly.
        !            21:  * if max argument is not given, we assume the second arg is infinity
        !            22:  */
        !            23: static flen; /*Internal to this module, used as a running counter of flatsize*/
        !            24: static fmax; /*used for maximum for quick reference */
        !            25: char *strcpy();
        !            26: 
        !            27: lispval
        !            28: Lflatsi()
        !            29: {
        !            30:        register lispval current;
        !            31:        Savestack(1);                   /* fixup entry mask */
        !            32: 
        !            33:        fmax = 0x7fffffff;      /* biggest integer by default */
        !            34:        switch(np-lbot) 
        !            35:        {
        !            36:            case 2: current = lbot[1].val;
        !            37:                    while(TYPE(current) != INT)
        !            38:                        current = errorh1(Vermisc,
        !            39:                                        "flatsize: second arg not integer",
        !            40:                                        nil,TRUE,0,current);
        !            41:                    fmax = current->i;
        !            42:            case 1: break;
        !            43:            default: argerr("flatsize");
        !            44:        }
        !            45: 
        !            46:        flen = 0; 
        !            47:        current = lbot->val;
        !            48:        protect(nil);                   /*create space for argument to pntlen*/
        !            49:        Iflatsi(current);
        !            50:        Restorestack();
        !            51:        return(inewint(flen));
        !            52: }
        !            53: /*
        !            54:  * Iflatsi does the real work of the calculation for flatc
        !            55:  */
        !            56: Iflatsi(current)
        !            57: register lispval current;
        !            58: {
        !            59: 
        !            60:        if(flen > fmax) return;
        !            61:        switch(TYPE(current)) {
        !            62: 
        !            63:        patom:
        !            64:        case INT: case ATOM: case DOUB: case STRNG:
        !            65:                np[-1].val = current;
        !            66:                flen += Ipntlen();
        !            67:                return;
        !            68:        
        !            69:        pthing:
        !            70:        case DTPR:
        !            71:                flen++;
        !            72:                Iflatsi(current->d.car);
        !            73:                current = current->d.cdr;
        !            74:                if(current == nil) {
        !            75:                        flen++;
        !            76:                        return;
        !            77:                }
        !            78:                if(flen > fmax) return;
        !            79:                switch(TYPE(current)) {
        !            80:                case INT: case ATOM: case DOUB:
        !            81:                        flen += 4;
        !            82:                        goto patom;
        !            83:                case DTPR:
        !            84:                        goto pthing;
        !            85:                }
        !            86:        }
        !            87: }
        !            88: 
        !            89: 
        !            90: #define EADC -1
        !            91: #define EAD  -2
        !            92: lispval
        !            93: Lread()
        !            94: { return (r(EAD)); }
        !            95: 
        !            96: lispval
        !            97: Lratom()
        !            98: { return (r(ATOM)); }
        !            99: 
        !           100: lispval
        !           101: Lreadc()
        !           102: { return (r(EADC)); }
        !           103: 
        !           104: 
        !           105: extern unsigned char *ctable;
        !           106: /* r *********************************************************************/
        !           107: /* this function maps the desired read         function into the system-defined */
        !           108: /* reading functions after testing for a legal port.                    */
        !           109: lispval
        !           110: r(op)
        !           111: int op;
        !           112: {
        !           113:        unsigned char c; register lispval result;
        !           114:        register cc;
        !           115:        int orlevel; extern int rlevel;
        !           116:        FILE *ttemp;
        !           117:        struct nament *oldbnp = bnp;
        !           118:        Savestack(2);
        !           119: 
        !           120:        switch(np-lbot) {
        !           121:        case 0:
        !           122:                protect(nil);
        !           123:        case 1:
        !           124:                protect(nil);
        !           125:        case 2: break;
        !           126:        default:
        !           127:                argerr("read or ratom or readc");
        !           128:        }
        !           129:        result = Vreadtable->a.clb;
        !           130:        chkrtab(result);
        !           131:        orlevel = rlevel;
        !           132:        rlevel = 0;
        !           133:        ttemp = okport(Vpiport->a.clb,stdin);
        !           134:        ttemp = okport(lbot->val,ttemp);
        !           135: /*printf("entering switch\n");*/
        !           136:        if(ttemp == stdin) fflush(stdout);      /* flush any pending 
        !           137:                                                 * characters if reading stdin 
        !           138:                                                 * there should be tests to see
        !           139:                                                 * if this is a tty or pipe
        !           140:                                                 */
        !           141: 
        !           142:        switch (op)
        !           143:        {
        !           144:        case EADC:      rlevel = orlevel;
        !           145:                        cc = getc(ttemp);
        !           146:                        c = cc;
        !           147:                        if(cc == EOF)
        !           148:                        {
        !           149:                                Restorestack();
        !           150:                                return(lbot[1].val);
        !           151:                        } else {
        !           152:                                strbuf[0] = hash = (c & 0177);
        !           153:                                strbuf[1] = 0;
        !           154:                                atmlen = 2;
        !           155:                                Restorestack();
        !           156:                                return((lispval)getatom(TRUE));
        !           157:                        }
        !           158: 
        !           159:        case ATOM:      rlevel = orlevel;
        !           160:                        result = (ratomr(ttemp));
        !           161:                        goto out;
        !           162: 
        !           163:        case EAD:       PUSHDOWN(Vpiport,P(ttemp)); /* rebind Vpiport */
        !           164:                        result = readr(ttemp);
        !           165:        out:            if(result==eofa)
        !           166:                        {    
        !           167:                             if(sigintcnt > 0) sigcall(SIGINT);
        !           168:                             result = lbot[1].val;
        !           169:                        }
        !           170:                        rlevel = orlevel;
        !           171:                        popnames(oldbnp);       /* unwind bindings */
        !           172:                        Restorestack();
        !           173:                        return(result);
        !           174:        }
        !           175:        /* NOTREACHED */
        !           176: }
        !           177: 
        !           178: /* Lload *****************************************************************/
        !           179: /* Reads in and executes forms from the specified file. This should      */
        !           180: /* really be an nlambda taking multiple arguments, but the error        */
        !           181: /* handling gets funny in that case (one file out of several not        */
        !           182: /* openable, for instance).                                             */
        !           183: lispval
        !           184: Lload()
        !           185: {
        !           186:        register FILE *port;
        !           187:        register char *p, *ttemp; register lispval vtemp;
        !           188:        struct nament *oldbnp = bnp;
        !           189:        int orlevel,typ;
        !           190:        char longname[100];
        !           191:        char *shortname, *end2, *Ilibdir();
        !           192:        /*Savestack(4); not necessary because np not altered */
        !           193: 
        !           194:        chkarg(1,"load");
        !           195:        if((typ = TYPE(lbot->val)) == ATOM)
        !           196:            ttemp =  lbot->val->a.pname ;  /* ttemp will point to name */
        !           197:        else if(typ == STRNG)
        !           198:            ttemp = (char *) lbot->val;
        !           199:        else 
        !           200:             return(error("FILENAME MUST BE ATOMIC",FALSE));
        !           201:        strcpy(longname, Ilibdir());
        !           202:        for(p = longname; *p; p++);
        !           203:        *p++ = '/'; *p = 0;
        !           204:        shortname = p;
        !           205:        strcpy(p,ttemp);
        !           206:        for(; *p; p++);
        !           207:                end2 = p;
        !           208:        strcpy(p,".l");
        !           209:        if ((port = fopen(shortname,"r")) == NULL &&
        !           210:                (port = fopen(longname, "r")) == NULL) {
        !           211:                        *end2 = 0;
        !           212:                        if ((port = fopen(shortname,"r")) == NULL &&
        !           213:                                (port = fopen(longname, "r")) == NULL)
        !           214:                                        errorh1(Vermisc,"Can't open file: ", 
        !           215:                                                     nil,FALSE,0,lbot->val);
        !           216:        }
        !           217:        orlevel = rlevel;
        !           218:        rlevel = 0;
        !           219: 
        !           220:        if(ISNIL(copval(gcload,CNIL)) &&
        !           221:                loading->a.clb != tatom &&
        !           222:                ISNIL(copval(gcdis,CNIL)))
        !           223:                gc((struct types *)CNIL);    /*  do a gc if gc will be off  */
        !           224: 
        !           225:        /* shallow bind the value of lisp atom piport   */
        !           226:        /* so readmacros will work                      */
        !           227:        PUSHDOWN(Vpiport,P(port));
        !           228:        PUSHDOWN(loading,tatom);        /* set indication of loading status */
        !           229: 
        !           230:        while ((vtemp = readr(port)) != eofa) {
        !           231:            eval(vtemp);
        !           232:        }
        !           233:        popnames(oldbnp);               /* unbind piport, loading */
        !           234: 
        !           235:        rlevel = orlevel;
        !           236:        fclose(port);
        !           237:        return(nil);
        !           238: }
        !           239: 
        !           240: /* concat **************************************************
        !           241: -
        !           242: -  use: (concat arg1 arg2 ... )
        !           243: -
        !           244: -  concatenates the print names of all of its arguments.
        !           245: - the arguments may be atoms, integers or real numbers.
        !           246: -
        !           247: - *********************************************************/
        !           248: lispval
        !           249: Iconcat(unintern)
        !           250: {
        !           251:        char *sprintf();
        !           252:        register struct argent *temnp;
        !           253:        register int atmlen; /* Passt auf!  atmlen in the external
        !           254:                                sense calculated by newstr          */
        !           255:        lispval cur;
        !           256: 
        !           257:        atmlen = 0 ;    
        !           258:        strbuf[0] = NULL_CHAR ;
        !           259: 
        !           260:        /* loop for each argument */
        !           261:        for(temnp = lbot + AD ; temnp < np ; temnp++)
        !           262:        {
        !           263:            cur = temnp->val;
        !           264:       loop: if(atmlen > 512) error("concat: string buffer overflow",FALSE);
        !           265:            switch(TYPE(cur))
        !           266:            {
        !           267:            case ATOM:
        !           268:                 strcpy(&strbuf[atmlen], ((struct atom *) cur) -> pname) ;
        !           269:                 break;
        !           270: 
        !           271:            case STRNG:
        !           272:                 strcpy(&strbuf[atmlen], (char *) cur);
        !           273:                 break;
        !           274: 
        !           275:            case INT:
        !           276:                 sprintf(&strbuf[atmlen],"%d",cur->i);
        !           277:                 break;
        !           278: 
        !           279:            case DOUB:
        !           280:                 sprintf(&strbuf[atmlen],"%f",cur->f);
        !           281:                 break;
        !           282: 
        !           283:            case SDOT: {
        !           284:                struct _iobuf _myiob;
        !           285: 
        !           286:                _myiob._flag = _IOWRT+_IOSTRG;
        !           287:                _myiob._ptr = &strbuf[atmlen];
        !           288:                _myiob._cnt = STRBLEN - 1  - atmlen;
        !           289: 
        !           290:                pbignum(cur,&_myiob);
        !           291:                putc(0,&_myiob);
        !           292:                break; }
        !           293:                    
        !           294:            default:
        !           295:                 cur = error("Non atom or number to concat",TRUE);
        !           296:                 goto loop;    /* if returns value, try it */
        !           297:           }
        !           298:           atmlen = strlen(strbuf);
        !           299: 
        !           300:        }
        !           301: 
        !           302:        if(unintern)
        !           303:                return( (lispval) newatom(FALSE)); /* uninterned atoms may
        !           304:                                                        have printname gc'd*/
        !           305:        else
        !           306:                return( (lispval) getatom(FALSE)) ;
        !           307: }
        !           308: lispval
        !           309: Lconcat(){
        !           310:        return(Iconcat(FALSE));
        !           311: }
        !           312: lispval
        !           313: Luconcat(){
        !           314:        return(Iconcat(TRUE));
        !           315: }
        !           316: 
        !           317: lispval
        !           318: Lputprop()
        !           319: {
        !           320:        lispval Iputprop();
        !           321:        chkarg(3,"putprop");
        !           322:        return(Iputprop(lbot->val,lbot[1].val,lbot[2].val));
        !           323: }
        !           324: 
        !           325: /*
        !           326:  * Iputprop :internal version of putprop used by some C functions
        !           327:  *  note: prop and ind are lisp values but are not protected (by this
        !           328:  * function) from gc.  The caller should protect them!!
        !           329:  */
        !           330: lispval
        !           331: Iputprop(atm,prop,ind)
        !           332: register lispval prop, ind, atm;
        !           333: {
        !           334:        register lispval pptr;
        !           335:        lispval *tack;          /* place to begin property list */
        !           336:        lispval pptr2;
        !           337:        lispval errorh();
        !           338:        Savestack(4);
        !           339:        
        !           340:  top:
        !           341:        switch (TYPE(atm)) {
        !           342:        case ATOM:
        !           343:                if(atm == nil) tack = &nilplist;
        !           344:                else tack =  &(atm->a.plist);
        !           345:                break;
        !           346:        case DTPR:
        !           347:                for (pptr = atm->d.cdr ; pptr != nil ; pptr = pptr->d.cdr->d.cdr)
        !           348:                    if(TYPE(pptr) != DTPR || TYPE(pptr->d.cdr) != DTPR) break;
        !           349:                if(pptr != nil) 
        !           350:                {   atm = errorh1(Vermisc,
        !           351:                                 "putprop: bad disembodied property list",
        !           352:                                 nil,TRUE,0,atm);
        !           353:                    goto top;
        !           354:                }
        !           355:                tack = (lispval *) &(atm->d.cdr);
        !           356:                break;
        !           357:        default:
        !           358:                errorh1(Vermisc,"putprop: Bad first argument: ",nil,FALSE,0,atm);
        !           359:        }
        !           360:        pptr = *tack;   /* start of property list */
        !           361: /*findit:*/
        !           362:        for (pptr = *tack ; pptr != nil ; pptr = pptr->d.cdr->d.cdr)
        !           363:                if (pptr->d.car == ind) {
        !           364:                        (pptr->d.cdr)->d.car = prop;
        !           365:                        Restorestack();
        !           366:                        return(prop);
        !           367:                }
        !           368:        /* not found, add to front
        !           369:           be careful, a gc could occur before the second newdot() */
        !           370:           
        !           371:        pptr = newdot();
        !           372:        pptr->d.car = prop;
        !           373:        pptr->d.cdr = *tack;
        !           374:        protect(pptr);
        !           375:        pptr2 = newdot();
        !           376:        pptr2->d.car = ind;
        !           377:        pptr2->d.cdr = pptr;
        !           378:        *tack = pptr2;
        !           379:        Restorestack();
        !           380:        return(prop);
        !           381: }
        !           382: 
        !           383: /* get from property list 
        !           384:  *   there are three routines to accomplish this
        !           385:  *     Lget - lisp callable, the first arg can be a symbol or a disembodied
        !           386:  *           property list.  In the latter case we check to make sure it
        !           387:  *           is a real one (as best we can).
        !           388:  *     Iget - internal routine, the first arg must be a symbol, no disembodied
        !           389:  *           plists allowed
        !           390:  *     Igetplist - internal routine, the first arg is the plist to search.
        !           391:  */
        !           392: lispval
        !           393: Lget()
        !           394: {
        !           395:        register lispval ind, atm;
        !           396:        register lispval dum1;
        !           397:        lispval Igetplist();
        !           398: 
        !           399:        chkarg(2,"get");
        !           400:        ind = lbot[1].val;
        !           401:        atm = lbot[0].val;
        !           402: top:
        !           403:        switch(TYPE(atm)) {
        !           404:        case ATOM:
        !           405:                if(atm==nil) atm = nilplist;
        !           406:                else atm = atm->a.plist;
        !           407:                break;          
        !           408: 
        !           409:        case DTPR:
        !           410:                for (dum1 = atm->d.cdr; dum1 != nil; dum1 = dum1->d.cdr->d.cdr)
        !           411:                    if((TYPE(dum1) != DTPR) || 
        !           412:                       (TYPE(dum1->d.cdr) != DTPR)) break; /* bad prop list */
        !           413:                if(dum1 != nil) 
        !           414:                {   atm = errorh1(Vermisc,
        !           415:                                 "get: bad disembodied property list",
        !           416:                                 nil,TRUE,0,atm);
        !           417:                    goto top;
        !           418:                }
        !           419:                atm = atm->d.cdr;
        !           420:                break;
        !           421:        default:
        !           422:                /* remove since maclisp doesnt treat
        !           423:                   this as an error, ugh
        !           424:                   return(errorh1(Vermisc,"get: bad first argument: ",
        !           425:                               nil,FALSE,0,atm));
        !           426:                 */
        !           427:                 return(nil);
        !           428:        }
        !           429: 
        !           430:        while (atm != nil)
        !           431:                {
        !           432:                        if (atm->d.car == ind)
        !           433:                                return ((atm->d.cdr)->d.car);
        !           434:                        atm = (atm->d.cdr)->d.cdr;
        !           435:                }
        !           436:        return(nil);
        !           437: }
        !           438: /*
        !           439:  * Iget - the first arg must be a symbol.
        !           440:  */
        !           441:        
        !           442: lispval
        !           443: Iget(atm,ind)
        !           444: register lispval atm, ind;
        !           445: {
        !           446:        lispval Igetplist();
        !           447: 
        !           448:        if(atm==nil)
        !           449:                atm = nilplist;
        !           450:        else
        !           451:                atm = atm->a.plist;
        !           452:        return(Igetplist(atm,ind));
        !           453: }
        !           454: 
        !           455: /*
        !           456:  *  Igetplist
        !           457:  * pptr is a plist
        !           458:  * ind is the indicator
        !           459:  */
        !           460: 
        !           461: lispval
        !           462: Igetplist(pptr,ind)
        !           463: register lispval pptr,ind;
        !           464: {
        !           465:        while (pptr != nil)
        !           466:                {
        !           467:                        if (pptr->d.car == ind)
        !           468:                                return ((pptr->d.cdr)->d.car);
        !           469:                        pptr = (pptr->d.cdr)->d.cdr;
        !           470:                }
        !           471:        return(nil);
        !           472: }
        !           473: lispval
        !           474: Lgetd()
        !           475: {
        !           476:        register lispval typ;
        !           477:        
        !           478:        chkarg(1,"getd");
        !           479:        typ = lbot->val;
        !           480:        if (TYPE(typ) != ATOM) 
        !           481:           errorh1(Vermisc,
        !           482:                  "getd: Only symbols have function definitions",
        !           483:                  nil,
        !           484:                  FALSE,
        !           485:                  0,
        !           486:                  typ);
        !           487:        return(typ->a.fnbnd);
        !           488: }
        !           489: lispval
        !           490: Lputd()
        !           491: {
        !           492:        register lispval atom, list;
        !           493:        
        !           494:        chkarg(2,"putd");
        !           495:        list = lbot[1].val;
        !           496:        atom = lbot->val;
        !           497:        if (TYPE(atom) != ATOM) error("only symbols have function definitions",
        !           498:                                        FALSE);
        !           499:        atom->a.fnbnd = list;
        !           500:        return(list);
        !           501: }
        !           502: 
        !           503: /* ===========================================================
        !           504: - mapping functions which return a list of the answers
        !           505: - mapcar applies the given function to successive elements
        !           506: - maplist applies the given function to successive sublists
        !           507: - ===========================================================*/
        !           508: 
        !           509: lispval
        !           510: Lmapcrx(maptyp,join)
        !           511: int maptyp;            /* 0 = mapcar,  1 = maplist  */
        !           512: int join;              /* 0 = the above, 1 = s/car/can/ */
        !           513: {
        !           514:        register struct argent *namptr;
        !           515:        register index;
        !           516:        register lispval temp;
        !           517:        register lispval current;
        !           518: 
        !           519:        struct argent *first, *last;
        !           520:        int count;
        !           521:        lispval lists[25], result;
        !           522:        Savestack(4);
        !           523:        
        !           524:        namptr = lbot + 1;
        !           525:        count = np - namptr;
        !           526:        if (count <= 0) return (nil);
        !           527:        result = current =  (lispval) np;
        !           528:        protect(nil);                   /* set up space for returned list */
        !           529:        protect(lbot->val);     /*copy funarg for call to funcall */
        !           530:        lbot = np -1;
        !           531:        first = np;
        !           532:        last = np += count;
        !           533:        for(index = 0; index < count; index++) {
        !           534:                temp =(namptr++)->val; 
        !           535:                if (TYPE (temp ) != DTPR && temp!=nil) 
        !           536:                        error ( "bad list argument to map",FALSE);
        !           537:                lists[index] = temp;
        !           538:        }
        !           539:        for(;;) {
        !           540:                for(namptr=first,index=0; index<count; index++) {
        !           541:                        temp = lists[index];
        !           542:                        if(temp==nil) goto done;
        !           543: 
        !           544:                        if(maptyp==0) (namptr++)->val = temp->d.car;
        !           545:                        else (namptr++)->val = temp;
        !           546: 
        !           547:                        lists[index] = temp->d.cdr;
        !           548:                }
        !           549:                if (join == 0) {
        !           550:                        current->l = newdot();
        !           551:                        current->l->d.car = Lfuncal();
        !           552:                        current = (lispval) &current->l->d.cdr;
        !           553:                } else {
        !           554:                        current->l = Lfuncal();
        !           555:                        if ( TYPE ( current -> l) != DTPR && current->l != nil)
        !           556:                                error("bad type returned from funcall inside map",FALSE);
        !           557:                        else  while ( current -> l  != nil )
        !           558:                                        current = (lispval) & (current ->l ->d.cdr);
        !           559:                }
        !           560:                np = last;
        !           561:        }
        !           562: done:  if (join == 0)current->l = nil;
        !           563:        Restorestack();
        !           564:        return(result->l);
        !           565: }
        !           566: 
        !           567: /* ============================
        !           568: -
        !           569: - Lmapcar
        !           570: - =============================*/
        !           571: 
        !           572: lispval
        !           573: Lmapcar()
        !           574: {
        !           575:        return(Lmapcrx(0,0));   /* call general routine */
        !           576: }
        !           577: 
        !           578: 
        !           579: /* ============================
        !           580: -
        !           581: -
        !           582: -  Lmaplist
        !           583: - ==============================*/
        !           584: 
        !           585: lispval
        !           586: Lmaplist()
        !           587: {
        !           588:        return(Lmapcrx(1,0));   /* call general routine */
        !           589: }
        !           590: 
        !           591: 
        !           592: /* ================================================
        !           593: - mapping functions which return the value of the last function application.
        !           594: - mapc and map
        !           595: - ===================================================*/
        !           596: 
        !           597: lispval
        !           598: Lmapcx(maptyp)
        !           599: int maptyp;            /* 0= mapc   , 1= map  */
        !           600: {
        !           601:        register struct argent *namptr;
        !           602:        register index;
        !           603:        register lispval temp;
        !           604:        register lispval result;
        !           605: 
        !           606:        int count;
        !           607:        struct argent *first;
        !           608:        lispval lists[25], errorh();
        !           609:        Savestack(4);
        !           610:        
        !           611:        namptr = lbot + 1;
        !           612:        count = np - namptr;
        !           613:        if(count <= 0) return(nil);
        !           614:        result = lbot[1].val;           /*This is what macsyma wants so ... */
        !           615:                                        /*copy funarg for call to funcall */
        !           616:        lbot = np; protect((namptr - 1)->val);
        !           617:        first = np; np += count;
        !           618: 
        !           619:        for(index = 0; index < count; index++) {
        !           620:                temp = (namptr++)->val;
        !           621:                while(temp!=nil && TYPE(temp)!=DTPR)
        !           622:                        temp = errorh1(Vermisc,"Inappropriate list argument to mapc",nil,TRUE,0,temp);
        !           623:                lists[index] = temp;
        !           624:        }
        !           625:        for(;;) {
        !           626:                for(namptr=first,index=0; index<count; index++) {
        !           627:                        temp = lists[index];
        !           628:                        if(temp==nil)
        !           629:                                goto done;
        !           630:                        if(maptyp==0)
        !           631:                                (namptr++)->val = temp->d.car;
        !           632:                        else
        !           633:                                (namptr++)->val = temp;
        !           634:                        lists[index] = temp->d.cdr;
        !           635:                }
        !           636:                Lfuncal();
        !           637:        }
        !           638: done:  
        !           639:        Restorestack();
        !           640:        return(result);
        !           641: }
        !           642: 
        !           643: 
        !           644: /* ==================================
        !           645: -
        !           646: -      mapc   map the car of the lists
        !           647: -
        !           648: - ==================================*/
        !           649: 
        !           650: lispval
        !           651: Lmapc()
        !           652: {      return( Lmapcx(0) );  }
        !           653: 
        !           654: 
        !           655: /* =================================
        !           656: -
        !           657: -      map    map the cdr of the lists
        !           658: -
        !           659: - ===================================*/
        !           660: 
        !           661: lispval
        !           662: Lmap()
        !           663: {      return( Lmapcx(1) );   }
        !           664: 
        !           665: 
        !           666: lispval
        !           667: Lmapcan()
        !           668: { 
        !           669:        lispval Lmapcrx();
        !           670: 
        !           671:        return ( Lmapcrx ( 0,1 ) ); 
        !           672: } 
        !           673: 
        !           674: lispval
        !           675: Lmapcon()
        !           676: { 
        !           677:        lispval Lmapcrx();
        !           678: 
        !           679:        return ( Lmapcrx ( 1,1 ) ); 
        !           680: }

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