********  CLOSE EXEC FILE  **********************************************

F68B	LDA #&00    ;A=0

*************************************************************************
*                                                                       *
*       *EXEC                                                           *
*                                                                       *
*************************************************************************

F68D	PHP         ;save flags on stack
F68E	STY &E6     ;&E6=Y
F690	LDY &0256   ;EXEC file handle
F693	STA &0256   ;EXEC file handle
F696	BEQ &F69B   ;if not 0 close file via OSFIND
F698	JSR OSFIND  ;
F69B	LDY &E6     ;else Y= original Y
F69D	PLP         ;get back flags
F69E	BEQ &F6AB   ;if A=0 on entry exit else
F6A0	LDA #&40    ;A=&40
F6A2	JSR OSFIND  ;to open an input file
F6A5	TAY         ;Y=A
F6A6	BEQ &F674   ;If Y=0 'File not found' else store
F6A8	STA &0256   ;EXEC file handle
F6AB	RTS         ;return

******* read a block    *************************************************

F6AC	LDX #&A6    ;X=&A6
F6AE	JSR &FB81   ;copy from 301/C+X to 3D2/C sought filename
F6B1	JSR &F77B   ;read block header
F6B4	LDA &03CA   ;block flag
F6B7	LSR         ;A=A/2 bit 0 into carry to check for locked file
F6B8	BCC &F6BD   ;if not set then skip next instruction
F6BA	JMP &F1F6   ;'locked' file routine

F6BD	LDA &03DD   ;Expected BGET file block number lo
F6C0	STA &B4     ; current block no. lo
F6C2	LDA &03DE   ;expected BGET file block number hi
F6C5	STA &B5     ;current block no. hi
F6C7	LDA #&00    ;A=0
F6C9	STA &B0     ;current load address
F6CB	LDA #&0A    ;A=&A setting current load address to the CFS/RFS
F6CD	STA &B1     ;current load address buffer at &A00
F6CF	LDA #&FF    ;A=&FF to set other 2 bytes
F6D1	STA &B2     ;current load address high word
F6D3	STA &B3     ;current load address high word
F6D5	JSR &F7D5   ;reset flags
F6D8	JSR &F9B4   ;load file from tape
F6DB	BNE &F702   ;if return non zero F702 else
F6DD	LDA &0AFF   ;get last character from input buffer
F6E0	STA &02ED   ;last character currently resident block
F6E3	JSR &FB69   ;inc. current block no.
F6E6	STX &03DD   ;expected BGET file block number lo
F6E9	STY &03DE   ;expected BGET file block number hi
F6EC	LDX #&02    ;X=2
F6EE	LDA &03C8,X ;read bytes from block flag/block length
F6F1	STA &02EA,X ;store into current values of above
F6F4	DEX         ;X=X-1
F6F5	BPL &F6EE   ;until X=-1 (&FF)

F6F7	BIT &02EC   ;block flag of currently resident block
F6FA	BPL &F6FF   ;
F6FC	JSR &F249   ;print newline if needed
F6FF	JMP &FAF2   ;enable second processor and reset serial system
F702	JSR &F637   ;search for a specified block
F705	BNE &F6B4   ;if NE check for locked condition else
F707	CMP #&2A    ;is it Synchronising byte &2A?
F709	BEQ &F742   ;if so F742
F70B	CMP #&23    ;else is it &23 (header substitute in ROM files)
F70D	BNE &F71E   ;if not BAD ROM error

F70F	INC &03C6   ;block number
F712	BNE &F717   ;
F714	INC &03C7   ;block number hi
F717	LDX #&FF    ;X=&FF
F719	BIT &D9B7   ;to set V & M
F71C	BNE &F773   ;and jump (ALWAYS!!) to F773

F71E	LDA #&F7    ;clear bit 3 of RFS status (current CAT status)
F720	JSR &F33D   ;RFS status =RFS status AND A

F723	BRK         ;and cause error
F724	DB  &D7     ;error number
F725	DB  'Bad Rom'
F72C	BRK         ;

**********: pick up a header ********************************************

