;			-- TAPELIB --
;
;					BY:  S. J. SINGER
;						(714) 780-8853
;
;	THIS PROGRAM IS A GENERAL CASSETTE TAPE LIBRARY MANAGER FOR CP/M.
;IT ACCEPTS A FUNCTION FOLLOWED BY A FILE NAME FROM THE CONSOLE AND
;PERFORMS A DISK TO TAPE OR TAPE TO DISK COPY. ANY CP/M FILE MAY BE COPIED.
;THE TAPE FORMAT IS TARBELL COMPATABLE, HOWEVER THE TAPES PRODUCED BY
;TAPELIB ARE NOT EASILY LOADED BY OTHER TARBELL INPUT ROUTINES.
;TAPE FILES ARE NAMED AND SPACE IS PROVIDED FOR EXTENSIVE COMMENTS.
;
;		    -- COMMAND FORMATS --
;
;		DISK TO TAPE
;	TAPELIB TAPE:=FILENAME.TYP  'OPTIONAL DESCRIPTION OR COMMENTS'
;	TAPELIB TAPE:=A:FILENAME.TYP	BLOCK
;	TAPELIB TAPE:=B:FILENAME.TYP       NODISPLAY
;
;		TAPE TO DISK
;	TAPELIB DISK:=FILENAME.TYP
;	TAPELIB A:=FILENAME.TYP
;	TAPELIB B:=FILENAME.TYP
;
;
;		EXECUTE FILE 
;	TAPELIB RUN:=FILENAME.COM
;
;		WRITE SYNC
;	TAPELIB TAPE:=SYNC
;
;
;	TAPELIB MAY ALSO BE LOADED LIKE PIP, BY SIMPLY TYPING TAPELIB.
;THE PROGRAM WILL LOAD, PRINT A TITLE THEN A * PROMPT. THE COMMANDS
;GIVEN ABOVE MAY THEN BE ENTERED WITHOUT THE WORD TAPELIB.
;
;   FILES MAY BE RENAMED OR SIMPLY VERIFIED (NO ACTUAL TRANSFER) DURING
;ALL TAPE TO DISK OPERATIONS. A COM FILE MAY ALSO BE RUN FROM TAPE
;WITHOUT FIRST LOADING IT TO DISK. THE SYNC OPTION WRITES 65K OF SYNC
;BYTES ON THE TAPE.
;
;	TAPELIB DISK:=FILENAME.TYP   RENAME NEW.NAM
;	TAPELIB DISK:=FILENAME.TYP    VERIFY
;	TAPELIB DISK:=FILENAME.COM      RUN   NODISPLAY

;  (RENAME,VERIFY,RUN AND THE FILE NAME ARE FREE FORMAT AND MAY BE  
;ANYWHERE IN THE COMMENT FIELD). A FILE MUST BE TYPE COM TO BE RUN.
;NODISPLAY IN THE COMMENT FIELD TURNS OFF THE DISPLAY OF THE FILE ON
;THE TERMINAL DURING TRANSFER OPERATIONS.
;
;	A TOTAL OF 128 BYTES ARE AVAILABLE FOR THE COMMAND AND COMMENTS.
;WHEN COPYING TAPE TO DISK COMMENTS ARE OMITTED. DURING ALL TAPE TRANSFER
;OPERATIONS THE CONTENTS OF THE FILE ARE DISPLAYED ON THE CONSOLE. NON
;DISPLAYABLE CHARACTERS DISPLAY AS PERIODS. THE NAMES AND COMMENTS OF
;THE FILES SKIPPED OVER ARE DISPLAYED DURING THE SEARCH. NORMALLY
;FILES ARE NOT BLOCKED ON TAPE BUT READ INTO MEMORY IN THEIR ENTIRETY.
;IF A FILE WILL NOT FIT IN MEMORY IT WILL BE WRITTEN OUT IN 1K BLOCKS.
;
;	FILES ARE DISPLAYED ON THE CONSOLE FOR VERIFICATION DURING
;ALL TRANSFER OPERATIONS. NON DISPLAYABLE CHARACTERS DISPLAY AS PERIODS.
;THE CONSOLE DEVICE MUST BE CAPABLE OF OPERATING AT A MINIMUM OF
;4800 BAUD OR ERRORS WILL OCCUR. THE DISPLAY FEATURE MUST BE DISABLED
;IF SLOW TERMINALS ARE USED.
;
;			-- TAPE FORMAT--
;
;	1. START BYTES		03CH  (600)
;	2. SYNC BYTE		06EH
;	3. DECODE BYTE		0FFH  CONTROLS DISPLAY
;	4. TYPE BYTE		0 1 OR 2
;	5. LENGTH BYTE		THE NUMBER OF 256 BYTE RECORDS
;	6. NAME			CP/M NAME 11 BYTES  (NAME....TYP)
;	7. COMMENT		110 BYTES PROVIDED, BLANK (20H) IF NOT ENTERED
;	8. DATA			MULTIPLES OF 256 BYTE RECORDS
;	9. CHECKSUM		ONE BYTE TARBELL CHECKSUM
;
;	A STRING OF 600 START BYTES PROVIDES AT LEAST 3 SEC OF 'LEADER'
;BETWEEN RECORDS ON THE TAPE. ALL THE MEMORY BETWEEN THE END OF THE
;PROGRAM AND THE OPERATING SYSTEM, IS USED AS A FILE BUFFER. IF A
;FILE IS TOO LARGE TO FIT IN THE AVAILABLE MEMORY, IT WILL BE
;WRITTEN ON TAPE IN 1K BLOCKS DURING DISK TO TAPE TRANSFERS.
;READING AND WRITING BLOCKED TAPES TAKES ABOUT TWICE AS LONG AS READING
;OR WRITING UNBLOCKED TAPES. PROGRAMS MAY NOT BE RUN DIRECTLY FROM
;BLOCKED TAPES. ENTERING THE WORD 'BLOCK' IN THE DESCRIPTION FIELD
;OF A DISK TO TAPE COMMAND WILL FORCE BLOCKING OF ALL FILES THAT
;WILL NOT FIT IN A 16K CP/M SYSTEM.
;
;
;	THE PROGRAM WAS ASSEMBLED USING A Z-80 MACRO ASSEMBLY PROGRAM,
;HOWEVER ONLY 8080 INSTRUCTIONS WERE USED SO THE PROGRAM WILL
;RUN ON EITHER AN 8080 OR Z-80 BASED PROCESSOR.
;
	.XLIST
;
	;	--------  MACROS   -------
;
;
;   1.   FILL - FILL A BLOCK OF MEMORY WITH A CONSTANT MAX 64K
;
	.DEFINE FILL [START,END,CONST(0)] = [
	LXI	H,START		;;SET START ADDR
	.IFB	[END],[
	XRA	A
	MOV	M,A]		;;STORE ONE BYTE IF NO END
	.IFNB	[END],[
	LXI	D,END-START+1	;;SET LENGTH
	MVI	A,CONST		;;LOAD CONSTANT IN A
	MOV	M,A		;;STORE THE CONST
	INX	H		;;INCR H
	DCX	D		;;DECR LENGTH
	MOV	A,D
	ORA	E		;;TEST LENGTH = ZERO
	JNZ	.-7]]		;;REPEAT IF DE AND HL NOT EQUAL
;
;   1.5  FILLI - FILL INDIRECT A BLOCK OF MEMORY WITH A CONSTANT
;
	.DEFINE FILLI [START,END,CONST(0),%FI] = [
	LHLD	START		;;START 
ADDR
	LXI	D,END+1		;;END ADDR
%FI:	MVI	A,CONST		;;CONSTANT TO A
	MOV	M,A		;;STORE CONST IN MEMORY
	INX	H		;;INCR POINTER
	CPHL			;;COMPARE HL AND DE
	JNZ	%FI]		;;REPEAT TILL ZERO
;
;  2.   CPHL - COMPARE DE AND HL AND SET FLAGS
;
	.DEFINE CPHL = [
	MOV	A,H
	CMP	D		;;COMPARE HIGH BYTES
	JNZ	.+5
	MOV	A,L
	CMP	E]		;;COMPARE LOW BYTES
;
;
;   3.  MOVE - MOVE A BLOCK OF LENGTH LEN FROM SOURCE TO DEST
;
	.DEFINE MOVE [SOURCE,DEST,LEN] = [
	LXI	D,SOURCE	;SOURCE
	LXI	H,DEST		;DEST
	LXI	B,LEN	;LENGTH
	LDAX	D	;GET A BYTE
	MOV	M,A	;STORE IT
	INX	H
	INX	D	;BUMP POINTERS
	DCX	B	;DECR LENGTH COUNT
	MOV	A,B
	ORA	C
	JNZ	.-7]	;TEST DONE?
