UNIX 6th Ed. - /usr/source/s1/bas.s

   1: /
   2: /
   3: 
   4: / bas0 -- basic
   5: 
   6: scope = 1
   7: .globl  main
   8: .globl  sin, cos, log, exp, atan, pow, sqrt
   9: .globl  rand, srand
  10: .globl  fptrap
  11: .globl fopen, getc
  12: 
  13: indir = 0  /for  indirect sys calls. (not in as)
  14: one = 40200
  15: 
  16: main:
  17:         mov     $1,prfile /initial print file
  18:         sys     signal; 4; fptrap
  19:         setd
  20:         sys     time
  21:         mov     r1,r0
  22:         mov     r0,randx
  23:         jsr     pc,srand
  24:         sys     signal; 2; intrup
  25:         mov     sp,gsp
  26:         clr     seeka
  27:         mov     $'a,r1
  28: 1:
  29:         movb    r1,tmpf+8
  30:         sys     stat; tmpf; line
  31:         bes     1f
  32:         inc     r1
  33:         cmp     r1,$'z
  34:         blos    1b
  35:         br      2f
  36: 1:
  37:         sys     creat; tmpf; 600
  38:         bes     2f
  39:         mov     r0,tfo
  40:         sys     open; tmpf; 0
  41:         bec     1f
  42: 2:
  43:         mov     $3f,r0
  44:         jsr     pc,print
  45:         sys     exit
  46: 3:
  47:         <Tmp file?\n\0>; .even
  48: 1:
  49:         mov     r0,tfi
  50: 
  51:         mov     gsp,sp
  52:         cmp     (sp),$2  /is there a file argument
  53:         blt     noarg
  54:         mov     4(sp),r0
  55:         mov     $argname,r1
  56: 1:
  57:         movb    (r0)+,(r1)+
  58:         bne     1b
  59: aftered: / after edit
  60:         mov     $argname,r0
  61:         jsr     r5,fopen; iobuf
  62:         bes     1f
  63: noarg:
  64:         jsr     pc,isymtab
  65:         br      loop
  66: 1:
  67:         mov     $1f,r0
  68:         jsr     pc,print
  69:         br      loop
  70: 1:
  71:         <Cannot open file\n\0>; .even
  72: 
  73: intrup:
  74:         sys     signal; 2; intrup
  75:         mov     $'\n,r0
  76:         jsr     r5,xputc
  77:         jsr     r5,error
  78:                 <ready\n\0>; .even
  79: 
  80: loop:
  81:         mov     gsp,sp
  82:         clr     lineno
  83:         jsr     pc,rdline
  84:         mov     $line,r3
  85: 1:
  86:         movb    (r3),r0
  87:         jsr     pc,digit
  88:                 br 1f
  89:         jsr     r5,atoi
  90:         cmp     r0,$' /
  91:         beq     3f
  92:         cmp     r0,$'	 /tab
  93:         bne     1f
  94: 3:
  95:         mov     $lintab,r3
  96:         mov     r1,r0
  97:         bgt     2f
  98:         jsr     pc,serror
  99: 2:
 100:         cmp     r0,(r3)
 101:         beq     2f
 102:         tst     (r3)
 103:         beq     2f
 104:         add     $6,r3
 105:         br      2b
 106: 2:
 107:         cmp     r3,$elintab-12.
 108:         blo     2f
 109:         jsr     r5,error
 110:                 <too many lines\n\0>; .even
 111: 2:
 112:         mov     r0,(r3)+
 113:         mov     seeka,(r3)+
 114:         mov     tfo,r0
 115:         mov     seeka,seekx
 116:         sys     indir; sysseek
 117:         mov     $line,r0
 118:         jsr     pc,size
 119:         inc     r0
 120:         add     r0,seeka
 121:         mov     r0,wlen
 122:         mov     tfo,r0
 123:         mov     $line,wbuf
 124:         sys     indir;syswrit
 125:         br      loop
 126: 1:
 127:         mov     $line,r3
 128:         jsr     pc,singstat
 129:         br      loop
 130: 
 131: nextc:
 132:         movb    (r3)+,r0
 133:         rts     r5
 134: 
 135: size:
 136:         clr     -(sp)
 137: 1:
 138:         inc     (sp)
 139:         cmpb    (r0),$'\n
 140:         beq     1f
 141:         cmpb    (r0),$0
 142:         beq     1f
 143:         inc     r0
 144:         br      1b
 145: 1:
 146:         mov     (sp)+,r0
 147:         rts     pc
 148: 
 149: rdline:  / read input (file or tty) to carr. ret.
 150:         mov     $line,r1
 151: 1:
 152:         jsr     r5,getc; iobuf
 153:         bes     2f
 154:         tst     r0
 155:         beq     2f
 156:         cmp     r1,$line+99.
 157:         bhis    2f                      / bad check, but a check
 158:         movb    r0,(r1)+
 159:         cmpb    r0,$'\n
 160:         bne     1b
 161:         clrb    (r1)
 162:         rts     pc
 163: 2:
 164:         mov     fi,r0
 165:         beq     1f
 166:         sys     close
 167:         clr     fi
 168:         br      1b
 169: 1:
 170:         jmp     _done
 171: 
 172: error:
 173:         tst     fi
 174:         beq     1f
 175:         sys     close
 176:         clr     fi
 177: 1:
 178:         tst     lineno
 179:         beq     1f
 180:         jsr     pc,nextlin
 181:                 br 1f
 182:         mov     $line,r0
 183:         jsr     pc,print
 184: 1:
 185:         mov     r5,r0
 186:         jsr     pc,print
 187:         jmp     loop
 188: 
 189: serror:
 190:         dec     r3
 191:         tst     fi
 192:         beq     1f
 193:         sys     close
 194:         clr     fi
 195: 1:
 196:         mov     $line,r1
 197: 1:
 198:         cmp     r1,r3
 199:         bne     2f
 200:         mov     $'_,r0
 201:         jsr     r5,xputc
 202:         mov     $10,r0
 203:         jsr     r5,xputc
 204: 2:
 205:         movb    (r1),r0
 206:         jsr     r5,xputc
 207:         cmpb    (r1)+,$'\n
 208:         bne     1b
 209:         jmp     loop
 210: 
 211: print:
 212:         mov     r0,wbuf
 213:         jsr     pc,size
 214:         mov     r0,wlen
 215:         mov     prfile,r0
 216:         sys     indir; syswrit
 217:         rts     pc
 218: 
 219: digit:
 220:         cmp     r0,$'0
 221:         blo     1f
 222:         cmp     r0,$'9
 223:         bhi     1f
 224:         add     $2,(sp)
 225: 1:
 226:         rts     pc
 227: 
 228: alpha:
 229:         cmp     r0,$'a
 230:         blo     1f
 231:         cmp     r0,$'z
 232:         bhi     1f
 233:         add     $2,(sp)
 234: 1:
 235:         cmp     r0,$'A
 236:         blo     1f
 237:         cmp     r0,$'Z
 238:         bhi     1f
 239:         add     $2,(sp)
 240: 1:
 241:         rts     pc
 242: 
 243: name:
 244:         mov     $nameb,r1
 245:         clr     (r1)
 246:         clr     2(r1)
 247: 1:
 248:         cmp     r1,$nameb+4
 249:         bhis    2f
 250:         movb    r0,(r1)+
 251: 2:
 252:         movb    (r3)+,r0
 253:         jsr     pc,alpha
 254:                 br 2f
 255:         br      1b
 256: 2:
 257:         jsr     pc,digit
 258:                 br 2f
 259:         br      1b
 260: 2:
 261:         mov     $resnam,r1
 262: 1:
 263:         cmp     nameb,(r1)
 264:         bne     2f
 265:         cmp     nameb+2,2(r1)
 266:         bne     2f
 267:         sub     $resnam,r1
 268:         asr     r1
 269:         add     $2,(sp)
 270:         rts     pc
 271: 2:
 272:         add     $4,r1
 273:         cmp     r1,$eresnam
 274:         blo     1b
 275:         mov     $symtab,r1
 276: 1:
 277:         tst     (r1)
 278:         beq     1f
 279:         cmp     nameb,(r1)
 280:         bne     2f
 281:         cmp     nameb+2,2(r1)
 282:         bne     2f
 283:         rts     pc
 284: 2:
 285:         add     $14.,r1
 286:         br      1b
 287: 1:
 288:         cmp     r1,$esymtab-28.
 289:         blo     1f
 290:         jsr     r5,error
 291:                 <out of symbol space\n\0>; .even
 292: 1:
 293:         mov     nameb,(r1)
 294:         mov     nameb+2,2(r1)
 295:         clr     4(r1)
 296:         clr     14.(r1)
 297:         rts     pc
 298: 
 299: skip:
 300:         cmp     r0,$' /
 301:         beq     1f
 302:         cmp     r0,$'	  / tab
 303:         bne     2f
 304: 1:
 305:         movb    (r3)+,r0
 306:         br      skip
 307: 2:
 308:         rts     pc
 309: 
 310: xputc:
 311: .if scope  / for plotting
 312:         tstb    drflg
 313:         beq     1f
 314:         jsr     pc,drput
 315:         rts     r5
 316: 1:
 317: .endif
 318:         mov     r0,ch
 319:         mov     $1,r0
 320:         sys     write; ch; 1
 321:         rts     r5
 322: 
 323: nextlin:
 324:         clr     -(sp)
 325:         mov     $lintab,r1
 326: 1:
 327:         tst     (r1)
 328:         beq     1f
 329:         cmp     lineno,(r1)
 330:         bhi     2f
 331:         mov     (sp),r0
 332:         beq     3f
 333:         cmp     (r0),(r1)
 334:         blos    2f
 335: 3:
 336:         mov     r1,(sp)
 337: 2:
 338:         add     $6,r1
 339:         br      1b
 340: 1:
 341:         mov     (sp)+,r1
 342:         beq     1f
 343:         mov     (r1)+,lineno
 344:         mov     (r1)+,seekx
 345:         mov     tfi,r0
 346:         sys     indir; sysseek
 347:         mov     tfi,r0
 348:         sys     read; line; 100.
 349:         add     $2,(sp)
 350: 1:
 351:         rts     pc
 352: 
 353: getloc:
 354:         mov     $lintab,r1
 355: 1:
 356:         tst     (r1)
 357:         beq     1f
 358:         cmp     r0,(r1)
 359:         beq     2f
 360:         add     $6,r1
 361:         br      1b
 362: 1:
 363:         jsr     r5,error
 364:                 <label not found\n\0>; .even
 365: 2:
 366:         rts     pc
 367: 
 368: isymtab:
 369:         mov     $symtab,r0
 370:         mov     $symtnam,r1
 371:         clrf    fr0
 372:         movf    $one,fr1
 373: 1:
 374:         mov     (r1)+,(r0)+
 375:         mov     (r1)+,(r0)+
 376:         mov     $1,(r0)+
 377:         subf    r1,r0
 378:         movf    r0,(r0)+
 379:         cmp     r1,$esymtnam
 380:         blo     1b
 381:         clr     (r0)+
 382:         rts     pc
 383: 
 384: /
 385: /
 386: 
 387: / bas1 -- compile
 388: /
 389: /    convention:	jsr pc,subrout /test
 390: /				br failside
 391: /			succeed ...
 392: 
 393: compile:
 394:         clr     forp
 395:         mov     $iflev,ifp /added for if..else..fi
 396:         mov     $space,r4
 397:         tst     lineno
 398:         beq     1f
 399:         rts     pc
 400: 1:
 401:         jsr     pc,nextlin
 402:                 br 1f
 403:         mov     lineno,r0
 404:         jsr     pc,getloc
 405:         mov     r4,4(r1)
 406:         jsr     pc,statement
 407:                 br .+2
 408:         inc     lineno
 409:         cmp     r4,$espace+20  / out of code space?
 410:         blo     1b
 411:         jsr     r5,error
 412:                 <out of code space\n\0>; .even
 413: 1:
 414:         tst     forp
 415:         jne     forer
 416:         cmp     ifp,$iflev
 417:         jne     fier   /hanging if..fi
 418:         mov     $loop,(r4)+
 419:         rts     pc
 420: 
 421: singstat:
 422:         clr     forp
 423:         mov     $iflev,ifp
 424:         mov     $exline,r4
 425:         jsr     pc,statement
 426:                 br 1f
 427:         cmp     -2(r4),$_asgn
 428:         beq     1f
 429:         mov     $_print,(r4)+
 430:         mov     $_nline,(r4)+
 431: 1:
 432:         tst     forp
 433:         jne     forer
 434:         cmp     r4,$eexline
 435:         blo     1f
 436:         jsr     r5,error
 437:                 <out of code space\n\0>; .even
 438: 1:
 439:         mov     $loop,(r4)+
 440:         mov     r4,exprloc
 441:         mov     $exline,r4
 442:         jmp     execute
 443: 
 444: statement:
 445:         mov     $line,r3
 446:         movb    (r3)+,r0
 447:         jsr     pc,digit
 448:                 br stat1
 449:         dec     r3
 450:         jsr     r5,atoi
 451:         cmp     r0,$' /
 452:         beq     1f
 453:         cmp     r0,$'	 /tab
 454:         beq     1f
 455:         mov     $line,r3
 456:         movb    (r3)+,r0
 457:         br      stat1
 458: 1:
 459:         mov     $_line,(r4)+
 460:         mov     r1,(r4)+
 461: 
 462: stat1:
 463:         jsr     pc,skip
 464:         cmp     r0,$'\n
 465:         bne     .+4
 466:         rts     pc
 467:         mov     r3,-(sp)
 468:         jsr     pc,alpha
 469:                 br 1f
 470:         jsr     pc,name
 471:                 br 1f
 472:         tst     (sp)+
 473:         jsr     pc,skip
 474:         dec     r3
 475:         jmp     *2f(r1)
 476: 2:
 477:         stlist
 478:         stdone
 479:         stdone
 480:         strun
 481:         stprint
 482:         stprompt   / prompt is like print except for cr
 483:         stif
 484:         stgoto
 485:         streturn
 486:         stfor
 487:         stnext
 488:         stoctl
 489:         stsave
 490:         stdump
 491:         stfi
 492:         stelse
 493:         stedit
 494:         stcomment
 495: .if scope    / for plotting on tektronix
 496:         stdisp
 497:         stdraw
 498:         steras
 499: .endif
 500: 
 501: 1:
 502:         mov     (sp)+,r3
 503:         dec     r3
 504:         jsr     pc,expr
 505:         cmp     r0,$'\n
 506:         jne     joe
 507:         add     $2,(sp)
 508:         rts     pc
 509: 
 510: stsave:
 511:         mov     $_save,func
 512:         br      1f
 513: 
 514: stlist:
 515:         mov     $_list,func
 516: 1:
 517:         cmp     r0,$'\n
 518:         bne     1f
 519:         clrf    r0
 520:         jsr     pc,const
 521:         movif   $77777,r0
 522:         jsr     pc,const
 523:         br      2f
 524: 1:
 525:         jsr     pc,expr
 526:         cmp     r0,$'\n
 527:         bne     1f
 528:         mov     $_dup,(r4)+
 529:         br      2f
 530: 1:
 531:         dec     r3
 532:         jsr     pc,expr
 533:         cmp     r0,$'\n
 534:         jne     joe
 535: 2:
 536:         mov     func,(r4)+
 537:         rts     pc
 538: 
 539: stdone:
 540:         cmp     r0,$'\n
 541:         jne     joe
 542:         mov     $_done,(r4)+
 543:         rts     pc
 544: 
 545: strun:
 546:         cmp     r0,$'\n
 547:         jne     joe
 548:         mov     $_run,(r4)+
 549:         rts     pc
 550: 
 551: 
 552: stprompt:
 553:         clr     -(sp)
 554:         br      stpr2
 555: 
 556: stdump:
 557:         cmp     r0,$'\n
 558:         jne     joe
 559:         mov     $_dump,(r4)+
 560:         rts     pc
 561: 
 562: stprint:
 563:         mov     pc,-(sp)
 564: stpr2:
 565:         movb    (r3)+,r0
 566:         jsr     pc,skip
 567: 1:
 568:         cmp     r0,$'\n
 569:         beq     2f
 570:         cmp     r0,$'"
 571:         beq     1f
 572:         dec     r3
 573:         jsr     pc,expr
 574:         mov     $_print,(r4)+
 575:         br      1b
 576: 1:
 577:         mov     $_ascii,(r4)+
 578: 1:
 579:         movb    (r3)+,(r4)
 580:         cmpb    (r4),$'"
 581:         beq     1f
 582:         cmpb    (r4)+,$'\n
 583:         bne     1b
 584:         jbr     joe
 585: 1:
 586:         add     $2,r4
 587:         bic     $1,r4
 588:         br      stpr2
 589: 2:
 590:         tst     (sp)+
 591:         beq     1f
 592:         mov     $_nline,(r4)+
 593: 1:
 594:         rts     pc
 595: 
 596: stif:
 597:         jsr     pc,expr
 598:         mov     $_if,(r4)+
 599:         mov     r4,*ifp
 600:         add     $2,ifp
 601:         tst     (r4)+
 602:         jsr     pc,skip
 603:         cmp     r0,$'\n   / if ... fi
 604:         beq     1f
 605:         jsr     pc,stat1
 606:                 br  .+2
 607: stfi:
 608:         sub     $2,ifp
 609:         cmp     ifp,$iflev
 610:         jlo     fier
 611:         mov     *ifp,r1  /for jump around if
 612:         mov     r4,(r1)
 613: 1:
 614:         rts     pc
 615: 
 616: fier:
 617:         jsr     r5,error; <if...else...fi imbalance\n\0>; .even
 618: 
 619: stelse:
 620:         mov     $_tra,(r4)+  /jump around else side
 621:         mov     r4+,-(sp) / save hole
 622:         tst     (r4)+
 623:         sub     $2,ifp
 624:         cmp     ifp,$iflev
 625:         jlo     fier
 626:         mov     *ifp,r1
 627:         mov     r4,(r1)  /fill in jump to else
 628:         mov     (sp)+,*ifp /save hole for fi
 629:         add     $2,ifp
 630:         rts     pc
 631: 
 632: stedit:  / enter the regular editor <ed>
 633:         sys fork
 634:         br      newpr
 635:         mov     $lintab,r0  / zero out line table during edit
 636: 1:
 637:         cmp     r0,$elintab  /done
 638:         beq     1f
 639:         mov     $0,(r0)+
 640:         br      1b
 641: 1:
 642:         sys     unlink; tmpf
 643:         sys     wait
 644:         jmp     aftered / start over
 645: newpr:
 646:         sys     exec; ed; edarg
 647:         sys     exit
 648: ed:     </bin/ed\0> ; .even
 649: ednm:   <-\n>
 650:  .even
 651: edarg:  ednm; argname; 0
 652: 
 653: stcomment:  /comment line
 654:         cmp     r0,$'\n
 655:         beq     1f
 656:         movb    (r3)+,r0
 657:         br      stcomment
 658: 1:
 659:         rts     pc
 660: stgoto:
 661:         jsr     pc,expr
 662:         mov     $_goto,(r4)+
 663:         rts     pc
 664: 
 665: streturn:
 666:         cmp     r0,$'\n
 667:         beq     1f
 668:         jsr     pc,expr
 669:         cmp     r0,$'\n
 670:         bne     joe
 671:         br      2f
 672: 1:
 673:         clrf    r0
 674:         jsr     pc,const
 675: 2:
 676:         mov     $_return,(r4)+
 677:         rts     pc
 678: 
 679: joe:
 680:         jsr     pc,serror
 681: 
 682: stfor:
 683:         mov     r4,-(sp)
 684:         jsr     pc,e2
 685:         mov     r4,-(sp)
 686:         cmp     r0,$'=
 687:         bne     joe
 688:         tst     val
 689:         bne     joe
 690:         jsr     pc,expr
 691:         mov     forp,(r4)+      / overlay w _asgn
 692:         mov     r4,forp
 693:         cmp     (r4)+,(r4)+     / _tra ..
 694:         mov     (sp)+,r0
 695:         mov     (sp)+,r1
 696: 1:
 697:         mov     (r1)+,(r4)+
 698:         cmp     r1,r0
 699:         blo     1b
 700:         mov     $_fori,(r4)+
 701:         mov     forp,r1
 702:         mov     $_tra,(r1)+
 703:         mov     r4,(r1)+
 704:         dec     r3
 705:         jsr     pc,expr
 706:         mov     $_lesseq,(r4)+
 707:         mov     $_if,(r4)+
 708:         mov     forp,(r4)+
 709:         mov     r4,forp
 710:         cmp     r0,$'\n
 711:         beq     1f
 712:         jsr     pc,stat1
 713:                 br .+2
 714:         br      stnext
 715: 1:
 716:         rts     pc
 717: 
 718: forer:
 719:         jsr     r5,error; <for/next imbalance\n\0>; .even
 720: 
 721: stnext:
 722:         mov     forp,r1
 723:         beq     forer
 724:         mov     -(r1),r0
 725:         mov     -(r0),forp
 726:         mov     $_ptra,(r4)+
 727:         mov     $_asgn,(r0)+
 728:         cmp     (r0)+,(r0)+
 729:         mov     r0,(r4)+
 730:         mov     r4,(r1)+
 731:         rts     pc
 732: 
 733: stoctl:
 734:         jsr     pc,expr
 735:         mov     $_octal,(r4)+
 736:         rts     pc
 737: 
 738: .if scope  / for plotting
 739: stdisp:
 740:         mov     $_sdisp,(r4)+
 741:         jsr     pc,stprint
 742:         mov     $_fdisp,(r4)+
 743:         rts     pc
 744: stdraw:
 745:         jsr     pc,expr
 746:         dec     r3
 747:         jsr     pc,expr
 748:         cmp     r0,$'\n
 749:         bne     1f
 750:         movf    $one,r0
 751:         jsr     pc,const
 752:         br      2f
 753: 1:
 754:         dec     r3
 755:         jsr     pc,expr
 756: 2:
 757:         mov     $_draw,(r4)+
 758:         rts     pc
 759: 
 760: steras:
 761:         mov     $_erase,(r4)+
 762:         rts     pc
 763: .endif
 764: 
 765: /
 766: /
 767: 
 768: / bas2 -- expression evaluation
 769: 
 770: expr:
 771:         jsr     pc,e1
 772:         jsr     pc,rval
 773:         rts     pc
 774: 
 775: / assignment right to left
 776: e1:
 777:         jsr     pc,e2
 778:         cmp     r0,$'=
 779:         beq     1f
 780:         jsr     pc,rval
 781:         rts     pc
 782: 1:
 783:         tst     val
 784:         beq     1f
 785:         jsr     pc,serror
 786: 1:
 787:         jsr     pc,e1
 788:         jsr     r5,op; _asgn
 789:         rts     pc
 790: 
 791: / and or left to right
 792: e2:
 793:         jsr     pc,e3
 794: 1:
 795:         cmp     r0,$'&
 796:         beq     2f
 797:         cmp     r0,$'|
 798:         beq     3f
 799:         rts     pc
 800: 2:
 801:         jsr     pc,rval
 802:         jsr     pc,e3
 803:         jsr     r5,op; _and
 804:         br      1b
 805: 3:
 806:         jsr     pc,rval
 807:         jsr     pc,e3
 808:         jsr     r5,op; _or
 809:         br      1b
 810: 
 811: / relation extended relation
 812: e3:
 813:         jsr     pc,e4
 814:         jsr     pc,e3a
 815:                 rts pc
 816:         clr     -(sp)
 817: 1:
 818:         mov     r0,-(sp)
 819:         jsr     pc,e4
 820:         jsr     pc,rval
 821:         mov     (sp)+,(r4)+
 822:         jsr     pc,e3a
 823:                 br 1f
 824:         mov     $_extr,(r4)+
 825:         inc     (sp)
 826:         br      1b
 827: 1:
 828:         dec     (sp)
 829:         blt     1f
 830:         mov     $_and,(r4)+
 831:         br      1b
 832: 1:
 833:         tst     (sp)+
 834:         rts     pc
 835: 
 836: / relational operator
 837: e3a:
 838:         cmp     r0,$'>
 839:         beq     1f
 840:         cmp     r0,$'<
 841:         beq     2f
 842:         cmp     r0,$'=
 843:         beq     3f
 844:         rts     pc
 845: 1:
 846:         mov     $_great,r0
 847:         cmpb    (r3),$'=
 848:         bne     1f
 849:         inc     r3
 850:         mov     $_greateq,r0
 851:         br      1f
 852: 2:
 853:         cmpb    (r3),$'>
 854:         bne     2f
 855:         inc     r3
 856:         mov     $_noteq,r0
 857:         br      1f
 858: 2:
 859:         mov     $_less,r0
 860:         cmpb    (r3),$'=
 861:         bne     1f
 862:         inc     r3
 863:         mov     $_lesseq,r0
 864:         br      1f
 865: 3:
 866:         cmpb    (r3),$'=
 867:         beq     2f
 868:         rts     pc
 869: 2:
 870:         inc     r3
 871:         mov     $_equal,r0
 872: 1:
 873:         jsr     pc,rval
 874:         add     $2,(sp)
 875:         rts     pc
 876: 
 877: / add subtract
 878: e4:
 879:         jsr     pc,e5
 880: 1:
 881:         cmp     r0,$'+
 882:         beq     2f
 883:         cmp     r0,$'-
 884:         beq     3f
 885:         rts     pc
 886: 2:
 887:         jsr     pc,rval
 888:         jsr     pc,e5
 889:         jsr     r5,op; _add
 890:         br      1b
 891: 3:
 892:         jsr     pc,rval
 893:         jsr     pc,e5
 894:         jsr     r5,op; _sub
 895:         br      1b
 896: 
 897: / multiply divide
 898: e5:
 899:         jsr     pc,e6
 900: 1:
 901:         cmp     r0,$'*
 902:         beq     2f
 903:         cmp     r0,$'/
 904:         beq     3f
 905:         rts     pc
 906: 2:
 907:         jsr     pc,rval
 908:         jsr     pc,e6
 909:         jsr     r5,op; _mult
 910:         br      1b
 911: 3:
 912:         jsr     pc,rval
 913:         jsr     pc,e6
 914:         jsr     r5,op; _divid
 915:         br      1b
 916: 
 917: / exponential
 918: e6:
 919:         jsr     pc,e6a
 920: 1:
 921:         cmp     r0,$'^
 922:         beq     2f
 923:         rts     pc
 924: 2:
 925:         jsr     pc,rval
 926:         jsr     pc,e6a
 927:         jsr     r5,op; _expon
 928:         br      1b
 929: 
 930: e6a:
 931:         movb    (r3)+,r0
 932:         jsr     pc,skip
 933:         cmp     r0,$'_
 934:         bne     1f
 935:         jsr     pc,e6a
 936:         jsr     r5,op; _neg
 937:         rts     pc
 938: 1:
 939:         dec     r3
 940:         jsr     pc,e7
 941:         rts     pc
 942: / end of unary -
 943: 
 944: / primary
 945: e7:
 946:         movb    (r3)+,r0
 947:         jsr     pc,skip
 948:         mov     $1,val
 949:         cmp     r0,$'(
 950:         bne     1f
 951:         jsr     pc,e1
 952:         cmp     r0,$')
 953:         bne     2f
 954:         movb    (r3)+,r0
 955:         br      e7a
 956: 2:
 957:         jsr     pc,serror
 958: 1:
 959:         cmp     r0,$'.
 960:         beq     2f
 961:         jsr     pc,digit
 962:                 br 1f
 963: 2:
 964:         dec     r3
 965:         jsr     r5,atof; nextc
 966:         jsr     pc,const
 967:         br      e7a
 968: 1:
 969:         jsr     pc,alpha
 970:                 br jim
 971:         jsr     pc,name
 972:                 br 2f
 973:         jsr     r5,error; <reserved name\n\0>; .even
 974: 2:
 975: / try to fix illegal symbol bug:
 976:         cmp     r4,$eexline
 977:         bhis    jim
 978: 
 979:         mov     $_lval,(r4)+
 980:         mov     r1,(r4)+
 981:         clr     val
 982:         br      e7a
 983: jim:
 984:         jsr     pc,serror
 985: 
 986: e7a:
 987:         jsr     pc,skip
 988:         cmp     r0,$'(
 989:         bne     1f
 990:         jsr     pc,rval
 991:         jsr     r5,rlist; _funct
 992:         cmp     r0,$')
 993:         bne     jim
 994:         movb    (r3)+,r0
 995:         br      e7a
 996: 1:
 997:         cmp     r0,$'[
 998:         bne     1f
 999:         tst     val
