lang/m2/test/Wirth/XREF.mod

   1 MODULE XREF;
   2   FROM InOut    IMPORT  Done, EOL, OpenInput, OpenOutput, Read, Write,
   3                         WriteCard, WriteString, CloseInput, CloseOutput;
   4
   5   FROM TableHandler IMPORT
   6                         WordLength, Table, overflow, InitTable, Record,
   7                         Tabulate;
   8
   9   TYPE  Alfa = ARRAY [0..9] OF CHAR;
  10
  11   CONST N = 45;         (* number of keywords *)
  12
  13   VAR   ch: CHAR;
  14         i,k,l,m,r,lno: CARDINAL;
  15         T: Table;
  16         id: ARRAY [0..WordLength-1] OF CHAR;
  17         key: ARRAY [1..N] OF Alfa;
  18
  19   PROCEDURE copy;
  20   BEGIN
  21         Write(ch);
  22         Read(ch)
  23   END copy;
  24
  25   PROCEDURE heading;
  26   BEGIN
  27         lno := lno + 1;
  28         WriteCard(lno, 5);
  29         WriteString("   ")
  30   END heading;
  31
  32 BEGIN
  33         InitTable(T);
  34         key[1] := "AND ";
  35         key[2] := "ARRAY ";
  36         key[3] := "BEGIN ";
  37         key[4] := "BITSET ";
  38         key[5] := "BOOLEAN ";
  39         key[6] := "BY ";
  40         key[7] := "CASE ";
  41         key[8] := "CARDINAL ";
  42         key[9] := "CHAR ";
  43         key[10] := "CONST ";
  44         key[11] := "DIV ";
  45         key[12] := "DO ";
  46         key[13] := "ELSE ";
  47         key[14] := "ELSIF ";
  48         key[15] := "END ";
  49         key[16] := "EXIT ";
  50         key[17] := "EXPORT ";
  51         key[18] := "FALSE ";
  52         key[19] := "FOR ";
  53         key[20] := "FROM ";
  54         key[21] := "IF ";
  55         key[22] := "IMPORT ";
  56         key[23] := "IN ";
  57         key[24] := "INTEGER ";
  58         key[25] := "LOOP ";
  59         key[26] := "MOD ";
  60         key[27] := "MODULE ";
  61         key[28] := "NOT ";
  62         key[29] := "OF ";
  63         key[30] := "OR ";
  64         key[31] := "POINTER ";
  65         key[32] := "PROCEDURE ";
  66         key[33] := "QUALIFIED ";
  67         key[34] := "RECORD ";
  68         key[35] := "REPEAT ";
  69         key[36] := "RETURN ";
  70         key[37] := "SET ";
  71         key[38] := "THEN ";
  72         key[39] := "TO ";
  73         key[40] := "TRUE ";
  74         key[41] := "TYPE ";
  75         key[42] := "UNTIL ";
  76         key[43] := "VAR ";
  77         key[44] := "WHILE ";
  78         key[45] := "WITH ";
  79
  80         OpenInput("mod");
  81         IF NOT Done THEN HALT END;
  82         OpenOutput("xref");
  83         lno := 0;
  84         Read(ch);
  85         IF Done THEN
  86             heading;
  87             REPEAT
  88                 IF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN
  89                     k := 0;
  90                     REPEAT
  91                         id[k] := ch;
  92                         k := k + 1;
  93                         copy
  94                     UNTIL (ch < "0") OR
  95                           (ch > "9") & (CAP(ch) < "A") OR
  96                           (CAP(ch) > "Z");
  97                     l := 1;
  98                     r := N;
  99                     id[k] := " ";
 100                     REPEAT      (* binary search *)
 101                         m := (l + r) DIV 2;
 102                         i := 0;
 103                         WHILE (id[i] = key[m,i]) & (id[i] > " ") DO
 104                                 i := i+1;
 105                         END;
 106                         IF id[i] <= key[m,i] THEN r := m-1 END;
 107                         IF id[i] >= key[m,i] THEN l := m+1 END;
 108                     UNTIL l > r;
 109                     IF l = r+1 THEN Record(T, id, lno) END
 110                 ELSIF (ch >= "0") & (ch <= "9") THEN
 111                     REPEAT
 112                         copy
 113                     UNTIL ((ch<"0") OR (ch>"9"))&((ch<"A") OR (ch>"Z"))
 114                 ELSIF ch = "(" THEN
 115                     copy;
 116                     IF ch = "*" THEN    (* comment *)
 117                         REPEAT
 118                             REPEAT
 119                                 IF ch = EOL THEN
 120                                     copy;
 121                                     heading
 122                                 ELSE
 123                                     copy
 124                                 END
 125                             UNTIL ch = "*";
 126                             copy
 127                         UNTIL ch = ")";
 128                         copy
 129                     END
 130                 ELSIF ch = "'" THEN
 131                     REPEAT copy UNTIL ch = "'";
 132                     copy
 133                 ELSIF ch = '"' THEN
 134                     REPEAT copy UNTIL ch = '"';
 135                     copy
 136                 ELSIF ch = EOL THEN
 137                     copy;
 138                     IF Done THEN heading END
 139                 ELSE
 140                     copy
 141                 END
 142             UNTIL NOT Done OR (overflow # 0)
 143         END;
 144         IF overflow > 0 THEN
 145             WriteString("Table overflow");
 146             WriteCard(overflow, 6);
 147             Write(EOL)
 148         END;
 149         Write(14C);
 150         Tabulate(T);
 151         CloseInput;
 152         CloseOutput
 153 END XREF.