1 /* BEGIN INCLUDE FILE ... pl1_descriptor_type_fcn.incl.pl1 */
  2 
  3 /* Program to convert symbol_node information into a descriptor type code.
  4    Written 780614 by PG
  5           Modified: 25 Apr 1979 by PCK to implement 4-bit decimal
  6 */
  7 
  8 pl1_descriptor_type:
  9      procedure (bv_type, bv_prec) returns (fixed bin);
 10 
 11 /* parameters */
 12 
 13 dcl (     bv_type bit (36),
 14           bv_prec fixed bin (24)) parameter;
 15 
 16 /* automatic */
 17 
 18 dcl       prec fixed bin (24),
 19           dtype fixed bin;
 20 
 21 /* builtins */
 22 
 23 dcl       string builtin;
 24 
 25 /* include files */
 26 
 27 %include pl1_symbol_type;
 28 %include std_descriptor_types;
 29 %include system;
 30 ^L
 31 /* program */
 32 
 33           string (type) = bv_type;
 34           prec = bv_prec;
 35 
 36           if type.structure
 37           then dtype = structure_dtype;
 38           else
 39 
 40           if type.real
 41           then if type.fixed
 42                then if type.binary
 43                     then if type.unsigned
 44                          then if prec <= max_p_fix_bin_1
 45                               then dtype = real_fix_bin_1_uns_dtype;
 46                               else dtype = real_fix_bin_2_uns_dtype;
 47                          else if prec <= max_p_fix_bin_1
 48                               then dtype = real_fix_bin_1_dtype;
 49                               else dtype = real_fix_bin_2_dtype;
 50                     else if type.unaligned
 51                          then dtype = real_fix_dec_4bit_bytealigned_ls_dtype;
 52                          else dtype = real_fix_dec_9bit_ls_dtype;
 53                else if type.binary
 54                     then if prec <= max_p_flt_bin_1
 55                          then dtype = real_flt_bin_1_dtype;
 56                          else dtype = real_flt_bin_2_dtype;
 57                     else if type.unaligned
 58                          then dtype = real_flt_dec_4bit_bytealigned_dtype;
 59                          else dtype = real_flt_dec_9bit_dtype;
 60           else
 61 
 62           if type.complex
 63           then if type.fixed
 64                then if type.binary
 65                     then if prec <= max_p_fix_bin_1
 66                          then dtype = cplx_fix_bin_1_dtype;
 67                          else dtype = cplx_fix_bin_2_dtype;
 68                     else if type.unaligned
 69                          then dtype = cplx_fix_dec_4bit_bytealigned_ls_dtype;
 70                          else dtype = cplx_fix_dec_9bit_ls_dtype;
 71                else if type.binary
 72                     then if prec <= max_p_flt_bin_1
 73                          then dtype = cplx_flt_bin_1_dtype;
 74                          else dtype = cplx_flt_bin_2_dtype;
 75                     else if type.unaligned
 76                          then dtype = cplx_flt_dec_4bit_bytealigned_dtype;
 77                          else dtype = cplx_flt_dec_9bit_dtype;
 78           else
 79 
 80           if type.bit
 81           then if type.varying
 82                then dtype = varying_bit_dtype;
 83                else dtype = bit_dtype;
 84           else
 85 
 86           if type.char
 87           then if type.varying
 88                then dtype = varying_char_dtype;
 89                else dtype = char_dtype;
 90           else
 91 
 92           if type.ptr
 93           then dtype = pointer_dtype;
 94           else
 95 
 96           if type.offset
 97           then dtype = offset_dtype;
 98           else
 99 
100           if type.area
101           then dtype = area_dtype;
102           else
103 
104           if type.label
105           then dtype = label_dtype;
106           else
107 
108           if type.entry
109           then dtype = entry_dtype;
110           else
111 
112           if type.file
113           then dtype = file_dtype;
114           else
115 
116           if type.picture
117           then dtype = char_dtype;
118           else dtype = 0;
119 
120           return (dtype);
121 
122      end /* pl1_descriptor_type */;
123 
124 /* END INCLUDE FILE ... pl1_descriptor_type_fcn.incl.pl1 */