X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fsystem.lisp;h=edb3f8ced5b4f1149fc9fb87d40e686a169675d6;hb=68c539ab90bb39f342229e68bf9286f63824597a;hp=17d315bbce78e4042cfa59bca73abf06a74d08d4;hpb=adf0d51d2bde8b723276bacf94641df9aa5ae561;p=sbcl.git diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index 17d315b..edb3f8c 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!VM") - -(file-comment - "$Header$") ;;;; type frobbing VOPs @@ -297,212 +294,3 @@ (inst inc (make-ea :dword :base count-vector :disp (- (* (+ vector-data-offset index) word-bytes) other-pointer-type))))) - -;;;; primitive multi-thread support - -(defknown control-stack-fork ((simple-array (unsigned-byte 32) (*)) t) - (member t nil)) - -(define-vop (control-stack-fork) - (:policy :fast-safe) - (:translate control-stack-fork) - (:args (save-stack :scs (descriptor-reg) :to :result) - (inherit :scs (descriptor-reg))) - (:arg-types simple-array-unsigned-byte-32 *) - (:results (child :scs (descriptor-reg))) - (:result-types t) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp) - (:save-p t) - (:generator 25 - (inst cmp inherit nil-value) - (inst jmp :e FRESH-STACK) - - ;; Child inherits the stack of the parent. - - ;; Setup the return context. - (inst push (make-fixup nil :code-object return)) - (inst push ebp-tn) - ;; Save the stack. - (inst xor index index) - ;; First the stack-pointer. - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)) - esp-tn) - (inst inc index) - (inst mov stack (make-fixup (extern-alien-name "control_stack_end") - :foreign)) - (inst jmp-short LOOP) - - FRESH-STACK - ;; Child has a fresh control stack. - - ;; Set up the return context. - (inst push (make-fixup nil :code-object return)) - (inst mov stack (make-fixup (extern-alien-name "control_stack_end") - :foreign)) - ;; The new FP is the top of the stack. - (inst push stack) - ;; Save the stack. - (inst xor index index) - ;; First save the adjusted stack-pointer. - (inst sub stack ebp-tn) - (inst add stack esp-tn) - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)) - stack) - ;; Save the current frame, replacing the OCFP and RA by 0. - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* (+ sb!vm:vector-data-offset 1) - sb!vm:word-bytes) - sb!vm:other-pointer-type)) - 0) - ;; Save 0 for the OCFP. - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* (+ sb!vm:vector-data-offset 2) - sb!vm:word-bytes) - sb!vm:other-pointer-type)) - 0) - (inst add index 3) - ;; Copy the remainder of the frame, skiping the OCFP and RA which - ;; are saved above. - (inst lea stack (make-ea :byte :base ebp-tn :disp -8)) - - LOOP - (inst cmp stack esp-tn) - (inst jmp :le stack-save-done) - (inst sub stack 4) - (inst mov temp (make-ea :dword :base stack)) - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)) - temp) - (inst inc index) - (inst jmp-short LOOP) - - RETURN - ;; Stack already clean if it reaches here. Parent returns NIL. - (inst mov child nil-value) - (inst jmp-short DONE) - - STACK-SAVE-DONE - ;; Cleanup the stack - (inst add esp-tn 8) - ;; Child returns T. - (load-symbol child t) - DONE)) - -(defknown control-stack-resume ((simple-array (unsigned-byte 32) (*)) - (simple-array (unsigned-byte 32) (*))) - (values)) - -(define-vop (control-stack-resume) - (:policy :fast-safe) - (:translate control-stack-resume) - (:args (save-stack :scs (descriptor-reg) :to :result) - (new-stack :scs (descriptor-reg) :to :result)) - (:arg-types simple-array-unsigned-byte-32 simple-array-unsigned-byte-32) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp) - (:save-p t) - (:generator 25 - ;; Set up the return context. - (inst push (make-fixup nil :code-object RETURN)) - (inst push ebp-tn) - ;; Save the stack. - (inst xor index index) - ;; First, the stack-pointer. - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)) - esp-tn) - (inst inc index) - (inst mov stack (make-fixup (extern-alien-name "control_stack_end") - :foreign)) - LOOP - (inst cmp stack esp-tn) - (inst jmp :le STACK-SAVE-DONE) - (inst sub stack 4) - (inst mov temp (make-ea :dword :base stack)) - (inst mov (make-ea :dword :base save-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type)) - temp) - (inst inc index) - (inst jmp-short LOOP) - - STACK-SAVE-DONE - ;; Clean up the stack - (inst add esp-tn 8) - - ;; Restore the new-stack. - (inst xor index index) - ;; First, the stack-pointer. - (inst mov esp-tn - (make-ea :dword :base new-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) - (inst inc index) - (inst mov stack (make-fixup (extern-alien-name "control_stack_end") - :foreign)) - LOOP2 - (inst cmp stack esp-tn) - (inst jmp :le STACK-RESTORE-DONE) - (inst sub stack 4) - (inst mov temp (make-ea :dword :base new-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset - sb!vm:word-bytes) - sb!vm:other-pointer-type))) - (inst mov (make-ea :dword :base stack) temp) - (inst inc index) - (inst jmp-short LOOP2) - STACK-RESTORE-DONE - ;; Pop the frame pointer, and resume at the return address. - (inst pop ebp-tn) - (inst ret) - - ;; Original thread resumes, stack has been cleaned up. - RETURN)) - -(defknown control-stack-return ((simple-array (unsigned-byte 32) (*))) - (values)) - -(define-vop (control-stack-return) - (:policy :fast-safe) - (:translate control-stack-return) - (:args (new-stack :scs (descriptor-reg) :to :result)) - (:arg-types simple-array-unsigned-byte-32) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack) - (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp) - (:save-p t) - (:generator 25 - ;; Restore the new-stack. - (inst xor index index) - ;; First the stack-pointer. - (inst mov esp-tn - (make-ea :dword :base new-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes) - sb!vm:other-pointer-type))) - (inst inc index) - (inst mov stack (make-fixup (extern-alien-name "control_stack_end") - :foreign)) - LOOP - (inst cmp stack esp-tn) - (inst jmp :le STACK-RESTORE-DONE) - (inst sub stack 4) - (inst mov temp (make-ea :dword :base new-stack :index index :scale 4 - :disp (- (* sb!vm:vector-data-offset - sb!vm:word-bytes) - sb!vm:other-pointer-type))) - (inst mov (make-ea :dword :base stack) temp) - (inst inc index) - (inst jmp-short LOOP) - STACK-RESTORE-DONE - ;; Pop the frame pointer, and resume at the return address. - (inst pop ebp-tn) - (inst ret)))