BSD 4 release

[unix-history] / usr / src / cmd / lisp / lam4.c

diff --git a/usr/src/cmd/lisp/lam4.c b/usr/src/cmd/lisp/lam4.c
index 423e9a9..31647fe 100644 (file)
--- a/usr/src/cmd/lisp/lam4.c
+++ b/usr/src/cmd/lisp/lam4.c
@@ -1,19 +1,19 @@
+static char *sccsid = "@(#)lam4.c      34.1 10/3/80";
+

 #include "global.h"
 #include "global.h"

-#define protect(z) (np++->val = (z))

 typedef struct argent *ap;
 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;
 static int prunep; lispval adbig(),subbig(),mulbig();
 lispval
 Ladd()
 {
        register lispval work;
        register ap result, mynp, oldnp, lbot, np;

-       int itemp;
+       int itemp,restype;

 
        oldnp = result = np;
        protect(rdrsdot);
 
        oldnp = result = np;
        protect(rdrsdot);

-       rdrsdot->CDR = (lispval) 0;
-       rdrsdot->I =0;
+       rdrsdot->s.CDR = (lispval) 0;
+       rdrsdot->s.I =0;

        restype = SDOT;
        prunep = TRUE;
 
        restype = SDOT;
        prunep = TRUE;
 


@@ -43,8 +43,8 @@ Ladd()
                                result->val = adbig(work,result->val);
                                restype = TYPE(result->val);
                                if(restype==INT) {
                                result->val = adbig(work,result->val);
                                restype = TYPE(result->val);
                                if(restype==INT) {

-                                       rdrsdot->I=result->val->I;
-                                       rdrsdot->CDR = (lispval) 0;
+                                       rdrsdot->s.I=result->val->s.I;
+                                       rdrsdot->s.CDR = (lispval) 0;

                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;
                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;


@@ -58,7 +58,7 @@ Ladd()
                case DOUB:
                        switch(restype) {
                        case SDOT:
                case DOUB:
                        switch(restype) {
                        case SDOT:

-                               if(result->val->CDR==(lispval) 0) {
+                               if(result->val->s.CDR==(lispval) 0) {

                                        protect(newdoub());
                                        np[-1].val->r = result->val->i+work->r;
                                        result->val = np[-1].val;
                                        protect(newdoub());
                                        np[-1].val->r = result->val->i+work->r;
                                        result->val = np[-1].val;


@@ -75,13 +75,13 @@ Ladd()
                        }
                        break;
                default:
                        }
                        break;
                default:

-                       error("Non-number to add",FALSE);
+                       errorh(Vermisc,"Non-number to add",nil,0,FALSE,work);

                }
        }
        if(restype==DOUB || prunep==FALSE)
                return(result->val);
                }
        }
        if(restype==DOUB || prunep==FALSE)
                return(result->val);

-       else if (result->val->CDR==(lispval) 0)
-               return(inewint(result->val->I));
+       else if (result->val->s.CDR==(lispval) 0)
+               return(inewint(result->val->s.I));

        else {
                struct sdot dummybig;
 
        else {
                struct sdot dummybig;
 


@@ -97,29 +97,31 @@ Lsub()
 {
        register lispval work;
        register ap result, mynp, oldnp, lbot, np;
 {
        register lispval work;
        register ap result, mynp, oldnp, lbot, np;

-       int itemp;
+       int itemp,restype;

        lispval Lminus();
 
        oldnp = result = np;
        mynp = lbot + 1;
        protect(rdrsdot);
        lispval Lminus();
 
        oldnp = result = np;
        mynp = lbot + 1;
        protect(rdrsdot);

-       rdrsdot->CDR = (lispval) 0;
-       rdrsdot->I =0;
+       rdrsdot->s.CDR = (lispval) 0;
+       rdrsdot->s.I =0;

        restype = SDOT;
        prunep = TRUE;
        if(oldnp==lbot)
                goto out;
        restype = SDOT;
        prunep = TRUE;
        if(oldnp==lbot)
                goto out;

-       if(oldnp==mynp)
+       if(oldnp==mynp) {
+               np--;

                return(Lminus());
                return(Lminus());

+       }

        work = lbot->val;
        switch(TYPE(work)) {
        case INT:
        work = lbot->val;
        switch(TYPE(work)) {
        case INT:

-               rdrsdot->I = work->i;
+               rdrsdot->s.I = work->i;

                break;
        case SDOT:
                result->val = adbig(result->val,work);
                if(TYPE(result->val)==INT) {
                break;
        case SDOT:
                result->val = adbig(result->val,work);
                if(TYPE(result->val)==INT) {

-                       rdrsdot->I = result->val->i;
+                       rdrsdot->s.I = result->val->i;

                        result->val = rdrsdot;
                }
                break;
                        result->val = rdrsdot;
                }
                break;


@@ -148,14 +150,16 @@ Lsub()
                case SDOT:
                        switch(restype) {
                        case DOUB:
                case SDOT:
                        switch(restype) {
                        case DOUB:

-                               error("Don't know how to make bignums into reals, yet",FALSE);
+                               errorh(Vermisc,
+                                      "difference: Don't know how to make bignums into reals, yet",
+                                      nil,FALSE,0,work);

                                break;
                        case SDOT:
                                result->val = subbig(result->val,work);
                                restype = TYPE(result->val);
                                if(restype==INT) {
                                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;
+                                       rdrsdot->s.I=result->val->s.I;
+                                       rdrsdot->s.CDR = (lispval) 0;

                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;
                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;


@@ -169,14 +173,15 @@ Lsub()
                case DOUB:
                        switch(restype) {
                        case SDOT:
                case DOUB:
                        switch(restype) {
                        case SDOT:

-                               if(result->val->CDR==(lispval) 0) {
+                               if(result->val->s.CDR==(lispval) 0) {

                                        protect(newdoub());
                                        np[-1].val->r = result->val->i-work->r;
                                        result->val = np[-1].val;
                                        np--;
                                        restype = DOUB;
                                } else 
                                        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);
+                                       errorh(Vermisc,
+                                              "difference: Don't know how to make bignums into reals ",nil,FALSE,0,work);

                                break;
                        case DOUB:
                                result->val->r -= work->r;
                                break;
                        case DOUB:
                                result->val->r -= work->r;


@@ -186,14 +191,14 @@ Lsub()
                        }
                        break;
                default:
                        }
                        break;
                default:

-                       error("Non-number to minus",FALSE);
+                       errorh(Vermisc,"Non-number to minus",nil,FALSE,0,work);

                }
        }
 out:
        if(restype==DOUB || prunep==FALSE)
                return(result->val);
                }
        }
 out:
        if(restype==DOUB || prunep==FALSE)
                return(result->val);

-       else if (result->val->CDR==(lispval) 0)
-               return(inewint(result->val->I));
+       else if (result->val->s.CDR==(lispval) 0)
+               return(inewint(result->val->s.I));

        else {
                struct sdot dummybig;
 
        else {
                struct sdot dummybig;
 


@@ -209,12 +214,12 @@ Ltimes()
 {
        register lispval work;
        register ap result, mynp, oldnp, lbot, np;
 {
        register lispval work;
        register ap result, mynp, oldnp, lbot, np;

-       int itemp;
+       int itemp,restype;

 
        oldnp = result = np;
        protect(rdrsdot);
 
        oldnp = result = np;
        protect(rdrsdot);

-       rdrsdot->CDR = (lispval) 0;
-       rdrsdot->I = 1;
+       rdrsdot->s.CDR = (lispval) 0;
+       rdrsdot->s.I = 1;

        restype = SDOT;
        prunep = TRUE;
 
        restype = SDOT;
        prunep = TRUE;
 


@@ -246,8 +251,8 @@ Ltimes()
                                if(restype==INT) {
                                        if(result->val->i==0)
                                                return(result->val);
                                if(restype==INT) {
                                        if(result->val->i==0)
                                                return(result->val);

-                                       rdrsdot->I=result->val->I;
-                                       rdrsdot->CDR = (lispval) 0;
+                                       rdrsdot->s.I=result->val->s.I;
+                                       rdrsdot->s.CDR = (lispval) 0;

                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;
                                        result->val = rdrsdot;
                                        restype=SDOT;
                                        prunep = TRUE;


@@ -261,7 +266,7 @@ Ltimes()
                case DOUB:
                        switch(restype) {
                        case SDOT:
                case DOUB:
                        switch(restype) {
                        case SDOT:

-                               if(result->val->CDR==(lispval) 0) {
+                               if(result->val->s.CDR==(lispval) 0) {

                                        protect(newdoub());
                                        np[-1].val->r = result->val->i*work->r;
                                        result->val = np[-1].val;
                                        protect(newdoub());
                                        np[-1].val->r = result->val->i*work->r;
                                        result->val = np[-1].val;


@@ -283,8 +288,8 @@ Ltimes()
        }
        if(restype==DOUB || prunep==FALSE)
                return(result->val);
        }
        if(restype==DOUB || prunep==FALSE)
                return(result->val);

-       else if (result->val->CDR==(lispval) 0)
-               return(inewint(result->val->I));
+       else if (result->val->s.CDR==(lispval) 0)
+               return(inewint(result->val->s.I));

        else {
                struct sdot dummybig;
 
        else {
                struct sdot dummybig;
 


@@ -315,14 +320,16 @@ Lquo()
        itemp = TYPE(work);
        switch(itemp) {
        case INT:
        itemp = TYPE(work);
        switch(itemp) {
        case INT:

-               dummybig.I = work->i;
+               if(mynp <= oldnp) dummybig.I = work->i;
+               else dummybig.I = 1/work->i;

                break;
        case DOUB:
                realflag = 1;
                protect(result = newdoub());
                break;
        case DOUB:
                realflag = 1;
                protect(result = newdoub());

-               result->r = work->r;
+               if(mynp <= oldnp) result->r = work->r;
+               else result->r = 1.0/work->r;

                break;
                break;

-       case SDOT:
+       case SDOT: /* must be fixed for the inverse case */

                protect(work);
                resaddr = &(np[-1].val);
                bigflag = 1;
                protect(work);
                resaddr = &(np[-1].val);
                bigflag = 1;