PACKET x taskinfo DEFINES x task status , (* M.Staubermann 1.8.0, 861009*)
x task info :
INT PROC pcf (TASK CONST t, INT CONST byte) :
TEXT VAR word := " " ;
replace (word, 1, pcb (t, byte DIV 2 + 17)) ;
IF (byte AND 1) = 0 THEN code (word SUB 1)
ELSE code (word SUB 2)
FI
ENDPROC pcf ;
TEXT PROC xstatus (TASK CONST task, INT CONST depth) :
TEXT VAR zeile := ".................." ,
task name := name (task) ;
change (zeile, 1, length (task name) + depth , depth * " " + task name) ;
task name := zeile ;
zeile CAT " " + hex16 (pcb (task, 9)) + "-" + hex8 (pcb (task, 10)) ;
IF bit (pcf (task, 5), 7) (* ^ tasknr & version *)
THEN zeile CAT "x"
ELSE zeile CAT " "
FI ;
IF bit (pcf (task, 5), 0)
THEN zeile CAT "h" (* comflg *)
ELSE zeile CAT " " (* haltprocess liegt an *)
FI ;
zeile CAT status (pcf (task, 6)) ; (* status *)
zeile CAT " " + bin (pcf (task, 7), 3, 7) ; (* statusflags rstflg *)
INT CONST pcf 11 :: pcf (task, 11) ;
IF bit (pcf 11, 7) (* iserror *)
THEN zeile CAT " e"
ELSE zeile CAT " n"
FI ;
IF bit (pcf 11, 6) (* disablestop *)
THEN zeile CAT "d"
ELSE zeile CAT "e"
FI ;
IF bit (pcf 11, 5) (* unbelegt *)
THEN zeile CAT "*"
ELSE zeile CAT " "
FI ;
IF bit (pcf 11, 4) (* arith 16 *)
THEN zeile CAT "u" (* unsigned *)
ELSE zeile CAT "s" (* signed *)
FI ;
zeile CAT " " + text (pcf 11 AND 3) ; (* codesegment *)
zeile CAT hex8 (pcf (task, 10)) + hex8 (pcf (task, 9)) ; (* icount *)
zeile CAT " " + text (pcb (task, 28) AND 15) ; (* heapsegment *)
zeile CAT hex16 (pcb (task, 28) AND -16) ; (* heaptop *)
zeile CAT " " + hex16 (pcb (task, 23)) ; (* mod *)
zeile CAT text (pcb (task, 4), 4) ; (* channel *)
zeile CAT text (pcb (task, 1), 4) ; (* linenr *)
zeile CAT text (pcb (task, 2), 4) ; (* errorline *)
zeile CAT text (pcb (task, 3), 4) ; (* errorcode *)
zeile CAT text (pcb (task, 7), 4) ; (* msgcode *)
zeile CAT " " + hex16 (pcb (task, 8)) ; (* msgds *)
zeile CAT " " + hex16 (pcb (task, 11)) + "-" + hex8 (pcb (task, 12)) ;
zeile CAT " " + hex8 (pcf (task, 29)) ; (* priv *)
zeile CAT " " + hex8 (pcf (task, 14)) ; (* pbas *) (* ^ fromid *)
zeile CAT " " + hex8 (pcf (task, 15)) ; (* c8k *)
zeile CAT " " + hex16 (pcb (task, 25)) ; (* lbas *)
zeile CAT " " + hex16 (pcb (task, 26)) ; (* ltop *)
zeile CAT " " + hex16 (pcb (task, 27)) ; (* ls_top *)
zeile CAT text (pcb (task, 6), 3) ; (* prio *)
zeile CAT " " + hex8 (pcf (task, 28)) ; (* priclk *)
zeile CAT " " + hex8 (pcf (task, 8)) ; (* pricnt *)
zeile CAT " " + hex16(pcb (task, 17)) + hex16 (pcb (task, 18)) ;
zeile CAT " " + hex8 (pcf (task, 4)) ; (* millis *) (* ^ wstate *)
zeile
ENDPROC xstatus ;
TEXT PROC status (INT CONST wert) :
stat + blocked .
stat:
SELECT (wert AND 60) DIV 4 OF
CASE 0 : "INTER"
CASE 1 : "OUT "
CASE 2 : "INCHR"
CASE 3 : "PAUSE"
CASE 4 : "RTN T"
CASE 5 : "RTN F"
CASE 6 : "CALL "
CASE 7 : "RTN "
CASE 8 : "CHGB1"
CASE 9 : "CHGB2"
CASE 10: "CHGB3"
CASE 15: IF wert = 255 THEN "-DEAD" ELSE "WAIT " FI
OTHERWISE "?? "+hex8 (wert AND 252)
ENDSELECT .
blocked:
IF (wert AND 1) = 1
THEN "-B"
ELSE " "
FI
ENDPROC status ;
TEXT PROC hex8 (INT CONST wert) :
hex digit (wert DIV 16) +
hex digit (wert AND 15)
ENDPROC hex8 ;
TEXT PROC hex16 (INT CONST wert) :
TEXT VAR t := " " ;
replace (t, 1, wert) ;
hex digit (code (t SUB 2) DIV 16) +
hex digit (code (t SUB 2) AND 15) +
hex digit (code (t SUB 1) DIV 16) +
hex digit (code (t SUB 1) AND 15)
ENDPROC hex16 ;
TEXT PROC hex digit (INT CONST wert) :
"0123456789ABCDEF" SUB (wert+1)
ENDPROC hex digit ;
TEXT PROC bin (INT CONST wert, from, to) :
INT VAR i ;
TEXT VAR t := "" ;
FOR i FROM to DOWNTO from REP
IF bit (wert, i) THEN t CAT "1"
ELSE t CAT "0"
FI
PER ;
t
ENDPROC bin ;
PROC x task info (FILE VAR list file) :
access catalogue ;
put (list file, date) ;
put (list file, " ") ;
put (list file, time of day) ;
put (list file, " Size:") ;
INT VAR size, used ;
storage (size, used) ;
put (list file, size) ;
put (list file, "K Used:") ;
put (list file, used) ;
put (list file, "K ") ;
line (list file) ;
put (list file, "TASK ") ;
put (list file, "taskid xhstatus rstflg edxa icount hptop mod chn") ;
write (list file, "lin eln ecd mcd mgds fromid prvpbs c8k lbs ltoplstop");
put (list file, "pripck pct wstate mls") ;
line (list file) ;
list tree (list file, supervisor, 0)
ENDPROC x task info ;
DATASPACE VAR ds ;
PROC x task info :
disable stop ;
ds := nilspace ;
FILE VAR list file := sequentialfile (output, ds) ;
max line length (list file, 1000) ;
x task info (list file) ;
edit (list file) ;
forget (ds) ;
ENDPROC x task info ;
PROC list tree (FILE VAR list file, TASK CONST first son, INT CONST depth) :
enable stop ;
TASK VAR actual task := first son ;
WHILE NOT isniltask (actual task) REP
list actual task ;
list tree (list file, son (actual task), depth + 1) ;
actual task := brother (actual task)
PER .
list actual task :
putline (list file, x status (actual task, depth))
ENDPROC list tree ;
PROC x task status (TASK CONST t) :
TEXT VAR zeile := x status (t, 0) ;
line ;
put ("Task:") ; putline (name (t)) ;
putline ("taskid xhstatus rstflg edxa icount hptop mod chn lin eln ecd") ;
putline (subtext (zeile, 20, 80)) ;
putline ("mcd mgds fromid prvpbs c8k lbs ltoplstoppripck pct wstate mls") ;
putline (subtext (zeile, 81)) ;
line
ENDPROC x task status ;
PROC x task status :
x task status (myself)
ENDPROC x task status ;
ENDPACKET x task info ;