[net.sources] resubmission of xlisp4.txt

betz (04/11/83)

This file is xlisp4.txt
<<<<<<<<<< xlstr.c >>>>>>>>>>
/* xlstr - xlisp string builtin functions */

#include <stdio.h>
#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);
}
<<<<<<<<<< xlsubr.c >>>>>>>>>>
/* xlsubr - xlisp builtin functions */

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

/* external variables */
extern int (*xlgetc)();
extern struct node *xlstack;

/* local variables */
static char *sgetptr;

/* xlsubr - define a builtin function */
xlsubr(sname,subr)
  char *sname; struct node *(*subr)();
{
    struct node *sym;

    /* enter the symbol */
    sym = xlenter(sname);

    /* initialize the value */
    sym->n_symvalue = newnode(SUBR);
    sym->n_symvalue->n_subr = subr;
}

/* xlsvar - define a builtin string variable */
xlsvar(sname,str)
  char *sname,*str;
{
    struct node *sym;

    /* enter the symbol */
    sym = xlenter(sname);

    /* initialize the value */
    sym->n_symvalue = newnode(STR);
    sym->n_symvalue->n_str = strsave(str);
}

/* xlarg - get the next argument */
struct node *xlarg(pargs)
  struct node **pargs;
{
    struct node *arg;

    /* make sure the argument exists */
    if (*pargs == NULL)
	xlfail("too few arguments");

    /* get the argument value */
    arg = (*pargs)->n_listvalue;

    /* move the argument pointer ahead */
    *pargs = (*pargs)->n_listnext;

    /* return the argument */
    return (arg);
}

/* xlmatch - get an argument and match its type */
struct node *xlmatch(type,pargs)
  int type; struct node **pargs;
{
    struct node *arg;

    /* get the argument */
    arg = xlarg(pargs);

    /* check its type */
    if (type == LIST) {
	if (arg != NULL && arg->n_type != LIST)
	    xlfail("bad argument type");
    }
    else {
	if (arg == NULL || arg->n_type != type)
	    xlfail("bad argument type");
    }

    /* return the argument */
    return (arg);
}

/* xlevarg - get the next argument and evaluate it */
struct node *xlevarg(pargs)
  struct node **pargs;
{
    struct node *oldstk,val;

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

    /* get the argument */
    val.n_ptr = xlarg(pargs);

    /* evaluate the argument */
    val.n_ptr = xleval(val.n_ptr);

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

    /* return the argument */
    return (val.n_ptr);
}

/* xlevmatch - get an evaluated argument and match its type */
struct node *xlevmatch(type,pargs)
  int type; struct node **pargs;
{
    struct node *arg;

    /* get the argument */
    arg = xlevarg(pargs);

    /* check its type */
    if (type == LIST) {
	if (arg != NULL && arg->n_type != LIST)
	    xlfail("bad argument type");
    }
    else {
	if (arg == NULL || arg->n_type != type)
	    xlfail("bad argument type");
    }

    /* return the argument */
    return (arg);
}

/* xllastarg - make sure the remainder of the argument list is empty */
xllastarg(args)
  struct node *args;
{
    if (args != NULL)
	xlfail("too many arguments");
}

/* assign - assign a value to a symbol */
static assign(sym,val)
  struct node *sym,*val;
{
    struct node *lptr;

    /* check for a current object */
    if ((lptr = xlobsym(sym)) != NULL)
	lptr->n_listvalue = val;
    else
	sym->n_symvalue = val;
}

/* set - builtin function set */
static struct node *set(args)
  struct node *args;
{
    struct node *oldstk,arg,sym,val;

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

    /* initialize */
    arg.n_ptr = args;

    /* get the symbol */
    sym.n_ptr = xlevmatch(SYM,&arg.n_ptr);

    /* get the new value */
    val.n_ptr = xlevarg(&arg.n_ptr);

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* assign the symbol the value of argument 2 and the return value */
    assign(sym.n_ptr,val.n_ptr);

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

    /* return the result value */
    return (val.n_ptr);
}

/* setq - builtin function setq */
static struct node *setq(args)
  struct node *args;
{
    struct node *oldstk,arg,sym,val;

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

    /* initialize */
    arg.n_ptr = args;

    /* get the symbol */
    sym.n_ptr = xlmatch(SYM,&arg.n_ptr);

    /* get the new value */
    val.n_ptr = xlevarg(&arg.n_ptr);

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* assign the symbol the value of argument 2 and the return value */
    assign(sym.n_ptr,val.n_ptr);

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

    /* return the result value */
    return (val.n_ptr);
}

/* load - direct input from a file */
static struct node *load(args)
  struct node *args;
{
    struct node *fname;

    /* get the file name */
    fname = xlevmatch(STR,&args);

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* direct input from the file */
    xlfin(fname->n_str);

    /* return the filename */
    return (fname);
}

/* defun - builtin function defun */
static struct node *defun(args)
  struct node *args;
{
    struct node *oldstk,arg,sym,fargs,*fun;

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

    /* initialize */
    arg.n_ptr = args;

    /* get the function symbol */
    sym.n_ptr = xlmatch(SYM,&arg.n_ptr);

    /* get the formal argument list */
    fargs.n_ptr = xlmatch(LIST,&arg.n_ptr);

    /* create a new function definition */
    fun = newnode(LIST);
    fun->n_listvalue = fargs.n_ptr;
    fun->n_listnext = arg.n_ptr;

    /* make the symbol point to a new function definition */
    assign(sym.n_ptr,fun);

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

    /* return the function symbol */
    return (sym.n_ptr);
}

/* sgetc - get a character from a string */
static int sgetc()
{
    if (*sgetptr == 0)
	return (-1);
    else
	return (*sgetptr++);
}

/* read - read an expression */
static struct node *read(args)
  struct node *args;
{
    struct node *val;
    int (*oldgetc)();

    /* save the old input stream */
    oldgetc = xlgetc;

    /* get the string or file pointer */
    if (args != NULL) {
	sgetptr = xlevmatch(STR,&args)->n_str;
	xlgetc = sgetc;
    }

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* read an expression */
    val = xlread();

    /* restore the old input stream */
    xlgetc = oldgetc;

    /* return the expression read */
    return (val);
}

/* fwhile - builtin function while */
static struct node *fwhile(args)
  struct node *args;
{
    struct node *oldstk,farg,arg,*val;

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

    /* initialize */
    farg.n_ptr = arg.n_ptr = args;

    /* loop until test fails */
    for (; TRUE; arg.n_ptr = farg.n_ptr) {

	/* evaluate the test expression */
	if (!testvalue(val = xlevarg(&arg.n_ptr)))
	    break;

	/* evaluate each remaining argument */
	while (arg.n_ptr != NULL)
	    xlevarg(&arg.n_ptr);
    }

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

    /* return the last test expression value */
    return (val);
}

/* foreach - builtin function foreach */
static struct node *foreach(args)
  struct node *args;
{
    struct node *oldstk,arg,sym,list,code,oldbnd,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&sym,&list,&code,&oldbnd,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the symbol to bind to each list element */
    sym.n_ptr = xlmatch(SYM,&arg.n_ptr);

    /* save the old binding of the symbol */
    oldbnd.n_ptr = sym.n_ptr->n_symvalue;

    /* get the list to iterate over */
    list.n_ptr = xlevmatch(LIST,&arg.n_ptr);

    /* save the pointer to the code */
    code.n_ptr = arg.n_ptr;

    /* loop until test fails */
    val = NULL;
    while (list.n_ptr != NULL) {

	/* check the node type */
	if (list.n_ptr->n_type != LIST)
	    xlfail("bad node type in list");

	/* bind the symbol to the list element */
	sym.n_ptr->n_symvalue = list.n_ptr->n_listvalue;

	/* evaluate each remaining argument */
	while (arg.n_ptr != NULL)
	    val = xlevarg(&arg.n_ptr);

	/* point to the next list element */
	list.n_ptr = list.n_ptr->n_listnext;

	/* restore the pointer to the code */
	arg.n_ptr = code.n_ptr;
    }

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

    /* restore the old binding of the symbol */
    sym.n_ptr->n_symvalue = oldbnd.n_ptr;

    /* return the last test expression value */
    return (val);
}

/* fif - builtin function if */
static struct node *fif(args)
  struct node *args;
{
    struct node *oldstk,arg,testexpr,thenexpr,elseexpr,*val;
    int dothen;

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

    /* initialize */
    arg.n_ptr = args;

    /* evaluate the test expression */
    testexpr.n_ptr = xlevarg(&arg.n_ptr);

    /* get the then clause */
    thenexpr.n_ptr = xlmatch(LIST,&arg.n_ptr);

    /* get the else clause */
    if (arg.n_ptr != NULL)
	elseexpr.n_ptr = xlmatch(LIST,&arg.n_ptr);
    else
	elseexpr.n_ptr = NULL;

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* figure out which expression to evaluate */
    dothen = testvalue(testexpr.n_ptr);

    /* default the result value to the value of the test expression */
    val = testexpr.n_ptr;

    /* evaluate the appropriate clause */
    if (dothen)
	while (thenexpr.n_ptr != NULL)
	    val = xlevarg(&thenexpr.n_ptr);
    else
	while (elseexpr.n_ptr != NULL)
	    val = xlevarg(&elseexpr.n_ptr);

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

    /* return the last value */
    return (val);
}

/* quote - builtin function to quote an expression */
static struct node *quote(args)
  struct node *args;
{
    /* make sure there is exactly one argument */
    if (args == NULL || args->n_listnext != NULL)
	xlfail("incorrect number of arguments");

    /* return the quoted expression */
    return (args->n_listvalue);
}

/* fexit - get out of xlisp */
fexit()
{
    exit();
}

/* testvalue - test a value for true or false */
static int testvalue(val)
  struct node *val;
{
    /* check for a nil value */
    if (val == NULL)
	return (FALSE);

    /* check the value type */
    switch (val->n_type) {
    case INT:
	    return (val->n_int != 0);
    case STR:
	    return (strlen(val->n_str) != 0);
    default:
	    return (TRUE);
    }
}

/* xlinit - xlisp initialization routine */
xlinit()
{
    xlsubr("set",set);
    xlsubr("setq",setq);
    xlsubr("load",load);
    xlsubr("read",read);
    xlsubr("quote",quote);
    xlsubr("while",fwhile);
    xlsubr("foreach",foreach);
    xlsubr("defun",defun);
    xlsubr("if",fif);
    xlsubr("exit",fexit);
}
<<<<<<<<<< xlisp.h >>>>>>>>>>
/* xlisp - a small subset of lisp */

/* system specific definitions */

/* DEFEXT	define to enable default extension of '.lsp' on 'load' */
/* FGETNAME	define if system supports 'fgetname' */
/* CNTRLGBREAK	define if control-g is a break character */

/* for the VAX-11 C compiler */
#ifdef vms
#define DEFEXT
#define FGETNAME
#define CNTRLGBREAK
#endif

/* for the DECUS C compiler */
#ifdef decusc
#define DEFEXT		/* enable extension defaulting on 'load' */
#define CNTRLGBREAK	/* control-g is a break character */
#endif

/* for unix compilers */
#ifdef unix
#endif

/* for the AZTEC C compiler */
#ifdef aztec
#define DEFEXT
#define getc(fp)	getch(fp)
#define kbin()		CPM(6,0xFF)
#define malloc		alloc
#endif

/* useful definitions */
#define TRUE	1
#define FALSE	0

/* program limits */
#define STRMAX	100	/* maximum length of a string constant */
#define NNODES	200	/* number of nodes to allocate in each request */
#define TDEPTH	100	/* trace stack depth */

