cmpct.lsp 2.76 KB
Newer Older
jjgarcia's avatar
jjgarcia committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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
77
78
79
80
81
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")))