;***************************************;
;					;
;		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
;
;06/24/80 - Removed MACLIB statement, included required macros
;	    in source.     Bruce R. Ratoff
;
;06/28/80 - Added IMS400 equate (prevents Industrial Micro Systems
;	    controller from hanging up during port scan).  BRR
;
;06/29/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
;
;
;

;*******************************;
;	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
IMS400	EQU	TRUE			; Industrial Micro Systems FDC
TARBAS: EQU	0F8H			; Base of Tarbell
	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
BDOS:	EQU	5			; Base of BDOS
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,TAB,'*** SYSTEM SURVEY ***'
	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	'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
	LDA	BDOS+2			; Yes, get top of TPA
	DCR	H
	CMP	H			; Compare with pointer
	JC	NOTTPA
	CALL	TYPE			; It's TPA
	DB	'T'+EOL
	JMP	NEXTK
NOTTPA: ADI	20			; Get base of bios
	JNC	EVALC
	MVI	A,0FFH
EVALC:	CMP	H
	JC	NOTCPM
	CALL	TYPE			; It's CPM
	DB	'C'+EOL
	JMP	NEXTK
NOTCPM: CALL	TYPE
	DB	'M'+EOL 		; It's just memory
	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,CRLF
	DB	'T=TPA',TAB,'C=CPM',TAB,'M=Unassigned Memory'
	DB	TAB,'R=ROM or Bad Memory'
	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'
	DW	CRLFE
	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			; Intit port counter
	LXI	D,TABS			; Init tab & port ctrs
PORTLP: MOV	A,D
	IF	TARBEL OR IMS400	; Single port mask
	CPI	SKIPORT
	JZ	ISPORT			; Print mask port
	ENDIF
	STA	INPORT+1
INPORT: IN	0			; Modifiable code
	CPI	0FFH			; Active port?
	JZ	NEXTPT			; No, get next
ISPORT: MOV	A,D			; Get port #
	PUSH	D
	PUSH	H
	HEXOUT
	POP	H
	POP	D
	INX	H
	DCR	E			; Dec tab counter
	JNZ	TAB1
	MVI	E,TABS			; Reset tab counter
	CALL	TYPE
	DW	CRLFE
	JMP	NEXTPT			; Get next port
TAB1:	CALL	TYPE			; Tab out 1
	DB	TAB+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