1: .globl sqrt 2: .globl fptrap 3: exit = 1. 4: read = 3. 5: write = 4. 6: signal = 48. 7: ldfps = 170100^tst 8: / 9: sys signal; 4; fptrap 10: ldfps $240 11: 12: clr argflg 13: cmp (sp)+,$2 14: blt begin 15: tst (sp)+ 16: mov (sp),r2 17: jsr r5,atof; getch1 18: inc argflg 19: br begin1 20: begin: 21: tst argflg 22: beq 9f; sys exit; 9: 23: jsr r5,atof; getch 24: begin1: 25: tstf fr0 26: cfcc 27: bpl 9f; jmp ouch; 9: 28: bne 9f; sys exit; 9: 29: cmpf big,fr0 30: cfcc 31: bgt 9f; jmp ouch; 9: 32: / 33: movf fr0,n 34: jsr pc,sqrt 35: movf fr0,v 36: mov $1,r0 37: sys write; nl; 1 38: / 39: movf $one,fr0 40: movf fr0,fr4 41: / 42: movf n,fr0 43: movf $two,fr1 44: jsr r5,xt 45: / 46: movf n,fr0 47: movif $3,fr1 48: jsr r5,xt 49: / 50: movf n,fr0 51: movif $5,fr1 52: jsr r5,xt 53: / 54: movf n,fr0 55: movif $7,fr1 56: jsr r5,xt 57: / 58: movf n,fr0 59: movif $11.,fr1 60: jsr r5,xt 61: / 62: movf n,fr0 63: movif $13.,fr1 64: jsr r5,xt 65: / 66: movf n,fr0 67: movif $17.,fr1 68: mov $tab+6,r4 69: jsr pc,xx 70: jmp begin 71: / 72: xt: 73: movf fr0,fr2 74: divf fr1,fr2 75: modf $one,fr2 76: movf fr3,fr2 77: mulf fr1,fr2 78: cmpf fr2,fr0 79: cfcc 80: beq hit2 81: rts r5 82: / 83: / 84: out1: 85: mov $tab,r4 86: br in1 87: 88: out2: 89: modf fr4,fr2 90: cfcc 91: bne 9f; mov $xx0,-(sp); jmp hit; 9: 92: br in2 93: xx: 94: mov (r4)+,kazoo 95: xx0: 96: mov $kazoo,r0 97: mov $100.,r1 98: clr r2 99: mov $gorp,r3 100: mov $gorp+6,r5 101: xx1: 102: movf fr0,fr2 103: divf fr1,fr2 104: cmp r4,$tabend 105: bhis out1 106: in1: 107: movf fr2,(r3) 108: bit r2,(r5) 109: beq out2 110: in2: 111: kazoo =.+2 112: addf $kazoo,fr1 113: mov (r4)+,(r0) 114: sob r1,xx1 115: mov $100.,r1 116: mov $127.,r2 117: cmpf v,fr1 118: cfcc 119: bge xx1 120: cmpf $one,fr0 121: cfcc 122: beq 1f 123: mov $1,r0 124: sys write; sp5; 5 125: movf n,fr0 126: jsr r5,ftoa; wrchar 127: mov $1,r0 128: sys write; nl; 1 129: 1: 130: rts pc 131: / 132: / 133: / 134: hit2: 135: movf fr1,t 136: movf fr3,n 137: movf fr3,fr0 138: jsr pc,sqrt 139: movf fr0,v 140: mov $1,r0 141: sys write; sp5; 5 142: movf t,fr0 143: jsr r5,ftoa; wrchar 144: mov $1,r0 145: sys write; nl; 1 146: movf n,fr0 147: movf t,fr1 148: cmp r4,$tab 149: bne 1f 150: mov $tabend,r4 151: 1: 152: mov -(r4),kazoo 153: jmp xt 154: / 155: hit: 156: movf fr1,t 157: movf fr3,n 158: movf fr3,fr0 159: jsr pc,sqrt 160: movf fr0,v 161: mov $1,r0 162: sys write; sp5; 5 163: movf t,fr0 164: jsr r5,ftoa; wrchar 165: mov $1,r0 166: sys write; nl; 1 167: movf n,fr0 168: movf t,fr1 169: mov $kazoo,r0 170: rts pc 171: / 172: / 173: / get one character from the console. 174: / called from atof. 175: / 176: getch: 177: clr r0 178: sys read; ch; 1 179: bec 9f; sys exit; 9: 180: tst r0; bne 9f; sys exit; 9: 181: mov ch,r0 182: rts r5 183: / 184: / 185: / get one character form the argument string. 186: getch1: 187: movb (r2)+,r0 188: rts r5 189: / 190: / write one character on the console 191: / called from ftoa. 192: / 193: wrchar: 194: mov r0,ch 195: mov $1,r0 196: sys write; ch; 1 197: rts r5 198: / 199: / 200: / read and convert a line from the console into fr0. 201: / 202: atof: 203: mov r1,-(sp) 204: movif $10.,r3 205: clrf r0 206: 1: 207: jsr r5,*(r5) 208: sub $'0,r0 209: cmp r0,$9. 210: bhi 2f 211: mulf r3,r0 212: movif r0,r1 213: addf r1,r0 214: br 1b 215: 2: 216: cmp r0,$' -'0 217: beq 1b 218: / 219: mov (sp)+,r1 220: tst (r5)+ 221: rts r5 222: 223: / 224: / 225: / 226: / 227: ftoa: 228: mov $ebuf,r2 229: 1: 230: modf tenth,fr0 231: movf fr0,fr2 232: movf fr1,fr0 233: addf $epsilon,fr2 234: modf $ten,fr2 235: movfi fr3,r0 236: movb r0,-(r2) 237: tstf fr0 238: cfcc 239: bne 1b 240: 1: 241: movb (r2)+,r0 242: add $60,r0 243: jsr r5,*(r5) 244: cmp r2,$ebuf 245: blo 1b 246: tst (r5)+ 247: rts r5 248: / 249: epsilon = 037114 250: tenth: 037314; 146314; 146314; 146315 251: .bss 252: buf: .=.+18. 253: ebuf: 254: .text 255: / 256: / 257: / 258: / complain about a number which the program 259: / is unable to digest 260: ouch: 261: mov $2,r0 262: sys write; 1f; 2f-1f 263: jmp begin 264: / 265: 1: <Ouch.\n> 266: 2: .even 267: / 268: / 269: one = 40200 270: two = 40400 271: four = 40600 272: ten = 41040 273: / 274: .data 275: big: 056177; 177777; 177777; 177777 276: nl: <\n> 277: sp5: < > 278: .even 279: / 280: tab: 281: 41040; 40400; 40600; 40400; 40600; 40700; 40400; 40700 282: 40600; 40400; 40600; 40700; 40700; 40400; 40700; 40600 283: 40400; 40700; 40600; 40700; 41000; 40600; 40400; 40600 284: 40400; 40600; 41000; 40700; 40600; 40700; 40400; 40600 285: 40700; 40400; 40700; 40700; 40600; 40400; 40600; 40700 286: 40400; 40700; 40600; 40400; 40600; 40400; 41040; 40400 287: tabend: 288: / 289: .bss 290: ch: .=.+2 291: t: .=.+8 292: n: .=.+8 293: v: .=.+8 294: gorp: .=.+8 295: argflg: .=.+2 296: .text 297: ldfps = 170100^tst 298: stfps = 170200^tst 299: / 300: / sqrt replaces the f.p. number in fr0 by its 301: / square root. newton's method 302: / 303: .globl sqrt, _sqrt 304: / 305: / 306: _sqrt: 307: mov r5,-(sp) 308: mov sp,r5 309: movf 4(r5),fr0 310: jsr pc,sqrt 311: mov (sp)+,r5 312: rts pc 313: 314: sqrt: 315: tstf fr0 316: cfcc 317: bne 1f 318: clc 319: rts pc /sqrt(0) 320: 1: 321: bgt 1f 322: clrf fr0 323: sec 324: rts pc / sqrt(-a) 325: 1: 326: mov r0,-(sp) 327: stfps -(sp) 328: mov (sp),r0 329: bic $!200,r0 / retain mode 330: ldfps r0 331: movf fr1,-(sp) 332: movf fr2,-(sp) 333: / 334: movf fr0,fr1 335: movf fr0,-(sp) 336: asr (sp) 337: add $20100,(sp) 338: movf (sp)+,fr0 /initial guess 339: mov $4,r0 340: 1: 341: movf fr1,fr2 342: divf fr0,fr2 343: addf fr2,fr0 344: mulf $half,fr0 / x = (x+a/x)/2 345: sob r0,1b 346: 2: 347: movf (sp)+,fr2 348: movf (sp)+,fr1 349: ldfps (sp)+ 350: mov (sp)+,r0 351: clc 352: rts pc 353: / 354: half = 40000