TITLE COMMAND SUBSYSTEM FOR SYSTEM MONITOR * Release A
;  *******Donated to the Pascal/Z Users Group,July 1980********
;       SYSTEM MONITOR COMMAND SUBSYSTEM * Release A
;	MODULE ONE
;
;	BASE ADDRESSES
;
;CBASE	CONSOLE SUBSYSTEM BASE
;TBASE	CASSETTE SUBSYSTEM BASE
;DBASE	DISK SUBSYSTEM BASE
;VBASE	INTEL I/O VECTOR SUBSYS BASE
;WBASE	MONITOR WORK SPACE
;SBASE	MONITOR STACK SPACE
;
;
;	LINKAGES TO CONSOLE SUBSYSTEM
;
CINITL	DEFL	CBASE
STATUS	DEFL	CBASE+3
SKEY	DEFL	CBASE+6
UKEY	DEFL	CBASE+9
LPOUT	DEFL	CBASE+0CH
BUFFIN	DEFL	CBASE+0FH
BUILD	DEFL	CBASE+12H
VADDR	DEFL	CBASE+15H
SVIDEO	DEFL	CBASE+18H
PVIDEO	DEFL	CBASE+1BH
VIDOUT	DEFL	CBASE+1EH
VIDPRO	DEFL	CBASE+21H
;
;	LINKAGES TO CASSETTE SUBSYSTEM
;
TINITL	DEFL	TBASE
ZSAVE	DEFL	TBASE+3
ZLOAD	DEFL	TBASE+6
SWRITE	DEFL	TBASE+9
SREAD	DEFL	TBASE+0CH
;
;	LINKAGES TO DISK SUBSYSTEM
;
DINITL	DEFL	DBASE		;INITIALIZE
DISK1	DEFL	DBASE+03	;MAIN ENTRY POINT
;
;	DEFINE ALL THE INTERNAL SYMBOLS
;
;	ASCII SYMBOLS
;
NULL	DEFL	00H
EOM	DEFL	00H
CLT	DEFL	1CH
CRT	DEFL	1EH
CDN	DEFL	1FH
CUP	DEFL	1DH
HOME	DEFL	0BH
CLEAR	DEFL	0CH
BOTTOM	DEFL	03H
REPT	DEFL	12H
CR	DEFL	0DH
LF	DEFL	0AH
COFF	DEFL	0FH
CON	DEFL	0EH
HTAB	DEFL	09H
ESC	DEFL	1BH
LINS	DEFL	04H
DEL	DEFL	7FH
SPACE	DEFL	20H
MINUS	DEFL	2DH
DOT	DEFL	2EH
QUOTE	DEFL	27H
PAGE	DEFL	11H
SCROLL	DEFL	17H
STX	DEFL	01H
REV	DEFL	05H
DIR	DEFL	16H
PROMP	DEFL	'>'
PTGL	DEFL	10H
;
;MONITOR WORK SPACE INDEX ADDRESS LOCATIONS
;	THE MONITOR OBTAINS THE ADDRESS STORED AT
;	[WORK] AND LOADS IT INTO THE [IY] REG
;	THERE AFTER THE MONITOR WILL ACCESS THE WORK
;	SPACE INDIRECTLY THROUGH THE [IY] REG
;
;	THE WORK SPACE IS DEFINED AS FOLLOWS:
;	IY-4DH		IOBYTE ALLOCATION FLAG
;	IY-4CH		DATA BLOCK TABLE, TEN BLOCKS
;			K   - DELIMITER CHAR
;			K+1 - LSB BLOCK ADDRESS
;			K+2 - MSB BLOCK ADDRESS
;			K+3 - NO OF BYTES IN BLOCK
;	IY-0CH		DECODED ADDRESS ONE
;	IY-OAH		   "	      "	 TWO
;	IY-08H		   "	      "	 THREE
;	IY-06H		NUMBER OF ADDRESSES DECODED
;	IY-05H		BLOCK POINTER (BLK NO)
;	IY-04H		NUMBER OF BLOCKS DEBLOCKED IN BUFFER
;	IY-03H		NUMBER OF SIGNIFICANT BYTES IN BUFFER
;	IY-02H		ADDRESS OF FIRST SIGNIFICANT BYTE IN
;			BUFFER (FIRST NUN-SPACE ASCII CHAR)
;	IY-00H		STARTING POINT OF BUFFER (80H BYTES)
;
;START OF MONITOR CODE
;
MBASE	EQU	$
;
;	EXTERNAL ENTRY VECTORS
;
MNTRY0	JP	START	;COLD START OF MONITOR
MNTRY1	JP	RESTRT	;WARM START OF MONITOR
MNTRY2	JP	FMEM	;MEMORY TEST
;
;	ADDRESS DEFINITIONS
;
WORK	DEFW	WBASE
STACK	DEFW	SBASE
;
;
;	MAIN COMMAND JUMP TABLE
;
MJUMP	DEFW	ASSIGN	;A
	DEFW	LOCKUP	;B
	DEFW	COPY	;C
	DEFW	DSPLAY	;D
	DEFW	ENTER	;E
	DEFW	FILL	;F
	DEFW	GOTO	;G
	DEFW	HEX	;H
	DEFW	INPUT	;I
	DEFW	JUMP	;J
	DEFW	NAVAIL	;K
	DEFW	LIST	;L
	DEFW	MOVE	;M
	DEFW	NAVAIL	;N
	DEFW	OUTPUT	;O
	DEFW	PROGRM	;P
	DEFW	NAVAIL	;Q
	DEFW	READ	;R
	DEFW	SEARCH	;S
	DEFW	TEST	;T
	DEFW	NAVAIL	;U
	DEFW	VERIFY	;V
	DEFW	WRITE	;W
	DEFW	NAVAIL	;X
	DEFW	NAVAIL	;Y
	DEFW	NAVAIL	;Z
;
;	COPY COMMAND JUMP TABLE
;
CJUMP	DEFW	CPM	;TT
	DEFW	CPM	;TD
	DEFW	READ	;TM
	DEFW	CPM	;TP
	DEFW	CPM	;TC
	DEFW	CPM	;TU
	DEFW	CPM	;DT
	DEFW	CPM	;DD
	DEFW	CPM	;DM
	DEFW	CPM	;DP
	DEFW	CPM	;DC
	DEFW	CPM	;DU
	DEFW	WRITE	;MT
	DEFW	CPM	;MD
	DEFW	MOVE	;MM
	DEFW	LIST	;MP
	DEFW	DSPLAY	;MC
	DEFW	CPM	;MU
	DEFW	CPM	;PT
	DEFW	CPM	;PD
	DEFW	CPM	;PM
	DEFW	CPM	;PP
	DEFW	CPM	;PC
	DEFW	CPM	;PU
	DEFW	CPM	;CT
	DEFW	CPM	;CD
	DEFW	ENTER	;CM
	DEFW	CPM	;CP
	DEFW	CPM	;CC
	DEFW	CPM	;CU
	DEFW	CPM	;UT
	DEFW	CPM	;UD
	DEFW	CPM	;UM
	DEFW	CPM	;UP
	DEFW	CPM	;UC
	DEFW	CPM	;UU
;
;	VERIFY COMMAND JUMP TABLE
;
VJUMP	DEFW	CPM	;TT
	DEFW	CPM	;TD
	DEFW	CPM	;TM
	DEFW	CPM	;TU
	DEFW	CPM	;DT
	DEFW	CPM	;DD
	DEFW	CPM	;DM
	DEFW	CPM	;DU
	DEFW	CPM	;MT
	DEFW	CPM	;MD
	DEFW	VMOVE	;MM
	DEFW	CPM	;MU
	DEFW	CPM	;UT
	DEFW	CPM	;UD
	DEFW	CPM	;UM
	DEFW	CPM	;UU
;
;	MAIN ENTRIES INTO THE MONITOR
;
START	SUB	A
	JP	INIT
ST1	CALL	CINITL	;INITIALIZE CONSOLE
	CALL	TINITL	;INITIALIZE CASSETTE
	CALL	DINITL	;INITIALIZE DISK
	LD	A,69H
	LD	(IY-4DH),A
	LD	HL,SMESS1
	CALL	VIDPRO
	JR	COMM
RESTRT	LD	A,1
	JP	INIT
ST2	LD	HL,SMESS2
	CALL	VIDPRO
COMM	LD	HL,SMESS3
	CALL	VIDPRO
RECOMM	CALL	BUILD
	LD	A,(IY-3);NULL COMMAND FIELD?
	OR	A
	JR	Z,COMM
	CALL	REDUCE
	CALL	DBLOCK
	LD	A,1
	CALL	SETDBA	;SET TO BLOCK 1
	LD	A,(IX+3)	;GET BLK SIZE
	OR	A
	JP	Z,ERR01	  ;IF BLK SIZE ZERO
	CALL	HLIX	;GET STARTING ADDR OF BLK
	LD	A,(HL)	;GET FIRST BYTE OF BLOCK
	JR	MVECT
INIT	LD	SP,(STACK)
	LD	IY,(WORK)
	OR	A
	JP	Z,ST1
	JP	ST2
;
;	MAIN VECTOR ROUTINE
;	A REG CONTAINS ALPHA
;
MVECT	SUB	'A'
	JP	C,ERR01
	CP	26
	JP	NC,ERR01
	LD	HL,MJUMP
	ADD	A,A
	ADD	A,L
	LD	L,A
	JR	NC,VECTOR
	INC	H
VECTOR	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	JP	(HL)
;
;	COPY AND VERIFY VECTOR 
;	SOURCE BYTE IN D REG
;	DEST  BYTE IN E REG
;	UPON ENTRY AND EXIT
;
COPY	CALL	GETSD
	JP	C,ERR02
	JP	Z,MOVE
	JR	CVECT
VERIFY	CALL	GETSD
	JP	C,ERR02
	JP	Z,VMOVE
	JR	VVECT
GETSD	CALL	GETOPT
	RET C
	LD	D,(HL)
	INC	HL
	LD	E,(HL)
	CP	SPACE
	RET
	SCF
	RET
CVECT	LD	HL,CJUMP
	SUB	A
	PUSH	AF
	PUSH	DE
	PUSH	HL
	LD	HL,CTBLE
	LD	BC,6
	JR	CVJUMP
VVECT	LD	HL,VJUMP
	LD	A,01
	PUSH	AF
	PUSH	DE
	PUSH	HL
	LD	HL,VTBLE
	LD	BC,4
	LD	A,01H
CVJUMP	PUSH	BC
	PUSH	HL
	LD	A,E
	CPIR
	JR	NZ,CV1
	LD	E,C
	POP	HL
	POP	BC
	PUSH	BC
	LD	A,D
	CPIR
	JR	NZ,CV1+1
	POP	HL
	ADD	HL,HL
	LD	B,C
	CALL	CV2
	LD	C,A
	LD	B,E
	LD	L,2
	CALL	CV2
	ADD	A,C
	LD	C,A
	POP	HL
	ADD	HL,BC
	POP	BC
	POP	AF
	JP	VECTOR
CV1	POP	HL
	POP	HL
	POP	HL
	POP	HL
	POP	HL
	JP	ERR02
CV2	SUB	A
	INC	B
	JR	CV4
CV3	ADD	A,L
CV4	DJNZ	CV3
	RET
;
;	REDUCE LOW CASE ALPHA TO CAPS AND MASK OFF
;	MSB OF BYTE TO OVERRIDE REVERSE VIDEO
;
REDUCE	LD	L,(IY-2)
	LD	H,(IY-1)
	LD	A,(IY-3)
	OR	A
	RET	Z
	LD	B,A
RED1	LD	A,(HL)
	AND	7FH
	CP	61H
	JR	C,RED2
	CP	0FBH
	JR	NC,RED2
	SUB	20H
RED2	LD	(HL),A
	INC	HL
	DJNZ	RED1
	RET
;
;	DEBLOCKING ROUTINE ... THIS ROUTINE DETERMINES THE
;	STARTING ADDRESS OF EACH SIGNIFICANT BLOCK DEFINED
;	BY THE DELIMITERS  [^.,;:-+*/=] WHERE ^ IS A BLANK
;
DBLOCK	LD	A,1
	CALL	SETDBA
	LD	L,(IY-02H)
	LD	H,(IY-01H)
	CALL	IXHL
	LD	(IX),NULL
	LD	A,(IY-3)	;LD NO OF BYTES IN BUFFER
	LD	B,A
	OR	A
	JR	Z,DB3+1
	LD	DE,1	;LOAD COUNTERS
DB1	LD	C,(HL)
	LD	A,C
	CALL	DELCK
	JR	NZ,DB2
	LD	(IX+3),D
	LD	A,10
	SUB	E
	JR	Z,DB3
	LD	D,00H
	LD	(IX+4),C
	INC	E
	INC	HL
	LD	(IX+5),L
	LD	(IX+6),H
	CALL	INCDBA
	JR	DB2A
DB2	INC	D
	INC	HL
DB2A	DJNZ	DB1
	LD	(IX+3),D
DB3	LD	A,E
	LD	(IY-04H),A
	RET
;
;	CHECK BUFFER BYTE FOR DELIMITER.
;
DELCK	PUSH	HL
	PUSH	BC
	LD	HL,DELCHR
	LD	BC,10
	CPIR
	POP	BC
	POP	HL
	RET
;
;	GET OPTION IF THERE IS ANY
;		CARRY SET - ERROR STATE .. EOF
;		ZERO  SET - OPTION FOUND
;		ZERO  CLR - NO OPTION
;
GETOPT	LD	A,(IY-04H)
	CP	2
	RET C
	LD	A,(IX+4)
	CP	DOT
	JR	NZ,GET1
	CALL	INCDBA
	CALL	HLIX
	LD	A,(HL)
	JR	GET2
GET1	LD	A,SPACE
GET2	OR	A
	RET
;
;	DECODE THE ADDRESSES ON THE BUFFER
;	Error state is flagged by carry-flag-set.
;	Up to three addresses are decoded. These are 
;	saved in ADDR1,ADDR2,and ADDR3. Number
;	of addresses decoded is saved in NADDR.
;	Expected format:
;		   [ ADDR1-ADDR2-ADDR3]
;
GETADD	CALL	INCDBA
	LD	A,00H
	RET C			;IF ZERO BLOCKS
	LD	(IY-06H),A
	LD	A,(IX)
	CP	SPACE
	JR	NZ,GA2		 ;FIRST DELIMITER NOT A SPACE
	CALL	DCDAD2
	RET C			;IF DECODING ERR
	LD	(IY-0CH),E	;SAVE ADDR 1
	LD	(IY-0BH),D
	LD	A,1
	LD	(IY-06H),A
	CALL	NXADD		;GET NEXT ADDR
	RET C			;IF DECODING ERR
	JR	NZ,GA1		 ;IF NO MORE ADDR
	LD	(IY-0AH),E
	LD	(IY-09H),D
	LD	A,2
	LD	(IY-06H),A
	CALL	NXADD		;GET NEXT ADDR
	RET C			;IF ERR
	JR	NZ,GA1		 ;IF NO MORE ADDR
	LD	(IY-08H),E
	LD	(IY-07H),D
	LD	A,3
	LD	(IY-06H),A
GA1	OR	A
	RET
GA2	SCF
	RET
;
NXADD	CALL	INCDBA	;INC TO NEXT BLK
	JR	NC,NXA1
NXA0	SUB	A
	INC	A
	RET
NXA1	LD	A,(IX)		;GET DELIMITER
	CP	MINUS		;MUST HAVE A - DELIM
	JR	NZ,NXA0
	CALL	DCDAD1
	RET C			;IF ERR
	SUB	A
	RET
INCDBA	INC	IX
	INC	IX
	INC	IX
	INC	IX
	LD	A,(IY-05H)
	INC	A
	LD	(IY-05H),A
IDBA1	PUSH	BC
	LD	C,A
	LD	A,(IY-04H)
	SUB	C
	POP	BC
	RET
CKBLK	LD	A,(IY-05H)
	JR	IDBA1
;
SETDBA	PUSH	IY
	POP	BC
	LD	IX,0FFB4H
	ADD	IX,BC
	LD	(IY-05H),A
	DEC	A
	ADD	A,A
	ADD	A,A
	LD	C,A
	LD	B,0
	ADD	IX,BC
	RET
;
;	LOAD HL WITH (IX+1)
;
HLIX	LD	L,(IX+1)
	LD	H,(IX+2)
	RET
;
;	LOAD (IX+1) WITH HL
;
IXHL	LD	(IX+1),L
	LD	(IX+2),H
	RET
;
;	LOAD ADDRESSES INTO HL
;
HLAD1	LD	L,(IY-0CH)
	LD	H,(IY-0BH)
	RET
HLAD2	LD	L,(IY-0AH)
	LD	H,(IY-09H)
	RET
HLAD3	LD	L,(IY-08H)
	LD	H,(IY-07H)
	RET
;
;	DECODE ADDRESSES FROM HEX
;
DCDAD1	LD	DE,0FFFFH
	JR	DCD1
DCDAD2	LD	DE,0000H
DCD1	LD	A,(IX+3)
	OR	A
	JR	NZ,DCD2
	SUB	A
	RET
DCD2	LD	DE,0
	CALL	HLIX
	LD	B,A
