; support for 13210A/7900 drive
; 1/10/04 5/4/04 5/11/04 9/1/04
; 9/4/06 mod to fix patching
; 10/5/07 simplified ?DRV, requires $DSTR from double.ipl
;
; contains 7900-specific versions of what's in the IDE word.
;
"Setting slots to 16/17" $PRINT CRLF
OCTAL 273 16 PUT
;extras...
;note! this driver IPL must be loaded AFTER disk.ipl
;easier to swap drivers this way anyway
"Loading ?DRV and CHPL" $PRINT CRLF
DEFINE ?DRV         ;drive info
"7900/13210 drive " $PRINT
DRV GET DUP 3 AND #0 SWAP $DSTR $PRINT
CASE > 3 " fixed " DEFAULT " removeable " ENDCASE $PRINT
END
;
DEFINE CHPL ;change platter
;0 CHPL for removeable, 1 CHPL for fixed
1 AND 4 MUL DRV GET 3 AND OR DRV SWAP PUT
?DRV   ;display current drive and platter
END
;---------
"Loading !7900" $PRINT CRLF
CREATE !7900
* slot assignment... (for code generation)
DC     EQU 16                  configured for 13210A in slots 16/17
CC     EQU 17                  note.. change CW1 too
* zero page vectors....
CMDVE  EQU 240                 command, >IDE code
STAVE  EQU 241                 status, <IDE code
W1KVE  EQU 242                 W-1K code
R1KVE  EQU 243                 R-1K code
SEEKV  EQU 244                 seek vector, sets seek adr to 246,247
BOOTV  EQU 245                 boot vector, seek or manually set first
BLKAL  EQU 246                 block address low
BLKAH  EQU 247                 block address high
DRVNM  EQU 250                 drive number 0-7 (0-3 removeable 4-7 fixed)
* patch slots...
DRSLA  EQU 273                 where slot number is stored
       LDA DCPL
       LDB DRSLA
       JSB PSUBA,I
       LDA CCPL
       LDB DRSLA
       INB
       JSB PSUBA,I
* set vectors to 7900 subs...
       LDA ACMD                get address of command code
       STA CMDVE               save in command vector
       LDA ASTA                same for status
       STA STAVE
       LDA AW1K                write 1K
       STA W1KVE
       LDA AR1K                read 1K
       STA R1KVE
       LDA ASEEK               seek
       STA SEEKV
       LDA ABOOT               boot
       STA BOOTV
* more inconvenient than worth, leave drive number alone
* however 250 must contain valid drive# or will hang on init
*      CLA
*      STA DRVNM
       LDA RSD                 get reset drive command
       JSB CMD                 call command sub
* sets block address to 0, calls status and discards results       
       JMP END                 back to hpiplos with vectors set
* patch lists...
DCPL   DEF *+1
       DEF DCP1
       DEF DCP2
       DEF DCP3
       DEF DCP4
       DEF DCP5
       DEF DCP6
       DEF DCP7
       DEF DCP8
       DEF DCP9
       DEF DCP10
       DEF DCP11
       DEF DCP12
       DEF DCP13
       DEF DCP14
       DEF DCP15
       DEF DCP16
       DEF CW1
       DEF CW1W
       DEF DCP19
       DEF DCP20
       DEF DCP21
       DEF DCP22
       DEF DCP23
       DEF DCP24
       DEF DCP25
       DEF DCP26
       DEF DCP27
       DEF DCP28
       OCT 0
CCPL   DEF *+1
       DEF CCP1
       DEF CCP2
       DEF CCP3
       DEF CCP4
       DEF CCP5
       DEF CCP6
       DEF CCP7
       DEF CCP8
       DEF CCP9
       DEF CCP10
       DEF CCP11
       DEF CCP12
       DEF CCP13
       DEF CCP14
       DEF CCP15
       DEF CCP16
       DEF CCP17
       DEF CCP18
       DEF CCP19
       DEF CCP20
       DEF CCP21
       DEF CCP22
       DEF CCP23
       DEF CCP24
       DEF CCP25
       OCT 0
* Perform command in A...
ACMD   DEF *+1
CMD    NOP
       STA 1                   save raw command
       AND C377                isolate low 8 bits
       STA PARM                store in parm var
       LDA 1                   get raw command
       AND C1774               isolate top 8 bits, command
       CPA SB1                 101xxx command - set low-8 blockadr
       JMP SB1C
       CPA SB2                 102xxx command - set next-8 blockadr
       JMP SB2C
       CPA RSD                 100xxx command - reset drive
       JMP RSDC
       JMP CMD,I               command not recognized, do nothing
* set block 1 lsb
SB1C   LDA BLADR               get block address
       AND C1774               zero low byte
       IOR PARM                combine with specified low-address
       STA BLADR               store back
       JMP CMD,I               return from sub
