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