	TITLE	'3740UTIL - 3740/CP/M UTILITY'
;
;PROGRAM	3740UTIL - 3740 DISK UTILITY
;PROGRAMMER	ROBERT	M. WHITE
;		3986 BRYSON WAY
;		BOISE, ID  83704
;/////////////////////////////////////////////////////////////
;/                         W-A-R-N-I-N-G                     /
;/ USE THIS PROGRAM AT YOUR OWN RISK.  THE AUTHOR WILL NOT   /
;/ BE RESPONSIBLE FOR THIS PROGRAM OR ITS USE IN ANY WAY.    /
;/////////////////////////////////////////////////////////////
;		
;DATE WRITTEN	AUGUST 15, 1979
;DATE FINISHED	DECEMBER 23, 1979
;UPDATES
;		APRIL 21, 1980 - CHANGED DATASET LIST FUNCTION
;			(11) TO PRINT 80 CHARS.  BEFORE IT USED
;			BUFFER WRITE, THIS CAUSED BAD DISPLAYS
;			IF THE DATA CONTAINED IMBEDDED '$'s.
;		26 MAR 1981 - REMOVED STRUCTURED PROGRAMMING
;			MACROS TO GIVE 'MAC' MORE ROOM TO
;			ASSEMBLE IN AND LESSEN RISK OF NOT
;			BEING ABLE TO ASSEMBLE IT PROPERLY.
;		APRIL 9, 1981 - FIXED BUG IN TRANSFER WHERE
;			IBM OPEN DID NOT RESET BUFFER HEADER
;			CAUSING THE TRANSFER TO NOT BE PERFORMED.
;		APRIL 9, 1981 - ADDED RECORD COUNT DISPLAY FOR
;			SOURCE TRANSFERS AND IBM DISPLAY.
;		APRIL 9, 1981 - ADDED TRAILING BLANK REMOVAL ON
;			SOURCE TRANSFER FROM IBM TO CP/M.
;PURPOSE	THIS PROGRAM GIVES THE USER THE CAPABILITY
;		OF CONVERTING IBM 374X DISKETTES TO CP/M
;		FORMAT AND VICE VERSA.  ALSO, CERTAIN
;		OTHER MAINTENANCE FUNCTIONS ARE PROVIDED.
;INPUT
;OUTPUT
;OUTLINE
;REMARKS
;		1. REFERENCES FOR THIS PROGRAM ARE IBM
;		   MANUALS:
;		   A. GA21-9182, IBM GENERAL INFORMATION
;		      MANUAL ON DISKETTES
;		2. THIS PROGRAM IS BASED ON IBM'S BASIC
;		   DATA EXCHANGE FORMAT.  THE ABOVE MANUAL
;		   DESCRIBE THIS FORMAT.  IN PARTICULAR,
;		   IT WAS WRITTEN TO FORMAT DATA ACCEPTABLE
;		   TO THE 3741 AND 3540 DISKETTE READER 
;		   FOR EXCHANGE OF DATA BETWEEN CP/M AND
;		   IBM 370 MAINFRAME.
;		3. ALL CP/M FILE NAMES ARE ASSUMED TO BE
;		   THE EIGHT BYTE DATASET NAME ENTERED IN 
;		   THE PARTICULAR FUNCTION WITH A FILE TYPE
;		   OF 'DAT'.  OTHER THAN THIS, BOTH THE CP/M
;		   AND IBM FILE NAMES ARE IDENTICAL.
;		4. ALL DISPLAYS ARE BASED ON THE SOROC-120.
;		   THE CLEAR SCREEN IS THE ONLY DEPENDENT
;		   ROUTINE AND IS LABELLED CLRSCRN.
;		5. ALL IBM DISKETTES ARE ASSUMED TO BE FORMATTED
;		   TO 128-BYTE SECTORS, 26 SECTORS PER TRACK AND
;		   76 TRACKS (SINGLE DENSITY ONLY).
;		6. THE 3741 REQUIRES THAT THE REMAINING BYTES AFTER
;		   THE RECORD LENGTH BE NULLS.  OTHERWISE, IT ISSUES
;		   A READ ERROR ON THE RECORD.

;MACLIBS
	MACLIB	MACS3740

;EQUATES
;;
;;		* * *  ASSEMBLER EQUATES  * * *
;;
TRUE	SET	0FFFFH		;;TRUE VALUE
FALSE	SET	NOT TRUE	;;FALSE VALUE
;;
;;
;;
;;
;;		* * *  CP/M EQUATES  * * *
;;
;;		* *  ADDRESS ASSIGNMENTS  * *
CPMEXIT	SET	0		;;WARM START BOOT LOCATION
BDOS	SET	5		;;BDOS ENTRY POINT
TBUFF	SET	0080H		;;DEFAULT BUFFER LOCATION
TDDN	SET	0004H		;;CURRENT DEFAULT DRIVE NUMBER
TFCB	SET	005CH		;;DEFAULT FCB LOCATION 1
TFCB2	SET	006CH		;;DEFAULT FCB LOCATION 2 ( MUST BE MOVED)
TIOBYTE	SET	0003H		;;INTEL STANDARD I/O BYTE
TPABGN	SET	0100H		;;TRANSIENT PROGRAM AREA BEGINNING
;;
;;		*  FDOS FUNCTIONS  *
CREAD	SET	1		;;**CODE FOR CONSOLE READ
CWRITE	SET	2		;;**CODE FOR CONSOLE WRITE
CPB	SET	9		;;**CODE FOR CONSOLE PRINT BUFFER
CRB	SET	10		;;**CODE FOR CONSOLE READ BUFFER
CSTAT	SET	11		;;**CODE FOR CONSOLE STATUS CHECK
DLDH	SET	12		;;**CODE FOR LIFT DISK HEAD
DRDS	SET	13		;;**CODE FOR RESET DISK SYSTEM
DSD	SET	14		;;**CODE FOR SELECT DISK
DOF	SET	15		;;**CODE FOR OPEN FILE
DCF	SET	16		;;**CODE FOR CLOSE FILE
DSF	SET	17		;;**CODE FOR SEARCH FIRST
DSN	SET	18		;;**CODE FOR SEARCH NEXT
DDF	SET	19		;;**CODE FOR DELETE FILE
DRR	SET	20		;;**CODE FOR READ A RECORD
DWR	SET	21		;;**CODE FOR WRITE A RECORD
DCRF	SET	22		;;**CODE FOR CREATE A FILE
DREN	SET	23		;;**CODE FOR RENAME A FILE
DINTL	SET	24		;;**CODE FOR INTERROGATE LOGIN
DRINT	SET	25		;;**CODE FOR DRIVE INTERROGATE
DDMA	SET	26		;;**CODE FOR SET DMA ADDRESS
DINTA	SET	27		;;**CODE FOR INTERROGATE ALLOCATION
;;		* FCB EQUATES *
FCBET	SET	0		;;FCB ENTRY TYPE - *NOT USED*
FCBFN	SET	1		;;FILE NAME, 8 CHARS, PADDED WITH BALNKS
FCBFT	SET	9		;;FILE TYPE, 3 CHARS, PADDED WITH BLANKS
FCBEX	SET	12		;;FILE EXTENT, NORMALLY SET TO ZERO
;;		13-14		;;*NOT USED*
FCBRC	SET	15		;;RECORD COUNT IN CURRENT EXTENT (0-128)
FCBDM	SET	16		;;DISK ALLOCATION MAP, USED BY CP/M
FCBNR	SET	32		;;NEXT RECORD NUMBER TO READ OR WRITE
FCBLEN	SET	FCBNR-FCBET+1	;;FCB LENGTH
;;
;;
;;
;;		* *  DOUBLE REGISTER EQUATES  * *
BC	SET	B
DE	SET	D
HL	SET	H
;;
;;
@TRNASEB SET	TRUE
@TRNEBAS SET	TRUE
@OUTTRN	SET	TRUE
NBIOS	SET	FALSE	;TRUE IF USING NEW BIOS FOR CP/M 2.0
DMA$BIOS SET	TRUE	;TRUE IF USING DMA BIOS FOR CP/M 2.0
SPOOLER SET	FALSE	;TRUE IF KLH SPOOLER IS IN NEW BIOS
Z80	SET	FALSE	;TRUE IF CPU IS Z80

	IF	SPOOLER	;DISP TO SPECIAL BIOS 2.0 JUMPS
JMPDSP	SET	033H+9
	ELSE
JMPDSP	SET	033H
	ENDIF
$+PRINT
$+PRINT

;IN-LINE MACROS
$+PRINT
;
;		MOVE ASCII TO EBCDIC.
MOVAE	MACRO	DST,SRC,LEN
	LOCAL	OVERSUB,LOOP
	JMP	OVERSUB
@MVAE:	DS	0
	MOV	A,M		;;GET NEXT BYTE.
	CALL	TRNASEB		;;TRANSLATE TO EBCDIC.
	STAX	DE		;;SAVE IT.
	INX	HL		;;BUMP PTRS.
	INX	DE
	DCR	C		;;DECR COUNT.
	JNZ	@MVAE		;;LOOP FOR ALL CHARACTERS.
	RET
OVERSUB:
;
;		MOVE EBCDIC TO ASCII.
MOVAE	MACRO	D,S,L
	IF	NOT NUL D
	LXI	DE,D		;;POINT OT DESTINATION.
	ENDIF
	IF	NOT NUL S
	LXI	HL,S		;;POINT TO SOURCE.
	ENDIF
	IF	NOT NUL L
	LSR	C,L		;;GET LENGTH.
	ENDIF
	CALL	@MVAE		;;DO THE MOVE.
	ENDM
	MOVAE	DST,SRC,LEN
	ENDM
;
;		PRINT AN EBCIDIC FIELD.
PRNTEAF MACRO	?STR,FLD,LNG
	IF	NOT NUL ?STR
	MVC	TBUFF,?STR	;;MOVE IT TO THE BUFFER.
	ENDIF
	MOVEA	<>,FLD,LNG
	MVI	A,CR		;;ADD CR.
	STAX	DE
	INX	DE
	MVI	A,LF		;;ADD LF.
	STAX	DE
	INX	DE
	MVI	A,'$'		;;ADD EOL MARKER.
	STAX	DE
	CPM	CPB,TBUFF	;;PRINT THE BUFFER.
	ENDM
;


;		MOVE EBCDIC TO ASCII.
MOVEA	MACRO	DST,SRC,LEN
	LOCAL	OVERSUB,LOOP
	JMP	OVERSUB
@MVEA:	DS	0
	MOV	A,M		;;GET NEXT BYTE.
	CALL	TRNEBAS		;;TRANSLATE TO ASCII.
	STAX	DE		;;SAVE IT.
	INX	HL		;;BUMP PTRS.
	INX	DE
	DCR	C		;;DECR COUNT.
	JNZ	@MVEA		;;LOOP FOR ALL CHARACTERS.
	RET
OVERSUB:
MOVEA	MACRO	D,S,L
	IF	NOT NUL D
	LXI	DE,D		;;POINT OT DESTINATION.
	ENDIF
	IF	NOT NUL S
	LXI	HL,S		;;POINT TO SOURCE.
	ENDIF
	IF	NOT NUL L
	LSR	C,L		;;GET LENGTH.
	ENDIF
	CALL	@MVEA		;;DO THE MOVE.
	ENDM
	MOVEA	DST,SRC,LEN
	ENDM
;
;
;
;
;
;		* * *  BEGINNING OF PROGRAM  * * *
;
	ORG	TPABGN		;ORG TO BEGINNING OF TPA
;		ESTABLISH STACK POINTER.
	LHLD	6		;GET ADDRESS OF BEGINNING OF CP/M.
	DCX	HL
	SPHL			;INIT STACK.
	CPM	DRDS		;RESET ALL DISKS.
	JMP	MAINMENU
;
;
;		* *  SPECIAL BIOS JUMPS * *
BIOSSEL:			;SELECT DISK.
	PUSH	H
	LHLD	1
	MVI	L,000H+JMPDSP
	XTHL
	RET

BIOSHOM:			;HOME DISK.
	PUSH	H
	LHLD	1
	MVI	L,003H+JMPDSP
	XTHL
	RET

BIOSSEK:			;SEEK TRACK.
	PUSH	H
	LHLD	1
	MVI	L,006H+JMPDSP
	XTHL
	RET

BIOSRED:			;READ SECTOR.
	PUSH	H
	LHLD	1
	MVI	L,009H+JMPDSP
	XTHL
	RET

BIOSWRT:			;WRITE SECTOR.
	PUSH	H
	MVI	C,1		;CP/M 2.0 - DIR WRITE (IMMED)
	LHLD	1
	MVI	L,00CH+JMPDSP
	XTHL
	RET

CLRSCRN:
	PRINT	<27,'*',0,0>	;CLEAR SCREEN.
	RET


;		* *  MAIN PROGRAM LOOP  * *
;
;		DISPLAY BASE MENU.
MAINMENU: DS	0
$+PRINT
	CALL	CLRSCRN
	PRINT	<'* * *  3740 IBM UTILITY  * * *',CR,LF>
	PRINT	<'SELECT ONE OF THE FOLLOWING:',CR,LF>
	PRINT	<'   0 - RETURN TO CP/M',CR,LF>
	PRINT	<'   1 - INITIALIZE THE DIRECTORY',CR,LF>
	PRINT	<'   2 - CHANGE A VOLUME SERIAL NUMBER',CR,LF>
	PRINT	<'   3 - CHANGE A DATASET ENTRY',CR,LF>
	PRINT	<'   4 - DELETE A DATASET ENTRY',CR,LF>
	PRINT	<'   5 - DISPLAY A DATASET ENTRY',CR,LF>
	PRINT	<'   6 - LIST THE DIRECTORY',CR,LF>
	PRINT	<'   7 - TRANSFER CP/M TO 3740 (BLOCK)',CR,LF>
	PRINT	<'   8 - TRANSFER 3740 TO CP/M (BLOCK)',CR,LF>
	PRINT	<'   9 - TRANSFER CP/M TO 3740 (SOURCE)',CR,LF>
	PRINT	<'  10 - TRANSFER 3740 TO CP/M (SOURCE)',CR,LF>
	PRINT	<'  11 - DISPLAY AN IBM DATASET',CR,LF>
	INPUT	'ENTER CHOICE: ',TBUFF
	PRINT	<CR,LF>
