TITLE	U C S D 2 C P M  ---  CONVERT PASCAL FILES TO CP/M FORMAT
;	
;
;	VERSION:  1.0   2/9/80
;
; THIS PROGRAM WAS DONATED TO THE SOFTWARE LIBRARY OF
;
; THE PASCAL ADVANCEMENT SOCIETY OF CALIFORNIA,   BY:
;
;	JEFFRY G. SHAW
;	P.O. BOX 600457
;	SUNNYVALE, CAL 94088
;	(408) 257-7676
;
; SUGGESTIONS FOR IMPROVMENT AND REPORTS OF BUGS SHOULD
; BE REPORTED TO THE PROGRAM DONER AND ARE ENCOURAGED.
;
; SOMETIMES THIS PROGRAM HAS DIFFICULTY IN FINDING THE PASCAL
; FILE NAME IN THE DIRECTORY.  IF YOU KNOW THAT THE FILE IS
; THERE THEN JUST RETRY UNTIL THE FILE IF FOUND.
;
;	GOOD LUCK!
;
.COMMENT\

	Changed 27 April 1980:
INITFILES:	Now allows display of Pascal directory before asking for the
	filename.
TRANS$WRITE:	Nulls, ampersands, and the blank compression char's were
	corrected.

	Routines added:
LIST$PDIR:	allows you to review Pascal directory before copying.
TESTING switch:	originally for my own use, changes the program to type all
	Pascal files on the CRT.  If you change the 4th line of PRTCHAR to
	"LD C,5", the program will print the directory and the files on the 
	system printer, provided TESTING is on.  If you wished, you could 
	probably quite easily change the switch to one set by the user at run 
	time.

	BUGS:
1.	Just give the program what it asks for (like filenames) when running.
	It is NOT forgiving of filename errors.
2.	The space-decoding routine is still imperfect: A rare line is 
	one or two spaces too far to the left, and once the space compression
	code was left as a quote.  Probably intersector errors.
3.	Occasionally, the last record is duplicated, requiring you either to
	edit the CP/M file or to diminish by one the record count in the direc-
	tory (byte 15 of the last extent of the file) with a patch utility.

JIM GAGNE, M.D., DATAMED RESEARCH, 1433 ROSCOMARE ROAD, LOS ANGELES 90024
\
FALSE	EQU	0
TRUE 	EQU	NOT FALSE
;
TESTING	EQU	FALSE
;
	.Z80
;
HTAB	EQU	09		;HORIZONTAL TAB
CR	EQU	0DH	    	;CARRAIGE RETURN CHARACTER
LF	EQU	0AH	    	;LINE FEED CHARACTER
EOF	EQU	1AH	    	;CP/M EOF CHAR
BLANK	EQU	20H	    	;BLANK CHAR
SPCHAR	EQU	10H	    	;PASCAL SPECIAL CHAR
SECLTH	EQU	128	    	;LENGTH OF SECTOR
;
;
GETCHR	MACRO
; READ A CHARACTER FROM THE CONSOLE.
	LD	C,1
	CALL	BDOS
	ENDM
;
GETBUF	MACRO
; INPUT BUFFERED LINE FROM CONSOLE.
	LD	C,10
	LD	DE,INBUFF
	CALL	BDOS
	ENDM
;
PUTBUF	MACRO	MSG
; DISPLAY MESSAGE ON CONSOLE.
	LD	C,9
	LD	DE,MSG
	CALL	BDOS
	ENDM
;
DELFIL	MACRO	FCBADR
; DELETE CP/M FILE.
	LD	C,19
	LD	DE,FCBADR
	CALL	BDOS
	ENDM
;
NEWFIL	MACRO	FCBADR
; CREATE A NEW CP/M FILE.
	LD	C,22
	LD	DE,FCBADR
	CALL	BDOS
	CP	255		;ERROR?
	ENDM
;
	ASEG
	ORG	100H
	JP	START
;
;	COMMAND LINE BUFFER
;
MAXLEN	EQU	40
BUFLEN	EQU	0
INBUFF:	DEFB	MAXLEN,BUFLEN	;MAX BUFFER LENGTH, ACTUAL BUFFER LEN
	DEFS	MAXLEN
;
;	CP/M INTERFACE --- FCB DEFINITIONS
;
BDOS	EQU	05H	    	;LOCATION 5 CONTAINS JMP TO BDOS
FCBLEN	EQU	33	    	;LENGTH OF FILE CONTROL BLOCK
FCB:	DEFS	FCBLEN	    	;FILE CONTROL BLOCK FOR CP/M FILE
;
FCBFN	EQU	FCB+1	    	;CP/M FILE NAME
FCBFT	EQU	FCB+9	    	;     FILE TYPE
FCBNR	EQU	FCB+32	    	;     NEXT RECORD NUMBER (0 TO 127)
;
BUFCNT:	DEFB	128	    	;NO. OF REMAINING SPACES IN BUFFER
WRSTAT:	DEFS	1		
DFNAME:	DEFS	1		;CP/M DISK NAME
;
;  PASCAL DISK DIRECTORY
;
DTITLE	EQU	06H		;OFFSET TO DIRECTORY ENTRY TITLE
DENTSZ	EQU	1AH		;DIRECTORY ENTRY SIZE IN BYTES
TLEN	EQU	15		;MAX PASCAL FILE TITLE LENGTH
;
SYSTLE:	DEFB	TLEN		;PASCAL FILE TITLE
	DEFS	TLEN
