1% This is etex.ch, a 2% WEB change file containing code for various features extending TeX; 3% to be applied to tex.web in order to define the 4% e-TeX program. 5 6% e-TeX is copyright (C) 1999-2012 by P. Breitenlohner (1994,98 by the NTS 7% team); all rights are reserved. Copying of this file is authorized only if 8% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to 9% your copy. (Programs such as TIE allow the application of several change 10% files to tex.web; the master files tex.web and etex.ch should stay intact.) 11 12% See etex_gen.tex for hints on how to install this program. 13% And see etripman.tex for details about how to validate it. 14 15% The TeX program is copyright (C) 1982 by D. E. Knuth. 16% TeX is a trademark of the American Mathematical Society. 17% e-TeX and NTS are trademarks of the NTS group. 18 19% All line numbers refer to tex.web 3.14159265 as of January 20, 2014. 20 21@x limbo l.1 - this is e-TeX 22% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved. 23% Copying of this file is authorized only if (1) you are D. E. Knuth, or if 24% (2) you make absolutely no changes to your copy. (The WEB system provides 25% for alterations via an auxiliary file; the master file should stay intact.) 26% See Appendix H of the WEB manual for hints on how to install this program. 27% And see Appendix A of the TRIP manual for details about how to validate it. 28 29% TeX is a trademark of the American Mathematical Society. 30% METAFONT is a trademark of Addison-Wesley Publishing Company. 31@y 32% e-TeX is copyright (C) 1999-2012 by P. Breitenlohner (1994,98 by the NTS 33% team); all rights are reserved. Copying of this file is authorized only if 34% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to 35% your copy. (Programs such as TIE allow the application of several change 36% files to tex.web; the master files tex.web and etex.ch should stay intact.) 37 38% See etex_gen.tex for hints on how to install this program. 39% And see etripman.tex for details about how to validate it. 40 41% e-TeX and NTS are trademarks of the NTS group. 42% TeX is a trademark of the American Mathematical Society. 43% METAFONT is a trademark of Addison-Wesley Publishing Company. 44 45% This program is directly derived from Donald E. Knuth's TeX; 46% the change history which follows and the reward offered for finders of 47% bugs refer specifically to TeX; they should not be taken as referring 48% to e-TeX, although the change history is relevant in that it 49% demonstrates the evolutionary path followed. This program is not TeX; 50% that name is reserved strictly for the program which is the creation 51% and sole responsibility of Professor Knuth. 52@z 53%--------------------------------------- 54@x limbo l.51 - e-TeX history 55% Although considerable effort has been expended to make the TeX program 56% correct and reliable, no warranty is implied; the author disclaims any 57% obligation or liability for damages, including but not limited to 58% special, indirect, or consequential damages arising out of or in 59% connection with the use or performance of this software. This work has 60% been a ``labor of love'' and the author hopes that users enjoy it. 61@y 62% A preliminary version of TeX--XeT was released in April 1992. 63% TeX--XeT version 1.0 was released in June 1992, 64% version 1.1 prevented arith overflow in glue computation (Oct 1992). 65% A preliminary e-TeX version 0.95 was operational in March 1994. 66% Version 1.0beta was released in May 1995. 67% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995). 68% Version 1.02beta allowed 256 mark classes (March 1996). 69% Version 1.1 changed \group{type,level} -> \currentgroup{type,level}, 70% first public release (October 1996). 71% Version 2.0 development was started in March 1997; 72% fixed a ligature-\beginR bug in January 1998; 73% was released in March 1998. 74% Version 2.1 fixed a \marks bug (when min_halfword<>0) (January 1999). 75% Version 2.2 development was started in Feb 2003; released in Oct 2004. 76% fixed a bug in sparse array handling (0=>null), Jun 2002; 77% fixed a bug in \lastnodetype (cur_val=>cur_val_level) 78% reported by Hartmut Henkel <hartmut_henkel@@gmx.de>, 79% fix by Fabrice Popineau <Fabrice.Popineau@@supelec.fr>, 80% Jan 2004; 81% another bug in sparse array handling (cur_ptr=>cur_chr) 82% reported by Taco Hoekwater <taco@@elvenkind.com>, Jul 2004; 83% fixed a sparse array reference count bug (\let,\futurelet), 84% fix by Bernd Raichle <berd@@dante.de>, Aug 2004; 85% reorganized handling of banner, additional token list and 86% integer parameters, and similar in order to reduce the 87% interference between eTeX, pdfTeX, and web2c change files. 88% adapted to tex.web 3.141592, revised glue rounding for mixed 89% direction typesetting; 90% fixed a bug in the revised glue rounding code, detected by 91% Tigran Aivazian <tigran@@aivazian.fsnet.co.uk>, Oct 2004. 92% Version 2.3 development was started in Feb 2008; released in Apr 2011. 93% fixed a bug in hyph_code handling (\savinghyphcodes) 94% reported by Vladimir Volovich <vvv@@vsu.ru>, Feb 2008. 95% fixed the error messages for improper use of \protected, 96% reported by Heiko Oberdiek 97% <heiko.oberdiek@@googlemail.com>, May 2010. 98% some rearrangements to reduce interferences between 99% e-TeX and pTeX, in part suggested by Hironori Kitagawa 100% <h_kitagawa2001@@yahoo.co.jp>, Mar 2011. 101% Version 2.4 fixed an uninitialized line number bug, released in May 2012. 102% Version 2.5 development was started in Aug 2012; released in Feb 2013. 103% better tracing of font definitions, reported by 104% Bruno Le Floch <blflatex@@gmail.com>, Jul 2012. 105% Version 2.6 development was started in Mar 2013; released in ??? 201?. 106% enable hyphenation of text between \beginL and \endL or 107% between \beginR and \endR, problem reported by 108% Vafa Khalighi <vafalgk@@gmail.com>, Nov 2013. 109% better handling of right-to-left text -- to be done. 110 111% Although considerable effort has been expended to make the e-TeX program 112% correct and reliable, no warranty is implied; the author disclaims any 113% obligation or liability for damages, including but not limited to 114% special, indirect, or consequential damages arising out of or in 115% connection with the use or performance of this software. This work has 116% been a ``labor of love'' and the author hopes that users enjoy it. 117@z 118%--------------------------------------- 119@x limbo l.63 - e-TeX logo, TeXXeT 120\let\mc=\ninerm % medium caps for names like SAIL 121@y 122\let\mc=\ninerm % medium caps for names like SAIL 123\def\eTeX{$\varepsilon$-\TeX} 124\font\revrm=xbmc10 % for right-to-left text 125% to generate xbmc10 (i.e., reflected cmbx10) use a file 126% xbmc10.mf containing: 127%+++++++++++++++++++++++++++++++++++++++++++++++++ 128% if unknown cmbase: input cmbase fi 129% extra_endchar := extra_endchar & 130% "currentpicture:=currentpicture " & 131% "reflectedabout((.5[l,r],0),(.5[l,r],1));"; 132% input cmbx10 133%+++++++++++++++++++++++++++++++++++++++++++++++++ 134\ifx\beginL\undefined % this is TeX 135 \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT} 136 \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT 137 \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT 138\else 139 \ifx\eTeXversion\undefined % this is \TeXeT 140 \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT 141 \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT 142 \else % this is \eTeX 143 \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT 144 \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT 145 \fi 146\fi 147@z 148%--------------------------------------- 149@x limbo l.66 - bug fix (print only changed modules) 150\def\pct!{{\char`\%}} % percent sign in ordinary text 151@y 152\def\pct!{{\char`\%}} % percent sign in ordinary text 153\def\grp{\.{\char'173...\char'175}} 154@z 155%--------------------------------------- 156@x limbo l.82 - e-TeX basic 157\def\title{\TeX82} 158@y 159\def\title{\eTeX} 160% system dependent redefinitions of \title should come later 161% and should use: 162% \toks0=\expandafter{\title} 163% \edef\title{...\the\toks0...} 164\let\maybe=\iffalse % print only changed modules 165@z 166%--------------------------------------- 167@x [1] m.1 l.93 - this is e-TeX 168This is \TeX, a document compiler intended to produce typesetting of high 169@y 170This is \eTeX, a program derived from and extending the capabilities of 171\TeX, a document compiler intended to produce typesetting of high 172@z 173%--------------------------------------- 174@x [1] m.2 l.182 - e-TeX basic 175If this program is changed, the resulting system should not be called 176@y 177This program contains code for various features extending \TeX, 178therefore this program is called `\eTeX' and not 179@z 180%--------------------------------------- 181@x [1] m.2 l.188 - e-TeX basic 182November 1984]. 183@y 184November 1984]. 185 186A similar test suite called the ``\.{e-TRIP} test'' is available for 187helping to determine whether a particular implementation deserves to be 188known as `\eTeX'. 189@z 190%--------------------------------------- 191@x [1] m.2 l.190 - e-TeX basic 192@d banner=='This is TeX, Version 3.14159265' {printed when \TeX\ starts} 193@y 194@d eTeX_version=2 { \.{\\eTeXversion} } 195@d eTeX_revision==".6" { \.{\\eTeXrevision} } 196@d eTeX_version_string=='-2.6' {current \eTeX\ version} 197@# 198@d eTeX_banner=='This is e-TeX, Version 3.14159265',eTeX_version_string 199 {printed when \eTeX\ starts} 200@# 201@d TeX_banner=='This is TeX, Version 3.14159265' {printed when \TeX\ starts} 202@# 203@d banner==eTeX_banner 204@# 205@d TEX==ETEX {change program name into |ETEX|} 206@# 207@d TeXXeT_code=0 {the \TeXXeT\ feature is optional} 208@# 209@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|} 210@z 211%--------------------------------------- 212@x [1] m.3 l.209 - e-TeX basic 213scalar types; there are no `\&{var}' parameters, except in the case of files; 214@y 215scalar types; there are no `\&{var}' parameters, except in the case of files 216--- \eTeX, however, does use `\&{var}' parameters for the |reverse| function; 217@z 218%--------------------------------------- 219@x [1] m.15 l.504 - e-TeX basic 220@d not_found=45 {go here when you've found nothing} 221@y 222@d not_found=45 {go here when you've found nothing} 223@d not_found1=46 {like |not_found|, when there's more than one} 224@d not_found2=47 {like |not_found|, when there's more than two} 225@d not_found3=48 {like |not_found|, when there's more than three} 226@d not_found4=49 {like |not_found|, when there's more than four} 227@z 228%--------------------------------------- 229@x [10] m.135 l.2895 - e-TeX TeXXeT 230|fil|, |fill|, or |filll|). The |subtype| field is not used. 231@y 232|fil|, |fill|, or |filll|). The |subtype| field is not used in \TeX. 233In \eTeX\ the |subtype| field records the box direction mode |box_lr|. 234@z 235%--------------------------------------- 236@x [10] m.141 l.2980 - e-TeX marks 237This field occupies a full word instead of a halfword, because 238there's nothing to put in the other halfword; it is easier in \PASCAL\ to 239use the full word than to risk leaving garbage in the unused half. 240@y 241In addition there is a |mark_class| field that contains the mark class. 242@z 243%--------------------------------------- 244@x [10] m.141 l.2986 - e-TeX marks 245@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark} 246@y 247@d mark_ptr(#)==link(#+1) {head of the token list for a mark} 248@d mark_class(#)==info(#+1) {the mark class} 249@z 250%--------------------------------------- 251@x [10] m.142 l.2995 - e-TeX marks 252@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list} 253@y 254@d adjust_ptr(#)==mem[#+1].int 255 {vertical list to be moved out of horizontal list} 256@z 257%--------------------------------------- 258@x [10] m.147 l.3084 - e-TeX TeXXeT 259the amount of surrounding space inserted by \.{\\mathsurround}. 260@y 261the amount of surrounding space inserted by \.{\\mathsurround}. 262 263In addition a |math_node| with |subtype>after| and |width=0| will be 264(ab)used to record a regular |math_node| reinserted after being 265discarded at a line break or one of the text direction primitives ( 266\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ). 267@z 268%--------------------------------------- 269@x [10] m.147 l.3088 - e-TeX TeXXeT 270@d after=1 {|subtype| for math node that winds up a formula} 271@y 272@d after=1 {|subtype| for math node that winds up a formula} 273@# 274@d M_code=2 275@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node} 276@d end_M_code=M_code+after {|subtype| for \.{\\endM} node} 277@d L_code=4 278@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node} 279@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node} 280@d R_code=L_code+L_code 281@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node} 282@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node} 283@# 284@d end_LR(#)==odd(subtype(#)) 285@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code) 286@d begin_LR_type(#)==(#-after+before) 287@z 288%--------------------------------------- 289@x [12] m.175 l.3561 - e-TeX TeXXeT 290math_node: print_char("$"); 291@y 292math_node: if subtype(p)>=L_code then print("[]") 293 else print_char("$"); 294@z 295%--------------------------------------- 296@x [12] m.184 l.3728 - e-TeX TeXXeT 297 begin print(", shifted "); print_scaled(shift_amount(p)); 298 end; 299@y 300 begin print(", shifted "); print_scaled(shift_amount(p)); 301 end; 302 if eTeX_ex then @<Display if this box is never to be reversed@>; 303@z 304%--------------------------------------- 305@x [12] m.192 l.3826 - e-TeX TeXXeT 306begin print_esc("math"); 307@y 308if subtype(p)>after then 309 begin if end_LR(p) then print_esc("end") 310 else print_esc("begin"); 311 if subtype(p)>R_code then print_char("R") 312 else if subtype(p)>L_code then print_char("L") 313 else print_char("M"); 314 end else 315begin print_esc("math"); 316@z 317%--------------------------------------- 318@x [12] m.196 l.3859 - e-TeX marks 319begin print_esc("mark"); print_mark(mark_ptr(p)); 320@y 321begin print_esc("mark"); 322if mark_class(p)<>0 then 323 begin print_char("s"); print_int(mark_class(p)); 324 end; 325print_mark(mark_ptr(p)); 326@z 327%--------------------------------------- 328@x [15] m.208 l.4096 - e-TeX saved_items 329@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} 330@y 331@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} 332 {( or \.{\\pagediscards}, \.{\\splitdiscards} )} 333@z 334%--------------------------------------- 335@x [15] m.208 l.4106 - e-TeX TeXXeT 336@d valign=33 {vertical table alignment ( \.{\\valign} )} 337@y 338@d valign=33 {vertical table alignment ( \.{\\valign} )} 339 {or text direction directives ( \.{\\beginL}, etc.~)} 340@z 341%--------------------------------------- 342@x [15] m.208 l.4122 - e-TeX middle 343@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} 344@y 345@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} 346 {( or \.{\\middle} )} 347@z 348%--------------------------------------- 349@x [15] m.209 l.4166 - e-TeX basic 350 \.{\\insertpenalties} )} 351@y 352 \.{\\insertpenalties} )} 353 {( or \.{\\interactionmode} )} 354@z 355%--------------------------------------- 356@x [15] m.209 l.4168 - e-TeX penalties 357@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )} 358@y 359@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )} 360 {(or \.{\\interlinepenalties}, etc.~)} 361@z 362%--------------------------------------- 363@x [15] m.209 l.4178 - e-TeX protected 364@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} 365@y 366@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} 367 {( or \.{\\protected} )} 368@z 369%--------------------------------------- 370@x [15] m.209 l.4181 - e-TeX read_line 371@d read_to_cs=96 {read into a control sequence ( \.{\\read} )} 372@y 373@d read_to_cs=96 {read into a control sequence ( \.{\\read} )} 374 {( or \.{\\readline} )} 375@z 376%--------------------------------------- 377@x [15] m.210 l.4196 - e-TeX scan_tokens 378@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )} 379@y 380@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )} 381 {( or \.{\\scantokens} )} 382@z 383%--------------------------------------- 384@x [15] m.210 l.4201 - e-TeX unexpanded 385@d the=max_command+9 {expand an internal quantity ( \.{\\the} )} 386@y 387@d the=max_command+9 {expand an internal quantity ( \.{\\the} )} 388 {( or \.{\\unexpanded}, \.{\\detokenize} )} 389@z 390%--------------------------------------- 391@x [16] m.212 l.4304 - e-TeX basic 392user's output routine. 393@y 394user's output routine. 395 396A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX. 397In vertical modes it is known as |LR_save| and holds the LR stack when a 398paragraph is interrupted by a displayed formula. In display math mode 399it is known as |LR_box| and holds a pointer to a prototype box for the 400display. In math mode it is known as |delim_ptr| and points to the most 401recent |left_noad| or |middle_noad| of a |math_left_group|. 402@z 403%--------------------------------------- 404@x [16] m.212 l.4319 - e-TeX basic 405 @!head_field,@!tail_field: pointer; 406@y 407 @!head_field,@!tail_field: pointer; 408 @!eTeX_aux_field: pointer; 409@z 410%--------------------------------------- 411@x [16] m.213 l.4326 - e-TeX basic 412@d tail==cur_list.tail_field {final node on current list} 413@y 414@d tail==cur_list.tail_field {final node on current list} 415@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX} 416@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted} 417@d LR_box==eTeX_aux {prototype box for display} 418@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group} 419@z 420%--------------------------------------- 421@x [16] m.215 l.4357 - e-TeX basic 422mode:=vmode; head:=contrib_head; tail:=contrib_head; 423@y 424mode:=vmode; head:=contrib_head; tail:=contrib_head; 425eTeX_aux:=null; 426@z 427%--------------------------------------- 428@x [16] m.216 l.4373 push_nest - e-TeX basic 429incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; 430@y 431incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; 432eTeX_aux:=null; 433@z 434%--------------------------------------- 435@x [17] m.230 l.4736 - e-TeX basic, every_eof 436@d toks_base=local_base+10 {table of 256 token list registers} 437@y 438@d tex_toks=local_base+10 {end of \TeX's token list parameters} 439@# 440@d etex_toks_base=tex_toks {base for \eTeX's token list parameters} 441@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}} 442@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters} 443@# 444@d toks_base=etex_toks {table of 256 token list registers} 445@z 446%--------------------------------------- 447@x [17] m.230 l.4737 - e-TeX basic, penalties 448@d box_base=toks_base+256 {table of 256 box registers} 449@y 450@# 451@d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties} 452@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} 453@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} 454@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} 455@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} 456@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} 457@# 458@d box_base=etex_pens {table of 256 box registers} 459@z 460%--------------------------------------- 461@x [17] m.231 l.4802 - e-TeX basic 462 othercases print_esc("errhelp") 463@y 464 @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/ 465 othercases print_esc("errhelp") 466@z 467%--------------------------------------- 468@x [17] m.232 l.4820 - e-TeX penalties 469eq_level(par_shape_loc):=level_one;@/ 470@y 471eq_level(par_shape_loc):=level_one;@/ 472for k:=etex_pen_base to etex_pens-1 do 473 eqtb[k]:=eqtb[par_shape_loc]; 474@z 475%--------------------------------------- 476@x [17] m.233 l.4848 - e-TeX penalties 477if n=par_shape_loc then 478 begin print_esc("parshape"); print_char("="); 479 if par_shape_ptr=null then print_char("0") 480@y 481if (n=par_shape_loc) or ((n>=etex_pen_base) and (n<etex_pens)) then 482 begin print_cmd_chr(set_shape,n); print_char("="); 483 if equiv(n)=null then print_char("0") 484 else if n>par_shape_loc then 485 begin print_int(penalty(equiv(n))); print_char(" "); 486 print_int(penalty(equiv(n)+1)); 487 if penalty(equiv(n))>1 then print_esc("ETC."); 488 end 489@z 490%--------------------------------------- 491@x [17] m.236 l.4969 - e-TeX basic 492@d int_pars=55 {total number of integer parameters} 493@y 494@d tex_int_pars=55 {total number of \TeX's integer parameters} 495@# 496@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters} 497@d tracing_assigns_code=etex_int_base {show assignments} 498@d tracing_groups_code=etex_int_base+1 {show save/restore groups} 499@d tracing_ifs_code=etex_int_base+2 {show conditionals} 500@d tracing_scan_tokens_code=etex_int_base+3 {show pseudo file open and close} 501@d tracing_nesting_code=etex_int_base+4 {show incomplete groups and ifs within files} 502@d pre_display_direction_code=etex_int_base+5 {text direction preceding a display} 503@d last_line_fit_code=etex_int_base+6 {adjustment for last line of paragraph} 504@d saving_vdiscards_code=etex_int_base+7 {save items discarded from vlists} 505@d saving_hyph_codes_code=etex_int_base+8 {save hyphenation codes for languages} 506@d eTeX_state_code=etex_int_base+9 {\eTeX\ state variables} 507@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters} 508@# 509@d int_pars=etex_int_pars {total number of integer parameters} 510@z 511%--------------------------------------- 512@x [17] m.236 l.5031 - e-TeX basic 513@d error_context_lines==int_par(error_context_lines_code) 514@y 515@d error_context_lines==int_par(error_context_lines_code) 516@# 517@d tracing_assigns==int_par(tracing_assigns_code) 518@d tracing_groups==int_par(tracing_groups_code) 519@d tracing_ifs==int_par(tracing_ifs_code) 520@d tracing_scan_tokens==int_par(tracing_scan_tokens_code) 521@d tracing_nesting==int_par(tracing_nesting_code) 522@d pre_display_direction==int_par(pre_display_direction_code) 523@d last_line_fit==int_par(last_line_fit_code) 524@d saving_vdiscards==int_par(saving_vdiscards_code) 525@d saving_hyph_codes==int_par(saving_hyph_codes_code) 526@z 527%--------------------------------------- 528@x [17] m.237 l.5096 print_param - e-TeX basic 529othercases print("[unknown integer parameter!]") 530@y 531@/@<Cases for |print_param|@>@/ 532othercases print("[unknown integer parameter!]") 533@z 534%--------------------------------------- 535@x [18] m.264 l.5627 primitive - e-TeX basic 536@!j:small_number; {index into |buffer|} 537@y 538@!j:0..buf_size; {index into |buffer|} 539@z 540%--------------------------------------- 541@x [18] m.264 l.5631 primitive - e-TeX basic 542 {we will move |s| into the (empty) |buffer|} 543 for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); 544 cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|} 545@y 546 {we will move |s| into the (possibly non-empty) |buffer|} 547 if first+l>buf_size+1 then 548 overflow("buffer size",buf_size); 549@:TeX capacity exceeded buffer size}{\quad buffer size@> 550 for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); 551 cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} 552@z 553%--------------------------------------- 554@x [18] m.265 l.5706 - e-TeX penalties 555primitive("parshape",set_shape,0);@/ 556@y 557primitive("parshape",set_shape,par_shape_loc);@/ 558@z 559%--------------------------------------- 560@x [18] m.265 l.5723 - e-TeX sparse arrays 561primitive("toks",toks_register,0);@/ 562@y 563primitive("toks",toks_register,mem_bot);@/ 564@z 565%--------------------------------------- 566@x [18] m.266 l.5756 - e-TeX cond 567expand_after: print_esc("expandafter"); 568@y 569expand_after: if chr_code=0 then print_esc("expandafter") 570 @<Cases of |expandafter| for |print_cmd_chr|@>; 571@z 572%--------------------------------------- 573@x [18] m.266 l.5762 - e-TeX marks 574mark: print_esc("mark"); 575@y 576mark: begin print_esc("mark"); 577 if chr_code>0 then print_char("s"); 578 end; 579@z 580%--------------------------------------- 581@x [18] m.266 l.5773 - e-TeX read_line 582read_to_cs: print_esc("read"); 583@y 584read_to_cs: if chr_code=0 then print_esc("read") 585 @<Cases of |read| for |print_cmd_chr|@>; 586@z 587%--------------------------------------- 588@x [18] m.266 l.5777 - e-TeX penalties 589set_shape: print_esc("parshape"); 590@y 591set_shape: case chr_code of 592 par_shape_loc: print_esc("parshape"); 593 @<Cases of |set_shape| for |print_cmd_chr|@>@;@/ 594 end; {there are no other cases} 595@z 596%--------------------------------------- 597@x [18] m.266 l.5778 - e-TeX unexpanded 598the: print_esc("the"); 599@y 600the: if chr_code=0 then print_esc("the") 601 @<Cases of |the| for |print_cmd_chr|@>; 602@z 603%--------------------------------------- 604@x [18] m.266 l.5779 - e-TeX sparse arrays 605toks_register: print_esc("toks"); 606@y 607toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>; 608@z 609%--------------------------------------- 610@x [18] m.266 l.5781 - e-TeX TeXXeT 611valign: print_esc("valign"); 612@y 613valign: if chr_code=0 then print_esc("valign")@/ 614 @<Cases of |valign| for |print_cmd_chr|@>; 615@z 616%--------------------------------------- 617@x [19] m.268 l.5815 - e-TeX sparse arrays 618interpreted in one of four ways: 619@y 620interpreted in one of five ways: 621@z 622%--------------------------------------- 623@x [19] m.268 l.5835 - e-TeX tracing 624the entries for that group. 625@y 626the entries for that group. 627Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the 628source line number at which the current level of grouping was entered. 629 630\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a 631chain of sparse array entries to be restored at the end of the current 632group. Furthermore |save_index(p)| and |save_level(p)| should replace 633the values of |sa_chain| and |sa_level| respectively. 634@z 635%--------------------------------------- 636@x [19] m.268 l.5845 - e-TeX basic 637@d level_boundary=3 {|save_type| corresponding to beginning of group} 638@y 639@d level_boundary=3 {|save_type| corresponding to beginning of group} 640@d restore_sa=4 {|save_type| when sparse array entries should be restored} 641 642@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@> 643@z 644%--------------------------------------- 645@x [19] m.273 l.5903 - e-TeX tracing 646@ The following macro is used to test if there is room for up to six more 647@y 648@ The following macro is used to test if there is room for up to seven more 649@z 650%--------------------------------------- 651@x [19] m.273 l.5909 check_full_save_stack - e-TeX tracing 652 if max_save_stack>save_size-6 then overflow("save size",save_size); 653@y 654 if max_save_stack>save_size-7 then overflow("save size",save_size); 655@z 656%--------------------------------------- 657@x [19] m.274 l.5931 new_save_level - e-TeX tracing 658begin check_full_save_stack; 659@y 660begin check_full_save_stack; 661if eTeX_ex then 662 begin saved(0):=line; incr(save_ptr); 663 end; 664@z 665%--------------------------------------- 666@x [19] m.274 l.5938 new_save_level - e-TeX tracing 667cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c; 668@y 669cur_boundary:=save_ptr; cur_group:=c; 670@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/ 671incr(cur_level); incr(save_ptr); 672@z 673%--------------------------------------- 674@x [19] m.275 l.5956 eq_destroy - e-TeX sparse arrays 675othercases do_nothing 676@y 677@/@<Cases for |eq_destroy|@>@/ 678othercases do_nothing 679@z 680%--------------------------------------- 681@x [19] m.277 l.5978 - e-TeX tracing 682the call, since |eq_save| makes the necessary test. 683@y 684the call, since |eq_save| makes the necessary test. 685 686@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#); 687 tats 688@z 689%--------------------------------------- 690@x [19] m.277 l.5982 eq_define - e-TeX tracing 691begin if eq_level(p)=cur_level then eq_destroy(eqtb[p]) 692@y 693label exit; 694begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then 695 begin assign_trace(p,"reassigning")@;@/ 696 eq_destroy(eqtb[p]); return; 697 end; 698assign_trace(p,"changing")@;@/ 699if eq_level(p)=cur_level then eq_destroy(eqtb[p]) 700@z 701%--------------------------------------- 702@x [19] m.277 l.5985 eq_define - e-TeX tracing 703end; 704@y 705assign_trace(p,"into")@;@/ 706exit:end; 707@z 708%--------------------------------------- 709@x [19] m.278 l.5992 eq_word_define - e-TeX tracing 710begin if xeq_level[p]<>cur_level then 711@y 712label exit; 713begin if eTeX_ex and(eqtb[p].int=w) then 714 begin assign_trace(p,"reassigning")@;@/ 715 return; 716 end; 717assign_trace(p,"changing")@;@/ 718if xeq_level[p]<>cur_level then 719@z 720%--------------------------------------- 721@x [19] m.278 l.5996 eq_word_define - e-TeX tracing 722end; 723@y 724assign_trace(p,"into")@;@/ 725exit:end; 726@z 727%--------------------------------------- 728@x [19] m.279 l.6005 geq_define - e-TeX tracing 729begin eq_destroy(eqtb[p]); 730eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e; 731@y 732begin assign_trace(p,"globally changing")@;@/ 733begin eq_destroy(eqtb[p]); 734eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e; 735end; 736assign_trace(p,"into")@;@/ 737@z 738%--------------------------------------- 739@x [19] m.279 l.6010 geq_word_define - e-TeX tracing 740begin eqtb[p].int:=w; xeq_level[p]:=level_one; 741@y 742begin assign_trace(p,"globally changing")@;@/ 743begin eqtb[p].int:=w; xeq_level[p]:=level_one; 744end; 745assign_trace(p,"into")@;@/ 746@z 747%--------------------------------------- 748@x [19] m.281 l.6027 - e-TeX tracing 749@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/ 750@y 751@p 752@z 753%--------------------------------------- 754@x [19] m.281 l.6034 unsave - e-TeX optimized \aftergroup 755begin if cur_level>level_one then 756@y 757@!a:boolean; {have we already processed an \.{\\aftergroup} ?} 758begin a:=false; 759if cur_level>level_one then 760@z 761%--------------------------------------- 762@x [19] m.282 l.6048 - e-TeX sparse arrays 763 else begin if save_type(save_ptr)=restore_old_value then 764@y 765 else if save_type(save_ptr)=restore_sa then 766 begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr); 767 end 768 else begin if save_type(save_ptr)=restore_old_value then 769@z 770%--------------------------------------- 771@x [19] m.282 l.6056 - e-TeX tracing 772done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr) 773@y 774done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/ 775if grp_stack[in_open]=cur_boundary then group_warning; 776 {groups possibly not properly nested with files} 777cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr); 778if eTeX_ex then decr(save_ptr) 779@z 780%--------------------------------------- 781@x [19] m.284 l.6082 - e-TeX tracing 782@ @<Declare the procedure called |restore_trace|@>= 783@y 784@ @<Declare \eTeX\ procedures for tr...@>= 785@z 786%--------------------------------------- 787@x [20] m.289 l.6170 - e-TeX protected 788@d end_match_token=@'7000 {$2^8\cdot|end_match|$} 789@y 790@d end_match_token=@'7000 {$2^8\cdot|end_match|$} 791@d protected_token=@'7001 {$2^8\cdot|end_match|+1$} 792@z 793%--------------------------------------- 794@x [20] m.294 l.6295 - e-TeX protected 795end_match: print("->"); 796@y 797end_match: if c=0 then print("->"); 798@z 799%--------------------------------------- 800@x [20] m.296 l.6316 print_meaning - e-TeX marks 801else if cur_cmd=top_bot_mark then 802@y 803else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then 804@z 805%--------------------------------------- 806@x [21] m.298 l.6390 print_cmd_chr - e-TeX protected 807procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); 808@y 809procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); 810var n:integer; {temp variable} 811@z 812%--------------------------------------- 813@x [21] m.299 l.6409 show_cur_cmd_chr - e-TeX tracing 814@p procedure show_cur_cmd_chr; 815@y 816@p procedure show_cur_cmd_chr; 817var n:integer; {level of \.{\\if...\\fi} nesting} 818@!l:integer; {line where \.{\\if} started} 819@!p:pointer; 820@z 821%--------------------------------------- 822@x [21] m.299 l.6414 show_cur_cmd_chr - e-TeX tracing 823print_cmd_chr(cur_cmd,cur_chr); print_char("}"); 824@y 825print_cmd_chr(cur_cmd,cur_chr); 826if tracing_ifs>0 then 827 if cur_cmd>=if_test then if cur_cmd<=fi_or_else then 828 begin print(": "); 829 if cur_cmd=fi_or_else then 830 begin print_cmd_chr(if_test,cur_if); print_char(" "); 831 n:=0; l:=if_line; 832 end 833 else begin n:=1; l:=line; 834 end; 835 p:=cond_ptr; 836 while p<>null do 837 begin incr(n); p:=link(p); 838 end; 839 print("(level "); print_int(n); print_char(")"); print_if_line(l); 840 end; 841print_char("}"); 842@z 843%--------------------------------------- 844@x [22] m.303 l.6490 show_context - e-TeX scan_tokens 845the terminal, under control of the procedure |read_toks|.) 846@y 847the terminal, under control of the procedure |read_toks|.) 848Finally |18<=name<=19| indicates that we are reading a pseudo file 849created by the \.{\\scantokens} command. 850@z 851%--------------------------------------- 852@x [22] m.307 l.6687 - e-TeX basic, every_eof 853only if |token_type>=macro|. 854@^reference counts@> 855@y 856only if |token_type>=macro|. 857@^reference counts@> 858 859Since \eTeX's additional token list parameters precede |toks_base|, the 860corresponding token types must precede |write_text|. 861@z 862%--------------------------------------- 863@x [22] m.307 l.6708 - e-TeX basic 864@d write_text=15 {|token_type| code for \.{\\write}} 865@y 866@# 867@d eTeX_text_offset=output_routine_loc-output_text 868@d every_eof_text=every_eof_loc-eTeX_text_offset 869 {|token_type| code for \.{\\everyeof}} 870@# 871@d write_text=toks_base-eTeX_text_offset {|token_type| code for \.{\\write}} 872@z 873%--------------------------------------- 874@x [22] m.311 l.6764 show_context - e-TeX scan_tokens 875 if (name>17) or (base_ptr=0) then bottom_line:=true; 876@y 877 if (name>19) or (base_ptr=0) then bottom_line:=true; 878@z 879%--------------------------------------- 880@x [22] m.313 l.6809 - e-TeX scan_tokens 881else begin print_nl("l."); print_int(line); 882@y 883else begin print_nl("l."); 884 if index=in_open then print_int(line) 885 else print_int(line_stack[index+1]); {input from a pseudo file} 886@z 887%--------------------------------------- 888@x [22] m.314 l.6831 - e-TeX basic 889write_text: print_nl("<write> "); 890@y 891every_eof_text: print_nl("<everyeof> "); 892write_text: print_nl("<write> "); 893@z 894%--------------------------------------- 895@x [23] m.326 l.7024 - e-TeX optimized \aftergroup 896begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t; 897@y 898begin t:=cur_tok; cur_tok:=p; 899if a then 900 begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p; 901 if cur_tok<right_brace_limit then 902 if cur_tok<left_brace_limit then decr(align_state) 903 else incr(align_state); 904 end 905else begin back_input; a:=eTeX_ex; 906 end; 907cur_tok:=t; 908@z 909%--------------------------------------- 910@x [23] m.328 l.7052 begin_file_reading - e-TeX every_eof, tracing_nesting 911incr(in_open); push_input; index:=in_open; 912@y 913incr(in_open); push_input; index:=in_open; 914eof_seen[index]:=false; 915grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr; 916@z 917%--------------------------------------- 918@x [23] m.329 l.7062 end_file_reading - e-TeX scan_tokens 919if name>17 then a_close(cur_file); {forget it} 920@y 921if (name=18)or(name=19) then pseudo_close else 922if name>17 then a_close(cur_file); {forget it} 923@z 924%--------------------------------------- 925@x [23] m.331 l.7081 - e-TeX tracing_nesting 926in_open:=0; open_parens:=0; max_buf_stack:=0; 927@y 928in_open:=0; open_parens:=0; max_buf_stack:=0; 929grp_stack[0]:=0; if_stack[0]:=null; 930@z 931%--------------------------------------- 932@x [24] m.362 l.7553 - e-TeX scan_tokens, every_eof 933if not force_eof then 934@y 935if not force_eof then 936 if name<=19 then 937 begin if pseudo_input then {not end of file} 938 firm_up_the_line {this sets |limit|} 939 else if (every_eof<>null)and not eof_seen[index] then 940 begin limit:=first-1; eof_seen[index]:=true; {fake one empty line} 941 begin_token_list(every_eof,every_eof_text); goto restart; 942 end 943 else force_eof:=true; 944 end 945 else 946@z 947%--------------------------------------- 948@x [24] m.362 l.7556 - e-TeX every_eof 949 else force_eof:=true; 950@y 951 else if (every_eof<>null)and not eof_seen[index] then 952 begin limit:=first-1; eof_seen[index]:=true; {fake one empty line} 953 begin_token_list(every_eof,every_eof_text); goto restart; 954 end 955 else force_eof:=true; 956@z 957%--------------------------------------- 958@x [24] m.362 l.7559 - e-TeX scan_tokens 959 begin print_char(")"); decr(open_parens); 960 update_terminal; {show user that file has been read} 961@y 962 begin if tracing_nesting>0 then 963 if (grp_stack[in_open]<>cur_boundary)or@| 964 (if_stack[in_open]<>cond_ptr) then file_warning; 965 {give warning for some unfinished groups and/or conditionals} 966 if name>=19 then 967 begin print_char(")"); decr(open_parens); 968 update_terminal; {show user that file has been read} 969 end; 970@z 971%--------------------------------------- 972@x [25] m.366 l.7643 - e-TeX basic 973@t\4@>@<Declare the procedure called |insert_relax|@>@;@/ 974@y 975@t\4@>@<Declare the procedure called |insert_relax|@>@;@/ 976@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/ 977@z 978%--------------------------------------- 979@x [25] m.366 l.7650 expand - e-TeX cond 980procedure expand; 981@y 982procedure expand; 983label reswitch; 984@z 985%--------------------------------------- 986@x [25] m.366 l.7661 expand - e-TeX cond 987if cur_cmd<call then @<Expand a nonmacro@> 988@y 989reswitch: 990if cur_cmd<call then @<Expand a nonmacro@> 991@z 992%--------------------------------------- 993@x [25] m.367 l.7672 - e-TeX cond 994expand_after:@<Expand the token after the next token@>; 995@y 996expand_after:if cur_chr=0 then @<Expand the token after the next token@> 997 else @<Negate a boolean conditional and |goto reswitch|@>; 998@z 999%--------------------------------------- 1000@x [25] m.377 l.7792 - e-TeX scan_tokens 1001input: if chr_code=0 then print_esc("input")@+else print_esc("endinput"); 1002@y 1003input: if chr_code=0 then print_esc("input") 1004 @/@<Cases of |input| for |print_cmd_chr|@>@/ 1005 else print_esc("endinput"); 1006@z 1007%--------------------------------------- 1008@x [25] m.378 l.7795 - e-TeX scan_tokens 1009if cur_chr>0 then force_eof:=true 1010@y 1011if cur_chr=1 then force_eof:=true 1012@/@<Cases for |input|@>@/ 1013@z 1014%--------------------------------------- 1015@x [25] m.382 l.7851 - e-TeX marks 1016@d top_mark_code=0 {the mark in effect at the previous page break} 1017@y 1018@d marks_code==5 {add this for \.{\\topmarks} etc.} 1019@# 1020@d top_mark_code=0 {the mark in effect at the previous page break} 1021@z 1022%--------------------------------------- 1023@x [25] m.385 l.7883 - e-TeX marks 1024top_bot_mark: case chr_code of 1025@y 1026top_bot_mark: begin case (chr_code mod marks_code) of 1027@z 1028%--------------------------------------- 1029@x [25] m.385 l.7889 - e-TeX marks 1030 endcases; 1031@y 1032 endcases; 1033 if chr_code>=marks_code then print_char("s"); 1034 end; 1035@z 1036%--------------------------------------- 1037@x [25] m.386 l.7895 - e-TeX marks 1038begin if cur_mark[cur_chr]<>null then 1039 begin_token_list(cur_mark[cur_chr],mark_text); 1040@y 1041begin t:=cur_chr mod marks_code; 1042if cur_chr>=marks_code then scan_register_num@+else cur_val:=0; 1043if cur_val=0 then cur_ptr:=cur_mark[t] 1044else @<Compute the mark pointer for mark type |t| and class |cur_val|@>; 1045if cur_ptr<>null then begin_token_list(cur_ptr,mark_text); 1046@z 1047%--------------------------------------- 1048@x [25] m.389 l.7958 macro_call - e-TeX protected 1049if info(r)<>end_match_token then 1050@y 1051if info(r)=protected_token then r:=link(r); 1052if info(r)<>end_match_token then 1053@z 1054%--------------------------------------- 1055@x [26] m.409 l.8270 - e-TeX basic 1056@t\4\4@>@<Declare procedures that scan font-related stuff@> 1057@y 1058@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@; 1059@t\4\4@>@<Declare procedures that scan font-related stuff@> 1060@z 1061%--------------------------------------- 1062@x [26] m.411 l.8314 - e-TeX sparse arrays 1063|glue_val|, or |mu_val|. 1064@y 1065|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes 1066cannot have these values) 1067@z 1068%--------------------------------------- 1069@x [26] m.411 l.8317 - e-TeX sparse arrays 1070primitive("count",register,int_val); 1071@!@:count_}{\.{\\count} primitive@> 1072primitive("dimen",register,dimen_val); 1073@!@:dimen_}{\.{\\dimen} primitive@> 1074primitive("skip",register,glue_val); 1075@!@:skip_}{\.{\\skip} primitive@> 1076primitive("muskip",register,mu_val); 1077@y 1078primitive("count",register,mem_bot+int_val); 1079@!@:count_}{\.{\\count} primitive@> 1080primitive("dimen",register,mem_bot+dimen_val); 1081@!@:dimen_}{\.{\\dimen} primitive@> 1082primitive("skip",register,mem_bot+glue_val); 1083@!@:skip_}{\.{\\skip} primitive@> 1084primitive("muskip",register,mem_bot+mu_val); 1085@z 1086%--------------------------------------- 1087@x [26] m.412 l.8327 - e-TeX sparse arrays 1088register: if chr_code=int_val then print_esc("count") 1089 else if chr_code=dimen_val then print_esc("dimen") 1090 else if chr_code=glue_val then print_esc("skip") 1091 else print_esc("muskip"); 1092@y 1093register: @<Cases of |register| for |print_cmd_chr|@>; 1094@z 1095%--------------------------------------- 1096@x [26] m.413 l.8343 scan_something_internal - e-TeX basic 1097var m:halfword; {|chr_code| part of the operand token} 1098@y 1099label exit; 1100var m:halfword; {|chr_code| part of the operand token} 1101@!q,@!r:pointer; {general purpose indices} 1102@!tx:pointer; {effective tail node} 1103@!i:four_quarters; {character info} 1104@z 1105%--------------------------------------- 1106@x [26] m.413 l.8369 scan_something_internal - e-TeX basic 1107end; 1108@y 1109exit:end; 1110@z 1111%--------------------------------------- 1112@x [26] m.415 l.8390 - e-TeX sparse arrays 1113 begin scan_eight_bit_int; m:=toks_base+cur_val; 1114 end; 1115 scanned_result(equiv(m))(tok_val); 1116@y 1117 if m=mem_bot then 1118 begin scan_register_num; 1119 if cur_val<256 then cur_val:=equiv(toks_base+cur_val) 1120 else begin find_sa_element(tok_val,cur_val,false); 1121 if cur_ptr=null then cur_val:=null 1122 else cur_val:=sa_ptr(cur_ptr); 1123 end; 1124 end 1125 else cur_val:=sa_ptr(m) 1126 else cur_val:=equiv(m); 1127 cur_val_level:=tok_val; 1128@z 1129%--------------------------------------- 1130@x [26] m.416 l.8405 - e-TeX basic 1131|glue_val|, |input_line_no_code|, or |badness_code|. 1132@y 1133|glue_val|, |input_line_no_code|, or |badness_code|. 1134\eTeX\ inserts |last_node_type_code| after |glue_val| and adds 1135the codes for its extensions: |eTeX_version_code|, \dots\ . 1136@z 1137%--------------------------------------- 1138@x [26] m.416 l.8407 - e-TeX basic 1139@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} 1140@d badness_code=glue_val+2 {code for \.{\\badness}} 1141@y 1142@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}} 1143@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}} 1144@d badness_code=input_line_no_code+1 {code for \.{\\badness}} 1145@# 1146@d eTeX_int=badness_code+1 {first of \eTeX\ codes for integers} 1147@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions} 1148@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue} 1149@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue} 1150@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions} 1151@z 1152%--------------------------------------- 1153@x [26] m.417 l.8440 - e-TeX interaction_mode 1154@+else print_esc("insertpenalties"); 1155@y 1156@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/ 1157@+else print_esc("insertpenalties"); 1158@z 1159%--------------------------------------- 1160@x [26] m.417 l.8449 - e-TeX basic 1161 othercases print_esc("badness") 1162@y 1163 @/@<Cases of |last_item| for |print_cmd_chr|@>@/ 1164 othercases print_esc("badness") 1165@z 1166%--------------------------------------- 1167@x [26] m.419 l.8469 - e-TeX interaction_mode 1168begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties; 1169@y 1170begin if m=0 then cur_val:=dead_cycles 1171@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/ 1172else cur_val:=insert_penalties; 1173@z 1174%--------------------------------------- 1175@x [26] m.420 l.8474 - e-TeX sparse arrays 1176begin scan_eight_bit_int; 1177if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc; 1178@y 1179begin scan_register_num; fetch_box(q); 1180if q=null then cur_val:=0 @+else cur_val:=mem[q+m].sc; 1181@z 1182%--------------------------------------- 1183@x [26] m.423 l.8499 - e-TeX penalties 1184begin if par_shape_ptr=null then cur_val:=0 1185@y 1186begin if m>par_shape_loc then @<Fetch a penalties array element@> 1187else if par_shape_ptr=null then cur_val:=0 1188@z 1189%--------------------------------------- 1190@x [26] m.424 l.8504 - e-TeX \lastnodetype 1191@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, and \.{\\lastskip} are 1192@y 1193@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, \.{\\lastskip}, and 1194\.{\\lastnodetype} are 1195@z 1196%--------------------------------------- 1197@x [26] m.424 l.8508 - e-TeX TeXXeT 1198legal in similar contexts. 1199@y 1200legal in similar contexts. 1201 1202The macro |find_effective_tail_eTeX| sets |tx| to the last non-\.{\\endM} 1203node of the current list. 1204@z 1205%--------------------------------------- 1206@x [26] m.424 l.8510 - e-TeX TeXXeT 1207@<Fetch an item in the current node...@>= 1208@y 1209@d find_effective_tail_eTeX== 1210tx:=tail; 1211if not is_char_node(tx) then 1212 if (type(tx)=math_node)and(subtype(tx)=end_M_code) then 1213 begin r:=head; 1214 repeat q:=r; r:=link(q); 1215 until r=tx; 1216 tx:=q; 1217 end 1218@# 1219@d find_effective_tail==find_effective_tail_eTeX 1220 1221@<Fetch an item in the current node...@>= 1222@z 1223%--------------------------------------- 1224@x [26] m.424 l.8511 - e-TeX basic 1225if cur_chr>glue_val then 1226@y 1227if m>=input_line_no_code then 1228@z 1229%--------------------------------------- 1230@x [26] m.424 l.8512 - e-TeX basic 1231 begin if cur_chr=input_line_no_code then cur_val:=line 1232 else cur_val:=last_badness; {|cur_chr=badness_code|} 1233@y 1234 if m>=eTeX_glue then @<Process an expression and |return|@>@; 1235 else if m>=eTeX_dim then 1236 begin case m of 1237 @/@<Cases for fetching a dimension value@>@/ 1238 end; {there are no other cases} 1239 cur_val_level:=dimen_val; 1240 end 1241 else begin case m of 1242 input_line_no_code: cur_val:=line; 1243 badness_code: cur_val:=last_badness; 1244 @/@<Cases for fetching an integer value@>@/ 1245 end; {there are no other cases} 1246@z 1247%--------------------------------------- 1248@x [26] m.424 l.8517 - e-TeX last_node_type 1249 cur_val_level:=cur_chr; 1250 if not is_char_node(tail)and(mode<>0) then 1251 case cur_chr of 1252 int_val: if type(tail)=penalty_node then cur_val:=penalty(tail); 1253 dimen_val: if type(tail)=kern_node then cur_val:=width(tail); 1254 glue_val: if type(tail)=glue_node then 1255 begin cur_val:=glue_ptr(tail); 1256 if subtype(tail)=mu_glue then cur_val_level:=mu_val; 1257 end; 1258 end {there are no other cases} 1259 else if (mode=vmode)and(tail=head) then 1260@y 1261 find_effective_tail; 1262 if cur_chr=last_node_type_code then 1263 begin cur_val_level:=int_val; 1264 if (tx=head)or(mode=0) then cur_val:=-1; 1265 end 1266 else cur_val_level:=cur_chr; 1267 if not is_char_node(tx)and(mode<>0) then 1268 case cur_chr of 1269 int_val: if type(tx)=penalty_node then cur_val:=penalty(tx); 1270 dimen_val: if type(tx)=kern_node then cur_val:=width(tx); 1271 glue_val: if type(tx)=glue_node then 1272 begin cur_val:=glue_ptr(tx); 1273 if subtype(tx)=mu_glue then cur_val_level:=mu_val; 1274 end; 1275 last_node_type_code: if type(tx)<=unset_node then cur_val:=type(tx)+1 1276 else cur_val:=unset_node+2; 1277 end {there are no other cases} 1278 else if (mode=vmode)and(tx=head) then 1279@z 1280%--------------------------------------- 1281@x [26] m.424 l.8531 - e-TeX last_node_type 1282 glue_val: if last_glue<>max_halfword then cur_val:=last_glue; 1283@y 1284 glue_val: if last_glue<>max_halfword then cur_val:=last_glue; 1285 last_node_type_code: cur_val:=last_node_type; 1286@z 1287%--------------------------------------- 1288@x [26] m.427 l.8547 - e-TeX sparse arrays 1289begin scan_eight_bit_int; 1290case m of 1291@y 1292begin if (m<mem_bot)or(m>lo_mem_stat_max) then 1293 begin cur_val_level:=sa_type(m); 1294 if cur_val_level<glue_val then cur_val:=sa_int(m) 1295 else cur_val:=sa_ptr(m); 1296 end 1297else begin scan_register_num; cur_val_level:=m-mem_bot; 1298 if cur_val>255 then 1299 begin find_sa_element(cur_val_level,cur_val,false); 1300 if cur_ptr=null then 1301 if cur_val_level<glue_val then cur_val:=0 1302 else cur_val:=zero_glue 1303 else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr) 1304 else cur_val:=sa_ptr(cur_ptr); 1305 end 1306 else 1307 case cur_val_level of 1308@z 1309%--------------------------------------- 1310@x [26] m.427 l.8554 - e-TeX sparse arrays 1311cur_val_level:=m; 1312@y 1313 end; 1314@z 1315%--------------------------------------- 1316@x [26] m.461 l.9082 - e-TeX expr 1317exit:end; 1318@y 1319exit:end; 1320@# 1321@<Declare procedures needed for expressions@>@; 1322@z 1323%--------------------------------------- 1324@x [27] m.464 l.9141 - e-TeX basic 1325@p function str_toks(@!b:pool_pointer):pointer; 1326@y 1327@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/ 1328function str_toks(@!b:pool_pointer):pointer; 1329@z 1330%--------------------------------------- 1331@x [27] m.465 l.9166 the_toks - e-TeX unexpanded 1332@p function the_toks:pointer; 1333@y 1334@p function the_toks:pointer; 1335label exit; 1336@z 1337%--------------------------------------- 1338@x [27] m.465 l.9170 the_toks - e-TeX unexpanded 1339begin get_x_token; scan_something_internal(tok_val,false); 1340@y 1341@!c:small_number; {value of |cur_chr|} 1342begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/ 1343get_x_token; scan_something_internal(tok_val,false); 1344@z 1345%--------------------------------------- 1346@x [27] m.465 l.9184 the_toks - e-TeX unexpanded 1347end; 1348@y 1349exit:end; 1350@z 1351%--------------------------------------- 1352@x [27] m.468 l.9207 - e-TeX basic 1353@d number_code=0 {command code for \.{\\number}} 1354@y 1355\eTeX\ adds \.{\\eTeXrevision} such that |job_name_code| remains last. 1356 1357@d number_code=0 {command code for \.{\\number}} 1358@z 1359%--------------------------------------- 1360@x [27] m.468 l.9212 - e-TeX basic 1361@d job_name_code=5 {command code for \.{\\jobname}} 1362@y 1363@d etex_convert_base=5 {base for \eTeX's command codes} 1364@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} 1365@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes} 1366@d job_name_code=etex_convert_codes {command code for \.{\\jobname}} 1367@z 1368%--------------------------------------- 1369@x [27] m.469 l.9235 - e-TeX basic 1370 othercases print_esc("jobname") 1371@y 1372 eTeX_revision_code: print_esc("eTeXrevision"); 1373 othercases print_esc("jobname") 1374@z 1375%--------------------------------------- 1376@x [27] m.471 l.9260 - e-TeX basic 1377job_name_code: if job_name=0 then open_log_file; 1378@y 1379eTeX_revision_code: do_nothing; 1380job_name_code: if job_name=0 then open_log_file; 1381@z 1382%--------------------------------------- 1383@x [27] m.472 l.9276 - e-TeX basic 1384job_name_code: print(job_name); 1385@y 1386eTeX_revision_code: print(eTeX_revision); 1387job_name_code: print(job_name); 1388@z 1389%--------------------------------------- 1390@x [27] m.478 l.9386 - e-TeX protected 1391 if cur_cmd<=max_command then goto done2; 1392@y 1393 if cur_cmd>=call then 1394 if info(link(cur_chr))=protected_token then 1395 begin cur_cmd:=relax; cur_chr:=no_expand_flag; 1396 end; 1397 if cur_cmd<=max_command then goto done2; 1398@z 1399%--------------------------------------- 1400@x [27] m.482 l.9434 read_toks - e-TeX read_line 1401@p procedure read_toks(@!n:integer;@!r:pointer); 1402@y 1403@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword); 1404@z 1405%--------------------------------------- 1406@x [27] m.483 l.9460 - e-TeX read_line 1407loop@+ begin get_token; 1408@y 1409@<Handle \.{\\readline} and |goto done|@>;@/ 1410loop@+ begin get_token; 1411@z 1412%--------------------------------------- 1413@x [28] m.487 l.9512 - e-TeX cond 1414@d if_char_code=0 { `\.{\\if}' } 1415@y 1416@d unless_code=32 {amount added for `\.{\\unless}' prefix} 1417@# 1418@d if_char_code=0 { `\.{\\if}' } 1419@z 1420%--------------------------------------- 1421@x [28] m.488 l.9567 - e-TeX cond 1422if_test: case chr_code of 1423@y 1424if_test: begin if chr_code>=unless_code then print_esc("unless"); 1425case chr_code mod unless_code of 1426@z 1427%--------------------------------------- 1428@x [28] m.488 l.9584 - e-TeX cond 1429 othercases print_esc("if") 1430 endcases; 1431@y 1432 @/@<Cases of |if_test| for |print_cmd_chr|@>@/ 1433 othercases print_esc("if") 1434 endcases; 1435end; 1436@z 1437%--------------------------------------- 1438@x [28] m.494 l.9658 pass_text - e-TeX tracing 1439done: scanner_status:=save_scanner_status; 1440@y 1441done: scanner_status:=save_scanner_status; 1442if tracing_ifs>0 then show_cur_cmd_chr; 1443@z 1444%--------------------------------------- 1445@x [28] m.496 l.9674 - e-TeX tracing_nesting 1446begin p:=cond_ptr; if_line:=if_line_field(p); 1447@y 1448begin if if_stack[in_open]=cond_ptr then if_warning; 1449 {conditionals possibly not properly nested with files} 1450p:=cond_ptr; if_line:=if_line_field(p); 1451@z 1452%--------------------------------------- 1453@x [28] m.498 l.9711 conditional - e-TeX cond 1454begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/ 1455@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>; 1456@y 1457@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?} 1458begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr; 1459@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr; 1460is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/ 1461@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>; 1462if is_unless then b:=not b; 1463@z 1464%--------------------------------------- 1465@x [28] m.501 l.9754 - e-TeX cond 1466if_false_code: b:=false; 1467@y 1468if_false_code: b:=false; 1469@/@<Cases for |conditional|@>@/ 1470@z 1471%--------------------------------------- 1472@x [28] m.505 l.9793 - e-TeX sparse arrays 1473begin scan_eight_bit_int; p:=box(cur_val); 1474@y 1475begin scan_register_num; fetch_box(p); 1476@z 1477%--------------------------------------- 1478@x [28] m.510 l.9883 - e-TeX cond 1479if cur_chr>if_limit then 1480@y 1481begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr; 1482if cur_chr>if_limit then 1483@z 1484%--------------------------------------- 1485@x [28] m.510 l.9894 - e-TeX cond 1486 end 1487@y 1488 end; 1489end 1490@z 1491%--------------------------------------- 1492@x [29] m.536 l.10348 - e-TeX basic 1493print_two(time div 60); print_char(":"); print_two(time mod 60); 1494@y 1495print_two(time div 60); print_char(":"); print_two(time mod 60); 1496if eTeX_ex then 1497 begin; wlog_cr; wlog('entering extended mode'); 1498 end; 1499@z 1500%--------------------------------------- 1501@x [30] m.581 l.11282 char_warning - e-TeX tracing 1502begin if tracing_lost_chars>0 then 1503@y 1504var old_setting: integer; {saved value of |tracing_online|} 1505begin if tracing_lost_chars>0 then 1506 begin old_setting:=tracing_online; 1507 if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; 1508@z 1509%--------------------------------------- 1510@x [30] m.581 l.11289 char_warning - e-TeX tracing 1511end; 1512@y 1513 tracing_online:=old_setting; 1514 end; 1515end; 1516@z 1517%--------------------------------------- 1518@x [32] m.616 l.12257 - e-TeX TeXXeT 1519this is essentially the depth of |push| commands in the \.{DVI} output. 1520@y 1521this is essentially the depth of |push| commands in the \.{DVI} output. 1522 1523For mixed direction text (\TeXXeT) the current text direction is called 1524|cur_dir|. As the box being shipped out will never be used again and 1525soon be recycled, we can simply reverse any R-text (i.e., right-to-left) 1526segments of hlist nodes as well as complete hlist nodes embedded in such 1527segments. Moreover this can be done iteratively rather than recursively. 1528There are, however, two complications related to leaders that require 1529some additional bookkeeping: (1)~One and the same hlist node might be 1530used more than once (but never inside both L- and R-text); and 1531(2)~leader boxes inside hlists must be aligned with respect to the left 1532edge of the original hlist. 1533 1534A math node is changed into a kern node whenever the text direction 1535remains the same, it is replaced by an |edge_node| if the text direction 1536changes; the subtype of an an |hlist_node| inside R-text is changed to 1537|reversed| once its hlist has been reversed. 1538@!@^data structure assumptions@> 1539@z 1540%--------------------------------------- 1541@x [32] m.616 l.12259 - e-TeX TeXXeT 1542@d synch_h==if cur_h<>dvi_h then 1543@y 1544@d reversed=1 {subtype for an |hlist_node| whose hlist has been reversed} 1545@d dlist=2 {subtype for an |hlist_node| from display math mode} 1546@d box_lr(#) == (qo(subtype(#))) {direction mode of a box} 1547@d set_box_lr(#) == subtype(#):=set_box_lr_end 1548@d set_box_lr_end(#) == qi(#) 1549@# 1550@d left_to_right=0 1551@d right_to_left=1 1552@d reflected==1-cur_dir {the opposite of |cur_dir|} 1553@# 1554@d synch_h==if cur_h<>dvi_h then 1555@z 1556%--------------------------------------- 1557@x [32] m.619 l.12327 hlist_out - e-TeX TeXXeT 1558@!edge:scaled; {left edge of sub-box, or right edge of leader space} 1559@y 1560@!edge:scaled; {right edge of sub-box or leader space} 1561@!prev_p:pointer; {one step behind |p|} 1562@z 1563%--------------------------------------- 1564@x [32] m.619 l.12337 hlist_out - e-TeX TeXXeT 1565save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h; 1566@y 1567save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; 1568prev_p:=this_box+list_offset; 1569@<Initialize |hlist_out| for mixed direction typesetting@>; 1570left_edge:=cur_h; 1571@z 1572%--------------------------------------- 1573@x [32] m.619 l.12340 hlist_out - e-TeX TeXXeT 1574prune_movements(save_loc); 1575@y 1576@<Finish |hlist_out| for mixed direction typesetting@>; 1577prune_movements(save_loc); 1578@z 1579%--------------------------------------- 1580@x [32] m.620 l.12359 - e-TeX TeXXeT 1581 p:=link(p); 1582@y 1583 prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|} 1584 p:=link(p); 1585@z 1586%--------------------------------------- 1587@x [32] m.622 l.12384 - e-TeX TeXXeT 1588kern_node,math_node:cur_h:=cur_h+width(p); 1589@y 1590kern_node:cur_h:=cur_h+width(p); 1591math_node: @<Handle a math node in |hlist_out|@>; 1592@z 1593%--------------------------------------- 1594@x [32] m.622 l.12386 - e-TeX TeXXeT 1595othercases do_nothing 1596@y 1597@/@<Cases of |hlist_out| that arise in mixed direction text only@>@; 1598othercases do_nothing 1599@z 1600%--------------------------------------- 1601@x [32] m.622 l.12391 - e-TeX TeXXeT 1602next_p:p:=link(p); 1603@y 1604next_p:prev_p:=p; p:=link(p); 1605@z 1606%--------------------------------------- 1607@x [32] m.623 l.12398 - e-TeX TeXXeT 1608 temp_ptr:=p; edge:=cur_h; 1609@y 1610 temp_ptr:=p; edge:=cur_h+width(p); 1611 if cur_dir=right_to_left then cur_h:=edge; 1612@z 1613%--------------------------------------- 1614@x [32] m.623 l.12401 - e-TeX TeXXeT 1615 cur_h:=edge+width(p); cur_v:=base_line; 1616@y 1617 cur_h:=edge; cur_v:=base_line; 1618@z 1619%--------------------------------------- 1620@x [32] m.625 l.12419 - e-TeX TeXXeT 1621 glue_temp:=-billion 1622 1623@<Move right or output leaders@>= 1624begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g; 1625@y 1626 glue_temp:=-billion 1627@# 1628@d round_glue==g:=glue_ptr(p); rule_wd:=width(g)-cur_g; 1629@z 1630%--------------------------------------- 1631@x [32] m.625 l.12438 - e-TeX TeXXeT 1632rule_wd:=rule_wd+cur_g; 1633@y 1634rule_wd:=rule_wd+cur_g 1635 1636@<Move right or output leaders@>= 1637begin round_glue; 1638if eTeX_ex then @<Handle a glue node for mixed direction typesetting@>; 1639@z 1640%--------------------------------------- 1641@x [32] m.626 l.12454 - e-TeX TeXXeT 1642 edge:=cur_h+rule_wd; lx:=0; 1643@y 1644 if cur_dir=right_to_left then cur_h:=cur_h-10; 1645 edge:=cur_h+rule_wd; lx:=0; 1646@z 1647%--------------------------------------- 1648@x [32] m.626 l.12460 - e-TeX TeXXeT 1649 cur_h:=edge-10; goto next_p; 1650@y 1651 if cur_dir=right_to_left then cur_h:=edge 1652 else cur_h:=edge-10; 1653 goto next_p; 1654@z 1655%--------------------------------------- 1656@x [32] m.628 l.12499 - e-TeX TeXXeT 1657synch_h; save_h:=dvi_h; temp_ptr:=leader_box; 1658@y 1659synch_h; save_h:=dvi_h; temp_ptr:=leader_box; 1660if cur_dir=right_to_left then cur_h:=cur_h+leader_wd; 1661@z 1662%--------------------------------------- 1663@x [32] m.632 l.12573 - e-TeX TeXXeT 1664 cur_h:=left_edge+shift_amount(p); {shift the box right} 1665@y 1666 if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) 1667 else cur_h:=left_edge+shift_amount(p); {shift the box right} 1668@z 1669%--------------------------------------- 1670@x [32] m.633 l.12585 - e-TeX TeXXeT 1671 begin synch_h; synch_v; 1672 dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd); 1673@y 1674 begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd; 1675 synch_h; synch_v; 1676 dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd); 1677 cur_h:=left_edge; 1678@z 1679%--------------------------------------- 1680@x [32] m.637 l.12651 - e-TeX TeXXeT 1681begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/ 1682@y 1683begin if cur_dir=right_to_left then 1684 cur_h:=left_edge-shift_amount(leader_box) 1685 else cur_h:=left_edge+shift_amount(leader_box); 1686synch_h; save_h:=dvi_h;@/ 1687@z 1688%--------------------------------------- 1689@x [32] m.638 l.12688 ship_out - e-TeX TeXXeT 1690@<Ship box |p| out@>; 1691@y 1692@<Ship box |p| out@>; 1693if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>; 1694@z 1695%--------------------------------------- 1696@x [33] m.649 l.12909 hpack - e-TeX TeXXeT 1697h:=0; @<Clear dimensions to zero@>; 1698@y 1699h:=0; @<Clear dimensions to zero@>; 1700if TeXXeT_en then @<Initialize the LR stack@>; 1701@z 1702%--------------------------------------- 1703@x [33] m.649 l.12919 hpack - e-TeX TeXXeT 1704exit: hpack:=r; 1705@y 1706exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>; 1707hpack:=r; 1708@z 1709%--------------------------------------- 1710@x [33] m.651 l.12943 - e-TeX TeXXeT 1711 kern_node,math_node: x:=x+width(p); 1712@y 1713 kern_node: x:=x+width(p); 1714 math_node: begin x:=x+width(p); 1715 if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>; 1716 end; 1717@z 1718%--------------------------------------- 1719@x [34] m.687 l.13514 - e-TeX middle 1720\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is 1721@y 1722\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}. 1723The |nucleus| of such noads is 1724@z 1725%--------------------------------------- 1726@x [34] m.687 l.13531 - e-TeX middle 1727@d delimiter==nucleus {|delimiter| field in left and right noads} 1728@y 1729@d delimiter==nucleus {|delimiter| field in left and right noads} 1730@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}} 1731@z 1732%--------------------------------------- 1733@x [34] m.696 l.13704 - e-TeX middle 1734right_noad: begin print_esc("right"); print_delimiter(delimiter(p)); 1735 end; 1736end; 1737if subtype(p)<>normal then 1738 if subtype(p)=limits then print_esc("limits") 1739 else print_esc("nolimits"); 1740if type(p)<left_noad then print_subsidiary_data(nucleus(p),"."); 1741@y 1742right_noad: begin if subtype(p)=normal then print_esc("right") 1743 else print_esc("middle"); 1744 print_delimiter(delimiter(p)); 1745 end; 1746end; 1747if type(p)<left_noad then 1748 begin if subtype(p)<>normal then 1749 if subtype(p)=limits then print_esc("limits") 1750 else print_esc("nolimits"); 1751 print_subsidiary_data(nucleus(p),"."); 1752 end; 1753@z 1754%--------------------------------------- 1755@x [36] m.727 l.14302 - e-TeX middle 1756done_with_noad: r:=q; r_type:=type(r); 1757@y 1758done_with_noad: r:=q; r_type:=type(r); 1759if r_type=right_noad then 1760 begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>; 1761 end; 1762@z 1763%--------------------------------------- 1764@x [36] m.760 l.14963 - e-TeX middle 1765 r_type:=t; 1766@y 1767 if type(q)=right_noad then t:=open_noad; 1768 r_type:=t; 1769@z 1770%--------------------------------------- 1771@x [36] m.762 l.15004 make_left_right - e-TeX middle 1772begin if style<script_style then cur_size:=text_size 1773else cur_size:=16*((style-text_style) div 2); 1774@y 1775begin cur_style:=style; @<Set up the values...@>; 1776@z 1777%--------------------------------------- 1778@x [37] m.785 l.15495 align_peek - e-TeX protected 1779begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>; 1780@y 1781begin restart: align_state:=1000000; 1782repeat get_x_or_protected; 1783until cur_cmd<>spacer; 1784@z 1785%--------------------------------------- 1786@x [37] m.791 l.15606 fin_col - e-TeX protected 1787align_state:=1000000; @<Get the next non-blank non-call token@>; 1788@y 1789align_state:=1000000; 1790repeat get_x_or_protected; 1791until cur_cmd<>spacer; 1792@z 1793%--------------------------------------- 1794@x [37] m.807 l.15868 - e-TeX TeXXeT 1795 begin type(q):=hlist_node; width(q):=width(p); 1796@y 1797 begin type(q):=hlist_node; width(q):=width(p); 1798 if nest[nest_ptr-1].mode_field=mmode then set_box_lr(q)(dlist); {for |ship_out|} 1799@z 1800%--------------------------------------- 1801@x [37] m.808 l.15886 - e-TeX TeXXeT 1802n:=span_count(r); t:=width(s); w:=t; u:=hold_head; 1803@y 1804n:=span_count(r); t:=width(s); w:=t; u:=hold_head; 1805set_box_lr(r)(0); {for |ship_out|} 1806@z 1807%--------------------------------------- 1808@x [38] m.814 l.16009 - e-TeX penalties 1809There is one explicit parameter: |final_widow_penalty| is the amount of 1810additional penalty to be inserted before the final line of the paragraph. 1811@y 1812There is one explicit parameter: |d| is true for partial paragraphs 1813preceding display math mode; in this case the amount of additional 1814penalty inserted before the final line is |display_widow_penalty| 1815instead of |widow_penalty|. 1816@z 1817%--------------------------------------- 1818@x [38] m.815 l.16036 line_break - e-TeX penalties 1819procedure line_break(@!final_widow_penalty:integer); 1820@y 1821procedure line_break(@!d:boolean); 1822@z 1823%--------------------------------------- 1824@x [38] m.815 l.16046 - e-TeX basic 1825end; 1826@y 1827end; 1828@# 1829@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@> 1830@z 1831%--------------------------------------- 1832@x [38] m.816 l.16066 - e-TeX last_line_fit 1833link(tail):=new_param_glue(par_fill_skip_code); 1834@y 1835link(tail):=new_param_glue(par_fill_skip_code); 1836last_line_fill:=link(tail); 1837@z 1838%--------------------------------------- 1839@x [38] m.819 l.16131 - e-TeX last_line_fit 1840@d active_node_size=3 {number of words in active nodes} 1841@y 1842@d active_node_size_normal=3 {number of words in normal active nodes} 1843@z 1844%--------------------------------------- 1845@x [38] m.827 l.16294 - e-TeX last_line_fit 1846background[6]:=shrink(q)+shrink(r); 1847@y 1848background[6]:=shrink(q)+shrink(r); 1849@<Check for special treatment of last line of paragraph@>; 1850@z 1851%--------------------------------------- 1852@x [38] m.829 l.16345 try_break - e-TeX last_line_fit 1853label exit,done,done1,continue,deactivate; 1854@y 1855label exit,done,done1,continue,deactivate,found,not_found; 1856@z 1857%--------------------------------------- 1858@x [38] m.845 l.16637 - e-TeX last_line_fit 1859total_demerits(q):=minimal_demerits[fit_class]; 1860@y 1861total_demerits(q):=minimal_demerits[fit_class]; 1862if do_last_line_fit then 1863 @<Store \(a)additional data in the new active node@>; 1864@z 1865%--------------------------------------- 1866@x [38] m.846 l.16650 - e-TeX last_line_fit 1867print(" t="); print_int(total_demerits(q)); 1868@y 1869print(" t="); print_int(total_demerits(q)); 1870if do_last_line_fit then @<Print additional data in the new active node@>; 1871@z 1872%--------------------------------------- 1873@x [38] m.851 l.16749 - e-TeX last_line_fit 1874if (b>inf_bad)or(pi=eject_penalty) then 1875@y 1876if do_last_line_fit then @<Adjust \(t)the additional data for last line@>; 1877found: 1878if (b>inf_bad)or(pi=eject_penalty) then 1879@z 1880%--------------------------------------- 1881@x [38] m.852 l.16773 - e-TeX last_line_fit 1882 begin b:=0; fit_class:=decent_fit; {infinite stretch} 1883@y 1884 begin if do_last_line_fit then 1885 begin if cur_p=null then {the last line of a paragraph} 1886 @<Perform computations for last line and |goto found|@>; 1887 shortfall:=0; 1888 end; 1889 b:=0; fit_class:=decent_fit; {infinite stretch} 1890@z 1891%--------------------------------------- 1892@x [38] m.855 l.16830 - e-TeX last_line_fit 1893 best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l; 1894@y 1895 best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l; 1896 if do_last_line_fit then 1897 @<Store \(a)additional data for this feasible break@>; 1898@z 1899%--------------------------------------- 1900@x [39] m.863 l.17003 - e-TeX last_line_fit 1901 end;@+tats@/ 1902@y 1903 end;@+tats@/ 1904if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>; 1905@z 1906%--------------------------------------- 1907@x [39] m.864 l.17014 - e-TeX last_line_fit 1908line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q; 1909@y 1910line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q; 1911if do_last_line_fit then 1912 @<Initialize additional fields of the first active node@>; 1913@z 1914%--------------------------------------- 1915@x [39] m.866 l.17064 - e-TeX TeXXeT 1916math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break; 1917@y 1918math_node: begin if subtype(cur_p)<L_code then auto_breaking:=odd(subtype(cur_p)); 1919 kern_break; 1920@z 1921%--------------------------------------- 1922@x [39] m.876 l.17226 - e-TeX penalties 1923post_line_break(final_widow_penalty) 1924@y 1925post_line_break(d) 1926@z 1927%--------------------------------------- 1928@x [39] m.877 l.17240 post_line_break - e-TeX penalties 1929procedure post_line_break(@!final_widow_penalty:integer); 1930@y 1931procedure post_line_break(@!d:boolean); 1932@z 1933%--------------------------------------- 1934@x [39] m.877 l.17250 post_line_break - e-TeX TeXXeT 1935begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the 1936@y 1937@!LR_ptr:pointer; {stack of LR codes} 1938begin LR_ptr:=LR_save; 1939@<Reverse the links of the relevant passive nodes, setting |cur_p| to the 1940@z 1941%--------------------------------------- 1942@x [39] m.877 l.17263 post_line_break - e-TeX TeXXeT 1943prev_graf:=best_line-1; 1944@y 1945prev_graf:=best_line-1; 1946LR_save:=LR_ptr; 1947@z 1948%--------------------------------------- 1949@x [39] m.879 l.17293 - e-TeX TeXXeT 1950 r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|} 1951@y 1952 r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|} 1953 if type(q)=math_node then if TeXXeT_en then 1954 @<Adjust \(t)the LR stack for the |post_line_break| routine@>; 1955@z 1956%--------------------------------------- 1957@x [39] m.880 l.17310 - e-TeX TeXXeT 1958@<Modify the end of the line to reflect the nature of the break and to include 1959 \.{\\rightskip}; also set the proper value of |disc_break|@>; 1960@y 1961if TeXXeT_en then 1962 @<Insert LR nodes at the beginning of the current line and adjust 1963 the LR stack based on LR nodes in this line@>; 1964@<Modify the end of the line to reflect the nature of the break and to include 1965 \.{\\rightskip}; also set the proper value of |disc_break|@>; 1966if TeXXeT_en then @<Insert LR nodes at the end of the current line@>; 1967@z 1968%--------------------------------------- 1969@x [39] m.881 l.17333 - e-TeX TeXXeT 1970 else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0; 1971@y 1972 else if type(q)=kern_node then width(q):=0 1973 else if type(q)=math_node then 1974 begin width(q):=0; 1975 if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>; 1976 end; 1977@z 1978%--------------------------------------- 1979@x [39] m.890 l.17427 - e-TeX penalties 1980 begin pen:=inter_line_penalty; 1981 if cur_line=prev_graf+1 then pen:=pen+club_penalty; 1982 if cur_line+2=best_line then pen:=pen+final_widow_penalty; 1983@y 1984 begin q:=inter_line_penalties_ptr; 1985 if q<>null then 1986 begin r:=cur_line; 1987 if r>penalty(q) then r:=penalty(q); 1988 pen:=penalty(q+r); 1989 end 1990 else pen:=inter_line_penalty; 1991 q:=club_penalties_ptr; 1992 if q<>null then 1993 begin r:=cur_line-prev_graf; 1994 if r>penalty(q) then r:=penalty(q); 1995 pen:=pen+penalty(q+r); 1996 end 1997 else if cur_line=prev_graf+1 then pen:=pen+club_penalty; 1998 if d then q:=display_widow_penalties_ptr 1999 else q:=widow_penalties_ptr; 2000 if q<>null then 2001 begin r:=best_line-cur_line-1; 2002 if r>penalty(q) then r:=penalty(q); 2003 pen:=pen+penalty(q+r); 2004 end 2005 else if cur_line+2=best_line then 2006 if d then pen:=pen+display_widow_penalty 2007 else pen:=pen+widow_penalty; 2008@z 2009%--------------------------------------- 2010@x [40] m.891 l.17455 - e-TeX TeXXeT 2011implicit kern nodes, and $p_m$ is a glue or penalty or insertion or adjust 2012@y 2013implicit kern or text direction nodes, and $p_m$ is a glue or penalty or 2014insertion or adjust 2015@z 2016%--------------------------------------- 2017@x [40] m.891 l.17494 - e-TeX hyph_codes 2018cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf; 2019@y 2020cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf; 2021set_hyph_index; 2022@z 2023%--------------------------------------- 2024@x [40] m.896 l.17557 - e-TeX TeXXeT 2025 else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue 2026@y 2027 else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue 2028 else if (type(s)=math_node)and(subtype(s)>=L_code) then goto continue 2029@z 2030%--------------------------------------- 2031@x [40] m.896 l.17563 - e-TeX hyph_codes 2032 if lc_code(c)<>0 then 2033 if (lc_code(c)=c)or(uc_hyph>0) then goto done2 2034@y 2035 set_lc_code(c); 2036 if hc[0]<>0 then 2037 if (hc[0]=c)or(uc_hyph>0) then goto done2 2038@z 2039%--------------------------------------- 2040@x [40] m.897 l.17580 - e-TeX hyph_codes 2041 if lc_code(c)=0 then goto done3; 2042 if hn=63 then goto done3; 2043 hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char; 2044@y 2045 set_lc_code(c); 2046 if hc[0]=0 then goto done3; 2047 if hn=63 then goto done3; 2048 hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char; 2049@z 2050%--------------------------------------- 2051@x [40] m.898 l.17606 - e-TeX hyph_codes 2052 if lc_code(c)=0 then goto done3; 2053 if j=63 then goto done3; 2054 incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/ 2055@y 2056 set_lc_code(c); 2057 if hc[0]=0 then goto done3; 2058 if j=63 then goto done3; 2059 incr(j); hu[j]:=c; hc[j]:=hc[0];@/ 2060@z 2061%--------------------------------------- 2062@x [40] m.899 l.17623 - e-TeX TeXXeT 2063 othercases goto done1 2064@y 2065 math_node: if subtype(s)>=L_code then goto done4@+else goto done1; 2066 othercases goto done1 2067@z 2068%--------------------------------------- 2069@x [42] m.934 l.18245 new_hyph_exceptions - e-TeX hyph_codes 2070label reswitch, exit, found, not_found; 2071@y 2072label reswitch, exit, found, not_found, not_found1; 2073@z 2074%--------------------------------------- 2075@x [42] m.934 l.18255 new_hyph_exceptions - e-TeX hyph_codes 2076set_cur_lang; 2077@y 2078set_cur_lang; 2079@!init if trie_not_ready then 2080 begin hyph_index:=0; goto not_found1; 2081 end; 2082tini@/ 2083set_hyph_index; 2084not_found1: 2085@z 2086%--------------------------------------- 2087@x [42] m.937 l.18287 - e-TeX hyph_codes 2088else begin if lc_code(cur_chr)=0 then 2089@y 2090else begin set_lc_code(cur_chr); 2091 if hc[0]=0 then 2092@z 2093%--------------------------------------- 2094@x [42] m.937 l.18295 - e-TeX hyph_codes 2095 begin incr(n); hc[n]:=lc_code(cur_chr); 2096@y 2097 begin incr(n); hc[n]:=hc[0]; 2098@z 2099%--------------------------------------- 2100@x [43] m.952 l.18583 - e-TeX hyph_codes 2101trie_root:=compress_trie(trie_root); {identify equivalent subtries} 2102@y 2103hyph_root:=compress_trie(hyph_root); 2104trie_root:=compress_trie(trie_root); {identify equivalent subtries} 2105@z 2106%--------------------------------------- 2107@x [43] m.958 l.18671 - e-TeX hyph_codes 2108if trie_root=0 then {no patterns were given} 2109@y 2110if trie_max=0 then {no patterns were given} 2111@z 2112%--------------------------------------- 2113@x [43] m.958 l.18675 - e-TeX hyph_codes 2114else begin trie_fix(trie_root); {this fixes the non-holes in |trie|} 2115@y 2116else begin if hyph_root>0 then trie_fix(hyph_root); 2117 if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|} 2118@z 2119%--------------------------------------- 2120@x [43] m.960 l.18718 new_patterns - e-TeX hyph_codes 2121 brace@>; 2122@y 2123 brace@>; 2124 if saving_hyph_codes>0 then 2125 @<Store hyphenation codes for current language@>; 2126@z 2127%--------------------------------------- 2128@x [43] m.966 l.18825 init_trie - e-TeX hyph_codes 2129@<Move the data into |trie|@>; 2130@y 2131if hyph_root<>0 then @<Pack all stored |hyph_codes|@>; 2132@<Move the data into |trie|@>; 2133@z 2134%--------------------------------------- 2135@x [44] m.968 l.18841 - e-TeX saved_items 2136whenever this is possible without backspacing. 2137@y 2138whenever this is possible without backspacing. 2139 2140When the second argument |s| is |false| the deleted nodes are destroyed, 2141otherwise they are collected in a list starting at |split_disc|. 2142@z 2143%--------------------------------------- 2144@x [44] m.968 l.18848 prune_page_top - e-TeX saved_items 2145@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break} 2146var prev_p:pointer; {lags one step behind |p|} 2147@!q:pointer; {temporary variable for list manipulation} 2148@y 2149@p function prune_page_top(@!p:pointer;@!s:boolean):pointer; 2150 {adjust top after page break} 2151var prev_p:pointer; {lags one step behind |p|} 2152@!q,@!r:pointer; {temporary variables for list manipulation} 2153@z 2154%--------------------------------------- 2155@x [44] m.968 l.18859 prune_page_top - e-TeX saved_items 2156 link(prev_p):=p; flush_node_list(q); 2157@y 2158 link(prev_p):=p; 2159 if s then 2160 begin if split_disc=null then split_disc:=q@+else link(r):=q; 2161 r:=q; 2162 end 2163 else flush_node_list(q); 2164@z 2165%--------------------------------------- 2166@x [44] m.977 l.19026 vsplit - e-TeX marks, sparse arrays 2167@p function vsplit(@!n:eight_bits; @!h:scaled):pointer; 2168@y 2169@p @t\4@>@<Declare the function called |do_marks|@>@; 2170function vsplit(@!n:halfword; @!h:scaled):pointer; 2171@z 2172%--------------------------------------- 2173@x [44] m.977 l.19032 vsplit - e-TeX sparse arrays 2174begin v:=box(n); 2175@y 2176begin cur_val:=n; fetch_box(v); 2177@z 2178%--------------------------------------- 2179@x [44] m.977 l.19033 vsplit - e-TeX marks, saved_items 2180if split_first_mark<>null then 2181@y 2182flush_node_list(split_disc); split_disc:=null; 2183if sa_mark<>null then 2184 if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null; 2185if split_first_mark<>null then 2186@z 2187%--------------------------------------- 2188@x [44] m.977 l.19041 vsplit - e-TeX saved_items 2189q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size); 2190@y 2191q:=prune_page_top(q,saving_vdiscards>0); 2192p:=list_ptr(v); free_node(v,box_node_size); 2193@z 2194%--------------------------------------- 2195@x [44] m.977 l.19042 vsplit - e-TeX sparse arrays 2196if q=null then box(n):=null {the |eq_level| of the box stays the same} 2197else box(n):=vpack(q,natural); 2198@y 2199if q<>null then q:=vpack(q,natural); 2200change_box(q); {the |eq_level| of the box stays the same} 2201@z 2202%--------------------------------------- 2203@x [44] m.979 l.19067 - e-TeX marks 2204 if split_first_mark=null then 2205@y 2206 if mark_class(p)<>0 then @<Update the current marks for |vsplit|@> 2207 else if split_first_mark=null then 2208@z 2209%--------------------------------------- 2210@x [45] m.982 l.19201 - e-TeX last_node_type 2211The variables |last_penalty| and |last_kern| are similar. And 2212@y 2213The variables |last_penalty|, |last_kern|, and |last_node_type| 2214are similar. And 2215@z 2216%--------------------------------------- 2217@x [45] m.982 l.19214 - e-TeX last_node_type 2218@!last_kern:scaled; {used to implement \.{\\lastkern}} 2219@y 2220@!last_kern:scaled; {used to implement \.{\\lastkern}} 2221@!last_node_type:integer; {used to implement \.{\\lastnodetype}} 2222@z 2223%--------------------------------------- 2224@x [45] m.991 l.19353 - e-TeX last_node_type 2225last_glue:=max_halfword; last_penalty:=0; last_kern:=0; 2226@y 2227last_glue:=max_halfword; last_penalty:=0; last_kern:=0; 2228last_node_type:=-1; 2229@z 2230%--------------------------------------- 2231@x [45] m.996 l.19420 - e-TeX last_node_type 2232last_penalty:=0; last_kern:=0; 2233@y 2234last_penalty:=0; last_kern:=0; 2235last_node_type:=type(p)+1; 2236@z 2237%--------------------------------------- 2238@x [45] m.999 l.19454 - e-TeX saved_items 2239link(contrib_head):=link(p); link(p):=null; flush_node_list(p) 2240@y 2241link(contrib_head):=link(p); link(p):=null; 2242if saving_vdiscards>0 then 2243 begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p; 2244 tail_page_disc:=p; 2245 end 2246else flush_node_list(p) 2247@z 2248%--------------------------------------- 2249@x [45] m.1012 l.19697 fire_up - e-TeX marks 2250if bot_mark<>null then 2251@y 2252if sa_mark<>null then 2253 if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null; 2254if bot_mark<>null then 2255@z 2256%--------------------------------------- 2257@x [45] m.1012 l.19705 fire_up - e-TeX marks 2258if (top_mark<>null)and(first_mark=null) then 2259@y 2260if sa_mark<>null then 2261 if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null; 2262if (top_mark<>null)and(first_mark=null) then 2263@z 2264%--------------------------------------- 2265@x [45] m.1014 l.19742 - e-TeX marks 2266 else if type(p)=mark_node then @<Update the values of 2267@y 2268 else if type(p)=mark_node then 2269 if mark_class(p)<>0 then @<Update the current marks for |fire_up|@> 2270 else @<Update the values of 2271@z 2272%--------------------------------------- 2273@x [45] m.1021 l.19854 - e-TeX saved_items 2274 ins_ptr(p):=prune_page_top(broken_ptr(r)); 2275@y 2276 ins_ptr(p):=prune_page_top(broken_ptr(r),false); 2277@z 2278%--------------------------------------- 2279@x [45] m.1023 l.19890 - e-TeX saved_items 2280ship_out(box(255)); box(255):=null; 2281@y 2282flush_node_list(page_disc); page_disc:=null; 2283ship_out(box(255)); box(255):=null; 2284@z 2285%--------------------------------------- 2286@x [45] m.1026 l.19932 - e-TeX saved_items 2287pop_nest; build_page; 2288@y 2289flush_node_list(page_disc); page_disc:=null; 2290pop_nest; build_page; 2291@z 2292%--------------------------------------- 2293@x [47] m.1070 l.20735 normal_paragraph - e-TeX penalties 2294if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null); 2295@y 2296if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null); 2297if inter_line_penalties_ptr<>null then 2298 eq_define(inter_line_penalties_loc,shape_ref,null); 2299@z 2300%--------------------------------------- 2301@x [47] m.1071 l.20756 - e-TeX sparse arrays 2302|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}'; 2303codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}' 2304through `\.{\\global\\setbox255}'; 2305code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513| 2306through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}', 2307@y 2308|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}'; 2309codes |global_box_flag| through |ship_out_flag-1| represent 2310`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}'; 2311code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag| 2312through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}', 2313@z 2314%--------------------------------------- 2315@x [47] m.1071 l.20770 - e-TeX sparse arrays 2316@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'} 2317@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'} 2318@y 2319@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'} 2320@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'} 2321@d leader_flag==@'10000200001 {context code for `\.{\\leaders}'} 2322@z 2323%--------------------------------------- 2324@x [47] m.1075 l.20853 box_end - e-TeX sparse arrays 2325var p:pointer; {|ord_noad| for new box in math mode} 2326@y 2327var p:pointer; {|ord_noad| for new box in math mode} 2328@!a:small_number; {global prefix} 2329@z 2330%--------------------------------------- 2331@x [47] m.1077 l.20891 - e-TeX sparse arrays 2332if box_context<box_flag+256 then 2333 eq_define(box_base-box_flag+box_context,box_ref,cur_box) 2334else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box) 2335@y 2336begin if box_context<global_box_flag then 2337 begin cur_val:=box_context-box_flag; a:=0; 2338 end 2339else begin cur_val:=box_context-global_box_flag; a:=4; 2340 end; 2341if cur_val<256 then define(box_base+cur_val,box_ref,cur_box) 2342else sa_def_box; 2343end 2344@z 2345%--------------------------------------- 2346@x [47] m.1079 l.20920 begin_box - e-TeX TeXXeT 2347@!m:quarterword; {the length of a replacement list} 2348@y 2349@!r:pointer; {running behind |p|} 2350@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?} 2351@!tx:pointer; {effective tail node} 2352@!m:quarterword; {the length of a replacement list} 2353@z 2354%--------------------------------------- 2355@x [47] m.1079 l.20922 begin_box - e-TeX sparse arrays 2356@!n:eight_bits; {a box number} 2357begin case cur_chr of 2358box_code: begin scan_eight_bit_int; cur_box:=box(cur_val); 2359 box(cur_val):=null; {the box becomes void, at the same level} 2360 end; 2361copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val)); 2362@y 2363@!n:halfword; {a box number} 2364begin case cur_chr of 2365box_code: begin scan_register_num; fetch_box(cur_box); 2366 change_box(null); {the box becomes void, at the same level} 2367 end; 2368copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q); 2369@z 2370%--------------------------------------- 2371@x [47] m.1080 l.20940 - e-TeX TeXXeT 2372@<If the current list ends with a box node, delete it...@>= 2373@y 2374@d fetch_effective_tail_eTeX(#)== {extract |tx|, 2375 drop \.{\\beginM} \.{\\endM} pair} 2376q:=head; p:=null; 2377repeat r:=p; p:=q; fm:=false; 2378if not is_char_node(q) then 2379 if type(q)=disc_node then 2380 begin for m:=1 to replace_count(q) do p:=link(p); 2381 if p=tx then #; 2382 end 2383 else if (type(q)=math_node)and(subtype(q)=begin_M_code) then fm:=true; 2384q:=link(p); 2385until q=tx; {found |r|$\to$|p|$\to$|q=tx|} 2386q:=link(tx); link(p):=q; link(tx):=null; 2387if q=null then if fm then confusion("tail1") 2388@:this can't happen tail1}{\quad tail1@> 2389 else tail:=p 2390else if fm then {|r|$\to$|p=begin_M|$\to$|q=end_M|} 2391 begin tail:=r; link(r):=null; flush_node_list(p);@+end 2392@# 2393@d check_effective_tail(#)==find_effective_tail_eTeX 2394@d fetch_effective_tail==fetch_effective_tail_eTeX 2395 2396@<If the current list ends with a box node, delete it...@>= 2397@z 2398%--------------------------------------- 2399@x [47] m.1080 l.20950 - e-TeX TeXXeT 2400else begin if not is_char_node(tail) then 2401 if (type(tail)=hlist_node)or(type(tail)=vlist_node) then 2402 @<Remove the last box, unless it's part of a discretionary@>; 2403 end; 2404@y 2405else begin check_effective_tail(goto done); 2406 if not is_char_node(tx) then 2407 if (type(tx)=hlist_node)or(type(tx)=vlist_node) then 2408 @<Remove the last box, unless it's part of a discretionary@>; 2409 done:end; 2410@z 2411%--------------------------------------- 2412@x [47] m.1081 l.20957 - e-TeX TeXXeT 2413begin q:=head; 2414repeat p:=q; 2415if not is_char_node(q) then if type(q)=disc_node then 2416 begin for m:=1 to replace_count(q) do p:=link(p); 2417 if p=tail then goto done; 2418 end; 2419q:=link(p); 2420until q=tail; 2421cur_box:=tail; shift_amount(cur_box):=0; 2422tail:=p; link(p):=null; 2423done:end 2424@y 2425begin fetch_effective_tail(goto done); 2426cur_box:=tx; shift_amount(cur_box):=0; 2427end 2428@z 2429%--------------------------------------- 2430@x [47] m.1082 l.20972 - e-TeX sparse arrays 2431begin scan_eight_bit_int; n:=cur_val; 2432@y 2433begin scan_register_num; n:=cur_val; 2434@z 2435%--------------------------------------- 2436@x [47] m.1096 l.21156 - e-TeX penalties, TeXXeT 2437 else line_break(widow_penalty); 2438@y 2439 else line_break(false); 2440 if LR_save<>null then 2441 begin flush_list(LR_save); LR_save:=null; 2442 end; 2443@z 2444%--------------------------------------- 2445@x [47] m.1101 l.21212 make_mark - e-TeX marks 2446begin p:=scan_toks(false,true); p:=get_node(small_node_size); 2447@y 2448@!c:halfword; {the mark class} 2449begin if cur_chr=0 then c:=0 2450else begin scan_register_num; c:=cur_val; 2451 end; 2452p:=scan_toks(false,true); p:=get_node(small_node_size); 2453mark_class(p):=c; 2454@z 2455%--------------------------------------- 2456@x [47] m.1105 l.21246 delete_last - e-TeX TeXXeT 2457@!m:quarterword; {the length of a replacement list} 2458@y 2459@!r:pointer; {running behind |p|} 2460@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?} 2461@!tx:pointer; {effective tail node} 2462@!m:quarterword; {the length of a replacement list} 2463@z 2464%--------------------------------------- 2465@x [47] m.1105 l.21250 delete_last - e-TeX TeXXeT 2466else begin if not is_char_node(tail) then if type(tail)=cur_chr then 2467 begin q:=head; 2468 repeat p:=q; 2469 if not is_char_node(q) then if type(q)=disc_node then 2470 begin for m:=1 to replace_count(q) do p:=link(p); 2471 if p=tail then return; 2472 end; 2473 q:=link(p); 2474 until q=tail; 2475 link(p):=null; flush_node_list(tail); tail:=p; 2476@y 2477else begin check_effective_tail(return); 2478 if not is_char_node(tx) then if type(tx)=cur_chr then 2479 begin fetch_effective_tail(return); 2480 flush_node_list(tx); 2481@z 2482%--------------------------------------- 2483@x [47] m.1108 l.21299 - e-TeX saved_items 2484un_vbox: if chr_code=copy_code then print_esc("unvcopy") 2485@y 2486un_vbox: if chr_code=copy_code then print_esc("unvcopy") 2487 @<Cases of |un_vbox| for |print_cmd_chr|@>@/ 2488@z 2489%--------------------------------------- 2490@x [47] m.1110 l.21309 unpackage - e-TeX saved_items 2491label exit; 2492@y 2493label done, exit; 2494@z 2495%--------------------------------------- 2496@x [47] m.1110 l.21312 unpackage - e-TeX saved_items, sparse arrays 2497begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val); 2498@y 2499begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>; 2500c:=cur_chr; scan_register_num; fetch_box(p); 2501@z 2502%--------------------------------------- 2503@x [47] m.1110 l.21324 unpackage - e-TeX sparse arrays 2504else begin link(tail):=list_ptr(p); box(cur_val):=null; 2505@y 2506else begin link(tail):=list_ptr(p); change_box(null); 2507@z 2508%--------------------------------------- 2509@x [47] m.1110 l.21327 unpackage - e-TeX saved_items 2510while link(tail)<>null do tail:=link(tail); 2511@y 2512done: 2513while link(tail)<>null do tail:=link(tail); 2514@z 2515%--------------------------------------- 2516@x [47] m.1130 l.21599 - e-TeX TeXXeT 2517vmode+halign,hmode+valign:init_align; 2518@y 2519vmode+halign:init_align; 2520hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align; 2521@z 2522%--------------------------------------- 2523@x [48] m.1138 l.21678 init_math - e-TeX TeXXeT 2524procedure init_math; 2525label reswitch,found,not_found,done; 2526var w:scaled; {new or partial |pre_display_size|} 2527@y 2528@t\4@>@<Declare subprocedures for |init_math|@>@; 2529procedure init_math; 2530label reswitch,found,not_found,done; 2531var w:scaled; {new or partial |pre_display_size|} 2532@!j:pointer; {prototype box for display} 2533@!x:integer; {new |pre_display_direction|} 2534@z 2535%--------------------------------------- 2536@x [48] m.1145 l.21736 - e-TeX TeXXeT, penalties 2537begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'} 2538 begin pop_nest; w:=-max_dimen; 2539 end 2540else begin line_break(display_widow_penalty);@/ 2541@y 2542begin j:=null; w:=-max_dimen; 2543if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'} 2544 @<Prepare for display after an empty paragraph@> 2545else begin line_break(true);@/ 2546@z 2547%--------------------------------------- 2548@x [48] m.1145 l.21749 - e-TeX TeXXeT 2549eq_word_define(dimen_base+pre_display_size_code,w); 2550@y 2551eq_word_define(dimen_base+pre_display_size_code,w); 2552LR_box:=j; 2553if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x); 2554@z 2555%--------------------------------------- 2556@x [48] m.1146 l.21757 - e-TeX TeXXeT 2557v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen; 2558p:=list_ptr(just_box); 2559@y 2560@<Prepare for display after a non-empty paragraph@>; 2561@z 2562%--------------------------------------- 2563@x [48] m.1146 l.21772 - e-TeX TeXXeT 2564done: 2565@y 2566done: 2567@<Finish the natural width computation@> 2568@z 2569%--------------------------------------- 2570@x [48] m.1147 l.21783 - e-TeX TeXXeT 2571kern_node,math_node: d:=width(p); 2572@y 2573kern_node: d:=width(p); 2574@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@; 2575@z 2576%--------------------------------------- 2577@x [48] m.1185 l.22292 - e-TeX middle 2578 if type(q)<>left_noad then confusion("right"); 2579@:this can't happen right}{\quad right@> 2580 info(numerator(incompleat_noad)):=link(q); 2581 link(q):=incompleat_noad; link(incompleat_noad):=p; 2582@y 2583 if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right"); 2584@:this can't happen right}{\quad right@> 2585 info(numerator(incompleat_noad)):=link(delim_ptr); 2586 link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p; 2587@z 2588%--------------------------------------- 2589@x [48] m.1189 l.22337 - e-TeX middle 2590else print_esc("right"); 2591@y 2592@/@<Cases of |left_right| for |print_cmd_chr|@>@/ 2593else print_esc("right"); 2594@z 2595%--------------------------------------- 2596@x [48] m.1191 l.22346 math_left_right - e-TeX middle 2597begin t:=cur_chr; 2598if (t=right_noad)and(cur_group<>math_left_group) then 2599@y 2600@!q:pointer; {resulting mlist} 2601begin t:=cur_chr; 2602if (t<>left_noad)and(cur_group<>math_left_group) then 2603@z 2604%--------------------------------------- 2605@x [48] m.1191 l.22351 math_left_right - e-TeX middle 2606 if t=left_noad then 2607 begin push_math(math_left_group); link(head):=p; tail:=p; 2608 end 2609 else begin p:=fin_mlist(p); unsave; {end of |math_left_group|} 2610@y 2611 if t=middle_noad then 2612 begin type(p):=right_noad; subtype(p):=middle_noad; 2613 end; 2614 if t=left_noad then q:=p 2615 else begin q:=fin_mlist(p); unsave; {end of |math_left_group|} 2616 end; 2617 if t<>right_noad then 2618 begin push_math(math_left_group); link(head):=q; tail:=p; 2619 delim_ptr:=p; 2620 end 2621 else begin 2622@z 2623%--------------------------------------- 2624@x [48] m.1191 l.22357 math_left_right - e-TeX middle 2625 info(nucleus(tail)):=p; 2626@y 2627 info(nucleus(tail)):=q; 2628@z 2629%--------------------------------------- 2630@x [48] m.1192 l.22365 - e-TeX middle 2631 print_err("Extra "); print_esc("right"); 2632@.Extra \\right.@> 2633 help1("I'm ignoring a \right that had no matching \left."); 2634@y 2635 print_err("Extra "); 2636 if t=middle_noad then 2637 begin print_esc("middle"); 2638@.Extra \\middle.@> 2639 help1("I'm ignoring a \middle that had no matching \left."); 2640 end 2641 else begin print_esc("right"); 2642@.Extra \\right.@> 2643 help1("I'm ignoring a \right that had no matching \left."); 2644 end; 2645@z 2646%--------------------------------------- 2647@x [48] m.1194 l.22380 after_math - e-TeX TeXXeT 2648procedure after_math; 2649@y 2650@t\4@>@<Declare subprocedures for |after_math|@>@; 2651procedure after_math; 2652@z 2653%--------------------------------------- 2654@x [48] m.1194 l.22387 after_math - e-TeX TeXXeT 2655begin danger:=false; 2656@y 2657begin danger:=false; 2658@<Retrieve the prototype box@>; 2659@z 2660%--------------------------------------- 2661@x [48] m.1194 l.22394 after_math - e-TeX TeXXeT 2662 mlist_to_hlist; a:=hpack(link(temp_head),natural); 2663@y 2664 mlist_to_hlist; a:=hpack(link(temp_head),natural); 2665 set_box_lr(a)(dlist); 2666@z 2667%--------------------------------------- 2668@x [48] m.1194 l.22397 after_math - e-TeX TeXXeT 2669 danger:=false; 2670@y 2671 danger:=false; 2672 @<Retrieve the prototype box@>; 2673@z 2674%--------------------------------------- 2675@x [48] m.1199 l.22484 - e-TeX TeXXeT 2676w:=width(b); z:=display_width; s:=display_indent; 2677@y 2678w:=width(b); z:=display_width; s:=display_indent; 2679if pre_display_direction<0 then s:=-s-z; 2680@z 2681%--------------------------------------- 2682@x [48] m.1199 l.22499 - e-TeX TeXXeT 2683resume_after_display 2684@y 2685@<Flush the prototype box@>; 2686resume_after_display 2687@z 2688%--------------------------------------- 2689@x [48] m.1202 l.22541 - e-TeX TeXXeT 2690d:=half(z-w); 2691@y 2692set_box_lr(b)(dlist); 2693d:=half(z-w); 2694@z 2695%--------------------------------------- 2696@x [48] m.1203 l.22562 - e-TeX TeXXeT 2697 begin shift_amount(a):=s; append_to_vlist(a); 2698@y 2699 begin app_display(j,a,0); 2700@z 2701%--------------------------------------- 2702@x [48] m.1204 l.22572 - e-TeX TeXXeT 2703shift_amount(b):=s+d; append_to_vlist(b) 2704@y 2705app_display(j,b,d) 2706@z 2707%--------------------------------------- 2708@x [48] m.1205 l.22582 - e-TeX TeXXeT 2709 shift_amount(a):=s+z-width(a); 2710 append_to_vlist(a); 2711@y 2712 app_display(j,a,z-width(a)); 2713@z 2714%--------------------------------------- 2715@x [48] m.1206 l.22601 - e-TeX TeXXeT 2716pop_nest; 2717@y 2718flush_node_list(LR_box); 2719pop_nest; 2720@z 2721%--------------------------------------- 2722@x [49] m.1208 l.22626 - e-TeX protected 2723control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and 2724it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}', 2725@y 2726control sequence can be defined to be `\.{\\long}', `\.{\\protected}', 2727or `\.{\\outer}', and it might or might not be expanded. The prefixes 2728`\.{\\global}', `\.{\\long}', `\.{\\protected}', 2729@z 2730%--------------------------------------- 2731@x [49] m.1209 l.22652 - e-TeX protected 2732 else print_esc("global"); 2733@y 2734 @/@<Cases of |prefix| for |print_cmd_chr|@>@/ 2735 else print_esc("global"); 2736@z 2737%--------------------------------------- 2738@x [49] m.1211 l.22714 prefixed_command - e-TeX tracing 2739 @<Discard erroneous prefixes and |return|@>; 2740@y 2741 @<Discard erroneous prefixes and |return|@>; 2742 if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr; 2743@z 2744%--------------------------------------- 2745@x [49] m.1212 l.22730 - e-TeX protected 2746help1("I'll pretend you didn't say \long or \outer or \global."); 2747@y 2748help1("I'll pretend you didn't say \long or \outer or \global."); 2749if eTeX_ex then help_line[0]:=@| 2750 "I'll pretend you didn't say \long or \outer or \global or \protected."; 2751@z 2752%--------------------------------------- 2753@x [49] m.1213 l.22735 - e-TeX protected 2754if (cur_cmd<>def)and(a mod 4<>0) then 2755 begin print_err("You can't use `"); print_esc("long"); print("' or `"); 2756 print_esc("outer"); print("' with `"); 2757@y 2758if a>=8 then 2759 begin j:=protected_token; a:=a-8; 2760 end 2761else j:=0; 2762if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then 2763 begin print_err("You can't use `"); print_esc("long"); print("' or `"); 2764 print_esc("outer"); 2765 help1("I'll pretend you didn't say \long or \outer here."); 2766 if eTeX_ex then 2767 begin help_line[0]:=@| 2768 "I'll pretend you didn't say \long or \outer or \protected here."; 2769 print("' or `"); print_esc("protected"); 2770 end; 2771 print("' with `"); 2772@z 2773%--------------------------------------- 2774@x [49] m.1213 l.22740 - e-TeX protected 2775 help1("I'll pretend you didn't say \long or \outer here."); 2776@y 2777@z 2778%--------------------------------------- 2779@x [49] m.1218 l.22798 - e-TeX protected 2780 q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref); 2781@y 2782 q:=scan_toks(true,e); 2783 if j<>0 then 2784 begin q:=get_avail; info(q):=j; link(q):=link(def_ref); 2785 link(def_ref):=q; 2786 end; 2787 define(p,call+(a mod 4),def_ref); 2788@z 2789%--------------------------------------- 2790@x [49] m.1221 l.22826 - e-TeX sparse arrays 2791 if cur_cmd>=call then add_token_ref(cur_chr); 2792@y 2793 if cur_cmd>=call then add_token_ref(cur_chr) 2794 else if (cur_cmd=register)or(cur_cmd=toks_register) then 2795 if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then 2796 add_sa_ref(cur_chr); 2797@z 2798%--------------------------------------- 2799@x [49] m.1224 l.22889 - e-TeX sparse arrays 2800 othercases begin scan_eight_bit_int; 2801@y 2802 othercases begin scan_register_num; 2803 if cur_val>255 then 2804 begin j:=n-count_def_code; {|int_val..box_val|} 2805 if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|} 2806 find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr); 2807 if j=tok_val then j:=toks_register@+else j:=register; 2808 define(p,j,cur_ptr); 2809 end 2810 else 2811@z 2812%--------------------------------------- 2813@x [49] m.1225 l.22902 - e-TeX read_line 2814read_to_cs: begin scan_int; n:=cur_val; 2815@y 2816read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val; 2817@z 2818%--------------------------------------- 2819@x [49] m.1225 l.22911 - e-TeX read_line 2820 p:=cur_cs; read_toks(n,p); define(p,call,cur_val); 2821@y 2822 p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val); 2823@z 2824%--------------------------------------- 2825@x [49] m.1226 l.22920 - e-TeX sparse arrays 2826 if cur_cmd=toks_register then 2827 begin scan_eight_bit_int; p:=toks_base+cur_val; 2828 end 2829 else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots} 2830@y 2831 e:=false; {just in case, will be set |true| for sparse array elements} 2832 if cur_cmd=toks_register then 2833 if cur_chr=mem_bot then 2834 begin scan_register_num; 2835 if cur_val>255 then 2836 begin find_sa_element(tok_val,cur_val,true); 2837 cur_chr:=cur_ptr; e:=true; 2838 end 2839 else cur_chr:=toks_base+cur_val; 2840 end 2841 else e:=true; 2842 p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots} 2843@z 2844%--------------------------------------- 2845@x [49] m.1226 l.22930 - e-TeX sparse arrays 2846 begin define(p,undefined_cs,null); free_avail(def_ref); 2847 end 2848 else begin if p=output_routine_loc then {enclose in curlies} 2849@y 2850 begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref); 2851 end 2852 else begin if (p=output_routine_loc)and not e then {enclose in curlies} 2853@z 2854%--------------------------------------- 2855@x [49] m.1226 l.22938 - e-TeX sparse arrays 2856 define(p,call,def_ref); 2857@y 2858 sa_define(p,def_ref)(p,call,def_ref); 2859@z 2860%--------------------------------------- 2861@x [49] m.1227 l.22943 - e-TeX sparse arrays 2862begin if cur_cmd=toks_register then 2863 begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val; 2864 end; 2865if cur_cmd=assign_toks then 2866 begin q:=equiv(cur_chr); 2867 if q=null then define(p,undefined_cs,null) 2868 else begin add_token_ref(q); define(p,call,q); 2869 end; 2870 goto done; 2871 end; 2872end 2873@y 2874if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then 2875 begin if cur_cmd=toks_register then 2876 if cur_chr=mem_bot then 2877 begin scan_register_num; 2878 if cur_val<256 then q:=equiv(toks_base+cur_val) 2879 else begin find_sa_element(tok_val,cur_val,false); 2880 if cur_ptr=null then q:=null 2881 else q:=sa_ptr(cur_ptr); 2882 end; 2883 end 2884 else q:=sa_ptr(cur_chr) 2885 else q:=equiv(cur_chr); 2886 if q=null then sa_define(p,null)(p,undefined_cs,null) 2887 else begin add_token_ref(q); sa_define(p,q)(p,call,q); 2888 end; 2889 goto done; 2890 end 2891@z 2892%--------------------------------------- 2893@x [49] m.1236 l.23059 do_register_command - e-TeX sparse arrays 2894begin q:=cur_cmd; 2895@y 2896@!e:boolean; {does |l| refer to a sparse array element?} 2897@!w:integer; {integer or dimen value of |l|} 2898begin q:=cur_cmd; 2899e:=false; {just in case, will be set |true| for sparse array elements} 2900@z 2901%--------------------------------------- 2902@x [49] m.1236 l.23076 do_register_command - e-TeX sparse arrays 2903if p<glue_val then word_define(l,cur_val) 2904else begin trap_zero_glue; define(l,glue_ref,cur_val); 2905@y 2906if p<glue_val then sa_word_define(l,cur_val) 2907else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val); 2908@z 2909%--------------------------------------- 2910@x [49] m.1237 l.23098 - e-TeX sparse arrays 2911p:=cur_chr; scan_eight_bit_int; 2912@y 2913if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then 2914 begin l:=cur_chr; p:=sa_type(l); e:=true; 2915 end 2916else begin p:=cur_chr-mem_bot; scan_register_num; 2917 if cur_val>255 then 2918 begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true; 2919 end 2920 else 2921@z 2922%--------------------------------------- 2923@x [49] m.1237 l.23105 - e-TeX sparse arrays 2924end; 2925found: 2926@y 2927 end; 2928end; 2929found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int 2930else if e then s:=sa_ptr(l)@+else s:=equiv(l) 2931@z 2932%--------------------------------------- 2933@x [49] m.1238 l.23111 - e-TeX sparse arrays 2934 if q=advance then cur_val:=cur_val+eqtb[l].int; 2935@y 2936 if q=advance then cur_val:=cur_val+w; 2937@z 2938%--------------------------------------- 2939@x [49] m.1239 l.23118 - e-TeX sparse arrays 2940begin q:=new_spec(cur_val); r:=equiv(l); 2941@y 2942begin q:=new_spec(cur_val); r:=s; 2943@z 2944%--------------------------------------- 2945@x [49] m.1240 l.23138 - e-TeX sparse arrays 2946 if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val) 2947 else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0) 2948 else cur_val:=x_over_n(eqtb[l].int,cur_val) 2949else begin s:=equiv(l); r:=new_spec(s); 2950@y 2951 if p=int_val then cur_val:=mult_integers(w,cur_val) 2952 else cur_val:=nx_plus_y(w,cur_val,0) 2953 else cur_val:=x_over_n(w,cur_val) 2954else begin r:=new_spec(s); 2955@z 2956%--------------------------------------- 2957@x [49] m.1241 l.23160 - e-TeX sparse arrays 2958set_box: begin scan_eight_bit_int; 2959 if global then n:=256+cur_val@+else n:=cur_val; 2960 scan_optional_equals; 2961 if set_box_allowed then scan_box(box_flag+n) 2962@y 2963set_box: begin scan_register_num; 2964 if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val; 2965 scan_optional_equals; 2966 if set_box_allowed then scan_box(n) 2967@z 2968%--------------------------------------- 2969@x [49] m.1246 l.23231 alter_integer - e-TeX interaction_mode 2970var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}} 2971begin c:=cur_chr; scan_optional_equals; scan_int; 2972if c=0 then dead_cycles:=cur_val 2973@y 2974var c:small_number; 2975 {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.} 2976begin c:=cur_chr; scan_optional_equals; scan_int; 2977if c=0 then dead_cycles:=cur_val 2978@/@<Cases for |alter_integer|@>@/ 2979@z 2980%--------------------------------------- 2981@x [49] m.1247 l.23240 alter_box_dimen - e-TeX sparse arrays 2982@!b:eight_bits; {box number} 2983begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; 2984scan_normal_dimen; 2985if box(b)<>null then mem[box(b)+c].sc:=cur_val; 2986@y 2987@!b:pointer; {box register} 2988begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals; 2989scan_normal_dimen; 2990if b<>null then mem[b+c].sc:=cur_val; 2991@z 2992%--------------------------------------- 2993@x [49] m.1248 l.23249 - e-TeX penalties 2994set_shape: begin scan_optional_equals; scan_int; n:=cur_val; 2995 if n<=0 then p:=null 2996@y 2997set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val; 2998 if n<=0 then p:=null 2999 else if q>par_shape_loc then 3000 begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n; 3001 n:=cur_val; mem[p+1].int:=n; {number of penalties} 3002 for j:=p+2 to p+n+1 do 3003 begin scan_int; mem[j].int:=cur_val; {penalty values} 3004 end; 3005 if not odd(n) then mem[p+n+2].int:=0; {unused} 3006 end 3007@z 3008%--------------------------------------- 3009@x [49] m.1248 l.23259 - e-TeX penalties 3010 define(par_shape_loc,shape_ref,p); 3011@y 3012 define(q,shape_ref,p); 3013@z 3014%--------------------------------------- 3015@x [49] m.1260 l.23346 new_font - e-TeX tracing 3016common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t; 3017@y 3018common_ending: define(u,set_font,f); eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t; 3019@z 3020%--------------------------------------- 3021@x [49] m.1292 l.23633 - e-TeX show_groups 3022 show_lists:print_esc("showlists"); 3023@y 3024 show_lists:print_esc("showlists"); 3025 @<Cases of |xray| for |print_cmd_chr|@>@;@/ 3026@z 3027%--------------------------------------- 3028@x [49] m.1293 l.23640 show_whatever - e-TeX show_ifs 3029var p:pointer; {tail of a token list to show} 3030@y 3031var p:pointer; {tail of a token list to show} 3032@!t:small_number; {type of conditional being shown} 3033@!m:normal..or_code; {upper bound on |fi_or_else| codes} 3034@!l:integer; {line where that conditional began} 3035@!n:integer; {level of \.{\\if...\\fi} nesting} 3036@z 3037%--------------------------------------- 3038@x [49] m.1293 l.23646 show_whatever - e-TeX show_groups 3039othercases @<Show the current value of some parameter or register, 3040@y 3041@<Cases for |show_whatever|@>@;@/ 3042othercases @<Show the current value of some parameter or register, 3043@z 3044%--------------------------------------- 3045@x [49] m.1295 l.23681 - e-TeX protected 3046call: print("macro"); 3047long_call: print_esc("long macro"); 3048outer_call: print_esc("outer macro"); 3049long_outer_call: begin print_esc("long"); print_esc("outer macro"); 3050@y 3051call,long_call,outer_call,long_outer_call: begin n:=cmd-call; 3052 if info(link(chr_code))=protected_token then n:=n+4; 3053 if odd(n div 4) then print_esc("protected"); 3054 if odd(n) then print_esc("long"); 3055 if odd(n div 2) then print_esc("outer"); 3056 if n>0 then print_char(" "); 3057 print("macro"); 3058@z 3059%--------------------------------------- 3060@x [49] m.1296 l.23689 - e-TeX sparse arrays 3061begin scan_eight_bit_int; begin_diagnostic; 3062print_nl("> \box"); print_int(cur_val); print_char("="); 3063if box(cur_val)=null then print("void") 3064else show_box(box(cur_val)); 3065@y 3066begin scan_register_num; fetch_box(p); begin_diagnostic; 3067print_nl("> \box"); print_int(cur_val); print_char("="); 3068if p=null then print("void")@+else show_box(p); 3069@z 3070%--------------------------------------- 3071@x [50] m.1307 l.23831 - e-TeX basic 3072dump_int(@$);@/ 3073@y 3074dump_int(@$);@/ 3075@<Dump the \eTeX\ state@>@/ 3076@z 3077%--------------------------------------- 3078@x [50] m.1308 l.23846 - e-TeX basic 3079if x<>@$ then goto bad_fmt; {check that strings are the same} 3080@y 3081if x<>@$ then goto bad_fmt; {check that strings are the same} 3082@/@<Undump the \eTeX\ state@>@/ 3083@z 3084%--------------------------------------- 3085@x [50] m.1311 l.23900 - e-TeX sparse arrays 3086dump_int(lo_mem_max); dump_int(rover); 3087@y 3088dump_int(lo_mem_max); dump_int(rover); 3089if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); 3090@z 3091%--------------------------------------- 3092@x [50] m.1312 l.23923 - e-TeX sparse arrays 3093undump(lo_mem_stat_max+1)(lo_mem_max)(rover); 3094@y 3095undump(lo_mem_stat_max+1)(lo_mem_max)(rover); 3096if eTeX_ex then for k:=int_val to tok_val do 3097 undump(null)(lo_mem_max)(sa_root[k]); 3098@z 3099%--------------------------------------- 3100@x [50] m.1324 l.24117 - e-TeX hyph_codes 3101dump_int(trie_max); 3102@y 3103dump_int(trie_max); 3104dump_int(hyph_start); 3105@z 3106%--------------------------------------- 3107@x [50] m.1325 l.24145 - e-TeX hyph_codes 3108undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini 3109@y 3110undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini 3111undump(0)(j)(hyph_start); 3112@z 3113%--------------------------------------- 3114@x [51] m.1335 l.24365 final_cleanup - tracing 3115 print_int(cur_level-level_one); print_char(")"); 3116@y 3117 print_int(cur_level-level_one); print_char(")"); 3118 if eTeX_ex then show_save_groups; 3119@z 3120%--------------------------------------- 3121@x [51] m.1335 l.24388 final_cleanup - e-TeX marks, saved_items 3122 if cur_mark[c]<>null then delete_token_ref(cur_mark[c]); 3123@y 3124 if cur_mark[c]<>null then delete_token_ref(cur_mark[c]); 3125 if sa_mark<>null then 3126 if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null; 3127 for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]); 3128@z 3129%--------------------------------------- 3130@x [51] m.1336 l.24398 init_prim - e-TeX basic 3131begin no_new_control_sequence:=false; 3132@y 3133begin no_new_control_sequence:=false; 3134first:=0; 3135@z 3136%--------------------------------------- 3137@x [51] m.1337 l.24413 - e-TeX basic 3138if (format_ident=0)or(buffer[loc]="&") then 3139@y 3140@<Enable \eTeX, if requested@>@;@/ 3141if (format_ident=0)or(buffer[loc]="&") then 3142@z 3143%--------------------------------------- 3144@x [51] m.1337 l.24421 - e-TeX basic 3145 end; 3146@y 3147 end; 3148if eTeX_ex then wterm_ln('entering extended mode'); 3149@z 3150%--------------------------------------- 3151@x [53] m.1362 l.24762 adv_past - e-TeX hyph_codes 3152 begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);@+end 3153@y 3154 begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); 3155 set_hyph_index; 3156 end 3157@z 3158%--------------------------------------- 3159@x [54] m.1379 l.24956 - e-TeX additions 3160@* \[54] System-dependent changes. 3161@y 3162@* \[53a] The extended features of \eTeX. 3163The program has two modes of operation: (1)~In \TeX\ compatibility mode 3164it fully deserves the name \TeX\ and there are neither extended features 3165nor additional primitive commands. There are, however, a few 3166modifications that would be legitimate in any implementation of \TeX\ 3167such as, e.g., preventing inadequate results of the glue to \.{DVI} 3168unit conversion during |ship_out|. (2)~In extended mode there are 3169additional primitive commands and the extended features of \eTeX\ are 3170available. 3171 3172The distinction between these two modes of operation initially takes 3173place when a `virgin' \.{eINITEX} starts without reading a format file. 3174Later on the values of all \eTeX\ state variables are inherited when 3175\.{eVIRTEX} (or \.{eINITEX}) reads a format file. 3176 3177The code below is designed to work for cases where `$|init|\ldots|tini|$' 3178is a run-time switch. 3179 3180@<Enable \eTeX, if requested@>= 3181@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then 3182 begin no_new_control_sequence:=false; 3183 @<Generate all \eTeX\ primitives@>@; 3184 incr(loc); eTeX_mode:=1; {enter extended mode} 3185 @<Initialize variables for \eTeX\ extended mode@>@; 3186 end; 3187tini@;@/ 3188if not no_new_control_sequence then {just entered extended mode ?} 3189 no_new_control_sequence:=true@+else 3190 3191@ The \eTeX\ features available in extended mode are grouped into two 3192categories: (1)~Some of them are permanently enabled and have no 3193semantic effect as long as none of the additional primitives are 3194executed. (2)~The remaining \eTeX\ features are optional and can be 3195individually enabled and disabled. For each optional feature there is 3196an \eTeX\ state variable named \.{\\...state}; the feature is enabled, 3197resp.\ disabled by assigning a positive, resp.\ non-positive value to 3198that integer. 3199 3200@d eTeX_state_base=int_base+eTeX_state_code 3201@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable} 3202@# 3203@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} 3204 3205@<Generate all \eTeX...@>= 3206primitive("lastnodetype",last_item,last_node_type_code); 3207@!@:last_node_type_}{\.{\\lastnodetype} primitive@> 3208primitive("eTeXversion",last_item,eTeX_version_code); 3209@!@:eTeX_version_}{\.{\\eTeXversion} primitive@> 3210primitive("eTeXrevision",convert,eTeX_revision_code);@/ 3211@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> 3212 3213@ @<Cases of |last_item| for |print_cmd_chr|@>= 3214last_node_type_code: print_esc("lastnodetype"); 3215eTeX_version_code: print_esc("eTeXversion"); 3216 3217@ @<Cases for fetching an integer value@>= 3218eTeX_version_code: cur_val:=eTeX_version; 3219 3220@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?} 3221 3222@<Glob...@>= 3223@!eTeX_mode: 0..1; {identifies compatibility and extended mode} 3224 3225@ @<Initialize table entries...@>= 3226eTeX_mode:=0; {initially we are in compatibility mode} 3227@<Initialize variables for \eTeX\ compatibility mode@>@; 3228 3229@ @<Dump the \eTeX\ state@>= 3230dump_int(eTeX_mode); 3231for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} 3232 3233@ @<Undump the \eTeX\ state@>= 3234undump(0)(1)(eTeX_mode); 3235if eTeX_ex then 3236 begin @<Initialize variables for \eTeX\ extended mode@>@; 3237 end 3238else begin @<Initialize variables for \eTeX\ compatibility mode@>@; 3239 end; 3240 3241@ The |eTeX_enabled| function simply returns its first argument as 3242result. This argument is |true| if an optional \eTeX\ feature is 3243currently enabled; otherwise, if the argument is |false|, the function 3244gives an error message. 3245 3246@<Declare \eTeX\ procedures for use...@>= 3247function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean; 3248begin if not b then 3249 begin print_err("Improper "); print_cmd_chr(j,k); 3250 help1("Sorry, this optional e-TeX feature has been disabled."); error; 3251 end; 3252eTeX_enabled:=b; 3253end; 3254 3255@ First we implement the additional \eTeX\ parameters in the table of 3256equivalents. 3257 3258@<Generate all \eTeX...@>= 3259primitive("everyeof",assign_toks,every_eof_loc); 3260@!@:every_eof_}{\.{\\everyeof} primitive@> 3261primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/ 3262@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@> 3263primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/ 3264@!@:tracing_groups_}{\.{\\tracinggroups} primitive@> 3265primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/ 3266@!@:tracing_ifs_}{\.{\\tracingifs} primitive@> 3267primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/ 3268@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@> 3269primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/ 3270@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@> 3271primitive("predisplaydirection", 3272 assign_int,int_base+pre_display_direction_code);@/ 3273@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@> 3274primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/ 3275@!@:last_line_fit_}{\.{\\lastlinefit} primitive@> 3276primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/ 3277@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@> 3278primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/ 3279@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@> 3280 3281@ @d every_eof==equiv(every_eof_loc) 3282 3283@<Cases of |assign_toks| for |print_cmd_chr|@>= 3284every_eof_loc: print_esc("everyeof"); 3285 3286@ @<Cases for |print_param|@>= 3287tracing_assigns_code:print_esc("tracingassigns"); 3288tracing_groups_code:print_esc("tracinggroups"); 3289tracing_ifs_code:print_esc("tracingifs"); 3290tracing_scan_tokens_code:print_esc("tracingscantokens"); 3291tracing_nesting_code:print_esc("tracingnesting"); 3292pre_display_direction_code:print_esc("predisplaydirection"); 3293last_line_fit_code:print_esc("lastlinefit"); 3294saving_vdiscards_code:print_esc("savingvdiscards"); 3295saving_hyph_codes_code:print_esc("savinghyphcodes"); 3296 3297@ In order to handle \.{\\everyeof} we need an array |eof_seen| of 3298boolean variables. 3299 3300@<Glob...@>= 3301@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?} 3302 3303@ The |print_group| procedure prints the current level of grouping and 3304the name corresponding to |cur_group|. 3305 3306@<Declare \eTeX\ procedures for tr...@>= 3307procedure print_group(@!e:boolean); 3308label exit; 3309begin case cur_group of 3310 bottom_level: begin print("bottom level"); return; 3311 end; 3312 simple_group,semi_simple_group: 3313 begin if cur_group=semi_simple_group then print("semi "); 3314 print("simple"); 3315 end; 3316 hbox_group,adjusted_hbox_group: 3317 begin if cur_group=adjusted_hbox_group then print("adjusted "); 3318 print("hbox"); 3319 end; 3320 vbox_group: print("vbox"); 3321 vtop_group: print("vtop"); 3322 align_group,no_align_group: 3323 begin if cur_group=no_align_group then print("no "); 3324 print("align"); 3325 end; 3326 output_group: print("output"); 3327 disc_group: print("disc"); 3328 insert_group: print("insert"); 3329 vcenter_group: print("vcenter"); 3330 math_group,math_choice_group,math_shift_group,math_left_group: 3331 begin print("math"); 3332 if cur_group=math_choice_group then print(" choice") 3333 else if cur_group=math_shift_group then print(" shift") 3334 else if cur_group=math_left_group then print(" left"); 3335 end; 3336 end; {there are no other cases} 3337print(" group (level "); print_int(qo(cur_level)); print_char(")"); 3338if saved(-1)<>0 then 3339 begin if e then print(" entered at line ") else print(" at line "); 3340 print_int(saved(-1)); 3341 end; 3342exit:end; 3343 3344@ The |group_trace| procedure is called when a new level of grouping 3345begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the 3346line number. 3347 3348@<Declare \eTeX\ procedures for tr...@>= 3349@!stat procedure group_trace(@!e:boolean); 3350begin begin_diagnostic; print_char("{"); 3351if e then print("leaving ") else print("entering "); 3352print_group(e); print_char("}"); end_diagnostic(false); 3353end; 3354tats 3355 3356@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return 3357the current level of grouping and the type of the current group 3358respectively. 3359 3360@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}} 3361@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}} 3362 3363@<Generate all \eTeX...@>= 3364primitive("currentgrouplevel",last_item,current_group_level_code); 3365@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@> 3366primitive("currentgrouptype",last_item,current_group_type_code); 3367@!@:current_group_type_}{\.{\\currentgrouptype} primitive@> 3368 3369@ @<Cases of |last_item| for |print_cmd_chr|@>= 3370current_group_level_code: print_esc("currentgrouplevel"); 3371current_group_type_code: print_esc("currentgrouptype"); 3372 3373@ @<Cases for fetching an integer value@>= 3374current_group_level_code: cur_val:=cur_level-level_one; 3375current_group_type_code: cur_val:=cur_group; 3376 3377@ The \.{\\currentiflevel}, \.{\\currentiftype}, and 3378\.{\\currentifbranch} commands return the current level of conditionals 3379and the type and branch of the current conditional. 3380 3381@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}} 3382@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}} 3383@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}} 3384 3385@<Generate all \eTeX...@>= 3386primitive("currentiflevel",last_item,current_if_level_code); 3387@!@:current_if_level_}{\.{\\currentiflevel} primitive@> 3388primitive("currentiftype",last_item,current_if_type_code); 3389@!@:current_if_type_}{\.{\\currentiftype} primitive@> 3390primitive("currentifbranch",last_item,current_if_branch_code); 3391@!@:current_if_branch_}{\.{\\currentifbranch} primitive@> 3392 3393@ @<Cases of |last_item| for |print_cmd_chr|@>= 3394current_if_level_code: print_esc("currentiflevel"); 3395current_if_type_code: print_esc("currentiftype"); 3396current_if_branch_code: print_esc("currentifbranch"); 3397 3398@ @<Cases for fetching an integer value@>= 3399current_if_level_code: begin q:=cond_ptr; cur_val:=0; 3400 while q<>null do 3401 begin incr(cur_val); q:=link(q); 3402 end; 3403 end; 3404current_if_type_code: if cond_ptr=null then cur_val:=0 3405 else if cur_if<unless_code then cur_val:=cur_if+1 3406 else cur_val:=-(cur_if-unless_code+1); 3407current_if_branch_code: 3408 if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1 3409 else if if_limit=fi_code then cur_val:=-1 3410 else cur_val:=0; 3411 3412@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and 3413\.{\\fontcharic} commands return information about a character in a 3414font. 3415 3416@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}} 3417@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}} 3418@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}} 3419@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}} 3420 3421@<Generate all \eTeX...@>= 3422primitive("fontcharwd",last_item,font_char_wd_code); 3423@!@:font_char_wd_}{\.{\\fontcharwd} primitive@> 3424primitive("fontcharht",last_item,font_char_ht_code); 3425@!@:font_char_ht_}{\.{\\fontcharht} primitive@> 3426primitive("fontchardp",last_item,font_char_dp_code); 3427@!@:font_char_dp_}{\.{\\fontchardp} primitive@> 3428primitive("fontcharic",last_item,font_char_ic_code); 3429@!@:font_char_ic_}{\.{\\fontcharic} primitive@> 3430 3431@ @<Cases of |last_item| for |print_cmd_chr|@>= 3432font_char_wd_code: print_esc("fontcharwd"); 3433font_char_ht_code: print_esc("fontcharht"); 3434font_char_dp_code: print_esc("fontchardp"); 3435font_char_ic_code: print_esc("fontcharic"); 3436 3437@ @<Cases for fetching a dimension value@>= 3438font_char_wd_code, 3439font_char_ht_code, 3440font_char_dp_code, 3441font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num; 3442 if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then 3443 begin i:=char_info(q)(qi(cur_val)); 3444 case m of 3445 font_char_wd_code: cur_val:=char_width(q)(i); 3446 font_char_ht_code: cur_val:=char_height(q)(height_depth(i)); 3447 font_char_dp_code: cur_val:=char_depth(q)(height_depth(i)); 3448 font_char_ic_code: cur_val:=char_italic(q)(i); 3449 end; {there are no other cases} 3450 end 3451 else cur_val:=0; 3452 end; 3453 3454@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength} 3455commands return the indent and length parameters of the current 3456\.{\\parshape} specification. 3457 3458@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}} 3459@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}} 3460@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}} 3461 3462@<Generate all \eTeX...@>= 3463primitive("parshapelength",last_item,par_shape_length_code); 3464@!@:par_shape_length_}{\.{\\parshapelength} primitive@> 3465primitive("parshapeindent",last_item,par_shape_indent_code); 3466@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@> 3467primitive("parshapedimen",last_item,par_shape_dimen_code); 3468@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@> 3469 3470@ @<Cases of |last_item| for |print_cmd_chr|@>= 3471par_shape_length_code: print_esc("parshapelength"); 3472par_shape_indent_code: print_esc("parshapeindent"); 3473par_shape_dimen_code: print_esc("parshapedimen"); 3474 3475@ @<Cases for fetching a dimension value@>= 3476par_shape_length_code, 3477par_shape_indent_code, 3478par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int; 3479 if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0 3480 else begin if q=2 then 3481 begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2; 3482 end; 3483 if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr); 3484 cur_val:=mem[par_shape_ptr+2*cur_val-q].sc; 3485 end; 3486 cur_val_level:=dimen_val; 3487 end; 3488 3489@ The \.{\\showgroups} command displays all currently active grouping 3490levels. 3491 3492@d show_groups=4 { \.{\\showgroups} } 3493 3494@<Generate all \eTeX...@>= 3495primitive("showgroups",xray,show_groups); 3496@!@:show_groups_}{\.{\\showgroups} primitive@> 3497 3498@ @<Cases of |xray| for |print_cmd_chr|@>= 3499show_groups:print_esc("showgroups"); 3500 3501@ @<Cases for |show_whatever|@>= 3502show_groups: begin begin_diagnostic; show_save_groups; 3503 end; 3504 3505@ @<Types...@>= 3506@!save_pointer=0..save_size; {index into |save_stack|} 3507 3508@ The modifications of \TeX\ required for the display produced by the 3509|show_save_groups| procedure were first discussed by Donald~E. Knuth in 3510{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990. 3511@^Knuth, Donald Ervin@> 3512 3513In order to understand a group type we also have to know its mode. 3514Since unrestricted horizontal modes are not associated with grouping, 3515they are skipped when traversing the semantic nest. 3516 3517@<Declare \eTeX\ procedures for use...@>= 3518procedure show_save_groups; 3519label found1,found2,found,done; 3520var p:0..nest_size; {index into |nest|} 3521@!m:-mmode..mmode; {mode} 3522@!v:save_pointer; {saved value of |save_ptr|} 3523@!l:quarterword; {saved value of |cur_level|} 3524@!c:group_code; {saved value of |cur_group|} 3525@!a:-1..1; {to keep track of alignments} 3526@!i:integer; 3527@!j:quarterword; 3528@!s:str_number; 3529begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array} 3530v:=save_ptr; l:=cur_level; c:=cur_group; 3531save_ptr:=cur_boundary; decr(cur_level);@/ 3532a:=1; 3533print_nl(""); print_ln; 3534loop@+begin print_nl("### "); print_group(true); 3535 if cur_group=bottom_level then goto done; 3536 repeat m:=nest[p].mode_field; 3537 if p>0 then decr(p) else m:=vmode; 3538 until m<>hmode; 3539 print(" ("); 3540 case cur_group of 3541 simple_group: begin incr(p); goto found2; 3542 end; 3543 hbox_group,adjusted_hbox_group: s:="hbox"; 3544 vbox_group: s:="vbox"; 3545 vtop_group: s:="vtop"; 3546 align_group: if a=0 then 3547 begin if m=-vmode then s:="halign" else s:="valign"; 3548 a:=1; goto found1; 3549 end 3550 else begin if a=1 then print("align entry") else print_esc("cr"); 3551 if p>=a then p:=p-a; 3552 a:=0; goto found; 3553 end; 3554 no_align_group: 3555 begin incr(p); a:=-1; print_esc("noalign"); goto found2; 3556 end; 3557 output_group: 3558 begin print_esc("output"); goto found; 3559 end; 3560 math_group: goto found2; 3561 disc_group,math_choice_group: 3562 begin if cur_group=disc_group then print_esc("discretionary") 3563 else print_esc("mathchoice"); 3564 for i:=1 to 3 do if i<=saved(-2) then print("{}"); 3565 goto found2; 3566 end; 3567 insert_group: 3568 begin if saved(-2)=255 then print_esc("vadjust") 3569 else begin print_esc("insert"); print_int(saved(-2)); 3570 end; 3571 goto found2; 3572 end; 3573 vcenter_group: begin s:="vcenter"; goto found1; 3574 end; 3575 semi_simple_group: begin incr(p); print_esc("begingroup"); goto found; 3576 end; 3577 math_shift_group: 3578 begin if m=mmode then print_char("$") 3579 else if nest[p].mode_field=mmode then 3580 begin print_cmd_chr(eq_no,saved(-2)); goto found; 3581 end; 3582 print_char("$"); goto found; 3583 end; 3584 math_left_group: 3585 begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left") 3586 else print_esc("middle"); 3587 goto found; 3588 end; 3589 end; {there are no other cases} 3590 @<Show the box context@>; 3591 found1: print_esc(s); @<Show the box packaging info@>; 3592 found2: print_char("{"); 3593 found: print_char(")"); decr(cur_level); 3594 cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr) 3595 end; 3596done: save_ptr:=v; cur_level:=l; cur_group:=c; 3597end; 3598 3599@ @<Show the box packaging info@>= 3600if saved(-2)<>0 then 3601 begin print_char(" "); 3602 if saved(-3)=exactly then print("to") else print("spread"); 3603 print_scaled(saved(-2)); print("pt"); 3604 end 3605 3606@ @<Show the box context@>= 3607i:=saved(-4); 3608if i<>0 then 3609 if i<box_flag then 3610 begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove; 3611 if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); 3612 print_scaled(abs(i)); print("pt"); 3613 end 3614 else if i<ship_out_flag then 3615 begin if i>=global_box_flag then 3616 begin print_esc("global"); i:=i-(global_box_flag-box_flag); 3617 end; 3618 print_esc("setbox"); print_int(i-box_flag); print_char("="); 3619 end 3620 else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders)) 3621 3622@ The |scan_general_text| procedure is much like |scan_toks(false,false)|, 3623but will be invoked via |expand|, i.e., recursively. 3624@^recursion@> 3625 3626@<Declare \eTeX\ procedures for sc...@>= 3627procedure@?scan_general_text; forward;@t\2@> 3628 3629@ The token list (balanced text) created by |scan_general_text| begins 3630at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|, 3631the list is empty.) 3632 3633@<Declare \eTeX\ procedures for tok...@>= 3634procedure scan_general_text; 3635label found; 3636var s:normal..absorbing; {to save |scanner_status|} 3637@!w:pointer; {to save |warning_index|} 3638@!d:pointer; {to save |def_ref|} 3639@!p:pointer; {tail of the token list being built} 3640@!q:pointer; {new node being added to the token list via |store_new_token|} 3641@!unbalance:halfword; {number of unmatched left braces} 3642begin s:=scanner_status; w:=warning_index; d:=def_ref; 3643scanner_status:=absorbing; warning_index:=cur_cs; 3644def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref; 3645scan_left_brace; {remove the compulsory left brace} 3646unbalance:=1; 3647loop@+ begin get_token; 3648 if cur_tok<right_brace_limit then 3649 if cur_cmd<right_brace then incr(unbalance) 3650 else begin decr(unbalance); 3651 if unbalance=0 then goto found; 3652 end; 3653 store_new_token(cur_tok); 3654 end; 3655found: q:=link(def_ref); free_avail(def_ref); {discard reference count} 3656if q=null then cur_val:=temp_head @+ else cur_val:=p; 3657link(temp_head):=q; 3658scanner_status:=s; warning_index:=w; def_ref:=d; 3659end; 3660 3661@ The \.{\\showtokens} command displays a token list. 3662 3663@d show_tokens=5 { \.{\\showtokens} , must be odd! } 3664 3665@<Generate all \eTeX...@>= 3666primitive("showtokens",xray,show_tokens); 3667@!@:show_tokens_}{\.{\\showtokens} primitive@> 3668 3669@ @<Cases of |xray| for |print_cmd_chr|@>= 3670show_tokens:print_esc("showtokens"); 3671 3672@ The \.{\\unexpanded} primitive prevents expansion of tokens much as 3673the result from \.{\\the} applied to a token variable. The 3674\.{\\detokenize} primitive converts a token list into a list of 3675character tokens much as if the token list were written to a file. We 3676use the fact that the command modifiers for \.{\\unexpanded} and 3677\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe} 3678are even. 3679 3680@<Generate all \eTeX...@>= 3681primitive("unexpanded",the,1);@/ 3682@!@:unexpanded_}{\.{\\unexpanded} primitive@> 3683primitive("detokenize",the,show_tokens);@/ 3684@!@:detokenize_}{\.{\\detokenize} primitive@> 3685 3686@ @<Cases of |the| for |print_cmd_chr|@>= 3687else if chr_code=1 then print_esc("unexpanded") 3688else print_esc("detokenize") 3689 3690@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>= 3691if odd(cur_chr) then 3692 begin c:=cur_chr; scan_general_text; 3693 if c=1 then the_toks:=cur_val 3694 else begin old_setting:=selector; selector:=new_string; b:=pool_ptr; 3695 p:=get_avail; link(p):=link(temp_head); 3696 token_show(p); flush_list(p); 3697 selector:=old_setting; the_toks:=str_toks(b); 3698 end; 3699 return; 3700 end 3701 3702@ The \.{\\showifs} command displays all currently active conditionals. 3703 3704@d show_ifs=6 { \.{\\showifs} } 3705 3706@<Generate all \eTeX...@>= 3707primitive("showifs",xray,show_ifs); 3708@!@:show_ifs_}{\.{\\showifs} primitive@> 3709 3710@ @<Cases of |xray| for |print_cmd_chr|@>= 3711show_ifs:print_esc("showifs"); 3712 3713@ 3714@d print_if_line(#)==if #<>0 then 3715 begin print(" entered on line "); print_int(#); 3716 end 3717 3718@<Cases for |show_whatever|@>= 3719show_ifs: begin begin_diagnostic; print_nl(""); print_ln; 3720 if cond_ptr=null then 3721 begin print_nl("### "); print("no active conditionals"); 3722 end 3723 else begin p:=cond_ptr; n:=0; 3724 repeat incr(n); p:=link(p);@+until p=null; 3725 p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit; 3726 repeat print_nl("### level "); print_int(n); print(": "); 3727 print_cmd_chr(if_test,t); 3728 if m=fi_code then print_esc("else"); 3729 print_if_line(l); 3730 decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p); 3731 until p=null; 3732 end; 3733 end; 3734 3735@ The \.{\\interactionmode} primitive allows to query and set the 3736interaction mode. 3737 3738@<Generate all \eTeX...@>= 3739primitive("interactionmode",set_page_int,2); 3740@!@:interaction_mode_}{\.{\\interactionmode} primitive@> 3741 3742@ @<Cases of |set_page_int| for |print_cmd_chr|@>= 3743else if chr_code=2 then print_esc("interactionmode") 3744 3745@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>= 3746else if m=2 then cur_val:=interaction 3747 3748@ @<Declare \eTeX\ procedures for use...@>= 3749procedure@?new_interaction; forward;@t\2@> 3750 3751@ @<Cases for |alter_integer|@>= 3752else if c=2 then 3753 begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then 3754 begin print_err("Bad interaction mode"); 3755@.Bad interaction mode@> 3756 help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/ 3757 ("3=errorstop. Proceed, and I'll ignore this case."); 3758 int_error(cur_val); 3759 end 3760 else begin cur_chr:=cur_val; new_interaction; 3761 end; 3762 end 3763 3764@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle} 3765delimiters to appear between \.{\\left} and \.{\\right}. 3766 3767@<Generate all \eTeX...@>= 3768primitive("middle",left_right,middle_noad); 3769@!@:middle_}{\.{\\middle} primitive@> 3770 3771@ @<Cases of |left_right| for |print_cmd_chr|@>= 3772else if chr_code=middle_noad then print_esc("middle") 3773 3774@ In constructions such as 3775$$\vbox{\halign{\.{#}\hfil\cr 3776{}\\hbox to \\hsize\{\cr 3777\hskip 25pt \\hskip 0pt plus 0.0001fil\cr 3778\hskip 25pt ...\cr 3779\hskip 25pt \\hfil\\penalty-200\\hfilneg\cr 3780\hskip 25pt ...\}\cr}}$$ 3781the stretch components of \.{\\hfil} and \.{\\hfilneg} compensate; they may, 3782however, get modified in order to prevent arithmetic overflow during 3783|hlist_out| when each of them is multiplied by a large |glue_set| value. 3784 3785Since this ``glue rounding'' depends on state variables |cur_g| and 3786|cur_glue| and \TeXXeT\ is supposed to emulate the behaviour of \TeXeT\ 3787(plus a suitable postprocessor) as close as possible the glue rounding 3788cannot be postponed until (segments of) an hlist has been reversed. 3789 3790The code below is invoked after the effective width, |rule_wd|, of a glue 3791node has been computed. The glue node is either converted into a kern node 3792or, for leaders, the glue specification is replaced by an equivalent rigid 3793one; the subtype of the glue node remains unchanged. 3794 3795@<Handle a glue node for mixed...@>= 3796if (((g_sign=stretching) and (stretch_order(g)=g_order)) or 3797 ((g_sign=shrinking) and (shrink_order(g)=g_order))) then 3798 begin fast_delete_glue_ref(g); 3799 if subtype(p)<a_leaders then 3800 begin type(p):=kern_node; width(p):=rule_wd; 3801 end 3802 else begin g:=get_node(glue_spec_size);@/ 3803 stretch_order(g):=filll+1; shrink_order(g):=filll+1; {will never match} 3804 width(g):=rule_wd; stretch(g):=0; shrink(g):=0; glue_ptr(p):=g; 3805 end; 3806 end 3807 3808@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed 3809left-to-right and right-to-left typesetting. This code is inspired by 3810but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre 3811MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987. 3812@^Knuth, Donald Ervin@> 3813@^MacKay, Pierre@> 3814 3815In order to avoid confusion with \TeXeT\ the present implementation of 3816mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\ 3817in several important aspects: (1)~Right-to-left text is reversed 3818explicitly by the |ship_out| routine and is written to a normal \.{DVI} 3819file without any |begin_reflect| or |end_reflect| commands; (2)~a 3820|math_node| is (ab)used instead of a |whatsit_node| to record the 3821\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction 3822primitives in order to keep the influence on the line breaking algorithm 3823for pure left-to-right text as small as possible; (3)~right-to-left text 3824interrupted by a displayed equation is automatically resumed after that 3825equation; and (4)~the |valign| command code with a non-zero command 3826modifier is (ab)used for the text direction primitives. 3827 3828Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\ 3829that may influence the line breaking algorithm for pure left-to-right 3830text. When a paragraph containing math mode material is broken into 3831lines \TeX\ may generate lines where math mode material is not enclosed 3832by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such 3833lines as part of a new paragraph may have the effect that hyphenation is 3834attempted for `words' originating from math mode or that hyphenation is 3835inhibited for words originating from horizontal mode. 3836 3837In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are 3838supplied at the start, resp.\ end of lines such that math mode material 3839inside a horizontal list always starts with either \.{\\mathon} or 3840\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These 3841additional nodes are transparent to operations such as \.{\\unskip}, 3842\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that 3843hyphenation is never attempted for `words' originating from math mode 3844and is never inhibited for words originating from horizontal mode. 3845 3846@d TeXXeT_state==eTeX_state(TeXXeT_code) 3847@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} 3848 3849@<Cases for |print_param|@>= 3850eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); 3851 3852@ @<Generate all \eTeX...@>= 3853primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); 3854@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> 3855primitive("beginL",valign,begin_L_code); 3856@!@:beginL_}{\.{\\beginL} primitive@> 3857primitive("endL",valign,end_L_code); 3858@!@:endL_}{\.{\\endL} primitive@> 3859primitive("beginR",valign,begin_R_code); 3860@!@:beginR_}{\.{\\beginR} primitive@> 3861primitive("endR",valign,end_R_code); 3862@!@:endR_}{\.{\\endR} primitive@> 3863 3864@ @<Cases of |valign| for |print_cmd_chr|@>= 3865else case chr_code of 3866 begin_L_code: print_esc("beginL"); 3867 end_L_code: print_esc("endL"); 3868 begin_R_code: print_esc("beginR"); 3869 othercases print_esc("endR") 3870 endcases 3871 3872@ @<Cases of |main_control| for |hmode+valign|@>= 3873if cur_chr>0 then 3874 begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then 3875@.Improper \\beginL@> 3876@.Improper \\endL@> 3877@.Improper \\beginR@> 3878@.Improper \\endR@> 3879 tail_append(new_math(0,cur_chr)); 3880 end 3881else 3882 3883@ An hbox with subtype dlist will never be reversed, even when embedded 3884in right-to-left text. 3885 3886@<Display if this box is never to be reversed@>= 3887if (type(p)=hlist_node)and(box_lr(p)=dlist) then print(", display") 3888 3889@ A number of routines are based on a stack of one-word nodes whose 3890|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The 3891top of the stack is pointed to by |LR_ptr|. 3892 3893When the stack manipulation macros of this section are used below, 3894variable |LR_ptr| might be the global variable declared here for |hpack| 3895and |ship_out|, or might be local to |post_line_break|. 3896 3897@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#; 3898 link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr; 3899 end 3900@# 3901@d push_LR(#)==put_LR(end_LR_type(#)) 3902@# 3903@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr); 3904 free_avail(temp_ptr); 3905 end 3906 3907@<Glob...@>= 3908@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|} 3909@!LR_problems:integer; {counts missing begins and ends} 3910@!cur_dir:small_number; {current text direction} 3911 3912@ @<Set init...@>= 3913LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right; 3914 3915@ @<Insert LR nodes at the beg...@>= 3916begin q:=link(temp_head); 3917if LR_ptr<>null then 3918 begin temp_ptr:=LR_ptr; r:=q; 3919 repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s; 3920 temp_ptr:=link(temp_ptr); 3921 until temp_ptr=null; 3922 link(temp_head):=r; 3923 end; 3924while q<>cur_break(cur_p) do 3925 begin if not is_char_node(q) then 3926 if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>; 3927 q:=link(q); 3928 end; 3929end 3930 3931@ @<Adjust \(t)the LR stack for the |p...@>= 3932if end_LR(q) then 3933 begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR; 3934 end 3935else push_LR(q) 3936 3937@ We use the fact that |q| now points to the node with \.{\\rightskip} glue. 3938 3939@<Insert LR nodes at the end...@>= 3940if LR_ptr<>null then 3941 begin s:=temp_head; r:=link(s); 3942 while r<>q do 3943 begin s:=r; r:=link(s); 3944 end; 3945 r:=LR_ptr; 3946 while r<>null do 3947 begin temp_ptr:=new_math(0,info(r)); 3948 link(s):=temp_ptr; s:=temp_ptr; r:=link(r); 3949 end; 3950 link(s):=q; 3951 end 3952 3953@ @<Initialize the LR stack@>= 3954put_LR(before) {this will never match} 3955 3956@ @<Adjust \(t)the LR stack for the |hp...@>= 3957if end_LR(p) then 3958 if info(LR_ptr)=end_LR_type(p) then pop_LR 3959 else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit; 3960 end 3961else push_LR(p) 3962 3963@ @<Check for LR anomalies at the end of |hp...@>= 3964begin if info(LR_ptr)<>before then 3965 begin while link(q)<>null do q:=link(q); 3966 repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q; 3967 LR_problems:=LR_problems+10000; pop_LR; 3968 until info(LR_ptr)=before; 3969 end; 3970if LR_problems>0 then 3971 begin @<Report LR problems@>; goto common_ending; 3972 end; 3973pop_LR; 3974if LR_ptr<>null then confusion("LR1"); 3975@:this can't happen LR1}{\quad LR1@> 3976end 3977 3978@ @<Report LR problems@>= 3979begin print_ln; print_nl("\endL or \endR problem (");@/ 3980print_int(LR_problems div 10000); print(" missing, ");@/ 3981print_int(LR_problems mod 10000); print(" extra");@/ 3982LR_problems:=0; 3983end 3984 3985@ @<Initialize |hlist_out| for mixed...@>= 3986if eTeX_ex then 3987 begin @<Initialize the LR stack@>; 3988 if box_lr(this_box)=dlist then 3989 if cur_dir=right_to_left then 3990 begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box); 3991 end 3992 else set_box_lr(this_box)(0); 3993 if (cur_dir=right_to_left)and(box_lr(this_box)<>reversed) then 3994 @<Reverse the complete hlist and set the subtype to |reversed|@>; 3995 end 3996 3997@ @<Finish |hlist_out| for mixed...@>= 3998if eTeX_ex then 3999 begin @<Check for LR anomalies at the end of |hlist_out|@>; 4000 if box_lr(this_box)=dlist then cur_dir:=right_to_left; 4001 end 4002 4003@ @<Handle a math node in |hlist_out|@>= 4004begin if eTeX_ex then 4005 @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary 4006 reverse an hlist segment and |goto reswitch|@>; 4007 cur_h:=cur_h+width(p); 4008 end 4009 4010@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result 4011in lines whith unpaired math nodes. Such hlists are silently accepted 4012in the absence of text direction directives. 4013 4014@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'} 4015 4016@<Adjust \(t)the LR stack for the |hl...@>= 4017begin if end_LR(p) then 4018 if info(LR_ptr)=end_LR_type(p) then pop_LR 4019 else begin if subtype(p)>L_code then incr(LR_problems); 4020 end 4021else begin push_LR(p); 4022 if LR_dir(p)<>cur_dir then 4023 @<Reverse an hlist segment and |goto reswitch|@>; 4024 end; 4025type(p):=kern_node; 4026end 4027 4028@ @<Check for LR anomalies at the end of |hl...@>= 4029begin while info(LR_ptr)<>before do 4030 begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000; 4031 pop_LR; 4032 end; 4033pop_LR; 4034end 4035 4036@ @d edge_node=style_node {a |style_node| does not occur in hlists} 4037@d edge_node_size=style_node_size {number of words in an edge node} 4038@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h| 4039 (after |width| has been taken into account)} 4040 4041@<Declare procedures needed in |hlist_out|, |vlist_out|@>= 4042function new_edge(@!s:small_number;@!w:scaled):pointer; 4043 {create an edge node} 4044var p:pointer; {the new node} 4045begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s; 4046width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later} 4047new_edge:=p; 4048end; 4049 4050@ @<Cases of |hlist_out| that arise...@>= 4051edge_node: begin cur_h:=cur_h+width(p); 4052 left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p); 4053 end; 4054 4055@ We detach the hlist, start a new one consisting of just one kern node, 4056append the reversed list, and set the width of the kern node. 4057 4058@<Reverse the complete hlist...@>= 4059begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p; 4060cur_h:=0; link(p):=reverse(this_box,null,cur_g,cur_glue); width(p):=-cur_h; 4061cur_h:=save_h; set_box_lr(this_box)(reversed); 4062end 4063 4064@ We detach the remainder of the hlist, replace the math node by 4065an edge node, and append the reversed hlist segment to it; the tail of 4066the reversed segment is another edge node and the remainder of the 4067original list is attached to it. 4068 4069@<Reverse an hlist segment...@>= 4070begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p); 4071free_node(p,small_node_size); 4072cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p; 4073cur_h:=cur_h-left_edge+rule_wd; 4074link(p):=reverse(this_box,new_edge(reflected,0),cur_g,cur_glue); 4075edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h; 4076goto reswitch; 4077end 4078 4079@ OLD VERSION. 4080The |reverse| function defined here is responsible to reverse the 4081nodes of an hlist (segment). The first parameter |this_box| is the enclosing 4082hlist node, the second parameter |t| is to become the tail of the reversed 4083list, and the global variable |temp_ptr| is the head of the list to be 4084reversed. Finally |cur_g| and |cur_glue| are the current glue rounding state 4085variables, to be updated by this function. We remove nodes from the original 4086list and add them to the head of the new one. 4087 4088@<Declare procedures needed in |hlist_out|, |vlist_out|@>= 4089function reverse(@!this_box,@!t:pointer; var cur_g:scaled; 4090 var cur_glue:real):pointer; 4091label reswitch,next_p,done; 4092var l:pointer; {the new list} 4093@!p:pointer; {the current node} 4094@!q:pointer; {the next node} 4095@!g_order: glue_ord; {applicable order of infinity for glue} 4096@!g_sign: normal..shrinking; {selects type of glue} 4097@!glue_temp:real; {glue value before rounding} 4098@!m,@!n:halfword; {count of unmatched math nodes} 4099begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box); 4100l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword; 4101loop@+ begin while p<>null do 4102 @<Move node |p| to the new list and go to the next node; 4103 or |goto done| if the end of the reflected segment has been reached@>; 4104 if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done; 4105 p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000; 4106 {manufacture one missing math node} 4107 end; 4108done:reverse:=l; 4109end; 4110 4111@ NEW VERSION. 4112The |reverse| function defined here is responsible to reverse (parts of) 4113the nodes of an hlist. The first parameter |this_box| is the enclosing 4114hlist node, the second parameter |t| is to become the tail of the reversed 4115list, and the global variable |temp_ptr| is the head of the list to be 4116reversed. Finally |cur_g| and |cur_glue| are the current glue rounding 4117state variables, to be updated by this function. 4118 4119@<Declare procedures needed in |hlist_out|, |vlist_out|@>= 4120@{ 4121@t\4@>@<Declare subprocedures for |reverse|@>@; 4122function reverse(@!this_box,@!t:pointer; var cur_g:scaled; 4123 var cur_glue:real):pointer; 4124label reswitch,next_p,done; 4125var l:pointer; {the new list} 4126@!p:pointer; {the current node} 4127@!q:pointer; {the next node} 4128@!g_order: glue_ord; {applicable order of infinity for glue} 4129@!g_sign: normal..shrinking; {selects type of glue} 4130@!glue_temp:real; {glue value before rounding} 4131@!m,@!n:halfword; {count of unmatched math nodes} 4132begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box); 4133@<Build a list of segments and determine their widths@>; 4134l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword; 4135loop@+ begin while p<>null do 4136 @<Move node |p| to the new list and go to the next node; 4137 or |goto done| if the end of the reflected segment has been reached@>; 4138 if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done; 4139 p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000; 4140 {manufacture one missing math node} 4141 end; 4142done:reverse:=l; 4143end; 4144@} 4145 4146@ We cannot simply remove nodes from the original list and add them to the 4147head of the new one; this might reverse the order of whatsit nodes such 4148that, e.g., a |write_node| for a stream appears before the |open_node| 4149and\slash or after the |close_node| for that stream. 4150 4151All whatsit nodes as well as hlist and vlist nodes containing such nodes 4152must not be permuted. A sequence of hlist and vlist nodes not containing 4153whatsit nodes as well as char, ligature, rule, kern, and glue nodes together 4154with math nodes not changing the text direction can be explicitly reversed. 4155Embedded sections of left-to-right text are treated as a unit and all 4156remaining nodes are irrelevant and can be ignored. 4157 4158In a first step we determine the width of various segments of the hlist to 4159be reversed: (1)~embedded left-to-right text, (2)~sequences of permutable or 4160irrelevant nodes, (3)~sequences of whatsit or irrelevant nodes, and 4161(4)~individual hlist and vlist nodes containing whatsit nodes. 4162 4163@d segment_node=style_node 4164@d segment_node_size=style_node_size {number of words in a segment node} 4165@d segment_first(#)==info(#+2) {first node of the segment} 4166@d segment_last(#)==link(#+2) {last node of the segment} 4167 4168@<Declare subprocedures for |reverse|@>= 4169function new_segment(@!s:small_number;@!f:pointer):pointer; 4170 {create a segment node} 4171var p:pointer; {the new node} 4172begin p:=get_node(segment_node_size); type(p):=segment_node; subtype(p):=s; 4173width(p):=0; {the |width| field will be set later} 4174segment_first(p):=f; segment_last(p):=f; 4175new_segment:=p; 4176end; 4177 4178@ @<Build a list of segments and determine their widths@>= 4179begin 4180end 4181 4182@ Here is a recursive subroutine that determines if the hlist or vlist 4183node~|p| contains whatsit nodes. 4184 4185@<Declare subprocedures for |reverse|@>= 4186function has_whatsit(@!p:pointer):boolean; 4187label exit; 4188begin p:=list_ptr(p); has_whatsit:=true; 4189while p<>null do 4190 begin if not is_char_node(p) then 4191 case type(p) of 4192 hlist_node, vlist_node: if has_whatsit(p) then goto exit; 4193 whatsit_node: goto exit; 4194 othercases do_nothing 4195 endcases;@/ 4196 p:=link(p); 4197 end; 4198has_whatsit:=false; 4199exit: end; 4200 4201@ @<Move node |p| to the new list...@>= 4202reswitch: if is_char_node(p) then 4203 repeat f:=font(p); c:=character(p); 4204 cur_h:=cur_h+char_width(f)(char_info(f)(c)); 4205 q:=link(p); link(p):=l; l:=p; p:=q; 4206 until not is_char_node(p) 4207else @<Move the non-|char_node| |p| to the new list@> 4208 4209@ @<Move the non-|char_node| |p| to the new list@>= 4210begin q:=link(p); 4211case type(p) of 4212hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p); 4213@t\4@>@<Cases of |reverse| that need special treatment@>@; 4214edge_node: confusion("LR2"); 4215@:this can't happen LR2}{\quad LR2@> 4216othercases goto next_p 4217endcases;@/ 4218cur_h:=cur_h+rule_wd; 4219next_p: link(p):=l; 4220if type(p)=kern_node then if (rule_wd=0)or(l=null) then 4221 begin free_node(p,small_node_size); p:=l; 4222 end; 4223l:=p; p:=q; 4224end 4225 4226@ Here we compute the effective width of a glue node as in |hlist_out|. 4227 4228@<Cases of |reverse|...@>= 4229glue_node: begin round_glue; 4230 @<Handle a glue node for mixed...@>; 4231 end; 4232 4233@ A ligature node is replaced by a char node. 4234 4235@<Cases of |reverse|...@>= 4236ligature_node: begin flush_node_list(lig_ptr(p)); 4237 temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q; 4238 free_node(temp_ptr,small_node_size); goto reswitch; 4239 end; 4240 4241@ Math nodes in an inner reflected segment are modified, those at the 4242outer level are changed into kern nodes. 4243 4244@<Cases of |reverse|...@>= 4245math_node: begin rule_wd:=width(p); 4246if end_LR(p) then 4247 if info(LR_ptr)<>end_LR_type(p) then 4248 begin type(p):=kern_node; incr(LR_problems); 4249 end 4250 else begin pop_LR; 4251 if n>min_halfword then 4252 begin decr(n); decr(subtype(p)); {change |after| into |before|} 4253 end 4254 else begin type(p):=kern_node; 4255 if m>min_halfword then decr(m) 4256 else @<Finish the reversed hlist segment and |goto done|@>; 4257 end; 4258 end 4259else begin push_LR(p); 4260 if (n>min_halfword)or(LR_dir(p)<>cur_dir) then 4261 begin incr(n); incr(subtype(p)); {change |before| into |after|} 4262 end 4263 else begin type(p):=kern_node; incr(m); 4264 end; 4265 end; 4266end; 4267 4268@ Finally we have found the end of the hlist segment to be reversed; the 4269final math node is released and the remaining list attached to the 4270edge node terminating the reversed segment. 4271 4272@<Finish the reversed...@>= 4273begin free_node(p,small_node_size); 4274link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done; 4275end 4276 4277@ @<Check for LR anomalies at the end of |s...@>= 4278begin if LR_problems>0 then 4279 begin @<Report LR problems@>; print_char(")"); print_ln; 4280 end; 4281if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3"); 4282@:this can't happen LR3}{\quad LR3@> 4283end 4284 4285@ Some special actions are required for displayed equation in paragraphs 4286with mixed direction texts. First of all we have to set the text 4287direction preceding the display. 4288 4289@<Set the value of |x| to the text direction before the display@>= 4290if LR_save=null then x:=0 4291else if info(LR_save)>=R_code then x:=-1@+else x:=1 4292 4293@ @<Prepare for display after an empty...@>= 4294begin pop_nest; @<Set the value of |x|...@>; 4295end 4296 4297@ When calculating the natural width, |w|, of the final line preceding 4298the display, we may have to copy all or part of its hlist. We copy, 4299however, only those parts of the original list that are relevant for the 4300computation of |pre_display_size|. 4301@^data structure assumptions@> 4302 4303@<Declare subprocedures for |init_math|@>= 4304procedure just_copy(@!p,@!h,@!t:pointer); 4305label found,not_found; 4306var @!r:pointer; {current node being fabricated for new list} 4307@!words:0..5; {number of words remaining to be copied} 4308begin while p<>null do 4309 begin words:=1; {this setting occurs in more branches than any other} 4310 if is_char_node(p) then r:=get_avail 4311 else case type(p) of 4312 hlist_node,vlist_node: begin r:=get_node(box_node_size); 4313 mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words} 4314 words:=5; list_ptr(r):=null; {this affects |mem[r+5]|} 4315 end; 4316 rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; 4317 end; 4318 ligature_node: begin r:=get_avail; {only |font| and |character| are needed} 4319 mem[r]:=mem[lig_char(p)]; goto found; 4320 end; 4321 kern_node,math_node: begin r:=get_node(small_node_size); 4322 words:=small_node_size; 4323 end; 4324 glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p)); 4325 glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null; 4326 end; 4327 whatsit_node:@<Make a partial copy of the whatsit...@>; 4328 othercases goto not_found 4329 endcases; 4330 while words>0 do 4331 begin decr(words); mem[r+words]:=mem[p+words]; 4332 end; 4333 found: link(h):=r; h:=r; 4334 not_found: p:=link(p); 4335 end; 4336link(h):=t; 4337end; 4338 4339@ When the final line ends with R-text, the value |w| refers to the line 4340reflected with respect to the left edge of the enclosing vertical list. 4341 4342@<Prepare for display after a non-empty...@>= 4343if eTeX_ex then @<Let |j| be the prototype box for the display@>; 4344v:=shift_amount(just_box); 4345@<Set the value of |x|...@>; 4346if x>=0 then 4347 begin p:=list_ptr(just_box); link(temp_head):=null; 4348 end 4349else begin v:=-v-width(just_box); 4350 p:=new_math(0,begin_L_code); link(temp_head):=p; 4351 just_copy(list_ptr(just_box),p,new_math(0,end_L_code)); 4352 cur_dir:=right_to_left; 4353 end; 4354v:=v+2*quad(cur_font); 4355if TeXXeT_en then @<Initialize the LR stack@> 4356 4357@ @<Finish the natural width computation@>= 4358if TeXXeT_en then 4359 begin while LR_ptr<>null do pop_LR; 4360 if LR_problems<>0 then 4361 begin w:=max_dimen; LR_problems:=0; 4362 end; 4363 end; 4364cur_dir:=left_to_right; flush_node_list(link(temp_head)) 4365 4366@ In the presence of text direction directives we assume that any LR 4367problems have been fixed by the |hpack| routine. If the final line 4368contains, however, text direction directives while \TeXXeT\ is disabled, 4369then we set |w:=max_dimen|. 4370 4371@<Cases of `Let |d| be the natural...@>= 4372math_node: begin d:=width(p); 4373 if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@> 4374 else if subtype(p)>=L_code then 4375 begin w:=max_dimen; goto done; 4376 end; 4377 end; 4378edge_node: begin d:=width(p); cur_dir:=subtype(p); 4379 end; 4380 4381@ @<Adjust \(t)the LR stack for the |i...@>= 4382if end_LR(p) then 4383 begin if info(LR_ptr)=end_LR_type(p) then pop_LR 4384 else if subtype(p)>L_code then 4385 begin w:=max_dimen; goto done; 4386 end 4387 end 4388else begin push_LR(p); 4389 if LR_dir(p)<>cur_dir then 4390 begin just_reverse(p); p:=temp_head; 4391 end; 4392 end 4393 4394@ @<Declare subprocedures for |init_math|@>= 4395procedure just_reverse(@!p:pointer); 4396label found,done; 4397var l:pointer; {the new list} 4398@!t:pointer; {tail of reversed segment} 4399@!q:pointer; {the next node} 4400@!m,@!n:halfword; {count of unmatched math nodes} 4401begin m:=min_halfword; n:=min_halfword; 4402if link(temp_head)=null then 4403 begin just_copy(link(p),temp_head,null); q:=link(temp_head); 4404 end 4405else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head)); 4406 end; 4407t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected; 4408while q<>null do 4409 if is_char_node(q) then 4410 repeat p:=q; q:=link(p); link(p):=l; l:=p; 4411 until not is_char_node(q) 4412 else begin p:=q; q:=link(p); 4413 if type(p)=math_node then 4414 @<Adjust \(t)the LR stack for the |just_reverse| routine@>; 4415 link(p):=l; l:=p; 4416 end; 4417goto done; 4418found:width(t):=width(p); link(t):=q; free_node(p,small_node_size); 4419done:link(temp_head):=l; 4420end; 4421 4422@ @<Adjust \(t)the LR stack for the |j...@>= 4423if end_LR(p) then 4424 if info(LR_ptr)<>end_LR_type(p) then 4425 begin type(p):=kern_node; incr(LR_problems); 4426 end 4427 else begin pop_LR; 4428 if n>min_halfword then 4429 begin decr(n); decr(subtype(p)); {change |after| into |before|} 4430 end 4431 else begin if m>min_halfword then decr(m)@+else goto found; 4432 type(p):=kern_node; 4433 end; 4434 end 4435else begin push_LR(p); 4436 if (n>min_halfword)or(LR_dir(p)<>cur_dir) then 4437 begin incr(n); incr(subtype(p)); {change |before| into |after|} 4438 end 4439 else begin type(p):=kern_node; incr(m); 4440 end; 4441 end 4442 4443@ The prototype box is an hlist node with the width, glue set, and shift 4444amount of |just_box|, i.e., the last line preceding the display. Its 4445hlist reflects the current \.{\\leftskip} and \.{\\rightskip}. 4446 4447@<Let |j| be the prototype box for the display@>= 4448begin if right_skip=zero_glue then j:=new_kern(0) 4449else j:=new_param_glue(right_skip_code); 4450if left_skip=zero_glue then p:=new_kern(0) 4451else p:=new_param_glue(left_skip_code); 4452link(p):=j; j:=new_null_box; width(j):=width(just_box); 4453shift_amount(j):=shift_amount(just_box); list_ptr(j):=p; 4454glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box); 4455glue_set(j):=glue_set(just_box); 4456end 4457 4458@ At the end of a displayed equation we retrieve the prototype box. 4459 4460@<Local variables for finishing...@>= 4461@!j:pointer; {prototype box} 4462 4463@ @<Retrieve the prototype box@>= 4464if mode=mmode then j:=LR_box 4465 4466@ @<Flush the prototype box@>= 4467flush_node_list(j) 4468 4469@ The |app_display| procedure used to append the displayed equation 4470and\slash or equation number to the current vertical list has three 4471parameters: the prototype box, the hbox to be appended, and the 4472displacement of the hbox in the display line. 4473 4474@<Declare subprocedures for |after_math|@>= 4475procedure app_display(@!j,@!b:pointer;@!d:scaled); 4476var z:scaled; {width of the line} 4477@!s:scaled; {move the line right this much} 4478@!e:scaled; {distance from right edge of box to end of line} 4479@!x:integer; {|pre_display_direction|} 4480@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation} 4481begin s:=display_indent; x:=pre_display_direction; 4482if x=0 then shift_amount(b):=s+d 4483else begin z:=display_width; p:=b; 4484 @<Set up the hlist for the display line@>; 4485 @<Package the display line@>; 4486 end; 4487append_to_vlist(b); 4488end; 4489 4490@ Here we construct the hlist for the display, starting with node |p| 4491and ending with node |q|. We also set |d| and |e| to the amount of 4492kerning to be added before and after the hlist (adjusted for the 4493prototype box). 4494 4495@<Set up the hlist for the display line@>= 4496if x>0 then e:=z-d-width(p) 4497else begin e:=d; d:=z-e-width(p); 4498 end; 4499if j<>null then 4500 begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p); 4501 s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s; 4502 end; 4503if box_lr(p)=dlist then q:=p {display or equation number} 4504else begin {display and equation number} 4505 r:=list_ptr(p); free_node(p,box_node_size); 4506 if r=null then confusion("LR4"); 4507 if x>0 then 4508 begin p:=r; 4509 repeat q:=r; r:=link(r); {find tail of list} 4510 until r=null; 4511 end 4512 else begin p:=null; q:=r; 4513 repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list} 4514 until r=null; 4515 end; 4516 end 4517 4518@ In the presence of a prototype box we use its shift amount and width 4519to adjust the values of kerning and add these values to the glue nodes 4520inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is 4521no prototype box (because the display is preceded by an empty 4522paragraph), or if the skip parameters are zero, we just add kerns. 4523 4524The |cancel_glue| macro creates and links a glue node that is, together 4525with another glue node, equivalent to a given amount of kerning. We can 4526use |j| as temporary pointer, since all we need is |j<>null|. 4527 4528@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont 4529@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont 4530@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end 4531@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end 4532@d cancel_glue_end_end(#)== 4533stretch_order(temp_ptr):=stretch_order(j); 4534shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j); 4535stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j) 4536 4537@<Package the display line@>= 4538if j=null then 4539 begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later} 4540 end 4541else begin r:=list_ptr(b); t:=link(r); 4542 end; 4543u:=new_math(0,end_M_code); 4544if type(t)=glue_node then {|t| is \.{\\rightskip} glue} 4545 begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t; 4546 end 4547else begin width(t):=e; link(t):=u; link(q):=t; 4548 end; 4549u:=new_math(0,begin_M_code); 4550if type(r)=glue_node then {|r| is \.{\\leftskip} glue} 4551 begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u; 4552 end 4553else begin width(r):=d; link(r):=p; link(u):=r; 4554 if j=null then 4555 begin b:=hpack(u,natural); shift_amount(b):=s; 4556 end 4557 else list_ptr(b):=u; 4558 end 4559 4560@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens} 4561primitive. 4562 4563@<Generate all \eTeX...@>= 4564primitive("scantokens",input,2); 4565@!@:scan_tokens_}{\.{\\scantokens} primitive@> 4566 4567@ @<Cases of |input| for |print_cmd_chr|@>= 4568else if chr_code=2 then print_esc("scantokens") 4569 4570@ @<Cases for |input|@>= 4571else if cur_chr=2 then pseudo_start 4572 4573@ The global variable |pseudo_files| is used to maintain a stack of 4574pseudo files. The |info| field of each pseudo file points to a linked 4575list of variable size nodes representing lines not yet processed: the 4576|info| field of the first word contains the size of this node, all the 4577following words contain ASCII codes. 4578 4579@<Glob...@>= 4580@!pseudo_files:pointer; {stack of pseudo files} 4581 4582@ @<Set init...@>= 4583pseudo_files:=null; 4584 4585@ The |pseudo_start| procedure initiates reading from a pseudo file. 4586 4587@<Declare \eTeX\ procedures for ex...@>= 4588procedure@?pseudo_start; forward;@t\2@> 4589 4590@ @<Declare \eTeX\ procedures for tok...@>= 4591procedure pseudo_start; 4592var old_setting:0..max_selector; {holds |selector| setting} 4593@!s:str_number; {string to be converted into a pseudo file} 4594@!l,@!m:pool_pointer; {indices into |str_pool|} 4595@!p,@!q,@!r:pointer; {for list construction} 4596@!w: four_quarters; {four ASCII codes} 4597@!nl,@!sz:integer; 4598begin scan_general_text; 4599old_setting:=selector; selector:=new_string; 4600token_show(temp_head); selector:=old_setting; 4601flush_list(link(temp_head)); 4602str_room(1); s:=make_string; 4603@<Convert string |s| into a new pseudo file@>; 4604flush_string; 4605@<Initiate input from new pseudo file@>; 4606end; 4607 4608@ @<Convert string |s| into a new pseudo file@>= 4609str_pool[pool_ptr]:=si(" "); l:=str_start[s]; 4610nl:=si(new_line_char); 4611p:=get_avail; q:=p; 4612while l<pool_ptr do 4613 begin m:=l; 4614 while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l); 4615 sz:=(l-m+7)div 4; 4616 if sz=1 then sz:=2; 4617 r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz); 4618 while sz>2 do 4619 begin decr(sz); incr(r); 4620 w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1])); 4621 w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3])); 4622 mem[r].qqqq:=w; m:=m+4; 4623 end; 4624 w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" "); 4625 if l>m then 4626 begin w.b0:=qi(so(str_pool[m])); 4627 if l>m+1 then 4628 begin w.b1:=qi(so(str_pool[m+1])); 4629 if l>m+2 then 4630 begin w.b2:=qi(so(str_pool[m+2])); 4631 if l>m+3 then w.b3:=qi(so(str_pool[m+3])); 4632 end; 4633 end; 4634 end; 4635 mem[r+1].qqqq:=w; 4636 if str_pool[l]=nl then incr(l); 4637 end; 4638info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p 4639 4640@ @<Initiate input from new pseudo file@>= 4641begin_file_reading; {set up |cur_file| and new level of input} 4642line:=0; limit:=start; loc:=limit+1; {force line read} 4643if tracing_scan_tokens>0 then 4644 begin if term_offset>max_print_line-3 then print_ln 4645 else if (term_offset>0)or(file_offset>0) then print_char(" "); 4646 name:=19; print("( "); incr(open_parens); update_terminal; 4647 end 4648else name:=18 4649 4650@ Here we read a line from the current pseudo file into |buffer|. 4651 4652@<Declare \eTeX\ procedures for tr...@>= 4653function pseudo_input: boolean; {inputs the next line or returns |false|} 4654var p:pointer; {current line from pseudo file} 4655@!sz:integer; {size of node |p|} 4656@!w:four_quarters; {four ASCII codes} 4657@!r:pointer; {loop index} 4658begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} 4659p:=info(pseudo_files); 4660if p=null then pseudo_input:=false 4661else begin info(pseudo_files):=link(p); sz:=ho(info(p)); 4662 if 4*sz-3>=buf_size-last then 4663 @<Report overflow of the input buffer, and abort@>; 4664 last:=first; 4665 for r:=p+1 to p+sz-1 do 4666 begin w:=mem[r].qqqq; 4667 buffer[last]:=w.b0; buffer[last+1]:=w.b1; 4668 buffer[last+2]:=w.b2; buffer[last+3]:=w.b3; 4669 last:=last+4; 4670 end; 4671 if last>=max_buf_stack then max_buf_stack:=last+1; 4672 while (last>first)and(buffer[last-1]=" ") do decr(last); 4673 free_node(p,sz); 4674 pseudo_input:=true; 4675 end; 4676end; 4677 4678@ When we are done with a pseudo file we `close' it. 4679 4680@<Declare \eTeX\ procedures for tr...@>= 4681procedure pseudo_close; {close the top level pseudo file} 4682var p,@!q: pointer; 4683begin p:=link(pseudo_files); q:=info(pseudo_files); 4684free_avail(pseudo_files); pseudo_files:=p; 4685while q<>null do 4686 begin p:=q; q:=link(p); free_node(p,ho(info(p))); 4687 end; 4688end; 4689 4690@ @<Dump the \eTeX\ state@>= 4691while pseudo_files<>null do pseudo_close; {flush pseudo files} 4692 4693@ @<Generate all \eTeX...@>= 4694primitive("readline",read_to_cs,1);@/ 4695@!@:read_line_}{\.{\\readline} primitive@> 4696 4697@ @<Cases of |read| for |print_cmd_chr|@>= 4698else print_esc("readline") 4699 4700@ @<Handle \.{\\readline} and |goto done|@>= 4701if j=1 then 4702 begin while loc<=limit do {current line not yet finished} 4703 begin cur_chr:=buffer[loc]; incr(loc); 4704 if cur_chr=" " then cur_tok:=space_token 4705 @+else cur_tok:=cur_chr+other_token; 4706 store_new_token(cur_tok); 4707 end; 4708 goto done; 4709 end 4710 4711@ Here we define the additional conditionals of \eTeX\ as well as the 4712\.{\\unless} prefix. 4713 4714@d if_def_code=17 { `\.{\\ifdefined}' } 4715@d if_cs_code=18 { `\.{\\ifcsname}' } 4716@d if_font_char_code=19 { `\.{\\iffontchar}' } 4717 4718@<Generate all \eTeX...@>= 4719primitive("unless",expand_after,1);@/ 4720@!@:unless_}{\.{\\unless} primitive@> 4721primitive("ifdefined",if_test,if_def_code); 4722@!@:if_defined_}{\.{\\ifdefined} primitive@> 4723primitive("ifcsname",if_test,if_cs_code); 4724@!@:if_cs_name_}{\.{\\ifcsname} primitive@> 4725primitive("iffontchar",if_test,if_font_char_code); 4726@!@:if_font_char_}{\.{\\iffontchar} primitive@> 4727 4728@ @<Cases of |expandafter| for |print_cmd_chr|@>= 4729else print_esc("unless") 4730 4731@ @<Cases of |if_test| for |print_cmd_chr|@>= 4732if_def_code:print_esc("ifdefined"); 4733if_cs_code:print_esc("ifcsname"); 4734if_font_char_code:print_esc("iffontchar"); 4735 4736@ The result of a boolean condition is reversed when the conditional is 4737preceded by \.{\\unless}. 4738 4739@<Negate a boolean conditional and |goto reswitch|@>= 4740begin get_token; 4741if (cur_cmd=if_test)and(cur_chr<>if_case_code) then 4742 begin cur_chr:=cur_chr+unless_code; goto reswitch; 4743 end; 4744print_err("You can't use `"); print_esc("unless"); print("' before `"); 4745@.You can't use \\unless...@> 4746print_cmd_chr(cur_cmd,cur_chr); print_char("'"); 4747help1("Continue, and I'll forget that it ever happened."); 4748back_error; 4749end 4750 4751@ The conditional \.{\\ifdefined} tests if a control sequence is 4752defined. 4753 4754We need to reset |scanner_status|, since \.{\\outer} control sequences 4755are allowed, but we might be scanning a macro definition or preamble. 4756 4757@<Cases for |conditional|@>= 4758if_def_code:begin save_scanner_status:=scanner_status; 4759 scanner_status:=normal; 4760 get_next; b:=(cur_cmd<>undefined_cs); 4761 scanner_status:=save_scanner_status; 4762 end; 4763 4764@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter} 4765\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new 4766control sequence will be entered into the hash table (once all tokens 4767preceding the mandatory \.{\\endcsname} have been expanded). 4768 4769@<Cases for |conditional|@>= 4770if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} 4771 repeat get_x_token; 4772 if cur_cs=0 then store_new_token(cur_tok); 4773 until cur_cs<>0; 4774 if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>; 4775 @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>; 4776 flush_list(n); 4777 b:=(eq_type(cur_cs)<>undefined_cs); 4778 end; 4779 4780@ @<Look up the characters of list |n| in the hash table...@>= 4781m:=first; p:=link(n); 4782while p<>null do 4783 begin if m>=max_buf_stack then 4784 begin max_buf_stack:=m+1; 4785 if max_buf_stack=buf_size then 4786 overflow("buffer size",buf_size); 4787@:TeX capacity exceeded buffer size}{\quad buffer size@> 4788 end; 4789 buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); 4790 end; 4791if m>first+1 then 4792 cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|} 4793else if m=first then cur_cs:=null_cs {the list is empty} 4794else cur_cs:=single_base+buffer[first] {the list has length one} 4795 4796@ The conditional \.{\\iffontchar} tests the existence of a character in 4797a font. 4798 4799@<Cases for |conditional|@>= 4800if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num; 4801 if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then 4802 b:=char_exists(char_info(n)(qi(cur_val))) 4803 else b:=false; 4804 end; 4805 4806@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix 4807command for macro definitions. Such macros are protected against 4808expansions when lists of expanded tokens are built, e.g., for \.{\\edef} 4809or during \.{\\write}. 4810 4811@<Generate all \eTeX...@>= 4812primitive("protected",prefix,8); 4813@!@:protected_}{\.{\\protected} primitive@> 4814 4815@ @<Cases of |prefix| for |print_cmd_chr|@>= 4816else if chr_code=8 then print_esc("protected") 4817 4818@ The |get_x_or_protected| procedure is like |get_x_token| except that 4819protected macros are not expanded. 4820 4821@<Declare \eTeX\ procedures for sc...@>= 4822procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|, 4823 and expands non-protected macros} 4824label exit; 4825begin loop@+begin get_token; 4826 if cur_cmd<=max_command then return; 4827 if (cur_cmd>=call)and(cur_cmd<end_template) then 4828 if info(link(cur_chr))=protected_token then return; 4829 expand; 4830 end; 4831exit:end; 4832 4833@ A group entered (or a conditional started) in one file may end in a 4834different file. Such slight anomalies, although perfectly legitimate, 4835may cause errors that are difficult to locate. In order to be able to 4836give a warning message when such anomalies occur, \eTeX\ uses the 4837|grp_stack| and |if_stack| arrays to record the initial |cur_boundary| 4838and |cond_ptr| values for each input file. 4839 4840@<Glob...@>= 4841@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|} 4842@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|} 4843 4844@ When a group ends that was apparently entered in a different input 4845file, the |group_warning| procedure is invoked in order to update the 4846|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to 4847give a warning message. The situation is, however, somewhat complicated 4848by two facts: (1)~There may be |grp_stack| elements without a 4849corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g., 4850error insertions from the terminal); and (2)~the relevant information is 4851recorded in the |name_field| of the |input_stack| only loosely 4852synchronized with the |in_open| variable indexing |grp_stack|. 4853 4854@<Declare \eTeX\ procedures for tr...@>= 4855procedure group_warning; 4856var i:0..max_in_open; {index into |grp_stack|} 4857@!w:boolean; {do we need a warning?} 4858begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; 4859 {store current state} 4860i:=in_open; w:=false; 4861while (grp_stack[i]=cur_boundary)and(i>0) do 4862 begin @<Set variable |w| to indicate if this case should be reported@>; 4863 grp_stack[i]:=save_index(save_ptr); decr(i); 4864 end; 4865if w then 4866 begin print_nl("Warning: end of "); print_group(true); 4867@.Warning: end of...@> 4868 print(" of a different file"); print_ln; 4869 if tracing_nesting>1 then show_context; 4870 if history=spotless then history:=warning_issued; 4871 end; 4872end; 4873 4874@ This code scans the input stack in order to determine the type of the 4875current input file. 4876 4877@<Set variable |w| to...@>= 4878if tracing_nesting>0 then 4879 begin while (input_stack[base_ptr].state_field=token_list)or@| 4880 (input_stack[base_ptr].index_field>i) do decr(base_ptr); 4881 if input_stack[base_ptr].name_field>17 then w:=true; 4882 end 4883 4884@ When a conditional ends that was apparently started in a different 4885input file, the |if_warning| procedure is invoked in order to update the 4886|if_stack|. If moreover \.{\\tracingnesting} is positive we want to 4887give a warning message (with the same complications as above). 4888 4889@<Declare \eTeX\ procedures for tr...@>= 4890procedure if_warning; 4891var i:0..max_in_open; {index into |if_stack|} 4892@!w:boolean; {do we need a warning?} 4893begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; 4894 {store current state} 4895i:=in_open; w:=false; 4896while if_stack[i]=cond_ptr do 4897 begin @<Set variable |w| to...@>; 4898 if_stack[i]:=link(cond_ptr); decr(i); 4899 end; 4900if w then 4901 begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if); 4902@.Warning: end of...@> 4903 print_if_line(if_line); print(" of a different file"); print_ln; 4904 if tracing_nesting>1 then show_context; 4905 if history=spotless then history:=warning_issued; 4906 end; 4907end; 4908 4909@ Conversely, the |file_warning| procedure is invoked when a file ends 4910and some groups entered or conditionals started while reading from that 4911file are still incomplete. 4912 4913@<Declare \eTeX\ procedures for tr...@>= 4914procedure file_warning; 4915var p:pointer; {saved value of |save_ptr| or |cond_ptr|} 4916@!l:quarterword; {saved value of |cur_level| or |if_limit|} 4917@!c:quarterword; {saved value of |cur_group| or |cur_if|} 4918@!i:integer; {saved value of |if_line|} 4919begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary; 4920while grp_stack[in_open]<>save_ptr do 4921 begin decr(cur_level); 4922 print_nl("Warning: end of file when "); 4923@.Warning: end of file when...@> 4924 print_group(true); print(" is incomplete");@/ 4925 cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr) 4926 end; 4927save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values} 4928p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line; 4929while if_stack[in_open]<>cond_ptr do 4930 begin print_nl("Warning: end of file when "); 4931@.Warning: end of file when...@> 4932 print_cmd_chr(if_test,cur_if); 4933 if if_limit=fi_code then print_esc("else"); 4934 print_if_line(if_line); print(" is incomplete");@/ 4935 if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr); 4936 if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr); 4937 end; 4938cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values} 4939print_ln; 4940if tracing_nesting>1 then show_context; 4941if history=spotless then history:=warning_issued; 4942end; 4943 4944@ Here are the additional \eTeX\ primitives for expressions. 4945 4946@<Generate all \eTeX...@>= 4947primitive("numexpr",last_item,eTeX_expr-int_val+int_val); 4948@!@:num_expr_}{\.{\\numexpr} primitive@> 4949primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val); 4950@!@:dim_expr_}{\.{\\dimexpr} primitive@> 4951primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val); 4952@!@:glue_expr_}{\.{\\glueexpr} primitive@> 4953primitive("muexpr",last_item,eTeX_expr-int_val+mu_val); 4954@!@:mu_expr_}{\.{\\muexpr} primitive@> 4955 4956@ @<Cases of |last_item| for |print_cmd_chr|@>= 4957eTeX_expr-int_val+int_val: print_esc("numexpr"); 4958eTeX_expr-int_val+dimen_val: print_esc("dimexpr"); 4959eTeX_expr-int_val+glue_val: print_esc("glueexpr"); 4960eTeX_expr-int_val+mu_val: print_esc("muexpr"); 4961 4962@ This code for reducing |cur_val_level| and\slash or negating the 4963result is similar to the one for all the other cases of 4964|scan_something_internal|, with the difference that |scan_expr| has 4965already increased the reference count of a glue specification. 4966 4967@<Process an expression and |return|@>= 4968begin if m<eTeX_mu then 4969 begin case m of 4970 @/@<Cases for fetching a glue value@>@/ 4971 end; {there are no other cases} 4972 cur_val_level:=glue_val; 4973 end 4974else if m<eTeX_expr then 4975 begin case m of 4976 @/@<Cases for fetching a mu value@>@/ 4977 end; {there are no other cases} 4978 cur_val_level:=mu_val; 4979 end 4980else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr; 4981 end; 4982while cur_val_level>level do 4983 begin if cur_val_level=glue_val then 4984 begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m); 4985 end 4986 else if cur_val_level=mu_val then mu_error; 4987 decr(cur_val_level); 4988 end; 4989if negative then 4990 if cur_val_level>=glue_val then 4991 begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m); 4992 @<Negate all three glue components of |cur_val|@>; 4993 end 4994 else negate(cur_val); 4995return; 4996end 4997 4998@ @<Declare \eTeX\ procedures for sc...@>= 4999procedure@?scan_expr; forward;@t\2@> 5000 5001@ The |scan_expr| procedure scans and evaluates an expression. 5002 5003@<Declare procedures needed for expressions@>= 5004@t\4@>@<Declare subprocedures for |scan_expr|@> 5005procedure scan_expr; {scans and evaluates an expression} 5006label restart, continue, found; 5007var a,@!b:boolean; {saved values of |arith_error|} 5008@!l:small_number; {type of expression} 5009@!r:small_number; {state of expression so far} 5010@!s:small_number; {state of term so far} 5011@!o:small_number; {next operation or type of next factor} 5012@!e:integer; {expression so far} 5013@!t:integer; {term so far} 5014@!f:integer; {current factor} 5015@!n:integer; {numerator of combined multiplication and division} 5016@!p:pointer; {top of expression stack} 5017@!q:pointer; {for stack manipulations} 5018begin l:=cur_val_level; a:=arith_error; b:=false; p:=null; 5019@<Scan and evaluate an expression |e| of type |l|@>; 5020if b then 5021 begin print_err("Arithmetic overflow"); 5022@.Arithmetic overflow@> 5023 help2("I can't evaluate this expression,")@/ 5024 ("since the result is out of range."); 5025 error; 5026 if l>=glue_val then 5027 begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e); 5028 end 5029 else e:=0; 5030 end; 5031arith_error:=a; cur_val:=e; cur_val_level:=l; 5032end; 5033 5034@ Evaluating an expression is a recursive process: When the left 5035parenthesis of a subexpression is scanned we descend to the next level 5036of recursion; the previous level is resumed with the matching right 5037parenthesis. 5038 5039@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen} 5040@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen} 5041@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen} 5042@d expr_mult=3 {$\langle\it term\rangle$ \.* seen} 5043@d expr_div=4 {$\langle\it term\rangle$ \./ seen} 5044@d expr_scale=5 {$\langle\it term\rangle$ \.* 5045 $\langle\it factor\rangle$ \./ seen} 5046 5047@<Scan and eval...@>= 5048restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0; 5049continue: if s=expr_none then o:=l@+else o:=int_val; 5050@<Scan a factor |f| of type |o| or start a subexpression@>; 5051found: @<Scan the next operator and set |o|@>; 5052arith_error:=b; 5053@<Make sure that |f| is in the proper range@>; 5054case s of @<Cases for evaluation of the current term@>@; 5055end; {there are no other cases} 5056if o>expr_sub then s:=o@+else @<Evaluate the current expression@>; 5057b:=arith_error; 5058if o<>expr_none then goto continue; 5059if p<>null then @<Pop the expression stack and |goto found|@> 5060 5061@ @<Scan the next op...@>= 5062@<Get the next non-blank non-call token@>; 5063if cur_tok=other_token+"+" then o:=expr_add 5064else if cur_tok=other_token+"-" then o:=expr_sub 5065else if cur_tok=other_token+"*" then o:=expr_mult 5066else if cur_tok=other_token+"/" then o:=expr_div 5067else begin o:=expr_none; 5068 if p=null then 5069 begin if cur_cmd<>relax then back_input; 5070 end 5071 else if cur_tok<>other_token+")" then 5072 begin print_err("Missing ) inserted for expression"); 5073@.Missing ) inserted@> 5074 help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't."); 5075 back_error; 5076 end; 5077 end 5078 5079@ @<Scan a factor...@>= 5080@<Get the next non-blank non-call token@>; 5081if cur_tok=other_token+"(" then 5082 @<Push the expression stack and |goto restart|@>; 5083back_input; 5084if o=int_val then scan_int 5085else if o=dimen_val then scan_normal_dimen 5086else if o=glue_val then scan_normal_glue 5087else scan_mu_glue; 5088f:=cur_val 5089 5090@ @<Declare \eTeX\ procedures for sc...@>= 5091procedure@?scan_normal_glue; forward;@t\2@>@/ 5092procedure@?scan_mu_glue; forward;@t\2@> 5093 5094@ Here we declare two trivial procedures in order to avoid mutually 5095recursive procedures with parameters. 5096 5097@<Declare procedures needed for expressions@>= 5098procedure scan_normal_glue; 5099begin scan_glue(glue_val); 5100end; 5101@# 5102procedure scan_mu_glue; 5103begin scan_glue(mu_val); 5104end; 5105 5106@ Parenthesized subexpressions can be inside expressions, and this 5107nesting has a stack. Seven local variables represent the top of the 5108expression stack: |p| points to pushed-down entries, if any; |l| 5109specifies the type of expression currently beeing evaluated; |e| is the 5110expression so far and |r| is the state of its evaluation; |t| is the 5111term so far and |s| is the state of its evaluation; finally |n| is the 5112numerator for a combined multiplication and division, if any. 5113 5114@d expr_node_size=4 {number of words in stack entry for subexpressions} 5115@d expr_e_field(#)==mem[#+1].int {saved expression so far} 5116@d expr_t_field(#)==mem[#+2].int {saved term so far} 5117@d expr_n_field(#)==mem[#+3].int {saved numerator} 5118 5119@<Push the expression...@>= 5120begin q:=get_node(expr_node_size); link(q):=p; type(q):=l; 5121subtype(q):=4*s+r; 5122expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n; 5123p:=q; l:=o; goto restart; 5124end 5125 5126@ @<Pop the expression...@>= 5127begin f:=e; q:=p; 5128e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q); 5129s:=subtype(q) div 4; r:=subtype(q) mod 4; 5130l:=type(q); p:=link(q); free_node(q,expr_node_size); 5131goto found; 5132end 5133 5134@ We want to make sure that each term and (intermediate) result is in 5135the proper range. Integer values must not exceed |infinity| 5136($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen| 5137($2^{30}-1$). We avoid the absolute value of an integer, because this 5138might fail for the value $-2^{31}$ using 32-bit arithmetic. 5139 5140@d num_error(#)== {clear a number or dimension and set |arith_error|} 5141 begin arith_error:=true; #:=0; 5142 end 5143@d glue_error(#)== {clear a glue spec and set |arith_error|} 5144 begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue); 5145 end 5146 5147@<Make sure that |f|...@>= 5148if (l=int_val)or(s>expr_sub) then 5149 begin if (f>infinity)or(f<-infinity) then num_error(f); 5150 end 5151else if l=dimen_val then 5152 begin if abs(f)>max_dimen then num_error(f); 5153 end 5154else begin if (abs(width(f))>max_dimen)or@| 5155 (abs(stretch(f))>max_dimen)or@| 5156 (abs(shrink(f))>max_dimen) then glue_error(f); 5157 end 5158 5159@ Applying the factor |f| to the partial term |t| (with the operator 5160|s|) is delayed until the next operator |o| has been scanned. Here we 5161handle the first factor of a partial term. A glue spec has to be copied 5162unless the next operator is a right parenthesis; this allows us later on 5163to simply modify the glue components. 5164 5165@d normalize_glue(#)== 5166 if stretch(#)=0 then stretch_order(#):=normal; 5167 if shrink(#)=0 then shrink_order(#):=normal 5168 5169@<Cases for evaluation of the current term@>= 5170expr_none: if (l>=glue_val)and(o<>expr_none) then 5171 begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t); 5172 end 5173 else t:=f; 5174 5175@ When a term |t| has been completed it is copied to, added to, or 5176subtracted from the expression |e|. 5177 5178@d expr_add_sub(#)==add_or_sub(#,r=expr_sub) 5179@d expr_a(#)==expr_add_sub(#,max_dimen) 5180 5181@<Evaluate the current expression@>= 5182begin s:=expr_none; 5183if r=expr_none then e:=t 5184else if l=int_val then e:=expr_add_sub(e,t,infinity) 5185else if l=dimen_val then e:=expr_a(e,t) 5186else @<Compute the sum or difference of two glue specs@>; 5187r:=o; 5188end 5189 5190@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum 5191(for |negative=false|) or difference (for |negative=true|) of |x| and 5192|y|, provided the absolute value of the result does not exceed 5193|max_answer|. 5194 5195@<Declare subprocedures for |scan_expr|@>= 5196function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer; 5197var a:integer; {the answer} 5198begin if negative then negate(y); 5199if x>=0 then 5200 if y<=max_answer-x then a:=x+y@+else num_error(a) 5201else if y>=-max_answer-x then a:=x+y@+else num_error(a); 5202add_or_sub:=a; 5203end; 5204 5205@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and 5206|shrink_order(e)>normal| implies |shrink(e)<>0|. 5207 5208@<Compute the sum or diff...@>= 5209begin width(e):=expr_a(width(e),width(t)); 5210if stretch_order(e)=stretch_order(t) then 5211 stretch(e):=expr_a(stretch(e),stretch(t)) 5212else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then 5213 begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t); 5214 end; 5215if shrink_order(e)=shrink_order(t) then 5216 shrink(e):=expr_a(shrink(e),shrink(t)) 5217else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then 5218 begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t); 5219 end; 5220delete_glue_ref(t); normalize_glue(e); 5221end 5222 5223@ If a multiplication is followed by a division, the two operations are 5224combined into a `scaling' operation. Otherwise the term |t| is 5225multiplied by the factor |f|. 5226 5227@d expr_m(#)==#:=nx_plus_y(#,f,0) 5228 5229@<Cases for evaluation of the current term@>= 5230expr_mult: if o=expr_div then 5231 begin n:=f; o:=expr_scale; 5232 end 5233 else if l=int_val then t:=mult_integers(t,f) 5234 else if l=dimen_val then expr_m(t) 5235 else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t)); 5236 end; 5237 5238@ Here we divide the term |t| by the factor |f|. 5239 5240@d expr_d(#)==#:=quotient(#,f) 5241 5242@<Cases for evaluation of the current term@>= 5243expr_div: if l<glue_val then expr_d(t) 5244 else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t)); 5245 end; 5246 5247@ The function |quotient(n,d)| computes the rounded quotient 5248$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive. 5249 5250@<Declare subprocedures for |scan_expr|@>= 5251function quotient(@!n,@!d:integer):integer; 5252var negative:boolean; {should the answer be negated?} 5253@!a:integer; {the answer} 5254begin if d=0 then num_error(a) 5255else begin if d>0 then negative:=false 5256 else begin negate(d); negative:=true; 5257 end; 5258 if n<0 then 5259 begin negate(n); negative:=not negative; 5260 end; 5261 a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!} 5262 if d+n>=0 then incr(a); 5263 if negative then negate(a); 5264 end; 5265quotient:=a; 5266end; 5267 5268@ Here the term |t| is multiplied by the quotient $n/f$. 5269 5270@d expr_s(#)==#:=fract(#,n,f,max_dimen) 5271 5272@<Cases for evaluation of the current term@>= 5273expr_scale: if l=int_val then t:=fract(t,n,f,infinity) 5274 else if l=dimen_val then expr_s(t) 5275 else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t)); 5276 end; 5277 5278@ Finally, the function |fract(x,n,d,max_answer)| computes the integer 5279$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive 5280and the result does not exceed |max_answer|. We can't use floating 5281point arithmetic since the routine must produce identical results in all 5282cases; and it would be too dangerous to multiply by~|n| and then divide 5283by~|d|, in separate operations, since overflow might well occur. Hence 5284this subroutine simulates double precision arithmetic, somewhat 5285analogous to \MF's |make_fraction| and |take_fraction| routines. 5286 5287@d too_big=88 {go here when the result is too big} 5288 5289@<Declare subprocedures for |scan_expr|@>= 5290function fract(@!x,@!n,@!d,@!max_answer:integer):integer; 5291label found, found1, too_big, done; 5292var negative:boolean; {should the answer be negated?} 5293@!a:integer; {the answer} 5294@!f:integer; {a proper fraction} 5295@!h:integer; {smallest integer such that |2*h>=d|} 5296@!r:integer; {intermediate remainder} 5297@!t:integer; {temp variable} 5298begin if d=0 then goto too_big; 5299a:=0; 5300if d>0 then negative:=false 5301else begin negate(d); negative:=true; 5302 end; 5303if x<0 then 5304 begin negate(x); negative:=not negative; 5305 end 5306else if x=0 then goto done; 5307if n<0 then 5308 begin negate(n); negative:=not negative; 5309 end; 5310t:=n div d; 5311if t>max_answer div x then goto too_big; 5312a:=t*x; n:=n-t*d; 5313if n=0 then goto found; 5314t:=x div d; 5315if t>(max_answer-a) div n then goto too_big; 5316a:=a+t*n; x:=x-t*d; 5317if x=0 then goto found; 5318if x<n then 5319 begin t:=x; x:=n; n:=t; 5320 end; {now |0<n<=x<d|} 5321@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@; 5322if f>(max_answer-a) then goto too_big; 5323a:=a+f; 5324found: if negative then negate(a); 5325goto done; 5326too_big: num_error(a); 5327done: fract:=a; 5328end; 5329 5330@ The loop here preserves the following invariant relations 5331between |f|, |x|, |n|, and~|r|: 5332(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$; 5333(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$ 5334and $n$. 5335 5336Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|, 5337because the latter could overflow. 5338 5339@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>= 5340f:=0; r:=(d div 2)-d; h:=-r; 5341loop@+begin if odd(n) then 5342 begin r:=r+x; 5343 if r>=0 then 5344 begin r:=r-d; incr(f); 5345 end; 5346 end; 5347 n:=n div 2; 5348 if n=0 then goto found1; 5349 if x<h then x:=x+x 5350 else begin t:=x-d; x:=t+x; f:=f+n; 5351 if x<n then 5352 begin if x=0 then goto found1; 5353 t:=x; x:=n; n:=t; 5354 end; 5355 end; 5356 end; 5357found1: 5358 5359@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and 5360\.{\\glueshrinkorder} commands return the stretch and shrink components 5361and their orders of ``infinity'' of a glue specification. 5362 5363@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}} 5364@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}} 5365@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}} 5366@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}} 5367 5368@<Generate all \eTeX...@>= 5369primitive("gluestretchorder",last_item,glue_stretch_order_code); 5370@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@> 5371primitive("glueshrinkorder",last_item,glue_shrink_order_code); 5372@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@> 5373primitive("gluestretch",last_item,glue_stretch_code); 5374@!@:glue_stretch_}{\.{\\gluestretch} primitive@> 5375primitive("glueshrink",last_item,glue_shrink_code); 5376@!@:glue_shrink_}{\.{\\glueshrink} primitive@> 5377 5378@ @<Cases of |last_item| for |print_cmd_chr|@>= 5379glue_stretch_order_code: print_esc("gluestretchorder"); 5380glue_shrink_order_code: print_esc("glueshrinkorder"); 5381glue_stretch_code: print_esc("gluestretch"); 5382glue_shrink_code: print_esc("glueshrink"); 5383 5384@ @<Cases for fetching an integer value@>= 5385glue_stretch_order_code, glue_shrink_order_code: 5386 begin scan_normal_glue; q:=cur_val; 5387 if m=glue_stretch_order_code then cur_val:=stretch_order(q) 5388 else cur_val:=shrink_order(q); 5389 delete_glue_ref(q); 5390 end; 5391 5392@ @<Cases for fetching a dimension value@>= 5393glue_stretch_code, glue_shrink_code: 5394 begin scan_normal_glue; q:=cur_val; 5395 if m=glue_stretch_code then cur_val:=stretch(q) 5396 else cur_val:=shrink(q); 5397 delete_glue_ref(q); 5398 end; 5399 5400@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue 5401into normal glue and vice versa; they allow to manipulate math glue with 5402\.{\\gluestretch} etc. 5403 5404@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}} 5405@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}} 5406 5407@<Generate all \eTeX...@>= 5408primitive("mutoglue",last_item,mu_to_glue_code); 5409@!@:mu_to_glue_}{\.{\\mutoglue} primitive@> 5410primitive("gluetomu",last_item,glue_to_mu_code); 5411@!@:glue_to_mu_}{\.{\\gluetomu} primitive@> 5412 5413@ @<Cases of |last_item| for |print_cmd_chr|@>= 5414mu_to_glue_code: print_esc("mutoglue"); 5415glue_to_mu_code: print_esc("gluetomu"); 5416 5417@ @<Cases for fetching a glue value@>= 5418mu_to_glue_code: scan_mu_glue; 5419 5420@ @<Cases for fetching a mu value@>= 5421glue_to_mu_code: scan_normal_glue; 5422 5423@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count, 5424dimen, skip, muskip, box, and token registers. As in \TeX\ the first 5425256 registers of each kind are realized as arrays in the table of 5426equivalents; the additional registers are realized as tree structures 5427built from variable-size nodes with individual registers existing only 5428when needed. Default values are used for nonexistent registers: zero 5429for count and dimen values, |zero_glue| for glue (skip and muskip) 5430values, void for boxes, and |null| for token lists (and current marks 5431discussed below). 5432 5433Similarly there are 32768 mark classes; the command \.{\\marks}|n| 5434creates a mark node for a given mark class |0<=n<=32767| (where 5435\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually 5436the |fire_up| routine) and the |vsplit| routine maintain the current 5437values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and 5438|split_bot_mark| for each mark class. They are accessed as 5439\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to 5440\.{\\topmark}. As in \TeX\ the five current marks for mark class zero 5441are realized as |cur_mark| array. The additional current marks are 5442again realized as tree structure with individual mark classes existing 5443only when needed. 5444 5445@<Generate all \eTeX...@>= 5446primitive("marks",mark,marks_code); 5447@!@:marks_}{\.{\\marks} primitive@> 5448primitive("topmarks",top_bot_mark,top_mark_code+marks_code); 5449@!@:top_marks_}{\.{\\topmarks} primitive@> 5450primitive("firstmarks",top_bot_mark,first_mark_code+marks_code); 5451@!@:first_marks_}{\.{\\firstmarks} primitive@> 5452primitive("botmarks",top_bot_mark,bot_mark_code+marks_code); 5453@!@:bot_marks_}{\.{\\botmarks} primitive@> 5454primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code); 5455@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@> 5456primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code); 5457@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@> 5458 5459@ The |scan_register_num| procedure scans a register number that must 5460not exceed 255 in compatibility mode resp.\ 32767 in extended mode. 5461 5462@<Declare \eTeX\ procedures for ex...@>= 5463procedure@?scan_register_num; forward;@t\2@> 5464 5465@ @<Declare procedures that scan restricted classes of integers@>= 5466procedure scan_register_num; 5467begin scan_int; 5468if (cur_val<0)or(cur_val>max_reg_num) then 5469 begin print_err("Bad register code"); 5470@.Bad register code@> 5471 help2(max_reg_help_line)("I changed this one to zero."); 5472 int_error(cur_val); cur_val:=0; 5473 end; 5474end; 5475 5476@ @<Initialize variables for \eTeX\ comp...@>= 5477max_reg_num:=255; 5478max_reg_help_line:="A register number must be between 0 and 255."; 5479 5480@ @<Initialize variables for \eTeX\ ext...@>= 5481max_reg_num:=32767; 5482max_reg_help_line:="A register number must be between 0 and 32767."; 5483 5484@ @<Glob...@>= 5485@!max_reg_num: halfword; {largest allowed register number} 5486@!max_reg_help_line: str_number; {first line of help message} 5487 5488@ There are seven almost identical doubly linked trees, one for the 5489sparse array of the up to 32512 additional registers of each kind and 5490one for the sparse array of the up to 32767 additional mark classes. 5491The root of each such tree, if it exists, is an index node containing 16 5492pointers to subtrees for 4096 consecutive array elements. Similar index 5493nodes are the starting points for all nonempty subtrees for 4096, 256, 5494and 16 consecutive array elements. These four levels of index nodes are 5495followed by a fifth level with nodes for the individual array elements. 5496 5497Each index node is nine words long. The pointers to the 16 possible 5498subtrees or are kept in the |info| and |link| fields of the last eight 5499words. (It would be both elegant and efficient to declare them as 5500array, unfortunately \PASCAL\ doesn't allow this.) 5501 5502The fields in the first word of each index node and in the nodes for the 5503array elements are closely related. The |link| field points to the next 5504lower index node and the |sa_index| field contains four bits (one 5505hexadecimal digit) of the register number or mark class. For the lowest 5506index node the |link| field is |null| and the |sa_index| field indicates 5507the type of quantity (|int_val|, |dimen_val|, |glue_val|, |mu_val|, 5508|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index 5509nodes counts how many of the 16 pointers are non-null. 5510 5511The |sa_index| field in the nodes for array elements contains the four 5512bits plus 16 times the type. Therefore such a node represents a count 5513or dimen register if and only if |sa_index<dimen_val_limit|; it 5514represents a skip or muskip register if and only if 5515|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register 5516if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a 5517token list register if and only if 5518|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark 5519class if and only if |tok_val_limit<=sa_index|. 5520 5521The |new_index| procedure creates an index node (returned in |cur_ptr|) 5522having given contents of the |sa_index| and |link| fields. 5523 5524@d box_val==4 {the additional box registers} 5525@d mark_val=6 {the additional mark classes} 5526@# 5527@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$} 5528@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$} 5529@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$} 5530@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$} 5531@# 5532@d index_node_size=9 {size of an index node} 5533@d sa_index==type {a four-bit address or a type or both} 5534@d sa_used==subtype {count of non-null pointers} 5535 5536@<Declare \eTeX\ procedures for ex...@>= 5537procedure new_index(@!i:quarterword; @!q:pointer); 5538var k:small_number; {loop index} 5539begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i; 5540sa_used(cur_ptr):=0; link(cur_ptr):=q; 5541for k:=1 to index_node_size-1 do {clear all 16 pointers} 5542 mem[cur_ptr+k]:=sa_null; 5543end; 5544 5545@ The roots of the seven trees for the additional registers and mark 5546classes are kept in the |sa_root| array. The first six locations must 5547be dumped and undumped; the last one is also known as |sa_mark|. 5548 5549@d sa_mark==sa_root[mark_val] {root for mark classes} 5550 5551@<Glob...@>= 5552@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays} 5553@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|} 5554@!sa_null:memory_word; {two |null| pointers} 5555 5556@ @<Set init...@>= 5557sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; 5558 5559@ @<Initialize table...@>= 5560for i:=int_val to tok_val do sa_root[i]:=null; 5561 5562@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element| 5563procedure returns (in |cur_ptr|) a pointer to the node for the 5564corresponding array element, or |null| when no such element exists. The 5565third parameter |w| is set |true| if the element must exist, e.g., 5566because it is about to be modified. The procedure has two main 5567branches: one follows the existing tree structure, the other (only used 5568when |w| is |true|) creates the missing nodes. 5569 5570We use macros to extract the four-bit pieces from a sixteen-bit register 5571number or mark class and to fetch or store one of the 16 pointers from 5572an index node. 5573 5574@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing} 5575 begin if cur_ptr=null then 5576 if w then goto #@+else return; 5577 end 5578@# 5579@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit} 5580@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit} 5581@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit} 5582@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit} 5583@# 5584@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1) 5585 else cur_ptr:=info(q+(i div 2)+1) 5586 {set |cur_ptr| to the pointer indexed by |i| from index node |q|} 5587@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=# 5588 else info(q+(i div 2)+1):=# 5589 {store the pointer indexed by |i| in index node |q|} 5590@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q)); 5591 end {add |cur_ptr| as the pointer indexed by |i| in index node |q|} 5592@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q)); 5593 end {delete the pointer indexed by |i| in index node |q|} 5594 5595@<Declare \eTeX\ procedures for ex...@>= 5596procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean); 5597 {sets |cur_val| to sparse array element location or |null|} 5598label not_found,not_found1,not_found2,not_found3,not_found4,exit; 5599var q:pointer; {for list manipulations} 5600@!i:small_number; {a four bit index} 5601begin cur_ptr:=sa_root[t]; 5602if_cur_ptr_is_null_then_return_or_goto(not_found);@/ 5603q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr; 5604if_cur_ptr_is_null_then_return_or_goto(not_found1);@/ 5605q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr; 5606if_cur_ptr_is_null_then_return_or_goto(not_found2);@/ 5607q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr; 5608if_cur_ptr_is_null_then_return_or_goto(not_found3);@/ 5609q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr; 5610if (cur_ptr=null)and w then goto not_found4; 5611return; 5612not_found: new_index(t,null); {create first level index node} 5613sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n); 5614not_found1: new_index(i,q); {create second level index node} 5615add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n); 5616not_found2: new_index(i,q); {create third level index node} 5617add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n); 5618not_found3: new_index(i,q); {create fourth level index node} 5619add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n); 5620not_found4: @<Create a new array element of type |t| with index |i|@>; 5621link(cur_ptr):=q; add_sa_ptr; 5622exit:end; 5623 5624@ The array elements for registers are subject to grouping and have an 5625|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|. 5626Since saved values as well as shorthand definitions (created by e.g., 5627\.{\\countdef}) refer to the location of the respective array element, 5628we need a reference count that is kept in the |sa_ref| field. An array 5629element can be deleted (together with all references to it) when its 5630|sa_ref| value is |null| and its value is the default value. 5631@^reference counts@> 5632 5633Skip, muskip, box, and token registers use two word nodes, their values 5634are stored in the |sa_ptr| field. 5635Count and dimen registers use three word nodes, their 5636values are stored in the |sa_int| resp.\ |sa_dim| field in the third 5637word; the |sa_ptr| field is used under the name |sa_num| to store 5638the register number. Mark classes use four word nodes. The last three 5639words contain the five types of current marks 5640 5641@d sa_lev==sa_used {grouping level for the current value} 5642@d pointer_node_size=2 {size of an element with a pointer value} 5643@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index} 5644@d sa_ref(#)==info(#+1) {reference count of a sparse array element} 5645@d sa_ptr(#)==link(#+1) {a pointer value} 5646@# 5647@d word_node_size=3 {size of an element with a word value} 5648@d sa_num==sa_ptr {the register number} 5649@d sa_int(#)==mem[#+2].int {an integer} 5650@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)} 5651@# 5652@d mark_class_node_size=4 {size of an element for a mark class} 5653@# 5654@d fetch_box(#)== {fetch |box(cur_val)|} 5655 if cur_val<256 then #:=box(cur_val) 5656 else begin find_sa_element(box_val,cur_val,false); 5657 if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr); 5658 end 5659 5660@<Create a new array element...@>= 5661if t=mark_val then {a mark class} 5662 begin cur_ptr:=get_node(mark_class_node_size); 5663 mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null; 5664 end 5665else begin if t<=dimen_val then {a count or dimen register} 5666 begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0; 5667 sa_num(cur_ptr):=n; 5668 end 5669 else begin cur_ptr:=get_node(pointer_node_size); 5670 if t<=mu_val then {a skip or muskip register} 5671 begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue); 5672 end 5673 else sa_ptr(cur_ptr):=null; {a box or token list register} 5674 end; 5675 sa_ref(cur_ptr):=null; {all registers have a reference count} 5676 end; 5677sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one 5678 5679@ The |delete_sa_ref| procedure is called when a pointer to an array 5680element representing a register is being removed; this means that the 5681reference count should be decreased by one. If the reduced reference 5682count is |null| and the register has been (globally) assigned its 5683default value the array element should disappear, possibly together with 5684some index nodes. This procedure will never be used for mark class 5685nodes. 5686@^reference counts@> 5687 5688@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count} 5689@# 5690@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same} 5691 if cur_val<256 then box(cur_val):=#@+else set_sa_box(#) 5692@# 5693@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false); 5694 if cur_ptr<>null then 5695 begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr); 5696 end; 5697 end 5698 5699@<Declare \eTeX\ procedures for tr...@>= 5700procedure delete_sa_ref(@!q:pointer); {reduce reference count} 5701label exit; 5702var p:pointer; {for list manipulations} 5703@!i:small_number; {a four bit index} 5704@!s:small_number; {size of a node} 5705begin decr(sa_ref(q)); 5706if sa_ref(q)<>null then return; 5707if sa_index(q)<dimen_val_limit then 5708 if sa_int(q)=0 then s:=word_node_size 5709 else return 5710else begin if sa_index(q)<mu_val_limit then 5711 if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue) 5712 else return 5713 else if sa_ptr(q)<>null then return; 5714 s:=pointer_node_size; 5715 end; 5716repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s); 5717if q=null then {the whole tree has been freed} 5718 begin sa_root[i]:=null; return; 5719 end; 5720delete_sa_ptr; s:=index_node_size; {node |q| is an index node} 5721until sa_used(q)>0; 5722exit:end; 5723 5724@ The |print_sa_num| procedure prints the register number corresponding 5725to an array element. 5726 5727@<Basic print...@>= 5728procedure print_sa_num(@!q:pointer); {print register number} 5729var @!n:halfword; {the register number} 5730begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case} 5731else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q); 5732 q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q))); 5733 end; 5734print_int(n); 5735end; 5736 5737@ Here is a procedure that displays the contents of an array element 5738symbolically. It is used under similar circumstances as is 5739|restore_trace| (together with |show_eqtb|) for the quantities kept in 5740the |eqtb| array. 5741 5742@<Declare \eTeX\ procedures for tr...@>= 5743@!stat procedure show_sa(@!p:pointer;@!s:str_number); 5744var t:small_number; {the type of element} 5745begin begin_diagnostic; print_char("{"); print(s); print_char(" "); 5746if p=null then print_char("?") {this can't happen} 5747else begin t:=sa_type(p); 5748 if t<box_val then print_cmd_chr(register,p) 5749 else if t=box_val then 5750 begin print_esc("box"); print_sa_num(p); 5751 end 5752 else if t=tok_val then print_cmd_chr(toks_register,p) 5753 else print_char("?"); {this can't happen either} 5754 print_char("="); 5755 if t=int_val then print_int(sa_int(p)) 5756 else if t=dimen_val then 5757 begin print_scaled(sa_dim(p)); print("pt"); 5758 end 5759 else begin p:=sa_ptr(p); 5760 if t=glue_val then print_spec(p,"pt") 5761 else if t=mu_val then print_spec(p,"mu") 5762 else if t=box_val then 5763 if p=null then print("void") 5764 else begin depth_threshold:=0; breadth_max:=1; show_node_list(p); 5765 end 5766 else if t=tok_val then 5767 begin if p<>null then show_token_list(link(p),null,32); 5768 end 5769 else print_char("?"); {this can't happen either} 5770 end; 5771 end; 5772print_char("}"); end_diagnostic(false); 5773end; 5774tats 5775 5776@ Here we compute the pointer to the current mark of type |t| and mark 5777class |cur_val|. 5778 5779@<Compute the mark pointer...@>= 5780begin find_sa_element(mark_val,cur_val,false); 5781if cur_ptr<>null then 5782 if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1) 5783 else cur_ptr:=info(cur_ptr+(t div 2)+1); 5784end 5785 5786@ The current marks for all mark classes are maintained by the |vsplit| 5787and |fire_up| routines and are finally destroyed (for \.{INITEX} only) 5788@.INITEX@> 5789by the |final_cleanup| routine. Apart from updating the current marks 5790when mark nodes are encountered, these routines perform certain actions 5791on all existing mark classes. The recursive |do_marks| procedure walks 5792through the whole tree or a subtree of existing mark class nodes and 5793preforms certain actions indicted by its first parameter |a|, the action 5794code. The second parameter |l| indicates the level of recursion (at 5795most four); the third parameter points to a nonempty tree or subtree. 5796The result is |true| if the complete tree or subtree has been deleted. 5797 5798@d vsplit_init==0 {action code for |vsplit| initialization} 5799@d fire_up_init==1 {action code for |fire_up| initialization} 5800@d fire_up_done==2 {action code for |fire_up| completion} 5801@d destroy_marks==3 {action code for |final_cleanup|} 5802@# 5803@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|} 5804@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|} 5805@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|} 5806@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|} 5807@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|} 5808 5809@<Declare the function called |do_marks|@>= 5810function do_marks(@!a,@!l:small_number;@!q:pointer):boolean; 5811var i:small_number; {a four bit index} 5812begin if l<4 then {|q| is an index node} 5813 begin for i:=0 to 15 do 5814 begin get_sa_ptr; 5815 if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr; 5816 end; 5817 if sa_used(q)=0 then 5818 begin free_node(q,index_node_size); q:=null; 5819 end; 5820 end 5821else {|q| is the node for a mark class} 5822 begin case a of 5823 @<Cases for |do_marks|@>@; 5824 end; {there are no other cases} 5825 if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then 5826 begin free_node(q,mark_class_node_size); q:=null; 5827 end; 5828 end; 5829do_marks:=(q=null); 5830end; 5831 5832@ At the start of the |vsplit| routine the existing |split_fist_mark| 5833and |split_bot_mark| are discarded. 5834 5835@<Cases for |do_marks|@>= 5836vsplit_init: if sa_split_first_mark(q)<>null then 5837 begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null; 5838 delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null; 5839 end; 5840 5841@ We use again the fact that |split_first_mark=null| if and only if 5842|split_bot_mark=null|. 5843 5844@<Update the current marks for |vsplit|@>= 5845begin find_sa_element(mark_val,mark_class(p),true); 5846if sa_split_first_mark(cur_ptr)=null then 5847 begin sa_split_first_mark(cur_ptr):=mark_ptr(p); 5848 add_token_ref(mark_ptr(p)); 5849 end 5850else delete_token_ref(sa_split_bot_mark(cur_ptr)); 5851sa_split_bot_mark(cur_ptr):=mark_ptr(p); 5852add_token_ref(mark_ptr(p)); 5853end 5854 5855@ At the start of the |fire_up| routine the old |top_mark| and 5856|first_mark| are discarded, whereas the old |bot_mark| becomes the new 5857|top_mark|. An empty new |top_mark| token list is, however, discarded 5858as well in order that mark class nodes can eventually be released. We 5859use again the fact that |bot_mark<>null| implies |first_mark<>null|; it 5860also knows that |bot_mark=null| implies |top_mark=first_mark=null|. 5861 5862@<Cases for |do_marks|@>= 5863fire_up_init: if sa_bot_mark(q)<>null then 5864 begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q)); 5865 delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null; 5866 if link(sa_bot_mark(q))=null then {an empty token list} 5867 begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null; 5868 end 5869 else add_token_ref(sa_bot_mark(q)); 5870 sa_top_mark(q):=sa_bot_mark(q); 5871 end; 5872 5873@ @<Cases for |do_marks|@>= 5874fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then 5875 begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q)); 5876 end; 5877 5878@ @<Update the current marks for |fire_up|@>= 5879begin find_sa_element(mark_val,mark_class(p),true); 5880if sa_first_mark(cur_ptr)=null then 5881 begin sa_first_mark(cur_ptr):=mark_ptr(p); 5882 add_token_ref(mark_ptr(p)); 5883 end; 5884if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr)); 5885sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p)); 5886end 5887 5888@ Here we use the fact that the five current mark pointers in a mark 5889class node occupy the same locations as the the first five pointers of 5890an index node. For systems using a run-time switch to distinguish 5891between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$' 5892surrounding the following piece of code should be removed. 5893@.INITEX@> 5894@^system dependencies@> 5895 5896@<Cases for |do_marks|@>= 5897@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do 5898 begin get_sa_ptr; 5899 if cur_ptr<>null then 5900 begin delete_token_ref(cur_ptr); put_sa_ptr(null); 5901 end; 5902 end; 5903tini 5904 5905@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}', 5906etc., as well as for references to sparse array elements defined by 5907`\.{\\countdef}', etc. 5908 5909@<Cases of |register| for |print_cmd_chr|@>= 5910begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then 5911 cmd:=sa_type(chr_code) 5912else begin cmd:=chr_code-mem_bot; chr_code:=null; 5913 end; 5914if cmd=int_val then print_esc("count") 5915else if cmd=dimen_val then print_esc("dimen") 5916else if cmd=glue_val then print_esc("skip") 5917else print_esc("muskip"); 5918if chr_code<>null then print_sa_num(chr_code); 5919end 5920 5921@ Similarly the command code |toks_register| is used for `\.{\\toks}' as 5922well as for references to sparse array elements defined by 5923`\.{\\toksdef}'. 5924 5925@<Cases of |toks_register| for |print_cmd_chr|@>= 5926begin print_esc("toks"); 5927if chr_code<>mem_bot then print_sa_num(chr_code); 5928end 5929 5930@ When a shorthand definition for an element of one of the sparse arrays 5931is destroyed, we must reduce the reference count. 5932 5933@<Cases for |eq_destroy|@>= 5934toks_register,register: 5935 if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then 5936 delete_sa_ref(equiv_field(w)); 5937 5938@ The task to maintain (change, save, and restore) register values is 5939essentially the same when the register is realized as sparse array 5940element or entry in |eqtb|. The global variable |sa_chain| is the head 5941of a linked list of entries saved at the topmost level |sa_level|; the 5942lists for lowel levels are kept in special save stack entries. 5943 5944@<Glob...@>= 5945@!sa_chain: pointer; {chain of saved sparse array entries} 5946@!sa_level: quarterword; {group level for |sa_chain|} 5947 5948@ @<Set init...@>= 5949sa_chain:=null; sa_level:=level_zero; 5950 5951@ The individual saved items are kept in pointer or word nodes similar 5952to those used for the array elements: a word node with value zero is, 5953however, saved as pointer node with the otherwise impossible |sa_index| 5954value |tok_val_limit|. 5955 5956@d sa_loc==sa_ref {location of saved item} 5957 5958@<Declare \eTeX\ procedures for tr...@>= 5959procedure sa_save(@!p:pointer); {saves value of |p|} 5960var q:pointer; {the new save node} 5961@!i:quarterword; {index field of node} 5962begin if cur_level<>sa_level then 5963 begin check_full_save_stack; save_type(save_ptr):=restore_sa; 5964 save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain; 5965 incr(save_ptr); sa_chain:=null; sa_level:=cur_level; 5966 end; 5967i:=sa_index(p); 5968if i<dimen_val_limit then 5969 begin if sa_int(p)=0 then 5970 begin q:=get_node(pointer_node_size); i:=tok_val_limit; 5971 end 5972 else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p); 5973 end; 5974 sa_ptr(q):=null; 5975 end 5976else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p); 5977 end; 5978sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p); 5979link(q):=sa_chain; sa_chain:=q; add_sa_ref(p); 5980end; 5981 5982@ @<Declare \eTeX\ procedures for tr...@>= 5983procedure sa_destroy(@!p:pointer); {destroy value of |p|} 5984begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p)) 5985else if sa_ptr(p)<>null then 5986 if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p)) 5987 else delete_token_ref(sa_ptr(p)); 5988end; 5989 5990@ The procedure |sa_def| assigns a new value to sparse array elements, 5991and saves the former value if appropriate. This procedure is used only 5992for skip, muskip, box, and token list registers. The counterpart of 5993|sa_def| for count and dimen registers is called |sa_w_def|. 5994 5995@d sa_define(#)==if e then 5996 if global then gsa_def(#)@+else sa_def(#) 5997 else define 5998@# 5999@d sa_def_box== {assign |cur_box| to |box(cur_val)|} 6000 begin find_sa_element(box_val,cur_val,true); 6001 if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box); 6002 end 6003@# 6004@d sa_word_define(#)==if e then 6005 if global then gsa_w_def(#)@+else sa_w_def(#) 6006 else word_define(#) 6007 6008@<Declare \eTeX\ procedures for tr...@>= 6009procedure sa_def(@!p:pointer;@!e:halfword); 6010 {new data for sparse array elements} 6011begin add_sa_ref(p); 6012if sa_ptr(p)=e then 6013 begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/ 6014 sa_destroy(p); 6015 end 6016else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/ 6017 if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p); 6018 sa_lev(p):=cur_level; sa_ptr(p):=e; 6019 @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 6020 end; 6021delete_sa_ref(p); 6022end; 6023@# 6024procedure sa_w_def(@!p:pointer;@!w:integer); 6025begin add_sa_ref(p); 6026if sa_int(p)=w then 6027 begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/ 6028 end 6029else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/ 6030 if sa_lev(p)<>cur_level then sa_save(p); 6031 sa_lev(p):=cur_level; sa_int(p):=w; 6032 @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 6033 end; 6034delete_sa_ref(p); 6035end; 6036 6037@ The |sa_def| and |sa_w_def| routines take care of local definitions. 6038@^global definitions@> 6039Global definitions are done in almost the same way, but there is no need 6040to save old values, and the new value is associated with |level_one|. 6041 6042@<Declare \eTeX\ procedures for tr...@>= 6043procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|} 6044begin add_sa_ref(p); 6045@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/ 6046sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e; 6047@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 6048delete_sa_ref(p); 6049end; 6050@# 6051procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|} 6052begin add_sa_ref(p); 6053@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/ 6054sa_lev(p):=level_one; sa_int(p):=w; 6055@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 6056delete_sa_ref(p); 6057end; 6058 6059@ The |sa_restore| procedure restores the sparse array entries pointed 6060at by |sa_chain| 6061 6062@<Declare \eTeX\ procedures for tr...@>= 6063procedure sa_restore; 6064var p:pointer; {sparse array element} 6065begin repeat p:=sa_loc(sa_chain); 6066if sa_lev(p)=level_one then 6067 begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain); 6068 @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/ 6069 end 6070else begin if sa_index(p)<dimen_val_limit then 6071 if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain) 6072 else sa_int(p):=0 6073 else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain); 6074 end; 6075 sa_lev(p):=sa_lev(sa_chain); 6076 @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/ 6077 end; 6078delete_sa_ref(p); 6079p:=sa_chain; sa_chain:=link(p); 6080if sa_index(p)<dimen_val_limit then free_node(p,word_node_size) 6081else free_node(p,pointer_node_size); 6082until sa_chain=null; 6083end; 6084 6085@ When the value of |last_line_fit| is positive, the last line of a 6086(partial) paragraph is treated in a special way and we need additional 6087fields in the active nodes. 6088 6089@d active_node_size_extended=5 {number of words in extended active nodes} 6090@d active_short(#)==mem[#+3].sc {|shortfall| of this line} 6091@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink} 6092 6093@<Glob...@>= 6094@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph} 6095@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?} 6096@!active_node_size:small_number; {number of words in active nodes} 6097@!fill_width:array[0..2] of scaled; {infinite stretch components of 6098 |par_fill_skip|} 6099@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall| 6100 corresponding to |minimal_demerits|} 6101@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding 6102 glue stretch or shrink} 6103 6104@ The new algorithm for the last line requires that the stretchability of 6105|par_fill_skip| is infinite and the stretchability of |left_skip| plus 6106|right_skip| is finite. 6107 6108@<Check for special...@>= 6109do_last_line_fit:=false; active_node_size:=active_node_size_normal; 6110 {just in case} 6111if last_line_fit>0 then 6112 begin q:=glue_ptr(last_line_fill); 6113 if (stretch(q)>0)and(stretch_order(q)>normal) then 6114 if (background[3]=0)and(background[4]=0)and(background[5]=0) then 6115 begin do_last_line_fit:=true; 6116 active_node_size:=active_node_size_extended; 6117 fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0; 6118 fill_width[stretch_order(q)-1]:=stretch(q); 6119 end; 6120 end 6121 6122@ @<Other local variables for |try_break|@>= 6123@!g:scaled; {glue stretch or shrink of test line, adjustment for last line} 6124 6125@ Here we initialize the additional fields of the first active node 6126representing the beginning of the paragraph. 6127 6128@<Initialize additional fields of the first active node@>= 6129begin active_short(q):=0; active_glue(q):=0; 6130end 6131 6132@ Here we compute the adjustment |g| and badness |b| for a line from |r| 6133to the end of the paragraph. When any of the criteria for adjustment is 6134violated we fall through to the normal algorithm. 6135 6136The last line must be too short, and have infinite stretch entirely due 6137to |par_fill_skip|. 6138 6139@<Perform computations for last line and |goto found|@>= 6140begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found; 6141 {previous line was neither stretched nor shrunk, or was infinitely bad} 6142if (cur_active_width[3]<>fill_width[0])or@| 6143 (cur_active_width[4]<>fill_width[1])or@| 6144 (cur_active_width[5]<>fill_width[2]) then goto not_found; 6145 {infinite stretch of this line not entirely due to |par_fill_skip|} 6146if active_short(r)>0 then g:=cur_active_width[2] 6147else g:=cur_active_width[6]; 6148if g<=0 then goto not_found; {no finite stretch resp.\ no shrink} 6149arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen); 6150if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen); 6151if arith_error then 6152 if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen; 6153if g>0 then 6154 @<Set the value of |b| to the badness of the last line for stretching, 6155 compute the corresponding |fit_class|, and |goto found|@> 6156else if g<0 then 6157 @<Set the value of |b| to the badness of the last line for shrinking, 6158 compute the corresponding |fit_class|, and |goto found|@>; 6159not_found:end 6160 6161@ These badness computations are rather similar to those of the standard 6162algorithm, with the adjustment amount |g| replacing the |shortfall|. 6163 6164@<Set the value of |b| to the badness of the last line for str...@>= 6165begin if g>shortfall then g:=shortfall; 6166if g>7230584 then if cur_active_width[2]<1663497 then 6167 begin b:=inf_bad; fit_class:=very_loose_fit; goto found; 6168 end; 6169b:=badness(g,cur_active_width[2]); 6170if b>12 then 6171 if b>99 then fit_class:=very_loose_fit 6172 else fit_class:=loose_fit 6173else fit_class:=decent_fit; 6174goto found; 6175end 6176 6177@ @<Set the value of |b| to the badness of the last line for shr...@>= 6178begin if -g>cur_active_width[6] then g:=-cur_active_width[6]; 6179b:=badness(-g,cur_active_width[6]); 6180if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit; 6181goto found; 6182end 6183 6184@ Vanishing values of |shortfall| and |g| indicate that the last line is 6185not adjusted. 6186 6187@<Adjust \(t)the additional data for last line@>= 6188begin if cur_p=null then shortfall:=0; 6189if shortfall>0 then g:=cur_active_width[2] 6190else if shortfall<0 then g:=cur_active_width[6] 6191else g:=0; 6192end 6193 6194@ For each feasible break we record the shortfall and glue stretch or 6195shrink (or adjustment). 6196 6197@<Store \(a)additional data for this feasible break@>= 6198begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g; 6199end 6200 6201@ Here we save these data in the active node representing a potential 6202line break. 6203 6204@<Store \(a)additional data in the new active node@>= 6205begin active_short(q):=best_pl_short[fit_class]; 6206active_glue(q):=best_pl_glue[fit_class]; 6207end 6208 6209@ @<Print additional data in the new active node@>= 6210begin print(" s="); print_scaled(active_short(q)); 6211if cur_p=null then print(" a=")@+else print(" g="); 6212print_scaled(active_glue(q)); 6213end 6214 6215@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip| 6216glue. 6217 6218@<Adjust \(t)the final line of the paragraph@>= 6219if active_short(best_bet)=0 then do_last_line_fit:=false 6220else begin q:=new_spec(glue_ptr(last_line_fill)); 6221 delete_glue_ref(glue_ptr(last_line_fill)); 6222 width(q):=width(q)+active_short(best_bet)-active_glue(best_bet); 6223 stretch(q):=0; glue_ptr(last_line_fill):=q; 6224 end 6225 6226@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive 6227the current |lc_code| values are stored together with the hyphenation 6228patterns for the current language. They will later be used instead of 6229the |lc_code| values for hyphenation purposes. 6230 6231The |lc_code| values are stored in the linked trie analogous to patterns 6232$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and 6233|lc_code(p_1)| replacing the |trie_op| code. This allows to compress 6234and pack them together with the patterns with minimal changes to the 6235existing code. 6236 6237@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|} 6238 6239@<Initialize table entries...@>= 6240hyph_root:=0; hyph_start:=0; 6241 6242@ @<Store hyphenation codes for current language@>= 6243begin c:=cur_lang; first_child:=false; p:=0; 6244repeat q:=p; p:=trie_r[q]; 6245until (p=0)or(c<=so(trie_c[p])); 6246if (p=0)or(c<so(trie_c[p])) then 6247 @<Insert a new trie node between |q| and |p|, and 6248 make |p| point to it@>; 6249q:=p; {now node |q| represents |cur_lang|} 6250@<Store all current |lc_code| values@>; 6251end 6252 6253@ We store all nonzero |lc_code| values, overwriting any previously 6254stored values (and possibly wasting a few trie nodes that were used 6255previously and are not needed now). We always store at least one 6256|lc_code| value such that |hyph_index| (defined below) will not be zero. 6257 6258@<Store all current |lc_code| values@>= 6259p:=trie_l[q]; first_child:=true; 6260for c:=0 to 255 do 6261 if (lc_code(c)>0)or((c=255)and first_child) then 6262 begin if p=0 then 6263 @<Insert a new trie node between |q| and |p|, and 6264 make |p| point to it@> 6265 else trie_c[p]:=si(c); 6266 trie_o[p]:=qi(lc_code(c)); 6267 q:=p; p:=trie_r[q]; first_child:=false; 6268 end; 6269if first_child then trie_l[q]:=0@+else trie_r[q]:=0 6270 6271@ We must avoid to ``take'' location~1, in order to distinguish between 6272|lc_code| values and patterns. 6273 6274@<Pack all stored |hyph_codes|@>= 6275begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2; 6276first_fit(hyph_root); trie_pack(hyph_root); 6277hyph_start:=trie_ref[hyph_root]; 6278end 6279 6280@ The global variable |hyph_index| will point to the hyphenation codes 6281for the current language. 6282 6283@d set_hyph_index== {set |hyph_index| for current language} 6284 if trie_char(hyph_start+cur_lang)<>qi(cur_lang) 6285 then hyph_index:=0 {no hyphenation codes for |cur_lang|} 6286 else hyph_index:=trie_link(hyph_start+cur_lang) 6287@# 6288@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} 6289 if hyph_index=0 then hc[0]:=lc_code(#) 6290 else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0 6291 else hc[0]:=qo(trie_op(hyph_index+#)) 6292 6293@<Glob...@>= 6294@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|} 6295@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|} 6296 6297@ When |saving_vdiscards| is positive then the glue, kern, and penalty 6298nodes removed by the page builder or by \.{\\vsplit} from the top of a 6299vertical list are saved in special lists instead of being discarded. 6300 6301@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder} 6302@d page_disc==disc_ptr[last_box_code] {first item removed by page builder} 6303@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}} 6304 6305@<Glob...@>= 6306@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers} 6307 6308@ @<Set init...@>= 6309page_disc:=null; split_disc:=null; 6310 6311@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the 6312command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are 6313distinguished by their |chr_code| values |last_box_code| and 6314|vsplit_code|. These |chr_code| values are larger than |box_code| and 6315|copy_code|. 6316 6317@<Generate all \eTeX...@>= 6318primitive("pagediscards",un_vbox,last_box_code);@/ 6319@!@:page_discards_}{\.{\\pagediscards} primitive@> 6320primitive("splitdiscards",un_vbox,vsplit_code);@/ 6321@!@:split_discards_}{\.{\\splitdiscards} primitive@> 6322 6323@ @<Cases of |un_vbox| for |print_cmd_chr|@>= 6324else if chr_code=last_box_code then print_esc("pagediscards") 6325else if chr_code=vsplit_code then print_esc("splitdiscards") 6326 6327@ @<Handle saved items and |goto done|@>= 6328begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null; 6329goto done; 6330end 6331 6332@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties}, 6333and \.{\\displaywidowpenalties} commands allow to define arrays of 6334penalty values to be used instead of the corresponding single values. 6335 6336@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc) 6337@d club_penalties_ptr==equiv(club_penalties_loc) 6338@d widow_penalties_ptr==equiv(widow_penalties_loc) 6339@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc) 6340 6341@<Generate all \eTeX...@>= 6342primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/ 6343@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@> 6344primitive("clubpenalties",set_shape,club_penalties_loc);@/ 6345@!@:club_penalties_}{\.{\\clubpenalties} primitive@> 6346primitive("widowpenalties",set_shape,widow_penalties_loc);@/ 6347@!@:widow_penalties_}{\.{\\widowpenalties} primitive@> 6348primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/ 6349@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@> 6350 6351@ @<Cases of |set_shape| for |print_cmd_chr|@>= 6352inter_line_penalties_loc: print_esc("interlinepenalties"); 6353club_penalties_loc: print_esc("clubpenalties"); 6354widow_penalties_loc: print_esc("widowpenalties"); 6355display_widow_penalties_loc: print_esc("displaywidowpenalties"); 6356 6357@ @<Fetch a penalties array element@>= 6358begin scan_int; 6359if (equiv(m)=null)or(cur_val<0) then cur_val:=0 6360else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m)); 6361 cur_val:=penalty(equiv(m)+cur_val); 6362 end; 6363end 6364 6365@* \[54] System-dependent changes. 6366@z 6367%--------------------------------------- 6368