![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bigmath.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / lisp|
Return to bigmath.s CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / lisp |
1.1 ! root 1: .asciz "@(#)bigmath.s 34.1 10/3/80" ! 2: .globl _dmlad ! 3: # ! 4: # routine for destructive multiplication and addition to a bignum by ! 5: # two fixnums. ! 6: # ! 7: # from C, the invocation is dmlad(sdot,mul,add); ! 8: # where sdot is the address of the first special cell of the bignum ! 9: # mul is the multiplier, add is the fixnum to be added (The latter ! 10: # being passed by value, as is the usual case. ! 11: # ! 12: # ! 13: # Register assignments: ! 14: # ! 15: # r11 = current sdot ! 16: # r10 = carry ! 17: # r9 = previous sdot, for relinking. ! 18: # ! 19: _dmlad: .word 0x0e00 ! 20: movl 4(ap),r11 #initialize cell pointer ! 21: movl 12(ap),r10 #initialize carry ! 22: loop: emul 8(ap),(r11),r10,r0 #r0 gets cell->car times mul + carry ! 23: # ediv $0x40000000,r0,r10,(r11)#cell->car gets prod % 2**30 ! 24: # #carry gets quotient ! 25: extzv $0,$30,r0,(r11) ! 26: extv $30,$32,r0,r10 ! 27: movl r11,r9 #save last cell for fixup at end. ! 28: movl 4(r11),r11 #move to next cell ! 29: bneq loop #done indicated by 0 for next sdot ! 30: tstl r10 #if carry zero no need to allocate ! 31: beql done #new bigit ! 32: mcoml r10,r3 #test to see if neg 1. ! 33: bneq alloc #if not must allocate new cell. ! 34: tstl (r9) #make sure product isn't -2**30 ! 35: beql alloc ! 36: movl r0,(r9) #save old lower half of product. ! 37: brb done ! 38: alloc: calls $0,_newsdot #otherwise allocate new bigit ! 39: movl r10,(r0) #store carry ! 40: movl r0,4(r9) #save new link cell ! 41: done: movl 4(ap),r0 ! 42: ret ! 43: .globl _dodiv ! 44: # ! 45: # routine to destructively divide array representation of a bignum by ! 46: # 1000000000 ! 47: # ! 48: # invocation: ! 49: # remainder = dodiv(top,bottom) ! 50: # int *top, *bottom; ! 51: # where *bottom is the address of the biggning of the array, *top is ! 52: # the top of the array. ! 53: # ! 54: # register assignments: ! 55: # r0 = carry ! 56: # r1 & r2 = 64bit temporary ! 57: # r3 = pointer ! 58: # ! 59: _dodiv: .word 0 ! 60: clrl r0 #no carry to begin. ! 61: movl 8(ap),r3 #get pointer to array. ! 62: loop2: emul $0x40000000,r0,(r3),r1 ! 63: ediv $1000000000,r1,(r3),r0 ! 64: acbl 4(ap),$4,r3,loop2 ! 65: ret ! 66: .globl _dsneg ! 67: # ! 68: # dsneg(top, bot); ! 69: # int *top, *bot; ! 70: # ! 71: # routine to destructively negate a bignum stored in array format ! 72: # lower order stuff at higher addresses. It is assume that the ! 73: # result will be positive. ! 74: # ! 75: _dsneg: .word 0 ! 76: movl 4(ap),r1 #load up address. ! 77: clrl r2 #set carry ! 78: loop3: mnegl (r1),r0 #negate and take carry into account. ! 79: addl2 r2,r0 ! 80: extzv $0,$30,r0,(r1) ! 81: extv $30,$2,r0,r2 ! 82: acbl 8(ap),$-4,r1,loop3 ! 83: #decrease r1, and branch back if appropriate. ! 84: ret ! 85: ! 86: # bignum add routine ! 87: # basic data representation is each bigit is a positive number ! 88: # less than 2^30, except for the leading bigit, which is in ! 89: # the range -2^30 < x < 2^30. ! 90: ! 91: .globl _adbig ! 92: .globl Bexport ! 93: .globl backfr ! 94: # ! 95: # Initialization section ! 96: # ! 97: _adbig: .word 0x0fc0 #save registers 6-11 ! 98: movl 4(ap),r1 #arg1 = addr of 1st bignum ! 99: movl 8(ap),r2 #arg2 = addr of 2nd bignum ! 100: clrl r5 #r5 = carry ! 101: movl $0xC0000000,r4 #r4 = clear constant. ! 102: movl sp,r10 #save start address of bignum on stack. ! 103: #note well that this is 4 above the actual ! 104: #low order word. ! 105: # ! 106: # first loop is to waltz through both bignums adding ! 107: # bigits, pushing them onto stack. ! 108: # ! 109: loop4: addl3 (r1),(r2),r0 #add bigits ! 110: addl2 r5,r0 #add carry ! 111: bicl3 r4,r0,-(sp) #save sum, no overflow possible ! 112: extv $30,$2,r0,r5 #sign extend two high order bits ! 113: #to be next carry. ! 114: movl 4(r1),r1 #get cdr ! 115: bleq out1 #negative indicates end of list. ! 116: movl 4(r2),r2 #get cdr of second bignum ! 117: bgtr loop4 #if neither list at end, do it again ! 118: # ! 119: # second loop propagates carries through higher order words. ! 120: # It assumes remaining list in r1. ! 121: # ! 122: loop5: addl3 (r1),r5,r0 #add bigits and carry ! 123: bicl3 r4,r0,-(sp) #save sum, no overflow possible ! 124: extv $30,$2,r0,r5 #sign extend two high order bits ! 125: #to be next carry. ! 126: movl 4(r1),r1 #get cdr ! 127: out2: bgtr loop5 #negative indicates end of list. ! 128: out2a: pushl r5 ! 129: # ! 130: # suppress unnecessary leading zeroes and -1's ! 131: # ! 132: iexport:movl sp,r11 #more set up for output routine ! 133: ckloop: ! 134: Bexport:tstl (r11) #look at leading bigit ! 135: bgtr copyit #if positive, can allocate storage etc. ! 136: blss negchk #if neg, still a chance we can get by ! 137: cmpl r11,r10 #check to see that ! 138: bgeq copyit #we don't pop everything off of stack ! 139: tstl (r11)+ #incr r11 ! 140: brb ckloop #examine next ! 141: negchk: ! 142: mcoml (r11),r3 #r3 is junk register ! 143: bneq copyit #short test for -1 ! 144: tstl 4(r11) #examine next bigit ! 145: beql copyit #if zero must must leave as is. ! 146: cmpl r11,r10 #check to see that ! 147: bgeq copyit #we don't pop everything off of stack ! 148: tstl (r11)+ #incr r11 ! 149: bisl2 r4,(r11) #set high order two bits ! 150: brb negchk #try to supress more leading -1's ! 151: # ! 152: # The following code is an error exit from the first loop ! 153: # and is out of place to avoid a jump around a jump. ! 154: # ! 155: out1: movl 4(r2),r1 #get next addr of list to continue. ! 156: brb out2 #if second list simult. exhausted, do ! 157: #right thing. ! 158: # ! 159: # loop6 is a faster version of loop5 when carries are no ! 160: # longer necessary. ! 161: # ! 162: loop6a: pushl (r1) #get datum ! 163: loop6: movl 4(r1),r1 #get cdr ! 164: bgtr loop6a #if not at end get next cell ! 165: brb out2a ! 166: ! 167: # ! 168: # create linked list representation of bignum ! 169: # ! 170: copyit: subl3 r11,r10,r2 #see if we can get away with allocating an int ! 171: bneq on1 #test for having popped everything ! 172: subl3 $4,r10,r11 #if so, fix up pointer to bottom ! 173: brb intout #and allocate int. ! 174: on1: cmpl r2,$4 #if = 4, then can do ! 175: beql intout ! 176: calls $0,_newsdot #get new cell for new bignum ! 177: backfr: movl r0,(r6)+ #push address of cell on ! 178: #arg stack to save from garbage collection. ! 179: #There is guaranteed to be slop for a least one ! 180: #push without checking. ! 181: movl r0,r8 #r8 = result of adbig ! 182: loop7: movl -(r10),(r0) #save bigit ! 183: movl r0,r9 #r9 = old cell, to link ! 184: cmpl r10,r11 #have we copy'ed all the bigits? ! 185: bleq Edone ! 186: calls $0,_newsdot #get new cell for new bignum ! 187: movl r0,4(r9) #link new cell to old ! 188: brb loop7 ! 189: Edone: ! 190: clrl 4(r9) #indicate end of list with 0 ! 191: movl -(r6),r0 #give resultant address. ! 192: ret ! 193: # ! 194: # export integer ! 195: # ! 196: intout: pushl (r11) ! 197: calls $1,_inewint ! 198: ret ! 199: .globl _mulbig ! 200: # ! 201: # bignum multiplication routine ! 202: # ! 203: # Initialization section ! 204: # ! 205: _mulbig:.word 0x0fc0 #save regs 6-11 ! 206: movl 4(ap),r1 #get address of first bignum ! 207: movl sp,r11 #save top of 1st bignum ! 208: mloop1: pushl (r1) #get bigit ! 209: movl 4(r1),r1 #get cdr ! 210: bgtr mloop1 #repeat if not done ! 211: movl sp,r10 #save bottom of 1st bignum, top of 2nd bignum ! 212: ! 213: movl 8(ap),r1 #get address of 2nd bignum ! 214: mloop2: pushl (r1) #get bigit ! 215: movl 4(r1),r1 #get cdr ! 216: bgtr mloop2 #repeat if not done ! 217: movl sp,r9 #save bottom of 2nd bignum ! 218: subl3 r9,r11,r6 #r6 contains sum of lengths of bignums ! 219: subl2 r6,sp ! 220: movl sp,r8 #save bottom of product bignum ! 221: # ! 222: # Actual multiplication ! 223: # ! 224: m1: movc5 $0,(r8),$0,r6,(r8)#zap out stack space ! 225: movl r9,r7 #r7 = &w[j +n] (+4 for a.d.) through calculation ! 226: subl3 $4,r10,r4 #r4 = &v[j] ! 227: ! 228: m3: movl r7,r5 #r7 = &w[j+n] ! 229: subl3 $4,r11,r3 #r3 = &u[i] ! 230: clrl r2 #clear carry. ! 231: ! 232: m4: addl2 -(r5),r2 #add w[i + j] to carry (no ofl poss) ! 233: emul (r3),(r4),r2,r0 #r0 = u[i] * v[j] + sext(carry) ! 234: extzv $0,$30,r0,(r5) #get new bigit ! 235: extv $30,$32,r0,r2 #get new carry ! 236: ! 237: m5: acbl r10,$-4,r3,m4 #r3 =- 4; if(r3 >= r10) goto m4; r10 = &[u1]; ! 238: movl r2,-(r5) #save w[j] = carry ! 239: ! 240: m6: subl2 $4,r7 #add just &w[j+n] (+4 for autodec) ! 241: acbl r9,$-4,r4,m3 #r4 =- 4; if(r4>=r9) goto m5; r9 = &v[1] ! 242: ! 243: movl r9,r10 #set up for output routine ! 244: movl $0xC0000000,r4 #r4 = clear constant. ! 245: movq 20(fp),r6 #restor _np and _lbot ! ! 246: brw iexport #do it! ! 247: # ! 248: # The remainder of this file are routines used in bignum division. ! 249: # Interested parties should consult Knuth, Vol 2, and divbig.c. ! 250: # These files are here only due to an optimizer bug. ! 251: # ! 252: ! 253: .align 1 ! 254: .globl _calqhat ! 255: _calqhat: ! 256: .word .R1 ! 257: movl 4(ap),r11 ! 258: movl 8(ap),r10 ! 259: movl $0x3fffffff,r0 ! 260: cmpl (r10),(r11) ! 261: beql on3 ! 262: emul (r11),$0x40000000,4(r11),r1 ! 263: ediv (r10),r1,r0,r5 ! 264: on3: ! 265: emul r0,4(r10),$0,r1 ! 266: emul r5,$0x40000000,8(r11),r3 ! 267: subl2 r3,r1 ! 268: sbwc r4,r2 ! 269: bleq out4 ! 270: decl r0 ! 271: out4: ! 272: ret ! 273: .set .R1,0xc00 ! 274: .align 1 ! 275: .globl _mlsb ! 276: _mlsb: ! 277: .word .R2 ! 278: movl 4(ap),r11 ! 279: movl 8(ap),r10 ! 280: movl 12(ap),r9 ! 281: movl 16(ap),r8 ! 282: clrl r0 ! 283: loop8: addl2 (r11),r0 ! 284: emul r8,-(r9),r0,r2 ! 285: extzv $0,$30,r2,(r11) ! 286: extv $30,$32,r2,r0 ! 287: acbl r10,$-4,r11,loop8 ! 288: ret ! 289: .set .R2,0xf00 ! 290: .align 1 ! 291: .globl _adback ! 292: _adback: ! 293: .word .R3 ! 294: movl 4(ap),r11 ! 295: movl 8(ap),r10 ! 296: movl 12(ap),r9 ! 297: clrl r0 ! 298: loop9: addl2 -(r9),r0 ! 299: addl2 (r11),r0 ! 300: extzv $0,$30,r0,(r11) ! 301: extv $30,$2,r0,r0 ! 302: acbl r10,$-4,r11,loop9 ! 303: ret ! 304: .set .R3,0xe00 ! 305: .align 1 ! 306: .globl _dsdiv ! 307: _dsdiv: ! 308: .word .R4 ! 309: movl 8(ap),r11 ! 310: clrl r0 ! 311: loopa: emul r0,$0x40000000,(r11),r1 ! 312: ediv 12(ap),r1,(r11),r0 ! 313: acbl 4(ap),$4,r11,loopa ! 314: ret ! 315: .set .R4,0x800 ! 316: .align 1 ! 317: .globl _dsmult ! 318: _dsmult: ! 319: .word .R5 ! 320: movl 4(ap),r11 ! 321: clrl r0 ! 322: loopb: emul 12(ap),(r11),r0,r1 ! 323: extzv $0,$30,r1,(r11) ! 324: extv $30,$32,r1,r0 ! 325: acbl 8(ap),$-4,r11,loopb ! 326: movl r1,4(r11) ! 327: ret ! 328: .set .R5,0x800 ! 329: .align 1 ! 330: .globl _export ! 331: _export: ! 332: .word .R6 ! 333: movl 8(ap),r11 ! 334: movl 4(ap),r10 ! 335: movl $0xC0000000,r4 ! 336: jmp Bexport ! 337: ret ! 338: .set .R6,0xfc0
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.