*DISK UTILITY -	By Ward Christensen

*		EQUATES			*

*	BASIC DISK OPERATING SYSTEM CALLS FOR CP/M 2.2		*

BDOS	EQU	0005	;STANDARD DISPATCH ENTRY ADDRESS.
FCB	EQU	5CH	;STANDARD FILE CONTROL BLOCK ADDRESS.
DMADDR	EQU	80H	;DEFAULT DISK/MEMORY ADDRESS.
TPA	EQU	100H	;TRANSIENT PROGRAM AREA.

WBOOT	EQU	0	;SYSTEM RESET.
CONIN	EQU	1	;CONSOLE INPUT.
CONOUT	EQU	2	;CONSOLE OUTPUT.
READER	EQU	3	;READER INPUT.
PUNCH	EQU	4	;PUNCH OUTPUT.
LIST	EQU	5	;LIST OUTPUT.
DCONIO	EQU	6	;DIRECT CONSOLE I/O.
GETIOB	EQU	7	;GET I/O BYTE.
SETIOB	EQU	8	;SET I/O BYTE.
PSTRNG	EQU	9	;PRINT STRING.
RCONBUF	EQU	10	;READ CONSOLE BUFFER.
CONSTAT	EQU	11	;GET CONSOLE STATUS.
GETVERS	EQU	12	;GET VERSION NUMBER.
RESDSK	EQU	13	;RESET DISK SYSTEM.
SELDSK	EQU	14	;SELECT DISK.
OPEN	EQU	15	;OPEN FILE.
CLOSE	EQU	16	;CLOSE FILE.
SRCH1ST	EQU	17	;SEARCH FOR FIRST.
SRCHNXT	EQU	18	;SEARCH FOR NEXT.
DELFIL	EQU	19	;DELETE FILE.
READSEQ	EQU	20	;READ SEQUENTIAL.
WRTSEQ	EQU	21	;WRITE SEQUENTIAL.
MAKEFIL	EQU	22	;MAKE FILE.
RENAME	EQU	23	;RENAME FILE.
LOGINV	EQU	24	;RETURN LOGIN VECTOR.
CURDSK	EQU	25	;RETURN CURRENT DISK.
SETDMA	EQU	26	;SET DISK/MEMORY ADDRESS.
GETADDR	EQU	27	;GET ADDRESS (ALLOCATION).
WRTPROT	EQU	28	;WRITE PROTECT DISK.
GETROV	EQU	29	;GET R/O VECTOR.
SETATRB	EQU	30	;SET FILE ATTRIBUTES.
GETPARM	EQU	31	;GET ADDRESS (DISK PARAMETERS).
USERCOD	EQU	32	;GET/SET USER CODE.
READRAN	EQU	33	;READ RANDOM.
WRTRAN	EQU	34	;WRITE RANDOM.
FILSIZ	EQU	35	;COMPUTE FILE SIZE.
SETRREC	EQU	36	;SET RANDOM RECORD.

CR	EQU	0DH	;CARRIAGE RETURN.
LF	EQU	0AH	;LINE FEED.
TAB	EQU	9
BELL	EQU	7
ASTRSK	EQU	2AH	;ASTERISK (*).

*	END OF EQUATES		*

*******************************

	ORG	TPA
	LXI	SP,STACK	;EXITS VIA JMP 0

*		SET UP LOCAL JMPS TO BIOS

	LHLD	1	;WARM BOOT POINTER
	LXI	D,3
	DAD	D	
	SHLD	VCONST+1
	DAD	D
	SHLD	VCINP+1
	DAD	D
	SHLD	VCONOUT+1
	DAD	D	;PRINT
	SHLD	VPRINT+1
	DAD	D	;PUNCH
	DAD	D	;RDR
	DAD	D
	SHLD	VHOME+1
	DAD	D	;SEL DISK
	DAD	D
	SHLD	VSETTRK+1
	DAD	D
	SHLD	VSETSEC+1
	DAD	D
	SHLD	VSETDMA+1
	DAD	D
	SHLD	VREAD+1
	DAD	D
	SHLD	VWRITE+1
	CALL	ILPRT
	DB	'DISK UTILITY (DU) V3.0 01/07/80',CR,LF
	DB	CR,LF,'Type ? for help'
	DB	CR,LF,'Type X to exit'
	DB	CR,LF,0
	LXI	H,DMADDR	;TO INPUT BUFF
	MOV	A,M
	ORA	A
	JZ	PROMPTR		;NO COMMAND

*GOT INITIAL COMMAND, SET IT UP

	MOV	B,A	;SAVE LENGTH
	DCR	B
	JZ	PROMPTR
	LXI	D,INBUF
	INX	H	;SKIP LEN
	INX	H	;SKIP ' '
	CALL	MOVE
	MVI	A,CR
	STAX	D
	LXI	H,INBUF
	JMP	PROMPTI

PROMPTR	CALL	RDBUF
PROMPTI	MVI	A,255
	STA	TOGO	;LOOP COUNT FOR "/"
PROMPT	LXI	SP,STACK
	XRA	A	;ZERO 2-UP PRINT
	STA	TWOUP	;..SWITCH
	MVI	A,1
	STA	FTSW	;TELL SEARCH NOT TO INCR
	PUSH	H
	LXI	H,100H
	SHLD	BUFAD	;FOR RDBYTE
	POP	H
	CALL	CTLCS	;ABORT?
	JZ	PROMPTR	;..YES, READ BUFFER