S$DISK:	DEFS	1		;CP/M DISK SAVED HERE
P$DISK:	DEFS	1		;PASCAL DISK NAME 
DENTP:	DEFS	2		;POINTER TO PASCAL DIR ENTRY
FBLOCK:	DEFS	2		;FIRST PASCAL FILE BLOCK
NBLOCK:	DEFS	1		;NUMBER OF BLOCKS IN PASCAL FILE
PFTYPE:	DEFS	1		;PASCAL FILE TYPE, 0=PCODE, 1=TEXT
;
;	BIOS INTERFACE
;
TSELDSK	EQU	1BH		;DISK SELECT
TSETTRK	EQU	1EH		;SET TRACK
TSETSEC	EQU	21H		;SET SECTOR
TSETDMA	EQU	24H		;SET DATA TRANSFER AREA
TREAD	EQU	27H		;READ SECTOR TO DATA AREA
;
;	BIOS DIRECT CALLS
;
SELDSK:	CALL	0		;SELECT DISK
	RET	
;
SETTRK:	CALL	0		;SET TRACK NUMBER
	RET	
;
SETSEC:	CALL	0		;SET SECTOR NUMBER
	RET	
;
SETDMA:	CALL	0		;SET BUFFER ADDRESS
	RET	
;
READ:	CALL	0		;READ DISK
	RET	
;
;
;	ROUTINE TO WRITE A SECTOR TO CP/M FILE
;	DE=ADDRESS OF THE BUFFER TO BE WRITTEN
;
WRITE:	
	LD	C,26		;SET DMA ADDRESS FUNCTION
	CALL	BDOS
	LD	C,21		;WRITE A SECTOR FUNCTION
	LD	DE,FCB		;CP/M FILE FCB
	CALL	BDOS
	RET	
;
;	ROUTINE TO CLOSE CP/M FILE
;
CLOSE:	
	PUSH	HL		;SAVE HL
	LD	A,(PFTYPE)
	CP	1
	CALL	Z,WRTLBF	;IF TEXT FILE WRITE LAST BUFFER
	LD	DE,FCB		
	LD	C,16		;CLOSE FUNCTION
	CALL	BDOS
	CP	255		;ERROR?
	JR	Z,CL10		;YES-
	POP	HL
	RET
CL10:
	PUTBUF	MSG5		;"ERROR IN CLOSEING CP/M FILE."
	POP	HL
	RET	
;
;	ROUTINE TO SAVE CP/M LOGGED IN DISK
;
SAVE$DISK:
	LD	DE,0
	LD	C,25		;RETURN CURRENTLY SELECTED DISK
	CALL	BDOS
	LD	(S$DISK),A
	RET	
;
;	ROUTINE TO RESTORE CP/M DISK
;
RESTORE$DISK:
	LD	HL,S$DISK
	LD	C,(HL)		;C=CP/M DISK
	CALL	SELDSK
	LD	BC,80H
	CALL	SETDMA		;SET DEFAULT DMA BUFFER
	RET	
;
;	SELECT DISK
;
;	THE REGISTER PAIR DE HAS THE DISK NAME:
;		E=0, A DISK
;		E=1, B DISK
;
SEL$DISK:
	PUSH	HL
	LD	D,0H		;CLEAR D REGISTER
	LD	C,0EH		;SELECT FUNCTION
	CALL	BDOS		
	POP	HL
	RET	
;
;	ROUTINE TO OPEN A CP/M FILE.
;
;	IF A FILE ALREADY EXISTS, IT IS DELETED.
;	A NEW FILE IS CREATED. ON ENTRY FCB CONTAINS A DESCRIPTION OF
;	THE FILE TO BE OPENED. ON EXIT :
;		A = 0 ,  ERROR IN OPENING THE FILE
;		A = 1 ,  SUCCESSFUL FILE OPEN
;
OPEN$CPMFILE:
	PUSH	HL		;SAVE HL
	LD	A,SECLTH	;INITIALIZE NO. OF REMAINING SPACES
	LD	(BUFCNT),A	;  IN THE TEXT FILE BUFFER
;
	DELFIL	FCB
;
	NEWFIL	FCB
	JR	NZ,OPNEX1	; OK
;
	PUTBUF	MSG7		;"NO SPACE AVAILABLE ON DISK."
	XOR	A		;A=0 , ERROR
	POP	HL
	RET
;
OPNEX1:
	XOR	A		;SET RECORD COUNT TO ZERO
	LD	(FCBNR),A
	LD	A,1		;A=1 , SUCCESSFUL OPEN
	POP	HL
	RET	
;
;	ROUTINE TO INITIALIZE FCB.
;
;	FIRST ALL ENTRIES ARE FILLED WITH 0, THEN FILE NAME
;	AND EXTENSION ARE FILLED WITH BLANKS.
;
SETFCB:	
	LD	HL,FCB		;FCB ADDRESS
	LD	C,0H		;ZERO OUT ENTIRE FCB
	LD	B,FCBLEN    	;FCB LENGTH
SF10:	
	LD	(HL),C		;FCB(I) = 0
	INC	HL		;I = I + 1
	DJNZ	SF10		;B = B - 1
;
	LD	HL,FCBFN    	;FILE NAME ADDRESS
	LD	C,' '		;FILL FILE NAME AND TYPE WITH BLANKS
	LD	B,11		;TOTAL NUMBER OF BLANKS
SF20:	
	LD	(HL),C		;FCBFN(I) = ' '
	INC	HL		;I = I + 1
	DJNZ	SF20		;B = B - 1
	RET	
;
;	ROUTINE TO MOVE CP/M FILE NAME AND EXTENSION
;	FROM THE INPUT BUFFER INTO THE CP/M FCB.
;
MVCPM:
	LD	HL,INBUFF+1 	;ADDRESS OF ACTUAL BUFFER LENGTH
	LD	B,(HL)		;B=ACTUAL BUFFER LENGTH
	LD	C,B		;SAVE BUFFER LENGTH
	INC	HL		;HL=BEGINING OF FILE NAME
;
;	SCAN FOR PERIOD
;
	LD	A,'.'
MC10:
	CP	(HL)
	JR	Z,MC20		;IF BUFF(I)='.'
;
	INC	HL		;I = I+1
	DJNZ	MC10		;B = B-1
;
;     FILE WITH NO EXTENSION
;
				;BC = BUFFER LENGTH.
	LD	HL,INBUFF+2 	;HL = COMMAND LINE INPUT BUFFER
	LD	DE,FCBFN    	;DE = FILE NAME IN FCB
	LDIR			;MOVE FILE NAME FROM BUFFER TO FCB
	RET	
;
;    FILE WITH AN EXTENSION
;
MC20:
	LD	A,C		;A  = BUFFER LENGTH
	LD	C,B		;SAVE FILE NAME LENGTH
	SUB	B		;A  = FILE NAME LENGTH
	INC	HL		;MOVE ACROSS PERIOD
;
	LD	B,0		;BC = LENGTH OF THE FILE NAME
	PUSH	BC
	LD	C,A
	LD	HL,INBUFF+2
	LD	DE,FCBFN
	LDIR			;MOVE FILE NAME FROM BUFFER TO FCB
;
	POP	BC
	DEC	C		;EXTENSION LENGTH
	LD	HL,INBUFF+1 	;BUFFER LENGTH
	LD	A,(HL)		
	LD	D,0
	SUB	C
	LD	E,A		;DE = OFFSET TO EXTENSION
	ADD	HL,DE
	INC	HL		;HL=EXTENSION STARTING ADDRESS
;
				;BC = EXTENSION LENGTH
	LD	DE,FCBFT    	;MOVE FILE TYPE FROM BUFFER TO FCB
	LDIR
	RET	
;
;	ROUTINE TO MOVE PASCAL FILE NAME FROM COMMAND LINE BUFFER
;	TO SYSTLE. IF THE FILE NAME IS LONGER THAN 15 CHARACTERS
;	AN ERROR MESSAGE IS ISSUED.
;
MOVE$PASCAL:
	LD	HL,INBUFF+1 	;ADDRESS OF ACTUAL BUFFER LENGTH
	LD	A,15		;MAX LENGTH OF A PASCAL FILE NAME
	CP	(HL)		;CY = A - (M)
	JR	NC,MP10		;IF FILE NAME LENGTH <= 15
;
;     ILLEGAL FILE NAME
;
	PUTBUF	MSG2		;"ILLEGAL FILE NAME, TRY AGAIN!"
;
	GETBUF			;READ ANSWER...
;
	JR	MOVE$PASCAL
;
MP10:
	LD	DE,SYSTLE   	;DE=ADDRESS OF SYSTLE
	LD	HL,INBUFF+1 	;HL=ADDRESS OF COMMAND LINE BUFFER
	LD	C,(HL)		;C=ACTUAL BUFFER LENGTH
	INC	C		;C=C+1
	LD	B,0
	LDIR			;MOVE PASCAL FILE NAME FROM BUFFER TO SYSTLE
	RET	
;
;	ROUTINE TO OBTAIN THE EXISTING PASCAL FILE NAME AND THE 
;	DESIRED CP/M FILE NAME FROM THE USER. IT ALSO INITIALIZES
;	THE DISK NAMES OF THE FILES AND THE FCB OF THE CP/M FILE.
;
GET$FILENAMES:
	PUTBUF	MSG1		;"UCSD FILE NAME?"
;
	GETBUF			;READ THE ANSWER...
;
	CALL	MOVE$PASCAL 	;MOVE FILE NAME FROM BUFFER TO SYSTLE
GF10:
	PUTBUF	MSG11		;"PASCAL TEXT FILE?"
;
	GETCHR			;READ THE ANSWER....
;
	LD	B,0
	CP	'N'
	JR	Z,GF20		;B=0, PCODE FILE.
	CP	'Y'
	JR	NZ,GF10
	INC	B		;B=1, TEXT FILE
GF20:	
	LD	A,B
	LD	(PFTYPE),A
;
	XOR	A		;PASCAL DISK NAME = A
	LD	B,01H		;CP/M DISK NAME = B
	LD	DE,P$DISK   	;P$DISK = A
	LD	(DE),A
	LD	DE,DFNAME 	;CPM$DISK = B
	LD	A,B
	LD	(DE),A
;
   IF NOT TESTING
	PUTBUF	MSG4		;"CP/M FILE NAME?"
;
	GETBUF			;READ THE ANSWER....
;
	PUTBUF	CRLF
;
	CALL	SETFCB		;INITIALIZE FCB
