From charmon at common-lisp.net  Mon Mar 14 21:44:58 2011
From: charmon at common-lisp.net (charmon)
Date: Mon, 14 Mar 2011 17:44:58 -0400
Subject: [cl-jpeg-cvs] CVS cljl
Message-ID: <E1PzFZS-00081z-Nu@common-lisp.net>

Update of /project/cl-jpeg/cvsroot/cljl
In directory cl-net:/tmp/cvs-serv30853

Modified Files:
	cl-jpeg.asd jpeg.lisp 
Log Message:
rename constants as +foo+ instead of *foo* (or foo).


--- /project/cl-jpeg/cvsroot/cljl/cl-jpeg.asd	2008/05/10 05:53:19	1.2
+++ /project/cl-jpeg/cvsroot/cljl/cl-jpeg.asd	2011/03/14 21:44:58	1.3
@@ -2,7 +2,7 @@
 
 (asdf:defsystem :cl-jpeg
   :name "cl-jpeg"
-  :version 1.023
+  :version 1.024
   :licence "BSD"
   :components ((:file "jpeg")))
 
--- /project/cl-jpeg/cvsroot/cljl/jpeg.lisp	2008/12/03 04:30:38	1.4
+++ /project/cl-jpeg/cvsroot/cljl/jpeg.lisp	2011/03/14 21:44:58	1.5
@@ -1,6 +1,6 @@
 ;;  -*- Mode: LISP; Package: (JPEG :use (common-lisp)) -*-
 ;;; Generic Common Lisp JPEG encoder/decoder implementation
-;;; $Id: jpeg.lisp,v 1.4 2008/12/03 04:30:38 charmon Exp $
+;;; $Id: jpeg.lisp,v 1.5 2011/03/14 21:44:58 charmon Exp $
 ;;; Version 1.023, May 2008
 ;;; Written by Eugene Zaikonnikov [viking at funcall.org]
 ;;; Copyright [c] 1999, Eugene Zaikonnikov <viking at funcall.org>
