1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
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 ;
|