F72D	LDY &FF     ;get ESCAPE flag
F72F	JSR &FB90   ;switch Motor on
F732	LDA #&01    ;A=1
F734	STA &C2     ;progress flag
F736	JSR &FB50   ;control serial system
F739	JSR &F995   ;confirm ESC not set and CFS not executing
F73C	LDA #&03    ;A=3
F73E	CMP &C2     ;progress flag
F740	BNE &F739   ;back until &C2=3

F742	LDY #&00    ;Y=0
F744	JSR &FB7C   ;zero checksum bytes
F747	JSR &F797   ;get character from file and do CRC
F74A	BVC &F766   ;if V clear on exit F766
F74C	STA &03B2,Y ;else store
F74F	BEQ &F757   ;or if A=0 F757
F751	INY         ;Y=Y+1
F752	CPY #&0B    ;if Y<>&B
F754	BNE &F747   ;go back for next character
F756	DEY         ;Y=Y-1

F757	LDX #&0C    ;X=12
F759	JSR &F797   ;get character from file and do CRC
F75C	BVC &F766   ;if V clear on exit F766
F75E	STA &03B2,X ;else store byte
F761	INX         ;X=X+1
F762	CPX #&1F    ;if X<>31
F764	BNE &F759   ;goto F759

F766	TYA         ;A=Y
F767	TAX         ;X=A
F768	LDA #&00    ;A=0
F76A	STA &03B2,Y ;store it
F76D	LDA &BE     ;CRC workspace
F76F	ORA &BF     ;CRC workspace
F771	STA &C1     ;Checksum result
F773	JSR &FB78   ;set (BE/C0) to 0
F776	STY &C2     ;progress flag
F778	TXA         ;A=X
F779	BNE &F7D4   ;
F77B	LDA &0247   ;filing system flag 0=CFS 2=RFS
F77E	BEQ &F72D   ;if cassette F72D
F780	JSR &EE51   ;read RFS data rom or Phrom
F783	CMP #&2B    ;is it ROM file terminator?
F785	BNE &F707   ;if not F707

********* terminator found **********************************************

F787	LDA #&08    ;A=8 isolating bit 3 CAT status
F789	AND &E2     ;CFS status byte
F78B	BEQ &F790   ;if clera skip next instruction
F78D	JSR &F24D   ;print CR if CFS not operational
F790	JSR &EE18   ;get byte from data Rom
F793	BCC &F780   ;if carry set F780
F795	CLV         ;clear overflow flag
F796	RTS         ;return

****************  get character from file and do CRC  *******************
    	;
F797	LDA &0247   ;filing system flag 0=CFS 2=RFS
F79A	BEQ &F7AD   ;if cassette F7AD
F79C	TXA         ;A=X to save X and Y
F79D	PHA         ;save X on stack
F79E	TYA         ;A=Y
F79F	PHA         ;save Y on stack
F7A0	JSR &EE51   ;read RFS data rom or Phrom
F7A3	STA &BD     ;put it in temporary storage
F7A5	LDA #&FF    ;A=&FF
F7A7	STA &C0     ;filing system buffer flag
F7A9	PLA         ;get back Y
F7AA	TAY         ;Y=A
F7AB	PLA         ;get back X
F7AC	TAX         ;X=A
F7AD	JSR &F884   ;check for Escape and loop till bit 7 of FS buffer
    	            ;flag=1

************************** perform CRC **********************************

F7B0	PHP         ;save flags on stack
F7B1	PHA         ;save A on stack
F7B2	SEC         ;set carry flag
F7B3	ROR &CB     ;CRC Bit counter
F7B5	EOR &BF     ;CRC workspace
F7B7	STA &BF     ;CRC workspace
F7B9	LDA &BF     ;CRC workspace
F7BB	ROL         ;A=A*2 C=bit 7
F7BC	BCC &F7CA   ;
F7BE	ROR         ;A=A/2
F7BF	EOR #&08    ;
F7C1	STA &BF     ;CRC workspace
F7C3	LDA &BE     ;CRC workspace
F7C5	EOR #&10    ;
F7C7	STA &BE     ;CRC workspace
F7C9	SEC         ;set carry flag

