TITLE	PHIMON DIRECTORY CONVERTER  3 MAY 81   12:15
;*************************************************************
;
;   (c) 1981  GRH Electronics  CUPERTINO, CA
;
;*************************************************************
;
;   PCONV is a PHIMON directory converter to allow access
; to PHIMON generated files through DCOS rutines. Specifically,
; it clears all attributes but the delete attribute except
; if the PHIMON file is deleted.
;
;   SYNTAX:
;   PCONV D:
;
;   WHERE:
;   D: = Drive number (0 - 3)
;
;*************************************************************
	FORM
;*************************************************************
;
;	DECLARATIONS:
;
TPA:	EQU	100H
DEFBFR:	EQU	0080H
BDOS:	EQU	5
STACK:	EQU	TPA
;
LF:	EQU	0AH
CR:	EQU	0DH
;
	FORM
;*************************************************************
;
;	ASSEMBLER DIRECTIVES:
;
	ORG	TPA
;
ENTRY:	JP	START
;
;
;   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,0
	ADD	HL,DE
	LD	C,(HL)		;GET MESSAGE PTR
	INC	HL
	LD	B,(HL)
	CALL	EDITOR
NOPRFX:	LD	BC,ERRMSG
	CALL	EDITOR
	SCF
	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
;
;
;   PHI PROM VECTORS
;
SETMAP:	EQU	0F403H
SETBID:	EQU	0F406H
SETCNT:	EQU	0F409H
SETDRV:	EQU	0F40FH
READF:	EQU	0F412H
WRITF:	EQU	0F415H
;
;   READ DIRECTORY SUBR
;   ENTRY- IY= FPB PTR (DRIVE PRESET)
;          (DIRBUF)= 1K DIRECTORY BUFFER AREA
;
DIRRD:	EQU	$
READIR:	LD	A,(IY+[-1])
	LD	C,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
;
;   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
;
;   ASCII TEXT PROCEDURES
;
;********************************************************
;
;   EXTRN   BDOS
;
;********************************************************
;
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:	EQU	$
	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
;
;  MAIN START
;
START:	LD	SP,STACK
	LD	BC,SIGNON	;OUTPUT SIGN-ON MSG
	CALL	EDITOR
	LD	HL,DEFBFR	;GO GET DRIVE #
	LD	A,(HL)
	RES	7,A
	CP	80H		;IF TOO BIG THEN ERR
	JR	C,CONT0
SYNERR:	LD	C,5
	JP	SYSERR
;
CONT0:	INC	HL
	PUSH	HL
	ADD	L		;PUT 0 IN END OF LINE
	LD	L,A
	JR	NC,HOK
	INC	H
HOK:	LD	(HL),0
	POP	HL
	LD	C,':'
	CALL	SERCH1
	JR	Z,SYNERR
	DEC	HL		;BACKUP & GET DRIVE SPEC
	LD	A,(HL)
	SUB	'0'		;IF NOT 0 TO 3 THEN ERR
	JR	C,SYNERR
	CP	4
	JR	NC,SYNERR
	LD	IY,FPB
	LD	(IY+[-1]),A	;SET DRIVE #
	CALL	READIR
	LD	C,A
	JP	NZ,SYSERR
	LD	HL,(DIRBUF)
	INC	HL		;B := ENTRY COUNT
	LD	B,(HL)
ENTLP:	INC	HL		;IF FILE DELETED THEN SKIP
	LD	A,(HL)
	OR	A
	JR	Z,DELTD
	SET	7,(HL)		;ELSE SET NOT DELETED ATTRIBUTE
DELTD:	LD	C,7		;C := CHAR COUNT
NAMLP:	INC	HL
	RES	7,(HL)		;CLEAR ATTRIBUTE
	DEC	C
	JR	NZ,NAMLP
	INC	HL		;SKIP OVER LENGTH
	INC	HL
	DJNZ	ENTLP		;DO WHILE ENTRIES > 0
	CALL	WRTDIR		;REWRITE CONVERTED DIRECTORY
	LD	C,A
	JP	NZ,SYSERR	;IF WRITE ERROR THEN ERR
	JP	0		;RETURN TO CP/M
;
TOGGLE:	DB	2
;
SIGNON:	DB	CR,LF,'PHIMON Directory Converter  Ver 1.0',CR
	DB	'(c) 1981  GRH Electronics   Cupertino, CA',0
;
;   FPB
;
DRIVE:	DB	0
FPB:	EQU	$
NAME:	DW	0,0,0,0
LENGTH:	DW	0
EXTRAS:	DW	0,0,0,0,0,0,0
;
DIRBUF:	DW	BUFFER
;
BUFFER:	EQU	$
;
	END