1: ; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System 2: ; Science Center, Harvard University 3: 4: ;this file has the routines to help out lisps that run on 5: ;systems without floating hardware 6: ; 7: ; forrest howard, aug 75 8: ; 9: .if ne,fpsim ;bad name choice... 10: .globl imul,idiv,sign,fpstuf 11: 12: imul: 13: ;multiply the number in a+b * j1+j2 14: ;leave result in a+b 15: ;if v bit is set on return, then strict overflow 16: 17: 18: save1 19: call fixsign ;which leaves both args pos 20: mov a,j3 21: mov b,fpstuf 22: bit #1,j2 23: bne 1$ 24: clr a 25: clr b 26: 1$: bic #1,j2 27: 28: 29: domul: ;now we do stuff-- shift only when necessary 30: tst j1 31: bne 1$ 32: tst j2 33: beq donmul 34: 1$: asl fpstuf 35: rol j3 36: bvs ovr 37: ashc #-1,j1 38: bit #1,j2 39: beq 2$ 40: dec j2 41: add fpstuf,b 42: adc a 43: bvs ovr 44: add j3,a 45: bvs ovr 46: 2$: br domul 47: 48: ovr: mov 2(sp),j3 49: cmp (sp)+,(sp)+ 50: sev 51: ret 52: donmul: 53: dfinup: mov 2(sp),j3 54: cmp (sp)+,(sp)+ 55: tst sign 56: beq 1$ 57: call negs 58: call negr 59: 1$: tst a 60: bne 3$ 61: tst b 62: cln ;clear the n-bit if set (want pos result) 63: 3$: 64: rts pc 65: 66: fixsign: 67: mov #sign,j3 68: clrb (j3) 69: tst j1 70: bge 1$ 71: comb (j3) 72: call negs 73: 1$: 74: tst a 75: bge 2$ 76: comb (j3) 77: negr= . 78: com a 79: com b 80: add #1,b 81: adc a 82: 2$: ret 83: 84: negs: 85: com j1 86: com j2 87: add #1,j2 88: adc j1 89: rts pc 90: 91: 92: 93: 94: idiv: ;idiv divides (a+b)/(j1+j2) 95: ;quoitient in a+b 96: ;rem in j1+j2 97: ;rem is same sign as quo 98: ;v bit is set if overflow occurs 99: ;or on divide check 100: ;z bit is set according to the ans 101: 102: 103: save1 104: call fixsign 105: ;ok; now we have all registers, and 106: ;can muck around 107: ;first check for zero's 108: mov j1,j3 109: bne 10$ 110: tst j2 111: beq ovr 112: 10$: mov j2,fpstuf 113: mov a,j1 114: bne 11$ 115: tst b 116: beq retz 117: 11$: mov b,j2 118: clr fpstuf+2 119: ;left justify the two ints, keeping count 120: 1$: ashc #1,j1 121: bvs 2$ 122: dec fpstuf+2 123: br 1$ 124: 2$: ror j1 125: ror j2 ;recover stuff... 126: mov fpstuf+2,fpstuf+4 ;save to form remainder 127: 3$: asl fpstuf 128: rol j3 129: bvs 4$ 130: inc fpstuf+4 131: br 3$ 132: 4$: ror j3 133: ror fpstuf 134: clr a 135: clr b ;clear for answer 136: 137: ;fpstuf+4 now has count of number of things..... 138: ;if it is neg, we can go home 139: 140: tst fpstuf+4 141: blt divret 142: actdiv: 143: sub fpstuf,j2 144: sbc j1 145: sub j3,j1 146: blt 1$ 147: inc b 148: br 2$ 149: 1$: add fpstuf,j2 150: adc j1 151: add j3,j1 152: 2$: asr j3 153: ror fpstuf ;shift right for next 154: dec fpstuf+4 155: blt divret 156: ashc #1,a ;for next 157: br actdiv 158: divret: 159: ashc fpstuf+2,j1 160: br dfinup 161: 162: 163: retz: clr a 164: clr b 165: clr j1 166: mov 2(sp),j3 167: cmp (sp)+,(sp)+ 168: clr j2 169: ret 170: 171: .endc
|
Last modified: 1981-05-10
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 361 |
|