--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CoCoOS9/level2v3/CMDS/idir.asm	Sat Jul 14 15:16:13 2018 +0900
@@ -0,0 +1,293 @@
+********************************************************************
+* IDir - Show interrupt polling table
+*
+* $Id: idir.asm,v 1.1.1.1 2001/02/21 23:30:54 boisy Exp $
+*
+* Ed.    Comments                                       Who YY/MM/DD
+* ------------------------------------------------------------------
+* 1      Created                                        KKD
+* 2      Modified                                       GH
+
+         nam   IDir
+         ttl   Show interrupt polling table
+
+         ifp1  
+         use   defsfile
+         endc  
+
+rev      set   $01
+edition  set   2
+
+         mod   lenmod,namemd,prgrm+objct,reent+rev,start,endmem
+
+         org   $0000
+usaver   rmb   $0002      = $0000
+datptr   rmb   $0002      = $0002
+notuse   rmb   $0002      = $0004
+outptr   rmb   $0002      = $0008
+cntr1    rmb   $0001      = $0009
+devptr   rmb   $0002      = $000B
+tblptr   rmb   $0002      = $000D
+dpvars   rmb   $0009
+rptbuf   rmb   $0050
+Devbuf   rmb   $0104
+u016A    rmb   $0002
+u016C    rmb   $0102
+u026E    rmb   $0104
+buffer2  rmb   $02C8
+endmem   equ   .
+x0004    equ   $0004
+Poltbl   equ   $0011
+x0012    equ   $0012
+DevTbl   equ   $0013
+x0015    equ   $0015
+x0023    equ   $0023
+x0050    equ   $0050
+x0080    equ   $0080
+x00C8    equ   $00C8
+x0100    equ   $0100
+z0000    equ   $0000
+
+namemd   fcs   "IDir"
+         fcb   edition
+
+z0012    fcc   "Polling Table at: "
+z0012L   equ   *-z0012
+Device   fcc   " Device Table at: "
+DeviceL  equ   *-Device
+Topline  fcc   " Device    Driver  IRQ   Flip     "
+         fcb   C$CR
+ToplineL equ   *-Topline
+Line2    fcc   "Port Mem   Name  Vector  &Mask Pty"
+         fcb   C$CR
+Line2L   equ   *-Line2
+Line3    fcc   "---- ----  ------------  ----- ---"
+crtn     fcb   C$CR
+Line3L   equ   *-Line3
+
+start    lda   #$01
+         stu   <usaver    at 0000 in direct page
+         leax  >crtn,pcr  start with \n
+         ldy   #$0001
+         os9   I$WritLn
+         bcs   errexit
+         leax  >z0012,pcr "Polling Table at: " etc
+         ldy   #z0012L     num chars to write
+         os9   I$Write
+         bcs   errexit
+         lda   #$01
+         leax  buffer2,u  $0372,u
+         os9   F$GPrDsc   get $200 byte copy of process 1
+         bcs   errexit
+* F$GPrDsc returns $200 bytes, why inc only $40?
+         leax  P$DatImg,x 40,x to next ptr area=$03B2,u
+         stx   <datptr    at +2 in direct page
+         bra   z00C5
+okexit   clrb  
+errexit  os9   F$Exit
+z00C5    leay  rptbuf,u   = $0016,u
+         sty   <outptr    at 0006 in direct page
+         ldu   <usaver    get u back? was it diddled?
+         leau  u016A,u    is now! destination buffer
+         ldd   <datptr    get ptr P$datimg
+         ldx   #$0080     offset to begin=D.Devtbl
+         ldy   #$0004     include D.Poltbl 4 bytes to copy
+         os9   F$CpyMem   get it
+         bcs   errexit
+         ldu   <usaver    restore u
+         ldd   u016A,u    get D.Devtbl addr
+         std   <DevTbl    put in dp
+         ldd   u016C,u    get D.Poltbl addr
+         std   <Poltbl    put in dp u016A is re-used below
+         lbsr  z023B      cnvrt 4 dgts of poll tbl addr
+         lbsr  z01B1      output poll tbl address in ascii
+* troubleshooting printout
+         pshs  u,x,y,d
+         leax  >Device,pcr
+         ldy   #DeviceL
+         lda   #1
+         os9   I$Write
+         ldu   <usaver
+         leax  rptbuf,u
+         stx   <outptr
+         ldd   <devtbl
+         lbsr  z023B
+         lbsr  z01B1
+         puls  u,x,y,d
+* to here
+         lda   #1
+         leax  >crtn,pcr  stick another \n on it
+         ldy   #$0001
+         os9   I$WritLn
+         bcs   errexit
+         leax  >Topline,pcr " Device    Driver  IRQ   Flip     "
+         ldy   #ToplineL
+         os9   I$WritLn
+         bcs   errexit
+         leax  >Line2,pcr "Port Mem   Name  Vector  &Mask Pty"
+         ldy   #Line2L
+         os9   I$WritLn
+         bcs   errexit
+         leax  >Line3,pcr "---- ----  ------------  ----- ---"
+         ldy   #Line3L
+         os9   I$WritLn
+         lbcs  errexit
+         ldu   <usaver    now get orig u back
+         leau  u016A,u
+         stu   <devptr
+         ldx   <Poltbl    D.Poltbl addr
+         ldy   #$006C     256 bytes to get is too many
+         ldd   <datptr    s/b only 9*12 entries, $6C
+         os9   F$CpyMem
+         lbcs  errexit
+         ldu   <usaver
+         leau  Devbuf,u
+         ldd   <datptr
+         ldx   <DevTbl    D.Devtbl
+         ldy   #x0100     is not all of devtbl, s/b $015F!
+         os9   F$CpyMem
+         lbcs  errexit
+         ldb   #$0C
+         stb   <cntr1
+         ldx   <devptr
+z0165    ldd   Q$STAT,x   06,x checking memory required
+* another troubleshooting printout
+* pshs u,x,y,d,cc
+* ldu <usaver
+* leax rptbuf,u
+* stx <outptr
+* lbsr z023B converet d to ascii
+* lbsr z01B1
+* puls u,x,y,d,cc
+* to here
+         beq   z016B
+         bsr   z0179
+z016B    dec   <cntr1
+         lbeq  okexit
+         ldx   <devptr
+         leax  $09,x
+         stx   <devptr    to next irqtbl entry
+         bra   z0165
+z0179    ldu   <usaver    restore u to dp
+         leay  rptbuf,u
+         sty   <outptr
+         ldx   <devptr
+         ldd   ,x
+         lbsr  z023B      convert 2 bytes port addr->ascii
+         ldd   $06,x
+         lbsr  z023B      convert 2 bytes memsiz->ascii
+         lbsr  z0243      extra space in line
+         bsr   z01CA      now do name
+         ldu   <usaver
+         ldx   <devptr
+         ldd   $04,x      get irq vector
+         lbsr  z023B      convert it to ascii
+         lbsr  z0243      extra space
+         lda   $02,x      get flip
+         lbsr  z0241      convert 1 byte + space
+         lda   $03,x      get mask
+         lbsr  z0241      convert 1 byte + space
+         lbsr  z0243      extra space
+         lda   $08,x      get priority byte
+         lbsr  z0241      convert 1 byte
+z01B1    ldx   <outptr
+         lda   #C$CR      terminate this line
+         sta   ,x
+         ldu   <usaver    restore u again
+         leax  rptbuf,u   ptr to outbuff
+         ldy   #80        max 80 chars
+         lda   #$01       stdout
+         os9   I$WritLn
+         lbcs  errexit
+         rts   
+z01CA    ldx   <devptr    fnd nam in devtbl if memaddr=
+         ldb   #$1C       27 entries max in devtbl
+         pshs  b
+* now we make an assumption that data
+* areas for the same driver will be
+* in the same page of memory, so compare
+* only the high bytes of the address
+         ldb   $06,x      get irq dat addr
+         leax  Devbuf,u   devtbl buffer
+z01D6    cmpb  $02,x
+         beq   z01F3      if match, found device
+         leax  $09,x      else inc to next tbl entry
+         dec   ,s         that pshs'd b above
+         bne   z01D6
+         leas  $01,s      get rid of stack data
+         ldy   <outptr
+* lda #$20
+* ldb #$08 trial to space empty over
+* z01EA sta ,y+
+* decb 
+* bne z01EA
+         leay  8,y        this leaves name visible
+         sty   <outptr    until new one found
+         rts   
+z01E9    ldy   <outptr
+         ldb   #08
+         lda   #$20       a space 
+z01EA    sta   ,y+
+         decb  
+         bne   z01EA
+         sty   <outptr
+         rts   
+z01F3    leas  $01,s      get rid of stack dat
+         ldx   V$DESC,x   $04,x pointer to dev desc
+         beq   z01E9      what, no module name ptr?
+         pshs  u
+         leau  u026E,u
+         ldd   <datptr
+         ldy   #x00C8
+         os9   F$CpyMem
+         puls  u
+         lbcs  errexit
+         leax  u026E,u
+         ldd   $0B,x
+         leax  d,x
+         lda   #$08
+         sta   <x0015
+         clrb  
+         bra   z0220
+z021D    bsr   z025B
+z0220    incb  
+         cmpb  <x0015
+         bcc   z0232
+         lda   ,x+
+         bpl   z021D
+         anda  #$7F
+         bsr   z025B
+         cmpb  <x0015
+         bcc   z023A
+z0232    bsr   z0243
+         incb  
+         cmpb  <x0015
+         bcs   z0232
+z023A    rts   
+z023B    pshs  b          convert to ascii
+         bsr   z0247      make 2 digits
+         puls  a
+z0241    bsr   z0247      make 2 more
+z0243    lda   #$20
+         bra   z025B
+z0247    tfr   a,b
+         lsra  
+         lsra  
+         lsra  
+         lsra  
+         bsr   z0251
+         tfr   b,a
+z0251    anda  #$0F
+         cmpa  #$0A
+         bcs   z0259
+         adda  #$07
+z0259    adda  #$30
+z025B    pshs  x
+         ldx   <outptr    get outbuf ptr
+         sta   ,x+
+         stx   <outptr
+         puls  pc,x
+
+         emod  
+lenmod   equ   *
+         end