(*$M-,T-,L+,C+*)
PROGRAM XREF(INPUT,OUTPUT) ;
(*CROSS REFERENCE GENERATOR FOR PASCAL PROGRAMS.  N.WIRTH, 7.5.74*)
(* 'QUADRATIC QUOTIENT' HASH METHOD *)
(* PASCAL-6000 DEPENDENT CONSTRUCTS CHANGED. S.HAZEGHI, 6.10.76 *)
   LABEL 99;
   CONST P = 79;           (*SIZE OF HASHTABLE*)
      NK = 31;               (*NO. OF KEYWORDS*)
      EMPTY = '          ';
   TYPE INDEX = 0..P;
      REF = @ITEM;
      ALFA = ARRAY[1..10] OF CHAR;
      WORD = RECORD KEY: ALFA;
                    FIRST, LAST: REF;
                    FOL: INDEX
             END ;
      ITEM = RECORD
                    LNO: 0..9999;
                    NEXT: REF
             END ;
   VAR I,TOP: INDEX;     (*TOP OF CHAIN LINKING ALL ENTRIES IN T*)
      CH:CHAR;
      EOLFLAG: BOOLEAN;
      K,K1: INTEGER;
      N: INTEGER;        (*CURRENT LINE NUMBER*)
      C1, C2: INTEGER;   (*FREQUENCY COUNTERS*)
      ID: RECORD CASE LRG1:BOOLEAN OF
                 FALSE: (A: ALFA); TRUE: (ORD: INTEGER)
          END ;
      LETTERS,DIGITS: SET OF CHAR;
      A: ARRAY [1..10] OF CHAR;  (*IDENTIFIER BUFFER*)
      KEY: ARRAY [1..NK] OF ALFA;
      T: ARRAY [INDEX] OF WORD;        (*HASH TABLE*)
    
   FUNCTION NOKEY(X: ALFA): BOOLEAN;
      VAR I,J,K: INTEGER;
   BEGIN I := 1; J := NK;
      REPEAT K := (I+J) DIV 2;      (*BINARY SEARCH*)
         IF KEY[K] <= X THEN I := K+1;
         IF KEY[K] >= X THEN J := K-1;
      UNTIL I > J;
      NOKEY := KEY[K] <> X
   END (*FINDKEY*) ;

   PROCEDURE NEXTCH;
    BEGIN
    IF EOLFLAG THEN
        BEGIN
        WRITELN(OUTPUT);
        IF N<9999 THEN
            N:=N+1
        ELSE BEGIN
             WRITELN(OUTPUT,' TEXT TOO LONG');
             EXIT(99)
             END;
         WRITE(OUTPUT,N:6,'  ');
         END;
    EOLFLAG:=EOLN(INPUT);
    READ(INPUT,CH);
    WRITE(OUTPUT,CH);
    END;    (*NEXTCH*)

    PROCEDURE SEARCH;
      (*GLOBAL: T, ID, TOP*)
   VAR H,D,I: INDEX;
      X: REF; F: BOOLEAN;
   BEGIN H := ABS(ORD(ID.A[1])*256+ORD(ID.A[2]))  MOD P;
      F := FALSE; D := 1; C2 := C2 + 1;
      NEW(X); X@.LNO := N; X@.NEXT := NIL;
      REPEAT
         IF T[H].KEY = ID.A THEN
         BEGIN (*FOUND*) F := TRUE;
            T[H].LAST@.NEXT := X; T[H].LAST := X
         END ELSE
         IF T[H].KEY = EMPTY THEN
         BEGIN (*NEW ENTRY*) F := TRUE; C1 := C1 + 1;
            T[H].KEY := ID.A;
            T[H].FIRST := X; T[H].LAST := X;
            T[H].FOL := TOP; TOP := H;
         END ELSE
         BEGIN (*COLLISION*) H := H+D; D := D+2;
            IF H >= P THEN H := H - P;
            IF D = P THEN
            BEGIN WRITELN(OUTPUT); WRITELN(OUTPUT,' **** TABLE FULL');
                  EXIT(99)
            END ;
         END
      UNTIL F
   END (*SEARCH*) ;

   PROCEDURE PRINTWORD(W: WORD);
      VAR L: INTEGER; X: REF;
   BEGIN WRITE(OUTPUT,' ',W.KEY);
      X := W.FIRST; L := 0;
      REPEAT IF L = 20 THEN
             BEGIN L := 0;
               WRITELN(OUTPUT); WRITE(OUTPUT,' ',EMPTY)
             END ;
         L := L+1; WRITE(OUTPUT,X@.LNO:6); X := X@.NEXT
      UNTIL X = NIL;
      WRITELN(OUTPUT);
   END (*PRINTWORD*) ;

   PROCEDURE PRINTTABLE;
      VAR I,J,M: INDEX;
   BEGIN I := TOP;
      WHILE I <> P DO
      BEGIN (*FIND MINIMAL WORD*)
         M := I; J := T[I].FOL;
         WHILE J <> P DO
         BEGIN IF T[J].KEY < T[M].KEY THEN M := J;
            J := T[J].FOL
         END ;
         PRINTWORD(T[M]);
         IF M <> I THEN
         BEGIN T[M].KEY := T[I].KEY;
            T[M].FIRST := T[I].FIRST; T[M].LAST := T[I].LAST
         END ;
         I := T[I].FOL
      END
   END (*PRINTTABLE*) ;
    
