--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CoCoOS9/level2v3/CMDS/proc.asm	Sat Jul 14 15:16:13 2018 +0900
@@ -0,0 +1,507 @@
+********************************************************************
+* Proc - Show process information
+*
+* $Id: proc.asm,v 1.1.1.1 2001/02/21 23:30:54 boisy Exp $
+*
+* NOTE: SHOULD ADD IN TO HANDLE PRINTING NAME OF CURRENT MODULE
+*       RUNNING IN A RUNB or BASIC09 PROCESS
+*
+* From "Inside Level II" by Kevin Darling
+*
+* Ed.    Comments                                       Who YY/MM/DD
+* ------------------------------------------------------------------
+* 1      Original version                               KKD 88/10/28
+* ?      Modified to show status in English, stderr     ??? 89/07/30
+*        and the system process
+* 11     Modified to add current executing/editing      LCB 94/11/08
+*        module name for Basic09 and/or RunB programs
+
+         nam   Proc
+         ttl   Show process information
+
+         ifp1  
+         use   defsfile
+         endc  
+
+Type     set   Prgrm+Objct
+Revs     set   ReEnt+1
+edition  set   11
+
+bufsiz   set   512
+CR       set   $0D
+Spc      set   $20
+stdout   set   1
+
+         pag   
+***************************************************
+         mod   PrgSiz,Name,Type,Revs,Entry,DatSiz
+
+Name     fcs   /Proc/
+         fcb   edition
+
+* Data Equates
+umem     rmb   2          Data mem ptr
+sysimg   rmb   2          pointer to sysprc datimg
+datimg   rmb   2          datimg for copymem
+datimg2  rmb   2          2nd copy for non-descriptor use
+basicflg rmb   1          Flag that primary module is BASIC09 or RUNB
+outptr   rmb   2          pointer in outbuf
+number   rmb   3
+leadflag rmb   1
+path     rmb   3          stdin, stdout and stderr
+pid      rmb   1
+namlen   rmb   1
+hdr      rmb   64
+outbuf   rmb   80         Buffer for output string
+buffer   rmb   bufsiz     working proc. desc.
+sysprc   rmb   bufsiz     system proc. desc.
+stack    rmb   200
+datsiz   equ   .
+
+**************************************************
+* Messages
+* Headers
+Header   fcc   " ID Prnt User Pty  Age  Tsk  Status  Signal   Module    I/O Paths "
+         fcb   CR
+Hdrlen   equ   *-Header
+
+Header2  fcc   /___ ____ ____ ___  ___  ___  _______ __  __  _________ __________________/
+Hdrcr    fcb   CR
+Hdrlen2  equ   *-Header2
+
+* State Strings (6 characters each)
+Quesstr  fcc   /??????/
+TimSlpSt fcc   /TSleep/
+TimOStr  fcc   /TimOut/
+ImgChStr fcc   /ImgChg/
+SuspStr  fcc   /Suspnd/
+CondmStr fcc   /Condem/
+DeadStr  fcc   /Dead          /
+Spaces   fcc   /              /
+SystmSt  fcc   /System        /
+
+* Special case module names
+basic09  fcc   'BASIC'
+b09sz    equ   *-basic09
+runb     fcc   'RUNB'
+runbsz   equ   *-runb
+basicms2 fcc   ')'
+         fcb   CR
+Nomodule fcc   'Not Defined'
+Nomodsz  equ   *-Nomodule
+
+************************************************
+Entry    stu   <Umem      save data mem ptr
+         lda   #stdout    Std out path=1
+         leax  Hdrcr,PC   print blank line
+         ldy   #1
+         os9   I$WritLn
+         bcs   Error
+         leax  Header,pcr  Print header line 1
+         ldy   #Hdrlen
+         os9   I$WritLn
+         bcs   Error
+         leax  Header2,pcr Print header line 2
+         ldy   #Hdrlen2
+         os9   I$WritLn
+         bcs   Error
+         lda   #1
+         leax  >sysprc,U  get system proc. desc.
+         os9   F$GPrDsc
+         bcs   Error
+         leax  P$DatImg,X just for its dat image
+         stx   <sysimg
+         clra             set <pid = start -1
+         sta   <basicflg  Default: not a RUNB or BASIC09
+         sta   <pid
+
+* Main Program Loop
+Main     ldu   <umem      Get data mem ptr
+         leax  OutBuf,U   Point to line buffer to print to screen
+         stx   <outptr
+         inc   <pid       next process
+         beq   Exit       If wrapped, we are done
+         lda   <pid       get proc ID to check 
+         leax  Buffer,U   Point to place to hold process dsc.
+         os9   F$GPrDsc   Get it
+         bcs   Main       loop if no descriptor
+         bsr   Output     print data for descriptor
+         bra   Main       Do rest of descriptors
+
+Exit     clrb  
+Error    os9   F$Exit
+
+***********************************************
+*  Subroutines
+* Print Data re Process
+* Entry: X=Ptr to buffer copy of process descriptor (Buffer,u)
+Output   lda   P$ID,X     process id
+         lbsr  Outdecl    print pid
+         lda   P$PID,X    parent's id
+         lbsr  Outdecl
+         lbsr  Spce
+         ldd   P$User,X   user id
+         lbsr  Outdec
+         lbsr  Spce
+         lda   P$Prior,X  priority
+         lbsr  Outdecl
+         lbsr  Spce
+         lda   P$Age,X    age
+         lbsr  Outdecl
+         lbsr  Spce
+         lbsr  Spce
+         lda   P$Task,X   task no.
+         lbsr  Out2HS
+         lbsr  Spce
+         lda   P$State,X  state
+         pshs  X          save X
+         lbsr  OutState
+         puls  X          restore x
+         lda   P$Signal,X signal
+         lbsr  Outdecl    - in decimal
+         lbsr  Spce
+         lda   P$Signal,X signal
+         lbsr  Out2HS     - in hex
+         lbsr  Spce
+         ldd   P$Path,X   get stdin and stdout
+         std   <path
+         lda   P$Path+2,X and stderr
+         sta   <path+2
+* Print primary module name
+* IN: X - ptr to process descriptor copy (buffer,u)
+         leay  P$DATImg,X
+         tfr   Y,D        d=dat image
+         std   <datimg
+         std   <datimg2   2nd copy for 2ndary name
+         lda   <pid       working on system process?
+         cmpa  #1
+         beq   Outp2      yes, print name
+         ldx   P$PModul,X x=offset in map
+         ldb   #9         set minimum space padded size of name
+         stb   <namlen
+         lbsr  Printnam   Go append name to buffer
+         bra   Outp3
+
+Outp2    leax  SystmSt,pcr print "System"
+         ldb   #9         name length
+         lbsr  PutSt1
+* Print Standard input Device
+Outp3    lbsr  Spce
+         lda   #'<
+         lbsr  Print
+         lbsr  Device
+         lda   <path+1    get stdout
+         sta   <path
+         lda   #'>
+         lbsr  Print
+         lbsr  Device
+Stderr   lda   <path+2    get stderr
+         sta   <path
+         lda   #'>
+         lbsr  Print      print first >
+         lda   #'>
+         lbsr  Print
+         bsr   Device
+* Print Line
+         ldx   <outptr    now print line
+         lda   #CR
+         sta   ,X         terminate line with CR
+         ldu   <umem
+         leax  outbuf,U   Print it (up to 80 chars)
+         ldy   #80
+         lda   #stdout
+         os9   I$Writln
+         lbcs  Error
+         lda   <basicflg  Was module RUNB or BASIC09?
+         beq   notbasic   No, finished this entry
+         clr   <basicflg  Yes, clear out flag for 2nd call to Printnam
+         leax  outbuf,u   Point to output buffer start
+         ldd   #$20*256+45 45 spaces
+copylp   sta   ,x+        Put spaces into output buffer
+         decb             Drop size counter
+         bne   copylp     Copy entire message
+         lda   #'(        Add opening parenthesis
+         sta   ,x+
+         stx   <outptr    Save new output buffer ptr
+         ldd   <datimg2   Get programs DAT img
+         std   <datimg    Save over descriptor one
+         ldx   #$002f     $002f in basic09 is ptr to current module
+         ldy   #2         Just need ptr for now
+         ldu   <umem
+         leau  hdr,u      Point to place to hold it
+         os9   F$CpyMem   Get current module ptr
+         ldu   <umem      Get data mem ptr
+         ldx   hdr,u      Get ptr to module start in BASIC09 workspace
+         beq   NotDef     If 0, no 'current module' defined
+         lbsr  Printnam   Go append sub-module name to output buffer
+         bra   printit    Add closing chars & print it
+
+NotDef   ldx   <outptr    Get current output buffer ptr
+         leay  Nomodule,pcr Point to 'Not Defined'
+         ldb   #Nomodsz   Size of message
+Notlp    lda   ,y+        Copy it
+         sta   ,x+
+         decb             Until done
+         bne   Notlp
+         stx   <outptr    Save output buffer ptr for below
+printit  ldd   basicms2,pcr Get closing ')' + CR
+         ldx   <outptr    Get current output buffer ptr
+         std   ,x         Append to output buffer
+         ldu   <umem
+         leax  outbuf,U   Print it (up to 80 chars)
+         ldy   #80
+         lda   #stdout
+         os9   I$Writln
+         lbcs  Error
+notbasic rts   
+
+* Print Character in A and Device Name
+Device   ldu   <umem      restore U
+         lda   <path
+         bne   Device2    if <path = 0, print spaces
+         leax  Spaces,pcr
+         lbra  PutStr
+
+* Get device name
+Device2  leau  hdr,U      get table offset in sys map
+         ldd   <sysimg
+         ldx   #D.PthDBT  from direct page
+         ldy   #2
+         os9   F$CpyMem
+         lbcs  Error
+         ldx   hdr        get <path descriptor table
+         ldy   #64
+         ldd   <sysimg
+         os9   F$CpyMem
+         lbcs  Error
+         ldb   <path      point to <path block
+         lsrb             four           <paths/ block
+         lsrb  
+         lda   B,U        a=msb block addr.
+         pshs  A
+         ldb   <path      point to <path
+         andb  #3
+         lda   #$40
+         mul   
+         puls  A          d= <path descriptor address
+         addb  #PD.Dev    get device table pointer
+         tfr   D,X
+         ldd   <sysimg
+         ldy   #2
+         os9   F$CpyMem
+         lbcs  Error
+         ldx   hdr        x= dev. table entry sys.
+         ldb   #V$Desc    we want descr. pointer
+         abx   
+         ldd   <sysimg
+         ldy   #2
+         os9   F$CpyMem
+         lbcs  Error
+         ldx   hdr        get descriptor addr.
+         ldu   <umem
+         ldd   <sysimg
+         std   <datimg
+         ldb   #5
+         stb   <namlen
+** Find and print a module name
+* IN:  X - module offset
+*      U - data area
+*      <datimg = pointer
+* Read module header
+Printnam pshs  U          save u
+         leau  hdr,U      destination
+         ldd   <datimg    proc <datimg pointer
+         ldy   #10        set length (M$Name ptr is @ 4)
+         os9   F$CpyMem   Get 1st 10 bytes of module header
+         lbcs  Error
+* Read name from Module to buffer
+         ldd   M$Name,U   get name offset from header
+         ldu   <outptr    move name to outbuf
+         leax  D,X        X - offset to name
+         ldd   <datimg
+         ldy   #40        max length of name we will accept
+         os9   F$CpyMem   Get copy of module name
+         puls  U
+         lbcs  Error
+
+         pshs  X
+         ldx   <outptr
+         pshs  X          Save start of module name ptr
+         clrb             set            length = 0
+Name3    incb             Bump up # chars long name is
+         lda   ,X+        Get char from module name
+         bpl   Name3      No hi-bit terminator yet, keep checking
+         cmpb  #40        Done, is it >39 chars?
+         bhs   Name5      Yes, skip ahead
+         anda  #$7F       Take out hi-bit
+         sta   -1,X       Save char back without hi-bit
+         cmpb  <namlen    Bigger than max name size we allow?
+         bhs   Name5      No, skip ahead
+         lda   #Spc       If smaller, pad with spaces
+Name4    sta   ,X+
+         incb  
+         cmpb  <namlen
+         blo   Name4
+Name5    stx   <outptr    Save new output buffer ptr
+         lda   <basicflg  Are we here doing a basic09 sub-module?
+         bne   notbas     Yes, don't get stuck in recursive loop
+         ldx   ,s         Get ptr to start of module name again
+         leay  basic09,pcr Check for BASIC09 1st
+         ldb   #b09sz     Size of module to check           
+chkb09lp lda   ,x+        Get char from module name
+         anda  #$df       Force to uppercase
+         cmpa  ,y+        Same as one for BASIC09?
+         bne   chkrunb    No, check runb
+         decb             Done 'BASIC' yet?
+         bne   chkb09lp   No, keep checking
+         ldd   ,x++       Get last 2 chars from name
+         cmpd  #$3039     '09'?
+         bne   chkrunb    No, try runb
+         lda   ,x         Next char space (end of name)?
+         cmpa  #$20
+         beq   setflag    Yes, set basic09 flag
+chkrunb  leay  runb,pcr    Point to 'runb'
+         ldb   #runbsz
+         ldx   ,s         Get ptr to name in buffer
+chkrunlp lda   ,x+        Get char
+         anda  #$df       Force to uppercase
+         cmpa  ,y+        Match?
+         bne   notbas     No, not either basic
+         decb             Done whole check?
+         bne   chkrunlp   No, keep checking
+setflag  sta   <basicflg  Set basic09 flag
+notbas   leas  2,s        Eat start of module name ptr
+         puls  X,PC       Restore X & return
+
+* Print Hexidecimal Digit in D
+Out4HS   pshs  B
+         bsr   Hexl
+         puls  A
+Out2HS   bsr   Hexl
+
+Spce     lda   #Spc
+         bra   Print
+
+* Print Hexidecimal Digit in A
+Hexl     tfr   A,B
+         lsra  
+         lsra  
+         lsra  
+         lsra  
+         bsr   Outhex
+         tfr   B,A
+Outhex   anda  #$0F
+         cmpa  #$0A       0 - 9
+         bcs   Outdig
+         adda  #$07       A - F
+Outdig   adda  #'0        make ASCII
+
+Print    pshs  X
+         ldx   <outptr
+         sta   ,X+
+         stx   <outptr
+         puls  X,PC
+
+* Print 1 Decimal Digit in B
+*
+Outdecl  tfr   A,B        <number to B
+         clra  
+
+* Print 2 Decimal Digits in D
+Outdec   clr   <leadflag
+         pshs  X
+         ldx   <umem
+         leax  <number,X
+         clr   ,X
+         clr   1,X
+         clr   2,X
+Hundred  inc   ,X
+         subd  #100
+         bcc   Hundred
+         addd  #100
+Ten      inc   1,X
+         subd  #10
+         bcc   Ten
+         addd  #10
+         incb  
+         stb   2,X
+         bsr   Printled
+         bsr   Printled
+         bsr   Printnum
+         bsr   Spce
+         puls  X,PC
+
+Printnum lda   ,X+        get char
+         adda  #$30-1     make ASCII
+         bra   Print
+
+Printled tst   <leadflag  print leading zero?
+         bne   Printnum   yes
+         ldb   ,X         is it zero?
+         inc   <leadflag
+         decb  
+         bne   Printnum   no, print zeros
+         clr   <leadflag
+         lda   #Spc
+         leax  1,X
+         bra   Print
+
+* Print process state in English
+*  IN:  A = P$State
+OutState tfr   A,B
+         bitb  #SysState  system?
+         beq   OutSt1     no
+         lda   #'s        s = System state
+         bra   OutSt2
+
+OutSt1   lda   #Spc
+
+OutSt2   bsr   Print
+         bitb  #TimSleep
+         bne   PTimSlp
+         bitb  #TimOut
+         bne   PTimOut
+         bitb  #ImgChg
+         bne   PImgCh
+         bitb  #Suspend
+         bne   PSuspnd
+         bitb  #Condem
+         bne   PCondem
+         bitb  #Dead
+         bne   PDead
+         bitb  #$04
+         bne   PQues
+         leax  Spaces,pcr  nothing to report
+         bra   PutStr
+
+PQues    leax  QuesStr,pcr
+         bra   PutStr
+
+PTimSlp  leax  TimSlpSt,pcr
+         bra   PutStr
+
+PTimOut  leax  TimOStr,pcr
+         bra   PutStr
+
+PImgCh   leax  ImgChStr,pcr
+         bra   PutStr
+
+PSuspnd  leax  SuspStr,pcr
+         bra   PutStr
+
+PCondem  leax  Condmstr,pcr
+         bra   PutStr
+
+PDead    leax  Deadstr,pcr
+
+Putstr   ldb   #6         six characters
+
+Putst1   lda   ,X+
+         lbsr  Print
+         decb  
+         bne   PutSt1
+         rts   
+
+         emod  
+Prgsiz   equ   *
+         end