;*****************************************************************************
;		L E V E L S . M A C
 
	.TITLE LEVELS
	.IDENT	/V 4.0/
	.ENABL	LC
	.NLIST	BEX,CND,ME
	.SBTTL	AUTHOR'S CREDITS
 
;	Authors:	RANDY ADAMS, HENRY TUMBLIN
;			THE JACKSON LABORATORY COMPUTER SERVICE
 
;	DATE: 		APRIL 10,1978
 
;	VERSION:	4.0
 
;	RESIDENCE:	DB0:[11,33]LEVELS.*
 
;	MODULE NAME:	LEVELS -- SYSTEM STATUS INDICATOR
 
;	FOR:		SYSTEMS/UTILITIES
 
;	CORE REQUIREMENTS:  APPROX. 2-K WORDS
 
;	MACHINE/SYSTEM:	PDP11/70-IAS V2.0
 
;	TYPE/LANGUAGE:	MAIN/ASSEMBLER
 
;	INDIRECT COMMAND FILE: LEVELS.CMD
 
;	ABSTRACT:	THIS ROUTINE DISPLAYS ALL JOBS CURRENTLY
;			EXECUTING UNDER IAS, THE JOB NAME, THE
;			USER NAME, THE UIC, AND THE AMT OF TICS EACH
;			JOB HAS ACCUMULATED SO FAR.
 
;	EDITS:
;
;	Date	By	Reason
;    ---------	------	------------------------------------------------------
;    10-APR-78	HRT	Got rid of some unnecessary buffer space. Reduced
;			overall task size to 2-K.
;    12-MAY-78	HRT	Added Utilization stuff.
;    12-MAY-78	HRT	Added Node pool and Max Hole stuff.
;    12-MAY-78	HRT	Added message to LB:[1,1]NOTICE.TXT.
;    13-MAY-78	HRT	Added "Total Terminals Logged in" message.
;    23-Jul-78	HRT	Re-evaluated utilization figure and added VT-52
;			conditional assembly stuff 
;    11-Sep-78	HRT	Changed utilization calculation to use the FPP
;			because of overflow errors.
;    12-Sep-78	HRT	Re-enabled utilization message to Notice.TXT.
;    11-Nov-78	HRT	Fixed up device load pending message and
;			modified output to use $EDTMG to format messages.
;    13-Nov-78	HRT	Added node warning message. Added device name
;			to display.
;    28-Dec-78	HRT	Added conditional code to enable different flavors
;			of levels.
;    22-Jan-79	HRT	Added DECLARE_SIGNIFICANT_EVENT so as to wake up
;			any handlers to facts about the system.
;    01-Apr-79	HRT	Made utilization calculation use double precision.
;    01-Apr-79	HRT	Made CPU time shown double precision.
;    01-Apr-79	HRT	Made UJN scan a subroutine.

	.SBTTL	TELL THE ASSEMBLER WHICH LIBMACS TO USE
;*****************************************************************************
 
	.MCALL	DIR$,FSRSZ$,QIOW$,EXIT$S,RUN$,RQST$,.ENB0,PUSH,POP
	.MCALL	GTIM$,C$C,FCSMC$,FINIT$,DECL$,PRINT,.INH0

	FCSMC$
 
 
 
;	adds=1				; define for an ADDS CONSUL-980
 	vt52=1				; define if for a VT-52
; 	vt100=1				; define for a VT-100
; 	la36=1				; define for a LA36 or ASR-33
	realtm=1			; Define for running REAL/TIME
;	NOCHG=1				; No changes made to IASCOM

;*****************************************************************************

	.sbttl	Set up the FCS stuff.
;***************************************************************************
 
	.if	df	REALTM
	INLUN=2				; FILE LUN
	FSRSZ$	0			; 0 FOR BLOCK I/O
 
MESFDB:	FDBDF$				; Allocate a File Descriptor Block
 
	FDRC$A	FD.RWM			; File Access :
					; ...Block I/O to be performed

	FDBK$A	INBUF,512.		; Block Data Attributes :
					; ...Input buffer is INBUF
					; ...Input buffer size is 512. bytes

	FDOP$A	INLUN,NOTIC		; File Open :
					; ...FCS Lun is INLUN
					; ...File name descriptor block
 
