Return to lam2.c CVS log

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

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

1.1     ! root        1: #ifndef lint
        !             2: static char *rcsid =
        !             3:    "$Header: lam2.c,v 1.5 83/12/09 16:35:49 sklower 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:        register struct argent *temnp;
        !           252:        register char *cp = strbuf;
        !           253:        register lispval cur;
        !           254:        int n;
        !           255:        char *sprintf(), *atomtoolong();
        !           256:        lispval Lhau();
        !           257: 
        !           258:        *cp = NULL_CHAR ;
        !           259: 
        !           260:        /* loop for each argument */
        !           261:        for(temnp = lbot + AD ; temnp < np ; temnp++)
        !           262:        {
        !           263:            cur = temnp->val;
        !           264:            switch(TYPE(cur))
        !           265:            {
        !           266:            case ATOM:
        !           267:                 n = strlen(cur->a.pname);
        !           268:                 while(n + cp >= endstrb) cp = atomtoolong(cp);
        !           269:                 strcpy(cp, cur->a.pname);
        !           270:                 cp += n;
        !           271:                 break;
        !           272: 
        !           273:            case STRNG:
        !           274:                 n = strlen( (char *) cur);
        !           275:                 while(n + cp >= endstrb) cp = atomtoolong(cp);
        !           276:                 strcpy(cp, (char *) cur);
        !           277:                 cp += n;
        !           278:                 break;
        !           279: 
        !           280:            case INT:
        !           281:                 if(15 + cp >= endstrb) cp = atomtoolong(cp);
        !           282:                 sprintf(cp,"%d",cur->i);
        !           283:                 while(*cp) cp++;
        !           284:                 break;
        !           285: 
        !           286:            case DOUB:
        !           287:                 if(15 + cp >= endstrb) cp = atomtoolong(cp);
        !           288:                 sprintf(cp,"%f",cur->f);
        !           289:                 while(*cp) cp++;
        !           290:                 break;
        !           291: 
        !           292:            case SDOT: {
        !           293:                struct _iobuf _myiob;
        !           294:                register lispval handy = cur;
        !           295: 
        !           296:                for(n = 12; handy->s.CDR!=(lispval) 0; handy = handy->s.CDR)
        !           297:                        n += 12;
        !           298: 
        !           299:                while(n + cp >= endstrb) cp = atomtoolong(cp);
        !           300: 
        !           301:                _myiob._flag = _IOWRT+_IOSTRG;
        !           302:                _myiob._ptr = cp;
        !           303:                _myiob._cnt = endstrb - cp - 1;
        !           304: 
        !           305:                pbignum(cur,&_myiob);
        !           306:                cp = _myiob._ptr;
        !           307:                *cp = 0;
        !           308:                break; }
        !           309:                    
        !           310:            default:
        !           311:                 cur = error("Non atom or number to concat",TRUE);
        !           312:                 continue;    /* if returns value, try it */
        !           313:           }
        !           314: 
        !           315:        }
        !           316: 
        !           317:        if(unintern)
        !           318:                return( (lispval) newatom(FALSE)); /* uninterned atoms may
        !           319:                                                        have printname gc'd*/
        !           320:        else
        !           321:                return( (lispval) getatom(FALSE)) ;
        !           322: }
        !           323: lispval
        !           324: Lconcat(){
        !           325:        return(Iconcat(FALSE));
        !           326: }
        !           327: lispval
        !           328: Luconcat(){
        !           329:        return(Iconcat(TRUE));
        !           330: }
        !           331: 
        !           332: lispval
        !           333: Lputprop()
        !           334: {
        !           335:        lispval Iputprop();
        !           336:        chkarg(3,"putprop");
        !           337:        return(Iputprop(lbot->val,lbot[1].val,lbot[2].val));
        !           338: }
        !           339: 
        !           340: /*
        !           341:  * Iputprop :internal version of putprop used by some C functions
        !           342:  *  note: prop and ind are lisp values but are not protected (by this
        !           343:  * function) from gc.  The caller should protect them!!
        !           344:  */
        !           345: lispval
        !           346: Iputprop(atm,prop,ind)
        !           347: register lispval prop, ind, atm;
        !           348: {
        !           349:        register lispval pptr;
        !           350:        lispval *tack;          /* place to begin property list */
        !           351:        lispval pptr2;
        !           352:        lispval errorh();
        !           353:        Savestack(4);
        !           354:        
        !           355:  top:
        !           356:        switch (TYPE(atm)) {
        !           357:        case ATOM:
        !           358:                if(atm == nil) tack = &nilplist;
        !           359:                else tack =  &(atm->a.plist);
        !           360:                break;
        !           361:        case DTPR:
        !           362:                for (pptr = atm->d.cdr ; pptr != nil ; pptr = pptr->d.cdr->d.cdr)
        !           363:                    if(TYPE(pptr) != DTPR || TYPE(pptr->d.cdr) != DTPR) break;
        !           364:                if(pptr != nil) 
        !           365:                {   atm = errorh1(Vermisc,
        !           366:                                 "putprop: bad disembodied property list",
        !           367:                                 nil,TRUE,0,atm);
        !           368:                    goto top;
        !           369:                }
        !           370:                tack = (lispval *) &(atm->d.cdr);
        !           371:                break;
        !           372:        default:
        !           373:                errorh1(Vermisc,"putprop: Bad first argument: ",nil,FALSE,0,atm);
        !           374:        }
        !           375:        pptr = *tack;   /* start of property list */
        !           376: /*findit:*/
        !           377:        for (pptr = *tack ; pptr != nil ; pptr = pptr->d.cdr->d.cdr)
        !           378:                if (pptr->d.car == ind) {
        !           379:                        (pptr->d.cdr)->d.car = prop;
        !           380:                        Restorestack();
        !           381:                        return(prop);
        !           382:                }
        !           383:        /* not found, add to front
        !           384:           be careful, a gc could occur before the second newdot() */
        !           385:           
        !           386:        pptr = newdot();
        !           387:        pptr->d.car = prop;
        !           388:        pptr->d.cdr = *tack;
        !           389:        protect(pptr);
        !           390:        pptr2 = newdot();
        !           391:        pptr2->d.car = ind;
        !           392:        pptr2->d.cdr = pptr;
        !           393:        *tack = pptr2;
        !           394:        Restorestack();
        !           395:        return(prop);
        !           396: }
        !           397: 
        !           398: /* get from property list 
        !           399:  *   there are three routines to accomplish this
        !           400:  *     Lget - lisp callable, the first arg can be a symbol or a disembodied
        !           401:  *           property list.  In the latter case we check to make sure it
        !           402:  *           is a real one (as best we can).
        !           403:  *     Iget - internal routine, the first arg must be a symbol, no disembodied
        !           404:  *           plists allowed
        !           405:  *     Igetplist - internal routine, the first arg is the plist to search.
        !           406:  */
        !           407: lispval
        !           408: Lget()
        !           409: {
        !           410:        register lispval ind, atm;
        !           411:        register lispval dum1;
        !           412:        lispval Igetplist();
        !           413: 
        !           414:        chkarg(2,"get");
        !           415:        ind = lbot[1].val;
        !           416:        atm = lbot[0].val;
        !           417: top:
        !           418:        switch(TYPE(atm)) {
        !           419:        case ATOM:
        !           420:                if(atm==nil) atm = nilplist;
        !           421:                else atm = atm->a.plist;
        !           422:                break;          
        !           423: 
        !           424:        case DTPR:
        !           425:                for (dum1 = atm->d.cdr; dum1 != nil; dum1 = dum1->d.cdr->d.cdr)
        !           426:                    if((TYPE(dum1) != DTPR) || 
        !           427:                       (TYPE(dum1->d.cdr) != DTPR)) break; /* bad prop list */
        !           428:                if(dum1 != nil) 
        !           429:                {   atm = errorh1(Vermisc,
        !           430:                                 "get: bad disembodied property list",
        !           431:                                 nil,TRUE,0,atm);
        !           432:                    goto top;
        !           433:                }
        !           434:                atm = atm->d.cdr;
        !           435:                break;
        !           436:        default:
        !           437:                /* remove since maclisp doesnt treat
        !           438:                   this as an error, ugh
        !           439:                   return(errorh1(Vermisc,"get: bad first argument: ",
        !           440:                               nil,FALSE,0,atm));
        !           441:                 */
        !           442:                 return(nil);
        !           443:        }
        !           444: 
        !           445:        while (atm != nil)
        !           446:                {
        !           447:                        if (atm->d.car == ind)
        !           448:                                return ((atm->d.cdr)->d.car);
        !           449:                        atm = (atm->d.cdr)->d.cdr;
        !           450:                }
        !           451:        return(nil);
        !           452: }
        !           453: /*
        !           454:  * Iget - the first arg must be a symbol.
        !           455:  */
        !           456:        
        !           457: lispval
        !           458: Iget(atm,ind)
        !           459: register lispval atm, ind;
        !           460: {
        !           461:        lispval Igetplist();
        !           462: 
        !           463:        if(atm==nil)
        !           464:                atm = nilplist;
        !           465:        else
        !           466:                atm = atm->a.plist;
        !           467:        return(Igetplist(atm,ind));
        !           468: }
        !           469: 
        !           470: /*
        !           471:  *  Igetplist
        !           472:  * pptr is a plist
        !           473:  * ind is the indicator
        !           474:  */
        !           475: 
        !           476: lispval
        !           477: Igetplist(pptr,ind)
        !           478: register lispval pptr,ind;
        !           479: {
        !           480:        while (pptr != nil)
        !           481:                {
        !           482:                        if (pptr->d.car == ind)
        !           483:                                return ((pptr->d.cdr)->d.car);
        !           484:                        pptr = (pptr->d.cdr)->d.cdr;
        !           485:                }
        !           486:        return(nil);
        !           487: }
        !           488: lispval
        !           489: Lgetd()
        !           490: {
        !           491:        register lispval typ;
        !           492:        
        !           493:        chkarg(1,"getd");
        !           494:        typ = lbot->val;
        !           495:        if (TYPE(typ) != ATOM) 
        !           496:           errorh1(Vermisc,
        !           497:                  "getd: Only symbols have function definitions",
        !           498:                  nil,
        !           499:                  FALSE,
        !           500:                  0,
        !           501:                  typ);
        !           502:        return(typ->a.fnbnd);
        !           503: }
        !           504: lispval
        !           505: Lputd()
        !           506: {
        !           507:        register lispval atom, list;
        !           508:        
        !           509:        chkarg(2,"putd");
        !           510:        list = lbot[1].val;
        !           511:        atom = lbot->val;
        !           512:        if (TYPE(atom) != ATOM) error("only symbols have function definitions",
        !           513:                                        FALSE);
        !           514:        atom->a.fnbnd = list;
        !           515:        return(list);
        !           516: }
        !           517: 
        !           518: /* ===========================================================
        !           519: - mapping functions which return a list of the answers
        !           520: - mapcar applies the given function to successive elements
        !           521: - maplist applies the given function to successive sublists
        !           522: - ===========================================================*/
        !           523: 
        !           524: lispval
        !           525: Lmapcrx(maptyp,join)
        !           526: int maptyp;            /* 0 = mapcar,  1 = maplist  */
        !           527: int join;              /* 0 = the above, 1 = s/car/can/ */
        !           528: {
        !           529:        register struct argent *namptr;
        !           530:        register index;
        !           531:        register lispval temp;
        !           532:        register lispval current;
        !           533: 
        !           534:        struct argent *first, *last;
        !           535:        int count;
        !           536:        lispval lists[25], result;
        !           537:        Savestack(4);
        !           538:        
        !           539:        namptr = lbot + 1;
        !           540:        count = np - namptr;
        !           541:        if (count <= 0) return (nil);
        !           542:        result = current =  (lispval) np;
        !           543:        protect(nil);                   /* set up space for returned list */
        !           544:        protect(lbot->val);     /*copy funarg for call to funcall */
        !           545:        lbot = np -1;
        !           546:        first = np;
        !           547:        last = np += count;
        !           548:        for(index = 0; index < count; index++) {
        !           549:                temp =(namptr++)->val; 
        !           550:                if (TYPE (temp ) != DTPR && temp!=nil) 
        !           551:                        error ( "bad list argument to map",FALSE);
        !           552:                lists[index] = temp;
        !           553:        }
        !           554:        for(;;) {
        !           555:                for(namptr=first,index=0; index<count; index++) {
        !           556:                        temp = lists[index];
        !           557:                        if(temp==nil) goto done;
        !           558: 
        !           559:                        if(maptyp==0) (namptr++)->val = temp->d.car;
        !           560:                        else (namptr++)->val = temp;
        !           561: 
        !           562:                        lists[index] = temp->d.cdr;
        !           563:                }
        !           564:                if (join == 0) {
        !           565:                        current->l = newdot();
        !           566:                        current->l->d.car = Lfuncal();
        !           567:                        current = (lispval) &current->l->d.cdr;
        !           568:                } else {
        !           569:                        current->l = Lfuncal();
        !           570:                        if ( TYPE ( current -> l) != DTPR && current->l != nil)
        !           571:                                error("bad type returned from funcall inside map",FALSE);
        !           572:                        else  while ( current -> l  != nil )
        !           573:                                        current = (lispval) & (current ->l ->d.cdr);
        !           574:                }
        !           575:                np = last;
        !           576:        }
        !           577: done:  if (join == 0)current->l = nil;
        !           578:        Restorestack();
        !           579:        return(result->l);
        !           580: }
        !           581: 
        !           582: /* ============================
        !           583: -
        !           584: - Lmapcar
        !           585: - =============================*/
        !           586: 
        !           587: lispval
        !           588: Lmpcar()
        !           589: {
        !           590:        return(Lmapcrx(0,0));   /* call general routine */
        !           591: }
        !           592: 
        !           593: 
        !           594: /* ============================
        !           595: -
        !           596: -
        !           597: -  Lmaplist
        !           598: - ==============================*/
        !           599: 
        !           600: lispval
        !           601: Lmaplist()
        !           602: {
        !           603:        return(Lmapcrx(1,0));   /* call general routine */
        !           604: }
        !           605: 
        !           606: 
        !           607: /* ================================================
        !           608: - mapping functions which return the value of the last function application.
        !           609: - mapc and map
        !           610: - ===================================================*/
        !           611: 
        !           612: lispval
        !           613: Lmapcx(maptyp)
        !           614: int maptyp;            /* 0= mapc   , 1= map  */
        !           615: {
        !           616:        register struct argent *namptr;
        !           617:        register index;
        !           618:        register lispval temp;
        !           619:        register lispval result;
        !           620: 
        !           621:        int count;
        !           622:        struct argent *first;
        !           623:        lispval lists[25], errorh();
        !           624:        Savestack(4);
        !           625:        
        !           626:        namptr = lbot + 1;
        !           627:        count = np - namptr;
        !           628:        if(count <= 0) return(nil);
        !           629:        result = lbot[1].val;           /*This is what macsyma wants so ... */
        !           630:                                        /*copy funarg for call to funcall */
        !           631:        lbot = np; protect((namptr - 1)->val);
        !           632:        first = np; np += count;
        !           633: 
        !           634:        for(index = 0; index < count; index++) {
        !           635:                temp = (namptr++)->val;
        !           636:                while(temp!=nil && TYPE(temp)!=DTPR)
        !           637:                        temp = errorh1(Vermisc,"Inappropriate list argument to mapc",nil,TRUE,0,temp);
        !           638:                lists[index] = temp;
        !           639:        }
        !           640:        for(;;) {
        !           641:                for(namptr=first,index=0; index<count; index++) {
        !           642:                        temp = lists[index];
        !           643:                        if(temp==nil)
        !           644:                                goto done;
        !           645:                        if(maptyp==0)
        !           646:                                (namptr++)->val = temp->d.car;
        !           647:                        else
        !           648:                                (namptr++)->val = temp;
        !           649:                        lists[index] = temp->d.cdr;
        !           650:                }
        !           651:                Lfuncal();
        !           652:        }
        !           653: done:  
        !           654:        Restorestack();
        !           655:        return(result);
        !           656: }
        !           657: 
        !           658: 
        !           659: /* ==================================
        !           660: -
        !           661: -      mapc   map the car of the lists
        !           662: -
        !           663: - ==================================*/
        !           664: 
        !           665: lispval
        !           666: Lmapc()
        !           667: {      return( Lmapcx(0) );  }
        !           668: 
        !           669: 
        !           670: /* =================================
        !           671: -
        !           672: -      map    map the cdr of the lists
        !           673: -
        !           674: - ===================================*/
        !           675: 
        !           676: lispval
        !           677: Lmap()
        !           678: {      return( Lmapcx(1) );   }
        !           679: 
        !           680: 
        !           681: lispval
        !           682: Lmapcan()
        !           683: { 
        !           684:        lispval Lmapcrx();
        !           685: 
        !           686:        return ( Lmapcrx ( 0,1 ) ); 
        !           687: } 
        !           688: 
        !           689: lispval
        !           690: Lmapcon()
        !           691: { 
        !           692:        lispval Lmapcrx();
        !           693: 
        !           694:        return ( Lmapcrx ( 1,1 ) ); 
        !           695: }

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