-- Get the next token from the input stream and assign it to the
--   global variable "token".
-- Note that a delimiter symbols will be read at the end of each
--   token and discarded; this is ok since the symbol cannot belong
--   to the next token.
-- An auxilary function LEGAL_CHARACTER is used to check for delimiters
--   and an auxiliary procedure MY_GET handles peculiarities of GET
--   regarding end of line and end of file.


procedure GetToken(ifs:FILE_TYPE) is
c:character;

  function legal_character(c:character) return BOOLEAN is
  begin
    return character'pos(c) in 33..127;
  end legal_character;

  procedure my_get(ifs:FILE_TYPE; c:in out character) is
  begin
    if end_of_line(ifs) then
       skip_line(ifs);
       c:=' ';
    else
       GET(ifs,c);
    end if;
  end my_get;

begin -- GetToken
  token.name:=(others=>' ');
  loop
    MY_GET(ifs,c);
    if legal_character(c) then
      token.name(1):=c;
      token.length:=1;
      if end_of_file(ifs) then
        return;
      end if;
      MY_GET(ifs,c);
      exit;
    end if;
  end loop;
  for i in 2..token_size loop
    if end_of_file(ifs) then
      exit;
    elsif not legal_character(c) then
      exit;
    else
      token.name(i):=c;
      token.length:=i;
      MY_GET(ifs,c);
    end if;
  end loop;
  PUT_LINE(token.name(1..token_size));
end;


-- Determine whether the input string "w" represents a reserved word

function reserved(w:symbol_type_ptr) return BOOLEAN is
begin
  if equal(w,begin_token) then
    return TRUE;
  elsif equal(w,end_token) then
    return TRUE;
  elsif equal(w,call_token) then
    return TRUE;
  elsif equal(w,function_token) then
    return TRUE;
  elsif equal(w,period_token) then
    return TRUE;
  else
    return FALSE;
  end if;
end reserved;


-- This initialization procedure gives the correct values to the
--   reserved word symbols, and creates the initial activation
--   and environment

procedure initialize is
begin
  call_token:=new symbol_type;
  call_token.length:=4;
  call_token.name(1..call_token.length):="call";
  begin_token:=new symbol_type;
  begin_token.length:=5;
  begin_token.name(1..begin_token.length):="begin";
  end_token:=new symbol_type;
  end_token.length:=3;
  end_token.name(1..end_token.length):="end";
  function_token:=new symbol_type;
  function_token.length:=8;
  function_token.name(1..function_token.length):="function";
  period_token:=new symbol_type;
  period_token.length:=1;
  period_token.name(1..period_token.length):=".";
  s:=new symbol_type;
  s.length:=5;
  s.name(1..s.length):="dummy";
  a:=new activation'(s,NULL,NULL,NULL,NULL);
  e:=new environment'(first=>a);
end;