Changeset 14619


Ignore:
Timestamp:
Jan 31, 2011, 11:17:18 PM (9 years ago)
Author:
rme
Message:

Merge shrink-tcr branch. This enables the 32-bit Windows lisp to run
on 64-bit Windows.

On 32-bit x86 ports, we expect to use a segment register to point to a
block of thread-local data called the TCR (thread context record).
This has always been kind of a bother on 32-bit Windows: we have been
using a kludge that allows us to use the %es segment register
(conditionalized on WIN32_ES_HACK).

Unfortunately, 64-bit Windows doesn't support using an LDT. This is
why the 32-bit lisp wouldn't run on 64-bit Windows.

The new scheme is to use some of the TlsSlots? (part of the Windows
TEB) for the most important parts of the TCR, and to introduce an "aux
vector" for the remaining TCR slots. Since %fs points to the TEB, we
can make this work. We reserve the last 34 (of 64) slots for our use,
and will die if we don't get them.

Microsoft's documentation says not to access the TlsSlots? directly
(you're supposed to use TlsGetValue/TlsSetValue?), so we're treading on
undocumented ground. Frankly, we've done worse.

This change introduces some ugliness. In lisp kernel C files, there's
a TCR_AUX(tcr) macro that expands to "tcr->aux" on win32, and to "tcr"
elsewhere.

If lisp or lap code has a pointer to a TCR, it's necessary to subtract
off target::tcr-bias (which on Windows/x86 is #xe10, the offset from
%fs to the TlsSlots? in the Windows TEB). We also sometimes have to load
target::tcr.aux to get at data which has been moved there.

These changes should only affect Windows/x86. The story on the other
platforms is just the same as before.

Location:
trunk/source
Files:
33 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/X8632/x8632-arch.lisp

    r13971 r14619  
    577577  why)
    578578
     579#+windows-target
     580(progn
    579581(eval-when (:compile-toplevel :load-toplevel :execute)
    580   (defconstant tcr-bias 0))
     582  (defconstant tcr-bias #xe88))
     583
     584(define-storage-layout tcr tcr-bias
     585  linear
     586  aux
     587  valence
     588  node-regs-mask       ; bit set means corresponding reg contains node
     589  save-allocbase
     590  save-allocptr
     591  last-allocptr
     592  catch-top
     593  db-link
     594  tlb-limit
     595  tlb-pointer
     596  ffi-exception
     597  foreign-sp
     598  interrupt-pending
     599  next-method-context
     600  next-tsp
     601  safe-ref-address
     602  save-tsp
     603  save-vsp
     604  save-ebp
     605  ts-area
     606  vs-area
     607  xframe
     608  unwinding
     609  flags
     610  foreign-mxcsr
     611  lisp-mxcsr
     612  pending-exception-context
     613  unboxed0
     614  unboxed1
     615  save0
     616  save1
     617  save2
     618  save3)
     619
     620(define-storage-layout tcr-aux 0
     621  total-bytes-allocated-low
     622  total-bytes-allocated-high
     623  cs-area
     624  cs-limit
     625  log2-allocation-quantum
     626  errno-loc
     627  osid
     628  foreign-exception-status
     629  native-thread-info
     630  native-thread-id
     631  reset-completion
     632  activate
     633  gc-context
     634  termination-semaphore
     635  shutdown-count
     636  suspend-count
     637  suspend-context
     638  suspend
     639  resume
     640  allocated
     641  pending-io-info
     642  io-datum
     643  next
     644  prev)
     645
     646)
     647
     648#-windows-target
     649(progn
     650
     651(eval-when (:compile-toplevel :load-toplevel :execute)
     652  (defconstant tcr-bias #xe88))
    581653
    582654(define-storage-layout tcr (- tcr-bias)
     
    642714  pending-io-info
    643715  io-datum                              ;for windows overlapped I/O
     716)
    644717)
    645718
  • trunk/source/compiler/X86/X8632/x8632-backend.lisp

    r13067 r14619  
    117117                :target-foreign-type-data nil
    118118                :target-arch x8632::*x8632-target-arch*
    119                 :lisp-context-register x8632::es
     119                :lisp-context-register x8632::fs
    120120                :num-arg-regs 2
    121121                ))
  • trunk/source/compiler/X86/x86-asm.lisp

    r13411 r14619  
    548548    :rex-prefix ,rex-prefix
    549549    :modrm-byte ,modrm-byte))
     550
     551;;(ccl::pdbg "about to define *x86-opcode-templates*")
     552;;(ccl::dbg 1)
    550553
    551554(defparameter *x86-opcode-templates*
     
    34253428   ))
    34263429
     3430;;(ccl::pdbg "about to set ordinals")
    34273431
    34283432(dotimes (i (length *x86-opcode-templates*))
  • trunk/source/compiler/X86/x86-lap.lisp

    r14258 r14619  
    14291429                                              (if name 1 0)
    14301430                                              (if debug-info 1 0)))
    1431                                         target::subtag-xfunction)))
     1431                                        target::subtag-xfunction))
     1432         (nconstants (length constants)))
    14321433    (unless name (setq bits (logior bits (ash -1 $lfbits-noname-bit))))
    14331434    (let* ((last (1- (uvsize constants-vector))))
     
    14351436      (setf (uvref constants-vector last) bits)
    14361437      (when name
     1438        (incf nconstants)
    14371439        (setf (uvref constants-vector (decf last)) name))
    14381440      (when debug-info
     1441        (incf nconstants)
    14391442        (setf (uvref constants-vector (decf last)) debug-info))
     1443      (incf nconstants)
    14401444      (dolist (c constants)
    14411445        (setf (uvref constants-vector (decf last)) (car c)))
    1442       (let* ((nbytes 0))
    1443         (do-dll-nodes (frag frag-list)
    1444           (incf nbytes (frag-length frag)))
    1445         #+x8632-target
    1446         (when (>= nbytes (ash 1 18)) (compiler-function-overflow))
    1447         (let* ((code-vector (make-array nbytes
     1446      (let* ((code-bytes (let ((nbytes 0))
     1447                           (do-dll-nodes (frag frag-list nbytes)
     1448                             (incf nbytes (frag-length frag)))))
     1449             (arch (backend-target-arch *target-backend*))
     1450             (shift (arch::target-word-shift arch))
     1451             (code-words (ash code-bytes (- shift))))
     1452        (target-word-size-case
     1453         (32
     1454          (let* ((ncode (- code-words nconstants)))
     1455            (when (>= ncode #x8000)
     1456              ;;(break "hey, a big function!")
     1457              (if (>= nconstants #x8000)
     1458                (compiler-function-overflow)
     1459                (let* ((buf (car (frag-code-buffer
     1460                                  (dll-header-first frag-list))))
     1461                       (new-word (logior #x8000 nconstants)))
     1462                  (setf (aref buf 0) (ldb (byte 8 0) new-word)
     1463                        (aref buf 1) (ldb (byte 8 8) new-word))))))))
     1464        (let* ((code-vector (make-array code-bytes
    14481465                                        :element-type '(unsigned-byte 8)))
    14491466               (target-offset 0))
  • trunk/source/level-0/X86/X8632/x8632-float.lisp

    r13067 r14619  
    281281;;; Return the MXCSR as a fixnum
    282282(defx8632lapfunction %get-mxcsr ()
    283   (stmxcsr (:rcontext x8632::tcr.scratch-mxcsr))
    284   (movl (:rcontext x8632::tcr.scratch-mxcsr) (% imm0))
     283  (stmxcsr (:rcontext x8632::tcr.unboxed0))
     284  (movl (:rcontext x8632::tcr.unboxed0) (% imm0))
    285285  (box-fixnum imm0 arg_z)
    286286  (single-value-return))
     
    292292  (unbox-fixnum val imm0)
    293293  (andl ($ x86::mxcsr-write-mask) (% imm0))
    294   (movl (% imm0) (:rcontext x8632::tcr.scratch-mxcsr))
    295   (ldmxcsr (:rcontext x8632::tcr.scratch-mxcsr))
     294  (movl (% imm0) (:rcontext x8632::tcr.unboxed0))
     295  (ldmxcsr (:rcontext x8632::tcr.unboxed0))
    296296  (single-value-return))
    297297
  • trunk/source/level-0/X86/X8632/x8632-misc.lisp

    r13365 r14619  
    208208  (movl (@ (% :rcontext) x8632::tcr.last-allocptr) (% temp0))
    209209  (cmpl ($ -8) (% temp1))               ;void_allocptr
     210  (jz @go)
     211  #+windows-target
     212  (progn
     213    (movl (:rcontext x8632::tcr.aux) (% imm0))
     214    (movq (@ x8632::tcr-aux.total-bytes-allocated-low (% imm0)) (% mm0)))
     215  #-windows-target
    210216  (movq (@ (% :rcontext) x8632::tcr.total-bytes-allocated-low) (% mm0))
    211   (jz @go)
    212217  (movl (% temp0) (% arg_y))
    213218  (subl (% temp1) (% temp0))
     
    340345(defx8632lapfunction %tcr-toplevel-function ((tcr arg_z))
    341346  (check-nargs 1)
    342   (movl (@ x8632::tcr.vs-area (% tcr)) (% temp0))
     347  (movl (@ (- x8632::tcr.vs-area x8632::tcr-bias) (% tcr)) (% temp0))
    343348  (movl (@ x8632::area.high (% temp0)) (% imm0)) ;bottom of vstack
    344349  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
     
    355360(defx8632lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
    356361  (check-nargs 2)
    357   (movl (@ x8632::tcr.vs-area (% tcr)) (% temp0))
     362  (movl (@ (- x8632::tcr.vs-area x8632::tcr-bias) (% tcr)) (% temp0))
    358363  (movl (@ x8632::area.high (% temp0)) (% imm0))
    359364  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
     
    368373  (jne @have-room)
    369374  (movl (% imm0) (@ x8632::area.active (% temp0)))
    370   (movl (% imm0) (@ x8632::tcr.save-vsp (% tcr)))
     375  (movl (% imm0) (@ (- x8632::tcr.save-vsp x8632::tcr-bias) (% tcr)))
    371376  (jmp @have-room)
    372377  @have-room
  • trunk/source/level-0/X86/x86-io.lisp

    r13067 r14619  
    3333#+x8632-target
    3434(defx8632lapfunction %get-errno ()
     35  #+windows-target
     36  (progn
     37    (movl (:rcontext x8632::tcr.aux) (% imm0))
     38    (movl (@ x8632::tcr-aux.errno-loc (% imm0)) (% imm0)))
     39  #-windows-target
    3540  (movl (:rcontext x8632::tcr.errno-loc) (% imm0))
    3641  (movl (@ (% imm0)) (% imm0))
    3742  (neg (% imm0))
    3843  (box-fixnum imm0 arg_z)
     44  #+windows-target
     45  (progn
     46    (movl (:rcontext x8632::tcr.aux) (% imm0))
     47    (movl (@ x8632::tcr-aux.errno-loc (% imm0)) (% imm0)))
     48  #-windows-target
    3949  (movl (:rcontext x8632::tcr.errno-loc) (% imm0))
    4050  (movss (% fpzero) (@ (% imm0)))
  • trunk/source/level-0/l0-misc.lisp

    r14541 r14619  
    266266                     (incf used (- high low))))
    267267                 (values free used)))))
    268     (let* ((tcr (lisp-thread.tcr thread)))
     268    (let* ((tcr (lisp-thread.tcr thread))
     269           (cs-area #+(and windows-target x8632-target)
     270                    (%fixnum-ref (%fixnum-ref tcr (- target::tcr.aux
     271                                                     target::tcr-bias))
     272                                 target::tcr-aux.cs-area)
     273                    #-(and windows-target x8632-target)
     274                    (%fixnum-ref tcr target::tcr.cs-area)))
    269275      (if (or (null tcr)
    270               (zerop (%fixnum-ref (%fixnum-ref tcr target::tcr.cs-area))))
     276              (zerop (%fixnum-ref cs-area)))
    271277        (values 0 0 0 0 0 0)
    272         (multiple-value-bind (cf cu) (free-and-used (%fixnum-ref tcr target::tcr.cs-area))
    273           (multiple-value-bind (vf vu) (free-and-used (%fixnum-ref tcr target::tcr.vs-area))
     278        (multiple-value-bind (cf cu) (free-and-used cs-area)
     279          (multiple-value-bind (vf vu)
     280              (free-and-used (%fixnum-ref tcr (- target::tcr.vs-area
     281                                                 target::tcr-bias)))
    274282            #+arm-target
    275283            (values cf cu vf vu)
    276284            #-arm-target
    277             (multiple-value-bind (tf tu) (free-and-used (%fixnum-ref tcr target::tcr.ts-area ))
     285            (multiple-value-bind (tf tu)
     286                (free-and-used (%fixnum-ref tcr (- target::tcr.ts-area
     287                                                   target::tcr-bias)))
    278288              (values cf cu vf vu tf tu))))))))
    279289
  • trunk/source/level-0/nfasload.lisp

    r14046 r14619  
    428428    #+x8632-target
    429429    (%update-self-references vector)
     430    #+x8632-target
     431    (let* ((addr (%address-of vector))
     432           (insn (%get-unsigned-long (%int-to-ptr addr))))
     433      (when (eql insn #xbf)
     434        (pdbg "update-self-references blew it")
     435        (dbg vector)))
    430436    (do* ((numconst (- size-in-elements size-of-code))
    431437          (i 0 (1+ i))
  • trunk/source/level-1/l1-lisp-threads.lisp

    r14367 r14619  
    194194
    195195(defun init-thread-from-tcr (tcr thread)
    196   (let* ((cs-area (%fixnum-ref tcr target::tcr.cs-area))
    197          (vs-area (%fixnum-ref tcr target::tcr.vs-area))
     196  (let* ((cs-area nil)
     197         (vs-area (%fixnum-ref tcr (- target::tcr.vs-area target::tcr-bias)))
    198198         #-arm-target
    199          (ts-area (%fixnum-ref tcr target::tcr.ts-area)))
     199         (ts-area (%fixnum-ref tcr (- target::tcr.ts-area target::tcr-bias))))
     200    #+(and windows-target x8632-target)
     201    (let ((aux (%fixnum-ref tcr (- target::tcr.aux target::tcr-bias))))
     202      (setq cs-area (%fixnum-ref aux target::tcr-aux.cs-area)))
     203    #-(and windows-target x8632-target)
     204    (setq cs-area (%fixnum-ref tcr target::tcr.cs-area))
    200205    (when (or (zerop cs-area)
    201206              (zerop vs-area)
     
    334339
    335340(defun tcr-flags (tcr)
    336   (%fixnum-ref tcr target::tcr.flags))
     341  (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias)))
    337342
    338343
     
    361366  ;; When a thread dies, it should try to clear its interrupt-pending
    362367  ;; flag.
    363   (if (eql 0 (%fixnum-ref tcr target::tcr.interrupt-pending))
     368  (if (eql 0 (%fixnum-ref tcr (- target::tcr.interrupt-pending
     369                                 target::tcr-bias)))
    364370    (%%tcr-interrupt tcr)
    365371    0))
     
    415421  (let* ((tcr (or (lisp-thread.tcr thread) (new-tcr-for-thread thread))))
    416422    (with-macptrs (s)
     423      #+(and windows-target x8632-target)
     424      (let ((aux (%fixnum-ref tcr (- target::tcr.aux target::tcr-bias))))
     425        (%setf-macptr-to-object s (%fixnum-ref aux target::tcr-aux.reset-completion)))
     426      #-(and windows-target x8632-target)
    417427      (%setf-macptr-to-object s (%fixnum-ref tcr target::tcr.reset-completion))
    418428      (when (%timed-wait-on-semaphore-ptr s timeout nil)
     
    425435
    426436(defun cleanup-thread-tcr (thread tcr)
    427   (let* ((flags (%fixnum-ref tcr target::tcr.flags)))
     437  (let* ((flags (%fixnum-ref tcr (- target::tcr.flags
     438                                    target::tcr-bias))))
    428439    (declare (fixnum flags))
    429440    (if (logbitp arch::tcr-flag-bit-awaiting-preset flags)
     
    447458    (%setf-macptr-to-object tcrp (lisp-thread.tcr thread))
    448459    (unless (%null-ptr-p tcrp)
    449       (let* ((natural (%get-natural tcrp target::tcr.osid)))
     460     
     461      (let* ((natural #+(and windows-target x8632-target)
     462                      (%get-natural (%get-ptr tcrp (- target::tcr.aux
     463                                                      target::tcr-bias))
     464                                    target::tcr-aux.osid)
     465                      #-(and windows-target x8632-target)
     466                      (%get-natural tcrp target::tcr.osid)))
    450467        (unless (zerop natural) natural)))))
    451468
     
    466483    (%setf-macptr-to-object tcrp (lisp-thread.tcr thread))
    467484    (unless (%null-ptr-p tcrp)
     485      #+(and windows-target x8632-target)
     486      (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
     487        (%get-unsigned-long aux target::tcr-aux.native-thread-id))
     488      #-(and windows-target x8632-target)
    468489      (#+32-bit-target %get-unsigned-long
    469490       #+64-bit-target %%get-unsigned-longlong tcrp target::tcr.native-thread-id))))
     
    473494    (%setf-macptr-to-object tcrp (lisp-thread.tcr thread))
    474495    (unless (%null-ptr-p tcrp)
     496      #+(and windows-target x8632-target)
     497      (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
     498        (%get-unsigned-long aux target::tcr-aux.suspend-count))
     499      #-(and windows-target x8632-target)
    475500      (#+32-bit-target %get-unsigned-long
    476501       #+64-bit-target %%get-unsigned-longlong tcrp target::tcr.suspend-count))))
    477502
    478503(defun tcr-clear-preset-state (tcr)
    479   (let* ((flags (%fixnum-ref tcr target::tcr.flags)))
     504  (let* ((flags (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias))))
    480505    (declare (fixnum flags))
    481     (setf (%fixnum-ref tcr target::tcr.flags)
     506    (setf (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias))
    482507          (bitclr arch::tcr-flag-bit-awaiting-preset flags))))
    483508
    484509(defun tcr-set-preset-state (tcr)
    485   (let* ((flags (%fixnum-ref tcr target::tcr.flags)))
     510  (let* ((flags (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias))))
    486511    (declare (fixnum flags))
    487     (setf (%fixnum-ref tcr target::tcr.flags)
     512    (setf (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias))
    488513          (bitset arch::tcr-flag-bit-awaiting-preset flags)))) 
    489514
     
    494519    (with-macptrs (tcrp)
    495520      (%setf-macptr-to-object tcrp tcr)
     521      #+(and windows-target x8632-target)
     522      (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
     523        (setf (%get-unsigned-long aux target::tcr-aux.log2-allocation-quantum)
     524              (or allocation-quantum (default-allocation-quantum))))
     525      #-(and windows-target x8632-target)
    496526      (setf (%get-natural tcrp target::tcr.log2-allocation-quantum)
    497527            (or allocation-quantum (default-allocation-quantum)))
     
    680710
    681711(defun %ptr-to-vstack-p (tcr idx)
    682   (%ptr-in-area-p idx (%fixnum-ref tcr target::tcr.vs-area)))
     712  (%ptr-in-area-p idx (%fixnum-ref tcr (- target::tcr.vs-area
     713                                          target::tcr-bias))))
    683714
    684715#-arm-target
    685716(defun %on-tsp-stack (tcr object)
    686   (%ptr-in-area-p object (%fixnum-ref tcr target::tcr.ts-area)))
     717  (%ptr-in-area-p object (%fixnum-ref tcr (- target::tcr.ts-area
     718                                             target::tcr-bias))))
    687719
    688720(defun %on-csp-stack (tcr object)
    689   (%ptr-in-area-p object (%fixnum-ref tcr target::tcr.cs-area)))
     721  (let ((cs-area #+(and windows-target x8632-target)
     722                 (%fixnum-ref (%fixnum-ref tcr (- target::tcr.aux
     723                                                  target::tcr-bias))
     724                              target::tcr-aux.cs-area)
     725                 #-(and windows-target x8632-target)
     726                 (%fixnum-ref tcr target::tcr.cs-area)))
     727    (%ptr-in-area-p object cs-area)))
    690728
    691729(defparameter *aux-tsp-ranges* ())
  • trunk/source/level-1/l1-processes.lisp

    r14362 r14619  
    317317(defmethod process-tcr-enable ((process process) tcr)
    318318  (when (and tcr (not (eql 0 tcr)))
     319    #+(and windows-target x8632-target)
     320    (let ((aux (%fixnum-ref tcr (- target::tcr.aux target::tcr-bias))))
     321      (%signal-semaphore-ptr (%fixnum-ref-macptr aux target::tcr-aux.activate)))
     322    #-(and windows-target x8632-target)
    319323    (%signal-semaphore-ptr (%fixnum-ref-macptr tcr target::tcr.activate))
    320324    ))
     
    695699    (with-macptrs (tcrp)
    696700      (%setf-macptr-to-object tcrp (%current-tcr))
    697       (setf (slot-value *current-process* 'allocation-quantum) new
    698             (%get-natural tcrp target::tcr.log2-allocation-quantum)
     701      #+(and windows-target x8632-target)
     702      (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
     703        (setf (%get-natural aux target::tcr-aux.log2-allocation-quantum)
     704              (1- (integer-length new))))
     705      #-(and windows-target x8632-target)
     706      (setf (%get-natural tcrp target::tcr.log2-allocation-quantum)
    699707            (1- (integer-length new)))
     708      (setf (slot-value *current-process* 'allocation-quantum) new)
    700709      new)
    701710    (report-bad-arg new '(satisfies valid-allocation-quantum-p))))
  • trunk/source/level-1/x86-threads-utils.lisp

    r13067 r14619  
    2828       (locally (declare (fixnum p))
    2929         (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
    30                 (vs-area (%fixnum-ref tcr target::tcr.vs-area)))
     30                (vs-area (%fixnum-ref tcr (- target::tcr.vs-area
     31                                             target::tcr-bias))))
    3132           (not (%ptr-in-area-p p vs-area))))))
    3233
  • trunk/source/lib/backtrace.lisp

    r14351 r14619  
    4444                        #+ppc-target *fake-stack-frames*
    4545                        #+(or x86-target arm-target) frame-ptr
    46                         (%fixnum-ref tcr target::tcr.db-link)
     46                        (%fixnum-ref tcr (- target::tcr.db-link
     47                                            target::tcr-bias))
    4748                        0         ;; break level - not used
    4849                        )))
  • trunk/source/lib/describe.lisp

    r14119 r14619  
    17741774(defun make-vsp-stack-range (tcr bt-info)
    17751775  (list (cons (ccl::%svref (ccl::bt.top-catch bt-info) target::catch-frame.esp-cell)
    1776               (ccl::%fixnum-ref (ccl::%fixnum-ref tcr target::tcr.vs-area)
     1776              (ccl::%fixnum-ref (ccl::%fixnum-ref tcr (- target::tcr.vs-area
     1777                                                         target::tcr-bias))
    17771778                                target::area.high))))
    17781779
     
    17981799#+x8632-target
    17991800(defun make-csp-stack-range (tcr bt-info)
     1801  (let ((cs-area nil))
     1802    #+windows-target
     1803    (let ((aux (ccl::%fixnum-ref tcr (- target::tcr.aux target::tcr-bias))))
     1804      (setq cs-area (ccl::%fixnum-ref aux target::tcr-aux.cs-area)))
     1805    #-windows-target
     1806    (setq cs-area (ccl::%fixnum-ref tcr target::tcr.cs-area))
    18001807  (list (cons (ccl::%svref (ccl::bt.top-catch bt-info) target::catch-frame.foreign-sp-cell)
    1801               (ccl::%fixnum-ref (ccl::%fixnum-ref tcr target::tcr.cs-area)
    1802                                 target::area.high))))
     1808              (ccl::%fixnum-ref cs-area target::area.high)))))
    18031809
    18041810#+x8664-target
  • trunk/source/lib/nfcomp.lisp

    r14351 r14619  
    17721772    (let* ((code (uvref f 0))
    17731773           (function-size (ash (uvsize code) -2))
    1774            (imm-words (dpb (uvref code 1) (byte 8 8) (uvref code 0)))
     1774           (encoded-imm-words (dpb (uvref code 1) (byte 8 8) (uvref code 0)))
     1775           (imm-words (if (logbitp 15 encoded-imm-words)
     1776                        (- function-size (ldb (byte 15 0) encoded-imm-words))
     1777                        encoded-imm-words))
    17751778           (imm-bytes (ash imm-words 2))
    17761779           (other-words (- function-size imm-words)))
  • trunk/source/lib/x86-backtrace.lisp

    r13067 r14619  
    121121(defun %stack< (index1 index2 &optional context)
    122122  (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
    123          (vs-area (%fixnum-ref tcr target::tcr.vs-area)))
     123         (vs-area (%fixnum-ref tcr (- target::tcr.vs-area
     124                                      target::tcr-bias))))
    124125    (and (%ptr-in-area-p index1 vs-area)
    125126         (%ptr-in-area-p index2 vs-area)
     
    300301(defun last-tsp-before (target)
    301302  (declare (fixnum target))
    302   (do* ((tsp (%fixnum-ref (%current-tcr) target::tcr.save-tsp)
     303  (do* ((tsp (%fixnum-ref (%current-tcr) (- target::tcr.save-tsp
     304                                            target::tcr-bias))
    303305             (%fixnum-ref tsp target::tsp-frame.backptr)))
    304306       ((zerop tsp) nil)
     
    315317(defun last-foreign-sp-before (target)
    316318  (declare (fixnum target))
    317   (do* ((cfp (%fixnum-ref (%current-tcr) target::tcr.foreign-sp)
     319  (do* ((cfp (%fixnum-ref (%current-tcr) (- target::tcr.foreign-sp
     320                                            target::tcr-bias))
    318321             (%fixnum-ref cfp target::csp-frame.backptr)))
    319322       ((zerop cfp))
     
    330333(defun %tsp-frame-containing-progv-binding (db)
    331334  (declare (fixnum db))
    332   (do* ((tsp (%fixnum-ref (%current-tcr) target::tcr.save-tsp) next)
     335  (do* ((tsp (%fixnum-ref (%current-tcr) (- target::tcr.save-tsp
     336                                            target::tcr-bias)) next)
    333337        (next (%fixnum-ref tsp target::tsp-frame.backptr)
    334338              (%fixnum-ref tsp target::tsp-frame.backptr)))
     
    353357  (do* ((db (%current-db-link) (%fixnum-ref db 0))
    354358        (tcr (%current-tcr))
    355         (vs-area (%fixnum-ref tcr target::tcr.vs-area))
     359        (vs-area (%fixnum-ref tcr (- target::tcr.vs-area
     360                                     target::tcr-bias)))
    356361        (vs-low (%fixnum-ref vs-area target::area.low))
    357362        (vs-high (%fixnum-ref vs-area target::area.high)))
  • trunk/source/lisp-kernel/gc-common.c

    r14422 r14619  
    686686  ExceptionInformation *xp;
    687687
    688   xp = tcr->gc_context;
     688  xp = TCR_AUX(tcr)->gc_context;
    689689  if (xp) {
    690690#ifndef X8632
     
    13881388
    13891389#ifndef FORCE_DWS_MARK
    1390   if ((natural) (tcr->cs_limit) == CS_OVERFLOW_FORCE_LIMIT) {
     1390  if ((natural) (TCR_AUX(tcr)->cs_limit) == CS_OVERFLOW_FORCE_LIMIT) {
    13911391    GCstack_limit = CS_OVERFLOW_FORCE_LIMIT;
    13921392  } else {
    1393     GCstack_limit = (natural)(tcr->cs_limit)+(natural)page_size;
     1393    GCstack_limit = (natural)(TCR_AUX(tcr)->cs_limit)+(natural)page_size;
    13941394  }
    13951395#else
     
    15611561      mark_tcr_xframes(other_tcr);
    15621562      mark_tcr_tlb(other_tcr);
    1563       other_tcr = other_tcr->next;
     1563      other_tcr = TCR_AUX(other_tcr)->next;
    15641564    } while (other_tcr != tcr);
    15651565
     
    16451645      forward_tcr_xframes(other_tcr);
    16461646      forward_tcr_tlb(other_tcr);
    1647       other_tcr = other_tcr->next;
     1647      other_tcr = TCR_AUX(other_tcr)->next;
    16481648    } while (other_tcr != tcr);
    16491649
  • trunk/source/lisp-kernel/lisp-debug.c

    r14590 r14619  
    880880 
    881881  if (tcr) {
    882     area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area;
     882    area *vs_area = tcr->vs_area, *cs_area;
     883
     884    if (TCR_AUX(tcr))
     885      cs_area = TCR_AUX(tcr)->cs_area;
    883886
    884887    fprintf(dbgout, "Current Thread Context Record (tcr) = 0x" LISP "\n", tcr);
  • trunk/source/lisp-kernel/macros.h

    r14119 r14619  
    120120#endif
    121121
     122#ifdef WIN_32
     123#define TCR_AUX(tcr) tcr->aux
     124#else
     125#define TCR_AUX(tcr) tcr
     126#endif
    122127#endif /* __macros __ */
  • trunk/source/lisp-kernel/pmcl-kernel.c

    r14603 r14619  
    16641664
    16651665
    1666  
    16671666
    16681667
     
    19701969  lisp_global(STATICALLY_LINKED) = 1 << fixnumshift;
    19711970#endif
    1972   tcr->prev = tcr->next = tcr;
     1971  TCR_AUX(tcr)->prev = TCR_AUX(tcr)->next = tcr;
    19731972#ifndef WINDOWS
    19741973  lisp_global(INTERRUPT_SIGNAL) = (LispObj) box_fixnum(SIGNAL_FOR_PROCESS_INTERRUPT);
     
    24512450#endif
    24522451    allocate_static_conses(nconses);
    2453     tcr->bytes_allocated += nbytes;
     2452    TCR_AUX(tcr)->bytes_allocated += nbytes;
    24542453  }
    24552454#ifdef USE_GC_NOTIFICATION
  • trunk/source/lisp-kernel/thread_manager.c

    r14589 r14619  
    7474  char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
    7575  CONTEXT  *pcontext;
    76   HANDLE hthread = (HANDLE)(target->osid);
     76  HANDLE hthread = (HANDLE)(TCR_AUX(target)->osid);
    7777  pc where;
    7878  area *ts = target->ts_area;
     
    157157      *(--p) = (LispObj)raise_thread_interrupt;;
    158158      xpGPR(pcontext,Isp) = (DWORD)p;
    159 #ifdef WIN32_ES_HACK
    160       pcontext->SegEs = pcontext->SegDs;
    161 #endif
    162159    }
    163160#endif
     
    173170raise_thread_interrupt(TCR *target)
    174171{
    175   pthread_t thread = (pthread_t)target->osid;
     172  pthread_t thread = (pthread_t)TCR_AUX(target)->osid;
    176173#ifdef DARWIN_not_yet
    177174  if (use_mach_exception_handling) {
     
    534531
    535532  if (tcr) {
    536     current = tcr->osid;
     533    current = TCR_AUX(tcr)->osid;
    537534  }
    538535  if (current == 0) {
     
    545542                    DUPLICATE_SAME_ACCESS);
    546543    if (tcr) {
    547       tcr->osid = current;
     544      TCR_AUX(tcr)->osid = current;
    548545    }
    549546  }
     
    589586   
    590587    tcr = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
    591     tcr->suspend_count = 1;
     588    TCR_AUX(tcr)->suspend_count = 1;
    592589    tcr->vs_area->active -= node_size;
    593590    *(--tcr->save_vsp) = lisp_nil;
     
    597594    SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
    598595  } else {
    599     tcr->suspend_context = context;
    600     SEM_RAISE(tcr->suspend);
    601     SEM_WAIT_FOREVER(tcr->resume);
    602     tcr->suspend_context = NULL;
     596    TCR_AUX(tcr)->suspend_context = context;
     597    SEM_RAISE(TCR_AUX(tcr)->suspend);
     598    SEM_WAIT_FOREVER(TCR_AUX(tcr)->resume);
     599    TCR_AUX(tcr)->suspend_context = NULL;
    603600  }
    604601#ifdef DARWIN_GS_HACK
     
    776773  TCR *next, *prev;
    777774
    778   next = tcr->next;
    779   prev = tcr->prev;
    780 
    781   prev->next = next;
    782   next->prev = prev;
    783   tcr->prev = tcr->next = NULL;
     775  next = TCR_AUX(tcr)->next;
     776  prev = TCR_AUX(tcr)->prev;
     777
     778  TCR_AUX(prev)->next = next;
     779  TCR_AUX(next)->prev = prev;
     780  TCR_AUX(tcr)->prev = TCR_AUX(tcr)->next = NULL;
    784781#ifdef X8664
    785782  tcr->linear = NULL;
     
    794791  LOCK(lisp_global(TCR_AREA_LOCK),new);
    795792  head = (TCR *)ptr_from_lispobj(lisp_global(INITIAL_TCR));
    796   tail = head->prev;
    797   tail->next = new;
    798   head->prev = new;
    799   new->prev = tail;
    800   new->next = head;
     793  tail = TCR_AUX(head)->prev;
     794  TCR_AUX(tail)->next = new;
     795  TCR_AUX(head)->prev = new;
     796  TCR_AUX(new)->prev = tail;
     797  TCR_AUX(new)->next = head;
    801798  UNLOCK(lisp_global(TCR_AREA_LOCK),new);
    802799}
     
    806803allocate_tcr()
    807804{
    808   void *p = calloc(1,sizeof(TCR)+15);
    809   TCR *tcr = (TCR *)((((natural)p)+15)&~15);
    810 
    811   tcr->allocated = p;
     805  void *p = calloc(1,sizeof(struct tcr_aux));
     806  char *teb = (char *)NtCurrentTeb();
     807  TCR *tcr = (TCR *)(teb + TCR_BIAS);
     808
     809  if (p == NULL)
     810    allocation_failure(true, sizeof(struct tcr_aux));
     811
     812  if ((intptr_t)p & 03) {
     813    fprintf(dbgout, "%p not aligned\n", p);
     814    exit(1);
     815  }
     816  memset(tcr, 0, sizeof(TCR));
     817  tcr->aux = p;
    812818  return tcr;
    813819}
     
    10631069setup_tcr_extra_segment(TCR *tcr)
    10641070{
    1065   int i, status;
    1066   DWORD nret;
    1067   win32_ldt_info info;
    1068   LDT_ENTRY *entry = &(info.entry);
    1069   DWORD *words = (DWORD *)entry, tcraddr = (DWORD)tcr;
    1070 
    1071 
    1072   WaitForSingleObject(ldt_lock,INFINITE);
    1073 
    1074   for (i = 0; i < 8192; i++) {
    1075     if (!ref_bit(ldt_entries_in_use,i)) {
    1076       info.offset = i << 3;
    1077       info.size = sizeof(LDT_ENTRY);
    1078       words[0] = 0;
    1079       words[1] = 0;
    1080       status = NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
    1081       if (status == 0) {
    1082         if ((info.size == 0) ||
    1083             ((words[0] == 0) && (words[1] == 0))) {
    1084           break;
    1085         }
    1086       }
    1087     }
    1088   }
    1089   if (i == 8192) {
    1090     ReleaseMutex(ldt_lock);
    1091     fprintf(dbgout, "All 8192 ldt entries in use ?\n");
    1092     _exit(1);
    1093   }
    1094   set_bit(ldt_entries_in_use,i);
    1095   words[0] = 0;
    1096   words[1] = 0;
    1097   entry->LimitLow = sizeof(TCR);
    1098   entry->BaseLow = tcraddr & 0xffff;
    1099   entry->HighWord.Bits.BaseMid = (tcraddr >> 16) & 0xff;
    1100   entry->HighWord.Bits.BaseHi = (tcraddr >> 24);
    1101   entry->HighWord.Bits.Pres = 1;
    1102   entry->HighWord.Bits.Default_Big = 1;
    1103   entry->HighWord.Bits.Type = 16 | 2; /* read-write data */
    1104   entry->HighWord.Bits.Dpl = 3; /* for use by the great unwashed */
    1105   info.size = sizeof(LDT_ENTRY);
    1106   status = NtSetInformationProcess(GetCurrentProcess(),10,&info,sizeof(info));
    1107   if (status != 0) {
    1108     ReleaseMutex(ldt_lock);
    1109     FBug(NULL, "can't set LDT entry %d, status = 0x%x", i, status);
    1110   }
    1111 #if 1
    1112   /* Sanity check */
    1113   info.offset = i << 3;
    1114   info.size = sizeof(LDT_ENTRY);
    1115   words[0] = 0;
    1116   words[0] = 0;
    1117   NtQueryInformationProcess(GetCurrentProcess(),10,&info,sizeof(info),&nret);
    1118   if (((entry->BaseLow)|((entry->HighWord.Bits.BaseMid)<<16)|((entry->HighWord.Bits.BaseHi)<<24)) != tcraddr) {
    1119     Bug(NULL, "you blew it: bad address in ldt entry\n");
    1120   }
    1121 #endif
    1122   tcr->ldt_selector = (i << 3) | 7;
    1123   ReleaseMutex(ldt_lock);
    11241071}
    11251072
     
    11271074free_tcr_extra_segment(TCR *tcr)
    11281075{
    1129   win32_ldt_info info;
    1130   LDT_ENTRY *entry = &(info.entry);
    1131   DWORD *words = (DWORD *)entry;
    1132   int idx = tcr->ldt_selector >> 3;
    1133 
    1134 
    1135   info.offset = idx << 3;
    1136   info.size = sizeof(LDT_ENTRY);
    1137 
    1138   words[0] = 0;
    1139   words[1] = 0;
    1140 
    1141   WaitForSingleObject(ldt_lock,INFINITE);
    1142   NtSetInformationProcess(GetCurrentProcess(),10,&info,sizeof(info));
    1143   clr_bit(ldt_entries_in_use,idx);
    1144   ReleaseMutex(ldt_lock);
    1145 
    1146   tcr->ldt_selector = 0;
    11471076}
    11481077
     
    13351264  tcr->single_float_convert.tag = subtag_single_float;
    13361265#endif
    1337   tcr->suspend = new_semaphore(0);
    1338   tcr->resume = new_semaphore(0);
    1339   tcr->reset_completion = new_semaphore(0);
    1340   tcr->activate = new_semaphore(0);
     1266  TCR_AUX(tcr)->suspend = new_semaphore(0);
     1267  TCR_AUX(tcr)->resume = new_semaphore(0);
     1268  TCR_AUX(tcr)->reset_completion = new_semaphore(0);
     1269  TCR_AUX(tcr)->activate = new_semaphore(0);
    13411270  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
    13421271  a = allocate_vstack_holding_area_lock(vstack_size);
     
    13861315  tcr->shutdown_count = PTHREAD_DESTRUCTOR_ITERATIONS;
    13871316#else
    1388   tcr->shutdown_count = 1;
     1317  TCR_AUX(tcr)->shutdown_count = 1;
    13891318#endif
    13901319  return tcr;
     
    14021331  }
    14031332
    1404   if (--(tcr->shutdown_count) == 0) {
     1333  if (--(TCR_AUX(tcr)->shutdown_count) == 0) {
    14051334    if (tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN)) {
    14061335      LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
     
    14211350    tcr->ts_area = NULL;
    14221351#endif
    1423     cs = tcr->cs_area;
    1424     tcr->cs_area = NULL;
     1352    cs = TCR_AUX(tcr)->cs_area;
     1353    TCR_AUX(tcr)->cs_area = NULL;
    14251354    if (vs) {
    14261355      condemn_area_holding_area_lock(vs);
     
    14501379#endif
    14511380#endif
    1452     destroy_semaphore(&tcr->suspend);
    1453     destroy_semaphore(&tcr->resume);
    1454     destroy_semaphore(&tcr->reset_completion);
    1455     destroy_semaphore(&tcr->activate);
     1381    destroy_semaphore(&TCR_AUX(tcr)->suspend);
     1382    destroy_semaphore(&TCR_AUX(tcr)->resume);
     1383    destroy_semaphore(&TCR_AUX(tcr)->reset_completion);
     1384    destroy_semaphore(&TCR_AUX(tcr)->activate);
    14561385    tcr->tlb_limit = 0;
    14571386    free(tcr->tlb_pointer);
    14581387    tcr->tlb_pointer = NULL;
    14591388#ifdef WINDOWS
    1460     if (tcr->osid != 0) {
    1461       CloseHandle((HANDLE)(tcr->osid));
    1462     }
    1463 #endif
    1464     tcr->osid = 0;
     1389    if (TCR_AUX(tcr)->osid != 0) {
     1390      CloseHandle((HANDLE)(TCR_AUX(tcr)->osid));
     1391    }
     1392#endif
     1393    TCR_AUX(tcr)->osid = 0;
    14651394    tcr->interrupt_pending = 0;
    1466     tcr->termination_semaphore = NULL;
    1467 #ifdef HAVE_TLS
     1395    TCR_AUX(tcr)->termination_semaphore = NULL;
     1396#if defined(HAVE_TLS) || defined(WIN_32)
    14681397    dequeue_tcr(tcr);
    14691398#endif
     
    14711400    free_tcr_extra_segment(tcr);
    14721401#endif
    1473 #ifdef WIN32
    1474     CloseHandle((HANDLE)tcr->io_datum);
    1475     tcr->io_datum = NULL;
    1476     free(tcr->native_thread_info);
    1477     tcr->native_thread_info = NULL;
     1402#ifdef WINDOWS
     1403    CloseHandle((HANDLE)TCR_AUX(tcr)->io_datum);
     1404    TCR_AUX(tcr)->io_datum = NULL;
     1405    free(TCR_AUX(tcr)->native_thread_info);
     1406    TCR_AUX(tcr)->native_thread_info = NULL;
     1407#ifdef WIN_32
     1408    free(tcr->aux);
     1409    tcr->aux = NULL;
     1410#endif
    14781411#endif
    14791412    UNLOCK(lisp_global(TCR_AREA_LOCK),current);
     
    14991432  }
    15001433#endif
    1501   a = tcr->cs_area;
     1434  a = TCR_AUX(tcr)->cs_area;
    15021435  if (a) {
    15031436    a->active = a->high;
    15041437  }
    15051438  tcr->valence = TCR_STATE_FOREIGN;
    1506   tcr->shutdown_count = 1;
     1439  TCR_AUX(tcr)->shutdown_count = 1;
    15071440  shutdown_thread_tcr(tcr);
    15081441  tsd_set(lisp_global(TCR_KEY), NULL);
     
    15411474  area *a, *register_cstack_holding_area_lock(BytePtr, natural);
    15421475
    1543   tcr->osid = current_thread_osid();
    1544   tcr->native_thread_id = current_native_thread_id();
     1476  TCR_AUX(tcr)->osid = current_thread_osid();
     1477  TCR_AUX(tcr)->native_thread_id = current_native_thread_id();
    15451478  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
    15461479  a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size);
    15471480  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
    1548   tcr->cs_area = a;
     1481  TCR_AUX(tcr)->cs_area = a;
    15491482  a->owner = tcr;
    15501483#ifdef ARM
     
    15521485#endif
    15531486  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
    1554     tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
     1487    TCR_AUX(tcr)->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
    15551488  }
    15561489#ifdef LINUX
     
    15611494#endif
    15621495#endif
    1563   tcr->errno_loc = &errno;
     1496  TCR_AUX(tcr)->errno_loc = &errno;
    15641497  tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
    15651498#ifdef DARWIN
     
    15731506#endif
    15741507#ifdef WINDOWS
    1575   tcr->io_datum = (VOID *)CreateEvent(NULL, true, false, NULL);
    1576   tcr->native_thread_info = malloc(sizeof(CONTEXT));
    1577 #endif
    1578   tcr->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
     1508  TCR_AUX(tcr)->io_datum = (VOID *)CreateEvent(NULL, true, false, NULL);
     1509  TCR_AUX(tcr)->native_thread_info = malloc(sizeof(CONTEXT));
     1510#endif
     1511  TCR_AUX(tcr)->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
    15791512}
    15801513
     
    17031636  SEM_RAISE(activation->created);
    17041637  do {
    1705     SEM_RAISE(tcr->reset_completion);
    1706     SEM_WAIT_FOREVER(tcr->activate);
     1638    SEM_RAISE(TCR_AUX(tcr)->reset_completion);
     1639    SEM_WAIT_FOREVER(TCR_AUX(tcr)->activate);
    17071640    /* Now go run some lisp code */
    17081641    start_lisp(TCR_TO_TSD(tcr),0);
     
    17571690  start_vsp = tcr->save_vsp;
    17581691  do {
    1759     SEM_RAISE(tcr->reset_completion);
     1692    SEM_RAISE(TCR_AUX(tcr)->reset_completion);
    17601693    suspend_current_cooperative_thread();
    17611694     
     
    18031736      return true;
    18041737    }
    1805     p = p->next;
     1738    p = TCR_AUX(p)->next;
    18061739  } while (p != head);
    18071740  return false;
     
    19061839#ifdef HAVE_TLS
    19071840  TCR *current = current_tcr;
     1841#elif defined(WIN_32)
     1842  TCR *current = (TCR *)((char *)NtCurrentTeb() + TCR_BIAS);
    19081843#else
    19091844  void *tsd = (void *)tsd_get(lisp_global(TCR_KEY));
     
    19491884      current->vs_area->active -= node_size;
    19501885    }
    1951     current->shutdown_count = 1;
     1886    TCR_AUX(current)->shutdown_count = 1;
    19521887    ((void (*)())ptr_from_lispobj(callback_ptr))(0);
    19531888
     
    20081943suspend_tcr(TCR *tcr)
    20091944{
    2010   int suspend_count = atomic_incf(&(tcr->suspend_count));
     1945  int suspend_count = atomic_incf(&(TCR_AUX(tcr)->suspend_count));
    20111946  DWORD rc;
    20121947  if (suspend_count == 1) {
    2013     CONTEXT  *pcontext = (CONTEXT *)tcr->native_thread_info;
    2014     HANDLE hthread = (HANDLE)(tcr->osid);
     1948    CONTEXT  *pcontext = (CONTEXT *)TCR_AUX(tcr)->native_thread_info;
     1949    HANDLE hthread = (HANDLE)(TCR_AUX(tcr)->osid);
    20151950    pc where;
    2016     area *cs = tcr->cs_area;
     1951    area *cs = TCR_AUX(tcr)->cs_area;
    20171952    LispObj foreign_rsp;
    20181953
     
    20652000          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
    20662001          ResumeThread(hthread);
    2067           SEM_WAIT_FOREVER(tcr->suspend);
     2002          SEM_WAIT_FOREVER(TCR_AUX(tcr)->suspend);
    20682003          SuspendThread(hthread);
    20692004          /* The thread is either waiting for its resume semaphore to
    20702005             be signaled or is about to wait.  Signal it now, while
    20712006             the thread's suspended. */
    2072           SEM_RAISE(tcr->resume);
     2007          SEM_RAISE(TCR_AUX(tcr)->resume);
    20732008          pcontext->ContextFlags = CONTEXT_ALL;
    20742009          GetThreadContext(hthread, pcontext);
     
    20872022#endif
    20882023    }
    2089     tcr->suspend_context = pcontext;
     2024    TCR_AUX(tcr)->suspend_context = pcontext;
    20902025    return true;
    20912026  }
     
    21462081  LOCK(lisp_global(TCR_AREA_LOCK),current);
    21472082  {
    2148     LispObj osid = tcr->osid;
     2083    LispObj osid = TCR_AUX(tcr)->osid;
    21492084   
    21502085    if (osid) {
     
    21542089         forcing the thread to run quit_handler().  For now,
    21552090         mark the TCR as dead and kill the Windows thread. */
    2156       tcr->osid = 0;
     2091      /* xxx TerminateThread() bad */
     2092      TCR_AUX(tcr)->osid = 0;
    21572093      if (!TerminateThread((HANDLE)osid, 0)) {
    21582094        CloseHandle((HANDLE)osid);
     
    21922128resume_tcr(TCR *tcr)
    21932129{
    2194   int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
     2130  int suspend_count = atomic_decf(&(TCR_AUX(tcr)->suspend_count)), err;
    21952131  DWORD rc;
    21962132  if (suspend_count == 0) {
    2197     CONTEXT *context = tcr->suspend_context;
    2198     HANDLE hthread = (HANDLE)(tcr->osid);
     2133    CONTEXT *context = TCR_AUX(tcr)->suspend_context;
     2134    HANDLE hthread = (HANDLE)(TCR_AUX(tcr)->osid);
    21992135
    22002136    if (context) {
    22012137      context->ContextFlags = CONTEXT_ALL;
    2202       tcr->suspend_context = NULL;
     2138      TCR_AUX(tcr)->suspend_context = NULL;
    22032139      SetThreadContext(hthread,context);
    22042140      rc = ResumeThread(hthread);
     
    22502186{
    22512187#ifndef HAVE_TLS
    2252   tcr->next = freed_tcrs;
     2188  TCR_AUX(tcr)->next = freed_tcrs;
    22532189  freed_tcrs = tcr;
    22542190#endif
     
    22782214#endif
    22792215
    2280   a = tcr->cs_area;
     2216  a = TCR_AUX(tcr)->cs_area;
    22812217  if (a) {
    22822218    a->active = a->high;
     
    22902226
    22912227  for (current = freed_tcrs; current; current = next) {
    2292     next = current->next;
     2228    next = TCR_AUX(current)->next;
    22932229#ifndef HAVE_TLS
    2294 #ifdef WIN32
    2295     free(current->allocated);
     2230#ifdef WIN_32
     2231    /* We sort of have TLS in that the TEB is per-thread.  We free the
     2232     * tcr aux vector elsewhere. */
    22962233#else
    22972234    free(current);
     
    23102247
    23112248  LOCK(lisp_global(TCR_AREA_LOCK), current);
    2312   for (other = current->next; other != current; other = other->next) {
    2313     if ((other->osid != 0)) {
     2249  for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2250    if ((TCR_AUX(other)->osid != 0)) {
    23142251      suspend_tcr(other);
    2315       if (other->osid == 0) {
     2252      if (TCR_AUX(other)->osid == 0) {
    23162253        dead_tcr_count++;
    23172254      }
     
    23232260  do {
    23242261    all_acked = true;
    2325     for (other = current->next; other != current; other = other->next) {
    2326       if ((other->osid != 0)) {
     2262    for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2263      if ((TCR_AUX(other)->osid != 0)) {
    23272264        if (!tcr_suspend_ack(other)) {
    23282265          all_acked = false;
     
    23362273  /* All other threads are suspended; can safely delete dead tcrs now */
    23372274  if (dead_tcr_count) {
    2338     for (other = current->next; other != current; other = next) {
    2339       next = other->next;
    2340       if ((other->osid == 0))  {
     2275    for (other = TCR_AUX(current)->next; other != current; other = next) {
     2276      next = TCR_AUX(other)->next;
     2277      if ((TCR_AUX(other)->osid == 0))  {
    23412278        normalize_dead_tcr_areas(other);
    23422279        dequeue_tcr(other);
     
    23572294{
    23582295  TCR *current = get_tcr(true), *other;
    2359   for (other = current->next; other != current; other = other->next) {
    2360     if ((other->osid != 0)) {
     2296  for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2297    if ((TCR_AUX(other)->osid != 0)) {
    23612298      resume_tcr(other);
    23622299    }
  • trunk/source/lisp-kernel/threads.h

    r14295 r14619  
    108108#define RELEASE_SPINLOCK(x) (x)=0
    109109
     110#ifdef WIN_32
     111#define TCR_TO_TSD(tcr) ((void *)((natural)(tcr)))
     112#define TCR_FROM_TSD(tsd) ((TCR *)((natural)(tsd)))
     113#else
    110114#define TCR_TO_TSD(tcr) ((void *)((natural)(tcr)+TCR_BIAS))
    111115#define TCR_FROM_TSD(tsd) ((TCR *)((natural)(tsd)-TCR_BIAS))
     116#endif
    112117
    113118#ifdef USE_WINDOWS_SEMAPHORES
  • trunk/source/lisp-kernel/win32/Makefile

    r14391 r14619  
    2323LD = ld
    2424ASFLAGS = -g --32
    25 M4FLAGS = -DWIN_32 -DWINDOWS -DX86 -DX8632 -DWIN32_ES_HACK
    26 CDEFINES = -DWIN_32 -DWINDOWS -D_REENTRANT -DX86 -DX8632 -D_GNU_SOURCE  -D__MSVCRT__ -D__MSVCRT_VERSION__=0x700 -D_WIN32_WINNT=0x0502 -DWIN32_ES_HACK -DSVN_REVISION=$(SVN_REVISION)
     25M4FLAGS = -DWIN_32 -DWINDOWS -DX86 -DX8632
     26CDEFINES = -DWIN_32 -DWINDOWS -D_REENTRANT -DX86 -DX8632 -D_GNU_SOURCE  -D__MSVCRT__ -D__MSVCRT_VERSION__=0x700 -D_WIN32_WINNT=0x0502 -DSVN_REVISION=$(SVN_REVISION)
    2727CDEBUG = -g
    28 COPT = -O2
     28COPT = -O
    2929# Once in a while, -Wformat says something useful.  The odds are against that,
    3030# however.
  • trunk/source/lisp-kernel/windows-calls.c

    r14583 r14619  
    309309  pending.h = hfile;
    310310  pending.o = &overlapped;
    311   tcr->pending_io_info = &pending;
    312   hevent = (HANDLE)(tcr->io_datum);
     311  TCR_AUX(tcr)->pending_io_info = &pending;
     312  hevent = (HANDLE)(TCR_AUX(tcr)->io_datum);
    313313  overlapped.hEvent = hevent;
    314314  ResetEvent(hevent);
    315315  if (ReadFile(hfile, buf, count, &nread, &overlapped)) {
    316     tcr->pending_io_info = NULL;
     316    TCR_AUX(tcr)->pending_io_info = NULL;
    317317    return nread;
    318318  }
     
    321321 
    322322  if (err == ERROR_HANDLE_EOF) {
    323     tcr->pending_io_info = NULL;
     323    TCR_AUX(tcr)->pending_io_info = NULL;
    324324    return 0;
    325325  }
     
    327327  if (err != ERROR_IO_PENDING) {
    328328    _dosmaperr(err);
    329     tcr->pending_io_info = NULL;
     329    TCR_AUX(tcr)->pending_io_info = NULL;
    330330    return -1;
    331331  }
     
    338338
    339339
    340   tcr->pending_io_info = NULL;
     340  TCR_AUX(tcr)->pending_io_info = NULL;
    341341  if (wait_result == WAIT_OBJECT_0) {
    342342    err = overlapped.Internal;
     
    464464  TCR *tcr = (TCR *)get_tcr(1);
    465465
    466   hevent = (HANDLE)tcr->io_datum;
     466  hevent = (HANDLE)TCR_AUX(tcr)->io_datum;
    467467  if (hfile == (HANDLE)1) {
    468468    hfile = GetStdHandle(STD_OUTPUT_HANDLE);
     
    481481  pending.h = hfile;
    482482  pending.o = &overlapped;
    483   tcr->pending_io_info = &pending;
     483  TCR_AUX(tcr)->pending_io_info = &pending;
    484484  overlapped.hEvent = hevent;
    485485  ResetEvent(hevent);
    486486  if (WriteFile(hfile, buf, count, &nwritten, &overlapped)) {
    487     tcr->pending_io_info = NULL;
     487    TCR_AUX(tcr)->pending_io_info = NULL;
    488488    return nwritten;
    489489  }
     
    492492  if (err != ERROR_IO_PENDING) {
    493493    _dosmaperr(err);
    494     tcr->pending_io_info = NULL;
     494    TCR_AUX(tcr)->pending_io_info = NULL;
    495495    return -1;
    496496  }
    497497  err = 0;
    498498  wait_result = WaitForSingleObjectEx(hevent, INFINITE, true);
    499   tcr->pending_io_info = NULL;
     499  TCR_AUX(tcr)->pending_io_info = NULL;
    500500  if (wait_result == WAIT_OBJECT_0) {
    501501    err = overlapped.Internal;
     
    996996init_windows_io()
    997997{
    998 #ifdef WIN_32
    999   extern void init_win32_ldt(void);
    1000   init_win32_ldt();
    1001 #endif
    1002998  find_symbol_lock = CreateMutex(NULL,false,NULL);
    1003999}
     
    10121008
    10131009/*
    1014  * Reserve TLS slots 32 through 63 in the TEB for (part of) the TCR.
     1010 * Reserve TLS slots 30 through 63 in the TEB for (part of) the TCR.
    10151011 *
    10161012 * On Windows 7 x64, #_TlsAlloc returns 23 in a fresh lisp.  On
    10171013 * Windows XP, it returns 11.  With any luck, this will leave enough
    10181014 * wiggle room for the C runtime or whatever to use a few more TLS
    1019  * slots, and still leave 32 through 63 free for us.
     1015 * slots, and still leave 30 through 63 free for us.
    10201016 */
    10211017void
     
    10251021
    10261022  first_available = TlsAlloc();
    1027   if (first_available > 32) {
     1023  if (first_available > 30) {
    10281024    fprintf(dbgout, "Can't allocate required TLS indexes.\n");
    10291025    fprintf(dbgout, "First available index value was %u\n", first_available);
     
    10321028  TlsFree(first_available);
    10331029
    1034   for (i = first_available; i < 32; i++) {
     1030  for (i = first_available; i < 30; i++) {
    10351031    n = TlsAlloc();
    10361032    if (n != i) {
     
    10391035    }
    10401036  }
    1041   for (i = 32; i < 64; i++) {
     1037  for (i = 30; i < 64; i++) {
    10421038    n = TlsAlloc();
    10431039    if (n != i) {
     
    10461042    }
    10471043  }
    1048   for (i = first_available; i < 32; i++)
     1044  for (i = first_available; i < 30; i++)
    10491045    TlsFree(i);
    10501046}
  • trunk/source/lisp-kernel/x86-asmutils32.s

    r13337 r14619  
    203203        __(movl 12(%esp),%edx)  /* old valence */
    204204        __(movl 8(%esp),%eax)   /* tcr */
    205         __(movw tcr.ldt_selector(%eax), %rcontext_reg)
    206205        __(movl %edx,rcontext(tcr.valence))
    207206        __(movl $0,rcontext(tcr.pending_exception_context))
     
    260259        .text
    261260       
    262         __ifdef(`WIN32_ES_HACK')
    263261/* Something that we shouldn't return to */
    264262_exportfn(C(windows_halt))
    265263        __(hlt)
    266264_endfn         
    267         __endif
     265
    268266_exportfn(C(ensure_safe_for_string_operations))
    269267        __ifdef(`WIN32_ES_HACK')
  • trunk/source/lisp-kernel/x86-constants32.h

    r14295 r14619  
    290290#endif
    291291
    292 #define TCR_BIAS 0
    293 
    294292/*
    295293 * bits correspond to reg encoding used in instructions
     
    299297
    300298#define X8632_DEFAULT_NODE_REGS_MASK 0xce
     299
     300#ifdef WIN_32
     301/* TCR is in the last 34 words of NtCurrentTeb()->TlsSlots[] */
     302#define TCR_BIAS (0xe10 + 30 * sizeof(natural))
     303
     304typedef struct tcr {
     305  struct tcr *linear;
     306  struct tcr_aux *aux;
     307  signed_natural valence;       /* odd when in foreign code */
     308  natural node_regs_mask;       /* bit set means register contains node */
     309  char *save_allocbase;
     310  char *save_allocptr;
     311  char *last_allocptr;
     312  LispObj catch_top;            /* top catch frame */
     313  special_binding *db_link;     /* special binding chain head */
     314  natural tlb_limit;
     315  LispObj *tlb_pointer;
     316  LispObj ffi_exception;        /* fpscr bits from ff-call */
     317  LispObj *foreign_sp;
     318  signed_natural interrupt_pending;     /* pending interrupt flag */
     319  LispObj next_method_context;  /* used in lieu of register */
     320  LispObj *next_tsp;
     321  void *safe_ref_address;
     322  LispObj *save_tsp;            /* TSP when in foreign code */
     323  LispObj *save_vsp;            /* VSP when in foreign code */
     324  LispObj *save_fp;             /* EBP when in foreign code */
     325  struct area *ts_area;         /* tstack area pointer */
     326  struct area *vs_area;         /* vstack area pointer */
     327  xframe_list *xframe;          /* exception-frame linked list */
     328  signed_natural unwinding;
     329  natural flags;
     330  natural foreign_mxcsr;
     331  natural lisp_mxcsr;
     332  ExceptionInformation *pending_exception_context;
     333  natural unboxed0;             /* unboxed scratch locations */
     334  natural unboxed1;
     335  LispObj save0;                /* spill area for node registers: */
     336  LispObj save1;                /*  it must be 16-byte aligned */
     337  LispObj save2;
     338  LispObj save3;
     339} TCR;
     340
     341struct tcr_aux {
     342  unsigned long long bytes_allocated;
     343  struct area *cs_area;         /* cstack area pointer */
     344  LispObj cs_limit;             /* stack overflow limit */
     345  natural log2_allocation_quantum;      /* for per-thread consing */
     346  int *errno_loc;               /* per-thread (?) errno location */
     347  LispObj osid;                 /* OS thread id */
     348  signed_natural foreign_exception_status; /* non-zero -> call lisp_exit_hook */
     349  void *native_thread_info;     /* platform-dependent */
     350  void *native_thread_id;       /* mach_thread_t, pid_t, etc. */
     351  void *reset_completion;
     352  void *activate;
     353  ExceptionInformation *gc_context;
     354  void *termination_semaphore;
     355  natural shutdown_count;
     356  natural save_eflags;
     357  sel_t ldt_selector;
     358  signed_natural suspend_count;
     359  ExceptionInformation *suspend_context;
     360  void *suspend;                /* suspension semaphore */
     361  void *resume;                 /* resumption semaphore */
     362  void *allocated;
     363  void *pending_io_info;
     364  void *io_datum;
     365  struct tcr *next;
     366  struct tcr *prev;
     367};
     368#else
     369#define TCR_BIAS 0
    301370
    302371typedef struct tcr {
     
    363432  void *io_datum;
    364433} TCR;
     434#endif
     435
     436/* expansion of "TCR_AUX(tcr)": TCR_AUX(tcr) */
    365437
    366438#define nil_value ((0x13000 + (fulltag_cons))+(LOWMEM_BIAS))
  • trunk/source/lisp-kernel/x86-constants32.s

    r13952 r14619  
    4747define(`rcontext_reg',`fs')
    4848       
    49         ifdef(`WINDOWS',`
    50 undefine(`rcontext_reg')       
    51 define(`rcontext_reg',`es')
    52         ')
    53                
    5449define(`rcontext',`%rcontext_reg:$1')
    5550
     
    485480        _ends
    486481
     482ifdef(`WIN_32',`
     483TCR_BIAS = 0xe10 + (4 * 30)     /* last 34 words of TlsSlots */
     484',`
    487485TCR_BIAS = 0
    488                
     486')
     487
     488ifdef(`WIN_32',`
     489        _struct(tcr,TCR_BIAS)
     490         _node(linear)          /* our linear (non-segment-based) address. */
     491         _word(aux)             /* pointer to tcr_aux struct, see below */
     492         _node(valence)         /* odd when in foreign code */
     493         _word(node_regs_mask)
     494         _node(save_allocbase)
     495         _node(save_allocptr)
     496         _node(last_allocptr)
     497         _node(catch_top)       /* top catch frame */
     498         _node(db_link)         /* special binding chain head */
     499         _node(tlb_limit)
     500         _node(tlb_pointer)     /* Consider using tcr+N as tlb_pointer */
     501         _node(ffi_exception)   /* mxcsr exception bits from ff-call */
     502         _node(foreign_sp)      /* Saved foreign SP when in lisp code */
     503         _node(interrupt_pending)
     504         _node(next_method_context)
     505         _node(next_tsp)
     506         _node(safe_ref_address)
     507         _node(save_tsp)        /* TSP when in foreign code */
     508         _node(save_vsp)        /* VSP when in foreign code */
     509         _node(save_ebp)        /* lisp EBP when in foreign code */
     510         _node(ts_area)         /* tstack area pointer */
     511         _node(vs_area)         /* vstack area pointer */
     512         _node(xframe)          /* per-thread exception frame list */
     513         _node(unwinding)
     514         _node(flags)     
     515         _node(foreign_mxcsr)
     516         _word(lisp_mxcsr)
     517         _word(pending_exception_context)
     518         _word(unboxed0)
     519         _word(unboxed1)
     520         _node(save0)           /* spill area for node registers... */
     521         _node(save1)           /* ...must be 16-byte aligned */
     522         _node(save2)
     523         _node(save3)
     524        _ends
     525
     526        _struct(tcr_aux,0)
     527         _word(bytes_allocated)
     528         _word(bytes_allocated_high)
     529         _node(cs_area)         /* cstack area pointer */
     530         _node(cs_limit)        /* cstack overflow limit */
     531         _node(log2_allocation_quantum)
     532         _node(errno_loc)       /* per-thread  errno location */
     533         _node(osid)            /* OS thread id */
     534         _node(foreign_exception_status)
     535         _node(native_thread_info)
     536         _node(native_thread_id)
     537         _node(reset_completion)
     538         _node(activate)
     539         _node(gc_context)
     540         _node(termination_semaphore)
     541         _node(shutdown_count)
     542         _node(suspend_count)
     543         _node(suspend_context)
     544         _node(suspend)         /* semaphore for suspension notify */
     545         _node(resume)          /* sempahore for resumption notify */
     546         _word(allocated)
     547         _word(pending_io_info)
     548         _word(io_datum)
     549         _node(next)            /* in doubly-linked list */
     550         _node(prev)            /* in doubly-linked list */
     551        _ends
     552',`
    489553/*  Thread context record.  */
    490554
     
    551615         _word(io_datum)
    552616        _ends
     617')
    553618
    554619        _struct(win32_context,0)
  • trunk/source/lisp-kernel/x86-exceptions.c

    r14602 r14619  
    6262update_bytes_allocated(TCR* tcr, void *cur_allocptr)
    6363{
    64   BytePtr
    65     last = (BytePtr) tcr->last_allocptr,
    66     current = (BytePtr) cur_allocptr;
     64  char *last = tcr->last_allocptr;
     65  char *current = cur_allocptr;
     66  u64_t *bytes_allocated = (u64_t *)&TCR_AUX(tcr)->bytes_allocated;
     67
    6768  if (last && (tcr->save_allocbase != ((void *)VOID_ALLOCPTR))) {
    68     tcr->bytes_allocated += last-current;
     69    *bytes_allocated += last - current;
    6970  }
    7071  tcr->last_allocptr = 0;
     
    8485  area *a;
    8586  natural newlimit, oldlimit;
    86   natural log2_allocation_quantum = tcr->log2_allocation_quantum;
     87  natural log2_allocation_quantum = TCR_AUX(tcr)->log2_allocation_quantum;
    8788
    8889  if (crossed_threshold) {
     
    13051306  if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_SUSPEND)) {
    13061307    CLR_TCR_FLAG(tcr, TCR_FLAG_BIT_PENDING_SUSPEND);
    1307     SEM_RAISE(tcr->suspend);
    1308     SEM_WAIT_FOREVER(tcr->resume);
     1308    SEM_RAISE(TCR_AUX(tcr)->suspend);
     1309    SEM_WAIT_FOREVER(TCR_AUX(tcr)->resume);
    13091310  }
    13101311#else
     
    15291530    xp = tcr->pending_exception_context;
    15301531  else if (tcr->valence == TCR_STATE_LISP) {
    1531     xp = tcr->suspend_context;
     1532    xp = TCR_AUX(tcr)->suspend_context;
    15321533  } else {
    15331534    xp = NULL;
     
    20182019  context->Esp = (DWORD)p;
    20192020  context->Eip = (DWORD)handler;
    2020 #ifdef WIN32_ES_HACK
    2021   context->SegEs = context->SegDs;
    2022 #endif
    20232021#endif
    20242022  context->EFlags &= ~0x400;  /* clear direction flag */
     
    20622060  } else {
    20632061    TCR *tcr = get_interrupt_tcr(false);
    2064     area *cs = tcr->cs_area;
     2062    area *cs = TCR_AUX(tcr)->cs_area;
    20652063    BytePtr current_sp = (BytePtr) current_stack_pointer();
    20662064    CONTEXT *context = exception_pointers->ContextRecord;
     
    21982196      a->active = a->high;
    21992197    }
    2200     a = tcr->cs_area;
     2198    a = TCR_AUX(tcr)->cs_area;
    22012199    if (a) {
    22022200      a->active = a->high;
     
    24712469   account for this extra byte when adjusting the PC */
    24722470#define LISP_ASSEMBLER_EXTRA_SIB_BYTE
    2473 #ifdef WIN32_ES_HACK
    2474 /* Win32 keeps the TCR in %es */
    2475 #define TCR_SEG_PREFIX 0x26     /* %es: */
    2476 #else
    2477 /* Other platfroms use %fs */
    2478 #define TCR_SEG_PREFIX 0x64     /* %fs: */
    2479 #endif
     2471#define TCR_SEG_PREFIX 0x64
     2472
     2473#ifdef WIN_32
     2474#define SAVE_ALLOCPTR 0x9c,0x0e,0x0,0x0
     2475#define SAVE_ALLOCBASE 0x98,0x0e,0x0,0x0
     2476#else
     2477#define SAVE_ALLOCPTR 0x84,0x0,0x0,0x0
     2478#define SAVE_ALLOCBASE 0x88,0x0,0x0,0x0
     2479#endif
     2480
    24802481opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
    2481   {TCR_SEG_PREFIX,0x8b,0x0d,0x84,0x00,0x00,0x00};  /* may have extra SIB byte */
     2482  {TCR_SEG_PREFIX,0x8b,0x0d,SAVE_ALLOCPTR};  /* may have extra SIB byte */
    24822483opcode compare_allocptr_reg_to_tcr_save_allocbase_instruction[] =
    2483   {TCR_SEG_PREFIX,0x3b,0x0d,0x88,0x00,0x00,0x00};  /* may have extra SIB byte */
     2484  {TCR_SEG_PREFIX,0x3b,0x0d,SAVE_ALLOCBASE};  /* may have extra SIB byte */
    24842485opcode branch_around_alloc_trap_instruction[] =
    24852486  {0x77,0x02};                  /* no SIB byte issue */
     
    24872488  {0xcd,0xc5};                  /* no SIB byte issue */
    24882489opcode clear_tcr_save_allocptr_tag_instruction[] =
    2489   {TCR_SEG_PREFIX,0x80,0x25,0x84,0x00,0x00,0x00,0xf8}; /* maybe SIB byte */
     2490  {TCR_SEG_PREFIX,0x80,0x25,SAVE_ALLOCPTR,0xf8}; /* maybe SIB byte */
    24902491opcode set_allocptr_header_instruction[] =
    24912492  {0x0f,0x7e,0x41,0xfa};        /* no SIB byte issue */
     
    25002501  case 0x77: return ID_branch_around_alloc_trap_instruction;
    25012502  case 0x0f: return ID_set_allocptr_header_instruction;
    2502   case TCR_SEG_PREFIX:
     2503  case 0x64:
    25032504    switch(program_counter[1]) {
    25042505    case 0x80: return ID_clear_tcr_save_allocptr_tag_instruction;
     
    28442845
    28452846
    2846   for (other_tcr = tcr->next; other_tcr != tcr; other_tcr = other_tcr->next) {
     2847  for (other_tcr = TCR_AUX(tcr)->next; other_tcr != tcr;
     2848       other_tcr = TCR_AUX(other_tcr)->next) {
    28472849    if (other_tcr->pending_exception_context) {
    2848       other_tcr->gc_context = other_tcr->pending_exception_context;
     2850      TCR_AUX(other_tcr)->gc_context = other_tcr->pending_exception_context;
    28492851    } else if (other_tcr->valence == TCR_STATE_LISP) {
    2850       other_tcr->gc_context = other_tcr->suspend_context;
     2852      TCR_AUX(other_tcr)->gc_context = TCR_AUX(other_tcr)->suspend_context;
    28512853    } else {
    28522854      /* no pending exception, didn't suspend in lisp state:
    28532855         must have executed a synchronous ff-call.
    28542856      */
    2855       other_tcr->gc_context = NULL;
    2856     }
    2857     normalize_tcr(other_tcr->gc_context, other_tcr, true);
     2857      TCR_AUX(other_tcr)->gc_context = NULL;
     2858    }
     2859    normalize_tcr(TCR_AUX(other_tcr)->gc_context, other_tcr, true);
    28582860  }
    28592861   
     
    28642866  other_tcr = tcr;
    28652867  do {
    2866     other_tcr->gc_context = NULL;
    2867     other_tcr = other_tcr->next;
     2868    TCR_AUX(other_tcr)->gc_context = NULL;
     2869    other_tcr = TCR_AUX(other_tcr)->next;
    28682870  } while (other_tcr != tcr);
    28692871
  • trunk/source/lisp-kernel/x86-gc.c

    r14464 r14619  
    297297
    298298  do {
    299     xp = tcr->gc_context;
     299    xp = TCR_AUX(tcr)->gc_context;
    300300    if (xp) {
    301301#ifdef X8632
     
    326326      check_range(tlb_start,tlb_end,false);
    327327    }
    328     tcr = tcr->next;
     328    tcr = TCR_AUX(tcr)->next;
    329329  } while (tcr != first);
    330330}
     
    19291929  ExceptionInformation *xp;
    19301930
    1931   xp = tcr->gc_context;
     1931  xp = TCR_AUX(tcr)->gc_context;
    19321932  if (xp) {
    19331933#ifdef X8664
     
    26762676  ExceptionInformation *xp;
    26772677 
    2678   xp = tcr->gc_context;
     2678  xp = TCR_AUX(tcr)->gc_context;
    26792679  if (xp) {
    26802680#ifdef X8632
     
    28382838      purify_tcr_xframes(other_tcr, low, high, pure_area, flags);
    28392839      purify_tcr_tlb(other_tcr, low, high, pure_area, flags);
    2840       other_tcr = other_tcr->next;
     2840      other_tcr = TCR_AUX(other_tcr)->next;
    28412841    } while (other_tcr != tcr);
    28422842
     
    28762876        purify_tcr_xframes(other_tcr, low, high, NULL, PURIFY_NOTHING);
    28772877        purify_tcr_tlb(other_tcr, low, high, NULL, PURIFY_NOTHING);
    2878         other_tcr = other_tcr->next;
     2878        other_tcr = TCR_AUX(other_tcr)->next;
    28792879      } while (other_tcr != tcr);
    28802880     
     
    31043104  ExceptionInformation *xp;
    31053105 
    3106   xp = tcr->gc_context;
     3106  xp = TCR_AUX(tcr)->gc_context;
    31073107  if (xp) {
    31083108#ifdef X8632
     
    32243224    impurify_tcr_xframes(other_tcr, ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
    32253225    impurify_tcr_tlb(other_tcr, ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
    3226     other_tcr = other_tcr->next;
     3226    other_tcr = TCR_AUX(other_tcr)->next;
    32273227  } while (other_tcr != tcr);
    32283228 
     
    33983398  ExceptionInformation *xp;
    33993399
    3400   xp = tcr->gc_context;
     3400  xp = TCR_AUX(tcr)->gc_context;
    34013401  if (xp) {
    34023402#ifdef X8664
     
    34883488    wp_update_tcr_xframes(other_tcr, old, new);
    34893489    wp_update_tcr_tlb(other_tcr, old, new);
    3490     other_tcr = other_tcr->next;
     3490    other_tcr = TCR_AUX(other_tcr)->next;
    34913491  } while (other_tcr != tcr);
    34923492  unprotect_watched_areas();
  • trunk/source/lisp-kernel/x86-spentry32.s

    r14597 r14619  
    43444344        __(addl $16,%esp)               /* discard arg, alignment words */
    43454345        /* linear TCR addr now in %eax */
     4346        ifdef(`WINDOWS',`
     4347        ',`
    43464348        __(movw tcr.ldt_selector(%eax), %rcontext_reg)
     4349        ')
    434743500:     
    43484351
  • trunk/source/lisp-kernel/x86-subprims32.s

    r13337 r14619  
    7777        __(cmpb $0,C(rcontext_readonly))
    7878        __(jne 0f)
     79ifdef(`WIN_32',`
     80',`
    7981        __(movw tcr.ldt_selector(%ebx), %rcontext_reg)
     82')
    80830:             
    8184        __(movl 8(%ebp),%eax)
  • trunk/source/lisp-kernel/xlbt.c

    r14484 r14619  
    146146
    147147  vs_area = tcr->vs_area;
    148   cs_area = tcr->cs_area;
     148  cs_area = TCR_AUX(tcr)->cs_area;
    149149  if ((((LispObj) ptr_to_lispobj(vs_area->low)) > current_fp) ||
    150150      (((LispObj) ptr_to_lispobj(vs_area->high)) < current_fp)) {
     
    155155    Dprintf("\nFrame pointer [#x" LISP "] in unknown area.", current_fp);
    156156  } else {
    157     fprintf(dbgout, "current thread: tcr = 0x" LISP ", native thread ID = 0x" LISP ", interrupts %s\n", tcr, tcr->native_thread_id, ilevel);
     157    fprintf(dbgout, "current thread: tcr = 0x" LISP ", native thread ID = 0x" LISP ", interrupts %s\n", tcr, TCR_AUX(tcr)->native_thread_id, ilevel);
    158158
    159159#ifndef WINDOWS
  • trunk/source/xdump/xfasload.lisp

    r14119 r14619  
    10841084    (xload-set '%all-packages% (xload-save-list (mapcar #'cdr *xload-aliased-package-addresses*)))
    10851085    (xload-set '%unbound-function% (%xload-unbound-function%))
    1086     (xload-set '*gc-event-status-bits* (xload-integer 0 #|(ash 1 $gc-integrity-check-bit)|#))
     1086    (xload-set '*gc-event-status-bits*
     1087               (xload-integer 0 (logior (ash 1 $gc-integrity-check-bit)
     1088                                        (ash 1 $egc-verbose-bit)
     1089                                        (ash 1 $gc-verbose-bit))))
    10871090    (xload-set '%toplevel-catch% (xload-copy-symbol :toplevel))
    10881091    (if *xload-target-use-code-vectors*
     
    18051808  (let* ((imm-word-count (xload-u16-at-address
    18061809                          (+ addr *xload-target-misc-data-offset*))))
     1810    (when (logbitp 15 imm-word-count)
     1811      (let* ((header (xload-natural-at-address
     1812                      (+ addr *xload-target-misc-header-offset*)))
     1813             (len (ash header (- target::num-subtag-bits))))
     1814        (setq imm-word-count (- len (ldb (byte 15 0) imm-word-count)))))
    18071815    (do* ((i (- imm-word-count 2) (1- i))
    18081816          (offset (xload-%fullword-ref addr i) (xload-%fullword-ref addr i)))
Note: See TracChangeset for help on using the changeset viewer.