1: / 2: / 3: / routine to add the two centennial numbers 4: / pointed to by r2 and r3. 5: / a pointer to the result is returned in r1 6: / r2 and r3 are preserved 7: / 8: / mov ptr1,r2 9: / mov ptr2,r3 10: / jsr pc,add3 11: / mov r1,... 12: / 13: add3: mov r0,-(sp) 14: mov r4,-(sp) 15: mov r5,-(sp) 16: mov r3,-(sp) 17: mov r2,-(sp) 18: / 19: / allocate a new string whose length is 20: / the max of the two addends. 21: / 22: mov w(r2),r0 23: sub a(r2),r0 24: mov w(r3),r4 25: sub a(r3),r4 26: cmp r0,r4 27: bgt 1f 28: mov r4,r0 29: 1: mov r0,r4 30: jsr pc,allocate 31: mov r1,-(sp) 32: / 33: / get everything ready 34: / 35: mov 2(sp),r1 36: jsr pc,rewind 37: mov 4(sp),r1 38: jsr pc,rewind 39: clr carry 40: / 41: / now add them 42: / 43: 2: dec r4 44: blt 3f 45: mov 2(sp),r1 /r2 46: jsr pc,getchar 47: mov r0,r5 48: mov 4(sp),r1 /r3 49: jsr pc,getchar 50: add r5,r0 51: add carry,r0 52: clr carry 53: cmp r0,$100. 54: blt 1f 55: sub $100.,r0 56: mov $1,carry 57: 1: 58: tstb r0 59: bpl 1f 60: add $100.,r0 61: mov $-1,carry 62: 1: mov (sp),r1 /r1 63: jsr pc,putchar 64: br 2b 65: / 66: / perhaps there is an extra digit 67: / 68: 3: mov carry,r0 69: beq 2f 70: mov (sp),r1 /r1 71: jsr pc,putchar 72: / 73: / strip leading zeros 74: / 75: 2: 76: jsr pc,fsfile 77: 2: jsr pc,backspace 78: bes 2f 79: beq 2b 80: inc r(r1) 81: 2: mov r(r1),w(r1) 82: / 83: / strip leading 99's 84: / 85: jsr pc,fsfile 86: jsr pc,backspace 87: cmpb r0,$-1 88: bne 1f 89: 2: 90: jsr pc,backspace 91: bes 2f 92: cmpb r0,$99. 93: beq 2b 94: jsr pc,getchar 95: 2: 96: mov $-1,r0 97: jsr pc,alterchar 98: mov r(r1),w(r1) 99: / 100: / restore and return 101: / 102: 1: 103: mov (sp)+,r1 104: mov (sp)+,r2 105: mov (sp)+,r3 106: mov (sp)+,r5 107: mov (sp)+,r4 108: mov (sp)+,r0 109: rts pc 110: / 111: .bss 112: carry: .=.+2 113: .text 114: / 115: / 116: / routine to change the sign of the centennial number 117: / pointed to by r1. 118: / negative numbers are stored in 100's complement form with 119: / -1 as the high order digit; the second digit is not 99. 120: / 121: / mov ...,r1 122: / jsr pc,chsign 123: / 124: chsign: 125: mov r1,-(sp) 126: mov r0,-(sp) 127: jsr pc,rewind 128: clr chcarry 129: / 130: 1: 131: jsr pc,lookchar 132: bes 1f 133: negb r0 134: sub chcarry,r0 135: mov $1,chcarry 136: add $100.,r0 137: cmpb $100.,r0 138: bgt 2f 139: sub $100.,r0 140: clr chcarry 141: 2: 142: jsr pc,alterchar 143: br 1b 144: / 145: 1: 146: clr r0 147: sub chcarry,r0 148: beq 2f 149: jsr pc,putchar 150: jsr pc,fsfile 151: jsr pc,backspace 152: jsr pc,backspace 153: cmp r0,$99. 154: bne 1f 155: mov r(r1),w(r1) 156: mov $-1,r0 157: jsr pc,putchar 158: br 1f 159: / 160: 2: 161: jsr pc,fsfile 162: jsr pc,backspace 163: bne 1f 164: mov r(r1),w(r1) 165: / 166: 1: 167: mov (sp)+,r0 168: mov (sp)+,r1 169: rts pc 170: / 171: .bss 172: chcarry: .=.+2 173: .text 174: / 175: / 176: / 177: / 178: / routine to multiply the two centennial numbers 179: / pointed to by r2 and r3. 180: / a pointer to the result is returned in r1 181: / r2 and r3 are preserved 182: / 183: / mov ptr1,r2 184: / mov ptr2,r3 185: / jsr pc,mul3 186: / mov r1,... 187: / 188: / save registers and make space for temps 189: / 190: mul3: 191: mov r5,-(sp) 192: mov r3,-(sp) /arg2 193: mov r2,-(sp) /arg1 194: mov r0,-(sp) 195: tst -(sp) /result 196: tst -(sp) /arg1 197: tst -(sp) /arg2 198: tst -(sp) /carry 199: / 200: / compute sign of result and make args positive 201: / 202: clr outsign 203: mov r2,r1 204: jsr pc,fsfile 205: jsr pc,backspace 206: bmi 2f 207: mov r2,4(sp) /arg1 208: br 1f 209: 2: 210: jsr pc,length 211: jsr pc,allocate 212: mov r1,4(sp) 213: mov r2,r0 214: jsr pc,move 215: jsr pc,chsign 216: com outsign 217: 1: 218: mov r3,r1 219: jsr pc,fsfile 220: jsr pc,backspace 221: bmi 2f 222: mov r3,2(sp) /arg2 223: br 1f 224: 2: 225: mov r3,r1 226: jsr pc,length 227: jsr pc,allocate 228: mov r1,2(sp) 229: mov r3,r0 230: jsr pc,move 231: jsr pc,chsign 232: com outsign 233: 1: 234: / 235: / compute the length of the result and 236: / allocate space for it 237: / 238: mov w(r2),r0 239: sub a(r2),r0 240: add w(r3),r0 241: sub a(r3),r0 242: jsr pc,allocate 243: jsr pc,zero 244: mov r1,6(sp) /result 245: clr offset 246: mov 2(sp),r1 /arg2 247: jsr pc,rewind 248: / 249: / work on next digit of arg2, starting over on arg1 250: / 251: 1: mov 4(sp),r1 /arg1 252: jsr pc,rewind 253: mov 2(sp),r1 /arg2 254: jsr pc,getchar 255: bes 3f 256: mov r0,r2 257: mov 6(sp),r1 /result 258: jsr pc,rewind 259: add offset,r(r1) 260: clr 0(sp) /carry 261: / 262: / work on next digit of arg3 263: / form the product of the two digits, 264: / add to what is already there and add in old carry 265: / to generate new dit and new carry. 266: / 267: 2: mov 4(sp),r1 /arg1 268: jsr pc,getchar 269: bes 2f 270: mov r0,r3 271: mpy r2,r3 272: add (sp),r3 /carry 273: mov 6(sp),r1 /result 274: jsr pc,lookchar 275: add r0,r3 276: mov r3,r1 277: clr r0 278: dvd $100.,r0 279: mov r0,(sp) /carry 280: mov r1,r0 281: mov 6(sp),r1 /result 282: jsr pc,alterchar 283: br 2b 284: / 285: 2: 286: inc offset 287: tst (sp) /carry 288: beq 1b 289: mov 6(sp),r1 /result 290: jsr pc,lookchar 291: add (sp),r0 /carry 292: jsr pc,alterchar 293: br 1b 294: / 295: 3: 296: / 297: / change sign of result if necessary 298: / 299: tst outsign 300: bpl 1f 301: mov 6(sp),r1 /result 302: jsr pc,chsign 303: / 304: / release dregs if necessary 305: / 306: 1: 307: cmp 2(sp),14(sp) 308: beq 1f 309: mov 2(sp),r1 310: jsr pc,release 311: 1: 312: cmp 4(sp),12(sp) 313: beq 1f 314: mov 4(sp),r1 315: jsr pc,release 316: 1: 317: / 318: / restore registers and return 319: / 320: tst (sp)+ 321: tst (sp)+ 322: tst (sp)+ 323: mov (sp)+,r1 324: mov (sp)+,r0 325: mov (sp)+,r2 326: mov (sp)+,r3 327: mov (sp)+,r5 328: rts pc 329: / 330: .bss 331: outsign: .=.+2 332: offset: .=.+2 333: k: .=.+2 334: kptr: .=.+2 335: .text 336: / 337: sqrt: 338: mov r4,-(sp) 339: mov r3,-(sp) 340: mov r2,-(sp) 341: mov r0,-(sp) 342: / 343: / check for zero or negative 344: / 345: mov w(r1),r2 346: sub a(r1),r2 347: / 348: / look at the top one or two digits 349: / 350: mov r1,r3 351: jsr pc,fsfile 352: jsr pc,backspace 353: mov r0,r4 354: bit $1,r2 355: bne 2f 356: mov r4,r1 357: mul $100.,r1 358: mov r1,r4 359: mov r3,r1 360: jsr pc,backspace 361: add r0,r4 362: 2: 363: / 364: / allocate space for result 365: / 366: inc r2 367: asr r2 368: mov r2,r0 369: jsr pc,allocate 370: jsr pc,zero 371: mov r2,r0 372: jsr pc,seekchar 373: mov r1,r2 374: / 375: / get high order digit of arg and square root it 376: / 377: mov $1,r0 378: 2: sub r0,r4 379: blt 2f 380: add $2,r0 381: br 2b 382: 2: inc r0 383: asr r0 384: mov r0,r4 385: mov r2,r1 386: jsr pc,fsfile 387: jsr pc,backspace 388: cmp r4,$100. 389: blt 1f 390: sub $100.,r4 391: mov r4,r0 392: jsr pc,alterchar 393: mov $1,r0 394: jsr pc,putchar 395: br 2f 396: 1: 397: mov r4,r0 398: jsr pc,alterchar 399: 2: 400: mov r1,-(sp) 401: mov r3,-(sp) 402: / 403: / get successive approx. from Newton 404: / 405: 1: mov (sp),r3 /arg 406: mov 2(sp),r2 /approx 407: jsr pc,div3 408: mov r1,r3 409: jsr pc,add3 410: mov r1,-(sp) 411: mov r3,r1 412: jsr pc,release 413: mov r4,r1 414: jsr pc,release 415: mov (sp)+,r1 416: mov sqtemp,r2 417: mov r1,r3 418: jsr pc,div3 419: mov r1,-(sp) 420: mov r3,r1 421: jsr pc,release 422: mov r4,r1 423: jsr pc,release 424: mov (sp)+,r3 425: mov 2(sp),r1 426: jsr pc,length 427: jsr pc,allocate 428: mov 2(sp),r0 429: jsr pc,move 430: jsr pc,chsign 431: mov r1,r2 432: jsr pc,add3 433: jsr pc,fsfile 434: jsr pc,backspace 435: jsr pc,release 436: mov r2,r1 437: jsr pc,release 438: tst r0 439: bpl 2f 440: / 441: / loop if new < old 442: mov 2(sp),r1 443: jsr pc,release 444: mov r3,2(sp) 445: br 1b 446: / 447: 2: 448: mov r3,r1 449: jsr pc,release 450: mov (sp)+,r1 451: jsr pc,release 452: mov (sp)+,r1 453: mov (sp)+,r0 454: mov (sp)+,r2 455: mov (sp)+,r3 456: mov (sp)+,r4 457: rts pc
Defined functions
Defined variables
|
Last modified: 1975-05-14
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 564 |
|