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 +D 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.
0553 STORE_IFF PUSH AF
0554 LD A,I Set the P/V flag according to the state
0556 PUSH AF of the IFF2.
0557 DI
0558 EX (SP),HL Get the Flag register in L while saving
HL.
0559 LD (#3E50),HL Store it. (IFF)
055C POP HL Restore HL and AF.
055D POP AF
055E RET Finished.
THE 'RESTORE INTERRUPT STATE' SUBROUTINE
This subroutine restores the interrupt state to the original state (DI or EI) (see NOTE
above).
055F REST_IFF PUSH AF Save the contents of the needed
0560 PUSH HL registers.
0561 LD HL,(#3E50) Fetch the previous IFF state.
0564 EX (SP),HL Restore HL and store IFF state.
0565 POP AF The IFF state is now contained in the
P/V flag.
0566 JP PO,#056A,REST_IFF1 Jump if interrupts were disabled.
0569 EI Otherwise enable interrupts.
056A REST_IFF1 POP AF
056B 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.
056C PRECOMP LD C,%10100010 Write a single sector, enable spin-up
sequence, no settling delay, disable
precompensation, normal data mark.
056E PRECOMP1 LD B,64 Start write precomp. at track 64.
0570 CALL #0985,DRV_CAP Get drive capacity in A.
0573 AND #7F Keep only the number of tracks.
0575 CP 80
0577 JR Z,#057B,PREC_1 Jump if drive has 80 tracks.
0579 SRL B Otherwise precomp. starts at track 32.
057B PREC_1 LD A,D Fetch current track.
057C AND B
057D JR Z,#0581,PREC_2 Jump if not at tracks above 63 or 31.
057F RES 1,C Otherwise enable write precompensation
(reset bit 1 of the command).
0581 PREC_2 JP #06F7,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.
0584 WSAD XOR A Reset retry counter.
0585 LD (#3DDB),A
0588 WSAD_1 CALL #0667,SET_TRKSEC Select drive, side, density and sector
and position the head above the correct
track.
058B CALL #056C,PRECOMP Enable precompensation when neccesary
and give the command to the FDC.
058E CALL #0D86,HL_BUFFER Make HL point to the data buffer.
0591 CALL #0599,WR_OP Write the sector.
0594 CALL #060D,SECTOR_ERR Check if there was an error, report it
if retried often enough. Otherwise exit
0597 JR #0588,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).
0599 WR_OP CALL #0553,STORE_IFF Store maskable interrupt state and
disable maskable interrupts.
059C LD BC,251 BC holds the I/O port address of the
data register of the FDC.
059F JR #05A4,WR_TST_DRQ Jump into the save loop.
05A1 WR_LOOP OUTI Send a byte to the FDC (port BC) then
increment HL (and decrement B).
05A3 NOP Waste some time.
05A4 WR_TST_DRQ IN A,(227) Fetch FDC status.
05A6 BIT 1,A Test Data ReQuest bit.
05A8 JR NZ,#05A1,WR_LOOP Jump if FDC requests a byte.
05AA IN A,(227) Otherwise fetch FDC status again.
05AC BIT 1,A
05AE JR NZ,#05A1,WR_LOOP Jump if FDC requests a byte.
05B0 IN A,(227)
05B2 BIT 1,A
05B4 JR NZ,#05A1,WR_LOOP
05B6 IN A,(227)
05B8 BIT 1,A
05BA JR NZ,#05A1,WR_LOOP
05BC BIT 0,A Test Busy bit.
05BE JR NZ,#05A4,WR_TST_DRQ Repeat until FDC is ready.
05C0 CALL #055F,REST_IFF Restore the interrupt state.
05C3 BIT 6,A Test Write Protected bit.
05C5 RET Z Return if not write protected.
05C6 CALL #0B56,DEC_MAPUSE Decrease (MAPUSED), the number of files
using the disk bitmap.
05C9 JP #1672,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.
05CC RSAD XOR A Clear retry counter.
05CD LD (#3DDB),A
05D0 RSAD_1 CALL #0667,SET_TRKSEC Set drive, side, density, sector and
position the head above the correct
track.
05D3 LD C,%10000000 Read a single sector, enable spin-up
sequence, no settling delay.
05D5 CALL #06F7,LD_COM_REG Give the command to the FDC.
05D8 CALL #0D86,HL_BUFFER Make HL point to the data buffer.
05DB CALL #05E3,RD_OP Read the sector.
05DE CALL #060D,SECTOR_ERR Check if there was an error, report it
if retried often enough. Otherwise exit
05E1 JR #05D0,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).
05E3 RD_OP CALL #0553,STORE_IFF Store the maskable interrupt state and
disable interrupts.
05E6 LD BC,251 I/O address of the FDCs data register.
05E9 JR #05EE,RD_TEST_DRQ Jump into the load loop.
05EB RD_LOOP INI Get a byte from the FDC and increment
HL (and decrement B).
05ED NOP Wait for a moment.
05EE RD_TST_DRQ IN A,(227) Fetch FDC status.
05F0 BIT 1,A Test Data ReQuest bit.
05F2 JR NZ,#05EB,RD_LOOP Jump if FDC has read a byte.
05F4 IN A,(227) Otherwise fetch FDC status again.
05F6 BIT 1,A
05F8 JR NZ,#05EB,RD_LOOP Jump if FDC has read a byte.
05FA IN A,(227)
05FC BIT 1,A
05FE JR NZ,#05EB,RD_LOOP
0600 IN A,(227)
0602 BIT 1,A
0604 JR NZ,#05EB,RD_LOOP
0606 BIT 0,A Test Busy bit.
0608 JR NZ,#05EE,RD_TST_DRQ Repeat until FDC is ready.
060A JP #055F,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.
If there was an positioning error the routine moves the head to the correct track. With
other errors the head is repositioned above the current track, unless ten retries have
been made, then an error is reported.
060D SECTOR_ERR AND %00011100 Mask the non error bits.
060F JR NZ,#0618,SEC_ERR1 Jump with an error.
0611 CALL #0DAA,RES_RPT Otherwise reset the data buffer pointer
(RPT).
0614 POP HL Drop return address and exit with
0615 JP #0D86,HL_BUFFER HL pointing to the data buffer.
0618 SEC_ERR1 PUSH AF Save error.
0619 LD A,(#3DDB) Increment the retry counter.
061C INC A
061D LD (#3DDB),A
0620 CP 10 If 10 retries have been made 'SECTOR
0622 JP NC,#164C,REP_4 error' is given.
0625 POP AF
0626 BIT 4,A
0628 JR NZ,#0636,SEC_ERR2 Jump with positioning error.
062A CALL #0DCF,STEP_IN Otherwise shake the the dust out of
062D CALL #0DCB,STEP_OUT the drive.
0630 CALL #0DCB,STEP_OUT
0633 JP #0DCF,STEP_IN
The routine now checks whether the head is above the right track. The current
tracknumber 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 16 the 'FORMAT
data lost' error is given.
0636 SEC_ERR2 LD C,%11000000 Read Address, disable spinup, no delay.
0638 CALL #06F7,LD_COM_REG Execute the command.
063B LD HL,#3DDC Address where the ID Field is loaded.
063E CALL #05E3,RD_OP Get the six byte ID Field of the first
sector encountered.
0641 AND %00011100
0643 JR NZ,#064B,SEC_ERR3 Jump if there was an error.
0645 LD A,(#3DDC) Otherwise store the current track
0648 OUT (235),A number into the FDC's track register.
064A RET
064B SEC_ERR3 LD A,(#3DDB)
064E INC A Increment retry counter.
064F LD (#3DDB),A
0652 CP 16 Give up if tried 16 times, 'FORMAT
0654 JP Z,#164E,REP_5 data lost'.
0657 CP 10
0659 JR NZ,#0662,SEC_ERR4 After 10 times try something different.
065B PUSH DE
065C CALL #06A4,TRACK_0 Start from the beginning of the disk.
065F POP DE
0660 JR #0636,SEC_ERR2
0662 SEC_ERR4 CALL #0DCF,STEP_IN Take one small step.
0665 JR #0636,SEC_ERR2 And retry again.
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: 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 +D can get confused.
0667 SET_TRKSEC LD A,D
0668 OR E
0669 JR NZ,#0676,SET_TRK1 Jump if DE<>0.
066B CALL #1626,TEST_2 Test the .. flag.
066E JP Z,#167A,REP_27 Give 'END of file' error when reset.
0671 LD SP,(#2066) Otherwise clear the machine stack.
0675 RET
0676 SET_TRK1 CALL #071C,SET_DRVSD Select drive, side and density.
0679 LD A,E Store the required sector number into
067A OUT (243),A the FDC's sector register.
067C CALL #1684,FLASH_REST Change the border colour when wanted.
067F SET_TRK2 LD A,D Track to A.
0680 AND #7F Mask highest bit which indicates side.
0682 LD B,A
0683 CALL #06E6,FDC_READY Wait until FDC is ready, test BREAK.
0686 IN A,(235) Fetch contents of FDC's track register.
0688 CP B Compare against required track.
0689 RET Z Exit if already on right track.
068A CALL NC,#0DCB,STEP_OUT Step out if required track lies
outwards (more towards track 0).
068D CALL C,#0DCF,STEP_IN Otherwise step in.
0690 JR #067F,SET_TRK2 Continue until on the right track.
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.
0692 STEP_DELAY LD A,(#2003) Fetch (STPRAT).
0695 AND A
0696 STEP_D1 RET Z Exit if 'msec-counter' reaches zero.
0697 WAIT_1MSEC PUSH AF
0698 LD BC,135 With this value the following loop
takes 3505 T states (about 1msec) to
complete.
069B WAIT_1M1 DEC BC
069C LD A,B
069D OR C
069E JR NZ,#069B,WAIT_1M1 Repeat until counter reaches zero.
06A0 POP AF
06A1 DEC A Decrease 'msec-counter'.
06A2 JR #0696,STEP_D1
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 #06B6) 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.
06A4 TRACK_0 LD A,(#2003)
06A7 RLCA Double (STPRAT).
06A8 LD (#2003),A
06AB CALL #06B6,REST Move head to track 0.
06AE LD A,(#2003)
06B1 RRCA Restore original (STPRAT) value.
06B2 LD (#2003),A
06B5 RET
06B6 REST LD DE,#0001 Signal 'track 0, sector 1'.
06B9 CALL #071C,SET_DRVSD Set drive, side and density.
The following code resets the drive head to track 0.
06BC LD C,%11010000 Terminate all operations.
06BE CALL #06FA,LD_COM_R1 Execute the FDC command.
06C1 LD B,0 Wait about 1 msec.
06C3 REST_1 DJNZ #06C3,REST_1
The routine now checks whether there is a disk in the drive. The bug present in the
DISCiPLE ROM is corrected, the +D doesn't wait forever for an INDEX pulse.
06C5 LD HL,0 The INDEX signal has to become low
and high again within about 1.4 sec.
06C8 REST_2 IN A,(227) Fetch FDC status.
06CA BIT 1,A
06CC CALL NZ,#06F0,REST_5 Call if INDEX signal is high.
06CF JR NZ,#06C8,REST_2 Wait for it to become low.
06D1 REST_3 IN A,(227) Fetch FDC status.
06D3 CPL Invert the bits.
06D4 BIT 1,A
06D6 CALL NZ,#06F0,REST_5 Call if INDEX signal is low.
06D9 JR NZ,#06D1,REST_3 Wait for it to become high again.
06DB REST_4 IN A,(227) Fetch the FDC status register.
06DD BIT 2,A
06DF JR NZ,#06E6,FDC_READY Exit if head is above track 0.
06E1 CALL #0DCB,STEP_OUT Otherwise, step-out and continue
06E4 JR #06DB,REST_4 the loop.
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.
06E6 FDC_READY IN A,(227) Fetch the FDC status.
06E8 BIT 0,A
06EA RET Z Exit if it's indicating 'FDC ready'.
06EB CALL #0497,TST_BREAK Test for BREAK.
06EE JR #06E6,FDC_READY Repeat until FDC is ready.
THE 'TRACK_0' ROUTINE CONTINUED
06F0 REST_5 DEC HL Decrease time limit.
06F1 LD A,H
06F2 OR L
06F3 RET NZ Return if limit isn't exceeded.
06F4 JP #1650,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.
06F7 LD_COM_REG CALL #06E6,FDC_READY Wait until FDC is ready, test BREAK.
06FA LD_COM_R1 LD A,C Load the command in the FDC's command
06FB OUT (227),A register.
06FD LD B,20 Wait for 73 µsec.
06FF LD_COM_R2 DJNZ #06FF,LD_COM_R2 Waste some time.
0701 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 #0702 is used when the drive is
specified in UFIA1. The entry point at #0705 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.
0702 TEST_DRV LD A,(#3E01) Fetch drive number from UFIA1.
0705 TEST_DRV1 CP 1
0707 JR Z,#0718,TEST_DRV2 Jump if drive one is to be used.
0709 CP 2 Otherwise give 'Wrong DRIVE' error if
070B JP NZ,#1670,REP_22 drive isn't drive two.
070E LD A,(#2002) Fetch (TRAKS2) system variable.
0711 CP 0
0713 JP Z,#1670,REP_22 Give error if drive isn't defined.
0716 LD A,2 Select drive two.
0718 TEST_DRV2 LD (IX+11),A Store hardware representation.
071B RET
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 239).
071C SET_DRVSD LD B,(IX+11) Fetch hardware drive representation.
071F LD A,(#3DDA) Fetch current control port status.
0722 AND %00000011 Keep only drive 1&2 select bits.
0724 CP B Set Zero flag if drive isn't changed.
0725 PUSH AF
0726 LD A,(#3DDA) Fetch current control port status
0729 AND %01111100 again. Mask drive and side select bits.
072B LD C,A Store result temporary.
072C LD A,D Fetch track.
072D AND %10000000 Only keep side select.
072F OR B Include drive select.
0730 OR C Include all other bits.
0731 LD (#3DDA),A Set current control port status.
0734 OUT (239),A Activate settings.
0736 POP AF Get Zero flag.
0737 RET Z Exit if drive hasn't changed.
NOTE: This would have been a nice place to update the FDC's track register, it is very
unlikely that both drives are on the same track all the time.
0738 LD A,128 Otherwise wait for 128 msec.
073A JP #0697,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). It is
used to get the program number printed in the extended CATalogue.
073D PROG_NUM PUSH DE Track and sector to BC.
073E POP BC
073F XOR A Clear A.
0740 DEC B
0741 JP M,#074A,PROG_N2 Jump with track 0, B now holds -1.
0744 PROG_N1 ADD A,10 Otherwise set A to 10*track number.
0746 DEC B
0747 JP P,#0744,PROG_N1 Repeat until B gets below zero.
074A PROG_N2 LD B,A
074B SLA B Otherwise double number of tens.
074D SLA C Together with the next instruction the
074F DEC C effect is 'INC C'.
0750 LD A,(IX+14) Fetch high byte of RPT.
0753 ADD A,C Add adjusted sector.
0754 ADD A,B Add adjusted track.
0755 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.
0756 SECT_END_Z CALL #0D97,RPT_HL1 Get RPT in HL and the disk buffer
0759 LD A,C position in BC.
075A CP 254 Exit if disk buffer position 510 (or
075C RET NZ 254) hasn't been reached, Zero reset.
075D LD A,B Position 510 has to be reached before
075E CP 1 returning with Zero set.
0760 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.
0761 SBYT PUSH BC
0762 PUSH DE
0763 PUSH HL
0764 PUSH AF
0765 CALL #0756,SECT_END_Z Check if the data buffer is full.
0768 JR NZ,#0777,SBYT_1 Jump if data buffer not full.
076A CALL #0925,MK_ALLOC Allocate the first free sector.
076D LD (HL),D Store it's track and sector number into
076E INC HL the last two bytes of the data buffer.
076F LD (HL),E
0770 EX DE,HL
0771 CALL #0DC1,GET_SECTOR Fetch track and sector number of the
current sector into DE, store the next
track and sector number.
0774 CALL #0584,WSAD Write the sector to disk.
0777 SBYT_1 POP AF
0778 LD (HL),A Store value.
0779 POP HL
077A POP DE
077B POP BC
077C JP #0DA2,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.
077F LBYT PUSH BC
0780 PUSH DE
0781 PUSH HL
0782 CALL #0756,SECT_END_Z Check if the data buffer is empty.
0785 JR NZ,#078D,LBYT_1 Jump if data buffer not empty.
0787 LD D,(HL) Otherwise fetch track and sector number
0788 INC HL of next sector into DE.
0789 LD E,(HL)
078A CALL #05CC,RSAD Load the next sector.
078D LBYT_1 LD A,(HL) Get a byte.
078E POP HL
078F POP DE
0790 POP BC
0791 JP #0DA2,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 #079E. 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.
0794 LD_BUF LD A,(HL) Fetch a byte from the data buffer.
0795 CALL #0DA2,INC_RPT Increment RPT.
0798 LD HL,(#3AC8) Fetch load address.
079B LD (HL),A Load the byte into memory.
079C INC HL
079D DEC DE
079E LOAD_FILE LD (#3AC8),HL Store load address into (FILEADDR).
07A1 LD A,D
07A2 OR E
07A3 RET Z Exit if no more bytes left.
07A4 LD_BUF1 CALL #0756,SECT_END_Z The data buffer has to be empty before
07A7 JR NZ,#0794,LD_BUF sectors can be loaded directly into
memory. Jump if data buffer not empty.
07A9 LD (#3AC5),DE Store the number of bytes left to load
into (BYTESLEFT).
07AD LD D,(HL) Fetch next track and sector.
07AE INC HL
07AF LD E,(HL)
07B0 CALL #0833,STO_BUFLEN Store the data buffer length.
07B3 LD_OP CALL #083B,LAST_SEC_C Check if this sector is the last one.
07B6 JP C,#0829,LD_LAST Jump if last sector.
07B9 INC HL Balance the Carry flag subtracted in
'LAST_SEC_C'.
07BA LD (#3AC5),HL Store number of bytes left after this
sector has been loaded.
07BD XOR A Clear retry counter.
07BE LD (#3DDB),A
07C1 CALL #0DBA,STORE_SEC Store track and sector.
07C4 LD_AGAIN CALL #0667,SET_TRKSEC Set drive, side, density, sector and
track.
07C7 LD C,%10000000 Read a single sector, enable spin-up,
no settling delay.
07C9 CALL #06F7,LD_COM_REG Execute the FDC command.
07CC CALL #0553,STORE_IFF Store interrupt state and disable.
07CF EXX HL' has to be rescued because the
07D0 PUSH HL 'main' ROM needs it.
07D1 LD BC,251 I/O address of FDC's data register.
07D4 LD DE,2 DE' holds the length of the next sector
address in each sector.
07D7 CALL #0D86,HL_BUFFER HL' points to the data buffer.
07DA EXX
07DB LD BC,251 I/O address of FDC's data register.
07DE LD DE,(#3ACA) DE holds length of data buffer. DE +
DE' hold the length of a sector.
07E2 LD HL,(#3AC8) HL holds the load address.
07E5 JR #07EF,LD_TST_DRQ Jump into the load loop.
07E7 LD_LOOP INI Get a byte from the FDC, increment HL.
07E9 DEC DE Decrement byte counter.
07EA LD A,D
07EB OR E
07EC JR NZ,#07EF,LD_TST_DRQ Jump if not zero.
07EE EXX Otherwise select the other HL and DE.
07EF LD_TST_DRQ IN A,(227) Fetch FDC status.
07F1 BIT 1,A Test Data ReQuest bit.
07F3 JR NZ,#07E7,LD_LOOP Jump if FDC has read a byte.
07F5 IN A,(227) Otherwise fetch FDC status again.
07F7 BIT 1,A
07F9 JR NZ,#07E7,LD_LOOP Jump if FDC has read a byte.
07FB IN A,(227)
07FD BIT 1,A
07FF JR NZ,#07E7,LD_LOOP
0801 IN A,(227)
0803 BIT 1,A
0805 JR NZ,#07E7,LD_LOOP
0807 BIT 0,A Test Busy bit.
0809 JR NZ,#07EF,LD_TST_DRQ Repeat until FDC is ready.
080B EXX When the FDC is ready, DE and DE' both
080C POP HL are 0, and the 'EXX' at #07EE has been
080D EXX executed twice, so to restore HL'
a 'EXX' has to be executed first.
080E CALL #055F,REST_IFF Restore interrupt state.
0811 AND %00011100 Mask non error bits of FDC status.
0813 JR Z,#081D,LD_OK Jump with no errors.
0815 CALL #0DB3,FETCH_SEC Otherwise fetch track and sector again.
0818 CALL #0618,SEC_ERR1 Check if there was a sector error.
081B JR #07C4,LD_AGAIN Try to load the sector again.
If there are no errors the next sector can be loaded.
081D LD_OK LD (#3AC8),HL Store the load address into (FILEADDR).
0820 CALL #0D86,HL_BUFFER Make HL point to the data buffer.
0823 LD D,(HL) Fetch the next track and sector number.
0824 INC HL
0825 LD E,(HL)
0826 JP #07B3,LD_OP Load the next sector.
The last sector is loaded into the data buffer.
0829 LD_LAST CALL #05CC,RSAD Load the last sector.
082C LD DE,(#3AC5) Fetch number of bytes left (BYTESLEFT)
0830 JP #07A4,LD_BUF1 and copy them to 'main' RAM.
THE 'STORE BUFFER LENGTH' SUBROUTINE
This subroutine stores the length of the data buffer into (#1ACA). Because the +D only
uses double density this is always 510.
0833 STO_BUFLEN LD BC,510 Length of DD data buffer.
0836 LD (#3ACA),BC Store the length into (BUFLEN).
083A RET
THE 'LAST_SEC_C' SUBROUTINE
This subroutine returns with the Carry flag set if the last sector is to be loaded.
083B LAST_SEC_C LD HL,(#3AC5) Fetch the number of bytes left to be
loaded from (BYTESLEFT).
083E LD BC,(#3ACA) Fetch the data buffer length from
(BUFLEN).
0842 SCF Set the Carry flag, now the Carry flag
will be set after the 'SBC' if HL=BC.
0843 SBC HL,BC Exit with Carry set signalling 'last
0845 RET sector to be loaded'.
THE 'SAVE FILE' ROUTINE
This is the opposite of the 'LOAD_FILE' routine above. The entry address is #0850, 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.
0846 SA_BUF LD (HL),D Save the byte in the data buffer.
0847 CALL #0DA2,INC_RPT Increment RPT.
084A LD HL,(#3AC8) Fetch save address from (FILEADDR).
084D INC HL
084E POP DE
084F DEC DE
0850 HSVBK_2 LD A,D
0851 OR E
0852 RET Z Exit if no more bytes to save.
0853 PUSH DE
0854 LD D,(HL) Fetch a byte from memory.
0855 LD (#3AC8),HL Store save address into (FILEADDR).
0858 CALL #0756,SECT_END_Z The data buffer has to be full before
085B JR NZ,#0846,SA_BUF the sector can be saved. Jump if data
buffer isn't full.
085D POP DE Fetch number of bytes left to save and
085E LD (#3AC5),DE store it into (BYTESLEFT).
0862 CALL #0925,MK_ALLOC Allocate the first free sector.
0865 LD (HL),D Store track and sector number into the
0866 INC HL data buffer.
0867 LD (HL),E
0868 EX DE,HL
0869 CALL #0DC1,GET_SECTOR Fetch track and sector number of the
current sector in DE, store the next
track and sector number.
086C CALL #0584,WSAD Write the sector to disk.
086F XOR A Clear sector counter.
0870 LD (#3DEA),A
0873 CALL #0833,STO_BUFLEN Store the data buffer length.
0876 CALL #083B,LAST_SEC_C Check if this is the last sector.
0879 JP C,#0918,SA_LAST Jump if it is.
087C CALL #0D86,HL_BUFFER HL points to the data buffer.
087F SA_ALLOC PUSH HL Store data buffer address.
0880 CALL #083B,LAST_SEC_C Check if this is the last sector.
0883 PUSH HL DE now holds the number of bytes left
0884 POP DE -1.
0885 POP HL Restore data buffer pointer.
0886 JR C,#089D,SA_OP Jump if all but last sector allocated.
0888 INC DE Balance the Carry subtracted in
0889 LD (#3AC5),DE 'LAST_SEC_C' before storing the number
of bytes left into (BYTESLEFT).
088D CALL #0925,MK_ALLOC Allocate a sector.
0890 LD (HL),D Store its track and sector number into
0891 INC HL the data buffer.
0892 LD (HL),E
0893 INC HL
0894 LD A,(#3DEA) Increase sector counter.
0897 INC A
0898 LD (#3DEA),A
089B JR NZ,#087F,SA_ALLOC Repeat until all sectors have been
allocated or the sector counter
overflows.
089D SA_OP XOR A Reset retry counter.
089E LD (#3DDB),A
08A1 CALL #0DB3,FETCH_SEC Fetch the sector to be saved.
08A4 SA_AGAIN CALL #0667,SET_TRKSEC Set drive, side, etc.
08A7 CALL #056C,PRECOMP Enable precompensation when neccesary
and execute the write sector command.
08AA CALL #0553,STORE_IFF Store interrupt state and disable.
08AD EXX HL' has to be stored because the
08AE PUSH HL 'main' ROM needs it.
08AF CALL #0D97,RPT_HL1 HL' points to the sector address
table, build up in the data buffer.
08B2 LD DE,2 DE' holds the length of the next
sector address in each sector.
08B5 LD BC,251 BC' holds the I/O address of the FDC's
data register.
08B8 EXX
08B9 LD HL,(#3AC8) HL holds the save address.
08BC LD DE,(#3ACA) DE holds the length of the data space
inside a sector. DE+DE' hold the
length of a complete sector.
08C0 LD BC,251 BC holds the same as BC'.
08C3 JR #08CD,SA_TST_DRQ Jump into the save loop.
08C5 SA_LOOP OUTI Send a byte to the FDC, increment HL.
08C7 DEC DE Decrement byte counter.
08C8 LD A,D
08C9 OR E
08CA JR NZ,#08CD,SA_TST_DRQ Jump if not zero.
08CC EXX Otherwise select the other HL and DE.
08CD SA_TST_DRQ IN A,(227) Fetch FDC status.
08CF BIT 1,A Test Data ReQuest bit.
08D1 JR NZ,#08C5,SA_LOOP Jump if FDC requests a byte.
08D3 IN A,(227) Otherwise fetch FDC status again.
08D5 BIT 1,A
08D7 JR NZ,#08C5,SA_LOOP Jump if FDC requests a byte.
08D9 IN A,(227)
08DB BIT 1,A
08DD JR NZ,#08C5,SA_LOOP
08DF IN A,(227)
08E1 BIT 1,A
08E3 JR NZ,#08C5,SA_LOOP
08E5 BIT 0,A Test Busy bit.
08E7 JR NZ,#08CD,SA_TST_DRQ Repeat until FDC is ready.
08E9 CALL #055F,REST_IFF Restore interrupt state.
08EC AND %00011100 Mask non error bits of FDC status.
08EE JR Z,#08FB,SA_OK Jump with no errors.
08F0 EXX
08F1 POP HL Restore HL'.
08F2 EXX
08F3 CALL #0DB3,FETCH_SEC Fetch track and sector again.
08F6 CALL #0618,SEC_ERR1 Check if there was a sector error.
08F9 JR #08A4,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.
08FB SA_OK LD (#3AC8),HL Store the save address into (FILEADDR)
08FE EXX
08FF DEC HL Fetch track and sector number of next
0900 LD E,(HL) sector.
0901 DEC HL
0902 LD D,(HL)
0903 CALL #0DA2,INC_RPT Update RPT.
0906 CALL #0DA2,INC_RPT
0909 CALL #0DBA,STORE_SEC Store the next sector's track and
sector number.
090C POP HL Restore HL'.
090D EXX
090E LD A,(#3DEA) Decrease sector counter.
0911 DEC A
0912 LD (#3DEA),A Save the next sector as long as it
0915 JP NZ,#089D,SA_OP isn't the last one.
0918 SA_LAST CALL #0DAA,RES_RPT The bytes of the last sector are saved
091B LD DE,(#3AC5) into the data buffer again. Fetch the
091F LD HL,(#3AC8) number of bytes left and the save
0922 JP #0850,HSVBK_2 address. Then save the bytes into the
data buffer.
THE 'ALLOCATE SECTOR' SUBROUTINE
This subroutine allocates the first free sector, which track and sector number are
returned in the DE register pair. The routine searches the disk bitmap at #1A00 for a
free sector, if there isn't one an error is reported.
0925 MK_ALLOC PUSH HL
0926 PUSH BC
0927 LD HL,#3A00 Address where disk bitmap is located.
092A LD DE,#0401 Start with track 4, sector 1.
092D LD C,0 Clear bitmap offset.
092F MK_ALL1 LD A,(HL)
0930 CP #FF
0932 JR NZ,#0946,MK_ALL3 Jump if there is a free sector here.
0934 LD A,E Otherwise update sector number.
0935 ADD A,8 Each byte holds 8 sectors.
0937 LD E,A
0938 SUB 10 But each track holds 10.
093A JR C,#0942,MK_ALL2 Jump if still on the same track, i.e.
093C JR Z,#0942,MK_ALL2 with sectors <=9 and 10.
093E LD E,A Otherwise the next sector has been
093F CALL #0956,NEXT_TRACK computed, next track is computed now.
0942 MK_ALL2 INC C Increase bitmap offset.
0943 INC HL Next byte of bitmap.
0944 JR #092F,MK_ALL1 Find a free sector.
Now the routine continues to find which sector is free.
0946 MK_ALL3 LD B,1 Reset bit pointer.
0948 MK_ALL4 LD A,(HL)
0949 AND B
094A JR Z,#0968,MK_ALLOC5 Jump if free sector has been found.
094C CALL #0D7E,NEXT_SEC Increase sector number.
094F CALL Z,#0956,NEXT_TRACK Next track if sector is on it.
0952 RLC B Test next sector.
0954 JR #0948,MK_ALL4
THE 'NEXT TRACK' SUBROUTINE
This subroutine checks whether the next track (current track held in D) still exists and
returns holding the next track in D when it does exist. If the drive capacity is
exceeded, the 'Not enough SPACE on disc' error is given.
0956 NEXT_TRACK INC D Increase track.
0957 CALL #0985,DRV_CAP Get number of tracks on current drive
in the A register.
095A CP D Decrement 'number of files using the
095B CALL Z,#0B56,DEC_MAPUSE disk bitmap' and give an error if
095E JP Z,#1674,REP_24 drive capacity is exceeded.
0961 AND #7F Mask off side bit.
0963 CP D
0964 RET NZ Return if side 0 isn't full.
0965 LD D,128 Otherwise return with track 0, side 1.
0967 RET
THE 'ALLOCATE SECTOR' ROUTINE CONTINUED
Now the 'ALLOCATE SECTOR' routine continues by unfreeing the found sector.
0968 MK_ALL5 LD A,(HL) Make found sector unfree in disk
0969 OR B bitmap.
096A LD (HL),A
096B LD A,B
096C LD B,0
096E PUSH IX
0970 ADD IX,BC Add bitmap offset.
0972 OR (IX+34) Set new sector in file bitmap.
0975 LD (IX+34),A
0978 POP IX Restore disk channel pointer.
097A INC (IX+31) Increment number of sectors used.
097D JR NZ,#0982,MK_ALL6
097F INC (IX+30)
0982 MK_ALL6 POP BC
0983 POP HL
0984 RET Finished.
THE 'GET DRIVE CAPACITY' SUBROUTINE
This small subroutine returns with the A register holding the capacity of the selected
drive, as found in the system variables.
0985 DRV_CAP PUSH HL
0986 LD HL,#2001 This is TRAKS1, drive 1's capacity.
0989 LD A,(#3DDA) Fetch current control port state.
098C BIT 0,A
098E JR NZ,#0991,DRV_CAP1 Jump if drive 1 selected.
0990 INC HL Otherwise point to TRAKS2.
0991 DRV_CAP1 LD A,(HL) Fetch drive capacity.
0992 POP HL
0993 RET Finished.
THE 'PRINT NAME' SUBROUTINE
This subroutine is used to print the name of a file during a 'CAT' command and when the
'overwrite' message is printed.
0994 PRT_NAME LD (IX+13),1 Point to the first character of the
name.
0998 CALL #0D97,RPT_HL1 Make HL point to it.
099B LD B,10 A name has 10 characters.
099D PRT_NAM1 LD A,(HL) Fetch a character.
099E CALL #1799,PRT_A Print it.
09A1 INC HL
09A2 DJNZ #09A2,PRT_NAM1 Repeat for all 10 characters.
09A4 RET
THE 'SCAN CATALOGUE' SUBROUTINE
This very important subroutine scans the CATalogue of a disk, whether this is for a free
entry, a matching filename, or for printing the directory. On entry all needed parameters
other than the A register should be contained in UFIA1. The A register determines where
to scan for as follows: (bits set)
- bit 0 : Search for the file with the specified program number.
- bit 1 : Print a 'names only' CATalogue to the current stream. A filename
must be specified.
- bit 2 : Print an 'extended' CATalogue to the current stream. A filename
has to be specified.
- bit 3 : Search for a file with the specified type and name.
- bit 4 : Search for a file with the specified filename.
- bit 5 : Produce the disk bitmap.
- bit 6 : Find the first unused entry.
Note that some functions exclude others. A return is made with DE holding the track and
sector number of the found entry, the data buffer holding the sector, RPT pointing to the
entry and the Zero flag signalling 'success' when set.
09A5 SCAN_CAT LD IX,#3AC3 IX points to the disk channel.
09A9 LD (IX+4),A Store scan-type.
09AC XOR A Clear column counter.
09AD LD (#3DEB),A
09B0 CALL #06B6,REST Reset drive head to track 0, DE = 1.
09B3 EACH_ENTRY CALL #05CC,RSAD Load a CATalogue sector.
09B6 EACH_E1 CALL #0D93,RPT_HL HL points to the start of data buffer.
09B9 LD A,(HL) Fetch file type.
09BA AND A Jump if it's an unused entry (could be
09BB JP Z,#0AA7,SCAN_FREE ERASEd).
09BE BIT 0,(IX+4)
09C2 JR Z,#09D0,NO_PRGNUM Jump if not searching for a filenumber
09C4 CALL #073D,PROG_NUM Otherwise load program number into A.
09C7 LD B,A
09C8 LD A,(#3E02) Fetch specified program number.
09CB CP B
09CC RET Z Exit if they are equal.
09CD JP #0A88,SCAN_NEXT Otherwise continue scanning.
NOTE: All entries with numbers below the specified one are considered, this isn't really
needed.
09D0 NO_PRGNUM BIT 1,(IX+4) Jump if a short CATalogue should be
09D4 JR NZ,#09DC,PRINT_CAT printed.
09D6 BIT 2,(IX+4)
09DA JR Z,#0A55,NO_CAT Jump if no CATalogue is desired.
09DC PRINT_CAT LD (IX+13),11 RPT points to number of sectors used.
09E0 CALL #0D97,RPT_HL1 Make HL hold RPT.
09E3 LD B,(HL) Fetch number of sectors used.
09E4 INC HL
09E5 LD C,(HL)
09E6 LD (#3AC3),BC Store it for printing.
09EA LD HL,(#3DD8) Add it to total number of sectors used
09ED ADD HL,BC
09EE LD (#3DD8),HL
09F1 BIT 7,A
09F3 JP NZ,#0A88,SCAN_NEXT Jump if this entry is hidden.
09F6 CALL #0AB0,MATCH_NAME
09F9 JP NZ,#0A88,SCAN_NEXT Jump if filename doesn't match.
09FC BIT 1,(IX+4)
0A00 JR NZ,SCAN_1 Jump with short CAT.
0A02 CALL #073D,PROG_NUM Calculate program number.
0A05 PUSH DE
0A06 LD H,0 Program number to HL.
0A08 LD L,A
0A09 LD A,32 Use leading spaces.
0A0B CALL #1758,PRT_N10 Print the program number.
0A0E POP DE Restore sector address.
0A0F CALL #1797,PRT_SPACE Print a space.
0A12 SCAN_1 CALL #0994,PRT_NAME Print filename.
0A15 BIT 1,(IX+4)
0A19 JR Z,#0A3F,EXT_CAT Jump with extended CAT.
0A1B LD B,3 Otherwise print three columns wide.
0A1D LD A,(#3E03) Except when using stream 3.
0A20 CP 3
0A22 JR NZ,#0A26,SCAN_2
0A24 SLA B Then print six columns wide.
0A26 SCAN_2 LD A,(#3DEB) Increment column counter.
0A29 INC A
0A2A CP B
0A2B JR Z,#0A34,SCAN_3 Jump if last column reached.
0A2D LD (#3DEB),A Otherwise store column counter and
0A30 LD A,32 separate the columns with a SPACE.
0A32 JR #0A3A,SCAN_4
This line is full, the next entry will be printed on the next line.
0A34 SCAN_3 XOR A Clear column counter.
0A35 LD (#3DEB),A
0A38 LD A,13 Print a NEWLINE.
0A3A SCAN_4 CALL #1799,PRT_A
0A3D JR #0A88,SCAN_NEXT Continue with the next entry.
With an extended CAT there has to be printed somewhat more.
0A3F EXT_CAT PUSH DE Store track and sector number.
0A40 LD HL,(#3AC3) Fetch length of file in sectors.
0A43 LD A,32 Print it with leading spaces.
0A45 CALL #1752,PRT_N100
0A48 CALL #1797,PRT_SPACE Print a trailing space.
0A4B CALL #0D93,RPT_HL HL points to the start of the entry.
0A4E LD A,(HL) Fetch file type
0A4F CALL #169B,PRT_TYPE and print it.
0A52 POP DE Restore track and sector number.
0A53 JR #0A88,SCAN_NEXT Continue with the next entry.
Now the routine continues with the search part.
0A55 NO_CAT BIT 3,(IX+4)
0A59 JR NZ,#0A61,SCAN_NAME Jump if searching for name and type.
0A5B BIT 4,(IX+4)
0A5F JR Z,#0A65,SCAN_5 Jump if not searching for name alone.
0A61 SCAN_NAME CALL #0AB0,MATCH_NAME Return with Zero flag set to signal
0A64 RET Z 'matching name (and type) found'.
0A65 SCAN_5 BIT 5,(IX+4)
0A69 JR Z,#0A88,SCAN_NEXT Jump if no disk map wanted.
This part of the routine builds up the bitmap.
0A6B PUSH IX
0A6D LD (IX+13),15 RPT points to the start of file bitmap
0A71 CALL #0D97,RPT_HL1 Make HL hold RPT.
0A74 LD IX,#3A00 Start of disk bitmap.
0A78 LD B,195 There are 1560 bits in the bitmap.
0A7A SCAN_MAP LD A,(IX+0) Fetch a disk map byte.
0A7D OR (HL) Incorporate the corresponding file map
0A7E LD (IX+0),A byte.
0A81 INC IX Point to the next map bytes.
0A83 INC HL
0A84 DJNZ #0A7A,SCAN_MAP Repeat for all map bytes.
0A86 POP IX Restore disk channel pointer.
Another entry has been handled, go on with the next.
0A88 SCAN_NEXT LD A,(IX+14) Fetch RPT-hi.
0A8B CP 1 Jump if the second entry has been
0A8D JR Z,#A098,SCAN_6 handled.
0A8F CALL #0DAA,RES_RPT Reset RPT.
0A92 INC (IX+14) Point to the second entry.
0A95 JP #09B6,EACH_E1 Repeat for this entry.
The next CAT sector has to be retrieved (if there is one).
0A98 SCAN_6 CALL #0D7E,NEXT_SEC Calculate next sector.
0A9B JP NZ,#09B3,EACH_ENTRY Jump if on same track.
0A9E INC D Otherwise next track.
0A9F LD A,D
0AA0 CP 4
0AA2 JP NZ,#09B3,EACH_ENTRY Jump if still a CATalogue track.
0AA5 AND A Otherwise signal 'unsuccessfull' and
0AA6 RET exit.
An unused entry was found, so if we are searching for one then exit else continue.
0AA7 SCAN_FREE LD A,(IX+4) Fetch scan-type.
0AAA CPL Invert all bits.
0AAB BIT 6,A
0AAD RET Z Return if searching for a free entry.
0AAE JR #0A88,SCAN_NEXT Otherwise continue with next entry.
THE 'MATCH NAME' SUBROUTINE
This subroutine checks whether the filename and, when needed, directory description of
the current entry matches the specification. If they don't match the Zero flag is
returned reset.
0AB0 MATCH_NAME PUSH IX Store disk channel pointer.
0AB2 CALL #0D93,RPT_HL HL points to the start of the entry.
0AB5 LD B,11 Length of file description.
0AB7 BIT 3,(IX+4)
0ABB LD IX,#3E05 IX points to the file description in
UFIA1.
0ABF JR Z,#0AD1,MATCH_N2 Jump if directory description doesn't
need to match.
0AC1 MATCH_N1 LD A,(IX+0) Fetch character of search string.
0AC4 CP 42,"*" Jump if it's a '*', then all other
0AC6 JR Z,#0AD6,MATCH_N3 characters don't matter.
0AC8 CP 63,"?" Jump if it's a '?', then this
0ACA JR Z,#0AD1,MATCH_N2 character doesn't matter.
0ACC XOR (HL) Compare with entries character.
0ACD AND #DF Capitalize.
0ACF JR NZ,#0AD6,MATCH_N3 Jump if they don't match.
0AD1 MATCH_N2 INC IX Next character.
0AD3 INC HL
0AD4 DJNZ #0AC1,MATCH_N1 Repeat for all characters.
0AD6 MATCH_N3 POP IX Restore disk channel pointer.
0AD8 RET Return with Zero set signalling
'match'.
THE 'OPEN A FILE FOR SAVE' SUBROUTINE
This subroutine opens a file, with the specified filename, for saving. If the filename
wasn't used the file is opened, a return is made with the Zero flag set to signal
'successfull'. If the filename was used, the 'OVERWRITE' message is printed, when the 'Y'
key is pressed the existing file is ERASEd and the opening is retried. Otherwise the
routine returns with the Zero flag reset to signal 'unsuccessfull'.
0AD9 OFSM_2 PUSH IX Store disk channel pointer.
0ADB LD A,(#3DEF) This is (MAPUSED), the (in)famous
@7663. It holds the number of files
which are using the disk bitmap.
0ADE CP 0
0AE0 LD A,%00010000 Scan catalogue for specified filename.
0AE2 JR NZ,#0AF0,OFSM_SCAN Jump if (@7663)<>0, the disk bitmap
isn't to be rebuild.
0AE4 LD HL,#3A00 Otherwise clear the disk bitmap.
0AE7 LD B,195
0AE9 OFSM_CLR LD (HL),0
0AEB INC HL
0AEC DJNZ #0AE9,OFSM_CLR
0AEE LD A,%00110000 Scan catalogue for specified filename
and produce a disk bitmap.
0AF0 OFSM_SCAN CALL #09A5,SCAN_CAT
0AF3 JR NZ,#0B1C,OFSM_FREE Jump if filename not used.
0AF5 PUSH DE Otherwise store sector address.
0AF6 RST #10,CALBAS Clear the lower part of the screen by
0AF7 DEFW #0D6E,CLS_LOWER calling 'CLS_LOWER' in 'main' ROM.
0AF9 SET 5,(IY+2) Signal 'lower screen has to be
cleared'. (TV_FLAG)
0AFD CALL #17FE,MESG_1 Print 'OVERWRITE' message.
0B00 CALL #0994,PRT_NAME Print filename.
0B03 CALL #1823,MESG_3 Print 'Y/N' message.
0B06 CALL #0B60,TEST_Y Test the 'Y' key.
0B09 JR Z,#0B0F,OFSM_ERASE Jump if 'Y' was pressed.
0B0B POP DE When any other key was pressed the
0B0C POP IX routine returns with Zero reset to
0B0E RET signal 'unsuccessfull'.
The filename existed already, the user wants it to be overwritten, so ERASE it.
0B0F OFSM_ERASE POP DE Restore track and sector number.
0B10 CALL #0D93,RPT_HL Make HL point to the entry to be
overwritten.
0B13 LD (HL),0 ERASE this file.
0B15 CALL #0584,WSAD Write the entry back to disk.
0B18 POP IX Restore disk channel pointer.
0B1A JR #0AD9,OFSM_2 Retry opening the file.
The filename wasn't used so now the file can be opened.
0B1C OFSM_FREE POP IX Restore disk channel pointer.
0B1E PUSH IX
0B20 LD B,0 Clear the file entry space in the disk
0B22 OFSM_CLR LD (IX+19),0 channel.
0B26 INC IX
0B28 DJNZ #0B22,OFSM_CLR
0B2A POP IX Restore disk channel pointer.
0B2C PUSH IX
0B2E LD HL,#3E05 HL points to the file descriptor in
UFIA1.
0B31 LD B,11 Length of file descriptor.
0B33 OFSM_FDESC LD A,(HL) Copy file descriptor to the file entry
0B34 LD (IX+19),A space in the disk channel.
0B37 INC HL
0B38 INC IX
0B3A DJNZ #0B33,OFSM_FDESC
0B3C POP IX Restore disk channel pointer.
0B3E CALL #0925,MK_ALLOC Allocate a sector.
0B41 CALL #0DBA,STORE_SEC Store its track and sector number.
0B44 LD (IX+32),D Store its sector address also into the
0B47 LD (IX+33),E file entry space.
0B4A CALL #0DAA,RES_RPT Reset RPT.
0B4D LD A,(#3DEF) Increment (MAPUSED), there is one more
0B50 INC A file which uses the disk bitmap.
0B51 LD (#3DEF),A
0B54 XOR A Return with Zero flag set to signal
0B55 RET 'successfull'.
THE 'DECREMENT MAPUSE' SUBROUTINE
This small subroutine decrements the MAPUSED system variable. This variable keeps track
of the number of files using the disk bitmap. When it reaches 0 the bitmap has to be
rebuild.
0B56 DEC_MAPUSE PUSH AF
0B57 LD A,(#3DEF) Decrease (MAPUSED), the number of
0B5A DEC A files using the disk bitmap.
0B5B LD (#3DEF),A
0B5E POP AF
0B5F RET
THE 'TEST FOR YES' SUBROUTINE
This subroutine tests whether the 'Y'-key is pressed, it returns with the Zero flag set
if it was, reset otherwise.
0B60 TEST_Y CALL #0B75,BEEP Produce a 'middle C' for one second.
0B63 TEST_Y1 RST #10,CALBAS The 'main' ROM is called to scan the
0B64 DEFW #028E,KEY_SCAN keyboard.
0B66 RST #10,CALBAS It is also called to determine if a
0B67 DEFW #031E,KEY_TEST key was pressed.
0B69 JR NC,#0B63,TEST_Y1 Repeat scanning and testing until a
key has been pressed.
0B6B AND #DF Capitalize.
0B6D CP 89,"Y" Set the Zero flag if it was the
0B6F PUSH AF 'Y'-key.
0B70 RST #10,CALBAS Again the 'main' ROM is called, this
0B71 DEFW #0D6E,CLS_LOWER time for clearing the lower screen.
0B73 POP AF Retrieve Zero flag.
0B74 RET Finished.
THE 'MAKE A BEEP' SUBROUTINE
This subroutine produces a beep (the note 'middle C' in fact) for one second.
0B75 BEEP PUSH HL
0B76 PUSH DE
0B77 PUSH BC
0B78 PUSH IX
0B7A LD HL,1642 Parameters needed by 'BEEPER' to
0B7D LD DE,261 produce a 'middle C'.
0B80 RST #10,CALBAS Produce the note.
0B81 DEFW #03B5,BEEPER
0B83 POP IX
0B85 POP BC
0B86 POP DE
0B87 POP HL
0B88 RET
THE 'CLOSE A SAVE FILE' SUBROUTINE
This subroutine closes a save file, by writing the last sector (contained in the data
buffer) to disk and by writing the CATalogue entry.
0B89 CFSM CALL #0D97,RPT_HL1 HL points to the first unused position
in the data buffer.
0B8C LD A,C C holds buffer offset-lo.
0B8D AND A
0B8E JR NZ,#0B95,CFSM_FILL Jump if buffer isn't full yet.
0B90 LD A,B B holds buffer offset-hi.
0B91 CP 2
0B93 JR Z,#0B9C,CFSM_SAVE Jump if buffer is full.
0B95 CFSM_FILL LD (HL),0 Otherwise fill up buffer with zero's.
0B97 CALL #0DA2,INC_RPT Increment RPT.
0B9A JR #0B89,CFSM And close the file.
The last sector is ready to be saved, it has been filled up with zero's if needed.
0B9C CFSM_SAVE CALL #0DB3,FETCH_SEC Fetch last sector's track and sector
0B9F CALL #0584,WSAD number and save it to disk.
0BA2 CALL #0B56,DEC_MAPUSE One file less uses the disk bitmap.
0BA5 PUSH IX Store disk channel pointer.
0BA7 LD A,%01000000 Search the CATalogue for an unused
0BA9 CALL #09A5,SCAN_CAT entry.
0BAC JP NZ,#1676,REP_25 If none found report 'Directory FULL'.
0BAF CALL #0D93,RPT_HL HL points to the entry.
0BB2 LD (#3ACA),IX Store disk channel pointer 2, this one
points to the DFCA.
0BB6 POP IX Restore disk channel pointer 1, this
one can point to 'main' RAM (OPENTYPE)
0BB8 PUSH IX Store it again.
0BBA LD B,0 Copy the file entry to the CAT entry 0BBC
CFSM_ENTRY LD A,(IX+19) in the data buffer.
0BBF LD (HL),A
0BC0 INC IX
0BC2 INC HL
0BC3 DJNZ #0BBC,CFSM_ENTRY
0BC5 LD IX,(#3ACA) Restore disk channel pointer 2.
0BC9 CALL #0584,WSAD Write the sector to disk.
0BCC POP IX Restore disk channel pointer 1.
0BCE RET Finished.
THE 'OPEN A FILE FOR LOAD' SUBROUTINE
This subroutine opens a file, with the specified filename, for loading. If the filename
isn't found an error is given. If the filename is found it is opened and the first sector
is loaded into the data buffer.
0BCF HGFLE_2 LD A,(#3E04) Fetch device description from UFIA1.
0BD2 AND #DF Capitalize.
0BD4 CP 80,"P"
0BD6 JR NZ,#0BFC,HGFL_NONUM Jump if no program number specified.
0BD8 LD A,%00000001 Search for the specified program
0BDA CALL #09A5,SCAN_CAT number.
0BDD JP NZ,#1678,REP_26 If file isn't found report 'File NOT
FOUND'.
0BE0 CALL #0D93,RPT_HL HL points to the entry.
0BE3 LD DE,#3E05 Copy the 11 byte file descriptor to
0BE6 LD BC,11 UFIA1.
0BE9 LDIR
0BEB LD (IX+13),211 RPT points to the file header of the
file.
0BEF CALL #0D97,RPT_HL1 Make HL point to it.
0BF2 LD DE,#3E10 Copy the 9 byte file header to UFIA1.
0BF5 LD BC,9
0BF8 LDIR
0BFA JR #0C04,LOAD_1ST Jump forward to load the first sector.
Now search for the file with the given name.
0BFC HGFL_NONUM LD A,%00010000 Search for the specified filename.
0BFE CALL #09A5,SCAN_CAT If file isn't found report 'File NOT
0C01 JP NZ,#1678,REP_26 FOUND'.
Otherwise the first sector is loaded
by entering the 'LOAD FIRST SECTOR'
subroutine below.
THE 'LOAD FIRST SECTOR' SUBROUTINE
When the CAT entry of the file to be loaded is found, this routine can be used to fetch
the first sector of the file. The first sector holds the 9 byte file header (with certain
filetypes) which should be identical to the 9 byte file header present in the CAT entry.
0C04 LOAD_1ST CALL #0D93,RPT_HL HL points to the entry.
0C07 LD DE,#3E1E Copy the 11 byte file descriptor to
0C0A LD BC,11 UFIA2.
0C0D LDIR
0C0F LD (IX+13),220 RPT points to the SNAPSHOT registers,
that is when they are present.
0C13 CALL #0D97,RPT_HL1 Make HL point to it.
0C16 LD DE,#3FEA Copy the 22 SNAPSHOT values to the
0C19 LD BC,22 internal stack bottom.
0C1C LDIR
0C1E LD (IX+13),13 RPT points to track and sector number.
0C22 CALL #0D97,RPT_HL1 Now HL points to it also.
0C25 LD D,(HL) Fetch track and sector number.
0C26 INC HL
0C27 LD E,(HL)
0C28 JP #05CC,RSAD And exit while loading the first
sector.
THE 'FORMAT A DISK' ROUTINE
This routine formats a disk by writing one track at a time to disk. The track is first
build up in 'main' RAM. After the formatting is completed, the other disk is completely
copied (cloned) or the disk is checked for bad sectors.
0C2B FORMAT_RUN CALL #0702,TEST_DRV See if the drive is defined.
0C2E CALL #071C,SET_DRVSD
0C31 LD B,20 First step 20 times inward.
0C33 FRMT_1 PUSH BC
0C34 CALL #0DCF,STEP_IN
0C37 POP BC
0C38 DJNZ #0C33,FRMT_1
0C3A CALL #06A4,TRACK_0 Then position the head above track 0.
0C3D LD IX,#3AC3 IX points to the DFCA.
0C41 FRMT_TRK CALL #0CF5,MK_TRK_DD Build up a double density track.
0C44 LD C,%11110000 Write track, disable spin-up sequence,
no delay, enable precompensation.
0C46 CALL #056E,PRECOMP1 Why call this routine ? The precomp.
has already been enabled.
0C49 LD HL,49152 HL points to the track build up in
'main' memory.
0C4C CALL #0599,WR_OP Write the track.
0C4F CALL #0692,STEP_DELAY Wait a moment.
0C52 INC D Next track.
0C53 CALL #0985,DRV_CAP Get drive capacity in A.
0C56 CP D
0C57 JR Z,#0C79,FRMT_DONE Jump if all tracks have been formatted
0C59 AND #7F Mask off side.
0C5B CP D
0C5C JR Z,#0C6E,FRMT_SIDE1 Jump if side1 hasn't been formatted.
0C5E CALL #0DCF,STEP_IN Next track.
The following code determines the skew, i.e. the shifting between the sectors of a track
and the previous track. The +D uses a skew of +2, so sector 1 on track T lies adjacent to
sector 9 on track T+1.
0C61 DEC E
0C62 JR NZ,#0C66,FRMT_2 Jump if sector >= 1.
0C64 LD E,10 Sector numbers have range 1..10.
0C66 FRMT_2 DEC E
0C67 JR NZ,#0C6B,FRMT_3 Jump if sector >= 1.
0C69 LD E,10 This instruction is never reached ??
0C6B FRMT_3 JP #0C41,FRMT_TRK Format the next track.
If a double sided drive is used, the formatting continues on track 0 side 1.
0C6E FRMT_SIDE1 CALL #06A4,TRACK_0 Reset drive head.
0C71 LD D,128 Track 0, side 1.
0C73 CALL #071C,SET_DRVSD Set drive, side, density, etc.
0C76 JP #0C41,FRMT_TRK Continue formatting.
When the formatting of all tracks is completed, the routine checks whether it is
supposed to copy another disk to this one, or to verify the disk.
0C79 FRMT_DONE CALL #06B6,REST Reset drive head.
0C7C LD A,(#3E1A)
0C7F CP #FF
0C81 JR Z,#0CD3,FRMT_CHK Jump if UFIA2 is empty.
When the disk in the other drive is to be cloned, it will be copied a track at a time.
0C83 FRMT_COPY LD HL,49152 Address of track buffer.
0C86 LD (#3AC5),HL Store load address.
0C89 LD (#3AC8),HL Store save address.
0C8C LD A,(#3E1A) Fetch source drive number from UFIA2.
0C8F CALL #0705,TEST_DRV1 Check and set drive.
0C92 FRMT_C1 CALL #05CC,RSAD Load a sector.
0C95 PUSH DE Store track and sector number.
0C96 LD HL,#3BD6 DRAM sector buffer address.
0C99 LD DE,(#3AC5) Fetch load address.
0C9D LD BC,512 BC holds sector length.
0CA0 LDIR Copy the contents of the buffer to
'main' RAM.
0CA2 LD (#3AC5),DE Store new load address.
0CA6 POP DE Restore track and sector number.
0CA7 CALL #0D7E,NEXT_SEC Compute next sector number.
0CAA JR NZ,#0C92,FRMT_C1 Jump if there is still a sector on this
track.
0CAC LD A,(#3E01) Fetch destination drive from UFIA1.
0CAF CALL #0705,TEST_DRV1 Check and set drive.
0CB2 FRMT_C2 PUSH DE Store track and sector number.
0CB3 LD HL,(#3AC8) Fetch save address.
0CB6 LD DE,#3BD6 DRAM sector buffer address.
0CB9 LD BC,512 BC holds sector length.
0CBC LDIR Copy a sector to the sector buffer.
0CBE LD (#3AC8),HL Store new save address.
0CC1 POP DE Restore track and sector number.
0CC2 CALL #0584,WSAD Save the sector.
0CC5 CALL #0D7E,NEXT_SEC Compute next sector number.
0CC8 JR NZ,#0CB2,FRMT_C2 Jump if not all sectors on this track
have been written.
0CCA CALL #0CE4,NXT_TRK Compute next track number.
0CCD JR NZ,#0C83,FRMT_COPY Jump if not all tracks have been
copied.
0CCF EI Enable interrupts and exit via
0CD0 JP #06B6,REST 'REST'.
The routine now verifies if all sectors are readable. An error is given if a sector
can't be read, it would have been more usefull if a 'badsectors' file was saved.
0CD3 FRMT_CHK CALL #05CC,RSAD Load a sector.
0CD6 CALL #0D7E,NEXT_SEC Compute next sector number.
0CD9 JR NZ,#0CD3,FRMT_CHK Jump if not all sectors on one track
have been loaded.
0CDB CALL #0CE4,NXT_TRK Compute next track number.
0CDE JR NZ,#0CD3,FRMT_CHK Jump if not all tracks on the disk have
been verified.
0CE0 EI Enable interrupts and exit via
0CE1 JP #06B6,REST 'REST'.
THE 'NXT_TRK' SUBROUTINE
This subroutine is almost the same as the 'NEXT_TRACK' subroutine at #0956. But the
differences are essential. No error is given when a non existent track is reached and the
Zero flag is used to signal 'no more tracks on this side' when set.
0CE4 NXT_TRK INC D Increase track number.
0CE5 CALL #0985,DRV_CAP Get drive capacity in A.
0CE8 CP D
0CE9 RET Z Return with Zero set if last track
reached.
0CEA AND #7F Mask off side bit.
0CEC CP D
0CED RET NZ Return with Zero reset if last track
on side0 hasn't been reached.
0CEE CALL #06B6,REST Reset drive head.
0CF1 LD D,128 Track 0, side 1.
0CF3 CP D Reset Zero flag.
0CF4 RET
THE 'BUILD UP A DD TRACK' SUBROUTINE
This subroutine builds up a double density track in the 'main' memory starting at
address 49152.
0CF5 MK_TRK_DD LD HL,49152 Start of track buffer.
0CF8 LD BC,#3C4E Store 60 bytes #4E. GAP I.
0CFB CALL #0D79,B_TIMES_C
0CFE LD B,10 Number of sectors on a track.
0D00 MK_TRK_DD1 PUSH BC
0D01 LD BC,#0C00 12 bytes #00. Last part of GAP III.
0D04 CALL #0D79,B_TIMES_C
0D07 LD BC,#03F5 3 bytes #F5 (written as #A1).
0D0A CALL #0D79,B_TIMES_C
0D0D LD BC,#01FE 1 byte #FE (ID field ID).
0D10 CALL #0D79,B_TIMES_C
0D13 LD A,D Fetch track number.
0D14 AND #7F Mask side bit.
0D16 LD C,A
0D17 LD B,1 1 byte track number.
0D19 CALL #0D79,B_TIMES_C
0D1C LD A,D Fetch track again.
0D1D AND #80 Keep only side bit.
0D1F RLCA Rotate it to bit 0.
0D20 LD C,A
0D21 LD B,1 1 byte side number.
0D23 CALL #0D79,B_TIMES_C
0D26 LD C,E Fetch sector number.
0D27 CALL #0D7E,NEXT_SEC Increment sector number.
0D2A LD B,1 1 byte sector number.
0D2C CALL #0D79,B_TIMES_C
0D2F LD BC,#0102 1 byte #02 (sector length = 512).
0D32 CALL #0D79,B_TIMES_C
0D35 LD BC,#01F7 1 byte #F7 (two CRC bytes written).
0D38 CALL #0D79,B_TIMES_C
0D3B LD BC,#164E 22 bytes #4E. GAP II.
0D3E CALL #0D79,B_TIMES_C
0D41 LD BC,#0C00 12 bytes #00.
0D44 CALL #0D79,B_TIMES_C
0D47 LD BC,#03F5 3 bytes #F5 (written as #A1).
0D4A CALL #0D79,B_TIMES_C
0D4D LD BC,#01FB 1 byte #FB (data field ID).
0D50 CALL #0D79,B_TIMES_C
0D53 LD BC,#0000 512 bytes #00. Data bytes.
0D56 CALL #0D79,B_TIMES_C
0D59 CALL #0D79,B_TIMES_C
0D5C LD BC,#01F7 1 byte #F7 (two CRC bytes written).
0D5F CALL #0D79,B_TIMES_C
0D62 LD BC,#184E 24 bytes #4E. First part of GAP III.
0D65 CALL #0D79,B_TIMES_C
0D68 POP BC Retrieve sector counter.
0D69 DEC B Repeat until all 10 sectors have been
0D6A JP NZ,#0D00,MK_TRK_DD1 build up.
0D6D LD BC,#004E 768 bytes #00. GAP IV.
0D70 CALL #0D79,B_TIMES_C
0D73 CALL #0D79,B_TIMES_C
0D76 JP #0D79,B_TIMES_C
THE 'STORE B TIMES BYTE C' SUBROUTINE
This subroutine is used in the construction of a track in memory, it stores the byte
held in the C register, B times.
0D79 B_TIMES_C LD (HL),C Store C.
0D7A INC HL Next address.
0D7B DJNZ #0D79,B_TIMES_C Repeat until B=0.
0D7D RET
THE 'NEXT SECTOR' SUBROUTINE
This subroutine computes the next sector number in E, it returns with the Zero flag set
indicating 'next track'.
0D7E NEXT_SEC INC E Increment sector number.
0D7F LD A,E
0D80 CP 11
0D82 RET NZ Return with Zero reset signalling
'same track'.
0D83 LD E,1 Otherwise start with sector 1 again.
0D85 RET Return with Zero set signalling 'next
track'.
THE 'MAKE HL POINT TO BUFFER' SUBROUTINE
This subroutine returns with HL holding the start of the data buffer. On entry IX must
point to the start of the disk channel.
0D86 HL_BUFFER PUSH BC
0D87 PUSH IX Disk channel pointer to BC.
0D89 POP BC
0D8A LD L,(IX+15) Fetch data buffer offset.
0D8D LD H,(IX+16)
0D90 ADD HL,BC HL now points to the data buffer.
0D91 POP BC
0D92 RET
THE 'FETCH RPT INTO HL' SUBROUTINE
This subroutine returns with HL holding the RAM PoinTer, which points to the next data
byte in the data buffer. When entering at #0D97, RPT-lo is first reset.
0D93 RPT_HL LD (IX+13),0 Reset RPT-lo.
0D97 RPT_HL1 CALL #0D86,HL_BUFFER HL points to the data buffer.
0D9A LD B,(IX+14) Fetch RPT offset into BC.
0D9D LD C,(IX+13)
0DA0 ADD HL,BC Add the offset to the start of the
data buffer.
0DA1 RET Finished.
THE 'INCREMENT RPT' SUBROUTINE
This small subroutine increments the RAM PoinTer offset.
0DA2 INC_RPT INC (IX+13) Increment RPT-lo.
0DA5 RET NZ
0DA6 INC (IX+14) Increment RPT-hi when necessary.
0DA9 RET
THE 'RESET RPT' SUBROUTINE
This small subroutine resets the RAM PoinTer offset.
0DAA RES_RPT LD (IX+13),0 Clear RPT offset.
0DAE LD (IX+14),0
0DB2 RET
THE 'FETCH SECTOR ADDRESS' SUBROUTINE
This subroutine returns with DE holding the stored track and sector number.
0DB3 FETCH_SEC LD D,(IX+18)
0DB6 LD E,(IX+17)
0DB9 RET
THE 'STORE SECTOR ADDRESS' SUBROUTINE
This subroutine stores the track and sector number held in DE into the disk channel.
0DBA STORE_SEC LD (IX+18),D
0DBD LD (IX+17),E
0DC0 RET
THE 'GET SECTOR ADDRESS' SUBROUTINE
This subroutine returns with DE holding the stored track and sector number and the track
and sector number held in HL stored into the disk channel.
0DC1 GET_SECTOR CALL #0DB3,FETCH_SEC Fetch the stored track and sector
0DC4 LD (IX+18),H number. And store the track and sector
0DC7 LD (IX+17),L number held in HL.
0DCA RET
THE 'STEP' SUBROUTINES
These two small subroutines are used to move the drive head one step in or out.
0DCB STEP_OUT LD C,%01111000 Step-out, update track register,
0DCD JR STEP disable spin-up sequence, no verify,
step rate 6 ms.
0DCF STEP_IN LD C,%01011000 Step-in, update track register,
disable spin-up sequence, no verify,
step rate 6 ms.
0DD1 STEP CALL #06F7,LD_COM_REG Execute the command, move one track.
0DD4 JP #0692,STEP_DELAY Wait for the number of msec's
specified by (STPRAT).