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

32DE MK_ALLOC   PUSH HL
32DF            PUSH BC
32E0            LD   HL,#1A00            Address where disk bitmap is located.
32E3            LD   DE,#0401            Start with track 4, sector 1.
32E6            LD   C,0                 Clear bitmap offset.
32E8 MK_ALLOC1  LD   A,(HL)
32E9            CP   #FF
32EB            JR   NZ,#32FF,MK_ALLOC3  Jump if there is a free sector here.
32ED            LD   A,E                 Otherwise update sector number.
32EE            ADD  A,8                 Each byte holds 8 sectors.
32F0            LD   E,A
32F1            SUB  10                  But each track holds 10.
32F3            JR   C,#32FB,MK_ALLOC2   Jump if still on the same track, i.e.
32F5            JR   Z,#32FB,MK_ALLOC2   with sectors <=9 and 10.
32F7            LD   E,A                 Otherwise the next sector has been
32F8            CALL #330F,NEXT_TRACK    computed, next track is computed now.
32FB MK_ALLOC2  INC  C                   Increase bitmap offset.
32FC            INC  HL                  Next byte of bitmap.
32FD            JR   #32E8,MK_ALLOC1     Find a free sector.

Now the routine continues to find which sector is free.

32FF MK_ALLOC3  LD   B,1                 Reset bit pointer.
3301 MK_ALLOC4  LD   A,(HL)
3302            AND  B
3303            JR   Z,#331E,MK_ALLOC5   Jump if free sector has been found.
3305            CALL #37BB,NEXT_SEC      Increase sector number.
3308            CALL Z,#330F,NEXT_TRACK  Next track if sector is on it.
330B            RLC  B                   Test next sector.
330D            JR   #3301,MK_ALLOC4

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.

330F NEXT_TRACK INC  D                   Increase track.
3310            CALL #333B,DRV_CAP       Get number of tracks on current drive
                                         in the A register.
3313            CP   D                   Give error if drive capacity is
3314            JP   Z,#2950,REP_24      exceeded.
3317            AND  #7F                 Mask off side bit.
3319            CP   D
331A            RET  NZ                  Return if side 0 isn't full.
331B            LD   D,128               Otherwise return with track 0, side 1.
331D            RET

THE 'ALLOCATE SECTOR' ROUTINE CONTINUED
Now the 'ALLOCATE SECTOR' routine continues by unfreeing the found sector.

331E MK_ALLOC5  LD   A,(HL)              Make found sector unfree in disk
331F            OR   B                   bitmap.
3320            LD   (HL),A
3321            LD   A,B
3322            LD   B,0
3324            PUSH IX
3326            ADD  IX,BC               Add bitmap offset.
3328            OR   (IX+34)             Set new sector in file bitmap.
332B            LD   (IX+34),A
332E            POP  IX                  Restore disk channel pointer.
3330            INC  (IX+31)             Increment number of sectors used.
3333            JR   NZ,#3338,MK_ALLOC6
3335            INC  (IX+30)
3338 MK_ALLOC6  POP  BC
3339            POP  HL
333A            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.

