;  ACUTER - CUTER MODIFIED FOR ALTAIR 8800.
;
;     Console (pseudo device 0): 1st 2SIO port
;     Serial (pseudo device 1): 2nd 2SIO port
;     Parallel (pseudo device 2): PIO port
;     Tape I/O commands use the Altair ACR.
;
;     HGET command added to input an Intel hex file
;	HGET [pseudo-port]
;
;     HSAVE command added to save an Intel hex file
;	HSAVE start end [pseudo-port]
;
;     Commands can be aborted with CTRL-@ as with CUTER
;
;     Console output does not attempt to emulate VDM
;     functions with terminal escape sequences.
;
;     Be sure to configure RAM and ROM addresses for
;     your system below.
;
;     Ver    Date	Author		Notes
;     1.0  04/25/2015  M. Douglas	Original
;
;-----------------------------------------------------------
;
;
;
;        CUTER(TM)
;
;                 COPYRIGHT (C) 1977
;                 SOFTWARE TECHNOLOGY CORP.
;                 P.O. BOX 5260
;                 SAN MATEO, CA 94402
;                 (415) 349-8080
;
;    A L L    R I G H T S   R E S E R V E D ! ! !
;
;
;        VERSION  1.3
;                 77-03-27
;
;
;  THIS PROGRAM IS DESIGNED TO BE A STANDALONE CUTS
;  OPERATING SYSTEM. CUTER IS DESIGNED TO BE READ IN FROM
;  CASSETTE TAPE OR TO BE RESIDENT IN READ-ONLY-MEMORY.
;  CUTER SUPPORTS VARIOUS DEVICES INCLUDING SERIAL,
;  PARALLEL, THE PROCESSOR TECHNOLOGY VDM(TM) AND UP TO
;  TWO CUTS TAPE DRIVES.
;
;  CUTER(TM) HAS BEEN WRITTEN SO AS TO BE COMPATIBLE WITH
;  SOLOS(TM).  THE FOLLOWING KEYS ARE USED BY CUTER(TM)
;  IN PLACE OF THE SPECIAL KEYS ON THE SOL KEYBOARD:
;
;     MODE            CTL-@
;
;

	ORG	0F000H	;CUTER ROM BASE ADDRESS
RAMADDR	EQU	0BC00H	;CUTER RAM BASE ADDRESS (1K REQUIRED)
;
;
;   AUTO-STARTUP CODE
;
START:	MOV	A,A	;SHOW THIS IS CUTER (SOLOS=00)
INIT:	JMP	STRTA	;SYSTEM RESTART ENTRY POINT
;
;   THESE JUMP POINTS ARE PROVIDED TO ALLOW COMMON ENTRY
; LOCATIONS FOR ALL VERSIONS OF CUTER.  THEY ARE USED
; EXTENSIVELY BY CUTS SYSTEM PROGRAMS AND IT IS RECOMMENDED
; THAT USER ROUTINES ACCESS CUTER ROUTINES THROUGH THESE
; POINTS ONLY!
;
RETRN:	JMP	COMND	;RETURN TO CUTER COMMAND PROCESSOR
FOPEN:	JMP	BOPEN	;CASSETTE OPEN FILE ENTRY
FCLOS:	JMP	PCLOS	;CASSETTE CLOSE FILE ENTRY
RDBYT:	JMP	RTBYT	;CASSETTE READ BYTE ENTRY
WRBYT:	JMP	WTBYT	;CASSETTE WRITE BYTE ENTRY
RDBLK:	JMP	RTAPE	;CASSETTE READ BLOCK ENTRY
WRBLK:	JMP	WTAPE	;CASSETTE WRITE BLOCK ENTRY
;
;     SYSTEM I/O ENTRY POINTS
;
;  THESE FOUR ENTRY POINTS ARE USED TO EITHER INPUT
;  OR OUTPUT TO CUTER PSUEDO PORTS.
;  THESE PSUEDO PORTS ARE AS FOLLOWS:
;
;  PORT   INPUT              OUTPUT
;  ----   -----------------  ---------------------
;   0     1ST 2SIO PORT      1ST 2SIO PORT
;   1     2ND 2SIO PORT	     2ND 2SIO PORT
;   2     PIO PARALLEL PORT  PIO PARALLEL PORT
;   3     USER'S INPUT RTN   USER'S OUTPUT ROUTINE
;
;
;  NOTE: SOUT AND SINP ARE "LDA" INSTRUCTIONS.
;        THIS FACT IS USED TO ALLOW ACCESS TO THE
;        BYTES "OPORT" AND "IPORT" DYNAMICALLY.
;        THESE MUST REMAIN "LDA" INSTRUCTIONS!!!!!
;
SOUT:	LDA	OPORT	;OUTPUT VIA STANDARD OUTPUT PSUEDO PORT
AOUT:	JMP	OUTPR	;OUTPUT VIA PSUEDO PORT SPECIFIED IN REG A
SINP:	LDA	IPORT	;INPUT VIA STANDARD INPUT PSUEDO PORT
AINP:	EQU	$	;INPUT VIA PSUEDO PORT SPECIFIED IN REG A
; -----------END OF SYSTEM ENTRY POINTS----------
;
;
; AINP CONTINUES HERE (IT COULD HAVE BEEN A "JMP" THOUGH)
	PUSH	H	;SAVE HL FM ENTRY
	LXI	H,ITAB
;
;    THIS ROUTINE PROCESSES THE I/O REQUESTS
;
IOPRC:	ANI	3	;KEEP REGISTER "A" TO FOUR VALUES
	RLC		;COMPUTE ENTRY ADDRESS
	ADD	L
	MOV	L,A	;WE HAVE ADDRESS
	JMP	DISPT	;DISPATCH TO IT
;
;
OUTPR:	EQU	$	;PROCESS OUTPUT REQUESTS
	PUSH	H	;SAVE REGS
	LXI	H,OTAB	;POINT TO OUTPUT DISPATCH TABLE
	JMP	IOPRC	;DISPATCH FOR PROPER PSUEDO PORT
;
;
;
; CUTER SYSTEM I/O ROUTINES
;
;
;    THIS ROUTINE IS A MODEL OF ALL INPUT ROUTINES WITHIN
;  CUTER.  THE FIRST ROUTINE "KREA1" PERFORMS THE INPUT
;  FROM THE STANDARD KEYBOARD ON PARALLEL PORT 3.
;  ALL STANDARD INPUT DRIVERS RETURN EITHER THE CHARACTER
;  WITH A NON-ZERO FLAG, OR JUST A ZERO FLAG INDICATING
;  THAT NO CHARACTER IS AVAILABLE YET.  IT WILL BE THE
;  RESPONSIBILITY OF THE USER TO LOOP WAITING FOR A
;  CHARACTER, OR TO USE THE INPUT AS A STATUS REQUEST.
;  WHEN A CHARACTER IS AVAILABLE, IT IS RETURNED IN REG A.
;
;  THE FOLLOWING KEYBOARD ROUTINE MAY BE USED AS A SAMPLE
;  OF HOW TO WRITE A USER INPUT ROUTINE.
;
;         KEYBOARD INPUT ROUTINE
;
KREA1:	EQU	$	;KEYBOARD READ ROUTINE
	IN	SIO1CSR	;GET STATUS WORD (1ST 2SIO PORT)
	ANI	SIORDRF	;RECEIVE DATA AVAILABLE?
	RZ		;ZERO IF NO CHARACTER RECEIVED
;
	IN	SIO1DR	;GET CHARACTER (1ST 2SIO PORT)
	RET		;GO BACK WITH IT
;
;
;
;   SERIAL INPUT ROUTINE
;
SREA1:	EQU	$	;SERIAL INPUT ROUTINE
	IN	SIO2CSR	;GET STATUS (2ND 2SIO PORT)
	ANI	SIORDRF	;TEST FOR SERIAL DATA READY
	RZ		;FLAGS ARE SET
;
	IN	SIO2DR	;GET DATA BYTE (2ND 2SIO PORT)
	RET		;WE HAVE IT
;
;
;   SERIAL DATA OUTPUT
;
SEROT:	EQU	$	;SERIAL OUTPUT ROUTINE
	IN	SIO2CSR	;GET STATUS (2ND 2SIO PORT)
	ANI	SIOTDRE	
	JZ	SEROT	;LOOP UNTIL TRANSMITTER BUFFER IS EMPTY
	MOV	A,B	;GET THE CHARACTER BACK
	OUT	SIO2DR	;SEND IT OUT (2ND 2SIO PORT)
	RET		;AND WE'RE DONE
;
;
; PARALLEL DATA INPUT
PARIT:	EQU	$	;GET CHAR FROM PARALLEL PORT
	IN	PIOCSR	;STATUS (PIO)
	ANI	PIORDRF	;IS DATA READY?
	RZ		;NO--JUST EXIT
;
	IN	PIODR	;YES--GET CHAR THEN
	RET		;THEN EXIT
;
;
;  PARALLEL DATA OUTPUT ROUTINE
PAROT:	EQU	$	;OUTPUT CHAR TO PARALLEL PORT
	IN	PIOCSR	;STATUS (PIO)
	ANI	PIOTDRE	;READY TO SEND?
	JZ	PAROT	;NO
	MOV	A,B	;GET CHAR
	OUT	PIODR	;SEND DATA NOW
	RET		;DONE
;
;
; USER DEFINED INPUT/OUTPUT ROUTINES
ERRIT:	EQU	$	;USER INPUT ROUTINE
	PUSH	H	;SAVE ORIG HL
	LHLD	UIPRT	;GET USER'S RTN ADDR
	JMP	ERRO1	;MERGE TO VERIFY THE ADDR
;
ERROT:	EQU	$	;USER OUTPUT ROUTINE
	PUSH	H	;SAVE ORIG HL
	LHLD	UOPRT	;GET USER'S RTN ADDR
ERRO1:	EQU	$	;WE MERGE HERE TO VFY ADDR
	MOV	A,L	;ZERO=UNDEFINED
	ORA	H	;IS IT?
	JNZ	DISP1	;NO--VALID--OFF TO IT
	JMP	STRTD	;RESET I/O PORTS AND BACK TO COMMAND MODE
;
;
;
;                  VIDEO DISPLAY ROUTINES
;
;
;  THESE ROUTINES ALLOW FOR STANDARD VIDEO TERMINAL
;  OPERATIONS.  ON ENTRY, THE CHARACTER FOR OUTPUT IS IN
;  REGISTER B AND ALL REGISTERS ARE UNALTERED ON RETURN.
;
;
;
VDM01:	EQU	$	;VDM OUTPUT DRIVER
	IN	SIO1CSR	;GET STATUS
	ANI	SIOTDRE
	JZ	VDM01	;LOOP UNTIL TRANSMITTER BUFFER IS EMPTY
	MOV	A,B	;GET THE CHARACTER BACK
	OUT	SIO1DR	;SEND IT OUT
	RET
