1% vim: ft=change 2% TODO: sparse arrays 3% This is the first of the set of 4% WEB change file containing code for various features extending Omega; 5% these files define the Aleph program, and are designed to be applied 6% to omega.web compiled without XML support. 7% This change-file is heavily based on etex.ch, 8% defining version 2.1 of e-TeX. 9 10% ATTENTION: The software is currently in pre-alpha stage. 11 12% The TeX program is copyright (C) 1982 by D. E. Knuth. 13% TeX is a trademark of the American Mathematical Society. 14% e-TeX and NTS are trademarks of the NTS group. 15 16% All line numbers refer to TEX.WEB 3.14159 as of March 21, 1995. 17% TODO: double line number reference, having them for both TEX.WEB 18% and (X)OMEGA.WEB 19 20@x limbo l.1 - this is Aleph 21% (C) 1994--2000 by John Plaice and Yannis Haralambous. 22@y 23% (C) 2002--2004 by Giuseppe Bilotta and the Aleph task force; 24% all rights are reserved. 25% 26% Aleph is directly derived from e-TeX, an extension of 27% Donald E. Knuth's TeX developed by Peter Breitenlohner and 28% the NTS team, and Omega, another extension of TeX, developed by 29% John Plaice and Yannis Haralambous. 30 31% Aleph is designed in the form of a set of WEB changefiles 32% to be applied to Omega 33% compiled without XML support. The changefiles are heavily based 34% on the e-TeX 2.1 changefiles. 35 36% Omega is copyright (C) 1994--2000 by John Plaice and Yannis Haralambous. 37@z 38%--------------------------------------- 39@x limbo l.1 - this is e-TeX 40% 41% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved. 42% Copying of this file is authorized only if (1) you are D. E. Knuth, or if 43% (2) you make absolutely no changes to your copy. (The WEB system provides 44% for alterations via an auxiliary file; the master file should stay intact.) 45% See Appendix H of the WEB manual for hints on how to install this program. 46% And see Appendix A of the TRIP manual for details about how to validate it. 47 48% TeX is a trademark of the American Mathematical Society. 49% METAFONT is a trademark of Addison-Wesley Publishing Company. 50@y 51% e-TeX is copyright (C) 1999-2012 by P. Breitenlohner (1994,98 by the NTS 52% team); all rights are reserved. 53 54% e-TeX and NTS are trademarks of the NTS group. 55% TeX is a trademark of the American Mathematical Society. 56% METAFONT is a trademark of Addison-Wesley Publishing Company. 57 58% e-TeX is directly derived from Donald E. Knuth's TeX; 59% the change history which follows and the reward offered for finders of 60% bugs refer specifically to TeX; they should not be taken as referring 61% to e-TeX, although the change history is relevant in that it 62% demonstrates the evolutionary path followed. This program is not TeX; 63% that name is reserved strictly for the program which is the creation 64% and sole responsibility of Professor Knuth. 65@z 66%--------------------------------------- 67@x limbo l.50 - e-TeX history 68% Although considerable effort has been expended to make the TeX program 69% correct and reliable, no warranty is implied; the author disclaims any 70% obligation or liability for damages, including but not limited to 71% special, indirect, or consequential damages arising out of or in 72% connection with the use or performance of this software. This work has 73% been a ``labor of love'' and the author hopes that users enjoy it. 74@y 75% A preliminary version of TeX--XeT was released in April 1992. 76% TeX--XeT version 1.0 was released in June 1992, 77% version 1.1 prevented arith overflow in glue computation (Oct 1992). 78% A preliminary e-TeX version 0.95 was operational in March 1994. 79% Version 1.0beta was released in May 1995. 80% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995). 81% Version 1.02beta allowed 256 mark classes (March 1996). 82% Version 1.1 changed \group{type,level} -> \currentgroup{type,level}, 83% first public release (October 1996). 84% Version 2.0 development was started in March 1997; 85% fixed a ligature-\beginR bug in January 1998; 86% was released in March 1998. 87% Version 2.1 fixed a marks bug (when min_halfword<>0) (January 1999). 88 89% Aleph includes all the e-TeX extensions, except for TeX--XeT and 90% some optimizations. 91 92% Release Candidate 0 was released in Janurary 2003. 93% Release Candidate 1 was released in June 2003. 94% fixed Omega overfull box bug 95% Release Candidate 2 has to be released 96% fixed Omega overfull rule bug 97% fixed Omega leader tripping bug 98% reorganized source code 99 100% Although considerable effort has been expended to make the Aleph program 101% correct and reliable, no warranty is implied; the authors disclaim any 102% obligation or liability for damages, including but not limited to 103% special, indirect, or consequential damages arising out of or in 104% connection with the use or performance of this software. This work has 105% been a ``labor of love'' and the authors hope that users enjoy it. 106@z 107%--------------------------------------- 108@x limbo l.61 - e-TeX logo, TeXXeT 109\let\mc=\ninerm % medium caps for names like SAIL 110@y 111\let\mc=\ninerm % medium caps for names like SAIL 112\def\eTeX{$\varepsilon$-\TeX} 113\def\Aleph{$\aleph$} 114% \font\revrm=xbmc10 % for right-to-left text 115% % to generate xbmc10 (i.e., reflected cmbx10) use a file 116% % xbmc10.mf containing: 117% %+++++++++++++++++++++++++++++++++++++++++++++++++ 118% % if unknown cmbase: input cmbase fi 119% % extra_endchar := extra_endchar & 120% % "currentpicture:=currentpicture " & 121% % "reflectedabout((.5[l,r],0),(.5[l,r],1));"; 122% % input cmbx10 123% %+++++++++++++++++++++++++++++++++++++++++++++++++ 124% \ifx\beginL\undefined % this is TeX 125 \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT} 126 \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT 127 \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT 128% \else 129% \ifx\eTeXversion\undefined % this is \TeXeT 130% \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT 131% \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT 132% \else % this is \eTeX 133% \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT 134% \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT 135% \fi 136% \fi 137@z 138%--------------------------------------- 139@x limbo l.64 - bug fix (print only changed modules) 140\def\pct!{{\char`\%}} % percent sign in ordinary text 141@y 142\def\pct!{{\char`\%}} % percent sign in ordinary text 143\def\grp{\.{\char'173...\char'175}} 144@z 145%--------------------------------------- 146@x limbo l.80 - e-TeX basic 147\def\title{$\Omega$ (OMEGA)} 148@y 149\def\title{\Aleph\ (ALEPH)} 150% system dependent redefinitions of \title should come later 151% and should use: 152% \toks0=\expandafter{\title} 153% \edef\title{...\the\toks0...} 154\let\maybe=\iffalse % print only changed modules 155\let\maybe=\iftrue % print everything 156@z 157%--------------------------------------- 158@x [1] m.1 l.91 - this is e-TeX 159This is $\Omega$, a document compiler intended to simplify high-quality 160@y 161This is \Aleph, an extension of $\Omega$. $\Omega$ is a document compiler 162intended to simplify high-quality 163@z 164%--------------------------------------- 165@x [1] m.2 l.179 - e-TeX basic 166If this program is changed, the resulting system should not be called 167@y 168This program contains code from both the $\Omega$ (developed by 169John Plaice and Yannis Haralambous) and \eTeX\ 170(developed by Peter Breitenlohner and the NTS team) extensions 171to \TeX, therefore this program is called `\Aleph' and not 172@z 173%--------------------------------------- 174@x [1] m.2 l.185 - e-TeX basic 175November 1984]. 176@y 177November 1984]. 178 179A similar test suite called the ``\.{e-BUMP} test'' is (or will be made) 180available for helping to determine whether a particular implementation deserves 181to be known as `\Aleph'. 182@z 183%--------------------------------------- 184@x [1] m.2 l.187 - e-TeX basic 185@d banner=='This is Omega, Version 3.14159265--1.15' {printed when \TeX\ starts} 186@y 187@d banner=='This is Aleph, Version 3.14159265--1.15--2.1' {printed when \TeX\ starts} 188@# 189@d eTeX_version_string=='3.14159265--1.15--2.1' {current \eTeX\ version} 190@d eTeX_version=2 { \.{\\eTeXversion} } 191@d eTeX_revision==".1" { \.{\\eTeXrevision} } 192@# 193@d eTeX_banner=='This is Aleph, Version ',eTeX_version_string 194 {printed when \eTeX\ starts} 195@# 196@d OMEGA==ALEPH {change program name into |ALEPH|} 197@# 198@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|} 199@z 200%--------------------------------------- 201@x [1] m.15 l.493 - e-TeX basic 202@d not_found=45 {go here when you've found nothing} 203@y 204@d not_found=45 {go here when you've found nothing} 205@d not_found1=46 {like |not_found|, when there's more than one} 206@d not_found2=47 {like |not_found|, when there's more than two} 207@d not_found3=48 {like |not_found|, when there's more than three} 208@d not_found4=49 {like |not_found|, when there's more than four} 209@z 210%--------------------------------------- 211@x [5] m.61 l.1556 - e-TeX basic 212wterm(banner); 213@y 214wterm(eTeX_banner); 215@z 216%--------------------------------------- 217@x [10] m.141 l.2965 - e-TeX marks 218This field occupies a full word instead of a halfword, because 219there's nothing to put in the other halfword; it is easier in \PASCAL\ to 220use the full word than to risk leaving garbage in the unused half. 221@y 222In addition there is a |mark_class| field that contains the mark class. 223@z 224%--------------------------------------- 225@x [10] m.141 l.2971 - e-TeX marks 226@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark} 227@y 228@d mark_ptr(#)==link(#+1) {head of the token list for a mark} 229@d mark_class(#)==info(#+1) {the mark class} 230@z 231%--------------------------------------- 232@x [10] m.142 l.2980 - e-TeX marks 233@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list} 234@y 235@d adjust_ptr(#)==mem[#+1].int 236 {vertical list to be moved out of horizontal list} 237@z 238%--------------------------------------- 239@x [12] m.196 l.3844 - e-TeX marks 240begin print_esc("mark"); print_mark(mark_ptr(p)); 241@y 242begin print_esc("mark"); 243if mark_class(p)<>0 then 244 begin print_char("s"); print_int(mark_class(p)); 245 end; 246print_mark(mark_ptr(p)); 247@z 248%--------------------------------------- 249@x [15] m.208 l.4081 - e-TeX saved_items 250@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} 251@y 252@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} 253 {( or \.{\\pagediscards}, \.{\\splitdiscards} )} 254@z 255%--------------------------------------- 256@x [15] m.208 l.4107 - e-TeX middle 257@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} 258@y 259@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} 260 {( or \.{\\middle} )} 261@z 262%--------------------------------------- 263@x [15] m.209 l.4151 - e-TeX basic 264 \.{\\insertpenalties} )} 265@y 266 \.{\\insertpenalties} )} 267 {( or \.{\\interactionmode} )} 268@z 269%--------------------------------------- 270@x [15] m.209 l.4153 - e-TeX penalties 271@d set_shape=set_box_dimen+1 272 {specify fancy paragraph shape ( \.{\\parshape} )} 273@y 274@d set_shape=set_box_dimen+1 275 {specify fancy paragraph shape ( \.{\\parshape} )} 276 {(or \.{\\interlinepenalties}, etc.~)} 277@z 278%--------------------------------------- 279@x [15] m.209 l.4163 - e-TeX protected 280@d prefix=divide+1 281 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} 282@y 283@d prefix=divide+1 284 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} 285 {( or \.{\\protected} )} 286@z 287%--------------------------------------- 288@x [15] m.209 l.4166 - e-TeX read_line 289@d read_to_cs=shorthand_def+1 290 {read into a control sequence ( \.{\\read} )} 291@y 292@d read_to_cs=shorthand_def+1 293 {read into a control sequence ( \.{\\read} )} 294 {( or \.{\\readline} )} 295@z 296%--------------------------------------- 297@x [15] m.210 l.4181 - e-TeX scan_tokens 298@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )} 299@y 300@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )} 301 {( or \.{\\scantokens} )} 302@z 303%--------------------------------------- 304@x [15] m.210 l.4186 - e-TeX unexpanded 305@d the=max_command+9 {expand an internal quantity ( \.{\\the} )} 306@y 307@d the=max_command+9 {expand an internal quantity ( \.{\\the} )} 308 {( or \.{\\unexpanded}, \.{\\detokenize} )} 309@z 310%--------------------------------------- 311@x [16] m.212 l.4289 - e-TeX basic 312user's output routine. 313@y 314user's output routine. 315 316A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX. 317In vertical modes it is known as |LR_save| and holds the LR stack when a 318paragraph is interrupted by a displayed formula. In display math mode 319it is known as |LR_box| and holds a pointer to a prototype box for the 320display. In math mode it is known as |delim_ptr| and points to the most 321recent |left_noad| or |middle_noad| of a |math_left_group|. 322 323In \Aleph it is only used in this last sense. 324@z 325%--------------------------------------- 326@x [16] m.212 l.4304 - e-TeX basic 327 @!head_field,@!tail_field: pointer; 328@y 329 @!head_field,@!tail_field: pointer; 330 @!eTeX_aux_field: pointer; 331@z 332%--------------------------------------- 333@x [16] m.213 l.4311 - e-TeX basic 334@d tail==cur_list.tail_field {final node on current list} 335@y 336@d tail==cur_list.tail_field {final node on current list} 337@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX} 338@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group} 339@z 340%--------------------------------------- 341@x [16] m.215 l.4342 - e-TeX basic 342mode:=vmode; head:=contrib_head; tail:=contrib_head; 343@y 344mode:=vmode; head:=contrib_head; tail:=contrib_head; 345eTeX_aux:=null; 346@z 347%--------------------------------------- 348@x [16] m.216 l.4358 push_nest - e-TeX basic 349incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; 350@y 351incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; 352eTeX_aux:=null; 353@z 354%--------------------------------------- 355@x [17] m.230 l.4712 - e-TeX basic, penalties 356@d output_routine_loc=local_base+1 {points to token list for \.{\\output}} 357@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}} 358@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}} 359@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}} 360@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}} 361@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}} 362@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}} 363@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}} 364@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}} 365@d ocp_trace_level_base=local_base+10 366@y 367@d inter_line_penalties_loc=local_base+1 {additional penalties between lines} 368@d club_penalties_loc=local_base+2 {penalties for creating club lines} 369@d widow_penalties_loc=local_base+3 {penalties for creating widow lines} 370@d display_widow_penalties_loc=local_base+4 {ditto, just before a display} 371@d token_base=local_base+5 {table of token list parameters} 372@d output_routine_loc=token_base {points to token list for \.{\\output}} 373@d every_par_loc=token_base+1 {points to token list for \.{\\everypar}} 374@d every_math_loc=token_base+2 {points to token list for \.{\\everymath}} 375@d every_display_loc=token_base+3 {points to token list for \.{\\everydisplay}} 376@d every_hbox_loc=token_base+4 {points to token list for \.{\\everyhbox}} 377@d every_vbox_loc=token_base+5 {points to token list for \.{\\everyvbox}} 378@d every_job_loc=token_base+6 {points to token list for \.{\\everyjob}} 379@d every_cr_loc=token_base+7 {points to token list for \.{\\everycr}} 380@d every_eof_loc=token_base+8 {points to token list for \.{\\everyeof}} 381@d err_help_loc=token_base+9 {points to token list for \.{\\errhelp}} 382@d ocp_trace_level_base=token_base+10 383@z 384%--------------------------------------- 385@x [17] m.231 l.4787 - e-TeX basic 386 othercases print_esc("errhelp") 387@y 388 @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/ 389 othercases print_esc("errhelp") 390@z 391%--------------------------------------- 392@x [17] m.233 l.4833 - e-TeX penalties 393if n=par_shape_loc then 394 begin print_esc("parshape"); print_char("="); 395 if par_shape_ptr=null then print_char("0") 396 else print_int(info(par_shape_ptr)); 397@y 398if n<token_base then 399 begin print_cmd_chr(set_shape,n); print_char("="); 400 if equiv(n)=null then print_char("0") 401 else if n>par_shape_loc then 402 begin print_int(penalty(equiv(n))); print_char(" "); 403 print_int(penalty(equiv(n)+1)); 404 if penalty(equiv(n))>1 then print_esc("ETC."); 405 end 406 else print_int(info(par_shape_ptr)); 407@z 408%--------------------------------------- 409% FIXME: in this section and in the next 410% we should remove pre_display_direction[_code] 411% stuff, both here and down below 412@x [17] m.236 l.4955 - e-TeX basic 413@d dir_base=int_base+int_pars 414@y 415@d tracing_assigns_code=int_pars {show assignments} 416@d tracing_groups_code=int_pars+1 {show save/restore groups} 417@d tracing_ifs_code=int_pars+2 {show conditionals} 418@d tracing_scan_tokens_code=int_pars+3 {show pseudo file open and close} 419@d tracing_nesting_code=int_pars+4 420 {show incomplete groups and ifs within files} 421@d pre_display_direction_code=int_pars+5 {text direction preceding a display} 422@d last_line_fit_code=int_pars+6 {adjustment for last line of paragraph} 423@d saving_vdiscards_code=int_pars+7 {save items discarded from vlists} 424@d saving_hyph_codes_code=int_pars+8 {save hyphenation codes for languages} 425@d eTeX_state_code=int_pars+9 {\eTeX\ state variables} 426@d dir_base=int_base+eTeX_state_code+eTeX_states 427@z 428%--------------------------------------- 429@x [17] m.236 l.5016 - e-TeX basic 430@d error_context_lines==int_par(error_context_lines_code) 431@y 432@d error_context_lines==int_par(error_context_lines_code) 433@d tracing_assigns==int_par(tracing_assigns_code) 434@d tracing_groups==int_par(tracing_groups_code) 435@d tracing_ifs==int_par(tracing_ifs_code) 436@d tracing_scan_tokens==int_par(tracing_scan_tokens_code) 437@d tracing_nesting==int_par(tracing_nesting_code) 438@d pre_display_direction==int_par(pre_display_direction_code) 439@d last_line_fit==int_par(last_line_fit_code) 440@d saving_vdiscards==int_par(saving_vdiscards_code) 441@d saving_hyph_codes==int_par(saving_hyph_codes_code) 442@z 443%--------------------------------------- 444@x [17] m.237 l.5081 print_param - e-TeX basic 445othercases print("[unknown integer parameter!]") 446@y 447@/@<Cases for |print_param|@>@/ 448othercases print("[unknown integer parameter!]") 449@z 450%--------------------------------------- 451% FIXED(?): moved to init_eqtb_entry in 452% omega.web at l.5813 453@x [17] m.232 l.4805 - e-TeX penalties 454 { Region 4 } 455 else if (p>=par_shape_loc) and 456 (p<=toks_base+biggest_reg) then begin 457 equiv_field(mw):=null; 458 eq_type_field(mw):=undefined_cs; 459 eq_level_field(mw):=level_zero; 460 end 461@y 462 { Region 4 } 463 else if (p>=par_shape_loc) and 464 (p< token_base) then begin 465 equiv_field(mw):=null; 466 eq_type_field(mw):=shape_ref; 467 eq_level_field(mw):=level_one; 468 end 469 else if (p>=token_base) and 470 (p<=toks_base+biggest_reg) then begin 471 equiv_field(mw):=null; 472 eq_type_field(mw):=undefined_cs; 473 eq_level_field(mw):=level_zero; 474 end 475@z 476%--------------------------------------- 477@x [18] m.264 l.5612 primitive - e-TeX basic 478@!j:small_number; {index into |buffer|} 479@y 480@!j:0..buf_size; {index into |buffer|} 481@z 482%--------------------------------------- 483@x [18] m.264 l.5616 primitive - e-TeX basic 484 {we will move |s| into the (empty) |buffer|} 485 for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); 486 cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|} 487@y 488 {we will move |s| into the (possibly non-empty) |buffer|} 489 if first+l>buf_size+1 then 490 overflow("buffer size",buf_size); 491@:TeX capacity exceeded buffer size}{\quad buffer size@> 492 for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); 493 cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} 494@z 495%--------------------------------------- 496@x [18] m.265 l.5691 - e-TeX penalties 497primitive("parshape",set_shape,0);@/ 498@y 499primitive("parshape",set_shape,par_shape_loc);@/ 500@z 501%--------------------------------------- 502@x [18] m.265 l.5708 - e-TeX sparse arrays 503primitive("toks",toks_register,0);@/ 504@y 505primitive("toks",toks_register,mem_bot);@/ 506@z 507%--------------------------------------- 508@x [18] m.266 l.5741 - e-TeX cond 509expand_after: print_esc("expandafter"); 510@y 511expand_after: if chr_code=0 then print_esc("expandafter") 512 @<Cases of |expandafter| for |print_cmd_chr|@>; 513@z 514%--------------------------------------- 515@x [18] m.266 l.5747 - e-TeX marks 516mark: print_esc("mark"); 517@y 518mark: begin print_esc("mark"); 519 if chr_code>0 then print_char("s"); 520 end; 521@z 522%--------------------------------------- 523@x [18] m.266 l.5758 - e-TeX read_line 524read_to_cs: print_esc("read"); 525@y 526read_to_cs: if chr_code=0 then print_esc("read") 527 @<Cases of |read| for |print_cmd_chr|@>; 528@z 529%--------------------------------------- 530@x [18] m.266 l.5762 - e-TeX penalties 531set_shape: print_esc("parshape"); 532@y 533set_shape: case chr_code of 534 par_shape_loc: print_esc("parshape"); 535 @<Cases of |set_shape| for |print_cmd_chr|@>@;@/ 536 end; {there are no other cases} 537@z 538%--------------------------------------- 539@x [18] m.266 l.5763 - e-TeX unexpanded 540the: print_esc("the"); 541@y 542the: if chr_code=0 then print_esc("the") 543 @<Cases of |the| for |print_cmd_chr|@>; 544@z 545%--------------------------------------- 546@x [18] m.266 l.5764 - e-TeX sparse arrays 547toks_register: print_esc("toks"); 548@y 549toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>; 550@z 551%--------------------------------------- 552@x [19] m.268 l.5800 - e-TeX sparse arrays 553interpreted in one of four ways: 554@y 555interpreted in one of five ways: 556@z 557%--------------------------------------- 558@x [19] m.268 l.5820 - e-TeX tracing 559the entries for that group. 560@y 561the entries for that group. 562Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the 563source line number at which the current level of grouping was entered. 564 565\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a 566chain of sparse array entries to be restored at the end of the current 567group. Furthermore |save_index(p)| and |save_level(p)| should replace 568the values of |sa_chain| and |sa_level| respectively. 569@z 570%--------------------------------------- 571% FIXME restore_sa safe? (sparse arrays) 572@x [19] m.268 l.5830 - e-TeX basic 573@d level_boundary=3 {|save_type| corresponding to beginning of group} 574@y 575@d level_boundary=3 {|save_type| corresponding to beginning of group} 576@d restore_sa=4 {|save_type| when sparse array entries should be restored} 577 578@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@> 579@z 580%--------------------------------------- 581@x [19] m.273 l.5888 - e-TeX tracing 582@ The following macro is used to test if there is room for up to six more 583@y 584@ The following macro is used to test if there is room for up to seven more 585@z 586%--------------------------------------- 587@x [19] m.273 l.5894 check_full_save_stack - e-TeX tracing 588 if max_save_stack>save_size-6 then overflow("save size",save_size); 589@y 590 if max_save_stack>save_size-7 then overflow("save size",save_size); 591@z 592%--------------------------------------- 593@x [19] m.274 l.5916 new_save_level - e-TeX tracing 594begin check_full_save_stack; 595@y 596begin check_full_save_stack; 597if eTeX_ex then 598 begin saved(0):=line; incr(save_ptr); 599 end; 600@z 601%--------------------------------------- 602@x [19] m.274 l.5923 new_save_level - e-TeX tracing 603cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c; 604@y 605cur_boundary:=save_ptr; cur_group:=c; 606@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/ 607incr(cur_level); incr(save_ptr); 608@z 609%--------------------------------------- 610@x [19] m.275 l.5941 eq_destroy - e-TeX sparse arrays 611othercases do_nothing 612@y 613@/@<Cases for |eq_destroy|@>@/ 614othercases do_nothing 615@z 616%--------------------------------------- 617@x [19] m.277 l.5963 - e-TeX tracing 618the call, since |eq_save| makes the necessary test. 619@y 620the call, since |eq_save| makes the necessary test. 621 622@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#); 623 tats 624@z 625%--------------------------------------- 626@x [19] m.277 l.5967 eq_define - e-TeX tracing 627begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p)) 628@y 629label exit; 630begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then 631 begin assign_trace(p,"reassigning")@;@/ 632 eq_destroy(new_eqtb(p)); return; 633 end; 634assign_trace(p,"changing")@;@/ 635if eq_level(p)=cur_level then eq_destroy(new_eqtb(p)) 636@z 637%--------------------------------------- 638@x [19] m.277 l.5970 eq_define - e-TeX tracing 639end; 640@y 641assign_trace(p,"into")@;@/ 642exit:end; 643@z 644%--------------------------------------- 645@x [19] m.278 l.5977 eq_word_define - e-TeX tracing 646begin if xeq_level(p)<>cur_level then 647@y 648label exit; 649begin if eTeX_ex and(eqtb[p].int=w) then 650 begin assign_trace(p,"reassigning")@;@/ 651 return; 652 end; 653assign_trace(p,"changing")@;@/ 654if xeq_level(p)<>cur_level then 655@z 656%--------------------------------------- 657@x [19] m.278 l.5981 eq_word_define - e-TeX tracing 658end; 659@y 660assign_trace(p,"into")@;@/ 661exit:end; 662@z 663%--------------------------------------- 664@x [19] m.279 l.5990 geq_define - e-TeX tracing 665begin eq_destroy(new_eqtb(p)); 666set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e); 667@y 668begin assign_trace(p,"globally changing")@;@/ 669begin eq_destroy(new_eqtb(p)); 670set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e); 671end; 672assign_trace(p,"into")@;@/ 673@z 674%--------------------------------------- 675@x [19] m.279 l.5995 geq_word_define - e-TeX tracing 676begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one); 677@y 678begin assign_trace(p,"globally changing")@;@/ 679begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one); 680end; 681assign_trace(p,"into")@;@/ 682@z 683%--------------------------------------- 684@x [19] m.281 l.6012 - e-TeX tracing 685@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/ 686@y 687@p 688@z 689%--------------------------------------- 690@x [19] m.281 l.6019 unsave - e-TeX optimized \aftergroup 691begin if cur_level>level_one then 692@y 693@!a:boolean; {have we already processed an \.{\\aftergroup} ?} 694begin a:=false; 695if cur_level>level_one then 696@z 697%--------------------------------------- 698% FIXME restore_sa usage 699@x [19] m.282 l.6033 - e-TeX sparse arrays 700 else begin if save_type(save_ptr)=restore_old_value then 701@y 702 else if save_type(save_ptr)=restore_sa then 703 begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr); 704 end 705 else begin if save_type(save_ptr)=restore_old_value then 706@z 707%--------------------------------------- 708@x [19] m.282 l.6041 - e-TeX tracing 709done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr) 710@y 711done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/ 712if grp_stack[in_open]=cur_boundary then group_warning; 713 {groups possibly not properly nested with files} 714cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr); 715if eTeX_ex then decr(save_ptr) 716@z 717%--------------------------------------- 718@x [19] m.284 l.6067 - e-TeX tracing 719@ @<Declare the procedure called |restore_trace|@>= 720@y 721@ @<Declare \eTeX\ procedures for tr...@>= 722@z 723%--------------------------------------- 724@x [20] m.289 l.6155 - e-TeX protected 725@d end_match_token=@"E0000 {$2^16\cdot|end_match|$} 726@y 727@d end_match_token=@"E0000 {$2^16\cdot|end_match|$} 728@d protected_token=@"E0001 {$2^16\cdot|end_match|+1$} 729@z 730%--------------------------------------- 731@x [20] m.294 l.6280 - e-TeX protected 732end_match: print("->"); 733@y 734end_match: if c=0 then print("->"); 735@z 736%--------------------------------------- 737@x [20] m.296 l.6301 print_meaning - e-TeX marks 738else if cur_cmd=top_bot_mark then 739@y 740else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then 741@z 742%--------------------------------------- 743@x [21] m.298 l.6375 print_cmd_chr - e-TeX protected 744procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); 745@y 746procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); 747var n:integer; {temp variable} 748@z 749%--------------------------------------- 750@x [21] m.299 l.6394 show_cur_cmd_chr - e-TeX tracing 751@p procedure show_cur_cmd_chr; 752@y 753@p procedure show_cur_cmd_chr; 754var n:integer; {level of \.{\\if...\\fi} nesting} 755@!l:integer; {line where \.{\\if} started} 756@!p:pointer; 757@z 758%--------------------------------------- 759@x [21] m.299 l.6399 show_cur_cmd_chr - e-TeX tracing 760print_cmd_chr(cur_cmd,cur_chr); print_char("}"); 761@y 762print_cmd_chr(cur_cmd,cur_chr); 763if tracing_ifs>0 then 764 if cur_cmd>=if_test then if cur_cmd<=fi_or_else then 765 begin print(": "); 766 if cur_cmd=fi_or_else then 767 begin print_cmd_chr(if_test,cur_if); print_char(" "); 768 n:=0; l:=if_line; 769 end 770 else begin n:=1; l:=line; 771 end; 772 p:=cond_ptr; 773 while p<>null do 774 begin incr(n); p:=link(p); 775 end; 776 print("(level "); print_int(n); print_char(")"); print_if_line(l); 777 end; 778print_char("}"); 779@z 780%--------------------------------------- 781% FIXME: What about \write18 compatibility? 782@x [22] m.303 l.6475 show_context - e-TeX scan_tokens 783the terminal, under control of the procedure |read_toks|.) 784@y 785the terminal, under control of the procedure |read_toks|.) 786Finally |18<=name<=19| indicates that we are reading a pseudo file 787created by the \.{\\scantokens} command. 788@z 789%--------------------------------------- 790@x [22] m.307 l.6692 - e-TeX basic 791@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.} 792@d write_text=15 {|token_type| code for \.{\\write}} 793@y 794@d every_eof_text=14 {|token_type| code for \.{\\everyeof}} 795@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.} 796@d write_text=16 {|token_type| code for \.{\\write}} 797@z 798%--------------------------------------- 799@x [22] m.311 l.6749 show_context - e-TeX scan_tokens 800 if (name>17) or (base_ptr=0) then bottom_line:=true; 801@y 802 if (name>19) or (base_ptr=0) then bottom_line:=true; 803@z 804%--------------------------------------- 805@x [22] m.313 l.6794 - e-TeX scan_tokens 806else begin print_nl("l."); print_int(line); 807@y 808else begin print_nl("l."); 809 if index=in_open then print_int(line) 810 else print_int(line_stack[index+1]); {input from a pseudo file} 811@z 812%--------------------------------------- 813@x [22] m.314 l.6814 - e-TeX basic 814every_cr_text: print_nl("<everycr> "); 815@y 816every_cr_text: print_nl("<everycr> "); 817every_eof_text: print_nl("<everyeof> "); 818@z 819%--------------------------------------- 820@x [23] m.326 l.7009 - e-TeX optimized \aftergroup 821begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t; 822@y 823begin t:=cur_tok; cur_tok:=p; 824if a then 825 begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p; 826 if cur_tok<right_brace_limit then 827 if cur_tok<left_brace_limit then decr(align_state) 828 else incr(align_state); 829 end 830else begin back_input; a:=eTeX_ex; 831 end; 832cur_tok:=t; 833@z 834%--------------------------------------- 835@x [23] m.328 l.7037 begin_file_reading - e-TeX every_eof, tracing_nesting 836incr(in_open); push_input; index:=in_open; 837@y 838incr(in_open); push_input; index:=in_open; 839eof_seen[index]:=false; 840grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr; 841@z 842%--------------------------------------- 843% FIXME: What about \write18 compatibility? 844@x [23] m.329 l.7047 end_file_reading - e-TeX scan_tokens 845if name>17 then a_close(cur_file); {forget it} 846@y 847if (name=18)or(name=19) then pseudo_close else 848if name>17 then a_close(cur_file); {forget it} 849@z 850%--------------------------------------- 851@x [23] m.331 l.7066 - e-TeX tracing_nesting 852in_open:=0; open_parens:=0; max_buf_stack:=0; 853@y 854in_open:=0; open_parens:=0; max_buf_stack:=0; 855grp_stack[0]:=0; if_stack[0]:=null; 856@z 857%--------------------------------------- 858@x [24] m.362 l.7538 - e-TeX scan_tokens, every_eof 859if not force_eof then 860@y 861if not force_eof then 862 if name<=19 then 863 begin if pseudo_input then {not end of file} 864 firm_up_the_line {this sets |limit|} 865 else if (every_eof<>null)and not eof_seen[index] then 866 begin limit:=first-1; eof_seen[index]:=true; {fake one empty line} 867 begin_token_list(every_eof,every_eof_text); goto restart; 868 end 869 else force_eof:=true; 870 end 871 else 872@z 873%--------------------------------------- 874@x [24] m.362 l.7541 - e-TeX every_eof 875 else force_eof:=true; 876@y 877 else if (every_eof<>null)and not eof_seen[index] then 878 begin limit:=first-1; eof_seen[index]:=true; {fake one empty line} 879 begin_token_list(every_eof,every_eof_text); goto restart; 880 end 881 else force_eof:=true; 882@z 883%--------------------------------------- 884@x [24] m.362 l.7544 - e-TeX scan_tokens 885 begin print_char(")"); decr(open_parens); 886 update_terminal; {show user that file has been read} 887@y 888 begin if tracing_nesting>0 then 889 if (grp_stack[in_open]<>cur_boundary)or@| 890 (if_stack[in_open]<>cond_ptr) then file_warning; 891 {give warning for some unfinished groups and/or conditionals} 892 if name>=19 then 893 begin print_char(")"); decr(open_parens); 894 update_terminal; {show user that file has been read} 895 end; 896@z 897%--------------------------------------- 898@x [25] m.366 l.7630 - e-TeX basic 899@t\4@>@<Declare the procedure called |insert_relax|@>@;@/ 900@y 901@t\4@>@<Declare the procedure called |insert_relax|@>@;@/ 902@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/ 903@z 904%--------------------------------------- 905@x [25] m.366 l.7637 expand - e-TeX cond 906procedure expand; 907@y 908procedure expand; 909label reswitch; 910@z 911%--------------------------------------- 912@x [25] m.366 l.7648 expand - e-TeX cond 913if cur_cmd<call then @<Expand a nonmacro@> 914@y 915reswitch: 916if cur_cmd<call then @<Expand a nonmacro@> 917@z 918%--------------------------------------- 919@x [25] m.367 l.7659 - e-TeX cond 920expand_after:@<Expand the token after the next token@>; 921@y 922expand_after:if cur_chr=0 then @<Expand the token after the next token@> 923 else @<Negate a boolean conditional and |goto reswitch|@>; 924@z 925%--------------------------------------- 926@x [25] m.377 l.7779 - e-TeX scan_tokens 927input: if chr_code=0 then print_esc("input")@+else print_esc("endinput"); 928@y 929input: if chr_code=0 then print_esc("input") 930 @/@<Cases of |input| for |print_cmd_chr|@>@/ 931 else print_esc("endinput"); 932@z 933%--------------------------------------- 934@x [25] m.378 l.7782 - e-TeX scan_tokens 935if cur_chr>0 then force_eof:=true 936@y 937if cur_chr=1 then force_eof:=true 938@/@<Cases for |input|@>@/ 939@z 940%--------------------------------------- 941@x [25] m.382 l.7838 - e-TeX marks 942@d top_mark_code=0 {the mark in effect at the previous page break} 943@y 944@d marks_code==5 {add this for \.{\\topmarks} etc.} 945@# 946@d top_mark_code=0 {the mark in effect at the previous page break} 947@z 948%--------------------------------------- 949@x [25] m.385 l.7870 - e-TeX marks 950top_bot_mark: case chr_code of 951@y 952top_bot_mark: begin case (chr_code mod marks_code) of 953@z 954%--------------------------------------- 955@x [25] m.385 l.7876 - e-TeX marks 956 endcases; 957@y 958 endcases; 959 if chr_code>=marks_code then print_char("s"); 960 end; 961@z 962%--------------------------------------- 963@x [25] m.386 l.7882 - e-TeX marks 964begin if cur_mark[cur_chr]<>null then 965 begin_token_list(cur_mark[cur_chr],mark_text); 966@y 967begin t:=cur_chr mod marks_code; 968if cur_chr>=marks_code then scan_register_num@+else cur_val:=0; 969if cur_val=0 then cur_ptr:=cur_mark[t] 970else @<Compute the mark pointer for mark type |t| and class |cur_val|@>; 971if cur_ptr<>null then begin_token_list(cur_ptr,mark_text); 972@z 973%--------------------------------------- 974@x [25] m.389 l.7945 macro_call - e-TeX protected 975if info(r)<>end_match_token then 976@y 977if info(r)=protected_token then r:=link(r); 978if info(r)<>end_match_token then 979@z 980%--------------------------------------- 981@x [26] m.409 l.8255 - e-TeX basic 982@t\4\4@>@<Declare procedures that scan font-related stuff@> 983@y 984@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@; 985@t\4\4@>@<Declare procedures that scan font-related stuff@> 986@z 987%--------------------------------------- 988@x [26] m.411 l.8299 - e-TeX sparse arrays 989|glue_val|, or |mu_val|. 990@y 991|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes 992cannot have these values) 993@z 994%--------------------------------------- 995@x [26] m.411 l.8302 - e-TeX sparse arrays 996primitive("count",register,int_val); 997@!@:count_}{\.{\\count} primitive@> 998primitive("dimen",register,dimen_val); 999@!@:dimen_}{\.{\\dimen} primitive@> 1000primitive("skip",register,glue_val); 1001@!@:skip_}{\.{\\skip} primitive@> 1002primitive("muskip",register,mu_val); 1003@y 1004primitive("count",register,mem_bot+int_val); 1005@!@:count_}{\.{\\count} primitive@> 1006primitive("dimen",register,mem_bot+dimen_val); 1007@!@:dimen_}{\.{\\dimen} primitive@> 1008primitive("skip",register,mem_bot+glue_val); 1009@!@:skip_}{\.{\\skip} primitive@> 1010primitive("muskip",register,mem_bot+mu_val); 1011@z 1012%--------------------------------------- 1013@x [26] m.412 l.8312 - e-TeX sparse arrays 1014register: if chr_code=int_val then print_esc("count") 1015 else if chr_code=dimen_val then print_esc("dimen") 1016 else if chr_code=glue_val then print_esc("skip") 1017 else print_esc("muskip"); 1018@y 1019register: @<Cases of |register| for |print_cmd_chr|@>; 1020@z 1021%--------------------------------------- 1022@x [26] m.413 l.8328 scan_something_internal - e-TeX basic 1023var m:halfword; {|chr_code| part of the operand token} 1024@y 1025label exit; 1026var m:halfword; {|chr_code| part of the operand token} 1027@!q:halfword; {general purpose index} 1028@!i:four_quarters; {character info} 1029@z 1030%--------------------------------------- 1031@x [26] m.413 l.8354 scan_something_internal - e-TeX basic 1032end; 1033@y 1034exit:end; 1035@z 1036%--------------------------------------- 1037@x [26] m.415 l.8375 - e-TeX sparse arrays 1038 begin scan_eight_bit_int; m:=toks_base+cur_val; 1039 end; 1040 scanned_result(equiv(m))(tok_val); 1041@y 1042 if m=mem_bot then 1043 begin scan_register_num; 1044 if cur_val<256 then cur_val:=equiv(toks_base+cur_val) 1045 else begin find_sa_element(tok_val,cur_val,false); 1046 if cur_ptr=null then cur_val:=null 1047 else cur_val:=sa_ptr(cur_ptr); 1048 end; 1049 end 1050 else cur_val:=sa_ptr(m) 1051 else cur_val:=equiv(m); 1052 cur_val_level:=tok_val; 1053@z 1054%--------------------------------------- 1055@x [26] m.416 l.8390 - e-TeX basic 1056|glue_val|, |input_line_no_code|, or |badness_code|. 1057 1058@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} 1059@d badness_code=glue_val+2 {code for \.{\\badness}} 1060@y 1061|glue_val|, |last_node_type_code|, |input_line_no_code|, |badness_code|, 1062|eTeX_version_code|, or one of the other codes for \eTeX\ extensions. 1063 1064@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}} 1065@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}} 1066@d badness_code=glue_val+3 {code for \.{\\badness}} 1067@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers} 1068@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions} 1069@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue} 1070@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue} 1071@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions} 1072@z 1073%--------------------------------------- 1074@x [26] m.417 l.8425 - e-TeX interaction_mode 1075@+else print_esc("insertpenalties"); 1076@y 1077@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/ 1078@+else print_esc("insertpenalties"); 1079@z 1080%--------------------------------------- 1081@x [26] m.417 l.8434 - e-TeX basic 1082 othercases print_esc("badness") 1083@y 1084 @/@<Cases of |last_item| for |print_cmd_chr|@>@/ 1085 othercases print_esc("badness") 1086@z 1087%--------------------------------------- 1088@x [26] m.419 l.8457 - e-TeX interaction_mode 1089begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties; 1090@y 1091begin if m=0 then cur_val:=dead_cycles 1092@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/ 1093else cur_val:=insert_penalties; 1094@z 1095%--------------------------------------- 1096@x [26] m.420 l.8462 - e-TeX sparse arrays 1097begin 1098 scan_eight_bit_int; 1099 if box(cur_val)=null then cur_val:=0 @+else 1100 cur_val:=mem[box(cur_val)+m].sc; 1101@y 1102begin 1103 scan_register_num; 1104 fetch_box(q); 1105 if q=null then cur_val:=0 @+else 1106 cur_val:=mem[q+m].sc; 1107@z 1108%--------------------------------------- 1109@x [26] m.423 l.8487 - e-TeX penalties 1110begin if par_shape_ptr=null then cur_val:=0 1111@y 1112begin if m>par_shape_loc then @<Fetch a penalties array element@> 1113else if par_shape_ptr=null then cur_val:=0 1114@z 1115%--------------------------------------- 1116@x [26] m.424 l.8499 - e-TeX basic 1117if cur_chr>glue_val then 1118 begin if cur_chr=input_line_no_code then cur_val:=line 1119 else cur_val:=last_badness; {|cur_chr=badness_code|} 1120@y 1121if m>last_node_type_code then 1122 if m>=eTeX_glue then @<Process an expression and |return|@>@; 1123 else if m>=eTeX_dim then 1124 begin case m of 1125 @/@<Cases for fetching a dimension value@>@/ 1126 end; {there are no other cases} 1127 cur_val_level:=dimen_val; 1128 end 1129 else begin case m of 1130 input_line_no_code: cur_val:=line; 1131 badness_code: cur_val:=last_badness; 1132 @/@<Cases for fetching an integer value@>@/ 1133 end; {there are no other cases} 1134@z 1135%--------------------------------------- 1136@x [26] m.424 l.8505 - e-TeX last_node_type 1137 cur_val_level:=cur_chr; 1138@y 1139 if cur_chr=last_node_type_code then 1140 begin cur_val:=int_val; 1141 if (tail=head)or(mode=0) then cur_val:=-1; 1142 end 1143 else cur_val_level:=cur_chr; 1144@z 1145%--------------------------------------- 1146@x [26] m.424 l.8513 - e-TeX last_node_type 1147 end; 1148@y 1149 end; 1150 last_node_type_code: 1151 if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then 1152 if type(tail)<=unset_node then cur_val:=type(tail)+1 1153 else cur_val:=unset_node+2; 1154@z 1155%--------------------------------------- 1156@x [26] m.424 l.8519 - e-TeX last_node_type 1157 glue_val: if last_glue<>max_halfword then cur_val:=last_glue; 1158@y 1159 glue_val: if last_glue<>max_halfword then cur_val:=last_glue; 1160 last_node_type_code: cur_val:=last_node_type; 1161@z 1162%--------------------------------------- 1163% FIXME might need work 1164@x [26] m.427 l.8535 - e-TeX sparse arrays 1165begin scan_eight_bit_int; 1166case m of 1167@y 1168begin if (m<mem_bot)or(m>lo_mem_stat_max) then 1169 begin cur_val_level:=sa_type(m); 1170 if cur_val_level<glue_val then cur_val:=sa_int(m) 1171 else cur_val:=sa_ptr(m); 1172 end 1173else begin scan_register_num; cur_val_level:=m-mem_bot; 1174 if cur_val>255 then 1175 begin find_sa_element(cur_val_level,cur_val,false); 1176 if cur_ptr=null then 1177 if cur_val_level<glue_val then cur_val:=0 1178 else cur_val:=zero_glue 1179 else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr) 1180 else cur_val:=sa_ptr(cur_ptr); 1181 end 1182 else 1183 case cur_val_level of 1184@z 1185%--------------------------------------- 1186@x [26] m.427 l.8542 - e-TeX sparse arrays 1187cur_val_level:=m; 1188@y 1189 end; 1190@z 1191%--------------------------------------- 1192@x [26] m.461 l.9070 - e-TeX expr 1193exit:end; 1194@y 1195exit:end; 1196@# 1197@<Declare procedures needed for expressions@>@; 1198@z 1199%--------------------------------------- 1200@x [27] m.464 l.9129 - e-TeX basic 1201@p function str_toks(@!b:pool_pointer):pointer; 1202@y 1203@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/ 1204function str_toks(@!b:pool_pointer):pointer; 1205@z 1206%--------------------------------------- 1207@x [27] m.465 l.9154 the_toks - e-TeX unexpanded 1208@p function the_toks:pointer; 1209@y 1210@p function the_toks:pointer; 1211label exit; 1212@z 1213%--------------------------------------- 1214@x [27] m.465 l.9158 the_toks - e-TeX unexpanded 1215begin get_x_token; scan_something_internal(tok_val,false); 1216@y 1217@!c:small_number; {value of |cur_chr|} 1218begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/ 1219get_x_token; scan_something_internal(tok_val,false); 1220@z 1221%--------------------------------------- 1222@x [27] m.465 l.9172 the_toks - e-TeX unexpanded 1223end; 1224@y 1225exit:end; 1226@z 1227%--------------------------------------- 1228@x [27] m.469 l.9223 - e-TeX basic 1229 othercases print_esc("jobname") 1230@y 1231 @/@<Cases of |convert| for |print_cmd_chr|@>@/ 1232 othercases print_esc("jobname") 1233@z 1234%--------------------------------------- 1235@x [27] m.470 l.9232 conv_toks - e-TeX basic 1236@!c:number_code..job_name_code; {desired type of conversion} 1237@y 1238@!c:small_number; {desired type of conversion} 1239@z 1240%--------------------------------------- 1241@x [27] m.471 l.9249 - e-TeX basic 1242end {there are no other cases} 1243@y 1244@/@<Cases of `Scan the argument for command |c|'@>@/ 1245end {there are no other cases} 1246@z 1247%--------------------------------------- 1248@x [27] m.472 l.9265 - e-TeX basic 1249end {there are no other cases} 1250@y 1251@/@<Cases of `Print the result of command |c|'@>@/ 1252end {there are no other cases} 1253@z 1254%--------------------------------------- 1255@x [27] m.478 l.9374 - e-TeX protected 1256 if cur_cmd<=max_command then goto done2; 1257@y 1258 if cur_cmd>=call then 1259 if info(link(cur_chr))=protected_token then 1260 begin cur_cmd:=relax; cur_chr:=no_expand_flag; 1261 end; 1262 if cur_cmd<=max_command then goto done2; 1263@z 1264%--------------------------------------- 1265@x [27] m.482 l.9422 read_toks - e-TeX read_line 1266@p procedure read_toks(@!n:integer;@!r:pointer); 1267@y 1268@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword); 1269@z 1270%--------------------------------------- 1271@x [27] m.483 l.9448 - e-TeX read_line 1272loop@+ begin get_token; 1273@y 1274@<Handle \.{\\readline} and |goto done|@>;@/ 1275loop@+ begin get_token; 1276@z 1277%--------------------------------------- 1278@x [28] m.487 l.9500 - e-TeX cond 1279@d if_char_code=0 { `\.{\\if}' } 1280@y 1281@d unless_code=32 {amount added for `\.{\\unless}' prefix} 1282@# 1283@d if_char_code=0 { `\.{\\if}' } 1284@z 1285%--------------------------------------- 1286@x [28] m.488 l.9555 - e-TeX cond 1287if_test: case chr_code of 1288@y 1289if_test: begin if chr_code>=unless_code then print_esc("unless"); 1290case chr_code mod unless_code of 1291@z 1292%--------------------------------------- 1293@x [28] m.488 l.9572 - e-TeX cond 1294 othercases print_esc("if") 1295 endcases; 1296@y 1297 @/@<Cases of |if_test| for |print_cmd_chr|@>@/ 1298 othercases print_esc("if") 1299 endcases; 1300end; 1301@z 1302%--------------------------------------- 1303@x [28] m.494 l.9646 pass_text - e-TeX tracing 1304done: scanner_status:=save_scanner_status; 1305@y 1306done: scanner_status:=save_scanner_status; 1307if tracing_ifs>0 then show_cur_cmd_chr; 1308@z 1309%--------------------------------------- 1310@x [28] m.496 l.9662 - e-TeX tracing_nesting 1311begin p:=cond_ptr; if_line:=if_line_field(p); 1312@y 1313begin if if_stack[in_open]=cond_ptr then if_warning; 1314 {conditionals possibly not properly nested with files} 1315p:=cond_ptr; if_line:=if_line_field(p); 1316@z 1317%--------------------------------------- 1318@x [28] m.498 l.9699 conditional - e-TeX cond 1319begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/ 1320@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>; 1321@y 1322@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?} 1323begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr; 1324@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr; 1325is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/ 1326@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>; 1327if is_unless then b:=not b; 1328@z 1329%--------------------------------------- 1330@x [28] m.501 l.9742 - e-TeX cond 1331if_false_code: b:=false; 1332@y 1333if_false_code: b:=false; 1334@/@<Cases for |conditional|@>@/ 1335@z 1336%--------------------------------------- 1337@x [28] m.505 l.9781 - e-TeX sparse arrays 1338begin scan_eight_bit_int; p:=box(cur_val); 1339@y 1340begin scan_register_num; fetch_box(p); 1341@z 1342%--------------------------------------- 1343@x [28] m.510 l.9871 - e-TeX cond 1344if cur_chr>if_limit then 1345@y 1346begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr; 1347if cur_chr>if_limit then 1348@z 1349%--------------------------------------- 1350@x [28] m.510 l.9882 - e-TeX cond 1351 end 1352@y 1353 end; 1354end 1355@z 1356%--------------------------------------- 1357@x [29] m.536 l.10324 - e-TeX basic 1358begin wlog(banner); 1359@y 1360begin wlog(eTeX_banner); 1361@z 1362%--------------------------------------- 1363@x [29] m.536 l.10331 - e-TeX basic 1364end 1365@y 1366if eTeX_ex then 1367 begin; wlog_cr; wlog('entering extended mode'); 1368 end; 1369end 1370@z 1371%--------------------------------------- 1372@x [30] m.581 l.11263 char_warning - e-TeX tracing 1373begin if tracing_lost_chars>0 then 1374@y 1375var old_setting: integer; {saved value of |tracing_online|} 1376begin if tracing_lost_chars>0 then 1377 begin old_setting:=tracing_online; 1378 if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; 1379@z 1380%--------------------------------------- 1381@x [30] m.581 l.11270 char_warning - e-TeX tracing 1382end; 1383@y 1384 tracing_online:=old_setting; 1385 end; 1386end; 1387@z 1388%--------------------------------------- 1389@x [34] m.687 l.13480 - e-TeX middle 1390\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is 1391@y 1392\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}. 1393The |nucleus| of such noads is 1394@z 1395%--------------------------------------- 1396@x [34] m.687 l.13497 - e-TeX middle 1397@d delimiter==nucleus {|delimiter| field in left and right noads} 1398@y 1399@d delimiter==nucleus {|delimiter| field in left and right noads} 1400@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}} 1401@z 1402%--------------------------------------- 1403@x [34] m.696 l.13670 - e-TeX middle 1404right_noad: begin print_esc("right"); print_delimiter(delimiter(p)); 1405 end; 1406end; 1407if subtype(p)<>normal then 1408 if subtype(p)=limits then print_esc("limits") 1409 else print_esc("nolimits"); 1410if type(p)<left_noad then print_subsidiary_data(nucleus(p),"."); 1411@y 1412right_noad: begin if subtype(p)=normal then print_esc("right") 1413 else print_esc("middle"); 1414 print_delimiter(nucleus(p)); 1415 end; 1416end; 1417if type(p)<left_noad then 1418 begin if subtype(p)<>normal then 1419 if subtype(p)=limits then print_esc("limits") 1420 else print_esc("nolimits"); 1421 print_subsidiary_data(nucleus(p),"."); 1422 end; 1423@z 1424%--------------------------------------- 1425@x [36] m.727 l.14268 - e-TeX middle 1426done_with_noad: r:=q; r_type:=type(r); 1427@y 1428done_with_noad: r:=q; r_type:=type(r); 1429if r_type=right_noad then 1430 begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>; 1431 end; 1432@z 1433%--------------------------------------- 1434@x [36] m.760 l.14929 - e-TeX middle 1435 r_type:=t; 1436@y 1437 if type(q)=right_noad then t:=open_noad; 1438 r_type:=t; 1439@z 1440%--------------------------------------- 1441@x [36] m.762 l.14970 make_left_right - e-TeX middle 1442begin if style<script_style then cur_size:=text_size 1443else cur_size:=script_size*((style-text_style) div 2); 1444@y 1445begin cur_style:=style; @<Set up the values...@>; 1446@z 1447%--------------------------------------- 1448@x [37] m.785 l.15461 align_peek - e-TeX protected 1449begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>; 1450@y 1451begin restart: align_state:=1000000; 1452repeat get_x_or_protected; 1453until cur_cmd<>spacer; 1454@z 1455%--------------------------------------- 1456@x [37] m.791 l.15572 fin_col - e-TeX protected 1457align_state:=1000000; @<Get the next non-blank non-call token@>; 1458@y 1459align_state:=1000000; 1460repeat get_x_or_protected; 1461until cur_cmd<>spacer; 1462@z 1463%--------------------------------------- 1464@x [38] m.814 l.15975 - e-TeX penalties 1465There is one explicit parameter: |final_widow_penalty| is the amount of 1466additional penalty to be inserted before the final line of the paragraph. 1467@y 1468There is one explicit parameter: |d| is true for partial paragraphs 1469preceding display math mode; in this case the amount of additional 1470penalty inserted before the final line is |display_widow_penalty| 1471instead of |widow_penalty|. 1472@z 1473%--------------------------------------- 1474@x [38] m.815 l.16002 line_break - e-TeX penalties 1475procedure line_break(@!final_widow_penalty:integer); 1476@y 1477procedure line_break(@!d:boolean); 1478@z 1479%--------------------------------------- 1480@x [38] m.815 l.16012 - e-TeX basic 1481end; 1482@y 1483end; 1484@# 1485@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@> 1486@z 1487%--------------------------------------- 1488@x [38] m.816 l.16032 - e-TeX last_line_fit 1489final_par_glue:=new_param_glue(par_fill_skip_code); 1490link(tail):=final_par_glue; 1491@y 1492final_par_glue:=new_param_glue(par_fill_skip_code); 1493link(tail):=final_par_glue; 1494last_line_fill:=link(tail); 1495@z 1496%--------------------------------------- 1497@x [38] m.819 l.16097 - e-TeX last_line_fit 1498@d active_node_size=3 {number of words in active nodes} 1499@y 1500@d active_node_size_normal=3 {number of words in normal active nodes} 1501@z 1502%--------------------------------------- 1503% FIXME might need fixes; TeX has 6 backgrounds 1504% Omega has 7. Why the difference? 1505@x [38] m.827 l.16260 - e-TeX last_line_fit 1506background[7]:=shrink(q)+shrink(r); 1507@y 1508background[7]:=shrink(q)+shrink(r); 1509@<Check for special treatment of last line of paragraph@>; 1510@z 1511%--------------------------------------- 1512@x [38] m.829 l.16311 try_break - e-TeX last_line_fit 1513label exit,done,done1,continue,deactivate; 1514@y 1515label exit,done,done1,continue,deactivate,found,not_found; 1516@z 1517%--------------------------------------- 1518@x [38] m.845 l.16603 - e-TeX last_line_fit 1519total_demerits(q):=minimal_demerits[fit_class]; 1520@y 1521total_demerits(q):=minimal_demerits[fit_class]; 1522if do_last_line_fit then 1523 @<Store \(a)additional data in the new active node@>; 1524@z 1525%--------------------------------------- 1526@x [38] m.846 l.16616 - e-TeX last_line_fit 1527print(" t="); print_int(total_demerits(q)); 1528@y 1529print(" t="); print_int(total_demerits(q)); 1530if do_last_line_fit then @<Print additional data in the new active node@>; 1531@z 1532%--------------------------------------- 1533@x [38] m.851 l.16715 - e-TeX last_line_fit 1534if (b>inf_bad)or(pi=eject_penalty) then 1535@y 1536if do_last_line_fit then @<Adjust \(t)the additional data for last line@>; 1537found: 1538if (b>inf_bad)or(pi=eject_penalty) then 1539@z 1540%--------------------------------------- 1541@x [38] m.852 l.16739 - e-TeX last_line_fit 1542 begin b:=0; fit_class:=decent_fit; {infinite stretch} 1543@y 1544 begin if do_last_line_fit then 1545 begin if cur_p=null then {the last line of a paragraph} 1546 @<Perform computations for last line and |goto found|@>; 1547 shortfall:=0; 1548 end; 1549 b:=0; fit_class:=decent_fit; {infinite stretch} 1550@z 1551%--------------------------------------- 1552@x [38] m.855 l.16796 - e-TeX last_line_fit 1553 best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l; 1554@y 1555 best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l; 1556 if do_last_line_fit then 1557 @<Store \(a)additional data for this feasible break@>; 1558@z 1559%--------------------------------------- 1560@x [39] m.863 l.16969 - e-TeX last_line_fit 1561 end;@+tats@/ 1562@y 1563 end;@+tats@/ 1564if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>; 1565@z 1566%--------------------------------------- 1567@x [39] m.864 l.16980 - e-TeX last_line_fit 1568line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q; 1569@y 1570line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q; 1571if do_last_line_fit then 1572 @<Initialize additional fields of the first active node@>; 1573@z 1574%--------------------------------------- 1575@x [39] m.876 l.17192 - e-TeX penalties 1576post_line_break(final_widow_penalty) 1577@y 1578post_line_break(d) 1579@z 1580%--------------------------------------- 1581@x [39] m.877 l.17206 post_line_break - e-TeX penalties 1582procedure post_line_break(@!final_widow_penalty:integer); 1583@y 1584procedure post_line_break(@!d:boolean); 1585@z 1586%--------------------------------------- 1587% FIXME possible conflict 1588@x [39] m.890 l.17395 - e-TeX penalties 1589 if passive_pen_inter(cur_p)<>0 then 1590 pen:=passive_pen_inter(cur_p) 1591 else pen:=inter_line_penalty; 1592 if cur_line=prev_graf+1 then pen:=pen+club_penalty; 1593 if cur_line+2=best_line then pen:=pen+final_widow_penalty; 1594@y 1595 q:=inter_line_penalties_ptr; 1596 if q<>null then 1597 begin r:=cur_line; 1598 if r>penalty(q) then r:=penalty(q); 1599 pen:=penalty(q+r); 1600 end 1601 else begin 1602 if passive_pen_inter(cur_p)<>0 then 1603 pen:=passive_pen_inter(cur_p) 1604 else pen:=inter_line_penalty; 1605 end; 1606 q:=club_penalties_ptr; 1607 if q<>null then 1608 begin r:=cur_line-prev_graf; 1609 if r>penalty(q) then r:=penalty(q); 1610 pen:=pen+penalty(q+r); 1611 end 1612 else if cur_line=prev_graf+1 then pen:=pen+club_penalty; 1613 if d then q:=display_widow_penalties_ptr 1614 else q:=widow_penalties_ptr; 1615 if q<>null then 1616 begin r:=best_line-cur_line-1; 1617 if r>penalty(q) then r:=penalty(q); 1618 pen:=pen+penalty(q+r); 1619 end 1620 else if cur_line+2=best_line then 1621 if d then pen:=pen+display_widow_penalty 1622 else pen:=pen+widow_penalty; 1623@z 1624%--------------------------------------- 1625@x [40] m.891 l.17460 - e-TeX hyph_codes 1626cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf; 1627@y 1628cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf; 1629set_hyph_index; 1630@z 1631%--------------------------------------- 1632@x [40] m.896 l.17529 - e-TeX hyph_codes 1633 if lc_code(c)<>0 then 1634 if (lc_code(c)=c)or(uc_hyph>0) then goto done2 1635@y 1636 set_lc_code(c); 1637 if hc[0]<>0 then 1638 if (hc[0]=c)or(uc_hyph>0) then goto done2 1639@z 1640%--------------------------------------- 1641@x [40] m.897 l.17546 - e-TeX hyph_codes 1642 if lc_code(c)=0 then goto done3; 1643 if lc_code(c)>max_hyph_char then goto done3; 1644 if hn=63 then goto done3; 1645 hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char; 1646@y 1647 set_lc_code(c); 1648 if hc[0]=0 then goto done3; 1649 if lc_code(c)>max_hyph_char then goto done3; 1650 if hn=63 then goto done3; 1651 hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char; 1652@z 1653%--------------------------------------- 1654@x [40] m.898 l.17572 - e-TeX hyph_codes 1655 if lc_code(c)=0 then goto done3; 1656 if lc_code(c)>max_hyph_char then goto done3; 1657 if j=63 then goto done3; 1658 incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/ 1659@y 1660 set_lc_code(c); 1661 if hc[0]=0 then goto done3; 1662 if lc_code(c)>max_hyph_char then goto done3; 1663 if j=63 then goto done3; 1664 incr(j); hu[j]:=c; hc[j]:=hc[0];@/ 1665@z 1666%--------------------------------------- 1667@x [42] m.934 l.18211 new_hyph_exceptions - e-TeX hyph_codes 1668label reswitch, exit, found, not_found; 1669@y 1670label reswitch, exit, found, not_found, not_found1; 1671@z 1672%--------------------------------------- 1673@x [42] m.934 l.18221 new_hyph_exceptions - e-TeX hyph_codes 1674set_cur_lang; 1675@y 1676set_cur_lang; 1677@!init if trie_not_ready then 1678 begin hyph_index:=0; goto not_found1; 1679 end; 1680tini@/ 1681set_hyph_index; 1682not_found1: 1683@z 1684%--------------------------------------- 1685@x [42] m.937 l.18253 - e-TeX hyph_codes 1686else begin if lc_code(cur_chr)=0 then 1687@y 1688else begin set_lc_code(cur_chr); 1689 if hc[0]=0 then 1690@z 1691%--------------------------------------- 1692@x [42] m.937 l.18261 - e-TeX hyph_codes 1693 begin incr(n); hc[n]:=lc_code(cur_chr); 1694@y 1695 begin incr(n); hc[n]:=hc[0]; 1696@z 1697%--------------------------------------- 1698@x [43] m.952 l.18549 - e-TeX hyph_codes 1699trie_root:=compress_trie(trie_root); {identify equivalent subtries} 1700@y 1701hyph_root:=compress_trie(hyph_root); 1702trie_root:=compress_trie(trie_root); {identify equivalent subtries} 1703@z 1704%--------------------------------------- 1705@x [43] m.958 l.18637 - e-TeX hyph_codes 1706if trie_root=0 then {no patterns were given} 1707@y 1708if trie_max=0 then {no patterns were given} 1709@z 1710%--------------------------------------- 1711@x [43] m.958 l.18641 - e-TeX hyph_codes 1712else begin trie_fix(trie_root); {this fixes the non-holes in |trie|} 1713@y 1714else begin if hyph_root>0 then trie_fix(hyph_root); 1715 if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|} 1716@z 1717%--------------------------------------- 1718@x [43] m.960 l.18684 new_patterns - e-TeX hyph_codes 1719 brace@>; 1720@y 1721 brace@>; 1722 if saving_hyph_codes>0 then 1723 @<Store hyphenation codes for current language@>; 1724@z 1725%--------------------------------------- 1726@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes 1727@<Move the data into |trie|@>; 1728@y 1729if hyph_root<>0 then @<Pack all stored |hyph_codes|@>; 1730@<Move the data into |trie|@>; 1731@z 1732%--------------------------------------- 1733@x [44] m.968 l.18807 - e-TeX saved_items 1734whenever this is possible without backspacing. 1735@y 1736whenever this is possible without backspacing. 1737 1738When the second argument |s| is |false| the deleted nodes are destroyed, 1739otherwise they are collected in a list starting at |split_disc|. 1740@z 1741%--------------------------------------- 1742@x [44] m.968 l.18814 prune_page_top - e-TeX saved_items 1743@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break} 1744var prev_p:pointer; {lags one step behind |p|} 1745@!q:pointer; {temporary variable for list manipulation} 1746@y 1747@p function prune_page_top(@!p:pointer;@!s:boolean):pointer; 1748 {adjust top after page break} 1749var prev_p:pointer; {lags one step behind |p|} 1750@!q,@!r:pointer; {temporary variables for list manipulation} 1751@z 1752%--------------------------------------- 1753@x [44] m.968 l.18825 prune_page_top - e-TeX saved_items 1754 link(prev_p):=p; flush_node_list(q); 1755@y 1756 link(prev_p):=p; 1757 if s then 1758 begin if split_disc=null then split_disc:=q@+else link(r):=q; 1759 r:=q; 1760 end 1761 else flush_node_list(q); 1762@z 1763%--------------------------------------- 1764@x [44] m.977 l.18992 vsplit - e-TeX marks, sparse arrays 1765@p function vsplit(@!n:eight_bits; @!h:scaled):pointer; 1766@y 1767@p @t\4@>@<Declare the function called |do_marks|@>@; 1768function vsplit(@!n:halfword; @!h:scaled):pointer; 1769@z 1770%--------------------------------------- 1771% FIXME incompatible? 1772@x [44] m.977 l.18998 vsplit - e-TeX sparse arrays 1773begin v:=box(n); vdir:=box_dir(v); 1774@y 1775begin cur_val:=n; fetch_box(v); vdir:=box_dir(v); 1776@z 1777%--------------------------------------- 1778% FIXME: how to detach this from sparse arrays? 1779@x [44] m.977 l.18999 vsplit - e-TeX marks, saved_items 1780if split_first_mark<>null then 1781@y 1782flush_node_list(split_disc); split_disc:=null; 1783if sa_mark<>null then 1784 if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null; 1785if split_first_mark<>null then 1786@z 1787%--------------------------------------- 1788@x [44] m.977 l.19007 vsplit - e-TeX saved_items 1789q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size); 1790@y 1791q:=prune_page_top(q,saving_vdiscards>0); 1792p:=list_ptr(v); free_node(v,box_node_size); 1793@z 1794%--------------------------------------- 1795% FIXME might be incompatible? 1796@x [44] m.977 l.19008 vsplit - e-TeX sparse arrays 1797if q=null then set_equiv(box_base+n,null) 1798 {the |eq_level| of the box stays the same} 1799else set_equiv(box_base+n,vpack(q,natural)); 1800@y 1801if q<>null then q:=vpack(q,natural); 1802change_box(q); {the |eq_level| of the box stays the same} 1803@z 1804%--------------------------------------- 1805@x [44] m.979 l.19033 - e-TeX marks 1806 if split_first_mark=null then 1807@y 1808 if mark_class(p)<>0 then @<Update the current marks for |vsplit|@> 1809 else if split_first_mark=null then 1810@z 1811%--------------------------------------- 1812@x [45] m.982 l.19167 - e-TeX last_node_type 1813The variables |last_penalty| and |last_kern| are similar. And 1814@y 1815The variables |last_penalty|, |last_kern|, and |last_node_type| 1816are similar. And 1817@z 1818%--------------------------------------- 1819@x [45] m.982 l.19180 - e-TeX last_node_type 1820@!last_kern:scaled; {used to implement \.{\\lastkern}} 1821@y 1822@!last_kern:scaled; {used to implement \.{\\lastkern}} 1823@!last_node_type:integer; {used to implement \.{\\lastnodetype}} 1824@z 1825%--------------------------------------- 1826@x [45] m.991 l.19317 - e-TeX last_node_type 1827last_glue:=max_halfword; last_penalty:=0; last_kern:=0; 1828@y 1829last_glue:=max_halfword; last_penalty:=0; last_kern:=0; 1830last_node_type:=-1; 1831@z 1832%--------------------------------------- 1833@x [45] m.996 l.19384 - e-TeX last_node_type 1834last_penalty:=0; last_kern:=0; 1835@y 1836last_penalty:=0; last_kern:=0; 1837last_node_type:=type(p)+1; 1838@z 1839%--------------------------------------- 1840@x [45] m.999 l.19421 - e-TeX saved_items 1841link(contrib_head):=link(p); link(p):=null; flush_node_list(p) 1842@y 1843link(contrib_head):=link(p); link(p):=null; 1844if saving_vdiscards>0 then 1845 begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p; 1846 tail_page_disc:=p; 1847 end 1848else flush_node_list(p) 1849@z 1850%--------------------------------------- 1851% FIXME: sparse arrays? 1852@x [45] m.1012 l.19661 fire_up - e-TeX marks 1853if bot_mark<>null then 1854@y 1855if sa_mark<>null then 1856 if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null; 1857if bot_mark<>null then 1858@z 1859%--------------------------------------- 1860@x [45] m.1012 l.19669 fire_up - e-TeX marks 1861if (top_mark<>null)and(first_mark=null) then 1862@y 1863if sa_mark<>null then 1864 if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null; 1865if (top_mark<>null)and(first_mark=null) then 1866@z 1867%--------------------------------------- 1868@x [45] m.1014 l.19706 - e-TeX marks 1869 else if type(p)=mark_node then @<Update the values of 1870@y 1871 else if type(p)=mark_node then 1872 if mark_class(p)<>0 then @<Update the current marks for |fire_up|@> 1873 else @<Update the values of 1874@z 1875%--------------------------------------- 1876@x [45] m.1021 l.19818 - e-TeX saved_items 1877 ins_ptr(p):=prune_page_top(broken_ptr(r)); 1878@y 1879 ins_ptr(p):=prune_page_top(broken_ptr(r),false); 1880@z 1881%--------------------------------------- 1882@x [45] m.1023 l.19854 - e-TeX saved_items 1883ship_out(box(255)); set_equiv(box_base+255,null); 1884@y 1885flush_node_list(page_disc); page_disc:=null; 1886ship_out(box(255)); set_equiv(box_base+255,null); 1887@z 1888%--------------------------------------- 1889@x [45] m.1026 l.19896 - e-TeX saved_items 1890pop_nest; build_page; 1891@y 1892flush_node_list(page_disc); page_disc:=null; 1893pop_nest; build_page; 1894@z 1895%--------------------------------------- 1896@x [47] m.1070 l.20697 normal_paragraph - e-TeX penalties 1897if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null); 1898@y 1899if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null); 1900if inter_line_penalties_ptr<>null then 1901 eq_define(inter_line_penalties_loc,shape_ref,null); 1902@z 1903%--------------------------------------- 1904@x [47] m.1071 l.20732 - e-TeX sparse arrays 1905@d ship_out_flag==box_flag+(number_regs+number_regs) 1906 {context code for `\.{\\shipout}'} 1907@y 1908@d global_box_flag==box_flag+(number_regs+number_regs) {context code for `\.{\\global\\setbox0}'} 1909@d ship_out_flag==global_box_flag+1 {context code for `\.{\\shipout}'} 1910@z 1911%--------------------------------------- 1912@x [47] m.1075 l.20815 box_end - e-TeX sparse arrays 1913var p:pointer; {|ord_noad| for new box in math mode} 1914@y 1915var p:pointer; {|ord_noad| for new box in math mode} 1916@!a:small_number; {global prefix} 1917@z 1918%--------------------------------------- 1919% FIXME: might not work this way 1920@x [47] m.1077 l.20853 - e-TeX sparse arrays 1921if box_context<box_flag+number_regs then 1922 eq_define(box_base-box_flag+box_context,box_ref,cur_box) 1923else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box) 1924@y 1925begin if box_context<global_box_flag then 1926 begin cur_val:=box_context-box_flag; a:=0; 1927 end 1928else begin cur_val:=box_context-global_box_flag; a:=4; 1929 end; 1930if cur_val<256 then define(box_base+cur_val,box_ref,cur_box) 1931else sa_def_box; 1932end 1933@z 1934%--------------------------------------- 1935@x [47] m.1079 l.20885 begin_box - e-TeX sparse arrays 1936@!n:eight_bits; {a box number} 1937begin case cur_chr of 1938box_code: begin scan_eight_bit_int; cur_box:=box(cur_val); 1939 set_equiv(box_base+cur_val,null); 1940 {the box becomes void, at the same level} 1941 end; 1942copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val)); 1943@y 1944@!n:halfword; {a box number} 1945begin case cur_chr of 1946box_code: begin scan_register_num; fetch_box(cur_box); 1947 set_equiv(box_base+cur_val,null); 1948 {the box becomes void, at the same level} 1949 end; 1950copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q); 1951@z 1952%--------------------------------------- 1953@x [47] m.1082 l.20935 - e-TeX sparse arrays 1954begin scan_eight_bit_int; n:=cur_val; 1955@y 1956begin scan_register_num; n:=cur_val; 1957@z 1958%--------------------------------------- 1959@x [47] m.1101 l.21175 make_mark - e-TeX marks 1960begin p:=scan_toks(false,true); p:=get_node(small_node_size); 1961@y 1962@!c:halfword; {the mark class} 1963begin if cur_chr=0 then c:=0 1964else begin scan_register_num; c:=cur_val; 1965 end; 1966p:=scan_toks(false,true); p:=get_node(small_node_size); 1967mark_class(p):=c; 1968@z 1969%--------------------------------------- 1970@x [47] m.1108 l.21262 - e-TeX saved_items 1971un_vbox: if chr_code=copy_code then print_esc("unvcopy") 1972@y 1973un_vbox: if chr_code=copy_code then print_esc("unvcopy") 1974 @<Cases of |un_vbox| for |print_cmd_chr|@>@/ 1975@z 1976%--------------------------------------- 1977@x [47] m.1110 l.21272 unpackage - e-TeX saved_items 1978label exit; 1979@y 1980label done, exit; 1981@z 1982%--------------------------------------- 1983@x [47] m.1110 l.21275 unpackage - e-TeX saved_items, sparse arrays 1984begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val); 1985@y 1986begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>; 1987c:=cur_chr; scan_register_num; fetch_box(p); 1988@z 1989%--------------------------------------- 1990% FIXME: might be incompatible 1991@x [47] m.1110 l.21287 unpackage - e-TeX sparse arrays 1992else begin link(tail):=list_ptr(p); 1993set_equiv(box_base+cur_val,null); 1994@y 1995else begin link(tail):=list_ptr(p); 1996change_box(null); 1997@z 1998%--------------------------------------- 1999@x [47] m.1110 l.21290 unpackage - e-TeX saved_items 2000while link(tail)<>null do tail:=link(tail); 2001@y 2002done: 2003while link(tail)<>null do tail:=link(tail); 2004@z 2005%--------------------------------------- 2006@x [48] m.1185 l.22243 - e-TeX middle 2007 if type(q)<>left_noad then confusion("right"); 2008@:this can't happen right}{\quad right@> 2009 info(numerator(incompleat_noad)):=link(q); 2010 link(q):=incompleat_noad; link(incompleat_noad):=p; 2011@y 2012 if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right"); 2013@:this can't happen right}{\quad right@> 2014 info(numerator(incompleat_noad)):=link(delim_ptr); 2015 link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p; 2016@z 2017%--------------------------------------- 2018@x [48] m.1189 l.22288 - e-TeX middle 2019else print_esc("right"); 2020@y 2021@/@<Cases of |left_right| for |print_cmd_chr|@>@/ 2022else print_esc("right"); 2023@z 2024%--------------------------------------- 2025@x [48] m.1191 l.22297 math_left_right - e-TeX middle 2026begin t:=cur_chr; 2027if (t=right_noad)and(cur_group<>math_left_group) then 2028@y 2029@!q:pointer; {resulting mlist} 2030begin t:=cur_chr; 2031if (t<>left_noad)and(cur_group<>math_left_group) then 2032@z 2033%--------------------------------------- 2034% FIXME: might be incompatible? 2035@x [48] m.1191 l.22302 math_left_right - e-TeX middle 2036 if t=left_noad then 2037 begin push_math(math_left_group); link(head):=p; tail:=p; 2038 end 2039 else begin p:=fin_mlist(p); 2040 @<DIR: |unsave| math@>; {end of |math_left_group|} 2041@y 2042 if t=middle_noad then 2043 begin type(p):=right_noad; subtype(p):=middle_noad; 2044 end; 2045 if t=left_noad then q:=p 2046 else begin q:=fin_mlist(p); 2047 @<DIR: |unsave| math@>; {end of |math_left_group|} 2048 end; 2049 if t<>right_noad then 2050 begin push_math(math_left_group); link(head):=q; tail:=p; 2051 delim_ptr:=p; 2052 end 2053 else begin 2054@z 2055%--------------------------------------- 2056@x [48] m.1191 l.22308 math_left_right - e-TeX middle 2057 info(nucleus(tail)):=p; 2058@y 2059 info(nucleus(tail)):=q; 2060@z 2061%--------------------------------------- 2062@x [48] m.1192 l.22316 - e-TeX middle 2063 print_err("Extra "); print_esc("right"); 2064@.Extra \\right.@> 2065 help1("I'm ignoring a \right that had no matching \left."); 2066@y 2067 print_err("Extra "); 2068 if t=middle_noad then 2069 begin print_esc("middle"); 2070@.Extra \\middle.@> 2071 help1("I'm ignoring a \middle that had no matching \left."); 2072 end 2073 else begin print_esc("right"); 2074@.Extra \\right.@> 2075 help1("I'm ignoring a \right that had no matching \left."); 2076 end; 2077@z 2078%--------------------------------------- 2079@x [49] m.1208 l.22577 - e-TeX protected 2080control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and 2081it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}', 2082@y 2083control sequence can be defined to be `\.{\\long}', `\.{\\protected}', 2084or `\.{\\outer}', and it might or might not be expanded. The prefixes 2085`\.{\\global}', `\.{\\long}', `\.{\\protected}', 2086@z 2087%--------------------------------------- 2088@x [49] m.1209 l.22603 - e-TeX protected 2089 else print_esc("global"); 2090@y 2091 @/@<Cases of |prefix| for |print_cmd_chr|@>@/ 2092 else print_esc("global"); 2093@z 2094%--------------------------------------- 2095@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing 2096 @<Discard erroneous prefixes and |return|@>; 2097@y 2098 @<Discard erroneous prefixes and |return|@>; 2099 if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr; 2100@z 2101%--------------------------------------- 2102@x [49] m.1212 l.22730 - e-TeX protected 2103help1("I'll pretend you didn't say \long or \outer or \global."); 2104@y 2105help1("I'll pretend you didn't say \long or \outer or \global."); 2106if eTeX_ex then help_line[0]:=@| 2107 "I'll pretend you didn't say \long or \outer or \global or \protected."; 2108@z 2109%--------------------------------------- 2110@x [49] m.1213 l.22686 - e-TeX protected 2111if (cur_cmd<>def)and(a mod 4<>0) then 2112 begin print_err("You can't use `"); print_esc("long"); print("' or `"); 2113 print_esc("outer"); print("' with `"); 2114@y 2115if a>=8 then 2116 begin j:=protected_token; a:=a-8; 2117 end 2118else j:=0; 2119if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then 2120 begin print_err("You can't use `"); print_esc("long"); print("' or `"); 2121 print_esc("outer"); 2122 help1("I'll pretend you didn't say \long or \outer here."); 2123 if eTeX_ex then 2124 begin help_line[0]:=@| 2125 "I'll pretend you didn't say \long or \outer or \protected here."; 2126 print("' or `"); print_esc("protected"); 2127 end; 2128 print("' with `"); 2129@z 2130%--------------------------------------- 2131@x [49] m.1213 l.22691 - e-TeX protected 2132 help1("I'll pretend you didn't say \long or \outer here."); 2133@y 2134@z 2135%--------------------------------------- 2136@x [49] m.1218 l.22749 - e-TeX protected 2137 q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref); 2138@y 2139 q:=scan_toks(true,e); 2140 if j<>0 then 2141 begin q:=get_avail; info(q):=j; link(q):=link(def_ref); 2142 link(def_ref):=q; 2143 end; 2144 define(p,call+(a mod 4),def_ref); 2145@z 2146%--------------------------------------- 2147@x [49] m.1224 l.22840 - e-TeX sparse arrays 2148 othercases begin scan_eight_bit_int; 2149@y 2150 othercases begin scan_register_num; 2151 if cur_val>255 then 2152 begin j:=n-count_def_code; {|int_val..box_val|} 2153 if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|} 2154 find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr); 2155 if j=tok_val then j:=toks_register@+else j:=register; 2156 define(p,j,cur_ptr); 2157 end 2158 else 2159@z 2160%--------------------------------------- 2161@x [49] m.1225 l.22853 - e-TeX read_line 2162read_to_cs: begin scan_int; n:=cur_val; 2163@y 2164read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val; 2165@z 2166%--------------------------------------- 2167@x [49] m.1225 l.22861 - e-TeX read_line 2168 p:=cur_cs; read_toks(n,p); define(p,call,cur_val); 2169@y 2170 p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val); 2171@z 2172%--------------------------------------- 2173@x [49] m.1226 l.22870 - e-TeX sparse arrays 2174 if cur_cmd=toks_register then 2175 begin scan_eight_bit_int; p:=toks_base+cur_val; 2176 end 2177 else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots} 2178@y 2179 e:=false; {just in case, will be set |true| for sparse array elements} 2180 if cur_cmd=toks_register then 2181 if cur_chr=mem_bot then 2182 begin scan_register_num; 2183 if cur_val>255 then 2184 begin find_sa_element(tok_val,cur_val,true); 2185 cur_chr:=cur_ptr; e:=true; 2186 end 2187 else cur_chr:=toks_base+cur_val; 2188 end 2189 else e:=true; 2190 p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots} 2191@z 2192%--------------------------------------- 2193@x [49] m.1226 l.22880 - e-TeX sparse arrays 2194 begin define(p,undefined_cs,null); free_avail(def_ref); 2195 end 2196 else begin if p=output_routine_loc then {enclose in curlies} 2197@y 2198 begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref); 2199 end 2200 else begin if (p=output_routine_loc)and not e then {enclose in curlies} 2201@z 2202%--------------------------------------- 2203@x [49] m.1226 l.22888 - e-TeX sparse arrays 2204 define(p,call,def_ref); 2205@y 2206 sa_define(p,def_ref)(p,call,def_ref); 2207@z 2208%--------------------------------------- 2209@x [49] m.1227 l.22893 - e-TeX sparse arrays 2210begin if cur_cmd=toks_register then 2211 begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val; 2212 end; 2213if cur_cmd=assign_toks then 2214 begin q:=equiv(cur_chr); 2215 if q=null then define(p,undefined_cs,null) 2216 else begin add_token_ref(q); define(p,call,q); 2217 end; 2218 goto done; 2219 end; 2220end 2221@y 2222if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then 2223 begin if cur_cmd=toks_register then 2224 if cur_chr=mem_bot then 2225 begin scan_register_num; 2226 if cur_val<256 then q:=equiv(toks_base+cur_val) 2227 else begin find_sa_element(tok_val,cur_val,false); 2228 if cur_ptr=null then q:=null 2229 else q:=sa_ptr(cur_ptr); 2230 end; 2231 end 2232 else q:=sa_ptr(cur_ptr) 2233 else q:=equiv(cur_chr); 2234 if q=null then sa_define(p,null)(p,undefined_cs,null) 2235 else begin add_token_ref(q); sa_define(p,q)(p,call,q); 2236 end; 2237 goto done; 2238 end 2239@z 2240%--------------------------------------- 2241@x [49] m.1236 l.23009 do_register_command - e-TeX sparse arrays 2242begin q:=cur_cmd; 2243@y 2244@!e:boolean; {does |l| refer to a sparse array element?} 2245@!w:integer; {integer or dimen value of |l|} 2246begin q:=cur_cmd; 2247e:=false; {just in case, will be set |true| for sparse array elements} 2248@z 2249%--------------------------------------- 2250@x [49] m.1236 l.23024 do_register_command - e-TeX sparse arrays 2251if p<glue_val then word_define(l,cur_val) 2252else begin trap_zero_glue; define(l,glue_ref,cur_val); 2253@y 2254if p<glue_val then sa_word_define(l,cur_val) 2255else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val); 2256@z 2257%--------------------------------------- 2258@x [49] m.1237 l.23046 - e-TeX sparse arrays 2259p:=cur_chr; scan_eight_bit_int; 2260@y 2261if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then 2262 begin l:=cur_chr; p:=sa_type(l); e:=true; 2263 end 2264else begin p:=cur_chr-mem_bot; scan_register_num; 2265 if cur_val>255 then 2266 begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true; 2267 end 2268 else 2269@z 2270%--------------------------------------- 2271@x [49] m.1237 l.23053 - e-TeX sparse arrays 2272end; 2273found: 2274@y 2275 end; 2276end; 2277found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=new_eqtb_int(l); 2278else if e then s:=sa_ptr(l)@+else s:=equiv(l) 2279@z 2280%--------------------------------------- 2281@x [49] m.1238 l.23059 - e-TeX sparse arrays 2282 if q=advance then cur_val:=cur_val+new_eqtb_int(l); 2283@y 2284 if q=advance then cur_val:=cur_val+w; 2285@z 2286%--------------------------------------- 2287@x [49] m.1239 l.23066 - e-TeX sparse arrays 2288begin q:=new_spec(cur_val); r:=equiv(l); 2289@y 2290begin q:=new_spec(cur_val); r:=s; 2291@z 2292%--------------------------------------- 2293@x [49] m.1240 l.23086 - e-TeX sparse arrays 2294 if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val) 2295 else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0) 2296 else cur_val:=x_over_n(new_eqtb_int(l),cur_val) 2297else begin s:=equiv(l); r:=new_spec(s); 2298@y 2299 if p=int_val then cur_val:=mult_integers(w,cur_val) 2300 else cur_val:=nx_plus_y(w,cur_val,0) 2301 else cur_val:=x_over_n(w,cur_val) 2302else begin r:=new_spec(s); 2303@z 2304%--------------------------------------- 2305@x [49] m.1241 l.23108 - e-TeX sparse arrays 2306set_box: begin scan_eight_bit_int; 2307 if global then n:=number_regs+cur_val@+else n:=cur_val; 2308 scan_optional_equals; 2309 if set_box_allowed then scan_box(box_flag+n) 2310@y 2311set_box: begin scan_register_num; 2312 if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val; 2313 scan_optional_equals; 2314 if set_box_allowed then scan_box(n) 2315@z 2316%--------------------------------------- 2317@x [49] m.1246 l.23179 alter_integer - e-TeX interaction_mode 2318var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}} 2319begin c:=cur_chr; scan_optional_equals; scan_int; 2320if c=0 then dead_cycles:=cur_val 2321@y 2322var c:small_number; 2323 {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.} 2324begin c:=cur_chr; scan_optional_equals; scan_int; 2325if c=0 then dead_cycles:=cur_val 2326@/@<Cases for |alter_integer|@>@/ 2327@z 2328%--------------------------------------- 2329@x [49] m.1247 l.23188 alter_box_dimen - e-TeX sparse arrays 2330@!b:eight_bits; {box number} 2331begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; 2332scan_normal_dimen; 2333if box(b)<>null then mem[box(b)+c].sc:=cur_val; 2334@y 2335@!b:pointer; {box register} 2336begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals; 2337scan_normal_dimen; 2338if b<>null then mem[b+c].sc:=cur_val; 2339@z 2340%--------------------------------------- 2341@x [49] m.1248 l.23197 - e-TeX penalties 2342set_shape: begin scan_optional_equals; scan_int; n:=cur_val; 2343 if n<=0 then p:=null 2344@y 2345set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val; 2346 if n<=0 then p:=null 2347 else if q>par_shape_loc then 2348 begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n; 2349 n:=cur_val; mem[p+1].int:=n; {number of penalties} 2350 for j:=p+2 to p+n+1 do 2351 begin scan_int; mem[j].int:=cur_val; {penalty values} 2352 end; 2353 if not odd(n) then mem[p+n+2].int:=0; {unused} 2354 end 2355@z 2356%--------------------------------------- 2357@x [49] m.1248 l.23207 - e-TeX penalties 2358 define(par_shape_loc,shape_ref,p); 2359@y 2360 define(q,shape_ref,p); 2361@z 2362%--------------------------------------- 2363@x [49] m.1292 l.23581 - e-TeX show_groups 2364 show_lists:print_esc("showlists"); 2365@y 2366 show_lists:print_esc("showlists"); 2367 @<Cases of |xray| for |print_cmd_chr|@>@;@/ 2368@z 2369%--------------------------------------- 2370@x [49] m.1293 l.23588 show_whatever - e-TeX show_ifs 2371var p:pointer; {tail of a token list to show} 2372@y 2373var p:pointer; {tail of a token list to show} 2374@!t:small_number; {type of conditional being shown} 2375@!m:normal..or_code; {upper bound on |fi_or_else| codes} 2376@!l:integer; {line where that conditional began} 2377@!n:integer; {level of \.{\\if...\\fi} nesting} 2378@z 2379%--------------------------------------- 2380@x [49] m.1293 l.23594 show_whatever - e-TeX show_groups 2381othercases @<Show the current value of some parameter or register, 2382@y 2383@<Cases for |show_whatever|@>@;@/ 2384othercases @<Show the current value of some parameter or register, 2385@z 2386%--------------------------------------- 2387@x [49] m.1295 l.23629 - e-TeX protected 2388call: print("macro"); 2389long_call: print_esc("long macro"); 2390outer_call: print_esc("outer macro"); 2391long_outer_call: begin print_esc("long"); print_esc("outer macro"); 2392@y 2393call,long_call,outer_call,long_outer_call: begin n:=cmd-call; 2394 if info(link(chr_code))=protected_token then n:=n+4; 2395 if odd(n div 4) then print_esc("protected"); 2396 if odd(n) then print_esc("long"); 2397 if odd(n div 2) then print_esc("outer"); 2398 if n>0 then print_char(" "); 2399 print("macro"); 2400@z 2401%--------------------------------------- 2402@x [49] m.1296 l.23637 - e-TeX sparse arrays 2403begin scan_eight_bit_int; begin_diagnostic; 2404print_nl("> \box"); print_int(cur_val); print_char("="); 2405if box(cur_val)=null then print("void") 2406else show_box(box(cur_val)); 2407@y 2408begin scan_register_num; fetch_box(p); begin_diagnostic; 2409print_nl("> \box"); print_int(cur_val); print_char("="); 2410if p=null then print("void")@+else show_box(p); 2411@z 2412%--------------------------------------- 2413@x [50] m.1307 l.23779 - e-TeX basic 2414dump_int(@$);@/ 2415@y 2416dump_int(@$);@/ 2417@<Dump the \eTeX\ state@>@/ 2418@z 2419%--------------------------------------- 2420@x [50] m.1308 l.23794 - e-TeX basic 2421if x<>@$ then goto bad_fmt; {check that strings are the same} 2422@y 2423if x<>@$ then goto bad_fmt; {check that strings are the same} 2424@/@<Undump the \eTeX\ state@>@/ 2425@z 2426%--------------------------------------- 2427@x [50] m.1311 l.23848 - e-TeX sparse arrays 2428dump_int(lo_mem_max); dump_int(rover); 2429@y 2430dump_int(lo_mem_max); dump_int(rover); 2431if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); 2432@z 2433%--------------------------------------- 2434@x [50] m.1312 l.23871 - e-TeX sparse arrays 2435undump(lo_mem_stat_max+1)(lo_mem_max)(rover); 2436@y 2437undump(lo_mem_stat_max+1)(lo_mem_max)(rover); 2438if eTeX_ex then for k:=int_val to tok_val do 2439 undump(null)(lo_mem_max)(sa_root[k]); 2440@z 2441%--------------------------------------- 2442@x [50] m.1324 l.24065 - e-TeX hyph_codes 2443dump_int(trie_max); 2444@y 2445dump_int(trie_max); 2446dump_int(hyph_start); 2447@z 2448%--------------------------------------- 2449@x [50] m.1325 l.24093 - e-TeX hyph_codes 2450undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini 2451@y 2452undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini 2453undump(0)(j)(hyph_start); 2454@z 2455%--------------------------------------- 2456@x [51] m.1335 l.24313 final_cleanup - tracing 2457 print_int(cur_level-level_one); print_char(")"); 2458@y 2459 print_int(cur_level-level_one); print_char(")"); 2460 if eTeX_ex then show_save_groups; 2461@z 2462%--------------------------------------- 2463@x [51] m.1335 l.24336 final_cleanup - e-TeX marks, saved_items 2464 if cur_mark[c]<>null then delete_token_ref(cur_mark[c]); 2465@y 2466 if cur_mark[c]<>null then delete_token_ref(cur_mark[c]); 2467 if sa_mark<>null then 2468 if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null; 2469 for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]); 2470@z 2471%--------------------------------------- 2472@x [51] m.1336 l.24345 ] m.1336 l.24340 init_prim - e-TeX basic 2473begin no_new_control_sequence:=false; 2474@y 2475begin no_new_control_sequence:=false; 2476first:=0; 2477@z 2478%--------------------------------------- 2479@x [51] m.1337 l.24360 - e-TeX basic 2480if (format_ident=0)or(buffer[loc]="&") then 2481@y 2482@<Enable \eTeX, if requested@>@;@/ 2483if (format_ident=0)or(buffer[loc]="&") then 2484@z 2485%--------------------------------------- 2486@x [51] m.1337 l.24368 - e-TeX basic 2487 end; 2488@y 2489 end; 2490if eTeX_ex then wterm_ln('entering extended mode'); 2491@z 2492%--------------------------------------- 2493@x [53] m.1363 l.24715 - e-TeX hyph_codes 2494adv_past(s) 2495@y 2496if subtype(s)=language_node then 2497 begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s); 2498 set_hyph_index; 2499 end 2500@z 2501%--------------------------------------- 2502@x [54] m.1379 l.24903 - e-TeX additions 2503@* \[54] System-dependent changes. 2504@y 2505@* \[53a] The extended features of \eTeX. 2506The program has two modes of operation: (1)~In \TeX\ compatibility mode 2507it fully deserves the name \TeX\ and there are neither extended features 2508nor additional primitive commands. There are, however, a few 2509modifications that would be legitimate in any implementation of \TeX\ 2510such as, e.g., preventing inadequate results of the glue to \.{DVI} 2511unit conversion during |ship_out|. (2)~In extended mode there are 2512additional primitive commands and the extended features of \eTeX\ are 2513available. 2514 2515The distinction between these two modes of operation initially takes 2516place when a `virgin' \.{eINITEX} starts without reading a format file. 2517Later on the values of all \eTeX\ state variables are inherited when 2518\.{eVIRTEX} (or \.{eINITEX}) reads a format file. 2519 2520The code below is designed to work for cases where `$|init|\ldots|tini|$' 2521is a run-time switch. 2522 2523@<Enable \eTeX, if requested@>= 2524@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then 2525 begin no_new_control_sequence:=false; 2526 @<Generate all \eTeX\ primitives@>@; 2527 incr(loc); eTeX_mode:=1; {enter extended mode} 2528 @<Initialize variables for \eTeX\ extended mode@>@; 2529 end; 2530tini@;@/ 2531if not no_new_control_sequence then {just entered extended mode ?} 2532 no_new_control_sequence:=true@+else 2533 2534@ The \eTeX\ features available in extended mode are grouped into two 2535categories: (1)~Some of them are permanently enabled and have no 2536semantic effect as long as none of the additional primitives are 2537executed. (2)~The remaining \eTeX\ features are optional and can be 2538individually enabled and disabled. For each optional feature there is 2539an \eTeX\ state variable named \.{\\...state}; the feature is enabled, 2540resp.\ disabled by assigning a positive, resp.\ non-positive value to 2541that integer. 2542 2543@d eTeX_state_base=int_base+eTeX_state_code 2544@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable} 2545@# 2546@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} 2547@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}} 2548 2549@<Generate all \eTeX...@>= 2550primitive("lastnodetype",last_item,last_node_type_code); 2551@!@:last_node_type_}{\.{\\lastnodetype} primitive@> 2552primitive("eTeXversion",last_item,eTeX_version_code); 2553@!@:eTeX_version_}{\.{\\eTeXversion} primitive@> 2554primitive("eTeXrevision",convert,eTeX_revision_code);@/ 2555@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> 2556 2557@ @<Cases of |last_item| for |print_cmd_chr|@>= 2558last_node_type_code: print_esc("lastnodetype"); 2559eTeX_version_code: print_esc("eTeXversion"); 2560 2561@ @<Cases for fetching an integer value@>= 2562eTeX_version_code: cur_val:=eTeX_version; 2563 2564@ @<Cases of |convert| for |print_cmd_chr|@>= 2565eTeX_revision_code: print_esc("eTeXrevision"); 2566 2567@ @<Cases of `Scan the argument for command |c|'@>= 2568eTeX_revision_code: do_nothing; 2569 2570@ @<Cases of `Print the result of command |c|'@>= 2571eTeX_revision_code: print(eTeX_revision); 2572 2573@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?} 2574 2575@<Glob...@>= 2576@!eTeX_mode: 0..1; {identifies compatibility and extended mode} 2577 2578@ @<Initialize table entries...@>= 2579eTeX_mode:=0; {initially we are in compatibility mode} 2580@<Initialize variables for \eTeX\ compatibility mode@>@; 2581 2582@ @<Dump the \eTeX\ state@>= 2583dump_int(eTeX_mode); 2584for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} 2585 2586@ @<Undump the \eTeX\ state@>= 2587undump(0)(1)(eTeX_mode); 2588if eTeX_ex then 2589 begin @<Initialize variables for \eTeX\ extended mode@>@; 2590 end 2591else begin @<Initialize variables for \eTeX\ compatibility mode@>@; 2592 end; 2593 2594@ The |eTeX_enabled| function simply returns its first argument as 2595result. This argument is |true| if an optional \eTeX\ feature is 2596currently enabled; otherwise, if the argument is |false|, the function 2597gives an error message. 2598 2599@<Declare \eTeX\ procedures for use...@>= 2600function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean; 2601begin if not b then 2602 begin print_err("Improper "); print_cmd_chr(j,k); 2603 help1("Sorry, this optional e-TeX feature has been disabled."); error; 2604 end; 2605eTeX_enabled:=b; 2606end; 2607 2608@ First we implement the additional \eTeX\ parameters in the table of 2609equivalents. 2610 2611@<Generate all \eTeX...@>= 2612primitive("everyeof",assign_toks,every_eof_loc); 2613@!@:every_eof_}{\.{\\everyeof} primitive@> 2614primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/ 2615@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@> 2616primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/ 2617@!@:tracing_groups_}{\.{\\tracinggroups} primitive@> 2618primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/ 2619@!@:tracing_ifs_}{\.{\\tracingifs} primitive@> 2620primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/ 2621@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@> 2622primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/ 2623@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@> 2624{ FIXME: the next two should be commented } 2625primitive("predisplaydirection", 2626 assign_int,int_base+pre_display_direction_code);@/ 2627@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@> 2628primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/ 2629@!@:last_line_fit_}{\.{\\lastlinefit} primitive@> 2630primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/ 2631@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@> 2632primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/ 2633@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@> 2634 2635@ @d every_eof==equiv(every_eof_loc) 2636 2637@<Cases of |assign_toks| for |print_cmd_chr|@>= 2638every_eof_loc: print_esc("everyeof"); 2639 2640@ @<Cases for |print_param|@>= 2641tracing_assigns_code:print_esc("tracingassigns"); 2642tracing_groups_code:print_esc("tracinggroups"); 2643tracing_ifs_code:print_esc("tracingifs"); 2644tracing_scan_tokens_code:print_esc("tracingscantokens"); 2645tracing_nesting_code:print_esc("tracingnesting"); 2646{ FIXME: the next one should be commented } 2647pre_display_direction_code:print_esc("predisplaydirection"); 2648last_line_fit_code:print_esc("lastlinefit"); 2649saving_vdiscards_code:print_esc("savingvdiscards"); 2650saving_hyph_codes_code:print_esc("savinghyphcodes"); 2651 2652@ In order to handle \.{\\everyeof} we need an array |eof_seen| of 2653boolean variables. 2654 2655@<Glob...@>= 2656@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?} 2657 2658@ The |print_group| procedure prints the current level of grouping and 2659the name corresponding to |cur_group|. 2660 2661@<Declare \eTeX\ procedures for tr...@>= 2662procedure print_group(@!e:boolean); 2663label exit; 2664begin case cur_group of 2665 bottom_level: begin print("bottom level"); return; 2666 end; 2667 simple_group,semi_simple_group: 2668 begin if cur_group=semi_simple_group then print("semi "); 2669 print("simple"); 2670 end; 2671 hbox_group,adjusted_hbox_group: 2672 begin if cur_group=adjusted_hbox_group then print("adjusted "); 2673 print("hbox"); 2674 end; 2675 vbox_group: print("vbox"); 2676 vtop_group: print("vtop"); 2677 align_group,no_align_group: 2678 begin if cur_group=no_align_group then print("no "); 2679 print("align"); 2680 end; 2681 output_group: print("output"); 2682 disc_group: print("disc"); 2683 insert_group: print("insert"); 2684 vcenter_group: print("vcenter"); 2685 math_group,math_choice_group,math_shift_group,math_left_group: 2686 begin print("math"); 2687 if cur_group=math_choice_group then print(" choice") 2688 else if cur_group=math_shift_group then print(" shift") 2689 else if cur_group=math_left_group then print(" left"); 2690 end; 2691 end; {there are no other cases} 2692print(" group (level "); print_int(qo(cur_level)); print_char(")"); 2693if saved(-1)<>0 then 2694 begin if e then print(" entered at line ") else print(" at line "); 2695 print_int(saved(-1)); 2696 end; 2697exit:end; 2698 2699@ The |group_trace| procedure is called when a new level of grouping 2700begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the 2701line number. 2702 2703@<Declare \eTeX\ procedures for tr...@>= 2704@!stat procedure group_trace(@!e:boolean); 2705begin begin_diagnostic; print_char("{"); 2706if e then print("leaving ") else print("entering "); 2707print_group(e); print_char("}"); end_diagnostic(false); 2708end; 2709tats 2710 2711@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return 2712the current level of grouping and the type of the current group 2713respectively. 2714 2715@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}} 2716@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}} 2717 2718@<Generate all \eTeX...@>= 2719primitive("currentgrouplevel",last_item,current_group_level_code); 2720@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@> 2721primitive("currentgrouptype",last_item,current_group_type_code); 2722@!@:current_group_type_}{\.{\\currentgrouptype} primitive@> 2723 2724@ @<Cases of |last_item| for |print_cmd_chr|@>= 2725current_group_level_code: print_esc("currentgrouplevel"); 2726current_group_type_code: print_esc("currentgrouptype"); 2727 2728@ @<Cases for fetching an integer value@>= 2729current_group_level_code: cur_val:=cur_level-level_one; 2730current_group_type_code: cur_val:=cur_group; 2731 2732@ The \.{\\currentiflevel}, \.{\\currentiftype}, and 2733\.{\\currentifbranch} commands return the current level of conditionals 2734and the type and branch of the current conditional. 2735 2736@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}} 2737@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}} 2738@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}} 2739 2740@<Generate all \eTeX...@>= 2741primitive("currentiflevel",last_item,current_if_level_code); 2742@!@:current_if_level_}{\.{\\currentiflevel} primitive@> 2743primitive("currentiftype",last_item,current_if_type_code); 2744@!@:current_if_type_}{\.{\\currentiftype} primitive@> 2745primitive("currentifbranch",last_item,current_if_branch_code); 2746@!@:current_if_branch_}{\.{\\currentifbranch} primitive@> 2747 2748@ @<Cases of |last_item| for |print_cmd_chr|@>= 2749current_if_level_code: print_esc("currentiflevel"); 2750current_if_type_code: print_esc("currentiftype"); 2751current_if_branch_code: print_esc("currentifbranch"); 2752 2753@ @<Cases for fetching an integer value@>= 2754current_if_level_code: begin q:=cond_ptr; cur_val:=0; 2755 while q<>null do 2756 begin incr(cur_val); q:=link(q); 2757 end; 2758 end; 2759current_if_type_code: if cond_ptr=null then cur_val:=0 2760 else if cur_if<unless_code then cur_val:=cur_if+1 2761 else cur_val:=-(cur_if-unless_code+1); 2762current_if_branch_code: 2763 if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1 2764 else if if_limit=fi_code then cur_val:=-1 2765 else cur_val:=0; 2766 2767@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and 2768\.{\\fontcharic} commands return information about a character in a 2769font. 2770 2771@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}} 2772@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}} 2773@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}} 2774@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}} 2775 2776@<Generate all \eTeX...@>= 2777primitive("fontcharwd",last_item,font_char_wd_code); 2778@!@:font_char_wd_}{\.{\\fontcharwd} primitive@> 2779primitive("fontcharht",last_item,font_char_ht_code); 2780@!@:font_char_ht_}{\.{\\fontcharht} primitive@> 2781primitive("fontchardp",last_item,font_char_dp_code); 2782@!@:font_char_dp_}{\.{\\fontchardp} primitive@> 2783primitive("fontcharic",last_item,font_char_ic_code); 2784@!@:font_char_ic_}{\.{\\fontcharic} primitive@> 2785 2786@ @<Cases of |last_item| for |print_cmd_chr|@>= 2787font_char_wd_code: print_esc("fontcharwd"); 2788font_char_ht_code: print_esc("fontcharht"); 2789font_char_dp_code: print_esc("fontchardp"); 2790font_char_ic_code: print_esc("fontcharic"); 2791 2792@ @<Cases for fetching a dimension value@>= 2793font_char_wd_code, 2794font_char_ht_code, 2795font_char_dp_code, 2796font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num; 2797 if (font_bc(q)<=cur_val)and(font_ec(q)>=cur_val) then 2798 begin i:=char_info(q)(qi(cur_val)); 2799 case m of 2800 font_char_wd_code: cur_val:=char_width(q)(i); 2801 font_char_ht_code: cur_val:=char_height(q)(height_depth(i)); 2802 font_char_dp_code: cur_val:=char_depth(q)(height_depth(i)); 2803 font_char_ic_code: cur_val:=char_italic(q)(i); 2804 end; {there are no other cases} 2805 end 2806 else cur_val:=0; 2807 end; 2808 2809@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength} 2810commands return the indent and length parameters of the current 2811\.{\\parshape} specification. 2812 2813@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}} 2814@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}} 2815@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}} 2816 2817@<Generate all \eTeX...@>= 2818primitive("parshapelength",last_item,par_shape_length_code); 2819@!@:par_shape_length_}{\.{\\parshapelength} primitive@> 2820primitive("parshapeindent",last_item,par_shape_indent_code); 2821@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@> 2822primitive("parshapedimen",last_item,par_shape_dimen_code); 2823@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@> 2824 2825@ @<Cases of |last_item| for |print_cmd_chr|@>= 2826par_shape_length_code: print_esc("parshapelength"); 2827par_shape_indent_code: print_esc("parshapeindent"); 2828par_shape_dimen_code: print_esc("parshapedimen"); 2829 2830@ @<Cases for fetching a dimension value@>= 2831par_shape_length_code, 2832par_shape_indent_code, 2833par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int; 2834 if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0 2835 else begin if q=2 then 2836 begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2; 2837 end; 2838 if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr); 2839 cur_val:=mem[par_shape_ptr+2*cur_val-q].sc; 2840 end; 2841 cur_val_level:=dimen_val; 2842 end; 2843 2844@ The \.{\\showgroups} command displays all currently active grouping 2845levels. 2846 2847@d show_groups=4 { \.{\\showgroups} } 2848 2849@<Generate all \eTeX...@>= 2850primitive("showgroups",xray,show_groups); 2851@!@:show_groups_}{\.{\\showgroups} primitive@> 2852 2853@ @<Cases of |xray| for |print_cmd_chr|@>= 2854show_groups:print_esc("showgroups"); 2855 2856@ @<Cases for |show_whatever|@>= 2857show_groups: begin begin_diagnostic; show_save_groups; 2858 end; 2859 2860@ @<Types...@>= 2861@!save_pointer=0..save_size; {index into |save_stack|} 2862 2863@ The modifications of \TeX\ required for the display produced by the 2864|show_save_groups| procedure were first discussed by Donald~E. Knuth in 2865{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990. 2866@^Knuth, Donald Ervin@> 2867 2868In order to understand a group type we also have to know its mode. 2869Since unrestricted horizontal modes are not associated with grouping, 2870they are skipped when traversing the semantic nest. 2871 2872@<Declare \eTeX\ procedures for use...@>= 2873procedure show_save_groups; 2874label found1,found2,found,done; 2875var p:0..nest_size; {index into |nest|} 2876@!m:-mmode..mmode; {mode} 2877@!v:save_pointer; {saved value of |save_ptr|} 2878@!l:quarterword; {saved value of |cur_level|} 2879@!c:group_code; {saved value of |cur_group|} 2880@!a:-1..1; {to keep track of alignments} 2881@!i:integer; 2882@!j:quarterword; 2883@!s:str_number; 2884begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array} 2885v:=save_ptr; l:=cur_level; c:=cur_group; 2886save_ptr:=cur_boundary; decr(cur_level);@/ 2887a:=1; 2888print_nl(""); print_ln; 2889loop@+begin print_nl("### "); print_group(true); 2890 if cur_group=bottom_level then goto done; 2891 repeat m:=nest[p].mode_field; 2892 if p>0 then decr(p) else m:=vmode; 2893 until m<>hmode; 2894 print(" ("); 2895 case cur_group of 2896 simple_group: begin incr(p); goto found2; 2897 end; 2898 hbox_group,adjusted_hbox_group: s:="hbox"; 2899 vbox_group: s:="vbox"; 2900 vtop_group: s:="vtop"; 2901 align_group: if a=0 then 2902 begin if m=-vmode then s:="halign" else s:="valign"; 2903 a:=1; goto found1; 2904 end 2905 else begin if a=1 then print("align entry") else print_esc("cr"); 2906 if p>=a then p:=p-a; 2907 a:=0; goto found; 2908 end; 2909 no_align_group: 2910 begin incr(p); a:=-1; print_esc("noalign"); goto found2; 2911 end; 2912 output_group: 2913 begin print_esc("output"); goto found; 2914 end; 2915 math_group: goto found2; 2916 disc_group,math_choice_group: 2917 begin if cur_group=disc_group then print_esc("discretionary") 2918 else print_esc("mathchoice"); 2919 for i:=1 to 3 do if i<=saved(-2) then print("{}"); 2920 goto found2; 2921 end; 2922 insert_group: 2923 begin if saved(-2)=255 then print_esc("vadjust") 2924 else begin print_esc("insert"); print_int(saved(-2)); 2925 end; 2926 goto found2; 2927 end; 2928 vcenter_group: begin s:="vcenter"; goto found1; 2929 end; 2930 semi_simple_group: begin incr(p); print_esc("begingroup"); goto found; 2931 end; 2932 math_shift_group: 2933 begin if m=mmode then print_char("$") 2934 else if nest[p].mode_field=mmode then 2935 begin print_cmd_chr(eq_no,saved(-2)); goto found; 2936 end; 2937 print_char("$"); goto found; 2938 end; 2939 math_left_group: 2940 begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left") 2941 else print_esc("middle"); 2942 goto found; 2943 end; 2944 end; {there are no other cases} 2945 @<Show the box context@>; 2946 found1: print_esc(s); @<Show the box packaging info@>; 2947 found2: print_char("{"); 2948 found: print_char(")"); decr(cur_level); 2949 cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr) 2950 end; 2951done: save_ptr:=v; cur_level:=l; cur_group:=c; 2952end; 2953 2954@ @<Show the box packaging info@>= 2955if saved(-2)<>0 then 2956 begin print_char(" "); 2957 if saved(-3)=exactly then print("to") else print("spread"); 2958 print_scaled(saved(-2)); print("pt"); 2959 end 2960 2961@ @<Show the box context@>= 2962i:=saved(-4); 2963if i<>0 then 2964 if i<box_flag then 2965 begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove; 2966 if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); 2967 print_scaled(abs(i)); print("pt"); 2968 end 2969 else if i<ship_out_flag then 2970 begin if i>=global_box_flag then 2971 begin print_esc("global"); i:=i-(global_box_flag-box_flag); 2972 end; 2973 print_esc("setbox"); print_int(i-box_flag); print_char("="); 2974 end 2975 else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders)) 2976 2977@ The |scan_general_text| procedure is much like |scan_toks(false,false)|, 2978but will be invoked via |expand|, i.e., recursively. 2979@^recursion@> 2980 2981@<Declare \eTeX\ procedures for sc...@>= 2982procedure@?scan_general_text; forward;@t\2@> 2983 2984@ The token list (balanced text) created by |scan_general_text| begins 2985at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|, 2986the list is empty.) 2987 2988@<Declare \eTeX\ procedures for tok...@>= 2989procedure scan_general_text; 2990label found; 2991var s:normal..absorbing; {to save |scanner_status|} 2992@!w:pointer; {to save |warning_index|} 2993@!d:pointer; {to save |def_ref|} 2994@!p:pointer; {tail of the token list being built} 2995@!q:pointer; {new node being added to the token list via |store_new_token|} 2996@!unbalance:halfword; {number of unmatched left braces} 2997begin s:=scanner_status; w:=warning_index; d:=def_ref; 2998scanner_status:=absorbing; warning_index:=cur_cs; 2999def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref; 3000scan_left_brace; {remove the compulsory left brace} 3001unbalance:=1; 3002loop@+ begin get_token; 3003 if cur_tok<right_brace_limit then 3004 if cur_cmd<right_brace then incr(unbalance) 3005 else begin decr(unbalance); 3006 if unbalance=0 then goto found; 3007 end; 3008 store_new_token(cur_tok); 3009 end; 3010found: q:=link(def_ref); free_avail(def_ref); {discard reference count} 3011if q=null then cur_val:=temp_head @+ else cur_val:=p; 3012link(temp_head):=q; 3013scanner_status:=s; warning_index:=w; def_ref:=d; 3014end; 3015 3016@ The \.{\\showtokens} command displays a token list. 3017 3018@d show_tokens=5 { \.{\\showtokens} , must be odd! } 3019 3020@<Generate all \eTeX...@>= 3021primitive("showtokens",xray,show_tokens); 3022@!@:show_tokens_}{\.{\\showtokens} primitive@> 3023 3024@ @<Cases of |xray| for |print_cmd_chr|@>= 3025show_tokens:print_esc("showtokens"); 3026 3027@ The \.{\\unexpanded} primitive prevents expansion of tokens much as 3028the result from \.{\\the} applied to a token variable. The 3029\.{\\detokenize} primitive converts a token list into a list of 3030character tokens much as if the token list were written to a file. We 3031use the fact that the command modifiers for \.{\\unexpanded} and 3032\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe} 3033are even. 3034 3035@<Generate all \eTeX...@>= 3036primitive("unexpanded",the,1);@/ 3037@!@:unexpanded_}{\.{\\unexpanded} primitive@> 3038primitive("detokenize",the,show_tokens);@/ 3039@!@:detokenize_}{\.{\\detokenize} primitive@> 3040 3041@ @<Cases of |the| for |print_cmd_chr|@>= 3042else if chr_code=1 then print_esc("unexpanded") 3043else print_esc("detokenize") 3044 3045@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>= 3046if odd(cur_chr) then 3047 begin c:=cur_chr; scan_general_text; 3048 if c=1 then the_toks:=cur_val 3049 else begin old_setting:=selector; selector:=new_string; b:=pool_ptr; 3050 p:=get_avail; link(p):=link(temp_head); 3051 token_show(p); flush_list(p); 3052 selector:=old_setting; the_toks:=str_toks(b); 3053 end; 3054 return; 3055 end 3056 3057@ The \.{\\showifs} command displays all currently active conditionals. 3058 3059@d show_ifs=6 { \.{\\showifs} } 3060 3061@<Generate all \eTeX...@>= 3062primitive("showifs",xray,show_ifs); 3063@!@:show_ifs_}{\.{\\showifs} primitive@> 3064 3065@ @<Cases of |xray| for |print_cmd_chr|@>= 3066show_ifs:print_esc("showifs"); 3067 3068@ 3069@d print_if_line(#)==if #<>0 then 3070 begin print(" entered on line "); print_int(#); 3071 end 3072 3073@<Cases for |show_whatever|@>= 3074show_ifs: begin begin_diagnostic; print_nl(""); print_ln; 3075 if cond_ptr=null then 3076 begin print_nl("### "); print("no active conditionals"); 3077 end 3078 else begin p:=cond_ptr; n:=0; 3079 repeat incr(n); p:=link(p);@+until p=null; 3080 p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit; 3081 repeat print_nl("### level "); print_int(n); print(": "); 3082 print_cmd_chr(if_test,t); 3083 if m=fi_code then print_esc("else"); 3084 print_if_line(l); 3085 decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p); 3086 until p=null; 3087 end; 3088 end; 3089 3090@ The \.{\\interactionmode} primitive allows to query and set the 3091interaction mode. 3092 3093@<Generate all \eTeX...@>= 3094primitive("interactionmode",set_page_int,2); 3095@!@:interaction_mode_}{\.{\\interactionmode} primitive@> 3096 3097@ @<Cases of |set_page_int| for |print_cmd_chr|@>= 3098else if chr_code=2 then print_esc("interactionmode") 3099 3100@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>= 3101else if m=2 then cur_val:=interaction 3102 3103@ @<Declare \eTeX\ procedures for use...@>= 3104procedure@?new_interaction; forward;@t\2@> 3105 3106@ @<Cases for |alter_integer|@>= 3107else if c=2 then 3108 begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then 3109 begin print_err("Bad interaction mode"); 3110@.Bad interaction mode@> 3111 help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/ 3112 ("3=errorstop. Proceed, and I'll ignore this case."); 3113 int_error(cur_val); 3114 end 3115 else begin cur_chr:=cur_val; new_interaction; 3116 end; 3117 end 3118 3119@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle} 3120delimiters to appear between \.{\\left} and \.{\\right}. 3121 3122@<Generate all \eTeX...@>= 3123primitive("middle",left_right,middle_noad); 3124@!@:middle_}{\.{\\middle} primitive@> 3125 3126@ @<Cases of |left_right| for |print_cmd_chr|@>= 3127else if chr_code=middle_noad then print_esc("middle") 3128 3129@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens} 3130primitive. 3131 3132@<Generate all \eTeX...@>= 3133primitive("scantokens",input,2); 3134@!@:scan_tokens_}{\.{\\scantokens} primitive@> 3135 3136@ @<Cases of |input| for |print_cmd_chr|@>= 3137else if chr_code=2 then print_esc("scantokens") 3138 3139@ @<Cases for |input|@>= 3140else if cur_chr=2 then pseudo_start 3141 3142@ The global variable |pseudo_files| is used to maintain a stack of 3143pseudo files. The |info| field of each pseudo file points to a linked 3144list of variable size nodes representing lines not yet processed: the 3145|info| field of the first word contains the size of this node, all the 3146following words contain ASCII codes. 3147 3148@<Glob...@>= 3149@!pseudo_files:pointer; {stack of pseudo files} 3150 3151@ @<Set init...@>= 3152pseudo_files:=null; 3153 3154@ The |pseudo_start| procedure initiates reading from a pseudo file. 3155 3156@<Declare \eTeX\ procedures for ex...@>= 3157procedure@?pseudo_start; forward;@t\2@> 3158 3159@ @<Declare \eTeX\ procedures for tok...@>= 3160procedure pseudo_start; 3161var old_setting:0..max_selector; {holds |selector| setting} 3162@!s:str_number; {string to be converted into a pseudo file} 3163@!l,@!m:pool_pointer; {indices into |str_pool|} 3164@!p,@!q,@!r:pointer; {for list construction} 3165@!w: four_quarters; {four ASCII codes} 3166@!nl,@!sz:integer; 3167begin scan_general_text; 3168old_setting:=selector; selector:=new_string; 3169token_show(temp_head); selector:=old_setting; 3170flush_list(link(temp_head)); 3171str_room(1); s:=make_string; 3172@<Convert string |s| into a new pseudo file@>; 3173flush_string; 3174@<Initiate input from new pseudo file@>; 3175end; 3176 3177@ @<Convert string |s| into a new pseudo file@>= 3178str_pool[pool_ptr]:=si(" "); l:=str_start(s); 3179nl:=si(new_line_char); 3180p:=get_avail; q:=p; 3181while l<pool_ptr do 3182 begin m:=l; 3183 while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l); 3184 sz:=(l-m+7)div 4; 3185 if sz=1 then sz:=2; 3186 r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz); 3187 while sz>2 do 3188 begin decr(sz); incr(r); 3189 w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1])); 3190 w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3])); 3191 mem[r].qqqq:=w; m:=m+4; 3192 end; 3193 w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" "); 3194 if l>m then 3195 begin w.b0:=qi(so(str_pool[m])); 3196 if l>m+1 then 3197 begin w.b1:=qi(so(str_pool[m+1])); 3198 if l>m+2 then 3199 begin w.b2:=qi(so(str_pool[m+2])); 3200 if l>m+3 then w.b3:=qi(so(str_pool[m+3])); 3201 end; 3202 end; 3203 end; 3204 mem[r+1].qqqq:=w; 3205 if str_pool[l]=nl then incr(l); 3206 end; 3207info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p 3208 3209@ @<Initiate input from new pseudo file@>= 3210begin_file_reading; {set up |cur_file| and new level of input} 3211line:=0; limit:=start; loc:=limit+1; {force line read} 3212if tracing_scan_tokens>0 then 3213 begin if term_offset>max_print_line-3 then print_ln 3214 else if (term_offset>0)or(file_offset>0) then print_char(" "); 3215 name:=19; print("( "); incr(open_parens); update_terminal; 3216 end 3217else name:=18 3218 3219@ Here we read a line from the current pseudo file into |buffer|. 3220 3221@<Declare \eTeX\ procedures for tr...@>= 3222function pseudo_input: boolean; {inputs the next line or returns |false|} 3223var p:pointer; {current line from pseudo file} 3224@!sz:integer; {size of node |p|} 3225@!w:four_quarters; {four ASCII codes} 3226@!r:pointer; {loop index} 3227begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} 3228p:=info(pseudo_files); 3229if p=null then pseudo_input:=false 3230else begin info(pseudo_files):=link(p); sz:=ho(info(p)); 3231 if 4*sz-3>=buf_size-last then 3232 @<Report overflow of the input buffer, and abort@>; 3233 last:=first; 3234 for r:=p+1 to p+sz-1 do 3235 begin w:=mem[r].qqqq; 3236 buffer[last]:=w.b0; buffer[last+1]:=w.b1; 3237 buffer[last+2]:=w.b2; buffer[last+3]:=w.b3; 3238 last:=last+4; 3239 end; 3240 if last>=max_buf_stack then max_buf_stack:=last+1; 3241 while (last>first)and(buffer[last-1]=" ") do decr(last); 3242 free_node(p,sz); 3243 pseudo_input:=true; 3244 end; 3245end; 3246 3247@ When we are done with a pseudo file we `close' it. 3248 3249@<Declare \eTeX\ procedures for tr...@>= 3250procedure pseudo_close; {close the top level pseudo file} 3251var p,@!q: pointer; 3252begin p:=link(pseudo_files); q:=info(pseudo_files); 3253free_avail(pseudo_files); pseudo_files:=p; 3254while q<>null do 3255 begin p:=q; q:=link(p); free_node(p,ho(info(p))); 3256 end; 3257end; 3258 3259@ @<Dump the \eTeX\ state@>= 3260while pseudo_files<>null do pseudo_close; {flush pseudo files} 3261 3262@ @<Generate all \eTeX...@>= 3263primitive("readline",read_to_cs,1);@/ 3264@!@:read_line_}{\.{\\readline} primitive@> 3265 3266@ @<Cases of |read| for |print_cmd_chr|@>= 3267else print_esc("readline") 3268 3269@ @<Handle \.{\\readline} and |goto done|@>= 3270if j=1 then 3271 begin while loc<=limit do {current line not yet finished} 3272 begin cur_chr:=buffer[loc]; incr(loc); 3273 if cur_chr=" " then cur_tok:=space_token 3274 @+else cur_tok:=cur_chr+other_token; 3275 store_new_token(cur_tok); 3276 end; 3277 goto done; 3278 end 3279 3280@ Here we define the additional conditionals of \eTeX\ as well as the 3281\.{\\unless} prefix. 3282 3283@d if_def_code=17 { `\.{\\ifdefined}' } 3284@d if_cs_code=18 { `\.{\\ifcsname}' } 3285@d if_font_char_code=19 { `\.{\\iffontchar}' } 3286 3287@<Generate all \eTeX...@>= 3288primitive("unless",expand_after,1);@/ 3289@!@:unless_}{\.{\\unless} primitive@> 3290primitive("ifdefined",if_test,if_def_code); 3291@!@:if_defined_}{\.{\\ifdefined} primitive@> 3292primitive("ifcsname",if_test,if_cs_code); 3293@!@:if_cs_name_}{\.{\\ifcsname} primitive@> 3294primitive("iffontchar",if_test,if_font_char_code); 3295@!@:if_font_char_}{\.{\\iffontchar} primitive@> 3296 3297@ @<Cases of |expandafter| for |print_cmd_chr|@>= 3298else print_esc("unless") 3299 3300@ @<Cases of |if_test| for |print_cmd_chr|@>= 3301if_def_code:print_esc("ifdefined"); 3302if_cs_code:print_esc("ifcsname"); 3303if_font_char_code:print_esc("iffontchar"); 3304 3305@ The result of a boolean condition is reversed when the conditional is 3306preceded by \.{\\unless}. 3307 3308@<Negate a boolean conditional and |goto reswitch|@>= 3309begin get_token; 3310if (cur_cmd=if_test)and(cur_chr<>if_case_code) then 3311 begin cur_chr:=cur_chr+unless_code; goto reswitch; 3312 end; 3313print_err("You can't use `"); print_esc("unless"); print("' before `"); 3314@.You can't use \\unless...@> 3315print_cmd_chr(cur_cmd,cur_chr); print_char("'"); 3316help1("Continue, and I'll forget that it ever happened."); 3317back_error; 3318end 3319 3320@ The conditional \.{\\ifdefined} tests if a control sequence is 3321defined. 3322 3323We need to reset |scanner_status|, since \.{\\outer} control sequences 3324are allowed, but we might be scanning a macro definition or preamble. 3325 3326@<Cases for |conditional|@>= 3327if_def_code:begin save_scanner_status:=scanner_status; 3328 scanner_status:=normal; 3329 get_next; b:=(cur_cmd<>undefined_cs); 3330 scanner_status:=save_scanner_status; 3331 end; 3332 3333@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter} 3334\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new 3335control sequence will be entered into the hash table (once all tokens 3336preceding the mandatory \.{\\endcsname} have been expanded). 3337 3338@<Cases for |conditional|@>= 3339if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} 3340 repeat get_x_token; 3341 if cur_cs=0 then store_new_token(cur_tok); 3342 until cur_cs<>0; 3343 if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>; 3344 @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>; 3345 flush_list(n); 3346 b:=(eq_type(cur_cs)<>undefined_cs); 3347 end; 3348 3349@ @<Look up the characters of list |n| in the hash table...@>= 3350m:=first; p:=link(n); 3351while p<>null do 3352 begin if m>=max_buf_stack then 3353 begin max_buf_stack:=m+1; 3354 if max_buf_stack=buf_size then 3355 overflow("buffer size",buf_size); 3356@:TeX capacity exceeded buffer size}{\quad buffer size@> 3357 end; 3358 buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); 3359 end; 3360if m>first+1 then 3361 cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|} 3362else if m=first then cur_cs:=null_cs {the list is empty} 3363else cur_cs:=single_base+buffer[first] {the list has length one} 3364 3365@ The conditional \.{\\iffontchar} tests the existence of a character in 3366a font. 3367 3368@<Cases for |conditional|@>= 3369if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num; 3370 if (font_bc(n)<=cur_val)and(font_ec(n)>=cur_val) then 3371 b:=char_exists(char_info(n)(qi(cur_val))) 3372 else b:=false; 3373 end; 3374 3375@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix 3376command for macro definitions. Such macros are protected against 3377expansions when lists of expanded tokens are built, e.g., for \.{\\edef} 3378or during \.{\\write}. 3379 3380@<Generate all \eTeX...@>= 3381primitive("protected",prefix,8); 3382@!@:protected_}{\.{\\protected} primitive@> 3383 3384@ @<Cases of |prefix| for |print_cmd_chr|@>= 3385else if chr_code=8 then print_esc("protected") 3386 3387@ The |get_x_or_protected| procedure is like |get_x_token| except that 3388protected macros are not expanded. 3389 3390@<Declare \eTeX\ procedures for sc...@>= 3391procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|, 3392 and expands non-protected macros} 3393label exit; 3394begin loop@+begin get_token; 3395 if cur_cmd<=max_command then return; 3396 if (cur_cmd>=call)and(cur_cmd<end_template) then 3397 if info(link(cur_chr))=protected_token then return; 3398 expand; 3399 end; 3400exit:end; 3401 3402@ A group entered (or a conditional started) in one file may end in a 3403different file. Such slight anomalies, although perfectly legitimate, 3404may cause errors that are difficult to locate. In order to be able to 3405give a warning message when such anomalies occur, \eTeX\ uses the 3406|grp_stack| and |if_stack| arrays to record the initial |cur_boundary| 3407and |cond_ptr| values for each input file. 3408 3409@<Glob...@>= 3410@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|} 3411@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|} 3412 3413@ When a group ends that was apparently entered in a different input 3414file, the |group_warning| procedure is invoked in order to update the 3415|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to 3416give a warning message. The situation is, however, somewhat complicated 3417by two facts: (1)~There may be |grp_stack| elements without a 3418corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g., 3419error insertions from the terminal); and (2)~the relevant information is 3420recorded in the |name_field| of the |input_stack| only loosely 3421synchronized with the |in_open| variable indexing |grp_stack|. 3422 3423@<Declare \eTeX\ procedures for tr...@>= 3424procedure group_warning; 3425var i:0..max_in_open; {index into |grp_stack|} 3426@!w:boolean; {do we need a warning?} 3427begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; 3428 {store current state} 3429i:=in_open; w:=false; 3430while (grp_stack[i]=cur_boundary)and(i>0) do 3431 begin @<Set variable |w| to indicate if this case should be reported@>; 3432 grp_stack[i]:=save_index(save_ptr); decr(i); 3433 end; 3434if w then 3435 begin print_nl("Warning: end of "); print_group(true); 3436@.Warning: end of...@> 3437 print(" of a different file"); print_ln; 3438 if tracing_nesting>1 then show_context; 3439 if history=spotless then history:=warning_issued; 3440 end; 3441end; 3442 3443@ This code scans the input stack in order to determine the type of the 3444current input file. 3445 3446@<Set variable |w| to...@>= 3447if tracing_nesting>0 then 3448 begin while (input_stack[base_ptr].state_field=token_list)or@| 3449 (input_stack[base_ptr].index_field>i) do decr(base_ptr); 3450 if input_stack[base_ptr].name_field>17 then w:=true; 3451 end 3452 3453@ When a conditional ends that was apparently started in a different 3454input file, the |if_warning| procedure is invoked in order to update the 3455|if_stack|. If moreover \.{\\tracingnesting} is positive we want to 3456give a warning message (with the same complications as above). 3457 3458@<Declare \eTeX\ procedures for tr...@>= 3459procedure if_warning; 3460var i:0..max_in_open; {index into |if_stack|} 3461@!w:boolean; {do we need a warning?} 3462begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; 3463 {store current state} 3464i:=in_open; w:=false; 3465while if_stack[i]=cond_ptr do 3466 begin @<Set variable |w| to...@>; 3467 if_stack[i]:=link(cond_ptr); decr(i); 3468 end; 3469if w then 3470 begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if); 3471@.Warning: end of...@> 3472 print_if_line(if_line); print(" of a different file"); print_ln; 3473 if tracing_nesting>1 then show_context; 3474 if history=spotless then history:=warning_issued; 3475 end; 3476end; 3477 3478@ Conversely, the |file_warning| procedure is invoked when a file ends 3479and some groups entered or conditionals started while reading from that 3480file are still incomplete. 3481 3482@<Declare \eTeX\ procedures for tr...@>= 3483procedure file_warning; 3484var p:pointer; {saved value of |save_ptr| or |cond_ptr|} 3485@!l:quarterword; {saved value of |cur_level| or |if_limit|} 3486@!c:quarterword; {saved value of |cur_group| or |cur_if|} 3487@!i:integer; {saved value of |if_line|} 3488begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary; 3489while grp_stack[in_open]<>save_ptr do 3490 begin decr(cur_level); 3491 print_nl("Warning: end of file when "); 3492@.Warning: end of file when...@> 3493 print_group(true); print(" is incomplete");@/ 3494 cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr) 3495 end; 3496save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values} 3497p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line; 3498while if_stack[in_open]<>cond_ptr do 3499 begin print_nl("Warning: end of file when "); 3500@.Warning: end of file when...@> 3501 print_cmd_chr(if_test,cur_if); 3502 if if_limit=fi_code then print_esc("else"); 3503 print_if_line(if_line); print(" is incomplete");@/ 3504 if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr); 3505 if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr); 3506 end; 3507cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values} 3508print_ln; 3509if tracing_nesting>1 then show_context; 3510if history=spotless then history:=warning_issued; 3511end; 3512 3513@ Here are the additional \eTeX\ primitives for expressions. 3514 3515@<Generate all \eTeX...@>= 3516primitive("numexpr",last_item,eTeX_expr-int_val+int_val); 3517@!@:num_expr_}{\.{\\numexpr} primitive@> 3518primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val); 3519@!@:dim_expr_}{\.{\\dimexpr} primitive@> 3520primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val); 3521@!@:glue_expr_}{\.{\\glueexpr} primitive@> 3522primitive("muexpr",last_item,eTeX_expr-int_val+mu_val); 3523@!@:mu_expr_}{\.{\\muexpr} primitive@> 3524 3525@ @<Cases of |last_item| for |print_cmd_chr|@>= 3526eTeX_expr-int_val+int_val: print_esc("numexpr"); 3527eTeX_expr-int_val+dimen_val: print_esc("dimexpr"); 3528eTeX_expr-int_val+glue_val: print_esc("glueexpr"); 3529eTeX_expr-int_val+mu_val: print_esc("muexpr"); 3530 3531@ This code for reducing |cur_val_level| and\slash or negating the 3532result is similar to the one for all the other cases of 3533|scan_something_internal|, with the difference that |scan_expr| has 3534already increased the reference count of a glue specification. 3535 3536@<Process an expression and |return|@>= 3537begin if m<eTeX_mu then 3538 begin case m of 3539 @/@<Cases for fetching a glue value@>@/ 3540 end; {there are no other cases} 3541 cur_val_level:=glue_val; 3542 end 3543else if m<eTeX_expr then 3544 begin case m of 3545 @/@<Cases for fetching a mu value@>@/ 3546 end; {there are no other cases} 3547 cur_val_level:=mu_val; 3548 end 3549else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr; 3550 end; 3551while cur_val_level>level do 3552 begin if cur_val_level=glue_val then 3553 begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m); 3554 end 3555 else if cur_val_level=mu_val then mu_error; 3556 decr(cur_val_level); 3557 end; 3558if negative then 3559 if cur_val_level>=glue_val then 3560 begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m); 3561 @<Negate all three glue components of |cur_val|@>; 3562 end 3563 else negate(cur_val); 3564return; 3565end 3566 3567@ @<Declare \eTeX\ procedures for sc...@>= 3568procedure@?scan_expr; forward;@t\2@> 3569 3570@ The |scan_expr| procedure scans and evaluates an expression. 3571 3572@<Declare procedures needed for expressions@>= 3573@t\4@>@<Declare subprocedures for |scan_expr|@> 3574procedure scan_expr; {scans and evaluates an expression} 3575label restart, continue, found; 3576var a,@!b:boolean; {saved values of |arith_error|} 3577@!l:small_number; {type of expression} 3578@!r:small_number; {state of expression so far} 3579@!s:small_number; {state of term so far} 3580@!o:small_number; {next operation or type of next factor} 3581@!e:integer; {expression so far} 3582@!t:integer; {term so far} 3583@!f:integer; {current factor} 3584@!n:integer; {numerator of combined multiplication and division} 3585@!p:pointer; {top of expression stack} 3586@!q:pointer; {for stack manipulations} 3587begin l:=cur_val_level; a:=arith_error; b:=false; p:=null; 3588@<Scan and evaluate an expression |e| of type |l|@>; 3589if b then 3590 begin print_err("Arithmetic overflow"); 3591@.Arithmetic overflow@> 3592 help2("I can't evaluate this expression,")@/ 3593 ("since the result is out of range."); 3594 error; 3595 if l>=glue_val then 3596 begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e); 3597 end 3598 else e:=0; 3599 end; 3600arith_error:=a; cur_val:=e; cur_val_level:=l; 3601end; 3602 3603@ Evaluating an expression is a recursive process: When the left 3604parenthesis of a subexpression is scanned we descend to the next level 3605of recursion; the previous level is resumed with the matching right 3606parenthesis. 3607 3608@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen} 3609@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen} 3610@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen} 3611@d expr_mult=3 {$\langle\it term\rangle$ \.* seen} 3612@d expr_div=4 {$\langle\it term\rangle$ \./ seen} 3613@d expr_scale=5 {$\langle\it term\rangle$ \.* 3614 $\langle\it factor\rangle$ \./ seen} 3615 3616@<Scan and eval...@>= 3617restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0; 3618continue: if s=expr_none then o:=l@+else o:=int_val; 3619@<Scan a factor |f| of type |o| or start a subexpression@>; 3620found: @<Scan the next operator and set |o|@>; 3621arith_error:=b; 3622@<Make sure that |f| is in the proper range@>; 3623case s of @<Cases for evaluation of the current term@>@; 3624end; {there are no other cases} 3625if o>expr_sub then s:=o@+else @<Evaluate the current expression@>; 3626b:=arith_error; 3627if o<>expr_none then goto continue; 3628if p<>null then @<Pop the expression stack and |goto found|@> 3629 3630@ @<Scan the next op...@>= 3631@<Get the next non-blank non-call token@>; 3632if cur_tok=other_token+"+" then o:=expr_add 3633else if cur_tok=other_token+"-" then o:=expr_sub 3634else if cur_tok=other_token+"*" then o:=expr_mult 3635else if cur_tok=other_token+"/" then o:=expr_div 3636else begin o:=expr_none; 3637 if p=null then 3638 begin if cur_cmd<>relax then back_input; 3639 end 3640 else if cur_tok<>other_token+")" then 3641 begin print_err("Missing ) inserted for expression"); 3642@.Missing ) inserted@> 3643 help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't."); 3644 back_error; 3645 end; 3646 end 3647 3648@ @<Scan a factor...@>= 3649@<Get the next non-blank non-call token@>; 3650if cur_tok=other_token+"(" then 3651 @<Push the expression stack and |goto restart|@>; 3652back_input; 3653if o=int_val then scan_int 3654else if o=dimen_val then scan_normal_dimen 3655else if o=glue_val then scan_normal_glue 3656else scan_mu_glue; 3657f:=cur_val 3658 3659@ @<Declare \eTeX\ procedures for sc...@>= 3660procedure@?scan_normal_glue; forward;@t\2@>@/ 3661procedure@?scan_mu_glue; forward;@t\2@> 3662 3663@ Here we declare two trivial procedures in order to avoid mutually 3664recursive procedures with parameters. 3665 3666@<Declare procedures needed for expressions@>= 3667procedure scan_normal_glue; 3668begin scan_glue(glue_val); 3669end; 3670@# 3671procedure scan_mu_glue; 3672begin scan_glue(mu_val); 3673end; 3674 3675@ Parenthesized subexpressions can be inside expressions, and this 3676nesting has a stack. Seven local variables represent the top of the 3677expression stack: |p| points to pushed-down entries, if any; |l| 3678specifies the type of expression currently beeing evaluated; |e| is the 3679expression so far and |r| is the state of its evaluation; |t| is the 3680term so far and |s| is the state of its evaluation; finally |n| is the 3681numerator for a combined multiplication and division, if any. 3682 3683@d expr_node_size=4 {number of words in stack entry for subexpressions} 3684@d expr_e_field(#)==mem[#+1].int {saved expression so far} 3685@d expr_t_field(#)==mem[#+2].int {saved term so far} 3686@d expr_n_field(#)==mem[#+3].int {saved numerator} 3687 3688@<Push the expression...@>= 3689begin q:=get_node(expr_node_size); link(q):=p; type(q):=l; 3690subtype(q):=4*s+r; 3691expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n; 3692p:=q; l:=o; goto restart; 3693end 3694 3695@ @<Pop the expression...@>= 3696begin f:=e; q:=p; 3697e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q); 3698s:=subtype(q) div 4; r:=subtype(q) mod 4; 3699l:=type(q); p:=link(q); free_node(q,expr_node_size); 3700goto found; 3701end 3702 3703@ We want to make sure that each term and (intermediate) result is in 3704the proper range. Integer values must not exceed |infinity| 3705($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen| 3706($2^{30}-1$). We avoid the absolute value of an integer, because this 3707might fail for the value $-2^{31}$ using 32-bit arithmetic. 3708 3709@d num_error(#)== {clear a number or dimension and set |arith_error|} 3710 begin arith_error:=true; #:=0; 3711 end 3712@d glue_error(#)== {clear a glue spec and set |arith_error|} 3713 begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue); 3714 end 3715 3716@<Make sure that |f|...@>= 3717if (l=int_val)or(s>expr_sub) then 3718 begin if (f>infinity)or(f<-infinity) then num_error(f); 3719 end 3720else if l=dimen_val then 3721 begin if abs(f)>max_dimen then num_error(f); 3722 end 3723else begin if (abs(width(f))>max_dimen)or@| 3724 (abs(stretch(f))>max_dimen)or@| 3725 (abs(shrink(f))>max_dimen) then glue_error(f); 3726 end 3727 3728@ Applying the factor |f| to the partial term |t| (with the operator 3729|s|) is delayed until the next operator |o| has been scanned. Here we 3730handle the first factor of a partial term. A glue spec has to be copied 3731unless the next operator is a right parenthesis; this allows us later on 3732to simply modify the glue components. 3733 3734@d normalize_glue(#)== 3735 if stretch(#)=0 then stretch_order(#):=normal; 3736 if shrink(#)=0 then shrink_order(#):=normal 3737 3738@<Cases for evaluation of the current term@>= 3739expr_none: if (l>=glue_val)and(o<>expr_none) then 3740 begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t); 3741 end 3742 else t:=f; 3743 3744@ When a term |t| has been completed it is copied to, added to, or 3745subtracted from the expression |e|. 3746 3747@d expr_add_sub(#)==add_or_sub(#,r=expr_sub) 3748@d expr_a(#)==expr_add_sub(#,max_dimen) 3749 3750@<Evaluate the current expression@>= 3751begin s:=expr_none; 3752if r=expr_none then e:=t 3753else if l=int_val then e:=expr_add_sub(e,t,infinity) 3754else if l=dimen_val then e:=expr_a(e,t) 3755else @<Compute the sum or difference of two glue specs@>; 3756r:=o; 3757end 3758 3759@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum 3760(for |negative=false|) or difference (for |negative=true|) of |x| and 3761|y|, provided the absolute value of the result does not exceed 3762|max_answer|. 3763 3764@<Declare subprocedures for |scan_expr|@>= 3765function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer; 3766var a:integer; {the answer} 3767begin if negative then negate(y); 3768if x>=0 then 3769 if y<=max_answer-x then a:=x+y@+else num_error(a) 3770else if y>=-max_answer-x then a:=x+y@+else num_error(a); 3771add_or_sub:=a; 3772end; 3773 3774@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and 3775|shrink_order(e)>normal| implies |shrink(e)<>0|. 3776 3777@<Compute the sum or diff...@>= 3778begin width(e):=expr_a(width(e),width(t)); 3779if stretch_order(e)=stretch_order(t) then 3780 stretch(e):=expr_a(stretch(e),stretch(t)) 3781else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then 3782 begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t); 3783 end; 3784if shrink_order(e)=shrink_order(t) then 3785 shrink(e):=expr_a(shrink(e),shrink(t)) 3786else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then 3787 begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t); 3788 end; 3789delete_glue_ref(t); normalize_glue(e); 3790end 3791 3792@ If a multiplication is followed by a division, the two operations are 3793combined into a `scaling' operation. Otherwise the term |t| is 3794multiplied by the factor |f|. 3795 3796@d expr_m(#)==#:=nx_plus_y(#,f,0) 3797 3798@<Cases for evaluation of the current term@>= 3799expr_mult: if o=expr_div then 3800 begin n:=f; o:=expr_scale; 3801 end 3802 else if l=int_val then t:=mult_integers(t,f) 3803 else if l=dimen_val then expr_m(t) 3804 else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t)); 3805 end; 3806 3807@ Here we divide the term |t| by the factor |f|. 3808 3809@d expr_d(#)==#:=quotient(#,f) 3810 3811@<Cases for evaluation of the current term@>= 3812expr_div: if l<glue_val then expr_d(t) 3813 else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t)); 3814 end; 3815 3816@ The function |quotient(n,d)| computes the rounded quotient 3817$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive. 3818 3819@<Declare subprocedures for |scan_expr|@>= 3820function quotient(@!n,@!d:integer):integer; 3821var negative:boolean; {should the answer be negated?} 3822@!a:integer; {the answer} 3823begin if d=0 then num_error(a) 3824else begin if d>0 then negative:=false 3825 else begin negate(d); negative:=true; 3826 end; 3827 if n<0 then 3828 begin negate(n); negative:=not negative; 3829 end; 3830 a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!} 3831 if d+n>=0 then incr(a); 3832 if negative then negate(a); 3833 end; 3834quotient:=a; 3835end; 3836 3837@ Here the term |t| is multiplied by the quotient $n/f$. 3838 3839@d expr_s(#)==#:=fract(#,n,f,max_dimen) 3840 3841@<Cases for evaluation of the current term@>= 3842expr_scale: if l=int_val then t:=fract(t,n,f,infinity) 3843 else if l=dimen_val then expr_s(t) 3844 else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t)); 3845 end; 3846 3847@ Finally, the function |fract(x,n,d,max_answer)| computes the integer 3848$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive 3849and the result does not exceed |max_answer|. We can't use floating 3850point arithmetic since the routine must produce identical results in all 3851cases; and it would be too dangerous to multiply by~|n| and then divide 3852by~|d|, in separate operations, since overflow might well occur. Hence 3853this subroutine simulates double precision arithmetic, somewhat 3854analogous to \MF's |make_fraction| and |take_fraction| routines. 3855 3856@d too_big=88 {go here when the result is too big} 3857 3858@<Declare subprocedures for |scan_expr|@>= 3859function fract(@!x,@!n,@!d,@!max_answer:integer):integer; 3860label found, found1, too_big, done; 3861var negative:boolean; {should the answer be negated?} 3862@!a:integer; {the answer} 3863@!f:integer; {a proper fraction} 3864@!h:integer; {smallest integer such that |2*h>=d|} 3865@!r:integer; {intermediate remainder} 3866@!t:integer; {temp variable} 3867begin if d=0 then goto too_big; 3868a:=0; 3869if d>0 then negative:=false 3870else begin negate(d); negative:=true; 3871 end; 3872if x<0 then 3873 begin negate(x); negative:=not negative; 3874 end 3875else if x=0 then goto done; 3876if n<0 then 3877 begin negate(n); negative:=not negative; 3878 end; 3879t:=n div d; 3880if t>max_answer div x then goto too_big; 3881a:=t*x; n:=n-t*d; 3882if n=0 then goto found; 3883t:=x div d; 3884if t>(max_answer-a) div n then goto too_big; 3885a:=a+t*n; x:=x-t*d; 3886if x=0 then goto found; 3887if x<n then 3888 begin t:=x; x:=n; n:=t; 3889 end; {now |0<n<=x<d|} 3890@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@; 3891if f>(max_answer-a) then goto too_big; 3892a:=a+f; 3893found: if negative then negate(a); 3894goto done; 3895too_big: num_error(a); 3896done: fract:=a; 3897end; 3898 3899@ The loop here preserves the following invariant relations 3900between |f|, |x|, |n|, and~|r|: 3901(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$; 3902(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$ 3903and $n$. 3904 3905Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|, 3906because the latter could overflow. 3907 3908@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>= 3909f:=0; r:=(d div 2)-d; h:=-r; 3910loop@+begin if odd(n) then 3911 begin r:=r+x; 3912 if r>=0 then 3913 begin r:=r-d; incr(f); 3914 end; 3915 end; 3916 n:=n div 2; 3917 if n=0 then goto found1; 3918 if x<h then x:=x+x 3919 else begin t:=x-d; x:=t+x; f:=f+n; 3920 if x<n then 3921 begin if x=0 then goto found1; 3922 t:=x; x:=n; n:=t; 3923 end; 3924 end; 3925 end; 3926found1: 3927 3928@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and 3929\.{\\glueshrinkorder} commands return the stretch and shrink components 3930and their orders of ``infinity'' of a glue specification. 3931 3932@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}} 3933@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}} 3934@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}} 3935@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}} 3936 3937@<Generate all \eTeX...@>= 3938primitive("gluestretchorder",last_item,glue_stretch_order_code); 3939@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@> 3940primitive("glueshrinkorder",last_item,glue_shrink_order_code); 3941@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@> 3942primitive("gluestretch",last_item,glue_stretch_code); 3943@!@:glue_stretch_}{\.{\\gluestretch} primitive@> 3944primitive("glueshrink",last_item,glue_shrink_code); 3945@!@:glue_shrink_}{\.{\\glueshrink} primitive@> 3946 3947@ @<Cases of |last_item| for |print_cmd_chr|@>= 3948glue_stretch_order_code: print_esc("gluestretchorder"); 3949glue_shrink_order_code: print_esc("glueshrinkorder"); 3950glue_stretch_code: print_esc("gluestretch"); 3951glue_shrink_code: print_esc("glueshrink"); 3952 3953@ @<Cases for fetching an integer value@>= 3954glue_stretch_order_code, glue_shrink_order_code: 3955 begin scan_normal_glue; q:=cur_val; 3956 if m=glue_stretch_order_code then cur_val:=stretch_order(q) 3957 else cur_val:=shrink_order(q); 3958 delete_glue_ref(q); 3959 end; 3960 3961@ @<Cases for fetching a dimension value@>= 3962glue_stretch_code, glue_shrink_code: 3963 begin scan_normal_glue; q:=cur_val; 3964 if m=glue_stretch_code then cur_val:=stretch(q) 3965 else cur_val:=shrink(q); 3966 delete_glue_ref(q); 3967 end; 3968 3969@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue 3970into normal glue and vice versa; they allow to manipulate math glue with 3971\.{\\gluestretch} etc. 3972 3973@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}} 3974@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}} 3975 3976@<Generate all \eTeX...@>= 3977primitive("mutoglue",last_item,mu_to_glue_code); 3978@!@:mu_to_glue_}{\.{\\mutoglue} primitive@> 3979primitive("gluetomu",last_item,glue_to_mu_code); 3980@!@:glue_to_mu_}{\.{\\gluetomu} primitive@> 3981 3982@ @<Cases of |last_item| for |print_cmd_chr|@>= 3983mu_to_glue_code: print_esc("mutoglue"); 3984glue_to_mu_code: print_esc("gluetomu"); 3985 3986@ @<Cases for fetching a glue value@>= 3987mu_to_glue_code: scan_mu_glue; 3988 3989@ @<Cases for fetching a mu value@>= 3990glue_to_mu_code: scan_normal_glue; 3991 3992{ FIXME: next chapter is about sparse arrays; how does it cope with Omega? } 3993 3994@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count, 3995dimen, skip, muskip, box, and token registers. As in \TeX\ the first 3996256 registers of each kind are realized as arrays in the table of 3997equivalents; the additional registers are realized as tree structures 3998built from variable-size nodes with individual registers existing only 3999when needed. Default values are used for nonexistent registers: zero 4000for count and dimen values, |zero_glue| for glue (skip and muskip) 4001values, void for boxes, and |null| for token lists (and current marks 4002discussed below). 4003 4004Similarly there are 32768 mark classes; the command \.{\\marks}|n| 4005creates a mark node for a given mark class |0<=n<=32767| (where 4006\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually 4007the |fire_up| routine) and the |vsplit| routine maintain the current 4008values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and 4009|split_bot_mark| for each mark class. They are accessed as 4010\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to 4011\.{\\topmark}. As in \TeX\ the five current marks for mark class zero 4012are realized as |cur_mark| array. The additional current marks are 4013again realized as tree structure with individual mark classes existing 4014only when needed. 4015 4016@<Generate all \eTeX...@>= 4017primitive("marks",mark,marks_code); 4018@!@:marks_}{\.{\\marks} primitive@> 4019primitive("topmarks",top_bot_mark,top_mark_code+marks_code); 4020@!@:top_marks_}{\.{\\topmarks} primitive@> 4021primitive("firstmarks",top_bot_mark,first_mark_code+marks_code); 4022@!@:first_marks_}{\.{\\firstmarks} primitive@> 4023primitive("botmarks",top_bot_mark,bot_mark_code+marks_code); 4024@!@:bot_marks_}{\.{\\botmarks} primitive@> 4025primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code); 4026@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@> 4027primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code); 4028@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@> 4029 4030@ The |scan_register_num| procedure scans a register number that must 4031not exceed 255 in compatibility mode resp.\ 32767 in extended mode. 4032 4033@<Declare \eTeX\ procedures for ex...@>= 4034procedure@?scan_register_num; forward;@t\2@> 4035 4036@ @<Declare procedures that scan restricted classes of integers@>= 4037procedure scan_register_num; 4038begin scan_int; 4039if (cur_val<0)or(cur_val>max_reg_num) then 4040 begin print_err("Bad register code"); 4041@.Bad register code@> 4042 help2(max_reg_help_line)("I changed this one to zero."); 4043 int_error(cur_val); cur_val:=0; 4044 end; 4045end; 4046 4047@ @<Initialize variables for \eTeX\ comp...@>= 4048max_reg_num:=255; 4049max_reg_help_line:="A register number must be between 0 and 255."; 4050 4051@ @<Initialize variables for \eTeX\ ext...@>= 4052max_reg_num:=32767; 4053max_reg_help_line:="A register number must be between 0 and 32767."; 4054 4055@ @<Glob...@>= 4056@!max_reg_num: halfword; {largest allowed register number} 4057@!max_reg_help_line: str_number; {first line of help message} 4058 4059@ There are seven almost identical doubly linked trees, one for the 4060sparse array of the up to 32512 additional registers of each kind and 4061one for the sparse array of the up to 32767 additional mark classes. 4062The root of each such tree, if it exists, is an index node containing 16 4063pointers to subtrees for 4096 consecutive array elements. Similar index 4064nodes are the starting points for all nonempty subtrees for 4096, 256, 4065and 16 consecutive array elements. These four levels of index nodes are 4066followed by a fifth level with nodes for the individual array elements. 4067 4068Each index node is nine words long. The pointers to the 16 possible 4069subtrees or are kept in the |info| and |link| fields of the last eight 4070words. (It would be both elegant and efficient to declare them as 4071array, unfortunately \PASCAL\ doesn't allow this.) 4072 4073The fields in the first word of each index node and in the nodes for the 4074array elements are closely related. The |link| field points to the next 4075lower index node and the |sa_index| field contains four bits (one 4076hexadecimal digit) of the register number or mark class. For the lowest 4077index node the |link| field is |null| and the |sa_index| field indicates 4078the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|, 4079|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index 4080nodes counts how many of the 16 pointers are non-null. 4081 4082The |sa_index| field in the nodes for array elements contains the four 4083bits plus 16 times the type. Therefore such a node represents a count 4084or dimen register if and only if |sa_index<dimen_val_limit|; it 4085represents a skip or muskip register if and only if 4086|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register 4087if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a 4088token list register if and only if 4089|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark 4090class if and only if |tok_val_limit<=sa_index|. 4091 4092The |new_index| procedure creates an index node (returned in |cur_ptr|) 4093having given contents of the |sa_index| and |link| fields. 4094 4095@d box_val==4 {the additional box registers} 4096@d mark_val=6 {the additional mark classes} 4097@# 4098@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$} 4099@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$} 4100@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$} 4101@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$} 4102@# 4103@d index_node_size=9 {size of an index node} 4104@d sa_index==type {a four-bit address or a type or both} 4105@d sa_used==subtype {count of non-null pointers} 4106 4107@<Declare \eTeX\ procedures for ex...@>= 4108procedure new_index(@!i:quarterword; @!q:pointer); 4109var k:small_number; {loop index} 4110begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i; 4111sa_used(cur_ptr):=0; link(cur_ptr):=q; 4112for k:=1 to index_node_size-1 do {clear all 16 pointers} 4113 mem[cur_ptr+k]:=sa_null; 4114end; 4115 4116@ The roots of the seven trees for the additional registers and mark 4117classes are kept in the |sa_root| array. The first six locations must 4118be dumped and undumped; the last one is also known as |sa_mark|. 4119 4120@d sa_mark==sa_root[mark_val] {root for mark classes} 4121 4122@<Glob...@>= 4123@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays} 4124@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|} 4125@!sa_null:memory_word; {two |null| pointers} 4126 4127@ @<Set init...@>= 4128sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; 4129 4130@ @<Initialize table...@>= 4131for i:=int_val to tok_val do sa_root[i]:=null; 4132 4133@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element| 4134procedure returns (in |cur_ptr|) a pointer to the node for the 4135corresponding array element, or |null| when no such element exists. The 4136third parameter |w| is set |true| if the element must exist, e.g., 4137because it is about to be modified. The procedure has two main 4138branches: one follows the existing tree structure, the other (only used 4139when |w| is |true|) creates the missing nodes. 4140 4141We use macros to extract the four-bit pieces from a sixteen-bit register 4142number or mark class and to fetch or store one of the 16 pointers from 4143an index node. 4144 4145@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing} 4146 begin if cur_ptr=null then 4147 if w then goto #@+else return; 4148 end 4149@# 4150@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit} 4151@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit} 4152@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit} 4153@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit} 4154@# 4155@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1) 4156 else cur_ptr:=info(q+(i div 2)+1) 4157 {set |cur_ptr| to the pointer indexed by |i| from index node |q|} 4158@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=# 4159 else info(q+(i div 2)+1):=# 4160 {store the pointer indexed by |i| in index node |q|} 4161@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q)); 4162 end {add |cur_ptr| as the pointer indexed by |i| in index node |q|} 4163@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q)); 4164 end {delete the pointer indexed by |i| in index node |q|} 4165 4166@<Declare \eTeX\ procedures for ex...@>= 4167procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean); 4168 {sets |cur_val| to sparse array element location or |null|} 4169label not_found,not_found1,not_found2,not_found3,not_found4,exit; 4170var q:pointer; {for list manipulations} 4171@!i:small_number; {a four bit index} 4172begin cur_ptr:=sa_root[t]; 4173if_cur_ptr_is_null_then_return_or_goto(not_found);@/ 4174q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr; 4175if_cur_ptr_is_null_then_return_or_goto(not_found1);@/ 4176q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr; 4177if_cur_ptr_is_null_then_return_or_goto(not_found2);@/ 4178q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr; 4179if_cur_ptr_is_null_then_return_or_goto(not_found3);@/ 4180q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr; 4181if (cur_ptr=null)and w then goto not_found4; 4182return; 4183not_found: new_index(t,null); {create first level index node} 4184sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n); 4185not_found1: new_index(i,q); {create second level index node} 4186add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n); 4187not_found2: new_index(i,q); {create third level index node} 4188add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n); 4189not_found3: new_index(i,q); {create fourth level index node} 4190add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n); 4191not_found4: @<Create a new array element of type |t| with index |i|@>; 4192link(cur_ptr):=q; add_sa_ptr; 4193exit:end; 4194 4195@ The array elements for registers are subject to grouping and have an 4196|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|. 4197Since saved values as well as shorthand definitions (created by e.g., 4198\.{\\countdef}) refer to the location of the respective array element, 4199we need a reference count that is kept in the |sa_ref| field. An array 4200element can be deleted (together with all references to it) when its 4201|sa_ref| value is |null| and its value is the default value. 4202@^reference counts@> 4203 4204Skip, muskip, box, and token registers use two word nodes, their values 4205are stored in the |sa_ptr| field. 4206Count and dimen registers use three word nodes, their 4207values are stored in the |sa_int| resp.\ |sa_dim| field in the third 4208word; the |sa_ptr| field is used under the name |sa_num| to store 4209the register number. Mark classes use four word nodes. The last three 4210words contain the five types of current marks 4211 4212@d sa_lev==sa_used {grouping level for the current value} 4213@d pointer_node_size=2 {size of an element with a pointer value} 4214@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index} 4215@d sa_ref(#)==info(#+1) {reference count of a sparse array element} 4216@d sa_ptr(#)==link(#+1) {a pointer value} 4217@# 4218@d word_node_size=3 {size of an element with a word value} 4219@d sa_num==sa_ptr {the register number} 4220@d sa_int(#)==mem[#+2].int {an integer} 4221@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)} 4222@# 4223@d mark_class_node_size=4 {size of an element for a mark class} 4224@# 4225@d fetch_box(#)== {fetch |box(cur_val)|} 4226 if cur_val<256 then #:=box(cur_val) 4227 else begin find_sa_element(box_val,cur_val,false); 4228 if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr); 4229 end 4230 4231@<Create a new array element...@>= 4232if t=mark_val then {a mark class} 4233 begin cur_ptr:=get_node(mark_class_node_size); 4234 mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null; 4235 end 4236else begin if t<=dimen_val then {a count or dimen register} 4237 begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0; 4238 sa_num(cur_ptr):=n; 4239 end 4240 else begin cur_ptr:=get_node(pointer_node_size); 4241 if t<=mu_val then {a skip or muskip register} 4242 begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue); 4243 end 4244 else sa_ptr(cur_ptr):=null; {a box or token list register} 4245 end; 4246 sa_ref(cur_ptr):=null; {all registers have a reference count} 4247 end; 4248sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one 4249 4250@ The |delete_sa_ref| procedure is called when a pointer to an array 4251element representing a register is being removed; this means that the 4252reference count should be decreased by one. If the reduced reference 4253count is |null| and the register has been (globally) assigned its 4254default value the array element should disappear, possibly together with 4255some index nodes. This procedure will never be used for mark class 4256nodes. 4257@^reference counts@> 4258 4259@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count} 4260@# 4261@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same} 4262 if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#) 4263@# 4264 4265{ FIXME: needs debugging (sparse arrays) } 4266@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false); 4267 if cur_ptr<>0 then 4268 begin 4269 set_equiv(sa_ptr(cur_ptr),#); 4270 add_sa_ref(cur_ptr); 4271 delete_sa_ref(cur_ptr); 4272 end; 4273 end 4274 4275@<Declare \eTeX\ procedures for tr...@>= 4276procedure delete_sa_ref(@!q:pointer); {reduce reference count} 4277label exit; 4278var p:pointer; {for list manipulations} 4279@!i:small_number; {a four bit index} 4280@!s:small_number; {size of a node} 4281begin decr(sa_ref(q)); 4282if sa_ref(q)<>null then return; 4283if sa_index(q)<dimen_val_limit then 4284 if sa_int(q)=0 then s:=word_node_size 4285 else return 4286else begin if sa_index(q)<mu_val_limit then 4287 if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue) 4288 else return 4289 else if sa_ptr(q)<>null then return; 4290 s:=pointer_node_size; 4291 end; 4292repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s); 4293if q=null then {the whole tree has been freed} 4294 begin sa_root[i]:=null; return; 4295 end; 4296delete_sa_ptr; s:=index_node_size; {node |q| is an index node} 4297until sa_used(q)>0; 4298exit:end; 4299 4300@ The |print_sa_num| procedure prints the register number corresponding 4301to an array element. 4302 4303@<Basic print...@>= 4304procedure print_sa_num(@!q:pointer); {print register number} 4305var @!n:halfword; {the register number} 4306begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case} 4307else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q); 4308 q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q))); 4309 end; 4310print_int(n); 4311end; 4312 4313@ Here is a procedure that displays the contents of an array element 4314symbolically. It is used under similar circumstances as is 4315|restore_trace| (together with |show_eqtb|) for the quantities kept in 4316the |eqtb| array. 4317 4318@<Declare \eTeX\ procedures for tr...@>= 4319@!stat procedure show_sa(@!p:pointer;@!s:str_number); 4320var t:small_number; {the type of element} 4321begin begin_diagnostic; print_char("{"); print(s); print_char(" "); 4322if p=null then print_char("?") {this can't happen} 4323else begin t:=sa_type(p); 4324 if t<box_val then print_cmd_chr(register,p) 4325 else if t=box_val then 4326 begin print_esc("box"); print_sa_num(p); 4327 end 4328 else if t=tok_val then print_cmd_chr(toks_register,p) 4329 else print_char("?"); {this can't happen either} 4330 print_char("="); 4331 if t=int_val then print_int(sa_int(p)) 4332 else if t=dimen_val then 4333 begin print_scaled(sa_dim(p)); print("pt"); 4334 end 4335 else begin p:=sa_ptr(p); 4336 if t=glue_val then print_spec(p,"pt") 4337 else if t=mu_val then print_spec(p,"mu") 4338 else if t=box_val then 4339 if p=null then print("void") 4340 else begin depth_threshold:=0; breadth_max:=1; show_node_list(p); 4341 end 4342 else if t=tok_val then 4343 begin if p<>null then show_token_list(link(p),null,32); 4344 end 4345 else print_char("?"); {this can't happen either} 4346 end; 4347 end; 4348print_char("}"); end_diagnostic(false); 4349end; 4350tats 4351 4352@ Here we compute the pointer to the current mark of type |t| and mark 4353class |cur_val|. 4354 4355@<Compute the mark pointer...@>= 4356begin find_sa_element(mark_val,cur_val,false); 4357if cur_ptr<>null then 4358 if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1) 4359 else cur_ptr:=info(cur_ptr+(t div 2)+1); 4360end 4361 4362@ The current marks for all mark classes are maintained by the |vsplit| 4363and |fire_up| routines and are finally destroyed (for \.{INITEX} only) 4364@.INITEX@> 4365by the |final_cleanup| routine. Apart from updating the current marks 4366when mark nodes are encountered, these routines perform certain actions 4367on all existing mark classes. The recursive |do_marks| procedure walks 4368through the whole tree or a subtree of existing mark class nodes and 4369preforms certain actions indicted by its first parameter |a|, the action 4370code. The second parameter |l| indicates the level of recursion (at 4371most four); the third parameter points to a nonempty tree or subtree. 4372The result is |true| if the complete tree or subtree has been deleted. 4373 4374@d vsplit_init==0 {action code for |vsplit| initialization} 4375@d fire_up_init==1 {action code for |fire_up| initialization} 4376@d fire_up_done==2 {action code for |fire_up| completion} 4377@d destroy_marks==3 {action code for |final_cleanup|} 4378@# 4379@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|} 4380@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|} 4381@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|} 4382@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|} 4383@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|} 4384 4385@<Declare the function called |do_marks|@>= 4386function do_marks(@!a,@!l:small_number;@!q:pointer):boolean; 4387var i:small_number; {a four bit index} 4388begin if l<4 then {|q| is an index node} 4389 begin for i:=0 to 15 do 4390 begin get_sa_ptr; 4391 if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr; 4392 end; 4393 if sa_used(q)=0 then 4394 begin free_node(q,index_node_size); q:=null; 4395 end; 4396 end 4397else {|q| is the node for a mark class} 4398 begin case a of 4399 @<Cases for |do_marks|@>@; 4400 end; {there are no other cases} 4401 if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then 4402 begin free_node(q,mark_class_node_size); q:=null; 4403 end; 4404 end; 4405do_marks:=(q=null); 4406end; 4407 4408@ At the start of the |vsplit| routine the existing |split_fist_mark| 4409and |split_bot_mark| are discarded. 4410 4411@<Cases for |do_marks|@>= 4412vsplit_init: if sa_split_first_mark(q)<>null then 4413 begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null; 4414 delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null; 4415 end; 4416 4417@ We use again the fact that |split_first_mark=null| if and only if 4418|split_bot_mark=null|. 4419 4420@<Update the current marks for |vsplit|@>= 4421begin find_sa_element(mark_val,mark_class(p),true); 4422if sa_split_first_mark(cur_ptr)=null then 4423 begin sa_split_first_mark(cur_ptr):=mark_ptr(p); 4424 add_token_ref(mark_ptr(p)); 4425 end 4426else delete_token_ref(sa_split_bot_mark(cur_ptr)); 4427sa_split_bot_mark(cur_ptr):=mark_ptr(p); 4428add_token_ref(mark_ptr(p)); 4429end 4430 4431@ At the start of the |fire_up| routine the old |top_mark| and 4432|first_mark| are discarded, whereas the old |bot_mark| becomes the new 4433|top_mark|. An empty new |top_mark| token list is, however, discarded 4434as well in order that mark class nodes can eventually be released. We 4435use again the fact that |bot_mark<>null| implies |first_mark<>null|; it 4436also knows that |bot_mark=null| implies |top_mark=first_mark=null|. 4437 4438@<Cases for |do_marks|@>= 4439fire_up_init: if sa_bot_mark(q)<>null then 4440 begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q)); 4441 delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null; 4442 if link(sa_bot_mark(q))=null then {an empty token list} 4443 begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null; 4444 end 4445 else add_token_ref(sa_bot_mark(q)); 4446 sa_top_mark(q):=sa_bot_mark(q); 4447 end; 4448 4449@ @<Cases for |do_marks|@>= 4450fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then 4451 begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q)); 4452 end; 4453 4454@ @<Update the current marks for |fire_up|@>= 4455begin find_sa_element(mark_val,mark_class(p),true); 4456if sa_first_mark(cur_ptr)=null then 4457 begin sa_first_mark(cur_ptr):=mark_ptr(p); 4458 add_token_ref(mark_ptr(p)); 4459 end; 4460if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr)); 4461sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p)); 4462end 4463 4464@ Here we use the fact that the five current mark pointers in a mark 4465class node occupy the same locations as the first five pointers of 4466an index node. For systems using a run-time switch to distinguish 4467between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$' 4468surrounding the following piece of code should be removed. 4469@.INITEX@> 4470@^system dependencies@> 4471 4472@<Cases for |do_marks|@>= 4473@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do 4474 begin get_sa_ptr; 4475 if cur_ptr<>null then 4476 begin delete_token_ref(cur_ptr); put_sa_ptr(null); 4477 end; 4478 end; 4479tini 4480 4481@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}', 4482etc., as well as for references to sparse array elements defined by 4483`\.{\\countdef}', etc. 4484 4485@<Cases of |register| for |print_cmd_chr|@>= 4486begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then 4487 cmd:=sa_type(chr_code) 4488else begin cmd:=chr_code-mem_bot; chr_code:=null; 4489 end; 4490if cmd=int_val then print_esc("count") 4491else if cmd=dimen_val then print_esc("dimen") 4492else if cmd=glue_val then print_esc("skip") 4493else print_esc("muskip"); 4494if chr_code<>null then print_sa_num(chr_code); 4495end 4496 4497@ Similarly the command code |toks_register| is used for `\.{\\toks}' as 4498well as for references to sparse array elements defined by 4499`\.{\\toksdef}'. 4500 4501@<Cases of |toks_register| for |print_cmd_chr|@>= 4502begin print_esc("toks"); 4503if chr_code<>mem_bot then print_sa_num(chr_code); 4504end 4505 4506@ When a shorthand definition for an element of one of the sparse arrays 4507is destroyed, we must reduce the reference count. 4508 4509@<Cases for |eq_destroy|@>= 4510toks_register,register: 4511 if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then 4512 delete_sa_ref(equiv_field(w)); 4513 4514@ The task to maintain (change, save, and restore) register values is 4515essentially the same when the register is realized as sparse array 4516element or entry in |eqtb|. The global variable |sa_chain| is the head 4517of a linked list of entries saved at the topmost level |sa_level|; the 4518lists for lowel levels are kept in special save stack entries. 4519 4520@<Glob...@>= 4521@!sa_chain: pointer; {chain of saved sparse array entries} 4522@!sa_level: quarterword; {group level for |sa_chain|} 4523 4524@ @<Set init...@>= 4525sa_chain:=null; sa_level:=level_zero; 4526 4527@ The individual saved items are kept in pointer or word nodes similar 4528to those used for the array elements: a word node with value zero is, 4529however, saved as pointer node with the otherwise impossible |sa_index| 4530value |tok_val_limit|. 4531 4532@d sa_loc==sa_ref {location of saved item} 4533 4534@<Declare \eTeX\ procedures for tr...@>= 4535procedure sa_save(@!p:pointer); {saves value of |p|} 4536var q:pointer; {the new save node} 4537@!i:quarterword; {index field of node} 4538begin if cur_level<>sa_level then 4539 begin check_full_save_stack; save_type(save_ptr):=restore_sa; 4540 save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain; 4541 incr(save_ptr); sa_chain:=null; sa_level:=cur_level; 4542 end; 4543i:=sa_index(p); 4544if i<dimen_val_limit then 4545 begin if sa_int(p)=0 then 4546 begin q:=get_node(pointer_node_size); i:=tok_val_limit; 4547 end 4548 else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p); 4549 end; 4550 sa_ptr(q):=null; 4551 end 4552else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p); 4553 end; 4554sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p); 4555link(q):=sa_chain; sa_chain:=q; add_sa_ref(p); 4556end; 4557 4558@ @<Declare \eTeX\ procedures for tr...@>= 4559procedure sa_destroy(@!p:pointer); {destroy value of |p|} 4560begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p)) 4561else if sa_ptr(p)<>null then 4562 if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p)) 4563 else delete_token_ref(sa_ptr(p)); 4564end; 4565 4566@ The procedure |sa_def| assigns a new value to sparse array elements, 4567and saves the former value if appropriate. This procedure is used only 4568for skip, muskip, box, and token list registers. The counterpart of 4569|sa_def| for count and dimen registers is called |sa_w_def|. 4570 4571@d sa_define(#)==if e then 4572 if global then gsa_def(#)@+else sa_def(#) 4573 else define 4574@# 4575@d sa_def_box== {assign |cur_box| to |box(cur_val)|} 4576 begin find_sa_element(box_val,cur_val,true); 4577 if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box); 4578 end 4579@# 4580@d sa_word_define(#)==if e then 4581 if global then gsa_w_def(#)@+else sa_w_def(#) 4582 else word_define(#) 4583 4584@<Declare \eTeX\ procedures for tr...@>= 4585procedure sa_def(@!p:pointer;@!e:halfword); 4586 {new data for sparse array elements} 4587begin add_sa_ref(p); 4588if sa_ptr(p)=e then 4589 begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/ 4590 sa_destroy(p); 4591 end 4592else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/ 4593 if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p); 4594 sa_lev(p):=cur_level; sa_ptr(p):=e; 4595 @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 4596 end; 4597delete_sa_ref(p); 4598end; 4599@# 4600procedure sa_w_def(@!p:pointer;@!w:integer); 4601begin add_sa_ref(p); 4602if sa_int(p)=w then 4603 begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/ 4604 end 4605else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/ 4606 if sa_lev(p)<>cur_level then sa_save(p); 4607 sa_lev(p):=cur_level; sa_int(p):=w; 4608 @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 4609 end; 4610delete_sa_ref(p); 4611end; 4612 4613@ The |sa_def| and |sa_w_def| routines take care of local definitions. 4614@^global definitions@> 4615Global definitions are done in almost the same way, but there is no need 4616to save old values, and the new value is associated with |level_one|. 4617 4618@<Declare \eTeX\ procedures for tr...@>= 4619procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|} 4620begin add_sa_ref(p); 4621@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/ 4622sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e; 4623@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 4624delete_sa_ref(p); 4625end; 4626@# 4627procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|} 4628begin add_sa_ref(p); 4629@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/ 4630sa_lev(p):=level_one; sa_int(p):=w; 4631@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/ 4632delete_sa_ref(p); 4633end; 4634 4635@ The |sa_restore| procedure restores the sparse array entries pointed 4636at by |sa_chain| 4637 4638@<Declare \eTeX\ procedures for tr...@>= 4639procedure sa_restore; 4640var p:pointer; {sparse array element} 4641begin repeat p:=sa_loc(sa_chain); 4642if sa_lev(p)=level_one then 4643 begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain); 4644 @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/ 4645 end 4646else begin if sa_index(p)<dimen_val_limit then 4647 if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain) 4648 else sa_int(p):=0 4649 else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain); 4650 end; 4651 sa_lev(p):=sa_lev(sa_chain); 4652 @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/ 4653 end; 4654delete_sa_ref(p); 4655p:=sa_chain; sa_chain:=link(p); 4656if sa_index(p)<dimen_val_limit then free_node(p,word_node_size) 4657else free_node(p,pointer_node_size); 4658until sa_chain=null; 4659end; 4660 4661{FIXME: |last_line_fit| might be incompatible with Omega} 4662 4663@ When the value of |last_line_fit| is positive, the last line of a 4664(partial) paragraph is treated in a special way and we need additional 4665fields in the active nodes. 4666 4667@d active_node_size_extended=5 {number of words in extended active nodes} 4668@d active_short(#)==mem[#+3].sc {|shortfall| of this line} 4669@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink} 4670 4671@<Glob...@>= 4672@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph} 4673@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?} 4674@!active_node_size:small_number; {number of words in active nodes} 4675@!fill_width:array[0..2] of scaled; {infinite stretch components of 4676 |par_fill_skip|} 4677@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall| 4678 corresponding to |minimal_demerits|} 4679@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding 4680 glue stretch or shrink} 4681 4682@ The new algorithm for the last line requires that the stretchability 4683|par_fill_skip| is infinite and the stretchability of |left_skip| plus 4684|right_skip| is finite. 4685 4686@<Check for special...@>= 4687do_last_line_fit:=false; active_node_size:=active_node_size_normal; 4688 {just in case} 4689if last_line_fit>0 then 4690 begin q:=glue_ptr(last_line_fill); 4691 if (stretch(q)>0)and(stretch_order(q)>normal) then 4692 if (background[3]=0)and(background[4]=0)and(background[5]=0) then 4693 begin do_last_line_fit:=true; 4694 active_node_size:=active_node_size_extended; 4695 fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0; 4696 fill_width[stretch_order(q)-1]:=stretch(q); 4697 end; 4698 end 4699 4700@ @<Other local variables for |try_break|@>= 4701@!g:scaled; {glue stretch or shrink of test line, adjustment for last line} 4702 4703@ Here we initialize the additional fields of the first active node 4704representing the beginning of the paragraph. 4705 4706@<Initialize additional fields of the first active node@>= 4707begin active_short(q):=0; active_glue(q):=0; 4708end 4709 4710@ Here we compute the adjustment |g| and badness |b| for a line from |r| 4711to the end of the paragraph. When any of the criteria for adjustment is 4712violated we fall through to the normal algorithm. 4713 4714The last line must be too short, and have infinite stretch entirely due 4715to |par_fill_skip|. 4716 4717@<Perform computations for last line and |goto found|@>= 4718begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found; 4719 {previous line was neither stretched nor shrunk, or was infinitely bad} 4720if (cur_active_width[3]<>fill_width[0])or@| 4721 (cur_active_width[4]<>fill_width[1])or@| 4722 (cur_active_width[5]<>fill_width[2]) then goto not_found; 4723 {infinite stretch of this line not entirely due to |par_fill_skip|} 4724if active_short(r)>0 then g:=cur_active_width[2] 4725else g:=cur_active_width[6]; 4726if g<=0 then goto not_found; {no finite stretch resp.\ no shrink} 4727arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen); 4728if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen); 4729if arith_error then 4730 if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen; 4731if g>0 then 4732 @<Set the value of |b| to the badness of the last line for stretching, 4733 compute the corresponding |fit_class, and |goto found||@> 4734else if g<0 then 4735 @<Set the value of |b| to the badness of the last line for shrinking, 4736 compute the corresponding |fit_class, and |goto found||@>; 4737not_found:end 4738 4739@ These badness computations are rather similar to those of the standard 4740algorithm, with the adjustment amount |g| replacing the |shortfall|. 4741 4742@<Set the value of |b| to the badness of the last line for str...@>= 4743begin if g>shortfall then g:=shortfall; 4744if g>7230584 then if cur_active_width[2]<1663497 then 4745 begin b:=inf_bad; fit_class:=very_loose_fit; goto found; 4746 end; 4747b:=badness(g,cur_active_width[2]); 4748if b>12 then 4749 if b>99 then fit_class:=very_loose_fit 4750 else fit_class:=loose_fit 4751else fit_class:=decent_fit; 4752goto found; 4753end 4754 4755@ @<Set the value of |b| to the badness of the last line for shr...@>= 4756begin if -g>cur_active_width[6] then g:=-cur_active_width[6]; 4757b:=badness(-g,cur_active_width[6]); 4758if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit; 4759goto found; 4760end 4761 4762@ Vanishing values of |shortfall| and |g| indicate that the last line is 4763not adjusted. 4764 4765@<Adjust \(t)the additional data for last line@>= 4766begin if cur_p=null then shortfall:=0; 4767if shortfall>0 then g:=cur_active_width[2] 4768else if shortfall<0 then g:=cur_active_width[6] 4769else g:=0; 4770end 4771 4772@ For each feasible break we record the shortfall and glue stretch or 4773shrink (or adjustment). 4774 4775@<Store \(a)additional data for this feasible break@>= 4776begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g; 4777end 4778 4779@ Here we save these data in the active node representing a potential 4780line break. 4781 4782@<Store \(a)additional data in the new active node@>= 4783begin active_short(q):=best_pl_short[fit_class]; 4784active_glue(q):=best_pl_glue[fit_class]; 4785end 4786 4787@ @<Print additional data in the new active node@>= 4788begin print(" s="); print_scaled(active_short(q)); 4789if cur_p=null then print(" a=")@+else print(" g="); 4790print_scaled(active_glue(q)); 4791end 4792 4793@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip| 4794glue. 4795 4796@<Adjust \(t)the final line of the paragraph@>= 4797if active_short(best_bet)=0 then do_last_line_fit:=false 4798else begin q:=new_spec(glue_ptr(last_line_fill)); 4799 delete_glue_ref(glue_ptr(last_line_fill)); 4800 width(q):=width(q)+active_short(best_bet)-active_glue(best_bet); 4801 stretch(q):=0; glue_ptr(last_line_fill):=q; 4802 end 4803 4804@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive 4805the current |lc_code| values are stored together with the hyphenation 4806patterns for the current language. They will later be used instead of 4807the |lc_code| values for hyphenation purposes. 4808 4809The |lc_code| values are stored in the linked trie analogous to patterns 4810$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and 4811|lc_code(p_1)| replacing the |trie_op| code. This allows to compress 4812and pack them together with the patterns with minimal changes to the 4813existing code. 4814 4815@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|} 4816 4817@<Initialize table entries...@>= 4818hyph_root:=0; hyph_start:=0; 4819 4820@ @<Store hyphenation codes for current language@>= 4821begin c:=cur_lang; first_child:=false; p:=0; 4822repeat q:=p; p:=trie_r[q]; 4823until (p=0)or(c<=so(trie_c[p])); 4824if (p=0)or(c<so(trie_c[p])) then 4825 @<Insert a new trie node between |q| and |p|, and 4826 make |p| point to it@>; 4827q:=p; {now node |q| represents |cur_lang|} 4828@<Store all current |lc_code| values@>; 4829end 4830 4831@ We store all nonzero |lc_code| values, overwriting any previously 4832stored values (and possibly wasting a few trie nodes that were used 4833previously and are not needed now). We always store at least one 4834|lc_code| value such that |hyph_index| (defined below) will not be zero. 4835 4836@<Store all current |lc_code| values@>= 4837p:=trie_l[q]; first_child:=true; 4838for c:=0 to 255 do 4839 if (lc_code(c)>0)or((c=255)and first_child) then 4840 begin if p=0 then 4841 @<Insert a new trie node between |q| and |p|, and 4842 make |p| point to it@> 4843 else trie_c[p]:=si(c); 4844 trie_o[p]:=qi(lc_code(c)); 4845 q:=p; p:=trie_r[q]; first_child:=false; 4846 end; 4847if first_child then trie_l[q]:=0@+else trie_r[q]:=0 4848 4849@ We must avoid to ``take'' location~1, in order to distinguish between 4850|lc_code| values and patterns. 4851 4852@<Pack all stored |hyph_codes|@>= 4853begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2; 4854first_fit(hyph_root); trie_pack(hyph_root); 4855hyph_start:=trie_ref[hyph_root]; 4856end 4857 4858@ The global variable |hyph_index| will point to the hyphenation codes 4859for the current language. 4860 4861@d set_hyph_index== {set |hyph_index| for current language} 4862 if trie_char(hyph_start+cur_lang)<>qi(cur_lang) 4863 then hyph_index:=0 {no hyphenation codes for |cur_lang|} 4864 else hyph_index:=trie_link(hyph_start+cur_lang) 4865@# 4866@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} 4867 if hyph_index=0 then hc[0]:=lc_code(#) 4868 else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0 4869 else hc[0]:=qo(trie_op(hyph_index+#)) 4870 4871@<Glob...@>= 4872@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|} 4873@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|} 4874 4875@ When |saving_vdiscards| is positive then the glue, kern, and penalty 4876nodes removed by the page builder or by \.{\\vsplit} from the top of a 4877vertical list are saved in special lists instead of being discarded. 4878 4879@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder} 4880@d page_disc==disc_ptr[last_box_code] {first item removed by page builder} 4881@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}} 4882 4883@<Glob...@>= 4884@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers} 4885 4886@ @<Set init...@>= 4887page_disc:=null; split_disc:=null; 4888 4889@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the 4890command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are 4891distinguished by their |chr_code| values |last_box_code| and 4892|vsplit_code|. These |chr_code| values are larger than |box_code| and 4893|copy_code|. 4894 4895@<Generate all \eTeX...@>= 4896primitive("pagediscards",un_vbox,last_box_code);@/ 4897@!@:page_discards_}{\.{\\pagediscards} primitive@> 4898primitive("splitdiscards",un_vbox,vsplit_code);@/ 4899@!@:split_discards_}{\.{\\splitdiscards} primitive@> 4900 4901@ @<Cases of |un_vbox| for |print_cmd_chr|@>= 4902else if chr_code=last_box_code then print_esc("pagediscards") 4903else if chr_code=vsplit_code then print_esc("splitdiscards") 4904 4905@ @<Handle saved items and |goto done|@>= 4906begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null; 4907goto done; 4908end 4909 4910@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties}, 4911and \.{\\displaywidowpenalties} commands allow to define arrays of 4912penalty values to be used instead of the corresponding single values. 4913 4914@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc) 4915@d club_penalties_ptr==equiv(club_penalties_loc) 4916@d widow_penalties_ptr==equiv(widow_penalties_loc) 4917@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc) 4918 4919@<Generate all \eTeX...@>= 4920primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/ 4921@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@> 4922primitive("clubpenalties",set_shape,club_penalties_loc);@/ 4923@!@:club_penalties_}{\.{\\clubpenalties} primitive@> 4924primitive("widowpenalties",set_shape,widow_penalties_loc);@/ 4925@!@:widow_penalties_}{\.{\\widowpenalties} primitive@> 4926primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/ 4927@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@> 4928 4929@ @<Cases of |set_shape| for |print_cmd_chr|@>= 4930inter_line_penalties_loc: print_esc("interlinepenalties"); 4931club_penalties_loc: print_esc("clubpenalties"); 4932widow_penalties_loc: print_esc("widowpenalties"); 4933display_widow_penalties_loc: print_esc("displaywidowpenalties"); 4934 4935@ @<Fetch a penalties array element@>= 4936begin scan_int; 4937if (equiv(m)=null)or(cur_val<0) then cur_val:=0 4938else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m)); 4939 cur_val:=penalty(equiv(m)+cur_val); 4940 end; 4941end 4942 4943@* \[54] System-dependent changes. 4944@z 4945%--------------------------------------- 4946