Z3ENV	DEFL	0FE00H
VERS	EQU	14

; Version 1.4 modifications August 7,1991 by Bruce
; Morgen.  File list is now sorted for improved
; appearance and readability.  A Type 4 version has been
; implemented through use of the new WILDEN module in
; lieu of WILDEX and some added code for determining
; where the CRC3 buffer will be allocated.  The help
; message has been (I hope) clarified and now includes
; the ZCRCK COMfile Type and load address.  The data
; area is now in CSEG to prevent the Type 4 version
; from corrupting the CCP -- perhaps there is a better
; way, but nothing else I tried worked.

; Version 1.3 modifications december 11, 1989 by Howard
; Goldstein.  Added option to send output to a disk file.
; Fixed a couple of minor bugs.

; Version 1.2 modifications February 20, 1988 by Bruce
; Morgen, use faster CRC routines from SYSLIB4, include
; type-3 safety header, a few cosmetic touches, etc.

; Version 1.1 modifications May 13, 1987 by Bruce Morgen
; Added printer output option, made ZCRCK a Z33 type 3
; COMfile.  PRNDU is now internal, calling SYSLIB for
; output.  ZCRCK will no longer run on an 8080 or 8085.

;Z-systemCRCK, adapted by Bruce Morgen 5/22/86 from
;NewCRCK  -  NCRCK v1.00 as of 04/22/84 by S. Kluger
;
; ZCRCK satisfies both worlds by providing simultaneous display
; of CRCs computer by two polynomials:
;
; X^16 + X^12 + X^5 +1				(the one used in CHEK, LU)
; X^16 + X^15 + X^13 + X^7 + X^4 + X^2 + X + 1	(the one used in CRCK, XMODEM)
;
; The primary purpose is to display CRCK values on RCP/M systems.
; Therefore, no provisions for file output have been made.
; (It does, however, provide a much smaller, fast-loading
; alternative to more elaborate programs, like the standard Z3
; CRC.COM - b/m)
;
CR	EQU	0DH
LF	EQU	0AH
BEL	EQU	07H
TAB	EQU	09H
;
DFCB	EQU	5CH
DBUF	EQU	80H
FCB2	EQU	6CH
BDOSE	EQU	05H
PRNSTR	EQU	9
;
	EXTRN	WILDEN,SORT	; Sigiish wildcard table build/sort
	EXTRN	Z3INIT,DUTDIR,GETWHL,GETEFCB,Z3LOG,GZMTOP
	EXTRN	PHL4HC,SHL4HC,SHLDC,SAFDC,SPRINT,CIN
	EXTRN	F$OPEN,INITFCB,F$READ,EPRINT,LOUT,COUT
	EXTRN	RETUD,GETUD,PUTUD,FO0$OPEN,F0$PUT,FO0$CLOSE,F$DELETE
	EXTRN	CRC3CLR,CRC3UPD,CRC3DONE,CRC3INIT
	EXTRN	CRC2CLR,CRC2UPD,CRC2DONE
	EXTRN	DIVHD,$MEMRY,CODEND
	PUBLIC	SOUT,CSOUT,ENTRY,Z3EADR
;

; TYPE 3 HEADER

; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).

ENTRY:
	JR	START0			; Must use relative jump
	NOP				; Filler
	DB	'Z3ENV',3		; Type-3 environment
Z3EADR:
	DW	Z3ENV			; Filled in by Z33
	DW	ENTRY			; Intended load address
START0:
	LD	HL,0			; Point to warmboot entry
	LD	A,(HL)			; Save the byte there
	DI				; Protect against interrupts
	LD	(HL),0C9H		; Replace warmboot with a return opcode
	RST	0			; Call address 0, pushing RETADDR
					; onto stack
RETADDR:
	LD	(HL),A			; Restore byte at 0
	DEC	SP			; Get stack pointer to point
	DEC	SP			; To the value of RETADDR
	POP	HL			; Get it into HL and restore stack
	EI				; We can allow interrupts again
	LD	DE,RETADDR		; This is where we should be
	XOR	A			; Clear carry flag
	SBC	HL,DE			; Subtract -- we should have 0 now
	JR	Z,START			; If addresses matched, begin real code
	ADD	HL,DE			; Restore value of RETADDR

	LD	DE,NOTZ33MSG-RETADDR	; Offset to message
	ADD	HL,DE
	EX	DE,HL			; Switch pointer to message into DE
	LD	C,PRNSTR
	JP	BDOSE			; Return via BDOS print string function
NOTZ33MSG:
	DB	'Not Z33+$'		; Abort message if not Z33-compatible
;
START:
	LD	(STKSAV),SP
	LD	SP,STACK
	LD	HL,(Z3EADR)
	CALL	Z3INIT
	LD	HL,SCTLFL
	LD	(HL),1		; CON: only
	CALL	GETWHL
	JR	Z,BANNER
	LD	DE,FCB2+1
	LD	A,(DE)
	CP	'/'
	JR	Z,NXTOPT
OPTLP:	CP	' '
	JR	Z,BANNER	; End of options
	CP	'L'
	JR	Z,LOPT
	CP	'D'
	JR	NZ,NXTOPT
	SET	1,(HL)		; Set disk flag bit in sctlfl
	JR	NXTOPT
LOPT:	SET	7,(HL)		; Set list flag bit in sctlfl
NXTOPT:	INC	DE
	LD	A,(DE)
	JR	OPTLP
BANNER:	CALL	EPRINT		; Never to LST:
	DB	'ZCRCK, Version '
	DB	[VERS/10]+'0','.',[VERS	MOD 10]+'0'
	DB	' (ESKAY-b/m, Type ',0
	LD	A,((Z3EADR-1))
	ADD	A,'0'
	CALL	COUT
	CALL	EPRINT
	DB	' at ',0
	LD	HL,ENTRY
	CALL	PHL4HC
	CALL	EPRINT
	DB	'h)',CR,LF,LF,0
	LD	A,(DFCB+1)
	CP	'/'
	JP	Z,ZHELP
	CP	' '
	JP	Z,HELP
DUISOK:	CALL	PUTUD
	CALL	CODEND
	LD	($MEMRY),HL
	CALL	LOGIN		; Log into given files du
	CALL	WILDEN		; Expand possible wildcards
	JP	Z,NOFILE	; Quit if no file
	PUSH	HL
	LD	HL,($MEMRY)
	LD	(BUFPTR),HL	; Save as buffer pointer
	LD	A,((Z3EADR-1))
	CP	4
	CALL	NZ,GZMTOP
	DEC	HL
	DEC	H
	DEC	H
	CALL	CRC3INIT
	POP	HL
	CALL	SYSCK		; Check and mark $sys files
	LD	HL,(COUNT)
	LD	A,H
	OR	L		; Any files to work with?
	JP	Z,NOFILE
	CALL	RETUD
	CALL	GETUD
	LD	A,(SCTLFL)
	BIT	1,A		; Are we doing disk output?
	JR	Z,DSPMATCH	; Skip file open if not
	LD	DE,OUTFCB
	CALL	INITFCB
	CALL	F$DELETE
	CALL	FO0$OPEN
	JP	NZ,OPNERR

DSPMATCH:
	CALL	SPRINT
	DB	'Matching files:',0
	CALL	SHLDC
	CALL	DUTDIR
	JR	Z,NOTNDR
	PUSH	HL
	CALL	SPRINT
	DB	' in the [',0
	POP	HL
	LD	B,8
NDRLOP:	LD	A,(HL)
	CP	' '
	CALL	NZ,SOUT
	INC	HL
	DJNZ	NDRLOP
DIRMSG:	CALL	SPRINT
	DB	'] directory.',0	
NOTNDR:	CALL	SPRINT
	DB	CR,LF,LF
STLINE:	DB	'DU:filename.[typ]   '
ENDLIN:	DB	0
	CALL	RETUD
	LD	A,9
	CP	C
	LD	A,' '
	CALL	C,SOUT
	CALL	SPRINT
BGLIN:	DB	'CRCK     CHEK     KBytes   Records'
ENLINE:	DB	CR,LF,0
	LD	A,'-'
	CALL	C,SOUT
HYPHLN:	LD	B,[ENDLIN-STLINE]+[ENLINE-BGLIN]
HYPHLP:	CALL	SOUT
	DJNZ	HYPHLP
	CALL	SCRLF
LOOP:	LD	HL,0		; Initialize sector count
	LD	(SECTS),HL
	LD	HL,(COUNT)	; Get file count
	LD	A,H
	OR	L
	JP	Z,EXIT		; No more - exit
	DEC	HL		; Decrement file count...
	LD	(COUNT),HL	; ...and save it
	CALL	LOGIN		; Log into given files du
;
; loop here for each file
;
LOOP1:	LD	HL,(BUFPTR)	; Move next file name...
	LD	DE,FCB		; ...into fcb
	LD	BC,16
	PUSH	DE
	LDIR
	POP	DE
	LD	(BUFPTR),HL	; Points to next table entry
	CALL	INITFCB		; Zero the fcb
	LD	A,(FCB+10)	; $sys file?
	OR	A
	JP	M,LOOP1		; Yes, skip this one
	CALL	F$OPEN		; Open file
	JR	NZ,LOOP		; Just in case!
	CALL	RETUD
	CALL	GETUD
	CALL	PRNDU
	LD	HL,FCB+1	; Now, print the file name
	CALL	PFN
	CALL	CRC2CLR		; Clear both CRC accumulators
	CALL	CRC3CLR
	PUSH	DE
	CALL	LOGIN		; Log into given files du
	POP	DE
;
; continuously read and update CRC, increment sector count
; and loop until EOF detected
;
GETLP:	CALL	F$READ
	OR	A
	JR	NZ,GOTEOF
	LD	BC,DBUF		; Point to buffer
	LD	HL,(SECTS)	; Increment sector count
	INC	HL
	LD	(SECTS),HL	; add a sector to count
CLP:	LD	A,(BC)		; Get byte
	CALL	CRC2UPD		; Update both accumulators
	CALL	CRC3UPD
	INC	C		; Increment pointer...
	JR	NZ,CLP		; ..until end of buffer
	CALL	CTLC		; Check for abort
	JR	GETLP
;
; got end of file - print stats
;
GOTEOF:	CALL	GETUD
	CALL	SPACE		; Space to CRCK
	CALL	CRC2DONE
	CALL	SHL4HC		; Output hl as NNNN hex
	CALL	SPACE		; Space to CHEK
	CALL	CRC3DONE
	CALL	SHL4HC
	CALL	SPACE		; Space to KBYTES
	LD	HL,(SECTS)
	LD	DE,7		; Round to next full k
	ADD	HL,DE
	INC	DE
	CALL	DIVHD
	CALL	SHLDC
	CALL	SPACE		; Space to RECORDS
	LD	HL,(SECTS)
	CALL	SHLDC
	CALL	SCRLF
	JP	LOOP		; Go do next file
;
; check for $sys files and remove them
;
SYSCK:	LD	B,H		; Counter to BC for SORT
	LD	C,L
	LD	(COUNT),HL
	LD	HL,($MEMRY)
	LD	DE,16		; File-to-file offset is length
	PUSH	BC
	PUSH	HL
	CALL	SORT		; Good time to sort things out
	POP	HL
	POP	BC		; Get back counter
	LD	DE,10		; $sys flag offset
	ADD	HL,DE
	LD	E,16		; File-to-file offset (D = 0)
CKSYS:	LD	A,B		; Check if we still have more files
	OR	C
	RET	Z		; All done, quit
	DEC	BC
	BIT	7,(HL)		; Test t2 byte - IS IT SYS?
	CALL	NZ,SYS		; Yes, call processor
	ADD	HL,DE		; Point to next t2 byte
	JR	CKSYS
;
SYS:	CALL	GETWHL
	JR	NZ,PASS		; Wheel set - strip flag
	PUSH	HL
	LD	HL,(COUNT)	; Else decrement file counter...
	DEC	HL		; ...so that it doesn't show...
	LD	(COUNT),HL	; ...in the total count
	POP	HL
	RET
;
PASS:	RES	7,(HL)		; Strip $sys bit
	RET
;
CTLC:	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	C,6
	LD	E,0FFH
	CALL	BDOSE
	OR	A
	POP	BC
	POP	DE
	POP	HL
	RET	Z		; Nothing typed on con: - return
	CP	'C'-40H		; Was it ^C?
	JR	Z,ABORT		; Yes, quit
	CP	'S'-40H		; Was it ^S?
	RET	NZ		; No - return
	JP	CIN		; Else wait for keypress
