head     56.3;
access   paws bayes jws quist dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.54.33;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.26.32;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.10.02.23;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.37.13;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.37.51;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.36.07;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.22.15;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.20.52;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.34.43;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.18.22;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.24.57;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.11.36;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.58.46;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.06.34;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.27.15;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.17.10;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.18.00.33;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.42.12;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.12.03.16;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.48.14;  author dew;  state Exp;
branches ;
next     1.3;

1.3
date     89.09.26.15.35.14;  author dew;  state Exp;
branches ;
next     1.2;

1.2
date     89.09.14.11.20.32;  author dew;  state Exp;
branches ;
next     1.1;

1.1
date     89.09.14.10.30.25;  author dew;  state Exp;
branches ;
next     ;


desc
@Robert Quist's Generic State Machine Driver.
@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@MODULE STATE_PROCS;
{ state machine executive for machine maker 4.0 }
EXPORT
CONST
  bad_state_type  = -1;
  bad_exit_type   = -2;
  event_not_found = -3;
  too_many_calls  = -4;
  proc_escaped    = -5;
TYPE
  st_short = 0..65535;
  short_signed= -32768..32767;
  state_name_string = string[17];
  control_recp = ^control_rec;
  stack_rec    = record
		   machine : anyptr;
		   oldstate: anyptr;
		 end;
  trace_data_type = (tstate,tproc,tmachine,tevent);
  trace_data_elt = record
		     case data_type : trace_data_type of
		     tstate,
		     tevent   : (short_data : st_short);
		     tproc,
		     tmachine : (long_data  : integer);
		   end;
  trace_data_ptr = ^trace_data;
  trace_data  = array[1..maxint] of trace_data_elt;
  trace_name_elt = packed record
		     offset : st_short;
		     name : state_name_string;
		   end;
  trace_name_table_ptr = ^trace_name_table_type;
  trace_name_table_type = array[1..maxint] of trace_name_elt;
  control_ptr = ^control_rec;
  control_rec = record
		  user_space    : anyptr;
		  states        : anyptr; { state machine table }
		  current_state : st_short;  { offset into states  }
		  exit_code     : short_signed;
		  exit_extension: short_signed;
		  mdone         : boolean;
		  tactive       : boolean;
		  tremaining    : integer;
		  ttotal        : integer;
		  tdata         : trace_data_ptr;
		  max_stack     : st_short;
		  last          : st_short;
		  stack         : array[1..1] of stack_rec;
		  { this record will be allocated to contain
		    the space specified in the max_stack field
		  }
		end;
  procedure exec(cont : control_ptr);
  procedure init_exec_control(cont : control_ptr;
			      user : anyptr;
			  anyvar machine : integer;
			      stack_size : integer);
  procedure reset_exec_control(cont : control_ptr; user : anyptr);
  procedure init_trace(cont : control_ptr; size : integer; p:ANYPTR);

  procedure trace_control(cont : control_ptr; on_off : boolean);

