; listing of floppy speeder.s
DeviceList     EQU 350
TrackTask      EQU 302
TrackPort      EQU 36
SPReg          EQU 54
ReplyAddress   EQU 70
IDNestCnt      EQU 294
PortStatus     EQU 34
CMD_READ       EQU 2
FindName       EQU -276
Wait           EQU -318
AllocMem       EQU -198
FreeMem        EQU -210

Req1           EQU $01                   ;MEMF_PUBLIC
Req2           EQU $03
TrackSize      EQU $1604                 ;Number of Bytes in one Track

ReadError      EQU 21
NoDisk         EQU 29
NoSync         EQU 21

               lea $fc0000,a0
               cmp.l #$2033332E,$1c(a0)
               bne \DError4
               cmp.l #$31393220,$20(a0)
               bne \DError4
               move.l $4,a6
               bsr Disable
               move.l #Ende-Start1,d0
               move.l #Req1,d1
               jsr AllocMem(a6)
               move.l d0,a1
               move.l a1,a4              ;Save memory address
               move.l d0,d4
               beq \DError1
               lea TrackName(pc),a1
               lea DeviceList(a6),a0
               jsr FindName(a6)
               tst.l d0
               beq \DError3
               move.l d0,a5

               lea MyTask(pc),a0
               lea Start1(pc),a1
               suba.l a1,a0
               adda.l a0,a4              ;Address of  MyTask
               clr.l d3
\l3:           move.l TrackPort(a5,d3),d0
               beq \l5
               move.l d0,a3
               move.l #TrackSize,d0
               move.l #Req2,d1
               jsr AllocMem(a6)
               lea TrackMemory1(pc),a0
               lea (a0,d3),a0            ;Track Memory for Disk
               move.l d0,(a0)
               beq \DError2
\l1:           btst #0,PortStatus(a3)    ;wait, until Task in Wait
               bne \l1
               move.l #1800,$2c(a3)      ;accelerate Step motor
               move.l #1,$30(a3)         ;no wait after Posi.
               lea TrackTask+SPReg(a3),a2
               move.l (a2),a1
               move.l a4,ReplyAddress(a1)
\l5:           addq.l #4,d3
               cmpi.w #16,d3
               bcs \l3

               move.l #Ende-Start1,d0
               lea Start1(pc),a0
               move.l d4,a1
\l4:           move.b (a0)+,(a1)+        ;Copy data
               subq.l #1,d0
               bne \l4
               bsr blink
\DError1:
               bsr Enable
\DError4:      clr.l d0
               rts
\DError2:      subq.l #4,d3
               bcs \DError3
               lea TrackMemory1(pc),a0
               lea (a0,d3),a0
               move.l (a0),a1
               move.l #TrackSize,d0
               jsr FreeMem(a6)
               bra \DError2
\DError3:      move.l #Ende-Start1,d0
               move.l a4,a1
               jsr FreeMem(a6)
               bra \DError1

Blink:         move.l D0,-(a7)
               move.l #$20000,d0
\l1:           move.w d0,$dff180
               sub.l #1,d0
               bne \l1
               move.l (a7)+,D0
               rts

Start1:
Disable:       move.w #$4000,$dff09a
               move.l a6,-(a7)
               move.l $4,a6
               add.b #1,IDNestCnt(a6)
               move.l (a7)+,a6
               rts
Enable:        move.l a6,-(a7)
               move.l $4,a6
               sub.b #1,IDNestCnt(a6)
               bge \l1
               move.w #$c000,$dff09a
\l1:           move.l (a7)+,a6
               rts

TheTask:       MOVEA.L 8(A7),A6
               MOVEA.L 4(A7),A3
               LEA $12E(A3),A0
               MOVE.L A0,$10(A3)
               JSR $FE9960
LFEAE64:       BSR.S LFEAE7A
               MOVE.L #$300,D0
               MOVE.L A6,-(A7)
               MOVEA.L $34(A6),A6
               JSR Wait(A6)
