	.title	'Print the list of current Network users'
	.sbttl	'WHO'
version	==	3
revision==	0
;----------
; Originally written by Dave Stein, Nov 1980
;  Modified by Peter Kavaler (version 3)
;  to print spool information
;----------
        .pabs
	.phex
	.loc	100h
	sspd	saveSP
	lxi	sp,stack	;stack at end of prog.
	jmp	START
saveSP:	.word	0
retCCP:
	lspd	saveSP
	ret
;
; BIOS Network jump addresses.  Filled in during START.
SENDNET:  jmp	0000h	; HiNET send 
RECVNET:  jmp	0000h	; HiNET receive 
Ackpoll:  jmp	0000h	; Acknowledge polls enable
Nackpoll: jmp	0000h	; Acknowledge polls disable
WBOOT	=	00h	; Bios entry point location
WBaddr	=	01h     ; Warm boot location
;
;Data Memory locations
numusr	=	32	; number of users
curdrive=	04	; current drive number
BIOSsec	=	41h	; BIOS maintained time
BIOSmin	=	42h
BIOShrs	=	43h	
usernum =	47h	; assigned user number loc
userlist=	4000h	; addr of user table
spoollist=	4200h	; addr of spool table
numspl	=	16	; number of spool jobs
whoNET	=	10h	; Network 'who' command
NETcmd:	.byte	00h	; byte for Network Master

cr	=	0Dh	; Ascii carriage return
lf	=	0Ah	; Ascii line feed

LOGmsg: .ascii	[cr][lf]'Who version '
	.byte	version+'0','.'
	.byte	revision/10+'0',revision@10+'0'
	.asciz	[cr][lf]
TIMEmsg:.ascii	[cr][lf]
	.asciz	'           HiNet Status as of '
notnet: .asciz	'Must log into HiNet before using WHO'
START:
; Check whether logged into net
	lda	47h	; get user number
	cpi	0FFh
	jrnz	..ok
	lxi	H,notnet
	call	PRTMSG	; not on net
	jmp	retCCP
; Print the log-on message
..ok:
	lxi	H,LOGmsg ; Print log-on message
	call	prtmsg
	lxi	H,TIMEmsg; Print time message
	call	prtmsg
	lda	BIOShrs	 ; Get the current hour
	sta	hours	 ; and store for printing.
	lda	BIOSmin	 ; Get the current minute
	sta	minutes	 ; and store for printing.
	lda	BIOSsec	 ; Get the current second
	sta	seconds	 ; and store for printing.
	call	prttime	 ; Print the time.
;
; Initialize BIOS subroutine jump addresses.
	lded	WBaddr	; DE = Warm boot address
	lxi	H,6Ch
	dad	D
	shld	SENDNET+1  ; jump address to SENDNET
	lxi	H,6Fh
	dad	D
	shld	RECVNET+1  ; jump address to RECVNET
	lxi	H,75h
	dad	D
	shld	Ackpoll+1  ; jump address to Ackpoll
	lxi	H,72h
	dad	D
	shld	Nackpoll+1 ; jump address to Nackpoll
;----------
; Determine if this program is being executed on the
; Network Master.  If we are on the Master, then
; the user table is already in memory.  We copy
; it into our userlist and print it out.
; are on a Network Station, then send the whonet
; command, receive the userlist from the
; Network, and print out the userlist.
;					D. Stein
;					11/7/80
	lda	usernum
	cpi	00	; are we on the master?
	jrz	MASTER	; Yes.
	jnz	SLAVE	; No.
MASTER:
	lxi	H,0FC00h   ; HL = table addr in Bios
	lxi	D,userlist ; DE = our userlist addr
	lxi	B,numusr*16; BC = length of table
	ldir		; Copy from BIOS to userlist
	lxi	H,0F500h
	lxi	D,spoollist
	lxi	B,numspl*16
	ldir
	jmp	PRTTABL	; print out user list
SLAVE:
	call	NACKpoll
	bit	7,A	; is network operational?
	jrz	NETdead	; No. Die.
;
; Send WHO request to master
	mvi	A,0	; load Masters user number
	lxi	B,1	; length of our data
	lxi	H,NETcmd; Our data addr
	mvi	M,whoNET; Load the 'whoNET' byte
	call	SENDNET	; and send it over the network.
;
; Get user table
	lda	usernum	; get our user number
	lxi	H,userlist ; Our destination addr
	lxi	B,numusr*16; max num of bytes to recv
	call	RECVNET	; Get the user list from Master
	bit	7,A	; is network still operational?
	jrz	NETdead	; No. Die.
