;
;  PROGRAM:  Z3LOC
;  AUTHOR:  RICHARD CONN
;  VERSION:  1.0
;  DATE:  18 MAY 84
;  PREVIOUS VERSIONS:  None
;  DERIVATION:	CCPLOC 1.1 (6 Jan 83)
;
;VERS	EQU	10

; Version 1.5 by Joe Wright  14 Feb 88
; Report names of the RSX and IOP.

; Version 1.4 by Joe Wright  27 Jan 88
; In deference to Howard Goldstein's release of 1.3, this is 1.4

; Version 1.3 by Joe Wright
; Added local stack.  CP/M CCP doesn't have enough stack for us.
; NZ-COM support added.
; Re-ordered the various reports in NZ-COM sequence.
; Added elements/size to Shell Stack report.
; Test for 'extended' environment.  Report from there if so.
;  Extended Z3ENV has bit 7 of byte 8 set to 1.
; Cleaned up some code.

; Version 1.2 by Bruce Morgen, to report addresses correctly,
; specifically no longer rely on the BDOS jump vector, which
; is too often munged by an RSX of some kind to be at all
; trustworthy.	Added RSX display line (if one is detected).
; Display lengths of FCP, RCP, NDR, command line, and path.
; Display DateStamper address if DS is running.  Display CPU
; type after BIOS address.  Display decent guess at CCP type
; after its address, ditto ZRDOS or CP/M version number.
; Refuse "Z" option if Z3LOC is uninstalled or running in a
; non-Z3 environment.  Z3LOC12.MAC assembles with Kluger-
; modified RMAC, M80 or (probably) SLRMAC, any 8080-compatible
; versions of Z3LIB and SYSLIB should link up just fine.

