.enabl	lc
	.title	hang up the phone
;++
;
; Program to handle dial-up logouts.
;
; Prompts for confirmation and kills the job.
;
; By John Wilson.
;
; Started: 21-Apr-86
;
;--
firqb=	402	;file request queue block
xrb=	442	;transfer request block
corcmn=	460	;core common area
calfip=	emt	;call file processor
opnfq=	2	;CALFIP subfunc to open a file
dlnfq=	6	;subfunc to delete a file
errfq=	16	;subfunc to return error message
rstfq=	20	;subfunc to reset channel(s)
lokfq=	22	;subfunc to do directory lookup
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.postn=	emt+32	;get carriage column
.date=	emt+34	;get system date/time
.uuo=	emt+66	;FIP calls (unimplemented user operation)
uu.hng=	-9.	;.UUO subfunc to hang up a dataset
uu.bye=	5	;subfunc to log out
uu.chu=	8.	;subfunc to kill a job
uu.cnv=	20.	;subfunc to convert date and time to ASCII
uu.sys=	26.	;subfunc to get SYSTAT info
;
cr=	15	;carriage return
lf=	12	;line feed
;
	.mcall	exit$s
;
hangup:	movb	#rstfq,firqb+3	;func=close all files
	clrb	firqb+4		;that's right
	calfip			;do it
	jsr	pc,clrfrq	;clear FIRQB
	movb	#opnfq,firqb+3	;OPEN
	mov	#"KB,firqb+30	;'KB:'
	movb	#2,firqb+4	;AS FILE 1%,
	mov	#100020,firqb+22 ;MODE 16%
	calfip			;do it
	movb	firqb+2,r1	;get job*2
	asr	r1		;/2=job
	clr	r0		;sxt
	movb	r1,jobnum	;save
	div	#10.,r0		;separate digits of job #
	mov	r0,r3		;copy high digit
	mul	#50,r3		;shift left (rad50)
	add	r3,r1		;add together
	add	#^R 00,r1	;convert to rad50
	mov	r1,job		;save
	movb	corcmn,r3	;get length of core common
	beq	10$		;empty, skip
	mov	#corcmn+1,r0	;get ptr
	br	30$		;skip
10$:	jsr	r5,type		;ask them to confirm
	.word	confrm,l.conf
	mov	#xrb,r1		;point at xrb
	mov	#81.,(r1)+	;length of buffer
	clr	(r1)+		;nothing in it yet
	mov	#kbbuf,r0	;point at buffer
	mov	r0,(r1)+	;save
	mov	#2,(r1)+	;channel 1
	clr	(r1)+		;read next block
	mov	#10.,(r1)+	;wait 10. seconds
	clr	(r1)		;no modifiers
	.read			;read a line
	movb	firqb,r5	;any errors?
	bne	50$		;yes, bag
	mov	xrb+2,r3	;no, get length of line read
	movb	#2,xrb+6	;see if at begn of line
	.postn			;return column
	tstb	xrb+2		;at begn of line?
	beq	30$		;yes
	jsr	r5,type		;print crlf
	.word	crlf,2
30$:	movb	(r0)+,r4	;get a char
	cmp	r4,#3		;^C?
	beq	60$		;yes, never mind
	cmp	r4,#40		;space or ctrl char?
	blos	40$		;yes, ignore
	cmp	r4,#'/		;slash ('bye/y') ?
	beq	40$		;yes, ignore
	cmp	r4,#'Y		;'Y'?
	beq	80$		;yes, continue
	cmp	r4,#'Y+40	;'y'?
	beq	80$
	cmp	r4,#'N		;'N'?
	beq	60$		;yes, exit
	cmp	r4,#'N+40	;'n'?
	beq	60$
	jsr	r5,type		;complain
	.word	yesno,l.yesn
	br	10$		;reprompt
40$:	sob	r3,30$		;loop
	br	10$		;reprompt
50$:	; read error, not confirmed, or user typed ^C
	cmp	r5,#27.		;'?I/O to detached keyboard'?
	beq	70$		;yes, just hang up
60$:	exit$s			;no, exit
70$:	jmp	dscnct		;they hung up on me
;
; Get the username from NAMEjj.TMP;
; use '(noname)' if NAMEjj.TMP doesn't exist.
;
80$:	jsr	pc,clrfrq	;clear the firqb
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#4,firqb+4	;on channel 2
	mov	job,r0		;get job #
	add	#^RE  ,r0	;name='NAMEjj.TMP'
	mov	#firqb+10,r5	;point at filename
	mov	#^RNAM,(r5)+
	mov	r0,(r5)+
	mov	#^RTMP,(r5)
	mov	#120000,firqb+22 ;open the file read-only
	calfip			;open the file
	tstb	firqb		;error?
	bne	100$		;yes, skip
	mov	#buf,r1		;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	r1,(r0)+	;into @#buf
	mov	#4,(r0)+	;channel 2
	clr	(r0)+		;next (first) block
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;(modifier bits)
	.read			;read username from NAMEjj.TMP
	mov	#uname,r2	;point at message buffer
	mov	#6,r3		;length=6 words