;
; Get spool table
	lda	usernum
	lxi	H,spoollist
	lxi	B,numspl*16
	call	RECVNET
	bit	7,A
	jrz	NETdead
;
; Re-ack polls, then process tables
	call	ACKpoll	; Yes.Resume poll acknowledging
	jmp	PRTTABL	; and print out the user list
;----------
; Utility Exit Routine for Network down times.
NETdead:
	lxi	H,deadMSG
	call	prtmsg
	jmp	WBOOT	; Network is down so warm boot.
deadMSG:.asciz	[cr][lf]'The HiNet is not operational.'
	.page
;----------
; Routine: PRTTABL
;
unit:	.byte	00h	; unit number of entry in table
status:	.byte	00h	; status of entry in stable
HEADmsg:.ascii	[cr][lf]'User Name   Login Time   '
	.ascii	'Last HiNet Request   Status'
	.ascii	[cr][lf]'---------   ----------   '
	.asciz	'------------------   ------'
SPLmsg:	.ascii	[cr][lf]'User Name   Spool Time   '
	.ascii	'File Length   Status'
	.ascii	[cr][lf]'---------   ----------   '
	.asciz	'-----------   ------'
actMSG:	.asciz	'active'
nactMSG:.asciz	'******'
crlf:	.asciz	[cr][lf]
;
prtTABL:
	mvi	A,0
	sta	unit		; re-initialize 
	lxi	H,crlf
	call	prtmsg
	lxi	H,HEADmsg
	call	prtmsg		; print table header

..1:	lxi	H,userlist	; HL = addr of table
	mvi	B,16		; B = bytes per line
	lda	unit		; A = line to find
	call	ADDRfind	; HL returns with addr
	call	prtline		; Print a line in table
	lda	unit
	inr	A		; increment the line
	sta	unit
	cpi	numusr		; All users checked?
	jrc	..1		; No.  Loop back.
	lxi	H,crlf		; Yes.
	call	prtmsg		; space down a line
;
; See if any entries in spool table
	lxi	H,spoollist
	lxi	D,16
	mvi	B,numspl
..look:	mov	A,M
	cpi	0E5h
	jrnz	..ok
	dad	D
	djnz	..look
	jmp	..exit	; no spool files, so return
;
; Print spool table
..ok:	mvi	A,0
	sta	unit
	lxi	H,SPLmsg
	call	PRTmsg
..2:	lxi	H,spoollist
	mvi	B,16
	lda	unit
	call	ADDRfind
	call	prtspool
	lda	unit
	inr	A
	sta	unit
	cpi	numspl
	jrc	..2
	lxi	H,crlf
	call	PRTMSG
..exit:	lxi	H,crlf
	call	PRTMSG
	jmp	retCCP		; ALL FINISHED
	.page
;----------
; Print one spool table entry
prtspool:
	mov	A,M	; get status byte
	sta	status
	cpi	0E5h
	rz		; return if empty
	push	H
	lxi	H,crlf	; skip to next line
	call	PRTMSG
	pop	H
	push	H
	lxi	B,8
	dad	B	; point to spool user name
	mov	A,M
	cpi	20h	; check for blank name
	jrnz	..ok1
	lxi	H,blkname
	call	prtmsg	; print "Unknown" if no name
	jmpr	..ok2
..ok1:
	mvi	B,8
	call	prtchr	; print spool user name
..ok2:
	pop	H
	inx	H	; skip status and user number
	inx	H
	mvi	B,5
	call	spaces
	lxi	D,seconds
	lxi	B,3
	ldir
	call	prttime
	mvi	B,3
	call	spaces
	mov	C,M	; track
	inx	H
	inx	H
	mov	E,M	; sector
	call	prtlen	; print spool file length
	mvi	B,3
	call	spaces
	lda	status
	cpi	6
	jrc	..ok
	mvi	A,6
..ok:	lxi	H,spltab
	mvi	D,0
	mov	E,A
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	mvi	B,8
	call	prtchr
	ret
blkname:.asciz	'Unknown '
spltab:	.ascii	'starting'
	.ascii	'spooling'
	.ascii	'ready   '
	.ascii	'printing'
	.ascii	'finished'
	.ascii	'waiting '
	.ascii	'unknown '
;----------
; Print spool file length
;  Regs in:  C  = track
;	     E  = sector
prtlen:
	mov	A,C
	ani	0Fh
	mov	B,A	; B = number of 16K tracks
	mvi	C,0
	srlr	B
	rarr	C
	mov	L,E
	mvi	H,0
	dad	B
	dcx	H
	dcx	H	; subtract for spool table
	call	cvthlbcd
	push	D
	mov	A,D
	call	PRTby1	; print high byte
	pop	D
	mov	A,E
	call	PRTby2	; print low byte
	lxi	H,..recs
	call	PRTMSG
	ret
