Anders is the chief architect of Turbo Pascal, now in its fifth generation. Anders is currently working on Turbo Pascal and other core technology products at Borland Int., Scotts Valley, Calif.
In modern programming, most applications depend heavily on data structuring methods that lie far beyond the built-in functionality of a programming language. In fact, large portions of typical applications are devoted to the maintenance of data structures, such as linked lists, dynamic arrays, binary trees, and so on. But even so, few, if any, programming languages provide built-in support for data structures other than simple records and arrays. As a result, scores of programmers are forced to "invent the wheel" over and over again as they write and debug the necessary data structure management code for each new application. Among the key benefits of object oriented programming (OOP) is the ability to create Container Object Types which, when packaged in library modules, essentially extend the underlying programming language with new ways of structuring data. Using Container Object Types, a programmer needn't worry about insertion and deletion on linked lists, balancing of binary trees, sorting of arrays, and so on; all such algorithms can be implemented once and for all in a library of Container Object Types. In this article, I'll demonstrate how to implement and use a number of Container Object Types in Turbo Pascal 5.5. In particular, I'll implement Container Object Types for linked lists and binary trees, and show how these structures can be used in a Pascal cross-reference generator program.
Container Object Types
You may think you know nothing about Container Object Types, when in fact you probably use them in every program you write. The Pascal array type, for instance, is an example of a container type (although not an object-oriented one). An array contains a number of elements of a specific type, and allows access to those elements through indices. And a Container Object Type is just that: A type that contains a number of elements and allows access to those elements in some way.
Consider, for example, a linked list. It consists of a number of nodes, each of which contains a link that points to the next node in the list. To access the list, one follows links down the chain of nodes. Both the linked list, and the array contain a number of elements and allow access to those elements in some way.
Many other data structures are natural candidates for implementation as container types. Stacks (last-in, first-out), queues (first-in, first-out), trees, dynamic arrays, and hash tables, like linked lists and arrays, all share the ability to store and access data elements and could be profitably "containerized."
While some applications may be able to get along with fixed-sized arrays, most programs require structures that dynamically resize themselves, that have the ability to sort themselves, and so on. When the number of elements in a structure isn't known beforehand, and when access to the elements is strictly sequential, a linked list is probably more appropriate than a fixed-size array. Likewise, when elements have to be sorted, a binary tree may be a better choice. It seems strange, then, that most programming languages only provide a couple of container types (such as array and record), when indeed there are many others to consider. Wouldn't it be nice, for example, to be able to declare a "list of Windows," a "queue of Transactions," or a "tree of Identifiers." With Container Object Types, you can do just that, although the syntax may be a little different.
Container Object Types allow lists, stacks, queues, trees, and other data structures to be made truly generic, almost as if they were language extensions. Just as procedures and functions in units (such as Dos, Overlay, and Graph) are extensions to the set of built-in routines (such as WriteLn, ReadLn, Length, and Sqrt) of Turbo Pascal, units with Container Object Types can act as extensions to the built-in array and record types.
The benefits are numerous. First of all, Container Object Types save time, because you don't have to write and debug code to manage data structures over and over again. Such code can be written and debugged once, and then reused in any number of applications. Second, Container Object Types can save space and can reduce errors. Imagine, for example, an application that uses linked lists for a number of different purposes. There might be a linked list of windows (the desktop), a linked list of menus (the menu bar) with linked lists of menu items, and so on. Instead of having separate linked-list managers for windows, menus, and menu items, there can be one generic Container Object Type that manages them all, with a resulting reduction in code space and potential bugs. Finally, if all linked lists in an application are derived from one Container Object Type, then any optimizations made to that container will improve performance throughout the entire application.
Implementing and Using Container Object Types
When it comes to implementation, Container Object Types are no different than ordinary object types. A container type has data fields and methods, and it can inherit from other object types. The methods of a Container Object Type provide access to the data stored in the container. Where brackets ([]) are used to access an array, method calls are used to access a container. A linked list container, for example, will have methods to insert, append, and remove elements, and methods to get at the first, last, next, and previous elements in the list.
Implementing a Container Object Type is a true exercise in data abstraction. When you write code for the methods of a Container Object Type, you deal only with the structure of the data in the container, not with the data itself. Just as you can index an array without knowing exactly what the array contains, you can insert, append, and remove elements on a linked list without knowing exactly what the elements are. But you do need to know something about the elements. In the case of an array, you need to know the size of each element, and in the case of a linked list, you need to know where to find the link to the next element. The key is to know just enough about the elements to access them, but not more.
Such partial knowledge of container elements is achieved through abstract element types. Each element on a linked list needs a pointer to the next element in the list:
type
ListNodePtr = ^ListNode;
ListNode = object
Next: ListNodePtr;
end;
If each element on the linked list is an object type derived from ListNode, then each element is guaranteed to have a Next link. For example, a linked list element that contains an integer value could be defined as:
type
IntNodePtr = ^IntNode;
IntNode = object(ListNode)
Value: Longint;
end;
The ListNode type is known as an abstract type. It exists only so that other types can be derived from it, but is otherwise useless, because it contains no data. IntNode, on the other hand, contains useful data, and because it is derived from ListNode, it inherits the Next field, and can act as a ListNode in a linked list. Of course, you can derive other types from ListNode, such as StringNode, WindowNode, and MenuNode, all of which can be put on a linked list.
Given the ListNode type, now implement a Container Object Type that "contains" it. In this case, I'll show a simple last-in, first-out stack of ListNodes, which has methods to Push and Pop elements:
type
StackList = object
First: ListNodePtr;
procedure Push(N: ListNodePtr);
function Pop: ListNodePtr;
...
end;
To "push" an element onto the stack, the new element is inserted at the beginning of the list:
procedure StackList.Push(N:ListNodePtr);
begin
N^.Next := First;
First := N;
end;
To "pop" an element, return the first element on the list and remove that element from list:
function StackList.Pop: ListNodePtr; begin Pop := First; if First <> nil then First := First^.Next; end;
Here's a simple program fragment that uses the StackList container type:
var
S: StackList;
P: IntNodePtr;
begin
...
S.Push(P);
P := IntNodePtr(S.Pop);
...
end;
Notice in particular that a typecast is required to assign the result of Pop to P, but that it is not required to pass P to Push. From the compiler's point of view, Push and Pop operate only on elements of type ListNode -- in fact, Push and Pop know nothing about the existence of an IntNode type. When passing P to Push, the compiler can guarantee that P is a ListNode, because IntNode is derived from ListNode. But going the other way and assigning the result of Pop to P, the compiler can make no such assumption. The pointer to a ListNode returned by Pop is not known at compile time to be also a pointer to an IntNode. Because I have only Pushed pointers to IntNodes, however, I can safely convert the return value by using a typecast.
Such typecasts are quite common in applications that use Container Object Types. The compiler doesn't know what is in the container, but the application does, and it can safely promote the elements.
The Contain.PAS Unit
To demonstrate the implementation of Container Object Types in Turbo Pascal 5.5, I have provided Contain.PAS, which is shown in Listing One (see page 108). The Contain unit implements a linked list container and a binary tree container.
The Base type is an abstract object type that serves as the ultimate ancestor of all these object types. The only thing it declares is a destructor called "Done3," and in itself, the Base type is quite useless, though objects derived from Base are guaranteed to always have destructors.
The List type implements a linked list container, which contains elements that are derived from the ListNode type. The List's Last field points to the last ListNode in the list, and the Next field of the last ListNode points to the first node, which then points to the next node, and so on. Storing the list in a circular fashion like this allows the efficient implementation of both an Insert and an Append method; if a pointer to the first element of the list had been stored instead, the Append method would become very inefficient, because it would have to traverse the entire list before appending the new element. Also because of the circular structure, each ListNode can itself provide a Prev method, which returns the previous node by traversing the entire circle.
The Init constructor initializes the list by setting the Last field to nil, and the Done destructor disposes the list by disposing each node. The Insert, Append, and Remove methods are used to insert, append, and remove nodes. Notice how Remove doesn't dispose the node, but rather just removes it from the list. First, Last, Next, and Prev are used to traverse the list; they all return nil to indicate the end of the iteration. First and Next are used to step forward through the list, and Last and Prev are used to step backwards. The latter is a rather slow process, though, because finding the previous node requires traversing the entire list.
The ForEach method applies an action to each node in the list. The action is specified in the form of a procedure parameter, which must be compatible with the ListAction procedure type. Starting with the first element in the list, the Action procedure is called for each element. The ForEach method is an alternative to the First/Next methods.
Writing:
L.ForEach(SomeAction);
corresponds to writing:
P := L.First;
while P <> nil do
begin
SomeAction(P);
P := L.Next(P);
end;
The action may be to dispose of the element (which is why the actual source code in ForEach calls the Next method before calling the Action procedure). An example of the use of ForEach is the Deletemethod, which uses ForEach to dispose of the entire list of elements.
The Tree type implements a sorted binary tree, which contains elements that are derived from the TreeNode type. Each node in the tree has a key value that is used to automatically sort nodes as they are inserted into the tree. The Tree's Root field points to the root of the tree, and the Left and Right fields of each TreeNode point to nodes whose key values are less than and greater than the key value of the node itself. The Tree does not allow duplicate key values.
Of particular interest is the Tree's Compare and GetKey methods. These methods are virtual, and are meant to be overridden by users of the Treetype. The GetKey method is passed a pointer to a TreeNode and must return a pointer to the key value field in the node. The Compare method is passed two such key value pointers, and must return -1, 0, or 1, indicating Key1 < Key2, Key1 = Key2, and Key1 > Key2, respectively. The default GetKey method simply returns a pointer to the node itself, which in some cases is sufficient. The default Compare method, however, always returns 0 (indicating equivalence), which of course is useless because every node will appear to be identical to every other node. The Compare method therefore must be overridden with an implementation that actually compares the keys.
The Insert method inserts a new node into the tree unless a node with the same key value already exists. The Find method returns a pointer to a node with a given key value, or nil if no such node exists. Both Insert and Find are implemented through the more general Search method. Search scans the tree for a node with a particular key value, and returns a pointer to the node. If the node doesn't exist, a user-specified function is called. The user function may create a new node and return a pointer to it, in which case that new node is entered into the tree. Alternatively, the user function may return nil, in which case no new node is created. In either case, the result of the user function also becomes the result of the Search method. The user function is specified as a function parameter to Search, and the type of the parameter must be compatible with the TreeCreate function type.
Like the List container type, the Tree container type has a ForEach method that applies an action to all nodes in the tree, in the order in which the nodes are sorted. The action is specified in the form of a procedure parameter, which must be compatible with the TreeAction procedure type. The action may be to dispose of the node (which is why the Traverse procedure in ForEach copies the Right pointer into a temporary before calling the Action procedure). An example of the use of ForEach is the Delete method, which uses ForEach to dispose of the entire tree.
As an example of the use of the Tree type, consider implementing a binary tree with nodes that contain a string and are ordered according to the value of the string:
StrPtr = ^String;
StrNodePtr = ^StrNode;
StrNode = object(TreeNode)
Value: StrPtr;
end;
To create a tree of such StrNode elements, a StrTree type is derived from the generic Treetype, and the Compare and GetKey methods are overridden:
StrTree = object(Tree) function Compare(Key1, Key2: Pointer): Integer; virtual; function GetKey(N: TreeNodePtr): Pointer; virtual; end;
The GetKey method returns a pointer to the string value in the node. Notice how a typecast is required to promote the node from a TreeNode to a StrNode.
function StrTree.GetKey(N: TreeNodePtr): Pointer;
begin
GetKey := StrNodePtr(N)^.Value;
end;
The Compare method likewise typecasts the key pointers into string pointers, and compares the string values:
function StrTree.Compare(Key1,Key2: Pointer): Integer;
begin
if StrPtr(Key1)^<StrPtr(Key2)^ then Compare := -1 else
if StrPtr(Key1)^>StrPtr(Key2)^ then Compare := 1 else
Compare := 0;
end;
The Crossref.PAS Program
Now that a Container Object Type module has been implemented, I'll show a program that actually uses those container types. The Crossref.PAS program (see Listing Two, page 109) uses linked lists and binary trees to generate a cross-reference listing of a Pascal source file. A listing of the source file with line numbers and a list of all identifiers in the source file is produced, and each identifier is followed by a list of numbers of the lines that reference the identifier.
To run the CrossRef program, use a command line such as this:
CROSSREF MYPROG.PAS
This generates a cross-reference listing of MYPROG.PAS on the screen. Because CrossRef writes to the standard Output file, the cross-reference can be redirected to a file. For example:
CROSSREF MYPROG.PAS >MYPROG .CRF
Within the CrossRef program, the LineRef object type is used to track line numbers of references to a particular identifier. It is derived from the ListNode type, so that reference line numbers can be kept on a linked list.
An IdentRef object represents an identifier and the line numbers of all the lines that reference it. The identifier is stored in the Name field as a pointer to a string, and the line numbers are kept on a linked list using the Lines field. The IdentRef type is derived from the TreeNode type, so that all identifiers can be kept in a sorted binary tree.
The IdentTree type implements a tree of IdentRef objects. It is derived from the generic Treetype, and the Compare and GetKey methods are overridden to extract and compare key values from IdentRef objects. In particular, GetKey returns the Name string pointer stored in each IdentRef, and Compare compares the strings.
The general flow of the CrossRef program is as follows: First the identifier tree is initialized using the Idents.Init constructor. Then the Input and Output files are prepared and are assigned buffers. Next, all Turbo Pascal reserved words are inserted into the tree, so that they can be ignored in the cross-reference listing. The ProcessFile procedure processes the input file and produces a source listing with line numbers, and the PrintIdents procedure prints the identifier cross reference. Finally, the Idents.Done destructor is called to dispose of the entire cross-reference tree.
The InsertKeyWord procedure uses a recursive binary iteration to insert the reserved words into the tree. This ensures optimal distribution of the keyword entries in the tree; if a straight for loop had been used to insert the keywords, the tree would become a worstcase unbalanced tree, because the keywords are sorted alphabetically in the KeyWord table.
The ProcessFile procedure "tokenizes" the input stream to isolate identifier references. It ignores strings, hex-numbers, and comments, and calls GetIdent to process each identifier. GetIdent, after reading the identifier, uses the Search method to find or create a corresponding IdentRef node. The NewIdent procedure is called if Search cannot locate the identifier in the tree, and NewIdent then creates a new IdentRef with one LineRef in the Lines list.
Because the tree contains only objects of type IdentRef, the result of the Search method call in GetIdent can be typecast to the IdentRefPtr type. If the resulting IdentRef has an empty Lines list, it is a reserved word, and such references are ignored. Otherwise, if the line number of the last reference on the Lines list is not the current line number, then a new LineRef object is added to the list.
The PrintIdents procedure calls PrintRef for each IdentRef object in the Idents tree. PrintRef ignores the IdentRef if the Lines list is empty, indicating a reserved word; otherwise, it prints the identifier, and calls PrintLine for each LineRef in the Lines list. PrintLine prints the reference line number with a maximum of RefPerLine references per line. Again, notice the typecasts in both PrintRef and PrintLine, which promote the generic TreeNode and ListNode types into the specific IdentRef and LineRef types.
Conclusion
The ability to add new data types that behave such as built-in data types makes it possible to extend Pascal itself to behave like a more abstract language. One only needs to provide a generic object type for stacks, linked lists, or queues. Then anyone can use the object's operations simply by creating a type definition for the objects to be manipulated. Objects that are to be managed can be as simple as a stack of integers or as complex as a list of windows open on a desktop complete with text buffers, scroll bars, and mouse support.
Regardless of the complexity of the objects managed, the basic object type never needs to be modified at the source level. Because the behavior of object types can be extended and modified through inheritance, users of object libraries only need the interface specification to modify the behavior of derived objects. Object libraries differ substantially from the conventional libraries provided by third-party vendors, where access to source code is a critical issue. As programmers become less concerned with source code availability, I think there will be two different types of programming projects -- projects that provide object libraries and projects that use them. Builders of object libraries are assured that they can provide truly reusable code. Users of object libraries will experience tremendous productivity boosts by inheriting, rather than reinventing the wheel every time they need data structure management code for a new application.
_CONTAINER OBJECT TYPES IN TURBO PASCAL_ by Anders Hejlsberg
[LISTING ONE]
Copyright © 1989, Dr. Dobb's Journal<a name="0238_000a">
unit Contain;
{$S-}
interface
type
{ Base object type }
Base = object
destructor Done; virtual;
end;
{ Abstract linked list node type }
ListNodePtr = ^ListNode;
ListNode = object(Base)
Next: ListNodePtr;
function Prev: ListNodePtr;
end;
{ Linked list iteration procedure type }
ListAction = procedure(N: ListNodePtr);
{ Linked list type }
ListPtr = ^List;
List = object(Base)
Last: ListNodePtr;
constructor Init;
destructor Done; virtual;
procedure Append(N: ListNodePtr);
procedure Delete;
function Empty: Boolean;
procedure ForEach(Action: ListAction);
function First: ListNodePtr;
procedure Insert(N: ListNodePtr);
function Next(N: ListNodePtr): ListNodePtr;
function Prev(N: ListNodePtr): ListNodePtr;
procedure Remove(N: ListNodePtr);
end;
{ Abstract binary node type }
TreeNodePtr = ^TreeNode;
TreeNode = object(Base)
Left, Right: TreeNodePtr;
end;
{ Binary tree iteration procedure type }
TreeAction = procedure(N: TreeNodePtr);
{ Binary tree node creation procedure type }
TreeCreate = function(Key: Pointer): TreeNodePtr;
{ Binary tree type }
TreePtr = ^Tree;
Tree = object(Base)
Root: TreeNodePtr;
constructor Init;
destructor Done; virtual;
function Compare(Key1, Key2: Pointer): Integer; virtual;
procedure Delete;
function Empty: Boolean;
function Find(Key: Pointer): TreeNodePtr;
procedure ForEach(Action: TreeAction);
function GetKey(N: TreeNodePtr): Pointer; virtual;
procedure Insert(N: TreeNodePtr);
function Search(Key: Pointer; Create: TreeCreate):
TreeNodePtr;
end;
implementation
{ Base methods }
destructor Base.Done;
begin
end;
{ ListNode methods }
function ListNode.Prev: ListNodePtr;
var
P: ListNodePtr;
begin
P := Self;
while P^.Next <> Self do P := P^.Next;
Prev := P;
end;
{ List methods }
{$F+}
procedure DelListNode(N: ListNodePtr);
begin
Dispose(N, Done);
end;
{$F-}
constructor List.Init;
begin
Last := nil;
end;
destructor List.Done;
begin
Delete;
end;
procedure List.Append(N: ListNodePtr);
begin
Insert(N);
Last := N;
end;
procedure List.Delete;
begin
ForEach(DelListNode);
Last := nil;
end;
function List.Empty: Boolean;
begin
Empty := Last = nil;
end;
procedure List.ForEach(Action: ListAction);
var
P, Q: ListNodePtr;
begin
P := First;
while P <> nil do
begin
Q := P;
P := Next(P);
Action(Q);
end;
end;
function List.First: ListNodePtr;
begin
if Last = nil then First := nil else First := Last^.Next;
end;
procedure List.Insert(N: ListNodePtr);
begin
if Last = nil then Last := N else N^.Next := Last^.Next;
Last^.Next := N;
end;
function List.Next(N: ListNodePtr): ListNodePtr;
begin
if N = Last then Next := nil else Next := N^.Next;
end;
function List.Prev(N: ListNodePtr): ListNodePtr;
begin
if N = First then Prev := nil else Prev := N^.Prev;
end;
procedure List.Remove(N: ListNodePtr);
var
P: ListNodePtr;
begin
if Last <> nil then
begin
P := Last;
while (P^.Next <> N) and (P^.Next <> Last) do P := P^.Next;
if P^.Next = N then
begin
P^.Next := N^.Next;
if Last = N then if P = N then Last := nil else Last := P;
end;
end;
end;
{ Tree methods }
var
NewTreeNode: TreeNodePtr;
{$F+}
function GetTreeNode(Key: Pointer): TreeNodePtr;
begin
GetTreeNode := NewTreeNode;
end;
procedure DelTreeNode(N: TreeNodePtr);
begin
Dispose(N, Done);
end;
{$F-}
constructor Tree.Init;
begin
Root := nil;
end;
destructor Tree.Done;
begin
Delete;
end;
function Tree.Compare(Key1, Key2: Pointer): Integer;
begin
Compare := 0;
end;
procedure Tree.Delete;
begin
ForEach(DelTreeNode);
Root := nil;
end;
function Tree.Empty: Boolean;
begin
Empty := Root = nil;
end;
function Tree.Find(Key: Pointer): TreeNodePtr;
begin
NewTreeNode := nil;
Find := Search(Key, GetTreeNode);
end;
procedure Tree.ForEach(Action: TreeAction);
procedure Traverse(P: TreeNodePtr);
var
R: TreeNodePtr;
begin
if P <> nil then
begin
R := P^.Right;
Traverse(P^.Left);
Action(P);
Traverse(R);
end;
end;
begin
Traverse(Root);
end;
function Tree.GetKey(N: TreeNodePtr): Pointer;
begin
GetKey := N;
end;
procedure Tree.Insert(N: TreeNodePtr);
begin
NewTreeNode := N;
N := Search(GetKey(N), GetTreeNode);
end;
function Tree.Search(Key: Pointer; Create: TreeCreate):
TreeNodePtr;
procedure Traverse(var P: TreeNodePtr);
var
C: Integer;
begin
if P = nil then
begin
P := Create(Key);
P^.Left := nil;
P^.Right := nil;
Search := P;
end else
begin
C := Compare(Key, GetKey(P));
if C < 0 then Traverse(P^.Left) else
if C > 0 then Traverse(P^.Right) else
Search := P;
end;
end;
begin
Traverse(Root);
end;
end.
<a name="0238_000b"><a name="0238_000b">
<a name="0238_000c">[LISTING TWO]<a name="0238_000c">
program CrossRef;
{$S-}
{$M 8192,8192,655360}
uses Contain;
const
MaxIdentLen = 20; { Maximum identifier length }
LineNoWidth = 6; { Width of line numbers in listing }
RefPerLine = 8; { Line numbers per line in
cross-reference }
IOBufSize = 4096; { Input/Output buffer size }
FormFeed = #12;
EndOfLine = #13;
EndOfFile = #26;
type
{ Input/Output buffer }
IOBuffer = array[1..IOBufSize] of Char;
{ Identifier string }
IdentPtr = ^Ident;
Ident = string[MaxIdentLen];
{ Line reference object }
LineRefPtr = ^LineRef;
LineRef = object(ListNode)
LineNo: Integer;
constructor Init(Line: Integer);
end;
{ Identifier reference object }
IdentRefPtr = ^IdentRef;
IdentRef = object(TreeNode)
Lines: List;
Name: IdentPtr;
constructor Init(S: Ident);
destructor Done; virtual;
end;
{ Identifier tree }
IdentTreePtr = ^IdentTree;
IdentTree = object(Tree)
function Compare(Key1, Key2: Pointer): Integer; virtual;
function GetKey(N: TreeNodePtr): Pointer; virtual;
end;
const
{ Turbo Pascal reserved words }
KeyWordCount = 52;
KeyWord: array[1..KeyWordCount] of string[15] = (
'ABSOLUTE', 'AND', 'ARRAY', 'BEGIN', 'CASE', 'CONST',
'CONSTRUCTOR', 'DESTRUCTOR', 'DIV', 'DO', 'DOWNTO', 'ELSE',
'END', 'EXTERNAL', 'FILE', 'FOR', 'FORWARD', 'FUNCTION',
'GOTO', 'IF', 'IMPLEMENTATION', 'IN', 'INLINE', 'INTERFACE',
'INTERRUPT', 'LABEL', 'MOD', 'NIL', 'NOT', 'OBJECT', 'OF',
'OR', 'PACKED', 'PROCEDURE', 'PROGRAM', 'RECORD', 'REPEAT',
'SET', 'SHL', 'SHR', 'STRING', 'THEN', 'TO', 'TYPE', 'UNIT',
'UNTIL', 'USES', 'VAR', 'VIRTUAL', 'WHILE', 'WITH', 'XOR');
var
Idents: IdentTree; { Tree of IdentRef objects }
LineCount: Integer; { Current line number }
RefCount: Integer; { Counter used by PrintLine }
InputBuffer: IOBuffer; { Standard input buffer }
OutputBuffer: IOBuffer; { Standard output buffer }
{ LineRef constructor }
constructor LineRef.Init(Line: Integer);
begin
LineNo := Line;
end;
{ IdentRef constructor }
constructor IdentRef.Init(S: Ident);
begin
Lines.Init;
GetMem(Name, Length(S) + 1);
Name^ := S;
end;
{ IdentRef destructor }
destructor IdentRef.Done;
begin
FreeMem(Name, Length(Name^) + 1);
Lines.Done;
end;
{ Compare keys of two IdentRef objects in an IdentTree }
function IdentTree.Compare(Key1, Key2: Pointer): Integer;
begin
if IdentPtr(Key1)^ < IdentPtr(Key2)^ then Compare := -1 else
if IdentPtr(Key1)^ > IdentPtr(Key2)^ then Compare := 1 else
Compare := 0;
end;
{ Return the key of an IdentRef object in an IdentTree }
function IdentTree.GetKey(N: TreeNodePtr): Pointer;
begin
GetKey := IdentRefPtr(N)^.Name;
end;
{ Insert keywords in identifier tree }
procedure InsertKeyWord(L, R: Integer);
var
I: Integer;
begin
I := (L + R) div 2;
Idents.Insert(New(IdentRefPtr, Init(KeyWord[I])));
if L < I then InsertKeyWord(L, I - 1);
if I < R then InsertKeyWord(I + 1, R);
end;
{$F+}
{ Create and return a new IdentRef object }
function NewIdent(Key: Pointer): TreeNodePtr;
var
P: IdentRefPtr;
begin
New(P, Init(IdentPtr(Key)^));
P^.Lines.Append(New(LineRefPtr, Init(LineCount)));
NewIdent := P;
end;
{$F-}
{ Process input file and print listing }
procedure ProcessFile;
var
Ch: Char;
{ Get next character from input file }
procedure GetChar;
begin
if Eof then Ch := EndOfFile else
begin
if Ch = EndOfLine then
begin
Inc(LineCount);
Write(LineCount: LineNoWidth, ': ');
end;
if not Eoln then
begin
Read(Ch);
Write(Ch);
if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
end else
begin
ReadLn;
WriteLn;
Ch := EndOfLine;
end;
end;
end;
{ Get next token from input file }
procedure GetToken;
{ Get identifier from input file and enter into tree }
procedure GetIdent;
var
Name: Ident;
P: LineRefPtr;
begin
Name := '';
repeat
if Length(Name) < MaxIdentLen then
begin
Inc(Name[0]);
Name[Length(Name)] := Ch;
end;
GetChar;
until ((Ch < '0') or (Ch > '9')) and
((Ch < 'A') or (Ch > 'Z')) and (Ch <> '_');
with IdentRefPtr(Idents.Search( Name, NewIdent))^ do
if not Lines.Empty then
if LineRefPtr(Lines.Last)^.LineNo <> LineCount then
Lines.Append(New(LineRefPtr, Init(LineCount)));
end;
begin { GetToken }
case Ch of
'A'..'Z', '_':
GetIdent;
'''':
repeat
repeat
GetChar;
until (Ch = '''') or (Ch = EndOfFile);
GetChar;
until (Ch <> '''');
'$':
repeat
GetChar;
until ((Ch < '0') or (Ch > '9')) and
((Ch < 'A') or (Ch > 'F'));
'{':
begin
repeat
GetChar;
until (Ch = '}') or (Ch = EndOfFile);
GetChar;
end;
'(':
begin
GetChar;
if Ch = '*' then
begin
GetChar;
repeat
while (Ch <> '*') and (Ch <> EndOfFile) do GetChar;
GetChar;
until (Ch = ')') or (Ch = EndOfFile);
GetChar;
end;
end;
else
GetChar;
end;
end;
begin { ProcessFile }
Ch := EndOfLine;
GetChar;
while (Ch <> EndOfFile) do GetToken;
Write(FormFeed, EndOfLine);
end;
{$F+}
{ Print a LineRef object }
procedure PrintLine(N: ListNodePtr);
begin
if RefCount = RefPerLine then
begin
WriteLn;
Write(' ': MaxIdentLen + 1);
RefCount := 0;
end;
Inc(RefCount);
Write(LineRefPtr(N)^.LineNo: LineNoWidth);
end;
{ Print an IdentRef object }
procedure PrintRef(N: TreeNodePtr);
begin
with IdentRefPtr(N)^ do if not Lines.Empty then
begin
Write(Name^, ' ': MaxIdentLen + 1 - Length(Name^));
RefCount := 0;
Lines.ForEach(PrintLine);
WriteLn;
end;
end;
{$F-}
{ Print identifier tree }
procedure PrintIdents;
begin
Idents.ForEach(PrintRef);
Write(FormFeed, EndOfLine);
end;
begin { CrossRef }
Idents.Init;
LineCount := 0;
if Pos('.', ParamStr(1)) = 0 then
Assign(Input, ParamStr(1) + '.PAS')
else
Assign(Input, ParamStr(1));
Reset(Input);
SetTextBuf(Input, InputBuffer);
SetTextBuf(Output, OutputBuffer);
InsertKeyWord(1, KeyWordCount);
ProcessFile;
PrintIdents;
Idents.Done;
end.
