Subttl -Firmware Hi-Level Disk Driver Routines (9_Aug_84) ; ; Copyright 1983, 1984 ; Morrow Designs, Inc. ; San Leandro, Ca. ; John Zalabak, Howard Fullmer ; .z80 ;Switch set to assemble z80 nemonics Include HD22DEF.MAC ;Include Global Equates ASeg Org O_Dsk1 ;See the hd*def.mac module for definition ; Index: Disk Drivers (27_Mar_84) ;-------------------------------- ; ; Intdsk Initialize for disk operations ; boot cold boot loader ; bter Print the Boot Error Message ; ; Park Park the Hard Disk Heads ; GetIX Set IX to an Mtab referencing the current Physical Drive ; DiscIO Read/Write to the disk controller with error handeling ; Virt Virtual Drive processing ; ErTran Translate rom level error code to bios level error code ; ErHand Error Handeler ; PbeMsg Print the basic error message ; PbrMsg Print the Bios and Rom level error messages ; Ersp Get the error response ; ; BadChk Check the bad map for the current sector ; ReMap Remap the current sector through the bad map ; BadEnt Enter the current sector into the bad map ; BadOpn Open the bad map ; BadCls Close the bad map ; SwpPio Swap Phytrk through ioadd with the contents of PioBuf ; SwpBuf Swap the disk buffer with the alternate buffer ; LdPhy Load the Physical Parameters through the HL ; ; ExDisk Execute a disk routine ; FixErr Fix error if possible/identify fatal errors ; Cnt Counter ; Jog10 Move the Head to Home and then to track 10 ; JogLE3 Step in 3 times if current track LE 3 ; ; PRP Main Line of Prep ; Setup Setup variables and constants ; Delays Do the Motor On and Head Load Delays ; HOM Home ; SEK Seek ; Settle Wait for the Drive to Settle after Stepping the Heads ; Setplc Setup Write Pre-Compensation and low current ; STP Step the Heads ; PlsMtr Pulse the Motor on Line ; Chkrot Check if the disk is rotating ; ; GETcyl Get the value of the current cylinder ; SETcyl Set the value of the current cylinder ; DLY Delay in 3ms increments/check drive status ; ABS Compute Absolute difference of DE and HL ; ClrLat Clear the Control Latch ; ----- Data Areas ; ETAB Table of Error Message Starting Addresses page 64 ;---------------------------------------------------------------------- ; Linkage Definitions (12_Dec_83) ;-------------------------------- ; public Intdsk ;Initialize the disk drivers public Boot ;cold boot loader public Bter ;Print the Boot Error Message public Park ;Park the Hard Disk Heads public Discio ;Read/Write disk with error handeling public PlsMtr ;Pulse the Motor On Line public ABS ;Compute Absolute difference of DE & HL public Clrlat ;Clear the Control Latch ; In Lo-Level Disk Driver Module external Verify ;Verify track info by reading a header external Rdio ;read data from the disk controller external Wrio ;write data to floppy disk controller external Hdrio ;Read a Header external Fmtio ;Format a Track external Smudge ;Destroy the current sector external IIRQ ;Init IRQ Vectors for Normal Operations external IDB ;Init Disk Buffer for Normal Operation ; In the Main Module external Hdone ;Vector to the Hard disk return code external Swap ;Swap two areas of memory (inner-bank) external Xfrdat ;Move default IX, IY and MTABs into ram external Fatal ;Print fatal error message and halt ; In the I/O Module external Mesg ;Print message pointed to by the DE external CinIY ;Console Input external CoutIY ;Console Output external OutByt ;Output accm as 2 digits of hex ; In the Bios Module external Rdhst ;Read a sector external Gdsk ;Set HL pointing to start current MTAB ;---------------------------------------------------------------------- ; Local Equates ;-------------- ; ; NONE page ;====================================================================== ; INTDSK - Initialize for disk operations (8_Dec_83) ;=================================================== ; 1) This routine sets up the interrupts, clears the disk controller and ; initializes all of the ram space required for disk operations. This ; includes prebuf, postbuf, genbuf and fmtbuf. ; 2) This code should be inserted in the primary initialization routine. ; 3) The subroutine Xfrdat should have been run before this routine so ; that the IY area is properly setup for the clrlat routine. ; Intdsk: di ;Disable Interrupts ;Clear the Disk State Register (ctlstb) and any pending interrupts call ClrLat ;Latch:= Cleared ;Set-up the Disk Match and Index Interrupt Vectors call IIRQ ;Set the interrupt vectors ;Initialize the disk pre/post buffer area call IDB ;(this is also done after formatting) ;Clear the General Buffer Area ld hl,genbuf ;HL:= Pointer start of general buffer ld b,40h ;B:= Max_Count INTlp1: ld (hl),0 ;Repeat Buffer:= 0 inc hl ; Pointer:= Pointer + 1 djnz INTlp1 ;Until (Count eq 0) ;Initialize the Current Cylinder Table (in the general buffer area) ld hl,cyltbl ;HL:= Pointer to table base ld b,8 ;B:= Max Count INTlp2: ld (hl),0FFh ;Repeat Clear table entry inc hl ; Pointer:= Pointer + 1 djnz INTlp2 ;Until (Table Cleared) ;Initialize the pointer to the Bad Map (in the general buffer area) ld hl,altbuf ld (badmap),hl ;Bad_Map_Pointer:= start of altbuf ;Clear the Format Buffer Area ld hl,fmtbuf ;HL:= Pointer start of format buffer ld b,40h ;B:= Max_Count INTlp3: ld (hl),0 ;Repeat Buffer:= 0 inc hl ; Pointer:= Pointer + 1 djnz INTlp3 ;Until (Count eq 0) ;Initialize the Hard Disk Sector Skew Table (in the format buffer area) ld hl,HDskew ;Source:= Default Skew Table ld de,hdstbl ;Destination:= Pointer to Table Base ld bc,9 ;Length:= Hard Disk SPT ldir ;Move default skew table into place ret page ;====================================================================== ; BOOT - Cold Boot Loader (27_Mar_84) ;==================================== ; 1) This routine loads in sector 1 ot track 0 into the disk buffer. ; First floppy drive 0 is started up. If there is a disk present then ; a prompt is issued, asking if the user really wants to boot from the ; the floppies. If the user doesn't elect to use the floppies then ; the boot disk is switched to the hard disk. ; 2) Any errors cause a transfer of execution over to bter which issues ; the boot error message and then halts. ; 3) If the boot was successfully read then execution passes to the ; beginning of the disk buffer where the boot was loaded. ; boot: call Xfrdat ;Transfer data tables to ram ld a,0 out (drvstb),a ;Select the first floppy disk call PlsMtr ;Pulse the Motor On line ; Check if a floppy disk is loaded call ChkRot ;If (the floppy disk is rotating) or a jr z,btsk0 ; (goto Hard Disk boot) ; Check if We're to boot from the floppy ld de,gofd call Mesg ; Print 'Boot from Floppy?' btlp1: call CinIY ; Repeat Get response and 5Fh ; convert to upper case push af ld c,a call CoutIY ; Echo the character pop af cp 'Y' ; If (response eq Yes) jr z,btsk1 ; Goto boot cp 'N' jr nz,btlp1 ; Until (response eq No) ; Boot from the Hard Disk ;------------------------ ; ;Swap the Mtabs of the first floppy with the first hard disk btsk0: ld a,0 call Gdsk ; HL:= Pointer to Floppy disk Mtab push hl ; (save the pointer) ld a,$DS1 call Gdsk ; HL:= Pointer to Hard Disk Mtab pop de ; (restore pointer to FD MTAB) ld bc,10h ; BC:= Counter (= 1 mtab's length) call Swap ; Swap (hard disk = 1st mtab) ;Select the Hard disk ld a,$DS1 ; (select first hard disk drive) ld (cpydrv),a ; Update copy of drive strobe out (drvstb),a ; Select the drive ; Give some time for the ready line to settle ld d,4 ; D:= Loop Count (for 2 sec dly) btlp01: ld b,167 ; Repeat D:= 500 ms delay ld c,0 ; C:= Mask No Status Test call DLY ; call Delay dec d jr nz,btlp01 ; Until (Loop Count eq 0) ; Wait for hard disk to come ready ld d,90 ; D:= Loop Count (for 45 sec dly) btlp2: call PlsMtr ; Repeat Pulse the Motor On line ld b,167 ; B:= 500 ms delay ld c,$READY ; C:= Test ready status call DLY ; call Delay jr nz,btsk1 ; If (ready eq true) dec d ; goto read boot jr nz,btlp2 ; Until (loop count eq 0) jp Bter ; Goto Boot Error ;Read in the boot sector ;----------------------- ; btsk1: ld de,CRLF call Mesg ; Print a cr - lf call Rdhst ; Read the boot sector ld a,(iy+ErFlag) ; If (error in reading boot) or a jp nz,Bter ; GOTO boot error ld hl,dskbuf ;HL:= Source ld de,CSboot ;DE:= Destination ld bc,180h ;BC:= Size ldir ;Move boot code to resting place jp CSboot ;and go boot ;====================================================================== ; BTER - print the boot error message (18_Dec_83) ;================================================ ; Bter: ld de,bterr ;boot error mesg. call mesg jp Fatal ;GOTO print fatal error message and halt page ;====================================================================== ; PARK - Park the Hard Disk Heads (27_Mar_84) ;============================================ ; 1) This routine parks the heads of any active HARD disk on its ; maximum cylinder plus the park offset (PrkOff) in its Mtab. ; 2) If a matching Mtab cannot be found or if the seek operation ; fails then the program halts after printing an error message. ; Park: ld a,0 set @HRDDSK,a ld (iy+PhyDrv),a ;PhyDrv = 1st Hard Disk PkLp1: ld a,(iy+PhyDrv) ;Repeat ld (CpyDrv),a ; (Update local copy of drvstb) out (DrvStb),a ; Select the next Hard disk drive call PlsMtr ; Pulse its Motor On line ld b,3 ; B:= 10 ms delay ld c,$READY ; C:= Test ready status call DLY ; call Delay jr z,Pksk2 ; If (Hard disk ready eq true) call GetIX ; Find Drive's Mtab or a ; If (Mtab NOT found) jr nz,PkErr ; GOTO park error bit @DrvCal,(ix+DskDef1) ; If (Drive NOT calib.) jr nz,PkSk1 call HOM ; Home the heads or a ; If (Error True) jr nz,PkErr ; Exit PkSk1: set @nover,(iy+OpFlag) ; (Set No Verify Flag) ld e,(ix+MaxCyl) ld d,(ix+MaxCyl+1) ; DE:= Desired Track Number call SEK ; Seek to Maximum Cylinder or a ; If (Error eq true) jr nz,PkErr ; Goto Park Error ld a,(ix+PrkOff) ; Get Step Offset cp 0FFh ; If (Offset ne 0FFh or 0) jr z,Pksk2 cp 0 jr z,Pksk2 ld d,a ; D:= Offset Cnt ld a,(CpyDrv) or $DIR out (DrvStb),a ; Set direction ex af,af' ; AF':= Drv PkLp2: ld b,(ix+STPRCL) ; Repeat calì STP ; Call Step dec d ; Dec Offset Cnt jr nz,PkLp2 call Settle ; Wait Settling Delay Pksk2: inc (iy+PhyDrv) ; PhyDrv:= Next HARD Disk ld a,(iy+Phydrv) cp 4 ; (Last Hard Disk + 1) jr nz,PkLp1 ;Until (Both HARD disks have been parked) ret ;Return PkErr: ld de,PrkErr ;DE:= Park Error Message call Mesg ;Print Park Error Message call Fatal ;Goto Fatal page ;--------------------------------------------------------------------------- ; GETIX - Set IX to an Mtab referencing the current Physical Drive (8_Jan_84) ;---------------------------------------------------------------------------- ; 1) The Park routine uses this routine to find an Logical drive (Mtab) ; that references the current Physical Drive (passed in PhyDrv). ; 2) If the Drive was found then the accm is returned equal to zero and ; the IX is positioned at the start of the drive's Mtab. ; 3) If the Drive was not found then the accm is returned non-zero. ; GetIX: ld a,0 ;Set HstDsk to 1st Logical Drive ld (iy+HstDsk),a GIXlp: ld a,(iy+HstDsk) ;Repeat Drive:= next Logical drive call Gdsk ; Get Logical Drive's Mtab push hl pop ix ; IX:= Current Mtab ld a,(ix+DskDef0) ; If (Mtab references PhyDrv) and $PHYADR cp (iy+PhyDrv) ld a,0 ; Set No Error (Match) ret z ; Return inc (iy+HstDsk) ; Inc HstDsk ld a,(iy+HstDsk) cp 5 ; (Maximum number of Mtabs) jr nz,GIXlp ;Until (all Logical Drive Checked) ld a,0FFh ;Set Error Return (NO Match) ret ;Return page ;====================================================================== ; DISCIO - Disk I/O with Error Handeling (10_Aug_84) ;=================================================== ; 1) This routine routine does virtual drive processing, involks the ; disk I/O execution routine, does error handeling and Sector ; ReMapping. ; 2) Note that for the duration of this routine the IX register is ; pointing to the start of the current drive's Mtab. ; 3) Register Usage: ; A -> General Purpose, Returned status ; HL -> Used to get pointer to start of current MTAB ; IX -> Pointer to start of current MTAB ; DiscIO: ex af,af' ;Save the alternate register set push af ex af,af' push ix ld a,(iy+hstdsk) call Gdsk ;HL:= Pointer of current mtab push hl pop ix ;IX:= Start of the current MTAB call Virt ;Take care of virtual drive processing res @MapRd,(iy+DFlag) ;Clear the Bad Map Read Flag res @MapEr,(iy+DFlag) ;Clear the Bad Map Error Flag bit @HrdDsk,(ix+DskDef0) ;If ( (This is a Hard Disk) jr z,DscLp1 bit @InMap,(iy+OpFlag) ;and (The sector is in bad map) ) jr nz,DscSk0 ; Goto Check the Bad Map DscLp1: ld (iy+ErFlag),0 ;Loop (reset the error flag) call ExDisk ; Attempt the disk operation or a ; If (disk operation successful) jr z,DscDon ; Break call Ertran ; Translate the error code ld (iy+ErFlag),c ; Set the Bios Level Error Code ld (RomErr),a ; Set the Rom Level Error Code and $REMAP ; If ( (Error is ReMappable) and jr z,DscSk2 DscSk0: bit @HasBad,(ix+dskdef1) ; and (Media has Bad Map) ) jr z,DscSk2 call BadChk ; Check Bad Map jr nz,DscFtl ; If (error eq true) quit jr nc,DscSk1 ; If (sector was found) set @InMap,(iy+OpFlag) ; Sector's in bad map call LdPhy jr DscLp1 ; Loop (sect replaced) DscSk1: seô @MapEr,(iy+DFlag© » Elså Set MapEò true biô @BufOk,(iy+OpFlag) ; If (buf valid) jr nz,DscSk4 ; Done DscSk2: call ErHand ; Do error handeling cp 'R' ; If (Response eq R) jp z,DscLp1 ; RETRY cp 'A' ; Else If (Response eq A) jr z,DscSk4 ; ABORT bit @HRDDSK,(ix+dskdef0) ; Else If (floppy disk) jr nz,DscSk3 set @InMap,(iy+OpFlag) ; Set InMap DscSk3: res @MapEr,(iy+DFlag) ; Else IGNORE DscDon: ld (iy+ErFlag),0 ;Reset the error flag DscSk4: bit @MapEr,(iy+DFlag) ;If ( (there was a re:mappable error) jr z,DscSk5 bit @BufOK,(iy+OpFlag) ;and (the buffer data is valid) ) jr z,DscSk5 set @InMap,(iy+OpFlag) ; Sector's in bad map call ReMap ; Re:Map the sector or a ; If (ReMapping error eq true) jr nz,DscFtl ; Quit ld (iy+ErFlag),0 ; Reset the error flag DscSk5: pop ix ex af,af' ;Restore the alternate register set pop af ex af,af' ld a,(iy+ErFlag) ;Return the Bios level error code ret ;Return ; Print Error Messages and Then Halt DscFtl: Push af ;Save the error code call PbeMsg ;Print the Basic Error Message call PbrMsg ;Print the Bios and Rom Level Errors pop af ld (RomErr),a ld (iy+ErFlag),ERbm call PbrMsg ;Print the Bios and Rom Level Errors in a,(cstat) ;If (Test and diagnostics mode enabled) and $DIAGM jr z,DscSk5 ; Continue Processing jp Fatal ;Print Fatal Message and Halt page ;---------------------------------------------------------------------- ; VIRT - take care of virtual drive processing (24_Sept_83) ;---------------------------------------------------------- ; 1) Register Usage: ; A -> General Purpose ; DE -> Message Pointer ; IX -> start of the IX area ; IY -> start of the IY area ; Virt: ld a,(iy+hstdsk) ;A:= Current Drive Number cp (iy+cdsk) ;If (drive same as current drive) ret z ; return ld (iy+cdsk),a ;update current drive bit @VD,(ix+dskdef0) ;If (Current drive is NOT virtual) ret z ; return cp (iy+vdsk) ;If (New drive same as current virtual) ld (iy+vdsk),a ; (update vdsk to new drive) ret z ; return add a,'A' ;A:= ascii letter code for drive ld e,(iy+vdrvp) ld d,(iy+vdrvp+1) ;DE:= pointer to virtual drive ld (de),a ;Virtual_Drive in message:= current drive ld e,(iy+vmsgp) ;DE: pointer to virtual drive mesg ld d,(iy+vmsgp+1) virtm: call Mesg ;print mesg. plop: call CinIY ;Repeat get response cp cr jr nz,plop ;Until (response eq Carriage Return) ld de,CRLF call Mesg ;print cr & lf ret page ;---------------------------------------------------------------------- ; ERTRAN - Error Code Translation (15_Dec_83) ;------------------------------------------- ; 1) This routine translates the rom generated error code into a bios ; level error code. ; 2) The translation is done using errtbl. Errtbl is organized as a ; series of two byte entries. The first byte is the rom level error ; code (all rom level error codes appear in this table once and only ; once). The second byte is a bios level error code. ; 3) Register Usage: ; A -> Enters and Returns the Rom Level Error ; C -> Returns the Bios Level Error ; HL -> General Error Table pointer ; ;Setup the registers ertran: ld c,a ;C:= Rom Level Error Code ld hl,errtbl ;HL:= Base of Validation/Translation Table ;Validate the error code (using errtbl) ertrlp: ld a,(hl) ;Loop cp c ; If (error code matches table) jr z,ermtch ; Break cp Euk ; If (error is not in the table) jr z,ermtch ; Break inc hl ; Table_Pointer:= Table_Pointer+2 inc hl jr ertrlp ;Restore the Rom level Error Code and retrieve Bios Level Error code ermtch: inc hl ;HL:= Bios Level Error Code ld a,c ;A:= Rom Level Error Code ld c,(hl) ;C:= Bios Level Error Code ret page ;---------------------------------------------------------------------- ; ERHAND - Error Handeler (28_Nov_83) ;------------------------------------ ; 1) This routine will display the error if error displays are not ; suppressed. If error displays are not suppressed and the error ; response is not suppressed then this routine will get the ; user response. ; 2) Unless a response is gotten from the user this routine will ; always return with the 'A' (abort operation) option. ; erhand: bit @serd,(iy+OpFlag) ;If (Error display NOT supressed) ld a,'A' ; (Default_Response:= Abort) jr nz,erhsk1 call PbeMsg ; Print Basic error message call PbrMsg ; Print Bios & Rom level errors bit @serur,(iy+OpFlag) ;If (User response NOT suppressed) ld a,'A' ; (Default_Response:= Abort) jr nz,erhsk1 call Ersp ; (get the user response) erhsk1: ret ;Return ;---------------------------------------------------------------------- ; PBEMSG - Print the basic error message (18_Dec_83) ;--------------------------------------------------- ; 1) This routine Prints the basic error message (Disk error on drive x) ; 2) Register Usage: ; A -> General Purpose ; C -> Output Character ; DE -> Pointer to start of Error Message ; PbeMsg: ld de,DMESG call Mesg ;Print 'Disk error on drive ' ld a,(iy+hstdsk) add a,'A' ;(Convert BDOS drive number to ascii) ld c,a call CoutIY ;Print the current drive's letter ld de,COLN call Mesg ;Print ': ' ret page ;---------------------------------------------------------------------- ; PBLMSG - Print the Bios and Rom level Error Messages (18_Dec_83) ;----------------------------------------------------------------- ; 1) The error code (passed in errflag) is used to form an offset ; into the error message pointer table. ; 2) Register Usage: ; A -> General Purpose ; C -> Output character ; DE -> Offset ; HL -> Message String Pointer ; ; Print the Bios level Error Message PbrMsg: ld a,(iy+ErFlag) ;A:= Bios level error code dec a ;(set error code to zero base) rlca ld e,a ld d,0 ld hl,ETAB add hl,de ;HL:= Error Message Table Pointer ld e,(hl) inc hl ld d,(hl) ;DE:= Address of the Error Message call Mesg ;Print the specific error message ; Print the Rom level Error Message in a,(cstat) ;If (diagnostics mode NOT selected) and $DIAGM ret nz ; Return ld c,'(' call CoutIY ld a,(Romerr) ;A:= Rom Level Error Code call outbyt ;Print the rom level error code ld c,')' call CoutIY ret ;Return ;---------------------------------------------------------------------- ; ERSP - Get the Error Response (14_Nov_83) ;------------------------------------------ ; 1) This routine Prints the error response message and then accepts ; an appropriate reply (A,I,R) from the current console device. ; 2) Register Usage: ; A -> General Purpose (returned response A,I or R) ; C -> Output character ; Ersp: ld de,RESM ;Print the error response message call Mesg erlp: call CinIY ;Loop Get user response from console and 5Fh ; (force upper case) cp 'A' ; If (response eq "a" ABORT) jr z,eret ; Break cp 'R' ; Else If (response eq "r" RETRY) jr z,eret ; Break cp 'I' ; Else If (response eq "i" IGNORE) jr nz,erlp ; Break eret: push af ;(save the response) ld c,a ;Echo the character call CoutIY ld de,CRLF call Mesg ;Output a newline pop af ;(restore the response) ret page ;---------------------------------------------------------------------- ; BADCHK - Check the bad map table for current sector (19_Dec_83) ;---------------------------------------------------------------- ; 1) This routine checks the bad map table for the current sector. ; 2) Return Condition Accm Carry_Flag HL_Register_Pair ; Error Non-Zero UnDefined UnDefined ; Not Found 0 Cleared UnDefined ; Found 0 Set Points to replacement ; 3) Register Usage: ; A -> General Purpose ; B -> Counter for number of entries checked ; C -> Current Number of bad sectors in the map ; DE -> offset to move the pointer past the replacement sector ; HL -> Pointer into the bad map table. ; badchk: call opnbad ;Open bad map for the selected drive or a ;If (Error in opening the bad map) ret nz ; Return (accm ne 0) ld c,(hl) ;C:= current number of bad map entries inc hl inc hl ;HL:= Pointer to 1st badmap entry ld de,4 ;DE:= Increment (to move past replacement) ld b,0 ;B:= counter bclp1: ld a,b ;While (counter .lt. # of entries) sub c ret z ; (Return accm=0, carry=clear) ld a,(iy+phytrk) ; If (Track_lo eq table) cp (hl) inc hl jr nz,bc1 ld a,(iy+phytrk+1) ; and (Track_hi eq table) cp (hl) inc hl jr nz,bc2 ld a,(iy+phyhd) ; and (Head eq table) cp (hl) inc hl jr nz,bc3 ld a,(iy+physec) ; and (Sector eq table) cp (hl) inc hl jr nz,bc4 xor a ; (clear accm & set 0 flag) scf ret ; Return accm=0,carry=set bc1: inc hl ;Else bc2: inc hl ; Adjust the pointer bc3: inc hl bc4: add hl,de ; Pointer:= start next entry inc b ; Counter:= Counter + 1 jp bclp1 page ;---------------------------------------------------------------------- ; REMAP - ReMap the current sector into the Bad Map (6_Jun_84) ;------------------------------------------------------------- ; 1) This routine ReMaps the current sector. It does this by clearing ; the buffer (if necessary), entering the current sector into the ; bad map, writing the buffer into the replacement sector, Destroying ; the bad sector and then closing the bad map. ; 2) If the Smudge fails due to a Header Error (Eha,Ehc,Ess or Ehn) then ; the No verify after seek flag is set and a second attemt is made to ; smudge the sector. This takes care of tracks that don't have any ; good sectors. ; ;Enter the sector into the bad map ReMap: call BadEnt ;Enter the bad Sector or a ;If (sector could not be entered) ret nz ; Return ;Write the buffer contents into the replacement sector push hl call SwpPio ;Save the current Track,Head and Sector pop hl call LdPhy ;Load the Phy* param. with Replacement ld (iy+ioadd),LOW Wrio ;Execution Vector:= Write ld (iy+ioadd+1),HIGH Wrio call ExDisk ;ReMap sector to its new location or a ;If (Error in writing sector) ret nz ; Return ;Destroy the Original Sector call SwpPio ;(Restore The Original Sector) ld (iy+ioadd),LOW Smudge ;Execution Vector:= Smudge ld (iy+ioadd+1),HIGH Smudge call ExDisk ;Destroy the original sector or a ;If (Sector could not be smudged) jr z,RmSk2 cp Eha ; If ( (Error eq Header Addr) Or jr z,RmSk1 cp Ehc ; (Error eq Header CRC) Or jr z,RmSk1 cp Ehn ; (Error eq Head Number) Or jr z,RmSk1 cp Ess ; (Error eq Sector Size) ) And ret nz RmSk1: bit @NoVer,(iy+OpFlag) ; (No_Verify Flag NOT Set) ret nz set @NoVer,(iy+OpFlag) call ExDisk ; Try to Destroy the Sector again res @NoVer,(iy+OpFlag) or a ; If (there's still an error) ret nz ; Return RmSk2: call SwpPio ;(Restore the New Sector) ;Close the Bad Map call BadCls ;Close the bad map ret ;Return (error set by BadCls) page ;---------------------------------------------------------------------- ; BADENT - Put the current sector into the bad map (18_Dec_83) ;------------------------------------------------------------- ; 1) This routine either puts the current sector in the bad map or ; returns the bad map full error message. ; 2) If there are 5 or less free entries remaining in the bad map then ; a Bad Map almost Full error message is printed. ; 3) Register Usage: ; A -> General Purpose (returned=0 for no error) ; DE -> Index/Pointer ; HL -> Returned pointing to the replacement sector in bad map ; BadEnt: call OpnBad ;Open bad map for the selected drive or a ;If (Error in opening the bad map) ret nz ; return (accm ne 0) ld a,(hl) ;A:= Current number of bad map entries inc hl cp (hl) ;B:= Maximum number of bad map entries jr c,BeSk1 ;If (max number of entries already hit) ld a,Ebf ; Accm:= Error (bad map full) ret ; Return BeSk1: push af add a,5 cp (hl) ;If (Current Entries within 5 of limit) jr c,BeSk2 push hl ld de,BMEwaf ; DE:= Warning Bad Map Almost Full call Mesg ; Print the message pop hl BeSk2: pop af ld e,a inc a dec hl ;(Move pointer back) ld (hl),a ;Update curent number of bad sectors mapped inc hl inc hl ;HL:= Start of bad map table sla e ;current number of entries * 8 sla e sla e ld d,0 ;BC:= Offset to the replacement sector add hl,de ;HL:= Start of current entry push hl ;(Save pointer into bad map) push iy pop hl ld de,PhyTrk add hl,de ;HL:= Source (Pointer to PhyTrk) pop de ;DE:= Destination (Pointer into bad map) ld bc,4 ;BC:= Count ldir ;Move the bad sector into the bad map ex de,hl ;HL:= Pointer to replacement sector ld a,0 ;Error:= None ret ;Return page ;---------------------------------------------------------------------- ; OPNBAD - Open the Bad Map (18_Dec_83) ;-------------------------------------- ; 1) This routine tries to open the current device's bad map. If the ; was successfully opened then the accm is returned equal to zero ; and the HL register pair is retuned pointing to the start of the ; bad map + 6 (Bad Entries Current). ; 2) Notice that the altbuf is referenced by using a vector called badmap ; 3) Register Usage: ; A -> Returned Status (0 = No Errors) ; BC -> Counter and flag for sector comparison ; DE -> Offsets ; HL -> Pointer (returned pointing to start of drive's bad map+6) ; ;Save the disk buffer and the physical pointer to the sector OpnBad: bit @MapRd,(iy+DFlag) ;If (Bad_Map_Read_Flag is True) jr nz,OpnSk2 ; Skip to Map Validation call SwpBuf ;Swap disk buffer with Bad Map Buffer call SwpPio ;Swap Phy* and IOadd Param. with PioBuf ;Setup to read the boot sector ld (iy+phytrk),0 ;Setup to read the boot sector ld (iy+phytrk+1),0 ;Track:= 0 ld (iy+phyhd),0 ;Head:= 0 ld (iy+physec),1 ;Sector:= 1 bit @SECZRO,(ix+dskdef0) ;If (media sector numbering starts w/0) jr z,OpnSk1 dec (iy+physec) ; Start_Sector:= Start_Sector - 1 OpnSk1: ld a,(ix+dskdef0) and $PHYADR ld (iy+phydrv),a ;(install the current drive number) ld (iy+ioadd),LOW rdio ld (iy+ioadd+1),HIGH rdio ;IO_Address:= Read a sector ;Read the Boot Sector call ExDisk ;If (there was an error) or a ; Error:= Can't Read Boot Sect. ret nz ; Return ;Verify The ID Number in the Boot Sector ld hl,(dskbuf+180h) ;HL:= ID Number ld de,BadID ;**** must match ID in boot sector **** or a ;(Clear the Carry Flag) sbc hl,de ;If (bad map ID byte doesn't match) ld a,Ebi ; Error:= Invalid ID ret nz ; Return ;Move Bad Map Pointers into Genbuf ld de,badtrk ;DE:= Badtrk entry in genbuf ld hl,dskbuf+182h ;HL:= Pyhtrk of bad map in boot sector ld bc,6 ;BC:= Length (Phy* + Badoff) ldir ;Move the bad map parameters into place ;Read the Bad Map ld hl,badtrk call LdPhy ;Move BadTrk through BadSec into Phy* call ExDisk ;Read the bad map (vector still = Rdio) or a ;If (there were any errors) ret nz ; Return (Error) ;Restore the Phy* and IOadd Parameters and the disk buffer contents call SwpBuf ;Swap disk buffer with Bad Map Buffer call SwpPio ;Swap Phy* and IOadd Param. with PioBuf set @MapRd,(iy+DFlag) ;Bad_Map_Read_Flag:= True ;Validate the Bad Map Table's Revision Number OpnSk2: ld hl,(badmap) ld de,(badoff) add hl,de ;HL:= Start of the Bad Map ld de,4 add hl,de ;HL:= ID byte in bad map Header Field ld a,BadRev ;If (Bad Map ID is gt current ID) cp (hl) ld a,EBr ; Error:= Bad Revision ret c ; Return ;Set HL register pair to start of Bad Map + 6 (Bad Entry Current) inc hl inc hl ;HL:= Pointer Bad Entries Current ld a,0 ;Accm:= No Error ret page ;---------------------------------------------------------------------- ; BADCLS - Close the Bad Map (18_Dec_83) ;--------------------------------------- ; 1) This routine writes the bad map sector back out to the disk. ; 2) All registers are altered. The accm is returned 0 if there were ; no errors. ; ;Exit if the bad map hasn't been read yet BadCls: bit @MapRd,(iy+DFlag) ;If (bad map hasn't been opened yet) ld a,Ebn ; (Error:= Bad Map Not Opened) ret z ;Swap the Buffers call SwpPio ;Save Phy* through IOadd Parameters call SwpBuf ;Save the disk buffer ;Write the Bad Map ld hl,badtrk call LdPhy ;Move Badtrk through badsec into Phy* ld (iy+ioadd),LOW wrio ;Setup the exection vector ld (iy+ioadd+1),HIGH wrio call ExDisk ;Write the Bad Map or a ;If (there was a write error) ret nz ; Return ;Restore the Disk Buffer call SwpPio ;Restore Phy* through IOadd Parameters call SwpBuf ;Restore the disk buffer ld a,0 ;Error:= None ret ;Return page ;---------------------------------------------------------------------- ; SWPPIO - Swap Phytrk through Ioadd with PIOBUF (15_Dec_83) ;----------------------------------------------------------- ; 1) This routine swaps PhyTrk through IOadd in the AI area with the ; contents of PioBuf in the general buffer area. ; SwpPIO: push iy pop hl ;HL:= Start of the General Data Area ld de,Phytrk ;DE:= Offset to Physical Track entry add hl,de ;HL:= Area_1 - Points to PhyTrk ld de,PioBuf ;DE:= Area_2 - Points to PioBuf ld bc,7 ;BC:= Length of area to swap (PioBuf) call Swap ;Swap Phytrk through Ioadd with PioBuf ret ;Return ;---------------------------------------------------------------------- ; SWPBUF - Swap Dskbuf with the Bad Map Bufferr (11_Dec_83) ;---------------------------------------------------------- ; 1) This routine swaps the contents of the disk buffer (dskbuf) with ; the contents of the Bad Map Buffer (Currently the Alternate Buffer) ; 2) All register pairs are preserved. ; SwpBUF: ld hl,DskBuf ;HL:= Area_1 - Start of the DskBuf ld de,(badmap) ;DE:= Area_2 - Start of Bad Map Buffer ld bc,1024 ;BC:= Length of the disk buffer call Swap ;Swap Dskbuf with Bad Map Buffer ret ;Return ;---------------------------------------------------------------------- ; LDPHY - Load the Physical Parameters through the HL (15_Dec_83) ;---------------------------------------------------------------- ; 1) This routine loads the Physical Track, Physical Head and Physical ; Sector from the location specified by the HL register pair. ; 2) Notice that NONE of the Flags are affected by this routine. ; LdPhy: ld a,(hl) ld (iy+phytrk),a inc hl ld a,(hl) ld (iy+phytrk+1),a ;Load new track inc hl ld a,(hl) ld (iy+phyhd),a ;Load new head inc hl ld a,(hl) ld (iy+physec),a ;Load new sector inc hl ret ;Return page ;---------------------------------------------------------------------- ; EXDISK - Execute a disk routine (20_Dec_83) ;-------------------------------------------- ; 1) This routine attempts a disk operation for up to 'n' retries. ; 2) Register Usage: ; A -> General Purpose (returned status: non-zero = error) ; B -> Major Retry Count ; C -> Minor Retry Count ; E -> Temp Save for the Rom Level error code ; HL -> Vector to disk routine ; ExDisk: ld b,(iy+retry) ;Retry_Count:= Max ld c,3 ;Sub_Retry_Count:= 3 ExLp1: push bc ;Loop call PRP ; Start up the disk pop bc or a ; If there were errors jr nz,ExSkp1 ; Goto Error Recovery push bc ; Repeat call PlsMtr ; Pulse the Motor On Line call DioHL ; Do Disk routine pop bc or a ; If (no errors) jr z,ExDone ; Break ExSkp1: call Fixerr ; Fix error (if possible) ld e,a ; (save error in E) and $NOTRY ; If (Error NonRetryable) jr nz,ExSkp3 ; Quit ld a,(iy+Retry) ; If (1/2 retries done) srl a cp b jr nz,ExSkp2 res @DrvCal,(ix+dskdef1) ; Drive:= DeCal ExSkp2: djnz ExLp1 ; Until (Retries eq 0) ExSkp3: ld a,e ;(Restore error code) ExDone: ret ;Return ;Execute the rdio, wrio or fmtio routine DioHL: ld l,(iy+ioadd) ld h,(iy+ioadd+1) ;HL:= Execution Vector jp (hl) page ;---------------------------------------------------------------------- ; FIXERR - Fix Errors if Possible (27_Mar_84) ;-------------------------------------------- ; 1) This routine adjusts retry counts and takes remedial action on ; certain errors. ; 2) The subroutine cnt is used to increment the Retry count and to ; decrement the sub retry count. If the sub retry count is zero ; then the B register is forced to 1 and the zero flag is returned ; set. ; 3) Notice that the loction (error) is always valid after executing ; this routine. ; 4) Register Usage: ; A -> Returned status from the last disk operation ; B -> Retry Count ; C -> Sub Retry Count ; FixErr: ld (error),a ;Save the current error ;Header Error ;------------ ; FXsk1: cp Ehd ;If (error eq Header) jr nz,FXsk2 push bc call verify ; Verify the Header pop bc or a ; If (There was no error) jr nz,FXsk11 ld a,Esn ; Error:= Sector FXsk11: ld (error),a ; Update the error code ex de,hl ; HL:= Cylinder Found cp Esk ; If (its a seek error) call z,SETcyl ; Update current cylinder ;Seek Error ;---------- ; FXsk2: cp Esk ;If (Error eq Seek) jr nz,FXsk3 call cnt ; Adjust the Retry counts jr EndFix ; Not Ready - Not Found - Missing Header Address Mark ;---------------------------------------------------- ; FXsk3: cp Enr ;If ( (Error equ Not Ready) or jr z,FXsk31 cp Enf ; (Error eq Not Found) or jr z,FXsk31 cp Eha ; (Error eq Missing header addr) ) jr nz,FXsk4 FXsk31: bit @HrdDsk,(ix+dskdef0) ; If ( (its a floppy disk) and jr nz,EndFix call ChkRot ; (disk IS NOT rotating) ) or a jr nz,EndFix ld a,Enr ld (error),a ; Error:= Not Ready call Jog10 ; Jog to trk 10 call cnt ; Adjust the Retry counts jr EndFix ;Unreadable Media ;---------------- ; FXsk4: cp Eum ;If (error eq Unreadable Media) jr nz,EndFix call cnt ;If (Adjusted Retry Counts ne 0) call nz,JogLE3 ; Step in 3 tracks EndFix: ld a,(error) ;Return with error code in accm. ret ;---------------------------------------------------------------------- ; CNT - counter ;-------------- ; 1) The routine increments the Retry count and decrements the ; sub retry count. If the sub retry decrement count results in ; a value of zero then the B register is forced to 1 and the ; ZERO-FLAG is returned SET. ; 2) This routine is only used by the fix error subroutine. ; 3) Register usage: ; B -> Retry Counter ; C -> Sub Retry Counter ; cnt: inc b ;Retry_Count:= Retry_Count + 1 dec c ;Sub_Retry_Count:= Sub_Retry_Count - 1 ret nz ;If (Sub_Retry_Count eq 0) ld b,1 ; Retry_Count:= 1 (effectively 0) ret page ;---------------------------------------------------------------------- ; JOG10 - Move the Head to Home and then to track 10 (9_Feb_84) ;-------------------------------------------------------------- ; 1) This routine homes the disk heads and then sends them out to track ; 10. This has been done to correct drive startup problems that ; occur with certain kinds of media. ; Jog10: push bc ;Save the BC pair call HOM ;Home the Disk Heads ld de,10 ;DE:= Cylinder 10 ld a,(iy+OpFlag) push af ;(save OpFlag) set @NoVer,a ;No_Verify:= true ld (iy+OpFlag),a call SEK ;Seek to cylinder 10 pop af ld (iy+OpFlag),a ;(Restore OpFlag) res @FMoton,(iy+DFlag) ;Clear floppy Motor flag res @DrvCal,(ix+DskDef1) ;Decalibrate the drive pop bc ;Restore the BC pair ret ;Return ;---------------------------------------------------------------------- ; JOGLE3 - Jog in Three Steps if current track is LE 3 (27_Mar_84) ;----------------------------------------------------------------- ; 1) This routine checks if the current track is less than or equal ; to track 3. If the current track is le track 3 then the heads are ; stepped in three tracks and the drive is set to decalibrated. ; ; Common Re-Home Routine (Seek to track three and then home) JogLE3: push bc ;(save retry counts) ld a,(iy+phytrk+1) ;If (current track le 3) or a jr nz,JogDon ; (Hi_Byte ne 0 - Done) ld a,(iy+phytrk) cp 3 jr nc,JogDon ; (Lo_Byte gt 3 - Done) ld a,(cpydrv) or $DIR ; Direction:= IN out (drvstb),a ; (setup head before step) ex af,af' ; (drive strobe to A') ld e,3 ; E:= 3 Steps Joglp1: ld b,(ix+STPRCL) ; Repeat B:= Step_Delay call STP ; Step the heads dec e ; Steps:= Steps-1 jr nz,Joglp1 ; Until (Steps eq 0) call Settle ; Wait for the Drive to Settle res @DRVCAL,(ix+dskdef1) ; (Drive:= decalibrated) JogDon: pop bc ;(restore retry counts) ret page ;---------------------------------------------------------------------- ; PRP - Main Line of Prep (8_Feb_84) ;----------------------------------- ; 1) This routine selects the drive, homes the heads (if necessary) ; and seeks to the proper track (if necessary). ; 2) Register usage: ; A -> General purpose ; DE -> Sector Size offset ; HL -> Current Cylinder ; ; Select the drive and start it PRP: call Setup ;Setup variables and constants call Delays ;Do the Motor On and Head Load Delays or a ;If (Error eq True) jr nz,PRPerr ; Exit ; Home the heads if necessary bit @recal,(iy+OpFlag) ;If ( (user recal flag is set) or jr nz,PRPsk1 bit @DrvCal,(ix+DskDef1) ; (Drive NOT calibrated) ) jr nz,PRPsk2 PRPsk1: call HOM ; Home the heads or a ; If (Error eq True) jr nz,PRPerr ; Exit ; Seek to the desired track if necessary PRPsk2: ld e,(iy+PHYTRK) ; DE:= Desired Cylinder ld d,(iy+PHYTRK+1) call SEK ; Seek to the Desired Track or a ; If (Error eq True) jr nz,PRPerr ; Exit ;Update the value of Pre-Compensation ld a,(savpc) ld b,a ld a,(cpymod) or b ld (cpymod),a ;Update the value of Low Current ld a,(savlc) ld b,a ld a,(cpydrv) or b ld (cpydrv),a ld a,0 ;(0 = no error) PRPerr: ret ;Return page ;---------------------------------------------------------------------- ; SETUP - Select the Drive (28_Nov_83) ;-------------------------------------- ; 1) This routine sets up the intitial values of blocks, cpymod, cpydrv ; and filchr. ; 2) Notice that the mode byte is built for a floppy disk. This local ; copy is modified when the set pre-compensation routine is called. ; To use the cpymod byte for hard disks you must strip all but the ; value of pre-compensation and then add back $MFM and $STD. ; 3) Register Usage: ; A -> General Purpose ; DE -> Used to build offsets ; HL -> Table Pointer ; ; Determine the number of 32 byte blocks to transfer Setup: ld a,(ix+dskdef1) and $SIZMSK ld e,a ld d,0 ;DE:= Sector size (0 to 3) ld hl,tsize ;HL:= Table of conversions add hl,de ld a,(hl) ld (blocks),a ;Blocks:= number of 32 byte blocks ; Build a Table Offset for the mode and fill bytes ld a,0 bit @DRVDEN,(ix+dskdef1) jr z,SETsk1 ;If (drive is double density) or 00000001b ; A:= offset to MFM SETsk1: bit @DRVSIZ,(ix+dskdef1) jr z,SETsk2 ;If (drive is standard 8") or 00000010b ; A:= offset to 8" SETsk2: ld e,a ld d,0 ;DE:= Table Offset ; Set the value of the fill byte ld hl,tfill add hl,de ;Form Pointer into fill character table ld a,(hl) ld (filchr),a ;save the fill character ; Set the value of CPYMOD (copy of mode) ld hl,tmode ;HL:= Pointer to base of mode table add hl,de ;HL:= Pointer into the mode table ld a,(hl) ;(basic mode byte for floppy disks) ld (cpymod),a ;CPYMOD:= copy of the mode byte ; Set the value of CPYDRV (copy of drvstb) ld a,(iy+PHYHD) ;A:= Desired Head sla a sla a ;(Move Head designation over 2 bits) or (iy+PHYDRV) ;(add in the drive designation) ld (cpydrv),a ;Copy of Drive Strobe:= current drive ret page ;---------------------------------------------------------------------- ; DELAYS - Delay for Motor On and Head Loads (25_Jan_84) ;------------------------------------------------------- ; 1) This routine selects the drive and pulses the motor on line and ; then does the motor on and head load delays if necessary. ; 2) If the drive has a ready line then it is sampled. ; 3) If the drive has a ready line and it isn't active then a Not Ready ; Error status will be returned (else status will equal 0). ; 4) Register Usage: ; A -> General Purpose (returned=0 for OK or Enr for Not Ready) ; B -> Delay time in 3ms incrememnts (seel DLY) ; C -> Status line check Mask (see DLY) ; Delays: ld a,(cpydrv) ;A:= Copy of Drive Strobe out (drvstb),a ;Select the drive ;Check if the motor line is active and pulse (repulse) it in a,(cstat) and $MTR ;If (motor is currently off) jr nz,DLSsk1 res @FMOTON,(iy+DFlag) ; Clear the floppy motor on flag DLSsk1: call PlsMtr ;Pulse the Motor on Line ;Check if the floppy motors have been started bit @HRDDSK,(iy+phydrv) ; If (Drive eq Floppy Disk) and jr nz,DLSsk3 bit @FMOTON,(iy+DFlag) ; If (floppy motor off) jr nz,DLSsk3 ; do the delay set @FMOTON,(iy+DFlag) ; (floppy_motor_flag=on) ;Do a motor on delay if the motor line is off ld c,0 ; Mask:= None ld b,(ix+motdly) ; Delay:= Motor_on Delay call DLY ; Do motor on delay ;Do a Head load delay if we've changed drives DLSsk3: ld a,(cpydrv) ;A:= Current Drive Select Byte and $PHYADR ;(remove all bits except drive number) cp (iy+phydrv) ;If (Drive ne current) jr z,DLSsk4 ld c,0 ; Mask:= None ld b,(ix+hlddly) ; Delay:= Head_Load_Delay call DLY ; Do head load delay ;Check the ready line if the drive has one DLSsk4: bit @DRVRDY,(ix+dskdef1) ;If (Drive has a ready line to test) jr z,DLSsk5 ld c,$READY ; Mask:= Ready Line Test ld b,4 ; Delay:= 12 milliseconds call DLY ; If (Drive ready within time limit) jr nz,DLSsk5 ; goto normal return ld a,Enr ; Else Error:= Not Ready ret DLSsk5: ld a,0 ;A:= No Error ret ;Return page ;---------------------------------------------------------------------- ; HOM - Home the disk Heads (27_Mar_84) ;-------------------------------------- ; 1) This routine Homes the heads using the recalibration step rate. ; 2) Note: Step direction is set before checking the track zero sensor. ; 3) If cylinder zero is found then the cylinder table is updated, the ; drive is set to calibrated and the error flag, write pre-comp and ; low current are cleared; Otherwise, the drive is decalibrated and ; an error (accm=Enh) return is made. ; 4) Register Usage: ; A' -> Set to the Drive Strobe Image ; A -> General Purpose/Returned Status (0=no_error) ; B -> Step Delay ; C -> Zero'ed (see DLY) ; DE -> Maximum Number of Steps ; HL -> Current Cylinder ; HOM: ld a,(cpydrv) and NOT $DIR ;Direction:= OUT (i.e. toward home) out (drvstb),a ;(setup the head before the step pulse) ex af,af' ;(save drive strobe image in alt accm) in a,(drvsts) ;If (Heads not over track_0) and $TRK0 jr nz,HOMdon ld de,500 ; HL:= Number of Steps (='s lots) HOMlp1: ld b,(ix+STPRCL) ; Repeat B:= Step_Delay (Recal.) call STP ; Step the heads in a,(drvsts) ; If (Heads over track_0) and $TRK0 jr z,HOMsk1 call Settle ; Do Settle Delay or a ; If (error) ret nz ; Return in a,(drvsts) ; If (track_0 ok) and $TRK0 jr nz,HOMdon ; break HOMsk1: dec de ; Steps:= Steps - 1 ld a,d or e jr nz,HOMlp1 ; Until (Step_Count eq 0) res @DRVCAL,(ix+dskdef1) ; Drive:= De:calibrated ld a,Enh ; Error:= Not_Home ret ; Return (error) HOMdon: ld hl,0 call SETcyl ;Current_Cylinder:= 0 ld a,0 ;Error:= none ld (savpc),a ;Clear Write Pre-Comp ld (savlc),a ;Clear Low Current res @recal,(iy+OpFlag) ;User_Re:Calibrate_Flag:= Cleared set @DRVCAL,(ix+dskdef1) ;Drive:= Calibrated ret ;Return page ;---------------------------------------------------------------------- ; SEK - Seek to the Desired Track (27_Mar_84) ;-------------------------------------------- ; 1) This routine steps to the track number passed in the DE register ; pair if necessary. If the heads were moved or the drive is ; decalibrated then the current track, head and sector size are ; verified by a test read if the @novrf (no track verify) flag is ; clear and the values of write pre-comp and low current are updated. ; 2) Notice that the drive can only become calibrated if the current ; track was verified either by reading correct track number from ; header or from finding the track 0 sensor active. ; 3) The HL pair is always returned equal to the desired cylinder. ; 4) If there was a seek error then the current cylinder is set to ; the cylinder found actually found (NOT the desired cylinder). ; 5) Register Usage: ; A' -> Drive Strobe image (1 step_IN; 0 step_OUT) ; A -> General Purpose/returned status (0=no_error) ; B -> Temp Storage for direction mask/Step Delay ; C -> Zero'ed (see DLY) ; DE -> Enter with Desired Track ; HL -> Desired Track Number ; SEK: call GETcyl ex de,hl ;DE:= Current Cylinder Number call ABS ;If (Desired_Cylinder eq Current_Cylinder) jr nz,SEKsk1 bit @DRVCAL,(ix+dskdef1) ; If (drive is calibrated) ld a,0 ; (Error:= none) ret nz ; Return jr SEKvrf ; (Contine at verify) ;Move the Direction and drive select byte into the secondary accm SEKsk1: and $DIR ;Set the Direction bit ld b,a ld a,(cpydrv) or b out (drvstb),a ;(setup the head before the step pulse) ex af,af' ;A':= Drive_Strobe_Image + Direction Bit ;Seek Routine for drives with fast seek capabilities bit @FSTSEK,(ix+dskdef1) ;If (this is a fast seeking drive) jr z,SEKlp2 SEKlp1: ld b,0 ; Repeat B:= Step_Delay:= 0 call STP ; Step the Heads dec de ; Steps:= Steps - 1 ld a,d or e jr nz,SEKlp1 ; Until (all steps taken) call Settle ; Wait for the Drive to Settle or a ; If (Seek Complete Didn't assert) jr nz,SEKerr ; GOTO Error Return jr SEKvrf ; (Continue at verify) ;Step at the normal rate to the desired track SEKlp2: ld b,(ix+STPRAT) ;Repeat B:= Normal_Step_Delay call STP ; Step the Heads in a,(drvsts) ; If (Heads over track_0) and $TRK0 jr z,SEKsk2 ld de,0 ; DE:= Cylinder Found ld a,h ; If (desired cyl eq 0) or l jr z,SEKsk3 ; Break ld a,Esk ; Else A:= Seek Error jr SEKsk4 ; Update cylinder SEKsk2: dec de ld a,d ; Step_Count:= Step_Count - 1 or e jr nz,SEKlp2 ;Until (Step Count eq zero) SEKsk3: call Settle ;Wait the Settling Time ;If NO verify flag is clear read a header and verify all but sector SEKvrf: bit @nover,(iy+OpFlag) ;If (the No verify flag is clear) then ld a,0 ; (accm:= no error status) jr nz,SEKlod push hl call verify ; Verify the header pop hl or a ; If (Errors were detected) jr z,SEKcal cp Esk ; If (Error ne Seek) jr nz,SEKerr ; Goto Error Ret SEKsk4: ex de,hl ; (move current cyl -> hl) SEKcal: set @DRVCAL,(ix+dskdef1) ;Drive:= Calibrated SEKlod: push af call SETcyl ;Update the current cylinder (in HL) call SETplc ;Update write precomp and low current pop af ;(Restore return status) ret ;Return (Error:= none) ;Error Return SEKerr: res @DRVCAL,(ix+dskdef1) ; Else Set drive to De:Calibrated ret ; Return page ;---------------------------------------------------------------------- ; SETTLE - Wait for the drive to settle after stepping (28_Mar_84) ;----------------------------------------------------------------- ; 1) This routine waits the settling time of drive and then checks if ; the drive has a fast seek capability. If its a fast seeking drive ; then the Seek Complete line is monitored. ; Settle: ld b,(ix+STPSET) ;B:= Set Settling Time lä c,° »C:½ Masë (don'ô care) bit @FstSek,(ix+DskDef1) ;If (Drive Has Normal Seek) jr nz,StlSk1 call DLY ; Delay the Settling Time ld a,0 ; Status:= No Error ret ; Return StlSk1: ld a,0FFh ;If (minimum step delay) cp b jr nz,StlSk2 ld a,60 ; A:= Time Delay (about 250us) StlLp1: dec a ; Repeat jr nz,StlLp1 ; Until (time delay done) jr StlSk3 StlSk2: call DLY ;Else Do the Normal Delay StlSk3: ld b,0FFh ;B:= max delay (@750ms) ld c,$SEEKC ;C:= Seek Complete call DLY ;Delay for Seek Complete ld a,Enr ;If (Seek line did NOT assert) ret z ; Return Not Ready Error ld a,0 ;Status:= No Error ret ;Return ;---------------------------------------------------------------------- ; SETPLC - Setup Write Precomp and low current Values (13_Dec_83) ;---------------------------------------------------------------- ; 1) This routine sets the value of Savpc (save location for write ; pre-compensation) and Savlc (save for Low Current)., ; 2) The routine ABS returns the accm equal to 0FFh if HL (current cyl) ; is greater than or equal to the DE (start precomp/low-current); ; otherwise the accm is returned equal to zero. ; 3) Notice that the HL register pair is always returned equal to the ; desired cylinder (i.e. PhyTrk). ; 4) Register Usage: ; A -> General purpose ; B -> Temp Save for Low current mask ; DE -> Offset/starting cylinder of Precomp/Low_Current ; HL -> Enter with Value of current cylinder (usually=PhyTrk) ; ; Setup Write Precompensation Bit SETplc: ld e,(ix+STRPRE) ;(HL:= Desired Cylinder on entry) ld d,(ix+STRPRE+1) ;DE:= Starting track of Write Precompensation call ABS ;A:= 0FFh if Crnt_Track ge Start_Write_Pre-comp and $PRECMP ;Mask out all but the write pre-comp bit ld (savpc),a ;Update Savpc ; Setup the Low Current Bit ld e,(ix+STRLOC) ld d,(ix+STRLOC+1) ;DE:= Starting track of Low Current call ABS ;A:= 0FFh if Crnt_Track ge Start_Low_Current and $LC ;(Mask out all but the Low Current bit) ld (savlc),a ;(save the mask) ret page ;---------------------------------------------------------------------- ; STP - Step the Heads (9_May_83) ;-------------------------------- ; 1) This routine moves the heads one step. ; 2) The drive, and the direction of the step are preselected and ; put in the secondary accm. ; 2) Register usage ; A' -> Select Byte (Drive_Sel, Head_Sel & direction) ; A -> General Purpose ; B -> Delay Count (in 3ms increments) ; C -> Mask Byte (see delay routine) is zero'ed ; STP: ex af,af' or $STEP ;Toggle the step line out (drvstb),a xor $STEP out (drvstb),a ex af,af' ld c,0 ;(Mask byte to 0) call DLY ;Delay ret page ;====================================================================== ; PLSMTR - Pulse the Motor On Line (27_Nov_83) ;============================================= ; 1) This routine pulses the motor on line once. ; 2) Notice that there is a time delay for the timer capacitor to ; discharge. ; 3) Register Usage: ; A -> General Purpose ; B -> Time delay - motor cap. discharge (entry value preserved) ; PlsMtr: push bc ld a,(iy+cpybnk) or $MTRON out (bnkstb),a ;Turn the motor ON ld b,10h ;(Delay for motor cap to discharge) plslp1: djnz plslp1 ;Wait and NOT $MTRON out (bnkstb),a ;Turn the motor OFF pop bc ret ;====================================================================== ; CHKROT - Check if the Disk is Rotating (20_Jan_84) ;=================================================== ; 1) this routine checks the index hole of the selected disk is changing. ; 2) If the index level IS NOT changing then the accm is returned = 0. ; ; Check for floppy index hole present ChkRot: push bc ld c,$INDEX ;C:= Mask for Index Line Test ld b,100 ;B:= Delay (300 milliseconds) call DLY ;If (index not found within time limit) jr z,CrNo ; Return (Not Rotating) ; Check for floppy index changes ld c,0 ;C:= Mask (No status test) ld b,5 ;B:= Delay (15 milliseconds) call DLY ;(delay for the index hole to go away) ld c,$INDEX ;C:= Mask for Index Line Test ld b,1 ;B:= Delay (3 milliseconds) call DLY ;If (index hasn't gone away) jr nz,CrNo ; Return (Not Rotating) ld a,0FFh ; pop bc ret ;Else Return (Rotating) CrNo: ld a,0 pop bc ret ;(Failure Return - Not Rotating) page ;---------------------------------------------------------------------- ; GETCYL - Get the value of the current cylinder (26_Nov_83) ;----------------------------------------------------------- ; 1) This routine returns the current cylinder value for the currently ; selected drive in the HL register pair. ; 2) Register Usage: ; A -> General Purpose ; DE -> Offset/Cylinder Value (entry value is preserved) ; HL -> Current Cylinder ; GETcyl: push de ld a,(ix+dskdef0) and $PHYADR ;A:= Physical drive number sla a ;(times 2 for a word pointer) ld e,a ld d,0 ld hl,cyltbl add hl,de ;HL:= Pointer to the current cylinder ld e,(hl) inc hl ld d,(hl) ex de,hl ;HL:= Current Track pop de ret ;Return ;---------------------------------------------------------------------- ; SETCYL - Set the value of the current cylinder (26_Nov_83) ;----------------------------------------------------------- ; 1) This routine updates the current cylinder entry for the current ; drive with the value of the HL register pair. ; 2) Register Usage: ; A -> General Purpose ; DE -> Offset/Cylinder Value (entry value is preserved) ; HL -> Current Cylinder ; SETcyl: push de push hl ld a,(ix+dskdef0) and $PHYADR ;A:= Physical drive number sla a ;(times 2 for a word pointer) ld e,a ld d,0 ld hl,cyltbl add hl,de ;HL:= Pointer to the current cylinder pop de ;DE:= Current Cylinder Value (was in HL) ld (hl),e inc hl ld (hl),d ;Current Cylinder:= DE ex de,hl ;HL:= Current Cylinder pop de ret ;Return page ;---------------------------------------------------------------------- ; DLY - Delay in 3ms increments/check drive status (6_Jun_84) ;------------------------------------------------------------ ; 1) This routine delays in 3ms increments. The time delay is passed ; in the B register. If the delay is 0 then there is NO_Delay. ; 2) Optionally one can also return when a given bit(s) in the drive ; status register go hi. The bits to watch for are passed in the ; C register. ; 3) If the program returns due to a time-out then the z_flag is set. ; 4) If the program returns due to the selected bit in the status ; register asserting then the z_flag is returned cleared. ; 5) The Loop 'dlylp2' (starts -> ld a,(drvsts) ends -> jr nz,dlylp2), ; takes 48 t-states to execute. This is equivalent to 12 us, ; assuming a 4mhz processor speed. ; 5) Register Usage: ; A -> General Purose ; B -> Number of 3ms Delay periods ; C -> Drive Status Mask ; DE -> 3ms Time Delay (this register pair is preserved) ; DLY: push de ;Save the DE register pair ld a,b ;If (Time_Delay ne 0) or b jr z,dlydon dlylp1: ld de,250 ; Repeat DE:= 3ms time delay dlylp2: in a,(drvsts) ; Repeat and c ; If (Status_Line active) jr nz,dlydon ; break dec de ; 3ms_Delay:= 3ms_Delay-1 ld a,d or e jr nz,dlylp2 ; Until (3ms_Delay is done) djnz dlylp1 ; Until (number of 3ms_Delays is zero) dlydon: pop de ;Restore DE register pair ret ;Return page ;====================================================================== ; ABS - Compute Absolute difference of DE and HL (26_Nov_83) ;=========================================================== ; 1) This routine returns the absolute difference between the HL and ; the DE register pairs in the DE pair (the HL pair is untouched). ; 2) The accm is set to 0FFh if the HL register pair is greater than ; or equal to the DE register pair (else its set to 00). ; 3) The zero flag is set if the HL and DE are identical otherwise the ; zero-flag is returned cleared. ; 4) Register Usage: ; A -> FF if HL=>DE else 00 if HL Set if HL=DE else Cleared if HL#DE ; DE -> Absolute difference of HL and DE ; HL -> Current Cylinder Number (value is not altered) ; ABS: scf ccf ;Carry_Flag:= Clear push hl ;Save HL pair sbc hl,de ;HL:= Absolute_Difference (HL - DE) jr c,ABSsk1 ;If (HL => DE) pop de ; DE:= HL's Entry Value ld a,0FFh ; Flag:= HL Greater Than or Equal to DE jr ABSsk2 ; Return ABSsk1: ccf ;Else Carry_Flag:= Cleared pop hl ; restore HL ex de,hl ; DE:= HL's Entry Value sbc hl,de ; HL:= Absolute Difference (DE - HL) ld a,0 ; Flag:= HL is less_Than DE ABSsk2: ex de,hl ;HL:= Entry Value, DE:= Absolute Difference ret ;Return page ;====================================================================== ; CLRLAT - Clear the Control Latch (26_Mar_84) ;============================================= ; 1) This routine resets the control latch to zero by setting and ; then immediatly clearing the auto enable bit. Then any pending ; interrupts are cleared by reading clrint. ; 3) Register Usage: ; A -> General Purpose ; clrlat: ld a,0 out (ctlstb),a ;Clear the control latch's buffer ld a,(iy+cpybnk) ;Toggle the auto enable bit or $AUTOE out (bnkstb),a ld a,4 CLLp1: dec a ;Wait for Auto Enable to propogate jr nz,CLLp1 ld a,(iy+cpybnk) and NOT $AUTOE out (bnkstb),a in a,(clrint) ;Clear any pending interrupts ret page ;---------------------------------------------------------------------- ; Data Areas (12_May_83) ;----------------------- ; ; Sector Size in number of 32 byte blocks ;---------------------------------------- ; 1) The table tsize is used in the routine PRP to convert the ; sector size byte (used in the sector header image) to the number ; of 32 byte blocks. ; tsize: db (128/32) - 1 ;128 byts sectors db (256/32) - 1 ;256 byte sectors db (512/32) - 1 ;512 byte sectors db (1024/32) - 1 ;1024 byte sectors ; Tables that are a function of Density ;-------------------------------------- ; 1) Both of these tables use a pointer formed from the density ; and size bits. ; 2) The tmode table returns the proper byte to initially write to ; the mode register. ; 3) The table tfill is used to pick the proper fill character for ; Gap3 (after the data field) according to the density. tmode: db $ALT ;Single Density 5.25" db $MFM or $ALT ;Double Density 5.25" db $STD or $ALT ;Single Density 8" db $STD or $MFM or $ALT ;Double Density 8" tfill: db 0FFh ;Single Density Gap3 fill Character db 04Eh ;Double Density Gap3 fill Character db 0FFh ;Single Density Gap3 fill Character db 04Eh ;Double Density Gap3 fill Character ;---------------------------------------------------------------------- ; HDSKEW - Default Hard Disk Sector Skew Table (13_Dec_83) ;--------------------------------------------------------- ; HDskew: db 2 db 4 db 6 db 8 db 1 db 3 db 5 db 7 db 0 ;Start of table page ;---------------------------------------------------------------------- ; Rom Error Validation and Translation Table (18_Jan_84) ;------------------------------------------------------- ; 1) This table serves two purposes a) To validate the rom level error ; code and b) to translate the rom level code into a bios level error ; code. ; 2) This table is only used by the routine Ertran ; errtbl: db Eum, ERnf ;Unreadable Media db Ehd, ERmf ;Header Error db Eha, ERnf ;Mismatch: Header ID address mark db Ehc, ERidc ;Mismatch: Header CRC db Eda, ERnf ;Mismatch: Data address mark db Edc, ERdac ;Mismatch: Data CRC db Esk, ERsk ;Mismatch: Track Number (seek error) db Ehn, ERef ;Mismatch: Head Number db Esn, ERnf ;Mismatch: Sector Number db Ess, ERmf ;Mismatch: Sector Size db Enh, ERef ;Drive failed to find track 0 db Emc, ERsk ;Maximum Cylinder Number Exceeded db Enr, ERnr ;Drive not ready db Eto, ERnr ;Motor Time-Out Failure db Ewp, ERwp ;Write Protected db Ewf, ERef ;Write Fault db Ebf, ERbm ;Bad Map is Full db Ebi, ERbm ;Bad Map ID does not match db Ebr, ERbm ;Bad Map Revision Number Doesn't Match db Ebn, ERbm ;Bad Map not opened db Enf, ERnf ;Data Not Found (Time out waiting for data) db Euk, ERuk ;Unknown Error Code page ;---------------------------------------------------------------------- ; ETAB - Disk Operation Error Message Lookup Table (18_Dec_83) ;------------------------------------------------------------- ; 1) This table is accessed using the bios level error code. ; ( (iy+ErFlag) * 2) + Etab = Pointer to Error Message ; Etab: dw MERwp ;Write Protected dw MERsk ;Seek Error dw MERdac ;Data CRC Error dw MERidc ;ID CRC Error dw MERnf ;Data Not Found dw MERnr ;Not Ready dw MERmf ;Media Failure dw MERef ;Equipment Failure dw MERuk ;Dummy Entry invalid command dw MERuk ;Unknown Error Code dw MERbm ;Unable to ReMap Sector ;---------------------------------------------------------------------- ; Text Strings ;------------- ; ; Disk Operation Error Messages (27_Dec_83) ;------------------------------------------ ; MERwp: db ' Write Protected ', 0 MERsk: db ' Seek Error ', 0 MERdac: db ' ID CRC Error ', 0 MERidc: db ' Data CRC Error ', 0 MERnf: db ' Data Not Found ', 0 MERnr: db ' Drive Not Ready ', 0 MERmf: db ' Media Failure ', 0 MERef: db ' Equipment Failure ', 0 MERuk: db ' Unknown Error Code ', 0 MERbm: db ' Unable to ReMap Sector ', 0 page ; Basic Disk Error Message ;------------------------- ; DMesg: db cr,lf, 'Disk error on drive ', 0 ; Print a Colon ;-------------- ; Coln: db ': ', 0 ; Error Response Message ;----------------------- ; Resm: db cr,lf,'Type R to try again, A to abort, or I to ignore: ',0 ; Print a Carriage Return Line Feed ;---------------------------------- ; crlf: db cr,lf,0 ; Boot Message to find out if the user wants to boot from the floppy disk ;------------------------------------------------------------------------ ; gofd: db 'Do you want to boot from the floppy disk? (Y/N) ',0 ; Boot Error Message ;------------------- ; bterr: db cr,lf, 'Error on CP/M system disk.', 0 ; Parking Error Message (9_Jan_84) ;--------------------------------- ; PrkErr: db cr,lf,'Unable to park drive ', 0 ; Bad Map Error Warning Messages (11_Jan_84) ;------------------------------------------- ; BMEWaf: db 'Warning: Bad Map Almost Full', 0 If ($ lt O_Dsk2 - 1) ;If (we haven't overwritten hd*dsk2) E_Dsk1: ds (O_Dsk2 - $) - 1, 0FFh ; Fill to the test module Else ;Else If2 ; print an error message on pass2 .Printx "The disk-1 module has overflowed into disk-2 module" EndIf EndIf end