/pliant/language/schedule/daemon.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "/pliant/install/ring3.pli" 
 17   
 18  constant trace false 
 19   
 20   
 21  type Daemon 
 22    field Str title 
 23    field DelayedAction action 
 24    field FastSem sem 
 25    field CBool running <- false 
 26    field CBool again 
 27   
 28  gvar List daemons 
 29   
 30   
 31  function execute2 a f 
 32    arg Address a ; arg Function f 
 33    indirect 
 34   
 35  function execute1 d 
 36    arg_rw Daemon d 
 37    action_push_record (var ActionRecord ar) d:title 
 38    while { d:sem request ; again } 
 39      again := false 
 40      d:sem release 
 41      execute2 d:action:parameter d:action:function 
 42    running := false 
 43    d:sem release 
 44    action_pull_record ar 
 45   
 46  method d setup title action 
 47    arg_rw Daemon d ; arg Str title ; arg DelayedAction action 
 48    d:sem request 
 49    again := true 
 50    if not d:running 
 51      title := title 
 52      action := action 
 53      var DelayedAction da 
 54      da function :> the_function execute1 Daemon 
 55      da parameter := addressof d 
 56      if run_thread:da 
 57        running := true 
 58      else 
 59        error error_id_starvation "Failed to start daemon "+d:title 
 60    d:sem release 
 61   
 62  method d start 
 63    arg_rw Daemon d 
 64    if (exists d:action:function) 
 65      var Str title := title 
 66      var DelayedAction action := action 
 67      setup title action 
 68   
 69  method d stop 
 70    arg_rw Daemon d 
 71    while d:running 
 72      os_yield 
 73     
 74   
 75  meta daemon e 
 76    if e:size<>or not (e:cast Str) 
 77      return 
 78    var Link:List expressions :> new List 
 79    var Link:List byaddress :> new List 
 80    expressions append (addressof e:1) 
 81    var Pointer:Module module :> module 
 82    var Address mark := module mark 
 83    module define "pliant shared" addressof:byaddress 
 84    module define "share" addressof:(the_meta 'pliant share arguments') 
 85    var List functions ; var Link:Type type 
 86    freeze expressions byaddress functions type 
 87    module rewind mark 
 88    void ? 
 89    suckup e:0 
 90    var Link:Daemon :> new Daemon 
 91    daemons append addressof:d 
 92    var Link:Argument :> argument mapped_constant Daemon d 
 93    add (instruction (the_function '. setup' Daemon Str DelayedAction) e:0:result e:1:result) 
 94    set_void_result 
 95   
 96   
 97  function daemon_emergency -> e 
 98    arg CBool e 
 99    := pliant_execution_phase>execution_phase_run 
 100   
 101  function daemon_sleep seconds 
 102    arg Float seconds 
 103    var Float remain := seconds 
 104    while remain>5 
 105      if daemon_emergency return 
 106      sleep 5 
 107      remain -= 5 
 108    if daemon_emergency return 
 109    sleep remain 
 110     
 111   
 112  export daemon daemon_emergency daemon_sleep 
 113   
 114   
 115  function start_daemons p 
 116    arg Address p 
 117    var Pointer:Arrow :> daemons first 
 118    while c<>null 
 119      (map Daemon) start 
 120      :> daemons next c 
 121  gvar DelayedAction start 
 122  start function :> the_function start_daemons Address 
 123  pliant_wakeup_actions append addressof:start 
 124   
 125  function stop_daemons p 
 126    arg Address p 
 127    var Pointer:Arrow :> daemons first 
 128    while c<>null 
 129      var Pointer:Daemon :> map Daemon 
 130      if trace 
 131        console "  stop " d:title " ..." 
 132      stop 
 133      if trace 
 134        console " done." eol 
 135      :> daemons next c 
 136    var Int lap := 0 
 137    while lap<and current_running_threads>1 
 138      sleep 0.1 ; lap += 1 
 139    sleep 0.1 
 140    if false # current_running_threads>1 
 141      console "failed to get back to single thread mode !" eol 
 142      sleep 2 
 143  gvar DelayedAction stop 
 144  stop function :> the_function stop_daemons Address 
 145  pliant_shutdown_actions append addressof:stop 
 146