Mercurial > hg > Members > kono > os9 > sbc09

comparison CoCoOS9/level2v3/CMDS/proc.asm @ 31:bd2b07db8917 cocoos9lv2v3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
CoCoOS9 version
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 14 Jul 2018 15:16:13 +0900
parents
children
comparison
equal deleted inserted replaced
30:7b1b25ff010a 31:bd2b07db8917
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