; This program is derived from MAKE26.ASM

; See file CFA10.HIS for upgrade notes and programmer credits.
; See file CFA10.DOC for full instructions, usage notes, warnings, etc.

;=============================================================================

;		P R O G R A M    E Q U A T E S

;=============================================================================

VERSION	EQU	10		; no longer an experimental release

FALSE	EQU	0
TRUE	EQU	NOT FALSE

ZCPR3	EQU	FALSE		;true for ZCPR3, false for plain CP/M
				; MAKE SURE TO SET THIS CORRECTLY.

WHEEL	EQU	FALSE		;true to test wheel byte before running
WHLADR	EQU	3EH		;wheel byte location

BDOS	EQU	0005H		;BDOS entry address
DMAADDR	EQU	0080H		;default CP/M file buffer
FCB	EQU	005CH		;default CP/M FCB
TFCB	EQU	006CH		;temporary FCB
Z3ENV	EQU	00000H		;ZCPR3 environment address filled in by Z3INS
CR	EQU	0DH		;(z3env not presently needed anyway)
LF	EQU	0AH
TAB	EQU	09H
BELL	EQU	07H

;=============================================================================

;		M A I N    P R O G R A M    C O D E

;-----------------------------------------------------------------------------

	ORG	0100H

CFA:

	 IF	ZCPR3

		;ZCPR3 initialization (not actually needed here, but if one
		;runs the install program it will not report a bad utility)

	JMP	START
	DB	'Z3ENV'
	DB	1		;external environment
	DW	Z3ENV		;environment address (value is not used here)

	 ENDIF	;ZCPR3

START:		;set up local stack pointer

	LXI	H,0		;get CP/M stack pointer
	DAD	SP
	SHLD	OLDSTK		;save it for later return
	LXI	SP,NEWSTK	;set up new local stack

		;perform setup tasks

	 IF	WHEEL
	LDA	WHLADR		;get wheel byte
	ORA	A		;is it set?
	JZ	EREXIT		;no/don't run
	 ENDIF			;wheel

	CALL	SIGNON		;print signon message
	CALL	CHKHLP		;see if help requested and go there if so

	CALL	INIT		;set up data areas
	CALL	SETDU		;handle current and specified DU areas
	CALL	GETOPT		;get option from command line (abort if bad)
	CALL	CHKRO		;abort if destination drive is R/O and option
				;..requests change in files

		;begin main work of program

	CALL	SRCHF		;locate first directory entry (abort if none)

LOOP:	CALL	SETPTR		;set DMAPTR to point to disk directory FCB
	CALL	CHKFIL		;check for applicable file
	CNC	CALLOPT		;if applicable file, process option

NEXTFIL:	;go on to next file

	LXI	H,DIRCODE 	;point to the directory code
	INR	M		;increase it one
	MOV	A,M		;get new value
	CPI	04		;check for four FCB entries completed
	JNZ	LOOP		;if not, go back and continue

		;process this group of four files and go on to next

	LXI	H,CHGFLAG	;point to change flag
	MOV	A,M		;get it into A
	MVI	M,0		;reset it
	ORA	A		;set flags from original value
	CNZ	WRTDE		;if changes were made, write the buffer back

		;sequence through files to get new buffer-full of FCB's

SRNXT:	LXI	D,AMBFIL	;point to any-match FCB
	MVI	C,12H		;BDOS search-next function
	CALL	BDOS
	CPI	0FFH		;see if end of entries
	JZ	QUIT		;quit if no more files
	CPI	0		;loop until buffer is updated by BDOS
	JNZ	SRNXT		;jump until dircode is zero
	STA	DIRCODE 	;save the 0 in dircode
	JMP	LOOP		; and loop again

;=============================================================================

;	O P T I O N    P R O C E S S I N G    R O U T I N E S

;-----------------------------------------------------------------------------

; Selects tag 1 to set high.

TAG1:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,1		;offset to tag 1
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects tag 1 to set low.

UNTAG1:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,1		;offset to tag 1
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------

; Selects tag 2 to set high.

TAG2:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,2		;offset to tag 2
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects tag 2 to set low.

UNTAG2:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,2		;offset to tag 2
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------

; Selects tag 3 to set high.

TAG3:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,3		;offset to tag 3
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects tag 3 to set low.

UNTAG3:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,3		;offset to tag 3
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------

; Selects tag 4 to set high.

TAG4:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,4		;offset to tag 4
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects tag 4 to set low.

UNTAG4:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,4		;offset to tag 4
	CALL	SETLO		; set control bit LOW
	RET

;------------------------------------------------------------------------------

; Selects SYS file attribute.

SETSYS:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,10		;offset 10 to DIR/SYS byte
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects DIR file attribute.

SETDIR:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,10		;offset 10 to SYS/DIR byte
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------

; Selects R/O file attribute.

SETRO:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,9		;offset 9 to R/O-R/W byte
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects R/W file attribute

SETRW:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,9		;offset 9 to R/O-R/W byte
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------
; Selects ARC file attribute.

SETARC:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,11		;offset 10 to ARCHIVE byte
	CALL	SETHI		; set control bit HIGH
	RET

;-----------------------------------------------------------------------------

; Selects Non-ARC file attribute.

SETNRC:
	LHLD	DMAPTR		;point to disk directory FCB entry
	LXI	D,11		;offset 10 to ARCHIVE byte
	CALL	SETLO		; set control bit LOW
	RET

;-----------------------------------------------------------------------------

; Erase the file by writing E5 as the user number tag.  We know that the file
; is not already erased because of the work of subroutine CHKFIL earlier.
; Therefore, we must set the change flag to show the need to write the sector
; back out to disk.

ERASE:
	LHLD	DMAPTR
	MVI	M,0E5H
	CALL	SETCHGFL	;show need to write sector back to disk
	CALL	REPORT		;report the new file status
	RET

;-----------------------------------------------------------------------------

; Unerase the file by writing the current user number into the tag byte in
; place of the E5.  The comments under ERASE apply here, too.

UNERA:
	LDA	DEFUSR		;get logged in user number
	LHLD	DMAPTR
	MOV	M,A		;put it into disk directory user # tag
	CALL	SETCHGFL	;show need to write sector back to disk
	CALL	REPORT		;report the new file status
	RET

;-----------------------------------------------------------------------------
;  This routine sets selected attribute or tag byte HIGH.  If the file
;  was not already set this way, the CHGFLAG is set to indicate the
;  necessity of writing the modified sector out to disk. 

SETHI:	DAD	D
	MOV	A,M		; get selected byte
        ORA	A		; test current state of control bit
	CP	SETCHGFL	; if not already high, set change flag
	ORI	80H		; make sure it is set
	MOV	M,A		; write modified byte back out
	CALL	REPORT		; report the new file status
	RET

;-----------------------------------------------------------------------------
;  This routine sets selected attribute or tag byte LOW.  If the file
;  was not already set this way, the CHGFLAG is set to indicate the
;  necessity of writing the modified sector out to disk. 

SETLO:	DAD	D
	MOV	A,M		; get selected byte
	ORA	A		; sign flag shows state of SYS bit
	CM	SETCHGFL	; if not already low, set change flag
	ANI	7FH		; clear the high bit
	MOV	M,A		; write modified byte back to buffer
	CALL	REPORT		; report the new file status
	RET

;-----------------------------------------------------------------------------

; Change the user number of the file.

CHUSER:	LDA	OPTION		;get user number
	LHLD	DMAPTR		;point to place to put it
	MOV	M,A		;put new user number in directory
	CALL	SETCHGFL	;show need to write sector back out to disk
	CALL	REPORT		;report the new file status
	RET

;-----------------------------------------------------------------------------

; This code reports the attributes of the files acted on and, if required,
; the erased or unerased status.  This code is called directly by the blank
; option and indirectly by all the other option processors after they have
; finished performing their changes on the files.

REPORT:	CALL	PRTFN		;print the file name
	CALL	ILPRT		;print spacer and equal sign
	DB	' = ',0
	CALL	PRTOPT		;print the option letter or number
	MVI	C,3		;put in three more blank spaces
	CALL	PRTBLK
	CALL	PRTATTR		;print file attributes
	LDA	OPTION		;see if files erased
	CPI	'E'
	CZ	PRTERA		;if so, print erased message
	LDA	OPTION
	CPI	'U'		;see if files unerased
	CZ	PRTUNE		;if so, print unerased message
	RET

;=============================================================================

;		P R O G R A M    F L O W    R O U T I N E S

;-----------------------------------------------------------------------------

;				CALLOPT

; This routine uses the value of OPTION to look up the processing routine
; to which to branch.

CALLOPT:
	LXI	H,JMPTBL	;point to jump table
	LDA	OPTION		;get user number or option letter
	MOV	B,A		;save it in B

LOOKUP:	MOV	A,M		;get option letter from table
	INX	H		;point to jump address
	ORA	A		;end of table?
	JZ	JMPOPT2		;if so, jump
	CMP	B		;do we match a table entry
	JZ	JMPOPT1		;if so, go to code to get jump address
	INX	H		;else jump over jump address to
	INX	H		;..next option character
	JMP	LOOKUP		;and try again

JMPOPT1:
	MOV	A,M		;get low part of jump address into A
	INX	H		;point to high part of address
	MOV	H,M		;get it into H
	MOV	L,A		;jump address is in HL
	PCHL			;jump to it

JMPOPT2:
	LXI	H,CHUSER	;default to change user routine
	PCHL			;jump to it

JMPTBL:	DB	' '
	DW	REPORT

	DB	'F'
	DW	TAG1

	DB	'G'
	DW	UNTAG1

	DB	'H'
	DW	TAG2

	DB	'I'
	DW	UNTAG2

	DB	'J'
	DW	TAG3

	DB	'K'
	DW	UNTAG3

	DB	'L'
	DW	TAG4

	DB	'M'
	DW	UNTAG4

	DB	'S'
	DW	SETSYS

	DB	'D'
	DW	SETDIR

	DB	'R'
	DW	SETRO

	DB	'W'
	DW	SETRW

	DB	'A'
	DW	SETARC

	DB	'N'
	DW	SETNRC

	DB	'E'
	DW	ERASE

	DB	'U'
	DW	UNERA

	DB	0		;end of table mark

;-----------------------------------------------------------------------------

;				QUIT

; Restores the original CP/M stack, and returns to CP/M.  If indicated by the
; reset flag, it resets the disk system.  The logged DU area when the program
; was invoked is restored.  The entry point QUIT2 is used by code CHKHL
; which that doesn't change the logged in directory.

QUIT:	LDA	DEFDRV		;get original default drive
	CALL	LOGDRV		;log it in
	LDA	DEFUSR		;get original default user
	CALL	LOGUSR		;log it in

		;see if we need to reset the disk system

QUIT1:	LDA	RSTFLAG
	ORA	A		;if reset flag is clear
	JZ	QUIT2		;..we can skip disk system reset

		;reset the disk system

	MVI	C,0DH
	CALL	BDOS

		;restore the original stack

QUIT2:	LHLD	OLDSTK		;get original stack pointer
	SPHL			;set it up

	CALL	CRLF		;one last blank line
	RET			;back to CP/M

	 IF	WHEEL
EREXIT:				;if using wheel byte and wheel not set
	CALL	ILPRT		;we pretend the program doesn't exist
	DB	'CFA?',0	;by printing phony CCP error.
	JMP	QUIT2
	 ENDIF			;wheel

;=============================================================================

;	F I L E    S E L E C T I O N    S U B R O U T I N E S

;-----------------------------------------------------------------------------

;				CHKFIL

; This subroutine checks to see whether or not the FCB pointed to in the
; DMA buffer is one that should be acted on.  If not, the routine returns
; with the zero flag set.

CHKFIL:	CALL	CHKUN		;check user number and erased status of file
	RC			;return with carry set to skip file
	CALL	CHKFN		;next check the file name for a match
	RET			;return showing status of name match

;-----------------------------------------------------------------------------

;				CHKUN

; This subroutine checks the user number status of a file and sets the carry
; flag if the file should be skipped over.  If the option is UNERASE and the
; file is not an erased file, it should be skipped.  If the option is not
; unerase and the file is an erased file, then likewise it should be skipped.
; Finally, if the file is in a user number other than the logged in user, it
; should also be skipped.

CHKUN:		;test file erased status

	LHLD	DMAPTR		;point to user number tag of file
	MOV	A,M		;get the tag
	CPI	0E5H		;carry flag set if not erased
	PUSH	PSW		;save flag
	
		;test program option status

	LDA	OPTION		;get the option
	CPI	'U'		;is it unerase?
	JNZ	CHKUN1		;if not, skip to CHKUN1

		;case of unerase option

	POP	PSW		;carry flag set if not erased
	RET			;file not erased will be skipped

		;case of option other than unerase

CHKUN1:	POP	PSW
	CMC			;carry flag set if file erased
	RC			;erased file will be skipped

		;now check for user number in source area

	LDA	ALLUSR		;see if "all users" was requested
	CPI	'#'		;
	JZ	CHKUN2		;if so, skip over compare...
	LDA	SRCUSR		;get source user number
	CMP	M		;compare to file tag
	RZ			;if OK, return (carry is clear)
	STC			;else set carry
CHKUN2:
	RET			;..and return

;-----------------------------------------------------------------------------

;				CHKFN

; This subroutine compares the name of the file in the FCB in the DMA buffer
; with the specification from the command line.

CHKFN:		;set up pointers and character count

	LHLD	DMAPTR		;get pointer to FCB in DMA buffer
	INX	H		;point to first character in the name
	LXI	D,FCB+1 	;set DE to name in FCB from command line
	MVI	C,0BH		;load count for compare

CP1:	LDAX	D		;get fcb command line character
	CPI	'?'		;see if anything matches
	JZ	MATCH		;if it is '?', consider it a match
	SUB	M		;get difference (see next instruction)
	ANI	7FH		;clear attribute bit
	JZ	MATCH		;if zero, characters match
	STC			;else set carry
	RET			;..and return

MATCH:	INX	D		;point to next characters
	INX	H
	DCR	C		;decrease count of characters
	JNZ	CP1		;loop until zero
	RET			;carry is clear showing names match

;=============================================================================

;	D I S K    O P E R A T I O N    S U B R O U T I N E S

;-----------------------------------------------------------------------------

;				SRCHF

; This subroutine uses the fully ambiguous file spec at AMBFIL to locate the
; first directory entry on the disk.  The directory code (0-3) is saved. If
; no directory entry is found, then the program gives a message and branches
; to QUIT for a prompt return.

SRCHF:	LXI	D,AMBFIL	;point to match any filename.typ
	MVI	C,11H		;bdos search first function
	CALL	BDOS		;do it
	STA	DIRCODE 	;save directory code
	CPI	0FFH		;see if end of entries
	RNZ			;if something found, return
	CALL	ILPRT		;else give a message
	DB	BELL
	DB	'Empty disk?',0
	JMP	QUIT

;-----------------------------------------------------------------------------

;				WRTDE

; This routine writes the directory buffer back to the disk.  I also sets the
; reset flag so that the disk system will be reset on program termination.

WRTDE:	LXI	H,RSTFLAG	;point to the flag
	MVI	M,0FFH		;set the flag
	MVI	C,1H		;set BIOS write to directory
				; C = 0   write to allocated
				; C = 1   write to directory
				; C = 2   write to unallocated
	CALL	WRITE		;do the write
	ORA	A		;check for error
	RZ			;if none, return

	CALL	ILPRT
	DB	BELL
	DB	'Bad Sector Write Error',0

	JMP	QUIT

;-----------------------------------------------------------------------------
	
;				WRITE

; This routine is filled in during the operation of the program and performs
; a direct BIOS sector write operation on the currently selected track and
; sector.

WRITE:	JMP	0000		;vector to bios write routine

;=============================================================================

;		P R I N T I N G    R O U T I N E S

;-----------------------------------------------------------------------------

;				PRTFN

; This subroutine displays (at the beginning of the next line of the screen)
; the name of the file pointed to in the DMA buffer.

PRTFN:	CALL	CRLF		;print cr/lf
	LHLD	DMAPTR		;address of file fcb
	INX	H		;skip to file name
	LXI	D,BLNKCNT	;point to blanks counter
	XCHG			;exchange pointers
	MVI	M,0		;preset blank count to zero

	MVI	C,8		;length of file name
	CALL	PRTSTR		;print the name first

	MVI	A,'.'		;print the period
	CALL	CHAROUT

	MVI	C,3		;now print the file type
	CALL	PRTSTR

	MOV	C,M		;get number of blanks needed for fill
	CALL	PRTBLK		;print the blanks
	RET

;-----------------------------------------------------------------------------

;				PRTOPT

; This subroutine prints out the option as a letter or as a number as
; appropriate.

PRTOPT:	LDA	OPTION		;get the option value
	CPI	20H		;if it's a user number, carry will be set
	JNC	CHAROUT		;if not number, just print the character
	MVI	B,'0'-1		;preset for two-digit calculation later
	CPI	10		;see if single digit
	JNC	TWODIG		;if not, print two digits
	ADI	'0'		;else convert to ASCII
	JMP	CHAROUT		;and print it
TWODIG:	INR	B		;count tens digit in B
	SUI	10		;keep subtracting 10 until carry is set
	JNC	TWODIG
	ADI	10		;get remainder (units digit) back
	MOV	C,A		;save it in C
	MOV	A,B		;print tens digit
	CALL	CHAROUT
	MOV	A,C		;print units digit
	ADI	'0'
	JMP	CHAROUT

;-----------------------------------------------------------------------------

;				PRTATTR

; This subroutine prints the attribute status (SYS or DIR and R/O or R/W)
; of the file currently being worked on.

PRTATTR:
	LHLD	DMAPTR		;point to file FCB
	LXI	D,9		;offset to R/O-R/W byte
	DAD	D
	PUSH	H		;save pointer for reuse below
	MOV	A,M
	RAL			;move R/O bit into carry
	PUSH	PSW		;save flags
	CC	PRTRO		;if carry, print read-only
	POP	PSW		;get flags back to test again
	CNC	PRTRW		;if not carry, print read-write

	POP	H		;get pointer back
	INX	H		;point to SYS/DIR byte
	PUSH	H		;save pointer for reuse below
	MOV	A,M
	RAL			;move SYS/DIR bit into carry
	PUSH	PSW		;save flags
	CC	PRTSYS		;if carry, print SYS
	POP	PSW		;get them back
	CNC	PRTDIR		;if not carry, print DIR
	POP	H
	INX	H
	MOV	A,M
	RAL			;move ARCHIVE bit into carry
	PUSH	PSW		;save flags
	CC	PRTARC		;if carry, print ARC
	POP	PSW		;get them back
	CNC	PRTNRC		;if not carry, print Non-ARC
	RET
	
;-----------------------------------------------------------------------------

;	MESSAGE PRINTING ROUTINES

PRTRO:	CALL	ILPRT		;file is read-only
	DB	'  R/O',0
	RET

PRTRW:	CALL	ILPRT		;file is read-write
	DB	'  R/W',0
	RET

PRTSYS:	CALL	ILPRT		;file has SYS attribute
	DB	'  SYS',0
	RET

PRTDIR:	CALL	ILPRT		;file has DIR attribute
	DB	'  DIR',0
	RET

PRTARC:	CALL	ILPRT		;file has ARC attribute
	DB	'  ARCHIVE',0
	RET

PRTNRC:	CALL	ILPRT		;file has NO ARC attribute
	DB	'  Non-ARC',0
	RET

PRTERA:	CALL	ILPRT		;file erased
	DB	'  <ERASED>',0
	RET

PRTUNE:	CALL	ILPRT		;file unerased
	DB	'  <UNERASED>',0
	RET

;-----------------------------------------------------------------------------

;				HELP

; This code displays the built in help screen and then jumps to QUIT to
; return to CP/M.  Entire menu re-written for this version.

HELP:	CALL	ILPRT
	DB	'Usage:',TAB

	 IF	ZCPR3
	DB	'CFA [dir:]filename.typ X[#]',CR,LF,LF
	DB	' where dir: is optional directory specifier in DU:',CR,LF
	DB	' or named directory form,'
	 ENDIF	;ZCPR3

	 IF	NOT ZCPR3
	DB	'CFA [d:]filename.typ X[#]',CR,LF,LF
	DB	' where d: is optional drive specifier,'
	 ENDIF	;NOT ZCPR3

	DB	' and X may be ONE of these:',CR,LF,LF

	DB	'Number 0-31',CR,LF
	DB	'  Moves file to user area X',CR,LF,LF

	DB	'File tags:',TAB,TAB,TAB
	DB	'File attributes:',CR,LF

	DB	'  F or G  Tag 1, on/off',TAB,TAB
	DB	'  R or W:  $R/O or $R/W',CR,LF

	DB	'  H or I  Tag 2, on/off',TAB,TAB
	DB	'  S or D:  $SYS or $DIR',CR,LF

	DB	'  J or K  Tag 3, on/off',TAB,TAB
	DB	'  A or N:  $ARC or $Non-ARC',CR,LF

	DB	'  L or M  Tag 4, on/off',CR,LF
	DB	LF	; end of usual file tags and attributes

	DB	'File erase or unerase:',CR,LF
	DB	'  E or U:  Erase or Unerase (into current user)'
	DB	CR,LF,LF

	DB	'Add "#" after any letter option to work in ALL user areas'
	DB	0	; end of help text

	JMP	QUIT2

;=============================================================================

;	G E N E R A L - P U R P O S E   S U B R O U T I N E S

;-----------------------------------------------------------------------------

;				CRTOUT

; This subroutine sends the character in register A to the console.  Registers
; BC, DE, and HL are preserved.

