*THIS PROGRAM TRANSFERS A FILE FROM A DEC FORMAT DISK TO A
* CP/M FORMAT DISK
*
*
*CP/M DEFINITIONS FOR PRIMITIVES
*
RDCON	EQU	1	;GET CHAR FROM CONSOLE
WRTCON	EQU	2	;TYPE CHAR ON CONSOLE
RDRDR	EQU	3	;GETCHAR FROM PAPER TAPE READER
WRTPCH	EQU	4	;SEND CHAR TO PUNCH
WRTLST	EQU	5	;SEND CHAR TO LIST DEVICE
IOSTAT	EQU	7	;INTERROGATE I/O STATUS (NOT USED HERE)
ALTIO	EQU	8	;ALTER I/O STATUS (NOT USED HERE)
PCONBF	EQU	9	;PRINT CONSOLE BUFFER
RCONBF	EQU	10	;READ CONSOLE BUFFER
CONST	EQU	11	;CHECK CONSOLE STATUS (BIT0 SET IF READY)
LIFTHD	EQU	12	;LIFT DISK HEAD (NOT USED HERE)
RSTDSK	EQU	13	;DMA ADDR TO 80H,SELECT DISK A
SELDSK	EQU	14	;SELECT DISK
OPENF	EQU	15	;OPEN FILE
CLOSEF	EQU	16	;CLOSE FILE
SRCH1	EQU	17	;SEARCH FOR FIRST FILE OCCURRENCE
SCHNXT	EQU	18	;SEARCH FOR NEXT FILE OCCURRENCE
DELETF	EQU	19	;DELETE FILE
READF	EQU	20	;READ TO BUFFER
WRITEF	EQU	21	;WRITE TO BUFFER
MAKEF	EQU	22	;CREATE A FILE ENTRY
RENAMF	EQU	23	;RENAME A FILE
INTLOG	EQU	24	;INTERROGATE LOGIN VECTOR
INTDSK	EQU	25	;INTERROGATE DISK (RETURNS SELECTED DISK #)
SETDMA	EQU	26	;SET DMA ADDR
INTALL	EQU	27	;INTERROGATE ALLOCATION VECTOR
*
BDOS	EQU	0005H	;DOS ENTRY POINT
FCB	EQU	5CH	;DEFAULT FILE CONTROL BLOCK ADDRESS
BUFF	EQU	80H	;DEFAULT DMA ADDRESS
*
	ORG	0100H
*
*SET UP STACK
	LXI	H,0
	DAD	SP
	SHLD	OLDSP
	LXI	SP,STKTOP
	JMP	MAIN
*
*STACK AREA
OLDSP:	DS	2
STACK:	DS	64
STKTOP	EQU	$
*
*
*SUBROUTINES
PCHAR:	;PRINT CHAR IN REG A
	PUSH H!	PUSH D!	PUSH B	;ENVIRONMENT SAVED
	MVI	C,WRTCON
	MOV	E,A
	CALL	BDOS
	POP B!	POP D!	POP H	;ENVIRONMENT RESTORED
	RET
*
CRLF:	;PRINT A CARRIAGE RETURN & LINE FEED
	MVI	A,0DH
	CALL	PCHAR
	MVI	A,0AH
	CALL	PCHAR
	RET
*
PNIB:	;PRINT NIBBLE IN REG A
	ANI	0FH	;LOWER 4 BITS
	CPI	10
	JNC	P10
	;LESS THAN OR EQUAL TO 9
	ADI	'0'
	JMP	PRN
	;GREATER THAN OR EQUAL TO 10
P10:	ADI	'A'-10
PRN:	CALL	PCHAR
	RET
*
PHEX:	;PRINT HEX CHAR IN REG A
	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	CALL	PNIB	;PRINT NIBBLE
	POP	PSW
	CALL	PNIB
	RET
*
CHIN:	;GET A CHAR FROM CONSOLE 
	PUSH H!	PUSH D!	PUSH B
	MVI	C,RDCON
	CALL	BDOS
	POP B!	POP D!	POP H
	RET
*
MSG:	;PRINT A MESSAGE POINTED TO BY HL (END OF MESSAGE=0FFH)
	MOV	A,M
	CPI	0FFH
	RZ		;RETURN IF END OF MESSAGE
	CALL	PCHAR
	INX	H
	JMP	MSG
*
SETTRK:	;SET TRACK IN C
	LHLD	1
	LXI	D,27
	DAD	D
	PCHL
*
SETSEC:	LHLD	1
	LXI	D,30
	DAD	D
	PCHL
*
RDSEC:	LHLD	1
	LXI	D,36
	DAD	D
	PCHL
*
DISKRD:	;READ FROM DISK B-TRACK IN "TRACK",SECTOR IN "SECTOR"
	PUSH	B	;SAVE LOGICAL TRACK & SECTOR
	LDA	TRACK
	STA	BTRACK
	LDA	SECTOR
	STA	BSECT
	LDA	INTLEV	;GET INTERLEAVE FLAG
	ORA	A
	JZ	CONSEC	;0 > CONSECUTIVE SECTORS
*
*INTERLEAVE ALGORITHM FOR STANDARD DEC DISKS
*
	PUSH	D	;SAVE DMA ADDR
	MVI	H,0
	LDA	BTRACK
	MOV	L,A
	DCX	H	;HL=TRACK-1;NOW MULTIPLY BY 6
	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	SHLD	X2	;HL*2
INTLV3:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	XCHG
	LHLD	X2
	DAD	D	;HL*6 IN HL
* 6*(TRACK-1) IN HL
*
INTLV0:	MOV	A,H
	ORA	A
	JNZ	INTLV5
	MOV	A,L
	CPI	26
	JM	INTLV4
INTLV5:	LXI	D,0-26
	DAD	D
	JMP	INTLV0
INTLV4:	LDA	BSECT
	DCR	A	;SHIFT SECTOR DOWN (0-25)
	PUSH	PSW
	ADD	A
	MOV	E,A	;SAVE S2
	POP	PSW
	CPI	13
	MOV	A,E	;GET S2 BACK TO ACC.
	JM	INTLV2
	INR	A
INTLV2:	ADD	L	;ADD BIAS
INTLV1:	SUI	26
	JP	INTLV1
	ADI	27
	STA	BSECT	;NEW PHYSICAL SECTOR TO BSECT
	POP	D	;RESTORE DMA ADDR
CONSEC:	LDA	BSECT
	MOV	C,A
	CALL	SETSEC
	LDA	BTRACK
	MOV	C,A
	CALL	SETTRK
	CALL	RDSEC
	POP	B
	RET
*
GETDIR:	;GET DIRECTORY SEGMENT 1 INTO THE DIRECTORY BUFFER
	; ASSUME FILE WILL BE IN SEGMENT 1
	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS	;SEL DISK B
	MVI	A,2
	STA	COUNT
	LXI	D,0
	MVI	A,01H
	STA	TRACK
	MVI	A,19H
	STA	SECTOR
	LXI	H,DRBUFF
	SHLD	BUFFPT	;INIT. BUFFPT
GTDIR1:	LHLD	BUFFPT
	DAD	D
	SHLD	BUFFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	DISKRD	;READ SECTOR FROM DISK
	LXI	D,128
	MVI	A,1AH
	STA	SECTOR
	LDA	COUNT
	DCR	A
	STA	COUNT
	JNZ	GTDIR1	;READ IN FIRST 2 SECTORS
	MVI	A,6
	STA	COUNT
	MVI	A,02
	STA	TRACK
	DCR	A
	STA	SECTOR
GTDIR2:	LXI	D,128	;LENGTH OF A SECTOR
	LHLD	BUFFPT
	DAD	D
	SHLD	BUFFPT
	XCHG		;DMA ADDR > DE
	MVI	C,SETDMA
	CALL	BDOS
	CALL	DISKRD
	LDA	SECTOR
	INR	A
	STA	SECTOR
	LDA	COUNT
	DCR	A
	STA	COUNT
	JNZ	GTDIR2
	RET
*
X50:	;MULTIPLY HL BY 50Q & RETURN IN HL
	PUSH	B
	PUSH	D
	MVI	B,3
X50A:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	X50A
	SHLD	X8
	MVI	B,2
X50B:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	X50B
	XCHG
	LHLD	X8
	DAD	D
	POP	D
	POP	B
	RET
REGMOD:	;MODIFY DRIVE B REGISTERS AFTER SECTOR READ
	LDA	SECTOR
	CPI	26
	JZ	RM1
	INR	A
	STA	SECTOR
	RET
RM1:	MVI	A,1
	STA	SECTOR
	LDA	TRACK
	INR	A
	STA	TRACK
	RET
*
CMP16:	;COMPARES HL & DE & SETS USUAL FLAGS
	MOV	A,H
	CMP	D
	RNZ
	MOV	A,L
	CMP	E
	RET
*
NEGDE:	;NEGATE DE REGISTER (2'S COMP)
	PUSH	PSW
	MOV	A,D
	CMA
	MOV	D,A
	MOV	A,E
	CMA
	MOV	E,A
	INX	D
	POP	PSW
	RET
*
DCR16:	;DECREMENT HL BY 1 & SET FLAG C IF RESULT >= 0
	; NC IF RESULT < 0
	PUSH	D
	LXI	D,0FFFFH	;-1
	DAD	D
	POP	D
	RET
*
*
*
FINIS:	CALL	CRLF
	LHLD	OLDSP
	SPHL
	RET
*
SPACE:	;PRINTS A SPACE ON CRT
	PUSH	PSW
	MVI	A,20H
	CALL	PCHAR
	POP	PSW
	RET
*
R50ASC:	;CONVERTS A BASIC RADIX 50 CHAR TO ASCII
	CPI	0
	JNZ	RASC1
	MVI	A,20H
	RET
RASC1:	CPI	1BH
	JP	RASC2
	ADI	40H
	RET
RASC2:	CPI	1BH
	JNZ	RASC3
	MVI	A,24H
	RET
RASC3:	CPI	1CH
	JNZ	RASC4
	MVI	A,2EH
	RET
RASC4:	ADI	12H
	RET
*
RAD50:	;DECODES RADIX 50 WORD TO 3 ASCII CHARS & PRINTS THEM
	SHLD	R50
	LXI	D,0-1600
	MVI	C,0
RAD1:	DAD	D
	JNC	RAD2
	INR	C
	JMP	RAD1
RAD2:	MOV	A,C
	STA	CHAR1
	MOV	L,A
	MVI	H,0
	CALL	X50
	CALL	X50
	XCHG
	CALL	NEGDE
	LHLD	R50
	DAD	D
	SHLD	R50
	LXI	D,0-40
	MVI	C,0
RAD3:	DAD	D
	JNC	RAD4
	INR	C
	JMP	RAD3
RAD4:	MOV	A,C
	STA	CHAR2
	MOV	L,A
	MVI	H,0
	CALL	X50
	XCHG
	CALL	NEGDE
	LHLD	R50
	DAD	D
	MOV	A,L
	STA	CHAR3
	LDA	CHAR1
	CALL	R50ASC
	CALL	PCHAR
	LDA	CHAR2
	CALL	R50ASC
	CALL	PCHAR
	LDA	CHAR3
	CALL	R50ASC
	CALL	PCHAR
	RET
*
LDECWD:	;PRINTS DECIMAL EQUIV. OF HL
	PUSH B!	PUSH PSW!	PUSH H!	PUSH D!
	XRA	A
	STA	BLANK0
	MVI	B,30H
	LXI	D,10000
	CALL	LDEC0
	LXI	D,1000
	CALL	LDEC0
LDECB1:	LXI	D,100
	CALL	LDEC0
	MVI	E,10
	CALL	LDEC0
	MVI	E,1
	CALL	LDEC0
	POP D!	POP H!	POP PSW!	POP B
	RET
*
LDEC0:	MVI	C,30H
LDEC1:	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	JC	LDEC2
	INR	C
	JMP	LDEC1
LDEC2:	DAD	D
	MOV	A,C
	CPI	30H
	JNZ	LDEC3
	MOV	A,B
	JMP	CO
LDEC3:	MVI	B,30H
	JMP	CO
CO:	CPI	30H
	JNZ	CO1
	PUSH	PSW
	LDA	BLANK0
	RAR
	JNC	CO2
	POP	PSW
	JMP	PCHAR
CO2:	POP	PSW
	MVI	A,20H
	JMP	PCHAR
CO1:	PUSH	PSW
	MVI	A,1
	STA	BLANK0
	POP	PSW
	JMP	PCHAR
*
*
*
*
*
MAIN:	;MAIN BODY OF PROGRAM-LISTS DEC DIRECTORY
	CALL	CRLF
*
DECINT:	LXI	H,M0	;IS DEC DISK INTERLEAVED?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	NO1
	MVI	A,1
	STA	INTLEV	;SET INTERLEAVE FLAG
	JMP	REDY
NO1:	CPI	'N'
	JNZ	DECINT
	XRA	A
	STA	INTLEV
	CALL	CRLF
*
REDY:	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS	;SEL DISK B
	CALL	GETDIR	;GET DIRECTORY INTO DRBUFF
	LHLD	ENTRYS
	SHLD	ENTNUM
	LXI	H,ENTRYS
	SHLD	DRBFPT
*
DRLOOP:	LHLD	ENTNUM
	MVI	A,2
	CMP	H
	JZ	EMPTFL	;THIS ENTRY AN EMPTY FILE
	MVI	A,4
	CMP	H
	JZ	PERMFL	;THIS ENTRY IS A PERMANENT FILE
	MVI	A,8
	CMP	H
	JZ	FINIS	;END OF DIRECTORY
	LXI	H,M2	;ILLEGAL STATUS WORD
	CALL	MSG
	JMP	DECINT
*
EMPTFL:	CALL	CRLF
	LXI	H,M3	;< UNUSED >
	CALL	MSG
	LHLD	DRBFPT
	LXI	D,8
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M	;FILE LENGTH IN DE
	XCHG
	CALL	SPACE
	CALL	SPACE
	CALL	LDECWD
	XCHG
	LXI	D,5
	DAD	D	;IGNORE REST OF ENTRY INFO
	SHLD	DRBFPT
	MOV	A,M
	STA	ENTNUM
	INX	H
	MOV	A,M
	STA	ENTNUM+1
	JMP	DRLOOP	;DO NEXT ENTRY
*
PERMFL:	CALL	CRLF
	LHLD	DRBFPT
	INX	H
	INX	H
	MOV	A,M
	STA	FILELO	;GET FILNAM.EXT FOR LISTING
	INX	H
	MOV	A,M
	STA	FILEHI
	INX	H
	MOV	A,M
	STA	NAMELO
	INX	H
	MOV	A,M
	STA	NAMEHI
	INX	H
	MOV	A,M
	STA	EXTLO
	INX	H
	MOV	A,M
	STA	EXTHI	;FILNAM.EXT STORED
	PUSH	H
	LHLD	FILELO
	CALL	RAD50	;PRINT OUT FIL
	LHLD	NAMELO
	CALL	RAD50	;PRINT OUT NAM
	MVI	A,'.'
	CALL	PCHAR	;PRINT OUT '.'
	LHLD	EXTLO
	CALL	RAD50	;PRINT OUT EXT
	CALL	SPACE
	CALL	SPACE
	POP	H	;RESTORE BUFFER POINTER
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M	;FILE LENGTH IN DE
	XCHG
	CALL	LDECWD	;PRINT LENGTH IN DECIMAL
	XCHG
	LXI	D,5
	DAD	D	;IGNORE REST OF ENTRY INFO.
	SHLD	DRBFPT
	MOV	A,M
	STA	ENTNUM
	INX	H
	MOV	A,M
	STA	ENTNUM+1	;SET UP FOR NEXT ENTRY
	JMP	DRLOOP	; & GO TO IT
*
*
*VARIABLES
ENTNUM:	DS	2	;ENTRY POINTER
BUFFPT:	DS	2	;XFER BUFFER POINTER
INTLEV:	DS	1	;INTERLEAVE FLAG
BLANK0:	DS	1	;SUPRESS LEADING 0 FLAG
CHAR1:	DS	1	;1ST RAD50 CHAR
CHAR2:	DS	1	;2ND "
CHAR3:	DS	1	;3RD "
R50:	DS	2	;TEMP RADIX 50 STORAGE
X2:	DS	2	;HL*2
BSECT:	DS	1
COUNT2:	DS	1	;SECOND UTILITY COUNTER
R50NUM:	DS	2	;RADIX 50 CONVERSION OF 3 ASCII CHARS
X8:	DS	2	;HL*8
FILELO:	DS	1	;PERMANENT FILE NAME & EXT. STORAGE
FILEHI:	DS	1
NAMELO	DS	1
NAMEHI	DS	1
EXTLO	DS	1
EXTHI	DS	1	;END OF PERM. NAME STORAGE
ENTRY:	DS	2	;ENTRY STATUS WORD POINTER
BLKCNT:	DS	2	;BLOCK COUNT (UPDATED EVERY ENTRY)
BLOCKS:	DS	2	;# OF BLOCKS TO FILE (VALID ONLY IF FOUND)
LENGTH:	DS	2	;LENGTH OF FILE FOUND (IN BLOCKS)
TRACK:	DS	1	;TRACK OF FOUND FILE
SECTOR:	DS	1	;SECTOR OF FOUND FILE
FILE:	DS	2	;FILE NAME
NAME:	DS	2	; & EXT. OF
EXT:	DS	2	;  REQUESTED FILE (DEC)
FLNMPT:	DS	2	;FILE NAME POINTER
FLBFPT:	DS	2	;PERM. FILE NAME POINTER
BTRACK:	DS	1	;PHYSICAL TRACK
COUNT:	DS	1	;UTILITY COUNTER LOCATION
DRBFPT:	DS	2	;DIRECTORY BUFFER POINTER
DRBUFF:			;DIRECTORY BUFFER
HDWD1:	DS	2	;SEGMENTS AVAILABLE
HDWD2:	DS	2	;NEXT SEGMENT
HDWD3:	DS	2	;HIGHEST OPEN SEGMENT
HDWD4:	DS	2	;EXTRA WORDS/ENTRY
HDWD5:	DS	2	;FILE STARTING BLOCK
ENTRYS:	DS	1014	;ENTRIES
ENDBUF:	DS	1
*
*
*MESSAGES
*
M0:	DB	0DH,0AH,'IS DEC DISK INTERLEAVED (Y/N)?',0FFH
M2:	DB	0DH,0AH,'ILLEGAL STATUS WORD ENCOUNTERED',0FFH
M3:	DB	'< UNUSED >',0FFH
*
*
PAD:	DS	4
*
PRGEND	EQU	$
*
*
*
	END