The stream handling routines II
THE 'OPEN TEMP. "D" CHANNEL' CONTINUED
Before the routine continues there are first some 'leftovers' from System 3c.
1374 ADD HL,DE
1375 EX DE,HL
1376 LD HL,(#1E1E)
1379 LD BC,#001E
137C ADD HL,BC
137D LD BC,#0009
1380 LDIR
1382 LD HL,#1FEA
1385 LD BC,#0016
1388 LDIR
Now continue with the 'OPEN a temporary "D" channel' routine.
138A OP_TEMP8 PUSH IX
138C POP DE Start of channel to DE.
138D LD HL,#13B9,D_CH_DATA Start of the "D" channel data.
1390 LD BC,11 Copy the 11 bytes channel data to the
1393 LDIR channel area.
1395 PUSH IX Start of channel to HL.
1397 POP HL
1398 LD DE,(23631) HL-(CHANS)+1 gives the required 'stream
139C OR A offset'.
139D SBC HL,DE
139F INC HL
13A0 RET Finished.
THE 'MAKE ROOM FOR CHANNEL' SUBROUTINE
This small subroutine creates room for a channel at the end of the CHANS area (i.e.
just before the BASIC program).
13A1 CHAN_SPC LD (#13C2),BC Store the length of the channel into
the "D" channel data table.
13A5 LD HL,(23635) Fetch the start address of the channel
13A8 DEC HL ((PROG)-1).
13A9 PUSH HL
13AA PUSH BC
13AB RST #10,CALBAS Create the required space by calling
13AC DEFW #1655,MAKE_ROOM 'main' ROM 'MAKE_ROOM'.
13AE POP BC
13AF POP HL Clear the created space.
13B0 CHAN_SPC1 LD (HL),0
13B2 INC HL
13B3 DEC BC
13B4 LD A,B
13B5 OR C
13B6 JR NZ,#13B0,CHAN_SPC1
13B8 RET
THE '"D" CHANNEL DATA' TABLE
The '11' bytes that compose the initial part of a "D" channel are as follows:
13B9 D_CH_DATA DEFW #0008 Main ROM 'output' routine.
13BB DEFW #0008 Main ROM 'input' routine.
13BD DEFB "D"+128 Channel specifier.
13BE DEFW #150D DISCiPLE system 'output' routine.
13C0 DEFW #148A DISCiPLE system 'input' routine.
13C2 DEFW 551 Length of a (read) channel.
THE 'CLOSE #' COMMAND SYNTAX ROUTINE
Unlike the Interface 1 and the Opus Discovery, the DISCiPLE doesn't page-in in the
middle of the 'main' ROM 'CLOSE' routine. But because the 'main' ROM routine can't
cope with DISCiPLE channels a 'CLOSE' for those channels has to be available. In order
to fail the normal syntax, 'CLOSE #*s' has to be used. The 'CLOSE #*' command closes
all streams.
13C4 CLOSE# RST #28,NEXT_C_RAM Next character.
13C5 CP "*"
13C7 JP NZ,#2920,REP_0 Give an error if it isn't a '*'.
13CA RST #28,NEXT_C_RAM Next character.
13CB CP 13
13CD JR Z,#13E2,CLOSE_#* Jump if statement ended with ENTER.
13CF CP ":"
13D1 JR Z,#13E2,CLOSE_#* Also if statement ended with a ':'.
13D3 CALL #109E,EXPT_#_NR1 Evaluate stream number.
13D6 CALL #0409,ST_END_RAM Confirm end of statement and exit when
syntax checking.
13D9 LD A,(#1E03) Fetch stream number.
13DC CALL #140C,CLOSE_STRM Close the stream.
13DF JP #0419,END Finished.
13E2 CLOSE_#* CALL #0409,ST_END_RAM Confirm end of statement and exit if
13E5 JR #13F4,CLEAR#_R1 syntax checking. Jump into the CLEAR#
routine.
THE 'CLEAR #' COMMAND ROUTINE
All streams are closed in turn, with bit 1 of FLAGS3 set to signal that the remaining
buffer contents are to be erased (with the 'CLOSE #*' command all buffers are emptied,
i.e. their contents are sent to the corresponding device).
13E7 CLEAR# RST #28,NEXT_C_RAM Advance CH_ADD.
13E8 CP "#"
13EA JP NZ,#2920,REP_0 Give an error if it isn't a '#'.
13ED RST #28,NEXT_C_RAM
13EE CALL #0409,ST_END_RAM Confirm end of statement and exit
during syntax checking.
13F1 CALL #09D3,SIGN_SERV Signal 'CLEAR #'.
13F4 CLEAR#_R1 XOR A Start with stream 0.
13F5 CLEAR#_R2 PUSH AF
13F6 CALL #140C,CLOSE_STRM Close this stream.
13F9 POP AF
13FA INC A Next stream.
13FB CP 16 Repeat until all streams 0..15 have
13FD JR C,#13F5,CLEAR#_R2 been CLOSEd.
13FF CALL #11D6,RECL_TEMP Reclaim temporary channels.
1402 XOR A
1403 LD (#1DEF),A Clear 'MAP_USED' (=POKE @6999,0).
1406 LD (#1ACF),A Clear FLAGS3.
1409 JP #0419,END Finished.
THE 'CLOSE A STREAM' SUBROUTINE
Any stream 0 to 15 may be CLOSEd by loading the stream number into A and then calling
this subroutine. The unsent bytes in 'OUTput' files are sent or lost depending upon
whether bit 1 of FLAGS3 is reset or set. First a call to 'STR_DATA1' in the 'main' ROM
is made to fetch into BC the 'stream data' for the given stream, and to make HL point to
the first of the two data bytes.
140C CLOSE_STRM RST #10,CALBAS Call 'STR_DATA1'.
140D DEFW #1727,STR_DATA1
140F LD A,C
1410 OR B Return if the stream is already CLOSEd
1411 RET Z (i.e. stream data = 0).
1412 LD (#1DED),BC Store stream data.
1416 PUSH HL
1417 LD HL,(23631) Make HL point to the start of the
141A DEC HL channel attached to the stream to be
141B ADD HL,BC CLOSEd ((CHANS)+'stream data').
141C EX (SP),HL HL now holds the address of the stream
data.
141D RST #10,CALBAS A call in the middle of the 'main' ROM
141E DEFW #16EB,CLOSE_0 'CLOSE' routine is made to update STRMS
contents.
1420 POP IX IX points to the start of the channel
1422 LD A,B to be removed.
1423 OR C
1424 RET NZ Exit if the stream is one of 0 to 3.
NOTE: Because this test tests for streams a disk channel attached to one of the
streams 0..3 can never be CLOSEd. If the test was made for 'standard' channels it had
been possible to use streams 0..3 with "D" channels.
1425 LD A,(IX+4) Fetch channel specifier.
1428 AND #5F Clear bit 7 (temporary) and make
capital.
142A CP "D"
142C JR NZ,#143C,CLOSE_1 Jump if it isn't a "D" channel.
142E CLOSE_0 BIT 0,(IX+12)
1432 JR Z,#143C,CLOSE_1 Jump if it is an 'INput' channel.
1434 CALL #09FB,TEST_SERV Jump if doing a 'CLEAR #', i.e. just
1437 JR NZ,#143C,CLOSE_1 remove the channel.
1439 CALL #15ED,CL_PATCH Empty the buffer.
143C CLOSE_1 CALL #114C,RECL_CHAN Reclaim the channel.
Now all data refering to the stream attached to the channels moved down are updated.
143F XOR A Start with stream 0.
1440 LD HL,23574 Address of data for stream 0.
1443 CLOSE_2 LD (#1AC8),HL Use 'FILE_ADDR' as a temporary storage.
1446 LD E,(HL) Fetch stream data.
1447 INC HL
1448 LD D,(HL)
1449 LD HL,(#1DED) Fetch stream data for CLOSEd stream.
144C AND A Jump if the stream data found is lower
144D SBC HL,DE than that of the CLOSEd stream (i.e.
144F JR NC,#145C,CLOSE_3 channel has not been moved).
1451 EX DE,HL Fetched stream data to HL.
1452 AND A
1453 SBC HL,BC Calculate the new stream data.
1455 EX DE,HL New stream data to DE.
1456 LD HL,(#1AC8) Restore stream data address.
1459 LD (HL),E Store new stream data.
145A INC HL
145B LD (HL),D
145C CLOSE_3 LD HL,(#1AC8) Make HL point to next stream data.
145F INC HL
1460 INC HL
1461 INC A Increment stream number.
1462 CP 16
1464 JR C,#1443,CLOSE_2 Repeat for all streams 0..15.
1466 RET Finished.
THE 'CLS #' COMMAND ROUTINE
The 'CLS #' command resets during runtime the Spectrum system variables ATTR_P, ATTR_T,
MASK_P, MASK_T, P_FLAG and BORDCR. I.e. all these variables are filled with their
'initial' values (paper 7, ink 0, flash 0 and bright 0).
1467 CLS# RST #28,NEXT_C_RAM Next character.
1468 CP "#"
146A JP NZ,#2920,REP_0 Give error if it isn't a '#'.
146D RST #28,NEXT_C_RAM Next character.
146E CALL #0409,ST_END_RAM Confirm end of statement and exit
during syntax checking.
1471 LD HL,56 The 'initial' attribute value.
1474 LD (23693),HL Store 56 into ATTR_P, clear MASK_P.
1477 LD (23695),HL Store 56 into ATTR_T, clear MASK_T.
147A LD (IY+14),L Store 56 also for lower screen
attribute.
147D LD (IY+87),H Clear P_FLAG.
1480 LD A,7 Set white border.
1482 OUT (254),A
1484 RST #10,CALBAS Call 'main' ROM 'CLS' routine.
1485 DEFW #0D6B,CLS
1487 JP #0419,END Finished.
THE '"D" CHANNEL INPUT' ROUTINE
This is a peculiar routine, although the DISCiPLE supports only one type of channel
(the "D" channel), this routine can handle all kinds of channels by loading HL with the
address of the 'service' input routine and entering at address #1491. From that address
on it's largely the same as the Interface 1 'CALL_INP' routine, which routine handles
all the IF1's channels.
148A D_INPUT LD IX,(23633) IX points to the start of the current
channel (CURCHL).
148E LD HL,#14DC,DCHAN_IN Address of "D" input service routine.
1491 RES 3,(IY+2) Signal 'the mode is to be considered as
being unchanged'.
1495 PUSH HL Store address of service routine.
1496 LD HL,(23613) HL points to error address (ERR_SP).
1499 LD E,(HL) Fetch the error address.
149A INC HL
149B LD D,(HL)
149C AND A
149D LD HL,#107F,ED_ERROR If the error address is 'ED_ERROR'
14A0 SBC HL,DE ('main' ROM) then an INPUT command was
14A2 JR NZ,#14CB,D_INKEY$ used. Jump if unequal to 'ED_ERROR'.
Now deal with an 'INPUT #' command referred to a "D" channel.
14A4 POP HL Restore address of service routine.
14A5 LD SP,(23613) Clear the machine stack (ERR_SP).
14A9 POP DE Remove 'ED_ERROR'.
14AA POP DE
14AB LD (23613),DE Restore the old value of ERR_SP.
14AF D_INPUT1 PUSH HL Store address of service routine.
14B0 LD DE,#14B5,D_INP_END Return address is 'D_INP_END' below.
14B3 PUSH DE
14B4 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.
14B5 D_INP_END JR C,#14BD,D_INP_ACC Jump with acceptable codes.
14B7 JP NZ,#2956,REP_27 Give the 'END of file' error when the
Zero flag is reset.
14BA POP HL Otherwise restore address of service
14BB JR #14AF,D_INPUT1 routine and try again.
14BD D_INP_ACC CP 13
14BF JR Z,#14C7,D_INPUT2 Jump if the code is ENTER.
14C1 RST #10,CALBAS Otherwise the byte is to be added to
14C2 DEFW #0F85,ADD_CHAR0 the INPUT line. This is done by calling
into the 'ADD_CHAR' subroutine.
14C4 POP HL Restore address of service routine and
14C5 JR #14AF,D_INPUT1 read the next byte.
14C7 D_INPUT2 POP HL Drop the address of the service routine
14C8 JP #0050,UNPAGE_1 and page-out the DISCiPLE system.
Now deal with the reading of a single byte.
14CB D_INKEY$ POP HL Restore address of the servce routine.
14CC LD DE,#14D1,D_INK$_END Return address is 'D_INK$_END' below.
14CF PUSH DE
14D0 JP (HL) Jump to the service routine.
14D1 D_INK$_END RET C Return with acceptable codes or
14D2 RET Z with no byte read.
14D3 CALL #0A00,TEST_STEAL Give the 'END of file' error if not
14D6 JP Z,#2956,REP_27 executing a 'MOVE' command.
14D9 OR 1 Otherwise return with Zero and Carry
14DB RET flags both reset.
THE '"D" CHANNEL INPUT' SERVICE ROUTINE
This is the actual input a byte from disk routine. The byte is read from the data buffer
in the channel, when it is empty the next sector is read from disk (provided that the
'current' data block is not the EOF one) before reading the byte.
14DC DCHAN_IN BIT 0,(IX+12) Give 'Reading a WRITE file' error if
14E0 JP NZ,#2944,REP_18 it's an OUTput channel.
14E3 LD A,(IX+31) Decrease LSB of file length.
14E6 SUB 1
14E8 LD (IX+31),A
14EB JR NC,#1505,DCHAN_IN1 Jump if more bytes left.
14ED LD A,(IX+32) Decrease MID byte of file length.
14F0 SUB 1
14F2 LD (IX+32),A
14F5 JR NC,#1505,DCHAN_IN1 Jump if more bytes left.
14F7 LD A,(IX+18) Decrease MSB of file length.
14FA SUB 1
14FC LD (IX+18),A
14FF JR NC,#1505,DCHAN_IN1 Jump if more bytes left.
1501 XOR A Otherwise EOF has been reached, so
reset Zero and Carry flag to signal
'End Of File'.
1502 ADD A,13 The return byte is 13.
1504 RET Finished.
NOTE: This 'end of file' test works only once, if an attempt is made to read more bytes
after the 'End of FILE' message has been given a crash will almost certainly follow.
1505 DCHAN_IN1 CALL #29A2,JLBYT Load one byte, read a new sector from
disk when the buffer is empty.
1508 CALL #297B,JBORD_REST Restore border colour.
150B SCF Signal 'acceptable code'.
150C RET
THE '"D" CHANNEL OUTPUT' ROUTINE
The routine which handles "D" channel output is quite short. It SAVEs the byte in the
A register to disk by calling the ROM 'JSBYT' routine, which handles the saving of the
byte. The only thing done here is incrementing the file length bytes.
150D DCHAN_OUT LD IX,(23633) IX point to current channel (CURCHL).
1511 BIT 0,(IX+12) Give 'Writing a READ file' error if
1515 JP Z,#2946,REP_19 it's an INput channel.
1518 CALL #29C3,JSBYT Save the byte in the A register.
151B CALL #297B,JBORD_REST Restore the border colour.
151E NOP
151F NOP
1520 NOP
1521 NOP
1522 PUSH IX
1524 LD BC,229
1527 ADD IX,BC IX now points to the file header.
1529 INC (IX+2) Update file length, skip higher bytes
152C JR NZ,#1536,DCHAN_OUT1 if it isn't necessary to update them.
152E INC (IX+3)
1531 JR NZ,#1536,DCHAN_OUT1
1533 INC (IX+0)
1536 DCHAN_OUT1 POP IX
1538 RET Finished.