;***************************************;
;					;
;		S U R V E Y		;
;					;
;***************************************;

;By Michael Friese  9/22/79


;*  Lists Kbytes used and remaining plus number of files
;   on all logged disks (up to 8)
;*  Prints Memory map and synopsis of all machine memory
;*  Lists all active I/O Ports
;*  Uses disk allocation block for all disk calculations
;
;VERSION LIST - Most recent version first.
;
;06/Jul/82 - Added Godbout DISK 1 equate and added SKIP equate
;	    Bill Bolton - Software Tools, Australia
;
;01/Jun/82 - Tidied up and fixed port display, added display
;	    of contents of low memory. David Bennett - Alfred
;	    Hospital, Australia
;
;29/Jun/80 - Added version number test and calculations for CP/M
;	    version 2 compatibility.   This program should now work
;	    properly on all versions 1.4 and later.  BRR
;
;28/Jun/80 - Added IMS400 equate (prevents Industrial Micro Systems
;	    controller from hanging up during port scan).  BRR
;
;24/Jun/80 - Removed MACLIB statement, included required macros
;	    in source.     Bruce R. Ratoff
;

;*******************************;
;	SYSTEM MACROS		;
;*******************************;
;Increments 16 bit memory location X
INXI	MACRO	X
	LOCAL	JUST8
	PUSH	H
	LXI	H,X
	INR	M
	JNZ	JUST8
	INX	H
	INR	M
JUST8:
	POP	H
	ENDM
;..............................................................
;
;	SAVE MACRO	SAVE SPECIFIED REGISTERS
;
;	SAVE	R1,R2,R3,R4
;
;		R1-R4 MAY BE B,D,H OR PSW  SAVED IN ORDER SPECIFIED
;		IF REGS ARE OMITTED SAVE B,D AND H
;
SAVE	MACRO	R1,R2,R3,R4
	IF NOT NUL R1&R2&R3&R4
	IRP	R,<<R1>,<R2>,<R3>,<R4>>
	IF	NUL R
	EXITM
	ENDIF
	PUSH	R
	ENDM
	ELSE
	IRPC	REG,BDH
	PUSH	REG
	ENDM
	ENDIF
	ENDM
;
;	. . . . . . . . . . . . . . . . . . . . . . . . . . . .
;
;	RESTORE MACRO	RESTORE REGISTERS  (INVERSE OF SAVE)
;
;	RESTORE	R1,R2,R3,R4
;
;		R1-R4 MAY BE B,D,H OR PSW  RESTORED IN ORDER SPECIFIED
;		IF REGS OMITTED RESTORE H,D AND B
;
RESTORE	MACRO	R1,R2,R3,R4
	IF	NOT NUL R1&R2&R3&R4
	IRP	R,<<R1>,<R2>,<R3>,<R4>>
	IF	NUL R
	EXITM
	ENDIF
	POP	R
	ENDM
	ELSE
	IRPC	REG,HDB
	POP	REG
	ENDM
	ENDIF
	ENDM
;
;..............................................................
;
;	CHAROUT MACRO	CONSOLE OUTPUT FROM A
;
;	CHAROUT	ADDR
;
CHAROUT	MACRO	ADDR
	IF	NOT NUL ADDR
	LDA	ADDR
	ENDIF
	MVI	C,2		;;CONOUT
	MOV	E,A		;;CHAR TO E
	CALL	5		;;CALL BDOS
	ENDM
;
;
;.............................................................
;
;	DECOUT MACRO	CONVERT A POSITIVE INTEGER TO DECIMAL AND OUTPUT 
;			TO THE CONSOLE.
;
;	DECOUT	ADDR
;
;		IF ADDR OMITTED, NUMBER ASSUMED TO BE IN HL, ELSE LOADED TO HL
;		LEADING ZEROS SUPRESSED. MAXIMUM NUMBER 65,767
;
DECOUT	MACRO	ADDR
	LOCAL	ENDDEC,DX
	JMP	ENDDEC
@DECOUT:
	SAVE			;;PUSH STACK
	LXI	B,-10		;;RADIX FOR CONVERSION
	LXI	D,-1		;;THIS BECOMES NO DIVIDED BY RADIX