;
;
;		IF NO INPUT, ISSUE ERROR MSG.
	LDA	TBUFF+1		;GET INPUT COUNT.
	CPI	0		;LENGTH CHECK (1-2)
	JZ 	MAINERR		;...ISSUE ERROR.
	CPI	2+1
	JNC	MAINERR
;
;
;		CONVERT INPUT TO BINARY.
	DECIN	TBUFF+2,TBUFF+1	;GET INPUT NUMBER.
	CPI	11+1		;IF INVALID NUMBER
	JNC	MAINERR		;...ISSUE ERROR MESSAGE.
;
;
;               CLEAR THE SCREEN FOR EACH ROUTINES OUTPUT.
        PUSH    PSW             ;SAVE OPTION CODE.
	CALL	CLRSCRN
        POP     PSW             ;RESTORE OPTION CODE.
;
;
;		CALL THE APPROPRIATE ROUTINE.
;
	ADD	A		;INDEX INTO TABLE.
	LXI	HL,FNCTBL	
	ADDHA
;
	MOV	E,M		;GET ENTRY.
	INX	HL
	MOV	D,M
;
	LXI	HL,MAINMENU	;SET RETURN PTR.
	PUSH	HL
;
	XCHG		;CALL THE ROUTINE.
	PCHL
;
;
;		ISSUE ERROR MESSAGE AND RE-PRINT MENU.
MAINERR: DS	0
	PRINT	<'***INVALID REPLY***',CR,LF>
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	JMP	MAINMENU
;
;
;
;
$+PRINT
$+PRINT
;		* * *  RETURN TO CPM  * * *
;PURPOSE
;		THIS ROUTINE RETURNS CONTROL TO CP/M ISSUEING
;		A WARM START AND DISK RESET.
;INPUT
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
RTNCPM:	DS	0
	PRINT	<'*** RETURN TO CPM ***',CR,LF>
	PRINT	<'PUT MASTER CP/M DISK IN DRIVE A.',CR,LF>
	INPUT	'PRESS <ENTER> WHEN READY. ',TBUFF
	CPM	DRDS		;RESET ALL DRIVES.
	JMP	CPMEXIT		;COLD START CP/M.
;
;
;
;
$+PRINT
$+PRINT
;		* * *  INITIALIZE A DISKETTE  * * *
;PURPOSE
;		THIS ROUTINE ALLOWS THE USER TO FORMAT A
;		DISKETTE TO IBM FORMAT.  FIRST, IT BUILDS
;		THE DIRECTORY AND THEN BLANKS ALL REMAINING
;		RECORDS.
;INPUT
;		DISK DRIVE OF DISK TO BE FORMATTED
;		VOLUME SERIAL NUMBER FOR THE DISK
;OUTPUT
;		FORMATTED DISK
;REMARKS
;
;
;
;		DO INITIALIZATION.
INITDISK: DS	0
	PRINT	<'*** INITIALIZE A DISK  ***',CR,LF>
;
;
;		GET DISK DRIVE.
	CALL	INPDSKNO
	STA	DIRDSK		;SAVE IT.
;
;
;		GET VOLUME SERIAL NUMBER.
	FILL	VOLSER,6,' '
INITDIRV: DS	0
	INPUT	'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LENGTH.
	CPI	1
	JC	$+8		;...INVALID.
	CPI	6+1
	JC	INITDIRG	;...VALID
	PRINT	<'*** INVALID REPLY ***',CR,LF>
	JMP	INITDIRV
INITDIRG: DS	0
	MVC	VOLSER,TBUFF+2,TBUFF+1
;
;
;		WRITE SECTORS (1-4 AND 6)
	FILL	DIRBUF,80,040H
	FILL	DIRBUF+80,48,000H
	MVI	A,1		;SET SECTOR TO 1.
	STA	DIRSCT
	LDA	DIRSCT
INITDIR0: DS	0
	CPI	4+1
	JNC	INITDIR1
	CALL	WRTDIR
	LDA	DIRSCT		;BUMP SCTOR NUMBER.
	INR	A
	STA	DIRSCT
	JMP	INITDIR0
INITDIR1: DS	0
	MVI	A,6
	CALL	WRTDIR
;
;
;		WRITE SECTOR 5 (ERMAP).
	MOVAE	DIRBUF,CERMAP,5
	MVI	A,5
	CALL	WRTDIR
;
;
;		WRITE SECTOR 7 (VOL1).
	MOVAE	DIRBUF,CVOL1,4	;PUT 'VOL1' IN COL 1.
	MOVAE	DIRBUF+4,VOLSER,6 ;PUT VOLSER IN COL 5.
	MVI	A,0E6H		;PUT 'W' IN COL 80.
	STA	DIRBUF+79
	MVI	A,7
	CALL	WRTDIR
;
;
;		WRITE SECTORS 8-26 (DATA).
	MVI	A,8
	STA	DIRSCT
INITDIR2:
	LDA	DIRSCT
	CPI	26+1
	JNC	INITDIR3
	CALL	DFTDIR
	LDA	DIRSCT
	CALL	WRTDIR
	LDA	DIRSCT
	INR	A
	STA	DIRSCT
	JMP	INITDIR2
INITDIR3: DS	0
;
;
;		WRITE REMAINING DISK BUFFERS.
	PRINT	<'THE DIRECTORY HAS BEEN INITIALIZED.',CR,LF>
	PRINT	<'THE REST OF THE DISK SHOULD HAVE BEEN',CR,LF>
	PRINT	<'PREVIOUSLY INITIALIZED.',CR,LF>
;
;
;		ISSUE COMPLETION MESSAGE.
	PRINT	<'*** INITIALIZATION IS COMPLETE ***',CR,LF>
	INPUT   'PRESS <ENTER> TO CONTINUE.',TBUFF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  CHANGE A VOLUME SERIAL NUMBER  * * *
;PURPOSE
;		THIS ROUTINE ALLOWS THE USER TO CHANGE AN IBM
;		VOLUME SERIAL NUMBER AS FOUND IN THE 'VOL1'
;		SECTOR (00008).
;INPUT
;		DISK DRIVE OF IBM DISKETTE
;		VOLUME SERIAL NUMBER (OPTIONAL)
;OUTPUT
;		THE VOLUME SERIAL NUMBER IS CHANGED IF ENTERED.
;REMARKS
;
;
;
;		DO INITIALIZATION.
CHGVOL: DS	0
	PRINT	<'*** CHANGE A VOLUME SERIAL NUMBER ***',CR,LF>
;
;
;		GET THE DISK DRIVE AND VERIFY IT.
	CALL	INPDSKNO	;GET IT.
	STA	DIRDSK		;SAVE IT.
	CALL	VERIBMD		;VERIFY IBM DISK.
	JC	CHGVOLE		;...DIDN'T VERFIY, MSG WAS GIVEN.
;
;
;		PRINT THE VOLUME SERIAL NUMBER.
	PRNTEAF	'CURRENT VOLUME SERIAL NUMBER: ',DIRBUF+4,6
	MOVEA	VOLSER,DIRBUF+4,6
;
;
;		GET VOLUME SERIAL NUMBER.
CHGVOLIV: DS	0
	PRINT	<'(OPTIONALLY) '>
	INPUT	'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LENGTH.
	CPI	1
	JC	CHGVOLIB	;...NO ENTRY, SKIP REPLACE.
	CPI	6+1
	JC	CHGVOLIG	;...VALID
	PRINT	<'*** INVALID REPLY ***',CR,LF>
	JMP	CHGVOLIV
CHGVOLIG: DS	0
	FILL	VOLSER,6,020H
	MVC	VOLSER,TBUFF+2,TBUFF+1
CHGVOLIB: DS	0
;
;
;		WRITE THE SECTOR BACK OUT.
	MOVAE	DIRBUF+4,VOLSER,6	;PUT VOLSER IN BUFFER.
	MVI	A,7		;WRITE OUT SECTOR 7 (VOL1).
	CALL	WRTDIR
;
;
;		RETURN TO CALLER.
	PRINT	<'*** CHANGE IS SUCCESSFUL.***',CR,LF>
CHGVOLE: DS	0
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  CHANGE A DATASET ENTRY  * * *
;PURPOSE
;		THIS ROUTINE ACTIVATES A DIRECTORY ENTRY AND/OR
;		ALLOWS THE USER TO CHANGE DIRECTORY INFORMATION
;		PERTAINING TO THAT DATASET.
;INPUT
;		IBM DISKETTE DISK DRIVE
;		DIRECTORY SECTOR NUMBER AS GIVEN IN DIRECTORY LIST
;OUTPUT
;		THE DIRECTORY ENTRY IS UPDATED.
;REMARKS
;
;
;
;		DO INITIALIZATION.
CHGDIR: DS	0
	PRINT	<'*** CHANGE A DATASET ENTRY ***',CR,LF>
;
;
;		GET DISK DRIVE.
	CALL	INPDSKNO	;GET IT.
	STA	DIRDSK		;SAVE IT.
	CALL	VERIBMD		;VERIFY IBM DISK.
	RC
;
;
;		GET THE SECTOR NUMBER.
	CALL	INPSCTNO	;GET IT.
	STA	DIRSCT		;SAVE IT.
;
;
;		PRINT THE ENTRY.
	CALL	REDDIR		;READ THE ENTRY.
	CALL	PRTDIR		;PRINT IT.
;
;
;		PRINT CHANGE MESSAGES.
	PRINT
	PRINT	<'CHANGE ONLY THE FIELDS THAT YOU WANT UPDATED.',CR,LF>
	PRINT	<'IF YOU DO NOT ENTER ANY DATA, THE FIELD',CR,LF>
	PRINT	<'REMAINS UNCHANGED.',CR,LF>
	PRINT
;
;
;		CHANGE THE FIELDS AND UPDATE THE RECORD.
	MVI	A,0C8H		;INSURE ACTIVE DATASET.
	STA	DSHD
	CALL	INPDIR		;CHANGE THE FIELDS.
	LDA	DIRSCT		;UPDATE THE RECORD.
	CALL	WRTDIR
	PRINT	<'***CHANGE IS SUCCESSFUL.***',CR,LF>
;
;
;		RETURN TO CALLER.
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  DELETE A DATASET ENTRY  * * *
;PURPOSE
;		THIS FUNCTION ALLOWS THE USER TO DELETE A
;		SPECIFIED DIRECTORY ENTRY.  THE ENTRY IS MARKED
;		AS DELETED AND INITIALIZED TO ITS INITIAL FORMAT
;		AS WHEN THE ENTIRE DIRECTORY WAS INITIALIZED.
;INPUT
;		IBM DISK DRIVE
;		DIRECTORY SECTORY NUMBER
;OUTPUT
;		DELETED INITIAL DIRECTORY ENTRY
;REMARKS
;		1. AT THIS POINT, WE HAVE FOUND THAT THE AM2 FIELD
;		   OF THE RECORD DOES NOT HAVE TO INDICATE DELETED
;		   RECORD.
;
;
;
;		DO INITIALIZATION.
DELDIR: DS	0
	PRINT	<'*** DELETE A DATASET ENTRY ***',CR,LF>
;
;
;		GET DISK DRIVE.
	CALL	INPDSKNO	;GET IT.
	STA	DIRDSK		;SAVE IT.
	CALL	VERIBMD		;VERIFY IBM DISK.
	RC			;...NOT IBM FORMAT!!
;
;
;		GET THE SECTOR NUMBER.
	CALL	INPSCTNO	;GET IT.
	STA	DIRSCT		;SAVE IT.
;
;
;		DELETE THE ENTRY.
	LDA	DIRSCT		;INITIALIZE THE ENTRY.
	CALL	DFTDIR
	LDA	DIRSCT		;WRITE IT BACK TO DISK.
	CALL	WRTDIR
;
;
;		RETURN TO CALLER.
	PRINT	<'***DELETION IS SUCCESSFUL.***',CR,LF>
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  DISPLAY A DATASET ENTRY  * * *
;PURPOSE
;		THIS ROUTINE DISPLAYS A SINGLE DIRECTORY ENTRY.
;		IT IS PRIMARILY USED TO INSURE THAT AN ENTRY
;		WAS CHANGED PROPERLY.
;INPUT
;		IBM DISK DRIVE
;		DIRECTORY SECTOR NUMBER
;OUTPUT
;		DIRECTORY ENTRY IS DISPLAYED
;REMARKS
;
;
;
;		DO INITIALIZATION.
DSPLDIR: DS	0
	PRINT	<'*** DISPLAY A DIRECTORY ENTRY ***',CR,LF>
;
;
;		GET DISK DRIVE.
	CALL	INPDSKNO	;GET IT.
	STA	DIRDSK		;SAVE IT.
	CALL	VERIBMD		;VERIFY IBM DISK.
	RC
;
;
;		GET THE SECTOR NUMBER.
	CALL	INPSCTNO	;GET IT.
	STA	DIRSCT		;SAVE IT.
;
;
;		PRINT THE ENTRY.
	CALL	REDDIR		;READ THE ENTRY.
	CALL	PRTDIR		;PRINT IT.
;
;
;		RETURN TO CALLER.
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  LIST THE DIRECTORY  * * *
;PURPOSE
;		THIS ROUTINE DISPLAYS THE ENTIRE IBM DISKETTE
;		DIRECTORY AND ALL PERTINENT DATA ASSOCIATED
;		WITH IT.
;INPUT
;		IBM DISK DRIVE
;OUTPUT
;		THE DIRECTORY IS DISPLAYED.
;REMARKS
;
;
;
;		DO INITIALIZATION.
LISTDIR: DS	0
	PRINT	<'*** LIST THE DIRECTORY ***',CR,LF>
