Page 8 of 10

Re: IDE interface for Altair 8800c

PostPosted: February 19th, 2023, 4:30 pm
by AltairClone
...and if ckFlsh runs, then shouldn’t it have deselected the drive - even if a flush wasn’t required?

Mike

Re: IDE interface for Altair 8800c

PostPosted: February 20th, 2023, 6:23 pm
by Wayne Parham
Absolutely. But the problem for me now is that - where I have the call - it happens only after a person presses a key. It isn't in the same position in the flow as yours is, and so I need to change that. In my code - since the 'conin' and 'in$scan' functions are in the BIOSKRNL.asm module, I didn't want to modify it to put the 'ckFlush' function immediately after entry from the BIOS jump table. That's really where we want to put 'ckFlush' but to do that means we modify the invariant BIOSKRNL module. That would certainly be the easiest thing to do, and I may ultimately do that. But for now, I'm going to look for another solution that leaves BIOSKRNL unmodified, if I can. I'll work on it some more next week.

In the meantime, I'm just stoked that it works!

Re: IDE interface for Altair 8800c

PostPosted: February 20th, 2023, 9:37 pm
by Wayne Parham
...I moved the ckFlush call out of CI and into CIST, both in CHARIO3.asm. That solved it! So that allows me to leave BIOSKRNL.asm as the unmodified Digital Research file.

Still piddling with a few things, mostly testing, but very nearly done. I do want to live with it for a while before calling it boxed up and ready to go.

Re: IDE interface for Altair 8800c

PostPosted: February 22nd, 2023, 11:17 pm
by Wayne Parham
I've tested the system for a few evenings now and I'm pretty comfortable with it.

- The IDE sector count is right, in that each track starts on sector 00 and ends on sector 3F. Watched it with the SID debugger and confirmed it with IDEutil.

- The diskette flushing mechanism works as designed, running ckFlush in the CIST function.

So I'm creating a disk image and will post a link for that soon. Still kind of messing around with GENCPM to find the best compromise between data/directory buffers and available TPA. But in the meantime, here are the source modules:

BIOSKRN3.asm:
Code: Select all
   title   'ROOT BIOS MODULE FOR CP/M 3.0'

   ; version 1.0 15 Sept 82

true   equ -1
false   equ not true

banked   equ FALSE            ;<------ BANKED Version
   

;        Copyright (C), 1982
;       Digital Research, Inc
;           P.O. Box 579
;      Pacific Grove, CA  93950


;   This is the invariant portion of the modular BIOS and is
;   distributed as source for informational purposes only.
;   All desired modifications should be performed by
;   adding or changing externally defined modules.
;   This allows producing "standard" I/O modules that
;   can be combined to support a particular system
;   configuration.

cr   equ 13
lf   equ 10
bell   equ 7
ctlQ   equ 'Q'-'@'
ctlS   equ 'S'-'@'

ccp   equ 0100h   ; Console Command Processor gets loaded into the TPA

   cseg      ; GENCPM puts CSEG stuff in common memory


    ; variables in system data page

   extrn @covec,@civec,@aovec,@aivec,@lovec ; I/O redirection vectors
   extrn @mxtpa            ; addr of system entry point
   extrn @bnkbf            ; 128 byte scratch buffer

    ; initialization

   extrn ?init         ; general initialization and signon
   extrn ?ldccp,?rlccp      ; load & reload CCP for BOOT & WBOOT

    ; user defined character I/O routines

   extrn ?ci,?co,?cist,?cost   ; each take device in <B>
   extrn ?cinit         ; (re)initialize device in <C>
   extrn @ctbl         ; physical character device table

    ; disk communication data items

   extrn @dtbl         ; table of pointers to XDPHs
   public @adrv,@rdrv,@trk,@sect   ; parameters for disk I/O
   public @dma,@dbnk,@cnt      ;    ''       ''   ''  ''

    ; memory control

   public @cbnk         ; current bank
   extrn ?xmove,?move      ; select move bank, and block move
   extrn ?bank         ; select CPU bank

    ; clock support

   extrn ?time         ; signal time operation

    ; general utility routines

   public ?pmsg,?pdec   ; print message, print number from 0 to 65535
   public ?pderr      ; print BIOS disk error message header

   maclib modebaud      ; define mode bits


    ; External names for BIOS entry points

   public ?boot,?wboot,?const,?conin,?cono,?list,?auxo,?auxi
   public ?home,?sldsk,?sttrk,?stsec,?stdma,?read,?write
   public ?lists,?sctrn
   public ?conos,?auxis,?auxos,?dvtbl,?devin,?drtbl
   public ?mltio,?flush,?mov,?tim,?bnksl,?stbnk,?xmov


    ; BIOS Jump vector.

      ; All BIOS routines are invoked by calling these
      ;   entry points.

?boot:   jmp boot   ; initial entry on cold start
?wboot:   jmp wboot   ; reentry on program exit, warm start

?const:   jmp const   ; return console input status
?conin:   jmp conin   ; return console input character
?cono:   jmp conout   ; send console output character
?list:   jmp list   ; send list output character
?auxo:   jmp auxout   ; send auxilliary output character
?auxi:   jmp auxin   ; return auxilliary input character

?home:   jmp home   ; set disks to logical home
?sldsk:   jmp seldsk   ; select disk drive, return disk parameter info
?sttrk:   jmp settrk   ; set disk track
?stsec:   jmp setsec   ; set disk sector
?stdma:   jmp setdma   ; set disk I/O memory address
?read:   jmp read   ; read physical block(s)
?write:   jmp write   ; write physical block(s)

?lists:   jmp listst   ; return list device status
?sctrn:   jmp sectrn   ; translate logical to physical sector

?conos:   jmp conost   ; return console output status
?auxis:   jmp auxist   ; return aux input status
?auxos:   jmp auxost   ; return aux output status
?dvtbl:   jmp devtbl   ; return address of device def table
?devin:   jmp ?cinit   ; change baud rate of device

?drtbl:   jmp getdrv   ; return address of disk drive table
?mltio:   jmp multio   ; set multiple record count for disk I/O
?flush:   jmp flush   ; flush BIOS maintained disk caching

?mov:   jmp ?move   ; block move memory to memory
?tim:   jmp ?time   ; Signal Time and Date operation
?bnksl:   jmp bnksel   ; select bank for code execution and default DMA
?stbnk:   jmp setbnk   ; select different bank for disk I/O DMA operations.
?xmov:   jmp ?xmove   ; set source and destination banks for one operation

   jmp 0      ; reserved for future expansion
   jmp 0      ; reserved for future expansion
   jmp 0      ; reserved for future expansion


   ; BOOT
   ;   Initial entry point for system startup.

   dseg   ; this part can be banked

boot:
   lxi sp,boot$stack
   mvi c,15   ; initialize all 16 character devices
c$init$loop:
   push b ! call ?cinit ! pop b
   dcr c ! jp c$init$loop

   call ?init   ; perform any additional system initialization
         ; and print signon message

   lxi b,16*256+0 ! lxi h,@dtbl   ; init all 16 logical disk drives
d$init$loop:
   push b      ; save remaining count and abs drive
   mov e,m ! inx h ! mov d,m ! inx h   ; grab @drv entry
   mov a,e ! ora d ! jz d$init$next   ; if null, no drive
   push h               ; save @drv pointer
   xchg               ; XDPH address in <HL>
   dcx h ! dcx h ! mov a,m ! sta @RDRV   ; get relative drive code
   mov a,c ! sta @ADRV         ; get absolute drive code
   dcx h               ; point to init pointer
   mov d,m ! dcx h ! mov e,m      ; get init pointer
   xchg ! call ipchl         ; call init routine
   pop h               ; recover @drv pointer
d$init$next:
   pop b               ; recover counter and drive #
   inr c ! dcr b ! jnz d$init$loop      ; and loop for each drive
   jmp boot$1

   cseg   ; following in resident memory

boot$1:
   call set$jumps
   call ?ldccp            ; fetch CCP for first time
   jmp ccp


   ; WBOOT
   ;   Entry for system restarts.

wboot:
   lxi sp,boot$stack
   call set$jumps      ; initialize page zero
   call ?rlccp      ; reload CCP
   jmp ccp         ; then reset jmp vectors and exit to ccp


set$jumps:

  if banked
   mvi a,1 ! call ?bnksl
  endif

   mvi a,JMP
   sta 0 ! sta 5      ; set up jumps in page zero
   lxi h,?wboot ! shld 1   ; BIOS warm start entry
   lhld @MXTPA ! shld 6   ; BDOS system call entry
   ret


      ds 64
boot$stack   equ $


   ; DEVTBL
   ;   Return address of character device table

devtbl:
   lxi h,@ctbl ! ret


   ; GETDRV
   ;   Return address of drive table

getdrv:
   lxi h,@dtbl ! ret



   ; CONOUT
   ;   Console Output.  Send character in <C>
   ;         to all selected devices

conout:   

   lhld @covec   ; fetch console output bit vector
   jmp out$scan


   ; AUXOUT
   ;   Auxiliary Output. Send character in <C>
   ;         to all selected devices

auxout:
   lhld @aovec   ; fetch aux output bit vector
   jmp out$scan


   ; LIST
   ;   List Output.  Send character in <C>
   ;         to all selected devices.

list:
   lhld @lovec   ; fetch list output bit vector

out$scan:
   mvi b,0      ; start with device 0
co$next:
   dad h      ; shift out next bit
   jnc not$out$device
   push h      ; save the vector
   push b      ; save the count and character
not$out$ready:
   call coster ! ora a ! jz not$out$ready
   pop b ! push b   ; restore and resave the character and device
   call ?co   ; if device selected, print it
   pop b      ; recover count and character
   pop h      ; recover the rest of the vector
not$out$device:
   inr b      ; next device number
   mov a,h ! ora l   ; see if any devices left
   jnz co$next   ; and go find them...
   ret


   ; CONOST
   ;   Console Output Status.  Return true if
   ;      all selected console output devices
   ;      are ready.

conost:
   lhld @covec   ; get console output bit vector
   jmp ost$scan


   ; AUXOST
   ;   Auxiliary Output Status.  Return true if
   ;      all selected auxiliary output devices
   ;      are ready.

auxost:
   lhld @aovec   ; get aux output bit vector
   jmp ost$scan


   ; LISTST
   ;   List Output Status.  Return true if
   ;      all selected list output devices
   ;      are ready.

listst:
   lhld @lovec   ; get list output bit vector

ost$scan:
   mvi b,0      ; start with device 0
cos$next:
   dad h      ; check next bit
   push h      ; save the vector
   push b      ; save the count
   mvi a,0FFh   ; assume device ready
   cc coster   ; check status for this device
   pop b      ; recover count
   pop h      ; recover bit vector
   ora a      ; see if device ready
   rz      ; if any not ready, return false
   inr b      ; drop device number
   mov a,h ! ora l   ; see if any more selected devices
   jnz cos$next
   ori 0FFh   ; all selected were ready, return true
   ret

coster:      ; check for output device ready, including optional
      ;   xon/xoff support
   mov l,b ! mvi h,0   ; make device code 16 bits
   push h         ; save it in stack
   dad h ! dad h ! dad h   ; create offset into device characteristics tbl
   lxi d,@ctbl+6 ! dad d   ; make address of mode byte
   mov a,m ! ani mb$xonxoff
   pop h         ; recover console number in <HL>
   jz ?cost      ; not a xon device, go get output status direct
   lxi d,xofflist ! dad d   ; make pointer to proper xon/xoff flag
   call cist1      ; see if this keyboard has character
   mov a,m ! cnz ci1   ; get flag or read key if any
   cpi ctlq ! jnz not$q   ; if its a ctl-Q,
   mvi a,0FFh       ;   set the flag ready
not$q:
   cpi ctls ! jnz not$s   ; if its a ctl-S,
   mvi a,00h      ;   clear the flag
not$s:
   mov m,a         ; save the flag
   call cost1      ; get the actual output status,
   ana m         ; and mask with ctl-Q/ctl-S flag
   ret         ; return this as the status

cist1:         ; get input status with <BC> and <HL> saved
   push b ! push h
   call ?cist
   pop h ! pop b
   ora a
   ret

cost1:         ; get output status, saving <BC> & <HL>
   push b ! push h
   call ?cost
   pop h ! pop b
   ora a
   ret

ci1:         ; get input, saving <BC> & <HL>
   push b ! push h
   call ?ci
   pop h ! pop b
   ret


   ; CONST
   ;   Console Input Status.  Return true if
   ;      any selected console input device
   ;      has an available character.

const:
   lhld @civec   ; get console input bit vector
   jmp ist$scan


   ; AUXIST
   ;   Auxiliary Input Status.  Return true if
   ;      any selected auxiliary input device
   ;      has an available character.

auxist:
   lhld @aivec   ; get aux input bit vector

ist$scan:
   mvi b,0      ; start with device 0
cis$next:
   dad h      ; check next bit
   mvi a,0      ; assume device not ready
   cc cist1   ; check status for this device
   ora a ! rnz   ; if any ready, return true
   inr b      ; drop device number
   mov a,h ! ora l   ; see if any more selected devices
   jnz cis$next
   xra a      ; all selected were not ready, return false
   ret


   ; CONIN
   ;   Console Input.  Return character from first
   ;      ready console input device.

conin:
   lhld @civec
   jmp in$scan


   ; AUXIN
   ;   Auxiliary Input.  Return character from first
   ;      ready auxiliary input device.

auxin:
   lhld @aivec

in$scan:
   push h      ; save bit vector
   mvi b,0
ci$next:
   dad h      ; shift out next bit
   mvi a,0      ; insure zero a  (nonexistant device not ready).
   cc cist1   ; see if the device has a character
   ora a
   jnz ci$rdy   ; this device has a character
   inr b      ; else, next device
   mov a,h ! ora l   ; see if any more devices
   jnz ci$next   ; go look at them
   pop h      ; recover bit vector
   jmp in$scan   ; loop til we find a character

ci$rdy:
   pop h      ; discard extra stack
   jmp ?ci


;   Utility Subroutines


ipchl:      ; vectored CALL point
   pchl


?pmsg:      ; print message @<HL> up to a null
      ; saves <BC> & <DE>
   push b
   push d
pmsg$loop:
   mov a,m ! ora a ! jz pmsg$exit
   mov c,a ! push h
   call ?cono ! pop h
   inx h ! jmp pmsg$loop
pmsg$exit:
   pop d
   pop b
   ret

?pdec:      ; print binary number 0-65535 from <HL>
   lxi b,table10! lxi d,-10000
next:
   mvi a,'0'-1
pdecl:
   push h! inr a! dad d! jnc stoploop
   inx sp! inx sp! jmp pdecl
stoploop:
   push d! push b
   mov c,a! call ?cono
   pop b! pop d
nextdigit:
   pop h
   ldax b! mov e,a! inx b
   ldax b! mov d,a! inx b
   mov a,e! ora d! jnz next
   ret

table10:
   dw   -1000,-100,-10,-1,0

?pderr:
   lxi h,drive$msg ! call ?pmsg         ; error header
   lda @adrv ! adi 'A' ! mov c,a ! call ?cono   ; drive code
   lxi h,track$msg ! call ?pmsg         ; track header
   lhld @trk ! call ?pdec            ; track number
   lxi h,sector$msg ! call ?pmsg         ; sector header
   lhld @sect ! call ?pdec            ; sector number
   ret


   ; BNKSEL
   ;   Bank Select.  Select CPU bank for further execution.

bnksel:
   sta @cbnk          ; remember current bank
   jmp ?bank         ; and go exit through users
               ; physical bank select routine


xofflist   db   -1,-1,-1,-1,-1,-1,-1,-1      ; ctl-s clears to zero
      db   -1,-1,-1,-1,-1,-1,-1,-1



   dseg   ; following resides in banked memory



;   Disk I/O interface routines


   ; SELDSK
   ;   Select Disk Drive.  Drive code in <C>.
   ;      Invoke login procedure for drive
   ;      if this is first select.  Return
   ;      address of disk parameter header
   ;      in <HL>

seldsk:
   mov a,c ! sta @adrv         ; save drive select code
   mov l,c ! mvi h,0 ! dad h      ; create index from drive code
   lxi b,@dtbl ! dad b         ; get pointer to dispatch table
   mov a,m ! inx h ! mov h,m ! mov l,a   ; point at disk descriptor
   ora h ! rz             ; if no entry in table, no disk
   mov a,e ! ani 1 ! jnz not$first$select   ; examine login bit
   push h ! xchg            ; put pointer in stack & <DE>
   lxi h,-2 ! dad d ! mov a,m ! sta @RDRV   ; get relative drive
   lxi h,-6 ! dad d         ; find LOGIN addr
   mov a,m ! inx h ! mov h,m ! mov l,a   ; get address of LOGIN routine
   call ipchl            ; call LOGIN
   pop h               ; recover DPH pointer
not$first$select:
   ret


   ; HOME
   ;   Home selected drive.  Treated as SETTRK(0).

home:
   lxi b,0      ; same as set track zero


   ; SETTRK
   ;   Set Track. Saves track address from <BC>
   ;      in @TRK for further operations.

settrk:
   mov l,c ! mov h,b
   shld @trk
   ret


   ; SETSEC
   ;   Set Sector.  Saves sector number from <BC>
   ;      in @sect for further operations.

setsec:
   mov l,c ! mov h,b
   shld @sect
   ret


   ; SETDMA
   ;   Set Disk Memory Address.  Saves DMA address
   ;      from <BC> in @DMA and sets @DBNK to @CBNK
   ;      so that further disk operations take place
   ;      in current bank.

setdma:
   mov l,c ! mov h,b
   shld @dma

   lda @cbnk   ; default DMA bank is current bank
         ; fall through to set DMA bank

   ; SETBNK
   ;   Set Disk Memory Bank.  Saves bank number
   ;      in @DBNK for future disk data
   ;      transfers.

setbnk:
   sta @dbnk
   ret


   ; SECTRN
   ;   Sector Translate.  Indexes skew table in <DE>
   ;      with sector in <BC>.  Returns physical sector
   ;      in <HL>.  If no skew table (<DE>=0) then
   ;      returns physical=logical.

sectrn:
   mov l,c ! mov h,b
   mov a,d ! ora e ! rz
   xchg ! dad b ! mov l,m ! mvi h,0
   ret


   ; READ
   ;   Read physical record from currently selected drive.
   ;      Finds address of proper read routine from
   ;      extended disk parameter header (XDPH).

read:
   lhld @adrv ! mvi h,0 ! dad h   ; get drive code and double it
   lxi d,@dtbl ! dad d      ; make address of table entry
   mov a,m ! inx h ! mov h,m ! mov l,a   ; fetch table entry
   push h            ; save address of table
   lxi d,-8 ! dad d      ; point to read routine address
   jmp rw$common         ; use common code


   ; WRITE
   ;   Write physical sector from currently selected drive.
   ;      Finds address of proper write routine from
   ;      extended disk parameter header (XDPH).

