1 /****^  ***********************************************************
 2         *                                                         *
 3         * Copyright, (C) BULL HN Information Systems Inc., 1989   *
 4         *                                                         *
 5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 6         *                                                         *
 7         * Copyright (c) 1972 by Massachusetts Institute of        *
 8         * Technology and Honeywell Information Systems, Inc.      *
 9         *                                                         *
10         *********************************************************** */
11 
12 
13 
14 /****^  HISTORY COMMENTS:
15   1) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu),
16      install(89-07-31,MR12.3-1066):
17      Removed the obsolete parameter source_line from the call to error_().
18                                                    END HISTORY COMMENTS */
19 
20 
21 /* format: style3,^indattr,ifthendo,ifthen,^indnoniterdo,indproc,^elsestmt,dclind9,idind23 */
22 error:
23      proc (err_no, statement_pt, token_pt);
24 
25 dcl      err_no fixed bin (15) parameter;
26 dcl      (statement_pt, token_pt) ptr parameter;
27 
28 dcl      n fixed bin;
29 dcl      p pointer;
30 
31 dcl      (null, string) builtin;
32 
33 dcl      pl1_stat_$err_stm ptr ext;
34 %page;
35 %include language_utility;
36 %page;
37 %include source_id;
38 %page;
39 %include statement;
40 %page;
41 %include source_list;
42 %page;
43 /* program */
44           pl1_stat_$err_stm, p = statement_pt;
45           if p = null then do;
46                string (source_id) = "0"b;
47                call error_$no_text (err_no, source_id, token_pt);
48           end;
49           else
50                call error_ (err_no, p -> statement.source_id, token_pt, (p -> statement.source.segment),
51                     (p -> statement.source.start), (p -> statement.source.length));
52 
53           return;
54 %page;
55 /*
56  *
57  */
58 error$omit_text:
59      entry (err_no, statement_pt, token_pt);
60 
61           pl1_stat_$err_stm, p = statement_pt;
62           if p = null then do;
63                string (source_id) = "0"b;
64                call error_$no_text (err_no, source_id, token_pt);
65           end;
66           else
67                call error_$no_text (err_no, p -> statement.source_id, token_pt);
68           return;
69      end error;