;
; TARBELL BASIC I/O SYSTEM
; LAST CHANGED 1-28-79
;
; THIS INPUT/OUTPUT SOURCE USES CONDITIONAL
; ASSEMBLIES TO ACTIVATE DIFFERENT PARTS OF
; THE CODE FOR DIFFERENT PURPOSES.  NOTE THAT
; SEVERAL EQU'S BELOW ARE SET EITHER TO TRUE
; (-1) OR FALSE (0).  THESE VALUES ARE THEN
; USED WITH THE PSUEDO-OPS "IF" AND "ENDIF"
; TO INHIBIT THE ASSEMBLY OF SECTIONS OF CODE.
; THIS IS A FEATURE OF THE CP/M ASSEMBLER.
; IT ALLOWS US TO MAKE CHANGES ONLY ON ONE
; ASSEMBLY-LANGUAGE SOURCE, AND AUTOMATICALLY
; UPDATE THE SOURCE FOR ALL VERSIONS.
; YOU CAN TELL WHICH PARTS ARE ASSEMBLED IN
; FOR YOUR VERSION BY LOOKING TO THE LEFT OF
; THE SOURCE CODE.  IF THERE ARE HEX ADDRESSES
; AND BYTES TO THE LEFT OF THE SOURCE, THAT
; PART OF THE SOURCE WAS ASSEMBLED.
;
; THE TOP OF MEMORY IS DETERMINED BY WHAT IS
; LOADED INTO H&L THE FIRST THING AFTER THE
; LABEL "INIT:" BELOW.  WHATEVER IS LOADED IS
; DECREMENTED BY 1.  IF 1 IS LOADED (DEC TO 0),
; THE TOP OF MEMORY IS DETERMINED BY SEARCHING
; TO THE END OF RAM.  IF ANYTHING ELSE IS PUT
; INTO H&L, THIS IS DECREMENTED AND USED AS
; THE TOP OF MEMORY.  SO IF YOU WANT TO SET
; TOP OF MEMORY TO TOP OF 32K, CHANGE THE
; CURRENT INSTRUCTION FOLLOWING INIT: TO
; AN "LXI 8000H".
;
; IF YOU HAVE A CP/M SYSTEM GOING, YOU CAN EASILY
; CHANGE THE EQU'S TO SUIT YOUR SYSTEM.  THEN 
; REASSEMBLE TBASICIO, THEN USE DDT TO COMBINE
; THE NEW I/O WITH THE OLD BASIC.
;
; IF YOU DON'T HAVE A CP/M SYSTEM GOING, YOU CAN
; CHANGE THE PORT NUMBERS IN THE CONINP AND CONOUT
; SUBROUTINES TO THOSE USED FOR YOUR CONSOLE INPUT
; AND OUTPUT.  DON'T FORGET TO ALSO CHECK THE
; STATUS BIT MASK (IN THE ANI INSTRUCTIONS) AND
; THE JNZ OR JZ FOR YOUR PARTICULAR SITUATION.
;
TRUE	EQU  0FFFFH	;FOR CONDITIONAL ASSEMBLIES.
FALSE	EQU  NOT TRUE
;
CPM	EQU  TRUE	;TRUE FOR CP/M SYSTEMS.
DISK	EQU  TRUE	;TRUE FOR DISK VERSION.
CASS	EQU  TRUE	;TRUE FOR CASSETTE I/O.
STD	EQU  NOT CPM	;TRUE FOR STANDARD CONSOLE.

; PORTS FOR STANDARD I/O SYSTEM.
CONSP	EQU  0		;CONSOLE STATUS PORT.
CONDP	EQU  1		;CONSOLE DATA PORT.
CONIM	EQU  01H	;CONSOLE INPUT MASK.
CONOM	EQU  80H	;CONSOLE OUTPUT MASK.
LSTSP	EQU  2		;LISTER STATUS PORT.
LSTDP	EQU  3		;LISTER DATA PORT.
LSTOM	EQU  080H	;LISTER OUTPUT MASK.

; PORTS FOR TARBELL CASSETTE I/O.
CASC	EQU  6EH	;CASSETTE STATUS PORT.
CASD	EQU  6FH	;CASSETTE DATA PORT.

; FILE BLOCK PARAMETER OFFSETS.
BLKST	EQU   0		;LOCATION OF FILE STATUS BYTE.
BLKCTR	EQU   1		;DISK BUFFER BYTE COUNTER.
BLKSPR	EQU   2		;SPARE BLOCK BYTES.
BLKFCB	EQU   4		;FCB LOCATION IN BLOCK.
BLKEXT	EQU   BLKFCB+12	;EXTENT LOCATION IN FCB.
BLKRC	EQU   BLKFCB+15 ;RECORD COUNT (EXTENT SIZE).
BLKNR	EQU   BLKFCB+32	;NEXT RECORD LOCATION IN FCB.
BLKDN	EQU   37	;DISK NUMBER LOCATION.
BLKRL	EQU   38	;RECORD LENGTH FOR RANDOM FILES.
BLKBUF	EQU   40	;POSITION OF FILE BUFFER.
BLKSIZ	EQU   BLKBUF+128	;FILE BLOCK SIZE.

; CP/M BIOS JUMP VECTOR OFFSETS.
CONST	EQU  3		;CONSOLE STATUS OFFSET.
CONIN	EQU  6		;CONSOLE INPUT OFFSET.
CONOT	EQU  9		;CONSOLE OUTPUT OFFSET.
LIST	EQU  12		;LIST OUTPUT OFFSET.
PUNCH	EQU  15		;PUNCH OUTPUT OFFSET.
READER	EQU  18		;READER OUTPUT OFFSET.
HOME	EQU  21		;DISK HOME OFFSET.
SELDSK	EQU  24		;SELECT DRIVE OFFSET.

; CP/M COMMON LOCATIONS.
BDOS	EQU  5		;MAIN ENTRY POINT TO BDOS.
FCB	EQU  5CH	;DEFAULT FILE CONTROL BLOCK.
TBUFF	EQU  80H	;DEFAULT BUFFER LOCATION.

; ENTRY POINTS INTO TARBELL BASIC INTERPRETER.
BASIC	EQU  0900H	;START OF TBASIC INTERPRETER.
CHANL	EQU  BASIC+3	;ADR OF ADR OF CHANNEL TABLE.
TRMNL	EQU  BASIC+5	;ADR OF ADR OF TERMINAL TABLE.
SSSS	EQU  BASIC+7	;ADR OF ADR OF END OF MEMORY.
CNVRA	EQU  BASIC+9	;ADR OF ADR OF NO. OF DIGITS.
FPRA6	EQU  BASIC+11	;ADR OF ADR OF USR ROUTINE.
MODES	EQU  BASIC+13	;ADR OF ADR OF MODES TABLE.
FSRC	EQU  BASIC+15	;ADR OF ADR OF START OF PROGRAM.
ESRC	EQU  BASIC+17	;ADR OF ADR OF END OF PROGRAM.
ERROR	EQU  BASIC+19	;ADR OF ADR OF ERROR ROUTINE.
KILL	EQU  BASIC+65	;ADR OF ADR OF KILL ROUTINE.
AMBL	EQU  BASIC+67	;ADR OF ADR OF ALLOCATION ROUTINE.
EOF	EQU  BASIC+69	;ADR OF ADR OF END OF FILE BYTE.
RECORD	EQU  BASIC+71	;ADR OF ADR OF RECORD NUMBER.
FILE	EQU  BASIC+73	;ADR OF ADR OF FILE NAME OR NUMBER.
TYPE	EQU  BASIC+75	;ADR OF ADR OF TYPE NUMBER.
NAME	EQU  BASIC+77	;ADR OF ADR OF FILE NAME.
MULT	EQU  BASIC+85	;ADR OF ADR OF MULTIPLY ROUTINE.
ZERO	EQU  BASIC+87	;ADR OF ADR OF ZERO ROUTINE.
DO	EQU  BASIC+91	;ADR OF ADR OF DO FUNCTION NUMBER.
DOPARA	EQU  BASIC+93	;ADR OF ADR OF DO PARAMETER.
DISKNO	EQU  BASIC+95	;ADR OF ADR OF DISK FUNCTION NUMBER.
KIND	EQU  BASIC+97	;ADR OF ADR OF KIND (OF TRANSFER) BYTE.
FUNK	EQU  BASIC+99	;ADR OF MASS STORAGE FUNCTION BYTE.
PTDIR	EQU  BASIC+101	;ADR OF ADR OF DIR STATEMENT CALL.
PTREN	EQU  BASIC+103	;ADR OF ADR OF RENAME STATEMENT CALL.
PTERA	EQU  BASIC+105	;ADR OF ADR OF ERASE STATEMENT CALL.
PTRES	EQU  BASIC+107	;ADR OF ADR OF RESET STATEMENT CALL.
PTSEA	EQU  BASIC+109	;ADR OF ADR OF SEARCH FUNCTION CALL.
PTFLX	EQU  BASIC+111	;ADR OF ADR OF FILEXISTS FUNCTION CALL.
;
***********************************************
*                                             *
*     EXECUTABLE CODE STARTS HERE             *
*                                             *
***********************************************
;
	ORG  100H	;NORMAL LOAD ADDRESS.
	JMP  INIT	;GO TO INITIALIZATION.
CONI:	JMP  CONINP	;CONSOLE INPUT ROUTINE.
CONO:	JMP  CONOUT	;CONSOLE OUTPUT ROUTINE.
SPAR:	NOP!NOP!RET	;FOR SPARE I/O ROUTINE.
LSTO:	JMP  LSTOUT	;LISTING OUTPUT ROUTINE.
RDRI:	NOP!NOP!RET	;FOR READER INPUT ROUTINE.
PUNO:	NOP!NOP!RET	;FOR PUNCH OUTPUT ROUTINE.

	IF   DISK	;IF DISK I/O IN,
DSKI:	JMP  DSKINP	;DISK INPUT ROUTINE.
DSKO:	JMP  DSKOUT	;DISK OUTPUT ROUTINE.
	ENDIF

	IF NOT DISK	;IF DISK I/O NOT IN,
DSKI:	NOP!NOP!RET	;JUST RETURN.
DSKO:	NOP!NOP!RET	;JUST RETURN.
	ENDIF

	IF   CASS	;IF CASSETTE VERSION,
CASI:	JMP  CASINP	;CASSETTE INPUT ROUTINE.
CASO:	JMP  CASOUT	;CASSETTE OUTPUT ROUTINE.
	ENDIF

	IF NOT CASS	;IF NO CASSETTE I/O,
CASI:	NOP!NOP!RET	;JUST RETURN.
CASO:	NOP!NOP!RET	;JUST RETURN.
	ENDIF