;
;
;		GET THE DISK NUMBER.
	CALL	INPDSKNO	;GET IT.
	STA	DIRDSK		;SAVE IT.
;
;
;		READ AND VERIFY THE VOLSER.
	CALL	VERIBMD		;VERIFY 'VOL1' ID.
	JC	LISTDIRR	;...BAD VOL1.
	CALL	CLRSCRN
	PRNTEAF	'              DIRECTORY FOR ',DSHD+4,6
	PRINT	<'                                           '>
	PRINT	<'         M VL B S W V',CR,LF>
	PRINT	<'SCT DATASET D LRECL  BOE   EOE   EOD  CREDT'>
	PRINT	<'  EXPDT  V SQ I S P C',CR,LF>
;
;
;		LIST ALL DIRECTORY ENTRIES.
	MVI	C,8		;SET BEGINNING SECTOR.
	MOV	A,C
LISTDIR0: DS 0
	CPI	26+1		;LOOP FOR SECTORS 8-26.
	JNC	LISTDIR1
	CALL	LISTDIRE	;LIST THE ENTRY.
	INR	C		;BUMP SECTOR.
	MOV	A,C		;SET FOR DOWHILE.
	JMP	LISTDIR0
LISTDIR1: DS 0
;
;
;		RETURN TO CALLER.
LISTDIRR: DS	0
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
$+PRINT
$+PRINT

;		* *  LIST A DIRECORTY ENTRY  * *
;
;		DO INITIALIZATION.
LISTDIRE: DS	0
	PUSH	BC		;SAVE REGS.
;
;
;		READ SECTOR.
	MOV	A,C		;GET SECTOR.
	CALL	REDDIR		;READ IT.
;
;
;		BUILD OUTPUT LINE.
	FILL	TBUFF,80,' '	;MOVE SPACES TO TBUFF.
	LXI	HL,CSCTNO	;  SECTOR NUMBER
	LDA	DIRSCT
	SUI	8
	ADD	A
	ADDHA
	MVC	TBUFF,,2
	LDA	DIRSCT
	CPI	8
	JNZ	LISTDIR2
	MVC	TBUFF,'08'
LISTDIR2: DS	0
	MOVEA	TBUFF+3,DSID,8	;  DATASET NAME
	LDA	DSHD		;  **DELETED**
	CPI	0C4H
	JNZ	LISTDIR3
	MVI	A,'D'
	STA	TBUFF+12
LISTDIR3: DS	0
	MOVEA	TBUFF+14,DSBLK,5	;  LRECL
	MOVEA	TBUFF+20,DSBOE,5	;  BOE
	MOVEA	TBUFF+26,DSEOE,5	;  EOE
	MOVEA	TBUFF+32,DSEOD,5	;  EOD
	MOVEA	TBUFF+38,DSCREDT,6
	MOVEA	TBUFF+45,DSEXPDT,6	;  EXP DATE
	MOVEA	TBUFF+52,DSMVI,1	;  MULTI-VOL IND
	MOVEA	TBUFF+54,DSVLSQ,2	;  VOL SEQ
	MOVEA	TBUFF+57,DSBYPI,1	;  BYP IND
	MOVEA	TBUFF+59,DSSS,1		;  SECURE IND
	MOVEA	TBUFF+61,DSWP,1		;  WRITE PRO IND
	MOVEA	TBUFF+63,DSVCI,1	;  VERI/COPY IND
;
;
;		PRINT THE LINE.
	MVC	TBUFF+72,CEOL,3
	PRINT	TBUFF,$
;
;
;		RETURN TO CALLER.
	POP	BC		;RESTORE REGS.
	RET
;
;
;
;
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSFER CP/M TO 3740 (BLOCK)  * * *
;PURPOSE
;		THIS ROUTINE TRANSFERS A DATASET FROM CP/M TO
;		IBM FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
;		EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
;		ARE ONE SECTOR.
;INPUT
;		CP/M INPUT DRIVE
;		IBM OUTPUT DRIVE
;		EIGHT-BYTE DATASET NAME
;OUTPUT
;		THE FILE IS MOVED TO THE IBM DISKETTE.
;REMARKS
;		1.  IT IS ASSUMED THAT THE INPUT FILE NAME
;		    IS THE EIGHT-BYTE DATASET NAME CONCATENATED
;		    WITH A FILE TYPE OF 'DAT'.
;		2.  IT IS ASSUMED THAT THE IBM FILE HAS BEEN
;		    PRE-ALLOCATED ON THE DISK WITH ENOUGH SPACE
;		    DEFINED TO HOLD THE INPUT FILE.
;
;
;
;		DO INITIALIZATION.
TRSCIBLK: DS	0
	PRINT	<'*** TRANSFER CP/M TO 3740 (BLOCK) ***',CR,LF>
	XRA	A		;ZERO ERROR COUNT.
	STA	TRSERR
;
;
;		GET INPUT AND OPEN FILES.
	CALL	TRSGETIN	;GET INPUT PARMS.
	MVI	A,0		;OPEN CP/M FOR INPUT.
	CALL	CPMOPEN
	JC	TRSCIBEN	;...UNSUCCESSFUL.
	MVI	A,1		;OPEN IBM FOR OUTPUT.
	LXI	HL,DATDSK2
	CALL	IBMOPEN
	JC	TRSCIBEN
;
;
;		GET THE BLOCK LENGTH FOR MOVE.
	MOVEA	TBUFF,DSBLK,5	;GET THE DATASET BLOCK LENGTH.
	DECIN	TBUFF,5		;CONVERT TO BINARY.
	XCHG			;GET BINARY BLOCK LENGTH.
	SHLD	BLKLEN		;SAVE IT.
;
;
;		GET AN CP/M BLOCK.
TRSCIBLP: DS	0
	CPM	CSTAT		;CHECK FOR SUSPEND.
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;SELECT THE DISK DRIVE.
	CPM	DDMA,DATA1	;SET FOR CP/M BUFFER.
	CPM	DRR,TRSFCB	;READ THE BLOCK.
	CPI	0		;ERROR?
	JZ	TRSCIB00	;...NO.
	CPI	1		;EOF?
	JZ	TRSCIBOK	;...YES, CLOSE FILES.
	PRINT	<'*** CP/M READ ERROR ***',CR,LF>
	BUMP	TRSERR
TRSCIB00: DS	0
;
;
;		MOVE BLOCK TO IBM BUFFER.
	FILL	DATA2,128,000H	;MOVE LOW VALUES TO BUFFER.
	MOVAE	DATA2,DATA1,BLKLEN ;MOVE IN THE DATA.
;
;
;		IF PAST EOE, ISSUE ERROR.
	CLC	DATTRK2,TDSEOE,2
	JC	TRSCIBNF
	JZ	TRSCIBNF
	PRINT	<'*** IBM EXTENT FULL ***',CR,LF>
	BUMP	TRSERR
	JMP	TRSCIBOK
TRSCIBNF: DS	0
;
;
;		WRITE IBM BLOCK.
	CALL	WRTDAT2		;WRITE THE BLOCK.
;
;
;		BUMP THE IBM TRK/SCT.
	BUMP	DATSCT2
	LDA	DATSCT2		;LIMIT TO 26.
	CPI	26+1		;ROLL TRACK AFTER LAST
	JC	TRSCIBLP
	MVI	A,1
	STA	DATSCT2
	BUMP	DATTRK2
	JMP	TRSCIBLP
;
;
;		CLOSE ALL FILES.
TRSCIBOK: DS	0
	MVI	A,0		;CP/M FILE.
	CALL	CPMCLOSE
	MVI	A,1		;IBM FILE.
	LXI	HL,DATTRK2
	CALL	IBMCLOSE
;
;
;		RETURN TO CALLER.
TRSCIBEN: DS	0
	LDA	TRSERR
	CPI	0
	JNZ	TRSCIB02
	PRINT	<'*** TRANSFER SUCCESSFUL ***',CR,LF>
	JMP	TRSCIB03
TRSCIB02: DS	0
	PRINT	<'*** TRANSFER NOT COMPLETED ***',CR,LF>
	PRINT	<'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSCIB03: DS	0
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSFER 3740 TO CP/M (BLOCK)  * * *
;PURPOSE
;		THIS ROUTINE TRANSFERS A DATASET FROM IBM TO 
;		CP/M FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
;		EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
;		ARE ONE SECTOR.
;INPUT
;		CP/M OUTPUT DRIVE
;		IBM INPUT DRIVE
;		EIGHT-BYTE DATASET NAME
;OUTPUT
;		THE FILE IS MOVED TO THE CP/M DISK.   
;REMARKS
;		1.  IT IS ASSUMED THAT THE INPUT FILE NAME
;		    IS THE EIGHT-BYTE DATASET NAME CONCATENATED
;		    WITH A FILE TYPE OF 'DAT'.
;
;
;
;		DO INITIALIZATION.
TRSICBLK: DS	0
	PRINT	<'*** TRANSFER 3740 TO CP/M (BLOCK) ***',CR,LF>
	XRA	A		;ZERO ERROR COUNT.
	STA	TRSERR
;
;
;		GET INPUT AND OPEN FILES.
	CALL	TRSGETIN	;GET INPUT PARMS.
	MVI	A,0		;OPEN IBM FOR INPUT.
	LXI	HL,DATDSK1
	CALL	IBMOPEN
	JC	TRSICBEN	;...UNSUCCESSFUL.
	MVI	A,1		;OPEN CP/M FOR OUTPUT.
	CALL	CPMOPEN
	JC	TRSICBEN
;
;
;		GET BLOCK LENGTH OF IBM DATASET.
	MOVEA	TBUFF,DSBLK,5	;GET ASCII BLOCK LENGTH.
	DECIN	TBUFF,5		;CONVERT IT TO BINARY.
	XCHG			;SAVE IT.
	SHLD	BLKLEN
;
;
;		GET AN IBM BLOCK.
TRSICBLP: DS	0
	CPM	CSTAT		;CHECK FOR SUSPEND.
	CLC	DATTRK1,TDSEOD,2 ;END OF FILE?
	CMC
	JC	TRSICBOK	;...YES.
	CALL	REDDAT1		;GET THE BLOCK.
;
;
;		MOVE BLOCK TO CP/M BUFFER.
	FILL	DATA2,128,000H	;ZERO OUTPUT BUFFER.
	MOVEA	DATA2,DATA1,BLKLEN
	MVI	A,00DH		;INSERT <CR><LF> PAIR FOR CP/M
	STAX	DE
	INX	DE
	MVI	A,00AH
	STAX	DE
;	
;
;		WRITE CP/M BLOCK.
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;SELECT DISK DRIVE.
	CPM	DDMA,DATA2
	CPM	DWR,TRSFCB
	CPI	0		;WRITE ERROR?
	JZ	TRSICB00	;...NO.
	PRINT	<'*** CP/M WRITE ERROR ***',CR,LF>
	BUMP	TRSERR
	JMP	TRSICBOK
TRSICB00:
;
;
;		BUMP TO NEXT IBM BLOCK.
	BUMP	DATSCT1		;BUMP SECTOR BY 1.
	CPI	26+1		;ALLOW FOR TRACK OVERFLOW.
	JC	TRSICBLP
	MVI	A,1		;SECTOR = 1
	STA	DATSCT1
	BUMP	DATTRK1
	JMP	TRSICBLP
;
;
;		CLOSE ALL FILES.
TRSICBOK: DS	0
	MVI	A,0		;IBM FILE.
	LXI	HL,DATTRK1
	CALL	IBMCLOSE
	MVI	A,1		;CP/M FILE.
	CALL	CPMCLOSE
;
;
;		RETURN TO CALLER.
TRSICBEN: DS	0
	LDA	TRSERR
	CPI	0
	JNZ	TRSICB01
	PRINT	<'*** TRANSFER SUCCESSFUL ***',CR,LF>
	JMP	TRSICB02
TRSICB01:
	PRINT	<'*** TRANSFER NOT COMPLETED ***',CR,LF>
	PRINT	<'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSICB02:
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSFER CP/M TO 3740 (SOURCE)  * * *
;PURPOSE
;		THIS ROUTINE TRANSFERS A CP/M SOURCE FILE TO AN
;		IBM FILE ONE LINE AT A TIME.  <TAB>'S ARE EX-
;		PANDED AS THEY ARE ENCOUNTERED.  EOF WILL OCCUR
;		WHEN (A) A 01AH IS ENCOUNTERED OR (B) THE PHYSICAL
;		EOF IS ENCOUNTERED.  NOTE THAT <CR><LF>'S ARE 
;		NOT TRANSFERRED.
;INPUT
;		CP/M DISK DRIVE
;		IBM DISK DRIVE
;		DATASET NAME
;OUTPUT
;		IBM DATASET
;REMARKS
;		1.  EACH LINE OF TEXT IS TRANSFERRED AS ONE PHYSICAL
;		    RECORD ON THE IBM DRIVE.  THE IBM BEGINNING-OF-EXTENT
;		    POINTER INDICATES WHERE THE TRANSFER IS TO BEGIN.
;		2.  IT IS ASSUMED THAT THE IBM DATASET HAS BEEN 
;		    PRE-ALLOCATED WITH ENOUGH SPACE TO HOLD THE
;		    ENTIRE CP/M DATASET.
;
;
;
;		DO INITIALIZATION.
TRSCISRC: DS	0
	PRINT	<'*** TRANSFER CP/M TO 3740 (SOURCE) ***',CR,LF>
	LXI	HL,0		;ZERO RECORD COUNT.
	SHLD	RCDCNT
	XRA	A		;ZERO ERROR COUNT.
	STA	TRSERR