;
	CALL	MVCPM    	;MOVE CP/M FILE NAME FROM INPUT BUFFER TO FCB
   ENDIF
	RET	
;
;	ROUTINE TO WRITE 512 BYTES IN PASBUF TO 4
;	SECTORS ON CP/M FILE.
;
WRTCPM:
	SUB	A
	LD	(CTLP$FLAG),A	;RESET CONTROL P FLAG
	LD	DE,PASBUF-128	
	PUSH	DE		;SAVE PASCAL FILE BUFFER ADDRESS ON STACK
	LD	B,4		;LOOP COUNT
WT$LP:	
	POP	DE		;PREVIOUS VALUE OF PASCAL BUFFER ADDRESS
	LD	HL,128		;ADD SECTOR LENGTH
	ADD	HL,DE		;HL = NEW PASCAL BUFFER ADDRESS
	PUSH	HL		;SAVE PASCAL ADDRESS FOR NEXT ITERATION
	PUSH	BC		;LOOP COUNT --- B REG ONLY
;
	LD	A,(PFTYPE)
	CP	1
	JR	Z,WT$L1		;IF TEXT FILE
;
   IF	TESTING
	RET			;SKIP CODE WRITES
   ELSE
	EX	DE,HL		;DE=BUFFER ADDRESS
	CALL	WRITE		;WRITE BUFFER TO CP/M FILE
	JR	WT$L2
   ENDIF
;
WT$L1:	
	CALL	TRANS$WRITE 	;TRANSLATE AND WRITE TEXT FILE BUFFER
WT$L2:	
;
	CP	0H
	JR	Z,WT$CONT   	;IF NO ERROR
;
	CP	01H
	JR	Z,WTERR8
;
	CP	02H
	JR	Z,WTERR9
;
	PUTBUF	MSG10		;"ERROR -- NO DIRECTORY SPACE."
	JR	WTERR$EXT
WTERR8:
	PUTBUF	MSG8		;"ERROR IN EXTENDING FILE."
	JR	WTERR$EXT
WTERR9:
	PUTBUF	MSG9		;"ERROR -- END OF DISK DATA."
WTERR$EXT:
	XOR	A		;A = 0, ERROR EXIT
	POP	BC		;RESTORE STACK
	POP	HL
	RET	
;
WT$CONT:
	POP	BC		;LOOP COUNT
	DJNZ	WT$LP		;B=B-1 UNTIL B=0
;
	POP	HL		;RESTORE STACK
	LD	A,1		;SUCCESSFUL WRITE
	RET	
;
;	ROUTINE TO TRANSLATE THE PASCAL TEXTFILE BUFFER AND TO
;	WRITE OUT THE TRANSLATED TEXT TO CP/M FILE. ON INPUT:
;	HL=PASCAL FILE BUFFER ADDRESS
;	DURING TRANSLATION CR IN PASCAL BUFFER IS TRANSLATED TO CR LF
;	AND NULLS ARE IGNORED.  BLANK COMPRESSION CHARACTERS ARE EXPANDED TO
;	THE CORRECT # OF HTABS & SPACES.
;	OUTPUT:  BUFFER TO BE WRITTEN OUT TO CP/M FILE.
;
TRANS$WRITE:
	PUSH	HL		;SAVE PASCAL BUFFER ADDRESS
	LD	HL,DMA$BUFF 	;HL=DMA BUFFER ADDRESS
	LD	A,(BUFCNT)	;A=REMAINING BUFFER SPACE
	LD	C,A	
;
	LD	A,SECLTH	
	SUB	C		;A=128-REMAINING BUFF. SPACE
	LD	E,A
	LD	D,0		;DE=OFFSET WITHIN THE BUFFER
;
	ADD	HL,DE		;HL=ADDRESS WITHIN THE BUFFER
;
	EX	DE,HL		;DE=ADDRESS WITHIN THE DMA (CP/M) BUFFER
	POP	HL		;HL=ADDRESS WITHIN THE PASCAL BUFFER
	LD	B,SECLTH
;
TR$LOOP:
	LD	A,(CTLP$FLAG)
	OR	A		;SEE IF LAST CHAR WAS ^P
	JR	NZ,GETSPC
	LD	A,(HL)		;A=PASCAL BUFF(I)
	CP	CR
	JP	Z,TR$CR		;IF A CR CHAR
;
	CP	SPCHAR
	JP	NZ,TRCONT  	;IF NOT A SPCHAR
	LD	A,0FFH
	LD	(CTLP$FLAG),A	;DUMP BUT FLAG IT WAS A ^P
	JR	TRCNT1
;
;
TRCONT:
	LD	(DE),A		;DMA BUFF(I)=A
	INC	DE		;I=I+1
	DEC	C		;DECREMENT DMA BUFFER COUNT
	CALL	Z,WRTBUF	;IF BUFFER FULL WRITE IT OUT
TRCNT1:
	INC	HL
	DJNZ	TR$LOOP		;DECREMENT PASCAL BUFFER COUNT
TRCNT2:
	LD	A,C
	LD	(BUFCNT),A
	LD	A,(WRSTAT)
	RET	
;
TR$CR:	
	LD	(DE),A		;DMA BUFF(I)=CR
	INC	DE		;DE=DE+1
	DEC	C		;DECREMENT DMA BUFFER COUNT
	CALL	Z,WRTBUF	;IF BUFFER FULL, WRITE IT OUT
;
	LD	A,LF		;A=LF CHAR
	JR	TRCONT
