mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-12-28 01:29:20 +00:00
4325cdcc78
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
1908 lines
60 KiB
Plaintext
1908 lines
60 KiB
Plaintext
;
|
|
; File: HALc96Data.a
|
|
;
|
|
; Contains: 53c96 Hardware-Specific routines
|
|
;
|
|
; Written by: Paul Wolf
|
|
;
|
|
; Copyright: © 1990-1994 by Apple Computer, Inc., all rights reserved.
|
|
;
|
|
; Change History (most recent first):
|
|
;
|
|
; <SM38> 1/25/94 DCB Rolled in Paul's change to stop trashing A0 in the TIB
|
|
; interpreter.
|
|
; <ML3> 1/9/94 pdw Added Clinton's new SlowWrite routine.
|
|
; <SM36> 12/19/93 DCB Added code to save the handshake values from each call to the
|
|
; fast read and write routines. This is so that scatter gather
|
|
; lists work without the sglists having to be multiples of the
|
|
; smallest handshake size.
|
|
; <SM35> 11/22/93 pdw Rolling in from <MCxx>.
|
|
; <MC10> 11/11/93 pdw Some slight optimizations to SlowWrite loop.
|
|
; <MC9> 11/10/93 pdw Added include of HardwarePrivateEqu.a
|
|
; <MC8> 11/9/93 pdw Fixed bug in scatter/gather that happened when a zero-length
|
|
; element was encountered.
|
|
; <SM34> 11/22/93 pdw Added forSTP601v1 around the BIOS hack.
|
|
; <SM33> 11/16/93 SAM Include HardwarePrivateEqu.a
|
|
; <SM32> 11/9/93 KW in SlowReadRealC96 have wombats get the 16 bytes with 4 long
|
|
; word reads. STP needs this for awhile until BTU gets reved
|
|
; <SM31> 10/29/93 pdw Fixed build - RecordCmd is being expanded in ROM but not init in
|
|
; SOME places.
|
|
; <SM30> 10/29/93 DCB Adding calls to deferAndWait after calls to Wt4SCSI do reduce
|
|
; the interrupt level during transfers. Also added code to remove
|
|
; the bus error handler when we are asychronous to avoid the
|
|
; problem of chaining to our own bus error handler.
|
|
; <MC6> 10/28/93 pdw Starting to make an attempt to fix the wrong-direction bug.
|
|
; <MC5> 10/14/93 pdw Moved stuffing of A0 with ioPtr to top of TIB loop instead of
|
|
; just before calling transfer routine.
|
|
; <SM29> 10/14/93 pdw Fixed bug.
|
|
; <SM28> 10/14/93 pdw <MC> roll-in.
|
|
; <MC4> 10/12/93 pdw Added support for Synchronous data transfers, rewrote State
|
|
; Machine, message handling etc.
|
|
; <MC3> 9/26/93 pdw Clinton's changes.
|
|
; <SM27> 9/24/93 DCB Fixing yet another residual length problem. This time with
|
|
; SlowReadRealC96.
|
|
; <SM26> 9/19/93 DCB Changing the SlowWrite routine so that it correctly returns the
|
|
; number of bytes not transferred. If it necessary to do an
|
|
; additional move.w to get a DREQ then that word wasn't accounted
|
|
; for.
|
|
; <SM25> 9/13/93 pdw Fixed Smurf by reverting to the old slow SlowRead routine if
|
|
; we're on a real c96. On a Curio, we use the new fast SlowRead
|
|
; routine.
|
|
; <SM24> 9/9/93 pdw Lots of little changes. Name changes, temporary cache_bug
|
|
; stuff.
|
|
; <SM23> 8/19/93 DCB Improving the bus error handler so that disconnects at
|
|
; non-polled bytes will work properly.
|
|
; <SM22> 8/13/93 pdw RecordCmd and eieieo stuff.
|
|
; <SM21> 7/19/93 pdw Fixed build.
|
|
; <SM20> 7/19/93 pdw Got rid of a beq.s to the next instruction to get rid of build
|
|
; warning.
|
|
; <SM19> 7/17/93 pdw Rewrote SlowRead96 routine from scratch.
|
|
; <SM18> 7/8/93 pdw Adding call to RecordError in TIB interpreter.
|
|
; <SM17> 6/29/93 pdw Massive checkins: Change asynchronicity mechanism to CallMachine
|
|
; stack switching mechanism. Adding support for Cold Fusion.
|
|
; Rearranging HW/SW Init code. Some code optimizations.
|
|
; <SM16> 5/25/93 DCB Rollin from Ludwig. (The next item below)
|
|
; <LW8> 5/20/93 DCB Changing _debuggers to DebugStrs so we can turn them off at
|
|
; compile time.
|
|
; <SM15> 5/5/93 PW Converted names to meanies-friendly names. Updated with latest
|
|
; from Ludwig stuff.
|
|
; <LW7> 5/1/93 PW Added 1,511 TIB optimization.
|
|
; <SM14> 4/8/93 DCB Fixed a bug with long transfers that don't have TIB support
|
|
; <SM13> 3/20/93 PW Rolled in Ludwig changes.
|
|
; <LW4> 3/3/93 PW Added some fixes for Quadra support.
|
|
; <LW3> 2/17/93 PW Added stuff needed to fix dataResidLen and bitbucketing bugs.
|
|
; <SM12> 1/31/93 PW Update from the latest of Ludwig. Also changes required for PDM
|
|
; (will update Ludwig with these as needed myself).
|
|
; <LW2> 1/27/93 PW Added support for new dispatches data routines based on
|
|
; scsiDataType field. Rewrote DoDataBuffer routine.
|
|
; <SM11> 12/9/92 PW Fixed test tool SCSIRead phase err crash that was revealed by
|
|
; early-return-from-cmd change that was made to XPTOldCall.
|
|
; <SM10> 11/12/92 PW Changed SlowCableMode to mSlowCableMode to correspond to changes
|
|
; in SCSIEqu53c9x.a
|
|
; <SM9> 10/30/92 DCB Various changes in interrupt handling to improve performance.
|
|
; <SM8> 10/14/92 PW Made fix for S/G bugs which showed up if premature phase change
|
|
; during DMA write.
|
|
; <SM7> 10/8/92 PW Added GrossError checks. Some trivial name changes. Added test
|
|
; for out of bounds xferType. (cb) Fixed .w vs .l direction
|
|
; parameter bug in calling of StartDMA.
|
|
; <SM6> 8/31/92 PW Changed register and command definitions to reflect changes to
|
|
; SCSIEqu53c96.
|
|
; <SM5> 8/30/92 PW Fixed some 'how many bytes were transferred' bugs.
|
|
; <SM4> 8/6/92 PW Removed installation of BusErrHandler from Transfer and put it
|
|
; in the appropriate FastRead and FastWrite routines so it only
|
|
; gets loaded on appropriate machines.
|
|
; <SM3> 7/29/92 PW Removed some debugger traps.
|
|
; <SM2> 7/27/92 PW Virtually initial check-in.
|
|
;
|
|
;==========================================================================
|
|
|
|
|
|
MACHINE MC68020 ; '020-level
|
|
BLANKS ON ; assembler accepts spaces & tabs in operand field
|
|
PRINT OFF ; do not send subsequent lines to the listing file
|
|
; don't print includes
|
|
|
|
PostNOP EQU 1
|
|
|
|
INCLUDE 'SysErr.a'
|
|
INCLUDE 'HardwarePrivateEqu.a'
|
|
INCLUDE 'Debug.a' ; for NAME macro
|
|
|
|
INCLUDE 'SCSI.a'
|
|
INCLUDE 'SCSIEqu53c96.a'
|
|
INCLUDE 'ACAM.a'
|
|
INCLUDE 'SIMCoreEqu.a'
|
|
INCLUDE 'XPTEqu.a'
|
|
|
|
INCLUDE 'HALc96equ.a'
|
|
|
|
PRINT ON ; do send subsequent lines to the listing files
|
|
CASE OBJECT
|
|
|
|
HALc96Data PROC EXPORT
|
|
|
|
EXPORT Xfer1Byte96, OneByteRead
|
|
EXPORT DoDataIn, DoDataOut, OneByteWrite
|
|
EXPORT SlowRead96, SlowReadReal96, SlowWrite96
|
|
EXPORT FastRead96, FastWrite96
|
|
|
|
EXPORT InitDataStuff
|
|
EXPORT DoSaveDataPointer
|
|
EXPORT DoRestorePointers
|
|
EXPORT DoModifyDataPointer
|
|
EXPORT InitDataSG
|
|
EXPORT InitDataBuffer
|
|
EXPORT InitDataTIB
|
|
EXPORT DoDataTIB
|
|
EXPORT DoDataBuffer
|
|
EXPORT DoDataSG
|
|
EXPORT DoBitBucket
|
|
|
|
IMPORT Wt4SCSIInt, Ck4SCSIInt
|
|
IMPORT InstallBEH96, RemoveBEH96
|
|
|
|
|
|
IMPORT Ck4DREQ
|
|
IMPORT WtForFIFOData
|
|
IMPORT RecordEvent, RecordError
|
|
|
|
IMPORT DataIn_PSC1x1, DataIn_PSCDMA, DataOut_PSC
|
|
IMPORT DeferAndWait
|
|
IMPORT QuickIntCheck, FullIntRegs
|
|
|
|
WITH HALc96GlobalRecord
|
|
WITH SIM_IO, HALactions, SCSIPhase
|
|
|
|
;==========================================================================
|
|
;
|
|
; DoDataIn and DoDataOut
|
|
;
|
|
; Called by: Toolbox Trap Dispatcher
|
|
;
|
|
; Calls: primitive data transfer routines
|
|
;
|
|
; On entry: A3 - SCSI read base address
|
|
; A4 - ptr to HALactionPB
|
|
; A5 - pointer to SCSI Manager globals
|
|
;
|
|
; Function: Performs TIB interpretation, and data transfers.
|
|
|
|
DoDataIn
|
|
DoDataOut
|
|
dataCommon
|
|
and.b #$FF-mCF1_SlowCableMode,rCF1(a3) ; turn-off Slow cable mode during data xfer
|
|
eieio
|
|
|
|
move.l dataRoutine(A0), A1
|
|
jmp (A1)
|
|
|
|
RTSNAME 'DoDataCommon'
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
;
|
|
; DoDataTIB - TIB data type handler
|
|
;
|
|
; ÑÑÑÑÑÑÑÑ Internal:ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; in this case, data desc is S/G and handshake desc must be used (do union of SG and TIB)
|
|
HALTransferRegs REG D2-D6/A0-A1
|
|
|
|
|
|
DoDataTIB
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'TIB ' ; EVENT =
|
|
move.l sp, -(sp) ;
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
;
|
|
; What direction is data transfer request? Set up D4 (xferRoutine ptr) accordingly
|
|
;
|
|
cmp.w #kDataIn, HALactionPB.action(A4) ; are we doing a read?
|
|
beq.s @isDataIn
|
|
|
|
@isDataOut ;ÑÑÑÑÑÑ
|
|
move.l #writeOffset, D1 ; get offset to write routines
|
|
add.b scsiTransferType(A0), D1 ; add the selection to the offset
|
|
bra.s @1
|
|
|
|
@isDataIn ;ÑÑÑÑÑÑ
|
|
IF readOffset <> 0 THEN
|
|
move.l #readOffset, D1 ; get offset to read routines
|
|
add.b scsiTransferType(A0), D1 ; add the selection to the offset
|
|
ELSE
|
|
moveq.l #0, D1
|
|
move.b scsiTransferType(A0), D1 ; get the transfer type selection
|
|
ENDIF
|
|
|
|
@1
|
|
move.l (xferRoutines, A5, D1.L*4), D4 ; get routine in D4 for Transfer's use
|
|
|
|
;ÑÑÑÑÑÑ ; <LW14> pdw F§ TOP ÑÑÑ
|
|
;
|
|
; See if TIB is a 1,511 type and if so, convert to a straight-512 TIB (but more general)
|
|
; check for inc,add,inc,add,loop,stop or inc,mv,inc,mv,loop,stop type TIBs
|
|
;
|
|
clr.b optimTIB(A5) ; default optimizing TIB flag = not doing it
|
|
|
|
move.l scsiDataPtr(A0), A1 ; get the TIB pointer
|
|
move.l A1, -(sp) ; save A1 since we trash it in TIB interp
|
|
move.l A2, -(sp) ; save A2 since we trash it
|
|
|
|
; check instruction 1 (second instruction)
|
|
move.w 1*scSize +scOpcode(a1), D3 ; get instr 1 into D3 for instr 3 ck
|
|
cmp.w #scMove, D3 ; is it scMove?
|
|
beq.s @keepCking1 ; yes -> check next instruction
|
|
cmp.w #scAdd, D3 ; is it scAdd?
|
|
bne.w @exec
|
|
@keepCking1
|
|
|
|
; check instruction 0
|
|
moveq.l #scInc, D1 ;
|
|
cmp.w 0*scSize +scOpcode(a1), D1 ; opcode == scInc?
|
|
bne.w @exec ; no -> go walk the TIB
|
|
|
|
; check instruction 2
|
|
;; move.w #scInc, D1 (already) ; (scInc already in D1)
|
|
cmp.w 2*scSize +scOpcode(a1), D1 ; scInc?
|
|
bne.w @exec
|
|
|
|
; check instruction 3
|
|
cmp.w 3*scSize +scOpcode(a1), D3 ; is it same as instruction 1?
|
|
bne.w @exec
|
|
|
|
cmp.w #scMove, D3 ; are they scMove?
|
|
bne.s @ck4Add ; no -> check for scAdd
|
|
; trashing A0 here
|
|
lea 0*scSize +scParam1(a1), A0 ; get addr of addr field in first scInc
|
|
cmp.l 1*scSize +scParam1(a1), A0 ; should be source address of first move
|
|
bne.w @exec
|
|
cmp.l 3*scSize +scParam2(a1), A0 ; should be dest address of second move
|
|
bne.w @exec
|
|
|
|
lea 2*scSize +scParam1(a1), A2 ; get addr of addr field in second scInc
|
|
cmp.l 1*scSize +scParam2(a1), A2 ; should be dest address of first move
|
|
bne.w @exec
|
|
cmp.l 3*scSize +scParam1(a1), A2 ; should be source address of second move
|
|
bne.w @exec
|
|
|
|
move.l 0*scSize +scParam2(a1), D0 ; instr 0 transfer count
|
|
move.l 2*scSize +scParam2(a1), D1 ; instr 2 transfer count
|
|
bra.s @keepCking3
|
|
|
|
@ck4Add
|
|
cmp.w #scAdd, D3 ; are they scAdd?
|
|
bne.s @exec
|
|
|
|
move.l 0*scSize +scParam2(a1), D0 ; instr 0 transfer count == ...
|
|
cmp.l 1*scSize +scParam2(a1), D0 ; ...instr 1 increment?
|
|
bne.s @exec
|
|
|
|
move.l 2*scSize +scParam2(a1), D1 ; instr 2 transfer count == ...
|
|
cmp.l 3*scSize +scParam2(a1), D1 ; ...instr 3 increment?
|
|
bne.s @exec
|
|
|
|
move.l 0*scSize +scParam1(a1), A0 ; get contents of addr field in first scInc
|
|
cmp.l 2*scSize +scParam1(a1), A0 ; should be same as second scInc
|
|
bne.s @exec
|
|
|
|
lea 0*scSize +scParam1(a1), A0 ; get addr of addr field in first scInc
|
|
cmp.l 3*scSize +scParam1(a1), A0 ; should be dest address of second scAdd
|
|
bne.s @exec
|
|
|
|
lea 2*scSize +scParam1(a1), A2
|
|
cmp.l 1*scSize +scParam1(a1), A2 ; check source address
|
|
bne.s @exec
|
|
|
|
@keepCking3
|
|
|
|
; check instruction 4
|
|
move.w 4*scSize +scOpcode(a1), D2
|
|
cmp.w #scLoop, D2 ; scLoop?
|
|
bne.s @exec
|
|
|
|
moveq.l #-40, D2
|
|
cmp.l 4*scSize +scParam1(a1), D2 ; jump==-40?
|
|
bne.s @exec
|
|
|
|
; check instruction 5
|
|
move.w 5*scSize +scOpcode(a1), D2
|
|
cmp.w #scStop, D2 ; scStop?
|
|
bne.s @exec
|
|
|
|
move.b D3, optimTIB(A5) ; set optimizing TIB flag (and remember add/mv)
|
|
move.l D0, firstIncCount(A5) ; remember first scInc count
|
|
move.l D1, secondIncCount(A5) ; remember second scInc count
|
|
|
|
add.l D1, D0 ; calc total block size (add transfer counts)
|
|
move.l D0, 0*scSize +scParam2(a1) ; first scInc transfers total block
|
|
clr.l 2*scSize +scParam2(a1) ; second scInc transfers none
|
|
|
|
cmp.w #scAdd, D3 ; is this an scAdd TIB?
|
|
bne.s @exec
|
|
move.l D0, 1*scSize +scParam2(a1) ; first scAdd do add of total transfer
|
|
clr.l 3*scSize +scParam2(a1) ; second scAdd do none
|
|
; ; <LW14> pdw F§ BOT ÑÑÑ
|
|
|
|
;ÑÑÑÑÑÑ
|
|
;
|
|
; Interpret the TIB
|
|
;
|
|
@exec
|
|
move.l HALactionPB.ioPtr(A4), A0 ; load A0 with ptr to SCSI_IO pb
|
|
bra.s @getCmd ; tighten loop by branching first
|
|
|
|
|
|
@c_inc
|
|
tst.l D2
|
|
beq.s @next_cmd
|
|
|
|
movem.l HALTransferRegs, -(sp) ; save registers
|
|
move.l D4, A1
|
|
jsr (A1) ; go to the appropriate routine
|
|
movem.l (sp)+, HALTransferRegs ; restore these guys
|
|
|
|
tst.l d1 ; set Z if all done
|
|
bne.s @earlyEnd ; if error, exit
|
|
add.l D2, scParam1(a1) ; increment the pointer by size of xfer
|
|
; FALL THROUGH to @next_cmd ; continue
|
|
|
|
@next_cmd
|
|
@c_nop ; also NOP, just skip the command
|
|
add.w #scSize, a1 ; point to the next TIB instruction
|
|
; FALL THROUGH to @exec
|
|
|
|
;
|
|
; Loop through the TIB, interpreting as we go
|
|
;
|
|
@getCmd
|
|
move.w scOpcode(a1), d1 ; get the function opcode
|
|
move.l scParam1(a1), a2 ; get the generic address
|
|
move.l scParam2(a1), d2 ; get the generic count
|
|
|
|
cmp.w #maxOpcode, d1 ; valid opcode ?
|
|
bhi.s @c_badop ; return err if not
|
|
|
|
add.w d1,d1 ; index times two
|
|
jmp @JmpTable(d1.w) ; jump into table
|
|
|
|
@JmpTable ;
|
|
bra.s @c_badop ; 0 is not a valid opcode
|
|
bra.s @c_inc ; 1
|
|
bra.s @c_noinc ; 2
|
|
bra.s @c_add ; 3
|
|
bra.s @c_move ; 4
|
|
bra.s @c_loop ; 5
|
|
bra.s @c_nop ; 6
|
|
bra.s @c_stop ; 7
|
|
bra.s @c_stop ;c_compare ; 8
|
|
|
|
@earlyEnd
|
|
moveq.l #scPhaseErr, D0
|
|
@data_error
|
|
move.l D0, -(sp)
|
|
bsr RecordError ; Err!
|
|
addq.l #4, sp
|
|
bra.s @data_end
|
|
|
|
@c_badop
|
|
moveq.l #scBadParmsErr, D0 ; bad opcode
|
|
bra.s @data_error
|
|
|
|
@c_noinc ; NOINC addr,count
|
|
tst.l D2
|
|
beq.s @next_cmd
|
|
|
|
movem.l HALTransferRegs, -(sp) ; save registers
|
|
move.l D4, A1
|
|
jsr (A1) ; go to the appropriate routine
|
|
movem.l (sp)+, HALTransferRegs ; restore these guys
|
|
|
|
tst.l d1 ; set Z if all done
|
|
bne.s @earlyEnd ; if error, exit
|
|
bra.s @next_cmd ; else process next command
|
|
|
|
@c_add ; ADD addr,data
|
|
add.l d2, (a2) ; the count added to the where
|
|
bra.s @next_cmd ; process the next command
|
|
|
|
@c_move ; MOVE addr1,addr2
|
|
move.l (a2), (ZA0,D2.L) ; simple enough
|
|
bra.s @next_cmd ; process the next command
|
|
|
|
@c_loop ; LOOP relative addr,count
|
|
tst.l d2 ; check for zero loop count
|
|
beq.s @next_cmd ; if count is already zero, quit loop
|
|
subq.l #1, d2 ; drop the count
|
|
move.l d2, scParam2(a1) ; put the count back for next time
|
|
beq.s @next_cmd ; if count exhausted, don't loop
|
|
add.l a2, a1 ; modify the command pointer
|
|
bra.s @exec ; and process the next command
|
|
|
|
@c_stop
|
|
moveq.l #noErr, D0 ; indicate no error
|
|
; FALL THROUGH to @data_end ;
|
|
|
|
|
|
@data_end
|
|
move.w D0, HALactionPB.result(A4) ; with whatever err
|
|
|
|
;=== Flush the cache line that contains location 8 (because of MOVE16 bug)
|
|
|
|
tst.b HBAhasHskPseudoDMA(A5) ; if we have a bus error handler <SM7> pdw
|
|
beq.s @skipFlushCache
|
|
movem.l D0-D2, -(sp)
|
|
moveq.l #9, D0 ; FlushCacheRange HWPriv scsiSelector
|
|
move.l #8, A0 ; starting address of flush range
|
|
move.l #4, A1 ; length of range
|
|
_HWPriv
|
|
movem.l (sp)+, D0-D2 ; restore regs
|
|
@skipFlushCache
|
|
|
|
move.l (sp)+, A2 ; restore A2 (saved before TIB interp)
|
|
move.l (sp)+, A1 ; restore A1 (saved before TIB interp) <LW14> pdw F§
|
|
|
|
move.l HALactionPB.ioPtr(A4), A0 ; restore A0 - ptr to SCSI_IO pb
|
|
|
|
;ÑÑÑÑÑÑ ; <LW14> pdw F§ TOP ÑÑÑ
|
|
;
|
|
; Replace munged TIB values if we optimized it before the interpretation
|
|
;
|
|
move.b optimTIB(A5), D3 ; test optimizing TIB flag
|
|
if DEBUGGING then
|
|
beq.w DataDone ; didn't optimize -> DataDone
|
|
else
|
|
beq.s DataDone ; didn't optimize -> DataDone
|
|
endif
|
|
|
|
cmp.w #scAdd, D3 ; is this an scAdd TIB?
|
|
bne.s @restoreMove
|
|
@restoreAdd
|
|
move.l firstIncCount(A5), D3
|
|
move.l D3, 0*scSize +scParam2(a1) ; restore first scInc count
|
|
move.l D3, 1*scSize +scParam2(a1) ; restore first scAdd count
|
|
move.l secondIncCount(A5), D3
|
|
move.l D3, 2*scSize +scParam2(a1) ; restore second scInc count
|
|
move.l D3, 3*scSize +scParam2(a1) ; restore second scAdd count
|
|
|
|
bra.s DataDone
|
|
@restoreMove
|
|
move.l firstIncCount(A5), 0*scSize +scParam2(a1) ; restore first scInc count
|
|
move.l secondIncCount(A5), 2*scSize +scParam2(a1) ; restore second scInc count
|
|
;ÑÑÑÑÑÑ ; <LW14> pdw F§ BOT ÑÑÑ
|
|
|
|
bra.s DataDone
|
|
|
|
RTSNAME 'DoDataTIB'
|
|
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
;
|
|
; DoDataBuffer - buffer data type handler
|
|
;
|
|
; ÑÑÑÑÑÑÑÑ Internal:ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
D1_remaining EQU D1 ; .l = number of bytes remaining in this block
|
|
D2_xferSize EQU D2 ; .l = number of bytes remaining in this block
|
|
|
|
XferRegs REG D2/A0-A2
|
|
|
|
DoDataBuffer
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'DBfr' ; EVENT =
|
|
move.l sp, -(sp) ; number of bytes
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
;
|
|
; Set up for a call to the "transfer one block of data" routine
|
|
; D2 (number of bytes) and A2 (address of buffer) for call to transfer routine
|
|
;
|
|
move.l currentSGptr(A0), A2 ; current position in buffer
|
|
move.l currentSGcount(A0), D2_xferSize ; how far we've got to go
|
|
beq.s DataDone ; zero? if so, get out
|
|
move.l D2_xferSize, D1_remaining ; make a copy of the count
|
|
|
|
;
|
|
; Do the transfer of this block
|
|
;
|
|
movem.l XferRegs, -(sp) ; save registers
|
|
|
|
movea.l xferRoutine(A0), A1 ; get the address of the transfer routine
|
|
jsr (A1) ; go to the transfer routine
|
|
IF DEBUGGING THEN
|
|
cmp.l HALactionPB.ioPtr(A4), A0
|
|
beq.s @nobug
|
|
DebugStr 'Err! A0!=ioPtr in DoDataBuffer'
|
|
@nobug
|
|
ENDIF
|
|
|
|
movem.l (sp)+, XferRegs ; restore these guys
|
|
|
|
;
|
|
; This call got further into this block and may have gotten done with it
|
|
; Update the Current pointers to point to this block with count as returned by Data call
|
|
;
|
|
sub.l D1_remaining, D2 ; calc how many bytes we transferred
|
|
beq.s PhaseErr ; (if no bytes, then phase err)
|
|
add.l D2, currentSGptr(A0) ; and where we need to start next time
|
|
sub.l D2, scsiDataResidual(A0) ; and what our total residual is
|
|
move.l D1_remaining, currentSGcount(A0) ; and how far we've got to go
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
|
|
DataDone
|
|
;=== exit and return result
|
|
ori.b #mCF1_SlowCableMode,rCF1(a3) ; go back to Slow cable mode for all else
|
|
eieio
|
|
rts
|
|
|
|
NAME 'DoDataBuffer'
|
|
|
|
|
|
; If we are in the wrong phase at the start of the data routine that means that we must be in
|
|
; the OTHER data phase (i.e. data in vs. data out). This is because the SIM would never call
|
|
; the data routine in unless we are in one or the other. The only other possibility is that
|
|
; the target just dropped the bus on us.
|
|
|
|
PhaseErr
|
|
move.b currentPhase(A5), D0 ; was it perhaps an unexpected disconnect?
|
|
cmp.b #kBusFreePhase, D0
|
|
bne.s @ckData
|
|
move.w #SCResults.scsiUnexpectedBusFree, HALactionPB.result(A4)
|
|
bra.w DataDone
|
|
@ckData
|
|
and.b #%110, D0 ; get rid of direction bit
|
|
cmp.b #(kDataOutPhase ** %110), D0 ; a data phase?
|
|
beq.s @wrongDir
|
|
IfDebugStr 'Totally wrong phase in data routine'
|
|
move.w #SCResults.scsiWrongDirection, HALactionPB.result(A4)
|
|
bra.w DataDone
|
|
@wrongDir
|
|
move.w #SCResults.scsiWrongDirection, HALactionPB.result(A4)
|
|
bra.w DataDone
|
|
|
|
RTSNAME 'PhaseErr'
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
;
|
|
; DoDataSG - scatter/gather data type handler
|
|
;
|
|
; ÑÑÑÑÑÑÑÑ Internal:ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
;D1_remaining EQU D1 ; .l = number of bytes remaining in this block
|
|
D2_position EQU D2 ; .l = position
|
|
|
|
DoDataSG
|
|
WITH SGRecord
|
|
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'ScGt'
|
|
clr.l -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
move.l A2, -(sp) ; save A2 since we trash it in S/G walking
|
|
;
|
|
; Set up for a call to the "transfer one block of data" routine
|
|
; D2 (number of bytes) and A2 (address of buffer) for call to transfer routine
|
|
;
|
|
move.l currentSGptr(A0), A1 ; <SM8> pdw TOP
|
|
move.l currentSGcount(A0), D2_position ; how far we've already gone into this block
|
|
|
|
@loop
|
|
move.l sgAddr(A1), A2 ; current buffer's start address
|
|
add.l D2_position, A2 ; displace start address that amount
|
|
move.l sgCount(A1), D1_remaining ; get the total buffer size
|
|
sub.l D2_position, D1_remaining ; and sub what we've done for to-do size<SM8> pdw BOT
|
|
|
|
;
|
|
; Do the transfer of this block
|
|
;
|
|
|
|
@doData
|
|
move.l D1_remaining, D2 ; D2 input parm = # of bytes to transfer <SM8> pdw
|
|
beq.s @dataDone ; if no data, skip xfer routine
|
|
movem.l XferRegs, -(sp) ; save registers
|
|
|
|
movea.l xferRoutine(A0), A1 ; get the address of the transfer routine
|
|
jsr (A1) ; go to the transfer routine
|
|
|
|
movem.l (sp)+, XferRegs
|
|
@dataDone
|
|
sub.l D1_remaining, D2 ; calc how many bytes we transferred
|
|
sub.l D2, scsiDataResidual(A0) ; and what our total residual now is
|
|
|
|
tst.l D1_remaining ; any bytes left in this block?
|
|
beq.s @nextEntry ; no, go to next entry
|
|
|
|
;
|
|
; This call got further into this block but didn't get done with it
|
|
; Update the Current pointers to point to this block with count as returned by Data call
|
|
;
|
|
|
|
@thisEntryNotDone ; <SM8> pdw TOP
|
|
move.l sgCount(A1), D2_position ; get the total buffer size
|
|
sub.l D1_remaining, D2_position ; sub # of bytes left from total count
|
|
move.l D2_position, currentSGcount(A0) ; how far we've already gone into this block
|
|
; <SM8> pdw BOT
|
|
bra.s @outOfPhaseOrError ; yes - go do them
|
|
|
|
;
|
|
; This call got done with this block
|
|
; Update the Current pointers to point to the next block
|
|
;
|
|
|
|
@nextEntry
|
|
lea sgNextBlock(A1), A1 ; point to next S/G entry
|
|
move.l A1, currentSGptr(A0) ; store in current pointer
|
|
moveq.l #0, D2_position ; <SM8> pdw TOP
|
|
move.l D2_position, currentSGcount(A0) ; init count to '0 bytes xferred so far'
|
|
|
|
;
|
|
; Now see if we're completely done
|
|
; compare new SGptr with the end of the SG list (scsiDataPtr + 8*scsiSGListCount)
|
|
;
|
|
moveq.l #0, D1 ;
|
|
move.w scsiSGListCount(A0), D1 ; how many elements in SG list
|
|
lsl.l #3, D1 ; 8 bytes per SG element
|
|
add.l scsiDataPtr(A0), D1 ; point just past last element
|
|
cmp.l A1, D1 ; are we there? <SM8> pdw BOT
|
|
bhi.s @loop ; no -> keep going
|
|
|
|
; if all done, set kbDataDone bit to tell SIM (so it will bitbucket or whatever if still data phz)
|
|
|
|
bset.b #SIMprivFlagsRecord.kbDataDone, SIMprivFlags(A0)
|
|
|
|
@outOfPhaseOrError
|
|
move.l (sp)+, A2
|
|
bra.w DataDone
|
|
|
|
RTSNAME 'DoDataSG'
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
InitDataStuff
|
|
;
|
|
; Initialize Current pointers and Saved pointers
|
|
; and, as an extra added bonus, initialize DataRoutine and XferRoutine ptrs
|
|
;
|
|
; First, figure out whether this request is for a S/G or a single data buffer
|
|
; If S/G point to first S/G element; If buffer, act like scsiDataPtr/scsiDataLength is a S/G element
|
|
;
|
|
InitDataStuffRegs REG D0-D2/A1
|
|
movem.l InitDataStuffRegs, -(sp)
|
|
;
|
|
; Decide whether we will use Buffer, S/G, or TIB then
|
|
; Init data pointer stuff accordingly, as well as residual count stuff
|
|
; Get the address of the data interpreter into dataRoutine
|
|
;
|
|
moveq.l #0, D1
|
|
move.b scsiDataType(A0), D1
|
|
move.l (dataRoutines, A5, D1.L*4), A1 ; get the data routine
|
|
move.l A1, dataRoutine(A0) ; save it in ioPB
|
|
|
|
move.l (initDataRoutines, A5, D1.L*4), A1 ; get the init data ptr routine
|
|
jmp (A1) ; jump to init data pointer routine
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑ
|
|
InitDataTIB
|
|
moveq.l #0, D0
|
|
bra.s exitInitData ; get out (we're in Select: no data info)
|
|
|
|
InitDataSG
|
|
move.l scsiDataPtr(A0), A1 ; get start of SG list
|
|
moveq.l #0, D0
|
|
bra.s fillInPointers
|
|
InitDataBuffer
|
|
move.l scsiDataPtr(A0), A1 ; get start of buffer
|
|
move.l scsiDataLength(A0), D0 ; get byte count
|
|
fillInPointers
|
|
move.l A1, currentSGptr(A0) ; init ptr
|
|
move.l D0, currentSGcount(A0) ; init count to 0
|
|
move.l A1, savedSGptr(A0) ; init ptr
|
|
move.l D0, savedSGcount(A0) ; init count to 0
|
|
|
|
move.l scsiDataLength(A0), D0 ; get byte count
|
|
move.l D0, scsiDataResidual(A0) ; current residual ptr
|
|
move.l D0, savedResidLen(A0) ; saved residual ptr
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑ
|
|
;
|
|
; Determine whether we're data IN, OUT or neither then
|
|
; Put the address of the data & transfer routine into xferRoutine(io) and dataRoutine(io)
|
|
;
|
|
move.l scsiFlags(A0), D0
|
|
and.l #scsiDirectionMask, D0 ; are we data in or out?
|
|
cmp.l #scsiDirectionIn, D0
|
|
beq.s @isDataIn
|
|
@notDataIn
|
|
cmp.l #scsiDirectionOut, D0
|
|
beq.s @isDataOut
|
|
|
|
@noDataXfer ;ÑÑÑÑÑÑ
|
|
moveq.l #0, D0
|
|
move.l D0, scsiDataResidual(A0) ; current residual ptr
|
|
move.l D0, savedResidLen(A0) ; saved residual ptr
|
|
move.l jvBitBucket(A5), dataRoutine(A0)
|
|
lea NoDataXfer, A1
|
|
move.l A1, xferRoutine(A0)
|
|
bra.s exitInitData
|
|
|
|
@isDataOut ;ÑÑÑÑÑÑ
|
|
move.l #writeOffset, D1 ; get offset to write routines
|
|
add.b scsiTransferType(A0), D1 ; add the selection to the offset
|
|
bra.s @1
|
|
|
|
@isDataIn ;ÑÑÑÑÑÑ
|
|
IF readOffset <> 0 THEN
|
|
move.l #readOffset, D1 ; get offset to read routines
|
|
add.b scsiTransferType(A0), D1 ; add the selection to the offset
|
|
ELSE
|
|
moveq.l #0, D1
|
|
move.b scsiTransferType(A0), D1 ; get the transfer type selection
|
|
ENDIF
|
|
|
|
@1
|
|
move.l (xferRoutines, A5, D1.L*4), A1 ; get the routine address
|
|
move.l A1, xferRoutine(A0)
|
|
|
|
exitInitData
|
|
movem.l (sp)+, InitDataStuffRegs
|
|
rts
|
|
|
|
NAME 'InitDataStuff'
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
DoSaveDataPointer
|
|
;
|
|
; Copy Current pointers into Saved
|
|
;
|
|
move.l currentSGptr(A0), savedSGptr(A0) ; copy ptr
|
|
move.l currentSGcount(A0), savedSGcount(A0) ; copy count
|
|
|
|
move.l scsiDataResidual(A0), savedResidLen(A0) ; copy residual ptr
|
|
rts
|
|
|
|
NAME 'DoSaveDataPointer'
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
DoRestorePointers
|
|
;
|
|
; Copy Saved pointers into Current
|
|
;
|
|
move.l savedSGptr(A0), currentSGptr(A0) ; copy ptr
|
|
move.l savedSGcount(A0), currentSGcount(A0) ; copy count
|
|
|
|
move.l savedResidLen(A0), scsiDataResidual(A0) ; copy residual ptr
|
|
rts
|
|
|
|
NAME 'DoRestorePointers'
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
DoModifyDataPointer
|
|
DebugStr 'Got Modify Data Pointer Message'
|
|
rts
|
|
|
|
NAME 'DoModifyDataPointer'
|
|
|
|
ENDWITH ;SGRecord
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
IllegalXfer
|
|
move.l #'Xfer', -(sp)
|
|
DebugStr 'Ileagal Xfer'
|
|
addq.l #4, sp
|
|
rts
|
|
|
|
NAME 'IllegalXfer'
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
NoDataXfer
|
|
|
|
rts
|
|
|
|
NAME 'NoDataXfer'
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; DoBitBucket - bit buckets data in or out until no longer in data phase
|
|
;
|
|
DoBitBucket
|
|
moveq.l #iPhaseMsk, d0 ; load mask bits for phase value
|
|
and.b rSTA(a3), d0 ; get phase bits
|
|
cmp #iDataOut, d0 ;
|
|
bne.s @checkPhase ;
|
|
btst.b #7, SCSI_IO.scsiResultFlags(A0)
|
|
beq.s @checkPhase
|
|
DebugStr 'The SCSIMgr will now trash your data. Is that a problem?'
|
|
@checkPhase
|
|
moveq.l #iPhaseMsk, D0 ; load mask bits for phase value
|
|
and.b rSTA(a3), D0 ; get phase bits
|
|
|
|
cmp #iDataIn, D0 ;
|
|
beq.s @inDataIn ;
|
|
|
|
cmp #iDataOut, D0 ;
|
|
bne.s @notInDataPhase ;
|
|
@inDataOut
|
|
move.b #$EE, rFIFO(A3) ; load filler byte into FIFO
|
|
eieio
|
|
bsr Xfer1Byte96 ; xfer 1 byte and wait for intrp w/o timeout
|
|
bne.s @xferErr ; bra. on xfer error
|
|
subq.l #1, scsiDataResidual(A0) ; adjust residual length
|
|
bra.s @checkPhase
|
|
|
|
@inDataIn
|
|
bsr Xfer1Byte96 ; xfer 1 byte and wait for intrp w/o timeout
|
|
bne.s @xferErr ; bra. on xfer error
|
|
move.b rFIFO(A3), D0 ; just empty the FIFO
|
|
subq.l #1, scsiDataResidual(A0) ; adjust residual length
|
|
bra.s @checkPhase
|
|
|
|
@xferErr
|
|
@notInDataPhase
|
|
rts
|
|
|
|
NAME 'DoBitBucket'
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; OneByteRead/OneByteWrite - proc to transfer 1 byte
|
|
;
|
|
OneByteRead
|
|
RecCmd $10, 'D',$01
|
|
move.b #cIOXfer, rCMD(a3) ; load IO transfer cmd & begin xfers
|
|
eieio
|
|
|
|
bsr.w Wt4SCSIInt ; Wait for intrp w/o timeout
|
|
; on exit d5 = rFOS|rINT|rSQS|rSTA
|
|
move.b rFIFO(a3), (a2)+ ; xfer byte from FIFO into input buffer
|
|
|
|
rts
|
|
|
|
NAME 'OneByteRead'
|
|
|
|
OneByteWrite
|
|
move.b (a2)+, rFIFO(a3) ; preload the FIFO
|
|
eieio
|
|
RecCmd $10, 'D',$02
|
|
move.b #cIOXfer, rCMD(a3) ; load IO transfer cmd & begin xfers
|
|
eieio
|
|
|
|
bsr.w Wt4SCSIInt ; Wait for intrp w/o timeout
|
|
; on exit d5 = rFOS|rINT|rSQS|rSTA
|
|
rts
|
|
|
|
NAME 'OneByteWrite'
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; Xfer1Byte96 - proc to transfer 1 byte of data
|
|
;
|
|
Xfer1Byte96
|
|
RecCmd $10, 'D',$03
|
|
move.b #cIOXfer, rCMD(a3) ; load IO transfer cmd & begin xfer
|
|
eieio
|
|
|
|
bsr.w Wt4SCSIInt ; wait for interrupt
|
|
rts
|
|
|
|
NAME 'Xfer1Byte96'
|
|
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; SlowRead96 - implements Polled Read
|
|
;
|
|
; Called by: Transfer
|
|
;
|
|
; All primitive data transfer routines assume:
|
|
;
|
|
; d1 - <-- bytes transferred
|
|
; d2 - --> number of bytes to transfer
|
|
; d4 - --> type of transfer to perform
|
|
; d5 - scratch - saved
|
|
; d6 - scratch - saved
|
|
;
|
|
; a0 - scratch - saved
|
|
; a1 - SCSI chip read base address - NON-SERIALIZED
|
|
; a2 - ptr to data buffer - saved
|
|
; a3 - SCSI chip read base address - SERIALIZED
|
|
; A5 - ptr to SCSI Mgr globals
|
|
;
|
|
; Method of Data Transfer: (pDMA and programmed IO)
|
|
; 1) calculate # of 16-byte block transfers to perform using pDMA & remember the remainder
|
|
; 2) Enable c96 DMA and wait till the 16-byte FIFO is full and DREQ is asserted
|
|
; 3) Transfer all data in the FIFO and wait for the intrp
|
|
; 4) Repeat until all blocks have been transferred
|
|
; 5) Transfer remaining data using non-DMA transfer command byte then
|
|
; Wait and poll for byte-in-fifo interrupt
|
|
; 6) Transfer data from fifo to input buffer
|
|
; 7) Repeat process until all remaining bytes have been transferred
|
|
;
|
|
; The weird thing about this routine (and SlowWrite as well) is that you can get a phase
|
|
; change but not get an interrupt because there may be outstanding DREQs and the c96
|
|
; will not set bINT until all DREQs have been satisfied. This means that we have to
|
|
; keep an eye on the phase bits to see if we get a change.
|
|
;
|
|
|
|
SlowRead96
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'SwRd' ; EVENT =
|
|
move.l scsiDataResidual(A0), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
IF 1 AND RECORD_ON THEN
|
|
move.l D2, -(sp) ; number of bytes
|
|
move.l A2, -(sp) ;
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
tst.b HBAhasDMA(A5) ; are we on a DMA (i.e. a Curio) machine?
|
|
beq SlowReadReal96 ; no -> do SlowRead for Real 53c96 parts
|
|
|
|
cmp.b #kDataInPhase, currentPhase(A5)
|
|
bne @wrongPhase
|
|
|
|
bclr #0, D2 ; odd xfer?
|
|
beq.s @even
|
|
|
|
move.b #cIOXfer, rCMD(A3) ; move that 1 byte (guaranteed - we have REQ)
|
|
bsr Wt4SCSIInt
|
|
|
|
jsr DeferAndWait ; defer til interupts are enabled
|
|
|
|
move.b rFIFO(A3), (A2)+
|
|
cmp.b #kDataInPhase, currentPhase(A5)
|
|
bne @wrongPhase
|
|
;ÉÉÉÉÉÉÉÉÉÉÉ
|
|
@even
|
|
move.l pdmaNonSerlzdAddr(A5), A1 ; point to non-serialized chip image
|
|
lea rFIFOflags(A3), A0 ; init A0 for btsts in loop
|
|
move.l #3, D3 ; ...and D3
|
|
move.l #4, D4 ; ...and D4
|
|
|
|
move.l D2, D6
|
|
swap D6 ; .w = # of 64K chunks
|
|
tst.w D2 ; mod 64K nonzero?
|
|
beq @loop64Kbtm ; yes -> go straight to 64K loop
|
|
|
|
move.l D2, D1
|
|
move.b D1, rXCL(A3)
|
|
lsr.l #8, D1
|
|
move.b D1, rXCM(A3)
|
|
clr.w D2 ; assume we transfer those bytes
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
@startXfer
|
|
RecCmd $90, 'D',$04
|
|
move.b #cDMAXfer, rCMD(A3) ; load DMA transfer cmd & start loading FIFO
|
|
nop
|
|
nop
|
|
nop
|
|
bra.s @ck4IntOrPhaseChange
|
|
;ÉÉÉÉÉÉÉÉÉÉÉ
|
|
@read16
|
|
move.w (a1), (a2)+ ; read 8 bytes
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
@read8
|
|
move.w (a1), (a2)+ ; read 8 bytes
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
@ckFIFO
|
|
nop
|
|
btst D3, (A0) ; FIFO half full?
|
|
nop
|
|
bne.s @read8 ; yes -> read 8 bytes
|
|
btst D4, (A0) ; FIFO full?
|
|
nop
|
|
bne.s @read16 ; yes -> read 16 bytes
|
|
btst D3, (A0) ; FIFO half full?
|
|
nop
|
|
bne.s @read8
|
|
@ck4IntOrPhaseChange
|
|
move.b rSTA(A3), D5 ; interrupt?
|
|
bmi.s @outOfPhase
|
|
btst D3, (A0) ; half full?
|
|
nop
|
|
bne.s @read8
|
|
btst D4, (A0) ; full?
|
|
nop
|
|
bne.s @read16
|
|
btst D3, (A0) ; half full?
|
|
nop
|
|
bne.s @read8
|
|
btst #bTermCount, D5 ; transfer complete?
|
|
nop
|
|
bne.s @tc
|
|
btst D3, (A0) ; half full?
|
|
nop
|
|
bne.s @read8
|
|
btst D4, (A0) ; full?
|
|
nop
|
|
bne.s @read16
|
|
btst D3, (A0) ; half full?
|
|
nop
|
|
bne.s @read8
|
|
and.b #iPhaseMsk, D5 ; and mask bits for phase value
|
|
btst D4, (A0) ; full?
|
|
nop
|
|
bne.s @read16
|
|
cmpi.b #kDataInPhase, D5 ; still in Data In phase?
|
|
bne.s @outOfPhase ; no -> take care of leftovers, get int
|
|
btst D3, (A0) ; half full?
|
|
nop
|
|
bne.s @read8
|
|
btst D4, (A0) ; full?
|
|
nop
|
|
bne.s @read16
|
|
bra.s @ckFIFO
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
@tc
|
|
@outOfPhase
|
|
moveq.l #mFIFOCount, D0 ; use mask to get FIFO flag field
|
|
and.b rFIFOflags(A3), D0 ; get FIFO count
|
|
beq.s @noBytesInFIFO
|
|
IF 0 AND RECORD_ON THEN
|
|
pea 'ffc0'
|
|
add.b D0, 3(sp)
|
|
move.l A2, -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
;sub.l D0, D2 ; subtract from total request
|
|
lsr.b #1, D0 ; how many words (Carry = odd byte)
|
|
bcc.s @evenFIFO ; no -> just xfer words
|
|
move.b rFIFO(a3), (a2)+ ; get odd byte out
|
|
bra.s @evenFIFO ; now get the words
|
|
@fifoWords
|
|
move.w (a1), (a2)+
|
|
@evenFIFO
|
|
dbra D0, @fifoWords
|
|
@noBytesInFIFO
|
|
IF 0 AND RECORD_ON THEN
|
|
pea 'ls12'
|
|
move.l -12(A2), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
IF 0 AND RECORD_ON THEN
|
|
move.l -8(A2), -(sp)
|
|
move.l -4(A2), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
bsr Wt4SCSIInt ; let's go get that interrupt
|
|
jsr DeferAndWait ; defer til interupts are enabled
|
|
|
|
clr.l D1
|
|
move.b rXCM(A3), D1 ; get high byte
|
|
lsl.w #8, D1
|
|
move.b rXCL(A3), D1 ; get low byte
|
|
add.l D1, D2 ; add to unxferred count
|
|
|
|
cmpi.b #kDataInPhase, currentPhase(A5) ; still data-in?
|
|
bne.s @exit ; no->exit
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
@loop64Kbtm
|
|
dbra D6, @loop64Ktop
|
|
|
|
@wrongPhase
|
|
@exit
|
|
move.l D2, D1
|
|
move.l HALactionPB.ioPtr(A4), A0 ; restore A0 - ptr to SCSI_IO pb
|
|
rts
|
|
|
|
@loop64Ktop
|
|
clr.b rXCL(A3)
|
|
sub.l #$10000, D2 ; assume we're going to transfer all 64K
|
|
clr.b rXCM(A3)
|
|
bra.w @startXfer
|
|
|
|
RTSNAME 'SlowRead96'
|
|
|
|
|
|
SlowReadReal96 ;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
;
|
|
; Setup A1 to point to a non-serialized image of the c96. If such an image doesn't exist this
|
|
; value will be the same as the serialized image.
|
|
;
|
|
move.l pdmaNonSerlzdAddr(A5), A1 ; point to non-serialized chip image
|
|
|
|
moveq.l #iPhaseMsk, d0 ; load mask for phase bits
|
|
and.b rSTA(a3), d0 ; are we in data-in phase?
|
|
cmpi #iDataIn, d0 ; data-in phase bits = 001
|
|
bne.w PhaseErrAtStart ; bra. on phase err
|
|
|
|
clr.l D3 ; d3 = bytes transferred to get DREQ after
|
|
; we change phase
|
|
move.l D2, D4 ; d4 = copy of transfer count
|
|
and.l #$F, D2 ; d2 = remainder word count after 16-byte moves
|
|
lsr.l #4, D4 ; divide xfer count by 16
|
|
move.l D4, D6 ; d4.w has lower 16-byte block count
|
|
swap D6 ; d6.w has upper 16-byte word count
|
|
|
|
clr.b rXCM(a3) ; rXCM = 0, clear most-sig. byte count
|
|
move.b #$10, rXCL(a3) ; rXCL = 16 bytes, least-sig. byte value
|
|
eieio
|
|
bra.w @bottomRead16
|
|
@read16
|
|
moveq.l #iPhaseMsk, d5 ; load mask bits for phase value
|
|
and.b rSTA(a3), d5 ; are we still in data-in phase?
|
|
cmpi.b #iDataIn, d5 ; data-in phase bits = 001
|
|
bne.w @gotPrematureInt ; no: probably in status phase - split
|
|
|
|
RecCmd $90, 'D',$05
|
|
move.b #cDMAXfer, rCMD(a3) ; load DMA transfer cmd & start loading FIFO
|
|
nop ; currently loaded transfer count is used/reused
|
|
@1
|
|
btst.b #bTermCount, rSTA(a3) ; check if we've rcvd all the data
|
|
bne.s @4 ; if we have, go get the bytes
|
|
bsr Ck4SCSIInt ; poll for unexpected intrp while waiting
|
|
bne.w @gotPrematureInt ; ... maybe disconnected or something catastrophic.
|
|
; premature phase change won't generate intrp bit 'cuz of outstanding DREQ...
|
|
; ... we have to check this condition explicitly
|
|
moveq.l #iPhaseMsk, d5 ; load mask bits for phase value
|
|
and.b rSTA(a3), d5 ; are we still in data-in phase?
|
|
cmpi.b #iDataIn, d5 ; data-in phase bits = 001
|
|
beq.s @1 ; yes, bra. & keep polling
|
|
tst.b rXCL(a3) ; not data-in anymore, have we xferred all data (XCL = 0)?
|
|
beq.s @1 ; if yes then there MUST be a transfer complete bit set
|
|
bra.w @prematurePhzChgSR ; transfer count not 0 so we have a premature end
|
|
|
|
; We need 8 guaranteed DREQs to safely transfer 16 bytes without bus error.
|
|
; DREQ will be active as long there are threshold number of bytes in the
|
|
; FIFO.
|
|
@4
|
|
|
|
; Why is this here? Ck4DREQ is really slow, and it seems unnecessary. If we don't have an interrupt
|
|
; and we do have a full FIFO we damn well better have a DREQ. Maybe it has something to do with the value
|
|
; of the FIFO flags field floating a bit during an xfer...
|
|
; bsr Ck4DREQ
|
|
; beq.s @1 ; loop until asserted
|
|
;
|
|
btst #4, rFIFOflags(a3) ; see if FIFO is full
|
|
beq.s @1 ; loop until asserted
|
|
|
|
|
|
IF forSTP601v1 THEN
|
|
cmp.b #pdmaTypeBIOS,HALc96GlobalRecord.dmaType(A5) ; Is this a Wombat or Primus/Optimus?
|
|
bne.s @notBIOSbased
|
|
|
|
nop
|
|
move.l (a1), (a2)+ ; read 16 bytes
|
|
move.l (a1), (a2)+
|
|
move.l (a1), (a2)+
|
|
move.l (a1), (a2)+
|
|
|
|
bra.b @endloop
|
|
@notBIOSbased
|
|
ENDIF
|
|
nop ; squoosh pipeline
|
|
move.w (a1), (a2)+ ; read 16 bytes
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
@endloop
|
|
IF PostNOP THEN
|
|
nop ; squoosh pipeline
|
|
ENDIF
|
|
|
|
; Note that intrp is asserted only after transfer count is 0, no DREQs pending,
|
|
; and the target asserts REQ for the next byte.
|
|
bsr.w QuickIntCheck ; Really Fast check for interrupt
|
|
beq.b @NoIntYet ;
|
|
@GotAnInt
|
|
move.l d1, d0 ; copy d1 since we might need to pass it to doIntRegs
|
|
andi.l #$00BF00FF, d0 ; don't care about FOS or Gross Error bit !!! use constant
|
|
cmp.l #$00910010, d0 ; Interrupt Pending, XferCnt 0, Data In, Bus Service !!! use constant
|
|
beq.b @bottomRead16 ; cool, keep going with xfer
|
|
; not what we were looking for, doIntRegs
|
|
jsr FullIntRegs ; re-enter doIntRegs d1 is the parameter
|
|
bra.b @bottomRead16 ; we just did a wt4scsi the hard way
|
|
@NoIntYet
|
|
ClearSCSIIRQ ; make sure that we don't go async with an interrupt
|
|
; pending at the VIA but not at the c96
|
|
bsr.w Wt4SCSIInt ; Do the long wait for an interrupt
|
|
bsr.w DeferAndWait ; defer til interupts are enabled
|
|
|
|
@bottomRead16
|
|
dbra D4, @read16 ; loop until done, d4 is lower word count
|
|
dbra D6, @read16 ; loop until done, d6 is upper word count
|
|
|
|
ClearSCSIIRQ ; make sure that we don't go async with an interrupt
|
|
; pending at the VIA but not at the c96
|
|
|
|
;
|
|
; Take care of "singles" - left overs less than 16 bytes. Use polled reads for this
|
|
; by issuing cIOXfer command, waiting for the interrupt then getting the byte. Must
|
|
; check for proper phase between each byte.
|
|
;
|
|
bra.s @16OrLess ; bra. to bottom of loop for zero case
|
|
@rdSingle
|
|
RecCmd $10, 'D',$06
|
|
move.b #cIOXfer, rCMD(a3) ; load IO transfer cmd & begin xfers
|
|
eieio
|
|
|
|
bsr.w Wt4SCSIInt ; Wait for intrp w/o timeout
|
|
move.b rFIFO(a3), (a2)+ ; xfer byte from FIFO into input buffer
|
|
@16OrLess
|
|
moveq.l #iPhaseMsk, d5 ; load mask bits for phase value
|
|
and.b rSTA(a3), d5 ; are we still in data-in phase?
|
|
cmpi.b #iDataIn, d5 ; data-in phase bits = 001
|
|
dbne D2, @rdSingle ; read the rest of the remainders
|
|
bne.s @singlesPhaseChange
|
|
moveq.l #0, D1 ; no bytes left to transfer
|
|
rts ;
|
|
|
|
;
|
|
; Premature phase change - get leftover bytes out of FIFO
|
|
;
|
|
@prematurePhzChgSR
|
|
bsr Ck4DREQ ; more than 2 bytes in FIFO?
|
|
beq.s @5 ; if no DREQ, skip dummy rDMA access
|
|
move.w rDMA(a3), (a2)+ ; get the word out of the FIFO
|
|
addq.l #2,d3 ; account for this data in residual length
|
|
bra.s @prematurePhzChgSR ; and see if there's more
|
|
@5 ; and give us that intrp
|
|
bsr.w Wt4SCSIInt ; Clear pending intrp & get err status
|
|
; on exit d5 = rFOS|rINT|0|rSTA
|
|
@gotPrematureInt
|
|
moveq.l #mFIFOCount, D0 ; use mask to get FIFO flag field
|
|
and.b rFIFOflags(a3), D0 ; how many bytes left in FIFO?
|
|
add.l D0, D3 ; add remainder to our log
|
|
bra.s @btmLeftovers
|
|
@topLeftovers
|
|
move.b rFIFO(a3), (a2)+
|
|
@btmLeftovers
|
|
dbra D0, @topLeftovers
|
|
|
|
; calc how many bytes we've xferred...
|
|
@singlesPhaseChange
|
|
swap D6 ; calculate bytes left to transfer
|
|
move.w D4, D6 ; form long word count
|
|
addq.l #1, D6 ; undo adjustment for aborted dbra
|
|
lsl.l #4, D6 ; mult by 16
|
|
add.l D2, D6 ; add un-xferred remainder
|
|
sub.l D3, D6 ; account for bytes removed after phase chg
|
|
move.l D6, D1 ; number of bytes not transferred
|
|
rts
|
|
|
|
|
|
RTSNAME 'SlowReadReal96'
|
|
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; FastRead96 - implements FastRead
|
|
;
|
|
; Called by: Transfer
|
|
;
|
|
; All primitive data transfer routines assume:
|
|
;
|
|
; Inputs --->
|
|
; -> D2.L number of bytes to transfer
|
|
; -> A2 ptr to data buffer - saved
|
|
; -> A3 SCSI chip read base address - SERIALIZED
|
|
; -> A5 ptr to SCSI Mgr globals
|
|
;
|
|
; Outputs <---
|
|
; <- d1.L bytes not transferred
|
|
;
|
|
; Internal ---
|
|
; D3 - trashed
|
|
; A0 - scratch - saved
|
|
; A1 - SCSI chip read base address - NON-SERIALIZED
|
|
; A2 - ptr to data buffer - saved
|
|
; A3 - SCSI chip read base address - SERIALIZED
|
|
; A5 - ptr to SCSI Mgr globals
|
|
;
|
|
; Method of Data Transfer: (uses Pseudo-DMA)
|
|
; 0) Make sure we got our intrp from the last cmd send
|
|
; 1) Parcel transfer into 64KB blocks since TC regr. handles 64KB max
|
|
; 2) Read 1st byte if input buffer is NOT word aligned
|
|
; 3) Calc. the number of 32-byte block transfers to perform
|
|
; 4) Calc. the remaining number of byte transfers to perform
|
|
; 5) Read data 32-byte blocks at a time using word MOVEs
|
|
; 6) Read remaining data a word at a time
|
|
; 7) Transfer residual byte if there is one
|
|
|
|
D2_thisTime EQU D2 ; .l = number of bytes remaining in this block
|
|
D3_total EQU D3 ; .l = number of bytes remaining in this request
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
FastRead96
|
|
;
|
|
; Loop thru scsiHandshake structure
|
|
;
|
|
move.l D2, D3_total ; save original total request count
|
|
@firstHandshake
|
|
lea scsiHandshake(A0), A1 ; and now with ptr to scsiHandshake
|
|
tst.w (A1) ; if no handshake,
|
|
beq.s FastRead96inner ; -> skip handshake, goto inner routine
|
|
|
|
moveq #0, D2_thisTime
|
|
move.w hdshkRemainder(a0), D2_thisTime ; Leftover Hansdhake?
|
|
beq.b @next ; nope, start handshake over again
|
|
|
|
move.w #0, hdshkRemainder(a0) ; don't try to do it again...
|
|
moveq #0, d0
|
|
move.b hdshkIndex(a0), d0 ; find out which handshake element we were working on
|
|
lsl.w #1, d0 ; adjust for word length
|
|
add.w d0, A1 ; index into the handshake array
|
|
bra.b @handshake ; and do it
|
|
@next
|
|
moveq.l #0, D2_thisTime
|
|
move.w (A1)+, D2_thisTime
|
|
beq.s @firstHandshake
|
|
@handshake
|
|
sub.l D2_thisTime, D3_total ; decrement total by this hsk count
|
|
beq.s @lastOne ; if same, -> this is the last one
|
|
blo.s @useTotal ; if total<hsk, -> use the total left
|
|
|
|
move.l A1, -(sp)
|
|
bsr.s FastRead96inner ; else, use the hsk value as count
|
|
move.l (sp)+, A1
|
|
|
|
tst.w D1 ; did we go out of phase?
|
|
bne.s @didntFinish ; -> yes, adjust unxferred count and ret
|
|
|
|
bra.s @next ; -> no, get the next hsk for next xfer
|
|
|
|
@didntFinish
|
|
add.l D3_total, D1 ; readjust total count by unxfered amount
|
|
rts ; (D1 is return value)
|
|
|
|
@useTotal
|
|
add.l D2_thisTime, D3_total ; restore total to what it was...
|
|
move.l D2_thisTime, D0 ; remember what handshake was
|
|
sub.l D3_total, D0 ; and figure out the remainder was
|
|
move.w D0, hdshkRemainder(A0) ; so we can remember it for later
|
|
move.l A1, D0 ; get next hanshake
|
|
sub.l #2, D0 ; and back up one word (element)
|
|
lea scsiHandshake(A0), A1 ; get the first hanshake
|
|
sub.l A1, D0 ; calculate the offset
|
|
move.b D0, hdshkIndex(A0) ; and remember it for later (whew!)
|
|
move.l D3_total, D2_thisTime
|
|
@lastOne
|
|
bsr.s FastRead96inner
|
|
rts
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
FastRead96inner
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'FsRd' ; EVENT =
|
|
move.l scsiDataResidual(A0), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
IF 1 AND RECORD_ON THEN
|
|
move.l D2, -(sp) ; number of bytes
|
|
move.l A2, -(sp) ;
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
|
|
;
|
|
; Setup A1 to point to a non-serialized image of the c96. If such an image doesn't exist this
|
|
; value will be the same as the serialized image.
|
|
;
|
|
move.l pdmaNonSerlzdAddr(A5), A1 ; point to non-serialized chip image
|
|
|
|
moveq.l #iPhaseMsk, d0 ; load mask for phase bits
|
|
and.b rSTA(a3), d0 ; are we in data-in phase?
|
|
cmpi.b #iDataIn, d0 ; data-in phase bits = 001
|
|
bne.w PhaseErrAtStart ; bra. on phase err
|
|
|
|
cmpi.l #1, d2 ; special case a 1 byte transfer
|
|
bne.s @not1 ; <SM5> pdw
|
|
bsr OneByteRead ;
|
|
subq.l #1, d2
|
|
bra @goodFRead
|
|
@not1
|
|
;
|
|
; Install our bus error handler because we are going into a routine that blindly accesses
|
|
; the SCSI chip (and it might not always be ready)
|
|
;
|
|
bsr.w InstallBEH96
|
|
|
|
move.l d2, d6 ; d6 = number 64KB block to perform
|
|
swap d6 ; upper word of d6 = lower word of d2
|
|
andi.l #$0000FFFF, d2 ; mask out upper word
|
|
beq @2 ; if 0 then we have $10000 (64K) bytes to xfer
|
|
bra.s @skipPhaseCk
|
|
@next64KB
|
|
moveq.l #iPhaseMsk, d0 ; load mask for phase bits
|
|
and.b rSTA(a3), d0 ; are we in data-in phase?
|
|
cmpi.b #iDataIn, d0 ; data-in phase bits = 001
|
|
bne.w @outOfPhase ; outta here.
|
|
@skipPhaseCk
|
|
move.l d2, d4 ; d4 <- d2
|
|
move.b d4, rXCL(a3) ; TC regr (least-sig. byte) <- d4.b
|
|
lsr.l #8, d4 ; get upper byte of low word
|
|
move.b d4, rXCM(a3) ; TC regr (most-sig. byte)
|
|
eieio
|
|
|
|
RecCmd $90, 'D',$08
|
|
move.b #cDMAXfer, rCMD(a3) ; load DMA transfer cmd & begin xfers
|
|
eieio
|
|
|
|
; move.l a2, d5 ;
|
|
; btst.l #0, d5 ; check if input buffer is on word boundary
|
|
; bne.s @misAligned
|
|
@aligned
|
|
move.l d2, d4 ; d4 = copy of transfer count
|
|
lsr.l #5, d4 ; divide xfer count by 32
|
|
ror.l #1, d2 ; xfer byte count to word & remember odd byte
|
|
and.w #$F, d2 ; d2 = remainder word count after 32-byte moves
|
|
neg.w d2 ; negate to form a backward jump offset
|
|
nop ; squoosh pipeline
|
|
jmp @RdLoop(d2.w*2) ; bra. into the loop
|
|
@read32 ;
|
|
move.w (a1), (a2)+ ; do 16 bytes
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
|
|
move.w (a1), (a2)+ ; do another 16 bytes
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+
|
|
move.w (a1), (a2)+ ;
|
|
@RdLoop
|
|
IF DEBUGGING THEN
|
|
tst.b rXCL(A3) ; just for analyzer
|
|
ENDIF
|
|
dbra d4, @read32 ; d4 = # of 32-byte transfers
|
|
IF PostNOP THEN
|
|
nop ; squoosh pipeline
|
|
ENDIF
|
|
bsr.w RemoveBEH96
|
|
bsr.w Wt4SCSIInt ; Wait for intrp w/o timeout
|
|
bsr.w DeferAndWait ; defer til interupts are enabled
|
|
bsr.w InstallBEH96
|
|
|
|
bclr.l #31, d2 ; check if we expected a residual byte
|
|
beq.s @2 ; bra. if no residual
|
|
|
|
moveq.l #mFIFOCount, d0 ; use mask to get FIFO flag field
|
|
and.b rFIFOflags(a3), d0 ; get # of bytes in FIFO
|
|
bne.s @3 ; get byte if FIFO is not empty
|
|
IfDebugStr 'FIFO Empty when we expected residual byte'
|
|
bra.b @2
|
|
@3
|
|
bset.l #31, d2 ; check if we expected a residual byte
|
|
move.b rFIFO(a3), (a2)+ ; xfer residual byte
|
|
@2
|
|
move.l #$10000, d2 ; init to transfer 64K bytes
|
|
dbra d6, @next64KB ;
|
|
bsr.w RemoveBEH96
|
|
;
|
|
; Remove our bus error handler
|
|
;
|
|
@goodFRead ; Don't remove bus error handler here
|
|
; because we can get here from a 1 byte read
|
|
moveq.l #0, D1 ; d1 = # of bytes transferred
|
|
@exit
|
|
rts ;
|
|
|
|
|
|
@outOfPhase
|
|
bsr.w RemoveBEH96
|
|
add.l #1,d6 ; undo for dbra
|
|
swap d6 ; d6 contains the number of 64k xfers
|
|
move.w #0, D6 ; we only care about the high word
|
|
|
|
move.l d6,d1 ; return the number of bytes left to be xferred
|
|
bra.s @exit
|
|
|
|
RTSNAME 'FastRead96'
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
PhaseErrAtStart
|
|
move.l D2, D1 ; return same number as requested
|
|
rts ;
|
|
|
|
NAME 'PhaseErrAtStart'
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; SlowWrite96 - implements Polled Write
|
|
;
|
|
; Called by: Transfer
|
|
;
|
|
; All primitive data transfer routines assume:
|
|
;
|
|
; d1 - <-- bytes transferred
|
|
; d2 - --> number of bytes to transfer
|
|
; d3 - scratch - saved
|
|
; d4 - --> type of transfer to perform
|
|
; d5 - scratch - saved
|
|
; d6 - scratch - saved
|
|
;
|
|
; a0 - scratch - saved
|
|
; a1 - SCSI chip read base address - NON-SERIALIZED
|
|
; a2 - ptr to data buffer - saved
|
|
; a3 - SCSI chip read base address - SERIALIZED
|
|
; A5 - ptr to SCSI Mgr globals
|
|
; a5 - scratch - saved
|
|
;
|
|
;
|
|
|
|
SlowWrite96
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'SwWr' ; EVENT =
|
|
move.l scsiDataResidual(A0), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
IF 1 AND RECORD_ON THEN
|
|
move.l D2, -(sp) ; number of bytes
|
|
move.l A2, -(sp) ;
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
|
|
moveq #0, D3 ; d3 is a residual count, assume zero for now
|
|
|
|
tst.b currentPhase(A5) ;
|
|
bne.w PhaseErrAtStart ; data-out phase bits = 0, bra. on phase err
|
|
|
|
@skipPhaseCk
|
|
; Fill up FIFO with data and start a transfer
|
|
|
|
move.l D2, D4
|
|
lsr.l #4, D4 ; how many 16-byte loops are needed
|
|
move.l D4, D6 ; prep D4 to be low word counter
|
|
swap D6 ; prep D6 to be high word counter
|
|
and.w #$F, D2 ; d2 = remainder word count after 16-byte moves
|
|
beq.b @loopBottom ; if nothing this time do the DBRA and 16 full bytes
|
|
neg.w D2 ; negate to form a backward jump offset
|
|
jmp @bottomOfMoveBs(D2.w*4) ; bra. into the loop
|
|
|
|
@write16 ;
|
|
move.b (a2)+, rFIFO(a3) ; do 8 bytes
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
;
|
|
move.b (a2)+, rFIFO(a3) ; do 8 more bytes
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
move.b (a2)+, rFIFO(a3)
|
|
@bottomOfMoveBs
|
|
RecCmd $10, 'D',$0a
|
|
move.b #cIOXfer, rCMD(a3) ; load IO transfer cmd & begin xfers
|
|
eieio ; nonserialized I/O machines only
|
|
|
|
bsr.w QuickIntCheck ; Really Fast check for interrupt
|
|
beq.b @NoIntYet ;
|
|
|
|
move.l D1, D0 ; copy d1 since we might need to pass it to doIntRegs
|
|
andi.l #$00BF00FF, D0 ; don't care about some flags or Gross Error bit !!! use constant
|
|
cmp.l #$00900010, D0 ; Interrupt Pending, XferCnt 0, Data Out, Bus Service !!! use constant
|
|
bne.b @doFullRegs ; not cool->do the full int thing
|
|
|
|
@loopBottom
|
|
dbra D4, @write16 ; d4 = # of 16-byte tranfers (low word)
|
|
dbra D6, @write16 ; d6 = # of 16-byte tranfers (high word)
|
|
;
|
|
; We've transferred all requested data.
|
|
;
|
|
@completeSlowWrite
|
|
ClearSCSIIRQ ; make sure that we don't go async with an interrupt
|
|
; pending at the VIA but not at the c96
|
|
moveq.l #0, D1 ; D1 = # of bytes remaining
|
|
rts ;
|
|
|
|
|
|
|
|
|
|
@doFullRegs ; not what we were looking for, doIntRegs
|
|
bsr.w FullIntRegs ; re-enter doIntRegs d1 is the parameter
|
|
bra.b @afterWt4 ; we just did a wt4scsi the hard way
|
|
@NoIntYet
|
|
ClearSCSIIRQ ; make sure that we don't go async with an interrupt
|
|
; pending at the VIA but not at the c96
|
|
bsr.w Wt4SCSIInt ; Do the long wait for an interrupt
|
|
|
|
bsr.w DeferAndWait ; defer til interupts are enabled
|
|
@afterWt4
|
|
tst.b currentPhase(A5) ;
|
|
beq.s @loopBottom
|
|
|
|
moveq.l #mFIFOCount, D1 ;
|
|
and.b int_rFIFOflags(A5), D1 ; get # of un-xferred data in FIFO
|
|
bne.s @doFlush
|
|
@afterFlush
|
|
swap D6 ; move hi word of counter into hi word of long
|
|
move.w D4, D6 ; get low order word into same long
|
|
lsl.l #4, D6 ; multiply by 16
|
|
|
|
add.l D6, D1 ; add FIFOcount to total bytes left
|
|
rts ;
|
|
|
|
@doFlush
|
|
RecCmd $01, 'D',$0c
|
|
move.b #cFlushFIFO, rCMD(a3) ; Flush FIFO
|
|
eieio
|
|
bra.s @afterFlush
|
|
|
|
RTSNAME 'SlowWrite96'
|
|
|
|
|
|
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
; FastWrite - implements Blind Write
|
|
;
|
|
; Called by: Transfer
|
|
;
|
|
; All primitive data transfer routines assume:
|
|
;
|
|
; d1 - <-- bytes transferred
|
|
; d2 - --> number of bytes to transfer
|
|
; d3 - scratch - saved
|
|
; d5 - scratch - saved
|
|
; d6 - scratch - saved
|
|
;
|
|
; a0 - scratch - saved
|
|
; a1 - SCSI chip read base address - NON-SERIALIZED
|
|
; a2 - ptr to data buffer - saved
|
|
; a3 - SCSI chip read base address - SERIALIZED
|
|
; A5 - ptr to SCSI Mgr globals
|
|
; a5 - scratch - saved
|
|
;
|
|
; Method of Data Transfer: (uses pseudo-DMA mode)
|
|
; 0) Make sure we got our intrp from the last cmd send
|
|
; 1) Parcel transfer into 64KB blocks since TC regr. handles 64KB max
|
|
; 2) Preload FIFO with non-aligned byte; get us word aligned
|
|
; 3) Calc. the number of 32-byte block transfers to perform
|
|
; 4) Calc. the remaining number of transfers to perform
|
|
; 5) Write data 32-byte blocks at a time using word MOVEs
|
|
; 6) Write remaining data using word MOVEs
|
|
; 7) Transfer residual byte if there is one
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
FastWrite96
|
|
;
|
|
; Loop thru scsiHandshake structure
|
|
;
|
|
move.l D2, D3_total ; save original total request count
|
|
@firstHandshake
|
|
lea scsiHandshake(A0), A1 ; and now with ptr to scsiHandshake
|
|
tst.w (A1) ; if no handshake,
|
|
beq.s FastWrite96inner ; -> skip handshake, goto inner routine
|
|
|
|
moveq #0, D2_thisTime
|
|
move.w hdshkRemainder(a0), D2_thisTime ; Leftover Hansdhake?
|
|
beq.b @next ; nope, start handshake over again
|
|
|
|
move.w #0, hdshkRemainder(a0) ; don't try to do it again...
|
|
moveq #0, d0
|
|
move.b hdshkIndex(a0), d0 ; find out which handshake element we were working on
|
|
lsl.w #1, d0 ; adjust for word length
|
|
add.w d0, A1 ; index into the handshake array
|
|
bra.b @handshake ; and do it
|
|
@next
|
|
moveq.l #0, D2_thisTime
|
|
move.w (A1)+, D2_thisTime
|
|
beq.s @firstHandshake
|
|
@handshake
|
|
sub.l D2_thisTime, D3_total ; decrement total by this hsk count
|
|
beq.s @lastOne ; if same, -> this is the last one
|
|
blo.s @useTotal ; if total<hsk, -> use the total left
|
|
|
|
move.l A1, -(sp)
|
|
bsr.s FastWrite96inner ; else, use the hsk value as count
|
|
move.l (sp)+, A1
|
|
|
|
tst.w D1 ; did we go out of phase?
|
|
bne.s @didntFinish ; -> yes, adjust unxferred count and ret
|
|
|
|
bra.s @next ; -> no, get the next hsk for next xfer
|
|
|
|
@didntFinish
|
|
add.l D3_total, D1 ; readjust total count by unxfered amount
|
|
rts ; (D1 is return value)
|
|
|
|
@useTotal
|
|
add.l D2_thisTime, D3_total ; restore total to what it was...
|
|
move.l D2_thisTime, D0 ; remember what handshake was
|
|
sub.l D3_total, D0 ; and figure out the remainder was
|
|
move.w D0, hdshkRemainder(A0) ; so we can remember it for later
|
|
move.l A1, D0 ; get next hanshake
|
|
sub.l #2, D0 ; and back up one word (element)
|
|
lea scsiHandshake(A0), A1 ; get the first hanshake
|
|
sub.l A1, D0 ; calculate the offset
|
|
move.b D0, hdshkIndex(A0) ; and remember it for later (whew!)
|
|
move.l D3_total, D2_thisTime
|
|
@lastOne
|
|
bsr.s FastWrite96inner
|
|
rts
|
|
|
|
;ÑÑÑÑÑÑÑÑÑÑÑÑ
|
|
FastWrite96inner
|
|
IF 1 AND RECORD_ON THEN
|
|
pea 'FsWr' ; EVENT =
|
|
move.l scsiDataResidual(A0), -(sp)
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
IF 1 AND RECORD_ON THEN
|
|
move.l D2, -(sp) ; number of bytes
|
|
move.l A2, -(sp) ;
|
|
bsr RecordEvent
|
|
addq.l #8, sp
|
|
ENDIF
|
|
|
|
|
|
;
|
|
; Setup A1 to point to a non-serialized image of the c96. If such an image doesn't exist this
|
|
; value will be the same as the serialized image.
|
|
;
|
|
move.l pdmaNonSerlzdAddr(A5), A1 ; point to non-serialized chip image
|
|
|
|
moveq.l #iPhaseMsk, d0 ;
|
|
and.b rSTA(a3), d0 ; are we in data-out phase?
|
|
bne.w PhaseErrAtStart ; data-out phase bits = 0, bra. on phase err
|
|
|
|
cmpi.l #1, d2 ; if 1 byte write then...
|
|
bne.s @not1 ; <SM5> pdw
|
|
bsr OneByteWrite ; ...do 1 byte transfer
|
|
subq.l #1, D2
|
|
bra @goodFWrite
|
|
@not1
|
|
|
|
;
|
|
; Install our bus error handler because we are going into a routine that blindly accesses
|
|
; the SCSI chip (and it might not always be ready)
|
|
;
|
|
bsr.w InstallBEH96
|
|
|
|
move.l d2, d6 ; d6 = number 64KB block to perform
|
|
swap d6 ; upper word of d6 = lower word of d2
|
|
andi.l #$0000FFFF, d2 ; mask out upper word
|
|
beq @2 ; if 0 then we have $10000 (64K) bytes to xfer
|
|
|
|
move.l a2, d5 ;
|
|
btst.l #0, d5 ; check if input buffer is on word boundary
|
|
bne.w @misAligned
|
|
bra.b @skipPhaseCk
|
|
@next64KB ; buffer is aligned from this point
|
|
moveq.l #iPhaseMsk, d0 ; load mask for phase bits
|
|
and.b rSTA(a3), d0 ; are we in data-out phase?
|
|
bne.w @phaseErr ; nope, outta here.
|
|
@skipPhaseCk
|
|
move.l d2, d4 ; d4 <- d2
|
|
move.b d4, rXCL(a3) ; TC regr (least-sig. byte) <- d4.b
|
|
lsr.l #8, d4 ; get upper byte of low word
|
|
move.b d4, rXCM(a3) ; TC regr (most-sig. byte) <- d4.b
|
|
eieio
|
|
|
|
RecCmd $90, 'D',$0e
|
|
move.b #cDMAXfer, rCMD(a3) ; load DMA transfer cmd & begin xfers
|
|
eieio
|
|
|
|
move.l d2, d4 ; d4 = copy of transfer count
|
|
lsr.l #5, d4 ; divide xfer count by 32
|
|
ror.l #1, d2 ; xfer byte count to word & remember odd byte
|
|
and.w #$F, d2 ; d2 = remainder word count after 32-byte moves
|
|
neg.w d2 ; negate to form a backward jump offset
|
|
nop ; squoosh pipeline
|
|
jmp @WrLoop(d2.w*2) ; bra. into the loop
|
|
@write32 ;
|
|
move.w (a2)+, (a1) ; do 16 bytes
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
|
|
move.w (a2)+, (a1) ; do another 16 bytes
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1)
|
|
move.w (a2)+, (a1) ;
|
|
@WrLoop
|
|
dbra d4, @write32 ; d4 = # of 32-byte tranfers
|
|
nop ; Force write to complete. <SM7>
|
|
; INT & TC maybe TRUE at this point
|
|
btst.l #31, d2 ; check if we have a residual byte
|
|
beq.s @noResidual ;
|
|
@residual
|
|
move.b (a2)+, rDMA(a3) ; xfer residual byte
|
|
eieio
|
|
@noResidual
|
|
bsr.w RemoveBEH96 ; remove BEH when not in data xfer routine
|
|
bsr.w Wt4SCSIInt ; Wait for intrp w/o timeout
|
|
; on exit d5 = rFOS|rINT|0|rSTA
|
|
bne.s @goodFWrite ; bra. if ended up disconnected
|
|
|
|
bsr.w DeferAndWait ; defer til interupts are enabled
|
|
bsr.w InstallBEH96
|
|
@2
|
|
move.l #$10000, d2 ; init to transfer 64K bytes
|
|
dbra d6, @next64KB ;
|
|
@disconnected
|
|
;
|
|
; Remove our bus error handler
|
|
;
|
|
bsr.w RemoveBEH96
|
|
@goodFWrite
|
|
moveq.l #0, D1 ; d1 = # of bytes transferred
|
|
@exit
|
|
rts ;
|
|
|
|
|
|
@misAligned ;
|
|
subq.l #1, d2 ; adjust for transfer count calc
|
|
move.b (a2)+, rFIFO(a3) ; ...preload fifo with odd byte
|
|
eieio
|
|
bra.w @next64KB ; now we're word aligned
|
|
@phaseErr
|
|
bsr.w RemoveBEH96
|
|
add.l #1,d6 ; undo for dbra
|
|
swap d6 ; d6 contains the number of 64k xfers
|
|
move.w #0, D6 ; we only care about the high word
|
|
|
|
move.l d6,d1 ; return the number of bytes left to be xferred
|
|
bra.s @exit
|
|
|
|
RTSNAME 'FastWrite96'
|
|
|
|
|
|
|
|
|
|
ENDWITH
|
|
|
|
END
|