From 65f64156283698dd16cf0061d595f568ddb91a0b Mon Sep 17 00:00:00 2001 From: lefessan Date: Fri, 2 Jun 2023 13:18:47 +0000 Subject: [PATCH 1/7] Display code excerpt around error messages in diagnostics Controlled by three new options: * -fno-diagnostics-show-caret to disable code excerpts * -fno-diagnostics-show-line-numbers to not display line numbers * -fdiagnostics-plain-output to make output as plain as possible --- NEWS | 10 +- cobc/ChangeLog | 14 +++ cobc/cobc.c | 7 ++ cobc/error.c | 135 ++++++++++++++++++++++----- cobc/flag.def | 8 +- cobc/help.c | 1 + tests/atlocal.in | 1 + tests/testsuite.src/listings.at | 4 +- tests/testsuite.src/used_binaries.at | 62 ++++++++++++ 9 files changed, 216 insertions(+), 26 deletions(-) diff --git a/NEWS b/NEWS index 194fc25dc..64811a97d 100644 --- a/NEWS +++ b/NEWS @@ -321,7 +321,7 @@ NEWS - user visible changes -*- outline -*- original version; note: their use will be adjusted where they don't match GCC's same options in later versions, including addition of -M and -MD -** New -std options: +** new -std options: gcos GCOS compatibility gcos-strict GCOS compatibility - strict @@ -330,6 +330,14 @@ NEWS - user visible changes -*- outline -*- dialect configuration options accompanying each specificity introduced by the dialect. +** new diagnostic format for errors: the diagnostics now print the source + code context with a left margin showing line numbers, configurable with + -fno-diagnostics-show-line-numbers, and possible to disable completely + with -fno-diagnostics-show-caret; + + the option -fdiagnostics-plain-output was added to request that diagnostic + output look as plain as possible and stay more stable over time + * Important Bugfixes: ** for dialects other than the GnuCOBOL default different reserved "alias" words diff --git a/cobc/ChangeLog b/cobc/ChangeLog index cf9ce9ecd..16af69cba 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,18 @@ +2023-02-16 Fabrice Le Fessant + + * flag.def (cb_diagnostics_show_caret), error.c + (diagnostics_show_caret): add argument -fno-diagnostics-show-caret + to disable the display of the source context of the error/warning, + 2 lines before and after the location; add argument + -fno-diagnostics-show-line-numbers to disable printing of + line numbers in carets; rename cb_diagnostic_show_option into + cb_diagnostics_show_option to match the argument name. + * error.c (cb_error_kind): replace all occurrences of a + error/warning/note string by a symbolic enum. + * cobc.c: new argument -fdiagnostics-plain-output to make + output as plain as possible (disabling carets for example) + 2023-05-31 Simon Sobisch * codegen.c (output_init_comment_and_source_ref) [NO_INIT_SOURCE_LOC]: diff --git a/cobc/cobc.c b/cobc/cobc.c index 336ac60bc..fe9095025 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -589,6 +589,7 @@ static const struct option long_options[] = { {"P", CB_OP_ARG, NULL, 'P'}, {"Xref", CB_NO_ARG, NULL, 'X'}, {"use-extfh", CB_RQ_ARG, NULL, 9}, /* this is used by COBOL-IT; Same is -fcallfh= */ + {"fdiagnostics-plain-output", CB_NO_ARG, NULL, '/'}, {"Wall", CB_NO_ARG, NULL, 'W'}, {"Wextra", CB_NO_ARG, NULL, 'Y'}, /* this option used to be called -W */ #if 1 @@ -3459,6 +3460,12 @@ process_command_line (const int argc, char **argv) } break; + case '/': + /* -fdiagnostics-plain-output */ + cb_diagnostics_show_caret = 0 ; + cb_diagnostics_show_line_numbers = 0; + break; + case 'P': /* -P : Generate preproc listing */ if (cob_optarg) { diff --git a/cobc/error.c b/cobc/error.c index 09a62ca5d..941ab6f67 100644 --- a/cobc/error.c +++ b/cobc/error.c @@ -32,6 +32,13 @@ #include "cobc.h" #include "tree.h" +enum cb_error_kind { + CB_KIND_ERROR, + CB_KIND_WARNING, + CB_KIND_NOTE, + CB_KIND_GENERAL +}; + static char *errnamebuff = NULL; static struct cb_label *last_section = NULL; static struct cb_label *last_paragraph = NULL; @@ -63,10 +70,80 @@ print_error_prefix (const char *file, int line, const char *prefix) } } +/* Display a context around the location of the error/warning, only if + * cb_diagnostics_show_caret is true + + Only display two lines before and after. No caret yet for the column as + we only have the line. Since we directly use the file, source is printed + before any REPLACE. + */ + +#define CARET_MAX_COLS 73 +static void +diagnostics_show_caret (const char *file, int line) +{ + FILE* fd = fopen(file, "r"); + if (fd == NULL) return; + char buffer[ CARET_MAX_COLS+1 ]; + int line_pos = 1; + int char_pos = 0; + int printed = 0; /* nothing printed */ + while(1){ + int c = fgetc (fd); + if ( c == EOF ){ + if (printed){ + fprintf(stderr, "\n"); + } + fclose(fd); + return ; + } + buffer[char_pos] = c ; + if (c == '\n' || char_pos == CARET_MAX_COLS){ + buffer[char_pos] = 0; + if (line_pos > line-3 && line_pos < line+3){ + if (line_pos == line-2) fprintf(stderr, "\n"); + printed = 1; + fprintf (stderr, " "); + if (cb_diagnostics_show_line_numbers){ + fprintf (stderr, "%04d ", + line_pos); + } + fprintf (stderr, "%c %s%s\n", + line == line_pos ? '>' : ' ', + c == '\n' ? "" : ".." , + buffer); + if (line_pos == line+2){ + fprintf(stderr, "\n"); + fclose(fd); + return; + } + } + while (c != '\n'){ + /* skip end of line too long */ + c = fgetc (fd); + if( c == EOF ) { fclose(fd); return ; } + } + line_pos++; + char_pos=0; + } else { + char_pos++; + } + } +} + static void -print_error (const char *file, int line, const char *prefix, +print_error (const char *file, int line, enum cb_error_kind kind, const char *fmt, va_list ap, const char *diagnostic_option) { + const char *prefix; + + switch( kind ){ + case CB_KIND_ERROR: prefix = _("error: "); break; + case CB_KIND_WARNING: prefix = _("warning: "); break; + case CB_KIND_NOTE: prefix = _("note: "); break; + case CB_KIND_GENERAL: prefix = ""; break; + } + if (!file) { file = cb_source_file; } @@ -119,12 +196,26 @@ print_error (const char *file, int line, const char *prefix, } cb_add_error_to_listing (file, line, prefix, errmsg); } + + static const char* last_caret_file = NULL ; + static int last_caret_line = -1 ; + if (cb_diagnostics_show_caret + && file != NULL + && strcmp (file, COB_DASH) != 0 + && line + && (last_caret_file != file || last_caret_line != line) + ){ + /* remember last printed location to avoid reprinting it */ + last_caret_file = file; + last_caret_line = line; + diagnostics_show_caret (file, line); + } } static void cobc_too_many_errors (void) { - if (!cb_diagnostic_show_option) { + if (!cb_diagnostics_show_option) { fprintf (stderr, "cobc: %s\n", _("too many errors")); } else @@ -306,7 +397,7 @@ static char *warning_option_text (const enum cb_warn_opt opt, const enum cb_warn { const char *opt_name; - if (!cb_diagnostic_show_option) { + if (!cb_diagnostics_show_option) { return NULL; } switch (opt) { @@ -343,9 +434,9 @@ cb_warning_internal (const enum cb_warn_opt opt, const char *fmt, va_list ap) } if (pref != COBC_WARN_AS_ERROR) { - print_error (NULL, 0, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } if (sav_lst_file) { @@ -379,7 +470,7 @@ cb_error_always (const char *fmt, ...) cobc_in_repository = 0; va_start (ap, fmt); - print_error (NULL, 0, _("error: "), fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, NULL); va_end (ap); if (sav_lst_file) { @@ -405,12 +496,12 @@ cb_error_internal (const char *fmt, va_list ap) } if (!ignore_error) { - print_error (NULL, 0, _("error: "), fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, NULL); ret = COBC_WARN_AS_ERROR; } else if (pref == COBC_WARN_AS_ERROR) { - print_error (NULL, 0, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, 0, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } if (sav_lst_file) { @@ -447,7 +538,7 @@ cb_perror (const int config_error, const char *fmt, ...) } va_start (ap, fmt); - print_error (NULL, 0, "", fmt, ap, NULL); + print_error (NULL, 0, CB_KIND_GENERAL, fmt, ap, NULL); va_end (ap); @@ -472,9 +563,9 @@ cb_plex_warning (const enum cb_warn_opt opt, const size_t sline, const char *fmt va_start (ap, fmt); if (pref != COBC_WARN_AS_ERROR) { - print_error (NULL, cb_source_line + (int)sline, _("warning: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, cb_source_line + (int)sline, _("error: "), fmt, ap, warning_option_text (opt, pref)); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } va_end (ap); @@ -496,7 +587,7 @@ cb_plex_error (const size_t sline, const char *fmt, ...) va_list ap; va_start (ap, fmt); - print_error (NULL, cb_source_line + (int)sline, ("error: "), fmt, ap, NULL); + print_error (NULL, cb_source_line + (int)sline, CB_KIND_ERROR, fmt, ap, NULL); va_end (ap); if (sav_lst_file) { @@ -628,7 +719,7 @@ cb_warning_x_internal (const enum cb_warn_opt opt, cb_tree x, const char *fmt, v } print_error (x->source_file, x->source_line, - pref == COBC_WARN_AS_ERROR ? _("error: ") : _("warning: "), + pref == COBC_WARN_AS_ERROR ? CB_KIND_ERROR : CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); if (sav_lst_file) { @@ -672,7 +763,7 @@ cb_warning_dialect_x (const enum cb_support tag, cb_tree x, const char *fmt, ... va_start (ap, fmt); print_error (x->source_file, x->source_line, - ret == COBC_WARN_AS_ERROR ? _("error: ") : _("warning: "), + ret == COBC_WARN_AS_ERROR ? CB_KIND_ERROR : CB_KIND_WARNING, fmt, ap, NULL); va_end (ap); @@ -725,10 +816,10 @@ cb_note_x (const enum cb_warn_opt opt, cb_tree x, const char *fmt, ...) listprint_suppress (); va_start (ap, fmt); if (opt != COB_WARNOPT_NONE) { - print_error (x->source_file, x->source_line, _("note: "), + print_error (x->source_file, x->source_line, CB_KIND_NOTE, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (x->source_file, x->source_line, _("note: "), + print_error (x->source_file, x->source_line, CB_KIND_NOTE, fmt, ap, NULL); } va_end (ap); @@ -752,10 +843,10 @@ cb_note (const enum cb_warn_opt opt, const int suppress_listing, const char *fmt } va_start (ap, fmt); if (opt != COB_WARNOPT_NONE) { - print_error (NULL, 0, _("note: "), + print_error (NULL, 0, CB_KIND_NOTE, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (NULL, 0, _("note: "), + print_error (NULL, 0, CB_KIND_NOTE, fmt, ap, NULL); } va_end (ap); @@ -776,13 +867,13 @@ cb_error_x_internal (cb_tree x, const char *fmt, va_list ap) } if (!ignore_error) { - print_error (x->source_file, x->source_line, _("error: "), + print_error (x->source_file, x->source_line, CB_KIND_ERROR, fmt, ap, NULL); } else if (pref == COBC_WARN_AS_ERROR) { - print_error (x->source_file, x->source_line, _("error: "), + print_error (x->source_file, x->source_line, CB_KIND_ERROR, fmt, ap, warning_option_text (opt, pref)); } else { - print_error (x->source_file, x->source_line, _("warning: "), + print_error (x->source_file, x->source_line, CB_KIND_WARNING, fmt, ap, warning_option_text (opt, pref)); ret = COBC_WARN_ENABLED; } diff --git a/cobc/flag.def b/cobc/flag.def index 80d96fe20..a98f48346 100644 --- a/cobc/flag.def +++ b/cobc/flag.def @@ -232,6 +232,12 @@ CB_FLAG (cb_listing_symbols, 1, "tsymbols", CB_FLAG (cb_listing_cmd, 1, "tcmd", _(" -ftcmd specify command line in listing")) -CB_FLAG_ON (cb_diagnostic_show_option, 1, "diagnostics-show-option", +CB_FLAG_ON (cb_diagnostics_show_option, 1, "diagnostics-show-option", _(" -fno-diagnostics-show-option\tsuppress output of option that directly\n" " controls the diagnostic")) + +CB_FLAG_ON (cb_diagnostics_show_caret, 1, "diagnostics-show-caret", + _(" -fno-diagnostics-show-caret\tdo not display source context on warning/error diagnostic")) + +CB_FLAG_ON (cb_diagnostics_show_line_numbers, 1, "diagnostics-show-line-numbers", + _(" -fno-diagnostics-show-line-numbers\tsuppress display of line numbers in diagnostics")) diff --git a/cobc/help.c b/cobc/help.c index 0cde1f29d..4f4dda32b 100644 --- a/cobc/help.c +++ b/cobc/help.c @@ -162,6 +162,7 @@ cobc_print_usage_warnings (void) #undef CB_ONWARNDEF #undef CB_NOWARNDEF #undef CB_ERRWARNDEF + puts (_(" -fdiagnostics-plain-output\tmake diagnostic output as plain as possible")); puts (_(" -Werror treat all warnings as errors")); puts (_(" -Wno-error don't treat warnings as errors")); puts (_(" -Werror= treat specified as error")); diff --git a/tests/atlocal.in b/tests/atlocal.in index 7213bf931..405c24a12 100644 --- a/tests/atlocal.in +++ b/tests/atlocal.in @@ -72,6 +72,7 @@ fi # FLAGS="-debug -Wall ${COBOL_FLAGS}" FLAGS="-debug -Wall ${COBOL_FLAGS} -fno-diagnostics-show-option" +COBC="${COBC} -fdiagnostics-plain-output" COMPILE="${COBC} -x ${FLAGS}" COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" COMPILE_MODULE="${COBC} -m ${FLAGS}" diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index a6d43eaba..df3c6c106 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -2143,8 +2143,8 @@ LINE PG/LN A...B............................................................ GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 command line: - cobc -q -std=default -Wall -fno-tmessages -fsyntax-only -t prog.lst -+ -fno-tsymbols -ftcmd prog.cob + cobc -fdiagnostics-plain-output -q -std=default -Wall -fno-tmessages ++ -fsyntax-only -t prog.lst -fno-tsymbols -ftcmd prog.cob ]) AT_CHECK([$UNIFY_LISTING prog.lst prog.lis], [0], [], []) diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 3d42db4b7..83fa09b07 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -918,3 +918,65 @@ AT_CHECK([cat prog.cob | $COMPILE_MODULE -j -], [0], [job], [], ) AT_CLEANUP + + +AT_SETUP([cobc diagnostics show caret]) +# promoted on 2023-06-01T09:57 +AT_KEYWORDS([cobc diagnostics]) +AT_DATA([prog.cob],[ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + COPY 'CRUD.CPY'. + PROCEDURE DIVISION. + DISPLAY TEST-VAR NO ADVANCING + END-DISPLAY + MOVE 12 TO TEST-VAR + DISPLAY TEST-VAR NO ADVANCING + END-DISPLAY + STOP RUN. +]) +AT_CHECK([$COBC -Wall -fsyntax-only prog.cob], [1], [], +[prog.cob:7: error: CRUD.CPY: No such file or directory +prog.cob:6: warning: numeric value is expected @<:@-Wothers@:>@ +]) +AT_CHECK([$COMPILE -fdiagnostics-show-caret -fdiagnostics-show-line-numbers -j prog.cob], [1], [], +[prog.cob:7: error: CRUD.CPY: No such file or directory + + 0005 WORKING-STORAGE SECTION. + 0006 01 TEST-VAR PIC 9(2) VALUE 'A'. + 0007 > COPY 'CRUD.CPY'. + 0008 PROCEDURE DIVISION. + 0009 DISPLAY TEST-VAR NO ADVANCING + +prog.cob:6: warning: numeric value is expected + + 0004 DATA DIVISION. + 0005 WORKING-STORAGE SECTION. + 0006 > 01 TEST-VAR PIC 9(2) VALUE 'A'. + 0007 COPY 'CRUD.CPY'. + 0008 PROCEDURE DIVISION. + +]) +AT_CHECK([$COMPILE -fdiagnostics-show-caret -j prog.cob],[1], [], +[prog.cob:7: error: CRUD.CPY: No such file or directory + + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + > COPY 'CRUD.CPY'. + PROCEDURE DIVISION. + DISPLAY TEST-VAR NO ADVANCING + +prog.cob:6: warning: numeric value is expected + + DATA DIVISION. + WORKING-STORAGE SECTION. + > 01 TEST-VAR PIC 9(2) VALUE 'A'. + COPY 'CRUD.CPY'. + PROCEDURE DIVISION. + +]) +AT_CLEANUP + From 32d52d0f34c5f67a1374a6e55ca7a42a2843d799 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 2 Jun 2023 20:40:36 +0000 Subject: [PATCH 2/7] minor cleanup libcob: * common.h (cob_file_org, cob_file_access_mode): changed defines to enums * fileio.c (cob_findkey_attr): * extracted identical logic from cob_findkey indexed_findkey and bdb_findkey * dropping the later two and set mapkey after calling it cobc: * tree.h (cb_file), parser.y: organization and access_mode as enums tests/cobol85/report.pl: place stderr from test runs into .out file --- cobc/ChangeLog | 41 ++++++++----- cobc/parser.y | 4 +- cobc/scanner.l | 6 +- cobc/tree.h | 4 +- libcob/common.h | 39 +++++++------ libcob/fileio.c | 126 ++++++++++------------------------------ tests/cobol85/ChangeLog | 4 ++ tests/cobol85/report.pl | 10 ++-- 8 files changed, 93 insertions(+), 141 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 16af69cba..069111957 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,16 +1,14 @@ -2023-02-16 Fabrice Le Fessant +2023-06-02 Simon Sobisch - * flag.def (cb_diagnostics_show_caret), error.c - (diagnostics_show_caret): add argument -fno-diagnostics-show-caret - to disable the display of the source context of the error/warning, - 2 lines before and after the location; add argument - -fno-diagnostics-show-line-numbers to disable printing of - line numbers in carets; rename cb_diagnostic_show_option into - cb_diagnostics_show_option to match the argument name. - * error.c (cb_error_kind): replace all occurrences of a - error/warning/note string by a symbolic enum. - * cobc.c: new argument -fdiagnostics-plain-output to make + * tree.h (cb_file), parser.y: organization and access_mode as enums + +2023-06-01 Fabrice Le Fessant + + * flag.def (cb_diagnostics_show_line_numbers), error.c + (diagnostics_show_caret): new flag -fno-diagnostics-show-line-numbers + to disable printing of line numbers in carets + * cobc.c: new option -fdiagnostics-plain-output to make output as plain as possible (disabling carets for example) 2023-05-31 Simon Sobisch @@ -241,6 +239,11 @@ of column 2 to fix terminal-format support and insert it before newlines are added to the beginning of the buffer +2023-02-21 Simon Sobisch + + * codegen.c, flag.def [COBC_HAS_CUTOFF_FLAG]: fix compile errors, + output -fif-cutoff to help when available + 2023-02-20 Nicolas Berthier * scanner.l, config.def: Add support for EBCDIC symbolic characters in @@ -249,11 +252,6 @@ * scanner.l, pplex.l: detect and issue a warning when EBCDIC symbolic character strings include extraneous separators -2023-02-21 Simon Sobisch - - * codegen.c, flag.def [COBC_HAS_CUTOFF_FLAG]: fix compile errors, - output -fif-cutoff to help when available - 2023-02-20 Fabrice Le Fessant * scanner.l (read_literal): refactor to use enum cb_literal_type @@ -261,6 +259,17 @@ * pplex.l: allow REPLACE between Gcos CONTROL DIVISION and the IDENTIFICATION DIVISION +2023-02-16 Fabrice Le Fessant + + * flag.def (cb_diagnostics_show_caret), error.c + (diagnostics_show_caret): new -fdiagnostics-show-caret (enabled by + default) to display source context of the error/warning, 2 lines + before and after the location + * error.c (cb_error_kind): replace all occurrences of a + error/warning/note string by a symbolic enum + * flag.def (cb_diagnostics_show_option), error.c: renamed from + cb_diagnostic_show_option to match the argument name + 2023-02-10 Simon Sobisch * cobc.c (clean_up_intermediates): fix missing move of temporary files diff --git a/cobc/parser.y b/cobc/parser.y index 416b38b44..b2348882d 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -1604,7 +1604,7 @@ setup_prototype (cb_tree prototype_name, cb_tree ext_name, } static void -error_if_record_delimiter_incompatible (const int organization, +error_if_record_delimiter_incompatible (const enum cob_file_org organization, const char *organization_name) { int is_compatible; @@ -18709,7 +18709,7 @@ _reference: single_reference_list: single_reference { $$ = CB_LIST_INIT ($1); } -| single_reference_list single_reference{ $$ = cb_list_add ($1, $2); } +| single_reference_list single_reference { $$ = cb_list_add ($1, $2); } ; single_reference: diff --git a/cobc/scanner.l b/cobc/scanner.l index 4010f33af..7b425d96b 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -370,7 +370,7 @@ AREA_A "#AREA_A"\n "FUNCTION" { if (cobc_in_repository || cobc_cs_check == CB_CS_EXIT) { yylval = NULL; - RETURN_TOK (FUNCTION); + RETURN_TOK (FUNCTION); } BEGIN FUNCTION_STATE; } @@ -936,8 +936,8 @@ H#[0-9A-Za-z]+ { /* FIXME: move the code for filling "name" here and first check with "lookup_system_name (name) != NULL" if we actually want to do this, - otherwise return 2 (!) WORD tokens (by adding a queue - of tokens to be returned) + otherwise return 2 (!) WORD tokens (by adding a queue + of tokens to be returned) */ if (cobc_in_procedure) { /* unput characters */ diff --git a/cobc/tree.h b/cobc/tree.h index 36f749de4..25917d2ff 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1130,8 +1130,8 @@ struct cb_file { int record_min; /* RECORD CONTAINS */ int record_max; /* RECORD CONTAINS */ int optional; /* OPTIONAL */ - int organization; /* ORGANIZATION - FIXME: use enum */ - int access_mode; /* ACCESS MODE - FIXME: use enum */ + enum cob_file_org organization; /* ORGANIZATION */ + enum cob_file_access_mode access_mode; /* ACCESS MODE */ int lock_mode; /* LOCK MODE */ int special; /* Special file */ int same_clause; /* SAME clause */ diff --git a/libcob/common.h b/libcob/common.h index 8fd422aca..6fcfdecb5 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -800,21 +800,24 @@ enum cob_exception_id { #define COB_FILE_MODE 0666 -/* Organization, FIXME: change to enum */ - -#define COB_ORG_SEQUENTIAL 0 -#define COB_ORG_LINE_SEQUENTIAL 1 -#define COB_ORG_RELATIVE 2 -#define COB_ORG_INDEXED 3 -#define COB_ORG_SORT 4 -#define COB_ORG_MAX 5 -#define COB_ORG_MESSAGE 6 /* only for syntax checks */ - -/* Access mode, FIXME: change to enum */ +/* file ORGANIZATION IS */ +enum cob_file_org { + COB_ORG_SEQUENTIAL = 0, + COB_ORG_LINE_SEQUENTIAL = 1, + COB_ORG_RELATIVE = 2, + COB_ORG_INDEXED = 3, + COB_ORG_SORT = 4, + COB_ORG_MAX = 5, + COB_ORG_MESSAGE = 6 /* only for syntax checks */ +}; -#define COB_ACCESS_SEQUENTIAL 1 -#define COB_ACCESS_DYNAMIC 2 -#define COB_ACCESS_RANDOM 3 +/* file ACCESS MODE IS */ +enum cob_file_access_mode { + COB_ACCESS_UNDEFINED = 0, + COB_ACCESS_SEQUENTIAL = 1, + COB_ACCESS_DYNAMIC = 2, + COB_ACCESS_RANDOM = 3 +}; /* SELECT features */ @@ -1358,12 +1361,12 @@ typedef struct __cob_file { size_t nkeys; /* Number of keys */ int fd; /* File descriptor */ - unsigned char organization; /* ORGANIZATION */ - unsigned char access_mode; /* ACCESS MODE */ + unsigned char organization; /* ORGANIZATION, read as cob_file_org */ + unsigned char access_mode; /* ACCESS MODE, read as cob_file_access_mode */ unsigned char lock_mode; /* LOCK MODE */ - unsigned char open_mode; /* OPEN MODE: GC4: cob_open_mode */ + unsigned char open_mode; /* OPEN MODE - GC4: cob_open_mode */ unsigned char flag_optional; /* OPTIONAL */ - unsigned char last_open_mode; /* Mode given by OPEN: GC4: cob_open_mode */ + unsigned char last_open_mode; /* Mode given by OPEN - GC4: cob_open_mode */ unsigned char flag_operation; /* File type specific */ unsigned char flag_nonexistent; /* Nonexistent file */ diff --git a/libcob/fileio.c b/libcob/fileio.c index 5700709a2..92c1b4bae 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -351,38 +351,41 @@ indexed_keycmp (struct keydesc *k1, struct keydesc *k2) return 0; } -/* Return index number for given key */ +#endif + +/* Return index number for given key and set length attributes */ static int -indexed_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) +cob_findkey_attr (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) { int k,part; *fullkeylen = *partlen = 0; + for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { - *fullkeylen = f->keys[k].field->size; + cob_field *key = f->keys[k].field; + if (key + && key->data == kf->data + && f->keys[k].count_components <= 1) { + *fullkeylen = key->size; *partlen = kf->size; - f->mapkey = k; return k; } } for (k = 0; k < f->nkeys; ++k) { if (f->keys[k].count_components > 1) { - if ((f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { + cob_field *key = f->keys[k].field; + if ((key + && key->data == kf->data + && key->size == kf->size) + || (f->keys[k].component[0]->data == kf->data)) { for (part=0; part < f->keys[k].count_components; part++) { *fullkeylen += f->keys[k].component[part]->size; } - if (f->keys[k].field - && f->keys[k].field->data == kf->data) { - *partlen = kf->size; + if (key + && key->data == kf->data) { + *partlen = key->size; } else { *partlen = *fullkeylen; } - f->mapkey = k; return k; } } @@ -390,8 +393,6 @@ indexed_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) return -1; } -#endif - /* Define some characters for checking LINE SEQUENTIAL data content */ #define COB_CHAR_CR '\r' #define COB_CHAR_FF '\f' @@ -715,43 +716,6 @@ struct indexed_file { DB_LOCK bdb_record_lock; }; -static int -bdb_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) -{ - int k, part; - - *fullkeylen = *partlen = 0; - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return k; - } - } - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].count_components > 1) { - if ( (f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { - for (part = 0; part < f->keys[k].count_components; part++) { - *fullkeylen += f->keys[k].component[part]->size; - } - if (f->keys[k].field - && f->keys[k].field->data == kf->data) { - *partlen = kf->size; - } else { - *partlen = *fullkeylen; - } - return (int)k; - } - } - } - return -1; -} - /* Return total length of the key */ static int bdb_keylen (cob_file *f, int idx) @@ -3864,9 +3828,8 @@ indexed_start_internal (cob_file *f, const int cond, cob_field *key, dupno = 0; ret = 0; /* Look up for the key */ - key_index = bdb_findkey (f, key, &fullkeylen, &partlen); + key_index = f->mapkey = cob_findkey_attr (f, key, &fullkeylen, &partlen); if (key_index < 0) { - f->mapkey = -1; return COB_STATUS_23_KEY_NOT_EXISTS; } p->key_index = key_index; @@ -4871,10 +4834,11 @@ indexed_start (cob_file *f, const int cond, cob_field *key) if (f->flag_nonexistent) { return COB_STATUS_23_KEY_NOT_EXISTS; } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { + k = cob_findkey_attr (f, key, &fullkeylen, &partlen); + if (k < 0) { return COB_STATUS_23_KEY_NOT_EXISTS; } + f->mapkey = k; /* Use size of data field; This may indicate a partial key */ klen = partlen; if (klen < 1 || klen > fullkeylen) { @@ -4981,10 +4945,11 @@ indexed_read (cob_file *f, cob_field *key, const int read_opts) if (f->flag_nonexistent) { return COB_STATUS_23_KEY_NOT_EXISTS; } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { + k = cob_findkey_attr (f, key, &fullkeylen, &partlen); + if (k < 0) { return COB_STATUS_23_KEY_NOT_EXISTS; } + f->mapkey = k; if (f->curkey != (int)k) { /* Switch to this index */ isstart (fh->isfd, &fh->key[k], 0, @@ -6960,46 +6925,18 @@ cob_delete_file (cob_file *f, cob_field *fnstatus) save_status (f, fnstatus, errno_cob_sts(COB_STATUS_00_SUCCESS)); } -/* Return index number for given key */ +/* Return index number for given key and set length attributes, + storing resulting key field in file's last_key */ int cob_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) { - int k,part; - *fullkeylen = *partlen = 0; - - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { + int k = cob_findkey_attr (f, kf, fullkeylen, partlen); #if 0 /* pending merge of r1411 */ - f->last_key = f->keys[k].field; -#endif - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return k; - } + if (k >= 0) { + f->last_key = f->keys[k].field; } - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].count_components > 1) { - if ((f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { -#if 0 /* pending merge of r1411 */ - f->last_key = f->keys[k].field; #endif - for (part=0; part < f->keys[k].count_components; part++) - *fullkeylen += f->keys[k].component[part]->size; - if (f->keys[k].field - && f->keys[k].field->data == kf->data) - *partlen = kf->size; - else - *partlen = *fullkeylen; - return k; - } - } - } - return -1; + return k; } /* Copy key data and return length of data copied */ @@ -8693,7 +8630,6 @@ cob_exit_fileio (void) void cob_init_fileio (cob_global *lptr, cob_settings *sptr) { - cobglobptr = lptr; cobsetptr = sptr; file_cache = NULL; diff --git a/tests/cobol85/ChangeLog b/tests/cobol85/ChangeLog index 88dd68b65..bb6d3f366 100644 --- a/tests/cobol85/ChangeLog +++ b/tests/cobol85/ChangeLog @@ -1,4 +1,8 @@ +2023-06-02 Simon Sobisch + + * report.pl: place stderr from test runs into .out file + 2023-04-07 Simon Sobisch * report.pl: check "cobc_flags" also for building lib; diff --git a/tests/cobol85/report.pl b/tests/cobol85/report.pl index a6f1ba43f..b0a48b696 100755 --- a/tests/cobol85/report.pl +++ b/tests/cobol85/report.pl @@ -41,7 +41,7 @@ my $compile_module; # change to 1 if executable doesn't work / cobcrun test should be done -my $force_cobcrun = 0; +my $force_cobcrun = 1; my $cobc = $ENV{"COBC"}; my $cobol_flags = $ENV{"COBOL_FLAGS"}; @@ -225,8 +225,8 @@ # the following failed in previous versions with --debug, # but don't do any more -# MOVE from PIC S9999 SEPARATE with "expected" value of SPACES to a target -# of X(5) - RECHECK: is a conversion and therefore check needed? +# this was a bad generation from PIC S9999 SEPARATE to +# a target of X(5) where no conversion is needed $cobc_flags{DB201A} = "-fno-ec=data-incompatible"; # 2.2 generated DEBUG-LINE as numeric - but it always was X(6) @@ -434,12 +434,12 @@ sub run_test { testrepeat: if (!$to_kill{$exe}) { - $ret = system ("$TRAP $cmd > $exe.out"); + $ret = system ("$TRAP $cmd > $exe.out 2>&1"); } else { $ret = system ("$TRAP $cmd > $exe.out 2>/dev/null"); } - # extra check for both SIGINT as masked signal and as plain return, because + # extra check for SIGINT both as masked signal and as plain return, because # AIX (at least 7.1 with GCC 4.2 and system libc) directly returns 2 if ($ret != 0 && !($to_kill{$exe} && ($ret >> 2 || $ret == 2))) { if (($ret >> 8) == 77) { From b0ec6e6f2fbd91f65c374df595dc7911f2545c8f Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 2 Jun 2023 20:44:01 +0000 Subject: [PATCH 3/7] minor cleanup libcob: * common.h (cob_file_org, cob_file_access_mode): changed defines to enums * fileio.c (cob_findkey_attr): * extracted identical logic from cob_findkey indexed_findkey and bdb_findkey * dropping the later two and set mapkey after calling it cobc: * tree.h (cb_file), parser.y: organization and access_mode as enums tests/cobol85/report.pl: place stderr from test runs into .out file --- tests/cobol85/report.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/cobol85/report.pl b/tests/cobol85/report.pl index b0a48b696..9989fe8e3 100755 --- a/tests/cobol85/report.pl +++ b/tests/cobol85/report.pl @@ -41,7 +41,7 @@ my $compile_module; # change to 1 if executable doesn't work / cobcrun test should be done -my $force_cobcrun = 1; +my $force_cobcrun = 0; my $cobc = $ENV{"COBC"}; my $cobol_flags = $ENV{"COBOL_FLAGS"}; From 507c36bca20fcda235f01a02d9ce6e622ff55dc5 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 2 Jun 2023 21:34:09 +0000 Subject: [PATCH 4/7] SORT/MERGE adjustment cobc: * typeck.c (cb_emit_sort_init, cb_emit_sort_using, cb_emit_sort_giving), parser.y: extended syntax checks, distinguish MERGE Sand ORT within diagnostics * parser.y, typeck.c (cb_emit_sort_init): move all syntax checks from code-emitter to parser * tree.h (cb_statement), parser.y, typeck.c: drop flag_merge, instead check by "statement == STMT_MERGE" * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options * parser.y (alphabet_name): add NATIVE (CB_COLSEQ_NATIVE), change STANDARD_1 from CB_COLSEQ_NATIVE to CB_COLSEQ_ASCII libcob: * fileio.c (cob_file_sort_using, cob_file_sort_giving): raise COB_EC_SORT_MERGE_FILE_OPEN when applicable * fileio.c (cob_copy_check, cob_file_sort_submit, cob_file_sort_retrieve): pass most matching argument type instead of the structures containing it * fileio.c (cobsort): new attribute flag_merge * fileio.c (cob_file_sort_options), common.h: new function to pass more options, so far only used to set flag_merge --- cobc/ChangeLog | 10 +++ cobc/codegen.c | 11 +-- cobc/parser.y | 42 +++++++---- cobc/tree.h | 1 - cobc/typeck.c | 68 ++++++++++-------- libcob/ChangeLog | 14 ++++ libcob/common.h | 18 +++-- libcob/fileio.c | 122 +++++++++++++++++++------------- tests/testsuite.src/run_file.at | 18 +++-- tests/testsuite.src/syn_misc.at | 8 +-- 10 files changed, 200 insertions(+), 112 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 069111957..1009e2005 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -2,6 +2,14 @@ 2023-06-02 Simon Sobisch * tree.h (cb_file), parser.y: organization and access_mode as enums + * typeck.c (cb_emit_sort_init, cb_emit_sort_using, cb_emit_sort_giving), + parser.y: extended syntax checks, distinguish MERGE and SORT within + diagnostics + * parser.y, typeck.c (cb_emit_sort_init): move all syntax checks from + code-emitter to parser + * tree.h (cb_statement), parser.y, typeck.c: drop flag_merge, + instead check by "statement == STMT_MERGE" + * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options 2023-06-01 Fabrice Le Fessant @@ -15,6 +23,8 @@ * codegen.c (output_init_comment_and_source_ref) [NO_INIT_SOURCE_LOC]: option to skip generating the source location in DATA DIVISION + * parser.y (alphabet_name): add NATIVE (CB_COLSEQ_NATIVE), + change STANDARD_1 from CB_COLSEQ_NATIVE to CB_COLSEQ_ASCII 2023-05-30 Simon Sobisch diff --git a/cobc/codegen.c b/cobc/codegen.c index 8d89b298f..d7bf5f6e3 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2273,7 +2273,7 @@ output_emit_field (cb_tree x, const char *cmt) } else { output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); output_field (x); - output_local(";\t/* "); + output_local (";\t/* "); if (f->report_column > 0) { output_local ("col%3d ", f->report_column); } @@ -7839,8 +7839,9 @@ output_if (const struct cb_if *ip) if (ip->test == cb_true && cb_flag_remove_unreachable) { output_line ("/* WHEN is always TRUE */"); - } else if (ip->test == cb_false - && cb_flag_remove_unreachable) { + } else + if (ip->test == cb_false + && cb_flag_remove_unreachable) { output_line ("/* WHEN is always FALSE */"); } else if (CB_TREE_TAG (ip->test) == CB_TAG_BINARY_OP) { @@ -7867,7 +7868,8 @@ output_if (const struct cb_if *ip) } else { output_line ("/* WHEN */"); } - } else if (ip->test->source_line) { + } else + if (ip->test->source_line) { output_source_reference (ip->test, STMT_WHEN); } else { output_line ("/* WHEN */"); @@ -9281,6 +9283,7 @@ output_file_initialization (struct cb_file *f) } } + /* TODO: generate enum values and flags as text */ output_line ("%s%s->organization = %d;", CB_PREFIX_FILE, f->cname, f->organization); output_line ("%s%s->access_mode = %d;", CB_PREFIX_FILE, f->cname, diff --git a/cobc/parser.y b/cobc/parser.y index b2348882d..562e36c9b 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -697,7 +697,7 @@ setup_use_file (struct cb_file *fileptr) struct cb_file *newptr; if (fileptr->organization == COB_ORG_SORT) { - cb_error (_("USE statement invalid for SORT file")); + cb_error (_("USE statement invalid for SD file")); } if (fileptr->flag_global) { newptr = cobc_parse_malloc (sizeof(struct cb_file)); @@ -5768,11 +5768,15 @@ alphabet_name: $$ = cb_error_node; } } -| STANDARD_1 +| NATIVE { $$ = build_colseq (CB_COLSEQ_NATIVE); } -| STANDARD_2 +| STANDARD_1 /* CHECKME: shouldn't that be 7-bit? */ + { + $$ = build_colseq (CB_COLSEQ_ASCII); + } +| STANDARD_2 /* CHECKME: shouldn't that be 7-bit? */ { $$ = build_colseq (CB_COLSEQ_ASCII); } @@ -15097,9 +15101,8 @@ merge_statement: MERGE { begin_statement (STMT_MERGE, 0); - current_statement->flag_merge = 1; } - sort_body + sort_merge_body ; @@ -16300,10 +16303,10 @@ sort_statement: { begin_statement (STMT_SORT, 0); } - sort_body + sort_merge_body ; -sort_body: +sort_merge_body: table_identifier /* may reference a file or a table */ _sort_key_list _sort_duplicates _sort_collating { @@ -16312,8 +16315,12 @@ sort_body: $$ = NULL; if (CB_VALID_TREE (x)) { if ($2 == NULL || CB_VALUE ($2) == NULL) { + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires KEY phrase")); + $2 = cb_error_node; + } else if (CB_FILE_P (x)) { - cb_error (_("file sort requires KEY phrase")); + cb_error (_("file SORT requires KEY phrase")); $2 = cb_error_node; } else { struct cb_field *f = CB_FIELD_PTR (x); @@ -16341,6 +16348,9 @@ sort_body: $2 = cb_error_node; } } + } else if (CB_FILE_P (x) && CB_FILE (x)->organization != COB_ORG_SORT) { + cb_error_x (x, _("must be an SD filename")); + $2 = cb_error_node; } if (CB_VALID_TREE ($2)) { cb_emit_sort_init ($1, $2, alphanumeric_collation, national_collation); @@ -16399,7 +16409,11 @@ sort_input: /* empty */ { if ($0 && CB_FILE_P (cb_ref ($0))) { - cb_error (_("file sort requires USING or INPUT PROCEDURE")); + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires USING files")); + } else { + cb_error (_("file SORT requires USING or INPUT PROCEDURE")); + } } } | USING file_name_list @@ -16417,7 +16431,7 @@ sort_input: if ($0) { if (!CB_FILE_P (cb_ref ($0))) { cb_error (_("INPUT PROCEDURE invalid with table SORT")); - } else if (current_statement->flag_merge) { + } else if (current_statement->statement == STMT_MERGE) { cb_error (_("INPUT PROCEDURE invalid with MERGE")); } else { cb_emit_sort_input ($4); @@ -16431,7 +16445,11 @@ sort_output: /* empty */ { if ($-1 && CB_FILE_P (cb_ref ($-1))) { - cb_error (_("file sort requires GIVING or OUTPUT PROCEDURE")); + if (current_statement->statement == STMT_MERGE) { + cb_error (_("MERGE requires GIVING or OUTPUT PROCEDURE")); + } else { + cb_error (_("file SORT requires GIVING or OUTPUT PROCEDURE")); + } } } | GIVING file_name_list @@ -16847,7 +16865,7 @@ unlock_body: if (CB_VALID_TREE ($1)) { if (CB_FILE (cb_ref ($1))->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), - _("UNLOCK invalid for SORT files")); + _("UNLOCK invalid for SD files")); } else { cb_emit_unlock ($1); } diff --git a/cobc/tree.h b/cobc/tree.h index 25917d2ff..df31751a5 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1519,7 +1519,6 @@ struct cb_statement { enum cb_handler_type handler_type; /* Handler type */ unsigned int flag_no_based : 1; /* Check BASED */ unsigned int flag_in_debug : 1; /* In DEBUGGING */ - unsigned int flag_merge : 1; /* Is MERGE */ unsigned int flag_callback : 1; /* DEBUG Callback */ unsigned int flag_implicit : 1; /* Is an implicit statement */ }; diff --git a/cobc/typeck.c b/cobc/typeck.c index f05823821..331c583af 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -13570,7 +13570,7 @@ cb_emit_set_last_exception_to_off (void) cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception", cb_int0)); } -/* SORT statement */ +/* SORT + MERGE statements */ void cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) @@ -13592,7 +13592,7 @@ cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) } /* note: the reference to the program's collation, - if not explicit specified in SORT is done within libcob */ + if not explicit specified in SORT/MERGE, is done within libcob */ if (col == NULL) { col = cb_null; } else { @@ -13607,28 +13607,30 @@ cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) COB_UNUSED (nat_col); if (CB_FILE_P (rtree)) { - if (CB_FILE (rtree)->organization != COB_ORG_SORT) { - cb_error_x (name, _("invalid SORT filename")); - } + cb_tree sort_return; + const struct cb_file *sd_file = CB_FILE (rtree); if (current_program->cb_sort_return) { CB_FIELD_PTR (current_program->cb_sort_return)->count++; - cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, - cb_int ((int)cb_list_length (keys)), col, - CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return), - CB_FILE(rtree)->file_status)); + sort_return = CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return); } else { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, - cb_int ((int)cb_list_length (keys)), col, - cb_null, CB_FILE(rtree)->file_status)); - + sort_return = cb_null; + } + cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, + cb_int ((int)cb_list_length (keys)), col, + sort_return, sd_file->file_status)); + if (current_statement->statement == STMT_MERGE) { + /* note: this function can be used later to set more options */ + cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_options", rtree, + cb_build_string (cobc_parse_strdup ("M"), 1))); } /* TODO: pass key-specific collation to libcob */ for (l = keys; l; l = CB_CHAIN (l)) { + cb_tree fref = CB_VALUE (l); cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key", rtree, - CB_VALUE (l), + fref, CB_PURPOSE (l), - cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset))); + cb_int (CB_FIELD_PTR (fref)->offset))); } } else { struct cb_field * const fr = CB_FIELD (rtree); @@ -13667,13 +13669,16 @@ cb_emit_sort_using (cb_tree file, cb_tree l) } /* LCOV_EXCL_STOP */ for (; l; l = CB_CHAIN (l)) { - cb_tree use_file = cb_ref (CB_VALUE (l)); - if (CB_FILE (use_file)->organization == COB_ORG_SORT) { + cb_tree use_ref = cb_ref (CB_VALUE (l)); + const struct cb_file *use_file = CB_FILE (use_ref); + if (use_file->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), - _("invalid SORT USING parameter")); + _("invalid %s parameter"), + current_statement->statement == STMT_MERGE ? + "MERGE USING" : "SORT USING"); } cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", - rtree, use_file)); + rtree, use_ref)); } } @@ -13688,40 +13693,43 @@ cb_emit_sort_input (cb_tree proc) } void -cb_emit_sort_giving (cb_tree file, cb_tree l) +cb_emit_sort_giving (cb_tree sd_file, cb_tree l) { cb_tree p; - int listlen; if (cb_validate_list (l)) { return; } for (p = l; p; p = CB_CHAIN (p)) { - if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) { + /* TODO: let parser create a list of files, not their references */ + const struct cb_file *giving_file = CB_FILE (cb_ref (CB_VALUE (p))); + if (giving_file->organization == COB_ORG_SORT) { cb_error_x (CB_TREE (current_statement), - _("invalid SORT GIVING parameter")); + _("invalid %s parameter"), + current_statement->statement == STMT_MERGE ? + "MERGE GIVING" : "SORT GIVING"); + } } - p = cb_ref (file); + p = cb_ref (sd_file); /* LCOV_EXCL_START */ if (p == cb_error_node) { cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_sort_giving", "file"); + "cb_emit_sort_giving", "sd_file"); COBC_ABORT (); } /* LCOV_EXCL_STOP */ - listlen = cb_list_length (l); p = CB_BUILD_FUNCALL_2 ("cob_file_sort_giving", p, l); - CB_FUNCALL(p)->varcnt = listlen; + CB_FUNCALL(p)->varcnt = cb_list_length (l); cb_emit (p); } void cb_emit_sort_output (cb_tree proc) { - if (current_program->flag_debugging && - !current_statement->flag_in_debug) { - if (current_statement->flag_merge) { + if (current_program->flag_debugging + && !current_statement->flag_in_debug) { + if (current_statement->statement == STMT_MERGE) { cb_emit (cb_build_debug (cb_debug_contents, "MERGE OUTPUT", NULL)); } else { diff --git a/libcob/ChangeLog b/libcob/ChangeLog index fd9e693a5..7ae68cbbe 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,18 @@ +2023-06-02 Simon Sobisch + + * common.h (cob_file_org, cob_file_access_mode): changed defines to enums + * fileio.c (cob_findkey_attr): extracted identical logic from cob_findkey, + indexed_findkey and bdb_findkey; + dropping the later two and set mapkey after calling it + * fileio.c (cob_file_sort_using, cob_file_sort_giving): raise + COB_EC_SORT_MERGE_FILE_OPEN when applicable + * fileio.c (cob_copy_check, cob_file_sort_submit, cob_file_sort_retrieve): + pass most matching argument type instead of the structures containing it + * fileio.c (cobsort): new attribute flag_merge + * fileio.c (cob_file_sort_options), common.h: new function to pass more + options, so far only used to set flag_merge + 2023-06-01 Simon Sobisch * fileio.c: minor refactoring for SORT related functions, diff --git a/libcob/common.h b/libcob/common.h index 6fcfdecb5..4836f8a77 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1332,6 +1332,9 @@ typedef struct __cob_file_key { unsigned int offset; /* Offset of field */ int count_components; /* 0..1::simple-key 2..n::split-key */ cob_field *component[COB_MAX_KEYCOMP]; /* key-components iff split-key */ +#if 0 /* TODO (for file keys, not for SORT/MERGE) */ + const unsigned char *collating_sequence; /* COLLATING */ +#endif } cob_file_key; @@ -2454,12 +2457,14 @@ typedef struct __fcd2 { #define OP_FLUSH 0x000C #define OP_UNLOCK_REC 0x000F -#define OP_CLOSE 0xFA80 /* OP CODES */ -#define OP_CLOSE_LOCK 0xFA81 -#define OP_CLOSE_NO_REWIND 0xFA82 -#define OP_CLOSE_REEL 0xFA84 -#define OP_CLOSE_REMOVE 0xFA85 -#define OP_CLOSE_NOREWIND 0xFA86 +/* standard OP CODES */ + +#define OP_CLOSE 0xFA80 /* CLOSE */ +#define OP_CLOSE_LOCK 0xFA81 /* CLOSE WITH LOCK */ +#define OP_CLOSE_NO_REWIND 0xFA82 /* CLOSE WITH NO REWIND */ +#define OP_CLOSE_REEL 0xFA84 /* CLOSE REEL/UNIT */ +#define OP_CLOSE_REMOVE 0xFA85 /* CLOSE REEL/UNIT FOR REMOVAL */ +#define OP_CLOSE_NOREWIND 0xFA86 /* CLOSE REEL/UNIT WITH NO REWIND */ #define OP_OPEN_INPUT 0xFA00 #define OP_OPEN_OUTPUT 0xFA01 @@ -2618,6 +2623,7 @@ COB_EXPIMP int cob_sys_file_delete (unsigned char *, unsigned char *); COB_EXPIMP void cob_file_sort_init (cob_file *, const unsigned int, const unsigned char *, void *, cob_field *); +COB_EXPIMP void cob_file_sort_options (cob_file *, const char *, ...); COB_EXPIMP void cob_file_sort_init_key (cob_file *, cob_field *, const int, const unsigned int); COB_EXPIMP void cob_file_sort_close (cob_file *); diff --git a/libcob/fileio.c b/libcob/fileio.c index 92c1b4bae..0bc20791e 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -481,6 +481,7 @@ struct cobsort { int retrieval_queue; struct queue_struct queue[4]; struct file_struct file[4]; + int flag_merge; }; /* End SORT definitions */ @@ -7981,12 +7982,12 @@ cob_write_block (struct cobsort *hp, const int n) } static void -cob_copy_check (cob_file *to, cob_file *from) +cob_copy_check (cob_field *to_record, cob_field *from_record) { - unsigned char *toptr = to->record->data; - unsigned char *fromptr = from->record->data; - const size_t tosize = to->record->size; - const size_t fromsize = from->record->size; + unsigned char *toptr = to_record->data; + unsigned char *fromptr = from_record->data; + const size_t tosize = to_record->size; + const size_t fromsize = from_record->size; if (unlikely (tosize > fromsize)) { memcpy (toptr, fromptr, fromsize); @@ -8112,17 +8113,19 @@ cob_file_sort_process (struct cobsort *hp) return 0; } +/* SORT/MERGE: insert record 'p' into the sort 'hp' */ static int -cob_file_sort_submit (cob_file *f, const unsigned char *p) +cob_file_sort_submit (struct cobsort *hp, const unsigned char *p) { - struct cobsort *hp = f->file; struct cobitem *q; struct queue_struct *z; int n; +#if 0 /* can't happen */ if (unlikely (!hp)) { return COBSORTNOTOPEN; } +#endif if (unlikely (hp->retrieving)) { return COBSORTABORT; } @@ -8170,15 +8173,17 @@ cob_file_sort_submit (cob_file *f, const unsigned char *p) return 0; } +/* SORT/MERGE: retrieve next record to be output for sort 'hp' into 'p' */ static int -cob_file_sort_retrieve (cob_file *f, unsigned char *p) +cob_file_sort_retrieve (struct cobsort *hp, unsigned char *p) { - struct cobsort *hp = f->file; int res; +#if 0 /* can't happen */ if (unlikely (!hp)) { return COBSORTNOTOPEN; } +#endif if (unlikely (!hp->retrieving)) { res = cob_file_sort_process (hp); if (res) { @@ -8222,7 +8227,7 @@ cob_file_sort_retrieve (cob_file *f, unsigned char *p) return 0; } -/* SORT: initial setup with adding sort definitions to sort file 'f' */ +/* SORT/MERGE: initial setup with adding sort definitions to sort file 'f' */ void cob_file_sort_init (cob_file *f, const unsigned int nkeys, const unsigned char *collating_sequence, @@ -8270,7 +8275,21 @@ cob_file_sort_init (cob_file *f, const unsigned int nkeys, save_status (f, fnstatus, COB_STATUS_00_SUCCESS); } -/* SORT: add key definition to internal sort file 'f' */ +/* SORT/MERGE: additional options for sort file 'f' - so far only note "we're in MERGE" */ +void +cob_file_sort_options (cob_file *f, const char *parms, ...) +{ + struct cobsort *hp = f->file; + + /* note: varargs are currently not used, if more information is added + handle as in cob_accept_field */ + hp->flag_merge = (parms[0] == 'M'); + + /* FIXME: MERGE should expect to have an ordered file (performance) and also test for + that / raise COB_EC_SORT_MERGE_SEQUENCE */ +} + +/* SORT/MERGE: add key definition to internal sort file 'f' */ void cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, const unsigned int offset) @@ -8281,17 +8300,20 @@ cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, f->nkeys++; } -/* SORT: add all records from GIVING file 'data_file' to 'sort_file' */ +/* SORT/MERGE: add all records from GIVING file 'data_file' to 'sort_file' */ void cob_file_sort_using (cob_file *sort_file, cob_file *data_file) { /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; - with ISO COBOL2023 this could also mean a local PERFORM WITH EXCEPTION HANDLING; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ + struct cobsort *hp = sort_file->file; int ret; cob_open (data_file, COB_OPEN_INPUT, 0, NULL); if (data_file->file_status[0] != '0') { + if (data_file->file_status[0] == '4') { + cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN); + } return; } for (;;) { @@ -8299,8 +8321,8 @@ cob_file_sort_using (cob_file *sort_file, cob_file *data_file) if (data_file->file_status[0] != '0') { break; } - cob_copy_check (sort_file, data_file); - ret = cob_file_sort_submit (sort_file, sort_file->record->data); + cob_copy_check (sort_file->record, data_file->record); + ret = cob_file_sort_submit (hp, sort_file->record->data); if (ret) { break; } @@ -8313,7 +8335,6 @@ void cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) { /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; - with ISO COBOL2023 this could also mean a local PERFORM WITH EXCEPTION HANDLING; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ struct cobsort *hp = sort_file->file; @@ -8338,6 +8359,9 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) opt[i] = 0; } } else { + if (using_file->file_status[0] == '4') { + cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN); + } opt[i] = -1; } } @@ -8346,7 +8370,7 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) /* retrieve all records, WRITE each to every GIVING file */ for (;;) { /* retrieve next record to write, stop AT END / error */ - ret = cob_file_sort_retrieve (sort_file, sort_file->record->data); + ret = cob_file_sort_retrieve (hp, sort_file->record->data); if (ret) { if (ret == COBSORTEND) { sort_file->file_status[0] = '1'; @@ -8354,6 +8378,8 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) } else { if (hp->sort_return) { *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ } sort_file->file_status[0] = '3'; sort_file->file_status[1] = '0'; @@ -8369,7 +8395,7 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) continue; } using_file->record->size = using_file->record_max; - cob_copy_check (using_file, sort_file); + cob_copy_check (using_file->record, sort_file->record); cob_write (using_file, using_file->record, opt[i], NULL, 0); /* stop writing to this file if we got a permanent write error; note: other files are still written to; therefore @@ -8440,50 +8466,50 @@ void cob_file_release (cob_file *f) { struct cobsort *hp = f->file; - cob_field *fnstatus; - int ret; if (likely(hp)) { - fnstatus = hp->fnstatus; + cob_field *fnstatus = hp->fnstatus; + const int ret = cob_file_sort_submit (hp, f->record->data); + if (!ret) { + save_status (f, fnstatus, COB_STATUS_00_SUCCESS); + return; + } + if (hp->sort_return) { + *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ + } + save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } else { - fnstatus = NULL; + save_status (f, NULL, COB_STATUS_30_PERMANENT_ERROR); } - ret = cob_file_sort_submit (f, f->record->data); - if (!ret) { - save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; - } - save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } void cob_file_return (cob_file *f) { struct cobsort *hp = f->file; - cob_field *fnstatus; - int ret; if (likely(hp)) { - fnstatus = hp->fnstatus; + cob_field *fnstatus = hp->fnstatus; + const int ret = cob_file_sort_retrieve (hp, f->record->data); + switch (ret) { + case 0: + save_status (f, fnstatus, COB_STATUS_00_SUCCESS); + return; + case COBSORTEND: + save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); + return; + } + if (hp->sort_return) { + *(int *)(hp->sort_return) = 16; + } else { + /* IBM doc: if not used then a runtime message is displayed */ + } + save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } else { - fnstatus = NULL; - } - ret = cob_file_sort_retrieve (f, f->record->data); - switch (ret) { - case 0: - save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - case COBSORTEND: - save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; + save_status (f, NULL, COB_STATUS_30_PERMANENT_ERROR); } - save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); } char * diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 3eea5ef70..d5b4549bc 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -9522,6 +9522,10 @@ kdblen: 0398 AT_CLEANUP +# TODO: add missing test for CLOSE options (most important: REEL) +# which are missing both for "normal" io and for EXTFH tests + + AT_SETUP([EXTFH: changing record address]) AT_KEYWORDS([runfile EXTFH]) @@ -12627,7 +12631,7 @@ AT_CLEANUP AT_SETUP([File SORT, SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) # Note: We shouldn't use AT_DATA to create sequential record # data, because AT_DATA needs a \n at the end @@ -12677,7 +12681,7 @@ AT_CLEANUP AT_SETUP([File SORT, SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -12763,7 +12767,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) # Note: We shouldn't use AT_DATA to create sequential record # data, because AT_DATA needs a \n at the end @@ -12822,7 +12826,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL same file]) -AT_KEYWORDS([runfile using giving]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([test.txt], [ bla @@ -12869,7 +12873,7 @@ AT_CLEANUP AT_SETUP([File SORT, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) +AT_KEYWORDS([runfile SORT USING GIVING]) AT_DATA([file1], [A1XXXX @@ -12907,7 +12911,7 @@ AT_DATA([prog.cob], [ 2 file3-key2 pic 9. 2 filler pic x(10). PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 + SORT file3 ON ASCENDING file3-key1 DESCENDING file3-key2 USING file1 GIVING file2. @@ -12933,7 +12937,7 @@ AT_CLEANUP AT_SETUP([File MERGE, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) +AT_KEYWORDS([runfile MERGE USING GIVING]) AT_DATA([file1], [A1XXXX diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 79c481728..ca0e6ac41 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -6530,10 +6530,10 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:32: error: table SORT requires KEY phrase -prog.cob:35: error: file sort requires USING or INPUT PROCEDURE -prog.cob:35: error: file sort requires GIVING or OUTPUT PROCEDURE -prog.cob:37: error: file sort requires KEY phrase -prog.cob:38: error: file sort requires KEY phrase +prog.cob:35: error: file SORT requires USING or INPUT PROCEDURE +prog.cob:35: error: file SORT requires GIVING or OUTPUT PROCEDURE +prog.cob:37: error: file SORT requires KEY phrase +prog.cob:38: error: file SORT requires KEY phrase ]) AT_CLEANUP From f197b9fb74411154da15f590f2cdf65544a34861 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 2 Jun 2023 22:33:12 +0000 Subject: [PATCH 5/7] EXTFH bugfixes and support for callfh with SORT libcob: * fileio.c (cob_file_sort_using_extfh, cob_file_sort_giving_extfh), common.h: new functions, calling EXTFH function if passed to read/write the data * fileio.c (update_fcd_to_file): set exception for non-digit returns, handle EOP flag (only usable if the internal EXTFH function was used) * fileio.c (cob_extfh_close): handle close options, most important: CLOSE REEL (as that does not actually close the file) * fileio.c (EXTFH3): handle OP_CLOSE_REEL as separate call to leave the file open * fileio.c (EXTFH3): handle "read direct" op codes, for now as "read random" * fileio.c (EXTFH3): setup intermediate record only where used: WRITE/REWRITE * fileio.c (update_key_from_fcd): extracted from EXTFH3 * fileio.c (update_key_from_fcd): only handle (logical) key field; split keys are all handled in io functions and otherwise not found there * fileio.c (find_fcd, cob_extfh_close): specify free handling via parameter, new option "-1" is used if FCD was created by ADDRESS OF FH--FCD/FH--KEYDEF, otherwise it is lost on first CLOSE * fileio.c: disable setting of record min/max size outside of OPEN, disable setting of record size in some places cobc: * typeck.c (cb_emit_sort_using, cb_emit_sort_giving): check if GIVING/USING files have an active EXTFH handler and generate calls to sort functions cob_file_sort_using_extfh / cob_file_sort_giving_extfh for those * parser.y (_close_option): parse UNIT/REEL WITH NO REWIND, currently handled as if only UNIT/REEL would have been specified tests/testsuite.src/run_file.at: test some "normal" programs with wrapping the io to EXTFH calls and to verify that those don't trash the FH--FCD/FH--KEYDEF allocated memory - new expected failure: LINAGE (it is unclear how to handle that via FCD3/EXTFH) --- cobc/ChangeLog | 10 +- cobc/parser.y | 5 +- cobc/typeck.c | 23 +- libcob/ChangeLog | 25 +- libcob/common.h | 3 + libcob/fileio.c | 398 +++++++++++++++----- tests/testsuite.src/run_file.at | 647 +++++++++++++++++++++++++------- 7 files changed, 876 insertions(+), 235 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 1009e2005..e0690fd37 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -9,7 +9,8 @@ code-emitter to parser * tree.h (cb_statement), parser.y, typeck.c: drop flag_merge, instead check by "statement == STMT_MERGE" - * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options + * parser.y (_close_option): parse UNIT/REEL WITH NO REWIND, + currently handled as if only UNIT/REEL would have been specified 2023-06-01 Fabrice Le Fessant @@ -19,6 +20,13 @@ * cobc.c: new option -fdiagnostics-plain-output to make output as plain as possible (disabling carets for example) +2023-06-01 Simon Sobisch + + * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options + * typeck.c (cb_emit_sort_using, cb_emit_sort_giving): check if GIVING/USING + files have an active EXTFH handler and generate calls to sort functions + cob_file_sort_using_extfh / cob_file_sort_giving_extfh for those + 2023-05-31 Simon Sobisch * codegen.c (output_init_comment_and_source_ref) [NO_INIT_SOURCE_LOC]: diff --git a/cobc/parser.y b/cobc/parser.y index 562e36c9b..3e440a6e5 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -12858,10 +12858,11 @@ close_files: _close_option: /* empty */ { $$ = cb_int (COB_CLOSE_NORMAL); } -| reel_or_unit { $$ = cb_int (COB_CLOSE_UNIT); } -| reel_or_unit _for REMOVAL { $$ = cb_int (COB_CLOSE_UNIT_REMOVAL); } | _with NO REWIND { $$ = cb_int (COB_CLOSE_NO_REWIND); } | _with LOCK { $$ = cb_int (COB_CLOSE_LOCK); } +| reel_or_unit { $$ = cb_int (COB_CLOSE_UNIT); } +| reel_or_unit _for REMOVAL { $$ = cb_int (COB_CLOSE_UNIT_REMOVAL); } +| reel_or_unit _with NO REWIND { $$ = cb_int (COB_CLOSE_UNIT); } /* PENDING */ ; close_window: diff --git a/cobc/typeck.c b/cobc/typeck.c index 331c583af..f9d465fba 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -13677,8 +13677,13 @@ cb_emit_sort_using (cb_tree file, cb_tree l) current_statement->statement == STMT_MERGE ? "MERGE USING" : "SORT USING"); } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", - rtree, use_ref)); + if (use_file->extfh) { + cb_emit (CB_BUILD_FUNCALL_3 ("cob_file_sort_using_extfh", + rtree, use_ref, use_file->extfh)); + } else { + cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", + rtree, use_ref)); + } } } @@ -13696,6 +13701,9 @@ void cb_emit_sort_giving (cb_tree sd_file, cb_tree l) { cb_tree p; + cb_tree extfh_list = NULL; + int has_extfh = 0; + const char *file_sort_giving_func; if (cb_validate_list (l)) { return; @@ -13710,6 +13718,9 @@ cb_emit_sort_giving (cb_tree sd_file, cb_tree l) "MERGE GIVING" : "SORT GIVING"); } + extfh_list = cb_list_add (extfh_list, CB_TREE (giving_file)); + cb_list_add (extfh_list, giving_file->extfh); + has_extfh += (giving_file->extfh != NULL); } p = cb_ref (sd_file); /* LCOV_EXCL_START */ @@ -13719,7 +13730,13 @@ cb_emit_sort_giving (cb_tree sd_file, cb_tree l) COBC_ABORT (); } /* LCOV_EXCL_STOP */ - p = CB_BUILD_FUNCALL_2 ("cob_file_sort_giving", p, l); + if (has_extfh) { + file_sort_giving_func = "cob_file_sort_giving_extfh"; + l = extfh_list; + } else { + file_sort_giving_func = "cob_file_sort_giving"; + } + p = CB_BUILD_FUNCALL_2 (file_sort_giving_func, p, l); CB_FUNCALL(p)->varcnt = cb_list_length (l); cb_emit (p); } diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 7ae68cbbe..0a8369ec7 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -9,9 +9,25 @@ COB_EC_SORT_MERGE_FILE_OPEN when applicable * fileio.c (cob_copy_check, cob_file_sort_submit, cob_file_sort_retrieve): pass most matching argument type instead of the structures containing it - * fileio.c (cobsort): new attribute flag_merge - * fileio.c (cob_file_sort_options), common.h: new function to pass more - options, so far only used to set flag_merge + * fileio.c (cob_file_sort_using_extfh, cob_file_sort_giving_extfh), + common.h: new functions, using EXTFH functions to read/write the data + * fileio.c (update_fcd_to_file): set exception for non-digit returns, + handle EOP flag (only usable if the internal EXTFH function was used) + * fileio.c (cob_extfh_close): handle close options, most important: + CLOSE REEL (as that does not actually close the file) + * fileio.c (EXTFH3): handle OP_CLOSE_REEL to leave the file open + * fileio.c (EXTFH3): handle "read direct" opcodes for now as "read random" + * fileio.c (EXTFH3): setup intermediate record only for WRITE/REWRITE as + it isn't used otherwise + * fileio.c (update_key_from_fcd): extracted from EXTFH3 + * fileio.c (update_key_from_fcd): only handle (logical) key field as split + keys are all handled in io functions and otherwise not found there + * fileio.c (find_fcd, cob_extfh_close): specify free handling by parameter, + new value "-1" is used if FCD was created by ADDRESS OF FH--FCD, + otherwise it is lost on first CLOSE + * fileio.c: disable setting of record min/max size outside of OPEN, + disable setting of record size in some places + 2023-06-01 Simon Sobisch @@ -24,6 +40,9 @@ where OPEN OUTPUT was not successful * fileio.c (cob_file_sort_giving): skip GIVING file on WRITE errors, early exit if no GIVING file left + * fileio.c (cobsort): new attribute flag_merge + * fileio.c (cob_file_sort_options), common.h: new function to pass more + options, so far only used to set flag_merge 2023-05-30 Simon Sobisch diff --git a/libcob/common.h b/libcob/common.h index 4836f8a77..2bb79628e 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -2628,7 +2628,10 @@ COB_EXPIMP void cob_file_sort_init_key (cob_file *, cob_field *, const int, const unsigned int); COB_EXPIMP void cob_file_sort_close (cob_file *); COB_EXPIMP void cob_file_sort_using (cob_file *, cob_file *); +COB_EXPIMP void cob_file_sort_using_extfh (cob_file *, cob_file *, + int (*callfh)(unsigned char *opcode, FCD3 *fcd)); COB_EXPIMP void cob_file_sort_giving (cob_file *, const size_t, ...); +COB_EXPIMP void cob_file_sort_giving_extfh (cob_file *, const size_t, ...); COB_EXPIMP void cob_file_release (cob_file *); COB_EXPIMP void cob_file_return (cob_file *); diff --git a/libcob/fileio.c b/libcob/fileio.c index 0bc20791e..18bb06227 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -8304,12 +8304,25 @@ cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, void cob_file_sort_using (cob_file *sort_file, cob_file *data_file) { - /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; + cob_file_sort_using_extfh (sort_file, data_file, NULL); +} + +/* SORT/MERGE: add all records from GIVING file 'data_file' to 'sort_file', + with optional external file handler 'callfh' */ +void +cob_file_sort_using_extfh (cob_file *sort_file, cob_file *data_file, + int (*callfh)(unsigned char *opcode, FCD3 *fcd)) +{ + /* FIXME: on each error the appropriate USAGE AFTER EXCEPTION/ERROR must be called; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ struct cobsort *hp = sort_file->file; int ret; - cob_open (data_file, COB_OPEN_INPUT, 0, NULL); + if (callfh) { + cob_extfh_open (callfh, data_file, COB_OPEN_INPUT, 0, NULL); + } else { + cob_open (data_file, COB_OPEN_INPUT, 0, NULL); + } if (data_file->file_status[0] != '0') { if (data_file->file_status[0] == '4') { cob_set_exception (COB_EC_SORT_MERGE_FILE_OPEN); @@ -8317,7 +8330,11 @@ cob_file_sort_using (cob_file *sort_file, cob_file *data_file) return; } for (;;) { - cob_read_next (data_file, NULL, COB_READ_NEXT); + if (callfh) { + cob_extfh_read_next (callfh, data_file, NULL, COB_READ_NEXT); + } else { + cob_read_next (data_file, NULL, COB_READ_NEXT); + } if (data_file->file_status[0] != '0') { break; } @@ -8327,30 +8344,37 @@ cob_file_sort_using (cob_file *sort_file, cob_file *data_file) break; } } - cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0); + if (callfh) { + cob_extfh_close (callfh, data_file, NULL, COB_CLOSE_NORMAL, 0); + } else { + cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0); + } } -/* SORT: WRITE all records from 'sort_file' to all passed USING files */ -void -cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) + +/* SORT/MERGE: WRITE all records from 'sort_file' to all USING files 'fbase', + with using their optional external file handlers 'callfh' */ +static void +cob_file_sort_giving_internal (cob_file *sort_file, const size_t giving_cnt, + cob_file **fbase, int (**callfh)(unsigned char *opcode, FCD3 *fcd)) { - /* FIXME: on each error the approprate USAGE AFTER EXCEPTION/ERROR must be called; + /* FIXME: on each error the appropriate USAGE AFTER EXCEPTION/ERROR must be called; and for MF/IBM the check for sort_return == 16 when coming back to stop the SORT! */ struct cobsort *hp = sort_file->file; - cob_file **fbase; + int *opt; size_t i; - va_list args; - int *opt; - int ret; + int ret; - /* setup temporary arrays, OPEN OUTPUT all GIVING files and get write option */ - fbase = cob_malloc (varcnt * sizeof (cob_file *)); - opt = cob_malloc (varcnt * sizeof (int)); - va_start (args, varcnt); - for (i = 0; i < varcnt; ++i) { - cob_file *using_file = fbase[i] = va_arg (args, cob_file *); - cob_open (using_file, COB_OPEN_OUTPUT, 0, NULL); + /* OPEN OUTPUT all GIVING files and get write option */ + opt = cob_malloc (giving_cnt * sizeof (int)); + for (i = 0; i < giving_cnt; ++i) { + cob_file *using_file = fbase[i]; + if (callfh && callfh[i]) { + cob_extfh_open (callfh[i], using_file, COB_OPEN_OUTPUT, 0, NULL); + } else { + cob_open (using_file, COB_OPEN_OUTPUT, 0, NULL); + } if (using_file->file_status[0] == '0') { if (COB_FILE_SPECIAL (using_file) || using_file->organization == COB_ORG_LINE_SEQUENTIAL) { @@ -8365,7 +8389,6 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) opt[i] = -1; } } - va_end (args); /* retrieve all records, WRITE each to every GIVING file */ for (;;) { @@ -8388,7 +8411,7 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) } /* WRITE record to all GIVING files */ - for (i = 0; i < varcnt; ++i) { + for (i = 0; i < giving_cnt; ++i) { cob_file *using_file = fbase[i]; /* skip files which got a permanent error before */ if (opt[i] < 0) { @@ -8396,7 +8419,11 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) } using_file->record->size = using_file->record_max; cob_copy_check (using_file->record, sort_file->record); - cob_write (using_file, using_file->record, opt[i], NULL, 0); + if (callfh && callfh[i]) { + cob_extfh_write (callfh[i], using_file, using_file->record, opt[i], NULL, 0); + } else { + cob_write (using_file, using_file->record, opt[i], NULL, 0); + } /* stop writing to this file if we got a permanent write error; note: other files are still written to; therefore SORT-RETURN 16 (early exit) is NOT set here */ @@ -8404,34 +8431,80 @@ cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) int j; opt[i] = -2; /* early exit if no GIVING file left */ - for (j = 0; j < varcnt; ++j) { + for (j = 0; j < giving_cnt; ++j) { if (opt[i] >= 0) { break; } } - if (j == varcnt) { + if (j == giving_cnt) { break; } } } - if (i != varcnt) { + if (i != giving_cnt) { break; } } /* all records processed - CLOSE all GIVING files */ - for (i = 0; i < varcnt; ++i) { + for (i = 0; i < giving_cnt; ++i) { cob_file *using_file = fbase[i]; /* skip files not opened */ if (opt[i] == -1) { continue; } - cob_close (using_file, NULL, COB_CLOSE_NORMAL, 0); + if (callfh && callfh[i]) { + cob_extfh_close (callfh[i], using_file, NULL, COB_CLOSE_NORMAL, 0); + } else { + cob_close (using_file, NULL, COB_CLOSE_NORMAL, 0); + } } /* cleanup temporary arrays */ cob_free (opt); cob_free (fbase); + if (callfh) { + cob_free (callfh); + } +} + +/* SORT: WRITE all records from 'sort_file' to all passed USING files */ +void +cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) +{ + cob_file **fbase; + va_list args; + size_t i; + + fbase = cob_malloc (varcnt * sizeof (cob_file *)); + va_start (args, varcnt); + for (i = 0; i < varcnt; ++i) { + fbase[i] = va_arg (args, cob_file *); + } + va_end (args); + cob_file_sort_giving_internal (sort_file, varcnt, fbase, NULL); +} + +/* SORT: WRITE all records from 'sort_file' to all passed USING files, + with using their optional external file handlers */ +void +cob_file_sort_giving_extfh (cob_file *sort_file, const size_t varcnt, ...) +{ + cob_file **fbase; + int (**callfh)(unsigned char *opcode, FCD3 *fcd); + va_list args; + size_t i, i_fh; + + fbase = cob_malloc (varcnt * sizeof (cob_file *)); + callfh = cob_malloc (varcnt * sizeof (void *)); + i_fh = 0; + va_start (args, varcnt); + for (i = 0; i < varcnt; i += 2) { + fbase[i_fh] = va_arg (args, cob_file *); + callfh[i_fh++] = va_arg (args, void *); + } + va_end (args); + cob_file_sort_giving_internal (sort_file, i_fh, fbase, callfh); } /* SORT: close of internal sort file 'f' and deallocation @@ -8728,7 +8801,7 @@ free_extfh_fcd (void) { struct fcd_file *ff,*nff; - for(ff = fcd_file_list; ff; ff = nff) { + for (ff = fcd_file_list; ff; ff = nff) { nff = ff->next; if (ff->free_select) { cob_cache_free ((void*)ff->f->select_name); @@ -8963,11 +9036,26 @@ static void update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) { if (wasOpen >= 0) { - cobglobptr->cob_error_file = f; - if (isdigit(fcd->fileStatus[0]) && fcd->fileStatus[1] != '0') { - cob_set_exception (status_exception[(fcd->fileStatus[0] - '0')]); + const int status_code_1 = isdigit(fcd->fileStatus[0]) + ? COB_D2I (fcd->fileStatus[0]) : 9; + if (status_code_1 == 0) { + /* EOP is non-fatal therefore 00 status but needs exception; + note that this global variable is only set if GnuCOBOL is used + as EXTFH, in every other case we currently can't set EOP; + also note that fcd->lineCount is never read/set */ + if (eop_status == 0) { + cobglobptr->cob_exception_code = 0; } else { - cobglobptr->cob_exception_code = 0; +#if 0 /* correct thing to do, but then also needs to have codegen adjusted + --> module-incompatibility --> 4.x */ + cob_set_exception (eop_status); +#else + cob_set_exception (COB_EC_I_O_EOP); +#endif + eop_status = 0; + } + } else { + cob_set_exception (status_exception[status_code_1]); } if (f->file_status) { memcpy (f->file_status, fcd->fileStatus, 2); @@ -8979,13 +9067,13 @@ update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) if (wasOpen > 0) { if((fcd->openMode & OPEN_NOT_OPEN)) f->open_mode = 0; - else if((fcd->openMode&0x7f) == OPEN_INPUT) + else if((fcd->openMode & 0x7f) == OPEN_INPUT) f->open_mode = COB_OPEN_INPUT; - else if((fcd->openMode&0x7f) == OPEN_OUTPUT) + else if((fcd->openMode & 0x7f) == OPEN_OUTPUT) f->open_mode = COB_OPEN_OUTPUT; - else if((fcd->openMode&0x7f) == OPEN_EXTEND) + else if((fcd->openMode & 0x7f) == OPEN_EXTEND) f->open_mode = COB_OPEN_EXTEND; - else if((fcd->openMode&0x7f) == OPEN_IO) + else if((fcd->openMode & 0x7f) == OPEN_IO) f->open_mode = COB_OPEN_I_O; } f->record_min = LDCOMPX4(fcd->minRecLen); @@ -8996,10 +9084,12 @@ update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) f->record->attr = &alnum_attr; } f->record->size = LDCOMPX4(fcd->curRecLen); +#if 0 /* this disables some expected status 44 */ if (f->record->size < f->record_min) f->record->size = f->record_min; else if (f->record->size > f->record_max) f->record->size = f->record_max; +#endif if (f->record->data != fcd->recPtr && fcd->recPtr != NULL) { @@ -9277,12 +9367,15 @@ copy_fcd_to_file (FCD3* fcd, cob_file *f, struct fcd_file *fcd_list_entry) * Construct FCD based on information from 'cob_file' */ static FCD3 * -find_fcd (cob_file *f) +find_fcd (cob_file *f, int free_fcd) { FCD3 *fcd; struct fcd_file *ff; for (ff = fcd_file_list; ff; ff=ff->next) { if (ff->f == f) { + if (free_fcd == -1) { + ff->free_fcd = -1; + } return ff->fcd; } } @@ -9292,7 +9385,7 @@ find_fcd (cob_file *f) ff->next = fcd_file_list; ff->fcd = fcd; ff->f = f; - ff->free_fcd = 1; + ff->free_fcd = free_fcd; fcd_file_list = ff; return fcd; } @@ -9501,12 +9594,19 @@ update_record_and_keys_if_necessary (cob_file * f, FCD3 *fcd) } f->record->size = LDCOMPX4(fcd->curRecLen); f->record->attr = &alnum_attr; +#if 0 /* this disables some expected status 44 + (the min/max may only be set during OPEN) */ f->record_min = LDCOMPX4(fcd->minRecLen); f->record_max = LDCOMPX4(fcd->maxRecLen); +#endif +#if 1 /* this disables some expected status 44 + and SIGSEGVs if the actual data is only + curRecLen long (+ accessed longer) */ if (f->record->size < f->record_min) f->record->size = f->record_min; if (f->record->size > f->record_max) f->record->size = f->record_max; +#endif if (fcd->fileOrg == ORG_INDEXED) { copy_keys_fcd_to_file (fcd, f, 1); } @@ -9545,7 +9645,7 @@ cob_extfh_open ( COB_UNUSED (sharing); - fcd = find_fcd(f); + fcd = find_fcd (f, 1); f->last_open_mode = (unsigned char)mode; if (mode == COB_OPEN_OUTPUT) STCOMPX2(OP_OPEN_OUTPUT, opcode); @@ -9584,32 +9684,57 @@ cob_extfh_close ( COB_UNUSED (remfil); - fcd = find_fcd (f); + fcd = find_fcd (f, 1); STCOMPX4 (opt, fcd->opt); - STCOMPX2 (OP_CLOSE, opcode); + + switch (opt) { + case COB_CLOSE_LOCK: + STCOMPX2 (OP_CLOSE_LOCK, opcode); + break; + case COB_CLOSE_NO_REWIND: + STCOMPX2 (OP_CLOSE_NO_REWIND, opcode); + break; + case COB_CLOSE_UNIT: + STCOMPX2 (OP_CLOSE_REEL, opcode); + break; + case COB_CLOSE_UNIT_REMOVAL: + STCOMPX2 (OP_CLOSE_REMOVE, opcode); + break; + default: + STCOMPX2 (OP_CLOSE, opcode); + break; + } /* Keep table of 'fcd' created */ (void)callfh (opcode, fcd); update_fcd_to_file (fcd, f, fnstatus, 0); - pff = NULL; - for (ff = fcd_file_list; ff; ff=ff->next) { - if (ff->fcd == fcd) { - if (pff) - pff->next = ff->next; - else - fcd_file_list = ff->next; - if (ff->free_fcd) { - if (ff->fcd->fnamePtr != NULL) - cob_cache_free ((void*)(ff->fcd->fnamePtr)); - cob_cache_free((void*)ff->fcd); - } else { - cob_cache_free((void*)ff->f); + /* drop internal FCD entry if file was closed */ + if (f->open_mode == COB_OPEN_CLOSED) { + pff = NULL; + for (ff = fcd_file_list; ff; ff=ff->next) { + if (ff->fcd == fcd) { + if (ff->free_fcd == -1) { + break; + } + if (pff) { + pff->next = ff->next; + } else { + fcd_file_list = ff->next; + } + if (ff->free_fcd) { + if (ff->fcd->fnamePtr != NULL) { + cob_cache_free ((void*)(ff->fcd->fnamePtr)); + } + cob_cache_free((void*)ff->fcd); + } else { + cob_cache_free((void*)ff->f); + } + cob_cache_free((void*)ff); + break; } - cob_cache_free((void*)ff); - break; + pff = ff; } - pff = ff; } } @@ -9626,7 +9751,7 @@ cob_extfh_start ( int recn; int keyn,keylen,partlen; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); if (f->organization == COB_ORG_INDEXED) { keyn = cob_findkey(f,key,&keylen,&partlen); STCOMPX2(keyn, fcd->refKey); @@ -9634,15 +9759,13 @@ cob_extfh_start ( partlen = cob_get_int (keysize); STCOMPX2(partlen, fcd->effKeyLen); STCOMPX2(keyn, fcd->refKey); - STCOMPX2(OP_READ_RAN, opcode); - } else if(f->organization == COB_ORG_RELATIVE) { + } else if (f->organization == COB_ORG_RELATIVE) { memset(fcd->relKey,0,sizeof (fcd->relKey)); recn = cob_get_int(f->keys[0].field); STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - STCOMPX2(OP_READ_RAN, opcode); } - switch(cond) { + switch (cond) { case COB_EQ: STCOMPX2(OP_START_EQ, opcode); break; case COB_GE: STCOMPX2(OP_START_GE, opcode); break; case COB_LE: STCOMPX2(OP_START_LE, opcode); break; @@ -9671,7 +9794,7 @@ cob_extfh_read ( int recn; int keyn,keylen,partlen; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX4 (read_opts, fcd->opt); if(key == NULL) { if((read_opts & COB_READ_PREVIOUS)) { @@ -9716,7 +9839,7 @@ cob_extfh_read_next ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX4(read_opts, fcd->opt); if((read_opts & COB_READ_PREVIOUS)) { STCOMPX2(OP_READ_PREV, opcode); @@ -9744,7 +9867,7 @@ cob_extfh_write ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX2(OP_WRITE, opcode); STCOMPX2(check_eop, fcd->eop); STCOMPX4(opt, fcd->opt); @@ -9780,9 +9903,8 @@ cob_extfh_rewrite ( FCD3 *fcd; int recn; - fcd = find_fcd(f); + fcd = find_fcd (f, 1); STCOMPX2 (OP_REWRITE, opcode); - STCOMPX4 (rec->size, fcd->curRecLen); STCOMPX4 (opt, fcd->opt); fcd->recPtr = rec->data; if (f->organization == COB_ORG_RELATIVE) { @@ -9814,7 +9936,7 @@ cob_extfh_delete ( FCD3 *fcd; int recn; - fcd = find_fcd (f); + fcd = find_fcd (f, 1); STCOMPX2 (OP_DELETE, opcode); if (f->organization == COB_ORG_RELATIVE) { memset (fcd->relKey, 0, sizeof (fcd->relKey)); @@ -9919,7 +10041,7 @@ cob_file_fcd_adrs (cob_file *f, void *pfcd) } /* LCOV_EXCL_STOP */ if (f->fcd == NULL) { - f->fcd = find_fcd (f); + f->fcd = find_fcd (f, -1); } fcd = f->fcd; if (fcd->openMode == OPEN_NOT_OPEN) { @@ -9994,6 +10116,52 @@ EXTFH (unsigned char *opcode, FCD3 *fcd) return EXTFH3 (opcode, fcd); } +static void +update_key_from_fcd (cob_file *f, FCD3 *fcd, cob_field *kf) +{ + if (fcd->fileOrg == ORG_INDEXED) { + const int k = LDCOMPX2 (fcd->refKey); + const int keylen = LDCOMPX2 (fcd->effKeyLen); + if (k >= 0 + && k <= (int)f->nkeys + && f->keys[k].field) { + cob_field *key = f->keys[k].field; +#if 0 /* the following sets up the _real_ key data, + but the functions called afterwards look out for + the "intermediate" key field; therefore leave as-is */ + kf->size = key->size; + kf->attr = key->attr; + if (f->keys[k].count_components <= 1) { + kf->data = f->record->data + f->keys[k].offset; + } else { + kf->data = key->data; + } +#else + /* copy over key field's attributes and data pointer */ + memcpy (kf, key, sizeof (cob_field)); +#endif + } else { + /* CHECKME: Shouldn't this just result in an error? */ + static unsigned char keywrk[80]; /* key data used for IDX, if not passed */ + memset (keywrk, 0, sizeof (keywrk)); + kf->size = sizeof (keywrk); + kf->attr = &alnum_attr; + kf->data = keywrk; + } + if (keylen != 0 + && keylen < kf->size) { + kf->size = keylen; + } + } else + if (fcd->fileOrg == ORG_RELATIVE) { + cob_field *rel_key = f->keys[0].field; + /* set value in the key field (several functions don't pass this outside of "f") */ + cob_set_int (rel_key, LDCOMPX4 (LSUCHAR (fcd->relKey + 4))); + /* copy over key field's attributes and data pointer */ + memcpy (kf, rel_key, sizeof (cob_field)); + } +} + /* * EXTFH: internal routine */ @@ -10004,11 +10172,9 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) int opcd,sts,opts,eop,k; unsigned char fnstatus[2]; /* storage for local file status field */ - unsigned char keywrk[80]; /* key data used for IDX, if not passed */ /* different cob_fields as some ABI functions operate on those */ cob_field fs[1]; cob_field key[1]; - cob_field rec[1]; cob_file *f; if (fcd->fcdVer != FCD_VER_64Bit) { @@ -10052,28 +10218,9 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) org_handling: switch (fcd->fileOrg) { case ORG_INDEXED: - k = LDCOMPX2(fcd->refKey); - if (k >= 0 - && k <= (int)f->nkeys - && f->keys[k].field) { - key->size = f->keys[k].field->size; - key->attr = f->keys[k].field->attr; - if (f->keys[k].count_components <= 1) { - key->data = f->record->data + f->keys[k].offset; - } else { - key->data = f->keys[k].field->data; - } - } else { - memset (keywrk, 0, sizeof (keywrk)); - key->size = sizeof (keywrk); - key->attr = &alnum_attr; - key->data = keywrk; - } f->organization = COB_ORG_INDEXED; break; case ORG_RELATIVE: - cob_set_int (f->keys[0].field, LDCOMPX4 (LSUCHAR (fcd->relKey + 4))); - memcpy (&key, f->keys[0].field, sizeof (cob_field)); f->organization = COB_ORG_RELATIVE; break; case ORG_SEQ: @@ -10161,10 +10308,14 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return -1; } +#if 0 /* this disables some expected status 44 + and SIGSEGV if the actual data is only + record_min long (+ accessed longer) */ if (f->record && f->record->size < f->record_min) { f->record->size = f->record_min; } +#endif /* handle OPEN/CLOSE operations */ @@ -10246,11 +10397,15 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return sts; case OP_CLOSE: - case OP_CLOSE_REEL: cob_close (f, fs, COB_CLOSE_NORMAL, 0); update_file_to_fcd (f, fcd, fnstatus); return sts; + case OP_CLOSE_REEL: + cob_close (f, fs, COB_CLOSE_UNIT, 0); + update_file_to_fcd (f, fcd, fnstatus); + return sts; + case OP_CLOSE_LOCK: cob_close (f, fs, COB_CLOSE_LOCK, 0); update_file_to_fcd (f, fcd, fnstatus); @@ -10298,11 +10453,6 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) return -1; } - /* create a local record field as following ABI functions expect it */ - rec->data = fcd->recPtr; - rec->size = LDCOMPX4(fcd->curRecLen); - rec->attr = &alnum_attr; - #if 0 /* CHECKME: why should we adjust the access mode? If wrong file, status should be raised in the following functions */ if (f->organization == COB_ORG_INDEXED @@ -10348,7 +10498,11 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) case OP_STEP_NEXT_LOCK: case OP_STEP_NEXT_NO_LOCK: case OP_STEP_NEXT_KEPT_LOCK: + /* use READ as an alias for STEP */ opts = COB_READ_NEXT; + /* FIXME "the current record pointer is not changed with STEP", + so either store on first STEP / restore on first non-STEP; + or implement step routines */ if (opcd == OP_STEP_NEXT_LOCK) opts |= COB_READ_LOCK; else if (opcd == OP_STEP_NEXT_NO_LOCK) @@ -10363,7 +10517,11 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) case OP_STEP_FIRST_LOCK: case OP_STEP_FIRST_NO_LOCK: case OP_STEP_FIRST_KEPT_LOCK: + /* use READ as an alias for STEP */ opts = COB_READ_FIRST; + /* FIXME "the current record pointer is not changed with STEP", + so either store on first STEP / restore on first non-STEP; + or implement step routines */ if (opcd == OP_STEP_FIRST_LOCK) opts |= COB_READ_LOCK; else if (opcd == OP_STEP_FIRST_NO_LOCK) @@ -10374,6 +10532,13 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) update_file_to_fcd (f, fcd, NULL); break; + case OP_READ_DIR: + case OP_READ_DIR_LOCK: + case OP_READ_DIR_NO_LOCK: + case OP_READ_DIR_KEPT_LOCK: + /* CHECKME: is this handling correct? */ + /* Fall through */ + case OP_READ_RAN: case OP_READ_RAN_LOCK: case OP_READ_RAN_NO_LOCK: @@ -10385,75 +10550,108 @@ EXTFH3 (unsigned char *opcode, FCD3 *fcd) opts |= COB_READ_NO_LOCK; else if (opcd == OP_READ_RAN_KEPT_LOCK) opts |= COB_READ_KEPT_LOCK; + update_key_from_fcd (f, fcd, key); cob_read (f, key, fs, opts); update_file_to_fcd (f, fcd, fnstatus); break; - case OP_WRITE: + case OP_WRITE: { + cob_field rec[1]; + rec->data = fcd->recPtr; + rec->size = LDCOMPX4 (fcd->curRecLen); + rec->attr = &alnum_attr; +#if 0 /* Simon: min/max from FCD may only be accessed on OPEN */ if (f->record && rec->size >= LDCOMPX4(fcd->minRecLen) && rec->size <= LDCOMPX4(fcd->maxRecLen)) { f->record->size = rec->size; } +#endif +#if 1 /* Simon: breaks status 44 and + can lead to SIGSEGV if there's only curRecLen + data available */ if (rec->size < f->record_min) { rec->size = f->record_min; } +#endif eop = LDCOMPX2(fcd->eop); opts = LDCOMPX4(fcd->opt); + update_key_from_fcd (f, fcd, key); cob_write (f, rec, opts, fs, eop); update_file_to_fcd (f, fcd, fnstatus); break; + } - case OP_REWRITE: + case OP_REWRITE: { + cob_field rec[1]; + rec->data = fcd->recPtr; + rec->size = LDCOMPX4 (fcd->curRecLen); + rec->attr = &alnum_attr; +#if 0 /* Simon: min/max from FCD may only be accessed on OPEN */ if (f->record - && rec->size >= LDCOMPX4(fcd->minRecLen) - && rec->size <= LDCOMPX4(fcd->maxRecLen)) { + && rec->size >= LDCOMPX4 (fcd->minRecLen) + && rec->size <= LDCOMPX4 (fcd->maxRecLen)) { f->record->size = rec->size; } +#endif +#if 1 /* Simon: breaks status 44 and + can lead to SIGSEGV if there's only curRecLen + data available */ if (rec->size < f->record_min) { rec->size = f->record_min; } +#endif opts = LDCOMPX4(fcd->opt); + update_key_from_fcd (f, fcd, key); cob_rewrite (f, rec, opts, fs); update_file_to_fcd (f, fcd, fnstatus); break; + } case OP_DELETE: + update_key_from_fcd (f, fcd, key); cob_delete (f, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_EQ: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_EQ, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_GE: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_GE, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LE: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LE, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LT: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LT, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_GT: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_GT, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_FI: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_FI, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; case OP_START_LA: + update_key_from_fcd (f, fcd, key); cob_start (f, COB_LA, key, NULL, fs); update_file_to_fcd (f, fcd, fnstatus); break; diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index d5b4549bc..db13d7769 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -2003,9 +2003,10 @@ AT_CLEANUP AT_SETUP([INDEXED file split keys WITH DUPLICATES]) -AT_KEYWORDS([runfile key]) +AT_KEYWORDS([runfile key EXTFH]) AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) + ## Note: The order in which secondary records with duplicate keys ## are returnded is not guaranteed. @@ -2157,6 +2158,13 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +# verify that all of this works with wrapping to EXTFH calls and +# back to our own EXTFH entry point + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh], [0], [], []) + AT_CLEANUP @@ -4777,55 +4785,55 @@ AT_DATA([prog.cob], [ 01 page-count pic 9999. PROCEDURE DIVISION. + main. + open input data-file. + read data-file + at end + display "File open error: " data-file-status + stop run + end-read. - open input data-file. - read data-file - at end - display "File open error: " data-file-status - stop run - end-read. - - open output mini-report. + open output mini-report. - write report-line - from report-line-blank - end-write. + write report-line + from report-line-blank + end-write. - move 1 to page-count. - accept page-date from date end-accept. - move page-count to page-no. - write report-line - from report-line-header - after advancing page - end-write. + move 1 to page-count. + accept page-date from date end-accept. + move page-count to page-no. + write report-line + from report-line-header + after advancing page + end-write. - perform readwrite-loop until endofdata. + perform readwrite-loop until endofdata. - display - "Normal termination, ending status: " - data-file-status - close mini-report. + display + "Normal termination, ending status: " + data-file-status + close mini-report. - close data-file. - stop run. + close data-file. + stop run. **************************************************************** readwrite-loop. - move data-record to report-line-data - move linage-counter to body-tag - write report-line from report-line-data - end-of-page - add 1 to page-count end-add - move page-count to page-no - move linage-counter to header-tag - write report-line from report-line-header - after advancing page - end-write - end-write - read data-file - at end set endofdata to true - end-read - . + move data-record to report-line-data + move linage-counter to body-tag + write report-line from report-line-data + end-of-page + add 1 to page-count end-add + move page-count to page-no + move linage-counter to header-tag + write report-line from report-line-header + after advancing page + end-write + end-write + read data-file + at end set endofdata to true + end-read + . ]) AT_CAPTURE_FILE([mini-report]) @@ -4921,49 +4929,49 @@ PAGE: 0004 LC: 000015 DATE: 150206 000008 01 page-count pic 9999. 000009 000010 PROCEDURE DIVISION. -000011 -000012 open input data-file. -000013 read data-file -000014 at end +000011 main. +000012 open input data-file. +000013 read data-file +000014 at end PAGE: 0005 LC: 000015 DATE: 150206 -000001 display "File open error: " data-file-status -000002 stop run -000003 end-read. +000001 display "File open error: " data-file-status +000002 stop run +000003 end-read. 000004 -000005 open output mini-report. +000005 open output mini-report. 000006 -000007 write report-line -000008 from report-line-blank -000009 end-write. +000007 write report-line +000008 from report-line-blank +000009 end-write. 000010 -000011 move 1 to page-count. -000012 accept page-date from date end-accept. -000013 move page-count to page-no. -000014 write report-line +000011 move 1 to page-count. +000012 accept page-date from date end-accept. +000013 move page-count to page-no. +000014 write report-line PAGE: 0006 LC: 000015 DATE: 150206 -000001 from report-line-header -000002 after advancing page -000003 end-write. +000001 from report-line-header +000002 after advancing page +000003 end-write. 000004 -000005 perform readwrite-loop until endofdata. +000005 perform readwrite-loop until endofdata. 000006 -000007 display -000008 "Normal termination, ending status: " -000009 data-file-status -000010 close mini-report. +000007 display +000008 "Normal termination, ending status: " +000009 data-file-status +000010 close mini-report. 000011 -000012 close data-file. -000013 stop run. +000012 close data-file. +000013 stop run. 000014 @@ -4973,27 +4981,27 @@ PAGE: 0006 LC: 000015 DATE: 150206 PAGE: 0007 LC: 000015 DATE: 150206 000001**************************************************************** 000002 readwrite-loop. -000003 move data-record to report-line-data -000004 move linage-counter to body-tag -000005 write report-line from report-line-data -000006 end-of-page -000007 add 1 to page-count end-add -000008 move page-count to page-no -000009 move linage-counter to header-tag -000010 write report-line from report-line-header -000011 after advancing page -000012 end-write -000013 end-write -000014 read data-file +000003 move data-record to report-line-data +000004 move linage-counter to body-tag +000005 write report-line from report-line-data +000006 end-of-page +000007 add 1 to page-count end-add +000008 move page-count to page-no +000009 move linage-counter to header-tag +000010 write report-line from report-line-header +000011 after advancing page +000012 end-write +000013 end-write +000014 read data-file PAGE: 0008 LC: 000015 DATE: 150206 -000001 at end set endofdata to true -000002 end-read -000003 . +000001 at end set endofdata to true +000002 end-read +000003 . ]) AT_CHECK([$COMPILE prog.cob], [0], [], []) @@ -5005,6 +5013,296 @@ AT_CHECK([diff mini-report reference-report], [0], [], []) AT_CLEANUP +AT_SETUP([EXTFH: LINAGE and LINAGE-COUNTER sample]) +AT_KEYWORDS([runfile EXTFH OPTIONAL FILE STATUS READ WRITE END-OF-PAGE LINE SEQUENTIAL]) + +# modified version of the test above + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + select optional data-file assign to 'prog.cob' + organization is line sequential + file status is data-file-status. + select mini-report assign to "mini-report". + + DATA DIVISION. + FILE SECTION. + FD data-file. + 01 data-record. + 88 endofdata value high-values. + 02 data-line pic x(80). + FD mini-report + linage is 16 lines + with footing at 15 + lines at top 2 + lines at bottom 2. + 01 report-line pic x(80). + + WORKING-STORAGE SECTION. + 01 command-arguments pic x(1024). + 01 file-name pic x(160). + 01 data-file-status pic xx. + 01 lc pic 99. + 01 report-line-blank. + 02 filler pic x(18) value all "*". + 02 filler pic x(05) value spaces. + 02 filler pic x(34) + VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". + 02 filler pic x(05) value spaces. + 02 filler pic x(18) value all "*". + 01 report-line-data. + 02 body-tag pic 9(6). + 02 line-3 pic x(74). + 01 report-line-header. + 02 filler pic x(6) VALUE "PAGE: ". + 02 page-no pic 9999. + 02 filler pic x(24). + 02 filler pic x(5) VALUE " LC: ". + 02 header-tag pic 9(6). + + + + + 01 page-count pic 9999. + + PROCEDURE DIVISION. + main. + open input data-file. + read data-file + at end + display "File open error: " data-file-status + stop run + end-read. + + open output mini-report. + + write report-line + from report-line-blank + end-write. + + move 1 to page-count. + move page-count to page-no. + write report-line + from report-line-header + after advancing page + end-write. + + perform readwrite-loop until endofdata. + + display + "Normal termination, ending status: " + data-file-status + close mini-report. + + close data-file. + stop run. + + **************************************************************** + readwrite-loop. + move data-record to report-line-data + move linage-counter to body-tag + write report-line from report-line-data + end-of-page + add 1 to page-count end-add + move page-count to page-no + move linage-counter to header-tag + write report-line from report-line-header + after advancing page + end-write + end-write + read data-file + at end set endofdata to true + end-read + . +]) + +AT_CAPTURE_FILE([mini-report]) +AT_DATA([reference-report], [ + +****************** THIS PAGE INTENTIONALLY LEFT BLANK ****************** + + + + + + + + + + + + + + + + + + +PAGE: 0001 LC: 000000 +000001 +000002 IDENTIFICATION DIVISION. +000003 PROGRAM-ID. prog. +000004 ENVIRONMENT DIVISION. +000005 INPUT-OUTPUT SECTION. +000006 FILE-CONTROL. +000007 select optional data-file assign to 'prog.cob' +000008 organization is line sequential +000009 file status is data-file-status. +000010 select mini-report assign to "mini-report". +000011 +000012 DATA DIVISION. +000013 FILE SECTION. +000014 FD data-file. + + + + + +PAGE: 0002 LC: 000015 +000001 01 data-record. +000002 88 endofdata value high-values. +000003 02 data-line pic x(80). +000004 FD mini-report +000005 linage is 16 lines +000006 with footing at 15 +000007 lines at top 2 +000008 lines at bottom 2. +000009 01 report-line pic x(80). +000010 +000011 WORKING-STORAGE SECTION. +000012 01 command-arguments pic x(1024). +000013 01 file-name pic x(160). +000014 01 data-file-status pic xx. + + + + + +PAGE: 0003 LC: 000015 +000001 01 lc pic 99. +000002 01 report-line-blank. +000003 02 filler pic x(18) value all "*". +000004 02 filler pic x(05) value spaces. +000005 02 filler pic x(34) +000006 VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". +000007 02 filler pic x(05) value spaces. +000008 02 filler pic x(18) value all "*". +000009 01 report-line-data. +000010 02 body-tag pic 9(6). +000011 02 line-3 pic x(74). +000012 01 report-line-header. +000013 02 filler pic x(6) VALUE "PAGE: ". +000014 02 page-no pic 9999. + + + + + +PAGE: 0004 LC: 000015 +000001 02 filler pic x(24). +000002 02 filler pic x(5) VALUE " LC: ". +000003 02 header-tag pic 9(6). +000004 +000005 +000006 +000007 +000008 01 page-count pic 9999. +000009 +000010 PROCEDURE DIVISION. +000011 main. +000012 open input data-file. +000013 read data-file +000014 at end + + + + + +PAGE: 0005 LC: 000015 +000001 display "File open error: " data-file-status +000002 stop run +000003 end-read. +000004 +000005 open output mini-report. +000006 +000007 write report-line +000008 from report-line-blank +000009 end-write. +000010 +000011 move 1 to page-count. +000012 accept page-date from date end-accept. +000013 move page-count to page-no. +000014 write report-line + + + + + +PAGE: 0006 LC: 000015 +000001 from report-line-header +000002 after advancing page +000003 end-write. +000004 +000005 perform readwrite-loop until endofdata. +000006 +000007 display +000008 "Normal termination, ending status: " +000009 data-file-status +000010 close mini-report. +000011 +000012 close data-file. +000013 stop run. +000014 + + + + + +PAGE: 0007 LC: 000015 +000001**************************************************************** +000002 readwrite-loop. +000003 move data-record to report-line-data +000004 move linage-counter to body-tag +000005 write report-line from report-line-data +000006 end-of-page +000007 add 1 to page-count end-add +000008 move page-count to page-no +000009 move linage-counter to header-tag +000010 write report-line from report-line-header +000011 after advancing page +000012 end-write +000013 end-write +000014 read data-file + + + + + +PAGE: 0008 LC: 000015 +000001 at end set endofdata to true +000002 end-read +000003 . +]) + +AT_CHECK([$COMPILE -fcallfh=EXTFH prog.cob], [0], [], []) + +# currently does not generate the expected report, as LINAGE options +# are not passed via FCD and the internal part works only "partial" + +AT_XFAIL_IF([true]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[Normal termination, ending status: 10 +], []) +AT_CHECK([diff mini-report reference-report], [0], [], []) + +AT_CLEANUP + + AT_SETUP([SEQUENTIAL file I/O with variable records]) AT_KEYWORDS([runfile]) @@ -8292,8 +8590,11 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Other Flags 32. +AT_CAPTURE_FILE([prog.out]) + +AT_CHECK([$COBCRUN_DIRECT ./prog 1>prog.out], [0], [], []) + +AT_DATA([reference], [Other Flags 32. File has 0003 keys. Key def 0112 bytes. File assigned is 'mytstisam' @@ -8366,7 +8667,18 @@ Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . Hit End of File after 11 -], []) +]) + +AT_CHECK([diff reference prog.out], [0], [], []) + +# verify that all of this works with wrapping to EXTFH calls +# and that those don't trash the FH--FCD allocated memory + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh 1>prog.out], [0], [], []) + +AT_CHECK([diff reference prog.out], [0], [], []) + AT_CLEANUP @@ -9035,19 +9347,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL WRITES COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO CREATE LINE SEQUENTIAL FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN LINE SEQUENTIAL FILE AS OUTPUT.' @@ -9080,19 +9392,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' OR '10' DISPLAY PROGRAM-NAME ': LINE SEQUENTIAL READS COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO READ LINE SEQUENTIAL FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE LINE SEQUENTIAL FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN LINE SEQUENTIAL FILE AS INPUT.' @@ -9156,6 +9468,12 @@ AT_CLEANUP AT_SETUP([EXTFH: FIXED SEQUENTIAL]) AT_KEYWORDS([runfile EXTFH]) +# CHECKME: Should it really be possible to change the length +# with a line-sequentia file this way? +# If yes: should there be an implied "WRITE FROM" - so +# that an intermediate record field, space padded, is +# internally used? + AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. @@ -9233,19 +9551,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' DISPLAY PROGRAM-NAME ': FIXED SEQ WRITES COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': FIXED SEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE FIXED SEQ FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO CREATE FIXED SEQ FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': FIXED SEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE FIXED SEQ FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN FIXED SEQ FILE AS OUTPUT.' @@ -9283,19 +9601,19 @@ AT_DATA([prog.cob], [ END-PERFORM IF FCD-FILE-STATUS = '00' OR '10' DISPLAY PROGRAM-NAME ': FIXED SEQ READS COMPLETE.' - SET EXTFH-OPCODE-ISCLOSE TO TRUE - PERFORM CALL-EXTFH - PERFORM FCD-CHECK-STAT - IF FCD-FILE-STATUS = '00' - DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' - ELSE - DISPLAY PROGRAM-NAME - ': UNABLE TO CLOSE FIXED SEQ FILE.' - END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO READ FIXED SEQ FILE.' END-IF + SET EXTFH-OPCODE-ISCLOSE TO TRUE + PERFORM CALL-EXTFH + PERFORM FCD-CHECK-STAT + IF FCD-FILE-STATUS = '00' + DISPLAY PROGRAM-NAME ': LSEQ FILE IS CLOSED.' + ELSE + DISPLAY PROGRAM-NAME + ': UNABLE TO CLOSE FIXED SEQ FILE.' + END-IF ELSE DISPLAY PROGRAM-NAME ': UNABLE TO OPEN FIXED SEQ FILE AS INPUT.' @@ -11165,7 +11483,7 @@ AT_CLEANUP AT_SETUP([INDEXED File READ/DELETE/READ]) -AT_KEYWORDS([runfile READ DELETE]) +AT_KEYWORDS([runfile READ DELETE EXTFH]) AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) @@ -11842,8 +12160,11 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample data file. +AT_CAPTURE_FILE([prog.out]) + +AT_CHECK([$COBCRUN_DIRECT ./prog 1>prog.out], [0], [], []) + +AT_DATA([reference], [Loading sample data file. Sample data file load complete. List sample data file Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 . @@ -11955,7 +12276,14 @@ Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . Hit End of File -], []) +]) + +AT_CHECK([diff reference prog.out], [0], [], []) + +AT_CHECK([$COMPILE -fcallfh=EXTFH -o extfh prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./extfh 1>prog.out], [0], [], []) + +AT_CHECK([diff reference prog.out], [0], [], []) AT_CLEANUP @@ -12911,7 +13239,7 @@ AT_DATA([prog.cob], [ 2 file3-key2 pic 9. 2 filler pic x(10). PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 + SORT file3 ON ASCENDING file3-key1 DESCENDING file3-key2 USING file1 GIVING file2. @@ -12936,8 +13264,75 @@ Z9XXXXXXXXXX AT_CLEANUP +AT_SETUP([EXTFH: File SORT, LINE SEQUENTIAL variable records]) +AT_KEYWORDS([runfile SORT USING GIVING EXTFH]) + +# same test as above, but this time using an external file handler +# which in this case is the internal EXTFH handler + +AT_DATA([file1], +[A1XXXX +A2XXX +A3XX +Z9XXXXXXXXXX +A4X +B1XXXXXXX +B2XXXXXX +A0XXXXX +C1XXXXXXXXX +C2XXXXXXXX +]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT file1 ORGANIZATION LINE SEQUENTIAL + ASSIGN "./file1". + SELECT file2 ORGANIZATION LINE SEQUENTIAL + ASSIGN "./file2". + SELECT file3 ASSIGN DISK. + DATA DIVISION. + FILE SECTION. + FD file1. + 1 file1-rec pic x(12). + FD file2. + 1 file2-rec pic x(12). + SD file3. + 1 file3-rec. + 2 file3-key1 pic x. + 2 file3-key2 pic 9. + 2 filler pic x(10). + PROCEDURE DIVISION. + SORT file3 ON ASCENDING file3-key1 + DESCENDING file3-key2 + USING file1 + GIVING file2. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fcallfh=EXTFH prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([cat file2], [0], +[A4X +A3XX +A2XXX +A1XXXX +A0XXXXX +B2XXXXXX +B1XXXXXXX +C2XXXXXXXX +C1XXXXXXXXX +Z9XXXXXXXXXX +]) + +AT_CLEANUP + + AT_SETUP([File MERGE, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile MERGE USING GIVING]) +AT_KEYWORDS([runfile]) AT_DATA([file1], [A1XXXX From 599953e71ee92fb32d38965676e7b66ca897cdc9 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Sat, 3 Jun 2023 14:26:53 +0000 Subject: [PATCH 6/7] build_aux update and updated ABI version number for libcob build_aux: * config.sub, texinfo.tex: updated to recent versions from https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ * create_mingw_bindist.sh: fix check for MSYS2/mingw environments libcob/Makefile.am (libcob_la_LDFLAGS): updated version-info - ABI fixed for 3.2 --- build_aux/ChangeLog | 6 + build_aux/config.sub | 8 +- build_aux/create_mingw_bindist.sh | 4 +- build_aux/texinfo.tex | 2090 ++++++++++++++++------------- libcob/ChangeLog | 4 + libcob/Makefile.am | 4 +- 6 files changed, 1193 insertions(+), 923 deletions(-) diff --git a/build_aux/ChangeLog b/build_aux/ChangeLog index eb7b5e8ed..667d414b0 100644 --- a/build_aux/ChangeLog +++ b/build_aux/ChangeLog @@ -1,4 +1,10 @@ +2023-06-03 Simon Sobisch + + * config.sub, texinfo.tex: updated to recent versions from + https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ + * create_mingw_bindist.sh: fix check for MSYS2/mingw environments + 2023-02-06 Simon Sobisch * pre-inst-env.in: export COB_ON_CYGWIN for testsuite checks diff --git a/build_aux/config.sub b/build_aux/config.sub index baf1512b3..de4259e40 100755 --- a/build_aux/config.sub +++ b/build_aux/config.sub @@ -1,10 +1,10 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2022 Free Software Foundation, Inc. +# Copyright 1992-2023 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-21' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -76,7 +76,7 @@ Report bugs and patches to ." version="\ GNU config.sub ($timestamp) -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -1075,7 +1075,7 @@ case $cpu-$vendor in pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) cpu=i586 ;; - pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*) + pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*) cpu=i686 ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) diff --git a/build_aux/create_mingw_bindist.sh b/build_aux/create_mingw_bindist.sh index 14ec89924..e47aeda26 100755 --- a/build_aux/create_mingw_bindist.sh +++ b/build_aux/create_mingw_bindist.sh @@ -1,7 +1,7 @@ #!/bin/bash # create_mingw_bindist.sh gnucobol # -# Copyright (C) 2016-2020, 2022 Free Software Foundation, Inc. +# Copyright (C) 2016-2020, 2022-2023 Free Software Foundation, Inc. # Written by Simon Sobisch # # This file is part of GnuCOBOL. @@ -25,7 +25,7 @@ # AND make sure EXTBUILDDIR exists with the right content. # Check we're in a MinGW environment -if test -d "$MSYSTEM_PREFIX/bin"; then +if test "x$MINGW_PREFIX" != "x" -a -d "$MSYSTEM_PREFIX/bin"; then MINGWDIR="$MSYSTEM_PREFIX" echo "generating binary ${MINGW_PREFIX:1} dist package..." elif test -d "/mingw/bin"; then diff --git a/build_aux/texinfo.tex b/build_aux/texinfo.tex index 8872e5e05..a32c84197 100644 --- a/build_aux/texinfo.tex +++ b/build_aux/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-04-09.08} +\def\texinfoversion{2023-03-27.21} % -% Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -58,12 +58,6 @@ \message{Loading texinfo [version \texinfoversion]:} -% If in a .fmt file, print the version number -% and turn on active characters that we couldn't do earlier because -% they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}% - \catcode`+=\active \catcode`\_=\active} - % LaTeX's \typeout. This ensures that the messages it is used for % are identical in format to the corresponding ones from latex/pdflatex. \def\typeout{\immediate\write17}% @@ -241,9 +235,6 @@ % \def\finalout{\overfullrule=0pt } -\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines -\newdimen\topandbottommargin \topandbottommargin=.75in - % Output a mark which sets \thischapter, \thissection and \thiscolor. % We dump everything together because we only have one kind of mark. % This works because we only use \botmark / \topmark, not \firstmark. @@ -317,16 +308,8 @@ \newbox\footlinebox % When outputting the double column layout for indices, an output routine -% is run several times, which hides the original value of \topmark. This -% can lead to a page heading being output and duplicating the chapter heading -% of the index. Hence, save the contents of \topmark at the beginning of -% the output routine. The saved contents are valid until we actually -% \shipout a page. -% -% (We used to run a short output routine to actually set \topmark and -% \firstmark to the right values, but if this was called with an empty page -% containing whatsits for writing index entries, the whatsits would be thrown -% away and the index auxiliary file would remain empty.) +% is run several times, hiding the original value of \topmark. Hence, save +% \topmark at the beginning. % \newtoks\savedtopmark \newif\iftopmarksaved @@ -351,15 +334,9 @@ % \checkchapterpage % - % Retrieve the information for the headings from the marks in the page, - % and call Plain TeX's \makeheadline and \makefootline, which use the - % values in \headline and \footline. - % - % Common context changes for both heading and footing. - % Do this outside of the \shipout so @code etc. will be expanded in - % the headline as they should be, not taken literally (outputting ''code). + % Make the heading and footing. \makeheadline and \makefootline + % use the contents of \headline and \footline. \def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars} - % \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi \global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}% \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi @@ -547,7 +524,7 @@ % ... but they get defined via ``\envdef\foo{...}'': \long\def\envdef#1#2{\def#1{\startenvironment#1#2}} -\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} +\long\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} % Check whether we're in the right environment: \def\checkenv#1{% @@ -608,6 +585,9 @@ % @/ allows a line break. \let\/=\allowbreak +% @- allows explicit insertion of hyphenation points +\def\-{\discretionary{\normaldash}{}{}}% + % @. is an end-of-sentence period. \def\.{.\spacefactor=\endofsentencespacefactor\space} @@ -617,21 +597,6 @@ % @? is an end-of-sentence query. \def\?{?\spacefactor=\endofsentencespacefactor\space} -% @frenchspacing on|off says whether to put extra space after punctuation. -% -\def\onword{on} -\def\offword{off} -% -\parseargdef\frenchspacing{% - \def\temp{#1}% - \ifx\temp\onword \plainfrenchspacing - \else\ifx\temp\offword \plainnonfrenchspacing - \else - \errhelp = \EMsimple - \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% - \fi\fi -} - % @w prevents a word break. Without the \leavevmode, @w at the % beginning of a paragraph, when TeX is still in vertical mode, would % produce a whole line of output instead of starting the paragraph. @@ -725,32 +690,22 @@ \dimen2 = \ht\strutbox \advance\dimen2 by \dp\strutbox \ifdim\dimen0 > \dimen2 + % This is similar to the 'needspace' module in LaTeX. + % The first penalty allows a break if the end of the page is + % not too far away. Following penalties and skips are discarded. + % Otherwise, require at least \dimen0 of vertical space. % - % Do a \strut just to make the height of this box be normal, so the - % normal leading is inserted relative to the preceding line. - % And a page break here is fine. - \vtop to #1\mil{\strut\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. + % (We used to use a \vtop to reserve space, but this had spacing issues + % when followed by a section heading, as it was not a "discardable item". + % This also has the benefit of providing glue before the page break if + % there isn't enough space.) + \vskip0pt plus \dimen0 + \penalty-100 + \vskip0pt plus -\dimen0 + \vskip \dimen0 \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak + \vskip -\dimen0 + \penalty0\relax % this hides the above glue from \safewhatsit and \dobreak \fi } @@ -1147,27 +1102,33 @@ % Output page labels information. % See PDF reference v.1.7 p.594, section 8.3.1. +% Page label ranges must be increasing. \ifpdf \def\pagelabels{% \def\title{0 << /P (T-) /S /D >>}% - \edef\roman{\the\romancount << /S /r >>}% - \edef\arabic{\the\arabiccount << /S /D >>}% % - % Page label ranges must be increasing. Remove any duplicates. - % (There is a slight chance of this being wrong if e.g. there is - % a @contents but no @titlepage, etc.) - % - \ifnum\romancount=0 \def\roman{}\fi - \ifnum\arabiccount=0 \def\title{}% - \else - \ifnum\romancount=\arabiccount \def\roman{}\fi - \fi - % - \ifnum\romancount<\arabiccount - \pdfcatalog{/PageLabels << /Nums [\title \roman \arabic ] >> }\relax + % support @contents at very end of document + \ifnum\contentsendcount=\pagecount + \ifnum\arabiccount<\romancount + \pdfcatalog{/PageLabels << /Nums + [\title + \the\arabiccount << /S /D >> + \the\romancount << /S /r >> + ] >> }\relax + \fi + % no contents in document + \else\ifnum\contentsendcount=0 + \pdfcatalog{/PageLabels << /Nums + [\title + \the\arabiccount << /S /D >> + ] >> }\relax \else - \pdfcatalog{/PageLabels << /Nums [\title \arabic \roman ] >> }\relax - \fi + \pdfcatalog{/PageLabels << /Nums + [\title + \the\romancount << /S /r >> + \the\contentsendcount << /S /D >> + ] >> }\relax + \fi\fi } \else \let\pagelabels\relax @@ -1176,6 +1137,8 @@ \newcount\pagecount \pagecount=0 \newcount\romancount \romancount=0 \newcount\arabiccount \arabiccount=0 +\newcount\contentsendcount \contentsendcount=0 + \ifpdf \let\ptxadvancepageno\advancepageno \def\advancepageno{% @@ -1239,13 +1202,17 @@ % % Set color, and create a mark which defines \thiscolor accordingly, % so that \makeheadline knows which color to restore. + \def\curcolor{0 0 0}% \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% + \ifx#1\curcolor\else + \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% + \domark + \pdfsetcolor{#1}% + \xdef\curcolor{#1}% + \fi } % - \def\maincolor{\rgbBlack} + \let\maincolor\rgbBlack \pdfsetcolor{\maincolor} \edef\thiscolor{\maincolor} \def\currentcolordefs{} @@ -1401,7 +1368,7 @@ % % by default, use black for everything. \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} + \let\linkcolor\rgbBlack \def\endlink{\setcolor{\maincolor}\pdfendlink} % % Adding outlines to PDF; macros for calculating structure of outlines @@ -1579,9 +1546,10 @@ \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} \else % non-pdf mode @@ -1828,10 +1796,11 @@ \next} \def\makelink{\addtokens{\toksB}% {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% + \def\pdflink#1{\pdflinkpage{#1}{#1}}% + \def\pdflinkpage#1#2{% \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% - \setcolor{\linkcolor}#1\endlink} + \setcolor{\linkcolor}#2\endlink} \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} % % @@ -2176,6 +2145,11 @@ \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% }% \fi\fi +% +% This is what gets called when #5 of \setfont is empty. +\let\cmap\gobble +% +% (end of cmaps) % Set the font macro #1 to the font named \fontprefix#2. @@ -2191,11 +2165,10 @@ \def\setfont#1#2#3#4#5{% \font#1=\fontprefix#2#3 scaled #4 \csname cmap#5\endcsname#1% + \ifx#2\ttshape\hyphenchar#1=-1 \fi + \ifx#2\ttbshape\hyphenchar#1=-1 \fi + \ifx#2\ttslshape\hyphenchar#1=-1 \fi } -% This is what gets called when #5 of \setfont is empty. -\let\cmap\gobble -% -% (end of cmaps) % Use cm as the default font prefix. % To specify the font prefix, you must define \fontprefix @@ -2558,7 +2531,7 @@ \def\it{\fam=\itfam \setfontstyle{it}} \def\sl{\fam=\slfam \setfontstyle{sl}} \def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf} -\def\tt{\fam=\ttfam \setfontstyle{tt}}\def\ttstylename{tt} +\def\tt{\fam=\ttfam \setfontstyle{tt}} % Texinfo sort of supports the sans serif font style, which plain TeX does not. % So we set up a \sf. @@ -2586,34 +2559,30 @@ \scriptfont\sffam=\sevensf } -% -% The font-changing commands (all called \...fonts) redefine the meanings -% of \STYLEfont, instead of just \STYLE. We do this because \STYLE needs -% to also set the current \fam for math mode. Our \STYLE (e.g., \rm) -% commands hardwire \STYLEfont to set the current font. -% -% The fonts used for \ifont are for "math italics" (\itfont is for italics -% in regular text). \syfont is also used in math mode only. -% -% Each font-changing command also sets the names \lsize (one size lower) -% and \lllsize (three sizes lower). These relative commands are used -% in, e.g., the LaTeX logo and acronyms. -% -% This all needs generalizing, badly. + +% \defineassignfonts{SIZE} - +% Define sequence \assignfontsSIZE, which switches between font sizes +% by redefining the meanings of \STYLEfont. (Just \STYLE additionally sets +% the current \fam for math mode.) % +\def\defineassignfonts#1{% + \expandafter\edef\csname assignfonts#1\endcsname{% + \let\noexpand\rmfont\csname #1rm\endcsname + \let\noexpand\itfont\csname #1it\endcsname + \let\noexpand\slfont\csname #1sl\endcsname + \let\noexpand\bffont\csname #1bf\endcsname + \let\noexpand\ttfont\csname #1tt\endcsname + \let\noexpand\smallcaps\csname #1sc\endcsname + \let\noexpand\sffont \csname #1sf\endcsname + \let\noexpand\ifont \csname #1i\endcsname + \let\noexpand\syfont \csname #1sy\endcsname + \let\noexpand\ttslfont\csname #1ttsl\endcsname + } +} \def\assignfonts#1{% - \expandafter\let\expandafter\rmfont\csname #1rm\endcsname - \expandafter\let\expandafter\itfont\csname #1it\endcsname - \expandafter\let\expandafter\slfont\csname #1sl\endcsname - \expandafter\let\expandafter\bffont\csname #1bf\endcsname - \expandafter\let\expandafter\ttfont\csname #1tt\endcsname - \expandafter\let\expandafter\smallcaps\csname #1sc\endcsname - \expandafter\let\expandafter\sffont \csname #1sf\endcsname - \expandafter\let\expandafter\ifont \csname #1i\endcsname - \expandafter\let\expandafter\syfont \csname #1sy\endcsname - \expandafter\let\expandafter\ttslfont\csname #1ttsl\endcsname + \csname assignfonts#1\endcsname } \newif\ifrmisbold @@ -2637,12 +2606,21 @@ \csname\curfontstyle\endcsname }% +% Define the font-changing commands (all called \...fonts). +% Each font-changing command also sets the names \lsize (one size lower) +% and \lllsize (three sizes lower). These relative commands are used +% in, e.g., the LaTeX logo and acronyms. +% +% Note: The fonts used for \ifont are for "math italics" (\itfont is for +% italics in regular text). \syfont is also used in math mode only. +% \def\definefontsetatsize#1#2#3#4#5{% + \defineassignfonts{#1}% \expandafter\def\csname #1fonts\endcsname{% \def\curfontsize{#1}% \def\lsize{#2}\def\lllsize{#3}% \csname rmisbold#5\endcsname - \assignfonts{#1}% + \csname assignfonts#1\endcsname \resetmathfonts \setleading{#4}% }} @@ -2687,9 +2665,22 @@ % Check if we are currently using a typewriter font. Since all the % Computer Modern typewriter fonts have zero interword stretch (and % shrink), and it is reasonable to expect all typewriter fonts to have -% this property, we can check that font parameter. -% -\def\ifmonospace{\ifdim\fontdimen3\font=0pt } +% this property, we can check that font parameter. #1 is what to +% print if we are indeed using \tt; #2 is what to print otherwise. +\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} + +% Same as above, but check for italic font. Actually this also catches +% non-italic slanted fonts since it is impossible to distinguish them from +% italic fonts. But since this is only used by $ and it uses \sl anyway +% this is not a problem. +\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} + + +% Check if internal flag is clear, i.e. has not been @set. +\def\ifflagclear#1#2#3{% + \expandafter\ifx\csname SET#1\endcsname\relax + #2\else#3\fi +} { \catcode`\'=\active @@ -2698,41 +2689,33 @@ \gdef\setcodequotes{\let`\codequoteleft \let'\codequoteright} \gdef\setregularquotes{\let`\lq \let'\rq} } +\setregularquotes -% Allow an option to not use regular directed right quote/apostrophe -% (char 0x27), but instead the undirected quote from cmtt (char 0x0d). -% The undirected quote is ugly, so don't make it the default, but it -% works for pasting with more pdf viewers (at least evince), the -% lilypond developers report. xpdf does work with the regular 0x27. +% output for ' in @code +% in tt font hex 0D (undirected) or 27 (curly right quote) % \def\codequoteright{% - \ifmonospace - \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax - \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax - '% - \else \char'15 \fi - \else \char'15 \fi - \else - '% - \fi + \ifusingtt + {\ifflagclear{txicodequoteundirected}% + {\ifflagclear{codequoteundirected}% + {'}% + {\char"0D }}% + {\char"0D }}% + {'}% } -% -% and a similar option for the left quote char vs. a grave accent. -% Modern fonts display ASCII 0x60 as a grave accent, so some people like -% the code environments to do likewise. + +% output for ` in @code +% in tt font hex 12 (grave accent) or 60 (curly left quote) +% \relax disables Spanish ligatures ?` and !` of \tt font. % \def\codequoteleft{% - \ifmonospace - \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax - \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax - % [Knuth] pp. 380,381,391 - % \relax disables Spanish ligatures ?` and !` of \tt font. - \relax`% - \else \char'22 \fi - \else \char'22 \fi - \else - \relax`% - \fi + \ifusingtt + {\ifflagclear{txicodequotebacktick}% + {\ifflagclear{codequotebacktick}% + {\relax`}% + {\char"12 }}% + {\char"12 }}% + {\relax`}% } % Commands to set the quote options. @@ -2750,7 +2733,7 @@ \errmessage{Unknown @codequoteundirected value `\temp', must be on|off}% \fi\fi } -% + \parseargdef\codequotebacktick{% \def\temp{#1}% \ifx\temp\onword @@ -2765,6 +2748,11 @@ \fi\fi } +% Turn them on by default +\let\SETtxicodequoteundirected = t +\let\SETtxicodequotebacktick = t + + % [Knuth] pp. 380,381,391, disable Spanish ligatures ?` and !` of \tt font. \def\noligaturesquoteleft{\relax\lq} @@ -2779,15 +2767,16 @@ \def\dosmartslant#1#2{% \ifusingtt {{\ttsl #2}\let\next=\relax}% - {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}% + {\def\next{{#1#2}\smartitaliccorrection}}% \next } \def\smartslanted{\dosmartslant\sl} \def\smartitalic{\dosmartslant\it} -% Output an italic correction unless \next (presumed to be the following -% character) is such as not to need one. -\def\smartitaliccorrection{% +% Output an italic correction unless the following character is such as +% not to need one. +\def\smartitaliccorrection{\futurelet\next\smartitaliccorrectionx} +\def\smartitaliccorrectionx{% \ifx\next,% \else\ifx\next-% \else\ifx\next.% @@ -2798,27 +2787,41 @@ \aftersmartic } -% Unconditional use \ttsl, and no ic. @var is set to this for defuns. -\def\ttslanted#1{{\ttsl #1}} - -% @cite is like \smartslanted except unconditionally use \sl. We never want -% ttsl for book titles, do we? -\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection} +% @cite unconditionally uses \sl with \smartitaliccorrection. +\def\cite#1{{\sl #1}\smartitaliccorrection} +% @var unconditionally uses \sl. This gives consistency for +% parameter names whether they are in @def, @table @code or a +% regular paragraph. +% To get ttsl font for @var when used in code context, @set txicodevaristt. +% The \null is to reset \spacefactor. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% - \smartslanted{#1}% + % + \ifflagclear{txicodevaristt}% + {\def\varnext{{{\sl #1}}\smartitaliccorrection}}% + {\def\varnext{\smartslanted{#1}}}% + \varnext } +% To be removed after next release +\def\SETtxicodevaristt{}% @set txicodevaristt + \let\i=\smartitalic \let\slanted=\smartslanted \let\dfn=\smartslanted \let\emph=\smartitalic -% Explicit font changes: @r, @sc, undocumented @ii. -\def\r#1{{\rm #1}} % roman font +% @r for roman font, used for code comment +\def\r#1{{% + \usenormaldash % get --, --- ligatures even if in @code + \defcharsdefault % in case on def line + \rm #1}} +{\catcode`-=\active \gdef\usenormaldash{\let-\normaldash}} + +% @sc, undocumented @ii. \def\sc#1{{\smallcaps#1}} % smallcaps font \def\ii#1{{\it #1}} % italic font @@ -2829,12 +2832,8 @@ % @sansserif, explicit sans. \def\sansserif#1{{\sf #1}} -% We can't just use \exhyphenpenalty, because that only has effect at -% the end of a paragraph. Restore normal hyphenation at the end of the -% group within which \nohyphenation is presumably called. -% -\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} -\def\restorehyphenation{\hyphenchar\font = `- } +\newif\iffrenchspacing +\frenchspacingfalse % Set sfcode to normal for the chars that usually have another value. % Can't use plain's \frenchspacing because it uses the `\x notation, and @@ -2842,21 +2841,45 @@ % \catcode`@=11 \def\plainfrenchspacing{% - \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m - \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m - \def\endofsentencespacefactor{1000}% for @. and friends + \iffrenchspacing\else + \frenchspacingtrue + \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m + \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m + \def\endofsentencespacefactor{1000}% for @. and friends + \fi } \def\plainnonfrenchspacing{% - \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 - \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 - \def\endofsentencespacefactor{3000}% for @. and friends + \iffrenchspacing + \frenchspacingfalse + \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 + \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 + \def\endofsentencespacefactor{3000}% for @. and friends + \fi } \catcode`@=\other \def\endofsentencespacefactor{3000}% default +% @frenchspacing on|off says whether to put extra space after punctuation. +% +\def\onword{on} +\def\offword{off} +% +\let\frenchspacingsetting\plainnonfrenchspacing % used in output routine +\parseargdef\frenchspacing{% + \def\temp{#1}% + \ifx\temp\onword \let\frenchspacingsetting\plainfrenchspacing + \else\ifx\temp\offword \let\frenchspacingsetting\plainnonfrenchspacing + \else + \errhelp = \EMsimple + \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% + \fi\fi + \frenchspacingsetting +} + + % @t, explicit typewriter. \def\t#1{% - {\tt \plainfrenchspacing #1}% + {\tt \defcharsdefault \plainfrenchspacing #1}% \null } @@ -2877,27 +2900,29 @@ % Switch to typewriter. \tt % - % But `\ ' produces the large typewriter interword space. + % `\ ' produces the large typewriter interword space. \def\ {{\spaceskip = 0pt{} }}% % - % Turn off hyphenation. - \nohyphenation - % \plainfrenchspacing #1% }% \null % reset spacefactor to 1000 } -% We *must* turn on hyphenation at `-' and `_' in @code. -% (But see \codedashfinish below.) +% This is for LuaTeX: It is not sufficient to disable hyphenation at +% explicit dashes by setting `\hyphenchar` to -1. +\def\dashnobreak{% + \normaldash + \penalty 10000 } + +% We must turn on hyphenation at `-' and `_' in @code. % Otherwise, it is too hard to avoid overfull hboxes % in the Emacs manual, the Library manual, etc. +% We explicitly allow hyphenation at these characters +% using \discretionary. % -% Unfortunately, TeX uses one parameter (\hyphenchar) to control -% both hyphenation at - and hyphenation within words. -% We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate at a dash. -- rms. +% Hyphenation at - and hyphenation within words was turned off +% by default for the tt fonts using the \hyphenchar parameter of TeX. { \catcode`\-=\active \catcode`\_=\active \catcode`\'=\active \catcode`\`=\active @@ -2910,13 +2935,9 @@ \let-\codedash \let_\codeunder \else - \let-\normaldash + \let-\dashnobreak \let_\realunder \fi - % Given -foo (with a single dash), we do not want to allow a break - % after the hyphen. - \global\let\codedashprev=\codedash - % \codex } % @@ -2926,21 +2947,30 @@ % % Now, output a discretionary to allow a line break, unless % (a) the next character is a -, or - % (b) the preceding character is a -. + % (b) the preceding character is a -, or + % (c) we are at the start of the string. + % In both cases (b) and (c), \codedashnobreak should be set to \codedash. + % % E.g., given --posix, we do not want to allow a break after either -. % Given --foo-bar, we do want to allow a break between the - and the b. \ifx\next\codedash \else - \ifx\codedashprev\codedash + \ifx\codedashnobreak\codedash \else \discretionary{}{}{}\fi \fi % we need the space after the = for the case when \next itself is a % space token; it would get swallowed otherwise. As in @code{- a}. - \global\let\codedashprev= \next + \global\let\codedashnobreak= \next } } \def\normaldash{-} % -\def\codex #1{\tclose{#1}\endgroup} +\def\codex #1{\tclose{% + % Given -foo (with a single dash), we do not want to allow a break + % after the -. \codedashnobreak is set to the first character in + % @code. + \futurelet\codedashnobreak\relax + #1% +}\endgroup} \def\codeunder{% % this is all so @math{@code{var_name}+1} can work. In math mode, _ @@ -3187,7 +3217,7 @@ % definition of @key with no lozenge. % -\def\key#1{{\setregularquotes \nohyphenation \tt #1}\null} +\def\key#1{{\setregularquotes \tt #1}\null} % @clicksequence{File @click{} Open ...} \def\clicksequence#1{\begingroup #1\endgroup} @@ -3390,8 +3420,8 @@ \let\atchar=\@ % @{ @} @lbracechar{} @rbracechar{} all generate brace characters. -\def\lbracechar{{\ifmonospace\char123\else\ensuremath\lbrace\fi}} -\def\rbracechar{{\ifmonospace\char125\else\ensuremath\rbrace\fi}} +\def\lbracechar{{\ifusingtt{\char123}{\ensuremath\lbrace}}} +\def\rbracechar{{\ifusingtt{\char125}{\ensuremath\rbrace}}} \let\{=\lbracechar \let\}=\rbracechar @@ -3445,8 +3475,13 @@ % Revert to plain's \scriptsize, which is 7pt. \count255=\the\fam $\fam\count255 \scriptstyle A$% \else - % For 11pt, we can use our lllsize. - \switchtolllsize A% + \ifx\curfontsize\smallword + % For footnotes and indices + \count255=\the\fam $\fam\count255 \scriptstyle A$% + \else + % For 11pt, we can use our lllsize. + \switchtolllsize A% + \fi \fi }% \vss @@ -3454,6 +3489,7 @@ \kern-.15em \TeX } +\def\smallword{small} % Some math mode symbols. Define \ensuremath to switch into math mode % unless we are already there. Expansion tricks may not be needed here, @@ -3532,7 +3568,7 @@ % @pounds{} is a sterling sign, which Knuth put in the CM italic font. % -\def\pounds{\ifmonospace{\ecfont\char"BF}\else{\it\$}\fi} +\def\pounds{{\ifusingtt{\ecfont\char"BF}{\it\$}}} % @euro{} comes from a separate font, depending on the current style. % We use the free feym* fonts from the eurosym package by Henrik @@ -3646,18 +3682,17 @@ % hopefully nobody will notice/care. \edef\ecsize{\csname\curfontsize ecsize\endcsname}% \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}% - \ifmonospace - % typewriter: - \font\thisecfont = #1ctt\ecsize \space at \nominalsize - \else - \ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize - \else - % regular: - \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize - \fi - \fi + \ifusingtt + % typewriter: + {\font\thisecfont = #1ctt\ecsize \space at \nominalsize}% + % else + {\ifx\curfontstyle\bfstylename + % bold: + \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize + \else + % regular: + \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \fi}% \thisecfont } @@ -3673,7 +3708,10 @@ % @textdegree - the normal degrees sign. % -\def\textdegree{$^\circ$} +\def\textdegree{% + \ifmmode ^\circ + \else {\tcfont \char 176}% + \fi} % Laurent Siebenmann reports \Orb undefined with: % Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38 @@ -3690,11 +3728,11 @@ % only change font for tt for correct kerning and to avoid using % \ecfont unless necessary. \def\quotedblleft{% - \ifmonospace{\ecfont\char"10}\else{\char"5C}\fi + \ifusingtt{{\ecfont\char"10}}{{\char"5C}}% } \def\quotedblright{% - \ifmonospace{\ecfont\char"11}\else{\char`\"}\fi + \ifusingtt{{\ecfont\char"11}}{{\char`\"}}% } @@ -3719,13 +3757,14 @@ want the contents after the title page.}}% \parseargdef\shorttitlepage{% - \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} + {\headingsoff \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% + \endgroup\page\hbox{}\page}\pageone} \envdef\titlepage{% % Open one extra group, as we want to close it in the middle of \Etitlepage. \begingroup \parindent=0pt \textfonts + \headingsoff % Leave some space at the very top of the page. \vglue\titlepagetopglue % No rule at page bottom unless we print one at the top with @title. @@ -3753,11 +3792,9 @@ % If we use the new definition of \page, we always get a blank page % after the title page, which we certainly don't want. \oldpage + \pageone \endgroup % - % Need this before the \...aftertitlepage checks so that if they are - % in effect the toc pages will come out with page numbers. - \HEADINGSon } \def\finishtitlepage{% @@ -3824,15 +3861,16 @@ \newtoks\oddfootline % footline on odd pages % Now make \makeheadline and \makefootline in Plain TeX use those variables -\headline={{\textfonts\rm +\headline={{\textfonts\rm\frenchspacingsetting \ifchapterpage \ifodd\pageno\the\oddchapheadline\else\the\evenchapheadline\fi \else \ifodd\pageno\the\oddheadline\else\the\evenheadline\fi \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} +\footline={{\textfonts\rm\frenchspacingsetting + \ifodd\pageno \the\oddfootline \else \the\evenfootline \fi}% + \HEADINGShook} \let\HEADINGShook=\relax % Commands to set those variables. @@ -3925,46 +3963,37 @@ } \def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting -\HEADINGSoff % it's the default -% When we turn headings on, set the page number to 1. +% Set the page number to 1. \def\pageone{ \global\pageno=1 \global\arabiccount = \pagecount } +\let\contentsalignmacro = \chappager + +% \def\HEADINGSon{\HEADINGSdouble} % defined by \CHAPPAGon + % For double-sided printing, put current file name in lower left corner, % chapter name on inside top of right hand pages, document % title on inside top of left hand pages, and page numbers on outside top % edge of all pages. -\def\HEADINGSdouble{% -\pageone -\HEADINGSdoublex -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{% -\pageone -\HEADINGSsinglex -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} +\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdouble} \let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% +\def\HEADINGSdouble{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} -\global\evenchapheadline={\line{\folio\hfil}} +\global\evenchapheadline={\line{\folio\hfil\thistitle}} \global\oddchapheadline={\line{\hfil\folio}} \global\let\contentsalignmacro = \chapoddpage } -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% +% For single-sided printing, chapter title goes across top left of page, +% page number on top right. +\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsingle} +\def\HEADINGSsingle{% \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -3976,7 +4005,6 @@ % for @setchapternewpage off \def\HEADINGSsinglechapoff{% -\pageone \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} @@ -4346,8 +4374,7 @@ % undo it ourselves. \def\headitemfont{\b}% for people to use in the template row; not changeable \def\headitem{% - \checkenv\multitable - \crcr + \crcr % must appear first \gdef\headitemcrhook{\nobreak}% attempt to avoid page break after headings \global\everytab={\bf}% can't use \headitemfont since the parsing differs \the\everytab % for the first item @@ -4432,7 +4459,7 @@ \message{conditionals,} -% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext, +% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotlatex, @ifnotplaintext, % @ifnotxml always succeed. They currently do nothing; we don't % attempt to check whether the conditionals are properly nested. But we % have to remember that they are conditionals, so that @end doesn't @@ -4446,6 +4473,7 @@ \makecond{ifnotdocbook} \makecond{ifnothtml} \makecond{ifnotinfo} +\makecond{ifnotlatex} \makecond{ifnotplaintext} \makecond{ifnotxml} @@ -4458,10 +4486,12 @@ \def\ifdocbook{\doignore{ifdocbook}} \def\ifhtml{\doignore{ifhtml}} \def\ifinfo{\doignore{ifinfo}} +\def\iflatex{\doignore{iflatex}} \def\ifnottex{\doignore{ifnottex}} \def\ifplaintext{\doignore{ifplaintext}} \def\ifxml{\doignore{ifxml}} \def\ignore{\doignore{ignore}} +\def\latex{\doignore{latex}} \def\menu{\doignore{menu}} \def\xml{\doignore{xml}} @@ -4700,13 +4730,11 @@ % except not \outer, so it can be used within macros and \if's. \edef\newwrite{\makecsname{ptexnewwrite}} -% \newindex {foo} defines an index named IX. +% \newindex {IX} defines an index named IX. % It automatically defines \IXindex such that % \IXindex ...rest of line... puts an entry in the index IX. % It also defines \IXindfile to be the number of the output channel for % the file that accumulates this index. The file's extension is IX. -% The name of an index should be no more than 2 characters long -% for the sake of vms. % \def\newindex#1{% \expandafter\chardef\csname#1indfile\endcsname=0 @@ -4769,21 +4797,6 @@ \def\docodeindexxxx #1{\docind{\indexname}{#1}} -% Used for the aux, toc and index files to prevent expansion of Texinfo -% commands. -% -\def\atdummies{% - \definedummyletter\@% - \definedummyletter\ % - \definedummyletter\{% - \definedummyletter\}% - \definedummyletter\&% - % - % Do the redefinitions. - \definedummies - \otherbackslash -} - % \definedummyword defines \#1 as \string\#1\space, thus effectively % preventing its expansion. This is used only for control words, % not control letters, because the \space would be incorrect for @@ -4799,110 +4812,91 @@ % \def\definedummyword #1{\def#1{\string#1\space}}% \def\definedummyletter#1{\def#1{\string#1}}% -\let\definedummyaccent\definedummyletter -% Called from \atdummies to prevent the expansion of commands. +% Used for the aux, toc and index files to prevent expansion of Texinfo +% commands. Most of the commands are controlled through the +% \ifdummies conditional. % -\def\definedummies{% +\def\atdummies{% + \dummiestrue % - \let\commondummyword\definedummyword - \let\commondummyletter\definedummyletter - \let\commondummyaccent\definedummyaccent - \commondummiesnofonts + \definedummyletter\@% + \definedummyletter\ % + \definedummyletter\{% + \definedummyletter\}% + \definedummyletter\&% % \definedummyletter\_% \definedummyletter\-% % - % Non-English letters. - \definedummyword\AA - \definedummyword\AE - \definedummyword\DH - \definedummyword\L - \definedummyword\O - \definedummyword\OE - \definedummyword\TH - \definedummyword\aa - \definedummyword\ae - \definedummyword\dh - \definedummyword\exclamdown - \definedummyword\l - \definedummyword\o - \definedummyword\oe - \definedummyword\ordf - \definedummyword\ordm - \definedummyword\questiondown - \definedummyword\ss - \definedummyword\th - % - % Although these internal commands shouldn't show up, sometimes they do. - \definedummyword\bf - \definedummyword\gtr - \definedummyword\hat - \definedummyword\less - \definedummyword\sf - \definedummyword\sl - \definedummyword\tclose - \definedummyword\tt - % - \definedummyword\LaTeX - \definedummyword\TeX - % - % Assorted special characters. - \definedummyword\ampchar - \definedummyword\atchar - \definedummyword\arrow - \definedummyword\backslashchar - \definedummyword\bullet - \definedummyword\comma - \definedummyword\copyright - \definedummyword\registeredsymbol - \definedummyword\dots - \definedummyword\enddots - \definedummyword\entrybreak - \definedummyword\equiv - \definedummyword\error - \definedummyword\euro - \definedummyword\expansion - \definedummyword\geq - \definedummyword\guillemetleft - \definedummyword\guillemetright - \definedummyword\guilsinglleft - \definedummyword\guilsinglright - \definedummyword\lbracechar - \definedummyword\leq - \definedummyword\mathopsup - \definedummyword\minus - \definedummyword\ogonek - \definedummyword\pounds - \definedummyword\point - \definedummyword\print - \definedummyword\quotedblbase - \definedummyword\quotedblleft - \definedummyword\quotedblright - \definedummyword\quoteleft - \definedummyword\quoteright - \definedummyword\quotesinglbase - \definedummyword\rbracechar - \definedummyword\result - \definedummyword\sub - \definedummyword\sup - \definedummyword\textdegree - % \definedummyword\subentry % % We want to disable all macros so that they are not expanded by \write. + \let\commondummyword\definedummyword \macrolist \let\value\dummyvalue % - \normalturnoffactive -} - -% \commondummiesnofonts: common to \definedummies and \indexnofonts. -% Define \commondummyletter, \commondummyaccent and \commondummyword before -% using. Used for accents, font commands, and various control letters. -% -\def\commondummiesnofonts{% - % Control letters and accents. + \turnoffactive +} + +\newif\ifdummies +\newif\ifindexnofonts + +\def\commondummyletter#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + % empty expansion + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +\def\commondummyaccent#1{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \noexpand\asis + \noexpand\else + \noexpand\ifdummies\string#1% + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} + +% Like \commondummyaccent but add a \space at the end of the dummy expansion +% #2 is the expansion used for \indexnofonts. #2 is always followed by +% \asis to remove a pair of following braces. +\def\commondummyword#1#2{% + \expandafter\let\csname\string#1:impl\endcsname#1% + \expandafter\def\csname\string#1:ixnf\endcsname{#2\asis}% + \edef#1{% + \noexpand\ifindexnofonts + \noexpand\expandafter % dispose of \else ... \fi + \expandafter\noexpand\csname\string#1:ixnf\endcsname + \noexpand\else + \noexpand\ifdummies\string#1\space + \noexpand\else + \noexpand\jumptwofi % dispose of the \fi \fi + \expandafter\noexpand\csname\string#1:impl\endcsname + \noexpand\fi + \noexpand\fi}% +} +\def\jumptwofi#1\fi\fi{\fi\fi#1} + +% For \atdummies and \indexnofonts. \atdummies sets +% \dummiestrue and \indexnofonts sets \indexnofontstrue. +\def\definedummies{ + % @-sign is always an escape character when reading auxiliary files + \escapechar = `\@ + % \commondummyletter\!% \commondummyaccent\"% \commondummyaccent\'% @@ -4916,58 +4910,123 @@ \commondummyaccent\^% \commondummyaccent\`% \commondummyaccent\~% - \commondummyword\u - \commondummyword\v - \commondummyword\H - \commondummyword\dotaccent - \commondummyword\ogonek - \commondummyword\ringaccent - \commondummyword\tieaccent - \commondummyword\ubaraccent - \commondummyword\udotaccent - \commondummyword\dotless + % + % Control letters and accents. + \commondummyword\u {}% + \commondummyword\v {}% + \commondummyword\H {}% + \commondummyword\dotaccent {}% + \commondummyword\ogonek {}% + \commondummyword\ringaccent {}% + \commondummyword\tieaccent {}% + \commondummyword\ubaraccent {}% + \commondummyword\udotaccent {}% + \commondummyword\dotless {}% % % Texinfo font commands. - \commondummyword\b - \commondummyword\i - \commondummyword\r - \commondummyword\sansserif - \commondummyword\sc - \commondummyword\slanted - \commondummyword\t + \commondummyword\b {}% + \commondummyword\i {}% + \commondummyword\r {}% + \commondummyword\sansserif {}% + \commondummyword\sc {}% + \commondummyword\slanted {}% + \commondummyword\t {}% % % Commands that take arguments. - \commondummyword\abbr - \commondummyword\acronym - \commondummyword\anchor - \commondummyword\cite - \commondummyword\code - \commondummyword\command - \commondummyword\dfn - \commondummyword\dmn - \commondummyword\email - \commondummyword\emph - \commondummyword\env - \commondummyword\file - \commondummyword\image - \commondummyword\indicateurl - \commondummyword\inforef - \commondummyword\kbd - \commondummyword\key - \commondummyword\math - \commondummyword\option - \commondummyword\pxref - \commondummyword\ref - \commondummyword\samp - \commondummyword\strong - \commondummyword\tie - \commondummyword\U - \commondummyword\uref - \commondummyword\url - \commondummyword\var - \commondummyword\verb - \commondummyword\w - \commondummyword\xref + \commondummyword\abbr {}% + \commondummyword\acronym {}% + \commondummyword\anchor {}% + \commondummyword\cite {}% + \commondummyword\code {}% + \commondummyword\command {}% + \commondummyword\dfn {}% + \commondummyword\dmn {}% + \commondummyword\email {}% + \commondummyword\emph {}% + \commondummyword\env {}% + \commondummyword\file {}% + \commondummyword\image {}% + \commondummyword\indicateurl{}% + \commondummyword\inforef {}% + \commondummyword\kbd {}% + \commondummyword\key {}% + \commondummyword\math {}% + \commondummyword\option {}% + \commondummyword\pxref {}% + \commondummyword\ref {}% + \commondummyword\samp {}% + \commondummyword\strong {}% + \commondummyword\tie {}% + \commondummyword\U {}% + \commondummyword\uref {}% + \commondummyword\url {}% + \commondummyword\var {}% + \commondummyword\verb {}% + \commondummyword\w {}% + \commondummyword\xref {}% + % + \commondummyword\AA {AA}% + \commondummyword\AE {AE}% + \commondummyword\DH {DZZ}% + \commondummyword\L {L}% + \commondummyword\O {O}% + \commondummyword\OE {OE}% + \commondummyword\TH {TH}% + \commondummyword\aa {aa}% + \commondummyword\ae {ae}% + \commondummyword\dh {dzz}% + \commondummyword\exclamdown {!}% + \commondummyword\l {l}% + \commondummyword\o {o}% + \commondummyword\oe {oe}% + \commondummyword\ordf {a}% + \commondummyword\ordm {o}% + \commondummyword\questiondown {?}% + \commondummyword\ss {ss}% + \commondummyword\th {th}% + % + \commondummyword\LaTeX {LaTeX}% + \commondummyword\TeX {TeX}% + % + % Assorted special characters. + \commondummyword\ampchar {\normalamp}% + \commondummyword\atchar {\@}% + \commondummyword\arrow {->}% + \commondummyword\backslashchar {\realbackslash}% + \commondummyword\bullet {bullet}% + \commondummyword\comma {,}% + \commondummyword\copyright {copyright}% + \commondummyword\dots {...}% + \commondummyword\enddots {...}% + \commondummyword\entrybreak {}% + \commondummyword\equiv {===}% + \commondummyword\error {error}% + \commondummyword\euro {euro}% + \commondummyword\expansion {==>}% + \commondummyword\geq {>=}% + \commondummyword\guillemetleft {<<}% + \commondummyword\guillemetright {>>}% + \commondummyword\guilsinglleft {<}% + \commondummyword\guilsinglright {>}% + \commondummyword\lbracechar {\{}% + \commondummyword\leq {<=}% + \commondummyword\mathopsup {sup}% + \commondummyword\minus {-}% + \commondummyword\pounds {pounds}% + \commondummyword\point {.}% + \commondummyword\print {-|}% + \commondummyword\quotedblbase {"}% + \commondummyword\quotedblleft {"}% + \commondummyword\quotedblright {"}% + \commondummyword\quoteleft {`}% + \commondummyword\quoteright {'}% + \commondummyword\quotesinglbase {,}% + \commondummyword\rbracechar {\}}% + \commondummyword\registeredsymbol {R}% + \commondummyword\result {=>}% + \commondummyword\sub {}% + \commondummyword\sup {}% + \commondummyword\textdegree {o}% } \let\indexlbrace\relax @@ -4985,25 +5044,24 @@ \catcode`\-=13 \catcode`\`=13 \gdef\indexnonalnumdisappear{% - \expandafter\ifx\csname SETtxiindexlquoteignore\endcsname\relax\else + \ifflagclear{txiindexlquoteignore}{}{% % @set txiindexlquoteignore makes us ignore left quotes in the sort term. % (Introduced for FSFS 2nd ed.) \let`=\empty - \fi + }% % - \expandafter\ifx\csname SETtxiindexbackslashignore\endcsname\relax\else + \ifflagclear{txiindexbackslashignore}{}{% \backslashdisappear - \fi - % - \expandafter\ifx\csname SETtxiindexhyphenignore\endcsname\relax\else + }% + \ifflagclear{txiindexhyphenignore}{}{% \def-{}% - \fi - \expandafter\ifx\csname SETtxiindexlessthanignore\endcsname\relax\else + }% + \ifflagclear{txiindexlessthanignore}{}{% \def<{}% - \fi - \expandafter\ifx\csname SETtxiindexatsignignore\endcsname\relax\else + }% + \ifflagclear{txiindexatsignignore}{}{% \def\@{}% - \fi + }% } \gdef\indexnonalnumreappear{% @@ -5019,18 +5077,7 @@ % would be for a given command (usually its argument). % \def\indexnofonts{% - % Accent commands should become @asis. - \def\commondummyaccent##1{\let##1\asis}% - % We can just ignore other control letters. - \def\commondummyletter##1{\let##1\empty}% - % All control words become @asis by default; overrides below. - \let\commondummyword\commondummyaccent - \commondummiesnofonts - % - % Don't no-op \tt, since it isn't a user-level command - % and is used in the definitions of the active chars like <, >, |, etc. - % Likewise with the other plain tex font commands. - %\let\tt=\asis + \indexnofontstrue % \def\ { }% \def\@{@}% @@ -5042,84 +5089,19 @@ \let\lbracechar\{% \let\rbracechar\}% % - % Non-English letters. - \def\AA{AA}% - \def\AE{AE}% - \def\DH{DZZ}% - \def\L{L}% - \def\OE{OE}% - \def\O{O}% - \def\TH{TH}% - \def\aa{aa}% - \def\ae{ae}% - \def\dh{dzz}% - \def\exclamdown{!}% - \def\l{l}% - \def\oe{oe}% - \def\ordf{a}% - \def\ordm{o}% - \def\o{o}% - \def\questiondown{?}% - \def\ss{ss}% - \def\th{th}% - % - \let\do\indexnofontsdef - % - \do\LaTeX{LaTeX}% - \do\TeX{TeX}% - % - % Assorted special characters. - \do\atchar{@}% - \do\arrow{->}% - \do\bullet{bullet}% - \do\comma{,}% - \do\copyright{copyright}% - \do\dots{...}% - \do\enddots{...}% - \do\equiv{==}% - \do\error{error}% - \do\euro{euro}% - \do\expansion{==>}% - \do\geq{>=}% - \do\guillemetleft{<<}% - \do\guillemetright{>>}% - \do\guilsinglleft{<}% - \do\guilsinglright{>}% - \do\leq{<=}% - \do\lbracechar{\{}% - \do\minus{-}% - \do\point{.}% - \do\pounds{pounds}% - \do\print{-|}% - \do\quotedblbase{"}% - \do\quotedblleft{"}% - \do\quotedblright{"}% - \do\quoteleft{`}% - \do\quoteright{'}% - \do\quotesinglbase{,}% - \do\rbracechar{\}}% - \do\registeredsymbol{R}% - \do\result{=>}% - \do\textdegree{o}% % % We need to get rid of all macros, leaving only the arguments (if present). % Of course this is not nearly correct, but it is the best we can do for now. - % makeinfo does not expand macros in the argument to @deffn, which ends up - % writing an index entry, and texindex isn't prepared for an index sort entry - % that starts with \. % % Since macro invocations are followed by braces, we can just redefine them % to take a single TeX argument. The case of a macro invocation that % goes to end-of-line is not handled. % + \def\commondummyword##1{\let##1\asis}% \macrolist \let\value\indexnofontsvalue } -% Give the control sequence a definition that removes the {} that follows -% its use, e.g. @AA{} -> AA -\def\indexnofontsdef#1#2{\def#1##1{#2}}% - @@ -5250,7 +5232,10 @@ \xdef\trimmed{\segment}% \xdef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% \xdef\indexsortkey{\trimmed}% - \ifx\indexsortkey\empty\xdef\indexsortkey{ }\fi + \ifx\indexsortkey\empty + \message{Empty index sort key near line \the\inputlineno}% + \xdef\indexsortkey{ }% + \fi }\fi % % Append to \fullindexsortkey. @@ -5295,9 +5280,7 @@ % \atdummies % - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax\else - \escapeisbackslash - \fi + \ifflagclear{txiindexescapeisbackslash}{}{\escapeisbackslash}% % % For texindex which always views { and } as separators. \def\{{\lbracechar{}}% @@ -5481,9 +5464,9 @@ % old index files using \ as the escape character. Reading this would % at best lead to typesetting garbage, at worst a TeX syntax error. \def\printindexzz#1#2\finish{% - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax + \ifflagclear{txiindexescapeisbackslash}{% \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 - \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax + \ifflagclear{txiskipindexfileswithbackslash}{% \errmessage{% ERROR: A sorted index file in an obsolete format was skipped. To fix this problem, please upgrade your version of 'texi2dvi' @@ -5499,15 +5482,15 @@ If you continue to have problems, deleting the index files and starting again might help (with 'rm \jobname.?? \jobname.??s')% }% - \else + }{% (Skipped sorted index file in obsolete format) - \fi + }% \else \begindoublecolumns \input \jobname.\indexname s \enddoublecolumns \fi - \else + }{% \begindoublecolumns \catcode`\\=0\relax % @@ -5517,7 +5500,7 @@ \catcode`\@=0\relax \input \jobname.\indexname s \enddoublecolumns - \fi + }% } % These macros are used by the sorted index file itself. @@ -5592,6 +5575,11 @@ \newdimen\entryrightmargin \entryrightmargin=0pt +% for PDF output, whether to make the text of the entry a link to the page +% number. set for @contents and @shortcontents where there is only one +% page number. +\newif\iflinkentrytext + % \entry typesets a paragraph consisting of the text (#1), dot leaders, and % then page number (#2) flushed to the right margin. It is used for index % and table of contents entries. The paragraph is indented by \leftskip. @@ -5618,7 +5606,7 @@ } \def\entrybreak{\unskip\space\ignorespaces}% \def\doentry{% - % Save the text of the entry + % Save the text of the entry in \boxA \global\setbox\boxA=\hbox\bgroup \bgroup % Instead of the swallowed brace. \noindent @@ -5628,12 +5616,21 @@ % with catcodes occurring. } {\catcode`\@=11 +% #1 is the page number \gdef\finishentry#1{% - \egroup % end box A + \egroup % end \boxA \dimen@ = \wd\boxA % Length of text of entry + % add any leaders and page number to \boxA. \global\setbox\boxA=\hbox\bgroup - \unhbox\boxA - % #1 is the page number. + \ifpdforxetex + \iflinkentrytext + \pdflinkpage{#1}{\unhbox\boxA}% + \else + \unhbox\boxA + \fi + \else + \unhbox\boxA + \fi % % Get the width of the page numbers, and only use % leaders if they are present. @@ -5652,6 +5649,8 @@ \fi \fi \egroup % end \boxA + % + % now output \ifdim\wd\boxB = 0pt \noindent\unhbox\boxA\par \nobreak @@ -6351,7 +6350,7 @@ \fi } -\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname} +\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname\HEADINGSon} \def\CHAPPAGoff{% \global\let\contentsalignmacro = \chappager @@ -6368,7 +6367,7 @@ \global\let\pchapsepmacro=\chapoddpage \global\def\HEADINGSon{\HEADINGSdouble}} -\CHAPPAGon +\setchapternewpage on % \chapmacro - Chapter opening. % @@ -6381,6 +6380,16 @@ \def\Yappendixkeyword{Yappendix} \def\Yomitfromtockeyword{Yomitfromtoc} % +% +% Definitions for @thischapter. These can be overridden in translation +% files. +\def\thischapterAppendix{% + \putwordAppendix{} \thischapternum: \thischaptername} + +\def\thischapterChapter{% + \putwordChapter{} \thischapternum: \thischaptername} +% +% \def\chapmacro#1#2#3{% \expandafter\ifx\thisenv\titlepage\else \checkenv{}% chapters, etc., should not start inside an environment. @@ -6403,22 +6412,14 @@ \xdef\currentchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\appendixletter}% - % \noexpand\putwordAppendix avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordAppendix{} - \noexpand\thischapternum: - \noexpand\thischaptername}% + \let\noexpand\thischapter\noexpand\thischapterAppendix }% \else \toks0={#1}% \xdef\currentchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\the\chapno}% - % \noexpand\putwordChapter avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordChapter{} - \noexpand\thischapternum: - \noexpand\thischaptername}% + \let\noexpand\thischapter\noexpand\thischapterChapter }% \fi\fi\fi % @@ -6504,6 +6505,12 @@ \def\subsubsecheadingskip{\subsecheadingskip} \def\subsubsecheadingbreak{\subsecheadingbreak} +% Definition for @thissection. This can be overridden in translation +% files. +\def\thissectionDef{% + \putwordSection{} \thissectionnum: \thissectionname} +% + % Print any size, any type, section title. % @@ -6545,11 +6552,7 @@ \xdef\currentsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \else @@ -6558,11 +6561,7 @@ \xdef\currentsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \fi\fi\fi @@ -6748,8 +6747,14 @@ \def\thistitle{}% no title in double-sided headings % Record where the Roman numerals started. \ifnum\romancount=0 \global\romancount=\pagecount \fi + \linkentrytexttrue } +% \raggedbottom in plain.tex hardcodes \topskip so override it +\catcode`\@=11 +\def\raggedbottom{\advance\topskip by 0pt plus60pt \r@ggedbottomtrue} +\catcode`\@=\other + % redefined for the two-volume lispref. We always output on % \jobname.toc even if this is redefined. % @@ -6812,12 +6817,8 @@ % Get ready to use Arabic numerals again \def\contentsendroman{% \lastnegativepageno = \pageno - \global\pageno = \savepageno - % - % If \romancount > \arabiccount, the contents are at the end of the - % document. Otherwise, advance where the Arabic numerals start for - % the page numbers. - \ifnum\romancount>\arabiccount\else\global\arabiccount=\pagecount\fi + \global\pageno=1 + \contentsendcount = \pagecount } % Typeset the label for a chapter or appendix for the short contents. @@ -6870,7 +6871,7 @@ % Chapters, in the short toc. % See comments in \dochapentry re vbox and related settings. \def\shortchapentry#1#2#3#4{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}% + \tocentry{\shortchaplabel{#2}\labelspace #1}{#4}% } % Appendices, in the main contents. @@ -6885,7 +6886,7 @@ % Unnumbered chapters. \def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}} -\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}} +\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{#4}} % Sections. \def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}} @@ -6917,24 +6918,24 @@ % Move the page numbers slightly to the right \advance\entryrightmargin by -0.05em \chapentryfonts - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsecentry#1#2{\begingroup \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} \def\dosubsubsecentry#1#2{\begingroup \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% + \tocentry{#1}{#2}% \endgroup} % We use the same \entry macro as for the index entries. @@ -6943,9 +6944,6 @@ % Space between chapter (or whatever) number and the title. \def\labelspace{\hskip1em \relax} -\def\dopageno#1{{\rm #1}} -\def\doshortpageno#1{{\rm #1}} - \def\chapentryfonts{\secfonts \rm} \def\secentryfonts{\textfonts} \def\subsecentryfonts{\textfonts} @@ -7090,19 +7088,25 @@ \newdimen\cartouter\newdimen\cartinner \newskip\normbskip\newskip\normpskip\newskip\normlskip - -\envdef\cartouche{% +\envparseargdef\cartouche{% \cartouchefontdefs \ifhmode\par\fi % can't be in the midst of a paragraph. \startsavinginserts \lskip=\leftskip \rskip=\rightskip \leftskip=0pt\rightskip=0pt % we want these *outside*. + % + % Set paragraph width for text inside cartouche. There are + % left and right margins of 3pt each plus two vrules 0.4pt each. \cartinner=\hsize \advance\cartinner by-\lskip \advance\cartinner by-\rskip + \advance\cartinner by -6.8pt + % + % For drawing top and bottom of cartouche. Each corner char + % adds 6pt and we take off the width of a rule to line up with the + % right boundary perfectly. \cartouter=\hsize - \advance\cartouter by 18.4pt % allow for 3pt kerns on either - % side, and for 6pt waste from - % each corner char, and rule thickness + \advance\cartouter by 11.6pt + % \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip % % If this cartouche directly follows a sectioning command, we need the @@ -7110,20 +7114,23 @@ % collide with the section heading. \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi % - \setbox\groupbox=\vbox\bgroup + \setbox\groupbox=\vtop\bgroup \baselineskip=0pt\parskip=0pt\lineskip=0pt \carttop \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \kern3pt - \hsize=\cartinner - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip - \comment % For explanation, see the end of def\group. + \hskip\lskip + \vrule\kern3pt + \vbox\bgroup + \hsize=\cartinner + \baselineskip=\normbskip + \lineskip=\normlskip + \parskip=\normpskip + \def\arg{#1}% + \ifx\arg\empty\else + \centerV{\hfil \bf #1 \hfil}% + \fi + \kern3pt + \vskip -\parskip } \def\Ecartouche{% \ifhmode\par\fi @@ -7277,22 +7284,6 @@ } \let\Eraggedright\par -\envdef\raggedleft{% - \parindent=0pt \leftskip0pt plus2em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedleft\par - -\envdef\raggedcenter{% - \parindent=0pt \rightskip0pt plus1em \leftskip0pt plus1em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedcenter\par - % @quotation does normal linebreaking (hence we can't use \nonfillstart) % and narrows the margins. We keep \parskip nonzero in general, since @@ -7390,8 +7381,9 @@ \endgroup % \def\setupverb{% - \tt % easiest (and conventionally used) font for verbatim + \tt \def\par{\leavevmode\endgraf}% + \parindent = 0pt \setcodequotes \tabeightspaces % Respect line breaks, @@ -7515,9 +7507,11 @@ % file; b) letting users define the frontmatter in as flexible order as % possible is desirable. % -\def\copying{\checkenv{}\begingroup\scanargctxt\docopying} -\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}} -% +\def\copying{\checkenv{}\begingroup\macrobodyctxt\docopying} +{\catcode`\ =\other +\gdef\docopying#1@end copying{\endgroup\def\copyingtext{#1}} +} + \def\insertcopying{% \begingroup \parindent = 0pt % paragraph indentation looks wrong on title page @@ -7565,32 +7559,19 @@ \exdentamount=\defbodyindent } -\def\dodefunx#1{% - % First, check whether we are in the right environment: - \checkenv#1% - % - % As above, allow line break if we have multiple x headers in a row. - % It's not a great place, though. - \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi - % - % And now, it's time to reuse the body of the original defun: - \expandafter\gobbledefun#1% -} -\def\gobbledefun#1\startdefun{} - -% \printdefunline \deffnheader{text} +% Called as \printdefunline \deffooheader{text} % \def\printdefunline#1#2{% \begingroup \plainfrenchspacing - % call \deffnheader: + % call \deffooheader: #1#2 \endheader % common ending: \interlinepenalty = 10000 \advance\rightskip by 0pt plus 1fil\relax \endgraf \nobreak\vskip -\parskip - \penalty\defunpenalty % signal to \startdefun and \dodefunx + \penalty\defunpenalty % signal to \startdefun and \deffoox % Some of the @defun-type tags do not enable magic parentheses, % rendering the following check redundant. But we don't optimize. \checkparencounts @@ -7599,29 +7580,51 @@ \def\Edefun{\endgraf\medbreak} -% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn; -% the only thing remaining is to define \deffnheader. +% @defblock, @defline do not automatically create index entries +\envdef\defblock{% + \startdefun +} +\let\Edefblock\Edefun + +\def\defline{% + \doingtypefnfalse + \parseargusing\activeparens{\printdefunline\deflineheader}% +} +\def\deflineheader#1 #2 #3\endheader{% + \printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} +\def\deftypeline{% + \doingtypefntrue + \parseargusing\activeparens{\printdefunline\deflineheader}% +} + +% \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) } % +% Define \deffoo, \deffoox \Edeffoo and \deffooheader. \def\makedefun#1{% \expandafter\let\csname E#1\endcsname = \Edefun \edef\temp{\noexpand\domakedefun \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}% \temp } - -% \domakedefun \deffn \deffnx \deffnheader { (defn. of \deffnheader) } -% -% Define \deffn and \deffnx, without parameters. -% \deffnheader has to be defined explicitly. -% \def\domakedefun#1#2#3{% \envdef#1{% \startdefun \doingtypefnfalse % distinguish typed functions from all else \parseargusing\activeparens{\printdefunline#3}% }% - \def#2{\dodefunx#1}% - \def#3% + \def#2{% + % First, check whether we are in the right environment: + \checkenv#1% + % + % As in \startdefun, allow line break if we have multiple x headers + % in a row. It's not a great place, though. + \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi + % + \doingtypefnfalse % distinguish typed functions from all else + \parseargusing\activeparens{\printdefunline#3}% + }% + \def#3% definition of \deffooheader follows } \newif\ifdoingtypefn % doing typed function? @@ -7646,74 +7649,51 @@ \fi\fi } -% \dosubind {index}{topic}{subtopic} -% -% If SUBTOPIC is present, precede it with a space, and call \doind. -% (At some time during the 20th century, this made a two-level entry in an -% index such as the operation index. Nobody seemed to notice the change in -% behaviour though.) -\def\dosubind#1#2#3{% - \def\thirdarg{#3}% - \ifx\thirdarg\empty - \doind{#1}{#2}% - \else - \doind{#1}{#2\space#3}% - \fi -} - % Untyped functions: % @deffn category name args -\makedefun{deffn}{\deffngeneral{}} - -% @deffn category class name args -\makedefun{defop}#1 {\defopon{#1\ \putwordon}} - -% \defopon {category on}class name args -\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } +\makedefun{deffn}#1 #2 #3\endheader{% + \doind{fn}{\code{#2}}% + \printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} -% \deffngeneral {subind}category name args -% -\def\deffngeneral#1#2 #3 #4\endheader{% - \dosubind{fn}{\code{#3}}{#1}% - \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% +% @defop category class name args +\makedefun{defop}#1 {\defopheaderx{#1\ \putwordon}} +\def\defopheaderx#1#2 #3 #4\endheader{% + \doind{fn}{\code{#3}\space\putwordon\ \code{#2}}% + \printdefname{#1\ \code{#2}}{}{#3}\magicamp\defunargs{#4\unskip}% } % Typed functions: % @deftypefn category type name args -\makedefun{deftypefn}{\deftypefngeneral{}} +\makedefun{deftypefn}#1 #2 #3 #4\endheader{% + \doind{fn}{\code{#3}}% + \doingtypefntrue + \printdefname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @deftypeop category class type name args -\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}} - -% \deftypeopon {category on}class type name args -\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } - -% \deftypefngeneral {subind}category type name args -% -\def\deftypefngeneral#1#2 #3 #4 #5\endheader{% - \dosubind{fn}{\code{#4}}{#1}% +\makedefun{deftypeop}#1 {\deftypeopheaderx{#1\ \putwordon}} +\def\deftypeopheaderx#1#2 #3 #4 #5\endheader{% + \doind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}% \doingtypefntrue - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% + \printdefname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Typed variables: % @deftypevr category type var args -\makedefun{deftypevr}{\deftypecvgeneral{}} +\makedefun{deftypevr}#1 #2 #3 #4\endheader{% + \doind{vr}{\code{#3}}% + \printdefname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @deftypecv category class type var args -\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}} - -% \deftypecvof {category of}class type var args -\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} } - -% \deftypecvgeneral {subind}category type var args -% -\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{% - \dosubind{vr}{\code{#4}}{#1}% - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% +\makedefun{deftypecv}#1 {\deftypecvheaderx{#1\ \putwordof}} +\def\deftypecvheaderx#1#2 #3 #4 #5\endheader{% + \doind{vr}{\code{#4}\space\putwordof\ \code{#2}}% + \printdefname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Untyped variables: @@ -7722,17 +7702,15 @@ \makedefun{defvr}#1 {\deftypevrheader{#1} {} } % @defcv category class var args -\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}} - -% \defcvof {category of}class var args -\def\defcvof#1#2 {\deftypecvof{#1}#2 {} } +\makedefun{defcv}#1 {\defcvheaderx{#1\ \putwordof}} +\def\defcvheaderx#1#2 {\deftypecvheaderx{#1}#2 {} } % Types: % @deftp category name args \makedefun{deftp}#1 #2 #3\endheader{% \doind{tp}{\code{#2}}% - \defname{#1}{}{#2}\defunargs{#3\unskip}% + \printdefname{#1}{}{#2}\defunargs{#3\unskip}% } % Remaining @defun-like shortcuts: @@ -7743,19 +7721,19 @@ \makedefun{defvar}{\defvrheader{\putwordDefvar} } \makedefun{defopt}{\defvrheader{\putwordDefopt} } \makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} } -\makedefun{defmethod}{\defopon\putwordMethodon} -\makedefun{deftypemethod}{\deftypeopon\putwordMethodon} -\makedefun{defivar}{\defcvof\putwordInstanceVariableof} -\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof} +\makedefun{defmethod}{\defopheaderx\putwordMethodon} +\makedefun{deftypemethod}{\deftypeopheaderx\putwordMethodon} +\makedefun{defivar}{\defcvheaderx\putwordInstanceVariableof} +\makedefun{deftypeivar}{\deftypecvheaderx\putwordInstanceVariableof} -% \defname, which formats the name of the @def (not the args). +% \printdefname, which formats the name of the @def (not the args). % #1 is the category, such as "Function". % #2 is the return type, if any. % #3 is the function name. % % We are followed by (but not passed) the arguments, if any. % -\def\defname#1#2#3{% +\def\printdefname#1#2#3{% \par % Get the values of \leftskip and \rightskip as they were outside the @def... \advance\leftskip by -\defbodyindent @@ -7765,9 +7743,7 @@ \rettypeownlinefalse \ifdoingtypefn % doing a typed function specifically? % then check user option for putting return type on its own line: - \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else - \rettypeownlinetrue - \fi + \ifflagclear{txideftypefnnl}{}{\rettypeownlinetrue}% \fi % % How we'll format the category name. Putting it in brackets helps @@ -7832,30 +7808,22 @@ \fi % no return type #3% output function name }% - {\rm\enskip}% hskip 0.5 em of \rmfont + \ifflagclear{txidefnamenospace}{% + {\rm\enskip}% hskip 0.5 em of \rmfont + }{}% % \boldbrax % arguments will be output next, if any. } -% Print arguments in slanted roman (not ttsl), inconsistently with using -% tt for the name. This is because literal text is sometimes needed in -% the argument list (groff manual), and ttsl and tt are not very -% distinguishable. Prevent hyphenation at `-' chars. -% +% Print arguments. Use slanted for @def*, typewriter for @deftype*. \def\defunargs#1{% - % use sl by default (not ttsl), - % tt for the names. - \df \sl \hyphenchar\font=0 - % - % On the other hand, if an argument has two dashes (for instance), we - % want a way to get ttsl. We used to recommend @var for that, so - % leave the code in, but it's strange for @var to lead to typewriter. - % Nowadays we recommend @code, since the difference between a ttsl hyphen - % and a tt hyphen is pretty tiny. @code also disables ?` !`. - \def\var##1{{\setregularquotes\ttslanted{##1}}}% - #1% - \sl\hyphenchar\font=45 + \bgroup + \df \ifdoingtypefn \tt \else \sl \fi + \ifflagclear{txicodevaristt}{}% + {\def\var##1{{\setregularquotes \ttsl ##1}}}% + #1% + \egroup } % We want ()&[] to print specially on the defun line. @@ -7874,9 +7842,12 @@ % so TeX would otherwise complain about undefined control sequence. { \activeparens - \global\let(=\lparen \global\let)=\rparen - \global\let[=\lbrack \global\let]=\rbrack - \global\let& = \& + \gdef\defcharsdefault{% + \let(=\lparen \let)=\rparen + \let[=\lbrack \let]=\rbrack + \let& = \&% + } + \globaldefs=1 \defcharsdefault \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} @@ -7887,7 +7858,7 @@ % If we encounter &foo, then turn on ()-hacking afterwards \newif\ifampseen -\def\amprm#1 {\ampseentrue{\bf\ }} +\def\amprm#1 {\ampseentrue{\rm\ }} \def\parenfont{% \ifampseen @@ -8060,24 +8031,17 @@ \catcode`\_=\other \catcode`\|=\other \catcode`\~=\other - \passthroughcharstrue -} - -\def\scanargctxt{% used for copying and captions, not macros. - \scanctxt \catcode`\@=\other - \catcode`\\=\other \catcode`\^^M=\other + \catcode`\\=\active + \passthroughcharstrue } -\def\macrobodyctxt{% used for @macro definitions +\def\macrobodyctxt{% used for @macro definitions and @copying \scanctxt \catcode`\ =\other - \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other - \catcode`\^^M=\other - \usembodybackslash } % Used when scanning braced macro arguments. Note, however, that catcode @@ -8086,14 +8050,10 @@ \def\macroargctxt{% \scanctxt \catcode`\ =\active - \catcode`\@=\other - \catcode`\^^M=\other - \catcode`\\=\active } \def\macrolineargctxt{% used for whole-line arguments without braces \scanctxt - \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other } @@ -8137,7 +8097,7 @@ \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% \addtomacrolist{\the\macname}% \fi - \begingroup \macrobodyctxt + \begingroup \macrobodyctxt \usembodybackslash \ifrecursive \expandafter\parsermacbody \else \expandafter\parsemacbody \fi} @@ -8222,12 +8182,12 @@ % % We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro % body to be transformed. -% Set \macrobody to the body of the macro, and call \defmacro. +% Set \macrobody to the body of the macro, and call \macrodef. % {\catcode`\ =\other\long\gdef\parsemacbody#1@end macro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% +\xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% {\catcode`\ =\other\long\gdef\parsermacbody#1@end rmacro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% +\xdef\macrobody{\eatcr{#1}}\endgroup\macrodef}}% % Make @ a letter, so that we can make private-to-Texinfo macro names. \edef\texiatcatcode{\the\catcode`\@} @@ -8446,35 +8406,36 @@ % \xdef is used so that macro definitions will survive the file % they're defined in: @include reads the file inside a group. % -\def\defmacro{% +\def\macrodef{% \let\hash=##% convert placeholders to macro parameter chars \ifnum\paramno=1 - \def\xeatspaces##1{##1}% - % This removes the pair of braces around the argument. We don't - % use \eatspaces, because this can cause ends of lines to be lost - % when the argument to \eatspaces is read, leading to line-based - % commands like "@itemize" not being read correctly. + \long\def\xeatspaces##1{##1}% + % We don't use \xeatspaces for single-argument macros, because we + % want to keep ends of lines. This definition removes \xeatspaces + % when \macrobody is expanded below. \else - \let\xeatspaces\relax % suppress expansion + \def\xeatspaces{\string\xeatspaces}% + % This expands \xeatspaces as a sequence of character tokens, which + % stops \scantokens inserting an extra space after the control sequence. \fi \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\spaceisspace \noexpand\endlineisspace \noexpand\expandafter % skip any whitespace after the macro name. \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname{% - \egroup + \endgroup \noexpand\scanmacro{\macrobody}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\braceorline \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \egroup + \endgroup \noexpand\scanmacro{\macrobody}% }% \else % at most 9 @@ -8485,7 +8446,7 @@ % @MACNAME@@@ removes braces surrounding the argument list. % @MACNAME@@@@ scans the macro body with arguments substituted. \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\expandafter % This \expandafter skip any spaces after the \noexpand\macroargctxt % macro before we change the catcode of space. \noexpand\expandafter @@ -8499,7 +8460,7 @@ \expandafter\xdef \expandafter\expandafter \csname\the\macname @@@@\endcsname\paramlist{% - \egroup\noexpand\scanmacro{\macrobody}}% + \endgroup\noexpand\scanmacro{\macrobody}}% \else % 10 or more: \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\getargvals@{\the\macname}{\argl}% @@ -8621,6 +8582,75 @@ \fi \macnamexxx} +% @linemacro + +\parseargdef\linemacro{% + \getargs{#1}% now \macname is the macname and \argl the arglist + \ifx\argl\empty + \paramno=0 + \let\hash\relax + \def\paramlist{\hash 1\endlinemacro}% + \else + \expandafter\linegetparamlist\argl;% + \fi + \begingroup \macrobodyctxt \usembodybackslash + \parselinemacrobody +} + +% Build up \paramlist which will be used as the parameter text for the macro. +% At the end it will be like "#1 #2 #3\endlinemacro". +\def\linegetparamlist#1;{% + \paramno=0\def\paramlist{}% + \let\hash\relax + \linegetparamlistxxx#1,;,% +} +\def\linegetparamlistxxx#1,{% + \if#1;\let\next=\linegetparamlistxxxx + \else \let\next=\linegetparamlistxxx + \advance\paramno by 1 + \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname + {\hash\the\paramno}% + \edef\paramlist{\paramlist\hash\the\paramno\space}% + \fi\next} +\def\linegetparamlistxxxx{% + \expandafter\fixparamlist\paramlist\fixparamlist +} +% Replace final space token +\def\fixparamlist#1 \fixparamlist{% + \def\paramlist{#1\endlinemacro}% +} + +% Read the body of the macro, replacing backslash-surrounded variables +% +{\catcode`\ =\other\long\gdef\parselinemacrobody#1@end linemacro{% +\xdef\macrobody{#1}% +\endgroup +\linemacrodef +}} + +% Make the definition +\def\linemacrodef{% + \let\hash=##% + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup + \noexpand\parsearg + \expandafter\noexpand\csname\the\macname @@\endcsname + } + \expandafter\xdef\csname\the\macname @@\endcsname##1{% + \egroup + \expandafter\noexpand + \csname\the\macname @@@\endcsname##1\noexpand\endlinemacro + } + \expandafter\expandafter + \expandafter\xdef + \expandafter\expandafter\csname\the\macname @@@\endcsname\paramlist{% + \newlinechar=13 % split \macrobody into lines + \noexpand\scantokens{\macrobody}% + } +} + + + % @alias. % We need some trickery to remove the optional spaces around the equal % sign. Make them active and then expand them all to nothing. @@ -8941,12 +8971,11 @@ % output the `[mynode]' via the macro below so it can be overridden. \xrefprintnodename\printedrefname % - \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax - % But we always want a comma and a space: - ,\space - % + \ifflagclear{txiomitxrefpg}{% + % We always want a comma + ,% % output the `page 3'. - \turnoffactive \putwordpage\tie\refx{#1-pg}% + \turnoffactive \putpageref{#1}% % Add a , if xref followed by a space \if\space\noexpand\tokenafterxref ,% \else\ifx\ \tokenafterxref ,% @TAB @@ -8956,12 +8985,16 @@ \tokenafterxref ,% @NL \else\ifx\tie\tokenafterxref ,% @tie \fi\fi\fi\fi\fi\fi - \fi + }{}% \fi\fi \fi \endlink \endgroup} +% can be overridden in translation files +\def\putpageref#1{% + \space\putwordpage\tie\refx{#1-pg}} + % Output a cross-manual xref to #1. Used just above (twice). % % Only include the text "Section ``foo'' in" if the foo is neither @@ -9373,6 +9406,12 @@ \imagexxx #1,,,,,\finish \fi } + +% Approximate height of a line in the standard text font. +\newdimen\capheight +\setbox0=\vbox{\tenrm H} +\capheight=\ht0 + % % Arguments to @image: % #1 is (mandatory) image filename; we tack on .eps extension. @@ -9387,13 +9426,6 @@ \makevalueexpandable \ifvmode \imagevmodetrue - \else \ifx\centersub\centerV - % for @center @image, we need a vbox so we can have our vertical space - \imagevmodetrue - \vbox\bgroup % vbox has better behavior than vtop here - \fi\fi - % - \ifimagevmode \medskip % Usually we'll have text after the image which will insert % \parskip glue, so insert it here too to equalize the space @@ -9402,17 +9434,20 @@ % % Place image in a \vtop for a top page margin that is (close to) correct, % as \topskip glue is relative to the first baseline. - \vtop\bgroup\hrule height 0pt\vskip-\parskip + \vtop\bgroup \kern -\capheight \vskip-\parskip \fi % - % Enter horizontal mode so that indentation from an enclosing - % environment such as @quotation is respected. - % However, if we're at the top level, we don't want the - % normal paragraph indentation. - % On the other hand, if we are in the case of @center @image, we don't - % want to start a paragraph, which will create a hsize-width box and - % eradicate the centering. - \ifx\centersub\centerV \else \imageindent \fi + \ifx\centersub\centerV + % For @center @image, enter vertical mode and add vertical space + % Enter an extra \parskip because @center doesn't add space itself. + \vbox\bgroup\vskip\parskip\medskip\vskip\parskip + \else + % Enter horizontal mode so that indentation from an enclosing + % environment such as @quotation is respected. + % However, if we're at the top level, we don't want the + % normal paragraph indentation. + \imageindent + \fi % % Output the image. \ifpdf @@ -9437,7 +9472,10 @@ \egroup \medskip % space after a standalone image \fi - \ifx\centersub\centerV \egroup \fi + \ifx\centersub\centerV % @center @image + \medskip + \egroup % close \vbox + \fi \endgroup} @@ -9604,8 +9642,8 @@ % \def\caption{\docaption\thiscaption} \def\shortcaption{\docaption\thisshortcaption} -\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption} -\def\defcaption#1#2{\egroup \def#1{#2}} +\def\docaption{\checkenv\float \bgroup\scanctxt\docaptionz} +\def\docaptionz#1#2{\egroup \def#1{#2}} % The parameter is the control sequence identifying the counter we are % going to use. Create it if it doesn't exist and assign it to \floatno. @@ -9894,12 +9932,10 @@ % For native Unicode handling (XeTeX and LuaTeX) \nativeunicodechardefs \else - % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX) + % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX). + % Since we already invoke \utfeightchardefs at the top level, + % making non-ascii chars active is sufficient. \setnonasciicharscatcode\active - % since we already invoked \utfeightchardefs at the top level - % (below), do not re-invoke it, otherwise our check for duplicated - % definitions gets triggered. Making non-ascii chars active is - % sufficient. \fi % \else @@ -9924,7 +9960,6 @@ \fi } -% emacs-page % A message to be logged when using a character that isn't available % the default font encoding (OT1). % @@ -9933,12 +9968,6 @@ % Take account of \c (plain) vs. \, (Texinfo) difference. \def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi} -% First, make active non-ASCII characters in order for them to be -% correctly categorized when TeX reads the replacement text of -% macros containing the character definitions. -\setnonasciicharscatcode\active -% - \def\gdefchar#1#2{% \gdef#1{% \ifpassthroughchars @@ -9948,8 +9977,14 @@ \fi }} +\begingroup + +% Make non-ASCII characters active for defining the character definition +% macros. +\setnonasciicharscatcode\active + % Latin1 (ISO-8859-1) character definitions. -\def\latonechardefs{% +\gdef\latonechardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\exclamdown} \gdefchar^^a2{{\tcfont \char162}} % cent @@ -10054,7 +10089,7 @@ } % Latin9 (ISO-8859-15) encoding character definitions. -\def\latninechardefs{% +\gdef\latninechardefs{% % Encoding is almost identical to Latin1. \latonechardefs % @@ -10069,7 +10104,7 @@ } % Latin2 (ISO-8859-2) character definitions. -\def\lattwochardefs{% +\gdef\lattwochardefs{% \gdefchar^^a0{\tie} \gdefchar^^a1{\ogonek{A}} \gdefchar^^a2{\u{}} @@ -10087,7 +10122,7 @@ \gdefchar^^ae{\v Z} \gdefchar^^af{\dotaccent Z} % - \gdefchar^^b0{\textdegree{}} + \gdefchar^^b0{\textdegree} \gdefchar^^b1{\ogonek{a}} \gdefchar^^b2{\ogonek{ }} \gdefchar^^b3{\l} @@ -10173,6 +10208,8 @@ \gdefchar^^ff{\dotaccent{}} } +\endgroup % active chars + % UTF-8 character definitions. % % This code to support UTF-8 is based on LaTeX's utf8.def, with some @@ -10324,9 +10361,9 @@ % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp % to the corresponding UTF-8 sequence. \gdef\parseXMLCharref{% - \ifnum\countUTFz < "A0\relax + \ifnum\countUTFz < "20\relax \errhelp = \EMsimple - \errmessage{Cannot define Unicode char value < 00A0}% + \errmessage{Cannot define Unicode char value < 0020}% \else\ifnum\countUTFz < "800\relax \parseUTFviiiA,% \parseUTFviiiB C\UTFviiiTwoOctetsName.,% @@ -10396,6 +10433,103 @@ % least make most of the characters not bomb out. % \def\unicodechardefs{% + \DeclareUnicodeCharacter{0020}{ } % space + \DeclareUnicodeCharacter{0021}{\char"21 }% % space to terminate number + \DeclareUnicodeCharacter{0022}{\char"22 }% + \DeclareUnicodeCharacter{0023}{\char"23 }% + \DeclareUnicodeCharacter{0024}{\char"24 }% + \DeclareUnicodeCharacter{0025}{\char"25 }% + \DeclareUnicodeCharacter{0026}{\char"26 }% + \DeclareUnicodeCharacter{0027}{\char"27 }% + \DeclareUnicodeCharacter{0028}{\char"28 }% + \DeclareUnicodeCharacter{0029}{\char"29 }% + \DeclareUnicodeCharacter{002A}{\char"2A }% + \DeclareUnicodeCharacter{002B}{\char"2B }% + \DeclareUnicodeCharacter{002C}{\char"2C }% + \DeclareUnicodeCharacter{002D}{\char"2D }% + \DeclareUnicodeCharacter{002E}{\char"2E }% + \DeclareUnicodeCharacter{002F}{\char"2F }% + \DeclareUnicodeCharacter{0030}{0}% + \DeclareUnicodeCharacter{0031}{1}% + \DeclareUnicodeCharacter{0032}{2}% + \DeclareUnicodeCharacter{0033}{3}% + \DeclareUnicodeCharacter{0034}{4}% + \DeclareUnicodeCharacter{0035}{5}% + \DeclareUnicodeCharacter{0036}{6}% + \DeclareUnicodeCharacter{0037}{7}% + \DeclareUnicodeCharacter{0038}{8}% + \DeclareUnicodeCharacter{0039}{9}% + \DeclareUnicodeCharacter{003A}{\char"3A }% + \DeclareUnicodeCharacter{003B}{\char"3B }% + \DeclareUnicodeCharacter{003C}{\char"3C }% + \DeclareUnicodeCharacter{003D}{\char"3D }% + \DeclareUnicodeCharacter{003E}{\char"3E }% + \DeclareUnicodeCharacter{003F}{\char"3F }% + \DeclareUnicodeCharacter{0040}{\char"40 }% + \DeclareUnicodeCharacter{0041}{A}% + \DeclareUnicodeCharacter{0042}{B}% + \DeclareUnicodeCharacter{0043}{C}% + \DeclareUnicodeCharacter{0044}{D}% + \DeclareUnicodeCharacter{0045}{E}% + \DeclareUnicodeCharacter{0046}{F}% + \DeclareUnicodeCharacter{0047}{G}% + \DeclareUnicodeCharacter{0048}{H}% + \DeclareUnicodeCharacter{0049}{I}% + \DeclareUnicodeCharacter{004A}{J}% + \DeclareUnicodeCharacter{004B}{K}% + \DeclareUnicodeCharacter{004C}{L}% + \DeclareUnicodeCharacter{004D}{M}% + \DeclareUnicodeCharacter{004E}{N}% + \DeclareUnicodeCharacter{004F}{O}% + \DeclareUnicodeCharacter{0050}{P}% + \DeclareUnicodeCharacter{0051}{Q}% + \DeclareUnicodeCharacter{0052}{R}% + \DeclareUnicodeCharacter{0053}{S}% + \DeclareUnicodeCharacter{0054}{T}% + \DeclareUnicodeCharacter{0055}{U}% + \DeclareUnicodeCharacter{0056}{V}% + \DeclareUnicodeCharacter{0057}{W}% + \DeclareUnicodeCharacter{0058}{X}% + \DeclareUnicodeCharacter{0059}{Y}% + \DeclareUnicodeCharacter{005A}{Z}% + \DeclareUnicodeCharacter{005B}{\char"5B }% + \DeclareUnicodeCharacter{005C}{\char"5C }% + \DeclareUnicodeCharacter{005D}{\char"5D }% + \DeclareUnicodeCharacter{005E}{\char"5E }% + \DeclareUnicodeCharacter{005F}{\char"5F }% + \DeclareUnicodeCharacter{0060}{\char"60 }% + \DeclareUnicodeCharacter{0061}{a}% + \DeclareUnicodeCharacter{0062}{b}% + \DeclareUnicodeCharacter{0063}{c}% + \DeclareUnicodeCharacter{0064}{d}% + \DeclareUnicodeCharacter{0065}{e}% + \DeclareUnicodeCharacter{0066}{f}% + \DeclareUnicodeCharacter{0067}{g}% + \DeclareUnicodeCharacter{0068}{h}% + \DeclareUnicodeCharacter{0069}{i}% + \DeclareUnicodeCharacter{006A}{j}% + \DeclareUnicodeCharacter{006B}{k}% + \DeclareUnicodeCharacter{006C}{l}% + \DeclareUnicodeCharacter{006D}{m}% + \DeclareUnicodeCharacter{006E}{n}% + \DeclareUnicodeCharacter{006F}{o}% + \DeclareUnicodeCharacter{0070}{p}% + \DeclareUnicodeCharacter{0071}{q}% + \DeclareUnicodeCharacter{0072}{r}% + \DeclareUnicodeCharacter{0073}{s}% + \DeclareUnicodeCharacter{0074}{t}% + \DeclareUnicodeCharacter{0075}{u}% + \DeclareUnicodeCharacter{0076}{v}% + \DeclareUnicodeCharacter{0077}{w}% + \DeclareUnicodeCharacter{0078}{x}% + \DeclareUnicodeCharacter{0079}{y}% + \DeclareUnicodeCharacter{007A}{z}% + \DeclareUnicodeCharacter{007B}{\char"7B }% + \DeclareUnicodeCharacter{007C}{\char"7C }% + \DeclareUnicodeCharacter{007D}{\char"7D }% + \DeclareUnicodeCharacter{007E}{\char"7E }% + % \DeclareUnicodeCharacter{007F}{} % DEL + % \DeclareUnicodeCharacter{00A0}{\tie}% \DeclareUnicodeCharacter{00A1}{\exclamdown}% \DeclareUnicodeCharacter{00A2}{{\tcfont \char162}}% 0242=cent @@ -10413,7 +10547,7 @@ \DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}% \DeclareUnicodeCharacter{00AF}{\={ }}% % - \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}% + \DeclareUnicodeCharacter{00B0}{\textdegree}% \DeclareUnicodeCharacter{00B1}{\ensuremath\pm}% \DeclareUnicodeCharacter{00B2}{$^2$}% \DeclareUnicodeCharacter{00B3}{$^3$}% @@ -10917,7 +11051,7 @@ % \DeclareUnicodeCharacter{20AC}{\euro{}}% % - \DeclareUnicodeCharacter{2192}{\expansion{}}% + \DeclareUnicodeCharacter{2192}{\arrow}% \DeclareUnicodeCharacter{21D2}{\result{}}% % % Mathematical symbols @@ -11080,24 +11214,26 @@ % provide a definition macro to replace/pass-through a Unicode character % \def\DeclareUnicodeCharacterNative#1#2{% - \catcode"#1=\active - \def\dodeclareunicodecharacternative##1##2##3{% + \ifnum"#1>"7F % only make non-ASCII chars active + \catcode"#1=\active + \def\dodeclareunicodecharacternative##1##2##3{% + \begingroup + \uccode`\~="##2\relax + \uppercase{\gdef~}{% + \ifpassthroughchars + ##1% + \else + ##3% + \fi + } + \endgroup + } \begingroup - \uccode`\~="##2\relax - \uppercase{\gdef~}{% - \ifpassthroughchars - ##1% - \else - ##3% - \fi - } + \uccode`\.="#1\relax + \uppercase{\def\UTFNativeTmp{.}}% + \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% \endgroup - } - \begingroup - \uccode`\.="#1\relax - \uppercase{\def\UTFNativeTmp{.}}% - \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% - \endgroup + \fi } % Native Unicode handling (XeTeX and LuaTeX) character replacing definition. @@ -11126,14 +11262,14 @@ \relax } -% Define all Unicode characters we know about. This makes UTF-8 the default -% input encoding and allows @U to work. +% Define all Unicode characters we know about \iftxinativeunicodecapable \nativeunicodechardefsatu \else \utfeightchardefs \fi + \message{formatting,} \newdimen\defaultparindent \defaultparindent = 15pt @@ -11180,13 +11316,9 @@ % \vsize = #1\relax \advance\vsize by \topskip - \outervsize = \vsize - \advance\outervsize by 2\topandbottommargin \txipageheight = \vsize % \hsize = #2\relax - \outerhsize = \hsize - \advance\outerhsize by 0.5in \txipagewidth = \hsize % \normaloffset = #4\relax @@ -11276,7 +11408,7 @@ \textleading = 12.5pt % \internalpagesizes{160mm}{120mm}% - {\voffset}{\hoffset}% + {\voffset}{-11.4mm}% {\bindingoffset}{8pt}% {210mm}{148mm}% % @@ -11355,9 +11487,138 @@ \hfuzz = 1pt +\message{microtype,} + +% protrusion, from Thanh's protcode.tex. +\def\mtsetprotcode#1{% + \rpcode#1`\!=200 \rpcode#1`\,=700 \rpcode#1`\-=700 \rpcode#1`\.=700 + \rpcode#1`\;=500 \rpcode#1`\:=500 \rpcode#1`\?=200 + \rpcode#1`\'=700 + \rpcode#1 34=500 % '' + \rpcode#1 123=300 % -- + \rpcode#1 124=200 % --- + \rpcode#1`\)=50 \rpcode#1`\A=50 \rpcode#1`\F=50 \rpcode#1`\K=50 + \rpcode#1`\L=50 \rpcode#1`\T=50 \rpcode#1`\V=50 \rpcode#1`\W=50 + \rpcode#1`\X=50 \rpcode#1`\Y=50 \rpcode#1`\k=50 \rpcode#1`\r=50 + \rpcode#1`\t=50 \rpcode#1`\v=50 \rpcode#1`\w=50 \rpcode#1`\x=50 + \rpcode#1`\y=50 + % + \lpcode#1`\`=700 + \lpcode#1 92=500 % `` + \lpcode#1`\(=50 \lpcode#1`\A=50 \lpcode#1`\J=50 \lpcode#1`\T=50 + \lpcode#1`\V=50 \lpcode#1`\W=50 \lpcode#1`\X=50 \lpcode#1`\Y=50 + \lpcode#1`\v=50 \lpcode#1`\w=50 \lpcode#1`\x=50 \lpcode#1`\y=0 + % + \mtadjustprotcode#1\relax +} + +\newcount\countC +\def\mtadjustprotcode#1{% + \countC=0 + \loop + \ifcase\lpcode#1\countC\else + \mtadjustcp\lpcode#1\countC + \fi + \ifcase\rpcode#1\countC\else + \mtadjustcp\rpcode#1\countC + \fi + \advance\countC 1 + \ifnum\countC < 256 \repeat +} + +\newcount\countB +\def\mtadjustcp#1#2#3{% + \setbox\boxA=\hbox{% + \ifx#2\font\else#2\fi + \char#3}% + \countB=\wd\boxA + \multiply\countB #1#2#3\relax + \divide\countB \fontdimen6 #2\relax + #1#2#3=\countB\relax +} + +\ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\pdffontexpand#1 20 20 1 autoexpand\relax} + \else % TeX + \def\mtfontexpand#1{} + \fi + \else % LuaTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} + \fi +\else % XeTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{} +\fi + + +\newif\ifmicrotype + +\def\microtypeON{% + \microtypetrue + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=2 + \pdfprotrudechars=2 + \fi + \else % LuaTeX + \adjustspacing=2 + \protrudechars=2 + \fi + \else % XeTeX + \XeTeXprotrudechars=2 + \fi + % + \mtfontexpand\textrm + \mtfontexpand\textsl + \mtfontexpand\textbf +} + +\def\microtypeOFF{% + \microtypefalse + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=0 + \pdfprotrudechars=0 + \fi + \else % LuaTeX + \adjustspacing=0 + \protrudechars=0 + \fi + \else % XeTeX + \XeTeXprotrudechars=0 + \fi +} + +\microtypeOFF + +\parseargdef\microtype{% + \def\txiarg{#1}% + \ifx\txiarg\onword + \microtypeON + \else\ifx\txiarg\offword + \microtypeOFF + \else + \errhelp = \EMsimple + \errmessage{Unknown @microtype option `\txiarg', must be on|off}% + \fi\fi +} + + \message{and turning on texinfo input format.} +% Make UTF-8 the default encoding. +\documentencodingzzz{UTF-8} + \def^^L{\par} % remove \outer, so ^L can appear in an @comment +\catcode`\^^K = 10 % treat vertical tab as whitespace % DEL is a comment character, in case @c does not suffice. \catcode`\^^? = 14 @@ -11373,23 +11634,6 @@ \catcode`\|=\other \def\normalverticalbar{|} \catcode`\~=\other \def\normaltilde{~} -% This macro is used to make a character print one way in \tt -% (where it can probably be output as-is), and another way in other fonts, -% where something hairier probably needs to be done. -% -% #1 is what to print if we are indeed using \tt; #2 is what to print -% otherwise. Since all the Computer Modern typewriter fonts have zero -% interword stretch (and shrink), and it is reasonable to expect all -% typewriter fonts to have this, we can check that font parameter. -% -\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} - -% Same as above, but check for italic font. Actually this also catches -% non-italic slanted fonts since it is impossible to distinguish them from -% italic fonts. But since this is only used by $ and it uses \sl anyway -% this is not a problem. -\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} - % Set catcodes for Texinfo file % Active characters for printing the wanted glyph. @@ -11435,23 +11679,32 @@ % Used sometimes to turn off (effectively) the active characters even after % parsing them. \def\turnoffactive{% - \normalturnoffactive + \passthroughcharstrue + \let-=\normaldash + \let"=\normaldoublequote + \let$=\normaldollar %$ font-lock fix + \let+=\normalplus + \let<=\normalless + \let>=\normalgreater + \let^=\normalcaret + \let_=\normalunderscore + \let|=\normalverticalbar + \let~=\normaltilde \otherbackslash + \setregularquotes + \unsepspaces } -\catcode`\@=0 +% If a .fmt file is being used, characters that might appear in a file +% name cannot be active until we have parsed the command line. +% So turn them off again, and have \loadconf turn them back on. +\catcode`+=\other \catcode`\_=\other + % \backslashcurfont outputs one backslash character in current font, % as in \char`\\. \global\chardef\backslashcurfont=`\\ -% \realbackslash is an actual character `\' with catcode other. -{\catcode`\\=\other @gdef@realbackslash{\}} - -% In Texinfo, backslash is an active character; it prints the backslash -% in fixed width font. -\catcode`\\=\active % @ for escape char from now on. - % Print a typewriter backslash. For math mode, we can't simply use % \backslashcurfont: the story here is that in math mode, the \char % of \backslashcurfont ends up printing the roman \ from the math symbol @@ -11461,109 +11714,120 @@ % ignored family value; char position "5C). We can't use " for the % usual hex value because it has already been made active. -@def@ttbackslash{{@tt @ifmmode @mathchar29020 @else @backslashcurfont @fi}} -@let@backslashchar = @ttbackslash % @backslashchar{} is for user documents. +\def\ttbackslash{{\tt \ifmmode \mathchar29020 \else \backslashcurfont \fi}} +\let\backslashchar = \ttbackslash % \backslashchar{} is for user documents. -% \otherbackslash defines an active \ to be a literal `\' character with -% catcode other. -@gdef@otherbackslash{@let\=@realbackslash} - -% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of -% the literal character `\'. -% -{@catcode`- = @active - @gdef@normalturnoffactive{% - @passthroughcharstrue - @let-=@normaldash - @let"=@normaldoublequote - @let$=@normaldollar %$ font-lock fix - @let+=@normalplus - @let<=@normalless - @let>=@normalgreater - @let^=@normalcaret - @let_=@normalunderscore - @let|=@normalverticalbar - @let~=@normaltilde - @let\=@ttbackslash - @setregularquotes - @unsepspaces - } -} - -% If a .fmt file is being used, characters that might appear in a file -% name cannot be active until we have parsed the command line. -% So turn them off again, and have @fixbackslash turn them back on. -@catcode`+=@other @catcode`@_=@other - -% \enablebackslashhack - allow file to begin `\input texinfo' -% -% If a .fmt file is being used, we don't want the `\input texinfo' to show up. -% That is what \eatinput is for; after that, the `\' should revert to printing -% a backslash. -% If the file did not have a `\input texinfo', then it is turned off after -% the first line; otherwise the first `\' in the file would cause an error. -% This is used on the very last line of this file, texinfo.tex. -% We also use @c to call @fixbackslash, in case ends of lines are hidden. -{ -@catcode`@^=7 -@catcode`@^^M=13@gdef@enablebackslashhack{% - @global@let\ = @eatinput% - @catcode`@^^M=13% - @def@c{@fixbackslash@c}% - % Definition for the newline at the end of this file. - @def ^^M{@let^^M@secondlinenl}% - % Definition for a newline in the main Texinfo file. - @gdef @secondlinenl{@fixbackslash}% +% These are made active for url-breaking, so need +% active definitions as the normal characters. +\def\normaldot{.} +\def\normalquest{?} +\def\normalslash{/} + +% \newlinesloadsconf - call \loadconf as soon as possible in the +% file, e.g. at the first newline. +% +{\catcode`\^=7 +\catcode`\^^M=13 +\gdef\newlineloadsconf{% + \catcode`\^^M=13 % + \newlineloadsconfzz% +} +\gdef\newlineloadsconfzz#1^^M{% + \def\c{\loadconf\c}% + % Definition for the first newline read in the file + \def ^^M{\loadconf}% % In case the first line has a whole-line command on it - @let@originalparsearg@parsearg - @def@parsearg{@fixbackslash@originalparsearg} + \let\originalparsearg\parsearg% + \def\parsearg{\loadconf\originalparsearg}% }} -{@catcode`@^=7 @catcode`@^^M=13% -@gdef@eatinput input texinfo#1^^M{@fixbackslash}} % Emergency active definition of newline, in case an active newline token % appears by mistake. -{@catcode`@^=7 @catcode13=13% -@gdef@enableemergencynewline{% - @gdef^^M{% - @par% - %@par% +{\catcode`\^=7 \catcode13=13% +\gdef\enableemergencynewline{% + \gdef^^M{% + \par% + %\par% }}} -@gdef@fixbackslash{% - @ifx\@eatinput @let\ = @ttbackslash @fi - @catcode13=5 % regular end of line - @enableemergencynewline - @let@c=@comment - @let@parsearg@originalparsearg +% \loadconf gets called at the beginning of every Texinfo file. +% If texinfo.cnf is present on the system, read it. Useful for site-wide +% @afourpaper, etc. Not opening texinfo.cnf directly in texinfo.tex +% makes it possible to make a format file for Texinfo. +% +\gdef\loadconf{% + \relax % Terminate the filename if running as "tex '&texinfo' FILE.texi". + % + % Turn off the definitions that trigger \loadconf + \everyjobreset + \catcode13=5 % regular end of line + \enableemergencynewline + \let\c=\comment + \let\parsearg\originalparsearg + % % Also turn back on active characters that might appear in the input % file name, in case not using a pre-dumped format. - @catcode`+=@active - @catcode`@_=@active - % - % If texinfo.cnf is present on the system, read it. - % Useful for site-wide @afourpaper, etc. This macro, @fixbackslash, gets - % called at the beginning of every Texinfo file. Not opening texinfo.cnf - % directly in this file, texinfo.tex, makes it possible to make a format - % file for Texinfo. + \catcode`+=\active + \catcode`\_=\active % - @openin 1 texinfo.cnf - @ifeof 1 @else @input texinfo.cnf @fi - @closein 1 + \openin 1 texinfo.cnf + \ifeof 1 \else \input texinfo.cnf \fi + \closein 1 } +% Redefine some control sequences to be controlled by the \ifdummies +% and \ifindexnofonts switches. Do this at the end so that the control +% sequences are all defined. +\definedummies + + + + +\catcode`\@=0 + +% \realbackslash is an actual character `\' with catcode other. +{\catcode`\\=\other @gdef@realbackslash{\}} + +% In Texinfo, backslash is an active character; it prints the backslash +% in fixed width font. +\catcode`\\=\active % @ for escape char from now on. + +@let\ = @ttbackslash + +% If in a .fmt file, print the version number. +% \eatinput stops the `\input texinfo' from showing up. +% After that, `\' should revert to printing a backslash. +% Turn on active characters that we couldn't do earlier because +% they might have appeared in the input file name. +% +@everyjob{@message{[Texinfo version @texinfoversion]}% + @global@let\ = @eatinput + @catcode`+=@active @catcode`@_=@active} + +{@catcode`@^=7 @catcode`@^^M=13% +@gdef@eatinput input texinfo#1^^M{@loadconf}} + +@def@everyjobreset{@ifx\@eatinput @let\ = @ttbackslash @fi} + +% \otherbackslash defines an active \ to be a literal `\' character with +% catcode other. +@gdef@otherbackslash{@let\=@realbackslash} + +% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of +% the literal character `\'. +% +{@catcode`- = @active + @gdef@normalturnoffactive{% + @turnoffactive + @let\=@ttbackslash + } +} % Say @foo, not \foo, in error messages. @escapechar = `@@ -% These (along with & and #) are made active for url-breaking, so need -% active definitions as the normal characters. -@def@normaldot{.} -@def@normalquest{?} -@def@normalslash{/} - % These look ok in all fonts, so just make them not special. % @hashchar{} gets its own user-level command, because of #line. @catcode`@& = @other @def@normalamp{&} @@ -11578,15 +11842,11 @@ @c Do this last of all since we use ` in the previous @catcode assignments. @catcode`@'=@active @catcode`@`=@active -@setregularquotes @c Local variables: @c eval: (add-hook 'before-save-hook 'time-stamp nil t) @c time-stamp-pattern: "texinfoversion{%Y-%02m-%02d.%02H}" -@c page-delimiter: "^\\\\message\\|emacs-page" +@c page-delimiter: "^\\\\message" @c End: -@c vim:sw=2: - -@enablebackslashhack - +@newlineloadsconf diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 0a8369ec7..aed2dea0f 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,8 @@ +2023-06-03 Simon Sobisch + + * Makefile.am (libcob_la_LDFLAGS): updated version-info - ABI fixed for 3.2 + 2023-06-02 Simon Sobisch * common.h (cob_file_org, cob_file_access_mode): changed defines to enums diff --git a/libcob/Makefile.am b/libcob/Makefile.am index 1f388c6a2..ce5a4a5cc 100644 --- a/libcob/Makefile.am +++ b/libcob/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/libcob # -# Copyright (C) 2003-2012, 2014, 2017-2020, 2022 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014, 2017-2020, 2022-2023 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -38,7 +38,7 @@ AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir)/lib -I$(top_srcdir)/lib \ AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) # note: currently misses libsupport... libcob_la_LIBADD = $(LIBCOB_LIBS) $(CODE_COVERAGE_LIBS) -libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 5:0:1 -no-undefined +libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 6:0:2 -no-undefined AM_LDFLAGS = $(COB_FIX_LIB) pkgincludedir = $(includedir)/libcob From c733ee9bb6dfee3e64bb8e1e4be0f88e558aacf4 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Fri, 9 Jun 2023 21:18:11 +0000 Subject: [PATCH 7/7] follow-up to printing context of diagnostics [r5074] cobc/error.c: * (print_error, diagnostics_show_caret): fix for C89 compat * (diagnostics_show_caret): * trim trailing whitespace * removed printing empty lines before/after, * print EOF * changed format --- cobc/ChangeLog | 8 +- cobc/error.c | 112 ++++++++++++++------------- tests/testsuite.src/used_binaries.at | 112 +++++++++++++++++---------- 3 files changed, 136 insertions(+), 96 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index e0690fd37..6383882f7 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,10 @@ +2023-06-09 Simon Sobisch + + * error.c (print_error, diagnostics_show_caret): fix for C89 compat + * error.c (diagnostics_show_caret): trim trailing whitespace, + remove printing empty lines before/after, print EOF, changed format + 2023-06-02 Simon Sobisch * tree.h (cb_file), parser.y: organization and access_mode as enums @@ -41,7 +47,7 @@ 2023-05-28 Simon Sobisch * parser.y: allow expressions for screen related clauses - COL, LINE, LINES, SIZE, COLOR + COL, LINE, LINES, SIZE, COLOR, implementing FR #414 2023-05-26 Simon Sobisch diff --git a/cobc/error.c b/cobc/error.c index 941ab6f67..61421b95d 100644 --- a/cobc/error.c +++ b/cobc/error.c @@ -70,61 +70,60 @@ print_error_prefix (const char *file, int line, const char *prefix) } } -/* Display a context around the location of the error/warning, only if - * cb_diagnostics_show_caret is true +/* Display a context around the location of the error/warning, + only used if cb_diagnostics_show_caret is true Only display two lines before and after. No caret yet for the column as we only have the line. Since we directly use the file, source is printed - before any REPLACE. - */ - -#define CARET_MAX_COLS 73 + before any REPLACE. */ static void -diagnostics_show_caret (const char *file, int line) +diagnostics_show_caret (FILE *fd, const int line) { - FILE* fd = fopen(file, "r"); - if (fd == NULL) return; - char buffer[ CARET_MAX_COLS+1 ]; + #define CARET_MAX_COLS 73 + 5 + #define CARET_CONTEXT_LINES 2 + const int line_start = line > CARET_CONTEXT_LINES ? line - CARET_CONTEXT_LINES : 1; + const int line_end = line + CARET_CONTEXT_LINES; + const int max_pos = cb_diagnostics_show_line_numbers ? CARET_MAX_COLS - 5 : CARET_MAX_COLS; + char buffer[ CARET_MAX_COLS + 1 ]; int line_pos = 1; int char_pos = 0; - int printed = 0; /* nothing printed */ - while(1){ - int c = fgetc (fd); - if ( c == EOF ){ - if (printed){ - fprintf(stderr, "\n"); - } - fclose(fd); - return ; - } - buffer[char_pos] = c ; - if (c == '\n' || char_pos == CARET_MAX_COLS){ - buffer[char_pos] = 0; - if (line_pos > line-3 && line_pos < line+3){ - if (line_pos == line-2) fprintf(stderr, "\n"); - printed = 1; - fprintf (stderr, " "); - if (cb_diagnostics_show_line_numbers){ - fprintf (stderr, "%04d ", - line_pos); + int c = 0; + while (c != EOF) { + buffer[char_pos] = c = fgetc (fd);; + if (c == '\n' || c == EOF || char_pos == max_pos) { + if (line_pos >= line_start) { + /* prefix */ + if (cb_diagnostics_show_line_numbers) { + fprintf (stderr, "%5d %c ", line_pos, + line == line_pos ? '>' : '|'); + } else { + fprintf (stderr, " %c ", + line == line_pos ? '>' : ' '); } - fprintf (stderr, "%c %s%s\n", - line == line_pos ? '>' : ' ', - c == '\n' ? "" : ".." , - buffer); - if (line_pos == line+2){ - fprintf(stderr, "\n"); - fclose(fd); - return; + /* drop trailing whitespace from buffer */ + while (char_pos >= 0 + && (buffer[char_pos] == ' ' + || buffer[char_pos] == '\t' + || buffer[char_pos] == '\r' + || buffer[char_pos] == '\n' + || buffer[char_pos] == EOF + || char_pos == max_pos)) { + buffer[char_pos--] = 0; } + /* print it */ + fprintf (stderr, "%s%s\n", + buffer, + c == '\n' ? "" : + c == EOF ? "" : ".."); + } + if (line_pos++ >= line_end) { + break; } - while (c != '\n'){ - /* skip end of line too long */ + /* skip end of line too long */ + while (c != '\n' && c != EOF) { c = fgetc (fd); - if( c == EOF ) { fclose(fd); return ; } } - line_pos++; - char_pos=0; + char_pos = buffer[0] = 0; } else { char_pos++; } @@ -197,18 +196,23 @@ print_error (const char *file, int line, enum cb_error_kind kind, cb_add_error_to_listing (file, line, prefix, errmsg); } - static const char* last_caret_file = NULL ; - static int last_caret_line = -1 ; if (cb_diagnostics_show_caret - && file != NULL - && strcmp (file, COB_DASH) != 0 - && line - && (last_caret_file != file || last_caret_line != line) - ){ - /* remember last printed location to avoid reprinting it */ - last_caret_file = file; - last_caret_line = line; - diagnostics_show_caret (file, line); + && file != NULL + && strcmp (file, COB_DASH) != 0 + && line != 0) { + static const char *last_caret_file = NULL ; + static int last_caret_line = -1 ; + if (last_caret_file != file + || last_caret_line != line) { + FILE *fd = fopen (file, "r"); + if (fd) { + diagnostics_show_caret (fd, line); + fclose (fd); + } + /* remember last printed location to avoid reprinting it */ + last_caret_file = file; + last_caret_line = line; + } } } diff --git a/tests/testsuite.src/used_binaries.at b/tests/testsuite.src/used_binaries.at index 83fa09b07..abdce6f60 100644 --- a/tests/testsuite.src/used_binaries.at +++ b/tests/testsuite.src/used_binaries.at @@ -921,8 +921,7 @@ AT_CLEANUP AT_SETUP([cobc diagnostics show caret]) -# promoted on 2023-06-01T09:57 -AT_KEYWORDS([cobc diagnostics]) +#AT_KEYWORDS([cobc diagnostics]) AT_DATA([prog.cob],[ IDENTIFICATION DIVISION. PROGRAM-ID. prog. @@ -936,47 +935,78 @@ AT_DATA([prog.cob],[ MOVE 12 TO TEST-VAR DISPLAY TEST-VAR NO ADVANCING END-DISPLAY - STOP RUN. -]) -AT_CHECK([$COBC -Wall -fsyntax-only prog.cob], [1], [], -[prog.cob:7: error: CRUD.CPY: No such file or directory -prog.cob:6: warning: numeric value is expected @<:@-Wothers@:>@ -]) -AT_CHECK([$COMPILE -fdiagnostics-show-caret -fdiagnostics-show-line-numbers -j prog.cob], [1], [], -[prog.cob:7: error: CRUD.CPY: No such file or directory - - 0005 WORKING-STORAGE SECTION. - 0006 01 TEST-VAR PIC 9(2) VALUE 'A'. - 0007 > COPY 'CRUD.CPY'. - 0008 PROCEDURE DIVISION. - 0009 DISPLAY TEST-VAR NO ADVANCING - -prog.cob:6: warning: numeric value is expected - - 0004 DATA DIVISION. - 0005 WORKING-STORAGE SECTION. - 0006 > 01 TEST-VAR PIC 9(2) VALUE 'A'. - 0007 COPY 'CRUD.CPY'. - 0008 PROCEDURE DIVISION. - + STOP RUN... ]) -AT_CHECK([$COMPILE -fdiagnostics-show-caret -j prog.cob],[1], [], -[prog.cob:7: error: CRUD.CPY: No such file or directory - - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 'A'. - > COPY 'CRUD.CPY'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING -prog.cob:6: warning: numeric value is expected - - DATA DIVISION. - WORKING-STORAGE SECTION. - > 01 TEST-VAR PIC 9(2) VALUE 'A'. - COPY 'CRUD.CPY'. - PROCEDURE DIVISION. +# note: $COBC has -fdiagnostics-plain-output +AT_CHECK([$COBC -Wall -fsyntax-only prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory +prog.cob:6: warning: numeric value is expected [-Wothers] +prog.cob:14: warning: ignoring redundant . [-Wothers] +]]) +AT_CHECK([$COBC -fdiagnostics-show-caret -fdiagnostics-show-line-numbers prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory + 5 | WORKING-STORAGE SECTION. + 6 | 01 TEST-VAR PIC 9(2) VALUE 'A'. + 7 > COPY 'CRUD.CPY'. + 8 | PROCEDURE DIVISION. + 9 | DISPLAY TEST-VAR NO ADVANCING +prog.cob:6: warning: numeric value is expected [-Wothers] + 4 | DATA DIVISION. + 5 | WORKING-STORAGE SECTION. + 6 > 01 TEST-VAR PIC 9(2) VALUE 'A'. + 7 | COPY 'CRUD.CPY'. + 8 | PROCEDURE DIVISION. +prog.cob:14: warning: ignoring redundant . [-Wothers] + 12 | DISPLAY TEST-VAR NO ADVANCING + 13 | END-DISPLAY + 14 > STOP RUN... + 15 | +]]) + +AT_CHECK([$COBC -fdiagnostics-show-caret prog.cob], [1], [], +[[prog.cob:7: error: CRUD.CPY: No such file or directory + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + > COPY 'CRUD.CPY'. + PROCEDURE DIVISION. + DISPLAY TEST-VAR NO ADVANCING +prog.cob:6: warning: numeric value is expected [-Wothers] + DATA DIVISION. + WORKING-STORAGE SECTION. + > 01 TEST-VAR PIC 9(2) VALUE 'A'. + COPY 'CRUD.CPY'. + PROCEDURE DIVISION. +prog.cob:14: warning: ignoring redundant . [-Wothers] + DISPLAY TEST-VAR NO ADVANCING + END-DISPLAY + > STOP RUN... + +]]) + +# Testcase for trailing whitespace +AT_CHECK([sed -e 's/DIVISION\./DIVISION \.\t \t /' prog.cob > progsp.cob]) + +AT_CHECK([$COBC -Wno-others -fdiagnostics-show-caret progsp.cob], [1], [], +[[progsp.cob:7: error: CRUD.CPY: No such file or directory + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC 9(2) VALUE 'A'. + > COPY 'CRUD.CPY'. + PROCEDURE DIVISION . + DISPLAY TEST-VAR NO ADVANCING +]]) + +# Testcase for line too long and printing only one line +AT_DATA([longgy.cob],[ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd +]) + +# note: this is actually an error in the parser line number, +# but until that is solved, it is a nice edge case of "line not available" +AT_CHECK([$COBC -Wno-others -fdiagnostics-show-caret longgy.cob], [1], [], +[[longgy.cob:2: error: PROGRAM-ID header missing + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd.. + > +]]) -]) AT_CLEANUP