USR:
;
; USRSUB - THIS IS THE SUBROUTINE THAT GETS
; CALLED BY THE USR FUNCTION IN TARBELL BASIC.
; THE ARGUMENT OF THE FUNCTION COMES IN D&E.
; THE VALUE RETURNED IN D&E BECOMES THE VALUE
; OF THE USR FUNCTION WHERE IT IS USED.
; A BLANK ROUTINE OF NOP'S IS PROVIDED FOR
; THE USER'S CONVENIENCE.
;
USRSUB:	NOP!NOP!NOP!NOP
	RET
;
; INIT - THIS IS WHERE INPUT/OUTPUT PARAMETERS
; ARE INITIALIZED.  THIS ROUTINE SHOULD ONLY BE
; EXECUTED THE FIRST TIME THAT BASIC IS BROUGHT
; INTO MEMORY.  IF IT IS DESIRED TO RESTART
; BASIC AFTER THIS, BEGIN EXECUTION AT 0700H.
;
INIT:	LXI  SP,0100H	;SET TEMPORARY STACK PTR.

	IF NOT CPM	;IF NOT CPM, LET BASIC
	LXI  H,1	;FIGURE END OF MEMORY.
	ENDIF

	IF CPM AND NOT DISK	;IF NOT DISK VERSION,
	LHLD 1		;GET START OF BIOS.
	DCX  H
	DCX  H
	ENDIF

	IF CPM AND DISK	;IF DISK VERSION,
	LHLD 6		;GET START OF CP/M.
	ENDIF

	DCX  H		;DECREMENT BELOW IT.
	SHLD ISSSS	;PUT INTO INIT TOP.
;
	LHLD CNVRA	;GET NO. OF DIGITS ADR.
	MVI  M,10	;MAKE IT TEN.
;
	MVI  A,128	;CLEAR THE 128 BYTE
	LXI  H,BLKTAB	;BLOCK TABLE TO ZERO.
	CALL CALLI
	DW   ZERO

	IF   STD	;IF STANDARD CONSOLE I/O,
	NOP!NOP!NOP!NOP	;ALLOW ROOM FOR AN
	NOP!NOP!NOP!NOP	;INITIALIZATION ROUTINE
	NOP!NOP!NOP!NOP	;TO BE PATCHED IN
	NOP!NOP!NOP!NOP	;IF NECESSARY.
	ENDIF

	IF   DISK	;IF DISK VERSION,
	MVI  C,25	;CODE FOR CP/M TO GET DRIVE
	CALL BDOS	;CURRENTLY SELECTED IN A.
	STA  IDISK	;SET INITIAL DISK NUMBER.
	ENDIF

;
	LXI  D,ISSSS	;GET ADR OF INIT. TABLE.
	LHLD SSSS	;GET PLACE TO GO IN SCRATCH.
	MVI  B,ENDTAB-ISSSS  ;GET BYTE COUNT.
	CALL MOVE	;INITIALIZE SCRATCH AREA.
	JMP  BASIC	;HOP INTO TARBELL BASIC.
*************************************************
;
; THE LOCATIONS AND TABLES BELOW ARE MOVED INTO
; CORRESPONDING LOCATIONS IN BASIC'S SCRATCH
; AREA AT INITIALIZATION TIME.
;
ISSSS:	DW   0		;TOP OF MEMORY ADDRESS.
;
; ICHANL - INITIAL I/O ROUTINE ADDRESSES FOR
;          CHANL TABLE.
;
ICHANL:	DW   CONI	;CONSOLE INPUT ADDRESS.
	DW   CONO	;CONSOLE OUTPUT ADDRESS.
	DW   CASI	;CASSETTE INPUT ADDRESS.
	DW   CASO	;CASSETTE OUTPUT ADDRESS.
	DW   SPAR	;SPARE I/O ADDRESS.
	DW   LSTO	;LISTING OUTPUT ADDRESS.
	DW   RDRI	;READER INPUT ADDRESS.
	DW   PUNO	;PUNCH OUTPUT ADDRESS.
	DW   DSKI	;DISK INPUT ADDRESS.
	DW   DSKO	;DISK OUTPUT ADDRESS.
;
; IMODES - INITIAL MODES TABLE FOR I/O DEVICES.
; THIS GETS TRANSFERRED FROM HERE TO BASIC'S 
; MODES TABLE UPON INITIALIZATION.  AFTER THAT,
; BASIC'S MODES TABLE MAY BE CHANGED FROM A
; RUNNING BASIC PROGRAM BY USING THE ASSIGN
; AND DROP STATEMENTS TO SET & RESET BITS.
;

;LOG. DEV. # 76543210	;PHYSICAL DEVICE.

IMODES:	DB   00000001B	;KEYBOARD INPUT.
	DB   00000010B	;CONSOLE PRINTER.

	IF NOT DISK	;IF NOT DISK VERSION.
	DB   00010100B	;CASSETTE INPUT.
	DB   00101000B	;CASSETTE OUTPUT.
	ENDIF

	IF   DISK	;IF DISK VERSION,
	DB   00000000B	;CASSETTE INPUT.
	DB   00000000B	;CASSETTE OUTPUT.
	ENDIF

	DB   00000000B	;SPARE INPUT/OUTPUT.
	DB   00000000B	;LISTING OUTPUT.
	DB   00000000B  ;READER INPUT.
	DB   00000000B	;PUNCH OUTPUT.

	IF   DISK	;IF DISK VERSION,
	DB   00010100B	;DISK INPUT.
	DB   00101000B	;DISK OUTPUT.
	ENDIF

	IF NOT DISK	;IF NOT DISK VERSION,
	DB   00000000B	;DISK INPUT.
	DB   00000000B	;DISK OUTPUT.
	ENDIF

;
; ITRMNL - INITIAL VALUES FOR TRMNL TABLE.
; FIRST BYTE OF EACH ENTRY IS TERMINAL WIDTH.
; 2ND BYTE OF EACH ENTRY IS TERMINAL POSITION.
; 3RD BYTE LOW 7 BITS IS RUBOUT CHARACTER OUT.
; 3RD BYTE MSB IS 0 FOR NO DECREMENT,1 FOR DEC.
;
ITRMNL:	DB   00,0,0	;KEYBOARD INPUT.
	DB   72,0,88H	;CONSOLE OUTPUT.
	DB   00,0,0	;CASSETTE INPUT.
	DB   72,0,5CH	;CASSETTE OUTPUT.
	DB   00,0,0	;SPARE DEVICE.
	DB   72,0,5CH	;LISTING OUTPUT.
	DB   00,0,0	;READER INPUT.
	DB   72,0,5CH	;PUNCH OUTPUT.
	DB   00,0,0	;DISK INPUT.
	DB   72,0,5CH	;DISK OUTPUT.
;
;
IDISK:	DW   0		;INITIAL DISK NUMBER.
IUSER:	DW   USR	;USR ROUTINE ADDRESS.
IEOF:	DB   0		;EOF INITIALLY FALSE.
IREC:	DW   0		;INITIAL RECORD NUMBER.
IFILE:	DW   0		;INITIAL FILE NUMBER.
ITYPE:	DW   0		;INITIAL TYPE IS SEQ.
IDIR:	DW   DIR	;DIR ROUTINE ADDRESS.
IREN:	DW   RENAME	;RENAME ROUTINE ADDRESS.
IERA:	DW   ERASE	;ERASE ROUTINE ADDRESS.
IRES:	DW   RESET	;RESET ROUTINE ADDRESS.
ISEA:	DW   SEARCH	;SEARCH ROUTINE ADDRESS.
IFLX:	DW   FILEXI	;FILEXIST ROUTINE ADDRESS.
ENDTAB:			;END OF INIT. TABLE.
***********************************************
;
; MOVE - MOVE THE NUMBER OF BYTES SPECIFIED BY
; REGISTER B, FROM THE ADDRESS IN D&E TO THE
; ADDRESS IN H&L.
;
MOVE:	LDAX D		;GET A BYTE.
	MOV  M,A	;PUT A BYTE.
	INX  H		;INCREMENT H&L.
	INX  D		;INCREMENT D&E.
	DCR  B		;DECREMENT COUNTER.
	JNZ  MOVE	;GO TILL COUNTER=0.
	RET		;RETURN FROM MOVE.
;
; CONOUT - PRINT THE CHARACTER IN REGISTER A
; ONTO THE CONSOLE OUTPUT DEVICE, USUALLY A
; TELETYPEWRITER OR CRT TERMINAL.
;
CONOUT:	RZ		;RETURN IF OPEN FLAG.
	RC		;RETURN IF CLOSE FLAG.
	PUSH H		;SAVE H&L.
	PUSH D		;SAVE D&E.
	PUSH B		;SAVE B&C.
	PUSH PSW	;SAVE A&PSW.

	IF   CPM	;IF CP/M I/O,
	CALL IO		;PRINT CHARACTER IN A.
	DB   CONOT
	ENDIF

	IF   STD	;IF STANDARD I/O,
	CALL CONOTS	;PRINT CHARACTER IN A.
	ENDIF

	JMP  RET4	;RESTORE 4 REG & RET.

	IF   STD	;IF STANDARD I/O,
CONOTS:	PUSH PSW	;SAVE REGISTER A & STATUS.
CONOTL:	IN   CONSP	;READ CONSOLE STATUS.
	ANI  CONOM	;LOOK AT OUTPUT STATUS BIT.
	JNZ  CONOTL	;WAIT UNTIL READY.
	POP  PSW	;GET CHARACTER.
	OUT  CONDP	;PRINT IT.
	RET		;RETURN FROM CONOT.
	ENDIF

;
; CONINP - READ A BYTE FROM THE CONSOLE KEYBOARD INTO
; REGISTER A.  IF THIS ROUTINE IS ENTERED WITH THE
; 8080 ZERO FLAG SET, IT IS A CHECK FOR CONTROL-C.
; IN THIS CASE, A CHECK IS MADE TO SEE IF A CONTROL-C
; KEY HAS BEEN PUSHED.  IF IT HASN'T, A RETURN IS
; MADE WITH THE ZERO FLAG CLEARED.  IF IT HAS, A
; RETURN IS MADE WITH THE ZERO FLAG SET.
;
CONINP:	JZ   CHKST	;IF ZERO, MUST BE STATUS CHECK.
CONINR:

	IF   CPM	;IF CP/M I/O,
	CALL IO		;READ KEYBOARD.
	DB   CONIN
	ENDIF

	IF   STD	;IF STANDARD I/O,
	CALL CONINS	;READ KEYBOARD.
	ENDIF

	ORA  A		;IF A NULL,
	JZ   CONINR	;READ AGAIN.
	RET		;RETURN FROM CONINP.