MyTask:        MOVEA.L (A7)+,A6
               BRA.S LFEAE64
LFEAE7A:       BSET #0,$22(A3)
               BNE NoMessage
LFEAE84:       MOVEA.L A3,A0
               MOVE.L A6,-(A7)
               MOVEA.L $34(A6),A6
               JSR -$174(A6)
               MOVEA.L (A7)+,A6
               TST.L D0
               BEQ LFEAF3E
               MOVEA.L D0,A2
               BCLR #3,$40(A3)
               BEQ LFEAF1E
               MOVEA.L $52(A3),A0
               BCLR #0,2(A0)
               BEQ LFEAEBA
               MOVE.L A0,$4E(A3)
               JSR $FEA958
LFEAEBA:       MOVEA.L $52(A3),A0
               MOVEQ #-1,D0
               MOVE.W D0,0(A0)
               MOVE.W D0,$4C(A3)
               MOVEQ #0,D0
               JSR $FEA462
               MOVEA.L A6,A0
               MOVEA.L $34(A0),A6
               ADDQ.B #1,$127(A6)
               MOVEA.L A0,A6
               TST.W $24(A3)
               BNE LFEAF12
               MOVEQ #0,D0
               MOVE.B $43(A3),D0
               MOVE.L A6,-(A7)
               MOVEA.L $3C(A6),A6
               JSR -$C(A6)
               MOVEA.L (A7)+,A6
               LEA $24(A6),A0
               MOVEQ #0,D0
               MOVE.B $43(A3),D0
               LSL.L #2,D0
               ADDA.L D0,A0
               CLR.L (A0)
               SUBA.L A1,A1
               MOVE.L A6,-(A7)
               MOVEA.L $34(A6),A6
               JSR -$120(A6)
               MOVEA.L (A7)+,A6
LFEAF12:       MOVE.L A6,-(A7)
               MOVEA.L $34(A6),A6
               JSR -$8A(A6)
               MOVEA.L (A7)+,A6
LFEAF1E:       MOVEA.L A2,A1
               LEA $86(A3),A0
               CMPA.L A0,A2
               BNE.S LFEAF30
               JSR $FE9960
               BRA LFEAE84
LFEAF30:       BSET #1,$22(A3)
               bsr Stepper1
               BRA LFEAE84
LFEAF3E:       BCLR #1,$22(A3)
               BCLR #0,$22(A3)
NoMessage:     RTS

Stepper1:      MOVE.L A2,-(A7)
               MOVEA.L A1,A2
               ANDI.B #-6,$40(A3)
               jsr $FE998C
               MOVEA.L A2,A1
               MOVE.W $1C(A2),D0
               cmp.b #CMD_READ,d0
               beq Stepper2
               BTST #$F,D0
               BEQ.S LFEA052
               BSET #2,$40(A3)
               MOVE.L $126(A3),D1
               CMP.L $30(A2),D1
               BLS.S LFEA052
               MOVE.B #$1D,$1F(A2)
               JSR $FEA1B0
               BRA.S LFEA066
LFEA052:       MOVEQ #0,D1
               MOVE.B D0,D1
               LSL.W #2,D1
               LEA $FEA300,A0
               MOVEA.L 0(A0,D1.W),A0
               JSR (A0)
LoadEnde:
               JSR $FE998C
LFEA066:       MOVEA.L (A7)+,A2
               RTS

Stepper2: ;     bsr Blink
               bsr Stepper3
               bra LoadEnde

Stepper3:
 MOVEM.L A2-A4,-(A7)
 MOVEA.L $18(A1),A3
 MOVEA.L A1,A2
 MOVE.L A2,$44(A3)
 MOVE.L #0,$20(A2)
 MOVE.L $28(A2),$56(A3)
 MOVE.L $2C(A2),D0
 JSR $FEA182
 TST.L D0
 BMI LFEA92A
 MOVE.W D0,$4A(A3)
 MOVE.B D1,$49(A3)
 MOVE.L $2C(A2),D0
 ADD.L $24(A2),D0
 JSR $FEA182
 TST.L D0
 BMI LFEA92A
 BTST #2,$40(A3)
 BEQ.S LFEA78E
 MOVE.L $34(A2),$5A(A3)
 BEQ.S LFEA78E
 BSET #0,$40(A3)
