TITLE	MSERIAL
	SUBTTL	Program serialization for CP/M 8" 2.2 disks

VERSION	EQU	22	;VERSION 1.4
MOVTRK	EQU	3	;TRACK CONTAINING MOVCPM PROGRAM

	.COMMENT \
	PROGRAM SERIALIZATION FOR CP/M DISKETTES

NOTE **********************************************************
THIS PROGRAM CONTAINS DIGITAL RESEARCH PROPRIETARY INFORMATION,
AND MUST NOT BE REPRODUCED, COPIED, OR TRANSCRIBED IN ANY FORM
WHATSOEVER
***************************************************************


	COPYRIGHT (C) 1976, 1977, 1978
	DIGITAL RESEARCH
	BOX 579 PACIFIC GROVE
	CALIFORNIA, 93950
\

	JMP	START
	DB	"Copyright (C) 1978, Digital Research "

;	GLOBAL EQUATES
BOOT	EQU	0
BDOS	EQU	5
CONIN	EQU	1	;READ CONSOLE DEVICE
RDBUFF	EQU	10	;READ BUFFER
PBUFF	EQU	9	;PRINT BUFFER
CR	EQU	0DH
LF	EQU	0AH

CCPB	EQU	3400H	;CONSOLE PROCESSOR BASE
BDOSB	EQU	3C00H	;BASIC DOS BASE
OFFSET	EQU	80H	;SPACE FOR COLD BOOT ON DISK
SLEN	EQU	BDOSB-CCPB	;SEARCH LENGTH FOR SERIAL NUMBER

READTRK:;READ DISK DRIVE A, FROM TRACK "TRACK"
	;INTO THE ADDRESS GIVEN BY "BUFFA"
	XRA	A
	STA	DSKNO
	CALL	SEL	;SELECT DRIVE A
	JMP	READ$D


WRITTRK:;WRITE TO DISK DRIVE B, TO TRACK "TRACK"
	;FROM THE ADDRESS GIVEN BY "BUFFA"
	MVI	A,1
	STA	IOF	;SET IOFUNCTION TO WRITE
	STA	DSKNO
	CALL	SEL	;SELECT DRIVE B
	JMP	RW$DISK

REREAD:	;READ FROM DISK DRIVE B, FROM TRACK "TRACK"
	;TO THE ADDRESS GIVEN BY "BUFFA"
	MVI	A,1
	STA	DSKNO
	CALL	SEL	;DRIVE B SELECTED
READ$D:	XRA	A
	STA	IOF	;SET TO READ FUNCTION
RW$DISK:;READ OR WRITE DISK
	LXI	H,TRACK
	MOV	C,M	;GET TRACK NUMBER
	CALL	TRK	;TRACK SELECTED
	LHLD	BUFFA	;GET DMA ADDRESS
	MVI	D,0
	LDA	NSECTS
	MOV	E,A
RW$LOOP:;READ/WRITE LOOP
	INR	D	;TO NEXT SECTOR
	PUSH	D
	PUSH	H
	MOV	C,D
	CALL	SEC	;SECTOR SET
	POP	B
	PUSH	B	;GET DMA ADDRESS
	CALL	DMA	;DMA ADDRESS SET
	;PERFORM IO FUNCTION
	LDA	IOF
	ORA	A	;SET FLAGS, 0=READ, 1=WRITE
	JNZ	WRITEFUNC
	;READ DISK
	CALL	DREAD
	JMP	RWCOMPLETE
WRITEFUNC:	;WRITE DISK
	CALL	DWRITE
RWCOMPLETE:	;FUNCTION COMPLETE
	POP	H	;RECALL DMA ADDRESS
	LXI	D,80H
	DAD	D	;TO NEXT DMA
	POP	D	;RECALL SECTOR AND COUNT
	; CHECK ERROR CONDITIONS
	ORA	A
	RNZ	;RETURN WITH NON ZERO FLAG SET
	DCR	E	;COUNT = COUNT - 1
	JNZ	RW$LOOP	;FOR ANOTHER SECTOR
	RET	;WITH ZERO FLAG SET FOR IO COMPLETE