BEGIN (*CROSSREF*)
    LETTERS:=['A'..'Z'] ;
    DIGITS:=['0'..'9'];
   FOR I := 0 TO P-1 DO  T[I].KEY := EMPTY;
   C1 := 0; C2 := 0;
   KEY[ 1] := 'AND       '; KEY[ 2] := 'ARRAY     ';
   KEY[ 3] := 'BEGIN     '; KEY[ 4] := 'CASE      ';
   KEY[ 5] := 'CONST     '; KEY[ 6] := 'DIV       ';
   KEY[ 7] := 'DOWNTO    '; KEY[ 8] := 'DO        ';
   KEY[ 9] := 'ELSE      '; KEY[10] := 'END       ';
   KEY[11] := 'FILE      '; KEY[12] := 'FOR       ';
   KEY[13] := 'FUNCTION  '; KEY[14] := 'IF        ';
   KEY[15] := 'IN        '; KEY[16] := 'MOD       ';
   KEY[17] := 'NIL       '; KEY[18] := 'NOT       ';
   KEY[19] := 'OF        '; KEY[20] := 'OR        ';
   KEY[21] := 'PROCEDURE '; KEY[22] := 'RECORD    ';
   KEY[23] := 'REPEAT    '; KEY[24] := 'SET       ';
   KEY[25] := 'THEN      '; KEY[26] := 'TO        ';
   KEY[27] := 'TYPE      '; KEY[28] := 'UNTIL     ';
   KEY[29] := 'VAR       '; KEY[30] := 'WHILE     ';
   KEY[31] := 'WITH      ';

   (*SCAN INPUT FILE FOR IDENTIFIERS*)
   N := 0; TOP := P; K1 := 10;
   WRITELN(OUTPUT); EOLFLAG:=TRUE; NEXTCH;
   WHILE NOT EOF(INPUT) DO
   BEGIN
      WHILE NOT EOLFLAG DO
      BEGIN
         IF CH = ' ' THEN  NEXTCH
         ELSE IF CH IN LETTERS THEN
         BEGIN K := 0;
            REPEAT
               IF K < 10 THEN
                  BEGIN K := K+1; A[K] := CH
                  END ;
               NEXTCH
            UNTIL NOT (CH IN LETTERS + DIGITS+['_','$']);
            IF K >= K1 THEN K := K1 ELSE
               REPEAT K := K+1; A[K] := ' '
               UNTIL K1 = K;
            ID.A:=A;
            IF NOKEY(ID.A) THEN SEARCH
         END ELSE
         IF CH IN DIGITS THEN
            REPEAT  NEXTCH
            UNTIL NOT (CH IN LETTERS + DIGITS) ELSE
         IF CH = '''' THEN
         BEGIN
            REPEAT  NEXTCH
            UNTIL CH = '''' ;
            NEXTCH
         END ELSE
         IF CH = '(' THEN
            BEGIN NEXTCH;
               IF CH = '*' THEN
                  BEGIN (*COMMENT*) NEXTCH;
                     REPEAT WHILE CH <> '*' DO NEXTCH;
                            NEXTCH
                     UNTIL CH = ')';
                     NEXTCH
                  END
            END ELSE
         NEXTCH
      END ;
      NEXTCH
   END ;

  WRITELN(OUTPUT); WRITELN(OUTPUT);
99: PRINTTABLE;
    WRITELN(OUTPUT,' ',C1:6,' IDENTIFIERS',C2:6,' OCCURRENCES');
END .