	TITLE	'MIC-XFER - MOVE A FILE BETWEEN REGULAR CP/M AND MICROPOLIS'
;	COPYRIGHT 1978,1979 BY  BRUCE R. RATOFF.   ALL RIGHTS RESERVED
;	LAST REV 5/20/79
;
BUFFER	EQU	80H		; BUFFER FOR DATA TRANSFER (CP/M DEFAULT)
MBDOS	EQU	3106H		; BDOS ENTRY POINT IN A 17K MIC CP/M SYSTEM
MCTL	EQU	0D200H		; MICROPOLIS BOARD ADDRESS + 200H
CONADR	EQU	49H		; ADDRESS WHERE MICROPOLIS CP/M STORES MCTL
MUNIT	EQU	46H		;    "      "       "       "     "    UNIT #
TRKTBL	EQU	40H		;    "      "       "       "     "    TRK. #
MRDBUF	EQU	42F4H		; READ BUFFER IN 17K MICROPOLIS CP/M
MWRBUF	EQU	41E8H		; WRITE BUFFER IN 17K MICROPOLIS CP/M
LOWSYS	EQU	0A00H		; WHERE MOVCPM LEAVES SYSTEM IMAGE
HISYS	EQU	2900H		; START OF 17K MICROPOLIS CP/M SYSTEM IMAGE
SYSLEN	EQU	1900H		; LENGTH OF MICROPOLIS CP/M SYSTEM IMAGE
MSELDK	EQU	3E1BH		; ADDR OF DRIVE SELECT VECTOR IN 17K SYSTEM
;
BDOS	EQU	5		; BDOS ENTRY POINT IN HOST SYSTEM
DFCB	EQU	5CH		; FIRST DEFAULT FILE CONTROL BLOCK
DFCB2	EQU	6CH		; SECOND DEFAULT FILE CONTROL BLOCK
LOGDSK	EQU	4		; WHERE CCP KEEPS CURRENT LOGGED DRIVE #
;
	ORG	100H
START:	LXI	SP,HISYS-1	;PUT STACK BELOW EXTRA SYSTEM IMAGE
	LDA	DFCB2+1		;LOOK AT DESTINATION SPECIFIER
	CPI	'M'		;MICROPOLIS?
	JZ	MOVSYS		;THEN LEAVE POINTERS AS LOADED
	CPI	'I'		;IBM-FORMAT?
	JZ	SWPDOS		;IF IBM, SWAP POINTERS
	LXI	D,VALCMD	;ALL ELSE IS ILLEGAL, SO SQUAWK
	JMP	ABEND
VALCMD:	DB	13,10,'VALID COMMAND FORMAT:'
	DB	13,10,'MIC-XFER SRCE-DRVE:SRCE-FILE.TYP DEST-DRVE:DEST-SYS'
	DB	13,10,'    SRCE-DRVE AND DEST-DRVE MAY BE A,B,C OR D'
	DB	13,10,'    DEST-SYS  MAY BE I (IBM) OR M (MICROPOLIS)'
	DB	'$'
SWPDOS:	LXI	H,BDOS		;SWAP READ AND WRITE DOS'S
	SHLD	WDOS+1
	LXI	H,MBDOS
	SHLD	RDOS+1
