src/code/sc-offset.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!C")
  11 \f
  12 ;;;; SC-OFFSETs
  13 ;;;;
  14 ;;;; We represent the place where some value is stored with a SC-OFFSET,
  15 ;;;; which is the SC number and offset encoded as an integer.
  16 ;;;;
  17 ;;;; The concrete encoding is exported to sc-offset.h during genesis
  18 ;;;; for use by the runtime.
  19
  20 (def!type sc-offset () '(unsigned-byte 27))
  21
  22 (defconstant-eqx +sc-offset-scn-bytes+
  23     `(,(byte 2 0) ,(byte 4 23))
  24   #'equalp)
  25
  26 (defconstant-eqx +sc-offset-offset-bytes+
  27     `(,(byte 21 2))
  28   #'equalp)
  29
  30 (declaim (ftype (sfunction ((unsigned-byte 6) (unsigned-byte 21)) sc-offset)
  31                 make-sc-offset))
  32 (defun make-sc-offset (sc-number offset)
  33   (let ((result 0))
  34     (flet ((add-bits (bytes source)
  35              (loop for byte in bytes
  36                 for size = (byte-size byte)
  37                 with i = 0
  38                 do
  39                   (setf result (dpb (ldb (byte size i) source) byte result))
  40                   (incf i size))))
  41       (add-bits +sc-offset-scn-bytes+ sc-number)
  42       (add-bits +sc-offset-offset-bytes+ offset))
  43     result))
  44
  45 (declaim (ftype (sfunction (sc-offset) unsigned-byte)
  46                 sc-offset-scn sc-offset-offset))
  47 (flet ((extract-bits (bytes source)
  48          (loop with result = 0
  49             for byte in bytes
  50             for size = (byte-size byte)
  51             with i = 0
  52             do
  53               (setf result (dpb (ldb byte source) (byte size i) result))
  54               (incf i size)
  55             finally (return result))))
  56
  57   (defun sc-offset-scn (sc-offset)
  58     (extract-bits +sc-offset-scn-bytes+ sc-offset))
  59
  60   (defun sc-offset-offset (sc-offset)
  61     (extract-bits +sc-offset-offset-bytes+ sc-offset)))