* set block 2 nsb
SB2C   LDA BLADR               get block address
       AND C377                zero high byte
       LDB PARM                get parm in B
       BLF,BLF                 move to high byte of B
       IOR 1                   combine
       STA BLADR               store back
       JMP CMD,I               return from sub
* reset drive command
RSDC   CLA
       STA BLADR               clear block address
       JSB STA                 call status sub to clear status
       JMP CMD,I
* end of CMD subroutine
* set drive/platter subroutine, fixes HDSEC
SETDP  NOP
       LDA DRVNM               get logical drive number
       AND DNC3                isolate bits 0,1
       STA DRIVE               save for drive number
       LDA DRVNM               get logical drive number
       AND DNC4                isolate bit 2
       SZA,RSS                 skip if not 0 (skip if fixed)
       JMP SETDP,I             exit sub if removeable
       LDA HDSEC
       IOR DNCB9
       STA HDSEC               set bit 9 of HDSEC if fixed
       JMP SETDP,I
DNC4   OCT 4
DNC3   OCT 3
DNCB9  OCT 1000
DRIVE  OCT 0
PLATT  OCT 0
* status sub...
ASTA   DEF *+1
STA    NOP
       JSB SETDP
DCP1   CLC DC
CCP1   CLC CC
       LDA STCMD
       IOR DRIVE
CCP2   OTA CC
CCP3   STC CC,C
DCP2   SFS DC
       JMP *-1
DCP3   LIA DC
       JMP STA,I
* read 1KW into memory, address in A
AR1K   DEF *+1
R1K    NOP
       IOR CB15             set bit 15
       STA CW2              store read address in CW2
       JSB LSEEK            seek to block address
DCP4   CLC DC               clear control on data
CCP4   CLC CC                and command channels
       LDA CW1              get dma control word 1
       OTA 6                send to dma channel
       CLC 2                prepare for cw2
       LDA CW2              get cw2, address
       OTA 2                send to dma channel
       STC 2                prepare for cw3
       LDA CW3              get cw3, -length
       OTA 2                send to dma channel
       LDA RDCMD            get read command
       IOR DRIVE
CCP5   OTA CC               send to disk command channel
DCP5   STC DC,C             prepare data channel for read
       STC 6,C              activate dma
CCP6   STC CC,C             activate read
CCP7   SFS CC               done?
       JMP *-1              no, wait
       CLF 6                clear dma flag
CCP8   CLC CC               clear command, data controls
DCP6   CLC DC
       ISZ BLADR            increment block address to match IDE firmware
       NOP
       JMP R1K,I            exit sub
* write 1KW to disk, address in A
AW1K   DEF *+1
W1K    NOP
       STA CW2              save address in CW2
       JSB LSEEK            seek to logical block address
DCP7   CLC DC               clear control data channel
CCP9   CLC CC               clear control command channel
       LDA CW1W             get dma cw1 for writes
       OTA 6                output to dma chan
       CLC 2                prepare for cw2
       LDA CW2              get cw2, start address
       OTA 2                output to dma
       STC 2                prepare for cw3
       LDA CW3              get cw3, -length
       OTA 2                output to dma
DCP8   STC DC
DCP9   STF DC               enable dma to data channel transfer
       STC 6,C              activate dma
       LDA WRCMD            get write command
       IOR DRIVE
CCP10  OTA CC               output to command channel
CCP11  STC CC,C             initiate write
CCP12  SFS CC               complete?
       JMP *-1              no, wait
       CLF 6                clear dma flag
CCP13  CLC CC               clear command, data controls
DCP10  CLC DC
       ISZ BLADR            increment block address to match IDE firmware
       NOP
       JMP W1K,I            exit subroutine
* seek sub.. converts block address into cyl/head/sect
* and performs seek operation
LSEEK  NOP
* each cylinder contains 48 sectors, 24 on the top
* and 24 on the bottom. Head is indicated by bit 8
* of HDSEC, bits 0-4 are sector, 0-23. Each 1K logical
* sector = 8 real sectors. Formulas...
* Cylinder = int(BlockAddress / 6)
* HeadSector = (BlockAddress MOD 6) * 8
* If HeadSector >= 24 Then
*   HeadSector = HeadSector - 24
*   Set bit 8 to indicate head 1
* Drive number OR'd with each command,
* set bit 9 of HDSEC to indicate fixed platter
       LDA BLADR
       CLB
       DIV
       DEF C6
       STA CYLNO            cyl=block / 6
       LDA 1                get remainder
       MPY
       DEF C8
       STA HDSEC            hdsec = block mod 6 * 8
       ADA CM24             A = hdsec - 24
       SSA                  skip if sign clear (hdsec>=24)
       JMP FIXHS            ready to seek
       IOR CB8              set bit 8
       STA HDSEC            hdsec = hdsec - 24 with bit 8 set
FIXHS  JSB SETDP            set drive and platt, fix hdsec
DCP11  CLC DC
CCP14  CLC CC
       LDA CYLNO            get cylinder