write:
   lhld @adrv ! mvi h,0 ! dad h   ; get drive code and double it
   lxi d,@dtbl ! dad d      ; make address of table entry
   mov a,m ! inx h ! mov h,m ! mov l,a   ; fetch table entry
   push h            ; save address of table
   lxi d,-10 ! dad d      ; point to write routine address

rw$common:
   mov a,m ! inx h ! mov h,m ! mov l,a   ; get address of routine
   pop d            ; recover address of table
   dcx d ! dcx d         ; point to relative drive
   ldax d ! sta @rdrv      ; get relative drive code and post it
   inx d ! inx d         ; point to DPH again
   pchl            ; leap to driver


   ; MULTIO
   ;   Set multiple sector count. Saves passed count in
   ;      @CNT

multio:
   sta @cnt ! ret


   ; FLUSH
   ;   BIOS deblocking buffer flush.  Not implemented.

flush:
   xra a ! ret      ; return with no error



   ; error message components
drive$msg   db   cr,lf,bell,'BIOS Error on ',0
track$msg   db   ': T-',0
sector$msg   db   ', S-',0


    ; disk communication data items

@adrv   ds   1      ; currently selected disk drive
@rdrv   ds   1      ; controller relative disk drive
@trk   ds   2      ; current track number
@sect   ds   2      ; current sector number
@dma   ds   2      ; current DMA address
@cnt   db   0      ; record count for multisector transfer
@dbnk   db   0      ; bank for DMA operations


   cseg   ; common memory

@cbnk   db   0      ; bank for processor operations


   end


SCB3.asm:
Code: Select all
   TITLE 'SYSTEM CONTROL BLOCK DEFINITION FOR CP/M 3.0'

   PUBLIC @CIVEC, @COVEC, @AIVEC, @AOVEC, @LOVEC, @BNKBF
   PUBLIC @CRDMA, @CRDSK, @VINFO, @RESEL, @FX, @USRCD
        PUBLIC @MLTIO, @ERMDE, @ERDSK, @MEDIA, @BFLGS
   PUBLIC @DATE, @HOUR, @MIN, @SEC, ?ERJMP, @MXTPA


SCB$BASE EQU    0FE00H          ; BASE OF THE SCB

@CIVEC  EQU     SCB$BASE+22H    ; CONSOLE INPUT REDIRECTION
                                ; VECTOR (WORD, R/W)
@COVEC  EQU     SCB$BASE+24H    ; CONSOLE OUTPUT REDIRECTION
                                ; VECTOR (WORD, R/W)
@AIVEC  EQU     SCB$BASE+26H    ; AUXILIARY INPUT REDIRECTION
                                ; VECTOR (WORD, R/W)
@AOVEC  EQU     SCB$BASE+28H    ; AUXILIARY OUTPUT REDIRECTION
                                ; VECTOR (WORD, R/W)
@LOVEC  EQU     SCB$BASE+2AH    ; LIST OUTPUT REDIRECTION
                                ; VECTOR (WORD, R/W)
@BNKBF  EQU     SCB$BASE+35H    ; ADDRESS OF 128 BYTE BUFFER
                                ; FOR BANKED BIOS (WORD, R/O)
@CRDMA  EQU     SCB$BASE+3CH    ; CURRENT DMA ADDRESS
                                ; (WORD, R/O)
@CRDSK  EQU     SCB$BASE+3EH    ; CURRENT DISK (BYTE, R/O)
@VINFO  EQU     SCB$BASE+3FH    ; BDOS VARIABLE "INFO"
                                ; (WORD, R/O)
@RESEL  EQU     SCB$BASE+41H    ; FCB FLAG (BYTE, R/O)
@FX     EQU     SCB$BASE+43H    ; BDOS FUNCTION FOR ERROR
                                ; MESSAGES (BYTE, R/O)
@USRCD  EQU     SCB$BASE+44H    ; CURRENT USER CODE (BYTE, R/O)
@MLTIO   EQU   SCB$BASE+4AH   ; CURRENT MULTI-SECTOR COUNT
            ; (BYTE,R/W)
@ERMDE  EQU     SCB$BASE+4BH    ; BDOS ERROR MODE (BYTE, R/O)
@ERDSK   EQU   SCB$BASE+51H   ; BDOS ERROR DISK (BYTE,R/O)
@MEDIA   EQU   SCB$BASE+54H   ; SET BY BIOS TO INDICATE
            ; OPEN DOOR (BYTE,R/W)
@BFLGS  EQU     SCB$BASE+57H    ; BDOS MESSAGE SIZE FLAG (BYTE,R/O) 
@DATE   EQU     SCB$BASE+58H    ; DATE IN DAYS SINCE 1 JAN 78
                                ; (WORD, R/W)
@HOUR   EQU     SCB$BASE+5AH    ; HOUR IN BCD (BYTE, R/W)
@MIN    EQU     SCB$BASE+5BH    ; MINUTE IN BCD (BYTE, R/W)
@SEC    EQU     SCB$BASE+5CH    ; SECOND IN BCD (BYTE, R/W)
?ERJMP  EQU     SCB$BASE+5FH    ; BDOS ERROR MESSAGE JUMP
                                ; (WORD, R/W)
@MXTPA  EQU     SCB$BASE+62H    ; TOP OF USER TPA
                                ; (ADDRESS AT 6,7)(WORD, R/O)
   END


BOOT3.asm:
Code: Select all
   TITLE   'BOOT LOADER MODULE FOR CP/M 3.0'

   ; BOOT3.ASM  v.1.0  02/22/2023

   ; Written by Wayne Parham  (wayne@parhamdata.com)

   ; Four drive support:
   ; Drives 0 and 1 are 330Kb diskettes
   ; Drives 2 and 3 are 8Mb IDE drives

   ; DEFINE LOGICAL VALUES:
TRUE      EQU   -1
FALSE      EQU   NOT TRUE

   ; DETERMINE IF FOR BANK SELECT OR NOT:
BANKED      EQU   FALSE   ;<--------------- BANKED VERSION

   ; DEFINE PUBLIC LABELS:
   PUBLIC   ?INIT,?LDCCP,?RLCCP,?TIME
   PUBLIC   OUT$BLOCKS

   ; EXTERNALLY DEFINED ENTRY POINTS AND LABELS:
   EXTRN   ?PMSG,?CONIN
   EXTRN   @CIVEC,@COVEC,@AIVEC,@AOVEC,@LOVEC
   EXTRN    @CBNK,?BNKSL

   IF   BANKED
   EXTRN   BANKBUF      ;128 BYTE BUFFER IN MOVE MODULE FOR USE
            ; DURING COLD AND WARM BOOTS
   ENDIF

   EXTRN   @SEC,@MIN,@HOUR,@DATE   ;FIELDS HOLDING CURRENT TIME AND DATE

   ; INCLUDE Z-80 MACROS:
   MACLIB   Z80

   ; SOME MISCELLANEOUS EQUATES:
BDOS      EQU   5
CR      EQU   13   ;ASCII CARRIAGE RETURN
LF      EQU   10   ;ASCII LINEFEED
;
;
   ; WE CAN DO INITIALIZATION FROM BANKED MEMORY (IF WE HAVE IT):
   IF   BANKED
   DSEG   ; INIT DONE FROM BANKED MEMORY
   ELSE
   CSEG   ; INIT TO BE DONE FROM COMMON MEMORY
   ENDIF

   ;;;;; ?INIT
   ; HARDWARE INITIALIZATION OTHER THAN CHARACTER AND DISK I/O:
?INIT:
   ; ASSIGN CONSOLE INPUT AND OUTPUT TO CRT:
   LXI   H,8000H      ;SIGNIFIES DEVICE 0
   SHLD   @CIVEC      ;CONSOLE INPUT VECTOR
   SHLD   @COVEC      ;CONSOLE OUTPUT VECTOR

   ; ASSIGN PRINTER TO LPT:
   LXI   H,4000H      ;SIGNIFIES DEVICE 1
   SHLD   @LOVEC      ;LIST OUTPUT VECTOR

   ; ASSIGN AUX TO CRT1:
   LXI   H,02000H   ;SIGNIFIES DEVICE 2
   SHLD   @AIVEC      ;AUXILLIARY INPUT VECTOR
   SHLD   @AOVEC      ;AUXILLIARY OUTPUT VECTOR

   ; PRINT THE SIGN-ON MESSAGE:
   LXI   H,SIGNON$MSG   ;POINT TO IT
   JMP   ?PMSG      ;AND PRINT IT
;
;
   ;;;;; OUT$BLOCKS
   ; ROUTINE OUTPUTS SPECIFIED # BYTES TO SPECIFIED OUTPUT PORTS:
   IF   BANKED
   CSEG         ;WE WANT THIS ROUTINE IN COMMON MEMORY
   ENDIF
OUT$BLOCKS:
   MOV   A,M      ;GET A BYTE FROM THE BLOCK
   ORA   A      ;END OF OUTPUT BLOCK ?
   RZ         ;THEN DONE!!
   MOV   B,A      ;ELSE PUT # BYTES TO SEND OUT IN [B]
   INX   H      ;POINT TO PORT TO SEND TO
   MOV   C,M      ;GET IT TO [C]
   INX   H      ;POINT TO 1ST BYTE OF BLOCK TO SEND OUT
   OUTIR         ;Z-80 BLOCK OUTPUT
   JR   OUT$BLOCKS

   ;;;;; ?LDCCP
   ; THIS ROUTINE IS ENTERED TO LOAD THE CCP.COM FILE INTO THE TPA BANK
   ;  AT SYSTEM COLD START:
?LDCCP:
   ; SET UP THE FCB FOR THE FILE OPERATION:
   XRA   A      ;ZERO EXTENT
   STA   CCP$FCB+15
   LXI   H,0      ;START AT BEGINNING OF FILE
   SHLD   FCB$NR

   ; TRY TO OPEN THE CCP.COM FILE:
   LXI   D,CCP$FCB   ;POINT TO FCB
   CALL   OPEN      ;ATTEMPT THE OPEN OPERATION
   INR   A      ;WAS IT ON THE DISK ?
;   JRNZ   CCP$FOUND   ;YES -- GO LOAD IT
   JNZ   CCP$FOUND   ;YES -- GO LOAD IT

   ; WE ARRIVE HERE WHEN CCP.COM FILE WASN'T FOUND:
   LXI   H,CCP$MSG   ;REPORT THE ERROR
   CALL   ?PMSG
   CALL   ?CONIN      ;GET A RESPONSE
   JR   ?LDCCP      ;AND TRY AGAIN

   ; FILE WAS OPENED OK -- READ IT IN:
CCP$FOUND:
   LXI   D,0100H      ;LOAD AT BOTTOM OF TPA
   CALL   SETDMA      ;BY SETTING THE NEXT DMA ADDRESS
   LXI   D,128      ;SET MULTI SECTOR I/O COUNT
   CALL   SETMULTI   ; TO ALLOW UP TO 16K BYTES IN ONE OPERATION
   LXI   D,CCP$FCB   ;POINT TO THE FCB
   CALL   READ      ;AND READ THE CCP IN

   ; FOLLOWING CODE FOR BANKED SYSTEMS -- MOVES CCP IMAGE TO BANK 2
   ;  FOR LATER RELOADING AT WARM STARTS:
   IF   BANKED
   LXI   H,0100H      ;GET CCP IMAGE FROM START OF TPA
   MVI   B,25      ;TRANSFER 25 LOGICAL SECTORS
   LDA   @CBNK      ;GET CURRENT BANK
   PUSH   PSW      ;AND SAVE IT
LD$1:
   PUSH   B      ;SAVE SECTOR COUNT
   MVI   A,1      ;SELECT TPA BANK
   CALL   ?BNKSL
   LXI   B,128      ;TRANSFER 128 BYTES TO TEMPORARY BUFFER
   LXI   D,BANKBUF   ;TEMPORARY BUFFER ADDR IN [DE]
   PUSH   H      ;SAVE SOURCE ADDRESS
   PUSH   D      ;AND DESTINATION
   PUSH   B      ;AND COUNT
   LDIR         ;BLOCK MOVE SECTOR TO TEMPORARY BUFFER
   MVI   A,2      ;SELECT BANK TO SAVE CCP IN
   CALL   ?BNKSL
   POP   B      ;GET BACK COUNT
   POP   H      ;LAST DESTINATION WILL BE NEW SOURCE ADDR
   POP   D      ;LAST SOURCE WILL BE NEW DESTINATION
   LDIR         ;BLOCK MOVE SECTOR FROM BUFFER TO ALTERNATE
            ; BANK
   XCHG         ;NEXT ADDR WILL BE NEW SOURCE ADDR
   POP   B      ;GET BACK SECTOR COUNT
   DJNZ   LD$1      ;DROP SECTOR COUNT AND LOOP TILL DONE...
   POP   PSW      ;WHEN DONE -- RESTORE ORIGINAL BANK
   JMP   ?BNKSL
   ELSE

   ; IF NON-BANKED WE RETURN THROUGH HERE:
   RET
   ENDIF

   ;;;;; ?RLCCP
   ; ROUTINE RELOADS CCP IMAGE FROM BANK 2 IF BANKED SYSTEM OR FROM THE
   ;  DISK IF NON-BANKED VERSION:
?RLCCP:
   IF   BANKED
   ; FOLLOWING CODE FOR BANKED VERSION:
   LXI   H,0100H      ;GET CCP IMAGE FROM START OF ALTERNATE BUFFER
   MVI   B,25      ;TRANSFER 25 LOGICAL SECTORS
   LDA   @CBNK      ;GET CURRENT BANK
   PUSH   PSW      ;AND SAVE IT
RL$1:
   PUSH   B      ;SAVE SECTOR COUNT
   MVI   A,2      ;SELECT ALTERNATE BANK
   CALL   ?BNKSL
   LXI   B,128      ;TRANSFER 128 BYTES TO TEMPORARY BUFFER
   LXI   D,BANKBUF   ;TEMPORARY BUFFER ADDR IN [DE]
   PUSH   H      ;SAVE SOURCE ADDRESS
   PUSH   D      ;AND DESTINATION
   PUSH   B      ;AND COUNT
   LDIR         ;BLOCK MOVE SECTOR TO TEMPORARY BUFFER
   MVI   A,1      ;PUT CCP TO TPA BANK
   CALL   ?BNKSL
   POP   B      ;GET BACK COUNT
   POP   H      ;LAST DESTINATION WILL BE NEW SOURCE ADDR
   POP   D      ;LAST SOURCE WILL BE NEW DESTINATION
   LDIR         ;BLOCK MOVE SECTOR FROM BUFFER TO TPA BANK
   XCHG         ;NEXT ADDR WILL BE NEW SOURCE ADDR
   POP   B      ;GET BACK SECTOR COUNT
   DJNZ   RL$1      ;DROP SECTOR COUNT AND LOOP TILL DONE...
   POP   PSW      ;GET BACK LAST CURRENT BANK #
   JMP   ?BNKSL      ;SELECT IT AND RETURN
   ELSE

   ; FOLLOWING CODE IS FOR NON-BANKED VERSIONS:
   JMP   ?LDCCP      ;JUST DO LOAD AS THOUGH COLD BOOT
   ENDIF

   ;;;;; ?TIME
   ; ROUTINE SETS/GETS TIME:
?TIME:   
   RET         ;Just return in this simple version
;
;
;
   IF   BANKED
   CSEG
   ENDIF

   ;;;;;
   ; CP/M BDOS FUNCTION INTERFACES

   ; OPEN FILE:
OPEN:
   MVI C,15 ! JMP BDOS      ; OPEN FILE CONTROL BLOCK

   ; SET DMA ADDRESS:
SETDMA:
   MVI C,26 ! JMP BDOS      ; SET DATA TRANSFER ADDRESS

   ; SET MULTI SECTOR I/O COUNT:
SETMULTI:
   MVI C,44 ! JMP BDOS      ; SET RECORD COUNT

   ; READ FILE RECORD:
READ:
   MVI C,20 ! JMP BDOS      ; READ RECORDS

   ; CCP NOT FOUND ERROR MESSAGE:
CCP$MSG:
   DB   CR,LF,'BIOS ERR ON A: NO CCP.COM FILE',0


   ; FCB FOR CCP.COM FILE LOADING:
CCP$FCB:
   DB   1      ;AUTO-SELECT DRIVE A
   DB   'CCP     COM'   ;FILE NAME AND TYPE
   DB   0,0,0,0
   DS   16
FCB$NR:   DB   0,0,0


   ; SYSTEM SIGN-ON MESSAGE:
SIGNON$MSG:
   db   CR,LF,LF,'CP/M Plus v3.0hd',CR,LF,LF,LF,0
   END


CHARIO3.asm:
Code: Select all
   TITLE   'SIO AND 2SIO MODULE FOR CP/M 3.0'

   ; CHARIO3.ASM  v.1.0  02/22/2023

   ; Written by Wayne Parham  (wayne@parhamdata.com)

   ; Character device driver module for Altair computers.
   ; Supports SIO and 2SIO async boards and compatibles
   ; such as Martin Eberhard's 88-2SIOJP.

   ; Note that the CIST function calls ckFlush from the
   ; diskette module.  This allows delayed track flushing.

   ; DEFINE LOGICAL VALUES:
TRUE      EQU   -1
FALSE      EQU   NOT TRUE

   ; Equates used by FDC for flushing during system inactivity (during char I/O)
UNDEF      EQU   0FFH
MINIDSK      EQU   FALSE      ;Set TRUE for Altair Mini-Disk (see FDC3.asm)
cHDUNLD      EQU   08H      ;head unload
DRVCMD      EQU   09H      ;drive command register (out)

   ; DETERMINE IF FOR BANK SELECT OR NOT:
BANKED      EQU   FALSE   ;<------------------- BANKED VERSION

   ; DEFINE PUBLIC LABELS:
   PUBLIC   ?CINIT,?CI,?CO,?CIST,?COST
   PUBLIC   @CTBL

   ; DEFINE EXTERNAL LABELS AND ENTRY POINTS:
   IF   BANKED
   EXTRN   @CBNK
   EXTRN   ?BNKSL
   ENDIF
   EXTRN   OUT$BLOCKS   ;BLOCK OUTPUT ROUTINE TO I/O PORTS
   EXTRN   ?PMSG

   ; FDC external labels:
   EXTRN   bfDrive      ;Buffered drive
   EXTRN   ckFlush      ;Disk buffer flush routine

   ; INCLUDE Z-80 MACROS:
   MACLIB   Z80

   ; 2SIO Serial Board Equates

SIO1CTL   EQU   10h      ;1st port on 2SIO board - control register
SIO1DAT   EQU   11h      ;1st port on 2SIO board - data register
SIO2CTL   EQU   12h      ;2nd port on 2SIO board - control register
SIO2DAT   EQU   13h      ;2nd port on 2SIO board - data register
SIORDRF   EQU   01h      ;read data register full flag
SIOTDRE   EQU   02h      ;transmit data register empty flag

   ; SIO Serial Board Equates

