home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP11.ARK / XLSTR.C < prev    next >
Text File  |  1986-10-12  |  6KB  |  246 lines
  1. /* xlstr - xlisp string builtin functions */
  2.  
  3. #ifdef AZTEC
  4. #include "a:stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13.  
  14. /* external procedures */
  15. extern char *strcat();
  16.  
  17. /* xstrlen - length of a string */
  18. static struct node *xstrlen(args)
  19.   struct node *args;
  20. {
  21.     struct node *oldstk,arg,*val;
  22.     int total;
  23.  
  24.     /* create a new stack frame */
  25.     oldstk = xlsave(&arg,NULL);
  26.  
  27.     /* initialize */
  28.     arg.n_ptr = args;
  29.     total = 0;
  30.  
  31.     /* loop over args and total */
  32.     while (arg.n_ptr != NULL)
  33.     total += strlen(xlevmatch(STR,&arg.n_ptr)->n_str);
  34.  
  35.     /* restore the previous stack frame */
  36.     xlstack = oldstk;
  37.  
  38.     /* create the value node */
  39.     val = newnode(INT);
  40.     val->n_int = total;
  41.  
  42.     /* return the total */
  43.     return (val);
  44. }
  45.  
  46. /* xstrcat - concatenate a bunch of strings */
  47. /*        this routine does it the dumb way -- one at a time */
  48. static struct node *xstrcat(args)
  49.   struct node *args;
  50. {
  51.     struct node *oldstk,arg,val,rval;
  52.     int newlen;
  53.     char *result,*argstr,*newstr;
  54.  
  55.     /* create a new stack frame */
  56.     oldstk = xlsave(&arg,&val,&rval,NULL);
  57.  
  58.     /* initialize */
  59.     arg.n_ptr = args;
  60.     rval.n_ptr = newnode(STR);
  61.     rval.n_ptr->n_str = result = stralloc(0);
  62.     *result = 0;
  63.  
  64.     /* loop over args */
  65.     while (arg.n_ptr != NULL) {
  66.  
  67.     /* get next argument */
  68.     val.n_ptr = xlevmatch(STR,&arg.n_ptr);
  69.     argstr = val.n_ptr->n_str;
  70.  
  71.     /* compute length of result */
  72.     newlen = strlen(result) + strlen(argstr);
  73.  
  74.     /* allocate string and copy */
  75.     newstr = stralloc(newlen);
  76.     strcpy(newstr,result);
  77.     strfree(result);
  78.     rval.n_ptr->n_str = result = strcat(newstr,argstr);
  79.     }
  80.  
  81.     /* restore the previous stack frame */
  82.     xlstack = oldstk;
  83.  
  84.     /* return the new string */
  85.     return (rval.n_ptr);
  86. }
  87.  
  88. /* substr - return a substring */
  89. static struct node *substr(args)
  90.   struct node *args;
  91. {
  92.     struct node *oldstk,arg,src,val;
  93.     int start,forlen,srclen;
  94.     char *srcptr,*dstptr;
  95.  
  96.     /* create a new stack frame */
  97.     oldstk = xlsave(&arg,&src,&val,NULL);
  98.  
  99.     /* initialize */
  100.     arg.n_ptr = args;
  101.     
  102.     /* get string and its length */
  103.     src.n_ptr = xlevmatch(STR,&arg.n_ptr);
  104.     srcptr = src.n_ptr->n_str;
  105.     srclen = strlen(srcptr);
  106.  
  107.     /* get starting pos -- must be present */
  108.     start = xlevmatch(INT,&arg.n_ptr)->n_int;
  109.  
  110.     /* get length -- if not present use remainder of string */
  111.     if (arg.n_ptr != NULL)
  112.     forlen = xlevmatch(INT,&arg.n_ptr)->n_int;
  113.     else
  114.     forlen = srclen;        /* use len and fix below */
  115.  
  116.     /* make sure there aren't any more arguments */
  117.     xllastarg(arg.n_ptr);
  118.  
  119.     /* don't take more than exists */
  120.     if (start + forlen > srclen)
  121.     forlen = srclen - start + 1;
  122.  
  123.     /* if start beyond string -- return null string */
  124.     if (start > srclen) {
  125.     start = 1;
  126.     forlen = 0; }
  127.     
  128.     /* create return node */
  129.     val.n_ptr = newnode(STR);
  130.     val.n_ptr->n_str = dstptr = stralloc(forlen);
  131.  
  132.     /* move string */
  133.     for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
  134.     ;
  135.     *dstptr = 0;
  136.  
  137.     /* restore the previous stack frame */
  138.     xlstack = oldstk;
  139.  
  140.     /* return the substring */
  141.     return (val.n_ptr);
  142. }
  143.  
  144. /* ascii - return ascii value */
  145. static struct node *ascii(args)
  146.   struct node *args;
  147. {
  148.     struct node *oldstk,val;
  149.  
  150.     /* create a new stack frame */
  151.     oldstk = xlsave(&val,NULL);
  152.  
  153.     /* build return node */
  154.     val.n_ptr = newnode(INT);
  155.     val.n_ptr->n_int = *(xlevmatch(STR,&args)->n_str);
  156.  
  157.     /* make sure there aren't any more arguments */
  158.     xllastarg(args);
  159.  
  160.     /* restore the previous stack frame */
  161.     xlstack = oldstk;
  162.  
  163.     /* return the character */
  164.     return (val.n_ptr);
  165. }
  166.  
  167. /* chr - convert an INT into a one character ascii string */
  168. static struct node *chr(args)
  169.   struct node *args;
  170. {
  171.     struct node *oldstk,val;
  172.     char *sptr;
  173.  
  174.     /* create a new stack frame */
  175.     oldstk = xlsave(&val,NULL);
  176.  
  177.     /* build return node */
  178.     val.n_ptr = newnode(STR);
  179.     val.n_ptr->n_str = sptr = stralloc(1);
  180.     *sptr++ = xlevmatch(INT,&args)->n_int;
  181.     *sptr = 0;
  182.  
  183.     /* make sure there aren't any more arguments */
  184.     xllastarg(args);
  185.  
  186.     /* restore the previous stack frame */
  187.     xlstack = oldstk;
  188.  
  189.     /* return the new string */
  190.     return (val.n_ptr);
  191. }
  192.  
  193. /* xatoi - convert an ascii string to an integer */
  194. static struct node *xatoi(args)
  195.   struct node *args;
  196. {
  197.     struct node *val;
  198.     int n;
  199.  
  200.     /* get the string and convert it */
  201.     n = atoi(xlevmatch(STR,&args)->n_str);
  202.  
  203.     /* make sure there aren't any more arguments */
  204.     xllastarg(args);
  205.  
  206.     /* create the value node */
  207.     val = newnode(INT);
  208.     val->n_int = n;
  209.  
  210.     /* return the number */
  211.     return (val);
  212. }
  213.  
  214. /* xitoa - convert an integer to an ascii string */
  215. static struct node *xitoa(args)
  216.   struct node *args;
  217. {
  218.     struct node *val;
  219.     char buf[20];
  220.  
  221.     /* get the integer and convert it */
  222.     sprintf(buf,"%d",xlevmatch(INT,&args)->n_int);
  223.  
  224.     /* make sure there aren't any more arguments */
  225.     xllastarg(args);
  226.  
  227.     /* create the value node */
  228.     val = newnode(STR);
  229.     val->n_str = strsave(buf);
  230.  
  231.     /* return the string */
  232.     return (val);
  233. }
  234.  
  235. /* xlsinit - xlisp string initialization routine */
  236. xlsinit()
  237. {
  238.     xlsubr("strlen",xstrlen);
  239.     xlsubr("strcat",xstrcat);
  240.     xlsubr("substr",substr);
  241.     xlsubr("ascii",ascii);
  242.     xlsubr("chr", chr);
  243.     xlsubr("atoi",xatoi);
  244.     xlsubr("itoa",xitoa);
  245. }
  246.