;*****************************************************************************
;*
;* ListScanner.asm   by HEIKO RATH
;* 
;*         Copyright 1988 by the Software Brewery
;*
;* This program may be non-commercially distributed.
;* 
;* This little program is intented to printout all ExecLists. It will only
;* work from CLI, WB-starting is senseless. To redirect the output to a file
;* use the standart DOS file redirection (ListScanner >filename). The output
;* contains the name of node, the type and the priority. 
;*
;*
;* A note to Leo Schwab: keep on developing display hacks.
;*
;*                        Heiko Rath
;*
;*****************************************************************************
;                          
;______  /          
;______\O                    - The Software Brewery - 
;      \\                        
;       o            Sparkling, fresh software from W.-Germany
;                 
;     @@@@@             Straight from the bar to your Amiga
;     |~~~|\        
;     | | |/        
;     |___|        With our regards to the Software Distillery
;
;Members are (listed alphabetically):
;Christian Balzer alias <CB>, Lattice C, user interfaces, beer addict. 
;Christof Bonnkirch alias KEY, Aztec C, Hardware & Devices, beer adict.
;Heiko Rath alias <HR>, Assembler, ROM-Kernal stuff, Marabou addict. 
;Peter Stark alias PS, Lattice C, IO & utilities, WordStar addict.
;Ralf Woitinas alias RAF, Assembler, anything, Ray-Tracing addict.
;Torsten Wronski alias MM, Assembler, anything, girls addict.
;
;Beverages: Altenmuenster Brauer Bier, Urfraenkisches Landbier, Grohe Bock.
;
;Send exotic drinks, beautyful girls, $$$$, comments, critizism, flames to:
;
;The Software Brewery   
;Christian Balzer      
;Im Wingertsberg 45      
;D-6108 Weiterstadt   
;West-Germany      
;
;Our BBS "AmigaNode" isn't online yet. As soon as it becomes available, 
;you'll be the first to know :-).
;
;
;Send the above stuff and of course MARABOU-CHOCOLATE to:
;
;Heiko Rath (AAAARRRRGGGHHH, where is my Marabou chocolate??)
;Raiffeisenstr.10a
;D-6108 Weiterstadt
;Tel.06150-2658
;West-Germany
;
;

ExecBase   Equ   4

;***
;*** Exec Offsets:
;***
OpenLibrary   Equ   -552      ;OpenLibrary (LibName,version)(a1,d0)
CloseLibrary   Equ   -414      ;CloseLibrary (Library)(a1)
Forbid      Equ   -132      ;Forbid ()()
Permit      Equ   -138      ;Permit ()()
AllocMem   Equ   -198      ;AllocMem (bytesize,requirement)(d0,d1)
FreeMem      Equ   -210      ;FreeMem (memoryblock,bytesize)(a1,d0)
_LVOGetMsg   equ -$174
_LVOReplyMsg equ -$17a
_LVOWaitPort equ -$180

;***
;*** DOS Offsets:
;***
_LVOOpen   equ -$1e
_LVOClose  equ -$24
_LVORead   equ -$2a
OutPut      Equ   -60      ;OutPut ()
Write      Equ   -48      ;Write (file,buffer,length)(d1,d2,d3)

pr_MsgPort       equ $5c
pr_CLI           equ $ac
ThisTask         equ $114
VBlankFrequency  equ $212
MODE_OLDFILE     equ 1005

;***
;*** I use these Macros to make things easier for me
;***

doit:   MACRO
   move.l   #\1.txt,d2      ;address of listname to d2
   bsr   TextOutPut      ;output listname
   move.l   #HeadLine,d2      ;address of HeadLine to d2
   bsr   TextOutPut      ;output HeadLine
   move.l   \1(pc),d0         ;offset of listhead to d0
   bsr   Showlist      ;output list
   ENDM

doit1:   MACRO
   move.l   #\1.txt,d2      ;address of listname to d2
   bsr   TextOutPut      ;output listname
   move.l   #HeadLine,d2      ;address of HeadLine to d2
   bsr   TextOutPut      ;output HeadLine
   move.l   \1(pc),d0         ;offset of listhead to d0
   bsr.s   Showlist      ;output list
   ENDM

