; support for 13037/7906 drive
; (modified from 7900.ipl) 6/7/05 6/15/05
; corrected comment 10/2/07
; 3/5/21 - changed STC 6 --> STC 6,C (102706 to 103706)
; the old code worked with older hp2100 sim, but failed with newer versions
;
"Setting 13037 slot to 16" $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
"7906/13037 drive " $PRINT
DRV GET DUP 7 AND PNUM
CASE > 7 "fixed " DEFAULT "removeable " ENDCASE $PRINT
END
;
DEFINE CHPL ;change platter
;0 CHPL for removeable, 1 CHPL for fixed
#1 AND 10 MUL DRV GET 7 AND OR DRV SWAP PUT
?DRV   ;display current drive and platter
END
;---------
"Loading !7906" $PRINT CRLF
CREATE !7906
 JMP PDSLT
* slot assignment... (for code generation)
DC     EQU 16                  configured for 13037 in slot 16
*                              note.. change CW1 too
* raw stats if anyone wants
STW1   OCT 0
STW2   OCT 0
* zero page vectors....
CMDVE  EQU 240                 command, >IDE code (NOT USED)
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-17 (0-7 removeable 10-17 fixed)
* patch slots...
DRSLA  EQU 273                 where slot number is stored
PDSLT  LDA DCPL
       LDB DRSLA
       JSB PSUBA,I
* set vectors to 7906 subs...
       LDA ASTA                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
       JMP END                 back to hpiplos with vectors set
* patch list...
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 DCP17
       DEF DCP18
       DEF DCP19
       DEF CW1R
       DEF CW1W
       DEF DLP01
       DEF DLP02
       DEF DLP03
       DEF DLP04
       DEF DLP05
       DEF DLP06
       DEF DLP07
       DEF DLP08
       DEF DLP09
       DEF DLP10
       DEF DLP11
       DEF DLP12
       DEF DLP13
       DEF DLP14
       DEF DLP15
       OCT 0
* set drive/platter subroutine, fixes HDSEC
SETDP  NOP
       LDA DRVNM               get logical drive number
       AND DNC7                isolate bits 0,1,3
       STA DRIVE               save for drive number
       LDA DRVNM               get logical drive number
       AND DNC8                isolate bit 3
       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
DNC8   OCT 10
DNC7   OCT 7
DNCB9  OCT 1000
DRIVE  OCT 0
PLATT  OCT 0
* status sub...
ASTA   DEF *+1
STA    NOP
       JSB SETDP
       JSB CLRDR
       LDA STCMD
       IOR DRIVE
DCP1   OTA DC
DCP2   SFS DC
       JMP *-1
DCP3   LIB DC,C
DCP4   SFS DC
       JMP *-1
DCP5   LIA DC,C
       STB STW1                save stat word 1
       STA STW2                save stat word 2
       JSB CLRDR
       LDA STW1
       AND B812                return bits 8-12 of stat word 1
       JMP STA,I
B812   OCT 17400
* 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
       JSB CLRDR
       LDA CW1R             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
       STC 6,C              activate DMA
DCP6   OTA DC,C             send read command
DCP7   SFS DC
       JMP *-1              wait until done     
       CLF 6                clear dma
       JSB CLRDR
       ISZ BLADR            increment internal block adr
       JMP R1K,I            exit sub
       HLT 44               halt if inc error
* 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
       JSB CLRDR
       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
       LDA WRCMD            get write command
       IOR DRIVE            or with drive number
       STC 6,C              activate DMA
DCP8   OTA DC,C             send write command
DCP9   SFS DC
       JMP *-1              wait
       CLF 6                clear dma
       JSB CLRDR
       ISZ BLADR            increment block adr
       JMP W1K,I            exit subroutine
       HLT 44               halt if inc error
* seek sub.. converts block address into cyl/head/sect
* and performs seek operation
LSEEK  NOP
* each cylinder contains 96 sectors, 48 on the top
* and 48 on the bottom. Head is indicated by bit 8
* of HDSEC, bits 0-5 are sector, 0-47. Each 1K logical
* sector = 8 real sectors. Formulas...
* Cylinder = int(BlockAddress / 12)
* HeadSector = (BlockAddress MOD 12) * 8
* If HeadSector >= 48 Then
*   HeadSector = HeadSector - 48
*   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 C12
       STA CYLNO            cyl=block / 12
       LDA 1                get remainder
       MPY
       DEF C8
       STA HDSEC            hdsec = block mod 12 * 8
       ADA CM48             A = hdsec - 48
       SSA                  skip if sign clear (hdsec>=48)
       JMP FIXHS            ready to seek
       IOR CB8              set bit 8
       STA HDSEC            hdsec = hdsec - 48 with bit 8 set