;	UTILITY SUBROUTINES FOR DIRECT DISK IO
WBOOT	EQU	1	;WARM BOOT ADDRESS
SELDSK	EQU	24	;SELECT DISK
SETTRK	EQU	27	;SET TRACK
SETSEC	EQU	30	;SET SECTOR
SETDMA	EQU	33	;SET DMA ADDRESS
READF	EQU	36	;READ DISK
WRITF	EQU	39	;WRITE DISK

SEL:	;SELECT DRIVE GIVEN BY REGISTER A
	MOV	C,A
	LHLD	WBOOT
	LXI	D,SELDSK
	DAD	D
	PCHL

TRK:	;SET TRACK GIVEN BY C
	LXI	H,26*128
	MVI	A,26
	STA	NSECTS
	SHLD	TRSIZE
	LHLD	WBOOT
	LXI	D,SETTRK
	DAD	D
	PCHL

SEC:	;SET	SECTOR GIVEN BY C
	LHLD	WBOOT
	LXI	D,SETSEC
	DAD	D
	PCHL

DMA:	;SET DMA ADDRESS TO VALUE OF B,C
	LHLD	WBOOT
	LXI	D,SETDMA
	DAD	D
	PCHL

DREAD:	;PERFORM READ OPERATION
	LHLD	WBOOT
	LXI	D,READF
	DAD	D
	PCHL

DWRITE:	;PERFORM WRITE OPERATION
	LHLD	WBOOT
	LXI	D,WRITF
	DAD	D
	PCHL

START:	LXI	SP,STACK
	CALL	ORGMSG	;ORIGIN PROMPT
	CALL	READ
ORG0:	MOV	A,B
	ORA	A
	JZ	ORG1
	CALL	RDERR	;NOT A VALID ORIGIN NUMBER
	JMP	ORG0	;FOR ANOTHER
ORG1:	LXI	H,ORIGIN
	MOV	M,C	;SAVED THE ORIGIN NUMBER
	LXI	H,COMLEN
	MOV	B,M
	INX	H
	XCHG
	LXI	H,AORIGIN	;ASCII VERSION OF THE ORIGIN
ORG2:	LDAX	D
	ORA	A
	JZ	ORG3
	INX	D
	MOV	M,A
	INX	H
	DCR	B
	JNZ	ORG2
	;ASCII VERSION MOVED TO BUFFER, PAD IT
ORG3:	MVI	M,"-"
	INX	H
	MVI	M,"$"	;READY FOR PRINTING

;	NOW READ THE SERIAL NUMBER
	CALL	SERMSG
	CALL	READ
	LXI	H,BSERIAL
	MOV	M,C
	INX	H
	MOV	M,B	;BINARY COPIED
	LXI	H,COMLEN
	MVI	A,5
	SUB	M	;DIFFERENCE IN REG-A
	LXI	H,ASERIAL
	JZ	PAD1	;PAD HIGH ORDER POSITIONS WITH 0
PAD0:	MVI	M,"0"
	INX	H
	DCR	A
	JNZ	PAD0
PAD1:	LXI	D,CBUFF	;ADDRESSING BUFFER
PAD2:	LDAX	D
	ORA	A
	JZ	PAD3	;LOOKING FOR BINARY 0
	MOV	M,A
	INX	H
	INX	D
	JMP	PAD2	;FOR ANOTHER CHAR
PAD3:	;END OF ASCII FILL (NOW RIGHT ADJUSTED IN ASERIAL)

RDDSK:	;READ DISK AND COPY
	CALL	INSMSG
	CALL	CI	;WAIT FOR RESPONSE