;
;
;		GET INPUT AND OPEN FILES.
	CALL	TRSGETIN	;GET INPUT PARMS.
	MVI	A,0		;OPEN CP/M FOR INPUT.
	CALL	CPMOPEN
	JC	TRSCISEN	;...UNSUCCESSFUL.
	MVI	A,1		;OPEN IBM FOR OUTPUT.
	LXI	HL,DATDSK2
	CALL	IBMOPEN
	JC	TRSCISEN
	CALL	TRSCISGT	;GET THE FIRST CP/M BLOCK.
	JC	TRSCISOK	;...**EOF REACHED**
;
;
;		GET THE BLOCK LENGTH FOR MOVE.
	MOVEA	TBUFF,DSBLK,5	;GET THE DATASET BLOCK LENGTH.
	DECIN	TBUFF,5		;CONVERT TO BINARY.
	XCHG			;GET BINARY BLOCK LENGTH.
	SHLD	BLKLEN		;SAVE IT.
;
;
;		GET THE NEXT LINE OF CP/M TEXT.
TRSCISLP: DS	0
	CALL	TRSCISGL	;GET THE LINE.
	JC	TRSCISOK	;...**EOF REACHED**
	INDEX	RCDCNT		;BUMP RECORD COUNT.
;
;
;		MOVE BLOCK TO IBM BUFFER.
	FILL	DATA2,128,000H	;MOVE LOW VALUES TO BUFFER.
	MOVAE	DATA2,TBUFF,BLKLEN ;MOVE IN THE DATA.
;
;
;		IF PAST EOE, ISSUE ERROR.
	CLC	DATTRK2,TDSEOE,2
	JC	TRSCISNF
	JZ	TRSCISNF
	PRINT	<'*** IBM EXTENT FULL ***',CR,LF>
	BUMP	TRSERR
	JMP	TRSCISOK
TRSCISNF: DS	0
;
;
;		WRITE IBM BLOCK.
	CALL	WRTDAT2		;WRITE THE BLOCK.
;
;
;		BUMP THE IBM TRK/SCT.
	BUMP	DATSCT2
	CPI	26+1
	JC	TRSCISLP
	MVI	A,1
	STA	DATSCT2
	BUMP	DATTRK2
	JMP	TRSCISLP
;
;
;		CLOSE ALL FILES.
TRSCISOK: DS	0
	MVI	A,0		;CP/M FILE.
	CALL	CPMCLOSE
	MVI	A,1		;IBM FILE.
	LXI	HL,DATTRK2
	CALL	IBMCLOSE
;
;
;		RETURN TO CALLER.
TRSCISEN: DS	0
	DECOUT	RCDCNT		;DISPLAY RECORDS XFERED.
	PRINT	<' RECORDS TRANSFERRED.',CR,LF>
	LDA	TRSERR
	CPI	0
	JNZ	TRSCIS01
	PRINT	<'*** TRANSFER SUCCESSFUL ***',CR,LF>
	JMP	TRSCIS02
TRSCIS01:
	PRINT	<'*** TRANSFER NOT COMPLETED ***',CR,LF>
	PRINT	<'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSCIS02:
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;		* *  GET A LINE OF CP/M TEXT  * *
TRSCISGL: DS	0
	FILL	TBUFF,128,' '	;MOVE SPACES TO BUFFER.
	LXI	DE,TBUFF	;POINT TO BEGINNING OF BUFFER.
;
;
;		MOVE THE TEXT TO THE BUFFER.
TRSCISGN: DS	0
	PUSH	DE		;SAVE BUFFER PTR.
	CALL	TRSCISGB	;GET THE NEXT BYTE.
	POP	DE		;RESTORE BUFFER PTR.
	RC			;...**EOF REACHED**
;
;		HANDLE SPECIAL CHARACTERS.
	CPI	009H		;**<TAB>**
	JNZ	TRSCIS03
	INX	DE		;BUMP OUTPUT PTR.
	MOV	A,E		;ALIGN TO 8 BYTE BOUNDARY.
	ANI	8-1
	JNZ	$-4
	JMP	TRSCISGN	;GO GET NEXT BYTE.
TRSCIS03:
	CPI	00DH		;**<CR> OR <EOL>**
	JNZ	TRSCIS04
	CALL	TRSCISGB	;GET TRAILING <LF>.
	RET
TRSCIS04:
	CPI	00AH		;**<LF> OR <EOL>**
	RZ
;
;		ADD CHARACTER TO BUFFER.
	STAX	DE
	INX	DE		;BUMP BUFFER PTR.
	JMP	TRSCISGN
;
;
;
;		* *  GET A BYTE  * *
TRSCISGB: DS	0
	LHLD	TRSBUFP		;POINT INTO CP/M BUFFER.
	LDA	TRSBUFA		;GET REMAINING # OF BYTES.
	CPI	0		;NEED A NEW BLOCK?
	JNZ	TRSCIS05	;...NO.
	CALL	TRSCISGT	;READ IT.
	RC			;...**EOF REACHED**
TRSCIS05:
;
;
	MOV	C,M		;GET THE NEXT BYTE.
	INX	HL		;BUMP BUFFER PTR.
	DCR	A		;DECR BUFFER COUNT.
	SHLD	TRSBUFP		;SAVE BUFFER PTR AND CNT.
	STA	TRSBUFA
	MOV	A,C
;
;
	CPI	01AH		;**LOGICAL EOF**
	JNZ	TRSCIS06
	STC
	RET
TRSCIS06:
	ORA	A		;RESET CY.
	RET
;
;
;
;		* *  GET A CP/M BLOCK  * *
TRSCISGT: DS	0
	CPM	CSTAT		;CHECK FOR SUSPEND.
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;SELECT THE DISK DRIVE.
	CPM	DDMA,DATA1	;SET FOR CP/M BUFFER.
	CPM	DRR,TRSFCB	;READ THE BLOCK.
	CPI	0
	JZ	TRSCIS07
	CPI	1
	JZ	TRSCIS08
	PRINT	<'*** CP/M READ ERROR ***',CR,LF>
	BUMP	TRSERR
TRSCIS08:
;				;** EOF REACHED **
	STC
TRSCIS07:
;		SET UP VARIABLES AND RETURN.
	LXI	HL,DATA1	;CURRENT BUFFER PTR
	SHLD	TRSBUFP
	MVI	A,128		;# OF BYTES REMAINING
	STA	TRSBUFA
	RET
;
;
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSFER 3740 TO CP/M (SOURCE)  * * *
;PURPOSE
;		THIS ROUTINE TRANSFERS A IBM DATASET TO A CP/M
;		SOURCE FILE ONE LINE AT A TIME.  LINES ARE ENDED
;		WITH <CR><LF> PAIRS AND OUTPUTTED CONTIGUOUSLY.
;		INITIALLY, THE OUTPUT BUFFER IS INITIALIZED TO    
;		01AH (LOGICAL EOF).  THEREFORE, ALL CONSTRAINTS
;		FOR A CP/M SOURCE FILE ARE MET.
;INPUT
;		CP/M DISK DRIVE
;		IBM DISK DRIVE
;		DATASET NAME
;OUTPUT
;		CP/M DATASET
;REMARKS
;		1.  IF THE DATASET WAS PREVIOUSLY CREATED ON THE CP/M
;		    DRIVE.  IT IS DELETED AND RE-ALLOCATED. 
;
;
;
;		DO INITIALIZATION.
TRSICSRC: DS	0
	PRINT	<'*** TRANSFER 3740 TO CP/M (SOURCE) ***',CR,LF>
	LXI	HL,0		;ZERO RECORD COUNT.
	SHLD	RCDCNT
	XRA	A		;ZERO ERROR COUNT.
	STA	TRSERR
;
;
;		GET INPUT AND OPEN FILES.
	CALL	TRSGETIN	;GET INPUT PARMS.
	MVI	A,0		;OPEN IBM FOR INPUT.
	LXI	HL,DATDSK1
	CALL	IBMOPEN
	JC	TRSICSEN	;...UNSUCCESSFUL.
	MVI	A,1		;OPEN CP/M FOR OUTPUT.
	CALL	CPMOPEN
	JC	TRSICSEN
	CALL	TRSICSIN	;INITIALIZE OUTPUT BUFFER.

;		GET BLOCK LENGTH OF IBM DATASET.
	MOVEA	TBUFF,DSBLK,5	;GET ASCII BLOCK LENGTH.
	DECIN	TBUFF,5		;CONVERT IT TO BINARY.
	XCHG			;SAVE IT.
	SHLD	BLKLEN

;		GET AN IBM BLOCK.
TRSICSLP: DS	0
	CPM	CSTAT		;CHECK FOR SUSPEND.
	CLC	DATTRK1,TDSEOD,2 ;END OF FILE?
	CMC
	JC	TRSICSOK	;...YES.
	CALL	REDDAT1		;GET THE BLOCK.
	INDEX	RCDCNT		;BUMP RECORD COUNT.

;		MOVE RECORD TO CP/M BUFFER.
	MOVEA	TBUFF,DATA1,BLKLEN

;		REMOVE TRAILING BLANKS.
	LXI	HL,TBUFF	;POINT TO BUFFER.
	LDA	BLKLEN		;GET BLOCK LENGTH - 1.
	DCR	A
	MOV	C,A		;SAVE IT.
	ADD	L		;POINT TO LAST BYTE.
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
TRSICS06:
	MOV	A,M		;GET A BYTE.
	CPI	' '		;BLANK?
	JNZ	TRSICS07	;...NO.
	DCX	HL		;TRY NEXT BYTE.
	DCR	C		;DECR COUNT.
	JNZ	TRSICS06
TRSICS07:
	MOV	A,C		;SAVE THE NEW LENGTH.
	INR	A		;MAKE IT RELATIVE TO ONE.
	STA	TWRKC3		;SAVE IT.

;		PUT THE RECORD TO CP/M.
	LXI	HL,TBUFF	;POINT TO BUFFER.
TRSICS00:
	LDA	TWRKC3		;** LOOP FOR FULL BUFFER **
	CPI	0
	JZ	TRSICS01
	MOV	A,M		;GET THE NEXT BYTE.
	CPI	' '		;BLANK?
	JNZ	TRSICS08	;...NO, PUT BYTE TO CP/M.
	MOV	A,L		;8-BYTE BOUNDARY?
	ANI	8-1
	CPI	8-1		;LAST BYTE ON BOUNDARY?
	JZ	TRSICS08-1	;YES, SKIP TAB COMPRESS.
	SUI	8		;GET REMAINING BYTES TO BOUNDARY.
	CMA
	MOV	C,A		;SAVE IT.
	MOV	B,A
	PUSH	HL		;SAVE HL.
TRSICS09:			;**CHECK IF REST OF BOUNDARY IS
;				;**BLANK.
	INX	HL
	MOV	A,M		;GET THE NEXT BYTE.
	CPI	' '		;IS IT A BLANK?
	JNZ	TRSICS08-2	;...NO, SKIP COMPRESSION.
	DCR	C		;DECR COUNT.
	JNZ	TRSICS09	;LOOP FOR ALL BYTES.
	POP	DE		;PUT PTR TO 8-BYTE BOUNDARY.
	LDA	TWRKC3		;ADJUST BYTE COUNT.
	SUB	B
	STA	TWRKC3
	MVI	A,009H		;OUTPUT A <TAB>.
	JMP	TRSICS08
	POP	HL
	MOV	A,M		;GET THE BYTE.
TRSICS08:
	INX	HL		;BUMP PTR.
	PUSH	HL		;SAVE IT.
	CALL	TRSICSPB	;ADD THE BYTE.
	POP	HL
	JC	TRSICSOK	;...** WRITE ERROR **
	BUMP	TWRKC3,-1	;DECR REMAINING COUNT.
	JMP	TRSICS00
TRSICS01:

;		ADD TRAILING CR,LF FOR CP/M.
	MVI	A,00DH		;ADD <CR>.
	CALL	TRSICSPB
	MVI	A,00AH		;ADD <LF>.
	CALL	TRSICSPB

;		BUMP TO NEXT IBM BLOCK.
	BUMP	DATSCT1		;BUMP SECTOR BY 1.
	CPI	26+1
	JC	TRSICSLP
	MVI	A,1		;SECTOR = 1
	STA	DATSCT1
	BUMP	DATTRK1
	JMP	TRSICSLP

;		CLOSE ALL FILES.
TRSICSOK: DS	0
	CALL	TRSICSPT	;PUT THE LAST BLOCK.
	MVI	A,0		;IBM FILE.
	LXI	HL,DATTRK1
	CALL	IBMCLOSE
	MVI	A,1		;CP/M FILE.
	CALL	CPMCLOSE

;		RETURN TO CALLER.
TRSICSEN: DS	0
	DECOUT	RCDCNT		;DISPLAY RECORDS XFERED.
	PRINT	<' RECORDS TRANSFERRED.',CR,LF>
	LDA	TRSERR
	CPI	0
	JNZ	TRSICS02
	PRINT	<'*** TRANSFER SUCCESSFUL ***',CR,LF>
	JMP	TRSICS03
TRSICS02:
	PRINT	<'*** TRANSFER NOT COMPLETED ***',CR,LF>
	PRINT	<'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSICS03:
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET


;		* *  PUT A BYTE TO CP/M FILE  * *

;		PUT BYTE IN BUFFER.
TRSICSPB: DS	0
	LHLD	TRSBUFP		;GET BUFFER POINTER.
	MOV	M,A		;ADD THE BYTE.
	INX	HL		;BUMP BUFFER PTR.
	SHLD	TRSBUFP		;SAVE IT.

;		IF FULL BUFFER, WRITE IT OUT.
	BUMP	TRSBUFA,-1	;DECR REMAINING BYTE CNT.
	LDA	TRSBUFA
	CPI	0		;** FULL BUFFER **
	JNZ	TRSICS04
	CALL	TRSICSPT	;ADD THE RECORD.
	RC			;...** WRITE ERROR **
	CALL	TRSICSIN	;INITIALIZE BUFFER.
TRSICS04:

;		RETURN TO CALLER.
	ORA	A
	RET

;		* *  WRITE CP/M BLOCK  * *
TRSICSPT: DS	0
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;SELECT DISK DRIVE.
	CPM	DDMA,DATA2
	CPM	DWR,TRSFCB
	CPI	0		;WRITE ERROR?
	JZ	TRSICS05	;...NO.
	PRINT	<'*** CP/M WRITE ERROR ***',CR,LF>
	BUMP	TRSERR
	STC			;INDICATE ERROR.
	RET
TRSICS05:
	ORA	A
	RET

;		* *  INITIALIZE OUTPUT BUFFER  * *
TRSICSIN: DS	0
	FILL	DATA2,128,01AH	;INITIALIZE BUFFER TO LOGICAL EOF.
	LXI	HL,DATA2	;RESET BUFFER PTR.
	SHLD	TRSBUFP
	MVI	A,128		;RESET REMAINING BYTE COUNT.
	STA	TRSBUFA
	RET



$+PRINT
$+PRINT
;		* * *  DISPLAY AN IBM DATASET  * * *
;PURPOSE
;		THIS ROUTINE DISPLAYS THE CONTENTS OF A PARTICULAR
;		IBM DATASET TO THE USER.  NOTE THAT ALL RECORDS
;		ARE DISPLAYED.
;INPUT
;		IBM DISK DRIVE
;		IBM EIGHT-BYTE DATASET NAME
;OUTPUT
;		THE CONTENTS OF THE FILE ARE LISTED ON THE SCREEN.
;REMARKS
;
;
;
;		DO INITIALIZATION.
DSPIBMDS: DS	0
	PRINT	<'*** DISPLAY AN IBM DATASET ***',CR,LF>
	LXI	HL,0		;ZERO RECORD COUNT.
	SHLD	RCDCNT
	XRA	A		;ZERO ERROR COUNT.
	STA	TRSERR
;
;
;		GET IBM DISK DRIVE.
	PRINT	<'(IBM) '>
	CALL	INPDSKNO	;GET IT.
	STA	IBMDSKNO	;SAVE IT.
;
;
;		GET DATASET NAME.
DSPIBMDD: DS	0
	INPUT	'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
	PRINT
	LDA	TBUFF+1		;CHECK FOR 1-8 CHARS.
	CPI	1
	JC	DSPIBMDB
	CPI	8+1
	JC	DSPIBMDG
DSPIBMDB: DS	0
	PRINT	<'*** INVALID REPLY ***',CR,LF>
	JMP	DSPIBMDD
DSPIBMDG: DS	0
	FILL	TDSN,8,020H	;INITIALIZE DATASET NAME.
	MVC	TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
;
;
;		GET INPUT FILE.
	MVI	A,0		;OPEN IBM FOR INPUT.
	LXI	HL,DATDSK1
	CALL	IBMOPEN
	JC	DSPIBMD1	;...UNSUCCESSFUL.
;
;
;		GET BLOCK LENGTH OF IBM DATASET.
	MOVEA	TBUFF,DSBLK,5	;GET ASCII BLOCK LENGTH.
	DECIN	TBUFF,5		;CONVERT IT TO BINARY.
	XCHG			;SAVE IT.
	SHLD	BLKLEN
;
;
;		GET AN IBM BLOCK.
DSPIBMDL: DS	0
	CPM	CSTAT		;CHECK FOR SUSPEND.
	CLC	DATTRK1,TDSEOD,2 ;END OF FILE?
	CMC
	JC	DSPIBMD2	;...YES.
	CALL	REDDAT1		;GET THE BLOCK.
	INDEX	RCDCNT		;BUMP RECORD COUNT.
;
;
;		PRINT 80 CHARS OF INFO.
	MVI	C,80		;SET COUNTER.
	LXI	HL,DATA1	;POINT TO DATA.
DSPIBMRL: DS	0
	MOV	A,M		;GET A CHAR.
	CALL	TRNEBAS		;TRANSLATE IT TO ASCII.
	CALL	OUTTRN		;REMOVE NON-PRINTABLE CHARS.
	PUSH	BC		;SAVE REGS.
	CPM	CWRITE,,??	;PUT THE CHAR.
	POP	BC		;RESTORE REGS.
	INX	HL		;BUMP CHAR PTR.
	DCR	C		;LOOP FOR ALL CHARS.
	JNZ	DSPIBMRL
;
;
;		BUMP TO NEXT IBM BLOCK.
	BUMP	DATSCT1		;BUMP SECTOR BY 1.
	CPI	26+1
	JC	DSPIBMDL
	MVI	A,1		;SECTOR = 1
	STA	DATSCT1
	BUMP	DATTRK1
	JMP	DSPIBMDL
;
;
;		CLOSE ALL FILES.
DSPIBMD2: DS	0
	MVI	A,0		;IBM FILE.
	LXI	HL,DATTRK1
	CALL	IBMCLOSE
;
;
;		RETURN TO CALLER.
DSPIBMD1: DS	0
	DECOUT	RCDCNT		;DISPLAY RECORDS XFERED.
	PRINT	<' RECORDS DISPLAYED.',CR,LF>
	LDA	TRSERR
	CPI	0
	JNZ	DSPIBM01
	PRINT	<'*** DISPLAY SUCCESSFUL ***',CR,LF>
	JMP	DSPIBM02
DSPIBM01: DS	0
	PRINT	<'*** ERROR DURING DISPLAY ***',CR,LF>
DSPIBM02: DS	0
	INPUT	'PRESS <ENTER> TO CONTINUE.',TBUFF
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  GET TRANSFER INPUT  * * *
;PURPOSE
;		THIS ROUTINE QUIRIES THE OPERATOR FOR THE
;		CP/M DRIVE, IBM DRIVE AND EIGHT-BYTE DATASET
;		NAME TO BE USED IN THE TRANSFERS.
;INPUT
;		CP/M DISK DRIVE
;		IBM DISK DRIVE
;		EIGHT BYTE DATASET NAME
;OUTPUT
;		CPMDSKNO CONTAINS THE CP/M DISK DRIVE.
;		IBMDSKNO CONTAINS THE IBM DISK DRIVE.
;		TDSN CONTAINS THE EIGHT-BYTE DATASET NAME.
;REMARKS
;
;
;
;		DO INITIALIZATION.
TRSGETIN: DS	0
;
;
;		GET CP/M DISK DRIVE.
TRSGETCD: DS	0
	PRINT	<'(CP/M) '>
	CALL	INPDSKNO	;GET IT.
	STA	CPMDSKNO	;SAVE IT.
;
;
;		GET IBM DISK DRIVE.
	PRINT	<'(IBM) '>
	CALL	INPDSKNO	;GET IT.
	STA	IBMDSKNO	;SAVE IT.
;
;
;		INSURE IBM DRIVE IS SEPERATE FROM CP/M DRIVE.
	LDA	IBMDSKNO
	MOV	C,A
	LDA	CPMDSKNO
	JNZ	TRSGETD
	PRINT	<'*** IBM AND CP/M DRIVES MUST BE DIFFERENT. ***',CR,LF>
	PRINT	<'*** PLEASE RE-ENTER. ***',CR,LF>
	JMP	TRSGETCD
;
;
;		GET DATASET NAME.
TRSGETD: DS	0
	INPUT	'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
	PRINT
	LDA	TBUFF+1		;CHECK FOR 1-8 CHARS.
	CPI	1
	JC	TRSGETDB
	CPI	8+1
	JC	TRSGETDG
TRSGETDB: DS	0
	PRINT	<'*** INVALID REPLY ***',CR,LF>
	JMP	TRSGETD
TRSGETDG: DS	0
	FILL	TDSN,8,020H	;INITIALIZE DATASET NAME.
	MVC	TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  OPEN A CP/M FILE  * * *
;PURPOSE
;		THIS ROUTINE OPENS THE CP/M INPUT/OUTPUT
;		FILE WITH THE APPROPRIATE HOUSEKEEPING.
;INPUT
;		A=0 (OPEN INPUT)
;		A=1 (OPEN OUTPUT)
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
CPMOPEN: DS	0
	SAVE
	PUSH	PSW		;SAVE INPUT/OUTPUT INDICATOR.
	MVI	A,0		;RESET ERROR INDICATOR.
	STA	TRSERR

;		SELECT THE DISK DRIVE.
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;COORDINATE BIOS.
	CPM	DDMA,TBUFF	;SET DMA TO DEFAULT BUFFER.
	CPM	DSD,,CPMDSKNO	;ISSUE LOGIN FOR DISK.
;
;
;		SET UP CP/M FCB.
	FILL	TRSFCB,33,000H
	MVC	TRSFCB+FCBFN,TDSN,8
	MVC	TRSFCB+FCBFT,'DAT'
;
;
;		IF OUTPUT, CREATE FILE.
	POP	PSW
	CPI	1
	JNZ	CPMOPEN00
	CPM	DDF,TRSFCB	;DELETE IT FIRST.
	CPM	DCRF,TRSFCB	;CREATE IT.
	CPI	255		;UNSUCCESSFUL?
	JNZ	CPMOPEN00
	PRINT	<'*** CP/M OUTPUT FILE DIRECTORY FULL ***',CR,LF>
	BUMP	TRSERR
CPMOPEN00:
;
;
;		OPEN THE FILE.
	CPM	DOF,TRSFCB	;ISSUE OPEN.
	CPI	255
	JNZ	CPMOPEN01
	PRINT	<'*** CP/M FILE OPEN FAILURE ***',CR,LF>
	BUMP	TRSERR
CPMOPEN01:
;
;
;		RETURN TO CALLER.
	RESTORE
	LDA	TRSERR		;GET ERROR COUNT.
	ORA	A		;RESET CY.
	RZ			;...RETURN, NO ERROR.
	STC
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  CLOSE A CP/M FILE  * * *
;PURPOSE
;		THIS ROUTINE CLOSES A CP/M FILE WITH THE
;		APPROPRIATE HOUSEKEEPING.
;INPUT
;		A=0 (CLOSE INPUT)
;		A=1 (CLOSE OUTPUT)
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
CPMCLOSE: DS	0
	SAVE			;SAVE REGS.
	MVI	A,0		;RESET ERROR INDICATOR.
	STA	TRSERR

;		SELECT THE DISK DRIVE.
	CPM	DRINT		;GET CP/M CURRENT DRIVE.
	SELDSK			;COORDINATE BIOS.
	CPM	DDMA,TBUFF	;SET DMA FOR DEFAULT BUFFER.

;		CLOSE THE FILE.
	CPM	DCF,TRSFCB	;ISSUE CLOSE.
	CPI	255		;UNSUCCESSFUL
	JNZ	CPMCLOS0
	PRINT	<'*** CP/M CLOSE FAILURE ***',CR,LF>
	BUMP	TRSERR
CPMCLOS0:

;		RETURN TO CALLER.
	RESTORE			;RESTORE REGS.
	LDA	TRSERR
	ORA	A		;RESET CY.
	RZ
	STC
	RET



$+PRINT
$+PRINT
;		* * *  CLOSE AN IBM FILE  * * *
;PURPOSE
;		THIS ROUTINE OPENS AN IBM FILE WITH THE
;		APPROPRIATE HOUSEKEEPING.
;INPUT
;		A = 0 - INPUT FILE
;		    1 - OUTPUT FILE
;		HL => INTERNAL DATA SECTOR
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
IBMCLOSE: DS	0
	SAVE			;SAVE REGS.
	PUSH	PSW
	MVI	A,0		;ZERO ERROR INDICATOR.
	STA	TRSERR
	POP	PSW
	CPI	1		;SKIP IF NOT OUTPUT.
	JNZ	IBMCLSEN
;
;
;		DSEOD = DATA TRK/SCT
	MOV	D,M		;GET TRK.
	INX	HL
	MOV	E,M		;GET SCT.
	LXI	HL,TBUFF	;CONVERT TO EXTERNAL.
	CALL	OUTTRSAD
	MOVAE	DSEOD,TBUFF,5	;CONVERT TO EBCDIC.
;
;
;		REWRITE THE DIRECTORY ENTRY.
	LDA	DIRSCT		;GET THE SECTOR.
	CALL	WRTDIR		;WRITE IT OUT.
;
;
;		RETURN TO CALLER.
IBMCLSEN: DS	0
	RESTORE			;RESTORE REGS.
	LDA	TRSERR		;IF ERROR, CY:ON.
	CPI	0
	RZ
	STC
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* * *  OPEN AN IBM FILE  * * *
;PURPOSE
;		THIS ROUTINE OPENS AN IBM FILE WITH
;		THE APPROPRIATE HOUSEKEEPING.
;INPUT
;		A=0 (OPEN INPUT)
;		A=1 (OPEN OUTPUT)
;		HL <= TRK/SCT AREA (2 BYTES)
;OUTPUT
;		TRK/SCT AREA = DSEOD
;REMARKS
;
;
;
;		DO INITIALIZATION.
IBMOPEN: DS	0
	SAVE			;SAVE REGS.
	PUSH	PSW
	MVI	A,0		;ZERO ERROR INDICATOR.
	STA	TRSERR
	POP	PSW

;		ZERO BUFFER HEADER.
	XRA	A
	MOV	M,A
	INX	HL
	MOV	M,A
	INX	HL
	MOV	M,A
	DCX	HL		;RESET PTR.
	DCX	HL

;		GET IBM DISK DRIVE.
	LDA	IBMDSKNO	;DIRDSK.
	MOV	M,A		;SAVE IN DATA AREA.
	INX	HL
	PUSH	HL
	STA	DIRDSK

;		SCAN IBM DISK DRIVE FOR DATASET.
	MVI	A,8		;SET FOR FIRST DIR ENTRY.
	STA	DIRSCT
