Personal tools
You are here: Home Projects LISP XLISP XLISP 0.0 Sources unpacked xlstr.c
Document Actions

xlstr.c

by Paul McJones last modified 2011-01-24 09:58

Click here to get the file

Size 6.3 kB - File type text/x-csrc

File contents

/* xlstr - xlisp string builtin functions */

#include <stdio.h>
#include <ctype.h>
#include "xlisp.h"

/* external variables */
extern struct node *xlstack;

/* len - length of a string */
static struct node *len(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);

    /* create return node */
    val = newnode(INT);
    val->n_int = total;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the total */
    return (val);
}

/* concat - concatenate a bunch of strings */
/*		this routine does it the dumb way -- one at a time */
static struct node *concat(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 */
    if (arg.n_ptr != NULL)
	xlfail("too many arguments");

    /* 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);
}

/* makstr - make a string of chars of specified length */
static struct node *makestr(args)
  struct node *args;
{
    struct node *oldstk,val,arg;
    char *sptr,*fptr;
    int len;

    /* create a new stack frame */
    oldstk = xlsave(&val,&arg,NULL);

    /* get the length */
    len = xlevmatch(INT,&args)->n_int;

    /* get the character */
    fptr = xlevmatch(STR,&args)->n_str;
    
    /* make sure there aren't any more arguments */
    if (args != NULL)
	xlfail("too many arguments");

    /* build return node */
    val.n_ptr = newnode(STR);
    val.n_ptr->n_str = sptr = stralloc(len);

    /* fill with desired char */
    while (len--) *sptr++ = *fptr;
    *sptr = 0;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the new string */
    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 */
    if (args != NULL)
	xlfail("too many arguments");

    /* 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 */
    if (args != NULL)
	xlfail("too many arguments");

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the new string */
    return (val.n_ptr);
}

/* readchr - read a character from terminal */
static struct node *readchr()
{
    struct node *oldstk,val;
    char *cptr;

    /* create a new stack frame */
    oldstk = xlsave(&val,NULL);

    /* clear any output */
    fflush(stdout);

    /* build return node */
    val.n_ptr = newnode(STR);
    val.n_ptr->n_str = cptr = stralloc(1);
    *cptr++ = kbin();
    *cptr = 0;    

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the new string */
    return (val.n_ptr);
}

/* getnum - parse a number */
static struct node *getnum()
{
    struct node *val;
    int ch,ival,sign;

    /* initialize the node */
    val = newnode(INT);
    val->n_int = 0;

    /* first might be sign */
    ival = 0;
    switch (ch = kbin()) {
	case '+' : sign =  1; break;
	case '-' : sign = -1; break;
	default:   if (!isdigit(ch))
			return(val);		/* no value */
		    else { sign =  1; ival = ch - '0'; }
    }
	

    /* loop looking for digits */
    for (;
	 (ch = kbin()) > 0 && isdigit(ch);
	 ival = ival * 10 + ch - '0')
	;

    val->n_int = ival * sign;

    /* return the new number */
    return (val);
}

/* xlsinit - xlisp string initialization routine */
xlsinit()
{
    xlsubr("len",len);
    xlsubr("concat",concat);
    xlsubr("substr",substr);
    xlsubr("makestr", makestr);
    xlsubr("ascii",ascii);
    xlsubr("chr", chr);
    xlsubr("readchr", readchr);
    xlsubr("getnum", getnum);
}
December 2013 »
Su Mo Tu We Th Fr Sa
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: