[e90b2f]: src / cmp / cmpstructures.lsp Maximize Restore History

Download this file

cmpstructures.lsp    112 lines (104 with data), 3.9 kB

  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
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; CMPSTRUCT. STRUCTURE related optimizations.
;;;; Copyright (c) 2008. Juan Jose Garcia-Ripol
;;;;
;;;; This program 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")
;;;
;;; GET-SLOT-TYPE
;;;
;;; Given a structure type and a slot index, infer the type of the output.
;;;
(defun get-slot-type (name index)
;; default is t
(or (third (nth index (get-sysprop name 'SYS::STRUCTURE-SLOT-DESCRIPTIONS))) 'T))
;;;
;;; STRUCTURE SLOT READING
;;;
;;; By looking at the name of a function we may infer whether it is a
;;; reader for a structure slot. If this is the case and the policy
;;; allows us, we will inline the slot access and infer the type of
;;; the output.
;;;
(defun maybe-optimize-structure-access (fname args)
(let* ((slot-description (get-sysprop fname 'SYS::STRUCTURE-ACCESS)))
(when (and slot-description
(inline-possible fname)
(policy-inline-slot-access-p))
;(format t "~%;;; Optimizing structure accessor ~A" fname)
(let (structure-type slot-index)
(unless (and (consp slot-description)
(setf structure-type (car slot-description)
slot-index (cdr slot-description))
(typep slot-index 'fixnum))
(cmpwarn "Unable to inline access to structure slot ~A because index is corrupt: ~A"
fname slot-index)
(return-from maybe-optimize-structure-access nil))
(unless (= (length args) 1)
(cmpwarn "Too many arguments for structure slot accessor ~A" fname)
(return-from maybe-optimize-structure-access nil))
(setf args (first args))
(cond
((eq structure-type 'list)
`(elt ,args ,slot-index))
((eq structure-type 'vector)
`(svref ,args ,slot-index))
((consp structure-type)
`(aref (the ,structure-type ,args) ,slot-index))
(t
`(,args ',structure-type ,slot-index)))))))
(define-compiler-macro si::structure-ref (&whole whole object structure-name index
&environment env)
(if (and (policy-inline-slot-access env)
(constantp structure-name env)
(constantp index env))
(let* ((index (cmp-eval index env))
(aux (gensym))
(form `(ffi:c-inline (,aux ,index) (:object :fixnum) :object
"(#0)->instance.slots[#1]"
:one-liner t)))
(unless (policy-assume-no-errors env)
(let ((structure-name (cmp-eval structure-name env)))
(setf form
`(ext:compiler-typecase ,aux
(,structure-name ,form)
(t (ffi:c-inline (,aux ,structure-name ,index)
(:object :object :fixnum)
:object
"ecl_structure_ref(#0,#1,#2)"
:one-liner t))))))
`(let ((,aux ,object))
(declare (:read-only ,aux))
,form))
whole))
(define-compiler-macro si::structure-set (&whole whole object structure-name index value
&environment env)
(if (and (policy-inline-slot-access env)
(constantp structure-name env)
(constantp index env))
(let* ((index (cmp-eval index env))
(aux (gensym))
(form `(ffi:c-inline (,aux ,index ,value) (:object :fixnum :object) :object
"(#0)->instance.slots[#1]=#2"
:one-liner t)))
(unless (policy-assume-no-errors env)
(let ((structure-name (cmp-eval structure-name env)))
(setf form
`(ext:compiler-typecase
,aux
(,structure-name ,form)
(t (ffi:c-inline (,aux ',structure-name ,index ,value)
(:object :object :fixnum :object)
:object
"ecl_structure_set(#0,#1,#2,#3)"
:one-liner t))))))
`(let ((,aux ,object))
(declare (:read-only ,aux))
,form))
whole))