SIOCTL   EQU   00h      ;SIO board at 0 - control register
SIODAT   EQU   01h      ;SIO board at 0 - data register
ACRCTL   EQU   06h      ;SIO board at 6 - control register (cassette)
ACRDAT   EQU   07h      ;SIO board at 6 - data register (cassette)
SIORCV   EQU   01h      ;data received bit (inverted)
SIOXMT   EQU   80h      ;read to transmit (inverted)

   ; EQUATES FOR MODE BYTE BIT FIELDS

MB$INPUT   EQU 0000$0001B   ; DEVICE MAY DO INPUT
MB$OUTPUT   EQU 0000$0010B   ; DEVICE MAY DO OUTPUT
MB$IN$OUT   EQU MB$INPUT+MB$OUTPUT

MB$SOFT$BAUD   EQU 0000$0100B   ; SOFTWARE SELECTABLE BAUD RATES

MB$SERIAL   EQU 0000$1000B   ; DEVICE MAY USE PROTOCOL
MB$XON$XOFF   EQU 0001$0000B   ; XON/XOFF PROTOCOL ENABLED

BAUD$NONE   EQU 0      ; NO BAUD RATE ASSOCIATED WITH THIS DEVICE
BAUD$50      EQU 1      ; 50 BAUD
BAUD$75      EQU 2      ; 75 BAUD
BAUD$110   EQU 3      ; 110 BAUD
BAUD$134   EQU 4      ; 134.5 BAUD
BAUD$150   EQU 5      ; 150 BAUD
BAUD$300   EQU 6      ; 300 BAUD
BAUD$600   EQU 7      ; 600 BAUD
BAUD$1200   EQU 8      ; 1200 BAUD
BAUD$1800   EQU 9      ; 1800 BAUD
BAUD$2400   EQU 10      ; 2400 BAUD
BAUD$3600   EQU 11      ; 3600 BAUD
BAUD$4800   EQU 12      ; 4800 BAUD
BAUD$7200   EQU 13      ; 7200 BAUD
BAUD$9600   EQU 14      ; 9600 BAUD
BAUD$19200   EQU 15      ; 19.2K BAUD

   ; WILL START OFF IN COMMON MEMORY FOR BANKED OR NON-BANKED SYSTEMS:
   CSEG

   IF   BANKED
   ; WE PROVIDE ALTERNATE DEFINITIONS OF THE ROUTINE ENTRY POINTS IF
   ;  WE ARE RUNNING A BANKED SYSTEM VERSUS A NON-BANKED SYSTEM:

   ;;;;; ?CINIT
   ; ENTER HERE FOR BANKED SYSTEMS FOR DEVICE INITIALIZATIONS:
?CINIT:
   LXI   H,BCINIT   ;POINT TO BANKED ROUTINE ADDRESS
   JR   BANKIO      ;GO TO DISPATCHER

   ;;;;; ?CI
   ; ENTER HERE FOR BANKED SYSTEM DEVICE INPUT:
?CI:   LXI   H,BCI      ;POINT TO BANKED ROUTINE ADDRESS
   JR   BANKIO      ;GO TO DISPATCHER

   ;;;;; ?CO
   ; ENTER HERE FOR BANKED SYSTEM DEVICE OUTPUT:
?CO:   LXI   H,BCO      ;POINT TO BANKED ROUTINE ADDRESS
   JR   BANKIO      ;GO TO DISPATCHER

   ;;;;; ?CIST
   ; ENTER HERE FOR BANKED SYSTEM DEVICE INPUT STATUS:
?CIST:   LXI   H,BCIST      ;POINT TO BANKED ROUTINE ADDRESS
   JR   BANKIO      ;GO TO DISPATCHER

   ;;;;; ?COST
   ; ENTER HERE FOR BANKED SYSTEM DEVICE OUTPUT STATUS:
?COST:   LXI   H,BCOST      ;POINT TO BANKED ROUTINE ADDRESS

   ;;;;; BANKIO
   ; ROUTINE DISPATCHES TO BANKED PORTION OF CHARACTER I/O ROUTINES:
BANKIO:
   SSPD   SPSAVE      ;SAVE CURRENT STACK POINTER
   LXI   SP,IOSP      ; AND USE LOCAL STACK FOR I/O
   LDA   @CBNK      ;GET CURRENT BANK
   PUSH   PSW      ;SAVE ON LOCAL STACK
   XRA   A      ;WE WILL SELECT BANK 0 (OP SYS)
   CALL   ?BNKSL
   LXI   D,BIORET   ;RETURN ADDRESS IN [DE]
   PUSH   D      ;PUT IT ON STACK FOR RETURN
   PCHL         ;DISPATCH TO BANKED PART OF ROUTINE

   ; ARRIVE HERE AFTER DEVICE HANDLER FINISHED:
BIORET:
   POP   D      ;GET PREVIOUS CURRENT BANK TO [D]
   PUSH   PSW      ;SAVE HANDLER RETURNED RESULT (IF ANY)
   MOV   A,D      ;RESELECT PREVIOUS CURRENT BANK
   CALL   ?BNKSL
   POP   PSW      ;GET BACK RESULT CODE TO [A]
   LSPD   SPSAVE      ;RESTORE PREVIOUS STACK
   RET         ;AND RETURN...
   ENDIF

   ;;;;;
   ;;;;; ACTUAL DEVICE HANDLERS
   ;;;;;

   ;;;;; ?CINIT (BCINIT FOR BANKED)
   ; PHYSICAL CODE FOR DEVICE INITIALIZATION:
   IF   BANKED
   DSEG         ;CAN PUT IN BANKED SEGMENT IF BANKED
BCINIT:
   ELSE
?CINIT:
   ENDIF
   MOV   B,C      ;ON ENTRY DEVICE # IS IN [C] BUT WE NEED
            ; IT IN [B]
   CALL   DEV$DISPATCH   ;GO TO CORRECT INIT ROUTINE
   DW   CINIT0      ;INIT FOR DEVICE 0
   DW   CINIT1      ;INIT FOR DEVICE 1
   DW   CINIT2      ;INIT FOR DEVICE 2
   DW   CINIT3      ;INIT FOR DEVICE 3
   DW   NULL$INIT   ;INIT FOR DEVICE 4
   DW   NULL$INIT   ;INIT FOR DEVICE 5
   DW   NULL$INIT   ;INIT FOR DEVICE 6
   DW   NULL$INIT   ;INIT FOR DEVICE 7
   DW   NULL$INIT   ;INIT FOR DEVICE 8
   DW   NULL$INIT   ;INIT FOR DEVICE 9
   DW   NULL$INIT   ;INIT FOR DEVICE 10
   DW   NULL$INIT   ;INIT FOR DEVICE 11
   DW   NULL$INIT   ;INIT FOR DEVICE 12
   DW   NULL$INIT   ;INIT FOR DEVICE 13
   DW   NULL$INIT   ;INIT FOR DEVICE 14
   DW   NULL$INIT   ;INIT FOR DEVICE 15

   ;;;;; ?CI (BCI FOR BANKED)
   ; PHYSICAL CODE FOR DEVICE INPUT:
   IF   BANKED
BCI:
   ELSE
?CI:
   ENDIF
   CALL   DEV$DISPATCH
   DW   CI0      ;DEVICE 0 INPUT
   DW   CI1      ;DEVICE 1 INPUT
   DW   CI2      ;DEVICE 2 INPUT
   DW   CI3      ;DEVICE 3 INPUT
   DW   NULL$CI      ;DEVICE 4 INPUT
   DW   NULL$CI      ;DEVICE 5 INPUT
   DW   NULL$CI      ;DEVICE 6 INPUT
   DW   NULL$CI      ;DEVICE 7 INPUT
   DW   NULL$CI      ;DEVICE 8 INPUT
   DW   NULL$CI      ;DEVICE 9 INPUT
   DW   NULL$CI      ;DEVICE 10 INPUT
   DW   NULL$CI      ;DEVICE 11 INPUT
   DW   NULL$CI      ;DEVICE 12 INPUT
   DW   NULL$CI      ;DEVICE 13 INPUT
   DW   NULL$CI      ;DEVICE 14 INPUT
   DW   NULL$CI      ;DEVICE 15 INPUT

   ;;;;; ?CO (BCO FOR BANKED)
   ; PHYSICAL CODE FOR DEVICE OUTPUT:
   IF   BANKED
BCO:
   ELSE
?CO:
   ENDIF
   CALL   DEV$DISPATCH   ;GO TO CORRECT DEVICE OUTPUT HANDLER
   DW   CO0      ;DEVICE 0 OUTPUT
   DW   CO1      ;DEVICE 1 OUTPUT
   DW   CO2      ;DEVICE 2 OUTPUT
   DW   CO3      ;DEVICE 3 OUTPUT
   DW   NULL$CO      ;DEVICE 4 OUTPUT
   DW   NULL$CO      ;DEVICE 5 OUTPUT
   DW   NULL$CO      ;DEVICE 6 OUTPUT
   DW   NULL$CO      ;DEVICE 7 OUTPUT
   DW   NULL$CO      ;DEVICE 8 OUTPUT
   DW   NULL$CO      ;DEVICE 9 OUTPUT
   DW   NULL$CO      ;DEVICE 10 OUTPUT
   DW   NULL$CO      ;DEVICE 11 OUTPUT
   DW   NULL$CO      ;DEVICE 12 OUTPUT
   DW   NULL$CO      ;DEVICE 13 OUTPUT
   DW   NULL$CO      ;DEVICE 14 OUTPUT
   DW   NULL$CO      ;DEVICE 15 OUTPUT

   ;;;;; ?CIST (BCIST FOR BANKED)
   ; PHYSICAL CODE FOR DEVICE INPUT STATUS:
   IF   BANKED
BCIST:
   ELSE
?CIST:
   ENDIF
   ;;;;; System is relatively idle during char input, so do some FDC housecleaning
   mvi   a,UNDEF      ;invalidate track buffer
   sta   bfDrive
   call   ckFlush      ;flush the track if needed
   ei         ;restore interrupts
   IF   NOT MINIDSK
   mvi   a,cHDUNLD   ;unload head
   out   DRVCMD
   ENDIF

   CALL   DEV$DISPATCH
   DW   CIST0      ;DEVICE 0 INPUT STATUS
   DW   CIST1      ;DEVICE 1 INPUT STATUS
   DW   CIST2      ;DEVICE 2 INPUT STATUS
   DW   CIST3      ;DEVICE 3 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 4 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 5 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 6 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 7 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 8 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 9 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 10 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 11 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 12 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 13 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 14 INPUT STATUS
   DW   NULL$CIST   ;DEVICE 15 INPUT STATUS

   ;;;;; ?COST (BCOST FOR BANKED)
   ; PHYSICAL CODE FOR DEVICE OUTPUT STATUS:
   IF   BANKED
BCOST:
   ELSE
?COST:
   ENDIF
   CALL   DEV$DISPATCH   ;GO TO CONSOLE OUTPUT STATUS HANDLER
   DW   COST0      ;DEVICE 0 OUTPUT STATUS
   DW   COST1      ;DEVICE 1 OUTPUT STATUS
   DW   COST2      ;DEVICE 2 OUTPUT STATUS
   DW   COST3      ;DEVICE 3 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 4 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 5 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 6 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 7 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 8 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 9 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 10 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 11 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 12 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 13 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 14 OUTPUT STATUS
   DW   NULL$COST   ;DEVICE 15 OUTPUT STATUS

   ;;;;; DEV$DISPATCH
   ; ROUTINE JUMPS TO CORRECT DEVICE HANDLER:
DEV$DISPATCH:
   MOV   A,B      ;GET DEVICE # TO [A]
   STA   DEV$CODE   ;SAVE FOR LATER USE
   ADD   A      ;X2 FOR WORD OFFSET
   POP   H      ;RETURN ADDRESS IS 1ST PARAMETER ADDRESS
   MOV   E,A      ;SET UP OFFSET IN [DE]
   MVI   D,0
   DAD   D      ;[HL] = PTR TO HANDLER ADDRESS
   MOV   E,M      ;GET HANDLER ADDRESS TO [DE]
   INX   H
   MOV   D,M
   MOV   A,C      ;PUT CHAR TO SEND INTO A
   XCHG         ;PUT HANDLER ADDRESS IN [HL]
   PCHL         ;AND DISPATCH TO IT...

   ;;;;;
   ;;;;; PHYSICAL DEVICE HANDLER CODE:
   ;;;;;

;---------------------------------------------------------------------------
; Initialize serial ports
;---------------------------------------------------------------------------

CINIT0:
   mvi   a,03h      ;reset 2SIO ports
   out   SIO1CTL
   out   SIO2CTL

   mvi   a,11h      ;select 8N2
   out   SIO1CTL
   out   SIO2CTL
CINIT1:
CINIT2:
CINIT3:
   ret

;---------------------------------------------------------------------------
; Input status routines. Return FFh if character ready, else zero
;---------------------------------------------------------------------------

CIST0:
sio1IS  in   SIO1CTL      ;read 2SIO #1 status/control register
   ani   SIORDRF      ;data present?
   rz         ;no, return zero

   mvi   a,0FFh      ;else return FFh
   ret

CIST1:
sio2IS   in   SIO2CTL      ;read 2SIO #2 status/control register
   ani   SIORDRF      ;data present?
   rz         ;no, return zero

   mvi   a,0FFh      ;else return FFh
   ret

CIST2:
sioIS   in   SIOCTL      ;read SIO status/control register
   xri   0FFh      ;convert to positive logic
   ani   SIORCV      ;data present?
   rz         ;no, return zero

   mvi   a,0FFh      ;else return FFh
   ret

CIST3:
acrIS   in   ACRCTL      ;read ACR (SIO) control register
   xri   0FFh      ;convert to positive logic
   ani   SIORCV      ;data present?

   rz         ;no, return zero
   mvi   a,0FFh      ;else return FFh
   ret

;---------------------------------------------------------------------------
; Character input routines (character ready assumed)
;---------------------------------------------------------------------------

CI0:
sio1In   in   SIO1DAT      ;read and return the character
   ret

CI1:
sio2In   in   SIO2DAT      ;read and return the character
   ret

CI2:
sioIn   in   SIODAT      ;read and return the character
   ret

CI3:
acrIn   in   ACRDAT      ;read and return the character
   ret

;---------------------------------------------------------------------------
; Output status routines. Return FFh if ready to send, else zero
;---------------------------------------------------------------------------

COST0:
sio1OS   in   SIO1CTL      ;read 2SIO #1 status/control register
   ani   SIOTDRE      ;0=busy
   rz         ;not ready, return 0

   mvi   a,0FFh      ;else return FFh
   ret

COST1:
sio2OS   in   SIO2CTL      ;read 2SIO #2 status/control register
   ani   SIOTDRE      ;0=busy
   rz         ;not ready, return 0

   mvi   a,0FFh      ;else return FFh
   ret

COST2:
sioOS   in   SIOCTL      ;read SIO status/control register
   xri   0FFh      ;convert to positive logic
   ani   SIOXMT      ;0=busy
   rz         ;not ready, return 0

   mvi   a,0FFh      ;else return FFh
   ret

COST3:
acrOS   in   ACRCTL      ;read SIO status/control register
   xri   0FFh      ;convert to positive logic
   ani   SIOXMT      ;0=busy
   rz         ;not ready, return 0

   mvi   a,0FFh      ;else return FFh
   ret

;---------------------------------------------------------------------------
; Character output routines (transmit ready assumed)
;---------------------------------------------------------------------------

CO0:
sio1Out   out   SIO1DAT      ;send character
   ret

CO1:
sio2Out   out   SIO2DAT      ;send character
   ret

CO2:
sioOut   out   SIODAT      ;send character
   ret

CO3:
acrOut   out   ACRDAT      ;send character
   ret

   ;;;;; NULL ROUTINES:
NULL$CIST:
NULL$COST:
   XRA   A      ;RETURN A FALSE STATUS RESULT
   JR   NULL$RET
NULL$CI:
   MVI   A,1AH      ;FOR INPUT RETURN A CNTL-Z (EOF)
NULL$INIT:
NULL$CO:
NULL$RET:
   RET         ;HARMLESS RETURN

   ; STORAGE FOR DEVICE CODE -- CAN RESIDE IN SAME SEGMENT AS THE BULK
   ;  OF CHARACTER I/O ROUTINES:
DEV$CODE:   DS   1

   ;;;;; CHRTBL
   ; CHARACTER DEVICE TABLE
   CSEG         ;MUST RESIDE IN COMMON MEMORY
@CTBL:
   db '2SIOA '      ; device 0, 2SIO at 10h/11h
   db mb$in$out+mb$serial
   db baud$none
   db '2SIOB '      ; device 1, 2SIO at 12h/13h
   db mb$in$out+mb$serial
   db baud$none
   db 'SIO   '      ; device 2, SIO at 0/1
   db mb$in$out+mb$serial
   db baud$none
   db 'ACR   '      ; device 3, SIO at 6/7 (ACR)
   db mb$in$out+mb$serial
   db baud$none
   db 0         ; table terminator

MAX$DEVICES   EQU   ($-@CTBL)/8   ;# DEVICES IN TABLE
   DB   0         ;TABLE TERMINATOR

   ; OTHER DATA AREAS:
   DS   24      ;CHARACTER I/O LOCAL STACK
IOSP   EQU   $
SPSAVE   DS   2

   END


MOVE3.asm:
Code: Select all
   TITLE 'BANK & MOVE MODULE FOR CP/M 3.0'

   ; MOVE3.ASM  v.1.0  02/22/2023

   ; Written by Wayne Parham  (wayne@parhamdata.com)

   ; Memory copy routines for the Altair 8800 computer.

   ; Only non-banked code is 8080-compatible.  If a
   ; banked-memory system is employed, the drivers in
   ; this module can be used as a starting point but
   ; obviously cannot be used in a stock Altair.

   ; DEFINE LOGICAL VALUES:
TRUE      EQU   -1
FALSE      EQU   NOT TRUE

   ; DETERMINE IF FOR BANK SELECT OR NOT:
BANKED      EQU   FALSE   ;<----------------Banked VERSION

MPURR0   EQU   0D2H      ;Z80 BOARD RELOCATION PORT
MPURR1   EQU   0D3H      ;Z80 BOARD RELOCATION PORT


   ; DEFINE PUBLIC LABELS:
   PUBLIC   ?MOVE,?XMOVE,?BANK

   ; PUBLIC LABELS AND EXTERNALS FOR BANKED SYSTEMS:
   IF   BANKED
   PUBLIC   CURRR0,CURRR1   ;CURRENT WINDOW RELOCATION SEGMENTS
   PUBLIC   BANKBUF      ;TEMPORARY 128 BYTE BUFFER OTHER ROUTINES
            ; MAY USE FOR TRANSIENT PURPOSES
   PUBLIC   WIN$LOW$2BITS   ;LOWER 2 BITS FOR EACH RELOCATION REGISTER
   PUBLIC   DOXMOV,XMOV$BANKS   ;EXTENDED BANK MOVE VARIABLES

   ; EXTERNALLY DEFINED ENTRY POINTS AND LABELS:
   EXTRN   @CBNK
   EXTRN   ?BNKSL
   ENDIF

   ; INCLUDE Z-80 MACROS:
   MACLIB   Z80

   ; LOCATE CODE IN THE COMMON SEGMENT:
   CSEG

   ;;;;; ldir
   ; An 8080-compatiple replacement for the Z80 LDIR instruction
   ; Copies [BC] bytes from the address starting at [HL] to [DE]
