BSD 3 development

Work on file usr/src/cmd/lisp/lam4.c

Synthesized-from: 3bsd

diff --git a/usr/src/cmd/lisp/lam4.c b/usr/src/cmd/lisp/lam4.c
new file mode 100644 (file)
index 0000000..423e9a9
--- /dev/null
+++ b/usr/src/cmd/lisp/lam4.c
@@ -0,0 +1,389 @@
+#include "global.h"
+#define protect(z) (np++->val = (z))
+typedef struct argent *ap;
+static int restype;
+static int prunep; lispval adbig(),subbig(),mulbig();
+lispval
+Ladd()
+{
+       register lispval work;
+       register ap result, mynp, oldnp, lbot, np;
+       int itemp;
+
+       oldnp = result = np;
+       protect(rdrsdot);
+       rdrsdot->CDR = (lispval) 0;
+       rdrsdot->I =0;
+       restype = SDOT;
+       prunep = TRUE;
+
+       for(mynp = lbot; mynp < oldnp; mynp++)
+       {
+               work = mynp->val;
+               switch(TYPE(work)) {
+               case INT:
+                       switch(restype) {
+                       case DOUB:
+                               result->val->r += work->i;
+                               break;
+                       case SDOT:
+                               dmlad(result->val,1,work->i);
+                               prunep = TRUE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case SDOT:
+                       switch(restype) {
+                       case DOUB:
+                               error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case SDOT:
+                               result->val = adbig(work,result->val);
+                               restype = TYPE(result->val);
+                               if(restype==INT) {
+                                       rdrsdot->I=result->val->I;
+                                       rdrsdot->CDR = (lispval) 0;
+                                       result->val = rdrsdot;
+                                       restype=SDOT;
+                                       prunep = TRUE;
+                               } else
+                                       prunep = FALSE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case DOUB:
+                       switch(restype) {
+                       case SDOT:
+                               if(result->val->CDR==(lispval) 0) {
+                                       protect(newdoub());
+                                       np[-1].val->r = result->val->i+work->r;
+                                       result->val = np[-1].val;
+                                       np--;
+                                       restype = DOUB;
+                               } else 
+                                       error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case DOUB:
+                               result->val->r += work->r;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               default:
+                       error("Non-number to add",FALSE);
+               }
+       }
+       if(restype==DOUB || prunep==FALSE)
+               return(result->val);
+       else if (result->val->CDR==(lispval) 0)
+               return(inewint(result->val->I));
+       else {
+               struct sdot dummybig;
+
+               dummybig.I = 0;
+               dummybig.CDR = (lispval) 0;
+               return(adbig(&dummybig,result->val));
+       }
+       urk:
+               error("Internal error in (add,sub,quo,times)",FALSE);
+}
+lispval
+Lsub()
+{
+       register lispval work;
+       register ap result, mynp, oldnp, lbot, np;
+       int itemp;
+       lispval Lminus();
+
+       oldnp = result = np;
+       mynp = lbot + 1;
+       protect(rdrsdot);
+       rdrsdot->CDR = (lispval) 0;
+       rdrsdot->I =0;
+       restype = SDOT;
+       prunep = TRUE;
+       if(oldnp==lbot)
+               goto out;
+       if(oldnp==mynp)
+               return(Lminus());
+       work = lbot->val;
+       switch(TYPE(work)) {
+       case INT:
+               rdrsdot->I = work->i;
+               break;
+       case SDOT:
+               result->val = adbig(result->val,work);
+               if(TYPE(result->val)==INT) {
+                       rdrsdot->I = result->val->i;
+                       result->val = rdrsdot;
+               }
+               break;
+       case DOUB:
+               (result->val = newdoub())->r = work->r;
+               restype = DOUB;
+       }
+
+       for(; mynp < oldnp; mynp++)
+       {
+               work = mynp->val;
+               switch(TYPE(work)) {
+               case INT:
+                       switch(restype) {
+                       case DOUB:
+                               result->val->r -= work->i;
+                               break;
+                       case SDOT:
+                               dmlad(result->val,1, -work->i);
+                               prunep = TRUE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case SDOT:
+                       switch(restype) {
+                       case DOUB:
+                               error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case SDOT:
+                               result->val = subbig(result->val,work);
+                               restype = TYPE(result->val);
+                               if(restype==INT) {
+                                       rdrsdot->I=result->val->I;
+                                       rdrsdot->CDR = (lispval) 0;
+                                       result->val = rdrsdot;
+                                       restype=SDOT;
+                                       prunep = TRUE;
+                               } else
+                                       prunep = FALSE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case DOUB:
+                       switch(restype) {
+                       case SDOT:
+                               if(result->val->CDR==(lispval) 0) {
+                                       protect(newdoub());
+                                       np[-1].val->r = result->val->i-work->r;
+                                       result->val = np[-1].val;
+                                       np--;
+                                       restype = DOUB;
+                               } else 
+                                       error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case DOUB:
+                               result->val->r -= work->r;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               default:
+                       error("Non-number to minus",FALSE);
+               }
+       }
+out:
+       if(restype==DOUB || prunep==FALSE)
+               return(result->val);
+       else if (result->val->CDR==(lispval) 0)
+               return(inewint(result->val->I));
+       else {
+               struct sdot dummybig;
+
+               dummybig.I = 0;
+               dummybig.CDR = (lispval) 0;
+               return(adbig(&dummybig,result->val));
+       }
+       urk:
+               error("Internal error in (add,sub,quo,times)",FALSE);
+}
+lispval
+Ltimes()
+{
+       register lispval work;
+       register ap result, mynp, oldnp, lbot, np;
+       int itemp;
+
+       oldnp = result = np;
+       protect(rdrsdot);
+       rdrsdot->CDR = (lispval) 0;
+       rdrsdot->I = 1;
+       restype = SDOT;
+       prunep = TRUE;
+
+       for(mynp = lbot; mynp < oldnp; mynp++)
+       {
+               work = mynp->val;
+               switch(TYPE(work)) {
+               case INT:
+                       switch(restype) {
+                       case DOUB:
+                               result->val->r *= work->i;
+                               break;
+                       case SDOT:
+                               dmlad(result->val,work->i,0);
+                               prunep = TRUE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case SDOT:
+                       switch(restype) {
+                       case DOUB:
+                               error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case SDOT:
+                               result->val = mulbig(work,result->val);
+                               restype = TYPE(result->val);
+                               if(restype==INT) {
+                                       if(result->val->i==0)
+                                               return(result->val);
+                                       rdrsdot->I=result->val->I;
+                                       rdrsdot->CDR = (lispval) 0;
+                                       result->val = rdrsdot;
+                                       restype=SDOT;
+                                       prunep = TRUE;
+                               } else
+                                       prunep = FALSE;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               case DOUB:
+                       switch(restype) {
+                       case SDOT:
+                               if(result->val->CDR==(lispval) 0) {
+                                       protect(newdoub());
+                                       np[-1].val->r = result->val->i*work->r;
+                                       result->val = np[-1].val;
+                                       np--;
+                                       restype = DOUB;
+                               } else 
+                                       error("Don't know how to make bignums into reals, yet",FALSE);
+                               break;
+                       case DOUB:
+                               result->val->r *= work->r;
+                               break;
+                       default:
+                               goto urk;
+                       }
+                       break;
+               default:
+                       error("Non-number to times",FALSE);
+               }
+       }
+       if(restype==DOUB || prunep==FALSE)
+               return(result->val);
+       else if (result->val->CDR==(lispval) 0)
+               return(inewint(result->val->I));
+       else {
+               struct sdot dummybig;
+
+               dummybig.I = 0;
+               dummybig.CDR = (lispval) 0;
+               return(adbig(&dummybig,result->val));
+       }
+       urk:
+               error("Internal error in (add,sub,quo,times)",FALSE);
+}
+lispval
+Lquo()
+{
+       register lispval work;
+       register lispval result;
+       register struct argent *mynp;
+       register struct argent *oldnp, *lbot, *np;
+       int bigflag = 0, realflag = 0, itemp;
+       struct sdot dummybig;
+       lispval divbig(), *resaddr;
+
+       mynp = lbot;
+       oldnp = np-1;
+       dummybig.CDR = (lispval) 0;
+       dummybig.I = 1;
+       if(mynp > oldnp) goto out;
+       work = (mynp++)->val;
+       itemp = TYPE(work);
+       switch(itemp) {
+       case INT:
+               dummybig.I = work->i;
+               break;
+       case DOUB:
+               realflag = 1;
+               protect(result = newdoub());
+               result->r = work->r;
+               break;
+       case SDOT:
+               protect(work);
+               resaddr = &(np[-1].val);
+               bigflag = 1;
+               break;
+       default:
+               error("Don't know how to divide this type.",FALSE);
+       }
+       for(;mynp <= oldnp; mynp++) {
+               work = mynp->val;
+               itemp = TYPE(work);
+               switch(itemp) {
+
+               case INT:
+                       if (work->i==0)
+                               kill(getpid(),8);
+                       if (realflag)
+                               result->r /= work->i;
+                       else if(bigflag) {
+                               dummybig.I = work->i;
+                               divbig(*resaddr, &dummybig, resaddr, 0);
+                       } else {
+                               dummybig.I /= work->i;
+                       }
+                       break;
+               case DOUB:
+                       if(realflag)
+                               result->r /= work->r;
+                       else if(bigflag)
+                               error("Don't know how to make bignums into reals, yet",FALSE);
+                       else {
+                               realflag = 1;
+                               result = newdoub();
+                               result->r = (double) dummybig.I / work->r;
+                               protect(result);
+                       }
+                       break;
+               case SDOT:
+                       if(realflag)
+                               error("Don't know how to divide reals by bignums ",FALSE);
+                       else if(bigflag)
+                               divbig(*resaddr, work, resaddr, 0);
+                       else {
+                               bigflag = 1;
+                               protect(newsdot());
+                               resaddr = &(np[-1].val);
+                               np[-1].val->i = dummybig.I;
+                               divbig(*resaddr, work, resaddr, 0);
+                       }
+                       break;
+               default:
+                       error("Don't know how to divide this type",FALSE);
+
+               }
+       }
+out:
+       if(realflag)
+               return(result);
+       else if (bigflag)
+               return(*resaddr);
+       else {
+               result = inewint(  dummybig.I );
+               return(result);
+       }
+}