ORG	04000H	;ORG FOR CPM
*---> DEFINE LOCATION OF READ/WRITE WORK AREA
WORKA	EQU	05800H	;FILE WORK AREA, SYMBOL TBL
*--> FOLLOWING IS A JMP TABLE TO MAJOR
*    CCOS INPUT/OUTPUT ROUTINES, ETC.
	JMP	CCOS	;CCOS STARTUP, NO FILE INIT
	JMP	INIT	;INIT FILE TABLE
	JMP	KEYIN	;PRIMARY KEYBOARD INPUT
	JMP	TYPE	;PRIMARY OUTPUT
	JMP	ALTO1	;ALT OUT 1
	JMP	ALTO2	;ALT OUT 2
	JMP	TTYO	;TTY OUTPUT
	JMP	DSPLY	;VDM OUT (ONLY)
	JMP	QCHEK	;HI SPEED (NO WAIT) CTL-Q CHK
	JMP	XO	;HEX OUTPUT FROM A
	JMP	XOB	;HEX OUT FROM A W/BLANK
	JMP	TINTI	;TAPE INIT FOR INPUT
	JMP	TINTO	;TAPE INIT FOR OUTPUT
	JMP	TPIN	;TAPE IN
	JMP	TPOUT	;TAPE OUT
	JMP	TPINC	;TAPE IN, CKSUM W/B
	JMP	TPOTC	;TAPE OUT, CKSUM W/B
*---> TTY OUTPUT NULL COUNT
NULLS	DB	1	;1+# OF NULLS AFTER C/R
* * * * * * * * N O T E * * * * * * * *
* ALL THE INPUT/OUTPUT (I/O) ROUTINES *
* IN CCOS ARE GROUPED TOGETHER JUST   *
* BELOW THIS NOTE.  YOU NEED ONLY     *
* CHANGE THESE ROUTINES TO MAKE CCOS  *
* WORK FOR YOUR I/O.                  *
*
* CCOS - THE CACHE CASSETTE OPERATING SYSTEM
* A MODIFICATION OF PROCESSOR TECHNOLOGY PKG 1
*
*---> DEFINE VDM INFORMATION
VDMST	EQU	0E000H	;<---VDM START ADDR
CURS	EQU	0FA00H	;<---VDM CURSOR POINTER
IOBYT	EQU	CURS-1	;I/O BYTE
VDMEP	EQU	0E4H	;PAGE AFTER VDM
VDMP	EQU	0E0H	;VDM PORT
*---> MISCELLANEOUS EQUATES
STOP	EQU	'X'-40H	;KEYBOARD INPUT VALUE
*          (CTL-X) TO STOP LISTING
HOLD	EQU	1BH	;HOLD SCROLL (ESCAPE) CHAR
*---> KEYBOARD (PRIMARY INPUT) EQUATES
KEYSP	EQU	0	;KEYBOARD STATUS PORT
KEYSB	EQU	1	;KEYBOARD STATUS BIT
KEYSV	EQU	0	;VALUE WHEN READY
KEYDP	EQU	1	;KEYBOARD INPUT PORT
*---> ALTERNATE INPUT (KEY, MODEM) EQUATES
AISP	EQU	4	;ALT INP STATUS PORT
AISB	EQU	1	;ALT INP STATUS BIT
AISV	EQU	1	;ALT INP STAT READY VALUE
AIDP	EQU	5	;ALT INPUT DATA PORT
*---> TTY OUTPUT PORT DEFINITION
TTOSP	EQU	0	;TTY STATUS PORT
TTOSB	EQU	80H	;TTY STATUS BIT
TTOSV	EQU	0	;TTY OUT READY VALUE
TTODP	EQU	1	;TTY OUTPUT DATA PORT
*---> ALT OUTPUT PORT EQU'S
AO1SP	EQU	4	;ALT OUT 1 STATUS PORT
AO1SB	EQU	2	;ALT OUT 1 STATUS BIT
AO1SV	EQU	2	;ALT OUT 1 STAT READY VALUE
AO1DP	EQU	5	;ALT OUT 1 DATA PORT
*---> ALT OUTPUT PORT EQU'S
AO2SP	EQU	4	;ALT OUT 2 STATUS PORT
AO2SB	EQU	2	;ALT OUT 2 STATUS BIT
AO2SV	EQU	2	;ALT OUT 2 STAT READY VALUE
AO2DP	EQU	5	;ALT OUT 2 DATA PORT
*---> KEYBOARD STATUS CHECK ROUTINE
KEYST	IN	KEYSP	;READ KB STATUS
	ANI	KEYSB	;AND WITH STATUS BIT
	CPI	KEYSV	;ZERO INDICATOR IF READY
	RET	 	;..THEN RETURN
*---> ALTERNATE INPUT DEV INPUT RTN
ALTIN	LDA	IOBYT	;GET I/O BYTE
	ANI	40H	;ISOLATE ALT INP FLAG
	JZ	KEYIN	;GO TO PRIMARY IF NO ALT
	IN	AISP	;READ ALT INP STATUS BYTE
	ANI	AISB	;ISOLATE READY BIT
	CPI	AISV	;CHECK ALT IN STAT VALUE
	JNZ	KEYIN	;GO TO PRIMARY IF NO DATA
	IN	AIDP	;READ ALT INP DATA PORT
	RET	 	;..AND RETURN
*---> KEYBOARD INPUT ROUTINE TO B REG
IN8	CALL	KEYIN	;INPUT TO A
	MOV	B,A	;MOVE TO B
	RET
*---> KEYBOARD INPUT ROUTINE TO A REG
KEYIN	CALL	KEYST
	JNZ	ALTIN	;TRY ALTERNATE INPUT
KBIN	IN	KEYDP	;READ KBD DATA PORT
	ANI	7FH	;DEL PARITY
	CPI	'Q'-40H	;CONTROL Q?
	JZ	QUIT	;..YES - RET TO CCOS
	RET
*---> 'QUIT' CHECK ROUTINE
* ABORTS IF CTL-Q HAS BEEN TYPED,
* OTHERWISE JUST RETURNS
* (LIKE HI-SPEED CTL-C CHK IN BASIC)
QCHEK	CALL	KEYST	;CHECK STATUS
	CZ	KBIN	;READ CHR IF READY
	RET
*---> OUTPUT ROUTINE FROM B
OUT8	MOV	A,B
	JMP	TYPE
*---> TTY OUTPUT ROUTINE - SENDS
*     L/F, NULLS AFTER C/R
TTYO	PUSH	PSW
	IN	TTOSP	;GET STAT
	ANI	TTOSB	;GET BIT
	CPI	TTOSV	;READY?
	JNZ	TTYO+1	;NO
	POP	PSW	;GET CHAR
	OUT	TTODP	;OUTPUT
	CPI	13	;C/R?
	RNZ	 	;RET IF NOT
	MVI	A,10	;GET L/F
	CALL	TTYO	;OUTPUT L/F
	LDA	NULLS	;GET NULL COUNT
	PUSH	B	;SAVE BC
	MOV	B,A	; SAVE NULL COUNT
NULLO	MVI	A,7FH
	CALL	TTYO
	DCR	B	;MORE NULLS?
	JNZ	NULLO
	POP	B
	RET	 	;FROM TTYO
*---> ALT OUTPUT 1 SENDS L/F AFTER C/R
*     ONLY IF 10H BIT ON IN IOBYTE
* I.W. 'IOBYTE 11' CAUSES OUTPUT W/ L/F
ALTO1	PUSH	PSW
	IN	AO1SP	;READ STAT
	ANI	AO1SB	;GET READY BIT
	CPI	AO1SV	;READY?
	JNZ	ALTO1+1	;LOOP TILL READY
	POP	PSW
	OUT	AO1DP	;OUTPUT DATA
	CPI	13	;C/R?
	RNZ	 	;RET IF NOT C/R
* SEND L/F IF IOBYTE 10H BIT IS ON
	LDA	IOBYT
	ANI	10H
	MVI	A,10	;GET L/F
	CNZ	ALTO1
	MVI	A,13	;RESTORE C/R
	RET
*---> ALT OUTPUT 2 SENDS L/F AFTER C/R
ALTO2	PUSH	PSW
	IN	AO2SP	;READ STAT
	ANI	AO2SB	;GET READY BIT
	CPI	AO2SV	;READY?
	JNZ	ALTO2+1	;LOOP TILL READY
	POP	PSW
	OUT	AO2DP	;OUTPUT DATA
	CPI	13	;C/R?
	RNZ	 	;RET IF NOT C/R
	MVI	A,10	;GET LINEFEED
	JMP	ALTO2	;OUTPUT LINEFEED
