SOLOS:	ORG	0C000H
;
START:	DB	0
INIT:	JMP	STRTA		;SYSTEM RESTART ENTRY POINT
;
; ENTRY POINTS
;
RETRN:	JMP	COMND		;RETURN TO SYSTEM ENTRY POINT
FOPEN:	JMP	BOPEN		;FILE OPEN ENTRY
FCLOS:	JMP	PCLOS		;FILE CLOSE 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
;
; THERE ARE TWO ENTRY TYPES:
;       SINP/SOUT    REG "A" WILL BE SET TO THE STANDARD
;                    SYSTEM PSEUDO PORT.
;       AINP/AOUT    REG "A" MUST BE SET BY THE USER AND
;                    WILL SPECIFY THE DESIRED PSEUDO PORT.
;
; THE FOLLOWING ARE THE PSEUDO PORTS:
;	PORT	DESCRIPTION
;	----	--------------------------------
;	 0	KEYBOARD WHEN INPUT, AND VDM WHEN OUTPUT
;	 1	SERIAL I/O PORT
;	 2	PARALLEL I/O PORT
;	 3	USER DEFINED I/O PORT
;
SOUT:	LDA	OPORT		;SOUT ENTRY POINT
AOUT:	JMP	OUTPR		;AOUT ENTRY POINT
SINP:	LDA	IPORT		;SINP ENTRY POINT
AINP:	PUSH	H		;AINP ENTRY POINT
	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:	PUSH	H		;SAVE REGS
	LXI	H,OTAB		;POINT TO OUTPUT TABLE
	JMP	IOPRC		;DISPATCH TO OUTPUT ROUTINE
;   KEYBOARD INPUT DRIVER
;
KSTAT:	IN	STAPT		;GET STATUS WORK
	CMA			;INVERT IT FOR PROPER RETURN
	ANI	KDR		;TEST KEYBOARD BIT
	RZ			;ZERO IS NO CHARACTER RECEIVED
	IN	KDATA		;GET CHARACTER
	CPI	0B2H
	JNZ	KST1
	MVI	A,'Z'-40H	;SOL'S STD DOWN KEY
KST1:	CPI	0B1H
	JNZ	KST2
	MVI	A,'W'-40H	;SOL'S STD UP KEY
KST2:	CPI	0B0H
	JNZ	KST3
	MVI	A,'A'-40H	;SOL'S STD LEFT KEY
KST3:	CPI	0AEH
	JNZ	KST4
	MVI	A,'S'-40H	;SOL'S STD RIGHT KEY
KST4:	ORA	A		;MAKE IT NON-ZERO
	RET			;GO BACK WITH IT
;
;	SERIAL INPUT DRIVER
;
SSTAT:	IN	SERST		;GET SERIAL STATUS WORD
	ANI	SDR		;TEST FOR SERIAL DATA READY
	RZ			;FLAGS ARE SET
	IN	SDATA		;GET DATA BYTE
	RET			;WE HAVE IT
;
;	SERIAL DATA OUTPUT
;
SDROT:	IN	SERST		;GET PORT STATUS
	RAL			;PUT HIGH BIT IN CARRY
	JNC	SDROT		;LOOP TILL XMTR BUFFER IS EMPTY
	MOV	A,B		;GET THE CHARACTER BACK
	OUT	SDATA		;SEND IT OUT
	RET			;AND WE'RE DONE
;
; PARALLEL INPUT DRIVER
;
PASTAT:	IN	STAPT
	CMA			;INVERT STATUS FLAGS
	ANI	PDR		;TEST BIT
	RZ
	IN	PDATA		;GET DATA
	RET
;
; PARALLEL OUTPUT HANDLER
;
PROUT:	IN	STAPT		;GET STATUS
	ANI	PXDR		;TEST IF DEVICE IS READY
	JNZ	PROUT		;LOOP UNTIL GO
	MOV	A,B		;
	OUT	PDATA
	RET
;
; COMBINATION ERROR/USER DEFINED I/O ROUTINES
;
ERRIT:	PUSH	H		;SAVE H,L ONCE AGAIN
	LHLD	UIPRT		;GET USER INPUT PORT ADDRESS
	JMP	ERRO1		;AND GO PROCESS
ERROT:	PUSH	H		;
	LHLD	UOPRT		;GET USER OUTPUT PORT ADDRESS
ERRO1:	MOV	A,L		;TEST HL FOR ZERO
	ORA	H
	JZ	RESIO		;IF ZERO RETURN TO COMMAND MODE
	XTHL			;ADDRESS TO STACK-OLD HL TO HL
	RET			;GO TO DRIVER
;
;	VIDEO DISPLAY ROUTINES
;
; CHAR IN B; ALL REGS PRESERVED EXCEPT ACC. & PSW
;
VDMOT:	PUSH	H		;SAVE MOST REGISTERS
	PUSH	D
	PUSH	B
;
; TEST IF ESC SEQUENCE HAS BEEN STARTED
;
	LDA	ESCFL		;GET ESCAPE FLAG
	ORA	A
	JNZ	ESCS		;IF NON-ZERO GO PROCESS THE REST
;
CHPCK:	MOV	A,B		;SAVE B - STRIP PARITY 
	ANI	7FH		;CLR PARITY TO LOCATE IN TBL
	MOV	B,A		;KEEP IT W/OUT PARITY IN B TOO
	JZ	GOBK		;DO A QUICK EXIT IF A NULL
	LXI	H,TBL		;POINT TO SPECIAL CHARACTER TABLE
	CALL	TSRCH		;GO PROCESS
;
GOBACK:	CALL	VDADD		;GET SCREEN ADDRESS
	MOV	A,M		;GET PRESENT CURSOR CHARACTER
	ORI	80H
	MOV	M,A		;CURSOR IS BACK ON
	LHLD	SPEED-1		;GET DELAY SPEED
	INR	L		;MAKE SURE IT IS NON-ZERO
	XRA	A		;DELAY WILL END WHEN H=0
TIMER:	DCX	H		;TIMER DELAYS HERE
	CMP	H		;DONE WITH DELAY YET
	JNZ	TIMER		;KEEP DELAYING
GOBK:	POP	B
	POP	D		;RESTORE REGISTERS
	POP	H
	RET			;EXIT FROM VDMOT
;
NEXT:	INX	H
	INX	H
