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

Defined functions

Defined variables