;***************************************************************************** .TITLE IASWHO .IDENT /V1.1/ .ENABL LC .NLIST BEX,CND,ME .SBTTL AUTHOR'S CREDITS .REM % This program is originally due to Randy Adams and Henry Tumblin of the Jackson Labs, and the IASWHO program distributed on the V3.0 tapes. It has been modified to utilize the formatting of TJL's LEVELS V5.0 for IAS V2.0, but has taken advantage of the proper table ofset parameters of IASWHO. The real time capabilities of the LEVELS program have been removed, and it also only supports VT-52 terminals. The list of tasks now also includes all of the CLI tasks (...PDS) so that logged in users can be determined. The distributed version of IASWHO for V3.0 had the unfortunate characteristic of not inhibiting task switching, and therefore very often printed out garbage before going belly-up. Current version author- John Hayes Allen-Bradley Company 747 Alpha Drive Cleveland, Ohio 44143 216-449-6700 Known bugs- The current version of IASWHO does not gracefully list information relating to spawned tasks. The program works fine, but the information for the spawned task looks a little wierd. % .SBTTL TELL THE ASSEMBLER WHICH LIBMACS TO USE ;***************************************************************************** .MCALL DIR$,FSRSZ$,QIOW$,EXIT$S,RUN$,RQST$,.ENB0 .MCALL GTIM$,FCSMC$,FINIT$,DECL$,.INH0 FCSMC$ vt52=1 ; define if for a VT-52 ; vt100=1 ; define for a VT-100 ; la36=1 ; define for a LA36 or ASR-33 .MACRO PUSH ARGS .IRP X, MOV X,-(SP) .ENDM .ENDM PUSH .MACRO POP ARGS .IRP X, MOV (SP)+,X .ENDM .ENDM POP .MACRO PRINT A,B,C=40 PUSH <,,> CALL $OUT .ENDM PRINT ;***************************************************************************** .sbttl Impure Area + Buffers ;**************************************************************************** .psect impur,d,rw,rel LEVCT: .BLKW 4 ; Level count(1 byte for each level) ;;NOTE: BYTES 1,2,3, and 4 are used...byte zero is ununsed UIC: .BLKW 2*SGTMM ; UIC CPU: .BLKW 2*SGTMM ; CPU time in tics STD: .BLKW 2*SGTMM ; STD entry for task NAME: .BLKW 2*SGTMM ; User name TERM: .BLKW 2*SGTMM ; Terminal number ;***************************************************************************** .sbttl QIO's, Status blocks, and other DPB's ;***************************************************************************** DECL: DECL$ ; Declare significant event WRITE: QIOW$ IO.WVB,1,1,110,,,<0,0,0> ; TERMINAL WRITE QIO UTIL: .WORD 0 ; WORD FOR SYSTEM UTILIZATION 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 12. ; 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 count DLTSAV: .REPT SGDEVM ; Device load table save area .BLKW 1 ; UJN of requestor .BLKW 1 ; Device name .BLKB 2 ; Unit Number, status .BLKW 6 ; Volume name .ENDR ;***************************************************************************** .SBTTL DATE AND TIME BUFFERS, Message strings ;***************************************************************************** .EVEN GETTIM: GTIM$ TIMBUF ; GET THE TIME AND TODAY'S DATE TIMBUF: .BLKW 8. ; BUFFER TO RECEIVE TIME INFORMATION. .SBTTL DEFINE STORAGE AREA. HDRLIN: .ASCIZ "%N** Current Task Status %Y %3Z %4SPDP-11/70 IAS V3.0%N" JOBLIN: .ASCIZ "%S%2R%2S%12E %2E%O [%B,%B]%6S%T %2R%N" LVLLIN: .ASCIZ "Level # %D%N" STABUF: .ASCIZ "User= %T Batch= %T Swap= %T Null= %T Elap= %T" UTMES: .ASCIZ "%NCurrent Utilization is now at %D%" LODMES: .ASCIZ "%NVolume %12A is mounted on %2A%O for %12A at %2A%O" NDMES: .ASCII "%NTotal Nodes = %D" .ASCII "%3SMax Hole = %D" .ASCII "%3SPool fragments = %D" .ASCIZ "%NTotal terminals logged in = %D%N" NOTMES: .ASCIZ "%N NOTE: Current utilization is now at %D% " WRNMES: .ASCIZ "%N%10SWarning --- Node pool dangerously low%N" .EVEN CLRSCN: .byte 33,'H,33,'J 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) CURRENTLY MOUNTED DEVICES. ; 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. ; ; ;***************************************************************************** .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 GETALO ;; Get the allocated devices 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 #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+20,#TEMP+14,#TEMP+10,#TEMP+4,#TEMP> ; Parameter 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 #UTIL,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 #INBUF,R1 ; And print warning message LDPEND: MOV DLCNT,R4 ; Are there any devices mounted? 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 CLRB 3(R1) ; Zero device status byte 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: STOP: 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: ; (USER_TIME + SWAP_TIME) ; UTILIZATION = ----------------------- * 100% ; (TOTAL_SYSTEM_TIME) ; 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- User MOV .SBTIM,TEMP+4 ;; MOV .SBTIM+2,TEMP+6 ;; ... Batch MOV .SPTIM,TEMP+10 ;; MOV .SPTIM+2,TEMP+12 ;; ... Swap MOV .SNTIM,TEMP+14 ;; MOV .SNTIM+2,TEMP+16 ;; ... Null MOV .SSTIM,TEMP+20 ;; MOV .SSTIM+2,TEMP+22 ;; ... System AC0=%0 ;; Define the FP registers AC1=%1 AC2=%2 SETF ;; Set SP on the FPP SETL ;; Set long integer LDCLF TEMP,AC0 ;; LOAD TOTAL TIME USER JOBS LDCLF TEMP+10,AC1 ;; LOAD TOTAL SWAP TIME ADDF AC1,AC0 ;; ADD IT IN LDCLF TEMP+20,AC1 ;; LOAD SYSTEM TIME DIVF AC1,AC0 ;; GET UTILIZATION MULF ONEHUN,AC0 ;; Get percentage SETI ;; Set integer mode STCFI AC0,UTIL ;; 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 devices loaded ; The format of the save table is: ; ; Word Byte Description ; ---- ---- ------------------------------------------ ; 0 0,1 Device mnemonic(i.e. MM,DX,DB,etc) ; 1 0 Unit number. ; 1 1 Device status ; 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 GETLDD: CALL $SAVAL ;; Save all registers MOV .DLTNO,R1 ;; Any devices mounted? BEQ 90$ ;; EQ - then return MOV .DLTBA,R0 ;; Get device table base @ MOV #DLTSAV,R2 ;; Device load save area 100$: INC DLCNT ;; Bump up count MOV DV.DEV(R0),(R2)+ ;; Save the Device name MOVB DV.UNI(R0),(R2)+ ;; Save the unit number MOVB DV.ST(R0),(R2)+ ;; And status 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 .DLTSZ,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 ; NOW CHECK TO SEE IF IT'S A CLI. IF IT IS, THEN ; WE WANT TO BUMP THE LOGGED IN USERS COUNT. 12$: MOV X.JN(R2),R0 ;; PUT FIRST UJN @ IN R0 CMP J.JB(R0),CLIR ;; IS THIS A CLI BNE 14$ ;; NO... GO ON INC USERS ;; KEEP TRACK OF # OF ACTIVE CLI'S ; 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 PUSH R2 ;; Save R2 MOV J.AT(R0),R2 ;; GET ATL NODE address MOV A.TAC(R2),CPU(R4) ;; Save double word MOV A.TAC+2(R2),CPU+2(R4) ;; accounting INFO MOV A.TD(R2),STD(R4) ;; SAVE STD ENTRY POP R2 ;; Restore R2 INCB LEVCT(R1) ;; BUMP UP COUNT of jobs at this level ADD #4,R4 ;; POINT TO NEXT OPEN BUFFER ENTRY CMP R2,R3 ;; IS THIS LAST UJN BEQ 20$ ;; YES, GO TO NEXT3 CMP #SGTMM*4,R4 ;; ENOUGH ENTRIES ?? BMI 100$ ;; YES, QUIT scan MOV N.FP(R2),R2 ;; NO, GET NEXT LINK JMP 12$ ;; AND GET NEXT NAME 20$: MOV R5,R0 ;; Point to next level BR 5$ ;; Check it out ;***************************************************************************** ;***************************************************************** ; ; GETALO - GET THE DEVICE ALLOCATION INFORMATION ; ; ; GETALO: RETURN ;DUMMY FOR NOW ; ;***************************************************************** .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