1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) BULL HN Information Systems Inc., 1989   *
  4    *                                                         *
  5    * Copyright, (C) Honeywell Bull Inc., 1987                *
  6    *                                                         *
  7    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  8    *                                                         *
  9    * Copyright (c) 1972 by Massachusetts Institute of        *
 10    * Technology and Honeywell Information Systems, Inc.      *
 11    *                                                         *
 12    *********************************************************** */
 13 
 14 
 15 
 16 
 17 /* HISTORY COMMENTS:
 18   1) change(1986-07-15,Ginter), approve(1986-07-15,MCR7287),
 19      audit(1986-07-16,Mabey), install(1986-07-28,MR12.0-1105):
 20      Change the version number for the MR12.0 release of the compiler.
 21   2) change(1988-01-26,RWaters), approve(1988-01-26,MCR7724),
 22      audit(1988-02-05,Huen), install(1988-02-16,MR12.2-1024):
 23      Change the version number for the MR12.2 release of the compiler.
 24   3) change(1988-08-23,RWaters), approve(1988-08-23,MCR7914),
 25      audit(1988-09-28,Huen), install(1988-10-12,MR12.2-1163):
 26      Change the version number for the MR12.2 release (Vers. 31a)
 27   4) change(1989-03-28,Huen), approve(1989-03-28,MCR8077),
 28      audit(1989-04-26,JRGray), install(1989-06-16,MR12.3-1059):
 29      Change the version number for the MR12.3 release (Vers. 31b)
 30   5) change(1989-04-04,Huen), approve(1989-04-04,MCR8092),
 31      audit(1989-04-26,RWaters), install(1989-06-16,MR12.3-1059):
 32      Change the version number for the MR12.3 release (Vers. 32a)
 33   6) change(1989-04-17,JRGray), approve(1989-04-17,MCR8078),
 34      audit(1989-04-18,Huen), install(1989-06-16,MR12.3-1059):
 35      Updated version to 32b, part of archive pathname support.
 36   7) change(1989-04-24,RWaters), approve(1989-04-24,MCR8101),
 37      audit(1989-04-27,Huen), install(1989-06-16,MR12.3-1059):
 38      Updated the version number to 32c.
 39   8) change(1989-07-10,RWaters), approve(1989-07-10,MCR8069),
 40      audit(1989-09-07,Vu), install(1989-09-19,MR12.3-1068):
 41      Update Version Number for numerous installed changes.
 42   9) change(1989-07-28,JRGray), approve(1989-07-28,MCR8123),
 43      audit(1989-09-12,Vu), install(1989-09-22,MR12.3-1073):
 44      Updated version to 32e for opt conditional fix  (pl1 2091 fix 2177).
 45  10) change(1989-10-02,Vu), approve(1989-10-02,MCR8139),
 46      audit(1989-10-04,Blackmore), install(1989-10-09,MR12.3-1086):
 47      Updated version to 32f for two named constant changes.
 48  11) change(1990-05-03,Huen), approve(1990-05-03,MCR8169),
 49      audit(1990-05-18,Gray), install(1990-05-30,MR12.4-1012):
 50      Updated version to 33a for pl1 opt concat of a common string exp bug
 51      (pl1_1885)
 52  12) change(1990-08-24,Huen), approve(1990-08-24,MCR8187),
 53      audit(1990-10-03,Zimmerman), install(1990-10-17,MR12.4-1046):
 54      Updated version to 33b for pl1 padded reference bug (phx13134, pl1_2224)
 55  13) change(1990-08-30,Huen), approve(1990-08-30,MCR8160),
 56      audit(1990-10-03,Zimmerman), install(1990-10-17,MR12.4-1046):
 57      version (33b) is also for fixing PL1 to not complain about constant
 58      symbols that are actually legal.
 59  14) change(1990-10-17,Gray), approve(1990-10-17,MCR8160),
 60      audit(1990-10-19,Schroth), install(1990-10-25,MR12.4-1049):
 61      Modified to 33c to only validate constants for syms dcled by dcl
 62      statement.
 63  15) change(1991-01-09,Blackmore), approve(1991-01-09,MCR8234),
 64      audit(1991-12-05,Huen), install(1992-04-24,MR12.5-1011):
 65      Change version to 33d, with constant reference resolution fix.
 66  16) change(1992-09-17,Zimmerman), approve(1992-09-17,MCR8257),
 67      audit(1992-09-18,Vu), install(1992-10-06,MR12.5-1023):
 68      Updated version number to 33e (MR 12.5). Fix source listing
 69      overflow problem. (PL1 error list entry 2212).
 70  17) change(2016-12-31,Anthony), approve(2016-12-31,MCR10023),
 71      audit(2017-01-08,GDixon), install(2017-01-09,MR12.6f-0011):
 72      Update declaration of decode_clock_value_$date_time to declare time zone
 73      parameter as char(4) and time_zone automatic variable as char(4).
 74  18) change(2017-02-09,Swenson), approve(2017-02-09,MCR10029),
 75      audit(2017-02-11,Davidoff), install(2017-02-11,MR12.6f-0016):
 76      Fix the previous fix (MCR8169) to string concatenation.  See
 77      http://multics-trac.swenson.org/ticket/9 for details. Update compiler
 78      version to 33f.
 79                                                    END HISTORY COMMENTS */
 80 
 81 
 82 /* format: style3 */
 83 (stringsize):
 84 pl1_version:
 85      procedure;
 86 
 87 /*     Written: 25 September 1979 by PCK to replace stand alone segment, pl1_version_ */
 88 /*     Modified: 28 January 1988 by RW to fix 1994 and 2186 */
 89 
 90 /* external entries */
 91 
 92 dcl       create_data_segment_
 93                               entry (ptr, fixed bin (35));
 94 dcl       ioa_                entry options (variable);
 95 dcl       com_err_            entry options (variable);
 96 dcl       decode_clock_value_$date_time
 97                               entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
 98                               fixed bin (71), fixed bin, char (4), fixed bin (35));
 99 