;
;
;   4. MOVEI - MOVE INDIRECT BLOCK OF LENGTH LEN FROM SOURCE TO DEST
;
	.DEFINE	MOVEI [SOURCE,DEST,LEN] = [
	.IFDIF [DE] [SOURCE],[
	LHLD	SOURCE		;SOURCE
	XCHG]
	.IFDIF [HL] [DEST],[
	LHLD	DEST]		;DESTINATION
	.IFDIF [BC] [LEN],[
	LXI	B,LEN]		;LENGTH
	LDAX	D		;GET A BYTE
	MOV	M,A		;STORE IT
	INX	H
	INX	D		;BUMP POINTERS
	DCX	B		;DECR LENGTH COUNT
	MOV	A,B
	ORA	C
	JNZ	.-7]		;TEST DONE
;
;   5.  READTB - READ CHAR STRING INTO INPUT TEXT BUFFER
;
	.DEFINE READTB [TEXT,MAX(127)] = [
	MVI	C,10
	LXI	D,TEXT
	MVI	A,MAX
	STAX	D	;SET MAXIMUM BUFFER LENGTH
	CALL	5]
;
;   6.  PRINTL - PRINT A LITERAL CHARACTER STRING ENCLOSED IN ' '
;
	.DEFINE	PRINTL [A$,%OUT] = [
	MVI	C,9
	LXI	D,.+9
	CALL	5
	JMP	%OUT
	.ASCII	'A$'
%OUT:]
;
;   7.  PRINT - PRINT TEXT FROM MEMORY TO CONSOLE
;
	.DEFINE PRINT [B$] = [
	MVI	C,9
	LXI	D,B$
	CALL	5]
;
;
;   7.5 DELMAK - DELETE AND MAKE A DISK FILE
;
	.DEFINE DELMAK [FCB] = [
	MVI	C,19		;;DELETE CODE
	LXI	D,FCB
	CALL	5
	MVI	C,22		;;MAKE CODE
	LXI	D,FCB
	CALL	5
	CPI	0FFH		;;TEST FOR ERROR
	CMC]			;;COMPLIMENT CARRY
;   8.  OPEN - OPEN DISK FILE
;
	.DEFINE OPEN [NAME] = [
	MVI	C,15
	LXI	D,NAME
	CALL	5
	CPI	0FFH	;TEST FOR ERROR
	CMC		;COMPLIMENT CARRY
	JNZ	.+4
	STC]
;
;
;   8.5 CLOSE - CLOSE A DISK FILE
;
	.DEFINE CLOSE [FCB] = [
	MVI	C,16		;;CLOSE CODE
	LXI	D,FCB
	CALL	5
	CPI	0FFH		;;TEST FOR ERROR
	CMC			;;COMPLIMENT CARRY
	JNZ	.+4
	STC]
;
;
;   9.  READ - READ NEXT DISK FILE
;
	.DEFINE READ [FCB] = [ 
	MVI	C,20
	LXI	D,FCB
	CALL	5
	ORA	A
	JZ	.+4
	STC]			;;SET CARRY ON EOF OR ERROR
;
;
;
;   9.5 WRITE - WRITE NEXT RECORD TO DISK
;
	.DEFINE WRITE [FCB] = [
	MVI	C,21		;;WRITE CODE
	LXI	D,FCB
	CALL	5
	ORA	A		;;SET FLAGS
	JZ	.+4
	STC]			;;SET CARRY ON ERROR
;
;
;    SEARCH - SEARCH DIRECTORY FOR FIRST FCB THAT MATCHES NAME
;
	.DEFINE SEARCH [FCB] = [
	MVI	C,17		;;SEARCH CODE
	LXI	D,FCB
	CALL	5
	CPI	0FFH		;;FFH = NO MATCH
	CMC			;;SET CARRY IF NO MATCH
]
;
;    SERNXT - SEARCH DIRECTORY FOR NEXT FCB MATCHING NAME
;
	.DEFINE SERNXT [FCB] = [
	LXI	D,FCB		;;NAME OF FILE TO SEARCH FOR
	MVI	C,18		;;SEARCH NEXT CODE
	CALL	5
	CPI	0FFH		;;0FFH = NO MATCH
	CMC			;;SET CARRY IF NO MATCH
]

;   66.  DELETE - DELETE A DISK FILE
;
	.DEFINE DELETE [FCB] = [
	MVI	C,19
	LXI	D,FCB
	CALL	5]
;

;
;  10.  CONIN [$S] - CONSOLE INPUT TO A
;
	.DEFINE CONIN [$S] = [
	.IFIDN [$S] [SR], [
		PUSH	H
		PUSH	D
		PUSH	B]
	MVI	C,1
	CALL	5
	.IFIDN [$S] [SR],[
		POP	B
		POP	D
		POP	H]
	]		;END MACRO
;
;	
;  11.  CONOUT - CONSOLE OUTPUT FROM A
;
	.DEFINE CONOUT [$S] = [
	.IFIDN [$S] [SR],[
	PUSH	H
	PUSH	D
	PUSH	B]
	MOV	E,A
	MVI	C,2
	CALL	5
	.IFIDN [$S] [SR],[
	POP	B
	POP	D
	POP	H]
]		;END MACRO
;
;  12.  INDEX - INDEX AN ADDRESS POINTER BY A CONSTANT
;
	.DEFINE INDEX [POINTER,INDX] = [
	LHLD	POINTER
	LXI	D,INDX
	DAD	D
	SHLD	POINTER]
;  13.  FILFCB - FILL IN ID FIELDS OF FCB (FILE NAME ENDED BY ZERO BYTE)
;		ON EXIT - CARRY SET IF NAME TOO LONG
;			- HL POINTS TO NEXT BYTE AFTER NAME

;
	.DEFINE FILFCB [FCB,IDSTR,%ERROR,%DONE] = [
	LHLD	IDSTR		;;POINTER TO NAME STRING
	XCHG
	LXI	H,FCB		;;ADDR OF FILE CONTROL BLOCK
	.IFN $FCBSW,[
	CALL	FFCB]
	.IFE $FCBSW,[
	CALL	FFCB
$FCBSW	=	1		;;SET CONDITIONAL ASSEMBLY SWITCH
	JMP	ENDFCB
FFCB:	MVI	M,0		;CLEAR FIRST BYTE OF FCB
	INX	H
	PUSH	H		;;SAVE FCB NAME ADDR
	MVI	C,11		;;SIZE OF NAME
	MVI	A,' '		;;SPACE TO A
	MOV	M,A		;;SET NAME FIELD TO SPACES
	INX	H
	DCR	C
	JNZ	.-3
	POP	H		;;RECOVER NAME ADDR
	MVI	C,8		;;MAXIMUM SIZE OF NAME+1
	LDAX	D		;;GET ID BYTE
	CPI	' '		;;LEADING SPACES ?
	JNZ	.+7		;;CONTINUE IF NOT
	INX	D		;;SKIP LEADING SPACES
	JMP	.-7
	LDAX	D		;;GET ID BYTE
	CPI	0		;;IS IT A ZERO BYTE
	JZ	%DONE		;;YES DONE
	CPI	' '		;;IMBEDDED SPACE?
	JZ	%DONE		;;YES DONE
	CPI	'.'		;;NAME.TYP SEPARATOR?
	JZ	.+13		;;YES, PROCESS TYPE
	MOV	M,A		;;STORE NAME BYTE
	INX	D
	INX	H		;BUMP POINTERS
	DCR	C		;DECREMENT MAX COUNT
	JP	.-20		;LOOP
	JMP	%ERROR		;ERROR, NAME TOO BIG
	INX	D		;SKIP OVER '.'
	MOV	A,C
	ORA	A
	JZ	.+8
	INX	H		;;SKIP TO TYPE FIELD
	DCR	C		
	JNZ	.-2	
	MVI	C,3		;;SIZE OF TYPE FIELD
	LDAX	D		;;GET ID BYTE	
	CPI	0		;;ZERO BYTE?
	JZ	%DONE		;;YES, DONE
	CPI	' '		;;SPACE?
	JZ	%DONE		;;YES, DONE
	MOV	M,A		;;STORE TYPE BYTE
	INX	D		;;BUMP POINTERS
	INX	H		
	DCR	C		;;DECREMENT MAX COUNT
	JNZ	.-15		;;LOOP
	JMP	%DONE		;;DONE
	
	
%ERROR:	STC			;;SET CARRY
%DONE:	XCHG			;;POINTER TO END OF NAME
	RET
ENDFCB:]]			;;END MACRO