;
;   THIS ROUTINE SEARCHES THROUGH A SINGLE CHARACTER 
; TABLE FOR A MATCH TO THE CHARACTER IN "B".  IF FOUND
; A DISPATCH IS MADE TO THE ADDRESS FOLLOWING THE MATCHED
; CHARACTER.  IF NOT FOUND THE CHARACTER IS DISPLAYED ON
; THE MONITOR.
;
TSRCH:	MOV	A,M		;GET CHR FROM TABLE
	ORA	A
	JZ	CHAR		;ZERO IS THE LAST
	CMP	B		;TEST THE CHR
	INX	H		;POINT FORWARD
	JNZ	NEXT
	PUSH	H		;FOUND ONE...SAVE ADDRESS
	CALL	CREM		;REMOVE CURSOR
	XTHL			;GET DISPATCH ADDRESS TO HL
	JMP	DISPT		;DISPATCH NOW
;
;	PUT CHARACTER TO SCREEN
;
CHAR:	CALL	VDADD		;GET SCREEN ADDRESS
	MOV	M,B		;PUT CHR ON SCREEN
	LDA	NCHAR		;GET CHARACTER POSITION
	CPI	63		;END OF LINE?
	JC	OK
	LDA	LINE
	CPI	15		;END OF SCREEN?
	JNZ	OK
;
; END OF SCREEN...ROLL UP ONE LINE
;
SCROLL:	XRA	A
	STA	NCHAR		;BACK TO FIRST CHAR POSITION
SROL:	MOV	C,A
	CALL	VDAD		;CALCULATE LINE TO BE BLANKED
	XRA	A
	CALL	CLIN1		;CLEAR IT
	LDA	BOT
	INR	A
	ANI	0FH
	JMP	ERAS3
;
; INCREMENT LINE COUNTER IF NECESSARY
;
OK:	LDA	NCHAR		;GET CHR POSITION
	INR	A
	ANI	3FH		;MOD 64 AND WRAP
	STA	NCHAR
	RNZ			;DIDN'T HIT END OF LINE, OK
PDOWN:	LDA	LINE		;GET THE LINE COUNT
	INR	A
CURSC:	ANI	0FH		;STORE THE NEW
CUR:	STA	LINE		;STORE THE NEW
	RET
;
; ERASE SCREEN
;
PERSE:	LXI	H,VDMEM		;POINT TO SCREEN
	MVI	M,80H+' '	;THIS IS THE CURSOR
	INX	H		;BUMP	1ST
ERAS1:	MVI	M,' '		;BLANK IT OUT
	INX	H		;NEXT
	MOV	A,H		;SEE IF END OF SCREEN YET
	SUI	0D0H
	JC	ERAS1		;NO--KEEP BLANKING
	STC			;CARRY WILL SAY COMPLETE ERASE
;
PHOME:	LXI	H,0		;
	SHLD	NCHAR		;COL 0 LINE 0
	RNC			;NO CARRY ==> DONE WITH HOME
;
ERAS3:	OUT	DSTAT		;RESET SCROOL PARAMETERS
	STA	BOT		;BEGINNING OF TEXT OFFSET
	RET
;
CLINE:	CALL	VDADD		;GET CURRENT SCREEN ADDRESS
	LDA	NCHAR		;CURRENT CURSOR POSITION
CLIN1:	CPI	64		;NO MORE THAN 63
	RNC			;ALL DONE
	MVI	M,' '		;ALL SPACED OUT
	INX	H
	INR	A
	JMP	CLIN1		;LOOP TO END OF LINE
;
;  ROUTINE TO MOVE THE CURSOR UP ONE LINE
;
PUP:	LDA	LINE		;GET LINE COUNT
	DCR	A
	JMP	CURSC		;MERGE TO HANDLE CURSOR
;
;  MOVE CURSOR LEFT ONE POSITION
;
PLEFT:	LDA	NCHAR
	DCR	A
PCUR:	ANI	3FH		;LET CURSOR WRAP
	STA	NCHAR		;UPDATED CURSOR
	RET
;
;  CURSOR RIGHT ONE POSITION
;
PRIT:	LDA	NCHAR
	INR	A
	JMP	PCUR
;
; ROUTINE TO CALCULATE SCREEN ADDRESS
;
;	ENTRY AT:	RETURNS:
;
;	VDADD	CURRENT SCREEN ADDRESS
;	VDAD2	ADDRESS OF CURRENT LINE, CHAR "C"
;	VDAD	LINE "A", CHARACTER POSITION 'C'
;
VDADD:	LDA	NCHAR		;GET CHARACTER POSITION
	MOV	C,A		;'C' KEEPS IT
VDAD2:	LDA	LINE		;LINE POSITION
VDAD:	MOV	L,A		;INTO 'L'
	LDA	BOT		;GET TEXT OFFSET
	ADD	L		;ADD IT TO THE LINE POSITION
	RRC			;TIMES TWO
	RRC			;MADES FOUR
	MOV	L,A		;L HAS IT
	ANI	3		;MOD THREE FOR LATER
	ADI	VDMEM SHR 8	;LOW SCREEN OFFSET
	MOV	H,A		;NOW H IS DONE
	MOV 	A,L		;TWIST L'S ARM
	ANI	0C0H
	ADD	C
	MOV	L,A
	RET			;H & L ARE NOW PERVERTED
;
;  ROUTINE TO REMOVE CURSOR
;
CREM:	CALL	VDADD		;GET CURRENT SCREEN ADDRESS
	MOV	A,M
	ANI	7FH		;STRIP OFF THE CURSOR
	MOV	M,A
	RET
;
;  ROUTINE TO BACKSPACE
;
PBACK:	CALL	PLEFT
	CALL	VDADD		;GET SCREEN ADDRESS
	MVI	M,' '		;PUT A BLANK THERE
	RET
;
;  ROUTINE TO PROCESS A CARRIAGE RETURN
;
PCR:	CALL	CLINE		;REWIND TO BEGINNING OF LINE
	JMP	PCUR		;AND STORE THE NEW VALUE
;
;  ROUTINE TO PROCESS A LINEFEED
;
PLF:	LDA	LINE		;GET LINE COUNT
	INR	A
	ANI	15		;SEE IF IT WRAPPED AROUND
	JNZ	CUR		;NO--NO NEED TO SCROLL
	JMP	SROL		;YES--THEN SCROLL
;
;  SET ESCAPE PROCESS FLAG
;
PESC:	MVI	A,0FFH
	STA	ESCFL		;SET FLAG
	RET
;
;  PROCESS ESCAPE SEQUENCE
;
ESCS:	CALL	CREM		;REMOVE CURSOR
	CALL	ESCSP		;PROCESS NEXT PART OF SEQUENCE
	JMP	GOBACK
ESCSP:	LDA	ESCFL		;GET ESCAPE FLAG
	CPI	0FFH		;TEST FLAG
	JZ	SECOND
