; Copyright (C) 1979 Ronald G. Parsons
; Modified by Robert Bedichek  1-13-81
;
; Transfers a Pascal file to a CP/M file.
;
; Syntax PASTOCPM    <CP/M filename>   <Pascal filename>
;
; Transferrs the Pascal filename on a Pascal disk in B
;    to the CP/M filename.  If the CP/M file already exists,
;    you will be asked for permission to overwrite.
; If Pascal file is a .TEXT file, then two blocks are skipped
;    and indents replaced by spaces.  LFs are added after CR.
; If Pascal file is a .CODE file, then one block is skipped.
; If neither .CODE or .TEXT, copy is exact.
;
; Pascal disk in B; CP/M disk in A.
;
DLE	EQU	10H
CBOOT	EQU	0		;LOCATION OF CP/M BOOT VECTOR
DENTSZ	EQU	1AH		;DIR ENTRY SIZE IN BYTES
DTITLE	EQU	06H		;OFFSET TO ENTRY TITLE
BLKBUF	EQU	1000H		;TOP OF BLOCK BUFFER
DIRTOP	EQU	2000H		;TOP OF TEMP RAM DISK DIRECTORY
;
	ORG	100H
	LXI	D,COPYRIGHT
	MVI	C,9	;print buffer
	CALL	BDOS
	JMP	START
COPYRIGHT DB	'Copyright (C) 1979 Ronald G. Parsons$'
START:
	LHLD	6		; HL point to one past last byte in TPA.
	SPHL

; Mod by RCB - Branch table at the end of this program links
; to branch table at the beginning of CP/M's BIOS.

	lded	1		; Base address of the jump table.
	mvi	c,14		; Number of jumps.
	LXI	H,JMPTAB	; Start of jump table in this program
; Now run through the internal jump table inserting the right values.
SETUPL	MVI	M,0C3H		; Opcode for jump
	INX	H

	MOV	M,e		; Lower byte of address.
	INX	H

	MOV	M,d		; Store high byte.
	INX	H

	inx	d
	inx	d
	inx	d

	DCR	C
	JNZ	SETUPL

	LXI	H,BUFF+1	;get Pascal file name
	LXI	D,SYSTLE+1
	MVI	C,0
	CALL	SCBK		;get second parameter
	CALL	SCBKCH
PFN2	MOV	A,M
	CPI	0
	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	;got .CODE file
	MVI	M,1
	LXI	D,CODE
	MVI	C,WRITECB
	CALL	BDOS
NOTCODE
	LXI	D,FCB		;OPEN	FILE
	MVI	C,OPENF
	CALL	BDOS
	CPI	ERNXF		;NON-EXISTENT FILE?
	JZ	CREF		;YES - CREATE IT
	LXI	D,PERMSG	;get permission to delete file
	MVI	C,WRITECB
	CALL	BDOS
RDCHR	EQU	$
	MVI	C,READC
	CALL	BDOS		;READ CONSOLE
	CPI	MODE
	JZ	CBOOT		;ABORT
	CPI	CR
	JNZ	RDCHR
	LXI	D,FCB
	MVI	C,DELETEF	;KILL	FILE
	CALL	BDOS
;
CREF	EQU	$
	LXI	D,FCB
	MVI	C,CREATEF	;CREATE FILE
	CALL	BDOS
	CPI	ERNDR		;create error?
	JZ	CERROR
;
INIT	LXI	H,BUFF
	SHLD	BOL
	LXI	H,BUFF+127
	SHLD	EOB
	LXI	H,BLKBUF+512
	SHLD	BUFADD
;
	LXI	B,DIRTOP	;READ THE DIRECTORY INTO DIRTOP
	CALL	READ$DIR
;
	LXI	H,DIRTOP	;SET THE DIRECTORY ENTRY POINTER
	LXI	D,DENTSZ	;  TO FIRST ENTRY AFTER THE VOLUME NAME
	DAD	D
	SHLD	DENTP
;
	CALL	FIND$FILE	;THEN FIND THE FILE
;
	LHLD	DENTP		;start of directory
	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
	DAD	H
	SHLD	LSTLSN		;last LSN + 1
	POP	H
	LDA	TXTFLG
SKPBL1	DCR	A		;skip TXTFLG blocks
	JM	SKPBL2		;  depending on .TEXT or .CODE
	INX	H
	JMP	SKPBL1
SKPBL2
	DAD	H
	DAD	H
	SHLD	LSN		;first LSN
;
LR80B	CALL	R80B		;read 80 bytes
	LDA	EOFFLAG
	ORA	A		;eof?
	JNZ	FILL1A
	CALL	WB		;write buffer
	JMP	LR80B
;
FILL1A	LDA	TXTFLG
	CPI	2		;.TEXT?
	JNZ	FILL2
	CALL	CT		;fill buffer with 1AH
	CALL	WB		;write buffer