333B DRV_CAP    PUSH HL
333C            LD   HL,#0299            This is TRAKS1, drive 1's capacity.
333F            LD   A,(#1DDA)           Fetch current control port state.
3342            BIT  0,A
3344            JR   NZ,#3347,DRV_CAP1   Jump if drive 1 selected.
3346            INC  HL                  Otherwise point to TRAKS2.
3347 DRV_CAP1   LD   A,(HL)              Fetch drive capacity.
3348            POP  HL
3349            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.

334A PRT_NAME   LD   (IX+13),1           Point to the first character of the
                                         name.
334E            CALL #37D4,RPT_HL1       Make HL point to it.
3351            LD   B,10                A name has 10 characters.
3353 PRT_NAME1  LD   A,(HL)              Fetch a character.
3354            CALL #3C2C,PRT_A         Print it.
3357            INC  HL
3358            DJNZ #3353,PRT_NAME1     Repeat for all 10 characters.
335A            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.

335B SCAN_CAT   LD   IX,#1AC3            IX points to the disk channel.
335F            LD   (IX+4),A            Store scan-type.
3362            XOR  A                   Clear column counter.
3363            LD   (#1DEB),A
3366            CALL #302C,TRACK_0       Reset drive head to track 0, DE = 1.
3369 EACH_ENTRY CALL #2F4F,RSAD          Load a CATalogue sector.
336C EACH_E1    CALL #37D0,RPT_HL        HL points to the start of data buffer.
336F            LD   A,(HL)              Fetch file type.
3370            AND  A                   Jump if it's an unused entry (could be
3371            JP   Z,#3464,SCAN_FREE   ERASEd).
3374            BIT  0,(IX+4)
3378            JR   Z,#3386,NO_PRGNUM   Jump if not searching for a filenumber.
337A            CALL #30D6,PROG_NUM      Otherwise load program number into A.
337D            LD   B,A
337E            LD   A,(#1E02)           Fetch specified program number.
3381            CP   B
3382            RET  Z                   Exit if they are equal.
3383            JP   #343E,SCAN_NEXT     Otherwise continue scanning.

NOTE: All entries with numbers below the specified one are considered, this isn't
really needed.

3386 NO_PRGNUM  BIT  1,(IX+4)            Jump if a short CATalogue should be
338A            JR   NZ,#3392,PRINT_CAT  printed.
338C            BIT  2,(IX+4)
3390            JR   Z,#340B,NO_CAT      Jump if no CATalogue is desired.
3392 PRINT_CAT  LD   (IX+13),11          RPT points to number of sectors used.
3396            CALL #37D4,RPT_HL1       Make HL hold RPT.
3399            LD   B,(HL)              Fetch number of sectors used.
339A            INC  HL
339B            LD   C,(HL)
339C            LD   (#1AC3),BC          Store it for printing.
33A0            LD   HL,(#1DD8)          Add it to total number of sectors used.
33A3            ADD  HL,BC
33A4            LD   (#1DD8),HL
33A7            BIT  7,A
33A9            JP   NZ,#343E,SCAN_NEXT  Jump if this entry is hidden.
33AC            CALL #346D,MATCH_NAME
33AF            JP   NZ,#343E,SCAN_NEXT  Jump if filename doesn't match.
33B2            BIT  1,(IX+4)
33B6            JR   NZ,#33C8,SCAN_1     Jump with short CAT.
33B8            CALL #30D6,PROG_NUM      Calculate program number.
33BB            PUSH DE
33BC            LD   H,0                 Program number to HL.
33BE            LD   L,A
33BF            LD   A,32                Use leading spaces.
33C1            CALL #3BEB,PRT_N10       Print the program number.
33C4            POP  DE                  Restore sector address.
33C5            CALL #3C2A,PRT_SPACE     Print a space.
33C8 SCAN_1     CALL #334A,PRT_NAME      Print filename.
33CB            BIT  1,(IX+4)
33CF            JR   Z,#33F5,EXT_CAT     Jump with extended CAT.
33D1            LD   B,3                 Otherwise print three columns wide.
33D3            LD   A,(#1E03)           Except when using stream 3.
33D6            CP   3
33D8            JR   NZ,#33DC,SCAN_2
33DA            SLA  B                   Then print six columns wide.
33DC SCAN_2     LD   A,(#1DEB)           Increment column counter.
33DF            INC  A
33E0            CP   B
33E1            JR   Z,#33EA,SCAN_3      Jump if last column reached.
33E3            LD   (#1DEB),A           Otherwise store column counter and
33E6            LD   A,32                separate the columns with a SPACE.
33E8            JR   #33F0,SCAN_4

This line is full, the next entry will be printed on the next line.

33EA SCAN_3     XOR  A                   Clear column counter.
33EB            LD   (#1DEB),A
33EE            LD   A,13                Print a NEWLINE.
33F0 SCAN_4     CALL #3C2C,PRT_A
33F3            JR   #343E,SCAN_NEXT     Continue with the next entry.

With an extended CAT there has to be printed somewhat more.

33F5 EXT_CAT    PUSH DE                  Store track and sector number.
33F6            LD   HL,(#1AC3)          Fetch length of file in sectors.
33F9            LD   A,32                Print it with leading spaces.
33FB            CALL #3BE5,PRT_N100
33FE            CALL #3C2A,PRT_SPACE     Print a trailing space.
3401            CALL #37D0,RPT_HL        HL points to the start of the entry.
3404            LD   A,(HL)              Fetch file type
3405            CALL #3B2E,PRT_TYPE      and print it.
3408            POP  DE                  Restore track and sector number.
3409            JR   #343E,SCAN_NEXT     Continue with the next entry.

Now the routine continues with the search part.

340B NO_CAT     BIT  3,(IX+4)
340F            JR   NZ,#3417,SCAN_NAME  Jump if searching for name and type.
3411            BIT  4,(IX+4)
3415            JR   Z,#341B,SCAN_5      Jump if not searching for name alone.
3417 SCAN_NAME  CALL #346D,MATCH_NAME    Return with Zero flag set to signal
341A            RET  Z                   'matching name (and type) found'.
341B SCAN_5     BIT  5,(IX+4)
341F            JR   Z,#343E,SCAN_NEXT   Jump if no disk map wanted.

This part of the routine builds up the bitmap.

3421            PUSH IX
3423            LD   (IX+13),15          RPT points to the start of file bitmap.
3427            CALL #37D4,RPT_HL1       Make HL hold RPT.
342A            LD   IX,#1A00            Start of disk bitmap.
342E            LD   B,195               There are 1560 bits in the bitmap.
3430 SCAN_MAP   LD   A,(IX+0)            Fetch a disk map byte.
3433            OR   (HL)                Incorporate the corresponding file map
3434            LD   (IX+0),A            byte.
3437            INC  IX                  Point to the next map bytes.
3439            INC  HL
343A            DJNZ #3430,SCAN_MAP      Repeat for all map bytes.
343C            POP  IX                  Restore disk channel pointer.

Another entry has been handled, go on with the next.

343E SCAN_NEXT  LD   A,(IX+14)           Fetch RPT-hi.
3441            CP   1
3443            JR   Z,#3455,SCAN_6      Jump if the second entry has been handled.
3445            LD   A,(#1DDA)           Fetch current control port state.
3448            AND  #04
344A            JR   NZ,#3455,SCAN_6     Jump if using single density.
344C            CALL #37E7,RES_RPT       Reset RPT.
344F            INC  (IX+14)             Point to the second entry.
3452            JP   #336C,EACH_E1       Repeat for this entry.

The next CAT sector has to be retrieved (if there is one).

3455 SCAN_6     CALL #37BB,NEXT_SEC      Calculate next sector.
3458            JP   NZ,#3369,EACH_ENTRY Jump if on same track.
345B            INC  D                   Otherwise next track.
345C            LD   A,D
345D            CP   4
345F            JP   NZ,#3369,EACH_ENTRY Jump if still a CATalogue track.
3462            AND  A                   Otherwise signal 'unsuccessfull' and
3463            RET                      exit.

An unused entry was found, so if we are searching for one then exit else continue.

3464 SCAN_FREE  LD   A,(IX+4)            Fetch scan-type.
3467            CPL                      Invert all bits.
3468            BIT  6,A
346A            RET  Z                   Return if searching for a free entry.
346B            JR   #343E,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.

346D MATCH_NAME PUSH IX                  Store disk channel pointer.
346F            CALL #37D0,RPT_HL        HL points to the start of the entry.
3472            LD   B,11                Length of file description.
3474            BIT  3,(IX+4)
3478            LD   IX,#1E05            IX points to the file description in
                                         UFIA1.
347C            JR   Z,#348E,MATCH_N2    Jump if directory description doesn't need
                                         to match.
347E MATCH_N1   LD   A,(IX+0)            Fetch character of search string.
3481            CP   "*"                 Jump if it's a '*', then all other
3483            JR   Z,#3493,MATCH_N3    characters don't matter.
3485            CP   "?"                 Jump if it's a '?', then this character
3487            JR   Z,#348E,MATCH_N2    doesn't matter.
3489            XOR  (HL)                Compare with entries character.
348A            AND  #DF                 Capitalize.
348C            JR   NZ,#3493,MATCH_N3   Jump if they don't match.
348E MATCH_N2   INC  IX                  Next character.
3490            INC  HL
3491            DJNZ #347E,MATCH_N1      Repeat for all characters.
3493 MATCH_N3   POP  IX                  Restore disk channel pointer.
3495            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'.

3496 OFSM_2     PUSH IX                  Store disk channel pointer.
3498            LD   A,(#1DEF)           This is (MAPUSED), the (in)famous
                                         @6999. It holds the number of files
                                         which are using the disk bitmap.
349B            CP   0
349D            LD   A,16                Scan catalogue for specified filename.
349F            JR   NZ,#34AD,OFSM_SCAN  Jump if (@6999)<>0, the disk bitmap
                                         isn't to be rebuild.
34A1            LD   HL,#1A00            Otherwise clear the disk bitmap.
34A4            LD   B,195
34A6 OFSM_CLR   LD   (HL),0
34A8            INC  HL
34A9            DJNZ #34A6,OFSM_CLR
34AB            LD   A,48                Scan catalogue for specified filename
                                         and produce a disk bitmap.
34AD OFSM_SCAN  CALL #335B,SCAN_CAT
34B0            JR   NZ,#34D9,OFSM_FREE  Jump if filename not used.
34B2            PUSH DE                  Otherwise store sector address.
34B3            RST  #10,CALBAS          Clear the lower part of the screen by
34B4            DEFW #0D6E,CLS_LOWER     calling 'CLS_LOWER' in 'main' ROM.
34B6            SET  5,(IY+2)            Signal 'lower screen has to be
                                         cleared'. (TV_FLAG)
34BA            CALL #3C8D,MESG_1        Print 'OVERWRITE' message.
34BD            CALL #334A,PRT_NAME      Print filename.
34C0            CALL #3CB2,MESG_3        Print 'Y/N' message.
34C3            CALL #3513,TEST_Y        Test the 'Y' key.
34C6            JR   Z,#34CC,OFSM_ERASE  Jump if 'Y' was pressed.
34C8            POP  DE                  When any other key was pressed the
34C9            POP  IX                  routine returns with Zero reset to
34CB            RET                      signal 'unsuccessfull'.

The filename existed already, the user wants it to be overwritten, so ERASE it.

34CC OFSM_ERASE POP  DE                  Restore track and sector number.
34CD            CALL #37D0,RPT_HL        Make HL point to the entry to be
                                         overwritten.
34D0            LD   (HL),0              ERASE this file.
34D2            CALL #2F04,WSAD          Write the entry back to disk.
34D5            POP  IX                  Restore disk channel pointer.
34D7            JR   #3496,OFSM_2        Retry opening the file.

The filename wasn't used so now the file can be opened.

34D9 OFSM_FREE  POP  IX                  Restore disk channel pointer.
34DB            PUSH IX
34DD            LD   B,0                 Clear the file entry space in the disk
34DF OFSM_CLR1  LD   (IX+19),0           channel.
34E3            INC  IX
34E5            DJNZ #34DF,OFSM_CLR1
34E7            POP  IX                  Restore disk channel pointer.
34E9            PUSH IX
34EB            LD   HL,#1E05            HL points to the file descriptor in
                                         UFIA1.
34EE            LD   B,11                Length of file descriptor.
34F0 OFSM_FDESC LD   A,(HL)              Copy file descriptor to the file entry
34F1            LD   (IX+19),A           space in the disk channel.
34F4            INC  HL
34F5            INC  IX
34F7            DJNZ #34F0,OFSM_FDESC
34F9            POP  IX                  Restore disk channel pointer.
34FB            CALL #32DE,MK_ALLOC      Allocate a sector.
34FE            CALL #37F7,STORE_SEC     Store its track and sector number.
3501            LD   (IX+32),D           Store its sector address also into the
3504            LD   (IX+33),E           file entry space.
3507            CALL #37E7,RES_RPT       Reset RPT.
350A            LD   A,(#1DEF)           Increment (MAPUSED), there is one more
350D            INC  A                   file which uses the disk bitmap.
350E            LD   (#1DEF),A
3511            XOR  A                   Return with Zero flag set to signal
3512            RET                      'successfull'.

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.

3513 TEST_Y     CALL #3528,DISC_BEEP     Produce a 'middle C' for one second.
3516 TEST_Y1    RST  #10,CALBAS          The 'main' ROM is called to scan the
3517            DEFW #028E,KEY_SCAN      keyboard.
3519            RST  #10,CALBAS          It is also called to determine if a key
351A            DEFW #031E,KEY_TEST      was pressed.
351C            JR   NC,#3516,TEST_Y1    Repeat scanning and testing until a key
                                         has been pressed.
351E            AND  #DF                 Capitalize.
3520            CP   "Y"                 Set the Zero flag if it was the
3522            PUSH AF                  'Y'-key.
3523            RST  #10,CALBAS          Again the 'main' ROM is called, this
3524            DEFW #0D6E,CLS_LOWER     time for clearing the lower screen.
3526            POP  AF                  Retrieve Zero flag.
3527            RET                      Finished.

THE 'MAKE A BEEP' SUBROUTINE
This subroutine produces a beep (the note 'middle C' in fact) for one second.

3528 DISC_BEEP  PUSH HL
3529            PUSH DE
352A            PUSH BC
352B            PUSH IX
352D            LD   HL,1642             Parameters needed by 'BEEPER' to
3530            LD   DE,261              produce a 'middle C'.
3533            RST  #10,CALBAS          Produce the note.
3534            DEFW #03B5,BEEPER
3536            POP  IX
3538            POP  BC
3539            POP  DE
353A            POP  HL
353B            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.

353C CFSM       CALL #37D4,RPT_HL1       HL points to the first unused position
                                         in the data buffer.
353F            LD   A,C                 C holds buffer offset-lo.
3540            AND  A
3541            JR   NZ,#354F,CFSM_FILL  Jump if buffer isn't full yet.
3543            LD   A,(#1DDA)           Fetch current control port state.
3546            AND  #04
3548            JR   NZ,#3556,CFSM_SAVE  Jump if using single density.
354A            LD   A,B                 B holds buffer offset-hi.
354B            CP   2
354D            JR   Z,#3556,CFSM_SAVE   Jump if buffer is full.
354F CFSM_FILL  LD   (HL),0              Otherwise fill up buffer with zero's.
3551            CALL #37DF,INC_RPT       Increment RPT.
3554            JR   #353C,CFSM          And close the file.

The last sector is ready to be saved, it has been filled up with zero's if needed.

3556 CFSM_SAVE  CALL #37F0,FETCH_SEC     Fetch last sector's track and sector
3559            CALL #2F04,WSAD          number and save it to disk.
355C            LD   A,(#1DEF)           Decrease (MAPUSED), the number of files
355F            DEC  A                   using the disk bitmap.
3560            LD   (#1DEF),A
3563            PUSH IX                  Store disk channel pointer.
3565            LD   A,64                Search the CATalogue for an unused
3567            CALL #335B,SCAN_CAT      entry.
356A            JP   NZ,#2952,REP_25     If none found report 'Directory FULL'.
356D            CALL #37D0,RPT_HL        HL points to the entry.
3570            LD   (#1ACA),IX          Store disk channel pointer 2, this one
                                         points to the DFCA.
3574            POP  IX                  Restore disk channel pointer 1, this
                                         one can point to 'main' RAM (OPENTYPE).
3576            PUSH IX                  Store it again.
3578            LD   B,0                 Copy the file entry to the  CAT entry in
357A CFSM_ENTRY LD   A,(IX+19)           the data buffer.
357D            LD   (HL),A
357E            INC  IX
3580            INC  HL
3581            DJNZ #357A,CFSM_ENTRY
3583            LD   IX,(#1ACA)          Restore disk channel pointer 2.
3587            CALL #2F04,WSAD          Write the sector to disk.
358A            POP  IX                  Restore disk channel pointer 1.
358C            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.

358D HGFLE_2    LD   A,(#1E04)           Fetch device description from UFIA1.
3590            AND  #DF                 Capitalize.
3592            CP   "P"
3594            JR   NZ,#35BA,HGFL_NONUM Jump if no program number specified.
3596            LD   A,1                 Search for the specified program
3598            CALL #335B,SCAN_CAT      number.
359B            JP   NZ,#2954,REP_26     If file isn't found report 'File NOT
                                         FOUND'.
359E            CALL #37D0,RPT_HL        HL points to the entry.
35A1            LD   DE,#1E05            Copy the 11 byte file descriptor to
35A4            LD   BC,11               UFIA1.
35A7            LDIR
35A9            LD   (IX+13),211         RPT points to the file header of the
                                         file.
35AD            CALL #37D4,RPT_HL1       Make HL point to it.
35B0            LD   DE,#1E10            Copy the 9 byte file header to UFIA1.
35B3            LD   BC,9
35B6            LDIR
35B8            JR   #35C2,LOAD_1ST      Jump forward to load the first sector.

Now search for the file with the given name.

35BA HGFL_NONUM LD   A,16                Search for the specified filename.
35BC            CALL #335B,SCAN_CAT      If file isn't found report 'File NOT
35BF            JP   NZ,#2954,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.

35C2 LOAD_1ST   CALL #37D0,RPT_HL        HL points to the entry.
35C5            LD   DE,#1E1E            Copy the 11 byte file descriptor to
35C8            LD   BC,11               UFIA2.
35CB            LDIR
35CD            LD   (IX+13),220         RPT points to the SNAPSHOT registers,
                                         that is when they are present.
35D1            CALL #37D4,RPT_HL1       Make HL point to it.
35D4            LD   DE,#1FEA            Copy the 22 SNAPSHOT values to the
35D7            LD   BC,22               internal stack bottom.
35DA            LDIR
35DC            LD   (IX+13),13          RPT points to track and sector number.
35E0            CALL #37D4,RPT_HL1       Now HL points to it also.
35E3            LD   D,(HL)              Fetch track and sector number.
35E4            INC  HL
35E5            LD   E,(HL)
35E6            JP   #2F4F,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.

35E9 FRMT_RUN   CALL #3030,REST          Reset drive head, DE = 1.
35EC            LD   IX,#1AC3            IX points to the DFCA.
35F0 FRMT_TRACK LD   A,(#1DDA)           Fetch current control port state.
35F3            AND  #04
35F5            JR   Z,#35FC,FRMT_DD     Jump if using double density.
35F7            CALL #3744,MK_TRK_SD     Build up a single density track in
35FA            JR   #35FF,FRMT_ING      'main' memory and start formatting.

35FC FRMT_DD    CALL #36C0,MK_TRK_DD     Build up a double density track.
35FF FRMT_ING   CALL #3099,TEST_DRV      See if the drive is defined.
3602            LD   C,%11111000         Write track, disable spin-up sequence,
                                         no delay, enable precompensation.
3604            CALL #2EE7,PRECOMP       Why call this routine ? The precomp.
                                         has already been enabled.
3607            LD   HL,49152            HL points to the track build up in
                                         'main' memory.
360A            CALL #2F1F,WR_OP         Write the track.
360D            INC  D                   Next track.
360E            CALL #333B,DRV_CAP       Get drive capacity in A.
3611            CP   D
3612            JR   Z,#3639,FRMT_DONE   Jump if all tracks have been formatted.
3614            AND  #7F                 Mask off side.
3616            CP   D
3617            JR   Z,#362E,FRMT_SIDE1  Jump if side1 hasn't been formatted.
3619            LD   C,%01011000         Step-in, update track register, disable
                                         spinup, no verify, step rate 6 msec.
361B            CALL #3085,LD_COM_REG    Execute the command.
361E            CALL #2FE6,STEP_DELAY    Wait for the step delay.

The following code determines the skew, i.e. the shifting between the sectors of a
track and the previous track. The DISCiPLE uses a skew of +2, so sector 1 on track T
lies adjacent to sector 9 on track T+1.

3621            DEC  E
3622            JR   NZ,#3626,FRMT_1     Jump if sector >= 1.
3624            LD   E,10                Sector numbers have range 1..10.
3626 FRMT_1     DEC  E
3627            JR   NZ,#362B,FRMT_2     Jump if sector >= 1.
3629            LD   E,10                This instruction is never reached ??
362B FRMT_2     JP   #35F0,FRMT_TRACK    Format the next track.

If a double sided drive is used, the formatting continues on track 0 side 1.

362E FRMT_SIDE1 CALL #3030,REST          Reset drive head.
3631            LD   D,128               Track 0, side 1.
3633            CALL #30B3,SET_DRVSD     Set drive, side, density, etc.
3636            JP   #35F0,FRMT_TRACK    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.

3639 FRMT_DONE  CALL #302C,TRACK_0       Reset drive head.
363C            LD   A,(#1E1A)
363F            CP   255
3641            JR   Z,#3692,FRMT_CHECK  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.

3643 FRMT_COPY  LD   HL,49152            Address of track buffer.
3646            LD   (#1AC5),HL          Store load address.
3649            LD   (#1AC8),HL          Store save address.
364C            LD   A,(#1E1A)           Fetch source drive number from UFIA2.
364F            CALL #309C,TEST_DRV1     Check and set drive.
3652 FRMT_READ  CALL #2F4F,RSAD          Load a sector.
3655            PUSH DE                  Store track and sector number.
3656            LD   HL,#1BD6            DRAM sector buffer address.
3659            LD   DE,(#1AC5)          Fetch load address.
365D            CALL #36B3,GET_SECLEN    BC holds sector length.
3660            LDIR                     Copy the contents of the buffer to
                                         'main' RAM.
3662            LD   (#1AC5),DE          Store new load address.
3666            POP  DE                  Restore track and sector number.
3667            CALL #37BB,NEXT_SEC      Compute next sector number.
366A            JR   NZ,#3652,FRMT_READ  Jump if there is still a sector on this
                                         track.
366C            LD   A,(#1E01)           Fetch destination drive from UFIA1.
366F            CALL #309C,TEST_DRV1     Check and set drive.
3672 FRMT_WRITE PUSH DE                  Store track and sector number.
3673            LD   HL,(#1AC8)          Fetch save address.
3676            LD   DE,#1BD6            DRAM sector buffer address.
3679            CALL #36B3,GET_SECLEN    BC holds sector length.
367C            LDIR                     Copy a sector to the sector buffer.
367E            LD   (#1AC8),HL          Store new save address.
3681            POP  DE                  Restore track and sector number.
3682            CALL #2F04,WSAD          Save the sector.
3685            CALL #37BB,NEXT_SEC      Compute next sector number.
3688            JR   NZ,#3672,FRMT_WRITE Jump if not all sectors on this track
                                         have been written.
368A            CALL #36A2,NXT_TRK       Compute next track number.
368D            JR   NZ,#3643,FRMT_COPY  Jump if not all tracks have been
                                         copied.
368F            JP   #302C,TRACK_0       Otherwise exit via 'TRACK_0'.

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.

3692 FRMT_CHECK CALL #2F4F,RSAD          Load a sector.
3695            CALL #37BB,NEXT_SEC      Compute next sector number.
3698            JR   NZ,#3692,FRMT_CHECK Jump if not all sectors on one track
                                         have been loaded.
369A            CALL #36A2,NXT_TRK       Compute next track number.
369D            JR   NZ,#3692,FRMT_CHECK Jump if not all tracks on the disk have
                                         been verified.
369F            JP   #302C,TRACK_0       Exit via 'TRACK_0'.

THE 'NXT_TRK' SUBROUTINE
This subroutine is almost the same as the 'NEXT_TRACK' subroutine at #330F. 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.

36A2 NXT_TRK    INC  D                   Increase track number.
36A3            CALL #333B,DRV_CAP       Get drive capacity in A.
36A6            CP   D
36A7            RET  Z                   Return with Zero set if last track
                                         reached.
36A8            AND  #7F                 Mask off side bit.
36AA            CP   D
36AB            RET  NZ                  Return with Zero reset if last track on
                                         side0 hasn't been reached.
36AC            CALL #302C,TRACK_0       Reset drive head.
36AF            LD   D,128               Track 0, side 1.
36B1            CP   D                   Reset Zero flag.
36B2            RET

THE 'GET SECTOR LENGTH' SUBROUTINE
This subroutine returns with BC holding the sector length in bytes. With double
density this is 512, with single density 256.

36B3 GET_SECLEN LD   BC,512              Length of a DD sector.
36B6            LD   A,(#1DDA)
36B9            AND  #04
36BB            RET  Z                   Return if using double density.
36BC            LD   BC,256              Length of a SD sector.
36BF            RET

THE 'BUILD UP A DD TRACK' SUBROUTINE
This subroutine builds up a double density track in the 'main' memory starting at
address 49152.

36C0 MK_TRK_DD  LD   HL,49152            Start of track buffer.
36C3            LD   BC,#3C4E            Store 60 bytes #4E. GAP I.
36C6            CALL #37B6,B_TIMES_C
36C9            LD   B,10                Number of sectors on a track.
36CB MK_TRK_DD1 PUSH BC
36CC            LD   BC,#0C00             12 bytes #00. Last part of GAP III.
36CF            CALL #37B6,B_TIMES_C
36D2            LD   BC,#03F5              3 bytes #F5 (written as #A1).
36D5            CALL #37B6,B_TIMES_C
36D8            LD   BC,#01FE              1 byte  #FE (ID field ID).
36DB            CALL #37B6,B_TIMES_C
36DE            LD   A,D                 Fetch track number.
36DF            AND  #7F                 Mask side bit.
36E1            LD   C,A
36E2            LD   B,1                   1 byte  track number.
36E4            CALL #37B6,B_TIMES_C
36E7            LD   A,D                 Fetch track again.
36E8            AND  #80                 Keep only side bit.
36EA            RLCA                     Rotate it to bit 0.
36EB            LD   C,A
36EC            LD   B,1                   1 byte  side number.
36EE            CALL #37B6,B_TIMES_C
36F1            LD   C,E                 Fetch sector number.
36F2            CALL #37BB,NEXT_SEC      Increment sector number.
36F5            LD   B,1                   1 byte  sector number.
36F7            CALL #37B6,B_TIMES_C
36FA            LD   BC,#0102              1 byte  #02 (sector length = 512).
36FD            CALL #37B6,B_TIMES_C
3700            LD   BC,#01F7              1 byte  #F7 (two CRC bytes written).
3703            CALL #37B6,B_TIMES_C
3706            LD   BC,#164E             22 bytes #4E. GAP II.
3709            CALL #37B6,B_TIMES_C
370C            LD   BC,#0C00             12 bytes #00.
370F            CALL #37B6,B_TIMES_C
3712            LD   BC,#03F5              3 bytes #F5 (written as #A1).
3715            CALL #37B6,B_TIMES_C
3718            LD   BC,#01FB              1 byte  #FB (data field ID).
371B            CALL #37B6,B_TIMES_C
371E            LD   BC,#0000            512 bytes #00. Data bytes.
3721            CALL #37B6,B_TIMES_C
3724            CALL #37B6,B_TIMES_C
3727            LD   BC,#01F7              1 byte  #F7 (two CRC bytes written).
372A            CALL #37B6,B_TIMES_C
372D            LD   BC,#184E             24 bytes #4E. First part of GAP III.
3730            CALL #37B6,B_TIMES_C
3733            POP  BC                  Retrieve sector counter.
3734            DEC  B                   Repeat until all 10 sectors have been
3735            JP   NZ,#36CB,MK_TRK_DD1 build up.
3738            LD   BC,#004E            768 bytes #00. GAP IV.
373B            CALL #37B6,B_TIMES_C
373E            CALL #37B6,B_TIMES_C
3741            JP   #37B6,B_TIMES_C

THE 'BUILD UP A SD TRACK' SUBROUTINE
This subroutine builds up a single density track in the 'main' memory starting at
address 49152.

3744 MK_TRK_SD  LD   HL,49152            Start of track buffer.
3747            LD   BC,#28FF            Store 40 bytes #FF. GAP I.
374A            CALL #37B6,B_TIMES_C
374D            LD   B,10                There are 10 sectors on a track.
374F MK_TRK_SD1 PUSH BC
3750            LD   BC,#0600              6 bytes #00. Last part of GAP III.
3753            CALL #37B6,B_TIMES_C
3756            LD   BC,#01FE              1 byte  #FE (ID field ID).
3759            CALL #37B6,B_TIMES_C
375C            LD   A,D                 Fetch track number.
375D            AND  #7F                 Drop side bit.
375F            LD   C,A
3760            LD   B,1                   1 byte  track number.
3762            CALL #37B6,B_TIMES_C
3765            LD   A,D                 Fetch track number again.
3766            AND  #80                 Keep only side bit.
3768            RLCA                     Rotate it to bit 0.
3769            LD   C,A
376A            LD   B,1                   1 byte  side number.
376C            CALL #37B6,B_TIMES_C
376F            LD   C,E                 Fetch sector number.
3770            CALL #37BB,NEXT_SEC      Compute next sector.
3773            LD   B,1                   1 byte  sector number.
3775            CALL #37B6,B_TIMES_C
3778            LD   BC,#0101              1 byte  #01 (sector length = 256).
377B            CALL #37B6,B_TIMES_C
377E            LD   BC,#01F7              1 byte  #F7 (two CRC bytes written).
3781            CALL #37B6,B_TIMES_C
3784            LD   BC,#0BFF             11 bytes #FF. GAP II.
3787            CALL #37B6,B_TIMES_C
378A            LD   BC,#0600              6 bytes #00.
378D            CALL #37B6,B_TIMES_C
3790            LD   BC,#01FB              1 byte  #FB (data field ID).
3793            CALL #37B6,B_TIMES_C
3796            LD   BC,#0000            256 bytes #00. Data bytes.
3799            CALL #37B6,B_TIMES_C
379C            LD   BC,#01F7              1 byte  #F7 (two CRC bytes written).
379F            CALL #37B6,B_TIMES_C
37A2            LD   BC,#0AFF             10 bytes #FF. First part of GAP III.
37A5            CALL #37B6,B_TIMES_C
37A8            POP  BC                  Retrieve sector counter.
37A9            DEC  B                   Repeat until all 10 sectors have been
37AA            JP   NZ,#374FMK_TRK_SD1  build up.
37AD            LD   BC,#00FF            512 bytes #FF. Gap IV.
37B0            CALL #37B6,B_TIMES_C
37B3            JP   #37B6,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.

37B6 B_TIMES_C  LD   (HL),C              Store C.
37B7            INC  HL                  Next address.
37B8            DJNZ #37B6,B_TIMES_C     Repeat until B=0.
37BA            RET

THE 'NEXT SECTOR' SUBROUTINE
This subroutine computes the next sector number in E, it returns with the Zero flag set
indicating 'next track'.

37BB NEXT_SEC   INC  E                   Increment sector number.
37BC            LD   A,E
37BD            CP   11
37BF            RET  NZ                  Return with Zero reset signalling 'same
                                         track'.
37C0            LD   E,1                 Otherwise start with sector 1 again.
37C2            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.

37C3 HL_BUFFER  PUSH BC
37C4            PUSH IX                  Disk channel pointer to BC.
37C6            POP  BC
37C7            LD   L,(IX+15)           Fetch data buffer offset.
37CA            LD   H,(IX+16)
37CD            ADD  HL,BC               HL now points to the data buffer.
37CE            POP  BC
37CF            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 #37D0, RPT-lo is first reset.

37D0 RPT_HL     LD   (IX+13),0           Reset RPT-lo.
37D4 RPT_HL1    CALL #37C3,HL_BUFFER     HL points to the data buffer.
37D7            LD   B,(IX+14)           Fetch RPT offset into BC.
37DA            LD   C,(IX+13)
37DD            ADD  HL,BC               Add the offset to the start of the data
                                         buffer.
37DE            RET                      Finished.

THE 'INCREMENT RPT' SUBROUTINE
This small subroutine increments the RAM PoinTer offset.

37DF INC_RPT    INC  (IX+13)             Increment RPT-lo.
37E2            RET  NZ
37E3            INC  (IX+14)             Increment RPT-hi when necessary.
37E6            RET

THE 'RESET RPT' SUBROUTINE
This small subroutine resets the RAM PoinTer offset.

37E7 RES_RPT    LD   (IX+13),0           Clear RPT offset.
37EB            LD   (IX+14),0
37EF            RET

THE 'FETCH SECTOR ADDRESS' SUBROUTINE
This subroutine returns with DE holding the stored track and sector number.

37F0 FETCH_SEC  LD   D,(IX+18)
37F3            LD   E,(IX+17)
37F6            RET

THE 'STORE SECTOR ADDRESS' SUBROUTINE
This subroutine stores the track and sector number held in DE into the disk channel.

37F7 STORE_SEC  LD   (IX+18),D
37FA            LD   (IX+17),E
37FD            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.

37FE GET_SECTOR CALL #37F0,FETCH_SEC     Fetch the stored track and sector
3801            LD   (IX+18),H           number. And store the track and sector
3804            LD   (IX+17),L           number held in HL.
3807            RET
Previous Next Contents Index