1 /*  START OF:       pl1_symbol_type_fcns.incl.pl1             *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  2 
  3 
  4 /****^  HISTORY COMMENTS:
  5   1) change(2016-08-09,GDixon), approve(2016-10-13,MCR10014),
  6      audit(2016-10-13,Swenson), install(2016-10-13,MR12.6f-0002):
  7      Initial version of subroutines to manipulate/display the "type" structure
  8      from pl1_symbol_type.incl.pl1 file.
  9                                                    END HISTORY COMMENTS */
 10 
 11 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 12           /*                                                                                                */
 13           /* Name: type_for_descriptor_set                                                                  */
 14           /*                                                                                                */
 15           /* Function:                                                                                      */
 16           /*  1) Validate whether the PL/I attributes selected in type structure (pl1_symbol_type.incl.pl1) */
 17           /*     form a self-consistent declaration of an entrypoint argument (what the PL/I Language       */
 18           /*     Specification calls a <descriptor-set>).                                                   */
 19           /*  2) Apply PL/I defaults for missing attributes to form a complete <descriptor-set>.  This      */
 20           /*     includes supplying precision for an arithmetic descriptor.                                 */
 21           /*                                                                                                */
 22           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 23 
 24 type_for_descriptor_set:
 25      proc (type_bv_in, prec_in, type_bv_out, prec_out) returns (bit(1) aligned);
 26 
 27   dcl  type_bv_in bit(36) aligned;                          /* Caller-supplied attribute list.                   (in) */
 28   dcl  prec_in fixed bin(24);                               /* Caller-supplied precision for arithmetic type.    (in) */
 29                                                             /*  This may be set to 0, to indicate precision was       */
 30                                                             /*  not supplied, as part of the input data.              */
 31   dcl  type_bv_out bit(36) aligned;                         /* Completed attribute list, after defaults applied.(out) */
 32   dcl  prec_out fixed bin(24);                              /* Precision for arithmetic type, as supplied by    (out) */
 33                                                             /*  caller, or stemming from attribute defaults.          */
 34 
 35   dcl (F init("0"b), T init("1"b)) bit(1) aligned int static options(constant);
 36   dcl  precUNSET fixed bin(24) int static options(constant) init(0);
 37 
 38   dcl (bin, min, string) builtin;
 39 
 40 %include pl1_symbol_type;
 41 
 42 %page;
 43   dcl 1 tp aligned,
 44       2 t like type unaligned;
 45      string(tp.t) = type_bv_in;                             /* Copy caller's input argument, so we can apply defaults */
 46                                                             /*  to it.                                                */
 47 
 48                                                             /* Descriptor Attribute Set - finding summary...          */
 49   dcl (DSin,                                                /*  - for the input set, defined in t structure.          */
 50        DSout)                                               /*  - for the output set, returned in type_out            */
 51                     fixed bin(2) aligned unsigned init(UNSET);
 52 
 53   dcl (UNSET init(0), CONSISTENT init(1), INCONSISTENT init(2))
 54                     fixed bin(2) aligned unsigned int static options(constant);
 55                                                             /* Possible summary values.                               */
 56 
 57 
 58           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 59           /*                                                                                                */
 60           /* Major attribute categories of a descriptor set.                                                */
 61           /*      <descriptor set>::= <data type><alignment>[dimension][member] [<sign type>]               */
 62           /*                                                                                                */
 63           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 64 
 65   dcl (DSdata_type,                                         /* Summary of data_type attributes                        */
 66        DSalignment,                                         /* Summary of alignment attributes                        */
 67        DSdimensioned,                                       /* Summary of array dimension attributes                  */
 68        DSsign_type)                                         /* Summary of sign attributes                             */
 69                     fixed bin(2) aligned unsigned init(UNSET);
 70 
 71 
 72           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 73           /*                                                                                                */
 74           /* Subcategories describing the data type:                                                        */
 75           /*      <data type>::= <arithmetic>|<string>|<entry>|structure[like]|                             */
 76           /*           pointer|offset|area|label[local]|format[local]|file                                  */
 77           /*                                                                                                */
 78           /* Attributes within each subcategory:                                                            */
 79           /*      <arithmetic>::= {fixed|float}{binary|decimal}{real|complex}                               */
 80           /*           precision                                                                            */
 81           /*                                                                                                */
 82           /*      <string>::= picture[real|complex]|                                                        */
 83           /*           {bit|character}{varying|nonvarying}                                                  */
 84           /*                                                                                                */
 85           /*      <entry>::= entry[options]                                                                 */
 86           /*           {reducible returns|irreducible[returns]}                                             */
 87           /*                                                                                                */
 88           /*      <alignment>::= aligned|unaligned                                                          */
 89           /*                                                                                                */
 90           /*      <sign type>::= signed|unsigned                                                            */
 91           /*                                                                                                */
 92           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 93 
 94   dcl (DTarithmetic, DTstring, DTentry)                     /* Subcategory summary variables                          */
 95                     fixed bin(2) aligned unsigned init(UNSET);
 96 
 97 
 98   dcl (Oreal_cplx)  fixed bin(2) aligned unsigned init(UNSET);
 99                                                             /* {real|complex} used in 2 subcats: arithmetic & string  */