;
;
;
;                START UP SYSTEM
;
;   CLEAR SCREEN AND THE FIRST 256 BYTES OF GLOBAL RAM
;  THEN ENTER THE COMMAND MODE.
;
STRTA:	IN	PIODR	;READ PIO DATA TO INIT HANDSHAKE
	MVI	A,03H	;RESET 2SIO PORTS
	OUT	SIO1CSR
	OUT	SIO2CSR
	MVI	A,11H	;8N2
	OUT	SIO1CSR
	OUT	SIO2CSR
	XRA	A
	MOV	C,A
	LXI	H,DFLTS	;CLEAR AFTER USER PORT ADDRESSES
;
CLERA:	MOV	M,A
	INX	H
	INR	C
	JNZ	CLERA
;
; DETERMINE THE DEFAULT PORTS
;     THIS COULD BECOME "MVI A,XX" FOR YOUR SPECIFIC PORTS
	IN	SENSE	;GET SWITCHES
;
	MOV	B,A	;SAVE IT
	ANI	3	;MAKE IT A VALID PORT
	STA	DFLTS+1	;SET DEFAULT OUTPUT PORT
	LXI	H,0	;USE FOR CLEARING USER ADDRESSES
	CPI	3	;IS IT A USER PORT
	JZ	STRTC	;YES-- DO NOT CLEAR IT
	SHLD	UOPRT	;NO--CLEAR ADDR
STRTC:	EQU	$	;OUTPUT PORT ALL SET
	MOV	A,B	;FM SENSE SWITCHES
	RAR
	RAR		;NEXT 2 BITS ARE INPUT PORT
	ANI	3	;VALID PORT
	STA	DFLTS	;THIS IS DEFAULT INPUT PORT
	CPI	3	;IS THIS ONE A USER PORT
	JZ	STRTD	;YES--DO NOT CLEAR IT THEN
	SHLD	UIPRT	;NO--FORCE USER ADDRESS ZERO
STRTD:	EQU	$	;1ST TIME INITIALIZATION ALL DONE NOW
	LHLD	DFLTS	;PICK UP DEFAULT PORTS
	SHLD	IPORT	;FORCE PORTS TO DEFAULT
COMN1:	EQU	$	;HERE TO TURN OFF TAPES, THEN COMMAND MODE
;
;
;
;            =--  COMMAND MODE  --=
;
;
;   THIS ROUTINE GETS AND PROCESSES COMMANDS
;
COMND:	LXI	SP,SYSTP	;SET STACK POINTER
	CALL	PROMPT	;PUT PROMPT ON SCREEN
	CALL	GCLI0	;INIT TO GET COMMAND LINE
	CALL	COPRC	;PROCESS THE LINE
	JMP	COMND	;OVER AND OVER
;
;
;
;   THIS ROUTINE READS A COMMAND LINE FROM THE SYSTEM
;  KEYBOARD
;
;  C/R   TERMINATES THE SEQUENCE ERASING ALL CHARS TO THE
;        RIGHT OF THE CURSOR
;  L/F   TERMINATES THE SEQUENCE
;  ESC   RESETS TO COMMAND MODE.
;
GCLI0:	EQU	$	;HERE TO INIT FOR GCLIN
	LXI	H,INLIN-1	;PT TO CHAR IN FRONT OF INPUT BFR
	MVI	M,7	;MAKE SURE IT IS "BELL" TO KEEP FM DEL'ING TOO FAR
	INX	H	;NOW PT TO INPUT BFR
	SHLD	INPTR	;SAVE AS STARTING PTR
	MVI	A,80	;NUMBER OF CHARS IN LINE (MAX)
GCLI1:	EQU	$	;LOOP TO BLANK OUT LINE BFR
	MVI	M,' '	;BLANKS
	INX	H	;NEXT CHAR
	DCR	A	;FOR THIS COUNT
	JNZ	GCLI1	;ENTIRE LINE
GCLIN:	CALL	SINP	;READ INPUT DEVICE
	JZ	GCLIN
	ANI	7FH	;MAKE SURE NO X'80' BIT DURING CMND MODE
	JZ	STRTD	;IF EITHER MODE (OR CTL-@)
	MOV	B,A
	CPI	CR	;IS IT CR?
	JZ	SOUT	;YES, ECHO IT AND EXIT
	CPI	LF	;IS IT A LINEFEED
	RZ		;YES--TERMINATE LINE AS IS
	LHLD	INPTR	;CRNT LINE PTR

; CHECK FOR AND PROCESS DELETE OR BACKSPACE

	CPI	7FH	;DELETE CHR?
	JZ	DODEL	;YES
	CPI	BS	;BACKSPACE
	JNZ	GCLI2	;NO--OK
DODEL:	DCX	H	;BACK UP LINE PTR
	MVI	A,'G'-40H	;SEE IF A BELL (START OF LINE)
	CMP	M	;IS IT?
	JZ	GCLIN	;YES, DO NOTHING
	MVI	B,BS	;ECHO BS, SPACE, BS
	CALL	SOUT
	MVI	B,' '
	CALL	SOUT
	MVI	B,BS
	JMP	GCLI3
;
GCLI2:	EQU	$	;STORE CHAR IN INPUT AREA
	MOV	M,B	;PLACE CHAR INTO LINE
	INX	H	;NEXT CHAR
;
GCLI3:	EQU	$	;SAVE NEW LINE PTR
	SHLD	INPTR	;SAVE PTR
;
	CALL	SOUT
	JMP	GCLIN
;
;
;
;
;      FIND AND PROCESS COMMAND
;
COPRC:	EQU	$	;PROCESS THIS COMMAND LINE
	CALL	STUP	;SETUP TO PROCESS INPUT LINE
	XCHG		;DE=ADDR
	LXI	H,START	;PREP SO THAT HL WILL PT TO CUTER LATER
	PUSH	H	;PLACE PTR TO CUTER ON STACK FOR LATER DISPT
	CALL	SCHR	;SCAN PAST BLANKS
	JZ	ERR1	;NO COMMAND?
	XCHG		;HL HAS FIRST CHR
	LXI	D,COMTAB	;POINT TO COMMAND TABLE
	CALL	FDCOM	;SEE IF IN PRIMARY TABLE
	CZ	FDCOU	;TRY CUSTOM ONLY IF NOT PRIMARY COMMAND
DISP0:	EQU	$	;HERE TO EITHER DISPATCH OR DO ERROR
	JZ	ERR2	;NOT IN EITHER TABLE
	INX	D	;PT DE TO ADDR OF RTN
	XCHG		;HL=ADDR OF ADDR OF RTN
; **** DROP THRU TO DISPT ***
;
; THIS ROUTINE DISPTACHES TO THE ADDR AT CONTENTS OF HL.
; HL ARE RESTORED PRIOR TO GOING TO ROUTINE.
;
DISPT:	EQU	$	;DISPATCH
	MOV	A,M	;LOW BYTE
	INX	H
	MOV	H,M	;HI BYTE
	MOV	L,A	;AND LO, HL NOW COMPLETE
