next up previous
Next: A.40 vc-simpler.setl Up: A. WEBeye Source Code Previous: A.38 vc-send.setl

  
A.39 vc-seq.setl

Client of service:
notify    (vc-event.setl, Section A.12 [vc-event.setl])

Called by parent program:
vc-model.setl     (Section A.27 [vc-model.setl])

Calls child programs:
vc-recv.setl     (Section A.36 [vc-recv.setl])
vc-send.setl     (Section A.38 [vc-send.setl])

Textually #includes:
vc-exit.setl     (Section A.15 [vc-exit.setl])
vc-msg.setl     (Section A.30 [vc-msg.setl])
vc-obtain.setl     (Section A.31 [vc-obtain.setl])

Source code: *

const yhwh = `vc-seq.setl';
 
-- Low-level Canon VC-C3 command sequencer
 
-- This pump takes commands or sequences thereof which are
-- clocked out on attached tick-based schedules.  It also remains
-- receptive at all times to event notices that are generated
-- by the Canon and mixed in with the command responses, which
-- themselves may be delayed.  Advantage is taken of the fact that
-- with the Canon one doesn't necessarily have to wait for the
-- response to one command before sending out another.  So, for
-- example, we can commence a panning and zooming operation at
-- almost the same time, and it might be on the order of seconds
-- before we receive confirmation of the newly accomplished settings.
-- We send all ``asynchronously'' received notices to the notify
-- service as events, as well as unexpected responses--see the calls
-- to the local notify routine in this program.
 
const ack_time_limit = 500;  -- ms
 
-- Low-level receiver:
const in_fd = fileno open (`exec setl vc-recv.setl', `pipe-from');
 
-- Interface to low-level sender, vc-send.setl:
const vc_send_cmd = `exec setl vc-send.setl';  -- needed for xrefs
const out_fd = fileno open (`vc-send', `pump');
 
const note_fd = fileno obtain_service (`notify');  -- event consumer
const sigterm_fd = open (`SIGTERM', `signal');
 
