]>
Commit | Line | Data |
---|---|---|
88fdfd5a | 1 | /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. |
6de9cd9a | 2 | Contributed by Andy Vaught |
8b6dba81 | 3 | Namelist output contributed by Paul Thomas |
6de9cd9a DN |
4 | |
5 | This file is part of the GNU Fortran 95 runtime library (libgfortran). | |
6 | ||
7 | Libgfortran is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
9 | the Free Software Foundation; either version 2, or (at your option) | |
10 | any later version. | |
11 | ||
57dea9f6 TM |
12 | In addition to the permissions in the GNU General Public License, the |
13 | Free Software Foundation gives you unlimited permission to link the | |
14 | compiled version of this file into combinations with other programs, | |
15 | and to distribute those combinations without any restriction coming | |
16 | from the use of this file. (The General Public License restrictions | |
17 | do apply in other respects; for example, they cover modification of | |
18 | the file, and distribution when not linked into a combine | |
19 | executable.) | |
20 | ||
6de9cd9a DN |
21 | Libgfortran is distributed in the hope that it will be useful, |
22 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
23 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
24 | GNU General Public License for more details. | |
25 | ||
26 | You should have received a copy of the GNU General Public License | |
27 | along with Libgfortran; see the file COPYING. If not, write to | |
fe2ae685 KC |
28 | the Free Software Foundation, 51 Franklin Street, Fifth Floor, |
29 | Boston, MA 02110-1301, USA. */ | |
6de9cd9a | 30 | |
36ae8a61 | 31 | #include "io.h" |
1449b8cb | 32 | #include <assert.h> |
6de9cd9a | 33 | #include <string.h> |
29dc5138 | 34 | #include <ctype.h> |
7984a2f0 | 35 | #include <stdlib.h> |
7b71bedf | 36 | #include <stdbool.h> |
6de9cd9a DN |
37 | #define star_fill(p, n) memset(p, '*', n) |
38 | ||
7b71bedf | 39 | #include "write_float.def" |
6de9cd9a DN |
40 | |
41 | void | |
5e805e44 | 42 | write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) |
6de9cd9a DN |
43 | { |
44 | int wlen; | |
45 | char *p; | |
46 | ||
47 | wlen = f->u.string.length < 0 ? len : f->u.string.length; | |
48 | ||
9e7fc6b9 JD |
49 | #ifdef HAVE_CRLF |
50 | /* If this is formatted STREAM IO convert any embedded line feed characters | |
51 | to CR_LF on systems that use that sequence for newlines. See F2003 | |
52 | Standard sections 10.6.3 and 9.9 for further information. */ | |
53 | if (is_stream_io (dtp)) | |
54 | { | |
55 | const char crlf[] = "\r\n"; | |
56 | int i, q, bytes; | |
57 | q = bytes = 0; | |
58 | ||
59 | /* Write out any padding if needed. */ | |
60 | if (len < wlen) | |
61 | { | |
62 | p = write_block (dtp, wlen - len); | |
63 | if (p == NULL) | |
64 | return; | |
65 | memset (p, ' ', wlen - len); | |
66 | } | |
67 | ||
68 | /* Scan the source string looking for '\n' and convert it if found. */ | |
69 | for (i = 0; i < wlen; i++) | |
70 | { | |
71 | if (source[i] == '\n') | |
72 | { | |
73 | /* Write out the previously scanned characters in the string. */ | |
74 | if (bytes > 0) | |
75 | { | |
76 | p = write_block (dtp, bytes); | |
77 | if (p == NULL) | |
78 | return; | |
79 | memcpy (p, &source[q], bytes); | |
80 | q += bytes; | |
81 | bytes = 0; | |
82 | } | |
83 | ||
84 | /* Write out the CR_LF sequence. */ | |
85 | q++; | |
86 | p = write_block (dtp, 2); | |
87 | if (p == NULL) | |
88 | return; | |
89 | memcpy (p, crlf, 2); | |
90 | } | |
91 | else | |
92 | bytes++; | |
93 | } | |
94 | ||
95 | /* Write out any remaining bytes if no LF was found. */ | |
96 | if (bytes > 0) | |
97 | { | |
98 | p = write_block (dtp, bytes); | |
99 | if (p == NULL) | |
100 | return; | |
101 | memcpy (p, &source[q], bytes); | |
102 | } | |
103 | } | |
6de9cd9a DN |
104 | else |
105 | { | |
9e7fc6b9 JD |
106 | #endif |
107 | p = write_block (dtp, wlen); | |
108 | if (p == NULL) | |
109 | return; | |
110 | ||
111 | if (wlen < len) | |
112 | memcpy (p, source, wlen); | |
113 | else | |
114 | { | |
115 | memset (p, ' ', wlen - len); | |
116 | memcpy (p + wlen - len, source, len); | |
117 | } | |
118 | #ifdef HAVE_CRLF | |
6de9cd9a | 119 | } |
9e7fc6b9 | 120 | #endif |
6de9cd9a DN |
121 | } |
122 | ||
32aa3bff | 123 | static GFC_INTEGER_LARGEST |
6de9cd9a DN |
124 | extract_int (const void *p, int len) |
125 | { | |
32aa3bff | 126 | GFC_INTEGER_LARGEST i = 0; |
6de9cd9a DN |
127 | |
128 | if (p == NULL) | |
129 | return i; | |
130 | ||
131 | switch (len) | |
132 | { | |
133 | case 1: | |
98cd8256 SE |
134 | { |
135 | GFC_INTEGER_1 tmp; | |
136 | memcpy ((void *) &tmp, p, len); | |
137 | i = tmp; | |
138 | } | |
6de9cd9a DN |
139 | break; |
140 | case 2: | |
98cd8256 SE |
141 | { |
142 | GFC_INTEGER_2 tmp; | |
143 | memcpy ((void *) &tmp, p, len); | |
144 | i = tmp; | |
145 | } | |
6de9cd9a DN |
146 | break; |
147 | case 4: | |
98cd8256 SE |
148 | { |
149 | GFC_INTEGER_4 tmp; | |
150 | memcpy ((void *) &tmp, p, len); | |
151 | i = tmp; | |
152 | } | |
6de9cd9a DN |
153 | break; |
154 | case 8: | |
98cd8256 SE |
155 | { |
156 | GFC_INTEGER_8 tmp; | |
157 | memcpy ((void *) &tmp, p, len); | |
158 | i = tmp; | |
159 | } | |
32aa3bff FXC |
160 | break; |
161 | #ifdef HAVE_GFC_INTEGER_16 | |
162 | case 16: | |
98cd8256 SE |
163 | { |
164 | GFC_INTEGER_16 tmp; | |
165 | memcpy ((void *) &tmp, p, len); | |
166 | i = tmp; | |
167 | } | |
6de9cd9a | 168 | break; |
32aa3bff | 169 | #endif |
6de9cd9a | 170 | default: |
5e805e44 | 171 | internal_error (NULL, "bad integer kind"); |
6de9cd9a DN |
172 | } |
173 | ||
174 | return i; | |
175 | } | |
176 | ||
999a06a0 TK |
177 | static GFC_UINTEGER_LARGEST |
178 | extract_uint (const void *p, int len) | |
179 | { | |
180 | GFC_UINTEGER_LARGEST i = 0; | |
181 | ||
182 | if (p == NULL) | |
183 | return i; | |
184 | ||
185 | switch (len) | |
186 | { | |
187 | case 1: | |
98cd8256 SE |
188 | { |
189 | GFC_INTEGER_1 tmp; | |
190 | memcpy ((void *) &tmp, p, len); | |
191 | i = (GFC_UINTEGER_1) tmp; | |
192 | } | |
999a06a0 TK |
193 | break; |
194 | case 2: | |
98cd8256 SE |
195 | { |
196 | GFC_INTEGER_2 tmp; | |
197 | memcpy ((void *) &tmp, p, len); | |
198 | i = (GFC_UINTEGER_2) tmp; | |
199 | } | |
999a06a0 TK |
200 | break; |
201 | case 4: | |
98cd8256 SE |
202 | { |
203 | GFC_INTEGER_4 tmp; | |
204 | memcpy ((void *) &tmp, p, len); | |
205 | i = (GFC_UINTEGER_4) tmp; | |
206 | } | |
999a06a0 TK |
207 | break; |
208 | case 8: | |
98cd8256 SE |
209 | { |
210 | GFC_INTEGER_8 tmp; | |
211 | memcpy ((void *) &tmp, p, len); | |
212 | i = (GFC_UINTEGER_8) tmp; | |
213 | } | |
999a06a0 TK |
214 | break; |
215 | #ifdef HAVE_GFC_INTEGER_16 | |
216 | case 16: | |
98cd8256 SE |
217 | { |
218 | GFC_INTEGER_16 tmp; | |
219 | memcpy ((void *) &tmp, p, len); | |
220 | i = (GFC_UINTEGER_16) tmp; | |
221 | } | |
999a06a0 TK |
222 | break; |
223 | #endif | |
224 | default: | |
5e805e44 | 225 | internal_error (NULL, "bad integer kind"); |
999a06a0 TK |
226 | } |
227 | ||
228 | return i; | |
229 | } | |
230 | ||
7984a2f0 | 231 | |
6de9cd9a | 232 | void |
5e805e44 | 233 | write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) |
6de9cd9a DN |
234 | { |
235 | char *p; | |
32aa3bff | 236 | GFC_INTEGER_LARGEST n; |
7fcb1804 | 237 | |
5e805e44 | 238 | p = write_block (dtp, f->u.w); |
6de9cd9a DN |
239 | if (p == NULL) |
240 | return; | |
241 | ||
242 | memset (p, ' ', f->u.w - 1); | |
243 | n = extract_int (source, len); | |
244 | p[f->u.w - 1] = (n) ? 'T' : 'F'; | |
245 | } | |
246 | ||
6de9cd9a DN |
247 | |
248 | static void | |
5e805e44 | 249 | write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len, |
1449b8cb | 250 | const char *(*conv) (GFC_UINTEGER_LARGEST, char *, size_t)) |
6de9cd9a | 251 | { |
32aa3bff | 252 | GFC_UINTEGER_LARGEST n = 0; |
6de9cd9a | 253 | int w, m, digits, nzero, nblank; |
1449b8cb JJ |
254 | char *p; |
255 | const char *q; | |
256 | char itoa_buf[GFC_BTOA_BUF_SIZE]; | |
6de9cd9a DN |
257 | |
258 | w = f->u.integer.w; | |
259 | m = f->u.integer.m; | |
260 | ||
999a06a0 | 261 | n = extract_uint (source, len); |
6de9cd9a | 262 | |
7fcb1804 | 263 | /* Special case: */ |
6de9cd9a DN |
264 | |
265 | if (m == 0 && n == 0) | |
266 | { | |
267 | if (w == 0) | |
268 | w = 1; | |
269 | ||
5e805e44 | 270 | p = write_block (dtp, w); |
6de9cd9a DN |
271 | if (p == NULL) |
272 | return; | |
273 | ||
274 | memset (p, ' ', w); | |
275 | goto done; | |
276 | } | |
277 | ||
1449b8cb | 278 | q = conv (n, itoa_buf, sizeof (itoa_buf)); |
6de9cd9a DN |
279 | digits = strlen (q); |
280 | ||
281 | /* Select a width if none was specified. The idea here is to always | |
7fcb1804 | 282 | print something. */ |
6de9cd9a DN |
283 | |
284 | if (w == 0) | |
285 | w = ((digits < m) ? m : digits); | |
286 | ||
5e805e44 | 287 | p = write_block (dtp, w); |
6de9cd9a DN |
288 | if (p == NULL) |
289 | return; | |
290 | ||
291 | nzero = 0; | |
292 | if (digits < m) | |
293 | nzero = m - digits; | |
294 | ||
7fcb1804 | 295 | /* See if things will work. */ |
6de9cd9a DN |
296 | |
297 | nblank = w - (nzero + digits); | |
298 | ||
299 | if (nblank < 0) | |
300 | { | |
301 | star_fill (p, w); | |
302 | goto done; | |
303 | } | |
304 | ||
29dc5138 | 305 | |
5e805e44 | 306 | if (!dtp->u.p.no_leading_blank) |
29dc5138 | 307 | { |
5e805e44 JJ |
308 | memset (p, ' ', nblank); |
309 | p += nblank; | |
310 | memset (p, '0', nzero); | |
311 | p += nzero; | |
312 | memcpy (p, q, digits); | |
29dc5138 PT |
313 | } |
314 | else | |
315 | { | |
316 | memset (p, '0', nzero); | |
317 | p += nzero; | |
318 | memcpy (p, q, digits); | |
319 | p += digits; | |
320 | memset (p, ' ', nblank); | |
5e805e44 | 321 | dtp->u.p.no_leading_blank = 0; |
29dc5138 | 322 | } |
6de9cd9a | 323 | |
f21edfd6 | 324 | done: |
6de9cd9a DN |
325 | return; |
326 | } | |
327 | ||
328 | static void | |
5e805e44 JJ |
329 | write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, |
330 | int len, | |
1449b8cb | 331 | const char *(*conv) (GFC_INTEGER_LARGEST, char *, size_t)) |
6de9cd9a | 332 | { |
32aa3bff | 333 | GFC_INTEGER_LARGEST n = 0; |
6de9cd9a | 334 | int w, m, digits, nsign, nzero, nblank; |
1449b8cb JJ |
335 | char *p; |
336 | const char *q; | |
6de9cd9a | 337 | sign_t sign; |
1449b8cb | 338 | char itoa_buf[GFC_BTOA_BUF_SIZE]; |
6de9cd9a DN |
339 | |
340 | w = f->u.integer.w; | |
341 | m = f->u.integer.m; | |
342 | ||
343 | n = extract_int (source, len); | |
344 | ||
7fcb1804 | 345 | /* Special case: */ |
6de9cd9a DN |
346 | |
347 | if (m == 0 && n == 0) | |
348 | { | |
349 | if (w == 0) | |
350 | w = 1; | |
351 | ||
5e805e44 | 352 | p = write_block (dtp, w); |
6de9cd9a DN |
353 | if (p == NULL) |
354 | return; | |
355 | ||
356 | memset (p, ' ', w); | |
357 | goto done; | |
358 | } | |
359 | ||
5e805e44 | 360 | sign = calculate_sign (dtp, n < 0); |
6de9cd9a DN |
361 | if (n < 0) |
362 | n = -n; | |
363 | ||
364 | nsign = sign == SIGN_NONE ? 0 : 1; | |
1449b8cb | 365 | q = conv (n, itoa_buf, sizeof (itoa_buf)); |
6de9cd9a DN |
366 | |
367 | digits = strlen (q); | |
368 | ||
369 | /* Select a width if none was specified. The idea here is to always | |
7fcb1804 | 370 | print something. */ |
6de9cd9a DN |
371 | |
372 | if (w == 0) | |
373 | w = ((digits < m) ? m : digits) + nsign; | |
374 | ||
5e805e44 | 375 | p = write_block (dtp, w); |
6de9cd9a DN |
376 | if (p == NULL) |
377 | return; | |
378 | ||
379 | nzero = 0; | |
380 | if (digits < m) | |
381 | nzero = m - digits; | |
382 | ||
7fcb1804 | 383 | /* See if things will work. */ |
6de9cd9a DN |
384 | |
385 | nblank = w - (nsign + nzero + digits); | |
386 | ||
387 | if (nblank < 0) | |
388 | { | |
389 | star_fill (p, w); | |
390 | goto done; | |
391 | } | |
392 | ||
393 | memset (p, ' ', nblank); | |
394 | p += nblank; | |
395 | ||
396 | switch (sign) | |
397 | { | |
398 | case SIGN_PLUS: | |
399 | *p++ = '+'; | |
400 | break; | |
401 | case SIGN_MINUS: | |
402 | *p++ = '-'; | |
403 | break; | |
404 | case SIGN_NONE: | |
405 | break; | |
406 | } | |
407 | ||
408 | memset (p, '0', nzero); | |
409 | p += nzero; | |
410 | ||
411 | memcpy (p, q, digits); | |
412 | ||
f21edfd6 | 413 | done: |
6de9cd9a DN |
414 | return; |
415 | } | |
416 | ||
417 | ||
7fcb1804 | 418 | /* Convert unsigned octal to ascii. */ |
6de9cd9a | 419 | |
1449b8cb JJ |
420 | static const char * |
421 | otoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) | |
6de9cd9a DN |
422 | { |
423 | char *p; | |
424 | ||
1449b8cb JJ |
425 | assert (len >= GFC_OTOA_BUF_SIZE); |
426 | ||
6de9cd9a | 427 | if (n == 0) |
1449b8cb | 428 | return "0"; |
6de9cd9a | 429 | |
1449b8cb JJ |
430 | p = buffer + GFC_OTOA_BUF_SIZE - 1; |
431 | *p = '\0'; | |
6de9cd9a DN |
432 | |
433 | while (n != 0) | |
434 | { | |
1449b8cb | 435 | *--p = '0' + (n & 7); |
6de9cd9a DN |
436 | n >>= 3; |
437 | } | |
438 | ||
1449b8cb | 439 | return p; |
6de9cd9a DN |
440 | } |
441 | ||
442 | ||
7fcb1804 | 443 | /* Convert unsigned binary to ascii. */ |
6de9cd9a | 444 | |
1449b8cb JJ |
445 | static const char * |
446 | btoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) | |
6de9cd9a DN |
447 | { |
448 | char *p; | |
449 | ||
1449b8cb JJ |
450 | assert (len >= GFC_BTOA_BUF_SIZE); |
451 | ||
6de9cd9a | 452 | if (n == 0) |
1449b8cb | 453 | return "0"; |
6de9cd9a | 454 | |
1449b8cb JJ |
455 | p = buffer + GFC_BTOA_BUF_SIZE - 1; |
456 | *p = '\0'; | |
6de9cd9a DN |
457 | |
458 | while (n != 0) | |
459 | { | |
1449b8cb | 460 | *--p = '0' + (n & 1); |
6de9cd9a DN |
461 | n >>= 1; |
462 | } | |
463 | ||
1449b8cb | 464 | return p; |
6de9cd9a DN |
465 | } |
466 | ||
467 | ||
468 | void | |
5e805e44 | 469 | write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 470 | { |
5e805e44 | 471 | write_decimal (dtp, f, p, len, (void *) gfc_itoa); |
6de9cd9a DN |
472 | } |
473 | ||
474 | ||
475 | void | |
5e805e44 | 476 | write_b (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 477 | { |
5e805e44 | 478 | write_int (dtp, f, p, len, btoa); |
6de9cd9a DN |
479 | } |
480 | ||
481 | ||
482 | void | |
5e805e44 | 483 | write_o (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 484 | { |
5e805e44 | 485 | write_int (dtp, f, p, len, otoa); |
6de9cd9a DN |
486 | } |
487 | ||
488 | void | |
5e805e44 | 489 | write_z (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 490 | { |
5e805e44 | 491 | write_int (dtp, f, p, len, xtoa); |
6de9cd9a DN |
492 | } |
493 | ||
494 | ||
495 | void | |
5e805e44 | 496 | write_d (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 497 | { |
5e805e44 | 498 | write_float (dtp, f, p, len); |
6de9cd9a DN |
499 | } |
500 | ||
501 | ||
502 | void | |
5e805e44 | 503 | write_e (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 504 | { |
5e805e44 | 505 | write_float (dtp, f, p, len); |
6de9cd9a DN |
506 | } |
507 | ||
508 | ||
509 | void | |
5e805e44 | 510 | write_f (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 511 | { |
5e805e44 | 512 | write_float (dtp, f, p, len); |
6de9cd9a DN |
513 | } |
514 | ||
515 | ||
516 | void | |
5e805e44 | 517 | write_en (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 518 | { |
5e805e44 | 519 | write_float (dtp, f, p, len); |
6de9cd9a DN |
520 | } |
521 | ||
522 | ||
523 | void | |
5e805e44 | 524 | write_es (st_parameter_dt *dtp, const fnode *f, const char *p, int len) |
6de9cd9a | 525 | { |
5e805e44 | 526 | write_float (dtp, f, p, len); |
6de9cd9a DN |
527 | } |
528 | ||
529 | ||
7fcb1804 | 530 | /* Take care of the X/TR descriptor. */ |
6de9cd9a DN |
531 | |
532 | void | |
5e805e44 | 533 | write_x (st_parameter_dt *dtp, int len, int nspaces) |
6de9cd9a DN |
534 | { |
535 | char *p; | |
536 | ||
5e805e44 | 537 | p = write_block (dtp, len); |
6de9cd9a DN |
538 | if (p == NULL) |
539 | return; | |
540 | ||
be0cc7e2 PT |
541 | if (nspaces > 0) |
542 | memset (&p[len - nspaces], ' ', nspaces); | |
6de9cd9a DN |
543 | } |
544 | ||
545 | ||
7fcb1804 | 546 | /* List-directed writing. */ |
6de9cd9a DN |
547 | |
548 | ||
7fcb1804 TS |
549 | /* Write a single character to the output. Returns nonzero if |
550 | something goes wrong. */ | |
6de9cd9a DN |
551 | |
552 | static int | |
5e805e44 | 553 | write_char (st_parameter_dt *dtp, char c) |
6de9cd9a DN |
554 | { |
555 | char *p; | |
556 | ||
5e805e44 | 557 | p = write_block (dtp, 1); |
6de9cd9a DN |
558 | if (p == NULL) |
559 | return 1; | |
560 | ||
561 | *p = c; | |
562 | ||
563 | return 0; | |
564 | } | |
565 | ||
566 | ||
7fcb1804 | 567 | /* Write a list-directed logical value. */ |
d464f8e9 | 568 | |
6de9cd9a | 569 | static void |
5e805e44 | 570 | write_logical (st_parameter_dt *dtp, const char *source, int length) |
6de9cd9a | 571 | { |
5e805e44 | 572 | write_char (dtp, extract_int (source, length) ? 'T' : 'F'); |
6de9cd9a DN |
573 | } |
574 | ||
575 | ||
7fcb1804 | 576 | /* Write a list-directed integer value. */ |
6de9cd9a DN |
577 | |
578 | static void | |
5e805e44 | 579 | write_integer (st_parameter_dt *dtp, const char *source, int length) |
6de9cd9a DN |
580 | { |
581 | char *p; | |
582 | const char *q; | |
583 | int digits; | |
d464f8e9 | 584 | int width; |
1449b8cb | 585 | char itoa_buf[GFC_ITOA_BUF_SIZE]; |
6de9cd9a | 586 | |
1449b8cb | 587 | q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf)); |
6de9cd9a | 588 | |
d464f8e9 JB |
589 | switch (length) |
590 | { | |
591 | case 1: | |
592 | width = 4; | |
593 | break; | |
594 | ||
595 | case 2: | |
596 | width = 6; | |
597 | break; | |
598 | ||
599 | case 4: | |
600 | width = 11; | |
601 | break; | |
602 | ||
603 | case 8: | |
604 | width = 20; | |
605 | break; | |
606 | ||
607 | default: | |
608 | width = 0; | |
609 | break; | |
610 | } | |
611 | ||
6de9cd9a DN |
612 | digits = strlen (q); |
613 | ||
5e805e44 JJ |
614 | if (width < digits) |
615 | width = digits; | |
616 | p = write_block (dtp, width); | |
aed6ee24 JD |
617 | if (p == NULL) |
618 | return; | |
5e805e44 | 619 | if (dtp->u.p.no_leading_blank) |
29dc5138 PT |
620 | { |
621 | memcpy (p, q, digits); | |
5e805e44 | 622 | memset (p + digits, ' ', width - digits); |
29dc5138 PT |
623 | } |
624 | else | |
625 | { | |
5e805e44 | 626 | memset (p, ' ', width - digits); |
aed6ee24 | 627 | memcpy (p + width - digits, q, digits); |
29dc5138 | 628 | } |
6de9cd9a DN |
629 | } |
630 | ||
631 | ||
7fcb1804 TS |
632 | /* Write a list-directed string. We have to worry about delimiting |
633 | the strings if the file has been opened in that mode. */ | |
6de9cd9a DN |
634 | |
635 | static void | |
5e805e44 | 636 | write_character (st_parameter_dt *dtp, const char *source, int length) |
6de9cd9a DN |
637 | { |
638 | int i, extra; | |
639 | char *p, d; | |
640 | ||
5e805e44 | 641 | switch (dtp->u.p.current_unit->flags.delim) |
6de9cd9a DN |
642 | { |
643 | case DELIM_APOSTROPHE: | |
644 | d = '\''; | |
645 | break; | |
646 | case DELIM_QUOTE: | |
647 | d = '"'; | |
648 | break; | |
649 | default: | |
650 | d = ' '; | |
651 | break; | |
652 | } | |
653 | ||
654 | if (d == ' ') | |
655 | extra = 0; | |
656 | else | |
657 | { | |
658 | extra = 2; | |
659 | ||
660 | for (i = 0; i < length; i++) | |
661 | if (source[i] == d) | |
662 | extra++; | |
663 | } | |
664 | ||
5e805e44 | 665 | p = write_block (dtp, length + extra); |
6de9cd9a DN |
666 | if (p == NULL) |
667 | return; | |
668 | ||
669 | if (d == ' ') | |
670 | memcpy (p, source, length); | |
671 | else | |
672 | { | |
673 | *p++ = d; | |
674 | ||
675 | for (i = 0; i < length; i++) | |
676 | { | |
677 | *p++ = source[i]; | |
678 | if (source[i] == d) | |
679 | *p++ = d; | |
680 | } | |
681 | ||
682 | *p = d; | |
683 | } | |
684 | } | |
685 | ||
686 | ||
7fcb1804 | 687 | /* Output a real number with default format. |
6d56728a | 688 | This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), |
55fc9243 | 689 | 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ |
6de9cd9a DN |
690 | |
691 | static void | |
5e805e44 | 692 | write_real (st_parameter_dt *dtp, const char *source, int length) |
6de9cd9a DN |
693 | { |
694 | fnode f ; | |
5e805e44 | 695 | int org_scale = dtp->u.p.scale_factor; |
6de9cd9a | 696 | f.format = FMT_G; |
5e805e44 | 697 | dtp->u.p.scale_factor = 1; |
6d56728a | 698 | switch (length) |
6de9cd9a | 699 | { |
6d56728a | 700 | case 4: |
e900e0ca FXC |
701 | f.u.real.w = 15; |
702 | f.u.real.d = 8; | |
6de9cd9a | 703 | f.u.real.e = 2; |
6d56728a FXC |
704 | break; |
705 | case 8: | |
e900e0ca FXC |
706 | f.u.real.w = 25; |
707 | f.u.real.d = 17; | |
6de9cd9a | 708 | f.u.real.e = 3; |
6d56728a FXC |
709 | break; |
710 | case 10: | |
e900e0ca FXC |
711 | f.u.real.w = 29; |
712 | f.u.real.d = 20; | |
6d56728a FXC |
713 | f.u.real.e = 4; |
714 | break; | |
715 | case 16: | |
81014334 TB |
716 | f.u.real.w = 44; |
717 | f.u.real.d = 35; | |
6d56728a FXC |
718 | f.u.real.e = 4; |
719 | break; | |
720 | default: | |
5e805e44 | 721 | internal_error (&dtp->common, "bad real kind"); |
6d56728a | 722 | break; |
6de9cd9a | 723 | } |
5e805e44 JJ |
724 | write_float (dtp, &f, source , length); |
725 | dtp->u.p.scale_factor = org_scale; | |
6de9cd9a DN |
726 | } |
727 | ||
728 | ||
729 | static void | |
5e805e44 | 730 | write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) |
6de9cd9a | 731 | { |
5e805e44 | 732 | if (write_char (dtp, '(')) |
6de9cd9a | 733 | return; |
5e805e44 | 734 | write_real (dtp, source, kind); |
6de9cd9a | 735 | |
5e805e44 | 736 | if (write_char (dtp, ',')) |
6de9cd9a | 737 | return; |
5e805e44 | 738 | write_real (dtp, source + size / 2, kind); |
6de9cd9a | 739 | |
5e805e44 | 740 | write_char (dtp, ')'); |
6de9cd9a DN |
741 | } |
742 | ||
743 | ||
7fcb1804 | 744 | /* Write the separator between items. */ |
6de9cd9a DN |
745 | |
746 | static void | |
5e805e44 | 747 | write_separator (st_parameter_dt *dtp) |
6de9cd9a DN |
748 | { |
749 | char *p; | |
750 | ||
5e805e44 | 751 | p = write_block (dtp, options.separator_len); |
6de9cd9a DN |
752 | if (p == NULL) |
753 | return; | |
754 | ||
755 | memcpy (p, options.separator, options.separator_len); | |
756 | } | |
757 | ||
758 | ||
7fcb1804 TS |
759 | /* Write an item with list formatting. |
760 | TODO: handle skipping to the next record correctly, particularly | |
761 | with strings. */ | |
6de9cd9a | 762 | |
18623fae | 763 | static void |
5e805e44 JJ |
764 | list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, |
765 | size_t size) | |
6de9cd9a | 766 | { |
5e805e44 | 767 | if (dtp->u.p.current_unit == NULL) |
6de9cd9a DN |
768 | return; |
769 | ||
5e805e44 | 770 | if (dtp->u.p.first_item) |
6de9cd9a | 771 | { |
5e805e44 JJ |
772 | dtp->u.p.first_item = 0; |
773 | write_char (dtp, ' '); | |
6de9cd9a DN |
774 | } |
775 | else | |
776 | { | |
5e805e44 JJ |
777 | if (type != BT_CHARACTER || !dtp->u.p.char_flag || |
778 | dtp->u.p.current_unit->flags.delim != DELIM_NONE) | |
779 | write_separator (dtp); | |
6de9cd9a DN |
780 | } |
781 | ||
782 | switch (type) | |
783 | { | |
784 | case BT_INTEGER: | |
5e805e44 | 785 | write_integer (dtp, p, kind); |
6de9cd9a DN |
786 | break; |
787 | case BT_LOGICAL: | |
5e805e44 | 788 | write_logical (dtp, p, kind); |
6de9cd9a DN |
789 | break; |
790 | case BT_CHARACTER: | |
5e805e44 | 791 | write_character (dtp, p, kind); |
6de9cd9a DN |
792 | break; |
793 | case BT_REAL: | |
5e805e44 | 794 | write_real (dtp, p, kind); |
6de9cd9a DN |
795 | break; |
796 | case BT_COMPLEX: | |
5e805e44 | 797 | write_complex (dtp, p, kind, size); |
6de9cd9a DN |
798 | break; |
799 | default: | |
5e805e44 | 800 | internal_error (&dtp->common, "list_formatted_write(): Bad type"); |
6de9cd9a DN |
801 | } |
802 | ||
5e805e44 | 803 | dtp->u.p.char_flag = (type == BT_CHARACTER); |
6de9cd9a DN |
804 | } |
805 | ||
18623fae JB |
806 | |
807 | void | |
5e805e44 JJ |
808 | list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind, |
809 | size_t size, size_t nelems) | |
18623fae JB |
810 | { |
811 | size_t elem; | |
18623fae JB |
812 | char *tmp; |
813 | ||
814 | tmp = (char *) p; | |
815 | ||
18623fae JB |
816 | /* Big loop over all the elements. */ |
817 | for (elem = 0; elem < nelems; elem++) | |
818 | { | |
5e805e44 JJ |
819 | dtp->u.p.item_count++; |
820 | list_formatted_write_scalar (dtp, type, tmp + size*elem, kind, size); | |
18623fae JB |
821 | } |
822 | } | |
823 | ||
29dc5138 | 824 | /* NAMELIST OUTPUT |
6de9cd9a | 825 | |
29dc5138 PT |
826 | nml_write_obj writes a namelist object to the output stream. It is called |
827 | recursively for derived type components: | |
828 | obj = is the namelist_info for the current object. | |
829 | offset = the offset relative to the address held by the object for | |
830 | derived type arrays. | |
831 | base = is the namelist_info of the derived type, when obj is a | |
832 | component. | |
833 | base_name = the full name for a derived type, including qualifiers | |
834 | if any. | |
835 | The returned value is a pointer to the object beyond the last one | |
836 | accessed, including nested derived types. Notice that the namelist is | |
837 | a linear linked list of objects, including derived types and their | |
838 | components. A tree, of sorts, is implied by the compound names of | |
839 | the derived type components and this is how this function recurses through | |
840 | the list. */ | |
6de9cd9a | 841 | |
29dc5138 PT |
842 | /* A generous estimate of the number of characters needed to print |
843 | repeat counts and indices, including commas, asterices and brackets. */ | |
844 | ||
845 | #define NML_DIGITS 20 | |
846 | ||
29dc5138 | 847 | static namelist_info * |
5e805e44 | 848 | nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, |
29dc5138 PT |
849 | namelist_info * base, char * base_name) |
850 | { | |
851 | int rep_ctr; | |
852 | int num; | |
853 | int nml_carry; | |
854 | index_type len; | |
855 | index_type obj_size; | |
856 | index_type nelem; | |
857 | index_type dim_i; | |
858 | index_type clen; | |
859 | index_type elem_ctr; | |
860 | index_type obj_name_len; | |
861 | void * p ; | |
862 | char cup; | |
863 | char * obj_name; | |
864 | char * ext_name; | |
865 | char rep_buff[NML_DIGITS]; | |
866 | namelist_info * cmp; | |
867 | namelist_info * retval = obj->next; | |
88fdfd5a JB |
868 | size_t base_name_len; |
869 | size_t base_var_name_len; | |
870 | size_t tot_len; | |
0be72e3a | 871 | unit_delim tmp_delim; |
29dc5138 PT |
872 | |
873 | /* Write namelist variable names in upper case. If a derived type, | |
874 | nothing is output. If a component, base and base_name are set. */ | |
875 | ||
876 | if (obj->type != GFC_DTYPE_DERIVED) | |
b10cf173 | 877 | { |
8824fd4c FXC |
878 | #ifdef HAVE_CRLF |
879 | write_character (dtp, "\r\n ", 3); | |
880 | #else | |
5e805e44 | 881 | write_character (dtp, "\n ", 2); |
8824fd4c | 882 | #endif |
29dc5138 PT |
883 | len = 0; |
884 | if (base) | |
b10cf173 | 885 | { |
29dc5138 | 886 | len =strlen (base->var_name); |
8f2a1406 | 887 | for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++) |
3bc268e6 | 888 | { |
29dc5138 | 889 | cup = toupper (base_name[dim_i]); |
5e805e44 | 890 | write_character (dtp, &cup, 1); |
3bc268e6 | 891 | } |
29dc5138 | 892 | } |
8f2a1406 | 893 | for (dim_i =len; dim_i < (index_type) strlen (obj->var_name); dim_i++) |
29dc5138 PT |
894 | { |
895 | cup = toupper (obj->var_name[dim_i]); | |
5e805e44 | 896 | write_character (dtp, &cup, 1); |
29dc5138 | 897 | } |
5e805e44 | 898 | write_character (dtp, "=", 1); |
29dc5138 PT |
899 | } |
900 | ||
901 | /* Counts the number of data output on a line, including names. */ | |
902 | ||
903 | num = 1; | |
904 | ||
905 | len = obj->len; | |
e5ef4b3b JB |
906 | |
907 | switch (obj->type) | |
908 | { | |
909 | ||
910 | case GFC_DTYPE_REAL: | |
911 | obj_size = size_from_real_kind (len); | |
912 | break; | |
913 | ||
914 | case GFC_DTYPE_COMPLEX: | |
915 | obj_size = size_from_complex_kind (len); | |
916 | break; | |
917 | ||
918 | case GFC_DTYPE_CHARACTER: | |
919 | obj_size = obj->string_length; | |
920 | break; | |
921 | ||
922 | default: | |
923 | obj_size = len; | |
924 | } | |
925 | ||
29dc5138 PT |
926 | if (obj->var_rank) |
927 | obj_size = obj->size; | |
928 | ||
929 | /* Set the index vector and count the number of elements. */ | |
930 | ||
931 | nelem = 1; | |
932 | for (dim_i=0; dim_i < obj->var_rank; dim_i++) | |
933 | { | |
934 | obj->ls[dim_i].idx = obj->dim[dim_i].lbound; | |
935 | nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound); | |
936 | } | |
937 | ||
938 | /* Main loop to output the data held in the object. */ | |
939 | ||
940 | rep_ctr = 1; | |
941 | for (elem_ctr = 0; elem_ctr < nelem; elem_ctr++) | |
942 | { | |
943 | ||
944 | /* Build the pointer to the data value. The offset is passed by | |
945 | recursive calls to this function for arrays of derived types. | |
946 | Is NULL otherwise. */ | |
947 | ||
948 | p = (void *)(obj->mem_pos + elem_ctr * obj_size); | |
949 | p += offset; | |
950 | ||
951 | /* Check for repeat counts of intrinsic types. */ | |
952 | ||
953 | if ((elem_ctr < (nelem - 1)) && | |
954 | (obj->type != GFC_DTYPE_DERIVED) && | |
955 | !memcmp (p, (void*)(p + obj_size ), obj_size )) | |
956 | { | |
957 | rep_ctr++; | |
958 | } | |
959 | ||
960 | /* Execute a repeated output. Note the flag no_leading_blank that | |
961 | is used in the functions used to output the intrinsic types. */ | |
962 | ||
963 | else | |
964 | { | |
965 | if (rep_ctr > 1) | |
966 | { | |
d8163f5c | 967 | sprintf(rep_buff, " %d*", rep_ctr); |
5e805e44 JJ |
968 | write_character (dtp, rep_buff, strlen (rep_buff)); |
969 | dtp->u.p.no_leading_blank = 1; | |
29dc5138 PT |
970 | } |
971 | num++; | |
972 | ||
420aa7b8 | 973 | /* Output the data, if an intrinsic type, or recurse into this |
29dc5138 PT |
974 | routine to treat derived types. */ |
975 | ||
976 | switch (obj->type) | |
977 | { | |
978 | ||
979 | case GFC_DTYPE_INTEGER: | |
5e805e44 | 980 | write_integer (dtp, p, len); |
6de9cd9a | 981 | break; |
29dc5138 PT |
982 | |
983 | case GFC_DTYPE_LOGICAL: | |
5e805e44 | 984 | write_logical (dtp, p, len); |
6de9cd9a | 985 | break; |
29dc5138 PT |
986 | |
987 | case GFC_DTYPE_CHARACTER: | |
0be72e3a JD |
988 | tmp_delim = dtp->u.p.current_unit->flags.delim; |
989 | if (dtp->u.p.nml_delim == '"') | |
990 | dtp->u.p.current_unit->flags.delim = DELIM_QUOTE; | |
991 | if (dtp->u.p.nml_delim == '\'') | |
992 | dtp->u.p.current_unit->flags.delim = DELIM_APOSTROPHE; | |
5e805e44 | 993 | write_character (dtp, p, obj->string_length); |
0be72e3a | 994 | dtp->u.p.current_unit->flags.delim = tmp_delim; |
6de9cd9a | 995 | break; |
29dc5138 PT |
996 | |
997 | case GFC_DTYPE_REAL: | |
5e805e44 | 998 | write_real (dtp, p, len); |
6de9cd9a | 999 | break; |
29dc5138 PT |
1000 | |
1001 | case GFC_DTYPE_COMPLEX: | |
5e805e44 | 1002 | dtp->u.p.no_leading_blank = 0; |
29dc5138 | 1003 | num++; |
5e805e44 | 1004 | write_complex (dtp, p, len, obj_size); |
6de9cd9a | 1005 | break; |
29dc5138 PT |
1006 | |
1007 | case GFC_DTYPE_DERIVED: | |
1008 | ||
1009 | /* To treat a derived type, we need to build two strings: | |
1010 | ext_name = the name, including qualifiers that prepends | |
420aa7b8 | 1011 | component names in the output - passed to |
29dc5138 PT |
1012 | nml_write_obj. |
1013 | obj_name = the derived type name with no qualifiers but % | |
420aa7b8 | 1014 | appended. This is used to identify the |
29dc5138 PT |
1015 | components. */ |
1016 | ||
1017 | /* First ext_name => get length of all possible components */ | |
1018 | ||
88fdfd5a JB |
1019 | base_name_len = base_name ? strlen (base_name) : 0; |
1020 | base_var_name_len = base ? strlen (base->var_name) : 0; | |
1021 | ext_name = (char*)get_mem ( base_name_len | |
1022 | + base_var_name_len | |
29dc5138 | 1023 | + strlen (obj->var_name) |
bfe936c0 PT |
1024 | + obj->var_rank * NML_DIGITS |
1025 | + 1); | |
29dc5138 | 1026 | |
88fdfd5a JB |
1027 | memcpy (ext_name, base_name, base_name_len); |
1028 | clen = strlen (obj->var_name + base_var_name_len); | |
1029 | memcpy (ext_name + base_name_len, | |
1030 | obj->var_name + base_var_name_len, clen); | |
1031 | ||
29dc5138 PT |
1032 | /* Append the qualifier. */ |
1033 | ||
88fdfd5a | 1034 | tot_len = base_name_len + clen; |
29dc5138 PT |
1035 | for (dim_i = 0; dim_i < obj->var_rank; dim_i++) |
1036 | { | |
88fdfd5a JB |
1037 | if (!dim_i) |
1038 | { | |
1039 | ext_name[tot_len] = '('; | |
1040 | tot_len++; | |
1041 | } | |
d8163f5c | 1042 | sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx); |
88fdfd5a JB |
1043 | tot_len += strlen (ext_name + tot_len); |
1044 | ext_name[tot_len] = (dim_i == obj->var_rank - 1) ? ')' : ','; | |
1045 | tot_len++; | |
29dc5138 PT |
1046 | } |
1047 | ||
88fdfd5a JB |
1048 | ext_name[tot_len] = '\0'; |
1049 | ||
29dc5138 PT |
1050 | /* Now obj_name. */ |
1051 | ||
1052 | obj_name_len = strlen (obj->var_name) + 1; | |
1053 | obj_name = get_mem (obj_name_len+1); | |
88fdfd5a JB |
1054 | memcpy (obj_name, obj->var_name, obj_name_len-1); |
1055 | memcpy (obj_name + obj_name_len-1, "%", 2); | |
29dc5138 PT |
1056 | |
1057 | /* Now loop over the components. Update the component pointer | |
1058 | with the return value from nml_write_obj => this loop jumps | |
1059 | past nested derived types. */ | |
1060 | ||
1061 | for (cmp = obj->next; | |
1062 | cmp && !strncmp (cmp->var_name, obj_name, obj_name_len); | |
1063 | cmp = retval) | |
1064 | { | |
5e805e44 JJ |
1065 | retval = nml_write_obj (dtp, cmp, |
1066 | (index_type)(p - obj->mem_pos), | |
29dc5138 PT |
1067 | obj, ext_name); |
1068 | } | |
1069 | ||
1070 | free_mem (obj_name); | |
1071 | free_mem (ext_name); | |
1072 | goto obj_loop; | |
1073 | ||
6de9cd9a | 1074 | default: |
5e805e44 | 1075 | internal_error (&dtp->common, "Bad type for namelist write"); |
6de9cd9a | 1076 | } |
29dc5138 PT |
1077 | |
1078 | /* Reset the leading blank suppression, write a comma and, if 5 | |
1079 | values have been output, write a newline and advance to column | |
1080 | 2. Reset the repeat counter. */ | |
1081 | ||
5e805e44 JJ |
1082 | dtp->u.p.no_leading_blank = 0; |
1083 | write_character (dtp, ",", 1); | |
b10cf173 RS |
1084 | if (num > 5) |
1085 | { | |
1086 | num = 0; | |
8824fd4c FXC |
1087 | #ifdef HAVE_CRLF |
1088 | write_character (dtp, "\r\n ", 3); | |
1089 | #else | |
5e805e44 | 1090 | write_character (dtp, "\n ", 2); |
8824fd4c | 1091 | #endif |
29dc5138 PT |
1092 | } |
1093 | rep_ctr = 1; | |
1094 | } | |
1095 | ||
1096 | /* Cycle through and increment the index vector. */ | |
1097 | ||
1098 | obj_loop: | |
1099 | ||
1100 | nml_carry = 1; | |
1101 | for (dim_i = 0; nml_carry && (dim_i < obj->var_rank); dim_i++) | |
1102 | { | |
1103 | obj->ls[dim_i].idx += nml_carry ; | |
1104 | nml_carry = 0; | |
1105 | if (obj->ls[dim_i].idx > (ssize_t)obj->dim[dim_i].ubound) | |
1106 | { | |
1107 | obj->ls[dim_i].idx = obj->dim[dim_i].lbound; | |
1108 | nml_carry = 1; | |
1109 | } | |
1110 | } | |
1111 | } | |
1112 | ||
1113 | /* Return a pointer beyond the furthest object accessed. */ | |
1114 | ||
1115 | return retval; | |
1116 | } | |
1117 | ||
1118 | /* This is the entry function for namelist writes. It outputs the name | |
420aa7b8 AJ |
1119 | of the namelist and iterates through the namelist by calls to |
1120 | nml_write_obj. The call below has dummys in the arguments used in | |
29dc5138 PT |
1121 | the treatment of derived types. */ |
1122 | ||
1123 | void | |
5e805e44 | 1124 | namelist_write (st_parameter_dt *dtp) |
29dc5138 PT |
1125 | { |
1126 | namelist_info * t1, *t2, *dummy = NULL; | |
1127 | index_type i; | |
1128 | index_type dummy_offset = 0; | |
1129 | char c; | |
1130 | char * dummy_name = NULL; | |
1131 | unit_delim tmp_delim; | |
1132 | ||
1133 | /* Set the delimiter for namelist output. */ | |
1134 | ||
5e805e44 | 1135 | tmp_delim = dtp->u.p.current_unit->flags.delim; |
29dc5138 PT |
1136 | switch (tmp_delim) |
1137 | { | |
1138 | case (DELIM_QUOTE): | |
5e805e44 | 1139 | dtp->u.p.nml_delim = '"'; |
29dc5138 PT |
1140 | break; |
1141 | ||
1142 | case (DELIM_APOSTROPHE): | |
5e805e44 | 1143 | dtp->u.p.nml_delim = '\''; |
29dc5138 PT |
1144 | break; |
1145 | ||
1146 | default: | |
5e805e44 JJ |
1147 | dtp->u.p.nml_delim = '\0'; |
1148 | break; | |
29dc5138 PT |
1149 | } |
1150 | ||
0be72e3a JD |
1151 | /* Temporarily disable namelist delimters. */ |
1152 | dtp->u.p.current_unit->flags.delim = DELIM_NONE; | |
1153 | ||
5e805e44 | 1154 | write_character (dtp, "&", 1); |
29dc5138 PT |
1155 | |
1156 | /* Write namelist name in upper case - f95 std. */ | |
5e805e44 | 1157 | for (i = 0 ;i < dtp->namelist_name_len ;i++ ) |
29dc5138 | 1158 | { |
5e805e44 JJ |
1159 | c = toupper (dtp->namelist_name[i]); |
1160 | write_character (dtp, &c ,1); | |
1161 | } | |
29dc5138 | 1162 | |
5e805e44 | 1163 | if (dtp->u.p.ionml != NULL) |
29dc5138 | 1164 | { |
5e805e44 | 1165 | t1 = dtp->u.p.ionml; |
29dc5138 PT |
1166 | while (t1 != NULL) |
1167 | { | |
1168 | t2 = t1; | |
5e805e44 | 1169 | t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name); |
b10cf173 RS |
1170 | } |
1171 | } | |
0be72e3a | 1172 | |
8824fd4c | 1173 | #ifdef HAVE_CRLF |
b87ff335 | 1174 | write_character (dtp, " /\r\n", 5); |
8824fd4c | 1175 | #else |
5e805e44 | 1176 | write_character (dtp, " /\n", 4); |
8824fd4c | 1177 | #endif |
29dc5138 | 1178 | |
0be72e3a | 1179 | /* Restore the original delimiter. */ |
5e805e44 | 1180 | dtp->u.p.current_unit->flags.delim = tmp_delim; |
6de9cd9a | 1181 | } |
29dc5138 PT |
1182 | |
1183 | #undef NML_DIGITS |