NOTIC:	.WORD	DEVS,DEV		; Length of device string, string @
	.WORD	DUICS,DUIC		; Length of UIC string, string @
	.WORD	FNAMS,FNAM		; Length of filename string, string @
 
DEV:	.ASCII	/LB00:/			; Device name
	DEVS=.-DEV			; string length
 
DUIC:	.ASCII	/[1,1]/			; UIC
	DUICS=.-DUIC			; string length
 
FNAM:	.ASCII	/NOTICE.TXT/		; File name
	FNAMS=.-FNAM			; string length
	.ENDC 

;*****************************************************************************

	.sbttl	Impure Area + Buffers
;****************************************************************************

	.psect	impur,d,rw,rel 

LEVCT:	.BLKW	4			; Level count(1 byte for each level)
UIC:	.BLKW	64.			; UIC 
CPU:	.BLKW	64.			; CPU time in tics
STD:	.BLKW	64.			; STD entry for task
TS:	.BLKW	64.			; Total task size
NAME:	.BLKW	64.			; User name
TERM:	.BLKW	64.			; Terminal number
 
 
 
 
 
 






;*****************************************************************************

	.sbttl	QIO's, Status blocks, and other DPB's
;*****************************************************************************

	.if	df	realtm
RUNN:	RUN$	LEVELS,GEN,200,,,20.,2	; RERUN EVERY 20. SECONDS

RDREC:	QIOW$	IO.RVB,INLUN,1,200,IOSTAT,,<INBUF,512.,,,1>
WTREC:	QIOW$	IO.WVB,INLUN,2,200,IOSTAT,,<INBUF,512.,,,1>
	.endc 
DECL:	DECL$				; Declare significant event

WRITE:	QIOW$	IO.WVB,1,1,200,,,<0,0,0>	; TERMINAL WRITE QIO
 
	.if	df	nochg
.sutil:	.word	0			; Word for system utilization
	.endc

CLIR:	.RAD50	/CLI/			; CLI match word
IOSTAT:	.WORD	0,0
LEVEL:	.BLKW	1			; Current level number
NLEV:	.WORD	0			; Total number of levels
NODE1:	.WORD	0			; TOTAL NUMBER OF FREE NODES
HOLE:	.WORD	0			; TOTAL MAX HOLE
FRAGM:	.BLKB	2			; Fragmentation count
USERS:	.WORD	0			; # OF ACTIVE TERMINALS (CLI'S)
TEMP:	.blkw	10.			; Work area
ONEHUN:	.FLT2	100.			; 100 for percent
INBUF:	.BLKW	256.			; INPUT BUFFER FOR MESSAGE FILE.
JBLNAL:	.BLKW	20.			; Argument list for job line

DLCNT:	.BLKW	1			; Device load pending count

DLTSAV:	.REPT	5			; Device load table save area
	.BLKW	1			; UJN of requestor
	.BLKW	1			; Device name
	.BLKW	1			; Unit Number
	.BLKW	6			; Requested Volume name
	.ENDR

;*****************************************************************************

	.SBTTL	DATE AND TIME BUFFERS, Message strings
;*****************************************************************************
 
	C$C				; DEFINE ALL CONTROL CHARACTERS
 
	.EVEN
GETTIM:	GTIM$	TIMBUF			; GET THE TIME AND TODAY'S DATE
TIMBUF:	.BLKW	8.			; BUFFER TO RECEIVE TIME INFORMATION.
 
BUZBUF:	.BYTE	BEL,BEL,BEL,BEL
	BUZS=.-BUZBUF

	.SBTTL	DEFINE STORAGE AREA.

HDRLIN:	.ASCIZ	"%N** Current Task Status  %Y %3Z %4SPDP-11/70 IAS V2.0%N"

JOBLIN:	.ASCIZ	"%S%2R%2S%12E  %2E%O	[%B,%B]    	%T	%2R	%D%N"

LVLLIN:	.ASCIZ	"Level # %D%N"