;
;  PROCESS THIRD CHR OF ESC SEQUENCE
;
	LXI	H,ESCFL
	MVI	M,0		;NO MORE PARTS TO THE SEQUENCE
	CPI	2
	JC	SETX		;SET X IF IS ONE
	JZ	SETY		;SET Y IF IS TWO
	CPI	8
	JZ	STSPD		;SET NEW DISPLAY SPEED IF "8"
	CPI	9
	JC	CHAR		;PUT IT ON THE SCREEN
	RNZ
;
;  TAB ABSOLUTE TO VALUE IN REG B
;
SETX:	MOV	A,B		;GET CHARACTER
	JMP	PCUR
;
;  SET CURSOR TO LINE "B"
;
SETY:	MOV	A,B
	JMP	CURSC
;
;  PROCESS SECOND CHR OF ESC SEPUENCE
;
SECOND:	MOV	A,B		;GET WHICH
	CPI	3
	JZ	CURET		;RETURN CURSOR PARAMETERS
	CPI	4
	JNZ	ARET2
;
;  ESC <4>  RETURN ABSOLUTE SCREEN ADDRESS
;
ARET:	MOV	B,H
	MOV	C,L		;SCRN ADDRESS TO BC FOR RETURN
ARET1:	POP	H		;RETURN ADDRESS
	POP	D		;OLD B
	PUSH	B
	PUSH	H
	XRA	A
ARET2:	STA	ESCFL
	RET
;
;  RETURN PRESENT SCREEN PARAMETERS IN "BC"
;
CURET:	LXI	H,NCHAR
	MOV	B,M		;CHARACTER POSITION
	INX	H
	MOV	C,M		;LINE POSITION
	JMP	ARET1
;
;	***** START UP SYSTEM *****
;
; CLEAR SCREEN AND THE FIRST 256 BYTES OF GLOBAL RAM
; THEN ENTER THE COMMAND MODE
;
STRTA:	XRA	A
	MOV	C,A
	LXI	H,SYSRAM	;CLEAR THE FIRST PAGE
CLERA:	MOV	M,A
	INX	H
	INR	C
	JNZ	CLERA
	LXI	SP,SYSTP	;SET UP THE STACK FOR CALL
	CALL	PERSE
RESIO:	XRA	A		;
	STA	OPORT
	STA	IPORT
COMN1:	XRA	A
	OUT	STAPT		;BE SURE TAPES ARE OFF
;
;	***** COMMAND MODE *****
;
;  THIS ROUTINE GETS AND PROCESSES COMMANDS
;
COMND:	LXI	SP,SYSTP	;SET STACK POINTER
	LDA	OPORT		;GET PORT
	PUSH	PSW		;SAVE IT
	XRA	A		;MAKE VDM-1
	STA	OPORT		;THE CURRENT OUTPUT PORT
	CALL	PROMPT		;PUT PROMPT ON SCREEN
	CALL	GCLIN		;GET COMMAND LINE
	POP	PSW		;GET PORT BACK
	STA	OPORT		;RESTORE IT
	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
;	MODE	RESTARTS THE COMMAND LINE
;
GCLIN:	CALL	SINP		;READ INPUT DEVICE
	JZ	GCLIN
	ANI	7FH		;CLEAR PARITY BIT
	JZ	COMN1		;THIS WAS A MODE (OR EVEN CTRL-@)
	MOV	B,A
	CPI	CR		;CARRIAGE RETURN
	JZ	CLINE		;YES--DONE WITH LINE
	CPI	LF		;LINE FEED
	RZ			;YES--DONE WITH LINE, LEAVE AS IS
	CPI	7FH		;DELETE CHR?
	JNZ	CONT
	MVI	B,BACKS		;REPLACE IT
CONT:	CALL	SOUT
	JMP	GCLIN
;
; FIND AND PROCESS COMMAND
;
COPRC:	CALL	CREM		;REMOVE THE CURSOR
	MVI	C,1		;SET FOR CHARACTER POSITION
	CALL	VDAD2		;GET SCREEN ADDRESS
	XCHG
	LXI	H,START		;MAKE SURE HL PT TO SOLOS START
	PUSH	H		;SAVE IT 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 COMMAND TABLE
DISPO:	JZ	ERR2		;NOT VALID, ERROR
	INX	D		;BUMP TO PTR OF RTN
	XCHG			;HL PT TO RTN ADDR
;
;  THIS IS THE DISPATCH ROUTINE
;  HL PT TO RTN ADDRESS, HL WILL BE RESTORED FROM STACK
;  SO THAT HL ARE RESTORED BEFORE DISPATCH.
;
DISPT:	MOV	A,M		;LO ADDR
	INX	H
	MOV	H,M		;HI ADDR
	MOV	L,A		;HL NOW COMPLETE
DISP1:	XTHL			;XCHG HL W/HL ON STACK
	MOV	A,L		;ALSO COPY HERE FOR SETS
	RET			;AND GO OFF TO THE RTN
;
;	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 HL POINTING TO ORIGINAL VALUE AND ZERO FLAG SET.
;
;	(ENTRY IS AT FDCOM)
;
NCOM:	INX	D		;GO TO NEXT ENTRY
	INX	D
	INX	D
	POP	H		;GET BACK ORIG. ADDR
FDCOM:	LDAX	D
	ORA	A		;TEST FOR TABLE END
	RZ			;NOT FOUND..COMMAND ERROR
	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		;RESTORE ORIGINAL SCAN ADDR
	ORA	A		;SET NON-ZERO FLAG SAYING FOUND
	RET			;WITH NON-ZERO SET
;
;	***** COMMAND TABLE *****
;
; THIS TABLE DESCRIBES THE VALID COMMANDS FOR SOLOS
;
COMTAB:	DW	'DU'		;DUMP
	DW	DUMP
	DW	'EN'		;ENTER
	DW	ENTER
	DW	'EX'		;EXECUTE
	DW	EXEC
	DW	'GE'		;GET A FILE
	DW	TLOAD
	DW	'SA'		;SAVE A FILE
	DW	TSAVE
	DW	'XE'		;AUTO-EXECUTE A FILE
	DW	TXEQ
	DW	'CA'		;CATALOG OF TAPE FILES
	DW	TLIST
	DW	'SE'		;SET COMMAND
	DW	CSET
	DW	'CP'		;CP/M COMMAND
	DW	CPM
	DW	'MT'		;MEMORY TEST
	DW	MTEST
	DW	'DD'		;DDT RST 7 RETURN TO CP/M DDT
	DW	DDT
	DB	0		;END OF TABLE MARK
;
;	DISPLAY DRIVER COMMAND TABLE
;
;     THIS TABLE DEFINES THE CHARACTERS FOR SPECIAL
; PROCESSING.  IF THE CHARACTER IS NOT IN THE TABLE IT
; GOES TO THE SCREEN.
;
TBL:	DB	CLEAR-80H	;CLEAR SCREEN
	DW	PERSE
	DB	UP-80H		;UP CURSOR
	DW	PUP
	DB	DOWN-80H	;DOWN CURSOR
	DW	PDOWN
	DB	LEFT-80H	;LEFT CURSOR
	DW	PLEFT
	DB	RIGHT-80H	;RIGHT CURSOR
	DW	PRIT
	DB	HOME-80H	;HOME CURSOR
	DW	PHOME
	DB	CR		;CARRIAGE RETURN
	DW	PCR
	DB	LF		;LINE FEED
	DW	PLF
	DB	BACKS		;BACKSPACE
	DW	PBACK
	DB	ESC		;ESCAPE KEY
	DW	PESC
	DB	08H		;ADDED STD ASCII BACKSPACE
	DW	PLEFT		;FOR CP/M
	DB	0		;END OF TABLE
;
;	OUTPUT DEVICE TABLE
;
OTAB:	DW	VDMOT		;VDM DRIVER
	DW	SDROT		;SERIAL OUTPUT
	DW	PROUT		;PARALLAL OUTPUT
	DW	ERROT		;ERROR OR USER DRIVER HANDLER
;
;	INPUT DEVICE TABLE
;
ITAB:	DW	KSTAT		;KEYBOARD INPUT
	DW	SSTAT		;SERIAL INPUT
	DW	PASTAT		;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	'CR'		;SET TO ALLOW CRC ERRORS
	DW	SETCR
	DB	0		;END OF TABLE MARK
;
;	OUTPUT A CR/LF FOLLOWED BY A PROMPT
;
PROMPT:	CALL	CRLF
	MVI	B,'>'		;THE PROMPT
	JMP	SOUT		;PUT IT ON THE SCREEN
;
CRLF:	MVI	B,LF		;LINE FEED
	CALL	SOUT
	MVI	B,CR		;CARRIAGE RETURN
	JMP	SOUT
;
;    SCAN OFF OPTIONAL PARAMETER.  IF PRESENT RETURN WITH
; VALUE IN HL AND COPY OF 'L' IN 'A'.  IF NOT PRESENT
; RETURN WITH A "1" IN 'A' AND HL UNTOUCHED.
;
PSCAN:	CALL	SBLK
	MVI	A,1		;DEFAULT VALUE
	RZ			;IF NONE
	CALL	SHEX		;CONVERT VALUE
	MOV	A,L		;GET LOWER HALF
	RET
;
;   SCAN OVER UP TO 12 CHARACTERS LOOKING FOR A BLANK
;
SBLK:	MVI	C,12		;MAXIMUM COMMAND STRING
SBLK1:	LDAX	D
	CPI	BLANK
	JZ	SCHR		;GOT A BLANK NOW SCAN PAST IT
	INX	D
	CPI	'='		;ALSO ALLOW EQUAL TO STOP US
	JZ	SCHR		;IF SO, PTR AT CHAR FOLLOWING
	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 NONBLANK CHR IN 10
SCHR1:	LDAX	D		;GET NEXT CHARACTER
	CPI	SPACE
	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 VALUE TO HEX.  ERRORS RETURN TO 
; THE ERROR HANDLER.
;
SCONV:	CALL	SBLK		;FIND IF VALUE IS PRESENT
	JZ	ERR1		;ABORT TO ERROR IF NONE
;
; ASCII TO BINARY CONVERSION
;
SHEX:	LXI	H,0		;CLEAR H & L
SHE1:	LDAX	D		;GET CHARACTER
	CPI	20H		;IS IT A SPACE
	RZ			;IF SO
	CPI	'/'		;SLASH IS ALSO LEGAL
	RZ
	CPI	':'		;EVEN THE COLON IS ALLOWED
	RZ
HCONV:	DAD	H		;MAKE ROOM FOR THE NEW ONE
	DAD	H
	DAD	H
	DAD	H
	SUI	30H		;REMOVE ASCII BIAS
	CPI	0AH
	JC	HCOV1
	SUI	7		;IF ITS A LETTER
	CPI	10H
HCOV1:	JNC	ERR1		;NOT VALID HEXIDECIMAL VALUE
	ADD	L
	MOV	L,A		;MOVE IT IN
	INX	D		;BUMP THE POINTER
	JMP	SHE1
;
;	***** DUMP COMMAND *****
;
DUMP:	CALL	SCONV		;SCAN 1ST ADDR AND CONVERT IT
	PUSH	H		;SAVE THE VALUE
	CALL	PSCAN		;SEE IF SECOND WAS GIVIN
	POP	D
	XCHG			;HL HAS START, DE HAS END
DLOOP:	PUSH	H		;SAVE H,L
	LXI	H,ASCDA		;POINT TO ASCII BUILD UP AREA
	SHLD	ASPTR		;INITIALIZE POINTER
	POP	H		;RESTORE REGISTER
	CALL	CRLF
	CALL	ADOUT		;OUTPUT ADDRESS
	CALL	BOUT		;ANOTHER SPACE - KEEP IT PRETTY
	MVI	C,8		;VALUES PER LINE
DLP1:	MOV	A,M		;GET THE CHAR
	PUSH	B		;SAVE VALUE COUNT
	CALL	HEOUT		;SEND IT OUT
	CALL	ASBLD		;BUILD ASCII
	INX	H		;POINT TO NEXT
	MOV	A,M		;GET THE CHAR
	CALL	HBOUT		;SEND IT OUT WITH A BLANK
	CALL	ASBLD		;BUILD ASCII
	POP	B		;VALUES PER LINE
	INX	H
	DCR	C		;BUMP THE LINE COUNT
	JNZ	DLP1		;NOT ZERO IF MORE FOR THIS LINE
;
;PRINT THE BUILT UP ASCII
;
ASOUT:	PUSH	H		;SAVE H,L
	LXI	H,ASCDA		;POINT TO ASCII DATA
	MVI	C,16
	CALL	BOUT
ASOU1:	MOV	B,M		;GET ASCII CHAR
	CALL	SOUT
	INX	H		;POINT TO NEXT ASCII CHAR
	DCR	C		;DCR COUNT
	JNZ	ASOU1
	POP	H		;RESTORE REGS
CK4END:	MOV	A,L		;COMPARE DE & HL - CHECK DONE
	SUB	E
	MOV	A,H
	SBB	D
	JC	DLOOP		;NOT DONE
	JMP	COMND		;ALL DONE
;
;ASCII BUILD FOR THE ASCII PART OF THE DUMP
;
ASBLD:	PUSH	H		;SAVE H,L
	LHLD	ASPTR		;GET ASCII POINTER
	MOV	A,C		;GET THE CHAR
	CPI	20H		;CNTL CHAR ?
	JC	NOPRT		;NOT IF THERE WASN'T A CARRY
	CPI	7FH		;CHECK DELETES OR HIGH CONTROLS
	JNC	NOPRT		;DON'T PRINT THEM
	CPI	5FH		;CHECK FOR LEFT ARROW
	JZ	NOPRT		;DON'T PRINT IT
	JMP	OKYDOK		;PRINT CHAR IF NONE OF ABOVE