LFEA78E:BTST #1,$40(A3)
 BEQ.S LFEA7A0
 MOVE.B #$1D,$1F(A2)
 BRA LFEA920
LFEA7A0:MOVE.W $4A(A3),D0
 JSR $FEA93C
 MOVE.L A0,$4E(A3)
 BNE.S LFEA804
 jsr $FEA952
 MOVEA.L A0,A2
 MOVE.L A2,$4E(A3)
LFEA7B8:BTST #0,2(A2)                    ;Track in buffer
 BEQ.S LFEA7D4                           ;No, read one
 JSR $FEA958
 TST.L D0
 BEQ.S LFEA7D4
 MOVEA.L $44(A3),A1
 MOVE.B D0,$1F(A1)
 BRA LFEA920
LFEA7D4:MOVE.W $4A(A3),0(A2)
 BCLR #0,2(A2)
 CLR.B $42(A3)
 bsr read1                               ;read track into buffer
 MOVE.B 3(A2),D0
 CMPI.B #$B,D0
 BCS.S LFEA804
 MOVE.W #-1,0(A2)
 MOVEA.L $44(A3),A1
 MOVE.B D0,$1F(A1)
 BRA LFEA920
LFEA804:MOVEA.L $44(A3),A2
 MOVE.W $1C(A2),D0
 MOVEA.L $4E(A3),A0
 CMPI.B #3,D0
 BNE LFEA890
 BSET #0,2(A0)
 MOVEQ #0,D0
 MOVE.B $49(A3),D0
 SUB.B 3(A0),D0
 BPL.S LFEA82E
 ADDI.B #$B,D0
LFEA82E:MULU #$440,D0
 LEA $680(A0),A4
 ADDA.L D0,A4
 BTST #0,$40(A3)
 BEQ.S LFEA866
 MOVEA.L $5A(A3),A0
 MOVE.L #$10,D0
 LEA $10(A4),A1
 JSR $FEAB4A
 LEA 8(A4),A0
 MOVE.W #$28,D1
 JSR $FEADA4
 LEA $30(A4),A0
 JSR $FEAD46
LFEA866:MOVEA.L $56(A3),A0
 MOVE.L #$200,D0
 LEA $40(A4),A1
 JSR $FEAB4A
 LEA $40(A4),A0
 MOVE.W #$400,D1
 JSR $FEADA4
 LEA $38(A4),A0
 JSR $FEAD46
 BRA LFEA8D6
LFEA890:MOVEQ #0,D0
 BTST #0,$40(A3)                         ;SecLabel set?
 BEQ.S LFEA8C4                           ;no
 MOVE.B $49(A3),D0                       ;Sector number to D0
 SUB.B 3(A0),D0
 BPL.S LFEA8A0
 ADDI.B #$B,D0
LFEA8A0:MULU #$440,D0
 LEA $680(A0),A4
 ADDA.L D0,A4
 LEA $10(A4),A1
 MOVEA.L $5A(A3),A0
 MOVE.L #$10,D0
 JSR $FEACB2
LFEA8C4:
 clr.l d0
 MOVE.B $49(A3),D0                       ;Sector number to D0
 MOVEA.L $56(A3),A1                      ;destination address
 lea TrackMemory1(pc),a0
 clr.l d1
 move.b $43(a3),d1
 lsl.w #2,d1
 adda.l d1,a0
 movea.l (a0),a0
 mulu #$200,d0
 adda.l d0,a0
 move.w #$200,d0
 bsr CopyBlock
