cmpct.lsp 5.02 KB
Newer Older
1
2
3
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:

jgarcia's avatar
jgarcia committed
4
;;;;
jjgarcia's avatar
jjgarcia committed
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;;;; 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")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
20
;;; KNOWN OPTIMIZABLE CONSTANTS
jjgarcia's avatar
jjgarcia committed
21
22
;;;

23
24
(defun make-single-constant-optimizer (name c-value)
  (cond ((symbolp name)
Daniel Kochmański's avatar
Daniel Kochmański committed
25
26
27
28
29
30
         (let* ((value (symbol-value name))
                (type (lisp-type->rep-type (type-of value))))
           (cons value `(c-inline () () ,type ,c-value
                                  :one-liner t :side-effects nil))))
        ((floatp name)
         (let* ((value name)
31
                      (type (type-of value))
Daniel Kochmański's avatar
Daniel Kochmański committed
32
33
34
                (loc-type (case type
                            (single-float 'single-float-value)
                            (double-float 'double-float-value)
35
36
37
38
                            (long-float 'long-float-value)
                            (si:complex-single-float 'csfloat-value)
                            (si:complex-double-float 'cdfloat-value)
                            (si:complex-long-float 'clfloat-value)))
Daniel Kochmański's avatar
Daniel Kochmański committed
39
40
41
42
43
44
45
                (location (make-vv :location c-value :value value)))
           (cons value (make-c1form* 'LOCATION :type type
                                     :args (list loc-type value location)))))
        (t
         (cons name (make-c1form* 'LOCATION :type (type-of name)
                                  :args (make-vv :location c-value
                                                 :value name))))))
jjgarcia's avatar
jjgarcia committed
46

47
48
49
(defun make-optimizable-constants (machine)
  (loop for (value name) in (optimizable-constants-list machine)
     collect (make-single-constant-optimizer value name)))
jjgarcia's avatar
jjgarcia committed
50

51
52
53
54
55
56
57
58
59
60
61
62
(defun optimizable-constants-list (machine)
  (append
   ;; Constants that appear everywhere
   '(
     ;; Order is important: on platforms where 0.0 and -0.0 are the same
     ;; the last one is prioritized.
     (#.(coerce 0 'single-float) "cl_core.singlefloat_zero")
     (#.(coerce 0 'double-float) "cl_core.doublefloat_zero")
     (#.(coerce -0.0 'single-float) "cl_core.singlefloat_minus_zero")
     (#.(coerce -0.0 'double-float) "cl_core.doublefloat_minus_zero")
     (#.(coerce 0 'long-float) "cl_core.longfloat_zero")
     (#.(coerce -0.0 'long-float) "cl_core.longfloat_minus_zero")
jjgarcia's avatar
jjgarcia committed
63

64
65
66
     ;; We temporarily remove this constant, because the bytecodes compiler
     ;; does not know how to externalize it.
     ;;(#.(si::standard-readtable) "cl_core.standard_readtable")
jjgarcia's avatar
jjgarcia committed
67

68
69
70
71
72
73
74
     (#.(find-package :cl) "cl_core.lisp_package")
     (#.(find-package :cl-user) "cl_core.user_package")
     (#.(find-package :keyword) "cl_core.keyword_package")
     (#.(find-package :clos) "cl_core.clos_package")
     #+threads
     (#.(find-package :mp) "cl_core.mp_package")
     )
75
   (when (eq machine *default-machine*)
76
77
78
79
80
81
     ;; Constants which are not portable
     `((MOST-POSITIVE-SHORT-FLOAT "FLT_MAX")
       (MOST-POSITIVE-SINGLE-FLOAT "FLT_MAX")
       
       (MOST-NEGATIVE-SHORT-FLOAT "-FLT_MAX")
       (MOST-NEGATIVE-SINGLE-FLOAT "-FLT_MAX")
82

83
84
       (LEAST-POSITIVE-SHORT-FLOAT "FLT_TRUE_MIN")
       (LEAST-POSITIVE-SINGLE-FLOAT "FLT_TRUE_MIN")
85
86
       (LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT "FLT_MIN")
       (LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" FLT_MIN")
87

88
89
       (LEAST-NEGATIVE-SHORT-FLOAT "-FLT_TRUE_MIN")
       (LEAST-NEGATIVE-SINGLE-FLOAT "-FLT_TRUE_MIN")
90
91
       (LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT "-FLT_MIN")
       (LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT "-FLT_MIN")
92

93
94
       (MOST-POSITIVE-DOUBLE-FLOAT "DBL_MAX")
       (MOST-NEGATIVE-DOUBLE-FLOAT "-DBL_MAX")
95
       (LEAST-POSITIVE-DOUBLE-FLOAT "DBL_TRUE_MIN")
96
       (LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT "DBL_MIN")
97
       (LEAST-NEGATIVE-DOUBLE-FLOAT "-DBL_TRUE_MIN")
98
       (LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT "-DBL_MIN")
99

100
101
102
103
       #+ieee-floating-point
       ,@'((SHORT-FLOAT-POSITIVE-INFINITY  "INFINITY")
           (SINGLE-FLOAT-POSITIVE-INFINITY "INFINITY")
           (DOUBLE-FLOAT-POSITIVE-INFINITY "INFINITY")
104

105
106
107
           (SHORT-FLOAT-NEGATIVE-INFINITY  "-INFINITY")
           (SINGLE-FLOAT-NEGATIVE-INFINITY "-INFINITY")
           (DOUBLE-FLOAT-NEGATIVE-INFINITY "-INFINITY"))
108

109
       ,@'((MOST-POSITIVE-LONG-FLOAT "LDBL_MAX")
Daniel Kochmański's avatar
Daniel Kochmański committed
110
           (MOST-NEGATIVE-LONG-FLOAT "-LDBL_MAX")
111
           (LEAST-POSITIVE-LONG-FLOAT "LDBL_TRUE_MIN")
Daniel Kochmański's avatar
Daniel Kochmański committed
112
           (LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" LDBL_MIN")
113
           (LEAST-NEGATIVE-LONG-FLOAT "-LDBL_TRUE_MIN")
Daniel Kochmański's avatar
Daniel Kochmański committed
114
           (LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT "-LDBL_MIN")
115
           #+ieee-floating-point
116
           (LONG-FLOAT-POSITIVE-INFINITY   "INFINITY")
117
           #+ieee-floating-point
118
           (LONG-FLOAT-NEGATIVE-INFINITY   "-INFINITY"))))))