100      Oreal_cplx = bin(t.real) + bin(t.complex);
101 
102 
103      if  t.fixed | t.float | t.binary | t.decimal | t.precision  then
104           DTarithmetic = CONSISTENT;                        /* Assume DTarithmetic is CONSISTENT if any arithmetic    */
105                                                             /*  attribute is given. (Oreal_cplx added in later.)      */
106      if  t.fixed  & t.float    then DTarithmetic = INCONSISTENT;
107      if  t.binary & t.decimal  then DTarithmetic = INCONSISTENT;
108                                                             /* No consistency, if paired attributes conflict.         */
109 
110      DTstring = min(INCONSISTENT, bin(t.bit) + bin(t.char) + bin(t.picture));
111      if (DTstring = UNSET) & t.varying  then DTstring = INCONSISTENT;
112                                                             /* Summarize string data type consistency.                */
113 
114      if (Oreal_cplx = CONSISTENT)  then do;                 /* real/complex can be applied either to string or        */
115                                                             /*  arithmetic data_type; but not to both.                */
116           if  t.picture & (DTstring = CONSISTENT) & (DTarithmetic ^= UNSET) then do;
117                DTarithmetic = INCONSISTENT;
118                DTstring = INCONSISTENT;
119                end;
120           else if (DTstring = UNSET) & (DTarithmetic = UNSET) then
121                DTarithmetic = CONSISTENT;                   /* If real|complex are the only attributes given, they    */
122           end;                                              /*  apply to the arithmetic subcategory, via defaults.    */
123 
124      else if (Oreal_cplx = INCONSISTENT) then do;           /* If both real and complex are given, both subcategories */
125           DTarithmetic = INCONSISTENT;                      /*  become inconsistent.                                  */
126           DTstring = INCONSISTENT;
127           end;
128 
129 
130      if  t.entry | t.reducible | t.irreducible | t.returns  then
131           DTentry = CONSISTENT;                             /* Summarize entry data type consistency.                 */
132      if  t.reducible & t.irreducible  then DTentry = INCONSISTENT;
133 
134 
135      DSdata_type = min(INCONSISTENT, DTarithmetic + DTstring + DTentry + bin(t.structure) +
136           bin(t.ptr) + bin(t.offset) + bin(t.area) + bin(t.label) + bin(t.format) + bin(t.file));
137                                                             /* A scalar declaration must include attributes for only  */
138                                                             /*  one data type.                                        */
139 
140      if  t.aligned | t.unaligned  then DSalignment = CONSISTENT;
141      if  t.aligned & t.unaligned  then DSalignment = INCONSISTENT;
142                                                             /* Summarize alignment descriptor components.             */
143 
144      if  t.dimensioned  then DSdimensioned = CONSISTENT;    /* Summarize array dimension descriptor component.        */
145 
146      if (t.signed | t.unsigned ) then DSsign_type = CONSISTENT;
147                                                             /* Summarize sign_type descriptor components.             */
148      if (t.signed & t.unsigned ) then DSsign_type = INCONSISTENT;
149      if (DSsign_type = CONSISTENT) & (DSdata_type = CONSISTENT) & (DTarithmetic ^= CONSISTENT) then
150           DSsign_type = INCONSISTENT;                       /*   Sign may only be given with arithmetic data.         */
151 
152      if (DSdata_type   = UNSET) & (DSalignment = UNSET) &   /* Overall summary of consistency of input descriptor set.*/
153         (DSdimensioned = UNSET) & (DSsign_type = UNSET)
154      then DSin = UNSET;
155      else if (DSdata_type   < INCONSISTENT) & (DSalignment < INCONSISTENT) &
156              (DSdimensioned < INCONSISTENT) & (DSsign_type < INCONSISTENT) then
157           DSin = CONSISTENT;
158      else DSin = INCONSISTENT;
159 %page;
160           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
161           /*                                                                                                */
162           /* Arithmetic Defaults                                                                            */
163           /*                                                                                                */
164           /*      default(^(character|bit|pointer|offset|area|label|format|entry|file|            (Rule 1)  */
165           /*         fixed|float|picture|binary|decimal|real|complex|                                       */
166           /*         builtin|generic|condition|constant)) fixed binary real;                                */
167           /*      default((real|complex)&^(picture|float|constant)) fixed;                        (Rule 2)  */
168           /*      default((binary|decimal)&^(float|constant)) fixed;                              (Rule 3)  */
169           /*      default((fixed|float)&^(complex|constant)) real;                                (Rule 4)  */
170           /*      default((fixed|float)&^(decimal|constant)) binary;                              (Rule 5)  */
171           /*      default(fixed&binary&^precision&^constant) precision(17,0);                     (Rule 6)  */
172           /*      default(fixed&decimal&^precision&^constant) precision(7,0);                     (Rule 7)  */
173           /*      default(float&binary&^precision&^constant) precision(27);                       (Rule 8)  */
174           /*      default(float&decimal&^precision&^constant) precision(10);                      (Rule 9)  */
175           /*                                                                                                */
176           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
177 
178      if (DSdata_type = UNSET) then do;                      /* Apply arithmetic default if no attributes set.         */
179           t.fixed = T;                                      /*  Rule 1 (see comment on "Arithmetic Defaults", above)  */
180           t.binary = T;
181           t.real = T;
182           DTarithmetic = CONSISTENT;
183           DSdata_type = CONSISTENT;
184           end;
185 
186      prec_out = prec_in;                                    /* Apply other arithmetic defaults.                       */
187      if (DSdata_type < INCONSISTENT) then do;
188           if (Oreal_cplx = CONSISTENT) & ^(t.picture | t.float | t.fixed)  then do;
189                t.fixed = T;                                 /*  Rule 2                                                */
190                if (DTarithmetic = UNSET) then
191                     DTarithmetic = CONSISTENT;
192                if (DSdata_type = UNSET) then
193                     DSdata_type = CONSISTENT;
194                end;
195           if (t.binary | t.decimal) & ^(t.float | t.fixed)  then
196                t.fixed = T;                                 /*  Rule 3                                                */
197           if (t.fixed | t.float) & ^(t.real | t.complex)  then
198                t.real = T;                                  /*  Rule 4                                                */
199           if (t.fixed | t.float) & ^(t.binary | t.decimal)  then
200                t.binary = T;                                /*  Rule 5                                                */
201           if (t.fixed & t.binary & (^t.precision | prec_out = precUNSET))  then do;
202                t.precision = T;                             /*  Rule 6                                                */
203                prec_out = 17;
204                end;
205           if (t.fixed & t.decimal & (^t.precision | prec_out = precUNSET))  then do;
206                t.precision = T;                             /*  Rule 7                                                */
207                prec_out = 7;
208                end;
209           if (t.float & t.binary & (^t.precision | prec_out = precUNSET))  then do;
210                t.precision = T;                             /*  Rule 8                                                */
211                prec_out = 27;
212                end;
213           if (t.float & t.decimal & (^t.precision | prec_out = precUNSET))  then do;
214                t.precision = T;                             /*  Rule 9                                                */
215                prec_out = 10;
216                end;
217           end;
218 
219 
220           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
221           /*                                                                                                */
222           /* Storage Mapping Defaults                                                                       */
223           /*                                                                                                */
224           /*      default((character|bit|picture|structure)&^(aligned|constant))                            */
225           /*         unaligned;                                                                             */
226           /*      default(^(constant|builtin|generic|unaligned}) aligned;                                   */
227           /*      default ((fixed|float)&^unsigned) signed;                                                 */
228           /*                                                                                                */
229           /* Though not stated in the PL/I Language Specification, other manuals descriptor layout of       */
230           /* storage note that varying strings are always aligned on a word boundary.  In fact, the PL/I    */
231           /* compiler produces a descriptor for:  char(N) varying unaligned                                 */
232           /* which says the variable is actually not-packed (i.e., aligned).                                */
233           /*                                                                                                */
234           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
235 
236      if DSalignment = UNSET then do;                        /* Apply "Storage Mapping Defaults" (see above)           */
237           if (DTstring = CONSISTENT) | t.structure  then do;
238                t.unaligned = T;
239                DSalignment = CONSISTENT;
240                end;
241           if (DSalignment = UNSET) then do;
242                t.aligned = T;
243                DSalignment = CONSISTENT;
244                end;
245           end;
246      if (DSdata_type = CONSISTENT) & (DTstring = CONSISTENT) & (DSalignment = CONSISTENT) &
247           t.varying & t.unaligned then do;
248           t.unaligned = F;
249           t.aligned = T;
250           end;
251 
252      if (DTarithmetic = CONSISTENT) & (DSsign_type = UNSET)  then do;
253           t.signed = T;
254           DSsign_type = CONSISTENT;
255           end;
256 
257 
258           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
259           /*                                                                                                */
260           /* Entry Defaults                                                                                 */
261           /*                                                                                                */
262           /*       default (returns|reducible|irreducible|options) entry;                                   */
263           /*       default (entry&^reducible) irreducible;                                                  */
264           /*                                                                                                */
265           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
266 
267      if (DTentry = CONSISTENT) & ^t.entry  then
268           t.entry = T;
269      if (DTentry = CONSISTENT) & ^t.reducible  then
270           t.irreducible = T;
271 
272 
273      if (DSdata_type   = UNSET) & (DSalignment = UNSET) &   /* Overall summary of consistency of output descriptor    */
274         (DSdimensioned = UNSET) & (DSsign_type = UNSET)     /*  set (after all defaults have been applied).           */
275      then DSout = UNSET;
276      else if (DSdata_type   < INCONSISTENT) & (DSalignment < INCONSISTENT) &
277              (DSdimensioned < INCONSISTENT) & (DSsign_type < INCONSISTENT) then
278           DSout = CONSISTENT;
279      else DSout = INCONSISTENT;
280 
281      type_bv_out = string(tp.t);                            /* Return modified descriptor attribute set.              */
282      return (DSout = CONSISTENT);
283 
284      end type_for_descriptor_set;
285 %page;
286           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
287           /*                                                                                                */
288           /* Name: type_as_string                                                                           */
289           /*                                                                                                */
290           /* Function:  Convert selected attributes in the type structure (pl1_symbol_type.incl.pl1) to a   */
291           /* string, in the order of their typical use in a PL/I declaration.  Add ability to include       */
292           /* related data (not in the type structure) needed for a complete PL/I declaration, including:    */
293           /*  - structure level                                                                             */
294           /*  - variable name or label for the attributes                                                   */
295           /*  - array bounds (dimension)                                                                    */
296           /*  - precision and scale (for fixed arithmetic data); precision for float data.                  */
297           /*  - size (for bit, character, and area data)                                                    */
298           /*  - picture string (e.g., "zzz9") for pictured data                                             */
299           /*                                                                                                */
300           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
301 
302 type_as_string:
303      proc (type_bv_in, level, label, dimension, precision, scale, size, picture) returns(char(500) var);
304 
305   dcl  type_bv_in bit(36) aligned;                          /* Caller-supplied attribute list.                   (in) */
306   dcl  level fixed bin;                                     /* Is the structure level number to output before    (in) */
307                                                             /*  label of a structure attribute list.                  */
308                                                             /*  If 0, the word "structure" is shown, without a level. */
309   dcl  label char(*);                                       /* String to be output before attributes in list.    (in) */
310   dcl  dimension char(40) var;                              /* String to be output after a dimension attribute.  (in) */
311                                                             /*  If empty string, an asterisk is output.               */
312   dcl  precision fixed bin(24);                             /* Precision to be output with an arithmetic type.   (in) */
313                                                             /*  If 0, only the precision attribute keyword is output. */
314   dcl  scale fixed bin(24);                                 /* Scale to be output with a fixed-point type.       (in) */
315                                                             /*  If precision is 0, no scale data is output.           */
316                                                             /*   -128 <= scale <= 127                                 */
317                                                             /*  If scale is 0, this is the default value for a scale  */
318                                                             /*  value, so no scale is output.                         */
319   dcl  size fixed bin(24);                                  /* Size to be displayed with string and area type.   (in) */
320                                                             /*  If 0, no size is output.                              */
321                                                             /*  If 16777215, then * is output as the size.            */
322   dcl  picture char(40) var;                                /* Picture string to be output following the picture (in) */
323                                                             /*  attribute.  If empty, no picture string is output.    */
324 
325   dcl (F init("0"b), T init("1"b)) bit(1) aligned int static options(constant);
326   dcl  levelUNSET fixed bin int static options(constant) init(0);
327   dcl  precUNSET fixed bin(24) int static options(constant) init(0);
328   dcl  sizeUNSET fixed bin(24) int static options(constant) init(0);
329   dcl  sizeSTAR  fixed bin(24) int static options (constant) init (16777215);
330                                                             /* size value in descriptor for bit(*) and char(*) parms  */
331   dcl  ioa_ entry() options(variable);
332 
333   dcl (char, ltrim, string) builtin;
334 
335 %include pl1_symbol_type;
336 
337 %page;
338   dcl 1 tp aligned,
339       2 t like type unaligned;
340      string(tp.t) = type_bv_in;                             /* Copy caller's input argument, so we access attributes  */
341                                                             /*  by name.                                              */
342   dcl  d char(500) var init("");
343 
344      if t.structure       then do;
345           if level = levelUNSET then
346                                d = d || label || " structure";
347           else                 d = d || ltrim(char(level)) || " " || label;
348           end;
349      else                      d = d || label;
350 
351      if t.dimensioned     then do;
352           if length(dimension) = 0 then
353                                d = d || " (*)";
354           else                 d = d || " (" || dimension || ")";
355           end;
356 
357      if t.fixed           then d = d || " fixed";
358      if t.float           then d = d || " float";
359      if t.decimal         then d = d || " decimal";
360      if t.binary          then d = d || " binary";
361      if t.precision       then do;
362           if precision ^= precUNSET then
363                if t.fixed then
364                     if scale ^= 0 then
365                                d = d || "(" || ltrim(char(precision)) || ", " || ltrim(char(scale)) || ")";
366                     else       d = d || "(" || ltrim(char(precision)) || ")";
367                else            d = d || "(" || ltrim(char(precision)) || ")";
368           else                 d = d || " precision";
369           end;
370 
371      if t.area            then d = d || " area";
372 
373      if t.bit             then d = d || " bit";
374      if t.char            then d = d || " char";
375 
376      if (t.bit | t.char | t.area) & (size ^= sizeUNSET) then do;
377           if size = sizeSTAR then
378                                d = d || "(*)";
379           else                 d = d || "(" || ltrim(char(size)) || ")";
380           end;
381 
382      if t.picture         then do;
383                                d = d || " picture";
384           if length(picture) > 0 then
385                                d = d || " """ || picture || """";
386           end;
387 
388      if t.real            then d = d || " real";
389      if t.complex         then d = d || " complex";
390 
391      if t.varying         then d = d || " varying";
392 
393      if t.entry           then d = d || " entry";
394      if t.reducible       then d = d || " reducible";
395      if t.irreducible     then d = d || " irreducible";
396      if t.returns         then d = d || " returns";
397 
398      if t.ptr             then d = d || " ptr";
399      if t.offset          then d = d || " offset";
400      if t.label           then d = d || " label";
401      if t.file            then d = d || " file";
402      if t.format          then d = d || " format";
403 
404      if t.aligned         then d = d || " aligned";
405      if t.unaligned       then d = d || " unaligned";
406      if t.signed          then d = d || " signed";
407      if t.unsigned        then d = d || " unsigned";
408      if t.initialed       then d = d || " initial";
409 
410      if t.arg_descriptor  then d = d || " arg_descriptor";
411      if t.storage_block   then d = d || " storage_block";
412      if t.explicit_packed then d = d || " explicit_packed";
413      if t.condition       then d = d || " condition";
414      if t.builtin         then d = d || " builtin";
415      if t.generic         then d = d || " generic";
416      if t.local           then d = d || " local";
417      if t.variable        then d = d || " variable";
418 
419      return (d);
420 
421      end type_as_string;
422 %page;
423           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
424           /*                                                                                                */
425           /* Source of this information:                                                                    */
426           /*                                                                                                */
427           /*                  PL/I Language Specification Manual, AG94-02, RevE 03/81                       */
428           /*                                                                                                */
429           /* Consistent Attribute Sets (from page 5-33)                                                     */
430           /*                                                                                                */
431           /* Each <literal constant set> must be produced by the declaration of a <literal constant>        */
432           /* and each <descriptor set> must be produced by the declaration derived from a <descriptor>.     */
433           /* A <named constant set>, other than an external entry constant or file constant, must           */
434           /* be produced by a declaration derived from a <label prefix>.                                    */
435           /*                                                                                                */
436           /* Syntax:                                                                                        */
437           /*                                                                                                */
438           /*      <consistent attribute set>::= <condition set>|<builtin set>|                              */
439           /*           <generic set>|<literal constant set>|                                                */
440           /*           <named constant set>|<descriptor set>|                                               */
441           /*           <variable set>                                                                       */
442           /*                                                                                                */
443           /*      <condition set>::= external condition                                                     */
444           /*                                                                                                */
445           /*      <builtin set>::= internal builtin                                                         */
446           /*                                                                                                */
447           /*      <generic set>::= internal generic                                                         */
448           /*                                                                                                */
449           /*      <literal constant set>::= {<arithmetic>|bit|character}                                    */
450           /*           constant                                                                             */
451           /*                                                                                                */
452           /*      <named constant set>::= internal label constant[dimension]|                               */
453           /*           internal format constant|<scope><entry>constant|                                     */
454           /*           <scope>file<consistent file description>constant                                     */
455           /*                                                                                                */
456           /*      <descriptor set>::= <data type><alignment>[dimension][member] [<sign type>]               */
457           /*                                                                                                */
458           /*      <variable set>::= variable<data type><alignment>[dimension]                               */
459           /*           <scope class>[initial] [<sign type>]                                                 */
460           /*                                                                                                */
461           /*      <data type>::= <arithmetic>|<string>|<entry>|structure[like]|                             */
462           /*           pointer|offset|area|label[local]|format[local]|file                                  */
463           /*                                                                                                */
464           /*      <arithmetic>::= {fixed|float}{binary|decimal}{real|complex}                               */
465           /*           precision                                                                            */
466           /*                                                                                                */
467           /*      <string>::= picture[real|complex]|                                                        */
468           /*           {bit|character}{varying|nonvarying}                                                  */
469           /*                                                                                                */
470           /*      <entry>::= entry[options]                                                                 */
471           /*           {reducible returns|irreducible[returns]}                                             */
472           /*                                                                                                */
473           /*      <alignment>::= aligned|unaligned                                                          */
474           /*                                                                                                */
475           /*      <scope>::= internal|external                                                              */
476           /*                                                                                                */
477           /*      <scope class>::= automatic internal|based internal|                                       */
478           /*           static<scope>|controlled<scope>|parameter internal|                                  */
479           /*           defined internal[position]|member internal                                           */
480           /*                                                                                                */
481           /*      <consistent file description>::= <stream description>|<record description>                */
482           /*                                                                                                */
483           /*      <stream description>::= stream{input|output[print][environment]}                          */
484           /*                                                                                                */
485           /*      <record description>::= record{input|output|update}                                       */
486           /*           {<sequential description>|<direct description>}[environment]                         */
487           /*                                                                                                */
488           /*      <sequential description>::= sequential[keyed]                                             */
489           /*                                                                                                */
490           /*      <direct description>::= direct keyed                                                      */
491           /*                                                                                                */
492           /*      <sign type>::= signed|unsigned                                                            */
493           /*                                                                                                */
494           /*                                                                                                */
495           /*                                                                                                */
496           /* 5.3.3 Language Default Rules (page 5-13 ff)                                                    */
497           /*                                                                                                */
498           /* Entry Defaults                                                                                 */
499           /*                                                                                                */
500           /*       default (returns|reducible|irreducible|options) entry;                                   */
501           /*       default (entry&^reducible) irreducible;                                                  */
502           /*                                                                                                */
503           /* File Default                                                                                   */
504           /*                                                                                                */
505           /*      default(input|output|update|stream|record|print|keyed|direct|                             */
506           /*         sequential|environment) file;                                                          */
507           /*                                                                                                */
508           /* Arithmetic Defaults                                                                            */
509           /*                                                                                                */
510           /*      default(^(character|bit|pointer|offset|area|label|format|entry|file|            (Rule 1)  */
511           /*         fixed|float|picture|binary|decimal|real|complex|                                       */
512           /*         builtin|generic|condition|constant)) fixed binary real;                                */
513           /*      default((real|complex)&^(picture|float|constant)) fixed;                        (Rule 2)  */
514           /*      default((binary|decimal)&^(float|constant)) fixed;                              (Rule 3)  */
515           /*      default((fixed|float)&^(complex|constant)) real;                                (Rule 4)  */
516           /*      default((fixed|float)&^(decimal|constant)) binary;                              (Rule 5)  */
517           /*      default(fixed&binary&^precision&^constant) precision(17,0);                     (Rule 6)  */
518           /*      default(fixed&decimal&^precision&^constant) precision(7,0);                     (Rule 7)  */
519           /*      default(float&binary&^precision&^constant) precision(27);                       (Rule 8)  */
520           /*      default(float&decimal&^precision&^constant) precision(10);                      (Rule 9)  */
521           /*                                                                                                */
522           /* String Default                                                                                 */
523           /*                                                                                                */
524           /*      default((character|bit)&^(varying|constant)) nonvarying;                                  */
525           /*                                                                                                */
526           /* Scope and Storage Class Defaults                                                               */
527           /*                                                                                                */
528           /*      default((entry|file)&(automatic|based|static|parameter|                                   */
529           /*         defined|controlled|member|aligned|unaligned|                                           */
530           /*         initial) variable;                                                                     */
531           /*      default((entry|file)&range(*)&^variable) constant;                                        */
532           /*      default(^(constant|builtin|generic|condition)&range(*))                                   */
533           /*         variable;                                                                              */
534           /*      default((file|entry)&range(*)&constant&^internal) external;                               */
535           /*      default(condition) external;                                                              */
536           /*      default(^external&range(*)) internal;                                                     */
537           /*      default(variable&external&^controlled) static;                                            */
538           /*      default(variable&^(based|controlled|static|defined|parameter|                             */
539           /*         member)) automatic;                                                                    */
540           /*                                                                                                */
541           /* Storage Mapping Defaults                                                                       */
542           /*                                                                                                */
543           /*      default((character|bit|picture|structure)&^(aligned|constant))                            */
544           /*         unaligned;                                                                             */
545           /*      default(^(constant|builtin|generic|unaligned}) aligned;                                   */
546           /*      default ((fixed|float)&^unsigned) signed;                                                 */
547           /*                                                                                                */
548           /* Example:                                                                                       */
549           /*        declare i fixed;                                                                        */
550           /*        declare j float;                                                                        */
551           /*        declare a;                                                                              */
552           /*        declare X external;                                                                     */
553           /*        declare E entry returns(fixed);                                                         */
554           /*                                                                                                */
555           /*                                                                                                */
556           /* After application of the language defaults, these declarations are:                            */
557           /*                                                                                                */
558           /*       declare i fixed binary real precision(17,0)                                              */
559           /*              aligned variable automatic internal signed;                                       */
560           /*       declare j float binary real precision(27)                                                */
561           /*              aligned variable automatiautomatic internal signed;                               */
562           /*       declare X fixed binary real precision(17,0)                                              */
563           /*              aligned variable static external signed;                                          */
564           /*       declare E entry constant external irreducible                                            */
565           /*              returns(fixed binary real precision(17,0) aligned signed);                        */
566           /*                                                                                                */
567           /*                                                                                                */
568           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
569 
570 /*  END OF:         pl1_symbol_type_fcns.incl.pl1             *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */