Return to strprc.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / rt

Annotation of 43BSD/contrib/icon/rt/strprc.c, revision 1.1.1.1

1.1       root        1: #include <ctype.h>
                      2: #include "../h/rt.h"
                      3: #ifdef XPX
                      4: #include "../h/pnames.h"
                      5: /*
                      6:  * strprc - Convert the qualified string named by *d into a procedure
                      7:  *  descriptor if possible.  n is the number of arguments that the desired
                      8:  *  procedure has.  n is only used when the name of the procedure is
                      9:  *  non-alphabetic (hence, an operator).
                     10:  *  A return value of 1 indicates successful conversion.
                     11:  *  0 indicates that the string could not be converted.
                     12:  */
                     13: strprc(d,n)
                     14: struct descrip *d;
                     15: int n;
                     16:    {
                     17:       extern struct descrip *gnames, *globals, *eglobals;
                     18:       struct descrip *np, *gp;
                     19:       struct pstrnm *p;
                     20:       char *s;
                     21:       int ns, l;
                     22:       
                     23:       /*
                     24:        * Look in global name list first.
                     25:        */
                     26:       np = gnames; gp = globals;
                     27:       while (gp < eglobals) {
                     28:          if (!lexcmp(np++,d))
                     29:             if (BLKLOC(*gp)->proc.type == T_PROC) {
                     30:                STRLEN(*d) = D_PROC; /* really type field */
                     31:                BLKLOC(*d) = BLKLOC(*gp);
                     32:                return 1;
                     33:                }
                     34:          gp++;
                     35:          }
                     36:       /*
                     37:        * The name is not a global, see if it is a builtin or an operator.
                     38:        */
                     39:       s = STRLOC(*d);
                     40:       l = STRLEN(*d);
                     41:       for (p = pntab; p->pstrep; p++)
                     42:          /*
                     43:           * Compare the desired name with each standard procedure/operator
                     44:           *  name.
                     45:           */
                     46:          if (!slcmp(s,l,p->pstrep)) {
                     47:             if (isalpha(*s)) {
                     48:                /*
                     49:                 * The names are the same and s starts with an alphabetic,
                     50:                 *  so it's the one being looked for; return it.
                     51:                 */
                     52:                STRLEN(*d) = D_PROC;
                     53:                BLKLOC(*d) = (union block *) p->pblock;
                     54:                return 1;
                     55:                }
                     56:             if ((ns = p->pblock->nstatic) < 0)
                     57:                ns = -ns;
                     58:             else
                     59:                ns = p->pblock->nparam;
                     60:             if (n == ns) {
                     61:                STRLEN(*d) = D_PROC; /* really type field */
                     62:                BLKLOC(*d) = (union block *) p->pblock;
                     63:                return 1;
                     64:                }
                     65:             }
                     66:       return 0;
                     67:    }
                     68: 
                     69: /*
                     70:  * slcmp - lexically compare l1 bytes of s1 with null-terminated s2.
                     71:  */
                     72: 
                     73: slcmp(s1, l1, s2)
                     74: int l1;
                     75: char *s1,*s2;
                     76:    {
                     77:    register int minlen;
                     78:    int l2;
                     79: 
                     80:    l2 = strlen(s2);
                     81: 
                     82:    minlen = (l1 <= l2) ? l1 : l2;
                     83: 
                     84:    while (minlen--)
                     85:       if (*s1++ != *s2++)
                     86:          return ((*--s1 & 0377) - (*--s2 & 0377));
                     87: 
                     88:    return (l1 - l2);
                     89:    }
                     90: #else XPX
                     91: char junk;     /* prevent null object module */
                     92: #endif XPX

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