DCP12  OTA DC  
DCP13  STC DC,C             output to data channel
       LDA SKCMD            get seek command
       IOR DRIVE
CCP15  OTA CC               output to command channel
CCP16  STC CC,C             initiate seek
DCP14  SFS DC               first address word accepted?
       JMP *-1              no, wait
       LDA HDSEC            get head/sector
DCP15  OTA DC
DCP16  STC DC,C             output to data channel
CCP17  SFS CC               seek complete?
       JMP *-1              no, wait
*       JSB STA              call status sub
*       SLA                  skip if any-error clear
*       JMP SERR             hard error if seek error
* check for errors manually if needed.. the sim wants to
* return status 13 (or 40001) sometimes when nothing seems to be wrong
       JMP LSEEK,I          exit subroutine
*
*SERR   HLT 55               halt on seek error
ERR    HLT 33               halt on other error
C6     OCT 6
C8     DEC 8
CM24   DEC -24
C377   OCT 377
C1774  OCT 177400
CB15   OCT 100000
CB8    OCT 000400
SB1    OCT 101000              sets low 8 bits of block address
SB2    OCT 102000              sets next 8 bits of block address
RSD    OCT 100000              reset drive, zeros block address
* SB3 and SB4 not needed.. only 1218 1KW block sectors available..
PARM   OCT 0                   command parm here
BLADR  OCT 0                   block address (logical 1K sector)
HDSEC  OCT 0                   formatted head/sector
CYLNO  OCT 0                   cylinder number
STCMD  OCT 000000              status command
WRCMD  OCT 010000              write command
RDCMD  OCT 020000              read command
SKCMD  OCT 030000              seek command
CW1    OCT 120016              dma cw1 for read, note slot 16
CW1W   OCT 100016              dma cw1 for write, note slot 16
CW2    OCT 0                   set to dma adr
CW3    OCT -2000               dma -len for 1KW
* seek, sets BLADR to BLKAL (loc 250), equivalent to 101xxx >IDE etc
ASEEK  DEF *+1
SEEKC  NOP
       LDA BLKAL
       STA BLADR
       JMP SEEKC,I
* boot, seek first
ABOOT  DEF *+1
BOOT   NOP
       LDA BLADR
       STA BLKAL              tell the boot code where to boot from
       LDA BOOTC
       STA FROM
       LDA DEST
       STA TO
BOOTL  LDA FROM,I
       STA TO,I
       ISZ TO
       LDA FROM
       CPA BOOTE
       JMP DEST,I
       INA
       STA FROM
       JMP BOOTL
BOOTC  DEF *+1
* from 077500 to 077641 (last 5 loc's omitted)
       OCT 060246
       OCT 073637
       OCT 060250
       OCT 013621
       OCT 073640
       OCT 060250
       OCT 013622
       OCT 006400
       OCT 002002
       OCT 067623
       OCT 077641
       OCT 017553
DCP19  OCT 106716
CCP18  OCT 106717
       OCT 063615
       OCT 102606
       OCT 106702
       OCT 063634
       OCT 102602
       OCT 102702
       OCT 063616
       OCT 102602
       OCT 063617
       OCT 033640
CCP19  OCT 102617
DCP20  OCT 103716
       OCT 103706
CCP20  OCT 103717
CCP21  OCT 102317
       OCT 027534
       OCT 037633
       OCT 027543
       OCT 103106
       OCT 127542
       OCT 000002
       OCT 017545
       OCT 027513
       OCT 000000
       OCT 063634
       OCT 043632
       OCT 073634
       OCT 037637
       OCT 127545
       OCT 000000
       OCT 063637
       OCT 006400
       OCT 100400
       OCT 077625
       OCT 073635
       OCT 060001
       OCT 100200
       OCT 077626
       OCT 073636
       OCT 043627
       OCT 002020
       OCT 027572
       OCT 033630
       OCT 073636
DCP21  OCT 106716
CCP22  OCT 106717
       OCT 063635
DCP22  OCT 102616
DCP23  OCT 103716
       OCT 063620
       OCT 033640
DCP24  OCT 103716
CCP23  OCT 102617
CCP24  OCT 103717
DCP25  OCT 102316
       OCT 027604
       OCT 063636
       OCT 033641
DCP26  OCT 102616
DCP27  OCT 103716
CCP25  OCT 102317
       OCT 027612
       OCT 127553
DCP28  OCT 120016
       OCT 176000
       OCT 020000
       OCT 030000
       OCT 000003
       OCT 000004
       OCT 001000
       OCT 000003
       OCT 000006
       OCT 000010
       OCT 177750
       OCT 000400
       OCT 001000
       OCT 002000
       OCT 177741
       OCT 100002
BOOTE  DEF *-1
DEST   OCT 77500
FROM   OCT 0
TO     OCT 0
END
;--- end of 13210A/7900 driver code
"Done" $PRINT CONSOLE