Previous Next Contents Index
The 'Hook code' routines 

The following routines are called by the 'hook and command code' routine at #228E (in
RAM) whenever a hook code was used.

THE 'HOOK CODE ADDRESSES' TABLE
This jump table consists of the 24 addresses of the routines called by using the various
'hook codes' in the range #1B..#32 (27..50).

0DD7 IF1_HOOK   DEFW #0E08,CONS_IN       Hook code #1B, 27.
0DD9            DEFW #0E1B,CONS_OUT      Hook code #1C, 28.
0DDB            DEFW #0E07,BCHAN_IN      Hook code #1D, 29.
0DDD            DEFW #0E07,BCHAN_OUT     Hook code #1E, 30.
0DDF            DEFW #0E2B,PRT_OUT       Hook code #1F, 31.
0DE1            DEFW #0E30,KBD_TEST      Hook code #20, 32.
0DE3            DEFW #0E38,SEL_DRIVE     Hook code #21, 33.
0DE5            DEFW #0E52,OP_TEMP_M     Hook code #22, 34.
0DE7            DEFW #1102,CLOSE_M2      Hook code #23, 35.
0DE9            DEFW #111E,ERASE         Hook code #24, 36.
0DEB            DEFW #11A1,READ_SEQ      Hook code #25, 37.
0DED            DEFW #11E1,WR_RECD       Hook code #26, 38.
0DEF            DEFW #11AD,RD_RANDOM     Hook code #27, 39.
0DF1            DEFW #1269,RD_SECTOR     Hook code #28, 40.
0DF3            DEFW #126A,RD_NEXT       Hook code #29, 41.
0DF5            DEFW #126B,WR_SECTOR     Hook code #2A, 42.
0DF7            DEFW #0EF4,SET_T_MCH     Hook code #2B, 43.
0DF9            DEFW #126C,DEL_M_BUF     Hook code #2C, 44.
0DFB            DEFW #1276,OP_TEMP_N     Hook code #2D, 45.
0DFD            DEFW #1277,CLOSE_NET     Hook code #2E, 46.
0DFF            DEFW #1278,GET_PACK      Hook code #2F, 47.
0E01            DEFW #1279,SEND_PACK     Hook code #30, 48.
0E03            DEFW #127A,HOOK_31       Hook code #31, 49.
0E05            DEFW #12C1,HOOK_32       Hook code #32, 50.

THE 'RS232 NOT SUPPORTED' SUBROUTINE
The 'BCHAN_IN' and 'BCHAN_OUT' 'hook codes' are not supported (the +D has no RS232 link).

0E07 UNDEFINED1 RET