*DO WE HAVE TO POSITION IN DIRECTORY AFTER FIND?
	LDA	FINDFLG
	ORA	A
	JNZ	POSDIR	;POSITION IN DIRECTORY
	MOV	A,M
	CPI	CR
	JZ	PROMPTR
	CPI	';'	;LOGICAL CR?
	INX	H
	JZ	PROMPT
	CALL	UPCASE
	STA	DUMTYPE	;TYPE OF DUMP (A,D,H)
	CPI	'+'	! JZ PLUS
	CPI	'-'	! JZ MINUS
	CPI	'='	! JZ SEARCH
	CPI	'<'	! JZ SAVE
	CPI	'>'	! JZ RESTORE
	CPI	'?'	! JZ HELP
	CPI	'A'	! JZ DUMP
	CPI	'C'	! JZ CHG
	CPI	'D'	! JZ DUMP
	CPI	'F'	! JZ POSFIL
	CPI	'G'	! JZ POS
	CPI	'H'	! JZ DUMP
	CPI	'L'	! JZ LOGIN
	CPI	'M'	! JZ MAP
	CPI	'P'	! JZ PRINTFF
	CPI	'R'	! JZ DOREAD
	CPI	'S'	! JZ POS
	CPI	'T'	! JZ POS
	CPI	'V'	! JZ VIEW
	CPI	'W'	! JZ DOWRITE
	CPI	'X'	! JZ 0
	CPI	'Z'	! JZ SLEEP
	CPI	'/'	! JZ REPEAT

WHAT	CALL	ILPRT
	DB	'?',0
	JMP	PROMPTR

*REPEAT BUFFER CONTENTS

REPEAT	CALL	DECIN	;NN SPECIFIED?
	MOV	A,E
	ORA	A
	JZ	NNN	;NO.
	LDA	TOGO	;FIRST TIME?
	CPI	0FFH	;WAS IT 0FFH?
	JNZ	NNN	;NO:  COUNTING
	MOV	A,E	;GET COUNT
	STA	TOGO	;SET COUNT
NNN	LXI	H,INBUF	;READY TO REPEAT
	LDA	TOGO
	CPI	0FFH
	JZ	PROMPT	;CONTINUOUS
	DCR	A	;COUNT DOWN
	STA	TOGO
	JNZ	PROMPT
	JMP	PROMPTR	;RESET

*TOGGLE PRINT FLAG

PRINTFF	LDA	PFLAG
	XRI	1
	STA	PFLAG
	JMP	PROMPT

*SLEEP ROUTINE, IN TENTHS OF A SEC

SLEEP	CALL	HEXIN	;GET COUNT IF ANY
	MOV	A,E	;ANY?
	ORA	A
	JNZ	SLEEPLP
	MVI	E,10
SLEEPLP	LXI	B,8000	;APPROX .1 SEC @ 2MHz
SLEEP2	DCX	B
	MOV	A,B
	ORA	C
	JNZ	SLEEP2
	PUSH	D
	CALL	CTLCS
	POP	D
	JZ	PROMPTR
	DCR	E
	JNZ	SLEEPLP
	JMP	PROMPT

*CHECK FOR CONTROL-C OR S

CTLCS	CALL	CONST
	INR	A
	RNZ		;NO CHAR
	CALL	CINP
	ANI	1FH	;ALLOW ASCII
	CPI	'S'-40H
	CZ	CINP
	CPI	'C'-40H
	RET		;0 SET IF Ctl-c

LOGIN	MVI	C,RESDSK
	PUSH	H
	CALL	BDOS
	POP	H
	MOV	A,M	;DISK REQ?
	LXI	D,0
	CPI	CR
	JZ	LGNODK
	CPI	';'
	JZ	LGNODK
	CALL	UPCASE
	INX	H
	SUI	'A'
	MOV	E,A
LGNODK	MVI	C,SELDSK
	PUSH	H
	CALL	BDOS
	POP	H
	CALL	NOWRITE
	JMP	PROMPT

*READ IN THE DISK DIRECTORY

READDIR	PUSH	H
	CALL	NOWRITE	;POSITIONING LOST
	MVI	A,2
	STA	CURTRK
	MVI	A,1
	STA	CURSEC
	MVI	B,16	;# OF SECTORS
	LXI	D,DIRECT	;DMA ADDR
RDIRLP	PUSH	B
	PUSH	D
	MOV	B,D
	MOV	C,E
	CALL	VSETDMA
	LDA	CURTRK
	CALL	SETTRK
	LDA	CURSEC
	CALL	SETSEC
	CALL	READ
	CALL	NEXTSEC
	POP	D
	POP	B
	LXI	H,80H
	DAD	D
	XCHG
	DCR	B
	JNZ	RDIRLP
	LXI	B,80H
	CALL	VSETDMA
	POP	H
	RET

*MAP THE DIRECTORY

MAP	CALL	READDIR	;READ IN DIRECTORY
	MVI	C,2	;DFLT START
	CALL	HEXIN
	PUSH	H	;SAVE INBUF PTR
	MOV	A,E	;GET START
	ORA	A	;NOTHING?
	JZ	MAPDF	;..YES, DFLT
	MOV	C,E
MAPDF	MOV	A,C
	CALL	HEX
	MVI	A,'-'
	CALL	TYPE
	CALL	GETGRP	;GET GRP(C) TO HL
MAPCONT	INR	C	;NEXT GRP
	JZ	MAPEND	;DONE
	PUSH	H
	CALL	GETGRP	;GET ANOTHER
	POP	D	;SEE IF SAME
	CALL	CTLCS
	JZ	MAPEND2
	MOV	A,D
	CMP	H
	JNZ	MAPDIFF
	MOV	A,E
	CMP	L
	JNZ	MAPDIFF
*SAME, CONTINUE
	JMP	MAPCONT

*DIFFERENT FILE ENCOUNTERED

MAPDIFF	MOV	A,C
	DCR	A
	CALL	HEX
	XCHG
	CALL	MAPNAME
	JMP	MAPDF

*END

MAPEND	MOV	A,C	;GET LAST
	DCR	A
	CALL	HEX
	CALL	MAPNAME
	POP	H
	CALL	CRLF

*END OF MAP - REPOSITION TO PREVIOUS GROUP

MAPEND2	LDA	GROUP
	PUSH	H
	MOV	L,A
	JMP	POSGRP2

*PRINT FILE NAME POINTED TO BY HL

MAPNAME	CALL	SPACE
	MOV	A,H
	ORA	L	;NONE?
	JZ	NONAME
	MOV	A,M	;SEE IF ALLOC
	ORA	A	;ZERO?
	MVI	A,' '
	JZ	MAPNSP1
	MVI	A,'('
MAPNSP1	CALL	TYPE
	PUSH	H	;SAVE POINTER
	INX	H	;SKIP ALLOC BYTE
	MVI	B,8
	CALL	MAPN2
	MVI	A,'.'
	CALL	TYPE
	MVI	B,3
	CALL	MAPN2
	CALL	SPACE
	MOV	A,M	;GET EXT
	ORI	'0'
	CALL	TYPE
	POP	H
	MOV	A,M
	ORA	A
	MVI	A,' '
	JZ	MAPNSP2
	MVI	A,')'
MAPNSP2	CALL	TYPE	;")" IF ERASED FILE
	LDA	TWOUP
	XRI	1
	STA	TWOUP
	JZ	CRLF
	JMP	DELIM

NONAME	CALL	ILPRT
	DB	'++FREE++        ',0
	LDA	TWOUP
	XRI	1
	STA	TWOUP
	JZ	CRLF
DELIM	MVI	A,':'
	JMP	TYPE

*PRINT NAME, LENGTH IN B

MAPN2	MOV	A,M
	INX	H
	CPI	' '	;PRINTABLE?
	JC	MAPN2H	;..NO, IN HEX
	CPI	7FH	
	JC	MAPN2A
MAPN2H	CALL	BHEX
	JMP	MAPN2Z
MAPN2A	CALL	TYPE
MAPN2Z	DCR	B
	JNZ	MAPN2
	RET

*FIND WHICH FILE GROUP(C) BELONGS TO

GETGRP	LXI	H,DIRECT
	MVI	A,64	;# OF FILES
	STA	FILECT
GETGLP	PUSH	H	;SAVE POINTER
	LXI	D,15	;DISP TO LENGTH
	DAD	D
	MOV	A,M	;GET LENGTH
	ORA	A	;ZERO?
	JZ	GETGNF	;NO FILE
	CPI	0E5H	;UNUSED, FOMATTED DISK?
	JZ	GETGNF
	MOV	B,A	;SAVE COUNT
	DCR	B	;ALLOW JP BELOW
GETGL2	INX	H	;TO NEXT
	MOV	A,M	;GET GRP
	CMP	C	;CORRECT ONE?
	JZ	GETGOT	;YES, GOT IT.
	MOV	A,B	;GET REC COUNT
	SUI	8
	MOV	B,A
	JP	GETGL2
*NO FILE
GETGNF	POP	H
	LXI	D,32
	DAD	D	;TO NEXT ENTRY
	LDA	FILECT
	DCR	A
	STA	FILECT
	JNZ	GETGLP	;MORE?
	LXI	H,0	;NO, NOT FOUND
	RET

*GOT THE FILE

GETGOT	POP	H	;POINT TO NAME
	RET

*SAVE THE CURRENT SECTOR

SAVE	LDA	WRFLG
	ORA	A
	JZ	BADW	;NONE TO SAVE
	PUSH	H
	LXI	H,80H
	LXI	D,SAVEBUF
	MVI	B,128
	CALL	MOVE
	MVI	A,1	;..SHOW
	STA	SAVEFLG	;..SAVED EXISTS
	POP	H
	JMP	PROMPT

*RESTORE THE CURRENT SECTOR

RESTORE	LDA	SAVEFLG
	ORA	A
	JZ	NOSAVE	;NONE TO SAVE
	PUSH	H
	LXI	H,SAVEBUF
	LXI	D,80H
	MVI	B,128
	CALL	MOVE
	POP	H
	JMP	PROMPT

NOSAVE	CALL	ILPRT
	DB	'++NO "<" SAVE COMMAND ISSUED'
	DB	CR,LF,0
	JMP	PROMPTR

*MOVE (HL) TO (DE) LENGTH IN B

MOVE	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MOVE
	RET

NOWRITE	XRA	A	;GET 0
	STA	WRFLG	;CAN'T WRITE NOW
	RET

*NO MATCH IN SEARCH, TRY NEXT CHAR

SRNOMAT	POP	H
	CALL	CTLCS	;ABORT?
	JNZ	SEARCH	;..YES
	LXI	H,INBUF
	MVI	M,CR
	JMP	CALCGRP	;SHOW WHERE STOPPED

*SEARCH FOR CHARACTER STRING

SEARCH	PUSH	H	;SAVE STRING POINTER
SRCHL	CALL	RDBYTE	;GET A BYTE
	PUSH	PSW
	CALL	GETVAL	;GET SEARCH VALUE
	MOV	B,A
	POP	PSW
	CMP	B	;MATCH?
	JNZ	SRNOMAT	;NO MATCH
	INX	H
	MOV	A,M	;DONE?
	CPI	CR
	JZ	SREQU
	CPI	';'
	JNZ	SRCHL
*GOT MATCH
SREQU	CALL	ILPRT
	DB	'= AT ',0
	LDA	BUFAD
	ANI	7FH
	CALL	HEX
	CALL	CRLF
	JMP	CALCGRP

*GET VALUE FROM INPUT BUFFER

GETVAL	MOV	A,M
	CPI	'<'	;HEX ESCAPE?
	RNZ		;NO, RETURN
