; .EnTete "Le-Lisp (c) version 15.2" " " "Les se'quenceurs de base"
; .EnPied "schedule.ll" "O-%" " "
; .Annexe O "Les se'quenceurs de base"
; .nr % 1 
;
; .Centre "*****************************************************************"
; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA.  "
; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA                 "
; .Centre "*****************************************************************"

; .Centre "$Header: schedule.ll,v 4.1 88/01/13 12:23:35 kuczynsk Rel $"

(unless (>= (version) 15.2)
        (error 'load 'erricf 'schedule))


(defvar #:sys-package:colon 'schedule)

; .Section "Initialisation des ITs horloge"

(defvar #:system:clock-tick 0.05)

(de clock ()
    (when (debug) (princn #/.))
    (suspend))

(dmd clockstart ()
     `(clockalarm #:system:clock-tick))

(dmd clockstop ()
     `(clockalarm 0.))

; .Section "Les se'quenceurs de base"

(defvar :ll)

(df parallel :ll
    ; e'value les expressions de :l en paralle`le.
    ; retourne () quand toutes les expressions ont e'te' e'value'es.
    (without-interrupts
        (let ((:l (append :ll ())))   ; e'vite les modifs physiques du corps.
            (while :l
                (schedule (lambda (:v)
                              (newr :l (list 'resume (kwote :v)))) 
                     (let ((:e (nextl :l)))
                          ; ce LET doit e↑tre dans la porte'e du
                          ; bloc d'activation schedule!
                          (clockstart)
                          (with-interrupts (eval :e))
                          (clockstop)))))))

(df parallelvalues :ll
    ; e'value les expressions de :l en paralle`le.
    ; retourne la liste des expressions e'value'es dans l'ordre de :l
    (without-interrupts
        (let ((:ltask ())                      ; les ta↑ches en suspend
              (:l :ll)                         ; les choses a faires
              (:r (makelist (length :ll) ()))  ; liste des valeurs de retour
              (:i -1))                         ; le compteur de slots
            (while (or :l :ltask)
                (schedule (lambda (:v) (newr :ltask :v))
                    (clockstart)
                    (ifn :l
                         (resume (nextl :ltask))
                         (let ((:e (nextl :l)))
                              ; ce LET doit e↑tre dans la porte'e du
                              ; bloc d'activation schedule!
                              (incr :i)
                              (rplaca (nthcdr :i :r)
                                      (with-interrupts (eval :e)))))
                    (clockstop)))
            :r)))

(df tryinparallel :ll
    ; e'value les expressions de :l en paralle`le.
    ; retourne la premie`re valeur calcule'e et arre↑te toutes
    ; les autres ta↑ches en suspend.
    (without-interrupts
        (let ((:ltask ())
              (:l :ll))
            (tag :return-value
                 (while (or :l :ltask)
                        (schedule (lambda (:v) (newr :ltask :v))
                            (clockstart)
                            (let ((:e (nextl :l)))
                                 ; ce LET doit e↑tre dans la porte'e du
                                 ; bloc d'activation schedule!
                                 (if :e
                                     (exit :return-value
                                           (prog1
                                                (with-interrupts
                                                    (eval :e))
                                          (clockstop))))
                                (resume (nextl :ltask)))))))))
         

(dmd progn-no-suspend :body
     ; e'value les expressions de :l en se'quence et sans e↑tre suspendu!
     `(schedule resume ,@:body))

(dmd letparallel (:lvar . :body)
     ; LET dans lequel les valeurs des variables sont e'value'es
     ; en paralle`ele : la liaison s'effectaunt e'galement en paralle`le.
     `(letvq ,(mapcar 'car :lvar)
             (parallelvalues ,@(mapcar 'cadr :lvar))
             ,@:body))