;
;  14.  $INSTR - IN STRING FUNCTION SEARCHES STRING OF LEN LSRT FOR SUBSTRING
;		RETURNS WITH CARRY SET IF MATCH AND HL POINTING TO END SUBSTR
;
	.DEFINE $INSTR [STRING,LSTR,SUBSTRING,%STR,%OVER] = [
	LHLD	STRING		;;GET STRING ADDR
	MVI	B,LSTR		;;STRING LENGTH
	.IFN	$STRSW,[
	LXI	D,%STR
	MVI	C,%OVER-%STR
	CALL	FSTR
	JMP	%OVER
%STR:	.ASCII	'SUBSTRING'
%OVER:]
	.IFE	$STRSW,[
	LXI	D,%STR
	MVI	C,%OVER-%STR
	CALL	FSTR
	JMP	%END
%STR:	.ASCII	'SUBSTRING'
%OVER:
	$STRSW = 1
FSTR:	MOV	A,B		;;STRING LEN
	SUB	C		;;SUBSTR LEN
	CMC
	JM	.+21		;;SUBSTR LONGER THAN STRING
	MOV	B,A		;;STRING LENGTH-SUBSTRING LENGTH
INSTR1:	PUSH	H
	PUSH	D
	PUSH	B
	DCR	C		;;DECR LENGTH COUNT
	JM	.+17		;;EXIT MATCH FOUND
	LDAX	D		;;GET A BYTE FROM FIRST STRING
	CMP	M		;;CONPARE WITH SECOND STRING
	JNZ	.+8		;;EXIT NO MATCH
	INX	H
	INX	D		;;INCR ADDR POINTERS
	JMP	.-11		;;TRY AGAIN
	XRA	A		;;CLEAR CARRY
	JMP	.+4		;;EXIT
	STC			;;SET CARRY
	POP	B
	POP	D
	POP	H
	JC	SSX		;;MATCH FOUND SET POINTER AND RET
	DCR	B		;;DECR STRING LEN

	RM			;;RETURN IF MINUS - NO MATCH
	INX	H		;;INCR STRING POINTER
	JMP	INSTR1		;;GO TRY SOME MORE
	RET
SSX:	LXI	D,0
	MOV	E,C
	DAD	D		;;ADD LENGTH TO POINTER
	STC			;;SET CARRY
	RET
%END:]]
;
;
;  15.  $MATCH - COMPARE STRING WITH LITERAL AND SET CARRY IF EQUAL
;
	.DEFINE $MATCH [STR1,STR2,%STR,%OVER] = [
	LXI	H,STR1
	.IFN	$MATSW,[
	LXI	D,%STR
	MVI	C,%OVER-%STR
	CALL	SMATCH
	JMP	%OVER
%STR:	.ASCII	'STR2'
%OVER:]
	.IFE	$MATSW,[
	LXI	D,%STR
	MVI	C,%OVER-%STR
	CALL	SMATCH
	JMP	MATEND
%STR:	.ASCII	'STR2'
%OVER:
$MATSW	=	1		;;CONDITIONAL ASSEMBLY SWITCH
SMATCH:	DCR	C		;;DECR LENGTH COUNT
	JM	SM3		;;EXIT MATCH FOUND
	LDAX	D		;;GET A BYTE FROM FIRST STRING
	CMP	M		;;COMPARE WITH SECOND STRING
	JNZ	SM2		;;EXIT, NO MATCH
	INX	H
	INX	D		;;INCR ADDR POINTERS
	JMP	SMATCH		;;TRY AGAIN
SM2:	XRA	A		;;CLEAR CARRY
	JMP	.+4		;;EXIT
SM3:	STC			;;SET CARRY
	RET
MATEND:]]
;
;
;   17.  IMATCH - COMPARE INDIRECT STRINGS OF EQUAL LENGTH SET CARRY IF =
;
	.DEFINE IMATCH [STR1,STR2,LEN] = [
	LXI	D,STR1		;;ONE STRING
	.IFDIF	[STR2][HL],[
	LXI	H,STR2]		;;THE OTHER
	MVI	C,LEN		;;LENGTH
	DCR	C		;;DECR LENGTH COUNT
	JM	.+17		;;MATCH FOUND EXIT
	LDAX	D		;;BYTE FROM ONE STRING
	CMP	M		;;COMPARE WITH OTHER STRING
	JNZ	.+8		;;NO MATCH EXIT
	INX	H
	INX	D		;;INCR POINTERS
	JMP	.-11		;;TRY AGAIN
	XRA	A		;;CLEAR CARRY
	JMP	.+4		;;EXIT
	STC]			;;SET CARRY ON MATCH
;
;

;   18. GETDRV - INTERROGATE AND SAVE CURRENTLY LOGGED DISK NO
;
	.DEFINE GETDRV [SAVE] = [
	MVI	C,25
	CALL	5
	STA	SAVE]
;
;
;
;   19. SETDRV - SET DISK DRIVE NUMBER
;
	.DEFINE SETDRV [X] = [
	MVI	C,14
	LXI	D,X
	CALL	5]
;
;
;   20. RESDRV - RESTORE SAVED DISK DRIVE NUMBER
;
	.DEFINE RESDRV [SAVE] = [
	MVI	C,14
	LDA	SAVE
	MOV	E,A
	CALL	5]
;
;
	.LIST
	.PABS
	.SALL
	.XSYM
	.LOC	100H		;SET ORIGIN AT 100
;
;SET CONDITIONAL ASSEMBLY SWITCHES
;
$FCBSW	=	0
$MATSW	=	0
$STRSW	=	0
	LXI	SP,NEWSTK	;SET UP NEW STACK
	LHLD	6		;TOP OF MEMORY
	LXI	D,-128
	DAD	D		;SUBTRACT 128 FOR LAST BLOCK
	LXI	D,5000H		;MEMORY LIMIT
	CPHL			;COMPARE DE - HL
	JC	STEND
	XCHG
STEND:	SHLD	MEMEND		;SET END OF MEMORY
	GETDRV	DRVNO		;SAVE CURRENTLY LOGGED DISK DRIVE NO
	STA	NEWDRV		;SAVE IT IN NEWDRV TOO
	LDA	80H		;BUFFER ALREADY FILLED?
	ORA	A
	JNZ	START
	PRINT	CRLF
	PRINTL	'TAPELIB UTILITY VERS 1.1$'
	PRINT	CRLF
	PRINTL	'COPYRIGHT 1977 BY S. J. SINGER$'
NEWIN:	PRINT	CRLF2
	PRINTL	'*$'
	MVI	A,0FFH		;SET SWITCH TO RETURN HERE AGAIN
	STA	INFLAG
	FILL	80H,0FFH	;ZERO INPUT BUFFER
	READTB	80H		;READ TEXT INTO BUFFER
	LDA	81H		;POINTS TO END OF INPUT
	INR	A
	STA	80H		;MOVE IT TO 80H
	XRA	A
	STA	DISFLG		;TURN OFF DISPLAY
	STA	DFLAG1
	STA	VERFLG		;RESET VERIFY FLAG
	STA	AMBIG		;RESET AMBIGUOUS FILE NAME FLAG
	STA	FAMBIG		;RESET FIRST AMBIGUOUS FILE FLAG
	MVI	A,65
	STA	BCOUNT		;RESET DISPLAY CHAR PER LINE
	MVI	A,88H
	STA	SLOC1		;RESET FILE NAME POINTER
START:	FILL	FCB,FCB+32	;ZERO ALL FIELDS OF FCB
	$INSTR	IPOINT,120,'BLOCK'	;BLOCK TAPE ?
	JNC	NODIS
	LXI	H,3000H
	SHLD	MEMEND		;SET MEMORY LIMIT
NODIS:	$INSTR	IPOINT,120,'NODISPLAY'	;TURN OFF DISPLAY ?
	JNC	MAT1
	MVI	A,0FFH
	STA	DFLAG1		;TURN OFF DISPLAY FOR SLOW TERMINALS
MAT1:	$MATCH	82H,'TAPE:='
	JC	DT1
	$MATCH	82H,'DISK:='
	JC	TDISK
	$MATCH	82H,'A:='
	JC	ADISK
	$MATCH	82H,'B:='
	JC	BDISK
	$MATCH	82H,'RUN:='
	JC	RUNFIL		;GO TO EXEC FILE IF TYPE COM
INERR:	PRINT	CRLF
	PRINTL	'ERROR - NO SUCH DESTINATION$'
	JMP	MOREIN	;ERROR IN INPUT COMMAND STRING EXIT
;
;    SELECT DISK DRIVE
;
DT1:	$MATCH	88H,'SYNC'	;TEST FOR WRITE SYNC STREAM
	JC	SYNC
	$MATCH	88H,'A:'	;DRIVE A
	JNC	DT2
	XRA	A		;0 - DRIVE A
	STA	NEWDRV
	JMP	DOWN
DT2:	$MATCH	88H,'B:'	;DRIVE B
	JNC	DTAPE
	MVI	A,1		;1 - DRIVE B
	STA	NEWDRV
DOWN:	MOVE	84H,82H,120	;SHIFT BUFFER DOWN TWO BYTES
	LXI	H,80H		;POINTS TO LENGTH OF COMMENT
	DCR	M
	DCR	M		;DECR LENGTH BY 2
