1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-19 01:27:05 +00:00
PDP-10.its/src/sysen2/wholin.53
Eric Swenson ffcc79dd16 Added WHOLIN.
Resolves #319.
2016-12-21 12:11:04 +01:00

388 lines
8.9 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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,<squoze 0,sym>
.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,<squoze 0,sym>
.eval x, ; get value of this symbol
.lose ; failed?
addm x,sym ; save index
termin
movx L,<squoze 0,LUBLK> ; 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,-<wid. '_> ; 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