DX:
	DAD	B		;;SUBTRACT 10
	INX	D
	JC	DX
	LXI	B,10
	DAD	B		;;ADD RADIX BACK IN ONCE
	XCHG
	MOV	A,H
	ORA	L		;;TEST FOR ZERO
	CNZ	@DECOUT		;;RECURSIVE CALL
	MOV	A,E
	ADI	'0'		;;CONVERT FROM BCD TO HEX
	MOV	E,A		;;TO E FOR OUTPUT
	CHAROUT			;;CONSOLE OUTPUT
	RESTORE			;;POP STACK
	RET
ENDDEC:
DECOUT	MACRO	?ADDR
	IF	NOT NUL ?ADDR
	LHLD	?ADDR
	ENDIF
	CALL	@DECOUT		;;CALL THE SUBROUTINE
	ENDM
	DECOUT	ADDR
	ENDM
;
;
;..............................................................
;
;	HEXOUT MACRO	CONVERT BINARY NO AND OUTPUT TO CONSOLE
;
;	HEXOUT	ADDR
;
;		NUMBER ASSUMED IN A IF NO ARGUMENT
;
HEXOUT	MACRO	ADDR
	LOCAL	OUTCHR,HEXEND
	JMP	HEXEND
HEXPRN:
	SAVE	PSW
	RRC
	RRC
	RRC
	RRC			;;SHIFT RIGHT 4
	CALL	OUTCHR
	RESTORE	PSW
OUTCHR:
	ANI	0FH		;;MASK 4 BITS
	ADI	90H		;;ADD OFFSET
	DAA			;;DEC ADJUST
	ACI	40H		;;ADD OFFSET
	DAA			;;DEC ADJUST
	MOV	E,A		;;TO E FOR OUTPUT
	MVI	C,2		;;CONOUT
	JMP	5		;;CALL BDOS
HEXEND:

HEXOUT	MACRO	?ADDR
	IF	NOT NUL ?ADDR
	LDA	?ADDR
	ENDIF
	CALL	HEXPRN
	ENDM
	HEXOUT	ADDR
	ENDM
;
;

;*******************************;
;	SYSTEM EQUATES		;
;*******************************;
TRUE	EQU	-1
FALSE	EQU	NOT TRUE
TARBEL	EQU	false		; Tarbell FDC dmb 31-may-82
IMS400	EQU	FALSE		; Industrial Micro Systems FDC
GODBOUT	EQU	TRUE		; Godbout Disk 1 FDC
GODBAS	EQU	0C0H		; Base of Godbout FDC
TARBAS	EQU	0F8H		; Base of Tarbell
SKIP	EQU	TARBEL OR IMS400 OR GODBOUT	; Will be true
				; if any skip needed
	IF	TARBEL
SKIPORT	EQU	TARBAS+4	; Port # to skip if Tarbell FDC
	ENDIF
	IF	IMS400
SKIPORT	EQU	08FH		; Port # to skip if IMS FDC
	ENDIF
	IF	GODBOUT
SKIPORT	EQU	GODBAS+1	; Port # to skip if Disk 1 FDC
	ENDIF
BDOS	EQU	5		; jump to BDOS
bios	equ	0		; jump to BIOS dmb 1-jun-82
CRLF	EQU	0A0DH		; CR LF sequence
CRLFE	EQU	8A0DH		; CR LF with EOL
EOL	EQU	80H		; End of line
TAB	EQU	'I'-40H 	; Tab character
ESC	EQU	1BH		; Escape character
TABS	EQU	9		; Tab columns

;***********************;
;	MAIN PROGRAM	;
;***********************;
;
	ORG	100H
;
START:
	LXI	H,0			; Save stack pointer
	DAD	SP
	SHLD	OLDSP
	LXI	SP,FINIS+64
	CALL	TYPE			; Type initial CRLF
	DB	TAB,TAB,'*** System Survey (June 82) ***'
	DW	CRLF,CRLFE

;DISK SURVEY
	LXI	H,8			; Init drive counter
	MVI	C,24			; Get login vector
	PUSH	H
	CALL	BDOS
	POP	H
ROTBIT:
	RAR				; RAR login bit to C
	JNC	NOTLOG			; Drive not logged
	PUSH	PSW			; Save login
	PUSH	H			; and counter

;Print drive letter
	CALL	TYPE
	DB	'Drive'
	DB	' '+EOL
	MVI	A,'A'			; Get ASCII bias
	ADD	H			; Add to drive #
	MOV	E,A			; Print drive letter
	CALL	TCHR
	CALL	TYPE			; and colon
	DB	':',' '+EOL
	POP	H			; Restore drive #
	PUSH	H

