Return to fconv.c CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx

Annotation of researchv10dc/cmd/icon/src/iconx/fconv.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * File: fconv.c
        !             3:  *  Contents: abs, cset, integer, list, numeric, proc, real, set, string, table
        !             4:  */
        !             5: 
        !             6: #include "../h/rt.h"
        !             7: 
        !             8: /*
        !             9:  * abs(x) - absolute value of x.
        !            10:  */
        !            11: FncDcl(abs,1)
        !            12:    {
        !            13:    union numeric result;
        !            14: 
        !            15:    switch (cvnum(&Arg1, &result)) {
        !            16:       /*
        !            17:        * If x is convertible to a numeric, turn Arg0 into
        !            18:        *  a descriptor for the appropriate type and value.  If the
        !            19:        *  conversion fails, produce an error.  This code assumes that
        !            20:        *  x = -x is always valid, but this assumption does not always
        !            21:        *  hold.
        !            22:        */
        !            23:       case T_Integer:
        !            24:       case T_Longint:
        !            25:          if (result.integer < 0L)
        !            26:             result.integer = -result.integer;
        !            27:          Mkint(result.integer, &Arg0);
        !            28:          break;
        !            29: 
        !            30:       case T_Real:
        !            31:          if (result.real < 0.0)
        !            32:             result.real = -result.real;
        !            33:          mkreal(result.real, &Arg0);
        !            34:          break;
        !            35: 
        !            36:       default:
        !            37:          runerr(102, &Arg1);
        !            38:       }
        !            39:    Return;
        !            40:    }
        !            41: 
        !            42: 
        !            43: /*
        !            44:  * cset(x) - convert x to cset.
        !            45:  */
        !            46: 
        !            47: FncDcl(cset,1)
        !            48:    {
        !            49:    register int i, j;
        !            50:    register struct b_cset *bp;
        !            51:    int *cs, csbuf[CsetSize];
        !            52:    extern struct b_cset *alccset();
        !            53: 
        !            54:    blkreq((word)sizeof(struct b_cset));
        !            55: 
        !            56:    if (Arg1.dword == D_Cset)
        !            57:       /*
        !            58:        * x is already a cset, just return it.
        !            59:        */
        !            60:       Arg0 = Arg1;
        !            61:    else if (cvcset(&Arg1, &cs, csbuf) != NULL) {
        !            62:       /*
        !            63:        * x was convertible to cset and the result resides in csbuf.  Allocate
        !            64:        *  a cset, make Arg0 a descriptor for it and copy the bits from csbuf
        !            65:        *  into it.
        !            66:        */
        !            67:       Arg0.dword = D_Cset;
        !            68:       bp = alccset(0);
        !            69:       BlkLoc(Arg0) =  (union block *) bp;
        !            70:       for (i = 0; i < CsetSize; i++)
        !            71:          bp->bits[i] = cs[i];
        !            72:       j = 0;
        !            73:       for (i = 0; i < CsetSize*CIntSize; i++) {
        !            74:          if (Testb(i,cs))
        !            75:             j++;
        !            76:          }
        !            77:       bp->size = j;
        !            78:       }
        !            79:    else                        /* Not a cset nor convertible to one. */
        !            80:       Fail;
        !            81:    Return;
        !            82:    }
        !            83: 
        !            84: 
        !            85: /*
        !            86:  * integer(x) - convert x to integer.
        !            87:  */
        !            88: 
        !            89: FncDcl(integer,1)
        !            90:    {
        !            91:    long l;
        !            92: 
        !            93:    switch (cvint(&Arg1, &l)) {
        !            94: 
        !            95:       case T_Integer:
        !            96:       case T_Longint:
        !            97:          Mkint(l, &Arg0);
        !            98:          break;
        !            99: 
        !           100:       default:
        !           101:          Fail;
        !           102:       }
        !           103:    Return;
        !           104:    }
        !           105: 
        !           106: 
        !           107: /*
        !           108:  * list(n,x) - create a list of size n, with initial value x.
        !           109:  */
        !           110: 
        !           111: /* >list */
        !           112: FncDcl(list,2)
        !           113:    {
        !           114:    register word i, size;
        !           115:    word nelem;
        !           116:    register struct b_lelem *bp;
        !           117:    register struct b_list *hp;
        !           118:    extern struct b_list *alclist();
        !           119:    extern struct b_lelem *alclstb();
        !           120: 
        !           121:    defshort(&Arg1, 0);                 /* Size defaults to 0 */
        !           122: 
        !           123:    nelem = size = IntVal(Arg1);
        !           124: 
        !           125: 
        !           126:    /*
        !           127:     * Ensure that the size is positive and that the list element block 
        !           128:     *  has at least MinListSlots element slots.
        !           129:     */
        !           130:    if (size < 0)
        !           131:       runerr(205, &Arg1);
        !           132:    if (nelem < MinListSlots)
        !           133:       nelem = MinListSlots;
        !           134: 
        !           135:    /*
        !           136:     * Ensure space for a list header block, and a list element block
        !           137:     * with nelem element slots.
        !           138:     */
        !           139:    blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
        !           140:          nelem * sizeof(struct descrip));
        !           141: 
        !           142:    /*
        !           143:     * Allocate the list header block and a list element block.
        !           144:     *  Note that nelem is the number of elements in the list element
        !           145:     *  block while size is the number of elements in the
        !           146:     *  list.
        !           147:     */
        !           148:    hp = alclist(size);
        !           149:    bp = alclstb(nelem, (word)0, size);
        !           150:    hp->listhead.dword = hp->listtail.dword = D_Lelem;
        !           151:    BlkLoc(hp->listhead) = BlkLoc(hp->listtail) = (union block *) bp;
        !           152: 
        !           153:    /*
        !           154:     * Initialize each list element.
        !           155:     */
        !           156:    for (i = 0; i < size; i++)
        !           157:       bp->lslots[i] = Arg2;
        !           158: 
        !           159:    /*
        !           160:     * Return the new list.
        !           161:     */
        !           162:    Arg0.dword = D_List;
        !           163:    BlkLoc(Arg0) = (union block *) hp;
        !           164:    Return;
        !           165:    }
        !           166: /* <list */
        !           167: 
        !           168: 
        !           169: /*
        !           170:  * numeric(x) - convert x to numeric type.
        !           171:  */
        !           172: FncDcl(numeric,1)
        !           173:    {
        !           174:    union numeric n1;
        !           175: 
        !           176:    switch (cvnum(&Arg1, &n1)) {
        !           177: 
        !           178:       case T_Integer:
        !           179:       case T_Longint:
        !           180:          Mkint(n1.integer, &Arg0);
        !           181:          break;
        !           182: 
        !           183:       case T_Real:
        !           184:          mkreal(n1.real, &Arg0);
        !           185:          break;
        !           186: 
        !           187:       default:
        !           188:          Fail;
        !           189:       }
        !           190:    Return;
        !           191:    }
        !           192: 
        !           193: 
        !           194: /*
        !           195:  * proc(x,args) - convert x to a procedure if possible; use args to
        !           196:  *  resolve ambiguous string names.
        !           197:  */
        !           198: FncDcl(proc,2)
        !           199:    {
        !           200:    char sbuf[MaxCvtLen];
        !           201:    
        !           202:    /*
        !           203:     * If x is already a proc, just return it in Arg0.
        !           204:     */
        !           205:    Arg0 = Arg1;
        !           206:    if (Arg0.dword == D_Proc) {
        !           207:       Return;
        !           208:       }
        !           209:    if (cvstr(&Arg0, sbuf) == NULL)
        !           210:       Fail;
        !           211:    /*
        !           212:     * args defaults to 1.
        !           213:     */
        !           214:    defshort(&Arg2, 1);
        !           215:    /*
        !           216:     * Attempt to convert Arg0 to a procedure descriptor using args to
        !           217:     *  discriminate between procedures with the same names.  Fail if
        !           218:     *  the conversion isn't successful.
        !           219:     */
        !           220:    if (strprc(&Arg0,IntVal(Arg2))) {
        !           221:       Return;
        !           222:       }
        !           223:    else
        !           224:       Fail;
        !           225:    }
        !           226: 
        !           227: 
        !           228: /*
        !           229:  * real(x) - convert x to real.
        !           230:  */
        !           231: 
        !           232: FncDcl(real,1)
        !           233:    {
        !           234:    double r;
        !           235: 
        !           236:    /*
        !           237:     * If x is already a real, just return it.  Otherwise convert it and
        !           238:     *  return it, failing if the conversion is unsuccessful.
        !           239:     */
        !           240:    if (Arg1.dword == D_Real)
        !           241:       Arg0 = Arg1;
        !           242:    else if (cvreal(&Arg1, &r) == T_Real)
        !           243:       mkreal(r, &Arg0);
        !           244:    else
        !           245:       Fail;
        !           246:    Return;
        !           247:    }
        !           248: 
        !           249: 
        !           250: /*
        !           251:  * set(list) - create a set with members in list.
        !           252:  *  The members are linked into hash chains which are
        !           253:  *  arranged in increasing order by hash number.
        !           254:  */
        !           255: FncDcl(set,1)
        !           256:    {
        !           257:    register word hn;
        !           258:    register struct descrip *pd;
        !           259:    register struct b_set *ps;
        !           260:    union block *pb;
        !           261:    struct b_selem *ne;
        !           262:    struct descrip *pe;
        !           263:    int res;
        !           264:    word i, j;
        !           265:    extern struct descrip *memb();
        !           266:    extern struct b_set *alcset();
        !           267:    extern struct b_selem *alcselem();
        !           268: 
        !           269:    if (Arg1.dword != D_List)
        !           270:       runerr(108,&Arg1);
        !           271: 
        !           272:    blkreq(sizeof(struct b_set) + (BlkLoc(Arg1)->list.size *
        !           273:       sizeof(struct b_selem)));
        !           274: 
        !           275:    pb = BlkLoc(Arg1);
        !           276:    Arg0.dword = D_Set;
        !           277:    ps = alcset();
        !           278:    BlkLoc(Arg0) = (union block *) ps;
        !           279:    /*
        !           280:     * Chain through each list block and for
        !           281:     *  each element contained in the block
        !           282:     *  insert the element into the set if not there.
        !           283:     */
        !           284:    for (Arg1 = pb->list.listhead; Arg1.dword == D_Lelem;
        !           285:       Arg1 = BlkLoc(Arg1)->lelem.listnext) {
        !           286:          pb = BlkLoc(Arg1);
        !           287:          for (i = 0; i < pb->lelem.nused; i++) {
        !           288:             j = pb->lelem.first + i;
        !           289:             if (j >= pb->lelem.nelem)
        !           290:                j -= pb->lelem.nelem;
        !           291:             pd = &pb->lelem.lslots[j];
        !           292:             pe = memb(ps, pd, hn = hash(pd), &res);
        !           293:             if (res == 0) {
        !           294:                ne = alcselem(pd,hn);
        !           295:                 addmem(ps,ne,pe);
        !           296:                 }
        !           297:             }
        !           298:       }
        !           299:    Return;
        !           300:    }
        !           301: 
        !           302: 
        !           303: /*
        !           304:  * string(x) - convert x to string.
        !           305:  */
        !           306: 
        !           307: /* >string */
        !           308: FncDcl(string,1)
        !           309:    {
        !           310:    char sbuf[MaxCvtLen];
        !           311:    extern char *alcstr();
        !           312: 
        !           313:    Arg0 = Arg1;
        !           314:    switch (cvstr(&Arg0, sbuf)) {
        !           315: 
        !           316:       /*
        !           317:        * If Arg1 is not a string, allocate it and return it; if it is a
        !           318:        *  string, just return it; fail otherwise.
        !           319:        */
        !           320:       case Cvt:
        !           321:          strreq(StrLen(Arg0));         /* allocate converted string */
        !           322:          StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
        !           323: 
        !           324:       case NoCvt:
        !           325:          Return;
        !           326: 
        !           327:       default:
        !           328:          Fail;
        !           329:       }
        !           330:    }
        !           331: /* <string */
        !           332: 
        !           333: /*
        !           334:  * table(x) - create a table with default value x.
        !           335:  */
        !           336: FncDcl(table,1)
        !           337:    {
        !           338:    extern struct b_table *alctable();
        !           339: 
        !           340:    blkreq((word)sizeof(struct b_table));
        !           341:    Arg0.dword = D_Table;
        !           342:    BlkLoc(Arg0) = (union block *) alctable(&Arg1);
        !           343:    Return;
        !           344:    }

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