TITLE	'"PASTOCPM" - Convert Pascal file to CP/M file'
;From DR. DOBB'S - August 1979
;Copyright (C) 1979 Ronald G. Parsons
;Modified by T. Mueller 9/1/79
; Changes include:
;	Provisions for designating disk drives.
;	Re-ordering calls to disk routines to be of the form:
;		select disk, select track, select sector, read/write.
;	Cleaned up handling of null codes in .TEXT files.
;	Set up new stack area and data buffers.
;	Changed exit to simple return, no re-boot.
;	Guaranteed .TEXT file on CP/M disk ends in EOF.
;	Memory size independance for BIOS calls.
;9/22/79 - Corrected handling of DLE as last byte of read block.
;
;Transfers a Pascal file to CP/M file.
;
;Syntax -- PASTOCPM <[d:]CP/M filename> <[d:]Pascal filename>
;
;Disk drive (d:) identifiers may be entered.  If none are supplied
; defaults are: CP/M file on logged drive, Pascal file on drive B:.
;
;Transfers the Pascal filename on a Pascal disk
;  to the CP/M filename on a CP/M disk.  If the CP/M file already exists,
;  you will be asked for permission to overwrite.
;If the Pascal file is a .TEXT file, then two blocks are skipped
;  and tabs replaced by spaces.  LF is added after each CR.
;If the Pascal file is a .CODE file, then one block is skipped.
;If file is neither .TEXT or .CODE, the copy is exact.
;
;
DLE	EQU	10H
DENTSZ	EQU	26	;DIRECTORY ENTRY SIZE IN BYTES
DTITLE	EQU	6	;OFFSET TO ENTRY TITLE
;
	ORG	100H
START	LXI	H,0
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK	;SET UP PRIVATE STACK
;
	MVI	C,LOGGED	;GET LOGGED DISK DRIVE
	CALL	BDOS
	STA	LDRIVE
	LDA	FCB		;GET CP/M DRIVE
	ORA	A
	JNZ	DOIT		;NOT LOGGED DRIVE
	LDA	LDRIVE		;GET LOGGED DRIVE
	INR	A
	STA	FCB		;FORCE SELECTION OF DRIVE
DOIT	LXI	H,BUFF		;GET PASCAL FILE NAME
	LXI	D,SYSTLE+1
	MVI	A,1
	STA	RDRIVE		;SET PASCAL DEFAULT TO DRIVE B
SCN1	CALL	SCBLK		;FIND NON-BLANK
	JZ	SCN1
SCN2	CALL	SCBLK		;FIND BLANK
	JNZ	SCN2
SCN3	CALL	SCBLK		;FIND START OF SECOND PARM
	JZ	SCN3
	INX	H
	MOV	A,M
	CPI	':'		;CHECK IF DRIVE ENTERED
	DCX	H
	JNZ	SCN4
	MOV	A,M		;GET DRIVE
	SUI	'A'
	STA	RDRIVE		;SAVE READ DRIVE
	INX	H
	INX	H		;SKIP DRIVE
SCN4	PUSH	H
	LXI	H,RDRIVE
	LDA	FCB
	DCR	A
	CMP	M		;CHECK IF READ AND WRITE DRIVES ARE SAME
	POP	H
	JZ	DRVERR
	MVI	C,0
PFN2	MOV	A,M
	ORA	A
	JZ	PFN3
	STAX	D
	INX	H
	INX	D
	INR	C
	JMP	PFN2
;
PFN3	MOV	A,C		;GET FILENAME LENGTH
	STA	SYSTLE
	ORA	A
	JZ	NOFLNM
;CHECK FOR .TEXT OR .CODE FILENAME
	LXI	D,TEXT+6
	DCX	H		;HL POINTS TO END OF FILENAME
	PUSH	H
	MVI	C,5
TEXTLP	LDAX	D
	CMP	M
	JNZ	NOTEXT		;FILENAME DOES NOT END IN .TEXT
	DCX	H
	DCX	D
	DCR	C
	JNZ	TEXTLP
	LXI	H,TXTFLG	;GOT .TEXT FILE
	MVI	M,2
	LXI	D,TEXT
	MVI	C,WRITECB
	CALL	BDOS
;
NOTEXT	POP	H		;POINT TO END OF FILENAME
	LXI	D,CODE+6
	MVI	C,5
