-- for activations (i.e., activation records)

with TEXT_IO;   use TEXT_IO;
with FUNCT;     use FUNCT;

package body environment_pkg is

-- in this constructor the
-- access & control fields handled by environment's PUSH function
-- actuals field by environment's BIND function

function build_activation(f:function_ptr) return activation_ptr is
i:integer;
a:activation_ptr:=new activation;
begin
  a.name:=f.name;
  a.actuals:=new list_of_offsets;
  a.functs:=f.subroutines;
  return a;
end build_activation;


-- for environments

-- look up a function symbol in the environment given a pair
--   (i,j) of integers by following the access link i times
--   and looking in position j in the resulting activation record.

function get_function(e:environment_ptr; o:offset_ptr) return function_ptr is
a:activation_ptr:=e.first;
begin
  for ii in 1..get_first(o) loop
    a:=a.access_ptr;
  end loop;
  return get_funct(a.functs,get_second(o));
end get_function;


-- return the (run-time) value stored at a given offset
-- note that by assumption the new activation record has already
--   been pushed onto the stack when this function is called,
--   so that the first activation record checked is first.control

function eval(e:environment_ptr; o:offset_ptr) return offset_ptr is
a:activation_ptr:=e.first.control_ptr;
begin
  if get_first(o)=CONST_FLAG then
    return o;
  end if;
  for ii in 1..get_first(o) loop
    a:=a.access_ptr;
  end loop;
  return get_offsets(a.actuals,get_second(o));
end eval;


-- remove an activation record from the environment

procedure pop(e:environment_ptr) is
begin
  e.first:=e.first.control_ptr;
end pop;


-- add a given activation record to the environment.  The integer
--   argument tells how far back to point the access link of the
--   new activation record

procedure push(e:environment_ptr;
               a:activation_ptr; i:integer) is
temp:activation_ptr:=e.first;
begin
  for ii in 1..i loop
    temp:=temp.access_ptr;
  end loop;
  a.access_ptr:=temp;
  a.control_ptr:=e.first;
  e.first:=a;
end push;



-- Initializes lists of actual parameters.  Note that the "actuals"
--   field contains the entire the function call, so it has one extra
--   initial element -- the function name

procedure bind(e:environment_ptr; call:list_of_offsets_ptr;
               actuals:list_of_offsets_ptr) is
o:offset_ptr;
arity:integer:=-1+get_size(call);
begin
  for i in 0..arity-1 loop
    o:=eval(e,get_offsets(call,i+1));
    print_offset(o);
    PUT(' ');
    insert(actuals,o);
  end loop;
  NEW_LINE;
end bind;


-- Simulate execution of a function, given an environment and a call
--   to the function.
-- Do so by stepping through each instruction of the body in turn,
--   construcing a new activation record for the function call
--   that the instruction represents, pushing it onto the environment,
--   and looking the name of the new function call and the name of
--   each of its parameters up in this environment.  Finally, simulate
--   recursively the execution of this new function.  Recall that we
--   are not assuming any constants in this (unrealistically) simple
--   programming language.
-- It is assumed that the activation record for the function to be
--   run has already been pushed onto the environment, but that the
--   bindings of formals to actuals have not been made.

procedure run(e:environment_ptr;
              call:list_of_offsets_ptr; f:function_ptr) is
a:activation_ptr;
code:list_of_encodings_ptr;
ff:function_ptr;
i,j:integer;
new_call:list_of_offsets_ptr;
begin
  bind(e,call,e.first.actuals);
  code:=f.code;
  for i in 0..get_size(code)-1 loop
    new_call:=get_code(code,i);    -- get the ith instr. of the body
    ff:=get_function(e,get_offsets(new_call,0));
    a:=build_activation(ff);
    push(e,a,get_first(get_offsets(new_call,0)));
    run(e,new_call,ff);            --   and execute it
  end loop;
  pop(e);
end run;


-- run a top-level function by constructing an (encoded) call and
--   an appropriate environment, and passing them to the general version
--   of "run"
-- Note that the initial environment already has a dummy activation
--   record on it.

procedure run(e:environment_ptr; f:function_ptr) is
call:list_of_offsets_ptr:=new list_of_offsets;
o:offset_ptr:=new offset'(0,0);
a:activation_ptr:=build_activation(f);
begin
  insert(call,o);                            -- get function name
  for i in 0..get_size(f.parameter)-1 loop   --   and parameters
    o:=new offset'(CONST_FLAG,i);
    insert(call,o);
  end loop;
  bind(e,call,a.actuals);              -- bind formals to actuals
  push(e,a,0);                         --   push onto environment
  run(e,call,f);                       --   and execute  
end run;

end environment_pkg;