;
; CHECK CONSOLE KEYBOARD STATUS.
;
CHKST:	PUSH H		;SAVE H&L.
	PUSH D		;SAVE D&E.
	PUSH B		;SAVE B&C.

	IF   CPM	;IF CP/M I/O,
	CALL IO		;CHECK KEYBOARD STATUS.
	DB   CONST
	ENDIF

	IF   STD	;IF STANDARD I/O,
	CALL CHKSTS	;CHECK KEYBOARD STATUS.
	ENDIF

	POP  B		;RESTORE B&C.
	POP  D		;RESTORE D&E.
	POP  H		;RESTORE H&L.
	CMA		;COMPLEMENT RESULT.
	ORA  A		;SET FLAGS.
	RNZ		;RETURN IF NO KEY PUSH.
CHKST1:
	IF   CPM	;IF CP/M I/O,
	CALL IO		;READ KEYBOARD.
	DB   CONIN
	ENDIF

	IF   STD	;IF STANDARD I/O,
	CALL CONINS	;READ KEYBOARD.
	ENDIF

	CPI  3		;SET ZERO FLAG IF CTL-C.
	RZ		;RETURN IF CTL-C.
	CPI  13H	;IS IT A CTL-S?
	JZ   CHKST1	;IF SO, READ KB AGAIN.
	RET		;RETURN FROM CONINP.

	IF   STD	;IF STANDARD I/O,
;
; CONINS - STANDARD READ FROM KEYBOARD.
;
CONINS:	IN   CONSP	;READ CONSOLE STATUS.
	ANI  CONIM	;LOOK AT INPUT STATUS BIT.
	JNZ  CONINS	;LOOP UNTIL READY.
	IN   CONDP	;READ THE CHARCTER.
	ANI  7FH	;STRIP PARITY BIT OFF.
	RET		;RETURN FROM CONINS.
;
; CHKSTS - STANDARD CONSOLE STATUS ROUTINE.
;
CHKSTS:	IN   CONSP	;READ CONSOLE STATUS.
	ANI  CONIM	;LOOK AT KB READY BIT.
	MVI  A,0	;SET A=0 FOR RETURN.
	RNZ		;NOT READY WHEN NOT ZERO.
	CMA		;IF READY, A=FF.
	RET		;RETURN FROM CHKSTS.
	ENDIF

	IF   CPM	;IF CP/M INPUT/OUTPUT,
;
; IO - PERFORM AN INPUT OR OUTPUT OPERATION USING
; CP/M'S BIOS (BASIC INPUT/OUTPUT SYSTEM).  THE
; BYTE FOLLOWING THE CALL TO THIS ROUTINE IS AN
; OFFSET WHICH IS ADDED TO THE BIOS JUMP VECTOR
; ADDRESS TO DETERMINE THE CORRECT ENTRY POINT
; TO BIOS.
;
IO:	XTHL		;GET ADDRESS OF OFFSET.
	MOV  E,M	;PUT OFFSET IN D&E.
	MVI  D,0
	INX  H		;MAKE RETURN ADDRESS RIGHT.
	XTHL		;PUT BACK ONTO STACK.
	LHLD 1		;GET ADDRESS OF IO VECTOR.
	DAD  D		;ADD OFFSET.
	MOV  C,A	;OUTPUT GOES IN C.
	PCHL		;JUMP TO IO ROUTINE.
	ENDIF

;
; LSTOUT - PRINT THE CHARACTER IN REGISTER A ON THE
; LISTING DEVICE.  IF IT'S A CARRIAGE-RETURN, ADD
; A LINE-FEED.
;
LSTOUT:	RZ		;RETURN IF OPEN FLAG.
	RC		;RETURN IF CLOSE FLAG.
	PUSH PSW	;SAVE REG A AND PSW.
	PUSH B		;SAVE B&C.

	IF   CPM	;IF CP/M I/O,
	CALL IO		;PRINT CHARACTER.
	DB   LIST
	ENDIF

	IF   STD	;IF STANDARD I/O,
	CALL LSTOUS	;PRINT CHARACTER.
	ENDIF

	POP  B		;RESTORE B&C.
	POP  PSW	;RESTORE REG A AND PSW.
	RET		;RETURN FROM LSTOUT.

	IF   STD	;IF STANDARD I/O,
;
; LSTOUS - STANDARD LISTING DEVICE ROUTINE.
;
LSTOUS:	PUSH PSW	;SAVE CHARACTER.
LSTOUL:	IN   LSTSP	;READ STATUS.
	ANI  LSTOM	;LOOK AT STATUS BIT.
	JNZ  LSTOUL	;WAIT TILL READY.
	POP  PSW	;GET CHARACTER BACK.
	PUSH PSW	;BACK AGAIN.
	CPI  08H	;IS IT BACKSPACE?
	JNZ  LSTECH	;HOP IF NOT.
	MVI  A,'\'	;PRINT BACKSLASH INSTEAD.
LSTECH:	OUT  LSTDP	;PRINT CHARACTER.
	POP  PSW	;RECOVER ORIG. CHAR.
	RET		;RETURN FROM LSTOUS.
	ENDIF

	IF   CASS	;IF CASSETTE I/O,
;
; CASINP - READ A BYTE FROM CASSETTE RECORDER.
; BYTE RETURNS IN REGISTER A.  IF THE CARRY
; FLAG IS SET UPON RETURN FROM THIS ROUTINE,
; A TAPE READ ERROR HAS OCCURED.
;
CASINP:	PUSH H		;SAVE H&L.
	PUSH D		;SAVE D&E.
	PUSH B		;SAVE B&C.
	CALL CASIN	;READ A BYTE FROM CASSETTE.
	JMP  RET3	;RESTORE REGISTERS & RETURN.
;
CASIN:	JZ   CASINO	;IF ZERO SET, OPEN FILE.
	JC   DEALOC	;IF CARRY, CLOSE FILE.
;
	CALL FNDBLK	;FIND BLOCK ADR, GET STATUS.
	JM   CASIRB	;JUMP IF HAS BEEN READ.
	ORI  80H	;IF NOT, SET READ FLAG.
	MOV  M,A
	CALL CTRD	;READ FROM CASSETTE.
	JZ   CASIRB	;NO ERROR IF ZERO SET.
	STC		;SET CARRY FOR ERROR.
	RET		;RETURN WITH ERROR.
CASIRB:	CALL FNDBYT	;FIND ADDRESS OF BYTE.
	MOV  A,M	;GET THE BYTE.
	RP		;RETURN IF NOT 128 YET.
	PUSH A		;SAVE DATA BYTE ON STACK.
	CALL CTRD	;READ A BLOCK FROM CASSETTE.
	POP  B		;GET DATA BYTE BACK FROM
	MOV  A,B	;STACK WITHOUT CHANGING PSW.
	RZ		;RETURN IF NO ERROR.
	STC		;SET CARRY FOR RETURN
	RET		;WITH ERROR.
;
CASINO:	LHLD EOF	;GET BASIC EOF ADDRESS.
	MVI  M,0	;SET EOF = 0 (FALSE).
	CALL GETBLK	;GET MEM BLOCK & NAME.
; CASRCH - CASSETTE SEARCH FOR FILE WHOSE NAME
; IS IN BLOCK AT BLKADR.  JUST RETURN WHEN FOUND.
CASRCH:	CALL CTRD	;READ NEXT BLOCK FROM CASS.
	RNZ		;RETURN IF CASSETTE ERROR.
	CALL GETBUF	;GET BUFFER & FCB ADDRESS.
	XCHG		;BUFFER @ D&E, FCB @ H&L.
	INX  H		;POINT TO NAME.
	MVI  C,11	;GET NAME SIZE.
CASRC1:	LDAX D		;GET BYTE FROM BUFFER.
	CMP  M		;COMPARE TO NAME BYTE.
	JNZ  CASRCH	;TRY AGAIN IF NO MATCH.
	INX  D		;INCREMENT POINTERS.
	INX  H
	DCR  C		;DECREMENT COUNTER.
	JNZ  CASRC1	;COMPARE ANOTHER.
	RET		;RETURN IF MATCH.
;
; CTWT - WRITE A BLOCK TO CASSETTE.
;
CTWT:	CALL RESCTR	;RESET BYTE COUNTER.
	CALL GETBUF	;GET BUFFER ADDRESS IN H&L.
CTWT1:	PUSH H		;SAVE H&L.
	LHLD KIND	;GET KIND (OF TRANSFER).
	MOV  A,M
	POP  H		;RESTORE H&L.
	ANI  2		;IS IT A BINARY TRANSFER?
	LXI  D,10	;JUST 10 BYTES IN GAP?
	JNZ  DELAY	;NO LONG DELAY IF BINARY.
	NOP!NOP!NOP	;TURN YOUR MOTOR ON HERE?
	LXI  D,187*2	;GET 2 SECOND COUNT.
DELAY:	MVI  A,3CH	;WRITE START BYTE.
	CALL CASW
	DCX  D		;DECREMENT COUNT.
	MOV  A,D	;IF D&E ARE
	ORA  E		;NOT YET ZERO,
	JNZ  DELAY	;KEEP COUNTING DOWN.
	MVI  A,0E6H	;WRITE SYNC BYTE.
	CALL CASW
	MVI  C,0	;CLEAR CHECKSUM.
	MVI  A,90H	;WRITE TYPE BYTE.
	CALL CASW
	MOV  A,B	;WRITE LENGTH BYTE.
	CALL CASW
	MOV  A,B	;GET LENGTH BYTE.
	ORA  A		;IF IT'S ZERO,
	JZ   CASEOF	;MUST BE EOF BLOCK.
CTLP:	MOV  A,M	;WRITE DATA BYTE.
	CALL CASW
	INX  H		;INCREMENT POINTER.
	DCR  B		;DECREMENT COUNTER.
	JNZ  CTLP	;REPEAT.
CASEOF:	MOV  A,C	;WRITE CHECKSUM.
	CALL CASW
	NOP!NOP!NOP	;TURN OFF THE MOTOR?
	RET		;RETURN FROM CTWT.
;
CASW:	PUSH PSW	;SAVE DATA ON STACK.
CALP:	IN   CASC	;READ CASSETTE STATUS.
	ANI  20H	;LOOK AT BIT 5.
	JNZ  CALP	;WAIT UNTIL READY.
	POP  PSW	;RECOVER DATA.
	OUT  CASD	;WRITE A BYTE.
	ADD  C		;ADD TO CHECKSUM.
	MOV  C,A
	RET		;RETURN FROM CASW.