*"<<" MEANS ONE "<"
	INX	H
	MOV	A,M
	CPI	'<'
	RZ
*GOT HEX
	PUSH	D
	CALL	HEXIN	;GET VALUE
	CPI	'>'	;PROPER DELIM?
	MOV	A,E	;GET VALUE
	POP	D
	JNZ	WHAT	;ERROR
	RET

*READ A BYTE AT A TIME

RDBYTE	PUSH	H
	LDA	FTSW	;FIRST READ?
	ORA	A
	JNZ	READ1
	LHLD	BUFAD
	MOV	A,H
	ORA	A	;AT 100?
	JZ	NORD	;NO, NO READ
*HAVE TO READ
	CALL	NEXTSEC
READ1	XRA	A
	STA	FTSW	;NOT FIRST READ
	LDA	CURSEC
	CALL	SETSEC
	LDA	CURTRK
	CALL	SETTRK
	CALL	READ
	CALL	CALCSUB
	LXI	H,80H
NORD	MOV	A,M
	INX	H
	SHLD	BUFAD
	POP	H
	RET

*VIEW THE FILE IN ASCII STARTING AT
*CURRENT SECTOR, STEPPING THRU THE DISK

VIEW	LDA	WRFLG
	ORA	A
	JZ	BADDMP
	CALL	HEXIN	;GET DISPL IF ANY
	PUSH	H
	MOV	A,E
	ORA	A
	JNZ	VIEWLP
	INR	E	;DFLT=1
VIEWLP	LXI	H,80H	;TO DATA
VIEWCHR	CALL	CTLCS
	JZ	VIEWEND
	MOV	A,M
	CPI	1AH
	JZ	VIEWEOF
	CALL	TYPE
	INR	L
	JNZ	VIEWCHR
	DCR	E
	JZ	VIEWEND
	PUSH	D	;SAVE COUNT
	CALL	NEXTSEC
	LDA	CURSEC
	CALL	SETSEC	
	LDA	CURTRK
	CALL	SETTRK
	CALL	READ
	POP	D	;RESTORE COUNT
	JMP	VIEWLP

VIEWEOF	CALL	ILPRT
	DB	CR,LF,TAB,'++EOF++',CR,LF,0

VIEWEND	POP	H
	CALL	CRLF
	JMP	CALCGRP

*DUMP IN HEX OR ASCII

DUMP	LDA	WRFLG
	ORA	A
	JNZ	DUMPOK
	CALL	ILPRT
BADDMP	DB	'++Can''t dump, no sector read.',CR,LF,0
EXPL	CALL	ILPRT
	DB	'Use G command following F,',CR,LF
	DB	'or R or S following T',CR,LF,0
	JMP	PROMPTR

DUMPOK	MOV	A,M
	CPI	';'
	JZ	DUMPDF	;DFLT
	CPI	CR
	JNZ	DUMPNDF
*USE DEFAULT
DUMPDF	LXI	B,80H
	LXI	D,0FFH
	JMP	DUMP1
DUMPNDF	CALL	DISP
	MOV	B,D
	MOV	C,E
	CPI	CR
	JZ	DUMP1
	CPI	';'
	JZ	DUMP1
	INX	H	;SKIP ','
	CALL	DISP

*BC = START, DE = END

DUMP1	PUSH	H	;SAVE COMMAND POINTER
	MOV	H,B
	MOV	L,C
DUMPLP	MOV	A,L
	ANI	7FH
	CALL	HEX
	CALL	SPACE
	CALL	SPACE
	LDA	DUMTYPE
	CPI	'A'
	JZ	DUMPAS
	PUSH	H	;SAVE START
DHEX	MOV	A,M
	CALL	HEX
	MOV	A,L
	ANI	3
	CPI	3
	CZ	SPACE
	MOV	A,L
	ANI	7
	CPI	7
	CZ	SPACE
	MOV	A,E
	CMP	L
	JZ	DPOP
	INX	H
	MOV	A,L
	ANI	0FH
	JNZ	DHEX
DPOP	CALL	CTLCS
	JZ	PROMPTR
	LDA	DUMTYPE
	CPI	'H'
	JZ	DNOAS	;HEX ONLY

	POP	H	;GET START ADDR
DUMPAS	CALL	ASTER
DCHR	MOV	A,M
	CPI	' '
	JC	DPER	;IF LESS THAN A SPACE (I.E. NONPRINTING CHARACTER)
	CPI	7FH
	JC	DOK	;IF A PRINTING CHARACTER
DPER	MVI	A,'.'
DOK	CALL	TYPE
	MOV	A,E
	CMP	L
	JZ	DEND
	INX	H
	MOV	A,L
	ANI	0FH
	JNZ	DCHR
DEND	CALL	ASTER
	CALL	CRLF
	PUSH	D
	CALL	CTLCS
	POP	D
	JZ	PROMPTR
	MOV	A,E
	CMP	L
	JNZ	DUMPLP
	POP	H
	JMP	PROMPT

DNOAS	POP	B
	CALL	CRLF
	MOV	A,E
	CMP	L
	JNZ	DUMPLP
	POP	H
	JMP	PROMPT

*POSITION

POS	PUSH	PSW
	MOV	A,M
	CPI	';'
	JZ	POSINQ
	CPI	CR
	JNZ	POSOK
POSINQ	POP	PSW
	JMP	INQ

POSOK	CALL	HEXIN
	POP	PSW
	CPI	'T'
	JZ	POSTRK
	CPI	'S'
	JZ	POSSEC
	CPI	'G'
	JZ	POSGRP
	JMP	WHAT

POSTRK	MOV	A,E
	CALL	SETTRK
	CALL	NOWRITE	;TRACK DOESN'T READ
	JMP	CALCGRP