ldir:
   xchg         ;Make [DE] be source and [HL] be target
   call   memcpy      ;Copy data block
   xchg         ;Make [DE] be target and [DE] be source
   ret

   ;;;;; memcpy
   ; Copies [BC] bytes from the address starting at [DE] to [HL]
memcpy:   ldax   d      ;Get byte byte
   mov   m,a      ;Store byte
   inx   h      ;Increment target address
   inx   d      ;Increment source address
   dcx   b      ;Decrement byte count
   mov   a,b      ;move btye count to accumulator
   ora   c      ;test for zero
   jnz   memcpy      ;loop until done
   ret

   ;;;;; ?XMOVE
   ; ROUTINE SETS UP AN INTER-BANK MOVE OF 128 BYTES ON THE NEXT CALL
   ;  TO ?MOVE:
?XMOVE:
   IF   BANKED
   MVI   A,0FFH      ;SET EXTENDED MOVE FLAG
   STA   DOXMOV
   SBCD   XMOV$BANKS   ;AND STORE BANKS FOR THE EXTENDED MOVE
   ENDIF
   RET

   ;;;;; ?MOVE
   ; ROUTINE PERFORMS INTRA-BANK MOVES IF ?XMOVE WAS NOT CALLED PRIOR TO
   ;  THIS CALL TO ?MOVE ELSE A 128 BYTE TRANSFER IS CONDUCTED BETWEEN
   ;  DIFFERENT BANKS:
?MOVE:
   IF   BANKED
   LDA   DOXMOV      ;GET EXTENDED MOVE FLAG
   ORA   A      ;IS IT SET ?
   MVI   A,0      ;RESET FOR NEXT TIME ANYWAY
   STA   DOXMOV
   JRZ   MOVE$IT

   ; HAVE TO IMPLEMENT INTER-BANK MOVE:
   LDA   @CBNK      ;REMEMBER CURRENT BANK
   PUSH   PSW
   LDA   XMOV$BANKS   ;GET SOURCE BANK
   CALL   ?BNKSL      ; AND SELECT IT
   PUSH   H      ;SAVE DESTINATION ADDRESS
   PUSH   B      ;AND THE COUNT
   XCHG         ;[HL] = SOURCE
   LXI   D,BANKBUF   ;[DE] = LOCAL TEMPORARY BUFFER
   LDIR         ;BLOCK MOVE TO TEMP BUFFER
   POP   B      ;RESTORE COUNT
   POP   D      ;[DE] = ORIGINAL DESTINATION
   PUSH   H      ;SAVE NEXT SOURCE ADDRESS
   LXI   H,BANKBUF   ;[HL] = SOURCE = TEMP BUFFER
   LDA   XMOV$BANKS+1   ;GET DESTINATION BANK
   CALL   ?BNKSL      ;AND SELECT IT
   LDIR         ;BLOCK MOVE FROM TEMP BUFFER TO DESTINATION
   POP   H      ;RESTORE NEXT SOURCE
   XCHG         ;RETURN SWAP
   POP   PSW      ;GET BACK PREVIOUS CURRENT BANK
   JMP   ?BNKSL      ;SELECT IT AND RETURN

   ; ARRIVE HERE FOR INTRA-BANK MEMORY MOVE:
MOVE$IT:
   ENDIF

;   XCHG         ;WE ARE PASSED SOURCE IN DE AND DEST IN HL
;   LDIR         ;USE Z80 BLOCK MOVE INSTRUCTION
;   XCHG         ;NEED NEXT ADDRESSES IN SAME REGS
;   RET
   jmp memcpy      ;Use 8080-compatible memcpy for move

   ;;;;; ?BANK
   ; ROUTINE SWITCHES IN PHYSICAL BANK:
?BANK:
   IF   BANKED
   CPI   2      ;BANK 2 OR HIGHER ?
   JRNC   BNK1$SWITCH   ;GO DIRECTLY TO CODE TO CALCULATE THE
            ; PHYSICAL ADDRESS...
   ORA   A      ;ELSE SWAP BANK 0 AND 1 VALUES
   MVI   A,1      ;IF BANK 0 MAKE BANK 1
   JRZ   BNK1$SWITCH
   XRA   A      ;ELSE IF BANK 1 MAKE BANK 0
   JR   BNK2$SWITCH

   ; HERE TO GET MPU-80 SEGMENT # FOR THE BANK WE NEED:
BNK1$SWITCH:
   DCR   A      ;NORMALIZE BANK # RELATIVE TO 0
   ADD   A      ;X2
   ADD   A      ;X4 FOR 16K / WINDOW
   ADD   A      ;X8 FOR 32K / BANK
   ADI   10H      ;BANKS 1-15 START ABOVE 1ST 64K

   ; DO PHYSICAL BANK SWITCHING HERE:
BNK2$SWITCH:
   PUSH   B      ;SAVE [BC]
   LBCD   WIN$LOW$2BITS   ;GET LOWER 2 BITS FOR EACH RELOCATION REGISTER
   DI         ;CRITICAL SECTION -- NO INTERRUPTS HERE
   STA   CURRR0      ;SAVE SEGMENT ADDR. OF LOWER WINDOW
   ORA   B      ;[A] = WINDOW SEG + LOW 2 BITS
   OUT   MPURR0      ;RELOCATE LOWER WINDOW NOW
   ANI   0FCH      ;TAKE OUT LOWER 2 BITS
   ADI   4      ;BUMP UP SEG ADDR BY 16K FOR UPPER WINDOW
   STA   CURRR1      ;SAVE UPPER WINDOW SEGMENT ADDR.
   ORA   C      ;[A] = WINDOW SEG + LOW 2 BITS
   OUT   MPURR1      ;RELOCATE UPPER WINDOW
;;;;   EI         ;CAN REENABLE INTERRUPTS NOW
   POP   B      ;RESTORE [BC]
   ENDIF
   RET

   IF   BANKED
DOXMOV:      DB   0   ;EXTENDED MOVE FLAG -- IF EQUAL TO FFH THEN
            ; NEXT CALL TO ?MOVE WILL BE AN INTER-BANK
            ; MOVE.

CURRR0:      DB   10H   ;CURRENT LOWER WINDOW RELOCATION REGISTER
            ; VALUE
CURRR1:      DB   14H   ;CURRENT UPPER WINDOW RELOCATION REGISTER
            ; VALUE

WIN$LOW$2BITS:   DB   1   ;UPPER WINDOW REGISTER LOW 2 BITS (MAY CONTROL
            ; ADDRESSING ABOVE 1 MEGABYTE OR EPROM SELECT)
      DB   1   ;LOWER WINDOW REGISTER LOW 2 BITS (MAY CONTROL
            ; ADDRESSING ABOVE 1 MEGABYTE OR EPROM SELECT)

XMOV$BANKS:   DS   1   ;STORAGE AREA FOR DESTINATION BANK # FOR
            ; EXTENDED MOVES
      DS   1   ;STORAGE AREA FOR SOURCE BANK # FOR
            ; EXTENDED MOVES

BANKBUF:   DS   128   ;LOCAL TEMPORARY BUFFER FOR EXTENDED MOVES
   ENDIF


   END

Re: IDE interface for Altair 8800c

PostPosted: February 22nd, 2023, 11:23 pm
by Wayne Parham
DRVTBL3.asm:
Code: Select all
   TITLE   'CP/M 3.0 DRIVE TABLES'

   ; DRVTBL3.ASM  v.1.0  02/22/2023

   ; Written by Wayne Parham  (wayne@parhamdata.com)

   ; Four drive support:
   ; Drives 0 and 1 are 330Kb diskettes
   ; Drives 2 and 3 are 8Mb IDE drives

   ; DEFINE LOGICAL VALUES:
TRUE      EQU   -1
FALSE      EQU   NOT TRUE

   ; DETERMINE IF BANK SELECTING:
BANKED      EQU   FALSE   ;<-------------- NON BANKED VERSION

   ; DEFINE PUBLIC LABELS:
   PUBLIC   @DTBL

   ; DECLARE EXTERNAL LABELS:
   EXTRN   DPH0, DPH1, DPH2, DPH3
   
   ; INCLUDE CP/M 3.0 MACRO LIBRARY:
   MACLIB   CPM3


   IF   BANKED
   DSEG         ;BANKED SYSTEMS CAN HAVE DRIVE TABLE IN THE
            ; OP SYS BANK
   ELSE
   CSEG         ;NON-BANKED SYSTEMS HAVE NO CHOICE BUT TO PUT
            ; IT IN THE COMMON MEMORY AREA
   ENDIF

@DTBL:   DTBL   <DPH0,DPH1,DPH2,DPH3,0,0,0,0,0,0,0,0,0,0,0,0>

   END


FDC3.asm:
Code: Select all
   TITLE   'FDC MODULE FOR CP/M 3.0'

   ; FDC3.ASM  v.1.0  02/22/2023

   ; Diskette device driver module for Altair computers.
   ; Supports Altair floppy disk controller and compatibles
   ; such as the FDC+ provided by DeRamp.com.

   ; Implemented by Wayne Parham  (wayne@parhamdata.com)
   ; Ported into the CP/M 3.0 modular BIOS format
   ; Written by Mike Douglas (AltairClone.com)

TRUE   equ   -1
FALSE   equ   not TRUE

;-----------------------------
;Diskette parameter equates
;-----------------------------
MINIDSK   equ   FALSE      ;set TRUE for Altair Mini-Disk

NUMTRK   equ   77      ;number of tracks on the disk
NUMSEC   equ   32      ;sectors per track
DATATRK   equ   6      ;1st data format track
SECMASK   equ   1Fh      ;five bit sector numbers

BLS   equ   1024      ;allocation unit size
BSH   equ   4      ;allocation block shift factor
BLM   equ   0Fh      ;allocation block mask
EXM   equ   0      ;extent mask
DSM   equ   149      ;max block number (150 blocks of 2K bytes)
NDIRS   equ   64      ;number of directory entries (64)
DRM   equ   63      ;max directory entry number
AL0   equ   0C0h      ;directory allocation block bits byte 0
AL1   equ   0      ;directory allocation block bits byte 1
RESTRK   equ   2      ;reserved tracks for boot image
CKS   equ   (DRM+1)/4   ;directory check space

NUMDISK   equ   2      ;Two drives supported
CSECLEN   equ   128      ;CP/M sector length
SSECLEN   equ   133      ;Altair system sector length
DSECLEN   equ   136      ;Altair data sector length
TSECLEN   equ   DSECLEN+1   ;length of sector in track table

; System tracks (0-5) sector format

SYSTRK   equ   0      ;offset of track number
SYSDATA   equ   3      ;offset of 128 byte data payload
SYSSTOP   equ   131      ;offset of stop byte (FFh)
SYSCSUM   equ   132      ;offset of checksum

; Data tracks (6-76) sector format

DATTRK   equ   0      ;offset of track number
DATSEC   equ   1      ;offset of sector number
DATCSUM   equ   4      ;offset of checksum
DATDATA   equ   7      ;offset of 128 byte data payload
DATSTOP   equ   135      ;offset of stop byte (FFh)


;-----------------------------
; Altair disk controller
;-----------------------------
DRVSLCT   equ   08h      ;drive select register (out)
cDSLCT   equ   80h      ;deselect drive

DRVSTAT   equ   08h      ;drive status register (in)
sENWD   equ   01h      ;enter new write data flag
sMOVEOK   equ   02h      ;OK to move head
sHDSTAT   equ   04h      ;head status flag
sDSKEN   equ   08h      ;disk is selected and enabled
sINTEN   equ   20h      ;processor interrupts enabled
sTRACK0   equ   40h      ;on track zero flag
sNRDA   equ   80h      ;new read data available

DRVCMD   equ   09h      ;drive command register (out)
cSTEPI   equ   01h      ;step in
cSTEPO   equ   02h      ;step out
cHDLOAD   equ   04h      ;head load
cRESTMR   equ   04h      ;restart motor-off timer (MINIDSK)
cHDUNLD   equ   08h      ;head unload
cINTEN   equ   10h      ;interrupt enable
cINTDIS   equ   20h      ;interrupt disable
cHCSON   equ   40h      ;reduce head current switch
cWRTEN   equ   80h      ;write enable

DRVSEC   equ   09h      ;drive sector position (in)
sNEWSEC   equ   01h      ;new sector flag (sector true)

DRVDATA   equ   0Ah      ;drive read/write data (in/out)


;-----------------------------
; BDOS equates
;-----------------------------
GETCH   equ   1      ;get character
PRINT   equ   9      ;display string
OPEN   equ   15      ;open file
READSEQ   equ   20      ;read sequential
DMA   equ   26      ;set address for file read
SETMULT   equ   44      ;set multi-record I/O


;-----------------------------
; RAM equates
;-----------------------------
TPA   equ   100h
DFFCB   equ   5Ch
STACK   equ   100h
BDOS   equ   5
WBOOTV   equ   00h      ;warm boot vector location
BDOSV   equ   05h      ;bdos entry vector location


;-----------------------------
; Misc equates
;-----------------------------
NUMCDEV   equ   4      ;number of character I/O devices
RDTRIES   equ   6      ;read tries (must be <= 8)
VFTRIES   equ   4      ;verify tries per write (must be <= 8)
WRTRIES   equ   3      ;track writes to try

UNDEF   equ   0FFh      ;undefined value
CR   equ   13      ;ascii for carriage return
LF   equ   10      ;ascii for line feed
EOF   equ   01Ah      ;ctrl-z


;------------------------------
; External references
;------------------------------
   maclib   CPM3      ;CP/M 3.0 disk definition macros
   maclib   Z80      ;Z80 translation macro library
   maclib   modebaud   ;Character I/O equates
   extrn   @civec,@covec,@aivec,@aovec,@lovec,@mxtpa

   cseg         ;Put DPBs in common memory


;------------------------------
; Disk Parameter Headers
;------------------------------
   ; DEFINE PUBLIC LABELS:
   PUBLIC   DPH0, DPH1      ;FLOPPY DISK PARAMETER HEADERS
   PUBLIC   bfDrive         ;Buffered drive
   PUBLIC   ckFlush         ;Disk buffer flush routine

   ; DEFINE EXTERNAL LABELS:
   EXTRN   @ADRV,@RDRV
   EXTRN   @DMA,@TRK,@SECT
   EXTRN   @CBNK
   EXTRN   @DBNK         ;BANK FOR DMA OPERATION
   EXTRN   @ERMDE         ;BDOS ERROR MODE
   EXTRN   ?WBOOT         ;WARM BOOT VECTOR
   EXTRN   ?SLDSK         ;SELECT DISK
   EXTRN   ?PMSG         ;PRINT MESSAGE @<HL> UP TO 00, SAVES [BC] AND [DE]
   EXTRN   ?PDERR         ;PRINT BIOS DISK ERROR HEADER
   EXTRN   ?CONIN,?CONO      ;CONSOLE IN AND OUT
   EXTRN   ?CONST         ;CONSOLE STATUS
   
; EXTENDED DISK PARAMETER HEADER FOR DRIVE 0:
   DW   fdWrite         ;FD SEC WRITE ROUTINE
   DW   fdRead         ;FD SEC READ ROUTINE
   DW   fdLogin         ;FLOPPY DISK "A:" LOGIN PROCEDURE
   DW   fdInit         ;FLOPPY DISK "A:" INITIALIZATION ROUTINE
   DB   0         ;RELATIVE DRIVE 0 ON THIS CONTROLLER
   DB   0         ;DRIVE TYPE (UNUSED BY CP/M)

dph0   dw   tranTbl,0,0,0,0,0,fd$dpb,csv0,alv0,fd$bcb,-1,-1
   db   0

; EXTENDED DISK PARAMETER HEADER FOR DRIVE 1:
   DW   fdWrite         ;FD SEC WRITE ROUTINE
   DW   fdRead         ;FD SEC READ ROUTINE
   DW   fdLogin         ;FLOPPY DISK "B:" LOGIN PROCEDURE
   DW   fdInit         ;FLOPPY DISK "B:" INITIALIZATION ROUTINE
   DB   1         ;RELATIVE DRIVE 1 ON THIS CONTROLLER
   DB   0         ;DRIVE TYPE (UNUSED BY CP/M)

dph1   dw   tranTbl,0,0,0,0,0,fd$dpb,csv1,alv1,fd$bcb,-1,-1
   db   0

; fd$dpb - Disk Parameter Block. This table gives a block size of 1024 bytes
;   and 64 directory entries.
fd$dpb   dw   NUMSEC      ;sectors per track
   db   BSH      ;allocation block shift factor (BSH)
   db   BLM      ;data location block mask (BLM)
   db   EXM      ;extent mask (EXM)
   dw   DSM      ;maximum block number (DSM 242)   
   dw   DRM      ;maximum directory entry number (DRM 63)
   db   AL0,AL1      ;AL0, AL1
   dw   CKS      ;CKS=(DRM+1)/4
   dw   RESTRK      ;reserved tracks for CPM and bootloader
   db   0      ;physical=logical sector (128 bytes)
   db   0      ;physical=logical sector (128 bytes)


; fd$bcb - Directory Buffer Control Block (BCB)
fd$bcb   db   0FFh      ;drive number (FF means not used yet)
   db   0,0,0      ;record position
   db   0      ;dirty (write) flag
   db   0      ;scratch byte
   dw   0      ;track
   dw   0      ;sector
   dw   dirBuf      ;buffer address
   dw   0      ;bank
   dw   0      ;link to next BCB (none)

   if MINIDSK
tranTbl   db   1,3,5,7,9,11,13,15,2,4,6,8,10,12,14,16
   endif

   if NOT MINIDSK
tranTbl   db   01,09,17,25,03,11,19,27,05,13,21,29,07,15,23,31
   db   02,10,18,26,04,12,20,28,06,14,22,30,08,16,24,32
   endif


;------------------------------------------------------------------
;  Floppy init (noop)
;------------------------------------------------------------------
fdInit:
   ret


;------------------------------------------------------------------
;  Floppy login (noop)
;------------------------------------------------------------------
fdLogin:
   ret


;----------------------------------------------------------------------------
; fdRead - Read sector BIOS entry. Read one sector using the @RDRV,
;    @TRK, @SECT, and @DMA previously specified.
;
; On Entry
;    @RDRV = drive to read from
;    @TRK  = track to read from
;    @SECT = sector number to read (0-31)
;    @DMA  = address of buffer to read into
;
; On Exit
;    If read successful
;   sector read into @DMA
;   HL = @DMA + CSECLEN
;   A=0, Z flag set true
;    Else
;   A=1, Z flag set false
;    Interrupts enabled
;    Clobbers all
;----------------------------------------------------------------------------