;
; CTRD - READ A RECORD FROM CASSETTE.
; INTO BUFFER AT ADDRESS IN H&L.
;
CTRD:	CALL RESCTR	;RESET BYTE COUNTER.
	CALL GETBUF	;GET BUFFER ADDRESS.
	CALL CASW	;DELAY TO ALLOW LAST
	CALL CASW	;BYTE TO PASS THROUGH.
	MVI  E,0	;SET CHECKSUM=0.
	MVI  A,10H	;SET BIT 4=1.
	OUT  CASC	;RESET RECEIVER.
	CALL CASR	;READ TYPE BYTE.
	CALL CASR	;READ LENGTH BYTE.
	MOV  B,A	;PUT LENGTH BYTE IN B.
	JZ   CASREF	;END-OF-FILE IF LENGTH 0.
	MOV  C,A	;PUT LENGTH IN C TOO.
CRLOP:	CALL CASR	;READ DATA BYTE.
	MOV  M,A	;PUT INTO MEMORY.
	INX  H		;INCREMENT POINTER.
	DCR  C		;DECREMENT COUNTER.
	JNZ  CRLOP	;READ ANOTHER BYTE.
	MOV  C,E	;PUT CHECKSUM IN C.
	CALL CASR	;READ CHECKSUM.
	SUB  C		;SUBTRACT FROM A.
	RET		;RETURN FROM CRLOP.
;
CASR:	IN   CASC	;READ CASS. STATUS.
	ANI  10H	;CHECK BIT 4.
	JNZ  CASR	;WAIT TILL READY.
	IN   CASD	;READ DATA.
	PUSH PSW	;SAVE REG A.
	ADD  E		;ADD TO CHECKSUM.
	MOV  E,A
	POP  PSW	;RESTORE A.
	ORA  A		;SET FLAGS.
	RET		;RETURN FROM CASR.
;
CASREF:	LHLD EOF	;GET BASIC EOF ADDRESS.
	MVI  M,1	;SET EOF = 1 (TRUE).
	RET		;RETURN FROM CTRD.
;
; CASOUT - OUTPUT ONE BYTE TO CASSETTE RECORDER.
; ON ENTRY, IF REG A=1, INITIALIZE.
; 	IF CARRY SET, END OF TRANSFER.
;	DATA BYTE IS IN REGISTER A.
;
CASOUT:	PUSH H		;SAVE ALL REGISTERS.
	PUSH D
	PUSH B
	PUSH PSW
	CALL CASOU	;ONE BYTE OUT TO CASS.
	JMP  RET4	;RESTORE REG & RETURN.
;
CASOU:	JZ   CASOOP	;OPEN FILE IF ZERO SET.
	JC   CASOCL	;CLOSE FILE IF CARRY SET.
;
CASOWT:	STA  DATA	;SAVE DATA BYTE.
	CALL FNDBLK	;FIND BLOCK ADDRESS.
	ANI  7FH	;CLEAR ANY READ STATUS.
	ORI  40H	;SET TO WRITE STATUS.
	MOV  M,A
	CALL FNDBYT	;FIND BYTE ADDRESS.
	LDAX D		;GET BYTE COUNT.
	MOV  B,A	;PUT IN REG A FOR CTWT.
	LDA  DATA	;GET DATA BYTE.
	MOV  M,A	;PUT INTO BUFFER.
	JM   CTWT	;IF 128, WRITE TO CASS.
	RET		;RETURN FROM CASOU.
;
CASOOP:	CALL GETBLK	;GET ADDRESS OF BLOCK.
	CALL GETBUF	;GET BUFFER & FCB ADR.
	XCHG		;PUT FCB ADR IN H&L.
	INX  H		;POINT TO NAME.
	MVI  B,11	;GET NAME LENGTH.
	JMP  CTWT1	;WRITE NAME TO CASS.
;
CASOCL:	LHLD BLKADR	;GET BLOCK ADDRESS.
	INX  H		;POINT TO COUNTER.
	MOV  B,M	;GET COUNT.
	MOV  A,B	;LOOK AT COUNT.
	ORA  A		;IF IT'S ZERO, NO NEED
	JZ   CASOC1	;WRITE TWO EOF'S.
	CALL CTWT	;WRITE REST OF FILE.
	MVI  B,0	;WRITE BLOCK OF LENGTH 0
CASOC1:	CALL CTWT1	;FOR END-OF-FILE MARK.
	JMP  DEALOC	;DEALLOCATE BLOCK.
	ENDIF

	IF NOT DISK
; RETURNS FOR DISK COMMANDS.
DIR:	RET		;DIRECTORY.
RENAME:	RET		;RENAME FILES.
ERASE:	RET		;ERASE FILE.
RESET:	RET		;RESET DISK SYSTEM.
SEARCH:	RET		;SEARCH FUNCTION.
FILEXI:	RET		;FILE EXISTS FUNCTION.
	ENDIF

	IF   DISK
;
; DIR - DO DIRECTORY LISTING.
;
DIR:	CALL SETBUF	;SET DMA ADDRESS.
	LXI  H,FCB+1	;MAKE FILE NAME EQUAL
	MVI  B,11	;TO 11 QUESTION MARKS.
DIR1:	MVI  M,'?'
	INX  H
	DCR  B
	JNZ  DIR1
	CALL DIRSCH	;SEARCH DIRECTORY.
DIR2:	RZ		;RETURN IF NOT FOUND.
	CALL CRLF	;DO A CARRIAGE-RETURN.
	LDA  TEMP	;GET BYTE ADDRESS.
	RRC!RRC!RRC	;DIVIDE BY 8.
	ANI  60H	;LOOK AT BITS 5&6.
	MOV  C,A	;SET B&C = A.
	MVI  B,0
	LXI  H,TBUFF+1	;GET BUFFER ADR + 1.
	DAD  B		;FIGURE NAME ADDRESS.
	MVI  B,8	;PRINT FILE NAME.
	CALL PNTSTR
	MVI  A,' '	;PRINT A SPACE.
	ORA  A		;CLEAR FLAGS.
	CALL CONO
	MVI  B,3	;PRINT EXTENTION.
	CALL PNTSTR
; END OF DIRECTORY ENTRY.
	XRA  A		;CHECK KEYBOARD STATUS.
	CALL CONI
	RZ		;RETURN IF CTL-C PUSHED.
	CALL SCHNXT	;SEARCH FOR NEXT ENTRY.
	JMP  DIR2	;GO AROUND AGAIN.
;
; SETBUF - SET DMA ADDRESS = DEFAULT BUFFER.
;
SETBUF:	LXI  D,TBUFF	;GET DEFAULT BUFFER ADR.
	MVI  C,26	;GET CODE TO SET DMA ADR.
	JMP  BDOS	;CALL BDOS & RETURN.
;
; PNTSTR - PRINT A STRING OF CHARACTERS AT
; ADDRESS IN H&L, LENGTH GIVEN BY B.
;
PNTSTR:	MOV  A,M	;GET CHARACTER.
	INX  H		;INCREMENT POINTER.
	ORA  A		;CLEAR FLAGS.
	CALL CONO	;PRINT THE CHARACTER.
	DCR  B		;DECREMENT COUNT.
	JNZ  PNTSTR	;KEEP GOING?
	RET		;RETURN WHEN DONE.
;
; CRLF - CARRIAGE-RETURN, LINE-FEED.
;
CRLF:	MVI  A,0DH	;GET CR.
	CALL CONO	;PRINT IT.
	MVI  A,0AH	;GET LF.
	CALL CONO	;PRINT IT.
	RET
;
; DIRSCH - SEARCH DIRECTORY.
;
DIRSCH:	LXI  D,FCB	;GET FCB ADDRESS.
	MVI  C,17	;CODE TO SEARCH FOR FILE.
	CALL BDOS	;DO IT.
	STA  TEMP	;SAVE BYTE ADDRESS.
	INR  A		;TEST FOR BEING = 255.
	RET		;RETURN FROM DIRSCH.
SCHNXT:	LXI  D,FCB	;GET FCB ADDRESS.
	MVI  C,18	;CODE TO SEARCH NEXT.
	CALL BDOS	;DO IT.
	STA  TEMP	;SAVE BYTE ADDRESS.
	INR  A		;TEST FOR NOT FOUND.
	RET		;RETURN FROM SCHNXT.
;
; RENAME - RENAME A FILE.
;
RENAME:	LHLD NAME	;GET ADR OF ADR OF NAME.
	MOV  E,M	;GET ADR OF NAME IN D&E.
	INX  H
	MOV  D,M
	LXI  H,TBUFF	;GET DEFAULT BUFFER ADR.
RENAM1:	LDAX D		;GET BYTE FROM STRING.
	INX  D		;INCREMENT STRING POINTER.
	ORA  A		;IS BIT 7 SET?
	RM		;RETURN IF IT IS.
	MOV  M,A	;PUT INTO BUFFER.
	INX  H		;INCREMENT BUFFER POINTER.
	CPI  '='	;IS IT EQUAL SIGN?
	JNZ  RENAM1	;KEEP LOOKING IF NOT.
	DCX  H		;POINT TO LAST BYTE
	DCX  H		;  OF FIRST NAME.
	MOV  A,M	;SET BIT 7 = 1.
	ORI  80H
	MOV  M,A
	LHLD NAME	;SET NAME PTR = D&E.
	MOV  M,E
	INX  H
	MOV  M,D
	LXI  D,FCB+1	;GET ADR TO PUT 2ND NAME.
	CALL GETNAM	;PUT IT THERE.
	LHLD NAME	;SET NAME PTR = TBUFF.
	LXI  D,TBUFF
	MOV  M,E
	INX  H
	MOV  M,D
	LXI  D,FCB+17	;PUT 1ST NAME HERE.
	CALL GETNAM
	LXI  D,FCB	;NOW IT'S TIME
	MVI  C,23	;TO RENAME
	JMP  BDOS	;USING THE DOS.
;
; ERASE - ERASE A FILE.
;
ERASE:	PUSH H		;SAVE REGISTERS.
	PUSH D
	PUSH B
	PUSH PSW
	LXI  H,FCB-BLKFCB	;GET ADR OF FILE BLOCK.
	CALL GETBPR	;CLEAR FCB AND GET FILE NAME.
	LXI  D,FCB	;GET ADR OF FILE CTL BLOCK.
	MVI  C,19	;GET CODE FOR DELETE.
BDOSRT:	CALL BDOS	;DO OPERATING SYSTEM THING.
	JMP  RET4	;RESTORE REGISTERS & RETURN.