LFEA8D6:MOVE.L #$200,D1
 ADD.L D1,$56(A3)
 MOVE.L $20(A2),D0
 ADD.L D1,D0
 MOVE.L D0,$20(A2)
 BTST #0,$40(A3)
 BEQ.S LFEA8FA
 ADDI.L #$10,$5A(A3)
LFEA8FA:CMP.L $24(A2),D0
 BCC.S LFEA920
 MOVEA.L $4E(A3),A2
 ADDQ.B #1,$49(A3)
 CMPI.B #$B,$49(A3)
 BLT LFEA804
 MOVE.B #0,$49(A3)
 ADDQ.W #1,$4A(A3)
 BRA LFEA7B8
LFEA920:MOVEA.L $44(A3),A1
 JSR $FEA1B0
 BRA.S LFEA936
LFEA92A:MOVEA.L $44(A3),A1
 MOVE.B #-4,$1F(A1)
 BRA.S LFEA920
LFEA936:MOVEM.L (A7)+,A2-A4
 RTS
read1:         MOVEM.L A2,-(A7)
               MOVEA.L $4E(A3),A2
               MOVEQ #1,D0
               jsr $FEA462               ;Motor on
LFEA9AC:       MOVEQ #0,D0
               MOVE.W $4A(A3),D0
               jsr $FEA3DA               ;Head Posi.
LFEA9B6:       LEA 1664(A2),A0
               lea TrackMemory1(pc),a1
               clr.l d0
               move.b $43(a3),d0
               lsl.w #2,d0
               adda.l d0,a1
               move.l (a1),a1
               bsr trackread1
               move.w FirstBlock(pc),D0
               MOVE.B d0,3(A2)
               lea ErrorFlag(pc),a0
               tst.w (a0)
               beq \Ende                 ;No Error
\Error:        MOVE.B 1(a0),3(A2)        ;Store error
               ADDQ.B #1,$42(A3)
               MOVE.B $42(A3),D0
               CMP.B $34(A3),D0
               BGT.S \Ende               ;End too many errors
               ANDI.B #3,D0
               BNE.S LFEA9B6
               MOVE.W #-1,$4C(A3)
               BRA.S LFEA9AC
\Ende:         MOVEM.L (A7)+,A2
               RTS

;Track read and decoder
;>= A1 = Pointer to buffer for decoded data
;>= A0 = Pointer to buffer for coded data

Trackread1:
               MOVEM.L D2-D4/a4-a5,-(A7)
               move.l a0,a5
               move.l a1,a4
               lea ErrorFlag(pc),a1
               clr.w (a1)
               lea DecodeNum(pc),a1
               move.w #$080,(a1)         ;Number long words to  decode
               lea $40(a5),a0
               lea DecodeAdr(pc),a1
               move.l a0,(a1)            ;Data area for 1. Blocks
               adda.l #$400,a0
               lea FTestAdr(pc),a1
               move.l a0,(a1)            ;Address of next Block
               jsr $FEADDC               ;Check drive
               MOVE.B $41(A3),$BFD100
               BTST #2,$BFE001           ;Disk in drive
               BNE.S \FL3                ;Ok
               lea ErrorFlag(pc),a1
               move.w #NoDisk,(a1)       ;No disk in drive
               BRA   \FL5                ;Ende

\FL3:          bsr Disable
               move.l a6,-(a7)
               MOVEA.L A5,A6             ;Track buffer
               move.l #$aaaaaaaa,(a6)+
               move.w #$4489,(a6)+       ;store first Sync
               bsr search
               tst.l d0
               bpl \FL8
               lea ErrorFlag(pc),a1
               move.w #NoSync,(a1)       ;No Sync
               bra \FL9                  ;End