F7CA	ROL &BE     ;CRC workspace
F7CC	ROL &BF     ;CRC workspace
F7CE	LSR &CB     ;CRC Bit counter
F7D0	BNE &F7B9   ;
F7D2	PLA         ;get back A
F7D3	PLP         ;get back flags
F7D4	RTS         ;return

F7D5	LDA #&00    ;A=0
F7D7	STA &BD     ;&BD=character temporary storage buffer=0
F7D9	LDX #&00    ;X=0
F7DB	STX &BC     ;file status or temporary store
F7DD	BVC &F7E9   ;
F7DF	LDA &03C8   ;block length
F7E2	ORA &03C9   ;block length hi
F7E5	BEQ &F7E9   ;if 0 F7E9

F7E7	LDX #&04    ;else X=4
F7E9	STX &C2     ;filename length/progress flag
F7EB	RTS         ;return

*************** SAVE A BLOCK ********************************************

F7EC	PHP         ;save flags on stack
F7ED	LDX #&03    ;X=3
F7EF	LDA #&00    ;A=0
F7F1	STA &03CB,X ;clear 03CB/E (RFS EOF+1?)
F7F4	DEX         ;X=X-1
F7F5	BPL &F7F1   ;

F7F7	LDA &03C6   ;block number
F7FA	ORA &03C7   ;block number hi
F7FD	BNE &F804   ;if block =0 F804 else
F7FF	JSR &F892   ;generate a 5 second delay
F802	BEQ &F807   ;goto F807


F804	JSR &F896   ;generate delay set by interblock gap
F807	LDA #&2A    ;A=&2A
F809	STA &BD     ;store it in temporary file
F80B	JSR &FB78   ;set (BE/C0) to 0
F80E	JSR &FB4A   ;set ACIA control register
F811	JSR &F884   ;check for Escape and loop till bit 7 of FS buffer
    	            ;flag=1
F814	DEY         ;Y=Y-1
F815	INY         ;Y=Y+1
F816	LDA &03D2,Y ;move sought filename
F819	STA &03B2,Y ;into filename block
F81C	JSR &F875   ;transfer byte to CFS and do CRC
F81F	BNE &F815   ;if filename not complet then do it again

******: deal with rest of header ****************************************

F821	LDX #&0C    ;X=12
F823	LDA &03B2,X ;get filename byte
F826	JSR &F875   ;transfer byte to CFS and do CRC
F829	INX         ;X=X+1
F82A	CPX #&1D    ;until X=29
F82C	BNE &F823   ;

F82E	JSR &F87B   ;save checksum to TAPE reset buffer flag
F831	LDA &03C8   ;block length
F834	ORA &03C9   ;block length hi
F837	BEQ &F855   ;if 0 F855

F839	LDY #&00    ;else Y=0
F83B	JSR &FB7C   ;zero checksum bytes
F83E	LDA (&B0),Y ;get a data byte
F840	JSR &FBD3   ;check if second processor file test tube prescence
F843	BEQ &F848   ;if not F848 else

F845	LDX &FEE5   ;Tube FIFO3

F848	TXA         ;A=X
F849	JSR &F875   ;transfer byte to CFS and do CRC
F84C	INY         ;Y=Y+1
F84D	CPY &03C8   ;block length
F850	BNE &F83E   ;
F852	JSR &F87B   ;save checksum to TAPE reset buffer flag
F855	JSR &F884   ;check for Escape and loop till bit 7 of FS buffer
    	            ;flag=1
F858	JSR &F884   ;check for Escape and loop till bit 7 of FS buffer
    	            ;flag=1
F85B	JSR &FB46   ;reset ACIA

F85E	LDA #&01    ;A=1
F860	JSR &F898   ;generate 0.1 * A second delay
F863	PLP         ;get back flags
F864	JSR &F8B9   ;update block flag, PRINT filename (& address if reqd)
F867	BIT &03CA   ;block flag
F86A	BPL &F874   ;is this last block (bit 7 set)?
F86C	PHP         ;save flags on stack
F86D	JSR &F892   ;generate a 5 second delay
F870	JSR &F246   ;sound bell and abort
F873	PLP         ;get back flags
F874	RTS         ;return

****************** transfer byte to CFS and do CRC **********************
    	;
F875	JSR &F882   ;save byte to buffer, transfer to CFS & reset flag
F878	JMP &F7B0   ;perform CRC

