title	Checksum Tool
	name	('COMCHK')
	maclib	base80.lib	

; Program adds or deletes checksum as described in several
; issues of the English magazine 8000PLUS

; Call it:
;		COMCHK -opt ASCII_file{.ext}
;
; -opt:	-C{tab}	for creating a checksum and
;	-D for	deleting a checksum
;
; Optional 'tab' in option -C allow setting tab position where
; the checksum starts. It defaults to 95
;
; 'ext' defaults to 'BAS' on option -C and
; a new file 'ASCII_file.CRC' will be created
;
; 'ext' defaults to 'CRC' on option -D and
; a new file 'ASCII_file.BAS' will be created

; Copyleft (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-2000 Hamburg 20
;		Tel.: 040/4223247

;		Version 1.0 Oktober 1994

;		All wrongs reserved

	entry	$memry

	extrn	string,upplin,filnam
	extrn	open,creatd,close,fillin,dskwrt
	extrn	adda,hexout

MaxLine	equ	255

TABs	equ	95

BASchr	equ	0fch		; Special BASIC code if tokenized

	dseg
$ILLOPT:
	db	'Invalid option, select ''-C'' or ''-D'''
	db	eot
$HELP:
	db	'Add or delete checksum of a BASIC program.'
	db	cr,lf,lf
	db	'This program reproduces the list of numbers down the right hand side'
	db	cr,lf
	db	'of each of listings published in the magazine 8000PLUS.'
	db	cr,lf
	db	'This allows a simple error detection comparing the numbers.'
	db	cr,lf,lf
	db	'The program also allows deleting of the checksums'
	db	cr,lf
	db	'for reconstructing the original BASIC source.'
	db	cr,lf,lf
	db	'Call it'
	db	cr,lf
	db	tab,tab,'COMCHK -opt ASCII_file{.ext}'
	db	cr,lf,lf
	db	'-opt:',tab,'-C{tab}',tab,'for creating a checksum and'
	db	cr,lf
	db	tab,'-D for',tab,'deleting a checksum'
	db	cr,lf,lf
	db	cr,lf
	db	'Optional ''tab'' in option -C allow setting tab position where'
	db	cr,lf
	db	'the checksum starts. It defaults to 95.'
	db	cr,lf,lf
	db	'''ext'' defaults to ''BAS'' on option -C and'
	db	cr,lf
	db	'a new file ''ASCII_file.CRC'' will be created.'
	db	cr,lf,lf
	db	'''ext'' defaults to ''CRC'' on option -D and'
	db	cr,lf
	db	'a new file ''ASCII_file.BAS'' will be created.'
	db	eot
$NOFILE:
	db	'Cannot find',eot
$NOCREC:
	db	'Cannot create',eot
$CLOSERR:
	db	'Cannot close',eot
$WRTERR:
	db	'Write error in',eot
$CRCDONE:
	db	'Done, result in',eot
$FILE:
	db	' file ',eot
$ILLCODE:
	db	'Error - Program was not saved in ASCII mode'
	db	cr,lf,lf
	db	'Save program with ''SAVE PRG,A'' and'
	db	cr,lf
	db	'run  the checksum program again'
	db	eot
$ILLNUM:
	db	'Invalid tab number in option ''-C'''
	db	eot
$HEXERR:
	db	'Invalid hex checksum in line:'
	db	cr,lf,eot
;
; ----- Default setting is for option -D -----
;
ExecAdr:
	dw	DoDelChk3
SrcExt:
	dw	$CRC
DstExt:
	dw	$BAS
;
; --------------------------------------------
;
$BAS:
	db	'BAS'
$CRC:
	db	'CRC'
$memry:
	ds	2
BASICline:			; Original line
	ds	2
UPPERline:			; UPPER CASE LINE
	ds	2
RecCnt:				; Record count of destination file
	ds	2
StrtPtr:			; Start of memory pointer
	ds	2
CRCptr:				; Current memory pointer
	ds	2
TABdef:				; Start position of checksum
	db	TABs
TABset:				; Length of blanks to output
	ds	1
check$:				; ASCII hex checksum
	db	'xxxx'
crlf$:
	db	cr,lf
	cseg
;
; Jump thru register
; ENTRY	Reg HL holds address
;
jpr:
	jp	(hl)
;
; Read line from file and return as upper case
; EXIT	Carry set on error
;	Reg C holds length of line on success
;
RdLine:
	ld	de,(BASICline)	; Get line pointer
	ld	b,null
	call	fillin		; Read line from file
	ret	c		; End of file
	push	af		; Save length
	ld	hl,(UPPERline)	; Get upper case line pointer
	push	hl
	inc	de
	ex	de,hl
	ld	c,a
	ld	b,0
	inc	bc
	ldir			; Unpack line
	pop	de
	ld	b,null
	call	upplin		; Convert line to UPPER case
	pop	af		; Get back length
	ld	c,a
	dec	c		; Remember new line
	dec	c
	or	a		; Set success
	ret
;
; Make page boundary
; ENTRY	Reg HL holds address
; EXIT	Reg HL holds address on page boundary
;
Boundary:
	inc	l
	dec	l		; Test already on boundary
	ret	z		; Yeap
	ld	l,0		; Else make boundary
	inc	h
	ret
;
; Copy second FCB to main FCB
;
cpyFCB:
	ld	hl,FCB2
	ld	de,FCB
	ld	bc,dirlen
	ldir			; Copy it
	ret
;
; Test character a decimal character
; ENTRY	Accu holds character
; EXIT	Carry set if invalid
;
tstdig:
	cp	'0'		; Test range
	ret	c
	cp	'9'+1
	ccf
	ret
;
; Test character a hex character
; ENTRY	Accu holds character
; EXIT	Carry set if invalid
;
tsthx:
	cp	'A'		; Test range
	ret	c
	cp	'F'+1
	ccf
	ret
;
; Test character a hexadecimal character
; ENTRY	Accu holds character
; EXIT	Carry set if invalid
;
TstHex:
	call	tstdig		; Test 0..9
	call	c,tsthx		; Nope, test A..F
	ret
;
; Convert ASCII decimal to byte
; ENTRY	Reg DE points to ASCII
; EXIT	Reg C holds byte
;
decbyt:
	ld	a,(de)		; Get character
	inc	de
	cp	' '		; Tes end of string
	ret	z		; Yeap
	call	tstdig		; Verify digit
	jr	c,IllNum
	sub	'0'		; Strip off offset
	ld	b,a		; Save it
	ld	a,c		; Get old
	add	a,a		; Calculate *10
	add	a,a
	add	a,c
	add	a,a
	add	a,b		; Add new one
	ld	c,a
	jr	decbyt		; Try next
;
; Set new tab position
;
getTab:
	ld	c,0		; Init result
	call	decbyt		; Get byte
	ld	a,c
	ld	(TABdef),a
	or	a		; Verify not zero
	ret	nz
IllNum:
	ld	de,$ILLNUM
	jr	LastMsg		; Tell error
;
; Process option
; ENTRY	Reg DE points to option line
; EXIT	Reg HL holds execution address
;
procOpt:
	inc	de		; Skip minus sign
	ld	a,(de)
	inc	de
	cp	'D'		; Test delete
	jr	nz,isOptC
	ld	a,(de)
	cp	' '		; VErify blank
	ret	z		; Ok, it is default


	jr	invOpt		; Tell invalid


isOptC:
	cp	'C'		; Verify create
	jr	nz,invOpt	; Should be
	ld	hl,DoCheck3
	ld	(ExecAdr),hl	; Change setting
	ld	hl,$BAS
	ld	(SrcExt),hl
	ld	hl,$CRC
	ld	(DstExt),hl
	ld	a,(de)		; Test possible tab setting
	cp	' '
	call	nz,getTab	; Yeap, get it
	ret
invOpt:
	ld	de,$ILLOPT
	jr	LastMsg		; Tell invalid option	
;
; ##################################################
; ################## START COMCHK ##################
; ##################################################
;
COMCHK:
	ld	sp,(TPATOP)	; Get stack
	ld	a,(FCBnm2)
	cp	' '		; Verify file there
	jr	nz,GotParam	; Yeap
HelpMsg:
	ld	de,$HELP
LastMsg:
	call	string		; Give hints if not
	jp	OS
GotParam:
	ld	de,FCBnam
	ld	a,(de)
	cp	'-'		; Verify option there


	jr	nz,HelpMsg	; Nope


	call	procOpt		; Process option
	call	cpyFCB		; Copy FCB
	ld	de,FCBext
	ld	a,(de)
	cp	' '		; Test extension
	jr	nz,GotType
	ld	hl,(SrcExt)
	ld	bc,.fext
	ldir			; Set default extension
GotType:
	ld	de,FCB
	call	open		; Open file
	ld	de,$NOFILE
	jr	c,FileMsg	; File not found
	ld	hl,($memry)	; Get start of free memory
	call	Boundary	; Make page boundary
	ld	(BASICline),hl	; Save address for line of file
	ld	(hl),MaxLine	; Set max for input
	inc	h
	ld	(UPPERline),hl	; Save address for upper case line
	inc	h
	ld	(StrtPtr),hl
	ld	(CRCptr),hl	; Save address
	ld	hl,(ExecAdr)
	call	jpr		; Do the checksum task
	ld	hl,(CRCptr)	; Get last address
	call	FillEOF		; Fill remaining of buffer
	ld	(CRCptr),hl
	ld	de,(StrtPtr)	; Init start of data
	or	a
	sbc	hl,de		; Get length of code
	xor	a
	add	hl,hl		; Divide by record size
	adc	a,a
	ld	l,h
	ld	h,a
	ld	(RecCnt),hl	; Save record count
	ld	de,FCBext
	ld	hl,(DstExt)
	ld	bc,.fext
	ldir			; Set BASIC default extension
	ld	de,FCB
	call	creatd		; Create new file
	ld	de,$NOCREC
	jr	c,FileMsg	; Cannot create
	ld	hl,(StrtPtr)	; Init start of data
	ld	bc,(RecCnt)	; Get record count
WrLoop:
	call	WrData		; Write to disk
	dec	bc
	ld	a,b
	or	c		; Test end
	jr	nz,WrLoop	; Nope
	ld	de,FCB
	call	close		; Close file
	ld	de,$CRCDONE
	jr	nc,FileMsg	; Ok
	ld	de,$CLOSERR	; Else error
FileMsg:
	call	string		; Tell main message
	ld	de,$FILE
	call	string		; Tell sub message
	ld	de,FCBnam
	call	filnam		; Tell name of file
	jp	OS
;
; Write data to disk
; ENTRY	Reg HL points to current data
; EXIT	Reg HL points to next data
;
WrData:
	push	bc
	ld	de,DMA
	ld	bc,reclng
	ldir			; Unpack data
	push	hl
	ld	de,FCB
	call	dskwrt		; Write to disk
	pop	hl
	pop	bc
	ret	nc
	ld	de,$WRTERR
	jr	FileMsg		; Tell error
;
; Clear last buffer
; ENTRY	Reg HL holds buffer address
; EXIT	Buffer filled with EOF
;
FillEOF:
	ld	a,l
	and	reclng-1	; Test boundary
	ret	z		; Yeap
	ld	(hl),eof	; Fill it
	inc	hl
	jr	FillEOF
;
; ############################################################
;
; Create checksums
;
DoCheck3:
	call	RdLine		; Read line from file
	ret	c		; End of file
	ld	a,(TABdef)
	sub	c		; Calculate length of TABs
	ld	(TABset),a
	push	af		; Save sign
	push	af
	call	BuildCRC	; Build checksum
	pop	af		; Get back sign
	call	nc,prCRCline	; Print line including checksum
	pop	af
	call	c,SplitLine	; Do line followed by checksum line
	jr	DoCheck3
;
; Build checksum of input line
; ENTRY	Reg C holds length of line
;
BuildCRC:
	ld	de,(UPPERline)	; Get upper case line
	ld	b,c		; Unpack length
	ld	c,0		; Clear counter
	ld	l,c		; Clear checksum
	ld	h,c
BuildLoop:
	ld	a,(de)		; Get character
	inc	de
	cp	' '		; Test blank
	jr	z,BuildSkip	; Skip it
	cp	BASchr		; Verify not special character
	jr	z,BuildError	; Invalid
	inc	c		; Update count
	sub	' '		; Strip off offset
	call	adda		; Add to sum
	ld	a,c
	call	mod7		; Build modulo
	call	adda		; Add to sum
BuildSkip:
	djnz	BuildLoop
	ld	de,check$	; Point to hex
	call	hexout		; Convert to ASCII
	ret
BuildError:
	ld	de,$ILLCODE
	call	string		; Tell invalid
	jp	OS		; And exit
;
; Build MOD 7 + 1
; ENTRY	Accu holds original value
; EXIT	Accu holds MOD 7 + 1
;
mod7:
	cp	7+1		; Check 1..7
	jr	c,mod7ok	; Yeap
	sub	7		; Divide for result 1..7
	jr	mod7
mod7ok:
	inc	a		; Fix to 2..8
	ret
;
; ##### Combine output line(s) #####
;
; Take original line, add blanks and checksum
;
prCRCline:
	jr	z,SplitLine	; Special case
	call	OrigLine	; Copy original line
	call	PosTab		; Append checksum
	ret
;
; Take original line, new line with blanks and checksum
;
SplitLine:
	call	OrigLine	; Copy original line
	ld	hl,crlf$
	ld	bc,2
	ldir			; Close line
	ld	a,(TABdef)	; Get length if tabs
	call	PosAll		; Copy checksum as extra line
	ret
;
; ##################################
;
; Copy original line to memory

OrigLine:
	ld	hl,(BASICline)	; Get source line
	ld	de,(CRCptr)	; Get destination address
CpyLine:
	inc	hl
	ld	a,(hl)
	cp	' '		; Test end
	ret	c		; Yeap
	ld	(de),a		; Unpack
	inc	de
	jr	CpyLine
;
; Position checksum and copy it
;
PosTab:
	ld	a,(TABset)	; Get length of tabs
PosAll:
	ld	b,a		; Set count
	ld	a,' '
TabPos:
	ld	(de),a		; Give blanks
	inc	de
	djnz	TabPos
	ld	hl,check$	; Point to hex
	ld	bc,4+2
	ldir			; Unpack hex
	ld	(CRCptr),de	; Save address
	ret
;
; ############################################################
;
; Delete checksums
;
DoDelChk3:
	call	RdLine		; Read line from file
	ret	c		; End of file
	call	FixLine		; Fix the line
	jr	DoDelChk3
;
; Fix line 
; ENTRY	Reg HL holds pointer to end of line
; EXIT	Reg HL points to end of lines
;
FixLine::
	ld	hl,(BASICline)	; Get line pointer
	ld	b,0
	add	hl,bc		; Point to end
	inc	hl
	ld	(hl),eot	; Force end for error line
	dec	hl
	call	VerifyCRC	; Verify four hex digits
FLloop:
	ld	a,(hl)
	dec	hl
	cp	' '		; Skip trailing blanks
	jr	z,FLloop
	inc	hl
	inc	hl
	ld	(hl),cr		; Close line
	inc	hl
	ld	(hl),lf
	ld	de,(CRCptr)	; Get destination address
	ld	hl,(BASICline)	; Get line pointer
FLcpy:
	inc	hl
	ld	a,(hl)
	ld	(de),a
	inc	de
	cp	lf
	jr	nz,FLcpy
	ld	(CRCptr),de	; Save address
	ret	
;
; Verify four characters are hex ones
; ENTRY	Reg HL points to string
;
VerifyCRC:
	push	bc
	ld	b,4		; Set count
VCloop:
	ld	a,(hl)		; Get character
	call	TstHex		; Verify hex
	jr	c,HexErr	; Error
	dec	hl
	djnz	VCloop
	pop	bc
	ret
HexErr:
	ld	de,$HEXERR
	call	string		; Tell error
	ld	de,(BASICline)	; Get line pointer
	inc	de
	call	string		; Tell error line
	jp	OS
;
; ############################################################
;

	end	COMCHK