NEXTDISK:
	MVI	A,255
	STA	STRACK	;MARK AS MOVCPM.COM NOT SERIALIZED
	CALL	CURMSG
	CALL	ASERMSG
	CALL	NEWMSG
	CALL	CI
	;NEW DISK IS READY, TRY THE COPY OPERATION
	LXI	H,TRACK
	MVI	M,0	;CLEAR THE TRACK NUMBER
	LXI	H,TRCOUNT
	MVI	M,"0"
	INX	H
	MVI	M,"0"

RDTRK:	;READ THE NEXT SOURCE TRACK, COMPARE WITH 0E5H FOR END
	LXI	H,IBUFF
	SHLD	BUFFA
	CALL	READTRK
	JZ	READOK
	CALL	READ0MSG
	JMP	RDDSK
READOK:	;TRACK IS IN MEMORY, TRACK 0?
	LDA	TRACK
	ORA	A
	JNZ	QTRK3
	;TRACK 0, LOOK FOR SERIAL NUMBER
	LXI	H,CCPV
	LXI	B,SLEN
SEARCH:	PUSH	H
	PUSH	B
	LXI	D,COMPARE
	MVI	C,COMPLEN
COMP0:	LDAX	D
	CMP	M
	JNZ	NOMATCH
	INX	H
	INX	D
	DCR	C
	JNZ	COMP0
	;MATCH COMPLETE, WE HAVE FOUND THE SERIAL NUMBER
	POP	B
	POP	D	;CLEARS STACK
	PUSH	H	;SAVE A COPY OF THE START ADDRESS OF THE SER #
	LDA	ORIGIN
	MOV	M,A
	INX	H
	MVI	M,VERSION	;VERSION NUMBER IN BINARY
	XRA	A	;REMAINING BYTES ARE ZERO UNTIL SEQ#
	INX	H
	MOV	M,A
	INX	H
	MOV	M,A
	INX	H	;READY TO ACCEPT THE SERIAL NUMBER
	XCHG
	LHLD	BSERIAL
	XCHG
	MOV	M,D
	INX	H
	MOV	M,E
	;FIRST SERIAL NUMBER IS STORED, NOW COPY TO BDOS
	POP	B
	PUSH	B
	LXI	D,BDOSV
;	COMPUTE DIFFERENCE IN ADDRESSES FOR LATER
	MOV	A,E
	SUB	C
	MOV	L,A
	MOV	A,D
	SBB	B
	MOV	H,A
	SHLD	SDIFF
	POP	H
	MVI	C,6	;LENGTH OF SERIAL NUMBER
;	H,L ADDRESS START OF SERIAL NUMBER, D,E ADDRESS SECOND #
COPY0:	MOV	A,M
	STAX	D
	INX	D
	INX	H
	DCR	C
	JNZ	COPY0
	;BDOS SERIAL NUMBER IS COPIED
	JMP	RDTRKN

NOMATCH:;TRY FOR NEXT MATCH
	POP	B
	POP	H
	INX	H
	DCX	B
	MOV	A,C
	ORA	B
	JNZ	SEARCH
	;NOT FOUND
	CALL	BADDSK
	JMP	RDDSK

QTRK3:	;IS THIS TRACK 3? IF SO, LOOK FOR CPM.COM
	CPI	MOVTRK
	JNZ	RDTRKN
	;LOOK FOR SERIAL NUMBER
	LXI	H,0
	LXI	B,TRLEN	;TRACK LENGTH IN B,C
QTR0:	PUSH	H
	PUSH	B	;SAVE BASE ADDRESS AND LENGTH
	LXI	D,COMPARE
	MVI	C,COMPLEN