;
vers	equ	19
; Version 1.9 by Bruce Morgen, February 23, 1990
;  Shrunk the thing back down a bit.  Just 'cuz SYSLIB 3.6 has no
;  DSEG doesn't mean we can't put our stack there.  Used relative
;  jumps where we're SURE to have a Z80-compatible CPU, Z80.LIB
;  now required for M80 or RMAC (SLRMAC has it "built-in").  A
;  two-pass linker is now required to re-build Z3LOC, a one-pass
;  tool like PROLINK will add 50 bytes to the COMfile, pushing it
;  back over 2K.  The program banner now shows the "official"
;  tool name (Z3LOC), the syntax help message still uses the EFCB
;  name when available.  This is in accordance with standard
;  practice in the toolset.  Otherwise v1.9 is functionally and
;  cosmetically identical to v1.8, but its COMfile is 2 records
;  shorter (2K) when linked with SYSLIB 3.6 (the last version
;  where the routines we reference are 8080-compatible).  An
;  "RMAC" equate has been added since that assembler won't accept
;  a "MACLIB" directive where there is a filetype, and M80 won't
;  work without that filetype (SLRMAC probably won't care).
;
false	equ	0
true	equ	not false
rmac	equ	false		; true for RMAC, false for M80
				; (SLRMAC probably doesn't care.)
;vers	equ	18
; Version 1.8 by Joe Wright
;  Changed order around so that SHSTK is before Z3ENV.
;  Changed RSX calculation for variable CCP and DOS sizes.

;vers	equ	17
; Version 1.7 by Joe Wright
;  Added intelligent 'help' so that re-naming of this file shows up
;   in the banner and help messages.  Re-formatted help message.
;  Renamed TOP-1 message to CBIOS and print it only if extended ENV.

;vers	equ	16		; March 19, 1988
; Version 1.6 by Cameron W. Cotrill
;  Changed DOS ID to use enhanced BDOS version function and report
;   ZRDOS, ZSDOS, Z80DOS, or ZOS properly.


; Version 1.4 by Joe Wright
; Howard Goldstein released 1.3 earlier, hence the change.

;VERS	EQU	15		; February 14, 1988
; Report names of RSX and IOP

;vers	equ	14		; January 27, 1988

; Version 1.3 by Joe Wright
;  Z3LIB no longer used, link with SYSLIB only

;vers	equ	13		; January 19, 1988

; Version 1.2 by Bruce Morgen

;vers	equ	12		; January 12, 1988

; Version 1.1 by Joe Wright, to report addresses correctly

;vers	equ	11

;
;	Z3LOC -- ZCPR3 Environment Element Locator
;
;	The purpose of Z3LOC is to locate the addresses of the running
; ZCPR3 CCP, BDOS, and BIOS, and to display these values to the user.
; If the Z option is given, the addresses of the following system elements
; are also presented:
;
;		External Path
;		RCP
;		IOP
;		FCP
;		RSX (if one is active)
;		Named Directory
;		Command Line Buffer
;		Shell Stack
;		Environment Descriptor
;		External FCB
;		ZCPR3 Message Buffer
;		External Stack
;		Wheel Byte
;

;
;  CP/M Constants
;
base	equ	0		; Cp/m base page
bdose	equ	5		; Bdos entry
fcb	equ	5ch		; Default file control block
cr	equ	0dh
lf	equ	0ah
tab	equ	9
idoff	equ	5bh
zrdosv	equ	48

	 if	rmac
	maclib	Z80		; Z80 opcodes used (where safe)
	 else			; if not rmac (e.g.: M80)
	maclib	Z80.LIB		; Z80 opcodes used (where safe)
	 endif	;rmac
;
;  Externals
;
	public cout		; Forces console routines to use bout

;  Only SYSLIB is used (version 3.6 or earlier for 8080 compatibility)

	extrn eprint,epstr,pa2hc,phl4hc,bout,bdos,crlf,pafdc,comphd

;
; Environment Definition
;
; External ZCPR3 Environment Descriptor
;
	jmp	start
	db	'Z3ENV'		; This is a zcpr3 utility
	db	1		; External environment descriptor
z3eadr:
	dw	0		; Installed by z3ins or z33+
start:
	lxi	h,0		; Clear hl
	dad	sp		; Hl=sp
	shld	stack		; Save ccp stack pointer
	lxi	sp,stack	; Establish our own
	lxi	h,exit		; Our exit address
	push	h		; On the stack so ret same as jmp exit

	lhld	z3eadr		; Pt to zcpr3 environment
	mov	a,h
	ora	l
	jz	noins		; Not installed (envtyp remains 0)
;
	lxi	d,8
	dad	d		; Point to environment type
	mov	a,m		; Pick it up
	sta	envtyp		; Save env type

noins:	call	pnam0

isins:	call	eprint
	db	', Version ',(vers/10)+'0','.',(vers mod 10)+'0'
	db	'  Z-System Address Locator',0
	lda	fcb+1		; Check for help
	cpi	'Z'		; Z is only option
	jz	start1
	cpi	' '		; No option?
	jz	start1

help:	call	eprint
	db	cr,lf,'  Syntax:',0
	call	crlfsp
	call	pname
hlp1:	call	eprint
	db	cr,lf,'      Gives the addresses of the CCP, BDOS, BIOS, and,'
	db	cr,lf,'      if active, the lowest RSX and the DateStamper.',0
	call	crlfsp
	call	pname
hlp2:	call	eprint
	db	' Z'
	db	cr,lf,'      Adds all key ZCPR3 addresses.',0
	ret

start1:	sta	z3flag		; A non-zero to zcpr3 flag
	call	eprint
	db	cr,lf,'System  Elements   Base  Addresses'
	db	cr,lf,0
	mvi	b,16
	mvi	a,'-'
	call	rptchr
	mvi	b,3
	call	bspcs
	mvi	b,15
	mvi	a,'-'
	call	rptchr

	call	extst		; Test for extended z3env, carry if so.
	jnc	s0

	mvi	e,63
	call	getdata
	jmp	s1

s0:	lhld	base+1		; Bios wm. boot jump vector
	lxi	d,-1603h	; Offset to ccp entry
	dad	d		; Hl pts to ccp

s1:	call	crlfsp
	call	eprint
	db	'CCP',0
	call	p2tabs
	call	prdata
	call	ccptyp

	call	extst		; Test for extended z3env, carry if so.
	jnc	s2

	call	ptab
	mvi	e,63
	call	getdata
	call	pdigit
	call	precs

	mvi	e,66
	call	getdata
	lxi	d,6
	dad	d
	jmp	s3

s2:	lhld	base+1		; Bios warm boot entry
	lxi	d,-(0e00h-3)
	dad	d

s3:	call	crlfsp
	call	eprint
	db	'BDOS',0
	call	ptab
	call	prdata
	call	zrdosq

	call	extst		; Test for extended z3env, carry if so.
	jnc	s4

	call	ptab
	mvi	e,66
	call	getdata
	call	pdigit
	call	precs

	mvi	e,69
	call	getdata
	jmp	s5

s4:	lhld	base+1		; Warm boot entry
	mvi	l,0		; Page boundary

s5:	call	crlfsp
	call	eprint
	db	'BIOS',0
	call	ptab
	call	prdata
	call	cputst

	call	extst		; Test for extended z3env, carry if so.
	jnc	s6
;
; Check the bios for the NZ-COM ID.
;
	lhld	base+1		; Bios base
	mvi	l,90		; Offset to potential id
	lxi	d,nzcid		; Local id (below)
	mvi	b,6		; Six bytes to check

nzchk:	ldax	d		; Get the byte at (de)
	cmp	m		; Compare it with (hl)
	jnz	s6		; Not nz-com
	inx	d
	inx	h		; Bump the pointers
	dcr	b		; Decrement the count
	jnz	nzchk		; Next..

	call	ptab		; Avoid eprint's tab counter
	call	parens
	call	eprint
nzcid:	db	'NZ-COM)',0	; First 6 bytes double as id

s6:	lda	2		; Bios page
	sbi	22		; CP/M CCP page
	mov	c,a		; Save it
	lhld	bdose+1		; Protected page to H
	call	extst
	mov	a,c		; CCP page
	jnc	s6a		; If not extended

	push	h
	mvi	e,63		; CCP offset
	call	getdata
	mov	a,h		; CCP page
	pop	h

s6a:	cmp	h
	jc	norsx		; Protected page is above CCP

	call	crlfsp
	call	eprint
	db	'RSX (lowest)   ',0
	call	hdata
;
; Come here with protected memory address in HL.  Assume P*P header
; and report names of all RSX's.
;
prsx:	push	h		; Save address of first module
	lxi	d,9		; Offset to wboot in header
	dad	d
	mov	e,m
	inx	h
	mov	d,m
	lhld	1		; Warm boot address from page 0
	mov	a,l
	sub	e
	mov	a,h
	sbb	d
	pop	h
	jnz	norsx		; Not a p*p header, quit
;
	push	h		; Save address again
	lxi	d,13		; Offset to address of name
	dad	d
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	call	modname
	pop	h		; Address of this module
	lxi	d,16		; Offset to wbent target
	dad	d
	mov	e,m
	inx	h
	mov	d,m		; Pick it up
	lxi	h,-3		; Offset to top of next rsx
	dad	d
	jmp	prsx		; Try again

norsx:
	call	dschek
	jnz	nods
	call	crlfsp
	call	eprint
	db	'DateStamper    ',0
	call	hdata
nods:
	call	crlf		; New line
	lda	fcb+1		; Check for z option
	cpi	'Z'
	rnz			; Done if not z

	lda	z3flag
	ora	a
	jz	isz3
	call	eprint
	db	cr,lf,'Non-ZCPR3 system or Z3LOC is uninstalled',0
	ret

isz3:	call	crlfsp
	call	eprint
	db	'IOP',0
	call	p2tabs
	mvi	e,15
	call	z3data
	jz	noiop

	push	d
	push	psw
	lxi	d,35h
	dad	d		; Point to iop name
	mvi	b,8		; Eight characters max
	call	modnam
	pop	psw
	pop	d

	call	pdigit
	call	precs

noiop:	call	crlfsp
	call	eprint
	db	'RCP',0
	call	p2tabs
	mvi	e,12
	call	z3data
	jz	norcp
	call	pdigit
	call	precs

norcp:	call	crlfsp
	call	eprint
	db	'FCP',0
	call	p2tabs
	mvi	e,18
	call	z3data
	jz	nofcp
	call	pdigit
	call	precs

nofcp:	call	crlfsp
	call	eprint
	db	'NDR',0
	call	p2tabs
	mvi	e,21
	call	z3data
	jz	nondr
	call	pdigit
	call	eprint
	db	' names)',0

nondr:	call	crlfsp
	call	eprint
	db	'SHSTK',0
	call	ptab
	mvi	e,30
	call	z3data
	jz	noshl
	call	pdigit
	mvi	a,' '
	call	bout
	inx	d
	ldax	d
	call	pafdc
	call	eprint
	db	'-byte entries)',0

noshl:
	call	eprint
	db	cr,lf,lf,'    Z3ENV',tab,0
	mvi	e,27		; Offset to env descriptor element
	call	z3data

	call	eprint
	db	' (Type ',0
	lda	envtyp
	call	pa2hc
	call	eprint
	db	'h)',0

isz4:	call	crlfsp
	call	eprint
	db	'Z3TCAP',0
	call	ptab
	lhld	z3eadr
	lxi	d,128
	dad	d
	call	prdata
	mov	a,m		; First byte of tcap
	cpi	' '+1
	cnc	modname
	call	crlfsp
	call	eprint
	db	'Z3MSG',0
	call	ptab
	mvi	e,34
	call	z3data

	call	crlfsp
	call	eprint
	db	'EXTFCB',0
	call	ptab
	mvi	e,36
	call	z3data

	call	crlfsp
	call	eprint
	db	'EXPATH',0
	call	ptab
	mvi	e,9
	call	z3data
	jz	nopath
	call	pdigit
	call	eprint
	db	' elements)',0
;
nopath:	call	crlfsp
	call	eprint
	db	'Z3WHL',0
	call	ptab
	mvi	e,41
	call	z3data
	jz	nowhl

	call	eprint
	db	' (O',0
	mov	a,m		; Get wheel byte
	ora	a
	mvi	a,'n'
	jnz	exwhl		; Wheel on
	mvi	a,'f'
	call	bout
exwhl:	call	bout
	call	ecap

nowhl:	call	crlfsp
	call	eprint
	db	'Z3CL',0
	call	ptab
	mvi	e,24
	call	z3data
	jz	noz3cl

	call	pdigit
	call	eprint
	db	' chars)',0

noz3cl:	call	crlfsp
	call	eprint
	db	'EXTSTK',0
	call	ptab
	mvi	e,38
	call	z3data

	call	extst
	rnc			; Return if no extended z3env

	call	crlfsp
	call	eprint
	db	'CBIOS',0
	call	ptab
	lhld	z3eadr
	inx	h
	inx	h
	mov	h,m
	mvi	l,0
	jmp	prdata

pname:	mvi	e,36
	call	getdata
	mov	a,h
	ora	l
	jnz	pnam1
pnam0:	call	eprint
	db	'Z3LOC',0
	ret
pnam1:	mvi	b,8
pnam2:	inx	h
	mov	a,m
	ani	7fh
	cpi	' '
	cnz	cout
	dcr	b
	jnz	pnam2
	ret

modname:
	mvi	b,0		; 256 characters max

modnam:	call	parens		; Quit after b characters

pcap:	mov	a,m
	inx	h
	cpi	' '+1
	jc	ecap
	push	psw
	ani	7fh
	call	bout
	pop	psw
	ora	a
	jm	ecap
	dcr	b
	jnz	pcap
	jmp	ecap

;
;  Z3DATA -- Print Data Fields for a ZCPR3 Element
;
z3data:
	call	getdata
;
;  PRDATA -- Print Data Field (Base Address)
;
prdata:
	mvi	b,3
	call	bspcs
	mov	a,l
	ora	h
	jnz	hdata
	call	eprint
	db	'[Not implemented]',0
	ret
;
getdata:
	lhld	z3eadr		; Pt to environment
	mvi	d,0
	dad	d		; Fall thru to prdata
	mov	e,m		; Get address
	inx	h
	mov	d,m
	xchg
	inx	d		; Point de to size byte
	ldax	d		; Return it in a
	ret
;
hdata:	call	phl4hc		; Print full address
hprint:	mvi	a,'h'
	call	bout
	ldax	d		; Get size byte in a
	ora	a
	ret

pdigit:	call	parens
	jmp	pafdc

crlfsp:	call	crlf
	mvi	b,4
bspcs:	mvi	a,' '
;	FALL	THROUGH
; Print contents of A, B times
rptchr:	call	bout
	dcr	b
	jnz	rptchr
	ret

; Check for ZCPR 3.3 or later and for BGii, display if found
ccptyp:
	push	h		; Save incoming hl (ccp addr)
	lhld	z3eadr		; Get environment pointer
	mov	a,l		; Test for 0000h
	ora	h
	jnz	doz3ck		; Then it's not z3 or z3loc n/g
	dcr	a		; So make psw nz
	jmp	dobgck		; Go do bgii stuff
doz3ck:
	lxi	d,27		; Offset to env pointer in env
	push	h		; Save our original pointer
	dad	d		; Make pointer-to-pointer
	mov	e,m		; Get env pointer into de
	inx	h
	mov	d,m
	pop	h		; Get back original pointer
	call	comphd		; Compare them
dobgck:
	pop	h		; Get back incoming hl
	push	h		; Re-save it on stack
	inx	h		; Adjust ccp pointer
	inx	h
	inx	h
notz3:
	jnz	ifcbg		; Do check for backgrounder ii
	xra	a
	sta	z3flag
	mov	a,m
	cpi	18h
	jnz	ifcbg
	call	eprint
zcprp:	db	' (ZCPR',0
	inx	h
	inx	h
	mov	l,m
	call	prnz33
	pop	h
	ret

; Adapted from Jay Sage's COMIF:
;
ifcbg:
	lxi	d,idoff-3	; Offset to 'BGii' id string in BG cpr
	dad	d
	lxi	d,idstr		; Point to reference id string
	mvi	b,idlen		; Length of id string
bgchk1:
	ldax	d		; Get reference character
	cmp	m		; Compare to actual character
	jnz	bgfals		; Set false if mismatch
	inx	h		; Move to next characters
	inx	d
	dcr	b
	jnz	bgchk1		; Loop through all characters
	call	eprint
	db	' ('
idstr:	db	'BGii'
idlen	equ	$-idstr
	db	')',0
bgfals:	pop	h
	rz
	push	h
	lda	z3flag
	ora	a
	jnz	earlyz
	mvi	a,30h
przcpr:	lxi	h,zcprp
	call	epstr
	mov	l,a
	call	prnz33
	pop	h
	ret

earlyz:	inx	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	inx	h
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	call	comphd
	jnz	nozcpr
	mvi	a,0ffh
	jmp	przcpr

nozcpr:	mvi	c,0ch
	call	bdos
	pop	h
	jmp	dricpm



; Adapted and cleaned up from DOSVER02 by D. McCord
; Further kludged by C. Cotrill for new universal enhanced BDOS IDs
; Re-kludged for compactness by B. Morgen
zrdosq:
	mvi	c,0ch		; Return version function
	call	bdos
	cpi	22h
	jnz	dricpm
	mvi	c,zrdosv
	call	bdos		; Get dos ver #
	mov	a,l
	ora	h		; Is it 0?
	jnz	isedos
cpm22:
	mvi	a,22h
dricpm:
	call	eprint
	db	' (CP/M',0
	mov	l,a
	jmp	prnz33

isedos:	mov	a,h		; Ok, we have an enhanced dos
	ana	a		; ..see if it's zrdos
	jz	iszrd		; If it is
	cpi	'S'		; Else check for zsdos
	jz	iszsd		; If id = 'S', we found it
	cpi	'D'		; Else check for zsdos
	jz	iszdd		; If id = 'D', we found it
	cpi	'8'		; Test for z80dos
	jz	isz8d		; If id = '8', it's z80dos
	cpi	'O'		; Test for zos
	jz	iszos		; If id = 'O', it's zos
	call	eprint
	db	' (UNKNOWN BDOS - ID: ',0
	call	pa2hc		; Display id
	call	hprint		; And "h" trailer...
	jmp	prnz33
iszsd:	call	eprint
	db	' (ZS',0
	jr	prndos
iszdd:	call	eprint
	db	' (ZD',0
	jr	prndos
isz8d:	call	eprint
	db	' (Z80',0
	jr	prndos
iszos:	call	eprint
	db	' (ZOS',0
	jr	prnz33
iszrd:	call	eprint
	db	' (ZR',0
prndos:	call	eprint
	db	'DOS',0
;
prnz33:
	mvi	a,' '
	call	bout
	mov	a,l
	rrc			; Move to proper position
	rrc
	rrc
	rrc
	call	prndig
	mvi	a,'.'		; Period
	call	bout
	mov	a,l
	call	prndig
ecap:	mvi	a,')'
	jmp	bout
;
;  COUT is declared PUBLIC (above) so that SYSLIB routines use
;   BDOS Function 2 instead of BIOS for console output.
;
p2tabs:	call	ptab
ptab:	mvi	a,tab
;	FALL	THROUGH
cout:	jmp	bout

prndig:	ani	0fh
	adi	'0'
	jmp	bout

parens:	call	eprint
	db	' (',0
	ret

; Adapted from TM-DS10.Z80 by Jim Lill
; Saved a byte for v1.9, Bruce Morgen
dschek:
	mvi	e,'D'		; Datestamper id character
	mvi	c,0ch		; Return version function
	call	bdose
	add	l		; Must be CP/M 2.2 (A = L = 22h)
	cmp	h		; Must be 44h, as should H if DS
	rnz			; If not equal, return NZ
	cpi	'D'		; Confirm it's really 44h
	rnz			; If not, return nz
	xchg			; Get time subroutine addr into hl
	ret			; Return z showing success

cputst:
	call	parens
	sub	a		; Bob Freed's Z80 test
	jpe	eighty
	lxi	b,0101h		; My HD64180 test
	db	0edh,04ch	; 64180's "MLT BC", Z80 ignores
				; 64180 will make B = 0, so if B
	djnz	hitachi		; still has a 1, we're a Z80
	call	eprint
	db	'Z80/NSC800)',0
	ret
hitachi:
	call	eprint
	db	'HD64180/Z180)',0
	ret
eighty:
	call	eprint
	db	'8080/8085)',0
	ret

precs:	call	eprint
recs:	db	' recs)',0
	ret

extst:	lda	envtyp
	ora	a
	rz
	ral			; Extended type sets carry
	ret

exit:	lhld	stack
	sphl
	ret

envtyp:	db	0

z3flag:	db	0


	dseg

	ds	48
stack:	ds	2

	end