..recs:	.asciz	' records'
	.page
;----------
; Print one user table entry
prtline:
	mov	A,M		; get the status
	sta	status		; store the status
	cpi	32		; Entry on this line?
	rc			; No. Return
	push	H
	lxi	H,crlf		; space down a line
	call	prtmsg
	pop	H		; HL = status byte addr
	inx	H		; HL = 8 chr name addr
prtN:	
	mov	A,M
	cpi	20h	; if name is blank, unknown
	jrnz	..ok1
	push	H
	lxi	H,noname
	call	prtmsg
	pop	H
	lxi	D,11
	dad	D
	jmpr	..ok2
..ok1:
	mvi	B,8
	call	prtchr		; print 8 chr name
	inx	H		; next addr in table
	mvi	B,5
	call	spaces	; skip 5 spaces
	lxi	D,seconds
	lxi	B,3
	ldir
	call	prttime	; print login time
	mvi	B,5
	call	spaces	; skip 5 spaces
..ok2:
	inx	H
	inx	H
	mov	A,M
	cpi	20h	; if blank, skip
	jrnz	..ok3
	mvi	B,10	; spaces instead of time
	call	spaces
	inx	H	; skip to request
	jmpr	..ok4
..ok3:
	dcx	H
	dcx	H
	lxi	D,seconds
	lxi	B,3
	ldir
	call	prttime	; print last request time
	mvi	B,2
	call	spaces	; skip 2 spaces
..ok4:
	mov	A,M
	sui	10h	; net commands start at 10h
	jrc	..unknown
	cpi	11h	; and end at 1Fh (20h is bad)
	jrc	..ok
..unknown:
	mvi	A,11h	; unknown command
..ok:
	lxi	H,reqtab
	mvi	D,0
	mov	E,A
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D
	dad	D	; address of request name
	mvi	B,8
	call	prtchr	; print request name
	mvi	B,2
	call	spaces	; skip 2 spaces
	lda	status		; Get the entry status
	lxi	H,actMSG	; Load active message
	cpi	0FFh		; Is it active?
	jrz	..1		; Yes. Print active msg
	lxi	H,nactMSG	; No. Load inactive msg
..1:	call	prtmsg		; and print the message.
	ora	A		; Clear A,
	ret			; and return
;----------
; Request name table
reqtab:
	.ascii	'who     '
	.ascii	'read    '
	.ascii	'write   '
	.ascii	'login   '
	.ascii	'startspl'
	.ascii	'read    '
	.ascii	'stopspl '
	.ascii	'assign  '
	.ascii	'hog     '
	.ascii	'lock    '
	.ascii	'unlock  '
	.ascii	'clrlock '
	.ascii	'spool   '
	.ascii	'??????  '
	.ascii	'??????  '
	.ascii	'??????  '
	.ascii	'unknown '	; unknown command
noname:	.asciz	'Unknown     Sys reboot    '; no name
;----------
; Print variable number of spaces
spaces:
	push	H	; save callers HL
	lxi	H,blanks
	call	prtchr	; B = number of spaces to print
	pop	H
	ret
blanks:	.ascii	'            '
;---------
;		Subroutine: ADDRfind
; Regs  in:    A = A line in table whose addr is needed
;	       B = Bytes per line of the table
;	       HL= addr of the start of the table
; Regs out:    HL= Addr of that line
ADDRfind:
	mvi	D,0
	mov	E,A
..mult:	dad	D	; HL = HL + A*B
	djnz	..mult
	ret
;----------
; Subroutine: PRTTIME
;
; Print the time as represented by these bytes.
;
seconds:.byte	00h
minutes:.byte	00h
hours:	.byte	00h
;----------
; Print the time as represented by the above bytes.
; This program is used in conjunction with the TIMERopt
; option of the BIOS on the DSC/3 and DSC/4.
; The BIOS maintains the time in locations 40h-43h.
;
PRTTIME:
; Print the hours
	lda	hours
	call	cvtbcd
	;is leading 0 necessary?
	cpi	10
	jp	bb1
	push	PSW
	mvi	A,'0'
	call	CONOUT
	pop	PSW
	;
bb1:	call	prtbyt
	mvi	A,':'
	call	CONOUT	
;
; Print the minutes
prtmin:	lda	minutes
	call	cvtbcd
	;is leading 0 necessary?
	cpi	10
	jp	bb2
	push	PSW
	mvi	A,'0'
	call	CONOUT
	pop	PSW
	;