NOPRT:	MVI	A,'.'		;SUBSTITUTE '.' FOR CNTL CHAR
OKYDOK:	MOV	M,A		;PUT CHAR IN BUFFER
	INX	H		;INR BUFFER
	SHLD	ASPTR		;SAVE POINTER
	POP	H		;RESTORE H
	RET			;DONE BUILDING
;
;  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 A CHAR WAITING
	JZ	BOUT		;NO
	ANI	7FH		;CLR PARITY FIRST THO
	JZ	COMND		;EITHER MODE OR CTRL-@
	CPI	'S'-40H		;IS IT A CNTL S
	JZ	WTLP1		;NO...IGNORE THE CHAR
	CPI	' '		;SPACE ?
	JNZ	BOUT		;IGNORE THAT, TOO
WTLP1:	CALL	SINP		;WAIT UNTIL KEY HIT
	JZ	WTLP1		;THIS ALLOWS LOOKING AT THE DISPLAY
BOUT:	MVI	B,' '
	JMP	SOUT		;PUT IT OUT
;
HEOUT:	MOV	C,A		;GET THE CHARACTER
	RRC			;MOVE THE HIGH FOUR DOWN
	RRC
	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
;
;	***** ENTER 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 BACK SLASH '/'
; ENDS THE ROUTINE AND RETURNS CONTROL TO THE COMMAND MODE.
; A COLON ':' SETS THE PREVIOUS VALUE AS A NEW ADDRESS FOR
; ENTRY.
;
ENTER:	CALL	SCONV		;SCAN OVER CHARS AND GET ADDRESS
	PUSH	H		;SAVE ADDRESS
	XRA	A
	STA	OPORT		;ENTER VALUES TO SCREEN BUFFER
;
ENLOP:	CALL	CRLF
	MVI	B,':'
	CALL	CONT		;GET LINE OF INPUT
	CALL	CREM		;REMOVE THE CURSOR
	MVI	C,1		;START SCAN
	CALL	VDAD2		;GET ADDRESS
	XCHG			;....TO DE
;
;
ENLO1:	MVI	C,3		;MAX 3 SPACES BETWEEN VALUES
	CALL	SCHR1		;SCAN TO NEXT VALUE
	JZ	ENLOP		;LAST ENTRY FOUND, START NEW LINE
;
	CPI	'/'		;COMMAND TERMINATOR
	JZ	COMN1		;IF SO, RETURN TO STANDARD INPUT
	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 *****
;
EXEC:	CALL	SCONV		;SCAN PAST BLANKS & GET PARMS
EXEC1:	PUSH	H		;PUT GO ADDRESS ON STACK
	LXI	H,START		;TELL PROGRAM WHERE WE CAME FROM
	RET			;AND DISPATCH IT
;
;MEMORY TEST PGM
;
MTEST:	CALL	SCONV		;GET 1ST ADDR
	SHLD	STRT		;SAVE AT START ADDR
	CALL	PSCAN		;GET 2ND ADDR
	XCHG
	INX	D		;
	XRA	A		;GET A ZERO
	STA	PATT		;SAVE AS PATTERN
	MOV	C,A		;TO C
	LHLD	STRT		;START ADDR TO H,L
WRO:	MOV	M,C		;STORE C IN MEMORY
	INX	H		;POINT TO NEXT LOC TO TEST
	CALL	CHECK		;SEE IF END
	JC	WRO		;IF NOT DONE
TRST:	LHLD	STRT		;START OVER
RCW:	MOV	A,M		;READ A BYTE
	CMP	C		;SAME AS EXPECTED ?
	JZ	GOOD		;YES - SKIP ERR. STUFF
	SHLD	ERRADR		;NO - SAVE BAD ADDR
	STA	DATERR		;SAVE BAD DATA
	LXI	H,PATT		;H,L POINT TO START OF DUMP AREA
	LXI	D,STRT		;D,E POINT TO END
	JMP	DLOOP		;DO A DUMP
GOOD:	INR	A		;GO TO NEXT PATTERN
	MOV	M,A		;READ TO SAVE TIME
	INX	H		;WHERE TO LOOK NEXT
	CALL	CHECK		;CHECK FOR END
	JC	RCW		;IF NOT, CONTINUE
	INR	C		;INCREMENT PATTERN
	MOV	A,C		;TO A
	STA	PATT		;FOR REFERENCE
	JMP	TRST		;START AGAIN
;
;TEST FOR END OF TEST RANGE
;
CHECK:	MOV	A,H		;GET HIGH ORDER BYTE
	CMP	D		;CHECK HIGH ADDR
	RC			;RET IF NOT DONE WITH CARRY SET
	MOV	A,L		;HIGH BYTES SAME - CHECK LOWS
	CMP	E		;
	RET
;
;CPM DISK BOOTSTRAP COMMAND
;
CPM:	MVI	A,0B2H		;SEL DISK 0 & HARDWARE RESTORE
	OUT	WAIT		;DO IT
	MVI	A,3		;LOWEST SPEED 1771 HOME COMND
	OUT	DCOM		;ISSUE IT
	IN	WAIT		;WAIT FOR COMPLETE
	MVI	A,0F2H		;DISK 0 SELECT COMMAND
	OUT	WAIT		;ISSUE IT
	XRA	A		;GET A ZERO
	MOV	L,A		;L=0
	MOV	H,A		;H=0
	PUSH	H		;0 IS BOOT ENTRY POINT
	INR	A		;A=1
	OUT	SECT		;SECTOR=1
	MVI	A,8CH		;READ SECTOR COMMAND
	OUT	DCOM		;ISSUE IT TO 1771
RLOOP:	IN	WAIT		;WAIT FOR DRQ OR INTRQ
	ORA	A		;SET FLAGS
	JP	RDONE		;DONE IF INTRQ
	IN	DDATA		;GET A BYTE FROM THE DISK
	MOV	M,A		;STASH IT
	INX	H		;INR POINTER
	JMP	RLOOP		;DO IT AGAIN
RDONE:	IN	DSKST		;READ DISK STATUS
	ORA	A		;SET FLAGS
	RZ			;JUMP TO BOOTSTRAP IF ZERO
	MOV	C,A		;SAVE STATUS
	CALL	CRLF
	MOV	A,C		;GET BACK STATUS
	CALL	HBOUT		;PRINT IT
	JMP	COMND		;BACK TO SOLOS