STABUF:	.ASCIZ	"%10SUser= %T Swap= %T Null= %T Elap= %T"

UTMES:	.ASCIZ	"%N%10SNOTE: Current Utilization is now at %D%"

NDMES:	.ASCII	"%N%5STotal Nodes available = %D"
	.ASCII	"%5SMax Hole = %D"
	.ASCII	"%N%8STotal number of pool fragments = %D"
	.ASCIZ	"%N%10STotal terminals logged in = %D%N"

LODMES:	.ASCII	"%N%8SLoad Volume %12A on %2A%O for %12A on %2A%O%N"
	.BYTE	BEL,BEL,BEL,0

NOTMES:	.ASCIZ	"%N		NOTE: Current utilization is now at %D%   "
  
WRNMES:	.ASCIZ	"%N%10SWarning     ---     Node pool dangerously low%N"

	.if	df	REALTM
FILNF:	.ASCII	<BEL>"%NLevels -- Unable to access LB:[1,1]NOTICE.TXT%N"
	.ASCIZ	"FCS Error # %D%N"
	.endc

	.EVEN
 
CLRSCN:
	.if	df	vt52
	.mcall	.vt52.
	.vt52.				;define screen commands
	.byte	esc,crshom,esc,ereos
	.endc
	
	.if	df	adds
	.byte	ff
	.endc
 
	.if	df	la36
	.byte	cr,lf,lf,lf
	.endc
	CLRSZ=.-CLRSCN

	.even
;*****************************************************************************

	.sbttl	Description
;*****************************************************************************

;	THIS PROGRAM GOES INTO THE "BOWELS" OF THE IAS COMMON AREA 
;	TO FIND OUT SOME INFORMATION CONCERNING TIMESHARING TASKS
;	IN MEMORY AND THE LIKE. TO DO THIS, IT FIRST DISABLES
;	TASK SWITCHING, GRABS ALL THE INFO IT NEEDS FROM IASCOM
;	AND THEN ENABLES TASK SWITCHING SO THINGS CAN PROCEED
;	NORMALLY. THE PARAMETERS THAT "LEVELS" CURRENTLY DISPLAY
;	ARE:
;	1) EACH TIMESHARING(NO REALTIME) TASK IN MEMORY.
;	2) THE USER ID CURRENTLY RUNNING THE TASK.
;	3) THE TERMINAL THAT THE USER IS LOGGED IN UNDER.
;	4) THE USERS  LOGIN U.I.C.
;	5) THE AMOUNT OF CPU TIME THAT EACH JOB HAS USED IN TICKS.
;	6) THE INSTALLED TASK NAME(IF OTHER THAN JOB NAME).
;	7) THE CURRENT SYSTEM UTILIZATION AS A FUNCTION OF SWAPPING.
;	8) THE TOTAL FREE NODES AND MAX HOLE AVAILABLE.
;	9) IF THERE IS A DEVICE LOAD PENDING, A MESSAGE WILL BE SENT
;	   TO THE OPERATOR EACH TIME LEVELS IS RUN, UNTIL THE
;	   LOAD REQUEST IS SATISFIED.
;	10) IF THE TOTAL AVAILABLE NODES OR MAX HOLE DROPS BELOW
;	    75, A WARNING MESSAGE WILL BE SENT TO THE OPERATOR'S
;	    CONSOLE TO WARN THAT A CRASH IS IMMINENT.
;	11) The actual task size in words.
;
;	THIS PROGRAM IS CURRENTLY RUNNING ON A ADDS CONSUL-580 VIDEO TERMINAL
;	BUT THERE IS A PROVISION IN THE ASSEMBLY PARAMETERS IN CASE
;	A VT-52 OR LA-36 IS TO BE USED INSTEAD.
;
;	THIS ROUTINE USES PART OF ONE OF THE TIMING PARAMETER WORDS
;	IN IASCOM TO PUT THE PREVIOUS SYSTEM UTILIZATION FIGURE
;	SO AS TO GIVE A MORE ACCURATE(MAYBE?) UTILIZATION FIGURE.
;	THE CURRENT LIMITS OF THIS PROGRAM ARE 32 TIMESHARING
;	JOBS TO BE DISPLAYED.
;	
;	Note: This utilization parameter was a modification to the
;	      IASCOM database. Reference symbol .SUTIL within
;	      IASCOM for a description of this parameter.
;	      Or define the symbol NOCHG within this file
;	      and the symbol will be defined locally to this module,
;	      instead of within IASCOM.
;
;
;*****************************************************************************

	.SBTTL	INITIALIZATION SECTION
