; ******** SOLOS OPERATING SYSTEM ********
;
; PROCESSOR TECHNOLOGY CORP.
; EMERYVILLE, CALIFORNIA
;
;
;     VERSION   1.3
;     RELEASE   3/27/77
;
;
;
;
;
;     THIS 2048 BYTE PROGRAM IS THE STANDARD SOL STAND
; ALONE OPERATING SYSTEM.  IT IS CONFIGURED TO OPTIMIZE
; THE CONVENIENCE AND POWER OF THE SOL-20 AND ONE OR TWO
; CASSETTE RECORDERS IN STAND ALONE COMPUTER APPLICATIONS.
;
;
;COMMANDS:
;	TE			TERMINAL MODE
;	DU SSSS EEEE		DUMP (START ADDR   END ADDR)
;	EN SSSS			ENTER HEX TO MEMORY
;	EX SSSS			EXECUTE
;	GE FILENAME/U		GET (U=TAPE UNIT 0 OR 1, DFLT=1)
;	SA FNAME/U SSSS EEEE	SAVE ON TAPE (UNIT 0 OR 1)
;	XE FILENAME/U		AUTO LOAD/EXECUTE
;	CA			CATALOG OF TAPE FILES
;	CU LL SSSS		CUSTOM COMMAND (LL=LABLE)
;	SET TA N		SET TAPE SPEED (N:0=FAST,1=SLOW)
;	SET S=NN		SET DISPLAY SPEED (O-->FF)
;	SET I=N			SET IN PSEUDO PORT (N=0 - 3)
;	SET O=N			SET OUT PSEUDO PORT (N=0 - 3)
;	SET N=NN		SET NULLS (N=0 - FF)
;	SET CI SSSS		SET CUSTOM INPUT DRIVER ADDR
;	SET CO SSSS		SET CUSTOM OUTPUT DRIVER ADDR
;	SET XE SSSS		SET AUTO-EXECUTE ADDRESS FOR TAPE SAVE
;	SET TY NN		SET FILE TYPE FOR TAPE HEADER
;	SET CR NN		OVERRIDE CRC ERRORS (FF=IGNORE ERRORS)
;
;
;	PSEUDO PORTS:	0 = KEYBOARD/VIDEO
;			1 = SERIAL PORT
;			2 = PARALLEL PORT
;			3 = USER DEFINED (SET CI, SET CO)
;
;
;
	ORG	0C000H
;
;
;
; AUTO-STARTUP CODE
;
START:	DB	0
INIT:	JMP	STRTA	;SYSTEM RESTART ENTRY POINT
;
;
;     ENTRY POINTS
;
;     THESE JUMP POINTS ARE PROVIDED TO ALLOW COMMON ENTRY
; LOCATIONS FOR ALL VERSIONS OF SOLOS.  THEY ARE USED
; EXTENSIVLY BY SOL SYSTEM PROGRAMS AND IT IS RECOMMENDED
; THAT USER ROUTINES ACCESS SOLOS THROUGH THESE 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
;
;   THESE ROUTINES PERFORM SYSTEM I/O
; 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:	EQU	$	;AINP ENTRY POINT
;******** END OF SYSTEM ENTRY POINTS *********
	PUSH	H	;THIS IS ACTUALLY AINP
	LXI	H,ITAB
;
;
;   THIS ROUTINE PROCESSES THE I/O REQUESTS BY DISPATCHING
; TO THE DRIVER REQUESTED IN REGISTER "A".  ON ENTRY HL
; HAS THE PROPER DISPATCH TABLE.
;
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
;
;
;	***** SOL SYSTEM I/O ROUTINES *****
;
;
;   THIS ROUTINE IS A MODEL OF ALL INPUT ROUTINES WITHIN
; SOLOS.  EACH ROUTINE FIRST TESTS THE STATUS INPUT FOR
; DATA AVAILABLE.  IF NO CHARACTERHAS BEEN RECEIVED THE
; ROUTINE RETURNS WITH THE ZERO FLAG SEG.  OTHERWISE THE
; CHARACTER IS INPUT AND A RETURN MADE WITH THE CHARACTER
; IN THE ACCUMULATOR AND THE ZERO FLAG RESET.
;
;
;   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
	RET		;GO BACK WITH IT