@@ -106,25 +106,25 @@
 (eval-when (:compile-toplevel :load-toplevel)
 
 ;;; Source huffman tables for the encoder
-(define-constant *luminance-dc-bits*
+(define-constant +luminance-dc-bits+
   #(#x00 #x01 #x05 #x01 #x01 #x01 #x01 #x01
      #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
 
-(define-constant *luminance-dc-values*
+(define-constant +luminance-dc-values+
   #(#x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
 
-(define-constant *chrominance-dc-bits*
+(define-constant +chrominance-dc-bits+
   #(#x00 #x03 #x01 #x01 #x01 #x01 #x01 #x01
      #x01 #x01 #x01 #x00 #x00 #x00 #x00 #x00))
 
-(define-constant *chrominance-dc-values*
+(define-constant +chrominance-dc-values+
   #(#x00 #x01 #x02 #x03 #x04 #x05 #x06 #x07 #x08 #x09 #x0a #x0b))
 
-(define-constant *luminance-ac-bits*
+(define-constant +luminance-ac-bits+
   #(#x00 #x02 #x01 #x03 #x03 #x02 #x04 #x03
      #x05 #x05 #x04 #x04 #x00 #x00 #x01 #x7d))
 
-(define-constant *luminance-ac-values*
+(define-constant +luminance-ac-values+
   #(#x01 #x02 #x03 #x00 #x04 #x11 #x05 #x12
      #x21 #x31 #x41 #x06 #x13 #x51 #x61 #x07
      #x22 #x71 #x14 #x32 #x81 #x91 #xa1 #x08
@@ -147,11 +147,11 @@
      #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 #xf8
      #xf9 #xfa))
 
-(define-constant *chrominance-ac-bits*
+(define-constant +chrominance-ac-bits+
   #(#x00 #x02 #x01 #x02 #x04 #x04 #x03 #x04
      #x07 #x05 #x04 #x04 #x00 #x01 #x02 #x77))
 
-(define-constant *chrominance-ac-values*
+(define-constant +chrominance-ac-values+
   #(#x00 #x01 #x02 #x03 #x11 #x04 #x05 #x21
      #x31 #x06 #x12 #x41 #x51 #x07 #x61 #x71
      #x13 #x22 #x32 #x81 #x08 #x14 #x42 #x91
@@ -175,7 +175,7 @@
      #xf9 #xfa))
 
 ;;;Zigzag encoding matrix
-(define-constant *zigzag-index*
+(define-constant +zigzag-index+
   #(#(0  1  5  6 14 15 27 28)
     #(2  4  7 13 16 26 29 42)
     #(3  8 12 17 25 30 41 43)
@@ -188,7 +188,7 @@
 ;;; Temporary buffer for zigzag encoding and decoding
 (defvar *zz-result* (make-array 64 :element-type 'unsigned-byte))
 
-(define-constant *zzbuf*
+(define-constant +zzbuf+
   #(#(0  0  0  0  0  0  0  0)
     #(0  0  0  0  0  0  0  0)
     #(0  0  0  0  0  0  0  0)
@@ -199,19 +199,19 @@
     #(0  0  0  0  0  0  0  0)))
 
 ;;;JPEG file markers
-(defconstant *M_COM* #xfe)
-(defconstant *M_SOF0* #xc0)
-(defconstant *M_DHT* #xc4)
-(defconstant *M_RST0* #xd0)
-(defconstant *M_RST7* #xd7)
-(defconstant *M_SOI* #xd8)
-(defconstant *M_EOI* #xd9)
-(defconstant *M_SOS* #xda)
-(defconstant *M_DQT* #xdb)
-(defconstant *M_DNL* #xdc)
-(defconstant *M_DRI* #xdd)
-(defconstant *M_DAC* #xcc)
-(defconstant *M_APP0* #xe0)
+(defconstant +M_COM+ #xfe)
+(defconstant +M_SOF0+ #xc0)
+(defconstant +M_DHT+ #xc4)
+(defconstant +M_RST0+ #xd0)
+(defconstant +M_RST7+ #xd7)
+(defconstant +M_SOI+ #xd8)
+(defconstant +M_EOI+ #xd9)
+(defconstant +M_SOS+ #xda)
+(defconstant +M_DQT+ #xdb)
+(defconstant +M_DNL+ #xdc)
+(defconstant +M_DRI+ #xdd)
+(defconstant +M_DAC+ #xcc)
+(defconstant +M_APP0+ #xe0)
 
 ;;; Default quantization tables
 (defvar *q-luminance*
@@ -297,65 +297,65 @@
 (finish-output)
 )
 
-(define-constant *q-tables* (vector *q-luminance* *q-chrominance*))
+(define-constant +q-tables+ (vector *q-luminance* *q-chrominance*))
 
 ;;; This table is used to map coefficients into SSSS value
-(define-constant *csize* (make-array 2047 
+(define-constant +csize+ (make-array 2047 
 				 :initial-contents
 				 (loop for i fixnum from 0 to 2046
 				       collecting (integer-length (abs (minus i 1023))))))
 
 ;;; Some constants for colorspace mapper
 (defconstant shift (1- (integer-length (ash most-positive-fixnum -7))))
-(defconstant *.299* (round (+ (* 0.299 (ash 1 shift)) 0.5)))
-(defconstant *.587* (round (+ (* 0.587 (ash 1 shift)) 0.5)))
-(defconstant *.114* (round (+ (* 0.114 (ash 1 shift)) 0.5)))
-(defconstant *-.1687* (round (+ (* -0.1687 (ash 1 shift)) 0.5)))
-(defconstant *-.3313* (round (+ (* -0.3313 (ash 1 shift)) 0.5)))
-(defconstant *-.4187* (round (+ (* -0.4187 (ash 1 shift)) 0.5)))
-(defconstant *-.0813* (round (+ (* -0.0813 (ash 1 shift)) 0.5)))
-(defconstant *.5* (round (+ (* 0.5 (ash 1 shift)) 0.5)))
-(defconstant uvoffset (ash 128 shift))
-(defconstant onehalf (1- (ash 1 (1- shift))))
-(defconstant r-y-off 0)
-(defconstant g-y-off 256)
-(defconstant b-y-off (* 2 256))
-(defconstant r-u-off (* 3 256))
-(defconstant g-u-off (* 4 256))
-(defconstant b-u-off (* 5 256))
-(defconstant r-v-off b-u-off)
-(defconstant g-v-off (* 6 256))
-(defconstant b-v-off (* 7 256))
+(defconstant +.299+ (round (+ (* 0.299 (ash 1 shift)) 0.5)))
+(defconstant +.587+ (round (+ (* 0.587 (ash 1 shift)) 0.5)))
+(defconstant +.114+ (round (+ (* 0.114 (ash 1 shift)) 0.5)))
+(defconstant +-.1687+ (round (+ (* -0.1687 (ash 1 shift)) 0.5)))
+(defconstant +-.3313+ (round (+ (* -0.3313 (ash 1 shift)) 0.5)))
+(defconstant +-.4187+ (round (+ (* -0.4187 (ash 1 shift)) 0.5)))
+(defconstant +-.0813+ (round (+ (* -0.0813 (ash 1 shift)) 0.5)))
+(defconstant +.5+ (round (+ (* 0.5 (ash 1 shift)) 0.5)))
+(defconstant +uvoffset+ (ash 128 shift))
+(defconstant +one-half+ (1- (ash 1 (1- shift))))
+(defconstant +r-y-off+ 0)
+(defconstant +g-y-off+ 256)
+(defconstant +b-y-off+ (* 2 256))
+(defconstant +r-u-off+ (* 3 256))
+(defconstant +g-u-off+ (* 4 256))
+(defconstant +b-u-off+ (* 5 256))
+(defconstant +r-v-off+ +b-u-off+)
+(defconstant +g-v-off+ (* 6 256))
+(defconstant +b-v-off+ (* 7 256))
 
 ;;;Direct color conversion table
 (defvar *ctab* (make-array 2048 :initial-element 0))
 
 ;;; Filling in the table
 (loop for i fixnum from 0 to 255 do
-      (setf (svref *ctab* (plus i r-y-off))
-            (mul *.299* i))
-      (setf (svref *ctab* (plus i g-y-off))
-            (mul *.587* i))
-      (setf (svref *ctab* (plus i b-y-off))
-            (mul *.114* i))
-      (setf (svref *ctab* (plus i r-u-off))
-            (mul *-.1687* i))
-      (setf (svref *ctab* (plus i g-u-off))
-            (mul *-.3313* i))
-      (setf (svref *ctab* (plus i b-u-off))
-            (+ (mul *.5* i) uvoffset onehalf))
-      (setf (svref *ctab* (plus i r-v-off))
-            (+ (mul *.5* i) uvoffset onehalf))
-      (setf (svref *ctab* (plus i g-v-off))
-            (mul *-.4187* i))
-      (setf (svref *ctab* (plus i b-v-off))
-            (mul *-.0813* i)))
+      (setf (svref *ctab* (plus i +r-y-off+))
+            (mul +.299+ i))
+      (setf (svref *ctab* (plus i +g-y-off+))
+            (mul +.587+ i))
+      (setf (svref *ctab* (plus i +b-y-off+))
+            (mul +.114+ i))
+      (setf (svref *ctab* (plus i +r-u-off+))
+            (mul +-.1687+ i))
+      (setf (svref *ctab* (plus i +g-u-off+))
+            (mul +-.3313+ i))
+      (setf (svref *ctab* (plus i +b-u-off+))
+            (+ (mul +.5+ i) +uvoffset+ +one-half+))
+      (setf (svref *ctab* (plus i +r-v-off+))
+            (+ (mul +.5+ i) +uvoffset+ +one-half+))
+      (setf (svref *ctab* (plus i +g-v-off+))
+            (mul +-.4187+ i))
+      (setf (svref *ctab* (plus i +b-v-off+))
+            (mul +-.0813+ i)))
 
 ;;; Constantsants for the inverse colorspace conversion
-(defconstant *1.40200* (round (+ (* 1.40200 (ash 1 shift)) 0.5)))
-(defconstant *1.77200* (round (+ (* 1.77200 (ash 1 shift)) 0.5)))
-(defconstant *-0.71414* (round (+ (* -0.71414 (ash 1 shift)) 0.5)))
-(defconstant *-0.34414* (round (+ (* -0.34414 (ash 1 shift)) 0.5)))
+(defconstant +1.40200+ (round (+ (* 1.40200 (ash 1 shift)) 0.5)))
+(defconstant +1.77200+ (round (+ (* 1.77200 (ash 1 shift)) 0.5)))
+(defconstant +-0.71414+ (round (+ (* -0.71414 (ash 1 shift)) 0.5)))
+(defconstant +-0.34414+ (round (+ (* -0.34414 (ash 1 shift)) 0.5)))
 
 ;;; Inverse color conversion tables
 (defvar *cr-r-tab* (make-array 256))
@@ -366,10 +366,10 @@
 ;;; Filling up the tables
 (loop for i from 0 to 255
       for x from -127 do
-      (setf (svref *cr-r-tab* i) (ash (plus (mul *1.40200* x) onehalf) (- shift)))
-      (setf (svref *cb-b-tab* i) (ash (plus (mul *1.77200* x) onehalf) (- shift)))
-      (setf (svref *cr-g-tab* i) (mul *-0.71414* x))
-      (setf (svref *cb-g-tab* i) (plus (mul *-0.34414* x) onehalf)))
+      (setf (svref *cr-r-tab* i) (ash (plus (mul +1.40200+ x) +one-half+) (- shift)))
+      (setf (svref *cb-b-tab* i) (ash (plus (mul +1.77200+ x) +one-half+) (- shift)))
+      (setf (svref *cr-g-tab* i) (mul +-0.71414+ x))
+      (setf (svref *cb-g-tab* i) (plus (mul +-0.34414+ x) +one-half+)))
 
 ;;; Temporary workspace for IDCT
 (defvar *ws* (make-array 8 :initial-contents (loop for i from 0 to 7 collecting (make-array 8))))
@@ -380,21 +380,21 @@
       (minus 13 (round (minus 31 (integer-length most-positive-fixnum)) 2))
     13))
 
-(defconstant shift-1 (1- dct-shift))
-(defconstant shift+1 (1+ dct-shift))
-(defconstant shift+4 (+ dct-shift 4))
-(defconstant FIX-0-298631336 (round (+ (* 0.298631336 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-0-390180644 (round (+ (* 0.390180644 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-0-541196100 (round (+ (* 0.541196100 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-0-765366865 (round (+ (* 0.765366865 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-0-899976223 (round (+ (* 0.899976223 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-1-175875602 (round (+ (* 1.175875602 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-1-501321110 (round (+ (* 1.501321110 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-1-847759065 (round (+ (* 1.847759065 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-1-961570560 (round (+ (* 1.961570560 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-2-053119869 (round (+ (* 2.053119869 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-2-562915447 (round (+ (* 2.562915447 (ash 1 dct-shift)) 0.5)))
-(defconstant FIX-3-072711026 (round (+ (* 3.072711026 (ash 1 dct-shift)) 0.5)))
+(defconstant +shift-1+ (1- dct-shift))
+(defconstant +shift+1+ (1+ dct-shift))
+(defconstant +shift+4+ (+ dct-shift 4))
+(defconstant +FIX-0-298631336+ (round (+ (* 0.298631336 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-0-390180644+ (round (+ (* 0.390180644 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-0-541196100+ (round (+ (* 0.541196100 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-0-765366865+ (round (+ (* 0.765366865 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-0-899976223+ (round (+ (* 0.899976223 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-1-175875602+ (round (+ (* 1.175875602 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-1-501321110+ (round (+ (* 1.501321110 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-1-847759065+ (round (+ (* 1.847759065 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-1-961570560+ (round (+ (* 1.961570560 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-2-053119869+ (round (+ (* 2.053119869 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-2-562915447+ (round (+ (* 2.562915447 (ash 1 dct-shift)) 0.5)))
+(defconstant +FIX-3-072711026+ (round (+ (* 3.072711026 (ash 1 dct-shift)) 0.5)))
 
 ;;; Post-IDCT limiting array
 (defvar *idct-limit-array* (make-array 512 :initial-element 0))
@@ -482,19 +482,19 @@
                 for b fixnum = (svref rgb pos)
                 for cx fixnum = (minus xd dx)
                 for cy fixnum = (minus yd dy) do
-                (setf (dbref Y cx cy) (minus (ash (+ (svref *ctab* (plus r r-y-off))
-                                                          (svref *ctab* (plus g g-y-off))
-                                                          (svref *ctab* (plus b b-y-off)))
+                (setf (dbref Y cx cy) (minus (ash (+ (svref *ctab* (plus r +r-y-off+))
+                                                          (svref *ctab* (plus g +g-y-off+))
+                                                          (svref *ctab* (plus b +b-y-off+)))
                                                        (- shift))
                                              128))
-                (setf (dbref U cx cy) (minus (ash (+ (svref *ctab* (plus r r-u-off))
-                                                          (svref *ctab* (plus g g-u-off))
-                                                          (svref *ctab* (plus b b-u-off)))
+                (setf (dbref U cx cy) (minus (ash (+ (svref *ctab* (plus r +r-u-off+))
+                                                          (svref *ctab* (plus g +g-u-off+))
+                                                          (svref *ctab* (plus b +b-u-off+)))
                                                        (- shift))
                                              128))
-                (setf (dbref V cx cy) (minus (ash (+ (svref *ctab* (plus r r-v-off))
-                                                          (svref *ctab* (plus g g-v-off))
-                                                          (svref *ctab* (plus b b-v-off)))
+                (setf (dbref V cx cy) (minus (ash (+ (svref *ctab* (plus r +r-v-off+))
+                                                          (svref *ctab* (plus g +g-v-off+))
+                                                          (svref *ctab* (plus b +b-v-off+)))
                                                        (- shift))
                                              128))))
     (values xend yend)))
@@ -577,28 +577,28 @@
               (setf tmp12 (minus tmp1 tmp2))
               (setf (svref dptr 0) (ash (plus tmp10 tmp11) 1))
               (setf (svref dptr 4) (ash (minus tmp10 tmp11) 1))
-              (setf z1 (mul (plus tmp12 tmp13) fix-0-541196100))
-              (setf (svref dptr 2) (descale (plus z1 (mul tmp13 fix-0-765366865)) shift-1))
-              (setf (svref dptr 6) (descale (plus z1 (mul tmp12 (- fix-1-847759065))) shift-1))
+              (setf z1 (mul (plus tmp12 tmp13) +FIX-0-541196100+))
+              (setf (svref dptr 2) (descale (plus z1 (mul tmp13 +FIX-0-765366865+)) +shift-1+))
+              (setf (svref dptr 6) (descale (plus z1 (mul tmp12 (- +FIX-1-847759065+))) +shift-1+))
               (setf z1 (plus tmp4 tmp7))
               (setf z2 (plus tmp5 tmp6))
               (setf z3 (plus tmp4 tmp6))
               (setf z4 (plus tmp5 tmp7))
-              (setf z5 (mul (plus z3 z4) fix-1-175875602))
-              (setf tmp4 (mul tmp4 fix-0-298631336))
-              (setf tmp5 (mul tmp5 fix-2-053119869))
-              (setf tmp6 (mul tmp6 fix-3-072711026))
-              (setf tmp7 (mul tmp7 fix-1-501321110))
-              (setf z1 (mul z1 (- fix-0-899976223)))
-              (setf z2 (mul z2 (- fix-2-562915447)))
-              (setf z3 (mul z3 (- fix-1-961570560)))
-              (setf z4 (mul z4 (- fix-0-390180644)))
+              (setf z5 (mul (plus z3 z4) +FIX-1-175875602+))
+              (setf tmp4 (mul tmp4 +fix-0-298631336+))
+              (setf tmp5 (mul tmp5 +fix-2-053119869+))
+              (setf tmp6 (mul tmp6 +fix-3-072711026+))
+              (setf tmp7 (mul tmp7 +fix-1-501321110+))
+              (setf z1 (mul z1 (- +fix-0-899976223+)))
+              (setf z2 (mul z2 (- +fix-2-562915447+)))
+              (setf z3 (mul z3 (- +fix-1-961570560+)))
+              (setf z4 (mul z4 (- +fix-0-390180644+)))
               (incf z3 z5)
               (incf z4 z5)
-              (setf (svref dptr 7) (descale (plus3 tmp4 z1 z3) shift-1))
-              (setf (svref dptr 5) (descale (plus3 tmp5 z2 z4) shift-1))
-              (setf (svref dptr 3) (descale (plus3 tmp6 z2 z3) shift-1))
-              (setf (svref dptr 1) (descale (plus3 tmp7 z1 z4) shift-1)))
+              (setf (svref dptr 7) (descale (plus3 tmp4 z1 z3) +shift-1+))
+              (setf (svref dptr 5) (descale (plus3 tmp5 z2 z4) +shift-1+))
+              (setf (svref dptr 3) (descale (plus3 tmp6 z2 z3) +shift-1+))
+              (setf (svref dptr 1) (descale (plus3 tmp7 z1 z4) +shift-1+)))
         (loop for cnt fixnum from 7 downto 0 do ;second pass: on columns
               (setf tmp0 (plus (dbref data cnt 0) (dbref data cnt 7)))
               (setf tmp7 (minus (dbref data cnt 0) (dbref data cnt 7)))
@@ -614,28 +614,28 @@
               (setf tmp12 (minus tmp1 tmp2))
               (setf (dbref data cnt 0) (descale (plus tmp10 tmp11) 1))
               (setf (dbref data cnt 4) (descale (minus tmp10 tmp11) 1))
-              (setf z1 (mul (plus tmp12 tmp13) fix-0-541196100))
-              (setf (dbref data cnt 2) (descale (plus z1 (mul tmp13 fix-0-765366865)) shift+1))
-              (setf (dbref data cnt 6) (descale (plus z1 (mul tmp12 (- fix-1-847759065))) shift+1))
+              (setf z1 (mul (plus tmp12 tmp13) +fix-0-541196100+))
+              (setf (dbref data cnt 2) (descale (plus z1 (mul tmp13 +fix-0-765366865+)) +shift+1+))
+              (setf (dbref data cnt 6) (descale (plus z1 (mul tmp12 (- +fix-1-847759065+))) +shift+1+))
               (setf z1 (plus tmp4 tmp7))
               (setf z2 (plus tmp5 tmp6))
               (setf z3 (plus tmp4 tmp6))
               (setf z4 (plus tmp5 tmp7))
-              (setf z5 (mul (plus z3 z4) fix-1-175875602))
-              (setf tmp4 (mul tmp4 fix-0-298631336))
-              (setf tmp5 (mul tmp5 fix-2-053119869))
-              (setf tmp6 (mul tmp6 fix-3-072711026))
-              (setf tmp7 (mul tmp7 fix-1-501321110))
-              (setf z1 (mul z1 (- fix-0-899976223)))
-              (setf z2 (mul z2 (- fix-2-562915447)))
-              (setf z3 (mul z3 (- fix-1-961570560)))
-              (setf z4 (mul z4 (- fix-0-390180644)))
+              (setf z5 (mul (plus z3 z4) +fix-1-175875602+))
+              (setf tmp4 (mul tmp4 +fix-0-298631336+))
+              (setf tmp5 (mul tmp5 +fix-2-053119869+))
+              (setf tmp6 (mul tmp6 +fix-3-072711026+))
+              (setf tmp7 (mul tmp7 +fix-1-501321110+))
+              (setf z1 (mul z1 (- +fix-0-899976223+)))
+              (setf z2 (mul z2 (- +fix-2-562915447+)))
+              (setf z3 (mul z3 (- +fix-1-961570560+)))
+              (setf z4 (mul z4 (- +fix-0-390180644+)))
               (incf z3 z5)
               (incf z4 z5)
-              (setf (dbref data cnt 7) (descale (plus3 tmp4 z1 z3) shift+1))
-              (setf (dbref data cnt 5) (descale (plus3 tmp5 z2 z4) shift+1))
-              (setf (dbref data cnt 3) (descale (plus3 tmp6 z2 z3) shift+1))
-              (setf (dbref data cnt 1) (descale (plus3 tmp7 z1 z4) shift+1)))
+              (setf (dbref data cnt 7) (descale (plus3 tmp4 z1 z3) +shift+1+))
+              (setf (dbref data cnt 5) (descale (plus3 tmp5 z2 z4) +shift+1+))
+              (setf (dbref data cnt 3) (descale (plus3 tmp6 z2 z3) +shift+1+))
+              (setf (dbref data cnt 1) (descale (plus3 tmp7 z1 z4) +shift+1+)))
         (return)))
 
 ;;; Forward DCT and quantization
@@ -659,13 +659,13 @@
 ;;; Function that maps value into SSSS
 (defun csize (n)
     (declare #.*optimize* (type fixnum n))
-    (svref *csize* (plus n 1023)))
+    (svref +csize+ (plus n 1023)))
 
 ;;; zigzag ordering
 (defun zigzag (buffer)
   (declare #.*optimize* (type (simple-vector 8) buffer))
   (loop for row across buffer
-        for z-row across *zigzag-index* do
+        for z-row across +zigzag-index+ do

[297 lines skipped]




From charmon at common-lisp.net  Mon Mar 14 22:49:00 2011
From: charmon at common-lisp.net (charmon)
Date: Mon, 14 Mar 2011 18:49:00 -0400
Subject: [cl-jpeg-cvs] CVS cljl
Message-ID: <E1PzGZQ-0004yl-H8@common-lisp.net>

Update of /project/cl-jpeg/cvsroot/cljl
In directory cl-net:/tmp/cvs-serv19139

Modified Files:
	cl-jpeg.asd jpeg.lisp 
Log Message:
put reader conditionals in minus macro instead of at call site and make abcl use - instead of fixnum'ized -


--- /project/cl-jpeg/cvsroot/cljl/cl-jpeg.asd	2011/03/14 21:44:58	1.3
+++ /project/cl-jpeg/cvsroot/cljl/cl-jpeg.asd	2011/03/14 22:49:00	1.4
@@ -2,7 +2,7 @@
 
 (asdf:defsystem :cl-jpeg
   :name "cl-jpeg"
-  :version 1.024
+  :version 1.025
   :licence "BSD"
   :components ((:file "jpeg")))
 
--- /project/cl-jpeg/cvsroot/cljl/jpeg.lisp	2011/03/14 21:44:58	1.5
+++ /project/cl-jpeg/cvsroot/cljl/jpeg.lisp	2011/03/14 22:49:00	1.6
@@ -1,6 +1,6 @@
 ;;  -*- Mode: LISP; Package: (JPEG :use (common-lisp)) -*-
 ;;; Generic Common Lisp JPEG encoder/decoder implementation
-;;; $Id: jpeg.lisp,v 1.5 2011/03/14 21:44:58 charmon Exp $
+;;; $Id: jpeg.lisp,v 1.6 2011/03/14 22:49:00 charmon Exp $
 ;;; Version 1.023, May 2008
 ;;; Written by Eugene Zaikonnikov [viking at funcall.org]
 ;;; Copyright [c] 1999, Eugene Zaikonnikov <viking at funcall.org>
@@ -85,6 +85,9 @@
   `(the fixnum (+ (the fixnum ,a) (the fixnum ,b))))
 
 (defmacro minus (a b)
+  #+(or clisp abcl)
+  `(- ,a ,b)
+  #-(or clisp abcl)
   `(the fixnum (- (the fixnum ,a) (the fixnum ,b))))
 
 (defmacro mul (a b)
@@ -268,7 +271,7 @@
               (loop for row across *q-luminance* do
                     (loop for q-coef fixnum across row
                           maximize (round (random 128) q-coef))))
-        (#+clisp - #-clisp minus (get-internal-run-time) time1))
+        (minus (get-internal-run-time) time1))
       (let ((time1 (get-internal-run-time)))
         (loop for i fixnum from 1 to 3000 do
               (loop for q-row across *q-luminance* do
@@ -292,7 +295,7 @@
                                      2)))
                                 (t
                                  (round val qc))))))
-                    (#+clisp - #-clisp minus (get-internal-run-time) time1))))
+                    (minus (get-internal-run-time) time1))))
 (format t "Done.~%")
 (finish-output)
 )