;*****************************************************************************
 
START:
 
	DIR$	#DECL			; Declare a significant event


;	Main collection point.

LEV:	.INH0				;; INHIBIT TASK SWITCHING
	CALL	GETLDD			;; Transfer the device load info
	CALL	GETUJN			;; + Get UJN info
	CALL	UTIL0			;; Get system utilization
	CALL	NODE			;; Get node pool information
	.ENB0				;; Enable task switching
 
;*****************************************************************************

	.sbttl	Start to dequeue info
;*****************************************************************************

	DIR$	#GETTIM			; Get current time and date

	MOV	#INBUF,R0		; Set up to output
	MOV	#HDRLIN,R1		; Point to format line
	MOV	#TIMBUF,R2		; Set p-list pointer
	CALL	$EDMSG			; Convert to ASCII
	PRINT	#CLRSCN,#CLRSZ		; CLEAR THE SCREEN
	PRINT	#INBUF,R1		; AND OUTPUT HEADER LINE

	CLR	R1			; CLEAR R1
	CLR	R4			; CLEAR POINTER
EDEQ1:	INC	R1			; ADVANCE LEVEL POINTER
	CMP	R1,NLEV			; LAST LEVEL ????
	BMI	DEQ2			; YES GO WAIT
	JMP	WAIT			; 

DEQ2:	MOV	R1,LEVEL		; SET UP LEVEL
	MOVB	LEVCT(R1),R5		; PUT UJN COUNT IN R5
	BEQ	EDEQ1			; RIGHT GO TO NEXT LEVEL
	MOV	R1,R3			; SAVE OFF R1 IN R3
	MOV	#INBUF,R0		; Set buffer pointer
	MOV	#LVLLIN,R1		; Point to format line
	MOV	#LEVEL,R2		; Point to the actual data
	CALL	$EDMSG			; Convert and format
	PRINT	#INBUF,R1		; And output the the terminal
 
;*****************************************************************************

	.sbttl	format job line
;*****************************************************************************

PRI:	MOV	#JBLNAL,R0		; Use R0 to set up job arg. list
	MOV	NAME(R4),(R0)+		; GET FIRST HALF OF RAD50 NAME
	MOV	NAME+2(R4),(R0)+	; GET SECOND HALF
	MOV	TERM(R4),R2		; GET TERMINAL NODE ADDRESS
	MOV	R2,(R0)			; Set pointer to user terminal node
	ADD	#I.UN,(R0)+		; Set pointer to username string
	MOV	R2,(R0)			; Set pointer to user terminal node
	ADD	#I.DN,(R0)+		; Set to display device name
	MOVB	I.TT(R2),R1		; GET TERMINAL #
	MOV	R1,(R0)+		; AND PLACE IN ARGLST
	MOV	#UIC+1,(R0)		; Set pointers for the UIC
	ADD	R4,(R0)+		;  pointer for group code
	MOV	#UIC,(R0)		;  and also pointer
	ADD	R4,(R0)+		;  for programmer code
	MOV	#CPU,(R0)		; Point to the accounting
	ADD	R4,(R0)+		;  double word
	MOV	STD(R4),R2		; GET SYSTEM TASK DIR ADDRESS
	MOV	S.TN(R2),(R0)+		; GET FIRST TASK NAME
	MOV	S.TN+2(R2),(R0)+	; AND SECOND HALF
	MOV	TS(R4),R1		; TASK SIZE IS IN 32 WORD BLKS
	MUL	#32.,R1			; SO ADJUST ACCORDINGLY
	MOV	R1,(R0)+		; AND PLACE IN ARGLST
	MOV	#INBUF,R0		; Get output buffer pointer
	MOV	#JOBLIN,R1		; Point to format string
	MOV	#JBLNAL,R2		; Point to argument list
	CALL	$EDMSG			; And format the mess
	PRINT	#INBUF,R1		; Output the line to the screen

