sw/music/prog/MUSIC.PA

   1 \f
   2 \f
   3 /MUSIC COMPILER
   4 /RICH WILSON, 1975
   5 /FOR CCL USE: SAVE SYS MUSIC;201=400
   6
   7 VERSION=3
   8
   9 /CONFIGURATION SECTION:
  10 /       THE FOLLOWING MUST BE FILLED IN TO CUSTOMIZE THE
  11 /       MUSIC COMPILER/PLAYER AS DESIRED.
  12 /       OF THE MANY POSSIBLE CONFIGURATIONS, ONLY SOME
  13 /       HAVE BEEN TRIED, AND OTHERS ARE NOT GUARANTEED
  14 /       TO ASSEMBLE OR FUNCTION PROPERLY.
  15
  16 IFNDEF CPU <CPU=1>
  17         /FILL IN 1 FOR PDP-8/E (ALSO 8/F, 8/M)
  18         /FILL IN 2 FOR PDP-8/A (WITH CORE MEMORY)
  19         /FILL IN 4 FOR PDP-8/I OR OLD PDP-8
  20
  21 IFNDEF OS8 <OS8=10>
  22         /FILL IN 10 TO RUN UNDER OS/8
  23         /FILL IN 20 FOR PAPER TAPE INPUT ONLY
  24
  25 IFNDEF CORE <CORE=400>
  26         /FILL IN 100 FOR 4K SYSTEM (PAPER TAPE ONLY)
  27         /FILL IN 200 FOR 8K OR LARGER SYSTEM
  28         /FILL IN 400 FOR 12K OR LARGER SYSTEM
  29         /(ENABLES SPECIAL PLAYER)
  30
  31 IFNDEF NOISE <NOISE=CAF>
  32         /FILL IN THE SINGLE CYCLE INSTRUCTION WHICH IS
  33         /TO BE USED TO CREATE NOISE.  FOR 8/E OR 8/A WITHOUT
  34         /AN RX01, TRY CAF.  FOR OTHER SYSTEMS, TRY IOF.
  35         /DO NOT USE AN INSTRUCTION WHICH TAKES LONGER
  36         /THAN 1.5 MICROSECONDS.
  37
  38 IFZERO OS8+CORE-110 <ILLEGAL CONFIGURATION>
  39 IFNZRO CPU-1<IFNZRO CPU-2<IFNZRO CPU-4<
  40 ILLEGAL CONFIGURATION>>>
  41 IFNZRO OS8-10<IFNZRO OS8-20<ILLEGAL CONFIGURATION>>
  42 IFNZRO CORE-100<IFNZRO CORE-200<IFNZRO CORE-400<
  43 ILLEGAL CONFIGURATION>>>
  44
  45 IFZERO CORE-400 <
  46 IFNZRO CPU-4 <WOW=10>>
  47
  48 MARGIN=4        /DO WE CATCH FIELD CHANGES IN TIME?
  49 AC7776=CLL STA RAL
  50 AC4000=CLA STL RAR
  51 AC0002=STL CLA RTL
  52 BRANCH=JMS I [BRAN0
  53 IFZERO OS8-10 <
  54 DECODE=5
  55 FETCH=1
  56 >
  57 \f
  58 *20
  59 WSA,    0
  60 WSB,    0
  61 WSC,    0
  62
  63 CHAR,   0
  64 NOTE,   0       /-1 FOR REST THROUGH 6 FOR G
  65 NOTEV,  0       /POINTER TO #! TABLE:KEYTAB
  66 THIRD,  0       /-1 FOR 1/THIRD TIME
  67 PAREN,  0       /-1 WHEN ( FOUND
  68 OCTAVE, 0       /REMEMBER + AND -
  69 THISLE, 0       /LENGTH THIS TIME
  70 TOTLEN, 0       /LENGTH OF NOTE
  71 ACC,    0       /REMEMBER ACCIDENTALS
  72 NOTCNT, 0       /COUNT OF NOTES TO PRODUCE
  73 OUTBUF, -1
  74 PROTAB,
  75 TIMA,   ZBLOCK  3
  76 TIMB,   ZBLOCK  3
  77 TIMC,   ZBLOCK  3
  78 TIMD,   ZBLOCK  3
  79 Y,      0       /# OF Y'S SO FAR
  80 L,      0       /# OF LINE FEEDS SINCE Y
  81 TFLAG,  0       /-1 TO PRINT LINE
  82 MINFLG, 0       /-1 TO SUBTRACT NOTES
  83 TRANSP, 0
  84 RTRAN,  0
  85 OUTFLG, 0
  86 PROTND, /THE END OF WORKING LOCATIONS TO BE ZEROED
  87 IFZERO OS8-10 <
  88 INCHCT, -1      /-# CHARACTERS IN BLOCK
  89 INEOF,  1       /NON-ZEOR FOR EOF
  90 INFPTR, 7617    /PNTR TO INPUT INFO
  91 INCTR,  0       /-LENGTH IN BLOCKS
  92 INPTR,  0       /BUFFER POINTER
  93 INSAVE, 0       /HALF OF CHAR 3
  94 >
  95 \f
  96 /WORKING STORAGE FOR MUSIC MAKER
  97
  98 DECIMAL
  99 /THE FOLLOWING NUMBERS ALL REPRESENT TENTHS OF A MICROSECOND
 100 IFDEF WOW <
 101 IFZERO CPU-1 <
 102 JIFFY=50
 103 T1=316
 104 T2=290
 105 T3=3044 /DIVIDE TIME
 106 TIM6=7
 107 T6A=4
 108 >
 109 IFZERO CPU-2 <
 110 JIFFY=60
 111 T1=375
 112 T2=330
 113 T3=3600
 114 TIM6=10
 115 T6A=55          /TIM6*64-(DOIT TIME)
 116 >>
 117 OCTAL
 118 IFNDEF WOW <
 119 IFZERO CPU-1 <TIM6=26>
 120 IFZERO CPU-2 <TIM6=26>
 121 IFZERO CPU-4 <TIM6=36>>
 122 MDEFAULT=30^74%2        /C=60
 123 T64=0
 124 IFDEF WOW <T64=1>
 125 IFZERO CPU-1 <T64=1>
 126 \f
 127 /WORKING LOCATIONS
 128 *10
 129 AXA,    VERSION
 130 LINE=AXB
 131 AXB,    0
 132 AXC,    0
 133 LOWAIT, 0
 134 OOPS,   0
 135 LIMIT,  0
 136 BUFTAB, 0
 137
 138 *20
 139 WSA,    0
 140 WSB,    0
 141
 142 SAVE,   0
 143 CHAR,   0
 144 FLG,    0
 145 GETPTR, 0
 146 LOSAVE, 0
 147 HOSAVE, 7777
 148 LOLONG, 0
 149 HOLONG, 7700
 150 LOTIM,  0
 151 HOTIM,  0
 152 BUFGET, 0
 153 TRAN,   0
 154
 155 NOTTAB,
 156 AC,     0
 157 AR,     0
 158 AT,     0
 159 RTOT,   0
 160 BC,     0
 161 BR,     0
 162 BT,     0
 163 OLDS,   0
 164 CC,     0
 165 CR,     0
 166 CT,     0
 167 SAVS,   0
 168 DC,     0
 169 DR,     0
 170 DT,     0
 171 OLDE,   0
 172 \f
 173 *77
 174
 175 /SOME MAGIC NUMBERS
 176 /USED TO FIGURE METER: HOW MANY 6.4US UNITS
 177 /ARE THERE IN ONE MINUTE DIVIDED BY TWO?
 178 IFNZRO T64 <
 179 LOFUDG, 3214
 180 HOFUDG, 2170
 181 >
 182 /AND IN 6.0US UNITS?
 183 IFZERO T64 <
 184 LOFUDG, 5500
 185 HOFUDG, 2304
 186 >
 187 IFDEF WOW <
 188
 189 /AND THE MAGIC SUBROUTINE
 190 DOIT,   0
 191         TAD I   DOIT    /HOW LONG 'TILL NEXT CALL?
 192         DCA     LIMIT   /REMEMBER
 193         CDF     10
 194 DOIT1,  TAD     LIMIT
 195         CLL
 196         TAD     LOWAIT  /IS THERE ENOUGH TIME TO RETURN
 197         SNL             /AND GET BACK IN TIME?
 198         JMP     DOIT5   /YES
 199         ISZ I   BUFGET  /HOW ABOUT HIGH ORDER TIME?
 200         JMP     DOIT6   /YES, TIME
 201         CLA CLL         /NOT ENOUGH TIME
 202         TAD     LOWAIT  /HOW LONG WE HAVE TO WAIT
 203         TAD     OOPS    /ERROR LAST TIME
 204         SZL             /HAVE WE WAITED OUR TIME?
 205         JMP     .+3     /YES
 206         TAD     (JIFFY  /NO, UPDATE AC
 207         JMP     .-3     /AND TRY AGAIN
 208         DCA     OOPS    /SAVE ERROR
 209 IFZERO CPU-1 <
 210         ISZ     BUFGET  /NOW HOW MANY SPIKES?
 211         JMP     .+3
 212         JMP     .+2     /COVER SKIP
 213 NOISA,  NOISE           /MAKE A SPIKE
 214         ISZ I   BUFGET
 215         JMP     .-2     /ANOTHER SPIKE
 216         ISZ     BUFGET
 217         SKP             /COVER ISZ SKIP
 218         NOP             /MAKING UP FOR TIMING ERROR
 219 >
 220 IFZERO CPU-2 <
 221         ISZ     BUFGET
 222         SKP
 223         NOP
 224         TAD I   BUFGET
 225         DCA     LOWAIT
 226         ISZ     BUFGET
 227         JMP     .+3
 228         JMP     .+2
 229 NOISA,  NOISE
 230         ISZ     LOWAIT
 231         JMP     .-2
 232 >
 233         TAD I   BUFGET  /LOW ORDER TIME
 234         DCA     LOWAIT  /SAVE IT
 235         ISZ     BUFGET  /POINT TO HO TIME
 236         JMP     DOIT1
 237         JMP     DOIT1   /COVER ISZ SKIP
 238
 239 DOIT5,  TAD     [0      /TIMING CORRECTOR
 240         NOP
 241 DOIT6,  DCA     LOWAIT
 242         CDF
 243         ISZ     DOIT
 244         JMP I   DOIT
 245 >
 246 \f
 247 /ALTERNATE RESTART ADDRESS TO BEGIN PLAYING
 248 *0
 249         NOP
 250         JMP     PLAY    /GO PLAY
 251         NOISA           /ADDRESS OF NOISE, FOR CONVENIENCE
 252 FIX,    -TIM6
 253         CPU+OS8+CORE    /FOR CONVENIENCE
 254
 255 *200
 256 /BEGINNING OF EVERYTHING
 257
 258 START,
 259 IFZERO OS8-10 <
 260 IFDEF WOW <SKP;SKP>     /LEAVE ROOM FOR RESTORE TRAP
 261         JMS     OSDEC   /CALL COMMAND DECODER
 262 >
 263 START1, TLS             /BRING UP PRINTER FLAG
 264         JMS     KEYC    /DEFAULT TO KEY OF C
 265         TAD     (BUFTBL-1
 266         DCA     BUFTAB
 267         TAD I   BUFTAB  /AUTO-INDEX
 268         DCA     OUTBUF  /BEGINNING OF BUFFER
 269         TAD I   BUFTAB
 270         DCA     LIMIT   /END OF BUFFER
 271 IFNZRO CORE-100 <
 272         TAD I   BUFTAB
 273         DCA     OUTCDF  /FIELD OF BUFFER
 274 CORINI, JMS     INIT    /INITIALIZE CORE SIZE, ETC.
 275 >
 276         TAD     [LINBUF-1
 277         DCA     LINE
 278         TAD     (PROTAB-PROTND  /CLEAR OUT ALL THE NOTES
 279         DCA     WSA     /AND OTHER THINGS
 280         TAD     (PROTAB-1
 281         DCA     AXA
 282         DCA I   AXA
 283         ISZ     WSA
 284         JMP     .-2
 285
 286 /INITIALIZE AFTER ; OR CR
 287
 288 START2, DCA     NOTCNT
 289
 290 /INITIALIZE FOR NEXT NOTE
 291
 292         DCA     THIRD
 293         DCA     PAREN
 294         DCA     TOTLEN
 295         DCA     MINFLG
 296
 297 /INITIALIZE FOR NEXT NOTE IN CHORD
 298
 299 START5, BRANCH          /JMP BASED ON NEXT INPUT CHAR
 300         BRANA
 301 \f
 302 NEXNOT, ISZ     PAREN   /ARE WE IN A CHORD?
 303         SKP
 304         JMP     DEFCH2  /YES
 305         DCA     TOTLEN  /NO-ANOTHER LENGTH
 306 TIE,    BRANCH
 307         BRANB
 308
 309 TRIPLE, STA
 310         DCA     THIRD   /REMEMBER IT'S A TRIPLET
 311         JMP     TIE
 312
 313 MINUS,  STA             /SUBTRACT NOTE DURATIONS
 314         DCA     MINFLG
 315         JMP     TIE
 316
 317 KEYF,   AC7776          /DEFINE FLATS
 318 KEYS,   IAC             /DEFINE SHARPS
 319         DCA     WSC
 320         JMS     GETEQ   /BUMP PAST =
 321         JMP     BADLINE
 322         JMS     KEYC    /RESET TO KEY OF C
 323 KEYL,   JMS     GETNOTE /IS THERE A NOTE?
 324         JMP     BADLINE /NO
 325         TAD     WSC
 326         DCA I   NOTEV   /REMEMBER SHARP/FLAT
 327         JMS     IN
 328         TAD     (-",
 329         SNA CLA         /IS THERE ANOTHER?
 330         JMP     KEYL    /YES
 331         TAD     CHAR    /NO
 332         JMP     START5  /DO SOMETHING ELSE
 333
 334 LENG,   IAC             /GRACE NOTE!
 335         ISZ     THIRD   /DID HE SAY TRIPLET?
 336         JMP     ADDLEN  /NO
 337         JMS     BADSTAR /YES-THAT'S NO GOOD
 338         JMP     LENG
 339
 340 LENB,   IAC             /SEMI-BREVE
 341 LENM,   IAC             /MINIM
 342 LENC,   IAC             /CROTCHET
 343 LENQ,   IAC             /QUAVER
 344 LENS,   IAC             /SEMI-QUAVER
 345 LEND,   CMA
 346         DCA     WSA
 347         STL RAL
 348         ISZ     THIRD   /THIRD TIME?
 349         STL
 350         RAL
 351         ISZ     WSA
 352         JMP     .-2
 353 ADDLEN, ISZ     MINFLG  /DO WE SUBTRACT?
 354         SKP             /NO
 355         CIA             /YES
 356         DCA     THISLEN /LENGTH THIS NOTE
 357         TAD     THISLEN
 358         TAD     TOTLEN
 359         SPA SNA         /DID HE SUBTRACT TOO MUCH?
 360         JMP     ADDNEG  /YES
 361         DCA     TOTLEN          /TOTAL LENGTH
 362         JMS     GETNOTE /IS THERE A NOTE YET?
 363         JMP     .+3     /NO, SOMETHING ELSE I GUESS
 364 NMODS,  BRANCH          /YES, NOW WHAT?
 365         BRANE
 366         TAD     CHAR
 367         BRANCH
 368         BRAND
 369
 370 PUTNO,  JMS     BADSTA  /OUT OF CORE!
 371         JMS     MSG     /PRINT LAST LINE
 372         JMS     CRLF
 373         TAD     ("$
 374         JMS     TYPE
 375         JMS     CRLF
 376         JMP     ENDM    /NOW PLAY IT
 377
 378 /DOTTED NOTES:
 379 DOT,    TAD     THISLEN
 380         STL
 381         SMA             /FIX LINK TO SIGN OF NUMBER
 382         CLL
 383         RAR             /DIVIDE BY TWO
 384         SZL             /VALID?
 385 ADDNEG, JMS     BADSTA  /NO
 386         JMP     ADDLEN
 387
 388 PAGE
 389 \f
 390 /DEFINE METER:
 391 /METER IS SAVED AS 12 BIT LENGTH*METER/2
 392
 393 DEFM,   ISZ     PAREN   /DEFINE METER
 394         SKP
 395         JMP     BADLINE /OOPS--INSIDE A (?
 396         JMS     DECIN   /GET METER
 397         SNA
 398         JMP     BADLINE /MUST BE VALID
 399         DCA     DEFM2
 400         TAD     TOTLEN  /LENGTH OF NOTE
 401         CLL RAR
 402         DCA     WSB
 403         JMS     MUL     /MULTIPLY
 404 DEFM2,  .-.
 405         DCA     WSB
 406         TAD     (4      /DEFINE METER CODE
 407         JMS     OUT
 408         TAD     WSB
 409         RTR
 410         RTR
 411         RTR
 412         JMS     OUT     /HIGH ORDER
 413         TAD     WSB
 414         JMS     OUT     /LOW ORDER
 415         JMS     LIMTST  /TEST FOR END OF BUFFER AREA
 416         JMP     DEFV
 417
 418 /LEFT PAREN FOUND (
 419 DEFCHO, ISZ     PAREN
 420         SKP
 421         JMS     BADSTA  /NESTED ((
 422 DEFCH2, STA
 423         DCA     PAREN
 424         JMS     GETNOTE /WE SHOULD HAVE A NOTE
 425         JMP     BADLINE /OOPS
 426         JMP     NMODS   /NOW TRY FOR "!+=
 427
 428 /ACCIDENTALS
 429 ACCF,   CLL STA RTL     /FLAT
 430 ACCS,   TAD     (2      /SHARP
 431         TAD     ACC
 432         DCA     ACC
 433         JMP     NMODS
 434 ACCN,   IAC             /NATURAL
 435         DCA     ACC
 436 OCTMOR, BRANCH          /LOOK FOR +-
 437         BRANF
 438
 439 OCTUP,  TAD     (30     /FOUND +
 440 OCTDN,  TAD     (-14    /FOUND -
 441         TAD     OCTAVE
 442         DCA     OCTAVE
 443         JMP     OCTMOR  /ARE THERE MORE?
 444 \f
 445 PPRODU, ISZ     PAREN   /WE SHOULD BE INSIDE ) HERE
 446         JMS     BADSTA
 447         BRANCH
 448         BRANG
 449
 450 SPRODU, ISZ     PAREN   /WAS THERE A PAREN?
 451         JMP     PRODUCE /NO, OK
 452         JMS     BADSTA  /YES--NO ) THOUGH
 453 PRODUC, TAD     NOTE
 454         SPA CLA         /REST?
 455         JMP     PRO7    /YES
 456         TAD     ACC
 457         SMA             /FLAT?
 458         CLL RAR         /NO, DIVIDE BY TWO
 459         SNA             /MAYBE ZERO IF NATURAL
 460         SZL             /NON-ZERO LINK IF NATURAL
 461         SKP
 462         TAD I   NOTEV   /GET DEFAULT #!"
 463         DCA     ACC     /-1 FOR !,1 FOR #
 464         TAD     NOTE
 465         TAD     (BASTAB
 466         DCA     NOTE
 467         TAD I   NOTE    /GET NOTE NUMBER
 468         TAD     ACC     /#!
 469         TAD     OCTAVE  /+-
 470         TAD     TRANSPOSE       /DID HE REQUEST TRANSPOSE
 471 PRO3,   SMA             /MAKE SURE IT IS WITHIN RANGE
 472         JMP     PRO4
 473         TAD     (14
 474 PRO3A,  DCA     WSB
 475         JMS     BADSTA  /OUT OF RANGE
 476         TAD     WSB
 477         JMP     PRO3
 478 PRO4,   TAD     (-117
 479         SPA
 480         JMP     PRO6
 481         TAD     (117-14 /OUT OF RANGE
 482         JMP     PRO3A
 483 PRO6,   TAD     (117
 484         DCA     NOTE
 485 PRO7,   TAD     (PROTAB
 486         DCA     WSA
 487         TAD     (-4
 488         DCA     WSB
 489 PRO8,   TAD I   WSA
 490         SNA CLA         /SPACE IN THE TABLE?
 491         JMP     PRO9    /YES
 492         ISZ     WSA     /GO TO NEXT ENTRY
 493         ISZ     WSA
 494         ISZ     WSA
 495         ISZ     WSB     /END?
 496         JMP     PRO8    /NO
 497         JMS     BADSTA  /TRYING TO PLAY 5 NOTES
 498         JMP     PROA
 499
 500 PAGE
 501 \f
 502 PRO9,   ISZ     NOTCNT  /COUNT HOW MANY
 503         TAD     TOTLEN
 504         DCA I   WSA
 505         ISZ     WSA
 506         STA
 507         DCA I   WSA     /SET FLAG SO WE WILL
 508         ISZ     WSA     /PROCESS NOTE LATER
 509         TAD     NOTE
 510         DCA I   WSA     /REMEMBER PITCH
 511         TAD     CHAR
 512 PROA,   TAD     (-",
 513         SNA CLA         /DO WE EXPECT MORE NOTES?
 514         JMP     NEXNOT  /YES
 515 PROB,   TAD     NOTCNT
 516         SNA
 517         JMP     START2  /THERE ARE NO NOTES TO WORRY ABOUT
 518         CIA
 519         DCA     NOTCNT
 520         TAD     (PROTAB
 521         DCA     WSA
 522         TAD     (-4
 523         DCA     WSB
 524
 525 /FIRST WORRY ABOUT NOTES WHICH MUST BE CHANGED TO RESTS
 526 PUT0,   TAD I   WSA
 527         ISZ     WSA
 528         ISZ     WSA
 529         SZA CLA         /IS THIS A TIMED OUT NOTE?
 530         JMP     PUT2    /NO
 531         ISZ I   WSA     /IS IT A REST?
 532         JMP     PUT3    /NO-BETTER MAKE IT ONE
 533 PUT1,   STA
 534         DCA I   WSA     /REMEMBER IT IS REST
 535 PUT2,   JMS     LIMTST  /TEST FOR END OF BUFFER AREA
 536         ISZ     WSA
 537         ISZ     WSB
 538         JMP     PUT0    /GO FOR MORE
 539         TAD     (PROTAB /START OVER AGAIN
 540         DCA     WSA
 541         TAD     (-4
 542         DCA     WSB
 543
 544 /NOW WORRY ABOUT OUR NEW NOTES
 545 PUT4,   TAD I   WSA
 546         ISZ     WSA
 547         SZA CLA         /ACTIVE NOTE?
 548         JMP     PUT6    /YES
 549 PUT5,   ISZ     WSA     /GO TO NEXT ENTRY
 550         ISZ     WSA
 551         ISZ     WSB
 552         JMP     PUT4
 553         HLT             /HLT HERE MEANS BUG
 554 \f
 555 PUT3,   TAD     (10     /DEFINE A REST
 556         TAD     WSB     /NOTE #
 557         STL RAL
 558         JMS     OUT
 559         JMP     PUT1
 560
 561 PUT6,   ISZ I   WSA     /FLAG SET?
 562         JMP     PUT5    /NO, IGNORE IT
 563         JMS     LIMTST  /TEST FOR END OF BUFFER AREA
 564         ISZ     WSA
 565         TAD I   WSA
 566         SPA CLA         /REST?
 567         JMP     PUT7    /YES
 568         TAD     RTRAN   /GET AUTOMATIC TRANSPOSE
 569         TAD I   WSA     /AND NOTE
 570 /THERE ARE MORE THAN 64 NOTES, BUT ONLY 6 BITS
 571 /TO REMEMBER WITH. SO WE DO THIS:
 572         AND     [7700   /IN RANGE?
 573         SNA
 574         JMP     PUT6A   /NOTHING TO DO
 575         SMA CLA
 576         TAD     (10
 577         TAD I   WSA     /TAD IN PITCH
 578         AND     (70     /GET TRANSPOSE AMOUNT
 579         DCA     RTRAN   /SAVE IT
 580         TAD     RTRAN
 581         TAD     (6      /PUT IN FUNCTION CODE
 582         JMS     OUT     /STASH IT IN BUFFER
 583         TAD     RTRAN
 584         CIA
 585         DCA     RTRAN
 586 PUT6A,  TAD     (10
 587 PUT7,   ISZ     NOTCNT  /LAST NOTE?
 588         TAD     (4
 589         TAD     (4
 590         TAD     WSB     /NOTE #
 591         STL RAL
 592         JMS     OUT
 593         TAD I   WSA
 594         TAD     RTRAN   /AUTOMATIC TRANSPOSE
 595         SMA             /REST?
 596         JMS     OUT     /NO, REMEMBER PITCH
 597         CLA CLL
 598         TAD     NOTCNT
 599         SZA CLA         /LAST NOTE?
 600         JMP     PUT5+1  /NO, GO FOR MORE
 601         JMP     PUT9
 602 \f
 603 /CHECK FOR THE END OF THE BUFFER SPACE
 604 LIMTST, 0
 605         CLA CLL
 606         TAD     OUTBUF
 607         TAD     LIMIT
 608         SNL CLA         /AT OR NEAR END?
 609         JMP I   LIMTST  /OK
 610 IFNZRO CORE-100 <
 611         TAD I   BUFTAB  /AUTO-INDEX
 612         SNA             /IS THERE MORE BUFFER AREA?
 613         JMP     PUTNO   /NO
 614         DCA     LIMIT   /LIMIT OF BUFFER IN THIS FIELD
 615         TAD     (14     /CODE FOR FIELD SWITCH
 616         JMS     OUT
 617         TAD I   BUFTAB  /CDF NEW FIELD
 618         DCA     OUTCDF
 619         DCA     OUTBUF  /START AT LOCATION ZERO
 620         DCA     OUTFLG
 621         JMP I   LIMTST
 622 >
 623 IFZERO CORE-100 <
 624         JMP     PUTNO
 625 >
 626
 627 PAGE
 628 \f
 629 PUT9,   AC4000
 630         DCA     THISLEN
 631
 632 /NOW FIGURE OUT WHAT THE SHORTEST TIME LEFT
 633 /IS OF THE FOUR NOTES, AND SUBTRACT THAT
 634 /TIME FROM ALL NOTES
 635         TAD     TIMA
 636         JMS     SMALL
 637         TAD     TIMB
 638         JMS     SMALL
 639         TAD     TIMC
 640         JMS     SMALL
 641         TAD     TIMD
 642         JMS     SMALL
 643         TAD     TIMA
 644         SZA
 645         TAD     THISLEN
 646         DCA     TIMA
 647         TAD     TIMB
 648         SZA
 649         TAD     THISLEN
 650         DCA     TIMB
 651         TAD     TIMC
 652         SZA
 653         TAD     THISLEN
 654         DCA     TIMC
 655         TAD     TIMD
 656         SZA
 657         TAD     THISLEN
 658         DCA     TIMD
 659         TAD     THISLEN
 660         CIA
 661         JMS     OUT     /OUTPUT LENGTH
 662
 663 /NOW IF IT WAS LONGER THAN 64, WE NEED TO REMEMBER THAT
 664         TAD     THISLEN
 665         RTR
 666         RTR
 667         RTR
 668         AND     [77
 669         TAD     [7700
 670         DCA     WSA
 671         JMS     LIMTST  /CHECK FOR END OF BUFFER AREA
 672         AC0002
 673         ISZ     WSA     /WAS IT TOO LONG?
 674         JMS     OUT     /YES--CREATE LONGER NOTE
 675         SNA     CLA
 676         JMP     .-5
 677         JMP     START2  /GO FOR MORE
 678
 679 NEXLIN, ISZ     TFLAG   /ERROR?
 680         SKP
 681         JMS     MSG     /YES-PRINT LINE
 682         TAD     [LINBUF-1
 683         DCA     LINE    /RESET BUFFER POINTER
 684         ISZ     L       /COUNT LINES
 685         JMP     START5
 686         JMP     START5
 687 \f
 688 DEFY,   TAD     TIMA    /WE FOUND A Y
 689         TAD     TIMB    /ARE ALL NOTES TIMED OUT?
 690         TAD     TIMC
 691         TAD     TIMD
 692         SZA CLA
 693         JMS     BADSTA  /NOTES DID NOT FINISH TOGETHER
 694         DCA     TIMA    /WHETHER THEY ARE OR NOT,
 695         DCA     TIMB    /WE WILL MAKE THEM SO
 696         DCA     TIMC
 697         DCA     TIMD
 698         ISZ     Y
 699         NOP
 700         DCA     L
 701         JMS     GETEQ   /IS THERE AN =
 702         JMP     DEFV    /NO
 703         JMS     DECIN   /GET DECIMAL #
 704         SZA
 705         DCA     Y       /SAVE IT
 706
 707 DEFV,   TAD     CHAR
 708         BRANCH          /LOOK FOR END OF LINE
 709         BRANC
 710
 711 DECIN,  0               /DECIMAL INPUT
 712 DECIN1, DCA     WSB
 713         JMS     IN
 714         TAD     (-"9-1
 715         CLL
 716         TAD     (12
 717         DCA     AXA
 718         SNL
 719         JMP     DECIN2
 720         JMS     MUL
 721         12
 722         TAD     AXA
 723         JMP     DECIN1
 724 DECIN2, TAD     WSB
 725         JMP I   DECIN
 726 \f
 727 SPACE,  0
 728         TAD     [240
 729         JMS     TYPE
 730         JMP I   SPACE
 731
 732 CRLF,   0
 733         TAD     (215
 734         JMS     TYPE
 735         TAD     (212
 736         JMS     TYPE
 737         JMP I   CRLF
 738
 739 TYPE,   0
 740         ISZ     COFLG   /CTRL/O?
 741         JMP     TYPENO  /YES-NO PRINTING
 742         TSF
 743         JMP     .-1
 744         TLS             /TYPE CHARACTER
 745 TYPENO, CLA
 746         KRS             /LASTLY TYPED CHARACTER
 747         AND     [177    /REMOVE PARITY
 748         TAD     (-"O+300
 749         SNA CLA         /IS IT CTRL/O?
 750         KSF             /AND IS FLAG SET?
 751         STA
 752         DCA     COFLG   /REMEMBER FLAG FOR NEXT TIME
 753         JMP I   TYPE
 754 COFLG,  -1
 755
 756 PAGE
 757 \f
 758 IFZERO OS8-20 < IFNDEF WOW <
 759 REMEM=.
 760 *HOFUDG+1
 761 >>
 762 SMALL,  0       /FIND SMALLEST LENGTH
 763         SNA
 764         JMP I   SMALL   /IGNORE ZEROES
 765         TAD     THISLEN
 766         SMA
 767         JMP     SMALL2
 768         CIA             /FOUND A SMALLER ONE
 769         TAD     THISLEN
 770         DCA     THISLEN
 771 SMALL2, CLA
 772         JMP I   SMALL
 773
 774 IFZERO OS8-10 <
 775 OSDEC,  0               /CALL OS8 COMMAND DECODER
 776         CIF     10
 777         JMS I   C7700
 778         DECODE
 779         "M-300^100+"U-300       /.MU DEFAULT
 780         STA
 781         DCA     INCHCT
 782         IAC
 783         DCA     INEOF   /CAUSE AN END OF FILE
 784         TAD     (7617   /INIT FILE POINTER
 785         DCA     INFPTR
 786         JMP I   OSDEC
 787
 788 OSIN,   0
 789 INCHAR, ISZ     INJMP   /UNPACKING SWITCH
 790         ISZ     INCHCT  /ANY MORE CHARACTERS?
 791 INJMPP, JMP     INJMP   /YES
 792         TAD     INEOF
 793         SNA CLA         /EOF?
 794         JMP     INGBUF  /NO-GO READ
 795 GETNEW, JMS     INNEWF  /GO TO NEXT FILE
 796         JMP     ENDM    /NO MORE FILES
 797 INGBUF, ISZ     INCTR
 798         SKP
 799         ISZ     INEOF   /WE'RE ON LAST BLOCK
 800         JMS I   INHNDL  /READ FROM INPUT
 801         200             /ONE BLOCK
 802 INBUFP, INBUF
 803 INREC,  0
 804         JMP     INERRX
 805 INBREC, ISZ     INREC   /GO TO NEXT BLOCK
 806         TAD     (-600-1
 807         DCA     INCHCT
 808         TAD     INJMPP
 809         DCA     INJMP
 810         TAD     INBUFP
 811         DCA     INPTR
 812         JMP     INCHAR
 813 INERRX, ISZ     INEOF
 814 C7700,  SMA CLA         /FATAL ERROR?
 815         JMP     INBREC  /END OF FILE
 816         HLT             /I/O ERROR
 817 INJMP,  HLT             /UNPACKING JUMP
 818         JMP     ICHAR1
 819         JMP     ICHAR2
 820         TAD     INJMPP
 821         DCA     INJMP
 822         TAD I   INPTR
 823         AND     (7400
 824         CLL RTR
 825         RTR
 826         TAD     INSAVE
 827         RTR
 828         RTR
 829         ISZ     INPTR
 830         JMP     INCOMN
 831 ICHAR2, TAD I   INPTR
 832         AND     (7400
 833         DCA     INSAVE
 834         ISZ     INPTR
 835 ICHAR1, TAD I   INPTR
 836 INCOMN, AND     [177
 837         TAD     (-32    /CTRL/Z?
 838         SNA
 839         JMP     GETNEW  /TIME FOR NEXT FILE
 840         TAD     (232
 841         JMP I   OSIN
 842
 843 /GO TO NEXT INPUT FILE
 844 INNEWF, 0
 845         TAD     (INDEVH+1
 846         DCA     INHNDL
 847         CDF     10
 848         TAD I   INFPTR
 849         CDF
 850         SNA
 851         JMP I   INNEWF  /NO MORE INPUT FILES
 852         CIF     10
 853         JMS I   C7700   /FETCH HANDLER
 854         FETCH
 855 INHNDL, .-.
 856         HLT
 857         CDF     10
 858         TAD I   INFPTR
 859         AND     (7760
 860         SZA
 861         TAD     (17
 862         STL RTR
 863         RTR
 864         DCA     INCTR
 865         ISZ     INFPTR
 866         TAD I   INFPTR
 867         CDF
 868         DCA     INREC
 869         ISZ     INFPTR
 870         DCA     INEOF
 871         STA
 872         DCA     INCHCT
 873         ISZ     INNEWF
 874         JMP I   INNEWF
 875 IFDEF WOW <
 876 RESTR2, 0
 877         JMS I   [RESTOR
 878         STA
 879         TAD     RESTR2
 880         DCA     RESTR2
 881         JMP I   RESTR2
 882 >>
 883 IFNZRO OS8-10 <
 884 OSIN,   0
 885 CH1,    TAD     [-20    /SET FOR DELAY OF A WHILE
 886         DCA     CHAR
 887 CH2,    KSF             /ANYTHING AT LOW SPEED?
 888         JMP     CH3     /NO
 889         KRB             /YES-GET IT
 890         JMP I   OSIN    /AND RETURN
 891
 892 CH3,    RSF             /ANYTHING AT HIGH SPEED?
 893         JMP     CH4     /NO
 894         RRB RFC         /YES, GET IT
 895         JMP I   OSIN    /AND RETURN
 896
 897 CH4,    ISZ     CH5
 898         JMP     CH2
 899         ISZ     CHAR
 900         JMP     CH2
 901         LAS
 902         SNA CLA
 903         RFC             /TRY TO START THE READER
 904         CLA             /IN CASE OF FUNNY INTERFACES
 905         JMP     CH1
 906 CH5,    0
 907 >
 908
 909 PAGE
 910 IFZERO OS8-20 < IFNDEF WOW <
 911 *REMEM
 912 >>
 913 \f
 914 BRAN0,  0               /BRANCH BASED ON CHARACTER
 915         DCA     CHAR    /MAYBE USE CHAR IN AC
 916         STA
 917         TAD I   BRAN0
 918         DCA     AXA
 919         TAD     CHAR
 920         SNA
 921         JMS     IN
 922         CLA SKP
 923 BRAN1,  ISZ     AXA
 924         TAD I   AXA
 925         SMA
 926         SKP CLA
 927         TAD     CHAR
 928         SZA CLA
 929         JMP     BRAN1
 930         TAD I   AXA
 931         DCA     WSA
 932         JMP I   WSA     /BRANCH!
 933
 934 GETEQ,  0               /SKIP IF NEXT CHAR IS =
 935         JMS     IN
 936         TAD     (-"=
 937         SNA CLA
 938         ISZ     GETEQ
 939         JMP I   GETEQ
 940
 941 KEYC,   0               /SET TO KEY OF C
 942         TAD     (KEYTAB-1
 943         DCA     AXA
 944         TAD     (-10
 945         DCA     WSA
 946         DCA I   AXA
 947         ISZ     WSA
 948         JMP     .-2
 949         JMP I   KEYC
 950
 951 GETNOT, 0               /GET A NOTE
 952         JMS     IN
 953         TAD     (-"G-1
 954         CLL
 955         TAD     ("G-"A+1
 956         SNL
 957         JMP     GETNR
 958 GETN2,  DCA     NOTE
 959         TAD     NOTE
 960         TAD     (KEYTAB+1
 961         DCA     NOTEV
 962         DCA     OCTAVE  /CLEAR OUT +-
 963         DCA     ACC     /CLEAR ACCIDENTALS
 964         ISZ     GETNOTE
 965         JMP I   GETNOTE
 966 \f
 967 GETNR,  TAD     ("A-"R
 968         SZA CLA
 969         JMP I   GETNOTE /NO NOTE
 970         STA
 971         JMP     GETN2
 972
 973 /GET A CHARACTER, AND REMEMBER IN CASE OF ERROR
 974 IN,     0
 975         JMS     OSIN
 976         AND     [177
 977         TAD     [200
 978         DCA     CHAR
 979         TAD     CHAR
 980         TAD     (-212
 981         SZA
 982         TAD     (-3
 983         SNA
 984         JMP     IN2     /CR OR LF
 985         TAD     (215-340
 986         CLL
 987         TAD     (340-240
 988         SNL CLA
 989         JMP     IN+1    /INVALID CHARACTER-IGNORE
 990 IN2,    TAD     LINE
 991         TAD     (-LINBUF-100+2
 992         SPA CLA         /SOMEWHAT LONG?
 993         JMP     .+3
 994         TAD     [LINBUF-1       /YES, START OVER
 995         DCA     LINE
 996         TAD     CHAR
 997         DCA I   LINE    /SAVE IN LINE BUFFER
 998         TAD     CHAR
 999         TAD     (-240
1000         SNA CLA
1001         JMP     IN+1    /IGNORE(BUT PRINT) SPACES
1002         TAD     CHAR
1003         JMP I   IN
1004
1005 BADLIN, JMS     BADSTA  /PRINT "*"
1006         JMP     DEFV    /FIND NEXT LINE
1007
1008 BADSTA, 0
1009         CLA
1010         TAD     LINE
1011         DCA     WSA
1012         TAD I   WSA     /GET LAST CHARACTER
1013         DCA I   LINE    /MOVE IT OVER
1014         TAD     ("*
1015         DCA I   WSA     /PUT * IN LINE
1016         STA
1017         DCA     TFLAG   /PRINT THIS LINE
1018         JMP I   BADSTA  /RETURN
1019 \f
1020 /T=  :  TRANSPOSE
1021 DEFT,   JMS     GETEQ   /BUMP OVER EQUAL
1022         JMP     BADLINE /OOPS, NONE
1023         JMS     DECIN   /GET DECIMAL NUMBER
1024         TAD     (-144   /T=100 IS NO TRANSPOSE
1025         DCA     TRANSPOSE
1026         JMP     DEFV    /IGNORE REST OF LINE
1027
1028 PAGE
1029 \f
1030 ENDM,   JMS     OUT     /OUTPUT END CODE (0)
1031         JMP I   [PLAY   /NOW GO AND PLAY
1032 IFDEF WOW < IFZERO OS8-10 <
1033 *.-1                    /UNLESS THIS IS ASSEMBLED
1034         TAD     [7600   /SINCE WE USE FIELD ONE AS A
1035         DCA     WSA     /4K BUFFER, WE MUST SAVE THE
1036         TAD     (SAVBUF-1
1037         DCA     AXA     /OS/8 STUFF WHICH IS THERE.
1038 SAVEL,  CDF     10
1039         TAD I   WSA
1040         CDF
1041         DCA I   AXA
1042         ISZ     WSA
1043         JMP     SAVEL
1044         TAD I   [7600
1045         DCA     MSG
1046         TAD     (JMS I [RESTR2
1047         DCA I   [7600   /SET RESTART TRAP
1048         TAD     (JMS I  [RESTR2
1049         DCA I   [START
1050         JMP I   [PLAY   /NOW, WE CAN PLAY MUSIC!
1051
1052 RESTOR, 0               /SUBROUTINE TO RESTORE THE
1053         TAD     [7600   /TOP PAGE OF FIELD ONE
1054         DCA     WSA
1055         TAD     (SAVBUF-1
1056         DCA     AXA
1057 RESTOL, TAD I   AXA
1058         CDF     10
1059         DCA I   WSA
1060         CDF
1061         ISZ     WSA
1062         JMP     RESTOL
1063         TAD     MSG     /RESTORE 7600
1064         DCA I   [7600
1065         TAD     (SKP
1066         DCA I   [START
1067         JMP I   RESTOR
1068 >>
1069
1070 MSG,    0               /PRINT LINE
1071         TAD     Y
1072         JMS     DECOUT  /PRINT Y NUMBER
1073         JMS     SPACE
1074         TAD     L
1075         JMS     DECOUT  /PRINT L NUMBER
1076         JMS     SPACE
1077         TAD     [LINBUF-1
1078         DCA     AXA
1079 MSG1,   TAD     (-76
1080         DCA     WSA
1081 MSG2,   TAD I   AXA
1082         JMS     TYPE
1083         TAD     AXA
1084         CIA
1085         TAD     LINE
1086         SNA CLA
1087         JMP I   MSG
1088         ISZ     WSA
1089         JMP     MSG2
1090         JMS     CRLF
1091         JMP     MSG1
1092
1093 OUT,    0
1094 IFNZRO CORE-100 <
1095 OUTCDF, CDF     00 >
1096         AND     [77
1097         ISZ     OUTFLG
1098         JMP     OUT2
1099         TAD I   OUTBUF
1100         DCA I   OUTBUF
1101         ISZ     OUTBUF
1102         JMP     OUT3
1103 OUT2,
1104 IFNZRO CPU-4 <BSW>
1105 IFZERO CPU-4 <
1106         CLL RTL
1107         RTL
1108         RTL
1109 >
1110 OUT3,   DCA I   OUTBUF
1111 IFNZRO CORE-100 < CDF >
1112         TAD     OUTFLG
1113         CIA
1114         DCA     OUTFLG
1115         JMP I   OUT
1116
1117 DECOUT, 0
1118         SNA
1119         JMP     DECO2
1120         DCA     WSB
1121         TAD     (DECO9
1122         DCA     WSA
1123         JMS     DECO6
1124         SNA
1125         JMP     .-2
1126         TAD     ("0
1127         JMS     TYPE
1128         JMS     DECO6
1129         JMP     .-3
1130 DECO2,  TAD     ("0
1131         JMS     TYPE
1132         JMP I   DECOUT
1133
1134 DECO6,  0
1135         DCA     WSC
1136 DECO7,  TAD I   WSA
1137         SNA
1138         JMP I   DECOUT
1139         STL
1140         TAD     WSB
1141         SZL
1142         JMP     DECO8
1143         DCA     WSB
1144         ISZ     WSC
1145         JMP     DECO7
1146 DECO8,  CLA
1147         ISZ     WSA
1148         TAD     WSC
1149         JMP I   DECO6
1150
1151 /MULTIPLY:AC=WSB*(JMS+1)
1152 MUL,    0
1153         TAD     (-14
1154         DCA     WSA
1155         TAD I   MUL
1156         ISZ     MUL
1157 MUL2,   CLL RAL
1158         SZL
1159         TAD     WSB
1160         ISZ     WSA
1161         JMP     MUL2
1162         JMP I   MUL
1163
1164 PAGE
1165 \f
1166 /THE START OF THE PLAYING PART OF THE COMPILER
1167 PLAY,   DCA     FLG     /RESET PACKING FLAG
1168         TAD     (BFR1
1169         DCA     TRAN
1170 IFDEF WOW <
1171         CDF     10
1172         DCA     AXB     /START OFF WITH A LONG
1173         DCA     BUFGET  /PAUSE (.84 SEC)
1174         STL RAR
1175         DCA I   BUFGET
1176         STA
1177         DCA I   AXB
1178         CDF
1179         DCA     OOPS
1180 >
1181 IFNDEF WOW <
1182         STA
1183 >
1184         DCA     SAVS    /DON'T START WITH POP
1185         TAD     (BUFTBL-1
1186         DCA     BUFTAB
1187         TAD I   BUFTAB
1188         DCA     GETPTR
1189 IFNZRO CORE-100 <
1190         ISZ     BUFTAB
1191         TAD I   BUFTAB
1192         DCA     GETCDF
1193 >
1194         TAD     (MDEFAULT
1195         JMP     DOM1    /SET METER DEFAULT
1196 RESTM,
1197 IFDEF WOW <DECIMAL
1198         JMS     DOIT    /A REST...
1199 IFZERO CPU-1 <  T1+158 >
1200 IFZERO CPU-2 <  T1+180 >
1201 OCTAL>
1202         TAD     (2000   /LOW FREQUENCY
1203         DCA I   AXA
1204         DCA I   AXA     /NO SPIKES
1205 NEXT1,  STA
1206         DCA I   AXA     /KEEP SIMULTANEOUS NOTES
1207 NEXT,
1208 IFDEF WOW <DECIMAL
1209         JMS     DOIT    /IN PHASE
1210 IFZERO CPU-1 <  T1+T2+190 >
1211 IFZERO CPU-2 <  T1+T2+225 >
1212 OCTAL>
1213         JMS I   [GET    /WHAT DO WE DO?
1214         CLL RAR
1215         SNL
1216         JMP     SPECIAL /SOMETHING SPECIAL
1217         RTR
1218         AND     (7      /WHAT DO?
1219         TAD     (JMPTAB
1220         DCA     WSA
1221         TAD I   WSA     /GET DISPATCH ADDRESS
1222         DCA     WSA
1223 IFDEF WOW <DECIMAL
1224         NOP
1225         JMS     DOIT
1226 IFZERO CPU-1 <  T1+140 >
1227 IFZERO CPU-2 <  T1+165 >
1228 OCTAL >
1229         TAD     CHAR
1230         AND     (6      /WHICH NOTE?
1231         CLL RAL
1232         TAD     (NOTTAB-1
1233         DCA     AXA
1234         JMP I   WSA     /NOW DISPATCH
1235
1236 REST,
1237 IFDEF WOW <DECIMAL
1238         JMS     DOIT    /DO A REST
1239 IFZERO CPU-1 <  T1+158 >
1240 IFZERO CPU-2 <  T1+180 >
1241 OCTAL>
1242         TAD     (2000
1243         DCA I   AXA     /LOW FREQUENCY
1244         DCA I   AXA     /NO SPIKES
1245 NEXT2,  STA
1246         DCA I   AXA     /KEEP SIMULTANEOUS NOTES
1247 IFDEF WOW <DECIMAL
1248         JMS     DOIT    /IN PHASE
1249 IFZERO CPU-1 <  T1+T2+12 >
1250 IFZERO CPU-2 <  T1+T2+15 >
1251 OCTAL>
1252         JMS I   [GET    /GET DURATION
1253         SNA CLA
1254         JMP     NEXHOL  /IT'S A LONG ONE
1255 IFDEF WOW <DECIMAL
1256         JMS     DOIT
1257 IFZERO CPU-1 <  T1+2678 >
1258 IFZERO CPU-2 <  T1+3135 >
1259 OCTAL>
1260         TAD     CHAR    /NOW WE WANT TO MULTIPLY DURATION
1261 IFNZRO CPU-4 <BSW>
1262 IFZERO CPU-4 <
1263         CLL RTL         /BY LENGTH OF A "G" IN
1264         RTL             /HOSAVE,LOSAVE (IN UNITS OF A
1265         RTL >           /6.4 MICROSECOND)
1266         DCA     WSB
1267         TAD     (-6
1268         DCA     WSA
1269         DCA     LOTIM
1270         DCA     HOTIM
1271         JMP     NEXLUP
1272 /NOW WE'RE ALL SET TO MULTIPLY
1273 NEXSH,  TAD     LOTIM
1274         CLL RAL
1275         DCA     LOTIM
1276         TAD     HOTIM
1277         RAL
1278         DCA     HOTIM
1279 NEXLUP, TAD     WSB
1280         RAL
1281         DCA     WSB     /BIT OF MULTIPLIER IN L
1282         SNL
1283         JMP     NEXNO2  /NO ADDING TO DO
1284         TAD     LOSAVE
1285         TAD     LOTIM
1286         DCA     LOTIM
1287         CML RAL         /REMEMBER CARRY!
1288         TAD     HOSAVE
1289         TAD     HOTIM
1290         DCA     HOTIM
1291 IFNDEF WOW <NEXNO2,>
1292 NEXNO,  ISZ     WSA
1293         JMP     NEXSH
1294         JMP     NEXINI  /DONE MULTIPLYING
1295 IFDEF WOW <
1296 NEXNO2, TAD             /WASTE TIME
1297         DCA
1298         TAD
1299         DCA
1300         AND I   AXA     /NEED AUTO-INDEX FOR EXTRA .2US
1301         JMP     NEXNO
1302 >
1303
1304 NEXHOL,
1305 IFDEF WOW <DECIMAL
1306         JMS     DOIT    /HOLD FOR 64 "G"S
1307 IFZERO CPU-1 <  T1+270 >
1308 IFZERO CPU-2 <  T1+315 >
1309 OCTAL>
1310         TAD     LOLONG
1311         DCA     LOTIM
1312         TAD     HOLONG
1313         DCA     HOTIM
1314 NEXINI, TAD     AR      /REMEMBER HOW MANY
1315         TAD     BR      /SPIKES IN ALL
1316         TAD     CR
1317         TAD     DR
1318 IFDEF WOW <CIA>
1319 IFNDEF WOW <CMA>
1320         DCA     RTOT
1321 IFNDEF WOW <
1322         KRB             /WHAT WAS THE LAST CHARACTER TYPED?
1323         AND     (177    /MASK PARITY
1324         TAD     (-3     /CHECK FOR CTRL/C
1325         SNA             /IS IT?
1326 IFZERO OS8-10 < JMP I [7600 >   /YES, RETURN TO MONITOR
1327 IFNZRO OS8-10 < JMP START>      /YES, READ ANOTHER TAPE
1328         TAD     ("C-"Q
1329         SNA CLA         /IS IT A CTRL/Q?
1330 IFZERO OS8-10 < JMP DOEND2 >    /YES, GO TO NEXT PIECE
1331 IFNZRO OS8-10 < JMP START  >    /YES, GO TO READ ANOTHER TAPE
1332 >
1333         JMP     PLAY2   /AND GO PLAY!
1334
1335 PAGE
1336 \f
1337 DIVP=LOLONG
1338 DIVM=HOLONG
1339
1340 /GIVEN THE DESIRED SPEED (12 BITS) AND
1341 /(HOFUDG,LOFUDG) (24 BITS), CALCULATE
1342 /HOW LONG A "G" IS (24 BITS) AND PUT
1343 /IT IN (HOSAVE,LOSAVE)
1344 DOMETE,
1345 IFDEF WOW <DECIMAL
1346         JMS     DOIT
1347 IFZERO CPU-1 <  T1+T2+T2+232 >
1348 IFZERO CPU-2 <  T1+T2+T2+270 >
1349 OCTAL >
1350         JMS I   [GET
1351 IFNZRO CPU-4 <BSW>
1352 IFZERO CPU-4<
1353         CLL RTL
1354         RTL
1355         RTL >
1356         DCA     DIVP
1357         JMS I   [GET    /GET RIGHT HALF
1358         TAD     DIVP
1359 DOM1,   DCA     DIVP
1360         TAD     DIVP
1361         CIA
1362         DCA     DIVM    /- LENGTH
1363         TAD     HOFUDG
1364         DCA     LOTIM
1365         DCA     HOTIM
1366 IFDEF WOW <DECIMAL
1367         JMS     DOIT
1368 IFZERO CPU-1 <  T1+T3+78 >
1369 IFZERO CPU-2 <  T1+T3+90 >
1370 OCTAL >
1371         JMS     DIV     /DIVIDE
1372         DCA     HOSAVE
1373         TAD     LOFUDG
1374         DCA     LOTIM
1375 IFDEF WOW <DECIMAL
1376         JMS     DOIT
1377 IFZERO CPU-1 <  T1+T3+26 >
1378 IFZERO CPU-2 <  T1+T3+30 >
1379 OCTAL>
1380         JMS     DIV     /DIVIDE LO
1381         DCA     LOSAVE
1382 IFDEF WOW <DECIMAL
1383         JMS     DOIT
1384 IFZERO CPU-1 <  T1+1124 >
1385 IFZERO CPU-2 <  T1+1320 >
1386 OCTAL>
1387         TAD     (-6
1388         DCA     WSA     /WE MUST NOW SHIFT IT 6
1389         TAD     HOSAVE  /PLACES TO THE LEFT
1390         DCA     HOLONG  /FOR LONG NOTES
1391         TAD     LOSAVE
1392         SKP
1393 DOM2,   TAD     LOLONG
1394         CLL RAL
1395         DCA     LOLONG
1396         TAD     HOLONG
1397         RAL
1398         DCA     HOLONG
1399         ISZ     WSA
1400         JMP     DOM2
1401         JMP I   [NEXT
1402
1403
1404 DIV,    0               /HOTIM,LOTIM/DIVP(DIVM)
1405         TAD     (-15    /REM IN HOTIM, QUO IN LOTIM
1406         DCA     WSA     /SET UP DIVIDE COUNT
1407         JMP     DIVB    /AND GO DO IT
1408
1409 DIVA,   RAL             /SHIFT DIVIDEND
1410 IFDEF WOW <     NOP >           /FOR TIMING
1411         TAD     DIVM    /MINUS DIVISOR
1412         DCA     HOTIM
1413         SNL             /DID WE OVER-SUBTRACT?
1414         JMP     DIVD    /YES, WE'LL START ADDING DIVISOR
1415 IFDEF WOW <     NOP >           /FOR TIMING
1416 DIVB,   TAD     LOTIM   /SHIFT DIVIDEND
1417         CML RAL
1418         DCA     LOTIM
1419         TAD     HOTIM
1420         ISZ     WSA     /ARE WE THROUGH?
1421         JMP     DIVA    /NO, CONTINUE SUBTRACTING
1422         DCA     HOTIM   /SAVE REMAINDER
1423 IFDEF WOW<AND>
1424         TAD     LOTIM   /GET QUOTIENT
1425         JMP I   DIV     /AND RETURN
1426
1427 DIVC,   RAL             /SHIFT DIVIDEND
1428         CML             /MAKE IT WORK
1429         TAD     DIVP    /POSITIVE DIVISOR
1430         DCA     HOTIM
1431         SZL             /HAVE WE ADDED ENOUGH?
1432         JMP     DIVB    /YES, GO SUBTRACT FOR A WHILE
1433 IFDEF WOW <     NOP >           /FOR TIMING
1434 DIVD,   TAD     LOTIM   /SHIFT DIVIDEND
1435         CML RAL
1436         DCA     LOTIM
1437         TAD     HOTIM
1438         ISZ     WSA     /ARE WE THROUGH?
1439         JMP     DIVC    /NO, GO ADD SOME MORE
1440         TAD     DIVP    /YES, CORRECT REMAINDER
1441         DCA     HOTIM   /AND SAVE IT
1442         TAD     LOTIM   /GET QUOTIENT
1443         JMP I   DIV     /AND RETURN
1444
1445 DOTRAN,
1446 IFDEF WOW <DECIMAL
1447         JMS     DOIT    /DO TRANSPOSE
1448 IFZERO CPU-1 <  T1+128 >
1449 IFZERO CPU-2 <  T1+150 >
1450 OCTAL>
1451         TAD     CHAR
1452         AND     (70
1453         TAD     (BFR1
1454         DCA     TRAN
1455         JMP I   [NEXT
1456
1457 /GET A BYTE FROM THE INFO BUFFER
1458 GET,    0
1459 IFNZRO CORE-100 <
1460 GETCDF, CDF     00      >
1461         TAD I   GETPTR
1462 IFNZRO CORE-100 <CDF>
1463         ISZ     FLG
1464         JMP     GETL
1465         ISZ     GETPTR
1466         AND     [77
1467         DCA     CHAR
1468 IFDEF WOW <
1469         NOP
1470         NOP
1471 >
1472         JMP     GET2
1473
1474 GETL,
1475 IFNZRO CPU-4<   BSW >
1476 IFZERO CPU-4 <
1477         RTR
1478         RTR
1479         RTR
1480 >
1481         AND     [77
1482         DCA     CHAR
1483         STA
1484         DCA     FLG
1485 GET2,   TAD     CHAR
1486         JMP I   GET
1487
1488 PAGE
1489 \f
1490 /THE FIRST TASK IS TO FIGURE OUT WHICH NOTE
1491 /WILL BE NEXT TO FINISH ONE CYCLE.
1492 PLAYIT,
1493 IFDEF WOW <DECIMAL
1494         JMS     DOIT
1495 IFZERO CPU-1 <  T1+1128 >
1496 IFZERO CPU-2 <  T1+1335 >
1497 OCTAL>
1498         TAD     AT
1499         CIA CLL
1500         TAD     BT
1501         SZL
1502         CLA SKP
1503         CIA
1504         TAD     BT
1505         CIA CLL
1506         TAD     CT
1507         SZL
1508         CLA SKP
1509         CIA
1510         TAD     CT
1511         CIA CLL
1512         TAD     DT
1513         SZL
1514         CLA SKP
1515         CIA
1516         TAD     DT
1517         CIA CLL
1518         DCA     SAVE
1519
1520 /WELL, WE DON'T REALLY KNOW WHICH ONE, BUT
1521 /WE DO KNOW HOW LONG IT IS.  SO WE MOVE UP
1522 /ALL FOUR COUNTERS, RESETTING ANY WHICH
1523 /REACH ZERO, AND REMEMBERING HOW MANY
1524 /SPIKES WE SHOULD DO.
1525         TAD     RTOT
1526 IFZERO CPU-4    <DCA SAVS>
1527 IFNZRO CPU-4    <MQL>
1528         TAD     AT
1529         TAD     SAVE
1530         SNA
1531         JMP     DELA
1532         DCA     AT
1533 IFNZRO CPU-4 <
1534         MQA
1535         TAD     AR
1536         MQL >
1537 IFZERO CPU-4 <
1538         TAD     SAVS
1539         TAD     AR
1540         DCA     SAVS >
1541
1542 RA,     TAD     BT
1543         TAD     SAVE
1544         SNA
1545         JMP     DELB
1546         DCA     BT
1547 IFNZRO CPU-4 <
1548         MQA
1549         TAD     BR
1550         MQL >
1551 IFZERO CPU-4 <
1552         TAD     SAVS
1553         TAD     BR
1554         DCA     SAVS >
1555
1556 RB,     TAD     CT
1557         TAD     SAVE
1558         SNA
1559         JMP     DELC
1560         DCA     CT
1561 IFNZRO CPU-4 <
1562         MQA
1563         TAD     CR
1564         MQL >
1565 IFZERO CPU-4 <
1566         TAD     SAVS
1567         TAD     CR
1568         DCA     SAVS>
1569
1570 RC,     TAD     DT
1571         TAD     SAVE
1572         SNA
1573         JMP     DELD
1574         DCA     DT
1575 IFNZRO CPU-4 <
1576         MQA
1577         TAD     DR
1578         MQL >
1579 IFZERO CPU-4 <
1580         TAD     SAVS
1581         TAD     DR
1582         DCA     SAVS >
1583 RD,     IFNZRO CPU-4 <
1584         MQA
1585         DCA     SAVS >
1586
1587 /AND NOW FOR A BUNCH OF FUNNY CALCULATIONS.
1588 /HOLD ON TO YOUR HAT....
1589         TAD     SAVE    /HOW MANY SPIKES THIS TIME
1590         CLL
1591         TAD     LOTIM
1592         DCA     LOTIM   /UPDATE NOTE LENGTH
1593         SNL
1594         AND             /TIMING CORRECTOR
1595         SZL
1596         ISZ     HOTIM   /UPDATE HIGH ORDER
1597         SKP
1598         JMP I   [NEXT   /FINISHED WITH THIS NOTE
1599 IFDEF WOW <DECIMAL
1600         NOP
1601 PLAY2,  JMS     DOIT
1602 IFZERO CPU-1 <  T1+216 >
1603 IFZERO CPU-2 <  T1+255 >
1604 OCTAL >
1605 IFNDEF WOW <
1606         IAC
1607 PLAY2,  >
1608         TAD     OLDE    /CORRECTION FACTOR FROM LAST TIME
1609         TAD     FIX     /HOW LONG IT IS THRU "DOIT"
1610         TAD     SAVS    /AND HOW MANY SPIKES WE HAVE
1611         SPA
1612         STL
1613         SMA             /SET UP LINK FOR +/-
1614         CLL
1615         TAD     SAVE
1616         SZL             /DO WE HAVE TIME?
1617         JMP     TRYAGN  /NO
1618
1619 IFDEF WOW <
1620 /WE HAVE BEEN DEALING IN UNITS OF 6.4US.
1621 /NOW WE CONVERT IT TO UNITS OF .1US
1622 /BY MULTIPLYING BY 64 (SHIFT 6 PLACES)
1623         CIA
1624         TAD     [7700
1625         DCA     WSA
1626 DECIMAL
1627         JMS     DOIT
1628 IFZERO CPU-1 <  T1+674 >
1629 IFZERO CPU-2 <  T1+810 >
1630 OCTAL
1631         TAD     WSA
1632         BSW
1633         MQL
1634         MQA
1635         AND     [7700   /JUST LOW ORDER BYTE*64
1636         DCA     WSA
1637         JMP     SAVIT
1638
1639 /SINCE THERE ISN'T ENOUGH TIME BETWEEN SETS OF
1640 /SPIKES TO GET AROUND DOIT, WE CAN'T DO THEM
1641 /AT THE RIGHT TIME.
1642 TRYAGN, TAD     (+TIM6
1643         DCA     OLDE    /SAVE RETRY FUDGE
1644 DECIMAL
1645         JMS     DOIT
1646 IFZERO CPU-1 <  T1+268 >
1647 IFZERO CPU-2 <  T1+315 >
1648 OCTAL
1649 /NOW PUT THE EXTRA SPIKES ALONG WITH
1650 /THE PREVIOUS BATCH
1651         TAD     AXB
1652         DCA     WSA
1653         TAD     SAVS
1654         CDF     10
1655         TAD I   WSA
1656         DCA I   WSA
1657         TAD     SAVS
1658         CDF
1659         TAD     OLDS
1660         DCA     OLDS
1661         JMP     PLAYIT
1662 >
1663 IFNDEF WOW <
1664         CMA
1665         DCA     SAVE
1666 IFNZRO CPU-1 <NOP>
1667 IFZERO CPU-1 <AND>
1668         ISZ     SAVE
1669         JMP     .-2
1670 TRYAGN, DCA     OLDE
1671         SKP
1672 NOISA,  NOISE
1673 IFZERO CPU-1 <NOP>
1674         ISZ     SAVS
1675 IFNZRO CPU-1 <JMP .-2>
1676 IFZERO CPU-1 <JMP .-3>
1677         JMP     PLAYIT
1678 >
1679
1680
1681 DELA,   TAD     AC
1682         DCA     AT
1683 IFZERO CPU-4 <AND>
1684         JMP     RA
1685 DELB,   TAD     BC
1686         DCA     BT
1687 IFZERO CPU-4 <AND>
1688         JMP     RB
1689 DELC,   TAD     CC
1690         DCA     CT
1691 IFZERO CPU-4 <AND>
1692         JMP     RC
1693 DELD,   TAD     DC
1694         DCA     DT
1695 IFZERO CPU-4 <AND>
1696         JMP     RD
1697
1698 PAGE
1699 \f
1700 SPECIA, TAD     XJMPT   /JUMP TO SPECIAL ROUTINE
1701         DCA     AXA
1702         TAD I   AXA
1703         DCA     WSA
1704         JMP I   WSA
1705
1706 SETN,
1707 IFDEF WOW <DECIMAL
1708         JMS     DOIT    /SET NOTE
1709 IFZERO CPU-1 <  T1+T2+488 >
1710 IFZERO CPU-2 <  T1+T2+570 >
1711 OCTAL>
1712         STA             /REMEMBER NO MORE NOTES NOW
1713 IFNDEF WOW <SETNM, >
1714 SETN2,  DCA     WSB
1715         JMS I   [GET    /GET PITCH
1716         TAD     TRAN
1717         DCA     WSA
1718         TAD I   WSA     /PERIOD IN UNITS OF 6.4 US
1719         DCA I   AXA
1720         LAS             /CHECK LOUDNESS
1721         CMA
1722         AND     [77
1723         TAD     WSA     /LOWER NOTES NEED EMPHASIS
1724         CLL RAR
1725         TAD     XB
1726         DCA     WSA
1727         TAD I   WSA     /HOW MANY SPIKES?
1728         DCA I   AXA
1729         ISZ     WSB     /CHECK FLAG
1730         JMP I   XNEXT1
1731         JMP I   XNEXT2
1732
1733 IFDEF WOW < DECIMAL
1734 SETNM,  JMS     DOIT
1735 IFZERO CPU-1 <  T1+T2+488 >
1736 IFZERO CPU-2 <  T1+T2+570 >
1737         JMP     SETN2
1738 OCTAL>
1739
1740 IFZERO CORE-100 <DOFLD, >
1741 ERR0,   HLT             /PROGRAM BUG
1742
1743 DOEND,
1744 IFDEF WOW < DECIMAL
1745         JMS     DOIT    /WE'RE AT THE END!
1746 IFZERO CPU-1 <  T1+114 >
1747 IFZERO CPU-2 <  T1+135 >
1748 OCTAL
1749         TAD     BUFGET  /WE MUST WAIT FOR THE
1750         CIA             /END OF THE MUSIC TO PLAY
1751         TAD     AXB
1752         AND     X7760
1753         SZA CLA
1754         JMP     DOEND
1755 >
1756         LAS
1757         SPA CLA         /REPEAT?
1758         JMP I   [PLAY   /YES
1759 DOEND2,
1760 IFZERO OS8-10 <
1761 IFDEF WOW <
1762         JMS I   [RESTOR >       /RESTORE TOP PAGE OF FIELD 1
1763         JMS I   XINNEWF /IS THERE ANOTHER INPUT FILE?
1764         SKP
1765         JMP I   XST1    /YES, PLAY IT
1766         CDF     10
1767         TAD I   X7642   /ALT-MODE FLAG?
1768         CDF
1769         SPA CLA
1770         JMP I   [7600   /RETURN TO MONITOR
1771 >
1772         JMP I   [START  /RETURN TO COMMAND DECODER
1773
1774 IFNZRO CORE-100 <
1775 /CHANGE TO A NEW FIELD FOR INPUT INFO
1776 DOFLD,
1777 IFDEF WOW < DECIMAL
1778         JMS     DOIT
1779 IFZERO CPU-1 <  T1+168 >
1780 IFZERO CPU-2 <  T1+195 >
1781 OCTAL >
1782         ISZ     BUFTAB
1783         TAD I   BUFTAB  /GET NEW FIELD
1784         DCA I   XGETCDF /SAVE IT
1785         DCA     FLG     /RESET PACKING FLAG
1786         DCA     GETPTR  /START AT ADDRESS 0
1787         JMP I   [NEXT
1788 XGETCD, GETCDF
1789 >
1790 XA=BFR1%2
1791 XB,     BFR2-XA
1792 XJMPT,  JMPTB2-1
1793 XNEXT1, NEXT1
1794 XNEXT2, NEXT2
1795 IFZERO OS8-10 <
1796 XINNEW, INNEWF
1797 XST1,   START1
1798 X7642,  7642
1799 >
1800 IFDEF WOW <
1801 X7760,  7760
1802 SAVIT,  TAD     OLDS    /CORRECT: SPIKES TAKE
1803         TAD     SAVS    /6.2US, NOT 6.4 US, AND
1804 IFZERO CPU-2 <CLL RAL >
1805         TAD     FUDGE   /DOIT DOESN'T REALLY TAKE
1806         CLL RAL         /TIM6*6.4US
1807         TAD     WSA
1808         CDF     10
1809         DCA I   AXB     /SAVE LOW ORDER
1810         TAD     [7700
1811         MQA             /NOW WE HAVE HIGH ORDER
1812         SZL             /BYTE ON RIGHT SIDE OF AC
1813         NOP
1814         SNL
1815         IAC             /BORROW FROM LOW ORDER?
1816         DCA I   AXB     /SAVE AWAY HIGH ORDER
1817         STA
1818         TAD     SAVS
1819         DCA I   AXB     /SAVE NO. OF SPIKES
1820         CDF
1821         DCA     OLDS    /RESET RETRY COUNTERS
1822         DCA     OLDE
1823 WAIT1,  CLL STA RTL
1824         TAD     BUFGET
1825         CIA
1826         TAD     AXB
1827         SZA CLA         /BUFFER FULL?
1828         JMP I   [PLAYIT /NO
1829         MQL             /ZERO TO MQ FOR SHOW
1830         NOP
1831 DECIMAL
1832         JMS     DOIT
1833 IFZERO CPU-1 <  T1+238 >
1834 IFZERO CPU-2 <  T1+285 >
1835 OCTAL
1836         KRB             /LAST CHARACTER TYPED?
1837         AND     C1      /MASK PARITY
1838         TAD     C2      /CTRL/C?
1839         SNA
1840         JMP     WAIT2   /YES
1841         TAD     C4      /CTRL/Q?
1842         SNA CLA
1843         JMP I   C5      /YES, NEXT INPUT
1844         JMP     WAIT1
1845 WAIT2,
1846 IFZERO OS8-10 <
1847         JMS I   [RESTOR >       /RESTORE TOP OF FIELD 1
1848         JMP I   C3      /JUMP OUT
1849
1850 C1,     177
1851 C2,     -"C+300
1852 C3,
1853 IFZERO OS8-10 <7600>
1854 IFNZRO OS8-10 <START>
1855 C4,     "C-"Q
1856 C5,
1857 IFZERO OS8-10 <DOEND2>
1858 IFNZRO OS8-10 <START>
1859 IFZERO CPU-1 <
1860 FUDGE,  -2      /HALF OF 4
1861 >
1862 IFZERO CPU-2 <
1863 FUDGE,  -33     /ABOUT HALF OF 55
1864 >>
1865 \f
1866 BRANA,  -"#     ;KEYS           /DEFINE SHARP
1867         -"!     ;KEYF           /DEFINE FLATS
1868         -"V     ;DEFV
1869         -"Y     ;DEFY
1870         -"T     ;DEFT
1871         -215    ;START2
1872         -212    ;NEXLIN
1873         -";     ;START2
1874         -"$     ;ENDM           /END MUSIC
1875 BRANB,  -"G     ;LENG
1876         -"D     ;LEND
1877         -"S     ;LENS
1878         -"Q     ;LENQ
1879         -"C     ;LENC
1880         -"M     ;LENM
1881         -"B     ;LENB
1882         -"3     ;TRIPLET
1883         0       ;BADLINE
1884
1885 BRANC,  -";     ;PROB
1886         -215    ;PROB
1887         0       ;DEFV+1
1888
1889 BRAND,  -"=     ;DEFM
1890         -"(     ;DEFCHORD
1891         -"T     ;TIE
1892         -"-     ;MINUS
1893         -".     ;DOT
1894         0       ;BADLINE
1895
1896 BRANE,  -""     ;ACCN
1897         -"#     ;ACCS
1898         -"!     ;ACCF
1899 BRANF,  -"+     ;OCTUP
1900         -"-     ;OCTDN
1901         -",     ;PRODUCE
1902         -";     ;SPRODUCE
1903         -215    ;SPRODUCE
1904         -")     ;PPRODUCE
1905         0       ;BADLINE
1906
1907 BRANG,  -",     ;PRODUCE
1908         -";     ;PRODUCE
1909         -215    ;PRODUCE
1910         0       ;BADLINE
1911
1912
1913 KEYTAB, ZBLOCK  10
1914
1915 DECO9,  DECIMAL;-1000;-100;-10;-1;0;OCTAL
1916
1917 /TABLE: WHERE ARE THE WHITE KEYS, A THROUGH G?
1918 BASTAB, 36;40;41;43;45;46;50
1919 \f
1920 /TABLE OF BUFFER AREAS
1921 BUFTBL, MUSBUF
1922 IFZERO OS8-10 < MARGIN-INBUF>
1923 IFZERO OS8-20 < MARGIN-7600  >
1924 IFNZRO CORE-100 <
1925         CDF 00
1926 IFNDEF WOW<
1927         MARGIN-7600
1928         CDF     10>
1929         MARGIN-7600
1930         CDF     20
1931 CORTAB=.
1932         MARGIN-7600
1933         CDF     30
1934         MARGIN-7600
1935         CDF     40
1936         MARGIN-7600
1937         CDF     50
1938         MARGIN-7600
1939         CDF     60
1940         MARGIN-7600
1941         CDF     70
1942         0
1943 >
1944 *.+1&7776
1945 BFR1,
1946 DECIMAL
1947
1948 IFNZRO T64 <
1949
1950 /PERIOD OF NOTES IN UNITS OF 6.4US
1951 /USING EQUAL TEMPERAMENT
1952 -4018;-3792;-3579;-3378;-3189;-3010
1953 /A--
1954 -2841;-2681;-2531;-2389;-2255;-2128
1955 -2009;-1896;-1790;-1689;-1594;-1505
1956 /A-
1957 -1420;-1341;-1265;-1194;-1127;-1064
1958 -1004;-948;-895;-845;-797;-752
1959 /A
1960 -710;-670;-633;-597;-564;-532;-502;-474;-447;-422;-399;-376
1961 /A+
1962 -355;-335;-316;-299;-282;-266;-251;-237;-224;-211;-199;-188
1963 /A++
1964 -178;-168;-158;-149;-141;-133;-126;-119;-112;-106;-100;-94
1965 /A+++
1966 -89;-84;-79;-75;-70;-67;-63;-59;-56;-53;-50;-47
1967 -44     /A++++!!
1968 >
1969 IFZERO T64 <
1970 /PERIOD OF NOTES IN 6.0 MICROSECOND UNITS
1971 /USING EQUAL TEMPERAMENT
1972
1973 -2143;-4045;-3818;-3604;-3401;-3210
1974 /A--
1975 -3030;-2860;-2700;-2548;-2405;-2270
1976 -2143;-2022;-1909;-1802;-1701;-1605
1977 /A-
1978 -1515;-1430;-1350;-1274;-1203;-1135
1979 -1071;-1011;-954;-901;-850;-803
1980 /A
1981 -758;-715;-675;-637;-601;-568
1982 -536;-506;-477;-450;-425;-401
1983 /A+=A440
1984 -379;-358;-337;-319;-301;-284
1985 -268;-253;-239;-225;-213;-201
1986 /A++
1987 -189;-179;-169;-159;-150;-142
1988 -134;-126;-119;-113;-106;-100
1989 /A+++
1990 -95;-89;-84;-80;-75;-71
1991 -67;-63;-60;-56;-53;-50
1992 -47     /A++++!!!
1993 >
1994 /NUMBER OF PULSES GENERATED DETERMINE LOUDNESS
1995 BFR2,
1996 104;97;91;84;79;74;69
1997 64;60;56;52;48;45;42;39
1998 37;34;32;30;28;26;24;23
1999 21;20;18;17;16;15;14;13
2000 12;11;10;9;9;8;8;7
2001 7;6;6;6;5;5;5;4
2002 4;4;3;3;3;3;3;2
2003 2;2;2;2;2;2;2;1
2004 1;1;1;1;1;1;1;1
2005 OCTAL
2006 \f
2007 JMPTAB, REST
2008         RESTM
2009         SETN
2010         SETNM
2011         ERR0
2012         ERR0
2013         ERR0
2014         ERR0
2015
2016 JMPTB2, DOEND
2017         NEXHOL
2018         DOMETER
2019         DOTRANSPOSE
2020         ERR0;ERR0
2021         DOFLD
2022         DOTRANSPOSE;
2023         ERR0;ERR0;ERR0;DOTRANSPOSE
2024         ERR0;ERR0;ERR0;DOTRANSPOSE
2025         ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0
2026         ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0
2027 NOPUNCH
2028 LINBUF, ZBLOCK 100      /SAVE INPUT TO PRINT ERROR MESSAGE
2029 MUSBUF=.                /BEGINNING OF MUSIC BUFFER
2030 IFZERO OS8-10 <
2031 *6600
2032 IFDEF WOW < SAVBUF, >   /SAVE FOR TOP OF FIELD 1
2033 INBUF,  ZBLOCK 400      /OS/8 I/O BUFFER
2034 INDEVH, ZBLOCK 400      /OS/8 DEVICE HANDLER SPACE
2035 >
2036 ENPUNCH
2037 \f
2038 IFNZRO  CORE-100 <      /INITIALIZATION CODE
2039 *LINBUF+177&7600
2040 INIT,   0
2041 COR0,   CDF     0
2042         TAD     CORSIZ
2043         RTL
2044         RAL
2045         AND     COR70
2046         TAD     COREX   /MAKE CDF FOR FIELD
2047         DCA     .+1     /TO BE TESTED
2048 COR1,   CDF     .-.
2049         TAD I   CORLOC
2050 COR2,   NOP
2051         DCA     COR1
2052         TAD     COR2
2053         DCA I   CORLOC
2054 COR70,  70
2055         TAD I   CORLOC
2056 CORX,   7400
2057         TAD     CORX
2058         TAD     CORV
2059         SZA CLA
2060         JMP     COREX
2061         TAD     COR1
2062         DCA I   CORLOC
2063         ISZ     CORSIZ
2064         JMP     COR0
2065
2066 CORLOC, CORX
2067 CORV,   1400
2068 CORSIZ, 1
2069 COREX,  CDF     00
2070
2071 IFZERO OS8-10 <
2072         TAD I   BATFLG
2073         AND     COR70   /ARE WE RESTRICTED IN CORE?
2074         CLL RTR
2075         SZA
2076         JMP     .+4>    /YES, IGNORE ACTUAL CORE SIZE
2077         STA
2078         TAD     CORSIZ  /TOP FIELD
2079         CLL RAL
2080         TAD     CORTBA
2081         DCA     WSA
2082 IFZERO OS8-10 <
2083         TAD I   BATFLG  /ARE WE RUNNING UNDER BATCH?
2084         RTL
2085         SNL CLA
2086         JMP     COR3    /NO, OK
2087         TAD     BATPRO  /YES, DON'T WIPE OUT MONITOR
2088         DCA I   WSA
2089 >
2090 COR3,   ISZ     WSA
2091         ISZ     WSA
2092         DCA I   WSA     /DON'T USE FIRST NONEXISTANT FIELD
2093         TAD     COR2    /NOP
2094         DCA I   CORINA  /DON'T RETURN HERE
2095 IFDEF WOW <
2096         STA
2097         TAD     CORSIZ
2098         SPA SNA CLA
2099         HLT             /NOT ENOUGH CORE!!
2100 >
2101         JMP I   INIT
2102
2103 CORINA, CORINI
2104 BATFLG, 7777
2105 CORTBA, CORTAB-6
2106 BATPRO, MARGIN-5000
2107 >
2108 $