;
;  DTAPE - START OF DISK TO TAPE ROUTINE
;
DTAPE:	FILFCB	FCB,SLOC1	;FILL IN FCB FROM INPUT BUFFER
	JC	NAMERR		;ERROR IN NAME PRINT ERROR MESSAGE
	PUSH	H		;POINTER TO START OF COMMENT
	FILL	FILBUF,FILBUF+128,20H   ;BLANK COMMENT FIELD OF FILE
	LDA	80H		;POINTS TO LENGTH OF COMMENT
	ADI	81H
	LXI	H,0		;ZERO HL
	MOV	L,A		;HL POINTS TO END OF COMMENT
	POP	D		;POINTS TO START OF COMMENT
	LXI	B,FILBUF+11	;POINTS TO OUTPUT BUFFER
MOVCOM:	CPHL			;FINISHED MOVE ?
	JZ	ENDMOV
	LDAX	D		;GET BYTE OF COMMENT
	STAX	B		;STORE IT
	INX	D
	INX	B
	JNZ	MOVCOM		;LOOP BACK
ENDMOV:	CALL	SCANFCB		;CHECK FOR AMBIGUOUS FILE NAME
	JNC	DTAPE1
	MOVE	FCB,AMBNAM,12	;SAVE AMBIGUOUS FILE NAME
	MVI	A,0FFH
	STA	AMBIG		;SET AMBIGUOUS NAME FLAG
	RESDRV	NEWDRV		;SELECT NEW DRIVE IF ANY
	CALL	GETNAM
DAM:	LXI	D,FCB		;POINT TO FCB
	MVI	C,12		;LENGTH
MNAM:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	MNAM		;MOVE NAME
	FILL	FCB+12,FCB+8	;ZERO REST OF FCB
DTAPE1:	MOVE	FCB+1,FILBUF,11	;MOVE NAME TO OUTPUT BUFFER
	RESDRV	NEWDRV		;SELECT NEW DRIVE
	OPEN	FCB
	JNC	LDFIL
OPNERR:	PRINT	CRLF

	LDA	NEWDRV
	ORA	A
	JNZ	OER1
	PRINTL	'NO FILE BY THAT NAME ON DRIVE A$'
	JMP	MOREIN
OER1:	PRINTL	'NO FILE BY THAT NAME ON DRIVE B$'
	JMP	MOREIN
LDFIL:	LXI	H,FILBUF+128	;SET DISK FILE BUFFER POINTER
	SHLD	BPOINT
	LXI	H,80H
	SHLD	IPOINT		;RESET INPUT BUFFER POINTER TO 80H
	LXI	H,0
	SHLD	NBLOCKS		;INITIALIZE BLOCK COUNT TO ZERO
LD1:	READ	FCB		;READ A RECORD FROM DISK
	JC	ENDFIL		;EXIT IF ERROR OR EOF
	MOVEI	IPOINT,BPOINT,128	;MOVE BLOCK TO BUFFER
	INDEX	NBLOCKS,1	;INDEX BLOCK COUNT BY ONE
	INDEX	BPOINT,128	;INDEX BUFFER POINTER BY 128
	XCHG
	LHLD	MEMEND		;TEST FOR MEMORY OVERFLOW
	CPHL			;COMPARE DE AND HL
	JNC	LD1		;BACK TO READ LOOP
MEMFUL:	PRINT	CRLF2
	PRINTL	'BLOCKED TAPE REQUESTED OR$'
	PRINT	CRLF
	PRINTL	'FILE TOO LARGE FOR MEMORY$'
	PRINT	CRLF
	PRINTL	'WRITING BLOCKED OUTPUT TAPE$'
	LDA	FAMBIG
	ORA	A
	JNZ	GOBLK		;DISPLAY MESS ONLY FOR FIRST BLK
	MVI	A,-1
	STA	FAMBIG		;START TAPE DISPLAY OFF
	CALL	STARTW		;DISPLAY START MESSAGE
GOBLK:	PRINT	CRLF2
	MOVE	FILBUF,FILBUF+1280,128	;SAVE COMMENT FIELD
	JMP	BLKOUT		;WRITE BLOCKED OUTPUT TAPE
ENDFIL:	CPI	1		;TEST FOR EOF
	JZ	TAPE
RDERR:	PRINT	CRLF
	PRINTL	'DISK READ ERROR$'
	JMP	MOREIN		;EXIT
TAPE:	LHLD	NBLOCKS		;GET NO OF 128 BYTE BLOCKS READ
	INX	H
	INX	H		;ADD 2 FOR ROUNDING
	MOV	A,H		;SHIFT RIGHT 1 BIT DOUBLE
	RAR
	MOV	A,L
	RAR
	PUSH	PSW		;STACK HAS NO OF 256 BYTE BLOCKS
	JC	PM1		;CARRY SET, PRINT MESSAGE
	LHLD	BPOINT		;NOT SET, FILL LAST 128 BYTES WITH ^Z
	PUSH	H
	INDEX	BPOINT,128
	XCHG			;END OF BLOCK IN D
	LHLD	MEMEND		;TOP OF MEMORY
	CPHL
	JC	MEMFUL		;MEMORY FILLED PRINT ERROR MESSAGE
	POP	H		;BEGINING OF BLOCK IN HL
LF1:	MVI	A,1AH		;CONTROL Z
	MOV	M,A		;STORE IT IN MEMORY
	INX	H
	CPHL			;LIMIT REACHED
	JNZ	LF1
PM1:	LDA	FAMBIG
	ORA	A
	JNZ	PMX		;NO START MESSAGE
	CALL	STARTW		;DISPLAY MESSAGE
	MVI	A,0FFH
	STA	FAMBIG		;SET SWITCH FOR DISPLAY OFF
PMX:	CALL	WRID		;WRITE AN ID BLOCK ON TAPE
	POP	B		;NO OF 256 BYTE BLOCKS IN B
	LXI	H,FILBUF
	MVI	C,1		;RECORD TYPE
	CALL	TAPOUT		;WRITE THE RECORD
PMY:	LDA	AMBIG		;AMBIGUOUS NAME FLAG
	ORA	A
	JZ	PM2		;NOT SET THEN EXIT
	CALL	GETNAM		;SEARCH DIR WITH PREVIOUS NAME
	MOVE	AMBNAM,FCB,12	;AMBIG NAME FOR NEXT SEARCH
	CALL	GETNEXT		;SEARCH DIR FOR NEXT NAME
	JC	PM2		;EXIT IF NO MORE NAMES
	PUSH	H
	PRINT	CRLF2		;SPACE AND RING BELL
	POP	H
	JMP	DAM		;WRITE THE FILE ON TAPE
PM2:	CALL	STOP		;DISPLAY STOP MESSAGE
	JMP	MOREIN		;EXIT
;
;    THIS ROUTINE WRITES BLOCKED OUTPUT TAPES FOR FILES
;    TOO LARGE FOR MEMORY
;
BLKOUT:	CLOSE	FCB
	FILL	FCB+12,FCB+8,0
	FILL	FILBUF+128,FILBUF+1024,1AH
	OPEN	FCB		;POSITION FILE TO FIRST RECORD
	LXI	H,FILBUF+128
	SHLD	BPOINT
	LXI	H,80H
	SHLD	IPOINT		;RESET DATA TRANSFER POINTERS
	MVI	A,0FFH
	STA	FIRST		;INDICATE FIRST RECORD
	MVI	A,15
	STA	BLKBLK		;RESET BLOCK COUNTER
RBEG:	MVI	A,1
	STA	BLOCK		;SET BLOCK COUNT TO 1
RLOOP:	READ	FCB		;READ A RECORD FROM DISK
	JC	FEND		;CARRY SET ON EOF OR ERROR
	MOVEI	IPOINT,BPOINT,128	;MOVE BLOCK
	LDA	BLOCK
	CPI	8
	JZ	TAPWRT		;IF 8 RECORDS WRITE TAPE
	INR	A
	STA	BLOCK		;INCR BLOCK COUNT
	INDEX	BPOINT,128	;INCR  ADDR BY 128
	JMP	RLOOP
FEND:	CPI	1
	JNZ	RDERR		;DISK READ ERROR
	MVI	C,2		;TYPE
	XRA	A		;CLEAR CARRY
	LDA	BLOCK		;BLOCK COUNT
	INR	A
	RAR			;NO OF 256 BYTE BLOCKS
	MOV	B,A		;STORE IN B
	LXI	H,FILBUF	;BUFFER POINTER
	CALL	WRSPAC		;WRITE SPACER BLOCK
	CALL	TAPOUT
	MOVE	FILBUF+1280,FILBUF,128	;RESTORE COMMENT FIELD
	JMP	PMY		;PRINT MESSAGE AND EXIT
TAPWRT:	LDA	FIRST
	ORA	A		;IS THIS THE FIRST RECORD
	JNZ	BLK1		;YES, WRITE IT WITH HEADER
	MVI	C,1
	MVI	B,4		;BLOCK COUNT
