| 3426 | // |
| 3427 | |
| 3428 | static void gen_tpb_data(const tpb* tpb_buffer) |
| 3429 | { |
| 3430 | union { |
| 3431 | UCHAR bytewise_tpb[4]; |
| 3432 | SLONG longword_tpb; |
| 3433 | } tpb_hunk; |
| 3434 | |
| 3435 | // TPBs are generated as raw BLR in longword chunks |
| 3436 | // because FORTRAN is a miserable excuse for a language |
| 3437 | // and doesn't allow byte value assignments to character |
| 3438 | // fields. |
| 3439 | |
| 3440 | int length = (tpb_buffer->tpb_length + (sizeof(SLONG) - 1)) / sizeof(SLONG); |
| 3441 | |
| 3442 | printa(COLUMN, "DATA ISC_TPB_%d /", tpb_buffer->tpb_ident, COMMA, length); |
| 3443 | |
| 3444 | const UCHAR* text = tpb_buffer->tpb_string; |
| 3445 | length = tpb_buffer->tpb_length; |
| 3446 | strcpy(output_buffer, CONTINUE); |
| 3447 | |
| 3448 | TEXT* p; |
| 3449 | for (p = output_buffer; *p; p++); |
| 3450 | |
| 3451 | while (length) |
| 3452 | { |
| 3453 | for (UCHAR* c = tpb_hunk.bytewise_tpb; c < tpb_hunk.bytewise_tpb + sizeof(SLONG); c++) |
| 3454 | { |
| 3455 | *c = *text++; |
| 3456 | if (!--length) |
| 3457 | break; |
| 3458 | } |
| 3459 | if (length) |
| 3460 | sprintf(p, "%" SLONGFORMAT",", tpb_hunk.longword_tpb); |
| 3461 | else |
| 3462 | sprintf(p, "%" SLONGFORMAT"/\n", tpb_hunk.longword_tpb); |
| 3463 | p += 12; // ??? |
| 3464 | } |
| 3465 | |
| 3466 | FTN_print_buffer(output_buffer); |
| 3467 | sprintf(output_buffer, "%sEnd of data for ISC_TPB_%d\n", COMMENT, tpb_buffer->tpb_ident); |
| 3468 | FTN_print_buffer(output_buffer); |
| 3469 | } |
| 3470 | |
| 3471 | |
| 3472 | //____________________________________________________________ |
no test coverage detected