TITLE	PHIMON FILE TRANSFER UTILITY FOR CP/M
;*********************************************************
;
;   PHIMON File Transfer Utility for CP/M
;
;   (c) 1981  GRH Electronics, CUPERTINO, CA
;
;*********************************************************
;
;   This program allows transfer of PHIMON files on tape
; to CP/M files on disk for subsequent use under CP/M.
; The CP/M filename will be the same as the PHIMON file-
; name with extra blanks added as needed. I.E., the PHI
; name of xxxxxx.yy will result in a CP/M filename of
; "xxxxxx  .yy ".
;   At this time, only transfers from PHIMON will be
; implemented.
;
;   SYNTAX:
;   PXFER  d: = d:filename.ex <,d:file2.ex,...filen.ex>
;
;   Where:
;   d: = REQUIRED drive ID which will ultimately determine
;        direction of transfer.
;   filename.ex = filename to be transferred in correct
;                 format according to d:.
;   file2,...filen = optional files to be transferred.
;
;   Note, source filenames may include wildcards.
;
;   Drive (d:) specifications:
;   0 thru 3 = PHI drives
;   A thru P = Disk drives
;
;*********************************************************
	FORM
;*************************************************************
;
*INCLUDE	HERRMAC.Z80
;
	FORM
;*************************************************************
;
;   SYSTEM LINKS
;
BDOS:	EQU	0005H
DEFFCB:	EQU	005CH
DEFBFR:	EQU	0080H
TPA:	EQU	0100H
;
SECSIZ:	EQU	128D
STKSIZ:	EQU	64D
DIRSIZ:	EQU	1024D
;
;   CONSTANTS
;
ZERO:	EQU	0
;
;   ASCII CONSTANTS
;
LF:	EQU	0AH
CR:	EQU	0DH
ASPACE:	EQU	20H
;
;   ASSEMBLER DIRECTIVES
;

	ORG	TPA
;
PGMST:	JP	PSTART
;
;
;   ASCII TEXT PROCEDURES
;
CONOUT:	EQU	$
	LD	E,C	;SETUP
	LD	A,C	;IF CHAR = CTRL-P THEN ONLY TOGGLE FLAG
	CP	10H
	JR	Z,TGLLPT
	LD	A,(TOGGLE)
	AND	7	;LIMIT 0-7
	LD	C,A
	JP	BDOS
;
TGLLPT:	EQU	$
	LD	A,(TOGGLE)	;2 <-> 5
	XOR	7
	AND	7
	LD	(TOGGLE),A
	RET
;
;   SERCH SUBR SEARCHES FOR A STRING CHAR THE SAME AS CONTENTS
; OF C. IT WILL NOT GO BEYOND A SEMICOLON ';'.
;   ENTRY- DE= STRING PTR
;          C= CHAR TO SEARCH FOR
;   EXIT - HL= CHAR PTR
;          Z=NOT FOUND
;
SERCH:	PUSH	DE
	POP	HL
SERCH1:	LD	A,(HL)	;IF CHAR = NUL THEN RETURN Z
	OR	A
	RET	Z
	CP	C	;ELSE IF CHAR=C THEN RETURN NZ
	JR	Z,FOUND
	CP	';'	;IF CHAR = ';' THEN RETURN Z
	RET	Z
	INC	HL	;ELSE TRY NEXT CHAR
	JR	SERCH1
;
FOUND:	OR	A
	RET
;
;   SPACEL BYPASSES TRAILING SPACES UNTIL NUL OR NON-SPACE
;      CHAR IS FOUND
;   ENTRY- BC= STRING PTR
;   EXIT - HL=1ST NON-SPACE CHAR
;          Z=NOT FOUND
;
SKIPON:	PUSH	BC
	POP	HL
SKIPO1:	LD	A,(HL)
	CP	20H	;IF CHAR <> ' ' THEN RETURN
	JR	NZ,FOUND
	INC	HL
	JR	SKIPO1
;
;   CARRIAGE RETURN/LINE FEED SUBR
;
CRLF:	EQU	$
	LD	C,0DH
	CALL	CONOUT
	LD	C,0AH
	JP	CONOUT
;
;   MESSAGE EDITOR SUBR
;   ENTRY- BC = STRING PTR
;
EDITOR:	EQU	$
	PUSH	BC
EDITLP:	POP	HL
	LD	A,(HL)	;GET CHAR
	INC	HL
	OR	A
	RET	Z
	PUSH	HL
	LD	C,A	;IF CHAR >= 80H THEN SPACES
	CALL	M,MLTSPC
	JR	Z,EDITLP
	CP	0DH	;IF RETURN THEN DO CR-LF
	PUSH	AF
	CALL	Z,CRLF
	POP	AF
	JR	Z,EDITLP
	CALL	CONOUT
	JR	EDITLP
;
;   MULTI SPACE SUBR OUTPUTS <= 127D SPACES
;   ENTRY- C= # SPACES
;   EXIT - ZF SET
;
MLTSPC:	EQU	$
	LD	B,C
	RES	7,B
	LD	C,20H
SPLP:	PUSH	BC	;SAVE CNT
	CALL	CONOUT
	POP	BC
	DJNZ	SPLP
	XOR	A
	RET
;
;   SYSTEM ERROR SUBR - PRINTS ERROR MESSAGES
;   ENTRY- ERROR NUMBER (1 THRU n) IN C
;   EXIT - CY SET
;
SYSERR:	EQU	$
	PUSH	BC
	CALL	CRLF
	POP	BC
	DEC	C
	LD	A,C
	LD	HL,ERRTBL	;IF ENTRY COUNT < ERROR# THEN 