90$:	mov	(r1)+,(r2)+	;copy
	sob	r3,90$		;loop
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#4,firqb+4	;channel 2
	calfip			;do it
;
; Delete all temporary files (????jj.TMP).
;
100$:	mov	job,r0		;get job #
	add	#132500,r0	;add '?  '
110$:	mov	#firqb+3,r5	;point into firqb
	movb	#lokfq,(r5)+	;func=dir lookup
	clr	(r5)+		;index=first
	clr	(r5)+		;ppn=current
	mov	#134745,(r5)+	;filename='????jj.TMP'
	mov	r0,(r5)+
	mov	#^RTMP,(r5)+
	mov	#firqb+30,r5	;point at device
	clr	(r5)+		;device='SY:'
	clr	(r5)
	calfip			;do it
	tstb	firqb		;error?
	bne	prmsg		;yes, no more matches
	movb	#dlnfq,firqb+3	;func=delete file
	calfip			;do it
	br	110$
;
; Print username, keyboard #, time, and date.
;
prmsg:	jsr	r5,type		;"Job "
	.word	msg1,l.msg1
	movb	jobnum,r0	;job #
	call	nout
	jsr	r5,type		;", User "
	.word	msg2,l.msg2
	mov	#uname,r0	;pt at name
	mov	#uname+12.,r1	;pt at end
10$:	cmpb	-(r1),#<' >	;trim trailing blanks
	beq	10$		;loop
	sub	#uname-1,r1	;correct, find length
	call	typec		;type the username
	jsr	r5,type		;" logged off KB"
	.word	msg3,l.msg3
	movb	#uu.sys,firqb+3	;func=get SYSTAT info
	clr	firqb+4		;subcode 0, current job
	.uuo			;get job info
	movb	firqb+5,r0	;get KB #
	movb	r0,kb		;save
	mov	firqb+12,-(sp)	;get connect time
	mov	firqb+10,-(sp)	;get low run time
	clr	r1		;r1=0
	bisb	firqb+21,r1	;get high run time
	mov	r1,-(sp)	;save
	call	nout		;type KB #
	jsr	r5,type		;" at "
	.word	msg4,l.msg4
	.date			;get date, time
	movb	#uu.cnv,firqb+3	;func=convert date/time
	mov	xrb,firqb+4	;copy date
	clr	firqb+6		;use system default format
	mov	xrb+2,firqb+22	;copy time
	clr	firqb+24	;use default format
	.uuo			;convert date/time to ASCII
	mov	#buf,r0		;point at buffer
	mov	r0,r1		;copy
	mov	#firqb+26,r2	;point at time
20$:	movb	(r2)+,(r1)+	;copy a byte
	bne	20$		;loop
	dec	r1		;back up
	movb	#' ,(r1)+	;add ' on '
	movb	#'o,(r1)+
	movb	#'n,(r1)+
	movb	#' ,(r1)+
	mov	#firqb+10,r2	;point at date
30$:	movb	(r2)+,(r1)+	;copy
	bne	30$		;loop
	sub	#buf+1,r1	;correct for nul & find length
	call	typec		;print date, time
	jsr	r5,type		;"."<cr><lf>"Used "
	.word	msg5,l.msg5
	mov	(sp)+,r4	;get high CPU time
	mov	(sp)+,r5	;get low CPU time
	div	#10.,r4		;get 1/10 seconds
	bisb	r5,tenths+1	;save them
	mov	r4,r5		;copy seconds
	clr	r4		;sxt
	div	#60.,r4		;get seconds
	mov	r5,-(sp)	;save them
	mov	r4,r5		;copy minutes
	beq	40$		;none, skip
	clr	r4		;sxt
	div	#60.,r4		;get minutes
	mov	r4,r0		;copy hours
	beq	40$		;none, skip
	; HH:
	call	nout		;write them
	jsr	r5,type		;colon
	.word	colon,1
	; MM:
	mov	r5,r0		;get minutes
	call	nout2		;2 digits
	br	50$		;skip
40$:	; MM: or M:
	mov	r5,r0		;get minutes
	call	nout		;1 or 2 digits