IMPLEMENT
TYPE
  short_ap    = ^short_array;
  state_proc  = procedure(stuff:anyptr; var event:st_short);
  pairs_rec   = packed record
		  event, next : st_short;
		end;
  short_array = packed array[0..100] of st_short;
  short_pairs = packed array[0..100] of pairs_rec;
  int_array   = packed array[0..100] of integer;
  mixed_array = record
		  case integer of
		  1:(exits:short_array);
		  2:(exit_pairs:short_pairs);
		  3:(procs:int_array);
		end;
  state_ptr   = ^state_rec;
  state_rec   = packed record
		  class     : char;
		  exits_type: char;
		  case integer of
		    0:();
		    1:(nexits : char;
		       nprocs : char;
		       table  : mixed_array);
		    2:(next_s : short_signed);
		    3:(next_m : anyptr);
		    4:(next_p : integer)
		end;

  $RANGE OFF$
  procedure init_trace(cont : control_ptr; size : integer; p:anyptr);
    begin
      with cont^ do
      begin
	tactive := false;
	ttotal  := size;
	tremaining := size;
	tdata := p;
      end;
    end; { init_trace }

  procedure trace_control(cont : control_ptr; on_off : boolean);
    begin
      with cont^ do
      begin
	tactive := on_off;
	if on_off then tactive := tremaining>0;
      end;
    end; { trace_control }

  procedure init_exec_control(    cont : control_ptr;
				  user : anyptr;
			      anyvar machine : integer;
				  stack_size : integer);
    begin
      with cont^ do
      begin
	user_space := user;
	states     := addr(machine);
	current_state := 0;
	exit_code  := 0;
	exit_extension:= 0;
	mdone      := false;
	tactive    := false;    { disable tracing }
	tremaining := 0;
	max_stack  := stack_size;
	last       := 0;
      end;
    end; { init_exec_control }

  procedure reset_exec_control(cont : control_ptr; user : anyptr);
    begin
      with cont^ do
      begin
	user_space    := user;
	current_state := 0;
	exit_code     := 0;
	exit_extension:= 0;
	mdone         := false;
	tactive       := false;
	tremaining    := ttotal;
	if last<>0 then states := stack[1].machine;
	last          := 0;
      end;
    end; { reset_exec_control }

  procedure exec(cont  :control_ptr);
    const
      first_state   =  2;
    type
      intp  = ^integer;
    var
      running: boolean;
      state  : state_ptr; { also global error state offset }
      prev_state : state_ptr;
      procp  : intp;
      count  : st_short;
      event  : st_short;
      temps  : st_short;
      funny  : record
		 case integer of
		 1:(proc : state_proc);
		 2:(proca  : integer;
		    static : integer);
	       end;

      procedure do_trace(ttype:trace_data_type);
	begin
	  with cont^, tdata^[tremaining] do
	  begin
	    data_type := ttype;
	    case data_type of
	      tstate   : short_data := current_state;
	      tmachine : long_data  := ord(states);
	      tproc    : long_data  := funny.proca;
	      tevent   : short_data := event;
	      otherwise
	    end;
	    tremaining := tremaining - 1;
	    tactive := tremaining>0;
	  end;
	end; { do_trace }

      procedure shutdown(ecode:short_signed);
	var is_bad : boolean;
	begin
	  with cont^ do
	  begin
	    is_bad := true;
	    if exit_code=0 then
	      if (ecode=proc_escaped) or (ecode=event_not_found) then
	      begin
		exit_code := ecode;
		if (ecode=proc_escaped) then exit_extension := escapecode
		else
		if (ecode=event_not_found) then exit_extension := event;
		current_state := short_ap(states)^[0];
		is_bad := false;
	      end;
	    if is_bad then
	    begin
	      mdone := true; running := false; exit_code := ecode;
	    end;
	  end;
	end; { shutdown }

      procedure find_next_state;
	label  1;
	begin
	  with cont^, state^ do
	  begin
	    case exits_type of
	    #0,#1: { singles & singles_catch }
	       if event<ord(nexits) then current_state := table.exits[event]
	       else
	       { check for catch all }
	       if exits_type=#1 then current_state := table.exits[ord(nexits)-1]
				else shutdown(event_not_found);
	    #2,#3: { pairs & pairs_catch }
	       begin { event is a lookup value, convert to an index }
		 count := 0;
		 while (count<ord(nexits)) do
		 begin
		  if table.exit_pairs[count].event=event then
		  begin
		    current_state := table.exit_pairs[count].next;
		    goto 1; { stop looking }
		  end
		  else count := succ(count);
		 end;
		 { check for catch all }
		 if exits_type = #3
		   then current_state := table.exit_pairs[ord(nexits)-1].next
		   else shutdown(event_not_found);
	       1:
	       end;
	    otherwise
	      shutdown(bad_exit_type);
	    end; { case exit_type }
	  end; { with state^ }
	end; { find_next_state }

    begin { exec }
      funny.static := 0;
      running := true;
      state := nil;
      with cont^ do
      begin
	if tactive then do_trace(tmachine);
	mdone := false;
	if current_state = 0 then current_state := first_state; { skip error index }
	repeat
	  prev_state := state;
	  state := addr(intp(states)^,current_state);
	  if tactive then do_trace(tstate);
	  with state^ do
	  begin
	    case class of
	    #0:{ STANDARD }
	       begin
		 try
		   case exits_type of
		   #0,#1:procp := addr(table.exits[ord(nexits)]);
		   #2,#3:procp := addr(table.exit_pairs[ord(nexits)]);
		   otherwise
		     shutdown(bad_exit_type);
		   end;
		   count := ord(nprocs);
		   while count>0 do  { execute all the procedures }
		   begin
		     funny.proca := procp^;
		     if tactive then do_trace(tproc);
		     call(funny.proc,user_space,event);
		     if tactive then do_trace(tevent);
		     if event<>0 then count := 0
				 else begin count := count-1;
					    procp := addr(procp^,sizeof(procp^));
				      end;
		   end;
		   find_next_state;
		 recover
		   begin
		     shutdown(proc_escaped);
		   end;
	       end;
	    #1:{ MCALL }
	       if last<max_stack then
	       begin
		 last := last + 1;
		 stack[last].machine := states;
		 stack[last].oldstate:= state;
		   case exits_type of
		   #0,#1:procp := addr(table.exits[ord(nexits)]);
		   #2,#3:procp := addr(table.exit_pairs[ord(nexits)]);
		   otherwise
		     shutdown(bad_exit_type);
		   end;
		 states := anyptr(procp^);
		 state  := nil;
		 current_state := first_state;
		 if tactive then do_trace(tmachine);
	       end
	       else shutdown(too_many_calls);
	    #2:{ MEXIT }
	       if last>0 then
	       begin
		 states := stack[last].machine;
		 state  := stack[last].oldstate;
		 last   := last - 1;
		 if tactive then do_trace(tmachine);
		 find_next_state;
	       end
	       else shutdown(next_s);
	    #3:{ SUSPEND }
	       begin
		 running := false;
		 current_state := next_s;
	       end;
	    #4:{ DONE_EXIT }
	       begin
		 shutdown(next_s);
	       end;
	    otherwise
	       shutdown(bad_state_type);
	    end;
	  end;
	until not running;
      end;
    end;{ exec }