;
DHADD	EX	DE,HL
	LD	HL,0
DHA1	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	LD	A,(DE)
	CALL	VHEX
	JR	C,DHA2
	ADD	A,L
	LD	L,A
	INC	DE
	DJNZ	DHA1
DHA2	EX	DE,HL
	RET
;
;	VERIFY HEX CHARACTER
;
VHEX	SUB	'0'
	RET C
	CP	0AH
	JR	NC,VHX1
	CCF
	RET
VHX1	SUB	7
	CP	0AH
	RET C
	CP	10H
	CCF
	RET
;
;	ESCAPE KEY CHECK
;
ESCAPE	CALL	UKEY
	CP	ESC
	JR	Z,ESCP1
	OR	A
	RET
ESCP1	SCF
	RET
;
;	GET TWO ADDRESSES, CALC NO. OF BYTES,
;	PUT NO. BYTES IN REG DE, STARTING ADD IN REG HL
;	ERROR RETURNS: CARRY-SET - HEXIDEC ERROR
;		       ZERO - REV ADD
;
GET2AD	CALL	GETADD
	JR	C,GERR
	LD	A,(IY-06H)
	CP	2
	JR	C,GERR
CALCAD	CALL	HLAD1
	EX	DE,HL
	CALL	HLAD2
	SBC	HL,DE
	JR	C,CLC1
	EX	DE,HL
	INC	DE
	RET
CLC1	POP	HL
	JP	ERR04
GERR	POP	HL
	JP	ERR03
;
;	UPDATE COUNTERS HL AND DE  AND TEST DE FOR ZERO
;
UPDATE	INC	HL
	DEC	DE
	LD	A,D
	OR	E
	RET
;
;	OUTPUT 8 HEX BYTES
;	...CARRY SET IF MORE BYTES ON QUEY
;
OUT8HB	LD	B,8
	PUSH	BC
	LD	A,(HL)
	CALL	OUTHBT
	CALL	OUTSPC
	POP	BC
	CALL	UPDATE
	RET Z
	DJNZ	OUT8HB+2
	SCF
	RET
;
;	OUTPUT 8 ASCII BYTES, CNTL CHARACTERS
;	ARE OUTPUTTED AS PERIODS
;
OUT8AB	LD	B,8
	LD	C,(HL)
	CALL	BTASC
	CALL	VIDOUT
	CALL	UPDATE
	RET Z
	DJNZ	OUT8AB+2
	SCF
	RET
;
;	CONVERT BYTE TO HEX CHARACTERS
;	EXPECT BYTE TO BE IN A REG
;	RESULT IS IN C AND A REG
;	C  -	MOST SIG NYBBLE
;	A  -	LEAST SIG NYBBLE
;
BTHEX	PUSH	AF
	AND	0F0H
	RRCA
	RRCA
	RRCA
	RRCA
	CALL	BT1
	LD	C,A
	POP	AF
	AND	0FH
BT1	ADD	A,90H
	DAA
	ADC	A,40H
	DAA
	RET
;
;	CONVERT ASCII CONTROL CHARACTERS TO PERIODS
;
BTASC	LD	A,C
	AND	7FH
	CP	20H
	JR	C,BTA1
	CP	DEL
	JR	Z,BTA1
	CP	5FH
	JR	Z,BTA1
	RET
BTA1	CP	80H
	JR	NC,BTA2
	LD	C,'.'
	RET
BTA2	LD	C,'.'+80H
	RET
;OUTPUT HEX ADDR RESIDING IN HL REG
;
OUTHAD	LD	A,H
	CALL	OUTHBT
	LD	A,L
OUTHBT	CALL	BTHEX
	PUSH	AF
	CALL	VIDOUT
	POP	AF
	LD	C,A
OUTB	JP	VIDOUT
;
;	OUTPUT [.],[-],[ ],[CRLF],[CRLF>],[   ]
;
OUTDOT	LD	C,'.'
	JR	OUTB
OUTSPC	LD	C,' '
	JR	OUTB
OUTDSH	LD	C,'-'
	JR	OUTB
OUTEXP	LD	C,'!'
	JR	OUTB
CRLF	LD	C,CR
	CALL	VIDOUT
	LD	C,LF
	JR	OUTB
CRLFP	CALL	CRLF
	LD	C,PROMP
	JR	OUTB
OUT3SP	CALL	OUTSPC
	CALL	VIDOUT
	JP	VIDOUT
	DEFB	NULL