.MCALL .MODULE
.MODULE	RTMON,VERSION=13,COMMENT=<System Display Monitor>,AUDIT=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;++
;COND
;	VT1$00	(1)	VT100 support
;		 0	no VT100 support
;		 1	VT100 support
;
;	VT5$2	 1	VT52 support
;		(0)	no VT52 support
;		 0	VT52 support
;
;	BO$TH	VT1$00&VT5$2
;--
.IIf	ndf	VT1$00	VT1$00=1
.IIf	ndf	VT5$2	VT5$2=0
BO$TH	=:	VT1$00&VT5$2

	.ENABL	LC
	.NLIST	BEX
	.ENABL	GBL

; Insert verbiage here

;	R. Billig, J. Harris - Authors		5/79
;	L. Parent	     - Modifications: 	2/80
;	J. Williams	     - add support for VT100 11/83
;	J. Williams	     - V5.4 Null Job changes
;	J. Williams	     - conditionalize terminal support
;	I. Ziemba	     - add AUDIT=YES to .MODULE info.
;	R. Hamilton	- do queue-element traverse at high priority,
;	 8-Sep-89	  impose a limit
;			- Fix infinite loop clearing FGND line 8 when
;			  FGND job unloaded
;			- blank SYSn jobs when no system task support
;			- display extended unit device names
;			- Remove default support for VT52
;			- Refuse to run as virtual (or VBGEXE) job
;  6-Jun-91	WFG	ACTION #7462 - Incorporate DATE formatting into 
;			this program to eliminate dependance on FORLIB
;  013	4-Feb-1998	Tim Shoppa
;			- add age support, 4-digit display years

; System MACRO requirements
	.MCALL	.GTJB,	.EXIT,	.PRINT,	.TWAIT,	.RCTRL,	.TTYOU, .GVAL, .MTPS
	.MCALL	.TTinR	.Poke	.SCCA	.Assume	.Br	...CMV
	.MCALL	.DATE

; SYSLIB modules referenced
	.GLOBL	TIME,	R50ASC		; FORTRAN-callable SYSLIB routines
	.GLOBL	$DEVTR	Call$F		; SYSLIB support routines

; PSECT ordering
	.PSect	SYSDAT
	.PSect	SYSCOD
	.PSect	SYSMSG

	.SBTTL	Definitions

IniSec	=:	2.			;number of seconds in initialization
TPerSc	=:	60.			;number of ticks in a second

; Get Job Parameter Block

GT.NUM	=: 0				;Job number * 2
GT.HGH	=: 2				;High memory limit
GT.LOW	=: 4				;Low memory limit
GT.IOC	=: 6				;Adrs of I/O channel space
GT.IMP	=: 10				;Adrs of job's impure area
GT.CON	=: 12				;Console TT unit number (*byte*)
GT.NAM	=: 22				;ASCII job name (6 characters)
GT.END  =: 30				;*End of Parameter Block*

; Job Impure Area Offsets

I.STATE	=: 0				;Status bits
I.QHDR	=: 2				;I/O queue header
I.CMPE	=: 4				;Completion queue last element
I.CMPL	=: 6				;Completion queue head
I.CHWT	=: 10				;Pointer to channel during I/O wait
I.PCHW	=: 12				;Saved I.CHWT during completion
I.PERR	=: 14				;Saved ERRBYT during completion
I.CNSL	=: 16				;Pointer to TCB for this job's console (MTTY)
I.TID	=: 22				;Pointer to job's ID area
I.JNUM	=: 24				;Job number
I.CNUM	=: 26				;Number of channels defined
I.CSW	=: 30				;Pointer to channel area
I.IOCT	=: 32				;Number of outstanding I/O operations
I.SCTR	=: 34				;Suspend counter (<0 => suspended)
I.BLOK	=: 36				;Blocking bits for job

; RMON Fixed Offset Definitions

RMON	=: 54				;Base address of RMON
 SYUNIT	=: 275				;Byte, system unit number
 $CNFG2	=: 370				;Configuration word 2
  EIS$	=: 000400			;Extended Instruction Set present
 SYSGEN =: 372				;Sysgen options word
  MMGT$	=: 000002			;Extended memory support
  RTEM$ =: 000010			;RTEM bit
  STASK$=: 040000			;System job support
  TSXP$	=: 100000			;Non-RT-11 system
 MONAME	=: 406				;Booted monitor name
 $PNAME	=: 404				;Offset to $PNAME table
 $NULJB	=: 444				;Pointer to null job code
  BRDOT2=:401				;BR .+2
  INCLB	=:5227				;INC #...
 KMONIN	=: 450				;<> means KMON is BG job
 $CNFG3	=: 466				;Configuration word 3
  CF3.64=: 400				; Extended unit support
 $SLOT2	=: 502				; $SLOT*2 value

; Job Status Word Definitions

