*       Show contents of Cookie Jar
*       (c) 1991 Mathew Lodge

_p_cookies equ  $5A0            Cookie jar pointer

dos     equ     1
xbios   equ     14

Pterm0  equ     $00
Cconws  equ     $09

Supexec equ     38


start:
        move.l  #stack,sp       Set up our stack
        pea     disp_jar
        move.w  #Supexec,-(sp)
        trap    #xbios          Execute routine in super mode
        addq.l  #6,sp

        move.w  #Pterm0,-(sp)   Terminate
        trap    #1

disp_jar:
        move.l  _p_cookies,d0
        beq     no_jar          If pointer zero, no jar installed
        move.l  d0,a0
loop:
        move.l  (a0)+,d0        Get cookie ID
        move.l  (a0)+,d1        Get cookie value
        tst.l   d0              End of jar?
        beq     jar_end
        bsr     show_cookie     Otherwise show cookie
        bsr     print_crlf      Goto next line
        bra     loop

no_jar:
        lea     no_jarm,a1      No jar message
        bsr     print_stg
        rts                     Done

jar_end:
        lea     end_msg,a1      Print end of jar message
        bsr     print_stg
        lea     scratch,a1
        bsr     print_hex       Print no of slots in jar
        bsr     print_crlf      Add CRLF
        rts                     Done

show_cookie:
        lea     scratch,a1      Scratch buffer
        move.l  d0,(a1)+        Store ID
        move.l  #" = $",(a1)+
        clr.b   (a1)            Zero terminate
        lea     scratch,a1      Print it
        bsr     print_stg
        lea     scratch,a1
*                               Fall through to print_hex

print_hex:
        move.l  a1,-(sp)        Save buffer address
        bsr     print_hex_l     Store in buffer
        clr.b   (a1)            Zero terminate
        move.l  (sp)+,a1        Fall through to print_stg

print_stg:
        movem.l d0-d1/a0-a1,-(sp) Save registers
        move.l  a1,-(sp)
        move.w  #Cconws,-(sp)   Print to screen
        trap    #dos
        addq.l  #6,sp
        movem.l (sp)+,d0-d1/a0-a1 Retrieve regs
        rts

print_crlf:
        lea     crlf,a1         Print carriage return
        bra     print_stg       and line feed

print_hex_l:
        swap    d1              Print high word first
        bsr     print_hex_w
        swap    d1
        bsr     print_hex_w     Then low word
        rts

print_hex_w:
        move.l  d1,-(sp)        Save D1
        lsr.w   #8,d1           Shift low byte into d1
        bsr     print_hex_b     Print it
        move.l  (sp),d1         Get D1 back (but don't unstack)
        bsr     print_hex_b     Print it
        move.l  (sp)+,d1        Get D1 back
        rts

print_hex_b:
        move.l  d1,-(sp)        Save D1
        lsr.w   #4,d1           Shift high nybble into D1
        bsr     lookup          Decode it
        move.l  (sp)+,d1        Get D1 back
        bsr     lookup          Decode low nybble
        rts

lookup:
        and.l   #$F,d1          mask off rest
        lea     hextable,a2     Look up table
        move.b  0(a2,d1.w),d2   Get ASCII equivalent
        move.b  d2,(a1)+        Save in scratch buffer
        rts

hextable:
        dc.b    '0123456789ABCDEF'

no_jarm dc.b    'No Cookie Jar installed',13,10,0
end_msg dc.b    'Total no of cookie slots :',0
crlf    dc.b    13,10,0
scratch:
        ds.l    4
        
        ds.l    99
stack   ds.l    1

        END