;
; THIS ROUTINE GETS A NAME OF UP TO 5 CHARS
;
NAMES:	LXI	H,THEAD		;POINT TO INTERNAL HEADER
NAME:	CALL	SBLK		;SCAN OVER TO FIRST CHRS
	MVI	B,6		;UP TO SIX ARE ACCEPTED
NAME1:	LDAX	D		;GET CHARACTER
	CPI	' '		;NO UNIT DELIMITER
	JZ	NFIL
	MOV	M,A
	INX	D		;BUMP THE SCAN POINTER
	INX	H
	DCR	B
	JNZ	NAME1		;FALL THRU IF TOO MANY CHARS
;
;	***** SOLOS ERROR HANDLER *****
;
ERR1:	XCHG			;GET SCAN ADDRESS TO HL
ERR2:	MVI	M,'?'		;PUT QUESTION MARK ON SCREEN
	JMP	COMN1		;AND RETURN TO COMMAND MODE
;
; ZERO FILL NAMES LESS THAN 5 CHARS.
;
NFIL:	MVI	M,0		;PUT IN AT LEAST ONE ZERO
	INX	H
	DCR	B
	JNZ	NFIL		;LOOP UNTIL B IS ZERO
	RET
;
;   THIS ROUTINE PROCESSES THE XEQ AND GET COMMANDS
;
TXEQ:	DB	3EH		;THIS BEGINS "MVI A,0AFH"
TLOAD:	XRA	A		;A=0 MEANS TLOAD, ELSE TXEQ
	PUSH	PSW		;SAVE FLAG FOR LATER
	LXI	H,DHEAD		;PLACE DUMMY HEADER HERE
	CALL	NAME		;SET IN NAME AND UNIT
	LXI	H,0		;PRETEND NO SECOND VALUE
	CALL	PSCAN		;GO GET THE ADDRESS (IF PRESENT)
TLOA2:	XCHG			;PUT ADDRESS IN DE
	LXI	H,DHEAD		;POINT TO DUMMY HDR W/NAME TO LOAD
	MOV	A,M		;SEE IF A NAME WAS ENTERED
	ORA	A		;IS THERE A NAME?
	JNZ	TLOA3		;YES...SEARCH FOR IT
	LXI	H,THEAD		;NO NAME, LOAD 1ST FILE
TLOA3:	PUSH	H		;SAVE PTR TO NAME TO LOAD
	CALL	ALOAD		;GET UNIT AND SPEED
	POP	H		;RESTORE PTR TO HDR TO LOAD
	CALL	RTAPE		;READ IN THE TAPE
	JC	TAERR		;TAPE ERROR?
	CALL	NAOUT		;PUT OUT THE HEADER PARMS
	POP	PSW		;RESTORE FLAG FROM ORIGINAL ENTRY
	ORA	A
	RZ			;AUTO XEQ NOT WANTED
	LDA	HTYPE		;CHECK TYPE
	ORA	A		;SET FLAGS
	JM	TAERR		;TYPE IS NOW XEQ
	LDA	THEAD+5		;GET CHARACTER PAST NAME
	ORA	A
	JNZ	TAERR		;BYTE MUST = 0 FOR AUTO XEQ
	LHLD	XEQAD		;GET THE TAPE ADDRESS
	JMP	EXEC1		;AND GO TO IT
;
;	***** SAVE COMMAND *****
;
TSAVE:	CALL	NAMES		;GET NAME AND UNIT
	CALL	SCONV		;GET START ADDRESS
	PUSH	H		;USE THE STACK AS A REGISTER
	CALL	SCONV		;GET END ADDRESS
	XTHL			;END ON STACK, GET BACK START
	PUSH	H		;SAVE START ON TOP OF STACK
	CALL	PSCAN		;OPT. HEADER ADDR GIVEN ?
	SHLD	LOADR		;PUT HEADER ADDRESS IN PLACE
	POP	H		;"FROM" ADDRESS TO HL
	POP	D		;GET BACK END ADDRESS
	PUSH	H		;SAVE FROM AGAIN FOR LATER
	MOV	A,E		;NOW CALCULATE SIZE
	SUB	L		;SIZE=END-START+1
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	INX	H
	SHLD	BLOCK		;STORE THE SIZE
	PUSH	H		;SAVE IT FOR THE READ ALSO
	CALL	ALOAD		;GET UNIT AND SPEED
	LXI	H,THEAD		;POINT TO HEADER
	CALL	WHEAD		;AND WRITE IT OUT
;  NOW WRITE OUT THE DATA
	POP	D		;GET SIZE TO DE
	POP	H		;GET BACK "FROM" ADDRESS
	JMP	WRLO1		;WRITE OUT THE DATA AND RETURN
;
;   OUTPUT ERROR AND HEADER
;
TAERR:	CALL	CRLF
	MVI	D,6
	LXI	H,ERRM		;POINT TO ERROR MESSAGE
	CALL	NLOOP		;OUTPUT ERROR
	CALL	NAOUT		;THEN THE HEADER
	JMP	COMN1		;AND TURN TAPE UNITS OFF
;
ERRM:	DB	'ERROR '
;
; CATALOG COMMAND
;
TLIST:	CALL	NAMES		;SET UP UNIT IF GIVEN
	CALL	CRLF
LLIST:	CALL	ALOAD
	MVI	B,1
	CALL	TON		;TURN ON THE TAPE
LIST1:	CALL	RHEAD
	JC	COMN1		;TURN OFF THE TAPE UNIT
	JNZ	LIST1
	CALL	NAOUT		;OUTPUT THE HEADER
	JMP	LIST1		;LOOP UNTIL MODE IS DEPRESSED
;
; THIS ROUTINE GETS THE CASSETTE UNIT NUMBER AND
; SPEED TO REGISTER "A" FOR THE TAPE CALLS
;
ALOAD:	LDA	TSPD		;GET THE SPEED
	ORI	80H		;AND UNIT 1 KEY
	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,' '
CHRLI:	CALL	OUTH		;OUTPUT CHAR NOW
	INX	H
	DCR	D
	JNZ	NLOOP
	RET
;
;	***** SET COMMAND *****
;
; THIS ROUTINE GETS THE ASSOCIATED PARAMETER AND
; DISPATCHES TO THE PROPER ROUTINE FOR SETTING
; GLOBAL VALUES.
;
CSET:	CALL	SBLK		;LOOK FOR SET NAME
	JZ	ERR1		;MUST HAVE SOMETHING!
	PUSH	D		;SAVE SCAN ADDRESS
	CALL	SCONV		;CONVERT FOLLOWING VALUE
	XTHL			;SCAN ADDR TO H,L & VALU ON STK
	LXI	D,SETAB		;SECONDARY COMMAND TABLE
	CALL	FDCOM		;SEE IF IN TABLE
	JMP	DISPO		;AND EITHER ERR OR OFF TO IT
