1           /* START OF:        rdc_error_.incl.pl1             *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  2 
  3      dcl  MERROR_SEVERITY               fixed bin init (0), /* Severity of highest-severity error.            */
  4           SERROR_CONTROL                bit(2) init ("00"b),/* Global switches control error message format.  */
  5           SERROR_PRINTED (dimension (error_control_table,1))
  6                                         bit(1) unaligned init ((dimension (error_control_table,1))(1)"0"b),
  7                                                             /* Array bit is on if corresponding error message */
  8                                                             /* in error_control_table has already been printed*/
  9           MIN_PRINT_SEVERITY            fixed bin init (0), /* Mimimum severity message that will be printed  */
 10           PRINT_SEVERITY_CONTROL        bit(2) init ("11"b);/* Action if severity < MIN_PRINT_SEVERITY        */
 11 
 12           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 13           /*                                                                                        */
 14           /* N^H__^Ha_^Hm_^He:  rdc_error_.incl.pl1                                                                     */
 15           /*                                                                                        */
 16           /*      This include segment is used by compilers generated by the reduction_compiler.    */
 17           /* It defines a procedure which the compilers can use to print error messages.            */
 18           /*                                                                                        */
 19           /* E^H__^Hn_^Ht_^Hr_^Hy:  ERROR                                                                               */
 20           /*                                                                                        */
 21           /*      Given an error number, this procedure prints a corresponding error message.       */
 22           /* The message is stored in a compiler-defined error_control_table, along with an integer */
 23           /* which specifies the severity level of the error, and a switch which specifies whether  */
 24           /* the source statement in which the error occurred (if any) should be printed after the  */
 25           /* error message.  The printing of the error message may be supressed for all messages    */
 26           /* having a severity less than a specified (MIN_PRINT_SEVERITY) value.  The ERROR         */
 27           /*  procedure calls the lex_error_ subroutine to perform the formatting and printing of   */
 28           /*  the error message.                                                                    */
 29           /*                                                                                        */
 30           /* U^H__^Hs_^Ha_^Hg_^He                                                                                       */
 31           /*                                                                                        */
 32           /*      call ERROR (error_number);                                                        */
 33           /*                                                                                        */
 34           /* 1) error_number  is the index of one of the structures in the error_control_table      */
 35           /*                  which defines the error message to be printed.                        */
 36           /*                                                                                        */
 37           /* N^H__^Ho_^Ht_^He_^Hs                                                                                       */
 38           /*                                                                                        */
 39           /*      The format of the error_control_table is shown below.                             */
 40           /*                                                                                        */
 41           /*   dcl  1 error_control_table (2)     aligned internal static,                          */
 42           /*          2 severity                  fixed bin(17) unaligned init (2,3),               */
 43           /*          2 Soutput_stmt              bit(1) unaligned initial ("0"b,"1"b),             */
 44           /*          2 message                   char(252) varying initial (                       */
 45           /*                  "The reduction source segment does not contain any reductions.",      */
 46           /*                  "Reduction label  '^a'  is invalid."),                                */
 47           /*          2 brief_message             char(100) varying initial (                       */
 48           /*                  "", "'^a'");                                                          */
 49           /*                                                                                        */
 50           /* error_control_table is an array of structures, with one array element per error.       */
 51           /* Each structure contains: a severity level for the error; a switch which specifies      */
 52           /* whether the source statement being processed should be output after the error message; */
 53           /* the long form of the error message text;  and the brief form of the error message text.*/
 54           /* The dimension of the error_control_table array of structures, and the lengths of       */
 55           /* message (long message) and brief_message (brief message), are compiler-defined.        */
 56           /* structures and the lengths of the message and brief_message are compiler-defined.      */
 57           /* The only requirement is that the messages be 256 characters or less in length.         */
 58           /* (Remember that the longest character string which can be used in an initial attribute  */
 59           /* is 254 characters in length.)                                                          */
 60           /*                                                                                        */
 61           /*      The severity number causes the error message to be preceded by a herald which     */
 62           /* includes one of the following prefixes:                                                */
 63           /*                                                                                        */
 64           /*       _^Hs_^He_^Hv  _^Hp_^Hr_^He_^Hf_^Hi_^Hx               _^He_^Hx_^Hp_^Hl_^Ha_^Hn_^Ha_^Ht_^Hi_^Ho_^Hn                                  */
 65           /*        0 = COMMENT                   - this is a comment.                              */
 66           /*        1 = WARNING                   - a possible error has been detected.  The        */
 67           /*                                        compiler will still generate an object segment. */
 68           /*        2 = ERROR                     - a probable error has been detected.  The        */
 69           /*                                        compiler will still generate an object segment. */
 70           /*        3 = FATAL ERROR               - an error has been detected which is so severe   */
 71           /*                                        that no object segment will be generated.       */
 72           /*        4 = TRANSLATOR ERROR          - an error has been detected in the operation of  */
 73           /*                                        the compiler or translator.  No object segment  */
 74           /*                                        will be generated.                              */
 75           /*                                                                                        */
 76           /* Full error messages are of the form:                                                   */
 77           /*                                                                                        */
 78           /*        _^Hp_^Hr_^He_^Hf_^Hi_^Hx _^He_^Hr_^Hr_^Ho_^Hr__^Hn_^Hu_^Hm_^Hb_^He_^Hr, SEVERITY _^Hs_^He_^Hv_^He_^Hr_^Hi_^Ht_^Hy IN STATEMENT _^Hn OF LINE _^Hm                */
 79           /*        _^Ht_^He_^Hx_^Ht__^Ho_^Hf__^He_^Hr_^Hr_^Ho_^Hr__^Hm_^He_^Hs_^Hs_^Ha_^Hg_^He                                                       */
 80           /*        SOURCE:                                                                         */
 81           /*        _^Hs_^Ho_^Hu_^Hr_^Hc_^He__^Hs_^Ht_^Ha_^Ht_^He_^Hm_^He_^Hn_^Ht                                                                     */
 82           /*                                                                                        */
 83           /* If only one statement appears in line _^Hm, then "STATEMENT _^Hn OF" is omitted.                 */
 84           /* If the source statement has been printed in a previous error message, it is omitted.   */
 85           /*                                                                                        */
 86           /*      The reduction compiler declares a bit string, SERROR_CONTROL, which controls the  */
 87           /* text of an error message.  The compiler may set this bit string, as shown below.       */
 88           /*                                                                                        */
 89           /*   SERROR_CONTROL           _^Hm_^He_^Ha_^Hn_^Hi_^Hn_^Hg                                                    */
 90           /*        "00"b               the first time a particular error occurs, the long message  */
 91           /*                            is printed; the brief message is used in subsequent         */
 92           /*                            occurrences of that error.                                  */
 93           /*        "10"b or "11"b      the long error message is always used.                      */
 94           /*        "01"b               the brief error message is always used.                     */
 95           /* The initial value of SERROR_CONTROL is "00"b.                                          */
 96           /*                                                                                        */
 97           /*      The reduction_compiler creates a declaration for SERROR_PRINTED, an array         */
 98           /* of switches (one per error).  The switch corresponding to a particular error is        */
 99           /* turned on whenever the error message is printed.  This allows lex_error_ to detect     */