fdRead:
   call   decSec      ;convert to zero-index
   call   ckFlush      ;flush track buffer if needed
   ei         ;re-enable interrupts

   call   readTrk      ;fill track buffer if needed
   ei         ;re-enable interrupts
   jnz   exitDio      ;track read error, exit
   
   call   movRead      ;move sector to @DMA

exitDio   mvi   a,0      ;if zero is true, return zero
   rz

   inr   a      ;else return A<>0, Z false
   ret
   

;----------------------------------------------------------------------------
; fdWrite - Write sector BIOS entry. Write one sector using the @RDRV,
;    @TRK, @SECT and @DMA specified.
;
; On Entry
;    @RDRV = drive to write
;    @TRK  = track to write
;    @SECT = sector number to write (0-31)
;    @DMA  = address of buffer to write from
;
; On Exit
;    If successful
;   sector written to trkBuf from @DMA
;   A=0, Z flag set true
;    Else
;   A=1, Z flag set false
;    Interrupts enabled
;    Clobbers all
;----------------------------------------------------------------------------

fdWrite:
   call   decSec      ;convert to zero-index
   call   ckFlush      ;flush track buffer if needed
   ei         ;re-enable interrupts

   call   readTrk      ;fill track buffer if needed
   ei         ;re-enable interrupts
   jnz   exitDio      ;track read error, exit

   jmp   movWrt      ;move @DMA to sector and exit
   

;----------------------------------------------------------------------------
; movRead - Move sector data from track buffer to @DMA for a
;    CPM read request
;
; On Entry
;    @TRK  = track to read
;    @SECT = sector number to read (0-31)
;    @DMA  = address of buffer to read into
;
; On Exit
;    If successful (good sector)
;   sector data moved to @DMA, Z flag set true
;   HL = @DMA + CSECLEN
;    Else (sector flagged as bad)
;   Z flag set false
;    Clobbers all
;----------------------------------------------------------------------------

movRead:
   call   altSkew      ;@SECT to hard sector in A
   call   dSecAdr      ;HL->sector in trkBuf
   
   mov   a,m      ;A=sector valid flag
   ora   a
   rnz         ;bad sector, return error
   
   lxi   d,DATDATA+1   ;DE=offset to data portion of sector
   lda   @TRK      ;on a data track?
   cpi   DATATRK
   jnc   mrMove      ;yes, data track (DE already correct)
   
   lxi   d,SYSDATA+1   ;DE=offset to data portion of sector

mrMove   dad   d      ;HL->data portion of sector
   xchg         ;DE->data portion of sector
   lhld   @DMA      ;HL->destination for data
   mvi   b,CSECLEN   ;B=number of bytes to move
   
mrLoop   ldax   d      ;move sector from trkBuf to @DMA
   mov   m,a
   inx   h      ;increment pointers
   inx   d
   dcr   b      ;loop count
   jnz   mrLoop

   ret         ;exit with zero   status
   

;----------------------------------------------------------------------------
; movWrt - Move sector data from @DMA to track buffer and create
;    metadata for the sector for a CPM write request.
;
; On Entry
;    @TRK  = track to write
;    @SECT = sector number to write (0-31)
;    @DMA  = address of buffer to write from
;
; On Exit
;    Sector data moved to trkBuf from @DMA
;    A=0, Z status true
;    Clobbers all
;----------------------------------------------------------------------------

movWrt:
   call   altSkew      ;@SECT to hard sector in A
   call   dSecAdr      ;HL->sector in trkBuf
   
   mvi   m,0      ;flag sector as good
   
   inx   h      ;HL->track
   lda   @TRK      ;A=track
   ori   80h      ;set sync bit
   mov   m,a      ;set track in sector
   
   inx   h      ;HL->byte after track
   cpi   DATATRK+80h   ;on a system or data track?
   jnc   wDatTrk      ;data track 6-76 (mini disk 4-34)

; Create Altair sector for system tracks 0-5 (mini disk 0-3)

   xra   a      ;put 0100h (16 bit) at offset 1,2
   mov   m,a
   inx   h      ;HL->offset 2
   inr   a      ;A=1
   mov   m,a
   
   inx   h      ;HL->128 byte CPM sector in Altair sector
   call   mwMove      ;move @DMA to sector in trkBuf
   
   mvi   m,0FFh      ;offset 131 is stop byte (0FFh)
   
   inx   h      ;offset 132 is checksum
   mov   m,b      ;store checksum at offset 132
   
   jmp   mwExit      ;exit

; wDatTrk- Create Altair sector for tracks 6-76 (mindisk 4-34)

wDatTrk:
   lda   @SECT      ;A = sector (low byte) before Altair skew
   mov   m,a      ;store Altair logical sector number
   
   inx   h      ;HL->offset 2 in sector
   xra   a      ;store zero at offsets 2-6
   mov   m,a      ;offset 2
   
   inx   h
   mov   m,a      ;zero at offset 3
   
   inx   h
   push   h      ;save address of offset 4 = checksum
   
   inx   h
   mov   m,a      ;zero at offset 5
   
   inx   h
   mov   m,a      ;zero at offset 6
   
   inx   h      ;HL->128 byte CPM sector in Altair sector
   call   mwMove      ;move @DMA to sector in trkBuf

   mvi   m,0FFh      ;offset 135 is stop byte (0FFh)
   
   pop   h      ;HL->checksum byte in Altair sector
   mov   m,b      ;store the checksum
   
; mwExit - set dirty flag true, return success status

mwExit:
   mvi   a,0FFh      ;set dirty flag true
   sta   bfDirty
   
   xra   a      ;return success status
   ret


;------------------------------------------------------------------------------
; mwMove - Move sector buffer (128 bytes) from @DMA to (HL) as part
;   of a CPM write command. Compute checksum on all bytes moved and return
;   the checksum in B.
;
; On Entry
;    HL->destination sector in trkBuf
;    @DMA = address of buffer to move from
;
; On Exit
;    128 bytes moved from @DMA to (HL)
;    HL = HL + 128
;    B = checksum of the 128 bytes moved
;    Clobbers all
;------------------------------------------------------------------------------

mwMove:
   xchg         ;DE->destination CPM sector in trkBuf
   lhld   @DMA      ;HL->source buffer
   lxi   b,CSECLEN   ;B=checksum (0), C=128 byte count
   
mwLoop:   mov   a,m      ;move from (HL) to (DE)
   stax   d
   
   add   b      ;add byte to checksum
   mov   b,a
   
   inx   d      ;increment both pointers
   inx   h
   dcr   c      ;decrement character count
   jnz   mwLoop      ;loop until count = 0
   
   xchg         ;return with buffer pointer in HL   
   ret


;----------------------------------------------------------------------------
; decSec - Decrement sector count to convert 1-indexed CPM physical
;    sector to 0-indexed hardware-layer physical sector. 
;
; On Entry
;    @SECT = 1-indexed sector number
;
; On Exit
;    @SECT = 0-indexed sector number
;    Clobbers A
;----------------------------------------------------------------------------
decSec:
   lda   @SECT      ;A = sector (low byte)
   dcr   a      ;decrement to convert to zero indexed
   sta   @SECT
   ret
   

;----------------------------------------------------------------------------
; altSkew - Perform Altair skew on the sector number in secNum and return
;    the result in A. The skew is based on the track as:
;
;   Tracks 0-5, secOut = secIn
;   Tracks 6-76, secOut = (secIn * 17) MOD 32
;
;    The skew computation for tracks 6-76 is implemented as:
;   secOut = secIn if secIn is even
;   secOut = secIn XOR 10h if secIn is odd
;
; On Entry
;    @TRK  = current track
;    @SECT = sector number (0-31)
;
; On Exit
;    A = sector number after Altair skew
;    Clobbers A,B
;----------------------------------------------------------------------------   

altSkew   equ   $

   if MINIDSK
   lda   @SECT      ;A = sector (low byte)
   ret         ;no skewing done for mini disk
   endif

   if NOT MINIDSK
   lda   @TRK      ;on a data track?
   cpi   DATATRK
   lda   @SECT      ;A = unmodified sector number (low byte)
   rc         ;system track, no change to sector
   
   mov   b,a      ;save sector number in B
   rrc         ;test for even/odd
   mov   a,b      ;restore sector number in A
   rnc         ;return with sector number if even
   
   xri   10h      ;else translate as in comments above
   ret
   endif
      

;----------------------------------------------------------------------------
; readTrk- read full track into track buffer if the requested
;    drive (@RDRV) or track (@TRK) does not match the buffered
;    drive (bfDrive) or buffered track (bfTrack). The status byte
;    at the start of each sector is set to zero if the sector is
;    good, non-zero if the sector couldn't be read.
;
; On Entry
;    @RDRV = drive to read
;    @TRK  = track to read
;    bfDrive = drive from which trkBuf was filled
;    bfTrack = track from which trkBuf was filled
;
; On Exit
;    @TRK on @RDRV read into trkBuf
;    Zero true if track read or already there, zero false otherwise
;    Clobbers all
;----------------------------------------------------------------------------

readTrk:
   lhld   bfDrive      ;L=buffered drive, H=buffered track

   lda   @RDRV      ;A=requested drive
   cmp   l      ;same drive buffered?
   jnz   rtNew      ;drive doesn't match, need a new buffer

   lda   @TRK      ;A=requested track
   cmp   h      ;same track buffered?
   rz         ;yes, already have this buffer

; rtNew - New track needs to be read

rtNew:
   mvi   a,UNDEF      ;invalidate buffered data
   sta   bfDrive
   
   call   dSelDrv      ;select drive, load head
   rnz         ;drive select failed, exit with error

   mvi   a,2      ;init restore/seek try counter
   sta   skRetry
   
rtRtry:   call   dSeek      ;seek to trkNum (disables interrupts)
   rnz         ;a restore was required and failed
   
   call   initTrk      ;init all sectors to "bad" (not read)
   lxi   d,RDTRIES*NUMSEC*256 + NUMSEC
            ;D=max sector reads = RDTRIES revolutions
            ;E=sectors remaining to fill


; Read sector loop - All sectors are originally marked "bad" (unread) and
;    a sector counter in E is started at NUMSEC (a full track of sectors).
;    Sectors are read until sector counter E reaches zero or the total
;    reads counter in D reaches zero (RDTRIES revolutions). The 1st time
;    the total reads counter reaches zero, a restore and re-seek is
;    performed in case we're on the wrong track. The second time it reaches
;    zero, the bad sectors remain marked as bad in the track buffer.

; Within dRead, 152 cycles execute after the last byte is read until we're
;    executing the instruction here following the dRead call. An additional
;    78 cycles are executed here until we're in dNxtSec looking for sector
;    true. This totals 230 cycles (115us) from the last byte read until
;    we're hunting for sector true. Allowing for 200us of index alignment
;    error and 10% speed variance, we have at least 180us to get this done.

; For the Mini Disk, a full track is 16 sectors instead of 32 and the time
;    available after a sector is read is well over 1000us, so timing is not
;    an issue.

rdLoop:
   call   dNxtSec      ;(17) wait for next sector, HL->sector buf
   mov   a,m      ;A=sector flag byte
   ora   a      ;this sector already read?
   jz   rdNext      ;yes, skip it

   push   h      ;save sector address
   inx   h      ;HL->1st read location in sector
   call   dRead      ;read the sector
   pop   h      ;(10) restore sector address in HL
   jnz   rdNext      ;(10) read error

   xra   a      ;(4) set sector flag to zero (good sector)
   mov   m,a      ;(7)

   dcr   e      ;(5) decrement sectors left to fill
   jz   rtExit      ;(10) all sectors read without error

rdNext:   dcr   d      ;(5) decrement total sectors counter
   jnz   rdLoop      ;(10) go read next sector

   lxi   h,skRetry   ;HL->seek retry counter
   dcr   m      ;decrement the counter
   jz   rtExit      ;re-seek(s) done, we're finished

   call   dRestor      ;restore to track zero
   jz   rtRtry      ;start over after the re-seek

   ret         ;else, exit with error

rtExit:   lhld   @RDRV      ;L=@RDRV, H=@TRK
   shld   bfDrive      ;set the buffered drive and track values
   ret         ;exit with Z flag true


;----------------------------------------------------------------------------
; initTrk - Set the flag byte in each sector in trkBuf to "bad" to
;    indicate none of the sectors have been read.
;
; On Entry
;
; On Exit
;    All sectors in trkBuf marked "bad" (unread)
;    Clobbers all
;----------------------------------------------------------------------------

initTrk:
   lxi   b,UNDEF*256 + NUMSEC;  B=UNDEF (bad), C=NUMSEC
   lxi   h,trkBuf   ;HL->track buffer
   lxi   d,TSECLEN   ;DE=length of each sector in track buffer

itLoop:   mov   m,b      ;mark sector as bad (not read)
   dad   d      ;HL->next sector in trkBuf
   dcr   c      ;repeat for all sectors
   jnz   itLoop
   
   ret


;----------------------------------------------------------------------------
; ckFlush - Check if track buffer should be flushed. This
;    function must be called before any drive selection or seek
;    operation. The buffer is flushed if the bfDirty flag is
;    set and the drive or track number are different than the
;    buffered track.
;
; On Entry
;    Drive still selected and on same track as in trkBuf
;    @RDRV, @TRK updated for the new I/O call
;
; On Exit
;    Zero true for no error, zero false if write error occurred
;    Clobbers all
;----------------------------------------------------------------------------

ckFlush:
   lda   bfDirty      ;see if track buffer is dirty
   ora   a
   rz         ;no, exit with Z set

   lhld   bfDrive      ;L=buffered drive, H=buffered track
   lda   @RDRV      ;A=requested drive number
   cmp   l      ;same drive?
   jnz   wrtTrk      ;no, flush

   lda   @TRK      ;A=requested track number
   cmp   h      ;same track?
   rz         ;yes, no need to flush

wrtTrk   equ   $

   if MINIDSK
   mvi   a,cRESTMR   ;restart motor timeout
   out   DRVCMD
 
   lda   curDrv      ;make sure current drive still enabled
   out   DRVSLCT
   endif

   mvi   e,cWRTEN   ;E=write command, normal head current
   mvi   a,42      ;tracks 0-42 are normal head current
   cmp   h      ;compare 42 - current track
   jnc   wrtInit      ;track is 0-42, E is correct
   
   mvi   e,cWRTEN+cHCSON   ;E=write command with reduced current
   
wrtInit   xra   a      ;clear buffer dirty flag
   sta   bfDirty

   mvi   a,WRTRIES   ;initialize write retry count
   sta   wrRetry

   di         ;disable interrupts


; rtryWrt - Write track retry entry point. Write a full track starting
;    with any sector. Don't write sectors that are flagged as bad.

rtryWrt:
   mvi   d,NUMSEC   ;D=count of sectors to write
   xra   a      ;zero the count of sectors actually written
   sta   secCnt

wrtLoop   call   dNxtSec      ;(78) wait for next sector, HL->sector buf
   mov   a,m      ;(7) check sector flag
   ora   a      ;(4)
   jnz   wrtNext      ;(10) skip if bad or previously verified
   
   mov   a,e      ;(5) issue write command to drive
   out   DRVCMD      ;(10) at 114 cycles 57us
   
   inx    h      ;point to 1st byte of sector
   call   dWrite      ;write the sector

   lxi   h,secCnt   ;count number of sectors written   
   inr   m

wrtNext   dcr   d      ;decrement write sector count
   jnz   wrtLoop      ;loop until all sectors processed

   call   dNxtSec      ;force a 1 sector delay for trim erase
   mvi   d,NUMSEC*VFTRIES   ;D=maximum number of sector reads
   
vfyLoop   call   dNxtSec      ;wait for next sector, HL->sector buf
   mov   a,m      ;test sector flag, only good and
   ora   a      ;   not previously verified sectors
   jnz   vfyNext      ;   are verified
      
   push   h      ;save pointer to sector flag
   inx   h      ;point to 1st byte of sector
   call   dVerify      ;verify the sector
   pop   h      ;HL->sector flag for current sector
   jnz   vfyNext      ;didn't match
   
   mvi   m,UNDEF      ;set flag to indicate sector is verified

   lxi   h,secCnt   ;HL->sectors left to verify
   dcr   m      ;decrement the count
   rz         ;track verified, exit

vfyNext   dcr   d      ;decrement sector count
   jnz   vfyLoop      ;loop until all verify tries expired

; Read re-tries expired, decrement the write retry count and write again

   lxi   h,wrRetry   ;decrement the write retry counter
   dcr   m
   jnz   rtryWrt      ;retry starting with the write

   call   ?pMsg
   db   CR,LF,'Delayed Write Error', CR, LF, 0

   inr   a
   ret         ;exit with 1 for error
   

;****************************************************************************
;
; Altair disk I/O routines
;
;****************************************************************************

;---------------------------------------------------------------------------
; dSelDrv - Select the drive specified in @RDRV and load the head.
;    Save the track (curTrk) the current drive is on into the track table,
;    load curTrk for the new drive from the track table.
;
; On Entry
;    @RDRV = drive to be selected
;    curDrv = drive currently selected
;    selTime = timeout in seconds to wait for drive select
;    curTrk = track the current drive is on
;
; On Exit
;    Drive selected and head loaded
;    curDrv = @RDRV
;    curTrk = track the newly selected drive is on
;    Zero true for success, zero false for error
;    Clobbers all
;---------------------------------------------------------------------------

dSelDrv   equ   $

   if MINIDSK
   mvi   a,cRESTMR   ;restart motor timeout
   out   DRVCMD
   endif

   lxi   h,curDrv   ;HL->currently selected drive
   mov   e,m      ;E=currently selected drive

   lda   @RDRV      ;A=desired drive
   mov   c,a      ;save new drive in C
   cmp   e      ;same or different drive?
   jnz   dNewDrv      ;different, go select a new drive

   in   DRVSTAT      ;drive still selected and enabled?
   ani   sDSKEN
   jz   dSelExt      ;yes, exit

   jmp   dReSel      ;otherwise, re-select the drive


; dNewDrv - Save current track (curTrk) for the current drive to the track
;    table, load curTrk for the new drive from the track table

dNewDrv   mov   m,c      ;save new drive in curDrv
   
   mvi   d,0      ;DE=currently selected drive
   lxi   h,trkTbl   ;HL->track table
   dad   d      ;HL->trkTbl entry for current drive

   lda   curTrk      ;A=track current drive is on
   mov   m,a      ;save it in the track table

   lxi   h,trkTbl   ;HL->track table
   mov   e,c      ;DE=offset in trkTbl for new drive
   dad   d      ;HL->trkTbl for new drive

   mov   a,m      ;A=track new drive is on
   sta   curTrk      ;update current track

; Select the new drive with the timeout specified in selTime

dReSel   lxi   h,selTime   ;move select timeout in seconds into B
   mov   b,m

dSelLp1   lxi   h,25641      ;HL=count of 78 cycle loops for 1 second

