| 4033 | // |
| 4034 | |
| 4035 | static void make_port(const gpre_port* port) |
| 4036 | { |
| 4037 | SSHORT digits; |
| 4038 | |
| 4039 | printa(COLUMN8, false, "01 %s%d.", names[isc_a_pos], port->por_ident); |
| 4040 | |
| 4041 | for (const ref* reference = port->por_references; reference; reference = reference->ref_next) |
| 4042 | { |
| 4043 | const gpre_fld* field = reference->ref_field; |
| 4044 | const TEXT* name; |
| 4045 | const gpre_sym* symbol = field->fld_symbol; |
| 4046 | if (symbol) |
| 4047 | name = symbol->sym_string; |
| 4048 | else |
| 4049 | name = "<expression>"; |
| 4050 | if (reference->ref_value && (reference->ref_flags & REF_array_elem)) |
| 4051 | field = field->fld_array; |
| 4052 | |
| 4053 | switch (field->fld_dtype) |
| 4054 | { |
| 4055 | case dtype_short: |
| 4056 | case dtype_long: |
| 4057 | case dtype_int64: |
| 4058 | if (field->fld_dtype == dtype_short) |
| 4059 | digits = 5; |
| 4060 | else if (field->fld_dtype == dtype_long) |
| 4061 | digits = 10; |
| 4062 | else |
| 4063 | digits = 19; |
| 4064 | fprintf(gpreGlob.out_file, "%s03 %s%d PIC S", |
| 4065 | COLUMN12, names[isc_a_pos], reference->ref_ident); |
| 4066 | if (field->fld_scale >= -digits && field->fld_scale <= 0) |
| 4067 | { |
| 4068 | if (field->fld_scale > -digits) |
| 4069 | fprintf(gpreGlob.out_file, "9(%d)", digits + field->fld_scale); |
| 4070 | if (field->fld_scale) |
| 4071 | fprintf(gpreGlob.out_file, "V9(%d)", digits - (digits + field->fld_scale)); |
| 4072 | } |
| 4073 | else if (field->fld_scale > 0) |
| 4074 | fprintf(gpreGlob.out_file, "9(%d)P(%d)", digits, field->fld_scale); |
| 4075 | else |
| 4076 | fprintf(gpreGlob.out_file, "VP(%d)9(%d)", -(field->fld_scale + digits), digits); |
| 4077 | if (field->fld_dtype == dtype_short) |
| 4078 | fprintf(gpreGlob.out_file, "%s.\n", USAGE_BINARY2); |
| 4079 | else if (field->fld_dtype == dtype_long) |
| 4080 | fprintf(gpreGlob.out_file, "%s.\n", USAGE_BINARY4); |
| 4081 | else |
| 4082 | fprintf(gpreGlob.out_file, "%s.\n", USAGE_BINARY8); |
| 4083 | break; |
| 4084 | |
| 4085 | case dtype_cstring: |
| 4086 | case dtype_text: |
| 4087 | printa(COLUMN12, false, "03 %s%d PIC X(%d).", |
| 4088 | names[isc_a_pos], reference->ref_ident, field->fld_length); |
| 4089 | break; |
| 4090 | |
| 4091 | case dtype_date: |
| 4092 | case dtype_quad: |
no test coverage detected