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