;
; RESET - RESET CP/M (READ NEW DIRECTORY).
;
RESET:	PUSH H		;SAVE ALL REGISTERS.
	PUSH D
	PUSH B
	PUSH PSW
	MVI  C,13	;SET C FOR RESET OPERATION.
	JMP  BDOSRT	;GO TO BDOS AND DO IT.
;
; SEARCH - SEARCH FILE FOR A STRING.
;
SEARCH:	PUSH H		;SAVE ALL REGISTERS.
	PUSH B
	PUSH PSW
	PUSH D		;SAVE ADDRESS OF STRING.
	LXI  H,1	;SET LINE COUNTER = 1.
	SHLD LINCTR
	CALL CKFUNK	;CHECK FUNK BYTE.
SEAR1:	CALL SAVLOC	;SAVE CURRENT NR & EXTENT.
	XRA  A		;CLEAR NEW RECORD FLAG.
	STA  NEWREC
	CALL RDGET	;READ DISK, GET BUFFER ADR.
SEAR6:	POP  D		;RESTORE STRING ADDRESS.
	PUSH D		;SAVE IT BACK.
	LDAX D		;GET STRING BYTE.
	ANI  7FH	;CLEAR BIT 7.
	MOV  B,A	;SAVE STRING BYTE IN B.
; SEARCH BUFFER FOR FIRST BYTE OF STRING.
SEAR2:	MOV  A,M	;GET FILE BYTE FROM BUFFER.
	CPI  1AH	;IS IT END-OF-FILE?
	JZ   SEAR8	;NOT FOUND IF SO.
	CPI  0DH	;IS IT A CARRIAGE-RETURN?
	JNZ  SEAR7	;HOP AHEAD IF NOT.
	PUSH H		;SAVE SECTOR BUFFER POINTER.
	LHLD LINCTR	;OTHERWISE, GET LINE COUNTER,
	INX  H		;INCREMENT IT,
	SHLD LINCTR	;AND PUT IT BACK.
	POP  H		;RESTORE BUFFER POINTER.
SEAR7:	CMP  B		;IS BUFFER BYTE=STRING BYTE?
	JZ   SEAR3	;HOP OUT IF SAME.
	INX  H		;INCREMENT BUFFER POINTER.
	DCR  C		;DECREMENT BYTE COUNT.
	JNZ  SEAR2	;KEEP LOOKING.
	JMP  SEAR1	;GET ANOTHER SECTOR.
; COMPARE REST OF STRING TO BUFFER STRING.
SEAR3:	PUSH H		;MARK PLACE IN SECTOR.
	PUSH B		;SAVE COUNTER (C).
SEAR4:	LDAX D		;GET BYTE BACK.
	ORA  A		;IS BIT 7 SET?
	JM   SEAR5	;LAST BYTE IF IT IS.
	INX  D		;INCREMENT STRING POINTER.
	INX  H		;INCREMENT BUFFER POINTER.
	DCR  C		;DECREMENT BUFFER BYTE COUNT.
	JNZ  SEAR9	;HOP AROUND IF NOT ZERO.
	PUSH D		;SAVE STRING POINTER.
	MVI  A,1	;SET NEW RECORD FLAG.
	STA  NEWREC
	CALL RDGET	;READ A SECTOR.
	POP  D		;RESTORE D&E.
SEAR9:	LDAX D		;GET STRING BYTE.
	ANI  7FH	;CLEAR BIT 7.
	CMP  M		;ARE THEY THE SAME?
	JZ   SEAR4	;KEEP COMPARING IF SO.
	LDA  NEWREC	;GET NEW RECORD FLAG.
	ORA  A		;IF IT'S IN A NEW RECORD,
	JZ   SEAR11
; *** NOTE ***
; TIME CAN BE SAVED HERE FOR THOSE CASES WHEN THE
; FIRST STRING CHARACTER MATCHES THE LAST BYTE IN
; THE BUFFER.  IN THAT CASE, THE CURRENT SYSTEM
; WILL READ THE SECTOR BACK WHEN IT DOESN'T NEED
; TO.  TESTS WOULD NEED TO BE MADE OF THE COUNTER,
; EXTENT, AND NR, TO FIND IF THIS CONDITION EXISTS.
	CALL RESLOC	;RESTORE OLD NR & EXTENT.
	CALL DSKRD	;READ OLD RECORD BACK.
SEAR11:	POP  B		;GET OLD COUNTER.
	POP  H		;GET OLD PLACE IN BUFFER.
	INX  H		;POINT TO NEXT BYTE.
	DCR  C		;DECREMENT COUNTER.
	JNZ  SEAR6	;LOOK FOR FIRST CHAR AGAIN.
	JMP  SEAR1	;READ A NEW SECTOR IF C=0.
; RETURN PROCESSING.
SEAR8:	LXI  D,0	;RETURN WITH D&E=0
	JMP  SEAR10	;SINCE STRING NOT FOUND.
SEAR5:	POP  H		;POP PLACE MARKER.
	POP  H		;POP BYTE COUNTER.
	LHLD LINCTR	;GET LINE COUNTER.
	XCHG		;PUT INTO D&E FOR
SEAR10:	POP  H		;POP STRING POINTER.
	LHLD BLKADR	;GET BLOCK ADDRESS.
	MOV  A,M	;GET BLOCK STATUS BYTE.
	ORI  80H	;SET TO READ STATUS.
	MOV  M,A
	INX  H		;POINT TO BUFFER COUNTER.
	MOV  A,C	;GET BYTE COUNT.
	CMA		;COMPLEMENT IT.
	INR  A		;INCREMENT IT.
	INR  A		;TWICE.
	ANI  7FH	;ONLY 0 TO 127.
	MOV  M,A	;SET BUFFER BYTE COUNT.
SEAR12:	POP  PSW	;RESTORE REGISTERS.
	POP  B
	POP  H
	RET		;RETURN FROM SEARCH.
;
; FILEXIST - DETERMINE WHETHER A FILE EXISTS.
;
FILEXI:	PUSH H		;SAVE REGISTERS.
	PUSH B
	PUSH PSW
	LHLD NAME	;GET ADR OF ADR OF NAME.
	MOV  M,E	;MAKE NAME ADR = D&E.
	INX  H
	MOV  M,D
	CALL SETBUF	;SET DMA ADR=TBUFF.
	LXI  H,FCB-BLKFCB  ;USE DEFAULT FCB.
	CALL GETBPR	;PUT NAME INTO FCB.
	CALL DIRSCH	;DO DIRECTORY SEARCH.
	LXI  D,0	;RETURN D&E=0 IF NOT FOUND.
	JZ   SEAR12	;RESTORE REGISTERS & RETURN.
	DCX  D		;RETURN D&E=-1 IF FOUND.
	JMP  SEAR12	;RESTORE REGISTERS & RETURN.
;
; RDGET - READ A SECTOR, GET BUFFER ADR, SET C.
;
RDGET:	CALL DSKRD	;READ A SECTOR INTO BUFFER.
	CALL GETBUF	;GET BLOCK BUFFER ADDRESS.
	MVI  C,128	;SET SECTOR BYTE COUNTER.
	RET		;RETURN FROM RDGET.
;
; SAVLOC - SAVE CURRENT RECORD NUMBER AND EXTENT.
;
SAVLOC:	CALL GETNR	;GET NEXT RECORD NUMBER.
	STA  FCBNR	;SAVE IT IN SCRATCH.
	CALL GETEXT	;GET EXTENT NUMBER.
	STA  EXTENT	;SAVE IT THERE TOO.
	RET		;RETURN FROM SAVLOC.
;
; GETEXT - GET CURRENT EXTENT NUMBER.
; RETURNS WITH IT'S ADR IN H&L.
;
GETEXT:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKEXT	;GET EXTENT OFFSET.
	DAD  D		;FIGURE EXTENT ADDRESS.
	MOV  A,M	;GET EXTENT NUMBER.
	RET		;RETURN FROM GETEXT.
;
; GETNR - GET CURRENT NEXT RECORD (NR) NUMBER.
; RETURN WITH IT'S ADDRESS IN H&L.
;
GETNR:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKNR	;GET NR OFFSET.
	DAD  D		;FIGURE NR ADDRESS.
	MOV  A,M	;GET NR NUMBER.
	RET		;RETURN FROM GETNR.
; GETRC - GET RECORD COUNT OF CURRENT EXTENT.
; RETURN WITH IT'S ADDRESS IN H&L.
;
GETRC:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKRC	;GET REC CT OFFSET.
	DAD  D		;FIGURE RC ADDRESS.
	MOV  A,M	;GET RECORD COUNT.
	RET		;RETURN FROM GETRC.
;
; MOVBEG - MOVE TO BEGINNING OF FILE.
;
MOVBEG:	CALL GETNR	;GET NR LOCATION.
	MVI  M,0	;SET NR = 0.
	CALL GETEXT	;GET EXTENT NUMBER.
	ORA  A		;IS EXTENT ZERO?
	RZ		;RETURN IF IT IS.
	MVI  M,0	;SET EXTENT = ZERO.
	JMP  DSKOP2	;OPEN FILE.
;
; MOVEOF - MOVE TO THE END OF FILE.
;
MOVEOF:	CALL GETEXT	;GET CURRENT EXTENT #.
	INR  M		;INCREMENT BY ONE.
	CALL DSKOP2	;OPEN NEW EXTENT.
	CALL GETRC	;GET RECORD COUNT.
	ORA  A		;IS IT ZERO?
	JNZ  MOVEOF	;KEEP GOING IF NOT.
; BACK UP TO LAST EXTENT.
	CALL GETEXT	;GET CURRENT EXTENT NO.
	DCR  M		;DECREMENT IT ONCE.
	CALL DSKOP2	;OPEN PREVIOUS EXTENT.
	CALL GETRC	;GET RECORD COUNT.
	MOV  B,A	;SAVE IT.
	CALL GETNR	;GET NEXT RECORD NO.
	MOV  M,B	;SET NR = RC.
	CALL DSKRDN	;READ WITH NO INCREMENT.
	CALL GETBUF	;GET BLOCK BUFFER ADR.
	MVI  A,1AH	;LET A = EOF (1A).
	MVI  C,0	;SET COUNTER = 0.
MOVEO1:	CMP  M		;IS THE BYTE A 1AH?
	JZ   MOVEO2	;HOP OUT IF SO.
	INR  C		;INCREMENT COUNTER.
	JP   MOVEO1	;LOOP TILL C=128.
	DCR  C		;MAKE C=127.
MOVEO2:	LHLD BLKADR	;GET BLOCK ADR.
	INX  H		;POINT TO BYTE COUNT.
	MOV  M,C	;SET COUNTER TO EOF POS.
	RET