\FL8:          bsr FErase                ;Prepare track buffer
               clr.l d2
               move.w BytesBefGap(pc),d2 ;Num. of Bytes before Gap
               tst.l d2
               beq \FL1                  ;No Bytes before Gap
               lea BlockAdr(pc),a1
               clr.w (a1)                ;Offset im Block
               bsr Numread1              ;Bytes read
               clr.l d0
               move.w BytesBefGap(pc),d0
               move.l a5,a6
               adda.l d0,a6              ;Pointer to next buffer
               move.l #$aaaaaaaa,(a6)+
               move.w #$4489,(a6)+       ;store first sync
\FL1:          move.w BytesAftGap(pc),d2
               tst.l d2
               beq \FL2
               lea BlockAdr(pc),a1
               clr.w (a1)
               bsr Numread1
               bsr lastoneblock
\FL2:          move.l #$aaaaaaaa,$2ec0(a5) ;Creat gap after data
               BTST #2,$BFE001           ;Disk in drive?
               bne   \FL9                ;Ok, Disk in Drive
               lea ErrorFlag(pc),a1
               move.w #NoDisk,(a1)
\FL9:          move.l (a7)+,a6
\FL5:          bsr Enable
               jsr $FEAE42               ;drop drive
               MOVEM.L (A7)+,D2-D4/a4-a5
               RTS

;Prepare track buffer (clrear block start)
;>= A5 = Pointer to track buffer

FErase:        move.l a5,a0
               move.w #10,d1
               clr.l d0
\L1:           move.l d0,$440(a0)
               adda.l #$440,a0
               dbf d1,\L1
               lea BlockReport1(pc),a0
               move.w #10,d1
\L2:           clr.w (a0)+
               dbf d1,\L2
               rts

;Read set number of bytes
;>= A6 = Pointer to destination
;>= D2 = Number of bytes to read

Numread1:
               bsr install
               MOVE.W D2,D0
               LSR.W #1,D0
               ORI.W #$8000,D0
               add.w #1,d0
               MOVE.W D0,36(A1)
               MOVE.W D0,36(A1)
               bsr decode
               LEA $DFF000,A1
               MOVE.W #$4000,$24(A1)
               rts

;Prepare to read
;>= A6 Pointer to track buffer

install:       LEA $DFF000,A1
               move.w #$4000,$24(a1)     ;set Disk-Len back
               move.w #$8400,$9e(a1)     ;switch on Disk Sync
               move.w #$4489,$7e(a1)     ;SYNC-Mark
               MOVE.L A6,$20(A1)         ;pass buffer
               move.w #$0002,$dff09c
               rts

;Code long wor dand enterinto buffer
;>= D0 = Long word
;>= A0 = Pointer to buffer

CodeLWort:     MOVEM.L D2-D3,-(A7)
               MOVE.L D0,D3
               LSR.L #1,D0
               BSR \CH1
               MOVE.L D3,D0
               BSR \CH1
               BSR Randsetone
               MOVEM.L (A7)+,D2-D3
               RTS
\CH1:          ANDI.L #$55555555,D0
               MOVE.L D0,D2
               EORI.L #$55555555,D2
               MOVE.L D2,D1
               LSL.L #1,D2
               LSR.L #1,D1
               BSET #$1F,D1
               AND.L D2,D1
               OR.L D1,D0
               BTST #0,-1(A0)
               BEQ.S \CH2
               BCLR #$1F,D0
\CH2:          MOVE.L D0,(A0)+
               RTS
;set border

Randsetone:    MOVE.B (A0),D0
               BTST #0,-1(A0)
               BNE.S \CH4
               BTST #6,D0
               BNE.S \CH6
               BSET #7,D0
               BRA.S \CH5
\CH4:          BCLR #7,D0
\CH5:          MOVE.B D0,(A0)
\CH6:          RTS

;determine checksum
;>= D1 = Number of Bytes (must be divisible by 4)
;>= A0 = Pointer to buffer
;=> D0 = Check sum

CheckSum:      MOVE.L D2,-(A7)
               LSR.W #2,D1
               SUBQ.W #1,D1
               MOVEQ #0,D0
