source: release/1.11/source/level-0/X86/X8632/x8632-symbol.lisp

;;;
;;; Copyright 2009 Clozure Associates
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;     http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(in-package "CCL")

(eval-when (:compile-toplevel :execute)
  (require "X8632-ARCH")
  (require "X86-LAPMACROS"))

;;; This assumes that macros & special-operators
;;; have something that's not FUNCTIONP in their
;;; function-cells.  It also assumes that NIL
;;; isn't a true symbol, but that NILSYM is.
(defx8632lapfunction %function ((sym arg_z))
  (check-nargs 1)
  (let ((symaddr temp0))
    (movl ($ (+ (target-nil-value) x8632::nilsym-offset)) (% symaddr))
    (cmp-reg-to-nil sym)
    (cmovne (% sym) (% symaddr))
    (trap-unless-typecode= symaddr x8632::subtag-symbol)
    (movl (% sym) (% arg_y))
    (movl (@ x8632::symbol.fcell (% symaddr)) (% arg_z))
    (extract-typecode arg_z imm0)
    (cmpb ($ x8632::subtag-function) (%b imm0))
    (je.pt @ok)
    (uuo-error-udf (% arg_y))
    @ok
    (single-value-return)))

;;; Traps unless sym is NIL or some other symbol.  If NIL, return
;;; nilsym
(defx8632lapfunction %symbol->symptr ((sym arg_z))
  (let ((tag imm0))
    (movl ($ (+ (target-nil-value) x8632::nilsym-offset)) (% tag))
    (cmp-reg-to-nil sym)
    (cmove (% tag) (% sym))
    (je :done)
    (trap-unless-typecode= sym x8632::subtag-symbol)
    :done
    (single-value-return)))

;;; If symptr is NILSYM, return NIL; else typecheck and return symptr
(defx8632lapfunction %symptr->symbol ((symptr arg_z))
  (cmpl ($ (+ (target-nil-value) x8632::nilsym-offset)) (% symptr))
  (jne @typecheck)
  (movl ($ (target-nil-value)) (% arg_z))
  (single-value-return)
  @typecheck
  (trap-unless-typecode= symptr x8632::subtag-symbol)
  (single-value-return))

(defx8632lapfunction %symptr-value ((symptr arg_z))
  (jmp-subprim .SPspecref))

(defx8632lapfunction %set-symptr-value ((symptr arg_y) (val arg_z))
  (jmp-subprim .SPspecset))

;;; This gets a tagged symbol as an argument.
;;; If there's no thread-local binding, it should return
;;; the underlying symbol vector as a first return value.
(defx8632lapfunction %symptr-binding-address ((symptr arg_z))
  (movl (@ x8632::symbol.binding-index (% symptr)) (% arg_y))
  (rcmp (% arg_y) (:rcontext x8632::tcr.tlb-limit))
  (movl (:rcontext x8632::tcr.tlb-pointer) (% temp0))
  (jae @sym)
  (cmpb ($ x8632::subtag-no-thread-local-binding) (@ (% temp0) (% arg_y)))
  (je @sym)
  (shl ($ x8632::word-shift) (% arg_y))
  (push (% temp0))
  (push (% arg_y))
  (set-nargs 2)
  (lea (@ '2 (% esp)) (% temp0))
  (jmp-subprim .SPvalues)
  @sym
  (push (% arg_z))
  (pushl ($ '#.x8632::symbol.vcell))
  (set-nargs 2)
  (lea (@ '2 (% esp)) (% temp0))
  (jmp-subprim .SPvalues))

(defx8632lapfunction %tcr-binding-location ((tcr arg_y) (sym arg_z))
  (movl (@ x8632::symbol.binding-index (% sym)) (% temp0))
  (movl ($ (target-nil-value)) (% arg_z))
  (rcmp (% temp0) (@ (- x8632::tcr.tlb-limit x8632::tcr-bias) (% tcr)))
  (movl (@ (- x8632::tcr.tlb-pointer x8632::tcr-bias) (% tcr)) (% arg_y))
  (jae @done)
  (lea (@ (% arg_y) (% temp0)) (% arg_y))
  ;; We're little-endian, so the tag is at the EA with no
  ;; displacement
  (cmpb ($ x8632::subtag-no-thread-local-binding) (@ (% arg_y)))
  (cmovnel (% arg_y) (% arg_z))
  @done
  (single-value-return))

(defx86lapfunction %pname-hash ((str arg_y) (len arg_z))
  (let ((accum imm0)
        (offset temp0))
    (xor (% offset) (% offset))
    (xor (% accum) (% accum))
    (testl (% len) (% len))
    (jz.pn @done)
    @loop8
    (roll ($ 5) (%l accum))
    (xorl (@ x8632::misc-data-offset (% str) (% offset)) (%l accum))
    (addl ($ '1) (% offset))
    (subl ($ '1) (% len))
    (jnz @loop8)
    (shll ($ 5) (% accum))
    (shrl ($ (- 5 x8632::fixnumshift)) (% accum))
    (movl (% accum) (% arg_z))
    @done
    (single-value-return)))

(defx8632lapfunction %string-hash ((start 4) #|(ra 0)|# (str arg_y) (len arg_z))
  (let ((accum imm0)
        (offset temp0))
    (movl (@ start (% esp)) (% offset))
    (xorl (% accum) (% accum))
    (testl (% len) (% len))
    (jz @done)
    @loop8
    (roll ($ 5) (%l accum))
    (xorl (@ x8632::misc-data-offset (% str) (% offset)) (%l accum))
    (addl ($ '1) (% offset))
    (subl ($ '1) (% len))
    (jnz @loop8)
    (shll ($ 5) (% accum))
    (shrl ($ (- 5 x8632::fixnumshift)) (% accum))
    (movl (% accum) (% arg_z))
    @done
    (single-value-return 3)))

;;; Ensure that the current thread's thread-local-binding vector
;;; contains room for an entry with index INDEX.
;;; Return the fixnum-tagged tlb vector.
(defx8632lapfunction %ensure-tlb-index ((idx arg_z))
  (cmp (:rcontext x8632::tcr.tlb-limit) (% idx))
  (jb @ok)
  (push (% arg_z))                      ; exception handler will pop this
  (ud2a)  (:byte 1)                     ; tlb_too_small()
  @ok
  (mov (:rcontext x8632::tcr.tlb-pointer) (% arg_z))
  (single-value-return))