/* node types */
#define FREE	0
#define SUBR	1
#define LIST	2
#define SYM	3
#define INT	4
#define STR	5
#define OBJ	6
#define FPTR	7
#define KMAP	8

/* node flags */
#define MARK	1
#define LEFT	2

/* string types */
#define DYNAMIC	0
#define STATIC	1

/* symbol structure */
struct xsym {
    char *xsy_name;		/* symbol name */
    struct node *xsy_value;	/* the current value */
};

/* subr node structure */
struct xsubr {
    struct node *(*xsu_subr)();	/* pointer to an internal routine */
};

/* list node structure */
struct xlist {
    struct node *xl_value;	/* value at this node */
    struct node *xl_next;	/* next node */
};

/* integer node structure */
struct xint {
    int xi_int;			/* integer value */
};

/* string node structure */
struct xstr {
    int xst_type;		/* string type */
    char *xst_str;		/* string pointer */
};

/* object node structure */
struct xobj {
    struct node *xo_obclass;	/* class of object */
    struct node *xo_obdata;	/* instance data */
};

/* file pointer node structure */
struct xfptr {
    FILE *xf_fp;		/* the file pointer */
};

/* keymap structure */
struct xkmap {
    struct node *(*xkm_map)[];	/* selection pointer */
};


/* shorthand macros for accessing node substructures */

/* symbol node */
#define n_symname	n_info.n_xsym.xsy_name
#define n_symvalue	n_info.n_xsym.xsy_value

/* subr node */
#define n_subr		n_info.n_xsubr.xsu_subr

/* list node (and message node and binding node) */
#define n_listvalue	n_info.n_xlist.xl_value
#define n_listnext	n_info.n_xlist.xl_next
#define n_msg		n_info.n_xlist.xl_value
#define n_msgcode	n_info.n_xlist.xl_next
#define n_bndsym	n_info.n_xlist.xl_value
#define n_bndvalue	n_info.n_xlist.xl_next
#define n_left		n_info.n_xlist.xl_value
#define n_right		n_info.n_xlist.xl_next
#define n_ptr		n_info.n_xlist.xl_value

/* integer node */
#define n_int		n_info.n_xint.xi_int

/* string node */
#define n_str		n_info.n_xstr.xst_str
#define n_strtype	n_info.n_xstr.xst_type

/* object node */
#define n_obclass	n_info.n_xobj.xo_obclass
#define n_obdata	n_info.n_xobj.xo_obdata

/* file pointer node */
#define n_fname		n_info.n_xfptr.xf_name
#define n_fp		n_info.n_xfptr.xf_fp

/* key map node */
#define n_kmap		n_info.n_xkmap.xkm_map

/* node structure */
struct node {
    char n_type;		/* type of node */
    char n_flags;		/* flag bits */
    union {			/* value */
	struct xsym n_xsym;	/*     symbol node */
	struct xsubr n_xsubr;	/*     subr node */
	struct xlist n_xlist;	/*     list node */
	struct xint n_xint;	/*     integer node */
	struct xstr n_xstr;	/*     string node */
	struct xobj n_xobj;	/*     object node */
	struct xfptr n_xfptr;	/*     file pointer node */
	struct xkmap n_xkmap;	/*     key map node */
    } n_info;
};

/* external procedure declarations */
extern struct node *xlread();		/* read an expression */
extern struct node *xleval();		/* evaluate an expression */
extern struct node *xlarg();		/* fetch an argument */
extern struct node *xlevarg();		/* fetch and evaluate an argument */
extern struct node *xlmatch();		/* fetch an typed argument */
extern struct node *xlevmatch();	/* fetch and evaluate a typed arg */
extern struct node *xlsend();		/* send a message to an object */
extern struct node *xlmfind();		/* find the method for a message */
extern struct node *xlxsend();		/* execute a message method */
extern struct node *xlenter();		/* enter a symbol into the oblist */
extern struct node *xlsave();		/* generate a stack frame */
extern struct node *xlobsym();		/* find an object's class or instance
					   variable */