;
;THIS ROUTINE REPLACES "^P" (DLE, = BLANK EXPANSION CODE) / FILLCHAR 
; (NO. OF SPACES TO ADD PLUS 20H) WITH HTABS UNTIL < 8 SPACES, THEN REMAINDER
; W/ SPACES.
;
GETSPC:	SUB	A
	LD	(CTLP$FLAG),A	;RESET FLAG
	LD	A,(HL)		;GET NO. OF SPACES
	SUB	20H
	JR	Z,TRCNT1	;SOMETIMES NO SPACES TO ADD
	PUSH	AF		;SAVE # OF SPACES
	RRC	A
	RRC	A
	RRC	A		;DIV 8
	AND	0FH
	JR	Z,NO$HTABS
	PUSH	HL
	LD	L,A
	LD	A,HTAB
HT$LOOP:
	LD	(DE),A
	INC	DE
	DEC	C
	CALL	Z,WRTBUF
	DEC	L
	JR	NZ,HT$LOOP
	POP	HL
NO$HTABS:
	POP	AF		;RESTORE # OF SPACES
	AND	7		;MOD 8
	JR	Z,TRCNT1	;NO SPACES TO PRINT
	PUSH	HL
	LD	L,A
	LD	A,BLANK
BK$LOOP:
	LD	(DE),A
	INC	DE
	DEC	C
	CALL	Z,WRTBUF
	DEC	L
	JR	NZ,BK$LOOP
	POP	HL
	JR	TRCONT
CTLP$FLAG:
	DEFB	0
;
;	ROUTINE TO WRITE A TEXT FILE BUFFER TO A CP/M FILE
;
WRTBUF:
	PUSH	BC		;SAVE REGISTERS
	PUSH	HL
;
   IF	TESTING
	LD	HL,DMA$BUFF
	LD	B,80H		;BUFFER COUNT
TSTLP:	LD	A,(HL)
	CP	EOF		;DUMP EOF'S
	JR	Z,SKP$P
	LD	E,A
	CALL	PRTCHAR
SKP$P:	INC	HL
	DJNZ	TSTLP
	SUB	A
   ELSE
	LD	DE,DMA$BUFF
	CALL	WRITE		;WRITE DMA BUFFER
   ENDIF
	LD	(WRSTAT),A	;SAVE WRITE STATUS
;
	POP	HL		;RESTORE REGISTERS
	POP	BC
	LD	C,SECLTH	;RESET DMA BUFFER
	LD	DE,DMA$BUFF
	RET	
;
;	ROUTINE TO FILL LAST TEXT FILE BUFFER WITH 
;	'EOF' AND WRITE IT OUT TO A CP/M FILE
;
WRTLBF:
	LD	A,(BUFCNT)
	CP	SECLTH
	RET	Z		;IF BUFFER EMPTY, RETURN
;
	LD	HL,DMA$BUFF 	;HL=ADDRESS OF DMA BUFFER
	LD	B,A		;B=NO OF REMAINING BUFFER SPACES
	LD	E,SECLTH
	SUB	E		;E=128-NO. OF EMPTY BUFF. SPACES
	LD	E,A
	LD	D,0		;DE=OFFSET WITHIN THE BUFFER
	ADD	HL,DE		;HL=ADDRESS WITHIN THE BUFFER
;
	LD	A,EOF
WL10:
	LD	(HL),A		;DMA BUFF(I)=EOF
	INC	HL		;I=I+1
	DJNZ	WL10		;DECR THE COUNT UNTIL ZERO.
;
	LD	A,SECLTH
	LD	(BUFCNT),A
	CALL	WRTBUF
	RET	
;
;	ROUTINE TO READ 4 BLOCK (512 BYTES EACH) LONG PASCAL
;	DISK DIRECTORY INTO THE BUFFER PASBUF.
;
READ$DIR:
	;BUFFER ADDRESS IS ALREADY IN BC-REG
	LD	E,4		;DIR IS 4 BLOCKS LONG
	LD	HL,2		;AND STARTS AT BLOCK #2
	CALL	SYSRD		;GO GET IT
	RET	
;
;
;	ROUTINE TO FIND A PASCAL FILE WITH THE TITLE IN SYSTLE
;	ON THE DIRECTORY POINTED BY DENTP.
;	ON RETURN:
;		SET A=1 IF FILE FOUND
;		    A=0 IF FILE NOT FOUND
;
FIND$PFILE:
	LD	C,77		;STOP AFTER THE 77'TH ENTRY
	LD	HL,(DENTP)  	;GET STARTING ENTRY
FP10:
	LD	DE,DTITLE   	;ADVANCE TO TITLE STRING
	ADD	HL,DE
	LD	DE,SYSTLE   	;SET DE-REG TO COMPARISON STRING
	LD	A,(DE)		;A=LENGTH OF THE TITLE
	INC	A		;A=LENGTH+1
	LD	B,A		;B=LENGTH+1
FP20:				;START COMPARING.
	LD	A,(DE)
	CP	(HL)
	JR	NZ,FP30	  	;IT'S NOT THIS ONE
	INC	DE		;HEY, WE'VE STILL GOT A CHANCE
	INC	HL
	DJNZ	FP20		;LOOP IF NOT END OF STRING.
	LD	A,1		;A=1, FILE FOUND
	RET	
