;***********************************************
;
;	P A S 2 C P M . A S M
; PROGRAM TO BRING A PASCAL FILE OVER FROM A PASCAL DISK
; TO A CP/M DISK.  CP/M=A:  PASCAL=B:
;
; PAS2CPM ,<CP/M FILENAME> <PASCAL FILENAME>
;
;
;  WRITTEN BY RON PARSONS
;
;	REF. DDJ. VOL. 37 PG. 12
;
;	MOD'D IN ACCORDANCE WITH
;	DDJ. VOL. 42 PG. 42 
;	MODS SUPPLIED BY JIM WARNER UC,SANTA CRUZ
;
; MODS TO RTN.S RB THRU SETEOF 
; ADD RTN.  GETBYT
;
; PURPOSE OF MOD.--ELIM. ERROR WHEN A 'DLE' -SPACE CODE
;		   FALLS ON A 512 BYTE BLOCK BOUNDARY
;
;*************************************************
;
;
STACK	EQU	0ABFFH
CBIOS	EQU	0AE00H
DLE	EQU	10H
CBOOT	EQU	0
DENTSZ	EQU	1AH
DTITLE	EQU	06H
BLKBUF	EQU	1000H
DIRTOP	EQU	2000H
;
	ORG	100H
	LXI	SP,STACK
;
	LXI	H,BUFF+1
	LXI     D,SYSTLE+1
	MVI	C,0
	CALL	SCBK
	CALL	SCBKCH
PFN2	MOV	A,M
	CPI	0
	JZ	PFN3
	STAX	D
	INX     H
	INX	D
	INR	C
	JMP	PFN2
PFN3	MOV	A,C
	STA	SYSTLE
	ORA	A
	JZ	NOFLNM
; CHECK FOR .TEXT OR .CODE FILENAME
	LXI	D,TEXT+6
	DCX	H
	PUSH	H
	MVI     C,5
TEXTLP  LDAX	D
	CMP	M
	JNZ	NOTEXT
	DCX	H
	DCX	D
	DCR 	C
	JNZ	TEXTLP
	LXI	H,TXTFLG
	MVI	M,2
	LXI	D,TEXT
	MVI	C,WRITECB
	CALL	BDOS
NOTEXT	POP	H
	LXI	D,CODE+6
	MVI	C,5
CODELP	LDAX	D
	CMP	M
	JNZ	NOTCODE
	DCX	H
	DCX	D
	DCR     C
	JNZ	CODELP
	LXI	H,TXTFLG
	MVI	M,1
	LXI	D,CODE
	MVI	C,WRITECB
	CALL    BDOS
NOTCODE LXI	D,FCB
	MVI	C,OPENF
	CALL	BDOS
	CPI	ERNXF
	JZ 	CREF
	LXI	D,PERMSG
	MVI	C,WRITECB
	CALL	BDOS
RDCHR	MVI	C,READC
	CALL	BDOS
	CPI	MODE
	JZ 	CBOOT
	CPI	CR
	JNZ	RDCHR
	LXI	D,FCB
	MVI	C,DELETEF
	CALL	BDOS
CREF	LXI	D,FCB
	MVI	C,CREATEF
	CALL	BDOS
	CPI	ERNDR
	JZ	CERROR
INIT	LXI	H,BUFF
	SHLD	BOL
	LXI	H,BUFF+127
	SHLD	EOB
	LXI	H,BLKBUF+512
	SHLD	BUFADD
;
	LXI	B,DIRTOP
	CALL	READ$DIR
;
	LXI	H,DIRTOP
	LXI	D,DENTSZ
	DAD	D
	SHLD	DENTP
;
	CALL	FIND$FILE
;
	LHLD	DENTP
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	DAD	H
	DAD	H
	SHLD	LSTLSN
	POP	H
	LDA	TXTFLG
SKPBL1	DCR	A
	JM	SKPBL2
	INX	H
	JMP	SKPBL1
SKPBL2	DAD	H
	DAD	H
	SHLD	LSN
LR80B	CALL	R80B
	LDA	EOFFLAG
	ORA	A
	JNZ	FILL1A
	CALL	WB
	JMP	LR80B
FILL1A  LDA	TXTFLG
	CPI	2
	JNZ	FILL2
	CALL	CT
	CALL	WB
FILL2	LXI	D,FCB
	MVI	C,CLOSEF
	CALL	BDOS
	JMP	CBOOT
;
;************************************
;
;       SUBROUTINES
;
;************************************
;
READ$DIR  EQU $
	MVI	E,4
	LXI	H,2
	CALL	SYSRD
	RET
;
;
FIND$FILE  EQU $
	MVI	C,77
	LHLD	DENTP
FI$SCH$LP  EQU	$
	LXI	D,DTITLE
	DAD	D
	LXI	D,SYSTLE
	LDA	SYSTLE
	INR	A
	MOV	B,A
FI$CMP$LP  EQU $
	LDAX	D
	CMP	M
	JNZ	FI$CONT
	INX	D
	INX	H
	DCR	B
	JNZ	FI$CMP$LP
	JMP	FI$FOUND
FI$CONT  EQU $
	LHLD	DENTP
	LXI	D,DENTSZ
	DAD	D
	SHLD	DENTP
	JNZ	FI$SCH$LP
FI$HANG  EQU $
	JMP	NOFILE