POSSEC	MOV	A,E
	ORA	A
	JZ	WHAT
	CPI	27
	JNC	WHAT
	CALL	SETSEC
	CALL	READ

CALCGRP	CALL	CALCSUB
	JMP	INQ

CALCSUB	PUSH	H
	LDA	CURTRK
	SUI	2	;GRP 0 IS TRK 2
	MOV	L,A
	MVI	H,0
	MOV	D,H
	MOV	E,L
	DAD	H	;X2
	DAD	D	;X3
	DAD	H	;X6
	DAD	H	;X12
	DAD	D	;X13
	DAD	H	;X26
	LDA	CURSEC
	DCR	A
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	MOV	A,L
	ANI	7
	STA	GRPDISP
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	MOV	A,H
	STA	GROUP
	POP	H
	RET

*POSITION IN THE DIRECTORY AFTER A FIND

POSDIR	PUSH	H	;SAVE INBUF
	XRA	A
	STA	FINDFLG	;CANCEL POS REQ
	LDA	DIRPOS	;GET POSITION
	RAR
	RAR
	PUSH	PSW
	ANI	7	;GET GRP DISPLACEMENT
	STA	GRPDISP
	POP	PSW
	RAR
	RAR
	RAR
	ANI	1	;GET GROUP
	STA	GROUP
	MOV	L,A	;SETUP FOR POSGRP2
	JMP	POSGRP2	;POSITION TO IT

POSGRP	MOV	A,E
	STA	GROUP
	XRA	A
	STA	GRPDISP
	PUSH	H
	MOV	L,E	;MULTIPLY
POSGRP2	MVI	H,0	;BY 8
	DAD	H
	DAD	H
	DAD	H
	LDA	GRPDISP	;MAY BE >0 IF "F" CMD.
	ADD	L	;CAN'T CARRY
	MOV	L,A
*DIVIDE BY 26, QUOTIENT = TRK, REMAINDER = SECTOR
	LXI	D,-26
	MVI	B,0	;TRK
DIVLP	INR	B
	DAD	D
	JC	DIVLP
	DCR	B
	LXI	D,26
	DAD	D
	MOV	A,B
	ADI	2	;GROUP 0 IS TRK 2
	CALL	SETTRK
	MOV	A,L
	INR	A
	CALL	SETSEC
	CALL	READ
	POP	H
	JMP	INQ

POSFIL	CALL	NOWRITE
	MVI	A,1
	STA	FINDFLG	;SO WE POSITION LATER
	LXI	D,FCB
	XRA	A	;LOGGED IN DISK
	STAX	D
	INX	D
	MVI	B,8
	CALL	MVNAME
	MVI	B,3
	CALL	MVNAME
	LXI	D,FCB
	MVI	C,SRCH1ST
	PUSH	H
	CALL	BDOS
	INR	A
	JNZ	FLOK
	STA	DIRPOS	;GRP 0 IF NOT FOUND
	CALL	ILPRT
	DB	'++FILE NOT FOUND',CR,LF,0
	POP	H
	JMP	PROMPT

FLOK	DCR	A
	STA	DIRPOS	;SAVE POS. IN DIR
	ANI	3
	MOV	L,A
	MVI	H,0
	DAD	H	;X32 BYTES/ENTRY
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	LXI	D,80H
	DAD	D	;HL POINTS TO ENTRY
	LXI	D,32
	XCHG
	DAD	D
	XCHG
	MVI	A,'D'
	STA	DUMTYPE
	JMP	DUMPLP	;WHICH POPS H

MVNAME	MOV	A,M
	CPI	'.'
	JZ	MVIPAD
	CPI	CR
	JZ	PAD
	CPI	';'
	JZ	PAD
	CALL	UPCASE
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MVNAME
	MOV	A,M
	CPI	CR
	RZ
	CPI	';'
	RZ
	INX	H
	CPI	'.'
	RZ
	JMP	WHAT

MVIPAD	INX	H

PAD	MVI	A,' '
	STAX	D
	INX	D
	DCR	B
	JNZ	PAD
	RET

PLUS	LXI	D,1	;DFLT TO 1 SECT
	MOV	A,M	;GET NEXT CHAR
	CPI	CR	;CR?
	JZ	PLUSGO	;..YES, DFLT TO 1
	CPI	';'
	JZ	PLUSGO
	CALL	HEXIN	;GET #
	MOV	A,E
	ORA	A
	JZ	WHAT
PLUSGO	CALL	NEXTSEC
	DCR	E	;MORE TO GO?
	JNZ	PLUSGO	;..YES

*OK, INCREMENTED TO SECTOR.  SETUP AND READ

PLUSMI	LDA	CURSEC
	CALL	SETSEC	
	LDA	CURTRK
	CALL	SETTRK
	CALL	READ
	JMP	CALCGRP

MINUS	LXI	D,1	;SET DFLT
	MOV	A,M	;GET CHAR
	CPI	CR	;CR?
	JZ	MINGO	;..YES, DFLT=1
	CPI	';'
	JZ	MINGO
	CALL	HEXIN	;..NO, GET ##
	MOV	A,E
	ORA	A
	JZ	WHAT
MINGO	LDA	CURSEC	;GET CURR
	DCR	A	;BACK UP
	JNZ	MINOK	;TO 0?
	LDA	CURTRK	;..YES, BACK..
	DCR	A	;..UP 1..
	STA	CURTRK	;..TRACK
	MVI	A,26	;
MINOK	STA	CURSEC
	DCR	E
	JNZ	MINGO
	JMP	PLUSMI

*GO TO NEXT SECTOR

