;;; -*- Mode:LISP; Package:LAMBDA -*-
;;;
;;; (c) Copyright 1984 - Lisp Machine, Inc.
;;;


;first hack:  (dpb 0 0434 0); make sure result is still 0
(defun dpb-test ()
  (let ((m-dest 1)
	(m-value 2)
	(m-background 3)
	(m-result 4)
	(m-zero 5)
	(m-testend 6))
    (write-m-mem m-dest 0)
    (write-m-mem m-value 0)
    (write-m-mem m-background 0)
    (write-m-mem m-result 0)
    (write-m-mem m-zero 0)
    (write-m-mem m-testend 20)
    (uload (m-dest m-value m-background m-result m-zero m-testend)
     0
	   ;((m-background) add m-background m-zero alu-carry-in-one)
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-aluf lam-alu-add
	    lam-ir-m-src m-background
	    lam-ir-a-src m-zero
	    lam-ir-m-mem-dest m-background
	    lam-ir-carry 1)
	   ;(jump-not-equal m-backgound m-testend do-dpb)
	   (lam-ir-op lam-op-jump
	    lam-ir-jump-cond lam-jump-cond-m-neq-a
	    lam-ir-m-src m-background
	    lam-ir-a-src m-testend
	    lam-ir-jump-addr do-dpb
	    lam-ir-n 1)
	   ;((m-background) setz)
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-aluf lam-alu-setz
	    lam-ir-m-mem-dest m-background)
     do-dpb
	   ;((m-result) m-background)
	   (lam-ir-op lam-op-alu
	    lam-ir-ob lam-ob-alu
	    lam-ir-aluf lam-alu-setm
	    lam-ir-m-src m-background
	    lam-ir-m-mem-dest m-result)
	   ;((m-dest) dpb m-value (byte-field 34 4) m-background)
	   (lam-ir-op lam-op-byte
	    lam-ir-byte-func lam-byte-func-dpb
	    lam-ir-mrot 4
	    lam-ir-bytl-1 33
	    lam-ir-m-src m-value
	    lam-ir-a-src m-background
	    lam-ir-m-mem-dest m-dest)
	   ;(jump-equal m-dest m-result 0)
	   (lam-ir-op lam-op-jump
	    lam-ir-jump-cond lam-jump-cond-m=a
	    lam-ir-m-src m-dest
	    lam-ir-a-src m-result
	    lam-ir-jump-addr 0
	    lam-ir-n 1)
	   ;(jump 0 halt)
	   (lam-ir-op lam-op-jump
	    lam-ir-jump-cond lam-jump-cond-unc
	    lam-ir-jump-addr 0
	    lam-ir-n 1
	    lam-ir-halt 1)
	   ;(setz)
	   (lam-ir-op lam-op-alu)))
  t)