THE 'CONSOLE INPUT' SUBROUTINE
Called by using 'hook code' 27 (#1B), it simply waits until a key is pressed. A return
is made with the A register holding the character code.

0E08 CONS_IN    RES  5,(IY+1)            Signal 'ready for a new key'.
0E0C WTKEY      EI                       Enable interrupts.
0E0D            HALT                     Wait for an interrupt.
0E0E            RST  #10,CALBAS          Call the keyboard scan routine in the
0E0F            DEFW #02BF,KEYBOARD      'main' ROM.
0E11            BIT  5,(IY+1)            Repeat the scan until a key has been
0E15            JR   Z,#0E0C,WTKEY       pressed.
0E17            LD   A,(23560)           Fetch the character code from (LAST_K)
0E1A            RET

THE 'CONSOLE OUTPUT' SUBROUTINE
By using 'hook code' 28 (#1C) the character held in the A register is printed on the
screen, with scroll suppressed.

0E1B CONS_OUT   PUSH AF
0E1C            LD   A,254               Use stream '-2' (attached to "S" the
                                         channel).
0E1E OUT_CODE   LD   HL,23692            This is SCR_CT.
0E21            LD   (HL),#FF            Set scroll counter.
0E23            RST  #10,CALBAS          Call 'CHAN_OPEN' in the 'main' ROM to
0E24            DEFW #1601,CHAN_OPEN     make stream -2 the current.
0E26            POP  AF
0E27            RST  #10,CALBAS          Print the character to the current
0E28            DEFW #0010,PRINT_A_1     stream.
0E2A            RET

THE 'PRINTER OUTPUT' SUBROUTINE
This subroutine is called by using 'hook code' 31 (#1F). It is identical to the
preceding one, but the output is directed to stream 3 (normally the printer).

0E2B PRT_OUT    PUSH AF
0E2C            LD   A,3                 Select stream 3.
0E2E            JR   #0E1E,OUT_CODE

THE 'KEYBOARD TEST' SUBROUTINE
This is called using 'hook code' 32 (#20). A return is made with the Zero flag reset if
a key is pressed.

0E30 KBD_TEST   XOR  A                   Clear A, allowing for the whole
                                         keyboard to be examined.
0E31            IN   A,(254)             Read the keyboard.
0E33            AND  #1F                 Keep only the keyboard bits.
0E35            SUB  #1F                 Return with sign negative and Zero
0E37            RET                      flag reset if a key is pressed.

THE 'SELECT DRIVE' SUBROUTINE
This subroutine is called by using 'hook code' 33 (#21). On entry, A holds the drive
number; if A isn't equal to 1 or 2 nothing is done.

0E38 SEL_DRIVE  CP   1
0E3A            JR   Z,#0E42,SEL_DRIVE1  Jump if drive 1 is to be selected.
0E3C            CP   2
0E3E            JR   Z,#0E42,SEL_DRIVE1  Jump if drive 2 is to be selected.
0E40            XOR  A
0E41            RET                      Otherwise exit.
0E42 SEL_DRIVE1 LD   B,A
0E43            LD   (#3ACE),A
0E46            LD   A,(#3DDA)           Fetch current control port state.
0E49            AND  #FC                 Drop the drive select bits.
0E4B            OR   B                   Use the new drive.
0E4C            LD   (#3DDA),A           Exit setting both current control port
0E4F            OUT  (239),A             state and the control port itself.
0E51            RET

THE 'OPEN TEMP. "M" CHANNEL' SUBROUTINE
This subroutine is used to open a temporary "M" channel in the CHANS area. It is called
by using 'hook code' 34 (#22). First a temporary "M" channel is created, then the drive
whose number is held into 'D_STR1' is searched for a file whose name is held into
'N_STR1'. A sector map is created with each reset bit indicating a free sector. Various
flags are returned as follows:
    - bit 0 of CHFLAG                    set with 'write' files.
    - bit 1 of RECFLG                    set with 'EOF' block.
    - bit 2 of RECFLG                    set with PRINT-type files.
On exit, HL holds a 'stream data' displacement that may be used to attach the channel to
a stream.

0E52 OP_TEMP_M  CALL #0EF4,SET_T_MCH     Create a temporary "M" channel.
0E55            PUSH HL                  Save 'stream displacement'.
0E56            LD   A,(IX+25)           Fetch the drive number (CHDRIV).
0E59            CALL #0E38,SEL_DRIVE     Select the drive.
0E5C            PUSH IX
0E5E            LD   DE,14               Make IX point to CHNAME, the name of
0E61            ADD  IX,DE               the wanted file.
0E63            CALL #1146,FIND_FILE     Search for the filename.
0E66            JR   NZ,#0E98,OP_T_2     Jump if not found.
0E68            INC  HL                  Skip number of sectors used.
0E69            INC  HL
0E6A            LD   D,(HL)              Fetch first track and sector.
0E6B            INC  HL
0E6C            LD   E,(HL)
0E6D            LD   IX,#3AC3            Point to the DRAM channel.
0E71            CALL #05CC,RSAD          Read the first sector.
0E74            POP  IX                  Restore channel pointer (in 'main'
0E76            PUSH IX                  RAM).
0E78            LD   DE,540              Microdrive type files consist of
                                         records with a length of 540 bytes
                                         each.
0E7B OP_T_1     PUSH IX                  Store data buffer pointer (in 'main'
                                         RAM).
0E7D            LD   IX,#3AC3            Point to the DRAM channel again.
0E81            CALL #077F,LBYT          Fetch a byte.
0E84            POP  IX                  Restore data buffer pointer.
0E86            LD   (IX+55),A           Loading starts with the data block
                                         preamble (offset 55).
0E89            INC  IX
0E8B            CALL #1265,DEC_DE        Decrement DE.
0E8E            JR   NZ,#0E7B,OP_T_1     Repeat until DE=0.
0E90            POP  IX
0E92            RES  0,(IX+24)           Signal 'read file'.
0E96            POP  HL                  Restore stream 'stream data'.
0E97            RET                      Finished.

0E98 OP_T_2     LD   HL,#3A00            Clear the disk bitmap.
0E9B            LD   B,195
0E9D OP_T_3     LD   (HL),0
0E9F            INC  HL
0EA0            DJNZ #0E9D,OP_T_3
0EA2            LD   A,%00100000         Make new disk bitmap.
0EA4            CALL #09A5,SCAN_CAT
0EA7            POP  IX
0EA9            PUSH IX
0EAB            LD   HL,#3AD6            Points to dir. descr. of DFCA.
0EAE            LD   (HL),6              File is a 'Microdrive file'.
0EB0            INC  HL
0EB1            LD   B,10                Copy the 10 characters of the name.
0EB3 OP_T_4     LD   A,(IX+14)
0EB6            LD   (HL),A
0EB7            INC  IX
0EB9            INC  HL
0EBA            DJNZ #0EB3,OP_T_4
0EBC            LD   B,245               Clear the rest of the CATalogue entry
0EBE OP_T_5     LD   (HL),0              of this file.
0EC0            INC  HL
0EC1            DJNZ #0EBE,OP_T_5
0EC3            LD   HL,#0000            Reset RPT.
0EC6            LD   (#3AD0),HL
0EC9            LD   HL,#3BD6            Clear the first 256 bytes of the data
0ECC            LD   B,0                 buffer.
0ECE OP_T_6     LD   (HL),0
0ED0            INC  HL
0ED1            DJNZ #0ECE,OP_T_6
0ED3            LD   IX,#3AC3
0ED7            CALL #0925,MK_ALLOC      Allocate the first free sector.
0EDA            LD   (#3AD4),DE          Store the track and sector number.
0EDE            LD   IX,#3AD6            Store them also into the CATalogue
0EE2            LD   (IX+13),D           entry.
0EE5            LD   (IX+14),E
0EE8            POP  IX
0EEA            RES  1,(IX+67)           Signal 'Not the EOF block' (RECFLG).
0EEE            RES  2,(IX+67)           Signal 'PRINT-type file' (opened for
0EF2            POP  HL                  writing). Restore stream 'stream data'
0EF3            RET                      Finished.

THE 'SET A TEMP. "M" CHANNEL' SUBROUTINE
This subroutine is also called by using 'hook code' 43 (#2B). It sets a temporary "M"
channel in the CHANS area. The subroutine returns with IX pointing to the start of the
channel and HL holding a suitable displacement to be eventually inserted in the STRMS
area to attach the channel to a stream.

0EF4 SET_T_MCH  LD   IX,(23631)          Fetch (CHANS), the start of the
                                         channel area.
0EF8            LD   DE,20               Make IX point to the start of the
0EFB            ADD  IX,DE               'new' channels.
0EFD SET_T_1    LD   A,(IX+0)
0F00            CP   128
0F02            JR   Z,#0F34,SET_T_3     Jump if the CHANS area is finished.
0F04            LD   A,(IX+4)            Fetch the channel specifier.
0F07            AND  #7F                 Clear bit 7 (drop temporary/permanent
                                         flag).
0F09            CP   "M"
0F0B            JR   NZ,#0F2A,SET_T_2    Jump if not a "M" channel.
0F0D            LD   A,(23766)           Fetch drive number (D_STR1).
0F10            CP   (IX+25)             Compare it with (CHDRIV).
0F13            JR   NZ,#0F2A,SET_T_2    Jump if this channel uses a different
                                         drive.
0F15            LD   BC,(23770)          Fetch length of filename (NSTR_1).
0F19            LD   HL,(23772)          And its startaddress (NSTR_1+2).
0F1C            CALL #0FCC,CHK_NAME      Check name against 'CHNAME' of this
                                         channel.
0F1F            JR   NZ,#0F2A,SET_T_2    Jump if not the same file.
0F21            BIT  0,(IX+24)
0F25            JR   Z,#0F2A,SET_T_2     Jump if it's a 'read file'.
0F27            JP   #12C3,MD_ERROR      Exit if the file is already opened for
                                         writing.
0F2A SET_T_2    LD   E,(IX+9)            Fetch the length of the channel.
0F2D            LD   D,(IX+10)
0F30            ADD  IX,DE               Point to the next channel.
0F32            JR   #0EFD,SET_T_1       Check next channel.

Now the space for the new channel is created at the end of the CHANS area.

0F34 SET_T_3    LD   HL,(23635)          Calculate end of CHANS area ((PROG)-1)
0F37            DEC  HL                  i.e. the start of the channel.
0F38            PUSH HL
0F39            LD   BC,595              Length is '595' bytes.
0F3C            RST  #10,CALBAS          Create the required space by calling
0F3D            DEFW #1655,MAKE_ROOM     'MAKE_ROOM'.
0F3F            POP  DE                  Restore start address of the channel.
0F40            PUSH DE
0F41            LD   HL,#10E9,MCHAN_DATA Start of "M" channel data.
0F44            LD   BC,25
0F47            LDIR                     Store channel data into the channel.
0F49            LD   A,(23766)           Fetch drive number (D_STR1).
0F4C            LD   (IX+25),A           Store it into the channel (CHDRIV).
0F4F            LD   BC,595              Length of the channel.
0F52            PUSH IX                  Make HL point to the start of the
0F54            POP  HL                  channel.
0F55            CALL #0FA3,REST_F_AD     Restore 'start of filename' possibly
                                         moved during the 'insertion' of the
                                         channel.
0F58            EX   DE,HL               The start address of the filename goes
                                         to HL.
0F59            LD   BC,(23770)          Fetch length of filename (N_STR1).
0F5D            BIT  7,B                 Jump if the name doesn't exist
0F5F            JR   NZ,#0F6F,SET_T_5    (N_STR1 = #FFFF).

The channel name is transferred into CHNAME.

0F61 SET_T_4    LD   A,B
0F62            OR   C
0F63            JR   Z,#0F6F,SET_T_5     Jump if no more bytes left.
0F65            LD   A,(HL)              Transfer a character of the name into
0F66            LD   (IX+14),A           (CHNAME).
0F69            INC  HL                  Point to next locations.
0F6A            INC  IX
0F6C            DEC  BC                  One byte less.
0F6D            JR   #0F61,SET_T_4       Continue with next character.

Now the 'preambles' are stored into the channel.

0F6F SET_T_5    POP  IX                  Restore start address of channel.
0F71            LD   DE,28               Offset for header block preamble.
0F74            CALL #0F89,SETUP_PRE     Set-up header preamble.
0F77            LD   DE,55               Offset for data block preamble.
0F7A            CALL #0F89,SETUP_PRE     Set-up data block preamble.
0F7D            PUSH IX                  Make HL point to the start of the
0F7F            POP  HL                  channel.
0F80            LD   DE,(23631)          Calculate the required 'stream offset'
0F84            OR   A                   into HL (i.e. channel start-(CHANS)+1)
0F85            SBC  HL,DE
0F87            INC  HL
0F88            RET                      Finished.

THE 'SET-UP A PREAMBLE' SUBROUTINE
The following subroutine passes a preamble to the specified channel position. On entry
IX points to the start of the channel and DE holds the required offset.

0F89 SETUP_PRE  PUSH IX                  Pass start of channel to HL.
0F8B            POP  HL
0F8C            ADD  HL,DE               Add the offset.
0F8D            EX   DE,HL               DE now points to the preamble area.
0F8E            LD   HL,#0F97            Start of 'preamble' data.
0F91            LD   BC,12               Preamble is 12 bytes long.
0F94            LDIR
0F96            RET

THE 'PREAMBLE DATA' TABLE
The header and data block preambles consist of the following bytes:

0F97 PREAMBLE   DEFB #00,#00,#00,#00,#00
0F9C            DEFB #00,#00,#00,#00,#00
0FA1            DEFB #FF,#FF

The Microdrive needs these bytes to fetch the start of a block of bytes when reading a
cartridge.

THE 'RESTORE FILENAME ADDRESS' ROUTINE
After the 'insertion' of some space, the 'filename' whose start addresses are held into
(N_STR1+2) and (N_STR2+2) have been moved up in the workspace area. This routine is
entered with HL holding the channel start address, and with BC holding the number of
'inserted' bytes. The addresses held into (N_STR1+2) and (N_STR2+2) are then updated,
unless the filenames are stored into 'no-dynamic' areas (i.e. before the channel or after
STKEND).

0FA3 REST_F_AD  PUSH HL                  Save 'start of channel' twice.
0FA4            PUSH HL
0FA5            LD   DE,(23780)          Restore start address of the second
0FA9            CALL #0FBE,TST_PLACE     filename.
0FAC            LD   (23780),DE
0FB0            POP  HL                  Restore channel start address.
0FB1            LD   DE,(23772)          Restore start address of the first
0FB5            CALL #0FBE,TST_PLACE     filename.
0FB8            LD   (23772),DE
0FBC            POP  HL                  Restore channel start address.
0FBD            RET                      Finished.

The following subroutine calculates the new filename address.

0FBE TST_PLACE  SCF                      Allow for a further byte.
0FBF            SBC  HL,DE               No action is made if the filename is
0FC1            RET  NC                  before the channel.
0FC2            LD   HL,(23653)          Or if it is after (STKEND).
0FC5            SBC  HL,DE
0FC7            RET  C
0FC8            EX   DE,HL               Add to DE the number of 'inserted'
0FC9            ADD  HL,BC               bytes, so returning the new filename
0FCA            EX   DE,HL               address.
0FCB            RET                      Finished.

THE 'CHECK NAME' SUBROUTINE
Whenever a 'filename' is to be compared against the channel name CHNAME, this subroutine
is called. On entry, HL must point to the filename to be compared, while C must contain
its length. If the comparision is succesful, the Zero flag is returned set.

0FCC CHK_NAME   PUSH IX                  Save start of channel.
0FCE            LD   B,10                Length of a filename.
0FD0 CHK_NAME1  LD   A,(HL)              Fetch a byte from the name.
0FD1            CP   (IX+14)
0FD4            JR   NZ,#0FEC,CHK_NAME3  Jump if it doesn't match.
0FD6            INC  HL                  Point to the next character.
0FD7            INC  IX
0FD9            DEC  B                   One byte less.
0FDA            DEC  C                   Repeat until all bytes of the name have
0FDB            JR   NZ,#0FD0,CHK_NAME1  been matched.
0FDD            LD   A,B                 CHNAME remaining length.
0FDE            OR   A
0FDF            JR   Z,#0FEC,CHK_NAME3   Exit if all bytes of CHNAME matched.
0FE1 CHK_NAME2  LD   A,(IX+14)           Otherwise the remaining characters of
0FE4            CP   32                  CHNAME have to be spaces.
0FE6            JR   NZ,#0FEC,CHK_NAME3  Exit if not a space.
0FE8            INC  IX                  Repeat until all bytes of CHNAME have
0FEA            DJNZ #0FE1,CHK_NAME2     been examined.
0FEC CHK_NAME3  POP  IX                  Restore channel start address.
0FEE            RET                      Finished.

THE 'CALL INP' ROUTINE
This routine is the same as the Interface 1 'CALL_INP' routine which handles all IF1's
channels. The +D uses this routine only for "M" channels, for "D" channels a similar
routine located in RAM is used. (The only difference is the test of FLAGS3, i.e. IY+124
while emulating the IF1, #1ACF otherwise.) On entry HL holds the address of the service
'input' routine. The routine handles both INPUT and INKEY$ commands.

0FEF CALL_INP   RES  3,(IY+2)            Signal 'the mode is to be considered
                                         as being unchanged'.
0FF3            PUSH HL                  Store address of service routine.
0FF4            LD   HL,(23613)          HL points to error address (ERR_SP).
0FF7            LD   E,(HL)              Fetch the error address.
0FF8            INC  HL
0FF9            LD   D,(HL)
0FFA            AND  A
0FFB            LD   HL,#107F,ED_ERROR   If the error address is 'ED_ERROR'
0FFE            SBC  HL,DE               ('main' ROM) then an INPUT command was
1000            JR   NZ,INKEY$           used. Jump if unequal to 'ED_ERROR'.

Now deal with an 'INPUT #' command referring to a "M" channel.

1002            POP  HL                  Restore address of service routine.
1003            LD   SP,(23613)          Clear the machine stack (ERR_SP).
1007            POP  DE                  Remove 'ED_ERROR'.
1008            POP  DE
1009            LD   (23613),DE          Restore the old value of ERR_SP.
100D IN_AGAIN   PUSH HL                  Store address of service routine.
100E            LD   DE,#1013,INPUT_END  Return address is 'INPUT_END' below.
1011            PUSH DE
1012            JP   (HL)                Jump to the service routine.

When the byte has been read from the required channel, a return is made here to add the
byte to the INPUT line, or to return if the byte is equal to CHR$ 13, i.e. ENTER.

1013 INPUT_END  JR   C,#101D,ACC_CODE    Jump with acceptable codes.
1015            JR   Z,#101A,NO_READ     Jump with no data read.
1017 INPUT_ERR  JP   #12C3,MD_ERROR      Otherwise jump to the 'hook code'
                                         error routine.
101A NO_READ    POP  HL                  Restore address of service routine and
101B            JR   #100D,IN_AGAIN      try again.

An acceptable code was received, it is added to the INPUT line.

101D ACC_CODE   CP   13
101F            JR   Z,#1027,END_INPUT   Jump if the code is ENTER.
1021            RST  #10,CALBAS          Otherwise the byte is to be added to
1022            DEFW #0F85,ADD_CHAR0     the INPUT line. This is done by call-
                                         ing into the 'ADD_CHAR' subroutine.
1024            POP  HL                  Restore address of the service routine
1025            JR   #100D,IN_AGAIN      and read the next byte.

1027 END_INPUT  POP  HL                  Drop the address of the service
1028            JP   #0050,UNPAGE_1      routine and page-out the +D.

Enter here to deal with the INKEY$ function (a single character is returned).

102B INKEY$     POP  HL                  Restore address of the service routine
102C            LD   DE,#1031,INK$_END   Return address is 'INK$_END' below.
102F            PUSH DE
1030            JP   (HL)                Jump to the service routine.

1031 INK$_END   RET  C                   Return with acceptable codes or
1032            RET  Z                   with no byte read.
1033            BIT  4,(IY+124)          Otherwise EOF was reached, so jump to
1037            JR   Z,#1017,INPUT_ERR   the error routine except when
                                         executing a 'MOVE' command.
1039            OR   1                   Then return with Zero and Carry flags
103B            RET                      both reset.

THE '"M" CHANNEL INPUT' ROUTINE
The actual 'input' is handled via 'CALL_INP' above. The service routine is 'MCHAN_IN'
below.

103C M_INPUT    LD   IX,(23633)          Make IX point to start of channel.
1040            LD   HL,#1046,MCHAN_IN   Address of the service routine.
1043            JP   #0FEF,CALL_INP      Jump to the control routine.

THE '"M" CHANNEL INPUT' SERVICE ROUTINE
This is the actual read a byte from the "M" channel routine. The byte is read from the
data buffer in the channel, if it is empty the next sector is loaded from disk (provided
that the 'current' data block is not the EOF one) before reading the byte.

1046 MCHAN_IN   BIT  0,(IX+24)           Jump to the 'hook code' error routine
104A            JP   NZ,#12C3,MD_ERROR   if (CHFLAG) indicates 'read' file.
104D TEST_M_BUF LD   E,(IX+11)           Fetch current byte counter from
1050            LD   D,(IX+12)           (CHBYTE).
1053            LD   L,(IX+69)           Fetch record length from (RECLEN).
1056            LD   H,(IX+70)
1059            SCF                      Include byte to be read.
105A            SBC  HL,DE
105C            JR   C,#1071,CHK_M_EOF   Jump if all bytes have been read.
105E            INC  DE                  Include byte to be read in the byte
                                         counter.
105F            LD   (IX+11),E           And store it.
1062            LD   (IX+12),D
1065            DEC  DE                  Position of character to be read.
1066            PUSH IX                  Save start address of channel.
1068            ADD  IX,DE               IX now points to 'byte to be
                                         read - 82'.
106A            LD   A,(IX+82)           Fetch the byte.
106D            POP  IX                  Restore start of channel.
106F            SCF                      Signal 'acceptable code'.
1070            RET                      Finished.

If all bytes in the data block have been read, a check is made to see if it is the 'end
of file' block, i.e. the last one.

1071 CHK_M_EOF  BIT  1,(IX+67)           Jump if (RECFLG) indicates 'not the
1075            JR   Z,#107B,NEW_BUFF    End Of File' block.
1077            XOR  A                   Otherwise Zero and Carry flag are
                                         reset to signal 'EOF'.
1078            ADD  A,13                Returned byte is CHR$ 13, i.e. ENTER.
107A            RET                      Finished.

A new data block is now read from the disk drive.

107B NEW_BUFF   LD   DE,0                Clear the byte counter.
107E            LD   (IX+11),E
1081            LD   (IX+12),D
1084            INC  (IX+13)             Increment (CHREC), i.e. record number.
1087            CALL #108C,GET_RECD      Fetch a new data block.
108A            JR   #104D,TEST_M_BUF    Read the byte.

THE 'GET A RECORD' SUBROUTINE
This subroutine is used to load a record of a 'MICRODRIVE'-type file.

108C GET_RECD   LD   C,3                 Three retries will be made before the
                                         routine is exitted when an error
                                         occurs.
108E            BIT  1,(IX+67)
1092            JR   NZ,#10BD,GET_R3     Jump if (RECFLG) indicates 'EOF' block
1094 GET_R1     PUSH IX                  Store channel pointer (in 'main' RAM).
1096            LD   DE,540              Microdrive file records have 540 bytes
                                         each.
1099 GET_R2     PUSH IX                  Store data buffer pointer.
109B            LD   IX,#3AC3            Point to the DRAM channel.
109F            CALL #077F,LBYT          Fetch a byte.
10A2            POP  IX                  Restore data buffer pointer.
10A4            LD   (IX+55),A           Loading starts with the data block
                                         preamble (offset 55).
10A7            INC  IX
10A9            CALL #1265,DEC_DE        Decrement DE.
10AC            JR   NZ,#1099,GET_R2     Repeat until DE=0.
10AE            POP  IX                  Restore channel pointer.
10B0            LD   A,(IX+68)           Fetch number of this record (RECNUM).
10B3            CP   (IX+13)             Test it against wanted record number
10B6            RET  Z                   (CHREC), exit if they are equal.
10B7            BIT  1,(IX+67)           Jump to load the next record if
10BB            JR   Z,#1094,GET_R1      (RECFLG) indicates that this isn't the
                                         EOF one.
10BD GET_R3     DEC  C                   Decrement retry counter.
10BE            JR   Z,#10E6,MD_ERROR1   Exit via the 'hook code' error routine
                                         when three retries have been made.

Now the routine reloads the first sector of the file. With 'MICRODRIVE'-type files it is
possible to have a 'read' channel attached to a file to which is also a 'write' channel
attached. So the last record could have been read into the 'read' channels data buffer
after which a new record was added by the 'write' channel. The reason why three retries
are made is probably because of the ignoring of errors, signalled by a set Carry flag
(remember this is a 'hook code' executing), reported by 'LBYT' and 'RSAD'. The routine
does some retrying before quitting.

10C0            PUSH HL                  Store the registers needed by the
10C1            PUSH IX                  routine above.
10C3            PUSH BC
10C4            LD   A,(IX+25)           Fetch the drive number from CHDRIV.
10C7            CALL #0E38,SEL_DRIVE     Select the drive.
10CA            LD   DE,14               Make IX point to CHNAME, the name of
10CD            ADD  IX,DE               the requested file.
10CF            CALL #1146,FIND_FILE     Search for the filename.
10D2            JR   NZ,#10E6,MD_ERROR1  Jump if not found.
10D4            INC  HL                  Skip 'number of sectors used'.
10D5            INC  HL
10D6            LD   D,(HL)              Fetch first track and sector.
10D7            INC  HL
10D8            LD   E,(HL)
10D9            LD   IX,#3AC3            Point to the DRAM channel.
10DD            CALL #05CC,RSAD          Read the first sector.
10E0            POP  BC                  Restore registers.
10E1            POP  IX
10E3            POP  HL
10E4            JR   #1094,GET_R1        Try to find the right record again.

THE 'JUMP TO ERROR ROUTINE'
Because this jump is only two times 'jump relatived to', it wastes one byte.

10E6 MD_ERROR1  JP   #12C3,MD_ERROR      Jump to the 'hook code' error routine.

THE '"M" CHANNEL DATA' TABLE
The '25' bytes that compose the initial part of an "M" channel are as follows:

10E9 MCHAN_DATA DEFW #0008               Main ROM 'output' routine.
10EB            DEFW #0008               Main ROM 'input' routine.
10ED            DEFB "M"+128             Channel specifier.
10EE            DEFW #11BB,MCHAN_OUT     +D ROM 'output' routine.
10F0            DEFW #103C,M_INPUT       +D ROM 'input' routine.
10F2            DEFW 595                 Channel length.
10F4            DEFW #0000               Default for CHBYTE.
10F6            DEFB #00                 Default for CHREC.
10F7            DEFM "          "        Default for CHNAME (10 spaces).
1101            DEFB #FF                 Default for CHFLAG ('write' channel).

THE 'CLOSE FILE' SUBROUTINE
By using 'hook code' 35 (#23) the following subroutine is called. It CLOSEs an "M"
channel which start adddress is held in the IX register. If the channel is used for
reading, then it is reclaimed; but if it is used for writing, any unsent data in the
buffer is written to disk before reclaiming the channel.

1102 CLOSE_M2   BIT  0,(IX+24)           Jump if (CHFLAG) indicates that this
1106            JR   Z,#111A,CLOSE_M1    is a 'read' channel.
1108            SET  1,(IX+67)           Otherwise signal 'EOF record',
110C            CALL #11E1,WR_RECD       and save it on disk.
110F            PUSH IX                  Save channel pointer.
1111            LD   IX,#3AC3            Point to the DRAM channel.
1115            CALL #0B89,CFSM          Close the File Sector Map.
1118            POP  IX                  Restore channel pointer.
111A CLOSE_M1   CALL #126C,DEL_M_BUF     Reclaim the channel.
111D            RET

THE 'ERASE' SUBROUTINE
This subroutine is called using 'hook code' 36 (#24). It deals with the ERASEing of all
file types. It differs from the +D's ERASE 'command code': this routine uses a temporary
channel and the IF1's extra system variables to ERASE a file. On entry 'D_STR1' must hold
the drive number and 'N_STR1' the length and the start of the filename.

111E ERASE      CALL #0EF4,SET_T_MCH     Create a temporary "M" channel.
1121            PUSH IX                  Store channel pointer.
1123            LD   DE,14               Make IX point to CHNAME, the name of
1126            ADD  IX,DE               the file to be ERASEd.
1128            CALL #1146,FIND_FILE     Search for the file.
112B            POP  IX                  Restore channel pointer.
112D            PUSH AF                  Save flags.
112E            JR   NZ,#1141,ERASE_1    Jump if the file wasn't found.
1130            LD   HL,#3BD6            Point to the start of the disk buffer.
1133            ADD  HL,BC               BC holds the directory entries offset
                                         (i.e. 0 for first, 256 for second).
1134            LD   (HL),0              Signal 'ERASEd file'.
1136            PUSH IX                  Store channel pointer.
1138            LD   IX,#3AC3            Point to the DRAM channel.
113C            CALL #0584,WSAD          Write sector DE.
113F            POP  IX                  Restore channel pointer.
1141 ERASE_1    CALL #126C,DEL_M_BUF     Reclaim the channel.
1144            POP  AF                  Exit with Zero reset indicating 'file
1145            RET                      not found'.

THE 'FIND A FILE' SUBROUTINE
This routine searches the disk CATalogue for the filename pointed to by the IX register.
On exit, Zero reset signals 'file not found'.

1146 FIND_FILE  CALL #06B6,REST          Reset drive to track 0.
1149            LD   (#3ACA),IX          Store the pointer to filename
                                         requested.
114D FIND_F1    LD   IX,#3AC3            Point to the DRAM channel.
1151            CALL #05CC,RSAD          Load a sector to the disk buffer.
1154            LD   BC,0                First entry's offset.
1157 FIND_F2    LD   HL,#3BD6            Point to the start of the disk buffer.
115A            ADD  HL,BC               Point to directory entry.
115B            LD   A,(HL)
115C            CP   0
115E            JR   Z,#1117F,FIND_F4    Jump if the file is ERASEd.
1160            INC  HL                  Point to the filename.
1161            LD   IX,(#3ACA)          Fetch pointer to filename requested.
1165            LD   A,10                Length of filename.
1167            LD   (#3DF3),A
116A FIND_F3    LD   A,(IX+0)            Fetch a byte from requested name.
116D            XOR  (HL)                Compare against found name.
116E            AND  #DF                 Capitalize.
1170            JR   NZ,#117F,FIND_F4    Jump if they don't match.
1172            INC  IX                  Next characters.
1174            INC  HL
1175            LD   A,(#3DF3)
1178            DEC  A
1179            LD   (#3DF3),A
117C            JR   NZ,#116A,FIND_F3    Repeat for all characters in the name.
117E            RET                      Return with Zero set to indicate 'file
                                         found'.

The requested filename wasn't found yet, so examine the next file.

117F FIND_F4    LD   A,B
1180            CP   1
1182            JR   Z,#1190,FIND_F5     Jump if second entry handled.
1184            LD   A,(#3DDA)
1187            AND  #04                 Jump if using single density, i.e.
1189            JR   NZ,#1190,FIND_F5    each sector holds one entry.
118B            LD   BC,256              Otherwise examine second entry.
118E            JR   #1157,FIND_F2

The next CATalogue sector has to be loaded, if present.

1190 FIND_F5    INC  E                   Next sector.
1191            LD   A,E
1192            CP   11                  Jump if last sector on current track
1194            JR   NZ,#114D,FIND_F1    hasn't been loaded yet.
1196            LD   E,1                 Otherwise start with sector 1
1198            INC  D                   on the next track.
1199            LD   A,D
119A            CP   4                   Jump if last track in CATalogue hasn't
119C            JR   NZ,#114D,FIND_F1    been handled yet.
119E            CP   0                   Otherwise reset Zero flag to signal
11A0            RET                      'file not found' and exit.

THE 'READ SEQUENTIAL' SUBROUTINE
This is called by using 'hook code' 37 (#25). The subroutine reads into the data block
of the current "M" channel, the next record of a named PRINT-type file. On entry IX must
hold the "M" channel start address, and CHREC the number of the current record. CHREC
will be automatically incremented. CHDRIV must hold the drive number and CHNAME must hold
the filename.

11A1 READ_SEQ   BIT  1,(IX+67)           Jump if (RECFLG) indicates that the
11A5            JR   Z,#11AA,INCREC      current record isn't the EOF one.
11A7            JP   #12C3,MD_ERROR      Otherwise exit via the 'hook code'
                                         error routine.
11AA INCREC     INC  (IX+13)             Increment the record number (CHREC)
                                         and continue into 'RD_RANDOM'.

THE 'READ RANDOM' SUBROUTINE
This subroutine is called by using 'hook code' 39 (#27). The record number CHREC of a
PRINT-type file is loaded into the data block. The other variables are to be set as for
'READ_SEQ' above.

11AD RD_RANDOM  CALL #108C,GET_RECD      Load CHREC record.
11B0            BIT  2,(IX+67)           Return only if (RECFLG) indicates that
11B4            RET  Z                   it is a PRINT-type file.
11B5            CALL #126C,DEL_M_BUF     Otherwise reclaim the channel and exit
11B8            JP   #12C3,MD_ERROR      via the 'hook code' error routine.

THE '"M" CHANNEL OUTPUT' ROUTINE
This routine handles the "M" channel output. The byte stored in the A register is stored
into the 512-byte buffer. When it is filled, the record is written onto disk.

11BB MCHAN_OUT  LD   IX,#FFFA            This is -6.
11BF            ADD  IX,DE               Point to the start of the channel.
11C1            BIT  0,(IX+24)           Continue only if (CHFLAG) indicates
11C5            JP   Z,#12C3,MD_ERROR    that this is a 'write' file.
11C8            LD   E,(IX+11)           Fetch the byte pointer (CHBYTE).
11CB            LD   D,(IX+12)
11CE            PUSH IX                  Save start address of channel.
11D0            ADD  IX,DE               Point to 'first free byte in
                                         buffer'-82.
11D2            LD   (IX+82),A           Store the byte into the buffer.
11D5            POP  IX                  Restore start of channel.
11D7            INC  DE                  Update (CHBYTE).
11D8            LD   (IX+11),E
11DB            LD   (IX+12),D
11DE            BIT  1,D                 Return if the buffer is not filled
11E0            RET  Z                   (position 512 has not been reached).

If the buffer is filled, the routine continues into 'WR_RECD' below.

THE 'WRITE RECORD' SUBROUTINE
This subroutine is called by using 'hook code' 38 (#26). The record held in the "M"
channel pointed by the IX register (with name CHNAME and number CHREC), is written onto
the disk inserted into drive CHDRIV.

11E1 WR_RECD    LD   A,(IX+25)           Fetch the drive number (CHDRIV).
11E4            CALL #0E38,SEL_DRIVE     Select the drive.
11E7            PUSH IX                  Save start address of channel.
11E9            LD   B,10                Counts ten characters.
11EB CP_NAME    LD   A,(IX+14)           Copy CHNAME into RECNAM.
11EE            LD   (IX+71),A
11F1            INC  IX
11F3            DJNZ #11EB,CP_NAME
11F5            POP  IX                  Restore start of channel.
11F7            LD   C,(IX+11)           Copy CHBYTE into RECLEN.
11FA            LD   (IX+69),C
11FD            LD   A,(IX+12)
1200            LD   (IX+70),A
1203            LD   A,(IX+13)           Copy CHREC into RECNUM.
1206            LD   (IX+68),A
1209            PUSH IX                  Make HL point to the start of the data
120B            POP  HL                  workspace,
120C            LD   DE,67               i.e. RECFLG.
120F            ADD  HL,DE
1210            CALL #122A,CHKS_HD_R     Calculate DESCHK checksum.
1213            LD   DE,15               Make HL point to the start of the
1216            ADD  HL,DE               512-byte buffer.
1217            CALL #122F,CHKS_BUF      Calculate DCHK checksum.
121A            CALL #1248,SAVE_RECD     Save the record to disk.
121D            LD   DE,0                Clear CHBYTE.
1220            LD   (IX+11),E
1223            LD   (IX+12),D
1226            INC  (IX+13)             Increment the record number (CHREC).
1229            RET                      Finished.

THE 'CALCULATE/COMPARE CHECKSUM' ROUTINE
This routine is used to calculate DESCHK and DCHK checksums, or to compare the previous
checksum against the current one; the Zero flag is returned set if the checksums match.
The entry point is CHK_HD_R for DESCHK, or CHKS_BUFF for DCHK checksum. On entry in both
cases HL must contain the start address of the block for which the checksum is to be
obtained.

122A CHKS_HD_R  LD   BC,14               The block length.
122D            JR   #1232,CHKS_ALL      Calculate checksum for the block.

122F CHKS_BUF   LD   BC,512              The block length.
1232 CHKS_ALL   PUSH HL                  The start address is preserved.
1233            LD   E,0                 Clear checksum.
1235 CHKS_1     LD   A,E                 Add the current byte to the previous
1236            ADD  A,(HL)              sum.
1237            INC  HL                  Point to next location.
1238            ADC  A,1                 Include also the carry + 1.
123A            JR   Z,#123D,CHKS_2      Jump if A reaches zero.
123C            DEC  A                   Otherwise balance the 'ADC' above.
123D CHKS_2     LD   E,A                 Update sum.
123E            DEC  BC                  One byte less to add.
123F            LD   A,B
1240            OR   C
1241            JR   NZ,#1235,CHKS_1     Repeat until all bytes have been added
1243            LD   A,E
1244            CP   (HL)                Compare with previous checksum.
1245            LD   (HL),A              Store the new one.
1246            POP  HL                  Restore start address.
1247            RET                      Finished.

THE 'SAVE A RECORD' SUBROUTINE
This subroutine saves the 540 byte Microdrive-file record to disk.

1248 SAVE_RECD  PUSH IX                  Save the channel pointer.
124A            PUSH IX
124C            POP  HL                  Calculate the address of the first
124D            LD   DE,55               byte to SAVE, i.e. the data block
1250            ADD  HL,DE               preamble (offset 55).
1251            LD   DE,540              Length of the record to be written.
1254            LD   IX,#3AC3            Point to the DRAM channel.
1258 SAVE_REC1  LD   A,(HL)              Fetch a byte.
1259            CALL #0761,SBYT          Save it to disk.
125C            INC  HL
125D            CALL #1265,DEC_DE        Decrement DE.
1260            JR   NZ,#1258,SAVE_REC1  Repeat until DE=0.
1262            POP  IX                  Restore the channel pointer.
1264            RET                      Finished.

THE 'DECREMENT DE' SUBROUTINE
This very small subroutine decrements DE and returns with the Zero flag indicating if DE
holds zero on exit. The purpose of this three-byte subroutine is unclear, it doesn't save
a single byte (a CALL instruction takes also three bytes so this subroutine makes the
code only longer), and the readability of the code (or the source) doesn't improve
really.

1265 DEC_DE     DEC  DE                  DE=DE-1.
1266            LD   A,D
1267            OR   E                   Set Zero flag if DE=0.
1268            RET                      Finished.

THE 'READ SECTOR' SUBROUTINE
This subroutine is not implemented, it is called by using 'hook code' 40 (#28). When
used with an IF1 the sector, which number is held in CHREC, is read into the channel
area. If the sector doesn't belong to a PRINT-type file the data buffer is cleared before
returning. On entry the required drive motor has to be turned on.

1269 RD_SECTOR  RET

THE 'READ NEXT SECTOR' SUBROUTINE
This subroutine called by using 'hook code' 41 (#29) isn't implemented either. It should
load into the channel area the first header and data block that pass through the
Microdrive head. The required drive motor has to be started before calling this routine.

126A RD_NEXT    RET

THE 'WRITE SECTOR' SUBROUTINE
Another unimplemented subroutine, called by using 'hook code' 42 (#2A) it writes the
data block in the current channel (pointed to by IX) to the sector specified by CHREC.
The required Microdrive has to be started and all channel variables, such as CHNAME, are
to be set as required before calling the routine.

126B WR_SECTOR  RET

THE 'RECLAIM "M" CHANNEL' SUBROUTINE
This subroutine (also called by using 'hook code' 44 (#2C)) is used to reclaim the "M"
channel pointed by the IX register. Unlike the IF1 routine this routine neither closes
the stream(s) attached to this channel, nor updates the stream data for channels moved
down after the reclaiming.

126C DEL_M_BUF  PUSH IX                  Make HL point to the start of the
126E            POP  HL                  channel.
126F            LD   BC,595              Length of the channel.
1272            RST  #10,CALBAS          Delete the channel area by calling
1273            DEFW #19E8,RECLAIM_2     'RECLAIM_2' in the 'main' ROM.
1275            RET                      Finished.

THE 'OPEN TEMP. "N" CHANNEL' SUBROUTINE
The +D doesn't support the use of "N" channels, temporary or permanent, by the user.
This routine is called by using 'hook code' 45 (#2D).

1276 OP_TEMP_N  RET

THE 'CLOSE NETWORK CHANNEL' SUBROUTINE
Because the +D doesn't support "N" channels, the CLOSEing of them isn't supported either
('hook code' 46 (#2E)).

1277 CLOSE_NET  RET

THE 'GET PACKET FROM NETWORK' SUBROUTINE
Called by using 'hook code' 47 (#2F), this subroutine to fetch a header and data block
from the network isn't implemented.

1278 GET_PACK   RET

THE 'SEND PACKET' SUBROUTINE
The +D doesn't support the sending of a header and data block over the network ('hook
code' 48 (#30)).

1279 SEND_PACK  RET

THE 'CREATE IF1 VARIABLES' SUBROUTINE
This subroutine (called by using 'hook code' 49 (#31)) has the task of creating the
IF1's new system variables if nonexistent. Many variables are initialised to their
default values.

127A HOOK_31    LD   HL,(23631)          Fetch start of channel area (CHANS).
127D            LD   DE,#A349            This is -23735.
1280            ADD  HL,DE               The Carry flag is now set if the CHANS
                                         area starts after address 23734, i.e.
                                         the 'new' variables exist already.
1281            JR   C,#12A9,VAR_EXIST   Jump if they exist already.
1283            LD   HL,(23651)          Clear the calculator stack by copying
1286            LD   (23653),HL          (STKBOT) into (STKEND).
1289            LD   HL,23698            Set (MEM) with the address of the
128C            LD   (23656),HL          MEMBOT area.
128F            LD   HL,23733            One location before the new space is
                                         needed.
1292            LD   BC,58               There are 58 new variables.
1295            RST  #10,CALBAS          Use 'main' ROM 'MAKE_ROOM' to create
1296            DEFW #1655,MAKEROOM      the space.
1297            LD   HL,#12AE,IF1_VARS   Address of 'default values' table.
129B            LD   BC,19               There are 19 default values.
129E            LD   DE,23734            Start of 'new' variables area.
12A1            LDIR                     Store default values.
12A3            LD   A,1                 Set (COPIES) to 1.
12A5            LD   (23791),A
12A8            RET                      Finished.

12A9 VAR_EXIST  RES  1,(IY+124)          Signal 'new variables already exist'.
12AD            RET

THE 'SYSTEM VARS DEFAULT VALUES' TABLE
This table contains the default values of all the 'new' IF1 system variables from FLAGS3
to SER_FL.

12AE IF1_VARS   DEFB #02                 Default for FLAGS3 (bit 1 is set to
                                         signal that the shadow ROM has been
                                         paged in for the first time).
12AF            DEFW #01F0               Default for VECTOR is the IF1's
                                         'ERR_6' address (nonsense for +D).
12B1            LD   HL,#0000            This short subroutine is used to call
12B4            CALL #0000               'main' ROM routines from the IF1 ROM,
12B7            LD   (23738),HL          it isn't used with the +D.
12BA            RET
12BB            DEFW #000C               Default for BAUD, i.e. 9600 baud.
12BD            DEFB #01                 Default for NSTAT.
12BE            DEFB #00                 Default for IOBORD, the colour during
                                         IF1 I/O (black).
12BF            DEFW #0000               Default for SER_FL.

THE 'CALL IF1 SUBROUTINE' SUBROUTINE
This subroutine, called by using 'hook code' 50 (#32), is designed to call IF1
ROM-routines when the 'main' ROM is paged in. The difference with IF1 is that the +D uses
DE to pass the address to be called.

12C1 HOOK_32    EX   DE,HL
12C2            JP   (HL)

THE 'HOOK CODE ERROR' ROUTINE
Whenever an error is encountered in the 'hook code' routines a jump is made here to
signal the error and clear the machine stack when necessary.

12C3 MD_ERROR   CALL #168E,BORD_REST     Restore the border colour.
12C6            LD   HL,(#2066)
12C9            LD   A,H
12CA            OR   L
12CB            JR   Z,#12CE,MD_ERR1     Jump if the stack isn't to be cleared.
12CD            LD   SP,HL               Otherwise clear the stack.
12CE MD_ERR1    XOR  A
12CF            DEC  A
12D0            SCF                      Exit with A holding 255 and Carry flag
12D1            RET                      set.

Previous Next Contents Index