JSW	=: 44				;Address of JSW
NOWAIT	=: 000100			;don't wait for terminal I/O
$VIRT	=: 002000			;Virtual Job (which RTMON isn't)
SPMODE	=: 010000			;Special TT mode in JSW
; Channel Definitions

CSWMSK	=: ^C<76>			;Mask for device index in CSW
C.UNIT	=: 11				;Offset in channel of device unit byte

; PSW Definitions

PR0	=: 000000			;Priority 0 mask
PR7	=: 000340			;Priority 7 mask

;Character definitions

SEP	=:	'-			; Separator
Bel	=:	007			;Bell character
HT	=:	011			;Horizontal tab char
LF	=:	012			;Line feed
CR	=:	015			;Carriage return
SO	=:	016			;Shift out
SI	=:	017			;Shift in
Ctrl.R	=:	'R-100			;^R
Ctrl.W	=:	'W-100			;^W
Ctrl.Z	=:	'Z-100			;^Z
ESC	=:	033			;Escape character
SPC	=:	040			;Space character
A.Dot	=:	'.			;Dot
A.Coln	=:	':			;Colon
A.Pcnt	=:	'%			;Percent
A.Zero	=:	'0			;Zero character
G.CkBd	=:	141			;Line-drawing set checkerboard
NoCrLf	=:	200			;Suppress CR LF terminator

E.CSI	=:	'[			;Esc command string introducer
E.PVT	=:	'?			;Esc private introducer
E.SEP	=:	';			;Esc separator
E.VT52	=:	'2			;Esc SM/RS VT52 emulation parameter
E.RM	=:	'l			;Esc reset mode
E.HOME	=:	'H			;Esc home
E.CUP	=:	'H			;Esc cursor position
E.EEOS	=:	'J			;Esc erase to end of screen
E.CURS	=:	'Y			;Esc (VT52) cursor positioning
E.GRAF	=:	'F			;Esc (VT52) enter graphics mode
E.ANSI	=:	'G			;Esc (VT52) enter ANSI mode
E.EEOL	=:	'K			;Esc erase to end of line
E.V100	=:	'<			;Esc (VT52) enter VT100 mode
E.SCS1	=:	')			;Esc SCS intermediate for G1
E.LDS	=:	'0			;Esc SCS terminal for Line-drawing set
	.SBTTL	Blocking, State Conditions

; The following macro is used to define masks on I.BLOK and the
; corresponding messages to be printed.

	.MACRO	BITDEF	BIT,REASON,LABEL
	.WORD	BIT
.IIF NB <LABEL>, LABEL:
	.ASCII	%'REASON%<NoCrLf>
	.ENDM	BITDEF

; Ellipsis macro

	.MACRO	......
	.ENDM


	.PSECT	SYSDAT
..VT52::.WORD	0			; Terminal type 0=100 0<>52

BLKTAB:	BITDEF	001000,< Done  >
	BITDEF	000100,<SUSPEND>
	BITDEF	040000,<KB Wait>
	BITDEF	020000,<TT Wait>
	BITDEF	004000,<I/O XX0>,IOWAIT
	BITDEF	002000,<SP Wait>
	BITDEF	000400,<Rundown>
	BITDEF	000020,<USRwait>
	BITDEF	000000,<Running>

; Job state word (I.STATE) bit definitions

STATAB:	BITDEF	000040,< Abort >
	BITDEF	100000,< Cmplt >
	BITDEF	000200,< Cpend >
	BITDEF	000004,<  CSI  >
	BITDEF	000010,<  USR  >
	BITDEF	000000,<       >

	WINDW$	=: 10000		;Privileged job bit (not displayed
					; here)
PRIV:	.ASCII	/Priv   /<NoCrLf>	;String to print if priv. job
NPRIV:	.ASCII	/Virtual/<NoCrLf>	;If not, print this.
	.SBTTL	Messages

; The following lines define the basic screen setup.

	.PSECT	SYSMSG
.Irp	x,\IniSec*2
INTMSG:	.ASCII	<Bel>/ - Initializing /
	.ASCIZ	/for 'x' sec ... please wait/<Bel>
.EndR

	...CMV	TYPE=V

LINE01:	.NLCSI	TYPE=I,PART=NAME
	.ASCII	<HT><HT>/    /
LINE1A:	.ASCII	/RT-11 /
	.BYTE	<RT$PRE>,<RT$REL+'0>,'.,<RT$VER+'0>,<RT$SUF>
	.ASCII	/ System Monitor/<NoCrLf>
LINE3:	.BYTE	<CR>,<LF>,<LF>
LINE03:	.ASCII	/       (   )/<HT>/ BGND/<HT>/ /<NoCrLf>

LINE3A:	.ASCII	/SYS1/<HT>/ SYS2/<HT>/ SYS3/<HT>/ /
	.ASCII	/SYS4/<HT>/ SYS5/<HT>/ SYS6/<HT>/ /

LINE3B:	.ASCII	/FGND/<CR><LF><LF>
LINE05:	.ASCII	/Job Name:/<CR><LF><NoCrLf> ;Pause here for a moment

LINE06:	.ASCII	/Status:/
EOL06:	.ASCII	<CR><LF>
LINE07:	.ASCII	/Terminal:/<CR><LF><LF>
LINE09:	.ASCII	/Low  Limit:/<CR><LF>
LINE10:	.ASCII	/High Limit:/<CR><LF>
LINE11:	.ASCII	/Size (words):/<CR><LF><LF>
LINE13:	.ASCII	/Impure Area:/<CR><LF><LF>
LINE15:	.ASCII	/Channels Open:/<CR><LF>
LINE16:	.ASCII	%Pending I/O:%<CR><LF>
LINE17:	.ASCII	/Free Qelements:/<CR><LF><LF>
LINE19:	.ASCII	/Job State:/<CR><LF><LF><LF><LF>
LINE23:	.ASCII	/System Idle:/
GrfSiz	=:60.				;length of bar graph
	.BYTE 	NoCrLf

	.EVEN				; for old FORLIB's DATE routine
DATOUT:	.ASCII	/DD-MMM-YYYY  /
TIMOUT:	.ASCII	/HH:MM:SS/<NoCrLf>

KMON:	.ASCII	/<KMON>/<NoCrLf>

; Escape sequence definitions

.If	ne	VT5$2
OVT52:	.BYTE	ESC,E.CSI,E.PVT,E.VT52,E.RM ;Set VT100 in VT52 mode/clear screen
OCLRSCN:.BYTE	ESC,E.HOME		;Cursor home/then clear
	.BYTE	ESC,E.EEOS,NoCrLf	;Clear to end of screen
OCURPOS:.BYTE	ESC,E.CURS,NoCrLf	;Cursor position
OGRPON:	.BYTE	ESC,E.GRAF,NoCrLf	;Select Graphics character set
OGRPOFF:.BYTE	ESC,E.ANSI,NoCrLf	;Select ASCII character set
OERSEOL:.BYTE	ESC,E.EEOL,NoCrLf	;Erase to end of line
ODATTIM:.BYTE	ESC,E.CURS,SPC,SPC+59.,NoCrLf
.EndC;	ne	VT5$2
.If	ne	vt1$00
NVT100:	.BYTE	ESC,E.V100		;Set VT100 in VT100 mode
	.BYTE	ESC,E.SCS1,E.LDS	;Set linedrawing set in G1
	.BYTE	SI			;Select ASCII character set/clear screen
NCLRSCN:.BYTE	ESC,E.CSI,E.CUP		;Cursor home/then clear
	.BYTE	ESC,E.CSI,E.EEOS,NoCrLf	;Clear to end of screen
;NCURPOS:.BYTE	ESC,E.CSI,NoCrLf	;Cursor position
.If	ne	bo$th
NGRPON:	.BYTE	SO,NoCrLf		;Select Graphics character set
NGRPOFF:.BYTE	SI,NoCrLf		;Select ASCII character set
.EndC;	ne	bo$th
NERSEOL:.BYTE	ESC,E.CSI,E.EEOL,NoCrLf	;Erase to end of line
NDATTIM:.BYTE	ESC,E.CSI,E.SEP,'5,'9,E.CUP,NoCrLf
.EndC;	ne	vt1$00

.If	ne	bo$th
	.PSect	SYSDAT
	.EVEN
VTXXX:	.WORD	NVT100
CLRSCN:	.WORD	NCLRSCN
GRPON:	.WORD	nGrpOn
GRPOFF:	.WORD	nGrpOff
ERSEOL:	.WORD	nErsEol
DATTIM:	.WORD	NDATTIM
	.PSect	SYSMSG
.IfF;	ne	bo$th
.If	ne	VT5$2
VTXXX	=:	OVT52
CLRSCN	=:	OCLRSCN
GRPON	=:	OGrpOn
GRPOFF	=:	OGrpOff
ERSEOL	=:	OErsEol
DATTIM	=:	ODATTIM
.EndC;	ne	VT5$2
.If	ne	vt1$00
VTXXX	=:	NVT100
CLRSCN	=:	NCLRSCN
ERSEOL	=:	NErsEol
DATTIM	=:	NDATTIM
.EndC;	ne	vt1$00
.EndC;	ne	bo$th

; Handy string for clearing a field

CLEAR:	.ASCII	/        /<NoCrLf>

; String for idle-time histogram

GRAPH:	.REPT	GrfSiz
	.BYTE	G.CkBd
	.ENDR
	.BYTE	SPC,NoCrLf

; Error messages

NOEIS:	.NLCSI	TYPE=I,PART=PREFIX
	.ASCIZ	/F-No EIS hardware/
NOTPRV:	.NLCSI	TYPE=I,PART=PREFIX
	.ASCIZ	"F-Not priv"
NONULL:	.NLCSI	TYPE=I,PART=PREFIX
	.ASCIZ	/F-No Null job/
	.SBTTL	Initialization

	.ASECT
.=JSW
	.WORD	SPMODE

	.PSECT	SYSCOD

DEBUG::
	Bpt				; For debugging
START::					; For normal operation
.If	ne	bo$th
	Tst	..VT52			; Change to VT52?
	Beq	10$			; no, leave it at VT100
	Mov	#OVT52,VTXXX
	Mov	#OCLRSCN,CLRSCN
	Mov	#OGRPON,GRPON
	Mov	#OGRPOff,GRPOFF
	Mov	#OERSEOL,ERSEOL
	Mov	#ODATTIM,DATTIM
10$:
.Endc;	ne	bo$th
	Mov	#NOTPRV,R1
	BIT	#$VIRT,@#JSW		;Did the user use VBGEXE?
	BNE	EXIT			; exit immediately if so.

	Mov	#AREA,R5		;R5 -> EMT request area
	.GVAL	R5,#SYSGEN		;Get monitor sysgen options
	Mov	R0,SYSOP		;Save for later
	Bit	#<TSXP$>,R0		;Not real RT-11?
	Bne	EXIT

	Mov	#2,R1			;Maximum job for FB
	Bit	#<STASK$>,R0		;Multitasking?
	Beq	12$
	Mov	#16,R1			;Maximum job when multitasking
12$:	Mov	R1,Maxjob

	Mov	#NOEIS,R1		;R1 -> Error message
	.GVAL	R5,#$CNFG2,CODE=NOSET	;Get configuration word 2
	Bit	#EIS$,R0		;Do we have EIS hardware?
	Beq	EXIT			; If eq, no - can't run demo

	.GVAL	R5,#$SLOT2,CODE=NOSET	; get $SLOT2 value
	BIC	#^c<77>,R0		; mask it
	ASL	R0			; $SLOT2*2
	MOV	R0,-(SP)
	ASL	R0			; $SLOT2*4
	ADD	(SP)+,R0		; $SLOT2*6
	TST	(R0)+			; account for extra word in $ENTRY
	MOV	R0,PNM2OF		; save $PNAM2 offset from $PNAME

	.GVAL	R5,#$PNAME,CODE=NOSET
	Add	@#RMON,R0		;R0 => $PNAME
	Mov	R0,PNAMEP		;save it for later

	.GVAL	R5,#$NULJB,CODE=NOSET	;Get addr of ..NULJ
	Mov	R0,R2			;Save addr
	Bne	OK			;Yes, there is one
	Mov	#NONULL,R1		;R1 -> Error message
EXIT:	.PRINT	R1			;Print error message
	.EXIT				;Leave
OK:
	Mov	@#RMON,R1		;R1 -> RMON
	.SCCA	R5,#CTRLC		;Block ^C^Cs
	.POKE	R5,R2,#BRDOT2		;Replace with BR .+2
	Mov	R2,AtNulJ		;Save address of 1st word
	Mov	R0,NulJb1		;Save 1st word of null job
	Add	#2,R2			;Point to 2nd word
	Mov	R2,NULCNT		;Save addr of null counter
	.POKE	R5,R2,#0,CODE=NOSET	;Replace with 0
	Mov	R0,NulJb2		;Save 2nd word of null job
	Sub	#2,R2			;Point to 1st word
	.POKE	R5,R2,#INCLB,CODE=NOSET	;Replace BR with INC #
.If	ne	bo$th
	.PRINT	VTXXX			;Set terminal to proper mode
.IfF;	ne	bo$th
	.PRINT	#VTXXX			;Set terminal to proper mode
.EndC;	ne	bo$th
	.PRINT	#LINE1A
	.PRINT	#INTMSG			;Indicate initialization in progress
	.TWAIT	R5,#INITTM		;Wait for <IniSec> seconds for print
	Clr	@NULCNT			;Initialize			*POKE*
	.TWAIT	R5,CODE=NOSET		;Wait for <IniSec> seconds for reference
	Mov	@NULCNT,R4		;Get count for <IniSec> seconds	*PEEK*
	Clr	@NULCNT			;Reinitialize			*POKE*
	Ror	R4			;Scale for XM (assumes C clear)
	Mov	R4,MAXNUL		;Set max value for <IniSec> ticks

	Mov	R1,R0			;Copy RMON pointer
	Add	#MONAME,R0		;Point to RAD50 monitor name
	Call	AscDev			;Convert monitor name to ASCII

	Asr	CONST			;Set up for 3 character conversions
	Mov	#<LINE03+8.>,PNMADR+2	;ASCII destination
	Mov	PNAMEP,R1
	Tst	(R1)+			;2nd device = system device
	Call	DevNam			;get it, xd-unit if needed

	Mov	#<IOWAIT+4>,PNMADR+2	;Set ASCII dest for future calls

CtrlW:
.If	ne	bo$th
	.PRINT	CLRSCN			;clear the screen
.IfF;	ne	bo$th
	.PRINT	#CLRSCN			;clear the screen
.EndC;	ne	bo$th
	.PRINT	#LINE01			;Put up first part of default screen
	.Print	#Line3
	Mov	#LINE3A,R0		;Assume it's a multitasking monitor
	Bit	#STASK$,SYSOP		;Well, is it?
	Bne	10$			;Branch if it is.
	Mov	#LINE3B,R0		;No.  Skip system job headers
10$:	.PRINT				;Do job header line.

	Mov	#LINE06,R0		;Assume its an XM monitor
	Bit	#MMGT$,SYSOP		;Well, is it?
	Bne	20$			; If ne, yes - we guessed right
	Mov	#EOL06,R0		;Skip past 'Status:'
20$:	.PRINT				;Put up rest of default screen	
	Jmp	UPDATE			;Go print first update
	......
SLEEP::
	CALL	TSTAMP			;Get the time stamp
	TstB	BLOCK			;Blocked by ^Z?
	Bne	SNOOZE			;Yes
.If	ne	bo$th
	.PRINT	DATTIM
.IfF;	ne	bo$th
	.PRINT	#DATTIM
.EndC;	ne	bo$th
	.PRINT	#DATOUT
11$:
	Mov	@NULCNT,R3		;Get null loop count		*PEEK*
	Clr	@NULCNT			;Clear to start new interval	*POKE*
	Asr	R3			;Divide by two to compare with MAXNUL
	Mov	#<IniSec>*TPerSc,R4	;Convert to <IniSec> second equivalent
	Mul	R3,R4
	Div	MAXNUL,R4		;Get percentage
	Cmp	R4,#GrfSiz		;Should be in range 1..GrfSiz
	Blos	1$			;If LOS, okay
	Mov	#GrfSiz,R4		;Else set to max value
1$:	Cmp	R4,OLDIDL		;Check against last displayed value
	Beq	SNOOZE			;If the same, just snooze now
	Blt	2$			;If NEW < OLD, go erase part
	Mov	#23.,R1			;Position to line 23
	Mov	OLDIDL,R0		;Get length of old bar
	Add	#17.,R0			;And set to column beyond old bar
	Call	GPOSIT			;Position cursor
	Mov	#GRAPH+GrfSiz,R5	;Get base of graph bar
	Sub	R4,R5			;And index to get subsection
	Add	OLDIDL,R5
.If	ne	bo$th
	.PRINT	GRPON			;Enter special graphics set
	.PRINT	R5			;Output new bar
	.PRINT	GRPOFF			;Reselect ASCII set
.IfF;	ne	bo$th
.If	ne	VT5$2
	.PRINT	#GRPON			;Enter special graphics set
	.PRINT	R5			;Output new bar
	.PRINT	#GRPOFF			;Reselect ASCII set
.EndC;	ne	VT5$2
.If	ne	vt1$00
	.TTYOut	#SO			;Enter special graphics set
	.PRINT	R5			;Output new bar
	.TTYOut	#SI			;Reselect ASCII set
.EndC;	ne	VT5$2
.EndC;	ne	bo$th
	Br	3$			;Go print percentage
2$:	Mov	#23.,R1			;Set to line 23
	Mov	R4,R0			;Get end of new bar
	Add	#17.,R0			; as a column number
	Call	GPOSIT			;Position cursor
.If	ne	bo$th
	.PRINT	ERSEOL			;Erase old extraneous chars
.IfF;	ne	bo$th
	.PRINT	#ERSEOL			;Erase old extraneous chars
.EndC;	ne	bo$th
	.TTYOUT	#SPC			;And a space before the percentage
3$:	Mov	R4,OLDIDL		;Remember what we drew last time
	Mov	R3,R0			;Get percentage base
	Mul	#<IniSec>*100.,R0
	Div	MAXNUL,R0
	Cmp	R0,#99.			;Cheat for two digit display
	Blos	4$
	Mov	#99.,R0
4$:	Mov	#BUFFER,R3
	Call	CVT10			;Convert to decimal ASCII
	MovB	#A.PCNT,(R3)+		;Followed by %
	MovB	#NoCrLf,@R3
	.PRINT	#BUFFER			;And output percentage
SNOOZE:	Tst	CTRLC			;^C^C entered?
	Bpl	22$			;no
	Mov	#Area,R5		;point to EMT request area
	Mov	AtNulJ,R1		;Save addr
	.Poke	R5,R1,#BrDot2		;Replace with BR .+2
	Add	#2,R1			;Point to 2nd word
	.Poke	R5,R1,NulJb2,CODE=NOSET ;Replace with original value
	Sub	#2,R1			;Point to 1st word
	.Poke	R5,R1,NulJb1,CODE=NOSET	;Replace with original value
.If	ne	bo$th
	Mov	CLRSCN,R1		;clear the screen
.IfF;	ne	bo$th
	Mov	#ClrScn,R1		;clear the screen
.EndC;	ne	bo$th
	Jmp	Exit			;and quit
22$:
	TstB	BLOCK
	Bne	5$
	Mov	#24.,R1
	Mov	#1.,R0
	Call	GPOSIT
5$:	.TWAIT	#AREA,#WAITTM		;Go to sleep

	.Br	UPDATE
	.SBTTL	Screen Update

; Whenever the sleep period elapses, come here to update the display

UPDATE:
	Bis	#NOWAIT,@#JSW		; don't wait if none
	.TTinR				; any input?
	Bic	#NOWAIT,@#JSW		; back to wait mode
	Bcs	UPDAT1			; no
	CmpB	#Ctrl.R,R0		; ^R?
	Beq	CtrlR			; yes, refresh
	CmpB	#Ctrl.W,R0		; ^W?
	Beq	CtrlR			; yes, refresh
	CmpB	#Ctrl.Z,R0		; ^Z?
	Bne	Update			; no
	MovB	R0,Block		; freeze output
.If	ne	bo$th
	.Print	CLRSCN			; clear the screen
.IfF;	ne	bo$th
	.Print	#CLRSCN			; clear the screen
.EndC;	ne	bo$th
	Br	UPDATE			; else just "burn" chars
CtrlR:	Clr	OLDIDL			; redo bargraph
	.RCTRLO				;Get special mode into operation
	ClrB	Block			; allow output
	Jmp	CtrlW			; bucket brigade
UPDAT1:
	TstB	Block			; doing display?
	Bne	Sleep1			; no
	Mov	#-2,R4			;Preset current job #

NXTJOB:	Add	#2,R4			;Update to next job
	Cmp	R4,MaxJob		;Have we finished all jobs yet?
	Blos	NxtJb1			;branch if not
Sleep1:	Jmp	SLEEP			;If higher, go to sleep now
NxtJb1:	.GTJB	#AREA,#GTDATA,R4	;Get job parameters
	Bcc	JOBDAT			;If CC, job exists
	Tst	JOBTAB(R4)		;Was this job existing last time?
	Beq	NXTJOB			;If EQ no - area already blank
	Mov	#5.,R1			;Else clear area, starting at line 5
1$:	Call	POSIT			;Position to this job's section
	.PRINT	#CLEAR			;Clear the 8 bytes
	Inc	R1			;Move to next line
	Cmp	R1,#19.			;Have we cleared all lines yet?
	Blos	1$			;If LOS no
	Clr	JOBTAB(R4)		;Indicate no job here
	Br	NXTJOB			;Else examine next job
	......
JOBDAT:	Mov	#-1,JOBTAB(R4)		;Indicate job present
	Mov	#5.,R1			;Position to job name
	Call	POSIT			;Reposition to job name
	MovB	#NoCrLf,GTDATA+GT.END	;Set stopper at end of name
	Mov	#GTDATA+GT.NAM,R0	;Assume not KMON
	Tst	R4			;Are we doing the background job?
	Bne	2$			; If ne, no
	Mov	@#RMON,R1		;Point to RMON
	Tst	KMONIN(R1)		;KMON running?			*PEEK*
	Bne	21$			;Yes
	Mov	#GTDATA+GT.NAM,R1	;R1 -> Logical job name in .GTJB block
1$:	TstB	(R1)+			;Scan name, replace 0s with spaces
	Bmi	2$			; If MI, we're at the end
	Bne	1$			; If NE, its a character
	MovB	#SPC,-(R1)		;Make it a space (rescan will skip it)
	Br	1$			;Rescan the space, continue
21$:
	Mov	#KMON,R0		;Job is KMON
	
2$:	.PRINT				;Print out name
	Bit	#MMGT$,SYSOP		;Is this an XM monitor?
	Beq	4$			; If eq, no - skip status business
	Mov	#6.,R1			;Position to job status
	Call	POSIT
	Mov	#PRIV,R2		;Assume its a privileged job
	Mov	GTDATA+GT.IMP,R3	;R3 -> Impure area of job
				.ASSUME I.STATE EQ 0
	Bit	#WINDW$,@R3		;Is it a virtual job?		*PEEK*
	Beq	3$			; If EQ, no - we guessed right
	Mov	#NPRIV,R2		;R2 -> virtual job message
3$:	.PRINT	R2			;Print job status

4$:	Mov	#7.,R1			;Position to terminal ID
	Call	POSIT
	Mov	GTDATA+GT.IMP,R5	;R5 -> job's impure area
	Clr	R0			;R0 = count of open channels
	Mov	I.CNUM(R5),R1		;R1 = number of channels defined*PEEK*
	Beq	7$			;If EQ none
	Mov	I.CSW(R5),R2		;R2 -> channel area		*PEEK*
5$:	Tst	@R2			;Is this channel active?	*PEEK*
	Bpl	6$			;If PL no
	Inc	R0			;Else increase active count
6$:	Add	#12,R2			;Skip current channel
	Sob	R1,5$			;And continue for all defined

7$:	MOV	#CHNCNT,R2		;Use R2 as data pointer
	Mov	R0,(R2)+		;Store count of open channels
	.MTPS	#PR7			;;; No interrupts here!
				.ASSUME IOCNT EQ CHNCNT+2
	Mov	I.IOCT(R5),(R2)+	;;;Store pending I/O count	*PEEK*
				.ASSUME I.STATE EQ 0
				.ASSUME STATBT EQ IOCNT+2
	Mov	@R5,(R2)+		;;; and job state		*PEEK*
				.ASSUME BLOKBT EQ STATBT+2
	Mov	I.BLOK(R5),(R2)+	;;; and blocking bits		*PEEK*
	Mov	I.CHWT(R5),R0		;;; and channel wait info	*PEEK*
				.ASSUME CHWAIT EQ BLOKBT+2
	Mov	@R0,(R2)+		;;; store channel CSW		*PEEK*
				.ASSUME CHUNIT EQ CHWAIT+2
	MovB	C.UNIT(R0),@R2		;;; also unit # of device	*PEEK*
;	Mov	I.QHDR(R5),R1		;R1 -> next free Q element	*PEEK*
					.Assume PR0 eq 0
	.MTPS	#PR0			;Okay, all you clock ticks...

Qlimit =: 999.

	Mov	#<-Qlimit>,R0		; Initialize count/limit value

	.MTPS	#PR7			;;; No interrupts here!
	Mov	I.QHDR(R5),R1		;;; R1 -> next free Q element?	*PEEK*
	Beq	85$			;;; are there any?
8$:	Inc	R0			;;; Yes.  Add to free count
	Beq	85$			;;; Limit reached?
	Mov	@R1,R1			;;; Link to next		*PEEK*
	Bne	8$			;;; And continue if not last in list
85$:	.MTPS	#PR0			;;; Reduce priority

9$:	Add	#Qlimit,R0		;Obtain actual free count
	Mov	R0,QELCNT		;Store number of free Q elements

	MovB	GTDATA+GT.CON,R0	;Get console lun number
	ADD	#A.zero,R0
	MOVB	R0,TTNUM
	.PRINT	#TTNAME			;Print terminal name

	Mov	#9.,R1			;Position to low mem limit

	Mov	GTDATA+GT.LOW,R0	;R0 = low memory limit
	CALL	OCTVAL			;Display it

	Mov	GTDATA+GT.HGH,R0	;R0 = high memory limit
	Call	OCTVAL

	Mov	GTDATA+GT.HGH,R0	;Get high memory limit
	Sub	GTDATA+GT.LOW,R0	;Subtract low limit
	Clc
	Ror	R0			;Compute size in words
	Adc	R0
	Call	DECVAL			;Output as decimal

	Inc	R1			;Skip a line for impure area 
	Mov	R5,R0			;R0 = address of impure area
	CALL	OCTVAL			;Display it in octal

	Inc	R1			;Skip a line for open channels
	Mov	CHNCNT,R0		;Get count of open channels
	Call	DECVAL			;Output as decimal

	Mov	IOCNT,R0		;R0 = pending I/O count
	Call	DECVAL			;Output as decimal

	Mov	QELCNT,R0		;Get free Q element count
	Call	DECVAL			;Output as decimal

	Inc	R1			;Position to job status (row 19.)
	Call	POSIT
	Mov	#BLKTAB,R3		;Get blocking masks table address
10$:	Tst	(R3)+			;End of table reached yet?
	Beq	12$			;If EQ yes - print defined state
	Bit	-2(R3),BLOKBT		;Is job blocked on this condition?
	Bne	11$			;If NE yes - print this state
	Add	#8.,R3			;Else skip description
	Br	10$
11$:	Cmp	R3,#IOWAIT		;Is this I/O wait state?
	Bne	12$			;If NE no
	Mov	CHWAIT,R1		;R1 = CSW for channel
	Bic	#CSWMSK,R1		;Isolate device index * 2
	Add	PNAMEP,R1		;R1 -> RAD50 device name
	Call	DevNam			;Get device name in ASCII
	Mov	#IOWAIT,R3

12$:	.PRINT	R3			;Print job state description

	Mov	#20.,R1			;Position to second line
	Call	POSIT
	Mov	#STATAB,R3		;R3 -> Bit definitions for I.STATE
13$:	Tst	(R3)+			;End of table?
	Beq	14$			; If eq, yes - print a field of spaces
	Bit	-2(R3),STATBT		;Is this bit on?
	Bne	14$			; If ne, yes - print description
	Add	#8.,R3			;Else skip description
	Br	13$			;Try next bit

14$:	.PRINT	R3			;Print description
	Jmp	NXTJOB
	......
	.SBTTL	Commonly used display routines
;+
;
; OCTVAL and DECVAL display the value in R0 in OCTAL or DECIMAL,
; respectively.
;
; R0 = value for display
; R1 = row number
; R4 = job number (translated to column)
; 
; R0 and R3 are destroyed.
; R1 is incremented.
;-
	.ENABL	LSB

OCTVAL:	Mov	#BUFFER,R3
	Call	OCTASC			;Convert R0 to ascii
	Br	30$
	......

DECVAL:	Mov	R1,-(SP)		;save the value to display,
	Mov	#BUFFER,R3		;R3 -> temp output area
	Call	CVT10			;Convert number to decimal ASCII
	Mov	(SP)+,R1		;Get the value again
	MovB	#A.Dot,(R3)+		;Indicate decimal
20$:	Cmp	R3,#BUFFER+6		;Have we filled 7 characters yet?
	Bhis	30$			;If HIS yes
	MovB	#SPC,(R3)+		;Else blank-fill
	Br	20$

30$:	MovB	#NoCrLf,@R3		;terminate the line
	Call	POSIT			;Position on [R4:R1]
	.Print	#BUFFER			;Print it.
	Inc	R1			;Assume next row
	Return
	......

	.DSABL	LSB
	.SBTTL	AscDev and DevNam
;+
; DevNam
;
; Creates an extended-unit device name in ASCII.
;
; Call with R1 pointing to handler name in $PNAME
; and unit number in CHUNIT.
;
; Returns with extended-unit ASCII device name stored via R50ASC's
; destination argument.
;
; (Note that we don't have to check for Extended Unit Support
; because unit numbers can only exceed 7 if that support is present.)
;-
	.ENABL	LSB

DevNam:	Mov	CHUNIT,-(sp)		;Get unit number
	Bic	#^C<177>,@sp		;watch out for MQ's high bit
	Cmp	(sp)+,#7		;Big unit number?
	Blos	10$			; if not, use 2-letter handler name
	Add	PNM2OF,R1		; Point to $PNAM2 entry
	
10$:	Mov	@R1,R0			;Let R0 = RAD50 name
	MovB	CHUNIT,R1		;Let R1 = unit number
	Call	$DEVTR			;Get a combined RAD50 name
	Mov	R0,buffer		;store the name,
	Mov	#buffer,R0		;and get its new address
	.Br	AscDev			;convert to ASCII
	......

;+
; AscDev
;
; Converts a RAD50 device name to ASCII.
;
; R0 points to the RAD50 name.
; The R50ARG block must otherwise be set up with a count and destination
; address.
;-

AscDev:	Mov	R0,PNMADR		;-> R50 name in arg list
	Mov	#R50ARG,R5		;Use SYSLIB R50ASC to convert it*PEEK*
	Mov	#R50ASC,R0
	Call	Call$F			;to ASCII...
	Return
	......

	.DSABL	LSB
	.SBTTL	Cursor Positioning

; POSIT
;
; Positions the cursor at the current job's area of the line specified.
;
; R1 = line number desired (1..24)
; R4 = current job number (*2)

; GPOSIT
;
; General cursor positioning entry
;
; R0 = column number desired (1..80)
; R1 = line number desired (1..24)

	.PSect	SYSCOD

POSIT:	Mov	R4,R0			;Take job # *2
	Asl	R0			; *4
	Asl	R0			; *8
	Add	#17.,R0			;And make column #
GPOSIT:
.If	ne	bo$th
	Tst	..VT52			;Is this a VT52?
	Bne	POS52			;Do VT52 cursor positioning
.EndC;	ne	bo$th
.If	ne	vt1$00
	Mov	R1,-(SP)		;Save work regs
	Mov	R3,-(SP)		;...
	Mov	#PBUFFV,R3		;Point to buffer for sequence
	Mov	R0,-(SP)		;Save column number
	Mov	R1,R0			;Get first position argument
	Call	CVT10			;Convert to ascii
	MovB	#E.SEP,(R3)+		;Delimiter
	Mov	(SP)+,R0		;Get second position argument
	Call	CVT10			;Convert to ascii
	MovB	#E.CUP,(R3)+		;Final char
	MovB	#NoCrLf,@R3		; and the eos
	.PRINT	#PBUFF			;Start cursor positioning sequence
	Mov	(SP)+,R3		;Restore work regs
	Mov	(SP)+,R1
	Return
.EndC;	ne	vt1$00

.If	ne	VT5$2
POS52:
	Mov	R0,-(SP)		;Save desired column
	.PRINT	#OCURPOS		;Start cursor positioning sequence
	Mov	R1,R0			;Get line number
	Add	#SPC-1,R0
	.TTYOUT				;Send desired line
	Mov	(SP)+,R0		;Restore column #
	Add	#SPC-1,R0
	.TTYOUT				;And send column
	Return
.EndC;	ne	VT5$2

	.SBTTL	Conversion Routines

; Convert binary to decimal

	.ENABL	LSB

CVT10:	Cmp	R0,#10.			;need to divide?
	Bhis	10$			;apparently so.
	MovB	R0,@R3			;no. do quick conversion
	Br	30$

10$:	Mov	R0,R1			;Copy number to convert
	Clr	R0
	Div	#10.,R0			;Divide by 10.
	Mov	R1,-(SP)		;Save remainder
	Tst	R0			;Anything left to convert?
	Beq	20$			;If EQ no
	Call	CVT10			;Else recur
20$:	MovB	(SP)+,@R3		;Move binary byte to output area
30$:	BisB	#A.Zero,(R3)+		;And make ASCII
40$:	Return
	......

; Convert binary to Octal

OCTASC:	MovB	#30,@R3
	Sec
50$:	Rol	R0
	RolB	(R3)+
	MovB	#206,@R3
60$:	Asl	R0
	Beq	40$
	RolB	@R3
	Bcs	60$
	Br	50$
	......

	.DSABL	LSB

.SBTTL	Subr	TSTAMP	Time stamp routine

TSTAMP::
	Mov	#TIMARG,R5
	Call	TIME		; Get current time of day

	.DATE			; Get the date in internal form
	CALL	CONDAT		; Convert it to something useable
	MOV	#DATOUT,R0	; R0 -> Destination

	MOV	DAY,R3		; R3 =  Binary DAY
	CALL	DTOASC		; Convert to ASCII
	MOVB	#SEP,(R0)+	; Move in a dash

	MOV	MON,R3		; R3 =  Binary MONTH
	ASL	R3		; R3 =  MON * 2
	ADD	MON,R3		; R3 =  MON * 3
	ADD	#MONTHS,R3	; R3 -> Month string
	MOVB	(R3)+,(R0)+
	MOVB	(R3)+,(R0)+
	MOVB	(R3)+,(R0)+
	MOVB	#SEP,(R0)+	; Move in a dash
	MOV	YEAR,R3		; R3 =  Binary YEAR
	CMP	R3,#100.	; Is year GT 100 ?
	BLO	40$		; No, leave it alone
	MOVB	#'2,(R0)+	; and we are in				;013
	MOVB	#'0,(R0)+	;  the 2000's				;013
	SUB	#100.,R3	; make it 2 digits			;013
	BR	DTOASC		; and diplay them			;013
40$:	MOVB	#'1,(R0)+	; or we are in				;013
	MOVB	#'9,(R0)+	;  the 1900's				;013
				; Fall into DTOASC and return from there;013
;				CALL	DTOASC		; Convert to ASCII
;				RETURN

.SBTTL	Subr	DTOASC	Convert decimal to ASCII
DTOASC::
	SWAB	R3			; Position quotient and dividend

50$:	SUB	#<10.*400-1>,R3		; Divide by 10.
	BPL	50$			; Subtract until negative
	ADD	#<10.*400-1>+"00,R3	; Back up, cvt to ASCII

	MOVB	R3,(R0)+		; Insert ten's digit
	SWAB	R3			; Position unit's digit
	MOVB	R3,(R0)+		; Insert unit's digit

	RETURN

.SBTTL	CONDAT
;+
; CONDAT
; This routine converts the RT-11 format date into something usable.
; INPUTS:
;	R0 contains the RT-11 format date
; OUTPUTS:
;	The current day, month, and year stored in DAY, MON, and
;	YEAR.
;	R0 is modified
;-

CONDAT::
	MOV	R1,-(SP)	;Save R1
	MOV	R2,-(SP)	; and R2
	MOV	R0,R1		;Get the date
	BIC	#177740,R1	;Clear all but the year
	ADD	#72.,R1		;RT-11 years are -72
	MOV	R1,YEAR		;Save the year
	MOV	R0,R1		;Get the age				;013
	ROR	R1		;Put the age bits			;013
	SWAB	R1		; in the right place			;013
	BIC	#177637,R1	;Now we have Age*32			;013
	ADD	R1,YEAR		;add it to get the real year		;013
	MOV	#32.,R2		;Divide by 32
	CALL	DDIV		;This will put the day in the low 5 bits
	MOV	R0,DAY		;Store it
	BIC	#177740,DAY	;Get rid of all but the day
	CALL	DDIV		;Now get the month
	BIC	#177760,R0	;Get rid of all but the month		;013
	MOV	R0,MON		; and save it
	MOV	(SP)+,R2	;Restore the registers
	MOV	(SP)+,R1
	RETURN

.SBTTL	DDIV-	Single precision divide
;+
; DDIV
; INPUTS:
;	R0 = dividend
;	R2 = divisor
; OUTPUTS:
;	R0 = quotient
;	R1 = remainder
;	R2 is unchanged
;-

DDIV::
	MOV	#16.,-(SP)	;Push the shift count
	CLR	R1		;Clear out the remainder
1$:	ASL	R0		;Double precision shift
	ROL	R1
	CMP	R2,R1		;Will the divisor fit?
	BHI	2$		;Branch if not
	SUB	R2,R1		;
	INC	R0		;
2$:	DEC	@SP		;Done?
	BGT	1$		;Branch if not
	TST	(SP)+		;Clean the stack
	RETURN

.SBTTL	Data Areas

	.PSECT	SYSDAT

QELCNT:	.BLKW	1			; These values should remain
CHNCNT:	.BLKW	1			;  in order ***
IOCNT:	.BLKW	1			;	     ***
STATBT:	.BLKW	1			;	      ***
BLOKBT:	.BLKW	1			;	       ***
CHWAIT:	.BLKW	1			;	        ***
CHUNIT:	.BLKW	1			;	         ***

SYSOP:	.BLKW	1
MaxJob:	.BLKW	1
PNM2OF:	.BLKW	1
PNAMEP:	.BLKW	1

AtNulJ:	.BlkW	1
NulJb1:	.BlkW	1
NulJb2:	.BlkW	1

NULCNT:	.BLKW	1			;Address of null count
CTRLC:	.BLKW	1			;^C^C flag word

.If ne vt1$00
PBUFF:	.BYTE	ESC,E.CSI		;Cursor position
PBUFFV:	.BLKB	10.			;(keep together with PBUFF)
.EndC; ne vt1$00

BUFFER:	.Rept	10.
	.BYTE	SPC
	.ENDR
	.Even

AREA:	.BLKW	10			; EMT BLOCK

GTDATA:	.BLKW	12.

MAXNUL:	.BLKW	1
OLDIDL:	.WORD	0

R50ARG:	.WORD	3
	.WORD	CONST
PNMADR:	.BLKW	1
	.WORD	LINE03

TIMARG:	.WORD	1
	.WORD	TIMOUT

CONST:	.WORD	6

JOBTAB:	.WORD	0,0,0,0,0,0,0,0

INITTM:	.WORD	0,<IniSec>*TPerSc+3	;Don't timeout when MTTY
WAITTM:	.WORD	0,TPerSc+3		;Time-out does !!!

DAY::	.WORD	0		;Current date (0-31)
MON::	.WORD	0		;Current month (0-12)
YEAR::	.WORD	0		;Current year (72-??)

TTNAME:	.ASCII	/TT/
TTNUM:	.ASCII	/0:/<200>

Block:	.Byte	0			; block output if non-zero

	.Even

MONTHS::.ASCII	\BADJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC\
	.EVEN

	.END	START