DISP1:	EQU	$	;HERE TO GO OFF TO HL DIRECTLY
	XTHL		;HL RESTORED AND ADDR ON STACK
	MOV	A,L	;ALWAYS PASS L IN "A" (PRIMARILY FOR SET'S)
	RET		;OFF TO ROUTINE
;
;
;
;   THIS ROUTINE SEARCHES THROUGH A TABLE, POINTED TO
;  BY 'DE', FOR A DOUBLE CHARACTER MATCH OF THE 'HL'
;  MEMORY CONTENT.  IF NO MATCH IS FOUND THE SCAN ENDS
;  WITH THE ZERO FLAG SET, ELSE NON-ZERO SET.
;
FDCOU:	EQU	$	;HERE TO SCAN CUSTOM TABLE
	LXI	D,CUTAB	;PT TO CUSTOM RTN TBL
FDCOM:	LDAX	D
	ORA	A	;TEST FOR TABLE END
	RZ		;NOT FOUND POST THAT AND RETURN
	PUSH	H	;SAVE START OF SCAN ADDRESS
	CMP	M	;TEST FIRST CHR
	INX	D
	JNZ	NCOM
;
	INX	H
	LDAX	D
	CMP	M	;NOW SECOND CHARACTER
	JNZ	NCOM	;GOODNESS
;
	POP	H	;RETURN HL TO PT TO CHAR START
	ORA	A	;FORCE TO NON-ZERO FLAG
	RET		;LET CALLER KNOW
;
;
NCOM:	INX	D	;GO TO NEXT ENTRY
	INX	D
	INX	D
	POP	H	;GET BACK ORIGINAL ADDRESS
	JMP	FDCOM	;CONTINUE SEARCH
;
;
; SET UP TO PROCESS AN INPUT LINE
STUP:	EQU	$	;PREPARE WHETHER VDM OR NOT
	LXI	H,INLIN	;ASSUME NON-VDM INPUT
	SHLD	INPTR	;ALSO RESET PTR FOR NOW
	RET
;
;           COMMAND TABLE
;
;  THIS TABLE DESCRIBES THE VALID COMMANDS FOR CUTER
;
COMTAB:	EQU	$	;START OF KNOWN COMMANDS
	DW	'DU'	;DUMP
	DW	DUMP
	DW	'EN'	;ENTR
	DW	ENTER
	DW	'EX'	;EXEC
	DW	EXEC
	DW	'GE'	;GET
	DW	TLOAD
	DW	'SA'	;SAVE
	DW	TSAVE
	DW	'HG'	;HEX FILE GET
	DW	HXGET
	DW	'HS'	;HEX FILE SAVE
	DW	HXSAVE
	DW	'XE'	;XEQ
	DW	TXEQ
	DW	'CA'	;CAT
	DW	TLIST
	DW	'SE'	;SET COMMAND
	DW	CSET
	DW	'CU'	;CUSTOM COMMAND ENTER/CLEAR
	DW	CUSET
	DB	0	;END OF TABLE MARK

;
;   OUTPUT DEVICE TABLE
;
OTAB:	DW	VDM01	;VDM DRIVER
	DW	SEROT	;SERIAL OUTPUT
	DW	PAROT	;PARALLEL OUTPUT
	DW	ERROT	;ERROR OR USER DRIVER HANDLER
;
;    INPUT DEVICE TABLE
;
ITAB:	DW	KREA1	;KEYBOARD INPUT
	DW	SREA1	;SERIAL INPUT
	DW	PARIT	;PARALLEL INPUT
	DW	ERRIT	;ERROR OR USER DRIVER HANDLER
;
;
;       SECONDARY COMMAND TABLE FOR SET COMMAND
;
SETAB:	DW	'TA'	;SET TAPE SPEED
	DW	TASPD
	DW	'S='	;SET DISPLAY SPEED
	DW	DISPD
	DW	'I='	;SET INPUT PORT
	DW	SETIN
	DW	'O='	;SET OUTPUT PORT
	DW	SETOT
	DW	'CI'	;SET CUSTOM DRIVER ADDRESS
	DW	SETCI
	DW	'CO'	;SET CUSTOM OUTPUT DRIVER ADDRESS
	DW	SETCO
	DW	'XE'	;SET HEADER XEQ ADDRESS
	DW	SETXQ
	DW	'TY'	;SET HEADER TYPE
	DW	SETTY
	DW	'N='	;SET NUMBER OF NULLS
	DW	SETNU
	DW	'CR'	;SET CRC (NORMAL OR IGNORE CRC ERRORS)
	DW	SETCR
	DB	0	;END OF TABLE MARK
; -*-
;
;
;      OUTPUT A CRLF FOLLOWED BY A PROMPT
;
PROMPT:	CALL	CRLF
	MVI	B,'>'	;THE PROMPT
	JMP	SOUT	;PUT IT ON THE SCREEN
;
CRLF:	MVI	B,CR	;CARRIAGE RETURN
	CALL	SOUT
	MVI	B,LF	;LINE FEED
	CALL	SOUT
	LDA	NUCNT	;GET COUNT OF NULLS TO OUTPUT
	MOV	C,A	;SAVE COUNT IN C
NULOT:	DCR	C
	RM		;COUNTED DOWN PAST ZERO (MAX COUNT IS X'7F')
	XRA	A	;HERE IS THE NULL
	CALL	OUTH	;OUTPUT IT
	JMP	NULOT	;LOOP FOR NUMBER OF NULLS
;
;
;  SCAN OVER UP TO 12 CHARACTERS LOOKING FOR A BLANK
;
SBLK:	MVI	C,12	;MAXIMUM COMMAND STRING
SBLK1:	LDAX	D
	CPI	' '
	JZ	SCHR	;GOT A BLANK NOW SCAN PAST IT
	INX	D
	CPI	'='	;A EQUAL WILL ALSO STOP US (AT NEXT CHAR)
	JZ	SCHR	;FOUND, DE PT TO NEXT CHAR
	DCR	C	;NO MORE THAN TWELVE
	JNZ	SBLK1
	RET		;GO BACK WITH ZERO FLAG SET
;
;
;  SCAN PAST UP TO 10 BLANK POSITIONS LOOKING FOR
; A NON BLANK CHARACTER.
;
SCHR:	MVI	C,10	;SCAN TO FIRST NON BLANK CHR WITHIN 10
SCHR1:	LDAX	D	;GET NEXT CHARACTER
	CPI	' '
	RNZ		;WE'RE PAST THEM
	INX	D	;NEXT SCAN ADDRESS
	DCR	C
	RZ		;COMMAND ERROR
	JMP	SCHR1	;KEEP LOOPING
;
;  THIS ROUTINE SCANS OVER CHARACTERS, PAST BLANKS AND
; CONVERTS THE FOLLOWING ADDRESS TO HEX.  ERRORS RETURN TO
; THE ERROR HANDLER.
;
SCONV:	CALL	SBLK
	JZ	ERR1
;
;  THIS ROUTINE CONVERTS ASCII DIGITS INTO BINARY FOLLOWING
; A STANDARD HEX CONVERSION.  THE SCAN STOPS WHEN AN ASCII
; SPACE IS ENCOUNTERED.  PARAMETER ERRORS REPLACE THE ERROR
; CHARACTER ON THE SCREEN WITH A QUESTION MARK.
;
SHEX:	LXI	H,0	;CLEAR H & L
SHE1:	LDAX	D	;GET CHARACTER
	CPI	20H	;IS IT A SPACE?
	RZ		;IF SO
	CPI	'/'
	RZ
	CPI	':'
	RZ
;
HCONV:	DAD	H	;MAKE ROOM FOR THE NEW ONE
	DAD	H
	DAD	H
	DAD	H
	CALL	HCOV1	;DO THE CONVERSION
	JNC	ERR1	;NOT VALID HEXIDECIMAL VALUE
	ADD	L
	MOV	L,A	;MOVE IT IN
	INX	D	;BUMP THE POINTER
	JMP	SHE1
;
HCOV1:	SUI	48	;REMOVE ASCII BIAS
	CPI	10
	RC		;IF LESS THAN 9
	SUI	7	;IT'S A LETTER??
	CPI	10H
	RET		;WITH TEST IN HAND
;
;
;  THIS ROUTINE WILL SEE IF A FIELD (OPERAND) IS PRESENT.
;  IF NOT, THEN HL WILL REMAIN AS THEY WERE ON ENTRY.
;  IF IT WAS PRESENT, THEN HL=THAT VALUE IN HEX.
;
PSCAN:	EQU	$	;OPTIONAL FIELD SCANNER
	CALL	SBLK	;SEE IF FIELD IS PRESENT
	RZ		;RETURN LEAVING HL AS THEY WERE ON ENTRY
	CALL	SHEX	;FIELD IS THERE, GO GET IT
	RET		;HL= EITHER OPTIONAL FIELD (HEX), OR AS IT WAS
;
;
;
;
;           DUMP COMMAND
;
;     THIS ROUTINE DUMPS CHARACTERS FROM MEMORY TO THE
;  CURRENT OUTPUT DEVICE.
;  ALL VALUES ARE DESPLAYED AS ASCII HEX.
;
;  THE COMMAND FORM IS AS FOLLOWS:
;
;        DUMP  ADDR1  ADDR2
;
;    THE VALUES FROM ADDR1 TO ADDR2 ARE THEN OUTPUT TO THE
;  OUTPUT DEVICE.  IF ONLY ADDR1 IS SPECIFIED THEN THE
;  VALUE AT THAT ADDRESS IS OUTPUT.
;
;  IF WHILE DUMPING, THE MODE KEY IS PRESSED, THE DUMP WILL
;  BE TERMINATED.  IF THE SPACE BAR IS PRESSED, THE DUMP
;  WILL BE TEMPORARILY SUSPENDED UNTIL ANY KEY IS PRESSED.
;
DUMP:	EQU	$	;SET UP REGS TO DUMP SPECIFIED AREA
	CALL	SCONV	;GET START ADDR (REQUIRED)
	PUSH	H	;SAVE THE START ADDR
	CALL	PSCAN	;GET OPTIONAL END ADDR, HL=THIS OR START ADDR
	POP	D	;DE=START ADDR
	XCHG		;DE=END ADDR, HL=START ADDR NOW
;
DLOOP:	CALL	CRLF
	CALL	ADOUT	;OUTPUT ADDRESS
	CALL	BOUT	;ANOTHER SPACE TO KEEP IT PRETTY
	MVI	C,16	;VALUES PER LINE
;
DLP1:	MOV	A,M	;GET THE CHR
	PUSH	B	;SAVE VALUE COUNT
	CALL	HBOUT	;SEND IT OUT WITH A BLANK
	MOV	A,H	;CRNT ADDR
	CMP	D	;VERSUS ENDING ADDR
	JC	DLP1A	;NOT DONE YET
	MOV	A,L	;TRY LOW ORDER BYTE
	CMP	E
	JNC	COMND	;ALL DONE WHEN CRNT REACHES ENDING
DLP1A:	EQU	$	;HERE TO KEEP DUMPING
	POP	B	;VALUES PER LINE
	INX	H
	DCR	C	;BUMP THE LINE COUNT
	JNZ	DLP1	;NOT ZERO IF MORE FOR THIS LINE
	JMP	DLOOP	;DO A LFCR BEFORE THE NEXT
;
;    OUTPUT HL AS HEX 16 BIT VALUE
;
ADOUT:	MOV	A,H	;H FIRST
	CALL	HEOUT
	MOV	A,L	;THEN L FOLLOWED BY A SPACE
;
HBOUT:	CALL	HEOUT
	CALL	SINP	;SEE IF WE SHD ESCAPE FM DUMP
	JZ	BOUT	;NO--ADD THE SPACE THEN
	ANI	7FH	;MAKE SURE ITS CLEAR OF PARITY
	JZ	COMND	;EITHER MODE (OR CTL-@)
	CPI	' '	;IS IT SPACE
	JNZ	BOUT	;NO--IGNORE THE CHAR
WTLP1:	CALL	SINP	;ON SPACE, WAIT FOR ANY OTHER CHAR
	JZ	WTLP1	;JUST LOOP AFTER A SPACE UNTIL ANY KEY PRESSED
BOUT:	MVI	B,' '
	JMP	SOUT	;PUT IT OUT
;
HEOUT:	MOV	C,A	;GET THE CHARACTER
	RRC
	RRC		;MOVE THE HIGH FOUR DOWN
	RRC
	RRC
	CALL	HEOU1	;PUT THEM OUT
	MOV	A,C	;THIS TIME THE LOW FOUR
;
HEOU1:	ANI	0FH	;FOUR ON THE FLOOR
	ADI	48	;WE WORK WITH ASCII HERE
	CPI	58	;0-9?
	JC	OUTH	;YUP!
	ADI	7	;MAKE IT A LETTER
OUTH:	MOV	B,A	;OUTPUT IT FROM REGISTER 'B'
	JMP	SOUT
;
;
;           ENTR COMMAND
;
;   THIS ROUTINE GETS VALUES FROM THE KEYBOARD AND ENTERS
; THEM INTO MEMORY.  THE INPUT VALUES ARE SCANNED FOLLOWING
; A STANDARD 'GCLIN' INPUT SO ON-SCREEN EDITING MAY TAKE
; PLACE PRIOR TO THE LINE TERMINATOR.  A SLASH '/'
; ENDS THE ROUTINE AND RETURNS CONTROL TO THE COMMAND MODE.
;
ENTER:	CALL	SCONV	;SCAN OVER CHARS AND GET ADDRESS
	PUSH	H	;SAVE ADDRESS
;
ENLOP:	CALL	CRLF
	MVI	B,':'
	CALL	SOUT	;DSPLY THE COLON
	CALL	GCLI0	;INIT AND PROCESS A LINE
	CALL	STUP	;SET UP TO PROCESS INPUT LINE
	XCHG		;....TO DE
;
;
ENLO1:	MVI	C,3	;NO MORE THAN THREE SPACES BETWEEN VALUES
	CALL	SCHR1	;SCAN TO NEXT VALUE
	JZ	ENLOP	;LAST ENTRY FOUND START NEW LINE
;
	CPI	'/'	;COMMAND TERMINATOR?
	JZ	COMND	;IF SO...
	CALL	SHEX	;CONVERT VALUE
	CPI	':'	;ADDRESS TERMINATOR?
	JZ	ENLO3	;GO PROCESS IF SO
	MOV	A,L	;GET LOW PART AS CONVERTED
	POP	H	;GET MEMORY ADDRESS
	MOV	M,A	;PUT IN THE VALUE
	INX	H
	PUSH	H	;BACK GOES THE ADDRESS
	JMP	ENLO1	;CONTINUE THE SCAN
;
ENLO3:	XTHL		;PUT NEW ADDRESS ON STACK
	INX	D	;MOVE SCAN PAST TERMINATOR
	JMP	ENLO1
;
;
;              EXECUTE COMMAND
;
;   THIS ROUTINE GETS THE FOLLOWING PARAMETER AND DOES A
; PROGRAM JUMP TO THE LOCATION GIVEN BY IT.  IF PROPER
; STACK OPERATIONS ARE USED WITHIN THE EXTERNAL PROGRAM
; IT CAN DO A STANDARD 'RET'URN TO THE CUTER COMMAND MODE.
;
;
EXEC:	CALL	SCONV	;SCAN PAST BLANKS AND GET PARAMETER
EXEC1:	EQU	$	;HERE TO GO TO HL
	PUSH	H	;SAVE ON STACK
	LXI	H,START	;LET USER KNOW WHERE WE ARE
	RET		;AND OFF TO USER
;
;
;
;
;   THIS ROUTINE GETS A NAME OF UP TO 5 CHARACTERS
;  FROM THE INPUT STRING.  IF THE TERMINATOR IS A
;  SLASH (/) THEN THE CHARACTER FOLLOWING IS TAKEN
;  AS THE CASSETTE UNIT SPECIFICATION.
;
;
NAME0:	EQU	$	;ENTER HERE TO SET HL TO THEAD
	LXI	H,THEAD	;PT WHERE TO PUT NAME
NAME:	CALL	SBLK	;SCAN OVER TO FIRST CHRS
	MVI	B,6
;
NAME1:	LDAX	D	;GET CHARACTER
	CPI	' '	;NO UNIT DELIMITER
	JZ	NFIL
	CPI	'/'	;UNIT DELIMITER
	JZ	NFIL
	MOV	M,A
	INX	D	;BUMP THE SCAN POINTER
	INX	H
	DCR	B
	JNZ	NAME1	;NAME IS OK, FALL THRU TO 'ERR1' IF NOT
;
;     CUTER ERROR HANDLER
;
ERR1:	XCHG		;GET SCAN ADDRESS
ERR2:	CALL	CRLF
	MVI	B,'?'	;SET UP THE ????
	CALL	SOUT	;INDICATE INPUT NOT VALID
	JMP	COMND	;NOW READY FOR NEXT INPUT
;
;
;
;  HERE WE HAVE SCANNED OFF THE NAME. ZERO FILL IN FOR
;  NAMES LESS THAN FIVE CHARACTERS.
;
NFIL:	MVI	M,0	;PUT IN AT LEAST ONE ZERO
	INX	H
	DCR	B
	JNZ	NFIL	;LOOP UNTIL B IS ZERO
;
	CPI	'/'	;IS THERE A UNIT SPECIFICATION?
	MVI	A,1	;PRETEND NOT
	JNZ	DEFLT
	INX	D	;MOVE PAST THE TERMINATOR
	CALL	SCHR	;GO GET IT
	SUI	'0'	;REMOVE ASCII BIAS
;
DEFLT:	EQU	$	;CNVRT TO INTERNAL BIT FOR TAPE CONTROL
	XRA	A	;JUST RETURN ZERO FOR ACR
STUNT:	STA	FNUMF	;SET IT IN
	RET
;
;
;
;   THIS ROUTINE PROCESSES THE XEQ AND GET COMMANDS
;
;
TXEQ:	DB	3EH	;THIS BEGINS "MVI" OF THE "XRA" FOLLOWING
TLOAD:	XRA	A	;A=0 TLOAD, A=AF (#0) THEN XEQ
	PUSH	PSW	;SAVE FLAG TO SAY WHETHER LOAD OR XEQ
	LXI	H,DHEAD	;PLACE DUMMY HDR HERE FOR COMPARES
	CALL	NAME	;SET IN NAME AND UNIT
	LXI	H,0	;ASSUME LOAD ADDR NOT GIVEN
	CALL	PSCAN	;HL EITHER =0, OR OVERRIDE LOAD ADDR
;
TLOA2:	XCHG		;PUT ADDRESS IN DE
	LXI	H,DHEAD	;PT TO NORMAL HDR
	MOV	A,M	;GET 1ST CHAR OF NAME
	ORA	A	;IS THERE A NAME?
	JNZ	TLOA3	;YES--LOOK FOR IT
	LXI	H,THEAD	;PT TO SAME HDR TO LOAD NEXT FILE
TLOA3:	PUSH	H	;SAVE PTR TO WHICH HDR TO USE
	CALL	ALOAD	;GET UNIT AND SPEED
	POP	H	;RESTORE PTR TO PROPER HDR TO USE
	CALL	RTAPE	;READ IN THE TAPE
	JC	TAERR	;TAPE ERROR?
;
	CALL	NAOUT	;PUT OUT THE HEADER PARAMETERS
	POP	PSW	;RESTORE FLAG SAYING WHETHER IT WAS LOAD OR XEQ
	ORA	A
	RZ		;AUTO XEQ NOT WANTED
	LDA	HTYPE	;CHECK TYPE
	ORA	A	;SET FLAGS
	JM	TAERR	;TYPE IS NON XEQ
	LDA	THEAD+5
	ORA	A
	JNZ	TAERR	;THE BYTE MUST BE ZERO FOR AUTO XEQ
	LHLD	XEQAD	;GET THE TAPE ADDRESS
	JMP	EXEC1	;AND GO OFF TO IT
;
;
;
;   THIS ROUTINE IS USED TO SAVE PROGRAMS AND DATA ON
;   THE CASSETTE UNIT.
;
;
TSAVE:	EQU	$	;SAVE MEMORY IMAGE TO TAPE
	CALL	NAME0	;GET NAME AND UNIT
	CALL	SCONV	;GET START ADDRESS
	PUSH	H	;SAVE START ADDR FOR SIZE COMPUTATION LATER
	CALL	SCONV	;GET END ADDR (REQUIRED)
	XTHL		;HL=START ADDR NOW, STACK=END ADDR
	PUSH	H	;STACK =START FOLLOWED BY END
	CALL	PSCAN	;SEE IF RETRIEVE FROM ADDR
	SHLD	LOADR	;EITHER ACTUAL START, OR OVERRIDE INTO HDR
	POP	H	;;HL=START ADDR
	POP	D	;DE=END ADDR
	PUSH	H	;PUT START BACK ONTO STACK
	MOV	A,E	;SIZE=END-START+1
	SUB	L
	MOV	L,A
	MOV	A,D
	SBI	0	;THIS EQUALS A "SBB H"
	SUB	H	;THIS IS NEEDED
	MOV	H,A
	INX	H
	SHLD	BLOCK	;STORE THE SIZE
	PUSH	H	;SAVE AS THE BLOCK SIZE
;
	CALL	ALOAD	;GET UNIT AND SPEED
	LXI	H,THEAD	;PT TO HEADER TO WRITE
	CALL	WHEAD	;TURN TAPE ON, THEN WRITE HEADER
	POP	D	;GET BACK THE SIZE
	POP	H	;AND GET BACK THE ACTUAL START ADDR
	JMP	WTAP1	;WRITE THE BLK (W/EXTRA PUSH)
;
;   OUTPUT ERROR AND HEADER
;
TAERR:	CALL	CRLF
	MVI	D,6
	LXI	H,ERRM
	CALL	NLOOP	;OUTPUT ERROR
	CALL	NAOUT	;THEN THE HEADER
	JMP	COMN1
;
ERRM:	DB	'ERROR '

;
;
;              CAT COMMAND
;
;   THIS ROUTINE READS HEADERS FROM THE TAPE AND OUTPUTS
;   THEM TO THE OUTPUT DEVICE.  IT CONTINUES UNTIL THE
;   MODE KEY IS DEPRESSED.
;
TLIST:	EQU	$	;PRODUCE A LIST OF FILES ON A TAPE
	CALL	NAME0	;GET UNIT IF ANY (NAME IS IGNORED)
	CALL	CRLF	;START ON A FRESH LINE
;
;
LLIST:	CALL	ALOAD
	MVI	B,1
	CALL	TON	;TURN ON THE TAPE
LIST1:	CALL	RHEAD
	JC	COMN1	;TRUN OFF THE TAPE UNIT
	JNZ	LIST1
	CALL	NAOUT	;OUTPUT THE HEADER
	JMP	LLIST
;
;
;   THIS ROUTINE GETS THE CASSETTE UNIT NUMBER AND
;   SPEED TO REGISTER "A" FOR THE TAPE CALLS
;
ALOAD:	XRA	A	;JUST RETURN ZERO FOR ACR
	RET		;AND GO BACK
;
;   THIS ROUTINE OUTPUTS THE NAME AND PARAMETERS OF
;   THEAD TO THE OUTPUT DEVICE.
;
;
NAOUT:	MVI	D,8
	LXI	H,THEAD-1  ;POINT TO THE HEADER
	CALL	NLOOP	;OUTPUT THE HEADER
	CALL	BOUT	;ANOTHER BLANK
	LHLD	LOADR	;NOW THE LOAD ADDRESS
	CALL	ADOUT	;PUT IT OUT
	LHLD	BLOCK	;AND THE BLOCK SIZE
	CALL	ADOUT
	JMP	CRLF	;DO THE CRLF AND RETURN
;
;
NLOOP:	MOV	A,M	;GET CHARACTER
	ORA	A
	JNZ	CHRLI	;IF IT ISN'T A ZERO
	MVI	A,' '	;SPACE OTHERWISE
CHRLI:	EQU	$	;CHAR IS OK TO SEND
	CALL	OUTH	;OUTPUT IT FROM A REG
	INX	H
	DCR	D
	JNZ	NLOOP
	RET
;
;
;
;
;      "SET" COMMAND
;
;   THIS ROUTINE GETS THE ASSOCIATED PARAMETER AND
;   DISPATCHES TO THE PROPER ROUTINE FOR SETTING
;   MEMORY VALUES.
;
CSET:	CALL	SBLK	;SCAN TO SECONDARY COMMAND
	JZ	ERR1	;MUST HAVE AT LEAST SOMETHING!!
	PUSH	D	;SAVE SCAN ADDRESS
	CALL	SCONV	;CONVERT FOLLOWING VALUE
	XTHL		;HL=SAVED SCAN ADDR AND STACK=VALUE
	LXI	D,SETAB	;SECONDARY COMMAND TABLE
	CALL	FDCOM	;TRY TO LOCATE IT
	JMP	DISP0	;OFF TO IT OR ERROR IF NOT IN TBL
;
;
;  THIS ROUTINE SETS THE TAPE SPEED
;
TASPD:	EQU	$	;GET CONVERTED VALUE
	RET		;DO NOTHING FOR ACR
;
;
STSPD:	EQU	$	;VDM ESCAPE SEQUENCE COMES HERE
DISPD:	EQU	$	;SET DISPLAY SPEED
	RET		;DO NOTHING FOR ACR
;
;
SETIN:	EQU	$	;SET AN INPUT PSUEDO PORT
	STA	IPORT
	RET
;
;
SETOT:	EQU	$	;SET AN OUTPUT PSUEDO PORT
	STA	OPORT
	RET
;
;
SETCI:	EQU	$	;DEFINE USER INPUT RTN ADDR
	SHLD	UIPRT
	RET
;
;
SETCO:	EQU	$	;DEFINE USER OUTPUT RTN ADDR
	SHLD	UOPRT
	RET
;
;
SETTY:	EQU	$	;SET TAPE HDR TYPE
	STA	HTYPE
	RET
;
;
SETXQ:	EQU	$	;SET TAPE-EXECUTE ADDDR FOR HDR
	SHLD	XEQAD
	RET
;
;
SETNU:	EQU	$	;HERE TO SET NUMBER OF NULLS
	STA	NUCNT	;THIS IS IT
	RET
;
;
SETCR:	EQU	$	;SET CRC TO BE NORMAL, OR IGNORE CRC ERRORS
	STA	IGNCR	;FF=IGNORE CRC ERRORS, ELSE=NORMAL
	RET
;
;
CUSET:	EQU	$	;TRY TO SET/CLEAR CUSTOM ROUTINE ADDR
	CALL	NAME0	;GET A NAME (S/B 2 CHARS OR MORE)
	LXI	H,COMND	;PT HERE IN CASE ADDR NOT GIVEN
	CALL	PSCAN	;GET OPTIONAL OPERAND IF ANY
	PUSH	H	;SAVE THAT VALUE (IF ANY)
	LXI	H,THEAD	;PT TO NAME
	CALL	FDCOU	;SEE IF NAME IS KNOWN IN CUST TABLE
	JZ	CUSE2	;NO--PROCEED TO KNOW IT
	DCX	D	;DE PT TO 1ST CHAR OF NAME IN TBL
	MVI	M,0	;(HL CAME BACK PT'ING TO THEAD)  CLR THIS NAME
CUSE2:	EQU	$	;ENTER NEW ONE IN TBL
	MOV	A,M	;GET 1ST CHAR OF NAME
	STAX	D	;PUT NAME INTO TABLE
	INX	D
	INX	H
	MOV	A,M	;GET 2ND CHAR OF NAME
	STAX	D	;NAME IS NOW POSTED
	INX	D	;PT TO 1ST BYTE OF ADDR
	POP	H	;RESTORE SAVED RTN ADDR
	XCHG		;DE=RTN ADDR, HL=THIS CU ENTRY
	MOV	M,E	;LO BYTE
	INX	H
	MOV	M,D	;AND HI BYTE
	RET		;ALL DONE
;
;
; -*-
;
;
;
;
;   THE FOLLOWING ROUTINES PROVIDE "BYTE BY BYTE" ACCESS
;  TO THE CASSETTE TAPES ON EITHER A READ OR WRITE BASIS.
;
;  THE TAPE IS READ ONE BLOCK AT A TIME AND INDIVIDUAL
;  TRANSFERS OF DATA HANDLED BY MANAGING A BUFFER AREA.
;
;  THE BUFFER AREA IS CONTROLLED BY A FILE CONTROL BLOCK
;  (FCB) WHOSE STRUCTURE IS:
;
;
;     7 BYTES FOR EACH OF THE TWO FILES STRUCTURED AS
;   FOLLOWS:
;
;         1 BYTE -  ACCESS CONTROL   00 IF CLOSED
;                                    FF IF READING
;                                    FE IF WRITING
;         1 BYTE -  READ COUNTER
;         1 BYTE -  BUFFER POSITION POINTER
;         2 BYTE -  CONTROL HEADER ADDRESS
;         2 BYTE -  BUFFER LOCATION ADDRESS
;
;
;
;        THIS ROUTINE "OPENS" THE CASSETTE UNIT FOR ACCESS
;
;   ON ENTRY:  A - HAS THE TAPE UNIT NUMBER (1 OR 2)
;             HL - HAS USER SUPPLIED HEADER FOR TAPE FILE
;
;
;   NORMAL RETURN:   ALL REGISTERS ARE ALTERED
;                    BLOCK IS READY FOR ACCESS
;
;   ERROR RETURN:    CARRY BIT IS SET
;
;   ERRORS:  BLOCK ALREADY OPEN
;
;
BOPEN:	PUSH	H	;SAVE HEADER ADDRESS
	CALL	LFCB	;GET ADDRESS OF FILE CONTROL
	JNZ	TERE2	;FILE WAS ALREADY OPEN
	MVI	M,1	;NOW IT IS
	INX	H	;POINT TO READ COUNT
	MOV	M,A	;ZERO
	INX	H	;POINT TO BUFFER CURSOR
	MOV	M,A	;PUT IN THE ZERO COUNT
;
;  ALLOCATE THE BUFFER
;
	LXI	D,FBUF1	;POINT TO BUFFER AREA
	LDA	FNUMF	;GET WHICH ONE WE ARE GOING TO USE
	ADD	D
	MOV	D,A	;256 BIT ADD
;
UBUF:	POP	B	;HEADER ADDRESS
	ORA	A	;CLEAR CARRY AND RETURN AFTER STORING PARAMS
	JMP	PSTOR	;STORE THE VALUES
;
;    GENERAL ERROR RETURN POINTS FOR STACK CONTROL
;
TERE2:	POP	H
TERE1:	POP	D
TERE0:	XRA	A	;CLEAR ALL FLAGS
	STC		;SET ERROR
	RET
;
;
EOFER:	DCR	A	;SET MINUS FLAGS
	STC		;AND CARRY
	POP	D	;CLEAR THE STACK
	RET		;THE FLAGS TELL ALL
;
;
;
;
;   THIS ROUTINE CLOSES THE FILE BUFFER TO ALLOW ACCESS
;   FOR A DIFFERENT CASSETTE OR PROGRAM.  IF THE FILE
;   OPERATIONS WERE "WRITE" THEN THE LAST BLOCK IS WRITTED
;   OUT AND AN "END OF FILE" WRITTEN TO THE TAPE.  IF
;   THE OPERATIONS WERE "READS" THEN THE FILE IS JUST
;   MADE READY FOR NEW USE.
;
;   ON ENTRY:  A - HAS WHICH UNIT (1 OR 2)
;
;   ERROR RETURNS:  FILE WASN'T OPEN
;
;
PCLOS:	CALL	LFCB	;GET CONTROL BLOCK ADDRESS
	RZ		;WASN'T OPEN, CARRY IS SET FROM LFCB
	ORA	A	;CLEAR CARRY
	INR	A	;SET CONDITION FLAGS
	MVI	M,0	;CLOSE THE CONTROL BYTE
	RZ		;WE WERE READING...NOTHING MORE TO DO
;
;    THE FILE OPERATIONS WERE "WRITES"
;
;  PUT THE CURRENT BLOCK ON THE TAPE
;  (EVEN IF ONLY ONE BYTE)
;  THEN WRITE AN END OF FILE TO THE TAPE
;
;
	INX	H
	INX	H
	MOV	A,M	;GET CURSOR POSITION
	MOV	A,M	;GET CURSOR POSITION
	CALL	PLOAD	;BC GET HEADER ADDRESS, DE BUFFER ADDRESS
	PUSH	B	;HEADER TO STACK
	LXI	H,BLKOF	;OFFSET TO BLOCK SIZE
	DAD	B
	ORA	A	;TEST COUNT
	JZ	EOFW	;NO BYTES...JUST WRITE EOF
;
;    WRITE LAST BLOCK
;
	PUSH	H	;SAVE BLOCK SIZE POINTER FOR EOF
	MOV	M,A	;PUT IN COUNT
	INX	H
	MVI	M,0	;ZERO THE HIGHER BYTE
	INX	H
	MOV	M,E	;BUFFER ADDRESS
	INX	H
	MOV	M,D
	MOV	H,B
	MOV	L,C	;PUT HEADER ADDRESS IN HL
	CALL	WFBLK	;GO WRITE IT OUT
	POP	H	;BLOCK SIZE POINTER
;
;   NOW WRITE END OF FILE TO CASSETTE
;
EOFW:	XRA	A	;PUT IN ZEROS FOR SIZE:  EOF MARK IS ZERO BYTES!
	MOV	M,A
	INX	H
	MOV	M,A
	POP	H	;HEADER ADDRESS
	JMP	WFBLK	;WRITE IT OUT AND RETURN
;
;
;
;
;   THIS ROUTINE LOCATES THE FILE CONTROL BLOCK POINTED TO
;   BY REGISTER "A".  ON RETURN HL POINT TO THE CONTROL BYT
;   AND REGISTER "A" HAS THE CONTROL WORD WITH THE FLAGS
;   SET FOR IMMEDIATE CONDITION DECISIONS.
;
;
LFCB:	LXI	H,FCBAS	;POINT TO THE BASE OF IT
	RAR		;MOVE THE 1 & 2 TO 0 & 1 LIKE COMPUTERS LIKE
	ANI	1	;SMALL NUMBERS ARE THE RULE
	STA	FNUMF	;CURRENT ACCESS FILE NUMBER
	JZ	LFCB1	;UNIT ONE (VALUE OF ZERO)
	LXI	H,FCBA2	;UNIT TWO--PT TO ITS FCB
LFCB1:	EQU	$	;HL PT TO PROPER FCB
	MOV	A,M	;PICK UP FLAGS FM FCB
	ORA	A	;SET FLAGS BASED ON CONTROL WORD
	STC		;SET CARRY IN CASE OF IMMEDIATE ERROR RETURN
	RET
;
;
;
;
;    READ TAPE BYTE ROUTINE
;
;    ENTRY:       -  A -  HAS FILE NUMBER
;    EXIT: NORMAL -  A -  HAS BYTE
;          ERROR
;            CARRY SET     - IF FILE NOT OPEN OR
;                            PREVIOUS OPERATIONS WERE WRITE
;            CARRY & MINUS - END OF FILE ENCOUNTERED
;
;
;
;
RTBYT:	CALL	LFCB	;LOCATE THE FILE CONTROL BLOCK
	RZ		;FILE NOT OPEN
	INR	A	;TEST IF FF
	JM	TERE0	;ERROR WAS WRITING
	MVI	M,(-1) AND 0FFH	;SET IT AS READ  (IN CASE IT WAS JUST OPENED)
	INX	H
	MOV	A,M	;GET READ COUNT
	PUSH	H	;SAVE COUNT ADDRESS
	INX	H
	CALL	PLOAD	;GET THE OTHER PARAMETERS
	POP	H
	ORA	A
	JNZ	GTBYT	;IF NOT EMPTY GO GET BYTE
;
;  CURSOR POSITION WAS ZERO...READ A NEW BLOCK INTO
;  THE BUFFER.
;
RDNBLK:	PUSH	D	;BUFFER POINTER
	PUSH	H	;TABLE ADDRESS
	INX	H
	CALL	PHEAD	;PREPARE THE HEADER FOR READ
	CALL	RFBLK	;READ IN THE BLOCK
	JC	TERE2	;ERROR POP OFF STACK BEFORE RETURN
	POP	H
	MOV	A,E	;LOW BYTE OF COUNT (WILL BE ZERO IF 256)
	ORA	D	;SEE IF BOTH ARE ZERO
	JZ	EOFER	;BYTE COUNT WAS ZERO....END OF FILE
	MOV	M,E	;NEW COUNT ( ZERO IS 256 AT THIS POINT)
	INX	H	;BUFFER LOCATION POINTER
	MVI	M,0
	DCX	H
	MOV	A,E	;COUNT TO A
	POP	D	;GET BACK BUFFER ADDRESS
;
;
;
;   THIS ROUTINE GETS ONE BYTE FROM THE BUFFER
;  AND RETURNS IT IN REGISTER "A".  IF THE END
;  OF THE BUFFER IS REACHED IT MOVES THE POINTER
;  TO THE BEGINNING OF THE BUFFER FOR THE NEXT
;  LOAD.
;
GTBYT:	DCR	A	;BUMP THE COUNT
	MOV	M,A	;RESTORE IT
	INX	H
	MOV	A,M	;GET BUFFER POSITION
	INR	M	;BUMP IT
;
	ADD	E
	MOV	E,A	;DE NOW POINT TO CORRECT BUFFER POSITION
	JNC	RT1
	INR	D
RT1:	LDAX	D	;GET CHARACTER FROM BUFFER
	ORA	A	;CLEAR CARRY
	RET		;ALL DONE
;
;
;
;
;      THIS ROUTINE IS USED TO WRITE A BYTE TO THE FILE
;
;      ON ENTRY:   A -  HAS FILE NUMBER
;                  B -  HAS DATA BYTE
;
;
WTBYT:	CALL	LFCB	;GET CONTROL BLOCK
	RZ		;FILE WASN'T OPEN
	INR	A
	RZ		;FILE WAS READ
	MVI	M,0FEH	;SET IT TO WRITE
	INX	H
	INX	H
	MOV	A,B	;GET CHARACTER
	PUSH	PSW
	PUSH	H	;SAVE CONTROL ADDRESS+2
;
;   NOW DO THE WRITE
;
	CALL	PLOAD	;BC GETS HEADER ADDR, DE BUFFER ADDRESS
	POP	H
	MOV	A,M	;COUNT BYTE
	ADD	E
	MOV	E,A
	JNC	WT1
	INR	D
WT1:	POP	PSW	;CHARACTER
	STAX	D	;PUT CHR IN BUFFER
	ORA	A	;CLEAR FLAGS
	INR	M	;INCREMENT THE COUNT
	RNZ		;RETURN IF COUNT DIDN'T ROLL OVER
;
;   THE BUFFER IS FULL. WRITE IT TO TAPE AND RESET
;  CONTROL BLOCK.
;
	CALL	PHEAD	;PREPARE THE HEADER
	JMP	WFBLK	;WRITE IT OUT AND RETURN
;
;
;
;
;  THIS ROUTINE PUTS THE BLOCK SIZE (256) AND BUFFER
;  ADDRESS IN THE FILE HEADER.
;
PHEAD:	CALL	PLOAD	;GET HEADER AND BUFFER ADDRESSES
	PUSH	B	;HEADER ADDRESS
	LXI	H,BLKOF-1	;PSTOR DOES AN INCREMENT
	DAD	B	;HL POINT TO BLOCKSIZE ENTRY
	LXI	B,256
	CALL	PSTOR
	POP	H	;HL RETURN WITH HEADER ADDRESS
	RET
;
;
PSTOR:	INX	H
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	RET
;
;
PLOAD:	INX	H
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	RET
;
;
;
;
;
;   THIS ROUTINE SETS THE CORRECT UNIT FOR SYSTEM READS
RFBLK:	CALL	GTUNT	;SET UP A=UNIT WITH SPEED
;
;
;
;
;              TAPE READ ROUTINES
;
;     ON-ENTRY:     A HAS UNIT AND SPEED
;                   HL POINT TO HEADER BLOCK
;                   DE HAVE OPTIONAL PUT ADDRESS
;
;     ON EXIT:      CARRY IS SET IF ERROR OCCURED
;                   TAPE UNITS ARE OFF
;
;
RTAPE:	PUSH	D	;SAVE OPTIONAL ADDRESS
	MVI	B,3	;SHORT DELAY
	CALL	TON
	IN	TDATA	;CLEAR THE UART FLAGS
;
PTAP1:	PUSH	H	;HEADER ADDRESS
	CALL	RHEAD	;GO READ HEADER
	POP	H
	JC	TERR	;IF AN ERROR OR ESC WAS RECEIVED
	JNZ	PTAP1	;IF VALID HEADER NOT FOUND
;
;  FOUND A VALID HEADER NOW DO COMPARE
;
	PUSH	H	;GET BACK AND RESAVE ADDRESS
	LXI	D,THEAD
	CALL	DHCMP	;COMPARE DE-HL HEADERS
	POP	H
	JNZ	PTAP1
;
;
	POP	D	;OPTIONAL "PUT" ADDRESS
	MOV	A,D
	ORA	E	;SEE IF DE IS ZERO
	LHLD	BLOCK	;GET BLOCK SIZE
	XCHG		;...TO DE
;  DE HAS HBLOCK....HL HAS USER OPTION
	JNZ	RTAP	;IF DE WAS ZERO GET TAPE LOAD ADDRESS
	LHLD	LOADR	;GET TAPE LOAD ADDRESS
;
;
;     THIS ROUTINE READS "DE" BYTES FROM THE TAPE
;     TO ADDRESS HL.  THE BYTES MUST BE FROM ONE
;     CONTIGUOUS PHYSICAL BLOCK ON THE TAPE.
;
;          HL HAS "PUT" ADDRESS
;          DE HAS SIZE OF TAPE BLOCK
;
RTAP:	PUSH	D	;SAVE SIZE FOR RETURN TO CALLING PROGRAM
;
RTAP2:	EQU	$	;HERE TO LOOP RDING BLKS
	CALL	DCRCT	;DROP COUNT, B=LEN THIS BLK
	JZ	RTOFF	;ZERO=ALL DONE
;
	CALL	RHED1	;READ THAT MANY BYTES
	JC	TERR	;IF ERROR OR ESC
	JZ	RTAP2	;RD OK--READ SOME MORE
;
;  ERROR RETURN
;
TERR:	XRA	A
	STC		;SET ERROR FLAGS
	JMP	RTOF1
;
;
TOFF:	MVI	B,1
	CALL	DELAY
RTOFF:	XRA	A
RTOF1:	OUT	TAPPT	;ZERO TO ACR REGISTER IS OK
	POP	D	;RETURN BYTE COUNT
	RET
;
;
DCRCT:	EQU	$	;COMMON RTN TO COUNT DOWN BLK LENGTHS
	XRA	A	;CLR FOR LATER TESTS
	MOV	B,A	;SET THIS BLK LEN=256
	ORA	D	;IS AMNT LEFT < 256
	JNZ	DCRC2	;NO--REDUCE AMNT BY 256
	ORA	E	;IS ENTIRE COUNT ZERO
	RZ		;ALL DONE--ZERO=THIS CONDITION
	MOV	B,E	;SET THIS BLK LEN TO AMNT REMAINING
	MOV	E,D	;MAKE ENTIRE COUNT ZERO NOW
	RET		;ALL DONE (NON-ZERO FLAG)
DCRC2:	EQU	$	;REDUCE COUNT BY 256
	DCR	D	;DROP BY 256
	ORA	A	;FORCE NON-ZERO FLAG
	RET		;NON-ZERO=NOT DONE YET (BLK LEN=256)
;
;
;   READ THE HEADER
;
RHEAD:	MVI	B,10	;FIND 10 NULLS
RHEA1:	CALL	STAT
	RC		;IF ESCAPE
	IN	TDATA	;IGNORE ERROR CONDITIONS
	ORA	A	;ZERO?
	JNZ	RHEAD
	DCR	B
	JNZ	RHEA1	;LOOP UNTIL 10 IN A ROW
;
;    WAIT FOR THE START CHARACTER
;
SOHL:	CALL	TAPIN
	RC		;ERROR OR ESCAPE
	CPI	1	;ARE WE AT THE 01 YET (START CHAR)
	JC	SOHL	;NO, BUT STIL ZEROES
	JNZ	RHEAD	;NO, LOOK FOR ANOTHER 10 NULLS
;
;    WE HAVE  10 (OR MORE) NULLS FOLLOWED IMMEDIATELY
;    BY AN 01.  NOW READ THE HEADER.
;
	LXI	H,THEAD	;POINT TO BUFFER
	MVI	B,HLEN	;LENGTH TO READ
;
RHED1:	EQU	$	;RD A BLOCK INTO HL FOR B BYTES
	MVI	C,0	;INIT THE CRC
RHED2:	EQU	$	;LOOP HERE
	CALL	TAPIN	;GET A BYTE
	RC
	MOV	M,A	;STORE IT
	INX	H	;INCREMENT ADDRESS
	CALL	DOCRC	;GO COMPUTE THE CRC
	DCR	B	;WHOLE HEADER YET?
	JNZ	RHED2	;DO ALL THE BYTES
;
;   THIS ROUTINE GETS THE NEXT BYTE AND COMPARES IT
; TO THE VALUE IN REGISTER C.  THE FLAGS ARE SET ON
; RETURN.
;
	CALL	TAPIN	;GET CRC BYTE
	XRA	C	;CLR CARRY AND SET ZERO IF MATCH, ELSE NON-ZERO
	RZ		;CRC IS FINE
	LDA	IGNCR	;BAD CRC, SHD WE STILL ACCEPT IT
	INR	A	;SEE IF IT WAS FF, IF FF THEN ZERO SAYS IGN ERR
;   NOW, CRC ERR DETECTION DEPENDS ON IGNCR.
	RET
;
;    THIS ROUTINE GETS THE NEXT AVAILABLE BYTE FROM THE
;  TAPE.  WHILE WAITING FOR THE BYTE THE KEYBOARD IS TESTED
;  FOR AN ESC COMMAND.  IF RECEIVED THE TAPE LOAD IS
;  TERMINATED AND A RETURN TO THE COMMAND MODE IS MADE.
;
STAT:	IN	TAPPT	;TAPE STATUS PORT
	CMA		;ACTIVE LOW STATUS
	ANI	TDR
	RNZ
	CALL	SINP	;CHECK INPUT
	JZ	STAT	;NOTHING THERE YET
	ANI	7FH	;CLEAR PARITY 1ST
	JNZ	STAT	;EITHER MODE OR CTL-@
	STC		;SET ERROR FLAG
	RET		;AND RETURN
;
;
;
TAPIN:	CALL	STAT	;WAIT UNTIL A CHARACTER IS AVAILABLE
	RC
;
TREDY:	IN	TAPPT	;TAPE STATUS
	ANI	TFE+TOE	;DATA ERROR?
	IN	TDATA	;GET THE DATA
	RZ		;IF NO ERRORS
	STC		;SET ERROR FLAG
	RET
;
;
;  THIS ROUTINE GETS THE CORRECT UNIT FOR SYSTEM WRITES
WFBLK:	CALL	GTUNT	;SET UP A WITH UNIT AND SPEED
;
;
;
;       WRITE TAPE BLOCK ROUTINE
;
;   ON ENTRY:   A   HAS UNIT AND SPEED
;              HL   HAS POINTER TO HEADER
;
;
WTAPE:	EQU	$	;HERE TO WRITE TAPE
	PUSH	H	;SAVE HEADER ADDRESS
	CALL	WHEAD	;TURN ON, THEN WRITE HDR
	POP	H
	LXI	D,BLKOF	;OFFSET TO BLOCK SIZE IN HEADER
	DAD	D	;HL POINT TO BLOCK SIZE
	MOV	E,M
	INX	H
	MOV	D,M	;DE HAVE SIZE
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A	;HL HAVE STARTING ADDRESS
;
;    THIS ROUTINE WRITES ONE PHYSICAL BLOCK ON THE
;  TAPE "DE" BYTES LONG FROM ADDRESS "HL".
;
;
WTAP1:	EQU	$	;HERE FOR THE EXTRA PUSH
	PUSH	H	;A DUMMY PUSH FOR LATER EXIT
WTAP2:	EQU	$	;LOOP HERE UNTIL ENTIRE AMOUNT READ
	CALL	DCRCT	;DROP COUNT IN DE AND SET UP B W/LEN THIS BLK
	JZ	TOFF	;RETURNS ZERO IF ALL DONE
	CALL	WTBL	;WRITE BLOCK FOR BYTES IN B (256)
	JMP	WTAP2	;LOOP UNTIL ALL DONE
;
;
WRTAP:	PUSH	PSW
WRWAT:	IN	TAPPT	;TAPE STATUS
	CMA		;ACTIVE LOW SIGNAL
	ANI	TTBE	;IS TAPE READY FOR A CHAR YET
	JZ	WRWAT	;NO--WAIT
	POP	PSW	;YES--RESTORE CHAR TO OUTPUT
	OUT	TDATA	;SEND CHAR TO TAPE
;
DOCRC:	EQU	$	;A COMMON CRC COMPUTATION ROUTINE
	SUB	C
	MOV	C,A
	XRA	C
	CMA
	SUB	C
	MOV	C,A
	RET		;ONE  BYTE NOW WRITTEN
;
;
;   THIS ROUTINE WRITES THE HEADER POINTED TO BY
;   HL TO THE TAPE.
;
WHEAD:	EQU	$	;HERE TO 1ST TURN ON THE TAPE
	CALL	WTON	;TURN IT ON, THEN WRITE HEADER
	MVI	D,50	;WRITE 50 ZEROS
NULOP:	XRA	A
	CALL	WRTAP
	DCR	D
	JNZ	NULOP
;
	MVI	A,1
	CALL	WRTAP
	MVI	B,HLEN	;LENGTH TO WRITE OUT
;
WTBL:	MVI	C,0	;RESET CRC BYTE
WLOOP:	MOV	A,M	;GET CHARACTER
	CALL	WRTAP	;WRITE IT TO THE TAPE
	DCR	B
	INX	H
	JNZ	WLOOP
	MOV	A,C	;GET CRC
	JMP	WRTAP	;PUT IT ON THE TAPE AND RETURN
;
;
;   THIS ROUTINE COMPARES THE HEADER IN THEAD TO
;   THE USER SUPPLIED HEADER IN ADDRESS HL.
;   ON RETURN IF ZERO IS SET THE TWO NAMES COMPARED
;
DHCMP:	MVI	B,5
DHLOP:	LDAX	D
	CMP	M
	RNZ
	DCR	B
	RZ		;IF ALL FIVE COMPARED
	INX	H
	INX	D
	JMP	DHLOP
;
GTUNT:	EQU	$	;SET A=SPEED + UNIT
	XRA	A	;JUST RETURN ZERO FOR ACR
	RET
;
WTON:	MVI	B,4	;SET LOOP DELAY  (BIT LONGER ON A WRITE)
TON:	EQU	$	;HERE TO TURN A TAPE ON THEN DELAY
;	OUT	TAPPT	;DON'T SEND TAPE ON COMMAND TO ACR
;
DELAY:	LXI	D,0
DLOP1:	DCX	D
	MOV	A,D
	ORA	E
	JNZ	DLOP1
	DCR	B
	JNZ	DELAY
	RET

;----------------------------------------------------------
;  HXGET - LOAD INTEL HEX FILE
;     OPTIONAL PARAMETER SPECIFIES PSEUDO PORT TO USE
;----------------------------------------------------------
HXGET:	lxi	h,IPORT		;hl->current input port
	call	setHxPt		;set port, display xfer prompt

; Look for new record

intelCr	call	CRLF
	mvi	c,0		;clear echo character flag
intel	call	getChar		;read next character
	sui	':'		;record marker?
	jnz	intel		;no, keep looking

; Have start of new record. Save the byte count and load address.
;   The load address is echoed to the screen so the user can
;   see the file load progress.

	mov	d,a		;init checksum in D to zero
	call	iByte		;input two hex digits (byte count)
	mov	a,e		;test for zero byte count
	ora	a
	jz	flush		;count of 0 means end

	mov	b,e		;B = byte count on line
	inr	c		;set echo flag for address bytes
	call	iByte		;get MSB of address
	mov	h,e		;H = address MSB
	call	iByte		;get LSB of address
	mov	l,e		;L = address LSB
	mvi	c,0		;clear echo flags
	call	iByte		;ignore record type

; Receive the data bytes of the record and move to memory

data	call	iByte		;read a data byte (2 hex digits)
	mov	m,e		;store in memory
	inx	h
	dcr	b
	jnz	data

; Validate checksum

	call	iByte		;read and add checksum
	jz	intelCr		;checksum good
error	lxi	h,mError	;display error message
	call	dispMsg
				;fall through to flush

; flush - flush rest of file as it comes in until no characters
;    received for about 1/4 second. The AINP call takes about
;    136 cycles.

flush	lxi	d,3000		;.25s timeout for 160 cycle loop
flshLp	lda	HPORT		;a=pseudo port to flush
	call	AINP
	jnz	flush		;character received, restart
	dcx	d		;(5) otherwise, decrement timeout
	mov	a,d		;(5)
	ora	e		;(4)
	jnz	flshLp		;(10) loop until zero
	jmp	COMND		;back to CUTER command loop

;-----------------------------------------------------------
; iByte	- read two ascii hex bytes and return binary
;    value in e. If a conversion error occurs, exit
;    directly to error label above.
;-----------------------------------------------------------
iByte	call	getChar		;get a character
	call	HCOV1		;ascii hex digit to binary
	jnc	error
	add	a		;put in msn, zero lsn
	add	a
	add	a
	add	a
	mov	e,a		;save byte with MSN in E

; 2nd byte (LSN)

	call	getChar		;get a character
	call	HCOV1		;ascii hex digit to binary
	jnc	error
	add	e		;combine msn and lsn
	mov	e,a		;save in E
	add	d		;add character to checksum
	mov	d,a
	ret		

;-------------------------------------------------------------
; getChar - read a character from pseudo port specified in
;    HPORT. The character is also echoed to the console port
;    if the echo flag (c) is set (non-zero)
;-------------------------------------------------------------
getChar	push	b		;save b,c
wtChar	lda	HPORT		;a=pseudo port to use
	call	AINP
	jz	wtChar		;wait for byte
	cpi	MODE		;MODE button (ctrl@)?
	jz	COMND		;yes, exit completely
	mov	b,a		;save character in b
	mov	a,c		;echo flag (c) set?
	ora	a
	jz	noEcho		;no echo
	call	SOUT		;echo character in b
	pop	b		;restore b,c
	ret			;byte is in a

noEcho	mov	a,b		;a=byte read
	pop	b		;restore b,c
	ret

;----------------------------------------------------------
;  HXSAVE - SAVE MEMORY RANGE AS INTEL HEX FILE
;     PARAMETER 1 - STARTING ADDRESS
;     PARAMETER 2 - ENDING ADDRESS
;     PARAMETER 3 (OPTIONAL) PSEUDO PORT TO USE
;----------------------------------------------------------
HXSAVE:	call	SCONV		;get start address in HL
	push	h		;save start
	call	SCONV		;get end address in HL
	push	h		;save end address
	lxi	h,OPORT		;hl->current output port
	call	setHxPt		;set port, display xfer prompt
	lxi	h,mReady	;return when ready prompt
	call	dispMsg
wtReady	call	SINP		;wait for any character
	jz	wtReady
	cpi	MODE		;MODE button (ctrl@)?
	jz	COMND		;yes, exit completely

; Get dump address in HL and length in DE

	pop	d		;de=end address
	pop	h		;hl=start address
	mov	a,e		;compute de=de-hl + 1
	sub	l
	mov	e,a
	mov	a,d
	sbb	h
	mov	d,a
	inx	d		

; sndLine - send a line of hex data

sndLine	mvi	b,':'		;transmit leading ":"
	call	sndChar
	mvi	b,0		;init checksum in b
	call	sndLen		;transmit length (returned in c)
	mov	a,h		;send high byte of address
	call	sndByte
	mov	a,l		;send low byte of address
	call	sndByte
	xra	a		;send record type (00)
	call	sndByte

; sndLoop - send data bytes of the line

sndLoop	mov	a,m		;send next data byte
	call	sndByte
	inx	h		;point to next byte
	dcr	c		;bytes per line counter
	jnz	sndLoop

; send checksum and CR/LF

	mov	a,b		;a=checksum before 2's compliment
	cma			;compute 2's compliment
	inr	a		;a=2's compliment checksum
	call	sndByte
	call	sndCrLf		;send CR/LF through HPORT

; if de <= zero, we're done, otherwise repeat at sndLine

	mov	a,d		;msb of count < 0?
	ora	a
	jm	sndDone		;yes, we're done
	jnz	sndLine		;not zero, do another line
	mov	a,e		;d is zero, is e zero too?
	ora	a
	jnz	sndLine		;no, do another line

; sndDone - all bytes sent, send EOF record

sndDone	mvi	b,':'		;send leading ":"
	call	sndChar
	mvi	c,10		;send 10 ascii zeros
eofLoop	mvi	b,'0'
	call	sndChar	
	dcr	c
	jnz	eofLoop
	call	sndCrLf		;trailing CR/LF
	jmp	COMND		;back to command processor

;----------------------------------------------------------
; sndLen - compute how many bytes will be sent in this
;    line (typically 16) and transmit the count as two
;    hex digits. The length is returned in c
;----------------------------------------------------------
sndLen	mvi	c,16		;assume 16 byte length
	mov	a,e		;compute de=de-16
	sub	c
	mov	e,a
	mov	a,d
	sbi	0
	mov	d,a
	jnc	haveLen

; length went below zero, compute number of bytes to send

	mov	a,e		;a=lsb of de < 0
	adi	16		;a=bytes left
	mov	c,a		;c=bytes to send

; haveLen - have length to send in c, transmit the length

haveLen	mov	a,c		;a=bytes in line
				;fall through to sndByte

;----------------------------------------------------------
; sndByte - send the byte in A as two ascii hex digits.
;     checksum is accumulated in b.
;----------------------------------------------------------
sndByte	push	a		;save passed character
	add	b		;update checksum
	mov	b,a		;save in b
	pop	a		;a=passed character
	push	b		;save b,c
	mov	c,a		;c=passed character
	rrc			;put in lsn
	rrc
	rrc
	rrc
	call	sndNib		;send the MSN
	mov	a,c		;a=original character
	call	sndNib		;send the LSN
	pop	b		;restore b,c
	ret

; sndNib - convert nibble in a to ascii hex and transmit

sndNib	ani	0fh		;get lower nibble alone
	adi	30h		;convert to ASCII
	cpi	3ah		;digit 0-9
	jc	xmtNib		;yes, send it	
	adi	7		;convert to "A-F"
xmtNib	mov	b,a		;b=character to send

; sndChar - send character in b through port in HPORT

sndChar	lda	HPORT
	jmp	AOUT

; sndCrLf - send CR/LF through port in HPORT

sndCrLf	mvi	b,CR
	call	sndChar
	mvi	b,LF
	jmp	sndChar

;----------------------------------------------------------
; setHxPt - Set hex transfer psedueo port.
;     Enter with HL->default port number, this function
;     gets the optional port number from the command line
;     if present. The default or specified port number is
;     then stored in HPORT and a file transfer prompt with
;     the port number is displayed. 
;----------------------------------------------------------
setHxPt	mov	l,m		;l=current input or output port
	call	PSCAN		;get optional port parameter
	mov	a,l		;a=specified port
	ani	3		;limit to 0-3
	sta	HPORT		;port HPORT for hex transfer

; Display message to send the file, then loop receiving 
;    and storing the hex file.

	adi	'0'		;get ASCII for port number
	mov	c,a		;save in c
	lxi	h,mXfer		;hl->file transfer message
	call	dispMsg		;display message
	mov	b,c		;b=port number in ASCII
	jmp	SOUT		;display port and return

;------------------------------------------------------------
; dispMsg - display the null-terminated message passed in hl
;    on the default pseudo port.
;------------------------------------------------------------
dispMsg	mov	a,m		;get the next message byte
	ora	a		;null terminates
	rz
	mov	b,a		;display it
	call	SOUT
	inx	h		;move to next byte
	jmp	dispMsg

;------------------------------------------------------------
;  Messages
;-----------------------------------------------------------
mXfer	db	cr,lf,'Send/Rcv on port ',0
mReady	db	', RETURN when ready',cr,lf,0
mError	db	cr,lf,lf,'Hex error',cr,lf,0

nxtAddr	equ	$

;
;
;**** -- END OF PROGRAM--
;
;
;
;
;    S Y S T E M    E Q U A T E S
;
;
;            KEYBOARD SPECIAL KEY ASSIGNMENTS
;
;  THESE DEFINITIONS ARE DESIGNED TO ALLOW
;  COMPATABILITY WITH SOLOS(TM). THESE ARE THE
;  SAME KEYS WITH BIT 7 (X'80') STRIPPED OFF.
;
MODE:	EQU	00H	;CTL-@
LF:	EQU	10
CR:	EQU	13
BS:	EQU	08	;ASCII BACKSPACE
;
;          PORT ASSIGNMENTS
;
SIO1CSR	EQU	10H	;2SIO PORT 1 CONTROL/STATUS REGISTER
SIO1DR	EQU	11H	;2SIO PORT 1 DATA REGISTER
SIO2CSR	EQU	12H	;2SIO PORT 2 CONTROL/STATUS REGISTER
SIO2DR	EQU	13H	;2SIO PORT 2 DATA REGISTER
;
PIOCSR	EQU	04H	;PIO CONTROL/STATUS REGISTER
PIODR	EQU	05H	;PIO DATA REGISTER
;
TAPPT:	EQU	06H	;TAPE STATUS PORT (ACR)
TDATA:	EQU	07H	;TAPE DATA PORT (ACR)
SENSE:	EQU	0FFH	;SENSE SWITCHES
;
;
;
;          BIT ASSIGNMENT MASKS
;
SIORDRF	EQU	01H	;BIT MASK FOR 2SIO RECEIVE DATA AVAILABLE
SIOTDRE	EQU	02H	;BIT MASK FOR 2SIO TRANSMIT READY
;
PIORDRF	EQU	02H	;BIT MASK FOR PIO RECEIVE DATA AVAILABLE
PIOTDRE	EQU	01H	;BIT MASK FOR PIO TRANSMIT READY
;
TFE:	EQU	10H	;TAPE FRAMING ERROR
TOE:	EQU	08H	;TAPE OVERFLOW ERROR
TDR:	EQU	01H	;TAPE DATA READY
TTBE:	EQU	80H	;TAPE TRANSMITTER BUFFER EMPTY
;
;
;
;
;       S Y S T E M   G L O B A L    A R E A
;
	ORG	RAMADDR	
;
SYSRAM:	EQU	$	;START OF SYSTEM RAM
SYSTP:	EQU	SYSRAM+3FFH	;STACK WORKS FM TOP DOWN
;
;
;   PARAMETERS STORED IN RAM
;
UIPRT:	DS	2	;USER DEFINED INPUT RTN IF NON ZERO
UOPRT:	DS	2	;USER DEFINED OUTPUT RTN IF NON ZERO
DFLTS:	DS	2	;DEFAULT PSUEDO I/O PORTS
IPORT:	DS	1	;CRNT INPUT PSUEDO PORT
OPORT:	DS	1	;CRNT OUTPUT PSUEDO PORT
INPTR:	DS	2	;PTR TO NEXT CHAR POSITION IN INLIN
NUCNT:	DS	1	;NUMBER OF NULLS AFTER CRLF
IGNCR:	DS	1	;IGN CRC ERR FLAG, FF=IGN CRC ERRS, ELSE=NORMAL
HPORT	DS	1	;PORT USED FOR HEX LOAD/SAVE
;
	DS	10	;ROOM FOR FUTURE EXPANSION
;
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;    T H I S   I S   T H E   H E A D E R   L A Y O U T    *
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
THEAD:	DS	5	;NAME
	DS	1	;THIS BYTE MUST BE ZERO
HTYPE:	DS	1	;TYPE
BLOCK:	DS	2	;BLOCK SIZE
LOADR:	DS	2	;LOAD ADDRESS
XEQAD:	DS	2	;AUTO EXECUTE ADDRESS
HSPR:	DS	3	;SPARES
;
HLEN:	EQU	$-THEAD	;LENGTH OF HEADER
BLKOF:	EQU	BLOCK-THEAD	;OFFSET TO BLOCK SIZE
DHEAD:	DS	HLEN	;A DUMMY HDR FOR COMPARES WHILE RD'ING
;
;
CUTAB:	DS	6*4	;ROOM FOR UP TO 6 CUSTOM USER COMMANDS
;
;
FNUMF:	DS	1	;FOR CURRENT FILE OPERATIONS
FCBAS:	DS	7	;1ST FILE CONTROL BLOCK
FCBA2:	DS	7	;2ND FILE CONTROL BLOCK
FBUF1:	DS	2*256	;SYSTEM FILE BUFFER BASE
	DS	1	;"BELL" (X'07') FLAGS START OF INPUT BFR
INLIN:	DS	80	;ROOM FOR THE INPUT LINE
USARE:	EQU	$	;START OF USER AREA
;
;   REMEMBER THAT THE STACK WORKS ITS WAY DOWN-FROM
;   THE END OF THIS 1K RAM AREA.
;
; -*-
