With IO,STRLIB,Util;
Package Body Xref Is
Use IO,STRLIB,Util;
    -- Cross reference program
    -- Last Modified  3/12/83
    -- Provided to demonstrate Access types, and to provide a useful tool
    -- Only the first MAXLINES occurances of a name will be recorded to
    -- save space.
    -- If the memory is nearly full, the crossref will be aborted, and
    -- what already has been done will be printed.

    -- The crossref'ed words are stored in a Binary Sorted Tree, and then
    -- are printted in order by printtree.  The line numbers are stored in
    -- a linked list attached to each tree node.  This algorithm is from
    -- Wirth, Algorithms + Data Structures = Programs

--SY Wong added function reserved_word to omit same, 1/15/83.

    MAXLINES : Constant := 25;

    Type Ident Is New String(20);
    Type LNum;			-- These types are used to form a linked list
    Type Line Is Access Lnum;	-- of line numbers
    Type LNum Is Record
	lno : Integer;
	nxt : Line;
    End Record;

    Type word;			-- These types are used to form a sorted
    Type wptr Is Access word;	-- binary tree of words
    Type word Is Record
	key : Ident;
	cnt : Integer;	-- Number of uses
	lnos: Line;	-- Line number chain
	left,right : wptr; -- Tree pointers
    End Record;

    Root : Wptr := Null;

    cur_line : Integer := 1;
    inp : File;
    tname : String;

Function reserved_word(str: in string) return boolean is
L:integer;
begin
  L:=length(str);
  case L is
    when 2 => if STR="AT" OR STR="DO" OR STR="IF" OR STR="IN"
	OR STR="IO"
    	OR STR="IS" OR STR="OF" OR STR="OR" then return true;
    	else return false; end if;
    when 3 => if STR="ALL" OR STR="AND" OR STR="END"
    	OR STR="FOR" OR STR="MOD" OR STR="NEW" OR STR="NOT"
    	OR STR="OUT" OR STR="PUT"
	OR STR="REM" OR STR="USE" then return true;
    	else return false;  end if;
    when 4 => if STR="BODY" OR STR="CASE" OR STR="ELSE"
    	OR STR="EXIT" OR STR="FILE" OR STR="GOTO" OR STR="LOOP"
	OR STR="OPEN" OR STR="NULL"
    	OR STR="TASK" OR STR="THEN" OR STR="TRUE"
	OR STR="TYPE" OR STR="UTIL" OR STR="WHEN" OR STR="WITH"
    	then return true; else return false;   end if;
    when 5 => if STR="ABORT" OR STR="ARRAY" OR STR="BEGIN"
    	OR STR="DELAY" OR STR="DELTA" OR STR="ELSIF"
    	OR STR="ENTRY" OR STR="FALSE" OR STR="RAISE" OR STR="RANGE"
    	OR STR="WHILE" then return true; else return false;
	end if;
    when 6 => if STR="ACCEPT" OR STR="ACCESS" OR STR="DIGITS"
    	OR STR="OTHERS" OR STR="PRAGMA" OR STR="RECORD"
    	OR STR="RETURN" OR STR="SELECT" OR STR="STRING"
	OR STR="STRLIB"
	then return true;
	else return false;  end if;
    when 7 => if STR="BOOLEAN"
	OR STR="DECLARE" OR STR="GENERIC" OR STR="INTEGER"
	OR STR="LIMITED"
    	OR STR="PACKAGE" OR STR="PRIVATE" OR STR="RENAMES"
    	OR STR="REVERSE" OR STR="SUBTYPE" then return true;
	else return false; end if;
    when 8 => if STR="CONSTANT" OR STR="FUNCTION" OR STR="SEPARATE"
	OR STR="NEW_LINE"
    	then return true; else return false;  end if;
    when 9 => if STR="CHARACTER"
	OR STR="EXCEPTION" OR STR="PROCEDURE" OR STR="READ_ONLY"
    	OR STR="TERMINATE" then return true;
	else return false;  end if;
    when others => return false;
  end case;
end reserved_word;

Procedure printtree(w:wptr) Is
    -- This routine recursively prints the cross reference tree
    -- This means that is calls itself to print the left and right
    -- subtrees of the node passed in.  If the node passed in is Null,
    -- nothing is done (this guarentees termination).
    t : Line; no : Integer := 0;
Begin
    If w /= Null Then
	printtree(w.left);
	Put(w.key); Put("-"); Put(w.cnt); Put(" Usages"); New_Line;
	Put("       Lines - ");
	-- Print the line numbers
	-- This is done by 'walking' the linked list of line numbers
	t := w.lnos;	-- Start of line number list
	While t /= Null Loop
	    Put(t.lno,4);
	    no := no + 1;
	    If no Mod 15 = 0 Then
		New_Line;
	    End If;
	    t := t.nxt;	-- Walk to next line number
	End Loop;
	New_Line;
	printtree(w.right);
    End If;
    -- Do nothing for a null pointer
End printtree;

Procedure insert(newkey : String; w : In Out wptr) Is
    -- This routine recursively inserts a new word.  The tree is recursively
    -- searched for the word.  If it is found, the line number is added to
    -- the line number list.  Otherwise, a new node is created and added
    -- to the tree.
    t : line;