QTR1:	;TRY TO MATCH ANOTHER CHAR
	PUSH	H
	CALL	TRANSLATE
	LDAX	D
	CMP	M
	;FLAGS SET IF EQUAL
	POP	H
	JNZ	NOMAT3
	INX	H
	INX	D
	DCR	C
	JNZ	QTR1
	;COMPLETE MATCH, FILL SERIAL NUMBERS
	POP	B
	POP	D	;TO CLEAR THE STACK
	PUSH	H	;SAVE SOURCE ADDRESS
	CALL	STSERIAL	;SERIAL NUMBER STORED
	POP	H	;RECALL SOURCE ADDRESS
	XCHG
	LHLD	SDIFF
	DAD	D	;H,L SHOULD ADDRESS SER#2
	MOV	A,L
	ORA	A
	JNZ	QTR2	;MUST BE LOW ZERO
	;SETUP STRACK TO SERIALIZE WHEN PROPER TRK FOUND
	XCHG
	LXI	H,STRACK	;DIFFERENCE IN D,E
	MVI	M,0	;COUNT STRACK UP FOR EACH TRACK SIZE
DLOOP:	INR	M	;STRACK = STRACK + 1
	PUSH	H
	LXI	H,TRSIZE
	MOV	A,E
	SUB	M
	INX	H
	MOV	B,A	;SAVE LOW ORDER DIFFERENCE
	MOV	A,D
	SBB	M
	POP	H
	JC	EDLOOP	;CARRY IF TOO MANY SUBTRACTS
	MOV	D,A
	MOV	E,B	;RESET TO LOWER VALUE
	JMP	DLOOP
EDLOOP:	;D,E CONTAIN OFFSET INTO TRACK STRACK
	XCHG
	SHLD	SDIFF
	JMP	RDTRKN
NOMAT3:	;NO MATCH ON CURRENT STRING
	POP	B
	POP	H
	INX	H
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	QTR0	;FOR ANOTHER SCAN
	;NOT FOUND
QTR2:	CALL	BADCOM
	JMP	RDDSK

RDTRKN:	;CHECK FOR MOVCPM.COM SERIALIZATION
	LXI	H,STRACK
	MOV	A,M
	ORA	A
	JZ	NOSER
	;ALREADY SERIALIZED IF STRACK=0
	DCR	M
	JNZ	NOSER	;NOT ON PROPER TRACK
	;ON PROPER TRACK, SDIFF CONTAINS INDEX TO BDOS SERIAL#
	LHLD	SDIFF
	CALL	STSERIAL
NOSER:	;TRACK IN MEMORY, CHECK FOR LAST TRACK
	LXI	H,IBUFF
	LXI	B,TRLEN
TRCOMP:	MVI	A,0E5H
	CMP	M
	JNZ	WRTRK
	INX	H
	DCX	B
	MOV	A,C
	ORA	B
	JNZ	TRCOMP
	;END OF COPY, ALL 0E5H'S
	LDA	STRACK
	ORA	A
	JZ	ENDCOPY
	;NOT ZERO, COULD NOT FIND SECOND SER NUMBER
	CALL	BADCOM
	JMP	RDDSK
ENDCOPY:LXI	D,TRMSG
	CALL	PRMSG
	CALL	INCSERIAL
	JMP	NEXTDISK

	;NOT END OF COPY, WRITE TRACK TO DISK FROM IBUFF
WRTRK:	CALL	WRITTRK
	JZ	WROK
	CALL	WRITE0MSG
	JMP	NEXTDISK
WROK:	;WRITTEN TO DISK, NOW READ IT BACK AND COMPARE
	LXI	H,OBUFF
	SHLD	BUFFA
	CALL	REREAD
	JZ	READ1OK
	CALL	READ1MSG
	JMP	NEXTDISK
READ1OK:LXI	H,IBUFF
	LXI	D,OBUFF
	LXI	B,TRLEN
WRCOMP:	LDAX	D
	CMP	M
	JNZ	WRERR
	INX	H
	INX	D
	DCX	B
	MOV	A,C
	ORA	B
	JNZ	WRCOMP
	;COMPARE WENT OK, INCREMENT TRACK COUNT AND CYCLE
	LXI	H,TRACK
	INR	M
	LXI	H,TRCOUNT+1
	INR	M
	MOV	A,M
	CPI	"9"+1
	JC	RDTRK	;OVERFLOW TO HIGH ORDER TRACK NUMBER
	MVI	M,"0"
	DCX	H
	INR	M
	JMP	RDTRK

