Return to al.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / apl

Annotation of 40BSD/cmd/apl/al.c, revision 1.1

1.1     ! root        1: #
        !             2: 
        !             3: /*
        !             4:  *     monadic epsilon and encode /rww
        !             5:  */
        !             6: 
        !             7: #include "apl.h"
        !             8: 
        !             9: ex_meps()
        !            10: {
        !            11: register struct item *p;
        !            12: register i,j;
        !            13: struct item *mark;
        !            14: 
        !            15:         char *a,*b,*c;
        !            16:         int dim0,dim1;
        !            17:         int xpcp;
        !            18: 
        !            19:        p = fetch1();
        !            20:        if(p->rank>2 || p->type!=CH)
        !            21:                error("execute C");
        !            22:        if(!p->size) {
        !            23:                pop();
        !            24:                push(newdat(DA,1,0));
        !            25:                return;
        !            26:        }
        !            27:        b = p->datap;
        !            28:        dim0 = p->rank<2 ? 1 : p->dim[0];
        !            29:        dim1 = p->rank<2 ? p->size : p->dim[1];
        !            30:        a = alloc(dim1+1);
        !            31:        xpcp = pcp;
        !            32:        mark = sp;
        !            33:        for(i=0; i<dim0; i++){
        !            34:                for(j=0; j<dim1; j++)
        !            35:                        a[j] = b[j];
        !            36:                a[j] = '\n';
        !            37:                c = compile(a,1);
        !            38:                execute(c);
        !            39:                afree(c);
        !            40:                b =+ dim1;
        !            41:                if(i < dim0-1)
        !            42:                        pop();
        !            43:        }
        !            44:        afree(a);
        !            45:        pcp = xpcp;
        !            46:        while(sp>mark)
        !            47:                dealloc(*--sp);
        !            48:        pop();
        !            49:        push(newdat(DA,1,0));
        !            50: }
        !            51: 
        !            52: ex_menc()
        !            53: {
        !            54:        struct item *p;
        !            55: 
        !            56:        p = fetch1();
        !            57:        if(p->type == CH)
        !            58:                menc0();
        !            59:        else
        !            60:                menc1();
        !            61: }
        !            62: 
        !            63: menc0()                        /* dredge up a function and put it into an array*/
        !            64: {
        !            65: int    oifile;
        !            66:        char name[NAMS];
        !            67:        char *c, *c2;
        !            68:        struct nlist *np;
        !            69:        struct item *p;
        !            70:        int len, dim0, dim1;
        !            71:        register i;
        !            72:        register char *dp;
        !            73: 
        !            74:        p = fetch1();
        !            75:        if(p->size == 0 || p->rank >1 || p->size >= NAMS)
        !            76:                error("menc C");
        !            77:                        /* set up the name in search format     */
        !            78:        copy(CH, p->datap, name, p->size);
        !            79:        name[p->size] = '\0';
        !            80:                        /* search for name among the functions  */
        !            81:        for(np = nlist; np->namep; np++)
        !            82:                if(equal(np->namep,name))
        !            83:                        break;
        !            84:                        /* if not found then domain error       */
        !            85:        if(!np->namep)
        !            86:                error("menc D");
        !            87:                        /* set up new array                     */
        !            88:        dim0 = 0;
        !            89:        dim1 = 0;
        !            90:        oifile = ifile;
        !            91:        ifile = dup(wfile);
        !            92:        lseek(ifile, np->label, 0);    /* look up function     */
        !            93:                        /* compute max width and height         */
        !            94:        while(c2 = c = rline(0))
        !            95:        {       while(*c2++ != '\n');
        !            96:                dim0++;
        !            97:                len = c2 - c - 1;
        !            98:                dim1 = dim1 < len ? len : dim1;
        !            99:                afree(c);
        !           100:        }
        !           101:        afree(p);                /* release old variable         */
        !           102:                        /* create new array and put function in */
        !           103:        p = newdat(CH, 2, dim0*dim1);
        !           104:        p->rank = 2;
        !           105:        p->dim[0] = dim0;
        !           106:        p->dim[1] = dim1;
        !           107:        dp = p->datap;
        !           108:        lseek(ifile, np->label, 0);
        !           109:        while(c2 = c = rline(0))
        !           110:        {       for(i=0; i<dim1; i++)
        !           111:                        if(*c != '\n')
        !           112:                                *dp++ = *c++;
        !           113:                        else
        !           114:                                *dp++ = ' ';    /* fill w/blanks*/
        !           115:                afree(c2);
        !           116:        }
        !           117:                        /* put the new array on the stack       */
        !           118:        push(p);
        !           119:                        /* reset the current file               */
        !           120:        ifile = oifile;
        !           121: }
        !           122: 
        !           123: menc1()/* change numbers into characters       */
        !           124: {
        !           125:        struct item *p, *q;
        !           126:        register i,j,numsz;
        !           127:        data *dp;
        !           128:        int total,param[4];
        !           129: 
        !           130:                        /* zeroize size information vector      */
        !           131:        for(i=0; i<4; i++)
        !           132:                param[i] = 0;
        !           133:                        /* pick up the argument                 */
        !           134:        p = fetch1();
        !           135:        dp = p->datap;
        !           136:                        /* find the maximum # of chars in any # */
        !           137:        for(i=0; i<p->size; i++)
        !           138:                epr1(*dp++, param);
        !           139:        numsz = param[1] + param[2] + !!param[2] + param[3] + 1;
        !           140:                        /* rowsize is max # size x last dim     */
        !           141:        rowsz = p->rank ? p->dim[p->rank-1] : 1;
        !           142:        rowsz *= numsz;
        !           143:                        /* row size x # of rows(incl blank)*/
        !           144:        total = p->size * numsz;
        !           145:        for(j=i=0; i<p->rank; i++)
        !           146:                if(p->dim[i] != 1)
        !           147:                        if(j++ > 1)
        !           148:                                total =+ rowsz;
        !           149:                        /* make new data and fill with blanks   */
        !           150:        q = newdat(CH, 2, total);
        !           151:        q->dim[0] = total/rowsz;
        !           152:        q->dim[1] = rowsz;
        !           153:        mencptr = q->datap;
        !           154:        for(i=0; i<total; i++)
        !           155:                *mencptr++ = ' ';
        !           156:        mencptr = q->datap;
        !           157:                        /* use putchar()to fill up the array   */
        !           158:        mencflg = 2;
        !           159:        ex_hprint();
        !           160:        mencflg = 0;
        !           161:                        /* put it on the stack                  */
        !           162:        push(q);
        !           163: }

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