;				 JUST ERROR
	CP	(HL)
	JR	NC,NOPRFX
	INC	HL	;POINT TO 1ST ENTRY
	ADD	A	;COMPUTE TABLE PTR
	LD	E,A
	LD	D,ZERO
	ADD	HL,DE
	LD	C,(HL)	;GET MESSAGE PTR
	INC	HL
	LD	B,(HL)
	CALL	EDITOR
NOPRFX:	LD	BC,ERRMSG
	CALL	EDITOR
	JP	0
;
ERRMSG:	DB	' Error!',CR,LF,0
;
ERRTBL:	DB	NUMENT
;
	DW	CRCM
	DW	NTFM
	DW	JAMM
	DW	PROTM
	DW	SYNM
	DW	FNTFM
	DW	TYPEM
	DW	DIRM
	DW	NORMM
;
CRCM:	DB	'CRC',0
NTFM:	DB	'Block not found',0
JAMM:	DB	'Tape',0
PROTM:	DB	'Write Protect',0
SYNM:	DB	'Syntax',0
FNTFM:	DB	'File not found',0
TYPEM:	DB	'File type',0
DIRM:	DB	'Directory',0
NORMM:	DB	'No room',0
;
NUMENT:	EQU	9D
;
;
;   SELECT DRIVE SUBR - RETURNS DRIVE #
;   ENTRY- DECKSL : POINTER IN BC
;          DCKSL1 : POINTER IN DE
;   EXIT - A= DRIVE #
;          Z= NO DRIVE SPEC'D
;          CF= INVALID DRIVE #
;
DECKSL:	PUSH	BC
	POP	DE
DCKSL1:	LD	C,':'	;FIND DRIVE SPEC
	CALL	SERCH
	RET	Z	;IF NON SPEC'D THEN USE LAST SELECTED
	DEC	HL
	CALL	SKIPBK	;SKIP PREVIOUS SPACES
	LD	A,(HL)	;IF <0 THEN RETURN CF
	SUB	'0'
	RET	C
	CP	4	;IF > MAXIMUM DRIVE # THEN RETURN CY
	CCF
	RET
;
;  SKIP BACK SUBR SKIPS PRECEDING SPACES
;
SKIPBK:	EQU	$
	LD	A,(HL)
	CP	20H	;IF NOT SPACE THEN RETURN
	RET	NZ
	DEC	HL
	JR	SKIPBK
;
;
;   DONAME SUBR SETS FILE PARAMETER BLOCK PER INPUTTED
;      STRING. DRIVE IS SET IF SPECIFIED. CHECKS FOR VALID
;      CHARACTERS & ALPHA 1ST CHARACTER ARE PERFORMED.
;      WILDCARDS ARE FORMATTED. '*' FILLS REMAINDER OF FPB
;      WITH '?'s, '?'s ARE INSERTED AS ENCOUNTERED.
;
;   ENTRY- BC= STRING PTR TO 1ST NON-SPACE CHAR.
;          IY= FPB PTR
;   EXIT - IY= FPB PTR TO NAME FIELD
;          HL= STRING PTR TO LAST CHAR +2
;          CF= ERROR [ERR CODE IN A]
;          A= '?' IF AMBIGUOUS FILENAME USED, 0 IF SPECIFIC
;
;*********************************************************
;
;   DEFINE THE FOLLOWING SOMEWHERE:
;
DRIVEO:	EQU	-1
NAMEO:	EQU	0
EXO:	EQU	NAMEO+6
LENGO:	EQU	EXO+2
BLOCKO:	EQU	LENGO+2
MAPO:	EQU	BLOCKO+2
ALTNMO:	EQU	MAPO+2
;
RDDRV:	EQU	0F430H	;PHI PROM ADDR
;*********************************************************
;
DONAME:	PUSH	BC
	POP	HL
DONAM1:	PUSH	IY	;SETUP
	POP	DE
	PUSH	DE
	XOR	A
	LD	(WILDFL),A	;CLEAR WILDCARD FLAG
	LD	B,EXO	;ZERO FPB FILENAME
DOLP:	LD	(DE),A
	INC	DE
	DJNZ	DOLP
	POP	DE
	LD	B,EXO-NAMEO
DONEXT:	LD	A,(HL)	;GET STRING CHAR
	RES	7,A	;CLEAR ATTRIBUTE
	INC	HL
	PUSH	BC
	CALL	RSVP1	;IF RESERVED CHAR THEN EXIT
	POP	BC
	JR	Z,DOCOLN
	CP	'['	;IF OUT OF RANGE THEN ERR
	CCF
	JR	C,DOERR
	CP	2AH	;IF CHAR = '*' THEN DO WILDCARD FORMAT
	JR	Z,DOWILD
	CP	'?'	;IF AMBIGUOUS THEN SET FLAG
	JR	NZ,DONOQU
	LD	(WILDFL),A
DONOQU:	LD	(DE),A	;ELSE PUT CHAR INTO FPB
	INC	DE
	DJNZ	DONEXT
DOMORE:	LD	A,(HL)	;IF NEXT CHAR= PERIOD THEN SET EXTEN.
	RES	7,A
NAMEDN:	CP	2EH
	JR	Z,EXTNTN
	LD	A,(IY+0)	;ELSE SET NOT DELETED ATTRIB &
	SET	7,(IY+0)
	CALL	ALPHA1	;IF 1ST CHAR <> ALPHA THEN ERR
	JR	C,DOERR
	CALL	RDDRV	;SET SPEC'D DRIVE INTO FPB
	LD	(IY+DRIVEO),A
	OR	A	;CLEAR CF
	LD	A,(WILDFL)	;RETURN WILDCARD FLAG
	RET
;
EXTNTN:	EQU	$
	LD	B,EXO	;SET PTR TO EXTENSION
	PUSH	IY
	POP	DE
EXTLP:	INC	DE
	DJNZ	EXTLP
	LD	B,LENGO-EXO
	JR	DONEXT
;
DOCOLN:	EQU	$
	CP	':'	;IF NOT COLON THEN DONE
	JR	NZ,NAMEDN
	PUSH	HL
	DEC	HL	;IF LAST CHAR NOT VALID DRIVE# THEN ERR
	EX	DE,HL
	PUSH	BC
	CALL	DCKSL1
	POP	BC
	POP	HL	;RESTORE PTR
	JR	C,DOERR
	JR	Z,NODRV1
	LD	C,A
	CALL	SETDRV
NODRV1:	CALL	SKIPO1
	JR	DONAM1
;
DOERR:	EQU	$
	LD	A,5	;SET UP SYNTAX ERROR
	SCF
	RET
;
DOWILD:	EQU	$
	LD	A,'?'	;FILL REMAINING FPB FIELD WITH ?s
	LD	(WILDFL),A	;SET WILDCARD FLAG
WILDLP:	LD	(DE),A
	INC	DE
	DJNZ	WILDLP
	JR	DOMORE
;
;   ALPHA CHAR TEST
;   ENTRY- C= CHAR
;   EXIT - CF= NOT ALPHA, NC= ALPHA
;
ALPHAT:	LD	A,C
ALPHA1:	EQU	$
	CP	':'	;IF > '9' THEN OK
	RET	NC
	CP	'0'	;ELSE IF < '0' THEN OK
	CCF
	RET
;
;   LOOKUP SEARCHES DIRECTORY FOR FILE REFERENCED BY FPB
;   ENTRY- IY= FPB PTR (DRIVE, NAME PRESET)
;   EXIT - Z,NC= OK, NZ OR CF= ERROR [A= ERR CODE]
;          FPB(NAME):= DIR(NAME) [INCLUDING ATTRIBUTES]
;          FPB(LENG, BLOCK):= DIR(LENG, 1ST BLK)
;          SETBID:= BLOCK, SETCNT:= LENG
;
;********************************************************
;
;   PHI PROM VECTORS
;
SETMAP:	EQU	0F403H
SETBID:	EQU	0F406H
SETCNT:	EQU	0F409H
SETDRV:	EQU	0F40FH
READF:	EQU	0F412H
WRITF:	EQU	0F415H
RDBID:	EQU	0F42DH
;
;
LOOKUP:	CALL	DIRSRH	;SEARCH DIRECTORY FOR FILE
LOOK1:	RET	NZ
	RET	C	;ERR RETURN
	LD	BC,(BLKTOT)	;SET FILE START PARAMS
	LD	(IY+BLOCKO),C
	LD	(IY+BLOCKO+1),B
	CALL	SETBID
	PUSH	DE	;DIR(NAME) PTR
	LD	HL,NAMCNT    ;FETCH FILE LENGTH FROM DIRECTORY
	ADD	HL,DE
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	LD	(IY+LENGO),C
	LD	(IY+LENGO+1),B
	CALL	SETCNT
	POP	HL	;DIR(NAME) PTR
	PUSH	IY	;IY -> DE  (DEST)
	POP	DE
	LD	BC,NAMCNT
	LDIR
	XOR	A	;CLEAR ERRS
	RET
;
;   DIRECTORY SEARCH FOR FILE REFERENCED IN FPB
;   NOTE: IF WILDCARDS USED, THESE ROUTINES RETURN FIRST MATCH.
;   ENTRY- IY= FPB PTR (DRIVE, NAME PRESET)
;   EXIT - NC AND Z= NORMAL, CF OR NZ= ERROR [A= ERR CODE]
;          HL= BLOCK ID OF FILE
;          DE= DIRECTORY PTR (NOT NEEDED FOR RE-ENTRY)
;          C= ENTRIES REMAINING
;          (BLKTOT)= FILE START BLOCK ID
;
DIRSRH:	CALL	DIRRD	;IF NOT IN DIRBUF THEN READ CURRENT DIR
	RET	NZ	;IF ERR THEN RETURN
	LD	HL,(DIRBUF)	;SET PTR
	LD	(DIRPTR),HL
	LD	C,(HL)		;BLOCK TOTAL:= START BLOCK
	LD	B,0
	LD	(BLKTOT),BC
	INC	HL	;SET DIR ENTRY COUNT
	LD	C,(HL)
	DEC	C	;IF NO ENTRIES THEN RETURN ERR
	JR	Z,NOENT
NXTFIL:	PUSH	IY	;FPB PTR -> HL
	POP	DE
	INC	HL
	BIT	7,(HL)		;IF DELETED THEN SKIP
	LD	B,NAMCNT	;SET ENTRY CHAR COUNT
	JR	Z,NOGOOD
NXCHAR:	LD	A,(DE)
	RES	7,A	;CLEAR ATTRIB.
	CP	'?'	;IF WILDCARD THEN OK AS IS
	JR	Z,GOOD
	CP	(HL)	     ;ELSE IF (FPB) = (DIR) THEN MATCH
	JR	Z,GOOD
	SET	7,A	;ELSE TRY WITH ATTRIB. SET
	CP	(HL)
	JR	NZ,NOGOOD
GOOD:	INC	DE	;LOOP IF COUNT <> 0
	INC	HL
	DJNZ	NXCHAR
	LD	(DIRPTR),HL   ;SAVE VARS FOR SEARCH NEXT ENTRY
	LD	(DIRVAR),BC
	LD	DE,-NAMCNT	;BACK UP DIR PTR TO BEGINNING 
;				 OF ENTRY
	ADD	HL,DE
	EX	DE,HL
	LD	HL,(BLKTOT)	;RETURN START BLOCK ID OF FILE
	XOR	A	;CLEAR ERR
	RET
;
NOGOOD:	INC	HL	;WASTE ENTRY
	DJNZ	NOGOOD
NXTENT:	DEC	C	;IF NOT LAST ENTRY THEN ADD FILE LENGTH
	PUSH	AF	;TO TOTAL & LOOP
	EX	DE,HL
	CALL	ADDBLK
	EX	DE,HL
	POP	AF
	JR	NZ,NXTFIL
NOENT:	LD	A,6	;RETURN NOT FOUND ERROR
	CP	A	;SET Z
	SCF
	RET
;
;   DIRECTORY SEARCH NEXT ENTRY POINT
;   ENTRY & EXIT PARAMS SAME AS DIRECTORY SEARCH
;
DIRSNX:	LD	HL,(DIRPTR)	;RESTORE SEARCH VARIABLES
	LD	BC,(DIRVAR)
	JR	NXTENT
;
;   READ DIRECTORY SUBR
;   ENTRY- IY= FPB PTR (DRIVE PRESET)
;          (DIRBUF)= 1K DIRECTORY BUFFER AREA
;
DIRRD:	EQU	$
READIR:	EQU	$
	LD	C,(IY+DRIVEO)	;IF DIRECTORY IN THEN RETURN
	LD	A,(DIRIN)
	CP	C
	RET	Z
	LD	A,C	;DIR IN := NEW DIR
	LD	(DIRIN),A
	CALL	SETDRV
	LD	BC,(DIRBUF)	;SET READ PTR
	CALL	SETMAP
	LD	BC,0	;SET BLOCK ID
	CALL	SETBID
	LD	C,4	;SET BLK COUNT
	CALL	SETCNT
	JP	READF
;
;   ADD LENGTH OF FILE TO TOTAL SUBR
;   ENTRY- (DE)= LO BYTE OF FILE LENGTH
;          (BLKTOT)= TOTAL TO BE ADDED TO
;   EXIT - DE= NEXT DIR ENTRY(NAME) -1
;
ADDBLK:	PUSH	BC	;SAVE VARS
	LD	A,(DE)	;GET THIS FILE'S LENGTH & ADD TO TOTAL
	LD	C,A
	INC	DE
	LD	A,(DE)
	LD	B,A
	LD	HL,(BLKTOT)
	ADD	HL,BC
	LD	(BLKTOT),HL
	POP	BC
	RET
;
;   WRITE DIRECTORY IN MEMORY TO DRIVE IN FPB
;   ENTRY- (DIRBUF)= 1K DIRECTORY BUFFER AREA
;          (CURDRV)= DRIVE # OF DIRECTORY IMAGE AT (DIRBUF)
;
;********************************************************
;
WRTDIR:	EQU	$
	LD	BC,(DIRBUF)	;SET WRITE PTR
	CALL	SETMAP
	LD	BC,0	;BLK ID := 0
	CALL	SETBID
	LD	B,4	;WRITE COUNT := 400H
	CALL	SETCNT
	JP	WRITF
;
;   DELETE FILE(S) REFERENCED BY FPB FROM CURRENT DIRECTORY
;   ENTRY- IY= FPB PTR (DRIVE, NAME PRESET)
;          C(BIT 0)= 1= VERIFY {PRINT EACH FILENAME AS DELETED
;                    0= NO VERIFY
;          C(BIT7)= RESERVED FOR USE
;   EXIT - CF OR NZ= ERROR [A= ERR CODE]
;          MF= DELETION OCCURRED, DIRECTORY WRITE REQ'D
;
DELETE:	LD	A,C
	RES	7,A	;CLEAR NO WRITE FLAG
	LD	(DELCTL),A
	CALL	DIRSRH	;IF FILE FOUND THEN GO DELETE
	RET	NZ
DELNXT:	JR	C,DELLST	;IF NOT FOUND THEN EXIT
DEL1:	PUSH	IY	;SAVE FPB PTR
	PUSH	DE	;DIR PTR(NAME) -> IY
	POP	IY
	BIT	7,(IY+NAMEO)	;IF ALREADY DELETED THEN IGNORE
	JR	Z,DELED
	BIT	7,(IY+NAMEO+1)	;IF PROTECTED THEN ERR
	JR	NZ,DELPRT
	RES	7,(IY+NAMEO)	;ELSE DELETE FILE AND
	LD	A,(DELCTL)	;SET DIR WRITE FLAG
	SET	7,A
	LD	(DELCTL),A
	BIT	0,A	;IF VERIFY FLAG SET THEN PRINT FILENAME
	JR	Z,DELED
	EX	DE,HL
	CALL	PRNAM1
	LD	BC,DELTDM
	CALL	EDITOR
DELED:	POP	IY	;RESTORE FPB PTR
	CALL	DIRSNX	;CONTINUE SEARCH
	JR	DELNXT
;
DELLST:	LD	A,(DELCTL) ;IF >0 FILES DELETED THEN WRITE DIR
	OR	A	;IF BIT 7 SET THEN FOUND
	RET	M
DELNF:	LD	A,6	;RETURN NOT FOUND ERR
	SCF
	RET
;
DELPRT:	POP	IY	;RESTORE FPB PTR
	LD	A,4	;RETURN WRITE PROTECT ERR
	SCF
	RET
;
;   ENTRY COMPUTES AVAILABLE SPACE ON CURRENT DRIVE TAPE
;   ENTRY- IY= FPB PTR (DRIVE, LENG PRESET)
;   EXIT - NZ OR CF= ERROR [A= ERR CODE]
;          HL= BLOCKS AVAILABLE ON TAPE
;          FPB(BLOCK):=SETBID:= 1ST AVAILABLE BLOCK
;
ENTRY:	CALL	DIRRD	;READ DIR IF NOT CURRENT
	RET	NZ
	LD	HL,(DIRBUF)	;SET PTR
	LD	C,(HL)		;BLOCK TOTAL := START BLOCK ID
	LD	B,0
	LD	(BLKTOT),BC
	INC	HL	;GET ENTRY COUNT
	LD	C,(HL)
ENTLP1:	INC	HL
	LD	B,NAMCNT	;SET ENTRY CHAR COUNT
ENTLP:	INC	HL
	DJNZ	ENTLP	;SKIP NAME
	DEC	C
	JR	Z,ENTDN	;IF LAST ENTRY THEN DONE
	EX	DE,HL
	CALL	ADDBLK	;ADD THIS FILE LENGTH TO TOTAL
	EX	DE,HL
	JR	ENTLP1
;
ENTDN:	LD	BC,(BLKTOT)	;SET FPB(BLOCK) & BLOCK ID
	LD	(IY+BLOCKO),C
	LD	(IY+BLOCKO+1),B
	CALL	SETBID
	LD	E,(HL)		;IF LENG > AVAIL BLKS THEN ERR
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	PUSH	HL
	LD	E,(IY+LENGO)	;FETCH REQ'D BLKS
	LD	D,(IY+LENGO+1)
	XOR	A
	SBC	HL,DE
	POP	HL	;AVAIL. BLKS
	INC	A	;SET Z
	DEC	A
	LD	A,9D
	RET
;
;
;   PRINT FILENAME FROM FPB SUBR
;   ENTRY- IY= FPB PTR (NAME PRESET)
;
PRNAME:	EQU	$
	PUSH	IY
	POP	HL
PRNAM1:	LD	C,8D	;SET CHAR COUNT
	PUSH	BC
PRNXTC:	LD	A,(HL)		;GET CHAR
	INC	HL
	PUSH	HL
	RES	7,A
	OR	A	;IF CHAR = 0 THEN CHAR := SPACE
	LD	C,A
	JR	NZ,PRNT
	LD	C,20H	;' '
PRNT:	CALL	CONOUT
	POP	HL
	POP	BC
	DEC	C	;COUNT -1
	RET	Z
	PUSH	BC
	LD	A,C	;IF COUNT = 2 THEN OUTPUT '.'
	CP	2
	LD	C,2EH
	PUSH	HL
	CALL	Z,CONOUT
	POP	HL
	JR	PRNXTC
;
;   ADD FILE TO DIRECTORY SUBR
;   ENTRY- IY= FPB PTR (DRIVE, NAME, LENG PRESET)
;   EXIT - CF OR NZ= ERROR [A= ERR CODE]
;
CLOSE:	CALL	DELETE	;DELETE POSSIBLE EXISTING FILE
	RET	NZ
CLOS1:	LD	HL,(DIRBUF)	;ELSE SET PTR
	INC	HL	;IF ENTRIES >= MAX THEN TRY PACKING DIR
	LD	A,(HL)
	CP	102D
	CCF
	PUSH	HL
	CALL	C,SQUISH
	POP	HL
	LD	A,8D	;IF STILL FULL THEN RETURN DIRECTORY 
;			 ERR
	RET	C
	LD	A,(HL)		;ELSE RESTORE ENTRY COUNT
	INC	(HL)		;ADD THIS FILE TO ENTRY COUNT
	LD	BC,10D	;BC := ENTRY SIZE
ADLOOP:	DEC	A	;ENTRIES -1
	JR	Z,CLOSE2	;IF NO MORE ENTRIES THEN EXIT
	ADD	HL,BC	;NEXT ENTRY
	JR	ADLOOP
;
CLOSE2:	INC	HL	;POINT TO 1ST AVAIL ENTRY
	PUSH	IY	;DIR(NAME) := FPB(NAME)
	POP	DE
	EX	DE,HL
	LD	BC,8D
	LDIR
	LD	C,(IY+8D)	;SET FILE LENGTH
	LD	B,(IY+9D)
	EX	DE,HL
	LD	E,(HL)		;REMAINING BLKS <-> LENGTH
	LD	(HL),C
	INC	HL
	LD	D,(HL)
	LD	(HL),B
	PUSH	BC		;LENGTH
	LD	B,8D		;NULL LAST ENTRY
	XOR	A
CLSNUL:	INC	HL
	LD	(HL),A
	DJNZ	CLSNUL
	INC	HL	;AVAIL - LENG = NEW AVAIL.
	EX	DE,HL
	POP	BC
	OR	A
	SBC	HL,BC
	EX	DE,HL
	LD	(HL),E
	INC	HL
	LD	(HL),D
	JP	WRTDIR
;
;   SQUISH DIRECTORY SUBR PACKS DIRECTORY
;
SQUISH:	EQU	$
	LD	HL,(DIRBUF)	;FETCH ENTRY COUNT
	INC	HL
	PUSH	HL
	LD	C,(HL)
	INC	HL	;SET DESTINATION FOR PACK
	PUSH	HL
	POP	DE
	LD	B,0	;COUNT := 0
SQNEXT:	BIT	7,(HL)	;IF DELETED THEN GO COUNT
	JR	Z,ADDEMP
	PUSH	BC	;ELSE SET UP FOR MOVE
	LD	BC,10D
	LDIR
	POP	BC
	DEC	C	;ENT COUNT := ENT COUNT -1
	INC	B	;COUNT := COUNT +1
	JR	SQNEXT
;
ADDEMP:	PUSH	DE	;DEST PTR
	LD	DE,0
	PUSH	DE
EMLOOP:	BIT	7,(HL)	;IF NOT DELETED THEN FINISH
	JR	NZ,FINISH
	LD	DE,8D	;ADD THIS FILE LENGTH TO TOTAL
	ADD	HL,DE
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	EX	(SP),HL
	ADD	HL,DE
	EX	(SP),HL
	DEC	C	;IF ENT COUNT -1 > 0 THEN REPEAT
	JR	NZ,EMLOOP
FINISH:	POP	DE	;BUILD NEW ENTRY
	EX	(SP),HL
	PUSH	BC
	LD	B,8D
CONSLP:	LD	(HL),0
	INC	HL
	DJNZ	CONSLP
	POP	BC
	LD	(HL),E
	INC	HL
	LD	(HL),D
	INC	HL
	POP	DE
	EX	DE,HL
	INC	B	;COUNT := COUNT -1
	INC	C	;IF ENT COUNT > 0 THEN LOOP
	DEC	C
	JR	NZ,SQNEXT
	POP	HL	;ELSE SET NEW ENTRY COUNT
	LD	A,B
	LD	(HL),A
	CP	102D	;IF STILL FULL THEN RETURN CF
	CCF
	RET
;
;   CP/M FILE CONTROL BLOCK FORMATTER
;   ENTRY- (CMDPTR) = ASCII STRING PTR OF FILE
;          HL = FCB TO FORMAT
;   EXIT - ZF = NO WILDCARDS USED
;          NZ = WILDCARD(S) USED, A REG. = NUMBER OF 
;               WILDCARDS
;
;*********************************************************
;
;   TEMPORARY CONSTANTS, REASSIGN WHEN LINKED TO MAIN PGM
;
DFLTDK:	EQU	0004H	;DEFAULT DISK LOCATION
;
;   CONSTANTS
;
ZROSIZ:	EQU	4
ASTRSK:	EQU	2AH	;'*'
ACOMMA:	EQU	2CH	;','
APEROD:	EQU	2EH	;'.'
;
NAMCNT:	EQU	8D	;FILENAME CHAR CNT
TYPCNT:	EQU	3	;FILE EXTENSION CHAR CNT
;
FORMAT:	PUSH	HL	;SAVE FPB PTR IN IY
	POP	IY
	LD	HL,(CMDPTR)
	CALL	SKIPO1	;SKIP LEADING SPACES
	LD	(CMDPTR),HL	;SAVE NEW PTR
	EX	DE,HL
	PUSH	IY
	POP	HL	;FPB PTR
	LD	A,(DE)	;IF CHAR = 0 THEN DONE
	OR	A
	JR	Z,L89
	SBC	'@'	;MAKE 'A'-'P' = 1-15 FOR DRIVE #
	LD	B,A
	INC	DE	;IF NEXT CHAR = ':' THEN MUST BE DRIVE
	LD	A,(DE)
	CP	':'
	JR	Z,L90
	DEC	DE	;ELSE BACK UP & USE DEFAULT DRIVE
L89:	LD	A,(DFLTDK)
	LD	(HL),A	;FCB(DISK) := DRIVE #
	JR	L96
;
L90:	LD	A,B	;USE SPECIFIED DISK
	LD	(HL),B
	INC	DE	;SKIP OVER ':'
L96:	LD	B,NAMCNT	;B := MAX CHARS
L98:	CALL	RSVP
	JR	Z,LB9
	INC	HL	;PTR := PTR +1
	CP	ASTRSK	;IF WILDCARD THEN ENTER '?'
	JR	NZ,LA9
	LD	(HL),'?'
	JR	LAB
;
LA9:	LD	(HL),A	;ADD CHAR TO FCB FILENAME
	INC	DE
LAB:	DJNZ	L98	;IF NOT DONE THEN LOOP
LAF:	CALL	RSVP	;IF RESERVED CHAR THEN EXIT
	JR	Z,LC0
	INC	DE	;SKIP OVER EXTRA CHARS TO '.'
	JR	LAF
;
LB9:	INC	HL	;FILL REMAINDER OF FCB WITH SPACES
	LD	(HL),ASPACE
	DJNZ	LB9
LC0:	LD	B,TYPCNT	;COUNT := TYPE CHAR COUNT
	CP	APEROD	   ;IF RESERVED CHAR NOT '.' THEN FILL 
;			    WITH SPACES
	JR	NZ,LE9
	INC	DE	;GET NEXT CHAR AFTER '.'
LC8:	CALL	RSVP	;IF RESERVED CHAR THEN EXIT
	JR	Z,LE9
	INC	HL	;IF CHAR <> '*' THEN EXIT
	CP	ASTRSK
	JR	NZ,LD9
	LD	(HL),'?'
	JR	LDB
;
LD9:	LD	(HL),A	;ADD CHAR TO FCB
	INC	DE
LDB:	DJNZ	LC8
LDF:	CALL	RSVP	;IF RESERVED CHAR THEN EXIT
	JR	Z,LF0
	INC	DE	;WASTE CHARS
	JR	LDF
;
LE9:	INC	HL	;FILL REMAINING TYPE WITH SPACES
	LD	(HL),ASPACE
	DJNZ	LE9
LF0:	LD	B,ZROSIZ    ;ZERO EXTENT, S1, S2, RECORD COUNT
LF2:	INC	HL
	LD	(HL),ZERO
	DJNZ	LF2
	LD	(CMDPTR),DE
	PUSH	IY
	POP	HL	;COUNT WILDCARDS
	LD	BC,NAMCNT+TYPCNT
L01:	INC	HL
	LD	A,(HL)
	CP	'?'
	JR	NZ,L09
	INC	B
L09:	DEC	C
	JR	NZ,L01
	LD	A,B
	OR	A
	RET
;
;   RESERVED CHAR TEST SUBR
;   ENTRY- (DE) = CHAR TO TEST
;   EXIT - ZF = FOUND
;
RSVP:	LD	A,(DE)	;IF CHAR <= ' ' THEN RETURN Z
RSVP1:	CP	ASPACE+1
	JR	NC,RSVP2
	XOR	A
	RET
;
RSVP2:	PUSH	BC
	PUSH	HL
	LD	B,TABCNT	;B := ENTRY COUNT
	LD	HL,RSVPT
RSVPL:	CP	(HL)
	JR	Z,RSVPX	;IF FOUND THEN EXIT
	INC	HL
	DJNZ	RSVPL
	INC	B	;RETURN NZ
RSVPX:	POP	HL
	POP	BC
	RET
;
RSVPT:	DB	'=',5FH,APEROD,':',';',ACOMMA,'<','>'
TABCNT:	EQU	$-RSVPT
;
;   CP/M SYSTEM CALLS
;
SETDMA:	LD	C,26D
	JP	BDOS
;
WRTSEC:	LD	C,21D
	JP	BDOS
;
RDSEC:	LD	C,20D
	JP	BDOS
;
OPEN:	LD	C,15D
	JP	BDOS
;
DELET:	LD	C,19D
	JP	BDOS
;
MAKE:	LD	C,22D
	JP	BDOS
;
CLOS:	LD	C,16D
	JP	BDOS
;
;   START OF MAIN PGM
;
PSTART:	LD	HL,(BDOS+1)	;GET TOP OF BUFFER
	DEC	HL
	LD	(MEMTOP),HL
	LD	DE,BUFFER	;COMPUTE BUFFER SIZE
	OR	A
	SBC	HL,DE
	LD	(BFRSIZ),HL
	LD	SP,STACK
	LD	BC,SIGNON	;OUTPUT SIGN-ON MSG
	CALL	EDITOR
	LD	HL,DEFBFR	;IF COMMAND COUNT = 0 THEN ERR
	LD	A,(HL)
	RES	7,A	;INSURE <= 128D BYTES
	OR	A
	JR	Z,SYNERR
	LD	C,A	;MOVE CMD LINE TO CMD BUFFER
	LD	B,0
	LD	DE,CMDBFR
	INC	HL	;SKIP COUNT
	LDIR
	XOR	A	;LAST CHAR := 0
	LD	(DE),A
	LD	HL,CMDBFR	;INITIALIZE
	CALL	SKIPO1	;SKIP LEADING SPACES
	JR	Z,SYNERR
	LD	(CMDPTR),HL
	LD	A,(HL)	;SELECT FORMATTER BY DRIVE #
	SUB	'0'
	JR	C,SYNERR
	CP	4
	JR	NC,DSK
SYNERR:	LD	C,5	;OUTPUT SYNTAX ERROR
	JP	SYSERR
;
DSK:	SUB	'A'-'0'	;IF VALID DRIVE THEN DEST = DISK
	JR	C,SYNERR
	CP	16D
	JR	NC,SYNERR
	INC	A	;NOT DEFAULT
	LD	(OUTFCB),A
SRCSEL:	LD	C,'='	;SEARCH FOR SOURCE
	CALL	SERCH1
	JR	Z,SYNERR
	INC	HL	;BYPASS '='
NXTSRC:	CALL	SKIPO1
	JR	Z,SYNERR
	LD	A,(HL)	;IF DRIVE NOT '0' THRU '3' THEN ERR
	SUB	'0'
	JR	C,SYNERR
	CP	4
	JR	NC,SYNERR
	LD	(CMDPTR),HL
	LD	IY,INFPB+1
	CALL	DONAM1
	LD	C,A
	JP	C,SYSERR
	CALL	DIRSRH	;LOOK UP IN DIRECTORY
	LD	C,A	;IF ERR THEN ERR
	JP	C,SYSERR
	JP	NZ,SYSERR
NXFILE:	LD	(INFPB+BLOCKO+1),HL	;SET UP PTRS
	LD	HL,NAMCNT
	ADD	HL,DE
	LD	A,(HL)
	LD	(INFPB+LENGO+1),A
	INC	HL
	LD	A,(HL)
	LD	(INFPB+LENGO+2),A
	EX	DE,HL	;OUTPUT FILENAME
	PUSH	HL
	CALL	CRLF
	POP	HL
	PUSH	HL
	CALL	PRNAM1
	LD	B,11D	;FILL OUTPUT FCB WITH ' '
	LD	HL,OUTFCB+1
	LD	A,ASPACE
INITFC:	LD	(HL),A
	INC	HL
	DJNZ	INITFC
	LD	B,17H	;RE-INITIALIZE FCB
ZFCB:	LD	(HL),0
	INC	HL
	DJNZ	ZFCB
	POP	HL
	LD	DE,OUTFCB+1
	LD	B,6
MOVLP:	LD	A,(HL)	;IF CHAR = 0 THEN NO LOAD
	RES	7,A	;CLEAR ATTRIB
	OR	A
	JR	Z,SKP1
	LD	(DE),A
SKP1:	INC	HL
	INC	DE
	DJNZ	MOVLP
	LD	B,2	;NOW MOVE EXTENSION
	LD	DE,OUTFCB+9D
MOVLP1:	LD	A,(HL)
	RES	7,A
	OR	A
	JR	Z,SKP2
	LD	(DE),A
SKP2:	INC	HL
	INC	DE
	DJNZ	MOVLP1
	LD	DE,OUTFCB	;DELETE ANY EXISTING FILE
	CALL	DELET
	LD	DE,OUTFCB	;NOW MAKE NEW FILE
	CALL	MAKE
	INC	A
	JR	NZ,CONT1
	LD	BC,NOSPCM	;IF ERR THEN DIR FULL
	CALL	EDITOR
	JP	0
;
CONT1:	EQU	$
NXTSEG:	LD	HL,(BFRSIZ)	;IF LENGTH > BUFFER SIZE THEN 
;				 SEGMENTIZE
	LD	L,H	;CONVERT TO PAGES
	LD	H,0
	LD	DE,(INFPB+LENGO+1)
	XOR	A
	SBC	HL,DE
	JR	NC,CONT2
;
OVER:	LD	DE,(BFRSIZ)
	LD	E,D
	LD	D,0
	DEC	A	;FINISHED FLAG := FALSE
CONT2:	LD	(FINIS),A
	LD	(BFRCNT),DE
	PUSH	DE	;SET UP FOR READ
	POP	BC
	CALL	SETCNT
	LD	BC,(INFPB+BLOCKO+1)
	CALL	SETBID
	LD	BC,BUFFER
	CALL	SETMAP
	CALL	READF
	LD	C,A	;IF ERR THEN ERR
	JP	NZ,SYSERR
	LD	HL,BUFFER	;SET WRITE PTRS
	LD	(WRTPTR),HL
	LD	HL,(BFRCNT)
	ADD	HL,HL	;SECTORS := PAGES * 2
	LD	(WRTCNT),HL
NXTSEC:	LD	DE,(WRTPTR)
	CALL	SETDMA
	LD	DE,OUTFCB
	CALL	WRTSEC
	OR	A
	JR	NZ,DSKFUL	;IF ERR THEN EXIT
	LD	DE,SECSIZ	;WRTPTR := WRTPTR + SECTOR SIZE
	LD	HL,(WRTPTR)
	ADD	HL,DE
	LD	(WRTPTR),HL
	LD	HL,(WRTCNT)	;WRTCNT := WRTCNT - 1
	DEC	HL
	LD	(WRTCNT),HL
	LD	A,L
	OR	H
	JR	Z,DONE1
	JR	NXTSEC
;
DONE1:	LD	A,(FINIS)	;IF FINISHED THEN GO CLOSE
	OR	A
	JR	Z,CLOSE1
	LD	HL,(INFPB+LENGO+1)	;ELSE 
;				LENGTH := LENGTH - BUFFER SIZE
	LD	DE,(BFRSIZ)
	LD	E,D
	LD	D,0
	SBC	HL,DE
	LD	(INFPB+LENGO+1),HL	;SET UP FOR BID
	CALL	RDBID
	LD	(INFPB+BLOCKO+1),HL
	JP	NXTSEG
;
CLOSE1:	LD	DE,OUTFCB
	CALL	CLOS
	INC	A
	JR	NZ,CONT3
	LD	BC,CLOSEM	;OUTPUT CAN'T CLOSE MSG
	CALL	EDITOR
	JP	0
;
CONT3:	LD	IY,INFPB+1	;SET UP FOR NEXT FILE
	CALL	DIRSNX
	JP	NC,NXFILE
	LD	HL,(CMDPTR)	;IF NO ',' THEN EXIT
	LD	C,ACOMMA
	CALL	SERCH1
	JP	Z,0
	JP	NXTSRC
;
DSKFUL:	LD	BC,DSKFM	;OUTPUT DISK FULL MSG
	CALL	EDITOR
	JP	0
;
;   MESSAGES
;
SIGNON:	DB	CR,'PHIMON File Transfer Utility',83H
	DB	'Ver 1.0',CR
	DB	'(c) 1981  GRH Electronics, Cupertino, CA',CR,0
CLOSEM:	DB	'Cannot Close File!',CR,0
DSKFM:	DB	'Disk Full!',CR,0
NOSPCM:	DB	' Directory Full!',CR,0
DELTDM:	DB	' Deleted',CR,0
;
;   PHI FILE PARAMETER BLOCKS
;
INFPB:	DF	0,32D
OUTFPB:	DF	0,32D
;
;   CP/M FILE CONTROL BLOCKS
;
INFCB:	DF	0,32D
OUTFCB:	DF	0,32D
;
;   VARIABLES
;
DIRIN:	DB	-1
DELCTL:	DB	0
DIRBUF:	DW	BFR1K
DIRPTR:	DW	BFR1K
BLKTOT:	DW	0
DIRVAR:	DW	0
WILDFL:	DB	0
TOGGLE:	DB	2
FINIS:	DB	0
MEMTOP:	DW	0
BFRSIZ:	DW	0
WRTPTR:	DW	BUFFER
WRTCNT:	DW	0
BFRCNT:	DW	0
CMDPTR:	DW	CMDBFR
;
CMDBFR:	DF	0,SECSIZ
	DF	0,STKSIZ
;
STACK:	EQU	$
BFR1K:	EQU	$
;
BUFFER:	EQU	BFR1K+DIRSIZ
;
	END