CHAROUT:

	PUSH	H		;save registers
	PUSH	D
	PUSH	B
	MOV	E,A		;get character into E
	MVI	C,06		;BDOS direct console I/O
	CALL	BDOS
	POP	B		;restore registers
	POP	D
	POP	H
	RET

;-----------------------------------------------------------------------------

;				CRLF

; This routine sends a carriage return and linefeed to the console.

CRLF:	CALL	ILPRT
	DB	CR,LF,0
	RET

;-----------------------------------------------------------------------------

;				FILL

; This subroutine fills memory starting at HL for a length B with the byte
; in A.

FILL:
	MOV	M,A
	INX	H
	DCR	B
	JNZ	FILL
	RET

;-----------------------------------------------------------------------------

;				ILPRT

; This subroutine prints the string that follows its call.  The string must
; be terminated with a null (0).

ILPRT:	POP	H	;get address following call into HL

ILPRT1:	MOV	A,M	;get character from message
	INX	H	;point to next character
	ORA	A	;test for null indicating end of message
	JZ	ILPRT2	;if end, fix up return address
	MOV	E,A	;have BDOS send character it to console
	MVI	C,2
	PUSH	H	;save pointer to string
	CALL	BDOS
	POP	H	;restore pointer
	JMP	ILPRT1	;process it

ILPRT2:	PUSH	H	;set up return address to just past message
	RET

;-----------------------------------------------------------------------------

;				PRTSTR

; This subroutine prints a string of characters pointed to by DE.  The number
; of characters is in the C register.  Blanks are not printed; instead, the
; blanks counter pointed to by HL is incremented.

PRTSTR:	LDAX	D		;get character
	CPI	' '		;see if it is a blank
	CZ	UPCOUNT		;if so, up the count
	CNZ	CHAROUT		;if not, output the character
	INX	D
	DCR	C		;check count
	JNZ	PRTSTR
	RET

UPCOUNT:
	PUSH	PSW		;save flags
	INR	M		;increase the blank counter
	POP	PSW		;restore flags
	RET

;-----------------------------------------------------------------------------

;				PRTBLK

; This subroutine prints blank spaces given by the count in C.  The routine
; will work even for a count of zero.

PRTBLK:	INR	C		;turn 0 into 1
PRTBL1:	DCR	C		;check count
	RZ			;return if count exhausted
	MVI	A,' '		;set character to print
	CALL	CHAROUT
	JMP	PRTBL1

;=============================================================================

;		S E T U P    S U B R O U T I N E S

;-----------------------------------------------------------------------------

;				SIGNON

; This subroutine displays the program signon message.

SIGNON:	CALL	ILPRT
	DB	CR,LF,'CFA - v'
	DB	VERSION / 10 + '0'
	DB	'.'
	DB	VERSION MOD 10 + '0'

	 IF	ZCPR3
	DB	' for ZCPR3'
	 ENDIF	;ZCPR3

	DB	CR,LF,0
	RET

;-----------------------------------------------------------------------------

;				CHKHLP

; This subroutine checks to see if the user has invoked the program in a
; way to request the built-in help screen.  The help screen is shown if the
; command has no tail or if the tail begins with a slash.

CHKHLP:	LDA	FCB+1		;get first character of first parameter
	CPI	' '		;no name?
	JZ	HELP		;if so, go to HELP
	CPI	'/'		;parameter starts with slash?
	JZ	HELP		;if so, go to HELP
	RET			;return with flag set appropriately

;-----------------------------------------------------------------------------

;				INIT

; This subroutine initializes the data areas in the program so that GO
; command will re-run the program correctly.

INIT:	XRA	A		;zero the accumulator
	STA	CHGFLAG		;preset control flags
	STA	RSTFLAG
	STA	DIRCODE
	LXI	H,AMBFIL2
	MVI	B,16
	CALL	FILL		;clear the fcb

	MVI	A,'?'
	MVI	B,16
	LXI	H,AMBFIL
	CALL	FILL

	LHLD	0001		;get warmboot address (base of bios + 3)
	LXI	D,27H		;offset for jump to bios write
	DAD	D		;compute address for write routine
	SHLD	WRITE + 1	;load our vector with this address

	RET

;-----------------------------------------------------------------------------

;				SETDU

; This subroutine gets and saves the values of the currently logged in drive
; and user area and the drive and user specified (if any) on the command line
; for the files to be operated on.

SETDU:		;get currently logged in user number

	MVI	C,20H		;BDOS get/set user number function
	MVI	E,0FFH		;get user flag
	CALL	BDOS
	STA	DEFUSR
	STA	SRCUSR		;save for now as source user also

		;get the currently logged in drive

	MVI	C,19H		;bdos get drive number function
	CALL	BDOS		;get drive number
	STA	DEFDRV
	INR	A		;change range 1-16 and
	STA	SRCDRV		;..save for now as source drive also
	
		;now log in the drive and user in file spec

	LDA	FCB		;get drive spec from FCB
	ORA	A		;see if default specified
	JZ	SETDU1
	STA	SRCDRV		;save source drive
	SUI	1		;get in range 0-15
	CALL	LOGDRV		;log in the drive
	XRA	A		;and change FCB to show default drive
	STA	FCB

SETDU1:

	 IF	ZCPR3
	LDA	FCB+13		;get user number from S1 byte
	STA	SRCUSR		;save as source user area
	CALL	LOGUSR		;log in the user number
	 ENDIF	;ZCPR3

	RET

;-----------------------------------------------------------------------------

; These two routines log in the drive or user number given in the A register.
; No registers are preserved.

LOGDRV:	MOV	E,A
	MVI	C,0EH
	CALL	BDOS
	RET

LOGUSR:	MOV	E,A
	MVI	C,20H
	CALL	BDOS
	RET

;-----------------------------------------------------------------------------

;				GETOPT

; Process option specified on the command line.  If there is an error, the
; routine jumps to HELP which in turn jumps to QUIT.  If a named directory
; is specified for the destination on the command line, then its user number
; is obtained from address TFCB+13.  The drive is checked to make sure that
; the destination is on the same drive.

GETOPT:

	 IF	ZCPR3

		;check for destination specified using named directory

	LDA	TFCB		;check for drive number
	ORA	A		;if zero, no DIR: or DU: given
	JZ	GETOPT1

		;check for correct drive spec

	LXI	H,SRCDRV	;point to source drive value
	CMP	M
	JNZ	BADDRV		;if not the same, jump to bad drive message

		;get the user number

	LDA	TFCB + 13
	STA	OPTION		;store user number as option
	JMP	CHKNUM		;check for valid user number

BADDRV:	CALL	ILPRT		;destination and source drives not same
	DB	BELL
	DB	'Source and Destination Drives must be same',0
	JMP	QUIT

	 ENDIF	;ZCPR3

GETOPT1:
	LXI	H,TFCB		;point to parsed second parameter
	MOV	A,M		;make sure it wasn't of form 'D:'
	ORA	A		;drive byte should be zero
	JNZ	BADOPT
	INX	H		;now look at data entered

	MOV	A,M		;get the first character
	CALL	GETNUM		;try to read it as a number
	JC	LETTER		;if not, must be a letter or bad
	MOV	B,A		;save digit in B
	STA	OPTION		;..and as interim option
	INX	H		;try next character
	MOV	A,M
	CPI	' '		;if it is a blank
	JZ	CHKNUM		;..go to test user number value

	CALL	GETNUM		;see if second character is a number
	JC	BADOPT		;if not, we have a bad option spec

	MOV	C,A		;save second digit
	MOV	A,B		;get first digit back
	ADD	A		;double it three times to make 8x
	ADD	A
	ADD	A
	ADD	B		;now add original in twice to make 10x
	ADD	B
	ADD	C		;finally, add in second digit
	STA	OPTION		;..and save the final result

		;check for valid user number (in range and not same
		;as logged in user number)

CHKNUM:	LDA	OPTION		;make sure we have the user number
	CPI	32		;test for valid user number range
	JNC	BADNUM
	LXI	H,SRCUSR	;see if same as source user
	CMP	M
	JZ	SAMENUM		;if so, give message
	RET

LETTER:		;check for valid letter option
	PUSH	PSW		;save option letter
	INX	H		;check whether option followed by '#'
	MOV	A,M		
	CPI	'#'
	JNZ	LETTER0		;not "all users" switch, don't save it
	STA	ALLUSR
LETTER0:
	POP	PSW		;get option character back
	LXI	H,OPTLIST	;point to list of valid options
	MOV	C,M		;get number of options in list
LETTER1:			;loop through them checking
	INX	H
	CMP	M		;compare to list entry
	JZ	GOODOPT		;if it matches, we have a good option
	DCR	C		;else, count down
	JNZ	LETTER1		;..and try again
	JMP	HELP		;we get here if option is not valid

