source: trunk/source/level-0/X86/x86-symbol.lisp @ 13745

Last change on this file since 13745 was 13745, checked in by gb, 9 years ago

nfcomp.lisp: in the pkg/no *FASDUMP-EPUSH*/ASCII case in FASL-DUMP-SYMBOL,

use $fasl-nvpkg-intern (not the -special variant) when no symbol-binding
index is involved. (Getting this wrong has caused >10000 symbols that
aren't referenced in special-binding constructs to have symbol-binding
indices, making the per-thread special bindings table unnecessarily large
and exposing problems with %FOREIGN-THREAD-INITIALIZE.

ppc-symbol.lisp, x8632-symbol.lisp, x86-symbol.lisp: define %ENSURE-TLB-INDEX,

which uses a platform-specific conditional trap to ensure that the current
thread's tlb is large enough.

l1-lisp-threads.lisp: use %ENSURE-TLB-INDEX in %FOREIGN-THREAD-INITIALIZE,

to ensure that TLB indices used in that function are in bounds.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.9 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18(in-package "CCL")
19#+x8664-target
20(progn
21
22(eval-when (:compile-toplevel :execute)
23  (require "X8664-ARCH")
24  (require "X86-LAPMACROS"))
25
26;;; This assumes that macros & special-operators
27;;; have something that's not FUNCTIONP in their
28;;; function-cells.  It also assumes that NIL
29;;; isn't a true symbol, but that NILSYM is.
30(defx86lapfunction %function ((sym arg_z))
31  (check-nargs 1)
32  (let ((symaddr temp0))
33    (movq ($ (+ (target-nil-value) x8664::nilsym-offset)) (% symaddr))
34    (cmp-reg-to-nil sym)
35    (cmovneq (% sym) (% symaddr))
36    (trap-unless-fulltag= symaddr x8664::fulltag-symbol)
37    (movq (% sym) (% arg_y))
38    (movq (@ x8664::symbol.fcell (% symaddr)) (% arg_z))
39    (extract-fulltag arg_z imm0)
40    (cmpb ($ x8664::fulltag-function) (%b imm0))
41    (je.pt @ok)
42    (uuo-error-udf (% arg_y))
43    @ok
44    (single-value-return)))
45
46;;; Traps unless sym is NIL or some other symbol.  If NIL, return
47;;; nilsym
48(defx86lapfunction %symbol->symptr ((sym arg_z))
49  (let ((tag imm0))
50    (movq ($ (+ (target-nil-value) x8664::nilsym-offset)) (% tag))
51    (cmp-reg-to-nil sym)
52    (cmoveq (% tag) (% sym))
53    (je :done)
54    (trap-unless-fulltag= sym x8664::fulltag-symbol)
55    :done
56    (single-value-return)))
57
58;;; If symptr is NILSYM, return NIL; else typecheck and return symptr
59(defx86lapfunction %symptr->symbol ((symptr arg_z))
60  (movw ($ (ash 1 x8664::fulltag-symbol)) (% imm0.w))
61  (btw (%w symptr) (% imm0.w))
62  (jb.pt @ok)
63  (uuo-error-reg-not-tag (% symptr) ($ x8664::fulltag-symbol))
64  @ok
65  (cmpq ($ (+ (target-nil-value) x8664::nilsym-offset)) (% symptr))
66  (sete (% imm0.b))
67  (negb (% imm0.b))
68  (andl ($ x8664::nilsym-offset) (% imm0.l))
69  (subq (% imm0) (% symptr))
70  (single-value-return))
71
72
73;;; Given something whose fulltag is FULLTAG-SYMBOL, return the
74;;; underlying uvector.  This function and its inverse would
75;;; be good candidates for inlining.
76(defx86lapfunction %symptr->symvector ((symptr arg_z))
77  (subb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
78  (single-value-return))
79
80(defx86lapfunction %symvector->symptr ((symbol-vector arg_z))
81  (addb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
82  (single-value-return))
83   
84(defx86lapfunction %symptr-value ((symptr arg_z))
85  (jmp-subprim .SPspecref))
86
87(defx86lapfunction %set-symptr-value ((symptr arg_y) (val arg_z))
88  (jmp-subprim .SPspecset))
89
90;;; This gets a tagged symbol as an argument.
91;;; If there's no thread-local binding, it should return
92;;; the underlying symbol vector as a first return value.
93(defx86lapfunction %symptr-binding-address ((symptr arg_z))
94  (movq (@ x8664::symbol.binding-index (% symptr)) (% arg_y))
95  (rcmp (% arg_y) (:rcontext x8664::tcr.tlb-limit))
96  (movq (:rcontext x8664::tcr.tlb-pointer) (% arg_x))
97  (jae @sym)
98  (cmpb ($ x8664::no-thread-local-binding-marker) (@ (% arg_x) (% arg_y)))
99  (je @sym)
100  (shl ($ x8664::word-shift) (% arg_y))
101  (push (% arg_x))
102  (push (% arg_y))
103  (set-nargs 2)
104  (lea (@ '2 (% rsp)) (% temp0))
105  (jmp-subprim .SPvalues)
106  @sym
107  (subb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
108  (push (% arg_z))
109  (pushq ($ '#.x8664::symptr.vcell))
110  (set-nargs 2)
111  (lea (@ '2 (% rsp)) (% temp0))
112  (jmp-subprim .SPvalues))
113
114(defx86lapfunction %tcr-binding-location ((tcr arg_y) (sym arg_z))
115  (movq (@ x8664::symbol.binding-index (% sym)) (% arg_x))
116  (movl ($ nil) (% arg_z.l))
117  (rcmp (% arg_x) (@ x8664::tcr.tlb-limit (% tcr)))
118  (movq (@ x8664::tcr.tlb-pointer (% tcr)) (% arg_y))
119  (jae @done)
120  (lea (@ (% arg_y) (% arg_x)) (% arg_y))
121  ;; We're little-endian, so the tag is at the EA with no
122  ;; displacement
123  (cmpb ($ x8664::subtag-no-thread-local-binding) (@ (% arg_y)))
124  (cmovneq (% arg_y) (% arg_z))
125  @done
126  (single-value-return))
127
128 
129(defx86lapfunction %pname-hash ((str arg_y) (len arg_z))
130  (let ((accum imm0)
131        (offset imm1))
132    (xorq (% offset) (% offset))
133    (xorq (% accum) (% accum))
134    (testq (% len) (% len))
135    (jz @done)
136    @loop8
137    (roll ($ 5) (%l accum))
138    (xorl (@ x8664::misc-data-offset (% str) (% offset) 4) (%l accum))
139    (addq ($ 1) (% offset))   
140    (subq ($ '1) (% len))
141    (jnz @loop8)
142    (shlq ($ 5) (% accum))
143    (shrq ($ (- 5 x8664::fixnumshift)) (% accum))
144    (movq (% accum) (% arg_z))
145    @done
146    (single-value-return)))
147
148(defx86lapfunction %string-hash ((start arg_x) (str arg_y) (len arg_z))
149  (let ((accum imm0)
150        (offset imm1))
151    (unbox-fixnum start offset)
152    (xorq (% accum) (% accum))
153    (testq (% len) (% len))
154    (jz @done)
155    @loop8
156    (roll ($ 5) (%l accum))
157    (xorl (@ x8664::misc-data-offset (% str) (% offset) 4) (%l accum))
158    (addq ($ 1) (% offset))   
159    (subq ($ '1) (% len))
160    (jnz @loop8)
161    (shlq ($ 5) (% accum))
162    (shrq ($ (- 5 x8664::fixnumshift)) (% accum))
163    (movq (% accum) (% arg_z))
164    @done
165    (single-value-return)))
166
167;;; Ensure that the current thread's thread-local-binding vector
168;;; contains room for an entry with index INDEX.
169;;; Return the fixnum-tagged tlb vector.
170(defx86lapfunction %ensure-tlb-index ((idx arg_z))
171  (cmp (:rcontext x8632::tcr.tlb-limit) (% idx))
172  (jb @ok)
173  (push (% arg_z))                      ; exception handler will pop this
174  (ud2a)  (:byte 1)                     ; tlb_too_small()
175  @ok
176  (mov (:rcontext x8632::tcr.tlb-pointer) (% arg_z))
177  (single-value-return))
178
179) ; #+x8664-target
180
181
182
183
Note: See TracBrowser for help on using the repository browser.