***************** save checksum to TAPE reset buffer flag ****************

F87B	LDA &BF     ;CRC workspace
F87D	JSR &F882   ;save byte to buffer, transfer to CFS & reset flag
F880	LDA &BE     ;CRC workspace

************** save byte to buffer, transfer to CFS & reset flag ********

F882	STA &BD     ;store A in temporary buffer

***** check for Escape and loop untill bit 7 of FS buffer flag=1 ***********

F884	JSR &F995   ;confirm ESC not set and CFS not executing
F887	BIT &C0     ;filing system buffer flag
F889	BPL &F884   ;loop until bit 7 of &C0 is set

F88B	LDA #&00    ;A=0
F88D	STA &C0     ;filing system buffer flag
F88F	LDA &BD     ;get temporary store byte
F891	RTS         ;return

****************** generate a 5 second delay  ***************************

F892	LDA #&32    ;A=50
F894	BNE &F898   ;generate delay 100ms *A (5 seconds)

*************** generate delay set by interblock gap ********************

F896	LDA &C7     ;get current interblock flag

*************** generate delay ******************************************

F898	LDX #&05    ;X=5
F89A	STA &0240   ;CFS timeout counter
F89D	JSR &F995   ;confirm ESC not set and CFS not executing
F8A0	BIT &0240   ;CFS timeout counter (decremented each 20ms)
F8A3	BPL &F89D   ;if +ve F89D
F8A5	DEX         ;X=X-1
F8A6	BNE &F89A   ;
F8A8	RTS         ;return

************: generate screen reports ***********************************

F8A9	LDA &03C6   ;block number
F8AC	ORA &03C7   ;block number hi
F8AF	BEQ &F8B6   ;if 0 F8B6
F8B1	BIT &03DF   ;copy of last read block flag
F8B4	BPL &F8B9   ;update block flag, PRINT filename (& address if reqd)
F8B6	JSR &F249   ;print newline if needed

************** update block flag, PRINT filename (& address if reqd) ****