;
; CKFUNK - CHECK THE FUNK BYTE AND DO WHAT
; THE SET BITS INDICATE.
;
CKFUNK:	LHLD FUNK	;GET ADR OF FUNK BYTE.
	MOV  A,M	;GET FUNK BYTE.
	ORA  A		;IS FUNK BYTE ZERO?
	RZ		;RETURN IF IT IS.
	ANI  40H	;IS BIT 6 SET?
	CNZ  MOVBEG	;MOVE TO BEGINNING IF SO.
	LHLD FUNK	;GET ADR OF FUNK BYTE.
	MVI  M,0	;SET FUNK BYTE TO ZERO.
	RET		;RETURN FROM CKFUNK.
;
; EOFCHK - CHECK REGISTER A FOR END-OF-FILE
; MARK (1AH).  IF IT IS, SET EOF=1 IN SCRATCH
; AREA OF BASIC.  DON'T CHANGE PSW OR REG A.
;
EOFCHK:	PUSH PSW	;SAVE PSW AND A.
	CPI  1AH	;IS A=1AH?
	JNZ  RET4	;RETURN IF NOT.
	LHLD EOF	;GET EOF ADDRESS.
	MVI  M,1	;SET EOF = 1.
	ENDIF

;
; RET4, RET3 - COMMON ROUTINE TO RESTORE REGISTERS
; AND RETURN TO CALLING ROUTINE.
;
RET4:	POP  PSW	;RESTORE PSW&A.
RET3:	POP  B		;RESTORE B&C.
	POP  D		;RESTORE D&E.
	POP  H		;RESTORE H&L.
	RET		;RET FROM CALLING ROUT.
;
; RESCTR - RESET THE BYTE COUNTER, WHICH IS THE
; SECOND BYTE IN THE FILE BLOCK.
;
RESCTR:	LHLD BLKADR	;GET BLOCK ADDRESS.
	INX  H		;POINT TO COUNTER.
	MVI  M,0	;RESET COUNTER.
	RET
;
; GETBUF - GET BLOCK BUFFER ADDRESS.
; RETURNS WITH BUFFER ADDRESS IN H&L,
; AND WITH FCB ADDRESS IN D&E.
;
GETBUF:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKBUF	;GET BUFFER OFFSET.
	XCHG		;SAVE BLOCK ADR IN D&E.
	DAD  D		;CALC BUFFER ADDRESS.
INXD4:	INX  D		;POINT TO COUNTER.
	INX  D		;POINT TO SPARES.
	INX  D
	INX  D		;POINT TO FCB.
	RET
;
; GETBLK - GET ADDRESS OF A FREE BLOCK OF MEMORY.
; PUT BLOCK ADDRESS IN BLKADR.
; IF SAVE OR LOAD PROGRAM OPERATION IN PROGRESS,
; BLOCK STARTS AT FCB-4 (0058H).
;
GETBLK:	LHLD KIND	;GET ADR OF KIND BYTE.
	MOV  A,M	;GET THE KIND BYTE.
	ANI  04H	;PROGRAM OR DATA?
	LXI  H,FCB-BLKFCB  ;GET ADR OF FILE BLOCK.
	JZ   GETBPR	;MUST BE PROGRAM.
;
	LHLD FILE	;GET ADDRESS OF FILE NUMBER.
	MOV  E,M	;GET FILE NUMBER.
	MVI  D,0	;INTO D&E.
	XCHG		;PUT FILE NUMBER INTO H&L
	DAD  H		;SO IT CAN BE DOUBLED.
	LXI  D,BLKTAB	;GET ADDRESS OF BLOCK TABLE.
	DAD  D		;ADD IT TO (FILE NUMBER)*2.
	PUSH H		;SAVE BLOCK TABLE POINTER.
	XCHG		;PUT INTO D&E FOR BACK POINTER.
	MVI  A,0C0H	;ID FOR EXTERNAL RAM REQUESTS.
	LXI  H,BLKSIZ	;GET BLOCK SIZE REQUIRED.
	CALL CALLI	;CALL THE BASIC SUBROUTINE
	DW   AMBL	;TO ALLOCATE SPACE.
	XCHG		;PUT ASSIGNED ADDRESS IN D&E.
	POP  H		;GET BLOCK TABLE POINTER.
	MOV  M,E	;PUT BLOCK ADR INTO TABLE.
	INX  H
	MOV  M,D
	XCHG		;PUT BLOCK ADR IN H&L.
GETBPR:	SHLD BLKADR	;SAVE BLOCK ADDRESS.
;
	MVI  B,BLKFCB+16  ;GET LENGTH OF AREA.
	LXI  D,BFCB	;GET ADR OF BLANK FCB.
	CALL MOVE	;SET FCB TO BLANK.
;
	CALL GETBUF	;GET FCB ADR IN D&E.
	INX  D		;POINT TO NAME ADDRESS.
;
; GETNAM - GET THE NAME OF THE FILE FROM BASIC
; AT ADDRESS IN LOCATION "NAME";  PUT THE NAME
; STARTING AT ADDRESS IN D&E.
;
GETNAM:	PUSH D		;SAVE D&E.
	LXI  H,8	;8 CHARS BEFORE EXTENTION.
	DAD  D		;CALC ADDRESS OF EXTENTION.
	SHLD  TEMP	;SAVE IT.
	LHLD NAME	;GET ADR OF ADR OF NAME.
	MOV  E,M	;GET NAME ADR LO BYTE.
	INX  H
	MOV  D,M	;GET NAME ADR HI BYTE.
	POP  H		;RESTORE WHAT WAS IN D&E.
	MVI  C,11	;COUNT ELEVEN BYTES.
GETNA1:	LDAX D		;GET CHAR FROM NAME.
	ANI  7FH	;CLEAR MSB.
	CPI  '.'	;IS IT A DECIMAL POINT?
	JNZ  GETNA2	;HOP IF NOT.
	MVI  C,4	;SET REMAINING COUNT=4.
	LHLD TEMP	;GET EXTENTION ADDRESS.
	JMP  GETNA3	;PROCEED.
GETNA2:	MOV  M,A	;PUT INTO FCB.
	INX  H		;INCREMENT POINTERS.
GETNA3:	LDAX D		;GET CHAR AGAIN.
	INX  D		;INCREMENT D&E.
	DCR  C		;DECREMENT DOWN COUNTER.
	RZ		;RETURN IF 11 CHARS.
	ORA  A		;IS MSB SET?
	JP   GETNA1	;IF NOT MSB, GET ANOTHER.
	RET		;RETURN IF MSB SET.
;
; FNDBLK - FIND ADDRESS OF BLOCK.
; IF FILE NOT OPEN OR NOT BEING USED, Z=1.
; IF FILE BEING USED FOR READ, M=1.
; RETURN WITH STATUS BYTE IN REGISTER A,
; AND WITH BLOCK ADDRESS IN H&L.
;
FNDBLK:	LHLD KIND	;GET ADR OF KIND BYTE.
	MOV  A,M	;GET THE KIND BYTE.
	ANI  04H	;PROGRAM OR DATA?
	LXI  H,FCB-BLKFCB  ;GET ADR OF DEFAULT BLOCK.
	JZ   FNDBL1	;HOP AROUND IF PROGRAM.
;
	LHLD FILE	;GET ADR OF FILE NO.
	MOV  E,M	;GET FILE NUMBER.
	MVI  D,0	;INTO D&E.
	XCHG		;PUT FILE NO. IN H&L.
	DAD  H		;DOUBLE FILE NUMBER.
	LXI  D,BLKTAB	;GET ADR OF BLOCK TABLE.
	DAD  D		;FIGURE ADR OF POINTER.
	MOV  E,M	;GET POINTER LOW BYTE.
	INX  H		;GET POINTER HIGH BYTE.
	MOV  D,M
	MOV  A,D
	ORA  E		;IF IT'S ZERO,
	XCHG		;HL=BLOCK ADDRESS.
	RZ		;FILE NOT OPEN.
FNDBL1:	MOV  A,M	;GET STATUS BYTE.
	ORA  A		;SET FLAGS.
	SHLD BLKADR	;SAVE BLOCK ADDRESS.
	RET		;RETURN FROM FNDBLK.
;
; FNDBYT - FIND THE ADDRESS OF THE BYTE.
;
FNDBYT:	LHLD BLKADR	;GET BLOCK ADDRESS.
	INX  H		;POINT TO BUFFER COUNTER.
	PUSH H		;SAVE COUNTER ADDRESS.
	MOV  A,M	;GET BUFFER COUNTER.
	LXI  D,BLKBUF-1	;GET BLOCK BUFFER OFFSET.
	DAD  D		;FIGURE BUFFER ADDRESS.
	MOV  E,A	;ADD BUFFER COUNTER
	DAD  D		;TO FIGURE BYTE ADDRESS.
	POP  D		;RECOVER BUFFER CTR ADR.
	XCHG		;CTR PTR TO H&L.
	ORA  A		;CLEAR CARRY FLAG.
	INR  M		;INCREMENT BUFFER COUNTER.
	XCHG		;BYTE POINTER TO H&L.
	RET		;RETURN FROM FNDBYT.

	IF   DISK	;IF DISK I/O,
;
; DSKINP - READ A BYTE FROM THE CURRENT DISK FILE.
; BYTE RETURNS IN REGISTER A.  IF THE CARRY FLAG
; IS SET UPON RETURN FROM THIS ROUTINE, A DISK
; READ ERROR HAS OCCURED.
;
DSKINP:	PUSH H		;SAVE H&L.
	PUSH D		;SAVE D&E.
	PUSH B		;SAVE B&C.
	CALL DSKIN	;OTHERWISE, READ BYTE.
	JMP  EOFCHK	;CHECK A FOR END-OF-FILE.
;
DSKIN:	JZ   DSKOPN	;OPEN FILE IF Z=1.
	JC   DSKCL	;CLOSE FILE IF C=1.
	CALL FNDBLK	;FIND BLOCK ADR, GET TYPE.
	JM   DSKIN1	;JMP IF FIRST SECTOR READ.
	PUSH H		;SAVE H&L.
	PUSH PSW	;SAVE STATUS BYTE.
	ANI  40H	;WAS IT WRITING?
	CNZ  DSKWT1	;WRITE MODIFIED SECTOR.
	POP  PSW	;RESTORE STATUS BYTE.
	POP  H		;RESTORE H&L.
	ORI  80H	;IF NOT, SET FLAG.
	ANI  0BFH	;CLEAR ANY WRITE STATUS.
	MOV  M,A
	ANI  1		;LOOK AT TYPE BIT.
	JNZ  DSKINR	;IF 1, MUST BE RANDOM.
	CALL DSKRD	;THEN DO READ.
	RC		;RETURN IF READ ERROR.
	JMP  DSKIN2	;READ FIRST BYTE NOW.