BLKN:	LXI	H,FILBUF	;BUFFER POINTER
	CALL	WRSPAC		;WRITE SPACER BLOCK
	CALL	TAPOUT		;WRITE TAPE
	FILL	FILBUF,FILBUF+1024,1AH
	LXI	H,FILBUF
	SHLD	BPOINT
	JMP	RBEG		;BACK FOR MORE DISK INPUT
BLK1:	CALL	WRID		;WRITE FILE HEADER
	MVI	C,0		;FIRST BLOCK TYPE 0
	MVI	B,5		;5 BLOCKS WITH HEADER
	XRA	A
	STA	FIRST		;NOT FIRST
	JMP	BLKN		;BACK TO OUTPUT
;
;
;    RUN TAPE FILE
;
RUNFIL:	LXI	H,87H
	SHLD	SLOC1		;POINTER TO FILE NAME
	MVI	A,0FFH
	STA	RUNFLG		;SET RUN FLAG TRUE
	JMP	TDISK
;
;    SELECT DISK DRIVE
;
ADISK:	XRA	A		;0 - DRIVE A

	STA	NEWDRV
	JMP	BD1
BDISK:	MVI	A,1		;1 - DRIVE B
	STA	NEWDRV
BD1:	LXI	H,85H
	SHLD	SLOC1		;POINTER TO NAME
;
;  TDISK - START OF TAPE TO DISK ROUTINE
;
TDISK:	FILFCB	FCB,SLOC1	;FILL IN FCB FROM INPUT BUFFER
	JC	NAMERR		;FILE NAME ERROR PRINT MESS
	CALL	SCANFCB		;CONVERT * TO ? IN AMBIG FILE NAMES
	JNC	TDISK1
	MVI	A,-1
	STA	AMBIG		;SET AMBIGUOUS NAME FLAG
	MOVE	FCB,AMBNAM,12	;SAVE AMBIG NAME
TDISK1:	MOVE	80H,FILBUF,128	;SAVE NAME AND COMMENT, RESDRV MAY USE BUFFER
	RESDRV	NEWDRV		;LOAD NEW DRIVE NO IF SELECTED
	MOVE	FILBUF,80H,128	;RESTORE NAME AND COMMENT
	PRINT	CRLF2
	PRINTL	'START CASSETTE TAPE - TYPE CARRIAGE RETURN$'
	PRINT	CRLF2
	CONIN			;WAIT FOR CONSOLE INPUT
	CPI	3		;CONTROL C ?
	JZ	MOREIN		;RETURN TO MONITOR
	JMP	TAPIN		;TO TAPE INPUT ROUTINE
;
;   CASW - CASSETTE OUTPUT ROUTINE  (DATA IN A)
;
CASW:	PUSH	H		;SAVE REGS
	PUSH	D
	PUSH	B
	PUSH	PSW
	CALL	ESCAPE		;CHECK FOR CONTROL C
CAS1:	IN	CASC		;GET STATUS
	ANI	20H
	JNZ	CAS1		;WAIT FOR STATUS READY
	POP	PSW		;DATA BACK TO A
	PUSH	PSW		;SAVE IT AGAIN
	OUT	CASD		;WRITE BYTE TO TAPE
	OUT	0FFH		;OUT TO LIGHTS
	LXI	H,CKSUM		;MEMORY ADDR OF CHECKSUM
	ADD	M		;ADD TO A
	STA	CKSUM		;STORE IT BACK
	POP	PSW		;GET BACK DATA
	CALL	DISPLY		;OUTPUT TO CONSOLE
	POP	B		;RESTORE REGISTERS
	POP	D
	POP	H
	RET
CASC	==	6EH		;CASSETTE STATUS PORT
CASD	==	6FH		;CASSETTE DATA   PORT
;
CASR:	PUSH	H		;SAVE REGISTERS
	PUSH	D
	PUSH	B
ETEST:	CALL	ESCAPE		;CHECK FOR CONTROL C
READCT:	IN	CASC		;READ CASSETTE STATUS
	ANI	10H		;CHECK BIT 4
	JNZ	ETEST		;WAIT TILL READY
	IN	CASD		;READ CASSETTE DATA
	PUSH	PSW		;SAVE IT
	OUT	0FFH		;OUT TO LIGHTS
	LXI	H,CKSUM		;POINTER TO CKSUM
	ADD	M		;ADD IT TO DATA
	STA	CKSUM		;STORE IT BACK
	POP	PSW		;GET BACK DATA
	PUSH	PSW		;SAVE IT AGAIN
	CALL	DISPLY		;OUT TO CONSOLE
	POP	PSW		;GET BACK DATA
	POP	B
	POP	D
	POP	H		;RESTORE REGISTERS
	RET
;  ESCAPE - TEST FOR CONTROL C AND RETURN TO MONITOR
;
ESCAPE:	MVI	C,11
	CALL	5
	ANI	1
	RZ			;RETURN IF LOW BIT NOT SET
	CONIN
	CPI	3		;TEST FOR ^C
	JZ	MOREIN		;EXIT TO MONITOR OR BACK TO INPUT
	RET
;
;
;   DISPLY - OUTPUT A TO CONSOLE AND SUBSTITUTE . FOR ^ CHARACTERS
;
DISPLY:	PUSH	PSW		;SAVE DATA
	LDA	DISFLG		;DISPLAY FLAG
	ORA	A
	JZ	YSKIP		;OUT IF ZERO
	LDA	DFLAG1
	ORA	A		;DISPLAY OFF FOR SLOW TERMINALS
	JNZ	YSKIP		;OUT IF NOT ZERO
	LDA	BCOUNT		;COUNT OF BYTES PER LINE
	DCR	A		;DECR BY ONE
	STA	BCOUNT		;STORE IT BACK
	JNZ	USKIP		;CONTINUE IF NOT END OF LINE
	PRINT	CRLF
	MVI	A,64		;CHAR PER LINE
	STA	BCOUNT		;RESET COUNTER
USKIP:	POP	PSW		;GET BACK DATA
	CPI	7FH		;COMPARE WITH RUBOUT
	JP	VSKIP		;PRINT PERIOD
	CPI	20H		;COMPARE WITH SPACE
	JP	XSKIP		;SKIP SUBSTITUTION
VSKIP:	MVI	A,2EH		;ASCII PERIOD
XSKIP:	CONOUT			;OUT TO CONSOLE
	RET
YSKIP:	POP	PSW
	RET
;   NAME ERROR IN FILE NAME - PRINT ERROR MESSAGE
;
NAMERR:	PRINT	CRLF
	PRINTL	'ERROR IN FILE NAME$'
	JMP	MOREIN		;EXIT BACK TO MONITOR
;
;
;
;   TAPEOUT - OUTPUT BLOCK OF TAPE IN TARBELL FORMAT
;
TAPOUT:	PUSH	H		;SAVE POINTER
	LXI	H,BLKBLK	;POINT TO BLOCK COUNT
	INR	M		;INCR BY ONE
	MVI	A,16		;BLOCK LIM 1
	CMP	M
	JZ	T0		;WRITE SPACER BLOCK
	INR	A
	CMP	M		;IS COUNT 18
	JNZ	T1		;NO EXTRA SPACE BLOCK
	MVI	M,1		;SET BLOCK COUNT TO ONE
T0:	CALL	WRSPAC		;WRITE SPACE BLOCK
	CALL	WRSPAC		;WRITE SPACE BLOCK
T1:	POP	H		;RESTORE POINTER
	MVI	A,3CH		;START BYTE
	CALL	CASW		;WRITE IT OUT
	MVI	A,0E6H		;SYNC BYTE
	CALL	CASW		;WRITE IT
	XRA	A
	STA	CKSUM		;ZERO CHECKSUM
	MVI	A,0FFH		;DECODE BYTE
	CALL	CASW		;WRITE IT
	MOV	A,C		;TYPE BYTE
	CALL	CASW		;WRITE IT TO TAPE
	MOV	A,B		;NO OF 256 BYTE BLOCKS
	CALL	CASW		;WRITE IT OUT
	MVI	A,0FFH		;SET DISPLAY FLAG
	STA	DISFLG
T2:	MVI	C,0		;BLOCK LENGTH IN BYTES - 1
T3:	MOV	A,M		;GET A BYTE FROM MEMORY
	CALL	CASW		;WRITE IT TO CASSETTE
	INX	H
	DCR	C
	JNZ	T3		;LOOP TILL END OF BLOCK
	DCR	B
	JNZ	T2		;LOOP TILL ALL BLOCKS DONE
T4:	XRA	A
	STA	DISFLG		;TURN OFF DISPLAY
	LDA	CKSUM
	CALL	CASW		;WRITE CHECKSUM
	RET			;BYE