FIXHS  JSB SETDP            set drive and platt, fix hdsec
       LDA SKCMD            get seek command
       IOR DRIVE            or with drive number
       JSB CLRDR
DCP10  OTA DC               send seek command
DCP11  SFS DC
       JMP *-1
       LDA CYLNO
DCP12  STF DC
DCP13  OTA DC               send cylinder number
DCP14  SFS DC
       JMP *-1
       LDA HDSEC
DCP15  STF DC
DCP16  OTA DC               send head/sector
DCP17  SFS DC
       JMP *-1
       JSB CLRDR
       JMP LSEEK,I
C12    DEC 12
C8     DEC 8
CM48   DEC -48
C377   OCT 377
C1774  OCT 177400
CB15   OCT 100000
CB8    OCT 000400
BLADR  OCT 0                   block address (logical 1K sector)
HDSEC  OCT 0                   formatted head/sector
CYLNO  OCT 0                   cylinder number
STCMD  OCT 001400              status command (03)
WRCMD  OCT 004000              write command  (10)
RDCMD  OCT 002400              read command   (05)
SKCMD  OCT 001200              seek command   (02 plus bit 7)
CW1R   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
* clear drive interface flags
CLRDR  NOP
DCP18  CLC DC
DCP19  CLF DC
       JMP CLRDR,I
* seek, sets BLADR to BLKAL (loc 250)
ASEEK  DEF *+1
SEEKC  NOP
       LDA BLKAL
       STA BLADR
       JMP SEEKC,I
* boot (as in load/run bin system), 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 077635
      OCT 060246
      OCT 073633
      OCT 060250
      OCT 013617
      OCT 073634
      OCT 060250
      OCT 013620
      OCT 006400
      OCT 002002
      OCT 067625
      OCT 077635
      OCT 017551
DLP01 OCT 106716
DLP02 OCT 103116
      OCT 063613
      OCT 102606
      OCT 106702
      OCT 063630
      OCT 102602
      OCT 102702
      OCT 063614
      OCT 102602
      OCT 063615
      OCT 033634
      OCT 103706              fix STC 6,C 3/5/21
DLP03 OCT 103616
DLP04 OCT 102316
      OCT 027532
      OCT 037627
      OCT 027541
      OCT 103106
      OCT 127540
      OCT 000002
      OCT 017543
      OCT 027513
      OCT 000000
      OCT 063630
      OCT 043626
      OCT 073630
      OCT 037633
      OCT 127543
      OCT 000000
      OCT 063633
      OCT 006400
      OCT 100400
      OCT 077622
      OCT 073631
      OCT 060001
      OCT 100200
      OCT 077620
      OCT 073632
      OCT 043623
      OCT 002020
      OCT 027570
      OCT 033624
      OCT 073632
      OCT 063616
      OCT 033634
DLP05 OCT 106716
DLP06 OCT 103116
DLP07 OCT 102616
DLP08 OCT 102316
      OCT 027575
      OCT 063631
DLP09 OCT 102116
DLP10 OCT 102616
DLP11 OCT 102316
      OCT 027602
      OCT 063632
      OCT 033635
DLP12 OCT 102116
DLP13 OCT 102616
DLP14 OCT 102316
      OCT 027610
      OCT 127551
DLP15 OCT 120016
      OCT 176000
      OCT 002400
      OCT 001200
      OCT 000007
      OCT 000010
      OCT 000003
      OCT 000014
      OCT 177720
      OCT 000400
      OCT 001000
      OCT 002000
      OCT 177741
      OCT 100002
      OCT 000000
      OCT 000000
      OCT 000000
      OCT 000000
      OCT 000000
*
BOOTE  DEF *-1
DEST   OCT 77500
FROM   OCT 0
TO     OCT 0
END
;--- end of 13037/7906 driver code
"Done" $PRINT CONSOLE