1000:         beq     2f
1001:         jsr     pc,serror
1002: 2:
1003:         jsr     r5,rlist; _subscr
1004:         clr     val
1005:         cmp     r0,$']
1006:         bne     jim
1007:         movb    (r3)+,r0
1008:         br      e7a
1009: 1:
1010:         rts     pc
1011: 
1012: op:
1013:         jsr     pc,rval
1014:         mov     (r5)+,(r4)+
1015:         rts     r5
1016: 
1017: rval:
1018:         tst     val
1019:         bne     1f
1020:         mov     $_rval,(r4)+
1021:         inc     val
1022: 1:
1023:         rts     pc
1024: 
1025: const:
1026:         mov     r0,-(sp)
1027:         movf    r1,-(sp)
1028:         tstf    r0
1029:         cfcc
1030:         bne     1f
1031:         mov     $_con0,(r4)+
1032:         br      2f
1033: 1:
1034:         cmpf    $one,r0
1035:         cfcc
1036:         bne     1f
1037:         mov     $_con1,(r4)+
1038:         br      2f
1039: 1:
1040:         movfi   r0,r0
1041:         movif   r0,r1
1042:         cmpf    r0,r1
1043:         cfcc
1044:         bne     1f
1045:         mov     $_intcon,(r4)+
1046:         mov     r0,(r4)+
1047:         br      2f
1048: 1:
1049:         mov     $_const,(r4)+
1050:         movf    r0,(r4)+
1051: 2:
1052:         movf    (sp)+,r1
1053:         mov     (sp)+,r0
1054:         rts     pc
1055: 
1056: rlist:
1057:         clr     -(sp)
1058:         cmpb    (r3),$')
1059:         bne     1f
1060:         movb    (r3)+,r0
1061:         br      2f
1062: 1:
1063:         inc     (sp)
1064:         jsr     pc,expr
1065:         cmp     r0,$',
1066:         beq     1b
1067: 2:
1068:         mov     (r5)+,(r4)+
1069:         mov     (sp)+,(r4)+
1070:         rts     r5
1071: 
1072: /
1073: /
1074: / bas3 -- execution
1075: 
1076: execute:
1077:         mov     $estack,r3
1078:         mov     r3,sstack
1079:         jmp     *(r4)+
1080: 
1081: _if:
1082:         tstf    (r3)+
1083:         cfcc
1084:         beq     _tra
1085:         tst     (r4)+
1086:         jmp     *(r4)+
1087: 
1088: _ptra:
1089:         mov     sstack,r3
1090: 
1091: _tra:
1092:         mov     (r4)+,r4
1093:         jmp     *(r4)+
1094: 
1095: _funct:
1096:         mov     r4,-(r3)
1097:         mov     sstack,-(r3)
1098:         mov     r3,sstack
1099:         inc     sublev
1100:         clr     r0
1101:         jsr     pc,arg
1102:         tstf    r0
1103:         cfcc
1104:         bge     1f
1105:         jmp     builtin
1106: 
1107: _goto:
1108:         movf    (r3),r0
1109: 1:
1110:         movfi   r0,-(sp)
1111:         jsr     pc,compile
1112:         mov     (sp)+,r0
1113:         jsr     pc,getloc
1114:         mov     4(r1),r4
1115:         jmp     *(r4)+
1116: 
1117: _run:
1118:         jsr     pc,isymtab
1119:         mov     randx,r0
1120:         jsr     pc,srand
1121:         jsr     pc,compile
1122:         mov     $space,r4
1123:         jmp     *(r4)+
1124: 
1125: _save:    / _save is a _list to the file named on the bas command
1126:         sys     creat; argname; 666
1127:         bes     1f
1128:         mov     r0,prfile
1129:         br      2f
1130: 1:
1131:         mov     1f,r0
1132:         mov     $1,prfile
1133:         jsr     pc,print
1134:         br      _done
1135: 1:      <Cannot create b.out\n\0>; .even
1136: 
1137: _list:
1138:         mov     $1,prfile
1139: 2:
1140:         movf    (r3)+,r0
1141:         movfi   r0,-(sp)
1142: / probably vistigal?? 	mov	r3,0f
1143:         movf    (r3),r0
1144:         movfi   r0,lineno
1145: 1:
1146:         jsr     pc,nextlin
1147:                 br 1f
1148:         cmp     lineno,(sp)
1149:         bhi     1f
1150:         mov     $line,r0
1151:         jsr     pc,print
1152:         inc     lineno
1153:         br      1b
1154: 1:
1155:         cmp     $1,prfile
1156:         beq     1f
1157:         mov     prfile,r0
1158:         sys     close
1159:         mov     $1,prfile
1160: 1:
1161:         tst     (sp)+
1162:         jmp     *(r4)+
1163: 
1164: _done:
1165:         sys     unlink; tmpf
1166:         sys     exit
1167: 
1168: .if scope  / for plotting
1169: _sdisp:
1170:         mov     $2,r0
1171:         jsr     pc,drput
1172:         jsr     pc,drxy
1173:         mov     $1,r0
1174:         jsr     pc,drput
1175:         mov     $3,r0
1176:         jsr     pc,drput
1177:         incb    drflg
1178:         jmp     *(r4)+
1179: 
1180: _fdisp:
1181:         clr     r0
1182:         jsr     pc,drput
1183:         clrb    drflg
1184:         jmp     *(r4)+
1185: 
1186: _draw:
1187:         movf    (r3)+,r2
1188:         movf    (r3)+,r1
1189:         movf    (r3)+,r0
1190:         jsr     r5,draw
1191:         jmp     *(r4)+
1192: 
1193: _erase:
1194:         mov     $1,r0
1195:         jsr     pc,drput
1196:         mov     $1,r0
1197:         jsr     pc,drput
1198:         jmp     *(r4)+
1199: .endif
1200: 
1201: _print:
1202:         movf    (r3)+,r0
1203:         jsr     r5,ftoa; xputc
1204:         jmp     *(r4)+
1205: 
1206: _octal:
1207:         movf    (r3)+,r0
1208:         jsr     r5,ftoo; xputc
1209:         jmp     *(r4)+
1210: 
1211: _nline:
1212:         mov     $'\n,r0
1213:         jsr     r5,xputc
1214:         jmp     *(r4)+
1215: 
1216: _ascii:
1217:         movb    (r4)+,r0
1218:         cmp     r0,$'"
1219:         beq     1f
1220:         jsr     r5,xputc
1221:         br      _ascii
1222: 1:
1223:         inc     r4
1224:         bic     $1,r4
1225:         jmp     *(r4)+
1226: 
1227: _line:
1228:         mov     sstack,r3
1229:         cmp     r3,$stack+20.
1230:         bhi     1f
1231:         jsr     r5,error
1232:                 <out of space\n\0>; .even
1233: 1:
1234:         mov     (r4)+,lineno
1235:         jmp     *(r4)+
1236: 
1237: _or:
1238:         tstf    (r3)+
1239:         cfcc
1240:         bne     stone
1241:         tstf    (r3)
1242:         cfcc
1243:         bne     stone
1244:         br      stzero
1245: 
1246: _and:
1247:         tstf    (r3)+
1248:         cfcc
1249:         beq     stzero
1250:         tstf    (r3)
1251:         cfcc
1252:         beq     stzero
1253:         br      stone
1254: 
1255: _great:
1256:         jsr     pc,bool
1257:         bgt     stone
1258:         br      stzero
1259: 
1260: _greateq:
1261:         jsr     pc,bool
1262:         bge     stone
1263:         br      stzero
1264: 
1265: _less:
1266:         jsr     pc,bool
1267:         blt     stone
1268:         br      stzero
1269: 
1270: _lesseq:
1271:         jsr     pc,bool
1272:         ble     stone
1273:         br      stzero
1274: 
1275: _noteq:
1276:         jsr     pc,bool
1277:         bne     stone
1278:         br      stzero
1279: 
1280: _equal:
1281:         jsr     pc,bool
1282:         beq     stone
1283: 
1284: stzero:
1285:         clrf    r0
1286:         br      advanc
1287: 
1288: stone:
1289:         movf    $one,r0
1290:         br      advanc
1291: 
1292: _extr:
1293:         movf    r1,r0           / dup for _and in extended rel
1294:         br      subadv
1295: 
1296: _asgn:
1297:         movf    (r3)+,r0
1298:         mov     (r3)+,r0
1299:         add     $4,r0
1300:         bis     $1,(r0)+
1301:         movf    r0,(r0)
1302:         br      subadv
1303: 
1304: _add:
1305:         movf    (r3)+,r0
1306:         addf    (r3),r0
1307:         br      advanc
1308: 
1309: _sub:
1310:         movf    (r3)+,r0
1311:         negf    r0
1312:         addf    (r3),r0
1313:         br      advanc
1314: 
1315: _mult:
1316:         movf    (r3)+,r0
1317:         mulf    (r3),r0
1318:         br      advanc
1319: 
1320: _divid:
1321:         movf    (r3)+,r1
1322:         movf    (r3),r0
1323:         divf    r1,r0
1324:         br      advanc
1325: 
1326: _expon:
1327:         movf    (r3)+,fr1
1328:         movf    (r3),fr0
1329:         jsr     pc,pow
1330:         bec     advanc
1331:         jsr     r5,error
1332:                 <Bad exponentiation\n\0>; .even
1333: 
1334: _neg:  / unary -
1335:         negf    r0
1336:         jbr     advanc
1337: / end of _neg
1338: 
1339: _intcon:
1340:         movif   (r4)+,r0
1341:         jbr     subadv
1342: 
1343: _con0:
1344:         clrf    r0
1345:         jbr     subadv
1346: 
1347: _con1:
1348:         movf    $one,r0
1349:         jbr     subadv
1350: 
1351: _const:
1352:         movf    (r4)+,r0
1353: 
1354: subadv:
1355:         movf    r0,-(r3)
1356:         jmp     *(r4)+
1357: 
1358: advanc:
1359:         movf    r0,(r3)
1360:         jmp     *(r4)+
1361: 
1362: _rval:
1363:         jsr     pc,getlv
1364:         br      subadv
1365: 
1366: _fori:
1367:         jsr     pc,getlv
1368:         addf    $one,r0
1369:         movf    r0,(r0)
1370:         br      subadv
1371: 
1372: _lval:
1373:         mov     (r4)+,-(r3)
1374:         jmp     *(r4)+
1375: 
1376: _dup:
1377:         movf    (r3),r0
1378:         br      subadv
1379: 
1380: _return:
1381:         dec     sublev
1382:         bge     1f
1383:         jsr     r5,error
1384:                 <bad return\n\0>; .even
1385: 1:
1386:         movf    (r3),r0
1387:         mov     sstack,r3
1388:         mov     (r3)+,sstack
1389:         mov     (r3)+,r4
1390:         mov     (r4)+,r0
1391: 1:
1392:         dec     r0
1393:         blt     advanc
1394:         add     $8,r3
1395:         br      1b
1396: 
1397: _subscr:
1398:         mov     (r4),r1
1399:         mpy     $8.,r1
1400:         add     r1,r3
1401:         mov     r3,-(sp)
1402:         mov     (r3),r0
1403:         mov     (r4)+,-(sp)
1404: 1:
1405:         dec     (sp)
1406:         blt     1f
1407:         movf    -(r3),r0
1408:         movfi   r0,r2
1409:         com     r2
1410:         blt     2f
1411:         jsr     r5,error
1412:                 <subscript out of range\n\0>; .even
1413: 2:
1414:         mov     r0,r1
1415:         mov     4(r0),r0
1416:         bic     $1,r0
1417: 2:
1418:         beq     2f
1419:         cmp     r2,(r0)+
1420:         bne     3f
1421:         tst     -(r0)
1422:         br      1b
1423: 3:
1424:         mov     (r0),r0
1425:         br      2b
1426: 2:
1427:         mov     $symtab,r0
1428: 2:
1429:         tst     (r0)
1430:         beq     2f
1431:         add     $14.,r0
1432:         br      2b
1433: 2:
1434:         cmp     r0,$esymtab-28.
1435:         blo     2f
1436:         jsr     r5,error
1437:                 <out of symbol space\n\0>; .even
1438: 2:
1439:         cmp     (r1)+,(r1)+
1440:         mov     r0,-(sp)
1441:         clr     14.(r0)
1442:         mov     r2,(r0)+
1443:         mov     (r1),r2
1444:         bic     $1,r2
1445:         mov     r2,(r0)+
1446:         clr     (r0)+
1447:         mov     (sp)+,r0
1448:         bic     $!1,(r1)
1449:         bis     r0,(r1)
1450:         br      1b
1451: 1:
1452:         tst     (sp)+
1453:         mov     (sp)+,r3
1454:         mov     r0,(r3)
1455:         jmp     *(r4)+
1456: 
1457: bool:
1458:         movf    (r3)+,r1        / r1 used in extended rel
1459:         cmpf    (r3),r1
1460:         cfcc
1461:         rts     pc
1462: 
1463: getlv:
1464:         mov     (r3)+,r0
1465:         add     $4,r0
1466:         bit     $1,(r0)+
1467:         bne     1f
1468:         jsr     r5,error;<used before set\n\0>; .even
1469: 1:
1470:         movf    (r0),r0
1471:         rts     pc
1472: 
1473: /
1474: /
1475: 
1476: / bas4 -- builtin functions
1477: 
1478: builtin:
1479:         dec     sublev
1480:         mov     (r3)+,sstack
1481:         mov     (r3)+,r4
1482:         movfi   r0,r0
1483:         com     r0
1484:         asl     r0
1485:         cmp     r0,$2f-1f
1486:         bhis    2f
1487:         jmp     *1f(r0)
1488: 1:
1489:         fnarg
1490:         fnexp
1491:         fnlog
1492:         fnsin
1493:         fncos
1494:         fnatan
1495:         fnrand
1496:         fnexpr
1497:         fnint
1498:         fnabs
1499:         fnsqr
1500: 2:
1501:         mov     $-1,r0
1502:         jsr     pc,getloc               / label not found diagnostic
1503: 
1504: fnarg:
1505:         cmp     (r4)+,$1
1506:         bne     narg
1507:         movf    (r3),r0
1508:         movfi   r0,r0
1509:         jsr     pc,arg
1510:         br      fnadvanc
1511: 
1512: fnexp:
1513:         jsr     r5,fnfn; exp
1514:         br      fnadvanc
1515: 
1516: fnlog:
1517:         jsr     r5,fnfn; log
1518:         bec     fnadvanc
1519:         jsr     r5,error
1520:                 <Bad log\n\0>; .even
1521: 
1522: fnsin:
1523:         jsr     r5,fnfn; sin
1524:         bec     fnadvanc
1525:         jsr     r5,error
1526:                 <Bad sine\n\0>; .even
1527: 
1528: fncos:
1529:         jsr     r5,fnfn; cos
1530:         bec     fnadvanc
1531:         jsr     r5,error
1532:                 <Bad cosine\n\0>; .even
1533: 
1534: fnatan:
1535:         jsr     r5,fnfn; atan
1536:         bec     fnadvanc
1537:         jsr     r5,error
1538:                 <Bad arctangent\n\0>; .even
1539: 
1540: fnrand:
1541:         tst     (r4)+
1542:         bne     narg
1543:         jsr     pc,rand
1544:         movif   r0,r0
1545:         divf    $44000,r0
1546:         jmp     advanc
1547: 
1548: fnexpr:
1549:         tst     (r4)+
1550:         bne     narg
1551:         mov     r3,-(sp)
1552:         mov     r4,-(sp)
1553:         jsr     pc,rdline
1554:         mov     exprloc,r4
1555:         mov     $line,r3
1556:         jsr     pc,expr
1557:         mov     $_tra,(r4)+
1558:         mov     (sp)+,(r4)+
1559:         mov     (sp)+,r3
1560:         mov     exprloc,r4
1561:         add     $8,r3
1562:         jmp     *(r4)+
1563: 
1564: fnint:
1565:         cmp     (r4)+,$1
1566:         bne     narg
1567:         movf    (r3),r0
1568:         modf    $one,r0
1569:         movf    r1,r0
1570:         br      fnadvanc
1571: 
1572: fnabs:
1573:         cmp     (r4)+,$1
1574:         bne     narg
1575:         movf    (r3),r0
1576:         cfcc
1577:         bge     fnadvanc
1578:         negf    r0
1579:         br      fnadvanc
1580: 
1581: fnsqr:
1582:         jsr     r5,fnfn; sqrt
1583:         bec     fnadvanc
1584:         jsr     r5,error
1585:         <Bad square root arg\n\0>; .even
1586: fnadvanc:
1587:         add     $8,r3
1588:         jmp     advanc
1589: 
1590: narg:
1591:         jsr     r5,error
1592:                 <arg count\n\0>; .even
1593: 
1594: arg:
1595:         tst     sublev
1596:         beq     1f
1597:         mov     sstack,r1
1598:         sub     *2(r1),r0
1599:         bhi     1f
1600: 2:
1601:         inc     r0
1602:         bgt     2f
1603:         add     $8,r1
1604:         br      2b
1605: 2:
1606:         movf    4(r1),r0
1607:         rts     pc
1608: 1:
1609:         jsr     r5,error
1610:                 <bad arg\n\0>; .even
1611: 
1612: fnfn:
1613:         cmp     (r4)+,$1
1614:         bne     narg
1615:         movf    (r3),r0
1616:         jsr     pc,*(r5)+
1617:         rts     r5
1618: 
1619: .if scope / for plotting
1620: draw:
1621:         tstf    r2
1622:         cfcc
1623:         bne     1f
1624:         movf    r0,drx
1625:         movf    r1,dry
1626:         rts     r5
1627: 1:
1628:         movf    r0,-(sp)
1629:         movf    r1,-(sp)
1630:         mov     $3,r0
1631:         jsr     pc,drput
1632:         jsr     pc,drxy
1633:         movf    (sp)+,r0
1634:         movf    r0,dry
1635:         movf    (sp)+,r0
1636:         movf    r0,drx
1637:         jsr     pc,drxy
1638:         rts     r5
1639: 
1640: drxy:
1641:         movf    drx,r0
1642:         jsr     pc,drco
1643:         movf    dry,r0
1644: 
1645: drco:
1646:         tstf    r0
1647:         cfcc
1648:         bge     1f
1649:         clrf    r0
1650: 1:
1651:         cmpf    $40200,r0               / 1.0
1652:         cfcc
1653:         bgt     1f
1654:         movf    $40177,r0               / 1.0-eps
1655: 1:
1656:         subf    $40000,r0               / .5
1657:         mulf    $43200,r0               / 4096
1658:         movfi   r0,r0
1659:         mov     r0,-(sp)
1660:         jsr     pc,drput
1661:         mov     (sp)+,r0
1662:         swab    r0
1663: 
1664: drput:
1665:         movb    r0,ch
1666:         mov     drfo,r0
1667:         bne     1f
1668:         sys     open; vt; 1
1669:         bec     2f
1670:         4
1671: 2:
1672:         mov     r0,drfo
1673: 1:
1674:         sys     write; ch; 1
1675:         rts     pc
1676: 
1677: .endif
1678: / bas4 -- old library routines
1679: atoi:
1680:         clr     r1
1681:         jsr     r5,nextc
1682:         clr     -(sp)
1683:         cmp     r0,$'-
1684:         bne     2f
1685:         inc     (sp)
1686: 1:
1687:         jsr     r5,nextc
1688: 2:
1689:         sub     $'0,r0
1690:         cmp     r0,$9
1691:         bhi     1f
1692:         mpy     $10.,r1
1693:         bcs     3f / >32k
1694:         add     r0,r1
1695:         bcs     3f / >32k
1696:         br      1b
1697: 1:
1698:         add     $'0,r0
1699:         tst     (sp)+
1700:         beq     1f
1701:         neg     r1
1702: 1:
1703:         rts     r5
1704: 3:
1705:         tst     (sp)+
1706:         mov     $'.,r0  / faking overflow
1707:         br      1b
1708: 
1709: ldfps = 170100^tst
1710: stfps = 170200^tst
1711: atof:
1712:         stfps   -(sp)
1713:         ldfps   $200
1714:         movf    fr1,-(sp)
1715:         mov     r1,-(sp)
1716:         mov     r2,-(sp)
1717:         clr     -(sp)
1718:         clrf    fr0
1719:         clr     r2
1720:         jsr     r5,*(r5)
1721:         cmpb    r0,$'-
1722:         bne     2f
1723:         inc     (sp)
1724: 1:
1725:         jsr     r5,*(r5)
1726: 2:
1727:         sub     $'0,r0
1728:         cmp     r0,$9.
1729:         bhi     2f
1730:         jsr     pc,dig
1731:                 br      1b
1732:         inc     r2
1733:         br      1b
1734: 2:
1735:         cmpb    r0,$'.-'0
1736:         bne     2f
1737: 1:
1738:         jsr     r5,*(r5)
1739:         sub     $'0,r0
1740:         cmp     r0,$9.
1741:         bhi     2f
1742:         jsr     pc,dig
1743:                 dec r2
1744:         br      1b
1745: 2:
1746:         cmpb    r0,$'e-'0
1747:         bne     1f
1748:         jsr     r5,atoi
1749:         sub     $'0,r0
1750:         add     r1,r2
1751: 1:
1752:         movf    $one,fr1
1753:         mov     r2,-(sp)
1754:         beq     2f
1755:         bgt     1f
1756:         neg     r2
1757: 1:
1758:         cmp     r2,$38.
1759:         blos    1f
1760:         clrf    fr0
1761:         tst     (sp)+
1762:         bmi     out
1763:         movf    $huge,fr0
1764:         br      out
1765: 1:
1766:         mulf    $ten,fr1
1767:         sob     r2,1b
1768: 2:
1769:         tst     (sp)+
1770:         bge     1f
1771:         divf    fr1,fr0
1772:         br      2f
1773: 1:
1774:         mulf    fr1,fr0
1775:         cfcc
1776:         bvc     2f
1777:         movf    $huge,fr0
1778: 2:
1779: out:
1780:         tst     (sp)+
1781:         beq     1f
1782:         negf    fr0
1783: 1:
1784:         add     $'0,r0
1785:         mov     (sp)+,r2
1786:         mov     (sp)+,r1
1787:         movf    (sp)+,fr1
1788:         ldfps   (sp)+
1789:         tst     (r5)+
1790:         rts     r5
1791: 
1792: dig:
1793:         cmpf    $big,fr0
1794:         cfcc
1795:         blt     1f
1796:         mulf    $ten,fr0
1797:         movif   r0,fr1
1798:         addf    fr1,fr0
1799:         rts     pc
1800: 1:
1801:         add     $2,(sp)
1802:         rts     pc
1803: 
1804: one     = 40200
1805: ten     = 41040
1806: big     = 56200
1807: huge    = 77777
1808: 
1809: .globl  _ndigits
1810: .globl ecvt
1811: .globl fcvt
1812: 
1813: ftoa:
1814:         jsr     pc,ecvt
1815:         mov     r0,bufptr
1816:         tstb    r1
1817:         beq     1f
1818:         mov     $'-,r0
1819:         jsr     r5,*(r5)
1820: 1:
1821:         cmp     r3,$-2
1822:         blt     econ
1823:         cmp     r2,$-5
1824:         ble     econ
1825:         cmp     r2,$6
1826:         bgt     econ
1827:         jsr     pc,cout
1828:         tst     (r5)+
1829:         rts     r5
1830: 
1831: econ:
1832:         mov     r2,-(sp)
1833:         mov     $1,r2
1834:         jsr     pc,cout
1835:         mov     $'e,r0
1836:         jsr     r5,*(r5)
1837:         mov     (sp)+,r0
1838:         dec     r0
1839:         jmp     itoa
1840: 
1841: cout:
1842:         mov     bufptr,r1
1843:         add     _ndigits,r1
1844:         mov     r2,-(sp)
1845:         add     bufptr,r2
1846: 1:
1847:         cmp     r1,r2
1848:         blos    1f
1849:         cmpb    -(r1),$'0
1850:         beq     1b
1851:         inc     r1
1852: 1:
1853:         mov     (sp)+,r2
1854:         bge     2f
1855:         mov     $'.,r0
1856:         jsr     r5,*(r5)
1857: 1:
1858:         mov     $'0,r0
1859:         jsr     r5,*(r5)
1860:         inc     r2
1861:         blt     1b
1862:         dec     r2
1863: 2:
1864:         mov     r2,-(sp)
1865:         mov     bufptr,r2
1866: 1:
1867:         cmp     r2,r1
1868:         bhis    1f
1869:         tst     (sp)
1870:         bne     2f
1871:         mov     $'.,r0
1872:         jsr     r5,*(r5)
1873: 2:
1874:         dec     (sp)
1875:         movb    (r2)+,r0
1876:         jsr     r5,*(r5)
1877:         br      1b
1878: 1:
1879:         tst     (sp)+
1880:         rts     pc
1881: 
1882: .bss
1883: bufptr: .=.+2
1884: .text
1885: 
1886: ftoo:
1887:         stfps   -(sp)
1888:         ldfps   $200
1889:         mov     r1,-(sp)
1890:         mov     r2,-(sp)
1891:         mov     $buf,r1
1892:         movf    fr0,(r1)+
1893:         mov     $buf,r2
1894:         br      2f
1895: 1:
1896:         cmp     r2,r1
1897:         bhis    1f
1898:         mov     $';,r0
1899:         jsr     r5,*(r5)
1900: 2:
1901:         mov     (r2)+,r0
1902:         jsr     pc,oct
1903:         br      1b
1904: 1:
1905:         mov     $'\n,r0
1906:         jsr     pc,*(r5)+
1907:         ldfps   (sp)+
1908:         rts     r5
1909: 
1910: oct:
1911:         mov     r0,x+2
1912:         setl
1913:         movif   x,fr0
1914:         mulf    $small,fr0
1915:         seti
1916:         mov     $6.,-(sp)
1917: 1:
1918:         modf    $eight,fr0
1919:         movfi   fr1,r0
1920:         add     $'0,r0
1921:         jsr     r5,*(r5)
1922:         dec     (sp)
1923:         bne     1b
1924:         tst     (sp)+
1925:         rts     pc
1926: 
1927: eight   = 41000
1928: small   = 33600
1929: .bss
1930: buf:    .=.+8
1931: x:      .=.+4
1932: .text
1933: 
1934: itoa:
1935:         mov     r1,-(sp)
1936:         mov     r0,r1
1937:         bge     1f
1938:         neg     r1
1939:         mov     $'-,r0
1940:         jsr     r5,*(r5)
1941: 1:
1942:         jsr     pc,1f
1943:         mov     (sp)+,r1
1944:         tst     (r5)+
1945:         rts     r5
1946: 
1947: 1:
1948:         clr     r0
1949:         dvd     $10.,r0
1950:         mov     r1,-(sp)
1951:         mov     r0,r1
1952:         beq     1f
1953:         jsr     pc,1b
1954: 1:
1955:         mov     (sp)+,r0
1956:         add     $'0,r0
1957:         jsr     r5,*(r5)
1958:         rts     pc
1959: / bas -- BASIC
1960: / new command "dump" which dumps symbol table values by name
1961: /		R. Haight
1962: /
1963: _dump:
1964:         mov     r4,-(sp)
1965:         mov     $11.*14.+symtab-14.,r4
1966: 1:
1967:         add     $14.,r4
1968:         tst     (r4)
1969:         beq     1f
1970:         bit     $1,4(r4)
1971:         beq     1b
1972:         jsr     pc,dmp1
1973:         mov     $'=,r0
1974:         jsr     r5,xputc
1975:         movf    6(r4),r0
1976:         jsr     r5,ftoa; xputc
1977:         mov     $'\n,r0
1978:         jsr     r5,xputc
1979:         br      1b
1980: 1:
1981:         mov     (sp)+,r4
1982:         jmp     *(r4)+
1983: 
1984: dmp1:
1985:         tst     (r4)
1986:         blt     1f
1987:         mov     (r4),nameb
1988:         mov     2(r4),nameb+2
1989:         mov     $nameb,r0
1990:         jsr     pc,print
1991:         rts     pc
1992: 1:
1993:         mov     r4,-(sp)
1994:         mov     $symtab-14.,r4
1995: 1:
1996:         add     $14.,r4
1997:         tst     (r4)
1998:         beq     1f
1999:         mov     4(r4),r0
2000:         bic     $1,r0
2001: 2:
2002:         beq     1b
2003:         cmp     r0,(sp)
2004:         beq     2f
2005:         mov     2(r0),r0
2006:         br      2b
2007: 2:
2008:         jsr     pc,dmp1
2009:         mov     $'[,r0
2010:         jsr     r5,xputc
2011:         mov     *(sp),r0
2012:         com     r0
2013:         movif   r0,r0
2014:         jsr     r5,ftoa; xputc
2015:         mov     $'],r0
2016:         jsr     r5,xputc
2017: 1:
2018:         mov     (sp)+,r4
2019:         rts     pc
2020: /
2021: /
2022: 
2023: / basx -- data
2024: 
2025: one = 40200
2026: 
2027: .data
2028: 
2029: _ndigits:10.
2030: tmpf:   </tmp/btma\0>
2031: argname: <b.out\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0>
2032: vt:     </dev/vt0\0>
2033: .even
2034: pname:  <\0\0\0\0\0\0>
2035:         .even
2036: 
2037: resnam:
2038:         <list>
2039:         <done>
2040:         <q\0\0\0>
2041:         <run\0>
2042:         <prin>
2043:         <prom>   / prompt is like print without \n (cr)
2044:         <if\0\0>
2045:         <goto>
2046:         <retu>
2047:         <for\0>
2048:         <next>
2049:         <octa>
2050:         <save>
2051:         <dump>
2052:         <fi\0\0>
2053:         <else>
2054:         <edit>
2055:         <comm>  / comment
2056: .if scope / for plotting
2057:         <disp>
2058:         <draw>
2059:         <eras>
2060: .endif
2061: eresnam:
2062: 
2063: symtnam:
2064:         <arg\0>
2065:         <exp\0>
2066:         <log\0>
2067:         <sin\0>
2068:         <cos\0>
2069:         <atn\0>
2070:         <rnd\0>
2071:         <expr>
2072:         <int\0>
2073:         <abs\0>
2074:         <sqr\0>
2075: esymtnam:
2076: 
2077: / indirect sys calls:
2078: sysseek:        sys     seek; seekx: 0; 0
2079: syswrit:        sys     write; wbuf: 0; wlen: 0
2080: sysread:        sys     read; rbuf: 0; rlen: 0
2081: sysopen:        sys     open; ofile: 0 ; omode: 0
2082: syscreat:       sys     creat; cfile: 0; cmode: 0
2083: .bss
2084: drx:    .=.+8
2085: dry:    .=.+8
2086: drfo:   .=.+2
2087: ch:     .=.+2
2088: drflg:  .=.+2
2089: randx:  .=.+2
2090: gsp:    .=.+2
2091: forp:   .=.+2
2092: exprloc:.=.+2
2093: sstack: .=.+2
2094: sublev: .=.+2
2095: val:    .=.+2
2096: splimit:        .=.+2  / statement size limit
2097: iflev:  .=.+20.  / nested if compile stack: 10 deep
2098: ifp:    .=.+2    / current pointer to iflev
2099: line:   .=.+100.
2100: prfile: .=.+2   / output from _list or _save
2101: tfi:    .=.+2  / input file
2102: func:   .=.+2   / alternate functions, eg: _list or _save
2103: seeka:  .=.+2   / seek offset 1
2104: lineno: .=.+2
2105: nameb:  .=.+4
2106: tfo:    .=.+2
2107: symtab: .=.+2800.; esymtab: / symbol=7wds; symtab for 200
2108: space:  .=.+8000.; espace: / code space
2109: exline: .=.+1000.; eexline: / line execute space
2110: lintab: .=.+1800.; elintab: / 3wds per statement = 300 stmts
2111: stack:  .=.+800.; estack:
2112: 
2113: iobuf: fi: .=.+518.  / should be aquired??

Defined functions

Defined variables