*--TARBELL CASSETTE I/O ROUTINES---*
TBSP	EQU	6EH	;TARBELL STAT PORT
TBISB	EQU	10H	;TARBELL INPUT READY BIT
TBISV	EQU	0	;TARBELL IN READY VALUE
TBOSB	EQU	20H	;TARBELL OUTPUT READY BIT
TBOSV	EQU	0	;TARBELL OUT READY VALUE
TBDP	EQU	6FH	;TARBELL DATA PORT
START	EQU	3CH	;TARBELL START BYTE
SYNC	EQU	0E6H	;TARBELL SYNC BYTE
*---> TARBELL OUTPUT W/CHECKSUM
TPOTC	PUSH	6
	XRA	B
	MOV	B,A
	POP	6
*---> TARBELL OUTPUT
TPOUT	PUSH	6
	CALL	QCHEK	;ALLOW CTL-Q EXIT
	IN	TBSP	;READ TARBELL STATUS PORT
	ANI	TBOSB	;ISOLATE READY BIT
	CPI	TBOSV	;READY?
	JNZ	TPOUT+1	;..NO
	POP	6	;GET BYTE
	OUT	TBDP	;OUTPUT TARBELL DATA PORT
	RET
*---> TARBELL INPUT W/CHECKSUM
TPINC	CALL	TPIN
	PUSH	6
	XRA	B	;CALC CKSUM
	MOV	B,A	;PUT BACK TO B
	POP	6
	RET
*---> TARBELL INPUT
TPIN	CALL	QCHEK	;ALLOW CTL-Q EXIT
	IN	TBSP	;TARBELL STATUS PORT
	ANI	TBISB	;ISOLATE READY BIT
	CPI	TBISV	;READY?
	JNZ	TPIN	;..NO
	IN	TBDP	;READ TARBELL DATA
	RET
*---> TARBELL OUTPUT INITIALIZE
* WRITES START, SYNC, FILE NAME
TINTO	MVI	A,START
	CALL	TPOUT
	MVI	A,SYNC
	CALL	TPOUT
	MVI	B,5
	LXI	H,FBUF	;POINT TO FILE NAME
	CALL	SET1	;ENSURE VDM OK
TIOL	MOV	A,M	;GET FILE NAME BYTE
	CALL	TPOUT	;OUT TO TARBELL
	CALL	DSPLY	;..AND VDM
	INX	H
	DCR	B	;DONE?
	JNZ	TIOL	;NO
	RET
*---> TARBELL INITIALIZE FOR INPUT
* READS UNTIL FILE NAME MATCH FOUND
TINTI	EQU	$
	MVI	A,10H	;TARBELL RESET
	OUT	TBSP	;OUT STAT PORT
	LXI	B,5	;FILENAME LENGTH
	LXI	H,FBUF	;FILENAME ADDR
	CALL	SET1	;VDM ADDR
TINTL	CALL	TPIN
	CMP	M
	JZ	TINTM
	INR	B	;BUMP NOT = COUNT
TINTM	CPI	' '	;' PRINTABLE?
	JC	TINTI	;-DON'T PRT IF BAD
	ORA	A
	JM	TINTI	;HI BIT ON - BAD
	CALL	DSPLY
	INX	H
	DCR	C
	JNZ	TINTL
	DCR	B
	RM
	JMP	TINTI
*---> OUTPUT ROUTINE, TO VDM + ALTERNATES 1,
*     AND/OR 2 AND/OR TTY ACCORDING TO IOBYTE
TYPE	PUSH	B	;SAVE BC
	MOV	C,A	;CHAR TO C
* OUTPUT TO VDM
	CALL	DSPLY
	LDA	IOBYT	;GET I/O BYTE
	MOV	B,A	;SAVE IN B
* OUTPUT ALTERNATE 1?
	ANI	1	;ALT 1 OUTPUT?
	MOV	A,C
	CNZ	ALTO1	;ALT OUTPUT 1
* OUTPUT ALTERNATE 2?
	MOV	A,B	;GET IOBYTE
	ANI	2	;ALT 2 OUTPUT?
	MOV	A,C	;CHAR TO A
	CNZ	ALTO2	;ALT OUTPUT 2
* OUTPUT TO TTY?
	MOV	A,B	;GET IOBYTE
	ANI	4	;TTY OUTPUT?
	MOV	A,C	;GET CHAR
	CNZ	TTYO	;TTY OUTPUT
	MOV	A,C	;GET CHAR
	POP	B	;RESTORE BC
	RET
DSPLY	PUSH	H	;SAVE HL
	LHLD	CURS	;GET CURSOR
	CPI	0DH	;C/R?
	JZ	ISCR	;..YES
	CPI	'H'-40H	;BACKSPACE?
	JNZ	NOTBS	;..NO
	MVI	M,' '	;' BKSP: DELETE CURSOR
	DCX	H	;..BACK UP,
	JMP	SVCUR	;..THEN STORE CURSUR
NOTBS	MOV	M,A	;SAVE INCOMING CHAR
	INX	H	;BUMP POINTER
CKEOS	MOV	A,H	;CHECK END OF SCREEN
	CPI	VDMEP	;END OF SCRN?
	JZ	SCRUP	;SCROLL UP IF AT END
	ANI	VDMEP-1	;OTHERWISE JUST
	ORI	VDMEP-4	;..ENSURE ON VDM
	MOV	H,A	;MOVE BACK
SVCUR	SHLD	CURS
CURON	MVI	M,' '
	POP	H
	RET
ISCR	CALL	BLANK
	JMP	CKEOS
SCRUP	PUSH	D
	LXI	H,VDMST
	LXI	D,VDMST+40H
VDMUP	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	MOV	A,D
	CPI	VDMEP	;PAST VDM?
	JNZ	VDMUP
	POP	D
	LXI	H,VDMST+3C0H
	SHLD	CURS
	MVI	M,' '
	INX	H
	CALL	BLANK
	POP	H
	CALL	KBIN	;READ KB, NO WAIT
	CPI	HOLD	;HOLD CHAR?
	RNZ
	CALL	KEYIN	;READ CHAR
	CPI	'B'	;<--BASIC?
	JZ	0	;<-C-A-U-T-I-O-N JMP 0!!
	RET
BLANK	MVI	M,' '	;'
	INX	H
	MOV	A,L
	ANI	3FH
	JNZ	BLANK
	RET
*---> ENTRY POINT, CLEAR FILE TABLE FIRST
INIT	MVI	C,INSP-FILE0	;FILE TABLE LENGTH
	XRA	A	;A=0
	LXI	H,FILE0	;POINT TO FILE TABLE
INIT2	MOV	M,A
	INX	H
	DCR	C
	JNZ	INIT2
*---> INIT SERIAL I/O PORT
	MVI	A,3	;GET RESET CHAR
	OUT	4
	MVI	A,15H	;GET CONTROL VALUE
	OUT	4
*---> REPL FOLLOWING JMP W/ CALL TO FURTHER
*     INITIALIZATION CODE YOU MAY NEED
	JMP	QUIT	;DUMMY JMP TO ALLOW PATCH
QUIT	XRA	A
	OUT	VDMP	;RESET VDM
	STA	IOBYT	;RESET I/O BYTE
	LXI	SP,AREA+18	;INIT STACK
	LXI	H,VDMST
	SHLD	CURS
	LXI	H,QUITM
	CALL	SCRN
	CALL	CRLF
*---> PRIMARY ENTRY POINT W/O CLEARING FILES
CCOS	LXI	SP,AREA+18
	CALL	READ	;READ INPUT LIST
	INX	H	;SKIP LENGTH BYTE
	MOV	A,M	;LOAD 1ST CHAR OF COMMAND
	CPI	'9'+1	;LINE NUMBER?
	JC	LINE	;..YES
	CALL	VALC	;GET COMMAND VALUES
	CALL	COMM	;LOOKUP/EXECUTE COMMAND
*---> RETURN FROM COMMAND EXECUTION
EOR	CALL	CRLF
	JMP	CCOS
*---> 'QUIT' MESSAGE
QUITM	DW	'QU'
	DW	'IT'
	DB	13
*---> READ INPUT LINE INTO INBUF
READ	LXI	H,IBUF
	SHLD	ADDS
	MVI	E,2
NEXT	CALL	IN8
	MOV	A,B
	CPI	'X'-40H	;CTL-X? (DELETES LINE)
	JNZ	CR
	CALL	CRLF
	JMP	READ
CR	CPI	13
	JNZ	DEL
	MOV	M,A	;STORE C/R
	MOV	A,E
	CPI	2	;NO DATA IN LINE?
	JZ	READ	;JMP IF C/R AND NO DATA READ
	INX	H
	MVI	M,1
	INX	H
	LXI	B,SYMT	;END OF INBUF ADDR
	MOV	A,C
	CALL	CLER	;CLEAR REMAINDER OF INPUT BUFF
	LXI	H,IBUF-1
	MOV	M,E
	RET
