The disk routines
THE 'STORE INTERRUPT STATE' SUBROUTINE
This subroutine stores the Interrupt Flip Flop of the Z80 and returns with interrupts
disabled. Whenever the DISCiPLE needs the interrupts to be disabled with disk operations
the status of the IFF (DI or EI) is stored. When the disk operation is finished the IFF
is restored to the state it was in before the interrupts were disabled.
NOTE: As a result of a bug in the Z80 itself the stored state of the IFF can be wrong if
interrupts are enabled. The problem occurs when an interrupt is accepted (implying:
interrupts enabled) during the execution of the 'LD A,R' or 'LD A,I' instruction. A
solution to this problem is a second test if the IFF indicates interrupts disabled.
With a Spectrum it is unlikely that two interrupts follow each other within a very short
time, so a second test should cure the problem. A better method can be found in the
'Zilog Z80 Family Data Book'. The best method is replacing the Z80 with a CMOS version,
the bug has been fixed in that Z80 type.
2ECE STORE_IFF PUSH AF
2ECF LD A,I Set the P/V flag according to the state
2ED1 PUSH AF of the IFF2.
2ED2 DI
2ED3 EX (SP),HL Get the Flag register in L while saving
HL.
2ED4 LD (#1ACC),HL Store it. (IFF)
2ED7 POP HL Restore HL and AF.
2ED8 POP AF
2ED9 RET Finished.
THE 'RESTORE INTERRUPT STATE' SUBROUTINE
This subroutine restores the interrupt state to the original state (DI or EI) (see NOTE
above).
2EDA REST_IFF PUSH AF Save the contents of the needed
2EDB PUSH HL registers.
2EDC LD HL,(#1ACC) Fetch the previous IFF state.
2EDF EX (SP),HL Restore HL and store IFF state.
2EE0 POP AF The IFF state is now contained in the
P/V flag.
2EE1 JP PO,#2EE5,REST_IFF1 Jump if interrupts were disabled.
2EE4 EI Otherwise enable interrupts.
2EE5 REST_IFF1 POP AF
2EE6 RET Finished.
THE 'WRITE PRECOMPENSATION' SUBROUTINE
This subroutine is called before a write command is send to the Floppy Disk Controller
(FDC). Its task is to enable write precompensation on the inner tracks to get a more
reliable working of the data transfers. On entry C holds the FDC command.
2EE7 PRECOMP LD A,(#1DDA) Fetch current control port state.
2EEA AND #04 Write precompensation isn't needed when
2EEC JR NZ,#2F01,PRECOMP_2 using single density, so skip the
following routine when using SD.
2EEE LD B,64 Start write precomp. at track 64.
2EF0 CALL #333B,DRV_CAP Get drive capacity in A.
2EF3 AND #7F Keep only the number of tracks.
2EF5 CP 80
2EF7 JR Z,#2EFB,PRECOMP_1 Jump if drive has 80 tracks.
2EF9 SRL B Otherwise precomp. starts at track 32.
2EFB PRECOMP_1 LD A,D Fetch current track.
2EFC AND B
2EFD JR Z,#2F01,PRECOMP_2 Jump if not at tracks above 63 or 31.
2EFF RES 1,C Otherwise enable write precompensation
(reset bit 1 of the command).
2F01 PRECOMP_2 JP #3085,LD_COM_REG Give the command to the FDC.
THE 'WRITE SECTOR' SUBROUTINE
This subroutine writes the contents of the data buffer to sector E on track D.
2F04 WSAD XOR A Reset retry counter.
2F05 LD (#1DDB),A
2F08 WSAD_1 CALL #2FAC,SET_TRKSEC Select drive, side, density and sector
and position the head above the correct
track.
2F0B LD C,%10100010 Write a single sector, enable spin-up
sequence, no settling delay, disable
precompensation, normal data mark.
2F0D CALL #2EE7,PRECOMP Enable precompensation when neccesary and
give the command to the FDC.
2F10 CALL #37C3,HL_BUFFER Make HL point to the data buffer.
2F13 CALL #2F1F,WR_OP Write the sector.
2F16 CALL #2F94,SECTOR_ERR Check if there was an error, report it
when retried often enough.
2F19 RET Z Exit with no errors.
2F1A CALL #2FF8,WRONGTRACK Check if head is above correct track.
2F1D JR #2F08,WSAD_1 Try again if no succes.
THE 'SEND DATA TO FDC' SUBROUTINE
This subroutine handles the actual saving of a sector. It keeps sending a byte at a
time to the FDC as long as it asks for one (sector length doesn't matter).
2F1F WR_OP CALL #2ECE,STORE_IFF Store maskable interrupt state and
disable maskable interrupts.
2F22 LD BC,219 BC holds the I/O port address of the
data register of the FDC.
2F25 JR #2F2A,WR_TST_DRQ Jump into the save loop.
2F27 WR_LOOP OUTI Send a byte to the FDC (port BC) then
increment HL (and decrement B).
2F29 NOP Waste some time.
2F2A WR_TST_DRQ IN A,(27) Fetch FDC status.
2F2C BIT 1,A Test Data ReQuest bit.
2F2E JR NZ,#2F27,WR_LOOP Jump if FDC requests a byte.
2F30 IN A,(27) Otherwise fetch FDC status again.
2F32 BIT 1,A
2F34 JR NZ,#2F27,WR_LOOP Jump if FDC requests a byte.
2F36 IN A,(27)
2F38 BIT 1,A
2F3A JR NZ,#2F27,WR_LOOP
2F3C IN A,(27)
2F3E BIT 1,A
2F40 JR NZ,#2F27,WR_LOOP
2F42 BIT 0,A Test Busy bit.
2F44 JR NZ,#2F2A,WR_TST_DRQ Repeat until FDC is ready.
2F46 CALL #2EDA,REST_IFF Restore the interrupt state.
2F49 BIT 6,A Test Write Protected bit.
2F4B RET Z Return if not write protected.
2F4C JP #294E,REP_23 Otherwise give 'Disc WRITE protected'
error.
THE 'READ SECTOR' SUBROUTINE
This subroutine loads the contents of the data buffer from sector E on track D.
2F4F RSAD XOR A Clear retry counter.
2F50 LD (#1DDB),A
2F53 RSAD_1 CALL #2FAC,SET_TRKSEC Set drive, side, density, sector and
position the head above the correct
track.
2F56 LD C,%10000000 Read a single sector, enable spin-up
sequence, no settling delay.
2F58 CALL #3085,LD_COM_REG Give the command to the FDC.
2F5B CALL #37C3,HL_BUFFER Make HL point to the data buffer.
2F5E CALL #2F6A,RD_OP Read the sector.
2F61 CALL #2F94,SECTOR_ERR Check if there was an error, report it
when retried often enough.
2F64 RET Z Exit with no errors.
2F65 CALL #2FF8,WRONGTRACK Check if head is above correct track.
2F68 JR #2F53,RSAD_1 Try again if no succes.
THE 'GET DATA FROM FDC' SUBROUTINE
This subroutine handles the actual loading of a sector. It keeps fetching a byte at a
time from the FDC as long as it asks to get one (sector length doesn't matter).
2F6A RD_OP CALL #2ECE,STORE_IFF Store the maskable interrupt state and
disable interrupts.
2F6D LD BC,219 I/O address of the FDCs data register.
2F70 JR #2F75,RD_TST_DRQ Jump into the load loop.
2F72 RD_LOOP INI Get a byte from the FDC and increment
HL (and decrement B).
2F74 NOP Wait for a moment.
2F75 RD_TST_DRQ IN A,(27) Fetch FDC status.
2F77 BIT 1,A Test Data ReQuest bit.
2F79 JR NZ,#2F72,RD_LOOP Jump if FDC has read a byte.
2F7B IN A,(27) Otherwise fetch FDC status again.
2F7D BIT 1,A
2F7F JR NZ,#2F72,RD_LOOP Jump if FDC has read a byte.
2F81 IN A,(27)
2F83 BIT 1,A
2F85 JR NZ,#2F72,RD_LOOP
2F87 IN A,(27)
2F89 BIT 1,A
2F8B JR NZ,#2F72,RD_LOOP
2F8D BIT 0,A Test Busy bit.
2F8F JR NZ,#2F75,RD_TST_DRQ Repeat until FDC is ready.
2F91 JP #2EDA,REST_IFF Restore interrupt state and exit.
THE 'CHECK SECTOR ERROR' SUBROUTINE
This subroutine checks if the FDC reported an error, on entry A holds the FDC status
byte. If there wasn't one HL points to the start of the data buffer and the RPT is
reset, a return is made with the Zero flag set. If there was an error a return is made
with the Zero flag reset unless ten retries have been made, then an error is reported.
2F94 SECTOR_ERR AND %00011100 Mask the non error bits.
2F96 JR NZ,#2F9F,SEC_ERR1 Jump with an error.
2F98 CALL #37E7,RES_RPT Otherwise reset the data buffer pointer
(RPT).
2F9B CALL #37C3,HL_BUFFER Make HL point to the data buffer.
2F9E RET Z Return with Zero flag set (always set
here).
2F9F SEC_ERR1 LD A,(#1DDB)
2FA2 INC A Increment the retry counter.
2FA3 LD (#1DDB),A
2FA6 CP 10 If 10 retries have been made 'SECTOR
2FA8 RET NZ error' is given, else exit with Zero
2FA9 JP #2928,REP_4 reset.
THE 'SET TRACK AND SECTOR' SUBROUTINE
This subroutine is used to select the required drive, side, density, sector to be
handled and to position the drive head above the required track.
Note I: The routine starts with a test if DE=0, but when the ROM is paged in high
(System loaded) the DISCiPLE will crash on the 'CALL #0408' (which ends in the RAM
located 'END OF STATEMENT' routine) whenever DE is 0. It seems that this part of the
routine is from an earlier ROM version.
Note II: The head is moved relative to the current position (fetched from the FDCs
track register), when the drive selected is not the same as the previous one the
DISCiPLE can get confused.
2FAC SET_TRKSEC LD A,D
2FAD OR E
2FAE JR NZ,#2FBB,SET_TRK1 Jump if DE<>0.
2FB0 CALL #0408,TEST_ Test the .. flag.
2FB3 JP Z,#2956,REP_27 Give 'END of file' error when reset.
2FB6 LD SP,(#0296) Otherwise clear the machine stack.
2FBA RET
2FBB SET_TRK1 CALL #30B3,SET_DRVSD Select drive, side and density.
2FBE LD A,E Store the required sector number into
2FBF OUT (155),A the FDC's sector register.
2FC1 CALL #3B17,FLASH_BORD Change the border colour when wanted.
2FC4 SET_TRK2 LD A,D Track to A.
2FC5 AND #7F Mask highest bit which indicates side.
2FC7 LD B,A
2FC8 CALL #3067,FDC_READY Wait until FDC is ready, test BREAK.
2FCB IN A,(91) Fetch contents of FDC's track register.
2FCD CP B Compare against required track.
2FCE RET Z Exit if already on right track.
2FCF PUSH BC
2FD0 LD C,%01111000 Step-out, update track register,
disable spin-up sequence, no verify,
step rate 6 ms.
2FD2 JR NC,#2FD6,SET_TRK3 Jump if required track lies outside
(more towards track 0) current track.
2FD4 LD C,%01011000 Step-in, update track register, disable
spin-up sequence, no verify,
step rate 6 ms.
2FD6 SET_TRK3 CALL #3085,LD_COM_REG Execute the command, move one track.
2FD9 CALL #3067,FDC_READY Wait until FDC is ready, test BREAK.
2FDC IN A,(91) Fetch current track again.
2FDE POP BC
2FDF CP B Compare with required track.
2FE0 RET Z Exit if required track reached.
2FE1 CALL #2FE6,STEP_DELAY Wait for the number of msec's specified
2FE4 JR #2FC4,SET_TRK2 by (STPRAT) before giving a next step.
THE 'STEP DELAY' SUBROUTINE
This subroutine does the waiting between the executing of two step commands. By
altering the value of the (STPRAT) system variabele (POKE @3,n) the time being waited
can be altered. There is no reason, except for drive specs, why (STPRAT) couldn't be
POKEd to any value below 6 as stated in the DISCiPLE manual.
2FE6 STEP_DELAY LD A,(#029B) Fetch (STPRAT).
2FE9 AND A
2FEA STEP_D1 RET Z Exit if 'msec-counter' reaches zero.
2FEB WAIT_1MSEC PUSH AF
2FEC LD BC,135 With this value the following loop
takes 3505 T states (about 1msec) to
complete.
2FEF WAIT_1M1 DEC BC
2FF0 LD A,B
2FF1 OR C
2FF2 JR NZ,#2FEF,WAIT_1M1 Repeat until counter reaches zero.
2FF4 POP AF
2FF5 DEC A Decrease 'msec-counter'.
2FF6 JR #2FEA,STEP_D1
THE 'WRONG TRACK' SUBROUTINE
This subroutine checks whether the head is above the right track. The current track
number is found by reading the ID Field of the first encountered sector on this track.
The track number is then stored into the track register of the FDC. When no ID Field
can be found the retry counter is incremented, when this reaches 5 the other density
is selected and when it reaches 10 the 'FORMAT data lost' error is given.
2FF8 WRONGTRACK LD C,%11001000 Read Address, disable spinup, no delay.
2FFA CALL #3085,LD_COM_REG Execute the command.
2FFD LD HL,#1DDC Address where the ID Field is loaded.
3000 CALL #2F6A,RD_OP Get the six byte ID Field of the first
sector encountered.
3003 AND %00011100
3005 JR NZ,#300D,WRONGT_1 Jump if there was an error.
3007 LD A,(#1DDC) Otherwise store the current track
300A OUT (91),A number into the FDC's track register.
300C RET
300D WRONGT_1 LD A,(#1DDB)
3010 INC A Increment retry counter.
3011 LD (#1DDB),A
3014 CP 5
3016 JR NZ,#3025,WRONGT_2 Jump if it hasn't reached 5.
3018 LD A,(#1DDA) Otherwise fetch current control port
301B XOR #04 status and invert Density bit.
301D LD (#1DDA),A
3020 OUT (31),A Set other density.
3022 LD A,(#1DDB) Fetch retry counter
3025 WRONGT_2 CP 10
3027 JR NZ,#2FF8,WRONGTRACK Retry if it hasn't reached 10.
3029 JP #292A,REP_5 Otherwise 'FORMAT data lost' is given.
THE 'TRACK_0' SUBROUTINE
This subroutine resets the head of the current drive to track 0. It has two entry
points, the first is used by the ROM located routines, while the second (at #3030) is
used by the 'REST' command code (code 64 or #40). After the head has been resetted, a
test is made whether there is a disk in the drive.
NOTE: This test fails for 3½" drives.
302C TRACK_0 LD B,1 Wait for 1 INDEX pulse.
302E JR #3032,REST_1
3030 REST LD B,4 Wait for 4 INDEX pulses.
3032 REST_1 PUSH BC
3033 LD DE,1 Signal 'track 0, sector 1'.
3036 CALL #30B3,SET_DRVSD Set drive, side and density.
3039 LD C,%11010000 Terminate all operations.
303B CALL #3088,LD_COM_R1 Execute the FDC command.
303E LD B,0 Wait about 1 msec.
3040 REST_2 DJNZ #3040,REST_2
3042 JR #304F,REST_HEAD1 Jump into the 'reset head' routine.
The following code resets the drive head to track 0.
3044 REST_HEAD LD C,%01111000 Step-out, update track register,
disable spin-up sequence, no verify,
step rate 6 msec.
3046 CALL #3085,LD_COM_REG Execute the command.
3049 CALL #3067,FDC_READY Wait until the FDC is ready.
304C CALL #2FE6,STEP_DELAY Wait for (STPRAT) msec before
continuing.
304F REST_HEAD1 IN A,(27) Fetch the FDC status register.
3051 BIT 2,A
3053 JR Z,#3044,REST_HEAD Repeat until head is above track 0.
3055 POP BC
The routine now checks whether there is a disk in the drive. This works correct only
with 5¼" drives, with 3½" the routine stays in the loop at #305F forever when there is
no disk in the drive. A solution would be to exit the loops whenever the FDC isn't busy
anymore and discard the time limit.
3056 REST_DISK LD HL,8192 The INDEX signal has to become low
within about 0.13 sec.
3059 REST_DISK1 IN A,(27) Fetch FDC status.
305B BIT 1,A
305D JR NZ,#307D,REST_DISK3 Jump if INDEX signal is high.
305F REST_DISK2 IN A,(27) Otherwise fetch the FDC status again.
3061 BIT 1,A
3063 JR Z,#305F,REST_DISK2 Repeat until it gets high again.
3065 DJNZ #3056,REST_DISK Repeat for B times. Exit via
'FDC_READY' below when B gets to zero.
THE 'WAIT UNTIL FDC IS READY' SUBROUTINE
This small subroutine waits until the FDC is ready. When the BREAK key is pressed
during the waiting, an error is reported.
3067 FDC_READY IN A,(27) Fetch the FDC status.
3069 BIT 0,A
306B RET Z Exit if it's indicating 'FDC ready'.
Now the BREAK key is tested.
306C LD A,#7F
306E IN A,(254)
3070 RRA
3071 JR C,#3067,FDC_READY Jump if the SPACE key isn't pressed.
3073 LD A,#FE
3075 IN A,(254)
3077 RRA
3078 JR C,#3067,FDC_READY Jump if CAPS isn't pressed also.
307A JP #2926,REP_3 Otherwise 'BREAK requested'.
THE 'TRACK_0' ROUTINE CONTINUED
307D REST_DISK3 DEC HL Decrease time limit.
307E LD A,H
307F OR L
3080 JR NZ,#3059,REST_DISK1 Continue if limit isn't exceeded.
3082 JP #292C,REP_6 Otherwise 'NO DISC in drive'.
THE 'LOAD FDC COMMAND REG.' SUBROUTINE
This subroutine loads the FDC command register with the command held in the Z80's C
register. The entry point 'LD_COM_R1' is used to give the 'terminate all operations'
command to the FDC, it makes no sense to wait for the FDC to get ready if the current
command is to be aborted.
3085 LD_COM_REG CALL #3067,FDC_READY Wait until FDC is ready, test BREAK.
3088 LD_COM_R1 LD A,C Load the command in the FDC's command
3089 OUT (27),A register.
308B LD B,30 This value is for a 110 msec wait.
308D LD A,(#1DDA) Fetch current control port state.
3090 AND #04 Keep only density select bit.
3092 JR NZ,#3096,LD_COM_R2 Jump with Single Density.
3094 LD B,15 Otherwise a 54 msec wait is taken.
3096 LD_COM_R2 DJNZ #3096,LD_COM_R2 Waste some time.
3098 RET Finished.
THE 'TEST DRIVE' SUBROUTINE
This subroutine checks if the specified drive is defined (only if it's number isn't 1,
then it is accepted right away). The entry point at #3099 is used when the drive is
specified in UFIA1. The entry point at #309C is used whenever the drive is specified
in the A register. On exit (IX+11) holds the hardware representation of the drive to
be used.
3099 TEST_DRV LD A,(#1E01) Fetch drive number from UFIA1.
309C TEST_DRV1 CP 1
309E JR Z,#30AF,TEST_DRV2 Jump if drive one is to be used.
30A0 CP 2 Otherwise give 'Wrong DRIVE' error if
30A2 JP NZ,#294C,REP_22 drive isn't drive two.
30A5 LD A,(#029A) Fetch (TRAKS2) system variable.
30A8 CP 0
30AA JP Z,#294C,REP_22 Give error if drive isn't defined.
30AD LD A,0 Zero is hardware representation of
drive two.
30AF TEST_DRV2 LD (IX+11),A Store hardware representation.
30B2 RET Finished.
THE 'SET DRIVE PARAMETERS' SUBROUTINE
This subroutine selects the drive, side and density by setting the right bits in the
control port (I/O address 31).
30B3 SET_DRVSD LD B,(IX+11) Fetch hardware drive representation.
30B6 LD A,(#1DDA) Fetch current control port status.
30B9 AND %00000001 Keep only drive 1/2 select bit.
30BB CP B Set Zero flag if drive isn't changed.
30BC PUSH AF
30BD LD A,(#1DDA) Fetch current control port status
30C0 AND %11111100 again. Mask drive and side select bits.
30C2 LD C,A Store result temporary.
30C3 LD A,D Fetch track.
30C4 RLCA Rotate side select bit to bit 1.
30C5 RLCA
30C6 AND %00000010 Only keep side select.
30C8 OR B Include drive select.
30C9 OR C Include all other bits.
30CA LD (#1DDA),A Set current control port status.
30CD OUT (31),A Activate settings.
30CF POP AF Get Zero flag.
30D0 RET Z Exit if drive hasn't changed.
30D1 LD A,30 Otherwise wait for 30 msec.
30D3 JP #2FEB,WAIT_1MSEC Exit via 'WAIT_1MSEC'.
THE 'PROGRAM NUMBER' SUBROUTINE
This subroutine calculates the program number from track and sector number and the
contents of RPT-high (which holds 0 for odd program numbers and 1 for even ones (double
density only)). It is used to get the program number printed in the extended CATalogue.
30D6 PROG_NUM PUSH DE Track and sector to BC.
30D7 POP BC
30D8 XOR A Clear A.
30D9 DEC B
30DA JP M,#30E3,PROG_NUM2 Jump with track 0, B now holds -1.
30DD PROG_NUM1 ADD A,10 Otherwise set A to 10*track number.
30DF DEC B
30E0 JP P,#30DD,PROG_NUM1 Repeat until B gets below zero.
30E3 PROG_NUM2 LD B,A
30E4 LD A,(#1DDA) Fetch current control port status.
30E7 AND #04
30E9 JR NZ,#30F0,PROG_NUM3 Jump if using single density.
30EB SLA B Otherwise double number of tens.
30ED SLA C Together with the next instruction the
effect is 'INC C'.
30EF DEC C
30F0 PROG_NUM3 LD A,(IX+14) Fetch high byte of RPT.
30F3 ADD A,C Add adjusted sector.
30F4 ADD A,B Add adjusted track.
30F5 RET Exit with A holding the program number.
THE 'SECT_END_Z' SUBROUTINE
This subroutine returns with the Zero flag set if RPT has reached the sector end, that
is if RPT points to the next track and sector numbers present in each sector.
30F6 SECT_END_Z CALL #37D4,RPT_HL1 Get RPT in HL and the disk buffer
30F9 LD A,C position in BC.
30FA CP 254 Exit if disk buffer position 254 (or
30FC RET NZ 510) hasn't been reached, Zero reset.
30FD LD A,(#1DDA) Fetch current control port status.
3100 CPL
3101 AND #04 Exit if single density is used with
3103 RET Z Zero set.
3104 LD A,B Otherwise position 510 has to be
3105 CP 1 reached before returning with Zero set.
3107 RET
THE 'SAVE A BYTE TO DISK' SUBROUTINE
This subroutine saves the byte in A in the data buffer at the location pointed to by
RPT (the disk buffer pointer). If the buffer is full, an automatic sector save to disk
will take place, RPT will be reset to the start of the buffer and the value will then
be saved.
3108 SBYT PUSH BC
3109 PUSH DE
310A PUSH HL
310B PUSH AF
310C CALL #30F6,SECT_END_Z Check if the data buffer is full.
310F JR NZ,#311E,SBYT_1 Jump if data buffer not full.
3111 CALL #32DE,MK_ALLOC Allocate the first free sector.
3114 LD (HL),D Store it's track and sector number into
3115 INC HL the last two bytes of the data buffer.
3116 LD (HL),E
3117 EX DE,HL
3118 CALL #37FE,GET_SECTOR Fetch track and sector number of the
current sector into DE, store the next
track and sector number.
311B CALL #2F04,WSAD Write the sector to disk.
311E SBYT_1 POP AF
311F LD (HL),A Store value.
3120 POP HL
3121 POP DE
3122 POP BC
3123 JP #37DF,INC_RPT Exit while increasing RPT.
THE 'LOAD A BYTE FROM DISK' SUBROUTINE
This subroutine loads the byte pointed to by RPT from the data buffer, and returns with
it in A and RPT updated. If the buffer is empty, another sector is read from the disk.
NOTE: If there isn't another sector, so track and sector are both zero, the routine will
try to load one anyway. The result is then that the 'SET_TRKSEC' routine crashes (see
NOTE II before #2FAC).
3126 LBYT PUSH BC
3127 PUSH DE
3128 PUSH HL
3129 CALL #30F6,SECT_END_Z Check if the data buffer is empty.
312C JR NZ,#3134,LBYT_1 Jump if data buffer not empty.
312E LD D,(HL) Otherwise fetch track and sector number
312F INC HL of next sector into DE.
3130 LD E,(HL)
3131 CALL #2F4F,RSAD Load the next sector.
3134 LBYT_1 LD A,(HL) Get a byte.
3135 POP HL
3136 POP DE
3137 POP BC
3138 JP #37DF,INC_RPT Exit while increasing RPT.
THE 'LOAD FILE' ROUTINE
This very important routine handles the loading of any file from disk. The entry point
is at address #3145. On entry HL holds the load address, while DE holds the number of
bytes to be loaded. The routine first empties the data buffer, which was loaded with
the first sector to obtain the 9 byte file header. When the data buffer is empty the
routine loads all sectors, but the last, into the memory directly. The last sector is
loaded into the data buffer again and then the remaining bytes are loaded from it.
313B LD_BUF LD A,(HL) Fetch a byte from the data buffer.
313C CALL #37DF,INC_RPT Increment RPT.
313F LD HL,(#1AC8) Fetch load address.
3142 LD (HL),A Load the byte into memory.
3143 INC HL
3144 DEC DE
3145 LOAD_FILE LD (#1AC8),HL Store load address into (FILEADDR).
3148 LD A,D
3149 OR E
314A RET Z Exit if no more bytes left.
314B LD_BUF1 CALL #30F6,SECT_END_Z The data buffer has to be empty before
314E JR NZ,#313B,LD_BUF sectors can be loaded directly into
memory. Jump if data buffer not empty.
3150 LD (#1AC5),DE Store the number of bytes left to load
into (BYTESLEFT).
3154 LD D,(HL) Fetch next track and sector.
3155 INC HL
3156 LD E,(HL)
3157 CALL #31DD,STO_BUFLEN Store the data buffer length.
315A LD_OP CALL #31EF,LAST_SEC_C Check if this sector is the last one.
315D JP C,#31D3,LD_LAST Jump if last sector.
3160 INC HL Balance the Carry flag subtracted in
'LAST_SEC_C'.
3161 LD (#1AC5),HL Store number of bytes left after this
sector has been loaded.
3164 XOR A Clear retry counter.
3165 LD (#1DDB),A
3168 CALL #37F7,STORE_SEC Store track and sector.
316B LD_AGAIN CALL #2FAC,SET_TRKSEC Set drive, side, density, sector and
track.
316E LD C,%10000000 Read a single sector, enable spin-up,
no settling delay.
3170 CALL #3085,LD_COM_REG Execute the FDC command.
3173 EXX
3174 PUSH HL HL' has to be rescued because the
'main' ROM needs it.
3175 LD BC,219 I/O address of FDC's data register.
3178 LD DE,2 DE' holds the length of the next sector
address in each sector.
317B CALL #37C3,HL_BUFFER HL' points to the data buffer.
317E EXX
317F LD BC,219 I/O address of FDC's data register.
3182 LD DE,(#1ACA) DE holds length of data buffer. DE +
DE' hold the length of a sector.
3186 LD HL,(#1AC8) HL holds the load address.
3189 CALL #2ECE,STORE_IFF Store interrupt state and disable.
318C JR #3196,LD_TST_DRQ Jump into the load loop.
318E LD_LOOP INI Get a byte from the FDC, increment HL.
3190 DEC DE Decrement byte counter.
3191 LD A,D
3192 OR E
3193 JR NZ,#3196,LD_TST_DRQ Jump if not zero.
3195 EXX Otherwise select the other HL and DE.
3196 LD_TST_DRQ IN A,(27) Fetch FDC status.
3198 BIT 1,A Test Data ReQuest bit.
319A JR NZ,#318E,LD_LOOP Jump if FDC has read a byte.
319C IN A,(27) Otherwise fetch FDC status again.
319E BIT 1,A
31A0 JR NZ,#318E,LD_LOOP Jump if FDC has read a byte.
31A2 IN A,(27)
31A4 BIT 1,A
31A6 JR NZ,#318E,LD_LOOP
31A8 IN A,(27)
31AA BIT 1,A
31AC JR NZ,#318E,LD_LOOP
31AE BIT 0,A Test Busy bit.
31B0 JR NZ,#3196,LD_TST_DRQ Repeat until FDC is ready.
31B2 EXX When the FDC is ready, DE and DE' both
31B3 POP HL are 0, and the 'EXX' at #3195 has been
31B4 EXX executed twice, so to restore HL' a
'EXX' has to be executed first.
31B5 CALL #2EDA,REST_IFF Restore interrupt state.
31B8 AND %00011100 Mask non error bits of FDC status.
31BA JR Z,#31C7,LD_OK Jump with no errors.
31BC CALL #37F0,FETCH_SEC Otherwise fetch track and sector again.
31BF CALL #2F9F,SEC_ERR1 Check if there was a sector error.
31C2 CALL #2FF8,WRONGTRACK Check if head is above correct track.
31C5 JR #316B,LD_AGAIN Try to load the sector again.
If there are no errors the next sector can be loaded.
31C7 LD_OK LD (#1AC8),HL Store the load address into (FILEADDR).
31CA CALL #37C3,HL_BUFFER Make HL point to the data buffer.
31CD LD D,(HL) Fetch the next track and sector number.
31CE INC HL
31CF LD E,(HL)
31D0 JP #315A,LD_OP Load the next sector.
The last sector is loaded into the data buffer.
31D3 LD_LAST CALL #2F4F,RSAD Load the last sector.
31D6 LD DE,(#1AC5) Fetch number of bytes left (BYTESLEFT)
31DA JP #314B,LD_BUF1 and copy them to 'main' RAM.
THE 'STORE BUFFER LENGTH' SUBROUTINE
This subroutine stores the length of the data buffer into (#1ACA). For double density
this is 510, for single density 254.
31DD STO_BUFLEN LD BC,510 Length of DD data buffer.
31E0 LD A,(#1DDA)
31E3 AND #04
31E5 JR Z,#31EA,STO_BUF1 Jump if using double density.
31E7 LD BC,254 Length of SD data buffer.
31EA STO_BUF1 LD (#1ACA),BC Store the length into (BUFLEN).
31EE RET
THE 'LAST_SEC_C' SUBROUTINE
This subroutine returns with the Carry flag set if the last sector is to be loaded.
31EF LAST_SEC_C LD HL,(#1AC5) Fetch the number of bytes left to be
loaded from (BYTESLEFT).
31F2 LD BC,(#1ACA) Fetch the data buffer length from
(BUFLEN).
31F6 SCF Set the Carry flag, now the Carry flag
will be set after the 'SBC' if HL=BC.
31F7 SBC HL,BC Exit with Carry set signalling 'last
31F9 RET sector to be loaded'.
THE 'SAVE FILE' ROUTINE
This is the opposite of the 'LOAD_FILE' routine above. The entry address is #3204, on
entry HL holds the save address and DE holds the number of bytes to be saved. The
routine first fills up the data buffer, which contains the 9 byte file header already.
The data buffer is saved to disk, after which a sector address table is build for all
but the last sector. All sectors, the addresses of which are contained in the table,
are saved directly from memory. The last sector is saved into the data buffer again
after which the file should be closed.
31FA SA_BUF LD (HL),D Save the byte in the data buffer.
31FB CALL #37DF,INC_RPT Increment RPT.
31FE LD HL,(#1AC8) Fetch save address from (FILEADDR).
3201 INC HL
3202 POP DE
3203 DEC DE
3204 HSVBK_2 LD A,D
3205 OR E
3206 RET Z Exit if no more bytes to save.
3207 PUSH DE
3208 LD D,(HL) Fetch a byte from memory.
3209 LD (#1AC8),HL Store save address into (FILEADDR).
320C CALL #30F6,SECT_END_Z The data buffer has to be full before
320F JR NZ,#31FA,SA_BUF the sector can be saved. Jump if data
buffer isn't full.
3211 POP DE Fetch number of bytes left to save and
3212 LD (#1AC5),DE store it into (BYTESLEFT).
3216 CALL #32DE,MK_ALLOC Allocate the first free sector.
3219 LD (HL),D Store track and sector number into the
321A INC HL data buffer.
321B LD (HL),E
321C EX DE,HL
321D CALL #37FE,GET_SECTOR Fetch track and sector number of the
current sector in DE, store the next
track and sector number.
3220 CALL #2F04,WSAD Write the sector to disk.
3223 XOR A Clear sector counter.
3224 LD (#1DEA),A
3227 CALL #31DD,STO_BUFLEN Store the data buffer length.
322A CALL #31EF,LAST_SEC_C Check if this is the last sector.
322D JP C,#32D1,SA_LAST Jump if it is.
3230 CALL #37C3,HL_BUFFER HL points to the data buffer.
3233 SA_ALLOC PUSH HL Store data buffer address.
3234 CALL #31EF,LAST_SEC_C Check if this is the last sector.
3237 PUSH HL DE now holds the number of bytes left
3238 POP DE -1.
3239 POP HL Restore data buffer pointer.
323A JR C,#3251,SA_OP Jump if all but last sector allocated.
323C INC DE Balance the Carry subtracted in
323D LD (#1AC5),DE 'LAST_SEC_C' before storing the number
of bytes left into (BYTESLEFT).
3241 CALL #32DE,MK_ALLOC Allocate a sector.
3244 LD (HL),D Store its track and sector number into
3245 INC HL the data buffer.
3246 LD (HL),E
3247 INC HL
3248 LD A,(#1DEA) Increase sector counter.
324B INC A
324C LD (#1DEA),A
324F JR NZ,#3233,SA_ALLOC Repeat until all sectors have been
allocated or the sector counter
overflows.
3251 SA_OP XOR A Reset retry counter.
3252 LD (#1DDB),A
3255 CALL #37F0,FETCH_SEC Fetch the sector to be saved.
3258 SA_AGAIN CALL #2FAC,SET_TRKSEC Set drive, side, etc.
325B LD C,%10100010 Write a single sector, enable spin-up
sequence, no settling delay, disable
precompensation, normal data mark.
325D CALL #2EE7,PRECOMP Enable precompensation when neccesary
and execute the command.
3260 EXX
3261 PUSH HL HL' has to be stored because the 'main'
ROM needs it.
3262 CALL #37D4,RPT_HL1 HL' points to the sector address table,
build up in the data buffer.
3265 LD DE,2 DE' holds the length of the next sector
address in each sector.
3268 LD BC,219 BC' holds the I/O address of the FDC's
data register.
326B EXX
326C LD HL,(#1AC8) HL holds the save address.
326F LD DE,(#1ACA) DE holds the length of the data space
inside a sector. DE+DE' hold the length
of a complete sector.
3273 LD BC,219 BC holds the same as BC'.
3276 CALL #2ECE,STORE_IFF Store interrupt state and disable.
3279 JR #3283,SA_TST_DRQ Jump into the save loop.
327B SA_LOOP OUTI Send a byte to the FDC, increment HL.
327D DEC DE Decrement byte counter.
327E LD A,D
327F OR E
3280 JR NZ,#3283,SA_TST_DRQ Jump if not zero.
3282 EXX Otherwise select the other HL and DE.
3283 SA_TST_DRQ IN A,(27) Fetch FDC status.
3285 BIT 1,A Test Data ReQuest bit.
3287 JR NZ,#327B,SA_LOOP Jump if FDC requests a byte.
3289 IN A,(27) Otherwise fetch FDC status again.
328B BIT 1,A
328D JR NZ,#327B,SA_LOOP Jump if FDC requests a byte.
328F IN A,(27)
3291 BIT 1,A
3293 JR NZ,#327B,SA_LOOP
3295 IN A,(27)
3297 BIT 1,A
3299 JR NZ,#327B,SA_LOOP
329B BIT 0,A Test Busy bit.
329D JR NZ,#3283,SA_TST_DRQ Repeat until FDC is ready.
329F CALL #2EDA,REST_IFF Restore interrupt state.
32A2 AND %00011100 Mask non error bits of FDC status.
32A4 JR Z,#32B4,SA_OK Jump with no errors.
32A6 EXX
32A7 POP HL Restore HL'.
32A8 EXX
32A9 CALL #37F0,FETCH_SEC Fetch track and sector again.
32AC CALL #2F9F,SEC_ERR1 Check if there was a sector error.
32AF CALL #2FF8,WRONGTRACK Check if head is above correct track.
32B2 JR #3258,SA_AGAIN Try to save the sector again.
If there are no errors the next sector can be saved, but first its track and sector
number have to be retrieved.
32B4 SA_OK LD (#1AC8),HL Store the save address into (FILEADDR).
32B7 EXX
32B8 DEC HL Fetch track and sector number of next
32B9 LD E,(HL) sector.
32BA DEC HL
32BB LD D,(HL)
32BC CALL #37DF,INC_RPT Update RPT.
32BF CALL #37DF,INC_RPT
32C2 CALL #37F7,STORE_SECT Store the next sector's track and
sector number.
32C5 POP HL Restore HL'.
32C6 EXX
32C7 LD A,(#1DEA) Decrease sector counter.
32CA DEC A
32CB LD (#1DEA),A Save the next sector as long as it
32CE JP NZ,#3251,SA_OP isn't the last one.
32D1 SA_LAST CALL #37E7,RES_RPT The bytes of the last sector are saved
32D4 LD DE,(#1AC5) into the data buffer again. Fetch the
32D8 LD HL,(#1AC8) number of bytes left and the save
32DB JP #3204,HSVBK_2 address. Then save the bytes into the
data buffer.