home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / CROSSREF.ARK / CR-M01.INC < prev    next >
Text File  |  1987-04-18  |  10KB  |  230 lines
  1. {.pa}
  2. {**************************** procedure BuildTree ***************************}
  3.  
  4. procedure BuildTree(var Tree       :TreePointer;
  5.                         Key        :IdentType;
  6.                         LengthWord,
  7.                         LNumber    :Index;
  8.                     var Status     :Info         );
  9.  
  10. { This driver procedure will determine if a word is a reserved word by running
  11.   a BinarySearch.  If not reserved, then it will be inserted into the tree by
  12.   running InsertTree.  During insertion, if the word is new to the tree it
  13.   will be put on to a node, otherwise it will run EnQueue to put the line
  14.   number into a queue.  The variables Reserved, Key, LengthWord, LNumber, &
  15.   Status are used as globals within this procedure. }
  16.  
  17. var
  18.    TestKey :RWord;                       { test key for binary search.       }
  19.    UpKey   :IdentType;                   { upper case version of identifier. }
  20.    J       :Index;                       { loop index.                       }
  21.    Found   :boolean;                     { has a reserved word been found.   }
  22.  
  23.    {************************* function BinarySearch *************************}
  24.  
  25.    function BinarySearch (TestKey :RWord):boolean;
  26.  
  27.    { This function will check if a word is a reserved or a semi-reserved word.
  28.      A true boolean flag (BinarySearch) will be returned if there is an
  29.      occurance, otherwise false. }
  30.  
  31.    var
  32.       Found :boolean;                               { found match         }
  33.       Mid,                                          { median of list      }
  34.       Low,                                          { lower bound of list }
  35.       High  :Index;                                 { upper bound of list }
  36.  
  37.    begin
  38.       Low := 1;                                    { set lower bound }
  39.       High := MaxReservedWords;                    { set upper bound }
  40.       Found := false;
  41.       while (Low <= High) and (not Found) do       { binary search loop }
  42.          begin
  43.             Mid := (Low + High) div 2;
  44.             if TestKey = Reserved[Mid] then
  45.                begin
  46.                   Found := true;
  47.                   Status.UsedReserved[Mid] := Status.UsedReserved[Mid] + 1;
  48.                end
  49.             else
  50.                if TestKey < Reserved[Mid] then
  51.                   High := Mid - 1
  52.                else
  53.                   Low := Mid + 1
  54.          end;  { while }
  55.       BinarySearch := Found                      { return result of search }
  56.    end;   { function BinarySearch }
  57.  
  58.    {**************************** procedure EnQueue ***************************}
  59.  
  60.    procedure EnQueue(var Entry   :EntryType);
  61.  
  62.    { This procedure will add a line number to the queue. }
  63.  
  64.    var
  65.       NewPointer :QueuePointer;                  { new node of queue }
  66.  
  67.    begin
  68.       new(NewPointer);                           { allocate space in queue }
  69.       NewPointer^.LineNumber := LNumber;
  70.       NewPointer^.Next := nil;
  71.       if Entry.Head = nil then
  72.          begin                                   { queue is empty }
  73.             Entry.Head := NewPointer;
  74.             Entry.Tail := NewPointer
  75.          end
  76.       else
  77.          begin                                    { store line number in  }
  78.             Entry.Tail^.Next := NewPointer;       { queue                 }
  79.             Entry.Tail := NewPointer
  80.          end
  81.    end;  { procedure EnQueue }
  82.  
  83.    {************************** procedure InsertTree **************************}
  84.  
  85.    procedure InsertTree (var Tree :TreePointer);
  86.  
  87.    { This procedure will insert an identifier into the tree.  If the
  88.      identifier already exists, then the its line number will be enqueued. }
  89.  
  90.    begin
  91.       if Tree = nil then
  92.          begin
  93.             new(Tree);                          { start new node of tree }
  94.             with Tree^ do
  95.                begin
  96.                   Status.DifferentIdents := Status.DifferentIdents + 1;
  97.                   Left := nil;                  { initialize sub-node    }
  98.                   Right := nil;                 { initialize sub-node    }
  99.                   Entry.Ident := Key;           { unchanged identifier   }
  100.                   Entry.UpIdent := UpKey;       { upper case Ident       }
  101.                   Entry.Head := nil;            { initialize queue head  }
  102.                   Entry.Tail := nil;            { initialize queue tail  }
  103.                   EnQueue (Entry);
  104.                end;
  105.          end  { if Tree = nil }
  106.       else
  107.          with Tree^ do
  108.             if UpKey < Entry.UpIdent then
  109.                InsertTree (Left)                 { go to left node of tree }
  110.             else
  111.                if UpKey > Entry.UpIdent then
  112.                   InsertTree (Right)             { go to right node of tree }
  113.                else
  114.                   EnQueue (Entry)                { duplicate Key }
  115.    end;  { procedure InsertTree }
  116.  
  117. {****************************** procedure EnterTree **************************}
  118.  
  119. begin
  120.    for J := 1 to MaxIdentLength do               { convert to upper case }
  121.       UpKey[J] := upcase(Key[J]);
  122.  
  123.    if LengthWord <= MaxReservedLength then     { word can't be reserved if it }
  124.                                                { is longer than max. reserved }
  125.       begin
  126.          for J := 1 to MaxReservedLength do
  127.             TestKey[J] := UpKey[J];
  128.          Found:=BinarySearch (TestKey);        { determine if reserved }
  129.       end
  130.    else
  131.       Found := false;
  132.    if not Found then
  133.       begin
  134.          Status.TotalIdents := Status.TotalIdents + 1;   { total idents }
  135.          InsertTree (Tree)                        { insert ident into tree }
  136.       end
  137.    else
  138.       Status.TotalReserved := Status.TotalReserved + 1
  139. end;  { procedure EnterTree }
  140. {.pa}
  141. {************************* procedure FindWord *******************************}
  142.  
  143. procedure FindWord(    LText  :LineType;
  144.                        Number :Index;
  145.                    var State  :Condition;
  146.                    var Tree   :TreePointer;
  147.                    var Status :Info         );
  148.  
  149. { This procedure will pick out words from a line of text.  Only words
  150.   containing alphabet, numbers or underscore characters will be taken; then
  151.   call a function SearchLine to see if it already occurs on the current line.}
  152.  
  153. var
  154.    I,J,K        :Index;                      { array index's.             }
  155.    Word         :IdentType;                  { word built by program.     }
  156.    Ch           :char;                       { character of LINETEXT.     }
  157.    Comment,                                  { the start of a comment?    }
  158.    FoundWord    :boolean;                    { has a word been created?   }
  159.    Line         :WordType;                   { line of input file.        }
  160.  
  161. begin
  162.    for K := 1 to MaxIdentLength do
  163.       Word[K] := ' ';                        { init. WORD array to blanks }
  164.       J := 1;                                { index of WORD array.       }
  165.       I := 0;                                { index of LINE array.       }
  166.       FoundWord := false;
  167.       Line := LText.Line;                    { line of input file.   }
  168.    while I < LText.Len do                    { scan through line of text  }
  169.       begin
  170.          I := I + 1;                         { increment index of LINE array }
  171.          Ch   := Line[I];                    { assign one char }
  172.          if (State = CCopy) and (J = 1) and (Ch in Alpha) then { char is valid }
  173.             begin
  174.                Word[1] := Ch;
  175.                K := I;                        { start index of word }
  176.                I := I + 1;
  177.                while (I <= LText.Len) and  { build word to MaxIdentLength }
  178.                      (Line[I] in AlphaNumeric) and
  179.                      (J < MaxIdentLength) do
  180.                   begin
  181.                      J := J + 1;
  182.                      Word[J] := Line[I];
  183.                      I := I + 1;
  184.                   end;
  185.                while (I < LText.Len) and  { get rid of excess word }
  186.                      (Line[I] in AlphaNumeric) do
  187.                   I := I + 1;
  188.                Status.AvgIdentLength := Status.AvgIdentLength + (I-K);
  189.                FoundWord := true;               { word has been found }
  190.                BuildTree(Tree,Word,J,Number,Status);
  191.                for K := 1 to J do
  192.                   Word[K] := ' ';
  193.                J := 1                           { start next word. }
  194.             end  { if -- then }
  195.          else
  196.             begin
  197.                Comment := (Ch = '{') or ((Ch = '(') and (Line[I+1] = '*'));
  198.                if (State = SkipComment) or Comment then
  199.                   begin
  200.                      if Comment then
  201.                         begin
  202.                            Status.Comments := Status.Comments + 1;
  203.                            State           := SkipComment;
  204.                         end;
  205.                      while (State = SkipComment) and { get rid of comments }
  206.                            (I < LText.Len) do
  207.                         begin
  208.                            I := I + 1;
  209.                            if Line[I] = '}' then
  210.                               State := CCopy;
  211.                            if I+1 <= LText.Len then
  212.                               if (Line[I] = '*') and (Line[I+1] = ')') then
  213.                                  State := CCopy;
  214.                         end;   { while }
  215.                   end;
  216.                if (State = SkipString) or
  217.                   (Ch = '''')          then
  218.                   repeat                         { get rid of strings }
  219.                      I := I + 1;
  220.                      if Line[I] = '''' then
  221.                         State := CCopy
  222.                      else
  223.                         State := SkipString
  224.                   until (State = CCopy) or (I = LText.Len)
  225.             end;   { else }
  226.       end;  { while }
  227.    if not FoundWord then
  228.       Status.CommentLines := Status.CommentLines + 1  { count comment lines }
  229. end; { procedure FindWord }
  230.