MOVSYS:	LXI	H,LOWSYS	;POINT TO MOVCPM SYSTEM IMAGE
	LXI	D,HISYS		;POINT TO CORRECT EXECUTION ADDRESS
	LXI	B,SYSLEN	;HOW MUCH TO MOVE
	CALL	LDIR		;GO MOVE IT
	LXI	H,MCTL		;SET UP POINTER TO MICROPOLIS CONTROLLER
	SHLD	CONADR		;AS THE MICROPOLIS BOOT WOULD NORMALLY DO
	LXI	H,0FFFFH	;ZAP CURRENT TRACK ON ALL MICROPOLIS DRIVES
	SHLD	TRKTBL		; (THIS FORCES A RECALIBRATE WHEN ACCESSED)
	SHLD	TRKTBL+2
	SHLD	MRDBUF		;ZAP CURRENT TRK/SEC IN MICROPOLIS READ BUFFER
	SHLD	MWRBUF		;AND WRITE BUFFER (FORCES A READ)
	LDA	DFCB		;PRESERVE SOURCE DRIVE #
	STA	HFCB
	LDA	DFCB2		;CARRY OVER DESTINATION DRIVE
	STA	MFCB
	MVI	C,13		;RESET MICROPOLIS SYSTEM
	CALL	MBDOS
	LXI	H,FILIST	;SCAN 'READ' SYSTEM FOR ELIGIBLE FILES,
	SHLD	FILPTR		;DEVELOPING A LIST AT 'FILIST' AND A COUNT
	MVI	A,1		;AT 'NFILES'
	STA	NFILES
	LXI	D,DFCB
	MVI	C,17		;GIVE INITIAL SEARCH COMMAND
	CALL	RDOS
	CPI	255		;IF NO MATCHES AT ALL, COMPLAIN AND QUIT
	JZ	FNFERR