;
;  TAPIN - TAPE INPUT ROUTINE
;
TAPIN:	XRA	A
	STA	DISFLG		;TURN OFF DISPLAY
	CALL	RDID		;SEARCH TAPE FOR ID BLOCK
	XRA	A		;ZERO
	STA	CKSUM		;ZERO CHECKSUM
	MVI	A,10H
	OUT	CASC		;RESET RECEIVER
	CALL	CASR		;READ DECODE BYTE
	CPI	0FFH		;CHECK IT
	JNZ	TAPIN
	CALL	CASR		;READ TYPE BYTE
	STA	TYPE		;SAVE IT
	CPI	3		;CHECK TYPE < 3
	JP	TAPIN
	CALL	CASR		;READ LENGTH
	LXI	H,0
	MOV	L,A		;NO OF 256 BYTE BLOCKS ON TAPE
	MOV	B,A		;SAVE IT IN B
	DAD	H		;SHIFT LEFT 1
	DCX	H		;NUMBER OF 128 BYTE BLOCKS (FOR DISK)
	SHLD	NBLOCKS		;STORE TO MEMORY
	MVI	A,0FFH		;.TRUE.
	STA	DISFLG		;TURN ON DISPLAY FLAG
	LXI	H,FILBUF	;BUFFER POINTER
	LXI	D,1		;BLOCK COUNT FOR NAME CHECK
RD1:	MVI	C,128		;NO BYTES PER BLOCK - 1
RD2:	CALL	CASR		;READ A BYTE
	MOV	M,A		;STORE IT
	INX	H
	DCR	C		;DECR LENGTH
	JNZ	RD2		;LOOP BACK
	DCX	D
	MOV	A,D		;DECR BLOCK COUNT FOR NAME CHECK
	ORA	E
	JZ	NAMCHK		;COMPARE NAME FROM TAPE WITH FCB
GOON:	DCR	B		;DECR NO OF BLOCKS
	MVI	C,0		;NO OF BYTES PER BLOCK - 1
	JNZ	RD2		;LOOP BACK
	SHLD	ENDF		;SAVE LOCATION OF LAST BYTE READ
	LDA	CKSUM		;GET CHECKSUM FROM MEMORY
	MOV	B,A		;STORE IT TEMPORARILY IN B
	XRA	A		;ZERO
	STA	DISFLG		;TURN OFF DISPLAY
	CALL	CASR		;READ CHECKSUM FROM TAPE
	SUB	B		;COMPARE IT WITH MEMORY
	JNZ	TPERR		;CHECKSUM ERROR
	LDA	AMBIG		;CHECK AMBIG FLAG
	ORA	A
	JNZ	PCR2		;TO DISK ROUTINE
	CALL	STOP		;DISPLAY STOP MESSAGE
	JMP	WDISK		;TO DISK WRITE ROUTINE
PCR2:	PRINT	CRLF2		;CARRIAGE RET
	JMP	WDISK		;TO DISK WRITE ROUTINE
;
TPERR:	PRINT	BELL
	PRINTL	'CHECKSUM ERROR$'
	PRINT	CRLF
	PRINTL	'TO RESTART - REWIND TAPE AND TYPE CARRIAGE RETURN$'
	PRINT	CRLF
	CONIN			;READ CONSOLE
	CPI	3		;CONTROL C ?
	JZ	MOREIN		;RETURN TO MONITOR
	JMP	TAPIN		;BACK TO TAPE INPUT ROUTINE
;
;
NAMCHK:	PUSH	H
	PUSH	D
	PUSH	B
	PRINT	CRLF
	LXI	H,FILBUF	;SET POINTERS
	LXI	D,FCB+1
	MVI	C,11
NAMC1:	DCR	C
	JM	NAMC3		;MATCH IF MINUS
	LDAX	D		;GET BYTE OF FCB NAME
	CPI	'?'
	JNZ	NAMCY
	MOV	A,M		;CHECK NAME FOR NON PRINTABLE CHAR
	CPI	20H
	JM	NAMC2
	CPI	7FH		;DELETE CODE
	JP	NAMC2
	JMP	NAMCX
NAMCY:	CMP	M		;COMPARE WITH FILE NAME
	JNZ	NAMC2
NAMCX:	INX	H
	INX	D
	JMP	NAMC1
NAMC2:	XRA	A		;CLEAR CARRY
	JMP	ENDCK
NAMC3:	STC
ENDCK:	POP	B
	POP	D
	POP	H
	JC	TYPCHK		;MATCH, CHECK TYPE
	JMP	TAPIN		;NO MATCH SEARCH SOME MORE
TYPCHK:	LDA	TYPE		;GET TYPE
	CPI	1		;IS IT TYPE 1
	JZ	RD1		;YES,UNBLOCKED RECORD
;
;    THIS ROUTINE READS BLOCKED TAPES
;
BLKIN:	PUSH	B		;SAVE BLOCK COUNT
	MOVE	FILBUF,FCB+1,11	;MOVE NAME INTO FCB
	XRA	A
	STA	FCB+32
	POP	B		;RESTORE BLOCK COUNT
	LXI	H,FILBUF	;POINTER TO BUFFER
	MVI	C,128		;BYTES LEFT IN FIRST BLOCK
RD5:	CALL	CASR		;READ A BYTE FROM TAPE
	MOV	M,A		;STORE IN BUFFER
	INX	H		;INCR BUFFER POINTER
	DCR	C		;DECR BYTE COUNT
	JNZ	RD5		;BLOCK NOT FINISHED
	MVI	C,0		;RESET BYTES PER BLOCK (256)
	DCR	B		;DECR BLOCK COUNT
	JNZ	RD5		;READ ANOTHER BLOCK
	SHLD	ENDF		;SAVE LAST LOCATION USED IN BUFFER
	XRA	A
	STA	DISFLG		;TURN OFF DISPLAY
	LDA	CKSUM		;GET CHECKSUM READ FROM TAPE
	MOV	B,A		;SAVE IT IN B
	CALL	CASR		;READ BLOCK CHECKSUM
	SUB	B		;COMPARE
	JNZ	TPERR		;CHECKSUM ERROR
;
;    NOW WRITE THE BLOCK ON DISK OR VERIFY IT
;
	LDA	TYPE		;GET TYPE
	ORA	A
	JNZ	WBLK		;IF NOT ZERO WRITE BLOCK
	LDA	VERFLG		;CHECK VERIFY FLAG (SET IF CKSUM ERROR)
	ORA	A
	JNZ	VERBLK		;VERIFY TAPE
	$INSTR	IPOINT,120,'VERIFY'	;VERIFY FILE ?
	JNC	REN1
	MVI	A,0FFH
	STA	VERFLG		;SET VERIFY FLAG
	JMP	VERBLK
REN1:	CALL	RENFIL		;RENAME FILE ?
	$INSTR	IPOINT,120,'RUN'	;RUN FILE ?
	JC	RUNERR
	CALL	$$$TYP		;SAVE OLD TYPE AND SUB $$$
	DELMAK	FCB		;IF FIRST BLOCK DELETE
WD3X:	OPEN	FCB		;AND OPEN FILE
	LDA	NBLOCKS		;NO OF 128 BYTE BLOCKS
	DCR	A		;SUBTRACT 1 FOR HEADER
	STA	NBLOCKS		;STORE IT BACK
WBLK:	LDA	VERFLG		;CHECK VERIFY ONLY
	ORA	A
	JNZ	VERNXT
	LXI	H,FILBUF	
	SHLD	BPOINT		;SET DMA ADDR
WD4:	MOVEI	BPOINT,IPOINT,128	;MOVE BLOCK
	WRITE	FCB		;WRITE A RECORD ON DISK
	JC	DERR		;DISK WRITE ERROR (FULL)
	INDEX	BPOINT,128	;INCR  ADDR BY 128
	LDA	NBLOCKS		;BLOCK COUNT
	DCR	A
	STA	NBLOCKS		;DECR BY 1
	JNZ	WD4		;WRITE ANOTHER BLOCK
WD4X:	LDA	TYPE
	CPI	2		;IS IT LAST BLOCK
	JZ	WD5		;CLOSE FILE AND EXIT
	XRA	A
	STA	CKSUM		;ZERO CHECKSUB
	STA	DISFLG		;TURN OFF DISPLAY
	MVI	A,10H
	OUT	CASC		;RESET RECEIVER
	CALL	CASR		;READ DECODE BYTE
	CALL	CASR		;READ	TYPE
	STA	TYPE		;SAVE IT
	CALL	CASR		;READ	LENGTH
	LXI	H,0
	MOV	L,A
	MOV	B,A		;NO OF 256 BYTE BLOCKS
	DAD	H
	SHLD	NBLOCKS		;SAVE NO OF 128 BYTE BLOCKS
	LXI	H,FILBUF	;BUFFER POINTER
	MVI	C,0		;NO OF BYTES PER BLOCK (256)
	MVI	A,0FFH
	STA	DISFLG		;TURN ON DISPLAY
	JMP	RD5		;READ ANOTHER BLOCK