DEL	CPI	7FH	;DELETE CHAR?
	JNZ	CHAR
	MOV	A,E	;<<MOD>>
	CPI	2	;<<MOD>>
	JZ	NEXT
	DCX	H
	DCR	E
BSPA	MVI	B,08H	;ECHO BACKSPACE CHAR
	CALL	OUT8
	JMP	NEXT
CHAR	CPI	' '	;'
	JC	NEXT
	CPI	80H	;<<MINOR MOD - ALLOW TO 7FH>>
	JNC	NEXT
	MOV	B,A
	CALL	OUT8	;ECHO
	MOV	M,A
	MOV	A,E	;<<MOD>> TO ENSURE LINE
	CPI	80	;<<MOD>> ..IS < 80 LONG
	JZ	BSPA
	INX	H
	INR	E
	JMP	NEXT
* BLANK AN AREA UNTIL L=A
CLER	CMP	L
	RZ
	MVI	M,' '	;'
	INX	H
	JMP	CLER
CRLF	MVI	B,0DH
	CALL	OUT8
	RET	 	;RET W/ NO LF OR DEL
*---> EXEC COMMAND
EXEC	CALL	VCHK	;CHECK VALUE
	CALL	CRLF	;C/R
	LHLD	BBUF	;GET ADDR
	PCHL	 	;EXEC PROG
*---> OUTPUT COMMAND: OUT PORT VAL
OUTPU	CALL	VCHK	;CHECK VALUE
	CALL	CRLF	;C/R
* BBUF = PP 00 VV 00 (PP=PORT, VV=VALUE)
	LXI	H,BBUF	;POINT TO PP 
	MOV	B,M	;B=PORT
	MVI	M,0D3H	;STORE 'OUT' OP CODE
	INX	H
	MOV	M,B	;STORE OUTPUT ADDR
	INX	H	;POINT TO DATA
	MOV	A,M	;GET DATA
	MVI	M,0C9H	;STORE 'RET' OP CODE
* BBUF NOW = D3 PP C9
	JMP	BBUF	;GO 'OUT PP, RET'
*---> ROUTINE TO SET I/O BYTE
SETIO	CALL	CRLF
	LXI	H,IOBYT	;POINT TO IOBYTE
	MOV	C,M	;GET OLD IOBYTE
	LXI	D,ISMSG	;'IS '
	LDA	ABUF	;CHECK PARM
	ORA	A	;NONE?
	JZ	IOBTY	;TYPE 'IS XX'
	LXI	D,IOMSG	;GET 'WAS ' MSG
	LDA	BBUF	;GET NEW
	MOV	M,A	;STORE
IOBTY	XCHG	 	;MSG ADDR TO HL
	CALL	SCRN	;OUTPUT MSG
	MOV	A,C	;GET OLD IOBYTE
	JMP	HOUT	;OUTPUT IN HEX, RETURN
IOMSG	DW	'WA'	;'WAS ' MSG
	DW	'S '	;S'
	DB	13	;C/R END OF MSG
ISMSG	DW	'IS'	;'IS '
	DB	' '	;'
	DB	13	;END OF MSG
*---> COMMAND LOOKUP ROUTINE
COMM	LXI	D,CTAB
	MVI	B,NCOM	;<--- MAX # OF COMMANDS
	MVI	A,4
	STA	NCHR
	CALL	COMS
	JNZ	WHAT
	PCHL	 	;EXECUTE COMMAND
COMS	LHLD	HCON
	LDA	NCHR
	MOV	C,A
	CALL	SEAR
	LDAX	D
	MOV	L,A
	INX	D
	LDAX	D
	MOV	H,A
	RZ
	INX	D
	DCR	B
	JNZ	COMS
	INR	B
	RET
*---> COMPARE RTN, DE TO HL, LENGTH IN C
SEAR	LDAX	D
	CMP	M
	JNZ	INCA
	INX	H
	INX	D
	DCR	C
	JNZ	SEAR
	RET
*---> COMPARE DIDN'T MATCH - BUMP D TO END
INCA	INX	D
	DCR	C
	JNZ	INCA
	INR	C
	RET
*---> ROUTINE TO ZERO A BUFFER
ZBUF	XRA	A
	LXI	D,ABUF+12
	MVI	B,12
ZBU1	DCX	D
	STAX	D
	DCR	B
	JNZ	ZBU1
	RET
*---> CHECK COMMAND VALUES
VALC	CALL	ETRA
	JC	WHAT
	RET
ETRA	LXI	H,0
	SHLD	BBUF+2
	SHLD	FBUF
	CALL	ZBUF
	LXI	H,IBUF-1
VAL1	INX	H
	MOV	A,M
	CPI	' '	;'
	CMC
	RNC
	JNZ	VAL1
	SHLD	PNTR
	CALL	SBLK
	CMC
	RNC
	CPI	'/'	;START OF FILE NAME?
	JNZ	VAL5
	LXI	D,FBUF
	MVI	C,NL
VAL2	INX	H
	MOV	A,M
	CPI	'/'
	JZ	VAL3
VAL2A	DCR	C
	JM	WHAT
	STAX	D
	INX	D
	JMP	VAL2
VAL3	MVI	A,' '	;'
VAL4	DCR	C
	JM	DONE
	STAX	D
	INX	D
	JMP	VAL4
DONE	CALL	SBL2
	CMC
	RNC
VAL5	LXI	D,ABUF
	CALL	ALPS
	MOV	A,B
	CPI	NL
	CMC
	RC
	LXI	B,ABUF
	CALL	AHEX
	RC
	SHLD	BBUF
	LXI	H,ABUF
	CALL	NORM
	CALL	SBLK
	CMC
	RNC
	LXI	D,ABUF+4
	CALL	ALPS
	MOV	A,B
	CPI	5
	CMC
	RC
	LXI	B,ABUF+4
	CALL	AHEX
	RC
	SHLD	BBUF+2
	LXI	H,ABUF+4
	CALL	NORM
	ORA	A
	RET
ADEC	LXI	H,0
ADE1	LDAX	B
	ORA	A
	RZ
	MOV	D,H
	MOV	E,L
	DAD	H
	DAD	H
	DAD	D
	DAD	H
	SUI	'0'
	CPI	0AH
	CMC
	RC
	MOV	E,A
	MVI	D,0
	DAD	D
	INX	B
	JMP	ADE1
AHEX	LXI	H,0
AHE1	LDAX	B
	ORA	A
	RZ
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	CALL	AHS1
	CPI	10H
	CMC
	RC
	ADD	L
	MOV	L,A
	INX	B
	JMP	AHE1
AHS1	SUI	'0'
	CPI	0AH
	RC
	SUI	07H
	RET
HOUT	CALL	BINH
HOUT1	LXI	H,HCON
	MOV	B,M
	CALL	OUT8
	INX	H
	MOV	B,M
	CALL	OUT8
	RET
*---> HEX OUT W/BLANK.  BC, HL CLOBBERED
HOTB	CALL	HOUT
	CALL	BLK1
	RET
	CALL	BIND
	CALL	HOUT1
	INX	H
	MOV	B,M
	CALL	OUT8
	RET
BLK1	MVI	B,' '	;'
	CALL	OUT8
	RET
ACHK	LHLD	BBUF
	LDA	BBUF+3
	CMP	H
	JNZ	ACH1
	LDA	BBUF+2
	CMP	L
	JNZ	ACH1
	STC
ACH1	INX	H
	SHLD	BBUF
	RET
SCRN	MOV	B,M
	MVI	A,0DH
	CMP	B
	RZ
	CALL	OUT8
	INX	H
	JMP	SCRN
BINH	LXI	H,HCON
BINH2	MOV	B,A
	RAR
	RAR
	RAR
	RAR
	CALL	BIN1
	MOV	M,A
	INX	H
	MOV	A,B
	CALL	BIN1
	MOV	M,A
	RET
BIN1	ANI	0FH
	ADI	'0'
	CPI	'9'+1
	RC
	ADI	07H
	RET
BIND	LXI	H,HCON
	MVI	B,100
	CALL	BID1
BIND2	MVI	B,10
	CALL	BID1
	ADI	'0'
	MOV	M,A
	RET
BID1	MVI	M,'0'-1
BID12	INR	M
	SUB	B
	JNC	BID12
	ADD	B
	INX	H
	RET
VCHK	LDA	ABUF
	ORA	A
	JZ	WHAT
	RET
*---> DUMP
DUMP	CALL	VCHK
	MVI	A,10H
	STA	SCNT
DUMS	CALL	CRLF
	LDA	BBUF+1
	CALL	HOUT
	LDA	BBUF
	CALL	HOTB
	LDA	SCNT
DUM1	STA	DCNT
	LHLD	BBUF
	MOV	A,M