TOLIST:	LHLD	FILPTR		;HAVE A MATCH, MOVE IT INTO FILIST
	XCHG
	RRC			;COMPUTE (DIR ENTRY # MOD 4) * 32
	RRC			;TO GET OFFSET INTO BUFFER
	RRC
	ANI	60H
	MOV	C,A		;ADD OFFSET TO BUFFER ADDRESS
	MVI	B,0		;+ 1 TO SKIP DELETE FLAG IN DIRECTORY ENTRY
	LXI	H,BUFFER+1
	DAD	B
	LXI	B,11		;MOVE NAME AND TYPE TO FILIST
	CALL	LDIR
	LXI	H,NFILES	;BUMP COUNT OF FILES
	INR	M
	XCHG
	SHLD	FILPTR		;UPDATE POINTER TO FILIST
	LXI	D,DFCB
	MVI	C,18		;GIVE 'CONTINUE SEARCH' COMMAND
	CALL	RDOS		;TO 'READ' SYSTEM
	CPI	255		;END OF SEARCH?
	JNZ	TOLIST		;NO, GO ADD IT TO LIST
	LXI	H,FILIST	;WE HIT THE END, RESET POINTER TO FILIST
	SHLD	FILPTR		; AND GO START COPYING
	JMP	PGO
;
;THIS ROUTINE WILL TEST FOR BREAK AND PRINT A MESSAGE
PEXIT:	MVI	C,11
	PUSH	D
	CALL	BDOS		;CONSOLE STATUS CALL
	POP	D
	RAR			;FORCE ABEND IF TRUE, ELSE JUST PRINT
	JNC	PMESS
;
ABEND:	MVI	A,1		;MAKE PGO THINK IT'S FINISHED BY
	STA	NFILES		;ZAPPING FILE COUNT
;
PMESS:	MVI	C,9		;PRINT A MESSAGE
	CALL	BDOS
;
;HERE TO COPY NEXT FILE
PGO:	LXI	H,NFILES	;DECREMENT FILE COUNT, SEE IF ANY LEFT
	DCR	M
	JZ	0		;IF NONE LEFT, EXIT
	LHLD	FILPTR		;POINT TO NEXT NAME IN FILIST
	LXI	D,HFCB+1	;COPY IT TO FCB
	LXI	B,11
	CALL	LDIR
	SHLD	FILPTR		;UPDATE POINTER TO FILIST
	LXI	D,COPMSG
	MVI	C,9		;ANNOUNCE WHAT WE'RE COPYING
	CALL	BDOS
	LXI	H,' $'
	SHLD	HFCB+12		;BY DROPPING '$' HERE, WE CAN PRINT STRAIGHT
	LXI	D,HFCB+1	; FROM FCB USING CP/M 'PRINT BUFFER' CALL
	MVI	C,9
	CALL	BDOS
	LXI	H,0		;CLEAN OUT '$' SO FILE CALLS WILL WORK
	SHLD	HFCB+12
	SHLD	HFCB+14
OPENI:	LXI	D,HFCB		;OPEN FILE ON 'READ' DOS
	MVI	C,15
	CALL	RDOS
	INR	A
	JNZ	GOTFIL
FNFERR:	LXI	D,FNFMSG	;KVETCH IF OPEN FAILS
	JMP	PEXIT
FNFMSG:	DB	'FILE NOT FOUND$'
GOTFIL:	LXI	H,HFCB+1	;COPY NAME TO 'WRITE' FCB
	LXI	D,MFCB+1
	LXI	B,11
	CALL	LDIR
	MVI	B,21
	SUB	A		;CLEAR REST OF 'WRITE' FCB
FCBZ:	STAX	D
	INX	D
	DCR	B
	JNZ	FCBZ
	STA	HFCB+32		;CLEAR 'NEXT SECTOR' IN READ FCB
	LXI	D,MFCB		;DELETE DESTINATION FILE
	MVI	C,19
	CALL	WDOS
	MVI	C,22		;CREATE DESTINATION FILE
	LXI	D,MFCB
	CALL	WDOS
	INR	A
	JNZ	CREOK
	LXI	D,CNCMSG	;KVETCH IF CREATE FAILS
	JMP	PEXIT
CNCMSG:	DB	'CANNOT CREATE FILE$'
CREOK:	LXI	D,MFCB		;OPEN DESTINATION FILE
	MVI	C,15
	CALL	WDOS
	INR	A
	JNZ	OOPNOK
	LXI	D,COFMSG	;HOW CAN CREATE SUCCEED AND OPEN FAIL?
	JMP	PEXIT
COFMSG:	DB	'CANNOT OPEN OUTPUT FILE$'
OOPNOK:	LXI	D,HFCB		;READ SECTOR FROM 'READ' DOS
	MVI	C,20
	CALL	RDOS
	ORA	A		;ASSUME ERROR RETURN IS EOF
	JNZ	COPDON
	LXI	D,MFCB		;WRITE SECTOR TO 'WRITE' DOS
	MVI	C,21
	CALL	WDOS
	ORA	A		;MAKE SURE WRITE SUCCEEDS
	JZ	OOPNOK		;IF SO, GO BACK FOR MORE
	LXI	D,WERMSG	;ELSE KVETCH
	MVI	C,9
	CALL	BDOS
	JMP	PEXIT
WERMSG:	DB	'DISK WRITE ERROR$'
COPDON:	MVI	C,16		;CLOSE OUTPUT FILE
	LXI	D,MFCB
	CALL	WDOS
	PUSH	PSW
	LDA	MUNIT		;MOMENTARILY CHANGING UNITS WILL ASSURE
	XRI	1		;THAT MICROPOLIS CP/M HAS FLUSHED ITS BUFFERS
	MOV	C,A
	CALL	MSELDK
	LDA	MUNIT
	XRI	1
	MOV	C,A
	CALL	MSELDK
	POP	PSW
	LXI	D,OKMSG		;ANNOUNCE SUCCESSFUL COPY
	INR	A		;OR CLOSE ERROR, DEPENDING ON RETURN
	JNZ	PEXIT
	LXI	D,CERMSG
	JMP	PEXIT		;PRINT MESSAGE AND CONTINUE
COPMSG:	DB	13,10,'COPYING $'
OKMSG:	DB	'SUCCESSFUL COPY$'
CERMSG:	DB	'ERROR ON CLOSE$'
;
LDIR:	MOV	A,M		;THIS BLOCK MOVE ROUTINE SIMULATES
	STAX	D		;A Z80 'LDIR' INSTRUCTION
	INX	H
	INX	D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	LDIR
	RET
;
RDOS:	JMP	BDOS		;POINTER TO DOS FOR READS
WDOS:	JMP	MBDOS		;POINTER TO DOS FOR WRITES
;
HFCB:	DS	33		;FCB FOR READS
MFCB:	DS	33		;FCB FOR WRITES
FILPTR:	DS	2		;POINTER TO CURRENT FILE IN FILIST
NFILES:	DS	1		;COUNT OF FILES IN FILIST
FILIST:	DS	254*11		;LIST OF FILENAMES TO BE COPIED
;
	END
