source: trunk/source/level-0/PPC/ppc-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.3 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
20(eval-when (:compile-toplevel :execute)
21  #+ppc32-target
22  (require "PPC32-ARCH")
23  #+ppc64-target
24  (require "PPC64-ARCH")
25  (require "PPC-LAPMACROS"))
26
27;;; This assumes that macros & special-operators
28;;; have something that's not FUNCTIONP in their
29;;; function-cells.
30#+ppc32-target
31(defppclapfunction %function ((sym arg_z))
32  (check-nargs 1)
33  (cmpwi cr1 sym (target-nil-value))
34  (let ((symptr temp0)
35        (symbol temp1)
36        (def arg_z))
37    (li symptr (+ ppc32::nilsym-offset (target-nil-value)))
38    (mr symbol sym)
39    (if (:cr1 :ne)
40      (progn
41        (trap-unless-typecode= sym ppc32::subtag-symbol)
42        (mr symptr sym)))
43    (lwz def ppc32::symbol.fcell symptr)
44    (extract-typecode imm0 def)
45    (cmpwi cr0 imm0 ppc32::subtag-function)
46    (beqlr+)
47    (uuo_interr arch::error-udf symbol)))
48
49#+ppc64-target
50(defppclapfunction %function ((sym arg_z))
51  (check-nargs 1)
52  (let ((symbol temp1)
53        (def arg_z))
54    (mr symbol sym)
55    (trap-unless-typecode= sym ppc64::subtag-symbol)
56    (mr symbol sym)
57    (ld def ppc64::symbol.fcell symbol)
58    (extract-typecode imm0 def)
59    (cmpdi cr0 imm0 ppc64::subtag-function)
60    (beqlr+)
61    (uuo_interr arch::error-udf symbol)))
62
63;;; Traps unless sym is NIL or some other symbol.
64;;; On PPC32, NIL isn't really a symbol; this function maps from NIL
65;;; to an internal proxy symbol ("nilsym").
66;;; On PPC64, NIL is a real symbol, so this function just does a
67;;; little bit of type checking.
68(defppclapfunction %symbol->symptr ((sym arg_z))
69  #+ppc32-target
70  (progn
71    (cmpwi cr0 arg_z (target-nil-value))
72    (if (:cr0 :eq)
73      (progn
74        (li arg_z (+ ppc32::nilsym-offset (target-nil-value)))
75        (blr))))
76  (trap-unless-typecode= arg_z target::subtag-symbol)
77  (blr))
78
79;;; Traps unless symptr is a symbol; on PPC32, returns NIL if symptr
80;;; is NILSYM.
81(defppclapfunction %symptr->symbol ((symptr arg_z))
82  #+ppc32-target
83  (progn
84    (li imm1 (+ ppc32::nilsym-offset (target-nil-value)))
85    (cmpw cr0 imm1 symptr)
86    (if (:cr0 :eq)
87      (progn 
88        (li arg_z nil)
89        (blr))))
90  (trap-unless-typecode= symptr target::subtag-symbol imm0)
91  (blr))
92
93(defppclapfunction %symptr-value ((symptr arg_z))
94  (ba .SPspecref))
95
96(defppclapfunction %set-symptr-value ((symptr arg_y) (val arg_z))
97  (ba .SPspecset))
98
99(defppclapfunction %symptr-binding-address ((symptr arg_z))
100  (ldr imm3 target::symbol.binding-index symptr)
101  (ldr imm2 target::tcr.tlb-limit target::rcontext)
102  (ldr imm4 target::tcr.tlb-pointer target::rcontext)
103  (cmplr imm3 imm2)
104  (bge @sym)
105  (ldrx temp0 imm4 imm3)
106  (cmpdi temp0 target::subtag-no-thread-local-binding)
107  (slri imm3 imm3 target::fixnumshift)
108  (beq @sym)
109  (vpush imm4)
110  (vpush imm3)
111  (set-nargs 2)
112  (la temp0 '2 vsp)
113  (ba .SPvalues)
114  @sym
115  (li arg_y '#.target::symbol.vcell)
116  (vpush arg_z)
117  (vpush arg_y)
118  (set-nargs 2)
119  (la temp0 '2 vsp)
120  (ba .SPvalues))
121
122(defppclapfunction %tcr-binding-location ((tcr arg_y) (sym arg_z))
123  (ldr imm3 target::symbol.binding-index sym)
124  (ldr imm2 target::tcr.tlb-limit tcr)
125  (ldr imm4 target::tcr.tlb-pointer tcr)
126  (li arg_z nil)
127  (cmplr imm3 imm2)
128  (bgelr)
129  (ldrx temp0 imm4 imm3)
130  (cmpri temp0 target::subtag-no-thread-local-binding)
131  (beqlr)
132  (add arg_z imm4 imm3)
133  (blr))
134
135 
136(defppclapfunction %pname-hash ((str arg_y) (len arg_z))
137  (let ((nextw imm1)
138        (accum imm0)
139        (offset imm2))
140    (cmpwi cr0 len 0)
141    (li offset target::misc-data-offset)
142    (li accum 0)
143    (beqlr- cr0)   
144    @loop
145    (cmpri cr1 len '1)
146    (subi len len '1)
147    (lwzx nextw str offset)
148    (addi offset offset 4)
149    (rotlwi accum accum 5)
150    (xor accum accum nextw)
151    (bne cr1 @loop)
152    (slri accum accum 5)
153    (srri arg_z accum (- 5 target::fixnumshift))
154    (blr)))
155
156(defppclapfunction %string-hash ((start arg_x) (str arg_y) (len arg_z))
157  (let ((nextw imm1)
158        (accum imm0)
159        (offset imm2))
160    (cmpwi cr0 len 0)
161    #+32-bit-target
162    (la offset target::misc-data-offset start)
163    #+64-bit-target
164    (progn
165      (srwi offset start 1)
166      (la offset target::misc-data-offset offset))
167    (li accum 0)
168    (beqlr- cr0)   
169    @loop
170    (cmpri cr1 len '1)
171    (subi len len '1)
172    (lwzx nextw str offset)
173    (addi offset offset 4)
174    (rotlwi accum accum 5)
175    (xor accum accum nextw)
176    (bne cr1 @loop)
177    (slri accum accum 5)
178    (srri arg_z accum (- 5 target::fixnumshift))
179    (blr)))
180
181;;; Ensure that the current thread's thread-local-binding vector
182;;; contains room for an entry with index INDEX.
183;;; Return the fixnum-tagged tlb vector.
184(defppclapfunction %ensure-tlb-index ((idx arg_z))
185  (ldr arg_y target::tcr.tlb-limit target::rcontext)
186  (trlle arg_y idx)
187  (ldr arg_z target::tcr.tlb-pointer target::rcontext)
188  (blr))
Note: See TracBrowser for help on using the repository browser.