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-processes.lisp

    r11281 r11744  
    295295
    296296
    297 (defun process-enable (p &optional (wait (* 60 60 24) wait-p))
     297(defmethod process-enable ((p process) &optional (wait (* 60 60 24) wait-p))
    298298  "Begin executing the initial function of a specified process."
    299   (setq p (require-type p 'process))
    300299  (not-in-current-process p 'process-enable)
    301300  (when wait-p
     
    306305    (do* ((total-wait wait (+ total-wait wait)))
    307306         ((thread-enable thread (process-termination-semaphore p) (1- (integer-length (process-allocation-quantum p)))  wait)
     307          (process-tcr-enable p (lisp-thread.tcr thread))
    308308          p)
    309309      (cerror "Keep trying."
     
    311311              p total-wait))))
    312312
     313(defmethod process-tcr-enable ((process process) tcr)
     314  (when (and tcr (not (eql 0 tcr)))
     315    (%signal-semaphore-ptr (%fixnum-ref-macptr tcr target::tcr.activate))
     316    ))
    313317
    314318(defmethod (setf process-termination-semaphore) :after (new (p process))
     
    351355 
    352356;;; Used by process-run-function
    353 (defun process-preset (process function &rest args)
     357(defmethod process-preset ((p process) function &rest args)
    354358  "Set the initial function and arguments of a specified process."
    355   (let* ((p (require-type process 'process))
    356          (f (require-type function 'function))
     359  (let* ((f (require-type function 'function))
    357360         (initial-form (process-initial-form p)))
    358361    (declare (type cons initial-form))
     
    361364    (rplaca initial-form f)
    362365    (rplacd initial-form args)
    363     (%process-preset-internal process)))
    364 
    365 (defun %process-preset-internal (process)
     366    (%process-preset-internal p)))
     367
     368(defmethod %process-preset-internal ((process process))
    366369   (let* ((initial-form (process-initial-form process))
    367370         (thread (process-thread process)))
     
    567570(defun process-allow-schedule ()
    568571  "Used for cooperative multitasking; probably never necessary."
    569   (yield))
     572  (process-yield *current-process*))
    570573
    571574
     
    621624        (process-interrupt process '%process-reset kill)))))
    622625
     626(defmethod process-yield ((p process))
     627  #+windows-target (#_Sleep 0)
     628  #-windows-target (#_sched_yield))
     629
    623630
    624631(defun %process-reset (kill)
Note: See TracChangeset for help on using the changeset viewer.