; TTL "Mirage Freq MIDI code"
*
*===============================
* MIRAGE FREQ
*===============================
*
 LST OFF
C64 EQU 0 ; set to 0 for 128, 1 for C64
TEST EQU 0 ; set to 1 for testing, 0 for normal
*
* This program simply sends a request to a Mirage asking
* for a configuration dump.  It receives this dump and then
* returns the input sample time (parameter [73]).
*
* C=128 object should be named getrate.o
* C=64 object should be named getrate64.o
*
* constants...
ACIA = $DE00 ; starting point for ACIA
* these addresses are for 'sci' interfaces
CAW = $DF01 ; PIA control a write
CBW = $DF03 ; PIA control b write
PIARST = $04 ; PIA reset
*
* these constants are the same for both
IFRST = $13 ; ACIA master reset
IFOFF = $15 ; ACIA off
IFENABL = $15 ; no ACIA interrupts
*
BORDER = $D020 ; VIC chip border address
*
* Starting address (h/w dependent)
 DO C64
 ORG $C000
 ELSE
 ORG $1300
 FIN
*
* The Basic program gets its values returned after the three
* bytes for the jump vector.
 JMP START ; vector to code
SMPLRATE DFB 0 ; sampling rate value [73]
IFILTER DFB 0 ; internal filter value [74]
EFILTER DFB 0 ; external filter value [93]
IFTYPE DFB $FF ; interface type 0-passport, 1-sci, -1 bad
STATUS DFB 0 ; returned status
; 0 - ok
 ; 1 - bad interface
 ; 2 - timeout
 ; 3 - MIDI error
TOCOUNT DFB 0 ; when this goes to zero, we've timed out
*
*-------------------------------
* START
*-------------------------------
*
* First, check to see if we know what sort of interface,
* if not - figure it out.
*
* Next, send the config dump request.
*
* Finally, receive the config dump and return the sample rate.
*
START = *
 LDA #12 ; reset the border...
 STA BORDER
 LDA #0
 STA STATUS ; start with a clean slate...
 JSR IFCHECK
 LDA STATUS ; if non-zero - we had a problem
 BEQ :LOOP
 RTS  ; return with error (STATUS)
:LOOP LDA #0 ; reset status again...
 STA STATUS
 SEI ; let's not be interrupted...
 JSR SENDREQ ; send the request for data
 JSR GETDUMP ; get the data
 CLI ; ok, what was that...interrupts back on
 LDA STATUS ; was it good?
 BNE :OUT ; nope, skip the update, error in STATUS
 JSR INSTALL ; put the values where they belong
:OUT RTS
*
*-------------------------------
* SEND REQuest
*-------------------------------
*
* Send the sysex command that asks for a configuration dump
*
SENDREQ = *
 JSR MIDICLR ; clear the i/f

 LDY #0 ; byte counter
:LOOP LDA CPDR,Y ; load the byte from the table
 JSR MIDISEND ; send it to the Mirage
 INY
 CPY #4 ; send four of them
 BNE :LOOP
 RTS
CPDR = * ; Configuration Parameters Dump Req
 HEX F00F0100F7
*
*-------------------------------
* GET DUMP
*-------------------------------
*
*===============================
* That's all we need to do if no other data are sent.
* Not likely so there is some error checking in here.
*
GETDUMP = *
:RETRY JSR MIDIGET ; make sure we start with a SysEX
 BCS :ERROR ; error - code is already in status
:RETRY2 CMP #$F0 ; is this a SysEx start?
 BEQ :LOOP0 ; yup, ok - let's get the rest
 JMP :RETRY ; so long as we're getting data,
; keep trying
:LOOP0 LDY #0 ; byte counter...
:LOOP JSR MIDIGET
 BCS :ERROR ; something went wrong - STATUS is set
 CMP #0 ; is it data (correct) or a command?
 BMI :RETRY2 ; this is an error - jump back up and
; look for a SysEx start.
:OK STA DUMPTBL,Y ; save it...
 DO TEST
 STA 1024,Y ; if TEST is on, put the data on the 40 column screen
 FIN
 INY
 CPY #60 ; only get the first 60.
 BNE :LOOP