WRERR:	;VERIFY ERROR
	CALL	VERERR
	JMP	NEXTDISK


;	UTILITY SUBROUTINES
CI:	MVI	C,CONIN
	JMP	BDOS	;READ A CHARACTER

PRMSG:	MVI	C,PBUFF
	JMP	BDOS	;PRINT A BUFFER

RDERR:	CALL	INVALID

READ:	;READ CONSTANT VALUE TO B,C
	LXI	D,MAXLEN
	MVI	C,RDBUFF
	CALL	BDOS	;BUFFER FILLED
	LXI	H,COMLEN
	MOV	A,M
	ORA	A
	JZ	RDERR	;NON ZERO LENGTH
	INX	H
	MOV	E,A
	MVI	D,0
	DAD	D	;H,L ADDRESS LAST POS+1
	MVI	M,0	;CLEARED FOR END OF SCAN
	LXI	H,CBUFF
	LXI	B,0
CONV:	MOV	A,M
	ORA	A
	RZ	;RETURN IF END OF CONVERT
	SUI	"0"
	CPI	10
	JNC	RDERR
	PUSH	H
	PUSH	B
	POP	H	;B,C COPIED TO H,L
	DAD	H
	DAD	H
	DAD	H
	DAD	B
	DAD	B
	PUSH	H
	POP	B
	POP	H	;BC=BC*10
	INX	H
	ADD	C
	MOV	C,A
	MVI	A,0
	ADC	B
	MOV	B,A
	JC	RDERR
	JMP	CONV	;TESTED FOR OVERFLOW

INCSERIAL:	;INCREMENT THE SERIAL NUMBER
	LHLD	BSERIAL
	INX	H
	SHLD	BSERIAL	;TEST FOR OVERFLOW
	MOV	A,L
	ORA	H
	JZ	SEROVER

	LXI	H,ASERIAL+4
	MVI	B,5	;LENGTH OF SERIAL NUMBER
INC0:	INR	M
	MOV	A,M
	CPI	"9"+1
	RC	;RETURN IF NO CARRY
	MVI	M,"0"	;CLEAR THE NUMBER
	DCX	H
	DCR	B
	JNZ	INC0

SEROVER:;OVERFLOW IN SERIAL NUMBER
	CALL	OVERMSG
	JMP	BOOT

TRANSLATE:	;TRANSLATE THE RELATIVE ADDRESS IN H,L TO ABSOLUTE ADDRESS
	;IN IBUFF, ASSUMING SECTORS ARE SKEWED
	PUSH	D
	MOV	A,L
	ANI	7FH
	MOV	E,A	;LS 7 BITS OF ADDRESS SAVED
	MOV	A,L
	RAL	;CARRY GETS MSB
	MOV	A,H
	RAL	;CARRY GOES TO LSB
	MOV	L,A
	MVI	H,0	;H,L CONTAIN INDEX INTO TRANSLATE TABLE
	PUSH	D
	LXI	D,TRAN
	DAD	D
	POP	D
	;H,L ADDRESS TRANSLATION ELEMENT, CONVERT TO REL ADDRESS
	XRA	A
	MOV	A,M
	DCR	A 
	RAR	;CARRY GETS LSB, MSB=0
	MOV	H,A
	MVI	A,0
	RAR	;CARRY GOES TO MSB
	ORA	E	;RECLAIM THE LEAST SIGNIFICANT 7 BITS
	MOV	L,A
	LXI	D,IBUFF
	DAD	D	;ABSOLUTE ADDRESS IN H,L
	POP	D	;RECALL STACKED D VALUE
	RET

STBYTE:	;STORE BYTE VALUE GIVEN BY REGISTER A TO TRANSLATED
	;ADDRESS GIVEN BY H,L.  INCREMENT H,L UPON RETURN
	PUSH	H
	PUSH	D
	PUSH	PSW
	CALL	TRANSLATE
	POP	PSW
	MOV	M,A
	POP	D
	POP	H
	INX	H
	RET

