lispval
Leval1(){
register struct nament *bindptr;
register lispval handy;
if (np-lbot == 2) { /*if two arguments to eval */
if (TYPE((lbot+1)->val) != INT)
error("Eval: 2nd arg not legal alist pointer", FALSE);
bindptr = orgbnp + (lbot+1)->val->i;
if (rsetsw == 0 || rsetatom->a.clb == nil)
error("Not in *rsetmode; second arg is useless - eval", TRUE);
if (bptr_atom->a.clb != nil)
error("WARNING - Nesting 2nd args to eval will give spurious values", TRUE);
if (bindptr < orgbnp || bindptr >bnplim)
error("Illegal pdl pointer as 2nd arg - eval", FALSE);
handy = newdot();
handy->d.car = (lispval)bindptr;
handy->d.cdr = (lispval)bnp;
PUSHDOWN(bptr_atom, handy);
handy = eval(lbot->val);
POP;
return(handy);
} else { /* normal case - only one arg */
chkarg(1,"eval");
handy = eval(lbot->val);
return(handy);
};
}
lispval
Lncons()
{
register lispval handy;
chkarg(1,"ncons");
handy = newdot();
handy->d.cdr = nil;
handy->d.car = lbot->val;
return(handy);
}
/*
*
* (oblist)
*
* oblist returns a list of all symbols in the oblist
*
* written by jkf.
*/
lispval
Loblist()
{
int indx;
lispval headp, tailp ;
struct atom *symb ;
extern int hashtop;
Savestack(0);
headp = tailp = newdot(); /* allocate first DTPR */
protect(headp); /*protect the list from garbage collection*/
/*line added by kls */
for( indx=0 ; indx <= hashtop-1 ; indx++ ) /* though oblist */
{
for( symb = hasht[indx] ;
symb != (struct atom *) CNIL ;
symb = symb-> hshlnk)
{
if(TYPE(symb) != ATOM)
{ printf(" non symbol in hasht[%d] = %x: ",indx,symb);
printr((lispval) symb,stdout);
printf(" \n");
fflush(stdout);
}
tailp->d.car = (lispval) symb ; /* remember this atom */
tailp = tailp->d.cdr = newdot() ; /* link to next DTPR */
}
}
tailp->d.cdr = nil ; /* close the list unfortunately throwing away
the last DTPR
*/
Restorestack();
return(headp);
}
lispval
Lwait()
{
register lispval ret, temp;
int status = -1, pid;
Savestack(2);
chkarg(0,"wait");
pid = wait(&status);
ret = newdot();
protect(ret);
temp = inewint(pid);
ret->d.car = temp;
temp = inewint(status);
ret->d.cdr = temp;
Restorestack();
return(ret);
}
lispval
Lpipe()
{
register lispval ret, temp;
int pipes[2];
Savestack(2);
chkarg(0,"pipe");
pipes[0] = -1;
pipes[1] = -1;
pipe(pipes);
ret = newdot();
protect(ret);
temp = inewint(pipes[0]);
ret->d.car = temp;
temp = inewint(pipes[1]);
ret->d.cdr = temp;
Restorestack();
return(ret);
}
lispval Nerrset()
{
lispval temp,flag;
pbuf pb;
Savestack(0);
if(TYPE(lbot->val) != DTPR) return(nil); /* no form */
/* evaluate and save flag first */
flag = lbot->val->d.cdr;
if(TYPE(flag) == DTPR) flag = eval(flag->d.car);
else flag = tatom; /* if not present , assume t */
protect(flag);
errp = Pushframe(F_CATCH,Verall,flag);
switch(retval) {
case C_THROW: /*
* error thrown to this routine, value thrown is
* in lispretval
*/
break;
case C_INITIAL: /*
* normally just evaluate expression and listify it.
*/
temp = eval(lbot->val->d.car);
protect(temp);
(lispretval = newdot())->d.car = temp;
break;
}
errp = Popframe();
Restorestack();
return(lispretval);
}
if(readp) fclose(obufs[1]);
if(wflag && child!= -1) {
int status=0;
/* we await the death of the child */
while(wait(&status)!=child) {}
/* the child has died */
signal(2,handler); /* restore the interrupt handler */
itemp = status >> 8;
Restorestack();
return(inewint(itemp)); /* return its status */
}
/* we are not waiting for the childs death
* build a list containing the write and read ports
*/
protect(handy = newdot());
handy->d.cdr = newdot();
handy->d.cdr->d.cdr = newdot();
if(readp) {
handy->d.car = P(obufs[0]);
ioname[PN(obufs[0])] = (lispval) inewstr((char *) "from-process");
}
if(writep) {
handy->d.cdr->d.car = P(bufs[1]);
ioname[PN(bufs[1])] = (lispval) inewstr((char *) "to-process");
}
handy->d.cdr->d.cdr->d.car = (lispval) inewint(child);
signal(SIGINT,handler);
Restorestack();
return(handy);
}
