/* xlstr - xlisp string builtin functions */ #ifdef AZTEC #include "a:stdio.h" #else #include "stdio.h" #endif #include "xlisp.h" /* external variables */ extern struct node *xlstack; /* external procedures */ extern char *strcat(); /* xstrlen - length of a string */ static struct node *xstrlen(args) struct node *args; { struct node *oldstk,arg,*val; int total; /* create a new stack frame */ oldstk = xlsave(&arg,NULL); /* initialize */ arg.n_ptr = args; total = 0; /* loop over args and total */ while (arg.n_ptr != NULL) total += strlen(xlevmatch(STR,&arg.n_ptr)->n_str); /* restore the previous stack frame */ xlstack = oldstk; /* create the value node */ val = newnode(INT); val->n_int = total; /* return the total */ return (val); } /* xstrcat - concatenate a bunch of strings */ /* this routine does it the dumb way -- one at a time */ static struct node *xstrcat(args) struct node *args; { struct node *oldstk,arg,val,rval; int newlen; char *result,*argstr,*newstr; /* create a new stack frame */ oldstk = xlsave(&arg,&val,&rval,NULL); /* initialize */ arg.n_ptr = args; rval.n_ptr = newnode(STR); rval.n_ptr->n_str = result = stralloc(0); *result = 0; /* loop over args */ while (arg.n_ptr != NULL) { /* get next argument */ val.n_ptr = xlevmatch(STR,&arg.n_ptr); argstr = val.n_ptr->n_str; /* compute length of result */ newlen = strlen(result) + strlen(argstr); /* allocate string and copy */ newstr = stralloc(newlen); strcpy(newstr,result); strfree(result); rval.n_ptr->n_str = result = strcat(newstr,argstr); } /* restore the previous stack frame */ xlstack = oldstk; /* return the new string */ return (rval.n_ptr); } /* substr - return a substring */ static struct node *substr(args) struct node *args; { struct node *oldstk,arg,src,val; int start,forlen,srclen; char *srcptr,*dstptr; /* create a new stack frame */ oldstk = xlsave(&arg,&src,&val,NULL); /* initialize */ arg.n_ptr = args; /* get string and its length */ src.n_ptr = xlevmatch(STR,&arg.n_ptr); srcptr = src.n_ptr->n_str; srclen = strlen(srcptr); /* get starting pos -- must be present */ start = xlevmatch(INT,&arg.n_ptr)->n_int; /* get length -- if not present use remainder of string */ if (arg.n_ptr != NULL) forlen = xlevmatch(INT,&arg.n_ptr)->n_int; else forlen = srclen; /* use len and fix below */ /* make sure there aren't any more arguments */ xllastarg(arg.n_ptr); /* don't take more than exists */ if (start + forlen > srclen) forlen = srclen - start + 1; /* if start beyond string -- return null string */ if (start > srclen) { start = 1; forlen = 0; } /* create return node */ val.n_ptr = newnode(STR); val.n_ptr->n_str = dstptr = stralloc(forlen); /* move string */ for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++) ; *dstptr = 0; /* restore the previous stack frame */ xlstack = oldstk; /* return the substring */ return (val.n_ptr); } /* ascii - return ascii value */ static struct node *ascii(args) struct node *args; { struct node *oldstk,val; /* create a new stack frame */ oldstk = xlsave(&val,NULL); /* build return node */ val.n_ptr = newnode(INT); val.n_ptr->n_int = *(xlevmatch(STR,&args)->n_str); /* make sure there aren't any more arguments */ xllastarg(args); /* restore the previous stack frame */ xlstack = oldstk; /* return the character */ return (val.n_ptr); } /* chr - convert an INT into a one character ascii string */ static struct node *chr(args) struct node *args; { struct node *oldstk,val; char *sptr; /* create a new stack frame */ oldstk = xlsave(&val,NULL); /* build return node */ val.n_ptr = newnode(STR); val.n_ptr->n_str = sptr = stralloc(1); *sptr++ = xlevmatch(INT,&args)->n_int; *sptr = 0; /* make sure there aren't any more arguments */ xllastarg(args); /* restore the previous stack frame */ xlstack = oldstk; /* return the new string */ return (val.n_ptr); } /* xatoi - convert an ascii string to an integer */ static struct node *xatoi(args) struct node *args; { struct node *val; int n; /* get the string and convert it */ n = atoi(xlevmatch(STR,&args)->n_str); /* make sure there aren't any more arguments */ xllastarg(args); /* create the value node */ val = newnode(INT); val->n_int = n; /* return the number */ return (val); } /* xitoa - convert an integer to an ascii string */ static struct node *xitoa(args) struct node *args; { struct node *val; char buf[20]; /* get the integer and convert it */ sprintf(buf,"%d",xlevmatch(INT,&args)->n_int); /* make sure there aren't any more arguments */ xllastarg(args); /* create the value node */ val = newnode(STR); val->n_str = strsave(buf); /* return the string */ return (val); } /* xlsinit - xlisp string initialization routine */ xlsinit() { xlsubr("strlen",xstrlen); xlsubr("strcat",xstrcat); xlsubr("substr",substr); xlsubr("ascii",ascii); xlsubr("chr", chr); xlsubr("atoi",xatoi); xlsubr("itoa",xitoa); }