summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/cwebdir/ctangle.w
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/cwebdir/ctangle.w')
-rw-r--r--Build/source/texk/web2c/cwebdir/ctangle.w211
1 files changed, 114 insertions, 97 deletions
diff --git a/Build/source/texk/web2c/cwebdir/ctangle.w b/Build/source/texk/web2c/cwebdir/ctangle.w
index e7e2d311fe5..03751a473c9 100644
--- a/Build/source/texk/web2c/cwebdir/ctangle.w
+++ b/Build/source/texk/web2c/cwebdir/ctangle.w
@@ -2,7 +2,7 @@
% This program by Silvio Levy and Donald E. Knuth
% is based on a program by Knuth.
% It is distributed WITHOUT ANY WARRANTY, express or implied.
-% Version 4.2 --- February 2021
+% Version 4.3 --- April 2021
% Copyright (C) 1987,1990,1993,2000 Silvio Levy and Donald E. Knuth
@@ -27,11 +27,11 @@
\mathchardef\RA="3221 % right arrow
\mathchardef\BA="3224 % double arrow
-\def\title{CTANGLE (Version 4.2)}
+\def\title{CTANGLE (Version 4.3)}
\def\topofcontents{\null\vfill
\centerline{\titlefont The {\ttitlefont CTANGLE} processor}
\vskip 15pt
- \centerline{(Version 4.2)}
+ \centerline{(Version 4.3)}
\vfill}
\def\botofcontents{\vfill
\noindent
@@ -61,7 +61,7 @@ Joachim Schrod, Lee Wittenberg, and others who have contributed improvements.
The ``banner line'' defined here should be changed whenever \.{CTANGLE}
is modified.
-@d banner "This is CTANGLE (Version 4.2)"
+@d banner "This is CTANGLE (Version 4.3)"
@c
@<Include files@>@/
@@ -151,11 +151,11 @@ init_node(name_dir); /* the undefined section has no replacement text */
starting at position |first| equals the identifier pointed to by |p|:
@c
-boolean names_match(@t\1\1@>
+boolean names_match(
name_pointer p, /* points to the proposed match */
const char *first, /* position of first character of string */
size_t l, /* length of identifier */
-eight_bits t@t\2\2@>) /* not used by \.{TANGLE} */
+eight_bits t) /* not used by \.{TANGLE} */
{@+(void)t;
if (length(p)!=l) return false;
return !strncmp(first,p->byte_start,l);
@@ -193,12 +193,13 @@ name, and they also tie together all the \CEE/ texts of unnamed sections.
The replacement text pointer for the first unnamed section appears in
|text_info->text_link|, and the most recent such pointer is |last_unnamed|.
+@d macro 0
@d section_flag max_texts /* final |text_link| in section replacement texts */
@<Private...@>=
static text_pointer last_unnamed; /* most recent replacement text of unnamed section */
-@ @<Set init...@>= last_unnamed=text_info; text_info->text_link=0;
+@ @<Set init...@>= last_unnamed=text_info; text_info->text_link=macro;
@ If the first byte of a token is less than |0200|, the token occupies a
single byte. Otherwise we make a sixteen-bit token by combining two consecutive
@@ -214,15 +215,18 @@ Codes less than |0200| are 7-bit |char| codes that represent themselves.
Some of the 7-bit codes will not be present, however, so we can
use them for special purposes. The following symbolic names are used:
-\yskip \hang |join| denotes the concatenation of adjacent items with no
-space or line breaks allowed between them (the \.{@@\&} operation of \.{CWEB}).
+\yskip \hang |string| denotes the beginning or end of a string
+or a verbatim construction.
-\hang |string| denotes the beginning or end of a string, verbatim
-construction or numerical constant.
+\hang |constant| denotes a numerical constant.
+
+\hang |join| denotes the concatenation of adjacent items with no space
+or line breaks allowed between them (the \.{@@\&} operation of \.{CWEB}).
@^ASCII code dependencies@>
-@d string 02 /* takes the place of extended ASCII \.{\char2} */
-@d join 0177 /* takes the place of ASCII delete */
+@d string 02 /* takes the place of ASCII \.{STX} */
+@d constant 03 /* takes the place of ASCII \.{ETX} */
+@d join 0177 /* takes the place of ASCII \.{DEL} */
@d output_defs_flag (2*024000-1)
@ The following procedure is used to enter a two-byte value into
@@ -308,8 +312,8 @@ We assume that the \CEE/ compiler can copy structures.
@c
static void
-push_level(@t\1\1@> /* suspends the current level */
-name_pointer p@t\2\2@>)
+push_level( /* suspends the current level */
+name_pointer p)
{
if (stack_ptr==stack_end) overflow("stack");
*stack_ptr=cur_state;
@@ -331,8 +335,8 @@ text or returns the state to the most recently stacked level.
@c
static void
-pop_level(@t\1\1@> /* do this when |cur_byte| reaches |cur_end| */
-boolean flag@t\2\2@>) /* |flag==false| means we are in |output_defs| */
+pop_level( /* do this when |cur_byte| reaches |cur_end| */
+boolean flag) /* |flag==false| means we are in |output_defs| */
{
if (flag && cur_repl->text_link<section_flag) { /* link to a continuation */
cur_repl=cur_repl->text_link+text_info; /* stay on the same level */
@@ -350,7 +354,7 @@ necessary stacking and unstacking. It sends the value |section_number|
if the next output begins or ends the replacement text of some section,
in which case |cur_val| is that section's number (if beginning) or the
negative of that value (if ending). (A section number of 0 indicates
-not the beginning or ending of a section, but a \&{\#line} command.)
+not the beginning or ending of a section, but a \#\&{line} command.)
And it sends the value |identifier|
if the next output is an identifier, in which case
|cur_val| points to that identifier name.
@@ -463,7 +467,7 @@ flush_buffer(void) /* writes one line to output file */
{
C_putc('\n');
if (cur_line % 100 == 0 && show_progress) {
- printf(".");
+ putchar('.');
if (cur_line % 500 == 0) printf("%d",cur_line);
update_terminal; /* progress report */
}
@@ -502,9 +506,7 @@ complain we're out of room@>=
if (an_output_file==end_output_files) {
if (cur_out_file>output_files)
*--cur_out_file=cur_section_name;
- else {
- overflow("output files");
- }
+ else overflow("output files");
}
}
@@ -518,7 +520,7 @@ phase_two (void) {
cur_line=1;
@<Initialize the output stacks@>@;
@<Output macro definitions if appropriate@>@;
- if (text_info->text_link==0 && cur_out_file==end_output_files) {
+ if (text_info->text_link==macro && cur_out_file==end_output_files) {
fputs("\n! No program text was specified.",stdout); mark_harmless;
@.No program text...@>
}
@@ -534,7 +536,7 @@ phase_two (void) {
printf(" (%s)",C_file_name);
update_terminal;
}
- if (text_info->text_link==0) goto writeloop;
+ if (text_info->text_link==macro) goto writeloop;
}
while (stack_ptr>stack) get_output();
flush_buffer();
@@ -557,14 +559,14 @@ for (an_output_file=end_output_files; an_output_file>cur_out_file;) {
an_output_file--;
sprint_section_name(output_file_name,*an_output_file);
fclose(C_file);
- C_file=fopen(output_file_name,"wb");
- if (C_file ==0) fatal("! Cannot open output file ",output_file_name);
+ if ((C_file=fopen(output_file_name,"wb"))==NULL)
+ fatal("! Cannot open output file ",output_file_name);
@.Cannot open output file@>
if (show_progress) { printf("\n(%s)",output_file_name); update_terminal; }
cur_line=1;
stack_ptr=stack+1;
- cur_name= (*an_output_file);
- cur_repl= (text_pointer)cur_name->equiv;
+ cur_name=(*an_output_file);
+ cur_repl=(text_pointer)cur_name->equiv;
cur_byte=cur_repl->tok_start;
cur_end=(cur_repl+1)->tok_start;
while (stack_ptr > stack) get_output();
@@ -586,14 +588,17 @@ static boolean output_defs_seen=false;
static void output_defs(void);@/
static void out_char(eight_bits);
-@ @c
+@ @d C_printf(c,a) fprintf(C_file,c,a)
+@d C_putc(c) putc(c,C_file) /* isn't \CEE/ wonderfully consistent? */
+
+@c
static void
output_defs(void)
{
sixteen_bits a;
push_level(NULL);
for (cur_text=text_info+1; cur_text<text_ptr; cur_text++)
- if (cur_text->text_link==0) { /* |cur_text| is the text for a macro */
+ if (cur_text->text_link==macro) { /* |cur_text| is the text for a |macro| */
cur_byte=cur_text->tok_start;
cur_end=(cur_text+1)->tok_start;
C_printf("%s","#define ");
@@ -611,7 +616,7 @@ output_defs(void)
if (a<024000) { /* |024000==(0250-0200)*0400| */
cur_val=a; out_char(identifier);
}
- else if (a<050000) { confusion("macro defs have strange char");}
+ else if (a<050000) confusion("macro defs have strange char");
else {
cur_val=a-050000; cur_section=cur_val; out_char(section_number);
}
@@ -643,7 +648,7 @@ restart:
@/@t\4@>@<Case of an identifier@>@;
@/@t\4@>@<Case of a section number@>@;
@/@t\4@>@<Cases like \.{!=}@>@;
- case '=': case '>': C_putc(cur_char); C_putc(' ');
+ case '=': case '>': C_putc(cur_char);@+C_putc(' ');
out_state=normal; break;
case join: out_state=unbreakable; break;
case constant: if (out_state==verbatim) {
@@ -659,7 +664,7 @@ restart:
}
}
-@ @<Cases like \.{!=}@>=
+@ @<Cases like \.{!=}@>=@t\1\quad@>
case plus_plus: C_putc('+');@+C_putc('+'); out_state=normal; break;
case minus_minus: C_putc('-');@+C_putc('-'); out_state=normal; break;
case minus_gt: C_putc('-');@+C_putc('>'); out_state=normal; break;
@@ -697,7 +702,7 @@ static char translit[128][translit_length];
for (i=0;i<128;i++) sprintf(translit[i],"X%02X",(unsigned int)(128+i));
}
-@ @<Case of an identifier@>=
+@ @<Case of an identifier@>=@t\1\quad@>
case identifier:
if (out_state==num_or_id) C_putc(' ');
j=(cur_val+name_dir)->byte_start;
@@ -710,7 +715,7 @@ case identifier:
}
out_state=num_or_id; break;
-@ @<Case of a sec...@>=
+@ @<Case of a sec...@>=@t\1\quad@>
case section_number:
if (cur_val>0) C_printf("/*%d:*/",cur_val);
else if(cur_val<0) C_printf("/*:%d*/",-cur_val);
@@ -731,7 +736,7 @@ case section_number:
if (*j=='\\' || *j=='"') C_putc('\\');
C_putc(*j);
}
- C_printf("%s","\"\n");
+ C_putc('"');@+C_putc('\n');
}
break;
@@ -756,7 +761,7 @@ of these internal code numbers has been chosen to simplify the program logic;
larger numbers are given to the control codes that denote more significant
milestones.
-@d ignore 0 /* control code of no interest to \.{CTANGLE} */
+@d ignore 00 /* control code of no interest to \.{CTANGLE} */
@d ord 0302 /* control code for `\.{@@'}' */
@d control_text 0303 /* control code for `\.{@@t}', `\.{@@\^}', etc. */
@d translit_code 0304 /* control code for `\.{@@l}' */
@@ -817,7 +822,7 @@ to the output. If the comment is introduced by \.{/*}, |skip_comment|
proceeds until finding the end-comment token \.{*/} or a newline; in the
latter case |skip_comment| will be called again by |get_next|, since the
comment is not finished. This is done so that each newline in the
-\CEE/ part of a section is copied to the output; otherwise the \&{\#line}
+\CEE/ part of a section is copied to the output; otherwise the \#\&{line}
commands inserted into the \CEE/ file by the output routines become useless.
On the other hand, if the comment is introduced by \.{//} (i.e., if it
is a \CPLUSPLUS/ ``short comment''), it always is simply delimited by the next
@@ -831,15 +836,15 @@ No comment, long or short, is allowed to contain `\.{@@\ }' or `\.{@@*}'.
static boolean comment_continues=false; /* are we scanning a comment? */
@ @c
-static boolean skip_comment(@t\1\1@> /* skips over comments */
-boolean is_long_comment@t\2\2@>)
+static boolean skip_comment( /* skips over comments */
+boolean is_long_comment)
{
char c; /* current character */
while (true) {
if (loc>limit) {
if (is_long_comment) {
- if(get_line()) return comment_continues=true;
- else{
+ if (get_line()) return comment_continues=true;
+ else {
err_print("! Input ended in mid-comment");
@.Input ended in mid-comment@>
return comment_continues=false;
@@ -864,8 +869,6 @@ boolean is_long_comment@t\2\2@>)
@* Inputting the next token.
-@d constant 03
-
@<Private...@>=
static name_pointer cur_section_name; /* name of section just scanned */
static boolean no_where; /* suppress |print_where|? */
@@ -873,20 +876,15 @@ static boolean no_where; /* suppress |print_where|? */
@ As one might expect, |get_next| consists mostly of a big switch
that branches to the various special cases that can arise.
-@d isxalpha(c) ((c)=='_' || (c)=='$')
- /* non-alpha characters allowed in identifier */
-@d ishigh(c) ((eight_bits)(c)>0177)
-@^high-bit character handling@>
-
@c
static eight_bits
get_next(void) /* produces the next input token */
{
- static int preprocessing=0;
+ static boolean preprocessing=false;
eight_bits c; /* the current character */
while (true) {
if (loc>limit) {
- if (preprocessing && *(limit-1)!='\\') preprocessing=0;
+ if (preprocessing && *(limit-1)!='\\') preprocessing=false;
if (get_line()==false) return new_section;
else if (print_where && !no_where) {
print_where=false;
@@ -913,9 +911,9 @@ get_next(void) /* produces the next input token */
else if (xisspace(c)) {
if (!preprocessing || loc>limit) continue;
/* we don't want a blank after a final backslash */
- else return ' '; /* ignore spaces and tabs, unless preprocessing */
+ else return ' '; /* ignore spaces and tabs, unless |preprocessing| */
}
- else if (c=='#' && loc==buffer+1) preprocessing=1;
+ else if (c=='#' && loc==buffer+1) preprocessing=true;
mistake: @<Compress two-symbol operator@>@;
return c;
}
@@ -930,24 +928,23 @@ combinations \.{...}, \.{::}, \.{.*} and \.{->*}.
The compound assignment operators (e.g., \.{+=}) are
treated as separate tokens.
-@d compress(c) if (loc++<=limit) return c
-
@<Compress tw...@>=
switch(c) {
case '+': if (*loc=='+') compress(plus_plus); break;
- case '-': if (*loc=='-') {compress(minus_minus);}
- else { if (*loc=='>') { if (*(loc+1)=='*') {loc++; compress(minus_gt_ast);}
- else compress(minus_gt); } } break;
- case '.': if (*loc=='*') {compress(period_ast);}
+ case '-': if (*loc=='-') {@+compress(minus_minus);@+}
+ else if (*loc=='>') {
+ if (*(loc+1)=='*') {loc++;@+compress(minus_gt_ast);}
+ else compress(minus_gt);
+ } break;
+ case '.': if (*loc=='*') {@+compress(period_ast);@+}
else if (*loc=='.' && *(loc+1)=='.') {
- loc++; compress(dot_dot_dot);
- }
- break;
+ loc++;@+compress(dot_dot_dot);
+ } break;
case ':': if (*loc==':') compress(colon_colon); break;
case '=': if (*loc=='=') compress(eq_eq); break;
- case '>': if (*loc=='=') {compress(gt_eq);}
+ case '>': if (*loc=='=') {@+compress(gt_eq);@+}
else if (*loc=='>') compress(gt_gt); break;
- case '<': if (*loc=='=') {compress(lt_eq);}
+ case '<': if (*loc=='=') {@+compress(lt_eq);@+}
else if (*loc=='<') compress(lt_lt); break;
case '&': if (*loc=='&') compress(and_and); break;
case '|': if (*loc=='|') compress(or_or); break;
@@ -956,30 +953,41 @@ switch(c) {
@ @<Get an identifier@>= {
id_first=--loc;
- while (isalpha((eight_bits)*++loc) || isdigit((eight_bits)*loc) @|
+ do {
+ ++loc;
+ } while (isalpha((eight_bits)*loc) || isdigit((eight_bits)*loc) @|
|| isxalpha((eight_bits)*loc) || ishigh((eight_bits)*loc));
id_loc=loc; return identifier;
}
@ @<Get a constant@>= {
+ boolean hex_flag = false; /* are we reading a hexadecimal literal? */
id_first=loc-1;
if (*id_first=='.' && !xisdigit(*loc)) goto mistake; /* not a constant */
if (*id_first=='0') {
if (*loc=='x' || *loc=='X') { /* hex constant */
- loc++; while (xisxdigit(*loc)) loc++; goto found;
+ hex_flag = true;
+ loc++; while (xisxdigit(*loc) || *loc=='\'') loc++;
+ }
+ else if (*loc=='b' || *loc=='B') { /* binary constant */
+ loc++; while (*loc=='0' || *loc=='1' || *loc=='\'') loc++; goto found;
}
}
- while (xisdigit(*loc)) loc++;
+ while (xisdigit(*loc) || *loc=='\'') loc++;
if (*loc=='.') {
- loc++;
- while (xisdigit(*loc)) loc++;
+ loc++;
+ while ((hex_flag && xisxdigit(*loc)) || xisdigit(*loc) || *loc=='\'') loc++;
}
if (*loc=='e' || *loc=='E') { /* float constant */
if (*++loc=='+' || *loc=='-') loc++;
- while (xisdigit(*loc)) loc++;
+ while (xisdigit(*loc) || *loc=='\'') loc++;
+ }
+ else if (hex_flag && (*loc=='p' || *loc=='P')) { /* hex float constant */
+ if (*++loc=='+' || *loc=='-') loc++;
+ while (xisxdigit(*loc) || *loc=='\'') loc++;
}
- found: while (*loc=='u' || *loc=='U' || *loc=='l' || *loc=='L'
- || *loc=='f' || *loc=='F') loc++;
+found: while (*loc=='u' || *loc=='U' || *loc=='l' || *loc=='L'
+ || *loc=='f' || *loc=='F') loc++;
id_loc=loc;
return constant;
}
@@ -994,7 +1002,7 @@ convention, but do not allow the string to be longer than |longest_name|.
id_first = section_text+1;
id_loc = section_text; *++id_loc=delim;
if (delim=='L' || delim=='u' || delim=='U') { /* wide character constant */
- if (delim=='u' && *loc=='8') { *++id_loc=*loc++; }
+ if (delim=='u' && *loc=='8') *++id_loc=*loc++;
delim=*loc++; *++id_loc=delim;
}
while (true) {
@@ -1035,8 +1043,7 @@ convention, but do not allow the string to be longer than |longest_name|.
whether there is more work to do.
@<Get control code and possible section name@>= {
- c=ccode[(eight_bits)*loc++];
- switch(c) {
+ switch(c=ccode[(eight_bits)*loc++]) {
case ignore: continue;
case translit_code: err_print("! Use @@l in limbo only"); continue;
@.Use @@l in limbo...@>
@@ -1063,9 +1070,8 @@ thus, \.{@@'\\nopq'} gives the same result as \.{@@'\\n'}.
@<Scan an ASCII constant@>=
id_first=loc;
- if (*loc=='\\') {
+ if (*loc=='\\')
if (*++loc=='\'') loc++;
- }
while (*loc!='\'') {
if (*loc=='@@') {
if (*(loc+1)!='@@')
@@ -1086,8 +1092,10 @@ thus, \.{@@'\\nopq'} gives the same result as \.{@@'\\n'}.
char *k; /* pointer into |section_text| */
@<Put section name into |section_text|@>@;
if (k-section_text>3 && strncmp(k-2,"...",3)==0)
- cur_section_name=section_lookup(section_text+1,k-3,1); /* 1 means is a prefix */
- else cur_section_name=section_lookup(section_text+1,k,0);
+ cur_section_name=section_lookup(section_text+1,k-3,true);
+ /* |true| means it's a prefix */
+ else cur_section_name=section_lookup(section_text+1,k,false);
+ /* |false| means it's not */
if (cur_section_name_char=='(')
@<If it's not there, add |cur_section_name| to the output file stack, or
complain we're out of room@>@;
@@ -1176,7 +1184,6 @@ ANSI \CEE/ preprocessor sometimes requires it.
acted, |cur_text| will point to the replacement text just generated, and
|next_control| will contain the control code that terminated the activity.
-@d macro 0
@d app_repl(c) {if (tok_ptr==tok_mem_end) overflow("token"); *tok_ptr++=c;}
@<Private...@>=
@@ -1185,11 +1192,11 @@ static eight_bits next_control;
@ @c
static void
-scan_repl(@t\1\1@> /* creates a replacement text */
-eight_bits t@t\2\2@>)
+scan_repl( /* creates a replacement text */
+eight_bits t)
{
sixteen_bits a; /* the current token */
- if (t==section_name) {@<Insert the line number into |tok_mem|@>@;}
+ if (t==section_name) @<Insert the line number into |tok_mem|@>@;
while (true) switch (a=get_next()) {
@<In cases that |a| is a non-|char| token (|identifier|,
|section_name|, etc.), either process it and change |a| to a byte
@@ -1212,19 +1219,21 @@ to |0150000|; then the numeric line number; then a pointer to the
file name.
@<Insert the line...@>=
-store_two_bytes(0150000);
-if (changing && include_depth==change_depth) { /* correction made Feb 2017 */
- id_first=change_file_name;
- store_two_bytes((sixteen_bits)change_line);
-}@+else {
- id_first=cur_file_name;
- store_two_bytes((sixteen_bits)cur_line);
+{
+ store_two_bytes(0150000);
+ if (changing && include_depth==change_depth) { /* correction made Feb 2017 */
+ id_first=change_file_name;
+ store_two_bytes((sixteen_bits)change_line);
+ }@+else {
+ id_first=cur_file_name;
+ store_two_bytes((sixteen_bits)cur_line);
+ }
+ id_loc=id_first+strlen(id_first);
+ {int a_l=id_lookup(id_first,id_loc,0)-name_dir; app_repl((a_l / 0400)+0200);
+ app_repl(a_l % 0400);}
}
-id_loc=id_first+strlen(id_first);
-{int a_l=id_lookup(id_first,id_loc,0)-name_dir; app_repl((a_l / 0400)+0200);
- app_repl(a_l % 0400);}
-@ @<In cases that |a| is...@>=
+@ @<In cases that |a| is...@>=@t\1\quad@>
case identifier: a=id_lookup(id_first,id_loc,0)-name_dir;
app_repl((a / 0400)+0200);
app_repl(a % 0400); break;
@@ -1268,7 +1277,13 @@ case new_section: goto done;
as explained in the manual */
}
-@ @<Copy a string...@>=
+@ By default, \.{CTANGLE} purges single-quote characters from \CPLUSPLUS/-style
+literals, e.g., \.{1'000'000}, so that you can use this notation also in \CEE/
+code. The \.{+k} switch will `keep' the single quotes in the output.
+
+@d keep_digit_separators flags['k']
+
+@<Copy a string...@>=
app_repl(a); /* |string| or |constant| */
while (id_first < id_loc) { /* simplify \.{@@@@} pairs */
if (*id_first=='@@') {
@@ -1276,6 +1291,8 @@ case new_section: goto done;
else err_print("! Double @@ should be used in string");
@.Double @@ should be used...@>
}
+ else if (a==constant && *id_first=='\'' && !keep_digit_separators)
+ id_first++;
app_repl(*id_first++);
}
app_repl(a); break;
@@ -1354,7 +1371,7 @@ scan_section(void)
if (*(loc-1)=='*' && show_progress) { /* starred section */
printf("*%d",section_count); update_terminal;
}
- next_control=0;
+ next_control=ignore;
while (true) {
@<Skip ahead until |next_control| corresponds to \.{@@d}, \.{@@<},
\.{@@\ } or the like@>@;
@@ -1431,7 +1448,7 @@ store_two_bytes((sixteen_bits)(0150000+section_count));
/* |0150000==0320*0400| */
@ @<Update the data...@>=
-if (p==name_dir||p==0) { /* unnamed section, or bad section name */
+if (p==name_dir||p==NULL) { /* unnamed section, or bad section name */
(last_unnamed)->text_link=cur_text-text_info; last_unnamed=cur_text;
}
else if (p->equiv==(void *)text_info) p->equiv=(void *)cur_text;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 18:44:26 +0000