dSelLp   mvi   a,cDSLCT   ;(7) deselect a possibly attached drive
   out   DRVSLCT      ;(10)

   mov   a,c      ;(5) A=drive to select
   out   DRVSLCT      ;(10) select it

   in   DRVSTAT      ;(10) did drive select work?
   ani   sDSKEN      ;(7)
   jz   dSelExt      ;(5) yes, exit

   dcx   h      ;(5) decr 1 sec counter
   mov   a,h      ;(5) test HL counter for zero
   ora   l      ;(4)
   jnz   dSelLp      ;(10) loop for one second

   dcr   b      ;decrement seconds expired
   jnz   dSelLp1      ;repeat for a new 1 second

   inr   a      ;timeout, return non-zero
   ret

dSelExt   mvi   a,cHDLOAD   ;issue head load command
   out   DRVCMD      ;restarts timeout for mini disk
 
   ret         ;return with zero status


;---------------------------------------------------------------------------
; dSeek - Seek to track in @TRK
;
; On Entry
;    Drive selected and ready
;    @TRK   = desired track
;    curTrk = current track, UNDEF means we don't know
;
; On Exit
;    curTrk = @TRK
;    Interrupts disabled
;    Zero true for success, zero false for failure
;   (failure is a failed restore to track zero)
;    Clobbers A,B,C,H,L
;---------------------------------------------------------------------------

dSeek   di         ;disable interrupts
   lda   curTrk      ;A=current track
   cpi   UNDEF      ;valid track number?
   jnz   dTrkVld      ;yes, track is valid

   call   dRestor      ;otherwise, restore to track zero
   rnz         ;exit if restore failed

; dTrkVld - Current track is valid, compute direction and number
;     of steps

dTrkVld   lxi   h,@TRK      ;HL<-@TRK
   sub   m      ;A=current-requested
   rz         ;return if already on correct track

   mvi   b,cSTEPO   ;B=step out (assume requested<current)
   jnc   dDoSeek      ;it is
   
   mvi   b,cSTEPI   ;B=step in (requested>current)
   cma         ;compute A=-A
   inr   a

; Save target track in curTrk, step there, then verify track

dDoSeek   mov   c,a      ;C=number of steps

   mov   a,m      ;save new track in curTrk
   sta   curTrk
   
   call   dStep      ;do the seek
   xra   a      ;return zero
   ret
   

;---------------------------------------------------------------------------
; dRestor - Restore to track 0 and then delay to ensure any subsequent
;    seek meets the minimum direction change period.
;
; On Entry
;    Drive selected and ready
;
; On Exit
;    If successful
;       curTrk = 0
;   A=0
;   Zero true
;    else
;       curTrk = UNDEF
;       Zero false
;    Clobbers A,B,C
;---------------------------------------------------------------------------

dRestor   xra   a
   sta   curTrk      ;set current drive track to zero

   in   DRVSTAT      ;test for track 0
   ani   sTRACK0
   rz         ;at track 0, exit

; Step in three tracks, then step out to track 0

   mvi   c,3      ;C=step in 3 tracks
   mvi   b,cSTEPI   ;B=step in command
   call   dStep      ;do 3 steps in

   mvi   a,20      ;20ms delay puts us past the 1ms step window
   call   delayMs      ;  and ensures proper dir change delay

; Seek back out until track 0 detected

   mvi   c,NUMTRK+10   ;C=maximum number of step outs to try
   mvi   b,cSTEPO   ;B=step out command
   call   dStep      ;step until track 0 detected
   jnz   drFail      ;restore failed

   mvi   a,20      ;20ms delay puts us past the 1ms step window
   call   delayMs      ;  and ensures proper dir change delay   
   ret         ;return with zero

drFail   mvi   a,UNDEF      ;restore failed, track is still undefined
   sta   curTrk
   ret         ;return with non-zero


;---------------------------------------------------------------------------
; dStep - Step head number of steps in C, direction command in B.
;   If track zero is detected during a step-out operation, curTrk
;   is forced to zero and zero is returned in A.
;
; On Entry
;    C = number of steps > 0
;    B = step command (cSTEPO or cSTEPI)
;
; On Exit
;    If stepping out and track zero hit
;   curTrk = 0
;   A = 0
;   Zero true
;    else
;   Zero false
;    Clobbers A,B,C
;---------------------------------------------------------------------------

dStep   in   DRVSTAT      ;loop until OK to move the head
   ani   sMOVEOK
   jnz   dStep

   in   DRVSTAT      ;see if we are at track 0
   ani   sTRACK0      ;at track zero?
   jnz   dStep1      ;no, go on

   mov   a,b      ;stepping out?
   sbi   cSTEPO
   jz   dStep0      ;yes, we've hit track 0

dStep1   mov   a,b      ;A=step command and direction
   out   DRVCMD      ;issue the step   

   dcr   c      ;decrement step counter
   jnz   dStep      ;loop until count reaches zero

   inr   c      ;force non-zero
   ret

dStep0   sta   curTrk      ;curTrk=0
   ret         ;return with zero true and A=0


;---------------------------------------------------------------------------
; dNxtSec - Wait for next (any) sector. Returns pointer to the sector
;    buffer within trkBuf. Control is back to caller at 78 cycles (39us).
;
; On Entry
;    Drive is selected, head loaded
;
; On Exit
;    HL->sector buffer in trkBuf for sector found
;    Clobbers A,B,C,H,L
;---------------------------------------------------------------------------

dNxtSec   equ   $

   if MINIDSK
   mvi   a,cRESTMR   ;restart motor timeout
   out   DRVCMD
   endif

dnLoop   in   DRVSEC      ;read sector position register
   rar         ;wait for sector true (0=true)
   jc   dnLoop
   
   ani   SECMASK      ;(7) get sector number alone
            ;fall into dSecAdr


;---------------------------------------------------------------------------
; dSecAdr - Convert hard sector in A to address within trkBuf for
;    the specified sector
;
; On Entry
;    A = Hard sector number
;
; On Exit
;    HL->sector buffer in trkBuf
;    Clobbers A,B,C,H,L
;---------------------------------------------------------------------------

dSecAdr   lxi   h,secAddr     ;(10) HL->sector address table
   mvi   b,0      ;(7) form BC=sector*2
   rlc         ;(4) A=sector*2 (2 bytes per table entry)
   mov   c,a      ;(5) BC=sector*2
   dad   b      ;(10) HL->address table entry for passed sector
   
   mov   a,m      ;(7) A=lsb of sector buffer address
   inx   h      ;(5)
   mov   h,m      ;(7) H=msb of sector buffer address
   mov   l,a      ;(5) HL->sector buffer
   ret         ;(11)


;----------------------------------------------------------------------------
; delayMs - Delay for number of ms specified in A
;
; On Entry
;    A = ms to delay
;
; On Exit
;    A=0
;    Zero true
;    Clobbers A,B
;----------------------------------------------------------------------------

delayMs   mvi   b,(2000/19)   ;19 cycles in the loop below

delayLp   nop         ;(4)
   dcr   b      ;(5)
   jnz   delayLp      ;(10)

   dcr   a      ;decrement ms counter
   jnz   delayMs
   ret


;---------------------------------------------------------------------------
; dRead - Read a sector, verify checksum, stop byte, and track number.
;    Verification is done after the sector is read in the time between
;    the last byte of the sector and before the start of the next sector.
;    With index alignment and rotation speed tolerance accounted for,
;    we safely have 360 cycles from the last byte of the sector until code
;    should be in the sector true hunt loop. The RET is complete from this
;    routine 152 cycles worst case after the last byte is read.
;
; On Entry
;    Drive is selected, sector true just detected
;    HL->sector buffer
;
; On Exit
;    Sector read to (HL)
;    C = track number from disk with sync bit set
;    Zero true if no error, Zero false for checksum error, missing
;   FF stop byte, or track number error
;    Clobbers A,B,C,H,L
;---------------------------------------------------------------------------

dRead   push   h      ;(11) save pointer to start of sector

   lxi   b,256+DSECLEN   ;(10) B=chksum (-FF), C=bytes to read
   lda   curTrk      ;(13) A=track we're on
   cpi   DATATRK      ;(7) data track or system track?
   jnc   drSecWt      ;(10) data track, length in C is correct

   mvi   c,SSECLEN   ;(7) C=length of a system sector


; The sector transfer loop is 116 cycles for two bytes read (has to be
;     less than 128) and computes checksum over all bytes read. For the
;     mini disk, only one byte is read per loop iteration.

drSecWt   in   DRVSTAT      ;(10) get drive status byte
   ora   a      ;(4) wait for NRDA flag true (zero)
   jm   drSecWt      ;(10)

   if NOT MINIDSK      ;8" reads two bytes per loop
   in   DRVDATA      ;(10) read first byte at 24-48 cycles
   mov   m,a      ;(7) store in buffer
   add   b      ;(4) update checksum
   mov   b,a      ;(5) keep checksum in B
   inx   h      ;(5) increment buffer pointer
   dcr   c      ;(5) decrement byte count
   jz   drSecDn      ;(10) exit if done
   endif

   in   DRVDATA      ;(10) read at 70-94 cycles (data at 64 and 128)
   mov   m,a      ;(7) store in buffer
   add   b      ;(4) update checksum
   mov   b,a      ;(5) keep checksum in B
   inx   h      ;(5) increment buffer pointer
   dcr   c      ;(5) decrement byte count
   jnz   drSecWt      ;(10) repeat until done


; drSecDn - Sector read is complete, now validate the sector based on whether
;   it is from a system track or data track.

drSecDn   lda   curTrk      ;(10) A=track we're supposed to be on
   cpi   DATATRK      ;(7) system or data track?
   jnc   drDatTk      ;(10) data track


; Validate a system track sector. A system track sector is three bytes
;    bytes shorter, so this codes starts 3*64 cycles sooner than for a
;    data sector. This code completes before a data sector would even
;    finish reading. Therefore, a data sector is the worst timing path.

   mov   a,b      ;(5) A=calculated checksum over all bytes
   dcx   h      ;(5) HL->checksum in sector
   sub   m      ;(7) subtract from computed checksum
   sub   m      ;(7) final sum will be zero

   dcx   h      ;(5) HL->stop byte
   mov   b,m      ;(7) B=stop byte
   pop   h      ;(10) restore HL->start of buffer
   inr   b      ;(4) was FF stop byte there?
   rnz         ;(5/11) no, return error

   mov   c,m      ;(7) C=track number from disk
   sub   c      ;(4) take track out of checksum

   inx   h      ;(5) HL->2nd byte of sector
   sub   m      ;(7) take out of checksum
   
   inx   h      ;(5) HL->3rd byte of sector
   jmp   drExit      ;(10) do common compares and exit


; Validate a data track sector (125 + 27 cycles for sector type jump)

drDatTk   dcx   h      ;(5) HL->stop byte
   mov   a,m      ;(7) A=stop byte
   pop   h      ;(10) restore HL->start of buffer
   inr   a      ;(4) was FF stop byte there?
   rnz         ;(5/11) no, return error

   mov   a,b      ;(5) A=calculated checksum over all bytes
   mov   c,m      ;(7) C=track number from disk
   sub   c      ;(4) take track out of checksum

   inx   h      ;(5) HL->sector number
   sub   m      ;(7) take out of checksum
   
   inx   h      ;(5) move to checksum byte
   inx   h      ;(5)
   inx   h      ;(5) HL->checksum
   
   sub   m      ;(7) subtract from checksum
drExit   sub   m      ;(7) checksums match?
   rnz         ;(5/11) no, exit with error
   
   lda   curTrk      ;(10) A=track we should be on
   ori   80h      ;(7) set sync bit
   cmp   c      ;(4) same track as from sector?
   ret         ;(11) exit with compare status


;---------------------------------------------------------------------------
; dVerify - Verify a sector
;    The 2nd read at 67 cycles only gives 3 cycles of headroom (67-64)
;    which, in turn, gives about 4% speed tolerance. However, we are
;    verifying our  own write, so the primary tolerance issue is ISV,
;    not the average rotation rate, so tolerance is still within the
;    +/-1.5% ISV spec.
;
; On Entry
;    Drive is selected, sector true just detected
;    HL->sector buffer to compare against
;
; On Exit
;    Zero true if match, zero false for error
;    Clobbers A,B,C,H,L
;---------------------------------------------------------------------------

dVerify lxi   b,DSECLEN   ;(10) B=0, C=data sector length
   lda   curTrk      ;(13) A=track we're on
   cpi   DATATRK      ;(7) data track or system track?
   jnc   dVfLoop      ;(10) data track, length in C is correct

   mvi   c,SSECLEN   ;(7) set C=length of a system sector

dVfLoop   in   DRVSTAT      ;(10) get drive status byte
   ora   a      ;(4) wait for NRDA flag true (zero)
   jm   dVfLoop      ;(10)

   if NOT MINIDSK      ;8" reads two bytes per loop
   in   DRVDATA      ;(10) read first byte at 24-48 cycles
   xra   m      ;(4) verify data matches buffer
   ora   b      ;(4) accumulate errors in b
   mov   b,a      ;(5)

   inx   h      ;(5) increment buffer pointer
   dcr   c      ;(5) decrement characters remaining counter
   jz   dVfDone      ;(10) done verifying bytes
   endif

   in   DRVDATA      ;(10) read 2nd byte at 67-91 cycles
   xra   m      ;(4) verify data matches buffer
   ora   b      ;(4) accumlate errors in b
   mov   b,a      ;(5)

   inx   h      ;(5) increment buffer pointer
   dcr   c      ;(5) decrement byte counter
   jnz   dVfLoop      ;(10) loop for all bytes

dVfDone   ora   a      ;A=zero if all bytes matched
   ret         ;return status


;---------------------------------------------------------------------------
; dWrite - Write a sector
;    The write loop is 61 cycles which gives just 3 cycles (64-61) of
;    headroom. However, since the write timing required by the FDC board
;    is derived from the 2 MHz CPU/bus clock, this loop is always exactly
;    in sync with the FDC write timing. 3 cycles of headroom is plenty.
;
; On Entry
;    Drive is selected, sector true just detected, and
;   the write command has already been issued
;    HL->sector buffer to write
;
; On Exit
;   Clobbers A,C,H,L
;---------------------------------------------------------------------------

dWrite   mvi   c,DSECLEN   ;C=number of bytes to write
   lda   curTrk      ;(13) A=track we're on
   cpi   DATATRK      ;(7) data track or system track?
   jnc   dWrLoop      ;(10) data track, length in C is correct

   mvi   c,SSECLEN   ;(7) set C=length of a system sector

dWrLoop   in   drvStat      ;(10) read drive status register
   rrc         ;(4) wait for ENWD flag (zero)
   jc   dWrLoop      ;(10)

   mov   a,m      ;(7) A=next byte to write
   out   drvData      ;(10) write 2nd byte at 68-92 cycles
   inx   h      ;(5) increment buffer pointer
   dcr   c      ;(5) decrement bytes remaining
   jnz   dWrLoop      ;(10) loop until all bytes written

dWrDone   in   drvStat      ;wait for another write flag
   rrc
   jc   dWrDone
   
   xra   a      ;write a trailing zero
   out   drvData
   ret


;******************************************************************************
;
;   BIOS Data Area
;
;******************************************************************************

;---------------------------------------------------------------------------
; secAddr - Sector address table. Returns sector buffer address within
;    the track buffer when indexed by hard sector number. Each sector
;    requires TSECLEN bytes.
;---------------------------------------------------------------------------

secAddr   dw   trkBuf+00*TSECLEN,trkBuf+01*TSECLEN,trkBuf+02*TSECLEN
   dw   trkBuf+03*TSECLEN,trkBuf+04*TSECLEN,trkBuf+05*TSECLEN
   dw   trkBuf+06*TSECLEN,trkBuf+07*TSECLEN,trkBuf+08*TSECLEN
   dw   trkBuf+09*TSECLEN,trkBuf+10*TSECLEN,trkBuf+11*TSECLEN
   dw   trkBuf+12*TSECLEN,trkBuf+13*TSECLEN,trkBuf+14*TSECLEN
   dw   trkBuf+15*TSECLEN

   if NOT MINIDSK
   dw   trkBuf+16*TSECLEN,trkBuf+17*TSECLEN,trkBuf+18*TSECLEN
   dw   trkBuf+19*TSECLEN,trkBuf+20*TSECLEN,trkBuf+21*TSECLEN
   dw   trkBuf+22*TSECLEN,trkBuf+23*TSECLEN,trkBuf+24*TSECLEN
   dw   trkBuf+25*TSECLEN,trkBuf+26*TSECLEN,trkBuf+27*TSECLEN
   dw   trkBuf+28*TSECLEN,trkBuf+29*TSECLEN,trkBuf+30*TSECLEN
   dw   trkBuf+31*TSECLEN
   endif


;----------------------------------------------------------------------------
; Initialized data
;----------------------------------------------------------------------------

selTime   db   7      ;drive select timeout in seconds

coldSt   db   0FFh      ;FF during cold start, 0 otherwise

curDrv   db   0      ;drive number currently selected
curTrk   db   UNDEF      ;track the selected drive is on
trkTbl   db   UNDEF,UNDEF,UNDEF,UNDEF      ;track each drive is on

bfDirty   db   0      ;non-zero if buffer has been written to
bfDrive   db   UNDEF      ;drive currently in track buffer
bfTrack   db   UNDEF      ;currently buffered track (MUST follow bfDrive)


;----------------------------------------------------------------------------
; Non-initialized data
;----------------------------------------------------------------------------

secCnt   ds   1      ;count of bad sectors remaining in trkBuf
wrRetry   ds   1      ;write retry counter
skRetry   ds   1      ;restore and seek retry counter


;-----------------------------------------------------------------------------
;  Disk scratchpad areas defined in the DPH table
;-----------------------------------------------------------------------------

dirBuf   ds   128      ;BDOS directory scratchpad
alv0   ds   (DSM/8 + 1)   ;allocation vector storage
csv0   ds   CKS      ;change disk scratchpad
alv1   ds   (DSM/8 + 1)
csv1   ds   CKS


;-----------------------------------------------------------------------------
; Track buffer. One extra byte is allocated at the start of each sector
;    to flag a bad sector (read failure). This byte is zero if the sector
;    is good, non-zero if the sector is bad.
;-----------------------------------------------------------------------------

trkBuf   ds   NUMSEC*TSECLEN


   end


IDE3.asm:
Code: Select all
   TITLE   'IDE MODULE FOR CP/M 3.0'

   ; IDE3.ASM  v.1.0  02/22/2023

   ; Written by Wayne Parham  (wayne@parhamdata.com)

   ; IDE disk device driver module for Altair computers.
   ; Supports the IDE-CF controller provided by
   ; S100computers.com.

   ; John Monahan designed the controller board and wrote
   ; a version of BIOS for his Z80-based systems.  The IDE
   ; interface was based on a design from Peter Faasse.
   ; Another important contributor is David Fry who recognized
   ; that the original format left "holes" on the disk because
   ; it skipped sectors in the LBA translation.

   ; This version is a re-write that takes all of those things
   ; and incorporates them in an 8080-compatible format that
   ; runs on an original Altair and compatible computers.