FILL2	LXI	D,FCB
	MVI	C,CLOSEF
	CALL	BDOS		;close file
	JMP	CBOOT		;boot
;
;*******************************************************
;
;   SUBROUTINES
;
;*******************************************************
;
READ$DIR			;READ DIRECTORY'S 4 BLOCKS TO BUFFER
				;BUFFER ADDRESS IS ALREADY IN BC-REG
	MVI	E,4		;DIR 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 TITLE STRING
	DAD	D
	LXI	D,SYSTLE	;SET DE-REG TO COMPARISON STRING
	LDA	SYSTLE		;comparison length
	INR	A
	MOV	B,A
FI$CMP$LP			;START COMPARING
	LDAX	D
	CMP	M
	JNZ	FI$CONT 	;IT'S NOT THIS ONE
	INX	D
	INX	H
	DCR	B		;IS THIS THE END OF THE STRING
	JNZ	FI$CMP$LP
	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 DIR LEFT?
	JNZ	FI$SCH$LP
FI$HANG 			;FILE NOT THERE
	JMP	NOFILE

FI$FOUND			;GOT IT
	RET
;
;
SYSRD				;READ BLOCKS FROM PASCAL DISKETTE
	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
	JNZ	SYSRD		;SEE IF WE'RE DONE
	RET
;
;
READ$RX 			;READ A PASCAL BLOCK
	DAD	H		;THERE ARE 4 SECTORS TO A BLOCK
	DAD	H		;MULT LOGICAL BLOCK BY 4
	MVI	E,4
RR$LP				;THIS GETS CONFUSING
	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
	MOV	C,H		;INTO TRACK, H, SECTOR, L
	PUSH	H
	CALL	SETTRK
	POP	H
	MOV	C,L
	CALL	SETSEC
	MVI	C,1
	CALL	SELDSK
	CALL	READ		;AND READ THE DATA
	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 BLOCK COUNT
	DCR	E		;THEN SEE IF WE CONTINUE
	JNZ	RR$LP
	RET			;LEAVE, WHEN DONE
;
;
RDSEC	EQU	$		;READ SECTOR GIVEN BY LSN
	MVI	C,DMAADD
	CALL	BDOS
	LHLD	LSN
	CALL	MAP
	MOV	C,L
	CALL	SETSEC
	MOV	C,H
	CALL	SETTRK
	CALL	READ
	ORA	A
	JNZ	RWERR
	LHLD	LSN
	INX	H
	SHLD	LSN
	RET
;
CT	LHLD	EOB		;clear to end of buffer
	INX	H
	XCHG
	LHLD	BOL
CT1	CALL	EQUAL
	RZ
	MVI	M,CTRLZ
	INX	H
	JMP	CT1
;
EQUAL	MOV	A,L		;returns zero if (DE) = (HL)
	CMP	E
	RNZ
	MOV	A,H
	CMP	D
	RET
;
COMPR	MOV	A,E		;CY set if (DE) less than (HL)
	SUB	L
	MOV	A,D
	SBB	H
	RET
;
R80B	MVI	B,80H		;read 80H bytes to buffer
	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
;
WB	MVI	C,0		;write 80H byte buffer
	CALL	SELDSK
	LXI	D,BUFF
	MVI	C,DMAADD
	CALL	BDOS
	LXI	D,FCB
	MVI	C,WRITER
	CALL	BDOS
	ORA	A
	JNZ	RWERR
	RET
;
;
SCBKCH	MOV	A,M		;scan to char after first blank
	CPI	' '
	JZ	SCBK
	INX	H
	JMP	SCBKCH
SCBK	MOV	A,M		;scan to first non-blank
	CPI	' '
	RNZ
	INX	H
	RET
;
; This has be rewritten by J. Warner, UC Santa Cruz.
; The GETBYT routine is a new single place to get
; characters from the Pascal read buffer.
;
RB	EQU	$		;read byte
	LDA	TXTFLG
	CPI	2		;.TEXT?
	JNZ	NOT$TXT
RBCKLF	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
RBFB	CALL	GETBYT	;read byte from buffer
	ORA	A	;bypass 0's at end of 1024 byte page
	JZ	RBFB
	CPI	CR
	JNZ	CKDLE
	STA	NLF	;Need Line Feed
	RET
;
CKDLE	CPI	DLE
	RNZ
	CALL	GETBYT	;get the space code
	SUI	32		;set indentation
	STA	NTB
	JMP	RBCKTB
;
NOT$TXT CALL	GETBYT
	RET
;
; Get the next character from the Pascal file.
; Read disk if necessary.
;
GETBYT	EQU	$
	LHLD	BUFADD
	LXI	D,BLKBUF+512
	CALL	EQUAL
	CZ	RBLK	;return with HL --> BLKBUF
	MOV	A,M
	INX	H
	SHLD	BUFADD
	RET