\PS1:          MOVE.L (A0)+,D2
               EOR.L D2,D0
               DBRA D1,\PS1
               ANDI.L #$55555555,D0
               MOVE.L (A7)+,D2
               RTS

;Decode block header
;>= A0 is pointer to header
;=> D0 = Header

Header:        move.l (a0)+,D0
               move.l (a0)+,D1
               andi.l #$55555555,d0
               andi.l #$55555555,d1
               lsl.l #1,D0
               or.l D1,D0
               rts

;find first block
;=> A6 = Pointer to track buffer
;=> D0 = Null: Block found
;=> BytesBefGap = Number of Bytes before the Gap
;=> BytesAftGap = Number of Bytes after the Gap

search:        
               movem.l d2-d4/a2,-(a7)
               move.w #11,d2             ;Number of errors permitted
\SU1:          bsr install
               move.w #$8024,d0          ;$24 Words read
               MOVE.W D0,$dff024
               MOVE.W D0,$dff024
               bsr Blockready            ;wait for ready Block
               tst.l d0                  ;Error, then D0 = -1
               bmi \SUError

               lea 8(a5),a0              ;Pointer to Blockheader
               moveq #$28,d1             ;number of long words
               bsr CheckSum              ;Sum for Header
               move.l d0,d3              ;Sum stored
               lea 48(a5),a0             ;*Sum
               bsr Header                ;get sum from Header
               cmp.l d0,d3               ;compare sums
               bne \SUNeu
               lea 8(a5),a0
               bsr Header                ;Header decode
               move.w d0,d3              ;Header to D3
               lsr.w #8,d3
               andi.w #$00ff,d3          ;isolate sector number
               addi.w #1,d3              ;incr. sector number
               cmp.w #$000a,d3           ;Nummer > 10?
               bls \SU2                  ;No, OK
               clr.w d3                  ;Number = 0
\SU2:          lea SectNum(pc),a2
               move.w d3,(a2)            ;Store number
               lea FirstBlock(pc),a2
               move.w d3,(a2)            ;Number of first block

               move.w d0,d3              ;Header
               andi.w #$ff,d3            ;Sectors to gap
               cmp.b #$0c,d3             ;Header OK?
               bcs.s \SUok
\SUNeu:        dbf d2,\SU1
               bra \SUError
\SUok:

               sub.w #1,d3               ;Num. of blocks to gap
               move.w d3,d2
               move.w #$000b,d4
               sub.b d2,d4               ;Num. of blocks after gap
               mulu #$440,d3             ;Num. of bytes to gap
               mulu #$440,d4             ;Num. of bytes to gap
               clr.l d0
               lea BytesBefGap(pc),a2
               move.w d3,(a2)
               lea BytesAftGap(pc),a2
               move.w d4,(a2)
               lea SectBL(pc),a2
               move.w #$0b,(a2)          ;Sectors before gap to load
               bra \SUEnd
\SUError:      move.l #-1,d0
               lea ErrorFlag(pc),a2
               move.w #ReadError,(a2)
\SUEnd:        movem.l (a7)+,d2-d4/a2
               rts

Blockready:    clr.l d0                  ;Error-Flag cleared
               move.l #$20000,d1
               move.w #$0002,$dff09c     ;DiskInt cleared
\B1:           MOVE.W $DFF01E,D0
               BTST #1,D0
               bne.s \B2
               sub.l #1,d1
               bne \B1
               move.l #-1,d0             ;Error occoured
\B2:           RTS


;decode bytes, unitl block ead

decode:
               movem.l d2-d4/a2-a3,-(a7)
               clr.l d3
               move.l a3,d4              ;save drive-prot
               move.w BlockAdr(pc),d3    ;Offset in Block
               move.l FTestAdr(pc),a0    ;Address to test if
                                         ;Block already loaded
               move.l DecodeAdr(pc),a2       ;Address, decode is done
               move.w DecodeNum(pc),d2       ;Number for decoding

\DC1:          MOVE.W $DFF01E,D0
               BTST #1,D0                ;Area read already
               bne  \DCEnd               ;Yes, end
               tst.l (a0)                ;TestAdr
               beq \DC1                  ;Wait, until block read

               movem.l a0-a1,-(a7)       ;save registern
               lea -$40(a2),a1           ;* Block Start
               move.l d4,a3              ;* Drive-Port
               bsr BlockCheck            ;Block check
               movem.l (a7)+,a0-a1       ;restore Register
               move.w SectNum(pc),d0
               mulu #$200,d0
               move.l a4,a1              ;Basic address for dest. data
               add.l d0,a1               ;Address of the Blocks
\DC2:
               MOVE.W $DFF01E,D0
               BTST #1,D0
               bne.s \DCEnd              ;area already read

               move.l (a2),D0
               move.l $200(a2),D1
               adda.l #4,a2
               andi.l #$55555555,d0
               andi.l #$55555555,d1
               lsl.l #1,D0
               or.l D1,D0
               move.l d0,(a1,d3)         ;store long word
               addq.w #4,d3
               subq.w #1,D2              ;Decode number
               bne \DC2
               adda.l #$240,a2           ;incr. Address
               adda.l #$440,a0           ;TestAdr
               move.l #$080,D2           ;Decode number
               clr.w d3                  ;Offset to Null
               lea SectNum(pc),a3
               add.w #1,(a3)             ;incr. Sector number
               cmp.w #$0b,(a3)           ;Nummer > 10?
               bcs \DC3                  ;No, OK
               clr.w (a3)                ;Number = 0
\DC3:          bra \DC1

\DCEnd:
               lea BlockAdr(pc),a3
               move.w d3,(a3)
               lea DecodeAdr(pc),a3
               move.l a2,(a3)
               lea FTestAdr(pc),a3
               move.l a0,(a3)
               lea DecodeNum(pc),a3
               move.w D2,(a3)

               movem.l (a7)+,d2-d4/a2-a3
               RTS

;decode last block

lastoneblock:  
               movem.l d2-d3/a2,-(a7)

               move.w SectNum(pc),d0
               mulu #$200,d0
               move.l a4,a1              ;Basic addres for dest. data
               add.l d0,a1               ;Address of the blocks
               clr.l d3
               move.l DecodeAdr(pc),a2
               move.w DecodeNum(pc),d2
\LB1:          move.l (a2),D0
               move.l $200(a2),D1
               adda.l #4,a2
               andi.l #$55555555,d0
               andi.l #$55555555,d1
               lsl.l #1,D0
               or.l D1,D0
               move.l d0,(a1,d3)
               addq.w #$4,d3
               subq.w #1,D2               ;Decode number
               bne \LB1
               movem.l (a7)+,d2-d3/a2
               
               RTS

;test Block for Errors
;A1 = Pointer to BlockStart

BlockCheck:
               movem.l d2-d3/a2,-(a7)
               clr.l d3
               move.w SectNum(pc),d3
               lsl.w #1,d3               ;Sector number => Offset
               lea BlockReport1(pc),a0
               move.w (a0,d3),d0         ;get entry
               tst.w d0                  ;already tested?
               bne \CBEnd2               ;Yes, end

               lea 64(a1),a0
               move.w #$400,d1
               bsr CheckSum              ;Sum for Data block
               move.l d0,d2              ;save sum
               lea 56(a1),a0             ;Pointer to Data sum
               bsr Header                ;Sum decoder
               cmp.l d0,d2
               bne \DataIsFalse

               lea 8(a1),a0
               bsr Header                ;Header decode
               move.w d0,d2              ;store lowere word
               lsr.w #8,d2               ;Sector number to d2
               cmp.b SectNum+1(pc),d2        ;rright Sector
               bne \FalseoneSector
               swap d0                   ;Track number to D0
               cmp.b 77(a3),d0           ;right Track?
               bne \FalseoneTrack
               andi.l #$ff00,d0
               cmp.w #$ff00,d0
               bne \KeinDosTrack
               lea 8(a1),a0
               moveq #$28,d1             ;long wor dnumber
               bsr CheckSum              ;Sum for Header
               move.l d0,d2              ;save sum
               lea 48(a1),a0             ;*Sum
               bsr Header                ;get sum from Header
               cmp.l d0,d2               ;compare sum
               bne \Header1False
               move.w #$ffff,d0