;***
;*** Here we go:
;***
DosOpen:      ;opens DOS-library, saves DOSBasepointer
         ;saves stdout
   move.l   ExecBase,a6      ;Execaddress to a6 (only to be sure)
   move.l   #DOSNAME,a1      ;Librarynamepointer to a1
   moveq   #0,d0         ;any version
   jsr   OpenLibrary(a6)      ;try to open DOS-Libary
   tst.l   d0         ;is d0 = NULL?
   beq   ErrorExit      ;exit if call wasn't successfull
   move.l   d0,DOSBase      ;save DOSBasepointer

           moveq   #0,d0
           movea.l ThisTask(a6),a0
           tst.l   pr_CLI(a0)
           bne.s   isCLI

           lea     pr_MsgPort(a0),a0 for WB get WB Message
           jsr     _LVOWaitPort(a6)
           jsr     _LVOGetMsg(a6)
           move.l  d0,-(a7)

           cmpi.b  #60,VBlankFrequency(a6) test if PAL or NTSC
           beq.s   isNTSC
           move.l  #'256/',window+12

isNTSC     move.l  DOSBase(pc),a6
           move.l  #window,d1
           move.l  #MODE_OLDFILE,d2
           jsr     _LVOOpen(a6)
           move.l  d0,stdout
           beq     exit
           bra.s   start

isCLI      move.l  d0,-(a7)
   move.l   DOSBase(pc),a6         ;move DOSBasepointer to a6
   jsr   OutPut(a6)      ;identify the initial output handle
   move.l   d0,stdout      ;save stdout

         ;from here we call the PrintOutPut-subroutine to output
         ;the listnames and then we call the Showlist-subroutine
start:         ;to printout the contents of the lists.  
   move.l   #Text,d2
   bsr   TextOutPut
   doit   memlist         ;output Memorylist
   doit   reslist         ;output Resourcelist
   doit   devlist         ;output Devicelist
   doit   intrlist      ;output Interruptlist
   doit   liblist         ;output Librarylist
   doit   portlist      ;output Portlist
   doit   trdylist      ;output Taskreadylist
   doit1   twtlist         ;output Taskwaitinglist
   doit1   smlist         ;output Semaphorlist

exit  move.l (a7)+,d4
      beq.s  DosClose
      move.l  stdout(pc),d1
      move.l  #press,d2
      moveq   #14,d3
      jsr     Write(a6)

      move.l  stdout(pc),d1
      move.l  #press,d2
      moveq   #1,d3
      jsr     _LVORead(a6)

      move.l  stdout(pc),d1   close console
      beq.s   nocon
      jsr     _LVOClose(a6)


nocon move.l  ExecBase,a6
      jsr     Forbid(a6)    reply to WB
      movea.l d4,a1
      jsr     _LVOReplyMsg(a6)
      jsr     Permit(a6)

DosClose:
   move.l   ExecBase,a6      ;ExecBase to a6
   move.l   DOSBase(pc),a1      ;DOS-pointer to a1
   move.l   ExecBase,a6      ;Exec-pointer to a6
   jsr   CloseLibrary(a6)   ;close DOS

ErrorExit: moveq #0,d0
   rts            ;CLI here I come again!!!!