Begin
    If w = Null Then -- Not in tree, insert it
	w := New word;
	w.key := newkey; w.cnt := 1;
	w.left := Null; w.right := Null;
	w.lnos := New LNum;
	w.lnos.lno := Cur_Line;
	w.lnos.nxt := Null;
@	Put("Add Word - Memavail = "); Put(memavail());
@  Put(" Maxavail() = "); Put(maxavail()); New_line;
    Elsif newkey < w.key Then
	insert(newkey,w.left);
    Elsif newkey > w.key Then
	insert(newkey,w.right);
    Else -- Found it
	w.cnt := w.cnt + 1;
	If w.cnt < MAXLINES And Then w.lnos.lno /= Cur_Line Then
	    t := New LNum;
	    t.lno := Cur_Line;
	    t.nxt := w.lnos;
	    w.lnos := t;
@	Put("Add Line - Memavail = "); Put(memavail());
@  Put(" Maxavail() = "); Put(maxavail()); New_line;
End If;
    End If;
    If Memavail() In 0..2000 Then -- Dump the tree before the memory runs out
	Printtree(root);
	Put("Crossref Program Halted at Line Number "); Put(Cur_Line);
	Put(" of the source file for insufficient memory"); New_Line;
	Halt;
    End If;
End Insert;

Procedure scan_input Is
    -- Break up the input into JANUS tokens, and store them in the tree
	str : string;
	ch : character;
	len : Integer;
bool : Boolean; -- Temporary to force garbage collection
    Begin
	Get(inp,ch);
	While Not End_of_File(inp) Loop
	    len := 1;
	    str(0) := Character'Val(20); -- Set the string to the maximum
					 -- possible length
	    While Not End_Of_File(inp) Loop
		-- Only cross reference ID's
		If (ch In 'A'..'Z') or (ch In 'a'..'z') Then
		  <<Id>> -- Jump from character constant, below
		    While (ch In 'A'..'Z') or else (ch In 'a'..'z') or else
			(ch In '0'..'9') or else (ch = '_') Loop
			If len < 21 Then -- String not full
			    If ch In 'a'..'z' Then
				str(len) := Character'Val(Character'Pos(ch) +
				    Character'Pos('A') - Character'Pos('a'));
			    Else
				str(len) := ch;
			    End If; -- Capitalize characters
			    len := len + 1;
			End If; -- Throw away character if string is full
			get(inp,ch);
		    End Loop;
		    Exit; -- Leave Scanner
		Elsif (ch = '-') Then -- Skip comments
		    get(inp,ch);
		    If ch /= '-' Then
			GoTo NotComment; -- Not a comment
		    End If;
		    Loop
			get(inp,ch);
			Exit When (ch In character'Val(10)..Character'Val(13))
				Or Else (ch = Character'Val(26));
		    End Loop;
		    Cur_Line := Cur_Line + 1;
		    get(inp,ch);
		    -- No exit (we'll get another token)
		<<NotComment>> Null; -- Do nothing special
		Elsif (ch = '"') Then -- Skip strings
		    While Not End_Of_File(inp) Loop
			get(inp,ch);
			Exit When ch = '"';
		    End Loop;
		    get(inp,ch);
		    -- No exit - get another token
		Elsif (ch = ''') Then
		    -- (Must skip the middle character of a char constant)
		    get(inp,ch);
		    str(1) := ch;
		    len := 2;
		    get(inp,ch);
		    If ch = ''' Then
			len := 1; -- Char constant, skip all
			get(inp,ch); -- Skip the character
		    Elsif str(1) In 'A'..'Z' Then
			Goto Id; -- It's an Id, Not a character const.
		    Elsif str(1) In 'a'..'z' Then
			str(1) := Character'Val(Character'Pos(Str(1)) - 32);
			GoTo Id; -- Also an ID
		    Else -- Not an Id
			len := 1; -- Reset character
		    End If;
		Elsif (ch = Character'Val(13)) Then
		    Cur_Line := Cur_Line + 1; -- Next Line;
		    get(inp,ch); -- Skip the character
		Else
		    get(inp,ch); -- Skip the character
		End If;
	    End Loop;
	    str(0) := Character'Val(len - 1); -- Set the string length
	    if not reserved_word(str) and len /= 1 -- len = 1 for null str.
              then
		bool := "aa" = str;
		 -- Force garbage collection to get rid of memory full errors
	      insert(str,root);  -- And put it into the tree
	    end if;
	End Loop;
    End scan_input;

Begin
    Put("Cross Reference Generator - Version 1.1"); New_Line;
    Put("File to Crossref? ");
    tname := Get_Line(Current_Input());
    Open(inp,tname,Read_Only);
    Scan_Input;
    printtree(root);
    New_Line; Put(Memavail()); Put(" Bytes Free Memory"); New_Line;
    Put("Cross Reference Program Completed"); New_Line;
End Xref;
rs
	      insert(str,root);  -- And put it into the tree
	    end if;
	End Loop;
    End scan_input;

Begin
    Put("Cros