From: Daniel B. <da...@us...> - 2003-04-02 11:15:54
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86 In directory sc8-pr-cvs1:/tmp/cvs-serv9747/src/compiler/x86 Modified Files: c-call.lisp cell.lisp macros.lisp nlx.lisp parms.lisp system.lisp Log Message: 0.pre8.28 === Threads merge, 100 metres === This is the first commit of experimental native threads for SBCL. Note that thread support is by default not compiled in - you need to add :sb-thread to target features. Note also that non-x86 probably doesn't build in this version - that will be fixed imminently See log messages for dan_native_threads_branch, dan_native_threads_2_branch, dan_native_threads_3_branch for more information. I'm not going to type it all in again Index: c-call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- c-call.lisp 16 Jan 2002 15:40:15 -0000 1.12 +++ c-call.lisp 2 Apr 2003 11:15:19 -0000 1.13 @@ -209,27 +209,57 @@ (define-vop (alloc-alien-stack-space) (:info amount) + #!+sb-thread (:temporary (:sc unsigned-reg) temp) (:results (result :scs (sap-reg any-reg))) + #!+sb-thread (:generator 0 (aver (not (location= result esp-tn))) (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) - (inst sub (make-ea :dword - :disp (+ nil-value - (static-symbol-offset '*alien-stack*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - delta))) + (inst mov temp + (make-ea :dword + :disp (+ nil-value + (static-symbol-offset '*alien-stack*) + (ash symbol-tls-index-slot word-shift) + (- other-pointer-lowtag)))) + (inst fs-segment-prefix) + (inst sub (make-ea :dword :scale 1 :index temp) delta))) + (load-tl-symbol-value result *alien-stack*)) + #!-sb-thread + (:generator 0 + (aver (not (location= result esp-tn))) + (unless (zerop amount) + (let ((delta (logandc2 (+ amount 3) 3))) + (inst sub (make-ea :dword + :disp (+ nil-value + (static-symbol-offset '*alien-stack*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + delta))) (load-symbol-value result *alien-stack*))) (define-vop (dealloc-alien-stack-space) (:info amount) + #!+sb-thread (:temporary (:sc unsigned-reg) temp) + #!+sb-thread (:generator 0 (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) - (inst add (make-ea :dword + (inst mov temp + (make-ea :dword :disp (+ nil-value (static-symbol-offset '*alien-stack*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - delta))))) + (ash symbol-tls-index-slot word-shift) + (- other-pointer-lowtag)))) + (inst fs-segment-prefix) + (inst add (make-ea :dword :scale 1 :index temp) delta)))) + #!-sb-thread + (:generator 0 + (unless (zerop amount) + (let ((delta (logandc2 (+ amount 3) 3))) + (inst add (make-ea :dword + :disp (+ nil-value + (static-symbol-offset '*alien-stack*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + delta))))) Index: cell.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/cell.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- cell.lisp 6 Aug 2002 11:46:32 -0000 1.10 +++ cell.lisp 2 Apr 2003 11:15:19 -0000 1.11 @@ -50,16 +50,45 @@ ;; Else, value not immediate. (storew value object offset lowtag)))) + + ;;;; symbol hacking VOPs ;;; these next two cf the sparc version, by jrd. ;;; FIXME: Deref this ^ reference. + ;;; The compiler likes to be able to directly SET symbols. +#!+sb-thread +(define-vop (set) + (:args (symbol :scs (descriptor-reg)) + (value :scs (descriptor-reg any-reg))) + (:translate sb!kernel:%set-symbol-value) + (:temporary (:sc descriptor-reg ) tls) + ;;(:policy :fast-safe) + (:generator 4 + (let ((global-val (gen-label)) + (done (gen-label))) + (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) + (inst or tls tls) + (inst jmp :z global-val) + (inst fs-segment-prefix) + (inst cmp (make-ea :dword :scale 1 :index tls) unbound-marker-widetag) + (inst jmp :z global-val) + (inst fs-segment-prefix) + (inst mov (make-ea :dword :scale 1 :index tls) value) + (inst jmp done) + (emit-label global-val) + (storew value symbol symbol-value-slot other-pointer-lowtag) + (emit-label done)))) + +;; unithreaded it's a lot simpler ... +#!-sb-thread (define-vop (set cell-set) (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. +;;; XXX stil used? I can't see where -dan (define-vop (checked-cell-ref) (:args (object :scs (descriptor-reg) :target obj-temp)) (:results (value :scs (descriptor-reg any-reg))) @@ -70,6 +99,33 @@ ;;; With Symbol-Value, we check that the value isn't the trap object. So ;;; Symbol-Value of NIL is NIL. +#!+sb-thread +(define-vop (symbol-value) + (:translate symbol-value) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg) :to (:result 1))) + (:results (value :scs (descriptor-reg any-reg))) + (:vop-var vop) + (:save-p :compute-only) + (:generator 9 + (let* ((err-lab (generate-error-code vop unbound-symbol-error object)) + (ret-lab (gen-label))) + (loadw value object symbol-tls-index-slot other-pointer-lowtag) + (inst fs-segment-prefix) + (inst mov value (make-ea :dword :index value :scale 1)) + (inst cmp value unbound-marker-widetag) + (inst jmp :ne ret-lab) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmp value unbound-marker-widetag) + (inst jmp :e err-lab) + (emit-label ret-lab)))) + +#!+sb-thread +(define-vop (fast-symbol-value symbol-value) + (:policy :fast) + (:translate symbol-value)) + +#!-sb-thread (define-vop (symbol-value) (:translate symbol-value) (:policy :fast-safe) @@ -83,18 +139,49 @@ (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab)))) +#!-sb-thread (define-vop (fast-symbol-value cell-ref) (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) -(defknown fast-symbol-value-xadd (symbol fixnum) fixnum ()) -(define-vop (fast-symbol-value-xadd cell-xadd) +(defknown fast-symbol-global-value-xadd (symbol fixnum) fixnum ()) + +(define-vop (fast-symbol-global-value-xadd cell-xadd) (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) - (:translate fast-symbol-value-xadd) + (:translate fast-symbol-global-value-xadd) (:arg-types * tagged-num)) +#!+sb-thread +(define-vop (boundp) + (:translate boundp) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:conditional) + (:info target not-p) + (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value) + (:generator 9 + (if not-p + (let ((not-target (gen-label))) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmp value unbound-marker-widetag) + (inst jmp :ne not-target) + (loadw value object symbol-tls-index-slot other-pointer-lowtag) + (inst fs-segment-prefix) + (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) + (inst jmp :e target) + (emit-label not-target)) + (progn + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmp value unbound-marker-widetag) + (inst jmp :ne target) + (loadw value object symbol-tls-index-slot other-pointer-lowtag) + (inst fs-segment-prefix) + (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) + (inst jmp :ne target))))) + +#!-sb-thread (define-vop (boundp) (:translate boundp) (:policy :fast-safe) @@ -107,6 +194,7 @@ (inst cmp value unbound-marker-widetag) (inst jmp (if not-p :e :ne) target))) + (define-vop (symbol-hash) (:policy :fast-safe) (:translate symbol-hash) @@ -176,9 +264,38 @@ ;;; the symbol on the binding stack and stuff the new value into the ;;; symbol. +#!+sb-thread (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) + (:temporary (:sc unsigned-reg) tls-index temp bsp) + (:generator 5 + (let ((tls-index-valid (gen-label))) + (load-tl-symbol-value bsp *binding-stack-pointer*) + (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + (inst add bsp (* binding-size n-word-bytes)) + (store-tl-symbol-value bsp *binding-stack-pointer* temp) + + (inst or tls-index tls-index) + (inst jmp :ne tls-index-valid) + ;; allocate a new tls-index + (load-symbol-value tls-index *free-tls-index*) + (inst add tls-index 4) ;XXX surely we can do this more + (store-symbol-value tls-index *free-tls-index*) ;succintly + (inst sub tls-index 4) + (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + (emit-label tls-index-valid) + (inst fs-segment-prefix) + (inst mov temp (make-ea :dword :scale 1 :index tls-index)) + (storew temp bsp (- binding-value-slot binding-size)) + (storew symbol bsp (- binding-symbol-slot binding-size)) + (inst fs-segment-prefix) + (inst mov (make-ea :dword :scale 1 :index tls-index) val)))) + +#!-sb-thread +(define-vop (bind) + (:args (val :scs (any-reg descriptor-reg)) + (symbol :scs (descriptor-reg))) (:temporary (:sc unsigned-reg) temp bsp) (:generator 5 (load-symbol-value bsp *binding-stack-pointer*) @@ -189,6 +306,26 @@ (storew symbol bsp (- binding-symbol-slot binding-size)) (storew val symbol symbol-value-slot other-pointer-lowtag))) + +#!+sb-thread +(define-vop (unbind) + ;; four temporaries? + (:temporary (:sc unsigned-reg) symbol value bsp tls-index) + (:generator 0 + (load-tl-symbol-value bsp *binding-stack-pointer*) + (loadw symbol bsp (- binding-symbol-slot binding-size)) + (loadw value bsp (- binding-value-slot binding-size)) + + (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + (inst fs-segment-prefix) + (inst mov (make-ea :dword :scale 1 :index tls-index) value) + + (storew 0 bsp (- binding-symbol-slot binding-size)) + (inst sub bsp (* binding-size n-word-bytes)) + ;; we're done with value, so we can use it as a temp here + (store-tl-symbol-value bsp *binding-stack-pointer* value))) + +#!-sb-thread (define-vop (unbind) (:temporary (:sc unsigned-reg) symbol value bsp) (:generator 0 @@ -200,11 +337,12 @@ (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) + (define-vop (unbind-to-here) (:args (where :scs (descriptor-reg any-reg))) - (:temporary (:sc unsigned-reg) symbol value bsp) + (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index) (:generator 0 - (load-symbol-value bsp *binding-stack-pointer*) + (load-tl-symbol-value bsp *binding-stack-pointer*) (inst cmp where bsp) (inst jmp :e done) @@ -213,17 +351,25 @@ (inst or symbol symbol) (inst jmp :z skip) (loadw value bsp (- binding-value-slot binding-size)) - (storew value symbol symbol-value-slot other-pointer-lowtag) + #!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag) + + #!+sb-thread (loadw + tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + #!+sb-thread (inst fs-segment-prefix) + #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP (inst sub bsp (* binding-size n-word-bytes)) (inst cmp where bsp) (inst jmp :ne loop) - (store-symbol-value bsp *binding-stack-pointer*) + ;; we're done with value, so can use it as a temporary + (store-tl-symbol-value bsp *binding-stack-pointer* value) DONE)) + + ;;;; closure indexing (define-full-reffer closure-index-ref * @@ -284,6 +430,32 @@ (define-full-setter instance-index-set * instance-slots-offset instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set) + + +(defknown %instance-set-conditional (instance index t t) t + (unsafe)) + +(define-vop (instance-set-conditional) + (:translate %instance-set-conditional) + (:args (object :scs (descriptor-reg) :to :eval) + (slot :scs (any-reg) :to :result) + (old-value :scs (descriptor-reg any-reg) :target eax) + (new-value :scs (descriptor-reg any-reg))) + (:arg-types instance positive-fixnum * *) + (:temporary (:sc descriptor-reg :offset eax-offset + :from (:argument 2) :to :result :target result) eax) + (:results (result :scs (descriptor-reg any-reg))) + ;(:guard (backend-featurep :i486)) + (:policy :fast-safe) + (:generator 5 + (move eax old-value) + (inst cmpxchg (make-ea :dword :base object :index slot :scale 1 + :disp (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)) + new-value) + (move result eax))) + + ;;;; code object frobbing Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- macros.lisp 25 Mar 2003 13:40:21 -0000 1.12 +++ macros.lisp 2 Apr 2003 11:15:19 -0000 1.13 @@ -84,7 +84,35 @@ (- other-pointer-lowtag))) ,reg)) +#!+sb-thread +(defmacro load-tl-symbol-value (reg symbol) + `(progn + (inst mov ,reg + (make-ea :dword + :disp (+ nil-value + (static-symbol-offset ',symbol) + (ash symbol-tls-index-slot word-shift) + (- other-pointer-lowtag)))) + (inst fs-segment-prefix) + (inst mov ,reg (make-ea :dword :scale 1 :index ,reg)))) +#!-sb-thread +(defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol)) +#!+sb-thread +(defmacro store-tl-symbol-value (reg symbol temp) + `(progn + (inst mov ,temp + (make-ea :dword + :disp (+ nil-value + (static-symbol-offset ',symbol) + (ash symbol-tls-index-slot word-shift) + (- other-pointer-lowtag)))) + (inst fs-segment-prefix) + (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg))) +#!-sb-thread +(defmacro store-tl-symbol-value (reg symbol temp) + `(store-symbol-value ,reg ,symbol)) + (defmacro load-type (target source &optional (offset 0)) #!+sb-doc "Loads the type bits of a pointer into target independent of @@ -277,31 +305,53 @@ ;;; FIXME: It appears that PSEUDO-ATOMIC is used to wrap operations which leave ;;; untagged memory lying around, but some documentation would be nice. +#!+sb-thread +(defmacro pseudo-atomic (&rest forms) + (let ((label (gensym "LABEL-"))) + `(let ((,label (gen-label))) + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) + (inst fs-segment-prefix) + (inst mov (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + ,@forms + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0) + (inst fs-segment-prefix) + (inst cmp (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + (inst jmp :eq ,label) + ;; if PAI was set, interrupts were disabled at the same time + ;; using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) + +#!-sb-thread (defmacro pseudo-atomic (&rest forms) (let ((label (gensym "LABEL-"))) `(let ((,label (gen-label))) ;; FIXME: The MAKE-EA noise should become a MACROLET macro or ;; something. (perhaps SVLB, for static variable low byte) (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - ;; FIXME: Use mask, not minus, to - ;; take out type bits. - (- other-pointer-lowtag))) + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + ;; FIXME: Use mask, not minus, to + ;; take out type bits. + (- other-pointer-lowtag))) 0) (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) (fixnumize 1)) ,@forms (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) 0) ;; KLUDGE: Is there any requirement for interrupts to be ;; handled in order? It seems as though an interrupt coming @@ -310,17 +360,19 @@ ;; are pending? I wish I could find the documentation for ;; pseudo-atomics.. -- WHN 19991130 (inst cmp (make-ea :byte - :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) + :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) 0) (inst jmp :eq ,label) ;; if PAI was set, interrupts were disabled at the same time ;; using the process signal mask. (inst break pending-interrupt-trap) (emit-label ,label)))) + + ;;;; indexed references Index: nlx.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/nlx.lisp,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- nlx.lisp 7 Mar 2003 12:15:32 -0000 1.15 +++ nlx.lisp 2 Apr 2003 11:15:20 -0000 1.16 @@ -44,15 +44,16 @@ (:results (catch :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) (:generator 13 - (load-symbol-value catch *current-catch-block*) - (load-symbol-value alien-stack *alien-stack*))) + (load-tl-symbol-value catch *current-catch-block*) + (load-tl-symbol-value alien-stack *alien-stack*))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) + #!+sb-thread (:temporary (:sc unsigned-reg) temp) (:generator 10 - (store-symbol-value catch *current-catch-block*) - (store-symbol-value alien-stack *alien-stack*))) + (store-tl-symbol-value catch *current-catch-block* temp) + (store-tl-symbol-value alien-stack *alien-stack* temp))) (define-vop (current-stack-pointer) (:results (res :scs (any-reg control-stack))) @@ -62,7 +63,7 @@ (define-vop (current-binding-pointer) (:results (res :scs (any-reg descriptor-reg))) (:generator 1 - (load-symbol-value res *binding-stack-pointer*))) + (load-tl-symbol-value res *binding-stack-pointer*))) ;;;; unwind block hackery @@ -75,7 +76,7 @@ (:results (block :scs (any-reg))) (:generator 22 (inst lea block (catch-block-ea tn)) - (load-symbol-value temp *current-unwind-protect-block*) + (load-tl-symbol-value temp *current-unwind-protect-block*) (storew temp block unwind-block-current-uwp-slot) (storew ebp-tn block unwind-block-current-cont-slot) (storew (make-fixup nil :code-object entry-label) @@ -91,42 +92,42 @@ (:temporary (:sc descriptor-reg) temp) (:generator 44 (inst lea block (catch-block-ea tn)) - (load-symbol-value temp *current-unwind-protect-block*) + (load-tl-symbol-value temp *current-unwind-protect-block*) (storew temp block unwind-block-current-uwp-slot) (storew ebp-tn block unwind-block-current-cont-slot) (storew (make-fixup nil :code-object entry-label) block catch-block-entry-pc-slot) (storew tag block catch-block-tag-slot) - (load-symbol-value temp *current-catch-block*) + (load-tl-symbol-value temp *current-catch-block*) (storew temp block catch-block-previous-catch-slot) - (store-symbol-value block *current-catch-block*))) + (store-tl-symbol-value block *current-catch-block* temp))) ;;; Just set the current unwind-protect to TN's address. This instantiates an ;;; unwind block as an unwind-protect. (define-vop (set-unwind-protect) (:args (tn)) - (:temporary (:sc unsigned-reg) new-uwp) + (:temporary (:sc unsigned-reg) new-uwp #!+sb-thread tls) (:generator 7 (inst lea new-uwp (catch-block-ea tn)) - (store-symbol-value new-uwp *current-unwind-protect-block*))) + (store-tl-symbol-value new-uwp *current-unwind-protect-block* tls))) (define-vop (unlink-catch-block) - (:temporary (:sc unsigned-reg) block) + (:temporary (:sc unsigned-reg) #!+sb-thread tls block) (:policy :fast-safe) (:translate %catch-breakup) (:generator 17 - (load-symbol-value block *current-catch-block*) + (load-tl-symbol-value block *current-catch-block*) (loadw block block catch-block-previous-catch-slot) - (store-symbol-value block *current-catch-block*))) + (store-tl-symbol-value block *current-catch-block* tls))) (define-vop (unlink-unwind-protect) - (:temporary (:sc unsigned-reg) block) + (:temporary (:sc unsigned-reg) block #!+sb-thread tls) (:policy :fast-safe) (:translate %unwind-protect-breakup) (:generator 17 - (load-symbol-value block *current-unwind-protect-block*) + (load-tl-symbol-value block *current-unwind-protect-block*) (loadw block block unwind-block-current-uwp-slot) - (store-symbol-value block *current-unwind-protect-block*))) + (store-tl-symbol-value block *current-unwind-protect-block* tls))) ;;;; NLX entry VOPs (define-vop (nlx-entry) Index: parms.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/parms.lisp,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- parms.lisp 23 Jul 2002 17:22:37 -0000 1.30 +++ parms.lisp 2 Apr 2003 11:15:20 -0000 1.31 @@ -144,11 +144,6 @@ (def!constant dynamic-space-start #x09000000) (def!constant dynamic-space-end #x29000000) - (def!constant control-stack-start #x50000000) - (def!constant control-stack-end #x57fff000) - - (def!constant binding-stack-start #x60000000) - (def!constant binding-stack-end #x67fff000) (def!constant alternate-signal-stack-start #x58000000)) #!+bsd @@ -162,15 +157,6 @@ #!+openbsd #x28000000) (def!constant static-space-end #x37fff000) - (def!constant binding-stack-start #x38000000) - (def!constant binding-stack-end #x3ffff000) - - (def!constant control-stack-start - #!+freebsd #x40000000 - #!+openbsd #x48000000) - (def!constant control-stack-end - #!+freebsd #x43fff000 - #!+openbsd #x4bfff000) (def!constant dynamic-space-start #!+freebsd #x48000000 #!+openbsd #x50000000) @@ -268,8 +254,13 @@ sb!unix::*interrupt-pending* *free-interrupt-context-index* + *free-tls-index* + sb!thread::*foreground-thread-stack* + *allocation-pointer* *binding-stack-pointer* + *binding-stack-start* + *control-stack-start* ;; the floating point constants *fp-constant-0d0* Index: system.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/system.lisp,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- system.lisp 15 Jan 2002 23:53:51 -0000 1.15 +++ system.lisp 2 Apr 2003 11:15:20 -0000 1.16 @@ -163,7 +163,7 @@ (:translate binding-stack-pointer-sap) (:policy :fast-safe) (:generator 1 - (load-symbol-value int *binding-stack-pointer*))) + (load-tl-symbol-value int *binding-stack-pointer*))) (defknown (setf binding-stack-pointer-sap) (system-area-pointer) system-area-pointer ()) @@ -173,10 +173,11 @@ (:arg-types system-area-pointer) (:results (int :scs (sap-reg))) (:result-types system-area-pointer) + #!+sb-thread (:temporary (:sc any-reg) temp) (:translate (setf binding-stack-pointer-sap)) (:policy :fast-safe) (:generator 1 - (store-symbol-value new-value *binding-stack-pointer*) + (store-tl-symbol-value new-value *binding-stack-pointer* temp) (move int new-value))) (define-vop (control-stack-pointer-sap) @@ -272,6 +273,26 @@ (:translate sb!unix::receive-pending-interrupt) (:generator 1 (inst break pending-interrupt-trap))) + +(defknown current-thread-offset-sap ((unsigned-byte 32)) + system-area-pointer (flushable)) + +(define-vop (current-thread-offset-sap) + (:results (sap :scs (sap-reg))) + (:result-types system-area-pointer) + (:translate current-thread-offset-sap) + (:args (n :scs (unsigned-reg) #!+sb-thread :target #!+sb-thread sap)) + #!-sb-thread (:temporary (:sc unsigned-reg :target sap) temp) + (:arg-types unsigned-num) + (:policy :fast-safe) + #!+sb-thread + (:generator 2 + (inst fs-segment-prefix) + (inst mov sap (make-ea :dword :disp 0 :index n :scale 4))) + #!-sb-thread + (:generator 2 + (inst mov temp (make-fixup (extern-alien-name "all_threads") :foreign)) + (inst mov sap (make-ea :dword :base temp :index n :scale 4)))) (define-vop (halt) (:generator 1 |