; --- NOTE ---
;   This was produced by scanning and OCRing the program listing
;   from Processor Technology Access newsletter, issue #2.  The
;   OCRing didn't go smoothly, and there was a LOT of hand editing.
;   After restoring the program listing, it was hand edited to be
;   compatible with the standard CP/M ASM assembler.  It assembles
;   and the hex output has been compared against the object listing
;   from the OCR'd listing and they match.  However, there is no
;  guarantee that this source is actually accurate.
;       Revision history:
;            99/11/06 -- jtb: first released version
;            99/11/13 -- jtb: fixed two source code OCR errors
; --- NOTE END ---
;
;
;
;
;        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:
;
;     CURSOR UP       CTL-W
;     CURSOR LEFT     CTL-A
;     CURSOR RIGHT    CTL-S
;     CURSOR DOWN     CTL-Z
;     CURSOR HOME     CTL-N
;     CLEAR SCREEN    CTL-K
;     MODE            CTL-@
;
;
;
	ORG	0C000H
;
;
;   AUTO-STARTUP CODE
;
START:	MOV	A,A	;SHOW THIS IS CUTER (SOLOS=00)
;      THIS BYTE ALLOWS AUTOMATIC POWER ON ENTRY
;      WHEN IN ROM SUPPORTING THIS HARDWARE FEATURE.
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     KEYBOARD INPUT     BUILT-IN VDM DRIVER
;         ACTUAL PORT 3      PORT C8, MEMORY FROM CC00
;   1     SERIAL PORT        SERIAL PORT
;         ACTUAL PORT 1      ACTUAL PORT 1
;   2     PARALLEL PORT      PARALLEL PORT
;         ACTUAL PORT 2      ACTUAL PORT 2
;   3     USER'S INPUT RTN   USER'S OUTPUT ROUTINE
;
;  STATUS FOR ACTUAL PORTS 1, 2 AND 3 IS VIA ACTUAL
;  PORT 0.  THE BITS OF PORT ZERO ARE DEFINED AS FOLLOWS:
;
;   :     :     :     :     :     :---- : --- : --- :
;   : TBE : RDA :     :     :     :PXDR : PDR : KDR :
; BIT  7     6     5     4     3     2     1     0
;
;  WHERE:
;    TBE    1=TRANSMITTER BUFFER EMPTY (SERIAL)
;    RDA    1=READER DATA AVAILABLE (SERIAL)
;    ----
;    PXDR   0=PARALLEL EXTERNAL DEVICE READY
;    ---
;    PDR    0=PARALLEL DATA READY
;    ---
;    KDR    0=KEYBOARD DATA READY
;
;
;
;
;  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	STAPT	;GET STATUS WORD
	CMA		;INVERT IT FOR PROPER RETURN
	ANI	KDR	;TEST NOT KEYBOARD DATA READY
	RZ		;ZERO IF NO CHARACTER RECEIVED
;
	IN	KDATA	;GET CHARACTER
	RET		;GO BACK WITH IT
;
;
;
;   SERIAL INPUT ROUTINE
;
SREA1:	EQU	$	;SERIAL INPUT ROUTINE
	IN	STAPT	;GET STATUS
	ANI	SDR	;TEST FOR SERIAL DATA READY
	RZ		;FLAGS ARE SET
;
	IN	SDATA	;GET DATA BYTE
;  IT IS UP TO THE CALLER TO STRIP PARITY IF DESIRED
	RET		;WE HAVE IT
;
;
;   SERIAL DATA OUTPUT
;
SEROT:	EQU	$	;SERIAL OUTPUT ROUTINE
	IN	STAPT	;GET STATUS
	RAL		;PUT HIGH BIT IN CARRY
	JNC	SEROT	;LOOP UNTIL TRANSMITTER BUFFER IS EMPTY
	MOV	A,B	;GET THE CHARACTER BACK
	OUT	SDATA	;SEND IT OUT
	RET		;AND WE'RE DONE
;
;
; PARALLEL DATA INPUT
PARIT:	EQU	$	;GET CHAR FM PARALLEL PORT
	IN	STAPT	;STATUS
	CMA		;INVERT FOR PROPER RETURN
	ANI	PDR	;IS DATA READY?
	RZ		;NO--JUST EXIT
	IN	PDATA	;YES--GET CHAR THEN
	RET		;THEN EXIT
;
;
;  PARALLEL DATA OUTPUT ROUTINE
PAROT:	EQU	$	;OUTPUT CHAR TO PARALLEL PORT
	IN	STAPT	;STATUS
	ANI	PXDR	;IS EXTERNAL DEVICE READY?
	JNZ	PAROT	;NO--WAIT TIL IT IS
	MOV	A,B	;GET CHAR
	OUT	PDATA	;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
	PUSH	H	;SAVE HL
	PUSH	D	;SAVE DE
	PUSH	B
;
;  PROCESS ESC SEQUENCE IF ANY
;
	LDA	ESCFL	;GET ESCAPE FLAG
	ORA	A
	JNZ	ESCS	;IF NON ZERO GO PROCESS THE REST OF THE SEQUENCE