CODELP	LDAX	D
	CMP	M
	JNZ	NOTCODE		;FILENAME DOES NOT END IN .CODE
	DCX	H
	DCX	D
	DCR	C
	JNZ	CODELP
	LXI	H,TXTFLG
	MVI	M,1		;GOT .CODE FILE
	LXI	D,CODE
	MVI	C,WRITECB
	CALL	BDOS
;
NOTCODE	LXI	D,FCB
	MVI	C,OPENF		;OPEN FILE
	CALL	BDOS
	CPI	0FFH		;NON-EXISTANT?
	JZ	CREF		;YES - CREATE IT
	LXI	D,PERMSG	;GET PERMISSION TO DELETE IT
	MVI	C,WRITECB
	CALL	BDOS
;
RDCHR	MVI	C,READC		;READ CONSOLE
	CALL	BDOS
	CPI	ABORT
	JZ	EXIT
	CPI	CR
	JNZ	RDCHR		;INVALID RESPONSE, TRY AGAIN
	MVI	E,LF
	MVI	C,WRITEC	;CHARACTER TO CONSOLE
	CALL	BDOS
	LXI	D,FCB
	MVI	C,DELETEF	;KILL FILE
	CALL	BDOS
;
CREF	LXI	D,FCB
	MVI	C,CREATEF	;CREATE FILE
	CALL	BDOS
	CPI	0FFH		;ERROR?
	JZ	CERROR		;YES
;
;INITIALIXE BUFFER POINTERS
;
INIT	LXI	H,BUFF
	SHLD	BOL
	LXI	H,BUFF+127
	SHLD	EOB
	LXI	H,BLKBUF+512
	SHLD	BUFADD
;
	LXI	B,DIRTOP	;READ DIRECTORY INTO THIS
	CALL	READ$DIR
;
	LXI	H,DIRTOP	;SET DIRECTORY ENTRY POINTER
	LXI	D,DENTSZ	;  TO FIRST ENTRY AFTER VOLUME NAME
	DAD	D
	SHLD	DENTP
;
	CALL	FIND$FILE	;FIND THE FILE
;
	LHLD	DENTP		;START OF DIRECTORY ENTRY
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D		;SAVE FIRST BLOCK
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG			;LAST BLOCK+1 IN HL
	DAD	H		;X2
	DAD	H		;X4
	SHLD	LSTLSN		;(LAST LSN + 1) * 4
	POP	H		;GET FIRST BLOCK
	LDA	TXTFLG
SKPBL1	DCR	A		;SKIP BLOCKS DEPENDING ON
	JM	SKPBL2		;  .TEXT OR .CODE
	INX	H
	JMP	SKPBL1
;
SKPBL2	DAD	H		;X2
	DAD	H		;X4
	SHLD	LSN		;(FIRST LSN) * 4
;
LR80B	CALL	R80B		;READ 128 BYTES
	LDA	EOFFLAG
	ORA	A		;LAST PASCAL SECTOR READ?
	JNZ	FILL1A		;YES
	CALL	WB		;WRITE BUFFER
	JMP	LR80B
;
FILL1A	CALL	CT		;FILL BUFFER WITH EOF
	CALL	WB		;WRITE BUFFER
	LDA	TXTFLG
	CPI	2		;.TEXT?
	JNZ	FILL2		;NO
	LHLD	EOB
	MOV	A,M
	CPI	EOF		;CHECK IF LAST SECTOR WRITTEN HAS EOF
	JZ	FILL2
	LXI	H,BUFF
	SHLD	BOL
	JMP	FILL1A
FILL2	LXI	D,FCB
	MVI	C,CLOSEF	;CLOSE FILE
	CALL	BDOS
EXIT	LXI	D,BUFF
	MVI	C,DMAADD
	CALL	BDOS
	LDA	LDRIVE		;GET LOGGED DRIVE
	MOV	E,A
	MVI	C,SELECTD	;RESTORE LOGGED DRIVE
	CALL	BDOS
	LHLD	STACK
	SPHL			;RESTORE SP
	RET			;JOB DONE - GO BACK
;
;*********************************************************
;
;  SUBROUTINES
;
;*********************************************************
;
;READ DIRECTORY'S 4 BLOCKS TO BUFFER
;BUFFER ADDRESS IS ALREADY IN REG-BC
;
READ$DIR:
	MVI	E,4		;DIRECTORY IS 4 BLOCKS LONG
	LXI	H,2		;  AND STARTS AT BLOCK 2
	CALL	SYSRD		;GET IT
	RET