100           /* subsequent occurrences of that same error.                                             */
101           /*                                                                                        */
102           /*      The reduction_compiler creates MERROR_SEVERITY, a fixed bin(17) integer           */
103           /* in which the severity of the highest-severity error encountered is maintained.         */
104           /* The compiler may reference this integer.                                               */
105           /*                                                                                        */
106           /*      The reduction_compiler creates MIN_PRINT_SEVERITY, a fixed bin (17) integer       */
107           /* which controls the printing of error messages by the ERROR procedure.                  */
108           /* Errors having a severity less than MIN_PRINT_SEVERITY will not cause lex_error_ to be  */
109           /* and no error will be printed.  The behaviour of the ERROR procedure for such errors    */
110           /* is controlled by the value of PRINT_SEVERITY_CONTROL, described below.                 */
111           /* The compiler may set the value of MIN_PRINT_SEVERITY; its initial value is 0.          */
112 ^L
113           /*                                                                                        */
114           /*      The reduction_compiler declares a bit string, PRINT_SEVERITY_CONTROL, which       */
115           /* controls the updating of MERROR_SEVERITY and SERROR_PRINTED when the severity of an    */
116           /* error is less than MIN_PRINT_SEVERITY.  In such cases, the lex_error_ procedure is not */
117           /* invoked, and the ERROR procedure must update these values as though lex_error_ were    */
118           /* called.  The compiler may set this bit string, as shown below.                         */
119           /*                                                                                        */
120           /* PRINT_SEVERITY_CONTROL     _^Hm_^He_^Ha_^Hn_^Hi_^Hn_^Hg                                                    */
121           /*        "00"b               update neither SERROR_PRINTED nor MERROR_SEVERITY.          */
122           /*        "01"b               update SERROR_PRINTED to reflect the error.                 */
123           /*        "10"b               update MERROR_SEVERITY to reflect the error severity.       */
124           /*        "11"b               update SERROR_PRINTED and MERROR_SEVERITY appropriately.    */
125           /*The initial value of PRINT_SEVERITY_CONTROL is "11"b.                                   */
126           /*                                                                                        */
127           /*      The ERROR procedure is simple to use, but it does limit the flexibility of the    */
128           /* error message.  A compiler action routine can output more flexible error messages      */
129           /* by calling lex_error_ directly.  See lex_error_ documentation for more details.        */
130           /*                                                                                        */
131           /* S^H__^Ht_^Ha_^Ht_^Hu_^Hs                                                                                   */
132           /*                                                                                        */
133           /* 0) Created:  April, 1974 by G. C. Dixon                                                */
134           /* 1) Modified: April, 1982 by E. N. Kittlitz.  Added MIN_PRINT_SEVERITY,                 */
135           /*                  PRINT_SEVERITY_CONTROL.                                               */
136           /*                                                                                        */
137           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
138 ^L
139 ERROR:    procedure (Nerror);
140 
141      dcl  Nerror                        fixed bin;          /* Number of the error which was detected. (In)   */
142 
143      dcl  Pstmt                         ptr,
144           1 erring_token                aligned based (Perring_token) like token,
145           Perring_token                 ptr,
146           erring_token_value            char(erring_token.Lvalue) based (erring_token.Pvalue);
147 
148      dcl  (max, null)                   builtin;
149 
150      dcl  lex_error_                    entry options (variable);
151 
152 
153           if error_control_table.severity(Nerror) < MIN_PRINT_SEVERITY then do; /* don't print                */
154                if PRINT_SEVERITY_CONTROL & "1"b then        /* update MERROR_SEVERITY                         */
155                     MERROR_SEVERITY = max (MERROR_SEVERITY, error_control_table.severity(Nerror));
156                if PRINT_SEVERITY_CONTROL & "01"b then       /* update SERROR_PRINTED                          */
157                     SERROR_PRINTED(Nerror) = "1"b;
158                return;
159           end;
160           Perring_token = Pthis_token;                      /* address the current erring_token.              */
161           if error_control_table.Soutput_stmt(Nerror) then
162                if Perring_token = null then
163                     Pstmt = null;
164                else
165                     Pstmt = erring_token.Pstmt;             /* address the statement descriptor.              */
166           else
167                Pstmt = null;
168           if Perring_token = null then
169                call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)),
170                     MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)),
171                     (error_control_table.brief_message(Nerror)));
172           else
173                call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)),
174                     MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)),
175                     (error_control_table.brief_message(Nerror)), erring_token_value, erring_token_value, erring_token_value);
176 
177           end ERROR;
178 
179           /* END OF:          rdc_error_.incl.pl1             *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */