% Revised: 1994-04-07/PH+GE Fixed error in ContinueLookUp, now starts 
%                           searching in block above the block where 
%                           LookUpDeclaration found a declaration
Simset class SymbolTable;
   hidden protected intCurrentBlock,intConnectedBlock,intDeclPtr,
                    BlockNotice,DeclarationNotice,FunctionDeclarationNotice,
                    UserError, intFuncNameBlock;
begin
   procedure EnterBlock(BlockInfo); ref(BlockDescription) BlockInfo;
      ! Create a new block;
   begin
      ref(BlockNotice) newBlock;
      ref(DeclarationNotice) D;
      if BlockInfo==none then
         Error("EnterBlock: BlockInfo==none");
      newBlock :- new BlockNotice(intCurrentBlock,CurrentLevel+1,BlockInfo);
      newBlock.Into(intCurrentBlock.SubBlocks);
      D :- intCurrentBlock.Declarations.Last;
      while D=/=none and then not
            (D is FunctionDeclarationNotice and then
             D qua FunctionDeclarationNotice.ConnectedBlock==none) do
         D :- D.Pred;
      inspect D when FunctionDeclarationNotice do
         if ConnectedBlock==none then
            ConnectedBlock :- newBlock;
      intCurrentBlock :- newBlock;
   end;
   
   procedure ExitBlock;
      ! Exit the current block, return to static father;
   begin
      if intCurrentBlock==none then
         Error("ExitBlock: no corresponding EnterBlock");
      intCurrentBlock :- intCurrentBlock.StaticFather;
   end;
   
   procedure DeclareVariable(Variable); ref(VariableDescription) Variable;
      ! Declare a variable (parameter or local) in the current block;
   begin
      ref(DeclarationNotice) D;
      if CurrentLevel=0 then
         Error("DeclareVariable: must call EnterBlock first")
      else if Variable==none then
         Error("DeclareVariable: Variable==none")
      else if Variable.GetVarName==notext then
         Error("DeclareVariable: Variable.VarName==notext");
      D :- new DeclarationNotice(Variable,intCurrentBlock);
      D.Into(intCurrentBlock.Declarations);
   end;
   
   procedure DeclareFunction(Variable); ref(VariableDescription) Variable;
      ! Declare a function in the current block;
   begin
      ref(DeclarationNotice) D;
      if CurrentLevel=0 then
         Error("DeclareFunction: must call EnterBlock first")
      else if Variable==none then
         Error("DeclareFunction: Variable==none")
      else if Variable.GetVarName==notext then
         Error("DeclareFunction: Variable.VarName==notext");
      D :- new FunctionDeclarationNotice(Variable,intCurrentBlock);
      D.Into(intCurrentBlock.Declarations);
   end;
   
   boolean procedure AlreadyDeclared(VarName); text VarName;
      ! True if a variable/function with name VarName already is
      ! declared in the current block;
   begin
      ref(DeclarationNotice) D;
      if CurrentLevel=0 then
         Error("AlreadyDeclared: must call EnterBlock first")
      else if VarName==notext then
         Error("AlreadyDeclared: VarName==notext");
      D :- intCurrentBlock.Declarations.First;
      while D=/=none and then not D.myVariable.GetVarName=VarName do
         D :- D.Suc;
      AlreadyDeclared := D=/=none;
   end;
   
   ref(VariableDescription) procedure LookUpDeclaration
      (VarName,BlockInfo,ConnectedBlock);
      name BlockInfo,ConnectedBlock;
      text VarName; ref(BlockDescription) BlockInfo,ConnectedBlock;
      ! Search the static chain of blocks for a variable/function with name
      ! VarName. Returns a pointer to the VariableDescription or none.
      ! BlockInfo=the BlockDescription of the block where the variable
      ! is declared.
      ! ConnectedBlock=the BlockDescription of the function block, if VarName
      ! is a function. Then, the next call to FirstDeclaration will yield a
      ! pointer to the first declaration in the function block;
   begin
      ref(BlockNotice) B;
      ref(DeclarationNotice) D;
      if CurrentLevel=0 then
         Error("LookUpDeclaration: must call EnterBlock first")
      else if VarName==notext then
         Error("LookUpDeclaration: VarName==notext");
      B :- intCurrentBlock;
      while B.StaticFather=/=none and then D==none do
      begin
         D :- B.Declarations.First;
         while D=/=none and then not D.myVariable.GetVarName=VarName do
            D :- D.Suc;
         if D==none then
            B :- B.StaticFather;
      end;
      if D=/=none then
      begin
      	intFuncNameBlock :- B;
         LookUpDeclaration :- D.myVariable;
         BlockInfo :- D.myBlock.BlockInfo;
         if D is FunctionDeclarationNotice then
         begin
            intConnectedBlock :- D qua FunctionDeclarationNotice.ConnectedBlock;
            ConnectedBlock :- intConnectedBlock.BlockInfo;
         end
      end
      else
      begin
         BlockInfo :- none;
         intConnectedBlock :- none;
         ConnectedBlock :- none;
      end;
   end;
   
   ref(VariableDescription) procedure ContinueLookUp
      (VarName,BlockInfo,ConnectedBlock);
      name BlockInfo,ConnectedBlock;
      text VarName; ref(BlockDescription) BlockInfo,ConnectedBlock;
      ! As LookUpDeclaration but startes search in the static father;
   begin
      ref(BlockNotice) B;
      ref(DeclarationNotice) D;
      if CurrentLevel=0 then
         Error("ContinueLookUp: must call EnterBlock first")
      else if VarName==notext then
         Error("ContinueLookUp: VarName==notext")
      else if intFuncNameBLock==none then
         Error("ContinueLookUp: must call LookupDeclaration first");
      B :- intFuncNameBlock.StaticFather;
      if B==none then
         Error("ContinueLookUp: already in outermost block");
      while B.StaticFather=/=none and then D==none do
      begin
         D :- B.Declarations.First;
         while D=/=none and then not D.myVariable.GetVarName=VarName do
            D :- D.Suc;
         if D==none then
            B :- B.StaticFather;
      end;
      if D=/=none then
      begin
         ContinueLookUp :- D.myVariable;
         BlockInfo :- D.myBlock.BlockInfo;
         if D is FunctionDeclarationNotice then
         begin
            intConnectedBlock :- D qua FunctionDeclarationNotice.ConnectedBlock;
            ConnectedBlock :- intConnectedBlock.BlockInfo;
         end
      end
      else
      begin
         BlockInfo :- none;
         intConnectedBlock :- none;
         ConnectedBlock :- none;
      end;
      intFuncNameBLock :- none;
   end;
   
   ref(VariableDescription) procedure FirstDeclaration;
      ! Return a pointer to the first declaration in the present ConnectedBlock;
   begin
      if CurrentLevel=0 then
         Error("FirstDeclaration: must call EnterBlock first")
      else if intConnectedBlock==none then
         Error("FirstDeclaration: must call LookUpDeclaration and find a function");
      intDeclPtr :- intConnectedBlock.Declarations.First;
      if intDeclPtr=/=none then
         FirstDeclaration :- intDeclPtr.myVariable;
   end;
   
   ref(VariableDescription) procedure NextDeclaration;
      ! Return next declaration in the ConnectedBlock;
   begin
      if CurrentLevel=0 then
         Error("NextDeclaration: must call EnterBlock first")
      else if IntDeclPtr==none Then
			Begin