WD5:	LDA	AMBIG		;CHECK AMBIG FILE NAME FLAG
	ORA	A
	JNZ	WD6		;OMIT STOP MESSAGE
	CALL	STOP		;DISPLAY STOP TAPE MESSAGE
WD6:	LDA	VERFLG		;CHECK VERIFY FLAG
	ORA	A
	JNZ	VOUT
	JMP	DWCLOS
;
;   WDISK - DISK OUTPUT ROUTINE
;
WDISK:	MOVE	FILBUF,FCB+1,11	;MOVE NAME INTO FCB
	LDA	VERFLG
	ORA	A
	JNZ	VERIFY
	$INSTR	IPOINT,120,'VERIFY'	;VERIFY ONLY?
	JC	VERIFY
	$INSTR	IPOINT,120,'RUN'	;LOAD AND EXEC FILE?
	JC	RUN
	LDA	RUNFLG		;GET RUN FLAG, OTHER RUN TEST
	ORA	A
	JNZ	RUN
	CALL	RENFIL		;RENAME ?
WDISK1:	CALL	$$$TYP		;CHANGE TYPE TO $$$ AND SAVE OLDTYP
	DELMAK	FCB		;DELETE AND MAKE FILE
	OPEN	FCB		;OPEN THE FILE
	JC	OPNERR		;ERROR ON OPEN - PRINT MESS AND EXIT
	LXI	H,FILBUF+128	;POINTER TO START OF FILE IN MEMORY
	SHLD	BPOINT		;SET POINTER
DWLOOP:	MOVEI	BPOINT,IPOINT,128	;MOVE INDIRECT BLOCK TO OUT BUFFER
	WRITE	FCB		;WRITE IT OUT
	JC	DERR		;JUMP TO WRITE ERROR
	LHLD	NBLOCKS		;NO OF BLOCKS TO WRITE
	DCX	H		;DECREMENT IT
	MOV	A,H
	ORA	L
	JZ	DWCLOS		;CLOSE FILE AND EXIT
	SHLD	NBLOCKS		;OTHERWISE STORE IT BACK
	INDEX	BPOINT,128	;INCR MEMORY POINTER BY 128
	JMP	DWLOOP		;BACK TO WRITE ANOTHER BLOCK
;
DWCLOS:	CLOSE	FCB		;CLOSE FILE
	MOVE	FCB,FCB+16,12	;RENAME FILE
	MOVE	OLDTYP,FCB+25,3
	MVI	C,19		;DELETE
	LXI	D,FCB+16
	CALL	5
	MVI	C,23
	LXI	D,FCB
	CALL	5		;RENAME ROUTINE
	JMP	AMBCHK		;RETURN FOR MORE TAPE INPUT ON AMBIG NAME
;
;
VERIFY:	LXI	H,FILBUF+128	;POINTER TO START OF TAPE FILE
	SHLD	BPOINT
	MVI	A,-1
	STA	VERFLG		;SET VERIFY FLAG
	OPEN	FCB		;OPEN THE DISK FILE
	JC	OPNERR		;PRINT ERROR MESSAGE IF NO FILE
VLOOP:	READ	FCB		;READ A DISK RECORD
	JC	VEND		;EXIT ON EOF OR ERROR
	LHLD	BPOINT		;POINTER FOR COMPARE
	IMATCH	80H,HL,128	;COMPARE (HL POINTS TO ONE STRING)
	JNC	VERERR		;EXIT IF NO MATCH
	INDEX	BPOINT,128	;INCR THE POINTER
	JMP	VLOOP		;DO ANOTHER RECORD
VEND:	CPI	1		;CHECK END FILE
	JNZ	RDERR		;READ ERROR IF NOT 1
VOUT:	PRINT	BELL2
	PRINTL	'VERIFIED SUCCESSFULLY$'
	PRINT	CRLF
AMBCHK:	LDA	AMBIG		;CONTINUE IF AMBIGUOUS FILE NAME
	ORA	A
	JZ	MOREIN		;EXIT
	MOVE	AMBNAM,FCB,12	;REPLACE AMBIG NAME IN FCB
	XRA	A
	STA	FCB+12		;ZERO EXTENTS
	STA	FCB+32
	JMP	TAPIN		;BACK TO TAPE INPUT
;
;    THIS SECTION MOVES THE FILE TO 100H AND EXECUTES IT. A CHECK IS
;    MADE TO VERIFY THAT IT IS A COM FILE.
;
RUN:	$MATCH	65H,'COM'	;TYPE IN FCB
	JNC	TYPERR
	MOVE	CODE,80H,40	;FILE OVERLAYS PROG MOVE TO BUFFER
	JMP	80H		;GO EXECUTE MOVE ROUTINE
CODE:	LXI	B,100H
	LXI	D,FILBUF+128	;POINTS TO BEGINNING OF FILE
	LHLD	ENDF		;LAST LOC TO BE MOVED
MLOOP:	LDAX	D		;GET A BYTE
	STAX	B		;STORE IT
	INX	D
	INX	B
	MOV	A,H		;COMPARE DE WITH HL
	CMP	D
	JNZ	89H
	MOV	A,L
	CMP	E
	JNZ	89H
	LXI	H,0
	SHLD	80H		;ZERO START OF INPUT BUFFER
	JMP	100H		;EXECUTE MOVED FILE
;
;    RENAME ROUTINE - RENAME FILE FOR TAPE TO DISK TRANSFER
;
RENFIL:	$INSTR	IPOINT,120,'RENAME'	;RENAME ?
	RNC			;RETURN IF NO 'RENAME'
SKPBLK:	INX	H		;INCR POINTER
	MOV	A,M		;GET A BYTE
	CPI	20H		;IS IT A BLANK
	JZ	SKPBLK		;SKIP OVER BLANKS
	SHLD	SLOC2		;STORE POINTER
	FILFCB	FCB,SLOC2	;FILL IN FCB WITH NEW NAME
	JC	NAMERR		;ERROR IN NAME (TOO LONG)
	RET
;
;    VERIFY BLOCKED TAPE
;
VERBLK:	OPEN	FCB		;OPEN THE FILE
	JC	OPNERR		;EXIT IF NO FILE
VERNXT:	LXI	H,FILBUF+1024	;POINTER FOR DISK INPUT
	SHLD	BPOINT
	LDA	NBLOCKS
	CPI	9		;SET BLOCKS TO 8 IF > 8
	JM	VER2
	MVI	A,8		;SET BLOCKS TO 8
	STA	NBLOCKS
VER2:	READ	FCB		;READ A RECORD
	JNC	VER3
	CPI	1		;TEST EOF
	JNZ	RDERR		;DISK READ ERROR
	JMP	WD5		;PRINT STOP MESSAGE AND EXIT
VER3:	MOVEI	IPOINT,BPOINT,128
	INDEX	BPOINT,128	;INCR POINTER
	LDA	NBLOCKS		;BLOCK COUNT
	DCR	A
	STA	NBLOCKS		;DECR COUNT BY 1
	JNZ	VER2		;READ SOME MORE
	LHLD	BPOINT		;POINTS TO END OF BLOCK
	DCX	H		;DECR BY 1
	XCHG			;TO DE
	LXI	H,FILBUF+1024	;POINTS TO DISK DATA
	LXI	B,FILBUF	;POINTS TO TAPE DATA
VER4:	LDAX	B		;GET A BYTE
	CMP	M		;COMPARE
	JNZ	VERERR		;ERROR, NO MATCH
	INX	H
	INX	B
	CPHL			;COMPARE HL AND DE
	JNZ	VER4
	JMP	WD4X		;BACK INTO TAPE INPUT ROUTINE
;
;    THIS ROUTINE SCANS FCB NAME AND FILLS * TO ?.
;    CARRY SET SET IF * OR ? IN FILE NAME
;
SCANFCB:LXI	H,FCB+1		;POINTS TO FILE NAME
	MVI	B,'?'
	MVI	A,'*'
	CMP	M		;IS NAME *
	JNZ	SCAN2
	MVI	C,8		;FILL IN 8 '?'
SCAN1:	MOV	M,B		;MOVE A BYTE
	INX	H
	DCR	C
	JNZ	SCAN1
SCAN2:	LXI	H,FCB+9		;POINTS TO TYPE
	CMP	M		;IS TYPE A *
	JNZ	SCAN4
	MVI	C,3		;FILL TYPE WITH '?'
SCAN3:	MOV	M,B		;MOVE A BYTE
	INX	H
	DCR	C
	JNZ	SCAN3
SCAN4:	LXI	H,FCB+1		;RESCAN FOR ? AND SET CARRY
	MVI	C,11
	MOV	A,B		;PUT '?' IN A
SCAN5:	CMP	M
	JZ	SCAN6
	INX	H
	DCR	C
	JNZ	SCAN5
	XRA	A		;CARRY OFF NO '?'
	RET
SCAN6:	STC			;CARRY ON
	RET
;
;    THIS ROUTINE SEARCHES DIRECTORY WITH AMBIGUOUS FILE NAME
;
GETNAM:	MVI	A,0
	STA	FCB+12		;SET FILE EXTENT TO ZERO
	SEARCH	FCB
	CPI	0FFH		;CHECK NAME NOT PRESENT
	JZ	OPNERR		;DISPLAY ERROR MESSAGE
	JMP	N1
GETNEXT:SERNXT	FCB		;SEARCH FOR NEXT OCCURRANCE OF NAME
	CPI	0FFH		;NAME NOT FOUND ?
	JNZ	N1		;RETURN ADDR IF FOUND
	STC
	RET			;SET CARRY AND RETURN
N1:	ANI	03		;ADDR MOD 4
	RRC
	RRC
	RRC			;ADDR * 32
	ADI	80H		;ADD BASE ADDR 
	LXI	H,0
	MOV	L,A		;HL NOW POINTS TO FCB FROM DIR
	XRA	A		;CLEAR CARRY
	RET
;
;   WRITE SYNC STREAM ON TAPE (65K BYTES)
;
SYNC:	CALL	STARTW		;PRINT START MESSAGE
	MVI	A,0FFH
	STA	DISFLG		;TURN ON DISPLAY
	LXI	D,0		;SYNC BYTE COUNTER
SYNC1:	MVI	A,0E6H		;LOAD A SYNC BYTE
	CALL	CASW		;WRITE IT OUT
	DCX	D		;DECR COUNT
	MOV	A,D
	ORA	E
	JNZ	SYNC1		;TEST COUNT AND LOOP
	CALL	STOP		;PRINT STOP MESSAGE
	JMP	MOREIN
;
;
;    SWAP FCB TYPE WITH $$$
;
$$$TYP:	MOVE	FCBTYP,OLDTYP,3	;MOVE TYPE TO TEMPORARY STORAGE
	FILL	FCBTYP,FCBTYP+2,'$'
	RET
;
;    WRITE LEADER AND ID BLOCK OF 100 76H BYTES ON TAPE
;
WRID:	LXI	D,1500		;LOAD COUNT
WRHD:	MVI	A,3CH		;START BYTE
	CALL	CASW		;WRITE IT
	DCX	D		;DECR COUNT
	MOV	A,D
	ORA	E
	JNZ	WRHD		;LOOP TILL ZERO
	MVI	D,100		;LOAD COUNT
	MVI	A,0E6H		;SYNC BYTE
	CALL	CASW		;WRITE IT
WRID1:	MVI	A,76H		;HALT CODE
	CALL	CASW		;WRITE IT
	DCR	D
	JNZ	WRID1		;WRITE ANOTHER BYTE
	RET
;
;    SEARCH FOR BLOCK OF 100 76H BYTES ON TAPE
;
RDID:	MVI	D,100		;LOAD COUNT
	MVI	A,10H
	OUT	CASC		;RESET RECEIVER
RDID1:	CALL	CASR		;READ A BYTE
	CPI	76H		;COMPARE WITH 76H
	JNZ	RDID		;START OVER
	DCR	D		;DECR COUNT
	JNZ	RDID1		;READ ANOTHER BYTE
	RET
;
;
;
;   WRITE SPACER BLOCK OF START BYTES FOR BLOCKED TAPES
;
WRSPAC:	PUSH	H
	PUSH	D
	PUSH	B
	LXI	D,160		;COUNT
WRSP1:	MVI	A,3CH		;START BYTE
	CALL	CASW		;WRITE IT
	DCX	D		;DECR COUNT
	MOV	A,D
	ORA	E
	JNZ	WRSP1		;LOOP TILL COUNT IS ZERO
	POP	B
	POP	D
	POP	H
	RET
;
;   CONSOLE MESSAGE ROUTINES
;
STARTW:	PRINT	CRLF2
	PRINTL	'START CASSETTE TAPE <<RECORD>> - TYPE CARRIAGE RETURN$'
	PRINT	CRLF2
	CONIN
	CPI	3		;ESCAPE CHARACTER
	JZ	GETOUT
	RET
GETOUT:	POP	PSW		;RESET STACK POINTER
	JMP	MOREIN		;BACK FOR MORE INPUT
STOP:	PRINT	BELL2
	PRINTL	'STOP CASSETTE TAPE$'
	PRINT	CRLF
	RET
;
;
;   EXIT AND ERROR ROUTINES
;
VERERR:	PRINT	BELL2
	PRINTL	'VERIFY ERROR$'
	JMP	MOREIN
;
TYPERR:	PRINT	BELL2
	PRINTL	'ERROR - FILE TYPE NOT <COM> - CANNOT BE RUN$'
	JMP	MOREIN
;
RUNERR:	PRINT	CRLF2
	PRINTL 'ERROR - A PROGRAM CAN NOT BE RUN FROM A BLOCKED TAPE$'
	PRINT	CRLF
	PRINTL	'TO EXECUTE PROGRAM FIRST LOAD TO DISK$'
	CALL	STOP		;DISPLAY STOP TAPE MESSAGE
	JMP	MOREIN
;
DERR:	PRINT	BELL2
	PRINTL	'DISK WRITE ERROR - DISK OR DIRECTORY FULL$'
	PRINT	CRLF
	PRINTL	'FILE DELETED FROM DISK$'
	DELETE	FCB
;
MOREIN:	LDA	INFLAG
	ORA	A
	JNZ	NEWIN
;
MONITOR: PRINT	CRLF
	RESDRV	DRVNO		;RESTORE ORIGINAL DRIVE NUMBER
	JMP	0		;EXIT BACK TO MONITOR
;
;
;   DATA ALLOCATIONS -
;
FCB	=	5CH	;FILE CONTROL BLOCK
FCBNAM	=	FCB+1	;FILE NAME
FCBTYP	=	FCB+9	;FILE TYPE
BELL:	.ASCII	[07H][0DH][0AH][24H]
BELL2:	.ASCII	[07H][0DH][0AH][0AH][24H]
CRLF:	.ASCII	[0DH][0AH]'$'
CRLF2:	.ASCII	[0DH][0AH][0AH][24H]
BCOUNT:	.BYTE	65	;COUNT OF BYTES PER LINE
RUNFLG:	.BYTE	0	;CONTROLS FILE TO BE LOADED AND EXECUTED
DISFLG:	.BYTE	0	;CONTROLS DISPLAY DURING TAPE OPERATIONS
DRVNO:	.BYTE	0	;CURRENTLY LOGGED DISK DRIVE NO
NEWDRV:	.BYTE	0	;STORAGE FOR NEW DRIVE NO IF ONE IS SELECTED
CKSUM:	.BYTE	0	;STORAGE FOR TAPE CHECKSUM
INFLAG:	.BYTE	0	;FLAG - IF SET RETURN FOR MORE CONSOLE INPUT
FIRST:	.BYTE	0	;INDICATES FIRST RECORD OF BLOCKED TAPE
BLOCK:	.BYTE	0	;BLOCK COUNT FOR BLOCKED TAPE
TYPE:	.BYTE	0	;TYPE CODE FOR BLOCKED TAPE
LENGTH:	.BYTE	0	;LENGTH OF BLOCKED RECORD 256 BYTE BLOCKS
DFLAG1:	.BYTE	0	;DISPLAY OFF FOR SLOW TERMINALS
VERFLG:	.BYTE	0	;FLAG - SET FOR VERIFICATION
AMBIG:	.BYTE	0	;AMBIGUOUS NAME FLAG
FAMBIG:	.BYTE	0	;FIRST AMBIGUOUS FILE FLAG
BLKBLK:	.BYTE	0	;BLOCK COUNT FOR BLOCKED TAPES
MEMEND:	.WORD	0	;END MEMORY FOR FILE STORAGE
BPOINT:	.WORD	0	;POINTER TO FILE MEMORY BUFFER
SLOC2:	.WORD	0	;STORAGE FOR POINTER TO FCB NAME
SLOC1:	.WORD	88H	;POINTER TO NAME IN INPUT BUFFER
IPOINT:	.WORD	80H	;POINTER TO DISK INPUT BUFFER
NBLOCKS:.WORD	0	;NUMBER OF 256 BYTE BLOCKS IN FILE
ENDF:	.WORD	0	;LAST MEMORY LOC USED TO STORE FILE
OLDTYP:	.BLKB	3	;TEMP STORAGE FOR FILE TYPE (FOR RENAME)
AMBNAM:	.BLKB	12	;STORAGE FOR AMBIGUOUS FILE NAME
ENDSTK:	.BLKW	16	;NEW STACK
NEWSTK:	.WORD	0	;START OF NEW STACK
FILBUF:	.WORD	0	;FILE BUFFER - TO TOP OF MEMORY
	.END