PRI1:	ADD	#4,R4			; Set index to next job
	SOB	R5,PRI			; Loop till thru

NEXT:	MOV	R3,R1			; RESTORE R1
	JMP	EDEQ1			; NEXT LEVEL

	.sbttl	NOW TRANSLATE THE SYSTEM UTILIZATION
;*****************************************************************************
 
WAIT:	CLR	R3			; Clear count

	PUSH	<#TEMP+14,#TEMP+10,#TEMP+4,#TEMP>  ; Set up paramter list
	MOV	#INBUF,R0		; Set output buffer pointer
	MOV	#STABUF,R1		; Set up for Statistics line
	MOV	SP,R2			; Point to the argument list
	CALL	$EDMSG			; Process the line
	ADD	#10,SP			; Clean up the stack
	ADD	R1,R3			; Accumulate total line length
	MOV	#UTMES,R1		; Set up for utilization line
	MOV	#.SUTIL,R2		; Point to utilization word
	CALL	$EDMSG			; Process the line
	ADD	R1,R3			; Accumulate total line length
	MOV	#NDMES,R1		; Set up for node,max hole, total term
	MOV	#NODE1,R2		; Point to the appropriate spot
	CALL	$EDMSG			; process this line
	ADD	R1,R3			; Accumulate total line length
	PRINT	#INBUF,R3		; And output the total message

	CMP	#75.,NODE1		; Is the node pool depleted??
	BLOS	LDPEND			; No - check for load pending
	MOV	#INBUF,R0		; Else send message
	MOV	#WRNMES,R1		; Indicating this fact
	MOV	#NODE1,R2		; to the system operator
	CALL	$EDMSG			; Format message
	PRINT	#BUZBUF,#BUZS		; Sound the bell
	PRINT	#INBUF,R1		; And print warning message

LDPEND:	MOV	DLCNT,R4		; Is there a load request pending?
	BEQ	FILSTF			; EQ - No
	MOV	#DLTSAV,R1		; Point to save area
 
;	Set up the volume information

10$:	MOV	#JBLNAL,R0		; Set up the parameter list
	MOV	R1,(R0)			; Set base address
	ADD	#4,(R0)+		; Point to volume name
	MOV	R1,(R0)+		; Point to device name
	MOV	2(R1),(R0)+		; Move unit # into place

;	Set up the requestor information.
 
	MOV	20(R1),R3		; Get UJN address
	MOV	J.TA(R3),R3		; Point to terminal node
	MOV	R3,(R0)			; Set base address
	ADD	#I.UN,(R0)+		; Point to user name
	MOV	R3,(R0)			; Set base address
	ADD	#I.DN,(R0)+		; Point to device name
	MOVB	I.TT(R3),R3		; Get the device #
	MOV	R3,(R0)+		; Store device #
 
;	Format the message and print it

	PUSH	R1			; Preserve pointer to save table
	MOV	#INBUF,R0		; Set outbuf pointer
	MOV	#LODMES,R1		; Set format string @
	MOV	#JBLNAL,R2		; Set arglist pointer
	CALL	$EDMSG			; Format the line
	PRINT	#INBUF,R1		; Output the line

	POP	R1			; Restore pointer
	ADD	#22,R1			; Point to next entry
	SOB	R4,10$			; Loop till through

;*****************************************************************************

	.sbttl	File I/O stuff and Exit code
;*****************************************************************************
	.enabl	lsb
FILSTF:
	.if	df	realtm
 	OPNS$M	#MESFDB			; OPEN NOTICE.TXT
	BCC	10$			; CC - then file exists
	MOVB	F.ERR(R0),R0		; Get error code
	PUSH	R0			; Leave on stack
	MOV	#INBUF,R0		; Point to the output area
	MOV	#FILNF,R1		; Point to the format string
	MOV	SP,R2			; Point to the argument list
	CALL	$EDMSG			; Format the error message
	TST	(SP)+			; Clear junk off stack
	PRINT	#INBUF,R1		; Output message
	BR	STOP			; And go exit