50$:	jsr	r5,type		;colon
	.word	colon,1
	; SS.T
	mov	(sp)+,r0	;get seconds
	call	nout2		;write them
	jsr	r5,type		;tenths
	.word	tenths,2
	jsr	r5,type		;" in "
	.word	msg6,l.msg6
	mov	(sp)+,r5	;get connect time
	clr	r4		;sxt
	div	#60.,r4		;find # hours
	mov	r4,r0		;copy
	call	nout		;write them
	jsr	r5,type		;colon
	.word	colon,1
	mov	r5,r0		;get # minutes
	call	nout2		;write them
	jsr	r5,type		;".  Thank you for using Digby's Bitpile."<crlf>
	.word	msg7,l.msg7
;
; Hang up the dataset and die.
;
dscnct:	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;close the terminal
	movb	#uu.hng,firqb+3	;func=hang up dataset
	movb	kb,firqb+4	;get KB #
	movb	#5,firqb+5	;hang up in 5 secs (give msg time to print)
	.uuo			;do it
	movb	#uu.bye,firqb+3	;log out
	.uuo
	movb	#uu.chu,firqb+3	;func=kill job
	movb	jobnum,firqb+4	;our job
	mov	#177400,firqb+34 ;distinguish from other uu.chu funcs
	.uuo			;do it
	exit$s			;exit if kill failed (should never happen)
;
; TYPE
;
; Print string with inline addr and length.
; Must be called through r5.
;
type:	mov	(r5)+,xrb+4	;get ptr
	mov	(r5),xrb	;get length
	mov	(r5)+,xrb+2	;twice
	mov	#2,xrb+6	;channel 1
	clr	xrb+10		;next block
	clr	xrb+14		;RECORD 0%
	.write			;write
	tstb	firqb		;error?
	bne	dscnct		;yes, die
	rts	r5		;no, return
;
; Print number in r0, variable width.
;
nout:	mov	#buf+5,r2	;pt at end of buf
	mov	r0,r1		;copy
10$:	clr	r0		;sxt
	div	#10.,r0		;/10
	bis	#'0,r1		;cvt rem to ascii
	movb	r1,-(r2)	;put in buf
	mov	r0,r1		;copy quotient
	bne	10$		;loop if not done
	mov	r2,r0		;copy ptr
	mov	#buf+5,r1	;pt at end
	sub	r0,r1		;find length
	;br	typec		;print it
;
; Type string at (r0), length in r1.
;
typec:	mov	#xrb,r2		;pt at xrb
	mov	r1,(r2)+	;length
	mov	r1,(r2)+	;twice
	mov	r0,(r2)+	;addr
	mov	#2,(r2)+	;channel 1
	clr	(r2)+		;next block
	clr	(r2)+		;(n/a)
	clr	(r2)		;RECORD 0%
	.write			;write
	tstb	firqb		;error?
	bne	dscnct		;yes, die
	rts	pc
;
; Output 2-digit number in r0.
;
nout2:	mov	r0,r1		;copy
	clr	r0		;sxt
	div	#10.,r0		;/10
	movb	r0,buf		;high digit
	movb	r1,buf+1	;low digit
	bis	#"00,buf	;convert to ascii
	jsr	r5,type		;print the #
	.word	buf,2
	rts	pc
;
; Clear out the FIRQB.
;
clrfrq:	mov	#firqb,r0	;point at firqb
	mov	#20,r1		;length=20 words
10$:	clr	(r0)+		;clear out the firqb
	sob	r1,10$		;loop
	rts	pc
;
job:	.word			;our job number, two-digit rad50
kb:	.byte			;KB number
jobnum:	.byte			;job number
confrm:	.ascii	/Confirm: /	;prompt
l.conf=	.-confrm
;
yesno:	.ascii	/Please type Y or N/<cr><lf>
l.yesn=	.-yesno
;
colon:	.byte	':
;
msg1:	.ascii	/Job /
l.msg1=	.-msg1
;
msg2:	.ascii	/, User /
l.msg2=	.-msg2
;
msg3:	.ascii	/ logged off KB/
l.msg3=	.-msg3
;
msg4:	.ascii	/ at /
l.msg4=	.-msg4
;
msg5:	.ascii	/./<cr><lf>/Used /
l.msg5=	.-msg5
;
msg6:	.ascii	/ in /
l.msg6=	.-msg6
;
msg7:	.ascii	/.  Thank you for using Digby's Bitpile./
crlf:	.byte	cr,lf
l.msg7=	.-msg7
;
	.even
;
uname:	.ascii	/(noname)    /	;user name, if any
;
tenths:	.ascii	/.0/		;tenths of a second of CPU time
;
kbbuf:				;keyboard buffer,
buf:	.blkb	512.		;and block buffer for NAMEjj.TMP
;
	.end	hangup