home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / cross2.mod < prev    next >
Text File  |  1987-01-08  |  15KB  |  287 lines
  1. (* Cross reference as above, but using a hash table instead
  2.    of a binary tree to store the words encountered. *)
  3.  
  4. (***************************************************************************************)
  5. (* MODULE crossref--This module is a cross reference generator.  A file which is       *)
  6. (* specified by the user is read and a cross reference table of all the words is built.*)
  7. (* A word consists of a letter and any combination of letters and digits thereafter    *)
  8. (* until a separator, i.e. blanks, ends of lines, special characters, is read.  Quotes *)
  9. (* and comments are ignored.  The cross reference table is a hash table which stores   *)
  10. (* the words and the number of the line on which the word appeared.  When the table    *)
  11. (* is generated, its contents are printed on the screen.  This program is the MODULA-2 *)
  12. (* translation of the PASCAL program 11.2.                                             *) 
  13.  
  14.  
  15.  
  16. MODULE crossref;
  17.  
  18. FROM InOut IMPORT                              (* get necessary i/o files             *)
  19.      Read, WriteString, Write, WriteLn, WriteCard, OpenInput, CloseInput, Done;
  20. FROM Storage IMPORT                            (* get NEW procedure                   *)
  21.      ALLOCATE;
  22.  
  23. CONST  ff         = 14c;                       (* clear the screen constant           *)
  24.        eol        = 36c;                       (* end of line constant                *)
  25.        quote      = 42c;                       (* double quote mark                   *)
  26.        wordlen    = 10;                        (* maximum word length                 *)
  27.        numperline = 8;                         (* no of line numbers per display line *)
  28.        digpernum  = 6;                         (* maximum number of digits per number *)
  29.        maxline    = 9999;                      (* maximum number of lines in file     *)
  30.        prime      = 997;                       (* number of hash table entries        *)
  31.        blank      = " ";                       (* blank character constant            *)
  32.        filetype   = "TEXT";                    (* default filename extension          *)
  33.  
  34. TYPE   index    = [0..prime];                  (* range of hash table                 *)
  35.        alfa     = ARRAY[1..wordlen] OF CHAR;   (* word string                         *)
  36.        relation = (equal,less,greater);        (* used for string comparisons         *)
  37.        itemref  = POINTER TO item;
  38.        word     = RECORD                       (* hash table entries                  *)
  39.                     key        : alfa;         (* word found in text                  *)
  40.                     first, last: itemref;      (* pointer to cross reference list     *)
  41.                     follow     : index         (* hash number of next entry           *)
  42.                   END;
  43.        item     = RECORD                       (* cross reference list                *)
  44.                     lineno: [0..maxline];      (* line number word occurred on        *) 
  45.                     next  : itemref            (* pointer to next item in list        *)
  46.                   END;
  47.  
  48. VAR    i        : index;                       (* index to hash table                 *)
  49.        top      : index;                       (* current hash table entry            *)
  50.        idcntr   : INTEGER;                     (* index to id array                   *)
  51.        id       : alfa;                        (* contains the current word           *)
  52.        free     : alfa;                        (* blank word                          *)
  53.        table    : ARRAY [0..prime] OF word;    (* hash table                          *)
  54.        current  : CARDINAL;                    (* current line number                 *)
  55.        ch       : CHAR;                        (* current character                   *)
  56.        tablefull: BOOLEAN;                     (* flags if table gets full            *)
  57.        
  58.  
  59. PROCEDURE compare(j,k:alfa):relation;
  60. (**************************************************************************************)
  61. (* This function compares the two strings j and k to see how they compare.  If j = k  *)
  62. (* then the value of equal is returned.  If j < k then the value is less is returned  *)
  63. (* and if j > k tthen the value greater is returned.                                  *)
  64. (**************************************************************************************)
  65.  
  66.  
  67. VAR compvalue : relation;                     (* function value                       *)
  68.     through   : BOOLEAN;                      (* flags when through with loop         *)
  69.     i         : INTEGER;                      (* array index                          *)
  70.  
  71. BEGIN 
  72.   compvalue := equal;                         (* initializations                      *)
  73.   i         := 1;  
  74.   through   := FALSE;
  75.   WHILE (NOT through) & (i <= 10) DO          (* compare the two strings              *)
  76.     IF CAP(j[i]) = CAP(k[i]) THEN             
  77.       INC(i)
  78.     ELSE
  79.       through := TRUE;
  80.       IF CAP(j[i]) < CAP(k[i]) THEN 
  81.         compvalue := less
  82.       ELSE
  83.         compvalue := greater
  84.       END
  85.     END
  86.   END;
  87.   RETURN compvalue
  88. END compare;
  89.  
  90.  
  91.  
  92. PROCEDURE search():BOOLEAN; 
  93. (**************************************************************************************)
  94. (* This function searches the hash table to see if an entry for the current word      *)
  95. (* already exists.  This is done by calculating the hash value of the current word.   *)
  96. (* If no entry exists at the hash value slot in the table, then an entry is created   *)
  97. (* for that word and an item list created.  If the entry already exists, then only a  *)
  98. (* new item node is created and added to the item list.  If the hash slot is already  *)
  99. (* occupied by a different word, then the hash table is searched for an empty slot.   *)
  100. (* If one is found, then it is filled in with the current word, etc.  If no empty     *)
  101. (* slot can be found, then a message is printed indicating table overflow and the     *)
  102. (* procedure quits, returning the value of FALSE.                                     *)
  103. (**************************************************************************************)
  104.  
  105. VAR  hash         : CARDINAL;                   (* contains hash value                *)
  106.      addvalue     : index;                      (* contains search increment value    *)
  107.      done         : BOOLEAN;                    (* flags when finished                *)
  108.      full         : BOOLEAN;                    (* flags if table is full             *)
  109.      x            : itemref;                    (* pointer to current item list       *)
  110.      compvalue    : relation;                   (* contains result of compare         *)
  111.  
  112.      
  113. BEGIN
  114.   full     := FALSE;                            (* initialize                         *)
  115.   hash     := 0;
  116.   done     := FALSE;
  117.   addvalue := 1;
  118.   NEW(x);                                       (* get a new item list node           *)
  119.   x^.lineno  := current;                        (* fill in current line number        *)
  120.   x^.next := NIL;                               (* set next link to nil               *)
  121.   FOR i := 1 TO wordlen                         (* calculate hash value               *)
  122.     DO
  123.      hash := (hash + ORD(id[i])) MOD prime
  124.     END;
  125.   REPEAT                                        (* continue searching until done      *)
  126.     compvalue := compare(id, table[hash].key);  (* compare id to key to see if equal  *)
  127.     IF compvalue = equal THEN                   (* if word entry already exists       *)
  128.       done := TRUE;                             (* flag to end loop                   *)
  129.       table[hash].last^.next := x;              (* link last item node to new node    *)
  130.       table[hash].last := x                     (* link table pointer to new last node*)
  131.     ELSE
  132.       compvalue := compare(free,table[hash].key);
  133.       IF compvalue = equal THEN                 (* if no entry exists                 *)
  134.         WITH table[hash] DO
  135.           key := id;                            (* fill in current word               *)
  136.           first := x;                           (* link to item node                  *)
  137.           last  := x;
  138.           follow := top                         (* fill in last hash table entry      *)
  139.         END;
  140.         top  := hash;                           (* set to current hash table entry    *)
  141.         done := TRUE
  142.       ELSE                                      (* collision occurred                 *)
  143.         hash := hash + addvalue;                (* incrmt hash to check next entry    *)
  144.         addvalue := addvalue + 2;               (* increment displacement             *)
  145.         IF  hash >= prime THEN             (* if hash value greater than length  *)
  146.     hash := hash - prime                    (* reset hash value                   *)
  147.         END;
  148.         IF addvalue = prime THEN                (* if table is full                   *)
  149.           done := TRUE;                         (* flag that search is through        *)
  150.           full := TRUE;                         (* flag that table is full            *)
  151.           WriteString("Table Overflow");
  152.           WriteLn
  153.         END
  154.       END
  155.     END
  156.   UNTIL done;
  157.   RETURN full
  158. END search;
  159.  
  160.  
  161. PROCEDURE printtable;
  162. (**************************************************************************************)
  163. (* This procedure prints out the cross reference table.  It lists each word and the    *)
  164. (* line numbers on which that word occurred.  Printtable has an internal procedure    *)
  165. (* printword that handles printing the word and its line references.  The cross      *)
  166. (* reference table is printed out in alphabetical order.                              *)
  167. (**************************************************************************************)
  168.  
  169. VAR  hold      : index;                          (* contains the current entry index  *)
  170.      least     : index;                          (* contains index to least word      *) 
  171.      move      : index;                          (* used to search for least word     *)  
  172.      compvalue : relation;                       (* contains compare result           *)
  173.  
  174. PROCEDURE printword(w: word);
  175.  
  176.    
  177.   VAR numcnt: INTEGER;                           (* keeps track line nos on screen    *)
  178.       x     : itemref;                           (* pointer to current item node      *)
  179.  
  180.   BEGIN
  181.     Write(blank);
  182.     WriteString(w.key); 
  183.     x := w.first;
  184.     numcnt := 0;
  185.     REPEAT                                       (* do until all line numbers printed *)
  186.       IF numcnt = numperline THEN                (* if need a new line for line nos   *)
  187.         numcnt := 0;                             (* reset counter                     *)
  188.         WriteLn;
  189.         Write(blank);
  190.         WriteString(free)
  191.       END; 
  192.       INC(numcnt);                               
  193.       WriteCard(x^.lineno,digpernum);            (* write the line number             *)
  194.       Write(blank);                              (* move to next item node            *)
  195.       x := x^.next
  196.     UNTIL x = NIL;
  197.     WriteLn;
  198.   END printword;
  199.  
  200. BEGIN
  201.   hold := top;                                   (* start at last entry to be added   *)
  202.   WHILE hold <> prime                            (* do for all of the table           *)
  203.     DO
  204.       least := hold;                             (* initialize for alphabetic search  *)
  205.       move  := table[hold].follow;
  206.       WHILE move <> prime                        (* search table for least entry      *)
  207.         DO
  208.           compvalue := compare(table[move].key,table[least].key);
  209.           IF compvalue = less THEN
  210.             least := move                   
  211.           END;
  212.           move := table[move].follow
  213.         END;
  214.       printword(table[least]);                    (* print the word and its line nos  *)  
  215.       IF least <> hold THEN                       (* make sure entry won't get printed*)
  216.         table[least].key   := table[hold].key;
  217.         table[least].first := table[hold].first;
  218.         table[least].last  := table[hold].last
  219.       END;
  220.       hold := table[hold].follow                  (* move to the next entry           *)  
  221.      END
  222. END printtable;
  223.  
  224.  
  225. BEGIN                                              (* ***MAIN PROCEDURE***            *)
  226.  
  227.   current   := 0;                                  (* initialize                      *)
  228.   top       := prime;
  229.   tablefull := FALSE;
  230.   FOR i := 1 TO wordlen DO 
  231.     free[i] := blank
  232.   END;
  233.   OpenInput(filetype);                             (* request filename and open file  *)
  234.   IF NOT Done THEN                                 (* if file does not exist quit     *)
  235.     WriteString("Error--file DK.file.TEXT does not exist")
  236.   ELSE                                             (* otherwise continue              *)
  237.     FOR i := 1 TO prime DO                         (* more initialization             *)
  238.       table[i].key := free
  239.     END;
  240.     Read(ch);                                      (* get the first character         *)
  241.     WHILE NOT tablefull DO                         (* do while table is not full      *)
  242.       WHILE Done DO                                (* do while end of file not reached*)
  243.         IF current = maxline THEN                  (* counter exceeds allowed line no *)
  244.           current := 0                             (* reset counter                   *)
  245.         END;
  246.         INC(current);
  247.         WriteCard(current,digpernum);              (* write current line no to screen *)
  248.         Write(blank);
  249.         WHILE (ch <> eol) & (Done) DO              (* while not at end of file line   *)             id := free;
  250.           IF (CAP(ch)>= "A") & (CAP(ch)<="Z") THEN (* see if alphabetic               *)
  251.             idcntr    := 0;
  252.             REPEAT                                 (* get the word and put in id      *)
  253.               IF idcntr < wordlen THEN
  254.                 INC(idcntr);
  255.                 id[idcntr] := ch;
  256.               END;
  257.               Write(ch);
  258.               Read(ch);
  259.              UNTIL ((CAP(ch)<"A") OR (CAP(ch)>"Z")) & ((ch<"0") OR (ch>"9"));
  260.             tablefull := search()                  (* call search to add to table     *)
  261.           ELSE                                     (* if not a word                   *)
  262.             IF ch = quote THEN                     (* if a quote ignore between quotes*)
  263.               REPEAT 
  264.                 Write(ch);
  265.                 Read(ch)
  266.               UNTIL ch = quote       
  267.             ELSIF ch = "{" THEN                    (* if a brace ignore between braces*)
  268.               REPEAT
  269.                 Write(ch);
  270.                 Read(ch)
  271.               UNTIL ch = "}"
  272.             END;
  273.           Write(ch);
  274.           Read(ch);
  275.         END;                                       (* end if alphabetic statement     *)
  276.       END;                                         (* end while not eol loop          *)
  277.       WriteLn;
  278.       Read(ch);
  279.     END;                                           (* end while not eof loop          *)
  280.     tablefull := TRUE;                             (* exit outer loop so can print tab*)
  281.   END;
  282.   CloseInput;                                      (* close the input file            *)
  283.   (* Write(ff) *)
  284.   printtable;                                      (* print the table                 *)
  285.   END 
  286. END crossref.
  287.