10$: 	DIR$	#RDREC			; READ THE FIRST BLOCK

	MOV	#INBUF+2,R0		; Point to output area
	MOV	#NOTMES,R1		; Point to input format string
	MOV	#.SUTIL,R2		; Point to utilization figure

	CALL	$EDMSG			; And format the message

 	DIR$	#WTREC			; NOW REWRITE THE BLOCK

 	CLOSE$	#MESFDB			; Close the file
	.endc

STOP:	.if	df	realtm 
	DIR$	#RUNN			; Request us again.
	.endc

	EXIT$S				; AND EXIT GRACEFULLY(ALWAYS)
	.dsabl	lsb

;*****************************************************************************

	.sbttl	Utilization routine
;*****************************************************************************
 
;	This routine calculates the system utilization
;	as a function of work done versus elapsed time.
 
;	The calculation performed is:
 
;	  UTILIZATION = (USER_TIME + SWAP_TIME)/ELAPSED_TIME * 100%

;	Note:	This subroutine is entered with task switching disabled
 
;	Register Conventions:
 
;		R0-R5	-	Unused
;		AC0	-	Accumulator for utilization percentage
;		AC1	-	Scratch

UTIL0:	MOV	.SUTIM,TEMP		;;
	MOV	.SUTIM+2,TEMP+2		;; Save all statistics
	MOV	.SPTIM,TEMP+4		;;
	MOV	.SPTIM+2,TEMP+6		;; ...
	MOV	.SNTIM,TEMP+10		;;
	MOV	.SNTIM+2,TEMP+12	;; ...
	MOV	.SSTIM,TEMP+14		;;
	MOV	.SSTIM+2,TEMP+16	;; ...

	.if	df	realtm
	CLR	.SUTIM			;;
	CLR	.SUTIM+2		;; Clear all statistics
	CLR	.SPTIM			;;
	CLR	.SPTIM+2		;; For next time
	CLR	.SNTIM			;;
	CLR	.SNTIM+2		;; ...
	CLR	.SSTIM			;;
	CLR	.SSTIM+2		;; ...
	.endc

	AC0=%0				;; Define the FP registers 
	AC1=%1

	SETF				;; Set SP on the FPP
	SETL				;; Set long integer

	LDCLF	TEMP,AC0		;; LOAD TOTAL TIME USER JOBS
	LDCLF	TEMP+4,AC1		;; LOAD TOTAL SWAP TIME
	ADDF	AC1,AC0			;; GET TOTAL UTILIZATION
	LDCLF	TEMP+14,AC1		;; GET TOTAL ELAPSED TIME
	DIVF	AC1,AC0			;; GET UTILIZATION
	MULF	ONEHUN,AC0		;; Get percentage
	SETI				;; Set integer mode
	STCFI	AC0,.SUTIL		;; Store utilization

	RETURN				;; AND LEAVE

;*****************************************************************************

	.sbttl	Node and Max-Hole module
;*****************************************************************************
 
;	This subroutine finds the total number of available
;	8-word nodes in the pool and also finds the largest
;	contiguous area(hole) in the pool.
 
;	Note:	This subroutine is entered with task switching
;		disabled.

;	Register Conventions:
;
;	R0	-	Pointer to pool listhead
;	R1	-	Total nodes available count
;	R2	-	Size of largest hole
;	R3	-	Total fragments in pool.
;	R4-R5	-	Unused
 
;	This subroutine destroys *NO* registers

NODE:	CALL	$SAVAL			;; SAVE ALL GP REGISTERS
	MOV	.POLLH,R0		;; GET POOL LIST HEAD
	CLR	R1			;; CLEAR TOTAL NODES COUNT
	CLR	R2			;; CLEAR LARGEST HOLE COUNT
	CLR	R3			;; Clear fragment count

;	Scan loop. The pool is a linked list with the
;	last link a null(0) value.

