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 >
Wrap
Text File
|
1986-10-12
|
6KB
|
246 lines
/* 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);
}