;*****************************************************************************
;*
;*   Showlist II               11.1.87
;*         by   Heiko Rath
;*            Raiffeisenstr.10a
;*            D-6108 Weiterstadt
;*            West-Germany
;*            Tel.06150-2658
;*
;* PURPOSE:         print out Exec-Systemlist (address of Node,
;*            type, priority, name of Node)
;*
;* ROUTINETYPE:         subroutine
;*
;* SYNTAX:         bsr Showlist   (Exec-offset to list)(d0)
;*
;* ENTRY CONDITIONS:      needs DOSlibrary opened and stdout defined
;*            also needs DOS-'Write' offset -48 defined.
;*            It also needs binhex subroutine.
;*
;* RETURNS:         none
;*
;* BUGS:         none
;*
;* NOTE:         none
;*
;* CHANGED:         nothing
;*
;* USAGE:         move.l   Listoffset,d0
;*            bsr   Showlist
;*
;*****************************************************************************
Showlist:
   movem.l   d0-d7/a0-a6,-(sp)   ;save registers

   move.l   ExecBase,a6      ;ExecBase to a6
   jsr   Forbid(a6)      ;forbid taskswitching (very important,
               ; 'cause we are accessing Systemdata)

   move.l   a6,a0         ;Execpointer to a0
   add.l   d0,a0         ; + librarylistoffset=address of listhead
   move.l   a0,ListHead      ;save address of listheader -=> ListHead
   move.l   (a0),a1         ;get address of 1.Node to a1
   move.l   a1,Node         ;save address of 1.Node -=> Node
   addq.l   #4,a0
   cmp.l   a1,a0         ;list empty?
               ;(test if listhead points to listhead+4)
   beq   PrintLF         ;yes -=> send LF and exit

   moveq.l   #1,d1         ;set counter to 1 'cause there is at least
               ; one node in the list
MyCountLoop:
   move.l   (a1),a1         ;get address of next node to a1
   tst.l   (a1)         ;see if contents of (a1) is NULL
   beq.b   EndCount      ;leave counting loop
   addq.l   #1,d1         ;increment counter by one
   bra.b   MyCountLoop      ;do this once more

EndCount:
   move.l   d1,NodeCount      ;save number of Nodes

GetMem:
   move.l   #48,d0         ;number of bytes per node
   mulu   d1,d0         ;bytes per node * NodeCount
   addq.l   #1,d0         ;add one for the bufferterminating Null
   move.l   d0,MyMemoryLength   ;save lenght of Memoryblock
   move.l   #$10001,d1      ;requirements:MEMF_Public & Clear
   jsr   AllocMem(a6)      ;get memory from system
   move.l   d0,MyMemoryBlock   ;save address of Memoryblock
   move.l   d0,MyMemoryOffset   ;save address of Memoryblock 2.time
   tst.l   d0         ;see if call was successfull
   bne.s   MoveNodeToBuffer   ;yes -=> MoveNodeToBuffer

   move.l   #Err,d2         ;this code is only here, to inform the
   bsr   TextOutPut      ; user that the AllocMem call wasn't
   bra   PrintLF         ; successfull

MoveNodeToBuffer:
   move.l   d0,a0         ;get address of MemoryBlock to a0
   move.l   MyMemoryLength(pc),d1   ;get length to d1

fill:
   move.b   #' ',(a0)+      ;fill MyMemoryBlock with spaces
   dbeq.b   d1,fill         ;is d1=NULL? (no-=>d1=d1-1-=>fill)

TheLoop:
   move.l   MyMemoryOffset(pc),a0   ;get address of MyMemoryOffset to a0
   move.l   Node(pc),a1         ;get address of current node to a1

CopyName:
   lea      10(a1),a1      ;address of namepointer to a1
   move.l   (a1),a1         ;get address of nodename to a1
   moveq.l   #0,d1         ;this is faster than clr.l d1
   moveq.l   #0,d2         ;set this to NULL for strlen

strlen:
   cmp.b   (a1)+,d2      ;NULL?
   beq.b   strlentest      ;yes -=>strlentest
   addq.l   #1,d1         ;increment d1 by one (stringlength)
   bra.b   strlen         ;do the loop once more

strlentest:
   cmp.b   #28,d1         ;see if string is greater #28
   ble.b   DoCopy         ;no (less or equal)-=>DoCopy
   move.l   #28,d1         ;set max.length to 28

DoCopy:
   move.l   Node(pc),a1         ;get address of node to a1
   lea      10(a1),a1         ;address of namepointer to a1
   move.l   (a1),a1         ;get address of nodename to a1
   tst.l   d1         ;see if d1=0
   bne.s   DoTheCopy      ;jump only if d1<>0
   move.l   #NoName,a1      ;get address of NoName to a1
   moveq.l   #7,d1         ;set length to 7 (length of 'No Name')

DoTheCopy:
   subq.l   #1,d1         ;decrement d1 by 1

CopyLoop:
   move.b   0(a1,d1),0(a0,d1)   ;copy source to destination
   dbf   d1,CopyLoop      ;decrement d1, if d1<0 then out of loop

   move.l   MyMemoryOffset(pc),a0   ;get address of MyMemoryOffset to a0
   move.b   #'$',29(a0)      ;store '$'
   move.b   #'$',39(a0)      ;store '$'
   move.b   #'$',43(a0)      ;store '$'
   move.b   #10,47(a0)      ;store LF

   move.l   Node(pc),a1         ;get Nodeaddress to a1
   addq.l   #8,a1         ;add 8 to get address of Type
   moveq.l   #0,d0         ;clear d0
   move.w   (a1),d0         ;get Type & Priority to d0
   move.l   #Buffer,a0      ;get bufferaddress to a0
   bsr   binhex         ;convert address to ASCII
   move.w   Buffer+6(pc),d0      ;get converted Type & Priority to d0
   move.l   MyMemoryOffset(pc),a0   ;get address of MyMemoryOffset to a0
   move.w   d0,44(a0)      ;copy Priority to MyMemoryBlock
   move.w   Buffer+4(pc),d0      ;get converted Priority to d0
   move.w   d0,40(a0)      ;copy Type to MyMemoryBlock

   move.l   Node(pc),d0         ;get Nodeaddress to d2
   move.l   MyMemoryOffset(pc),a0   ;get address of MyMemoryOffset to a0
   lea      30(a0),a0         ;add 30 to get storeaddress
   bsr.s   binhex         ;convert address to ASCII

   add.l   #48,MyMemoryOffset   ;do this for the next loop
   move.l   Node(pc),a1         ;get nodeaddress to a1
   move.l   (a1),Node      ;save address of next node
   move.l   MyMemoryOffset(pc),d0   ;get MyMemoryOffset to d0
   addq.l   #1,d0
   move.l   MyMemoryBlock(pc),d1   ;get MyMemoryBlock to d1
   add.l   MyMemoryLength(pc),d1   ;add MyMemoryLength to d1
   cmp.l   d0,d1         ;see if we have to loop once more
   bne   TheLoop         ;if <> -=> TheLoop
   move.l   MyMemoryBlock(pc),a0   ;get address of MyMemoryBlock to a0
   add.l   MyMemoryLength(pc),a0   ;add length to MyMemoryBlock
   subq.l   #1,a0         ;decrement address by one
   move.b   #0,(a0)         ;set last byte of MyMemoryBlock to NULL

   move.l   MyMemoryBlock(pc),d2   ;get address of MyMemoryBlock to d2
   bsr.s   TextOutPut      ;print out the complete buffered list
   move.l   MyMemoryBlock(pc),a1   ;get address of MyMemoryBlock to a1
   move.l   MyMemoryLength(pc),d0   ;get length of MyMemoryBlock to d0
   jsr   FreeMem(a6)      ;free the allocated RAM

PrintLF:
   move.l   #LF,d2         ;get address of LF-string to d2
   bsr.b   TextOutPut      ;and get it out via DOS-Write & stdout
   jsr   Permit(a6)      ;permit taskswitching (I think Dos enables
               ; this for you, but I do this to be sure
               ; that taskswitching is now allowed.)
   movem.l   (sp)+,d0-d7/a0-a6   ;restore Registers
   rts

;*****************************************************************************
;*
;*   TextOutPut
;*         by   Heiko Rath
;*            Raiffeisenstr.10a
;*            D-6108 Weiterstadt
;*            West Germany
;*            Tel.06150-2658
;*
;* PURPOSE:       output a NULL-terminated string via stdout
;*
;* ROUTINE TYPE:    subroutine
;*
;* SYNTAX:      bsr   TextOutPut   (stringaddress)(d0)
;*
;* ENTRY CONDITIONS:   needs DOSlibrary opened and stdout defined
;*         also needs DOS-'Write' offset -48 defined.
;*
;* RETURNS:      none
;*
;* NOTE:      its better if the string is really NULL-terminated
;*
;* CHANGED:      nothing
;*
;* USAGE:      move.l   #Textaddress,d2
;*         bsr   TextOutPut
;*
;*****************************************************************************

TextOutPut:
   movem.l   d0-d7/a0-a6,-(sp)   ;save registers
   move.l   d2,a0         ;address to a0
   clr.l   d3         ;count = 0

CountLoop:
   tst.b   (a0)+         ;is it NULL ?
   beq.b   PMsg         ;yes: -=> determine length
   addq.l   #1,d3         ;count = count+1
   bra.b   CountLoop      ;test next byte

PMsg:
   move.l   stdout(pc),d1      ;get stdout to d1
   move.l   DOSBase(pc),a6      ;move DOSBase to a6
   jsr   Write(a6)      ;write the Text
   movem.l   (sp)+,d0-d7/a0-a6   ;reserve registers
   rts

;***********************************************************************
;*
;*    binhex
;*          by Heiko Rath
;*
;* PURPOSE: Convert a binary value in a register to
;*       a hex ASCII string at the destination address
;*          
;* ROUTINE TYPE: SUBROUTINE
;*
;* SYNTAX: bsr   binhex   (source(long),destination) (d0.l,a0)
;*      bsr   binhexw   (source(word),destination) (d0.w,a0)
;*      bsr   binhexb   (source(byte),destination) (d0.b,a0)
;*
;* ENTRY CONDITIONS: None
;*
;* RETURNS: ASCII string in destination address
;* NOTE:    the destination place must contain 8 bytes for any
;*           length (byte, word, longword)
;*
;* CHANGED: Nothing
;*
;* USAGE:
;*
;*    move   #label,d0
;*    move.l   address(pc),a0   ;converts the address at label to
;*    bsr   binhex      ;string at address
;*            
;*    move   label(pc),d0
;*    move.l   address(pc),a0
;*    bsr   binhex      ;conv contents at label
;*
;*    move   #value,d0
;*    move.l   address(pc),a0
;*    bsr   binhex      ;convert immediate value
;*
;****************************************************************

binhex:   movem.l   d0-d2/a0,-(sp)      ;save registers

   move.l   #7,d2         ;get number of counts to d2
   clr.l   d1         ;clear work register

001$:   rol.l   #4,d0         ;move high nibble to low order
   move.b   d0,d1         ;get low order byte to d1
   andi.b   #$f,d1         ;isolate low order nibble
   cmp.b   #$0a,d1         ;is it a letter or a digit?
   blt.b   002$         ;if digit -=> 002$
   add.b   #'A'-'0'-$0A,d1      ;offset for letters

002$:   add.b   #'0',d1         ;convert to ASCII
   move.b   d1,(a0)+      ;store it and increment storeaddress
   dbf.b   d2,001$         ;do the converting 8 times

   movem.l   (sp)+,d0-d2/a0      ;restore registers
   rts

;
; Variables:
;
DOSBase:   dc.l   0      ;this contains the DOSlibraryaddress
stdout:      dc.l   0      ;this contains stdout
Buffer:      dc.b   '00000000'   ;At runtime this is the storage of
               ; Type & Priority
ListHead:
   dc.l   0         ;At runtime this contains the
               ; address of the listheader
Node:
   dc.l   0         ;At runtime this contains the
               ; address of the current node
NodeCount:
   dc.l   0         ;At runtime this contains the
               ; number of nodes in the list
MyMemoryLength:
   dc.l   0         ;At runtime this contains the
               ; length of the memoryblock
MyMemoryBlock:
   dc.l   0         ;At runtime this contains the
               ; address of the memoryblock
MyMemoryOffset:
   dc.l   0         ;At runtime this contains the
               ; address of the memoryblock
               ; + 48 Bytes per finished node

;
; Constants:
;
memlist:   dc.l   $142   ;These are the offsets of the Exec-
reslist:   dc.l   $150   ; systemlists. To get the address
devlist:   dc.l   $15e   ; of a listheader they are added to
intrlist:   dc.l   $16c   ; ExecBase.
liblist:   dc.l   $17a
portlist:   dc.l   $188
trdylist:   dc.l   $196
twtlist:   dc.l   $1a4
smlist:      dc.l   $214

window     dc.b 'CON:0/0/639/199/ListScanner',0
           even
press      dc.b 'Press <RETURN>'
           even
DOSNAME:   dc.b   'dos.library',0
      cnop   0,2
INTNAME:   dc.b   'intuition.library',0
      cnop   0,2
Err:      dc.b   '*** Out of Memory Error ***',0
      cnop   0,2
NoName:      dc.b   'No Name',0
      cnop   0,2
LF:      dc.b   10,0      ;LF
      cnop   0,2
HeadLine:   dc.b   $9b,'4;32;40m'
      dc.b   'Name:                         Address Type Pri'
      dc.b   $9b,'0;31;40m',10,0
      cnop   0,2
Text:
   dc.b   $9b,'0;33;40m','ListScanner',$9b,'0;31;40m'
   dc.b   ' by Heiko Rath - copyright ',169,' by '
   dc.b   $9b,'1;31;40m','The Software Brewery',$9b,'0;31;40m',10
   dc.b   '            '
   dc.b   'Raiffeisenstr.10a,D-6108 Weiterstadt,Tel.06150-2658',10
   dc.b   '            '
   dc.b   '(famous last words: Where is my Marabou chocolate?)'
   dc.b   10,10,0
      cnop   0,2
memlist.txt:   dc.b   'MemoryList:',10,0
      cnop   0,2
reslist.txt:   dc.b   'ResourceList:',10,0
      cnop   0,2
devlist.txt:   dc.b   'DeviceList:',10,0
      cnop   0,2
intrlist.txt:   dc.b   'InterruptList:',10,0
      cnop   0,2
liblist.txt:   dc.b   'LibraryList:',10,0
      cnop   0,2
portlist.txt:   dc.b   'PortList:',10,0
      cnop   0,2
trdylist.txt:   dc.b   'TaskReadyList:',10,0
      cnop   0,2
twtlist.txt:   dc.b   'TaskWaitingList:',10,0
      cnop   0,2
smlist.txt:   dc.b   'SemaphoreList:',10,0
      end