;
;
FIND$FILE:
	MVI	C,77		;STOP AFTER THE 77'TH ENTRY
	LHLD	DENTP		;GET STARTING ENTRY
FI$SCH$LP:
	LXI	D,DTITLE	;ADVANCE TO TILTE STRING
	DAD	D
	LXI	D,SYSTLE	;SET REG-DE TO COMPARISON STRING
	LDA	SYSTLE		;COMPARISON LENGTH
	INR	A		;COMPARE INCLUDES LENGTH BYTE
	MOV	B,A
FI$CMP$LP:
	LDAX	D
	CMP	M
	JNZ	FI$CONT		;IT'S NOT THIS ONE
	INX	D
	INX	H
	DCR	B		;CHECK FOR END OF STRING
	JNZ	FI$CMP$LP	;NOT YET
	JMP	FI$FOUND	;FOUND IT
;
FI$CONT:
	LHLD	DENTP		;ON TO THE NEXT ENTRY
	LXI	D,DENTSZ
	DAD	D
	SHLD	DENTP
	DCR	C		;IS THERE ANY DIRECTORY LEFT?
	JNZ	FI$SCH$LP	;YES
FI$HANG:
	JMP	NOFILE		;FILE NOT THERE
;
FI$FOUND:
	RET			;GOT IT
;
;
;READ BLOCKS FROM PASCAL DISKETTE
;
SYSRD	PUSH	D		;SAVE BLOCK COUNT
	PUSH	H		;  AND BLOCK NUMBER
	CALL	READ$RX		;BUFFER IS ADVANCED BY 512 BYTES
	POP	H
	POP	D
	INX	H		;ADVANCE TO NEXT BLOCK
	DCR	E		;SEE IF WE'RE DONE
	JNZ	SYSRD
	RET
;
;
;READ A PASCAL BLOCK
;
READ$RX:
	DAD	H		;THERE ARE 4 SECTORS TO A BLOCK
	DAD	H		;MULT LOGICAL BLOCK BY 4
	MVI	E,4
RR$LP	PUSH	B		;SET BUFFER ADDRESS
	PUSH	D
	PUSH	H
	CALL	SETDMA
	POP	H		;NOW COMPUTE TRACK/SECTOR
	PUSH	H
	CALL	MAP		;CONVERTS LOGICAL SECTOR IN HL
	PUSH	H
	LDA	RDRIVE
	MOV	E,A
	MVI	C,SELECTD	;SELECT READ DISK
	CALL	BDOS
	POP	H
	MOV	C,H		;  INTO TRACK H, SECTOR L
	PUSH	H
	CALL	SETTRK
	POP	H
	MOV	C,L
	CALL	SETSEC
	CALL	READ
	ORA	A
	JNZ	RWERR
	POP	H
	POP	D
	POP	B
	PUSH	H		;ADVANCE THE BUFFER ADDRESS
	LXI	H,128
	DAD	B
	MOV	B,H
	MOV	C,L
	POP	H
	INX	H		;ADVANCE THE BLOCK COUNT
	DCR	E		;SEE IF WE CONTINUE
	JNZ	RR$LP		;YES
	RET
;
;
;READ SECTOR GIVEN BY LSN
;
RDSEC	MVI	C,DMAADD
	CALL	BDOS
	LHLD	LSN
	CALL	MAP		;CONVERT LOGICAL SECTOR # TO TRACK/SECTOR
	MOV	C,H
	PUSH	H
	CALL	SETTRK
	POP	H
	MOV	C,L
	CALL	SETSEC
	CALL	READ
	ORA	A
	JNZ	RWERR
	LHLD	LSN
	INX	H
	SHLD	LSN
	RET
;
;CLEAR TO END OF BUFFER
;
CT	LHLD	EOB
	INX	H
	XCHG
	LHLD	BOL
CT1	CALL	EQUAL
	RZ
	MVI	M,EOF
	INX	H
	JMP	CT1
;
EQUAL	MOV	A,L
	CMP	E
	RNZ
	MOV	A,H
	CMP	D
	RET			;ZERO IF DE=HL