;
FP30:
	LD	HL,(DENTP)  	;ON TO THE NEXT ENTRY
	LD	DE,DENTSZ
	ADD	HL,DE
	LD	(DENTP),HL
	DEC	C		;WAIT, IS THERE ANY DIR LEFT?
	JR	NZ,FP10
;
	PUTBUF	MSG6		;"PASCAL FILE NOT FOUND."
;
	XOR	A		; SET A=0
	RET	
;
;
;
PRTCHAR:
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	C,2	;PRINT CHAR IN E ON CONSOLE; CHANGE TO A 5 IF YOU
	CALL	BDOS	; WANT TO PRINT THE DIRECTORY INSTEAD
	POP	HL
	POP	DE
	POP	BC
	RET
;
;
WDSKMSG:
	DEFB	CR,LF,'OOPS!  THE DISK IN DRIVE A: IS NOT A VALID PASCAL DISK.$'
;
;
;	ROUTINE TO PRINT PASCAL DIRECTORY
;
LIST$PDIR:
	LD	HL,PASBUF+DTITLE	;POINT TO VOLUME NAME CHAR COUNT
	LD	A,(HL)
	OR	A		;CHECK FOR VALID NO. (0 < N < 8)
	JR	Z,LPD$ER
	CP	8
	JR	C,LPD$OK
LPD$ER:	PUTBUF	WDSKMSG		;"WRONG DISK"
	POP	HL		;DUMP RETURN
	JP	INITFILES	;TRY AGAIN
LPD$OK:	PUTBUF	PDIR$QUERY
	GETCHR
	CP	'Y'
	RET	NZ
	PUTBUF	PVOLMSG		;'DIRECTORY OF VOLUME '
	LD	HL,PASBUF+DTITLE	;POINT TO VOLUME NAME CHAR COUNT
	LD	B,(HL)
	INC	HL
LP05:	LD	E,(HL)		;TYPE OUT VOLUME NAME
	CALL	PRTCHAR
	INC	HL
	DJNZ	LP05
	PUTBUF	COLONCRLF
	LD	C,77		;STOP AFTER THE 77'TH ENTRY
	PUSH	BC
	LD	HL,(DENTP)  	;GET STARTING ENTRY
	SUB	A
	LD	(EPL$COUNT),A	;ZERO ENTRIES/LINE COUNTER
LP10:
	LD	DE,DTITLE   	;ADVANCE TO TITLE STRING
	ADD	HL,DE
	LD	A,(HL)		;A=LENGTH OF THE TITLE
	CP	0E5H		;0 OR E5 MEAN EMPTY ENTRY
	JR	Z,NXT$ENT
	OR	A
	JR	Z,NXT$ENT
	INC	HL
	LD	B,A
	LD	D,A
LP20:				;START LISTING DIRECTORY
	LD	E,(HL)
	CALL	PRTCHAR
	INC	HL
	DJNZ	LP20		;LOOP IF NOT END OF STRING.
;
	LD	A,(EPL$COUNT)
	INC	A
	AND	3		;4 ENTRIES PER LINE
	LD	(EPL$COUNT),A	;UPDATE ENTRY COUNTER
	JR	Z,NXTLIN
	LD	A,20		;PAD TO 20TH CHAR PER ENTRY W/ BLANKS
	SUB	D		;ACTUAL CHAR PRINTED SO FAR
	LD	B,A		;NO. OF BLANKS TO PRINT
	LD	E,BLANK
LP40:	CALL	PRTCHAR
	DJNZ	LP40
	JR	NXT$ENT		;DONE W/ THIS ENTRY, ON TO NEXT
NXTLIN:	PUTBUF	CRLF
;
NXT$ENT:
	LD	HL,(DENTP)  	;ON TO THE NEXT ENTRY
	LD	DE,DENTSZ
	ADD	HL,DE
	LD	(DENTP),HL
	POP	BC
	DEC	C		;WAIT, IS THERE ANY DIR LEFT?
	RET	Z		;77 ENTRIES IN ALL
	PUSH	BC
	JR	LP10
;
EPL$COUNT:
	DEFB	0
PVOLMSG:
	DEFB	CR,LF,LF,'DIRECTORY OF VOLUME $'
COLONCRLF:
	DEFB	':',CR,LF,LF,'$'
;
;
; READ BLOCKS FROM PASCAL DISKETTE
;
SYSRD:
	PUSH	DE		;SAVE BLOCK COUNT
	PUSH	HL		;AND BLOCK NUMBER
	CALL	READ$PFILE  	;BUFFER IS ADVANCED BY 512 BYTES
	POP	HL
	POP	DE
	INC	HL		;ADVANCE TO NEXT BLOCK
	DEC	E		;BUT, BEFORE WE GO ON
	JR	NZ,SYSRD    	;  SEE IF WE'RE DONE
	RET	
¿
;	ROUTINE TO READ A BLOCK (512 BYTES) FROM A PASCAL FILE
;
;
READ$PFILE:
	ADD	HL,HL		;THERE ARE 4 IBM SECTORS TO A PASCAL BLOCK
	ADD	HL,HL		;  SO MULT LOGICAL BLOCK BY 4 TO GET 1ST SEC
	LD	E,4