;
	MOV	A,B	;GET CHAR
	ANI	7FH	;CLR HI BIT IN CASE
	MOV	B,A	;USE CHAR STRIPPED OF HI BIT FOR COMPATABILITY
	JZ	GOBK	;MAKE A QUICK EXIT FOR A NULL
;
	LXI	H,TBL
	CALL	TSRCH	;GO PROCESS
;
GOBACK:	EQU	$	;RESET CURSOR AND DELAY
	CALL	VDADD	;GET SCRN ADDR
	MOV	A,M	;GET CHAR
	ORI	80H	;INVERSE VIDEO
	MOV	M,A	;CURSOR IS NOW THERE
	LHLD	SPEED-1	;GET DELAY SPEED
	INR	L	;MAKE IT DEFINITELY NON-ZERO
	XRA	A	;DELAY ENDS WHEN H=ZERO
TIMER:	DCX	H	;LOOP FOR DELAY AMNT
	CMP	H	;IS IT DONE YET
	JNZ	TIMER	;NO--KEEP DELAYING
GOBK:	POP	B
	POP	D	;RESTORE ALL REGISTERS
	POP	H
	RET		;EXIT FROM VDMOT
;
;
NEXT:	EQU	$	;GO TO NEXT CHR
	INX	H
	INX	H
;
;  THIS ROUTINE SEARCHES FOR A MATCH OF THE CHAR IN "B"
;  TO THE CHAR IN THE TBL POINTED TO BY HL.
;
TSRCH:	MOV	A,M	;GET CHR FROM TABLE
	ORA	A	;SEE IF END OF TBL
	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		;RESTORE ADDR OF CHAR ENTRY IN TBL
	JMP	DISPT	;DISPATCH FOR CURSOR CONTROL
;
;
CHAR:	EQU	$	;WE HAVE A CHAR
	MOV	A,B	;GET CHARACTER
	CPI	7FH	;IS IT A DEL?
	RZ		;GO BACK IF SO
;
;
;
OCHAR:	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
	STA	NCHAR	;STORE THE NEW
	RNZ		;MORE CHARS THIS LINE
PDOWN:	EQU	$	;MOVE CURSOR DOWN ONE LINE
	LDA	LINE	;GET THE LINE COUNT
	INR	A
CURSC:	ANI	0FH	;MOD 15 INCREMENT
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	;NEXT CHAR
ERAS1:	EQU	$	;LOOP TO CLR SCRN
	MVI	M,' '	;BLANK IT OUT
	INX	H	;NEXT SCRN LOC
	MOV	A,H	;SEE IF DONE
	CPI	0D0H	;DID IT GO ABOVE VDM
	JC	ERAS1	;NO--MORE
	STC		;SAY WE WANT TO DROP THRU TO ERAS3
;
PHOME:	EQU	$	;RESET CURSOR TO HOME
	MVI	A,0	;CLEAR, LEAVE CARRY AS IS
	STA	LINE	;ZERO LINE
	STA	NCHAR	;LEFT SIDE OF SCREEN
	RNC		;THIS IS JUST A HOME OPERATION
;
ERAS3:	OUT	DSTAT	;RESET SCROLL PARAMETERS
	STA	BOT	;BEGINNING OF TEXT OFFSET
	RET
;
;
CLIN2:	EQU	$	;HERE TO SEE IF VDM OUTPUT
	LDA	OPORT	;GET CRNT OUTPUT PORT
	ORA	A
	RNZ		;NOT VDM--DONE THEN
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
;
;  MOVE CURSOR LEFT ONE POSITION
;
PLEFT:	LDA	NCHAR
	DCR	A
PCUR:	EQU	$	;TAKE CARE OF CURSOR SAME LINE
	ANI	03FH	;LET CURSOR WRAP AROUND
	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		;MAKES 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	;CLEAR FROM CURRENT CURSOR TO END OF LINE
;  NOTE THAT A COMES BACK=64 WHICH WILL BE CLEARED AT PCUR
	JMP	PCUR	;AND STORE THE NEW VALUE
;
;   ROUTINE TO PROCESS LINEFEED
;
PLF:	LDA	LINE	;GET LINE COUNT
	INR	A	;NEXT LINE
	ANI	15	;SEE IF IT WRAPPED AROUND
	JNZ	CUR	;IT DID NOT--NO SCROLL
;
	JMP	SROL	;SCROLL ONE LINE--CURSOR SOME POSITION
;
;     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 CHARACTER
	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
	CPI	2
	JC	SETX	;SET X
	JZ	SETY	;SET Y
	CPI	8	;SPECIAL SET SPEED
	JZ	STSPD	;YES--SET THE SPEED WITH IT THEN
	CPI	9
	JC	OCHAR	;PUT IT ON THE SCREEN
	RNZ
;
;  TAB ABSOLUTE TO VALUE IN REG B
;
SETX:	MOV	A,B
	JMP	PCUR
;
;  SET CURSOR TO LINE "B"
;
SETY:	MOV	A,B
	JMP	CURSC
;
;
;   PROCESS SECOND CHR OF ESC SEQUENCE
;
SECOND:	MOV	A,B
	CPI	3
	JZ	CURET
	CPI	4
	JNZ	ARET2
