--- simlab/gfx/src/basic-graphics.lisp	1995-06-06 02:00:43.000000000 +0530
+++ simlab-1.01.madhu/gfx/src/basic-graphics.lisp	2005-06-04 21:42:18.000000000 +0530
@@ -4,7 +4,13 @@
 ;;; ** FUNDAMENTAL GRAPHICAL DISPLAY ROUTINES **
 ;;; ********************************************
 
-(in-package 'common-lisp-user)
+(in-package :common-lisp-user)		;madhu 050324
+
+(defun pp (&rest args)
+  (format t "PP: ~{~a~^ ~}~%" args))
+
+(defun ppq (&rest args)
+  (format t "PPQ: ~{~a~^ ~}~%" args))
 
 (defvar *postscript* nil)
 (defvar *ps-font-scale* 0.8)
@@ -34,7 +40,7 @@
 %!
 ")
 
-(setf postscript-prefix
+(defvar postscript-prefix
       (list "%!"
 	    "/inch {72 mul} def"
 	  ""
@@ -107,7 +113,7 @@
 			  *viewport* nil))
 	(*ps-x* 0)
 	(*ps-y* 0))
-    (declare(special *px-x* *ps-y*))
+    (declare(special *ps-x* *ps-y*))	; madhu
     (loop for point in (list p1 p2 p3 p4)
 	  minimize (px (first point) :cbbox nil) into min-x
 	  minimize (py (second point) :cbbox nil) into min-y
@@ -179,7 +185,7 @@
 	    (offset  (min-screen-point bb)))
        (setf *ps-x* (- (first offset) 10))
        (setf *ps-y* (-  (second offset) 10))
-       '(ppq  *ps-x*  *ps-y*)
+       (ppq  *ps-x*  *ps-y*)
        (with-string-output-stream
 	(*postscript*)
 	(setf
@@ -249,12 +255,14 @@
   n)
 
 (defun px(num  &key (cbbox t))
+  (declare (special *ps-x*))		; madhu
   (let ((n (- (truncate num) *ps-x*)))
     (if cbbox
 	(setminx n))
     n))
 
 (defun py(num &key (cbbox t))
+  (declare (special *ps-y* *window-center*))		; madhu
   (let ((n (- (* 2 *window-center*)
 	      (- (truncate num) *ps-y*))))
     (if cbbox (setf *min-y* (min *min-y* n)
@@ -298,7 +306,7 @@
 	((eql operation :flip)
 	 (setf (xlib:gcontext-function (display-gcontext display))
 	       boole-xor)) ;invert bits using XOR
-	(t (error "drawing mode ~A is not supported"))))
+	(t (error "drawing mode ~A is not supported" operation)))) ;madhu
 ;; draws a point at window coordinates (x,y) in display with mode
 ;; operation.  The point is drawn in the style given by *point-style*
 
@@ -306,12 +314,12 @@
 (defun draw-point (x y &optional (display *display*)
 		     (color *black*)(fill-p t)
 		     (radius *draw-point-radius*))
-  '(pp 'draw-point x y)
+  (pp 'draw-point x y)
   (xlib:with-gcontext
       ((display-gcontext display)
        :foreground color)
     (xlib:draw-arc
-     (display-window display)
+     (display-drawable display) ;madhu 050604
      (display-gcontext display)
      (- (xv x) radius)
      (-  (xv y) radius)
@@ -335,12 +343,12 @@
 		      (start 0.0)
 		      (end (* 2 pi))
 		      )
-  '(pp 'draw-circle x y)
+  (pp 'draw-circle x y)
   (xlib:with-gcontext
    ((display-gcontext display)
     :foreground color)
    (xlib:draw-arc
-    (display-window display)
+    (display-drawable display) ;madhu 050604
     (display-gcontext display)
     (- (xv x) radius)
     (-  (xv y) radius)
@@ -374,7 +382,7 @@
    ((display-gcontext display)
     :foreground color)
    (xlib:draw-arc
-    (display-window display)
+    (display-drawable display) ;madhu 050604
     (display-gcontext display)
     (- (xv x) width)
     (-  (xv y) height)
@@ -464,11 +472,11 @@
 	      (PX PX1) (PY PY1)
 	      (PX PX2) (PY PY2)
 	      (PX X2) (PY Y2)
-	      (PX X1) (PY Y1)
+;;; madhu 050305	      (PX X1) (PY Y1) ; XXX ???
 	      ))
      (if oriented
 	 (let ((dx (- x2 px2))
-	       (dy (- y2 py2)))
+	       (dy (- y2 py2)) len poly) ;madhu
 	   (cond ((or  max-head-size min-head-size)
 		  (if (zerop (setf len (sqrt (+ (* dx dx) (* dy  dy)))))
 		      (return-from draw-curved-line nil))
@@ -502,7 +510,7 @@
   (setf (xlib:gcontext-foreground (display-gcontext display))
 	(or color *black*))
   (xlib:draw-line
-   (display-window display)
+   (display-drawable display) ;madhu 050604
    (display-gcontext display)
    (xv x1)
    (xv y1)
@@ -543,7 +551,7 @@
 	(poly nil))
     
     (xlib:draw-line
-     (display-window display) (display-gcontext display) x1 y1 x2  y2)
+     (display-drawable display) (display-gcontext display) x1 y1 x2  y2) ;madhu 050604
     
     (when-postscript (:color color)
 		     (format *postscript* "~a ~a ~a ~a drawedge~%"
@@ -571,11 +579,13 @@
 ;; draws a (filled) rectangle with upper left corner (x1,y1), width w, 
 ;; and height h in display with mode operation
 (defun draw-rect (x1 y1 w h display &key (color *background*)
+		  ;; madhu 050604 hack
+		  (drawable (display-drawable display))
 		     (fill t) (operation :draw))
   (xlib:with-gcontext
    ((display-gcontext display)
     :foreground color)
-   (xlib:draw-rectangle (display-window display)
+   (xlib:draw-rectangle drawable
 			(display-gcontext display)
 			(xv x1)
 			(xv y1)
@@ -590,14 +600,14 @@
 	   (py (+ y1 h))
 	   (if fill "fill" "")))
   
-  (set-drawing-mode display :draw)) ;return to normal mode
+  (set-drawing-mode display operation)) ;return to normal mode
 
 
 ;; draws an unfilled rectangle with upper left corner (x1,y1), width w, 
 ;; and height h in display with mode operation
 (defun draw-frame (x1 y1 w h display &optional (operation :draw))
   (set-drawing-mode display operation)
-  (xlib:draw-rectangle (display-window display)
+  (xlib:draw-rectangle (display-drawable display) ;madhu 050604
 		       (display-gcontext display)
 		       (xv x1)
 		       (xv y1)
@@ -622,8 +632,8 @@
   ;; set the line width properly
   (setf (xlib:gcontext-line-width (display-gcontext display)) *line-width*)
   ;; do the drawing
-  '(pp 'draw-lines points)
-  (xlib:draw-lines (display-window display)
+  (pp 'draw-lines points)
+  (xlib:draw-lines (display-drawable display) ;madhu 050604
 		   (display-gcontext display)
 		   points)
   (set-drawing-mode display :draw)) ;return to normal mode
@@ -643,7 +653,7 @@
   (xlib:with-gcontext
       ((display-gcontext display) :foreground color)
     (xlib::fill-polygon
-     (display-window display)
+     (display-drawable display) ;madhu 050604
      (display-gcontext display)
      (loop for point in points
 	   nconc
@@ -702,7 +712,7 @@
     (xlib:with-gcontext
      ((display-gcontext display)
       :foreground color :font font)
-     (xlib:draw-glyphs (display-window display)
+     (xlib:draw-glyphs (display-drawable display) ; madhu 050604
 		       (display-gcontext display)
 		       (+ just (first pos) (- slen))
 		       (+  (or (second pos) 0) 3) string))
@@ -717,7 +727,7 @@
 	    (p2x (px (+ (first pos)
 			(+ slen (-(* 0.25 radius))))))
 	    )
-       '(ppq p1x center-y p2x radius string)
+       (ppq p1x center-y p2x radius string)
        (format
 	*postscript*
 	"~a ~a ~a lhcircle fill ~%"
--- simlab/gfx/src/geom-utils.lisp	1994-02-05 16:58:13.000000000 +0530
+++ simlab-1.01.madhu/gfx/src/geom-utils.lisp	2005-06-04 21:54:48.000000000 +0530
@@ -36,7 +36,7 @@
   `(1-skel ,geom))
 
 (defmethod geom-verts-of ((geom t))
-  (verts-of geom))
+  (vertices-of geom))			; madhu 050604
 
 (defmethod geom-verts-of ((l list))
   l)
--- simlab/gfx/src/init.lisp	1995-06-06 02:00:44.000000000 +0530
+++ simlab-1.01.madhu/gfx/src/init.lisp	2005-06-04 23:10:16.000000000 +0530
@@ -3,11 +3,15 @@
 (in-package "COMMON-LISP-USER")
 
 
-(defvar *default-display-machine* "arvak"
+(defvar *default-display-machine* "localhost"
   "Machine on which to open an x-window.")
 (defvar *default-window-size*  600)
-(defvar *black* 1)
-(defvar *white* 0)
+;;madhu 050603: don't initialize these here, they are initialized in
+;;initialize-x
+;;
+;; (defvar *black* 0)
+;; (defvar *white* 1)
+
 (defun init-gfx(&key (host *default-display-machine*)
 		     (name "SimLab")
 		     (height  *default-window-size*)
@@ -15,16 +19,23 @@
 		     (window nil)
 		     (gcontext nil)
 		     (display-num 0)
-		     (foreground  *black*)
-		     (background *white*))
+		     (foreground "black")
+		     (background "white"))
   (setf *default-postscript-scale*
 	(* 1.0 (/ *default-window-size*  (min height width))))
-  (setf *background* background)
-  (setf *foreground* foreground)
+
+;; madhu 050603 this cannot be set here
+;;  (setf *background* background)
+;;  (setf *foreground* foreground)
 
   (initialize-graphics
    :host host :name name :height height  :width width
-   :foreground foreground :background background
+;; madhu 050603
+;; :foreground foreground :background background
+
+   :default-foreground foreground
+   :default-background background
+   
    :window window
    :gcontext gcontext :display-num display-num))
 
--- simlab/gfx/src/new-windows.lisp	1995-06-06 02:00:44.000000000 +0530
+++ simlab-1.01.madhu/gfx/src/new-windows.lisp	2005-06-05 23:09:11.000000000 +0530
@@ -19,8 +19,8 @@
 (defvar *x-visual*)       ;visual information for the default window
 (defvar *x-visual-class*) ;the visual-class of the default window
 ;; standard colors
-(defvar *black* 1)
-(defvar *white* 0)
+(defvar *black*)
+(defvar *white*)
 (defvar *gray*)
 (defvar *red*)
 (defvar *green*)
@@ -34,9 +34,9 @@
 (defvar *cornflower-blue*)
 (defvar *forest-green*)
 (defvar *firebrick*)
-(defvar *foreground* 1)
-(defvar *background* 0)
 
+(defvar *foreground*)
+(defvar *background*)
 
 
 ;; sets up the global variables and colors.  If the system is
@@ -51,9 +51,15 @@
   ((window :initarg :window :accessor display-window)
    (gcontext :initarg :gcontext :accessor display-gcontext)
    (foreground :initarg :foreground :accessor display-foreground)
-   (background :initarg :background :accessor display-background))
+   (background :initarg :background :accessor display-background)
+   ;; madhu 050601 have basic-graphics write to this hack
+   (pixmap :initform nil)) ; madhu
   (:documentation "a window along with its graphics context"))
 
+(defmethod DISPLAY-DRAWABLE ((display display))
+  (with-slots (window pixmap) display
+    (if pixmap pixmap window)))
+
 (defun create-display (&key
 		       (width 750)
 		       (height 750)
@@ -63,6 +69,10 @@
 		       (foreground nil)
 		       (window nil)
 		       (gcontext nil))
+  (declare (ftype (function (&optional display boolean) xlib:pixmap)
+		  initialize-pixmap))
+
+
   (or background (setf background *background*))
   (or foreground (setf foreground *foreground*))
   (or window
@@ -79,6 +89,8 @@
 	   :colormap *colormap*
 	   :bit-gravity :center
 	   :event-mask '(:exposure :button-press)
+	   :save-under :on		;madhu
+	   ;;:override-redirect :off
 	   :backing-store :always)))
   (or gcontext
    (setf gcontext (xlib:create-gcontext
@@ -106,8 +118,12 @@
    :input :off
    :initial-state :normal)
   (xlib:map-window window)
-  (make-instance 'display :window window :gcontext gcontext
-		 :foreground foreground  :background background))
+  (setf (xlib:window-override-redirect window) :on) ; madhu - no resizing
+  (let ((display
+	 (make-instance 'display :window window :gcontext gcontext
+			:foreground foreground  :background background)))
+    (initialize-pixmap display)
+    display))
 
 (defun initialize-display (host &key 
 				(width 750)
@@ -135,12 +151,19 @@
   (x-force-output))
 
 ;; changes the display background and foreground colors
+;; madhu 050603 - foreground should also set actual display colors
 (defun set-display-colors (&key (background NIL) (foreground NIL)
-				(display *display*))
+				(display *display*) &aux x)
   (when background
-    (setf (display-background display) background))
+    (setf (display-background display) background)
+    (setf (xlib:window-background (display-window display)) background)
+    (setf x t))
+  
   (when foreground
-    (setf (display-foreground display) foreground)))
+    (setf (display-foreground display) foreground)
+    (setf (xlib:gcontext-foreground (display-gcontext display)) foreground)
+    (setf x t))
+  (when x (x-force-output)))
 
 ;;; *********************** OTHER ROUTINES ************************
 
@@ -238,8 +261,11 @@
     new-colors))
 
 ;; forces output in *x-display*
-(defun x-force-output ()
-  (xlib:display-force-output *x-display*))
+(defun x-force-output (&optional (display *display*))
+  (let ((x-display (cond ((null display) *x-display*)
+			 (t (paint) ;; go after it with a hammer
+			    (display-display display)))))
+    (xlib:display-force-output x-display)))
 
 ;; makes the display display visible on the screen, if it is not already
 (defun show-display (&optional (display *display*))
@@ -251,19 +277,30 @@
   (xlib:unmap-window (display-window display))
   (x-force-output))
 
+;; madhu 050604, first parametrized clear-display  on drawable
+(defun clear-display-1 (&optional (display *display*) (drawable (display-window display)))
+  ;; erase the window
+  (draw-rect 
+   0 0 (xlib:drawable-width drawable)
+  (xlib:drawable-height drawable)
+  display :color (display-background display) :drawable drawable))
+
 ;; clears the given display completely
 (defun clear-display (&optional (display *display*))
-  ;; erase the window
-  (draw-rect
-   0 0 (xlib:drawable-width (display-window display))
-  (xlib:drawable-height (display-window display))
-  display :color (display-background display))
+  (with-slots (pixmap window) display
+    (when (xlib:pixmap-p pixmap)
+      (clear-display-1 display pixmap))
+    (clear-display-1 display window))
   ;; update the display
   (x-force-output))
+		      
 
 
 ;; eliminates the given display completely
 (defun destroy-display (&optional (display *display*))
+  (with-slots (pixmap) display
+    (if (xlib:pixmap-p pixmap)
+	(xlib:free-pixmap pixmap)))
   (xlib:destroy-window (display-window display))
   (x-force-output))
 
@@ -274,3 +311,65 @@
 ;; returns the current height of the given display
 (defun display-height (&optional (display *display*))
   (xlib:drawable-height (display-window display)))
+
+;; madhu 050601
+;; Backing pixmap routines
+
+
+
+(defun display-depth  (&optional (display *display*))
+  (xlib:drawable-depth (display-window display)))
+
+(defun display-display  (&optional (display *display*))
+  (xlib:window-display (display-window display)))
+
+(defun initialize-pixmap (&optional (display *display*) invalidate-p)
+  "(re)initialize display backing pixmap. If invalidate-p is non-nil
+The pixmap is destroyed and set to nil"
+  (with-slots (pixmap window) display
+    (when (xlib:pixmap-p pixmap) (xlib:free-pixmap pixmap))
+    (let ((new-value
+	   (if invalidate-p
+	       nil
+	       (let ((depth (display-depth display))
+		     (width (display-width display))
+		     (height (display-height display)))
+;;		 (when nil
+		 (unless (= height (display-height display))
+		   (error "sanity: height"))
+		 (unless (= width (display-height display))
+		   (error "sanity: width")) ;;)
+		 (xlib:create-pixmap :height height :width width :depth depth
+				     :drawable window)))))
+      ;; XXX: dont bother refreshing if invalidated
+      ;; otherwise (clear-display-1 display window)
+      (when new-value 
+	;; clear new pixmap
+	(clear-display-1 display new-value))
+      (setf pixmap new-value))))
+
+
+(defun paint (&optional (display *display*) (x 0) (y 0) width height)
+  "Repaint backing pixmap onto display window"
+  (with-slots (pixmap gcontext window) display
+    (when (xlib:pixmap-p pixmap)
+      (unless width (setq width (xlib:drawable-width pixmap)
+			  #+XXX(display-width DISPLAY)))
+      (unless height (setq height (xlib:drawable-height pixmap)
+			   #+XXX(display-height DISPLAY)))
+      (xlib:copy-area pixmap gcontext
+		      x y width height
+		      window
+		      x y))))
+
+
+(defun mainloop (&optional (display *display*))
+  (with-slots (pixmap) display
+    (loop (xlib:event-case ((display-display display) :discard-p nil
+			    :force-output-p t)
+	    (exposure (window width height x y)
+		      (warn "painting ~a to ~a x ~a3C at ~a x ~a" 
+			    window width height x y)
+		      (paint display x y width height))))))
+
+
--- simlab/gfx/src/rendering.lisp	1995-06-06 02:00:45.000000000 +0530
+++ simlab-1.01.madhu/gfx/src/rendering.lisp	2005-06-04 23:07:52.000000000 +0530
@@ -31,8 +31,16 @@
 	(camera-pos-x 0.0) (camera-pos-y 0.0) (camera-pos-z 10.0)
 	(camera-targ-x 0.0) (camera-targ-y 0.0) (camera-targ-z 0.0)
 	(camera-lens-width 12.0) (camera-lens-height 12.0)
-	(background *background*)
-	(foreground *foreground*)
+
+;; madhu 050603: (*background* 0 *foreground* 1) etc dont work as the
+;; colors are only set up in initialize-x, which we call.  Set
+;; *background* and *foreground* to standard color names
+;;
+;;	(background *background*)
+;;	(foreground *foreground*)
+
+   default-background default-foreground
+
 	(name  "DISPLAY")
 	(width 500)
 	(height 500)
@@ -42,15 +50,25 @@
   #+xlib(progn
           (when (not host)
 	    (setf host (machine-instance)))
-	  (initialize-x host :display-num display-num))
+	  (initialize-x host :display-num display-num)
+
+	  ;; madhu 050603 set up defaults here
+	  
+	  (setf *background* (xlib:alloc-color *colormap* default-background))
+	  (setf *foreground* (xlib:alloc-color *colormap* default-foreground))
+	  )
 					;make clx ready for use
+  
   #+apple(setf *display-width* width)
   #+apple(setf *display-height* height)
   
   (setf *global-viewports* nil) ;no viewports to begin with
   (setf *display* (create-display :width width :height height
-				  :background background 
-				  :foreground foreground 
+;; madhu 050603
+;;				  :background background 
+;;				  :foreground foreground 
+				  :background *background*
+				  :foreground *foreground*
 				  :display-name name
 				  :window window
 				  :gcontext gcontext))
@@ -145,6 +163,7 @@
 		       (width *line-width*)
 		       (ratio 0.1)
 		       (scale 1.0))
+ (flet ((times (a b) (weyli::times a b))); madhu 050324
   (if color
       (set-drawing-color color (viewport-display viewport)))
   (let*((endpoints  (if (listp edge) edge (weyli::vertices-of edge)))
@@ -182,7 +201,7 @@
 	(first p2) (second p2)
 	(viewport-display viewport)
 	color)))
-    (x-force-output)))
+    (x-force-output))))
 
 (defmethod cross-prod ((v1 list) (v2 list))
   (list
--- simlab/utilities/lisp/basic-support.lisp	1995-04-07 22:46:58.000000000 +0530
+++ simlab-1.01.madhu/utilities/lisp/basic-support.lisp	2005-06-04 19:48:07.000000000 +0530
@@ -4,6 +4,8 @@
 ;;; (c) Copyright 1995 Cornell University
 
 ;;; basic-support.lisp,v 1.4 1995/04/07 17:16:58 rz Exp
+;;; Madhu 050604
+;;; - 
 
 (in-package "MAKE")
 
@@ -31,7 +33,8 @@
                                     names)))
 
 (defun module-directory (&rest names)
-  (let ((path (pathname make::*central-registry*)))
+  (let ((path #+nil (pathname make::*central-registry*)	; madhu 050604
+	      *simlab-srcdir*))
     (make-pathname :device (pathname-device path)
 		   :directory (append
 				(butlast (pathname-directory path))
@@ -40,10 +43,14 @@
 					      (string-downcase (string q))))
 					names)))))
 
+
+;;#+nil					; madhu 050604
 (defun standard-binary-directory ()
   #+(and Lucid Sparc)   "lucid-sparc"
   #+(and Allegro Sparc) "allegro-sparc"
   #+MCL                 "mcl-binary"
+  #+CMUCL	"binary-cmucl"		; madhu
+  #+CLISP	"binary-clisp"
   )  
 
 ;; Guarantee that there we can grow to at least MEGS megabytes of
--- simlab/weyl/demo/benchmarks.lisp	1995-06-12 21:34:28.000000000 +0530
+++ simlab-1.01.madhu/weyl/demo/benchmarks.lisp	2005-06-05 00:30:59.000000000 +0530
@@ -139,7 +139,7 @@
        ret-val))
 
 
- (defmacro mytime (mess count expr &optional (stream *standard-output*))
+(defmacro mytime (mess count expr &optional (stream *standard-output*))
    (declare (ignore count))
    `(progn
       (format ,stream "~%~a"   ,mess)
--- simlab/weyl/demo/draw-topology.lisp	1995-06-12 20:58:40.000000000 +0530
+++ simlab-1.01.madhu/weyl/demo/draw-topology.lisp	2005-06-04 18:11:32.000000000 +0530
@@ -4,6 +4,7 @@
 
 (unless (find-package "COMMON-LISP-USER")
   (MAKE-PACKAGE "COMMON-LISP-USER" :nicknames (list "CLU")))
+(cl-user::package-add-nicknames :cl-user :clu)	; madhu
 
 (import '(clu::*green* clu::*red* clu::*blue* clu::*black* clu::*orange* 
 		       clu::*white* clu::clear-display clu::x-force-output
--- simlab/weyl/src/algebraic-domains.lisp	1995-05-24 23:11:57.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/algebraic-domains.lisp	2005-05-29 21:44:12.000000000 +0530
@@ -284,6 +284,9 @@
   (quotient (element self) (element self)) -> (element self)
   (recip (element self)) -> (element self))
 
+(defclass finite-set (set)		; madhu moved def forward for pcl barfing on unbound class-precedence-list slot of classes specialized in defmethods
+  ())
+
 (defclass finite-field (field finite-set)
   ())
 
@@ -400,6 +403,8 @@
   (:documentation "Sets built from this class can be modified"))
 
 
+;;; madhu 050329
+#+nil
 (defclass finite-set (set)
   ())
 
@@ -475,6 +480,11 @@
   (or (typep x 'cl:number)
       (typep x 'numeric)))
 
+
+(defclass caching-zero-and-one (domain)	;; madhu 050329
+     ((zero)
+      (one)))
+
 ;; Rational integers
 
 (defclass rational-integers (ring caching-zero-and-one numeric-domain)
@@ -602,6 +612,7 @@
 ;; It is often useful to cache the values of zero and one since they are
 ;; often needed.  Need to include the class domain here to make
 ;; caching... more specific than just domain.
+#+nil					;; madhu 050329
 (defclass caching-zero-and-one (domain)
      ((zero)
       (one)))
@@ -747,6 +758,12 @@
 ;; created in the direct-sum.lisp file along with several support
 ;; methods.
 
+
+(defclass tuple () ;; madhu 050329 from sets.lisp
+  ((value :initarg :values
+	  :initform ()
+	  :reader value-of)))
+
 (defclass direct-sum (tuple domain) ())
 
 (defclass direct-sum-element (tuple domain-element) ())
--- simlab/weyl/src/algebraic-extension.lisp	1994-10-05 04:00:39.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/algebraic-extension.lisp	2005-06-04 20:20:20.000000000 +0530
@@ -52,7 +52,8 @@
 (defmethod minimal-polynomial ((domain algebraic-extension-ring) variable)  
   (with-slots (variables) domain
     (unless (member variable variables :test #'ge-equal)
-      (error "~'i~A~ is not a variable of ~S" variable domain)))
+      (error #+nil "~'i~A~ is not a variable of ~S"	; madhu 050604
+	     "~A is not a variable of ~S" variable domain)))
   (get-variable-number-property domain (variable-index domain variable)
 				:minimal-polynomial))
 
@@ -65,7 +66,9 @@
   (setq variable (coerce variable *general*))
   (with-slots (variables) domain    
     (unless (member variable variables :test #'ge-equal)
-      (error "~'i~A~ is not a variable of ~S" variable domain)))
+      (error #+nil "~'i~A~ is not a variable of ~S" ; madhu 050604
+	     "~A is not a variable of ~S"
+	     variable domain)))
   (unless (eql (domain-of minimal-polynomial) domain)
     (error "The algebraic relation ~S is not an element of ~S" 
 	   minimal-polynomial domain))
--- simlab/weyl/src/lisp-numbers.lisp	1995-05-24 23:12:03.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/lisp-numbers.lisp	2003-10-20 22:31:28.000000000 +0530
@@ -55,7 +55,7 @@
 
 (defun faster-isqrt (n)
   (let (n-len-quarter n-half n-half-isqrt init-value q r iterated-value)
-    "argument n must be a non-negative integer"
+    #-clisp "argument n must be a non-negative integer"
     (cond
       ((> n 24)
        ;; theoretically (> n 7) ,i.e., n-len-quarter > 0
--- simlab/weyl/src/lisp-support.lisp	1994-10-21 23:46:43.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/lisp-support.lisp	2005-05-29 20:53:59.000000000 +0530
@@ -31,6 +31,7 @@
 
 #+PCL
 (defmacro weyli::defmethod (&rest args &environment env)
+  #+nil					; madhu 050305
   (declare (pcl:arglist name
 			{method-qualifier}*
 			specialized-lambda-list
@@ -50,12 +51,15 @@
 						  q))
 					  rest))))))
     (multiple-value-bind (name qualifiers lambda-list body)
-	(pcl:parse-defmethod args)
-      (let ((proto-method (pcl:method-prototype-for-gf name)))
+	(pcl::parse-defmethod args)
+      (multiple-value-bind (proto-gf proto-method)
+	  (pcl::prototypes-for-make-method-lambda name)
 	`(progn
 	   ,@(loop for ll in (duplicate-arglist lambda-list)
 		   collect
-		     (pcl:expand-defmethod proto-method name qualifiers ll body env)))))))
+		     (pcl::expand-defmethod name proto-gf proto-method qualifiers ll body env)))))))
+
+
 
 #+CLOS
 (defmacro weyli::defmethod (&rest args)
@@ -80,12 +84,12 @@
     #-LispWorks
     (multiple-value-bind (name qualifiers lambda-list body)
           #+(or excl Lucid) (clos::parse-defmethod args)
-	  #+(or MCL Genera) (clos-parse-defmethod args)
+	  #+(or MCL Genera clisp) (clos-parse-defmethod args)
       `(progn
 	,@(loop for ll in (duplicate-arglist lambda-list)
 		collect
-                #-MCL
-		 `(clos::defmethod ,name ,@qualifiers ,ll ,@body)
+		#-MCL
+		`(clos::defmethod ,name ,@qualifiers ,ll ,@body)
                  #+MCL
                   `(,(if (or qualifiers ll) 'cl:defmethod 'defun) ,name ,@qualifiers
                     ,ll ,@body))))
@@ -99,8 +103,9 @@
   		   `(clos:defmethod ,name ,@qualifiers ,ll ,@body)))))))
 
 (defmacro clos-class-direct-superclasses (c)
-  `(#-MCL clos::class-direct-superclasses 
-    #+MCL class-direct-superclasses       ,c))
+  `(        #+clisp clos::class-direct-superclasses	;madhu 050305
+	    #+cmu pcl:class-direct-superclasses
+	    #+MCL class-direct-superclasses       ,c))
 
 ;; The following predicate determines if class is a subclass of super-class.
 (defun weyli::subclass-of? (class super-class)
@@ -116,7 +121,7 @@
     (or (eql class super-class)
 	(search-list (clos-class-direct-superclasses super-class)))))
 
-#+(or MCL (and Genera CLOS))
+#+(or MCL clisp (and Genera CLOS))
 (defun clos-parse-defmethod (form)
   (let ((name (pop form))
 	qualifiers)
@@ -235,15 +240,17 @@
 
 ;;Infinities...
 
-(defvar weyli::*positive-infinity*
+(defvar weyli::*positive-infinity* ; madhu
 	#+Genera si:infinite-positive-double-float
 	#+Lucid system:float-positive-infinity
-        #-(or Lucid Genera) (expt 2.0 1000))
+	#+ansi-cl most-positive-double-float
+        #-(or Lucid Genera ansi-cl) (expt 2.0 1000))
 
 (defvar weyli::*negative-infinity*
 	#+Genera si:infinite-negative-double-float
 	#+Lucid system:float-negative-infinity
-        #-(or Genera Lucid) (- (expt 2.0 1000)))
+	#+ansi-cl most-negative-double-float	
+        #-(or Genera Lucid ansi-cl) (- (expt 2.0 1000)))
 
 (defmacro weyli::copy-array-contents (from-array to-array)
   #+Genera
@@ -252,7 +259,8 @@
   `(copy-array-contents* ,from-array ,to-array))
 
 #+(not (or Genera Lucid MCL Lispworks Allegro))
-(error "Need to define COPY-ARRAY-CONTENTS*")
+(eval-when (:compile-toplevel) ;madhu
+  (warn #+nil error "Need to define COPY-ARRAY-CONTENTS*"))
 
 #+Lucid
 (defmacro general-set-aref (value array indices)
@@ -278,6 +286,9 @@
 	     from-array to-array))
     (labels ((worker (from-dims to-dims indices)
 	       (cond ((null from-dims)
+		      (setf (apply #'aref to-array indices) 
+			    (apply #'aref from-array indices))
+		      #+nil ; madhu
 		      (general-set-aref (apply #'aref from-array indices)
 					to-array indices))
 		     (t (loop for i below (min (first from-dims)
@@ -489,16 +500,28 @@
   (if b `(weyli::truncate2 ,a ,b) `(weyli::truncate1 ,a)))
 
 #+PCL
+(intern "*COMPILE-CLASS-HASH*" :pcl)
+#+PCL
+(export '(pcl::*compile-class-hash*
+	  pcl::notice-methods-change-1
+	  pcl::compile-class-methods-1
+	  pcl::classp) :pcl)
+#+PCL
 (defvar pcl:*compile-class-hash* (make-hash-table :test #'eq))
 
+#+pcl
+(defun pcl:notice-methods-change-1 (gf)
+  (warn "Unknown function  pcl:notice-methods-change-1 called on ~S" gf))
+    
+
 #+PCL
 (defun pcl:COMPILE-CLASS-METHODS-1 (classes)
   (clrhash pcl:*compile-class-hash*)
   (dolist (class-spec classes)
     (let ((class (cond ((symbolp class-spec) (pcl:find-class class-spec nil))
 		       ((pcl:classp class-spec) class-spec))))
-      (cond (class
-	     (dolist (gf (pcl:class-direct-generic-functions class))
+      (cond (class			; madhy 050305 was pcl:class-d-g-f
+	     (dolist (gf (pcl:specializer-direct-generic-functions class))
 	       (unless (gethash gf pcl:*compile-class-hash*)
 		 (setf (gethash gf pcl:*compile-class-hash*) T)
 		 (pcl:notice-methods-change-1 gf))))
@@ -518,7 +541,7 @@
   (let ((class (cond ((symbolp class-spec) (pcl:find-class class-spec nil))
 		     ((pcl:classp class-spec) class-spec))))
     (cond (class
-	   (dolist (gf (pcl:class-direct-generic-functions class))
+	   (dolist (gf (pcl:specializer-direct-generic-functions class))
 	     (dolist (method (pcl:generic-function-methods gf))
 	       (unless (or (compiled-function-p (pcl:method-function method))
 			   #+Genera
@@ -551,4 +574,3 @@
 		  (push generic list)
 		  (funcall function generic))))))))
 
-
--- simlab/weyl/src/matrix.lisp	1995-05-24 23:19:23.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/matrix.lisp	2005-06-04 19:56:09.000000000 +0530
@@ -697,7 +697,8 @@
   (ignore (ignore ignore))
   (if (not (typep (coefficient-domain-of (domain-of m))
 		  'multivariate-polynomial-ring))
-      (error "Expected ~S to be over a multivariate-polynomial-ring"))
+      (error "Expected ~S to be over a multivariate-polynomial-ring"
+	     (coefficient-domain-of (domain-of m))))
   (with-matrix-dimensions (dim1 dim2 array) m
     (let ((new-array (make-array (list dim1 dim2))))
 	 (loop for i below dim1 do
--- simlab/weyl/src/numbers.lisp	1995-05-24 23:12:07.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/numbers.lisp	2005-06-04 20:49:12.000000000 +0530
@@ -848,7 +848,8 @@
 		 (y-domain (domain-of .y.)))
 	     (cond ((eql x-domain y-domain)
 		    (when (eql (class-of .x.) (class-of .y.))
-		      (error "No applicable ~A method for ~S and ~S" .x. .y.))
+		      (error "No applicable ~A method for ~S and ~S"
+			     ',binary-op .x. .y.)) ; madhu 050604
 		    (with-contagion (.x. .y.) (,binary-op .x. .y.)))
 		   ((typep (domain-of .x.) 'non-strict-domain)
 		    (,binary-op .x. (coerce .y. (domain-of .x.))))
--- simlab/weyl/src/packages.lisp	1995-04-06 03:09:44.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/packages.lisp	2003-10-19 14:42:24.000000000 +0530
@@ -8,7 +8,7 @@
 
 (in-package #-ANSI-CL "USER" #+ANSI-CL "CL-USER")
 
-(make::adjust-version-numbers Weyl "1.19")
+(make::adjust-version-numbers :Weyl "1.19")
 
 
 ;; This is really stupid.  In ANSI-CL's the name of the LISP package
--- simlab/weyl/src/sets.lisp	1995-05-24 23:12:11.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/sets.lisp	2005-05-29 21:43:51.000000000 +0530
@@ -11,10 +11,12 @@
 (make::adjust-version-numbers Weyl "1.6")
 
 ;; Tuples are just indexed lists.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+#+nil ;; madhu 050329 moved the definition to algebraic-domains.lisp for pcl compilation
 (defclass tuple ()
   ((value :initarg :values
 	  :initform ()
-	  :reader value-of)))
+	  :reader value-of))))
 
 ;;;for backward compatibility
 (defmethod tuple-value ((tuple tuple))
--- simlab/weyl/src/sparsegcd.lisp	1995-03-14 04:06:50.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/sparsegcd.lisp	2005-06-04 20:58:30.000000000 +0530
@@ -372,7 +372,7 @@
 (defmethod SparseInterpStagei ((coef-domain field)
 			       (Pkminus1 mpolynomial) Bp D k
 			       &optional ignore)
-  (ignore (ignore ignore))
+  (declare (ignore ignore))
   (let* ((domain (domain-of Pkminus1))
 	 (vars (list-coerce (list-of-variables Pkminus1) domain))
 	 (Skel (pskeleton Pkminus1 vars))
--- simlab/weyl/src/tpower.lisp	1995-05-24 23:12:14.000000000 +0530
+++ simlab-1.01.madhu/weyl/src/tpower.lisp	2005-06-04 20:59:15.000000000 +0530
@@ -11,7 +11,7 @@
 
 (define-domain-creator tpower-series-ring
 		       ((coefficient-domain domain) variable)
-  (let* ((field? (field? coefficiet-domain))
+  (let* ((field? (field? coefficient-domain))
 	 (domain
 	   (make-instance (if field? 'tpower-series-field
 			      'tpower-series-ring)