RP10:				;THIS GETS CONFUSING
	PUSH	BC		;SET BUFFER ADDRESS
	PUSH	DE
	PUSH	HL
	CALL	SETDMA
	POP	HL		;NOW COMPUTE PHYSICAL TRACK-SECTOR
	PUSH	HL
	CALL	MAP		;MAP CONVERTS LOGICAL SECTOR IN HL-REG
	LD	C,H		;  INTO PHYSICAL TRACK, H-REG, SECTOR, L-REG
	PUSH	HL
	CALL	SETTRK
	POP	HL
	LD	C,L
	CALL	SETSEC
	CALL	READ		;AND READ THE DATA
	POP	HL
	POP	DE
	POP	BC
	PUSH	HL		;ADVANCE THE BUFFER ADDRESS
	LD	HL,128
	ADD	HL,BC
	LD	B,H
	LD	C,L
	POP	HL
	INC	HL		;ADVANCE BLOCK COUNT
	DEC	E		;THEN SEE IF WE CONTINUE
	JR	NZ,RP10
	RET			;LEAVE, WHEN DONE
;
;	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
;
MAP:
	PUSH	BC
	PUSH	DE
;
	CALL	DIV26
	LD	A,L
	ADD	A,A
	LD	B,A
	LD	A,12
	CP	L
	JR	NC,M10
	INC	B
M10:	
	LD	C,E
	XOR	A
	LD	D,A
	LD	H,A
	LD	L,B
	LD	A,6
M20:
	ADD	HL,DE
	DEC	A
	JR	NZ,M20
	PUSH	BC
	CALL	DIV26
	POP	BC
	INC	L
	LD	H,C
	INC	H
	POP	DE
	POP	BC
	RET	
;
;
DIV26:	
	LD	BC,-26
	LD	E,0FFH
DIVL:	
	INC	E
	ADD	HL,BC
	LD	A,H
	OR	A
	JP	P,DIVL
	LD	BC,26
	ADD	HL,BC
	RET	
;
;	THIS ROUTINE EXTRACTS THE INFORMATION ABOUT THE PASCAL
;	FILE FROM THE DIRECTORY. ON INPUT DENTP POINTS TO THE 
;	DIRECTORY ENTRY. ON EXIT :
;	FBLOCK = 1ST BLOCK (ABSOLUTE) OF THE FILE ON PASCAL DISK
;	NBLOCK = TOTAL NUMBER OF BLOCKS IN THE FILE
;
OPEN$PFILE:
	LD	HL,(DENTP)  	;OBTAIN FIRST BLOCK NUMBER
	LD	C,(HL)
	INC	HL
	LD	B,(HL)		;BC=FILE'S FIRST BLOCK NUMBER
;
	LD	A,(PFTYPE)
	CP	1
	JR	NZ,OP10  	;IF NOT A TEXT FILE
;
	INC	BC
	INC	BC		;SKIP IST 2 BLOCKS OF TEXT FILE
OP10:
	LD	A,C
	LD	(FBLOCK),A	
	CPL	
	LD	C,A
;
	LD	A,B
	LD	(FBLOCK+1),A	;FBLOCK=FIRST BLOCK TO BE COPIED TO CP/M FILE
	CPL	
	LD	B,A
;
	INC	BC		;BC=2'S COMPLEMENT OF IST BLOCK NO.
;
	LD	HL,(DENTP)
	LD	DE,02H		;OFFSET FOR LAST BLOCK NUMBER
	ADD	HL,DE		;HL = ADDRESS OF LAST BLOCK NUMBER
;
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;DE = LAST BLOCK NUMBER
;
	EX	DE,HL		;HL = DE
;
	ADD	HL,BC		;HL = LAST BLOCK NO. - FIRST BLOCK NO.
;
	LD	A,L		;A  = NUMBER OF BLOCKS IN THE FILE
	LD	DE,NBLOCK
	LD	(DE),A		;NBLOCK = NUMBER OF BLOCKS IN THE FILE
	RET	
;
;	ROUTINE TO INITIALIZE PASCAL AND CP/M FILES. WHICH MEANS
;	TO OBTAIN THE FILE NAMES FROM THE USER BY CALLING GET$FILENAMES
;	AND TO OPEN BOTH FILES FOR PROCESSING.
;
INITFILES:
   IF NOT TESTING
	LD	C,13		;INITIALIZE FUNCTION
	LD	DE,0
	CALL	BDOS
   ENDIF
;
	PUTBUF	MSG3		;GET DISKS IN RIGHT PLACES
	GETCHR			;WAIT TO CONTINUE
;
	LD	HL,PASBUF+DENTSZ 	;SET DIRECTORY ENTRY POINTER TO
	LD	(DENTP),HL	;1ST ENTRY AFTER VOLUME NAME
;	
   IF NOT TESTING
	CALL	SAVE$DISK   	;SAVE CP/M DISK
   ENDIF
;
	LD	HL,P$DISK
	LD	C,(HL)		;C = PASCAL DISK NAME
	CALL	SELDSK
;
	LD	BC,PASBUF
	CALL	READ$DIR    	;READ DIRECTORY IN PASBUF
	CALL	LIST$PDIR
;
   IF NOT TESTING
	CALL	RESTORE$DISK
   ENDIF
;
	CALL	GET$FILENAMES
;
	LD	HL,PASBUF+DENTSZ 	;SET DIRECTORY ENTRY POINTER TO
	LD	(DENTP),HL	;1ST ENTRY AFTER VOLUME NAME
;	
	CALL	FIND$PFILE  	;FIND PASCAL FILE ENTRY IN THE DIR
	CP	01H
	JR	NZ,INITFILES	;IF FILE NOT FOUND
