.TITLE WATCH_DOG - Interactive Process Monitor .IDENT /V5.0-0/ ;++ ; Program: WATCHDOG ; ; Original: unknown (program came from DECUS Tape) ; ; Modifier's Address: ; George H. Walrod III ; 7908 Brooks Place ; Greenbelt, MD 20770 ; ; Purpose: This Program Monitors Interactive Processes and Logs Off ; Processes Set There Idle. ; ; Compilation: ; ; Corrected Modification: ; V3.6-0 06-May-1985 George H. Walrod III ; Watchdog rushed to Veterinarian Hospital, after being ; found on DECUS Tape Suffering from Owner's Neglect (not ; functioning properly). After One Hundred Hours of ; Reconstructive Surgery, and Plenty of Testing Watchdog is ; being Discharged. Insect(Bug) Removed Surgery Include ; Poor Documentation of Source Code. Eye Sight Correction ; Was Done Because of Processes DECneting Over to Another ; System. The Process on the Host System Looks Idle but ; Still Should NOT be Logged Off the Remote Process May be ; Busy Working. ; ; V3.6-1 22-May-1985 George H. Walrod III ; Correct Bug if User Spawns a Subprocess the Subprocess ; Does not Have a Terminal when you do a $GETJPI, so we ; Search for the Parent Process to Get the Terminal. If ; Parent has No Terminal They are probably a Detach Process ; and We Do Not Touch those Processes. ; ; V3.6-2 22-May-1985 George H. Walrod III ; Security/Bug, If user Spawn a Subprocess and then ; Suspends his Parent Process, Then we can't find his ; Terminal. The User seems to be trying to avoid Watchdog ; So we warning him but send no Messages, and eventually ; log him off, Knowing That it will probably hang him in ; Suspended Process. But we try to resume the Parent ; Process first knowing that this will probably no work. ; ; V3.7-0 26-May-1985 George H. Walrod III ; Watch Dog get hits by Car! When Watchdog tells the user ; that they are being logged off and the User logs out on ; their own, When Watch goes to bite(Delete) the user ; process for the final Kill, and user is gone. Watchdog ; dies when a car(Error) come from no where. The license ; plate of the car is "SS$_NONEXPR" (nonexistent process). ; ; V4.0-0 06-Dec-1985 George H. Walrod III ; Alan Cutler ; DEC Goes Against Own Standard, Version 4.X changes the ; Indexed PID to Extended PID. Added Routine to Change ; PID (GETPID). THIS CALL MUST BE COMMENTED FOR VMS ; VERSION LESS THAN 4.X. ; ; V4.0-1 17-Dec-1985 George H. Walrod III ; VAX/DBMS Tries to Jump Fence, While Watchdog is looking and ; mulls Detached Process. By VAX/DBMS Creating a Detached ; Process with a Terminal Name of a Mailbox, Watchdog Thinks ; It a Interactive Process. Watchdog Ignores Terminal Types ; 'MB'. ; ; V4.0-2 17-Jan-1986 George H. Walrod III ; Watchdog Jumps out of Car, and Wanders up to Tewksbury, ; Massachusetts and is Found by VAX/VMS Software Engineer. ; Software Engineer returns Watchdog back to Owner, with bad ; news that Watchdog has encountered a deadly but curable ; disease the ALL-IN-ONE Spotted Fever Tick. Watchdog has ; Problem Living in the Same Environment as ALL-IN-ONE, Due ; to the Way Watchdog Looks at Subprocesses in Relation to ; Parent Process this Problem is Correct When Watchdog is ; Release from Veterinarian Hospital(next major release), but ; it OK to use if All-In-One is not on System. ; ; V4.0-3 18-Feb-1986 George H. Walrod III ; Food and Drug Administration (FDA) Starts Major Investigation ; of ALL-IN-ONE Spotted Fever Tick, that Watchdog has acquired ; while up in Tewksbury, Massachusetts. After Four Weeks of ; Investigation (THATS FAST FOR THE U.S. GOVERNMENT), FDA has ; Determined the Spread of the ALL-IN-ONE Spotted Fever Tick, ; Has Become of Epidemic proportion, has Infected all programs ; of this Type. Police have charged all DECUS Program Authors ; and Owners of Not Maintaining There Programs. In Watchdog's ; Case is not Charged, The Charged is an Over Caring Owner ; (Perfectionist), Thus Over Working the Owner. The Sentence ; is to No Longer Support Version of Watchdogs running in ; VMS environments of 3.X for less and all Programs must ; Be Recompiled. ; ; V4.1-0 24-Feb-1986 George H. Walrod III ; WELCOME HOME WATCHDOG!!! Watchdog is Released from ; Veterinarian Hospital with a Clean Bill of Heath. The ; Disease of the ALL-IN-ONE Spotted Fever Tick is Curried and ; Previous Restriction of Processes not being able to be ; Resumed after Being Suspended. The Cure Required Major ; Reconstructive Surgery on the Way Watchdog Looks at ; Subprocesses. Watchdog starts by Looking at Master PID ; Process, then if There are Any Subprocesses Have They Are ; Looked at After That. A Process is Stop After the Stop ; Process limit is Reached and All Processes Connect with the ; Process are Inactive. Also the Reconstructive Surgery Makes ; Provision for Watchdog Next Veterinarian Checkup, which ; Gives Watchdog's Master the Power of Exceptions. ; ; V4.2-0 11-Feb-1987 George H. Walrod III ; Watchdog Readmitted to Veterinarian Hospital, with a Serious ; Condition : Layered Product Dependences with a touch of High ; Level Language Fever! This came about after an attempt was ; made to Implement Power of Exception. The Plastic surgeon ; noticed that this condition was causing permanent scars to ; develop on coat(code) after the last Reconstructive Surgery. ; The surgeon recommended that additional surgery be done with ; only a 25% chance of Watchdog ever looking the same. During ; the operation, lightning struck the hospital and caused the ; scalpel to lash Watchdog coat (removing all high level ; FORTRAN code). With the surgeon receiving a blow on the head ; causing amnesia and making him think he is Dr. Frankinstein. ; After several months the surgeon came to his senses and ; realized what he had done, but with the technologies of VMS ; he rebuilt Watchdog, making it Stronger (Able to Stop ; Processes three different way : Disconnect using the Virtual ; Terminal Driver to Disconnect Code, Force Exit a Process and ; Delete Process), Faster (no more $GETJPI, more efficient code, ; less page faulting), Better (Power of Exceptions :Variable ; Length Timer to Stop and Warn User at on a per user/group ; basics including Options ...) Able to create the first virtual ; dog that bits users on different times. The Surgeon would like ; to thank a Group Individuals who came together at Dallas and put ; a 5 page Wishlist together, so I could give you the complete ; tool you need. ; ; V4.2-1 12-Apr-1987 George H. Walrod III ; Watchdog is in to much of a hurry get out side, and chokes ; himself on leash. Syntax error correction on parse table. ; Properly check null argument in comparison of string (change ; first move from word to long). ; ; V4.2-2 15-Apr-1987 George H. Walrod III ; Increase information on coroner's report if Watchdog decides ; to die (cease to exist). Stopped using $EXIT macro to signal ; error in CHECK macro, replaced with LIB$SIGNAL. Also added ; /DUMP to the starting up of Watchdog, so some information is ; gathered. ; ; V4.2-3 15-Apr-1987 George H. Walrod III ; Watchdog's voice changes when talking to users. Stopped ; using $BRDCST system service and started using $BRKTHRUW ; due to All-In-1 broadcast mailbox. ; ; V4.2-4 16-Apr-1987 George H. Walrod III ; Watchdog jerk on chain in Version 4.2.2 to increase ; information did not work, so correcting replacing ; LIB$SIGNAL with LIB$STOP. ; ; V4.2-5 16-Apr-1987 George H. Walrod III ; Watchdog's All-in-1 Spotted Fever Tick Sprayed for, by ; snap-shotting user after sending warning messages. ; ; V4.2-6 27-Apr-1987 George H. Walrod III ; Watchdog Goes West, acting as Lone-Ranger but wearing ; a mask that only one eye could see out of. The mask ; could only be described as register entry type ^M, ; to correct the problem mask changed to look like ^M. ; With the mask being incorrect, false file status were being ; passed revealing an unwritten buffer, because of RMS local ; buffer were set in RAB ROP Field. Problem corrected. ; ; V4.2-7 01-May-1987 George H. Walrod III ; Watchdog Lead down Dark Alley in Texas, Armed with new tools ; that he thought would stop any interactive user. How wrong ; he was Keymo-Sobey, the $FORCEX tool should only be used as ; a front-end to the $DELPRC. Problem Corrected. ; ; V4.2-8 03-May-1987 George H. Walrod III ; "Slow Down Partner and Expand your Horizon !", Says the Wise ; Man from West. Allow the Logoff Message to Complete before ; Termination. Also Expand Operator buffer so Buffer-Overflow ; does not cause corruption of descriptor causing SS$_ACCVIO. ; Problem Corrected. ; ; V4.2-9 09-May-1987 George H. Walrod III ; "Danger Will Robinson(Watchdog), Danger!", shouts the ; Robot(Scheduler) before receiving a cold Arctic blast of air ; while in Minnesota, as Watchdog attempts to look at the ; Rightslist of a process that may not still exist. Machine ; Crashes giving INVEXCEPTN, Exception while above ASTDEL or on ; interrupt stack, Signal Array Exception Code Indicates Access ; Violation, while in EXE$SEARCH_RIGHT. Problem Corrected, ; making a reduction of 4 bytes in each PSB block possible, ; which may not seem allot but when you multiply that by ; MAXPROCESSCNT, It can be over a page. Speed Improvements have ; been made in IPL code to Get Process Information, as well as ; in size of Code. ; ; V4.2-10 23-May-1987 George H. Walrod III ; "Watchdog has Completed its Training(Testing), and is Now ; Ready for the Olympics(DECUS Library)", says the Trainer. ; After almost two months of testing, at over 40 selected sites, ; Watchdog is again ready to meet the public. Overall coding ; improvements have been done in the areas of speed and ; effectiveness of code. These improvements included several ; fixes and the coding of EXE$SEARCH_RIGHT into Watchdog. This ; coding was necessary since Watchdog needs to execute this code ; at IPL level Synch, so Identifiers of other processes may be ; checked. The VMS routine EXE$SEARCH_RIGHT location posed at ; problem since it resided in Paged Pool and no guarantees could ; be placed if it was resident or not. Swapped Processes are no ; longer a problem, the Get Process Information was rewritten to ; always get process header information, with the exception of ; a suspended process. The suspended processes are assume idle, ; if they are interactive processes. The amount of Nonpaged Pool ; needed to buffer process information was reduced from ; MAXPROCESSCNT*72 bytes to only 68 bytes. This now makes the ; maximum amount of Nonpaged Pool used at one time 68 bytes + ; ACB$K_LENGTH + the Size of Special Kernel AST = approximately ; 143 bytes. Get Process Information routine does not get all ; processes, it ignores network, batch, deletion pending process ; to save time since Watchdog does not look at these processes ; anyway. The FLAGDEF macro is no long used since it was totally ; redundant with the User Option Flags including the values, ; this means you DO NOT have to change already existing option ; flag values. Changes in the Disconnection routine were made ; so we go right from unlocking the I/O database to the Device's ; IPL for the disconnection and then back to user mode. Moved ; the LIB$WAIT change which was done in version 4.2-8 to after ; the code that sends any message which was send to the user ; by Watchdog, this was to accommodate, a slow application ; (WPSPLUS/VMS) which also causes the Buffer I/O Count and CPU ; time to go up. All known problem have been corrected. ; ; V5.0-0 06-May-1989 George H. Walrod III ; Pit Bull (VMS Development) attacks Watchdog with the teeth ; of VMS Version 5, rendering it helpless by changing the ; synchronization techiques. But on Watchdog's birthday, ; it prefails by owner nursing it back heath, after almost ; 7 months of version 5 testing. Some minor bugs corrections ; were included in this release : ; o Corrected terminal string extraction to exclude the ; colon that may appear in terminal name. ; o Support the use of Dollarsigns and Underscores in ; Exception Strings. ; o Typographical Correction in call EXE$SEARCHRIGHT. ; o Use of disconnect bit without the Virtual Terminal ; Driver will not crash system. ; ; Wishlist: ; o Move Functional Macros into Main Code, the Macro Library ; seems to love to Eat Comments, and Redocumented. ; ; o Removed Library Reference to Old Macro Library. ; ; o Rewrite Algormith for Granuality in GETMEM/FREEMEM Macros ; ; o Add Terminal I/O Completion Count as a requirement for ; Parent Processes being Idle, due to ACMS/ENTER Mismanagement ; of Accounting data, charging the ACMS processes with CPU ; time and Buffered I/O Completion. ; ; o Give Watchdog a Place in Life, a Default Disk and Directory. ; ; o Remove Unnessary Code from $NAM Block, Let RMS ; use its own buffers. ; ; o Checking of terminal in exceptions list the logical ; terminal as well as physical terminal need to be checked. ; ; o Remove Unused Status field from Process Status Block (PSB) ; ; o Improve Parser Messages ; ; o Allow Multi Wild Card Exception List Entries ; ; o Remove Image Exception Reference, it will NEVER be ; Implemented. ; ; o Start Following some VMS Engineering Macro Coding Standards ; ; o Impliment Log File Option ; ; o Replace INDEX with MULL3 Instruction do to speed. ; ; o Add Macro which emulates Maynard Defination Language (MDL) this ; will the replace the Assembly program Version of Program ; originally written, that only the developer has. ; ; Notes: ; ; Read File AAAREADME and ABSTRACT ; ; Uncomment the Next Line to Turn-on the Build-in Debugging Tools : ; DEBUG = 1 ; ;++ .PAGE .SBTTL LIBRARIES - Required Macro and Link Libraries ; ; Required Libraries ; .LINK "SYS$SYSTEM:SYS.STB" /SELECTIVE_SEARCH .LIBRARY "SYS$LIBRARY:LIB.MLB" .LIBRARY "WATCHDEF.MLB" .SBTTL SYMBOLS - Equated Local Symbol Definitions ; ; Equated Symbols ; CPU_50MS = 5 ; 50 MS Resolution MAX_STRING = 100 ; Maximum String Length BINARY_ONE_MIN = -600000000 ; Binary Time BELL = ^X07 ; ASCII Bell TAB = ^X09 ; ASCII Tab CR = ^X0A ; ASCII Carriage Return LF = ^X0D ; ASCII Line Feed FF = ^X0C ; ASCII Form Feed BLANK = ^X20 ; ASCII Space COMMENT = ^X21 ; ASCII Exclamation Point DOLLARSIGN = ^X24 ; ASCII Dollarsign UNDERSCORE = ^X5F ; ASCII Underscore .SBTTL MACROS - Local and System Macro Definitions ; ; Macros ; BADDEF ; Parse Error Flags EXCEPTDEF ; Exception Record Definitions PSBDEF ; Watchdog Process Scan Block USERDEF ; Watchdog Memory Database $ACBDEF ; AST Control Block Def $ARBDEF ; Access Rights Database $BRKDEF ; Breakthru Definitions $DCDEF ; Device Class Definitions $DDBDEF ; Device Data Block $DEVDEF ; Device Characteristics $DSCDEF ; Descriptor Definitions $DYNDEF ; Buffer Type Definitions $FABDEF ; File Access Block $IPLDEF ; Interrupt Priority Level $IRPDEF ; Intermediate Request Packet $JIBDEF ; Job Information Block $LNMDEF ; Logical Name Definitions $NAMDEF ; Name Block $OPCDEF ; Operator Control Definitions $OTSDEF ; OTS Definitions $PCBDEF ; Process Control Block Info $PHDDEF ; Process Header Definition $PRDEF ; Processor Register Definitions $PRIDEF ; Priority Definitions $RABDEF ; Record Access Block $RMSDEF ; RMS Definitions $STATEDEF ; State Definitions $SHRDEF ; Shared Message Definitions $SSDEF ; System Services Status $STSDEF ; Status Word Definitions $TPADEF ; LIB$TPARSE Definitions $TT2DEF ; Terminal Characteristics $TTYUCBDEF ; Terminal Unit Control Block $TTYVECDEF ; Terminal Vector Definitions $UCBDEF ; Unit Control Block Offsets $UICDEF ; User Identification Codes ; ; Check Size and Alignment of Symbol Definitions ; ASSUME FAB$L_STV EQ FAB$L_STS+4 ASSUME PSB_S_TERMINAL EQ PCB$S_TERMINAL ASSUME PSB_S_LNAME EQ PCB$S_LNAME ASSUME PSB_S_ACCOUNT EQ JIB$S_ACCOUNT+1 ASSUME PSB_S_USERNAME EQ JIB$S_USERNAME+1 ASSUME UCB$L_DEVCHAR2 EQ UCB$L_DEVCHAR+4 ; ; Routine Argument Offsets ; $OFFDEF CHECK_NETDEVICE, - ; Check Network Device ; Process Identification Number $OFFDEF CHECK_EXCEPTION_LIST, - ; Check Exception List ; User Address $OFFDEF DISCONNECT_TERMINAL, - ; Disconnect Terminal ; Terminal Descriptor $OFFDEF GET_PROCESS, - ; Get Process Information ; Process Vector Index $OFFDEF PARSER, - ; Parse Exception Table ; Exception Filename $OFFDEF COMPARE_STRINGS, - ; Compare String Arguments ; $OFFDEF COMPARE_EXCEPTION, - ; Compare Exception Arguments ; $OFFDEF SEARCH_RIGHTS, - ; Search Rights List Arguments ; $OFFDEF TERMINAL_CHAR, - ; Get Terminal Characteristics ; Terminal Characteristics .PAGE .SBTTL GLOBAL DECLARATIONS - Global or Commonly Used Data ; ; Global or Commonly Used Data ; .PSECT GLOBAL_DATA, PIC BEGIN_LOCK_REGION: ; ; Pure String Definations ; NETWORK_DEVICE: ; Network Device .ASCID 'NET0:' FAO_IN_STR: ; FAO Control String .ASCID '!AS !AC on !AC has been inactive for !SL min.' HEADER_MSG: ; Header Message .ASCID 'MESSAGE FROM WATCH_DOG' STAMP_MSG: ; Time Stamp Message .ASCID 'WATCH DOG TIME STAMP' LOGOFF_DEF: ; Default Logoff .ASCID ' and is being Logged Off' ; ; Read Write Data Area ; TERMINAL_DESC: ; Terminal Descriptor .BLKQ 1 FORCEX_VALUE: ; Force Exit Value .BLKL 1 OPER_FLAG: ; Operator Flags .BLKL 1 DEFAULT_FLAGS: ; Flags For Watchdog Operation .BLKL 1 SEND_STAMP: ; Time Stamp(send_stamp*asctim) .BLKL 1 START_MESSAGE: ; Start Sending Warning Msg .BLKL 1 STOP_PROCESS: ; Stop Process Msg .BLKL 1 TIME_STAMP: ; Time Stamp Counter .BLKL 1 BINTIM: ; Binary Time .BLKL 2 TIME_MINUTES: ; Time in Minutes .BLKL 1 USER_ADDR: ; Address of User DataBase .BLKL 1 PSB_ADDR: ; Address of Process Scan Block .BLKL 1 PSB_DB: ; Process Scan Block Size .BLKL 1 EXCEPTION_ADDR: ; Base Address of Exception .BLKL 1 NO_EXCEPTIONS: ; Number Exception Used .BLKL 1 DEVICE_CHAR: ; Device Characteristics .BLKL 2 RANGE: ; Working Set Purge .LONG 0 .LONG ^X7FFFFFFF TIMBF_DESC: ; Time Buffer Descriptor .WORD 8 .BYTE DSC$K_DTYPE_T, DSC$K_CLASS_S .ADDRESS TIMBF TIMBF: .BLKB 8 ; Time Buffer OPER_MSG_DESC: ; Operator Message Descriptor .WORD .BYTE DSC$K_DTYPE_T, DSC$K_CLASS_S .ADDRESS OPER_MSG OPER_MSG: ; Operator Message Buffer .BLKB USER_MSG_DESC: ; User Message Descriptor .WORD 255 .BYTE DSC$K_DTYPE_T, DSC$K_CLASS_D .ADDRESS USER_MSG USER_MSG: ; User Message Buffer .BLKB 255 CHECK_NETDEVICE_ARGLIST: ; Check Network Device Argument .LONG CHECK_NETDEVICE$_NARGS ; Number of Arguments .BLKL 1 ; Process Identification No DISCONNECT_TERMINAL_ARGLIST: ; Disconnect Terminal Argument .LONG DISCONNECT_TERMINAL$_NARGS ; Number of Arguments .ADDRESS TERMINAL_DESC ; Address of Terminal Desc. GET_PROCESS_ARGLIST: ; Get Process Info Argument .LONG GET_PROCESS$_NARGS ; Number of Arguments .BLKL 1 ; Index into PCB Vector COMPARE_EXCEPTION_ARGLIST: ; Compare Exception Argument COMPARE_STRINGS_ARGLIST: ; Compare String Argument SEARCH_RIGHTS_ARGLIST: ; Search Rights List Argument .LONG SEARCH_RIGHTS$_NARGS ; Number of Arguments .BLKL 1 ; Index PID .BLKQ 1 ; Exception Address TERMINAL_CHAR_ARGLIST: ; Terminal Char Argument List .LONG TERMINAL_CHAR$_NARGS ; Number of Arguments .ADDRESS TERMINAL_DESC ; Address of Terminal Desc. .ADDRESS DEVICE_CHAR ; Address of Device Char. .PAGE .SBTTL MAIN - Watchdog Main Module Executable Code ; ; Executable Code ; .ENTRY WATCHDOG, ^M ; ; Initialize Watchdog ; BRB 10$ ; DELTA Debugging Reference Point RET ; DELTA Debugging Instruction 10$: BSBW WATCHDOG_INIT ; ; Main Section of Program, Get Data on Users ; BEGIN_LOOKING: ; ; Increment Time Stamp and Check to See if it if time for a Time Stamp ; BBS #USER_V_NO_OPER_TIMESTAMP, DEFAULT_FLAGS, 10$ INCL TIME_STAMP ; Increment No of Stamps CMPL TIME_STAMP, SEND_STAMP ; Check and See if it's Stamp BNEQ 10$ ; Time SENDOPER STAMP_MSG ; Send Time Stamp CLRL TIME_STAMP ; Clear No of Stamps 10$: ; ; Scan All Processes to Get Process Information ; MOVAL GET_PROCESS_ARGLIST, R0 ; Get Address of Argument List CLRL GET_PROCESS$_INDEX(R0) ; Signal to Get All Processes $CMKRNL_S - ; Go Get All Processes routin = GET_PROCESS_INFORMATION - arglst = GET_PROCESS_ARGLIST MNEGL #1, R11 ; Clear Process Index ; ; Dump Process Status Block ; .IF DEFINED DEBUG DEBUG = DEBUG + 1 DUMP_PSB ,\DEBUG .ENDC ; ; Look at Next Process Scan Process Block ; NEXT_PROCESS: INCL R11 ; Increment Process Index MOVL #1, R8 ; Assume No CPU Time was Used ; or Buffer I/O ; ; Check for End of Scan Process Block ; CMPL R11, G^SCH$GL_MAXPIX ; Check Max Process Count BLEQU 10$ BRW SLEEP_TIME ; It is then Go to Sleep 10$: ; ; Compute the Scan Process Address of Next Process ; INDEX R11, #0, G^SCH$GL_MAXPIX, - ; Compute Index Into Scan Blk #PSB_C_BLN, #0, R10 ADDL2 PSB_ADDR, R10 ; Add Base Process Scan Blk ; ; Check for the Zero Pid (This could mean Null or Swapper PCB) ; TSTW PSB_W_IPIDIDX(R10) ; Check for Zero Pid Index BEQL NEXT_PROCESS ; No Process Present ; ; Compute the User Database Address of Process ; INDEX R11, #0, G^SCH$GL_MAXPIX, - ; Compute Index Into User DB #USER_C_BLN, #0, R9 ADDL2 USER_ADDR, R9 ; Add Base Address ; ; Watchdog at this point only looks at Parent Processes ; and Then Searches Other Later Out Later Necessary. ; CHECK_MASTER: CMPL PSB_L_MPID(R10), PSB_L_IPID(R10); Is This a Master Process? BNEQ NEXT_PROCESS ; ; If The Sequence Number Has Changed Since We Last Logged In, ; We Have A New Sucker. Reset All Counts Used , And Don't Bother Him ; ASSUME USER_L_START_MSG EQ USER_L_STOP_PROCESS-4 CHECK_SEQUENCE: CMPW USER_W_IPIDSEQ(R9), - ; Check for Same Sequence No PSB_W_IPIDSEQ(R10) BEQL 10$ ; Branch Same Process MOVW PSB_W_IPIDSEQ(R10), - ; Set New Sequence No USER_W_IPIDSEQ(R9) CLRL R8 ; CPU Time, Buffer I/O was Used MNEGL #1, USER_L_START_MSG(R9) ; Set New Start/Stop Values MNEGL #1, USER_L_STOP_PROCESS(R9) MNEGL #1, USER_L_OPTIONS(R9) BRW SAVE_PARAMS ; Save Parameters and Check ; Subprocesses 10$: ; ; Since the Process is a MASTER Process They Must be a ; Associated with a Terminal so Ignore the Process there is ; Not A Terminal. ; CHECK_TERMINAL: TSTB PSB_T_TERMINAL(R10) ; Is There a Terminal BEQL NEXT_PROCESS ; Branch if Not ; ; Find the Terminal Device and Check the Device Characteristics ; to See if it is Disconnected, if is Disconnect Ignore, Because ; the process will be terminate after SYSGEN TTY_TIMEOUT seconds. ; CHECK_DETACH_TERMINAL: MOVAL TERMINAL_DESC, R0 ; Get Address of Terminal Desc MOVZBL PSB_T_TERMINAL(R10), DSC$W_LENGTH(R0) MOVAL (R10), DSC$A_POINTER(R0) $CMKRNL_S - ; Get Terminal Characteristics routin = TERMINAL_CHAR - arglst = TERMINAL_CHAR_ARGLIST BLBC R0, 10$ ; Can't Find Device BBC #DEV$V_DET, DEVICE_CHAR+4, 20$ ; Branch If Not Detached? 10$: CLRW USER_W_IPIDSEQ(R9) ; Clear History of Process BRW NEXT_PROCESS ; Just Go to Next Process 20$: ; ; Leave The Processes Alone, IF There Using a Network Device ; CHECK_NETWORK_DEVICE: MOVAL CHECK_NETDEVICE_ARGLIST, R0 ; Get Address Argument List MOVL PSB_L_IPID(R10), CHECK_NETDEVICE$_PID(R0) $CMKRNL_S - ; Check for Any Network Devices routin = CHECK_NETDEVICE - arglst = CHECK_NETDEVICE_ARGLIST BLBC R0, 10$ ; No, Then They are Normal User CLRL R8 ; CPU Time, Buffer I/O was Used BRB SAVE_PARAMS ; Found a Network Device 10$: ; Allocated, So Go Save Params ; ; Check Watchdog's Special Exception List ; CHECK_SPECIAL_EXCEPTIONS: PUSHL R9 ; Push User Addr and PSB PUSHL R10 ; Push PSB CALLS #2, CHECK_EXCEPTION_LIST CMPW R0, #SS$_NONEXPR ; Is the Process Still There? BNEQ 10$ ; Yep BRW NEXT_PROCESS ; No Go to Next Process 10$: ; ; Normal User, Check Buffer I/O, or If 50ms Of CPU was Used ; ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 NORMAL_USER: ; ; Is the Process Header Resident? If Not Assume Their Idle ; MOVQ PSB_L_CPUTIM(R10), PSB_L_CPUTIM(R10) BEQL 20$ ; Assume He Idle CMPL PSB_L_BUFIOC(R10), - ; Check For Any Buffered I/O USER_L_BUFIOC(R9) BGTR 10$ ; Yes ADDL3 #CPU_50MS, USER_L_CPUTIM(R9), R0 ; Compute CPU time Limit CMPL R0, PSB_L_CPUTIM(R10) ; Check For Any CPU Time > .50 BGTR 20$ ; Yes 10$: CLRL R8 ; Get Victim in Our Sights 20$: ; ; Save Process Parameters (CPU Time and Buffer I/O Count) ; ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 ASSUME USER_L_CPUTIM EQ USER_L_BUFIOC-4 SAVE_PARAMS: MOVQ PSB_L_CPUTIM(R10), USER_L_CPUTIM(R9) ; CPU Time and Buffer I/O ; ; Does the Parent Have Any Subprocess Outstanding, ; If They Do We Must Look At Them Too. ; CHECK_SUBPROCESS: TSTW PSB_W_PRCCNT(R10) ; Are There Any Sub Processes BNEQ 10$ ; Yes, Scan Them BRW CHECK_STATUS ; No Finished Go Check Victim 10$: MOVL PSB_L_MPID(R10), R6 ; Check all Subprocess PUSHR #^M ; Owned By This MASTER PID MNEGL #1, R11 ; Clear Process Index ; ; Look at Next Subprocess Scan Process Block ; NEXT_SUBPROCESS: INCL R11 ; Increment Process Index ; ; Check for End of Scan Process Block ; CMPL R11, G^SCH$GL_MAXPIX ; Check Max Process Index BLEQU 10$ POPR #^M ; Restore Original Index Reg's BRW CHECK_STATUS ; Finished Go Check Victim 10$: ; ; Compute the Scan Process Address of Next Process ; INDEX R11, #0, G^SCH$GL_MAXPIX, - ; Compute Index Into Scan Blk #PSB_C_BLN, #0, R10 ADDL2 PSB_ADDR, R10 ; Add Base Process Scan Blk ; ; Check for the Zero Pid (This could mean Null or Swapper PCB) ; TSTW PSB_W_IPIDIDX(R10) ; Check for Zero Pid Index BEQL NEXT_SUBPROCESS ; No Process Present ; ; Compute the User Database Address of Process ; INDEX R11, #0, G^SCH$GL_MAXPIX, - ; Compute Index Into User DB #USER_C_BLN, #0, R9 ADDL2 USER_ADDR, R9 ; Add Base Address ; ; Watchdog at this point only Should look at Sub-Proceseses ; owned by the Parent Processes. ; CMPL R6, PSB_L_MPID(R10) ; Found Process Owned by Master BNEQ NEXT_SUBPROCESS ; Go For Next Sub-Process CMPL PSB_L_MPID(R10), PSB_L_IPID(R10) ; It the Master Process BEQL NEXT_SUBPROCESS ; Go For Next Sub-Process ; ; If The Sequence Number Has Changed Since We Last Logged In, ; We Have A New Sucker. Reset All Counts Used , And Dont Bother Him ; CHECK_SUBPROCESS_SEQUENCE: CMPW USER_W_IPIDSEQ(R9), - ; Does The Sequence Numbers PSB_W_IPIDSEQ(R10) ; Match? BEQL 10$ ; Yes! MOVW PSB_W_IPIDSEQ(R10), - ; Set New Sequence Number USER_W_IPIDSEQ(R9) BRB BUSY_SUBPROCESS ; Save New Parameters 10$: ; ; There Using a Network Device ; CHECK_EXCEPTIONS: MOVAL CHECK_NETDEVICE_ARGLIST, R0 ; Get Address Argument List MOVL PSB_L_IPID(R10), CHECK_NETDEVICE$_PID(R0) $CMKRNL_S - ; Check for Any Network Devices routin = CHECK_NETDEVICE - arglst = CHECK_NETDEVICE_ARGLIST BLBS R0, BUSY_SUBPROCESS ; Network Device Found, Can Not ; Warn the User ; ; Normal Subprocess, Check Buffer I/O, or If 50ms Of CPU was Used ; ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 NORMAL_SUBPROCESS: ; ; Is the Process Header Resident? If Not Assume Their Idle ; MOVQ PSB_L_CPUTIM(R10), PSB_L_CPUTIM(R10) BEQL SAVE_SUBPROCESS_PARAM ; Assume He Idle CMPL PSB_L_BUFIOC(R10), - ; Check For Any Buffered I/O USER_L_BUFIOC(R9) BGTR BUSY_SUBPROCESS ; Yes ADDL3 #CPU_50MS, USER_L_CPUTIM(R9), R0 ; Compute CPU time Limit CMPL R0, PSB_L_CPUTIM(R10) ; Check For Any CPU Time > .50 BGTR SAVE_SUBPROCESS_PARAM ; Yes BUSY_SUBPROCESS: CLRL R8 ; Get Victim in Our Sights ; ; Save the CPUTIM and BUFIOC ; ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 ASSUME USER_L_CPUTIM EQ USER_L_BUFIOC-4 SAVE_SUBPROCESS_PARAM: .IF DEFINED DEBUG ; Dump Process Before Message DEBUG = DEBUG + 1 MOVZWL PSB_W_IPIDIDX(R10), R0 ; Set Process Index DUMP_PSB R0, \DEBUG .ENDC MOVQ PSB_L_CPUTIM(R10), USER_L_CPUTIM(R9) ; CPU Time and Buffer I/O BRW NEXT_SUBPROCESS ; ; Check R8 to See if Any of the Processes Owned ; by the Current Master Process, has used by CPU time ; or Buffered I/O, or if One Process's Header Were Not Resident? CHECK_STATUS: TSTL R8 ; If R8 is Clear then Sometime BNEQ 10$ ; Say That I can't warn user CLRL USER_L_WARNING(R9) ; Clear Number of Warnings BRW NEXT_PROCESS ; So Branch to Next Process 10$: ; ; We Have Them Now, Check To See if We Can Start Sending Messages Yet ; to User and/or Central Operator ; ASSUME USER_L_START_MSG EQ USER_L_STOP_PROCESS-4 START_WARNING: INCL USER_L_WARNING(R9) ; Increment Number of Warning TSTL USER_L_START_MSG(R9) ; If Zero this Could Mean ; One of Two Time either ; No Warning Message to ; The User or Their Excluded ; (This is Usually the Case ; Since There is a Option Flag ; For No Warning Message) BNEQ 20$ TSTL USER_L_STOP_PROCESS(R9) ; If This is Zero Their are BNEQ 20$ ; Excluded so Reset CLRL USER_L_WARNING(R9) ; Number of Warning and 10$: BRW NEXT_PROCESS ; Branch to Next Process 20$: CMPL USER_L_WARNING(R9), - ; Can We Start With Msg Yet USER_L_START_MSG(R9) BLSS 10$ ; No Branch to Next Process 30$: ; ; Format User's Warning Message or Termination Message ; FORMAT_WARNING: PUSHAQ TIMBF_DESC CALLS #1, G^FOR$TIME_T_DS ; Get Current Time MOVW #255, USER_MSG_DESC ; Reset User Message Length MULL3 TIME_MINUTES, - ; Number of Minutes Idle USER_L_WARNING(R9), -(SP) PUSHAB PSB_T_TERMINAL(R10) ; Terminal Name PUSHAB PSB_T_USERNAME(R10) ; Username PUSHAQ TIMBF_DESC ; Current Time PUSHAQ USER_MSG_DESC ; Output Descriptor PUSHAQ USER_MSG_DESC ; Length Buffer PUSHAQ FAO_IN_STR ; Control String CALLS #7, G^SYS$FAO ; Format Warning Message CHECK ; ; Determine If We Are Going to Make Them History for the Message ; Get Time of Day and Assemble The Message ; CHECK_LOGOFF: CMPL USER_L_WARNING(R9), - ; Can We Append Logoff Msg USER_L_STOP_PROCESS(R9) BNEQ 10$ ; Not Enough Warning Yet APPEND LOGOFF_DEF, USER_MSG_DESC ; Append String 10$: ; ; Tell the Operator that the User is Being Logged Off or Warned ; TELL_OPERATOR: CMPL USER_L_WARNING(R9), - ; Is this a Logoff Message USER_L_STOP_PROCESS(R9) BNEQ 10$ ; Just a Warning BBC #USER_V_NOTIFY_OPER_LOGOFF, - ; No Logoff Message to Operator USER_L_OPTIONS(R9), NO_OPERATOR_MESSAGE BRB 20$ 10$: BBC #USER_V_NOTIFY_OPER_WARNING, - ; No Warning Message to Operator USER_L_OPTIONS(R9), NO_OPERATOR_MESSAGE 20$: ; ; Send Message to Operator ; SENDOPER USER_MSG_DESC ; ; Go Here When There is No Message is to be Send to Operator ; NO_OPERATOR_MESSAGE: ; ; Tell the User that there Being Warned or Logged Off ; TELL_USER: CMPL USER_L_WARNING(R9), - ; Is this a Logoff Message USER_L_STOP_PROCESS(R9) BNEQ 10$ ; Just a Warning BBS #USER_V_NO_NOTIFY_USER_LOGOFF,- ; No Logoff Message for User USER_L_OPTIONS(R9), NO_USER_MESSAGE BRB 20$ 10$: BBS #USER_V_NO_NOTIFY_USER_WARNING,-; No Warning Message for User USER_L_OPTIONS(R9), NO_USER_MESSAGE 20$: ; ; Tell the User Message Header ; TELL_USER_HEADER: BBS #USER_V_NO_HEADER_MSG, - ; Should User Message Header? USER_L_OPTIONS(R9), 10$ $BRKTHRUW_S - ; Send Watchdog Header msgbuf = HEADER_MSG - sendto = TERMINAL_DESC - sndtyp = #BRK$C_DEVICE - timout = #5 10$: TELL_USER_MESSAGE: $BRKTHRUW_S - ; Send Watchdog Message msgbuf = USER_MSG_DESC - sendto = TERMINAL_DESC - sndtyp = #BRK$C_DEVICE - timout = #5 ; ; Slow Down Wait for Message to Complete ; MOVF #0.5, -(SP) ; Wait for 1/2 Second PUSHL SP ; Pass By Ref, CALLS #1, G^LIB$WAIT ADDL2 #4, SP ; Restore Stack ; ; Go Here When There is No Message is to be Send to User ; NO_USER_MESSAGE: ; ; Can We Delete Process, Check ; CHECK_DELETATION: CMPL USER_L_WARNING(R9), - ; Can We Delete Process? USER_L_STOP_PROCESS(R9) BNEQ JUST_A_WARNING ; Not Enough Warnings Yet ; ; If Its Allowed Disconnect User From Terminal, ; Else Just Delete Then. ; DISCONNECT_PROCESS: BBS #USER_V_NO_DISCONNECTIONS, - ; No Not Disconnect USER_L_OPTIONS(R9), 10$ $CMKRNL_S - ; Go Disconnect Terminal routin = DISCONNECT_TERMINAL - arglst = DISCONNECT_TERMINAL_ARGLIST BLBS R0, CLEAR_PROCESS ; Clear History of Process 10$: ; Go Delete Process If ; Disconnect Did Not Work DELETE_PROCESS: BBC #USER_V_FORCEX, - ; Force Exit Process USER_L_OPTIONS(R9), 10$ $FORCEX_S - ; Force Exit Process pidadr = PSB_L_EPID(R10) - code = FORCEX_VALUE 10$: $DELPRC_S - ; Delete Process Time pidadr = PSB_L_EPID(R10) CMPW R0, #SS$_NONEXPR ; Check if Process Beat be to it BEQL 20$ ; Goto to Save Param easier call CHECK 20$: ; ; Clear Process History By Clearing Process Identification Number ; CLEAR_PROCESS: CLRW USER_W_IPIDSEQ(R9) ; Clear History of Process BRW NEXT_PROCESS ; ; Branch Here if it is Just a Warning ; JUST_A_WARNING: ; ; Save the CPUTIM and BUFIOC ; ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 ASSUME USER_L_CPUTIM EQ USER_L_BUFIOC-4 GET_NEW_PARAMETERS: .IF DEFINED DEBUG ; Dump Process Before Message DEBUG = DEBUG + 1 MOVZWL PSB_W_IPIDIDX(R10), R0 ; Set Process Index DUMP_PSB R0, \DEBUG .ENDC MOVAL GET_PROCESS_ARGLIST, R0 ; Get Address of Argument List MOVZWL PSB_W_IPIDIDX(R10), - ; Set Process Index GET_PROCESS$_INDEX(R0) $CMKRNL_S - ; Go Just That Processes routin = GET_PROCESS_INFORMATION - arglst = GET_PROCESS_ARGLIST MOVQ PSB_L_CPUTIM(R10), USER_L_CPUTIM(R9) ; CPU Time and Buffer I/O .IF DEFINED DEBUG ; Dump Process After Message DEBUG = DEBUG + 1 MOVZWL PSB_W_IPIDIDX(R10), R0 ; Set Process Index DUMP_PSB R0, \DEBUG .ENDC BRW NEXT_PROCESS ; Go For Next Process ; ; All Done Go to Sleep for a While ; SLEEP_TIME: $SCHDWK_S - ; A Scheduled Wake Up to Occur daytim = BINTIM CHECK $PURGWS_S - ; Dont Waste Memory inadr = RANGE CHECK $HIBER_S ; Hibernate Till Schedule Wake-up BRW BEGIN_LOOKING .PAGE .SBTTL GET_PROCESS_INFORMATION - Get Process Information ;++ ; ; MODULE: GET_PROCESS_INFORMATION ; ; ABSTRACT: Get Process Information From System Database ; ; ENVIRONMENT: Kernal Mode, Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) Process Index - Process Index if Index ; ; OUTPUT PARAMETERS: ; None ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY GET_PROCESS_INFORMATION, ^M MOVL GET_PROCESS$_INDEX(AP), R9 ; Get Index to PCB Vectors CLRL R11 ; Address of Special Kernal Ast ; ; Allocate Non-Paged Pool for a Process Status Block(PSB). ; So We Do Not Have to Worry About Page Faulting at Elevated IPL ; MOVZBL #PSB_C_BLN, R1 ; Size of Non-Paged Pool Needed JSB G^EXE$ALONONPAGED ; Go Allocate Pool BLBS R0, 10$ ; Continue If There is No Error MOVZWL #SS$_INSFMEM, R0 ; Set Return Error Message RET 10$: MOVL R1, R10 ; Size of Requested Block MOVL R2, R6 ; Get Base Address of Pool Addr ; ; Scan Scheduler's Process Database ; 20$: LOCK - ; Synchronize Scheduler Database lockname = SCHED - lockipl = SCHED - savipl = -(SP) CMPL R9, G^SCH$GL_MAXPIX ; Check Index See if in Range BLEQU 30$ ; Have Not Seen All Processes BRW 100$ ; Have Not Seen All Processes ; ; Initialize Nonpaged PSB ; 30$: ASSUME PSB_L_CPUTIM EQ PSB_L_BUFIOC-4 CLRL PSB_L_IPID(R6) ; Initialize Internal PID CLRQ PSB_L_CPUTIM(R6) ; Initialize Cputim and Bufioc ; ; Make Sure Index is Not Null or Swapper and Get Process Control Block ; 40$: MOVL @SCH$GL_PCBVEC[R9], R7 ; Get Process Pcb Address CMPL G^SCH$AR_NULLPCB, R7 ; Is This the NULL PCB BEQL 50$ ; If it is Branch CMPL G^SCH$AR_SWPPCB, R7 ; Is This the SWAP PCB BEQL 50$ ; If it is Branch ; ; Save Time Skip Batch Jobs, Network Jobs or Process's with Deletation Pending ; BITL #, PCB$L_STS(R7) BEQL 60$ ; Continue if all Bits are clear 50$: BRW 90$ 60$: ; ; Start Moving Process Information Needed ; ASSUME PCB$L_PID EQ PCB$L_EPID-4 ASSUME PSB_L_IPID EQ PSB_L_EPID-4 MOVQ PCB$L_PID(R7), PSB_L_IPID(R6) ; Internal and Extended PIDs ; ; Move the Terminal Name (Minus the Colon) ; MOVAB PCB$T_TERMINAL(R7), R4 ; Get Base Address of ASCIC String MOVZBL (R4)+, R3 ; Extract the Length LOCC #^A/:/, R3, (R4) ; Locate the Colon If Any SUBL2 R0, R3 ; Subtract it From the Length MOVB R3, PSB_T_TERMINAL(R6) MOVC5 R3, (R4), - ; Move the Remain String #0, #PSB_S_TERMINAL-1, (R6) ; MOVSTR PCB$T_TERMINAL(R7) - ; Terminal Name ; #PSB_S_TERMINAL, PSB_T_TERMINAL(R6) MOVSTR PCB$T_LNAME(R7), - ; Process Name #PSB_S_LNAME, PSB_T_LNAME(R6) PUSHL R8 ; No JIB Lock require, ; not manipulating BYTxx quotas MOVL PCB$L_JIB(R7), R8 ; Job Info Blk Address MOVL JIB$L_MPID(R8), PSB_L_MPID(R6) ; Master PID MOVW JIB$W_PRCCNT(R8), PSB_W_PRCCNT(R6) ; Process Count MOVB #JIB$S_USERNAME, PSB_T_USERNAME(R6) ; Set Length of User Name MOVC3 #JIB$S_USERNAME, - ; Username JIB$T_USERNAME(R8), PSB_T_USERNAME+1(R6) LOCC #^A/ /, #JIB$S_USERNAME, PSB_T_USERNAME+1(R6) SUBB2 R0, PSB_T_USERNAME(R6) ; Adjust Length MOVB #JIB$S_ACCOUNT, PSB_T_ACCOUNT(R6) ; Set Length of Account Name MOVC3 #JIB$S_ACCOUNT, - ; Account Name JIB$T_ACCOUNT(R8), PSB_T_ACCOUNT+1(R6) LOCC #^A/ /, #JIB$S_ACCOUNT, PSB_T_ACCOUNT+1(R6) SUBB2 R0, PSB_T_ACCOUNT(R6) ; Adjust Length POPL R8 BBC #PCB$V_PHDRES, PCB$L_STS(R7), 200$ ; Resident Process Header MOVL PCB$L_PHD(R7), R1 ; Process Header Address MOVL PHD$L_CPUTIM(R1),PSB_L_CPUTIM(R6) ; Cpu Time MOVL PHD$L_BIOCNT(R1),PSB_L_BUFIOC(R6) ; Buffer I/O Count ; ; Copy Data back Into the User Buffer ; 90$: UNLOCK - ; Allow Pagefault lockname = SCHED - newipl = (SP)+ INDEX R9, #0, G^SCH$GL_MAXPIX, - ; Compute Index Into Scan Block #PSB_C_BLN, #0, R1 MOVC3 #PSB_C_BLN, (R6), @PSB_ADDR[R1] ; Move Information Back TSTL GET_PROCESS$_INDEX(AP) ; Look at More Process BNEQ 100$ ; No, Just the One Process INCL R9 ; Increment Process Index BRW 20$ ; Go look at Next Process ; ; Return Non-Paged Pool ; 100$: MOVL R6, R0 ; Address of Pool MOVW R10, IRP$W_SIZE(R0) ; Initialize Header Size and MOVB #DYN$C_BUFIO, IRP$B_TYPE(R0) ; Set Type of Pool JSB G^EXE$DEANONPAGED ; Deallocate Pool MOVL R11, R0 ; Address of Pool BEQL 110$ MOVW R8, IRP$W_SIZE(R0) ; Initialize Header Size and MOVB #DYN$C_BUFIO, IRP$B_TYPE(R0) ; Set Type of Pool JSB G^EXE$DEANONPAGED ; Deallocate Pool 110$: RET ; ; We Know at This Point Process Header is Not Resident ; and the Process in question is Not Network, Batch Job. ; and the Process is not Pending Deletion. We need to check ; to make sure the process is not suspend some how or in ; some type of Mutex Wait State. Because were going to queue ; a Special Kernal AST to the Process. ; 200$: BBS #PCB$V_SUSPEN, PCB$L_STS(R7), 90$ ; Pending Suspendation CMPW #SCH$C_SUSP, PCB$W_STATE(R7) ; Suspended? BEQL 90$ ; Yep CMPW #SCH$C_SUSPO, PCB$W_STATE(R7) ; Suspended Outswapped? BEQL 90$ ; Yep CMPW #SCH$C_MWAIT, PCB$W_STATE(R7) ; Mutex Wait BEQL 90$ ; Yep ; ; Clear the Event Flag ; CLRL R3 ; Event Flag Zero MOVL G^CTL$GL_PCB, R4 JSB G^SCH$CLREF ; Clear Event Flag ; ; Allocate Non-Paged Pool for Special Kernal Ast Code ; TSTL R11 ; Check to See if Code Mapped BNEQ 210$ ; Yes, Then Don't Map Again MOVL #CODE_SIZE, R1 ; Size of Pool Needed for KAST JSB G^EXE$ALLOCBUF ; Allocate Buffer BLBC R0, 300$ ; Branch Out on Error MOVL R1, R8 ; Size of Buffer MOVL R2, R11 ; Save ACB Address PUSHL R4 MOVC3 #CODE_SIZE, SPECIAL_KRNLAST, (R11) ; Move Code POPL R4 210$: JSB G^EXE$ALLOCIRP ; Allocate Ast Control Block BLBC R0, 300$ ; Branch Out on Error MOVL R2, R5 ; Save ACB Address ; ; Do Some Initialization ; IPL Status : SYNCH ; Register Status: ; R4 contains Current Process PCB ; R5 contains ACB Address ; R7 contains Target Process PCB ; MOVL PCB$L_PID(R4), ACB$L_AST(R5) ; Set Requestor PID MOVL R6, ACB$L_ASTPRM(R5) ; Buffer Address MOVL PCB$L_PID(R7), ACB$L_PID(R5) ; Set PID of Target MOVB #<1@ACB$V_KAST>, ACB$B_RMOD(R5) ; Mode Special Kernal MOVL R11, ACB$L_KAST(R5) ; Kernal Routine Address ; ; Queue AST to Process ; IPL Status : SYNCH ; Register Status: ; R4 contains Current Process PCB ; R5 contains ACB Address ; R7 contains Target Process PCB ; MOVL #PRI$_TICOM, R2 ; Boost Priority Time Queue Increment JSB G^SCH$QAST ; Queue the AST to Target Process BLBC R0, 290$ ; ; Wait For Event Flag 0 ; SETIPL #0 $WAITFR_S efn=#0 BRW 90$ ; ; Deallocate Ast Control Block ; 290$: MOVL R5, R0 ; Get ACB Address JSB G^EXE$DEANONPAGED ; Deallocate packet back to pool 300$: LOCK - ; Synchronize Scheduler Database lockname = SCHED - lockipl = SCHED - savipl = -(SP) BRW 90$ .PAGE .SBTTL SPECIAL_KRNLAST - Special Kernal Ast to Get PHD Info ;++ ; FUNCTIONAL DESCRIPTION: ; SPECIAL_KRNLAST retrieves a selected process's Buffer I/O ; and CPU Time. ; ; CALLING SEQUENCE: ; Via ACB, BSB or JSB ; ; INPUT PARAMETERS: ; None ; ; IMPLICIT INPUTS: ; R4 - PCB Address of Current Process ; R5 - ACB Address ; IPL - IPL$_ASTDEL ; ; OUTPUT PARAMETERS: ; None ; ; IMPLICIT OUTPUTS: ; None ; ; COMPLETION CODES: ; SS$_NORMAL - Successful Completion ; ; SIDE EFFECTS: ; Event Flag Zero is Set in Requesting Process ; ;-- .PAGE SPECIAL_KRNLAST: PUSHR #^M MOVL PCB$L_PHD(R4), R3 ; Get Process Header MOVL ACB$L_ASTPRM(R5), R6 ; Return PHD Information MOVL PHD$L_CPUTIM(R3), PSB_L_CPUTIM(R6) ; Retrieve Cpu Time MOVL PHD$L_BIOCNT(R3), PSB_L_BUFIOC(R6) ; Retrieve Buffer I/O Count CLRQ R2 ; No Priority Boost and Event Flag Zero MOVL ACB$L_AST(R5), R1 ; Requestor's Pid JSB G^SCH$POSTEF ; Set Event Flag POPR #^M MOVL R5, R0 ; Get ACB Address JMP G^EXE$DEANONPAGED ; Deallocate and Return CODE_SIZE = .-SPECIAL_KRNLAST .PAGE .SBTTL TERMINAL_CHAR - Get Terminal Characteristics ;++ ; ; MODULE: TERMINAL_CHAR ; ; ABSTRACT: Locate Terminal in I/O Database, and Return Characteristics ; ; ENVIRONMENT: Kernel Mode, Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) Address of Terminal Descriptor ; 8(AP) Address of Quadword For Device Characteristics ; ; OUTPUT PARAMETERS: ; R0 = SS$_NORMAL - Device Found ; = SS$_ACCVIO - Name String is Not Readable ; = SS$_NONLOCAL - Nonlocal Device ; = SS$_IVLOGNAM - Invalid Device Name String ; = SS$_NOSUCHDEV - Network Templete Device Not Found ; = SS$_NODEVAVL - Device Exists but NotAvailable According Rules ; = SS$_NOPRIV - Failed Device Protection ; = SS$_TEMPLATEDEV - Can't Allocate Template Device ; = SS$_DEVMOUNT - Device Already Mounted ; = SS$_DEVOFFLINE - Device Marked Offline ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY TERMINAL_CHAR, ^M JSB G^SCH$IOLOCKR ; Read Lock MOVL TERMINAL_CHAR$_TERMINAL(AP), R1 ; Move Terminal Descriptor -> R1 CLRQ R2 ; No Flags or Mutexes JSB G^IOC$SEARCHDEV ; Search I/O Database BLBC R0, 10$ ; Branch on Error MOVQ UCB$L_DEVCHAR(R1), @TERMINAL_CHAR$_DEVCHAR(AP) ; Get Device Char 10$: PUSHL R0 ; Save Status Registers JSB G^SCH$IOUNLOCK ; Unlock I/O Database SETIPL #0 ; Restore IPL POPL R0 ; Restore Status Registers RET .PAGE .SBTTL CHECK_NETDEVICE - Check for Network Devices ;++ ; ; MODULE: CHECK_NETDEVICE ; ; ABSTRACT: Search I/O Database for Network Devices (_NET***) ; ; ENVIRONMENT: Native/Kernel Mode, Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) Address of Longword for Index Type Pid ; ; OUTPUT PARAMETERS: ; R0 = SS$_NORMAL - Device Found ; = SS$_ACCVIO - Name String is Not Readable ; = SS$_NONLOCAL - Nonlocal Device ; = SS$_IVLOGNAM - Invalid Device Name String ; = SS$_NOSUCHDEV - Network Templete Device Not Found ; = SS$_NODEVAVL - Device Exists but NotAvailable According Rules ; = SS$_NOPRIV - Failed Device Protection ; = SS$_TEMPLATEDEV - Can't Allocate Template Device ; = SS$_DEVMOUNT - Device Already Mounted ; = SS$_DEVOFFLINE - Device Marked Offline ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY CHECK_NETDEVICE, ^M JSB G^SCH$IOLOCKR ; Read Lock MOVAQ NETWORK_DEVICE, R1 ; Move Network Device -> R1 CLRQ R2 ; No Flags or Mutexes JSB G^IOC$SEARCHDEV ; Search I/O Database BLBC R0, 30$ ; Branch on Error MOVZWL #SS$_NOSUCHDEV, R0 ; Assume Failure Status 10$: CMPL UCB$L_PID(R1), - ; Does This Process Own Device CHECK_NETDEVICE$_PID(AP) BEQL 20$ ; Found Network Device MOVL UCB$L_LINK(R1), R1 ; Get Next UCB BNEQ 10$ ; No, Go Check For More BRB 30$ ; No Network Devices Found 20$: MOVZWL #SS$_NORMAL, R0 ; Set Success 30$: PUSHL R0 ; Save Status Registers JSB G^SCH$IOUNLOCK ; Unlock I/O Database SETIPL #0 ; Restore IPL POPL R0 ; Restore Status Registers RET .PAGE .SBTTL DISCONNECT_TERMINAL - Disconnect Terminal ;++ ; MODULE: DISCONNECT_TERMINAL ; ; ABSTRACT: This Program Disconnects a Specified Terminal ; ; NOTES: None ; ; ENVIRONMENT: KERNEL MODE ; ;-- .PAGE .ENTRY DISCONNECT_TERMINAL, ^M JSB G^SCH$IOLOCKR ; Read Lock I/O Database ; ; Search I/O Database for Terminal's UCB and DDB ; CLRQ R2 ; No Flags or Mutexes MOVL DISCONNECT_TERMINAL$_TERMINAL(AP), R1 ; Search I/O Database for JSB G^IOC$SEARCHDEV ; Terminal's UCB and DDB BLBC R0, 40$ ; Exit on Error 10$: MOVZWL #SS$_DEVREQERR, R0 ; Assume Error CMPB UCB$B_DEVCLASS(R1), #DC$_TERM ; Make Sure Device is a Terminal BNEQ 40$ ; It is not a Terminal ; ; Check Terminal for Following Conditions: ; Redirection, Detached, Remote Terminal ; ASSUME DEV$V_DET LE 15 ASSUME DEV$V_RTT LE 15 ASSUME DEV$V_RED LE 15 20$: BBC #DEV$V_TRM, UCB$L_DEVCHAR(R1), 40$ ; Check for Terminal Device BBS #DEV$V_NET, UCB$L_DEVCHAR(R1), 40$ ; Check for Network Device BITW #, UCB$L_DEVCHAR2(R1) BNEQ 40$ ; ; Can Not Disconnect a Terminal Unless Another is Connect To It. ; CMPL UCB$L_TL_PHYUCB(R1), R1 ; Is this the Physical Device BEQL 40$ ; Sorry 30$: MOVL R1, R5 ; Set UCB Address in R5 BBC #TT2$V_DISCONNECT, UCB$L_DEVDEPND2(R1), 40$ ; Disconnectable? MOVL UCB$L_TL_PHYUCB(R5), R1 ; Get UCB CMPL R5, R1 ; Is this the Physical Device BNEQ 30$ ; No, Go Try Again ; ; Get Class Table and Device's IPL before Unlock Database ; MOVL UCB$L_TT_CLASS(R5), R6 ; Get Base Address Class Table BEQL 40$ ; No Terminal Class Info MOVZBL UCB$B_DIPL(R5), R7 ; Get Device's IPL MOVZWL #SS$_NORMAL, R0 ; Set Normal Status ; ; Unlock Database ; 40$: PUSHL R0 ; Save Error Status if Any JSB G^SCH$IOUNLOCK ; Unlock I/O Database POPL R0 ; Restore Error Status if Any BLBC R0, 50$ ; Exit On Error ; ; Raise IPL Device IPL and Do the Disconnection ; DEVICELOCK - ; Set Raise IPL to Device IPL lockaddr = UCB$L_DLCK(R5) - lockipl = UCB$B_DIPL(R5) - preserve = NO JSB @CLASS_DISCONNECT(R6) ; Go Disconnect Terminal DEVICEUNLOCK - ; Set Raise IPL to Device IPL lockaddr = UCB$L_DLCK(R5) - newipl = #0 - preserve = NO MOVZWL #SS$_NORMAL, R0 ; Set Normal Status ; ; Restore IPL and Exit ; 50$: SETIPL #0 ; Restore IPL RET .PAGE .SBTTL CHECK_EXCEPTION_LIST - Check WATCHDOG Exception List ;++ ; MODULE: CHECK_EXCEPTION_LIST ; ; ABSTRACT: This Module Checks a Process in the Exception List. ; ; ENVIRONMENT: Normal Mode, Non-Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) Process Status Block ; ; OUTPUT PARAMETERS: ; R0 = 0 - No Match Found ; = SS$_NORMAL - Completed Normally ; = SS$_NONEXPR - Non Existent Process ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY CHECK_EXCEPTION_LIST, ^M ASSUME START_MESSAGE EQ STOP_PROCESS-4 MOVQ START_MESSAGE, R6 ; Init Default Start and Stop MOVL DEFAULT_FLAGS, R10 ; Default_Flags TSTL NO_EXCEPTIONS ; Check Number of Exceptions BNEQ 10$ ; Branch If There Exceptions BRW END_OF_LIST ; If None Exit 10$: CLRL R9 ; Initialize Exception Tbl Index MOVL CHECK_EXCEPTION_LIST$_PSB(AP), R11 ; Get Base Address of Process ; Status Block ; ; Scan Exception Table Until End of Table or Entry Found ; NEXT_EXCEPTION: INDEX R9, #0, NO_EXCEPTIONS, - ; Compute Index of Exception #EXCEPT_C_BLN, #0, R8 ADDL2 EXCEPTION_ADDR, R8 ; Add Base of Exception Table MOVAL COMPARE_EXCEPTION_ARGLIST, R5 ; Get Base Address MOVQ EXCEPT_Q_DESCRIPTOR(R8), - ; Move Addr of Exception Entry COMPARE_EXCEPTION$_EXCEPTION(R5) ; ; Check Exception Based on Record Type ; FFS #EXCEPT_V_ACCOUNT, - ; Find Record Type Bit Position #EXCEPT_V_IMAGE, EXCEPT_L_RECTYP(R8),R0 CASEL R0, #EXCEPT_V_ACCOUNT, - ; Branch on Record Type #EXCEPT_V_IMAGE 10$: .WORD EXCEPTION_ACCOUNT-10$ ; Account Name Record Type .WORD EXCEPTION_PROCESS-10$ ; Process Name Record Type .WORD EXCEPTION_TERMINAL-10$ ; Terminal Name Record Type .WORD EXCEPTION_USERNAME-10$ ; User Name Record Type .WORD EXCEPTION_IDENTIFIER-10$ ; Identifier Record Type .WORD EXCEPTION_IMAGE-10$ ; Image Record Type ; ; Do Exception List Compare for Each Type of Exception ; EXCEPTION_ACCOUNT: ; Account Name Record Type MOVZBL #PSB_T_ACCOUNT, R4 ; Byte Offset of Account BRB GO_COMPARE_STRING ; Go Compare Strings EXCEPTION_PROCESS: ; Process Name Record Type MOVZBL #PSB_T_LNAME, R4 ; Byte Offset of Process Name BRB GO_COMPARE_STRING ; Go Compare Strings EXCEPTION_TERMINAL: ; Terminal Name Record Type MOVZBL #PSB_T_TERMINAL, R4 ; Byte Offset of Terminal BRB GO_COMPARE_STRING ; Go Compare Strings EXCEPTION_USERNAME: ; User Name Record Type MOVZBL #PSB_T_USERNAME, R4 ; Byte Offset of Username BRB GO_COMPARE_STRING ; Go Compare Strings EXCEPTION_IDENTIFIER: ; Identifier Record Type MOVL PSB_L_IPID(R11), - ; Move Index PID COMPARE_EXCEPTION$_ITEM(R5) $CMKRNL_S - ; Search Identifiers routin = SEARCH_RIGHTS - arglst = SEARCH_RIGHTS_ARGLIST BRB EXCEPTION_STATUS ; Go Check Status EXCEPTION_IMAGE: ; Image Record Type MOVL #0, COMPARE_EXCEPTION$_ITEM(R5) ; Move Address of Image GO_COMPARE_STRING: MOVAB (R11)[R4], - ; Pass Address COMPARE_EXCEPTION$_ITEM(R5) COMPARE_STRING: MOVW EXCEPT_W_WILDCARD(R8), - ; Encode Wildcard Value (R5) CALLG COMPARE_STRINGS_ARGLIST, - ; Compare Strings COMPARE_STRINGS ; ; Check Status of Exception Check ; EXCEPTION_STATUS: BLBS R0, 10$ ; Branch Out of Exception Loop ; Exception Found CMPW R0, #SS$_NONEXPR ; Special Error, Process Gone BEQL PROCESS_GONE AOBLSS NO_EXCEPTIONS, R9, NEXT_EXCEPTION ; Try Again No Exception Found BRB END_OF_LIST ; No Exceptions Found ASSUME EXCEPT_L_START_MSG EQ EXCEPT_L_STOP_PROCESS-4 10$: MOVQ EXCEPT_L_START_MSG(R8), R6 ; New Default Start and Stop MOVL EXCEPT_L_OPTIONS(R8), R10 ; Options ; ; Check Number of Start and Stop Values ; END_OF_LIST: CLRL R0 ; Assume Change in Start/Stop ; Message Values MOVL CHECK_EXCEPTION_LIST$_USER(AP), R11 ; Get Base Address of User CMPL USER_L_START_MSG(R11), R6 ; Check for Change in Start BEQL 20$ ; A Change was Found CMPL USER_L_STOP_PROCESS(R11), R7 ; Check for Change in Stop BEQL 20$ ; A Change was Found CMPL USER_L_OPTIONS(R11), R10 ; Check for Change in Options BEQL 20$ ; No Change was Found 10$: MOVZWL #SS$_NORMAL, R0 ; Set No Change in Values ASSUME USER_L_START_MSG EQ USER_L_STOP_PROCESS-4 20$: MOVQ R6, USER_L_START_MSG(R11) ; Set New Start/Stop Values MOVL R10, USER_L_OPTIONS(R11) ; As Well as OPTIONS PROCESS_GONE: RET .PAGE .SBTTL COMPARE_STRINGS - Compares Two String With Wildcards ;++ ; ; MODULE: COMPARE_STRINGS ; ; ABSTRACT: Compares Two Strings With Possible Wildcards ; ; ENVIRONMENT: Normal Mode, Non-Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) ASCIC String Descriptor ; 8(AP) Exception List Entry ; ; OUTPUT PARAMETERS: ; R0 = 0 - No Match Found ; = SS$_NORMAL - Completed Normally ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY COMPARE_STRINGS, ^M MOVL COMPARE_STRINGS$_STRING(AP), R0 ; Get Counted String Address BEQL 20$ ; Watch for No String MOVZBL (R0), R6 ; Relieve Length MOVAB 1(R0), R7 ; Compute Address MOVQ COMPARE_STRINGS$_EXCEPTION(AP),R8; Get Exception Address EXTZV #16, #16, R8, R10 ; Extract Wildcard Wildcard MOVZWL R10, R10 ; Convert Wildcard to Longword MOVZWL R8, R8 ; Convert Length to Longword BBS #15, R10, 10$ ; Branch if Wildcard Present CMPC5 R6, (R7), #0, R8, (R9) ; Straight Compare BEQL 30$ ; A Match CLRL R0 ; Sorry No Match RET 10$: MNEGW R10, R10 ; Change Negative to Positive BICW2 #^X8000, R10 ; Clear High Order Bit CMPC3 R10, (R7), (R9) ; Compare First Part BNEQ 20$ ; Did not Match SUBL2 R10, R6 ; Adjust Length of String ADDL2 R10, R7 ; Repoint String SUBL2 R10, R8 ; Adjust Length of String ADDL2 R10, R9 ; Repoint String TSTL R8 ; How Much String Left BEQL 30$ ; Not Enough String Left SUBL3 R8, R6, R10 ; Adjust Length of String BLSS 20$ ; Not Enough String Left SUBL2 R10, R6 ; Adjust Length of String ADDL2 R10, R7 ; Repoint String CMPC3 R8, (R7), (R9) ; Compare Second Half BEQL 30$ ; A Match 20$: MOVL #0, R0 ; Sorry No Match RET 30$: MOVZWL #SS$_NORMAL, R0 ; Set Success RET .PAGE .SBTTL SEARCH_RIGHTS - Search a Process's Rightslist Segment ;++ ; ; MODULE: SEARCH_RIGHTS ; ; ABSTRACT: Search a Process's Rightslist Segment for an Identifier ; ; ENVIRONMENT: Kernel Mode, Privileged Code ; ; INPUT PARAMETERS: ; 4(AP) Internal PID ; 8(AP) Exception List Entry ; ; OUTPUT PARAMETERS: ; R0 = SS$_NOSUCHID - Specified Identifier Not Found ; = SS$_NORMAL - Completed Normally ; = SS$_NONEXPR - Non Existent Process ; ; SIDE EFFECTS: ; None ; ;-- .PAGE .ENTRY SEARCH_RIGHTS, ^M LOCK - ; Synchronize Scheduler Database lockname = SCHED - lockipl = SCHED - savipl = -(SP) MOVZWL #SS$_NONEXPR, R0 ; Assume Non-Existent Process MOVZWL SEARCH_RIGHTS$_IPID(AP), R1 ; Get Index PID MOVL @SCH$GL_PCBVEC[R1], R1 ; Retrieve Process Control Blk CMPL PCB$L_PID(R1), SEARCH_RIGHTS$_IPID(AP) ; Same Process BNEQ 10$ ; Branch Out if Not MOVL PCB$L_ARB(R1), R1 ; Get Process Control Block MOVAL ARB$L_RIGHTSLIST(R1), R4 ; Get Rightslist Segment ; data structures MOVL SEARCH_RIGHTS$_EXCEPTION(AP),R2 ; Get Identifier JSB G^EXE$SEARCH_RIGHT 10$: UNLOCK - ; ReSynchronize system-wide lockname = SCHED - newipl = (SP)+ RET .PAGE .SBTTL EXE$SEARCH_RIGHT - SEARCH RIGHTS DESCRIPTOR FOR AN IDENTIFIER ;++ ; ; FUNCTIONAL DESCRIPTION: ; ; This routine searches the specified rights segment for the fiven ; identifier. ; ; CALLING SEQUENCE: ; JSB EXE$SEARCH_RIGHT ; ; INPUT PARAMETERS: ; IDENTIFIER (R2): identifier being sought ; RIGHTSDESC (R4): address of the rights segment descriptors ; ; IMPLICIT INPUTS: ; NONE ; ; OUTPUT PARAMETERS: ; ID_ADDRESS (R1): address of the ID quadword if found ; DESC_ADDRESS (R5): address of the rights segment containing the ID ; ; IMPLICIT OUTPUTS: ; NONE ; ; ROUTINE VALUE: ; SS$_NORMAL if ID was found ; SS$_NOSUCHID if the ID was not found ; ; SIDE EFFECTS: ; NONE ; ;-- .PAGE ASSUME UIC$K_UIC_FORMAT EQ 0 ASSUME UIC$K_ID_FORMAT EQ 2 ASSUME UIC$V_FORMAT EQ 30 ASSUME UIC$K_MATCH_ALL EQ -1 EXE$SEARCH_RIGHT: PUSHL R10 ; save work registers PUSHL R4 PUSHL R3 MCOML R2,R10 ; see if match-all specified BNEQ 5$ ; branch if not MOVL R2,R10 ; set test mask to all ones CLRL R2 ; search pattern is zero BRB 30$ ; and execute match code 5$: BBS #30,R2,50$ ; xfer if invalid identifier format CLRL R10 ; preset UIC mask TSTL R2 ; check for a UIC type identifier BLSS 30$ ; xfer if not a UIC ; ; form a wilcard mask baed upon the UIC entry in the ACE. ; CMPZV #UIC$V_GROUP,#UIC$S_GROUP,R2,#UIC$K_WILD_GROUP ; wildcard group? BNEQ 10$ ; xfer if not MOVL R2,R10 ; get the UIC with wild group CLRW R10 ; zap the member for now 10$: CMPW R2,#UIC$K_WILD_MEMBER ; wildcard member? BNEQ 20$ ; xfer if not MNEGW #1,R10 ; else note it 20$: BICL R10,R2 ; mask out unneeded portions ; ; At this point an identifier exists in R2. Now can the rights lis seqment ; to see if it exists within the rights lists. ; 30$: MOVL (R4)+,R5 ; else get address of a descriptor BEQL 50$ ; xfer if at the end...ID not found MOVZWL (R5),R3 ; else get size of descriptor ASHL #-3,R3,R3 ; get number of entries BEQL 30$ ; xfer if none to check MOVL 4(R5),R1 ; get starting address 40$: MOVL (R1),R0 ; get the identifier BEQL 30$ ; xfer if no more BICL R10,R0 ; mask out any unneeded portions CMPL R2,R0 ; ACE & rights list identifier match? BEQL 60$ ; xfer if so, next identifier please ADDL #ARB$S_RIGHTSDESC,R1 ; point to next identifier SOBGTR R3,40$ ; go try it BRB 30$ ; if exhausted, try next rights list 50$: MOVZWL #SS$_NOSUCHID,R0 ; set status BRB 70$ ; go finish up 60$: MOVL #SS$_NORMAL,R0 ; set status 70$: MOVL (SP)+,R3 ; restore work registers MOVL (SP)+,R4 MOVL (SP)+,R10 RSB ; return to caller ; ; EXCEPTION HANDLER ; .IF DEFINED DEBUG .ENTRY HANDLER, ^M MOVL 4(AP), R5 SUBL3 #1, (R5), R6 MOVAL 14$, (R5)[R6] MOVZWL #SS$_CONTINUE,R0 RET 14$: MOVL #OTS$_FATINTERR,R0 ; UNKNOWN ERROR RET .ENDC END_LOCK_REGION: .PAGE .SBTTL LOCAL DECLARATIONS - Used Once Data ; ; Once Used Data ; .PSECT LOCAL_DATA PIC, LONG ; ; Pure String Definations ; INIT_MSG: ; Initial Message .ASCID 'WATCH DOG IS INITIALIZING' RUN_MSG: ; Running Message .ASCID 'WATCH DOG IS RUNNING' LOGICAL_TABLE: ; Logical Name Table .ASCID /LNM$SYSTEM_TABLE/ PROCESS_NAME: ; Process Name .ASCID 'WATCHDOG' USER_DB: ; User Database Size .BLKL 1 EXCEPTION_DB: ; Exception Database Size .BLKL 1 TRNLNM_DESC: ; Translate Logical Name Desc .WORD 0 .BYTE DSC$K_DTYPE_T, DSC$K_CLASS_D .LONG 0 ; ; Initial Translate Logical Item List ; ITEMNEW TRN_ITMLST, writeable ITEMLST TRN_ITMLST, MAX_STRING, lnm$_string, 0, 0, writeable ITEMEND TRN_ITMLST, writeable ; ; Lock Page(s) Descriptors Ranges LOCK_DOWN_REGION: ; Lock Down Page Descriptor .ADDRESS BEGIN_LOCK_REGION .ADDRESS END_LOCK_REGION .PAGE .SBTTL PARSER_DECLARATIONS - Data for Parsing Exception Records ; ; Following Data is for the Parsing of Exception ; ; ; Exception File File Access Block and Record Access Block ; .ALIGN LONG ; RMS must be Longword Aligned INPUT_FAB: ; File Address Block $FAB fac = GET, - ; File Access Type dna = INPUT_DEFAULT,- ; Default File dns = 4, - ; Default File Length fop = SQO, - ; Sequential Only nam = INPUT_NAM ; File Name Block INPUT_NAM: ; Name Address Block $NAM ess = NAM$C_MAXRSS, - ; Expanded String Area Size esa = INPUT_ESA, - ; Expanded String Area Addr rss = NAM$C_MAXRSS, - ; Resultant String Area Size rsa = INPUT_RSA ; Resultant String Area Addr INPUT_RAB: ; Record Address Block $RAB rac = SEQ, - ; Record Access Mode usz = 255, - ; Maximum Input Buffer Size ubf = BUFFER, - ; User Input Record Area fab = INPUT_FAB ; File Address Block ; ; Pure String Definations ; FACILITY_NAME: ; Facility Name .ASCID /WATCHDOG/ INPUT_DEFAULT: ; Default Input File .ASCII /.EXC/ FIELD_NAMES: ; Field Names .ASCID /RECORD TYPE/ ; Record Type .ASCID /DEVICE NAME/ ; Device Value .ASCID /STRING TYPE/ ; String Value .ASCID /IDENT VALUE/ ; Identifier Value .ASCID /START VALUE/ ; Start Warning Value .ASCID /STOP VALUE / ; Stop Process Value .ASCID /FLAG VALUE / ; Flag Value ; ; Read/Write Data ; INPUT_ESA: ; Input Extended String Address .BLKB NAM$C_MAXRSS INPUT_RSA: ; Input Resulted String Address .BLKB NAM$C_MAXRSS BUFFER: ; Temporary Buffer Address .BLKB 255 STRING_DB: ; String's For Database Size .BLKL 1 TEMP_DESCRIPTOR: ; Temporary Descriptor .BLKQ 1 LINE: .BLKL 1 ; Line Number PARSER_FLAG: ; Parser Record Value .BLKL 1 OPTION_FLAG: ; Option Flags .BLKL 1 STRING_ADDR: ; Base Address of String .BLKL 1 IDENT_VAL: ; Identifier Value .BLKL 1 START_VAL: ; Start Message Value .BLKL 1 STOP_VAL: ; Stop Message Value .BLKL 1 ERROR_FLAG: ; Parser Error Flags .BLKL 1 TPARSE_BLK: ; TParse Block .BLKB TPA$K_LENGTH0 .PAGE .SBTTL WATCHDOG_INIT - Initialize Watchdog Routine ;++ ; ; MODULE: WATCHDOG_INIT ; ; ABSTRACT: Initializes Watchdog Process ; ; ENVIRONMENT: User Mode, Non-Privileged Code ; ; INPUT PARAMETERS: ; None ; ; OUTPUT PARAMETERS: ; None ; ; SIDE EFFECTS: ; None ; ;-- .PAGE WATCHDOG_INIT: ; ; Set Process Name ; $SETPRN_S - ; Set Process Name "WATCH_DOG" prcnam = PROCESS_NAME CHECK ; ; Create Temporary String for Logical Name Translation ; PUSHL #MAX_STRING ; Allocate Temporary String PUSHAQ TRNLNM_DESC ; Dynamic Descriptor PUSHAL 4(SP) ; For Logical Name Translation CALLS #2, G^STR$GET1_DX ; Allocate One Dynamic String ADDL2 #4, SP ; CHECK ; ; Translate Logical Names for Operator Flags ; TRNLNM WATCHDOG_OPER_FLAG, TRUE, OPER_FLAG ; Operator Flags ; ; Initialize Operator Data Structure ; MOVAL OPER_MSG, R1 ; Address of Operator Message MOVB #OPC$_RQ_RQST, OPC$B_MS_TYPE(R1) ; Insert Message Type INSV OPER_FLAG, - ; Insert Target Mask (Central) #0, - ; Starting at Bit 0 #24, - ; Continuing for 24 bits OPC$B_MS_TARGET(R1) ; into Target Field ; ; Send Operator Console Message Tell Them That I am Running ; SENDOPER INIT_MSG ; Send Initialization Message ; ; Translate Logical Names for ; Timestamp, Start and Stop Process, Flags ; TRNLNM WATCHDOG_STOP_PROC, TRUE, STOP_PROCESS ; Stop Process Logical TRNLNM WATCHDOG_START_MSG, TRUE, START_MESSAGE ; Start Message Logical TRNLNM WATCHDOG_FLAGS, TRUE, DEFAULT_FLAGS ; Default Flags TRNLNM WATCHDOG_FORCEX, TRUE, FORCEX_VALUE ; Forcex Value ; ; Check to Operator Timestamp Flag Before Translating ; Timestamp Value. ; BBS #USER_V_NO_OPER_TIMESTAMP, DEFAULT_FLAGS, NO_TIMESTAMP TRNLNM WATCHDOG_TIMESTAMP, TRUE, SEND_STAMP ; Time Stamp Logical NO_TIMESTAMP: ; ; Translate Logical Name for Interval Time and Valid ; TRNLNM WATCHDOG_INTERVAL ; Interval Logical Name $BINTIM_S - ; Convert ASCII Time to Binary timbuf = TRNLNM_DESC, - timadr = BINTIM CHECK EDIV #BINARY_ONE_MIN, BINTIM, - ; Convert to Minutes TIME_MINUTES, R1 TSTL R1 ; No Remainder Allowed BEQL 10$ ; Ok Clean From Translations MOVZWL #SS$_IVTIME, R0 ; Set Error Invalid Time CHECK 10$: ; ; Translate Optional Logical Name for Exception File ; and Parse File Contains ; CLRL NO_EXCEPTIONS ; Set Number of Exceptions to 0 TRNLNM WATCHDOG_EXCEPTION_FILE, FALSE ; Exception File Logical PUSHAL TRNLNM_DESC ; Exception File Name CALLS #1, PARSER ; Parse Exception File CHECK ; ; Deallocate Temporary String for Logical Name Translation ; PUSHAQ TRNLNM_DESC ; Dynamic Descriptor CALLS #1, G^STR$FREE1_DX ; Deallocate One Dynamic String CHECK ; ; Allocate Memory for User Database ; ADDL3 #1, G^SCH$GL_MAXPIX, R0 ; Maximum Index plus One GETMEM #USER_C_BLN, R0, USER ; Get Memory For User DB ; ; Allocate Memory for Process Scan Block ; ADDL3 #1, G^SCH$GL_MAXPIX, R0 ; Maximum Index plus One GETMEM #PSB_C_BLN, R0, PSB ; Get Memory For Scan Block ; ; Lock Down Code and Data that is Either Used ; Often or Runs At elevated IPL ; $LCKPAG_S - ; Lock Pages in Working Set inadr = LOCK_DOWN_REGION CHECK ; ; Send Operator Console Message Tell Them That I am Running ; SENDOPER RUN_MSG ; Send Running Message SUBL3 #1, SEND_STAMP, TIME_STAMP ; Initialize Time Stamp So ; It triggers First Time RSB .PAGE .SBTTL PARSER - Parse Watchdog Excludation File Input ;++ ; MODULE: Parser ; ; ABSTRACT: Parses Watchdog Exception File in Order ; to Create Exception Database ; ; NOTES: Format for Exception File is as Follows : ; RECORD-TYPE EXCEPTION [START-MSG] [STOP-PROCESS] [OPTION-FLAG] ; ; ENVIRONMENT: User Mode ; ;-- .PAGE .ENTRY PARSER, ^M ; ; Initialize Counters and Fields ; CLRL NO_EXCEPTIONS ; Number Exception Used CLRL LINE ; Line Number CLRL PARSER_FLAG ; Parser Record Value CLRL ERROR_FLAG ; Parser Error Flags MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor CLRL DSC$W_LENGTH(R1) ; Clear Length MOVL DEFAULT_FLAGS, OPTION_FLAG ; Reset Default Option Flags MOVL #TPA$K_COUNT0, TPARSE_BLK ; TParse Block MOVL PARSER$_FILENAME(AP), R0 ; Get File Name TSTW DSC$W_LENGTH(R0) ; Check If Name EXIST BNEQ 10$ MOVZWL #SS$_NORMAL, R0 RET 10$: MOVAL INPUT_FAB, R1 ; Get Fab Address MOVB DSC$W_LENGTH(R0), FAB$B_FNS(R1) MOVL DSC$A_POINTER(R0), FAB$L_FNA(R1) ; ; Allocate Virtual by Pages for the Exception Database ; We Allocate by Page so that We Can Return What We ; Don't Use. ; GETMEM #EXCEPT_C_BLN, #EXCEPT_C_MAXIMUM, EXCEPTION, 20$ ; ; Allocate Virtual by Pages for the String ; We Allocate by Page so that We Can Return What We ; Don't Use. ; GETMEM #EXCEPT_C_STRLEN, #EXCEPT_C_MAXIMUM, STRING, 20$ MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor MOVL STRING_ADDR, DSC$A_POINTER(R1) ; Set Address ; ; Open and Connect to Input File ; $OPEN - ; Open Input File fab = INPUT_FAB, - err = INP_OPN_ERR BBSS #STS$V_INHIB_MSG, R0, .+1 CHECK R0,, 20$ ; Stop on Error $CONNECT - ; Connect Input File rab = INPUT_RAB,- err = INP_CON_ERR BBSS #STS$V_INHIB_MSG, R0, .+1 CHECK R0,, 20$ ; Stop on Error ; ; Start Parsing Exception File ; PUSHAL KEYWORDS ; Keyword Table PUSHAL STATE_TABLE ; State Table PUSHAL TPARSE_BLK ; TParse Block CALLS S^#3, G^LIB$TPARSE ; Parse Till End of File ; ; Status Should Be RMS$_EOF, If not Error Message ; CHECK R0, #, 20$ ; ; Close Input File ; $CLOSE - ; Close Input File fab = INPUT_FAB, - err = INP_CLS_ERR BBSS #STS$V_INHIB_MSG, R0, .+1 CHECK R0,, 20$ ; Stop on Error ; ; Deallocate Virtual by Pages for the Exception Database ; We Didn't Use. ; MULL3 NO_EXCEPTIONS, #EXCEPT_C_BLN, R2 ; Get Amount Memory Used FREEMEM R2, EXCEPTION, 20$ ; Free What is Left ; ; Deallocate Virtual by Pages for the String's for Exception Database ; We Didn't Use. ; MOVAL TEMP_DESCRIPTOR, R1 SUBL3 STRING_ADDR, DSC$A_POINTER(R1), R2 ; Get Amount Used FREEMEM R2, STRING, 20$ ; Free What is Left MOVZWL #SS$_NORMAL, R0 ; Set Success 20$: ; ; Dump Exception Table is Compiled With Debug ; .IF DEFINED DEBUG DUMP_EXCEPTIONS .ENDC RET .PAGE .SBTTL PARSER STATE TABLE - Excludation Parse Table ; ; Parse State Table ; $INIT_STATE STATE_TABLE, KEYWORDS $STATE START $TRAN TPA$_LAMBDA,, GET_INPUT $STATE $TRAN FF, START $TRAN COMMENT, START $TRAN TPA$_EOS, START $TRAN 'ACCOUNT', STRING, CREATE_DB,EXCEPT_M_ACCOUNT, PARSER_FLAG $TRAN 'IMAGE', STRING, CREATE_DB,EXCEPT_M_IMAGE, PARSER_FLAG $TRAN 'PROCESS', STRING, CREATE_DB,EXCEPT_M_PROCESS, PARSER_FLAG $TRAN 'TERMINAL', DEVICE, CREATE_DB,EXCEPT_M_TERMINAL, PARSER_FLAG $TRAN 'USERNAME', STRING, CREATE_DB,EXCEPT_M_USERNAME, PARSER_FLAG $TRAN 'IDENTIFIER', IDENTIFIER,CREATE_DB,EXCEPT_M_IDENTIFIER,PARSER_FLAG $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_RECTYP, ERROR_FLAG $STATE DEVICE $TRAN TPA$_ALPHA,, NEW_STRING $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_DEVNAM, ERROR_FLAG $STATE DEV_STRNG $TRAN '*',, SETSTR_WILD $TRAN ':', START_MSG, END_STR $TRAN TPA$_ALPHA, DEV_STRNG, ADDTO_STR $TRAN TPA$_DIGIT, DEV_STRNG, ADDTO_STR $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_DEVNAM, ERROR_FLAG $STATE DEV_END $TRAN ':', START_MSG, END_STR $TRAN TPA$_DIGIT, DEV_END, ADDTO_STR $TRAN TPA$_ALPHA, DEV_END, ADDTO_STR $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_DEVNAM, ERROR_FLAG $STATE STRING $TRAN '*', STR_WILD, SETSTR_WILD $TRAN DOLLARSIGN,, NEW_STRING $TRAN UNDERSCORE,, NEW_STRING $TRAN TPA$_ALPHA,, NEW_STRING $TRAN TPA$_DIGIT,, NEW_STRING $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_STRING, ERROR_FLAG $STATE STR_BUILD $TRAN '*',, SETSTR_WILD $TRAN DOLLARSIGN, STR_BUILD, ADDTO_STR $TRAN UNDERSCORE, STR_BUILD, ADDTO_STR $TRAN TPA$_ALPHA, STR_BUILD, ADDTO_STR $TRAN TPA$_DIGIT, STR_BUILD, ADDTO_STR $TRAN BLANK, START_MSG, END_STR $TRAN COMMENT, MAKE_REC, END_STR $TRAN TPA$_EOS, MAKE_REC, END_STR $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_STRING, ERROR_FLAG $STATE STR_CONTIN $TRAN DOLLARSIGN, STR_CONTIN,ADDTO_STR $TRAN UNDERSCORE, STR_CONTIN,ADDTO_STR $TRAN TPA$_ALPHA, STR_CONTIN,ADDTO_STR $TRAN TPA$_DIGIT, STR_CONTIN,ADDTO_STR $TRAN BLANK, START_MSG, END_STR $TRAN COMMENT, MAKE_REC, END_STR $TRAN TPA$_EOS, MAKE_REC, END_STR $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_STRING, ERROR_FLAG $STATE STR_WILD $TRAN TPA$_LAMBDA, STR_CONTIN,NEW_STRING $STATE IDENTIFIER $TRAN TPA$_IDENT, START_MSG,,, IDENT_VAL $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_IDENT, ERROR_FLAG $STATE START_MSG $TRAN 'DEFAULT',, SET_DEFSTART $TRAN TPA$_DECIMAL,,,, START_VAL $TRAN COMMENT, MAKE_REC $TRAN TPA$_EOS, MAKE_REC $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_START, ERROR_FLAG $STATE STOP_PROC $TRAN 'DEFAULT',, SET_DEFSTOP $TRAN TPA$_DECIMAL,,,, STOP_VAL $TRAN COMMENT, MAKE_REC $TRAN TPA$_EOS, MAKE_REC $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_STOP, ERROR_FLAG $STATE FLAG $TRAN 'DEFAULT' $TRAN TPA$_DECIMAL,,,, OPTION_FLAG $TRAN COMMENT, MAKE_REC $TRAN TPA$_EOS, MAKE_REC $TRAN TPA$_LAMBDA, SIGNAL_ERR,, BAD_M_FLAG, ERROR_FLAG $STATE $TRAN COMMENT, MAKE_REC $TRAN TPA$_EOS, MAKE_REC $STATE MAKE_REC $TRAN TPA$_LAMBDA, START, CREATE_RECORD $STATE SIGNAL_ERR $TRAN TPA$_LAMBDA, START, BAD_FIELD $END_STATE .PAGE ; ; Get Line from Input File ; GET_INPUT: .WORD ^M $GET - ; Read a Record rab = INPUT_RAB,- err = INP_GET_ERR BLBS R0, 20$ BBSS #STS$V_INHIB_MSG, R0, .+1 RET ; ; Initialize TPARSE Block With String Address and Length ; 20$: MOVAL INPUT_RAB, R1 ; Get Address of RAB MOVZWL RAB$W_RSZ(R1), TPA$L_STRINGCNT(AP) MOVL RAB$L_RBF(R1), TPA$L_STRINGPTR(AP) CLRL TPA$L_TOKENCNT(AP) CLRL TPA$L_TOKENPTR(AP) INCL LINE ; ; Remove Tabs and Convert to Uppercase ; MOVZWL RAB$W_RSZ(R1), R2 ; Set Length MOVL RAB$L_RBF(R1), R3 ; Set Buffer Address BRB 50$ 30$: CMPB (R3)[R2], #TAB ; Check for Tab BNEQ 40$ ; Branch if No Tab MOVB #^A/ /, (R3)[R2] ; Replace With Space If There Is 40$: CMPB (R3)[R2], #^A/a/ ; Check Less Than Lowercase A BLSS 50$ ; It is Goto Next Character CMPB (R3)[R2], #^A/z/ ; Check Greater Than Lowercase Z BGTR 50$ ; It is Goto Next Character SUBB2 #<^A/a/-^A/A/>, (R3)[R2] ; Convert to Upper Case 50$: SOBGEQ R2, 30$ ; Loop Thru Whole String RET ; ; Initialize Watchdog Database Record ; CREATE_DB: .WORD ^M INDEX NO_EXCEPTIONS, - ; Compute Index #0, - #EXCEPT_C_MAXIMUM-1, - #EXCEPT_C_BLN, #0, R6 ADDL3 R6, EXCEPTION_ADDR, R10 ; Load Base Address PUSHR #^M MOVC5 (SP), #0, #0, #EXCEPT_K_BLN, (R10) ; Clear Record POPR #^M MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor CLRL DSC$W_LENGTH(R1) ; Clear String Length CLRL IDENT_VAL ; Clear Identifier RET ; ; Create Exception Record ; CREATE_RECORD: .WORD ^M INDEX NO_EXCEPTIONS, - ; Compute Index #0, - #EXCEPT_C_MAXIMUM-1, - #EXCEPT_C_BLN, #0, R6 ADDL3 R6, EXCEPTION_ADDR, R10 ; Load Base Address ; ; Set Exception Record Values ; MOVL IDENT_VAL, EXCEPT_L_IDENTIFIER(R10) ; Set Identifier MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor MOVAL EXCEPT_Q_DESCRIPTOR(R10), R2 ; Get Address of Descriptor TSTL DSC$W_LENGTH(R1) ; Check for String or Ident BEQL 10$ MOVL DSC$W_LENGTH(R1), DSC$W_LENGTH(R2) ; Set String Length MOVL DSC$A_POINTER(R1),DSC$A_POINTER(R2); Move Address of String ADDL2 DSC$W_LENGTH(R1), DSC$A_POINTER(R1) ; Add of String CLRL DSC$W_LENGTH(R1) ; Clear String Length 10$: MOVL PARSER_FLAG, EXCEPT_L_RECTYP(R10) ; Record Type MOVL START_VAL, EXCEPT_L_START_MSG(R10) ; Start Message MOVL STOP_VAL, EXCEPT_L_STOP_PROCESS(R10) ; Stop Message MOVL OPTION_FLAG, EXCEPT_L_OPTIONS(R10) ; Option Flags INCL NO_EXCEPTIONS ; Increment Number of Exceptions ; ; Reset Parse Values ; CLRL PARSER_FLAG ; Clear Record Type CLRL START_VAL ; Reset Start Message CLRL STOP_VAL ; Reset Stop Message MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor CLRW DSC$W_LENGTH(R1) ; Clear Descriptor Length MOVL DEFAULT_FLAGS, OPTION_FLAG ; Reset Default Option Flags RET ; ; Set Wildcard Value ; SETSTR_WILD: .WORD ^M INDEX NO_EXCEPTIONS, - ; Compute Index #0, - #EXCEPT_C_MAXIMUM-1, - #EXCEPT_C_BLN, #0, R6 ADDL3 R6, EXCEPTION_ADDR, R10 ; Load Base Address MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor MNEGW DSC$W_LENGTH(R1), EXCEPT_W_WILDCARD(R10) BISW2 #^X8000, EXCEPT_W_WILDCARD(R10) ; Set High Order Bit RET ; ; CREATE NEW STRING ; NEW_STRING: .WORD ^M MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor MOVL DSC$A_POINTER(R1), R9 ; Get Address of Temporary Str PUSHR #^M MOVC5 (SP), #0, #0, #EXCEPT_C_STRLEN, (R9) ; Clear String POPR #^M BBCS #TPA$V_BLANKS, TPA$L_OPTIONS(AP), .+1 ; Turn on Blank Processing ; ; Check if Wildcard is at Beginning ; If So Don't Move the Character INDEX NO_EXCEPTIONS, - ; Compute Index #0, - #EXCEPT_C_MAXIMUM-1, - #EXCEPT_C_BLN, #0, R6 ADDL3 R6, EXCEPTION_ADDR, R10 ; Load Base Address TSTW EXCEPT_W_WILDCARD(R10) BNEQU 10$ ; Branch Around Moving Character BSBB ADDTO_STRING ; Add Character to String 10$: RET ; ; Add to String ; ADDTO_STR: .WORD ^M<> ADDTO_STRING: PUSHR #^M MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor MOVL DSC$A_POINTER(R1), R9 ; Get Address of Temporary Str MOVL DSC$W_LENGTH(R1), R7 ; Initialize String Length MOVB TPA$B_CHAR(AP), (R9)[R7] ; Move the Character to string INCL DSC$W_LENGTH(R1) ; Increment the Length POPR #^M RET ; ; End of String ; END_STR: .WORD ^M<> BBSC #TPA$V_BLANKS, TPA$L_OPTIONS(AP), .+1 ; Turn Off Blank Processing RET ; ; Set Default Start and Stop Values ; SET_DEFSTART: .WORD ^M<> MOVL START_MESSAGE, START_VAL RET SET_DEFSTOP: .WORD ^M<> MOVL STOP_PROCESS, STOP_VAL RET ; ; Bad Record Type Found ; BAD_FIELD: .WORD ^M MOVAL INPUT_RAB, R1 ; Get Address of RAB PUSHL RAB$L_RBF(R1) MOVZWL RAB$W_RSZ(R1), -(SP) MOVL SP, -(SP) ; Push Address of Descriptor CALLS #1, G^LIB$PUT_OUTPUT ; Write Error Line Out ADDL2 #DSC$C_D_BLN, SP ; Restore Stack BBSC #TPA$V_BLANKS, TPA$L_OPTIONS(AP), .+1 ; Turn Off Blank Processing FFS #0, #32, ERROR_FLAG, R2 ; Find What Flag is Set BEQL PARSER_ERR ; No Bits Set INDEX R2, - ; Compute Index #0, - #31, - #DSC$C_D_BLN+11, #0, R2 PUSHL LINE ; Line Number ADDL3 #FIELD_NAMES, R2, -(SP) ; Push Field PUSHL #1 ; Number of FAO Args PUSHL # ; Error Code PUSHL #3 ; Number Vector Elements $PUTMSG_S - ; Put Message to SYS$ERROR msgvec = 12(SP) - ; Message Vector facnam = FACILITY_NAME ; Facility Name ; ; Reset Parse Values ; CLRL PARSER_FLAG ; Clear Record Type CLRL ERROR_FLAG ; Parser Error Flags CLRL START_VAL ; Reset Start Message CLRL STOP_VAL ; Reset Stop Message MOVAL TEMP_DESCRIPTOR, R1 ; Get Address of Descriptor CLRW DSC$W_LENGTH(R1) ; Clear Descriptor Length CLRL OPTION_FLAG ; Clear Option Flags RET PARSER_ERR: MOVL #OTS$_FATINTERR,R0 ; Unknown Error RET .PAGE .SBTTL ERROR_ROUTINES - RMS Input/Output Error Routines ;+ ; ; These Routines is Entered When an Error is Detected on a File. ; A Message is Printed and Return is Made to the Original Caller. ; ; INPUTS: ; ; 4(AP) = ADDRESS OF THE FAB/RAB FOR WHICH ERROR OCCURRED ; ;- ; ; INP_GET_ERR - Error Reading File ; INP_GET_ERR: ; Error Reading Input File .WORD ^M ; Register Mask BSBB RAB_ERR ; Process Error on RAB .LONG SHR$_READERR!STS$M_FAC_NO ; Error Code ; ; INP_CON_ERR - Input File Connect Error ; INP_CON_ERR: ; Error Connecting Input File .WORD ^M ; Register Mask BSBB RAB_ERR ; Process Error on RAB .LONG SHR$_OPENIN!STS$M_FAC_NO ; Error Code ; ; RAB_ERR - RAB Error Processing ; RAB_ERR: MOVL 4(AP),R1 ; Get the RAB MOVL RAB$L_FAB(R1), R0 ; Get FAB from That MOVQ RAB$L_STS(R1), FAB$L_STS(R0) ; Put Errors in Common Place CMPL #RMS$_EOF, FAB$L_STS(R0) ; Continue on EOF BNEQ FIL_ERR ; Process Unknown File Error RET ; ; INP_OPN_ERR - Input File Open Error ; INP_OPN_ERR: ; Error Opening Input File .WORD ^M ; Register Mask BSBB FAB_ERR ; Process FAB Error .LONG SHR$_OPENIN!STS$M_FAC_NO ; Error Code ; ; INP_CLS_ERR - Input File Close Error ; INP_CLS_ERR: ; Error Closing Input File .WORD ^M ; Register Mask BSBB FAB_ERR ; Process FAB Error .LONG SHR$_CLOSEIN!STS$M_FAC_NO ; Error Code ; ; FAB_ERR - FAB Error Processing ; FAB_ERR: MOVL 4(AP), R0 ; Get the FAB ; ; FIL_ERR - File Error Processing ; FIL_ERR: MOVL FAB$L_NAM(R0), R1 ; Get Name Block Address MOVL NAM$L_RSA(R1), R3 ; Set Resultant String Address MOVZBL NAM$B_RSL(R1), R2 ; and Length BNEQ 10$ ; BR If Resultant Name Formed MOVL NAM$L_ESA(R1), R3 ; Address of Expanded String MOVZBL NAM$B_ESL(R1), R2 ; and Length BNEQ 10$ ; BR If Expanded String Formed MOVL FAB$L_FNA(R0), R3 ; Set Input File Name MOVB FAB$B_FNS(R0), R2 ; and Size for Message 10$: MOVL @(SP)+, R1 ; Get the Error Code ; ; Set up Message Vector for Call to SYS$PUTMSG ; PUSHR #^M ; Push Descriptor for File Name MOVQ FAB$L_STS(R0),-(SP) ; Push RMS Error Codes PUSHAQ 8(SP) ; Address of Name Descriptor PUSHL #1 ; Number of Arguments PUSHL R1 ; Message Code PUSHL #5 ; Total Size of the Msg Vector ; Fall into Show Message ; ; Set up Argument List for and Call SYS$PUTMSG ; SHOW_MSG: $PUTMSG_S - ; Put Message to SYS$ERROR msgvec = 12(SP) - ; Message Vector facnam = FACILITY_NAME ; Facility Name RET ; .END WATCHDOG ; Call It a Day