![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to lam4.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 ! root 1: static char *sccsid = "@(#)lam4.c 34.1 10/3/80"; ! 2: ! 3: #include "global.h" ! 4: typedef struct argent *ap; ! 5: static int prunep; lispval adbig(),subbig(),mulbig(); ! 6: lispval ! 7: Ladd() ! 8: { ! 9: register lispval work; ! 10: register ap result, mynp, oldnp, lbot, np; ! 11: int itemp,restype; ! 12: ! 13: oldnp = result = np; ! 14: protect(rdrsdot); ! 15: rdrsdot->s.CDR = (lispval) 0; ! 16: rdrsdot->s.I =0; ! 17: restype = SDOT; ! 18: prunep = TRUE; ! 19: ! 20: for(mynp = lbot; mynp < oldnp; mynp++) ! 21: { ! 22: work = mynp->val; ! 23: switch(TYPE(work)) { ! 24: case INT: ! 25: switch(restype) { ! 26: case DOUB: ! 27: result->val->r += work->i; ! 28: break; ! 29: case SDOT: ! 30: dmlad(result->val,1,work->i); ! 31: prunep = TRUE; ! 32: break; ! 33: default: ! 34: goto urk; ! 35: } ! 36: break; ! 37: case SDOT: ! 38: switch(restype) { ! 39: case DOUB: ! 40: error("Don't know how to make bignums into reals, yet",FALSE); ! 41: break; ! 42: case SDOT: ! 43: result->val = adbig(work,result->val); ! 44: restype = TYPE(result->val); ! 45: if(restype==INT) { ! 46: rdrsdot->s.I=result->val->s.I; ! 47: rdrsdot->s.CDR = (lispval) 0; ! 48: result->val = rdrsdot; ! 49: restype=SDOT; ! 50: prunep = TRUE; ! 51: } else ! 52: prunep = FALSE; ! 53: break; ! 54: default: ! 55: goto urk; ! 56: } ! 57: break; ! 58: case DOUB: ! 59: switch(restype) { ! 60: case SDOT: ! 61: if(result->val->s.CDR==(lispval) 0) { ! 62: protect(newdoub()); ! 63: np[-1].val->r = result->val->i+work->r; ! 64: result->val = np[-1].val; ! 65: np--; ! 66: restype = DOUB; ! 67: } else ! 68: error("Don't know how to make bignums into reals, yet",FALSE); ! 69: break; ! 70: case DOUB: ! 71: result->val->r += work->r; ! 72: break; ! 73: default: ! 74: goto urk; ! 75: } ! 76: break; ! 77: default: ! 78: errorh(Vermisc,"Non-number to add",nil,0,FALSE,work); ! 79: } ! 80: } ! 81: if(restype==DOUB || prunep==FALSE) ! 82: return(result->val); ! 83: else if (result->val->s.CDR==(lispval) 0) ! 84: return(inewint(result->val->s.I)); ! 85: else { ! 86: struct sdot dummybig; ! 87: ! 88: dummybig.I = 0; ! 89: dummybig.CDR = (lispval) 0; ! 90: return(adbig(&dummybig,result->val)); ! 91: } ! 92: urk: ! 93: error("Internal error in (add,sub,quo,times)",FALSE); ! 94: } ! 95: lispval ! 96: Lsub() ! 97: { ! 98: register lispval work; ! 99: register ap result, mynp, oldnp, lbot, np; ! 100: int itemp,restype; ! 101: lispval Lminus(); ! 102: ! 103: oldnp = result = np; ! 104: mynp = lbot + 1; ! 105: protect(rdrsdot); ! 106: rdrsdot->s.CDR = (lispval) 0; ! 107: rdrsdot->s.I =0; ! 108: restype = SDOT; ! 109: prunep = TRUE; ! 110: if(oldnp==lbot) ! 111: goto out; ! 112: if(oldnp==mynp) { ! 113: np--; ! 114: return(Lminus()); ! 115: } ! 116: work = lbot->val; ! 117: switch(TYPE(work)) { ! 118: case INT: ! 119: rdrsdot->s.I = work->i; ! 120: break; ! 121: case SDOT: ! 122: result->val = adbig(result->val,work); ! 123: if(TYPE(result->val)==INT) { ! 124: rdrsdot->s.I = result->val->i; ! 125: result->val = rdrsdot; ! 126: } ! 127: break; ! 128: case DOUB: ! 129: (result->val = newdoub())->r = work->r; ! 130: restype = DOUB; ! 131: } ! 132: ! 133: for(; mynp < oldnp; mynp++) ! 134: { ! 135: work = mynp->val; ! 136: switch(TYPE(work)) { ! 137: case INT: ! 138: switch(restype) { ! 139: case DOUB: ! 140: result->val->r -= work->i; ! 141: break; ! 142: case SDOT: ! 143: dmlad(result->val,1, -work->i); ! 144: prunep = TRUE; ! 145: break; ! 146: default: ! 147: goto urk; ! 148: } ! 149: break; ! 150: case SDOT: ! 151: switch(restype) { ! 152: case DOUB: ! 153: errorh(Vermisc, ! 154: "difference: Don't know how to make bignums into reals, yet", ! 155: nil,FALSE,0,work); ! 156: break; ! 157: case SDOT: ! 158: result->val = subbig(result->val,work); ! 159: restype = TYPE(result->val); ! 160: if(restype==INT) { ! 161: rdrsdot->s.I=result->val->s.I; ! 162: rdrsdot->s.CDR = (lispval) 0; ! 163: result->val = rdrsdot; ! 164: restype=SDOT; ! 165: prunep = TRUE; ! 166: } else ! 167: prunep = FALSE; ! 168: break; ! 169: default: ! 170: goto urk; ! 171: } ! 172: break; ! 173: case DOUB: ! 174: switch(restype) { ! 175: case SDOT: ! 176: if(result->val->s.CDR==(lispval) 0) { ! 177: protect(newdoub()); ! 178: np[-1].val->r = result->val->i-work->r; ! 179: result->val = np[-1].val; ! 180: np--; ! 181: restype = DOUB; ! 182: } else ! 183: errorh(Vermisc, ! 184: "difference: Don't know how to make bignums into reals ",nil,FALSE,0,work); ! 185: break; ! 186: case DOUB: ! 187: result->val->r -= work->r; ! 188: break; ! 189: default: ! 190: goto urk; ! 191: } ! 192: break; ! 193: default: ! 194: errorh(Vermisc,"Non-number to minus",nil,FALSE,0,work); ! 195: } ! 196: } ! 197: out: ! 198: if(restype==DOUB || prunep==FALSE) ! 199: return(result->val); ! 200: else if (result->val->s.CDR==(lispval) 0) ! 201: return(inewint(result->val->s.I)); ! 202: else { ! 203: struct sdot dummybig; ! 204: ! 205: dummybig.I = 0; ! 206: dummybig.CDR = (lispval) 0; ! 207: return(adbig(&dummybig,result->val)); ! 208: } ! 209: urk: ! 210: error("Internal error in (add,sub,quo,times)",FALSE); ! 211: } ! 212: lispval ! 213: Ltimes() ! 214: { ! 215: register lispval work; ! 216: register ap result, mynp, oldnp, lbot, np; ! 217: int itemp,restype; ! 218: ! 219: oldnp = result = np; ! 220: protect(rdrsdot); ! 221: rdrsdot->s.CDR = (lispval) 0; ! 222: rdrsdot->s.I = 1; ! 223: restype = SDOT; ! 224: prunep = TRUE; ! 225: ! 226: for(mynp = lbot; mynp < oldnp; mynp++) ! 227: { ! 228: work = mynp->val; ! 229: switch(TYPE(work)) { ! 230: case INT: ! 231: switch(restype) { ! 232: case DOUB: ! 233: result->val->r *= work->i; ! 234: break; ! 235: case SDOT: ! 236: dmlad(result->val,work->i,0); ! 237: prunep = TRUE; ! 238: break; ! 239: default: ! 240: goto urk; ! 241: } ! 242: break; ! 243: case SDOT: ! 244: switch(restype) { ! 245: case DOUB: ! 246: error("Don't know how to make bignums into reals, yet",FALSE); ! 247: break; ! 248: case SDOT: ! 249: result->val = mulbig(work,result->val); ! 250: restype = TYPE(result->val); ! 251: if(restype==INT) { ! 252: if(result->val->i==0) ! 253: return(result->val); ! 254: rdrsdot->s.I=result->val->s.I; ! 255: rdrsdot->s.CDR = (lispval) 0; ! 256: result->val = rdrsdot; ! 257: restype=SDOT; ! 258: prunep = TRUE; ! 259: } else ! 260: prunep = FALSE; ! 261: break; ! 262: default: ! 263: goto urk; ! 264: } ! 265: break; ! 266: case DOUB: ! 267: switch(restype) { ! 268: case SDOT: ! 269: if(result->val->s.CDR==(lispval) 0) { ! 270: protect(newdoub()); ! 271: np[-1].val->r = result->val->i*work->r; ! 272: result->val = np[-1].val; ! 273: np--; ! 274: restype = DOUB; ! 275: } else ! 276: error("Don't know how to make bignums into reals, yet",FALSE); ! 277: break; ! 278: case DOUB: ! 279: result->val->r *= work->r; ! 280: break; ! 281: default: ! 282: goto urk; ! 283: } ! 284: break; ! 285: default: ! 286: error("Non-number to times",FALSE); ! 287: } ! 288: } ! 289: if(restype==DOUB || prunep==FALSE) ! 290: return(result->val); ! 291: else if (result->val->s.CDR==(lispval) 0) ! 292: return(inewint(result->val->s.I)); ! 293: else { ! 294: struct sdot dummybig; ! 295: ! 296: dummybig.I = 0; ! 297: dummybig.CDR = (lispval) 0; ! 298: return(adbig(&dummybig,result->val)); ! 299: } ! 300: urk: ! 301: error("Internal error in (add,sub,quo,times)",FALSE); ! 302: } ! 303: lispval ! 304: Lquo() ! 305: { ! 306: register lispval work; ! 307: register lispval result; ! 308: register struct argent *mynp; ! 309: register struct argent *oldnp, *lbot, *np; ! 310: int bigflag = 0, realflag = 0, itemp; ! 311: struct sdot dummybig; ! 312: lispval divbig(), *resaddr; ! 313: ! 314: mynp = lbot; ! 315: oldnp = np-1; ! 316: dummybig.CDR = (lispval) 0; ! 317: dummybig.I = 1; ! 318: if(mynp > oldnp) goto out; ! 319: work = (mynp++)->val; ! 320: itemp = TYPE(work); ! 321: switch(itemp) { ! 322: case INT: ! 323: if(mynp <= oldnp) dummybig.I = work->i; ! 324: else dummybig.I = 1/work->i; ! 325: break; ! 326: case DOUB: ! 327: realflag = 1; ! 328: protect(result = newdoub()); ! 329: if(mynp <= oldnp) result->r = work->r; ! 330: else result->r = 1.0/work->r; ! 331: break; ! 332: case SDOT: /* must be fixed for the inverse case */ ! 333: protect(work); ! 334: resaddr = &(np[-1].val); ! 335: bigflag = 1; ! 336: break; ! 337: default: ! 338: error("Don't know how to divide this type.",FALSE); ! 339: } ! 340: for(;mynp <= oldnp; mynp++) { ! 341: work = mynp->val; ! 342: itemp = TYPE(work); ! 343: switch(itemp) { ! 344: ! 345: case INT: ! 346: if (work->i==0) ! 347: kill(getpid(),8); ! 348: if (realflag) ! 349: result->r /= work->i; ! 350: else if(bigflag) { ! 351: dummybig.I = work->i; ! 352: divbig(*resaddr, &dummybig, resaddr, 0); ! 353: } else { ! 354: dummybig.I /= work->i; ! 355: } ! 356: break; ! 357: case DOUB: ! 358: if(realflag) ! 359: result->r /= work->r; ! 360: else if(bigflag) ! 361: error("Don't know how to make bignums into reals, yet",FALSE); ! 362: else { ! 363: realflag = 1; ! 364: result = newdoub(); ! 365: result->r = (double) dummybig.I / work->r; ! 366: protect(result); ! 367: } ! 368: break; ! 369: case SDOT: ! 370: if(realflag) ! 371: error("Don't know how to divide reals by bignums ",FALSE); ! 372: else if(bigflag) ! 373: divbig(*resaddr, work, resaddr, 0); ! 374: else { ! 375: bigflag = 1; ! 376: protect(newsdot()); ! 377: resaddr = &(np[-1].val); ! 378: np[-1].val->i = dummybig.I; ! 379: divbig(*resaddr, work, resaddr, 0); ! 380: } ! 381: break; ! 382: default: ! 383: error("Don't know how to divide this type",FALSE); ! 384: ! 385: } ! 386: } ! 387: out: ! 388: if(realflag) ! 389: return(result); ! 390: else if (bigflag) ! 391: return(*resaddr); ! 392: else { ! 393: result = inewint( dummybig.I ); ! 394: return(result); ! 395: } ! 396: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.