Patch title: Release 84 bulk changes
Abstract:
File: /pliant/language/schedule/daemon.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/install/ring3.pli"

constant trace false


type Daemon
  field Str title
  field DelayedAction action
  field FastSem sem
  field CBool running <- false
  field CBool again

gvar List daemons


function execute2 a f
  arg Address a ; arg Function f
  indirect

function execute1 d
  arg_rw Daemon d
  action_push_record (var ActionRecord ar) d:title
  while { d:sem request ; d again }
    d again := false
    d:sem release
    execute2 d:action:parameter d:action:function
  d running := false
  d:sem release
  action_pull_record ar

method d setup title action
  arg_rw Daemon d ; arg Str title ; arg DelayedAction action
  d:sem request
  d again := true
  if not d:running
    d title := title
    d action := action
    var DelayedAction da
    da function :> the_function execute1 Daemon
    da parameter := addressof d
    if run_thread:da
      d running := true
    else
      error error_id_starvation "Failed to start daemon "+d:title
  d:sem release

method d start
  arg_rw Daemon d
  if (exists d:action:function)
    var Str title := d title
    var DelayedAction action := d action
    d setup title action

method d stop
  arg_rw Daemon d
  while d:running
    os_yield
  

meta daemon e
  if e:size<>2 or not (e:0 cast Str)
    return
  var Link:List expressions :> new List
  var Link:List byaddress :> new List
  expressions append (addressof e:1)
  var Pointer:Module module :> e module
  var Address mark := module mark
  module define "pliant shared" addressof:byaddress
  module define "share" addressof:(the_meta 'pliant share arguments')
  var List functions ; var Link:Type type
  e freeze expressions byaddress functions type
  module rewind mark
  void ?
  e suckup e:0
  var Link:Daemon d :> new Daemon
  daemons append addressof:d
  var Link:Argument a :> argument mapped_constant Daemon d
  e add (instruction (the_function '. setup' Daemon Str DelayedAction) a e:0:result e:1:result)
  e set_void_result


function daemon_emergency -> e
  arg CBool e
  e := pliant_execution_phase>execution_phase_run

function daemon_sleep seconds
  arg Float seconds
  var Float remain := seconds
  while remain>5
    if daemon_emergency return
    sleep 5
    remain -= 5
  if daemon_emergency return
  sleep remain
  

export daemon daemon_emergency daemon_sleep


function start_daemons p
  arg Address p
  var Pointer:Arrow c :> daemons first
  while c<>null
    (c map Daemon) start
    c :> daemons next c
gvar DelayedAction start
start function :> the_function start_daemons Address
pliant_wakeup_actions append addressof:start

function stop_daemons p
  arg Address p
  var Pointer:Arrow c :> daemons first
  while c<>null
    var Pointer:Daemon d :> c map Daemon
    if trace
      console "  stop " d:title " ..."
    d stop
    if trace
      console " done." eol
    c :> daemons next c
  var Int lap := 0
  while lap<9 and current_running_threads>1
    sleep 0.1 ; lap += 1
  sleep 0.1
  if false # current_running_threads>1
    console "failed to get back to single thread mode !" eol
    sleep 2
gvar DelayedAction stop
stop function :> the_function stop_daemons Address
pliant_shutdown_actions append addressof:stop