;
; THIS ROUTINE SETS THE TAPE SPEED
;
TASPD:	ORA	A		;IS IT ZERO?
	JZ	SETSP		;YES...THAT'S A VALID SPEED
	MVI	A,32		;SET TO SLOW IF NON-ZERO
SETSP:	STA	TSPD		;SPEED IS STORED HERE
	RET
;
STSPD:	MOV	A,B		;ESCAPE COMES HERE TO SET SPEED
DISPD:	STA	SPEED		;SET DISPLAY SPEED
	RET
;
; SET INPUT DRIVER
;
SETIN:	STA	IPORT
	RET
;
; SET OUTPUT DRIVER
;
SETOT:	STA	OPORT
	RET
;
; SET USERS CUSTOM INPUT DRIVER ADDRESS
;
SETCI:	SHLD	UIPRT
	RET
;
; SET USERS CUSTOM OUTPUT DRIVER ADDRESS
;
SETCO:	SHLD	UOPRT
	RET
;
; SET TYPE BYTE INTO HEADER
;
SETTY:	STA	HTYPE
	RET
;
; SET EXECUTE ADDRESS INTO HEADER
;
SETXQ:	SHLD	XEQAD
	RET
;
SETCR:	STA	IGNCR		;FF=IGNORE ERRORS, ELSE=NORMAL
	RET
;
; THE FOLLOWING ROUTINES PROVIDE "BYTE BY BYTE" ACCESS
; TO THE CASSETTE TAPES ON EITHER A READ ORWRITE 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
;				  FEIF 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
UBUF:	POP	B		;HEADER ADDRESS
	ORA	A		;CLR CARRY TO RET AFT STORING PARMS
PSTOR:	INX	H
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	RET
;
; 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 OF PROGRAM.  IF THE TILE
; OPERATIONS WERE "WRITE" THEN THE LAST BLOCK IS WRITTEN
; 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			;NOT OPEN, CARRY SET FROM LFCR
	ORA	A		;CLEAR CARRY
	INR	A		;SET CONDITION FLAGS
	MVI	M,0		;CLOSE THE CONTROL BYTE
	RZ			;READING -- DONE
;
; 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
	CALL	PLOAD		;HDR ADDR TO B,C - BUFR ADDR TO D,E
	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
