cmpct.lsp 2.93 KB
Newer Older
jjgarcia's avatar
jjgarcia committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
;;;; 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+ '())

16
(defun c1constant-value (val &key always only-small-values)
jjgarcia's avatar
jjgarcia committed
17
18
  (cond
   ((let ((x (assoc val +optimizable-constant+)))
19
20
21
      (when x
       (pushnew "#include <float.h>" *clines-string-list*)
       (c1expr (cdr x)))))
jjgarcia's avatar
jjgarcia committed
22
23
24
25
26
27
28
   ((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))))
29
30
31
32
33
34
   ((typep val 'DOUBLE-FLOAT)
    (make-c1form* 'LOCATION :type 'DOUBLE-FLOAT
		  :args (list 'DOUBLE-FLOAT-VALUE val (add-object val))))
   ((typep val 'SINGLE-FLOAT)
    (make-c1form* 'LOCATION :type 'SINGLE-FLOAT
		  :args (list 'SINGLE-FLOAT-VALUE val (add-object val))))
35
   (always
jjgarcia's avatar
jjgarcia committed
36
37
    (make-c1form* 'LOCATION :type (object-type val)
		  :args (list 'VV (add-object val))))
38
   (only-small-values nil)
jjgarcia's avatar
jjgarcia committed
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
   (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-NEGATIVE-DOUBLE-FLOAT "-DBL_MAX")
   (LEAST-POSITIVE-DOUBLE-FLOAT "DBL_MIN")
   (LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT "DBL_MIN")
   (LEAST-NEGATIVE-DOUBLE-FLOAT "-DBL_MIN")
   (LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT "-DBL_MIN")
77
78
79
80
81
82
83
84
85
86
87

   . #+long-float NIL #-long-float
   (
    (MOST-POSITIVE-LONG-FLOAT "DBL_MAX")
    (MOST-NEGATIVE-LONG-FLOAT "-DBL_MAX")
    (LEAST-POSITIVE-LONG-FLOAT "DBL_MIN")
    (LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" DBL_MIN")
    (LEAST-NEGATIVE-LONG-FLOAT "-DBL_MIN")
    (LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT "-DBL_MIN")
    )
   ))