\CBEnd1:       lea BlockReport1(pc),a0
               move.w d0,(a0,d3)
               btst #0,-1(a1)
               beq \CB1
               move.l #$2aaaaaaa,(a1)
               bra \CB2
\CB1:          move.l #$aaaaaaaa,(a1)
\CB2:          move.l #$44894489,4(a1)
               move.w #$ff00,d0          ;create new Header
               move.b 77(a3),d0
               swap d0
               move.b SectNum+1(pc),d0
               lsl.w #8,d0
               move.b SectBL+1(pc),d0
               lea 8(a1),a0
               bsr CodeLWort             ;store Header
               lea 8(a1),a0
               moveq #$28,d1             ;long word number
               bsr CheckSum              ;Sum for Header
               lea 48(a1),a0             ;*Sum
               bsr CodeLWort             ;Checksum stored
               lea SectBL(pc),a2
               subq.w #1,(a2)
\CBEnd2:       movem.l (a7)+,d2-d3/a2
               rts

\FalseoneSector: move.w #$0017,d0
                 bra \Flagsetone
\FalseoneTrack: move.w #$0017,d0
                 bra \Flagsetone
\KeinDosTrack:  move.w #$0017,d0
                 bra \Flagsetone
\Header1False:  move.w #$001b,d0
                 bra \Flagsetone
\DataIsFalse:   move.w #$0019,d0
\Flagsetone:    lea ErrorFlag(pc),a2
                move.w d0,(a2)
                bra \CBEnd1

;Data bock coded
;>= D0 = Length of source
;>= A0 = Pointer to Source
;>= A1 = Pointer to Dest.

CopyBlock:
               move.l a2,-(a7)
               move.l a0,a2
               LSL.W #2,D0
               ORI.W #8,D0
               lea $dff000,a0
               bsr BlitWait
               bsr BlitterCode
               move.l (a7)+,a2
               RTS

;A0 = $dff000
;D0 = Length of source
;D1 = Source
;A5 = Dest

BlitterCode:
               bsr Modulu                ;set Modulu
               MOVE.L a2,$50(A0)         ;Source
               MOVE.L a1,$54(A0)         ;Dest
               MOVE.W #$09F0,$40(A0)
               MOVE.W #0,$42(A0)
               bsr StartBlit
               rts

;Blit start and wait for end of Blitter

StartBlit:
               MOVE.W d0,$dff058
BlitWait:      btst #14,$dff002
               bne.s BlitWait
               rts

;Modulu for coding set
;>= A0 = $dff000
Modulu:
               movem.l d0/a1,-(a7)
               MOVEQ #0,D0
               LEA $44(A0),A1
               MOVE.L #-1,(A1)
               LEA $62(A0),A1
               MOVE.L D0,(A1)+
               MOVE.W D0,(A1)+
               movem.l (a7)+,d0/a1
               rts



BytesBefGap:   dc.w 0
BytesAftGap:   dc.w 0
ErrorFlag:     dc.w 0
DecodeNum:     dc.w 0
DecodeAdr:     dc.l 0
FTestAdr:      dc.l 0
BlockAdr:      dc.w 0
SectNum:       dc.w 0
FirstBlock:    dc.w 0
SectBL:        dc.w 0
TrackMemory1:dc.l 0
TrackMemory2:dc.l 0
TrackMemory3:dc.l 0
TrackMemory4:dc.l 0

BlockReport1:  ds.w 11

TrackName:     dc.b 'trackdisk.device',0,0
Ende:
               END