IBMOPEN00: DS	0
	LDA	DIRSCT
	CPI	26+1
	JNC	IBMOPEN01
	CALL	REDDIR		;READ THE DIRECTORY.
	MOVEA	TBUFF,DSID,8	;COMPARE DATASET NAMES.
	CLC	TBUFF,TDSN,8
	JZ	IBMOPNFD	;...FOUND IT.
	BUMP	DIRSCT
	JMP	IBMOPEN00
IBMOPEN01: DS	0
	PRINT	<'*** IBM DATASET NOT FOUND ***',CR,LF>
	BUMP	TRSERR
	POP	PSW
	JMP	IBMOPNEN
IBMOPNFD: DS	0

;		GET BEGINNING OF EXTENT.
	MOVEA	TBUFF,DSBOE,5
	LXI	HL,TBUFF	;CONVERT TO BINARY.
	CALL	VERTRSAD
	JNC	IBMOPNGB
	PRINT	<'*** IBM BAD BOE FOUND ***',CR,LF>
	BUMP	TRSERR
IBMOPNGB: DS	0
	MOV	A,H		;SAVE IT.
	MOV	H,L
	MOV	L,A
	SHLD	TDSBOE

;		GET END OF EXTENT.
	MOVEA	TBUFF,DSEOE,5
	LXI	HL,TBUFF	;CONVERT TO BINARY.
	CALL	VERTRSAD
	JNC	IBMOPNGE
	PRINT	<'*** IBM BAD EOE FOUND ***',CR,LF>
	BUMP	TRSERR
IBMOPNGE: DS	0
	MOV	A,H		;SAVE IT.
	MOV	H,L
	MOV	L,A
	SHLD	TDSEOE

;		GET END OF DATA.
	MOVEA	TBUFF,DSEOD,5
	LXI	HL,TBUFF	;CONVERT TO BINARY.
	CALL	VERTRSAD
	JNC	IBMOPNGD
	PRINT	<'*** IBM BAD EOD FOUND ***',CR,LF>
	BUMP	TRSERR
IBMOPNGD: DS	0
	MOV	A,H		;SAVE IT.
	MOV	H,L
	MOV	L,A
	SHLD	TDSEOD

;		DATA TRK/SCT = BOE
	POP	HL
	XCHG
	MVC	<>,TDSBOE,2

;		RETURN TO CALLER.
IBMOPNEN: DS	0
	RESTORE			;RESTORE REGS.
	LDA	TRSERR		;IF ERROR, CY:ON.
	ORA	A
	RZ
	STC
	RET



$+PRINT
$+PRINT
;		* *  INPUT DISK DRIVE NUMBER  * *
;PURPOSE	THIS ROUTINE INPUTS A DISK DRIVE NUMBER
;		AND VERIFIES IT.
;INPUT		NONE
;OUTPUT		A = DRIVE NO (0-3)
;
;
;		DO INITIALIZATION.
INPDSKNO: DS	0
	SAVE	BC,DE,HL
;
;		REQUEST DRIVE NO.
INPDSKL: DS	0
	INPUT	'ENTER DISK DRIVE (A-D): ',TBUFF
	PRINT	<CR,LF>
;
;		VERIFY INPUT.
	LDA	TBUFF+1		;IF INPUT LEN <>1 THEN ERR.
	CPI	1
	JNZ	INPDSKER
	LDA	TBUFF+2		;VERIFY A-D.
	CPI	'A'
	JC	INPDSKER
	CPI	'D'+1
	JNC	INPDSKER
;
;		RETURN TO CALLER WITH ANSWER.
	SUI	'A'		;MAKE RELATIVE TO ZERO.
	RESTORE HL,DE,BC
	RET
;
;		ERROR - RETRY.
INPDSKER: DS	0
	PRINT	<'***INVALID REPLY***',CR,LF>
	JMP	INPDSKL
;
;
;
;
$+PRINT
$+PRINT
;		* *  INPUT DIRECTORY ENTRY  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;		1.  INSURE THAT THE FIELDS ARE ENTERED IN THE SAME
;		    SEQUENCE AS THE FIELDS ARE PRINTED IN 'PRTDIR'.
;
;
;
;		DO INITIALIZATION.
INPDIR:	DS	0
	SAVE			;SAVE REGS.
;
;
;		ENTER DATSET ID.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER DATASET ID: ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPIDB
	CPI	8+1
	JNC	INPERR
	FILL	DSID,8,040H	;MOVE SPACES TO FIELD.
	MOVAE	DSID,TBUFF+2,TBUFF+1
INPIDB:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		ENTER LOGICAL RECORD LENGTH.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER LOGICAL RECORD LENGTH (NNNNN): ',TBUFF
	PRINT
	LDA	TBUFF+1		;CHECK FOR PROPER LENGTH.
	ORA	A		;...SKIP IF NO ENTRY.
	JZ	INPLRC
	CPI	5	
	JNZ	INPERR		;...INVALID
	DECIN	TBUFF+2,5	;CONVERT TO INTERNAL FORMAT.
	JC	INPERR		;...INVALID
	MOV	A,E		;GET VALUE.
	CPI	1		;RANGE CHECK (1-128).
	JC	INPERR
	CPI	128+1
	JNC	INPERR
	MOVAE	DSBLK,TBUFF+2,5 ;MOVE IT TO DIR BUFFER.
INPLRC: POP	HL		;RESET STACK FOR NEXT INPUT.
;
;
;		ENTER BEGINNING OF EXTENT.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	PRINT	<'(BEGINNING OF EXTENT) '>
	CALL	INPTRSAD	;GET TT0SS FOR BOE.
	JC	INPERR		;...INVALID INPUT.
	LDA	TBUFF+1		;CHECK IF INPUT GIVEN.
	ORA	A
	JZ	INPBOE
	MOVAE	DSBOE,TBUFF+2,5 ;MOVE IT IN PLACE.
INPBOE: POP	HL
;
;
;		ENTER END OF EXTENT.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	PRINT	<'(END OF EXTENT) '>
	CALL	INPTRSAD	;GET TT0SS FOR BOE.
	JC	INPERR		;...INVALID INPUT.
	LDA	TBUFF+1		;CHECK IF INPUT GIVEN.
	ORA	A
	JZ	INPEOE
	MOVAE	DSEOE,TBUFF+2,5 ;MOVE IT IN PLACE.
INPEOE: POP	HL
;
;
;		ENTER END OF DATA.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	PRINT	<'(END OF DATA) '>
	CALL	INPTRSAD	;GET TT0SS FOR BOE.
	JC	INPERR		;...INVALID INPUT.
	LDA	TBUFF+1		;CHECK IF INPUT GIVEN.
	ORA	A
	JZ	INPEOD
	MOVAE	DSEOD,TBUFF+2,5 ;MOVE IT IN PLACE.
INPEOD: POP	HL
;
;
;		ENTER CREATION DATE.
;
;
;		ENTER EXPIRATION DATE.
;
;
;		ENTER MULTI-VOLUME IND.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER MULTI-VOLUME IND (C, L, OR BLANK): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPMVIB
	JNZ	INPERR
	LDA	TBUFF+2		;GET CHAR INPUTTED.
	CPI	'C'		;MUST BE C, L, OR BLANK.
	JZ	$+13
	CPI	'L'
	JZ	$+8
	CPI	' '
	JNZ	INPERR
	CALL	TRNASEB		;MAKE IT EBCDIC.
	STA	DSMVI		;SAVE IT.
INPMVIB:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		ENTER VOLUME SEQUENCE NUMBER.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER VOLUME SEQUENCE NUMBER (NN): ',TBUFF
	PRINT
	LDA	TBUFF+1		;CHECK FOR PROPER LENGTH.
	ORA	A		;...SKIP IF NO ENTRY.
	JZ	INPVLS
	CPI	2	
	JNZ	INPERR		;...INVALID
	DECIN	TBUFF+2,2	;CONVERT TO INTERNAL FORMAT.
	JC	INPERR		;...INVALID
	MOV	A,E		;GET VALUE.
	CPI	1		;RANGE CHECK (1-99).
	JC	INPERR
	CPI	99+1
	JNC	INPERR
	MOVAE	DSVLSQ,TBUFF+2,2 ;MOVE IT TO DIR BUFFER.
INPVLS: POP	HL		;RESET STACK FOR NEXT INPUT.
;
;
;		ENTER BYPASS IND.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER BYPASS IND (B OR BLANK): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPBYPIB
	JNZ	INPERR
	LDA	TBUFF+2
	CPI	'B'
	JZ	$+8
	CPI	' '
	JNZ	INPERR
	CALL	TRNASEB		;MAKE IT EBCDIC.
	STA	DSBYPI		;SAVE IT.
INPBYPIB:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		ENTER SECURITY IND.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER SECURITY IND (NON-BLANK OR BLANK): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPSSP
	JNZ	INPERR
	LDA	TBUFF+2
	CALL	TRNASEB		;MAKE IT EBCDIC.
	STA	DSSS		;SAVE IT.
INPSSP:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		ENTER WRITE PROTECT IND.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER WRITE PROTECT IND (P OR BLANK): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPWPB
	JNZ	INPERR
	LDA	TBUFF+2
	CPI	'P'
	JZ	$+8
	CPI	' '
	JNZ	INPERR
	CALL	TRNASEB		;MAKE IT EBCDIC.
	STA	DSWP		;SAVE IT.
INPWPB:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		ENTER VERIFY/COPY IND.
	LXI	HL,$		;SET FOR ERROR.
	PUSH	HL
	INPUT	'ENTER VERIFY/COPY IND (C, V, OR BLANK): ',TBUFF
	PRINT
	LDA	TBUFF+1		;VERIFY LEN (1-8).
	CPI	1
	JC	INPVCIB
	JNZ	INPERR
	LDA	TBUFF+2
	CPI	'C'
	JZ	$+13
	CPI	'V'
	JZ	$+8
	CPI	' '
	JNZ	INPERR
	CALL	TRNASEB		;MAKE IT EBCDIC.
	STA	DSVCI		;SAVE IT.
INPVCIB:	POP	HL		;RESET STACK FOR NEXT INP.
;
;
;		RETURN TO CALLER.
	RESTORE
	RET
;
;
;		ISSUE ERROR MESSAGE.
INPERR:	DS	0
	PRINT	<'***INVALID REPLY***',CR,LF>
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  INPUT SECTOR NUMBER  * *
;PURPOSE	THIS ROUTINE INPUTS A SECTOR NUMBER
;		AND VERIFIES IT.
;INPUT		NONE
;OUTPUT
;		A = SECTOR NUMBER (8-26)
;
;
;		DO INITIALIZATION.
INPSCTNO: DS	0
	SAVE	BC,DE,HL
;
;		REQUEST SECTOR NO.
INPSCTL: DS	0
	INPUT	'ENTER SECTOR NUMBER (8-26): ',TBUFF
	PRINT
;
;		VERIFY INPUT.
	LDA	TBUFF+1		;IF INPUT LEN <1 THEN ERR.
	CPI	1
	JC	INPSCTER
	CPI	2+1		;IF INPUT LEN > 2, THEN ERR.
	JNC	INPSCTER
	DECIN	TBUFF+2,TBUFF+1
	JC	INPSCTER	;...CONVERSION ERROR.
	MOV	A,E
	CPI	8		;IF <8 THEN
	JC	INPSCTER	;   ERROR.
	CPI	26+1		;IF >26 THEN
	JNC	INPSCTER	;...ERROR.
;
;		RETURN TO CALLER WITH ANSWER.
	RESTORE HL,DE,BC
	RET
;
;		ERROR - RETRY.
INPSCTER: DS	0
	PRINT	<'***INVALID REPLY***',CR,LF>
	JMP	INPSCTL
;
;
;
;
$+PRINT
$+PRINT
;		* *  INPUT TRACK/SECTOR NUMBER  * *
;PURPOSE
;INPUT
;OUTPUT
;		H = TRACK NUMBER
;		L = SECTOR NUMBER
;REMARKS
;
;
;
;		DO INITIALIZATION.
INPTRSAD: DS	0
;
;
;		GET THE DATA TRACK/SECTOR.
INPTRSL: DS	0
	INPUT	'ENTER TRACK/SECTOR (TT0SS): ',TBUFF
	PRINT
;
;
;		VERIFY AND CONVERT INPUT.
	LDA	TBUFF+1		;IF INPUT LENGTH <> 5, THEN ERROR.
	ORA	A		;CHECK FOR INPUT GIVEN OR NOT.
	JZ	INPTRSOK	;...NO.
	CPI	5
	JNZ	INPTRSER
;
	LXI	HL,TBUFF+2	;VERIFY CONTENTS.
	CALL	VERTRSAD
	JC	INPTRSER	;...INVALID.
;
;
;		RETURN TO CALLER.
INPTRSOK: DS	0
	ORA	A		;RESET CARRY.
	RET
;
;
;		HANDLE INPUT ERROR.
INPTRSER: DS	0
	STC			;SET CARRY.
	RET
;
;
;
$+PRINT
$+PRINT
;		* *  OUTPUT DATA TRACK/SECTOR  * *
;PURPOSE
;INPUT
;		D = TRACK NUMBER
;		E = SECTOR NUMBER
;		HL <= 5 BYTE TRACK/SECTOR (TT0SS)
;OUTPUT
;		SAME AS INPUT   
;REMARKS
;
;
;		DO INITIALIZATION.
OUTTRSAD: DS	0
	SAVE			;SAVE REGS.
;
;
;		OUTPUT THE TRACK.
	MOV	A,D		;SET FOR CALL.        .
	CALL	OUTTRSSB	;DO IT.
;
;
;		OUTPUT THE '0'.
	MVI	M,'0'
	INX	HL
;
;
;		OUTPUT THE SECTOR.
	MOV	A,E		;SET FOR CALL
	CALL	OUTTRSSB	;DO IT.
;
;
;		RETURN TO CALLER.
	RESTORE			;RESTORE REGS.
	RET