;Print K already allocated
	MOV	E,H
	MVI	C,14			; Log drive
	CALL	BDOS
	MVI	C,27			; Index allocation vect
	CALL	BDOS
	MOV	L,A			; Put in decent regs
	MOV	H,B
	PUSH	H			; save for later
	MVI	C,12			; get version #
	CALL	BDOS
	MOV	A,L			; zero if version 1
	ORA	A
	JNZ	V2X			; otherwise, use 2.x style params
	LHLD	BDOS+1			; get vers 1 style params
	MVI	L,3CH
	MOV	A,M			; get block shift factor
	STA	BLKSHF
	INX	H
	INX	H
	MOV	L,M			; get max. block number
	MVI	H,0
	SHLD	MAXALL
	MVI	B,32			; assume 32 bytes in block map
	JMP	GETALC			; continue
V2X:
	MVI	A,'?'			; Use wild user #
	STA	FCB			; in filename search
	MVI	C,31			; Get 2.x parameter block
	CALL	BDOS
	INX	H
	INX	H
	MOV	A,M			; Get and save ablock shift factor
	STA	BLKSHF
	INX	H
	INX	H
	INX	H
	MOV	A,M			; Get maximum block number
	INX	H			; (double precision)
	MOV	H,M
	MOV	L,A
	SHLD	MAXALL
	INX	H
	MVI	B,3			; map size is (MAXALL+1)/8
V2SH:
	MOV	A,H
	ORA	A			; do 16 bit right shift
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	DCR	B			; 3 times
	JNZ	V2SH
	MOV	B,L
	LDA	MAXALL			; allow for leftover bits if any
	ANI	3
	JZ	GETALC
	INR	B
GETALC:
	POP	H
	LXI	D,0			; Init group counter
NXBYTE:
	MVI	C,8			; Bit counter for byte
	MOV	A,M			; Get map byte
NXBIT:
	RAR				; Rotate to C
	JNC	NOBIT			; No group allocated
	INX	D			; Inc group counter
NOBIT:
	DCR	C			; Dec bit counter
	JNZ	NXBIT
	INX	H			; Index next byte
	DCR	B
	JNZ	NXBYTE
	CALL	SHF16
	PUSH	H
	CALL	BINDEC
	CALL	TYPE
	DB	'K bytes in',' '+EOL

;Print number of files
	LXI	D,FCB			; Fake file cont block
	MVI	C,17			; Search for 1st file
	CALL	BDOS
	LXI	H,0			; File counter
LOOK:
	CPI	255			; Failure
	JZ	PFILE
	ADD	A			; File offset times 2
	ADD	A			; 4
	ADD	A			; 8
	ADD	A			; 16
	ADD	A			; 32
	ADI	80H			; Make sure it's not a deleted file
	MOV	E,A
	MVI	D,0
	LDAX	D
	CPI	0E5H
	JZ	LOOK1
	INX	H			; Bump file counter
LOOK1:
	LXI	D,FCB			; Restore FCB
	MVI	C,18			; Look for addtl files
	PUSH	H			; Save file counter
	CALL	BDOS
	POP	H
	JMP	LOOK
PFILE:
	CALL	BINDEC			; Print # of files
	CALL	TYPE
	DB	' files with',' '+EOL

;Print K remaining
	LHLD	MAXALL			; Get number of blocks
	XCHG
	INX	D			; Inc for actual value
	CALL	SHF16
	XCHG
	POP	H
	MOV	A,H			; Ones comp & move
	CMA
	MOV	H,A
	MOV	A,L
	CMA
	MOV	L,A
	INX	H			; Twos complement
	DAD	D			; and subtract
	CALL	BINDEC			; K remaining
	CALL	TYPE
	DB	'K bytes remaining'
	DW	CRLFE

;Set up to print next drive
	POP	H			; Restore bit counter
	POP	PSW			; and bitmap byte
NOTLOG:
	INR	H			; Bump drive counter
	DCR	L			; Dec bit counter
	JNZ	ROTBIT