extern struct node *xlclass();		/* enter a class definition */
extern struct node *xlivar();		/* get an instance variable */
extern struct node *xlcvar();		/* get an instance variable */
extern struct node *newnode();		/* allocate a new node */

extern char *stralloc();		/* allocate string space */
extern char *strsave();			/* make a safe copy of a string */
<<<<<<<<<< junk.c >>>>>>>>>>
#include "stdio.h"
#include "xlisp.h"

char *fgetname()
{
	return ("a file");
}
char *strchr(str,ch)
  char *str; int ch;
{
	for (; *str; str++)
		if (*str == ch)
			return (str);
	return (NULL);
}
int getch(fp)
  FILE *fp;
{
	int ch;

	if ((ch = agetc(fp)) == '\032')
		return (EOF);
	else
		return (ch);
}
char *calloc(n,size)
  unsigned n,size;
{
	char *str;
	unsigned nsize,i;

	if ((str = malloc(nsize = n * size)) == NULL)
		return (NULL);
	for (i = 0; i < nsize; i++)
		str[i] = 0;
	return (str);
}
<<<<<<<<<< setjmp.h >>>>>>>>>>
typedef int jmp_buf[14];
<<<<<<<<<< setjmp.asm >>>>>>>>>>
;setjmp/longjmp support for Aztec C
;Mark E. Mallett 830127
;

	public	setjmp_
	public	longjmp_


;
; setjmp			i = setjmp(env)
;
;		returns 0 if setting
;			val if longjmping
;

setjmp_:
	DB	0EDH,073H	; LD (nn),SP
	DW	osp		;   nn..
	pop	h		; Get return address
	shld	raddr		; Save it
	pop	h		; get address of env buffer
	shld	envadr		; Save it

	DB	011H		; ld de,nn   .. Find the end of the jmp buffer
	 DW	10		;       nn
	DB	019H		; ADD HL,DE
	shld	nsp		; Save so I can pick it up...
	DB	0EDH,07BH	; ... here   ( ld sp,(nn)  )
	DW	nsp		;                    ..NN..

	push	b		; save things in jmp buffer
	db	0DDH,0E5H	; push ix
	db	0FDH,0E5H	; push iy
	lhld	raddr		; save return address
	push	h
	lhld	osp		; save original stack pointer
	push	h

	lxi	h,0		; set return value to 0
	shld	val
	jp	ljret		; go return as if from longjump



; longjmp			longjmp (env,val)
;			returns val to where setjmp was called
;

longjmp_:
	lxi	h,2		; Find addr of env
	dad	sp		;     .
	mov	e,m		; get it in de
	inx	h
	mov	d,m
	inx	h
	DB	0EDH,053H	; ld (nn),de
	DW	envadr
	mov	e,m		; get value
	inx	h
	mov	d,m
	DB	0EDH,053H	; LD (nn),de
	DW	val		;   NN

; Here to return from setjmp/longjmp

ljret:
	DB	0EDH,07BH	; LD SP,(NN)... Get jmp buffer address
	DW	envadr		;      ..NN..
	pop	h		; Get old stack pointer value
	shld	osp		; Save it
	pop	d		; Get old return address
	mov	m,e		; Put it on the old stack
	inx	h
	mov	m,d

	db	0FDH,0E1H	; pop iy
	db	0DDH,0E1H	; pop ix
	pop	b

	lhld	val		; Get value to return
	DB	0EDH,07BH	; LD sp,(nn)
	 DW	osp		;       NN

	ret			; Return to setjmp caller



envadr:	ds	2		; Address of jmp buffer
nsp:	ds	2		; New stack pointer
osp:	ds	2		; Old stack pointer
raddr:	ds	2		; Return address
val:	ds	2		; Value to return
	end