|
965
|
1 ********************************************************************
|
|
|
2 * Proc - Show process information
|
|
|
3 *
|
|
|
4 * $Id$
|
|
|
5 *
|
|
|
6 * NOTE: SHOULD ADD IN TO HANDLE PRINTING NAME OF CURRENT MODULE
|
|
|
7 * RUNNING IN A RUNB or BASIC09 PROCESS
|
|
|
8 *
|
|
|
9 * From "Inside Level II" by Kevin Darling
|
|
|
10 *
|
|
|
11 * Ed. Comments Who YY/MM/DD
|
|
|
12 * ------------------------------------------------------------------
|
|
|
13 * 1 Original version KKD 88/10/28
|
|
|
14 * ? Modified to show status in English, stderr ??? 89/07/30
|
|
|
15 * and the system process
|
|
|
16 * 11 Modified to add current executing/editing LCB 94/11/08
|
|
|
17 * module name for Basic09 and/or RunB programs
|
|
|
18
|
|
|
19 nam Proc
|
|
|
20 ttl Show process information
|
|
|
21
|
|
|
22 ifp1
|
|
|
23 use defsfile
|
|
|
24 endc
|
|
|
25
|
|
|
26 Type set Prgrm+Objct
|
|
|
27 Revs set ReEnt+1
|
|
|
28 edition set 11
|
|
|
29
|
|
|
30 bufsiz set 512
|
|
|
31 stdout set 1
|
|
|
32
|
|
|
33 pag
|
|
|
34 ***************************************************
|
|
|
35 mod PrgSiz,Name,Type,Revs,Entry,DatSiz
|
|
|
36
|
|
|
37 Name fcs /Proc/
|
|
|
38 fcb edition
|
|
|
39
|
|
|
40 * Data Equates
|
|
|
41 umem rmb 2 Data mem ptr
|
|
|
42 sysimg rmb 2 pointer to sysprc datimg
|
|
|
43 datimg rmb 2 datimg for copymem
|
|
|
44 datimg2 rmb 2 2nd copy for non-descriptor use
|
|
|
45 basicflg rmb 1 Flag that primary module is BASIC09 or RUNB
|
|
|
46 outptr rmb 2 pointer in outbuf
|
|
|
47 number rmb 3
|
|
|
48 leadflag rmb 1
|
|
|
49 path rmb 3 stdin, stdout and stderr
|
|
|
50 pid rmb 1
|
|
|
51 namlen rmb 1
|
|
|
52 hdr rmb 64
|
|
|
53 outbuf rmb 80 Buffer for output string
|
|
|
54 buffer rmb bufsiz working proc. desc.
|
|
|
55 sysprc rmb bufsiz system proc. desc.
|
|
|
56 stack rmb 200
|
|
|
57 datsiz equ .
|
|
|
58
|
|
|
59 **************************************************
|
|
|
60 * Messages
|
|
|
61 * Headers
|
|
|
62 Header fcc " ID Prnt User Pty Age Tsk Status Signal Module I/O Paths "
|
|
|
63 fcb C$CR
|
|
|
64 Hdrlen equ *-Header
|
|
|
65
|
|
|
66 Header2 fcc /___ ____ ____ ___ ___ ___ _______ __ __ _________ __________________/
|
|
|
67 Hdrcr fcb C$CR
|
|
|
68 Hdrlen2 equ *-Header2
|
|
|
69
|
|
|
70 * State Strings (6 characters each)
|
|
|
71 Quesstr fcc /??????/
|
|
|
72 TimSlpSt fcc /TSleep/
|
|
|
73 TimOStr fcc /TimOut/
|
|
|
74 ImgChStr fcc /ImgChg/
|
|
|
75 SuspStr fcc /Suspnd/
|
|
|
76 CondmStr fcc /Condem/
|
|
|
77 DeadStr fcc /Dead /
|
|
|
78 Spaces fcc / /
|
|
|
79 SystmSt fcc /System /
|
|
|
80
|
|
|
81 * Special case module names
|
|
|
82 basic09 fcc 'BASIC'
|
|
|
83 b09sz equ *-basic09
|
|
|
84 runb fcc 'RUNB'
|
|
|
85 runbsz equ *-runb
|
|
|
86 basicms2 fcc ')'
|
|
|
87 fcb C$CR
|
|
|
88 Nomodule fcc 'Not Defined'
|
|
|
89 Nomodsz equ *-Nomodule
|
|
|
90
|
|
|
91 ************************************************
|
|
|
92 Entry stu <Umem save data mem ptr
|
|
|
93 lda #stdout Std out path=1
|
|
|
94 leax Hdrcr,PC print blank line
|
|
|
95 ldy #1
|
|
|
96 os9 I$WritLn
|
|
|
97 bcs Error
|
|
|
98 leax Header,pcr Print header line 1
|
|
|
99 ldy #Hdrlen
|
|
|
100 os9 I$WritLn
|
|
|
101 bcs Error
|
|
|
102 leax Header2,pcr Print header line 2
|
|
|
103 ldy #Hdrlen2
|
|
|
104 os9 I$WritLn
|
|
|
105 bcs Error
|
|
|
106 lda #1
|
|
|
107 leax >sysprc,U get system proc. desc.
|
|
|
108 os9 F$GPrDsc
|
|
|
109 bcs Error
|
|
|
110 leax P$DatImg,X just for its dat image
|
|
|
111 stx <sysimg
|
|
|
112 clra set <pid = start -1
|
|
|
113 sta <basicflg Default: not a RUNB or BASIC09
|
|
|
114 sta <pid
|
|
|
115
|
|
|
116 * Main Program Loop
|
|
|
117 Main ldu <umem Get data mem ptr
|
|
|
118 leax OutBuf,U Point to line buffer to print to screen
|
|
|
119 stx <outptr
|
|
|
120 inc <pid next process
|
|
|
121 beq Exit If wrapped, we are done
|
|
|
122 lda <pid get proc ID to check
|
|
|
123 leax Buffer,U Point to place to hold process dsc.
|
|
|
124 os9 F$GPrDsc Get it
|
|
|
125 bcs Main loop if no descriptor
|
|
|
126 bsr Output print data for descriptor
|
|
|
127 bra Main Do rest of descriptors
|
|
|
128
|
|
|
129 Exit clrb
|
|
|
130 Error os9 F$Exit
|
|
|
131
|
|
|
132 ***********************************************
|
|
|
133 * Subroutines
|
|
|
134 * Print Data re Process
|
|
|
135 * Entry: X=Ptr to buffer copy of process descriptor (Buffer,u)
|
|
|
136 Output lda P$ID,X process id
|
|
|
137 lbsr Outdecl print pid
|
|
|
138 lda P$PID,X parent's id
|
|
|
139 lbsr Outdecl
|
|
|
140 lbsr Spce
|
|
|
141 ldd P$User,X user id
|
|
|
142 lbsr Outdec
|
|
|
143 lbsr Spce
|
|
|
144 lda P$Prior,X priority
|
|
|
145 lbsr Outdecl
|
|
|
146 lbsr Spce
|
|
|
147 lda P$Age,X age
|
|
|
148 lbsr Outdecl
|
|
|
149 lbsr Spce
|
|
|
150 lbsr Spce
|
|
|
151 lda P$Task,X task no.
|
|
|
152 lbsr Out2HS
|
|
|
153 lbsr Spce
|
|
|
154 lda P$State,X state
|
|
|
155 pshs X save X
|
|
|
156 lbsr OutState
|
|
|
157 puls X restore x
|
|
|
158 lda P$Signal,X signal
|
|
|
159 lbsr Outdecl - in decimal
|
|
|
160 lbsr Spce
|
|
|
161 lda P$Signal,X signal
|
|
|
162 lbsr Out2HS - in hex
|
|
|
163 lbsr Spce
|
|
|
164 ldd P$Path,X get stdin and stdout
|
|
|
165 std <path
|
|
|
166 lda P$Path+2,X and stderr
|
|
|
167 sta <path+2
|
|
|
168 * Print primary module name
|
|
|
169 * IN: X - ptr to process descriptor copy (buffer,u)
|
|
|
170 leay P$DATImg,X
|
|
|
171 tfr Y,D d=dat image
|
|
|
172 std <datimg
|
|
|
173 std <datimg2 2nd copy for 2ndary name
|
|
|
174 lda <pid working on system process?
|
|
|
175 cmpa #1
|
|
|
176 beq Outp2 yes, print name
|
|
|
177 ldx P$PModul,X x=offset in map
|
|
|
178 ldb #9 set minimum space padded size of name
|
|
|
179 stb <namlen
|
|
|
180 lbsr Printnam Go append name to buffer
|
|
|
181 bra Outp3
|
|
|
182
|
|
|
183 Outp2 leax SystmSt,pcr print "System"
|
|
|
184 ldb #9 name length
|
|
|
185 lbsr PutSt1
|
|
|
186 * Print Standard input Device
|
|
|
187 Outp3 lbsr Spce
|
|
|
188 lda #'<
|
|
|
189 lbsr Print
|
|
|
190 lbsr Device
|
|
|
191 lda <path+1 get stdout
|
|
|
192 sta <path
|
|
|
193 lda #'>
|
|
|
194 lbsr Print
|
|
|
195 lbsr Device
|
|
|
196 Stderr lda <path+2 get stderr
|
|
|
197 sta <path
|
|
|
198 lda #'>
|
|
|
199 lbsr Print print first >
|
|
|
200 lda #'>
|
|
|
201 lbsr Print
|
|
|
202 bsr Device
|
|
|
203 * Print Line
|
|
|
204 ldx <outptr now print line
|
|
|
205 lda #C$CR
|
|
|
206 sta ,X terminate line with CR
|
|
|
207 ldu <umem
|
|
|
208 leax outbuf,U Print it (up to 80 chars)
|
|
|
209 ldy #80
|
|
|
210 lda #stdout
|
|
|
211 os9 I$Writln
|
|
|
212 lbcs Error
|
|
|
213 lda <basicflg Was module RUNB or BASIC09?
|
|
|
214 beq notbasic No, finished this entry
|
|
|
215 clr <basicflg Yes, clear out flag for 2nd call to Printnam
|
|
|
216 leax outbuf,u Point to output buffer start
|
|
|
217 ldd #$20*256+45 45 spaces
|
|
|
218 copylp sta ,x+ Put spaces into output buffer
|
|
|
219 decb Drop size counter
|
|
|
220 bne copylp Copy entire message
|
|
|
221 lda #'( Add opening parenthesis
|
|
|
222 sta ,x+
|
|
|
223 stx <outptr Save new output buffer ptr
|
|
|
224 ldd <datimg2 Get programs DAT img
|
|
|
225 std <datimg Save over descriptor one
|
|
|
226 ldx #$002f $002f in basic09 is ptr to current module
|
|
|
227 ldy #2 Just need ptr for now
|
|
|
228 ldu <umem
|
|
|
229 leau hdr,u Point to place to hold it
|
|
|
230 os9 F$CpyMem Get current module ptr
|
|
|
231 ldu <umem Get data mem ptr
|
|
|
232 ldx hdr,u Get ptr to module start in BASIC09 workspace
|
|
|
233 beq NotDef If 0, no 'current module' defined
|
|
|
234 lbsr Printnam Go append sub-module name to output buffer
|
|
|
235 bra printit Add closing chars & print it
|
|
|
236
|
|
|
237 NotDef ldx <outptr Get current output buffer ptr
|
|
|
238 leay Nomodule,pcr Point to 'Not Defined'
|
|
|
239 ldb #Nomodsz Size of message
|
|
|
240 Notlp lda ,y+ Copy it
|
|
|
241 sta ,x+
|
|
|
242 decb Until done
|
|
|
243 bne Notlp
|
|
|
244 stx <outptr Save output buffer ptr for below
|
|
|
245 printit ldd basicms2,pcr Get closing ')' + CR
|
|
|
246 ldx <outptr Get current output buffer ptr
|
|
|
247 std ,x Append to output buffer
|
|
|
248 ldu <umem
|
|
|
249 leax outbuf,U Print it (up to 80 chars)
|
|
|
250 ldy #80
|
|
|
251 lda #stdout
|
|
|
252 os9 I$Writln
|
|
|
253 lbcs Error
|
|
|
254 notbasic rts
|
|
|
255
|
|
|
256 * Print Character in A and Device Name
|
|
|
257 Device ldu <umem restore U
|
|
|
258 lda <path
|
|
|
259 bne Device2 if <path = 0, print spaces
|
|
|
260 leax Spaces,pcr
|
|
|
261 lbra PutStr
|
|
|
262
|
|
|
263 * Get device name
|
|
|
264 Device2 leau hdr,U get table offset in sys map
|
|
|
265 ldd <sysimg
|
|
|
266 ldx #D.PthDBT from direct page
|
|
|
267 ldy #2
|
|
|
268 os9 F$CpyMem
|
|
|
269 lbcs Error
|
|
|
270 ldx hdr get <path descriptor table
|
|
|
271 ldy #64
|
|
|
272 ldd <sysimg
|
|
|
273 os9 F$CpyMem
|
|
|
274 lbcs Error
|
|
|
275 ldb <path point to <path block
|
|
|
276 lsrb four <paths/ block
|
|
|
277 lsrb
|
|
|
278 lda B,U a=msb block addr.
|
|
|
279 pshs A
|
|
|
280 ldb <path point to <path
|
|
|
281 andb #3
|
|
|
282 lda #$40
|
|
|
283 mul
|
|
|
284 puls A d= <path descriptor address
|
|
|
285 addb #PD.Dev get device table pointer
|
|
|
286 tfr D,X
|
|
|
287 ldd <sysimg
|
|
|
288 ldy #2
|
|
|
289 os9 F$CpyMem
|
|
|
290 lbcs Error
|
|
|
291 ldx hdr x= dev. table entry sys.
|
|
|
292 ldb #V$Desc we want descr. pointer
|
|
|
293 abx
|
|
|
294 ldd <sysimg
|
|
|
295 ldy #2
|
|
|
296 os9 F$CpyMem
|
|
|
297 lbcs Error
|
|
|
298 ldx hdr get descriptor addr.
|
|
|
299 ldu <umem
|
|
|
300 ldd <sysimg
|
|
|
301 std <datimg
|
|
|
302 ldb #5
|
|
|
303 stb <namlen
|
|
|
304 ** Find and print a module name
|
|
|
305 * IN: X - module offset
|
|
|
306 * U - data area
|
|
|
307 * <datimg = pointer
|
|
|
308 * Read module header
|
|
|
309 Printnam pshs U save u
|
|
|
310 leau hdr,U destination
|
|
|
311 ldd <datimg proc <datimg pointer
|
|
|
312 ldy #10 set length (M$Name ptr is @ 4)
|
|
|
313 os9 F$CpyMem Get 1st 10 bytes of module header
|
|
|
314 lbcs Error
|
|
|
315 * Read name from Module to buffer
|
|
|
316 ldd M$Name,U get name offset from header
|
|
|
317 ldu <outptr move name to outbuf
|
|
|
318 leax D,X X - offset to name
|
|
|
319 ldd <datimg
|
|
|
320 ldy #40 max length of name we will accept
|
|
|
321 os9 F$CpyMem Get copy of module name
|
|
|
322 puls U
|
|
|
323 lbcs Error
|
|
|
324
|
|
|
325 pshs X
|
|
|
326 ldx <outptr
|
|
|
327 pshs X Save start of module name ptr
|
|
|
328 clrb set length = 0
|
|
|
329 Name3 incb Bump up # chars long name is
|
|
|
330 lda ,X+ Get char from module name
|
|
|
331 bpl Name3 No hi-bit terminator yet, keep checking
|
|
|
332 cmpb #40 Done, is it >39 chars?
|
|
|
333 bhs Name5 Yes, skip ahead
|
|
|
334 anda #$7F Take out hi-bit
|
|
|
335 sta -1,X Save char back without hi-bit
|
|
|
336 cmpb <namlen Bigger than max name size we allow?
|
|
|
337 bhs Name5 No, skip ahead
|
|
|
338 lda #C$SPAC If smaller, pad with spaces
|
|
|
339 Name4 sta ,X+
|
|
|
340 incb
|
|
|
341 cmpb <namlen
|
|
|
342 blo Name4
|
|
|
343 Name5 stx <outptr Save new output buffer ptr
|
|
|
344 lda <basicflg Are we here doing a basic09 sub-module?
|
|
|
345 bne notbas Yes, don't get stuck in recursive loop
|
|
|
346 ldx ,s Get ptr to start of module name again
|
|
|
347 leay basic09,pcr Check for BASIC09 1st
|
|
|
348 ldb #b09sz Size of module to check
|
|
|
349 chkb09lp lda ,x+ Get char from module name
|
|
|
350 anda #$df Force to uppercase
|
|
|
351 cmpa ,y+ Same as one for BASIC09?
|
|
|
352 bne chkrunb No, check runb
|
|
|
353 decb Done 'BASIC' yet?
|
|
|
354 bne chkb09lp No, keep checking
|
|
|
355 ldd ,x++ Get last 2 chars from name
|
|
|
356 cmpd #$3039 '09'?
|
|
|
357 bne chkrunb No, try runb
|
|
|
358 lda ,x Next char space (end of name)?
|
|
|
359 cmpa #C$SPAC
|
|
|
360 beq setflag Yes, set basic09 flag
|
|
|
361 chkrunb leay runb,pcr Point to 'runb'
|
|
|
362 ldb #runbsz
|
|
|
363 ldx ,s Get ptr to name in buffer
|
|
|
364 chkrunlp lda ,x+ Get char
|
|
|
365 anda #$df Force to uppercase
|
|
|
366 cmpa ,y+ Match?
|
|
|
367 bne notbas No, not either basic
|
|
|
368 decb Done whole check?
|
|
|
369 bne chkrunlp No, keep checking
|
|
|
370 setflag sta <basicflg Set basic09 flag
|
|
|
371 notbas leas 2,s Eat start of module name ptr
|
|
|
372 puls X,PC Restore X & return
|
|
|
373
|
|
|
374 * Print Hexidecimal Digit in D
|
|
|
375 Out4HS pshs B
|
|
|
376 bsr Hexl
|
|
|
377 puls A
|
|
|
378 Out2HS bsr Hexl
|
|
|
379
|
|
|
380 Spce lda #C$SPAC
|
|
|
381 bra Print
|
|
|
382
|
|
|
383 * Print Hexidecimal Digit in A
|
|
|
384 Hexl tfr A,B
|
|
|
385 lsra
|
|
|
386 lsra
|
|
|
387 lsra
|
|
|
388 lsra
|
|
|
389 bsr Outhex
|
|
|
390 tfr B,A
|
|
|
391 Outhex anda #$0F
|
|
|
392 cmpa #$0A 0 - 9
|
|
|
393 bcs Outdig
|
|
|
394 adda #$07 A - F
|
|
|
395 Outdig adda #'0 make ASCII
|
|
|
396
|
|
|
397 Print pshs X
|
|
|
398 ldx <outptr
|
|
|
399 sta ,X+
|
|
|
400 stx <outptr
|
|
|
401 puls X,PC
|
|
|
402
|
|
|
403 * Print 1 Decimal Digit in B
|
|
|
404 *
|
|
|
405 Outdecl tfr A,B <number to B
|
|
|
406 clra
|
|
|
407
|
|
|
408 * Print 2 Decimal Digits in D
|
|
|
409 Outdec clr <leadflag
|
|
|
410 pshs X
|
|
|
411 ldx <umem
|
|
|
412 leax <number,X
|
|
|
413 clr ,X
|
|
|
414 clr 1,X
|
|
|
415 clr 2,X
|
|
|
416 Hundred inc ,X
|
|
|
417 subd #100
|
|
|
418 bcc Hundred
|
|
|
419 addd #100
|
|
|
420 Ten inc 1,X
|
|
|
421 subd #10
|
|
|
422 bcc Ten
|
|
|
423 addd #10
|
|
|
424 incb
|
|
|
425 stb 2,X
|
|
|
426 bsr Printled
|
|
|
427 bsr Printled
|
|
|
428 bsr Printnum
|
|
|
429 bsr Spce
|
|
|
430 puls X,PC
|
|
|
431
|
|
|
432 Printnum lda ,X+ get char
|
|
|
433 adda #$30-1 make ASCII
|
|
|
434 bra Print
|
|
|
435
|
|
|
436 Printled tst <leadflag print leading zero?
|
|
|
437 bne Printnum yes
|
|
|
438 ldb ,X is it zero?
|
|
|
439 inc <leadflag
|
|
|
440 decb
|
|
|
441 bne Printnum no, print zeros
|
|
|
442 clr <leadflag
|
|
|
443 lda #C$SPAC
|
|
|
444 leax 1,X
|
|
|
445 bra Print
|
|
|
446
|
|
|
447 * Print process state in English
|
|
|
448 * IN: A = P$State
|
|
|
449 OutState tfr A,B
|
|
|
450 bitb #SysState system?
|
|
|
451 beq OutSt1 no
|
|
|
452 lda #'s s = System state
|
|
|
453 bra OutSt2
|
|
|
454
|
|
|
455 OutSt1 lda #C$SPAC
|
|
|
456
|
|
|
457 OutSt2 bsr Print
|
|
|
458 bitb #TimSleep
|
|
|
459 bne PTimSlp
|
|
|
460 bitb #TimOut
|
|
|
461 bne PTimOut
|
|
|
462 bitb #ImgChg
|
|
|
463 bne PImgCh
|
|
|
464 bitb #Suspend
|
|
|
465 bne PSuspnd
|
|
|
466 bitb #Condem
|
|
|
467 bne PCondem
|
|
|
468 bitb #Dead
|
|
|
469 bne PDead
|
|
|
470 bitb #$04
|
|
|
471 bne PQues
|
|
|
472 leax Spaces,pcr nothing to report
|
|
|
473 bra PutStr
|
|
|
474
|
|
|
475 PQues leax QuesStr,pcr
|
|
|
476 bra PutStr
|
|
|
477
|
|
|
478 PTimSlp leax TimSlpSt,pcr
|
|
|
479 bra PutStr
|
|
|
480
|
|
|
481 PTimOut leax TimOStr,pcr
|
|
|
482 bra PutStr
|
|
|
483
|
|
|
484 PImgCh leax ImgChStr,pcr
|
|
|
485 bra PutStr
|
|
|
486
|
|
|
487 PSuspnd leax SuspStr,pcr
|
|
|
488 bra PutStr
|
|
|
489
|
|
|
490 PCondem leax Condmstr,pcr
|
|
|
491 bra PutStr
|
|
|
492
|
|
|
493 PDead leax Deadstr,pcr
|
|
|
494
|
|
|
495 Putstr ldb #6 six characters
|
|
|
496
|
|
|
497 Putst1 lda ,X+
|
|
|
498 lbsr Print
|
|
|
499 decb
|
|
|
500 bne PutSt1
|
|
|
501 rts
|
|
|
502
|
|
|
503 emod
|
|
|
504 Prgsiz equ *
|
|
|
505 end
|
