.........1.........2.........3.........4.........5.........6.........7.........8 STREAMS AND CHANNELS by Toni Baker part 5 of 5, ZX Computing April 1987 This month, Toni Baker opens up a new channel to the 128's RAMdisc facility. [Note that the code in STREAMS.TAP "PART5"] [includes the code from "PART4". JimG] This is the final part in the Streams and Channels series, and this is an article for people who own either a Spectrum 128 or a Spectrum 128+2. This month's new channel introduces SERIAL FILES to the 128K machines. People who have Interface Ones and Microdrives will already be used to serial files on microdrive cartridge. In this case you open a microdrive file either as a READ file (if the file already exists on microdrive) or a WRITE file (in which case the file must be created on microdrive). You can print text to a WRITE file, and then CLOSE and OPEN it (so that it becomes a READ file) and you may then input your text as either strings or numbers into a BASIC variable. RAMdisc RAMdisc files work in exactly the same way, except that you don't need an Interface One. When you first OPEN a RAMdisc file for writing, a file with a given name is created on the Spectrum's so-called "silicon disc". Text or numbers may then be printed into this file. Once the channel is closed no more printing to the file is possible. The file may, however, be re-OPENed as a read file, in which case whatever is in the file may be input into a BASIC variable. As with microdrive files, RAMdisc files must be CLOSEd once all the data has been printed to, or input from, the file. If a WRITE file is not closed then some or all of the data may be lost, as it will not be cleared from a special buffer. If a READ file is not closed then the consequences are less serious, however, each RAMdisc channel requires more than 1/2K, which may only be reclaimed by closing the file. You should always close such a file once you have finished with it. Once a file has been opened, it will appear in the RAMdisc catalogue, which you can verify by typing CAT! in BASIC. It is impossible to LOAD a RAMdisc serial file using a LOAD command, however it Is possible to ERASE a RAMdisc serial file in the usual manner, by entering ERASE! "filename". You should never ERASE a RAMdisc serial file which is still in use (ie. which still has a stream attached to it). The machine code program does in fact protect itself from this eventually, so such an error would not be fatal - however, you will certainly get spurious results if you break this rule. Silicon disc The key to how the machine code program works is the manipulation of the memory organisation known as the silicon disc, or RAMdisc, which is normally used to save programs, data, or machine code for as long as the machine is switched on. RAMdisc files are much faster than microdrive files, but the whole of RAMdisc is erased when the machine is switched off. RAMdisc serial files will, of course, suffer from precisely these advantages and disadvantages. The RAMdisc memory itself is primarily organised by the CATALOGUE, which is an index to all files saved in RAMdisc. The CATALOGUE resides in RAM page seven. It is effectively a stack, which begins at address 7EBFF and grows downwards, with each entry taking twenty bytes. Figure Two shows the meanings of these twenty bytes, with IX pointing to the first of these bytes. At the end of the catalogue stack is a twenty byte "End of catalogue" marker, only three bytes of which are used. The system variable (SFNEXT) points to this marker, and is effectively the stack-pointer for this catalogue stack. So long as we keep the catalogue in its required format, we can manipulate the RAMdisc organisation itself from machine code. This is the aim of this issue's program. The RAMdisc files themselves begin in RAM page 1, and grow upwards through RAM pages 3, 4, 6 and 7 (care is taken to ensure that RAMdisc files do not collide with the catalogue stack). To avoid any problems with this strange page- numbering, all addresses in RAMdisc are "page-coded". This means that one register will hold a page-code, while another register-pair will hold an actual physical address. These page codes are 0, 1, 2, 3 and 4 sequentially for RAMdisc files, with page-code 5 being the conventional notation for normal (48K) RAM. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 1 R CHANNEL INFORMATION BLOCK --------------------------- IX+00 R_OUT Address of RAMdisc file output routine (=B92B) IX+02 R_IN Address of RAMdisc file input routine (=B7D4) IX+04 R_NAME Name of channel (="R") IX+05 R_IDEN New channel identifier (=1234h) IX+07 R_CLOSE Address of RAMdisc file close routine (=B960) IX+09 R_LEN Length of channel information block (=021B) IX+0B R_CHBYTE Pointer into buffer IX+0D R_CHREC Record number within file IX+0E R_CHNAME File name IX+18 R_CHFLAG Various flags, defined as follows: Bits 7 to 2: Not used Bit 1: Set if End-Of-File at end of record, reset otherwise Bit 0: Reset for a READ file, set for a WRITE file IX+19 R_RECLEN Length of record within buffer IX+1B R_BUFFER Buffer storing current record - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 2 CATALOGUE INDEX INFORMATION --------------------------- IX+00 SF_NAME File name IX+0A SF_START Page-coded address of start of file IX+0D SF_LEN Total number of bytes in file, including header info IX+10 SF_END Page-coded address of byte beyond end of file IX+13 SF_FLAG Reset unless catalogue information incomplete (ie. reset normally) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Channel "R" We shall call our new channel "R", which stands for RAMdisc serial file. This is not to be confused with the ROM's internal "R" channel, which is used for inserting bytes into normal (48K) dynamic RAM. Internal-channel-"R" is quite interesting in fact. It is permanently attached to stream minus-one, so to use it from machine code all you have to do is select stream minus-one as the current stream (by loading A with FF and calling address 1601h). It is impossible to use from BASIC. Prior to selecting stream minus-one the system variable K_CUR must be made to point somewhere into dynamic RAM. Printing to stream FF will then insert characters into dynamic memory at the point indicated by (K_CUR). Our new channel is also called "R", but its use is much more exciting - and of course it MAY be used from BASIC. We require a channel information block over 1/2K in size. Most of this is in fact a huge 0200h byte buffer. For reasons of speed, the buffer is used most of the time, with RAMdisc itself only being accessed once the end of the buffer is reached. It is of course important to realise that the location of a RAMdisc file is not constant - it may move either if another file is erased, or if more bytes are inserted into another RAMdisc serial file. This means that the file has to be relocated every time we wish to read or write into it. To save time we make use of a temporary buffer virtually all of the time. Figure One shows the actual organisation of the channel information block for our R channel. Note that R_CHREC, R_RECLEN, and bit one of R_CHFLAG are used only if the file is a READ file. The remaining variables are used for both types of file. To interface with BASIC, an example machine code program is appended to the end. Essentially, a RAMdisc serial file may be opened by loading the A register with the stream number of the stream to be opened, whilst the actual filename is stored in the system variable N_STR1 at address 5B67, and then calling the label R_OPEN. Four additional entry points are included, labelled OPEN_4, OPEN_5, CLOSE_4 and CLOSE_5. Calling OPEN_4 will open a RAMdisc serial file called "FILE1" and attach it to stream four. Similarly, calling OPEN_5 will open a RAMdisc serial file called "FILE2" and attach it to stream five. The routines CLOSE_4 and CLOSE_5 will of course close these new channels. This means that the new channel may easily be used in BASIC. Take a look at Figure Three. It contains a BASIC program which demonstrates the RAMdisc serial files at work, first as WRITE files, then as READ files. Try it - you may be surprised at how fast it all works. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 3 1000 REM WRITE FILE DEMO 1010 RANDOMIZE USR 47713: REM OPEN #4,"R_FILE1" 1020 RANDOMIZE USR 47720: REM OPEN #5,"R_FILE2" 1030 FOR i=1 TO 512 1040 INPUT "": PRINT i 1050 PRINT #4;2*i 1060 PRINT #5;i*i 1070 NEXT i 1080 RANDOMIZE USR 47736: REM CLOSE #4 1090 RANDOMIZE USR 47740: REM CLOSE #5 1100 REM READ FILE DEMO 1110 RANDOMIZE USR 47713: REM OPEN #4,"R_FILE1" 1120 RANDOMIZE USR 47720: REM OPEN #5,"R_FILE2" 1130 FOR i=1 TO 512 1140 INPUT #4;a 1150 INPUT #5;b 1160 PRINT a,b 1170 NEXT i 1180 RANDOMIZE USR 47736: REM CLOSE #4 1190 RANDOMIZE USR 47740: REM CLOSE #5 1200 STOP - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Of course you won't always want your files to be called "FILE1" or "FILE2'; and you won't always want to use streams four or five. That is why the more general entry point R_OPEN is included, which, as has already been stated, requires that A contains the stream number, and (N_STR1) contains the filename (with trailing spaces if required). You will have to write your own machine code to patch any other combination into BASIC, utilising this routine. The potential for streams and channels is limitless. It is theoretically possible, for instance, to have a channel which utilises a RANDOM ACCESS FILE, or INDEXED FILE, in RAMdisc - though the program would have to be much more complicated. I have shown you enough of the potential use for streams and channels to whet your appetite a little, and there I shall leave you. If demand is high enough, I may return with more. Good programming everyone, and may the force be with you. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ERRATUM In OPEN_NEW at address B06D (Streams and Channels Part Two, January Issue, page 68) there is an instruction missing. The instruction is POP BC (hex code C1). It should be the eleventh instruction of the routine, occurring between OR C and JR Z,OPEN_NEW_2. Sorry about that. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The following are vectored routines in the Spectrum's ROM 0. Notice that there are two alternative such vector tables, one for the Spectrum 128 and one for the 128+2. This is because the two machines have different ROMs. If the ROM of the 128+2 is changed at some indefinite point in the future, then it will be necessary to rewrite this table further. (Spectrum 128 only) B6FC C3AC05 V_ERROR JP #05AC ;Generate an error report B6FF C3641C V_PAGE JP #1C64 ;Change current RAM page B702 C3971C V_NEWCAT JP #1C97 ;Create new entry in catalogue B705 C3F31C V_SPACE JP #1CF3 ;Ensure enough space in RAMdisc area B708 C3121D V_FIND JP #1D12 ;Find catalogue entry for filename B70B C3561D V_CATEND JP #1D56 ;Tidy up last catalogue entry (Spectrum 128+2 only) B6FC C3AC05 V_ERROR JP #05CB ;Generate an error report B6FF C3641C V_PAGE JP #1C83 ;Change current RAM page B702 C3971C V_NEWCAT JP #1CB6 ;Create new entry in catalogue B705 C3F31C V_SPACE JP #1D12 ;Ensure enough space in RAMdisc area B708 C3121D V_FIND JP #1D31 ;Find catalogue entry for filename B70B C3561D V_CATEND JP #1D75 ;Tidy up last catalogue entry The rest of the program will be the same, whichever version of the Spectrum you have. The following subroutine will decrement a page-coded address held in register triplet BHL. B70E 2B DEC_BHL DEC HL ;Decrement HL B70F 78 LD A,B ;A= page code B710 FE05 CP #05 B712 C8 RET Z ;Return if using standard RAM B713 CB74 BIT 6,H B715 C0 RET NZ ;Return unless HL has crossed ;a page boundary B716 CBF4 SET 6,H ;Correct address in HL B718 05 DEC B ;Decrement page code B719 C9 RET ;Return The following subroutine works a bit like a glorified LDDR instruction, which works in RAMdisc area as well as in standard memory. Its action is threefold: (1) Decrement BHL and BHL'; (2) Load one byte from address (BHL) to address (BHL'); (3) If BHL is not equal to CDE then go to step (1). B71A CD0EB7 RTRANSFER CALL DEC_BHL ;Decrement page-coded address in BHL B71D D9 EXX B71E CD0EB7 CALL DEC_BHL ;Decrement page-coded address in BHL' B721 D9 EXX B722 78 LD A,B ;A= paging code of FROM address B723 CDFFB6 CALL V_PAGE ;Page in the FROM memory page B726 7E LD A,(HL) ;A= byte to load B727 F5 PUSH AF ;Stack this byte B728 D9 EXX B729 78 LD A,B ;A= paging code of TO address B72A CDFFB6 CALL V_PAGE ;Page in the TO memory page B72D F1 POP AF ;A= byte to load B72E 77 LD (HL),A ;Load byte into memory as required B72F D9 EXX B730 78 RTRANSFE2 LD A,B ;A= paging code of FROM address B731 B9 CP C B732 20E6 JR NZ,RTRANSFER ;Loop back if not equal to the paging ;code of the limiting address B734 ED52 SBC HL,DE ;Set Zero flag if address = limit B736 19 ADD HL,DE ;(ADD HL,DE doesn't affect Zero flag) B737 20E1 JR NZ,RTRANSFER ;Loop back unless limit has been ;reached B739 C9 RET ;Return The next subroutine will calculate the page-coded address which is BC bytes further on from AHL. It assumes that BC is always less than 4000h. B73A 09 ADD_HL_BC ADD HL,BC ;Increment HL by BC bytes B73B FE05 CP #05 B73D C8 RET Z ;Return if using standard RAM B73E CB74 BIT 6,H B740 C0 RET NZ ;Return unless page boundary crossed B741 CBFC SET 7,H B743 CBF4 SET 6,H ;Correct address in HL B745 3C INC A ;Increment page code B746 C9 RET ;Return This subroutine will search for the file whose name is specified in the channel information area, in the RAMdisc catalogue, giving an error if the file does not exist. On exit IX will point to the catalogue entry. B747 DDE5 FIND_FILE PUSH IX B749 E1 POP HL ;HL points to channel information B74A 010E00 LD BC,#000E B74D 09 ADD HL,BC ;HL points to filename B74E 0E0A LD C,#0A ;BC= length of filename (ten) B750 11675B LD DE,N_STR1 ;DE points to system variable B753 EDB0 LDIR ;Copy filename into system variable B755 CD08B7 CALL V_FIND ;Find catalogue entry for this name B758 C0 RET NZ ;Return if file exists, with IX ;pointing to catalogue entry B759 CDFCB6 CALL V_ERROR ;Generate error message B75C 23 DEFB #23 ;"h File does not exist" The next subroutine is designed to match up the buffer for R-channel with the corresponding region of RAMdisc memory. The subroutine will leave BHL pointing to the first byte beyond the RAMdisc segment, CDE pointing to the start of the RAMdisc segment, and BHL' pointing to the first byte beyond the corresponding region in the R-channel buffer. It will also signal whether or not this is an end-of-file block. It requires that IX initially points to the channel information block. B75D DDE5 R_MATCH PUSH IX ;Stack channel info address B75F DD7E0D LD A,(R_CHREC) B762 F5 PUSH AF ;Stack record number to match B763 CD47B7 CALL FIND_FILE ;IX points to catalogue entry B766 C1 POP BC ;B= record number B767 CB20 SLA B ;B= record number x 2 B769 0E01 LD C,#01 ;BC= 200h * record number + 1 B76B 37 SCF B76C 08 EX AF,AF' ;Signal "End of file block" B76D DD6E0D LD L,(SF_LEN) B770 DD660E LD H,(SF_LEN+1) B773 DD7E0F LD A,(SF_LEN+2) ;AHL= length of file (17 bit) B776 A7 AND A B777 ED42 SBC HL,BC B779 DE00 SBC A,#00 ;AHL= length of remainder of file B77B A7 AND A B77C 2008 JR NZ,RM_NO_EOF ;Jump if high part of AHL is non-zero B77E 110102 LD DE,#0201 B781 ED52 SBC HL,DE B783 19 ADD HL,DE B784 3804 JR C,RM_EOF ;Jump if AHL less than 0201h B786 210002 RM_NO_EOF LD HL,#0200 ;HL= length of record (0200h max) B789 08 EX AF,AF' ;Signal "Not end of file block" B78A EB RM_EOF EX DE,HL ;DE= length of record B78B DD6E0A LD L,(SF_START) B78E DD660B LD H,(SF_START+1) B791 DD7E0C LD A,(SF_START+2);AHL= coded addr of start of file B794 CD3AB7 CALL ADD_HL_BC ;AHL= coded addr of RAMdisc segment B797 C5 PUSH BC ;Stack 200h * record number + 1 B798 D5 PUSH DE ;Stack length of record B799 E5 PUSH HL B79A F5 PUSH AF ;Stack page-coded address of segment B79B 42 LD B,D B79C 4B LD C,E ;BC= length of record B79D CD3AB7 CALL ADD_HL_BC ;AHL= page-coded address of byte ;following RAMdisc segment B7A0 47 LD B,A ;BHL= this address B7A1 F1 POP AF B7A2 4F LD C,A B7A3 D1 POP DE ;CDE= page-coded address of segment B7A4 D9 EXX ;Use alternative registers B7A5 D1 POP DE ;DE'= length of record B7A6 C1 POP BC ;BC'= 200h * record number + 1 B7A7 DDE1 POP IX ;IX points to channel info area B7A9 DD7319 LD (R_RECLEN),E B7AC DD721A LD (R_RECLEN+1),D;Store length of record B7AF DDE5 PUSH IX B7B1 E1 POP HL ;HL' points to channel information B7B2 011B00 LD BC,#001B B7B5 09 ADD HL,BC ;HL' points to the R-channel buffer B7B6 19 ADD HL,DE ;HL' points to byte following ;current record B7B7 0605 LD B,#05 ;B'= 05, signalling "Standard RAM" B7B9 D9 EXX ;Use normal registers B7BA DDCB188E RES 1,(R_CHFLAG) ;Signal "Not end of file block" B7BE 08 EX AF,AF' B7BF D0 RET NC ;Return unless end of file block B7C0 DDCB18CE SET 1,(R_CHFLAG) ;Signal "End of file block" B7C4 C9 RET ;Return This subroutine actually assigns the R-channel buffer in preparation for use with a READ channel. Note that it calls the RTRANSFER subroutine from label RTRANSFE2 in order to deal with the zero case, when the buffer is to be considered empty. B7C5 CD5DB7 R_ASSIGN CALL R_MATCH ;Match buffer with RAMdisc segment B7C8 CD30B7 CALL RTRANSFE2 ;Copy bytes into buffer B7CB DD360B00 RBUFFEXIT LD (R_CHBYTE),#00 B7CF DD360C00 LD (R_CHBYTE+1),#00 ;Reset pointer into buffer B7D3 C9 RET ;Return There now follows the INPUT routine for channel R. It isolates INPUT from INKEY$ and deals with each accordingly. B7D4 2A3D5C R_INPUT LD HL,(ERR_SP) ;HL points to error return address B7D7 5E LD E,(HL) B7D8 23 INC HL B7D9 56 LD D,(HL) ;DE= error return address B7DA 217F10 LD HL,ED_ERROR B7DD A7 AND A B7DE ED52 SBC HL,DE B7E0 2021 JR NZ,R_INKEY ;Jump if dealing with INKEY$ B7E2 ED7B3D5C LD SP,(ERR_SP) ;Clear machine stack as far as ;return from EDITOR routine B7E6 E1 POP HL B7E7 E1 POP HL B7E8 223D5C LD (ERR_SP),HL ;Restore normal error return address B7EB CD03B8 R_INPLOOP CALL R_INKEY ;Input a single character into A B7EE FE0D CP #0D B7F0 C8 RET Z ;Return if character is "enter" B7F1 FDCB377E BIT 7,(FLAG_X) B7F5 2007 JR NZ,R_INPUT_2 ;Jump if doing INPUT LINE B7F7 FE22 CP #22 B7F9 2003 JR NZ,R_INPUT_2 ;Jump unless character is "quotes" B7FB CD850F CALL ADD_CHAR_1 ;Register quotes twice B7FE CD850F R_INPUT_2 CALL ADD_CHAR_1 ;Insert character into INPUT area B801 18E8 JR R_INPLOOP ;Loop back to input rest of string The following routine inputs a single character from an R-channel and returns it in the A register. B803 CD005B R_INKEY CALL SWAP ;Page in ROM 0 B806 2A5A5B LD HL,(RETADDR) B809 E5 PUSH HL ;Stack return address in ROM 0 B80A D9 EXX B80B C5 PUSH BC B80C D5 PUSH DE B80D E5 PUSH HL ;Stack alternative register set B80E DD2A515C LD IX,(CURCHL) ;IX points to channel information B812 DDCB1846 BIT 0,(R_CHFLAG) B816 2804 JR Z,R_INKEY_2 ;Jump if this is a READ file B818 CDFCB6 R_ERROR CALL V_ERROR ;Generate report code B81B 1D DEFB #1D ;"b Wrong file type" B81C DD5E0B R_INKEY_2 LD E,(R_CHBYTE) B81F DD560C LD D,(R_CHBYTE+1);DE= position of next byte to read B822 DDCB184E BIT 1,(R_CHFLAG) B826 280F JR Z,RINKYREAD ;Jump unless this is an EOF block B828 DD6E19 LD L,(R_RECLEN) B82B DD661A LD H,(R_RECLEN+1);HL= length of current record B82E A7 AND A B82F ED52 SBC HL,DE B831 2004 JR NZ,RINKYREAD ;Jump unless we have reached the ;end of the (EOF) record B833 CDFCB6 CALL V_ERROR ;Generate error report B836 07 DEFB #07 ;"8 End of file" B837 DDE5 RINKYREAD PUSH IX B839 E1 POP HL ;HL points to channel information B83A 011B00 LD BC,#001B B83D 09 ADD HL,BC ;HL points to buffer B83E 19 ADD HL,DE ;HL points to next byte to read B83F 7E LD A,(HL) ;A= byte which INKEY$ must return B840 F5 PUSH AF B841 13 INC DE ;Increment pointer B842 DD730B LD (R_CHBYTE),E B845 DD720C LD (R_CHBYTE+1),D;Store incremented pointer B848 15 DEC D B849 15 DEC D B84A 2006 JR NZ,RINKYEXIT ;Jump unless buffer to be renewed B84C DD340D INC (R_CHREC) ;Increment record number B84F CDC5B7 CALL R_ASSIGN ;Assign and reset buffer B852 F1 RINKYEXIT POP AF ;A= byte just read from buffer B853 37 SCF ;Set Carry, so that INKEY$ # works ;properly B854 E1 RINOUEXIT POP HL B855 D1 POP DE B856 C1 POP BC B857 D9 EXX ;Restore alternative registers B858 E1 R_EXIT POP HL ;HL= return address into ROM 0 B859 225A5B LD (RETADDR),HL ;Store in system variable B85C C3005B JP SWAP ;Page in ROM 1 and return The next subroutine is designed to insert additional bytes into an already existing file stored in RAMdisc. Any files which need to be moved in order to make room for these extra bytes will be so moved, and re-indexed to accomodate. The subroutine should be entered with AHL containing the page-coded address at which to insert the bytes, and BC containing the number of bytes to insert. B85F C5 RMAKEROOM PUSH BC ;Stack number of bytes to insert B860 E5 PUSH HL B861 F5 PUSH AF ;Stack page-coded address at ;which to insert B862 AF XOR A ;A= 00, Carry flag reset B863 67 LD H,A B864 6F LD L,A ;AHL= zero B865 ED42 SBC HL,BC B867 9F SBC A,A ;AHL= minus no. of bytes to insert B868 CD05B7 CALL V_SPACE ;Ensure enough room for extra bytes B86B F1 POP AF B86C E1 POP HL ;AHL= address at which to insert B86D C1 POP BC ;BC= number of bytes to insert B86E C5 PUSH BC B86F E5 PUSH HL B870 F5 PUSH AF B871 3E04 LD A,#04 B873 CDFFB6 CALL V_PAGE ;Select page containing catalogue B876 DD2A835B LD IX,(SF_NEXT) ;IX points to "End of cat" index B87A DD6E0A LD L,(SF_START) B87D DD660B LD H,(SF_START+1) B880 DD7E0C LD A,(SF_START+2);AHL= page-coded address of first ;spare byte in RAMdisc area B883 F5 PUSH AF B884 E5 PUSH HL ;Stack this address B885 CD3AB7 CALL ADD_HL_BC ;AHL= page-coded address of first ;RAMdisc byte which will remain spare ;after more bytes are inserted B888 47 LD B,A ;BHL= this address B889 D9 EXX ;BHL'= this address B88A E1 POP HL B88B C1 POP BC ;BHL points to 1st spare byte (old) B88C F1 POP AF B88D D1 POP DE ;ADE= address at which to insert B88E 4F LD C,A ;CDE= address at which to insert B88F D5 PUSH DE B890 F5 PUSH AF ;Stack this address B891 CD30B7 CALL RTRANSFE2 ;Move bytes which need to be moved B894 3E04 LD A,#04 B896 CDFFB6 CALL V_PAGE ;Select page containing catalogue B899 C1 POP BC B89A D1 POP DE ;BDE= position of insertion B89B DD6E0A R_MR_LOOP LD L,(SF_START) ;AHL= previous page-coded address of B89E DD660B LD H,(SF_START+1);a RAMdisc file (or next spare byte) B8A1 DD7E0C LD A,(SF_START+2);which may have been moved B8A4 B8 CP B B8A5 382E JR C,R_MRFOUND ;Jump if file address precedes ;point of insertion B8A7 ED52 SBC HL,DE B8A9 19 ADD HL,DE B8AA 3829 JR C,R_MRFOUND ;Jump if file address precedes ;point of insertion B8AC EB EX DE,HL B8AD E3 EX (SP),HL B8AE EB EX DE,HL ;DE= number of bytes inserted B8AF 19 ADD HL,DE B8B0 3005 JR NC,R_MR_ADDR B8B2 CBFC SET 7,H B8B4 CBF4 SET 6,H B8B6 3C INC A ;AHL= new address of file B8B7 EB R_MR_ADDR EX DE,HL B8B8 E3 EX (SP),HL B8B9 EB EX DE,HL ;BDE= position of insertion B8BA DD750A LD (SF_START),L B8BD DD740B LD (SF_START+1),H B8C0 DD770C LD (SF_START+2),A;Store new start address of file B8C3 C5 PUSH BC B8C4 011400 LD BC,#0014 B8C7 DD09 ADD IX,BC ;IX points to index for next file B8C9 C1 POP BC ;BDE= position of insertion B8CA DD7510 LD (SF_END),L B8CD DD7411 LD (SF_END+1),H B8D0 DD7712 LD (SF_END+2),A ;Store new address for next file B8D3 18C6 JR R_MR_LOOP ;Loop back to deal with this file B8D5 DD6E0D R_MRFOUND LD L,(SF_LEN) B8D8 DD660E LD H,(SF_LEN+1) B8DB DD7E0F LD A,(SF_LEN+2) ;AHL= previous length of file B8DE EB EX DE,HL B8DF E3 EX (SP),HL B8E0 EB EX DE,HL ;DE= number of bytes inserted B8E1 19 ADD HL,DE B8E2 CE00 ADC A,#00 ;AHL= new length of file B8E4 DD750D LD (SF_LEN),L B8E7 DD740E LD (SF_LEN+1),H B8EA DD770F LD (SF_LEN+2),A ;Store new length of file B8ED 78 LD A,B ;A= page-code of point of insertion B8EE 42 LD B,D B8EF 4B LD C,E ;BC= number of bytes inserted B8F0 E1 POP HL ;AHL= page-coded address of point ;at which bytes were inserted B8F1 C9 RET ;Return The following subroutine will transfer the contents of the R-channel buffer into the corresponding RAMdisc file. B8F2 DD4E0B R_STORE LD C,(R_CHBYTE) B8F5 DD460C LD B,(R_CHBYTE+1);BC= number of bytes in buffer B8F8 DDE5 PUSH IX ;Stack address of R-channel info B8FA C5 PUSH BC ;Stack number of bytes in buffer B8FB CD47B7 CALL FIND_FILE ;IX points to file entry in cat. B8FE C1 POP BC ;BC= number of bytes in buffer B8FF DD6E10 LD L,(SF_END) B902 DD6611 LD H,(SF_END+1) B905 DD7E12 LD A,(SF_END+2) ;AHL= page-coded address of first ;byte beyond end of file B908 CD5FB8 CALL RMAKEROOM ;Insert enough room for contents ;of buffer B90B DDE1 POP IX ;IX points to channel information B90D CD3AB7 CALL ADD_HL_BC ;AHL points one byte beyond the ;last of the new bytes B910 C5 PUSH BC ;Stack number of bytes in buffer B911 47 LD B,A ;BHL= address of last new byte + 1 B912 D9 EXX ;BHL'= address of last new byte + 1 B913 DDE5 PUSH IX B915 E1 POP HL ;HL= address of channel information B916 011B00 LD BC,#001B B919 09 ADD HL,BC ;HL points to start of buffer B91A C1 POP BC ;BC= number of bytes in buffer B91B E5 PUSH HL ;Stack address of start of buffer B91C 09 ADD HL,BC ;HL points to byte beyond buffer B91D D1 POP DE ;DE points to start of buffer B91E 010505 LD BC,#0505 ;BHL and CDE now page-coded addresses B921 CD30B7 CALL RTRANSFE2 ;Copy buffer into RAMdisc area B924 78 LD A,B ;A= 05 B925 CDFFB6 CALL V_PAGE ;Page in normal RAM B928 C3CBB7 JP RBUFFEXIT ;Reset pointer into buffer and return Now comes the output routine, whose job it is to print the character stored in the A register to an R channel (ie. to store it firstly in the buffer, and ultimately in a RAMdisc file). B92B CD005B R_PRINT CALL SWAP ;Page in ROM 0 B92E 2A5A5B LD HL,(RETADDR) B931 E5 PUSH HL ;Stack return address into ROM 0 B932 D9 EXX B933 C5 PUSH BC B934 D5 PUSH DE B935 E5 PUSH HL ;Stack alternative register set B936 DD2A515C LD IX,(CURCHL) ;IX points to channel information B93A DDCB1846 BIT 0,(R_CHFLAG) B93E CA18B8 JP Z,R_ERROR ;Error if this is a READ file B941 DD5E0B LD E,(R_CHBYTE) B944 DD560C LD D,(R_CHBYTE+1);DE= number of bytes in buffer B947 DDE5 PUSH IX B949 E1 POP HL ;HL points to channel information B94A 011B00 LD BC,#001B B94D 09 ADD HL,BC ;HL points to start of buffer B94E 19 ADD HL,DE ;HL points to next spare byte B94F 77 LD (HL),A ;Store byte in buffer B950 13 INC DE ;DE= new number of bytes in buffer B951 DD730B LD (R_CHBYTE),E B954 DD720C LD (R_CHBYTE+1),D;Store new number of chars in buffer B957 15 DEC D B958 15 DEC D B959 CCF2B8 CALL Z,R_STORE ;If buffer is now full, then empty ;contents into RAMdisc file B95C A7 AND A ;Reset Carry B95D C354B8 JP RINOUEXIIT ;Jump to exit routine Next we have the routine to CLOSE an R channel. All that is necessary is that the buffer contents be ignored (READ file) or stored in RAMdisc (WRITE file). B960 CD005B R_CLOSE CALL SWAP ;Page in ROM 0 B963 2A5A5B LD HL,(RETADDR) B966 E5 PUSH HL ;Stack return address into ROM 0 B967 DDE5 PUSH IX ;Stack pointer to channel info B969 2A3D5C LD HL,(ERR_SP) ;HL points to error return address B96C E5 PUSH HL ;Stack this pointer B96D 21FEFF LD HL,#FFFE B970 39 ADD HL,SP ;HL= SP minus two B971 223D5C LD (ERR_SP),HL ;Set new error return address B974 DDCB1846 BIT 0,(R_CHFLAG) B978 C4F2B8 CALL NZ,R_STORE ;If this is a WRITE file, then empty ;buffer contents into RAMdisc B97B E1 POP HL ;NOTE: This is also the return point ;from any errors that may have ;occurred during R_STORE B97C 223D5C LD (ERR_SP),HL ;Restore error pointer to normal B97F DDE1 POP IX ;Restore channel info pointer B981 215827 R_OC_EXIT LD HL,#2758 B984 D9 EXX ;HL'= 2758 to prevent crash B985 C358B8 JP R_EXIT ;Jump to exit routine At last we have the routine to OPEN an R channel. On entry the A register must contain the stream number to which the channel is to be attached, and the 10- byte system variable N_STR1 must contain the filename of the READ or WRITE file to be opened. If the filename is less than 10 characters long then it should be followed by trailing spaces. B988 CD005B R_OPEN CALL SWAP ;Page in ROM 0 B98B 2A5A5B LD HL,(RETTADDR) B98E E5 PUSH HL ;Stack return address into ROM 0 B98F F5 PUSH AF ;Stack stream number B990 3E52 LD A,"R" ;A= name of this channel ("R") B992 CD94B5 CALL SEARCHALL ;Search for an existing R channel B995 381F JR C,R_OP_OK ;Jump if none found B997 DDE5 R_OP_LOOP PUSH IX B999 E1 POP HL ;HL points to channel information ;for already existing R channel B99A 010E00 LD BC,#000E B99D 09 ADD HL,BC ;HL points to filename for ;already existing R channel B99E 11675B LD DE,N_STR1 ;DE points to intended filename ;for this channel B9A1 060A LD B,#0A ;B= length of filename B9A3 1A R_OP_NAME LD A,(DE) B9A4 13 INC DE B9A5 BE CP (HL) B9A6 23 INC HL B9A7 2006 JR NZ,#R_OPRETRY ;Jump if filenames are different B9A9 10F8 DJNZ R_OP_NAME ;Test all 10 characters of filename. ;If filenames are identical then B9AB CDFCB6 R_OPERROR CALL V_ERROR ;generate error report B9AE 20 DEFB #20 ;"e File already exists" B9AF 1652 R_OPRETRY LD D,"R" ;D= name of this channel ("R") B9B1 CDAAB5 CALL SEARCHNXT ;Search for next existing R channel B9B4 30E1 JR NC,R_OP_LOOP ;Loop back if one found B9B6 CD08B7 R_OP_OK CALL V_FIND ;Search for RAMdisc file with ;given name B9B9 F5 PUSH AF ;Stack the Zero flag B9BA 2811 JR Z,R_OP_CONT ;Jump if no file found (ie. if this ;is to be a WRITE file) B9BC DD6E0A LD L,(SF_START) B9BF DD660B LD H,(SF_START+1) ;[The next line was incorrectly printed as DD7E0B in the magazine. JimG] B9C2 DD7E0C LD A,(SF_START+2);AHL= page-coded address of file ;with given name B9C5 CDFFB6 CALL V_PAGE ;Select page containing first byte ;of this file B9C8 7E LD A,(HL) ;A= type-of-file code B9C9 FE04 CP #04 B9CB 20DE JR NZ,R_OPERROR ;Give error unless a READ file B9CD 3E05 R_OP_CONT LD A,#05 B9CF CDFFB6 CALL V_PAGE ;Page in normal RAM B9D2 F1 POP AF ;Retrieve Zero flag B9D3 08 EX AF,AF' ;Store in A' B9D4 F1 POP AF ;A= stream number B9D5 08 EX AF,AF' ;A'= stream number B9D6 F5 PUSH AF ;Stack the Zero flag, which determines ;whether this is a READ or WRITE file B9D7 3E52 LD A,"R" ;A= name of this channel ("R") B9D9 011B02 LD BC,#021B ;BC= length of channel info block B9DC 11D4B7 LD DE,R_INPUT ;DE= address of input routine B9DF 212BB9 LD HL,R_PRINT ;HL= address of output routine B9E2 DD2160B9 LD IX,R_CLOSE ;IX= address of close routine B9E6 EF RST #28 B9E7 6DB0 DEFW #B06D,OPEN_NEW;Create channel information block B9E9 DDE5 PUSH IX B9EB E1 POP HL ;HL points to channel information B9EC 010B00 LD BC,#000B B9EF 09 ADD HL,BC ;HL points to variable R_CHBYTE B9F0 70 LD (HL),B B9F1 23 INC HL B9F2 70 LD (HL),B ;Reset R_CHBYTE B9F3 23 INC HL B9F4 70 LD (HL),B ;Reset R_CHREC B9F5 23 INC HL B9F6 EB EX DE,HL ;DE points to R_CHNAME B9F7 21675B LD HL,N_STR1 ;HL points to filename given B9FA 0E0A LD C,#0A ;DE= length of filename (ten) B9FC EDB0 LDIR ;Copy filename into channel info B9FE F1 POP AF ;Retrieve Zero flag B9FF 2809 JR Z,R_OPWRITE ;Jump if this is to be a WRITE file BA01 DDCB1886 RES 0,(R_CHFLAG) ;Signal "This is a READ file" BA05 CDC5B7 CALL R_ASSIGN ;Assign buffer from RAMdisc file BA08 1840 JR R_OP_EXIT ;Jump to exit routine BA0A DDCB18C6 R_OPWRITE SET 0,(R_CHFLAG) ;Signal "This is a WRITE file" BA0E CD02B7 CALL V_NEWCAT ;Create new catalogue entry BA11 21FFFF LD HL,#FFFF BA14 7C LD A,H ;AHL= minus one BA15 CD05B7 CALL V_SPACE ;Ensure enough room for one byte BA18 3E04 LD A,#04 BA1A CDFFB6 CALL V_PAGE ;Select page containing catalogue BA1D DD6E0A LD L,(SF_START) BA20 DD660B LD H,(SF_START+1) BA23 DD7E0C LD A,(SF_START+2);AHL= page-coded address of first ;spare byte in RAMdisc BA26 F5 PUSH AF ;Stack page-code BA27 CDFFB6 CALL V_PAGE ;Select page containing first ;spare byte in RAMdisc BA2A F1 POP AF ;AHL points to first spare byte BA2B 3604 LD (HL),#04 ;Store 04 as type-of-file code BA2D 010100 LD BC,#0001 BA30 CD3AB7 CALL ADD_HL_BC ;AHL= page-coded address of new ;first spare byte in RAMdisc BA33 5F LD E,A ;EHL= this address BA34 3E04 LD A,#04 BA36 CDFFB6 CALL V_PAGE ;Select page containing catalogue BA39 DD7510 LD (SF_END),L BA3C DD7411 LD (SF_END+1),H BA3F DD7312 LD (SF_END+2),E ;Store address of end of file BA42 CD0BB7 CALL V_CATEND ;Tidy up catalogue entry BA45 3E05 LD A,#05 BA47 CDFFB6 CALL V_PAGE ;Select normal RAM BA4A C381B9 R_OP_EXIT JP R_OC_EXIT ;Jump to exit routine And finally, we have the routines which integrate the R channel with BASIC. These are only example routines, and you may of course rewrite them to your own specifications. OPEN_4 will open stream four to a serial file called FILE1; OPEN_5 will open stream five to a serial file called FILE2; CLOSE_4 will close stream four; and CLOSE_5 will close stream five. BA4D 46494C4531 DEFM FILE1 2020202020 DEFM five spaces ;Name of first file 46494C4532 DEFM FILE2 2020202020 DEFM five spaces ;Name of second file BA61 3E04 OPEN_4 LD A,#04 ;A= stream number BA63 214DBA LD HL,FILE_1 ;HL points to filename BA66 1805 JR OPEN_4_5 ;Jump to open stream BA68 3E05 OPEN_5 LD A,#05 ;A= stream number BA6A 2157BA LD HL,FILE_2 ;HL points to filename BA6D 11675B OPEN_4_5 LD DE,N_STR1 ;DE points to system variable BA70 010A00 LD BC,#000A ;BC= length of filename (ten) BA73 EDB0 LDIR ;Copy filename into system variable BA75 C388B9 JP R_OPEN BA78 3E04 CLOSE_4 LD A,#04 ;A= stream number BA7A 1802 JR CLOSE_4_5 BA7C 3E05 CLOSE_5 LD A,#05 ;A= stream number BA7E C300B0 CLOSE_4_5 JP CLOSE_NEW ;Jump to close channel - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -