harmony compiler phase 1 : 5/21/63 /Form A-31276490732-3b/21 / retyped 060321 0/ /macros 1/6/62 (as amended by Acts of 1/15/62 and 4/30/62) define load A lac A termin define store A dac A termin define addi A add A termin define goto T jmp T termin define govia P jmp i P termin define subt A sub A termin define zero A dzm A termin define step1 J idx J termin define call S jda S termin define band U and U termin define halt hlt termin define clear cla termin define comple cma termin define halve sar 1s termin define x2to1 ral 1s termin define x2to6 ral 6s termin define x2to7 ral 7s termin define x2to3 ral 3s termin define exit P jmp termin define move A,B lac A dac B termin define sett A,B lac (B dac A termin define trze T sza i jmp T termin define trnz T sza jmp T termin define trpl T sma jmp T termin define trmi T spa jmp T termin define trel A,T sad A jmp T termin define trnl A,T sas A jmp T termin define write P law P jda wr termin define type Q lio Q tyo termin define ftrel A,T trel A,T termin define compla U lac (U jda er termin define error U lac (U jda er1 termin define lookup V add (V dap .+1 lac termin define feed N law i N jda fee termin define step J,I lac J add I dac J termin define stepa J,I law I add J dac J termin define istepa J,I law i I add J dac J termin define grow A,V,C lac A add (V dac C termin define tles C,T sub C spa jmp T termin define tlesc C,T sub (C spa jmp T termin define tgrel C,T sub C sma jmp T termin define tgrec C,T sub (C sma+sza-skp jmp T termin define test0 Y,Z lac Y sza i jmp Z termin define test1 Y,Z lac Y sza jmp Z termin define testp Y,Z lac Y sma jmp Z termin define testm Y,Z lac Y spa jmp Z termin define testel Y,Z,A lac Y sad Z jmp A termin define testnl Y,Z,A lac Y sas Z jmp A termin define halfof V lac V sar 1s dac V termin define double Q lac Q ral 1s dac Q termin define dispat U add (U dap .+1 jmp i termin define diswit L,U add (U dap .+2 lac L jmp i termin define putback U,Q add (U dap .+2 lac Q dac termin define answer X 0 dap X lac .-2 termin define x10dec ral 1s dac t1 ral 2s add t1 termin define copy H,I,N law H dap .+3 law I dap .+2 lac dac idx .-2 idx .-2 sas (dac I+N jmp .-5 termin define search W,N,ERR dac t1 law W dap .+2 lac t1 sad jmp .+5 idx .-2 sas (sad W+N jmp .-5 jmp ERR lac .-6 add (-sad-W termin define print F lac F rcl 6s tyo rcl 6s tyo rcl 6s tyo termin /wr, rp, fee, ppp, rpr wr, 0 dap wre wr1, print i wre idx wre sas wr jmp wr1 wrx, jmp i wre wre, 0 rpr, 0 rrb rpa-i dap .+1 jmp rp, 0 dap rtx rt2, cks ril 1s spi i jmp rt2 rrb rpa-i dio t1 rcr 7s spa jmp rt2 law 1000 add t1 dap .+2 law 2525 670000 /rar sma jmp rtb law 77 and t1 sad (77 cla sad (36 cla sad (13 jmp rt2 rtx, jmp rtb, lac t1 sza hlt jmp rt2 fee, 0 dap fex cli lat and (700 sad (700 jmp fex ppa isp fee jmp .-2 fex, jmp ppp, 0 dap pup lio ppp lat and (700 sad (700 jmp pup ppb ril 6s ppb ril 6s ppb pup, jmp /ap, cr, sbc, snl, rfcw, rrc, rch, er, er1, red, blk, eh u, halt ap, zero lmb call rpr sett bc, -1 store nl sett mjp, -2 pf, sett ft, fb pg, call rp /read title store chr load ft putback f, chr testnl chr, (21, pg1 xp, sett pfu, pfr sett emp, fb sett tc, -1 goto erf pg1, step1 ft trnl (fl, pg hap, goto rrz pfr, zero 1u zero 3u sett irl, -1 zero tll zero ft sett fi, 1 store sid zero rob zero gi zero gis zero ao zero tc zero mm zero ss sett rb, 1 store tbc sett tim, -1 sett st, 26 goto pum /copies nt to kt to mt, goes to s1 cr, answer crx type (77 crx, exit cr sbc, answer sbx step1 tbc step1 bc addi nl tgrec all, s3x load bc complement sbx, exit sbc snl, answer swx step1 nl addi bc tgrec all, s3x load nl swx, exit snl rcw, answer rwx load fi rwx, exit rcw rrc, answer rrx move fl2, fi store fl1 rrx, exit rrc rch, answer rcx load ft tgrel fi, rcf sett mbh, fb store fi store ft store fl1 store fl2 sett bgs, 1 rcy, call rp /read body store ch trnl (74, rcc rcu, call rp /read comment trnl (72, rcu goto rcy rcc, load ch trze rc1 trel (21, rc1 clear goto rc2 rc1, load (1 rc2, store pp load ft putback f, ch step1 ft tlesc fw, rcs load ft tlesc fl, rce goto rrz rce, load ch trel (21, rfc rcs, load bgs diswith ch, rdt rdt, rd0 rd1 rd2 rd3 rd4 rd0, trze rda trnl (21, rdp rda, sett bgs, 1 goto rcy rd1, trnl (65, rdp sett bgs, 2 goto rcy rd2, trnl (45, rdp sett bgs, 3 goto rcy rd3, trnl (64, rdp sett bgs, 4 goto rcy rd4, trze rfc trel (1, rfc rdp, move pp, bgs goto rcy rfc, istepa ft, 1 rcf, load fi lookup f store ch step1 fi load ch trze rf1 trel (21, rf1 move fl1, fl2 goto rff rf1, move fi, fl1 rff, load ch rcx, exit rch /error er, answer erx store arg sett uin, 1 goto erc er1, answer ery store arg sett uin, -1 erc, sett pfu, ec3 ert, load mjp tgrec -2, erq call red write erq text / To err is human---to forgive, divine. / erq, call blk testnl mjp, bc, erk testel tjp, tc, ec erk, move mbh, emp erf, zero blc sett etc, 1 load emp err, lookup f store chy trze et1 trel (21, ec0 type chy goto etr et1, setp1 etc subt tc trze et2 trnl (1, et4 call blk goto et4 et2, call red et4, load blc tlesc 100, ets call cr zero blc goto eti ets, type (0 etr, step1 blc eti, step1 emp goto err ec0, call blk type (21 call cr ec, govia pfu ec3, type (36 testp uin, ec1 call red ec1, print arg call blk ec2, call cr move bc, mjp move tc, tjp testp uin, erx ery, exit er1 erx, exit er /red, black, eh red, answer rex testm rb, rex type (35 sett rb, -1 rex, exit red blk, answer blx testp rb, blx type (34 sett rb, +1 blx, exit blk s1y, s1z, error flexo tmf goto te s1x, error flexo tff goto te s1w, error flexo unc goto te s1v, error flexo ert goto te s3x, call cr write eha text /Table overflow. Subdivide source program./ eha, call cr goto u rrz, call cr write rry text /Measure has too many characters. Rearrange tape./ rry, goto eha pcz, error flexo nps test0 chr, te pz2, call rch store chr trze pz3 trnl (21, pz2 pz3, move chr, trm goto te /scan 1, cn, scan 2 s1, zero ldl zero ucd zero num zero psi zero chi zero g zero r zero cm sett fc, 40 sett fu, 100 s10, call rch store chr trze s11 tgrec 20, s11 s12, step1 psi test1 ldl, s13 sett ldl, 1 s13, testnl chr, (20, s14 clear s14, store dig load num x10dec addi dig store num goto s10 s11, test0 ldl, s15 zero ldl test0 ucd, s17 tgrec 1, s16 move num, n2 goto s16 s17, move num, n1 store n2 zero num s16, step1 ucd s15, test0 chr, s18 trel (21, s18 step1 chi step1 psi load chr ftrel (73, s19 ftrel (27, s1a ftrel (51, s1b ftrel (67, s1c trel (33, s1d goto s10 s19, move fc, fu s1a, halfof fc goto s10 s1b, step1 r goto s10 s1c, step1 g goto s10 s1d, step1 cm goto s10 s18, step1 tc move chr, trm test0 psi, te load ucd addi cm trze pc test1 chi, s1e test1 ao, ps testel n1, tbc, te complaint flexo bbl goto te s1e, zero ao load r tlesc 2, s1f complaint flexo tmr sett r, 1 s1f, load g tlesc 2, s1g complaint flexo tmg sett g, 1 s1g, load cm tlesc 2, s1h complaint flexo tmc sett cm, 1 s1h, load cm addi r addi ucd tgrec 2, s1y test1 cm,s1s load r addi g addi ucd subt (2 trmi s1x trnz s1t test0 g, s1t sett rt, 1 goto sli s1s, sett rt, 2 goto sli s1t, zero rt sli, test1 r, s1k test1 ucd, s1j load (2 goto s1l s1j, clear goto s1l s1k, test1 sid, sk1 load nld /from nl, 2006/02/26 --prs. lookup not band (117777 addi (400000 store t1 load nld /from nl, 2006/02/26 --prs. putback not, t1 sk1, load (1 s1l, store lt test0 rt, s1n tgrec 1, s1m sett tim, 2 goto s1o s1m, testm tim, s1w goto s1o s1n, sett tim, 100 sett t2, 1 move n2, t1 trze s1v tgrec 100, s1v s1q, halfof t1 trze s1p halfof tim halfof fu double t2 goto s1q s1p, testnl n2, t2, s1v test1 fu, s1o complaint flexo dtu s1o, load tim halve store fc goto s2 /scan 2 s2, zero fu zero sr zero 3i zero si zero aci zero acc zero et zero ete call rrc s20, call rch store chr trze s21 tgrec 20, s21 goto s20 s21, load chr search s2z, 25, s20 dispatch s2y s2b, sett sv, 200000 goto s2a s2c, sett sv, 400000 goto s2a 2sr, sett sv, 20000 goto s2a 2ss, sett sv, 40000 goto s2a s2d, zero sv s2a, setpa si, 1 goto s20 s2e, stepa sr, 14 goto s20 s2f, istepa sr, 14 goto s20 s2g, sett 3i, 100000 goto s20 s2h, testm aci, s24 step1 acc goto s25 s2i, testm aci, s24 istepa acc, 1 s25, sett aci, 1 goto s20 s24, complaint flexo nor goto s20 s2j, testel aci, (1, s26 s27, sett aci, -1 goto s20 s26, complaint flexo nor zero acc goto s27 s2k, load (1 goto s28 s2l, load (2 goto s28 s2m, load (3 goto s28 s2n, load (4 goto s28 s2o, load (5 goto s28 s38, load (6 s28, store et test0 ete, s29 complaint flexo tme s29, move et, ete goto s20 s2p, step fu, fc s2q, halfof fc goto s20 s2r, test0 si, s51 trel (1, s52 complaint flexo tms s51, move ss, sv s52, test1 cm, s69 move 3i, ccc 2s3, load tim addi fu store nft store nfp test1 g, 2s1 zero gi test0 rob, s2s load nft subt rob store nft tlesc 2, 2s2 22s, zero rob goto s2s 2s2, load nft tgrel rob, 22s move nls, nl zero rob complaint flexo itg goto 2s3 2s1, step rob, tim sett gi, 1 goto s2s s69, move nfp, nft test1 3i, s2t move ccc, 3i s2t, test0 fu, 2s4 complaint flexo tic 2s4, test1 g, 2s1 zero gi s2s, test0 lt, s2u tgrec 1, sv2 load aci addi ete trze s2w complaint flex air s2w, sett tne, 200 goto s70 s2u, load n1 addi sr addi st store ton trmi s40 tlesc 44, s2v s40, complaint flexo uat goto s2w sv2, testel tne, (200, s70 s2v, test0 aci, s31 load ton lookup nt addi acc store t1 tlesc 2, s41 load t1 tlesc 77, s42 s41, compalint flexo aor goto s2w s42, load ton putback mt, t1 s31, load ton lookup mt addi tll store tne tlesc 2, s40 load tne tgrec 76, s40 load tne x2to7 store tne s30, test0 ete, s70 test0 3i, s71 s72, complaint flexo etr goto s70 s71, load ete lookup ebl-1 subt nft trze s99 complement s99, store ex trpl s73 s79, complaint flexo eit goto s70 s73, load ton addi (1 lookup mt addi tll store tnf tlesc 2, s39 load tnf tgrec 76, s39 load tnf x2to7 store tnf load ton subt (1 lookup mt addi tll store tnd tlesc 2, s39 load tnd tgrec 76, s39 load tnd x2to7 store tnd load ete dispatch ebd-1 s81, load (2 addi tne call cn load (2 addi tnd call cn goto s75 s82, zero cut goto s76 s83, sett cut, 4 s76, load nft band (3 trnz s79 s77, load nft subt cut trze s78 load (2 addi tnf call cn load (2 addi tne call cn stepa cut, 4 goto s77 s84, load (400002 addi tnf call cn load (400002 addi tne call cn load (400002 addi tnd call cn goto s75 s85, load (2 addi tne call cn goto s83 s86, load (1 addi tnf call cn load (1 addi tne call cn load (1 addi tnf call cn s75, load ex addi (2 addi tne addi sv call cn goto s32 s78, load ete dispatch ebe-1 s93, load (2 addi tnd call cn load (2 addi tne call cn goto s32 s95, load (2 addi tnf call cn goto s32 cn, answer cnx store nf call snl putback not, nf cnx, exit cn s39, complaint flexo eor s70, load nft addi tne addi sv addi 3i call cn test0 gi, 2sa test1 gis, 2sb sett gis, 1 grow nl, -1, nls goto 2sb 2sa, zero gis 2sb, test0 3i, s32 load nft x2to1 store tu goto s33 s32, load nft store tu x2to1 addi tu store tu s33, step mm, tu move si, sid move nl, nld / added 2006/02/26 --prs. goto te s2z, 22 /s 43 /l 65 /e 61 /a 62 /b 63 /c 57 /( + 54 /- 55 /) = 64 /d 44 /m 45 /n 47 /p 24 /u 26 /w 73 /. 27 /x 21 // | 00 / space 50 /q 70 /h s2z+25, s2y, s2b s2c s2d s2e s2f s2g s2h s2i s2j s2k s2l s2m s38 s2n s2o s2p s2q s2r s2r 2sr 2ss s2y+25, ebl, 6 /d 4 /m 10 /n 10 /u 4 /w 5 /p ebl+6, ebd, s81 s82 s83 s84 s85 s86 ebd+6, ebe, s32 s32 s93 s32 s95 s32 ebe+6, /terminator, pseudos te, test0 trm, s1 sett sid, 1 zero tc testel mm, 3u, te1 zero tjp load mm tles 3u, te9 complaint flexo mtl goto te1 te9, complaint flexo mts te1, test0 rob, te0 complaint flexo itg zero rob zero gi zero gis move nls, nl te0, load (600000 call cn teb, call sbc putback bar, lmb grow nl, 1, lmb zero mm call rcw store mbh zero ao sett pfu, s1 goto pue pc, zero tht pcr, zero ucl step1 tht tgrec npi, pcz load tht lookup pnm-1 store zet call rrc pc2, call rch store chr trze pc3 trnl (21, pc4 zero chr pc3, sett ucl, 1 pc4, load zet lookup 0 trnl chr, pcr test1 ucl, pc9 step1 zet goto pc2 pc9, load tht dispatch pcd-1 pcd, pv1 pv2 pv3 pv4 pv5 pv6 pv7 pv8 pv9 pva pvb pvc pvd pve pvf pvg pvh pnm, pn1 pn2 pn3 pn4 pn5 pn6 pn7 pn8 pn9 pna pnb pnc pnd pne pnf png pnh pn1, 22 0 pn2, 43 0 pn3, 65 0 pn4, 65 45 64 0 pn5, 62 61 22 22 0 pn6, 23 51 65 62 43 65 0 pn7, 23 65 45 46 51 0 pn8, 61 43 23 46 0 pn9, 24 45 71 23 22 0 pna, 42 65 30 0 pnb, 51 65 22 23 0 pnc, 63 46 47 30 0 pnd, 24 47 0 pne, 64 46 26 45 0 pnf, 70 0 png, 50 0 pnh, 23 65 44 47 46 0 ps, govia psw pv1, sett ss, 200000 /s goto psr pv2, sett ss, 400000 /l goto psr pv3, zero ss /e goto psr pvf, sett ss, 40000 /h goto psr pvg, sett ss, 20000 /q goto psr pv5, sett st, 12 /bass goto psr pv6, sett st, 26 /treble goto psr pv7, sett st, 16 /tenor -- from 20, 070418 goto psr pv8, sett st, 20 /alto -- from 22, 070418 goto psr pv9, sett ao, 1 /units sett psw, p9a goto te p9a, load n1 store 1u x2to1 addi n1 x2to1 store 3u sett irl, -1 psr, zero ao goto te pv4, call sbc /end putback bar, (600000 feed 400 step1 nl call ppp /no. of notes zero t2 zero t3 p41, load t3 lookup not store t1 call ppp /note entry step t2, t1 step1 t3 trnl nl, p41 load t2 call ppp /+checksum feed 6 step1 bc call ppp /no. of bars zero t2 zero t3 p42, load t3 complement lookup bar store t1 call ppp /bar entry step t2, t1 step1 t3 trnl bc, p42 load t2 call ppp /+checksum feed 300 goto u pvh, sett ao, 1 /tempo sett psw, pha goto te pha, load n1 addi (700000 call cn goto psr key, pva, call rch /key trze pva ftrel (55, pum ftrel (57, pus trel (54, puf call rrc goto s1 pum, sett pfu, s1 pun, copy nt, kt, 44 pue, copy kt, mt, 44 govia pfu pus, sett pfu, put goto puh puf, sett pfu, pug puh, sett psw, pun sett ao, 1 goto s1 put, sett acc, 1 sett aci, 4 sett tne, 3 goto puw pug, sett acc, -1 sett aci, 3 sett tne, 6 puw, test0 n1, pw2 move tne, ton pw1, load ton lookup nt addi acc store t4 load ton putback kt, t4 stepa ton, 7 tlesc 44, pw1 istepa n1, 1 step tne, aci tlesc 7, puw istepa tne,7 goto puw pw2, sett pfu, psr goto pue pvb, sett ao, 1 /rest test0 mm, pb2 error flexo ilr goto i1a pb2, sett psw, pb1 goto te pb1, test0 n1, psr testp irl, pb3 load 1u addi (100 x2to1 store t1 call snl store irl putback not, t1 call snl putback not, (600000 grow nl, 1, lmb pb3, call sbc putback bar, irl istepa n1, 1 trnz pb3 goto psr pvd, sett ao, 1 /up sett psw, pd1 goto te pd1, move n1, tll goto psr pve, sett ao, 1 /down sett psw,pe1 goto te pe1, load n1 trze pe2 complement pe2, store tll goto psr pvc, sett ao, 2 /copy test0 mm, cow error flexo ilc i2a, sett psw, i1a goto te i1a, co1, sett psw, psr goto te cow, sett psw, co2 goto te co2, move n1, cbh trze co3 tles tbc, co4 co3, error flexo blc goto i1a co4, sett psw, co5 goto te co5, load n1 tgrel cbh, co7 co6, error flexo brc goto psr co7, istepa cbh, 1 co8, load cbh complement lookup bar store t4 call sbc putback bar, t4 step1 cbh tles n1, co8 goto psr /temporary**2 storage ldl, 0 /s1, s2: preceding char. numeric? 1/yes, 0/no. ucd, 0 /s1: number of num. fields read num, 0 /s1, rin: value of num. field n1, 0 /s1: first number n2, 0 /s1: last number of 1 or 2 psi, 0 /s1: character count chi, 0 /s1: nun-numeric char. count fc, 0 /s1, s2: fraction status fu, 0 /s1, s2: fraction used g, 0 /s1: count of g's r, 0 /s1: count of r's cm, 0 /s1: count of commas rt, 0 /s1: right indicator: 0/num, 1/g, 2/cm. lt, 0 /s1: left indicator: 0/num, 1/r, 2/cm. tim, 0 /s1: running time trm, 0 /s1: terminator ao, 0 /ps: arguments outstanding bc, 0 /te: bar count tbc, 0 /sbc: bar count within tape tc, 0 /s1: terminator count within measure chr, 0 /s1, s2, pc, ri: character read dig, 0 /s1: digit read ss, 0 /s2: running status of sle indicator sv, 0 /s2: value of ss for particular note sr, 0 /s2: staff reloc. count st, 0 /s2: staff location (0=subbass) 3i, 0 /s2: triplet ind.: 0/no, 100000/yes. aci, 0 /s2: accid. ind.: 0/none, 1/sharp or flat, -1/natural. /key: spacing acc, 0 /s2, key: accid. count et, 0 /s2: embell. temp. ete, 0 /s2: embell. terminal nf, 0 /cn: note forming ton, 0 /s2, key: tone pointer to staff (mt); not changing tne, 0 /s2, key: tone pointer to table; letter changing tnd, 0 /s2: tne-1 for embell. tnf, 0 /s2: tne+1 for embell. nl, 0 /s2: note location in not nft, 0 /s2: note formed, time part nfp, 0 /s2: nft preserved from robbery ex, 0 /s2: time for sustained note cut, 0 /s2: time not available to trill loop mm, 0 /s2: units*3 used in measure to date tu, 0 /s2: units*3 used by current note 1u, 0 /ps: 1*units 3u, 0 /ps: 3*units mbh, 0 /rch: pointer to beginning of measure in f lmb, 0 /te: last measure starting index in not tht, 0 /pc: index of pseudo under investigation zet, 0 /pc: character position in pseudos ucl, 0 /pc: switch internal to pc bgm, 0 /pc: another switch rn, 0 /rnd: random number psw, 0 /ps: switch for return with argument sid, 0 /s2: si delayed nld, 0 /s2: nl delayed ccc, 0 /s2: triplet status of last non-comma note nls, 0 /s2: nl saved rob, 0 /s2: time desired by grace notes gi, 0 /s2: grace note indicator gis, 0 /s2: gi saved tll, 0 /pvd, pve: transposition semitone count pfu, 0 /pf, key: identity check for title; switch: sh. or fl. si, 0 /s2: 0/no sle in note; 1/sle cbh, 0 /pvc: copy begins here irl, 0 /pvb: is rest location? np, 0 /pf: no. of parts rii, 0 /ri: index on read rij, 0 /ri: index on write or compare riw, 0 /ri: switch for compare or write bgs, 0 /rch: "end" counter fi, 0 /rch: f index ft, 0 /rch f top pp, 0 /rch: saves character ch, 0 /rch: character from tape fl1, 0 /rch: location in f of last terminator fl2, 0 /rch: loc. in f of last termin. before new word chy, 0 /er: charac. from f to be printed arg, 0 /er: flexo name of error uin, 0 /er: internal switch etc, 0 /er: internal terminator count blc, 0 /er: bell count mjp, 0 /er: last measure having error tjp, 0 /er: termin. count in meas. for last error emp, 0 /er: internal index on f rb, 0 /red, blk: +1 blac, -1 red. t1, 0 t2, 0 t3, 0 t4, 0 constants mt=.-200 /from .-100, 2006-02-25 --prs. kt=mt+44 nt=kt+44 nt/ 2 4 6 7 11 13 15 16 20 22 23 25 27 31 32 34 36 37 41 43 45 46 50 52 53 55 57 61 62 64 66 67 71 73 75 76 bar=7750 f=0 fb=. foo=105 fw=fb+400 fl=fw+200 not=fl+1 all=bar-not-1 npi=pn1-pnm 11a=not 11b=bar 11c=u start u