;;; Random test code; don't load this file, but interactively evaluate
;;; parts of it.

(load '(assembler loader))
(load-tas)
(load-ppc-tas)

(set (repl-env) tas-ppc-env)
(define @ object-unhash)

(new-assemble
 (test-lap '((mfspr (r 0) link)
             (bcl 10 31 go)
          go (fmr (fr 12) (fr 1))
             (mfspr (r 10) link)
             (mtspr link (r 0))
             (addis (r 2) (r 10) ($ 0))
             (lfd (fr 1) (d@r (r 2) #x68))
             (addis (r 2) (r 10) ($ 0))
             (lfd (fr 13) (d@r (r 2) #x60))
             (fsub (fr 0) (fr 1) (fr 12))
             (fabs (fr 0) (fr 0))
             (fcmpu (cr 7) (fr 0) (fr 13))
             (bc>= (cr 7) ret)
             (addis (r 2) (r 10) ($ 0))
             (fmr (fr 10) (fr 13))
             (lfd (fr 11) (d@r (r 2) #x70))
        loop (fadd (fr 0) (fr 12) (fr 1))
             (fmul (fr 1) (fr 0) (fr 11))
             (fmsub (fr 13) (fr 1) (fr 12) (fr 1))
             (fabs (fr 13) (fr 13))
             (fcmpu (cr 7) (fr 13) (fr 10))
             (bclr #b0010 28)
             (b loop)
         ret (addis (r 2) (r 10) ($ 0))
             (lfd (fr 1) (d@r (r 2) #x68))
             (blr))
           powerpc))




(block (define r0 (ppc-reg/general 0))
       (define r2 (ppc-reg/general 2))
       (define r3 (ppc-reg/general 3))
       (define r4 (ppc-reg/general 4))
       (define r5 (ppc-reg/general 5))
       nil)

(define (emit ib op . args)
  (as-emit ib (apply (table-entry (machine-ops-table powerpc)
                                  op)
                     args)))

(lset as-section nil)
(lset ib nil)

(set as-section (cons-assembly-section powerpc))
(set ib (as-tag as-section (generate-symbol 'ib)))

(block (emit ib 'mullw r0 r4 r5)
       (emit ib 'cmp 7 r0 r3)
       (let ((0tag (generate-symbol '0tag))
             (1tag (generate-symbol '1tag)))
         (let ((1ib (as-tag as-section 1tag))
               (0ib (as-tag as-section 0tag)))
           (set-ib-follower ib 1ib)
           (as-emit-jump as-section ib
                         (make-ppc-jump-op ppc/bc
                                           (make-cr-bc-op '#f)
                                           '#f
                                           0)
                         0tag 1tag)
           (emit 0ib 'add r2 r4 r3)
           (emit 0ib 'addi r3 r2 #xFFFF)
           (emit 0ib 'blr)
           (emit 1ib 'addi r0 r5 #x2)
           (emit 1ib 'mullw r3 r3 r0)
           (emit 1ib 'blr)))
       nil)

(new-assemble as-section)