home *** CD-ROM | disk | FTP | other *** search
- ;*****************************************************************************
- ; Change Log
- ; Date | Change
- ;-----------+-----------------------------------------------------------------
- ; 31-Dec-85 | Created change log
- ; 31-Dec-85 | Make sure DS: register is set properly!
- ; | Note: Why the CLD at the start of the routine? CLI?
- ; 1-Jan-86 | Removed CLD. Roger suggests this was carryover from 6502 code
- ; | where CLD is clear-decimal-mode.
- ; | Change 62H EOI code to 20H EOI code like everything else that
- ; | talks to interrupt chip. Note that we are tweaking the primary
- ; | interrupt controller chip on a /AT, but that is OK because the
- ; | EOI was sent to the secondary controller via the RE_DIRECT code
- ; | (PC/AT Tech Ref page 5-71)
- ; | This is the same mechanism used on both the /XT and /AT, e.g.
- ; | PC/XT Tech Ref page A-80, lines 5729-5730
- ; 5-Feb-86 | Keep interrupts off during interrupt handler
- ; 8-Feb-86 | Added code to capture system exclusive messages
- ; | Removed some debugging stores into d0,d1,d2,d3
- ; | Removed interrupt nesting counter -- if interrupts nest, you'll
- ; | crash before you can print the error report
- ; 13-Feb-86 | Changed DATA macro to a more sane name: GETMIDI
- ; 14-Feb-86 | Moved all variables to DSEG (they were in PSEG -- why did this
- ; | ever work before?)
- ; 5-May-86 | Optimized input for better transcription speed
- ; 9-Jul-86 | Added loop to avoid exiting interrupts with more data available
- ; 18-Jul-86 | Fixed a running status bug and cleaned up some debugging code
- ;*****************************************************************************
- ;;
- ;; MPU-401 interrupt handler
- ;; modelled after MPU-401 manual, pages 55-56
- ;; except that Ack commands are handled by setting
- ;; a flag and other commands are handled by
- ;; putting data into a buffer. Once things are
- ;; initialized, this is the only place that should
- ;; read data from the MPU-401. All writes (commands)
- ;; are issued from C routines.
- ;;
- ;; Notes: (Joe Newcomer, 31-Dec-85)
- ;; Because an interrupt can occur from anywhere, including DOS and
- ;; the BIOS, we cannot, repeat CANNOT assume the validity of any
- ;; register except CS:. In particular, SS:SP is quite possibly a
- ;; BIOS stack segment which are infinitesmally small. We CANNOT
- ;; push anything onto the BIOS stack segment without risking severe
- ;; damage to the integrity of the system. So we have here a large
- ;; private stack segement; we switch attention to it, *very carefully*
- ;; save our state on it, and then call the code which handles our
- ;; MPU-401 interrupt. Upon return, we *very carefully* reset the stack
- ;; and return to our caller. Since we need to address the C data segment,
- ;; we must also load DS:, which we need to set intnest and various buffer
- ;; headers. See the note associated with the setting of DS:; this
- ;; code works only in the small data model.
-
- include dos.mac
-
- ; DEBUG = 1 ;; define DEBUG to enable some extra record keeping
-
- DSEG
- extrn _interror:word ;; report errors up to C handlers
- extrn _timeerr:word ;; reports timeout errors to C handlers
- extrn _time_req:word ;; set to true if next Ack will be timing byte
-
- IFDEF DEBUG
- extrn _loop_cnt:word ;; count loop interations
- extrn _loop_max:word ;; max value of loop interations
- extrn _intcnt:word ;; count of interrupts taken
- ENDIF
-
- extrn _buff:byte ;; data from mpu401
- extrn _buffhead:word ;; data is removed from head offset
- extrn _bufftail:word ;; data is inserted at the tail offset
-
- extrn _xbuff:word ;; system exclusive buffer pointer
- extrn _xbuffhea:word
- extrn _xbufftai:word
- extrn _xbuffmas:word
-
- ;;
- ;; Globals used in communication with mpu.c
- ;;
-
- extrn _Ack:word ;; set if ack received
- extrn _Unknown:word ;; set for unknown command (for debugging)
- extrn _Ticks:dword ;; Clock ticks (400 = 1 second)
-
- ;;Midi information
- extrn _MidiTime:byte ;; extra timing byte
- extrn _MidiStat:byte ;; Running status
- extrn _Midi1:byte ;; First arg
- extrn _Midi2:byte ;; Second arg
- extrn _Midi3:byte ;; Third arg (not used)
-
- extrn _rd_delay:word ;; counts down wait for mpu data
-
- ENDDS
-
- ;_TEXT SEGMENT
- PSEG
- public _a_intr, _init_asm
-
- ; These must be in the pseg because on entry only the CS: is addressible
-
- DASEG DW 0
-
- OldAX DW ?
- OldSS DW ? ; old stack segment
- OldSP DW ? ; old stack pointer
- DW 512 DUP(?) ; local stack space for intercept routine
- STACK label WORD
-
-
- NESTERR = 1 ;;nested interrupt error
- BUFFERR = 2 ;;input buffer overflow error
- CMDERR = 3 ;;unknown command
- TIMEOUT = 4 ;;timeout waiting to read data
-
- BUFFMASK = 3FFH ;; buffer size is 1024 bytes, 3FF=1023
-
- ;; Status byte masks
- ;;
- DRR = 40h ;; Data Receive Ready
- DSR = 80h ;; Data Send Ready
-
- STATPORT = 331H ;; MPU-401 Status port
- DATAPORT = 330H ;; MPU-401 Data (MPU to PC) port
-
- ;*****************************************************************************
- ; _init_asm(): called to save the data segment into a place where
- ; the interupt routine can get at it.
-
- _init_asm proc near
-
- push bp ;save bp
- mov bp,sp ;move sp into bp
- mov cs:DASEG,ds ;save the ds in DASEG
- pop bp
- ret
-
- _init_asm endp
-
- ;*****************************************************************************
- ; _a_intr
- ; Called via:
- ; far call from interrupt handler. NOTE: proc is declared 'near' so
- ; that funny fixups are not required when linking it into C small model
- ; code. Since we return via IRET, the near/far distinction does not
- ; matter. HOWEVER if one were to play funny games with doing returns
- ; and twiddling flags (unlikely) the near/far distinction would matter
- ;*****************************************************************************
- _a_intr proc near
- ; Establish a stack for us
- mov OldSS,SS ; save old stack
- mov OldSP,SP ; ...
- mov OldAX,AX ; and scratch register
- cli ; don't play with fire, turn 'em off
- mov AX,CS ; our new stack segment is addressible by CS:
- mov SS,AX ; ..
- mov SP,offset STACK ; always change SS,SP in adjacent instructions
-
- ; In principle, we didn't need to turn
- ; interrupts off because doing it in that
- ; order guarantees that no interrupt will
- ; occur between mov SS and mov SP, but early
- ; 8088s had a bug and it didn't work.
- ; Better safe than sorry. An /XT could be
- ; repaired with one of these bogus chips
-
- ; sti ; allow interrupts again
- ; Save state
- push ds ; save state
- push es
- push ax
- push bx
- push cx
- push dx
- push di
- push si
- push ds
- ; begin body
-
- ; Restore DS from value saved in pgroup:DASEG.
- mov bx,offset PGROUP:DASEG
- mov ds,cs:[bx] ; now DS has the offset of dgroup segment
- assume ds:DGROUP
-
- ; mov ax,DGROUP
- ; mov ax,SEG intnest ; make DS be correct
- ; note: All variables have the same DS
- ; so doing it for one will do it for
- ; all
- ; This trick will not work in the large
- ; memory model; there we have to load
- ; DS: for each variable, because they
- ; could be in different segments
- ; No, I don't know how to handle the
- ; case where a long vector falls across
- ; a segment boundary
-
- ; at this point we may now validly address data
- IFDEF DEBUG
- inc intcnt ; up interrupt count
- mov _loop_cnt, 0 ; initialize iteration counter
- ENDIF
-
- readit: call mpu_aintr
- ; end body
- IFDEF DEBUG
- inc _loop_cnt
- ENDIF
- mov al,20h ;;; EOI code
- out 20h,al ;;; Announce end of interrupt
- mov dx,STATPORT ;; load port number
- in al,dx ;; read in char from port
- test al,DSR ;
- jz readit ;loop to handle next data byte
- ;; See note about the fact that we are
- ;; twiddling the primary interrupt controller
- ;; chip on an /AT, but this is no different
- ;; than what is required on the /XT
- IFDEF DEBUG
- mov ax, _loop_cnt ;; _loop_max = max(_loop_max, _loop_cnt)
- cmp ax, _loop_max
- jb leave
- mov _loop_max, ax
- ENDIF
- leave: pop ds
- pop si
- pop di
- pop dx
- pop cx
- pop bx
- pop ax
- pop es
- pop ds
- ; Now restore our old stack
- cli ; do it safely...
- mov SS,OldSS ; restore SS
- mov SP,OldSP ; restore SP
- ; sti ; allow them again
- mov AX,OldAX ; restore AX
- iret
- _a_intr endp
-
- ;;
-
- ;;
- ;; Data from mpu-401
- ;;
-
- MPU_ACK = 0feh ;; acknowledgment of end of command
- ABOVE_TIMING_BYTE = 0f0h ;; 1st value greater than legal timing
- ;; byte values (0 - 0efh)
- TIMER_OVERFLOW = 0f8h ;; record timer reached 240
- TIMER_INCR = 240d ;; add when TIMER_OVERFLOW comes
- SYSTEM_MESSAGE = 0ffh ;; MIDI system message
- MIDI_EXCLUSIVE = 0f0h ;; MIDI exclusive message
- MIDI_EOX = 0f7h ;; MIDI EOX (end of MIDI exclusive)
- MPUNOOP = 0f8h ;; MPU Mark: No Operation
-
- ;;
- ;; midi codes
- ;; high order 4 bits (of 8) give command
- ;; low order 4 bits give midi channel number
- ;;
- MCOMMASK = 0f0h ;; These bits give MIDI command
-
- MSTATUSMASK = 080h ;; This bit set if MIDI status byte
- MCHANMASK = 00fh ;; These bits give MIDI channel number
-
- NOTEOFF = 080h ;; status,pitch,veloc
- NOTEON = 090h ;; status,pitch,veloc (=0 means off)
- NOTEAFTERTOUCH = 0a0h ;; status,pitch,arg2
- CONTROLCHANGE = 0b0h ;; status,arg1,arg2
- PROGRAMCHANGE = 0c0h ;; status,program
- CHAFTERTOUCH = 0d0h ;; status,arg
- PITCHWHEEL = 0e0h ;; status,arg1,arg2
- MPUCOM = 0f0h ;; fake midi command, really mpu401
-
- MAXDELAY = 20000 ;; mpu_get times out after this many tries
-
-
- ;*****************************************************************************
- ; mpu_get
- ;
- ;*****************************************************************************
- mpu_get proc near ;; read data from mpu 401
- mov _rd_delay,MAXDELAY
- tryagain:
- mov dx,STATPORT ;; read status port
- in al,dx
- test al,DSR ;; data ready to send?
- jz gotit ;; yes - read the data
- dec _rd_delay ;; no - test for timeout
- jnz tryagain ;; timed out? no - repeat
- mov _timeerr,TIMEOUT ;; yes - report error,
- mov al,0f8h ;; and return innocuous (I hope) data
- ret
- gotit: mov dx,DATAPORT ;; load port number
- in al,dx ;; read in char from port
- ret
- mpu_get endp
-
-
- ;*****************************************************************************
- ; putbuf
- ;*****************************************************************************
- putbuf proc near ;; put data into buffer
- mov dx,_bufftail
- add dx,4
- and dx,BUFFMASK ;; wrap around ( dx = dx mod buffersize )
- cmp dx,_buffhead
- je bufferfull
- ;; save new _bufftail in dx, copy bytes
- mov si,_bufftail
- mov bl, _MidiStat
- mov byte ptr _buff[si],bl
- inc si
- mov bl, _Midi1
- mov byte ptr _buff[si],bl
- inc si
- mov bl,_Midi2
- mov byte ptr _buff[si],bl
- mov _bufftail,dx
- ret
- bufferfull:
- mov _interror,BUFFERR
- ret
- putbuf endp
-
- GETMIDI macro ;; read the mpu 401 data port into al
- call mpu_get
- endm
-
-
- ;*****************************************************************************
- ; mpu_aintr
- ;*****************************************************************************
- mpu_aintr proc near
-
- GETMIDI 1,gm1 ;; get what 401 want us to get
-
- mov ah,0 ;; several places assume ax = al
- cmp ax,ABOVE_TIMING_BYTE ;; Timing byte?
- jb l_timing_byte ;; (usually followed by midi data)
- cmp al, TIMER_OVERFLOW
- je l_timer_overflow
- cmp al,MPU_ACK ;; Ack?
- je l_mpu_ack
- cmp al,SYSTEM_MESSAGE ;; Midi system message?
- jne bad
- jmp l_system_message
-
-
- ;;
- ;; This routine does not handle:
- ;; Track data requests
- ;; Conductor requests
- ;; Clock to host
- ;; musicinit() initializes the MPU-401 in such a way so that these bytes
- ;; are never sent. If they do appear, they end up here.
- ;;
-
- bad:
- mov _Unknown,ax
- mov _interror,CMDERR
- jmp bye
- ;;
- ;; Handle each class of 401 message
- ;;
-
- ;; An ack, set Ack so that mpu_wait() can see it.
- l_mpu_ack:
- inc _Ack
- cmp _time_req, 0 ;; Does this command return timing data?
- je ack_done ;; if not, just return
- GETMIDI 2,gm2 ;; otherwise, read one more byte
- mov ah, 0 ;; increment Ticks by result
- add WORD PTR _Ticks, ax
- adc WORD PTR _Ticks+2, 0
- mov _time_req, 0
- ack_done:
- jmp bye
-
- ;; A timer overflow, increment clock by appropriate number of ticks
- l_timer_overflow:
- add WORD PTR _Ticks,TIMER_INCR ;; yes, do 32 bit incr of clock
- adc WORD PTR _Ticks+2,0
- jmp bye
-
- ;; A timing byte - the hard case
- ;; There are a number of possibilities, on which we branch
- l_timing_byte:
- mov _MidiTime,al ;; save timing byte
- add WORD PTR _Ticks,ax ;; yes, do 32 bit incr of clock
- adc WORD PTR _Ticks+2,0
- GETMIDI 3,gm3 ;; get next byte
- test al,MSTATUSMASK ;; It's midi, is it a status byte?
- je runstat
-
- ;; Here we have new midi status byte. Stash it and read in first data
-
- mov _MidiStat,al
- mov bl,al ;; copy command to bl
-
- and bl,MCOMMASK ;; "And" off channel bits
- cmp bl,MPUCOM ;; Is it an MPU command in disguise?
- je l_mpucom ;; Yes, deal with it.
-
- GETMIDI 4,gm4 ;; read in first data byte
- jmp decode ;; decide whether 1 or 2 data bytes
-
- runstat:
- mov bl,_MidiStat ;; no, use previous (running) status
- and bl,MCOMMASK
-
- ;; Commands 0c0h (program change) and 0d0h (channel after touch) have 2 bytes
- ;; at this point, al has 1st data byte, bl has upper four bits of status byte
-
- decode: mov _Midi1,al ;; save first data byte
- cmp bl,CHAFTERTOUCH
- je gotmsg
- cmp bl,PROGRAMCHANGE
- je gotmsg
-
- GETMIDI 5,gm5 ;; read second data byte
- mov _Midi2,al ;; save second data bytes
- gotmsg:
-
- ;;
- ;; Here the midi command is contained in the (2 or) 3 bytes
- ;; MidiStat, Midi1, and Midi2
- ;;
- call putbuf ;; put the data in the buffer
- ;; optimization note: only one call to putbuf
- gobye: jmp bye
-
-
- ;;
- ;; MPU-401 marks
- ;; These shouldn't happen and are ignored. The NOOP mark IS sent
- ;; when recording, contrary to the MPU401 manual. Since it seems
- ;; harmless, no error is reported if a NOOP is sent. Otherwise,
- ;; report a bad command with the timing byte in the high-order byte
- ;; of the error data (Unknown) to distinguish the data as mark data.
- ;;
- l_mpucom:
- cmp al,MPUNOOP
- je gobye ;; MPU-401 manual is wrong! The
- mov ah,_MidiTime ;; report two bytes as unknown
- jmp bad
-
- ;; A MIDI system message, currently only read sys. exclusive messages
- l_system_message:
- ;; see what the message is
- GETMIDI 6,gm6
- cmp al,MIDI_EXCLUSIVE
- je store_x
- jmp bad ;; only handle MIDI_EXCLUSIVE
-
- store_x: ;; put data in buffer until MIDI_EOX read
- mov bx,_xbuff ;; do not store if _xbuff is NULL
- cmp bx,0
- je nobuff
-
- add bx,_xbufftai ;; add index
- mov byte ptr [bx],al ;; and store midi data
- mov dx,_xbufftai ;; increment with wrap-around
- add dx,1
- and dx,_xbuffmas
- mov _xbufftai,dx
- nobuff: test al,MSTATUSMASK ;; are we done?
- je ex_continue ;; stop on any status byte ...
- cmp al,MIDI_EXCLUSIVE ;; ... except midi exclusive
- jne bye
- ex_continue:
- GETMIDI 7,gm7
- jmp store_x
- ;; common return point
-
- bye: ret
- mpu_aintr endp
- ENDPS
- ;_TEXT ENDS
- END
-