F8B9	LDY #&00    ;Y=0
F8BB	STY &BA     ;current block flag
F8BD	LDA &03CA   ;block flag
F8C0	STA &03DF   ;copy of last read block flag
F8C3	JSR &E7DC   ;check if free to print message
F8C6	BEQ &F933   ;if A=0 on return Cassette system is busy
F8C8	LDA #&0D    ;else A=&0D :carriage return
F8CA	JSR OSWRCH  ;print it (note no linefeed as it's via OSWRCH)
F8CD	LDA &03B2,Y ;get byte from filename
F8D0	BEQ &F8E2   ;if 0 filename is ended
F8D2	CMP #&20    ;if <SPACE
F8D4	BCC &F8DA   ;F8DA
F8D6	CMP #&7F    ;if less than DELETE
F8D8	BCC &F8DC   ;its a printable character for F8DC else

*******************Control characters in RFS/CFS filename ******************

F8DA	LDA #&3F    ;else A='?'
F8DC	JSR OSWRCH  ;and print it

F8DF	INY         ;Y=Y+1
F8E0	BNE &F8CD   ;back to get rest of filename

***************** end of filename ***************************************

F8E2	LDA &0247   ;filing system flag 0=CFS 2=RFS
F8E5	BEQ &F8EB   ;if cassette F8EB
F8E7	BIT &BB     ;test current OPTions
F8E9	BVC &F933   ;if bit 6 clear no,long messages needed F933
F8EB	JSR &F991   ;print a space
F8EE	INY         ;Y=Y+1
F8EF	CPY #&0B    ;if Y<11 then
F8F1	BCC &F8E2   ;loop again to fill out filename with spaces

F8F3	LDA &03C6   ;block number
F8F6	TAX         ;X=A
F8F7	JSR &F97A   ;print ASCII equivalent of hex byte
F8FA	BIT &03CA   ;block flag
F8FD	BPL &F933   ;if not end of file return
F8FF	TXA         ;A=X
F900	CLC         ;clear carry flag
F901	ADC &03C9   ;block length hi
F904	STA &CD     ;file length counter hi
F906	JSR &F975   ;print space + ASCII equivalent of hex byte
F909	LDA &03C8   ;block length
F90C	STA &CC     ;file length counter lo
F90E	JSR &F97A   ;print ASCII equivalent of hex byte
F911	BIT &BB     ;current OPTions
F913	BVC &F933   ;if bit 6 clear no long messages required so F933

F915	LDX #&04    ;X=4
F917	JSR &F991   ;print a space
F91A	DEX         ;X=X-1
F91B	BNE &F917   ;loop to print 4 spaces

F91D	LDX #&0F    ;X=&0F to point to load address
F91F	JSR &F927   ;print 4 bytes from CFS block header
F922	JSR &F991   ;print a space
F925	LDX #&13    ;X=&13 point to Execution address

************** print 4 bytes from CFS block header **********************

F927	LDY #&04    ;loop pointer
F929	LDA &03B2,X ;block header
F92C	JSR &F97A   ;print ASCII equivalent of hex byte
F92F	DEX         ;X=X-1
F930	DEY         ;Y=Y-1
F931	BNE &F929   ;

F933	RTS         ;return

*********** print prompt for SAVE on TAPE *******************************

F934	LDA &0247   ;filing system flag 0=CFS 2=RFS
F937	BEQ &F93C   ;if cassette F93C
F939	JMP &E310   ;else 'Bad Command error message'
F93C	JSR &FB8E   ;switch Motor On
F93F	JSR &FBE2   ;set up CFS for write operation
F942	JSR &E7DC   ;check if free to print message
F945	BEQ &F933   ;if not exit else
F947	JSR &FA46   ; print message following call

F94A	DB  'RECORD then RETURN';
F95C	BRK         ;

F95D	JSR &F995   ;confirm CFS not operating, nor ESCAPE flag set

************ wait for RETURN key to be pressed **************************

F960	JSR OSRDCH  ;wait for keypress
F963	CMP #&0D    ;is it &0D (RETURN)
F965	BNE &F95D   ;no then do it again

F967	JMP OSNEWL  ;output Carriage RETURN and LINE FEED

************* increment current load address ****************************

F96A	INC &B1     ;current load address
F96C	BNE &F974   ;
F96E	INC &B2     ;current load address high word
F970	BNE &F974   ;
F972	INC &B3     ;current load address high word
F974	RTS         ;return

************* print a space + ASCII equivalent of hex byte **************

F975	PHA         ;save A on stack
F976	JSR &F991   ;print a space
F979	PLA         ;get back A

************** print ASCII equivalent of hex byte  **********************

F97A	PHA         ;save A on stack
F97B	LSR         ;/16 to put high nybble in lo
F97C	LSR         ;
F97D	LSR         ;
F97E	LSR         ;
F97F	JSR &F983   ;print its ASCII equivalent
F982	PLA         ;get back A

F983	CLC         ;clear carry flag
F984	AND #&0F    ;clear high nybble
F986	ADC #&30    ;Add &30 to convert 0-9 to ASCII A-F to : ; < = > ?
F988	CMP #&3A    ;if A< ASC(':')
F98A	BCC &F98E   ;goto F98E
F98C	ADC #&06    ;else add 7 to convert : ; < = > ? to A B C D E F

F98E	JMP OSWRCH  ;print character and return

******************** print a space  *************************************

F991	LDA #&20    ;A=' '
F993	BNE &F98E   ;goto F98E to print it

******************** confirm CFS not operating, nor ESCAPE flag set *****

F995	PHP         ;save flags on stack
F996	BIT &EB     ;CFS Active flag
F998	BMI &F99E   ;
F99A	BIT &FF     ;if ESCAPE condition
F99C	BMI &F9A0   ;goto F9A0
F99E	PLP         ;get back flags
F99F	RTS         ;return

F9A0	JSR &F33B   ;close input file
F9A3	JSR &FAF2   ;enable second processor and reset serial system
F9A6	LDA #&7E    ;A=&7E (126) Acknowledge ESCAPE
F9A8	JSR OSBYTE  ;OSBYTE Call

F9AB	BRK         ;
F9AC	DB  &11     ;error 17
F9AD	DB  'Escape' ;
F9B3	BRK         ;