;
; print 5 spaces
;
SPACE:	CALL	SPRINT
	DB	'     ',0
	RET
;
; print file name
;
PFN:	LD	B,8
	CALL	PFN2
	LD	A,'.'
	CALL	SOUT
	LD	B,3
PFN2:	LD	A,(HL)
	AND	7FH
	CALL	SOUT
	INC	HL
	DJNZ	PFN2
	RET

; Login to DU of file specified on command line

login:	LD	DE,DFCB
	JP	Z3LOG

; Print "DU:" to switched output when B=Disk and C=User code.

PRNDU:	LD	A,B
	ADD	A,'A'
	CALL	SOUT
	LD	A,C
	CALL	SAFDC
	LD	A,':'
	JR	SOUT		; JR xxxx = CALL xxxx!RET


; Print actual program name if possible, otherwise print "ZCRCK"

COMNAM:	CALL	GETEFCB
	JR	Z,NOEFCB
	LD	B,8
COMNLP:	INC	HL
	LD	A,(HL)
	AND	7FH
	CP	' '
	CALL	NZ,COUT
	DJNZ	COMNLP
	RET
NOEFCB:	CALL	EPRINT
	DB	'ZCRCK',0
	RET

;
; Switched output:  Put char to CON:, LST:, and/or disk file

CSOUT:
SOUT:	PUSH	HL
	PUSH	AF
	LD	HL,SCTLFL
	BIT	0,(HL)		; Console?
	CALL	NZ,COUT
	BIT	7,(HL)		; List?
	CALL	NZ,LOUT
	BIT	1,(HL)		; Disk?
	call	nz,f0$put
	jr	nz,dskful	; complain and abort if disk full
	POP	AF
	POP	HL
	RET

SCRLF:	PUSH	AF
	LD	A,CR
	CALL	SOUT
	LD	A,LF
	CALL	SOUT
	POP	AF
	RET

;
ABORT:	CALL	EPRINT
	DB	CR		; CR only! - erases filename.typ
	DB	'<<< Aborted! >>>',CR,LF,0
	CALL	GETUD
	JR	EXIT1
;
EXIT:	CALL	EPRINT
	DB	CR,LF,'Done.',CR,LF,0
EXIT1:	LD	A,(SCTLFL)
	BIT	1,A		; Writing to disk file?
	CALL	NZ,FO0$CLOSE	; CLOSE FILE IF SO
	JP	QUIT
;
DSKFUL:	CALL	EPRINT
	DB	CR,LF,LF
	DB	'Disk full!',CR,LF,0
	JR	EXIT1

NOFILE:	CALL	EPRINT
	DB	CR,LF
	DB	'File not found',CR,LF,0
	JP	QUIT
;
OPNERR:	CALL	EPRINT
	DB	CR,LF
	DB	'Can''t open output file',CR,LF,0
	JP	QUIT

HELP:	CALL	EPRINT
	DB	CR,LF
	DB	'No file specified',CR,LF,0
ZHELP:	CALL	EPRINT
	DB	'Syntax:',CR,LF,' ',0
	CALL	COMNAM
	CALL	EPRINT
	DB	' [du: or dir:]afn',0
	CALL	GETWHL
	JR	Z,HELP1
	CALL	EPRINT
	DB	' [[/]Options]',0
HELP1:	CALL	EPRINT
	DB	CR,LF,LF
	DB	' CRC values for the selected file(s) are displayed.',CR,LF
	DB	' Both "CRCK" (Petersen) and "CHEK" (CCITT) values shown.',CR,LF,0
	CALL	GETWHL
	JR	Z,QUIT
	CALL	EPRINT
	DB	' Options: "L"=output listing to LST: device.',CR,LF
	DB	TAB,'  "D"=output listing to file CRC.CRC',CR,LF,0

QUIT:	LD	SP,(STKSAV)
	RET

;
OUTFCB:	DB	0,'CRC     CRC'
	DS	24,0

;

STKSAV:	DS	2
COUNT:	DS	2
BUFPTR:	DS	2
SECTS:	DS	2
SCTLFL:	DS	1
FCB:	DS	36
	DS	60
STACK:	DS	2

	END