cmpct.lsp 3.12 KB
Newer Older
jgarcia's avatar
jgarcia committed
1
2
;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
jjgarcia's avatar
jjgarcia committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
;;;; 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+ '())

18
(defun c1constant-value (val &key always only-small-values)
jjgarcia's avatar
jjgarcia committed
19
20
  (cond
   ((let ((x (assoc val +optimizable-constant+)))
21
22
23
      (when x
       (pushnew "#include <float.h>" *clines-string-list*)
       (c1expr (cdr x)))))
jjgarcia's avatar
jjgarcia committed
24
25
26
27
28
29
30
   ((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))))
31
32
33
34
35
36
   ((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))))
37
38
39
   ((typep val 'LONG-FLOAT)
    (make-c1form* 'LOCATION :type 'LONG-FLOAT
		  :args (list 'LONG-FLOAT-VALUE val (add-object val))))
40
   (always
jjgarcia's avatar
jjgarcia committed
41
42
    (make-c1form* 'LOCATION :type (object-type val)
		  :args (list 'VV (add-object val))))
43
   (only-small-values nil)
jjgarcia's avatar
jjgarcia committed
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
77
78
79
80
81
   (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")
82
83
84
85
86
87
88
89
90
91
92

   . #+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")
    )
   ))