DSKIN1:	ANI  1		;IS FILE RANDOM TYPE?
	JZ   DSKIN2	;HOP FOLLOWING IF NOT.
	CALL DSKRND	;DIFFERENT SECTOR?
	JZ   DSKIN2	;HOP IF NOT.
DSKIN3:	CALL SETRND	;SET UP FCB IF SO.
	CALL DSKRD1	;GET NEW SECTOR IF REQUIRED.
DSKIN2:	CALL FNDBYT	;FIND ADR OF BYTE.
	MOV  A,M	;GET THE BYTE.
	RP		;RETURN IF NOT 128 YET.
	PUSH A		;SAVE DATA BYTE ON STACK.
	CALL DSKRD	;READ FROM DISK.
	POP  B		;GET DATA BYTE BACK FROM
	MOV  A,B	;STACK WITHOUT CHANGING PSW.
	RET		;RETURN FROM DSKIN.
;
DSKINR:	CALL DSKRND	;FIND RANDOM PLACE ON DISK.
	JMP  DSKIN3	;SET & DO RANDOM READ.
;
; DSKOUT - OUTPUT ONE BYTE TO CURRENT DISK FILE.
;	IF CARRY SET, END OF TRANSFER.
;	IF ZERO SET, START OF TRANSFER.
;	DATA BYTE IS IN REGISTER A.
;
DSKOUT:	PUSH H		;SAVE ALL REGISTERS.
	PUSH D
	PUSH B
	PUSH PSW
	CALL DSKOU	;OUTPUT TO DISK.
	JMP  RET4	;RESTORE REGISTERS & RET.
;
DSKOU:	JZ   DSKOPN	;OPEN FILE IF ZERO SET.
	JC   DSKCL	;CLOSE FILE IF CARRY SET.
	STA  DATA	;SAVE DATA BYTE.
	CALL FNDBLK	;FIND BLOCK ADDRESS.
	ANI  40H	;HAVE WE DONE A WRITE YET?
	JNZ  DSKOUA	;JUMP IF WE HAVE.
	MOV  A,M	;GET STATUS BYTE BACK.
	ANI  7FH	;CLEAR ANY READ STATUS.
	ORI  40H	;SET TO WRITE STATUS.
	MOV  M,A
	ANI  01H	;IS IT A RANDOM FILE?
	JNZ  DSKOUR	;HOP OUT IF SO.
	JMP  DSKOUB
;
DSKOUA:	MOV  A,M	;GET STATUS BACK.
	ANI  1		;IS IT A RANDOM FILE?
	JZ   DSKOUB	;HOP AROUND IF NOT.
	CALL DSKRND	;SEE IF NEW SECTOR.
	JZ   DSKOUB	;HOP IF NOT NEW SECTOR.
	CALL DSKWT1	;WRITE MODIFIED SECTOR.
DSKOUC:	CALL SETRND	;SET RANDOM PARAMETERS.
	CALL DSKRDN	;READ WITH NO INCREMENT.
	RC		;RETURN IF READ ERROR.
DSKOUB:	CALL FNDBYT	;GET BYTE ADDRESS.
	LDA  DATA	;PUT DATA BYTE IN BUFFER.
	MOV  M,A
	JM   DSKWT	;IF 128, WRITE TO DISK.
	RET		;RESTORE & RETURN.
;
DSKOUR:	CALL DSKRND	;FIGURE RANDOM PLACE.
	JMP  DSKOUC	;SET AND READ SECTOR.
;
; DSKRND - RANDOM DISK FILE CHECK AND SET.
; IF RANDOM RECORD:
;    SAME RECORD AS BEFORE:  RETURN WITH Z=1.
;    NEW RECORD:
;	SAME SECTOR:  SET BLKCTR, RETURN WITH Z=1.
;	DIFF SECTOR:  SET BLKCTR, RETURN WITH Z=0.
;	DIFF EXTENT:  SET BLKCTR, RETURN WITH Z=0.
;
DSKRND:	LHLD RECORD	;GET ADR OF RECORD NUMBER.
	MOV  A,M	;GET RECORD NUMBER LOW.
	INX  H
	ORA  M		;IS RECORD NUMBER = 0?
	RZ		;RETURN IF IT IS.
;
	MOV  B,M	;PUT NEW REC # IN B&C.
	XRA  A		;SET RECORD(N) = 0.
	MOV  M,A
	DCX  H
	MOV  C,M
	MOV  M,A
	DCX  B		;MAKE THE FIRST RECORD #1.
	LHLD BLKADR	;GET BLOCK (STATUS) ADDRESS.
	XCHG		;SAVE BLOCK LOCATION.
	LXI  H,BLKRL	;GET OFFSET FOR RECORD LENGTH.
	DAD  D		;CALC ADDRESS OF REC LEN.
	MOV  E,M	;SET D&E = RECORD LENGTH.
	INX  H
	MOV  D,M
	XCHG		;SET H&L = RECORD LENGTH.
; TOTAL BYTE COUNT = (RECORD LENGTH)*(RECORD NUMBER).
; ALLOW FOR 3-BYTE RESULT (16 MBYTES).
; HL = RECORD LENGTH, BC = RECORD NUMBER.
	MOV  D,C	;MULTIPLY DE = C*L.
	MOV  E,L
	CALL CALLI
	DW   MULT
	MOV  A,E	;SAVE FIRST COLUMN TOTAL.
	STA  MULC1
;
	ANI  7FH	;BLKCTR = BYTECOUNT AND 7FH.
	STA  COUNT
	MOV  A,D	;KEEP PARTIAL COLUMN 2.
;
	MOV  D,C	;MULTIPLY DE = C*H.
	MOV  E,H
	CALL CALLI
	DW   MULT
	MOV  C,L	;C = RECORD LENGTH LOW.
	MOV  L,A	;GET 2ND COLUMN.
	MOV  A,H	;A = RECORD LENGTH HIGH.
	MVI  H,0
	DAD  D		;ADD D&E TO 2ND COLUMN.
	SHLD MULC2	;SAVE PARTIAL 2ND & 3RD.
;
	MOV  D,B	;MULTIPLY DE = B*L.
	MOV  E,C	;C HAS PREVIOUS L.
	CALL CALLI
	DW   MULT
	LHLD MULC2	;GET COLUMN 2 & 3.
	DAD  D		;ADD B*L TO IT.
	SHLD MULC2	;SAVE COLUMNS 2 & 3.
;
	MOV  E,B	;MULTIPLY DE = B*H.
	MOV  D,A	;A HAS PREVIOUS H.
	CALL CALLI
	DW   MULT
	LDA  MULC3	;GET 3RD COLUMN SUBTOTAL.
	ADD  E		;ADD LAST PARTIAL PRODUCT.
	STA  MULC3	;SAVE FINAL COLUMN 3.
; SECTOR NUMBER = BYTE COUNT DIVIDED BY 128.
; ONLY 2 BYTES REQUIRED FOR SECTOR NUMBER.
	LHLD MULC1	;GET COLUMNS 1 & 2.
	DAD  H		;SHIFT LEFT 1.
	MOV  A,H	;A = COLUMN 1.
	LHLD MULC2	;GET COLUMNS 2 & 3.
	DAD  H		;SHIFT LEFT 1.
	MOV  B,H	;B = COLUMN 2.
; NEXT RECORD (NR) = SECTOR NUMBER AND 7FH.
	MOV  L,A	;SAVE COLUMN 1.
	ANI  7FH	;CALC NR.
	MOV  C,A	;SAVE NEW NR IN C.
	STA  FCBNR	;ALSO IN SCRATCH.
; EXTENT = SECTOR NUMBER DIVIDED BY 128.
; ONLY 1 BYTE REQUIRED FOR EXTENT NUMBER.
	MOV  H,B	;H&L = COLUMNS 1&2.
	DAD  H		;SHIFT LEFT 1.
	MOV  A,H	;SAVE NEW EXTENT IN A.
	STA  EXTENT	;ALSO IN SCRATCH.
;
	LHLD BLKADR	;GET BLOCK ADDRESS.
	INX  H		;POINT TO BYTE COUNTER.
	LDA  COUNT	;GET NEW BYTE COUNT.
	MOV  M,A	;PUT INTO BLOCK.
; SEE IF A NEW RANDOM SECTOR IS REQUIRED.
SECTST:	LHLD BLKADR	;GET BLOCK ADDRESS.
	MOV  B,M	;GET STATUS BYTE IN B.
	XCHG		;PUT BLOCK ADR INTO D&E.
	LXI  H,BLKEXT	;GET LOCATION OF EXTENT.
	DAD  D		;FIGURE EXTENT ADDRESS.
	XCHG		;PUT EXTENT ADR IN D&E.
	LXI  H,BLKNR-BLKEXT  ;CALCULATE ADDRESS
	DAD  D		;OF BLOCK FCB NR.
	XCHG		;PUT EXTENT ADR IN H&L.
	LDA  EXTENT	;GET NEW EXTENT.
	CMP  M		;IS NEW EXTENT = OLD?
	RNZ		;RET WITH Z=0 IF SO.
	MOV  A,B	;GET STATUS BYTE.
	XCHG		;PUT OLD NR ADR IN H&L.
	MOV  B,M	;GET OLD FCB NR.
	XCHG		;NR=(DE), EXTENT=(HL).
	ORA  A		;WE IN READ MODE?
	JP   SECTS1	;HOP IF NOT.
	DCR  B		;DECREMENT CURRENT NR.
SECTS1:	LDA  FCBNR	;GET NEW NR.
	CMP  B		;ARE THEY THE SAME?
	RET		;Z=1 IF NO SECTOR REQ.
;
; SETRND - SET RANDOM PARAMETERS INTO BLOCK FCB.
; THIS INCLUDES EXTENT AND NR (NEXT RECORD).
;
SETRND:	CALL SECTST	;HL=EXT ADR, DE=NR ADR.
	LDA  FCBNR	;GET NEW NR.
	STAX D		;REPLACE OLD NR WITH IT.
	LDA  EXTENT	;GET NEW EXTENT.
	CMP  M		;SAME AS OLD ONE?
	RZ		;RETURN IF SAME.
	MOV  M,A	;REPLACE OLD EXTENT.
	JMP  DSKOP2	;OPEN NEW EXTENT.
