Skip to content
Browse files

EuXLisp: Renamed conditional include macros for consistency with the …

…file names
  • Loading branch information...
1 parent 20a898b commit 70a13ea72ecff5307ecb4ba3b26b5968322ce324 Henry committed
View
2 EuXLisp/Makefile
@@ -1,5 +1,5 @@
### Copyright 1994 Russell Bradford
-### Copyright 2010 Henry G. Weller
+### Copyright 2010, 2011 Henry G. Weller
###-----------------------------------------------------------------------------
## This file is part of
### --- EuLisp System 'Eu2C'
View
8 EuXLisp/euxlbanner.h
@@ -1,5 +1,5 @@
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -21,11 +21,11 @@
/// Title: EuXLisp identification
/// Maintainer: Henry G. Weller
///-----------------------------------------------------------------------------
-#ifndef XSBANNER_H
-#define XSBANNER_H
+#ifndef EUXLBANNER_H
+#define EUXLBANNER_H
#define BANNER "EuLisp System EuXLisp (formally Euscheme) - Version 0.991"
///-----------------------------------------------------------------------------
-#endif // XSBANNER_H
+#endif // EUXLBANNER_H
///-----------------------------------------------------------------------------
View
8 EuXLisp/euxlbcode.h
@@ -1,6 +1,6 @@
/// Copyright 1988 David Michael Betz
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -22,8 +22,8 @@
/// Title: EuXLisp compiler byte code definitions
/// Maintainer: Henry G. Weller
///-----------------------------------------------------------------------------
-#ifndef XSBCODE_H
-#define XSBCODE_H
+#ifndef EUXLBCODE_H
+#define EUXLBCODE_H
#define OP_BRT 0x01 // branch on true
#define OP_BRF 0x02 // branch on false
@@ -109,5 +109,5 @@
#endif
///-----------------------------------------------------------------------------
-#endif // XSBCODE_H
+#endif // EUXLBCODE_H
///-----------------------------------------------------------------------------
View
690 EuXLisp/euxlcom.c
345 additions, 345 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
View
170 EuXLisp/euxldmem.c
@@ -1,6 +1,6 @@
/// Copyright 1988 David Michael Betz
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -29,16 +29,16 @@
///-----------------------------------------------------------------------------
/// Virtual machine registers
///-----------------------------------------------------------------------------
-LVAL xlfun = NIL; // current function
-LVAL xlenv = NIL; // current environment
-LVAL xlval = NIL; // value of most recent instruction
-LVAL *xlsp = NULL; // value stack pointer
+euxlValue xlfun = NIL; // current function
+euxlValue xlenv = NIL; // current environment
+euxlValue xlval = NIL; // value of most recent instruction
+euxlValue *xlsp = NULL; // value stack pointer
///-----------------------------------------------------------------------------
/// Stack limits
///-----------------------------------------------------------------------------
-LVAL *xlstkbase = NULL; // base of value stack
-LVAL *xlstktop = NULL; // top of value stack (actually, one beyond)
+euxlValue *xlstkbase = NULL; // base of value stack
+euxlValue *xlstktop = NULL; // top of value stack (actually, one beyond)
///-----------------------------------------------------------------------------
/// variables shared with xsimage.c
@@ -54,7 +54,7 @@ NSEGMENT *nslast = NULL; // last node segment
int nscount = 0; // number of node segments
FIXTYPE nnodes = 0; // total number of nodes
FIXTYPE nfree = 0; // number of nodes in free list
-LVAL fnodes = NIL; // list of free nodes
+euxlValue fnodes = NIL; // list of free nodes
///-----------------------------------------------------------------------------
/// Vector (and string) space
@@ -62,8 +62,8 @@ LVAL fnodes = NIL; // list of free nodes
VSEGMENT *vsegments = NULL; // list of vector segments
VSEGMENT *vscurrent = NULL; // current vector segment
int vscount = 0; // number of vector segments
-LVAL *vfree = NULL; // next free location in vector space
-LVAL *vtop = NULL; // top of vector space
+euxlValue *vfree = NULL; // next free location in vector space
+euxlValue *vtop = NULL; // top of vector space
///-----------------------------------------------------------------------------
/// External variables
@@ -73,13 +73,13 @@ LVAL *vtop = NULL; // top of vector space
///-----------------------------------------------------------------------------
/// Forward declarations
///-----------------------------------------------------------------------------
-static LVAL allocnode(int type);
+static euxlValue allocnode(int type);
static void findmemory();
-static LVAL allocvector(int type, int size);
+static euxlValue allocvector(int type, int size);
static int findvmemory(int size);
void gc(int reason);
-static void mark(LVAL ptr);
-static void markvector(LVAL vect);
+static void mark(euxlValue ptr);
+static void markvector(euxlValue vect);
static void compact();
static void compact_vector(VSEGMENT * vseg);
static void sweep();
@@ -90,9 +90,9 @@ static void badobjtype(int type);
/// Functions
///-----------------------------------------------------------------------------
// cons - construct a new cons node
-LVAL cons(LVAL x, LVAL y)
+euxlValue cons(euxlValue x, euxlValue y)
{
- LVAL nnode;
+ euxlValue nnode;
// get a free node
if ((nnode = fnodes) == NIL)
@@ -120,25 +120,25 @@ LVAL cons(LVAL x, LVAL y)
}
// newframe - create a new environment frame
-LVAL newframe(LVAL parent, int size)
+euxlValue newframe(euxlValue parent, int size)
{
- LVAL frame = cons(newvector(size), parent);
+ euxlValue frame = cons(newvector(size), parent);
frame->n_type = ENV;
return (frame);
}
// cvstring - convert a string to a string node
-LVAL cvstring(char *str)
+euxlValue cvstring(char *str)
{
- LVAL val = newstring(strlen(str) + 1);
+ euxlValue val = newstring(strlen(str) + 1);
strcpy(getstring(val), str);
return (val);
}
// cvstring2 - convert a string (possibly containing NULLs) to a string node
-LVAL cvstring2(char *str, int len)
+euxlValue cvstring2(char *str, int len)
{
- LVAL val = newstring(len + 1);
+ euxlValue val = newstring(len + 1);
for (int i = 0; i < len; i++)
{
@@ -151,11 +151,11 @@ LVAL cvstring2(char *str, int len)
}
// ensure unique names for symbols
-static void set_symbol_name(LVAL new, char *pname)
+static void set_symbol_name(euxlValue new, char *pname)
{
int i = hash(pname, HSIZE);
- LVAL sym, name;
+ euxlValue sym, name;
for (sym = getelement(obarray, i); sym; sym = cdr(sym))
{
if (strcmp(pname, getstring(getpname(car(sym)))) == 0)
@@ -176,9 +176,9 @@ static void set_symbol_name(LVAL new, char *pname)
}
// cvsymbol - convert a string to a symbol
-LVAL cvsymbol(char *pname)
+euxlValue cvsymbol(char *pname)
{
- LVAL val = allocvector(SYMBOL, SYMSIZE);
+ euxlValue val = allocvector(SYMBOL, SYMSIZE);
cpush(val);
setvalue(val, s_unbound);
set_symbol_name(val, pname);
@@ -188,9 +188,9 @@ LVAL cvsymbol(char *pname)
}
// cvmodule - convert a string to a module
-LVAL cvmodule(char *name)
+euxlValue cvmodule(char *name)
{
- extern LVAL xlenter_keyword();
+ extern euxlValue xlenter_keyword();
// delete old module of same name if there
if (module_list != NIL)
@@ -201,7 +201,7 @@ LVAL cvmodule(char *name)
}
else
{
- LVAL mods1, mods2;
+ euxlValue mods1, mods2;
for
(
mods1 = module_list, mods2 = cdr(module_list);
@@ -219,10 +219,10 @@ LVAL cvmodule(char *name)
}
// make new module
- LVAL val = allocvector(MODULE, MODSIZE);
+ euxlValue val = allocvector(MODULE, MODSIZE);
cpush(val);
setmname(val, cvstring(name)); // module name
- LVAL obarray = newvector(HSIZE);
+ euxlValue obarray = newvector(HSIZE);
setmsymbols(val, obarray); // module obarray
// next line to ensure that oblists of different modules differ, and are
// not compiled into equal literals
@@ -232,62 +232,62 @@ LVAL cvmodule(char *name)
}
// cvfixnum - convert an integer to a fixnum node
-LVAL cvfixnum(FIXTYPE n)
+euxlValue cvfixnum(FIXTYPE n)
{
if (n >= SFIXMIN && n <= SFIXMAX)
{
return (cvsfixnum(n));
}
- LVAL val = allocnode(FIXNUM);
+ euxlValue val = allocnode(FIXNUM);
val->n_int = n;
return (val);
}
// cvflonum - convert a floating point number to a flonum node
-LVAL cvflonum(FLOTYPE n)
+euxlValue cvflonum(FLOTYPE n)
{
- LVAL val = allocnode(FLONUM);
+ euxlValue val = allocnode(FLONUM);
val->n_flonum = n;
return (val);
}
// cvchar - convert an integer to a character node
-LVAL cvchar(int ch)
+euxlValue cvchar(int ch)
{
- LVAL val = allocnode(CHAR);
+ euxlValue val = allocnode(CHAR);
val->n_chcode = ch;
return (val);
}
// cvclosure - convert code and an environment to a closure
-LVAL cvclosure(LVAL code, LVAL env)
+euxlValue cvclosure(euxlValue code, euxlValue env)
{
- LVAL val = cons(code, env);
+ euxlValue val = cons(code, env);
val->n_type = CLOSURE;
return (val);
}
// cvpromise - convert a procedure to a promise
-LVAL cvpromise(LVAL code, LVAL env)
+euxlValue cvpromise(euxlValue code, euxlValue env)
{
- LVAL val = cons(cvclosure(code, env), NIL);
+ euxlValue val = cons(cvclosure(code, env), NIL);
val->n_type = PROMISE;
return (val);
}
// cvsubr - convert a function to a subr/xsubr
-LVAL cvsubr(int type, LVAL(*fcn) (), int offset)
+euxlValue cvsubr(int type, euxlValue(*fcn) (), int offset)
{
- LVAL val = allocnode(type);
+ euxlValue val = allocnode(type);
val->n_subr = fcn;
val->n_offset = offset;
return (val);
}
// cvstream - convert a file pointer to an stream
-LVAL cvstream(FILE *fp, int flags)
+euxlValue cvstream(FILE *fp, int flags)
{
- LVAL val = allocnode(STREAM);
+ euxlValue val = allocnode(STREAM);
setfile(val, fp);
setsavech(val, '\0');
setpflags(val, flags);
@@ -295,12 +295,12 @@ LVAL cvstream(FILE *fp, int flags)
}
// cvtable - convert a comparator function to a table
-LVAL cvtable(LVAL comp, LVAL fill)
+euxlValue cvtable(euxlValue comp, euxlValue fill)
{
check(3);
push(comp);
push(fill);
- LVAL val = allocvector(TABLE, TABLESIZE);
+ euxlValue val = allocvector(TABLE, TABLESIZE);
push(val);
settablecomp(val, comp);
settabletable(val, newvector(HTABLESIZE));
@@ -310,35 +310,35 @@ LVAL cvtable(LVAL comp, LVAL fill)
}
// newvector - allocate and initialize a new vector
-LVAL newvector(int size)
+euxlValue newvector(int size)
{
return (allocvector(VECTOR, size));
}
// newstring - allocate and initialize a new string
-LVAL newstring(int size)
+euxlValue newstring(int size)
{
- LVAL val = allocvector(STRING, btow_size(size));
+ euxlValue val = allocvector(STRING, btow_size(size));
val->n_vsize = size;
return (val);
}
// newcode - create a new code object
-LVAL newcode(int nlits)
+euxlValue newcode(int nlits)
{
return (allocvector(CODE, nlits));
}
// newcontinuation - create a new continuation object
-LVAL newcontinuation(int size)
+euxlValue newcontinuation(int size)
{
return (allocvector(CONTINUATION, size));
}
// newobject - allocate and initialize a new object
-LVAL newobject(LVAL cls, int size)
+euxlValue newobject(euxlValue cls, int size)
{
- LVAL val = allocvector(OBJECT, size + 1); // class, ivars
+ euxlValue val = allocvector(OBJECT, size + 1); // class, ivars
setclass(val, cls);
for (int i = 1; i <= size; i++)
{
@@ -348,19 +348,19 @@ LVAL newobject(LVAL cls, int size)
return (val);
}
-LVAL newgeneric()
+euxlValue newgeneric()
{
return allocvector(GENERIC, GENSIZE);
}
-LVAL newmethod()
+euxlValue newmethod()
{
return allocvector(METHOD, MDSIZE);
}
-LVAL newslot(LVAL name)
+euxlValue newslot(euxlValue name)
{
- LVAL val = allocvector(SLOT, SLOTSIZE);
+ euxlValue val = allocvector(SLOT, SLOTSIZE);
setslotname(val, name);
setslotkey(val, s_unbound);
setslotdefault(val, s_unbound);
@@ -369,9 +369,9 @@ LVAL newslot(LVAL name)
}
// allocnode - allocate a new node
-static LVAL allocnode(int type)
+static euxlValue allocnode(int type)
{
- LVAL nnode;
+ euxlValue nnode;
// get a free node
if ((nnode = fnodes) == NIL)
@@ -416,7 +416,7 @@ int nexpand(int size)
if ((newseg = newnsegment(size)) != NULL)
{
// add each new node to the free list
- LVAL p = &newseg->ns_data[0];
+ euxlValue p = &newseg->ns_data[0];
for (int i = NSSIZE; --i >= 0; ++p)
{
p->n_type = FREE;
@@ -429,9 +429,9 @@ int nexpand(int size)
}
// allocvector - allocate and initialize a new vector node
-static LVAL allocvector(int type, int size)
+static euxlValue allocvector(int type, int size)
{
- register LVAL val;
+ register euxlValue val;
// get a free node
if ((val = fnodes) == NIL)
@@ -468,7 +468,7 @@ static LVAL allocvector(int type, int size)
}
// allocate the next available block
- register LVAL *p = vfree;
+ register euxlValue *p = vfree;
vfree += size;
// store the backpointer
@@ -610,14 +610,14 @@ VSEGMENT *newvsegment(unsigned int n)
void pstack()
{
- extern LVAL s_stdout;
+ extern euxlValue s_stdout;
if (s_stdout && getvalue(s_stdout))
{
xlterpri(xstdout());
- for (LVAL *p = xlsp; p < xlstktop; ++p)
+ for (euxlValue *p = xlsp; p < xlstktop; ++p)
{
- LVAL tmp = *p;
+ euxlValue tmp = *p;
xlprin1(tmp, xstdout());
xlterpri(xstdout());
}
@@ -628,7 +628,7 @@ void pstack()
void gc(int reason)
{
extern int quiet;
- extern LVAL s_gcmsgs;
+ extern euxlValue s_gcmsgs;
if (!quiet && s_gcmsgs && getvalue(s_gcmsgs))
{
@@ -684,9 +684,9 @@ void gc(int reason)
}
// mark the stack
- for (register LVAL *p = xlsp; p < xlstktop; ++p)
+ for (register euxlValue *p = xlsp; p < xlstktop; ++p)
{
- register LVAL tmp;
+ register euxlValue tmp;
if ((tmp = *p) != NIL && ispointer(tmp))
{
mark(tmp);
@@ -711,7 +711,7 @@ void gc(int reason)
}
// mark - mark all accessible nodes
-static void mark(LVAL ptr)
+static void mark(euxlValue ptr)
{
if (!ispointer(ptr))
{
@@ -719,8 +719,8 @@ static void mark(LVAL ptr)
}
// initialize
- register LVAL prev = NIL;
- register LVAL this = ptr;
+ register euxlValue prev = NIL;
+ register euxlValue this = ptr;
// mark this node
for (;;)
@@ -737,7 +737,7 @@ static void mark(LVAL ptr)
case ENV:
{
this->n_flags |= MARK;
- register LVAL tmp;
+ register euxlValue tmp;
if ((tmp = car(this)) != NIL && ispointer(tmp))
{
this->n_flags |= LEFT;
@@ -788,7 +788,7 @@ static void mark(LVAL ptr)
// make sure there is a previous node
if (prev)
{
- register LVAL tmp;
+ register euxlValue tmp;
if (prev->n_flags & LEFT)
{
// came from left side
@@ -820,15 +820,15 @@ static void mark(LVAL ptr)
}
// markvector - mark a vector-like node
-static void markvector(LVAL vect)
+static void markvector(euxlValue vect)
{
- register LVAL *p;
+ register euxlValue *p;
if ((p = vect->n_vdata) != NULL)
{
register int n = getsize(vect);
while (--n >= 0)
{
- register LVAL tmp;
+ register euxlValue tmp;
if ((tmp = *p++) != NIL && ispointer(tmp))
{
mark(tmp);
@@ -865,13 +865,13 @@ static void compact()
// compact_vector - compact a vector segment
static void compact_vector(VSEGMENT * vseg)
{
- register LVAL *vdata = &vseg->vs_data[0];
- register LVAL *vnext = vdata;
- register LVAL *vfree = vseg->vs_free;
+ register euxlValue *vdata = &vseg->vs_data[0];
+ register euxlValue *vnext = vdata;
+ register euxlValue *vfree = vseg->vs_free;
while (vdata < vfree)
{
- register LVAL vector = *vdata;
+ register euxlValue vector = *vdata;
register int vsize =
(
vector->n_type == STRING
@@ -921,7 +921,7 @@ static void sweep()
static void sweep_segment(NSEGMENT * nseg)
{
register FIXTYPE n;
- register LVAL p;
+ register euxlValue p;
// add all unmarked nodes
for (p = &nseg->ns_data[0], n = nseg->ns_size; --n >= 0L; ++p)
@@ -966,8 +966,8 @@ void xlminit(unsigned int ssize)
vfree = vtop = NULL;
// allocate the value stack
- unsigned int n = ssize * sizeof(LVAL);
- if ((xlstkbase = (LVAL *) calloc(1, n)) == NULL)
+ unsigned int n = ssize * sizeof(euxlValue);
+ if ((xlstkbase = (euxlValue *) calloc(1, n)) == NULL)
{
xlfatal("insufficient memory");
}
View
36 EuXLisp/euxlftab.c
@@ -1,6 +1,6 @@
/// Copyright 1988 David Michael Betz
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -33,7 +33,7 @@
int xsubrcnt = 12; // number of XSUBR functions
int csubrcnt = 18; // number of CSUBR functions + xsubrcnt
-typedef LVAL(*FP) ();
+typedef euxlValue(*FP) ();
///-----------------------------------------------------------------------------
/// Built-in functions
@@ -463,19 +463,19 @@ FUNDEF funtab[] =
/// Functions
///-----------------------------------------------------------------------------
// xstdin - get the stdin stream
-LVAL xstdin()
+euxlValue xstdin()
{
return (getvalue(s_stdin));
}
// xstdout - get the stdout stream
-LVAL xstdout()
+euxlValue xstdout()
{
return (getvalue(s_stdout));
}
// eq - internal 'eq' function
-int eq(LVAL arg1, LVAL arg2)
+int eq(euxlValue arg1, euxlValue arg2)
{
if (symbolp(arg1) && symbolp(arg2))
{
@@ -485,7 +485,7 @@ int eq(LVAL arg1, LVAL arg2)
}
// eqv - internal 'eql' function
-int eqv(LVAL arg1, LVAL arg2)
+int eqv(euxlValue arg1, euxlValue arg2)
{
// try the eq test first
if (arg1 == arg2)
@@ -512,7 +512,7 @@ int eqv(LVAL arg1, LVAL arg2)
}
// equal - internal 'equal' function
-int equal(LVAL arg1, LVAL arg2)
+int equal(euxlValue arg1, euxlValue arg2)
{
// try the eq test first
if (arg1 == arg2)
@@ -548,7 +548,7 @@ int equal(LVAL arg1, LVAL arg2)
}
// equality of two numbers
-int equals(LVAL arg1, LVAL arg2)
+int equals(euxlValue arg1, euxlValue arg2)
{
if (fixp(arg1))
{
@@ -579,7 +579,7 @@ int equals(LVAL arg1, LVAL arg2)
}
// vectorequal - compare two vectors
-int vectorequal(LVAL v1, LVAL v2)
+int vectorequal(euxlValue v1, euxlValue v2)
{
// compare the vector sizes
int len;
@@ -601,9 +601,9 @@ int vectorequal(LVAL v1, LVAL v2)
}
// xltoofew - too few arguments to this function
-LVAL xltoofew(char *cfn_name)
+euxlValue xltoofew(char *cfn_name)
{
- LVAL name = cvstring(cfn_name);
+ euxlValue name = cvstring(cfn_name);
xlcerror("too few arguments", name, NIL);
return NIL; // notreached
}
@@ -611,37 +611,37 @@ LVAL xltoofew(char *cfn_name)
// xltoofew - too few arguments to this function
void xltoofew_int()
{
- extern LVAL xlfun;
+ extern euxlValue xlfun;
xlinterror("too few arguments", xlfun, NIL);
}
// xltoomany - too many arguments to this function
void xltoomany(char *cfn_name)
{
- LVAL name = cvstring(cfn_name);
+ euxlValue name = cvstring(cfn_name);
xlcerror("too many arguments", name, NIL);
}
// xltoomany - too many arguments to this function
void xltoomany_int()
{
- extern LVAL xlfun;
+ extern euxlValue xlfun;
xlinterror("too many arguments", xlfun, NIL);
}
// xlbadtype - incorrect argument type
// cf badargtype in xsint.c
-LVAL xlbadtype(LVAL val, char *name, char *fn)
+euxlValue xlbadtype(euxlValue val, char *name, char *fn)
{
- extern LVAL s_bad_type_error, s_unbound;
+ extern euxlValue s_bad_type_error, s_unbound;
char buf[256];
sprintf(buf, "incorrect type in %s", fn);
- LVAL cond = getvalue(s_bad_type_error);
+ euxlValue cond = getvalue(s_bad_type_error);
if (cond != s_unbound)
{
- LVAL class = name[0] == '<' ?
+ euxlValue class = name[0] == '<' ?
getvalue(xlenter_module(name, root_module)) : cvstring(name);
setivar(cond, 3, class); // cf condcl.em
}
View
424 EuXLisp/euxlfun1.c
@@ -1,6 +1,6 @@
/// Copyright 1988 David Michael Betz
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -36,30 +36,30 @@ static int gsnumber = 1; // gensym number
///-----------------------------------------------------------------------------
/// External variables
///-----------------------------------------------------------------------------
-extern LVAL xlenv, xlval;
+extern euxlValue xlenv, xlval;
///-----------------------------------------------------------------------------
/// Forward declarations
///-----------------------------------------------------------------------------
-static LVAL cxr(char *adstr);
-LVAL member(int (*fcn) (LVAL a, LVAL b));
-LVAL assoc(int (*fcn) (LVAL a, LVAL b));
-static LVAL nth(int carflag);
-static LVAL vref(LVAL vector);
-static LVAL vset(LVAL vector);
-static LVAL eqtest(int (*fcn) (LVAL a, LVAL b));
+static euxlValue cxr(char *adstr);
+euxlValue member(int (*fcn) (euxlValue a, euxlValue b));
+euxlValue assoc(int (*fcn) (euxlValue a, euxlValue b));
+static euxlValue nth(int carflag);
+static euxlValue vref(euxlValue vector);
+static euxlValue vset(euxlValue vector);
+static euxlValue eqtest(int (*fcn) (euxlValue a, euxlValue b));
///-----------------------------------------------------------------------------
/// Functions
///-----------------------------------------------------------------------------
// xcons - construct a new list cell
-LVAL xcons()
+euxlValue xcons()
{
static char *cfn_name = "cons";
// get the two arguments
- LVAL carval = xlgetarg();
- LVAL cdrval = xlgetarg();
+ euxlValue carval = xlgetarg();
+ euxlValue cdrval = xlgetarg();
xllastarg();
// construct a new cons node
@@ -67,197 +67,197 @@ LVAL xcons()
}
// xcar - built-in function 'car'
-LVAL xcar()
+euxlValue xcar()
{
static char *cfn_name = "car";
- LVAL list = xlgacons();
+ euxlValue list = xlgacons();
xllastarg();
return car(list);
}
// xicar - built-in function '%car'
-LVAL xicar()
+euxlValue xicar()
{
static char *cfn_name = "%car";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (car(arg));
}
// xcdr - built-in function 'cdr'
-LVAL xcdr()
+euxlValue xcdr()
{
static char *cfn_name = "cdr";
- LVAL arg = xlgacons();
+ euxlValue arg = xlgacons();
xllastarg();
return cdr(arg);
}
// xicdr - built-in function '%cdr'
-LVAL xicdr()
+euxlValue xicdr()
{
static char *cfn_name = "%cdr";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (cdr(arg));
}
// cxxr functions
-LVAL xcaar()
+euxlValue xcaar()
{
return (cxr("aa"));
}
-LVAL xcadr()
+euxlValue xcadr()
{
return (cxr("da"));
}
-LVAL xcdar()
+euxlValue xcdar()
{
return (cxr("ad"));
}
-LVAL xcddr()
+euxlValue xcddr()
{
return (cxr("dd"));
}
// cxxxr functions
-LVAL xcaaar()
+euxlValue xcaaar()
{
return (cxr("aaa"));
}
-LVAL xcaadr()
+euxlValue xcaadr()
{
return (cxr("daa"));
}
-LVAL xcadar()
+euxlValue xcadar()
{
return (cxr("ada"));
}
-LVAL xcaddr()
+euxlValue xcaddr()
{
return (cxr("dda"));
}
-LVAL xcdaar()
+euxlValue xcdaar()
{
return (cxr("aad"));
}
-LVAL xcdadr()
+euxlValue xcdadr()
{
return (cxr("dad"));
}
-LVAL xcddar()
+euxlValue xcddar()
{
return (cxr("add"));
}
-LVAL xcdddr()
+euxlValue xcdddr()
{
return (cxr("ddd"));
}
// cxxxxr functions
-LVAL xcaaaar()
+euxlValue xcaaaar()
{
return (cxr("aaaa"));
}
-LVAL xcaaadr()
+euxlValue xcaaadr()
{
return (cxr("daaa"));
}
-LVAL xcaadar()
+euxlValue xcaadar()
{
return (cxr("adaa"));
}
-LVAL xcaaddr()
+euxlValue xcaaddr()
{
return (cxr("ddaa"));
}
-LVAL xcadaar()
+euxlValue xcadaar()
{
return (cxr("aada"));
}
-LVAL xcadadr()
+euxlValue xcadadr()
{
return (cxr("dada"));
}
-LVAL xcaddar()
+euxlValue xcaddar()
{
return (cxr("adda"));
}
-LVAL xcadddr()
+euxlValue xcadddr()
{
return (cxr("ddda"));
}
-LVAL xcdaaar()
+euxlValue xcdaaar()
{
return (cxr("aaad"));
}
-LVAL xcdaadr()
+euxlValue xcdaadr()
{
return (cxr("daad"));
}
-LVAL xcdadar()
+euxlValue xcdadar()
{
return (cxr("adad"));
}
-LVAL xcdaddr()
+euxlValue xcdaddr()
{
return (cxr("ddad"));
}
-LVAL xcddaar()
+euxlValue xcddaar()
{
return (cxr("aadd"));
}
-LVAL xcddadr()
+euxlValue xcddadr()
{
return (cxr("dadd"));
}
-LVAL xcdddar()
+euxlValue xcdddar()
{
return (cxr("addd"));
}
-LVAL xcddddr()
+euxlValue xcddddr()
{
return (cxr("dddd"));
}
// cxr - common car/cdr function
-static LVAL cxr(char *adstr)
+static euxlValue cxr(char *adstr)
{
static char *cfn_name = "c[ad]r";
// get the list
- LVAL list = xlgalist();
+ euxlValue list = xlgalist();
xllastarg();
- LVAL lst = list;
+ euxlValue lst = list;
char *ad = adstr;
// perform the car/cdr operations
@@ -279,13 +279,13 @@ static LVAL cxr(char *adstr)
}
// xsetcar - built-in function 'set-car'
-LVAL xsetcar()
+euxlValue xsetcar()
{
static char *cfn_name = "set-car";
// get the cons and the new car
- LVAL arg = xlgacons();
- LVAL newcar = xlgetarg();
+ euxlValue arg = xlgacons();
+ euxlValue newcar = xlgetarg();
xllastarg();
// replace the car
@@ -294,13 +294,13 @@ LVAL xsetcar()
}
// xisetcar - built-in function '%set-car'
-LVAL xisetcar()
+euxlValue xisetcar()
{
static char *cfn_name = "%set-car";
// get the cons and the new car
- LVAL arg = xlgetarg();
- LVAL newcar = xlgetarg();
+ euxlValue arg = xlgetarg();
+ euxlValue newcar = xlgetarg();
xllastarg();
// replace the car
@@ -309,13 +309,13 @@ LVAL xisetcar()
}
// xsetcdr - built-in function 'set-cdr'
-LVAL xsetcdr()
+euxlValue xsetcdr()
{
static char *cfn_name = "set-cdr";
// get the cons and the new cdr
- LVAL arg = xlgacons();
- LVAL newcdr = xlgetarg();
+ euxlValue arg = xlgacons();
+ euxlValue newcdr = xlgetarg();
xllastarg();
// replace the cdr
@@ -324,13 +324,13 @@ LVAL xsetcdr()
}
// xisetcdr - built-in function '%set-cdr'
-LVAL xisetcdr()
+euxlValue xisetcdr()
{
static char *cfn_name = "%set-cdr";
// get the cons and the new cdr
- LVAL arg = xlgetarg();
- LVAL newcdr = xlgetarg();
+ euxlValue arg = xlgetarg();
+ euxlValue newcdr = xlgetarg();
xllastarg();
// replace the cdr
@@ -339,19 +339,19 @@ LVAL xisetcdr()
}
// xlist - built-in function 'list'
-LVAL xlist()
+euxlValue xlist()
{
// initialize the list
- LVAL val = NIL;
+ euxlValue val = NIL;
// add each argument to the list
if (moreargs())
{
- LVAL last = cons(nextarg(), NIL);
+ euxlValue last = cons(nextarg(), NIL);
val = last;
while (moreargs())
{
- LVAL next = nextarg();
+ euxlValue next = nextarg();
push(val);
next = cons(next, NIL);
rplacd(last, next);
@@ -365,18 +365,18 @@ LVAL xlist()
}
// xliststar - built-in function 'list*'
-LVAL xliststar()
+euxlValue xliststar()
{
// initialize the list
- LVAL val = NIL;
- LVAL last = NIL;
+ euxlValue val = NIL;
+ euxlValue last = NIL;
// add each argument to the list
if (moreargs())
{
for (;;)
{
- LVAL next = nextarg();
+ euxlValue next = nextarg();
if (moreargs())
{
push(val);
@@ -412,19 +412,19 @@ LVAL xliststar()
}
// xappend - built-in function 'append'
-LVAL xappend()
+euxlValue xappend()
{
static char *cfn_name = "append";
// append each argument
- LVAL last, val;
+ euxlValue last, val;
for (val = last = NIL; xlargc > 1;)
{
// append each element of this list to the result list
- for (LVAL next = xlgalist(); consp(next); next = cdr(next))
+ for (euxlValue next = xlgalist(); consp(next); next = cdr(next))
{
push(val);
- LVAL this = cons(car(next), NIL);
+ euxlValue this = cons(car(next), NIL);
val = pop();
if (last == NIL)
{
@@ -455,12 +455,12 @@ LVAL xappend()
return (val);
}
-LVAL xlreverse(LVAL next)
+euxlValue xlreverse(euxlValue next)
{
cpush(next);
// append each element of this list to the result list
- LVAL val;
+ euxlValue val;
for (val = NIL; consp(next); next = cdr(next))
{
push(val);
@@ -475,24 +475,24 @@ LVAL xlreverse(LVAL next)
}
// xreverse - built-in function 'reverse'
-LVAL xreverse()
+euxlValue xreverse()
{
static char *cfn_name = "reverse-list";
// get the list to reverse
- LVAL next = xlgalist();
+ euxlValue next = xlgalist();
xllastarg();
return xlreverse(next);
}
// xlastpair - built-in function 'last-pair'
-LVAL xlastpair()
+euxlValue xlastpair()
{
static char *cfn_name = "last-pair";
// get the list
- LVAL list = xlgalist();
+ euxlValue list = xlgalist();
xllastarg();
// find the last cons
@@ -509,12 +509,12 @@ LVAL xlastpair()
}
// xsize - built-in function 'list_size'
-LVAL xsize()
+euxlValue xsize()
{
static char *cfn_name = "list-size";
// get the argument
- LVAL arg = xlgalist();
+ euxlValue arg = xlgalist();
xllastarg();
// find the list_size
@@ -529,27 +529,27 @@ LVAL xsize()
}
// xmember - built-in function 'member'
-LVAL xmember()
+euxlValue xmember()
{
return (member(equal));
}
// xmemv - built-in function 'memv'
-LVAL xmemv()
+euxlValue xmemv()
{
return (member(eqv));
}
// xmemq - built-in function 'memq'
-LVAL xmemq()
+euxlValue xmemq()
{
return (member(eq));
}
// member - common function for member/memv/memq
-LVAL xlmember(LVAL x, LVAL list, int (*fcn) (LVAL a, LVAL b))
+euxlValue xlmember(euxlValue x, euxlValue list, int (*fcn) (euxlValue a, euxlValue b))
{
- LVAL val;
+ euxlValue val;
// look for the expression
for (val = NIL; consp(list); list = cdr(list))
@@ -565,51 +565,51 @@ LVAL xlmember(LVAL x, LVAL list, int (*fcn) (LVAL a, LVAL b))
return (val);
}
-LVAL member(int (*fcn) ())
+euxlValue member(int (*fcn) ())
{
static char *cfn_name = "member/memq/memv";
// get the expression to look for and the list
- LVAL x = xlgetarg();
- LVAL list = xlgalist();
+ euxlValue x = xlgetarg();
+ euxlValue list = xlgalist();
xllastarg();
return xlmember(x, list, fcn);
}
// xassoc - built-in function 'assoc'
-LVAL xassoc()
+euxlValue xassoc()
{
return (assoc(equal));
}
// xassv - built-in function 'assv'
-LVAL xassv()
+euxlValue xassv()
{
return (assoc(eqv));
}
// xassq - built-in function 'assq'
-LVAL xassq()
+euxlValue xassq()
{
return (assoc(eq));
}
// assoc - common function for assoc/assv/assq
-LVAL assoc(int (*fcn) ())
+euxlValue assoc(int (*fcn) ())
{
static char *cfn_name = "assoc/assv/assq";
// get the expression to look for and the association list
- LVAL x = xlgetarg();
- LVAL alist = xlgalist();
+ euxlValue x = xlgetarg();
+ euxlValue alist = xlgalist();
xllastarg();
// look for the expression
- LVAL val;
+ euxlValue val;
for (val = NIL; consp(alist); alist = cdr(alist))
{
- LVAL pair;
+ euxlValue pair;
if ((pair = car(alist)) != NIL && consp(pair))
{
if ((*fcn) (x, car(pair), fcn))
@@ -625,25 +625,25 @@ LVAL assoc(int (*fcn) ())
}
// xlistref - built-in function 'list-ref'
-LVAL xlistref()
+euxlValue xlistref()
{
return (nth(TRUE));
}
// xlisttail - built-in function 'list-tail'
-LVAL xlisttail()
+euxlValue xlisttail()
{
return (nth(FALSE));
}
// nth - internal nth function
-static LVAL nth(int carflag)
+static euxlValue nth(int carflag)
{
static char *cfn_name = "list-ref/list-tail";
// get n and the list
- LVAL list = xlgalist();
- LVAL arg = xlgafixnum();
+ euxlValue list = xlgalist();
+ euxlValue arg = xlgafixnum();
xllastarg();
// range check the index
@@ -670,33 +670,33 @@ static LVAL nth(int carflag)
}
// xboundp - is this a value bound to this symbol?
-LVAL xboundp()
+euxlValue xboundp()
{
static char *cfn_name = "symbol-exists?";
- LVAL sym = xlgasymbol();
+ euxlValue sym = xlgasymbol();
xllastarg();
return (boundp(sym) ? true : NIL);
}
// xsymvalue - get the value of a symbol
-LVAL xsymvalue()
+euxlValue xsymvalue()
{
static char *cfn_name = "symbol-value";
- LVAL sym = xlgasymbol();
+ euxlValue sym = xlgasymbol();
xllastarg();
return (getvalue(sym));
}
// xsetsymvalue - set the value of a symbol
-LVAL xsetsymvalue()
+euxlValue xsetsymvalue()
{
static char *cfn_name = "set-symbol-value";
// get the symbol
- LVAL sym = xlgasymbol();
- LVAL val = xlgetarg();
+ euxlValue sym = xlgasymbol();
+ euxlValue val = xlgetarg();
xllastarg();
// set the global value
@@ -707,12 +707,12 @@ LVAL xsetsymvalue()
}
// xsymplist - get the property list of a symbol
-LVAL xsymplist()
+euxlValue xsymplist()
{
static char *cfn_name = "symbol-plist";
// get the symbol
- LVAL sym = xlgasymbol();
+ euxlValue sym = xlgasymbol();
xllastarg();
// return the property list
@@ -720,13 +720,13 @@ LVAL xsymplist()
}
// xsetsymplist - set the property list of a symbol
-LVAL xsetsymplist()
+euxlValue xsetsymplist()
{
static char *cfn_name = "set-symbol-plist";
// get the symbol
- LVAL sym = xlgasymbol();
- LVAL val = xlgetarg();
+ euxlValue sym = xlgasymbol();
+ euxlValue val = xlgetarg();
xllastarg();
// set the property list
@@ -735,13 +735,13 @@ LVAL xsetsymplist()
}
// xget - get the value of a property
-LVAL xget()
+euxlValue xget()
{
static char *cfn_name = "get";
// get the symbol and property
- LVAL sym = xlgasymbol();
- LVAL prp = xlgasymbol();
+ euxlValue sym = xlgasymbol();
+ euxlValue prp = xlgasymbol();
xllastarg();
// retrieve the property value
@@ -749,14 +749,14 @@ LVAL xget()
}
// xput - set the value of a property
-LVAL xput()
+euxlValue xput()
{
static char *cfn_name = "put";
// get the symbol and property
- LVAL sym = xlgasymbol();
- LVAL prp = xlgasymbol();
- LVAL val = xlgetarg();
+ euxlValue sym = xlgasymbol();
+ euxlValue prp = xlgasymbol();
+ euxlValue val = xlgetarg();
xllastarg();
// set the property value
@@ -767,13 +767,13 @@ LVAL xput()
}
// xgetsyntax - symbol syntax
-LVAL xgetsyntax()
+euxlValue xgetsyntax()
{
static char *cfn_name = "get-syntax";
// get the symbol and property
- LVAL sym = xlgasymbol();
- LVAL prp = xlgasymbol();
+ euxlValue sym = xlgasymbol();
+ euxlValue prp = xlgasymbol();
xllastarg();
// retrieve the syntax value
@@ -781,14 +781,14 @@ LVAL xgetsyntax()
}
// xput - set symbol syntax
-LVAL xputsyntax()
+euxlValue xputsyntax()
{
static char *cfn_name = "put-syntax";
// get the symbol and property
- LVAL sym = xlgasymbol();
- LVAL prp = xlgasymbol();
- LVAL val = xlgetarg();
+ euxlValue sym = xlgasymbol();
+ euxlValue prp = xlgasymbol();
+ euxlValue val = xlgetarg();
xllastarg();
// set the syntax value
@@ -799,7 +799,7 @@ LVAL xputsyntax()
}
// xtheenvironment - built-in function 'the-environment'
-LVAL xtheenvironment()
+euxlValue xtheenvironment()
{
static char *cfn_name = "the-environment";
xllastarg();
@@ -807,32 +807,32 @@ LVAL xtheenvironment()
}
// xprocenvironment - built-in function 'procedure-environment'
-LVAL xprocenvironment()
+euxlValue xprocenvironment()
{
static char *cfn_name = "procedure-environment";
- LVAL arg = xlgaclosure();
+ euxlValue arg = xlgaclosure();
xllastarg();
return (getcenv(arg));
}
// xenvp - built-in function 'environment?'
-LVAL xenvp()
+euxlValue xenvp()
{
static char *cfn_name = "environment?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (envp(arg) ? true : NIL);
}
// xenvbindings - built-in function 'environment-bindings'
-LVAL xenvbindings()
+euxlValue xenvbindings()
{
static char *cfn_name = "environment-bindings";
// get the environment
- LVAL env = xlgetarg();
+ euxlValue env = xlgetarg();
xllastarg();
// check the argument type
@@ -846,18 +846,18 @@ LVAL xenvbindings()
}
// initialize
- LVAL frame = car(env);
- LVAL names = getelement(frame, 0);
+ euxlValue frame = car(env);
+ euxlValue names = getelement(frame, 0);
int len = getsize(frame);
check(1);
// build a list of dotted pairs
- LVAL val, last;
+ euxlValue val, last;
int i;
for (val = last = NIL, i = 1; i < len; ++i, names = cdr(names))
{
push(val);
- LVAL this = cons(cons(car(names), getelement(frame, i)), NIL);
+ euxlValue this = cons(cons(car(names), getelement(frame, i)), NIL);
val = pop();
if (last)
{
@@ -873,22 +873,22 @@ LVAL xenvbindings()
}
// xenvparent - built-in function 'environment-parent'
-LVAL xenvparent()
+euxlValue xenvparent()
{
static char *cfn_name = "environment-parent";
- LVAL env = xlgaenv();
+ euxlValue env = xlgaenv();
xllastarg();
return (cdr(env));
}
// xvector - built-in function 'vector'
-LVAL xvector()
+euxlValue xvector()
{
static char *cfn_name = "vector";
- LVAL vect = newvector(xlargc);
- for (LVAL *p = &vect->n_vdata[0]; moreargs();)
+ euxlValue vect = newvector(xlargc);
+ for (euxlValue *p = &vect->n_vdata[0]; moreargs();)
{
*p++ = xlgetarg();
}
@@ -896,12 +896,12 @@ LVAL xvector()
}
// xmakevector - built-in function 'make-vector'
-LVAL xmakevector()
+euxlValue xmakevector()
{
static char *cfn_name = "make-vector";
// get the vector size
- LVAL arg = xlgafixnum();
+ euxlValue arg = xlgafixnum();
int len = (int)getfixnum(arg);
if (len < 0)
@@ -910,14 +910,14 @@ LVAL xmakevector()
}
// check for an initialization value
- LVAL val;
+ euxlValue val;
if (moreargs())
{
arg = xlgetarg(); // get the initializer
xllastarg(); // make sure that's the last argument
cpush(arg); // save the initializer
val = newvector(len); // create the vector
- LVAL *p = &val->n_vdata[0]; // initialize the vector
+ euxlValue *p = &val->n_vdata[0]; // initialize the vector
for (arg = pop(); --len >= 0;)
{
*p++ = arg;
@@ -933,46 +933,46 @@ LVAL xmakevector()
}
// xvsize - built-in function 'vector-size'
-LVAL xvsize()
+euxlValue xvsize()
{
static char *cfn_name = "vector-size";
- LVAL arg = xlgavector();
+ euxlValue arg = xlgavector();
xllastarg();
return (cvfixnum((FIXTYPE) getsize(arg)));
}
// xivsize - built-in function '%vector-size'
-LVAL xivsize()
+euxlValue xivsize()
{
static char *cfn_name = "%vector-size";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (cvfixnum((FIXTYPE) getsize(arg)));
}
// xvref - built-in function 'vector-ref'
-LVAL xvref()
+euxlValue xvref()
{
static char *cfn_name = "vector-ref";
return (vref(xlgavector()));
}
// xivref - built-in function '%vector-ref'
-LVAL xivref()
+euxlValue xivref()
{
static char *cfn_name = "%vector-ref";
return (vref(xlgetarg()));
}
// vref - common code for xvref and xivref
-static LVAL vref(LVAL vector)
+static euxlValue vref(euxlValue vector)
{
static char *cfn_name = "vector-ref";
// get the index
- LVAL index = xlgafixnum();
+ euxlValue index = xlgafixnum();
xllastarg();
// range check the index
@@ -987,27 +987,27 @@ static LVAL vref(LVAL vector)
}
// xvset - built-in function 'vector-set'
-LVAL xvset()
+euxlValue xvset()
{
static char *cfn_name = "vector-set";
return (vset(xlgavector()));
}
// xivset - built-in function '%vector-set'
-LVAL xivset()
+euxlValue xivset()
{
static char *cfn_name = "%vector-set";
return (vset(xlgetarg()));
}
// vset - common code for xvset and xivset
-static LVAL vset(LVAL vector)
+static euxlValue vset(euxlValue vector)
{
static char *cfn_name = "vector-set";
// get the index and the new value
- LVAL index = xlgafixnum();
- LVAL val = xlgetarg();
+ euxlValue index = xlgafixnum();
+ euxlValue val = xlgetarg();
xllastarg();
// range check the index
@@ -1023,12 +1023,12 @@ static LVAL vset(LVAL vector)
}
// xvectlist - built-in function 'vector->list'
-LVAL xvectlist()
+euxlValue xvectlist()
{
static char *cfn_name = "vector->list";
// get the vector
- LVAL vect = xlgavector();
+ euxlValue vect = xlgavector();
xllastarg();
// make a list from the vector
@@ -1043,7 +1043,7 @@ LVAL xvectlist()
}
// xlistvect - built-in function 'list->vector'
-LVAL xlistvect()
+euxlValue xlistvect()
{
static char *cfn_name = "list->vector";
@@ -1053,8 +1053,8 @@ LVAL xlistvect()
// make a vector from the list
int size = list_size(xlval);
- LVAL vect = newvector(size);
- for (LVAL *p = &vect->n_vdata[0]; --size >= 0; xlval = cdr(xlval))
+ euxlValue vect = newvector(size);
+ for (euxlValue *p = &vect->n_vdata[0]; --size >= 0; xlval = cdr(xlval))
{
*p++ = car(xlval);
}
@@ -1063,131 +1063,131 @@ LVAL xlistvect()
}
// xnullp - built-in function 'null?'
-LVAL xnullp()
+euxlValue xnullp()
{
static char *cfn_name = "null?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (null(arg) ? true : NIL);
}
// xatomp - built-in function 'atom?'
-LVAL xatomp()
+euxlValue xatomp()
{
static char *cfn_name = "atom?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (atom(arg) ? true : NIL);
}
// xlistp - built-in function 'list?'
-LVAL xlistp()
+euxlValue xlistp()
{
static char *cfn_name = "list?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (listp(arg) ? true : NIL);
}
// xnumberp - built-in function 'number?'
-LVAL xnumberp()
+euxlValue xnumberp()
{
static char *cfn_name = "number?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (numberp(arg) ? true : NIL);
}
// xbooleanp - built-in function 'boolean?'
-LVAL xbooleanp()
+euxlValue xbooleanp()
{
static char *cfn_name = "boolean?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (arg == true || arg == NIL ? true : NIL);
}
// xconsp - built-in function 'cons?'
-LVAL xconsp()
+euxlValue xconsp()
{
static char *cfn_name = "cons?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (consp(arg) ? true : NIL);
}
// xsymbolp - built-in function 'symbol?'
-LVAL xsymbolp()
+euxlValue xsymbolp()
{
static char *cfn_name = "symbol?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (symbolp(arg) ? true : NIL);
}
// xkeywordp - built-in function 'keyword?'
-LVAL xkeywordp()
+euxlValue xkeywordp()
{
static char *cfn_name = "keyword?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (keywordp(arg) ? true : NIL);
}
// xintegerp - built-in function 'integer?'
-LVAL xintegerp()
+euxlValue xintegerp()
{
static char *cfn_name = "integer?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (fixp(arg) ? true : NIL);
}
// xfloatp - built-in function 'float?'
-LVAL xfloatp()
+euxlValue xfloatp()
{
static char *cfn_name = "float?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (floatp(arg) ? true : NIL);
}
// xcharp - built-in function 'char?'
-LVAL xcharp()
+euxlValue xcharp()
{
static char *cfn_name = "char?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (charp(arg) ? true : NIL);
}
// xstringp - built-in function 'string?'
-LVAL xstringp()
+euxlValue xstringp()
{
static char *cfn_name = "string?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (stringp(arg) ? true : NIL);
}
// xvectorp - built-in function 'vector?'
-LVAL xvectorp()
+euxlValue xvectorp()
{
static char *cfn_name = "vector?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (vectorp(arg) ? true : NIL);
}
@@ -1196,73 +1196,73 @@ LVAL xvectorp()
(closurep(x) || continuationp(x) || subrp(x) || xsubrp(x) || genericp(x))
// xfunctionp - built-in function 'function?'
-LVAL xfunctionp()
+euxlValue xfunctionp()
{
static char *cfn_name = "function?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (isprocedure(arg) ? true : NIL);
}
// xobjectp - built-in function 'object?'
-LVAL xobjectp()
+euxlValue xobjectp()
{
static char *cfn_name = "object?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (objectp(arg) ? true : NIL);
}
// xdefaultobjectp - built-in function 'default-object?'
-LVAL xdefaultobjectp()
+euxlValue xdefaultobjectp()
{
static char *cfn_name = "default-object?";
- LVAL arg = xlgetarg();
+ euxlValue arg = xlgetarg();
xllastarg();
return (arg == default_object ? true : NIL);
}
// xeq - built-in function 'eq'
-LVAL xeq()
+euxlValue xeq()
{
return (eqtest(eq));
}
// xeqv - built-in function 'eql'
-LVAL xeqv()
+euxlValue xeqv()
{
return (eqtest(eqv));
}
// xequal - built-in function 'equal'
-LVAL xequal()
+euxlValue xequal()
{
return (eqtest(equal));
}
// eqtest - common code for eq/eql/equal
-static LVAL eqtest(int (*fcn) ())
+static euxlValue eqtest(int (*fcn) ())
{
static char *cfn_name = "eq/eql/equal";
- LVAL arg1 = xlgetarg();
- LVAL arg2 = xlgetarg();
+ euxlValue arg1 = xlgetarg();
+ euxlValue arg2 = xlgetarg();
xllastarg();
return ((*fcn) (arg1, arg2) ? true : NIL);
}
// xgensym - generate a symbol
-LVAL xgensym()
+euxlValue xgensym()
{
static char *cfn_name = "gensym";
// get the prefix or number
if (moreargs())
{
- LVAL x;
+ euxlValue x;
if ((x = xlgetarg()) == NIL)
{
xlbadtype(x, "symbol, string, or integer", cfn_name);
@@ -1296,13 +1296,13 @@ LVAL xgensym()
}
// xsprintf -- used by format
-LVAL xsprintf()
+euxlValue xsprintf()
{
static char *cfn_name = "xsprintf";
- LVAL arg = xlgastring();
- LVAL ch = xlgachar();
- LVAL val = xlgafloat();
+ euxlValue arg = xlgastring();
+ euxlValue ch = xlgachar();
+ euxlValue val = xlgafloat();
xllastarg();
char buf[128], fmt[128];
View
410 EuXLisp/euxlfun2.c
@@ -1,6 +1,6 @@
/// Copyright 1988 David Michael Betz
/// Copyright 1994 Russell Bradford
-/// Copyright 2010 Henry G. Weller
+/// Copyright 2010, 2011 Henry G. Weller
///-----------------------------------------------------------------------------
// This file is part of
/// --- EuLisp System 'EuXLisp'
@@ -31,22 +31,22 @@
///-----------------------------------------------------------------------------
/// External variables
///-----------------------------------------------------------------------------
-extern LVAL xlfun, xlenv, xlval;
+extern euxlValue xlfun, xlenv, xlval;
extern int prbreadth, prdepth;
extern FILE *tfp;
///-----------------------------------------------------------------------------
/// Forward declarations
///-----------------------------------------------------------------------------
-static void do_maploop(LVAL last);
+static void do_maploop(euxlValue last);
static void do_forloop();
static void do_withfile(int flags, char *mode);
-static void do_load(LVAL print);
-static void do_loadloop(LVAL print);
-static LVAL setit(int *pvar);
-static LVAL openfile(int flags, char *mode);
-static LVAL strcompare(int fcn, int icase);
-static LVAL chrcompare(int fcn, int icase);
+static void do_load(euxlValue print);
+static void do_loadloop(euxlValue print);
+static euxlValue setit(int *pvar);
+static euxlValue openfile(int flags, char *mode);
+static euxlValue strcompare(int fcn, int icase);
+static euxlValue chrcompare(int fcn, int icase);
///-----------------------------------------------------------------------------
/// Functions
@@ -60,7 +60,7 @@ void xapply()
// get the function
xlval = xlgetarg();
- LVAL arglist = xlsp[xlargc - 1];
+ euxlValue arglist = xlsp[xlargc - 1];
if (!listp(arglist))
{
xlbadtype(arglist, "<list>", cfn_name);
@@ -75,7 +75,7 @@ void xapply()
// shift up (or down) explicit args
if (nargs == 0)
{
- LVAL *from, *to;
+ euxlValue *from, *to;
int i;
for
(
@@ -91,7 +91,7 @@ void xapply()
else
{
xlsp -= nargs - 1;
- LVAL *from, *to;
+ euxlValue *from, *to;
int i;
for (from = xlsp + nargs - 1, to = xlsp, i = 0; i < xlargc; i++)
{
@@ -100,7 +100,7 @@ void xapply()
}
// copy the list arguments onto the stack
- for (LVAL *to = xlsp + xlargc; consp(arglist); arglist = cdr(arglist))
+ for (euxlValue *to = xlsp + xlargc; consp(arglist); arglist = cdr(arglist))
{
*to++ = car(arglist);
}
@@ -119,7 +119,7 @@ void xvalues()
// get the function
xlval = xlgetarg();