bb2:	call	prtbyt
	mvi	A,':'
	call	CONOUT
;
; Print the seconds
prtsec:	lda	seconds
	call	cvtbcd
	;is leading 0 necessary?
	cpi	10
	jp	bb3
	push	PSW
	mvi	A,'0'
	call	CONOUT
	pop	PSW
	;
bb3:	call	prtbyt
	ret		; date and time printed out.

;----------
; SUBROUTINES
;----------
; Print a message on the console
;  Regs in:   HL = address of string (ended by null)
;  Regs out:  none
;  Destroyed: A, HL
prtmsg:
	mov	A,M
	ora	A
	rz
	call	CONOUT
	inx	H
	jmpr	prtmsg
;----------
;		Subroutine: prtchr
; Regs  in:	B =length of string
;		HL=addr of string
; Regs out:	HL=addr of last chr printed
;Destroyed:	B,A
;Print a specified number of chrs to the console
prtchr:
	mov	A,M
	call	CONOUT
	dcr	B
	mov	A,B
	cpi	0	; all B chrs printed?
	rz
	inx	H	; next chr addr
	jmpr	prtchr	
;----------
; Print a byte on the console
;  Regs in:   A = byte to be printed
;  Regs out:  none
;  Destroyed: A
prtbyt:
	push	PSW
	rrc
	rrc
	rrc
	rrc
	ani	0Fh	
	jrz	..1	; dont print leading zeros
	call	prtnbl
..1:	pop	PSW
prtnbl:	ani	0Fh
	adi	'0'
	cpi	'9'+1
	jrc	CONOUT
	adi	'A'-('9'+1)
	jmpr	CONOUT
;----------
; Print a byte on the console
;  (print blanks instead of leading zeros)
;  Regs in:   A = byte to be printed
;  Regs out:  none
;  Destroyed: A
prtby1:
	push	PSW
	rrc
	rrc
	rrc
	rrc
	ani	0Fh	
	jrz	..prtblk
	call	..prtnbl
	pop	PSW
..prtnbl:ani	0Fh
	adi	'0'
	cpi	'9'+1
	jrc	CONOUT
	adi	'A'-('9'+1)
	jmpr	CONOUT
..prtblk:mvi	A,' '
	call	CONOUT
	pop	PSW
	ani	0Fh
	jrnz	prtnbl
	mvi	A,' '
	jmp	CONOUT
;----------
; Print a byte on the console
;  (Do print leading zeros)
;  Regs in:   A = byte to be printed
;  Regs out:  none
;  Destroyed: A
prtby2:
	push	PSW
	rrc
	rrc
	rrc
	rrc
	ani	0Fh	
	call	..prtnbl
	pop	PSW
..prtnbl:ani	0Fh
	adi	'0'
	cpi	'9'+1
	jrc	CONOUT
	adi	'A'-('9'+1)
	jmpr	CONOUT
;----------
; Convert binary to BCD
;  Regs in:   A = byte to be converted
;  Regs out:  A = byte, in BCD format
;  Destroyed: B
cvtbcd:
	ora	A
	rz
	mov	B,A
	xra	A
..1:	inr	A
	daa
	djnz	..1
	ret
;----------
; Subroutine:	cvtHLbcd
; Regs  in:	HL = word to be converted to BCD
; Regs out:	C,D,E = three bytes in BCD format
;Destroyed:	A,HL
;Convert a register pair's contents to BCD
cvtHLbcd:
	lxi	D,00
	lxi	B,00
..tst:	mov	A,H	; HL is our hex counter
	ora	A
	jrnz	..addBCD
	ora	L	; Does HL=0
	rz		; we finished decrementing HL
..addBCD:
	dcx	H	; reduce hex count
	mov	A,E	; now increment decimal count
	adi	1
	daa
	mov	E,A	; put low BCD back byte in E
	jrnc	..tst	; decrement, test again.
	mov	A,D	; Since carry was set
	adi	1	; Increment next BCD byte.
	daa
	mov	D,A	; put high BCD back byte in D
	jrnc	..tst	; decrement, test again.
	mov	A,C	; Since carry was set
	adi	1	; Increment next BCD byte.
	daa
	mov	C,A	; put Meg BCD byte back in C
	jmpr	..tst	; decrement, test again.
;----------
; Print a character on the console
;  Regs in:   A = character to be printed
CONOUT:
	push	H
	push	D
	push	B
	mvi	C,2
	mov	E,A
	call	5	; print using BDOS
	pop	B
	pop	D
	pop	H
	ret
	.blkw	30
stack:
.end