NEXTSEC	LDA	CURSEC	;GET CURRENT
	INR	A	;BUMP IT
	CPI	27	;NEXT TRACK?
	JNZ	NEXTOK	;NO, CONI
	LDA	CURTRK	;BUMP..
	INR	A	;..CURR..
	STA	CURTRK	;..TRK
	MVI	A,1	;SECT=1
NEXTOK	STA	CURSEC
	RET

*TELL WHAT GRP, DISPLACEMENT, TRK, SECT, PHY SECT

INQ	CALL	INQSUB
	JMP	PROMPT

*POSITION INQUIRY SUBROUTINE
*	EXECUTED VIA: G S OR T (WITH NO OPERANDS)

INQSUB	LDA	CURTRK
	CPI	2
	JC	NOGRP
	CALL	ILPRT
	DB	'G=',0
	LDA	GROUP
	CALL	HEX
	MVI	A,':'
	CALL	TYPE
	LDA	GRPDISP
	ORI	'0'
	CALL	TYPE
	MVI	A,','
	CALL	TYPE
NOGRP	CALL	ILPRT
	DB	' T=',0
	LDA	CURTRK
	CALL	HEX
	CALL	ILPRT
	DB	', S=',0
	LDA	CURSEC
	CALL	HEX
	CALL	ILPRT
	DB	', PS=',0
	LDA	PHYSEC
	CALL	HEX
	CALL	CRLF
	RET

CHG	MOV	A,M	;GET TYPE (HEX, ASCII)
	CALL	UPCASE
	PUSH	PSW	;SAVE "H" OR "A"
	INX	H
	CALL	DISP	;GET, VALIDATE DISP TO DE
	INX	H
	LXI	B,0	;SHOW NO 'THRU' ADDR
	CPI	'-'	;TEST DELIM FR. DISP
	JNZ	CHGNTH	;NO THRU
	PUSH	D	;SAVE FROM
	CALL	DISP	;GET THRU
	MOV	B,D
	MOV	C,E	;BC = THRU
	POP	D	;GET FROM
	JMP	CHGAH
CHGNTH	CPI	','
	JNZ	WHAT
CHGAH	POP	PSW
	CPI	'H'
	JZ	CHGHEX
	CPI	'A'
	JNZ	WHAT
*CHANGE ASCII
CHGALP	MOV	A,M
	CPI	CR
	JZ	PROMPT
	CPI	';'
	JZ	PROMPT
	LDAX	D
	CPI	' '
	JC	CHGAHX
	CPI	7FH
	JNC	CHGAHX
	JMP	CHGA2
CHGAHX	CALL	BHEX
	JMP	CHGA3
CHGA2	CALL	TYPE
CHGA3	CALL	GETVAL	;ASCII OR <HEX>
	STAX	D	;UPDATE CHAR
	INX	H	;TO NEXT INPUT CHAR
*SEE IF 'THRU' REQUESTED
	MOV	A,C
	ORA	A
	JZ	CHGANTH
	CMP	E	;DONE?
	JZ	PROMPT
	DCX	H	;..NO: MORE.
CHGANTH	INR	E
	JNZ	CHGALP
	MOV	A,M
	CPI	CR
	JZ	PROMPT
	CPI	';'
	JZ	PROMPT
	JMP	WHAT

*CHANGE HEX

CHGHCOM	INX	H
CHGHEX	MOV	A,M
	CPI	CR
	JZ	PROMPT
	CPI	';'
	JZ	PROMPT
	CPI	','	;DELIM?
	JZ	CHGHCOM
	PUSH	D
	SHLD	HEXAD	;IN CASE 'THRU'
	CALL	HEXIN	;POSITIONS TO DELIM
	MOV	A,E	;GET VALUE
	POP	D	;..ADDR
	PUSH	PSW	;SAVE VALUE
	LDAX	D	;GET OLD
	CALL	HEX	;ECHO IN HEX
	POP	PSW	;GET NEW
	STAX	D	;SAVE NEW

	MOV	A,C	;SEE IF 'THRU'
	ORA	A
	JZ	CHGHNTH	;..NO.
	CMP	E	;..YES, DONE?
	JZ	PROMPT
	LHLD	HEXAD	;..NO: MORE
CHGHNTH	INR	E
	JNZ	CHGHEX
	MOV	A,M
	CPI	CR
	JZ	PROMPT
	CPI	';'
	JZ	PROMPT
	JMP	WHAT

DOREAD	CALL	READ
	JMP	PROMPT

DOWRITE	CALL	WRITE
	JMP	PROMPT

BHEX	PUSH	PSW
	MVI	A,'<'
	CALL	TYPE
	POP	PSW
	CALL	HEX
	MVI	A,'>'
	CALL	TYPE
	RET

HEX	PUSH	PSW
	RAR
	RAR
	RAR
	RAR
	CALL	NIBBL
	POP	PSW
NIBBL	ANI	0FH
	CPI	10
	JC	HEXNU
	ADI	7
HEXNU	ADI	'0'
	JMP	TYPE

SPACE	MVI	A,' '
	JMP	TYPE
ASTER	MVI	A,'*'
	JMP	TYPE

ILPRT	XTHL
ILPLP	CALL	CTLCS	;ABORT?
	JZ	PROMPTR
	MOV	A,M
	CALL	TYPE
	INX	H
	MOV	A,M
	ORA	A
	JNZ	ILPLP
	INX	H
	XTHL
	RET

*DISP CALLS HEXIN, AND VALIDATES A SECTOR
*DISPLACEMENT, THEN CONVERTS IT TO AN ADDRESS

DISP	CALL	HEXIN
	PUSH	PSW	;SAVE DELIMITER
	MOV	A,D
	ORA	A
	JNZ	BADISP
	MOV	A,E
	ORA	A
	JM	BADISP
	ADI	80H	;TO POINT TO BUFFER AT 80
	MOV	E,A
	POP	PSW	;GET DELIM
	RET