;
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,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
	ORA	A	;SEE IF THIS THE VDM
	JNZ	STRTB	;NO--DO NOT RESET VDM
	LXI	SP,SYSTP	;SET UP THE STACK FOR CALL
	CALL	PERSE	;(REG A ASSUMED TO COME BACK ZERO)
STRTB:	EQU	$	;FINISH OFF THIS PORT THEN DO NEXT
	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
	XRA	A
	OUT	TAPPT	;BE SURE TAPES ARE OFF
;
;
;
;            =--  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	CLIN2	;YES--TERMINATE LINE HERE (CLR IF VDM)
	CPI	LF	;IS IT A LINEFEED
	RZ		;YES--TERMINATE LINE AS IS
	LHLD	INPTR	;CRNT LINE PTR
	CPI	7FH	;DELETE CHR?
	JNZ	GCLI2	;NO--OK
	MVI	B,BACKS	;REPLACE IT
	DCX	H	;BACK LINE PTR UP TOO
	MVI	A,'G'-40H	;SEE IF A BELL
	CMP	M	;IS IT?
	JNZ	GCLI3	;NO--OK
	MOV	B,A	;YES--RING THE BELL THEN
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
;
CONT:	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
	LDA	OPORT	;SEE IF IT IS VDM
	ORA	A	;IS IT THE VDM PORT
	RNZ		;NO--HL ARE SET PROPERLY
	CALL	CREM	;REMOVE CURSOR
	MVI	C,1	;GET VDM ADDR FM POSITION ONE
	JMP	VDAD2	;GET SCRN ADDR
;
;           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	'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
;
;
;               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	;SCREEN
	DW	PERSE
	DB	UP	;CURSOR
	DW	PUP
	DB	DOWN	;"
	DW	PDOWN
	DB	LEFT	;"
	DW	PLEFT
	DB	RIGHT	;"
	DW	PRIT
	DB	HOME	;"
	DW	PHOME
	DB	CR	;CARRIAGE RETURN
	DW	PCR
	DB	LF	;LINE FEED
	DW	PLF
	DB	BACKS	;BACK SPACE
	DW	PBACK
	DB	ESC	;ESCAPE KEY
	DW	PESC
	DB	0	;END OF TABLE
;
;   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,LF	;LINE FEED
	CALL	SOUT
	MVI	B,CR	;CARRIAGE RETURN
	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	BLANK
	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	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 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:	MVI	M,'?'	;FLAG THE ERROR
	LDA	OPORT	;SEE IF VIA VDM DRIVER
	ORA	A
	JZ	COMND	;YES--VDM SCREEN NOW HAS THE ?
	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
	ANI	1	;JUST BIT ZERO
	MVI	A,TAPE1	;ASSUME TAPE ONE
	JNZ	STUNT	;IF NON ZERO, IT IS ONE
	RAR		;ELSE MAKE IT TAPE TWO
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:	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,' '	;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
	ORA	A	;IS IT ZERO?
	JZ	SETSP	;YES--THAT IS A PROPER SPEED
	MVI	A,32	;NO--SET SPEED PROPERLY THEN
SETSP:	STA	TSPD
	RET
;
;
STSPD:	EQU	$	;VDM ESCAPE SEQUENCE COMES HERE
	MOV	A,B	;GET CHAR FOR FOLLOWING DISPD
DISPD:	EQU	$	;SET DISPLAY SPEED
	STA	SPEED
	RET
;
;
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
	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
	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
	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
	LDA	FNUMF	;GET UNIT
	ORA	A	;SEE WHICH UNIT
	LDA	TSPD	;BUT 1ST 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 A 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--
;
;
;
;
;    S Y S T E M    E Q U A T E S
;
;
;          VDM PARAMETERS
;
VDMEM:	EQU	0CC00H	;VDM SCREEN MEMORY
;
;
;            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.
;
DOWN:	EQU	1AH	;CTL Z
UP:	EQU	17H	;CTL W
LEFT:	EQU	01H	;CTL A
RIGHT:	EQU	13H	;CTL S
CLEAR:	EQU	0BH	;CTL K
HOME:	EQU	0EH	;CTL N
MODE:	EQU	00H	;CTL-@
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	0	;STATUS PORT GENERAL
SDATA:	EQU	1	;SERIAL DATA
PDATA:	EQU	2	;PARALLEL DATA
KDATA:	EQU	3	;KEYBOARD DATA
DSTAT:	EQU	0C8H	;VDM CONTROL PORT
TAPPT:	EQU	0FAH	;TAPE STATUS PORT
TDATA:	EQU	0FBH	;TAPE DATA 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 DATA READY
PDR:	EQU	2	;PARALLEL DATA READY
PXDR:	EQU	4	;PARALLEL DEVICE READY
TFE:	EQU	8	;TAPE FRAMING ERROR
TOE:	EQU	16	;TAPE OVERFLOW 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
;
;
;
;
;       S Y S T E M   G L O B A L    A R E A
;
	ORG    START+0800H	;RAM STARTS JUST AFTER ROM
;
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
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	;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
;
	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.
;
; -*-