* ok, at this point it looks like we got it, but let's check
* the first couple of bytes to be sure. If they're wrong, figure
* we're picking up some other SysEx and so go back up to
* GETDUMP.  This will tend to clear out any extraneous/extra
* data until we get the config dump, or we time out.
 LDA DUMPTBL ; this should be the 15
 CMP #$0F ; ensoniq code
 BNE GETDUMP
 LDA DUMPTBL+1 ; this should be 1
 CMP #1 ; Mirage code
 BNE GETDUMP
 LDA DUMPTBL+2 ; this should be 6
 CMP #2 ; Config Dump Data
 BNE GETDUMP
:OUT RTS
* There was a MIDI error returned from MIDIGET.  If the
* interface is not right, do a reset.
:ERROR LDA IFSTAT ; get the interface status.
 AND ERRMSK ; and with the error mask
 BNE :RESET
 RTS
:RESET JSR MIDICLR
 JMP GETDUMP ; try again
*
DUMPTBL = *
 DS 3 ; rest of SysEx header
 DS 12 ; first six bytes
SRVAL DA 0 ; sample rate value
IFVAL DA 0 ; internal filter value
 DS 36 ; more of the message
EFVAL DA 0 ; external filter value
 DS 5 ; the last bit

*
*-------------------------------
* MIDI GET
*-------------------------------
*
* This routine gets the next MIDI byte and returns it
* in .a.  .x is used for the pointer to the i/f registers
* .y is not altered
*
MIDIGET = *
 LDA #0
 STA TOCOUNT
 STA STATUS

 LDX AS ; offset to status reg
:LOOP LDA ACIA,X ; get MIDI status byte
 STA IFSTAT ; save the interface status

 DO TEST
 STA 1144 ; show it on the screen - col 1 line 4
 FIN

 BIT ERRMSK ; mask for errors
 BEQ :OK

 DO TEST
 LSR  ; put the error code in the border
 LSR
 LSR
 STA BORDER ; this way we can see the error
 LDA 1144
 STA 1145 ; show last error
 FIN

 LDA #3 ; midi error
 STA STATUS
 SEC
 RTS
*
* No error - check to see if we got something...
:OK LSR  ; shift status bit to carry
 BCS :CONT ; got something - handle it

; didn't get anything start timeout
 DO TEST
 INC 1184
 FIN

 TYA ; a time killing loop
 PHA
 LDY #2 ; adjust as needed
:L DEY
 BNE :L
 PLA
 TAY
 DEC TOCOUNT ; try again  - a few more times
 BNE :LOOP

 LDA #2 ; error code for timeout
 STA STATUS
 SEC ; error (timeout)
 RTS

:CONT DEC BORDER ; indicate that we have a byte
 LDX AR ; offset to read reg
 LDA ACIA,X
 CLC ; no error
 INC BORDER ; show that we got it
:OUT RTS
ERRMSK DFB %111000 ; bits to check for errors
IFSTAT DFB 0
*
*-------------------------------
* MIDI SEND
*-------------------------------
*
* assembler entry point '.a' contains byte to send
* to interface.  Checks the i/f, sends the byte when
* it is ready.
*
MIDISEND = *
 PHA ; remember the byte to send
 LDX AS ;
:LOOP LDA ACIA,X ; get the status
 AND #2 ; ready?
 BEQ :LOOP ; no, not yet...
*
 LDX AW ; ok - now...
 PLA
 STA ACIA,X
 RTS
*
*-------------------------------
* InterFace CHECK
*-------------------------------
*
IFCHECK = *
 LDA IFTYPE ; if negative, we haven't been here
 BMI MIDIINIT ; go figure it out
 RTS ; otherwise - we're fine - return
*
*-------------------------------
* MIDI INITialize
*-------------------------------
*
* Determine the type of the MIDI interface and
* set up accordingly...
MIDIINIT = *
 LDA #IFRST
 STA $DE08 ; see if we've got a passport
 LDA $DE08 ; should be zero
 BNE :CONT ; not a passport
 LDA #IFOFF
 STA $DE08
 LDA $DE08
 CMP #2 ; should be 2
 BNE :CONT
*
 LDX #0 ; Passport
 BEQ SETMTBL
*
:CONT LDA #IFRST ; see if we've got an SCI
 STA $DE00
 LDA $DE02 ; should be 0
 BNE BADIF
 LDA #IFOFF
 STA $DE00
 LDA $DE02 ; should be 2
 CMP #2
 BNE BADIF
*
 LDX #1 ; SCI - fall through
*
*-------------------------------
* SET Midi TaBLe
*-------------------------------
*
* at this point .x contains the interface type.
* load up the four locations to based on that.
*
SETMTBL = *
 STX IFTYPE
 BEQ :CONT
 LDA #PIARST ; reset the PIA (SCI only)
 STA CAW
 STA CBW
:CONT LDA COFF,X ; passport and SCI both - set up
 STA AC ; register pointers
 LDA SOFF,X
 STA AS
 LDA ROFF,X
 STA AR
 LDA WOFF,X
 STA AW
*
MIDIRST = *
 LDX AC ; control register
 LDA #IFRST ; master reset
 STA ACIA,X
 LDA #IFENABL ; turn it on
 STA ACIA,X
 RTS
*
* These tables contain the offsets to each of the
* four registers on the ACIA.
COFF DFB 8,0 ; control
AC DFB 0
SOFF DFB 8,2 ; status
AS DFB 0
ROFF DFB 9,3 ; read
AR DFB 0
WOFF DFB 9,1 ; write
AW DFB 0
*
*
* oops - bad or missing interface.
BADIF = *
 LDA #7
 STA BORDER
 LDA #1
 STA STATUS
 RTS
*
*-------------------------------
* MIDI OFF
*-------------------------------
*
* Turn off the midi interface
*
MIDIOFF ENT
 LDX AC
 LDA #IFRST ; i/f Master Reset
 STA ACIA,X
 LDA #IFOFF ; i/f interrupts off
 STA ACIA,X
 RTS
*
*-------------------------------
* FLaSH the BoRDeR
*-------------------------------
FLSHBRDR = *
 LDA BORDER ; get new border color
 AND #$0F ; mask to 16 colors we know
 STA FLSHCLR ; use to return to this color
 TAX ; use as an index
 LDA BDRCLRS,X
 STA BORDER
 RTS
FLSHBACK = *
 LDA FLSHCLR
 STA BORDER
 RTS
FLSHCLR DFB 0
*
BDRCLRS = *
 DFB 8 ; black -> orange (overrun)
 DFB 1 ; white
 DFB 10 ; red -> pink (framing error)
 DFB 4 ; cyan -> purple (parity?)
 DFB 3 ; purple -> cyan (parity?)
 DFB 5 ; green
 DFB 6 ; blue
 DFB 13 ; yellow - lt green (over flow)
 DFB 0 ; orange -> black (overrun)
 DFB 9 ; brown
 DFB 2 ; pink ->red (framing error)
 DFB 11 ; dk grey
 DFB 15 ; med grey -> lt grey (normal)
 DFB 7 ; lt green -> yellow (over flow)
 DFB 14 ; lt blue
 DFB 12 ; lt grey -> med grey (normal)
*
*-------------------------------
* INSTALL values
*-------------------------------
*
* This routine puts the three values we want into
* the correct location.  It also handles merging
* the data from two bytes to one.
*
INSTALL = *
 LDA SRVAL+1 ; sampling rate
 LDX SRVAL
 JSR MERGE
 STA SMPLRATE ; [73]
*
 LDA IFVAL+1 ; input filter rate
 LDX IFVAL
 JSR MERGE
 STA IFILTER ; [74] this is twice the value displayed
*
 LDA EFVAL+1 ; external filter rate
 LDX EFVAL
 JSR MERGE
 STA EFILTER ; [93]
 RTS

MERGE = *
*
* Just shift and add the two nybbles together...
* .a=MSB .x=LSB
 STX TEMP
 ASL
 ASL
 ASL
 ASL
 ORA TEMP
 RTS
TEMP DFB 0
*
*-------------------------------
* MIDI CLeaR
*-------------------------------
*
* This is a bit of a kludge - but appears to be
* required
*
MIDICLR = *
 LDX AC
 LDA #IFRST
 STA ACIA,X
 LDA #IFENABL
 STA ACIA,X
 LDA IFTYPE ; for passports, skip this kludge
 BEQ :OUT
 LDX AR
 LDY AS
 LDA ACIA,X ; data
 LDA ACIA,Y ; status
 LDA ACIA,X ; data
:OUT RTS