%         Error("NextDeclaration: no more declarations")
! patched 970601 StefanZ
          NextDeclaration :- none;
			End
      else
      begin
         intDeclPtr :- intDeclPtr.Suc;
         if intDeclPtr=/=none then
            NextDeclaration :- intDeclPtr.myVariable;
      end;
   end;
   
   integer procedure CurrentLevel;
      ! The current static level;
   begin
      CurrentLevel := intCurrentBlock.StaticLevel;
   end;
   
   ref(BlockDescription) procedure CurrentBlock;
      ! The BlockDescription of the current block;
   begin
      if CurrentLevel=0 then
         Error("CurrentBlock: must call EnterBlock first");
      CurrentBlock :- intCurrentBlock.BlockInfo;
   end;

   procedure PrintTable;
   begin
      intRoot.Print;
   end;

!------------------------------------------------------------------------------;
!           I N T E R N A L S                                                  ;
!------------------------------------------------------------------------------;

   procedure UserError(Message); text Message;
   begin
      Error("SYMBOLTABLE FATAL ERROR: "&Message);
   !  Outimage;
   !  Outtext(Message); Outimage;
   !  Terminate_program;
   end;
   
   ref(BlockNotice) intRoot,intCurrentBlock,intConnectedBlock;
   ref(DeclarationNotice) intDeclPtr;
   ref(BlockNotice) intFuncNameBLock;
   
   Link class BlockNotice(StaticFather,StaticLevel,BlockInfo);
      ref(BlockNotice) StaticFather; integer StaticLevel;
      ref(BlockDescription) BlockInfo;
   begin
      ref(Head) SubBlocks;
      ref(Head) Declarations;
      procedure Print;
      begin
         ref(DeclarationNotice) DN;
         ref(BlockNotice) BN;
         DN :- Declarations.First;
         while DN=/=none do
         begin
            DN.myVariable.Print;
            DN :- DN.Suc;
         end;
         Outimage;
         BN :- SubBlocks.First;
         while BN=/=none do
         begin
            BN.BlockInfo.Print;
            BN.Print;
            BN :- BN.Suc;
         end;
      end;
      SubBlocks :- new Head;
      Declarations :- new Head;
   end;
   
   Link class DeclarationNotice(myVariable,myBLock);
      ref(VariableDescription) myVariable; ref(BlockNotice) myBlock;
   begin
   end;
   
   DeclarationNotice class FunctionDeclarationNotice;
   begin
      ref(BlockNotice) ConnectedBlock;
   end;
	
   ref(Head) StatusList;
   link class StatusElement(P); ref(DeclarationNotice) P;
   begin
      into(StatusList);
   end;
   procedure PushStatus;
      new StatusElement(IntDeclPtr);

   procedure PopStatus;
   begin
      ref(StatusElement) E;
      E:-StatusList.Last;
      E.out;
      IntDeclPtr:-E.P;
   end;
   StatusList:-new Head;   
   intRoot :- intCurrentBlock :- new BlockNotice(none,0,new BlockDescription);
end;

class BlockDescription;
   virtual : procedure Print is procedure Print;;
   ! Contains the user data describing a block;
begin
   procedure Print;
   begin
      Outtext("Block");
      Outimage;
   end;
end;

class VariableDescription(VarName); value VarName; text VarName;
 !  hidden protected VarName;
   virtual : procedure Print is procedure Print;;
   ! Contains the user data describing a variable;
begin
   procedure Print;
   begin
      Outtext("   "); Outtext(VarName);
   end;
   text procedure GetVarName;
   begin
      GetVarName :- VarName;
   end;

end;