Previous Next Contents Index
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).

Previous Next Contents Index