10$:	INC	R3			;; Bump fragments count
	ADD	2(R0),R1		;; ADD IN NEW HOLE SIZE
	CMP	2(R0),R2		;; IS THIS THE LARGEST HOLE SO FAR?
	BLOS	20$			;; BR IF NO.
	MOV	2(R0),R2		;; GET NEW SIZE
20$:	TST	(R0)			;; DONE??
	BEQ	30$			;; BRANCH IF YES
	MOV	(R0),R0			;; ELSE MOVE TO NEXT HOLE
	BR	10$			;; LOOP TILL THRU

;	All through. Change node and max hole counts to
;	units of eight words, and store them along with the
;	fragments count for later display.

30$:	ASH	#-4,R2			;; GET PROPER HOLE
	ASH	#-4,R1			;; AND NODE COUNT
	MOV	R1,NODE1		;; AND NO. OF AVAILABLE NODES
	MOV	R2,HOLE			;; SAVE MAX HOLE
	MOV	R3,FRAGM		;; Save # of pool fragments.
	RETURN				;; Return to calling procedure

;*****************************************************************************

	.SBTTL	Device load table save module
;*****************************************************************************
 
;	This subroutine saves any information from the 
;	device load table to display back to the operator's
;	console in the event of a device load pending.
 
;	The format of the save table is:
;
;	Word	Byte	Description
;	----	----	------------------------------------------
;	 0	0,1	Device mneumonic(i.e. MM,DX,DB,etc)
;	 1	0,1	Unit number.
;	 2-7	all	12 character Volume name.
;	 8	0,1	UJN entry of requestor.

;	Note:	This subroutine is entered with task switching
;		disabled.
 
;	Register Conventions are:
 
;	R0	-	Pointer to device load table.
;	R1	-	Number of device loads outstanding.
;	R2	-	Pointer to save area
;	R3-R5	-	Scratch

	DV.UJN=2
	DV.DEV=4
	DV.UNI=6
	DV.VOL=10
	DV.SZ=32

GETLDD:	CALL	$SAVAL			;; Save all registers

	MOV	.DLTNO,R1		;; Any device loads outstanding?
	BEQ	90$			;; EQ - then return
	MOV	.DLTBA,R0		;; Get device table base @
	MOV	#DLTSAV,R2		;; Device load save area

100$:	BITB	#ST.LOA,DV.ST(R0)	;; Is a load request pending?
	BEQ	120$			;; EQ - Nope, check next device
	INC	DLCNT			;; Yes, bump up count
	MOV	DV.DEV(R0),(R2)+	;; Save the Device name
	MOVB	DV.UNI(R0),R3		;; Save the
	MOV	R3,(R2)+		;; Unit Number
	MOV	R0,R3			;; Save R0

	ADD	#DV.VOL,R3		;; Point to Volume label
	MOV	#6,R4			;; And its length in words
110$:	MOV	(R3)+,(R2)+		;; Move into position
	SOB	R4,110$			;; Loop until thru

	MOV	DV.UJN(R0),(R2)+	;; Save the UJN of requestor
120$:	ADD	#DV.SZ,R0		;; Point to next entry
	SOB	R1,100$			;; Loop until all requests saved

90$:	RETURN				;; Return to calling proc.

;*****************************************************************************

	.sbttl	Get UJN info.
;*****************************************************************************
	.enabl	lsb

;	This subroutine scans the UTL for active tasks and retrieves
;	pertinent information about each task for later display.
 
;	Note, this subroutine is entered with task switching disabled.

;	Register Conventions are:
;
;	R0	-	UTL list pointer.
;	R1	-	Current Timesharing level number
;	R2	-	ATL list pointer for current UJN
;	R3	-	Pointer to last UJN at this level
;	R4	-	Pointer to information save area.
;	R5	-	Pointer to next level.

GETUJN:	CALL	$SAVAL			;; Preserve our registers

;	Initialize. 

	MOV	.UTLNO,NLEV		;; Save the number of levels
	INC	NLEV			;; Add a level for batch
	MOV	.UTLHD,R0		;; Place listhead -> R0
	CLR	R4			;; Set inital save index
	CLR	R1			;; Set initial level number

;	Set up for next level or return.