;
;
;   THIS JUMP IS PART OF THE AUTO START UP CODE
;
	DB	0	;VERIFY ADDR=C037 
	JMP	INIT	;THIS SHOULD BE C038
;
;
;	JMP TABLE OUTPUT ROUTINES
;
;   THIS ROUTINE SETS UP THE DISPATCH TABLE FOR OUTPUT
; ROUTINES.  THE CHARACTER FOR OUTPUT IS IN REGISTER "B".
; OUTPUT IS MADE TO THE DRIVER POINTED TO BY THE REGISTER
; "A".  THE DEVICE DRIVERS ARE DEFINED AS FOLLOWS:
;
;	0 - DISPLAY SCREEN
;	1 - SERIAL OUTPUT PORT
;	2 - PARALLEL OUTPUT PORT
;	3 - USER DEFINED OR ERROR FLAG
;
; ENTRY AT:	SOUT SELECTS CURRENT OUTPUT DEVICE
;		AOUT SELECTS DEVICE IN REGISTER "A"
;
OUTPR:	PUSH	H
	LXI	H,OTAB	;POINT TO OUTPUT TABLE
	JMP	IOPRC	;AND DISPATCH TO OUTPUT ROUTINE
;
;
;
;	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 UNTIL TRANSMITTER BUFFER IS EMPTY
	MOV	A,B	;GET THE CHARACTER BACK
	OUT	SDATA	;SEND IT OUT
	RET		;AND WE'RE DONE
;
;
;
;
;	VIDEO DISPLAY ROUTINES
;
;
;   THESE ROUTINES ALLOW FOR STANDARD VIDEO TERMINAL
; OPERATIONS.  ON ENTRY, THE CHARACTER FOR OUTPUT IS IN
; REGISTER B AND ALL REGISTERS EXCEPT "A" AND FLAGS ARE
; UNALTERED ON RETURN.
;
;
VDMOT:	PUSH	H	;SAVE MOST REGISTERS
	PUSH	D
	PUSH	B
;
; TEST IS ESC SEPUENCE HAS BEEN STARTED
;
	LDA	ESCFL	;GET ESCAPE FLAG
	ORA	A
	JNZ	ESCS	;IF NON-ZERO GO PROCESS THE REST
;
;
CHPCK:	MOV	A,B	;SAVE IN B...STRIP PARITY BEFORE SCREEN!
	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 SHARACTER 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:	MOV	A,B	;GET CHARACTER
	CPI	7FH	;IS IT A DEL?
	RZ		;GO BACK IF SO
;
;
;
OCHAR:	EQU	$	;ACTUALLY PUT CHAR TO SCREEN NOW
	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:	EQU	$	;CURSOR DOWN ONE LINE HERE
	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:	EQU	$	;LOOPS HERE TO ERASE SCREEN
	MVI	M,' '	;BLANK IT OUT
	INX	H	;NEXT
	MOV	 A,H	;SEE IF END OF SCREEN YET
	CPI	0D0H
	JC	ERAS1	;NO--KEEP BLANKING
	STC		;CARRY WILL SAY COMPLETE ERASE
;
PHOME:	MVI	A,0	;RESET CURSOR--CARRY=ERASE, ELSE HOME
	STA	LINE	;ZERO LINE
	STA	NCHAR	;LEFT SIDE OF SCREEN
	RNC		;IF NO CARRY, WE ARE 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:	EQU	$	;CURSOR ON SAME LINE
	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:	XRA	A	;REWIND TO BEGINNING OF LINE
;
;ORIGINAL HAD 'CALL CLINE' INSTEAD OF 'XRA A' AS SHOWN
;ABOVE. THIS CAUSED DISK COMMANDS TO DISAPPEAR FROM THE
;SCREEN AS CP/M MUST OUTPUT TWO 'CR' CHARACTERS.
;
	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,(-1) AND 0FFH
	STA	ESCFL	;SET FLAG
	RET
;
;  PROCESS ESCAPE SEQUENCE
;
ESCS:	CALL	CREM	;REMOVE CURSOR
	CALL	ESCSP	;PROCESS THE NEXT PART OF SEQUENCE
	JMP	GOBACK
;
ESCSP:	LDA	ESCFL	;GET ESCAPE FLAG
	CPI	(-1) AND 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	OCHAR	;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	;PRESENT SCREEN 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 THR FIRST PAGE
;
CLERA:	MOV	M,A
	INX	H
	INR	C
	JNZ	CLERA
;
	LXI	SP,SYSTP	;SET UP THE STACK FOR CALL
	CALL	PERSE
COMN1:	XRA	A
	OUT STAPT	;BE SURE TAPES ARE OFF
	STA	OPORT
	STA	IPORT
;
;
;
;	***** COMMAND MODE *****
;
;
;  THIS ROUTINE GETS AND PROCESSES COMMANDS
;
COMND:	LXI	SP,SYSTP	;SET STACK POINTER
	LDA	OPORT	;GET PORT
	PUSH	PSW
	XRA	A
	STA	OPORT	;FORCE SCREEN OPERATIONS
	CALL	PROMPT	;PUT PROMPT ON SCREEN
	CALL	GCLIN	;GET COMMAND LINE
	POP	PSW
	STA	OPORT	;RESTORE DEFAULT PORT
	CALL	COPRC	;PROCESS THE LINE
	JMP	COMND	;OVER AND OVER
;
;
;
; THIS ROUTINE READS A COMMAND LINE
; FROM THE SYSTEM KEYBOARD
;
;	C/R	TERMINATES THE SWQUENCE 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
	CZ	FDCOU	;IF NOT, TRY CUSTOM TABLE NEXT
DISPO:	EQU	$	;HERE TO SEE IF ERROR OR DISP
	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:	EQU	$	;OFF TO A ROUTINE
	MOV	A,M	;LO ADDR
	INX	H
	MOV	H,M	;HI ADDR
	MOV	L,A	;HL NOW COMPLETE
DISP1:	EQU	$	;HERE TO GO OFF TO HL
	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.
;
FDCOU:	LXI	D,CUTAB	;HERE TO SCAN CUSTOM TBL ONLY
;
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
;
;
NCOM:	INX	D	;GO TO NEXT ENTRY
	INX	D
	INX	D
	POP	H	;GET BACK ORIGINAL ADDRESS
	JMP	FDCOM	;CONTINUE SEARCH
;
;
;	***** COMMAND TABLE *****
;
; THIS TABLE DESCRIBES THE VALID COMMANDS FOR SOLOS
;
COMTAB:	DW	'TE'	;TERMINAL MODE
	DW	TERM
	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	'CU'	;CUSTOM COMMAND
	DW	CUSET
	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	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	'N='	;SET NULLS
	DW	SETNU
	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 CRC TO ALLOW IGNORING OF CRC ERRORS
	DW	SETCR
	DB	0	;END OF TABLE MARK
;
;
;  SOLOS PORT ERROR HANDLER
;
ERRIT:	PUSH	H	;SAVE HL 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	COMN1	;IF ZERO RETURN TO COMMAND MODE
	XTHL		;ADDRESS TO STACK...OLD HL TO HL
	RET		;GO TO THE DRIVER
;
;    THIS ROUTINE IS THE PARALLEL DEVICE HANGLER
; NO PROVISION IS MADE FOR CONTROLLING THE PORT
; CONTROL BIT.
;
;
;	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 SO
	MOV	A,B
	OUT	PDATA
	RET
;
;
;	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
	CALL	SOUT
;  NOW OUTPUT THE NULLS
	LDA	NUCNT	;GET DESIRED COUNT
	MOV	C,A	;STORE IN C
NULOT:	DCR	C
	RM		;RETURN WHEN PAST ZERO
	XRA	A	;GET A NULL
	CALL	OUTH
	JMP	NULOT
;
;
;    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
;
;
;	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	'/'	;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
	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