;
;
;		OUTPUT A TRACK/SECTOR ADDRESS.
OUTTRSSB: DS	0
	PUSH	DE		;SAVE TRK/SCT.
	PUSH	HL		;SAVE OUTPUT PTR.
	BAU8	TWRKC3		;CONVERT TO ASCII.
	POP	HL		;RESTORE OUTPUT PTR.
	XCHG			;DE <= OUTPUT
	MVC	<>,TWRKC3+1,2	;GET TRK/SCT.
	XCHG
	POP	DE		;RESTORE TRK/SCT.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  VERIFY DATA TRACK/SECTOR  * *
;PURPOSE
;INPUT
;		HL <= 5 BYTE TRACK/SECTOR (TT0SS)
;OUTPUT
;		H = TRACK NUMBER
;		L = SECTOR NUMBER
;REMARKS
;
;
;		DO INITIALIZATION.
VERTRSAD: DS	0
;
;
;		VERIFY THE TRACK.
	DECIN	,2		;CONVERT IT TO DECIMAL.
	JC	VERTRSER	;...INVALID.
	CPI	1		;RANGE CHECK (1-74)
	JC	VERTRSER
	CPI	74+1
	CMC
	JC	VERTRSER
	STA	VERTRSTK	;SAVE IT.
;
;
;		VERIFY THE SECTOR NUMBER.
	DECIN	,3		;CONVERT IT TO DECIMAL.
	JC	VERTRSER	;...INVALID.
	CPI	1		;RANGE CHECK (1-26).
	JC	VERTRSER
	CPI	26+1
	CMC
	JC	VERTRSER
;
;
;		RETURN TO CALLER.
	LDA	VERTRSTK	;PUT TRACK NUMBER IN H.
	MOV	D,A
	XCHG			;HL = TRK/SCT
	ORA	A		;RESET CARRY.
	RET
;
;
;		HANDLE ERROR.
VERTRSER: DS	0
	RET
;
;
;		CONSTANTS AND VARIABLES.
VERTRSTK: DS	1		;TRACK NUMBER SAVE AREA
;
;
;
$+PRINT
$+PRINT
;		* *  VERIFY IBM DISK  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
VERIBMD: DS	0
	SAVE		;SAVE REGS.
;
;
;		READ THE VOLSER SECTOR.
	MVI	A,7		;READ SECTOR 7.
	CALL	REDDIR
;
;
;		VERIFY 'VOL1' ID.
	MOVEA	TBUFF,DSHD,4	;VERIFY VOL1 CONSTANT.
	CLC	TBUFF,CVOL1,4
	JZ	VERIBMDE	;...OK.
	PRINT	<'*** DISK VOLUME SERIAL NUMBER NOT FOUND ***',CR,LF>
	STC			;...ERROR.
;
;
;		RETURN TO CALLER.
VERIBMDE: DS	0
	RESTORE
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  VERIFY SECTOR NUMBER  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
VERPTR: DS	0
;
;
;		RIGHT JUSTIFY INPUT.
	FILL	PTRIN,5,'0'	;DEFAULT TO ALL ZEROES.
	LDA	TBUFF+1		;GET INPUT LENGTH.
	CPI	1		;VERFIY LENGTH IS 1-5.
	JC	PTRNONE
	CPI	5+1
	CMC
	RC
	MOV	C,A		;SAVE IT.
	LXI	DE,PTRIN+4	;MOVE DESCENDING.
	LXI	HL,TBUFF+2
	ADDHA
	DCX	HL
	MOV	A,M		;DO THE MOVE.
	STAX	DE
	DCX	HL
	DCX	DE
	DCR	C
	JNZ	$-5
;
;
;		VERIFY THE TRACK.
	DECIN	PTRIN,2
	RC			;...ERROR.
	MOV	A,E
	CPI	76+1
	CMC
	RC			;...ERROR.
;
;
;		VERIFY '0'.
	LDA	PTRIN+2
	CPI	'0'
	STC
	RNZ
;
;
;		VERIFY SECTOR AND RETURN.
	DECIN	PTRIN+3,2
	RC			;...ERROR.
	MOV	A,E
	CPI	1		;RANGE CHECK 1-26.
	RC
	CPI	26+1
	CMC
	RET
;
;
;		RETURN W/O VERIFY.
PTRNONE: DS	0
	MVI	A,1		;RESET CY BUT KEEP NZ.
	ORA	A
	RET
;
;
;		AREAS USED
PTRIN:	DS	5		;TRK/SCT PTR
;
;
;
;
$+PRINT
$+PRINT
;		* *  PRINT DIRECTORY ENTRY  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
PRTDIR:	DS	0
	SAVE			;SAVE REGS.
;
;
;		PRINT FIELDS.
	PRNTEAF	'DATASET NAME = ',DSID,8
	LDA	DSHD
	CPI	0C4H
	JNZ	PRTDIR00
	PRINT	<'    * * * DELETED * * *',CR,LF>
PRTDIR00:
	PRNTEAF	'LRECL = ',DSBLK,5
	PRNTEAF	'BOE = ',DSBOE,5
	PRNTEAF	'EOE = ',DSEOE,5
	PRNTEAF	'EOD = ',DSEOD,5
	PRNTEAF	'CREDT = ',DSCREDT,6
	PRNTEAF	'EXPDT = ',DSEXPDT,6
	PRNTEAF	'MULTI-VOLUME IND = ',DSMVI,1
	PRNTEAF	'VOL SEQ IND = ',DSVLSQ,2
	PRNTEAF	'BYPASS IND = ',DSBYPI,1
	PRNTEAF 'SECURE IND = ',DSSS,1
	PRNTEAF	'WRITE PROTECT IND = ',DSWP,1
	PRNTEAF	'VERIFY/COPY IND = ',DSVCI,1
;
;
;		RETURN TO CALLER.
	RESTORE			;RESTORE REGS.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  DEFAULT DIR BUF DATA  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;		DO INITIALIZATION.
DFTDIR:	DS	0
	STA	DIRSCT
;
;
;		INITIALIZE BUFFER.
	FILL	DIRBUF,80,040H		;EBCDIC SPACES
	FILL	DIRBUF+80,48,000H
	MOVAE	DSHD,CHDR1,4		;DDR1
	MOVAE	DSID,CDSIDD,4		;DATA
	LXI	HL,CSCTNO		;SECTOR NUMBER
	LDA	DIRSCT
	SUI	8
	ADD	A
	ADDHA
	MOVAE	DSID+4,,2
	MOVAE	DSBLK,CLRL80,5		;00080
	MOVAE	DSBOE,CSPRTRK,5		;74001
	MOVAE	DSEOE,CHGHTRK,5		;73026
	MOVAE	DSEOD,CSPRTRK,5		;74001
;
;
;		SET BOE,EOE,EOD FOR SECTOR 8.
	LDA	DIRSCT
	CPI	8
	JNZ	DFTDIR00
	MVI	A,'H'			;HDR1
	CALL	TRNASEB
	STA	DSHD
	MOVAE	DSBOE,CLOWTRK,5		;01001
	MOVAE	DSEOD,CLOWTRK,5		;01001
DFTDIR00:
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  READ A DIRECTORY SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
REDDIR:	DS	0
	STA	DIRSCT		;SAVE SECTOR NUMBER.
	XRA	A		;SET TRKNO = 0.
	STA	DIRTRK
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DIRDSK		;SELECT THE DISK.
	IF	NBIOS
	LDA	DIRDSK		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DIRTRK		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DIRSCT		;READ THE SECTOR
	MOV	C,A
	LXI	H,DIRBUF	;INTO DIRBUF.
	CALL	BIOSRED
	ENDIF
	IF DMA$BIOS
	SETTRK	DIRTRK		;SET THE TRACK NO.
	SETSEC	DIRSCT		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DIRBUF	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD		;READ THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DIRTRK		;SET THE TRACK NO.
	SETSEC	DIRSCT		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DIRBUF	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD		;READ THE SECTOR.
	ENDIF

;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  WRITE A DIRECTORY SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
WRTDIR:	DS	0
	STA	DIRSCT		;SAVE SECTOR NUMBER.
	XRA	A		;SET TRKNO = 0.
	STA	DIRTRK
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DIRDSK		;SELECT THE DISK.
	IF	NBIOS
	LDA	DIRDSK		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DIRTRK		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DIRSCT		;WRITE THE SECTOR
	MOV	C,A
	LXI	H,DIRBUF	;FROM DIRBUF.
	CALL	BIOSWRT
	ENDIF
	IF DMA$BIOS
	SETTRK	DIRTRK		;SET THE TRACK NO.
	SETSEC	DIRSCT		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DIRBUF	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;READ THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DIRTRK		;SET THE TRACK NO.
	SETSEC	DIRSCT		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DIRBUF	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;READ THE SECTOR.
	ENDIF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  READ A DATA 1 SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
REDDAT1:	DS	0
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DATDSK1		;SELECT THE DISK.
	IF	NBIOS
	LDA	DATDSK1		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DATTRK1		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DATSCT1		;READ THE SECTOR
	MOV	C,A
	LXI	H,DATBUF1	;INTO DATBUF1.
	CALL	BIOSRED
	ENDIF
	IF DMA$BIOS
	SETTRK	DATTRK1		;SET THE TRACK NO.
	SETSEC	DATSCT1		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF1	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD		;READ THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DATTRK1		;SET THE TRACK NO.
	SETSEC	DATSCT1		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF1	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD		;READ THE SECTOR.
	ENDIF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  WRITE A DATA 1 SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
WRTDAT1:	DS	0
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DATDSK1		;SELECT THE DISK.
	IF	NBIOS
	LDA	DATDSK1		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DATTRK1		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DATSCT1		;WRITE THE SECTOR
	MOV	C,A
	LXI	H,DATBUF1	;FROM DATBUF1.
	CALL	BIOSWRT
	ENDIF
	IF DMA$BIOS
	SETTRK	DATTRK1		;SET THE TRACK NO.
	SETSEC	DATSCT1		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF1	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;WRITE THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DATTRK1		;SET THE TRACK NO.
	SETSEC	DATSCT1		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF1	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;WRITE THE SECTOR.
	ENDIF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  READ A DATA 2 SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
REDDAT2:	DS	0
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DATDSK2		;SELECT THE DISK.
	IF	NBIOS
	LDA	DATDSK2		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DATTRK2		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DATSCT2		;READ THE SECTOR
	MOV	C,A
	LXI	H,DATBUF2	;INTO DATBUF2.
	ENDIF
	IF DMA$BIOS
	SETTRK	DATTRK2		;SET THE TRACK NO.
	SETSEC	DATSCT2		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF2	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD 		;READ THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DATTRK2		;SET THE TRACK NO.
	SETSEC	DATSCT2		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF2	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DREAD 		;READ THE SECTOR.
	ENDIF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
$+PRINT
$+PRINT
;		* *  WRITE A DATA 2 SECTOR  * *
;PURPOSE
;INPUT
;		A = SECTOR NUMBER
;OUTPUT
;
;
;
;		DO INITIALIZATION.
WRTDAT2:	DS	0
;
;
;		READ THE SECTOR USING BIOS.
	SELDSK	DATDSK2		;SELECT THE DISK.
	IF	NBIOS
	LDA	DATDSK2		;SELECT IT PHYSICALLY.
	MOV	C,A
	CALL	BIOSSEL
	LDA	DATTRK2		;SET THE TRACK.
	MOV	C,A
	CALL	BIOSSEK
	LDA	DATSCT2		;WRITE THE SECTOR
	MOV	C,A
	LXI	H,DATBUF2	;FROM DATBUF2.
	CALL	BIOSWRT
	ENDIF
	IF DMA$BIOS
	SETTRK	DATTRK2		;SET THE TRACK NO.
	SETSEC	DATSCT2		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF2	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;WRITE THE SECTOR.
	ENDIF
	IF (NOT NBIOS) AND (NOT DMA$BIOS)
	SETTRK	DATTRK2		;SET THE TRACK NO.
	SETSEC	DATSCT2		;SET THE SECTOR NO.
	RC			;...INVALID SECTOR.
	LXI	BC,DATBUF2	;SET DMA TO DIRBUF.
	CALLBIOS DSETDMA
	CALLBIOS DWRITE		;WRITE THE SECTOR.
	ENDIF
;
;
;		RETURN TO CALLER.
	RET
;
;
;
;
;		* * *  PROGRAM CONSTANTS AND AREAS  * * *
;
;		* *  GENERAL  * *
;
$+PRINT
;		*  MAIN FUNCTION TABLE  *
FNCTBL:	DS	0
	DW	RTNCPM		;00 - RETURN TO CPM
	DW	INITDISK	;01 - INITIALIZE A DISKETTE
	DW	CHGVOL		;02 - CHANGE A VOLUME SERIAL NUMBER
	DW	CHGDIR		;03 - CHANGE A DATASET ENTRY
	DW	DELDIR		;04 - DELETE A DATASET
	DW	DSPLDIR		;05 - DISPLAY A DATASET ENTRY
	DW	LISTDIR		;06 - LIST THE DIRECTORY
	DW	TRSCIBLK	;07 - TRANSFER CP/M TO 3740 (BLOCKED)
	DW	TRSICBLK	;08 - TRANSFER 3740 TO CP/M (BLOCKED)
	DW	TRSCISRC	;09 - TRANSFER CP/M TO 3740 (SOURCE)
	DW	TRSICSRC	;10 - TRANSFER 3740 TO CP/M (SOURCE)
	DW	DSPIBMDS	;11 - DISPLAY AN IBM DATASET
;
;		*  CONSTANTS  *
CVOL1:	DB	'VOL1'		;VOLUME SECTOR ID
CHDR1:	DB	'DDR1'		;DATASET SECTOR ID
CSPRTRK: DB	'74001'		;SPARE TRACK PTR
CHGHTRK: DB	'73026'		;HIGH TRACK PTR
CLOWTRK: DB	'01001'		;LOW TRACK PTR
CLRL80: DB	'00080'		;DEFAULT RECORD LENGTH
CDSIDD:	DB	'DATA'		;DEFAULT DATASET ID
CERMAP: DB	'ERMAP'		;ERMAP SECTOR ID
CSCTNO: DB	'  091011121314151617'	;ASCII SECTOR NUMBERS.
	DB	'181920212223242526'
