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