Changeset 14606 for branches


Ignore:
Timestamp:
Jan 27, 2011, 8:56:05 PM (9 years ago)
Author:
rme
Message:

Checkpoint of work in progress.

Location:
branches/shrink-tcr
Files:
31 edited

Legend:

Unmodified
Added
Removed
  • branches/shrink-tcr/compiler/X86/X8632/x8632-arch.lisp

    r13971 r14606  
    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
  • branches/shrink-tcr/compiler/X86/X8632/x8632-backend.lisp

    r13067 r14606  
    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                ))
  • branches/shrink-tcr/compiler/X86/x86-asm.lisp

    r13411 r14606  
    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*))
  • branches/shrink-tcr/compiler/X86/x86-lap.lisp

    r14258 r14606  
    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))
  • branches/shrink-tcr/level-0/X86/X8632/x8632-misc.lisp

    r13365 r14606  
    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
  • branches/shrink-tcr/level-0/X86/x86-io.lisp

    r13067 r14606  
    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)))
  • branches/shrink-tcr/level-0/l0-misc.lisp

    r14541 r14606  
    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))
     278        (multiple-value-bind (cf cu) (free-and-used cs-area)
    273279          (multiple-value-bind (vf vu) (free-and-used (%fixnum-ref tcr target::tcr.vs-area))
    274280            #+arm-target
  • branches/shrink-tcr/level-0/nfasload.lisp

    r14046 r14606  
    415415    (%epushval s (svref (faslstate.faslevec s) idx))))
    416416
     417(defun decode-imm-word-count (imm-word-count element-count)
     418  (if (logbitp 15 imm-word-count)
     419    (- element-count (ldb (byte 15 0) imm-word-count))
     420    imm-word-count))
     421
    417422#+x86-target
    418423;;; Read a "concatenated" lisp function, in which the machine code
     
    425430    (declare (fixnum size-in-elements size-of-code))
    426431    (%epushval s function)
     432    #+x8632-target
     433    (setq size-of-code (decode-imm-word-count size-of-code size-in-elements))
    427434    (%fasl-read-n-bytes s vector 0 (ash size-of-code target::word-shift))
    428435    #+x8632-target
    429436    (%update-self-references vector)
     437    #+x8632-target
     438    (let* ((addr (%address-of vector))
     439           (insn (%get-unsigned-long (%int-to-ptr addr))))
     440      (when (eql insn #xbf)
     441        (pdbg "update-self-references blew it")
     442        (dbg vector)))
    430443    (do* ((numconst (- size-in-elements size-of-code))
    431444          (i 0 (1+ i))
  • branches/shrink-tcr/level-1/l1-lisp-threads.lisp

    r14367 r14606  
    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* ())
  • branches/shrink-tcr/level-1/l1-processes.lisp

    r14362 r14606  
    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))))
  • branches/shrink-tcr/level-1/x86-threads-utils.lisp

    r13067 r14606  
    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
  • branches/shrink-tcr/lib/backtrace.lisp

    r14351 r14606  
    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                        )))
  • branches/shrink-tcr/lib/describe.lisp

    r14119 r14606  
    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
  • branches/shrink-tcr/lib/nfcomp.lisp

    r14351 r14606  
    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 (decode-imm-word-count encoded-imm-words function-size))
    17751776           (imm-bytes (ash imm-words 2))
    17761777           (other-words (- function-size imm-words)))
     
    17781779      (fasl-out-opcode $fasl-clfun f)
    17791780      (fasl-out-count function-size)
    1780       (fasl-out-count imm-words)
     1781      (fasl-out-count encoded-imm-words)
    17811782      (fasl-out-ivect code 0 imm-bytes)
    17821783      (do ((i 1 (1+ i))
  • branches/shrink-tcr/lisp-kernel/gc-common.c

    r14422 r14606  
    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
  • branches/shrink-tcr/lisp-kernel/lisp-debug.c

    r14484 r14606  
    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);
  • branches/shrink-tcr/lisp-kernel/macros.h

    r14119 r14606  
    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 __ */
  • branches/shrink-tcr/lisp-kernel/pmcl-kernel.c

    r14583 r14606  
    16611661
    16621662
    1663  
    16641663
    16651664
     
    19671966  lisp_global(STATICALLY_LINKED) = 1 << fixnumshift;
    19681967#endif
    1969   tcr->prev = tcr->next = tcr;
     1968  TCR_AUX(tcr)->prev = TCR_AUX(tcr)->next = tcr;
    19701969#ifndef WINDOWS
    19711970  lisp_global(INTERRUPT_SIGNAL) = (LispObj) box_fixnum(SIGNAL_FOR_PROCESS_INTERRUPT);
     
    24402439#endif
    24412440    allocate_static_conses(nconses);
    2442     tcr->bytes_allocated += nbytes;
     2441    TCR_AUX(tcr)->bytes_allocated += nbytes;
    24432442  }
    24442443#ifdef USE_GC_NOTIFICATION
  • branches/shrink-tcr/lisp-kernel/thread_manager.c

    r14328 r14606  
    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;
    78   area *cs = target->cs_area, *ts = target->cs_area;
     78  area *ts = target->ts_area;
    7979  DWORD rc;
    8080  BOOL io_pending;
     
    173173raise_thread_interrupt(TCR *target)
    174174{
    175   pthread_t thread = (pthread_t)target->osid;
     175  pthread_t thread = (pthread_t)TCR_AUX(target)->osid;
    176176#ifdef DARWIN_not_yet
    177177  if (use_mach_exception_handling) {
     
    534534
    535535  if (tcr) {
    536     current = tcr->osid;
     536    current = TCR_AUX(tcr)->osid;
    537537  }
    538538  if (current == 0) {
     
    545545                    DUPLICATE_SAME_ACCESS);
    546546    if (tcr) {
    547       tcr->osid = current;
     547      TCR_AUX(tcr)->osid = current;
    548548    }
    549549  }
     
    589589   
    590590    tcr = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
    591     tcr->suspend_count = 1;
     591    TCR_AUX(tcr)->suspend_count = 1;
    592592    tcr->vs_area->active -= node_size;
    593593    *(--tcr->save_vsp) = lisp_nil;
     
    597597    SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
    598598  } else {
    599     tcr->suspend_context = context;
    600     SEM_RAISE(tcr->suspend);
    601     SEM_WAIT_FOREVER(tcr->resume);
    602     tcr->suspend_context = NULL;
     599    TCR_AUX(tcr)->suspend_context = context;
     600    SEM_RAISE(TCR_AUX(tcr)->suspend);
     601    SEM_WAIT_FOREVER(TCR_AUX(tcr)->resume);
     602    TCR_AUX(tcr)->suspend_context = NULL;
    603603  }
    604604#ifdef DARWIN_GS_HACK
     
    776776  TCR *next, *prev;
    777777
    778   next = tcr->next;
    779   prev = tcr->prev;
    780 
    781   prev->next = next;
    782   next->prev = prev;
    783   tcr->prev = tcr->next = NULL;
     778  next = TCR_AUX(tcr)->next;
     779  prev = TCR_AUX(tcr)->prev;
     780
     781  TCR_AUX(prev)->next = next;
     782  TCR_AUX(next)->prev = prev;
     783  TCR_AUX(tcr)->prev = TCR_AUX(tcr)->next = NULL;
    784784#ifdef X8664
    785785  tcr->linear = NULL;
     
    794794  LOCK(lisp_global(TCR_AREA_LOCK),new);
    795795  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;
     796  tail = TCR_AUX(head)->prev;
     797  TCR_AUX(tail)->next = new;
     798  TCR_AUX(head)->prev = new;
     799  TCR_AUX(new)->prev = tail;
     800  TCR_AUX(new)->next = head;
    801801  UNLOCK(lisp_global(TCR_AREA_LOCK),new);
    802802}
     
    806806allocate_tcr()
    807807{
    808   void *p = calloc(1,sizeof(TCR)+15);
    809   TCR *tcr = (TCR *)((((natural)p)+15)&~15);
    810 
    811   tcr->allocated = p;
     808  void *p = calloc(1,sizeof(struct tcr_aux));
     809  char *teb = (char *)NtCurrentTeb();
     810  TCR *tcr = (TCR *)(teb + TCR_BIAS);
     811
     812  if (p == NULL)
     813    allocation_failure(true, sizeof(struct tcr_aux));
     814
     815  if ((intptr_t)p & 03) {
     816    fprintf(dbgout, "%p not aligned\n", p);
     817    exit(1);
     818  }
     819  memset(tcr, 0, sizeof(TCR));
     820  tcr->aux = p;
    812821  return tcr;
    813822}
     
    10631072setup_tcr_extra_segment(TCR *tcr)
    10641073{
    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);
    11241074}
    11251075
     
    11271077free_tcr_extra_segment(TCR *tcr)
    11281078{
    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;
    11471079}
    11481080
     
    13351267  tcr->single_float_convert.tag = subtag_single_float;
    13361268#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);
     1269  TCR_AUX(tcr)->suspend = new_semaphore(0);
     1270  TCR_AUX(tcr)->resume = new_semaphore(0);
     1271  TCR_AUX(tcr)->reset_completion = new_semaphore(0);
     1272  TCR_AUX(tcr)->activate = new_semaphore(0);
    13411273  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
    13421274  a = allocate_vstack_holding_area_lock(vstack_size);
     
    13861318  tcr->shutdown_count = PTHREAD_DESTRUCTOR_ITERATIONS;
    13871319#else
    1388   tcr->shutdown_count = 1;
     1320  TCR_AUX(tcr)->shutdown_count = 1;
    13891321#endif
    13901322  return tcr;
     
    14021334  }
    14031335
    1404   if (--(tcr->shutdown_count) == 0) {
     1336  if (--(TCR_AUX(tcr)->shutdown_count) == 0) {
    14051337    if (tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN)) {
    14061338      LispObj callback_macptr = nrs_FOREIGN_THREAD_CONTROL.vcell,
     
    14211353    tcr->ts_area = NULL;
    14221354#endif
    1423     cs = tcr->cs_area;
    1424     tcr->cs_area = NULL;
     1355    cs = TCR_AUX(tcr)->cs_area;
     1356    TCR_AUX(tcr)->cs_area = NULL;
    14251357    if (vs) {
    14261358      condemn_area_holding_area_lock(vs);
     
    14501382#endif
    14511383#endif
    1452     destroy_semaphore(&tcr->suspend);
    1453     destroy_semaphore(&tcr->resume);
    1454     destroy_semaphore(&tcr->reset_completion);
    1455     destroy_semaphore(&tcr->activate);
     1384    destroy_semaphore(&TCR_AUX(tcr)->suspend);
     1385    destroy_semaphore(&TCR_AUX(tcr)->resume);
     1386    destroy_semaphore(&TCR_AUX(tcr)->reset_completion);
     1387    destroy_semaphore(&TCR_AUX(tcr)->activate);
    14561388    tcr->tlb_limit = 0;
    14571389    free(tcr->tlb_pointer);
    14581390    tcr->tlb_pointer = NULL;
    14591391#ifdef WINDOWS
    1460     if (tcr->osid != 0) {
    1461       CloseHandle((HANDLE)(tcr->osid));
    1462     }
    1463 #endif
    1464     tcr->osid = 0;
     1392    if (TCR_AUX(tcr)->osid != 0) {
     1393      CloseHandle((HANDLE)(TCR_AUX(tcr)->osid));
     1394    }
     1395#endif
     1396    TCR_AUX(tcr)->osid = 0;
    14651397    tcr->interrupt_pending = 0;
    1466     tcr->termination_semaphore = NULL;
     1398    TCR_AUX(tcr)->termination_semaphore = NULL;
    14671399#ifdef HAVE_TLS
    14681400    dequeue_tcr(tcr);
     
    14721404#endif
    14731405#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;
     1406    CloseHandle((HANDLE)TCR_AUX(tcr)->io_datum);
     1407    TCR_AUX(tcr)->io_datum = NULL;
     1408    free(TCR_AUX(tcr)->native_thread_info);
     1409    TCR_AUX(tcr)->native_thread_info = NULL;
    14781410#endif
    14791411    UNLOCK(lisp_global(TCR_AREA_LOCK),current);
     
    14991431  }
    15001432#endif
    1501   a = tcr->cs_area;
     1433  a = TCR_AUX(tcr)->cs_area;
    15021434  if (a) {
    15031435    a->active = a->high;
    15041436  }
    15051437  tcr->valence = TCR_STATE_FOREIGN;
    1506   tcr->shutdown_count = 1;
     1438  TCR_AUX(tcr)->shutdown_count = 1;
    15071439  shutdown_thread_tcr(tcr);
    15081440  tsd_set(lisp_global(TCR_KEY), NULL);
     
    15411473  area *a, *register_cstack_holding_area_lock(BytePtr, natural);
    15421474
    1543   tcr->osid = current_thread_osid();
    1544   tcr->native_thread_id = current_native_thread_id();
     1475  TCR_AUX(tcr)->osid = current_thread_osid();
     1476  TCR_AUX(tcr)->native_thread_id = current_native_thread_id();
    15451477  LOCK(lisp_global(TCR_AREA_LOCK),tcr);
    15461478  a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size);
    15471479  UNLOCK(lisp_global(TCR_AREA_LOCK),tcr);
    1548   tcr->cs_area = a;
     1480  TCR_AUX(tcr)->cs_area = a;
    15491481  a->owner = tcr;
    15501482#ifdef ARM
     
    15521484#endif
    15531485  if (!(tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN))) {
    1554     tcr->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
     1486    TCR_AUX(tcr)->cs_limit = (LispObj)ptr_to_lispobj(a->softlimit);
    15551487  }
    15561488#ifdef LINUX
     
    15611493#endif
    15621494#endif
    1563   tcr->errno_loc = &errno;
     1495  TCR_AUX(tcr)->errno_loc = &errno;
    15641496  tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
    15651497#ifdef DARWIN
     
    15731505#endif
    15741506#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));
     1507  TCR_AUX(tcr)->io_datum = (VOID *)CreateEvent(NULL, true, false, NULL);
     1508  TCR_AUX(tcr)->native_thread_info = malloc(sizeof(CONTEXT));
     1509#endif
     1510  TCR_AUX(tcr)->log2_allocation_quantum = unbox_fixnum(lisp_global(DEFAULT_ALLOCATION_QUANTUM));
    15791511}
    15801512
     
    17031635  SEM_RAISE(activation->created);
    17041636  do {
    1705     SEM_RAISE(tcr->reset_completion);
    1706     SEM_WAIT_FOREVER(tcr->activate);
     1637    SEM_RAISE(TCR_AUX(tcr)->reset_completion);
     1638    SEM_WAIT_FOREVER(TCR_AUX(tcr)->activate);
    17071639    /* Now go run some lisp code */
    17081640    start_lisp(TCR_TO_TSD(tcr),0);
     
    17571689  start_vsp = tcr->save_vsp;
    17581690  do {
    1759     SEM_RAISE(tcr->reset_completion);
     1691    SEM_RAISE(TCR_AUX(tcr)->reset_completion);
    17601692    suspend_current_cooperative_thread();
    17611693     
     
    18031735      return true;
    18041736    }
    1805     p = p->next;
     1737    p = TCR_AUX(p)->next;
    18061738  } while (p != head);
    18071739  return false;
     
    19061838#ifdef HAVE_TLS
    19071839  TCR *current = current_tcr;
     1840#elif defined(WIN_32)
     1841  TCR *current = (TCR *)((char *)NtCurrentTeb() + TCR_BIAS);
    19081842#else
    19091843  void *tsd = (void *)tsd_get(lisp_global(TCR_KEY));
     
    19491883      current->vs_area->active -= node_size;
    19501884    }
    1951     current->shutdown_count = 1;
     1885    TCR_AUX(current)->shutdown_count = 1;
    19521886    ((void (*)())ptr_from_lispobj(callback_ptr))(0);
    19531887
     
    20081942suspend_tcr(TCR *tcr)
    20091943{
    2010   int suspend_count = atomic_incf(&(tcr->suspend_count));
     1944  int suspend_count = atomic_incf(&(TCR_AUX(tcr)->suspend_count));
    20111945  DWORD rc;
    20121946  if (suspend_count == 1) {
    2013     CONTEXT  *pcontext = (CONTEXT *)tcr->native_thread_info;
    2014     HANDLE hthread = (HANDLE)(tcr->osid);
     1947    CONTEXT  *pcontext = (CONTEXT *)TCR_AUX(tcr)->native_thread_info;
     1948    HANDLE hthread = (HANDLE)(TCR_AUX(tcr)->osid);
    20151949    pc where;
    2016     area *cs = tcr->cs_area;
     1950    area *cs = TCR_AUX(tcr)->cs_area;
    20171951    LispObj foreign_rsp;
    20181952
     
    20651999          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
    20662000          ResumeThread(hthread);
    2067           SEM_WAIT_FOREVER(tcr->suspend);
     2001          SEM_WAIT_FOREVER(TCR_AUX(tcr)->suspend);
    20682002          SuspendThread(hthread);
    20692003          /* The thread is either waiting for its resume semaphore to
    20702004             be signaled or is about to wait.  Signal it now, while
    20712005             the thread's suspended. */
    2072           SEM_RAISE(tcr->resume);
     2006          SEM_RAISE(TCR_AUX(tcr)->resume);
    20732007          pcontext->ContextFlags = CONTEXT_ALL;
    20742008          GetThreadContext(hthread, pcontext);
     
    20872021#endif
    20882022    }
    2089     tcr->suspend_context = pcontext;
     2023    TCR_AUX(tcr)->suspend_context = pcontext;
    20902024    return true;
    20912025  }
     
    21462080  LOCK(lisp_global(TCR_AREA_LOCK),current);
    21472081  {
    2148     LispObj osid = tcr->osid;
     2082    LispObj osid = TCR_AUX(tcr)->osid;
    21492083   
    21502084    if (osid) {
     
    21542088         forcing the thread to run quit_handler().  For now,
    21552089         mark the TCR as dead and kill the Windows thread. */
    2156       tcr->osid = 0;
     2090      /* xxx TerminateThread() bad */
     2091      TCR_AUX(tcr)->osid = 0;
    21572092      if (!TerminateThread((HANDLE)osid, 0)) {
    21582093        CloseHandle((HANDLE)osid);
     
    21922127resume_tcr(TCR *tcr)
    21932128{
    2194   int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
     2129  int suspend_count = atomic_decf(&(TCR_AUX(tcr)->suspend_count)), err;
    21952130  DWORD rc;
    21962131  if (suspend_count == 0) {
    2197     CONTEXT *context = tcr->suspend_context;
    2198     HANDLE hthread = (HANDLE)(tcr->osid);
     2132    CONTEXT *context = TCR_AUX(tcr)->suspend_context;
     2133    HANDLE hthread = (HANDLE)(TCR_AUX(tcr)->osid);
    21992134
    22002135    if (context) {
    22012136      context->ContextFlags = CONTEXT_ALL;
    2202       tcr->suspend_context = NULL;
     2137      TCR_AUX(tcr)->suspend_context = NULL;
    22032138      SetThreadContext(hthread,context);
    22042139      rc = ResumeThread(hthread);
     
    22502185{
    22512186#ifndef HAVE_TLS
    2252   tcr->next = freed_tcrs;
     2187  TCR_AUX(tcr)->next = freed_tcrs;
    22532188  freed_tcrs = tcr;
    22542189#endif
     
    22782213#endif
    22792214
    2280   a = tcr->cs_area;
     2215  a = TCR_AUX(tcr)->cs_area;
    22812216  if (a) {
    22822217    a->active = a->high;
     
    22902225
    22912226  for (current = freed_tcrs; current; current = next) {
    2292     next = current->next;
     2227    next = TCR_AUX(current)->next;
    22932228#ifndef HAVE_TLS
    22942229#ifdef WIN32
    2295     free(current->allocated);
     2230    free(current->aux);
    22962231#else
    22972232    free(current);
     
    23102245
    23112246  LOCK(lisp_global(TCR_AREA_LOCK), current);
    2312   for (other = current->next; other != current; other = other->next) {
    2313     if ((other->osid != 0)) {
     2247  for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2248    if ((TCR_AUX(other)->osid != 0)) {
    23142249      suspend_tcr(other);
    2315       if (other->osid == 0) {
     2250      if (TCR_AUX(other)->osid == 0) {
    23162251        dead_tcr_count++;
    23172252      }
     
    23232258  do {
    23242259    all_acked = true;
    2325     for (other = current->next; other != current; other = other->next) {
    2326       if ((other->osid != 0)) {
     2260    for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2261      if ((TCR_AUX(other)->osid != 0)) {
    23272262        if (!tcr_suspend_ack(other)) {
    23282263          all_acked = false;
     
    23362271  /* All other threads are suspended; can safely delete dead tcrs now */
    23372272  if (dead_tcr_count) {
    2338     for (other = current->next; other != current; other = next) {
    2339       next = other->next;
    2340       if ((other->osid == 0))  {
     2273    for (other = TCR_AUX(current)->next; other != current; other = next) {
     2274      next = TCR_AUX(other)->next;
     2275      if ((TCR_AUX(other)->osid == 0))  {
    23412276        normalize_dead_tcr_areas(other);
    23422277        dequeue_tcr(other);
     
    23572292{
    23582293  TCR *current = get_tcr(true), *other;
    2359   for (other = current->next; other != current; other = other->next) {
    2360     if ((other->osid != 0)) {
     2294  for (other = TCR_AUX(current)->next; other != current; other = TCR_AUX(other)->next) {
     2295    if ((TCR_AUX(other)->osid != 0)) {
    23612296      resume_tcr(other);
    23622297    }
  • branches/shrink-tcr/lisp-kernel/threads.h

    r14295 r14606  
    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
  • branches/shrink-tcr/lisp-kernel/win32/Makefile

    r14391 r14606  
    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) -DGC_INTEGRITY_CHECKING
    2727CDEBUG = -g
    28 COPT = -O2
     28COPT =
    2929# Once in a while, -Wformat says something useful.  The odds are against that,
    3030# however.
  • branches/shrink-tcr/lisp-kernel/windows-calls.c

    r14583 r14606  
    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}
  • branches/shrink-tcr/lisp-kernel/x86-asmutils32.s

    r13337 r14606  
    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')
  • branches/shrink-tcr/lisp-kernel/x86-constants32.h

    r14295 r14606  
    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))
  • branches/shrink-tcr/lisp-kernel/x86-constants32.s

    r13952 r14606  
    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)
  • branches/shrink-tcr/lisp-kernel/x86-exceptions.c

    r14427 r14606  
    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;
     
    20622063  } else {
    20632064    TCR *tcr = get_interrupt_tcr(false);
    2064     area *cs = tcr->cs_area;
     2065    area *cs = TCR_AUX(tcr)->cs_area;
    20652066    BytePtr current_sp = (BytePtr) current_stack_pointer();
    20662067    CONTEXT *context = exception_pointers->ContextRecord;
     
    21982199      a->active = a->high;
    21992200    }
    2200     a = tcr->cs_area;
     2201    a = TCR_AUX(tcr)->cs_area;
    22012202    if (a) {
    22022203      a->active = a->high;
     
    24712472   account for this extra byte when adjusting the PC */
    24722473#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
     2474#define TCR_SEG_PREFIX 0x64
     2475
     2476#ifdef WIN_32
     2477#define SAVE_ALLOCPTR 0x9c,0x0e,0x0,0x0
     2478#define SAVE_ALLOCBASE 0x98,0x0e,0x0,0x0
     2479#else
     2480#define SAVE_ALLOCPTR 0x84,0x0,0x0,0x0
     2481#define SAVE_ALLOCBASE 0x88,0x0,0x0,0x0
     2482#endif
     2483
    24802484opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
    2481   {TCR_SEG_PREFIX,0x8b,0x0d,0x84,0x00,0x00,0x00};  /* may have extra SIB byte */
     2485  {TCR_SEG_PREFIX,0x8b,0x0d,SAVE_ALLOCPTR};  /* may have extra SIB byte */
    24822486opcode compare_allocptr_reg_to_tcr_save_allocbase_instruction[] =
    2483   {TCR_SEG_PREFIX,0x3b,0x0d,0x88,0x00,0x00,0x00};  /* may have extra SIB byte */
     2487  {TCR_SEG_PREFIX,0x3b,0x0d,SAVE_ALLOCBASE};  /* may have extra SIB byte */
    24842488opcode branch_around_alloc_trap_instruction[] =
    24852489  {0x77,0x02};                  /* no SIB byte issue */
     
    24872491  {0xcd,0xc5};                  /* no SIB byte issue */
    24882492opcode clear_tcr_save_allocptr_tag_instruction[] =
    2489   {TCR_SEG_PREFIX,0x80,0x25,0x84,0x00,0x00,0x00,0xf8}; /* maybe SIB byte */
     2493  {TCR_SEG_PREFIX,0x80,0x25,SAVE_ALLOCPTR,0xf8}; /* maybe SIB byte */
    24902494opcode set_allocptr_header_instruction[] =
    24912495  {0x0f,0x7e,0x41,0xfa};        /* no SIB byte issue */
     
    25002504  case 0x77: return ID_branch_around_alloc_trap_instruction;
    25012505  case 0x0f: return ID_set_allocptr_header_instruction;
    2502   case TCR_SEG_PREFIX:
     2506  case 0x64:
    25032507    switch(program_counter[1]) {
    25042508    case 0x80: return ID_clear_tcr_save_allocptr_tag_instruction;
     
    28442848
    28452849
    2846   for (other_tcr = tcr->next; other_tcr != tcr; other_tcr = other_tcr->next) {
     2850  for (other_tcr = TCR_AUX(tcr)->next; other_tcr != tcr;
     2851       other_tcr = TCR_AUX(other_tcr)->next) {
    28472852    if (other_tcr->pending_exception_context) {
    2848       other_tcr->gc_context = other_tcr->pending_exception_context;
     2853      TCR_AUX(other_tcr)->gc_context = other_tcr->pending_exception_context;
    28492854    } else if (other_tcr->valence == TCR_STATE_LISP) {
    2850       other_tcr->gc_context = other_tcr->suspend_context;
     2855      TCR_AUX(other_tcr)->gc_context = TCR_AUX(other_tcr)->suspend_context;
    28512856    } else {
    28522857      /* no pending exception, didn't suspend in lisp state:
    28532858         must have executed a synchronous ff-call.
    28542859      */
    2855       other_tcr->gc_context = NULL;
    2856     }
    2857     normalize_tcr(other_tcr->gc_context, other_tcr, true);
     2860      TCR_AUX(other_tcr)->gc_context = NULL;
     2861    }
     2862    normalize_tcr(TCR_AUX(other_tcr)->gc_context, other_tcr, true);
    28582863  }
    28592864   
     
    28642869  other_tcr = tcr;
    28652870  do {
    2866     other_tcr->gc_context = NULL;
    2867     other_tcr = other_tcr->next;
     2871    TCR_AUX(other_tcr)->gc_context = NULL;
     2872    other_tcr = TCR_AUX(other_tcr)->next;
    28682873  } while (other_tcr != tcr);
    28692874
  • branches/shrink-tcr/lisp-kernel/x86-gc.c

    r14464 r14606  
    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();
  • branches/shrink-tcr/lisp-kernel/x86-spentry32.s

    r13561 r14606  
    10551055        /* preserve state of direction flag */
    10561056        __(pushfl)
    1057         __(popl rcontext(tcr.save_eflags))
     1057        __(popl rcontext(tcr.unboxed0))
    10581058        __(cld)
    10591059        __(emms)
     
    10791079        __(clr %fn)
    10801080        __(pxor %fpzero,%fpzero)
    1081         __(pushl rcontext(tcr.save_eflags))
     1081        __(pushl rcontext(tcr.unboxed0))
    10821082        __(popfl)
    10831083        __(movl rcontext(tcr.save_vsp),%esp)
     
    11111111        /* preserve state of direction flag */
    11121112        __(pushfl)
    1113         __(popl rcontext(tcr.save_eflags))
     1113        __(popl rcontext(tcr.unboxed0))
    11141114        __(cld)
    11151115        __(emms)
     
    11391139        __(clr %fn)
    11401140        __(pxor %fpzero,%fpzero)
    1141         __(pushl rcontext(tcr.save_eflags))
     1141        __(pushl rcontext(tcr.unboxed0))
    11421142        __(popf)
    11431143        __(movl rcontext(tcr.save_vsp),%esp)
     
    41824182        /* preserve state of direction flag */
    41834183        __(pushfl)
    4184         __(popl rcontext(tcr.save_eflags))
     4184        __(popl rcontext(tcr.unboxed0))
    41854185        __(cld)       
    41864186        __(stmxcsr rcontext(tcr.lisp_mxcsr))
     
    42264226        __(fnclex)
    42274227        __endif
    4228 1:      __(pushl rcontext(tcr.save_eflags))
     42281:      __(pushl rcontext(tcr.unboxed0))
    42294229        __(popfl)
    42304230        __(movl rcontext(tcr.save_vsp),%esp)
     
    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
  • branches/shrink-tcr/lisp-kernel/x86-subprims32.s

    r13337 r14606  
    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)
  • branches/shrink-tcr/lisp-kernel/xlbt.c

    r14484 r14606  
    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
  • branches/shrink-tcr/xdump/xfasload.lisp

    r14119 r14606  
    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.