100 /* builtins */
101 
102 dcl       (addr, clock, ltrim, size, unspec)
103                               builtin;
104 
105 /* internal static */
106 
107 dcl       day_of_week_string  (1:7) character (9) varying int static options (constant)
108                               init ("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday");
109 dcl       month_string        (1:12) character (9) varying int static options (constant)
110                               init ("January", "February", "March", "April", "May", "June", "July", "August", "September",
111                               "October", "November", "December");
112 dcl       my_name             character (11) int static init ("pl1_version") options (constant);
113 
114 /* conditions */
115 
116 dcl       (stringsize, error) condition;
117 
118 /* automatic */
119 
120 /* RELEASE = "" for the >experimental_library compiler,
121            = <release_number> for the >system_standard_library compiler */
122 
123 dcl       RELEASE             character (3) varying init ("33f");
124 dcl       (clock_reading, microsecond)
125                               fixed bin (71);
126 dcl       (month, day_of_month, year, day_of_week, hour, minute, second)
127                               fixed bin;
128 dcl       time_zone           character (4) init ("");
129 dcl       pl1_version_string  character (256) varying;
130 dcl       code                fixed bin (35);
131 dcl       1 cdsa              like cds_args aligned;        /* info to be passed to
132                                           create_data_segment_ */
133 dcl       1 pl1_version_struc,
134             2 pl1_version     character (256) varying,
135             2 pl1_release     character (3) varying;
136 dcl       year_pic            picture "9999";
137 dcl       day_of_month_pic    picture "zz";
138 dcl       hour_pic            picture "99";
139 dcl       minute_pic          picture "99";
140 
141 /* include file */
142 
143 %include cds_args;
144 
145 /* on unit */
146 
147           on stringsize
148                begin;
149                     call com_err_ (0, my_name, "Stringsize raised.");
150                     signal error;
151                end;
152 
153 /* program */
154 
155 /* Read system clock and convert to calendar date-time */
156 
157           clock_reading = clock ();
158           call decode_clock_value_$date_time (clock_reading, month, day_of_month, year, hour, minute, second, microsecond,
159                day_of_week, time_zone, code);
160 
161           if code ^= 0
162           then do;
163                     call com_err_ (code, my_name);
164                     return;
165                end;
166 
167           year_pic = year;
168           day_of_month_pic = day_of_month;
169 
170 /* Generate a pl1_version_string appropriate for an EXL or SSS compiler */
171 
172           if RELEASE ^= ""
173           then pl1_version_string =
174                     "Multics PL/I Compiler, Release " || RELEASE || ", of " || month_string (month) || " "
175                     || ltrim (day_of_month_pic) || ", " || year_pic;
176           else do;
177                     hour_pic = hour;
178                     minute_pic = minute;
179                     pl1_version_string =
180                          "PL/I Compiler of " || day_of_week_string (day_of_week) || ", "
181                          || month_string (month) || " " || ltrim (day_of_month_pic) || ", " || year_pic || " at "
182                          || hour_pic || ":" || minute_pic;
183                end;
184 
185 /* Let user know what version string has been generated */
186 
187           call ioa_ ("^a: pl1_version_=""^a"".", my_name, pl1_version_string);
188 
189 /* Fill in pl1_version_struc with version and release info */
190 
191           unspec (pl1_version_struc) = ""b;
192           pl1_version_struc.pl1_version = pl1_version_string;
193           pl1_version_struc.pl1_release = RELEASE;
194 
195 /* Fill in cdsa for call to create_data_segment_ */
196 
197           unspec (cdsa) = "0"b;
198           cdsa.have_text = "1"b;                            /* Place pl1_version info in text section */
199           cdsa.sections (1).p = addr (pl1_version_struc);
200           cdsa.sections (1).len = size (pl1_version_struc);
201           cdsa.sections (1).struct_name = "pl1_version_struc";
202           cdsa.seg_name = my_name;
203 
204           call create_data_segment_ (addr (cdsa), code);
205           if code ^= 0
206           then call com_err_ (code, my_name, "Creating ^a data segment.", my_name);
207 
208      end pl1_version;