BADISP	CALL	ILPRT
	DB	'++BAD DISPLACEMENT (NOT 0-7F)'
	DB	CR,LF,0
	JMP	PROMPTR

HEXIN	LXI	D,0
	MOV	A,M
	CPI	'#'	;DECIMAL?
	JZ	HDIN	;MAKE DECIMAL
HINLP	MOV	A,M
	CALL	UPCASE
	CPI	CR
	RZ
	CPI	';'
	RZ
	CPI	','
	RZ
	CPI	'-'	;'THRU'?
	RZ
	CPI	'>'
	RZ
	INX	H
	CPI	'0'
	JC	WHAT
	CPI	'9'+1
	JC	HINNUM
	CPI	'A'
	JC	WHAT
	CPI	'F'+1
	JNC	WHAT
	SUI	7
HINNUM	SUI	'0'
	XCHG
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	ADD	L
	MOV	L,A
	XCHG
	JMP	HINLP

HDIN	INX	H	;SKIP '.'
DECIN	LXI	D,0
DINLP	MOV	A,M
	CALL	UPCASE
	CPI	CR
	RZ
	CPI	';'
	RZ
	CPI	','
	RZ
	CPI	'-'	;'THRU'?
	RZ
	INX	H
	CPI	'0'
	JC	WHAT
	CPI	'9'+1
	JNC	WHAT
	SUI	'0'
	PUSH	H
	MOV	H,D
	MOV	L,E
	DAD	H	;X2
	DAD	H	;X4
	DAD	D	;X5
	DAD	H	;X10
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	XCHG
	POP	H
	JMP	DINLP

*READ IN A CONSOLE BUFFER FULL

RDBUF	CALL	ILPRT
	DB	CR,LF,':',0
	LXI	H,INBUF
	MVI	B,0
RDBLP	CALL	CINP
	MOV	C,A	;SAVE FOR BS TEST
	CPI	'U'-40H
	JZ	RDCTLU
	CPI	CR
	JZ	RDCR
	CPI	8
	JZ	RDBS
	CPI	7FH
	JZ	RDBS
	CPI	'R'-40H
	JZ	RDCTLR
	MOV	M,A
	INX	H
	INR	B
	JM	FULL
	CALL	TYPE
	JMP	RDBLP

FULL	DCR	B
	DCX	H
	MVI	A,BELL
	CALL	TYPE
	JMP	RDBLP

*GOT CR

RDCR	MOV	M,A	;SAVE IT
	CALL	TYPE	;ECHO IT
	MVI	A,LF	;ECHO..
	CALL	TYPE	;..LF
	LXI	H,INBUF
	RET

*GOT DELETE OR BS, ECHO IF BS

RDBS	XRA	A	;AT FRONT..
	ORA	B	;..OF LINE?
	JZ	RDCTLU	;..YES, ECHO ^U
	DCX	H
	DCR	B
	MOV	A,C
	CPI	8	;BS?
	JZ	BACKUP	;ECHO THE BS
	MOV	A,M	;ECHO..
	CALL	TYPE	;..DELETED CHAR
	JMP	RDBLP

BACKUP	MVI	A,8
	CALL	TYPE
	JMP	RDBLP

*GOT CTL-R, RETYPE

RDCTLR	MVI	M,CR
	CALL	CRLF
	LXI	H,INBUF
	MVI	B,0
RDCRL	MOV	A,M
	CPI	CR
	JZ	RDBLP
	CALL	TYPE
	INR	B
	INX	H
	JMP	RDCRL

*GOT CTL-U OR BACKUP TO BEG. OF LINE.

RDCTLU	MVI	A,'^'
	CALL	TYPE
	MVI	A,'U'
	CALL	TYPE
	JMP	RDBUF

CRLF	MVI	A,CR
	CALL	TYPE
	MVI	A,LF
	JMP	TYPE

UPCASE	CPI	60H
	RC
	ANI	5FH	;MAKE UPPER CASE
	RET

CONST	PUSH	B
	PUSH	D
	PUSH	H
VCONST	CALL	$-$
	POP	H
	POP	D
	POP	B
	RET

CINP	PUSH	B
	PUSH	D
	PUSH	H
VCINP	CALL	$-$
	POP	H
	POP	D
	POP	B
	RET

*CONSOLE OUT WITH TAB EXPANSION

TYPE	PUSH	B
	PUSH	D
	PUSH	H
	MOV	C,A	;FOR OUTPUT ROUTINE
	CPI	TAB
	JNZ	VCONOUT
TYPETAB	MVI	A,' '
	CALL	TYPE
	LDA	TABCOL
	ANI	7
	JNZ	TYPETAB
	JMP	TYPERET

VCONOUT	CALL	$-$	;ADDR FILLED IN BY 'INIT'

*UPDATE COLUMN USED IN TAB EXPANSION

	MOV	A,C	;GET CHAR
	CPI	CR
	JNZ	TYPENCR
	MVI	A,0
	STA	TABCOL
	JMP	TYPELST

TYPENCR	CPI	' '	;CTL CHAR?
	JC	TYPERET	;..NO CHANGE IN COL
	LDA	TABCOL
	INR	A
	STA	TABCOL
TYPELST	LDA	PFLAG
	ANI	1
	CNZ	PRINT	;FROM C REG.
TYPERET	POP	H
	POP	D
	POP	B
	RET

PRINT:			;TYPE SAVED REGS
VPRINT	JMP	$-$

HOME	PUSH	H
VHOME	CALL	$-$
	POP	H
	RET

SETTRK	CPI	77
	JC	TRKOK
	CALL	ILPRT
	DB	'++not in tracks 0-76++'
	DB	CR,LF,0
	CALL	NOWRITE
	JMP	PROMPTR