STSERIAL:	;STORE THE SERIAL NUMBER INTO ADDRESS GIVEN BY H,L
	LDA	ORIGIN
	CALL	STBYTE	;BYTE STORED, H,L INCREMENTED
	MVI	A,VERSION
	CALL	STBYTE	;VERSION NUMBER
	XRA	A
	CALL	STBYTE
	XRA	A
	CALL	STBYTE	;TWO ZERO BYTES
	;NOW MOVE SERIAL NUMBER TO LAST TWO BYTES
	LXI	D,BSERIAL+1	;ADDRESS HIGH ORDER POSITION OF SER #
	LDAX	D
	CALL	STBYTE
	DCX	D	;ADDRESS LOW ORDER BYTE
	LDAX	D
	CALL	STBYTE
	RET


;	PRINT STRINGS
INSMSG:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Insert control diskette in A, type RETURN$"

ORGMSG:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"CP/M ver "
	DB	VERSION/10+"0",".",VERSION MOD 10 +"0"
	DB	" serialization",CR,LF
	DB	"Origin number?$"

SERMSG:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Starting serial number?$"

INVALID:LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Invalid number, try again:$"

CURMSG:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Serializing disk $"

ASERMSG:LXI	D,AORIGIN
	CALL	PRMSG
	LXI	D,ASERIAL
	JMP	PRMSG

NEWMSG:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Insert new diskette, type RETURN:$"

BADCOM:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Bad MOVCPM.COM file, replace$"

BADDSK:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Non CP/M diskette, cannot serialize$"

VERERR:	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Verification error, bad disk$"

OVERMSG:LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Serial number overflow$"
READ0MSG:
	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Error on source disk, replace$"

WRITE0MSG:
	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Cannot write new disk, replace$"

READ1MSG:
	LXI	D,$+6
	JMP	PRMSG
	DB	CR,LF,"Cannot re-read new disk, replace$"

;	MISCELLANEOUS DATA AREAS

ASERIAL:DB	"00000$"
TRMSG:	DB	CR,LF
TRCOUNT:DB	"00 tracks verified$"
COMPARE:DB	"DIR "
	DB	"ERA "
	DB	"TYPE"
	DB	"SAVE"
	DB	"REN "
	DB	"USER"
COMPLEN EQU	$-COMPARE
;	SECTOR TRANSLATION VECTOR
TRAN:	DB	1,7,13,19, 25,5,11,17
	DB	23,3,9,15, 21,2,8,14
	DB	20,26,6,12, 18,24,4,10
	DB	16,22
TRLEN	EQU	26*128	;BUFFER SIZE

;	INPUT BUFFER
MAXLEN:	DB	7
END:
COMLEN:	DS	1
CBUFF:	DS	8
STRACK:	DS	1	;SERIALIZE TRACK FOR CPM.COM FILE WHEN ENCOUNTERED
SDIFF:	DS	2	;DIFFERENCE BETWEEN TWO SERIAL NUMBER ADDRESSES
IBUFF:	DS	TRLEN
OBUFF:	DS	TRLEN
CCPV	EQU	IBUFF+OFFSET
BDOSV	EQU	IBUFF+SLEN+OFFSET
ORIGIN:	DS	1	;BINARY ORIGIN
AORIGIN:DS	5
BSERIAL:DS	2	;BINARY SERIAL NUMBER
TRACK:	DS	1	;SET TO TRACK TO READ/WRITE
BUFFA:	DS	2	;SET TO BUFFER ADDRESS TO READ/WRITE
IOF:	DS	1	;IO FUNCTION 0 = READ, 1 = WRITE
DSKNO:	DS	1
TRSIZE:	DS	2
NSECTS:	DS	1

	DS	32	;STACK
STACK:
	ORG	END
	END