DUM2	CALL	HOTB
	CALL	QCHEK	;ALLOW CTL-Q
	CALL	ACHK
	RC
	LDA	DCNT
	DCR	A
	JNZ	DUM1
	JMP	DUMS
*---> PAGE COMMAND
PAGE	CALL	VCHK
	LDA	ABUF+4
	ORA	A
	JZ	WHAT
	LHLD	BBUF
	XCHG
	LHLD	BBUF+2
	MVI	B,0
PAG1	MOV	A,E
	MOV	A,D
	CPI	-1
	LDAX	D
	JNZ	PAG2
PAG2	MOV	M,A
	INX	H
	INX	D
	DCR	B
	JNZ	PAG1
	RET
*---> FILE COMMAND
FILE	CALL	CRLF
	LDA	FBUF
	ORA	A
	JZ	FOUT
	CALL	FSEA
	XCHG	
	JNZ	TEST
	LDA	ABUF
	ORA	A
	JZ	WHA1
	LDA	FEF
	ORA	A
	JNZ	ROOM
	LXI	H,EMES1
	JMP	MESS
TEST	LDA	ABUF
	ORA	A
	JZ	SWAPS
	LHLD	BBUF
	MOV	A,H
	ORA	L
	JZ	SWAPS
	LXI	H,EMES2
	JMP	MESS
ROOM	LHLD	FREAD
	XCHG	
	LXI	H,FBUF
	PUSH	D
	MVI	C,NMLEN
MOV23	MOV	A,M
	STAX	D
	INX	D
	DCR	C
	JMP	PATCH
PRET	POP	D
SWAPS	LXI	H,FILE0
	MVI	C,NMLEN+8
SWAP	LDAX	D
	MOV	B,M
	MOV	M,A
	MOV	A,B
	STAX	D
	INX	D
	INX	H
	DCR	C
	JNZ	SWAP
	LDA	ABUF
	ORA	A
	JZ	FOOT
	LHLD	BBUF
	SHLD	BOFP
	SHLD	EOFP
	MOV	A,L
	ORA	H
	JZ	FIL35
	MVI	M,1
FIL35	XRA	A
	STA	MAXL
	JMP	FOOT
FOUT	LDA	IBUF+4
	CPI	'S'
	MVI	C,MAXFL	;MAX FILES
	JZ	FOUL
FOOT	MVI	C,1
FOUL	LXI	H,FILE0
	MOV	A,C
FINE	STA	FOCNT
	PUSH	H
	LXI	D,NMLEN
	DAD	D
	MOV	A,M
	ORA	A
	JNZ	FOOD
	INX	H
	ADD	M
	INX	H
	JNZ	FOOD
	INX	SP
	INX	SP
	INX	H
	INX	H
	JMP	FEET
FOOD	POP	H
	MVI	C,NMLEN
FAST	MOV	B,M
	CALL	OUT8
	DCR	C
	INX	H
	JNZ	FAST
	CALL	FOOL
	CALL	FOOL
	CALL	CRLF
FEET	LXI	D,4
	DAD	D
	LDA	FOCNT
	DCR	A
	JNZ	FINE
	RET	
FOOL	CALL	BLK1
	INX	H
	MOV	A,M
	DCX	H
	PUSH	H
	CALL	HOUT
	POP	H
	MOV	A,M
	INX	H
	INX	H
	PUSH	H
	CALL	HOTB
	POP	H
	RET	
FSEA	XRA	A
	STA	FEF
	MVI	B,MAXFL
	LXI	D,FILE0
FSE10	LXI	H,FBUF
	MVI	C,NMLEN
	CALL	SEAR
	PUSH	PSW
	PUSH	D
	LDAX	D
	ORA	A
	JNZ	FSE20
	INX	D
	LDAX	D
	ORA	A
	JNZ	FSE20
	XCHG	
	LXI	D,-6
	DAD	D
	SHLD	FREAD
	MOV	A,D
	STA	FEF
	POP	H
	POP	PSW
FSE15	LXI	D,8
	DAD	D
	XCHG	
	DCR	B
	RZ		;
	JMP	FSE10
FSE20	POP	H
		POP	 PSW
		JNZ	 FSE15
		LXI	  D,-5
 	DAD	 D
		MOV	   A,D
		ORA	 A
		RET
*---> 'WHAT' ERROR MESSAGE PRINT
WHAT	CALL	CRLF
WHA1	LXI		 H,EMES
MESS	CALL	SCRN
		JMP	  EOR
EMES	DB		 'W'
		DB	  'H'
		DB	  'A'
		DB	  'T'
		DB	  '?'
		DB	  13
EMES1	DB		 'F'
		DB	  'U'
		DB	  'L'
		DB	  'L'
		DB	  13
EMES2	DB		 'N'
		DB	  'O'
		DB	  ' '
		DB	  'N'
		DB	  'O'
		DB	  13
*---> ENTR COMMAND
ENTR	CALL	VCHK
		CALL	 ENTS
		JC	 WHAT
		CALL	 CRLF
		RET
ENTS	CALL	CRLF
		CALL	 READ
		LXI	  H,IBUF
		SHLD	 PNTR
ENT1	CALL	ZBUF
		CALL	 SBLK
		JC	 ENTS
		CPI	  '/'
		RZ
		CALL	 ALPS
		MOV	   A,B
		CPI	  3
		CMC
		RC
		LXI	  B,ABUF
		CALL	 AHEX
		RC
		MOV	   A,L
		LHLD	 BBUF
		MOV	   M,A
		CALL	 ACH1
		JMP	  ENT1
*---> SOURCE FILE LINE INPUT ROUTINE
LINE	MVI		 C,4
		LXI	  H,IBUF-1
LICK	INX		 H
		MOV	   A,M
		CPI	  '0'
		JC	 WHAT
		CPI	  '9'+1
		JNC	 WHAT
		DCR	  C
		JNZ	 LICK
		SHLD	 ADDS
		LXI	  D,MAXL+3
		CALL	 COM0
		JNC	 INSR
		INX	  H
		CALL	 LODM
		LXI	  H,MAXL+3
		CALL	 STOM
		LXI	  D,IBUF-1
		LHLD	 EOFP
		MVI	  C,1
		CALL	 LMOV  
		MOV	   M,C
		SHLD	 EOFP
		JMP	  EOR
INSR	CALL	FIN1
		MVI	  C,2
		JZ	 EQUL
		DCR	  C
EQUL	MOV		  B,M
		DCX	  H
		MVI	  M,2
		SHLD	 INSP
		LDA	 IBUF-1
		DCR	  C
		JZ	 LT
		SUB	  B
		JZ	 ZER0
		JC	 GT
LT	LHLD	EOFP
		MOV	   D,H
		MOV	   E,L
		CALL	 ADR
		SHLD	 EOFP
		MVI	  C,2
		CALL	 RMOV  
		JMP	  ZER0
GT	CMA
		INR	  A
		MOV	   D,H
		MOV	   E,L
		CALL	 ADR
		XCHG
		CALL	 LMOV  
		MVI	  M,1
		SHLD	 EOFP
ZER0	LHLD	INSP
		MVI	  M,13
		INX	  H
		LXI	  D,IBUF-1
		MVI	  C,1
		CALL	 LMOV  
		JMP	  EOR
FIND	LXI	H,ABUF+3
FIN0	SHLD	ADDS
FIN1	LHLD	BOFP
FI1	CALL	EO1
	XCHG
	LHLD	ADDS
	XCHG
	MVI	A,4
	CALL	ADR
	CALL	COM0
	RC
	RZ
FI2	MOV	A,M
	CALL	ADR
	JMP	FI1
EOF	INX	H
EO1	MVI	A,1
	CMP	M
	RNZ
	JMP	EOR
ADR	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET
LMOV	LDAX	D
	INX	D
	CMP	C
	RZ
	MOV	M,A
	INX	H
	JMP	LMOV
RMOV	LDAX	D
	DCX	D
	CMP	C
	RZ
	MOV	M,A
	DCX	H
	JMP	RMOV
LODM	MOV	B,M
	INX	H
	MOV	C,M
	INX	H
	MOV	D,M
	INX	H
	MOV	E,M
	RET
STOM	MOV	M,E
	DCX	H
	MOV	M,D
	DCX	H
	MOV	M,C
	DCX	H
	MOV	M,B
	RET
COM0	MVI	B,1
	MVI	C,4
	ORA	A
CO1	LDAX	D
	SBB	M
	JZ	CO2
	INR	B
CO2	DCX	D
	DCX	H
	DCR	C
	JNZ	CO1
	DCR	B
	RET
	MVI	C,4
	LDAX	D
	SUI	1
	JMP	CO1+1
NORM	CALL	LODM
	XRA	A
	CMP	B
	RZ
NOR1	CMP	E
	CNZ	STOM
	RNZ
	MOV	E,D
	MOV	D,C
	MOV	C,B
	MVI	B,'0'
	JMP	NOR1