;
;
;	***** TERMINAL COMMAND *****
;
;	THIS ROUTINE GETS CHARACTERS FROM THE SYSTEM KEYBOARD
; AND OUTPUTS THEM TO THE SELECTED OUTPUT PORT.  IT IS
; INTENDED TO CONFIGURE THE SOL AS A STANDARD VIDEO
; TERMINAL.  COMMAND KEYS ARE NOT OUTPUT TO THE OUTPUT
; PORT BUT ARE INTERPRETED AS DIRECT SOL COMMANDS.
; THE MODE COMMAND, RECEIVED BY THE KEYBOARD, PUTS THE SOL
; IN THE COMMAND MODE.
;
;
;
TERM:	CALL	PSCAN	;FIND IF INPUT PARAMETER IS PRESENT
	STA	IPORT	;SINP WILL USE THIS DRIVER (DEFAULT IS 1)
	CALL	PSCAN	;NOW FOR THE OUTPUT DRIVER
	STA	OPORT
;
TERM1:	CALL	KSTAT	;IS THERE ONE WAITING?
	JZ	TIN	;IF NOT
	MOV	B,A	;SAVE IT IN B
	CPI	MODE	;IS IT MODE?
	JZ	COMN1	;YES...RESET AND QUIT TERM
	JC	TOUT	;NON-CURSOR KEY...SEND TO TERM PORT
	CALL	VDMOT	;PROCESS IT
	JMP	TIN
;
TOUT:	CALL	SOUT	;OUTPUT IT TO THE SERIAL PORT
TIN:	CALL	SINP	;GET INPUT STATUS
	JZ	TERM1	;LOOP IF NOT
	ANI	7FH	;NO HIGH BITS FROM HERE
	JZ	TERM1	;A NULL IS IGNORED
	MOV	B,A	;IT'S OUTPUT FROM 'B'
	CPI	1BH	;IS IT A CONTROL CHAR TO BE IGNORED
	JNC	TERM2	;NO...TO VDM AS IS THEN
	CPI	CR	;CR OR LF ARE SPECIAL CASES THOUGH
	JZ	TERM2	;AND MUST BE PASSED STD MODE TO VDM
	CPI	LF
	JZ	TERM2
	LDA	ESCFL	;A CTRL CHAR...ARE WE W/IN ESC SEQUENCE?
	ORA	A	;IF YES, THEN OUTPUT CTRL CHAR DIRECTLY TO VDM
	JNZ	TERM2	;WE SURE ARE, LET VDM DRIVER HANDLE IT
	PUSH	B	;SAVE THE CHARACTER
	MVI	B,ESC	;CTRL CHAR TO VDM VIA ESC SEQUENCE
	CALL	VDMOT
	MVI	B,7	;SAY TO PUT OUT NEXT CHAR AS IS
	CALL	 VDMOT	;ALMOST READY
	POP	B	;RESTORE CHAR
TERM2:	EQU	$	;ALL READY TO OUTPUT THE CHAR
	CALL	VDMOT	;PUT IT ON THE SCREEN
	JMP	TERM1	;LOOP OVER AND OVER
;
;
;
;	***** DUMP COMMAND *****
;
;   THIS ROUTINE DUMPS CHARACTERS FROM MEMORY TO THE
; CURRENT OUTPUT DEVICE.  ALL VALUES ARE DISPLATED AS
; ASCII HEX.
;
;   THE COMMAND FORM IS A FOLLOWS:
;
;	DU   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.
;
DUMP:	CALL	SCONV	;SCAN TO FIRST ADDRESS 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:	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 CHAR
	PUSH	B	;SAVE VALUE COUNT
	CALL	HBOUT	;SEND IT OUT WITH A BLANK
	MOV	A,L	;COMPARE DE AND HL
	SUB	E
	MOV	A,H
	SBB	D
	JNC	COMND	;ALL DONE
	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 A CHAR WAITING
	JZ	BOUT	;NO
	ANI	7FH	;CLR PARITY FIRST THO
	JZ	COMND	;EITHER MODE OR CTRL-@
	CPI	' '	;IS IT A SPACE
	JNZ	BOUT	;NO...IGNORE THE CHAR
