From 9e747f5fc3214e5989ea16a324c1fcff1d44bf27 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Wed, 4 May 2005 09:32:03 +0000
Subject: [PATCH] *** empty log message ***

---
 src/cmp/cmpct.lsp | 82 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 82 insertions(+)
 create mode 100644 src/cmp/cmpct.lsp

diff --git a/src/cmp/cmpct.lsp b/src/cmp/cmpct.lsp
new file mode 100644
index 000000000..264d45a5c
--- /dev/null
+++ b/src/cmp/cmpct.lsp
@@ -0,0 +1,82 @@
+;;;; CMPCT --  Optimizer for several constant values
+
+;;;;  Copyright (c) 2003, Juan Jose Garcia Ripoll.
+;;;;
+;;;;    ECoLisp is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+
+(in-package "COMPILER")
+
+(defvar +optimizable-constant+ '())
+
+(defun c1constant-value (val always-p)
+  (cond
+   ((let ((x (assoc val +optimizable-constant+)))
+      (and x (c1expr (cdr x)))))
+   ((eq val nil) (c1nil))
+   ((eq val t) (c1t))
+   ((sys::fixnump val)
+    (make-c1form* 'LOCATION :type 'FIXNUM :args (list 'FIXNUM-VALUE val)))
+   ((characterp val)
+    (make-c1form* 'LOCATION :type 'CHARACTER
+		  :args (list 'CHARACTER-VALUE (char-code val))))
+   ((typep val 'LONG-FLOAT)
+    (make-c1form* 'LOCATION :type 'LONG-FLOAT
+		  :args (list 'LONG-FLOAT-VALUE val (add-object val))))
+   ((typep val 'SHORT-FLOAT)
+    (make-c1form* 'LOCATION :type 'SHORT-FLOAT
+		  :args (list 'SHORT-FLOAT-VALUE val (add-object val))))
+   (always-p
+    (make-c1form* 'LOCATION :type (object-type val)
+		  :args (list 'VV (add-object val))))
+   (t nil)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; OPTIMIZABLE DOUBLE CONSTANTS
+;;;
+
+(mapc
+ #'(lambda (record)
+     (let* ((name (first record))
+	    (c-value (second record))
+	    (value (symbol-value name))
+	    (type (lisp-type->rep-type (type-of value))))
+       (push (cons value `(c-inline () () ,type ,c-value :one-liner t :side-effects nil))
+	     +optimizable-constant+)))
+
+ '((MOST-POSITIVE-SHORT-FLOAT "FLT_MAX")
+   (MOST-POSITIVE-SINGLE-FLOAT "FLT_MAX")
+
+   (MOST-NEGATIVE-SHORT-FLOAT "-FLT_MAX")
+   (MOST-NEGATIVE-SINGLE-FLOAT "-FLT_MAX")
+
+   (LEAST-POSITIVE-SHORT-FLOAT "FLT_MIN")
+   (LEAST-POSITIVE-SINGLE-FLOAT "FLT_MIN")
+   (LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT "FLT_MIN")
+   (LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" FLT_MIN")
+
+   (LEAST-NEGATIVE-SHORT-FLOAT "-FLT_MIN")
+   (LEAST-NEGATIVE-SINGLE-FLOAT "-FLT_MIN")
+   (LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT "-FLT_MIN")
+   (LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT "-FLT_MIN")
+
+   (MOST-POSITIVE-DOUBLE-FLOAT "DBL_MAX")
+   (MOST-POSITIVE-LONG-FLOAT "DBL_MAX")
+
+   (MOST-NEGATIVE-DOUBLE-FLOAT "-DBL_MAX")
+   (MOST-NEGATIVE-LONG-FLOAT "-DBL_MAX")
+
+   (LEAST-POSITIVE-DOUBLE-FLOAT "DBL_MIN")
+   (LEAST-POSITIVE-LONG-FLOAT "DBL_MIN")
+   (LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT "DBL_MIN")
+   (LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" DBL_MIN")
+
+   (LEAST-NEGATIVE-DOUBLE-FLOAT "-DBL_MIN")
+   (LEAST-NEGATIVE-LONG-FLOAT "-DBL_MIN")
+   (LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT "-DBL_MIN")
+   (LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT "-DBL_MIN")))