SUBTTL Initialization Rex W. Shadrick /DVB/DRB/RWS/TW/JMS 21-Dec-80 ; This routine is set up to scan 702 or 703 disk DDB chains and ; output some useful information. This routine is set up to ; drive an ASR33, Mini-Bee, Hazeltine 2000, Hazeltine Modular-One, ; LSI ADM-1, LSI ADM-3, DEC VT05, DEC VT50, DEC VT52, DEC VT61 or DEC VT100 ; terminal. ;Search some universal files SEARCH MACTEN ;Get some macros SEARCH UUOSYM ;Get some nice symbols [274] ;Make the listing look nice SALL ;Suppress macro expansion .DIREC FLBLST ;Suppress multi-line binary [277] ;Define the version number DDBVER==6 ;Version 6 of DDBDPY [274] DDBMIN==0 ;Minor version number [274] DDBWHO==1 ;Last editor [274] DDBEDT==302 ;Last edit number [274] LOC 137 .JBVER: VRSN. DDB ;Store the version number [274] TWOSEG ;Setup two segment relocation [274] RELOC SUBTTL Table of Contents ; Table of Contents for DDBDPY ; ; Section Page ; ; ; 1. History ; 1.1 Revisions . . . . . . . . . . . . . . . . . . 4 ; 1.2 Suggestions . . . . . . . . . . . . . . . . . 10 ; 2. Definitions ; 2.1 Conditional Values . . . . . . . . . . . . . . 11 ; 2.2 Constant Values . . . . . . . . . . . . . . . 12 ; 2.3 Macros ; 2.3.1 .MNVAL . . . . . . . . . . . . . . . . . 16 ; 2.3.2 .TITLE, .DSPCL and .DSPTB . . . . . . . 20 ; 2.3.3 .HLPTX . . . . . . . . . . . . . . . . . 22 ; 2.3.4 .ASPAG . . . . . . . . . . . . . . . . . 23 ; 3. Program Initalization . . . . . . . . . . . . . . . . 24 ; 4. The DDB Scanning Loop . . . . . . . . . . . . . . . . 31 ; 5. Make the Header Line and Output the Buffer . . . . . . 37 ; 6. Command Scanner ; 6.1 Read the Command Character . . . . . . . . . . 40 ; 6.2 The Command Dispatch Table . . . . . . . . . . 41 ; 6.3 The Command Processors . . . . . . . . . . . . 42 ; 7. Input Routines ; 7.1 SCAN - Input a File Specification . . . . . . 48 ; 7.2 OCTIN/DECIN - Input a Number . . . . . . . . . 52 ; 7.3 WLDOCT - Input a Wild Octal Number . . . . . . 53 ; 7.4 WLDSIX - Input Wild SIXBIT . . . . . . . . . . 54 ; 7.5 CLRLIN - Clear to End of Line . . . . . . . . 55 ; 7.6 TSTEOL - Test of End-of-Line Character . . . . 56 ; 8. Output Routines ; 8.1 PPNOUT/PPNJST - Output a PPN . . . . . . . . . 57 ; 8.2 OCTOUT/DECOUT/OCTJST/DECJST . . . . . . . . . 58 ; 8.3 CHROUT - Output a Character . . . . . . . . . 59 ; 8.4 PRVOUT - Output a Protection . . . . . . . . . 60 ; 8.5 JUST - Justify the Output . . . . . . . . . . 61 ; 8.6 ASCOUT - Output an ASCIZ String . . . . . . . 62 ; 8.7 SIXOUT - Output a SIXBIT Word . . . . . . . . 63 ; 8.8 TTLLIN - Set Up for the Title Line . . . . . . 64 ; 8.9 BEGLIN - Set up for a Display Line . . . . . . 65 ; 8.10 ENDLIN - Finish off a Display Line . . . . . . 66 ; 8.11 COMOUT - Output a Comma . . . . . . . . . . . 67 ; 8.12 CLNOUT - Output a Colon . . . . . . . . . . . 68 ; 8.13 LBROUT, RBROUT - Output a Bracket . . . . . . 69 ; 8.14 SLHOUT - Output a Slash . . . . . . . . . . . 70 ; 8.15 SPAOUT - Output a Space . . . . . . . . . . . 71 ; 9. Output Routines - STROUT - Output a Structure Name and 72 SUBTTL Table of Contents (page 2) ; Table of Contents for DDBDPY ; ; Section Page ; ; ; 10. Output Routines ; 10.1 SCALE - Scale a Decimal Number . . . . . . . . 73 ; 10.2 TIMOUT - Output a Time . . . . . . . . . . . . 74 ; 10.3 TWOOUT - Output Atleast Two Digits . . . . . . 75 ; 10.4 SIXJST - Output a Justified SIXBIT Word . . . 76 ; 10.5 JOBOUT - Output Some Job Status . . . . . . . 77 ; 10.6 CMDOUT - Output the Command String . . . . . . 90 ; 10.7 SPCOUT - Output a File Specification . . . . . 92 ; 10.8 WPPOUT - Output a Wild PPN . . . . . . . . . . 93 ; 10.9 WOCOUT - Output a wild octal number . . . . . 94 ; 11. Display Initalization ; 11.1 TRMDSP - Get the Default Terminal Type . . . . 95 ; 11.2 SETDSP - Set up Display Size . . . . . . . . . 96 ; 12. Useful Routines ; 12.1 HGHSIZ/LOWSIZ - Get a Segment Size . . . . . . 97 ; 12.2 ADJTIM - Convert UDT to Jiffies . . . . . . . 98 ; 12.3 PAGADJ - Page Adjustment . . . . . . . . . . . 99 ; 12.4 TSTABR - Test for an Abbreviation . . . . . . 100 ; 12.5 RSTTRM - Restore Terminal Characteristics . . 101 ; 13. DDB Scanning Routines ; 13.1 FNDSTR - Find a Structure Name . . . . . . . . 102 ; 13.2 GETLDB - Map a LDB Page into Core . . . . . . 103 ; 13.3 MAPSTR - Map a STR given its Pointer . . . . . 104 ; 13.4 GETUNI - Get a UNI from the DDB Pointer . . . 105 ; 13.5 GETBLK - Map a Data Structure . . . . . . . . 106 ; 13.6 FUNWRD - Get a Word from Funny Space . . . . . 109 ; 13.7 MAPFUN - Map a Job's Funny Space . . . . . . . 110 ; 13.8 MAPUPT - Map a Job's UPT . . . . . . . . . . . 111 ; 14. DDB Test Routines ; 14.1 TSTPRG - Test for Program . . . . . . . . . . 112 ; 14.2 TSTNOT - Test for NOT Logged-In . . . . . . . 113 ; 14.3 TSTLOG - Test for Logged-In . . . . . . . . . 114 ; 14.4 TSTFIL - Test for a File Specification . . . . 115 ; 14.5 TSTJOB - Test for a Job . . . . . . . . . . . 116 ; 15. Display Routines ; 15.1 TRMCLR - Clear the Screen . . . . . . . . . . 117 ; 15.2 TRMEOS - Clear to End of Screen . . . . . . . 118 ; 15.3 TRMEOL - Clear to End of Line . . . . . . . . 119 ; 15.4 TRMHOM - Home the Screen . . . . . . . . . . . 120 ; 16. The Error Message Routines . . . . . . . . . . . . . . 121 ; 17. Data/Storage ; 17.1 High Segment . . . . . . . . . . . . . . . . . 122 ; 17.2 Low Segment . . . . . . . . . . . . . . . . . 127 ; 18. The End . . . . . . . . . . . . . . . . . . . . . . . 134 SUBTTL History -- Revisions ; Edit Date Comment ; ; *** 27-May-75 Change the major version number from 4 to 5. ; ; 134 27-May-75 Add support for the Hazeltine-2000, DEC VT05B, LSI ; ADM-1 and DEC VT50 terminals. ; ; 135 28-May-75 Replace the macro '.TTYDP' with the file ; 'SYS:DDBDPY.INI'. ; ; 136 29-May-75 Add the option to change the display back to the ; default display for this terminal. ; ; 137 29-May-75 List spooled device DDBs. ; ; 140 04-Jun-75 Change the title line and remove the "I" command. ; ; 141 04-Jun-75 Add support for the 602 monitor. ; ; 142 04-Jun-75 Change the output under the 'OTH' column. ; ; 143 04-Jun-75 More of edit 141. ; ; 144 06-Jun-75 Improve the Control-C (^C) intercept routine and ; remove the "L" and "T" commands. ; ; 145 06-Jun-75 More of edit 135. ; ; 146 19-Sep-75 Display the entered spooled name (602), allow "J" ; command if not [1,2] (but only look at the job if ; logged in under the same programmer number) and ; change the "P" command to the "L" command. ; ; 147 20-Oct-75 Add the "K" command which kills the display and ; LOGOUTs the job. ; ; 150 23-Oct-75 Add a debugging aid. ; ; 151 04-Nov-75 Add support to display the entire path of the file ; being displayed and add "P" command to display this ; information. ; ; 152 05-Nov-75 Rewrite subroutines 'SCAN' and 'TSTFIL'. ; ; 153 07-Nov-75 Add some small goodies and fix some minor bugs. ; ; 154 07-Nov-75 Rewrite subroutine 'FNDSTR' and display the mount ; count. ; ; 155 10-Nov-75 Display the current command string being processed. ; Edit Date Comment ; ; 156 10-Nov-75 Allow a space between commands. ; ; 157 18-Nov-75 Make the "K" command restore the line characteristics ; before the RUN UUO is executed. ; ; 160 05-Dec-75 Change the "J" command to display more information ; about the job. ; ; 161 10-Dec-75 More of edit 160. ; ; 162 10-Dec-75 Remove 506 support (too many questionable symbols) ; and don't allow subjobs to run DDBDPY. ; ; 163 12-Dec-75 Add DEC VT52 support and don't allow the title ; buffer to overflow. ; ; 164 18-Dec-75 Replace the allocated length by the unit status ; (i.e. idle, seek, seek wait, position, ...) and ; the LOOKUP count. ; ; 165 23-Dec-75 Reenable the old "T" Command (complement the output ; of the title line), get the jiffies per second from ; the monitor and do one update and pause on an ESCAPE. ; ; 166 21-Jan-76 More of edit 165 - timout was outputting the parts ; of a second incorrectly. ; ; 167 25-Jan-76 Correct the core size of a job on a VM monitor. ; ; 170 19-Mar-76 Put the allocated length back and fix the six ; digit PPN problem. ; ; 171 24-Mar-76 Under the 'OTH' column output an 'I' for input wait ; or an 'O' for output wait and clear the terminal ; input buffer on a 'K' command. ; ; 172 26-Mar-76 Fix the Hazeltine clear to the end-of-screen routine. ; ; 173 05-Apr-76 Change the sleep time after 10 scans. ; ; 174 21-Apr-76 More of edit 173. ; ; 175 28-Apr-76 Allow lower case commands. ; ; 176 04-May-76 Add support for the Hazeltine "Modular One". ; ; 177 17-May-76 Search MACTEN and UUOSYM instead of C. ; ; 200 28-Jun-76 Allow a tab as a break character between commands. ; ; 201 28-Jun-76 Add the rescan code. ; Edit Date Comment ; ; 202 11-Aug-76 Do a little more code clean up. ; ; 203 01-Sep-76 Allow only privileged users to run DDBDPY and more ; of edit 201. ; ; 204 15-Oct-76 Add support for the 603 monitor, add support for ; the LSI ADM-3 and DEC VT61 terminals, and improve ; edit 173. ; ; 205 26-Oct-76 Improve the DDB to output code. ; ; 206 30-Nov-76 Change the default PPN specification for the ; F, J and L commands: ; [OPR] -> [*,*] ; [non-OPR] -> [*,PRG] ; ; 207 22-Feb-77 Don't clear the terminal input buffer on a "^Z" ; or "^C" and clear to the end of the command line ; on "K" command. ; ; 210 22-Feb-77 More of edit 204 (603 monitor support). ; ; 211 23-Feb-77 Change the file specification for the 'INI' file, ; 'SYS:DDBDPY.INI' -> 'SYS:DISPLA.INI'. ; ; 212 10-Mar-77 Allow DDBDPY to run as a subjob, but not a batch ; or MIC subjob. ; ; 213 14-Mar-77 Add a little 2741 support, allow "<" and ">" around ; the PPN specification. ; ; 214 06-May-77 Output an 'S' If the structure is mounted single ; access, in the header, and change 'RD' to 'RED' and ; 'WT' to 'WRT', in the job display. ; ; 215 06-May-77 Put in a check for a null structure name. ; ; 216 13-May-77 Add a third line to the job display. ; ; 217 18-May-77 Change LSI and LSI3 to ADM1 and ADM3 respectively, ; to be consistent with TECO %124. ; ; 220 19-May-77 Fix a bug in the path mode output. ; ; 221 20-May-77 Output the user's active search list on a 'J' command. ; ; 222 20-May-77 Add support for the node/line convension in ; 'DISPLA.INI'. ; Edit Date Comment ; ; 223 24-May-77 On the job display output event wait codes: ; TK - (1) Tape kontroller wait ; TR - (2) Tape rewind wait ; LP - (3) Label processing wait ; NW - (4) Network wait ; IP - (5) IPCF system process receive wait ; FI - (6) Front end device input wait ; FO - (7) Front end device output wait ; D6 - (10) DAS60 device wait ; ; 224 26-May-77 On the job display output the smaller of the two, ; free on the structure or LOGIN quota. ; ; 225 02-Jun-77 On start-up always reset the sleep time after 10 ; scans. ; ; 226 02-Jul-77 Search STCMAC to get the $VRSN and $TITLE macros. ; ; 227 03-Jul-77 Add the "N" command, display jobs not logged-in ; under this PPN, the default PPN is the user's. ; ; 230 18-Jul-77 Add support for super-mode I/O. ; ; 231 18-Jul-77 Add support for ERSATZ Devices: ; SYS:*.EXE -> ALL:*.EXE[1,4] ; SYSA:*.SHR -> DSKA:*.SHR[1,4] ; ; 232 19-Jul-77 Allow users with SPY privileges to have Godliness. ; ; 233 19-Jul-77 Change the "P" command to "E" command for 'Extended' ; status and output the logical name, protection code ; and I/O mode. ; ; 234 20-Jul-77 Add a new "P" command which output only DDBDPY that ; from jobs running a program. ; ; 235 21-Jul-77 Remove some questionable conditional code. ; ; 236 21-Jul-77 Add support for 'ALL' in 'SYS:DISPLA.INI': ; ALL_OPR:VT50 -> On all nodes, OPR is a VT50 ; XXX_ALL:VT52 -> On node XXX all terminals are ; VT52s ; ALL_ALL:VT05 -> On all nodes all terminals ; are VT05s ; ; 237 09-Mar-78 Fix a bug in the display of the command buffer, "A" ; was being output as "J0". ; ; 240 09-Mar-78 Make ADM3s work if "TTY NO BLANK" is enabled. ; ; 241 09-Mar-78 Search STCUNV instead of STCMAC. ; Edit Date Comment ; ; 242 09-Mar-78 Output the high segment name if it is different than ; the low segment name. ; ; 243 19-May-78 Add support for the Soroc IQ-120 terminal. ; ; 244 08-Sep-78 Make DDBDPY and TECO more compatiable in the use of ; terminal types in DISPLA.INI. ; ; 245 28-Sep-78 Output the low segment size correctly for non-sharable ; VM systems. ; ; 246 26-Oct-78 SL and HB are swapped in the job output. ; ; *** 26-Oct-78 Change the major version number from 5 to 6 ; ; 247 17-Apr-80 Add support for monitor version 700. ; ; 250 02-May-80 Do lots of code clean up. ; ; 251 07-May-80 Fix two bugs: ; 1) LDRREM was defined wrong. ; 2) When the terminal type (via TRMOP.) was ; known, the input routine (INCHR) was ; trashed. ; ; 252 07-May-80 Add support for the Datamedia 1521 (DM1521). ; ; 253 12-May-80 Put FTKL around some DDB definitions so that it will work ; on the 2020. JMS @ CSM ; ; 254 12-May-80 Get the value of .PDJSL right for KL 701. JMS @ CSM ; ; 255 09-Sep-80 Add feature-test ITTYPE. If non-zero, use ITTYPE.REL to ; do the TRMOP. and/or read SYS:DISPLA.INI to get the terminal ; type. ITTYPE also allows for aliases in DISPLA.INI, such ; as CRT=ADM3. JMS @ CSM ; ; 256 16-Sep-80 ADP users running on CSM's 2020 need to be able to look at ; all DDBs without knowing the magic word. Pretend that ; everybody running on that CPU is [1,2] by testing the CPU ; serial number for being 4275. JMS @ CSM ; ; 257 16-Oct-80 Change default monitor version to 701. Change ; IFE MONVER-603 to IFL MONVER-700 etc. ; ; 260 27-Oct-80 Can't get LDB information for a detached job, so ; don't output ICC/OCC/CMD information. ; Edit Date Comment ; ; 261 15-Dec-80 If 7.01, make the DDBDPY run in 2 segments. ; ; 262 15-Dec-80 Make the ERSATZ device stuff work with 7.01. ; ; 263 3-Feb-81 If a PAGE. UUO fails, reset the PDL and go back to DDBMAN. ; ; 264 5-Aug-81 Insert code for VT100 terminal. ; ; 265 24-Nov-81 Destroy all SPY pages so that RUN uuo to LOGOUT won't get ; "?1P of core needed". ; ; 266 14-May-85 Update for 7.02/7.03 and KL paging. ; ; 267 27-May-85 Convert more constants to symbols, rework the terminal ; display stuff. ; ; 270 3-Jun-85 Output the number of funny pages as part of the job's core ; size. ; ; 271 3-Jun-85 Clean up the code that outputs structure names and free ; counts. ; ; 272 3-Jun-85 Type the job's path after the character counts in th job ; display. ; ; 273 8-Jun-85 Rework the display code and add lots of terminal name ; aliases. ; ; 274 10-Jun-85 Add hacks to allow this to be assembled with brain damaged ; MACRO. This implies the removal of SYSUNV features. ; ; 275 12-Jun-85 Add the "O" command which will enable the display of swapped ; out DDBs. Since this is expensive and requires the use of ; JOBPEK, require its use to those people who have poke privs ; or are logged in under [1,2] ; ; 276 17-Jun-85 Output the job's LIB: on a fourth job status line if one ; exists. ; ; 277 12-Sep-85 Do a little minor clean up here and there. ; ; 300 12-Sep-85 Add the "C" command, which will cycle through all the ; displayable DDBs. ; ; 301 15-Nov-85 Output the job's current context number as part of the ; second status line of the job display and as part of the ; extended file display. ; ; 302 15-Nov-85 Add .IOAS8 (eight bit ASCII mode) to the I/O modes table ; (MODTAB), even though it isn't possible to anything we ; type about. ; ; ** End of the Revision History ** SUBTTL History -- Suggestions ; Date Suggestion ; ; 27-May-75 Output the DDBs in order of oldest to newest. ; ; 10-Dec-75 Add split screen support (the upper half is for DDBDPY ; and the lower half is for an interactive subjob). ; ; 28-Apr-76 On VT05, VT50, VT52 and VT61 terminals clear to the E-O-L ; instead of clearing the line then typing the data. ; ; 22-Feb-77 Add support to scan 'SWITCH.INI'. ; ; 19-Jul-77 Output DTA (file name and next record) and MTA (next ; file and record). ; ; 12-May-80 Output spooling name (.RBSPL) for the extended path. ; ; 12-May-80 Output .RBSPL in the OTH column on normal display, so we can ; tell which file the spooler is working on. (QXJ54Z.LPT=FOR06) ; ; 12-May-80 Ignore spaces between the comand and the argument (eg "P LPTSPL") ; ; 16-Oct-80 Exit on Control-C like SYSDPY does, by erasing only the bottom ; 2 lines. This leaves most of the display intact. ; ; ** End of the Suggestion History ** SUBTTL Definitions -- Conditional Values ;Define some conditional assembly values ND FTMOUNT,-1 ;Non-zero to display the mount count ND FTSLEEP,-1 ;Non-zero to adjust the sleep time ND FTDEBUG,0 ;Non-zero to allow a debugging aid ND FTPRIV,0 ;Non-zero to check privileges to run ddbdpy ND FTPROG,-1 ;Non-zero to make programmer number match ND FTPROJ,0 ;Non-zero to make project number match ND FTKL,-1 ;Non-zero for KL DDB definitions [253] ;Define some conditional values ND MONVER,703 ;The version of the monitor DDBDPY will ; run under ND PDLSIZ,^D20 ;The default size of the push down list ND PATSIZ,^D50 ;The default patch size when debugging ND PASWRD,'HOST ' ;The password for the 'G' command ND MAXSTR,^D4 ;The default number of structures to be ; typed on the title line ND SLPSCN,^D10 ;The sleep time counter ND SLPDEF,^D5000 ;The default hibernate time between scans ND SLPMIN,^D30000 ;The minimum sleep time without adjustment ND SLPADJ,^D30000 ;The new sleep time after adjustment ND SLPPTY,^D60000 ;The sleep time on a PTY ND MAXLIN,^D26 ;The default maximum number of lines ND WHTSIZ,^D11 ;The default command string buffer ND LINLEN,^D75 ;Default line length (including <0>) [273] ND LINSIZ,^D15 ;The default line size (5 char per word) ND BUFSIZ,> ;The size the line buffer ND FSTPAG,210 ;First randomly mappable page [266] ND TTLLNS,3 ;Number of lines in the title [267] ND DDBMAX,46 ;Maximum number of DDB words we want [275] SUBTTL Definitions -- Constant Values ;Define the accumulators F=0 ;Flags T1=1 ;Temporary AC T2=2 ;Temporary AC T3=3 ;Temporary AC T4=4 ;Temporary AC T5=5 ;Temporary AC P1=6 ;Holds the current display type (Permanent AC) P2=7 ;Holds the link to the current DDB (Permanent AC) P3=10 ;Holds the link to the current ACC (Permanent AC) ; or the link to the current PDB (Job display) P4=11 ;Holds the link to the current AKB (Permanent AC) ; or the link to the current NMB ; or the link to the current STR ; or the job status (Job display) P5=12 ;Holds the link to the current PPB (Permanent AC) ; or the job or segment number (Job display) C=13 ;Holds a character CC=14 ;Holds the column count LC=15 ;Holds the line count BP=16 ;Holds a byte pointer P=17 ;Holds the push down pointer ;Define an I/O channel to the TTY and to the disk SYS==16 ;I/O channel to SYS TTY==17 ;I/O channel to the TTY ;Define some permanent flags for 'F' (left half) F.XTN==1B0 ;If on, display the entire path (sign bit) F.HLP==1B1 ;If on, give a help text F.INI==1B2 ;If on, the program has be initalized F.WLD==1B3 ;If on, check for a event to occur F.GOD==1B4 ;If on, the job is privileged F.CLR==1B5 ;If on, clear the screen before this scan F.DDT==1B6 ;If on, DDT is loaded and don't do some goodies F.WHT==1B7 ;If on, display the current command being processed F.JOB==1B8 ;If on, using job display mode F.PAS==1B9 ;If on, in pass one of the job display F.POK==1B10 ;If on, we're allowed to do JOBPEKs [275] F.PEK==1B11 ;If on, we are doing JOBPEKs [275] F.TTL==1B12 ;If on, don't output the title line F.ESC==1B13 ;If on, do an update and then pause F.RES==1B14 ;If on, we are in rescan mode F.CYC==1B15 ;If on, cycling through displayable DDBs [300] ;Define some temporary flags for 'F' (right half) F.NOD==1B18 ;If on, node name seen F.DEV==1B19 ;If on, device name seen F.FIL==1b20 ;If on, file name seen F.EXT==1B21 ;If on, extension was seen F.PPN==1B22 ;If on, PPN was seen F.AST==1B23 ;If on, astrisk was seen F.DIG==1B24 ;If on, a digit has been output F.NEG==1B25 ;If on, a negative sign must be output F.LOW==1B26 ;If on, get get the low segment size F.DCT==1B27 ;If on, don't clear the terminal input buffer F.SUP==1B29 ;If on, the file is for super-mode I/O F.SCN==1B30 ;The path's /SCAN switch [272] F.TMP==1B31 ;Random temporary bit [276] ;Define some status bits about the job or segment JS.RUN==1B0 ;The job is runnable JS.CMW==1B1 ;The job is in a command wait JS.JNA==1B3 ;The job number is assigned JS.LOK==1B5 ;The job is locked in core JS.SWP==1B7 ;The job is swapped JS.NSH==1B8 ;The job can't be shuffled JS.CLK==1B18 ;The job has a clock request JS.JDC==1B20 ;The job is in a DAEMON wait JS.DCE==1B22 ;The job is waiting for a device to continue JS.SFL==1B33 ;The job will pause on a disk full condition SS.SNA==1B0 ;The segment number is assigned SS.SPY==1B0 ;The segment is a SPY segment (GETSGN) [266] SS.SHR==1B1 ;The high segment is sharable ;Define some customer privilege bits JP.DPY==1B34 ;The user has privileges to run DDBDPY JP.PAS==1B35 ;The user can't change her password ; Define some other random monitor constants: SECMAP==540 ;Section 0 map pointer offset in EPT/UPT [266] ;Define some terminal flags (stored in the LH of P1) TM%DUM==1B0 ;The terminal is dumb (TTY, ADM3) [273] TM%EOL==1B1 ;Clear to end of line works [273] TM%FIL==1B2 ;Terminal needs to be filled [273] TM%CLR==1B3 ;Terminal can clear screen (instead of home, ers) [273] TM%LFS==1B4 ;Spew lots of s to clear to EOS [273] TM%PFX==37B13 ;The prefix index [273] TM%LEN==177B20 ;The terminal's length (in lines) [273] TM%WID==777B29 ;The terminal's width (in characters) [273] TM%CLS==77B35 ;The terminal's class [273] ; Define some terminal class flags: TTYFLG==TM%DUM!TM%CLR ;Flags for TTY [273] ADMFLG==TM%EOL!TM%FIL ;ADM-1,2 can clear to end of line [273] AD3FLG==TM%DUM!TM%LFS ;ADM3s need special attention [273] DM1FLG==TM%CLR!TM%EOL ;Datamedia 1521 [273] IQ1FLG==ADMFLG!TM%CLR ;And an IQ-120 can clear the screen [273] HZLFLG==TM%FIL!TM%CLR ;Hazeltines need fill [273] VTXFLG==TM%EOL ;VT-5x, VT-61, VT-100 and ANSI [273] MBEFLG==VTXFLG!TM%CLR&<^-TM%EOL> ;Minibee can't clear to end of line [273] V05FLG==TM%EOL!TM%FIL ;VT-05B flags [273] ;Other terminal miscellany %HZ1HP==^D68 ;Column to clear to on a Hazeltine terminal [273] SUBTTL Definitions -- Macros -- .MNVAL IFN <&>,< PRINTX ?DDBNSM Not a monitor supported by DDBDPY PASS2 END > DEFINE .MNVAL ($SYM,$702,$703),< IFE ,< $SYM==$702 > IFE ,< $SYM==$703 >> NS==-1 ;** No such symbol in this monitor ** ; Define some values used by DDBDPY in the DDB (device data block) .MNVAL DEVNAM,0,0 ;The device name in SIXBIT .MNVAL DEVCHR,1,1 ;The device characteristics (job number bits 0-6) .MNVAL DEVIOS,2,2 ;The input/output status .MNVAL IOSUPR,1B2,1B2 ;Super-mode I/O .MNVAL IOSIO,20,20 ;Output wait .MNVAL IOSIOW,1,1 ;Input/output wait .MNVAL DEVSER,3,3 ;The link to the next DDB (LH) .MNVAL DEVMOD,4,4 ;The device characteristics (char.,,modes) .MNVAL DEVLOG,5,5 ;The logical name for the device .MNVAL DEVSPL,12,12 ;The spool bit for this DDB .MNVAL DEVPAL,13,13 ;The pre-allocation word .MNVAL DEPPAL,20,20 ;Pre-allocated (bit 31 603) .MNVAL DEVFIL,22,23 ;The file name in SIXBIT .MNVAL DEVEXT,23,24 ;The file extension in SIXBIT (LH) IFN FTKL,< ;There is a FTKL&FTMP conditional in COMMOD at DEVPPN+1.[253] .MNVAL DEVREL,33,33 ;The relative block in the file to read or write .MNVAL DEVPRI,45,45 ;The disk priority (bits 27-29) > ;End of IFN FTKL [253] IFE FTKL,< ;Definition for KI and KS [253] .MNVAL DEVREL,27,27 ;The relative block in the file to read or write .MNVAL DEVPRI,41,41 ;The disk priority (bits 27-29) > ;End of IFE FTKL [253] ; Define some values used by DDBDPY in the NMB (file name data block) .MNVAL NMBNAM,0,0 ;The name of SFD in SIXBIT .MNVAL NMBPPB,1,1 ;The link to the father SFD (LH) .MNVAL NMPUPT,2,2 ;The SFD name is in NMBNAM (bit) .MNVAL NMBACC,3,3 ;The link to the NMB's ACC [272] ; Define some values used by DDBDPY in the ACC (access data block) .MNVAL ACCALC,0,0 ;The blocks allocated to this file (602) .MNVAL ACCDOR,3,3 ;The list link word (if zero, access is not ; dormant) .MNVAL ACCPPB,4,4 ;The link to the proj-prog block (RH 602) .MNVAL ACCSTS,5,5 ;The file status (RH) .MNVAL ACPREN,200,200 ;A RENAME UUO in progress (bit) .MNVAL ACPDEL,100,100 ;The file marked for deletion (bit) .MNVAL ACPSMU,4,4 ;Simultaneous update (bit 602) .MNVAL ACCWRT,6,6 ;The blocks written in the file .MNVAL ACCPRV,7,7 ;The protection code of the file (bits 0-8) ; Define some values used by DDBDPY in the PPB (proj-prog block) .MNVAL PPBNAM,0,0 ;Project number,,Programmer number .MNVAL PPBSYS,1,1 ;Link to the next PPB (LH) .MNVAL PPBUFB,2,2 ;Link to the UFB's for this PPN (LH) ; Define some values used by DDBDPY in the UFB (user file directory block) .MNVAL UFBTAL,0,0 ;Project number,,Programmer number .MNVAL UFBPPB,1,1 ;Link to the next UFB (LH) .MNVAL UFBFSN,4,4 ;The file structure number (bits 0-5) ; Define some values used by DDBDPY in the UNI (unit data block) .MNVAL UNINAM,0,0 ;The unit name (i.e. RPA0) .MNVAL UNISTR,4,4 ;The link to the file structure data block (RH) ; Define some values used by DDBDPY in the STR (file structure data block) .MNVAL STRNAM,0,0 ;The file structure name in SIXBIT .MNVAL STRFSN,1,1 ;The file structure number (RH) .MNVAL STRTAL,11,11 ;The number of free blocks .MNVAL STRMNT,13,13 ;The mount count for this structure .MNVAL STRJOB,20,20 ;The single access job ; Define some values used by DDBDPY in the LDB (line data block) .MNVAL LDBBCT,20,41 ;The commands type (LH) and ; the input wakeup's (RH) .MNVAL LDBICT,21,42 ;The input character count .MNVAL LDBOCT,22,43 ;The output character count ; LDBDCH: The terminal characteristics word: .MNVAL LDRPTY,1B18,1B18;The terminal is a PTY .MNVAL LDRREM,1B25,1B25;The terminal is remote .MNVAL LDBREM,33,57 ;The remote line number (bits 0-7) IFN FTKL,< ;KL has 4 words for the RSX-20F stuff [253] .MNVAL LDBMIC,41,65 ;The terminal is under MIC control > ;End of IFN FTKL [253] IFE FTKL,< ;4 words not in the LDB .MNVAL LDBMIC,41,41 ;The terminal is under MIC control > ;End of IFE FTKL [253] ; Define some values used by DDBDPY in the PDB (process data block) IFN FTKL,< ;The KL has EBOX & MBOX counters in the PDB [253] .MNVAL .PDJSL,30,34 ;The job's search list [254] .MNVAL .PDOSL,71,72 ;The old style LIB: PPN [276] .MNVAL .PDCTC,NS,77 ;The current context block pointer [301] > ;End of IFN FTKL [253] IFE FTKL,< ;4 words not in the PDB [253] .MNVAL .PDJSL,24,24 ;The job's search list .MNVAL .PDOSL,64,65 ;The old style LIB: PPN [276] .MNVAL .PDCTC,NS,73 ;The current context block pointer [301] > ;End of IFE FTKL [253] .MNVAL .FSFNC,45,45 ;The fence active/passive .MNVAL .FSEND,46,46 ;The logical end .MNVAL .FSTMP,47,47 ;The temporary .MNVAL .FSSTP,77,77 ;The physical end .MNVAL FS.WLK,100,100 ;The structure is write-locked .MNVAL FS.NCR,200,200 ;The structure is no-create ; Define some locations in the context block: .MNVAL .CTFLG,NS,0 ;Offset to the context flags [301] .MNVAL CNOMSK,NS,777 ;Mask for reading the context # [301] ; Define some locations in the monitor .MNVAL LIMLVL,5,5 ;The maximum SFD nesting level .MNVAL GTBSLF,410,410 ;The absolute address that contains the ; address of the 'GETTAB' pointers .MNVAL HI,400000,400000;The offset to the SPY segment SUBTTL Definitions -- Macros -- .TITLE, .DSPCL and .DSPTB DEFINE .TITLE ($MON,$CPU),< TITLE. DDB,DDBDPY, > IFN FTKL,< .TITLE \MONVER,KL> IFE FTKL,< .TITLE \MONVER,non-KL> DDBTTL ;Generate the title line [274] ;Define the terminal classes. The .CLS macro is of the form: ; .CLS $CLS,$CLR,$HOM,$EOS,$EOL ; $CLS - Terminal class suffix (matches similar arg in the .DSP macro) ; $CLR - Character value or routine to home and clear screen ; $HOM - Character value or routine to home screen ; $EOS - Character value or routine to clear to end of screen ; $EOL - Character value or routine to clear to end of line DEFINE .DSPCL < .CLS DUM,0,0,0,0 .CLS ADM,52,36,131,124 .CLS AD3,32,0,AD3EOS,0 .CLS D15,14,31,13,35 .CLS HZL,34,22,HZ1EOS,23 .CLS V05,0,35,37,36 .CLS VTX,105,110,112,113 > ; Define the known terminal types. the .DSP macro is of the form: ; .DSP $NAM,$FLG,$WID,$LEN,$PFX,$CLS,$LBL ; $NAM - The name of the terminal (6 chars or less) ; $FLG - Terminal type flags ; $WID - Line width ; $LEN - Number of lines per screen ; $PFX - Word of escape sequence prefix ; $CLS - Terminal class suffix ; $LBL - Optional label to be assigned to flags word storage DEFINE .DSPTB < .DSP ADM1,ADMFLG,^D80,^D24,ESC,ADM .DSP ADM3,AD3FLG,^D80,^D24,NUL,AD3 .DSP ADM3A,AD3FLG,^D80,^D24,NUL,AD3 .DSP ANSI52,VTXFLG,^D80,^D24,ESC,VTX .DSP DAS21,VTXFLG,^D80,^D24,ESC,VTX .DSP DM1521,DM1FLG,^D80,^D24,NUL,D15 .DSP GIGI,VTXFLG,^D80,^D24,CSI,VTX .DSP H19,VTXFLG,^D80,^D24,ESC,VTX .DSP HZLONE,HZLFLG,^D80,^D24,ALT,HZL .DSP HZL200,HZLFLG,^D77,^D26,ALT,HZL .DSP IQ120,IQ1FLG,^D79,^D24,ESC,ADM .DSP MINIBE,MBEFLG,^D79,^D24,ESC,VTX .DSP PRO350,VTXFLG,^D80,^D24,CSI,VTX .DSP TTY,TTYFLG,^D72,^D19,NUL,DUM,%TTYTP .DSP VK100,VTXFLG,^D80,^D24,CSI,VTX .DSP VT05B,V05FLG,^D80,^D24,NUL,V05 .DSP VT50,VTXFLG,^D80,^D12,ESC,VTX .DSP VT50H,VTXFLG,^D80,^D24,ESC,VTX .DSP VT52,VTXFLG,^D80,^D24,ESC,VTX .DSP VT55,VTXFLG,^D80,^D24,ESC,VTX .DSP VT61,VTXFLG,^D80,^D24,ESC,VTX .DSP VT62,VTXFLG,^D80,^D24,ESC,VTX .DSP VT71,VTXFLG,^D80,^D24,ESC,VTX .DSP VT72,VTXFLG,^D80,^D24,ESC,VTX .DSP VT78,VTXFLG,^D80,^D24,ESC,VTX .DSP VT80,VTXFLG,^D80,^D24,ESC,VTX .DSP VT100,VTXFLG,^D80,^D24,CSI,VTX .DSP VT101,VTXFLG,^D80,^D24,CSI,VTX .DSP VT102,VTXFLG,^D80,^D24,CSI,VTX .DSP VT102J,VTXFLG,^D80,^D24,CSI,VTX .DSP VT103,VTXFLG,^D80,^D24,CSI,VTX .DSP VT105,VTXFLG,^D80,^D24,CSI,VTX .DSP VT110,VTXFLG,^D80,^D24,CSI,VTX .DSP VT125,VTXFLG,^D80,^D24,CSI,VTX .DSP VT131,VTXFLG,^D80,^D24,CSI,VTX .DSP VT132,VTXFLG,^D80,^D24,CSI,VTX .DSP VT170,VTXFLG,^D80,^D24,CSI,VTX .DSP VT180,VTXFLG,^D80,^D24,CSI,VTX .DSP VT185,VTXFLG,^D80,^D24,CSI,VTX .DSP VT200,VTXFLG,^D80,^D24,CSI,VTX .DSP VT220,VTXFLG,^D80,^D24,CSI,VTX .DSP VT240,VTXFLG,^D80,^D24,CSI,VTX .DSP VT241,VTXFLG,^D80,^D24,CSI,VTX .DSP VT278,VTXFLG,^D80,^D24,CSI,VTX > SUBTTL Definitions -- Macros -- .HLPTX DEFINE .HLPTX ($MON,$VER,$EDT)< XLIST ;;Turn the listing off ASCIZ ~DDBDPY %'$VER($EDT) Help Text - Set up for a $MON Monitor Each command must be terminated by a break character ^C (Control-C) OR ^Z (Control-Z) will exit the job Update the listing Update the listing and wait for a new command + Advance the listing by one page - Decrement the listing by one page A List all the disk DDBs (privileged command) C Complement the cycling of displayable DDBs D Change the type of display E Complement the listing of the extended status F List only the DDBs that reference a file specification H This help text J List only the DDBs from a job K Kill the execution and this job L List only the DDBs that are from jobs logged-in under a PPN N List only the DDBs that are from jobs not logged-in under a PPN O Complement the listing of swapped out DDBs (privileged command) P List only the DDBs that are from jobs running a program S Change the sleep time between updates T Complement the listing of the title line W Complement the listing of the command buffer~ LIST ;;Turn the listing on > SUBTTL Definitions -- Macros -- .ASPAG ; Small macro to assign page numbers: DEFINE .ASPAG ($PAG,$CNT<1>),< ;; [266] '$PAG'PAG==LSTPAG ;; Assign the next page number [266] $PAG=LSTPAG_^D9 ;; Assign the address [266] LSTPAG==LSTPAG+$CNT ;; Bump to the next page [266] '$PAG'PAG=='$PAG'PAG ;; Display the page in listing [266] > SUBTTL Program Initalization RELOC 400000 ;Put the code in the high segment [274] DDBDPY: JFCL ;Ignore CCL entry MOVX T1,%CNDVN ;Get the monitor %%%[266] GETTAB T1, ; version number JRST E$$DRM ;No - before 503 ANDX T1,777B11 ;Remove the costumer version number and %%%[266] CAME T1,[B11];Skip if the right monitor [266,274] JRST E$$DRM ;Jump if an illegal monitor version number MOVX T1,%VMUPM ;Get the exec virtual address [266] GETTAB T1, ; of the current job's UPT [266] JRST E$$DRM ;Can't get it? Die [266] MOVEM T1,UPT ;Store as the UPT word address [266] LSH T1,-^D9 ;Convert it to a page number [266] HRRM T1,UPTBLK+1 ;Store for our subsequent PAGE. UUOs [266] HRRM T1,DELUPT+1 ; that map and unmap UPT pages [266] MOVX T1,%VMLST ;Get the offset to the GETTAB T1, ; swappable DDBs in UPMP JRST E$$DRM ;Can't get it? Die %%%[266] ADD T1,UPT ;Relocate it MOVEM T1,LSTLOC ;Save for later SETZB F,PAGNUM ;Reset all the flags and current page number IFN FTDEBUG,< SKIPE .JBDDT## ;Skip if DDT isn't loaded TXO F,F.DDT ;Set the DDT is loaded flag > MOVX T1,SLPDEF ;Get the default sleep time between scans HRRM T1,HIBTIM ;Save for later RESCAN 1 ;Skip if there isn't a RESCAN'able command TXO F,F.RES ;Set the rescan flag MOVX T1,%CNSIZ ;Get the size of GETTAB T1, ; the monitor JRST E$$NPS ;No - go inform the user MOVEM T1,MEMSIZ ;Store for later LSH T1,-^D9 ;Get the number of monitor pages MOVE T2,[.PAGSP,,T3] ;Get the function for the PAGE. UUO MOVX T3,^O1 ;Get the argument count MOVX T4,HI_<-^D9> ;Get the argumnent for the function DDBD0A: PAGE. T2,UU.PHY ;Put a monitor map into my address space JRST E$$NPS ;No - go inform the user ADD T4,[^O1,,^O1] ;On to the next page SOJG T1,DDBD0A ;Loop until all the pages have been allocated DDBDP0: RESET ;Reset the world HRRZ P5,HI+GTBSLF ;Get the address of the start of the ; GETTAB tables MOVEI T2,HI(P5) ;Save the address of HRRM T2,GETSLF ; the GETTAB tables ; Find out where funny space lives: HRRZ T4,HI+.GTVM(P5) ;Point to the virtual memory data [266] MOVE T1,HI+%VMLNM_-^D18(T4) ;Get the UPT offset for the [276] ADD T1,UPT ; logical names table [276] MOVEM T1,.USLNM ;Store for later [276] MOVE T1,HI+%VMPPB_-^D18(T4) ;Get the first funny page number [266] LSH T1,-^D9 ;Convert to a page number [266] MOVEM T1,FUNFST ;Store as the first funny page number [266] MOVE T2,HI+%VMPPE_-^D18(T4) ;Get the end of funny space [266] LSH T2,-^D9 ;Convert to a page number [266] MOVEM T2,FUNLST ;Store for later [266] CAIL T1,PFFPAG ;Make sure we don't [266] CAILE T2,HI_-^D9 ; own any of these pages [266] JRST E$$OPP ;Error - overlap funny pages [266] HRRZ T4,HI+.GTC0C(P5) ;Point to CPU0 constants table [266] MOVE T3,HI+%CCTOS_-^D18(T4) ;Get the EPT address [266] HRRZ T3,HI+SECMAP(T3) ;Get the section 0 map pointer [266] LSH T3,^D9 ;Convert page number to address [266] ADDI T3,HI(T1) ;Point to the funny space pointers [266] HLRZ T3,(T3) ;Get the funny page offset into UPT [266] ANDI T3,^O777 ;Mask off accessibility bits [266] HRRZM T3,FUNPAG ;Save it for later [266] HRRZ T2,HI+.GTLVD(P5);Get the address of level-D table MOVEI T1,HI+%LDSPB_-^D18(T2) ;Get the address of the MOVEM T1,GETSPB ; pointer to the PPBs MOVEI T1,HI+%LDSTR_-^D18(T2) ;Get the address of the MOVEM T1,GETSTR ; pointer to the STRs HRRZ T1,@T1 ;Get the STRSYS offset [266] IORM T1,STRSYS ;Store it in the magic pointer [266] HRRZ T1,HI+%LDDVU_-^D18(T2) ;Get the offset into the DDB for [266] IORM T1,DEVUNI ; the unit data block (UDB) [266] HRRZ T1,HI+%LDNMB_-^D18(T2) ;Get the offset into the DDB for [266] IORM T1,DEVSFD ; the father SFD's NMB pointrer [266] HRRZ T1,HI+%LDBLK_-^D18(T2) ;Get the offset into the DDB for [266] IORM T1,DEVBLK ; the next logical block number [266] HRRZ T1,HI+%LDRSU_-^D18(T2) ;Get the offset into the DDB for [266] IORM T1,DEVACC ; the Access table (ACC) [266] HRRZ T1,HI+%LDSPN_-^D18(T2) ;Get the offset into the DDB for [266] IORM T1,DEVSPN ; the spooled file name [266] HRRZ P2,HI+.GTCNF(P5) ;Get the max MOVE T1,HI+%CNSJN_-^D18(P2) ; number of HRRI T1,-1(T1) ; jobs on the HRRZM T1,JOBMAX ; system HRRZ T1,HI+%CNDJB_-^D18(P2) ;Get the offset into the DDB for [266] IORM T1,JOBPTR ; the job number [266] IFG .PDCTC,IORM T1,CTXPTR ; and the context number [301] HRRZ T1,HI+%CNLDB_-^D18(P2) ;Get the offset into the DDB for [266] IORM T1,DDBLDB ; the LDB associated with this DDB [266] HRRZ T1,HI+%CNDCH_-^D18(P2) ;Get the offset into the LDB for [266] IORM T1,LDBDCH ; the line characteristics word [266] MOVE T1,HI+.GTC0V(P5) ;Get the pointer MOVEI T1,HI+10(T1) ; to HIGHJB MOVEM T1,HIJOB ;Save for later MOVEI T1,HI+%CNDTM_-^D18(P2) ;Get the address HRRZM T1,GETDAT ; of the date MOVE T1,HI+%CNPTY_-^D18(P2) ;Get the PTYs on the system HLRZM T1,PTYMIN ;Save the minimum PTY number MOVEI T1,^D60 ;Get default time for a jiffy MOVE T2,HI+%CNSTS_-^D18(P2) ;Get the states word TXNE T2,ST%CYC ;Skip if a 60 cycle clock MOVEI T1,^D50 ;Set up for a 50 cycle clock MOVEM T1,JIFFIE ;Save the time of a jiffy for later IMULI T1,^D60 ;Get jiffies per minutes MOVEM T1,JIFMIN ;Save for later IMULI T1,^D60 ;Get jiffies per hour MOVEM T1,JIFHOR ;Save for later HRRZ T1,HI+%CNPDB_-^D18(P2) ;Get the address MOVEI T1,HI(T1) ; of the PDB HRRM T1,GETPDB ; table HRRZ T1,HI+%CNSFD_-^D18(P2) ;Get the address [272] MOVEI T1,HI(T1) ; of the JBTSFD [272] HRRM T1,GETSFD ; table [272] LDB T1,[POINTR HI+.GTEDN(P5),SL.MAX] ;Make ADDI T1,1 ; a MOVEM T1,MAXEDN ; pointer MOVNS T1 ; to HRLZS T1 ; the HRR T1,HI+.GTEDN(P5) ; ERSATZ TXZ T1,^O777000 ; on ADDI T1,EDN ; the MOVEM T1,GETEDN ; system HRRZ T1,HI+.GTEDN(P5);The LSH T1,-^D9 ; monitor HRLM T1,EDNBLK+^O1 ; pages ADDI T1,^D1 ; to HRLM T1,EDNBLK+^O2 ; allocate MOVE T1,[.PAGSP,,DELEDN] ;Delete the old PAGE. T1, ; ERSATZ page JFCL ;Assume the first time here MOVE T1,[.PAGSP,,EDNBLK] ;Map in the new PAGE. T1, ; ERSATZ page JRST E$$NPS ;No - Go inform the user MOVE T2,[-GETSIZ,,GETTBL] ;Set the GETTAB pointers DDBDP1: LDB T1,[POINT 9,(T2),8] ;Get the table to look at HRRZ T1,@GETSLF ;Get the address of the table MOVEI T1,HI(T1) ;Set up for SPYing HRRM T1,(T2) ;Save for later use AOBJN T2,DDBDP1 ;Loop back back if not finished MOVEI T1,DDBDP0 ;Set up to have IMRs MOVEM T1,.JBAPR## ; restart the program MOVX T1,AP.ILM ;Set up to trap APRENB T1, ; ILL MEM REFs IFN FTDEBUG,< TXNE F,F.DDT ;Skip if DDT isn't loaded JRST DDBDP2 ;Skip setting up the Control-C intercept > MOVEI T1,INTBLK ;Set up to intercept MOVEM T1,.JBINT## ; Control-Cs (^C) SETZM INTBLK+2 ;Reset the intercept block DDBDP2: MOVE T1,CMDWAT ;Set up the default input MOVEM T1,INCHR ; routine (INCHWL C) MOVE P,[-PDLSIZ,,PDL];Set up the push down list TXOE F,F.INI ;Skip if the program was just started JRST DDBDP7 PJOB P5, ;Get my job number MOVEM P5,CURJOB ;Save my job number for later MOVE T1,@GETPRV ;Get the user's privileges IFN FTPRIV,< TXNN T1,JP.DPY ;Skip if the user is privleged JRST E$$NPR ;Not enough privileges > TXNE T1,JP.SPA!JP.SPM;Skip if the user has SPY privileges TXO F,F.GOD ;Set the God bit TXNE T1,JP.POK ;Skip if the user has POKE privileges [275] TXO F,F.GOD!F.POK ;Yes, we're allowed to JOBPEK [275] MOVE T1,@GETPPN ;Get my PPN MOVEM T1,MYPPN ;Save for later CAMN T1,[1,,2] ;Skip if not 1,2 JRST DDBDP3 ;Go set the God bit IFE FTPROJ,< IFN FTPROG,< HRRZM T1,IDIR ;Assume [*,PRG] HLLOS IDIRMSK >> IFN FTPROJ,< IFE FTPROG,< HLLZM T1,IDIR ;Assume [PRJ,*] HRROS IDIRMSK > IFN FTPROG,< MOVEM T1,IDIR ;Assume [PRJ,PRG] SETOM T1,IDIRMSK >> MOVE T1,[IROUTI,,ROUTIN] ;Set up the initial BLT T1,BLTEND ; scan conditions TXOA F,F.WLD ;Set the wild flag DDBDP3: TXO F,F.GOD!F.POK ;Set the God bit [275] IFN FTSLEEP,< MOVX T1,SLPSCN ;Set the default MOVEM T1,SLPCNT ; sleep counter > SKIPN T4,@GETTTY ;Get the address of my terminal's DDB JRST E$$TTF ;Error - no DDB ADD T4,DDBLDB ;Get the address of [266] MOVE T4,HI(T4) ; the terminal's LDB [266] JUMPE T4,E$$TTF ;Jump if the address is zero PUSHJ P,GETLDB ;Set SPY-page for LDB MOVE T3,@LDBDCH ;Get the device characteristic bits [266] TXNN T3,LDRPTY ;Skip if a PTY JRST DDBDP4 ;Skip some PTY code MOVX T1,JB.LBT ;Get the batch bit SKIPN HI+LDBMIC(T4) ;Skip if a MIC Cojob TDNE T1,@GETLIM ;Skip if not a batch job JRST E$$CRS ;Can't run DDBDPY MOVX T1,SLPPTY ;Sleep time HRRM T1,HIBTIM ; on a PTY IFN FTSLEEP,< SETZM SLPCNT ;Don't reset the sleep counter > DDBDP4: DPB T3,[POINT 9,TRM+1,35] ;Store the ten terminal number MOVSI T3,-TRMSIZ ;Set a AOBJN counter DDBDP6: MOVE T2,TRMTAB(T3) ;Get the TRMOP. to preform HLRZM T2,TRM+2 ;Save the new status HRRZM T2,TRM ;Save the read function MOVE T1,[2,,TRM] ;Read the bit in TRMOP. T1, ; question JRST E$$TTF ;No - go inform the user MOVEM T1,TRMSAV(T3) ;Save for later MOVEI T2,.TOSET(T2) ;Change the function into a set MOVEM T2,TRM ;Save for later MOVE T1,[3,,TRM] ;Set the function TRMOP. T1, ; in question JRST E$$TTF ;No - go inform the user AOBJN T3,DDBDP6 ;Jump if not finished PUSHJ P,TRMDSP ;Set up the default display type PUSHJ P,PAGADJ ;Set up the screen size info PUSHJ P,CMDOUT ;Go setup the command string buffer DDBDP7: IFN FTDEBUG,< TXNE F,F.DDT ;Skip if DDT wasn't loaded JRST DDBDP8 ;Skip the init code > INIT TTY,IO.SUP!.IOASC ;Init the TTY with echo off SIXBIT ~TTY~ OCT 0 JRST E$$CIT ;No - inform the user!! DDBDP8: TXZN F,F.RES ;Skip if in rescan mode JRST DDBMAN ;Go start the DDB scanning PUSHJ P,WLDSIX ;Go get the command that started me JRST DDBD12 ;Error in rescan of name HRROI T2,['DDBDPY'] ;Get the pointer the the DDBDPY command PUSHJ P,TSTABR ;Go test for an abbreviation JRST DDBD12 ;Not the right command JRST DDBD11 DDBD10: XCT INCHR ;Get the next character DDBD11: CAIE C," " ;Skip if the character is a space CAIN C,.CHTAB ;Skip if the character isn't a tab JRST DDBD10 ;Go get the next character CAIE C,"!" ;Skip if a comment line CAIN C,";" ;Skip if not a comment line JRST DDBD12 ;Go through the rest of the line away JRST CMDTST ;Go test the command DDBD12: PUSHJ P,CLRLIN ;Clear to the end of the line SUBTTL The DDB Scanning Loop DDBMAN: MOVE P,[-PDLSIZ,,PDL];Set up the push down list [263] TXZE F,F.CLR ;Skip if the screen shouldn't be cleared PUSHJ P,TRMCLR ;Go clear the screen SETZB LC,DDBCNT ;Zero some counters SETZB P2,JOB ;Clear the initial job number DDBLOP: PUSHJ P,NXTDDB ;Get the next DDB in the chain JRST DDBEND ;Finished with the chain MOVX T1,DV.DSK ;Get the device is a disk bit TDNN T1,DEVMOD(P2) ;Skip if the DDB is for a disk JRST [SKIPGE DEVSPL(P2) ;Skip if the device isn't spooled JRST DDBLO0 ;Go list the DDB JRST DDBLOP] ;Go try the next DDB DDBLO0: MOVX T1,IOSUPR ;Get the super-mode I/O flag TDNE T1,DEVIOS(P2) ;Skip if not super-mode I/O JRST [TXO F,F.SUP ;Remember that it is super-mode JRST DDBL0A] ;Go output the DDB if wanted TXZ F,F.SUP ;Clear the super-mode flag HRRZ P3,@DEVACC ;Get the pointer to ACCTAB [266] JUMPE P3,DDBLOP ;Jump if zero SKIPE HI+ACCDOR(P3) ;Skip if the file isn't dormant JRST DDBLOP ;Go try the next DDB HRRZ P5,HI+ACCPPB(P3);Get the PPB pointer JUMPE P5,DDBLOP ;No PPB - try next DDB then DDBL0A: TXNE F,F.WLD ;Skip if wild processor isn't wanted JRST @ROUTIN ;Go excute the wild processor DDBLO1: MOVE T1,DDBCNT ;Get the DDB counter CAML T1,PAGFST ;Skip if the DDB is to soon CAML T1,PAGLST ;Skip if the DDB is in time JRST DDBL13 ;Go count the DDB PUSHJ P,BEGLIN ;Set up the line MOVEI T4,^D2 ;Set up output the job number LDB T1,JOBPTR ;Get the job number of this DDB PUSHJ P,DECJST ;Output the job number LDB T1,STSPTR ;Get the file status TXNE F,F.SUP ;Skip if not super I/O MOVEI T1,3 ;A fake mode for super I/O MOVE T1,STSTAB(T1) ;Get the mode and PUSHJ P,SIXOUT ; output it LDB T5,JOBPTR ;Get the job number again SKIPN T5,@GETPP ;Skip if the PPN for this ; job is non-zero JRST DDBLOP MOVEI T4,^D6 ;Set up to output the PPN PUSHJ P,PPNJST ;Go output the PPN MOVEI T1,^D17 ;Justify to PUSHJ P,JUST ; column 17 TXNE F,F.SUP ;Skip if not super-mode I/O JRST [PUSHJ P,GETUNI ;Get the pointer to the UDB [266] JRST DDBLOP ;No such UDB [266] MOVE T1,UNINAM(T1) ;Output the PUSHJ P,SIXOUT ; unit name MOVEI T4,^D29 ;Output the logical MOVE T1,@DEVBLK ; block to be read [266] PUSHJ P,DECJST ; or written MOVEI T1,^D63 ;Justify to PUSHJ P,JUST ; column 63 JRST DDBL6A] PUSHJ P,FNDSTR ;Go find the structure name JRST DDBLOP ;Go abort the output PUSHJ P,SIXOUT ;Go output the structure name MOVEI T1,^D22 ;Justify to PUSHJ P,JUST ; column 22 SKIPN T1,DEVFIL(P2) ;Skip if the file name is non-zero JRST DDBLOP HLRZ T5,DEVEXT(P2) ;Get the extension CAIN T5,'UFD' ;Skip if it isn't a UFD JRST [PUSHJ P,LBROUT ;Output an open bracket MOVE T5,T1 ;Get the ppn in the right place PUSHJ P,PPNOUT ;Go output the PPN MOVE T1,['].UFD '] ;Output PUSHJ P,SIXOUT ; '].UFD' JRST DDBLO5] ;Skip outputting the UFD SKIPGE DEVSPL(P2) ;Skip if not a spooled file SKIPN T2,@DEVSPN ;Skip if a non-zero entered spooled name [266] JRST DDBLO2 ;Go output the file name MOVE T1,T2 ;Output the entered PUSHJ P,SIXOUT ; spooled name MOVEI T1,^D28 ;Justify to PUSHJ P,JUST ; column 28 MOVEI C,"*" ;Output a PUSHJ P,CHROUT ; asterisk JRST DDBLO3 ;Go output the spooled device DDBLO2: PUSHJ P,SIXOUT ;Output the file name JUMPE T5,DDBLO4 ;Jump if the extension is zero MOVEI T1,^D29 ;Justify to PUSHJ P,JUST ; column 29 DDBLO3: MOVSI T1,(T5) ;Get the extension again PUSHJ P,SIXOUT ;Output the extension DDBLO4: MOVEI T1,^D32 ;Justify to PUSHJ P,JUST ; column 32 JUMPL F,[PUSHJ P,GETUNI ;Get the link to the UDB [266] JRST DDBLOP ;Jump if no UDB [266] MOVE T1,UNINAM(T1) ;Get the unit name LSH T1,-^D6 ;Shift in a space PUSHJ P,SIXOUT ;Output the unit name MOVEI T4,^D7 MOVE T1,@DEVBLK ;Output the logical block [266] PUSHJ P,DECJST ; to be read or written MOVEI T4,^D6 ;Set up output the JRST DDBLO6] ; relative block MOVEI T4,^D6 MOVE T5,HI+PPBNAM(P5);The PPN of the file PUSHJ P,PPNJST ;Go output the PPN DDBLO5: MOVEI T1,^D45 ;Justify to PUSHJ P,JUST ; column 45 MOVEI T4,^D5 DDBLO6: MOVE T1,DEVREL(P2) ;Get the next (relative) block PUSHJ P,DECJST ; to be read or written MOVEI T4,^D6 MOVE T1,HI+ACCWRT(P3);Get the number of blocks written PUSHJ P,DECJST ;Output it MOVEI T4,^D6 MOVE T1,HI+ACCALC(P3);Get the number of blocks allocated PUSHJ P,DECJST ;Output it PUSHJ P,SPAOUT ;Output a space DDBL6A: LDB T1,[POINT 3,DEVPRI(P2),29] ;The disk priority JUMPE T1,DDBLO7 ;Jump if zero TRZE T1,4 ;Skip if negative MOVEI C,"-" PUSHJ P,CHROUT ;Output a minus sign or a space PUSHJ P,DECOUT ;Output the disk priority PUSHJ P,SPAOUT ;Output a space DDBLO7: TXNE F,F.SUP ;Skip if not super I/O JRST DDBL7A ;Skip some non-super I/O stuff MOVEI C,"S" SKIPGE DEVSPL(P2) ;Skip if the file isn't a spoolled file PUSHJ P,CHROUT ;Output a "S" HRRZ T1,HI+ACCSTS(P3);Get the file status MOVEI C,"D" TRNE T1,ACPDEL ;Skip if the file isn't marked for deletion PUSHJ P,CHROUT ;Output a 'D' MOVEI C,"R" TRNE T1,ACPREN ;Skip if the file isn't being renamed PUSHJ P,CHROUT ;Output a 'R' MOVEI C,"M" TRNE T1,ACPSMU ;Skip if not simultaneous update, multi-user PUSHJ P,CHROUT ;Output a 'M' MOVEI C,"P" MOVX T1,DEPPAL ;Get the pre-allocation bit TDNE T1,DEVPAL(P2) ;Skip if not pre-allocated PUSHJ P,CHROUT ;Output a 'P' DDBL7A: HLRZ T1,DEVIOS(P2) ;Get the I/O status TRNN T1,IOSIOW ;Skip if in I/O wait JRST DDBLO8 ;Jump not in an I/O wait MOVEI C,"I" ;Assume input wait TRNE T1,IOSIO ;Skip if input wait MOVEI C,"O" ;Output wait PUSHJ P,CHROUT ;Output the wait state DDBLO8: PUSHJ P,ENDLIN ;Go finish off the line AOJ LC, ;Increment the line count JUMPGE F,DDBL13 ;Jump if the extended status isn't wanted PUSHJ P,BEGLIN ;Set up the line IFG .PDCTC,< ;If this monitor has multiple contexts [301] MOVEI T4,^D3 ;Get the number of digits to output [301] LDB T1,CTXPTR ;Get the context number [301] PUSHJ P,DECJST ;Output it (offset from job number) [301] > TXNE F,F.SUP ;Skip if not super I/O JRST DDBL12 ;Skip some non-super I/O stuff IFLE .PDCTC,MOVEI T4,^D10 IFG .PDCTC,MOVEI T4,^D7 ;Account for context number if output [301] MOVE T5,HI+PPBNAM(P5);Get the PPN to be output PUSHJ P,PPNJST ;Output the PPN HRRZ P4,@DEVSFD ;See if the file is in an SFD [266] JUMPE P4,DDBL12 ;Skip if the file is in an SFD PUSH P,[0] ;Set a flag DDBLO9: PUSH P,HI+NMBNAM(P4) ;Save the SFD name DDBL10: HLRZ P4,HI+NMBPPB(P4);Get the pointer to the next NMB TRZN P4,NMPUPT ;Skip if the contains the SFD name JUMPN P4,DDBL10 ;Go save the SFD name JUMPN P4,DDBLO9 ;Go get the next NMB pointer DDBL11: POP P,T1 ;Get the SFD name back JUMPE T1,DDBL12 ;Jump if the flag was found PUSHJ P,COMOUT ;Output a comma PUSHJ P,SIXOUT ;Output the SFD name JRST DDBL11 ;Go get the next SFD level DDBL12: MOVEI T1,^D33 ;Output the MOVE T2,DEVLOG(P2) ; logical PUSHJ P,SIXJST ; name TXNE F,F.SUP ;Skip if not super I/O JRST DDB12A ;Skip the protection code MOVEI T1,^D40 ;Output the LDB T2,[POINT 9,HI+ACCPRV(P3),8] ; protection PUSHJ P,PRVOUT ; code DDB12A: LDB T2,[POINTR DEVIOS(P2),IO.MOD] ;Output the MOVE T2,MODTAB(T2) ; I/O mode MOVEI T1,^D47 ; of the PUSHJ P,SIXJST ; DDB HRRZ T1,DEVIOS(P2) ;Get the I/O status TXNN T1,IO.IMP!IO.DER!IO.DTE!IO.BKT!IO.EOF!IO.ACT JRST DDB12B ;Skip some code MOVEI C,":" ;Output a PUSHJ P,CHROUT ; colon MOVEI C,"I" TXNE T1,IO.IMP ;Skip if not improper mode PUSHJ P,CHROUT ;Output a 'I' MOVEI C,"X" TXNE T1,IO.DER ;Skip if not device error PUSHJ P,CHROUT ;Output a 'X' MOVEI C,"D" TXNE T1,IO.DTE ;Skip if not data error PUSHJ P,CHROUT ;Output a 'D' MOVEI C,"B" TXNE T1,IO.BKT ;Skip if not block to large PUSHJ P,CHROUT ;Output a 'B' MOVEI C,"E" TXNE T1,IO.EOF ;Skip if not end-of-file PUSHJ P,CHROUT ;Output a 'E' MOVEI C,"A" TXNE T1,IO.ACT ;Skip if not I/O active PUSHJ P,CHROUT ;Output a 'A' MOVEI C,"H" TXNE T1,IO.WHD ;Skip if not write headers PUSHJ P,CHROUT ;Output a 'H' DDB12B: PUSHJ P,ENDLIN ;Go finish off the line AOJ LC, ;Increment the line count DDBL13: AOS DDBCNT ;Increment DDB count JRST DDBLOP ;Go try the next DDB SUBTTL Make the Header Line and Output the Buffer DDBEND: MOVX T1,CL.AD3 ;Get the ADM-3 class [273] CAIN T1,(P1) ;Skip if not a LSI ADM-3 [273] OUTSTR [BYTE (7).CHCRT,.CHLFD,0] MOVEM LC,CURCNT ;Save the line count TXNE F,F.TTL ;Skip if the title flag is set JRST DDBEN7 ;Go output the DDB buffer SETZ LC, ;Set up the for PUSHJ P,TTLLIN ; the title line TXNN F,F.JOB ;Skip if the job display is wanted JRST DDBEN0 ;Skip the job display stuff PUSHJ P,JOBOUT ;Get set up the job buffer JRST DDBEN4 ;Go terminate the line off right DDBEN0: MOVE T1,DDBCNT ;Output the number PUSHJ P,DECOUT ; of DDBs PUSHJ P,SPAOUT ;Output a space MOVE T1,PAGNUM ;Get the current page number AOJ T1, PUSHJ P,DECOUT ;Output the current page number PUSHJ P,SLHOUT ;Output a slash SKIPE T1,DDBCNT ;Skip if the DDB count is zero SOJ T1, ;Make it one less ADD T1,PAGSIZ IDIV T1,PAGSIZ ;Get the number of pages of DDBs PUSHJ P,DECOUT ;Output the number of pages HLRZ P4,@GETSTR ;Get the pointer to the structure chain JUMPE P4,DDBEN4 ;Jump if the end of the chain was reached DDBEN1: PUSHJ P,MAPSTR ;Map the STR [266] JRST DDBEN4 ;Can't? Pretend end of chain [266] DDBE1A: SKIPN STRNAM(P4) ;Skip if a non-null structure name [266] JRST DDBEN3 ;Go try the next structure MOVE T1,STRMNT(P4) ;Get the mount count for this structure [271] PUSHJ P,SCALE ;Find out how many digits here [271] MOVEI T4,1(T2) ;Save the number needed for mount count [271] MOVE T1,STRNAM(P4) ;Get the structure name [271] MOVE T2,STRTAL(P4) ;Get the free space on this structure [271] PUSHJ P,STROUE ;Output the structure and space [271] JRST DDBEN2 ;Doesn't fit, go try a new line [271] IFN FTMOUNT,< PUSHJ P,CLNOUT ;Output a colon SKIPLE STRJOB(P4) ;Skip if the structure is mounted single [266] JRST [MOVEI C,"S" ;Output an 'S' for PUSHJ P,CHROUT ; single access JRST DDBEN3] ;Keep on truck'n MOVE T1,STRMNT(P4) ;Get the mount count for this structure [266] PUSHJ P,DECOUT ;Output the mount count > JRST DDBEN3 ;Go get the next STR [271] DDBEN2: PUSHJ P,ENDLIN ;Terminate the current line AOJ LC, ;Increment the line count CAIL LC,TTLLNS ;Too many title lines? [266,267] JRST DDBEN5 ;Yes, do no more [266] PUSHJ P,TTLLIN ;Set up a title line JRST DDBE1A ;And try to output it again [271] DDBEN3: HLRZ P4,@STRSYS ;Get pointer to the next structure [266] JUMPN P4,DDBEN1 ;Go display this structure DDBEN4: PUSHJ P,ENDLIN ;Finish off the line AOJ LC, ;Increment the line count CAILE LC,^D2 ;Skip if two or less title lines JRST DDBEN5 ;Skip some crude code PUSHJ P,TTLLIN ;Set up another title line MOVEI T1,STLBUF ;Assume not outputting the path TXNE F,F.XTN ;Skip extended status isn't wanted MOVEI T1,PTHBUF ;Get the extended status buffer PUSHJ P,ASCOUT ;Output text to the buffer PUSHJ P,ENDLIN ;Finish off the line right AOJ LC, ;Increment the line count DDBEN5: MOVEI T5,TTLBUF ;The pointer to the title line DDBEN6: TXNN P1,TM%EOL ;Skip if this terminal can clear to eol [273] PUSHJ P,TRMEOL ;Clear to the end of the line OUTSTR (T5) ;Output a title line TXNE P1,TM%EOL ;Can we really clear to end of line? [273] PUSHJ P,TRMEOL ;Yes, do it now [273] OUTSTR [BYTE (7).CHCRT,.CHLFD,0] ;Finish off the line [273] MOVEI T5,LINSIZ(T5) ;Get the pointer to the next line SOJG LC,DDBEN6 ;Loop until finished DDBEN7: MOVEI T5,LINBUF ;Set up the line buffer SKIPG LC,CURCNT ;Skip if no lines to output JRST DDBEN9 ;Skip some code DDBEN8: TXNN P1,TM%EOL ;Skip if this terminal can clear to eol [273] PUSHJ P,TRMEOL ;Go clear to the end of the line OUTSTR (T5) ;Go output a line TXNE P1,TM%EOL ;Can we really clear to end of line? [273] PUSHJ P,TRMEOL ;Yes, do it now [273] OUTSTR [BYTE (7).CHCRT,.CHLFD,0] ;Finish off the line [273] MOVEI T5,LINSIZ(T5) ;Point to the next line SOJG LC,DDBEN8 ;Jump if more lines to output DDBEN9: PUSHJ P,TRMEOS ;Go clear to the end of the screen IFN FTSLEEP,< SOSE SLPCNT ;Skip if time to adjust the sleep time JRST DDBE10 ;Skip some code MOVX T1,SLPADJ ;Adjust the sleep HRRM T1,HIBTIM ; time interval PUSHJ P,CMDOUT ;Set up command string buffer DDBE10: > TXNN F,F.HLP!F.WHT ;Skip if the help or command buffer is needed JRST DDBE11 ;Go home the terminal MOVEI T1,WHTBUF ;Get the address of the command line TXNE F,F.HLP ;Skip if help isn't needed MOVEI T1,[ASCIZ ~ ** Type "H" for help **~] OUTSTR (T1) ;Output the line CAXN P1,%TTYTP ;Skip if not an hard copy display OUTSTR [BYTE (7).CHCRT,.CHLFD,0] DDBE11: PUSHJ P,TRMHOM ;Go home the terminal SUBTTL Command Scanner -- Read the Command Character TXNN F,F.CYC ;Cycling through all the DDBs? [300] JRST CMDFRZ ;Nope, go see if anything input [300] SKIPE T1,DDBCNT ;Calculate the number of [300] SUBI T1,^D1 ; displayable DDB pages [300] IDIV T1,PAGSIZ ; found on the last scan [300] AOS T2,PAGNUM ;Look at the next page [300] CAMLE T2,T1 ;Looking beyond the last page? [300] SETZM PAGNUM ;Yep, then start over [300] PUSHJ P,PAGADJ ;Find the DDBs to be output [300] CMDFRZ: TXZE F,F.ESC ;Skip if the screen shouldn't be frozen [300] JRST CMDWAT ;Go wait for a new command SKPINL ;Skip if a command was typed JRST CMDFIN ;No - go hibernate CMDWAT: INCHWL C ;Get a char from the TTY CMDTST: CAIL C,"a" ;Skip if less than a lower case A CAILE C,"z" ;Skip if less than a lower case Z JRST CMDTS0 ;Jump if not lower case character MOVEI C,"A"-"a"(C) ;Convert to upper case CMDTS0: TXZ F,F.HLP ;Clear the command error flag MOVSI T2,-CMDSIZ ;Set up a AOBJN counter CMDTS1: MOVS T1,CMD(T2) ;Get a char to test CAIE C,(T1) ;Skip if the char match AOBJN T2,CMDTS1 ;Jump if not finished JUMPGE T2,CMDERR ;Jump if a match wasn't found HLRZS T1 ;Get the flags and where to go too TRZN T1,EC ;Skip if eol should follow the command JRST (T1) ;No - go to the right routine PUSHJ P,TSTEOL ;Go test for an EOL JRST CMDERR ;Not EOL - go give an error message JRST (T1) ;Found an EOL go to the routine ;Here if a command error was detected CMDERR: CAIE C,.CHCNC ;Skip if a Control-C was input CAIN C,.CHCNZ ;Skip if a Control-Z wasn't input JRST CMDABT ;Go abort the job CLRBFI ;Clear the input buffer TXO F,F.HLP ;Set the help flag JRST DDBMAN ;Go do a rescan SUBTTL Command Scanner -- The Command Dispatch Table EC==400000 ;Command should be followed by an EOL char CMD: .CHTAB,,CMDWAT ;Go get the next command .CHCRT,,DDBMAN+EC ;Do a rescan now (carriage-return) .CHESC,,CMDESC ;Freeze the screen (altmode) " ",,CMDWAT ;Go get the next command "+",,CMDNXT+EC ;Output next page "-",,CMDLST+EC ;Output previous page "A",,CMDALL+EC ;Go do the normal job sequence "C",,CMDCYC+EC ;Complement the DDB display cycling [300] "D",,CMDDSP ;Set up a new output display "E",,CMDXTN+EC ;Complement the extended status "F",,CMDFIL ;Set up to test for a file specification "G",,CMDGOD ;Complement the God bit "H",,CMDHLP+EC ;Set to print a help message "J",,CMDJOB ;Set up to test for a job "K",,CMDKIL+EC ;Kill the display and the job "L",,CMDLOG ;Set up to test for a logged in job "N",,CMDNOT ;Set up to test for a not logged in job "O",,CMDSWP+EC ;Complement the swapped enable [275,277] "P",,CMDPRG ;Set up to test for a program "S",,CMDSLP ;Go get the sleep time "T",,CMDTTL+EC ;Complement the output of the title "W",,CMDWHT+EC ;Complement the command buffer bit CMDSIZ==.-CMD SUBTTL Command Scanner -- The Command Processors ;Here on a "-" command - Decrement the display by one page CMDLST: SOSGE PAGNUM ;Decrement the page pointer ;Here on a "+" command - Advance the display by one page CMDNXT: AOS PAGNUM ;Increment the page pointer PUSHJ P,PAGADJ ;Set up the page boundary JRST CMDNOW ;Do a rescan now ;Here on a "G" command - Complement the God bit CMDGOD: PUSHJ P,WLDSIX ;Go get the password JRST CMDERR ;Error while getting the password PUSHJ P,TSTEO0 ;Go test for an EOL character JRST CMDERR ;Error, not an EOL character CAXE T1,PASWRD ;Skip if the right password was input JRST CMDERR ;Go give a command error TXCN F,F.GOD ;Complement the God bit [275] TXO F,F.POK ;Allow JOBPEKs if we're enabling [275] JRST CMDNOW ;Go do a rescan ;Here on a Control-C or Control-Z command - Abort the program CMDABT: TXO F,F.DCT ;Don't clear the terminal input buffer CLRBFO ;Clear the output buffer PUSHJ P,TRMCLR ;Go clear the screen CMDAB0: SETZM INTBLK+.EROPC ;Allow more Control-Cs PUSHJ P,RSTTRM ;Go restore the trminal characteristics CMDAB1: TXZN F,F.DCT ;Skip if buffer isn't to be cleared CLRBFI ;Clear the input buffer IFN FTDEBUG,< TXNN F,F.DDT ;Skip if ddt is loaded > RELEASE TTY, ;Release the TTY SETZM .JBINT## ;Disable Control-C intercept MONRT. ;Return to monitor mode JRST DDBDPY ;Restart the program on a continue ;Here on a "W" command - Complment the 'what' bit CMDWHT: TXC F,F.WHT ;Complement the command buffer bit JRST CMDNOW ;Do a rescan now ;Here on a "N" command - Change the logged in PPN not to display CMDNOT: TXNE F,F.GOD ;Skip if not God PUSHJ P,SCAN ;Go get the PPN JRST CMDERR ;An error inform the user TXNE F,F.PPN ;Skip if a PPN wasn't input JRST CMDNO0 ;Skip some code MOVE T1,MYPPN ;Get my PPN MOVEM T1,XDIR ;Save for SETOM XDIRMSK ; 'TSTNOT' CMDNO0: MOVEI T1,TSTNOT ;Set up to get the not logged in PPN MOVEM T1,XROUTIN ;Save for later JRST CMDFI0 ;Go set everything right ;Here on a "L" command - Change the logged in PPN to display CMDLOG: SKIPA T1,[TSTLOG] ;Set up to get the logged in PPN ;Here on a "F" command - Change the file specification to display CMDFIL: MOVEI T1,TSTFIL ;Set up to test a file specification MOVEM T1,XROUTIN ;Save for later PUSHJ P,SCAN ;To scan the file specification JRST CMDERR ;Error in specification CMDFI0: MOVE T1,[XROUTI,,ROUTIN] ;Set to store the specification BLT T1,BLTEND ; in the right place TXZ F,F.JOB ;Zero the job display flag CMDFI1: TXO F,F.WLD ;Set the wild flag CMDFI2: SETZM PAGNUM ;Start on page one PUSHJ P,PAGADJ ;Set up the page boundary CMDFI3: PUSHJ P,CMDOUT ;Go build the command string buffer JRST CMDNOW ;Go do a rescan ;Here on a "P" command - Change the program to test for CMDPRG: MOVEI T1,TSTPRG ;Set up to test a program MOVEM T1,XROUTIN ;Save for later PUSHJ P,SCAN ;Go get the program to test JRST CMDERR ;Error in specification TXNE F,F.PPN ;Skip if a PPN wasn't input JRST CMDPR0 ; SETZM XDIR ;Reset the directory SETZM XDIRMSK ;Reset the directory mask CMDPR0: MOVE T1,IDIR ;Save the MOVEM T1,IPPN ; user's MOVE T1,IDIRMSK ; default PPN MOVEM T1,IPPNMSK ; specification JRST CMDFI0 ;Go set everything right ;Here on a "J" command - Change the job number to display CMDJOB: PUSHJ P,DECIN ;Go get a decimal number JRST CMDERR ;Jump if no EOL seen CAIG T1,^D0 ;Skip if not job zero MOVE T1,CURJOB ;Convert job zero into my job number CAMLE T1,JOBMAX ;Skip if the job number is .LT. JOBMAX JRST CMDERR ;Jump if job number is out of range MOVEM T1,JOBNUM ;Save the job number for later MOVE T1,IDIR ;Get the default MOVEM T1,DIR ; directory MOVE T1,IDIRMSK ;Get the default MOVEM T1,DIRMSK ; directory mask MOVEI T1,TSTJOB ;Set up to test for a job MOVEM T1,ROUTIN ;Save for laver TXO F,F.JOB!F.PAS ;Set some job display flags SETZM JOBTTL ;Start with the job's search list [271] JRST CMDFI1 ;Clear the page counter and do a rescan ;Here on an "A" command - Display all DDBs CMDALL: TXNN F,F.GOD ;Skip if God JRST CMDERR ;Go inform user not a valid command TXZ F,F.WLD!F.JOB ;Clear the wild and job display flags JRST CMDFI2 ;Clear the page counter and do a rescan ;Here on a "H" command - Display a help text CMDHLP: PUSHJ P,TRMCLR ;Go clear the screen OUTSTR HLPBUF ;Output the help message PUSHJ P,TRMHOM ;Go home the terminal TXO F,F.CLR ;Clear the screen before next scan JRST CMDWAT ;Go wait for a command ;Here on a "C" command - Complement the cycling of displayable DDBs [300] CMDCYC: TXC F,F.CYC ;Try the other for awhile (I guess) [300] JRST CMDFI2 ;Go start a page 1 [300] ;Here on a "K" command - Kill the display and the job CMDKIL: PUSHJ P,CLRLIN ;Clear to the end of the command line PUSHJ P,TRMCLR ;Clear the terminal PUSHJ P,RSTTRM ;Go restore the terminal characteristics MOVX T1,%CNSIZ ;Get the size of GETTAB T1, ; the monitor JRST E$$NPS ;No - go inform the user LSH T1,-^D9 ;Get the number of monitor pages MOVE T2,[.PAGSP,,T3] ;Get the function for the PAGE. UUO MOVX T3,^O1 ;Get the argument count MOVE T4,[PA.GAF+HI_<-^D9>] ;Unmap the specified page KILL1: PAGE. T2,UU.PHY ;Put a monitor map into my address space JRST E$$NPS ;No - go inform the user ADD T4,[^O1,,^O1] ;On to the next page SOJG T1,KILL1 ;Loop to delete all SPY pages MOVEI T1,PFFPAG-FSTPAG ;Get the number of preassigned pages to delete MOVE T4,[PA.GAF+FSTPAG] ;Get the first preassgined page number KILL2: PAGE. T2, ;Delete a page JFCL ;Don't worry if it wasn't mapped SOJG T1,KILL2 ;Loop to delete all preassigned pages MOVE T1,FUNLST ;Get the first unused exec funny page MOVE T4,FUNFST ;Get the first funny page number SUB T1,T4 ;Compute the number of pages to delete TXO T4,PA.GAF ;Say we're deleting pages KILL3: PAGE. T2, ;Delete a page JFCL ;Don't worry if not there SOJG T1,KILL3 ;Loop for all funny pages MOVEI T1,LGOBLK ;Point to args RUN T1,UU.PHY ;Run SYS:LOGOUT HALT . ;Cannot fail ;Here on a "S" command - Change the sleep time between displays CMDSLP: PUSHJ P,DECIN ;Go get a decimal number JRST CMDERR ;No End-Of-Line, go inform user CAILE T1,^D60 ;Skip if less than 61 seconds JRST CMDERR ;Error if the time is greater than 60 IMULI T1,^D1000 ;Convert to milliseconds CAIN T1,^D0 ;Skip if the sleep time isn't zero MOVEI T1,^D250 ;Set the sleep time to 250 milliseconds HRRM T1,HIBTIM ;Save for later IFN FTSLEEP,< TXNN F,F.GOD ;Skip if God CAXL T1,SLPMIN ;Skip if less the minimum sleep time TDZA T1,T1 ;Don't adjust the sleep time MOVX T1,SLPSCN ;Set the sleep MOVEM T1,SLPCNT ; time counter > JRST CMDFI3 ;Go update the screen now ;Here on a "ESCAPE" command - Freeze the screen CMDESC: TXO F,F.ESC ;Pause after updating the screen JRST DDBMAN ;Go update the screen now ;Here on a "D" command - Change the type of display CMDDSP: PUSHJ P,WLDSIX ;Go get the new display type JRST CMDERR ;Error while seaching for a display type PUSHJ P,TSTEO0 ;Test for an EOL character JRST CMDERR ;Error, not an EOL character SKIPA ;Skip into the following code [273] CMDDS0: MOVE T1,TRMNAM ;Get the terminal's type [273] PUSHJ P,SETDSP ;Go set up the screen size JRST CMDFI2 ;Go clear the page number and do a rescan ;Here on a "E" command - Change the display of the extended status CMDXTN: TXC F,F.XTN ;Complement the entire path bit JRST CMDDS0 ;Go set up the screen size ;Here on a "T" command - Change the display of the title line CMDTTL: TXC F,F.TTL ;Complement the title bit JRST CMDDS0 ;Go set up the screen size ;Here on an "O" command - Change the display of swapped out DDBs CMDSWP: TXNN F,F.POK ;Are we allowed to do this? [275] JRST CMDERR ;No, go complain [275] TXC F,F.PEK ;Yes, complement the bit [275] JRST CMDFI2 ;Go do a rescan [275] ;Here to sleep for awhile CMDFIN: MOVE T1,HIBTIM HIBER T1, ;Hibernate awhile JFCL ;No - punt it INCHSL C ;Skip if input made me wake up JRST DDBMAN ;No - go do a rescan JRST CMDTST ;Go test this new command ;Here to see if the screen should be updated now CMDNOW: CAIE C," " ;Skip if the character is an space CAIN C,.CHTAB ;Skip if the character is a tab JRST CMDWAT ;Go wait for a new command CAIN C,.CHESC ;Skip if the character isn't an escape JRST CMDWAT ;Go wait for a new command JRST DDBMAN ;Go update the screen now!!! SUBTTL Input Routines -- SCAN - Input a File Specification ;SCAN - Input a file specification ;Call: PUSHJ P,SCAN ; * Non-skip return - An error was detected while scanning * ; * Skip return - XNOD block contains the file-spec. * ;Uses: F, T1-5 and C SCAN: MOVE T1,[INOD,,XNOD] ;Set up the initial conditions BLT T1,XBLTEND ; for scan - ALL:*.*[MYPPN] TXZ F,F.NOD!F.DEV!F.FIL!F.EXT!F.PPN ;Clear some flags SCAN0: PUSHJ P,WLDSIX ;Go read a SIXBIT word POPJ P, ;Error in the SIXBIT routine CAIE C,"[" ;Skip if an open bracket CAIN C,"<" ;Skip if not an open carrot JRST SCNDIR ;Go process it CAIN C,"_" ;Skip if not a backarrow (underscore) JRST SCNNOD ;Go process it CAIN C,":" ;Skip if not a colon JRST SCNDEV ;Go process it SCAN1: CAIN C,"." ;Skip if not an period JRST SCNFIL ;Go process it SCAN2: PUSHJ P,TSTEO0 ;Go see if an EOL was found POPJ P, ;No EOL - error return SCNEXT: TXNE F,F.FIL ;Skip if no file-name seen JRST SCNEX0 JUMPE T1,SCNEX1 ;Jump if default name is wanted TXO F,F.FIL ;Set the file seen flag MOVEM T1,XFIL ;Save for later MOVEM T2,XFILMSK ;Save for later JRST SCNEX1 ;Go test for ERSATZ device SCNEX0: TXO F,F.EXT ;Set the extension seen flag HLR T1,T2 ;Get the extension mask MOVEM T1,XEXT ;Save for later CAME T1,['UFD',,-1] ;Skip if the extension is 'UFD' JRST SCNEX1 ;Go test for ERSATZ device MOVE T1,[1,,1] ;Move the EXCH T1,XDIR ; directory MOVEM T1,XFIL ; to the file SETO T1, ; name and [1,1] EXCH T1,XDIRMSK ; to the MOVEM T1,XFILMSK ; directory SCNEX1: TXNE F,F.DEV ;Skip if device wasn't input TXNE F,F.PPN ;Skip if directory wasn't input PJRST .POPJ1 ;Give a good return SETCM T1,XDEVMSK ;Get the device mask JUMPN T1,.POPJ1 ;Skip if any wild-cards input HLRZ T1,XDEV ;Get the possible ERSATZ device MOVE T3,GETEDN ;Get a pointer to ERSATZ devices SCNEX2: HLRZ T2,(T3) ;Get a real ERSATZ device CAME T1,T2 ;Skip if equal AOBJN T3,SCNEX2 ;Loop until all have been tried JUMPGE T3,.POPJ1 ;Return if no match was found ADD T3,MAXEDN ;Get the pointer HRRZ T3,(T3) ; to the PPN SKIPG T1,HI(T3) ;Skip a real ERSATZ device PJRST .POPJ1 ;** No way to get the LIB PPN ** REPEAT 0,< JRST [JUMPE T1,.POPJ1 ;Return to caller MOVE P5,CURJOB ;Get my job number HLRZ T1,@GETSFD ;Get LIB info TXZ T1,JBPSYS!JBPXSY;Clear some bits JUMPE T1,.POPJ ;Jump if no LIB MOVE T1,HI+PPBNAM(T1);Get the LIB PPN JRST SCNEX3] ;See if valid for this user > SCNEX3: TXNE F,F.GOD ;Skip if not Godly JRST SCNEX4 ;Jump if no need to test the PPN MOVE T2,T1 ;Get a copy of the PPN XOR T2,XDIR ;Compare the PPNs TDNE T2,XDIRMSK ;Skip if good enough POPJ P, ;Give an error return SCNEX4: MOVEM T1,XDIR ;Save the PPN SETOM T1,XDIRMSK ;Reset the mask HRRZ T1,XDEV ;Get the structure name SKIPN T1 ;Skip if null TLOA T1,'ALL' ;Set the device name to 'ALL' TLOA T1,'DSK' ;Set the device name to 'dskx' SETZM XDEVMSK ;Reset the device mask MOVEM T1,XDEV ;Save the device name TXO F,F.PPN ;Inform the caller a PPN was input PJRST .POPJ1 ;Give a good return SCNNOD: TXON F,F.NOD ;Skip if the node flag is set TXNE F,F.DEV!F.FIL!F.PPN ;Skip if none are set POPJ P, ;Error return JUMPE T1,.POPJ ;Null node is illegal - error return MOVEM T1,XNOD ;Save for later MOVEM T2,XNODMSK ; .. JRST SCAN0 ;Go look for more SCNDEV: TXON F,F.DEV ;Skip if the device flag is set TXNE F,F.FIL!F.PPN ;Skip if none are set POPJ P, ;Error return JUMPE T1,.POPJ ;Null device is illegal - error return CAMN T1,IDEV ;Skip if the device isn't 'ALL' JRST SCAN0 ;Go look for more MOVEM T1,XDEV ;Save for later MOVEM T2,XDEVMSK ; .. JRST SCAN0 ;Go look for more SCNFIL: TXOE F,F.FIL ;Skip if I haven't been here before POPJ P, ;Error return JUMPE T1,SCAN0 ;Jump if the default name is wanted MOVEM T1,XFIL ;Save for later MOVEM T2,XFILMSK ; .. JRST SCAN0 ;Go look for more SCNDIR: TXOE F,F.PPN ;Skip if I haven't been here before POPJ P, ;Error return PUSHJ P,WLDOCT ;Go get the project number then CAIE C,"," ;Skip if a comma POPJ P, ;Error return CAMN T3,[-1,,0] ;Skip if the project number isn't zero HLRO T3,MYPPN ;Use my project number then IFN FTPROJ,< TXNE F,F.GOD ;Skip if not a privileged user JRST SCNDI0 HLRO T4,MYPPN ;Get the uesr's project number CAME T3,T4 ;Skip if the input project and the ; user's project number don't match POPJ P, ;Error return > SCNDI0: HRLZM T3,XDIR ;Save for later HLLZM T3,XDIRMSK ; .. PUSHJ P,WLDOCT ;Go get the programmer number then CAMN T3,[-1,,0] ;Skip if the programmer number isn't zero HRRO T3,MYPPN ;Use my programmer number then IFN FTPROG,< TXNE F,F.GOD ;Skip if not a privileged user JRST SCNDI1 HRRO T4,MYPPN ;Get the uesr's programmer number CAME T3,T4 ;Skip if the input programmer and the ; user's programmer number don't match POPJ P, ;Error return > SCNDI1: HRRM T3,XDIR ;Save for later HLRM T3,XDIRMSK ; .. REPEAT 0,< ; **** Save T1-T2 **** PUSH P,P1 ;Save P1 MOVSI P1,- ;Set up a counter SCNDI2: CAIE C,"," ;Skip if the character is a comma JRST SCNDI4 ;Go test for EOL AOBJP P1,SCNDI3 ;Jump if too many SFD PUSHJ P,WLDSIX ;Go read the SFD name JRST SCNDI3 ;Error in SFD name JUMPE T1,SCNDI3 ;Null SFD is an illegal MOVEM T1,XDIR+1(P1) ;Save the SFD name MOVEM T2,XDIRMSK+1(P1);Save the SFD mask JRST SCNDI2 ;Loop back for more SCNDI3: POP P,P1 ;Restore P1 POPJ P, ;Error RETURN SCNDI4: POP P,P1 ;Restore P1 > CAIE C,"]" ;Skip if the break character was a "]" CAIN C,">" ;Skip if the break character wasn't a ">" JRST [XCT INCHR ;Get the next character then JRST SCAN1] ;Go test for a "." JRST SCAN2 ;Go test for an EOL SUBTTL Input Routines -- OCTIN/DECIN - Input a Number ;OCTIN - Input an octal number ;DECIN - Input a decimal number ;Call: PUSHJ P,OCTIN/DECIN ; * Return - The result is in T1 * ;Uses: T1-3 and C OCTIN: SKIPA T3,[^D8] ;Set up of octal input DECIN: MOVEI T3,^D10 ;Set up of decimal input RDXIN: SETZ T1, ;Clear the input buffer RDXIN0: XCT INCHR ;Get a character CAIL C,"0" ;Skip if less than an ASCII zero CAIL C,"0"(T3) ;Skip if less than the radix of input PJRST TSTEO0 ;Go test for EOL IMULI T1,(T3) ;Muliply by the radix ADDI T1,-"0"(C) ;Add in the new digit JRST RDXIN0 ;Go get another char SUBTTL Input Routines -- WLDOCT - Input a Wild Octal Number ;WLDOCT - Input a wild octal number ;Call: PUSHJ P,WLDOCT ; * Return - The result is in T3; RH = mask, LH = number * ;Uses: T3-4 and C WLDOCT: MOVSI T3,-1 ;Set up the default number MOVEI T4,^D7 ;Set up a character counter WLDOC0: SOJL T4,.POPJ ;Return if more than six digits input XCT INCHR ;Get a character CAIL C,"0" ;Skip if less than a "0" CAILE C,"7" ;Skip if less than an "8" JRST WLDOC1 LSH T3,3 ;Multiply by 8 TLO T3,7 ;Put a 7 in the mask ORI T3,-"0"(C) ;Add in the last number JRST WLDOC0 ;Go get another number WLDOC1: CAIN C,"*" ;Skip if not an astrisk JRST WLDOC2 CAIE C,"?" ;Skip if a question mark POPJ P, ;Return LSH T3,3 ;Multiply by 8 JRST WLDOC0 ;Loop for more digits WLDOC2: CAME T3,[-1,,0] ;Skip if the default number POPJ P, ;Error return SETZ T3, ;Set the '*' flag XCT INCHR ;Get the next character POPJ P, ;Return SUBTTL Input Routines -- WLDSIX - Input Wild SIXBIT ;WLDSIX - Input a wild SIXBIT word ;Call: PUSHJ P,WLDSIX ;Get wild SIXBIT word and mask ; * Non-skip return - Illegal sintax on input * ; * Skip return - Wild SIXBIT input in T1 and mask in T2 * ;Uses: T1-5 and C WLDSIX: TXZ F,F.AST ;Reset the astrisk flag SETZ T1, ;Reset the SIXBIT word SETO T2, ;Reset the mask word MOVE T3,[POINT 6,T1] ;Set up a byte pointer WLDSI0: XCT INCHR ;Get a character from the user CAIL C,"a" ;Skip if less than a lower case A CAILE C,"z" ;Skip if less than a lower case Z JRST WLDSI3 ;Go store the character MOVEI C,"A"-"a"(C) ;Convert lower case to upper case WLDSI1: TXNE F,F.AST ;Skip if an astrisk has been input POPJ P, ;Error WLDSI2: MOVEI C,' '-" "(C) ;Convert ASCII to SIXBIT TXNE T3,77B5 ;Skip if the SIXBIT word is full IDPB C,T3 ;Store the character JRST WLDSI0 ;Go get the next character WLDSI3: CAIG C,"Z" ;Skip if greater than a "Z" CAIGE C,"0" ;Skip if greater than a "0" JRST WLDSI4 ;Go test for an "*" or "?" CAIGE C,"A" ;Skip if greater than a "A" CAIG C,"9" ;Skip if greater than a "9" JRST WLDSI1 ;Go store the character WLDSI4: CAIN C,"*" ;Skip if not an astrisk JRST WLDAST ;Go process the astrisk CAIE C,"?" ;Skip if a question mark PJRST .POPJ1 ;Give a good return WLDQST: TXNE F,F.AST ;Skip if the astrisk flag isn't set POPJ P, ;Error return MOVX T4,77B5 ;Set up the question mark mask JRST WLDAS0 ;To store the character and mask WLDAST: TXOE F,F.AST ;Skip it astrisk flag isn't set and set it POPJ P, ;Error return SETO T4, ;Set the mask flag WLDAS0: LDB T5,[POINT 6,T3,5] ;Get the location of the byte LSH T4,-^D36(T5) ;Position the mask XOR T2,T4 ;Store the mask JRST WLDSI2 ;To store the character SUBTTL Input Routines -- CLRLIN - Clear to End of Line ;CLRLIN - Clear to the end of a command line ;Call: PUSHJ P,CLRLIN ; * Return * ;Uses: T5 and C CLRLIN: MOVSI T5,- ;Get the number of end of line characters CLRLI0: CAMN C,EOL(T5) ;Skip if not this character POPJ P, ;Return AOBJN T5,CLRLI0 ;Loop until all have been tried XCT INCHR ;Get the next character JRST CLRLIN ;Go try this character SUBTTL Input Routines -- TSTEOL - Test of End-of-Line Character ;TSTEOL - Test for an EOL character ;Call: MOVE C, ; PUSHJ P,TSTEOL ; * Non-skip return - Not an EOL character * ; * Skip return - An EOL character * ;Uses: T5 and C TSTEOL: XCT INCHR ;Get a character TSTEO0: CAIN C,.CHCRT ;Skip if the char isn't a carriage return XCT INCHR ;Get another character then MOVSI T5,-EOLSIZ ;Set up an AOBJN counter TSTEO1: CAMN C,EOL(T5) ;Skip if it equals this char JRST .POPJ1 ;Give an E-O-L return AOBJN T5,TSTEO1 ;Jump if more char to test POPJ P, ;Return ;The EOL character set EOL: .CHBEL ;A bell .CHLFD ;A line-feed .CHVTB ;A vertical-tab .CHFFD ;A form-feed .CHCNZ ;A Control-Z .CHESC ;An escape .CHTAB ;A tab " " ;A space EOLSIZ==.-EOL SUBTTL Output Routines -- PPNOUT/PPNJST - Output a PPN ;PPNOUT - Output a PPN without justification ;PPNJST - Output a PPN with (right) justification ;Call: MOVE T4, ; MOVE T5, ; PUSHJ P,PPNOUT/PPNJST ; * Return * ;Uses: T1-5, BP, C and CC PPNOUT: SETZ T4, ;Clear the justify counter PPNJST: HLRZ T1,T5 ;Set to output the proj number PUSHJ P,OCTJST ;Output the proj number PUSHJ P,COMOUT ;Output a comma MOVEI T1,(T5) ;Set up to output the prog number ; PFALL OCTOUT ;Fall into OCTOUT SUBTTL Output Routines -- OCTOUT/DECOUT/OCTJST/DECJST ;OCTOUT - Output an octal number without justification ;DECOUT - Output a decimal number without justification ;OCTJST - Output an octal number with (right) justification ;DECJST - Output a decimal number with (right) justification ;Call: MOVE T4, ; MOVE T1, ; PUSHJ P,OCTOUT/DECOUT/OCTJST/DECJST ; * Return * ;Uses: T1-4, BP, C and CC OCTOUT: TDZA T4,T4 DECOUT: TDZA T4,T4 OCTJST: SKIPA T3,[^D8] ;Set up for octal output DECJST: MOVEI T3,^D10 ;Set up for decimal output RDXJST: JUMPGE T1,RDXJS0 ;Jump if the number of positive MOVNS T1 ;Make the number positive SOJ T4, ;Decrement column counter TXOA F,F.NEG ;Set the negative flag and skip RDXJS0: TXZ F,F.NEG ;Clear the negative flag RDXJS1: SOJ T4, ;Decrement column counter IDIVI T1,(T3) ;Get a digit MOVEI C,"0"(T2) ;Convert binary to ASCII HRLM C,(P) ;Save for later JUMPE T1,RDXJS3 ;Jump if no more digits to output PUSHJ P,RDXJS1 ;Go get another digit RDXJS2: HLRZ C,(P) ;Get a digit PJRST CHROUT ;Go output the digit RDXJS3: TXNE F,F.NEG ;Skip if not negative PUSH P,["-",,RDXJS2] ;Set up to output a "-" JUMPLE T4,RDXJS2 ;Jump if no spaces to output MOVEI C," " RDXJS4: PUSHJ P,CHROUT ;Output a space SOJG T4,RDXJS4 ;Jump if more spaces to output JRST RDXJS2 ;Go output some digits SUBTTL Output Routines -- CHROUT - Output a Character ;CHROUT - Output a Character ;Call: MOVE C, ; PUSHJ P,CHROUT ; * Return * ;Uses: BP and CC CHROUT: AOJ CC, ;Increment the column counter CAMGE CC,LINWID ;Don't output if done too many [276] IDPB C,BP ;Save the char POPJ P, ;Return SUBTTL Output Routines -- PRVOUT - Output a Protection ;PRVOUT - Output a protection code ;Call: MOVE T4, ; MOVE T2, ; PUSHJ P,PRVOUT ; * Return * ;Uses: T1-4, BP, C and CC PRVOUT: PUSHJ P,JUST ;Justify everything first MOVEI T3,^D3 ;Set up a counter MOVE T1,['> <000'] ;Get the protection mask PRVOU0: ROTC T1,-^D3 ;Get a digit ROT T1,-^D3 ;Convert to sixbit SOJG T3,PRVOU0 ;Loop until finished ROT T1,-^D6 ;Allow room for the open carrot PJRST SIXOUT ;Output the protection code SUBTTL Output Routines -- JUST - Justify the Output ;JUST - Justify the output ;Call: MOVE T1, ; PUSHJ P,JUST ; * Return * ;Uses: T1, BP, C and CC JUST: SUBI T1,(CC) ;Get the number of spaces needed JUMPLE T1,.POPJ ;Jump if none to output MOVEI C," " JUST0: PUSHJ P,CHROUT ;Output a space SOJG T1,JUST0 ;Loop if more spaces to output POPJ P, ;Return SUBTTL Output Routines -- ASCOUT - Output an ASCIZ String ;ASCOUT - Output an ASCIZ String ;Call: MOVEI T1, ; PUSHJ P,ASCOUT ; * Return * ;Uses: T1, BP, C and CC ASCOUT: TLOA T1,(POINT 7) ;Set up the byte pointer ASCOU0: PUSHJ P,CHROUT ;Output the char ILDB C,T1 ;Get the next char JUMPN C,ASCOU0 ;Go output the char if non-null POPJ P, ;Return SUBTTL Output Routines -- SIXOUT - Output a SIXBIT Word ;SIXOUT - Output a SIXBIT word ;Call: MOVE T1, ; PUSHJ P,SIXOUT ; * Return * ;Uses: T1-2, BP, C and CC SIXOUT: JUMPE T1,.POPJ ;Jump if nothing to output SIXOU0: SETZ T2, ;Clear a shift register ROTC T1,6 ;Get the char into T2 MOVEI C," "-' '(T2) ;Convert from SIXBIT to ASCII PUSHJ P,CHROUT ;Output the char JUMPN T1,SIXOU0 ;Loop for more characters POPJ P, ;Return SUBTTL Output Routines -- TTLLIN - Set Up for the Title Line ;TTLLIN - Set up to output the title line ;Call: MOVEI LC, ; PUSHJ P,TTLLIN ; * Return * ;Uses: BP and CC TTLLIN: MOVEI BP,(LC) ;Make a byte IMULI BP,LINSIZ ; pointer to the ADD BP,[POINT 7,TTLBUF] ; current line SETZ CC, ;Reset the column count POPJ P, ;Return SUBTTL Output Routines -- BEGLIN - Set up for a Display Line ;BEGLIN - Set up to output a display line ;Call: PUSHJ P,GETLIN ; * Return * ;Uses: BP and CC BEGLIN: MOVEI BP,(LC) ;Make a byte IMULI BP,LINSIZ ; pointer to the ADD BP,[POINT 7,LINBUF] ; current line SETZ CC, ;Reset the column count POPJ P, ;RETURN SUBTTL Output Routines -- ENDLIN - Finish off a Display Line ;ENDLIN - Finish off a display line ;Call: PUSHJ P,ENDLIN ; * Return * ;Uses: T1, BP, C and CC ENDLIN: MOVX T1,%HZ1HP ;Assume a Hazeltine terminal [273] MOVX T2,CL.HZL ;Get the class for a Hazeltine terminal [273] CAIN T2,(P1) ;Is it a Hazeltine terminal? [273] PUSHJ P,JUST ;Clear thru column 68 SETZ C, ;Get a null [273] PJRST CHROUT ;Go put a null char in the line buffer SUBTTL Output Routines -- COMOUT - Output a Comma ;COMOUT - Output a comma ;Call: PUSHJ P,COMOUT ; * Return * ;Uses: BP, C and CC COMOUT: MOVEI C,"," ;Get a comma to output PJRST CHROUT ;Output it and return SUBTTL Output Routines -- CLNOUT - Output a Colon ;CLNOUT - Output a colon ;Call: PUSHJ P,CLNOUT ; * Return * ;Uses: BP, C and CC CLNOUT: MOVEI C,":" ;Get a colon to output PJRST CHROUT ;Output it and return SUBTTL Output Routines -- LBROUT, RBROUT - Output a Bracket ;LBROUT - Output a left bracket ("[") ;RBROUT - Output a right bracket ("]") ;Call: PUSHJ P,LBROUT ; * Return * ;Uses: BP, C and CC LBROUT: SKIPA C,["["] ;Get a left bracket [276] RBROUT: MOVEI C,"]" ;Get a right bracket [276] PJRST CHROUT ;Output it and return [276] SUBTTL Output Routines -- SLHOUT - Output a Slash ;SLHOUT - Output a slash ;Call: PUSHJ P,SLHOUT ; * Return * ;Uses: BP, C and CC SLHOUT: MOVEI C,"/" ;Get a slash to output PJRST CHROUT ;Output it and return SUBTTL Output Routines -- SPAOUT - Output a Space ;SPAOUT - Output a space ;Call: PUSHJ P,SPAOUT ; * Return * ;Uses: BP, C and CC SPAOUT: MOVEI C," " ;Get a space to output PJRST CHROUT ;Output it and return SUBTTL Output Routines - STROUT - Output a Structure Name and Free Count ;STROUT - Output a structure name and free count ;Call: MOVE T1, ; MOVE T2, ; PUSHJ P,STROUT ; * Non-skip return - structure won't fit on this line ; * Skip return - output successfully ;Call: MOVE T1, ; MOVE T2, ; MOVE T4, ; PUSHJ P,STROUE ; * Non-skip return - couldn't fit on the line ; * Skip return - structure output ;Uses: BP, C and CC STROUE: PUSH P,T1 ;Save all [271] PUSH P,T2 ; the appropriate [271] PUSH P,T3 ; registers [271] PUSH P,T4 ; ... [271] ADDI T4,2(CC) ;Compute the amount of overhead chars [271] JRST STRO01 ;Jon the common code below [271] STROUT: PUSH P,T1 ;Save the [271] PUSH P,T2 ; two arguments [271] PUSH P,T3 ;And a couple [271] PUSH P,T4 ; of other registers [271] MOVEI T4,2(CC) ;Account for the ":" and leading space [271] STRO01: ADDI T4,1 ;Count this character (assumes at least one) [271] LSH T1,^D6 ;Shift to next character [271] JUMPN T1,STRO01 ;Loop if more chars in the name [271] MOVE T1,T2 ;Get the free count [271] PUSHJ P,SCALE ;Get the number of digits needed [271] ADD T4,T2 ;Add it into the sum [271] ; We have the length needed. See if it'll fit on this line CAML T4,LINWID ;Will it fit on this line? [271,273] JRST STRO99 ;No, just return unsuccessfully [271] AOS -4(P) ;Yes, cause a skip return [271] SKIPE CC ;Are we in column zero? [271] PUSHJ P,SPAOUT ;No, output a space [271] MOVE T1,-3(P) ;Get the structure name back [271] PUSHJ P,SIXOUT ;Output it [271] PUSHJ P,CLNOUT ;Output the separator [271] MOVE T1,-2(P) ;Get the free count back [271] PUSHJ P,DECOUT ; and output it [271] STRO99: POP P,T4 ;Restore the saved [271] POP P,T3 ; temp ACs [271] POP P,T2 ;Restore the free count [271] POP P,T1 ; and the structure name [271] POPJ P, ;Return [271] SUBTTL Output Routines -- SCALE - Scale a Decimal Number ;SCALE - Figure out how many digits in a decimal number ;Call: MOVE T1, ; PUSHJ P,SCALE ; * Returns T2 containing the number of digits to be output ;Uses T1, T2 SCALE: MOVSI T2,-STENLN ;Get the powers of ten table length [271] ; Loop here to figure out how namy digits: SCAL01: CAML T1,STEN(T2) ;Big enough power of ten yet? [271] AOBJN T2,SCAL01 ;No, try the next power of ten [271] HRRZS T2 ;Get the number of digits [271] POPJ P, ;And return [271] ; The powers of ten table: STEN: ^D0 ;(Should be 1, but even 0 needs a digit) [271] ^D10 ;10^1 [271] ^D100 ;10^2 [271] ^D1000 ;10^3 [271] ^D10000 ;10^4 [271] ^D100000 ;10^5 [271] ^D1000000 ;10^6 [271] ^D10000000 ;10^7 [271] ^D100000000 ;10^8 [271] ^D1000000000 ;10^9 [271] ^D10000000000 ;10^10 [271] STENLN==.-STEN ;Length of this table [271] SUBTTL Output Routines -- TIMOUT - Output a Time ;TIMOUT - Output a time value ;Call: MOVE T1, ; PUSHJ P,TIMOUT ; * Return * ;Uses: T1-4, BP, C and CC TIMOUT: TXZ F,F.DIG ;Clear the digit output flag IDIV T1,JIFHOR ;Get the number of hours PUSH P,T2 ;Save the minutes and seconds for later JUMPE T1,TIMOU0 ;Jump if the hours field is zero PUSHJ P,TWOOUT ;Output the hours PUSHJ P,CLNOUT ;Output a colon TIMOU0: POP P,T1 ;Restore the minutes and seconds IDIV T1,JIFMIN ;Get the minutes PUSH P,T2 ;Save the seconds for later TXNN F,F.DIG ;Skip is a digit has been output JUMPE T1,TIMOU1 ;Jump if the minutes field is zero PUSHJ P,TWOOUT ;Output the minutes PUSHJ P,CLNOUT ;Output a colon TIMOU1: POP P,T1 ;Restore the seconds IDIV T1,JIFFIE ;Get the whole seconds PUSH P,T2 ;Save the part of a second for later PUSHJ P,TWOOUT ;Output the whole seconds MOVEI C,"." ;Output PUSHJ P,CHROUT ; a "." POP P,T1 ;Restore the part of a second IMULI T1,^D100 ;Convert to IDIV T1,JIFFIE ; centi-seconds ; PFALL TWOOUT ;Fall into TWOOUT SUBTTL Output Routines -- TWOOUT - Output Atleast Two Digits ;TWOOUT - Output atleast two decimal digits ;Call: MOVE T1, ; PUSHJ P,TWOOUT ; * Return * ;Uses: F, T1-4, BP, C and CC TWOOUT: TXON F,F.DIG ;Skip if a digit has been output PJRST DECOUT ;Output the number and return MOVEI C,"0" ;Set up to output a zero CAIGE T1,^D10 ;Skip if the number is greater than 9 PUSHJ P,CHROUT ;Output a zero PJRST DECOUT ;Output the number and return SUBTTL Output Routines -- SIXJST - Output a Justified SIXBIT Word ;SIXJST - Output a justified SIXBIT Word ;Call: MOVE T4, ; MOVE T2, ; PUSHJ P,SIXJST ; * Return * ;Uses: T1-2, BP, C and CC SIXJST: PUSHJ P,JUST ;Justify to the right column MOVE T1,T2 ;Get the SIXBIT word to be output PJRST SIXOUT ;Now output it and return SUBTTL Output Routines -- JOBOUT - Output Some Job Status ;JOBOUT - Output some job status ;Call: PUSHJ P,JOBOUT ; * Return * ;Uses: F, T1-5, P2-5, BP, C and CC JOBOUT: MOVE P5,JOBNUM ;Get the job number MOVE P4,@GETSTS ;Get the job's status TXNN P4,JS.JNA ;Skip if the job number has be assigned PJRST .POPJ1 ;The job isn't in use SKIPE P2,@GETTTY ;Skip if on TTY associated with the job ADDI P2,HI ;Relocate to the high segment [266] SKIPN P3,@GETPDB ;Skip if the job has a pdb PJRST .POPJ1 ;The job isn't in use PUSH P,P5 ;The save job number for later MOVE T1,['PRG: '] ;Output PUSHJ P,SIXOUT ; 'PRG:' MOVE T1,@GETPRG ;Get the program name PUSHJ P,SIXOUT ; and output it MOVE T2,@GETPRG ;Get the low segment name again SKIPLE P5,@GETSGN ;Skip if the high segment doesn't exists SKIPN T1,@GETPRG ;Skip if a non-null high segment name JRST JOBO0A ;Ok, then skip some code CAMN T1,T2 ;Skip if they aren't the same JRST JOBO0A ;Ok, then skip some code MOVEI C,"+" ;Output PUSHJ P,CHROUT ; a "+" PUSHJ P,SIXOUT ;Output the high segment name JOBO0A: MOVE P5,(P) ;Get the segment job number back MOVEI T1,^D18 ;Justify to column MOVE T2,['COR: '] ; 18 and output PUSHJ P,SIXJST ; 'COR:' SKIPG P5,@GETSGN ;Skip if there is a high segment TDZA T1,T1 ;Clear the high segment size PUSHJ P,HGHSIZ ;Get the high segment size MOVE T5,T1 ;Save the high segment size MOVE P5,(P) ;Restore the job number PUSHJ P,LOWSIZ ;Get the low segment size SKIPG P5,@GETSGN ;Skip if a high segment JRST JOBO0B ;Skip some code MOVX T2,SS.SHR ;Get the sharable bit TDNN T2,@GETSTS ;Skip if non-sharable SUB T1,T5 ;Adjust the low segment size JOBO0B: PUSHJ P,DECOUT ;Output the low segment size JUMPLE P5,JOBOU0 ;Jump if no high segment MOVEI C,"+" ;Output PUSHJ P,CHROUT ; a "+" MOVE T1,T5 ;Get the high PUSHJ P,DECOUT ; segment size JOBOU0: JUMPGE P5,JOBOU1 ;Jump if not SPYing MOVSI T1,'+S ' ;Output '+S' to show PUSHJ P,SIXOUT ; job is SPYing JOBOU1: POP P,P5 ;Restore the job number MOVEI C,"+" ;Output [270] PUSHJ P,CHROUT ; a "+" [270] HLRZ T1,@GETPDB ;Get the number of funny pages [270] PUSHJ P,DECOUT ;Output it [270] MOVEI C,"P" ;Assume the core is in pages CAIGE CC,^D32 ;Don't output if we've typed too much [270] PUSHJ P,CHROUT ;Output the core size MOVEI T1,^D33 ;Justify to column [270] MOVE T2,['STS: '] ; 33 and output PUSHJ P,SIXJST ; 'STS:' MOVSI T1,'^W ' ;Assume command wait state TXNE P4,JS.RUN ;Skip if not in a run state MOVSI T1,'CW ' ;Assume core wait state TXNE P4,JS.CMW ;Skip if not in command wait JRST JOBOU4 ;Go output the state MOVSI T1,'OW ' ;Assume operator wait TXNE P4,JS.DCE ;Skip if not in operator wait JRST JOBOU4 ;Go output the state MOVSI T1,'^D ' ;Assume DAEMON wait state TXNE P4,JS.JDC ;Skip if not in DAEMON wait JRST JOBOU4 ;Go output the state MOVSI T1,'^C ' ;Assume the job is stopped JUMPGE P4,JOBOU4 ;Go output the state LDB T1,[POINT 5,P4,14] ;Get the state of the job IDIVI T1,^D3 ;Get the word the state is in IMULI T2,^D12 ;Get the shift value to get the state MOVE T1,@GETWSN ;Get the right state for the job LSH T1,(T2) ;Get the state if the right place ANDX T1,7777B11 ;Clear any unneeded bits CAME T1,['EW '] ;Skip if in an event wait state JRST JOBOU2 ;Skip the EW state stuff LDB T2,[POINT 5,@GETST2,24] ;Get the event wait code JUMPE T2,JOBOU4 ;Zero is unknown CAIG T2,EVWSIZ ;Skip if greater than the known one's MOVE T1,EVWTAB-1(T2) ;Get the event wait state JRST JOBOU4 ;Go output the state JOBOU2: CAME T1,['SL '] ;Skip if in a sleep state JRST JOBOU3 ;Go test the 'TI' state TXNN P4,JS.CLK ;Skip if in a clock request queue MOVSI T1,'HB ' ;Change the state to HIBERnate JRST JOBOU4 ;Go output the state JOBOU3: CAMN T1,['TI '] ;Skip if not terminal I/O wait SKIPL DEVIOS(P2) ;Skip if output wait JRST JOBOU4 ;Go output the state MOVSI T1,'TO ' ;Change the state to terminal output JOBOU4: PUSHJ P,SIXOUT ;Output the state of the job ; Note - T1 is zero on return TXNE P4,JS.LOK ;Skip if the job isn't locked in core MOVSI T1,' LS' ;Job is locked in core shuffling allowed TXNE P4,JS.NSH ;Skip if the job can be shuffled MOVSI T1,' LK' ;Job is locked in core in place JUMPN T1,JOBOU7 ;Go output the state of the job TXNN P4,JS.SWP ;Skip if the job is swapped JRST JOBOU5 ;Go see if virtual MOVSI T1,' SW' ;Assume swapped SKIPGE @GETSWP ;Skip if not fragmented MOVSI T1,' SF' ;Set the job to swapped and fragmented JOBOU5: HLRZ T2,@GETVRT ;Get the virtual flags for the job JUMPE T2,JOBOU7 ;Jump if not virtual JUMPE T1,JOBOU6 ;Jump if not swapped TLNN T1,'SW'^!'SF' ;Skip if not fragmented TLCA T1,'SF'^!'F'^!'M' ;Set the state to 'VF' TLC T1,'SW'^!'S'^!'M' ;Set the state to 'VS' JOBOU6: TLC T1,'VM' ;Set the state to 'VM' JOBOU7: PUSHJ P,SIXOUT ;Output the state of the job MOVEI T1,^D43 ;Justify to column [270] MOVE T2,['RUN: '] ; 43 and get 'RUN:' TXNE F,F.PAS ;Skip if not pass one TRO T2,' ? ' ;Change to 'RUN:?' PUSHJ P,SIXJST ;Output the SIXBIT message MOVN T1,@GETTIM ;Get the run time of the job EXCH T1,TOTTIM ;Save for the next scan SUB T1,TOTTIM ;Get the incremental run time CAIGE T1,0 ;Skip if non-negative MOVN T1,TOTTIM ;Use the total runtime (assume new job) MOVEM T1,DELTIM ;Save for later TXNN F,F.PAS ;Skip if pass one PUSHJ P,TIMOUT ;Output the incremental run time PUSHJ P,SLHOUT ;Output a slash MOVN T1,TOTTIM ;Get the total run time PUSHJ P,TIMOUT ;Output total run time MOVEI T1,^D63 ;Justify to column [270] MOVE T2,['CPU: '] ; 63 and get 'CPU:' TXNE F,F.PAS ;Skip if not pass one TRO T2,' ? ' ;Change to 'CPU:?' PUSHJ P,SIXJST ;Output the SIXBIT message MOVE T1,DELTIM ;Get the delta runtime IMULI T1,^D100 ;Set up to get a percentage MOVN T2,@GETDAT ;Get the date EXCH T2,CURDAT ;Save for the next scan SUB T2,CURDAT ;Get the delta date PUSHJ P,ADJTIM ;Convert to the right format MOVE T3,T2 ;Round the ASH T3,-^D1 ; percentage ADD T1,T3 ; of runtime IDIV T1,T2 ;Get the percentage of runtime TXNN F,F.PAS ;Skip if pass one PUSHJ P,DECOUT ;Output the percentage of runtime PUSHJ P,SLHOUT ;Output a slash MOVN T1,TOTTIM ;Get the runtime IMULI T1,^D100 ;Set up to get a percentage MOVN T2,CURDAT ;Get the length of time the SUB T2,@GETJLT ; job has been logged in PUSHJ P,ADJTIM ;Convert to the right format MOVE T3,T2 ;Round the ASH T3,-^D1 ; percentage ADD T1,T3 ; of runtime IDIV T1,T2 ;Get the percentage PUSHJ P,DECOUT ; of runtime PUSHJ P,ENDLIN ;Finish off the line right AOJ LC, ;Increment the line count PUSHJ P,TTLLIN ;Set up for the new line MOVE T1,DEVNAM(P2) ;Get the terminal name MOVE T4,@DDBLDB ;Get the link to the terminal's LDB [266] JUMPE T4,[SETO T5, ;The job is detached [260] HRLI T1,'DET' ;Say the job is detached TXNN F,F.GOD ;Skip if GOD TRZ T1,-1 ;Clear the terminal number JRST JOBO10] ;Go output the terminal name PUSHJ P,GETLDB ;Set SPY-page for LDB MOVE T5,T4 ;Save for later MOVE T2,@LDBDCH ;Get the terminal characteristic bits [266] TXNN T2,LDRPTY ;Skip if a PTY JRST JOBO10 ;No need to change anything ANDX T2,777 ;Remove some unneeded bits SUB T2,PTYMIN ;Convert from TTY range to PTY range MOVSI T1,'PTY' ;Set the terminal to be a PTY PUSH P,JOBOU9 ;Set up to make the PTY name JOBOU8: IDIVI T2,^D8 ;Get a digit HRLM T3,(P) ;Save it for later CAIN T2,0 ;Skip if not finished SKIPA T3,[POINT 6,T1,17] ;Set up a type pointer PUSHJ P,JOBOU8 ;Loop back HLRZ T2,(P) ;Restore a digit MOVEI T2,'0'(T2) ;Convert from binary to SIXBIT IDPB T2,T3 ;Store the digit in the name JOBOU9: POPJ P,JOBO10 ;Magic JOBO10: PUSHJ P,SIXOUT ;Output the terinal name MOVEI T1,^D7 ;Justify to column MOVE T2,['HPQ: '] ; 7 and output PUSHJ P,SIXJST ; 'HPQ:' LDB T1,[POINT 4,@GETRTD,9] ;Get the HPQ level PUSHJ P,DECOUT ;Output the level number MOVEI T1,^D13 ;Justify to column MOVE T2,['PRI: '] ; 13 and output PUSHJ P,SIXJST ; 'PRI:' LDB T1,[POINT 3,@GETSPL,26] ;Get the disk priority TRZE T1,4 ;Skip if a positive priority MOVNS T1 ;Negate the absolute value of the priority PUSHJ P,DECOUT ;Output the priority MOVEI T1,^D20 ;Justify to column 20 MOVE T2,['DSK:E '] ;Assume error on quota exausted TXNE P4,JS.SFL ;Skip if error on disk full condition TRC T2,'E '^!'P ' ;Change error to pause PUSHJ P,SIXJST ;Output the message MOVEI T1,^D26 ;Justify to column MOVE T2,['DDB: '] ; 26 and output PUSHJ P,SIXJST ; 'DDB:' MOVE T1,DDBCNT ;Output the PUSHJ P,DECOUT ; DDB count MOVEI T1,^D33 ;Justify to column 33 MOVE T2,['RED: '] ; and output 'RED:' TXNE F,F.PAS ;Skip if not pass one TRO T2,' ? ' ;Change to 'RED:?' PUSHJ P,SIXJST ;Output the SIXBIT message LDB T1,[POINT 24,@GETRCT,35] ;Get the number of disk reads MOVNS T1 ;Negate the number the disk reads EXCH T1,DSKRED ;Save for the next scan SUB T1,DSKRED ;Get the incremental disk reads TXNN F,F.PAS ;Skip if pass one PUSHJ P,DECOUT ;Output the incremental disk reads PUSHJ P,SLHOUT ;Output a slash MOVN T1,DSKRED ;Output the total PUSHJ P,DECOUT ; disk reads MOVEI T1,^D49 ;Justify to column 49 MOVE T2,['WRT: '] ; and get 'WRT:' TXNE F,F.PAS ;Skip if not pass one TRO T2,' ? ' ;Change to 'WRT:?' PUSHJ P,SIXJST ;Output the SIXBIT message LDB T1,[POINT 24,@GETWCT,35] ;Get the number of disk writes MOVNS T1 ;Negate the number the disk writes EXCH T1,DSKWRT ;Save for the next scan SUB T1,DSKWRT ;Get the incremental disk writes TXNN F,F.PAS ;Skip if pass one PUSHJ P,DECOUT ;Output the incremental disk writes PUSHJ P,SLHOUT ;Output a slash MOVN T1,DSKWRT ;Output the total PUSHJ P,DECOUT ; disk writes IFG .PDCTC,< ;If this monitor has alternate contexts [301] SKIPN T3,HI+.PDCTC(P3);Get the current context pointer [301] JRST JOB10B ;No context pointer? Don't write this [301] IFN .CTFLG,ADDI T3,.CTFLG ;Point to the context flags word [301] PEEK T3, ;Get the context flags [301] MOVEI T1,^D63 ;Justify to column 63 [301] MOVE T2,['CTX: '] ; and get 'CTX:' [301] PUSHJ P,SIXJST ;Output the header [301] LDB T1,[POINTR T3,CNOMSK] ;Extract the context number [301] PUSHJ P,DECOUT ;Output the context number [301] JOB10B: > ;End IFG .PDCTC [301] PUSHJ P,ENDLIN ;Finish the line off AOJ LC, ;Increment the line count PUSHJ P,TTLLIN ;Set up for the next line MOVE T1,@GETPPN ;Get the job's PPN [272] XOR T1,DIR ;Compare the PPN against [272] TDNE T1,DIRMSK ; what we're allowed to see [272] TXNE F,F.GOD ;Not normally allowed. Are we GOD? [272] SKIPA ;It's ok to do this then [272] JRST JOBO11 ;No, just output the character counts [272] JOB10A: MOVE T1,JOBTTL ;Get the job title line type [272] JRST @[JOBO13 ;Output the search list [272] JOBO11 ;Output character counts [272] JOBO20 ;Output the job's path [272] JOBO26](T1) ;Output the job's LIB: spec [276] JOBO11: JUMPL T5,JOB11A ;Jump if detached [260] MOVE T1,['ICC: '] ;Output PUSHJ P,SIXOUT ; 'ICC:' MOVE T1,HI+LDBICT(T5);Get the input character count PUSHJ P,DECOUT ;Output it MOVEI T1,^D12 ;Justify to column MOVE T2,['OCC: '] ; 12 and output PUSHJ P,SIXJST ; 'OCC:' MOVE T1,HI+LDBOCT(T5);Get the output character count PUSHJ P,DECOUT ;Output it MOVEI T1,^D24 ;Justify to column MOVE T2,['CMD: '] ; 24 and output PUSHJ P,SIXJST ; 'CMD:' HLRZ T1,HI+LDBBCT(T5);Get the command count PUSHJ P,DECOUT ;Output it JOB11A: MOVEI T1,^D33 ;Justify to column [260] MOVE T2,['UUO: '] ; 33 and output PUSHJ P,SIXJST ; 'UUO:' MOVE T1,@GETUUC ;Output the UUO PUSHJ P,DECOUT ; count MOVEI T1,^D45 ;Justify to column MOVE T2,['KCS: '] ; 45 and output PUSHJ P,SIXJST ; 'KCS:' MOVE T1,@GETKCT ;Output the IDIV T1,JIFFIE ; non-VM PUSHJ P,DECOUT ; Kill-Core-Seconds PUSHJ P,CLNOUT ;Output a colon MOVE T1,@GETVKS ;Output IDIV T1,JIFFIE ; the VM PUSHJ P,DECOUT ; Kilo-Core-Seconds JOBO12: AOS T1,JOBTTL ;Increment the title type [272] CAIL T1,4 ;Have we overflowed? [272] SETZM JOBTTL ;Yes, start back over with the search list [272] TXZ F,F.PAS ;Clear the pass one flag POPJ P, ;Return JOBO13: MOVE T1,@GETPPN ;Get the user's PPN HLRZ T4,@GETSPB ;Get the pointer to the PPB chain TRNA ;Fast skip JOBO14: HLRZ T4,HI+PPBSYS(T4);Get the pointer to the next PPB JUMPE T4,JOBO15 ;Jump if end of the chain CAME T1,HI+PPBNAM(T4);Skip if the user's PPB JRST JOBO14 ;Keep on truck'n MOVE T5,[POINT 9,HI+.PDJSL(P3)] ;Get the pointer to the search list JOBO15: ILDB T3,T5 ;Get a file structure number ANDX T3,77 ;Clear some flags CAIN T3,.FSTMP ;Skip if not a temporary structure JRST JOBO15 ;Go try the next structure CAIE T3,.FSEND ;Skip if the end of the search list CAIN T3,.FSFNC ;Skip if the end of the active search list JRST JOBO12 ;Finished CAIN T3,.FSSTP ;Skip if the end of everything JRST JOBO12 ;Finished HLRZ P4,@GETSTR JOBO16: PUSHJ P,MAPSTR ;Go map this STR [266] JRST JOBO15 ;Can't? At least we tried [266] HRRZ T2,STRFSN(P4) ;Get this file structure number CAMN T2,T3 ;Skip if not a match JRST JOBO17 ;Yea! We found it HLRZ P4,@STRSYS ;Get the pointer to the next structure JUMPN P4,JOBO16 ;Skip if not the end of the line JRST JOBO15 ;Well I tried JOBO17: HLRZ T2,HI+PPBUFB(T4);Get the pointer to the UFB chain TRNA ;Fast skip JOBO18: HLRZ T2,HI+UFBPPB(T2);Get the pointer to the next PPB JUMPE T2,JOBO19 ;Jump if the end of the chain LDB T1,[POINT 6,HI+UFBFSN(T2),5] ;Get the file structure number CAME T1,T3 ;Skip if the right structure JRST JOBO18 ;Keep on truck'n MOVE T2,HI+UFBTAL(T2);Get the login quota CAMLE T2,STRTAL(P4) ;Skip if smaller than structure free JOBO19: MOVE T2,STRTAL(P4) ;Get the free space on the structure [271] MOVE T1,STRNAM(P4) ;Get the structure name [271] PUSHJ P,STROUT ;Output the structure and free space [271] JRST JOBO12 ;It don't fit, so we're done [271] JRST JOBO15 ;Go find the next structure ;Here to output the job's path JOBO20: HRRZ P4,@GETSFD ;Get the job's path pointer [272] TRZE P4,1 ;Is /SCAN set? [272] TXO F,F.SCN ;Yes, remember that for later [272] MOVE T1,['PATH:['] ;Get a header [272] PUSHJ P,SIXOUT ;Output it [272] SKIPE P4 ;Did we get any kind of pointer? [272] TRZE P4,2 ;Is this just a UFB pointer? [272] SKIPA ;No SFDs, it's pretty easy then [272] JRST JOBO21 ;No, do it the hard way [272] SKIPE P4 ;Did we really get anything? [272] SKIPN T5,HI+PPBNAM(P4);Yes, get the PPN [272] MOVE T5,@GETPPN ;No, get from the job table [272] PUSHJ P,PPNOUT ;Output the PPN [272] JRST JOBO25 ;Continue at end of path [272] ; Here if the path is in an SFD. We have to follow the NMBs up JOBO21: PUSH P,[0] ;Put a marker on the stack [272] HLRZ T4,HI+NMBACC(P4);Get the ACC pointer [272] HRRZ T4,HI+ACCPPB(T4);Get the PPB pointer [272] MOVE T5,HI+PPBNAM(T4);Get the PPN [272] PUSHJ P,PPNOUT ;Go output it [272] ;Loop here finding superior SFDs JOBO22: PUSH P,HI+NMBNAM(P4) ;Save this SFD's name [272] JOBO23: HLRZ P4,HI+NMBPPB(P4);Get the pointer to the next NMB [272] TRZN P4,NMPUPT ;Skip if it points to the father SFD [272] JUMPN P4,JOBO23 ;Nope. Try the next [272] JUMPN P4,JOBO22 ;Yep. Save the SFD name [272] ; Unwind the SFDs: JOBO24: POP P,T1 ;Restore an SFD name [272] JUMPE T1,JOBO25 ;Exit loop if we're done [272] PUSHJ P,COMOUT ;Output a comma [272] PUSHJ P,SIXOUT ;Output the SFD name [272] JRST JOBO24 ;Loop for all SFD names [272] ;Done with the path proper. Output /SCAN/NEW/SYS, etc JOBO25: PUSHJ P,RBROUT ;Output a terminator [272] MOVE T1,['/SCAN '] ;Get the switch [272] TXZE F,F.SCN ;Was it set? [272] PUSHJ P,SIXOUT ;Yes, type it then [272] MOVE T5,@GETSFD ;Get the JBTSFD entry back [272] MOVE T1,['/SYS '] ;Get the/SYS switch [272] TLNE T5,1 ;Is it set? [272] PUSHJ P,SIXOUT ;Yes, type it then [272] MOVE T1,['/NEW '] ;Get the /NEW switch [272] TLNE T5,2 ;Is it set? [272] PUSHJ P,SIXOUT ;Yes, type it too [272] JRST JOBO12 ;Finish line and exit [272] ; Here to output the job's LIB: specification: JOBO26: MOVE T5,@GETSFD ;Get the SFD/LIB pointer word [276] TLNN T5,777774 ;Any LIB spec? [276] JRST [SETZM JOBTTL ;Nope. Reset the title line counter [276] JRST JOB10A] ;And output something else [276] MOVE T1,['LIB: '] ;Yes, get the prefix [276] PUSHJ P,SIXOUT ;Output it [276] SKIPN T5,HI+.PDOSL(P3);Any old style LIB: PPN? [276] JRST JOBO27 ;No. Gotta do it the hard way [276] JRST JOBO34 ;Output the PPN and finish up [276] ; Here if we have to output a new style LIB:. First, find the logical spec: JOBO27: PUSHJ P,MAPUPT ;Go map the UPT [276] JRST JOBO33 ;Error? Just output the PPB contents [276] SKIPN P2,@.USLNM ;Get the logical name pointer [276] JRST JOBO33 ;None? Just output the PPB again [276] TLZ P2,-1 ;Get rid of the AC index [276] PUSHJ P,MAPFUN ;Go map the funny spage for this guy [276] JRST JOBO33 ;Can't? Just output the PPB contents [276] ;Loop for each logical name def. Find one that looks like a LIB: JOBO28: PUSHJ P,FUNWRD ;Get the next pointer [276] JRST JOBO33 ;Can't? Just output the PPB contents [276] JUMPE T1,JOBO33 ;None? Just output the PPB thing [276] JUMPG T1,JOBO28 ;Ignore this if not /SEARCH [276] HRRZ P2,T1 ;Copy the /LIB: pointer [276] PUSHJ P,MAPFUN ;Go map it [276] JRST JOBO33 ;Can't? Just give up [276] ADDI P2,1 ;Skip over the name itself [276] TXOA F,F.TMP ;Don't output a comma first time out [276] JOBO29: PUSHJ P,RBROUT ;Finish the previous path [276] JOBO30: PUSHJ P,FUNWRD ;Get the device name [276] JRST JOBO36 ;Error? Sounds like the end of the def [276] JUMPE T1,JOBO36 ;End of def if no device name [276] TXZN F,F.TMP ;First time through here? [276] PUSHJ P,COMOUT ;Nope, output a separator [276] PUSHJ P,SIXOUT ;Output the device name [276] PUSHJ P,CLNOUT ;Output the separator [276] PUSHJ P,FUNWRD ;Get the filename [276] JRST JOBO36 ;Error ... [276] SKIPE T1 ;Any filename? [276] PUSHJ P,SIXOUT ;Yes, output it [276] PUSHJ P,FUNWRD ;Get the extension [276] JRST JOBO36 ;Error again ... [276] JUMPE T1,JOBO31 ;Skip this if no extension [276] MOVEI C,"." ;Get the separator [276] PUSHJ P,CHROUT ;Output it [276] PUSHJ P,SIXOUT ;Output the extension [276] ; Output the path in this section of the logical definition: JOBO31: PUSHJ P,FUNWRD ;Get the PPN [276] JRST JOBO36 ;Error ... [276] JUMPE T1,JOBO30 ;Start next piece if no path [276] MOVE T5,T1 ;Copy the PPN [276] PUSHJ P,LBROUT ;Output the beginning of the path [276] PUSHJ P,PPNOUT ;Output the PPN [276] JOBO32: PUSHJ P,FUNWRD ;Get the next SFD name [276] JRST JOBO35 ;Can't - finish the path and quit [276] JUMPE T1,JOBO29 ;No more SFDs, finish this path [276] PUSHJ P,COMOUT ;Got an SFD, output a separator [276] PUSHJ P,SIXOUT ;Then output the SFD name [276] JRST JOBO32 ;Loop for all SFDs [276] JOBO33: HLRZ T1,@GETSFD ;Get the PPB pointer [276] TRZ T1,3 ;Get rid of junk [276] MOVE T5,HI(T1) ;Get the LIB: PPN [276] JOBO34: PUSHJ P,LBROUT ;Output a left bracket [276] PUSHJ P,PPNOUT ;Output the PPN [276] JOBO35: PUSHJ P,RBROUT ;Output the end of path separator [276] JOBO36: JRST JOBO12 ;Finish line and exit [276] SUBTTL Output Routines -- CMDOUT - Output the Command String ;CMDOUT - Output the current command string ;Call: PUSHJ P,CMDOUT ; * Return * ;Uses: T1-4, BP, C and CC CMDOUT: PUSH P,C ;Save C for later MOVE BP,[POINT 7,WHTBUF] ;Set up the pointer to the buffer SETZ CC, ;Reset the buffer counter TXNN F,F.WLD ;Skip if the wild processor is in use JRST CMDOU4 ;Go inform user MOVE T1,ROUTINE ;Get the address of the wild processor CAIN T1,TSTFIL ;Skip if not the "F" command JRST CMDOU2 ;Go output the "F" command string CAIN T1,TSTJOB ;Skip if not the "J" command JRST CMDOU3 ;Go output the "J" command string CAIN T1,TSTLOG ;Skip if not the "L" command JRST CMDOU0 ;Go output the "L" command string CAIN T1,TSTPRG ;Skip if not the "P" command string JRST CMDOU1 ;Go output the "P" command string SKIPA C,["N"] ;Output an "N" CMDOU0: MOVEI C,"L" ;Output an "L" PUSHJ P,CHROUT ;Output the character PUSHJ P,WPPOUT ;Go output the PPN for the "L" command JRST CMDOU5 CMDOU1: SKIPA C,["P"] ;Output a "P" CMDOU2: MOVEI C,"F" ;Output a "F" PUSHJ P,CHROUT ;Output the character PUSHJ P,SPCOUT ;Go output the file spec JRST CMDOU5 CMDOU3: MOVEI C,"J" ;Output PUSHJ P,CHROUT ; the "J" MOVE T1,JOBNUM ;Go output the job number PUSHJ P,DECOUT ; for the "J" command JRST CMDOU5 CMDOU4: MOVEI C,"A" ;Output PUSHJ P,CHROUT ; the "A" CMDOU5: MOVSI T1,' D ' ;Output PUSHJ P,SIXOUT ; the " D" MOVE T1,TRMNAM ;Output the [273] PUSHJ P,SIXOUT ; display name MOVSI T1,' E ' ;Set up to output a "E" if in path mode TXNE F,F.XTN ;Skip if not in extended status mode PUSHJ P,SIXOUT ;Output a "E" if a extended status mode MOVSI T1,' O ' ;Set up to output an "O" if in swap mode [275] TXNE F,F.PEK ;Are we in swapped DDB mode? [275] PUSHJ P,SIXOUT ;Yes, say so [275] MOVSI T1,' S ' ;Output PUSHJ P,SIXOUT ; the " S" HRRZ T1,HIBTIM ;Get the HIBERnate time IDIVI T1,^D1000 ;Convert from milliseconds to seconds PUSHJ P,DECOUT ;Output the time MOVSI T1,' T ' ;Set up to output a "T" if in title suppression TXNE F,F.TTL ;Skip if the title is wanted PUSHJ P,SIXOUT ;Output a " T" if in title suppression mode MOVSI T1,' C ' ;Assume we're cycling through the DDBs [300] TXNE F,F.CYC ;Are we cycling through the DDBs? [300] PUSHJ P,SIXOUT ;Can't be wrong all the time [300] MOVSI T1,' W ' ;Output PUSHJ P,SIXOUT ; the " W" IDPB T1,BP ;Store a null character in the buffer POP P,C ;Restore C POPJ P, ;Return SUBTTL Output Routines -- SPCOUT - Output a File Specification ;SPCOUT - Output a file specification ;Call: PUSHJ P,SPCOUT ; * Return * ;Uses: T1-5, BP, C and CC SPCOUT: MOVE T1,DEV ;Output the PUSHJ P,SIXOUT ; device name PUSHJ P,CLNOUT ;Output a colon HLRZ T5,EXT ;Get the extension CAIN T5,'UFD' ;Skip if not 'UFD' JRST [MOVE T3,FIL ;Get the file name MOVE T4,FILMSK ; and file name mask PUSHJ P,WPPOU0 ;Output the name as a UFD JRST SPCOU0] ;Continue MOVE T1,FIL ;Output the PUSHJ P,SIXOUT ; file name SPCOU0: JUMPE T5,WPPOUT ;Jump if the extension is zero MOVEI C,"." ;Output PUSHJ P,CHROUT ; a period MOVSI T1,(T5) ;Output the PUSHJ P,SIXOUT ; extension ; PFALL WPPOUT ;Fall into WPPOUT SUBTTL Output Routines -- WPPOUT - Output a Wild PPN ;WPPOUT - Output a wild PPN ;Call: PUSHJ P,WPPOUT ; * Return * ;Uses: T1-4, BP, C and CC WPPOUT: MOVE T3,DIR ;Get the directory and MOVE T4,DIRMSK ; directory mask WPPOU0: PUSHJ P,LBROUT ;Output a "[" HLLZ T1,T4 ;Get the project mask HLR T1,T3 ;Get the project number PUSHJ P,WOCOUT ;Output the wild project number PUSHJ P,COMOUT ;Output a comma HRLZI T1,(T4) ;Get the programmer mask HRRI T1,(T3) ;Get the programmer number PUSHJ P,WOCOUT ;Output the wild programmer number PJRST RBROUT ;Output a "]" and return SUBTTL Output Routines -- WOCOUT - Output a wild octal number ;WOCOUT - Output a wild octal number ;Call: MOVSI T1, ; HRRI T1, ; PUSHJ P,WOCOUT ; * Return * ;Uses: T1-2, BP, C and CC WOCOUT: JUMPE T1,WOCOU3 ;Jump if the number is completely wild TXZ F,F.DIG ;Clear the digit seen flag MOVEI T2,^D6 ;Set up a counter WOCOU0: JUMPGE T1,WOCOU1 ;Jump if this digit is wild LDB C,[POINT 3,T1,20] ;Get a digit TXNN F,F.DIG ;Skip if a digit has been seen JUMPE C,WOCOU2 ;Jump if the digit is a zero TROA C,"0" ;Convert binary to ASCII and skip WOCOU1: MOVEI C,"?" ;Set up to output a question mark TXO F,F.DIG ;Set the digit seen flag PUSHJ P,CHROUT ;Output the digit or question mark WOCOU2: LSH T1,^D3 ;Adjust the mask SOJG T2,WOCOU0 ;Loop back if not finished POPJ P, ;Return WOCOU3: MOVEI C,"*" ;Set up to output an PJRST CHROUT ; astrisk and return SUBTTL Display Initalization -- TRMDSP - Get the Default Terminal Type ;TRMDSP - Get the default terminal type ;Call: PUSHJ P,TRMDSP ; * Return - P1 contains terminal type offset * ;Uses: T1-4, P1, P3 and C TRMDSP: MOVE T1,[2,,T2] ;Point to the TRMOP. argument block [266] MOVX T2,.TOTRM ;Get the function to read the term type [266] MOVE T3,TRM+1 ;Get the terminal number [266] TRMOP. T1, ;Get the terminal's type [266] MOVX T1,'TTY ' ;Error? Just get the default [266] ; PFALL SETDSP ;Set the other display parameters [255] SUBTTL Display Initalization -- SETDSP - Set up Display Size ;SETDSP - Set up the display size parameters ;Call: MOVE T1, ; PUSHJ P,SETDSP ; * Returns terminal class in of P1, flags in LH, PREFIX setup ;Uses: T1-T4, P1 SETDSP: MOVSI T2,-DSPSIZ ;Get an AOBJN pointer to term types [266,273] CAME T1,DSPNAM(T2) ;Proper terminal type? [266,273] AOBJN T2,.-1 ;No, try the next one [266,273] SKIPL T2 ;Find anything? [266,273] MOVX T2,%TTYTP ;No, assume TTY [266,273] MOVEM T1,TRMNAM ;Save the terminal's name [273] MOVE P1,DSPNUM(T2) ;Get the terminal's flags [273] LDB T1,[POINTR P1,TM%PFX] ;Get the prefix index [273] MOVE T1,PFXTAB(T1) ;Get the prefix [273] MOVEM T1,PREFIX ;Store [273] LDB T1,[POINTR P1,TM%WID] ;Get the terminal's width [273] MOVEM T1,LINWID ;Store for later [273] LDB T1,[POINTR P1,TM%LEN] ;Get the number of lines per page [273] MOVEM T1,TRMLIN ;Store the number of lines on the screen [273] TXNN F,F.TTL ;Do we want the title line? [273] MOVEI T1,-TTLLNS(T1) ;Yes, reserve some lines [273] SUBI T1,1 ;Account for the command echo buffer [273] TXNE F,F.XTN ;Skip it the path option isn't wanted LSH T1,-^D1 ;Divide by two MOVEM T1,PAGSIZ ;Save for later TRZ P1,^-TM%CLS ;Mask off junk [273] TXO F,F.CLR ;Set up clear the screen on the next scan POPJ P, ;Return SUBTTL Useful Routines -- HGHSIZ/LOWSIZ - Get a Segment Size ;HGHSIZ - Get the high segment size ;LOWSIZ - Get the low segment size ;Call: MOVE P4, ; MOVE P5, ; PUSHJ P,HGHSIZ/LOWSIZ ; * Return - The result is in T1 * ;Uses: F and T1 IFGE MONVER-703,< ;New core size computation [266] HGHSIZ: MOVE T1,@GETIMI ;Get the image swapped in size [266] TLZ T1,777770 ;Get rid of junk [266] JUMPN T1,.POPJ ;Return if we got something [266] HLRZ T1,@GETSWP ;Get the swapped size [266] POPJ P, ;Return only the last 9 bits [266] LOWSIZ: MOVE T1,@GETIMI ;Get the swapped in image size [266] TLZ T1,777770 ;Get rid of junk [266] SKIPN T1 ;Anything there? [266] SEGSI0: HLRZ T1,@GETSWP ;No, get it from the swap word [266] POPJ P, ;And return with the segment size [266] > IFLE MONVER-702,< ;Old core size computation [266] HGHSIZ: TXZA F,F.LOW ;Clear the low segment flag LOWSIZ: TXO F,F.LOW ;Set the low segment flag MOVE T1,@GETSWP ;Get the swapped size TXNE F,F.LOW ;Skip if the high segment JRST LOWSI3 ;Return only the last 9 bits MOVX T1,SS.SHR ;Get the sharable bit TDNE T1,@GETSTS ;Skip if the segment isn't sharable JRST LOWSI0 ;Go use the old way MOVS T1,@GETSWP ;Get the swapped size JRST LOWSI3 ;Return only the last 9 bits LOWSI0: MOVS T1,@GETADR ;Get the protection register info JUMPE T1,LOWSI1 ;Jump if zero TXNE F,F.LOW ;Skip if the high segment TXNN P4,JS.SWP ;Skip if swapped JRST LOWSI2 ;Go convert words to pages or K LOWSI1: MOVE T1,@GETSWP ;Get the swapped size ANDI T1,777 ;Get only 9 bits JUMPN T1,.POPJ ;Return the result MOVS T1,@GETADR ;Get the protection register LOWSI2: AOJ T1, ;Round up the nearist unit LSH T1,-^D9 ;Convert words to pages LOWSI3: ANDI T1,777 ;Clear out some trash POPJ P, ;Return the result [266] > SUBTTL Useful Routines -- ADJTIM - Convert UDT to Jiffies ;ADJTIM - Convert UDT to jiffies ;Call: MOVE T2, ; PUSHJ P,ADJTIM ; * Return - T2 contains time in jiffies * ;Uses: T2-3 ADJTIM: MUL T2,[^D<24*60*60*1000>] ;Adjust the faction of a day ASHC T2,^D17 ;Adjust this result MUL T2,JIFFIE ;Convert from milliseconds DIVI T2,^D1000 ; to jiffies POPJ P, ;Return SUBTTL Useful Routines -- PAGADJ - Page Adjustment ;PAGADJ - Set up the page boundaries ;Call: PUSHJ P,PAGADJ ; * Return * ;Uses: T1 PAGADJ: MOVE T1,PAGNUM ;Get the page to output IMUL T1,PAGSIZ ;Get the first MOVEM T1,PAGFST ; DDB to output ADD T1,PAGSIZ ;Get the last MOVEM T1,PAGLST ; DDB to output POPJ P, ;Return SUBTTL Useful Routines -- TSTABR - Test for an Abbreviation ;TSTABR - Test for an abbreviated SIXBIT word in a table ;Call: MOVE T1, ; MOVE T2, ; PUSHJ P,TSTABR ; * Non-skip return - Error: T3 contains: * ; * 0 - No abbreviation found * ; * 1 - No unique abbreviation found * ; * Skip return - T2 contains offset to avvreviation * ;Uses: T1-5 TSTABR: SETO T4, ;Reset a counter TSTAB0: LSH T4,-6 ;Shift the mask one character to the right TDNE T1,T4 ;Skip if out of characters JRST TSTAB0 ;Loop back until finished SETZ T3, ;Clear the flag for later HRRZM T2,TEMP ;Set the base address for later TSTAB1: MOVE T5,(T2) ;Get a word to test XOR T5,T1 ;Try to clear some characters JUMPE T5,TSTAB3 ;Jump if a match was found ANDCM T5,T4 ;Clear any characters at the end of the word JUMPN T5,TSTAB2 ;Jump if not a valid abbreviation TRON T3,1 ;Skip a if not the first match TLOA T3,(T2) ;Set the flag for an abreviation found TLZ T3,-1 ;More than one abbreviation found TSTAB2: AOBJN T2,TSTAB1 ;Loop back if not finished TLNN T3,-1 ;Skip if an abbreviation was found POPJ P, ;Error - T3 contains a: ; 0 - No abbreviation found ; 1 - No unique abbreviation found HLRZ T2,T3 ;Set up T2 to point to the abbreviation TSTAB3: SUB T2,TEMP ;Set up T2 to be 0, 1, 2, ... JRST .POPJ1 ;Give a good return SUBTTL Useful Routines -- RSTTRM - Restore Terminal Characteristics ;RSTTRM - Restore the terminal characteristics ;Call: PUSHJ P,RSTTRM ; * Return * ;Uses: T1-3 RSTTRM: MOVSI T1,-TRMSIZ ;Set up an AOBJN counter RSTTR0: MOVE T2,TRMSAV(T1) ;Get the bit to set MOVEM T2,TRM+2 ;Save for the TRMOP. UUO HRRZ T2,TRMTAB(T1) ;Get the first function MOVEI T2,.TOSET(T2) ;Set up as a set function MOVEM T2,TRM ;Save for the TRMOP. UUO MOVE T3,[3,,TRM] TRMOP. T3, ;Set the bit JRST E$$TTF ;No - go inform the user AOBJN T1,RSTTR0 ;Jump if more to do POPJ P, ;Return SUBTTL DDB Scanning Routines -- FNDSTR - Find a Structure Name ;FNDSTR - Find a structure name (SIXBIT) ;Call: MOVE P2, ; PUSHJ P,FNDSTR ; * Non-skip return - Can't find the structure name * ; * Skip return - The structure name is in T1 * ;Uses: T1 FNDSTR: PUSHJ P,GETUNI ;Get the pointer to the unit [266] POPJ P, ;Error return [266] HRRZ T1,UNISTR(T1) ;Get the pointer to the structure JUMPE T1,.POPJ ;Error return PUSH P,T2 ;Save a couple [266] PUSH P,T3 ; of registers [266] MOVEI T2,STRNAM ;Get the highest loc we want [266] MOVEI T3,STRPAG ;Get the mapping if not in SPY seg [266] PUSHJ P,GETBLK ;Go map the block [266] JRST FNDS90 ;Error, just return [266] MOVE T1,STRNAM(T1) ;Got it, get the structure name [266] AOS -2(P) ;Cause a skip return [266] FNDS90: POP P,T3 ;Restore the [266] POP P,T2 ; saved registers [266] POPJ P, ;And return [266] MOVE T1,HI+STRNAM(T1);Get the structure name JRST .POPJ1 ;Go do a skip return SUBTTL DDB Scanning Routines -- GETLDB - Map a LDB Page into Core ;GETLDB - Map a LDB page into core ;Call: MOVE T4, ; PUSHJ P,GETLDB ; * Return - The LDB in mapped into core * ;Uses: T3 GETLDB: MOVE T3,T4 ;Convert the LDB LSH T3,-^D9 ; address into a HRLM T3,LDBBLK+1 ; page address ADDX T3,1 ;Account for the second HRLM T3,LDBBLK+2 ; page of the LDB MOVE T3,[.PAGSP,,DELLDB] ;Delete the old PAGE. T3, ; LDB pages JFCL ;Assume first time here MOVE T3,[.PAGSP,,LDBBLK] ;Map in the new PAGE. T3, ; LDB pages JRST E$$UMP ;Unable to map in the LDB pages TRZ T4,777000 ;Fake the pointer to point TRO T4,LDB-HI ; to the mapped pages POPJ P, ;Return SUBTTL DDB Scanning Routines -- MAPSTR - Map a STR given its Pointer ;MAPSTR - Map a STR given the pointer ;Call: MOVE P4, ; PUSHJ P,MAPSTR ; * Non-skip return - no STR ; * Skip-return - P4 contains STR pointer, mapped ;Uses P4 MAPSTR: JUMPE P4,.POPJ ;Return now if no STR pointer [266] PUSH P,T1 ;Got one, maybe. Save [266] PUSH P,T2 ; a few registers [266] PUSH P,T3 ; ... [266] MOVE T1,P4 ;Copy the STR pointer [266] MOVEI T2,STRJOB ;Get the highest address we want [266] MOVEI T3,STRPAG ;Get the mapping [266] PUSHJ P,GETBLK ;Map the STR pointer [266] SKIPA ;Too bad if we failed [266] AOS -3(P) ;Ok, cause skip return [266] MOVE P4,T1 ;Get the new STR pointer [266] POP P,T3 ;Then, [266] POP P,T2 ; restore [266] POP P,T1 ; the registers [266] POPJ P, ;And return [266] SUBTTL DDB Scanning Routines -- GETUNI - Get a UNI from the DDB Pointer ;GETUNI - Map a UNI given a DDB pointer ;Call: MOVE P2, ; PUSHJ P,GETUNI ; * Non-skip return - no UNI ; * Skip-return - T1 contains the UNI pointer, mapped ;Uses T1 GETUNI: HRRZ T1,@DEVUNI ;Get the UNI pointer [266] JUMPE T1,.POPJ ;Return if nothing there [266] PUSH P,T2 ;Save some [266] PUSH P,T3 ; registers [266] MOVEI T2,UNISTR ;Get the highest loc we want [266] MOVEI T3,UNIPAG ;Get the page to map it into [266] PUSHJ P,GETBLK ;Go get the block [266] SKIPA ;Oh well, we tried [266] AOS -2(P) ;Got it, cause a skip [266] POP P,T3 ;Restore the [266] POP P,T2 ; saved registers [266] POPJ P, ;And return [266] SUBTTL DDB Scanning Routines -- GETBLK - Map a Data Structure ;GETBLK - Map a data structure given the exec virtual address ;Call: MOVE T1, ; MOVE T2, ; MOVE T3, ; PUSHJ P,GETBLK ; * Non-skip return - Can't map the block ; * Skip return - T1 contains the data pointer ;Uses T1-T3 GETBLK: PUSH P,T4 ;Save a temp register [266] PUSH P,T1 ;Save the block pointer [266] ADD T2,T1 ;Compute the ending address [266] CAML T2,MEMSIZ ;Already mapped in SPY segment? [266] JRST GETB01 ;No, map it normally [266] ADDI T1,HI ;Yes, relocate the pointer [266] JRST GETB80 ;Then give success return [266] ; Here if we're going to have to map the page(s) GETB01: MOVE T1,(P) ;Get the address back [266] ANDI T1,^O777 ;Get rid of the page number [266] DPB T3,[POINT 9,T1,26] ;Store the new page number [266] EXCH T1,(P) ;Put relocated address on the stack [266] LSHC T1,-^D9 ;Convert addresses to page numbers [266] TLZ T2,^O777000 ;Mask off junk [266] TXO T3,PA.GAF ;Turn on the delete page bit [266] ; Loop here mapping all necessary pages: GETB02: MOVEM T3,PAGBLK+1 ;Store the page to be unmapped [266] MOVE T4,[.PAGSP,,PAGBLK] ;Point to the PAGE. arg nblock [266] PAGE. T4, ;First, make sure the page is unmapped [266] MOVE T4,[.PAGSP,,PAGBLK] ;Ignore errors, but reset th arg [266] HRLM T1,PAGBLK+1 ;Store the source page number [266] PAGE. T4, ;Map the new page [266] JRST GETB90 ;Error? Punt [266] ADDI T3,1 ;Point to our next page [266] CAME T1,T2 ;Have we done enough yet? [266] AOJA T1,GETB02 ;No, do another one [266] MOVE T1,(P) ;Yes, get the pointer back [266] ; Here if success: GETB80: AOS -2(P) ;Make a skip return happen [266] ; Here if not necessarily success: GETB90: POP P,(P) ;Clean up the stack [266] POP P,T4 ;Restore scratch register [266] POPJ P, ;And return [266] ;Uses: T1-5, BP, C and CC SUBTTL DDB Scanning Routines -- NXTDDB - Get the Next DDB in Chain ;NXTDDB - Get the address of the next DDB in the chain ;Call: MOVE P2, ; PUSHJ P,NXTDDB ; * Non-skip return - The end of the DDB chain was reached * ; * Skip return - P2 contains the address of the next DDB * ;Uses: T1-3 NXTDDB: JUMPE P2,NXTDD1 ;No current DDB - map the UPT, etc [275] MOVE T1,JOB ;Get the job number back HRRZ T2,@GETUPM ;Get the job's UPMP CAME T2,CURUPM ;Skip if the same as last time JRST NXTDD2 ;Do it the hard way HLRZ T2,DEVSER(P2) ;Get the link to the next DDB JUMPE T2,NXTDD1 ;Jump if the end of DDB chain XOR T2,CURVRT ;Is this DDB on the same TRNE T2,777000 ; page as the last one JRST NXTDD3 ;No, get the new DDB page MOVE T2,@CURPTR ;Get the physical page CAME T2,CURPAG ;Skip if the same as last time JRST NXTDD3 ;No, get the new DDB page HLRZ P2,DEVSER(P2) ;Get the DDB address JRST NXTDD4 ;Go convert to the mapped page NXTDD1: AOS T1,JOB ;Look at the next job CAMLE T1,@HIJOB ;Skip if valid job POPJ P, ;Return (the end of the DDB chain) SETZ P2, ;Assume the end of the jobs DDB chain HRRZ T2,@GETUPM ;Get the job's UPMP TXNN F,F.JOB ;Are we just doing a job display? [275] JRST NXTDD2 ;No, skip this [275] CAMGE T1,JOBNUM ;Yes, have we reached the job number? [275] JRST NXTDD1 ;No, try the next one [275] CAME T1,JOBNUM ;Are we all done with this job? [275] POPJ P, ;Yes, all out of DDBs [275] NXTDD2: JUMPE T2,NXTDD5 ;Jump if no UPMP PUSHJ P,MAPUP1 ;Map the job's UPT [276] JRST E$$UMP ;Unable to map in the UPMP [276] NXTDD3: SKIPE P2 ;Skip if the DDB for the job [276] SKIPA P2,DEVSER(P2) ;Get the link to the next DDB [276] MOVE P2,@LSTLOC ;Get the link to the first DDB [276] HLRZS P2 ;Remove some junk from the link [276] JUMPE P2,NXTDD1 ;Jump if the end of the DDB chain [276] MOVEM P2,CURVRT ;Save for later [276] PUSHJ P,MAPFUN ;Map the funny page [276] JRST E$$UMP ;Unable to map in the DDB page NXTDD4: JUMPE P2,.POPJ ;?? .POPJ ?? .POPJ1: AOS (P) ;Set up for a skip return .POPJ: POPJ P, ;Return ; Here if the job went away or swapped: NXTDD5: PUSH P,P5 ;Save the current job number for a min [275] MOVE P5,JOB ;Get the job we're looking at [275] MOVE T1,@GETSTS ;Get the job's status bits [275] POP P,P5 ;Restore the job number [275] TXNE F,F.PEK ;Are we JOBPEKing? [275] TXNN T1,JS.JNA ;Yes, job number assigned? [275] JRST NXTDD1 ;No, go on to the next job [275] JUMPN P2,NXTDD6 ;Skip this if not the first DDB [275] MOVEI T1,T2 ;First time, setup a JOBPEK block [275] HRLZ T2,JOB ; to read the job's UPMP pointer [275] TXO T2,JK.UPM!1 ; to the first DDB in the job's [275] HRLZ T3,LSTLOC ; funny space DDB list [275] HRRI T3,P2 ; Point to our destination [275] JOBPEK T1, ;Go read the first DDB address [275] JRST NXTDD1 ;Can't. Just try the next job [275] SKIPA ;And fall into the following code [275] NXTDD6: HLLZ P2,DEVSER(P2) ;Follow the DDB link [275] JUMPE P2,NXTDD1 ;No more DDBs. Try the next job [275] MOVE T3,P2 ;Copy the DDB pointer (left half) [275] HRRI T3,PEKDDB ;Point at the storage [275] HRLZ T2,JOB ;Get the job number we're reading [275] TXO T2,JK.EVA!DDBMAX ;Get flags and length of the peek [275] MOVEI T1,T2 ;Point at the ARG block [275] JOBPEK T1, ;Go try to read the DDB [275] JRST NXTDD1 ;Error, try the next job [275] MOVEI P2,PEKDDB ;Got it. Point to it [275] JRST .POPJ1 ;And return happy [275] SUBTTL DDB Scanning Routines -- FUNWRD - Get a Word from Funny Space ;FUNWRD - Get the next word from funny space ;Call: MOVEI P2,
; PUSHJ P,FUNWRD ; * Non-Skip return - can't map the address ; * Skip return - funny word in T1 ;Uses T1 FUNWRD: TRNE P2,777 ;Just start a new page? [276] JRST FUNW01 ;No, go on [276] PUSHJ P,MAPFUN ;Yes, go map the page [276] POPJ P, ;Error, pass it on [276] FUNW01: MOVE T1,(P2) ;Get the next word [276] AOJA P2,.POPJ1 ;And return happy [276] SUBTTL DDB Scanning Routines -- MAPFUN - Map a Job's Funny Space ;MAPFUN - Map a page from a job's funny space ;Call: MOVEI P2,
; PUSHJ P,MAPFUN ; * Non-skip return - Can't map the address ; * Skip return - Funny page mapped ok ;Uses T1 MAPFUN: MOVE T1,P2 ;Copy the address [276] LSH T1,-^D9 ;Convert it to a page number [276] TXO T1,PA.GAF ;Set the delete bit [276] MOVEM T1,PAGBLK+1 ;Store the the PAGE. arg block [276] MOVE T1,[.PAGSP,,PAGBLK] ;Unmap the old copy [276] PAGE. T1, ; of this funny page [276] JFCL ;Punt errors here [276] HRRZ T1,PAGBLK+1 ;Get the page number back [276] SUB T1,FUNFST ;Subtract the base funny page [276] JUMPL T1,.POPJ ;Not a funny page? Return error [276] ADD T1,FUNPAG ;Add in the funny mapping offset [276] ADD T1,UPT ;Add in the UPT base address [276] MOVEM T1,CURPTR ;Save for future reference [276] MOVE T1,(T1) ;Get the funny page's mapping [276] MOVEM T1,CURPAG ;Save also for future reference [276] HRLM T1,PAGBLK+1 ;Store as the source page number [276] MOVE T1,[.PAGSP,,PAGBLK] ;Then, map the [276] PAGE. T1,UU.PHY ; funny page [276] POPJ P, ;Error, just return [276] JRST .POPJ1 ;Ok, return happy [276] SUBTTL DDB Scanning Routines -- MAPUPT - Map a Job's UPT ;MAPUPT - Map a job's UPT ;Call: MOVEI P5, ; PUSHJ P,MAPUPT ; * Non-skip return - Can't map page (job swapped possibly) ; * Skip return - UPT page mapped ok ;Uses T1 MAPUPT: MOVE T1,P5 ;Copy the job number for GETUPM [276] MAPUP1: HRRZ T1,@GETUPM ;Get the UPT pointer for this job [276] JUMPE T1,.POPJ ;Error if no UPT pointer [276] CAMN T1,CURUPM ;Already have this mapped? [276] JRST .POPJ1 ;Yes, just return happy [276] HRLM T1,UPTBLK+1 ;Save for the PAGE. UUO [276] MOVEM T1,CURUPM ;And save for next time [276] MOVE T1,[.PAGSP,,DELUPT] ;Delete the [276] PAGE. T1, ; old UPT [276] JFCL ;Punt errors here [276] MOVE T1,[.PAGSP,,UPTBLK] ;Map in the [276] PAGE. T1,UU.PHY ; new UPT [276] POPJ P, ;Error, just pass it on [276] JRST .POPJ1 ;Success, return that way [276] SUBTTL DDB Test Routines -- TSTPRG - Test for Program ;TSTPRG - Test if a program was is being run ;Call: MOVE P2, ; MOVE P3, ; MOVE P5, ; JRST TSTPRG ; * Returns to DDBLO1 if it valid else returns to DDBLOP * ;Uses: T1 TSTPRG: PUSH P,P5 ;Preserve P5 LDB P5,JOBPTR ;Get the job number TXNE F,F.GOD ;Skip if not GOD JRST TSTPR0 ;No need to test this stuff MOVE T1,@GETPPN ;Get the PPN in use XOR T1,PPN ;Compare the PPN's TDNE T1,PPNMSK ;Skip if a match JRST TSTPR1 ;Go try the next DDB TSTPR0: SKIPN P5,@GETPDB ;Get the address of the PDB JRST TSTPR1 ;Jump if no PDB MOVE T1,@GETRDI ;Get the program's directory XOR T1,DIR ;Compare the directory TDNE T1,DIRMSK ;Skip if a match JRST TSTPR1 ;Go try the next DDB MOVE T1,@GETRFN ;Get the program's name XOR T1,FIL ;Compare the file name TDNE T1,FILMSK ;Skip if a match JRST TSTPR1 ;Go try the next ddb MOVE T1,@GETRDV ;Get the porgram's device XOR T1,DEV ;Compare the device TDNE T1,DEVMSK ;Skip if a match JRST TSTPR1 ;Go try the next DDB POP P,P5 ;Restore P5 JRST DDBLO1 ;Go output this DDB TSTPR1: POP P,P5 ;Restore P5 JRST DDBLOP ;Go try the next DDB SUBTTL DDB Test Routines -- TSTNOT - Test for NOT Logged-In ;TSTNOT - Test if a DDB fits a not logged in specification ;Call: MOVE P2, ; MOVE P3, ; MOVE P5, ; JRST TSTNOT ; * Returns to DDBLO1 if it valid else returns to DDBLOP * ;Uses: T1 and T5 TSTNOT: LDB T5,JOBPTR ;Get the job number MOVE T1,@GETPP ;Get the PPN in use XOR T1,DIR ;Compare this PPN TDNN T1,DIRMSK ;Skip if not a match JRST DDBLOP ;No - go try next DDB JRST DDBLO1 ;Yea - go output this DDB SUBTTL DDB Test Routines -- TSTLOG - Test for Logged-In ;TSTLOG - Test if a DDB fits a logged in specification ;Call: MOVE P2, ; MOVE P3, ; MOVE P5, ; JRST TSTLOG ; * Returns to DDBLO1 if it valid else returns to DDBLOP * ;Uses: T1 and T5 TSTLOG: LDB T5,JOBPTR ;Get the job number TSTLO0: MOVE T1,@GETPP ;Get the PPN in use XOR T1,DIR ;Compare this PPN TDNE T1,DIRMSK ;Skip if a match JRST DDBLOP ;No - go try next DDB JRST DDBLO1 ;Yea - go output this DDB SUBTTL DDB Test Routines -- TSTFIL - Test for a File Specification ;TSTFIL - Test if a DDB fits a file specification ;Call: MOVE F, ; MOVE P2, ; MOVE P3, ; MOVE P5, ; JRST TSTFIL ; * Returns to DDBLO1 if it valid else returns to DDBLOP * ;Uses: T1 TSTFIL: TXNE F,F.SUP ;Skip if not super I/O JRST DDBLOP ;Don't output super I/O DDB's MOVE T1,HI+PPBNAM(P5);Get the PPN of the file XOR T1,DIR ;Compare this PPN TDNE T1,DIRMSK ;Skip if a match JRST DDBLOP ;No - go try next DDB then PUSHJ P,FNDSTR ;Go find the structure name JRST DDBLOP ;No - go try next DDB then XOR T1,DEV ;Compare this device TDNE T1,DEVMSK ;Skip if a match JRST DDBLOP ;No - go try next DDB then MOVE T1,DEVFIL(P2) ;Get the file name XOR T1,FIL ;Compare this file name TDNE T1,FILMSK ;Skip if a match JRST DDBLOP ;No - go try next DDB then HLLZ T1,DEVEXT(P2) ;Get the extension XOR T1,EXT ;Compare this extension TLNE T1,(T1) ;Skip if a match JRST DDBLOP ;No - go try next DDB JRST DDBLO1 ;Yea - go output this DDB SUBTTL DDB Test Routines -- TSTJOB - Test for a Job ;TSTJOB - Test if a DDB is from a given job ;Call: MOVE P2, ; MOVE P3, ; MOVE P5, ; JRST TSTJOB ; * Returns to DDBLO1 if it valid else returns to DDBLOP * ;Uses: T1 and T5 TSTJOB: LDB T5,JOBPTR ;Get the job number CAME T5,JOBNUM ;Skip if a right job number JRST DDBLOP ;Go try the next job number TXNE F,F.GOD ;Skip if not GOD JRST DDBLO1 ;Go output the DDB JRST TSTLO0 ;Go test the PPN of this user SUBTTL Display Routines -- TRMCLR - Clear the Screen ;TRMCLR - Clear the screen ;Call: MOVEI P1, ; PUSHJ P,TRMCLR ; * Return * ;Uses: T1 TRMCLR: SETOM LSTCNT ;Insure Hazeltine hack works [273] TXNE P1,TM%CLR ;Can this terminal clear the screen? [273] JRST TRMC01 ;Yes, go do it [273] PUSHJ P,TRMHOM ;No, emulate it with home [273] PJRST TRMEOS ; and clear to end of screen [273] TRMC01: MOVE T1,CLRTAB(P1) ;Get the character that clears [273] CAILE T1,177 ;Is it really a character? [273] PJRST (T1) ;No, call the routine then [273] JUMPN T1,TRMC02 ;Go output the char if there is one [273] TXNE P1,TM%DUM ;Oh. Is this a dumb terminal? [273] OUTSTR [BYTE (7) .CHCRT,.CHLFD,0] ;Yes, just output a CRLF [273] POPJ P, ;Whatever. Just return [273] TRMC02: SKIPE PREFIX ;Any prefix to be output? [273] OUTSTR PREFIX ;Yes, output it then [273] OUTCHR T1 ;Output this guy [273] TXNE P1,TM%FIL ;Do we need to output some fill? [273] OUTSTR FILL ;Yes, output some [273] POPJ P, ;Return [273] SUBTTL Display Routines -- TRMEOS - Clear to End of Screen ;TRMEOS - Clear to end of the screen ;Call: MOVEI P1, ; PUSHJ P,TRMEOS ; * Return * ;Uses: T1-2 TRMEOS: SKIPN T1,EOSTAB(P1) ;Anything to output? [273] POPJ P, ;No, just a no-op then [273] CAILE T1,177 ;Is it really a routine address? [273] PJRST (T1) ;Yes, go do it instead [273] SKIPE PREFIX ;Any prefix to be output? [273] OUTSTR PREFIX ;Yes, output it then [273] OUTCHR T1 ;And output the magic char [273] TXNE P1,TM%FIL ;Do we need to output some fill? [273] OUTSTR FILL ;Yes, do it [273] POPJ P, ;And return [273] AD3EOS: MOVE T1,TRMLIN ;Get the screen size [273] TXNN F,F.TTL ;Skip the title is being output MOVEI T1,-TTLLNS(T1) ;Get the size of the title [267,273] SUBI T1,1 ;Account for the status line [273] SUB T1,CURCNT ;Get the number of blank lines [273] JUMPLE T1,.POPJ ;Return if no blanks lines needed AD3EO1: OUTCHR [.CHLFD] ;Output a line-feed SOJG T1,AD3EO1 ;Loop back if more lines to output POPJ P, ;Return HZ1EOS: MOVE T1,CURCNT ;Get the number of lines displayed EXCH T1,LSTCNT ;Save for the next scan SUB T1,LSTCNT ;Get the number lines to delete AOJLE T1,.POPJ ;Return if no lines to clear HZ1ES0: OUTSTR [BYTE (7) 176,23,.CHDEL,.CHDEL,0] ; [273] OUTSTR FILL ;Output some fill [273] SOJE T1,.POPJ ;Jump if no more lines to delete JRST HZ1ES0 ;Loop back until finished SUBTTL Display Routines -- TRMEOL - Clear to End of Line ;TRMEOL - Clear to end of the line ;Call: MOVEI P1, ; PUSHJ P,TRMEOL ; * Return * ;Uses: No ACs TRMEOL: SKIPN T1,EOLTAB(P1) ;Anything to clear? [273] POPJ P, ;No, just return now [273] CAIL T1,177 ;Is it a character? [273] JRST (T1) ;No. Dispatch to the routine [273] SKIPE PREFIX ;Any prefix to output? [273] OUTSTR PREFIX ;Yes, output it [273] OUTCHR T1 ;Output the character [273] POPJ P, ;And return [273] SUBTTL Display Routines -- TRMHOM - Home the Screen ;TRMHOM - Home the screen ;Call: MOVEI P1, ; PUSHJ P,TRMCLR ; * Return * ;Uses: T1 TRMHOM: SKIPN T1,HOMTAB(P1) ;Get the character which homes [273] POPJ P, ;None? Just return I guess [273] CAILE T1,177 ;Is it a char or a routine? [273] PJRST (T1) ;A routine. Call it [273] SKIPE PREFIX ;A character. Any prefix? [273] OUTSTR PREFIX ;Yes, output it [273] OUTCHR T1 ;Then send the home character [273] TXNE P1,TM%FIL ;Are we filling? [273] OUTSTR FILL ;Yes, output some fill then [273] POPJ P, ;And return FILL: BYTE(7) .CHDEL,.CHDEL,.CHDEL,.CHDEL,.CHDEL ; [273] BYTE(7) .CHDEL,.CHDEL,.CHDEL,.CHDEL,0 ; [273] SUBTTL The Error Message Routines E$$DRM: OUTSTR [ASCIZ ~ ?DDBDRM DDBDPY isn't set up to run on this monitor ~] JRST CMDAB1 ;Go do a monitor return E$$NPS: OUTSTR [ASCIZ ~ ?DDBNPS No privileges to SPY on the monitor ~] JRST CMDAB1 ;Go do a monitor return E$$UMP: PUSHJ P,@TRMCLR(P1) ;Go clear the screen OUTSTR [ASCIZ ~ %DDBUMP Unable to map in a DDB or LDB page (Job is swapped out) [DDBCON Continuing] ~] PUSHJ P,@TRMHOM(P1) ;Home cursor [263] MOVEI T1,2 ;Wait [263] SLEEP T1, ; awhile [263] JRST DDBMAN ;Reset PDL and try again [263] E$$TTF: OUTSTR [ASCIZ ~ ?DDBTTF A TRMNO. or TRMOP. UUO failed ~] JRST CMDAB1 ;Go do a monitor return E$$CIT: OUTSTR [ASCIZ ~ ?DDBCIT Can't INIT the terminal ~] JRST CMDAB1 ;Go do a monitor return E$$CRS: OUTSTR [ASCIZ ~ ?DDBCRS DDBDPY can't be run as a subjob ~] JRST CMDAB1 ;Go do a monitor return IFN FTPRIV,< E$$NPR: OUTSTR [ASCIZ ~ ?DDBNPR No privileges to run DDBDPY ~] JRST CMDAB1 ;Go do a monitor return > E$$OPP: OUTSTR [ASCIZ ~ ?DDBOPP Program overlaps per process pages ~] JRST CMDAB1 ;Do a monitor return SUBTTL Data/Storage -- High Segment STLBUF: ASCIZ ~JB M PPN FILE NXT WRT ALC OTH~ PTHBUF: ASCIZ ~JB M PPN FILE UNIT BLK NXT WRT ALC OTH~ HLPBUF: .HLPTX \MONVER,\DDBVER,\DDBEDT ;The help text STSPTR: POINT 3,HI+ACCSTS(P3),32 ;Pointer to the file status STSTAB: SIXBIT ~ R~ ;0 - Read ** The file status modes ** SIXBIT ~ U~ ;1 - Update SIXBIT ~ S~ ;2 - Supersede SIXBIT ~ *~ ;3 - Fake for super I/O SIXBIT ~ C~ ;4 - Create MODTAB: SIXBIT ~A~ ;0 - ASCII ** The I/O modes ** SIXBIT ~AL~ ;1 - ASCII line SIXBIT ~P~ ;2 - Packed image SIXBIT ~BT~ ;3 - Byte SIXBIT ~A8~ ;4 - Eight bit ASCII [302] SIXBIT ~5~ ;5 - Undefined SIXBIT ~6~ ;6 - Undefined SIXBIT ~7~ ;7 - Undefined SIXBIT ~I~ ;10 - Image mode SIXBIT ~11~ ;11 - Undefined SIXBIT ~12~ ;12 - Undefined SIXBIT ~IB~ ;13 - Image binary SIXBIT ~B~ ;14 - Binary SIXBIT ~SD~ ;15 - Scope dump SIXBIT ~DR~ ;16 - Dump by record SIXBIT ~D~ ;17 - Dump EVWTAB: SIXBIT ~TK~ ;Tape kontroller wait ** The event wait states ** SIXBIT ~TR~ ;Tape rewind wait SIXBIT ~LB~ ;Label processing wait SIXBIT ~ND~ ;Network device wait SIXBIT ~NT~ ;Network terminal connect wait SIXBIT ~NS~ ;Network station control wait SIXBIT ~DT~ ;DTE I/O wait [266] SIXBIT ~KD~ ;KDP I/O wait [266] SIXBIT ~IP~ ;IPCF system process receive wait SIXBIT ~FI~ ;Front end device input wait SIXBIT ~FO~ ;Front end device output wait SIXBIT ~D6~ ;DN60 device wait SIXBIT ~DN~ ;DECnet connect/I/O wait [266] SIXBIT ~DM~ ;DMR I/O wait [266] SIXBIT ~CI~ ;Distributed terminal input [266] SIXBIT ~CO~ ;Distributed terminal output [266] SIXBIT ~NI~ ;Ethernet function wait [266] EVWSIZ==.-EVWTAB DEFINE .DSP ($NAM,$FLG,$WID,$LEN,$PFX,$CLS,$LBL),< > DSPNAM: .DSPTB ;** Generate the display name table ** DSPSIZ==.-DSPNAM DEFINE .DSP ($NAM,$FLG,$WID,$LEN,$PFX,$CLS,$LBL,%PFX),< IFG <$WID+1-LINLEN>, IFG <$LEN-MAXLIN>, IFNB <$LBL>,<$LBL:> %PFX=='$PFX'PFX-PFXTAB EXP $FLG!INSVL.(%PFX,TM%PFX)!INSVL.($LEN,TM%LEN)!INSVL.($WID,TM%WID)!CL.'$CLS'> DSPNUM: .DSPTB ;** Generate the display size table ** LINSIZ==/5 ;Compute max line size [273] IFG -BUFSIZ>,< BUFSIZ==LINSIZ*> ;Compute the buffer size [273] ; Generate the class tables: DEFINE .CLS ($CLS,$CLR,$HOM,$EOS,$EOL),< CL.'$CLS==NXTCLS NXTCLS==NXTCLS+1 EXP $CLR > ; [273] NXTCLS==0 ;Init the class counter [273] CLRTAB: .DSPCL ;** Generate the clear screen table ** [273] MAXCLS==NXTCLS ;Get the maximum class number [273] DEFINE .CLS ($CLS,$CLR,$HOM,$EOS,$EOL), ; [273] HOMTAB: .DSPCL ;** Generate the home screen table ** [273] DEFINE .CLS ($CLS,$CLR,$HOM,$EOS,$EOL), ; [273] EOSTAB: .DSPCL ;** Generate the clear to end of screen ** [273] DEFINE .CLS ($CLS,$CLR,$HOM,$EOS,$EOL), ; [273] EOLTAB: .DSPCL ;** Generate the clear to end of line ** [273] PFXTAB: ;Beginning of prefix types [273] NULPFX: EXP 0 ;No prefix [273] ESCPFX: BYTE (7) .CHESC ;Traditional escape prefix [273] CSIPFX: BYTE (7) .CHESC,"[" ;ANSI CSI prefix [273] ALTPFX: BYTE (7) 176 ;Old style prefix [273] SUBTTL Data/Storage -- Low Segment RELOC 0 ;Put the data in the low segment [274] PDL: BLOCK PDLSIZ ;The push down list IFN FTDEBUG,< PATCH: BLOCK PATSIZ ;A patch area if debugging > TEMP: BLOCK 1 ;A temporary storage location LSTLOC: BLOCK 1 ;Offset for .UPLST INCHR: BLOCK 1 ;Contains an instruction to be executed when ; another character is wanted on input ADRDSK: BLOCK 1 ;Address of the first disk DDB MAXEDN: BLOCK 1 ;The maximum number of ERSATZ device MYPPN: BLOCK 1 ;My project programmer number JOBMAX: BLOCK 1 ;The maximum number of jobs CURJOB: BLOCK 1 ;My job number JIFFIE: BLOCK 1 ;The number of jiffies in one second JIFMIN: BLOCK 1 ;The number of jiffies in one minute JIFHOR: BLOCK 1 ;The number of jiffies in one hour PTYMIN: BLOCK 1 ;The number of the first PTY CURDAT: BLOCK 1 ;The current date TOTTIM: BLOCK 1 ;The total runtime DELTIM: BLOCK 1 ;The delta runtime DSKRED: BLOCK 1 ;The number of disk reads DSKWRT: BLOCK 1 ;The number of disk writes PAGNUM: BLOCK 1 ;Current page to output PAGSIZ: BLOCK 1 ;The number of DDB's on one screen PAGFST: BLOCK 1 ;The first DDB to output on the page PAGLST: BLOCK 1 ;The last DDB to output on the page CURCNT: BLOCK 1 ;The number of lines output this scan LINWID: BLOCK 1 ;This terminal's line width [273] TRMLIN: BLOCK 1 ;The number of lines on this terminal's screen [273] PREFIX: BLOCK 1 ;ASCIZ prefix string [273] TRMNAM: BLOCK 1 ;SIXBIT terminal type name [273] LSTCNT: BLOCK 1 ;The number of lines output on the last scan DDBCNT: BLOCK 1 ;The number of DDB's found on this scan JOB: BLOCK 1 ;The current job we're looking at for DDB's HIJOB: BLOCK 1 ;The highest job in use on the system CURUPM: BLOCK 1 ;The current UPMP for the job (physical address) CURPTR: BLOCK 1 ;The pointer to the current funny page CURPAG: BLOCK 1 ;The current page of funny page CURVRT: BLOCK 1 ;The current virtual page of SPY'ed DDB JOBTTL: BLOCK 1 ;The current job title line type [272] TTLBUF: BLOCK LINSIZ*TTLLNS ;The title buffer [267] WHTBUF: BLOCK WHTSIZ ;The command string buffer IFN FTSLEEP,< SLPCNT: BLOCK 1 ;Sleep time adjustment counter > HIBTIM: HB.RTL!HB.RWJ ;HIBER time and wake bits FUNFST: BLOCK 1 ;Page number of the first funny space page [266] FUNLST: BLOCK 1 ;Page number of the last funny spage page [266] FUNPAG: BLOCK 1 ;Offset into UPT for funny space page mapping for exec [266] UPT: BLOCK 1 ;Exec virtual address (and ours) of the UPT [266] MEMSIZ: BLOCK 1 ;The size of the monitor's low segment [266] PEKDDB: BLOCK DDBMAX ;A JOBPEKed DDB [275] .USLNM: BLOCK 1 ;UPT address for the logical names table [276] ROUTIN: BLOCK 1 ;The routine to be used is stored here JOBNUM: PPN: NOD: BLOCK 1 ;The file specification go here PPNMSK: NODMSK: BLOCK 1 DEV: BLOCK 1 DEVMSK: BLOCK 1 FIL: BLOCK 1 FILMSK: BLOCK 1 EXT: BLOCK 1 DIR: BLOCK 1 DIRMSK: BLOCK 1 BLTEND==.-1 XROUTI: BLOCK 1 ;The routine to be used is stored here XPPN: XNOD: BLOCK 1 ;The temporary file specification go here XPPNMS: XNODMS: BLOCK 1 XDEV: BLOCK 1 XDEVMS: BLOCK 1 XFIL: BLOCK 1 XFILMS: BLOCK 1 XEXT: BLOCK 1 XDIR: BLOCK 1 XDIRMS: BLOCK 1 XBLTEND==.-1 IROUTI: TSTFIL ;The routine to be used is stored here IPPN: INOD: ' ' ;The initial file specification go here IPPNMS: INODMS: -1 ; 'ALL:*.*[PRJ,*] IDEV: 'ALL ' IDEVMS: 0 IFIL: '* ' IFILMS: 0 IEXT: '* ',,0 IDIR: 0 IDIRMS: 0 TRMTAB: 1,,.TONFC ;Set the no free carriage returns 0,,.TOALT ;Clear the altmode setting 0,,.TOBLK ;Set the blank line setting TRMSIZ==.-TRMTAB TRMSAV: BLOCK TRMSIZ ;Save the TTY status here TRM: BLOCK 1 ;The TRMOP. data area .UXTRM BLOCK 1 INTBLK: 4,,CMDABT ;Go abort the job on a Control-C ER.ICC BLOCK 2 ; Assign some dynamically mapped pages: LSTPAG==FSTPAG ;Init the page counter [266] .ASPAG EDN,2 ;The Ersatz Device Name pages [266] .ASPAG LDB,2 ;Pages for mapping the Line Data Block [266] .ASPAG UNI,2 ;Pages for mapping UDBs [266] .ASPAG STR,2 ;Pages for mapping STRs [266] .ASPAG PFF,0 ;First free page (must be below funny space) [266] ; An argument block for PAGE. UUOs. PAGBLK: ^D1 ;One argument page only [266] EDNPAG ;A place to stick page numbers [266] EDNBLK: ^D2 ;Length (create EDN pages) EDNPAG ;Page EDNPAG+1 ; numbers LDBBLK: ^D2 ;Length (create LDB pages) LDBPAG ;Page LDBPAG+1 ; numbers UPTBLK: ^D1 ;Length (create UPT page) 0 ;Page number [266] DELEDN: ^D2 ;Length (delete EDN pages) PA.GAF+EDNPAG ;Page PA.GAF+EDNPAG+1 ; numbers DELLDB: ^D2 ;Length (delete LDB pages) PA.GAF+LDBPAG ;Page PA.GAF+LDBPAG+1 ; numbers DELUPT: ^D1 ;Length (delete UPT page) PA.GAF ;Page number [266] DEFINE GT ($TBL,$IDX,$FTX)< IFN $FTX,< BYTE (9)$TBL(5)0(4)$IDX(18)0 > > GETSLF: GT ,T1,1 ;The GETTAB table pointer GETPDB: GT ,P5,1 ;The PDB pointer GETSFD: GT ,P5,1 ;The JBTSFD pointer (to find paths) [272] GETDAT: GT ,,1 ;Get address of the date GETSPB: GT ,,1 ;The address of the where to find the first PPB GETSTR: GT ,,1 ;The address of the where to find the first STR GETEDN: GT ,,1 ;The address of the ERSATZ device table GETTBL: ;The GETTAB tables to be set up GETSTS: GT .GTSTS,P5,1 ;The status of a job GETADR: GT .GTADR,P5,1 ;The relocation and protection GETPP: GT .GTPPN,T5,1 ;The project-programmer number GETPPN: GT .GTPPN,P5,1 ;The project-programmer number GETPRG: GT .GTPRG,P5,1 ;The program name GETTIM: GT .GTTIM,P3,1 ;The current runtime GETKCT: GT .GTKCT,P3,1 ;The Kilo-Core-Ticks GETPRV: GT .GTPRV,P5,1 ;The job privileges GETSWP: GT .GTSWP,P5,1 ;The swapping data GETTTY: GT .GTTTY,P5,1 ;The TTY pointer GETSGN: GT .GTSGN,P5,1 ;The segment number GETRCT: GT .GTRCT,P5,1 ;The disk read count GETWCT: GT .GTWCT,P5,1 ;The disk write count GETWSN: GT .GTWSN,T1,1 ;The run states GETSPL: GT .GTSPL,P5,1 ;The spool bits GETRTD: GT .GTRTD,P5,1 ;The real time status word GETLIM: GT .GTLIM,P5,1 ;The limits word GETUPM: GT .GTUPM,T1,1 ;The UPMP pointer GETVRT: GT .GTVRT,P5,1 ;The virtual flags GETST2: GT .GTST2,P5,1 ;The second status word GETJLT: GT .GTJLT,P5,1 ;The logged-in time GETRDV: GT .GTRDV,P5,1 ;The device of the program GETRDI: GT .GTRDI,P5,1 ;The directory of the program GETRFN: GT .GTRFN,P5,1 ;The file name of the program GETVKS: GT .GTVKS,P3,1 ;The VM Kilo-Core-Ticks GETUUC: GT .GTUUC,P3,1 ;The UUO count IFGE MONVER-703,< ;New GETTABs!!! [266] GETIMI: GT .GTIMI,P5,1 ;The incore image size of the job/segment [266] > GETSIZ==.-GETTBL ;Define the size of the GETTAB table ; Some indirect pointers to be filled in from GETTABs ; First, stuff we find in DDBs: [266] JOBPTR: POINT 9,(P2),35 ;Pointer to the job number [266] CTXPTR: POINT 9,(P2),26 ;Pointer to the context number [301] DEVUNI: (P2) ;The link to the unit data block [266] DEVSFD: (P2) ;The link to the father SFD (RH) [266] DEVBLK: (P2) ;The logical block in the unit to read [266] DEVACC: (P2) ;The link to the access block (RH) [266] DEVSPN: (P2) ;The entered spooled name [266] ; Terminal DDB instead of disk DDB: [266] DDBLDB: (P2) ;The link to the line data block (LDB) [266] ; Some LDB stuff: LDBDCH: HI(T4) ;LDB characteristics word [266] ; Some STR fields: STRSYS: (P4) ; is link to next STR [266] LGOBLK: SIXBIT ~SYS~ ;Device - for the "K" command SIXBIT ~LOGOUT~;Filename EXP 0 ;Extension EXP 0 ;Privileges EXP 0 ;PPN EXP 0 ;Core LINBUF: BLOCK BUFSIZ ;The line buffer SUBTTL The End END DDBDPY ;The end of 'DDBDPY'