;
; DSKOPN - OPEN THE DISK FILE WHOSE NAME IS AT
; LOCATION "NAME" IN BASIC SCRATCH AREA.
;
DSKOPN:	CALL GETBLK	;GET BLOCK & NAME.
DSKOP:	LHLD DISKNO	;GET ADR OF DISK #.
	MOV  E,M	;GET DISK NUMBER.
	MVI  D,0
	MVI  C,14	;CODE TO SELECT DISK.
	PUSH D		;SAVE DISK NUMBER.
	CALL BDOS	;SELECT THE DISK.
	POP  B		;RECOVER DISK NUMBER.
	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKDN	;GET LOCATION OF DISK #.
	XCHG		;SWAP SO BLKADR SAVED.
	DAD  D		;CALC ADR OF DISK NUMBER.
	MOV  M,C	;PUT DISK # INTO BLOCK.
;
	LHLD EOF	;GET EOF ADDRESS.
	MVI  M,0	;SET EOF=0 (FALSE).
;
	LHLD KIND	;GET ADR OF KIND NUMBER.
	MOV  A,M	;GET KIND NUMBER.
	ANI  04H	;PROGRAM OR DATA?
	JZ   DSKOP5	;PROGRAMS ARE SEQUENTIAL.
;
	LHLD TYPE	;GET ADR OF TYPE NUMBER.
	MOV  A,M	;GET LO TYPE NUMBER.
DSKOP5:	STAX D		;MAKE INIT STATUS = TYPE.
	ANI  0FH	;LOOK AT LOW 4 BITS.
	MOV  H,A	;SET H&L = 0?
	MOV  L,A
	JZ   SEQ	;IF TRANSFER NOT SEQUENTIAL,
;
	LHLD RECORD	;GET ADR OF RECORD LENGTH.
	MOV  E,M	;GET RECORD LENGTH LOW.
	INX  H	
	MOV  D,M	;GET RECORD LENGTH HIGH.
	XCHG		;PUT RECORD LENGTH IN H&L.
SEQ:	PUSH H		;SAVE RECORD LENGTH.
	LHLD BLKADR	;GET CURRENT BLOCK ADR.
	LXI  D,BLKRL	;FIGURE ADR OF REC LENGTH.
	DAD  D
	POP  D		;RECOVER RECORD LENGTH.
	MOV  M,E	;PUT INTO BLOCK.
	INX  H
	MOV  M,D
;
DSKOP1:	CALL DSKOP2	;OPEN FILE IN BLOCK FCB.
	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKNR	;GET LOCATION OF NR.
	XCHG		;SWAP TO SAVE BLKADR.
	DAD  D		;GET ADDRESS OF NR.
	MVI  M,0	;SET NR BYTE = 0.
	INR  A		;WAS FILE FOUND?
	RNZ		;RETURN IF FILE FOUND.
	CALL INXD4	;POINT D&E TO FCB.
	MVI  C,22	;OTHERWISE MAKE FILE.
	CALL BDOS	;DO IT.
	MVI  D,0	;PUT A INTO D&E.
	MOV  E,A
	INR  A		;WAS THERE ROOM?
	JNZ  DSKOP1	;OPEN IF SO.
	RET		;RETURN IF NOT.
;
DSKOP2:	LHLD EOF	;GET BASIC EOF ADDRESS.
	MVI  M,0	;SET EOF = 0 (FALSE).
	CALL GETBUF	;GET FCB ADR IN D&E.
	MVI  C,15	;OPEN FILE.
	JMP  BDOS	;DO IT.
;
; DSKCL - CLOSE THE DISK FILE WHICH IS CONTROLLED
; BY THE BLOCK WHOSE ADDRESS IS IN BLKTAB AT THE
; LOCATION DETERMINED BY "FILE", OR, IN THE CASE
; OF A PROGRAM FILE, THE FILE WHOSE NAME IS IN
; THE DEFAULT FCB AT 5CH.
;
DSKCL:	CALL FNDBLK	;FIND BLOCK ADDRESS.
	JM   DSKCLR	;IF MINUS, WAS READING.
	RZ		;IF 0, INACTIVE.
	ANI  1		;IF RANDOM FILE,
	JNZ  DSKCL1	;  DON'T PUT IN EOF MARK.
	CALL FNDBYT	;FIND BYTE ADDRESS IN BUFR.
	MVI  M,1AH	;PUT IN END-OF-FILE.
DSKCL1:	CALL DSKWT	;WRITE LAST RECORD.
	RC		;RETURN IF ERROR.
DSKCLR:	CALL SELECT	;SELECT DISK DRIVE.
	CALL GETBUF	;GET FCB ADR IN D&E.
	MVI  C,16	;GET CPM CODE FOR CLOSE.
	CALL BDOS	;CLOSE IT.
	ENDIF

DEALOC:	LHLD BLKADR	;GET BLOCK ADDRESS.
	MOV  A,H	;IF BELOW 100H,
	ORA  A
	RZ		;DON'T KILL.
	CALL CALLI	;CALL INDIRECT TO
	DW   KILL	;DEALLOCATE BLOCK.
	RET
;
; BFCB - BLANK FILE CONTROL BLOCK.
; FIRST TWO BYTES ARE TO CLEAR STATUS & COUNTER.
;
BFCB:	DB   0,0,0,0,0,'           ',0,0,0,0

	IF   DISK	;IF DISK I/O,
;
; DSKRD - READ A SECTOR FROM THE SELECTED DISK
; INTO THE BUFFER IN THE BLOCK AT BLKADR.
;
DSKRD:	CALL RESCTR	;RESET BYTE COUNTER.
DSKRD1:	CALL SETSEL	;SET DMA & SELECT.
	CALL GETBUF	;GET FCB ADR IN D&E.
	MVI  C,20	;READ NEXT RECORD.
	CALL BDOS
	LHLD EOF	;GET BASIC EOF ADDRESS.
	MVI  M,0	;SET EOF = 0 (FALSE).
	CPI  1		;IS IT END-OF-FILE?
	CMC		;SET CARRY IF A>1.
	RNZ		;RETURN IF NOT EOF.
	MOV  M,A	;SET EOF = 1 (TRUE).
	RET		;RETURN FROM DSKRD.
;
; DSKWT - WRITE A SECTOR FROM THE BUFFER IN
; THE BLOCK AT BLKADR TO THE SELECTED DISK.
; ALSO RESET DISK BUFFER COUNTER.
;
; DSKWTR - WRITE WITHOUT RESETTING COUNTER.
;
; DSKRDN - READ WITHOUT INCREMENTING NR.
;
DSKWT:	CALL RESCTR	;RESET BYTE COUNTER.
DSKWTR:	CALL DSKWT1	;WRITE BUFFER TO DISK.
RDCHK:	LHLD BLKADR	;GET BLOCK ADDRESS.
	MOV  A,M	;GET STATUS BYTE.
	ANI  01H	;LOOK AT TYPE BIT.
	RZ		;RETURN IF NOT RANDOM.
DSKRDN:	CALL SAVLOC	;SAVE CURRENT NR & EXTENT.
	CALL DSKRD1	;READ NEXT SECTOR.
RESLOC:	CALL GETEXT	;GET ADR OF NEW EXTENT.
	LDA  EXTENT	;GET OLD EXTENT BACK.
	CMP  M		;STILL IN SAME EXTENT?
	MOV  M,A	;SET OLD EXTENT BACK
	CNZ  DSKOP2	;OPEN OLD EXTENT IF NOT SAME.
	CALL GETNR	;GET ADR OF NEW NR.
	LDA  FCBNR	;GET OLD NR BACK.
	MOV  M,A	;PUT INTO FCB.
	RET		;RETURN.
;
DSKWT1:	CALL SETSEL	;SET DMA & SELECT.
	CALL GETBUF	;GET FCB ADR IN D&E.
	MVI  C,21	;WRITE NEXT RECORD.
	JMP  BDOS	;DO IT.
;
; SETSEL - SET THE DMA ADDRESS TO THE ADR
; OF THE BUFFER IN THE BLOCK AT BLKADR.
; AND SELECT THE CORRECT DRIVE.
;
SETSEL:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKBUF	;GET BUFFER LOCATION.
	DAD  D		;CALC BUFFER ADDRESS.
	XCHG		;PUT INTO D&E.
	MVI  C,26	;CODE TO SET DMA ADR.
	CALL BDOS	;DO IT.
;
; SELECT - SELECT DISK DRIVE ACCORDING TO NUMBER
; IN BLKADR + BLKDN (37).
;
SELECT:	LHLD BLKADR	;GET BLOCK ADDRESS.
	LXI  D,BLKDN	;GET DISK # LOCATION.
	DAD  D		;CALC DISK # ADDRESS.
	MOV  E,M	;D&E = DISK NUMBER.
	MVI  C,14	;CODE TO SELECT DISK.
	JMP  BDOS	;CALL & RETURN.
	ENDIF

;
; CALLI - CALL INDIRECT THROUGH FOLLOWING LOCATION.
;
CALLI:	XTHL		;GET RETURN ADDRESS.
	PUSH D		;SAVE D&E.
	MOV  E,M	;FISH OUT THE ADDRESS.
	INX  H
	MOV  D,M
	INX  H
	PUSH H		;SAVE THE NEW RETURN ADDRESS.
	XCHG		;GET THE INDIRECT ADDRESS OUT.
	MOV  E,M
	INX  H
	MOV  D,M
	POP  H		;RESTORE RETURN ADDRESS.
	XCHG		;SWAP.
	SHLD TEMP	;SAVE THE CALL ADDRESS.
	POP  H		;RESTORE ORIGINAL D&E.
	XCHG		;BACK TO D&E.
	XTHL		;RETURN ADR TO STACK.
	PUSH H		;SAVE IT AGAIN.
	LHLD TEMP	;GET THE CALL ADDRESS.
	XTHL		;SWAP IT WITH ORIGINAL H&L.
	RET		;DO THE CALL.
;
;
; THIS PART SHOULD BE IN RAM.
;
NEWREC:	DS   1		;NEW RECORD IF NOT 0.
TEMP:	DS   2		;TEMPORARY STORAGE.
LINCTR:	DS   2		;LINE COUNTER FOR SEARCH.
; RANDOM FILE CALCULATION RESULTS.
COUNT:	DS   1		;RANDOM BYTE COUNT FOR BLKCTR.
MULC1:	DS   1		;MULT PRODUCT BYTE 1 (LSB).
MULC2:	DS   1		;MULT PRODUCT BYTE 2
MULC3:	DS   1		;MULT PRODUCT BYTE 3 (MSB).
FCBNR:	DS   1		;RANDOM FCB NEXT RECORD.
EXTENT:	DS   1		;RANDOM FCB EXTENT.
DATA:	DS   1		;TEMPORARY DATA STORAGE.
;
BLKADR:	DS   2		;ADDRESS OF CURRENT BLOCK.
BLKTAB:	DS   128	;ROOM FOR 64 BLOCK ADDRESSES.
	END