* ---> LIST COMMAND MODIFIED TO ACCEPT
* ENDING LINE NUMBER ALSO
LIST	CALL	CRLF
	LXI	H,-1	;DFLT ENDING ADDR
	LDA	ABUF+4	;GET 'TO' LINE NUMBER
	ORA	A	;ANYTHING ENTERED?
	JZ	LNOTO	;..NO 'TO' LINE
	LXI	H,ABUF+7
	CALL	FIN0	;FIND LINE
LNOTO	PUSH	H	;SAVE END ADDR
	CALL	FIND
	POP	D	;RESTORE END ADDR
LIS1	INX	H
	CALL	SCRN
	CALL	CRLF
	CALL	EOF
	CALL	QCHEK	;ALLOW CTL-Q EXIT
	MOV	A,D	;END ADDR
	CMP	H	;DONE?
	JNZ	LIS1	;CONTINUE?
	MOV	A,E
	CMP	L
	JNZ	LIS1
	RET
* ---> DELT COMMAND
DELT	CALL	VCHK	;*** DELT ***
	CALL	FIND
	SHLD	INSP
	LXI	H,ABUF+7
	MOV	A,M
	ORA	A
	JNZ	DEL1
	LXI	H,ABUF+3
DEL1	SHLD	ADDS
	XCHG
	LXI	H,MAXL+3
	CALL	COM0
	LHLD	DELP
	JC	NOVR
	SHLD	EOFP
	MVI	M,1
	XCHG
	LHLD	BOFP
	XCHG
	MVI	B,13
	DCX	H
DEL2	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	MVI	A,13
	JC	DEL4
	DCR	B
	DCX	H
	CMP	M
	JNZ	DEL2
	DCX	H
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	DEL5
	CMP	M
	INX	H
	INX	H
	JZ	DEL3
DEL2A	INX	H
DEL3	CALL	LODM
	LXI	H,MAXL+3
	CALL	STOM
	RET
DEL4	CMP	B
DEL5	XCHG	
	JNZ	DEL2A
	STA	MAXL
	RET	
NOVR	CALL	FI1
	CZ	FI2
	XCHG	
	LHLD	DELP
	MVI	C,1
	CALL	LMOV
	SHLD	EOFP
	MVI	M,1
	RET	
*---> ASSM COMMAND
ASSM	CALL	VCHK
	LDA	ABUF+4
	ORA	A
	JNZ	ASM4
	LHLD	BBUF
	SHLD	BBUF+2
ASM4	LDA	IBUF+4
	CPI	'E'
	JNZ	ASM5
	XRA	A
ASM5	STA	AERR
	XRA	A
	STA	NOLA
ASM3	STA	PASI
	LHLD	BBUF
	SHLD	ASPC
	LHLD	BOFP
	SHLD	APNT
ASM1	LHLD	APNT
	LXI	SP,AREA+18
	MOV	A,M
	CPI	1
	JZ	EASS
	XCHG	
	INX	D
	LXI	H,OBUF
	MVI	A,25	;<<MOD>> LOAD OBUF LENGTH
	ADD	L	;<<MOD>> A= '>IBUF-5'
	CALL	CLER
	MVI	C,13
	CALL	LMOV
	MOV	M,C
	XCHG	
	SHLD	APNT
	LDA	PASI
	ORA	A
	JNZ	ASM2
	CALL	PAS1
	JMP	ASM1
ASM2	CALL	PAS2
	LXI	H,OBUF
	CALL	AOUT
	JMP	ASM1
AOUT	LDA	AERR
	ORA	A
	JNZ	AOU1
AOU2	LDA	OBUF+18
	CPI	' '	;'
	RZ	
AOU1	LXI	H,OBUF
	CALL	CRLF
	CALL	SCRN
	RET	
PAS1	CALL	ZBUF
	STA	PASI
	LXI	H,IBUF
	SHLD	PNTR
	MOV	A,M
	CPI	' '	;'
	JZ	OPC
	CPI	'*'
	RZ	
	CALL	SLAB
	JC	OP5
	JZ	ERRD
	CALL	LCHK
	JNZ	OP5
	MVI	C,5
	LXI	H,ABUF
MLAB	MOV	A,M
	STAX	D
	INX	D
	INX	H
	DCR	C
	JNZ	MLAB
	XCHG	
	SHLD	TABA
	LDA	ASPC	;<<MOD>> FOR COMS MOD
	MOV	M,A
	INX	H
	LDA	ASPC+1	;<<MOD>> FOR COMS MOD
	MOV	M,A
	LXI	H,NOLA
	INR	M
OPC	CALL	ZBUF
	CALL	SBLK
	JC	OERR
	CALL	ALPS
	CPI	' '	;'
	JC	OPCD
	JNZ	OERR
	JMP	OPCD
LCHK	LHLD	PNTR
	MOV	A,M
	CPI	' '	;'
	RZ	
	CPI	':'
	RNZ	
	INX	H
	SHLD	PNTR
	RET	
PSU1	CALL	SBLK
	LDAX	D
	ORA	A
	JZ	ORG1
	JM	DAT21
	JPO	EQU1
	CPI	5
	JC	RES1
	JNZ	EASS
ACO1	MVI	C,2
	XRA	A
	JMP	OCN1
ORG1	CALL	ASCN
	LDA	OBUF+18
	CPI	' '	;'
	RNZ
	SHLD	ASPC
	LDA	IBUF
	CPI	' '	;'
	RZ
	JMP	EQUS
EQU1	CALL	ASCN
	LDA	IBUF
	CPI	' '	;'
	JZ	ERRM
EQUS	XCHG
	LHLD	TABA
	MOV	M,E	;<<MOD>> FOR COMS MOD
	INX	H
	MOV	M,D	;<<MOD>> FOR COMS MOD
	JMP	AOU2
RES1	CALL	ASCN
	MOV	B,H
	MOV	C,L
	JMP	RES21
	JMP	OP2
PAS2	LXI	H,OBUF
	LDA	ASPC+1
	CALL	BINH+3
	INX	H
	LDA	ASPC
	CALL	BINH+3
	SHLD	OIND
	CALL	ZBUF
	LXI	H,IBUF
	SHLD	PNTR
	MOV	A,M
	CPI	' '	;'
	JZ	OPC
	CPI	'*'
	RZ
	CALL	SLAB
	JC	ERRL
	CALL	LCHK
	JNZ	ERRL
	JMP	OPC
PSU2	LDAX	D
	ORA	A
	JZ	ORG2
	JM	DAT2
	RPO
	CPI	5
	JC	RES2
	JNZ	EASS
	CALL	TYS6
	JMP	ACO1
RES2	CALL	ASBL
	MOV	B,H
	MOV	C,L
	LHLD	BBUF+2
	DAD	B
	SHLD	BBUF+2
RES21	XRA	A
	JMP	OCN2
DAT2	CALL	TYS5
DAT21	XRA	A
	MVI	C,1
	JMP	OCN1
ORG2	CALL	ASBL
	LDA	OBUF+18
	CPI	' '	;'
	RNZ
	XCHG
	LHLD	ASPC
	XCHG
	SHLD	ASPC
	MOV	A,L
	SUB	E
	MOV	E,A
	MOV	A,H
	SBB	D
	MOV	D,A
	LHLD	BBUF+2
	DAD	D
	SHLD	BBUF+2
	RET
TYP1	CALL	AST0
	RET
TYP2	CALL	ASBL
	CNZ	ERRR
	MOV	A,L
	ORA	A
	JZ	TY31
	CPI	2
	CNZ	ERRR
	JMP	TY31
TYP3	CALL	ASBL
	CNZ	ERRR
	MOV	A,L
	RRC
	CC	ERRR
	RAL
	CPI	8
	CNC	ERRR
TY31	RLC
	RAL
	RAL
TY32	MOV	B,A
	LDAX	D
	ADD	B
	CPI	76H
	CZ	ERRR
	JMP	TYP1
TYP4	CALL	ASBL
TYP4A	CNZ	ERRR
	MOV	A,L
	CPI	8
	CNC	ERRR
	LDAX	D
	CPI	40H
	JZ	TY41
	CPI	0C7H
	MOV	A,L
	JZ	TY31
	JM	TY32
	JMP	TY31
TY41	DAD	H
	DAD	H
	DAD	H
	ADD	L
	STAX	D
	CALL	MPNT
	CALL	ASCN
	CNZ	ERRR
	MOV	A,L
	CPI	8
	CNC	ERRR
	JMP	TY32
TYP5	CPI	6
	CZ	TY56
	CALL	AST0
TYS5	CALL	ASBL
	INR	A
	CPI	2
	CNC	ERRV
	MOV	A,L
	JMP	TYP1
TY56	CALL	ASBL
	CNZ	ERRR
	MOV	A,L
	CPI	8
	CNC	ERRR
	DAD	H
	DAD	H
	DAD	H
	LDAX	D
	ADD	L
	MOV	E,A
MPNT	LHLD	PNTR
	MOV	A,M
	CPI	','
	INX	H
	SHLD	PNTR
	JNZ	ERRS
	MOV	A,E
	RET	
TYP6	CPI	1
	JNZ	TY6
	CALL	TY56
	ANI	8
	CNZ	ERRR
	MOV	A,E
	ANI	0F7H
TY6	CALL	AST0
TYS6	CALL	ASBL
	MOV	A,L
	MOV	D,H
	CALL	AST0
	MOV	A,D
	CALL	TYP1
	RET	
AST0	LHLD	BBUF+2
	MOV	M,A
	INX	H
	SHLD	BBUF+2
	LHLD	OIND
	INX	H
	INX	H
	CALL	BINH+3
	SHLD	OIND
	RET	
EASS	LDA	PASI
	ORA	A
	JNZ	EOR
	CALL	CRLF
	MVI	A,1
	JMP	ASM3
SBLK	LHLD	PNTR
SBL1	MOV	A,M
	CPI	' '	;'
	RNZ	
SBL2	INX	H
	SHLD	PNTR
	JMP	SBL1
COND	LXI	H,ABUF+1
	SHLD	HCON
	MVI	B,2
	CALL	COPC
	RET	
OTAB	DW	'OR'
	DB	'G'
	DW	0
	DW	'EQ'
	DW	'U'
	DB	1
	DW	'DB'
	DW	0
	DB	0FFH
	DW	'DS'
	DW	0
	DB	3
	DW	'DW'
	DW	0
	DB	5
	DW	'EN'
	DW	'D'
	DB	6
	DB	0
	DW	'HL'
	DB	'T'
	DB	76H
	DW	'RL'
	DB	'C'
	DB	7
	DW	'RR'
	DB	'C'
	DB	0FH
	DW	'RA'
	DB	'L'
	DB	17H
	DW	'RA'
	DB	'R'
	DB	1FH
	DW	'RE'
	DB	'T'
	DB	0C9H
	DW	'CM'
	DB	'A'
	DB	2FH
	DW	'ST'
	DB	'C'
	DB	37H
	DW	'DA'
	DB	'A'
	DB	27H
	DW	'CM'
	DB	'C'
	DB	3FH
	DW	'EI'
	DB	0
	DB	0FBH
	DW	'DI'
	DB	0
	DB	0F3H
	DW	'NO'
	DW	'P'
	DB	0
	DW	'XC'
	DW	'HG'
	DB	0EBH
	DW	'XT'
	DW	'HL'
	DB	0E3H
	DW	'SP'
	DW	'HL'
	DB	0F9H
	DW	'PC'
	DW	'HL'
	DB	0E9H
	DB	0
	DW	'ST'
	DW	'AX'
	DB	2
	DW	'LD'
	DW	'AX'
	DB	10
	DB	0
	DW	'PU'
	DW	'SH'
	DB	0C5H
	DW	'PO'
	DW	'P'
	DB	0C1H
	DW	'IN'
	DW	'X'
	DB	3
	DW	'DC'
	DW	'X'
	DB	0BH
	DW	'DA'
	DW	'D'
	DB	9
	DB	0
	DW	'IN'
	DB	'R'
	DB	4
	DW	'DC'
	DB	'R'
	DB	5
	DW	'MO'
	DB	'V'
	DB	40H
	DW	'AD'
	DB	'D'
	DB	80H
	DW	'AD'
	DB	'C'
	DB	88H
	DW	'SU'
	DB	'B'
	DB	90H
	DW	'SB'
	DB	'B'
	DB	98H
	DW	'AN'
	DB	'A'
	DB	0A0H
	DW	'XR'
	DB	'A'
	DB	0A8H
	DW	'OR'
	DB	'A'
	DB	0B0H
	DW	'CM'
	DB	'P'
	DB	0B8H
	DW	'RS'
	DB	'T'
	DB	0C7H
	DB	0
	DW	'AD'
	DB	'I'
	DB	0C6H
	DW	'AC'
	DB	'I'
	DB	0CEH
	DW	'SU'
	DB	'I'
	DB	0D6H
	DW	'SB'
	DB	'I'
	DB	0DEH
	DW	'AN'
	DB	'I'
	DB	0E6H
	DW	'XR'
	DB	'I'
	DB	0EEH
	DW	'OR'
	DB	'I'
	DB	0F6H
	DW	'CP'
	DB	'I'
	DB	0FEH
	DW	'IN'
	DB	0
	DB	0DBH
	DW	'OU'
	DB	'T'
	DB	0D3H
	DW	'MV'
	DB	'I'
	DW	6
	DW	'JM'
	DW	'P'
	DB	0C3H
	DW	'CA'
	DW	'LL'
	DB	0CDH
	DW	'LX'
	DW	'I'
	DB	1
	DW	'LD'
	DW	'A'
	DB	3AH
	DW	'ST'
	DW	'A'
	DB	32H
	DW	'SH'
	DW	'LD'
	DB	22H
	DW	'LH'
	DW	'LD'
	DB	2AH
	DB	0
*@320
	DW	'NZ'
	DB	0
	DW	'Z'
	DB	8
	DW	'NC'
	DB	10H
	DW	'C'
	DB	18H
	DW	'PO'
	DB	20H
	DW	'PE'
	DB	28H
	DB	'P'
	DB	0
	DB	30H
	DB	'M'
	DB	0
	DB	38H
	DB	0
COPC	LHLD	ADDS
	LDAX	D
	ORA	A
	JZ	COP1
	MOV	C,B
	CALL	SEAR
	LDAX	D
	RZ	
	INX	D
	JMP	COPC
COP1	INR	A
	INX	D
	RET	
OPCD	LXI	H,ABUF
	SHLD	ADDS
	LXI	D,OTAB
	MVI	B,4
	CALL	COPC
	JZ	PSEU
	DCR	B
	CALL	COPC
	JZ	OP1
	INR	B
	CALL	COPC
OP1	LXI	H,TYP1
OP2	MVI	C,1
	JZ	OCNT
	CALL	COPC
	LXI	H,TYP2
	JZ	OP2
	CALL	COPC
	LXI	H,TYP3
	JZ	OP2
	DCR	B
	CALL	COPC
	LXI	H,TYP4
	JZ	OP2
	CALL	COPC
	LXI	H,TYP5
	MVI	C,2
	JZ	OCNT
	INR	B
	CALL	COPC
	JZ	OP4
	CALL	COND
	JNZ	OERR
	ADI	0C0H
	MOV	D,A
	MVI	B,3
	LDA	ABUF
	MOV	C,A
	CPI	'R'
	MOV	A,D
	JZ	OP1
	MOV	A,C
	INR	D
	INR	D
	CPI	'J'
	JZ	OPAD
	CPI	'C'
	JNZ	OERR
	INR	D
	INR	D
OPAD	MOV	A,D
OP4	LXI	H,TYP6
OP5	MVI	C,3
OCNT	STA	TEMP
*** MODIFIED 'CHECK OPCODE LENGTH' ROUTINE
*** MOD'D BECAUSE NO '<' AND '>' FUNCTIONS
*** AVAILABLE IN THIS ASSEMBLER
	LXI	D,ABUF
	MOV	A,E
	ADD	B
	MOV	E,A
	MOV	A,D
	ACI	0
	MOV	D,A
	LDAX	D
	ORA	A
	JNZ	OERR
OCN0	LDA	PASI
OCN1	MVI	B,0
	XCHG	
OCN2	LHLD	ASPC
	DAD	B
	SHLD	ASPC
	ORA	A
	RZ	
	LDA	TEMP
	XCHG	
	PCHL	
OERR	LXI	H,ERRO
	MVI	C,3
	JMP	OCN0
PSEU	LXI	H,ABUF+4
	MOV	A,M
	ORA	A
	JNZ	OERR
	LDA	PASI
	ORA	A
	JZ	PSU1
	JMP	PSU2
SLAB	CPI	'A'
	RC	
	CPI	'Z'+1
	CMC	
	RC	
	CALL	ALPS
	LXI	H,ABUF
	SHLD	ADDS
	DCR	B
	JNZ	SLA1
	INR	B
	LXI	D,RTAB
	CALL	COPC
	JNZ	SLA1
	MOV	L,A
	MVI	H,0
	JMP	SLA2
SLA1	LDA	NOLA
	MOV	B,A
	LXI	D,SYMT	;<----- ONLY REFERENCE
	ORA	A	;..TO THE SYMBOL TABLE
	JZ	SLA3
	MVI	A,LLAB
	STA	NCHR
	CALL	COMS
SLA2	STC	
	CMC	
	RET	
SLA3	INR	A
	ORA	A
	RET	
RTAB	DB	'A'
	DB	7
	DB	'B'
	DB	0
	DB	'C'
	DB	1
	DB	'D'
	DB	2
	DB	'E'
	DB	3
	DB	'H'
	DB	4
	DB	'L'
	DB	5
	DB	'M'
	DB	6
	DB	0
ALPS	MVI	B,0
ALP1	STAX	D
	INR	B
	MOV	A,B
	CPI	0BH
	RNC
	INX	D
	INX	H
	SHLD	PNTR
	MOV	A,M
	CPI	'0'
	RC
	CPI	':'
	JC	ALP1
	CPI	'A'
	RC
	CPI	'Z'+1
	JC	ALP1
	RET
ASBL	CALL	SBLK
ASCN	LXI	H,0
	SHLD	OPRD
	INR	H
	SHLD	OPRI-1
NXT1	LHLD	PNTR
	DCX	H
	CALL	ZBUF
	STA	SIGN
NXT2	INX	H
	MOV	A,M
	CPI	' '+1
	JC	SEND
	CPI	','
	JZ	SEND
	CPI	'+'
	JZ	ASC1
	CPI	'-'
	JNZ	ASC2
	STA	SIGN
ASC1	LDA	OPRI
	CPI	2
	JZ	ERRS
	MVI	A,2
	STA	OPRI
	JMP	NXT2
ASC2	MOV	C,A
	LDA	OPRI
	ORA	A
	JZ	ERRS
	MOV	A,C
	CPI	'$'
	JNZ	ASC3
	INX	H
	SHLD	PNTR
	LHLD	ASPC
	JMP	AVAL
ASC3	CPI	''''
	JNZ	ASC5
	LXI	D,0
	MVI	C,3
ASC4	INX	H
	SHLD	PNTR
	MOV	A,M
	CPI	13
	JZ	ERRA
	CPI	''''
	JNZ	SSTR
	INX	H
	SHLD	PNTR
	MOV	A,M
	CPI	''''
	JNZ	AVAL1
SSTR	DCR	C
	JZ	ERRA
	MOV	D,E
	MOV	E,A
	JMP	ASC4
ASC5	CPI	'0'
	JC	ERRA
	CPI	'9'+1
	JNC	ALAB
	CALL	NUMS
	JC	ERRA
AVAL	XCHG
AVAL1	LHLD	OPRD
	XRA	A
	STA	OPRI
	LDA	SIGN
	ORA	A
	JNZ	ASUB
	DAD	D
ASC7	SHLD	OPRD
	JMP	NXT1
ASUB	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	JMP	ASC7
ALAB	CALL	SLAB
	JZ	AVAL
	JC	ERRA
	JMP	ERRU
SEND	LDA	OPRI
	ORA	A
	JNZ	ERRS
	LHLD	OPRD
SEN1	MOV	A,H
	LXI	D,TEMP
	ORA	A
	RET
NUMS	CALL	ALPS
	DCX	D
	LDAX	D
	LXI	B,ABUF
	CPI	'H'
	JZ	NUM2
	CPI	'D'
	JNZ	NUM1
	XRA	A
	STAX	D
NUM1	CALL	ADEC
	RET
NUM2	XRA	A
	STAX	D
	CALL	AHEX
	RET
ERRR	MVI	A,'R'
ERRR1	LXI	H,0
	STA	OBUF+18
	RET
ERRS	MVI	A,'S'
ERRS1	STA	OBUF+18
	LXI	H,0
	JMP	SEN1
ERRU	MVI	A,'U'
	JMP	ERRS1
ERRV	MVI	A,'V'
	JMP	ERRR1
ERRM	MVI	A,'M'
	STA	OBUF+18
	CALL	AOU1
	RET
ERRA	MVI	A,'A'
	JMP	ERRS1
ERRO	MVI	A,'O'
ERRO1	STA	OBUF+18
	LDA	PASI
	ORA	A
	RZ
	MVI	C,3
ERO1	XRA	A
	CALL	AST0
	DCR	C
	JNZ	ERO1
	RET
ERRL	MVI	A,'L'
	JMP	ERRO1
ERRD	MVI	A,'D'
	STA	OBUF+18
	CALL	AOU1
	JMP	OPC
PATCH	INX	H
	JNZ	MOV23
	JMP	PRET
* HEX SUBROUTINES
X1	RAR
	RAR
	RAR
	RAR
X2	ANI	0FH
	CPI	10
	JC	X2B
	ADI	7
X2B	ADI	30H
	JMP	TYPE
*---> HEX OUTPUT SUBROUTINE
XO	PUSH	6
	CALL	X1
	POP	6
	JMP	X2
*---> RENUM COMMAND
RENUM	CALL	CRLF
	LXI	H,0
	SHLD	BBUF
	SHLD	BBUF+2
	LHLD	FILE0+5
RELP	MOV	A,M
	DCR	A
	JZ	RPRT
	CALL	QCHEK	;ALLOW CTL-Q EXIT
* BUMP LINE #
	LXI	D,BBUF+1	;POINT TO 10'S DIGIT
REIN	LDAX	D
	INR	A
	STAX	D
	CPI	10
	JNZ	REEND
	XRA	A
	STAX	D
	INX	D
	JMP	REIN
REEND	LXI	D,BBUF+3
	MOV	C,M
	INX	H
	PUSH	B
	LXI	B,FILE0+9
REMVL	LDAX	D
	ORI	'0'
	MOV	M,A
	STAX	B
	INX	H
	DCX	D
	INX	B
	MOV	A,C
	CPI	0DH
	JNZ	REMVL
	POP	D
	MVI	D,0
	DAD	D
	LXI	D,-5
	DAD	D
	JMP	RELP
RPRT	LXI	B,0
	SHLD	FILE0+7
	LHLD	FILE0+5
RLOOP	MOV	A,M
	DCR	A
	JZ	RNDUN
	ORA	A
	MOV	A,C
	INR	A
	DAA
	MOV	C,A
	MOV	A,B
	ACI	0
	DAA
	MOV	B,A
	MOV	E,M
	MVI	D,0
	DAD	D
	JMP	RLOOP
RNDUN	MOV	A,B
	CALL	XO
	MOV	A,C
	CALL	XO
	LXI	H,RMSG
	JMP	LINER
RMSG	DW	' L'	;'
	DW	'IN'
	DW	'ES'
	DB	13
*---> VERIFY COMMAND
VERIF	CALL	CRLF
	LHLD	FILE0+5
V1	MVI	D,12
VLINE	MOV	A,M
	DCR	A
	JZ	VDONE
	INR	A
	MOV	B,A	;B = LINE COUNT
	CALL	QCHEK	;CHECK FOR CTL-Q
	INX	H
	DCR	B
	MVI	C,4	;LINE # COUNT
VNUM	MOV	A,M
	CPI	'9'+1
	JNC	VBAD
	CPI	'0'
	JC	VBAD
	CALL	TYPE
	INX	H
	DCR	B
	DCR	C
	JNZ	VNUM
	MVI	A,' '	;'
	CALL	TYPE
V0005	XRA	A
	ORA	B
	JP	V0010
	JMP	VBAD
V0010	MOV	A,M
	CPI	' '	;'
	JC	CHECK
	ANI	80H
	JNZ	VBAD
	INX	H
	DCR	B
	JZ	VBAD
	JMP	V0010
CHECK	CPI	13
	JNZ	VBAD
	INX	H
	DCR	B
	JNZ	VBAD
	DCR	D
	JNZ	VLINE
	CALL	RET1
	JMP	V1
VBAD	MOV	A,H
	CALL	XO
	MOV	A,L
	JMP	XO
VDONE	LXI	H,VMSG
*---> LINER - MESSAGE OUTPUT W/ C/R
LINER	CALL	SCRN	;OUTPUT TO C/R
	JMP	TYPE	;OUTPUT FINAL C/R
VMSG	DW	'A-'
	DW	'OK'
	DB	13
RET1	MVI	A,13
	JMP	TYPE
*---> PRINT COMMAND
PRINT	CALL	RET1
	LHLD	FILE0+5
PNLP	CALL	QCHEK	;ALLOW CTL-Q EXIT
	MOV	A,M
	DCR	A	;EOF?
	RZ	 	;..YES
	LXI	D,5
	DAD	D
PLOOP	MOV	A,M
	CALL	TYPE
	MOV	A,M
	INX	H
	CPI	13
	JNZ	PLOOP
	JMP	PNLP
*---> HEX OUTPUT W/BLANK
XOB	CALL	XO
	MVI	A,' '	;'
	JMP	TYPE
*---> OBJECT SAVE ROUTINE TO TARBELL
OSAVE	CALL	RET1
	CALL	TINTO
	LHLD	BBUF+2
	INX	H
	XCHG
	LHLD	BBUF
	MVI	B,0	;CKSUM
* OUTPUT START, END ADDRESS
	MOV	A,H
	CALL	TPOTC
	MOV	A,L
	CALL	TPOTC
	MOV	A,D
	CALL	TPOTC
	MOV	A,E
	CALL	TPOTC
OSLP	MOV	A,M
	CALL	TPOTC
	INX	H
	CALL	QDEHL
	JNZ	OSLP
	MOV	A,B
	CALL	TPOUT	;CKSUM
	RET
*---> TARBELL OBJECT LOAD
OLOAD	CALL	RET1
	CALL	TINTI
	MVI	B,0	;CKSUM
	LDA	IBUF+5
	CPI	'N'
	JZ	OLNO
	CALL	TPINC
	MOV	H,A
	CALL	XO
	CALL	TPINC
	MOV	L,A
	CALL	XOB
	CALL	TPINC
	MOV	D,A
	CALL	XO
	CALL	TPINC
	MOV	E,A
	CALL	XO
	JMP	OLCON
OLNO	LHLD	BBUF
	LXI	D,-1
OLCON	PUSH	H	;PGM START
OLRD	CALL	TPINC
	MOV	M,A
	INX	H
	CALL	QDEHL
	JNZ	OLRD
	CALL	TPIN	;CKSUM
	XRA	B
	JNZ	BADCS
	LDA	IBUF+5
	CPI	'X'
	RZ
	POP	H
	RET
BADCS	LXI	H,CSMSG
	CALL	LINER
	POP	H
	RET
CSMSG	DW	'CK'
	DW	'SU'
	DB	'M'
	DB	13
QDEHL	MOV	A,H
	CMP	D
	RNZ
	MOV	A,L
	CMP	E
	RET
*---> TARBELL SOURCE SAVE ROUTINE
SSAVE	CALL	RET1
	CALL	TINTO
	LHLD	FILE0+5
	MVI	B,0	;CKSUM
SSLIN	CALL	SET1	;CURSOR
	MOV	A,M
	CALL	TPOTC
	INX	H
	DCR	A
	JNZ	SSLP
	MOV	A,B
	CALL	TPOUT
	RET
SSLP	MOV	A,M
	CALL	TPOTC
	CALL	DSPLY
	MOV	A,M
	INX	H
	CPI	13
	JZ	SSLIN
	JMP	SSLP
*---> TARBELL SOURCE LOAD ROUTINE
SLOAD	CALL	RET1
	CALL	TINTI
	LHLD	FILE0+5
	MVI	B,0
SLINE	CALL	SET1	;CURSOR
	CALL	TPINC
	MOV	M,A
	DCR	A
	JNZ	SLP0
	SHLD	FILE0+7
	CALL	TPIN
	PUSH	H
	XRA	B
	JNZ	BADCS
	POP	H
	LHLD	BBUF	;START OF LAST LINE
	LXI	D,FILE0+9	;HI LINE # ADDR
	MVI	C,4
SMOVE	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	SMOVE
	RET
SLP0	INX	H
	SHLD	BBUF
SLLP	CALL	TPINC
	MOV	M,A
	CALL	DSPLY
	MOV	A,M
	INX	H
	CPI	13
	JZ	SLINE
	JMP	SLLP
*---> SET - SET CURSOR SO NO SCROLL
SET1	LDA	CURS+1	;GET PAGE
	ANI	VDMEP-1	;ENSURE
	ORI	VDMEP-4	;..ON VDM
	STA	CURS+1	;STORE BACK
	CPI	VDMEP-1	;BOTTOM LINE?
	RC	 	;NO
	MVI	A,VDMEP-4
	STA	CURS+1	;BACK TO VDM TOP
	RET
* * * * * COMMAND TABLE * * * * *
CTAB	DB	'D'
	DB	'U'
	DB	'M'
	DB	'P'
	DW	DUMP
	DB	'E'
	DB	'N'
	DB	'T'
	DB	'R'
	DW	ENTR
	DB	'E'
	DB	'X'
	DB	'E'
	DB	'C'
	DW	EXEC
	DB	'F'
	DB	'I'
	DB	'L'
	DB	'E'
	DW	FILE
	DB	'L'
	DB	'I'
	DB	'S'
	DB	'T'
	DW	LIST
	DB	'D'
	DB	'E'
	DB	'L'
	DB	'T'
	DW	DELT
	DB	'A'
	DB	'S'
	DB	'S'
	DB	'M'
	DW	ASSM
	DB	'P'
	DB	'A'
	DB	'G'
	DB	'E'
	DW	PAGE
	DB	'R'
	DB	'E'
	DB	'N'
	DB	'U'
	DW	RENUM
	DB	'S'
	DB	'L'
	DB	'O'
	DB	'A'
	DW	SLOAD
	DB	'S'
	DB	'S'
	DB	'A'
	DB	'V'
	DW	SSAVE
	DB	'O'
	DB	'L'
	DB	'O'
	DB	'A'
	DW	OLOAD
	DB	'O'
	DB	'S'
	DB	'A'
	DB	'V'
	DW	OSAVE
	DB	'R'
	DB	'E'
	DB	'N'
	DB	'U'
	DW	RENUM
	DB	'V'
	DB	'E'
	DB	'R'
	DB	'I'
	DW	VERIF
	DB	'P'
	DB	'R'
	DB	'I'
	DB	'N'
	DW	PRINT
	DB	'I'
	DB	'O'
	DB	'B'
	DB	'Y'
	DW	SETIO	;SET I/O BYTE
	DB	'O'
	DB	'U'
	DB	'T'
	DB	' '	;'
	DW	OUTPU
* * * * * * * * * * * * * * * *
* ADD YOUR OWN COMMANDS HERE  *
* * * * * * * * * * * * * * * *
* JUST PUT IN A 4 BYTE ASCII  *
* COMMAND, FOLLOWED BY IT'S 2 *
* BYTE ADDRESS, WITH THE LOW  *
* BYTE OF THE ADDRESS FIRST,  *
* THEN THE HIGH BYTE.  BE SURE*
* THE NUMBER OF COMMANDS IN   *
* THE 'COMM' ROUTINE STATEMENT*
* 'MVI A,NCOM' IS BIG ENOUGH  *
* FOR ALL THE COMMANDS YOU    *
* HAVE.                       *
* * * * * * * * * * * * * * * *
*@3C0
* PROCESSOR TECH WORK AREA
	ORG	WORKA	;TO WORK AREA
LLAB	EQU	5	;LABEL LENGTH
NL	EQU	5
NMLEN	EQU	5
MAXFL	EQU	6	;MAX NUMBER OF FILES
FILE0	DS	NMLEN	;FILE NAME
BOFP	DS	2	;BEGIN. OF FILE POINTER
EOFP	DS	2	;END OF FILE POINTER
MAXL	DS	4	;MAX LINE NUMBER
FILTB	DS	40+NL+NL+NL+NL+NL	;5 MORE FILES
INSP	DS	2	;ISRT LINE POSITION
DELP	EQU	INSP	;DELT LINE POSITION
APNT	EQU	INSP	;ASSEMBLE LINE POINTER
ASCR	EQU	13	;ASCII C/R
HCON	DS	2	;HEX BYTE WORK AREA
ADDS	EQU	HCON	;FIND ADDRESS
FBUF	DS	NMLEN	;FILE NAME BUFFER
FREAD	DS	2	;FREE ADDR IN DIRECTORY
FEF	DS	1	;FREE ENTRY FOUND FLAG
FOCNT	EQU	FEF	;OUTPUT COUNTER
ABUF	DS	12	;ASCII BUFFER
BBUF	DS	4	;BINARY BUFFER
SCNT	DS	1
AERR	EQU	SCNT	;ASSM ERR PRT SWITCH
DCNT	DS	1	;DUMP ROUTINE COUNTER
NCOM	EQU	20	;NUMBER OF COMMANDS
TABA	DS	2	;SYMBOL TABLE END ADDR
ASPC	DS	2	;ASSEMBLER PROGRAM COUNTER
PASI	DS	1	;ASSEMBLER PASS INDICATOR
NCHR	DS	1	;LENGTH OF STR FOR COMPARE
PNTR	DS	2	;LINE POINTER
NOLA	DS	1	;NUMBER OF LABLES
SIGN	DS	1	;SIGN STORAGE FOR SCAN
OPRD	DS	2	;OPERAND STORAGE
OPRI	DS	1	;OPERAND FOUND INDICATOR
TEMP	DS	1
OIND	DS	2	;OUTPUT ADDRESS
AREA	DS	18	;STACK POINTER AREA
OBUF	DS	25	;HEX ASM OBJECT OUTPUT
	DS	5	;LINE # GOES HERE
IBUF	DS	83	;INPUT BUFFER
SYMT	EQU	$	;START OF SYMBOL TABLE
	END