;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; LUSH Lisp Universal Shell
;;;   Copyright (C) 2002 Leon Bottou, Yann Le Cun, AT&T Corp, NECI.
;;; Includes parts of TL3:
;;;   Copyright (C) 1987-1999 Leon Bottou and Neuristique.
;;; Includes selected parts of SN3.2:
;;;   Copyright (C) 1991-2001 AT&T Corp.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; $Id: idx-macros.lsh,v 1.5 2004/01/12 05:46:55 profshadoko Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? **** Generic IDX Macros and Functions

#? *** Resizing Macros and Functions
;; A set of macros and functions to resize
;; vectors, matrices and tensors.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(dmd idx-m0acc (in out) `(idx-m0add ,in ,out ,out))
(dmd idx-m1acc (in out) `(idx-m1add ,in ,out ,out))
(dmd idx-m2acc (in out) `(idx-m2add ,in ,out ,out))
(dmd idx-maacc (in out) `(idx-maadd ,in ,out ,out))

(dm -very-large-negative-number- args -1e37)
(dm -very-large-positive-number- args 1e37)
(dm -very-small-positive-number- args 1e-35)
(dm -very-small-negative-number- args -1e-35)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? (midx-m1resize <m> <n0>)
;; a macro redims idx1 <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; In interpreted mode, the function idx1-resize can be called.
;;.SEE (idx1-resize <m> <n0>)
(dm midx-m1resize (f m n0)
    (if (or C_COMPILE ~(is-of-class idx-m1resize |DH|))
        `(cinline "Midx_init_dim1(%s,%s)" ,m ,n0)
      `(idx-m1resize ,m ,n0) ) )

#? (midx-m2resize <m> <n0> <n1>)
;; a macro that redims idx2 <m> in-place 
(dm midx-m2resize (f m n0 n1)
    (if (or C_COMPILE ~(is-of-class idx-m2resize |DH|))
        `(cinline "Midx_init_dim2(%s,%s,%s)" ,m ,n0 ,n1)
      `(idx-m2resize ,m ,n0 ,n1) ) )

#? (midx-m3resize <m> <n0> <n1> <n2>)
;; a macro that redims idx3 <m> in-place 
(dm midx-m3resize (f m n0 n1 n2)
    (if (or C_COMPILE ~(is-of-class idx-m3resize |DH|))
        `(cinline "Midx_init_dim3(%s,%s,%s,%s)" ,m ,n0 ,n1 ,n2)
      `(idx-m3resize ,m ,n0 ,n1 ,n2) ) )

#? (midx-m4resize <m> <n0> <n1> <n2> <n3>)
;; a macro that redims idx4 <m> in-place 
(dm midx-m4resize (f m n0 n1 n2 n3)
    (if (or C_COMPILE ~(is-of-class idx-m4resize |DH|))
        `(cinline "Midx_init_dim4(%s,%s,%s,%s,%s)" ,m ,n0 ,n1 ,n2 ,n3)
      `(idx-m4resize ,m ,n0 ,n1 ,n2 ,n3) ) )

#? (midx-m5resize <m> <n0> <n1> <n2> <n3> <n4>)
;; a macro that redims idx5 <m> in-place 
(dm midx-m5resize (f m n0 n1 n2 n3 n4)
    (if (or C_COMPILE ~(is-of-class idx-m5resize |DH|))
        `(cinline "Midx_init_dim5(%s,%s,%s,%s,%s,%s)" ,m ,n0 ,n1 ,n2 ,n3, n4)
      `(idx-m5resize ,m ,n0 ,n1 ,n2 ,n3 ,n4) ) )