;
; SEE IF FCB IS ALREADY ALLOCATED
;
LFCB:	LXI	H,FCBAS		;POINT TO FCB
	MOV	A,M		;PICK UP FLAGS FROM FCB
	ORA	A		;SET FLAGS BASED ON CONTROL WORD
	STC			;SET CARRY FOR IMMEDIATE ERROR RET
	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,0FFH		;SET IT AS READ
	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 (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		;GET BACK BUFFER ADDRESS
	POP	D
;
; 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	M,A		;GET BUFFER POSITION
	INR	M		;BUMP IT
	ADD	E
	MOV	E,A		;DE 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
;
; THIS ROUTINE GETS THE CORRECT UNIT FOR SYSTEM WRITES
;
WFBLK:	CALL	ALOAD		;SET UP A WITH UNIT AND SPEED
;
;	***** WRITE TAPE BLOCK ROUTINE *****
;
; ON ENTRY:	 A - HAS UNIT AND SPEED
;		HL - HAS POINTER TO HEADER
;
WTAPE:	PUSH	H		;SAVE HEADER ADDRESS
	CALL	WHEAD		;TURN ON, THEN WRITE HEADER
	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 HAS SIZE
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A		;HL HAS STARTING ADDRESS
;
; THIS ROUTINE WRITES ONE PHYSICAL BLOCK ON THE
; TAPE "DE" BYTES LONG FROM ADDRESS "HL".
;
WRLO1:	PUSH	H		;A DUMMY PUSH FOR LATER EXIT
WTAP2:	CALL	DCRCT		;DROP COUNT IN DE AND SET UP B 
				;WITH LENGTH THIS BLOCK
	JZ	TOFF		;RETURNS ZERO IF ALL DONE
	CALL	WTBL		;WRITE BLOCK FOR BYTES IN B (256)
	JMP	WTAP2		;LOOP UNTIL ALL DONE
;
; 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 POINTS TO  BLOCKSIZE ENTRY
	LXI	B,256
	CALL	PSTOR
	POP	H		;HL RETURN WITH HEADER ADDRESS
	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	ALOAD		;SET UP A=UNIT WITH SPEED
;
;
;	***** TAPE READ ROUTINES *****
;
; ON ENTRY:	 A - HAS UNIT AND SPEED
;		HL - POINTS TO HEADER BLOCK
;		DE - HAS 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 0 GET TAPE LOAD ADDR
	LHLD	LOADR		;GET TAPE LOAD ADDRESS
;
; THIS ROUTINE READS "DE" BYTES FROM THE TAPE
; TO ADDRESS HL.  THE BYTES MUST BY FROM ONE
; CONTIGUOUS PHYSICAL BLOCK ON THE TAPE.
;
;	HL HAS "PUT" ADDRESS
;	DE HAS SIZE OF TAPE BLOCK
;
RTAP:	PUSH	D		;SAVE SIZE FOR CALLER
RTAP2:	CALL	DCRCT		;DROP COUNT, B=LEN THIS BLOCK
	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
	POP	D		;RETURN BYTE COUNT
	RET
;
DCRCT:	XRA	A		;CLR FOR LATER TESTS
	MOV	B,A		;SET THIS BLK LEN = 256
	ORA	D		;IS ANMT LEFT < 256
	JNZ	DCRC2		;NO...REDUCE AMNT BY 256
	ORA	E		;IS ENTIRE COUNT ZERO
	RZ			;ALL DONE..ZERO=THIS CONDITION
	MOV	B,E		;BLK LEN = AMNT REMAINING
	MOV	E,D		;MAKE ENTIRE COUNT ZERO NOW
	RET			;ALL DONE (NON-ZERO FLAG)
DCRC2:	DCR	D		;DROP BY 256
	ORA	A		;FORCE NON-ZERO FLAG
	RET			;NON-ZERO=NOT DONE (BLKSIZ=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		;10 NULLS THEN 01
	JC	SOHL		;STILL A NULL, KEEP WAITING
	JNZ	RHEAD		;START SEQ OVER AGAIN
;
; NOW GET THE HEADER
;
	LXI	H,THEAD		;POINT TO BUFFER
	MVI	B,HLEN		;LENGTH TO READ
RHED1:	MVI	C,0		;INITALIZE THE CRC
RHED2:	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 WAS FINE
	LDA	IGNCR		;GET CRC OVERIDE FLAG
	INR	A		;FF=IGNORE CRC ERRORS
	RET			;ELSE PROCESS CRC ERROR
;
; 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
	ANI	TDR
	RNZ
	CALL	SINP		;CHECK INPUT
	JZ	STAT		;NOTHING THERE YET
	ANI	7FH		;CLR PARITY FIRST
	JNZ	STAT		;NOT A MODE (OR EVEN CTRL-@)
	STC			;SET ERROR FLAG
	RET			;AND RETURN
;
TAPIN:	CALL	STAT		;WAIT TILL CHARACTER 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 WRITES THE HEADER POINTED TO BY
; HL TO THE TAPE.
;
WHEAD:	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
WRTAP:	PUSH	PSW
WRWAT:	IN	TAPPT		;TAPE STATUS
	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:	SUB	C
	MOV	C,A
	XRA	C
	CMA
	SUB	C
	MOV	C,A
	RET			;ONE BYTE NOW WRITTEN
;
; 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
;
WTON:	MVI	B,4		;SET LOOP DELAY, (LONGER ON WRITE)
TON:	OUT	TAPPT		;GET TAPE MOVING, THEN DELAY
;
DELAY:	LXI	D,0
DLOP1:	DCX	D
	MOV	A,D
	ORA	E
	JNZ	DLOP1
	DCR	B
	JNZ	DELAY
	RET
;
;RST 7 FOR DDT COMMAND
;
DDT:	DB	0FFH
;
;********* END OF PROGRAM ************
;
;
;
;
;
;		SOL SYSTEM EQUATES
;
;
;	VDM PARAMETERS
;
VDMEM	EQU	0CC00H		;VDM SCREEN MEMORY
HIBYTE	EQU	0CCH		;MEMORY HIGH BYTE
;
;
;	KEYBOARD SPECIAL KEY ASSIGNMENTS
;
DOWN	EQU	9AH
UP	EQU	97H
LEFT	EQU	81H
RIGHT	EQU	93H
MODE	EQU	80H
CLEAR	EQU	8BH
HOME	EQU	08EH
BACKS	EQU	5FH		;BACKSPACE
LF	EQU	10
CR	EQU	13
BLANK	EQU	' '
SPACE	EQU	BLANK
CX	EQU	'X'-40H
ESC	EQU	1BH
;
;	PORT ASSIGNMENTS
;
STAPT	EQU	0FAH		;STATUS PORT GENERAL
SERST	EQU	0F8H		;SERIAL STATUS PORT
SDATA	EQU	0F9H		;SERIAL DATA
TAPPT	EQU	0FAH		;TAPE STATUS PORT
TDATA	EQU	0FBH		;TAPE DATA
KDATA	EQU	0FCH		;KEYBOARD DATA
PDATA	EQU	0FDH		;PARALLEL DATA
DSTAT	EQU	0FEH		;VDM DISPLAY PARAMETER PORT
SENSE	EQU	0FFH		;SENSE SWITCHES
DCOM	EQU	0E8H		;DISK COMMAND PORT
DSKST	EQU	DCOM		;DISK STATUS PORT
SECT	EQU	DCOM+2		;DISK SECTOR PORT
DDATA	EQU	DCOM+3		;DISK DATA PORT
WAIT	EQU	DCOM+4		;DISK WAIT PORT
;
;
;	BIT ASSIGNMENT MASKS
;
SCD	EQU	1		;SERIAL CARRIER DETECT
SDSR	EQU	2		;SERIAL DATA SET READY
SPE	EQU	4		;SERIAL PARITY ERROR
SFE	EQU	8		;SERIAL FRAMING ERROR
SOE	EQU	16		;SERIAL OVERRUN ERROR
SCTS	EQU	32		;SERIAL CLEAR TO SEND
SDR	EQU	64		;SERIAL DATA READY
STBE	EQU	128		;SERIAL XMTR BUFFER EMPTY
;
KDR	EQU	1		;KEYBOARD DAYA READY
PDR	EQU	2		;PARALLEL DATA READY
PXDR	EQU	4		;PARALLEL DEVICE READY
TFE	EQU	8		;TAPE FRAMING ERROR
TOE	EQU	16		;TAPE OVERRUN ERROR
TDR	EQU	64		;TAPE DATA READY
TTBE	EQU	128		;TAPE TRANSMITTER BUFFER EMPTY
;
SOK	EQU	1		;SCROLL OK FLAG
;
TAPE1	EQU	80H		;1=TURN TAPE ONE ON
TAPE2	EQU	40H		;1=TURN TAPE TWO ON
;
;
;
;		SOL SYSTEM GLOBAL AREA
;
	ORG	SOLOS+800H
;
SYSRAM	EQU	$		;START OF RAM AREA
SYSTP	EQU	$+1024		;STACK IS AT THE TOP
;
;	***** PARAMETERS STORED IN RAM *****
;
UIPRT	DS	2		;USER INPUT RTN IF NON-ZERO
UOPRT	DS	2		;USER OUTPUT RTN IF NON-ZERO
ASPTR	DS	2		;ASCII POINTER FOR DUMP COMMAND
IPORT	DS	1		;CRNT INPUT PSEUDO PORT
OPORT	DS	1		;CRNT OUTPUT PSEUDO PORT
NCHAR	DS	1		;CURRENT CHARACTER POSITION
LINE	DS	1		;CURRENT LINE POSITION
BOT	DS	1		;BEGINNING OF TEXT DISPLACEMENT
SPEED	DS	1		;SPEED CONTROL BYTE
ESCFL	DS	1		;ESCAPE FLAG CONTROL BYTE
TSPD	DS	1		;CURRENT TAPE SPEED
STRT	DS	2		;START ADDR FOR MEMORY TEST
	DS	1		;FOR COMPATIBILITY
IGNCR	DS	1		;FF=IGNORE CRC ERR., ELSE NORM
PATT	DS	1		;PATTERN FOR MEMORY TEST
DATERR	DS	1		;BAD DATA FOR MEMORY TEST
ERRADR	DS	2		;BAD ADDR FOR MEMORY TEST
	DS	6		;FOR COMPATIBILITY
;
;
; THIS IS THE HEADER LAYOUT
;
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		;DUMMY HDR FOR COMPARES WHILE RDING
;
;
;FOLLOWING REPLACES CUSTOM COMMAND TABLE
;
ASCDA	DS	16		;ASCII BUFFER FOR DUMP
	DS	8		;FOR COMPATABILITY
;
FNUMF	DS	1		;FOR COMPATIBILITY
FCBAS	DS	7		;1ST FILE CONTROL BLOCK
FCBA2	DS	7		;FOR COMPATIBILITY
FBUF1	DS	256		;SYSTEM FILE BUFFER BASE
;
END
