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