title WHOLINE display subttl Definitions ; I make no claims that this crock is at all well-written. .insrt MRC;MACROS ; Assembly switches nd. slptim==10. ; seconds of sleep time ; Accumulators acdef. [x y z v u w b c j t l] ; I/O channels acdef. [tto] .hkill tto define type string irpc char,foo,[string] movx x,<"char> chrout x termin termin ; No attempt is made to optimize the AOS'ing of the character count, since ; this way it is more straightforward and anybody who cares about a few extra ; words or a couple of usecs saved is obviously losing! define chrout ac idpb ac,b addx c,1 termin line: block 20. ; who-line block subttl Main program ; Start of program wholin: .open tto,[%tjdis\.uao,,'TTY] ; get a TTY output channel .lose ; failed movx x,%zeros ; initialize page counter syscal CORBLK,[ clarg. (%cbred) ; get read access clarg. %jself ; this job clarg. 777600000200; top half of a moby clarg. 400000 ; system job %clarg x] ; page counter .lose %lssys ; failed? .value [asciz\:Forget :Vk \] ; Fetch symbols from ITS irps sym,,[UNAME JNAME USYSNM TTYSTS USTP FLSINS USWST JTMU UTRNTM NMPGS NSWPGS UPC SV40 OPTION UUOSXB LSCALL OPRSXB UUAC IOCHNM IOTTB CLSTB JBDEV DCHSTB CALSXB] movx x, .eval x, ; get value of this symbol .lose ; failed? addx x,400000 ; offset to where I have ITS mapped addm x,sym ; save index termin irps sym,,[NUUOSX MXOPR %CLSJ %IOTOT] movx x, .eval x, ; get value of this symbol .lose ; failed? addm x,sym ; save index termin movx L, ; size of luser block .eval L, ; get value .lose ; failed? ; Set up for the next who-line wholup: uget CNSL,t ; get my TTY # jumpl t,zzz ; no TTY, back to sleep TTYSTS: hrrz j,(t) ; get job number ; Initialize the who-line store %zeros,line,line+19. ; clear prototype who-line movx b,line(440700) ; load line pointer movx c,%zeros ; no characters yet type [SZL] ; position who-line ; Date and time .rdatim y, ; get date/time exch y,z ; want date first rot y,wid. '_'_ ; convert YYMMDD to MMDDYY repeat 3,[ repeat 2,[ movx x,%zeros ; flush original cruft lshc x,wid. '_ ; gobble down a character addx x,<" > ; ASCIIify chrout x ; output the character ] ; repeat 2 ifn 2-.rpcnt,movx x,"/ ; delimiter between fields .else movx x,<" > ; delimiter between items chrout x ; output whatever ] ; repeat 3 repeat 3,[ repeat 2,[ movx y,%zeros ; flush original cruft lshc y,wid. '_ ; gobble down a character addx y,<" > ; ASCIIify chrout y ; output the character ] ; repeat 2 ifn 2-.rpcnt,movx x,": ; delimiter between fields .else movx x,<" > ; delimiter between items chrout x ; output whatever ] ; repeat 3 ; User index move x,j ; just user index idiv x,l ; index, not table pointer idivx x,100 ; high order idivx y,10 ; medium/low order jumpe x,[ jumpe y,lorder jrst morder] ; null, just medium order addx x,"0 ; ASCIIify chrout x ; output the character morder: addx y,"0 ; ASCIIify chrout y ; output medium order digit lorder: addx z,"0 ; ASCIIify chrout z ; output low order digit movx x,<" > ; space chrout x ; output delimiter ; UNAME UNAME: move y,(j) ; get user name unmlup: movx x,%zeros ; zap out old cruft lshc x,wid. '_ ; siphon out a character addx x,<" > ; ASCIIify chrout x ; output the frob jumpn y,unmlup ; loop until done movx x,<" > ; delimit with space chrout x ; output it ; JNAME JNAME: move y,(j) ; get job name jnmlup: movx x,%zeros ; zap out old cruft lshc x,wid. '_ ; siphon out a character addx x,<" > ; ASCIIify chrout x ; output the frob jumpn y,jnmlup ; loop until done movx x,<" > ; delimit with space chrout x ; output it ; SNAME USYSNM: move y,(j) ; get system name snmlup: movx x,%zeros ; zap out old cruft lshc x,wid. '_ ; siphon out a character addx x,<" > ; ASCIIify chrout x ; output the frob jumpn y,snmlup ; loop until done movx x,<" > ; delimit with space chrout x ; output it ; Status movx z,sixbit/STOP/ ; default to not running USTP: skipe (j) ; running? jrst gotsts ; got the status movx z,('RUN) ; runnable, try RUN status FLSINS: skipn (j) ; is job waiting? jrst chkrun ; no, what type of run? movx z,sixbit/PAGE/ ; could be paging USWST: movx x,(j) ; get swapping status txnn x,(200000) ; are we paging? jrst chkrna ; no, maybe some kind of run ; Got status gotsts: movx y,%zeros ; zap out old cruft lshc y,wid. '_ ; siphon out a character addx y,<" > ; ASCIIify chrout y ; output the frob jumpn z,gotsts ; loop until done movx x,<" > ; delimit with space chrout x ; output it ; % runtime JTMU: move x,(j) ; compute from scheduler priority mulx x,100. divx x,2.^6 idivx x,10. ; split off digits jumpe x,lord1 ; no leading zeros addx x,"0 ; ASCIIify high order chrout x ; stick in who line lord1: addx y,"0 ; ASCIIify low order chrout y ; ditto for low order movx x,"% ; funny character chrout x ; stick it in who line too movx x,<" > ; delimit with space chrout x ; output delimiter ; Runtime UTRNTM: move x,(j) ; get job runtime idivx x,25000. ; now in units of .1 seconds idivx x,36000. ; hours move z,y ; save other cruft idivx x,10. addx x,"0 chrout x addx y,"0 chrout y movx x,": chrout x move x,z idivx x,600. ; minutes move z,y ; save seconds and tenths idivx x,10. addx x,"0 chrout x addx y,"0 chrout y movx x,": chrout x move x,z idivx x,10. ; seconds move z,y ; save tenths idivx x,10. addx x,"0 chrout x addx y,"0 chrout y movx x,". chrout x addx z,"0 ; finally ASCIIify tenths chrout z ; and output it movx x,<" > chrout x ; Real and virtual pages NMPGS: move w,(j) ; job virtual pages NSWPGS: move x,(j) ; pages out subm w,x ; pages in idivx x,100. idivx y,10. jumpe x,[ jumpe y,lord2 jrst mord2] addx x,"0 chrout x mord2: addx y,"0 chrout y lord2: addx z,"0 chrout z movx x,"/ ; delimiter chrout x move x,w ; get number of virtual again idivx x,100. idivx y,10. jumpe x,[ jumpe y,lord3 jrst mord3] addx x,"0 chrout x mord3: addx y,"0 chrout y lord3: addx z,"0 chrout z movx x,"K ; indicate what this is chrout x ; Computed it, output the who-line type [R] ; restore cursor position movx b,line(440700) ; start at BOL syscal SIOT,[ clarg. tto ; output to TTY output channel b ? c] ; with normal randomness .lose %lssys ; sigh ; All done, back to sleep zzz: movx x,slptim*30. ; get number of frobs to sleep .sleep x, ; and sleep until time out jrst wholup ; and try try again subttl Status suboutines chkrun: UPC: move x,(j) ; job running: user mode? txne x,(%pcusr) ; if so, status is "RUN" jrst gotsts ; yup chkrna: SV40: move x,(j) ; else decode system call to get status hlrz y,x caxn y,(.call) jrst chkcal ; symbolic system call txz y,17_5 ; mask out AC field OPTION: move w,(j) txnn w,(%opdec) ; in 10/50 compatability mode? jrst itsuuo ; nope caxe y,40_9 ; INIT? caxn y,41_9 ; OPEN? jrst rnduuo ; random UUO caxn y,47_9 ; CALLI? jrst rnduuo itsuuo: caxn y,(.iot) ; .IOT  decode device in use jrst chkdev caxn y,(.oper) ; .OPER  decode address field jrst chkopr caxn y,(.call) ; .CALL but not symbolic  decode address jrst chkncl lsh y,-9 ; get number of this UUO subx y,40 caxl y, NUUOSX: cail y, rnduuo: skipa z,['UUO,,] ; random UUO UUOSXB: move z,(y) jrst uuosts ; Symbolic system call chkcal: LSCALL: move z,(j) ; use system call name as status caxe z,sixbit/SIOT/ caxn z,('IOT) jrst chksdv ; IOT, decode device name uuosts: skipe @FLSINS ; running? jrst gotsts lsh z,- ; stick + if running in system iorx z,sixbit/+/ ; (exec mode or hung) jrst gotsts ; and return ; New system call did an IOT chksdv: UUAC: skipl y,(j) jrst uuosts ; getting arguments, UUAC not set up yet move w,z ; save name jrst chkdv1 ; Old system call IOT chkdev: ldb y,[270400,,x] ; .IOT channel movx w,%zeros ; no saved name chkdv1: IOCHNM: addi y,(j) ; get IOCHNM word addr for channel move y,(y) ; get word contents hlrz z,y IOTTB: hll y,(y) ; LH gets direction, block/unit bits movx v,%zeros CLSTB: hll z,(y) %CLSJ: tlne z, ; job device? JBDEV: skipa z,(z) ; job device name DCHSTB: hllz z,(y) ; device name move x,[360600,,z] ildb u,x ; find first space in the name jumpn u,.-1 jumpge y,chkdv2 ; %iotbk  bit 4.9 movx u,'B ; block mode dpb u,x ibp x chkdv2: caxe w,sixbit/SIOT/ jrst chkdv3 movx u,'S dpb u,x ibp x chkdv3: movx u,'O ; follow with O or I for direction %IOTOT: tlnn y, movx u,'I dpb u,x jrst uuosts ; .OPER chkopr: hrrz y,x ; job is doing a .OPER MXOPR: cail y, jrst rnduuo OPRSXB: move z,(y) jrst uuosts ; .CALL chkncl: ldb y,[270400,,x] ; get AC field of .CALL CALSXB: move z,(y) ; sixbit name of .CALL jrst uuosts end wholin