TRKOK	STA	CURTRK
	MOV	C,A
	PUSH	H
VSETTRK	CALL	$-$
	POP	H
	RET

SETSEC	STA	CURSEC	;LOGICAL
	MOV	C,A
	LDA	CURTRK
	CPI	2
	JC	GSETSEC	;DON'T SCRAMBLE TRK'S 0-1
	PUSH	H
	LXI	H,SECTBL-1
	MOV	A,C
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	MOV	A,M
	POP	H
	MOV	C,A
GSETSEC	PUSH	H
	MOV	A,C	;GET PHYSICAL SECTOR
	STA	PHYSEC
VSETSEC	CALL	$-$
	POP	H
	RET

VSETDMA	JMP	$-$

READ	MVI	A,1
	STA	WRFLG
	PUSH	H
VREAD	CALL	$-$
	ORA	A
	JZ	READOK
	CALL	ILPRT
	DB	'++READ failed, sector may be invalid++'
	DB	CR,LF,0
READOK	POP	H
	RET

WRITE	LDA	WRFLG
	ORA	A
	JNZ	PWRITE
BADW	CALL	ILPRT
	DB	'++CANNOT WRITE UNLESS READ ISSUED'
	DB	CR,LF,0
	JMP	EXPL
PWRITE	PUSH	H
VWRITE	CALL	$-$
	ORA	A
	JZ	WRITEOK
	CALL	ILPRT
	DB	'++WRITE failed++',CR,LF,0
WRITEOK	POP	H
	RET

*HELP

HELP	CALL	ILPRT
	DB	'Operands in brackets [...] are optional'
	DB	CR,LF
	DB	'+[n]	step in [n] sectors'
	DB	CR,LF
	DB	'-[n]	step out [n] sectors'
	DB	CR,LF
	DB	'=xxx	search for ASCII xxx from curr sector.'
	DB	CR,LF
	DB	'Caution: upper/lower case matters'
	DB	CR,LF
	DB	'<nn> for hex: "IN 0" is: =<db><0>'
	DB	CR,LF
	DB	'"(tab)H,0(CR)(LF)" is: =<9>H,0<D><A>'
	DB	CR,LF
	DB	'<	save current sector'
	DB	CR,LF
	DB	'>	restore saved sector'
	DB	CR,LF
	DB	'?	give help'
	DB	CR,LF
	DB	'A[ff,tt] ASCII dump'
	DB	CR,LF
	DB	'C	Change:'
	DB	CR,LF
	DB	'	CHaddr,byte,byte... (hex)'
	DB	CR,LF
	DB	'  or	CAaddr,data  (Ascii)'
	DB	CR,LF
	DB	'	<xx> Allowed for imbedded hex.'
	DB	CR,LF
	DB	'  or	CHfrom-thru,byte  e.g. ch0-7f,e5'
	DB	CR,LF
	DB	'  or	CAfrom-thru,byte'
	DB	CR,LF
	DB	'D[ff,tt] Dump (hex+ASCII)'
	DB	CR,LF
	DB	'Fn.t	Find file'
	DB	CR,LF
	DB	'Gnn	CP/M Allocation Group nn'
	DB	CR,LF
	DB	'H[ff,tt]	hex dump'
	DB	CR,LF
	DB	'L	Log in drive'
	DB	CR,LF
	DB	'Lx	Log in drive x'
	DB	CR,LF
	DB	'M[nn]	Map [from group nn]'
	DB	CR,LF
	DB	'P	Toggle printer switch'
	DB	CR,LF
	DB	'R	Read current sector'
	DB	CR,LF
	DB	'Snn	Sector nn'
	DB	CR,LF
	DB	'Tnn	Track nn'
	DB	CR,LF
	DB	'V[nn]	View [nn] ASCII sectors'
	DB	CR,LF
	DB	'W	Write current sector'
	DB	CR,LF
	DB	'X	Exit program'
	DB	CR,LF
	DB	'Z[nn]	Sleep [nn tenths]'
	DB	CR,LF
	DB	'/[nn]	Repeat [nn (decimal) times]'
	DB	CR,LF,CR,LF
	DB	'Cancel a function with C or Ctl-C.'
	DB	CR,LF
	DB	'Suspend output with S or Ctl-S.'
	DB	CR,LF
	DB	'Separate commands with ";".'
	DB	CR,LF
	DB	'All "nn" usage except "/" are '
	DB	'HEX.  Use #nn for decimal.'
	DB	CR,LF,0
	JMP	PROMPT

*DISK SECTOR ORDER - standard CP/M

SECTBL	DB	1,7,13,19,25,5,11,17,23,3,09,15,21
	DB	2,8,14,20,26,6,12,18,24,4,10,16,22

BUFAD	DW	100H	;FORCES INITIAL READ
HEXAD	DW	0	;TO RE-FETCH A VALUE
TOGO	DB	0FFH	;REPEAT COUNT (FF=CONT)
TWOUP	DB	0
PFLAG	DB	0	;1=PRINT
GROUP	DB	0
GRPDISP	DB	0
SAVEFLG	DB	0
CURTRK	DB	0
CURSEC	DB	1
PHYSEC	DB	1
TABCOL	DB	0
FILECT	DB	0
DIRPOS	DB	0
FINDFLG	DB	0	;1=MUST POSITION AFTER FIND
FTSW	DB	1	;SEARCH W/O INCREMENT
WRFLG	DB	0	;MAY NOT WRITE UNTIL '+', '-',
*			 OR 'G' COMMAND
	DS	100	;STACK SPACE
STACK:
DUMTYPE	DS	1
SAVEBUF	DS	128
INBUF	DS	128

*DIRECTORY READ IN HERE; ALSO SEARCH WORKAREA

WORK:
DIRECT	DS	32*64


	END