{.pa}
{**************************** procedure BuildTree ***************************}

procedure BuildTree(var Tree       :TreePointer;
                        Key        :IdentType;
                        LengthWord,
                        LNumber    :Index;
                    var Status     :Info         );

{ This driver procedure will determine if a word is a reserved word by running
  a BinarySearch.  If not reserved, then it will be inserted into the tree by
  running InsertTree.  During insertion, if the word is new to the tree it
  will be put on to a node, otherwise it will run EnQueue to put the line
  number into a queue.  The variables Reserved, Key, LengthWord, LNumber, &
  Status are used as globals within this procedure. }

var
   TestKey :RWord;                       { test key for binary search.       }
   UpKey   :IdentType;                   { upper case version of identifier. }
   J       :Index;                       { loop index.                       }
   Found   :boolean;                     { has a reserved word been found.   }

   {************************* function BinarySearch *************************}

   function BinarySearch (TestKey :RWord):boolean;

   { This function will check if a word is a reserved or a semi-reserved word.
     A true boolean flag (BinarySearch) will be returned if there is an
     occurance, otherwise false. }

   var
      Found :boolean;                               { found match         }
      Mid,                                          { median of list      }
      Low,                                          { lower bound of list }
      High  :Index;                                 { upper bound of list }

   begin
      Low := 1;                                    { set lower bound }
      High := MaxReservedWords;                    { set upper bound }
      Found := false;
      while (Low <= High) and (not Found) do       { binary search loop }
         begin
            Mid := (Low + High) div 2;
            if TestKey = Reserved[Mid] then
               begin
                  Found := true;
                  Status.UsedReserved[Mid] := Status.UsedReserved[Mid] + 1;
               end
            else
               if TestKey < Reserved[Mid] then
                  High := Mid - 1
               else
                  Low := Mid + 1
         end;  { while }
      BinarySearch := Found                      { return result of search }
   end;   { function BinarySearch }

   {**************************** procedure EnQueue ***************************}

   procedure EnQueue(var Entry   :EntryType);

   { This procedure will add a line number to the queue. }

   var
      NewPointer :QueuePointer;                  { new node of queue }

   begin
      new(NewPointer);                           { allocate space in queue }
      NewPointer^.LineNumber := LNumber;
      NewPointer^.Next := nil;
      if Entry.Head = nil then
         begin                                   { queue is empty }
            Entry.Head := NewPointer;
            Entry.Tail := NewPointer
         end
      else
         begin                                    { store line number in  }
            Entry.Tail^.Next := NewPointer;       { queue                 }
            Entry.Tail := NewPointer
         end
   end;  { procedure EnQueue }

   {************************** procedure InsertTree **************************}

   procedure InsertTree (var Tree :TreePointer);

   { This procedure will insert an identifier into the tree.  If the
     identifier already exists, then the its line number will be enqueued. }

   begin
      if Tree = nil then
         begin
            new(Tree);                          { start new node of tree }
            with Tree^ do
               begin
                  Status.DifferentIdents := Status.DifferentIdents + 1;
                  Left := nil;                  { initialize sub-node    }
                  Right := nil;                 { initialize sub-node    }
                  Entry.Ident := Key;           { unchanged identifier   }
                  Entry.UpIdent := UpKey;       { upper case Ident       }
                  Entry.Head := nil;            { initialize queue head  }
                  Entry.Tail := nil;            { initialize queue tail  }
                  EnQueue (Entry);
               end;
         end  { if Tree = nil }
      else
         with Tree^ do
            if UpKey < Entry.UpIdent then
               InsertTree (Left)                 { go to left node of tree }
            else
               if UpKey > Entry.UpIdent then
                  InsertTree (Right)             { go to right node of tree }
               else
                  EnQueue (Entry)                { duplicate Key }
   end;  { procedure InsertTree }

{****************************** procedure EnterTree **************************}