open (`SIGPIPE', `ignore');  -- but see put_frame
 
tie (stdinstdout);
 
loop
 
  ready := select_or_exit_on_sigterm ({stdinin_fd});
 
  if in_fd in ready then
    -- in this state, treat anything from the controller as a note
    frame := get_frame();
    if frame /= om then
      notify (frame);
    end if;
  end if;
 
  if stdin in ready then
    read (seq);  -- command packet, a map
    if eof then
      quit_gracefully;
    end if;
    time_limit := round (seq.time_limit ? 1000);
    if (cmd := seq.cmd/= om then
      response := do_cmd (cmdtime_limit);
      write (response);
    elseif (cmds := seq.cmds/= om then
      responses := do_cmds (cmdsseq.tick_mstime_limit);
      write (responses);
    else
      msg (`unrecognized seq form ' + str seq + ` ignored');
    end if;
  end if;
 
end loop;
 
proc get_frame();
  reada (in_fdframe);
  if eof then
    msg (`EOF from ' + str filename in_fd);
    quit_gracefully;
  elseif frame = `*then  -- inter-char timeout
    return frame;
  elseif frame = `+then  -- checksum error
    put_frame (unhex `8810');  -- checksum error nak
    return om;
  elseif #frame < 2 then  -- illegal 1-byte frame
    return frame;
  elseif is_ack_or_nak frame then
    return frame;
  else  -- note or response
    ack := char (16#80 bit_or (abs frame(1) bit_and 16#0f)) + `\x00';
    put_frame (ack);  -- ack it, whichever it is
    if is_note frame then
      notify (frame);
      return om;
    else
      return frame;
    end if;
  end if;
end proc get_frame;
 
proc do_cmd (cmdtime_limit);
  put_frame (cmd);
  if #cmd = 1 then
    return cmd;
  end if;
  awaiting_ack := true;
  response := om;
  deadline := clock + time_limit + 1;
  time_left := time_limit + 1;
  while time_left > 0 loop
    ready := select_or_exit_on_sigterm ({in_fd}, time_left);
    if in_fd in ready then
      frame := get_frame();
      if frame /= om then
        if #frame < 2 then  -- inter-char timeout or bad frame
          return frame;  -- abandon command; ``response'' is this frame
        elseif is_ack_or_nak frame then
          if awaiting_ack then
            if is_ack frame then
              if response /= om then
                return response;
              end if;
              awaiting_ack := false;
            else  -- abandon command; ``response'' is this nak frame
              return frame;
            end if;
          else  -- ack or nak unexpected
            notify (frame);  -- treat as note but otherwise ignore
          end if;
        else  -- other response
          if not awaiting_ack then  -- already got the ack
            return frame;  -- take this frame to be the response
          else  -- didn't get ack yet (strange but supported)
            response := frame;  -- to be returned when the ack comes
          end if;
        end if;
      end if;
    end if;
    time_left := deadline - clock;
  end loop;
  return `!';  -- our way of indicating this kind of timeout
end proc do_cmd;
 
proc do_cmds (cmdstick_mstime_limit);
  const n = #cmds;
  responses := [ ];
  timer_fd := open (str tick_ms, `real-ms');
  tick := 0;
  while #cmds > 0 loop
    [ticknumcmdfromb cmds;
    while tick < ticknum loop
      ready := select_or_exit_on_sigterm ({timer_fdin_fd});
      if timer_fd in ready then
        geta (timer_fddummy);
        tick +:= 1;
      end if;
      if in_fd in ready then
        frame := get_frame();
        if frame /= om then
          responses with:= frame;
        end if;
      end if;
    end loop;
    put_frame (cmd);
    ack_deadline := clock + ack_time_limit + 1;
    ack_time_left := ack_time_limit + 1;
    while ack_time_left > 0 loop
      -- awaiting ack
      ready := select_or_exit_on_sigterm ({in_fd}, ack_time_left);
      if in_fd in ready then
        frame := get_frame();
        if frame /= om then
          if is_ack frame then
            ack_time_left := 0;  -- got ack; quit loop
          else
            responses with:= frame;
            if is_nak frame then
              ack_time_left := 0;  -- give up waiting for ack
            end if;
          end if;
        end if;
      else
        responses with:= `@';  -- for ``ack timeout''
        ack_time_left := 0;  -- give up waiting for ack
      end if;
      if ack_time_left > 0 then
        ack_time_left := ack_deadline - clock;
      end if;
    end loop;
  end loop;
  deadline := clock + time_limit + 1;
  time_left := time_limit + 1;
  -- Now enter a final stage of just waiting up to the time limit for
  -- the number of responses to reach the original number of commands (n)
  while #responses < n and time_left > 0 loop
    ready := select_or_exit_on_sigterm ({in_fd}, time_left);
    if in_fd in ready then
      frame := get_frame();
      if frame /= om then
        responses with:= frame;
      end if;
    end if;
    time_left := deadline - clock;
  end loop;
  close (timer_fd);
  return responses;
end proc do_cmds;
 
op is_note (frame);
  return is_string frame
     and #frame >= 2
     and ((abs frame(1) bit_and 16#80) = 0)
     and ((abs frame(2) bit_and 16#20) /= 0);
end op;
 
op is_ack_or_nak (frame);
  return is_string frame
     and #frame >= 2
     and (abs frame(1) bit_and 16#80) /= 0;  -- ``frame id'' byte
end op;
 
op is_ack (frame);
  return is_ack_or_nak frame and abs frame(2) = 0;  -- ``cmd id'' byte
end op;
 
op is_nak (frame);
  return is_ack_or_nak frame and abs frame(2) /= 0;  -- ``cmd id'' byte
end op;
 
proc notify (frame);
  writea (note_fdframe);
  flush (note_fd);
end proc;
 
proc select_or_exit_on_sigterm (fdsmax_time(*));
  if #max_time = 0 then
    [ready] := select ([{sigterm_fd} + fds]);
  else
    [ready] := select ([{sigterm_fd} + fds], max_time(1));
  end if;
  if sigterm_fd in ready then
    msg (yhwh + ` (' + str pid + `) caught SIGTERM');
    quit_gracefully;
  end if;
  return ready;
end proc;
 
proc put_frame (frame);
  -- If the output operation provokes a SIGPIPE, we remain blissfully
  -- unaware of it because we have explicitly requested open to
  -- ``ignore'' that signal.  But we can detect disappearance of the
  -- sender nonetheless by checking for EOF (getline out_fd = om),
  -- because normally the sender acks our requests with at least an
  -- empty line:
  writea (out_fdframe);
  if getline out_fd = om then
    msg (str filename out_fd + ` appears to have crashed');
    quit_gracefully;
  end if;
end proc;
 
proc quit_gracefully;
  exit_gracefully ([[str filename in_fdin_fd],
                    [str filename out_fdout_fd]]);
end proc;
 
#include ``vc-obtain.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''


next up previous
Next: A.40 vc-simpler.setl Up: A. WEBeye Source Code Previous: A.38 vc-send.setl
David Bacon
1999-12-10