;
;
RBLK	EQU	$		;read LSN block
	LHLD	LSN
	XCHG
	LHLD	LSTLSN
	CALL	EQUAL
	JZ	SETEOF		;found last sector
	MVI	C,1		;select B disk
	CALL	SELDSK
	LXI	D,BLKBUF	;read four sectors
	CALL	RDSEC
	LXI	D,BLKBUF+80H
	CALL	RDSEC
	LXI	D,BLKBUF+100H
	CALL	RDSEC
	LXI	D,BLKBUF+180H
	CALL	RDSEC
	LXI	H,BLKBUF
	SHLD	BUFADD
	RET
;
SETEOF	LXI	H,EOFFLAG
	MVI	M,1
	RET
;
; Error messages
NOFLNM	LXI	D,NOFNMSG
	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	CBOOT
;
CERROR	LXI	D,ERRMSG
	ORI	'0'
	STA	ERRMSG
	JMP	GENERR
;
MAP				;TURN LSN INTO IBM TRACK-SECTOR
;
;	NOTE	TRACK 00 IS NOT USED SO BLOCK 0
;		IS AT TRACK 01 SECTOR 1
;
;	ON ENTRY	HL-REG HAS LOGICAL SECTOR NO.
;	ON EXIT H-REG HAS PHYSICAL TRACK
;			L-REG HAS PHYSICAL SECTOR
;
;
	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
;
;
;
NOFNMSG DB	CR,LF,'MISSING FILE NAME$'
NOFMSG		DB	CR,LF,'FILE DOES NOT EXIST$'
WERMSG		DB	'  READ/WRITE ERROR$'
PERMSG		DB	CR,LF,'FILE ALREADY EXISTS. '
PMSG1		DB	CR,LF,'C/R TO CONTINUE. CTRL-@ TO ABORT$'
ERRMSG		DB	'  ERROR IN CREATE OR OPEN$'
TEXT		DB	CR,LF,'.TEXT file being processed$'
CODE		DB	CR,LF,'.CODE file being processed$'
;
;
TXTFLG		DB	0
DENTP		DW	0
EOFFLAG 	DB	0
NLF		DB	0
NTB		DB	0
BUFADD		DW	0
LSN		DW	0
LSTLSN		DW	0
BOL		DW	0
EOB		DW	0
SYSTLE		DS	22


; Jump table that points to BIOS jump table
JMPTAB

WBOOT	DS	3
CONST	DS	3
CONIN	DS	3
CONOUT	DS	3
LIST	DS	3
PUNCH	DS	3
READER	DS	3
HOME	DS	3
SELDSK	DS	3
SETTRK	DS	3
SETSEC	DS	3
SETDMA	DS	3
READ	DS	3
WRITE	DS	3

BDOS	EQU	5
FCB	EQU	5CH
BUFF	EQU	80H

SYSRST	EQU	0	;SYSTEM RESET
READC	EQU	1	;READ	CONSOLE
READRD	EQU	3	;READ READER
WRITEP	EQU	4	;WRITE PUNCH
WRITEL	EQU	5	;WRITE LIST

IOSTAT	EQU	7	;INTERROGATE I/O STATUS
ALTIOS	EQU	8	;ALTER I/O STATUS
WRITECB EQU	9	;WRITE CONSOLE BUFFER
READCB	EQU	10	;READ CONSOLE BUFFER
CONSTAT EQU	11	;CHECK CONSOLE STATUS
LIFTDH	EQU	12	;LIFT DISK HEAD
RSTDS	EQU	13	;RESET DISK SYSTEM
SELECTD EQU	14	;SELECT DISK
OPENF	EQU	15	;OPEN FILE
CLOSEF	EQU	16	;CLOSE FILE
SEARCHF EQU	17	;SEARCH FIRST
DELETEF EQU	19	;DELETE FILE
READR	EQU	20	;READ RECORD
WRITER	EQU	21	;WRITE RECORD
CREATEF EQU	22	;CREATE FILE
RENAMEF EQU	23	;RENAME FILE
LOGINV	EQU	24	;GET LOGIN VECTOR
LOGGED	EQU	25	;GET LOGGED DISK
DMAADD	EQU	26	;SET DMA ADDRESS
ALLOCV	EQU	27	;GET ALLOCATION VECTOR

ERNXF	EQU	255	;NON-EXISTANT FILE
EREOF	EQU	1	;END OF FILE RETURN CODE
ERURA	EQU	2	;READ UNWRITTEN DATA
EREXT	EQU	1	;ERROR IN EXTENDING FILE
EREOD	EQU	2	;END OF DISK DATA
ERNDR	EQU	255	;NO MORE DIRECTORY SPACE

CR	EQU	13
LF	EQU	10
ESC	EQU	1BH
MODE	EQU	0
CTRLZ	EQU	1AH