begin
   for J := 1 to MaxIdentLength do               { convert to upper case }
      UpKey[J] := upcase(Key[J]);

   if LengthWord <= MaxReservedLength then     { word can't be reserved if it }
                                               { is longer than max. reserved }
      begin
         for J := 1 to MaxReservedLength do
            TestKey[J] := UpKey[J];
         Found:=BinarySearch (TestKey);        { determine if reserved }
      end
   else
      Found := false;
   if not Found then
      begin
         Status.TotalIdents := Status.TotalIdents + 1;   { total idents }
         InsertTree (Tree)                        { insert ident into tree }
      end
   else
      Status.TotalReserved := Status.TotalReserved + 1
end;  { procedure EnterTree }
{.pa}
{************************* procedure FindWord *******************************}

procedure FindWord(    LText  :LineType;
                       Number :Index;
                   var State  :Condition;
                   var Tree   :TreePointer;
                   var Status :Info         );

{ This procedure will pick out words from a line of text.  Only words
  containing alphabet, numbers or underscore characters will be taken; then
  call a function SearchLine to see if it already occurs on the current line.}

var
   I,J,K        :Index;                      { array index's.             }
   Word         :IdentType;                  { word built by program.     }
   Ch           :char;                       { character of LINETEXT.     }
   Comment,                                  { the start of a comment?    }
   FoundWord    :boolean;                    { has a word been created?   }
   Line         :WordType;                   { line of input file.        }

begin
   for K := 1 to MaxIdentLength do
      Word[K] := ' ';                        { init. WORD array to blanks }
      J := 1;                                { index of WORD array.       }
      I := 0;                                { index of LINE array.       }
      FoundWord := false;
      Line := LText.Line;                    { line of input file.   }
   while I < LText.Len do                    { scan through line of text  }
      begin
         I := I + 1;                         { increment index of LINE array }
         Ch   := Line[I];                    { assign one char }
         if (State = CCopy) and (J = 1) and (Ch in Alpha) then { char is valid }
            begin
               Word[1] := Ch;
               K := I;                        { start index of word }
               I := I + 1;
               while (I <= LText.Len) and  { build word to MaxIdentLength }
                     (Line[I] in AlphaNumeric) and
                     (J < MaxIdentLength) do
                  begin
                     J := J + 1;
                     Word[J] := Line[I];
                     I := I + 1;
                  end;
               while (I < LText.Len) and  { get rid of excess word }
                     (Line[I] in AlphaNumeric) do
                  I := I + 1;
               Status.AvgIdentLength := Status.AvgIdentLength + (I-K);
               FoundWord := true;               { word has been found }
               BuildTree(Tree,Word,J,Number,Status);
               for K := 1 to J do
                  Word[K] := ' ';
               J := 1                           { start next word. }
            end  { if -- then }
         else
            begin
               Comment := (Ch = '{') or ((Ch = '(') and (Line[I+1] = '*'));
               if (State = SkipComment) or Comment then
                  begin
                     if Comment then
                        begin
                           Status.Comments := Status.Comments + 1;
                           State           := SkipComment;
                        end;
                     while (State = SkipComment) and { get rid of comments }
                           (I < LText.Len) do
                        begin
                           I := I + 1;
                           if Line[I] = '}' then
                              State := CCopy;
                           if I+1 <= LText.Len then
                              if (Line[I] = '*') and (Line[I+1] = ')') then
                                 State := CCopy;
                        end;   { while }
                  end;
               if (State = SkipString) or
                  (Ch = '''')          then
                  repeat                         { get rid of strings }
                     I := I + 1;
                     if Line[I] = '''' then
                        State := CCopy
                     else
                        State := SkipString
                  until (State = CCopy) or (I = LText.Len)
            end;   { else }
      end;  { while }
   if not FoundWord then
      Status.CommentLines := Status.CommentLines + 1  { count comment lines }
end; { procedure FindWord }