END;  { STATE_PROCS }

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 335
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 335
MODULE STATE_PROCS;
{ state machine executive for machine maker 4.0 }
EXPORT
CONST
  bad_state_type  = -1;
  bad_exit_type   = -2;
  event_not_found = -3;
  too_many_calls  = -4;
  proc_escaped    = -5;
TYPE
  st_short = 0..65535;
  short_signed= -32768..32767;
  state_name_string = string[17];
  control_recp = ^control_rec;
  stack_rec    = record
		   machine : anyptr;
		   oldstate: anyptr;
		 end;
  trace_data_type = (tstate,tproc,tmachine,tevent);
  trace_data_elt = record
		     case data_type : trace_data_type of
		     tstate,
		     tevent   : (short_data : st_short);
		     tproc,
		     tmachine : (long_data  : integer);
		   end;
  trace_data_ptr = ^trace_data;
  trace_data  = array[1..maxint] of trace_data_elt;
  trace_name_elt = packed record
		     offset : st_short;
		     name : state_name_string;
		   end;
  trace_name_table_ptr = ^trace_name_table_type;
  trace_name_table_type = array[1..maxint] of trace_name_elt;
  control_ptr = ^control_rec;
  control_rec = record
		  user_space    : anyptr;
		  states        : anyptr; { state machine table }
		  current_state : st_short;  { offset into states  }
		  exit_code     : short_signed;
		  exit_extension: short_signed;
		  mdone         : boolean;
		  tactive       : boolean;
		  tremaining    : integer;
		  ttotal        : integer;
		  tdata         : trace_data_ptr;
		  max_stack     : st_short;
		  last          : st_short;
		  stack         : array[1..1] of stack_rec;
		  { this record will be allocated to contain
		    the space specified in the max_stack field
		  }
		end;
  procedure exec(cont : control_ptr);
  procedure init_exec_control(cont : control_ptr;
			      user : anyptr;
			  anyvar machine : integer;
			      stack_size : integer);
  procedure reset_exec_control(cont : control_ptr; user : anyptr);
  procedure init_trace(cont : control_ptr; size : integer; p:ANYPTR);

  procedure trace_control(cont : control_ptr; on_off : boolean);

IMPLEMENT
TYPE
  short_ap    = ^short_array;
  state_proc  = procedure(stuff:anyptr; var event:st_short);
  pairs_rec   = packed record
		  event, next : st_short;
		end;
  short_array = packed array[0..100] of st_short;
  short_pairs = packed array[0..100] of pairs_rec;
  int_array   = packed array[0..100] of integer;
  mixed_array = record
		  case integer of
		  1:(exits:short_array);
		  2:(exit_pairs:short_pairs);
		  3:(procs:int_array);
		end;
  state_ptr   = ^state_rec;
  state_rec   = packed record
		  class     : char;
		  exits_type: char;
		  case integer of
		    0:();
		    1:(nexits : char;
		       nprocs : char;
		       table  : mixed_array);
		    2:(next_s : short_signed);
		    3:(next_m : anyptr);
		    4:(next_p : integer)
		end;

  $RANGE OFF$
  procedure init_trace(cont : control_ptr; size : integer; p:anyptr);
    begin
      with cont^ do
      begin
	tactive := false;
	ttotal  := size;
	tremaining := size;
	tdata := p;
      end;
    end; { init_trace }

  procedure trace_control(cont : control_ptr; on_off : boolean);
    begin
      with cont^ do
      begin
	tactive := on_off;
	if on_off then tactive := tremaining>0;
      end;
    end; { trace_control }

  procedure init_exec_control(    cont : control_ptr;
				  user : anyptr;
			      anyvar machine : integer;
				  stack_size : integer);
    begin
      with cont^ do
      begin
	user_space := user;
	states     := addr(machine);
	current_state := 0;
	exit_code  := 0;
	exit_extension:= 0;
	mdone      := false;
	tactive    := false;    { disable tracing }
	tremaining := 0;
	max_stack  := stack_size;
	last       := 0;
      end;
    end; { init_exec_control }

  procedure reset_exec_control(cont : control_ptr; user : anyptr);
    begin
      with cont^ do
      begin
	user_space    := user;
	current_state := 0;
	exit_code     := 0;
	exit_extension:= 0;
	mdone         := false;
	tactive       := false;
	tremaining    := ttotal;
	if last<>0 then states := stack[1].machine;
	last          := 0;
      end;
    end; { reset_exec_control }

  procedure exec(cont  :control_ptr);
    const
      first_state   =  2;
    type
      intp  = ^integer;
    var
      running: boolean;
      state  : state_ptr; { also global error state offset }
      prev_state : state_ptr;
      procp  : intp;
      count  : st_short;
      event  : st_short;
      temps  : st_short;
      funny  : record
		 case integer of
		 1:(proc : state_proc);
		 2:(proca  : integer;
		    static : integer);
	       end;

      procedure do_trace(ttype:trace_data_type);
	begin
	  with cont^, tdata^[tremaining] do
	  begin
	    data_type := ttype;
	    case data_type of
	      tstate   : short_data := current_state;
	      tmachine : long_data  := ord(states);
	      tproc    : long_data  := funny.proca;
	      tevent   : short_data := event;
	      otherwise
	    end;
	    tremaining := tremaining - 1;
	    tactive := tremaining>0;
	  end;
	end; { do_trace }

      procedure shutdown(ecode:short_signed);
	var is_bad : boolean;
	begin
	  with cont^ do
	  begin
	    is_bad := true;
	    if exit_code=0 then
	      if (ecode=proc_escaped) or (ecode=event_not_found) then
	      begin
		exit_code := ecode;
		if (ecode=proc_escaped) then exit_extension := escapecode
		else
		if (ecode=event_not_found) then exit_extension := event;
		current_state := short_ap(states)^[0];
		is_bad := false;
	      end;
	    if is_bad then
	    begin
	      mdone := true; running := false; exit_code := ecode;
	    end;
	  end;
	end; { shutdown }

      procedure find_next_state;
	label  1;
	begin
	  with cont^, state^ do
	  begin
	    case exits_type of
	    #0,#1: { singles & singles_catch }
	       if event<ord(nexits) then current_state := table.exits[event]
	       else
	       { check for catch all }
	       if exits_type=#1 then current_state := table.exits[ord(nexits)-1]
				else shutdown(event_not_found);
	    #2,#3: { pairs & pairs_catch }
	       begin { event is a lookup value, convert to an index }
		 count := 0;
		 while (count<ord(nexits)) do
		 begin
		  if table.exit_pairs[count].event=event then
		  begin
		    current_state := table.exit_pairs[count].next;
		    goto 1; { stop looking }
		  end
		  else count := succ(count);
		 end;
		 { check for catch all }
		 if exits_type = #3
		   then current_state := table.exit_pairs[ord(nexits)-1].next
		   else shutdown(event_not_found);
	       1:
	       end;
	    otherwise
	      shutdown(bad_exit_type);
	    end; { case exit_type }
	  end; { with state^ }
	end; { find_next_state }

    begin { exec }
      funny.static := 0;
      running := true;
      state := nil;
      with cont^ do
      begin
	if tactive then do_trace(tmachine);
	mdone := false;
	if current_state = 0 then current_state := first_state; { skip error index }
	repeat
	  prev_state := state;
	  state := addr(intp(states)^,current_state);
	  if tactive then do_trace(tstate);
	  with state^ do
	  begin
	    case class of
	    #0:{ STANDARD }
	       begin
		 try
		   case exits_type of
		   #0,#1:procp := addr(table.exits[ord(nexits)]);
		   #2,#3:procp := addr(table.exit_pairs[ord(nexits)]);
		   otherwise
		     shutdown(bad_exit_type);
		   end;
		   count := ord(nprocs);
		   while count>0 do  { execute all the procedures }
		   begin
		     funny.proca := procp^;
		     if tactive then do_trace(tproc);
		     call(funny.proc,user_space,event);
		     if tactive then do_trace(tevent);
		     if event<>0 then count := 0
				 else begin count := count-1;
					    procp := addr(procp^,sizeof(procp^));
				      end;
		   end;
		   find_next_state;
		 recover
		   begin
		     shutdown(proc_escaped);
		   end;
	       end;
	    #1:{ MCALL }
	       if last<max_stack then
	       begin
		 last := last + 1;
		 stack[last].machine := states;
		 stack[last].oldstate:= state;
		   case exits_type of
		   #0,#1:procp := addr(table.exits[ord(nexits)]);
		   #2,#3:procp := addr(table.exit_pairs[ord(nexits)]);
		   otherwise
		     shutdown(bad_exit_type);
		   end;
		 states := anyptr(procp^);
		 state  := nil;
		 current_state := first_state;
		 if tactive then do_trace(tmachine);
	       end
	       else shutdown(too_many_calls);
	    #2:{ MEXIT }
	       if last>0 then
	       begin
		 states := stack[last].machine;
		 state  := stack[last].oldstate;
		 last   := last - 1;
		 if tactive then do_trace(tmachine);
		 find_next_state;
	       end
	       else shutdown(next_s);
	    #3:{ SUSPEND }
	       begin
		 running := false;
		 current_state := next_s;
	       end;
	    #4:{ DONE_EXIT }
	       begin
		 shutdown(next_s);
	       end;
	    otherwise
	       shutdown(bad_state_type);
	    end;
	  end;
	until not running;
      end;
    end;{ exec }
