;(*---------------------------------------------------------------------------
; :Program.     DHT.asm
; :Contents.    Hartley Transform
; :Author.      Christian Stiens
; :Address.     Snail-Mail:          E-Mail:
; :Address.     Heustiege 2          FIDO: 2:245/5802.25
; :Address.     W-4710 Lüdinghausen  UUCP: Christian_Stiens@ouzonix.bo.open.de
; :Copyright.   public domain
; :Language.    68000 Assembler
; :Translator.  A68k V2.71
; :History.     V1.0, 30.3.93
; :Support.     Daniel Wesemann
;---------------------------------------------------------------------------*)


        XDEF _DHT

_DHT: ; (ein{a0},aus{a1}: ^INT; n{d0}: INT; log2n{d1}: INT; sintab{a2}: ^INT);


ein     EQUR a0
aus     EQUR a1
sintab  EQUR a2
sinptr  EQUR a3
cosptr  EQUR a4

i       EQUR d1
j       EQUR d2
k       EQUR d3
e       EQUR d4
idx     EQUR d5
arypos  EQUR d6
tabstep EQUR d7

nmine   EQU   8
andval  EQU   6
orval   EQU   4
log2n   EQU   2
n       EQU   0


        movem.l d2-d7/a2-a6,-(sp)
        clr.w   -(sp)                  ; 8(sp)
        clr.w   -(sp)                  ; 6(sp)
        clr.w   -(sp)                  ; 4(sp)
        move.w  d1,-(sp)               ; 2(sp) = log2n
        move.w  d0,-(sp)               ; 0(sp) = n
bitrev:
        move.w  n(sp),d3               ; FOR i = n-1 TO 0
\bv     subq.w  #1,d3
        move.w  log2n(sp),d2
        move.w  d3,d1
        moveq   #0,d0
        subq.w  #1,d2
        bmi.s   \ende
\loop   lsr.w   #1,d1
        roxl.w  #1,d0
        dbra    d2,\loop
\ende   cmp.w   d0,d3
        bge.s   \endif
        add.w   d0,d0
        move.w  d3,d4
        add.w   d4,d4
        move.w  0(ein,d0.w),d1
        move.w  0(ein,d4.w),0(ein,d0.w)
        move.w  d1,0(ein,d4.w)
\endif  tst.w   d3
        bgt.s   \bv

pairsum:
        btst    #0,log2n+1(sp)         ; ODD log2n?
        beq.s   \else

        move.w  n(sp),d0               ; FOR i := n-2 TO 0 BY -2
\loop0  subq.w  #2,d0
        move.w  d0,d7
        add.w   d7,d7
        move.w  0(ein,d7.w),d1
        move.w  2(ein,d7.w),d2
        ext.l   d1
        ext.l   d2
        move.l  d2,d3
        add.l   d1,d3
        asr.l   #1,d3
        sub.l   d2,d1
        asr.l   #1,d1
        move.w  d3,0(aus,d7.w)
        move.w  d1,2(aus,d7.w)
        tst.w   d0
        bgt.s   \loop0
        exg     ein,aus
        bra.s   \endif
\else   move.w  n(sp),d0               ; FOR i := n-2 TO 0 BY -2
\loop1  subq.w  #2,d0
        move.w  d0,d7
        add.w   d7,d7
        move.w  0(ein,d7.w),d1
        move.w  2(ein,d7.w),d2
        ext.l   d1
        ext.l   d2
        move.l  d2,d3
        add.l   d1,d3
        asr.l   #1,d3
        sub.l   d2,d1
        asr.l   #1,d1
        move.w  d3,0(ein,d7.w)
        move.w  d1,2(ein,d7.w)
        tst.w   d0
        bgt.s   \loop1
\endif

mainloop:
        moveq   #4,e                   ; WHILE e <= n
\while  cmp.w   n(sp),e
        bgt     \endw

        move.w  e,andval(sp)
        subq.w  #1,andval(sp)
        move.w  e,orval(sp)
        asr     orval(sp)
        move.l  #1024,tabstep
        divs    e,tabstep
        add.w   tabstep,tabstep        ; tabstep = sintablen DIV e * 2
        move.w  n(sp),nmine(sp)
        sub.w   e,nmine(sp)

        moveq   #0,arypos              ; WHILE arypos <= n-e
\while2 cmp.w   nmine(sp),arypos
        bgt.s   \endw2

        movea.l sintab,sinptr
        movea.l sintab,cosptr
        adda.w  #512,cosptr

        moveq   #0,idx                 ; REPEAT
\repeat move.w  orval(sp),i
        subq.w  #1,i
        and.w   idx,i
        move.w  i,j
        or.w    orval(sp),j
        move.w  j,k
        neg.w   k
        and.w   andval(sp),k
        or.w    orval(sp),k
        add.w   i,i
        add.w   j,j
        add.w   k,k
        move.w  arypos,d0
        add.w   d0,d0
        lea     0(ein,d0.w),a5         ; a5 = ADR(ein[arypos])
        move.w  (cosptr),d0
        muls    0(a5,j.w),d0
        move.l  d0,j
        move.w  (sinptr),d0
        muls    0(a5,k.w),d0
        add.l   d0,j
        moveq   #15,d0
        asr.l   d0,j                   ; j = temp
        move.w  idx,d0
        add.w   arypos,d0
        add.w   d0,d0
        lea     0(aus,d0.w),a6         ; a6 = ADR(aus[arypos+idx])
        move.w  0(a5,i.w),d0
        ext.l   d0
        add.l   j,d0
        asr.l   #1,d0
        move.w  d0,(a6)                ; (a6) := SHORT((ein[arypos+i] + temp) DIV 2);
        adda.w  tabstep,sinptr
        adda.w  tabstep,cosptr
        addq.w  #1,idx
        cmp.w   e,idx
        blt.s   \repeat                ; UNTIL idx >= e

        add.w   e,arypos
        bra.s   \while2

\endw2  exg     ein,aus
        add.w   e,e
        bra     \while

\endw   lea     10(sp),sp
        movem.l (sp)+,d2-d7/a2-a6
        rts

        END