;
;READ A SECTOR TO BUFFER
;
R80B	MVI	B,128
	LXI	H,BUFF
R80B1	PUSH	B
	PUSH	H
	CALL	RB
	POP	H
	POP	B
	PUSH	PSW
	LDA	EOFFLAG
	ORA	A
	JZ	R80B2		;NOT EOF
	POP	PSW
	SHLD	BOL
	RET
;
R80B2	POP	PSW
	MOV	M,A
	INX	H
	DCR	B
	JNZ	R80B1
	RET
;
;WRITE 128 BYTE BUFFER
;
WB	LXI	D,BUFF
	MVI	C,DMAADD
	CALL	BDOS
	LXI	D,FCB
	MVI	C,WRITER
	CALL	BDOS
	ORA	A
	JNZ	RWERR
	RET
;
;SCAN FOR BLANKS IN COMMAND LINE
;
SCBLK	INX	H
	MOV	A,M
	CPI	0		;CHECK IF END OF INPUT LINE
	JZ	NOFLNM
	CPI	' '
	RET
;
;PROCESS LF AND TAB FILL, GET BYTE FROM READ BUFFER
;
RB	LDA	TXTFLG
	CPI	2
	JNZ	RBFB		;NOT .TEXT
RCCKLF	LDA	NLF		;NEED LF?
	ORA	A
	JZ	RBCKTB
	XRA	A
	STA	NLF
	MVI	A,LF
	RET
;
RBCKTB	LDA	NTB		;NEED TAB?
	ORA	A
	JZ	RBFB
	DCR	A
	STA	NTB
	MVI	A,' '
	RET
;
;GET BYTE FROM READ BUFFER, AND FILL IF NEEDED
;
RBFB	LHLD	BUFADD
	LXI	D,BLKBUF+512
	CALL	EQUAL		;CHECK FOR END OF BUFFER
	JZ	RBLK
	LDA	TXTFLG
	CPI	2		;.TEXT?
	JNZ	NOTEXT2
	LDA	DFLAG		;WAS LAST CHAR DLE?
	ORA	A
	JNZ	RBFBT		;YES
	MOV	A,M
	ORA	A
	INX	H
	SHLD	BUFADD
	JZ	RBFB		;SKIP BYTE OF ZERO
	CPI	CR
	JNZ	CKDLE
	STA	NLF		;PUT LF AFTER CR
	RET
;PROCESS BYTE FOLLOWING DLE
;
RBFBT	MOV	A,M
	INX	H
	SHLD	BUFADD
	SUI	32		;GET INDENTATION
	STA	NTB		;SAVE NUMBER OF COLUMNS TO INDENT
	XRA	A
	STA	DFLAG		;CLEAR TAB FLAG
	JMP	RBCKTB		;DO BLANK EXPANSION
;
;CHECK FOR DLE CODE - USED FOR INDENTATION
;
CKDLE	CPI	DLE
	RNZ
	STA	DFLAG		;SET FLAG FOR DLE FOUND
	JMP	RBFB		;GET NEXT BYTE (COUNT)
;
NOTEXT2	MOV	A,M
	INX	H
	SHLD	BUFADD
	RET
;
;READ 4 SECTORS (A PASCAL BLOCK)
;
RBLK	LHLD	LSN		;GET START LOGICAL SECTOR NUMBER
	XCHG
	LHLD	LSTLSN
	CALL	EQUAL
	JZ	SETEOF		;FOUND LAST SECTOR
	LDA	RDRIVE		;GET READ DRIVE NUMBER
	MOV	E,A
	MVI	C,SELECTD	;SELECT DISK
	CALL	BDOS
	LXI	D,BLKBUF	;READ 4 SECTORS
	CALL	RDSEC
	LXI	D,BLKBUF+128
	CALL	RDSEC
	LXI	D,BLKBUF+256
	CALL	RDSEC
	LXI	D,BLKBUF+384
	CALL	RDSEC
	LXI	H,BLKBUF
	SHLD	BUFADD		;RESET POINTER TO START OF BUFFER
	JMP	RBFB
;
SETEOF	LXI	H,EOFFLAG
	MVI	M,1		;LAST SECTOR ALREADY READ
	RET
;
;ERROR MESSAGES
;
NOFLNM	LXI	D,NOFLNMSG
	JMP	GENERR
