section quiet

* This adds a pair of extensions that can be used to shut down sound generation
* Rather useful for annoying games...

* QUIET will stop all sound initiation and NOISY will re-instate it.
* Actually, if continuous sound is in progress, you will want BEEP to stop it.

* This code is VERY clean, and can used from any job or jobs, as it doesn't
* have to stay resident! It copies it's tiny piece of code into the common
* heap, and makes it be owned by job 0. Only one copy will ever be present.
* E.g. you can say QUIET in a MultiBasic, with these extensions only present
* there, and then throw away the MultiBasic. A subsequent sequence to turn the
* sound back on with NOISY will work fine. It doesn't matter how many times
* you call QUIET and NOISY. If QUIET was last, there will be the single bit
* of code linked in. If NOISY was the last used, there will be nothing linked.

* The only thing it doesn't manage is that BEEPING will always think a sound
* has finished instantaneously. I wonder if any game ever makes any great use
* of such a thing?

bp.init equ     $110

err.bp  equ     -15

mt.alchp equ    $18
mt.inf  equ     0
mt.rechp equ    $19

sv_chtop equ    $7C

sx_ipcom equ    $14

assert macro
i setnum 1
l maclab
i setnum [i]+1
 ifnum [i] > [.nparms] goto x
 ifnum [.parm([i]-1)] = [.parm([i])] goto l
        error   [.parm([i]-1)] is not [.parm([i])]
x maclab
 endm

        lea     table,a1
        move.w  bp.init,a2
        jmp     (a2)

quiet
        moveq   #mt.alchp,D7
noisy
        moveq   #err.bp,d0      object if any parameters are given
        cmp.l   a3,a5
        bne.s   rts0

* Acually, the following code may be CALL'ed, setting d7 to zero for NOISY or
* to mt.alchp for QUIET, without using the extensions!

        moveq   #mt.inf,d0
        trap    #1

        moveq   #sx_ipcom,d5
        add.l   sv_chtop(a0),d5 set IPCOM link word address

        move.l  d7,d0
        beq.s   noalloc         no allocation if we're going to go noisy
clen    equ     4*3             length of code we are presetting
        moveq   #8+clen,d1
        moveq   #0,d2           allocate to job 0, 'cos we intend to stay!
        trap    #1
        tst.l   d0
        bne.s   rts0
        lea     8(a0),a1
        movem.l code,a2-a4
        movem.l d0/a1-a4,(a0)   preset with 0, code address and our PI code
noalloc

        move.w  sr,d4
        trap    #0
        or.w    #$700,sr        no interrupts allowed during lookup

lookup
        move.l  d5,a5           remember where the link is
        move.l  (a5),d5         get link, ready to loop
        beq.s   absent          we didn't find ourselves, so get out
        move.l  d5,a1           starting from base of linkage block
        move.l  (a1)+,d3        remember the forward link from here
        move.l  (a1)+,d1        pick up routine address
        cmp.l   a1,d1
        bne.s   lookup          if not self referencing, like us, go on
        moveq   #(cend-code)>>1-1,d2
        lea     code,a2
match
        cmp.w   (a1)+,(a2)+     verify IDENTICAL code in use
        dbne    d2,match
        bne.s   lookup          if not an exact code sequence, get on with list

* We've found a precise match to our code, now decide what to do!

        tst.l   d7
        bne.s   dropit          if being told to go quiet, we already are!
        move.l  d3,(a5)         overwrite prior link with our old forward link
        move.l  d5,a0           ready to throw out our old stuff
dropit
        move    d4,sr           back to user mode
        moveq   #mt.rechp,d0    say it's gotta go
        trap    #1
        rts

* We couldn't find ourselves, decide what to do
absent
        tst.l   d7
        beq.s   allover         if being told to go noisy, we already are!
        move.l  a0,(a5)         just put our block on the end of list
allover
        move    d4,sr           back out to user mode
        rts

*       dc.l    next (forward link)
*       dc.l    code (routine address)
code
        moveq   #$8000>>$A,d6   command is actually just the ls nibble
        rol.w   d0,d6           effectively ignore upper 4 bits
        bpl.s   rts0            leave all but initiate sound
        addq.l  #2,(sp)         say we've done it!
rts0
        rts
cend
        assert  0,(code+clen-cend)>>2 ; confirm we copied enough code

table
        dc.w    2
        dc.w    quiet-*
        dc.b    5,'QUIET'
        dc.w    noisy-*
        dc.b    5,'NOISY'
        dc.w    0,0,0

        end