#? (idx-f1resize <m> <n0>)
;; redims idx1 of float <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-f1resize (m n0) 
    ((-idx1- (-flt-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-f2resize <m> <n0> <n1>)
;; redims idx2 of float <m> in-place 
(de idx-f2resize (m n0 n1) 
    ((-idx2- (-flt-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-f3resize <m> <n0> <n1> <n2>)
;; redims idx3 of float <m> in-place 
(de idx-f3resize (m n0 n1 n2) 
    ((-idx3- (-flt-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-f4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of float <m> in-place 
(de idx-f4resize (m n0 n1 n2 n3) 
    ((-idx4- (-flt-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

(dmd idx-m1resize l (cons 'idx-f1resize l))
(dmd idx-m2resize l (cons 'idx-f2resize l))
(dmd idx-m3resize l (cons 'idx-f3resize l))
(dmd idx-m4resize l (cons 'idx-f4resize l))

#? (idx-i1resize <m> <n0>)
;; redims idx1 of int <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-i1resize (m n0) 
    ((-idx1- (-int-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-i2resize <m> <n0> <n1>)
;; redims idx2 of int <m> in-place 
(de idx-i2resize (m n0 n1) 
    ((-idx2- (-int-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-i3resize <m> <n0> <n1> <n2>)
;; redims idx3 of int <m> in-place 
(de idx-i3resize (m n0 n1 n2) 
    ((-idx3- (-int-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-i4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of int <m> in-place 
(de idx-i4resize (m n0 n1 n2 n3) 
    ((-idx4- (-int-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

#? (idx-s1resize <m> <n0>)
;; redims idx1 of short <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-s1resize (m n0) 
    ((-idx1- (-short-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-s2resize <m> <n0> <n1>)
;; redims idx2 of short <m> in-place 
(de idx-s2resize (m n0 n1) 
    ((-idx2- (-short-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-s3resize <m> <n0> <n1> <n2>)
;; redims idx3 of short <m> in-place 
(de idx-s3resize (m n0 n1 n2) 
    ((-idx3- (-short-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-s4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of short <m> in-place 
(de idx-s4resize (m n0 n1 n2 n3) 
    ((-idx4- (-short-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

#? (idx-b1resize <m> <n0>)
;; redims idx1 of byte <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-b1resize (m n0) 
    ((-idx1- (-byte-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-b2resize <m> <n0> <n1>)
;; redims idx2 of byte <m> in-place 
(de idx-b2resize (m n0 n1) 
    ((-idx2- (-byte-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-b3resize <m> <n0> <n1> <n2>)
;; redims idx3 of byte <m> in-place 
(de idx-b3resize (m n0 n1 n2) 
    ((-idx3- (-byte-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-b4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of byte <m> in-place 
(de idx-b4resize (m n0 n1 n2 n3) 
    ((-idx4- (-byte-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

#? (idx-u1resize <m> <n0>)
;; redims idx1 of ubyte <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-u1resize (m n0) 
    ((-idx1- (-ubyte-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-u2resize <m> <n0> <n1>)
;; redims idx2 of ubyte <m> in-place 
(de idx-u2resize (m n0 n1) 
    ((-idx2- (-ubyte-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-u3resize <m> <n0> <n1> <n2>)
;; redims idx3 of ubyte <m> in-place 
(de idx-u3resize (m n0 n1 n2) 
    ((-idx3- (-ubyte-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-u4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of ubyte <m> in-place 
(de idx-u4resize (m n0 n1 n2 n3) 
    ((-idx4- (-ubyte-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

#? (idx-g1resize <m> <n0>)
;; redims idx1 of gptr <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-g1resize (m n0) 
    ((-idx1- (-gptr-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-g2resize <m> <n0> <n1>)
;; redims idx2 of gptr <m> in-place 
(de idx-g2resize (m n0 n1) 
    ((-idx2- (-gptr-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-g3resize <m> <n0> <n1> <n2>)
;; redims idx3 of gptr <m> in-place 
(de idx-g3resize (m n0 n1 n2) 
    ((-idx3- (-gptr-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-g4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of gptr <m> in-place 
(de idx-g4resize (m n0 n1 n2 n3) 
    ((-idx4- (-gptr-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())

#? (idx-d1resize <m> <n0>)
;; redims idx1 of double <m> in-place 
;; with the new size <n0>. Unlike redim, it does not create a temporary
;; variable. Unlike idx-changedim, this macro increases the size of 
;; the storage if necessary. very efficient.
;; exists also in macro form.
;;.SEE (midx-m1resize <m> <n0>)
(de idx-d1resize (m n0) 
    ((-idx1- (-double-)) m) ((-int-) n0) (midx-m1resize m n0) ())

#? (idx-d2resize <m> <n0> <n1>)
;; redims idx2 of double <m> in-place 
(de idx-d2resize (m n0 n1) 
    ((-idx2- (-double-)) m) ((-int-) n0 n1) (midx-m2resize m n0 n1) ())

#? (idx-d3resize <m> <n0> <n1> <n2>)
;; redims idx3 of double <m> in-place 
(de idx-d3resize (m n0 n1 n2) 
    ((-idx3- (-double-)) m) ((-int-) n0 n1 n2) (midx-m3resize m n0 n1 n2) ())

#? (idx-d4resize <m> <n0> <n1> <n2> <n3>))
;; redims idx4 of double <m> in-place 
(de idx-d4resize (m n0 n1 n2 n3) 
    ((-idx4- (-double-)) m) ((-int-) n0 n1 n2 n3) (midx-m4resize m n0 n1 n2 n3) ())
(dmd idx-r1resize l (cons idx-d1resize l))
(dmd idx-r2resize l (cons idx-d2resize l))
(dmd idx-r3resize l (cons idx-d3resize l))
(dmd idx-r4resize l (cons idx-d4resize l))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; a few macros to write efficient C code from lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? *** Macros for common operations

#? (midx-m2oversample <input> <nlin> <ncol> <output>)
;; macro for 2D oversampling 
(dmd midx-m2oversample (out nlin ncol in)
     `(let* ((uin (unfold ,in 0 ,nlin ,nlin))
	     (uuin (unfold uin 1 ,ncol ,ncol)))
	(idx-eloop ((z1 uuin))
	  (idx-eloop ((z2 z1))
	    (idx-copy ,out z2)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? *** Obsolete Iterators for Inline C code
;; These function are kept for backward compatibility,
;; but a largely superseded by cidx-bloop described
;; in the Core section.

#? (cinline-idx1loop <m> <type> <c> <j> <p1> [<p2>...])
;; man, that's a tough one to explain.
;; don't try this at home anyway.
;; this thing is like a loop for cinline. It executes the cinline instructions
;; in <p1>... for each element of matrix <m> (must be an idx1).
;; <c>, and <j> must be strings containing valid C variable
;; identifiers, and <type> is a string that must contain a valid C type 
;; (like "float"). during the loop, C variable <c> will point to the current element
;; of <m>, and C variable <j> will contain the index of that element.
;; So a macro that fills the elements of a vector with its index plus a constant n
;; can be written:
;;.VP
;;  (cinline-idx1loop mat "flt" "p" "i" (cinline "*p = i+%s;" n))
;;
(dmd cinline-idx1loop (m type c j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type " *" c ";"))
	      (cinline ,(concat "  register int " j ", jmax = (%s)->dim[0];") ,m)
	      (cinline          "  register int imat1_m0 = (%s)->mod[0];" ,m)
	      (cinline ,(concat "  " c " = IDX_PTR((%s)," type ");") ,m)
	      (cinline ,(concat "  for (" j "=0; " j " <jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c " += imat1_m0;"))
	      (cinline "  } }")
	      ()))))

#? (cinline-idxloop2 <m1> <type1> <m2> <type2> <c1> <c2> <j> <p1> [<p2>...])
;; same as cinline-idx1loop, but loops simultaneously on two vectors
(dmd cinline-idx1loop2 (m1 type1 m2 type2 c1 c2 j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type1 " *" c1 ";"))
	      (cinline ,(concat "  register " type2 " *" c2 ";"))
	      (cinline ,(concat "  register int " j ", jmax = (%s)->dim[0];") ,m1)
	      (cinline          "  register int imat1_m0 = (%s)->mod[0];" ,m1)
	      (cinline          "  register int imat2_m0 = (%s)->mod[0];" ,m2)
	      (cinline ,(concat "  " c1 " = IDX_PTR((%s)," type1 ");") ,m1)
	      (cinline ,(concat "  " c2 " = IDX_PTR((%s)," type2 ");") ,m2)
	      (cinline ,(concat "  for (" j "=0; " j " <jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c1 " += imat1_m0;"))
	      (cinline ,(concat "    " c2 " += imat2_m0;"))
	      (cinline "  } }")
	      ()))))

#? (cinline-idxloop3 <m1> <type1> <m2> <type2> <m3> <type3> <c1> <c2> <c3> <j> <p1> [<p2>...])
;; same as cinline-idx1loop, but loops simultaneously on three vectors
(dmd cinline-idx1loop3 (m1 type1 m2 type2 m3 type3 c1 c2 c3 j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type1 " *" c1 ";"))
	      (cinline ,(concat "  register " type2 " *" c2 ";"))
	      (cinline ,(concat "  register " type3 " *" c3 ";"))
	      (cinline ,(concat "  register int " j ", jmax = (%s)->dim[0];") ,m1)
	      (cinline          "  register int imat1_m0 = (%s)->mod[0];" ,m1)
	      (cinline          "  register int imat2_m0 = (%s)->mod[0];" ,m2)
	      (cinline          "  register int imat3_m0 = (%s)->mod[0];" ,m3)
	      (cinline ,(concat "  " c1 " = IDX_PTR((%s)," type1 ");") ,m1)
	      (cinline ,(concat "  " c2 " = IDX_PTR((%s)," type2 ");") ,m2)
	      (cinline ,(concat "  " c3 " = IDX_PTR((%s)," type3 ");") ,m3)
	      (cinline ,(concat "  for (" j "=0; " j " <jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c1 " += imat1_m0;"))
	      (cinline ,(concat "    " c2 " += imat2_m0;"))
	      (cinline ,(concat "    " c3 " += imat3_m0;"))
	      (cinline "  } }")
	      ()))))


#? (cinline-idx2loop <m> <type> <c> <i> <j> [<l1>...])
;; same as cinline-idx1loop but loops over all elements of an idx2.
;; <i> and <j> are strings containing the C name of the row and column indices.
(dmd cinline-idx2loop (m type c i j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type " *_idx2loopc, *" c ";"))
	      (cinline ,(concat "  register int " i ", _imax = (%s)->dim[0];") ,m)
	      (cinline ,(concat "  register int " j ", _jmax = (%s)->dim[1];") ,m)
	      (cinline          "  register int _imat1_m0 = (%s)->mod[0];" ,m)
	      (cinline          "  register int _imat1_m1 = (%s)->mod[1];" ,m)
	      (cinline ,(concat "    _idx2loopc = IDX_PTR((%s)," type ");") ,m)
	      (cinline ,(concat "  for (" i "=0; " i " <_imax; " i "++){"))
	      (cinline ,(concat "    " c "= _idx2loopc;"))
	      (cinline ,(concat "    for (" j "=0; " j " <_jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c " += _imat1_m1;"))
	      (cinline          "    }")
	      (cinline          "     _idx2loopc += _imat1_m0;")
	      (cinline "  } }")
	      ()))))

#? (cinline-idx2loop2 <m1> <type1> <m2> <type2> <c1> <c2> <i> <j> [<l>...])
;; same as cinline-idx1loop2 but loops over all elements of an idx2.
;; <i> and <j> are strings containing the C name of the row and column indices.
(dmd cinline-idx2loop2 (m1 type1 m2 type2 c1 c2 i j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type1 " *_idx2loopc1, *" c1 ";"))
	      (cinline ,(concat "  register " type2 " *_idx2loopc2, *" c2 ";"))
	      (cinline ,(concat "  register int " i ", _imax = (%s)->dim[0];") ,m1)
	      (cinline ,(concat "  register int " j ", _jmax = (%s)->dim[1];") ,m1)
	      (cinline          "  register int _imat1_m0 = (%s)->mod[0];" ,m1)
	      (cinline          "  register int _imat1_m1 = (%s)->mod[1];" ,m1)
	      (cinline          "  register int _imat2_m0 = (%s)->mod[0];" ,m2)
	      (cinline          "  register int _imat2_m1 = (%s)->mod[1];" ,m2)
	      (cinline ,(concat "    _idx2loopc1 = IDX_PTR((%s)," type1 ");") ,m1)
	      (cinline ,(concat "    _idx2loopc2 = IDX_PTR((%s)," type2 ");") ,m2)
	      (cinline ,(concat "  for (" i "=0; " i " <_imax; " i "++){"))
	      (cinline ,(concat "    " c1 "= _idx2loopc1;"))
	      (cinline ,(concat "    " c2 "= _idx2loopc2;"))
	      (cinline ,(concat "    for (" j "=0; " j " <_jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c1 " += _imat1_m1;"))
	      (cinline ,(concat "    " c2 " += _imat2_m1;"))
	      (cinline          "    }")
	      (cinline          "     _idx2loopc1 += _imat1_m0;")
	      (cinline          "     _idx2loopc2 += _imat2_m0;")
	      (cinline "  } }")
	      ()))))

#? (cinline-idx2loop3 <m1> <type1> <m2> <type2> <m3> <type3> <c1> <c2> <c3> <i> <j> [<l>...])
;; same as cinline-idx1loop3 but loops over all elements of an idx2.
;; <i> and <j> are strings containing the C name of the row and column indices.
(dmd cinline-idx2loop3 (m1 type1 m2 type2 m3 type3 c1 c2 c3 i j . l)
     (cons 'progn
	   (append
	    `((cinline ,(concat "{ register " type1 " *_idx2loopc1, *" c1 ";"))
	      (cinline ,(concat "  register " type2 " *_idx2loopc2, *" c2 ";"))
	      (cinline ,(concat "  register " type3 " *_idx2loopc3, *" c3 ";"))
	      (cinline ,(concat "  register int " i ", _imax = (%s)->dim[0];") ,m1)
	      (cinline ,(concat "  register int " j ", _jmax = (%s)->dim[1];") ,m1)
	      (cinline          "  register int _imat1_m0 = (%s)->mod[0];" ,m1)
	      (cinline          "  register int _imat1_m1 = (%s)->mod[1];" ,m1)
	      (cinline          "  register int _imat2_m0 = (%s)->mod[0];" ,m2)
	      (cinline          "  register int _imat2_m1 = (%s)->mod[1];" ,m2)
	      (cinline          "  register int _imat3_m0 = (%s)->mod[0];" ,m3)
	      (cinline          "  register int _imat3_m1 = (%s)->mod[1];" ,m3)
	      (cinline ,(concat "    _idx2loopc1 = IDX_PTR((%s)," type1 ");") ,m1)
	      (cinline ,(concat "    _idx2loopc2 = IDX_PTR((%s)," type2 ");") ,m2)
	      (cinline ,(concat "    _idx2loopc3 = IDX_PTR((%s)," type3 ");") ,m3)
	      (cinline ,(concat "  for (" i "=0; " i " <_imax; " i "++){"))
	      (cinline ,(concat "    " c1 "= _idx2loopc1;"))
	      (cinline ,(concat "    " c2 "= _idx2loopc2;"))
	      (cinline ,(concat "    " c3 "= _idx2loopc3;"))
	      (cinline ,(concat "    for (" j "=0; " j " <_jmax; " j "++){")))
	    l
	    `((cinline ,(concat "    " c1 " += _imat1_m1;"))
	      (cinline ,(concat "    " c2 " += _imat2_m1;"))
	      (cinline ,(concat "    " c3 " += _imat3_m1;"))
	      (cinline          "    }")
	      (cinline          "     _idx2loopc1 += _imat1_m0;")
	      (cinline          "     _idx2loopc2 += _imat2_m0;")
	      (cinline          "     _idx2loopc3 += _imat3_m0;")
	      (cinline "  } }")
	      ()))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(dhc-make ()
	  idx-f1resize idx-f2resize idx-f3resize idx-f4resize
	  idx-i1resize idx-i2resize idx-i3resize idx-i4resize
  	  idx-s1resize idx-s2resize idx-s3resize idx-s4resize
  	  idx-b1resize idx-b2resize idx-b3resize idx-b4resize
  	  idx-u1resize idx-u2resize idx-u3resize idx-u4resize
  	  idx-g1resize idx-g2resize idx-g3resize idx-g4resize
  	  idx-d1resize idx-d2resize idx-d3resize idx-d4resize
         )