;
NOFILE	LXI	D,NOFMSG
	JMP	GENERR
;
RWERR	ORI	'0'		;MAKE IT ASCII
	STA	WERMSG
	LXI	D,WERMSG
GENERR	MVI	C,WRITECB
	CALL	BDOS
	JMP	EXIT
;
CERROR	LXI	D,ERRMSG
	ORI	'0'
	STA	ERRMSG
	JMP	GENERR
;
DRVERR	LXI	D,DERMSG
	JMP	GENERR
;
;TURN LSN INTO TRACK/SECTOR
;
;NOTE - TRACK 0 IS NOT USED, SO BLOCK 0 IS AT TRACK 1 SECTOR 1
;
;ON ENTRY - REG-HL HAS LOGICAL BLOCK # * 4 = LOGICAL SECTOR #
;ON EXIT - REG-H HAS PHYSICAL TRACK
;	   REG-L HAS PHYSICAL SECTOR
;
MAP	PUSH	B
	PUSH	D
	CALL	DIV26
	MOV	A,L
	ADD	A
	MOV	B,A
	MVI	A,12
	CMP	L
	JNC	MAPC
	INR	B
MAPC	MOV	C,E
	XRA	A
	MOV	D,A
	MOV	H,A
	MOV	L,B
	MVI	A,6
MAP$LOOP:
	DAD	D
	DCR	A
	JNZ	MAP$LOOP
	PUSH	B
	CALL	DIV26
	POP	B
	INR	L
	MOV	H,C
	INR	H
	POP	D
	POP	B
	RET
;
;
DIV26	LXI	B,-26
	MVI	E,0FFH
DIVL	INR	E
	DAD	B
	MOV	A,H
	ORA	A
	JP	DIVL
	LXI	B,26
	DAD	B
	RET
;
;
;
;BIOS ENTRIES
;
SETTRK	LHLD	1
	MVI	L,1EH
	PCHL
;
SETSEC	LHLD	1
	MVI	L,21H
	PCHL
;
SETDMA	LHLD	1
	MVI	L,24H
	PCHL
;
READ	LHLD	1
	MVI	L,27H
	PCHL
;
NOFLNMSG	DB	CR,LF,'ERROR - Missing file name$'
NOFMSG		DB	CR,LF,'"Pascal" file does not exist$'
WERMSG		DB	'  Read/Write ERROR$'
PERMSG		DB	CR,LF,'"CP/M" file already exists.'
		DB	CR,LF,'C/R to continue, CTRL-C to abort$'
ERRMSG		DB	'  ERROR in file Create or Open$'
TEXT		DB	CR,LF,'.TEXT file being processed$'
CODE		DB	CR,LF,'.CODE file being processed$'
DERMSG		DB	CR,LF,'ERROR - Both files on same drive$'
;
;
TXTFLG	DB	0
DENTP	DS	2
EOFFLAG	DB	0
NLF	DB	0
NTB	DB	0
DFLAG	DB	0
BUFADD	DS	2
LSN	DS	2
LSTLSN	DS	2
BOL	DS	2
EOB	DS	2
SYSTLE	DS	22
RDRIVE	DS	1		;DRIVE FOR READ
LDRIVE	DS	1		;LOGGED DRIVE ON ENTRY
;
	DS	64		;STACK AREA
STACK	DS	2		;ENTRY SP
BLKBUF	DS	512
DIRTOP	DS	2048
;
;
;CP/M EQUATES
;
BDOS	EQU	5
FCB	EQU	5CH
BUFF	EQU	80H
READC	EQU	1		;READ CONSOLE CHARACTER
WRITEC	EQU	2		;WRITE CONSOLE CHARACTER
WRITECB	EQU	9		;WRITE CONSOLE BUFFER
SELECTD	EQU	14		;SELECT DRIVE
OPENF	EQU	15		;OPEN FILE
CLOSEF	EQU	16		;CLOSE FILE
DELETEF	EQU	19		;DELETE FILE
WRITER	EQU	21		;WRITE RECORD
CREATEF	EQU	22		;CREATE FILE
LOGGED	EQU	25		;GET LOGGED DRIVE
DMAADD	EQU	26		;SET DMA ADDRESS
;
CR	EQU	0DH
LF	EQU	0AH
ABORT	EQU	3		;CRTL-C
EOF	EQU	1AH
;
	END	START