WTLP1:	CALL	SINP	;IF SPACE, WAIT UNTIL ANY OTHER 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	;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	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 *****
;
;    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 SOLOS COMMAND MODE.
; THE STARTING ADDRESS OF SOLOS IS PASSED TO THE PROGRAM
; IN REGISTER PAIR HL SO IT CAN ADJUST INTERNAL PARAMETERS
; FOR SOLOS OPERATION.
;
;
EXEC:	CALL	SCONV	;SCAN PAST BLANKS AND GET PARAMETER
EXEC1:	PUSH	H	;PUT GO ADDRESS ON STACK
	LXI	H,START	;TELL THE PROGRAM WHERE WE CAME FROM
	RET		;AND DISPATCH IT
;
;
;    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.
;
;
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
	CPI	'/'	;UNIT DELIMITER
	JZ	NFIL
	MOV	M,A
	INX	D	;BUMP THE SCAN POINTER
	INX	H
	DCR	B
	JNZ	NAME1	;FALL THROUGH TO ERR1 IF TOO MANY CHRS IN NAME
;
;
;	***** 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
;
;
;    HERE WE HAVE SCANNED OFF THE NAME.  ZERO FILL 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 UNIT SPEC
	SUI	'0'	;REMOVE ASCII BIAS
;
DEFLT:	EQU	$	;MOVE OVER TO INTERNAL REPRESENTATION
	ANI	1	;JUST BIT ZERO
	MVI	A,TAPE1	;ASSUME TAPE ONE
	JNZ	STUNT	;IF NON-ZERO, ITS ONE
	RAR
STUNT:	STA	FNUMF	;SET IT IN
	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 HEADER WITH 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 PARAMETERS
	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	;THE BYTE MUST BE ZERO FOR AUTO XEQ
	LHLD	XEQAD	;GET THE TAPE ADDRESS
	JMP	EXEC1	;AND GO TO IT
;
;
;	***** GET COMMAND *****
;
; THIS ROUTINE IS USED TO SAVE PROGRAMS AND DATA ON
; THE CASSETTE UNIT
;
;
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		;PUT END ON STACK, GET BACK START
	PUSH	H	;SAVE START ON TOP OF STACK
	CALL	PSCAN	;SEE IF OPTIONAL HEADER ADDRESS WAS 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 BE SURE THE TAPE UNITS ARE OFF
;
ERRM:	DB	'ERROR '
;
;
;   THIS ROUTINE READS HEADERS FROM THE TAPE AND OUTPUTS
; THEM TO THE OUTPUT DEVICE.  IT CONTINUES UNTIL THE
; MODE KEY IS DEPRESSED.
;
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:	LXI	H,FNUMF	;POINT TO THE UNIT SPECIFICATION
	LDA	TSPD	;GET THE TAPE SPEED
	ORA	M	;PUT THEM TOGETHER
	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:	EQU	$	;THIS IS THE SET COMMAND
	CALL	SBLK	;LOOK FOR SET NAME
	JZ	ERR1	;MUST HAVE A LEAST SOMETHING!!
	PUSH	D	;SAVE SCAN ADDRESS
	CALL	SCONV	;CONVERT FOLLOWING VALUE
	XTHL		;GET SCAN ADDR BACK...SAVE VALUE ON STACK
	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:	EQU	$
	STA	IPORT
	RET
;
; SET OUTPUT DRIVER
;
SETOT:	EQU	$
	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
;
;
SETNU:	STA	NUCNT	;SET THE NULL COUNT
	RET		;THAT'S DONE
;
;
SETCR:	EQU	$	;SET TO IGNORE CRC ERRORS
	STA	IGNCR	;FF=IGNORE ERRORS, ELSE=NORMAL
	RET
