1: .globl log2 2: .globl getchar 3: .globl lookchar 4: .globl fsfile 5: .globl seekchar 6: .globl backspace 7: .globl putchar 8: .globl alterchar 9: .globl move 10: .globl rewind 11: .globl create 12: .globl zero 13: .globl allocate 14: .globl release 15: .globl collect 16: .globl w, r, a, l 17: / 18: cmp (sp)+,$2 19: blo 1f 20: tst (sp)+ 21: mov (sp)+,0f 22: cmpb *0f,$'- 23: beq 8f 24: sys 0; 9f 25: .data 26: 9: 27: sys open; 0:.=.+2; 0 28: .text 29: bec 2f 30: mov $1,r0 31: sys write; 4f; 5f-4f 32: sys exit 33: 34: / 35: 4: <Input file.\n> 36: 5: .even 37: / 38: 2: 39: mov r0,source 40: 1: 41: sys signal; 2; 1 42: ror r0 43: bcs 1f 44: sys signal; 2; case177 45: 1: 46: 8: 47: clr delflag 48: mov $pdl,r5 49: / 50: mov $10.,r0 51: jsr pc,log2 52: mov r0,log10 53: mov $1,r0 54: jsr pc,allocate 55: mov r1,scalptr 56: clr r0 57: jsr pc,putchar 58: clr r0 59: jsr pc,allocate 60: mov r1,basptr 61: mov $10.,r0 62: jsr pc,putchar 63: mov $1,r0 64: jsr pc,allocate 65: mov r1,inbas 66: mov $10.,r0 67: jsr pc,putchar 68: mov $1,r0 69: jsr pc,allocate 70: mov $10.,r0 71: jsr pc,putchar 72: mov r1,tenptr 73: clr r0 74: jsr pc,allocate 75: mov r1,chptr 76: clr r0 77: jsr pc,allocate 78: mov r1,strptr 79: mov $1,r0 80: jsr pc,allocate 81: mov $2,r0 82: jsr pc,putchar 83: mov r1,sqtemp 84: clr r0 85: jsr pc,allocate 86: mov r1,divxyz 87: loop: 88: tst delflag 89: bne in177 90: mov sp,errstack 91: jsr pc,readc 92: mov $casetab,r1 93: 1: tst (r1)+ 94: beq 2f 95: cmp r0,(r1)+ 96: bne 1b 97: jmp *-4(r1) 98: 2: jmp eh 99: / 100: / 101: / case for new line (which is special for apl box) 102: / 103: case012: 104: br loop 105: / 106: / 107: / case q for quit 108: / 109: case161: 110: cmp readptr,$readstack+2 111: blos 1f 112: mov *readptr,r1 113: beq 2f 114: jsr pc,release 115: 2: 116: sub $2,readptr 117: mov *readptr,r1 118: beq 2f 119: jsr pc,release 120: 2: 121: sub $2,readptr 122: jmp loop 123: 1: 124: sys exit 125: / 126: / 127: / case Q for controlled quit 128: / 129: case121: 130: jsr pc,pop 131: jes eh 132: jsr pc,length 133: cmp r0,$2 134: jhi eh1 135: jsr pc,rewind 136: jsr pc,getchar 137: jmi eh1 138: jsr pc,release 139: 1: 140: cmp readptr,$readstack 141: jlos eh 142: mov *readptr,r1 143: beq 2f 144: jsr pc,release 145: 2: 146: sub $2,readptr 147: sob r0,1b 148: jbr loop 149: / 150: / 151: / case of delete character 152: / 153: case177: 154: sys signal; 2; case177 155: mov $1,delflag 156: mov r0,-(sp) 157: mov 2(sp),r0 158: cmp -6(r0),$sys+read 159: bne 1f 160: sub $6,2(sp) 161: clr delflag 162: 1: 163: mov (sp)+,r0 164: 2 /rti 165: / 166: in177: 167: mov $' ,ch 168: mov $1,r0 169: sys write; 1f; 1 170: clr delflag 171: jmp eh 172: / 173: .bss 174: delflag: .=.+2 175: .text 176: 1: <\n> 177: .even 178: / 179: / 180: / case digit 181: / 182: case060: 183: movb r0,savec 184: jsr pc,readin 185: jsr pc,push 186: br loop 187: / 188: / 189: / case _ for negative numbers 190: / 191: case137: 192: jsr pc,readin 193: jsr pc,fsfile 194: jsr pc,backspace 195: mov r0,savk 196: dec w(r1) 197: jsr pc,chsign 198: mov savk,r0 199: jsr pc,putchar 200: jsr pc,push 201: jbr loop 202: / 203: / 204: / case screamer 205: / 206: case041: 207: jsr pc,in041 208: jbr loop 209: / 210: in041: 211: jsr pc,readc 212: cmp r0,$'< 213: jeq in74a 214: cmp r0,$'= 215: jeq in75a 216: cmp r0,$'> 217: jeq in76a 218: / 219: mov $field,r1 220: movb r0,(r1)+ 221: 1: 222: jsr pc,readc 223: movb r0,(r1)+ 224: cmpb r0,$'\n 225: bne 1b 226: clrb (r1)+ 227: / 228: sys fork 229: br 9f 230: sys wait 231: mov $1,r0 232: sys write; screamer; 2 233: rts pc 234: 9: sys exec; 6f; 8f 235: sys exit 236: .data 237: 8: 6f; 7f; field; 0 238: 6: </bin/sh\0> 239: 7: <-c\0> 240: screamer: <!\n> 241: .even 242: .bss 243: field: .=.+70. 244: .text 245: / 246: / 247: / case d for duplicate 248: / 249: case144: 250: cmp r5,$pdl 251: jeq eh 252: clr r0 253: jsr pc,allocate 254: mov -2(r5),r0 255: jsr pc,move 256: jsr pc,push 257: jmp loop 258: / 259: / 260: / case z for stack size 261: / 262: case172: 263: clr r0 264: jsr pc,allocate 265: mov r5,r3 266: sub $pdl,r3 267: asr r3 268: 2: 269: beq 2f 270: clr r2 271: dvd $100.,r2 272: mov r3,r0 273: jsr pc,putchar 274: mov r2,r3 275: br 2b 276: 2: 277: clr r0 278: jsr pc,putchar 279: jsr pc,push 280: jmp loop 281: / 282: / 283: / case c for flush 284: / 285: case143: 286: 2: jsr pc,pop 287: jes loop 288: jsr pc,release 289: br 2b 290: / 291: / case s for save 292: / 293: case163: 294: tst sfree 295: bne 1f 296: jsr pc,sinit 297: 1: 298: jsr pc,readc 299: cmp r5,$pdl 300: bne 2f 301: movb $'s,ch 302: jmp eh 303: 2: 304: clr r2 305: cmpb r0,$128. / check for array 306: blo 1f 307: inc r2 308: 1: 309: asl r0 310: mov stable(r0),r1 311: beq 2f 312: mov r1,r0 313: mov 2(r0),r1 314: tst r2 315: beq 4f 316: mov r1,-(sp) / have array - release elements 317: jsr pc,rewind 318: 1: 319: mov (sp),r1 320: 3: 321: jsr pc,getword 322: bes 1f 323: tst r0 324: beq 3b 325: mov r0,r1 326: jsr pc,release 327: br 1b 328: 1: 329: mov (sp)+,r1 330: 4: 331: jsr pc,release 332: jsr pc,pop 333: mov r1,2(r0) 334: jbr loop 335: 2: 336: mov sfree,stable(r0) 337: mov stable(r0),r0 338: mov (r0),sfree 339: beq symout 340: clr (r0) 341: jsr pc,pop 342: mov r1,2(r0) 343: jmp loop 344: / 345: symout: 346: mov $1,r0 347: sys write; 7f; 8f-7f 348: jmp reset 349: / 350: 7: <Symbol table overflow.\n> 351: 8: .even 352: / 353: / 354: sinit: 355: mov $sfree+4,r0 356: 1: 357: mov r0,-4(r0) 358: clr -2(r0) 359: add $4,r0 360: cmp r0,$sfend 361: blos 1b 362: clr sfend-4 363: rts pc 364: / 365: / 366: .bss 367: sfree: .=.+512. 368: sfend: 369: .text 370: / 371: / 372: / case S for save 373: / 374: case123: 375: tst sfree 376: bne 1f 377: jsr pc,sinit 378: 1: 379: jsr pc,readc 380: cmp r5,$pdl 381: bne 2f 382: movb $'S,ch 383: jbr eh 384: 2: 385: clr r3 386: cmp r0,$128. / check for array 387: blo 1f 388: inc r3 389: 1: 390: asl r0 391: mov stable(r0),r1 392: beq 2f 393: mov sfree,r2 394: mov (r2),sfree 395: beq symout 396: mov stable(r0),(r2) 397: mov r2,stable(r0) 398: jsr pc,pop 399: tst r3 400: beq 1f 401: jsr pc,length / to make auto arrays work 402: cmp r0,$1 403: bhi 1f 404: jsr pc,zero 405: 1: 406: mov r1,2(r2) 407: jbr loop 408: 2: 409: mov sfree,stable(r0) 410: mov stable(r0),r2 411: mov (r2),sfree 412: beq symout 413: clr (r2) 414: jsr pc,pop 415: tst r3 416: beq 1f 417: jsr pc,length 418: cmp r0,$1 419: bhi 1f 420: jsr pc,zero 421: 1: 422: mov r1,2(r2) 423: jbr loop 424: / 425: / 426: / case l for load 427: / 428: case154: 429: jsr pc,in154 430: jmp loop 431: / 432: in154: 433: jsr pc,readc 434: clr r2 435: cmp r0,$128. / check for array 436: blo 1f 437: inc r2 438: 1: 439: asl r0 440: mov stable(r0),r1 441: beq 1f 442: mov 2(r1),r1 443: mov r1,-(sp) 444: jsr pc,length 445: jsr pc,allocate 446: tst r2 447: beq 2f 448: mov r1,-(sp) / have array - copy elements 449: mov 2(sp),r1 450: jsr pc,rewind 451: 3: 452: mov 2(sp),r1 453: jsr pc,getword 454: bes 3f 455: tst r0 456: beq 4f 457: mov r0,-(sp) 458: mov r0,r1 459: jsr pc,length 460: jsr pc,allocate 461: mov (sp)+,r0 462: jsr pc,move 463: mov r1,r0 464: mov (sp),r1 465: jsr pc,putword 466: br 3b 467: 4: 468: clr r0 469: mov (sp),r1 470: jsr pc,putword 471: br 3b 472: 3: 473: mov (sp)+,r1 474: jsr pc,push 475: tst (sp)+ 476: rts pc 477: 2: 478: mov (sp)+,r0 479: jsr pc,move 480: jsr pc,push 481: rts pc 482: 1: 483: clr r0 484: jsr pc,allocate 485: jsr pc,putword 486: jsr pc,push 487: rts pc 488: / 489: / case : for save array 490: / 491: case072: 492: tst sfree 493: bne 1f 494: jsr pc,sinit 495: 1: 496: jsr pc,pop 497: jes eh 498: jsr pc,scalint 499: jsr pc,fsfile 500: jsr pc,backspace 501: tst r0 502: jmi eh1 / neg. index 503: jsr pc,length 504: cmp r0,$2 505: jhi eh1 / index too high 506: jsr pc,fsfile 507: clr r3 508: cmp r0,$1 509: blo 1f 510: beq 2f 511: jsr pc,backspace 512: mov r0,r3 513: mul $100.,r3 514: 2: 515: jsr pc,backspace 516: add r0,r3 517: cmp r3,$2048. 518: jhis eh1 / index too high 519: asl r3 520: 1: 521: jsr pc,release 522: jsr pc,readc 523: cmp r5,$pdl 524: bne 2f 525: movb $':,ch 526: jmp eh 527: 2: 528: asl r0 529: mov stable(r0),r1 530: beq 2f 531: mov r1,-(sp) 532: mov 2(r1),r1 533: mov l(r1),r0 534: sub a(r1),r0 535: sub $2,r0 536: cmp r3,r0 537: blos 1f 538: mov r1,-(sp) / need more space 539: mov r3,r0 540: add $2,r0 541: jsr pc,allocate 542: jsr pc,zero 543: mov (sp)+,r0 544: jsr pc,move 545: mov r1,-(sp) 546: mov r0,r1 547: jsr pc,release 548: mov (sp)+,r1 549: 1: 550: mov r1,-(sp) 551: mov r3,r0 552: jsr pc,seekchar 553: jsr pc,getword 554: bes 1f 555: sub $2,r(r1) 556: tst r0 557: beq 1f 558: mov r0,r1 559: jsr pc,release 560: 1: 561: jsr pc,pop 562: jes eh 563: mov r1,r0 564: mov (sp)+,r1 565: jsr pc,alterchar 566: swab r0 567: jsr pc,alterchar 568: mov (sp)+,r0 569: mov r1,2(r0) 570: jmp loop 571: 2: 572: mov sfree,stable(r0) 573: mov stable(r0),r0 574: mov (r0),sfree 575: jeq symout 576: clr (r0) 577: mov r0,-(sp) 578: mov r3,r0 579: add $2,r0 580: jsr pc,allocate 581: jsr pc,zero 582: sub $2,r0 583: jsr pc,seekchar 584: mov r1,-(sp) 585: br 1b 586: / 587: / case ; for load array 588: / 589: case073: 590: tst sfree 591: bne 1f 592: jsr pc,sinit 593: 1: 594: jsr pc,pop 595: jes eh 596: jsr pc,scalint 597: jsr pc,fsfile 598: jsr pc,backspace 599: tst r0 600: jmi eh1 / neg. index 601: jsr pc,length 602: cmp r0,$2 603: jhi eh1 604: jsr pc,fsfile 605: clr r3 606: cmp r0,$1 607: blo 1f 608: beq 2f 609: jsr pc,backspace 610: mov r0,r3 611: mul $100.,r3 612: 2: 613: jsr pc,backspace 614: add r0,r3 615: cmp r3,$2048. 616: jhis eh1 / index too high 617: asl r3 618: 1: 619: jsr pc,release 620: jsr pc,readc 621: asl r0 622: mov stable(r0),r1 623: beq 1f 624: mov 2(r1),r1 625: jsr pc,length 626: sub $2,r0 627: cmp r3,r0 628: bhi 1f / element not here 629: mov r3,r0 630: jsr pc,seekchar 631: jsr pc,getword 632: tst r0 633: beq 1f 634: mov r0,r1 635: mov r1,-(sp) 636: jsr pc,length 637: jsr pc,allocate 638: mov (sp)+,r0 639: jsr pc,move 640: jsr pc,push 641: jmp loop 642: 1: 643: clr r0 644: jsr pc,allocate 645: jsr pc,putword 646: jsr pc,push 647: jmp loop 648: / 649: / 650: / case L for load 651: / 652: case114: 653: jsr pc,readc 654: clr r2 655: cmp r0,$128. / check for array 656: blo 1f 657: inc r2 658: 1: 659: asl r0 660: mov stable(r0),r1 661: beq 4f 662: mov (r1),stable(r0) 663: mov sfree,(r1) 664: mov r1,sfree 665: mov 2(r1),r1 666: tst r2 667: beq 2f 668: mov r1,-(sp) / have array - assume a throw away 669: jsr pc,rewind 670: 1: 671: mov (sp),r1 672: 3: 673: jsr pc,getword 674: bes 1f 675: tst r0 676: beq 3b 677: mov r0,r1 678: jsr pc,release 679: br 1b 680: 1: 681: mov (sp)+,r1 682: 2: 683: jsr pc,push 684: jbr loop 685: 4: 686: movb $'L,ch 687: jbr eh 688: / 689: / 690: / case - for subtract 691: / 692: case055: 693: jsr pc,in055 694: jmp loop 695: / 696: in055: 697: jsr pc,pop 698: jes eh 699: jsr pc,fsfile 700: jsr pc,backspace 701: mov r0,savk 702: dec w(r1) 703: jsr pc,chsign 704: mov savk,r0 705: jsr pc,putchar 706: jsr pc,push 707: br in053 708: / 709: / 710: / case + for add 711: / 712: case053: 713: jsr pc,in053 714: jmp loop 715: / 716: in053: 717: jsr pc,eqk 718: mov $add3,r0 719: jsr pc,binop 720: jsr pc,pop 721: mov savk,r0 722: jsr pc,putchar 723: jsr pc,push 724: rts pc 725: / 726: / 727: / case * for multiply 728: / 729: case052: 730: jsr pc,pop 731: jes eh 732: mov r1,-(sp) 733: jsr pc,pop 734: jec 1f 735: mov (sp)+,r1 736: jsr pc,push 737: jbr eh 738: 1: 739: jsr pc,fsfile 740: jsr pc,backspace 741: mov r0,savk2 742: dec w(r1) 743: mov r1,r2 744: mov (sp)+,r1 745: jsr pc,fsfile 746: jsr pc,backspace 747: mov r0,savk1 748: dec w(r1) 749: mov r1,r3 750: mov $mul3,r0 751: jsr pc,binop 752: jsr pc,pop 753: cmp savk1,savk2 754: blo 1f 755: mov savk1,r2 756: br 2f 757: 1: 758: mov savk2,r2 759: 2: 760: cmp r2,k 761: bhis 1f 762: mov k,r2 763: 1: 764: add savk2,savk1 765: cmp r2,savk1 766: bhis 1f 767: mov r2,-(sp) 768: neg r2 769: add savk1,r2 770: jsr pc,removc 771: mov (sp)+,r0 772: 2: 773: jsr pc,putchar 774: jsr pc,push 775: jmp loop 776: 1: 777: mov savk1,r0 778: br 2b 779: / 780: / r1 = string 781: / r2 = count 782: / result returned in r1 (old r1 released) 783: / 784: removc: 785: mov r1,-(sp) 786: jsr pc,rewind 787: 1: 788: cmp r2,$1 789: blos 1f 790: jsr pc,getchar 791: sub $2,r2 792: br 1b 793: 1: 794: mov $2,r0 795: jsr pc,allocate 796: mov r1,-(sp) 797: 1: 798: mov 2(sp),r1 799: jsr pc,getchar 800: bes 1f 801: mov (sp),r1 802: jsr pc,putchar 803: mov r1,(sp) 804: br 1b 805: 1: 806: cmp r2,$1 807: bne 1f 808: mov (sp),r3 809: mov tenptr,r2 810: jsr pc,div3 811: mov r1,(sp) 812: mov r3,r1 813: jsr pc,release 814: mov r4,r1 815: jsr pc,release 816: 1: 817: mov 2(sp),r1 818: jsr pc,release 819: mov (sp)+,r1 820: tst (sp)+ 821: rts pc 822: / 823: / case / for divide 824: / 825: case057: 826: jsr pc,dscale 827: mov $div3,r0 828: jsr pc,binop 829: mov r4,r1 830: jsr pc,release 831: jsr pc,pop 832: mov savk,r0 833: jsr pc,putchar 834: jsr pc,push 835: jmp loop 836: / 837: / 838: dscale: 839: jsr pc,pop 840: jes eh 841: mov r1,-(sp) 842: jsr pc,pop 843: bec 1f 844: mov (sp)+,r1 845: jsr pc,push 846: jmp eh 847: 1: 848: mov r1,-(sp) 849: jsr pc,fsfile 850: jsr pc,backspace 851: mov r0,savk1 852: dec w(r1) 853: jsr pc,rewind 854: mov 2(sp),r1 855: jsr pc,fsfile 856: jsr pc,backspace 857: mov r0,savk2 858: dec w(r1) 859: mov k,r2 860: sub savk1,r2 861: add savk2,r2 862: mov k,savk 863: mov (sp)+,r1 864: tst r2 865: bmi 1f 866: jsr pc,add0 867: br 2f 868: 1: 869: neg r2 870: jsr pc,removc 871: 2: 872: mov r1,r3 873: mov (sp)+,r2 874: rts pc 875: / 876: / 877: / case % for remaindering 878: / 879: case045: 880: jsr pc,dscale 881: mov $div3,r0 882: jsr pc,binop 883: jsr pc,pop 884: jsr pc,release 885: mov r4,r1 886: mov savk1,r0 887: add k,r0 888: jsr pc,putchar 889: jsr pc,push 890: jmp loop 891: / 892: / 893: binop: 894: jsr pc,(r0) 895: jsr pc,push 896: mov r2,r1 897: jsr pc,release 898: mov r3,r1 899: jsr pc,release 900: rts pc 901: / 902: eqk: 903: jsr pc,pop 904: jes eh 905: mov r1,-(sp) 906: jsr pc,pop 907: bec 1f 908: mov (sp)+,r1 909: jsr pc,push 910: jbr eh 911: 1: 912: mov r1,-(sp) 913: mov 2(sp),r1 914: jsr pc,fsfile 915: jsr pc,backspace 916: mov r0,savk1 917: dec w(r1) 918: mov (sp),r1 919: jsr pc,fsfile 920: jsr pc,backspace 921: mov r0,savk2 922: dec w(r1) 923: cmp r0,savk1 924: beq 1f 925: blo 2f 926: mov savk2,savk 927: mov r0,r2 928: sub savk1,r2 929: mov 2(sp),r1 930: jsr pc,add0 931: mov r1,2(sp) 932: br 4f 933: 2: 934: mov savk1,r2 935: sub savk2,r2 936: mov (sp),r1 937: jsr pc,add0 938: mov r1,(sp) 939: 1: 940: mov savk1,savk 941: 4: 942: mov 2(sp),r3 943: mov (sp)+,r2 944: tst (sp)+ 945: rts pc 946: .bss 947: savk1: .=.+2 948: savk2: .=.+2 949: savk: .=.+2 950: .text 951: / 952: / 953: / r2 = count 954: / r1 = ptr 955: / returns ptr in r1 956: add0: 957: mov r1,-(sp) 958: jsr pc,length 959: jsr pc,allocate 960: clr r0 961: 1: 962: cmp r2,$1 963: blos 1f 964: jsr pc,putchar 965: sub $2,r2 966: br 1b 967: 1: 968: mov r1,-(sp) 969: mov 2(sp),r1 970: jsr pc,rewind 971: 1: 972: jsr pc,getchar 973: bes 1f 974: mov (sp),r1 975: jsr pc,putchar 976: mov r1,(sp) 977: mov 2(sp),r1 978: br 1b 979: 1: 980: cmp r2,$1 981: bne 1f 982: mov (sp),r3 983: mov tenptr,r2 984: jsr pc,mul3 985: mov r1,(sp) 986: mov r3,r1 987: jsr pc,release 988: 1: 989: mov 2(sp),r1 990: jsr pc,release 991: mov (sp)+,r1 992: tst (sp)+ 993: rts pc 994: / case i for input base 995: / 996: case151: 997: jsr pc,in151 998: jmp loop 999: / 1000: in151: 1001: jsr pc,pop 1002: jes eh 1003: jsr pc,scalint 1004: mov r1,-(sp) 1005: mov inbas,r1 1006: mov (sp)+,inbas 1007: jsr pc,release 1008: rts pc 1009: case111: 1010: mov inbas,r1 1011: jsr pc,length 1012: inc r0 1013: jsr pc,allocate 1014: mov inbas,r0 1015: jsr pc,move 1016: clr r0 1017: jsr pc,putchar /scale 1018: jsr pc,push 1019: jmp loop 1020: / 1021: .bss 1022: inbas: .=.+2 1023: .data 1024: / 1025: / 1026: / case o for output base 1027: / 1028: case157: 1029: jsr pc,in157 1030: jmp loop 1031: / 1032: in157: 1033: jsr pc,pop 1034: jes eh 1035: jsr pc,scalint 1036: mov r1,-(sp) 1037: jsr pc,length 1038: jsr pc,allocate 1039: mov (sp),r0 1040: jsr pc,move 1041: jsr pc,fsfile 1042: jsr pc,length 1043: 1: 1044: cmp r0,$1 1045: beq 1f 1046: jsr pc,backspace 1047: bpl 2f 1048: jsr pc,chsign 1049: jsr pc,length 1050: br 1b 1051: 2: 1052: clr sav 1053: mov r0,-(sp) 1054: 2: 1055: jsr pc,backspace 1056: bes 2f 1057: mov (sp),r2 1058: clr r3 1059: mul $100.,r2 1060: add r0,r3 1061: mov r3,(sp) 1062: tst sav 1063: beq 3f 1064: mov r2,r0 1065: clr r3 1066: mov sav,r2 1067: mul $100.,r2 1068: mov r3,sav 1069: add r0,sav 1070: br 2b 1071: 3: 1072: mov r2,sav 1073: br 2b 1074: 2: 1075: mov (sp)+,r0 1076: tst sav 1077: beq 2f 1078: mov sav,r0 1079: jsr pc,log2 1080: add $16.,r0 1081: mov r0,logo 1082: br 3f 1083: 1: 1084: jsr pc,backspace 1085: 2: 1086: tst r0 1087: bpl 1f 1088: mov $15.,logo 1089: br 3f 1090: 1: 1091: jsr pc,log2 1092: mov r0,logo 1093: 3: 1094: jsr pc,release 1095: mov basptr,r1 1096: jsr pc,release 1097: mov (sp),basptr 1098: / 1099: / set field widths for output 1100: / and set output digit handling routines 1101: / 1102: mov (sp),r1 1103: mov $bigout,outdit 1104: jsr pc,length 1105: cmp r0,$1. 1106: bne 2f 1107: jsr pc,fsfile 1108: jsr pc,backspace 1109: cmp r0,$16. 1110: bhi 2f 1111: mov $hexout,outdit 1112: 2: 1113: jsr pc,length 1114: jsr pc,allocate 1115: mov (sp),r0 1116: jsr pc,move 1117: clr (sp) 1118: jsr pc,fsfile 1119: jsr pc,backspace 1120: bpl 2f 1121: add $1.,(sp) 1122: jsr pc,chsign 1123: 2: 1124: mov r1,r2 1125: mov $1,r0 1126: jsr pc,allocate 1127: mov $-1,r0 1128: jsr pc,putchar 1129: mov r1,r3 1130: jsr pc,add3 1131: jsr pc,length 1132: asl r0 1133: add r0,(sp) 1134: jsr pc,fsfile 1135: jsr pc,backspace 1136: cmp r0,$9. 1137: blos 2f 1138: add $1,(sp) 1139: 2: 1140: jsr pc,release 1141: mov r2,r1 1142: jsr pc,release 1143: mov r3,r1 1144: jsr pc,release 1145: mov (sp)+,fw 1146: mov fw,fw1 1147: dec fw1 1148: cmp outdit,$hexout 1149: bne 2f 1150: mov $1,fw 1151: clr fw1 1152: 2: 1153: mov $70.,ll 1154: cmp fw,$70. 1155: blo 9f; rts pc; 9: 1156: mov $70.,r1 1157: clr r0 1158: dvd fw,r0 1159: mov r0,r1 1160: mpy fw,r1 1161: mov r1,ll 1162: rts pc 1163: case117: 1164: mov basptr,r1 1165: jsr pc,length 1166: inc r0 1167: jsr pc,allocate 1168: mov basptr,r0 1169: jsr pc,move 1170: clr r0 1171: jsr pc,putchar /scale 1172: jsr pc,push 1173: jmp loop 1174: / 1175: .data 1176: fw: 1 /field width for digits 1177: fw1: 0 1178: ll: 70. /line length 1179: .text 1180: / 1181: / 1182: / case k for skale factor 1183: / 1184: case153: 1185: jsr pc,pop 1186: jes eh 1187: jsr pc,scalint 1188: mov w(r1),r0 1189: sub a(r1),r0 1190: cmp r0,$1 1191: jhi eh1 1192: jsr pc,rewind 1193: jsr pc,getchar 1194: jmi eh1 1195: mov r0,k 1196: mov r1,-(sp) 1197: mov scalptr,r1 1198: jsr pc,release 1199: mov (sp)+,scalptr 1200: jmp loop 1201: / 1202: case113: 1203: mov scalptr,r1 1204: jsr pc,length 1205: inc r0 1206: jsr pc,allocate 1207: mov scalptr,r0 1208: jsr pc,move 1209: clr r0 1210: jsr pc,putchar 1211: jsr pc,push 1212: jmp loop 1213: scalint: 1214: jsr pc,fsfile 1215: jsr pc,backspace 1216: dec w(r1) 1217: mov r0,r2 1218: jsr pc,removc 1219: rts pc 1220: / 1221: / case ^ for exponentiation 1222: / 1223: case136: 1224: jsr pc,pop 1225: jes eh 1226: jsr pc,scalint 1227: jsr pc,fsfile 1228: jsr pc,backspace 1229: tst r0 1230: bge 1f 1231: inc negexp 1232: jsr pc,chsign 1233: 1: 1234: jsr pc,length 1235: cmp r0,$3 1236: jhis eh1 1237: mov r1,r3 1238: jsr pc,pop 1239: jes eh 1240: jsr pc,fsfile 1241: jsr pc,backspace 1242: mov r0,savk 1243: dec w(r1) 1244: mov r1,r2 1245: jsr pc,exp3 1246: mov r1,-(sp) 1247: mov r2,r1 1248: jsr pc,release 1249: mov r3,r1 1250: jsr pc,rewind 1251: jsr pc,getchar 1252: mov r0,-(sp) 1253: jsr pc,getchar 1254: bes 2f 1255: mov r0,r1 1256: mul $100.,r1 1257: add (sp)+,r1 1258: br 3f 1259: 2: 1260: mov (sp)+,r1 1261: 3: 1262: mul savk,r1 1263: mov r1,r2 1264: mov r3,r1 1265: jsr pc,release 1266: tst negexp 1267: bne 4f 1268: cmp k,savk 1269: blo 1f 1270: mov k,r3 1271: br 2f 1272: 1: 1273: mov savk,r3 1274: 2: 1275: cmp r3,r2 1276: bhis 4f 1277: sub r3,r2 1278: mov (sp)+,r1 1279: mov r3,-(sp) 1280: jsr pc,removc 1281: mov (sp)+,r0 1282: jsr pc,putchar 1283: jsr pc,push 1284: br 3f 1285: 4: 1286: mov (sp)+,r1 1287: mov r2,r0 1288: jsr pc,putchar 1289: jsr pc,push 1290: 3: 1291: tst negexp 1292: jeq loop 1293: clr negexp 1294: jsr pc,pop 1295: mov r1,-(sp) 1296: mov $2,r0 1297: jsr pc,allocate 1298: mov $1,r0 1299: jsr pc,putchar 1300: clr r0 1301: jsr pc,putchar 1302: jsr pc,push 1303: mov (sp)+,r1 1304: jsr pc,push 1305: jmp case057 1306: / 1307: .bss 1308: sav: .=.+2 1309: negexp: .=.+2 1310: .text 1311: / 1312: / case v for square root 1313: / 1314: case166: 1315: jsr pc,pop 1316: jes eh 1317: / 1318: jsr pc,fsfile 1319: jsr pc,backspace 1320: mov r0,savk 1321: dec w(r1) 1322: mov w(r1),r2 1323: sub a(r1),r2 1324: tst r2 1325: beq sqz 1326: jsr pc,backspace 1327: tst r0 1328: jmi eh1 1329: mov k,r2 1330: asl r2 1331: sub savk,r2 1332: beq 1f 1333: blo 2f 1334: jsr pc,add0 1335: br 1f 1336: 2: 1337: neg r2 1338: jsr pc,removc 1339: 1: 1340: jsr pc,sqrt 1341: mov k,r0 1342: jsr pc,putchar 1343: jsr pc,push 1344: jmp loop 1345: / 1346: / 1347: sqz: 1348: mov savk,r0 1349: jsr pc,putchar 1350: jsr pc,push 1351: jmp loop 1352: .bss 1353: sqtemp: .=.+2 1354: .text 1355: / 1356: / 1357: / case [ for subroutine definition 1358: / 1359: case133: 1360: clr -(sp) 1361: clr r0 1362: jsr pc,allocate 1363: jsr pc,push 1364: 1: jsr pc,readc 1365: cmp r0,$'] 1366: bne 3f 1367: tst (sp) 1368: beq 1f 1369: dec (sp) 1370: br 2f 1371: 3: 1372: cmp r0,$'[ 1373: bne 2f 1374: inc (sp) 1375: 2: 1376: jsr pc,putchar 1377: br 1b 1378: / 1379: 1: tst (sp)+ 1380: jmp loop 1381: / 1382: / 1383: / case x for execute top of stack 1384: / 1385: case170: 1386: jsr pc,in170 1387: jmp loop 1388: / 1389: in170: 1390: jsr pc,pop 1391: jes eh 1392: mov r1,-(sp) 1393: tst *readptr 1394: beq 1f 1395: mov *readptr,r1 1396: cmp r(r1),w(r1) 1397: bne 1f 1398: jsr pc,release 1399: br 2f 1400: 1: 1401: add $2,readptr 1402: cmp readptr,$readtop 1403: bhis 1f 1404: 2: mov (sp)+,r1 1405: mov r1,*readptr 1406: beq 2f 1407: jsr pc,rewind 1408: rts pc 1409: 2: 1410: jsr pc,readc 1411: cmp r0,$'\n 1412: beq 3f 1413: mov r0,savec 1414: 3: 1415: rts pc 1416: 1: 1417: nderr: 1418: mov $1,r0 1419: sys write; 1f; 2f-1f 1420: jmp reset 1421: 1: <Nesting depth.\n> 1422: 2: .even 1423: / 1424: .data 1425: readptr: readstack 1426: .bss 1427: readstack: .=.+100. 1428: readtop: 1429: .text 1430: / 1431: / case ? for apl box function 1432: / 1433: case077: 1434: add $2,readptr 1435: cmp readptr,$readtop 1436: bhis nderr 1437: clr *readptr 1438: in077: 1439: mov source,-(sp) 1440: clr source 1441: jsr pc,readc 1442: cmp r0,$'! 1443: bne 1f 1444: jsr pc,in041 1445: mov (sp)+,source 1446: br in077 1447: 1: 1448: mov r0,savec 1449: clr r0 1450: jsr pc,allocate 1451: 2: 1452: jsr pc,readc 1453: jsr pc,putchar 1454: 1: 1455: jsr pc,readc 1456: jsr pc,putchar 1457: cmp r0,$'\\ 1458: beq 2b 1459: cmp r0,$'\n 1460: bne 1b 1461: mov (sp)+,source 1462: mov r1,*readptr 1463: jmp loop 1464: / 1465: / 1466: / case < for conditional execution 1467: / 1468: case074: 1469: jsr pc,in074 1470: ble neg074 1471: jmp aff074 1472: / 1473: / 1474: / case !< for conditional execution 1475: / 1476: in74a: 1477: jsr pc,in074 1478: bgt inneg 1479: jmp inaff 1480: / 1481: in074: 1482: jsr pc,in055 /go subtract 1483: jsr pc,pop 1484: jsr pc,length 1485: tst r0 1486: beq 1f 1487: jsr pc,fsfile 1488: jsr pc,backspace 1489: jsr pc,backspace 1490: tst r0 1491: 1: 1492: rts pc 1493: / 1494: aff074: 1495: jsr pc,release 1496: jsr pc,in154 /load from register 1497: jmp case170 1498: / 1499: neg074: 1500: jsr pc,release 1501: jsr pc,readc 1502: jmp loop 1503: / 1504: / 1505: / case = for conditional execution 1506: / 1507: case075: 1508: jsr pc,in074 1509: beq aff074 1510: jmp neg074 1511: / 1512: / 1513: / case != for conditional execution 1514: / 1515: in75a: 1516: jsr pc,in074 1517: bne inaff 1518: jmp inneg 1519: / 1520: / 1521: / case > for conditional execution 1522: / 1523: case076: 1524: jsr pc,in074 1525: bge neg074 1526: jmp aff074 1527: / 1528: / 1529: / case !> for conditional execution 1530: / 1531: in76a: 1532: jsr pc,in074 1533: blt inneg 1534: jmp inaff 1535: / 1536: inaff: 1537: jsr pc,release 1538: jsr pc,in154 1539: jsr pc,in170 1540: rts pc 1541: / 1542: inneg: 1543: jsr pc,release 1544: jsr pc,readc 1545: rts pc 1546: / 1547: err: 1548: mov $1,r0 1549: sys write; 1f; 2f-1f 1550: jmp reset 1551: 1: <Fatal error\n>; 2: .even 1552: / 1553: eh1: 1554: jsr pc,release 1555: eh: 1556: movb ch,1f+2 1557: mov $1,r0 1558: sys write; 1f; 2f-1f 1559: mov $readstack,readptr 1560: mov errstack,sp 1561: jmp loop 1562: .data 1563: 1: <( ) ?\n> 1564: 2: .even 1565: .text 1566: / 1567: / 1568: / routine to read and convert a number from the 1569: / input stream. Numbers beginnig with 0 are 1570: / converted as octal. Routine converts 1571: / up to next nonnumeric. 1572: / 1573: / 1574: readin: 1575: clr dp 1576: clr dpt 1577: clr r0 1578: jsr pc,allocate 1579: mov r1,-(sp) 1580: mov strptr,r1 1581: jsr pc,create 1582: jsr pc,readc 1583: 1: 1584: cmpb ch,$'0 1585: blt 3f 1586: cmpb ch,$'9 1587: bgt 3f 1588: mov ch,r0 1589: sub $'0,r0 1590: 4: 1591: tst dp 1592: beq 8f 1593: cmp dpt,$99. 1594: beq 5f 1595: inc dpt 1596: 8: 1597: mov chptr,r1 1598: jsr pc,create 1599: tst r0 1600: beq 2f 1601: jsr pc,putchar 1602: 2: mov r1,chptr 1603: mov (sp),r3 1604: mov inbas,r2 1605: jsr pc,mul3 1606: mov r1,(sp) 1607: mov r3,r1 1608: jsr pc,release 1609: mov (sp),r3 1610: mov chptr,r2 1611: jsr pc,add3 1612: mov r1,(sp) 1613: mov r3,r1 1614: jsr pc,release 1615: 5: 1616: jsr pc,readc 1617: mov r0,ch 1618: br 1b 1619: 3: 1620: cmpb ch,$'A 1621: blt 1f 1622: cmpb ch,$'F 1623: bgt 1f 1624: mov ch,r0 1625: sub $67,r0 1626: br 4b 1627: 1: 1628: cmpb ch,$134 /backslash 1629: bne 1f 1630: jsr pc,readc 1631: br 5b 1632: 1: 1633: cmpb ch,$'. 1634: bne 1f 1635: tst dp 1636: bne 1f 1637: inc dp 1638: clr dpt 1639: br 5b 1640: 1: 1641: mov r0,savec 1642: / 1643: / scale up or down 1644: 2: 1645: tst dp 1646: bne 1f 1647: mov (sp)+,r1 1648: clr r0 1649: jsr pc,putchar 1650: rts pc 1651: 1: 1652: mov (sp),r1 1653: jsr pc,scale 1654: mov dpt,r0 1655: jsr pc,putchar 1656: tst (sp)+ 1657: rts pc 1658: / 1659: .bss 1660: dp: .=.+2 1661: dpt: .=.+2 1662: .text 1663: / 1664: scale: 1665: mov dpt,r2 1666: jsr pc,add0 1667: mov r1,-(sp) 1668: mov $1,r0 1669: jsr pc,allocate 1670: mov dpt,r0 1671: jsr pc,putchar 1672: mov r1,r3 1673: mov inbas,r2 1674: jsr pc,exp3 1675: mov r1,-(sp) 1676: mov r3,r1 1677: jsr pc,release 1678: mov (sp)+,r2 1679: mov (sp)+,r3 1680: jsr pc,div3 1681: mov r1,-(sp) 1682: mov r2,r1 1683: jsr pc,release 1684: mov r3,r1 1685: jsr pc,release 1686: mov r4,r1 1687: jsr pc,release 1688: mov (sp)+,r1 1689: rts pc 1690: / 1691: / routine to read another character from the input 1692: / stream. If the caller does not want the character, 1693: / it is to be placed in the cell savec. 1694: / The routine exits to the system on end of file. 1695: / Character is returned in r0. 1696: / 1697: / jsr pc,readc 1698: / movb r0,... 1699: / 1700: / 1701: readc: 1702: tst savec 1703: beq 1f 1704: movb savec,r0 1705: bic $177400,r0 1706: clr savec 1707: rts pc 1708: 1: 1709: tst *readptr 1710: bne 1f 1711: 2: mov source,r0 1712: sys read; ch; 1 1713: bes eof 1714: tst r0 1715: beq eof 1716: movb ch,r0 1717: bic $177400,r0 1718: rts pc 1719: 1: 1720: mov r1,-(sp) 1721: mov *readptr,r1 1722: jsr pc,getchar 1723: bes eof1 1724: bic $177400,r0 1725: mov r0,ch 1726: mov (sp)+,r1 1727: rts pc 1728: / 1729: eof: 1730: tst source 1731: beq 1f 1732: clr source 1733: br 2b 1734: 1: 1735: sys exit 1736: / 1737: eof1: 1738: mov *readptr,r1 1739: beq 2f 1740: jsr pc,release 1741: 2: 1742: sub $2,readptr 1743: mov (sp)+,r1 1744: jmp readc 1745: / 1746: / 1747: / case p for print 1748: / 1749: case160: 1750: cmp r5,$pdl 1751: jeq eh 1752: jsr pc,in160 1753: jmp loop 1754: / 1755: / 1756: in160: 1757: / mov $1,r0 1758: / sys write; sphdr; 4 1759: br 1f 1760: / 1761: sphdr: < > 1762: .even 1763: / 1764: 1: cmp r5,$pdl 1765: bne 1f 1766: mov $1,r0 1767: sys write; qm; 1 1768: mov $1,r0 1769: sys write; nl; 1 1770: rts pc 1771: / 1772: / do the conversion 1773: / 1774: 1: 1775: mov -2(r5),r1 1776: jsr pc,printf 1777: rts pc 1778: / 1779: / 1780: / case f for print the stack 1781: / 1782: case146: 1783: mov r5,-(sp) 1784: 1: 1785: cmp r5,$pdl 1786: beq 2f 1787: 1: 1788: jsr pc,in160 1789: jsr pc,pop 1790: cmp r5,$pdl 1791: bne 1b 1792: 2: 1793: mov $stable-2,r2 1794: 1: 1795: tst (r2)+ 1796: cmp r2,$stable+254. 1797: bhi 1f 1798: / 1799: mov (r2),r3 1800: beq 1b 1801: movb $'0,7f+3 1802: mov r2,r0 1803: sub $stable,r0 1804: asr r0 1805: movb r0,7f+1 1806: 3: 1807: mov $1,r0 1808: sys write; 7f; 8f-7f 1809: .data 1810: 7: <" (0)"> 1811: 8: .even 1812: .text 1813: mov 2(r3),r1 1814: jsr pc,printf 1815: tst (r3) 1816: beq 1b 1817: incb 7b+3 1818: mov (r3),r3 1819: br 3b 1820: 1: 1821: mov (sp)+,r5 1822: jbr loop 1823: / 1824: / 1825: / routine to convert to decimal and print the 1826: / top element of the stack. 1827: / 1828: / jsr pc,printf 1829: / 1830: / 1831: printf: 1832: mov r4,-(sp) 1833: mov r3,-(sp) 1834: mov r2,-(sp) 1835: mov r1,-(sp) 1836: mov r0,-(sp) 1837: clr -(sp) 1838: jsr pc,rewind 1839: 2: 1840: jsr pc,getchar 1841: bes 2f 1842: cmp r0,$143 1843: blos 2b 1844: cmp r0,$-1 1845: beq 2b 1846: bis $1,(sp) 1847: br 2b 1848: 2: 1849: tst (sp)+ 1850: beq 2f 1851: jsr pc,length 1852: mov r0,0f 1853: mov a(r1),3f 1854: mov $1,r0 1855: sys 0; 9f 1856: .data 1857: 9: 1858: sys write; 3:.=.+2; 0:.=.+2 1859: .text 1860: jbr prout 1861: 2: 1862: jsr pc,fsfile 1863: jsr pc,backspace 1864: bec 1f 1865: mov $1,r0 1866: sys write; asczero; 1 1867: jbr prout 1868: 1: 1869: jsr pc,length 1870: mov r1,-(sp) 1871: jsr pc,allocate 1872: mov (sp),r0 1873: mov r1,(sp) 1874: jsr pc,move 1875: mov ll,count 1876: / inc count 1877: jsr pc,fsfile 1878: jsr pc,backspace 1879: mov r0,savk 1880: dec w(r1) 1881: jsr pc,backspace 1882: cmpb r0,$-1 1883: bne 2f 1884: mov basptr,r1 1885: jsr pc,fsfile 1886: jsr pc,backspace 1887: cmp r0,$-1 1888: beq 2f 1889: mov (sp),r1 1890: jsr pc,chsign 1891: mov $'-,ch 1892: jsr pc,wrchar 1893: br 1f 1894: 2: 1895: / mov $' ,ch 1896: / jsr pc,wrchar 1897: 1: 1898: mov strptr,r1 1899: jsr pc,create 1900: mov basptr,r1 1901: jsr pc,length 1902: cmp r0,$1 1903: jlo dingout 1904: bne 1f 1905: jsr pc,rewind 1906: jsr pc,getchar 1907: cmp r0,$1. 1908: jeq unout 1909: cmp r0,$-1 1910: jeq dingout 1911: cmp r0,$10. 1912: jeq tenout 1913: 1: 1914: mov log10,r1 1915: mul savk,r1 1916: clr r0 1917: div logo,r0 1918: mov r0,dout 1919: clr ct 1920: 1: 1921: mov (sp),r3 1922: mov savk,r2 1923: jsr pc,getdec 1924: mov r1,decimal 1925: clr dflg 1926: mov (sp),r1 1927: mov savk,r2 1928: jsr pc,removc 1929: mov r1,(sp) 1930: 1: 1931: mov (sp),r3 1932: mov basptr,r2 1933: jsr pc,div3 1934: mov r1,r2 1935: mov (sp),r1 1936: jsr pc,release 1937: mov r2,(sp) 1938: mov r4,r1 1939: jsr pc,*outdit 1940: mov (sp),r1 1941: jsr pc,length 1942: bne 1b 1943: / 1944: mov strptr,r1 1945: jsr pc,fsfile 1946: 1: 1947: jsr pc,backspace 1948: bes 1f 1949: mov r0,ch 1950: jsr pc,wrchar 1951: br 1b 1952: 1: 1953: mov (sp)+,r1 1954: jsr pc,release 1955: tst savk 1956: bne 1f 1957: mov decimal,r1 1958: jsr pc,release 1959: br prout 1960: 1: 1961: mov dot,ch 1962: jsr pc,wrchar 1963: mov strptr,r1 1964: jsr pc,create 1965: mov decimal,-(sp) 1966: inc dflg 1967: 1: 1968: mov (sp),r3 1969: mov basptr,r2 1970: jsr pc,mul3 1971: mov r1,(sp) 1972: mov r3,r1 1973: jsr pc,release 1974: mov (sp),r3 1975: mov savk,r2 1976: jsr pc,getdec 1977: mov r1,(sp) 1978: mov r3,r1 1979: mov savk,r2 1980: jsr pc,removc 1981: jsr pc,*outdit 1982: mov strptr,r1 1983: inc ct 1984: cmp ct,dout 1985: blo 1b 1986: mov (sp)+,r1 1987: jsr pc,release 1988: mov strptr,r1 1989: jsr pc,rewind 1990: 1: 1991: jsr pc,getchar 1992: bes 1f 1993: mov r0,ch 1994: jsr pc,wrchar 1995: br 1b 1996: 1: 1997: / 1998: / cleanup, print new line and return 1999: / 2000: prout: mov $1,r0 2001: sys write; nl; 1 2002: mov (sp)+,r0 2003: mov (sp)+,r1 2004: mov (sp)+,r2 2005: mov (sp)+,r3 2006: mov (sp)+,r4 2007: rts pc 2008: / 2009: / 2010: / 2011: / r2 = count 2012: / r3 = pointer (not released) 2013: / 2014: .bss 2015: dflg: .=.+2 2016: dout: .=.+2 2017: logo: .=.+2 2018: log10: .=.+2 2019: decimal: .=.+2 2020: .text 2021: getdec: 2022: mov r3,-(sp) 2023: mov r3,r1 2024: jsr pc,rewind 2025: jsr pc,length 2026: jsr pc,allocate 2027: mov r1,-(sp) 2028: 1: 2029: cmp r2,$1 2030: blt 1f 2031: mov 2(sp),r1 2032: jsr pc,getchar 2033: mov (sp),r1 2034: jsr pc,putchar 2035: mov r1,(sp) 2036: sub $2,r2 2037: br 1b 2038: 1: 2039: tst r2 2040: beq 1f 2041: mov tenptr,r2 2042: mov (sp),r3 2043: jsr pc,mul3 2044: mov r1,(sp) 2045: mov r3,r1 2046: jsr pc,length 2047: jsr pc,release 2048: mov r0,r3 2049: jsr pc,allocate 2050: mov r1,-(sp) 2051: mov 2(sp),r1 2052: jsr pc,rewind 2053: 2: 2054: tst r3 2055: beq 2f 2056: jsr pc,getchar 2057: mov (sp),r1 2058: jsr pc,putchar 2059: mov r1,(sp) 2060: dec r3 2061: mov 2(sp),r1 2062: br 2b 2063: 2: 2064: clr r0 2065: mov (sp),r1 2066: jsr pc,putchar 2067: mov 2(sp),r1 2068: jsr pc,release 2069: mov (sp),r3 2070: mov tenptr,r2 2071: jsr pc,div3 2072: mov r1,(sp) 2073: mov r3,r1 2074: jsr pc,release 2075: mov r4,r1 2076: jsr pc,release 2077: mov (sp)+,r1 2078: tst (sp)+ 2079: mov (sp)+,r3 2080: rts pc 2081: 1: 2082: mov (sp)+,r1 2083: mov (sp)+,r3 2084: rts pc 2085: tenout: 2086: mov savk,ct 2087: mov $2,r0 2088: jsr pc,allocate 2089: mov r1,-(sp) 2090: mov 2(sp),r1 2091: jsr pc,fsfile 2092: jsr pc,backspace 2093: mov r0,r3 2094: clr r2 2095: dvd $10.,r2 2096: beq 1f 2097: 3: 2098: add $60,r2 2099: mov r2,r0 2100: mov (sp),r1 2101: jsr pc,putchar 2102: mov r1,(sp) 2103: 1: 2104: mov (sp),r1 2105: add $60,r3 2106: mov r3,r0 2107: jsr pc,putchar 2108: mov 2(sp),r1 2109: 1: 2110: jsr pc,backspace 2111: bec 2f 2112: mov (sp),r1 2113: jsr pc,length 2114: cmp r0,ct 2115: beq 4f 2116: blo 5f 2117: sub ct,r0 2118: mov r0,ct 2119: 1: 2120: jsr pc,getchar 2121: mov r0,ch 2122: jsr pc,wrchar 2123: dec ct 2124: bne 1b 2125: jsr pc,getchar 2126: bes 6f 2127: jsr pc,backspace 2128: 4: 2129: movb dot,ch 2130: jsr pc,wrchar 2131: 1: 2132: jsr pc,getchar 2133: bes 1f 2134: mov r0,ch 2135: jsr pc,wrchar 2136: br 1b 2137: 5: 2138: sub r0,ct 2139: movb dot,ch 2140: jsr pc,wrchar 2141: mov $60,ch 2142: 5: 2143: jsr pc,wrchar 2144: dec ct 2145: bne 5b 2146: br 1b 2147: 1: 2148: 6: 2149: mov (sp)+,r1 2150: jsr pc,release 2151: mov (sp)+,r1 2152: jsr pc,release 2153: jbr prout 2154: 2: 2155: mov r0,r3 2156: clr r2 2157: dvd $10.,r2 2158: br 3b 2159: dot: <.> 2160: .even 2161: ct: .=.+2 2162: / 2163: / 2164: dingout: 2165: clr -(sp) 2166: br 1f 2167: unout: 2168: mov $1,-(sp) 2169: 1: 2170: mov 2(sp),r1 2171: mov savk,r2 2172: jsr pc,removc 2173: mov r1,2(sp) 2174: mov strptr,r1 2175: jsr pc,create 2176: mov $-1,r0 2177: jsr pc,putchar 2178: mov r1,r3 2179: 1: 2180: mov 2(sp),r1 2181: jsr pc,length 2182: beq 1f 2183: mov r1,r2 2184: jsr pc,add3 2185: mov r1,2(sp) 2186: mov r2,r1 2187: jsr pc,release 2188: mov $1,r0 2189: tst (sp) 2190: beq 2f 2191: mov $'1,ch 2192: jsr pc,wrchar 2193: br 1b 2194: 2: 2195: tst delflag 2196: jne in177 2197: sys write; ding; 3 2198: br 1b 2199: 1: 2200: tst (sp)+ 2201: mov (sp)+,r1 2202: jsr pc,release 2203: jmp prout 2204: / 2205: ding: < > /<bell prefix form feed> 2206: sp5: <\\\n > 2207: minus: <-> 2208: one: <1> 2209: .even 2210: .bss 2211: count: .=.+2 2212: .text 2213: / 2214: bigout: 2215: mov r1,-(sp) /big digit 2216: tst dflg 2217: beq 1f 2218: clr r0 2219: jsr pc,allocate 2220: mov r1,tptr 2221: 1: 2222: mov strptr,r1 2223: jsr pc,length 2224: add fw,r0 2225: dec r0 2226: mov r0,-(sp) /end of field 2227: clr -(sp) /negative 2228: mov 4(sp),r1 2229: jsr pc,length 2230: bne 2f 2231: mov $'0,r0 2232: tst dflg 2233: beq 3f 2234: mov tptr,r1 2235: jsr pc,putchar 2236: mov r1,tptr 2237: br 1f 2238: 3: 2239: mov strptr,r1 2240: jsr pc,putchar 2241: br 1f 2242: 2: 2243: mov 4(sp),r1 /digit 2244: jsr pc,fsfile 2245: jsr pc,backspace 2246: bpl 2f 2247: mov $1,(sp) /negative 2248: jsr pc,chsign 2249: 2: 2250: mov 4(sp),r3 /digit 2251: mov r3,r1 2252: jsr pc,length 2253: beq 1f 2254: mov tenptr,r2 2255: jsr pc,div3 2256: mov r1,4(sp) /digit 2257: mov r3,r1 2258: jsr pc,release 2259: mov r4,r1 2260: jsr pc,rewind 2261: jsr pc,getchar 2262: jsr pc,release 2263: add $'0,r0 2264: tst dflg 2265: beq 3f 2266: mov tptr,r1 2267: jsr pc,putchar 2268: mov r1,tptr 2269: br 2b 2270: 3: 2271: mov strptr,r1 2272: jsr pc,putchar 2273: br 2b 2274: 1: 2275: tst dflg 2276: beq 4f 2277: mov tptr,r1 2278: jsr pc,length 2279: cmp r0,fw1 2280: bhis 2f 2281: mov fw1,r1 2282: sub r0,r1 2283: mov r1,-(sp) 2284: mov strptr,r1 2285: 3: 2286: mov $'0,r0 2287: jsr pc,putchar 2288: dec (sp) 2289: bne 3b 2290: tst (sp)+ 2291: 2: 2292: mov tptr,r1 2293: jsr pc,fsfile 2294: 2: 2295: mov tptr,r1 2296: jsr pc,backspace 2297: bes 2f 2298: mov strptr,r1 2299: jsr pc,putchar 2300: br 2b 2301: 2: 2302: mov tptr,r1 2303: jsr pc,release 2304: br 1f 2305: 4: 2306: mov strptr,r1 2307: jsr pc,length 2308: cmp r0,2(sp) /end of field 2309: bhis 1f 2310: mov $'0,r0 2311: jsr pc,putchar 2312: br 1b 2313: 1: 2314: tst (sp) /negative 2315: beq 1f 2316: mov $'-,r0 2317: mov strptr,r1 2318: dec w(r1) 2319: jsr pc,putchar 2320: 1: 2321: mov strptr,r1 2322: mov $' ,r0 2323: jsr pc,putchar 2324: tst (sp)+ 2325: tst (sp)+ 2326: mov (sp)+,r1 2327: jsr pc,release 2328: rts pc 2329: / 2330: .bss 2331: tptr: .=.+2 2332: tenptr: .=.+2 2333: .text 2334: / 2335: / 2336: / 2337: hexout: 2338: mov r1,-(sp) 2339: jsr pc,rewind 2340: jsr pc,getchar 2341: cmp r0,$16. 2342: blo 1f 2343: jmp err 2344: 1: 2345: add $60,r0 2346: cmp r0,$'9 2347: blos 2f 2348: add $'A-'9-1,r0 2349: 2: 2350: mov strptr,r1 2351: jsr pc,putchar 2352: mov (sp)+,r1 2353: jsr pc,release 2354: rts pc 2355: / 2356: / 2357: wrchar: 2358: tst delflag 2359: jne in177 2360: mov $1,r0 2361: tst count 2362: bne 7f 2363: sys write; sp5; 2 2364: mov ll,count 2365: mov $1,r0 2366: 7: 2367: dec count 2368: sys write; ch; 1 2369: rts pc 2370: / 2371: / 2372: / case P for print an ascii string 2373: / 2374: / 2375: case120: 2376: jsr pc,pop 2377: jes eh 2378: jsr pc,length 2379: mov r0,0f 2380: mov a(r1),3f 2381: mov $1,r0 2382: sys 0; 9f 2383: jsr pc,release 2384: jmp loop 2385: .data 2386: 9: sys write; 3:.=.+2; 0:.=.+2 2387: .text 2388: / 2389: / 2390: / here for unimplemented stuff 2391: / 2392: junk: 2393: movb r0,1f 2394: mov $1,r0 2395: sys write; 1f; 2f-1f 2396: jmp loop 2397: .data 2398: 1: <0 not in switch.\n> 2399: 2: .even 2400: .text 2401: / 2402: / 2403: / 2404: / routine to place one word onto the pushdown list 2405: / Error exit to system on overflow. 2406: / 2407: / 2408: push: 2409: mov r1,(r5)+ 2410: cmp r5,$pdltop 2411: bhis pdlout 2412: rts pc 2413: / 2414: pdlout: 2415: mov $1,r0 2416: sys write; 1f; 2f-1f 2417: jmp reset 2418: 1: <Out of pushdown.\n> 2419: 2: .even 2420: / 2421: / 2422: / routine to remove one word from the pushdown list 2423: / carry bit set on empty stack 2424: / 2425: / 2426: / jsr pc,pop 2427: / 2428: pop: 2429: cmp r5,$pdl 2430: bhi 1f 2431: clr r1 2432: sec 2433: rts pc 2434: 1: mov -(r5),r1 2435: clc 2436: rts pc 2437: / 2438: / 2439: / 2440: / 2441: .data 2442: outdit: hexout 2443: .bss 2444: source: .=.+2 2445: savec: .=.+2 2446: ch: .=.+2 2447: .text 2448: nl: <\n> 2449: asczero: <0> 2450: qm: <?\n> 2451: .even 2452: / 2453: .bss 2454: chptr: .=.+2 2455: strptr: .=.+2 2456: basptr: .=.+2 2457: scalptr: .=.+2 2458: errstack:.=.+2 2459: / 2460: stable: .=.+512. 2461: .text 2462: casetab: 2463: case012; 012 /nl 2464: loop; 040 /sp 2465: case041; 041 /! 2466: case045; 045 /% 2467: case052; 052 /* 2468: case053; 053 /+ 2469: case055; 055 /- 2470: case060; 056 /. 2471: case057; 057 // 2472: case060; 060 /0 2473: case060; 061 /1 2474: case060; 062 /2 2475: case060; 063 /3 2476: case060; 064 /4 2477: case060; 065 /5 2478: case060; 066 /6 2479: case060; 067 /7 2480: case060; 070 /8 2481: case060; 071 /9 2482: case072; 072 /: 2483: case073; 073 /; 2484: case074; 074 /< 2485: case075; 075 /= 2486: case076; 076 /> 2487: case077; 077 /? 2488: case060; 101 /A 2489: case060; 102 /B 2490: case060; 103 /C 2491: case060; 104 /D 2492: case060; 105 /E 2493: case060; 106 /F 2494: case111; 111 /I 2495: case113; 113 /K 2496: case114; 114 /L 2497: case117; 117 /O 2498: case120; 120 /P 2499: case121; 121 /Q 2500: case123; 123 /S 2501: case166; 126 /V 2502: case170; 130 /X 2503: case172; 132 /Z 2504: case133; 133 /[ 2505: case136; 136 /^ 2506: case137; 137 /_ 2507: case143; 143 /c 2508: case144; 144 /d 2509: case146; 146 /f 2510: case151; 151 /i 2511: case153; 153 /k 2512: case154; 154 /l 2513: case157; 157 /o 2514: case160; 160 /p 2515: case161; 161 /q 2516: case163; 163 /s 2517: case166; 166 /v 2518: case170; 170 /x 2519: case172; 172 /z 2520: 0;0 2521: / 2522: .bss 2523: pdl: .=.+100. 2524: pdltop: 2525: .text 2526: 2527: reset: 2528: clr r0 2529: sys seek; 0; 2 2530: 1: 2531: clr r0 2532: sys read; rathole; 1 2533: bes 1f 2534: tst r0 2535: beq 1f 2536: cmpb rathole,$'q 2537: bne 1b 2538: 1: 2539: sys exit 2540: .bss 2541: rathole: .=.+2 2542: .text
Defined functions
Defined variables
|
Last modified: 1975-05-14
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 638 |
|