Ignore:
Timestamp:
Feb 16, 2009, 1:55:29 PM (11 years ago)
Author:
gb
Message:

Mostly experimental changes: try to make some operations on PROCESSes
generic. Work-in-progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-lisp-threads.lisp

    r11659 r11744  
    163163            nil
    164164            :reset
    165             (make-lock)
    166             nil))
     165            (make-lock)))
    167166
    168167(defvar *current-lisp-thread*
     
    404403
    405404       
    406 (defun thread-preset (thread function &rest args)
     405(defun  thread-preset (thread function &rest args)
    407406  (setf (lisp-thread.initial-function.args thread)
    408407        (cons function args)))
     
    437436        (%kill-tcr tcr)))))
    438437
    439 ;;; This returns the underlying pthread, whatever that is.
     438;;; This returns the underlying pthread, whatever that is, as an
     439;;; unsigned integer.
    440440(defun lisp-thread-os-thread (thread)
    441441  (with-macptrs (tcrp)
    442442    (%setf-macptr-to-object tcrp (lisp-thread.tcr thread))
    443443    (unless (%null-ptr-p tcrp)
    444       #+linux-target
    445       (let* ((pthread (#+32-bit-target %get-unsigned-long
    446                        #+64-bit-target %%get-unsigned-longlong
    447                        tcrp target::tcr.osid)))
    448         (unless (zerop pthread) pthread))
    449       #+darwin-target
    450       (let* ((pthread (%get-ptr tcrp target::tcr.osid)))
    451         (unless (%null-ptr-p pthread) pthread)))))
     444      (let* ((natural (%get-natural tcrp target::tcr.osid)))
     445        (unless (zerop natural) natural)))))
     446
     447
    452448                         
    453449;;; This returns something lower-level than the pthread, if that
     
    487483          (bitset arch::tcr-flag-bit-awaiting-preset flags)))) 
    488484
     485;;; This doesn't quite activate the thread; see PROCESS-TCR-ENABLE.
    489486(defun %activate-tcr (tcr termination-semaphore allocation-quantum)
    490487  (if (and tcr (not (eql 0 tcr)))
    491     (with-macptrs (tcrp s)
     488    (with-macptrs (tcrp)
    492489      (%setf-macptr-to-object tcrp tcr)
    493       (%setf-macptr s (%get-ptr tcrp target::tcr.activate))
    494       (unless (%null-ptr-p s)
    495         (setf (#+64-bit-target %%get-unsigned-longlong
    496                #+32-bit-target %get-unsigned-long
    497                                tcrp target::tcr.log2-allocation-quantum)
    498               (or allocation-quantum (default-allocation-quantum)))
    499         (setf (%get-ptr tcrp target::tcr.termination-semaphore)
    500               (if termination-semaphore
    501                 (semaphore-value termination-semaphore)
    502                 (%null-ptr)))
    503         (%signal-semaphore-ptr s)
    504         t))))
     490      (setf (%get-natural tcrp target::tcr.log2-allocation-quantum)
     491            (or allocation-quantum (default-allocation-quantum)))
     492      (setf (%get-ptr tcrp target::tcr.termination-semaphore)
     493            (if termination-semaphore
     494              (semaphore-value termination-semaphore)
     495              (%null-ptr)))
     496      t)))
    505497                         
    506498(defvar *canonical-error-value*
Note: See TracChangeset for help on using the changeset viewer.