5$:	INC	R1			;; Bump up level #
	CMP	R1,NLEV			;; SEE IF AT LAST LEVEL 
	BMI	10$			;; NO, THEN CHECK THIS LEVEL
100$:	RETURN				;; ALL DONE, Return

;	Set up for current level.

10$:	MOV	R1,LEVEL		;; SAVE CURRENT LEVEL
	MOV	Z.NL(R0),R5		;; SAVE NEXT LEVEL IN R5
	MOV	Z.FJ(R0),R2		;; SAVE FIRST UJN ADDRESS
	MOV	Z.LJ(R0),R3		;; SAVE LAST UJN ADDRESS
	TSTB	Z.NE(R0)		;; IS ANYTHING AT THIS LEVEL?
	BEQ	20$			;; EQ -- THEN THIS LEVEL'S EMPTY
	MOV	R2,R0			;; ELSE PUT FIRST UJN @ IN R0
 
; 	NOW CHECK TO SEE IF IT'S A CLI. IF IT IS, THEN
; 	WE DON'T WANT TO DISPLAY IT.(...PDS,...SCI, ETC)
;	If it is, then bump the logged-in users count.
 
12$:	CMP	J.JB(R0),CLIR		;; IS THIS A CLI
	BNE	14$			;; NO... GO ON
	INC	USERS			;; KEEP TRACK OF # OF ACTIVE CLI'S
	CMP	R0,R3			;; IS THIS THE LAST UJN
	BEQ	20$			;; EQ - GO TO NEXT LEVEL
	MOV	(R0),R0			;; Point to next list element
	BR	12$			;; Check it out

 
;	NOW PULL OUT ANY JOBS RUNNING AT THIS LEVEL OF TIMESHARING
;	AND STORE THEM IN A BUFFER SO WE CAN TRANSLATE AND FORMAT
;	THEM LATER ON. 
 
14$:	MOV	J.JB(R0),NAME(R4)	;; GET JOB NAME
	MOV	J.JB+2(R0),NAME+2(R4)	;; 2 RAD-50 WORDS
	MOV	J.TA(R0),TERM(R4)	;; SAVE TERMINAL NODE ADDRESS
	MOV	J.UI(R0),UIC(R4)	;; SAVE UIC
	MOV	J.AC(R0),CPU(R4)	;; Save double word
	MOV	J.AC+2(R0),CPU+2(R4)	;;  accounting INFO
	MOV	J.TS(R0),TS(R4)		;; + Save total task size
	MOV	J.AT(R0),R2		;; GET ATL NODE address
	MOV	A.TD(R2),STD(R4)	;; SAVE STD ENTRY

	INCB	LEVCT(R1)		;; BUMP UP COUNT of jobs at this level
	ADD	#4,R4			;; POINT TO NEXT OPEN BUFFER ENTRY
	CMP	R0,R3			;; IS THIS LAST UJN
	BEQ	20$			;; YES, GO TO NEXT3
	CMP	#100,R4			;; MORE THAN 32 ENTRIES ??
	BMI	100$			;; YES, QUIT scan
	MOV	(R0),R0			;; NO, GET NEXT LINK
	JMP	12$			;; AND GET NEXT NAME

20$:	MOV	R5,R0			;; Point to next level
	BR	5$			;; Check it out

;*****************************************************************************


	.sbttl	$OUT	-   Output to the terminal
 
;	This is the common output routine for the 
;	PRINT macro.
;
;	Arguments are:
;		
;		2(SP)	-	Address of the buffer to output
;		4(SP)	-	Length in bytes of output buffer
;		6(SP)	-	Format control character
 
;	This subroutine destroys *NO* registers.

$OUT:	MOV	2(SP),WRITE+Q.IOPL	; Set buffer address
	MOV	4(SP),WRITE+Q.IOPL+2	; Set buffer length
	MOV	6(SP),WRITE+Q.IOPL+4	; Set VFC character
	DIR$	#WRITE			; Output the string
	MOV	(SP)+,(SP)		; Clear the stack
	MOV	(SP)+,(SP)		;  ...
	MOV	(SP)+,(SP)		;  ...
	RETURN				; Return to who called us

	.END	START