;MEMORY SURVEY
;Create header
MSURV:
	CALL	TYPE
	DW	CRLF
	DB	'Memory map:'
	DW	CRLF
	DB	'0',TAB,'8',TAB,'16',TAB,'24',TAB,'32'
	DB	TAB,'40',TAB,'48',TAB,'56',TAB,'64'
	DW	CRLF
	REPT	8
	DB	'|',TAB
	ENDM
	DB	'|'
	DW	CRLF
	db	' '			; dmb 31-May-82
	DB	'T'+EOL
	LXI	H,RAM
	MVI	M,LOW 1023		; Init RAM counter
	INX	H
	MVI	M,HIGH 1023
	MVI	B,4			; Clear ROM, EMP
CLREG:
	INX	H
	MVI	M,0
	DCR	B
	JNZ	CLREG
	LXI	H,1024			; Init memory pointer
	MVI	C,63			; K to be checked

;Start of analysis loop
BEGANA:
	LXI	D,1024			; Byte counter
	XRA	A			; Clear flag bytes
	STA	RAMF
	STA	EMPF
ANALP:
	MOV	A,M			; Get test byte and
	MOV	B,A			; store for later
	CMA
	MOV	M,A			; Put invertd tst byte
	SUB	M			; Check for good write
	MOV	M,B			; Restore orignl data
	JNZ	NOTMEM			; Wasn't good write
	INXI	RAM			; Bump memory counter
	JMP	NEXT			; To next byte

NOTMEM:
	STA	RAMF			; Not considered RAM
	MVI	A,0FFH			; Is it empty space?
	SUB	B
	JNZ	NOTEMP			; Inc ROM, set flag
	LDA	EMPF			; Any non empty space
	ANA	A			; before here?
	JZ	NEXT
	JMP	NOTEM			; To next byte
NOTEMP:
	STA	EMPF			; Set no empty flag
NOTEM:
	INXI	ROM
NEXT:
	INX	H			; Index next byte
	DCX	D			; Decrement K counter
	XRA	A
	ORA	D
	ORA	E
	JNZ	ANALP			; K counter not 0
	PUSH	B
	PUSH	H
	LDA	RAMF			; Is it RAM?
	ANA	A
	JNZ	NOTRAM			; No
	dcr	h			; drop H to make compares right
	LDA	BDOS+2			; Is it under BDOS ?
	CMP	H
	JC	NOTTPA			; No
	CALL	TYPE			; Yes, it's TPA
	DB	'T'+EOL
	JMP	NEXTK
NOTTPA:
	lda	bios+2			; is it under bios ?
	cmp	h
	jc	nbdos
	call	type			; yes, it's BDOS
	db	'C'+eol
	jmp	nextk
nbdos:
	CALL	TYPE			; Assume it's BIOS
	DB	'B'+EOL
	JMP	NEXTK
;
NOTRAM:
	LDA	EMPF			; Is it empty?
	ANA	A
	JZ	NOMEM			; Yes, no memory
	CALL	TYPE			; No, must be ROM
	DB	'R'+EOL
	JMP	NEXTK
NOMEM:
	CALL	TYPE
	DB	' '+EOL
NEXTK:
	POP	H
	POP	B
	DCR	C			; Decrement K counter
	JNZ	BEGANA
	CALL	TYPE
	DW	CRLF
	DB	'T=TPA',TAB,'C=CPM',TAB,'B=BIOS or unassigned'
	DB	TAB,'R=ROM or bad'
	DW	CRLFE
;
; contents of first page
	call	type
	db	'BIOS at',' '+eol
	hexout	bios+2
	hexout	bios+1
	call	type
	db	tab,'iobyte',' '+eol
	hexout	bios+3
	call	type
	db	tab,'drive',' '+eol
	hexout	bios+4
	call	type
	db	tab,'BDOS at',' '+eol
	hexout	bdos+2
	hexout	bdos+1
	call	type
	dw	crlf,crlfe
;
;MEMORY SYNOPSIS
	LHLD	RAM
	PUSH	H			; Save RAM
	CALL	BINDEC			; Type RAM
	CALL	TYPE
	DB	' Bytes RAM',TAB,TAB+EOL
	LHLD	ROM
	PUSH	H
	CALL	BINDEC			; Type ROM
	CALL	TYPE
	DB	' Bytes ROM',TAB,TAB+EOL
	LHLD	BDOS+1
	CALL	BINDEC
	CALL	TYPE
	DB	' Bytes in TPA'
	DW	CRLFE
	POP	D			; Get RAM
	POP	H			; Get RAM
	DAD	D			; Add 'em
	PUSH	H			; and save result
	LXI	D,0			; Subtract from this
	MOV	A,H			; Complement 16 bits
	CMA
	MOV	H,A
	MOV	A,L
	CMA
	MOV	L,A			; 2s comp bias in D
	DAD	D			; Subtract
	CALL	BINDEC
	CALL	TYPE
	DB	' Bytes Empty   ',TAB+EOL
	POP	H			; Restore RAM+ROM
	CALL	BINDEC
	CALL	TYPE
	DB	' Total Active Bytes'
	DW	CRLF,CRLF