GOODOPT:	;we have a good option letter
	STA	OPTION
	RET

BADOPT:		;we have a bad option specifier
	CALL	ILPRT
	DB	BELL,0	; if bad option, just a bell, then menu
	JMP	HELP

BADNUM:		;we have an illegal user number
	CALL	ILPRT
	DB	BELL
	DB	'User number must be 0-31',0
	JMP	QUIT

SAMENUM:	;give message about already in that user area
	CALL	ILPRT
	DB	BELL
	DB	'Destination/Source user numbers must be different',0
	JMP	QUIT

		;subroutine to check for number character
		;returns with carry set if not a number

GETNUM:	CPI	'0'		;see if less than '0'
	RC			;if so, set carry flag as signal
	CPI	'9'+1		;see if more than '9'
	CMC			;reverse sense of carry flag
	RC			;if >9, return with carry set
	SUI	'0'		;convert to number value
	RET			;carry is clear

		;list of valid options

OPTLIST:
	DB	ENDLIST-OPTLIST	;number of options in list
	DB	' SDRWANEU'	; options for file attributes
	DB	'FGHIJKLM'	; options for file tags

ENDLIST:	; just a marker, no code.

;-----------------------------------------------------------------------------

;				CHKRO

; This routine checks to see if the destination drive is read-only.  If it
; is, an appropriate error message is displayed and the program aborts with
; a jump to QUIT.  If the option is display only (option = space char), then
; this test is skipped.

CHKRO:	LDA	OPTION		;see if display option is in effect
	CPI	' '
	RZ			;if so, skip rest of test

	MVI	C,1DH		;get R/O vector from BDOS
	CALL	BDOS

		;calculate number of left-shifts needed

	LDA	SRCDRV		;get the target drive number
	CMA			;complement it (makes 255-SRCDRV)
	ADI	17		;makes A = 16 - SRCDRV (value 1-16)

		;shift word in HL to put bit of R/O vector for
		;specified drive into high bit position

CHKRO1:	DCR	A		;test for done
	JZ	CHKRO2		;if so, jump
	DAD	H		;shift HL to left
	JMP	CHKRO1		;and loop

CHKRO2:	DAD	H		;move high bit into carry flag
	RNC			;if not R/O, return
	CALL	ILPRT		;else print R/O error message
	DB	BELL
	DB	'Drive is R/O',0

	JMP	QUIT		;abort program

;=============================================================================

;		M I S C E L L A N E O U S    R O U T I N E S

;-----------------------------------------------------------------------------

;				SETPTR

; This subroutine uses the value of the directory code to calculate a pointer
; to the FCB in the DMA buffer.  This is done by multiplying the directory code
; by 32 and adding it to the DMA address (DMAADDR).  The result is saved in
; DMAPTR.

SETPTR:
	LDA	DIRCODE 	;get the directory code
	ADD	A		;offset by 32 bytes per entry
	ADD	A
	ADD	A
	ADD	A
	ADD	A
	MOV	E,A		;move value into DE
	MVI	D,0
	LXI	H,DMAADDR	;get buffer address
	DAD	D		;compute offset into buffer
	SHLD	DMAPTR		;save the address into the buffer
	RET

;-----------------------------------------------------------------------------

;				SETCHGFL

; This subroutine sets the change-flag to show that the directory sector
; has been modified and needs to be written out to disk.

SETCHGFL:
	PUSH	PSW
	MVI	A,0FFH		;set the sector change flag
	STA	CHGFLAG
	POP	PSW
	RET

;=============================================================================

;			D A T A    A R E A

;-----------------------------------------------------------------------------

OLDSTK:				;place to keep old stack pointer
	DS	2

BLNKCNT:			;count of blank characters in file name
	DS	1

CHGFLAG:			;flag for change requiring write
	DS	1

RSTFLAG:			;flag for need to reset disk system
	DS	1

AMBFIL:				;working fcb
	DS	16

AMBFIL2:			;space for rest of FCB
	DS	19

OPTION:				;storage for new user number or option
	DS	1

ALLUSR:				;storage for "all users" switch
	DS	1

DIRCODE:			;storage for directory code (0-3)
	DS	1

DMAPTR:				;address of FCB in DMA buffer
	DS	2

DEFDRV:				;current default drive
	DS	1

SRCDRV:		 		;source drive
	DS	1

DEFUSR:				;current default user number
	DS	1

SRCUSR:				;source user area from file spec
	DS	1

	DS	60		;room for local stack

NEWSTK:
	END