X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/2b84abb596f52ab2068d52108adc96838ad4340a..31cef89cb428866f787983e68246030321893df4:/usr/src/cmd/lisp/lam4.c

diff --git a/usr/src/cmd/lisp/lam4.c b/usr/src/cmd/lisp/lam4.c
index 423e9a9199..31647fefd7 100644
--- 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"
-#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;
+	int itemp,restype;
 
 	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;
 
@@ -43,8 +43,8 @@ Ladd()
 				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;
@@ -58,7 +58,7 @@ Ladd()
 		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;
@@ -75,13 +75,13 @@ Ladd()
 			}
 			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);
-	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;
 
@@ -97,29 +97,31 @@ Lsub()
 {
 	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);
-	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;
-	if(oldnp==mynp)
+	if(oldnp==mynp) {
+		np--;
 		return(Lminus());
+	}
 	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) {
-			rdrsdot->I = result->val->i;
+			rdrsdot->s.I = result->val->i;
 			result->val = rdrsdot;
 		}
 		break;
@@ -148,14 +150,16 @@ Lsub()
 		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) {
-					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;
@@ -169,14 +173,15 @@ Lsub()
 		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 
-					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;
@@ -186,14 +191,14 @@ Lsub()
 			}
 			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);
-	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;
 
@@ -209,12 +214,12 @@ Ltimes()
 {
 	register lispval work;
 	register ap result, mynp, oldnp, lbot, np;
-	int itemp;
+	int itemp,restype;
 
 	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;
 
@@ -246,8 +251,8 @@ Ltimes()
 				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;
@@ -261,7 +266,7 @@ Ltimes()
 		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;
@@ -283,8 +288,8 @@ Ltimes()
 	}
 	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;
 
@@ -315,14 +320,16 @@ Lquo()
 	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());
-		result->r = work->r;
+		if(mynp <= oldnp) result->r = work->r;
+		else result->r = 1.0/work->r;
 		break;
-	case SDOT:
+	case SDOT: /* must be fixed for the inverse case */
 		protect(work);
 		resaddr = &(np[-1].val);
 		bigflag = 1;