+#ifndef lint
+static char *rcsid =
+ "$Header: lam1.c,v 1.8 87/12/14 18:39:12 sklower Exp $";
+#endif
+
+/* -[Fri Feb 17 16:44:24 1984 by layer]-
+ * lam1.c $Locker: $
+ * lambda functions
+ *
+ * (c) copyright 1982, Regents of the University of California
+ */
+
+# include "global.h"
+# include <sgtty.h>
+# include "chkrtab.h"
+# include "frame.h"
+
+lispval
+Leval()
+{
+ register lispval temp;
+
+ chkarg(1,"eval");
+ temp = lbot->val;
+ return(eval(temp));
+}
+
+lispval
+Lxcar()
+{ register int typ;
+ register lispval temp, result;
+
+ chkarg(1,"xcar");
+ temp = lbot->val;
+ if (((typ = TYPE(temp)) == DTPR) || (typ == ATOM) || HUNKP(temp))
+ return(temp->d.car);
+ else if(typ == SDOT) {
+ result = inewint(temp->i);
+ return(result);
+ } else if(Schainp!=nil && typ==ATOM)
+ return(nil);
+ else
+ return(error("Bad arg to car",FALSE));
+
+}
+
+lispval
+Lxcdr()
+{ register int typ;
+ register lispval temp;
+
+ chkarg(1,"xcdr");
+ temp = lbot->val;
+ if(temp==nil) return (nil);
+
+ if (((typ = TYPE(temp)) == DTPR) || HUNKP(temp))
+ return(temp->d.cdr);
+ else if(typ==SDOT) {
+ if(temp->s.CDR==0) return(nil);
+ temp = temp->s.CDR;
+ if(TYPE(temp)==DTPR)
+ errorh1(Vermisc,"Fell off the end of a bignum",nil,FALSE,5,lbot->val);
+ return(temp);
+ } else if(Schainp!=nil && typ==ATOM)
+ return(nil);
+ else
+ return(error("Bad arg to cdr", FALSE));
+}
+
+lispval
+cxxr(as,ds)
+register int as,ds;
+{
+
+ register lispval temp, temp2;
+ int i, typ;
+ lispval errorh();
+
+ chkarg(1,"c{ad}+r");
+ temp = lbot->val;
+
+ for( i=0 ; i<ds ; i++)
+ {
+ if( temp != nil)
+ {
+ typ = TYPE(temp);
+ if ((typ == DTPR) || HUNKP(temp))
+ temp = temp->d.cdr;
+ else
+ if(typ==SDOT)
+ {
+ if(temp->s.CDR==0)
+ temp = nil;
+ else
+ temp = temp->s.CDR;
+ if(TYPE(temp)==DTPR)
+ errorh1(Vermisc,"Fell off the end of a bignum",nil,FALSE,5,lbot->val);
+ }
+ else
+ if(Schainp!=nil && typ==ATOM)
+ return(nil);
+ else
+ return(errorh1(Vermisc,"Bad arg to cdr",nil,FALSE,5,temp));
+ }
+ }
+
+ for( i=0 ; i<as ; i++)
+ {
+ if( temp != nil )
+ {
+ typ = TYPE(temp);
+ if ((typ == DTPR) || HUNKP(temp))
+ temp = temp->d.car;
+ else if(typ == SDOT)
+ temp2 = inewint(temp->i), temp = temp2;
+ else if(Schainp!=nil && typ==ATOM)
+ return(nil);
+ else
+ return(errorh1(Vermisc,"Bad arg to car",nil,FALSE,5,temp));
+ }
+ }
+
+ return(temp);
+}
+
+lispval
+Lcar()
+{ return(cxxr(1,0)); }
+
+lispval
+Lcdr()
+{ return(cxxr(0,1)); }
+
+lispval
+Lcadr()
+{ return(cxxr(1,1)); }
+
+lispval
+Lcaar()
+{ return(cxxr(2,0)); }
+
+lispval
+Lc02r()
+{ return(cxxr(0,2)); } /* cddr */
+
+lispval
+Lc12r()
+{ return(cxxr(1,2)); } /* caddr */
+
+lispval
+Lc03r()
+{ return(cxxr(0,3)); } /* cdddr */
+
+lispval
+Lc13r()
+{ return(cxxr(1,3)); } /* cadddr */
+
+lispval
+Lc04r()
+{ return(cxxr(0,4)); } /* cddddr */
+
+lispval
+Lc14r()
+{ return(cxxr(1,4)); } /* caddddr */
+
+/*
+ *
+ * (nthelem num list)
+ *
+ * Returns the num'th element of the list, by doing a caddddd...ddr
+ * where there are num-1 d's. If num<=0 or greater than the length of
+ * the list, we return nil.
+ *
+ */
+
+lispval
+Lnthelem()
+{
+ register lispval temp;
+ register int i;
+
+ chkarg(2,"nthelem");
+
+ if( TYPE(temp = lbot->val) != INT)
+ return (error ("First arg to nthelem must be a fixnum",FALSE));
+
+ i = temp->i; /* pick up the first arg */
+
+ if( i <= 0) return(nil);
+
+ ++lbot; /* fix lbot for call to cxxr() 'cadddd..r' */
+ temp = cxxr(1,i-1);
+ --lbot;
+
+ return(temp);
+}
+
+lispval
+Lscons()
+{
+ register struct argent *argp = lbot;
+ register lispval retp, handy;
+
+ chkarg(2,"scons");
+ retp = newsdot();
+ handy = (argp) -> val;
+ if(TYPE(handy)!=INT)
+ error("First arg to scons must be an int.",FALSE);
+ retp->s.I = handy->i;
+ handy = (argp+1)->val;
+ if(handy==nil)
+ retp->s.CDR = (lispval) 0;
+ else {
+ if(TYPE(handy)!=SDOT)
+ error("Currently you may only link sdots to sdots.",FALSE);
+ retp->s.CDR = handy;
+ }
+ return(retp);
+}
+
+lispval
+Lbigtol(){
+ register lispval handy,newp;
+
+ chkarg(1,"Bignum-to-list");
+ handy = lbot->val;
+ while(TYPE(handy)!=SDOT)
+ handy = errorh1(Vermisc,
+ "Non bignum argument to Bignum-to-list",
+ nil,TRUE,5755,handy);
+ protect(newp = newdot());
+ while(handy) {
+ newp->d.car = inewint((long)handy->s.I);
+ if(handy->s.CDR==(lispval) 0) break;
+ newp->d.cdr = newdot();
+ newp = newp->d.cdr;
+ handy = handy->s.CDR;
+ }
+ handy = (--np)->val;
+ return(handy);
+}
+
+lispval
+Lcons()
+{
+ register lispval retp;
+ register struct argent *argp;
+
+ chkarg(2,"cons");
+ retp = newdot();
+ retp->d.car = ((argp = lbot) -> val);
+ retp->d.cdr = argp[1].val;
+ return(retp);
+}
+#define CA 0
+#define CD 1
+
+lispval
+rpla(what)
+int what;
+{ register struct argent *argp;
+ register int typ; register lispval first, second;
+
+ chkarg(2,"rplac[ad]");
+ argp = np-1;
+ first = (argp-1)->val;
+ while(first==nil)
+ first = error("Attempt to rplac[ad] nil.",TRUE);
+ second = argp->val;
+ if (((typ = TYPE(first)) == DTPR) || (typ == ATOM) || HUNKP(first)) {
+ if (what == CA)
+ first->d.car = second;
+ else
+ first->d.cdr = second;
+ return(first);
+ }
+ if (typ==SDOT) {
+ if(what == CA) {
+ typ = TYPE(second);
+ if(typ!=INT) error("Rplacca of a bignum will only replace INTS",FALSE);
+ first->s.I = second->i;
+ } else {
+ if(second==nil)
+ first->s.CDR = (lispval) 0;
+ else
+ first->s.CDR = second;
+ }
+ return(first);
+ }
+ return(error("Bad arg to rpla",FALSE));
+}
+lispval
+Lrplca()
+{ return(rpla(CA)); }
+
+lispval
+Lrplcd()
+{ return(rpla(CD)); }
+
+
+lispval
+Leq()
+{
+ register struct argent *mynp = lbot + AD;
+
+ chkarg(2,"eq");
+ if(mynp->val==(mynp+1)->val) return(tatom);
+ return(nil);
+}
+
+
+
+lispval
+Lnull()
+{ chkarg(1,"null");
+ return ((lbot->val == nil) ? tatom : nil);
+}
+
+
+
+/* Lreturn **************************************************************/
+/* Returns the first argument - which is nill if not specified. */
+
+lispval
+Lreturn()
+{
+ if(lbot==np) protect (nil);
+ Inonlocalgo(C_RET,lbot->val,nil);
+ /* NOT REACHED */
+}
+
+
+lispval
+Linfile()
+{
+ FILE *port;
+ register lispval name;
+
+ chkarg(1,"infile");
+ name = lbot->val;
+loop:
+ name = verify(name,"infile: file name must be atom or string");
+ /* return nil if file couldnt be opened
+ if ((port = fopen((char *)name,"r")) == NULL) return(nil); */
+
+ if ((port = fopen((char *)name,"r")) == NULL) {
+ name = errorh1(Vermisc,"Unable to open file for reading.",nil,TRUE,31,name);
+ goto loop;
+ }
+ ioname[PN(port)] = (lispval) inewstr((char *)name); /* remember name */
+ return(P(port));
+}
+
+/* outfile - open a file for writing.
+ * 27feb81 [jkf] - modifed to accept two arguments, the second one being a
+ * string or atom, which if it begins with an `a' tells outfile to open the
+ * file in append mode
+ */
+lispval
+Loutfile()
+{
+ FILE *port; register lispval name;
+ char *mode ="w"; /* mode is w for create new file, a for append */
+ char *given;
+
+ if(lbot+1== np) protect(nil);
+ chkarg(2,"outfile");
+ name = lbot->val;
+ given = (char *)verify((lbot+1)->val,"Illegal file open mode.");
+ if(*given == 'a') mode = "a";
+loop:
+ name = verify(name,"Please supply atom or string name for port.");
+#ifdef os_vms
+ /*
+ * If "w" mode, open it as a "txt" file for convenience in VMS
+ */
+ if (strcmp(mode,"w") == 0) {
+ int fd;
+
+ if ((fd = creat(name,0777,"txt")) < 0) {
+ name = errorh1(Vermisc,"Unable to open file for writing.",nil,TRUE,31,name);
+ goto loop;
+ }
+ port = fdopen(fd,mode);
+ } else
+#endif
+ if ((port = fopen((char *)name,mode)) == NULL) {
+ name = errorh1(Vermisc,"Unable to open file for writing.",nil,TRUE,31,name);
+ goto loop;
+ }
+ ioname[PN(port)] = (lispval) inewstr((char *)name);
+ return(P(port));
+}
+
+lispval
+Lterpr()
+{
+ register lispval handy;
+ FILE *port;
+
+ if(lbot==np) handy = nil;
+ else
+ {
+ chkarg(1,"terpr");
+ handy = lbot->val;
+ }
+
+ port = okport(handy,okport(Vpoport->a.clb,stdout));
+ putc('\n',port);
+ fflush(port);
+ return(nil);
+}
+
+lispval
+Lclose()
+{
+ lispval port;
+
+ chkarg(1,"close");
+ port = lbot->val;
+ if((TYPE(port))==PORT) {
+ fclose(port->p);
+ ioname[PN(port->p)] = nil;
+ return(tatom);
+ }
+ errorh1(Vermisc,"close:Non-port",nil,FALSE,987,port);
+ /* not reached */
+}
+
+lispval
+Ltruename()
+{
+ chkarg(1,"truename");
+ if(TYPE(lbot->val) != PORT)
+ errorh1(Vermisc,"truename: non port argument",nil,FALSE,0,lbot->val);
+
+ return(ioname[PN(lbot->val->p)]);
+}
+
+lispval
+Lnwritn()
+{
+ register FILE *port;
+ register value;
+ register lispval handy;
+
+ if(lbot==np) handy = nil;
+ else
+ {
+ chkarg(1,"nwritn");
+ handy = lbot->val;
+ }
+
+ port = okport(handy,okport(Vpoport->a.clb,stdout));
+ value = port->_ptr - port->_base;
+ return(inewint(value));
+}
+
+lispval
+Ldrain()
+{
+ register FILE *port;
+ register int iodes;
+ register lispval handy;
+ struct sgttyb arg;
+
+ if(lbot==np) handy = nil;
+ else
+ {
+ chkarg(1,"nwritn");
+ handy = lbot->val;
+ }
+ port = okport(handy, okport(Vpoport->a.clb,stdout));
+ if(port->_flag & _IOWRT) {
+ fflush(port);
+ return(nil);
+ }
+ if(! port->_flag & _IOREAD) return(nil);
+ port->_cnt = 0;
+ port->_ptr = port->_base;
+ iodes = fileno(port);
+ if(gtty(iodes,&arg) != -1) stty(iodes,&arg);
+ return(P(port));
+}
+
+lispval
+Llist()
+{
+ /* added for the benefit of mapping functions. */
+ register struct argent *ulim, *namptr;
+ register lispval temp, result;
+ Savestack(4);
+
+ ulim = np;
+ namptr = lbot + AD;
+ temp = result = (lispval) np;
+ protect(nil);
+ for(; namptr < ulim;) {
+ temp = temp->l = newdot();
+ temp->d.car = (namptr++)->val;
+ }
+ temp->l = nil;
+ Restorestack();
+ return(result->l);
+}
+
+lispval
+Lnumberp()
+{
+ chkarg(1,"numberp");
+ switch(TYPE(lbot->val)) {
+ case INT: case DOUB: case SDOT:
+ return(tatom);
+ }
+ return(nil);
+}
+
+lispval
+Latom()
+{
+ register struct argent *lb = lbot;
+ chkarg(1,"atom");
+ if(TYPE(lb->val)==DTPR || (HUNKP(lb->val)))
+ return(nil);
+ else
+ return(tatom);
+}
+
+lispval
+Ltype()
+{
+ chkarg(1,"type");
+ switch(TYPE(lbot->val)) {
+ case INT:
+ return(int_name);
+ case ATOM:
+ return(atom_name);
+ case SDOT:
+ return(sdot_name);
+ case DOUB:
+ return(doub_name);
+ case DTPR:
+ return(dtpr_name);
+ case STRNG:
+ return(str_name);
+ case ARRAY:
+ return(array_name);
+ case BCD:
+ return(funct_name);
+ case OTHER:
+ return(other_name);
+
+ case HUNK2:
+ return(hunk_name[0]);
+ case HUNK4:
+ return(hunk_name[1]);
+ case HUNK8:
+ return(hunk_name[2]);
+ case HUNK16:
+ return(hunk_name[3]);
+ case HUNK32:
+ return(hunk_name[4]);
+ case HUNK64:
+ return(hunk_name[5]);
+ case HUNK128:
+ return(hunk_name[6]);
+
+ case VECTOR:
+ return(vect_name);
+ case VECTORI:
+ return(vecti_name);
+
+ case VALUE:
+ return(val_name);
+ case PORT:
+ return(port_name);
+ }
+ return(nil);
+}
+
+lispval
+Ldtpr()
+{
+ chkarg(1,"dtpr");
+ return(typred(DTPR, lbot->val));
+}
+
+lispval
+Lbcdp()
+{
+ chkarg(1,"bcdp");
+ return(typred(BCD, lbot->val));
+}
+
+lispval
+Lportp()
+{
+ chkarg(1,"portp");
+ return(typred(PORT, lbot->val));
+}
+
+lispval
+Larrayp()
+{
+ chkarg(1,"arrayp");
+ return(typred(ARRAY, lbot->val));
+}
+
+/*
+ * (hunkp 'g_arg1)
+ * Returns t if g_arg1 is a hunk, otherwise returns nil.
+ */
+
+lispval
+Lhunkp()
+{
+ chkarg(1,"hunkp");
+ if (HUNKP(lbot->val))
+ return(tatom); /* If a hunk, return t */
+ else
+ return(nil); /* else nil */
+}
+
+lispval
+Lset()
+{
+ lispval varble;
+
+ chkarg(2,"set");
+ varble = lbot->val;
+ switch(TYPE(varble))
+ {
+ case ATOM: return(varble->a.clb = lbot[1].val);
+
+ case VALUE: return(varble->l = lbot[1].val);
+ }
+
+ error("IMPROPER USE OF SET",FALSE);
+ /* NOTREACHED */
+}
+
+lispval
+Lequal()
+{
+ register lispval first, second;
+ register type1, type2;
+ lispval Lsub(),Lzerop();
+ long *oldsp;
+ Keepxs();
+ chkarg(2,"equal");
+
+
+ if(lbot->val==lbot[1].val) return(tatom);
+
+ oldsp=sp(); stack((long)lbot->val);stack((long)lbot[1].val);
+ for(;oldsp > sp();) {
+
+ first = (lispval) unstack(); second = (lispval) unstack();
+ again:
+ if(first==second) continue;
+
+ type1=TYPE(first); type2=TYPE(second);
+ if(type1!=type2) {
+ if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT))
+ goto dosub;
+ {Freexs(); return(nil);}
+ }
+ switch(type1) {
+ case DTPR:
+ stack((long)first->d.cdr); stack((long)second->d.cdr);
+ first = first->d.car; second = second->d.car;
+ goto again;
+ case DOUB:
+ if(first->r!=second->r)
+ {Freexs(); return(nil);}
+ continue;
+ case INT:
+ if(first->i!=second->i)
+ {Freexs(); return(nil);}
+ continue;
+ case VECTOR:
+ if(!vecequal(first,second)) {Freexs(); return(nil);}
+ continue;
+ case VECTORI:
+ if(!veciequal(first,second)) {Freexs(); return(nil);}
+ continue;
+ dosub:
+ case SDOT: {
+ lispval temp;
+ struct argent *OLDlbot = lbot;
+ lbot = np;
+ np++->val = first;
+ np++->val = second;
+ temp = Lsub();
+ np = lbot;
+ lbot = OLDlbot;
+ if(TYPE(temp)!=INT || temp->i!=0)
+ {Freexs(); return(nil);}
+ }
+ continue;
+ case VALUE:
+ if(first->l!=second->l)
+ {Freexs(); return(nil);}
+ continue;
+ case STRNG:
+ if(strcmp((char *)first,(char *)second)!=0)
+ {Freexs(); return(nil);}
+ continue;
+
+ default:
+ {Freexs(); return(nil);}
+ }
+ }
+ {Freexs(); return(tatom);}
+}
+lispval
+oLequal()
+{
+ chkarg(2,"equal");
+
+ if( lbot[1].val == lbot->val ) return(tatom);
+ if(Iequal(lbot[1].val,lbot->val)) return(tatom); else return(nil);
+}
+
+Iequal(first,second)
+register lispval first, second;
+{
+ register type1, type2;
+ lispval Lsub(),Lzerop();
+
+ if(first==second)
+ return(1);
+ type1=TYPE(first);
+ type2=TYPE(second);
+ if(type1!=type2) {
+ if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT))
+ goto dosub;
+ return(0);
+ }
+ switch(type1) {
+ case DTPR:
+ return(
+ Iequal(first->d.car,second->d.car) &&
+ Iequal(first->d.cdr,second->d.cdr) );
+ case DOUB:
+ return(first->r==second->r);
+ case INT:
+ return( (first->i==second->i));
+dosub:
+ case SDOT:
+ {
+ lispval temp;
+ struct argent *OLDlbot = lbot;
+ lbot = np;
+ np++->val = first;
+ np++->val = second;
+ temp = Lsub();
+ np = lbot;
+ lbot = OLDlbot;
+ return(TYPE(temp)==INT&& temp->i==0);
+ }
+ case VALUE:
+ return( first->l==second->l );
+ case STRNG:
+ return(strcmp((char *)first,(char *)second)==0);
+ }
+ return(0);
+}
+lispval
+Zequal()
+{
+ register lispval first, second;
+ register type1, type2;
+ lispval Lsub(),Lzerop();
+ long *oldsp;
+ Keepxs();
+ chkarg(2,"equal");
+
+
+ if(lbot->val==lbot[1].val) return(tatom);
+
+ oldsp=sp(); stack((long)lbot->val);stack((long)lbot[1].val);
+
+ for(;oldsp > sp();) {
+
+ first = (lispval) unstack(); second = (lispval) unstack();
+ again:
+ if(first==second) continue;
+
+ type1=TYPE(first); type2=TYPE(second);
+ if(type1!=type2) {
+ if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT))
+ goto dosub;
+ {Freexs(); return(nil);}
+ }
+ switch(type1) {
+ case DTPR:
+ stack((long)first->d.cdr); stack((long)second->d.cdr);
+ first = first->d.car; second = second->d.car;
+ goto again;
+ case DOUB:
+ if(first->r!=second->r)
+ {Freexs(); return(nil);}
+ continue;
+ case INT:
+ if(first->i!=second->i)
+ {Freexs(); return(nil);}
+ continue;
+ dosub:
+ case SDOT:
+ {
+ lispval temp;
+ struct argent *OLDlbot = lbot;
+ lbot = np;
+ np++->val = first;
+ np++->val = second;
+ temp = Lsub();
+ np = lbot;
+ lbot = OLDlbot;
+ if(TYPE(temp)!=INT || temp->i!=0)
+ {Freexs(); return(nil);}
+ }
+ continue;
+ case VALUE:
+ if(first->l!=second->l)
+ {Freexs(); return(nil);}
+ continue;
+ case STRNG:
+ if(strcmp((char *)first,(char *)second)!=0)
+ {Freexs(); return(nil);}
+ continue;
+ }
+ }
+ {Freexs(); return(tatom);}
+}
+
+/*
+ * (print 'expression ['port]) prints the given expression to the given
+ * port or poport if no port is given. The amount of structure
+ * printed is a function of global lisp variables plevel and
+ * plength.
+ */
+lispval
+Lprint()
+{
+ register lispval handy;
+ extern int plevel,plength;
+
+
+ handy = nil; /* port is optional, default nil */
+ switch(np-lbot)
+ {
+ case 2: handy = lbot[1].val;
+ case 1: break;
+ default: argerr("print");
+ }
+
+ chkrtab(Vreadtable->a.clb);
+ if(TYPE(Vprinlevel->a.clb) == INT)
+ {
+ plevel = Vprinlevel->a.clb->i;
+ }
+ else plevel = -1;
+ if(TYPE(Vprinlength->a.clb) == INT)
+ {
+ plength = Vprinlength->a.clb->i;
+ }
+ else plength = -1;
+ printr(lbot->val,okport(handy,okport(Vpoport->a.clb,poport)));
+ return(nil);
+}
+
+/* patom does not use plevel or plength
+ *
+ * form is (patom 'value ['port])
+ */
+lispval
+Lpatom()
+{
+ register lispval temp;
+ register lispval handy;
+ register int typ;
+ FILE *port;
+
+ handy = nil; /* port is optional, default nil */
+ switch(np-lbot)
+ {
+ case 2: handy = lbot[1].val;
+ case 1: break;
+ default: argerr("patom");
+ }
+
+ temp = Vreadtable->a.clb;
+ chkrtab(temp);
+ port = okport(handy, okport(Vpoport->a.clb,stdout));
+ if ((typ= TYPE((temp = (lbot)->val))) == ATOM)
+ fputs(temp->a.pname, port);
+ else if(typ == STRNG)
+ fputs((char *)temp,port);
+ else
+ {
+ if(TYPE(Vprinlevel->a.clb) == INT)
+ {
+ plevel = Vprinlevel->a.clb->i;
+ }
+ else plevel = -1;
+ if(TYPE(Vprinlength->a.clb) == INT)
+ {
+ plength = Vprinlength->a.clb->i;
+ }
+ else plength = -1;
+
+ printr(temp, port);
+ }
+ return(temp);
+}
+
+/*
+ * (pntlen thing) returns the length it takes to print out
+ * an atom or number.
+ */
+
+lispval
+Lpntlen()
+{
+ return(inewint((long)Ipntlen()));
+}
+Ipntlen()
+{
+ register lispval temp;
+ register char *handy;
+
+ temp = np[-1].val;
+loop: switch(TYPE(temp)) {
+
+ case ATOM:
+ handy = temp->a.pname;
+ break;
+
+ case STRNG:
+ handy = (char *) temp;
+ break;
+
+ case INT:
+ sprintf(strbuf,"%d",temp->i);
+ handy =strbuf;
+ break;
+
+ case DOUB:
+ sprintf(strbuf,"%g",temp->r);
+ handy =strbuf;
+ break;
+
+ default:
+ temp = error("Non atom or number to pntlen\n",TRUE);
+ goto loop;
+ }
+
+ return( strlen(handy));
+}
+#undef okport
+FILE *
+okport(arg,proper)
+lispval arg;
+FILE *proper;
+{
+ if(TYPE(arg)!=PORT)
+ return(proper);
+ else
+ return(arg->p);
+}
projects / unix-history / commitdiff