;
   IF NOT TESTING
	LD	HL,DFNAME	
	LD	E,(HL)		;E=NAME OF THE DISK WITH CP/M FILE
	CALL	SEL$DISK    	;SELECT CP/M DISK
;
	CALL	OPEN$CPMFILE
;
	CP	01H
	JR	NZ,INITFILES	;IF ERROR
   ENDIF
;
	CALL	OPEN$PFILE	
	LD	A,80H
	LD	(BUFCNT),A
	SUB	A
	LD	(WRSTAT),A
	RET	
;
;	CONVERT UCSD PASCAL FILE TO CP/M FORMAT FILE. THIS PROGRAM
;	ASSUMES THAT THE USER HAS INSERTED A PASCAL FORMAT DISK IN ONE
;	OF THE DRIVES AND A CP/M FORMAT DISK IN THE OTHER DISK. THIS
;	PROGRAM ALSO REQUIRES THAT BDOS AND BIOS BE RESIDENT IN THE
;	MEMORY. FOR READING THE UCSD PASCAL FORMAT FILES THE DISK I/O
;	IS CARRIED OUT BY DIRECTLY CALLING BIOS.
;
START:
	LD	HL,0H		;ZERO O_T HL
	ADD	HL,SP		;HL = SP
	LD	(OLDSP),HL  	;SAVE OLDSP
	LD	SP,STKTOP   	;NEW SP
;
;	SET UP BIOS CALLS
;
	LD	HL,(1)
	LD	L,TSELDSK
	LD	(SELDSK+1),HL
	LD	L,TSETTRK
	LD	(SETTRK+1),HL
	LD	L,TSETSEC
	LD	(SETSEC+1),HL
	LD	L,TSETDMA
	LD	(SETDMA+1),HL
	LD	L,TREAD
	LD	(READ+1),HL
CONTINUE:
	CALL	INITFILES
;
;     MAIN LOOP :
;
; 	READ 1 BLOCK (512 BYTES) FROM THE PASCAL FILE
;	AND THEN WRITE 4 SECTORS TO THE CP/M FILE.
;
CONV$LOOP:
   IF NOT TESTING
	CALL	SAVE$DISK
   ENDIF
;
	LD	HL,P$DISK
	LD	C,(HL)
	CALL	SELDSK		;CALL BIOS TO SELECT PASCAL DISK
;
	LD	HL,(FBLOCK)
	PUSH	HL		;SAVE CURRENT BLOCK NUMBER
	INC	HL		;HL = NEXT BLOCK NUMBER
	LD	(FBLOCK),HL 	;SAVE NEXT BLOCK NUMBER
	POP	HL
	LD	BC,PASBUF 	;BUFFER FOR READING IN PASCAL BLOCK
	CALL	READ$PFILE		;READ A BLOCK FROM PASCAL FILE
;
   IF NOT TESTING
	CALL	RESTORE$DISK	;RESTORE CP/M DISK
;
	LD	HL,DFNAME	
	LD	E,(HL)
	CALL	SEL$DISK    	;SELECT CP/M DISK
   ENDIF
;
	CALL	WRTCPM   	;WRITE 4 SECTORS TO CP/M FILE
;
	CP	01H
	JR	NZ,CONTINUE 	;IF ERROR
;
	LD	HL,NBLOCK
	DEC	(HL)		;NBLOCK = NBLOCK - 1
	JR	NZ,CONV$LOOP
;
   IF NOT TESTING
	CALL	CLOSE		;CLOSE CP/M FILE
   ENDIF
	JR	CONTINUE
;
;MESSAGES DISPLAYED BY CONOUT
;
PDIR$QUREY:
	DEFB	CR,LF,'WOULD YOU LIKE TO SEE THE PASCAL DIRECTORY (Y/N)? $'
MSG1:	DEFB	CR,LF,LF,'*UCSD FILE NAME?  $'
MSG2:	DEFB	CR,LF,'*ILLEGAL FILE NAME, TRY IGAIN!$'
MSG3:	DEFB	CR,LF,LF,'	PUT PASCAL DISK IN DRIVE A, CP/M DISK IN DRIVE B.'
	DEFB	CR,LF,'THEN TYPE A SPACE. $'
MSG4:	DEFB	CR,LF,'*CP/M FILE NAME?  $'
MSG5:	DEFB	CR,LF,'*ERROR IN CLOSING CP/M FILE.$'
MSG6:	DEFB	CR,LF,'*UCSD FILE NOT FOUND.$'
MSG7:	DEFB	CR,LF,'*NO SPACE AVAILABLE FOR CP/M FILE.$'
MSG8:	DEFB	CR,LF,'*ERROR IN EXTENDING FILE.$'
MSG9:	DEFB	CR,LF,'*ERROR -- END OF DISK DATA.$'
MSG10:	DEFB	CR,LF,'*ERROR -- NO MORE DIRECTORY SPACE.$'
MSG11:	DEFB	CR,LF,'*PASCAL TEXT FILE (Y OR N)?  $'
CRLF:	DEFB	CR,LF,'$'
;
OLDSP:	DEFS	2		;OLD STACK POINTER
PASBUF:	DEFS	2048		; 4*512 BLOCKS
DMA$BUFF	EQU	PASBUF+1024
	DEFS	256	
STKTOP	EQU	$
;
;
	END	START