;INCLUDE CP/M 3.0 DISK DEFINITION MACROS:
MACLIB   CPM3

;INCLUDE Z-80 MACRO LIBRARY:
MACLIB   Z80

;Ports for 8255 chip. Change these to specify where the 8255 is addressed,
;and which of the 8255's ports are connected to which IDE signals.
;The first three control which 8255 ports have the control signals,
;upper and lower data bytes.  The last one is for mode setting for the
;8255 to configure its ports, which must correspond to the way that
;the first three lines define which ports are connected.

IDEportA   EQU   030H      ;lower 8 bits of IDE interface
IDEportB   EQU   031H      ;upper 8 bits of IDE interface
IDEportC   EQU   032H      ;control lines for IDE interface
IDEportCtrl   EQU   033H      ;8255 configuration port
IDEDrive   EQU   034H   ;Bit 0 - 0 for drive 0 and 1 for drive 1

READcfg8255   EQU   10010010b   ;Set 8255 IDEportC out, IDEportA/B input
WRITEcfg8255   EQU   10000000b   ;Set all three 8255 ports output

;IDE control lines for use with IDEportC.  Change these 8
;constants to reflect where each signal of the 8255 each of the
;IDE control signals is connected.  All the control signals must
;be on the same port, but these 8 lines let you connect them to
;whichever pins on that port.

IDEa0line   EQU   01H   ;direct from 8255 to IDE interface
IDEa1line   EQU   02H   ;direct from 8255 to IDE interface
IDEa2line   EQU   04H   ;direct from 8255 to IDE interface
IDEcs0line   EQU   08H   ;inverter between 8255 and IDE interface
IDEcs1line   EQU   10H   ;inverter between 8255 and IDE interface
IDEwrline   EQU   20H   ;inverter between 8255 and IDE interface
IDErdline   EQU   40H   ;inverter between 8255 and IDE interface
IDErstline   EQU   80H   ;inverter between 8255 and IDE interface
;
;Symbolic constants for the IDE Drive registers, which makes the
;code more readable than always specifying the address pins

REGdata      EQU   IDEcs0line
REGerr      EQU   IDEcs0line + IDEa0line
REGseccnt   EQU   IDEcs0line + IDEa1line
REGsector   EQU   IDEcs0line + IDEa1line + IDEa0line
REGcylinderLSB   EQU   IDEcs0line + IDEa2line
REGcylinderMSB   EQU   IDEcs0line + IDEa2line + IDEa0line
REGshd      EQU   IDEcs0line + IDEa2line + IDEa1line      ;(0EH)
REGcommand   EQU   IDEcs0line + IDEa2line + IDEa1line + IDEa0line   ;(0FH)
REGstatus   EQU   IDEcs0line + IDEa2line + IDEa1line + IDEa0line
REGcontrol   EQU   IDEcs1line + IDEa2line + IDEa1line
REGastatus   EQU   IDEcs1line + IDEa2line + IDEa1line + IDEa0line

;IDE Command Constants.  These should never change.

COMMANDrecal   EQU   10H
COMMANDread   EQU   20H
COMMANDwrite   EQU   30H
COMMANDinit   EQU   91H
COMMANDid   EQU   0ECH
COMMANDspindown   EQU   0E0H
COMMANDspinup   EQU   0E1H
;
MAXSEC      EQU   3FH
LBA$MODE   EQU   11100000b
;
; IDE Status Register:
;  bit 7: Busy   1=busy, 0=not busy
;  bit 6: Ready 1=ready for command, 0=not ready yet
;  bit 5: DF   1=fault occured insIDE drive
;  bit 4: DSC   1=seek complete
;  bit 3: DRQ   1=data request ready, 0=not ready to xfer yet
;  bit 2: CORR   1=correctable error occured
;  bit 1: IDX   vendor specific
;  bit 0: ERR   1=error occured
;
BUSY$FLAG   EQU   10000000b
BUSY$DRQ   EQU   10001000b
RDY$DRQ      EQU   00001000b
BUSY$CMD   EQU   11000000b   
RDY$CMD      EQU   01000000b

;------------------------------------------------------------------
; Console ASCII equates
;------------------------------------------------------------------
BELL   EQU   07H
CR   EQU   0DH
LF   EQU   0AH

;------------------------------------------------------------------
; Disk Parameter Headers
;------------------------------------------------------------------
   ; Public labels exposed:
   PUBLIC   DPH2, DPH3   ;IDE drive parameter headers

   ; External labels:
   EXTRN   @ADRV,@RDRV
   EXTRN   @DMA,@TRK,@SECT
   EXTRN   @CBNK
   EXTRN   @DBNK
   EXTRN   @ERMDE      ;BDOS error mode
   EXTRN   ?WBOOT
   EXTRN   ?PMSG      ;Print null-terminated string
   EXTRN   ?PDERR      ;Print BIOS disk error
   EXTRN   ?CONIN,?CONO   ;Console I/O
   EXTRN   ?CONST      ;Console status

   ; Extended disk parameter header for IDE drive 0:
   DW   HDWRT      ;IDE Drive Write
   DW   HDRD      ;IDE Drive Read
   DW   SELECT0      ;IDE Login
   DW   INIT0      ;IDE Init
   DB   0      ;Controller drive number
   DB   0      ;Media Type

DPH2:   DPH   0,IDEHD$DPB,0,

   ; Extended disk parameter header for IDE drive 1:
   DW   HDWRT      ;IDE Drive Write
   DW   HDRD      ;IDE Drive Read
   DW   SELECT1      ;IDE Login
   DW   INIT1      ;IDE Init
   DB   1      ;Controller drive number
   DB   0      ;Media Type

DPH3:   DPH   0,IDEHD$DPB,0,

   ; Put DPBs in common memory
   CSEG

   ; 512 byte sectors on hard disk (512 x 64 x 256 = 8,388,608 bytes)
IDEHD$DPB:
   DPB   512,64,256,2048,1024,1,8000H
   ;
   ; 2048 allocation unit size, 1024 directory entries


;------------------------------------------------------------------
; IDE Initialization / Login
;------------------------------------------------------------------

SELECT0:         ;Select drive 0
   XRA   A
   JMP   SELECTdrive

SELECT1:         ;Select drive 1
   MVI   A, 1

SELECTdrive:         ;Select drive [A]
   OUT   IDEDrive   
   RET

INIT0:
   XRA   A
   OUT   IDEDrive   ;Select drive 0
   JMP   IDEinit

INIT1:
   MVI   A, 1
   OUT   IDEDrive   ;Select drive 1

IDEinit:         ;Initialize the 8255 and drive
   MVI   A,READcfg8255
   OUT   IDEportCtrl   ;config 8255 chip, READ mode
            
   MVI   A,IDErstline
   OUT   IDEportC   ;reset

   MVI   B, 20H
ResetDelay:
   DCR   B
   JNZ   ResetDelay   ;delay (reset pulse width)

   XRA   A
   OUT   IDEportC   ;no IDE control lines asserted (just bit 7 of port C)
   CALL   DELAY$32
         
   MVI   D, LBA$MODE   ;11100000B

   MVI   E, REGshd 
   CALL   IDEwr8D      ;write byte to select the MASTER device

   MVI   B, 0FFH      ;set delay time
WaitInit:   
   MVI   E, REGstatus   ;get status after initialization
   CALL   IDErd8D      ;check status
   MOV   A, D
   ANI   BUSY$FLAG   ;check busy flag
   JZ   DoneInit   ;return if ready bit is zero

   PUSH   B
   LXI   B, 0FFFFH   ;long delay to allow drive to get up to speed   
DELAY2:   MVI   D, 2
DELAY1:   DCR   D
   JNZ   DELAY1
   DCX   B
   MOV   A,C
   ORA   B
   JNZ   DELAY2
   POP   B
   DCR   B
   JNZ   WaitInit

   CALL   SetErrorFlag   ;if not ready by this point, return with NZ flag set
   LXI   H, MSG$INIT$ERR
   CALL   ?PMSG
   ORI   1
   RET   
DoneInit:   
   XRA   A      ;return with no error
   RET


;------------------------------------------------------------------
; SECTOR WRITE ROUTINE
;------------------------------------------------------------------
HDWRT:            ;Write one sector
   XRA   A
   STA   ERFLG      ;clear error flag
   CALL   wrlba      ;convert track/sector to LBA
   CALL   IDEwaitnotbusy   ;make sure drive is ready
   JC   SetErrorFlag

   MVI   D, COMMANDwrite
   MVI   E, REGcommand
   CALL   IDEwr8D      ;tell drive to write a sector
   CALL   IDEwaitdrq   ;wait unit it wants the data
   JC   SetErrorFlag   ;if problem abort

   LHLD    @DMA      ;DMA address

   MVI   A, WRITEcfg8255
   OUT   IDEportCtrl

   MVI   B,0      ;256x2 bytes
WRSEC1:
   MOV   A, M
   INX   H
   OUT   IDEportA   ;LOW byte to port A first
   MOV   A, M
   INX   H
   OUT   IDEportB   ;then HIGH byte to port B
   MVI   A, REGdata
   PUSH   PSW
   OUT   IDEportC   ;send write command
   ORI   IDEwrline   ;send WR pulse
   OUT   IDEportC
   POP   PSW
   OUT   IDEportC
   DCR   B
   JNZ   WRSEC1
   MVI   A, READcfg8255   ;set 8255 back to read mode
   OUT   IDEportCtrl

CHECK$RW:
   MVI   E, REGstatus   ;check R/W status when done
   CALL   IDErd8D
   MOV   A, D
   ANI   01H
   STA   ERFLG      ;return Z if successful
   RZ
SetErrorFlag:         ;for now just return with error flag set
   XRA   A
   DCR   A
   STA   ERFLG      ;return NZ if problem
   RET


;------------------------------------------------------------------
; SECTOR READ ROUTINE
;------------------------------------------------------------------
HDRD:            ;Read one sector
   XRA   A
   STA   ERFLG           ;clear error flag
   CALL   wrlba      ;convert track/sector to LBA
   CALL   IDEwaitnotbusy   ;make sure drive is ready
   JC   SetErrorFlag   ;NZ set if error

   MVI   D, COMMANDread
   MVI   E, REGcommand
   CALL   IDEwr8D      ;send sector read command
   CALL   IDEwaitdrq   ;wait until data ready
   JC   SetErrorFlag   ;if problem abort
      
   LHLD     @DMA      ;DMA address
   MVI   B, 0

MoreRD16:
   MVI   A,REGdata   ;select data register address
   OUT   IDEportC   

   ORI   IDErdline   ;08H+40H, pulse RD line
   OUT   IDEportC   

   IN   IDEportA   ;read the LOW byte first
   MOV   M, A
   INX   H
   IN   IDEportB   ;then the HIGH byte
   MOV   M,A
   INX   H
   
   MVI   A, REGdata   ;deassert RD line
   OUT   IDEportC

   DCR   B
   JNZ   MoreRD16

   JMP   CHECK$RW


;------------------------------------------------------------------
; SUPPORT ROUTINES
;------------------------------------------------------------------
wrlba:            ;Translate to logical block address
   CALL   IDEwaitnotbusy   ;make sure drive isn't busy
   LHLD   @TRK      ;get the CP/M requested track high and low
   MOV   A, L      ;get low byte of track, interested in bottom two bits
   RRC         ;shift 'em
   RRC         ;shift again to the top
   ANI   0C0H      ;examine those two bits
   MOV   C, A      ;save in [C]
   LDA   @SECT      ;sector number (low byte) into [A]
   ANI   03FH      ;take only bottom 6 bits
   ORA   C      ;add in top 2 bits of track
   MOV   D, A      ;send info to the drive
   MVI   E, REGsector
   CALL   IDEwr8D

   MOV   A, L      ;get low byte of track again
   RRC
   RRC
   ANI   03FH
   MOV   C, A      ;save in [C]
   MOV   A, H      ;get high byte of track
   RRC         ;rotate twice, leaving low 2 bits
   RRC         ;in upper bits of [A]
   ANI   0C0H      ;mask all but the two bits we want
   ORA   C      ;add in the top 6 bits of the first track byte
   MOV   D, A      ;send Low TRK#
   MVI   E, REGcylinderLSB
   CALL   IDEwr8D
   
   MOV   A, H      ;get high byte of track
   RRC         ;just the top 6 bits
   RRC
   ANI   03FH
   MOV   D, A      ;send High TRK#
   MVI   E, REGcylinderMSB
   CALL   IDEwr8D

   MVI   D, 1      ;one sector at a time
   MVI   E, REGseccnt
   CALL   IDEwr8D
   RET

IDEwaitnotbusy:         ;Drive READY if 01000000
   MVI   B, 0FFH
   MVI   C, 0FFH      ;delay, must be above 80H. Leave longer for slower drives
MoreWait:
   MVI   E, REGstatus   ;wait for RDY bit to be set
   CALL   IDErd8D
   MOV   A, D
   ANI   BUSY$CMD   ;11000000B
   XRI   RDY$CMD      ;01000000B
   JZ   DoneNotbusy
   DCR   B
   JNZ   MoreWait
   DCR   C
   JNZ   MoreWait
   STC         ;set carry to indicqate an error
   ret
DoneNotBusy:
   ORA   A      ;clear carry it indicate no error
   RET

IDEwaitdrq:
   MVI   B, 0FFH
   MVI   C, 0FFH      ;delay must be above 80H. Leave longer for slower drives
MoreDRQ:
   MVI   E, REGstatus   ;dait for DRQ bit to be set
   CALL   IDErd8D
   MOV   A, D
   ANI   BUSY$DRQ   ;10001000B
   CPI   RDY$DRQ      ;00001000B
   JZ   DoneDRQ
   DCR   B
   JNZ   MoreDRQ
   DCR   C
   JNZ   MoreDRQ
   STC         ;set carry to indicate error
   RET
DoneDRQ:
   ORA   A      ;clear carry
   RET

DELAY$32:
   MVI   A, 40      ;delay ~32ms
DELAY3:
   MVI   B, 0
M0:
   DCR   B
   JNZ   M0
   DCR   A
   JNZ   DELAY3
   RET


;------------------------------------------------------------------
; Low Level 8 bit R/W to the drive controller.  These are the routines that talk
; directly to the drive controller registers, via the 8255 chip. 
; Note the 16 bit I/O to the drive (which is only for SEC R/W) is done directly
; in the routines HDRD & HDWRT for speed reasons.
;------------------------------------------------------------------
IDErd8D:         ;Read byte from IDE register in [E], return info in [D]
   MOV   A, E
   OUT   IDEportC   ;drive address onto control lines

   ORI   IDErdline   ;RD pulse pin (40H)
   OUT   IDEportC   ;assert read pin

   IN   IDEportA
   MOV   D, A      ;return with data in [D]

   MOV   A, E
   OUT   IDEportC   ;deassert RD pin first

   XRA   A
   OUT   IDEportC   ;zero all port C lines
   RET

IDEwr8D:         ;Write byte in [D] to IDE register in [E]
   MVI   A, WRITEcfg8255   ;set 8255 to write mode
   OUT   IDEportCtrl

   MOV   A, D      ;get data put it in 8255 A port
   OUT   IDEportA

   MOV   A, E      ;select IDE register
   OUT   IDEportC

   ORI   IDEwrline   ;lower WR line
   OUT   IDEportC

   MOV   A, E
   OUT   IDEportC   ;deassert WR pin first

   XRA   A      ;deselect all lines including WR line
   OUT   IDEportC

   MVI   A, READcfg8255   ;config 8255 chip, read mode on return
   OUT   IDEportCtrl
   RET

MSG$INIT$ERR DB   'Initilization of IDE drive failed.',CR,LF,0

ERFLG:      DB   0H

Re: IDE interface for Altair 8800c

PostPosted: February 23rd, 2023, 6:33 pm
by AltairClone
Great work!

Re: IDE interface for Altair 8800c

PostPosted: March 6th, 2023, 10:25 am
by Wayne Parham
I've been testing the BIOS for about a week now, and I'm satisfied that it is working properly. So I've created a distribution archive, which contains the source code, executable binaries and a couple of 330Kb bootable image files, one for 48Kb RAM and the other for 63Kb.

This version of CP/M boots from 330Kb diskette and supports two 330Kb diskette drives and two 8Mb IDE drives, either magnetic or compact flash. The diskettes are A and B and the hard drives are C and D.


I actually found and fixed one last bug. I had initially placed the drive-selection logic in the "login" function for each drive. But the login function is only called once, immediately after first selection of the drive. So I removed the drive selection logic from the login function and added it at the beginning of the read and write functions.

You can see my troubleshooting steps at the link below. It's essentially the same notes I made that were the subject of this thread. So scroll down to the bottom to see the last stuff I did. It's all kind of a yawner, but might help someone else in the future trying to troubleshoot a new BIOS. At least it'll help me remember if I ever need it.


=== Next Steps ===

I'm pretty happy with this version of CP/M exactly as it stands. But there are a few things that might be useful at some point:

1. A version of BIOS that boots from an IDE drive.
2. BIOS that supports banked memory on the Altair. Of course, we'd need to choose or define and develop memory hardware first.
3. BIOS or tool that changes the CP/M accessible drive from "partition" 00 to any other.

To explain this third idea, you might remember earlier in this thread where I described a feature I added to IDEutil that allows the selection of "partitions." What I did was to logically group the tracks into "partitions," using the most significant byte of the track number.

CP/M tracks are 00-FF and sectors are 00-3F for each of the IDE drives. But the drive is capable of tracks 0000-FFFF. So the first 8Mb is tracks 0000-00FF, the second is 0100-01FF, and so on. IDEutil can access any of these areas, but CP/M can only "see" the first one.

It might be nice to add a feature - tied in through the wrlba function in IDE3.asm - that allows the user to change "partitions" in CP/M, to allow any of 256 to be selected. That would expose an entire 2Gb drive to CP/M.

Re: IDE interface for Altair 8800c

PostPosted: January 6th, 2024, 2:44 pm
by mr_metra_nilak
Hello,

I just read the entire thread. What a journey! I've been trying to get the Dual IDE V4 board to work and ran into some issues that have been occupying me for quite some time now. Maybe someone here has ideas or insights as to why I'm having these issues: I'm able to initialize a drive and read/copy data from the drive. The problem that I'm having is that, when the computer runs my code to read and copy data from the drive to RAM, it skips certain words occasionally. It's always the same words (it seems) but whether they are present or not is kind of random. That is - sometimes they are read while other times they are skipped and the next word is actually read from the buffer instead (by "word" I mean the HI and LO byte).

I'm using a variant of a bootloader that was present in this thread but I modified it a bit to get it working on my Altair (Intel 8080). The code reads from a CF drive that contains CP/M V3. I can see that it copies most of it into RAM address 0100H but, as I stated above, certain words are skipped. I also read from the CF card on my other computer to see what was on it and those words are present.

For example, here are the first few records. I have [b] tags around the words that are skipped.

Code: Select all
00000200: 3181 02cd 000b 0e0d cd8d 020e 0911 2502  1.............%.
00000210: cd8d 020e 0f11 ab01 cd8d 02fe ff11 cf01  ................
00000220: caa2 0111 8000 cd8f 01cd 9501 2180 0011  ............!...
00000230: 8102 0e06 7e12 1323 0dc2 3401 cd95 010e  ....~..#..4.....
00000240: 0911 8000 cd8d 023a 8202 673a 8102 cd73  .......:..g:...s
00000250: 013a 8402 b7ca 5f01 673a 8302 cd73 0121  .:...._.g:...s.!
00000260: 5d00 7efe 24c2 6f01 [b]237e[/b] fe42 cca9 0131  ].~.$.o.#~.B...1
00000270: 8502 c9b7 571e 007c 1767 [b]eb01[/b] 80ff 09eb  ....W..|.g......
00000280: d5e5 cd8f 01cd 9501 e1d1 25c2 7a01 c90e  ..........%.z...


The code that reads from the drive and copies to RAM is the following:

Code: Select all
MoreRD16:
        MVI     A,REGdata               ;REG register address
        OUT     IDECport       

        ORI     IDErdline               ;08H+40H, Pulse RD line
        OUT     IDECport
       
        IN      IDEAport                ;read the LOWER byte
        MOV     M,A
        INX     H

        IN      IDEBport                ;read the UPPER byte
        MOV     M,A
        INX     H

        MVI     A,REGdata               ;Deassert RD line
        OUT     IDECport

        DCR     B
        JNZ     MoreRD16
        DCR     C
        JNZ     MoreRD16

        MVI     E,REGstatus             ;Check the R/W status when done
        CALL    IDErd8D
        MOV     A,D                     ;Z80 = Bit 0,D  (A is unused)
        ANI     01H
        JNZ     IDEerr1                 ;Z if no errors
        LXI     H,CPMADDRESS
        MOV     A,M
        CPI     31H                     ;EXPECT TO HAVE 31H @80H IE. MOV SP,80H
        JZ      CPMADDRESS              ;AS THE FIRST INSTRUCTION. IF OK JMP to 100H in RAM
        JMP     ERRLD1                  ;Boot Sector Data incorrect


Here is the full code:

Code: Select all
BELL    EQU     07H
CR      EQU     0DH
LF      EQU     0AH

;-------------- S100Computers I/O BOARD PORT ASSIGNMENTS  (A0-AC)

BCTL            EQU     10H            ;CHANNEL B CONTROL PORT ASSIGNMENTS OF THE ZILOG SCC CHIP           
BDTA            EQU     11H            ;CHANNEL B DATA

;-------------- S100Computers IDE HARD DISK CONTROLLER COMMANDS ETC.

CPMADDRESS      EQU     100H            ;Will place the CPMMOVR.COM Loader here with
                                        ;CPMMOVR.COM will ALWAYS be on TRK 0,SEC2, (LBA Mode)
SECCOUNT        EQU     12              ;CPMMOVR.COM requires (currently) 10, 512 byte sectors

IDEAport        EQU     030H            ;lower 8 bits of IDE interface
IDEBport        EQU     031H            ;upper 8 bits of IDE interface
IDECport        EQU     032H            ;control lines for IDE interface
IDECtrl         EQU     033H            ;8255 configuration port
IDEDrivePort    EQU     034H            ;To select the 1st or 2nd CF card/drive (Not used with this monitor)

IDEreset        EQU     80H             ;inverter between 8255 and IDE interface
IDEResetDelay   EQU     020H            ;Time delay for reset/initilization (~60 uS, with 10MHz Z80, 2 I/O wait states)
RDcfg8255       EQU     10010010B       ;Set 8255 IDECport out, IDEAport/B input
WRcfg8255       EQU     10000000B       ;Set all three 8255 ports output

IDEa0line       EQU     01H             ;direct from 8255 to IDE interface
IDEa1line       EQU     02H             ;direct from 8255 to IDE interface
IDEa2line       EQU     04H             ;direct from 8255 to IDE interface
IDEcs0line      EQU     08H             ;inverter between 8255 and IDE interface
IDEcs1line      EQU     10H             ;inverter between 8255 and IDE interface
IDEwrline       EQU     20H             ;inverter between 8255 and IDE interface
IDErdline       EQU     40H             ;inverter between 8255 and IDE interface

;
;Symbolic constants for the IDE Drive registers, which makes the
;code more readable than always specifying the address pins
;
REGdata         EQU     08H             ;IDEcs0line
REGerr          EQU     09H             ;IDEcs0line + IDEa0line
REGcnt          EQU     0AH             ;IDEcs0line + IDEa1line
REGsector       EQU     0BH             ;IDEcs0line + IDEa1line + IDEa0line
REGcyLSB        EQU     0CH             ;IDEcs0line + IDEa2line
REGcyMSB        EQU     0DH             ;IDEcs0line + IDEa2line + IDEa0line
REGshd          EQU     0EH             ;IDEcs0line + IDEa2line + IDEa1line             ;(0EH)
REGCMD          EQU     0FH             ;IDEcs0line + IDEa2line + IDEa1line + IDEa0line ;(0FH)
REGstatus       EQU     0FH             ;IDEcs0line + IDEa2line + IDEa1line + IDEa0line

;

DIAGLEDS       EQU     5               ;OUT (Will use this port initially for diagnostic LED display)

;IDE CMD Constants.  These shouMOV never change.
CMDrecal        EQU     10H
CMDread         EQU     20H
CMDwrite        EQU     30H
CMDinit         EQU     91H
CMDid           EQU     0ECH
CMDdownspin     EQU     0E0H
CMDupspin       EQU     0E1H

;-------------- BOOT UP CPM FROM HARD DISK ON S100COMPUTERS IDR BOARD ----------------

;BOOT UP THE 8255/IDE Board HARD DISK/Flash Memory Card
;NOTE CODE IS ALL HERE IN CASE A 2716 IS USED

ORG 0DF00H

INITIALIZE:
        MVI     A,3             ;RESET 6850 UART
        OUT     BCTL
        MVI     A,11H           ;8N2   
        OUT     BCTL

HBOOTCPM:
        POP     H                       ;CLEAN UP STACK
        LXI     H,SPEAKCPMMSG           ;Announce on speaker
        CALL    SPEAK
       
        CALL    INITILIZEIDEBOARD       ;Initilze the 8255 and drive (again just in case)
        JC      ERRNR                   ;Carry set to indicate an error, Drive not ready

        MVI     D,11100000B             ;Data for IDE SDH reg (512bytes, LBA mode,single drive)
        MVI     E,REGshd                ;00001110,(0EH) CS0,A2,A1, 
        CALL    IDEwr8D                 ;Write byte to select the MASTER device

        MVI     B,0FFH                  ;Delay time to allow a Hard Disk to get up to speed
WaitInit:       
        MVI     E,REGstatus             ;Get status after initilization
        CALL    IDErd8D                 ;Check Status (info in [D])
        MOV     A,D                     ;Z80 = BIT 7,D (A is not needed)
        ANI     80H
        JZ      SECREAD                 ;Zero, so all is OK to write to drive
                                        ;Delay to allow drive to get up to speed
        PUSH    B
        LXI     B,0FFFFH       
DXLAY2: MVI     D,2                     ;May need to adjust delay time to allow coMOV drive to
DXLAY1: DCR     D                       ;to speed
        JNZ     DXLAY1
        DCX     B
        MOV     A,C
        ORA     B
        JNZ     DXLAY2
        POP     B
        DCR     B
        JNZ     WaitInit                ;If after 0FFH, 0FEH, 0FDH... 0, then drive initilization problem
IDError:
        LXI     H,DRIVENRERR          ;Drive not ready
        JMP     ABORTERRMSG

SECREAD:                                ;Note CPMMOVR will ALWAYS be on TRK 0,SEC 1,Head 0
        MVI     A,11111111B             ;FLAG PROGRESS VISUALLY FOR DIAGNOSTIC
        OUT     DIAGLEDS

        CALL    IDEwaitnotbusy          ;Make sure drive is ready
        JC      IDError                 ;NC if ready

        MVI     D,1                     ;Load track 0,sec 1, head 0
        MVI     E,REGsector             ;Send info to drive
        CALL    IDEwr8D

        MVI     D,0                     ;Send Low TRK#
        MVI     E,REGcyLSB
        CALL    IDEwr8D

        MVI     D,0                     ;Send High TRK#
        MVI     E,REGcyMSB
        CALL    IDEwr8D

        MVI     D,SECCOUNT              ;Count of CPM sectors we wish to read
        MVI     E,REGcnt
        CALL    IDEwr8D

        MVI     D,CMDread               ;Send read CMD
        MVI     E,REGCMD
        CALL    IDEwr8D                 ;Send sec read CMD to drive.
        CALL    IDEwdrq                 ;Wait until it's got the data

        LXI     H,CPMADDRESS            ;DMA address where the CPMMOVR resides in RAM
        MVI     B,0                     ;256X2 bytes
        MVI     C,SECCOUNT              ;Count of sectors X 512
MoreRD16:
        MVI     A,REGdata               ;REG register address
        OUT     IDECport       

        ORI     IDErdline               ;08H+40H, Pulse RD line
        OUT     IDECport
       
        IN      IDEAport                ;read the LOWER byte
        MOV     M,A
        INX     H

        IN      IDEBport                ;read the UPPER byte
        MOV     M,A
        INX     H

        MVI     A,REGdata               ;Deassert RD line
        OUT     IDECport

        DCR     B
        JNZ     MoreRD16
        DCR     C
        JNZ     MoreRD16

        MVI     E,REGstatus             ;Check the R/W status when done
        CALL    IDErd8D
        MOV     A,D                     ;Z80 = Bit 0,D  (A is unused)
        ANI     01H
        JNZ     IDEerr1                 ;Z if no errors
        LXI     H,CPMADDRESS
        MOV     A,M
        CPI     31H                     ;EXPECT TO HAVE 31H @80H IE. MOV SP,80H
        JZ      CPMADDRESS              ;AS THE FIRST INSTRUCTION. IF OK JMP to 100H in RAM
        JMP     ERRLD1                  ;Boot Sector Data incorrect

IDEerr1:
        LXI     H,IDERWERROR            ;Drive R/W Error
        JMP     ABORTERRMSG


;      ----- SUPPORT ROUTINES --------------

INITILIZEIDEBOARD:                      ;Drive Select in [A]. Note leaves selected drive as [A]
        MVI     A,RDcfg8255             ;Config 8255 chip (10010010B), read mode on return
        OUT     IDECtrl                 ;Config 8255 chip, READ mode
                               
                                        ;Hard reset the disk drive
                                        ;For some reason some CF cards need to the RESET line
                                        ;pulsed very carefully. You may need to play around   
        MVI     A,IDEreset              ;with the pulse length. Symptoms are: incorrect data coming
        OUT     IDECport                ;back from a sector read (often due to the wrong sector being read)
                                        ;I have a (negative)pulse of 60 uSec. (10Mz Z80, two IO wait states).

        MVI     C,IDEResetDelay         ;~60 uS seems to work for the 5 different CF cards I have
ResetDelay:
        DCR     C
        JNZ     ResetDelay              ;Delay (reset pulse width)
        XRA     A
        OUT     IDECport                ;No IDE control lines asserted (just bit 7 of port C)
       
        CALL    DELAY15                 ;Need to delay a little before checking busy status

IDEwaitnotbusy:                         ;Drive READY if 01000000
        MVI     B,0FFH
        MVI     C,0FFH                  ;Delay, must be above 80H for 4MHz Z80. Leave longer for slower drives
MoreWait:
        MVI     E,REGstatus             ;Wait for RDY bit to be set
        CALL    IDErd8D
        MOV     A,D
        ANI     11000000B
        XRI     01000000B
        JZ      DoneNotbusy
        DCR     B       
        JNZ     MoreWait
        DCR     C
        JNZ     MoreWait
        STC                             ;Set carry to indicate an error
        RET
DoneNotBusy:
        ORA     A                       ;Clear carry it indicate no error
        RET
       
                                       
                                        ;Wait for the drive to be ready to transfer data.
IDEwdrq:                                ;Returns the drive's status in Acc
        MVI     B,0FFH
        MVI     C,0FFH                  ;Delay, must be above 80H for 4MHz Z80. Leave longer for slower drives
MoreDRQ:
        MVI     E,REGstatus             ;wait for DRQ bit to be set
        CALL    IDErd8D
        MOV     A,D
        ANI     10001000B
        CPI     00001000B
        JZ      DoneDRQ
        DCR     B
        JNZ     MoreDRQ
        DCR     C
        JNZ     MoreDRQ
        STC                             ;Set carry to indicate error
        RET
DoneDRQ:
        ORA     A                       ;Clear carry
        RET
;
;------------------------------------------------------------------
; Low Level 8 bit R/W to the drive controller.  These are the routines that talk
; directly to the drive controller registers, via the 8255 chip. 
; Note the 16 bit I/O to the drive (which is only for SEC Read here) is done directly
; in the routine MoreRD16 for speed reasons.

IDErd8D:                                ;READ 8 bits from IDE register in [E], return info in [D]
        MOV     A,E
        OUT     IDECport                ;drive address onto control lines

        ORI     IDErdline               ;RD pulse pin (40H)
        OUT     IDECport                ;assert read pin

        IN      IDEAport
        MOV     D,A                     ;return with data in [D]

        MOV     A,E                     ;Ken Robbins suggestion
        OUT     IDECport                ;Deassert RD pin

        XRA     A
        OUT     IDECport                ;Zero all port C lines
        RET


IDEwr8D:                                ;WRITE Data in [D] to IDE register in [E]
        MVI     A,WRcfg8255             ;Set 8255 to write mode
        OUT     IDECtrl

        MOV     A,D                     ;Get data put it in 8255 A port
        OUT     IDEAport

        MOV     A,E                     ;select IDE register
        OUT     IDECport

        ORI     IDEwrline               ;lower WR line
        OUT     IDECport

        MOV     A,E                     ;Kens Robbins suggestion, raise WR line
        OUT     IDECport

        XRA     A                       ;Deselect all lines including WR line
        OUT     IDECport

        MVI     A,RDcfg8255             ;Config 8255 chip, read mode on return
        OUT     IDECtrl
        RET
SPEAKOUT:
        XRA     A                       ;Will try 256 times, then timeout
SPXXX:  PUSH    PSW
        IN      BCTL                    ;(A0), Is SCC TX Buffer empty
        ANI     2
        JNZ     SENDS                   ;NZ if ready to recieve character
        POP     PSW
        DCR     A
        JNZ     SPXXX
        RET
SENDS:  POP     PSW
        MOV     A,C
        OUT     BDTA                    ;(A2), Send it
        RET

;SPEAKTOMM THIS IS A ROUTINE TO SEND A STRING TO TALKER [HL] AT STRING
SPEAK:  MOV     A,M
        CPI     '$'
        JZ      SPEAK1
        MOV     C,A
        CALL    SPEAKOUT
        INX     H
        JMP     SPEAK
SPEAK1: MVI     C,0DH                   ;MUST END WITH A CR
        JMP     SPEAKOUT
DELAY:  DCR     A                       ;GENERAL COUNT DOWN TIME DELAY
        RZ                              ;LENGTH SET IN [A]
        PUSH    PSW
        MVI     A,05H
MORE:   DCR     A
        PUSH    PSW
        XRA     A
MORE2:  DCR     A
        JNZ     MORE2
        POP     PSW
        JNZ     MORE
        POP     PSW
        JMP     DELAY

DELAY15:                                ;DELAY ~15 MS
        MVI     A,40                   
DELAY1: MVI     B,0
M0:     DCR     B
        JNZ     M0
        DCR     A
        JNZ     DELAY1 
        RET
ERRNR:  LXI     H,DRIVENRERR            ;"DRIVE NOT READY
        JMP     ABORTERRMSG
ERRLD1:
        LXI     H,BOOTLD1ERR            ;"DATA ERROR IN BOOT SECTOR"
ABORTERRMSG: 
        CALL    SPEAK
        JMP     HBOOTCPM                ;BACK TO START

SPEAKCPMMSG:    DB      'LOADING CPM $'
DRIVENRERR:     DB      BELL,CR,LF
                DB      'Drive not Ready.',CR,LF,LF,'$'
BOOTLD1ERR:     DB      BELL,CR,LF
                DB      'BOOT error.',CR,LF,LF,'$'
IDERWERROR:     DB      CR,LF
                DB      'IDE Drive R/W Error'
                DB      CR,LF,'$'


I would really appreciate some help on this as I've been banging my head for the past few days, if not weeks.

Re: IDE interface for Altair 8800c

PostPosted: January 9th, 2024, 4:53 pm
by Wayne Parham
Nice to see a fellow IDE owner here!

One thing I would probably suggest is to get the latest copy of the bootloader. You may have already done that, but if not, I'd start there.

After that, if you need to troubleshoot further, I'd definitely suggest using SID. As you saw, when I was developing the code for my version of CP/M, I leaned heavily on the SID debugger. I would encourage you to do that too. It's an old debugger, but it does the job.

The real trick for me was finding places to set breakpoints, uh, I meant passpoints. That was always the hardest part. 'Cause once you've entered a loop, you have to step a few hundred or thousand steps to get past it. So the trick is to find places to put passpoints - before functional (iterative) blocks that you're not sure of, and after stuff that you are sure of.

You may have seen my (super-boring) SID flow documents. I used a lot of "P" commands (to set passpoints) and "G" commands to execute up to a passpoint. I also used "L" to list blocks of memory and "T" and "TW" commands to step into and out of an iterative block, treating it sort of like a function that could be stepped through as if it were a single instruction. Took a little while to get the hang of that process, but once I had it, I could really use the SID tool.

Another thing I would suggest is to run IDEutil.com and see if that works for you. If it doesn't, you may have a hardware problem. Might be worthwhile to single-step through IDEutil anyway, just to be sure. I remember when I was first working with the CF board, I spent a lot of time working on IDEutil. The WRLBA function was of particular interest to me, because there were at least two versions of it in Monahan's code, and I was making a third.

Then again, if I've misinterpreted you, if you know that the CF drive initializes, read and writes without error, you'll probably focus on the CP/M code. I would probably blow the dust off the SID traces I made in development, maybe even choose one of the same GENCPM topmem values, so your jump table addresses are the same as mine. That might save some time finding stuff. Then trace through the reads and see what you see.

Or maybe try one thing first - a shotgun approach that misses a lot of detail but just might work - play around with your disk buffer settings when doing GENCPM. You can choose what drives have unique buffers and/or what drives share buffers. I found some settings just plain don't work. So you might focus on that before rolling your sleeves up and running SID.

I'm super-curious about what you find out so please keep us posted!

Re: IDE interface for Altair 8800c

PostPosted: January 30th, 2024, 9:36 am
by mr_metra_nilak
Hello Wayne,

I appreciate your response. I tried assembling the ideutils.asm file but the assembler does not like this line: DB 0CBH, 0*8+D+40H ;BIT 0, D

It seems to be complaining about the "D". Any ideas?