github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-30 21:41:56 +00:00
Code Issues Releases Wiki Activity
Files
55cd9b88aa47f1300073d45ad74d55f15db2f4cb
PDP-10.its/src/syseng/big.160
Lars Brinkhoff 55cd9b88aa Remove DECtape garbage from BIG source files.
2020-04-02 17:25:49 +02:00

3414 lines
46 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE BIG 144 710928 160139
RELOCA
6V==0 ;1 = NO PLAYER, USES ONLY T-S PROCESSOR
32K=0 ;0 = 16K
APRCHN"==4
TPCHN"==2
TPCHNA"==40
UTCCHN"==3
PCHCHN"==UTCCHN
NDIR"==3
NURBUF"==3
NUWBUF"==3
BLKSPC"==5
TTYCHN==7
A=1
TAPAC"=A
B=2
C=3
D=4
E=5
F=6
G=7
H=10
P"=11
I=12
J=13
K=14
L"=15
M=16
N=17
MEMTOP=37777
IFN 32K,TOP=40000
IFE 32K,TOP=26400
IFN 32K,FRETOP=77777
IFE 32K,FRETOP=37777
DEFINE .RD710 A
DATAI 710,A
TERMIN
;BLOCK LENGTHS
STRLL==140 ;MAX LENGTH OF INPUT STRING
SLAKLL==100
COMLL==140
PDLL==40
XPDLL==10
YPDLL==10
SYTLL==200
SYMLL==240
TITLL==40
NLINES==10
ALIVEL==30
;SYMS LH
NUMBER==21
TONUS==22
ORDFLG==23
ORDINL==24
STAR==25
CREATE==26
STRUCT==27
UNSTRU==30
PARAM==31
MINUS==32
MODIFY==33
MODALL==(MODIFY)0
MODEXC==(MODIFY)1
MODPLS==(MODIFY)2
MODAGN==(MODIFY)3
ERASER==34
GOTO==35
PLAYER==36
MULTIP==37
BRAKET==40
PUNCTU==41
PUNCCM==(PUNCTU)0
PUNCCL==(PUNCTU)1
PUNCSC==(PUNCTU)2
PUNCTO==(PUNCTU)3
PUNCFM==(PUNCTU)4
PUNCSL==(PUNCTU)5
TRANSL==42
SCRIB==43
HARMON==44
CLEF==45
;F FLAGS (RH)
IGNORF==20
RETYPF==40
NONEWF==100
MINUSF==200
PREVCF==400
NOMORF==1000
PLEASF==2000
BEGUNF==4000
.ZZ.==.
LOC 40
0
JSR UUOH
LOC .ZZ.
DEFINE NUMS N1,N2
ZZZ==.
REPEAT N2-N1+1,N1+.-ZZZ
TERMIN
JRST SETUP
SETUPX": MOVE 0,[(20)SAVLOD
BLT 0,SAVLOD+17
MOVEI A,FREE"
MOVEM A,FREP'"
MOVSI A,-MAXNP"
SETUX0: JUMPGE A,SETUX1
SETOM PRECLE"(A)
AOBJN A,SETUX0
SETUX1: SETZM NTAPES'
AOS NTAPES
SETZM TIME'
IFE 6V,[ SETZM PSDATL
MOVE 0,[PSDATL,,PSDATL+1]
BLT 0,HARCDE-1
]
SETUP": MOVE P,[(,-PDLL)PDL-1
.OPEN 2,[SIXBIT / %TTY/]
JRST 4,.-1
.OPEN 1,[SIXBIT / 4TTY/]
JRST SSSB
.RD710 B,
IDIVI B,60.
MOVE A,[(252525252525)]
MOVEM A,RAND'
FMPM A,RAND
SOJG C,.-1
MOVEI A,1
MOVE B,[(600)SYMTAB-1]
SETUP0: ILDB C,B
JUMPN C,.-1
ILDB C,B
SKIPE C
AOJA A,SETUP0
MOVEM A,NSYMS'
MOVNM A,NNSYMS'
MOVEM B,STEND'
SETZM PLAYP'
IFE 6V,[ PUSHJ P,TUNEUP
SETUP1: MOVE P,[(,-PDLL)PDL-1]
]
REALLY: MOVEI C,"^
SETZM ALTF'
SETZM BKD'
REALL1: PUSHJ P,TTYOFF
PUSHJ P,CRLF
RCS: MOVE P,[(,-PDLL)PDL-1 ;GET SET TO GOBBLE CHAR. STRING
MOVEM P,DOP
SETZM BRAKC'
MOVSI H,-STRLL
SKIPE A,ALTF
RCS2: PUSHJ P,ECHO
RCS1: PUSHJ P,TYI ;DISPATCH ON CHAR (JUST PUT IN STRING IF REG.)
CAIN A,177
JRST RBOUT
CAIN A,4
JRST REALL1
CAIN A,"/
JRST GENAM
CAIN A,"\
PUSHJ P,RCOMN
CAIE A,33
CAIN A,175
MOVEM C,ALTF
CAIN A,"[
AOS BRAKC
CAIN A,"]
SOS BRAKC
CAIE A,15
JRST RCS2
SKIPN BRAKC
JRST RCS3
PUSHJ P,CRLF
RCSH: MOVSI A,-1
MOVEM A,STRING(H)
AOBJP H,SST ;STRING TOO LONG
JRST RCS2
RCS3: SETZM STRING(H) ;GET HERE WHEN C.R. REALLY MEANS DOIT.
AOBJP H,SST
SETOM STRING(H) ;END MARKER IS -1
AOBJP H,SST
SETZM STRING(H)
JRST TCS
RBOUT: SETZM STRING(H)
RBT: SOJ H,
CAMG H,[-STRLL,,0]
JRST REALLY
SKIPN A,STRING(H)
JRST RCSH
PUSHJ P,TYO6
JRST RBT
LOSE: MOVE B,[440700,,[ASCIZ ./COMMAND STRING LOSES\.]]
PUSHJ P,DOSAY5
JRST DONE
UUOH:
0
MOVEM ACSAV
MOVE [1,,ACSAV+1]
BLT ACSAV+17
EXCH P,PSAV
PUSHJ P,CRLF
MOVE B,[440700,,[ASCIZ ./ILLEGAL UUO\.]]
PUSHJ P,DOSAY5
EXCH P,PSAV
.VALUE
UUOBLM: MOVEI A,SETUPX-1 ;MOBY BLAM
MOVEM A,UUOH
UUOSRT: AOS UUOH
UUORET: MOVE [ACSAV+1,,1]
BLT 17
MOVE ACSAV
JRST @UUOH
ACSAV: BLOCK 20
PSAV: UUOPDL
UUOPDL: BLOCK 20 ;PDL FOR UUO OPS SO AS NOT TO CLOBBER...
TCS: MOVEI F,STRING
MOVSI H,-COMLL
TCS2: SKIPN (F) ;SIXBIT SPACE IS ZERO
AOJA F,.-1
MOVE A,(F)
AOJE A,DO ;END OF COMMAND STRING
SKIPGE A
AOJA F,TCS6
TCS1: PUSHJ P,SS ;EVALUATE SYMBOL
CAIL A,60
JRST TCS3
CAIGE A,30
JRST SSSA ;CAN'T GET IT
SUB A,2BEST'
CAIGE A,10
JRST SSSA ;CAN'T GET IT HERE EITHER
TCS4: MOVE A,NBEST' ;THIS IS IT
HRL E,F
TCS7: MOVEM A,COML(H) ;MAKE LIST OF THINGS TO DO
MOVE F,SSBF'
AOBJN H,TCS2 ;GET NEXT SYMBOL
JRST SSS ;WHAT LOSSAGE??
TCS3: SUB A,2BEST
CAIGE A,6
JRST SSSA ;CAN'T GET THIS SYMBOL
MOVE A,2BEST
CAIL A,60
JRST SSSB
JRST TCS4
TCS6: MOVEM F,SSBF
SOJA A,TCS7
ECHO1: MOVEI A,40
ECHO: MOVEI B,-40(A)
JUMPL B,ECHO1
CAIL B,100
JRST ECHO1
ECHO2: MOVEM B,STRING(H)
MOVEI A,40(B)
CAIN A,"^
SETZM ALTF
AOBJN H,TYO
SST: PUSHJ P,CRLF
SSS: MOVEI A,"?
PUSHJ P,TYO
JRST REALLY
GENAM: PUSHJ P,GNAM ;CREATE A NAME BY TRIAL AND ERROR
PUSHJ P,GENAM3
JRST RCS1
GENAM3: MOVSI C,-5
GENAM2: MOVE E,STEND ;SHOVE IT INTO STRING
GENAM1: MOVE B,SLAK(C)
PUSHJ P,ECHO2
DPB B,E
IBP E
AOBJN C,GENAM1
MOVEI A,0
DPB A,E
IDPB A,E
NULSYM: SOS NNSYMS
AOS B,NSYMS ;E IS PNTR
CAIL B,SYMLL
JRST SSSB
SETZM SYMS(B)
MOVEI B,(E)
CAIL B,SYTEND-2
JRST SSSB
MOVEM E,STEND
POPJ P,
GNAM: MOVSI C,-5 ;MAKE UP A NAME
GNAM1: XCT RCHT(C)
HRREM B,SLAK(C)
AOBJN C,GNAM1
SETZM SLAK(C)
MOVEI F,SLAK
PUSHJ P,SS ;ALREADY EXISTS?
CAIL A,20
JRST GNAM ;AMOST, TRY AGAIN
POPJ P,
RCHT: PUSHJ P,RCCHAR
PUSHJ P,RVCHAR
PUSHJ P,RCCHAR
PUSHJ P,RVCHAR
PUSHJ P,RCCHAR
RVCHAR: PUSHJ P,RANDOM
IDIVI A,6
MOVE A,B
MOVE B,[440600,,RVTAB]
JRST RV1
RCCHAR: PUSHJ P,RANDOM
IDIVI A,20.
MOVE A,B
MOVE B,[440600,,RCTAB]
RV1: PUSH P,C
ILDB C,B
SOJGE A,.-1
MOVE B,C
POP P,C
POPJ P,
RVTAB: SIXBIT /AEIOUY/
RCTAB: SIXBIT /BCDFGHJKLMNPQRSTVWXYZ/
SS: CLEARM 2BEST' ;SYMBOL EVALUATOR
CLEARB G,1BEST'
MOVE E,[(600)SYMTAB-1
ILDB I,E
SS0: MOVEI B,1(F)
SETOM NCHW'
MOVE A,-1(B)
MOVE A,TYPE(A)
MOVEM A,SSOLDT'
SS01: AOS NCHW ;FIND END OF SYMBOL (SPACE)
MOVE A,(B)
MOVE A,TYPE(A)
JUMPL A,SS19
CAMN A,SSOLDT'
AOJA B,SS01
SS19: MOVEM B,SSBF ;B HAS END OF SYM
SS10: CLEARB C,D
MOVE B,F ;F HAS BEGINNING OF SYM
SS1: MOVE A,I ;A HAS CURRENT BYTE TO TEST AGAINST.
ILDB I,E
JUMPE A,SS2 ;RAN OUT
ADDI D,1 ;D HAS ITERATION COUNT
CAMN A,(B) ;CHECK CHARACTORS
ADDI C,60 ;INFINITELY SURE THIS IS CHAR
SKIPG NCHW ;CHECK NEARBY CHARS?
JUMPE I,SS12
CAMN A,-1(B)
ADDI C,37 ;SOMEWHAT PLAUSABLE HE MEANT THIS
CAMN A,1(B)
ADDI C,24 ;PLAUSABLE HE MEANT THIS
SKIPG NCHW
AOJA B,SS1
CAMN A,-2(B)
ADDI C,14 ;HE MIGHT EVEN MEAN THIS
CAMN A,2(B)
ADDI C,10 ;UNLIKELY, BUT MAYBE THIS
SS12: AOJA B,SS1
SS2: SUBI D,1 ;COMPUTE FIRST AND SECOND BEST CHOICES.
SUB D,NCHW
IMUL D,D
ADD D,NCHW
ADDI D,1
IDIV C,D
CAMG C,1BEST
JRST SS3
EXCH G,NBEST
EXCH C,1BEST
MOVEM G,N2BEST'
MOVE G,NBEST
MOVEM C,2BEST
SS20: CAME E,STEND
AOJA G,SS10
MOVE A,1BEST
POPJ P,
SS3: CAMG C,2BEST
JRST SS20
MOVEM G,N2BEST
MOVEM C,2BEST
JRST SS20
RCOMN: PUSHJ P,TTYOFF ;GET INFORMATION FROM LOSER
PUSHJ P,CRLF
MOVEI A,"\
PUSHJ P,TYO
MOVE C,[(10700)SLAK-1]
RCOMN1: PUSHJ P,TYI
CAIN A,177
JRST RCOMN2
PUSHJ P,TYO
CAME C,[(10700)SLAK+SLAKLL-1
IDPB A,C
CAIE A,"\ ;TERMINATOR
JRST RCOMN1
JRST CRLF
RCOMN2: CAMN C,[(10700)SLAK-1] ;RUBOUT
JRST RCOMN1
LDB A,C
PUSHJ P,TYO
ADD C,[7_30.]
SKIPGE C
ADD C,[-<43_30.>-1]
JRST RCOMN1
RANNO":
RANDOM: MOVE A,[(252525)252525
FMPB A,RAND
.RD710 B,
ADD A,B
POPJ P,
GCDD": JUMPE I,CPOPJ
JUMPN J,GCDD1
MOVEI I,1
POPJ P,
GCDD1: PUSH P,A
PUSH P,I
PUSH P,J
MOVE A,I
GCDD2: MOVE I,A
CAMGE I,J
EXCH I,J
MOVE A,J
IDIV I,J
JUMPN J,GCDD2
POP P,I
IDIV I,A
EXCH I,(P)
IDIV I,A
POP P,J
POP P,A
POPJ P,
DONE": PUSHJ P,TTYOFF
MOVE P,DOP'
SKIPL COML(H)
AOJA H,.-1
JRST DO1
DO: SETOM COML(H)
DO0: SETZB H,F
DO1: MOVEM P,DOP'
PUSHJ P,DOG
JRST REALLY ;SUPER-CONFUSED
CAMN D,[MODAGN]
JRST DOAG
MOVE A,[COML,,COMSL]
BLT A,COMSL+COMLL-1 ;SAVE STRING JUST IN CASE
SETZM REHASH'
CAMN D,[MODPLS] ;SET TO PLEASE MODE
JRST DOPLSE
HRRZS D
CAIN E,BRAKET
JRST DOBRAK
CAIN E,STAR
JRST DOSTAR
CAIN E,CREATE
JRST DOCREA
CAIN E,TRANSL
JRST DOTRNS
CAIN E,ERASER
JRST DOERZ
CAIN E,PARAM
JRST DOPARM
CAIN E,GOTO
XCT GOTOT(D)
CAIN E,PLAYER
XCT PLTOT(D)
CAIN E,SCRIB
XCT SCRIBT(D)
DONEXT: AOJE H,DO1
DOG: HRRE G,COML(H)
JUMPL G,CPOPJ
SKIPGE COML(H)
AOJA H,DO1A ;END OF STRING MARKER
CAML G,NSYMS
JRST SSSB ;NOT IN SYMBOL TABLE
TRNN F,RETYPF
JRST DO10
MOVEI A,40
TRON F,NONEWF
MOVEI A,"\
PUSHJ P,TYO
MOVE B,[(600)SYMTAB-1
SOJL G,DO11
ILDB A,B
JUMPE A,.-2
JRST .-2 ;LOSSAGE ??
PUSHJ P,TYO6
DO11: ILDB A,B
JUMPN A,.-2
HRRZ G,COML(H)
DO10: TRNE F,IGNORF
SOJA H,DO1
HLRZ E,SYMS(G)
MOVE D,SYMS(G)
JRST SPOPJ
DO1A: POP P,A
JRST DO1
DOAG: SETZB I,DOAGWF'
DOAG1: ADDI H,1
PUSHJ P,DOG
MOVNI E,1
DOAG3: HRRE A,COMSL(I)
JUMPL A,DOAG2
HLRZ B,SYMS(A)
JUMPN E,DOAG4
CAIE B,UNSTRU
CAIN B,STRUCT
JRST DOAG5
DOAG4:
CAME B,E
AOJA I,DOAG3
DOAG5: MOVE A,COML(H)
MOVEM A,COMSL(I)î
AOJA I,DOAG1
DOAG2: MOVE A,[COMSL,,COML] ;RESTORE STRING
BLT A,COML+COMLL-1
SETOM REHASH'
JRST DO0
DOBRAK: JUMPN D,DOBRK1
AOS BKD
PUSHJ P,NUMVAL
SKIPN A
MOVEI A,1
PUSH P,H
PUSH P,A
JRST DONEXT
DOBRK1: SOSLE A,(P)
SKIPA H,-1(P)
SOSGE BKD'
JRST DONEXT
SUB P,[(2)2
JRST DONEXT
GOTOT: JRST TUNEUP
AOJA H,DOVALU
JRST DOTITL
JRST ALLOW
AOJA H,DOTAPE
JRST WRIT
JRST DOLIST
JRST HARBLD
JRST HARAUG
JRST JRSTGO
JRST DETUNE
JRST HARSCL
JRST VOXPT
JRST VOXCD
JRST SCWAV
JRST CLEFP
JRST RELPDP
JRST PLWHOA
JRST SCLBLD
JRST PRINT
JRST SYNN
PLTOT: JRST PLGOA
JRST PSGOA
SCRIBT: JRST PLOT
DOSTAR: CAIN D,2
JRST DDTGO
TRON F,RETYPF
PUSHJ P,CRLF
CAIN D,1
TRO F,IGNORF
AOJA H,DO1
DOPLSE: TRO F,PLEASF ;HE REALLY WANTS THIS
AOJA H,DO1
RELPDP: SETZM PLAYP
.CLOSE 17,
.CLOSE 16,
AOJA H,DO1
DOCREA: MOVEI B,NUMBER
PUSHJ P,GET
MOVNI A,1
MOVEM A,J
SKIPL (C)
ADDI C,1
MOVEI B,NUMBER
PUSHJ P,GET2
MOVNI A,1
MOVEM A,DOCRN2'
MOVE K,D
DOCRE0: SETOM PLWN
SETZB G,PLWN+1
MOVE A,[(PLWN+1)PLWN+2
BLT A,PLWN+177
MOVEI B,0
PUSHJ P,GET
JRST DOCRE1
HRRZ C,(C)
DOCRE2: MOVEM C,DOTITA'
ADDI C,SYMS
SETZM (C)
HRRM C,STASH
MOVE I,FREP'
XCT DOCRET(K)
JRST DONE
DOCRE1: MOVEI B,UNSTRU
PUSHJ P,GET
JRST DOCRE3
DOCRE4: MOVE C,B
PUSH P,C
PUSHJ P,DOERS1
POP P,C
JRST DOCRE2
DOCRE3: MOVEI B,STRUCT
PUSHJ P,GET
JRST BADATA
JRST DOCRE4
PUSHJ P,TTSTOU
DOCRET: PUSHJ P,CRRDOL
PUSHJ P,CRUT
PUSHJ P,CRSC
PUSHJ P,CRKY
PUSHJ P,CRRCMP
PUSHJ P,DPLU
PUSHJ P,CRRCMI
DOTRNS: MOVEI B,STRUCT
PUSHJ P,GET
JRST BADATA
HRRZM A,TTOX'
ADDI A,1
HRRM A,TTGET
MOVEI K,-1
JRST DOCRE0
DOERZ: PUSHJ P,@DOERZT(D)
JRST DONE
DOERZT: DOERAS
DOMENT
DOERAS: PUSHJ P,DOERA
MOVEM A,FREP
SETZM SYMS(M)
PUSHJ P,DOERS
PUSHJ P,DOERS1
SETZM TITL
POPJ P,
DOMENT: PUSHJ P,TTYON
PUSHJ P,DOERA
JFCL
PUSHJ P,DOSAY0
PUSHJ P,DOSAY
PUSHJ P,DOSAY9
JFCL
POPJ P,
CLEFP: MOVEI B,CLEF
PUSHJ P,GET
JRST BADATA
HRREM A,CLEFPA'
MOVEI B,NUMBER
PUSHJ P,GET
JRST BADATA
SKIPLE A
CAILE A,MAXNP"
JRST BADATA
MOVE B,CLEFPA
MOVEM B,PRECLE"(A)-1
JRST DONE
DPLU: PUSH P,DONEW
MOVE B,[440700,,[ASCIZ ./NO EDIT ROUTINES\.]]
JRST DOSAY5
PLOT: SETZB M,N
ADDI H,1
SKIPGE A,COML(H)
JRST DONE
HLRZ B,SYMS(A)
CAIE B,STRUCT
JRST BADATA
HRRZ J,SYMS(A)
HRRZM A,PLOTLS'
PLOTLP: ADDI H,1
SKIPGE A,COML(H)
SOJA H,PLOTDO
MOVE B,SYMS(A)
CAMN B,[PUNCFM]
JRST PLOTFM
CAME B,[PUNCTO]
SOJA H,PLOTDO
PUSHJ P,NUMVAL
MOVE N,A
JRST PLOTLP
PLOTFM: PUSHJ P,NUMVAL
SKIPE A
SUBI A,1
MOVE M,A
JRST PLOTLP
PLOTDO: SETZB B,L
PLOTW: HLRZ C,TITL(B)
JUMPE C,PLOTY
CAME C,PLOTLS
AOJA B,PLOTW
HRR L,TITL(B)
PLOTY: MOVEM H,PLOTRH'
JRST .PLOT"
.PLOTR": MOVE H,PLOTRH
JRST PLOT
DOSAY0: MOVE C,M
DOSAY9: HLRZ B,SYMS(C)
JRST DOSAY1
DOSAY: PUSHJ P,GCHEK
DOSAY1: PUSHJ P,CRLF
MOVEI A,40
CAIN B,STRUCT
MOVEI A,"*
CAIN B,HARMON
MOVEI A,"#
PUSHJ P,TYO
PUSHJ P,DOSAY6
MOVEI D,0
DOSAY2: HLRZ A,TITL(D)
JUMPE A,CPOPJ
CAME A,C
AOJA D,DOSAY2
MOVEI A,40
PUSHJ P,TYO
HRR B,TITL(D)
HRLI B,700
DOSAY5": ILDB A,B
CAIN A,"\
POPJ P,
PUSHJ P,TYO
JRST DOSAY5
DOSAY6: SETZB A,E
PUSHJ P,TYO6
MOVE B,[(600)SYMTAB-1
JUMPE C,DOSAY4
DOSAY3: ILDB A,B
JUMPN A,.-1
CAIE C,1(E)
AOJA E,DOSAY3
DOSAY4: ILDB A,B
PUSHJ P,TYO6
CAIE A,40
JRST DOSAY4
POPJ P,
DDTGO: SKIPA A,[LOGOUT]
JRSTGO: PUSHJ P,NUMVOC
CAILE A,17
CAILE A,MEMTOP
JRST BADATA
PUSHJ P,UWAIT"
JRST (A)
JRST SETUP
LOGOUT: .LOGOUT
.VALUE
JRST SETUPX
SYNN: MOVEI C,COML+1(H)
MOVEI A,COML+2(H)
HRRZ B,(A)
HLRZ B,SYMS(D)
HRRZ D,(C)
HLRZ D,SYMS(D)
MOVEM B,SYMS(C)
JRST DONE
SAVLOD: BLOCK 20
ALLOW: PUSH P,H ;TEST FOR GOODNESS
PUSHJ P,ALLOWZ
POP P,H
JRST DONE
ALLOWZ: PUSHJ P,RCOMN
MOVSI C,-10.
MOVE B,[(700)SLAK-1
SETZM SLAK+7
ALLOW0: ILDB A,B
CAIE A,",
CAIN A,"\
JRST ALLOW1
SUBI A,40
JUMPL A,ALLOW0
CAIGE A,100
SKIPE TYPE(A)
JRST ALLOW0
MOVEM A,SLAK+10(C)
AOBJN C,ALLOW0
ALLOW1: MOVEM B,ALLOWB'
SETZM SLAK+10(C)
CAMG C,[(,-8.)
JRST ALLOWS
MOVNM C,ALLOWC'
PUSH P,F
MOVEI F,SLAK+10
PUSHJ P,SS
POP P,F
MOVEI B,22
TRNE F,PLEASF
MOVEI B,35
CAML A,B
JRST ALLOWN
MOVS C,ALLOWC
HRRI C,10
MOVSI H,-STRLL
PUSHJ P,GENAM2
MOVE B,ALLOWB
LDB A,B
CAIN A,",
JRST ALLOW0
JRST DONE
ALLOWS: MOVE B,[(700)[ASCII ./TOO SHORT\.]-1]
JRST DOSAY5
ALLOWN: MOVE B,[(700)[ASCII ./RESEMBLES\.]-1]
PUSHJ P,DOSAY5
MOVE C,NBEST'
JRST DOSAY6
DOPARM: PUSHJ P,NUMVAL
XCT DOPX(D)
XCT DOPY(D)
JRST DONE
DOPX: JFCL
PUSHJ P,DOPSSC
JFCL
JFCL
PUSHJ P,DOPTMP
PUSHJ P,SCRHK
PUSHJ P,DOPSDN
PUSHJ P,ARDSP
DOPY: JFCL
MOVEM A,SCRSPC
MOVEM A,SCRINT
MOVEM A,DETEMPO
IFN 6V, MOVEM A,PLTDMY'
IFE 6V, MOVEM A,PLTEMP-73+PDP6P
MOVEM A,SCRSIZ
MOVEM A,SLURDN
MOVEM A,PLOWA
ARDSIZ": 30
SCRSIZ": 60
SCRINT": 1
SLURDN": 2
PLOWS": 1
PLOWA: 0
DOPTMP: PUSH P,A
IFE 6V,[
MOVE D,A ;CHANGE TEMPO
MUL D,[(300000)]
MOVEM D,PSTEMP
SKIPL PLAYP
JRST DOPTMQ
.ACCESS 16,[76]
.IOT 16,B
SOJN B,DOPTMQ ;UNLESS PLAYING
.ACCESS 16,[77]
.IOT 16,B
SOJL B,DOPTMQ ;UNLESS REALLY PLAYING
.ACCESS 17,DOPTMT(B)
MOVE C,DOPTMU(B)
.IOT 17,C
DOPTMQ:
]
IFN 6V, JFCL
POP P,A
POPJ P,
IFE 6V,[
DOPTMT: PLTEMP ;MI
PSTEMP ;DAC
DOPTMU: -1,,A ;MI
-1,,D ;DAC
]
DOPSSC: CAIG A,20.
CAMGE A,[-20.]
JRST BADATA
PUSH P,A
IMUL A,[14631,,463146]
MOVEM A,SCRSPA
POP P,A
POPJ P,
SCRSPA": 0
SCRSPC: 0
GET: MOVEI C,COML+1(H) ;GET NEXT SYL OF TYPE IN B
GET2: SKIPGE (C)
POPJ P,
HRRZ A,(C)
HLRZ A,SYMS(A)
CAME A,B
AOJA C,GET2
HRRZ B,(C)
HRRZ A,SYMS(B)
JRST SPOPJ
DOPSDN: JUMPLE A,BADATA
CAIL A,5
JRST BADATA
POPJ P,
SCRHK: MOVE B,A
ASH B,-1
MOVEM B,ARDSIZ
POPJ P,
ARDSP: MOVEI B,0
SKIPN A
MOVEI B,1
CAIN A,1
MOVNI B,1
MOVEM B,PLOWS
POPJ P,
TUFLUK": MOVEI A,"/
PUSHJ P,TYO
BADATA: SKIPGE COML(H)
JRST REALLY
HLRZ F,COML(H)
SKIPA A,["/
SSSA: MOVEI A,"?
SSSA1: PUSHJ P,TYO
MOVE A,(F)
JUMPLE A,REALLY
PUSHJ P,TYO6
AOJA F,SSSA1+1
SSSB": MOVEI A,"?
PUSHJ P,TYO
HLRZ F,COML(H)
JRST SSSA1
EVENON=400000
CRRCMI: SKIPA J,[1] ;READ IN MUSIC, K=-1 MEANS TRANSLATE
CRRDOL: TDZA K,K
CRRCMP: MOVEI K,1
PUSHJ P,TTYON
JUMPLE J,BADATA
CAIL J,11
JRST BADATA
SKIPN K
PUSHJ P,CRLF
SETZM CRFLAG'"
JUMPN K,CRRCM1
CONO PTR,20
PUSHJ P,CRRBK
JRST 4,.-1
CRRCM0: SETZM CRDELY' ;GET HERE FOR ALLREADS, MODE IN J, K DEVICE
SETZM CRDELZ'
MOVEM J,CRNPT'
SOS CRNPT
MOVNS J
HRLZ M,J
MOVEI L,1
PUSHJ P,PDAT
SETZM CRRSP(M)
SETZM CRPREV(M)
AOBJN M,.-2
MOVE C,N
CRRW1: PUSHJ P,CRGNB ;GET TIME
JUMPE A,CROP2K ;IF END
JUMPE K,CRRW6
MOVE B,CRGNBA'
AOJE B,CRRW3 ;STOP SPEC
CRRW6: SUB A,[(1)]
ASH A,5
SKIPE K
ASH A,9
IDIV A,DETEMPO
EXCH A,CRDELY
ADDM A,CRDELZ
HRLZ M,J
PUSHJ P,CRGNB
CRRW2: MOVEI D,3
LSHC A,-12.
CRR1: SOJL A,CROP11 ;IF DEAD PART
CAMN A,CRPREV(M)
JRST CROP11 ;IF NO CHANGE
MOVE L,CRPREW(M)
JUMPE A,CROP12 ;IF REST
SKIPE CRPREV(M)
PUSHJ P,PDAT1A
CROP1: MOVE L,M
CAILE L,5
SUBI L,6
ASH L,7
ADD L,A
CROP10: MOVEM L,CRPREW(M)
SETOM PLWN(L)
ADD L,CRRSP(M)
TROA L,EVENON
CROP12: SETZM PLWN(L) ;SKIPPED OVER
PUSHJ P,PDAT1
MOVEM A,CRPREV(M)
CROP11: AOBJP M,CRRW1 ;IF FINISHED CHORD
MOVEI A,0
ROTC A,6
SOJG D,CRR1
PUSHJ P,CRGNB0
JRST CRRW2
CRRW3: PUSHJ P,CRGNB
MOVEI D,0
CRRW5: MOVE M,[220600,,A]
CRRW4: ILDB B,M
ASH B,11.
MOVEM B,CRRSP(D)
TLNE M,770000
AOJA D,CRRW4
CAML D,CRNPT
JRST CRRW1
PUSHJ P,CRGNB0
AOJA D,CRRW5
CROP2K: JUMPE K,CROP2
PUSHJ P,.UNRED"
CROP2": MOVEI L,0
PUSHJ P,PDAT
CROP3: HRLM I,@FREP'
EXCH I,FREP
MOVE B,CRFLAG
HRL I,CROP3T(B)+1
STASH: MOVEM I,
JUMPE G,CPOPJ
MOVE A,G
JRST DPT
CROP3T: STRUCT
UNSTRU
UNSTRU
HARMON
CRGNB0: JUMPN K,CRGNB5
CRGNB: JUMPN K,CRGNB6 ;GET NEXT BITE
CAMN N,C
PUSHJ P,CRRBK
JRST CRGNB1
JRST .-2
CRGNB1: ILDB A,N
POPJ P,
CRGNB6: PUSHJ P,CRCUR ;NOT PTR, GET WORD
MOVEM A,CRGNBA'
HLRZS A
POPJ P,
CRGNB5: HRRZ A,CRGNBA
POPJ P,
CRRCM1: PUSH P,J
MOVE J,DOCRN2'
PUSHJ P,CRUT0 ;OPEN FILE
PUSHJ P,.URED ;USES .IOT 4,A
JRST BDHDR
CAME A,[JRST 1]
JRST CRRCM2
MOVE B,[440700,,[ASCII .(UNSTRUCTURED)\.]
PUSHJ P,DOSAY5
POP P,J
MOVEI K,1
MOVEI N,1
JRST CRRCM0
CRRCM2: CAME A,[JRST 4,1]
JRST BDHDR
MOVE B,[440700,,[ASCII .(STRUCTURED)\.]
PUSHJ P,DOSAY5
SETOM CRFLAG
SETZM CRINEQ'
POP P,CRNPT
PUSHJ P,.URED"
JRST DATEXH
MOVEM A,CRNPT
MOVEI L,-1
MOVN J,I
HRRM J,CRINA0
PUSHJ P,PDAT
HRRM I,CRINA1
ADD I,A
SETZB L,N
PUSHJ P,PDAT
CAIL I,FREEND"-3
JRST TUFLUK
CRINE: SOSGE CRNPT
JRST CRINF
CRINA0: MOVEI J,(I) ;-BEG.
CRINA1: HRRZM J, ;HEADER BLOCK
AOS CRINA1
SETZM CRINTF'
SETZM CRITM'
HRRZM I,CRINM'
CRINA2: PUSHJ P,.URED"
JRST DATEXH
JUMPL A,CRINA5
CAIL A,600000
JRST CRINA3
MOVE L,A
TLO L,400000
PUSHJ P,PDAT
JRST CRINA2
CRINA3: CAIN A,600000
JRST CRINA9
TRNN A,100000
JRST CRINA4 ;IF TIME SIG.
ANDI A,77777 ;IF KEY SIG.
TRNE A,40000
ORCMI A,77777
MOVE L,CRINAT(A)
PUSHJ P,PDAT
JRST CRINA2
CRINA5: SETOM CRINTF'
JRST CRINA2
CRINA4: ANDI A,17777
HRLI A,200
MOVE L,A
PUSHJ P,PDAT
JRST CRINA2
CRINA9: MOVE G,CRINM ;WHERE MEASURE ENTRIES BEGIN
SKIPL CRINTF
JRST CRINC
MOVEM I,CRINTF
HRLI L,1000
PUSHJ P,PDAT
CRINC: MOVEI L,0 ;END OF MEASURES AND END OF MEASURE
PUSHJ P,PDAT
SETZM CRITM
CRINB: SKIPN (G)
JRST CRINE1 ;NO MORE MEASURES
SKIPL B,(G)
AOJA G,CRINB
XCT CRINA0
HRRZM J,(G)
MOVE A,G
CRINB0: SKIPN (A)
JRST CRINB1
CAMN B,(A)
HRRZM J,(A)
AOJA A,CRINB0
CRINB1: PUSHJ P,.URED"
JRST DATEXH
CAIL A,600000
JRST CRINB4
PUSH P,I
LDB J,[700,,A] ;J GETS LENGTH
TRNE A,100000
ASH J,1
TRNN A,100000
IMULI J,3
LDB B,[70600,,A] ;B GETS PITCH
MOVE D,CRITM
ADDM J,CRITM
CAIG B,1
JRST CRIB1A
LDB M,[150200,,A]
LDB N,[200200,,A]
DPB N,[20200,,M]
MOVE L,CRINBT(M) ;ARTIC
DPB B,[220700,,L]
MOVEI I,300
CRINB2: PUSHJ P,GCDD
CAIG J,40
CAILE I,100
SOJA J,CRIB2A ;NO, BUT ... FAKE IT
DPB J,[370500,,L]
DPB I,[310600,,L]
MOVEI I,300
MOVE J,D
CRINB3: PUSHJ P,GCDD
CAIGE J,200
CAILE I,100
SOJA J,CRIB3A
DPB J,[60700,,L]
DPB I,[600,,L]
POP P,I
PUSHJ P,PDAT
JRST CRINB1
CRINB4: CAIL A,740000
JRST CRINB1 ;BEAT
CAIN A,600000
JRST CRINC
CAIGE A,700000
JRST CRINS
CRINT: MOVE L,[400000,,104] ;TEMPO
MOVEI B,4504.
ANDI A,17777
IDIV B,A
DPB B,[311200,,L]
PUSHJ P,PDAT
JRST CRINB1
CRINS: MOVSI L,400000
DPB A,[220700,,L]
PUSHJ P,PDAT
JRST CRINB1
CRINF: PUSHJ P,.UNRED"
MOVE G,CRINEQ
JRST CROP3
CRIB2A: AOS CRINEQ
JRST CRINB2
CRIB3A: AOS CRINEQ
JRST CRINB3
CRIB1A: POP P,I
JRST CRINB1
CRINE1: SKIPN B,CRINTF
JRST CRINE
HRRM I,(B)
CRINE3: PUSHJ P,.URED"
JRST DATEXH
MOVE L,A
PUSHJ P,PDAT
MOVE B,[440700,,A]
CRINE2: ILDB C,B
CAIN C,"\
JRST CRINE
TLNE B,760000
JRST CRINE2
JRST CRINE3
CRINBT: 1_15
2_15
3_15
3_15
REPEAT 4,4_15
REPEAT 10,10_15
403,,443444
403,,443344
403,,343344
403,,343334
403,,333334
403,,333333
403,,330333
400,,330333
400,,330033
400,,30033
400,,30003
400,,3
CRINAT: 400,,0
400,,1000
401,,1000
401,,1100
401,,101100
401,,101110
401,,111110
401,,111111
401,,112111
402,,112111
402,,112211
402,,212211
402,,212221
CRCUR: JUMPL N,CRCUR5 ;IN BLOCK
JUMPN N,CRCUR4 ;BEG. OF FILE
PUSHJ P,.URED" ;CHECKSUM
JRST DATEXH
CAME A,CRCURM
JRST CKSMER
CRCUR4: PUSHJ P,.URED"
JRST DATEXH
MOVEM A,CRCURM'
HLREM A,N ;WORD COUNT
CAIN N,(JFCL)
MOVEI A,0
JUMPE A,CPOPJ
JUMPG A,BDHDR
CRCUR5: PUSHJ P,.URED
JRST DATEXH
MOVE C,CRCURM
ROT C,1
ADD C,A
MOVEM C,CRCURM
AOJA N,CPOPJ
BDHDR: SKIPA B,[440700,,[ASCII ./BAD DATA IN FILE\.]]
CKSMER: MOVE B,[440700,,[ASCII ./CHECKSUM ERROR\.]]
JRST DEATH
DATEXH: MOVE B,[440700,,[ASCII ./FILE UNEXPECTEDLY ENDS\.]]
JRST DEATH
PDAT1A: SETZM PLWN(L)
PDAT1: HRL L,CRDELZ
SETZM CRDELZ
PDAT: MOVEM L,(I)
CAIGE I,FREEND"-1
AOJA I,CPOPJ
JRST TUFLUK
DETEMPO: 883.
CRPREV: BLOCK 10
CRPREW: BLOCK 10
CRRSP: BLOCK 10
;NEW "RELAY" NUMBERS: (OLD PITCH-1) + 200*(MAN-1)
NRNO==1400
DOTAP1: MOVE A,TAPTAB(C)
PUSHJ P,TAPKIL"
DOTAPE: SOSL C,NTAPES
JRST DOTAP1
DOTAP2: AOS C,NTAPES
CAIL C,NDIR
JRST DONE
MOVE D,COML(H)
JUMPL D,DONE
HLRZ B,SYMS(D)
CAIE B,NUMBER
JRST BADATA
HRRZ A,SYMS(D)
PUSHJ P,FILEST"
JRST SSSB
MOVEM A,TAPTAB(C)
AOJA H,DOTAP2
CRUT: TDZA L,L
CRUT0: MOVEI L,1
JUMPL J,CRUT1
MOVE A,J
PUSHJ P,TAPCK
PUSHJ P,NAMFIL
CRUT4: PUSHJ P,TTYON
PUSHJ P,FIND
JRST FNF
JRST CRUT2
CRUT1: MOVEI A,0
PUSHJ P,NAMFIL ;DECODE FILE NAME
JUMPN A,CRUT4
PUSHJ P,FINDIT
PUSHJ P,TTYON
CRUT2: JUMPN L,CPOPJ
PUSHJ P,.URED"
JRST BADATA
HRRZ B,A
JUMPN B,CRUTM
MOVN C,A
CRUT3: PUSHJ P,.URED"
JRST BADATA
MOVEM A,SLAK(C)
AOBJN C,CRUT3
ADDI C,SLAK-1
PUSHJ P,DOTITE
JRST CRUT2
CRUTM: HRREM A,CRFLAG'
HLRZ C,A
MOVEI L,(A)
PUSHJ P,PDAT
CRUTM1: PUSHJ P,.URED"
JRST BADATA
MOVE L,A
PUSHJ P,PDAT
SOJG C,CRUTM1
MOVEI G,0
JRST CROP3
TAPCK: MOVE C,NTAPES'
CAME A,TAPTAB-1(C)
SOJG C,.-1
JUMPLE C,BADATA
POPJ P,
NAMFIL: PUSH P,A
PUSHJ P,RCOMN ;GET FILE NAME
MOVE C,[(700)SLAK-1
MOVSI K,400000
NAMFL0: MOVE J,K
NAMFL9: MOVSI K,400000
MOVE D,[440600,,K]
NAMFL1: ILDB E,C
CAIN E,"\
JRST NAMFL2
SUBI E,40
JUMPL E,NAMFL1 ;IGNORE LOOSING CHARS.
JUMPE E,NAMFL0
CAIN E,';
JRST NAMFL3
CAIN E,':
JRST NAMFL4
CAIL E,100
JRST NAMFL1
TLNE D,770000
IDPB E,D
JRST NAMFL1
NAMFL2: MOVEM J,NAMA'
MOVEM K,NAMB'
POP P,A
POPJ P,
NAMFL3: MOVE A,K
PUSHJ P,FILEST"
JRST BADSNM
JRST NAMFL9
NAMFL4: HLRZM K,(P)
JRST NAMFL9
BADSNM: MOVE B,[440700,,[ASCII ./BAD SYSTEM NAME\.]]
JRST DEATH
FIND: PUSHJ P,FILEST"
JRST SSSB
MOVE A,NAMA'
MOVE B,NAMB'
PUSHJ P,OPNRD"
POPJ P,
JRST SPOPJ
FINDIT: MOVE C,NTAPES
JUMPLE C,WRITW1
FINDT1: JUMPLE C,FNF
MOVE A,TAPTAB-1(C)
PUSHJ P,FIND
SOJA C,FINDT1
POPJ P,
FNF: MOVE B,[440700,,[ASCII ./FILE NOT FOUND\.]]
JRST DEATH
PRINT: SOJ H,
PUSH P,DONEW
PRINT1: AOJ H,
MOVE B,[HARMON]
PUSHJ P,GET
SKIPA B,[GOTO] ;MAY BE VOICE
JRST PHARM
PUSHJ P,GET
SKIPA B,[NUMBER]
JRST PVOICE
PUSHJ P,GET
SKIPA B,[MODALL]
JRST PNUMB
PUSHJ P,GET
SKIPA B,0
JRST PALL
PUSHJ P,GET
SKIPA
JRST PNIL
POPJ P,
PNIL: .VALUE ;PRINT A NOTHING
JRST PRINT1
PHARM: .VALUE ;PRINT HARMONIC STRUCTURE TABLE
JRST PRINT1
PNUMB: MOVE B,A
PNUM1: IDIVI B,10.
MOVEI A,60(C)
PUSHJ P,TYO
JUMPN B,PNUM1
JRST PRINT1
PALL: .VALUE
POPJ P,
PVOICE: .VALUE
POPJ P,
WRIT: MOVEI B,UNSTRU
PUSHJ P,GET
SKIPA B,[STRUCT]
JRST WRIT10
PUSHJ P,GET
SKIPA B,[HARMON]
JRST WRIT10
PUSHJ P,GET
JRST BADATA
WRIT10: PUSH P,B
MOVEI B,NUMBER
PUSHJ P,GET
JRST WRITW
PUSHJ P,TAPCK
WRIT13: PUSHJ P,NAMFIL
PUSHJ P,FILEST"
JRST SSSB
MOVE A,NAMA
MOVE B,NAMB
PUSHJ P,OPNWR"
JRST TUFLUK
POP P,C
MOVEI D,0
WRIT11: HLRZ A,TITL(D)
JUMPE A,WRIT2
CAME A,C
AOJA D,WRIT11
HRRZ B,TITL(D)
PUSHJ P,WRITE
WRIT2: HRRZ B,SYMS(C)
PUSHJ P,WRITE
MOVE A,NAMA
MOVE B,NAMB
PUSHJ P,FILE"
JRST TUFLUK
JRST DONE
WRITE: HLRZ D,(B)
SUBI D,1(B)
MOVS A,D
HRR A,(B)
PUSHJ P,.UWR"
JRST TUFLUK
WRIT12: MOVE A,1(B)
PUSHJ P,.UWR"
JRST TUFLUK
ADDI B,1
SOJG D,WRIT12
POPJ P,
WRITW: SKIPG NTAPES
JRST WRITW1
MOVE A,TIME
IDIV A,NTAPES
MOVE A,TAPTAB(B)
JRST WRIT13
WRITW1: MOVE B,[(700)[ASCII ./NO TAPES\.]-1]
DEATH": PUSHJ P,DOSAY5
JRST REALLY
CRSC: MOVE 0,[(1)SAVAC
BLT 0,SAVAC+16
PUSHJ P,SMOLGN"
MOVE 0,[(SAVAC)1
BLT 0,17
PUSHJ P,CRLF
MOVE C,SMOLTM"
LSH C,-7
IOR C,[ASCII ./ \.]
MOVE B,[(700)B
PUSHJ P,DOSAY5
MOVEI L,1
PUSHJ P,PDAT
SETZB G,CRFLAG'
SETZB A,CRSCD'
CRSC0: MOVE L,SMOLTM"(A)+1
JUMPE L,CRSC1
IMUL L,[(,-1000)
MOVE M,L
ASH M,-3
SUB L,M
HRR L,SMOLPT"(A)+1
HRR L,SMOLCP(L)
PUSH P,L
TRO L,EVENON
HLL L,CRSCD
MOVEM M,CRSCD
PUSHJ P,PDAT
POP P,L
PUSHJ P,PDAT
AOJA A,CRSC0
CRSC1: SKIPE SMOLTM+1(A)+1
AOJA A,CRSC0
JRST CROP2
SMOLCP: 45
46
50
52
53
55
57
60
CRKY: PUSHJ P,TTYON
PUSHJ P,CRLFQ
SETZM CRKYS1'
MOVE A,[(4)200000
MOVEM A,CRKYS2'
CRKYR: MOVEI L,1
PUSHJ P,PDAT
SETZB G,CRFLAG'
CONO 724,1
MOVEM L,CRKYDS'
CRKY3: CONSO 724,2
JRST .-1
CONO 724,1
SOS CRKYD'
CRKY1: DATAI 724,A
MOVE C,A
XOR A,CRKYS1'
MOVE B,A
JUMPE A,CRKY2
SUBI A,1
ANDCA A,B
XORM A,CRKYS1'
ANDM A,C
TLNN A,777000
TLOA A,32000
PUSHJ P,CRKY10
CRKY11: FAD A,[0
LSH A,-33
CAILE A,27
ADDI A,22
ADDI A,61
CRKY13: SKIPE C
TRO A,EVENON
SOSL CRKYDS'
SETZM CRKYD
HRL A,CRKYD'
MOVE L,A
PUSHJ P,PDAT
SETZM CRKYD
JUMPN M,CRKY2
JRST CRKY1
CRKY10: LSH A,-11
TLO A,43000
POPJ P,
CRKY2: DATAI 730,A
MOVE C,A
XOR A,CRKYS2'
MOVE B,A
JUMPE A,CRKY3
SUBI A,1
ANDCA A,B
XORM A,CRKYS2'
ANDM A,C
TLNN A,777000
TLOA A,32000
PUSHJ P,CRKY10
CRKY21: FAD A,[0
LSH A,-33
CAIGE A,27
JRST CRKY22
ADDI A,15
AOJA M,CRKY13
CRKY22: JUMPE C,CRKY2
CAIN A,24
JRST CROP2
CAIE A,20
JRST CRKY2
MOVE I,FREP'
JRST CRKYR
DEFINE CONCAT A,B
A!B!TERMIN
TTSTOU: MOVEI L,1
PUSHJ P,PDAT
SETZB N,CRDELZ'
SETZB G,K
TTGET: MOVE A,(K)
JUMPE A,TTGET1
ADD A,TTOX
MOVEM A,MEAS(K)
PUSHJ P,TT123Y
AOJA K,TTGET
TTGET1: MOVEM K,TTMG' ;# OF LINES
SETZB H,CRFLAG'
TT0: MOVEI M,0
MOVSI J,377777
TRO F,NOMORF
TT11: CAMN M,TTMG
JRST TT111
SKIPGE MEAS(M)
AOJA M,TT11
TRZ F,NOMORF
MOVE A,@LOCA(M) ;NOTE ENTRY
LDB B,[A(60700) ;NUM
LDB C,[A(600) ;DEN
IMUL B,TEMPF(M)
IDIV B,C ;COUNTS INTO MEASURE
ADD B,MSTM(M)
CAMGE B,J
MOVE K,M ;PART
CAMGE B,J
MOVEM B,J
AOJA M,TT11
TT111: MOVEI M,0
TT112: CAMN M,H
JRST TT12
TRZ F,NOMORF
HLRZ B,ALIVE(M)
CAMGE B,J
MOVEI K,ALIVE(M) ;PART+ALIVE
CAMGE B,J
MOVEM B,J
AOJA M,TT112
TT12: TRNE F,NOMORF
JRST CROP2
EXCH N,J
SUB J,N
ADDM J,CRDELZ'
CAIGE K,ALIVE
JRST TT120
MOVE L,(K) ;COMPILE 'OFF'
PUSHJ P,PDAT1A
HRLI K,1(K)
BLT K,ALIVE-1(H)
SOJA H,TT0
TT120: LDB A,[(220700)@LOCA(K)] ;COMPILE 'ON'
MOVE B,K
CAILE B,5
SUBI B,6
ASH B,7
ADDI B,-1(A)
CAIGE H,ALIVEL
SKIPE PLWN(B)
AOJA G,[SOJA H,TT0A] ;FORGET IT
TT1205: MOVEI L,EVENON(B)
SETOM PLWN(B)
PUSHJ P,PDAT1
TT121: LDB A,[(150500)@LOCA(K)] ;ARTIC. FIELD
CAILE A,10
MOVEI A,5
LDB C,[(370400)@LOCA(K)] ;N
LDB D,[(310600)@LOCA(K)] ;D
CAIGE A,5
MOVEI C,1
IMUL C,TTART1(A)
IMUL D,TTART2(A)
IMUL C,TEMPF(K)
IDIV C,D
LDB D,[(370400)@LOCA(K)]
LDB E,[(310600)@LOCA(K)]
IMUL D,TEMPF(K)
IDIV D,E
LDB E,[(60700)@LOCA(K)]
LDB A,[(600)@LOCA(K)]
IMUL E,TEMPF(K)
IDIV E,A
ADD D,E
ADD D,MSTM(K)
SUB D,C
HRL B,D
MOVEM B,ALIVE+1(H)
TT0A: PUSHJ P,TT122 ;AOSES H
JRST TT0
TT122: AOSA A,LOCA(K)
TT122A: MOVE A,(A) ;NOTE ENTRY
JUMPE A,TT123
TLNE A,177
TLNN A,377600
SKIPL A
JRST TT122M
LDB C,[(600)A] ;TEMPO WD.
LDB D,[(60700)A]
IMULI C,30000.
LDB E,[(311200)A]
IMUL D,E
IDIV C,D
MOVEM C,TEMPF(K)
JRST TT122
TT123: SOS LOCA(K) ;END OF MEASURE
SKIPGE MEAS(K)
JRST TT123X
TT123U: AOS A,MEAS(K)
TT123Y: MOVEM N,MSTM(K)
MOVE A,(A) ;MEASURE ENTRY
JUMPE A,TT123X
LDB B,[(311300)A]
JUMPN B,TT123U
TT124: ADD A,TTOX
MOVEM A,LOCA(K) ;MEASURE PTR.
JRST TT122A
TT123X: SETOM MEAS(K)
TT122M: AOJA H,CPOPJ
TTART1: 0
1
3
1
1
1
3
1
1
TTART2: 1
10
20
4
2
10
20
4
2
DOERA: HRRZ N,(P)
MOVE A,COML+1(H)
JUMPL A,BADATA
MOVE A,SYMS(A)
CAME A,[MODALL
JRST DOERA1
SKIPL COML+2(H)
JRST BADATA
CAIN N,DOERAS+1
TRNE F,PLEASF
SKIPA
JRST BADATA
MOVEI A,FREE"
XCT (N)
XCT 4(N)
MOVE M,NSYMS
SOJL M,DOERAX
DOERA4: HLRZ A,SYMS(M)
CAIN A,HARMON
XCT 1(N)
CAIE A,STRUCT
CAIN A,UNSTRU
XCT 1(N)
SOJGE M,DOERA4
JRST DOERAX
DOERA1: CAME A,[MODEXC]
AOJA H,DOERA3
ADDI H,2
MOVEI A,COML(H)
DOERA2: MOVE C,(A)
JUMPL C,DOERA5
HLRZ C,SYMS(C)
CAIN C,HARMON
AOJA A,DOERA2
CAIE C,STRUCT
CAIN C,UNSTRU
AOJA A,DOERA2
JRST BADATA
DOERA3: SKIPGE COML(H)
JRST DOERAX
XCT 2(N)
AOJA H,DOERA3
DOERA5: ADD C,NSYMS
DOERA7: HLRZ A,SYMS(C)
CAIN A,HARMON
JRST DOERA6
CAIE A,STRUCT
CAIN A,UNSTRU
JRST DOERA6
DOERA0: SOJGE C,DOERA7
DOERAX: POP P,A
JRST 5(N)
DOERA6: MOVEI B,COML(H)
DOERA9: SKIPGE (B)
JRST DOERA8
HRRZ A,(B)
CAME A,C
AOJA B,DOERA9
JRST DOERA0
DOERA8: XCT 3(N)
JRST DOERA0
;DOERS USES A,B,C,D
DOERS: PUSHJ P,GCHEK
DOERS1: MOVEM C,DOERSC'
HRRZ B,SYMS(C)
SETZM SYMS(C)
IFE 6V, HRRM C,RUDGE0
PUSHJ P,RUDGE
MOVEI D,0
DOERS5: HLRZ B,TITL(D)
JUMPE B,DOERS9
CAME B,DOERSC
AOJA D,DOERS5
DOERS8: HRRZ B,TITL(D)
HRLI A,TITL+1(D)
HRRI A,TITL(D)
BLT A,TITL+TITLL-2
PUSHJ P,RUDGE
DOERS9: MOVE C,DOERSC
POPJ P,
RUDGE: MOVEM B,RUDGEB' ;BLOCK ORIGIN
MOVEM B,RUDGER'
AOS RUDGER
HLRZ D,(B) ;BLOCK END+1
SUBM B,D
HLRZ B,(B)
RUDGE7: HLRZ A,(B)
CAMLE A,B
CAILE A,FREEND"
JRST RUDGE5
MOVE C,A
ADD C,D
HRLM C,(B)
MOVE B,A
JRST RUDGE7
RUDGE5: MOVE B,RUDGEB
HLL B,(B)
BLT B,FREEND"(D)
ADDM D,FREP
MOVE C,NSYMS
RUDGE2: HRRZ A,SYMS(C)-1
CAMGE A,RUDGEB
JRST RUDGE3
HLRZ A,SYMS(C)-1
CAIE A,STRUCT
CAIN A,UNSTRU
JRST RUDGE4
CAIN A,HARMON
JRST RUDGE4
RUDGE3: SOJG C,RUDGE2
MOVEI C,0
RUDGE6: HRRZ B,TITL(C)
JUMPE B,RUDGE8
CAMLE B,RUDGEB
ADDM D,TITL(C)
AOJA C,RUDGE6
RUDGE8:IFE 6V,[
MOVSI C,PSGTLT-HARCDE
RUDGE9: HRRZ B,PSGTLT(C)
CAMN B,RUDGER
RUDGE0: HRROI B, ;SYM #
CAMLE B,RUDGEB
ADDM D,PSGTLT(C)
SKIPGE B
MOVEM B,PSGTLT(C)
AOBJN C,RUDGE9
] POPJ P,
RUDGE4: CAMN A,RUDGEB
MOVNM D,SYMS(C)-1
ADDM D,SYMS(C)-1
JRST RUDGE3
GCHEK: HRRZ C,COML(H)
HLRZ B,SYMS(C)
CAIN B,HARMON
POPJ P,
CAIE B,STRUCT
CAIN B,UNSTRU
POPJ P,
JRST BADATA
NUMVLV: MOVEI A,10.
HRRM A,NUMVL8
TRZ F,BEGUNF
JRST NUMVLW
NUMVOC: SKIPA A,[10
NUMVAL: MOVEI A,10.
HRRM A,NUMVL8
TRO F,BEGUNF
NUMVLW: MOVEI C,COML+1(H)
TRZ F,PREVCF+MINUSF
MOVEI A,0
NUMVL1: SKIPGE (C)
JRST NUMVL9
HRRZ B,(C)
HLRZ B,SYMS(B)
CAIE B,MINUS
JRST NUMVL3
TRO F,BEGUNF
TRON F,MINUSF+PREVCF
AOJA C,NUMVL1
NUMVL9: MOVEI H,.-COML-$."-1(C)
TRZE F,MINUSF
MOVNS A
POPJ P,
NUMVL2: CAIE B,NUMBER
JRST NUMVLX
HRRZ B,(C)
HRRZ B,SYMS(B)
NUMVL8: IMULI A,10.
ADD A,B
NUMVL0: TRO F,PREVCF+BEGUNF
AOJA C,NUMVL1
NUMVL3: CAIE B,MULTIP
JRST NUMVL2
HRRZ B,(C)
HRRZ B,SYMS(B)
ADD B,NUMVL8
IMUL A,-10(B)
JRST NUMVL0
NUMVLX: TRNE F,BEGUNF
JRST NUMVL9
AOJA C,NUMVL1
DOVALU: MOVE C,COML(H)
JUMPL C,DONE
PUSHJ P,CRLF
HLRZ A,SYMS(C)
CAIE A,PARAM
JRST DOVAL4
HRRZ A,SYMS(C)
HLRZ B,DOPY(A)
CAIN B,(JFCL)
AOJA H,DOVALU
CAIE B,(MOVEM A,)
JRST SSSB
MOVE A,@DOPY(A)
DOVAL5: PUSHJ P,DPT
AOJA H,DOVALU
DOVAL4: MOVE A,SYMS(C)
CAMN A,[(GOTO)17]
JRST DOVAL6
CAME A,[(GOTO)12
JRST BADATA
MOVE A,TUNVAL'
JRST DOVAL5
DOVAL6: MOVSI D,-MAXNP"
SETZM DOVALW'
DOVAL9: SKIPGE E,PRECLE"(D)
JRST DOVAL8
MOVE B,[440700,,[ASCII ., \.]]
SKIPGE DOVALW
PUSHJ P,DOSAY5
HRLI E,CLEF
HRLZ C,NNSYMS
CAME E,SYMS(C)
AOBJN C,.-1
MOVEI A,1(D)
PUSHJ P,DPT
JUMPGE C,DOVAL7
MOVEI C,(C)
PUSHJ P,DOSAY6
JRST DOVAL8
DOVAL7: MOVE B,[440700,,[ASCII . ?\.]]
PUSHJ P,DOSAY5
DOVAL8: SETOM DOVALW
AOBJN D,DOVAL9
AOJA H,DOVALU
DOLIST: PUSHJ P,CRLF
PUSHJ P,TTYON
PUSHJ P,NUMVOC
MOVEM A,G
MOVE C,NSYMS
SUBI C,1
DOLST1: JUMPL C,DONE
HLRZ A,SYMS(C)
CAME A,G
SOJA C,DOLST1
PUSHJ P,DOSAY6
PUSHJ P,CRLF
SOJA C,DOLST1
DOTITL: MOVE A,COML(H)+1
JUMPL A,BADATA
HLRZ B,SYMS(A)
CAIN B,HARMON
JRST DOTIT1
CAIE B,UNSTRU
CAIN B,STRUCT
JRST DOTIT1
JRST BADATA
DOTIT1: HRRZM A,DOTITA'
PUSHJ P,RCOMN
PUSHJ P,DOTITE
JRST RCS
DOTITE: PUSHJ P,TTYOFF
MOVEM C,DOERSC'
MOVEI D,0
DOTIT2: CAIL D,TITLL-1
JRST TUFLUK
HLRZ A,TITL(D)
JUMPE A,DOTIT3
CAME A,DOTITA
AOJA D,DOTIT2
PUSHJ P,DOERS8 ;TO ERASE OLD TITLE
DOTIT3: MOVE I,FREP
MOVEI D,0
SKIPE TITL(D)
AOJA D,.-1
HRL A,DOTITA
HRR A,I
MOVE B,I
HRLI B,SLAK-1
ADDI I,2(C)
SUBI I,SLAK
CAIL I,FREEND"
JRST TUFLUK
BLT B,(I)
HRLZM I,@FREP
MOVEM I,FREP
MOVEM A,TITL(D)
SETZM TITL+1(D)
POPJ P,
IFE 6V,[
SCLBLD: MOVE A,[-1]
MOVEM A,HARN
JRST HARBLD
HARAUG: TDZA G,G ;AUGMENT HST
HARSCL: MOVNI G,1
JRST HARC
HARBLD: MOVEI G,1 ;BUILD HST
HARC: ADDI H,1
MOVE B,COML(H)
HLRZ A,SYMS(B)
JUMPLE G,HARC1
JUMPE A,HARC3 ;EX NIHILO
HARC1: CAIE A,HARMON
JRST BADATA ;CAN'T BUILD FROM THIS
HRRZ B,SYMS(B)
AOJA B,HARC2
HARC3: MOVE I,FREP ;BUILD
CAIL I,FREEND"-402
JRST TUFLUK
HRRM I,SYMS(B) ;CALL IT A HST
MOVEI A,HARMON
HRLM A,SYMS(B)
ADDI I,401
HRL A,I
HRRI A,2
MOVEM A,-401(I)
MOVEM I,FREP
SETZM -400(I)
MOVEI A,-377(I)
HRLI A,-400(I)
BLT A,-1(I)
MOVEI B,-400(I)
HARC2: HRRM B,HART ;DROPS THRU
HARBL1: PUSHJ P,NUMVAL
ADDI H,1
MOVE E,COML(H)
JUMPL E,HARBL8
MOVE B,SYMS(E)
CAMN B,[PUNCCL]
HARBL8: CAIL A,5 ;FOUR CHANNELS ONLY
JRST BADATA
HARBL0: JUMPL A,BADATA
MOVE L,A
JUMPLE G,HARBL9
MOVSI D,-400
MOVE C,[MOVEM C,@HART]
SKIPE L
MOVE C,[DPB C,@HART(L)]
MOVEM C,HARBM2
MOVEI C,0
HARBM2: MOVEM C,@HART ;OR DPB C,@HART(L)
AOBJN D,HARBM2
HARBL9: JUMPL E,DONE
MOVSI D,-400
HARTO: PUSHJ P,NUMVAL
ADDI H,1
MOVE B,COML(H)
JUMPL B,BADATA
MOVE B,SYMS(B)
CAME B,HARTOQ(G)+1 ;COMMAS ONLY HERE
JRST BADATA
HRRM A,HARMN ;HARMONIC #
MOVEM A,HARSN1'
PUSHJ P,NUMVAL
MOVE E,COML(H)+1
JUMPL E,HARBL2
MOVE B,SYMS(E)
CAME B,[PUNCSC] ;SEMI-COLONS ONLY, DROPS THRU
JRST BADATA
HARBL2: MOVEM A,HARSN2'
JUMPL G,HARSC
CAILE A,2000. ;LET'S BE REASONABLE
JRST BADATA
MOVMM A,HARAM' ;MAGNITUDE
IDIV A,HARAM
MOVEM A,HARAS' ;SIGN
HARL: SKIPE HARSN1 ;HARMONIC #
JRST HARL2
PUSHJ P,RANDOM ;WHITE NOISE
IDIVI A,2048.
JRST HARL3
HARL2: MOVEI A,(D)
HARMN: SKIPE HARN'
JRST HARNT ;USE PIANO SCALE
IMULI A,
IMUL A,HARAS
HARMN2: PUSHJ P,XSIN
HARL3:
ADDI B,2047.
IMUL B,HARAM
IDIVI B,16000.
JUMPN L,HARSC0
MOVE L,[-4,,1]
HARSC0: LDB A,HARPT(L)-1
ADD A,B
HARSC1: CAIL A,700
JRST HAROF ;OVERFLOW
DPB A,HARPT(L)-1
JUMPGE L,HARMN5
AOBJN L,HARSC0
MOVEI L,0
HARMN5: AOBJN D,HARL1 ;NEXT CYCLE
AOJA H,HARBL9 ;NEXT HARMONIC
HARL1: JUMPGE G,HARL
JRST HARSC
HARTOQ: PUNCSL
PUNCCM
PUNCCM
HARSC: JUMPN L,HARSC8
MOVE L,[-4,,1]
HARSC8: LDB A,HARPT(L)-1
IMUL A,HARSN1
IDIV A,HARSN2
CAIL A,700
JRST HAROF
DPB A,HARPT(L)-1
JUMPGE L,HARMN5
AOBJN L,HARSC8
MOVEI L,0
JRST HARMN5
HARPT: (1100)@HART
HART: (111100+D)
(221100)@HART
(331100)@HART
HAROF: MOVE B,[(700)[ASCII ./OVERFLOW\.]-1]
PUSHJ P,DOSAY5
JRST DONE
PSNTM1==0
PSNTM2==0
PSNTM3==0
PSNTM4==0
HARNT: PUSH P,B
PUSH P,A
HRRZ A,HARMN
IDIVI A,12 ;SCALE IT
MOVE B,TWTABL(B) ;TWELFTH ROOT OF 2
IMULI B,A ;FULL RANGE
POP P,A
IMULI A,B ;RESTORE
POP P,B
JRST HARMN2
HARWT: PSNTM1
PSNTM2
PSNTM3
PSNTM4
]
COS": FADR A,[1.57079631847]
SIN": MOVM B,A
CAMGE B,[.001
POPJ P,
FDV B,[1.57079631847
CAMG B,[1.0
JRST SINS2
MULI B,400
ASH C,-202(B)
MOVEI B,200
ROT C,3
LSHC B,33
FAD B,[0
JUMPE C,SINS2
TLCE C,1000
FSB B,[1.0
TLCE C,3000
TLNN C,3000
MOVNS B
SINS2: SKIPGE A
MOVNS B
MOVEM B,A
FMPR B,B
MOVE C,[.00015148419
FMP C,B
FAD C,[-.00467376557
FMP C,B
FAD C,[.07968967928
FMP C,B
FAD C,[-.64596371106
FMP C,B
FAD C,[1.57079631847
FMPR A,C
POPJ P,
XSIN: TLC A,232000
FAD A,A
FMP A,[.02454369248
PUSHJ P,SIN
FMP A,[2047.0
MULI A,400
TSC A,A
ASH B,-243(A)
POPJ P, ;RANGE OF B: -2047. TO +2047.
ATAN": PUSH P,B
MOVM B,A
CAMG B,[145000000000]
JRST ATANX
MOVEM A,C2'
CAML B,A2
JRST AT4
PUSH P,C
MOVSI C,201400
PUSH P,CMOVNS
CAMG B,C
AOSA (P)
FDVM C, B
MOVEM B,C3'
FMP B, B
MOVE C,KB3
FAD C, B
MOVE A,KA3
FDVM A,C
FAD C, B
FAD C,KB2
MOVE A,KA2
FDVM A,C
FAD C,B
FAD C,KB1
MOVE A,KA1
FDV A,C
FAD A,KB0
FMP A,C3'
FSBR A,[200622077325]
XCT (P)
FADR A,[200622077325]
SKIPA C,-1(P)
AT4: SKIPA A,A3
SUB P,[2,,2]
SKIPGE C2'
CMOVNS: MOVNS A
ATANX: POP P,B
POPJ P",
A2: 233000000000
A3: 201622077325
KB0: 0.1746554388
KB1: 6.762139240
KB2: 3.316335425
KB3: 1.448631538
KA1: 3.709256262
KA2: -7.106760045
KA3: -0.2647686202
;FLOATING POINT SQUARE ROOT FUNCTION
SQRT": MOVEM B,BSAV
MOVMS A
JUMPLE A,SQ2
ASHC A,-33
SUBI A,201
ROT A,-1
HRRM A,SQ1
LSH A,-43
ASH B,-10
FSC B,177(A)
MOVEM B,ST
FMP B,S1(A)
FAD B,S2(A)
MOVE A,ST
FDV A,B
FAD B,A
FSC B,-1
MOVE A,ST
FDV A,B
FADR A,B
SQ1: FSC A,0
SQ2: MOVE B,BSAV
POPJ P",
S1: 0.8125
0.578125
S2: 0.302734
0.421875
ST: 0
BSAV: 0
SCWAV: PUSHJ P,TTYON
MOVEI B,NUMBER
PUSHJ P,GET
JRST BADATA
MOVE D,A
MOVEI B,HARMON
PUSHJ P,GET
JRST BADATA
ADDI A,1
HRRM A,SCWAVT
SCWAV1: MOVSI A,-400
PUSHJ P,UWAIT"
CONO 4000+APRCHN ;CLK ENBL OFF
SCWAV2: LDB B,SCWAVT(D)-1
DPB A,[111100,,B]
MOVEM B,32
AOBJN A,SCWAV2
JRST SCWAV1
SCWAVT: 1100,,(A)
111100,,@SCWAVT
221100,,@SCWAVT
331100,,@SCWAVT
;CRRBK USES A,B,C,E; INITIALIZES N
CRRBK: MOVE N,[(2200)SLAK-1
PUSHJ P,R3B
JRST .-1
CAIL A,400000
JRST SPOPJ
MOVEM A,CRBSP'
JRST CRBC
CRBLOK: CONO PTR,20
PUSHJ P,R3B
JRST .-1
CAME A,CRBSP
JRST REALLY
CRBC: PUSHJ P,R3B
JRST CRBLOK
ADD A,CRBSP
MOVEM A,CRCKSM'
SUB A,CRBSP
SUB A,CRBSP
CAILE A,0
CAILE A,100
JRST 4,CRBLOK
MOVE C,[(2200)SLAK-1
MOVEM A,E
CRBWD: PUSHJ P,R3B
JRST CRBLOK
IDPB A,C
ADD A,CRCKSM
CAIL A,-1
SUBI A,-1
MOVEM A,CRCKSM
SOJG E,CRBWD
CR1R: PUSHJ P,R3B
JRST CRBLOK
CAME A,CRCKSM
JRST 4,CRBLOK
POPJ P,
R3B: PUSHJ P,R1B
POPJ P,
MOVE B,A
PUSHJ P,R1B
POPJ P,
ROT A,-6
ROTC A,6
PUSHJ P,R1B
POPJ P,
ROT A,-6
ROTC A,-30.
JRST SPOPJ
R1B: PUSHJ P,RPA
CAIL A,400
JRST 4,CPOPJ
TRZE A,200
TRZE A,100
JRST R1B
SPOPJ: AOS (P)
CPOPJ: POPJ P,
RPA: CONSO PTR,10
JRST .-1
DATAI PTR,A
POPJ P,
TYI":
.IOT 1,A
POPJ P,
CRLFQ: SKIPE BKD'
POPJ P,
CRLF": MOVEI A,15
PUSHJ P,TYO
SKIPA A,[12]
TYO6": ADDI A,40
TYO":
.IOT 2,A
POPJ P,
IFE 6V,[
PSGTR: MOVEM B,PSGTRP'
MOVE 0,[(SAVAC)1]
BLT 0,17
MOVE B,[440700,,[ASCII .
/STOP \.]]
SKIPN PSGTRP
MOVE B,[440700,,[ASCII .
/VOICE \.]]
SKIPN PSGTRP
MOVEM A,PSGTRP
PUSHJ P,DOSAY5
MOVE A,PSGTRP
PUSHJ P,DPT
MOVE B,[440700,,[ASCII . NOT SPECIFIED/
\.]]
JUMPE 0,PSGTR6
MOVE B,[440700,,[ASCII . HARMONICS\.]]
PUSHJ P,DOSAY5
HRRZ C,0
PUSHJ P,DOSAY6
MOVE B,[440700,,[ASCII . NOT BUILT/
\.]]
PSGTR6: PUSHJ P,DOSAY5
JRST PLDONE
VOXPT: TDZA G,G ;ASSIGN HST TO VOICE
VOXCD: MOVEI G,1
MOVEI B,HARMON
PUSHJ P,GET
JRST VOXCD1 ;NOT HST
VOXCD2: MOVEI J,1(A)
PUSHJ P,NUMVLV
JUMPLE A,BADATA ;NOT NOTHING EITHER
CAMLE A,VOXSLT(G)
JRST BADATA
MOVEM J,@VOXSTT(G)
JRST DONE
VOXCD1: MOVEI B,0
PUSHJ P,GET
JRST BADATA
JRST VOXCD2
VOXSTT: PSGTLT(A)-1
HARCOD(A)-1
VOXSLT: 10
30
]
DPT: JUMPGE A,DPT1
MOVN B,A
MOVEI A,"-
PUSHJ P,TYO
MOVE A,B
DPT1: IDIVI A,10.
JUMPE A,TYN
PUSH P,B
PUSHJ P,DPT
POP P,B
TYN: MOVEI A,60(B)
JRST TYO
TTYON:
TTYOFF: POPJ P,
IFN 6V,[
HARAUG:
HARSCL:
HARBLD:
PLGOA:
PSGOA:
PLWHOA:
VOXPT:
VOXCD: MOVE B,[440700,,[ASCII ./SORRY, NO PLAYER ROUTINES
\.]]
JRST DEATH"
]
IFE 6V,[
;MI PLAYER, ENTER AT PLGOA
PSGOA: SKIPA A,[PSGTF]
PLGOA: MOVEI A,PLWHY1
HRRM A,PLWHY
PUSHJ P,CRLFQ
PUSHJ P,TTYON
JRST PLGO
PLGNP: ADDI H,1
SKIPGE COML(H)
JRST PLDNE
HRRZ A,COML(H)
HLRZ B,SYMS(A)
CAIE B,UNSTRU
JRST NOTSTR
MOVE B,SYMS(A)
HRRM B,PLWHRE
HRRZM B,PSDATL
SKIPGE PLAYP
PLWHY: JRST
PUSHJ P,TUNER
PLWHYT: .ACCESS 16,[76]
.IOT 16,A ;SEE IF IT'S TUNED
AOJN A,PLWHYT
JRST PLWHY
PLWHOA: SKIPL PLAYP
AOJA H,DO1
PLWHA1: .ACCESS 16,[77]
.IOT 16,A
SOJL A,PLWHA3
.ACCESS 17,PLWHAT(A)
.ACCESS 16,PLWHAT(A)
.IOT 16,D ;SAVE WORD
MOVE C,[-1,,[JRST 100]]
.IOT 17,C ;CLOBBER
PLWHA2: .ACCESS 16,[77]
.IOT 16,B
JUMPN B,PLWHA2 ;WAIT UNTIL STOPPED
MOVE C,[-1,,D]
.ACCESS 17,PLWHAT(A)
.IOT 17,C ;RESTORE
PLWHA3: AOJA H,DO1
PLWHAT: PLAY1 ;MI
PLAY2 ;DAC
PLWHY1: MOVEI 0,0
.ACCESS 17,[MUSDAT]
PLWHRE: HLRZ B,
AOS PLWHRE
HRRZ A,PLWHRE
SUBI A,(B)
HRL A,A
HRR A,PLWHRE
.IOT 17,A
.ACCESS 17,[77]
MOVE A,[-1,,[1]]
.IOT 17,A
.ACCESS 17,[76]
MOVE A,[-1,,[1]]
.IOT 17,A
PLDONE:
PLGO: PUSHJ P,NUMVAL
PLLCT: SOJL A,PLGNP ;YAWN
.RD710 A
ADDI A,700000
.RD710 B
CAMGE B,A
JRST .-2
JRST PLLCT
PLDNE: JRST DONE
NOTSTR: MOVE B,[440700,,[ASCIZ ./UNSTRUCTURED MUSIC ONLY\.]]
PUSHJ P,DOSAY5
JRST BADATA
]
IFN 6V,[
TUNEUP:
DETUNE: MOVE B,[440700,,[ASCII ./SORRY, NO PLAYER ROUTINES
\.]]
JRST DEATH"
]
IFE 6V,[
TUNEUP: SKIPA A,[440.]
DETUNE: PUSHJ P,NUMVAL
MOVEM A,TUNVAL'
TLC A,232000
FAD A,A
MOVE C,A
FMPR A,[.OP FDVR 52944.0 440.0]
MULI A,400
TSC A,A
ASH B,-243(A)
FMPR C,[.OP FDVR 6442450994.0 440.0]
MULI C,400
TSC C,C
ASH D,-243(C)
MOVEM D,PDP6P+1
TUNE1: MOVEM B,PDP6P
TUNER: .SUSET [.RUNAME,,A]
MOVEM A,PDP6B+1
MOVEM A,PDP6C+1
.OPEN 17,PDP6B
JRST NOPDP6
.RESET 17, ;CLEAR CORE
.ACCESS 17,[73]
MOVE A,PDP6P1
.IOT 17,A ;LOAD PROGRAM
.ACCESS 17,[37]
MOVE A,PDP6P2
.IOT 17,A ;SET IT GOING
.OPEN 16,PDP6C
JRST NOPDP6
SETOM PLAYP
MOVNI A,100
PDOP1: .ACCESS 16,[37]
.IOT 16,B
AOJE B,PDOP2
AOJL A,PDOP1
MOVE B,[440700,,[ASCII .
/PLEASE START THE PDP-6 AT 100
\.]]
PUSHJ P,DOSAY5
PDOP2: POPJ P,
NOPDP6: MOVE B,[440700,,[ASCII ./CAN'T GET PDP-6
\.]]
JRST DEATH"
PDP6B: 3,,(SIXBIT /USR/)
0
SIXBIT /PDP6/
PDP6C: (SIXBIT /USR/)
0
SIXBIT /PDP6/
PDP6P1: PDP6P-PDP6PE,,PDP6P
PDP6P2: -3,,.+1
1
0
JRST 100
CONSTANTS
VARIABLES
PDP6P: OFFSET 73-.
PLRCM: 0
PLRS9: 0
0
0 ;76: 0 UNTUNED, -1 WAITING, 1 TO GO
0 ;77: 0 INITIALLY, 1 TO PLAY MI, 2 TO PLAY DAC
PGO: SETZM 77 ;100
SETZM 37
PLD: SKIPGE A,76
JRST PLD
JUMPE A,PLD1
MOVE A,77
JRST @PLDT(A)
PLDT: PLD1
PLMI
PLSC
PLD1: CONO PI,11577
CONO 200000
MOVE A,[JSR PLRC1]
MOVEM A,42
SETZM PLTAB
SETZM PLTAB+1
SETZM PSTB4
SETZM PSTB4+1
MOVSI 15,400000
MOVNI 14,60.
CONO PI,12300
CONO 1000
CONSO 1000
JRST .-1
CONO 1000
CONO 2001
JRST PLAY
PLRC1: 0
CONO 1001
AOJGE 14,PLRC2
JRST 12,@PLRC1
;INCREMENT TABLES, BUILT BY TUNEUP
PSTB1: BLOCK 100
PSTB2: BLOCK 100
PSTB3: BLOCK 100
PSTB4: BLOCK 77
PSTBT: BLOCK 1
PSTBX=PSTBT-14
PSTBE:
PLRC2: CONO PI,11577
HRRZ A,PLRC1
SUBI A,PLAY
TLZ 15,400000
IMULI 15,31 ;PLAY LOOP
ADD A,15
MOVEI C,0
MOVS D,PLRCM
DIV C,A
MOVEI A,PLTABX
MOVE P,PP
MOVEI F,PLTAB
MOVEI G,PLBOT
PUSHJ P,PLRCE
PLRS: CONO 200000
MOVE A,[JSR PLRS1]
MOVEM A,44
MOVEI A,[(400000)]-1
MOVEM A,PSDATL
MOVEI A,1
EXCH A,PSTEMP
MOVEM A,PLPSTP'
MOVNI A,60.
MOVEM A,PLRS0'
CONO PI,12240
CONO 1000
CONSO 1000
JRST .-1
CONO 3002
JRST PSGTF
PLRS1: 0
CONO 1002
AOSGE PLRS0'
JRST 12,@PLRS1
CONO PI,11577
HRRZ A,PLRS1
CAIL A,PSGTT3
SUBI A,PSGTT3-27
SUBI A,7
TLZ 0,400000
IMULI 0,16
ADD A,0
MOVEI C,0
MOVE D,PLRS9
ASHC C,3
DIV C,A
MOVEI A,PSTBX
MOVE P,PP
MOVEI F,PSTB4
MOVEI G,PSTB1
PUSHJ P,PLRCE
MOVE A,PLPSTP
MOVEM A,PSTEMP
SETOM 76
JRST 100
PLRCE: MOVE B,C
PLRC3: HRRM A,PLRC4
MOVEI E,13
PLRC4: MOVEM C,(E)
MUL C,[(361503)374705]
SOJGE E,.-2
ASH B,-1
MOVE C,B
SUBI A,14
CAML A,F
JRST PLRC3
PLRC5: MOVEM C,13(A)
MOVEI A,-2(F)
MOVE C,100(A)
MUL C,DTC
MOVEM C,(A)
CAMLE A,G
SOJA A,.-4
POPJ P,
DTC: (377200)
DEFINE PART N
P!N: ADDI N,
III==1_<6-N>
TLNE N,1
TROA III
TRZ III
TERMIN
PLMI: SETOM 76
MOVEI 0,0
MOVEI 17,MUSDAT
JRST PLGT
PLOFF: ASH 15,-7
HLLZS @PLACC(15)
PLGT: HLLE 15,(17) ;GET DURATION
IDIV 15,PLTEMP
JUMPE 15,PLGE
PLAY: REPEAT 6,PART \.RPCNT+1
PLAY1: MOVEM 32 ;MI ON 32 ALSO
AOJL 15,PLAY
PLGE: HRRZ 15,(17) ;NOTE
JUMPE 15,PGO ;DONE?
TRZN 15,EVENON ;BEG OF CHORD?
AOJA 17,PLOFF
ANDCMI 15,374000
IDIVI 15,200
MOVE 14,@PLGET(15)
HRRM 14,@PLACC(15)
AOJA 17,PLGT
]
IFE 6V,[
PLTEMP: 200000
PLACC: P1
P2
P3
P4
P5
P6
P1
P2
PLGET: PLTB1(16)+1 ;POINTERS TO FREQ TABLE
PLTB2(16)+1
PLTB3(16)+1
PLTB4(16)+1
PLTB5(16)+1
PLTB6(16)+1
PLTB1(16)+1
PLTB2(16)+1
PLBOT: BLOCK 500
PLTAB: BLOCK 77
PLTABT: BLOCK 1
PLTABX=PLTABT-14
PLTB1=PLBOT
PLTB2=PLTB1+100
PLTB3=PLTB2+100
PLTB4=PLTB3+100
PLTB5=PLTB4+100
PLTB6=PLTB5+100
PSGTF: MOVE 0,[(PSGTT)7]
BLT 0,17
MOVE 0,[(PSGTTL)PSGTT3]
BLT 0,PSGCCF
MOVE A,PSGTLT
HRRM A,PSGTT1-R
MOVE A,PSGTLT+1
HRRM A,PSGTT2-R
MOVE A,PSGTLT+2
HRRM A,PSGTT3
MOVE A,PSGTLT+3
HRRM A,PSGTT4
JRST PSGT
PSTEMP: 200000
PSGTT: ADDI C,0
LDB B,PSGCCC
PSGTT1: MOVE A,(B)
ADDI D,0
LDB B,PSGCCD
PSGTT2: ADD A,(B)
ADDI E,0
LDB B,PSGCCE
JRST PSGTT3 ;17
PSGTTL:
PSGTT3: ADD A,(B)
ADDI F,0
LDB B,PSGCCF
PSGTT4: ADD A,(B)
PLAY2: MOVEM A,32
AOJL 0,7
PSGTB: HRRZ A,@PSDATL
TRZE A,EVENON+374000
JRST PSGTA
JUMPE A,PGO
PSOFF: ASH A,-7
HLLZS @PSPT(A)
PSGT: AOS A,PSDATL
HLLE 0,(A)
IDIV 0,PSTEMP
XCT 7
XCT 12
XCT 15
XCT PSGTT3+1
JUMPN 0,7
JRST PSGTB
PSGTA: IDIVI A,200
MOVE 0,@PSGTAT(A)
HRRM 0,@PSPT(A)
LDB B,[130600,,@PSDATL]
MOVE 0,@PSGY(B)
JUMPLE 0,PSGTR
HRRM 0,@PSGTTT(A)
XCT 7
XCT 12
XCT 15
XCT PSGTT3+1
JRST PSGT
;32 IS D-A LOC
R==PSGTT-7
PSPT: 7
12
15
PSGTT3+1
7
12
15
PSGTT3+1
PSGY: PSGTLT(A)
REPEAT 30,HARCOD(B)-1
PSGTAT: PSTB1(B)+1
PSTB2(B)+1
PSTB3(B)+1
PSTB4(B)+1
PSTB1(B)+1
PSTB2(B)+1
PSTB3(B)+1
PSTB4(B)+1
PSGTTT: PSGTT1-R
PSGTT2-R
PSGTT3
PSGTT4
PSGTT1-R
PSGTT2-R
PSGTT3
PSGTTE: PSGTT4
PSGCCC: 121000,,C
PSGCCD: 121000,,D
PSGCCE: 121000,,E
PSGCCF: 121000,,F
CONSTANTS
VARIABLES
PP: -10,,PPBK-1
PPBK: BLOCK 10
PSDATL: 0
PSGTLT: BLOCK 10
HARCOD: BLOCK 30
HARCDE:
MUSDAT: OFFSET 0 ;-DURATION,,EVENON+VOICE*200+PTR TO FREQ?
PDP6PE:
]
SYMTAB: SIXBIT /0 1 2 3 4 5 6 7 8 9 ZERO ONE TWO THREE FOUR FIVE/
SIXBIT / SIX SEVEN EIGHT NINE C D E F G A B ST ND RD TH /
SIXBIT /DETEMPO - MINUS SOPRANO ALTO TENOR B/
SIXBIT /ASS FORGET ALL EXCEPT READOLD TUNEUP TEMPO PLOLD/
SIXBIT / VALUE K M THOUSAND MILLION MENTION ENTITLE ENTE/
SIXBIT /R TAPES READ WRITE [ ] = PLSCOPE , : ; BUILD BUI/
SIXBIT /LDON JRST MELGEN KEYBOARD TUNING FROM TO TRANSLA/
SIXBIT !TE PLEASE SCRIPT SCRIPTSIZE VOLBUILD # READNEW V!
SIXBIT /OICE STOP ++ VIEWWAVE INTREAD SCRIPTSPACE SCRIPT/
SIXBIT /MNINT AGAIN * ** ^ SLURDENS ARDS TREBLE SCRIPTCL/
SIXBIT /EF ? NOPLAY WHOA SCLBUILD PRINT SYN SYNONYM /
BLOCK SYMTAB-.+SYTLL
SYTEND:
SYMS: REPEAT 2,[ZZZ=0
REPEAT 10.,[(NUMBER)ZZZ
ZZZ=ZZZ+1
]]
REPEAT 7,[(TONUS)ZZZ-10.
ZZZ=ZZZ+1
]
REPEAT 4,(ORDFLG)
(PARAM)3
(MINUS)
(MINUS)
(CLEF)7
(CLEF)6
(CLEF)5
(CLEF)4
(ERASER)0
MODALL
MODEXC
(CREATE)0
(GOTO)0
(PARAM)4
(PLAYER)0
(GOTO)1
(MULTIP)MULTAB
(MULTIP)MULTAB+1
(MULTIP)MULTAB
(MULTIP)MULTAB+1
(ERASER)1
(GOTO)2
(GOTO)3
(GOTO)4
(CREATE)1
(GOTO)5
(BRAKET)0
(BRAKET)1
(GOTO)6
(PLAYER)1
PUNCCM
PUNCCL
PUNCSC
(GOTO)7
(GOTO)10
(GOTO)11
(CREATE)2
(CREATE)3
(GOTO)12
PUNCFM
PUNCTO
(TRANSL)0
MODPLS
(SCRIB)0
(PARAM)5
(GOTO)13
PUNCSL
(CREATE)4
(GOTO)14
(GOTO)15
(CREATE)5
(GOTO)16
(CREATE)6
(PARAM)1
(PARAM)2
MODAGN
(STAR)0
(STAR)1
(STAR)2
(PARAM)6
(PARAM)7
(CLEF)2
(GOTO)17
(CLEF),-1
(GOTO)20
(GOTO)21
(GOTO)22
(GOTO)23
(GOTO)24
(GOTO)24
BLOCK SYMS-.+SYMLL
TWTABL: BLOCK 12 ;ROOTS OF 2
0
DONEW: DONE ;USED BY PC HACKS
PLSC: .VALUE
JRST DONE
0
STRING: BLOCK STRLL
0
SLAK: BLOCK SLAKLL
COML: BLOCK COMLL
COMSL: BLOCK COMLL
TEMPF: BLOCK NLINES
LOCA: BLOCK NLINES
MEAS: BLOCK NLINES
MSTM: BLOCK NLINES
ALIVE: BLOCK ALIVEL
PDLSE: LOSE
PDL": BLOCK PDLL
XPDL: BLOCK XPDLL
YPDL: BLOCK YPDLL
TITL: 0
BLOCK TITLL-1
TAPTAB: 0
BLOCK NDIR-1
PLWN: BLOCK NRNO
SAVAC: BLOCK 17
PATCH": BLOCK 100
MULTAB: 1000
1000000
1000.
1000000.
TYPE: -1
0 ;!
-1 ;"
-1 ;#
0 ;$
0 ;%
0 ;&
-1 ;'
-1 ;(
-1 ;)
1 ;*
1 ;+
-1 ;,
-1 ;-
0 ;.
-1 ;/
-1 ;0
-1 ;1
-1 ;2
-1 ;3
-1 ;4
-1 ;5
-1 ;6
-1 ;7
-1 ;8
-1 ;9
-1 ;:
-1 ;;
-1 ;<
1 ;=
-1 ;>
-1 ;?
-1 ;@
0 ;A
0 ;B
0 ;C
0 ;D
0 ;E
0 ;F
0 ;G
0 ;H
0 ;I
0 ;J
0 ;K
0 ;L
0 ;M
0 ;N
0 ;O
0 ;P
0 ;Q
0 ;R
0 ;S
0 ;T
0 ;U
0 ;V
0 ;W
0 ;X
0 ;Y
0 ;Z
-1 ;[
-1 ;\
-1 ;]
1 ;^
1 ;_
VARIAB
CONSTA
FREE":
LOC FRETOP
FREEND":
DEFINE MESS A,B
PRINTX ?A!B
?
TERMIN
IF2,MESS [LENGTH OF FREE STORAGE = ]\FREEND-FREE
END SETUPX

Reference in New Issue View Git Blame Copy Permalink