anchor.diff:    `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
        ,@(when doc (list doc))))
   
  -(deftype uint8 () '(unsigned-byte 8))
  -
   (eval-when (:compile-toplevel :load-toplevel)
   
  +(defun uint8-array (&rest contents)
  +  (the uint8-array (make-array (length contents) :element-type 'uint8
  +			       :initial-contents contents)))
  +  
   (defun 2d-uint8-array (&rest contents)
     (let ((nrow (length contents)))
  -    (make-array nrow :initial-contents
  +    (the uint8-2d-array
  +	 (make-array nrow
  +		:element-type 'uint8-array
  +		:initial-contents
                   (loop for row in contents
                         collecting (make-array (length row) :element-type 'uint8
  -                                             :initial-contents row)))))
  +                                             :initial-contents row))))))
  +
  +(defun 2d-fixnum-array (&rest contents)
  +  (let ((nrow (length contents)))
  +    (the uint8-2d-array
  +	 (make-array nrow
  +		:element-type 'fixnum-array
  +		:initial-contents
  +                (loop for row in contents
  +                      collecting (make-array (length row) :element-type 'fixnum
  +                                             :initial-contents row))))))
   
   ;;; Source huffman tables for the encoder
   (define-constant +luminance-dc-bits+
  -  #(#x00 #x01 #x05 #x01 #x01 #x01 #x01 #x01
  -     #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
  +    (uint8-array #x00 #x01 #x05 #x01 #x01 #x01 #x01 #x01
  +		 #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
   
   (define-constant +luminance-dc-values+
  -  #(#x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
  +    (uint8-array #x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
   
   (define-constant +chrominance-dc-bits+
  -  #(#x00 #x03 #x01 #x01 #x01 #x01 #x01 #x01
  -     #x01 #x01 #x01 #x00 #x00 #x00 #x00 #x00))
  +    (uint8-array #x00 #x03 #x01 #x01 #x01 #x01 #x01 #x01
  +		 #x01 #x01 #x01 #x00 #x00 #x00 #x00 #x00))
   
   (define-constant +chrominance-dc-values+
  -  #(#x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
  +    (uint8-array #x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
   
   (define-constant +luminance-ac-bits+
  -  #(#x00 #x02 #x01 #x03 #x03 #x02 #x04 #x03
  -     #x05 #x05 #x04 #x04 #x00 #x00 #x01 #x7d))
  +    (uint8-array #x00 #x02 #x01 #x03 #x03 #x02 #x04 #x03
  +		 #x05 #x05 #x04 #x04 #x00 #x00 #x01 #x7d))
   
   (define-constant +luminance-ac-values+
  -  #(#x01 #x02 #x03 #x00 #x04 #x11 #x05 #x12
  +    (uint8-array
  +     #x01 #x02 #x03 #x00 #x04 #x11 #x05 #x12
        #x21 #x31 #x41 #x06 #x13 #x51 #x61 #x07
        #x22 #x71 #x14 #x32 #x81 #x91 #xa1 #x08
        #x23 #x42 #xb1 #xc1 #x15 #x52 #xd1 #xf0
  
positive.code: ;;  -*- Mode: LISP; Package: (JPEG :use (common-lisp)) -*-
  ;;; Generic Common Lisp JPEG encoder/decoder implementation
  ;;; $Id: jpeg.lisp,v 1.6 2011-03-14 22:49:00 charmon Exp $
  ;;; Version 1.3, August 2015
  ;;; Written by Eugene Zaikonnikov [eugene@funcall.org]
  ;;; Copyright [c] 1999,2015, Eugene Zaikonnikov <eugene@funcall.org>
  ;;;               
  ;;; This software is distributed under the terms of BSD-like license
  
negative.code:               (setf z4 (mul z4 (- +fix-0-390180644+)))
                (incf z3 z5)
                (incf z4 z5)
                (setf (fixref data cnt 7) (descale (plus3 tmp4 z1 z3) +shift+1+))
                (setf (fixref data cnt 5) (descale (plus3 tmp5 z2 z4) +shift+1+))
                (setf (fixref data cnt 3) (descale (plus3 tmp6 z2 z3) +shift+1+))
                (setf (fixref data cnt 1) (descale (plus3 tmp7 z1 z4) +shift+1+)))
          (return)))
  
  ;;; Forward DCT and quantization
  (defun crunch (buf pos table)
    (declare #.*optimize*
             (type fixnum pos)
             (type (simple-array fixnum-2d-array (*)) buf))
    (llm-dct (aref buf pos))
    (quantize (aref buf pos) table))
  
  ;;; Q-tables scaling
  (defun q-scale (table q-factor)
    (declare #.*optimize*
  	   (type uint8-2d-array table)
  	   (type uint8 q-factor))
    (when (/= q-factor 64)
      (let ((factor (the uint8 (/ q-factor 64))))
        (loop for q-row of-type uint8-array across table do
              (loop for x fixnum from 0 to 7 do
                    (setf (aref q-row x)
                          (the fixnum (round (* (aref q-row x) factor)))))))))
  
  ;;; Function that maps value into SSSS
  (defun csize (n)
      (declare #.*optimize* (type fixnum n))
      (aref +csize+ (plus n 1023)))
  
  ;;; zigzag ordering
  (defun zigzag (buffer)
    (declare #.*optimize*
  	   (type fixnum-2d-array buffer)
  	   (type fixnum-array *zz-result*))
    (loop for row of-type fixnum-array across buffer
       for z-row of-type uint8-array across +zigzag-index+ do
         (loop for x fixnum from 0 to 7 do
  	    (setf (aref *zz-result* (aref z-row x))
  		  (the fixnum (aref row x)))))
    *zz-result*)
  
  (defun zigzag8 (buffer)
    (let ((zz-result (make-array 64 :element-type 'uint8)))
      (declare #.*optimize*
  	     (type uint8-2d-array buffer)
  	     (type uint8-array zz-result))
      (loop for row of-type uint8-array across buffer
         for z-row of-type uint8-array across +zigzag-index+ do
  	 (loop for x fixnum from 0 to 7 do
  	      (setf (aref zz-result (aref z-row x))
  		    (the fixnum (aref row x)))))
      zz-result))
  
  ;;; Writes frame header
  (defun write-frame-header (maxX maxY cn q-tables sampling tqv out-stream)
    (declare #.*optimize* (type fixnum maxX maxY cn)
  	   (type (simple-array uint8-2d-array (*)) q-tables)
  	   ;;(type uint8-array tqv)
  	   )
    (write-huffman-tables out-stream)
    (write-quantization-tables q-tables out-stream)
    ;; writing frame header
  