;PORT SURVEY
	DB	'Active I/O ports',':'+EOL
	LXI	H,1000H			; DELAY SO MESSAGE OUTPUT
PDLY:
	DCX	H			; DOESN'T GIVE A FALSE READING
	MOV	A,H			; ON CONSOLE STATUS PORT
	ORA	L
	JNZ	PDLY
	LXI	H,0			; Init active port counter
	mvi	d,0			; Init port counter
	mvi	e,0ffh			; init port group variable
PORTLP:
	MOV	A,D

	IF	SKIP			; Single port mask
	CPI	SKIPORT
	JZ	ISPORT			; Print mask port
	ENDIF

	mov	b,a			; save port #
	STA	INPORT+1
INPORT:
	IN	0			; Modifiable code
; by trial and error, inactive port could return FF or echo port #
	CPI	0FFH
	JZ	NEXTPT
	cmp	b
	jz	nextpt
ISPORT:
	mov	a,d			; got a live one, probably
	ani	0f0h			; is port in same group as last ?
	cmp	e
	jz	nocrlf
	call	type			; no, start a new line
	dw	crlfe
	mov	a,d			; save for next time
	ani	0f0h
	mov	e,a
nocrlf:
	MOV	A,D			; Get port #
	PUSH	D
	PUSH	H
	HEXOUT
	POP	H
	POP	D
	INX	H			; count another one found
	call	type
	db	' '+eol
NEXTPT:
	INR	D			; Bump port counter
	JNZ	PORTLP			; Not done
	CALL	TYPE			; Done
	DW	CRLFE
	CALL	BINDEC
	CALL	TYPE			; Type Active Ports
	DB	' Ports active'
	DW	CRLFE
 CCP:
	LHLD	OLDSP
	SPHL
	RET


;***********************;
;	SUBROUTINES	;
;***********************;

;Binary to decimal conversion
BINDEC:
	DECOUT				; From LIB
	RET

;Types a string of text terminated with bit 7 high
TYPE:
	XTHL				; Get string address
	PUSH	D
TYPELP:
	MOV	A,M			; Get type data
	MOV	D,A			; Save for later
	ANI	7FH			; Mask ASCII
	MOV	E,A
	PUSH	H
	PUSH	D
	CALL	TCHR
	POP	D
	POP	H
	INX	H
	MVI	A,EOL			; End of line bit
	ANA	D
	JP	TYPELP			; Not done
	POP	D
	XTHL				; Get return address
	RET

;Types a single character on console
TCHR:
	MVI	C,2
	JMP	BDOS

;Checks sectors per block and multiplies or divides block size
;Enter with data in D. Result returned in H,L
;
SHF16:
	LDA	BLKSHF			; Get shift factor (gives block size)
	CPI	3			; Is it 1K (std)?
	JNZ	NOT3
	MOV	L,E			; Yes, use present #
ZH:
	MVI	H,0
	RET
;
NOT3:
	CPI	2			; Is it minifloppy?
	JNZ	NOT2
	MOV	A,E			; Yes, divide by 2
	RRC
	ANI	7FH
	MOV	L,A
	JMP	ZH
NOT2:
	SUI	3			; Must be something
	MOV	B,A			; larger like double
	XCHG				; sided or double dens
BITSHF:
	DAD	H			; 16 bit 2^(B-1)
	DCR	B
	JNZ	BITSHF
	RET


;***********************;
;	DATA STORAGE	;
;***********************;

FCB:	DB	0,'???????????',0,0,0	; File control block
	DS	17			; Extra FCB workspace
OLDSP:	DS	2			; Old stack pointer
RAM:	DS	2			; RAM counter
ROM:	DS	2			; ROM counter
RAMF:	DS	1			; RAM good flag
EMPF:	DS	1			; Empty so far flag
BLKSHF:	DS	1			; block shift factor
MAXALL:	DS	2			; maximum block number
FINIS	EQU	$			; End of program
	END
