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