FI$FOUND  EQU $
	RET
;
;
SYSRD	PUSH	D
	PUSH    H
	CALL	READ$RX
	POP	H
	POP	D
	INX	H
	DCR	E
	JNZ	SYSRD
	RET
;
;
READ$RX DAD	H
	DAD	H
	MVI	E,4
RR$LP	PUSH	B
	PUSH	D
	PUSH	H
	CALL	SETDMA
	POP	H
	PUSH	H
	CALL	MAP
	MOV	C,H
	PUSH	H
	CALL	SETTRK
	POP	H
	MOV	C,L
	CALL	SETSEC
	MVI	C,1
	CALL	SELDSK
	CALL	READ
	POP	H
	POP	D
	POP	B
	PUSH	H
	LXI	H,128
	DAD	B
	MOV	B,H
	MOV	C,L
	POP	H
	INX	H
	DCR	E
	JNZ	RR$LP
	RET
;
;
RDSEC	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
	INX	H
	XCHG
	LHLD	BOL
CT1	CALL	EQUAL
	RZ
	MVI	M,CTRLZ
	INX	H
	JMP	CT1
;
EQUAL	MOV	A,L
	CMP	E
	RNZ
	MOV	A,H
	CMP	D
	RET
;
COMPR	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	RET
;
R80B	MVI	B,80H
	LXI	H,BUFF
R80B1	PUSH	B
	PUSH	H
	CALL	RB
	POP	H
	POP	B
	PUSH	PSW
	LDA	EOFFLAG
	ORA	A
	JZ	R80B2
	POP	PSW
	SHLD	BOL
	RET
R80B2	POP	PSW
	MOV	M,A
	INX	H
	DCR	B
	JNZ	R80B1
	RET
;
WB	MVI	C,0
	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
	CPI	' '
	JZ	SCBK
	INX	H
	JMP	SCBKCH
SCBK	MOV	A,M
	CPI	' '
	RNZ
	INX	H
	RET
;
RB	LDA	TXTFLG
	CPI	2
	JNZ	NOT$TXT
RBCKLF	LDA	NLF
	ORA	A
	JZ	RBCKTB
	XRA	A
	STA	NLF
	MVI	A,LF
	RET
RBCKTB	LDA	NTB
	ORA	A
	JZ	RBFB
	DCR	A
	STA	NTB
	MVI	A,' '
	RET
RBFB	CALL	GETBYT
	ORA	A
	JZ	RBFB
	CPI	CR
	JNZ	CKDLE
	STA	NLF
	RET
CKDLE	CPI	DLE
	RNZ
	CALL	GETBYT
	SUI	32
	STA	NTB
	JMP	RBCKTB
NOT$TXT	CALL	GETBYT
	RET
;
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	$
	LHLD	LSN
	XCHG
	LHLD	LSTLSN
	CALL	EQUAL
	JZ	SETEOF
	MVI	C,1	;SELECT B DISK-FOUND LAST SECTOR
	CALL	SELDSK
	LXI	D,BLKBUF
	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,NOFLNMSG
	JMP	GENERR
NOFILE	LXI	D,NOFMSG
	JMP	GENERR
RWERR	ORI	'0'
	STA	WERMSG
	LXI	D,WERMSG
GENERR	MVI	C,WRITECB
	CALL	BDOS
	JMP	CBOOT
;
CERROR	LXI	D,ERRMSG
	ORI	'0'
	STA	ERRMSG
	JMP	GENERR
;
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	A,H
	MOV	L,B
	MVI	A,6
MAP$LOOP  EQU $
	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
;
;
;
NOFLNMSG	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. $'
PERMSG1	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
;
;
; CP/M EQUATES
;
BOOT	EQU	CBIOS
WBOOT	EQU 	BOOT+3
CONST	EQU	WBOOT+3
CONIN	EQU	CONST+3
CONOUT	EQU	CONIN+3
LIST	EQU	CONOUT+3
PUNCH	EQU	LIST+3
READER	EQU	PUNCH+3
HOME	EQU	READER+3
SELDSK	EQU	HOME+3
SETTRK	EQU	SELDSK+3
SETSEC	EQU	SETTRK+3
SETDMA	EQU	SETSEC+3
READ	EQU	SETDMA+3
WRITE	EQU	READ+3
;
BDOS	EQU	5
FCB	EQU	5CH
BUFF	EQU	80H
;
SYSRST	EQU	0	;SYSTEM RESET
READC	EQU	1	;READ CONSOLE
WRITEC	EQU	2	;WRITE 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 SYS.
SELECTD	EQU	14	;SELECT DISK
OPENF	EQU	15	;OPEN FILE
CLOSEF	EQU	16	;CLOSE FILE
SEARCHF	EQU	17	;SEARCH FIRST
SEARCHN	EQU	18	;SEARCH NEXT
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	;GTET LOGGED DISK
DMAADD	EQU	26	;SET DMA ADDRESS
ALLOCV	EQU	27	;GET ALLOCATION VECTOR
;
ERNXF	EQU	255	;NON-EXISTANT FILE
EREOF	EQU	1	;E0F 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 DIR. SPACE
;
CR	EQU	13
LF	EQU	10
ESC	EQU	1BH
MODE	EQU	0
CTRLZ	EQU	1AH
;
;
	END