CEOL:	DB	CR,LF,'$'
CSPACES: DB	'        '	;8 SPACES
;
;		* GENERAL VARIABLES *
VOLSER: DS	6		;VOLUME SERIAL NUMBER
RCDCNT: DW	0		;RECORD COUNT
;
;		* TRANSFER VARIABLES *
CPMDSKNO: DS	1		;CP/M DISK DRIVE
IBMDSKNO: DS	1		;IBM DISK DRIVE
TDSN:	DS	8		;DATASET NAME
TDSBOE:	DS	2		;IBM BOE (INTERNAL)
TDSEOE:	DS	2		;IBM EOE (INTERNAL)
TDSEOD:	DS	2		;IBM EOD (INTERNAL)
BLKLEN: DS	2		;IBM BLOCK LENGTH (INTERNAL)
TRSFCB:	DS	33		;CP/M FCB FOR TDSN
TWRKC3:	DS	3		;CHAR WORK AREA
TRSERR:	DS	1		;TRANSFER ERROR COUNT
TRSBUFP: DS	2		;CURRENT BUFFER POINTER.
TRSBUFA: DS	1		;CURRENT # OF BYTES REMAINING IN BUFFER
;
;
$+PRINT
$+PRINT
;		* *  DISK I/O BUFFERS  * *
;
;		* IBM DIRECTORY BUFFER *
DIRDSK:	DS	1		;CURRENT DISK NO
DIRTRK:	DS	1		;CURRENT TRACK NO
DIRSCT:	DS	1		;CURRENT SECTOR NO
DIRBUF:	DS	0
DSHD:	DS	4		;'HDR1'
	DS	1		;RESERVED
DSID:	DS	8		;DATASET IDENTIFIER
	DS	9		;**RESERVED
DSBLK:	DS	5		;BLOCK LENGTH OR PHYSICAL
;				;RECORD SIZE
DSATTR:	DS	1		;RECORD ATTRIBUTE
;				;  B - RECORDS UNBLOCKED, UNSPANNED
;				;  R - RECORDS BLOCKED, SPANNED
;				;  B - RECORDS BLOCKED, UNSPANNED
DSBOE:	DS	5		;GEGINNING OF EXTENT
DSPRL:	DS	1		;PHYSICAL RECORD LENGTH
;				;  B - 128 BYTES
;				;  1 - 256 BYTES
;				;  2 - 512 BYTES
DSEOE:	DS	5		;END OF EXTENT
DSRBF:	DS	1		;RECORD/BLOCK FORMAT
;				;  MUST BE B OR F
DSBYPI:	DS	1		;BYPASS INDICATOR
;				;  B - TRANSFER DATA
;				;  B - BYPASS TRANSFER
DSSS:	DS	1		;DATASET SECURITY
;				;  B - NOT SECURED
;				;  ANYTHING - SECURED
DSWP:	DS	1		;WRITE PROTECT
;				;  B - READ AND WRITE VALID
;				;  P - READ ONLY
DSETI:	DS	1		;EXCHANGE TYPE INDICATOR
;				;  B - BASIC DATA EXCHANGE
;				;  ANYTHING - ADDITIONAL
;				;      CHECKING REQUIRED
DSMVI:	DS	1		;MULTI-VOLUME INDICATOR
;				;  B - DATASET RESIDES ON
;				;      VOLUME ONLY
;				;  C - DATASET IS CONTINUED
;				;      ON ANOTHER VOLUME
;				;  L - LAST VOLUME OF DATA-
;				;      SET
DSVLSQ:	DS	2		;VOLUME SEQUENCE NUMBER
DSCREDT: DS	6		;CREATION DATE (YYMMDD)
DSRL:	DS	4		;RECORD LENGTH
DSONRS:	DS	5		;OFFSET TO NEXT RECORD SPACE
	DS	4		;**RESERVED
DSEXPDT: DS	6		;EXPIRATION DATE (YYMMDD)
DSVCI:	DS	1		;VERIFY/COPY INDICATOR
;				;  B - DATASET CREATED
;				;  C - SUCCESSFULLY COPIED
;				;  V - DATASET VERIFIED
	DS	1		;**RESERVED
DSEOD:	DS	5		;END OF DATA
	DS	1		;**RESERVED
DSLV:	DS	48		;**RESERVED - LOW VALUES
;
;		*  DATA BUFFER 1  *
DATDSK1: DS	1		;CURRENT DISK NO
DATTRK1: DS	1		;CURRENT TRACK
DATSCT1: DS	1		;CURRENT SECTOR
	ORG	$+(($+7)MOD 256) ;ORG TO 8-BYTE BOUNDARY
DATBUF1: DS	0
DATA1:	DS	80
	DS	48		;FILLER
;
;		*  DATA BUFFER 2  *
DATDSK2: DS	1		;CURRENT DISK NO
DATTRK2: DS	1		;CURRENT TRACK NO
DATSCT2: DS	1		;CURRENT SECTOR NO
	ORG	$+(($+7)MOD 256) ;ORG TO 8-BYTE BOUNDARY
DATBUF2: DS	0
DATA2:	DS	80
	DS	48		;FILLER
;
;
;
$+PRINT
$+PRINT
;FILE		TRNSUBS.LIB
;		* * * *  CHARACTER TRANSLATIONS  * * * *
;PURPOSE	THESE ROUTINES PROVIDE THE MEANS OF TRANS-
;		LATING CHARACTERS FROM ASCII TO EBCDIC OR
;		VICE VERSA.  ALSO, THEY PROVIDE A MEANS
;		FOR REMOVING UNWANTED CHARACTERS FROM PRINT
;		LINES SUCH AS FOR A DUMP OF CORE.
;INPUT
;		A = CHARACTER TO BE TRNASLATED
;OUTPUT
;		A = TRANSLATED CHARACTER
;REMARKS
;		1.  EACH SUBROUTINE WILL ONLY BE GENERATED
;		    IF ITS GLOBAL IS SET TO TRUE.  THE GLO-
;		    BALS ARE:
;			@TRNASEB - ASCII TO EBCDIC
;			@TRNEBAS - EBCDIC TO ASCII
;			@OUTTRN - OUTPUT TRANSLATION
;
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSLATE ASCII TO EBCDIC  * * *
;PURPOSE	THIS ROUTINE TRANSLATES AN ASCII CHARACTER
;		TO EBCDIC.
;INPUT
;		A = ASCII CHARACTER
;OUTPUT
;		A = EBCDIC CHARACTER
;
;
;		DO INITIALIZATION.
	IF	@TRNASEB
TRNASEB: DS	0
	PUSH	BC		;SAVE REGS.
	PUSH	HL
	MOV	C,A
;
;		TRANSLATE THE CHAR BY INDEXING INTO TABLE.
	ANI	07FH		;ZERO HIGH ORDER BIT.
	MVI	B,0		;BC=A
	MOV	C,A
	LXI	HL,ASEBTBL	;HL=>TABLE.
	DAD	BC		;INDEX INTO TABLE.
	MOV	A,M		;GET TRNLTD CHAR.
;
;		RETURN TO CALLER.
	POP	HL		;RESTORE REGS.
	POP	BC
	RET
;
;
;
;		* *  ASCII TO EBCDIC TRANSLATION TABLE  * *
;
ASEBTBL: DS	0
	DB	000H,001H,002H,003H,004H,02DH,02EH,02FH		;000-007
	DB	016H,005H,025H,00BH,00CH,00DH,00EH,00FH		;008-015
	DB	010H,011H,012H,013H,014H,03DH,032H,026H		;016-023
	DB	018H,019H,03FH,027H,01CH,01DH,01EH,01FH		;024-031
	DB	040H,05AH,07FH,07BH,05BH,06CH,050H,07DH		;032-039
	DB	04DH,05DH,05CH,04EH,06BH,060H,04BH,061H		;040-047
	DB	0F0H,0F1H,0F2H,0F3H,0F4H,0F5H,0F6H,0F7H		;048-055
	DB	0F8H,0F9H,07AH,05EH,04CH,07EH,06EH,06FH		;056-063
	DB	07CH,0C1H,0C2H,0C3H,0C4H,0C5H,0C6H,0C7H		;064-071
	DB	0C8H,0C9H,0D1H,0D2H,0D3H,0D4H,0D5H,0D6H		;072-079
	DB	0D7H,0D8H,0D9H,0E2H,0E3H,0E4H,0E5H,0E6H		;080-087
	DB	0E7H,0E8H,0E9H,0ADH,0E0H,0BDH,05FH,06DH		;088-095
	DB	079H,081H,082H,083H,084H,085H,086H,087H		;096-103
	DB	088H,089H,091H,092H,093H,094H,095H,096H		;104-111
	DB	097H,098H,099H,0A2H,0A3H,0A4H,0A5H,0A6H		;112-119
	DB	0A7H,0A8H,0A9H,0C0H,06AH,0D0H,0A1H,007H		;120-127
	ENDIF
;
;
;
;
$+PRINT
$+PRINT
;		* * *  TRANSLATE EBCDIC TO ASCII  * * *
;PURPOSE	THIS ROUTINE TRANSLATES AN EBCDIC CHARACTER
;		TO ASCII.
;INPUT
;		A = EBCDIC CHARACTER
;OUTPUT
;		A = ASCII CHARACTER
;
;
;		DO INITIALIZATION.
	IF	@TRNEBAS
TRNEBAS: DS	0
	PUSH	BC		;SAVE REGS.
	PUSH	HL
	MOV	C,A
;
;		TRANSLATE THE CHAR BY INDEXING INTO TABLE.
	MVI	B,0		;BC=A
	MOV	C,A
	LXI	HL,EBASTBL	;HL=>TABLE.
	DAD	BC		;INDEX INTO TABLE.
	MOV	A,M		;GET TRNLTD CHAR.
;
;		RETURN TO CALLER.
	POP	HL		;RESTORE REGS.
	POP	BC
	RET
;
;
;
;		* *  EBCDIC TO ASCII TRANSLATION TABLE  * *
;
EBASTBL: DS	0
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;00-07
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;08-0F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;10-17
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;18-1F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;20-27
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;28-2F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;30-37
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;38-3F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;40-47
	DB	020H,020H,020H,02EH,03CH,028H,02BH,07CH		;48-4F
	DB	026H,020H,020H,020H,020H,020H,020H,020H		;50-57
	DB	020H,020H,021H,024H,02AH,029H,03BH,07EH		;58-5F
	DB	02DH,02FH,020H,020H,020H,020H,020H,020H		;60-67
	DB	020H,020H,020H,02CH,025H,05FH,03EH,03FH		;68-6F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;70-77
	DB	020H,020H,03AH,023H,040H,027H,03DH,022H		;78-7F
	DB	024H,020H,020H,020H,020H,020H,020H,020H		;80-87
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;88-8F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;90-97
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;98-9F
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;A0-A7
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;A8-AF
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;B0-B7
	DB	020H,020H,020H,020H,020H,020H,020H,020H		;B8-BF
	DB	020H,041H,042H,043H,044H,045H,046H,047H		;C0-C7
	DB	048H,049H,020H,020H,020H,020H,020H,020H		;C8-CF
	DB	020H,04AH,04BH,04CH,04DH,04EH,04FH,050H		;D0-D7
	DB	051H,052H,020H,020H,020H,020H,020H,020H		;D8-DF
	DB	020H,020H,053H,054H,055H,056H,057H,058H		;E0-E7
	DB	059H,05AH,020H,020H,020H,020H,020H,020H		;E8-EF
	DB	030H,031H,032H,033H,034H,035H,036H,037H		;F0-F7
	DB	038H,039H,020H,020H,020H,020H,020H,020H		;F8-FF
	ENDIF
;
;
;
;
$+PRINT
$+PRINT
;		* * *  OUPUT TRANSLATION  * * *
;
;PURPOSE	THE FOLLOWING ROUTINE AND TABLE ARE
;		USED FOR OUTPUT TRANSLATION OF NON-
;		PRINTABLE CHARACTERS.  FOR INSTANCE,
;		IF THE CHARACTER IS A <CR>, IT WILL
;		BE PRINTED AS A SPACE.
;PROGRAMMER	ROBERT M. WHITE
;DATE CODED	MAY 23, 1977
;INPUT		A = CHARACTER TO BE TRANSLATED.
;OUTPUT		A = TRANSLATED CHARACTER
;
;
;
;		DO INITIALIZATION.
	IF	@OUTTRN
OUTTRN: DS	0
	PUSH	BC		;SAVE REGS.
	PUSH	HL
	MOV	C,A
;
;		TRANSLATE THE CHAR BY INDEXING INTO TABLE.
	ANI	07FH		;ZERO HIGH ORDER BIT.
	MVI	B,0		;BC=A
	MOV	C,A
	LXI	HL,OUTTBL	;HL=>TABLE.
	DAD	BC		;INDEX INTO TABLE.
	MOV	A,M		;GET TRNLTD CHAR.
;
;		RETURN TO CALLER.
	POP	HL		;RESTORE REGS.
	POP	BC
	RET
;
;
;		* *  TRANSLATION TABLE  * *
OUTTBL:	DB	'                '	;000 - 015
	DB	'                '	;016 - 031
	DB	' !"#$%&',027H,'()*+,-./'	;032 - 047
	DB	'0123456789:;<=>?'	;048 - 063
	DB	'@ABCDEFGHIJKLMNO'	;064 - 079
	DB	'PQRSTUVWXYZ[\]^_'	;080 - 095
	DB	' abcdefghijklmno'	;096 - 111
	DB	'pqrstuvwxyz{|}  '	;112 - 127
	ENDIF
;
;
;
;
$+PRINT
;END		TRNSUBS.LIB
	END