END;  { STATE_PROCS }

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


1.3
log
@
pws2rcs automatic delta on Tue Sep 26 14:31:31 MDT 1989
@
text
@@


1.2
log
@ST_PROCS updated for MAKER4.
@
text
@d60 1
a60 1
  procedure init_trace(cont : control_ptr; size : integer, p:ANYPTR);
d334 1
a334 1
END.  { STATE_PROCS }
@


1.1
log
@Initial revision
@
text
@d2 1
a2 2
{ state machine executive for machine maker 3.0 }
{IMPORT ASM;}
a9 1
  bad_recycle     = -6;
d55 4
a58 4
  procedure init_exec_control(    cont : control_ptr;
				  user : anyptr;
			      anyvar machine : integer;
				  stack_size:integer);
d60 2
a61 1
  procedure init_trace(cont : control_ptr; size : integer);
d95 1
a95 1
  procedure init_trace(cont : control_ptr; size : integer);
d102 1
a102 2
	if size = 0 then
		     tdata := nil;
d115 2
a116 2
  procedure init_exec_control(cont : control_ptr;
			      user : anyptr;
d118 1
a118 1
			      stack_size:integer);
d128 2
d237 2
a238 6
		   then
		     current_state := table.exit_pairs[ord(nexits)-1].next
		   else
		   begin
		     shutdown(event_not_found);
		   end;
d318 1
a318 1
	    #3:{ RECYCLE_EVENT }
a319 18
		 funny.proca := next_p;
		 if tactive then do_trace(tproc);
		 try
		   call(funny.proc,user_space,event);
		   if tactive then do_trace(tevent);
		   if prev_state = nil then shutdown(bad_recycle)
		   else
		   begin
		     state := prev_state;
		     find_next_state;
		   end;
		 recover
		   begin
		     shutdown(proc_escaped);
		   end;
	       end;
	    #4:{ SUSPEND }
	       begin
d323 1
a323 1
	    #5:{ DONE_EXIT }
d334 2
a335 1
END;  { MODULE STATE_PROCS }
@