;
;
;
;  CUSTOM COMMAND NAME AND ADDRESS INTO CUSTOM COMMAND
;
CUSET:	CALL	NAMES	;CUSTOM COMMAND ENTRY/REMOVAL
	LXI	H,COMND	;DEFAULT ADDR IF NONE GIVEN
	CALL	PSCAN	;GET RTN ADDRESS
	PUSH	H	;SAVE RTN ADDRESS
	LXI	H,THEAD	;POINT AT NAME TO SEARCH
	CALL	FDCOU	;SEARCH IT IN CUSTOM TABLE
	JZ	CUSE2	;NOT IN TABLE...ENTER IT
	DCX	D	;IN TABLE, REMOVE IT
	MVI	M,0	;CHANGE NEW NAME TO BE ZERO
CUSE2:	MOV	A,M	;GET 1ST CHAR OF NAME
	STAX	D	;ENTER IT INTO TABLE
	INX	D	;AND THE 2ND NAME
	INX	H
	MOV	A,M
	STAX	D	;NAME NOW ENTERED
	INX	D	;GET SET TO ENTER ADDRESS
	POP	H	;RESTORE RTN ADDR
	XCHG
	MOV	M,E	;SET ADDR IN NOW
	INX	H	;AND HI BYTE OF ADDR
	MOV	M,D
	RET		;NAME IS NOW ENTERED OR CLEARED
;
;
;
; 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
	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 RET 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 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		;WASN'T OPEN, CARRY IS SET FROM LFCR
	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
	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 POINTS TO THE CONTROL BYTE
; 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 
	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--POINT TO ITS FCB
LFCB1:	EQU	$	;HL POINT TO PROPER FCB
	MOV	A,M	;PICK UP FLAGS FROM FCB
	ORA	A	;SET FLAGS BASED ON CONTROL WORD
	STC		;SET CARRY IN CASE OF 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,(-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	;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 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 POINTS 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 - 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 RETURN TO CALLING PROGRAM
;
RTAP2:	EQU	$	;HERE TO LOOP RDING BLKS
	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:	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 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	;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	;AT LEAST 10 NULLS FOLLOWED BY A 01
	JC	SOHL	;STILL A NULL, KEEP WAITING
	JNZ	RHEAD	;NON-ZERO, START SEQUENCE OVER AGAIN
;
; NOW GET 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	;INITALIZE 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 WAS FINE
	LDA	IGNCR	;GET POSSIBLE OVERRIDE CRC ERROR 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 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 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:	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 
			;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
;
;
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:	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 FIRST 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
	LDA	FNUMF	;GET UNIT
	ORA	A	;SEE WHICH UNIT
	LDA	TSPD	;BUT FIRST GET SPEED
	JNZ	GTUN2	;MAKE IT UNIT TWO
	ADI	TAPE2	;THIS ONCE=UNIT 2, TWICE=UNIT 1
GTUN2:	ADI	TAPE2	;UNIT AND SPEED NOW SET IN A
	RET		;ALL DONE
;
WTON:	MVI	B,4	;SET LOOP DELAY, (BIT LONGER ON WRITE)
TON:	EQU	$	;HERE TO TURN A TAPE ON THEN DELAY
	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
;
;
;********* 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
;
;
;	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 TRANSMITTER 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	0C800H	;START OF 1K RAM AREA
;
SYSRAM	EQU	$	;START OF SYSTEM RAM
SYSTP	EQU	$+1024	;STACK IS AT THE TOP
;
;
;	***** 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 
			;   (ALWAYS ZERO IN SOLOS)
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
INPTR	DS	2	;FOR COMPATABILITY W/CUTER
NUCNT	DS	1	;NUMBER OF NULLS AFTER CRLF
IGNCR	DS	1	;FF=IGNORE CRC ERRORE, ELSE NORMAL
;
	DS	10	;ROOM FOR FUTURE EXPANSION
;
;
; 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	;A DUMMY HDR FOR COMPARES WHILE RDING
;
;
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	81	;THIS IS AN AREA USED BY CUTER
USARE	EQU	$	;START OF USER AREA *****************
; REMEMBER THAT THE STACK WORKS ITS WAY DOWN FROM
; THE END OF THIS 1K RAM AREA.
;
;
;
END
