Skip to content

Instantly share code, notes, and snippets.

@texdraft

texdraft/tex-pretty-beginning.pas Secret

Last active July 12, 2019 10:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save texdraft/cb5d4360f16ac3d7d48f204ef286aa01 to your computer and use it in GitHub Desktop.
Save texdraft/cb5d4360f16ac3d7d48f204ef286aa01 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
tex-pretty-beginning.pas
{<4>=}
{<Compiler directives 9>=}{$C-,A+,D-}{[$C+,D+]}{</9>}
program TEX;
{<Labels in the outer block 6>=}
label 1, // start_of_TeX
9998, // end_of_TeX
9999; // final_end
{</6>}
{<Constants in the outer block 11>=}
const mem_max = 30000;{greatest index in TeX's internal mem array;
must be strictly less than max_halfword;}
mem_min = 0;{smallest index in TeX's internal mem array;
must be min_halfword or more; must be equal to mem_bot in INITEX, otherwise <= mem_bot}
buf_size = 500; {maximum number of characters simultaneously present in
current lines of open files and in control sequences between
\csname and \endcsname; must not exceed max_halfword}
error_line = 72; {width of first lines of contexts in terminal
error messages; should be between 30 and error_line - 15}
half_error_line = 42; {width of context lines on terminal error messages}
max_print_line = 79; {width of longest text lines output; should be at least 60}
stack_size = 200; {maximum number of simultaneous input sources}
max_in_open = 6; {maximum number of input files and error insertions that
can be going on simultaneously}
font_max = 75; {maximum internal font number; must not exceed max_quarterword
and must be at most font_base + 256}
font_mem_size = 20000; {number of words of font_info for all fonts}
param_size = 60; {maximum number of simultaneous macro parameters}
nest_size = 40; {maximum number of semantic levels simultaneously active}
max_strings = 3000; {maximum number of strings; must not exceed max_halfword}
string_vacancies = 8000; {the minimum number of characters that should be
available for the user's control sequences and font names,
after TeX's own error messages are stored}
pool_size = 32000; {maximum number of characters in strings, including all
error messages and help texts, and the names of all fonts and
control sequences; must exceed string_vacancies by the total
length of TeX's own strings, which is currently about 23000}
save_size = 600; {space for saving values outside of current group; must be
at most max_halfword}
trie_size = 8000;{space for hyphenation patterns; should be larger for
INITEX than it is in production versions of TeX}
trie_op_size = 500; {space for 'opcodes' in the hyphenation patterns}
dvi_buf_size = 800; {size of the output buffer; must be a multiple of 8}
file_namesize = 40; {file names shouldn't be longer than this}
pool_name = 'TeXformats:TEX.POOL ';
{string of length file_name_size; tells where the string pool appears}
{</11>}
{<Types in the outer block 18>=}
type ASCII_code = 0..255; {eight-bit numbers}
{<25. Input and output.>}
eight_bits = 0..255; {unsigned one-byte quantity}
alpha_file = packed file of char; {files that contain textual data}
byte_file = packed file of eight_bits; {files that contain binary data}
{</25>}
{<38. String handling.>}
pool_pointer = 0..pool_size; {for variables that point into str_pool}
str_number = 0..max_strings; {for variables that point into str_start}
packed_ASCII_code = 0..255; {elements of str_pool array}
{</38>}
{<101>}
scaled = integer; {this type is used for scaled integers}
nonnegative_integer = 0..2147483647; {0 <= x < 2^31} // 17777777777 octal
small_number = 0..63; {this type is self-explanatory}
{</101>}
{<109>}
glue_ratio = real; {one-word representation of a glue expansion factor}
{</109>}
{<113>}
quarterword = 0..255;
halfword = 0..65535;
pointer = halfword; // my addition
two_choices = 1..2;
four_choices = 1..4;
two_halves = packed record
rh: halfword;
case two_choices of
1: (lh: halfword);
2: (b0: quarterword; b1: quarterword);
end;
four_quarters = packed record
b0: quarterword;
b1: quarterword;
b2: quarterword;
b3: quarterword;
end;
memory_word = record
case four_choices of
1: (int: integer);
2: (gr: glue_ratio);
3: (hh: two_halves);
4: (qqqq: four_quarters);
end;
word_file = file of memory_word;
{<113>}
{<150>}
glue_ord = 0..3; {infinity to the 0, 1, 2, or 3 power} // glue_ord = normal..fill;
{</150>}
{</18>}
{<Global variables 13>=}
var bad: integer; {is some 'constant' wrong?}
{<20>}
xord: array[char] Of ASCII_code; // array[text_char of ASCII_code];
xchr: array[ASCII_code] Of char; // array [ASCII_code] of textchar;
{</20>}
{<26>}
name_of_file: packed array[1..file_name_size] of char;
{on some systems this may be a record variable}
name_length: 0..file_name_size; {this many characters are actually
relevant in name_of_file (the rest are blank)}
{</26>}
{<30>}
buffer: array[0..buf_size] Of ASCII_code; {lines of characters being read}
first: 0..buf_size; {the first unused position in buffers}
last: 0..buf_size; {the first unused position in buffer}
max_buf_stack: 0..buf_size; {the first unused position in buffer}
{</30>}
{<32>}
term_in: alpha_file; {the terminal as an input file}
term_out: alpha_file; {the terminal as an output file}
{<32>}
{<39>}
str_pool: packed array[pool_pointer] Of packed_ASCII_code;
str_start: array[str_number] Of pool_pointer;
pool_ptr: pool_pointer;
str_ptr: str_number;
init_pool_ptr: pool_pointer;
init_str_ptr: str_number;
{</39>}
{<50>}
pool_file: alpha_file;
{</50>}
{<54. On-line and off-line printing.>}
log_file: alpha_file; {transcript of TeX session}
selector: 0..21; {where to print a message}
dig: array[0..22] Of 0..15; {digits in a number being output}
tally: integer; {the number of characters recently printed}
term_offset: 0..max_print_line; {the number of characters on the current terminal line}
file_offset: 0..max_print_line; {the number of characters on the current file line}
trick_buf: array[0..error_line] Of ASCII_code; {circular buffer for pseudoprinting}
trick_count: integer; {threshold for pseudoprinting, explained later}
first_count: integer; {another variable for pseudoprinting}
{</54>}
{<73>}
interaction: 0..3; {current level of interaction} // batch_mode..error_stop_mode
{</73>}
{<76>=}
deletions_allowed: boolean; {is it safe for error to call get_token?}
set_box_allowed: boolean; {is it safe to do a \setbox assignment?}
history: 0..3; {has the source input been clean so far?} // spotless..fatal_error_stop
error_count: -1..100; {the number of scrolled errors since the last paragraph ended}
{</76>}
{<79>=}
help_line: array[0..5] of str_number; {helps for the next error}
help_ptr: 0..6; {the number of help lines present}
use_err_help: boolean; {should the err_help list be shown?}
{</79>}
{<96>}
interrupt: integer; {should TeX pause for instructions?}
OK_to_interrupt: boolean; {should interrupts be observed?}
{</96>}
{<104>}
arith_error: boolean; {has arithmetic overflow occurred recently?}
remainder: scaled; {amount subtracted to get an exact division}
{</104>}
{<115. Dynamic memory allocation.>=}
temp_ptr: pointer; {a pointer variable for occasional emergency use}
{</115>}
{<116>}
mem: array[mem_min..mem_max] Of memory_word; {the big dynamic storage area}
lo_mem_max: pointer; {the largest location of variable-size memory in use}
hi_mem_min: pointer; {the smallest location of one-word memory in use}
{</116>}
{<117>}
var_used, dyn_used: integer; {how much memory is in use}
{</117>}
{<118>}
avail: halfword;
mem_end: halfword;
{</118>}
{<124>}
rover: pointer; {points to some node in the list of empties}
{</124>}
{<165>}
{debug} (*
free: packed array[mem_min..mem_max] of boolean; {free cells}
was_free: packed array[mem_min..mem_max] of boolean; {previously free cells}
was_mem_end, was_lo_max, was_hi_min: pointer; {previous mem_end, lo_mem_max, and hi_mem_min}
panicking: boolean; {do we want to check memory constantly?}
{</165>}
{gubed} *)
{<173>}
font_in_short_display: integer; {an internal font number}
{</173>}
{<181>}
depth_threshold: integer;
breadth_max: integer;
{</181>}
{</13>}
procedure initialize;
{<Local variables for initialization 19>=}
var i: integer;
{<163>}
k: integer; {index into mem, eqtb, etc.}
{</163>}
{<927>}
z: hyphpointer;
{</927>}
{</19>}
begin{8:}
{<Set initial values of key variables 21>=}
xchr[32] := ' ';
xchr[33] := '!';
xchr[34] := '"';
xchr[35] := '#';
xchr[36] := '$';
xchr[37] := '%';
xchr[38] := '&';
xchr[39] := '''';
xchr[40] := '(';
xchr[41] := ')';
xchr[42] := '*';
xchr[43] := '+';
xchr[44] := ',';
xchr[45] := '-';
xchr[46] := '.';
xchr[47] := '/';
xchr[48] := '0';
xchr[49] := '1';
xchr[50] := '2';
xchr[51] := '3';
xchr[52] := '4';
xchr[53] := '5';
xchr[54] := '6';
xchr[55] := '7';
xchr[56] := '8';
xchr[57] := '9';
xchr[58] := ':';
xchr[59] := ';';
xchr[60] := '<';
xchr[61] := '=';
xchr[62] := '>';
xchr[63] := '?';
xchr[64] := '@';
xchr[65] := 'A';
xchr[66] := 'B';
xchr[67] := 'C';
xchr[68] := 'D';
xchr[69] := 'E';
xchr[70] := 'F';
xchr[71] := 'G';
xchr[72] := 'H';
xchr[73] := 'I';
xchr[74] := 'J';
xchr[75] := 'K';
xchr[76] := 'L';
xchr[77] := 'M';
xchr[78] := 'N';
xchr[79] := 'O';
xchr[80] := 'P';
xchr[81] := 'Q';
xchr[82] := 'R';
xchr[83] := 'S';
xchr[84] := 'T';
xchr[85] := 'U';
xchr[86] := 'V';
xchr[87] := 'W';
xchr[88] := 'X';
xchr[89] := 'Y';
xchr[90] := 'Z';
xchr[91] := '[';
xchr[92] := '\';
xchr[93] := ']';
xchr[94] := '^';
xchr[95] := '_';
xchr[96] := '`';
xchr[97] := 'a';
xchr[98] := 'b';
xchr[99] := 'c';
xchr[100] := 'd';
xchr[101] := 'e';
xchr[102] := 'f';
xchr[103] := 'g';
xchr[104] := 'h';
xchr[105] := 'i';
xchr[106] := 'j';
xchr[107] := 'k';
xchr[108] := 'l';
xchr[109] := 'm';
xchr[110] := 'n';
xchr[111] := 'o';
xchr[112] := 'p';
xchr[113] := 'q';
xchr[114] := 'r';
xchr[115] := 's';
xchr[116] := 't';
xchr[117] := 'u';
xchr[118] := 'v';
xchr[119] := 'w';
xchr[120] := 'x';
xchr[121] := 'y';
xchr[122] := 'z';
xchr[123] := '{';
xchr[124] := '|';
xchr[125] := '}';
xchr[126] := '~';
{<23>=}
for i := 0 to 31 do // 0 to 37 octal
xchr[i] := ' ';
for i := 127 to 255 do // 177 to 177 octal
xchr[i] := ' ';
{</23>}
{<24>=}
for i := 0 to 255 do // first_text_char to last_text_char
xord[chr(i)] := 127; {invalid_code}
for i := 128 to 255 do // 200 to 377 octal}
xord[xchr[i]] := i;
for i := 0 to 126 do // 0 to 176 octal
xord[xchr[i]] := i;
{</24>}
{<74>=}
interaction := 3; // interaction := error_stop_mode;
{</74>}
{<77>=}
deletions_allowed := true;
set_box_allowed := true;
error_count := 0; {history is initialized elsewhere}
{</77>}
{<80>=}
help_ptr := 0;
use_err_help := false;
{</80>}
{<97>=}
interrupt := 0;
OK_to_interrupt := true;
{</97>}
{<166>}
{debug} (*
was_mem_end := mem_min; {indicate that everything was previously free}
was_lo_max := mem_min;
was_hi_min := mem_max;
panicking := false;
{gubed} *)
{</166>}
{init}
{<Initialize table entries (done by INITEX only) 164>=}
for k := 1 to 19 do // for k := mem_bot + 1 to lo_mem_stat_max do
mem[k].int := 0; {all glue dimensions are zeroed} // mem[k].sc := 0;
k := 0; // k := mem_bot;
while k <= 19 do {set first words of glue specifications} // while k <= lo_mem_stat_max do
begin
mem[k].hh.rh := 1; // glue_ref_count(k) := null + 1;
mem[k].hh.b0 := 0; // stretch_order(k) := normal;
mem[k].hh.b1 := 0; // shrink_order(k) := normal;
k := k + 4; // k := k + glue_spec_size;
end;
mem[6].int := 65536; // stretch(fil_glue) := unity;
mem[4].hh.b0 := 1; // stretch_order(fil_glue) := fil;
mem[10].int := 65536; // stretch(fill_glue) := unity;
mem[8].hh.b0 := 2; // stretch_order(fill_glue) := fill;
mem[14].int := 65536; // stretch(ss_glue) := unity;
mem[12].hh.b0 := 1; // stretch_order(ss_glue) := fil;
mem[15].int := 65536; // shrink(ss_glue) := unity;
mem[12].hh.b1 := 1; // shrink_order(ss_glue) := fil;
mem[18].int := -65536; // stretch(fil_neg_glue) := -unity;
mem[16].hh.b0 := 1; // stretch_order(fil_neg_glue) := fil;
{now initialize the dynamic memory}
rover := 20; // rover := lo_mem_stat_max + 1;
mem[rover].hh.rh := 65535; // link(rover) := empty_flag;
mem[rover].hh.lh := 1000; {which is a 1000-word available node} // node_size(rover) := 1000;
mem[rover + 1].hh.lh := rover; // llink(rover) := rover;
mem[rover + 1].hh.rh := rover; // rlink(rover) := rover;
lo_mem_max := rover + 1000;
mem[lo_mem_max].hh.rh := 0; // link(lo_mem_max) := null;
mem[lo_mem_max].hh.lh := 0; // info(lo_mem_max) := null;
for k := 29987 to 30000 do // for k := hi_mem_stat_min to mem_top do
mem[k] := mem[lo_mem_max]; {clear list heads}
{<Initialize the special list heads and constant nodes 790>=}
mem[29990].hh.lh := 6714; {link(omit_template) = null} // info(omit_template ) := end_template_token;
{<797>}
mem[29991].hh.rh := 256; // link(end_span) := max_quarterword + 1;
mem[29991].hh.lh := 0; // info(end_span) := null;
{</797>}
{<820>}
mem[29993].hh.b0 := 1; // type(last_active) := hyphenated;
mem[29994].hh.lh := 65535; // line_number(last_active) := max_halfword;
mem[29993].hh.b1 := 0; {the subtype is never examined by the algorithm} // subtype(last_active) := 0;
{</820>}
{<981>}
mem[30000].hh.b1 := 255; // subtype(page_ins_head) := qi(255);
mem[30000].hh.b0 := 1; // type(page_ins_head) := split_up;
mem[30000].hh.rh := 30000; // link(page_ins_head) := page_ins_head;
{</981>}
{<988>}
mem[29998].hh.b0 := 10; // type(page_head) := glue_node;
mem[29998].hh.b1 := 0; // subtype(page_head) := normal;
{</988>};
{</790>}
avail := 0; // avail := null
mem_end := 30000; // mem_end := mem_top;
hi_mem_min := 29987; {initialize the one-word memory} // hi_mem_min := hi_mem_stat_min;
{initialize statistics}
var_used := 20; // var_used := lo_mem_stat_max + 1 - mem_bot;
dyn_used := 14; // dyn_used:=hi_mem_stat_usage
{</164>}
{222:}
eqtb[2881].hh.b0 := 101;
eqtb[2881].hh.rh := 0;
eqtb[2881].hh.b1 := 0;
For k:=1 To 2880 Do
eqtb[k] := eqtb[2881];{:222}{228:}
eqtb[2882].hh.rh := 0;
eqtb[2882].hh.b1 := 1;
eqtb[2882].hh.b0 := 117;
For k:=2883 To 3411 Do
eqtb[k] := eqtb[2882];
mem[0].hh.rh := mem[0].hh.rh+530;{:228}{232:}
eqtb[3412].hh.rh := 0;
eqtb[3412].hh.b0 := 118;
eqtb[3412].hh.b1 := 1;
For k:=3413 To 3677 Do
eqtb[k] := eqtb[2881];
eqtb[3678].hh.rh := 0;
eqtb[3678].hh.b0 := 119;
eqtb[3678].hh.b1 := 1;
For k:=3679 To 3933 Do
eqtb[k] := eqtb[3678];
eqtb[3934].hh.rh := 0;
eqtb[3934].hh.b0 := 120;
eqtb[3934].hh.b1 := 1;
For k:=3935 To 3982 Do
eqtb[k] := eqtb[3934];
eqtb[3983].hh.rh := 0;
eqtb[3983].hh.b0 := 120;
eqtb[3983].hh.b1 := 1;
For k:=3984 To 5262 Do
eqtb[k] := eqtb[3983];
For k:=0 To 255 Do
Begin
eqtb[3983+k].hh.rh := 12;
eqtb[5007+k].hh.rh := k+0;
eqtb[4751+k].hh.rh := 1000;
End;
eqtb[3996].hh.rh := 5;
eqtb[4015].hh.rh := 10;
eqtb[4075].hh.rh := 0;
eqtb[4020].hh.rh := 14;
eqtb[4110].hh.rh := 15;
eqtb[3983].hh.rh := 9;
For k:=48 To 57 Do
eqtb[5007+k].hh.rh := k+28672;
For k:=65 To 90 Do
Begin
eqtb[3983+k].hh.rh := 11;
eqtb[3983+k+32].hh.rh := 11;
eqtb[5007+k].hh.rh := k+28928;
eqtb[5007+k+32].hh.rh := k+28960;
eqtb[4239+k].hh.rh := k+32;
eqtb[4239+k+32].hh.rh := k+32;
eqtb[4495+k].hh.rh := k;
eqtb[4495+k+32].hh.rh := k;
eqtb[4751+k].hh.rh := 999;
End;
{:232}{240:}
For k:=5263 To 5573 Do
eqtb[k].int := 0;
eqtb[5280].int := 1000;
eqtb[5264].int := 10000;
eqtb[5304].int := 1;
eqtb[5303].int := 25;
eqtb[5308].int := 92;
eqtb[5311].int := 13;
For k:=0 To 255 Do
eqtb[5574+k].int := -1;
eqtb[5620].int := 0;
{:240}{250:}
For k:=5830 To 6106 Do
eqtb[k].int := 0;
{:250}{258:}
hashused := 2614;
cscount := 0;
eqtb[2623].hh.b0 := 116;
hash[2623].rh := 502;{:258}{552:}
fontptr := 0;
fmemptr := 7;
fontname[0] := 800;
fontarea[0] := 338;
hyphenchar[0] := 45;
skewchar[0] := -1;
bcharlabel[0] := 0;
fontbchar[0] := 256;
fontfalsebchar[0] := 256;
fontbc[0] := 1;
fontec[0] := 0;
fontsize[0] := 0;
fontdsize[0] := 0;
charbase[0] := 0;
widthbase[0] := 0;
heightbase[0] := 0;
depthbase[0] := 0;
italicbase[0] := 0;
ligkernbase[0] := 0;
kernbase[0] := 0;
extenbase[0] := 0;
fontglue[0] := 0;
fontparams[0] := 7;
parambase[0] := -1;
For k:=0 To 6 Do
fontinfo[k].int := 0;
{:552}{946:}
For k:=-trieopsize To trieopsize Do
trieophash[k] := 0;
For k:=0 To 255 Do
trieused[k] := 0;
trieopptr := 0;
{:946}{951:}
trienotready := true;
triel[0] := 0;
triec[0] := 0;
trieptr := 0;
{:951}{1216:}
hash[2614].rh := 1189;{:1216}{1301:}
format_ident := 1256;
{:1301}{1369:}
hash[2622].rh := 1295;
eqtb[2622].hh.b1 := 1;
eqtb[2622].hh.b0 := 113;
eqtb[2622].hh.rh := 0;{:1369}{:8}
End;
{<Basic printing procedures 57>=}
procedure print_ln; {prints an end-of-line}
begin
case selector of
19: {term_and_log}
begin
write_ln(term_out);
write_ln(log_file);
term_offset := 0;
file_offset := 0;
end;
18: {log_only}
begin
write_ln(log_file);
file_offset := 0;
end;
17: {term_only}
begin
write_ln(term_out);
term_offset := 0;
end;
16,20,21:; // no_print, psuedo, new_string: do_nothing;
others: write_ln(write_file[selector])
{</57>}
end; {tally is not affected}
end;
{<58>=}
procedure print_char(s: ascii_code); {prints a single character}
label 10; {exit}
begin
if
{<Character s is the current new-line character 244>=}
s = eqtb[5312].int // s = new_line_char
{</244>}then
if selector < 20 then // if selector < pseudo then
begin
print_ln;
goto 10; // goto exit;
end;
case selector of
19: // term_and_log
begin
write(term_out,xchr[s]);
write(log_file,xchr[s]);
term_offset := term_offset+1; // incr(term_offset)
file_offset := file_offset+1; // incr(file_offset)
if term_offset = max_print_line then
begin
write_ln(term_out);
term_offset := 0;
end;
if file_offset=max_print_line then
begin
write_ln(log_file);
file_offset := 0;
end;
end;
18: // log_only
begin
write(log_file,xchr[s]);
file_offset := file_offset + 1;
if file_offset = max_print_line then print_ln;
end;
17: // term_only
begin
write(term_out,xchr[s]);
term_offset := term_offset + 1;
if term_offset = max_print_line then print_ln;
end;
16:; // no_print: do_nothing;
20: // pseudo:
if tally < trick_count then trick_buf[tally mod error_line] := s;
21: // new_string:
begin
if pool_ptr < pool_size then
begin // append_char(s)}
str_pool[pool_ptr] := s;
pool_ptr := pool_ptr + 1;
end; {we drop characters if the string space is full}
end;
others: write(write_file[selector],xchr[s])
end;
tally := tally+1; // incr(tally)
10: {exit:}
end;
{</58>}
{<59>=}
procedure print(s: integer); {prints string s}
label 10; {exit}
var j: pool_pointer; {current character code position}
nl: integer; {new-line character to restore}
begin
if s >= str_ptr then s := "???" {this can't happen} {POOL 259}
else if s<256 then
if s<0 then s := "???" {can't happen} {POOL 259}
else
begin
if selector > 20 then // if selector > pseudo then
begin
print_char(s);
goto 10; {internal strings are not expanded} // return
end;
if
{<Character s is the current new-line character 244>=}
s = eqtb[5312].int // s = new_line_char
{</244>}then
if selector < 20 then // if selector < pseudo then
begin
print_ln;
goto 10; // return;
end;
nl := eqtb[5312].int; // nl := new_line_char;
eqtb[5312].int := -1; // new_line_char := -1;
j := str_start[s];
while j < str_start[s + 1] do
begin
print_char(str_pool[j]); // print_char(so(str_pool[j]));
j := j + 1; // incr(j);
end;
eqtb[5312].int := nl; // new_line_char := nl;
goto 10; // return;
end;
j := str_start[s];
while j < str_start[s + 1] do
begin
print_char(str_pool[j]);
j := j + 1; // incr(j);
end;
10: // exit:
end;
{</59>}
{<60>=}
procedure slow_print(s: integer); {prints string s}
var j: pool_pointer; {current character code position}
begin
if (s >= str_ptr) or (s < 256)then print(s)
else
begin
j := str_start[s];
while j < str_start[s + 1] do
begin
print(str_pool[j]);
j := j + 1; // incr(j);
end;
end;
end;
{</60>}
{<62>=}
procedure print_nl(s: str_number); {prints string s at beginning of line}
begin
if ((term_offset > 0) and (odd(selector)))
or ((file_offset > 0) and
(selector >= 18)) // (selector >= log_only))
then print_ln;
print(s);
end;
{</62>}
{<63>=}
procedure print_esc(s: str_number);
var c: integer;
begin
{<Set variable c to the current escape character 243>=}
c := eqtb[5308].int; // c := escape_char
{</243>}
if c >= 0 then if c < 256 then print(c);
slow_print(s);
end;
{</63>}
{<64>=}
procedure print_the_digs(k: eight_bits); {prints dig[k − 1]...dig[0]}
begin
while k > 0 do
begin
k := k-1; // decr(k);
if dig[k] < 10 then print_char("0" + dig[k]) {POOL 48}
else print_char("A" + dig[k]); {POOL 55}
end;
end;
{</64>}
{<65>=}
procedure print_int(n:integer); {prints an integer in decimal form}
var k: 0..23; {index to current digit; we assume that n < 10^23}
m: integer; {used to negate n in possibly dangerous cases}
begin
k := 0;
if n < 0 then
begin
print_char("-"); {POOL 45}
if n > -100000000 then n := -n //... then negate(n)
else
begin
m := -1-n;
n := m div 10;
m := (m mod 10)+1;
k := 1;
if m < 10 then dig[0] := m
else
begin
dig[0] := 0;
n := n + 1; // incr(n);
end;
end;
end;
repeat
dig[k] := n mod 10;
n := n div 10;
k := k+1; // incr(k);
until n=0;
print_the_digs(k);
end;
{</65>}
{<262>}
{</262>}
{<263>}
{</263>}
{<518>}
{</518>}
{<699>}
{</699>}
{<1355>}
{</1355>}
{<Error handling procedures 78>=}
procedure normalize_selector; forward;
procedure get_token; forward;
procedure term_input; forward;
procedure show_context; forward;
procedure beginfilereading; forward;
procedure open_log_file; forward;
procedure closefilesandterm_inate; forward;
procedure clear_for_error_prompt; forward;
procedure give_err_help; forward;
{debug}
{procedure debughelp; forward;}
{gubed}
{</78>}
{<81>=}
procedure jump_out;
begin
goto end_of_TeX;
end;
{</81>}
{<82>=}
procedure error; {completes the job of error reporting}
label 22,10; // continue, exit
var c: ASCII_code; {what the user types}
s1,s2,s3,s4: integer; {used to save global variables when deleting tokens}
begin
if history < 2 then //if history < error_message_issued then
history := 2; // history := error_message_issued;
print_char("."); {POOL 46}
show_context;
if interaction = 3 then // if interaction = error_stop_mode then
{<Get user's advice and return 83>=}
while true do // loop
begin
22: // continue:}
clear_for_error_prompt;
begin; // prompt_input("? ")}
print("? "); {POOL 264}
term_input;
end;
if last = first then
goto 10; {return;}
c := buffer[first];
if c >= 97 then c := c - 32; {convert to uppercase} // if c >= 'a' then c := c + "A" - "a";
{<Interpret code c and return 84>=}
case c of
"0","1","2","3","4","5","6","7","8","9": {POOL 48,49,50,51,52,53,54,55,56,57}
if deletions_allowed then
{<Delete c - "0" tokens and goto continue 88>=}
begin
s1 := cur_tok;
s2 := cur_cmd;
s3 := cur_chr;
s4 := align_state;
align_state := 1000000;
OK_to_interrupt := false;
if (last > first + 1) and
(buffer[first + 1] >= "0") and {POOL 48}
(buffer[first + 1] <= "9") then {POOL 57}
c := c * 10 + buffer[first + 1] - 48 * 11
else c := c - 48;
while c > 0 do
begin
get_token; {one-level recursive call of error is possible}
c := c - 1; // decr(c);
end;
cur_tok := s1;
cur_cmd := s2;
cur_chr := s3;
align_state := s4;
OK_to_interrupt := true;
begin {help2(...)}
help_ptr := 2;
help_line[1] := "You can now delete more, or insert, or whatever."; {POOL 280}
help_line[0] := "I have just deleted some text, as you asked."; {POOL 270}
end;
show_context;
goto 22; // goto continue;
end;
{</88>}
{debug} (* "D": {POOL 68}
begin
debughelp;
goto 22; {goto continue;}
end;*) {gubed}
"E": {POOL 69}
if base_ptr > 0 then
begin
print_nl("You want to edit file "); {POOL 265}
slow_print(input_stack[base_ptr].name_field);
print(" at line "); {POOL 266}
print_int(line);
interaction := 2;
jump_out;
end;
"H": {POOL 72}
{<Print the help information and goto continue 89>=}
begin
if use_err_help then
begin
give_err_help;
use_err_help := false;
end
else
begin
if help_ptr = 0 then
begin {help2(...)}
help_ptr := 2;
help_line[1] := "Maybe you should try asking a human?"; {POOL 282}
help_line[0] := "Sorry, I don't know how to help in this situation."; {POOL 281}
end;
repeat
help_ptr := help_ptr-1; // decr(help_ptr);
print(help_line[help_ptr]);
print_ln;
until help_ptr=0;
end;
begin {help4(...)}
help_ptr := 4;
help_line[3] := "``If all else fails, read the instructions.''"; {POOL 285}
help_line[2] := "An error might have occurred before I noticed any problems."; {POOL 284}
help_line[1] := "Maybe you should try asking a human?"; {POOL 282}
help_line[0] := "Sorry, I already gave what help I could..."; {POOL 283}
end;
goto 22; // goto continue;
end;
{</89>}
"I": {POOL 73}
{<Introduce new material from the terminal and return 87>=}
begin
beginfilereading; {enter a new syntactic level for terminal input}
{now state = mid_line, so an initial blank space will count as a blank}
if last > first + 1 then
begin
cur_input.loc_field := first + 1; // loc := first + 1;
buffer[first] := " "; {POOL 32}
end
else
begin
begin; // prompt_input(...)
print("insert>"); {POOL 278}
term_input;
end;
cur_input.loc_field := first; // loc := first;
end;
first := last;
cur_input.limit_field := last - 1; {no end_line_char ends this line}
goto 10; // return;
end
{</87>};
"Q","R","S": {POOL 81,82,83}
{Change the interaction level and return>=}
begin
error_count := 0;
interaction := 0 + c - "Q"; {POOL 81}
print(273); {POOL 273}
case c of
"Q": {POOL 81}
begin
print_esc("batch_mode"); {POOL 274}
selector := selector-1;
end;
"R": {POOL 82}
print_esc("nonstopmode"); {POOL 275}
"S": {POOL 83}
print_esc("scrollmode"); {POOL 276}
end;
print("..."); {there are no other cases} {POOL 277}
print_ln;
break(term_out); // update_terminal;
goto 10; // return;
end;
{</86>}
"X": {POOL 88}
begin
interaction := 2;
jump_out;
end;
others: // othercases: do_nothing;
end;
{<Print the menu of available options 85>=}
begin
print("Type <return> to proceed, S to scroll future error messages,"); {POOL 267}
print_nl("R to run without stopping, Q to run quietly,"); {POOL 268}
print_nl("I to insert something, "); // POOL 269
if base_ptr > 0 then
print("E to edit your file,"); // POOL 270
if deletions_allowed
then print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,"); {POOL 271}
print_nl("H for help, X to quit."); {POOL 272}
end;
{</85>}
{</84>}
end;
{</83>}
error_count := error_count+1; // incr(error_count);
if error_count = 100 then
begin
print_nl("(That makes 100 errors; please try again.)"); // POOL 263
history := 3; // history := fatal_error_stop;
jump_out;
end;
{<Put help message on the transcript file 90>=}
if interaction > 0 then // if interaction > batch_mode then
selector := selector - 1; {avoid terminal output} // decr(selector);
if use_err_help then
begin
print_ln;
give_err_help;
end
else while help_ptr > 0 do
begin
help_ptr := help_ptr - 1; // decr(help_ptr);
print_nl(help_line[help_ptr]);
end;
print_ln;
if interaction > 0 then
selector := selector + 1; {re-enable terminal output} // incr(selector);
print_ln;
{</90>}
10: // exit:
end;
{</82>}
{<93>=}
procedure fatal_error(s: str_number); {prints s, and that's it}
begin
normalize_selector;
begin {print_err("Emergency stop");}
if interaction = 3 then; {if interaction=error_stop_mode then wake_up_terminal;}
print_nl("! "); {POOL 262}
print("Emergency stop"); {POOL 287}
end;
begin {help1(s);}
help_ptr := 1;
help_line[0] := s;
end;
begin {succumb;}
if interaction = 3 then interaction := 2;
if log_opened then error;
{debug} {if interaction > 0 then debughelp;} {gubed}
history := 3;
jump_out;
end;
end;
{</93>}
{<94>=}
procedure overflow(s: str_number; n: integer); {stop due to finiteness}
begin
normalize_selector;
begin {print_err(...)}
if interaction = 3 then; {if interaction = error_stop_mode then wake_up_terminal;}
print_nl("! "); {POOL 262}
print("TeX capacity exceeded, sorry ["); {POOL 288}
end;
print(s);
print_char("="); {POOL 61}
print_int(n);
print_char("]"); {POOL 94}
begin {help2(...)}
help_ptr := 2;
help_line[1] := "you can ask a wizard to enlarge me."; {POOL 290}
help_line[0] := "If you really absolutely need more capacity,"; {POOL 289}
end;
begin {succumb;}
if interaction = 3 then interaction := 2;
if log_opened then error;
{debug} {if interaction > 0 then debughelp;} {gubed}
history := 3;
jump_out;
end;
end;
{</94>}
{<95>=}
procedure confusion(s: str_number); {consistency check violated; s tells where}
begin
normalize_selector;
if history < 2 then
begin
begin {print_err(...)}
if interaction = 3 then; {if interaction=error_stop_mode then wake_up_terminal;}
print_nl("! "); {POOL 262}
print("This can't happen ("); {POOL 291}
end;
print(s);
print_char(")"); {POOL 41}
begin {help1(...)}
help_ptr := 1;
help_line[0] := "I'm broken. Please show this to someone who can fix can fix"; {POOL 292}
end;
end
else
begin
begin {print_err(...)}
if interaction=3 then; {if interaction=error_stop_mode then wake_up_terminal;}
print_nl("! ");
print("I can't go on meeting you like this");
end;
begin {help2(...)}
help_ptr := 2;
help_line[1] := "in fact, I'm barely conscious. Please fix it and try again.";
help_line[0] := "One of your faux pas seems to have wounded me deeply...";
end;
end;
begin {succumb;}
if interaction = 3 then interaction := 2;
if log_opened then error;
{debug} {if interaction > 0 then debughelp;} {gubed}
history := 3;
jump_out;
end;
end;
{</95>}
{</4>}
{<27>}
function a_open_in(var f: alpha_file): boolean; {open a text file for input}
begin
reset(f, name_of_file, '/O');
a_open_in := erstat(f)=0; {a_open_in := reset_OK(f);}
end;
function a_open_out(var f: alpha_file): boolean; {open a text file for output}
begin
rewrite(f, name_of_file, '/O');
aopenout := erstat(f)=0; {a_open_out := rewrite_OK(f);}
end;
function b_open_in(var f: byte_file): boolean; {open a binary file for input}
begin
reset(f, name_of_file, '/O');
bopenin := erstat(f)=0; {b_open_in := reset_OK(f);}
end;
function b_open_out(var f: byte_file): boolean; {open a binary file for output}
begin
rewrite(f, name_of_file,'/O');
bopenout := erstat(f)=0; {b_open_out := rewrite_OK(f);}
end;
function w_open_in(var f: word_file): boolean; {open a word file for input}
begin
reset(f, name_of_file, '/O');
wopenin := erstat(f)=0; {w_open_in := reset_OK(f);}
end;
function w_open_out(var f: word_file): boolean; {open a word file for output}
begin
rewrite(f, name_of_file, '/O');
wopenout := erstat(f)=0; {w_open_out := rewrite_OK(f);}
end;
{</27>}
{<28>}
procedure a_close(var f: alpha_file); {close a text file}
begin
close(f);
end;
procedure b_close(var f: byte_file); {close a binary file}
begin
close(f);
end;
procedure w_close(var f: word_file); {close a word file}
begin
close(f);
end;
{</28>}
{<31>}
function input_ln(var f: alpha_file; bypass_eoln: boolean): boolean;
{inputs the next line or returns false}
var last_non_blank: 0..buf_size; {last with trailing blanks removed}
begin
if bypass_eoln then
if not eof(f) then get(f); {input the first character of the line into f^}
last := first; {cf. Matthew 19:30}
if eof(f) then input_ln := false
else
begin
last_non_blank := first;
while not eoln(f) do
begin
if last >= max_buf_stack then
begin
max_buf_stack := last+1;
if max_buf_stack = buf_size then
{<Report overflow of the input buffer, and abort 35>=}
if format_ident = 0 then
begin
write_ln(term_out,'Buffer size exceeded!');
goto final_end;
end
else
begin
cur_input.loc_field := first;
cur_input.limit_field := last-1;
overflow("buffer size",buf_size); {POOL 256}
end;
{</35>}
end;
buffer[last] := xord[f^];
get(f);
last := last+1;
if buffer[last-1] <> " " then {<> 32}
last_nonblank := last;
end;
last := last_nonblank;
input_ln := true;
end;
end;
{</31>}
{<37>}
function init_terminal: boolean; {gets the terminal input started}
label 10; {exit}
begin
reset(term_in,'TTY:','/O/I'); {t_open_in}
while true do {loop}
begin; {wake_up_terminal}
write(term_out,'**');
break(term_out); {update_terminal}
if not input_ln(term_in, true)then
begin
write_ln(term_out);
write(term_out, '! End of file on the terminal... why?');
init_terminal := false;
{return;}
goto 10; {goto exit;}
end;
cur_input.loc_field := first; {loc := first;}
while (cur_input.loc_field < last) and (buffer[cur_input.loc_field] = " ") do
{(buffer[cur_input.loc_field] = 32)}
cur_input.loc_field := cur_input.loc_field + 1; {incr(loc);}
if cur_input.loc_field < last then {if loc < last then}
begin
init_terminal := true;
{return;}
goto 10; {goto exit;}
end;
write_ln(term_out,'Please type the name of your input file.');
end;
10: {exit:}
end;
{</37>}
{<43>}
function make_string: str_number;
begin
if str_ptr = max_strings then
overflow("number of strings",max_strings-init_str_ptr); {POOL 258}
str_ptr := str_ptr + 1; // incr(str_ptr);
str_start[str_ptr] := pool_ptr;
make_string := str_ptr - 1;
end;
{</43>}
{<45>}
function str_eq_buf(s: str_number; k: integer): boolean; {test equality of strings}
label 45; {loop exit} // not_found
var j: pool_pointer; {running index}
result: boolean; {result of comparison}
begin
j := str_start[s];
while j<str_start[s+1] do
begin
if str_pool[j]<>buffer[k]then
begin
result := false;
goto 45; // goto not_found
end;
j := j+1; // incr(j)
k := k+1; // incr(k)
end;
result := true;
45: str_eq_buf := result; // not_found: ...
end;
{</45>}
{<46>}
function str_eq_str(s, t: str_number): boolean; {test equality of strings}
label 45; {loop exit} // not_found
var j,k: pool_pointer; {running indices}
result: boolean; {result of comparison}
begin
result := false;
if (str_start[s + 1] - str_start[s]) <> (str_start[t + 1] - str_start[t]) then
// if length(s) <> length(t) then
goto 45; // goto not_found;
j := str_start[s];
k := str_start[t];
while j < str_start[s+1] do
begin
if str_pool[j]<>str_pool[k]then goto 45;
j := j+1; // incr(j);
k := k+1; // incr(k);
end;
result := true;
45: str_eq_str := result; // not_found: ...
end;
{</46>}
{<47>}
{init}
function get_strings_started boolean; {initializes the string pool, but returns
false if something goes wrong}
label 30, 10; // done, exit;
var k, l: 0..255; {small indices or counters}
m, n: char; {characters input from |pool_file|}
g: str_number; {garbage}
a: integer; {accumulator for check sum}
c: boolean; {check sum has been checked}
begin
pool_ptr := 0;
str_ptr := 0;
str_start[0] := 0;
{<Make the first 256 strings 48>=}
for k := 0 to 255 do
begin
if ({<Character c cannot be printed 49>=}(k < " ") {POOL 32} or (k > "~") {POOL 126} {</49>})then
begin
begin
// append_char("^");
str_pool[pool_ptr] := "^"; // ... := si("^"); {POOL 94}
pool_ptr := pool_ptr+1;
end;
begin
// {append_char("^");
str_pool[pool_ptr] := "^"; // ... := si("^"); {POOL 94}
pool_ptr := pool_ptr+1;
end;
if k < 64 then // octal 100
begin
// append_char(k + '100);
str_pool[pool_ptr] := k+64;
pool_ptr := pool_ptr+1;
end
else if k < 128 then // octal 200
begin
// append_char(k - '100);
str_pool[pool_ptr] := k-64;
pool_ptr := pool_ptr+1;
end
else
begin
// app_lc_hex(k div 16);
l := k div 16;
if l<10 then
begin
str_pool[pool_ptr] := l+48;
pool_ptr := pool_ptr+1;
end
else
begin
str_pool[pool_ptr] := l+87;
pool_ptr := pool_ptr+1;
end;
// app_lc_hex(k mod 16)
l := k mod 16;
if l<10 then
begin
str_pool[pool_ptr] := l+48;
pool_ptr := pool_ptr+1;
end
else
begin
str_pool[pool_ptr] := l+87;
pool_ptr := pool_ptr+1;
end;
end;
end
else
begin
// append_char(k);
str_pool[pool_ptr] := k;
pool_ptr := pool_ptr+1;
end;
g := make_string;
end;
{</48>}
{<Read the other strings from the TEX.POOL file and return true, or give an
error message and return false 51>=}
name_of_file := pool_name; {we needn't set name_length}
if a_open_in(pool_file) then
begin
c := false;
repeat
{<Read one string, but return false if the string memory space
is getting too tight for comfort 52>=}
begin
if eof(pool_file) then
// bad_pool('! TEX.POOL has no check sum');
begin;
write_ln(term_out,'! TEX.POOL has no check sum.');
a_close(pool_file);
get_strings_started := false;
goto 10; {return;}
end;
read(pool_file,m,n); {read two digits of string length}
if m = '*' then
{<Check the pool check sum 53>=}
begin
a := 0;
k := 1;
while true do
begin
if (xord[n] < 48) or (xord[n] > 57) then
// bad_pool('! TEX.POOL check sum doesn''t have nine digits.')
begin;
write_ln(term_out,'! TEX.POOL check sum doesn''t have nine digits.');
a_close(pool_file);
get_strings_started := false;
goto 10;
end;
a := 10 * a + xord[n] - "0"; {POOL 48}
if k = 9 then goto 30; // goto done;
k := k+1; // incr(k);
read(pool_file,n);
end;
{done:} 30: if a <> 117275187 then
// bad_pool('! TEX.POOL doesn''t match; TANGLE me again.')
begin;
write_ln(term_out,'! TEX.POOL doesn''t match; TANGLE me again.');
a_close(pool_file);
get_strings_started := false;
goto 10; // return;
end;
c := true;
end
{</53>}
else
begin
if (xord[m] < 48) or (xord[m] > 57) or (xord[n] < 48) or (xord[n] > 57) then
// bad_pool('! TEX.POOL line doesn''t begin with two digits.');
begin;
write_ln(term_out,'! TEX.POOL line doesn''t begin with two digits.');
a_close(pool_file);
get_strings_started := false;
goto 10;
end;
l := xord[m] * 10 + xord[n] - "0" {POOL 48} * 11;
if pool_ptr + l + string_vacancies > pool_size then
// bad_pool('! You have to increase POOLSIZE.')
begin;
write_ln(term_out,'! You have to increase POOLSIZE.');
a_close(pool_file);
get_strings_started := false;
goto 10;
end;
for k:=1 to l do
begin
if eoln(pool_file)then m := ' '
else read(pool_file,m);
// append_char(xord[m])
begin
str_pool[pool_ptr] := xord[m];
pool_ptr := pool_ptr+1;
end;
end;
read_ln(pool_file);
g := make_string;
end;
end;
{</52>}
until c;
a_close(pool_file);
get_strings_started := true;
end
else
// bad_pool('! I can''t read TEX.POOL.');
begin;
write_ln(term_out,'! I can''t read TEX.POOL.');
a_close(pool_file);
get_strings_started := false;
goto 10;
end;
{</51>}
10: {exit:}
end;
{</47>}
{tini}
{<66>}
procedure print_two(n: integer); {prints two least significant digits}
begin
n := abs(n) mod 100;
print_char("0" + (n div 10)); {POOL 48}
print_char("0" + (n mod 10)); {POOL 48}
end;
{</66>}
{<67>}
procedure print_hex(n: integer); {prints a positive integer in hexadecimal form}
var k: 0..22; {index to current digit; we assume that n < 16^22}
begin
k := 0;
print_char(""""); {POOL 34}
repeat
dig[k] := n mod 16;
n := n div 16;
k := k+1; // incr(k)
until n=0;
print_the_digs(k);
end;
{</67>}
{<69>}
procedure print_roman_int(n: integer);
label 10; {exit}
var j, k: pool_pointer; {mysterious indices into str_pool}
u, v: nonnegative_integer; {mysterious numbers}
begin
j := str_start["m2d5c2l5x2v5i"]; {POOL 260}
v := 1000;
while true do
begin
while n >= v do
begin
print_char(str_pool[j]);
n := n - v;
end;
if n <= 0 then
goto 10; {nonpositive input produces no output} // return;
k := j + 2;
u := v div(str_pool[k - 1] - "0"); {POOL 48}
if str_pool[k - 1] = "2" then // POOL 50 // ... si("2") then
begin
k := k + 2;
u := u div (str_pool[k - 1] - "0"); // POOL 48
end;
if n + u >= v then
begin
print_char(str_pool[k]);
n := n + u;
end
else
begin
j := j + 2;
v := v div(str_pool[j - 1] - "0"); // POOL 48
end;
end;
10: {exit}
end;
{</69>}
{<70>}
procedure print_current_string; {print a yet-unmade string}
var j: pool_pointer; {points to current character code}
begin
j := str_start[str_ptr];
while j < pool_ptr do
begin
print_char(str_pool[j]);
j := j + 1; // incr(j)
end;
end;
{</70>}
{<71>}
procedure term_input; {gets a line from the terminal}
var k: 0..buf_size; {index into buffer}
begin
break(term_out); {now the user sees the prompt for sure} // update_terminal
if not input_ln(term_in, true) then
fatal_error("End of file on the terminal!"); // POOL 161
term_offset := 0;
selector := selector - 1; // decr(selector);
if last <> first then
for k := first to last - 1 do
print(buffer[k]);
print_ln;
selector := selector + 1; // incr(selector);
end;
{</71>}
{<91>}
procedure int_error(n: integer);
begin
print(" ("); // POOL 286
print_int(n);
print_char(")"); // POOL 41
error;
end;
{</91>}
{<92>}
procedure normalize_selector;
begin
if log_opened then selector := 19 // ...selector := term_and_log
else selector := 17; // else selector := term_only
if job_name = 0 then open_log_file;
if interaction = 0 then // if interaction = batch_mode then
selector := selector-1; // decr(selector);
end;
{</92>}
{<98>}
procedure pause_for_instructions;
begin
if ok_to_interrupt then
begin
interaction := 3; // interaction := error_stop_mode
if (selector = 18) or // if (selector = log_only) or
(selector = 16) then // (selector = no_print) then
selector := selector + 1; // incr(selector)
begin {print_err(...)}
if interaction = 3 then;
print_nl("! "); // POOL 262
print("Interruption"); // POOL 296
end;
begin // help3(...)
help_ptr := 3;
help_line[2] := "unless you just want to quit by typing `X'."; // POOL 297
help_line[1] := "Try to insert some instructions for me (e.g.,`I\showlists'),"; // POOL 298
help_line[0] := "You rang?"; // POOL 299
end;
deletions_allowed := false;
error;
deletions_allowed := true;
interrupt := 0;
end;
end;
{</98>}
{<100>}
function half(x: integer): integer;
begin
if odd(x) then half := (x + 1) div 2
else half := x div 2;
end;
{</100>}
{<102>}
function round_decimals(k: small_number): scaled; {converts a decimal fraction}
var a: integer; {the accumulator}
begin
a := 0;
while k > 0 do
begin
k := k - 1; // decr(k);
a := (a + dig[k] * 131072) div 10;
end;
round_decimals := (a + 1) div 2;
end;
{</102>}
{<103>}
procedure print_scaled(s: scaled); {prints scaled real, rounded to five digits}
var delta: scaled; {amount of allowable inaccuracy}
begin
if s < 0 then
begin
print_char("-"); {print the sign, if negative} // POOL 45
s := -s; // negate(s);
end;
print_int(s div 65536); {print the integer part} // ...(s div unity);
print_char("."); // POOL 46
s := 10 * (s mod 65536) + 5; // ...(s mod unity) + 5;
delta := 10;
repeat
if delta > 65536 then s := s - 17232; {round the last digit} // if delta > unity then s := s + '100000 - 5000;
print_char("0" + (s div 65536)); // ...(s div unity); // POOL 48
s := 10 * (s mod 65536); // ...(s mod unity);
delta := delta * 10;
until s <= delta;
end;
{</103>}
{<105>}
function mult_and_add(n: integer; x, y, max_answer: scaled): scaled;
begin
if n < 0 then
begin
x := -x; // negate(x);
n := -n; // negate(n);
end;
if n = 0 then mult_and_add := y
else if ((x <= (max_answer - y) div n) and (-x <= (max_answer + y) div n))
then mult_and_add := n * x + y
else
begin
arith_error := true;
mult_and_add := 0;
end;
end;
{</105>}
{<106>}
function x_over_n(x: scaled; n: integer): scaled;
var negative: boolean; {should remainder be negated?}
begin
negative := false;
if n = 0 then
begin
arith_error := true;
x_over_n := 0;
remainder := x;
end
else
begin
if n < 0 then
begin
x := -x;
n := -n;
negative := true;
end;
if x >= 0 then
begin
x_over_n := x div n;
remainder := x mod n;
end
else
begin
x_over_n := -((-x) div n);
remainder := -((-x) mod n);
end;
end;
if negative then
remainder := -remainder; // negate(remainder)
end;
{</106>}
{<107>}
function xn_over_d(x: scaled; n, d: integer): scaled;
var positive: boolean; {was x >= 0?}
t, u, v: nonnegative_integer; {intermediate quantities}
begin
if x >= 0 then positive := true
else
begin
x := -x; // negate(x);
positive := false;
end;
// 32768 is '100000
t := (x mod 32768) * n;
u := (x div 32768) * n + (t div 32768);
v := (u mod d) * 32768 + (t mod 32768);
if u div d >= 32768 then arith_error := true
else u := 32768 * (u div d) + (v div d);
if positive then
begin
xn_over_d := u;
remainder := v mod d;
end
else
begin
xn_over_d := -u;
remainder := -(v mod d);
end;
end;
{</107>}
{<108>}
function badness(t, s: scaled): halfword; {compute badness, given t >= 0}
var r: integer; {approximation to at/s, where a^3 ~=~ 100*2^18}
begin
if t = 0 then
badness := 0
else if s <= 0 then
badness := 10000 // badness := inf_bad
else
begin
if t <= 7230584 then
r := (t * 297) div s {273^3 = 99.4 * 2^18}
else if s >= 1663497 then
r := t div (s div 297)
else r := t;
if r > 1290 then
badness := 10000 {1290^3 < 2^31 < 1291^3} // badness := inf_bad
else
badness := (r * r * r + 131072) div 262144; // ...(r*r*r+'400000) div '1000000
end; {that was (r^3)/(2^18), rounded to the nearest integer}
end;
{<108>}
{<114>}
{<debug>}
(*
procedure printword(w: memory_word); {prints w in all ways}
begin
print_int(w.int); print_char(" "); {POOL 32}
print_scaled(w.int); print_char(" "); {POOL 32}
print_scaled(round(65536*w.gr)); print_ln;
print_int(w.hh.lh); print_char("="); {POOL 61}
print_int(w.hh.b0); print_char(":"); {POOL 58}
print_int(w.hh.b1); print_char(";"); {POOL 59}
print_int(w.hh.rh); print_char(" "); {POOL 32}
print_int(w.qqqq.b0); print_char(":"); {POOL 58}
print_int(w.qqqq.b1); print_char(":"); {POOL 58}
print_int(w.qqqq.b2); print_char(':'); {POOL 58}
print_int(w.qqqq.b3);
end;
*)
{gubed}
{</114>}
{<119>}
{<292>}
{</292>}
{<306>}
{</306>}
{</119>}
{<120>}
function get_avail: pointer; {single-word node allocation}
var p: pointer; {the new node being got}
begin
p := avail; {get top location in the avail stack}
if p <> 0 then avail := mem[avail].hh.rh {and pop it off} // ...avail := link(avail)
else if mem_end < mem_max then {or go into virgin territory}
begin
mem_end := mem_end + 1; // incr(mem_end)
p := mem_end;
end
else
begin
hi_mem_min := hi_mem_min - 1; // decr(hi_mem_min)
p := hi_mem_min;
if hi_mem_min <= lo_mem_max then
begin
runaway; {if memory is exhausted, display possible runaway text}
overflow("main memory size",
mem_max + 1 - mem_min); {quit; all one-word nodes are busy} // POOL 300
end;
end;
mem[p].hh.rh := 0; {provide an oft-desired initialization of the new node} // link(p) := null;
{stat} {dyn_used:=dyn_used+1;} {tats} {maintain statistics} // incr(dyn_used);
get_avail := p;
end;
{</120>}
{<123>}
procedure flush_list(p: pointer); {makes list of single-word nodes available}
var q, r: pointer; {list traversers}
begin
if p <> 0 then // if p <> null then
begin
r := p;
repeat
q := r;
r := mem[r].hh.rh;
{stat} {dyn_used:=dyn_used-1;} {tats}
until r = 0; {now q is the last node on the list} // until r = null;
mem[q].hh.rh := avail; // link(q) := avail;
avail := p;
end;
end;
{</123>}
{<125>}
function get_node(s: integer): pointer; {variable-size node allocation}
label 40, 10, 20; // found, exit, restart
var p: pointer; {the node currently under inspection}
q: pointer; {the node physically after node p}
r: integer; {the newly allocated node, or a candidate for this honor}
t: integer; {temporary register}
begin
20: // restart:
p := rover;
repeat
{<Try to allocate within node p and its physical successors,
and goto found if allocation was possible 127>=}
q := p + mem[p].hh.lh; {find the physical successor} // q := p + node_size(p);
while (mem[q].hh.rh = 65535) do {merge node p with node q} // while is_empty(q) do
begin
t := mem[q + 1].hh.rh; // begin t := rlink(q)
if q = rover then rover := t;
mem[t + 1].hh.lh := mem[q + 1].hh.lh; // llink(t) := llink(q);
mem[mem[q + 1].hh.lh + 1].hh.rh := t; // rlink(llink(q)) := t
q := q + mem[q].hh.lh; // q := q + node_size(q);
end;
r := q - s;
if r > p + 1 then
{<Allocate from the top of node p and goto found 128>=}
begin
mem[p].hh.lh := r - p; {store the remaining size} // node_size(p) := r - p;
rover := p; {start searching here next time}
goto 40; // goto found;
end;
{</128>}
if r = p then
if mem[p + 1].hh.rh <> p then // if rlink(p) <> p
{<Allocate entire node p and goto found 129>=}
begin
rover := mem[p + 1].hh.rh; // rover := rlink(p);
t := mem[p + 1].hh.lh; // t := llink(p);
mem[rover + 1].hh.lh := t; // llink(rover) := t;
mem[t + 1].hh.rh := rover; // rlink(t) := rover;
goto 40; // goto found;
end;
{</129>}
mem[p].hh.lh := q - p; // node_size(p) := q - p;
{</127>}
p := mem[p + 1].hh.rh; {move to the next node in the ring} // p := rlink(p);
until p = rover; {repeat until the whole list has been traversed}
if s = 1073741824 then // if s = '10000000000 then
begin
get_node := 65535; // get_node := max_halfword;
goto 10; // return;
end;
if lo_mem_max + 2 < hi_mem_min then
if lo_mem_max + 2 <= 65535 then
{<Grow more variable-sized memory and goto restart 126>=}
begin
if hi_mem_min - lo_mem_max >= 1998 then
t := lo_mem_max + 1000
else t := lo_mem_max + 1 + (hi_mem_min - lo_mem_max) div 2; {lo_mem_max + 2 <= t < hi_mem_min}
p := mem[rover + 1].hh.lh; // p := llink(rover);
q := lo_mem_max;
mem[p + 1].hh.rh := q; // rlink(p) := q;
mem[rover + 1].hh.lh := q; // llink(rover) := q;
if t > 65535 then t := 65535; // if t > mem_bot + max_halfword then t := max_halfword;
mem[q + 1].hh.rh := rover; // rlink(q) := rover;
mem[q+1].hh.lh := p; // llink(q) := p;
mem[q].hh.rh := 65535; // link(q) := empty_flag;
mem[q].hh.lh := t - lo_mem_max; // node_size(q) := t - lo_mem_max;
lo_mem_max := t;
mem[lo_mem_max].hh.rh := 0; // link(lo_mem_max) := null;
mem[lo_mem_max].hh.lh := 0; // info(lo_mem_max) := null;
rover := q;
goto 20; // goto restart;
end;
{</126>}
overflow("main memory size", mem_max + 1 - mem_min); {sorry, nothing satisfactory is left} // POOL 300
40: mem[r].hh.rh := 0; {this node is now nonempty}
{stat} {var_used := var_used + s;} {tats} {maintain usage statistics}
get_node := r;
10:
end;
{</125>}
{<130>}
procedure free_node(p: pointer; s: halfword); {variable-size node liberation}
var q: pointer; {llink(rover)}
begin
{set both links}
mem[p].hh.lh := s; // node_size(p) := s;
mem[p].hh.rh := 65535; // link(p) := empty_flag;
q := mem[rover + 1].hh.lh; // q := llink(rover);
mem[p + 1].hh.lh := q; // llink(p) := q;
{insert p into the ring}
mem[p + 1].hh.rh := rover; // rlink(p) := rover;
mem[rover + 1].hh.lh := p; // llink(rover) := p;
mem[q + 1].hh.rh := p; // rlink(q) := p;
{stat} {var_used:=var_used-s;} {tats} {maintain statistics}
end;
{</130>}
{init}
{<131>}
procedure sort_avail; {sorts the available variable-sized nodes by location}
var p, q, r: pointer; {indices into mem}
old_rover: pointer; {initial rover setting}
begin
p := get_node(1073741824); {merge adjacent free areas} // p:= get_node('10000000000);
p := mem[rover + 1].hh.rh; // p := rlink(rover);
mem[rover + 1].hh.rh := 65535; // rlink(rover) := max_halfword;
old_rover := rover;
while p <> old_rover do
{<Sort p into the list starting at rover and advance p to rlink(p) 132>=}
if p < rover then
begin
q := p;
p := mem[ q + 1].hh.rh; // p := rlink(q);
mem[q + 1].hh.rh := rover; // rlink(q) := rover;
rover := q;
end
else
begin
q := rover;
while mem[q + 1].hh.rh < p do // while rlink(q) < p do
q := mem[q + 1].hh.rh; // q := rlink(q);
r := mem[p + 1].hh.rh; // r := rlink(p)
mem[p + 1].hh.rh := mem[q + 1].hh.rh; // rlink(p) := rlink(q);
mem[q + 1].hh.rh := p; // rlink(q) := p;
p := r;
end;
{</132>}
p := rover;
while mem[p + 1].hh.rh <> 65535 do // while rlink(p) <> max_halfword do
begin
mem[mem[p + 1].hh.rh + 1].hh.lh := p; // llink(rlink(p)) := p;
p := mem[p + 1].hh.rh; // p := rlink(p);
end;
mem[p + 1].hh.rh := rover; // rlink(p) := rover;
mem[rover + 1].hh.lh := p; // llink(rover) := p;
end;
{</131>}
{tini}
{<136>}
function new_null_box: halfword; {creates a new box node}
var p: halfword; {the new node}
begin
p := get_node(7); // p := get_node(box_node_size);
mem[p].hh.b0 := 0; // type(p) := hlist_node;
mem[p].hh.b1 := 0; // subtype(p) := min_quarterword;
mem[p + 1].int := 0; // width(p) := 0;
mem[p + 2].int := 0; // depth(p) := 0;
mem[p + 3].int := 0; // height(p) := 0;
mem[p + 4].int := 0; // shift_amount(p) := 0;
mem[p + 5].hh.rh := 0; // list_ptr(p) := null;
mem[p + 5].hh.b0 := 0; // glue_sign(p) := normal;
mem[p + 5].hh.b1 := 0; // glue_order(p) := normal;
mem[p + 6].gr := 0.0; // set_glue_ratio_zero(glue_set(p));
new_null_box := p;
end;
{<136>}
{<139>}
function new_rule: pointer;
var p: pointer;
begin
p := get_node(4); // p := get_node(node_size);
mem[p].hh.b0 := 2; // type(p) := rule_node;
mem[p].hh.b1 := 0; // subtype(p) := 0;
mem[p+1].int := -1073741824; // width(p) := null_flag;
mem[p+2].int := -1073741824; // depth(p) := null_flag;
mem[p+3].int := -1073741824; // height(p) := null_flag;
new_rule := p;
end;
{</139>}
{<144>}
function new_ligature(f, c: quarterword; q: pointer): pointer;
var p: pointer; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 6; // type(p) := ligature_node;
mem[p + 1].hh.b0 := f; // font(lig_char(p)) := f;
mem[p + 1].hh.b1 := c; // character(lig_char(p)) := c
mem[p + 1].hh.rh := q; // lig_ptr(p) := q;
mem[p].hh.b1 := 0; // subtype(p) := 0;
new_ligature := p;
end;
function new_lig_item(c: quarterword): pointer;
var p: halfword; {the new node} // var p: pointer
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b1 := c; // character(p) := c;
mem[p + 1].hh.rh := 0; // lig_ptr(p) := null;
new_lig_item := p;
end;
{<144>}
{<145>}
function new_disc: pointer; {creates an empty disc_node}
var p: pointer; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 7; // type(p) := disc_node;
mem[p].hh.b1 := 0; // replace_count(p) := 0;
mem[p + 1].hh.lh := 0; // pre_break(p) := null;
mem[p + 1].hh.rh := 0; // post_break(p) := null;
new_disc := p;
end;
{</145>}
{<147>}
function new_math(w: scaled; s: small_number): pointer;
var p: pointer; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 9; // type(p) := math_node;
mem[p].hh.b1 := s; // subtype(p) := s;
mem[p + 1].int := w; // width(p) := w;
new_math := p;
end;
{</147>}
{<151>}
function new_spec(p: pointer): pointer; {duplicates a glue specification}
var q: pointer; {the new spec}
begin
q := get_node(4); // q := get_node(glue_spec_size);
mem[q] := mem[p];
mem[q].hh.rh := 0; // glue_ref_count(q) := null;
mem[q + 1].int := mem[p + 1].int; // width(q) := width(p);
mem[q + 2].int := mem[p + 2].int; // stretch(q) := stretch(p);
mem[q + 3].int := mem[p + 3].int; // shrink(q) := shrink(p);
new_spec := q;
end;
{</151>}
{<152>}
function new_param_glue(n: small_number): pointer;
var p: pointer; {the new node}
q: pointer; {the glue specification}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 10; // type(p) := glue_node;
mem[p].hh.b1 := n + 1; // subtype(p) := n + 1;
mem[p + 1].hh.rh := 0; // leader_ptr(p) := null;
q :=
{<Current mem equivalent of glue parameter number n 224>=}
eqtb[2882 + n].hh.rh; // glue_par(n)
{</224>}
mem[p + 1].hh.lh := q;
mem[q].hh.rh := mem[q].hh.rh + 1;
new_param_glue := p;
end;
{<152>}
{<153>}
function new_glue(q: pointer): pointer;
var p: pointer; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 10; // type(p) := glue_node;
mem[p].hh.b1 := 0; // subtype(p) := normal;
mem[p + 1].hh.rh := 0; // leader_ptr(p) := null;
mem[p + 1].hh.lh := q; // glue_ptr(p) := q;
mem[q].hh.rh := mem[q].hh.rh + 1; // incr(glue_ref_count(q));
new_glue := p;
end;
{<153>}
{<154>}
function new_skip_param(n: small_number): pointer;
var p: pointer; {the new node}
begin
temp_ptr := new_spec(
{<Current mem equivalent of glue parameter number n 224>=}
eqtb[2882 + n].hh.rh; // glue_par(n)
{</224>});
p := new_glue(temp_ptr);
mem[temp_ptr].hh.rh := 0; // glue_ref_count(temp_ptr) := null;
mem[p].hh.b1 := n + 1; // subtype(p) := n + 1;
new_skip_param := p;
end;
{</154>}
{<156>}
function new_kern(w: scaled): pointer;
var p: halfword; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 11; // type(p) := kern;
mem[p].hh.b1 := 0; // subtype(p) := normal;
mem[p + 1].int := w; // width(p) := w;
new_kern := p;
end;
{</156>}
{<158>}
function new_penalty(m: integer): pointer;
var p: pointer; {the new node}
begin
p := get_node(2); // p := get_node(small_node_size);
mem[p].hh.b0 := 12; // type(p) := penalty;
mem[p].hh.b1 := 0; {the subtype is not used} // subtype(p) := 0;
mem[p + 1].int := m; // penalty(p) := w;
new_penalty := p;
end;
{</158>}
{<167>}
{debug} (*
procedure check_mem(print_locs: boolean);
label 31, 32; {loop exits} // label done1, done2;
var p, q: pointer; {current locations of interest in mem}
clobbered: boolean; {is something amiss?}
begin
for p := mem_min to lo_mem_max do {you can probably do this faster}
free[p] := false;
for p:=hi_mem_min to mem_end do {ditto}
free[p] := false;
{<Check single-word avail list 168>=}
p := avail; q := 0;
clobbered := false;
while p <> 0 do
begin
if(p > mem_end) or (p < hi_mem_min) then
clobbered := true
else if free[p] then
clobbered := true;
if clobbered then
begin
print_nl("AVAIL list clobbered at "); // POOL 301
print_int(q);
goto 31; // goto done1;
end;
free[p] := true;
q := p;
p := mem[q].hh.rh;
end;
31: {</168>};
{<Check variable-size avail list 169>=}
p := rover;
q := 0;
clobbered := false;
repeat
if(p >= lo_mem_max) or (p < mem_min) then
clobbered := true
else if (mem[p + 1].hh.rh >= lo_mem_max) or
(mem[p + 1].hh.rh < mem_min) then
clobbered := true
else if not ((mem[p].hh.rh = 65535)) or (mem[p].hh.lh < 2) or
(p + mem[p].hh.lh > lo_mem_max) or
(mem[mem[p + 1].hh.rh + 1].hh.lh <> p) then
clobbered := true;
if clobbered then
begin
print_nl("Double−AVAIL list clobbered at "); // POOL 302
print_int(q);
goto 32; // goto done2;
end;
for q := p to p + mem[p].hh.lh - 1 do {mark all locations free} // for q := p to p + node_size(p) - 1 do
begin
if free[q] then
begin
print_nl("Doubly free location at "); // POOL 303
print_int(q);
goto 32; // goto done2;
end;
free[q] := true;
end;
q := p;
p := mem[p + 1].hh.rh; // p := rlink(p);
until p = rover;
32: {</169>};
{<Check flags of unavailable nodes 170>=}
p := mem_min;
while p <= lo_mem_max do {node p should not be empty}
begin
if (mem[p].hh.rh = 65535) then // if is_empty(p) then
begin
print_nl("Bad flag at "); // POOL 304
print_int(p);
end;
while (p <= lo_mem_max) and not free[p] do
p := p + 1; // incr(p);
while(p <= lo_mem_max) and free[p]do
p := p + 1; // incr(p);
end;
{</170>}
if print_locs then
{<Print newly busy locations 171>=}
begin
print_nl("New busy locs:"); // POOL 305
for p := mem_min to lo_mem_max do
if not free[p]and ((p > was_lo_max) or was_free[p]) then
begin
print_char(" "); // POOL 32
print_int(p);
end;
for p := hi_mem_min to mem_end do
if not free[p] and ((p < was_hi_min) or
(p > was_mem_end) or was_free[p]) then
begin
print_char(" "); // POOL 32
print_int(p);
end;
end;
{</171>}
for p := mem_min to lo_mem_max do
was_free[p] := free[p];
for p := hi_mem_min to mem_end do
was_free[p]:=free[p]; {was_free := free might be faster}
was_mem_end := mem_end;
was_lo_max := lo_mem_max;
was_hi_min := hi_mem_min;
end;
{gubed} *)
{</167>}
{<172>}
{debug} (*
procedure search_mem(p: pointer); {look for pointers to p}
var q: integer; {current position being searched}
begin
for q := mem_min to lo_mem_max do
begin
if mem[q].hh.rh = p then // if link(q) = p then
begin
print_nl("LINK("); // POOL 306
print_int(q);
print_char(")"); // POOL 41
end;
if mem[q].hh.lh = p then // if info(q) = p then
begin
print_nl("INFO("); // POOL 307
print_int(q);
print_char(")"); // POOL 41
end;
end;
for q := hi_mem_min to mem_end do
begin
if mem[q].hh.rh = p then // if link(q) = p then
begin
print_nl("LINK("); // POOL 306
print_int(q);
print_char(")"); // POOL 41
end;
if mem[q].hh.lh = p then // if info(q) = p then
begin
print_nl("INFO("); // POOL 307
print_int(q);
print_char(")"); // POOL 41
end;
end;
{<Search eqtb for equivalents equal to p 255>=}
for q := 1 to 3933 do // for q := active_base to box_base + 255 do
begin
if eqtb[q].hh.rh = p then
begin
print_nl("EQUIV("); // POOL 501
print_int(q);
print_char(")"); // POOL 41
end;
end
{</255>};
{<Search save stack for equivalents that point to p 285>=}
if save_ptr > 0 then
for q := 0 to save_ptr - 1 do
begin
if save_stack[q].hh.rh = p then // if equiv_field(save_stack(q)) = p then
begin
print_nl("SAVE("); // POOL 546
print_int(q);
print_char(")"); // POOL 41
end;
end;
{</285>}
{<Search hyph list for pointers to p 933>=}
for q := 0 to 307 do // for q := 0 to hyph_size do
begin
if hyph_list[q] = p then
begin
print_nl("HYPH("); // POOL 939
print_int(q);
print_char(")"); // 41
end;
end;
{</933>}
end;
{gubed} *)
{</172>}
{<174>}
procedure short_display(p: integer); {prints highlights of list p}
var n: integer; {for replacement counts}
begin
while p > mem_min do
begin
if (p >= hi_mem_min) then // if is_char_node(p) then
begin
if p <= mem_end then
begin
if mem[p].hh.b0 <> font_in_short_display then // if font(p) <> font_in_short_display then
begin
if (mem[p].hh.b0 < 0) or // if font(p) < font_base or
(mem[p].hh.b0 > font_max) then // font(p) > font_max then
print_char("*") // POOL 42
else
{<Print the font identifier for font(p) 267>=}
print_esc(hash[2624 + mem[p].hh.b0].rh); // print_esc(font_id_text(font(p)));
{</267>}
print_char(" "); // POOL 32
font_in_short_display := mem[p].hh.b0; // font_in_short_display := font(p);
end;
print(mem[p].hh.b1 - 0); // print_ASCII(qo(character(p)));
end;
end
else
{<Print a short indication of the contents of node p 175>=}
case mem[p].hh.b0 of // case type(p) of
0, 1, 3, 8, 4, 5, 13: // hlist_node, vlist_node, ins_node, whatsit_node, mark_node, adjust_node, unset_node:
print("[]"); // POOL 308
2: // rule_node:
print_char("|");
10: // glue_node:
if mem[p + 1].hh.lh <> 0 then // if glue_ptr(p) <> 0 then
print_char(" "); // POOL 32
9: // math_node:
print_char("$"); // POOL 36
6: // ligature_node:
short_display(mem[p + 1].hh.rh); // short_display(lig_ptr(p));
7: // disc_node:
begin
short_display(mem[p + 1].hh.lh); // short_display(pre_break(p));
short_display(mem[p + 1].hh.rh); // short_display(post_break(p));
n := mem[p].hh.b1; // n := replace_count(p);
while n > 0 do
begin
if mem[p].hh.rh <> 0 then // if link(p) <> null then
p := mem[p].hh.rh; // p := link(p);
n := n - 1; // decr(n);
end;
end;
others:
end;
{</175>}
p := mem[p].hh.rh;
end;
end;
{:174}
{<176>}
procedure print_font_and_char(p: integer); {prints char_node data}
begin
if p > mem_end then
print_esc("CLOBBERED.") // POOL 309
else
begin
if (mem[p].hh.b0 < 0) or // if (font(p) < font_base) or
(mem[p].hh.b0 > font_max) then // (font(p) > font_max) then
print_char("*") // POOL 42
else
{<Print the font identifier for font(p) 267>=}
print_esc(hash[2624 + mem[p].hh.b0].rh); // print_esc(font_id_text(font(p)));
{</267>}
print_char(" "); // POOL 32
print(mem[p].hh.b1 - 0); // print_ASCII(qo(character(p)));
end;
end;
procedure print_mark(p: integer); {prints token list data in braces}
begin
print_char("{"); // POOL 123
if (p < hi_mem_min) or (p > mem_end) then
print_esc("CLOBBERED.") // POOL 309
else
show_token_list(mem[p].hh.rh, 0, max_print_line - 10); // show_token_list(link(p), null, max_print_line - 10);
print_char("}"); // POOL 125
end;
procedure print_rule_dimen(d: scaled); {prints dimension in rule node}
begin
if (d = -1073741824) then // if is_running(d) then
print_char("*") // POOL 42
else
print_scaled(d);
end;
{</176>}
{<177>}
procedure print_glue(d: scaled; order: integer; s: str_number); {prints a glue component}
begin
print_scaled(d);
if (order < 0) or (order > 3) then // if (order < normal) or (order > filll) then
print("foul") // POOL 310
else if order > 0 then
begin
print("fil"); // POOL 311
while order > 1 do // while order > fil do
begin
print_char("l"); // POOL 108
order := order - 1; // decr(order);
end;
end
else if s <> 0 then
print(s);
end;
{</177>}
{<178>}
procedure print_spec(p: integer; s: str_number); {prints a glue specification}
begin
if (p < mem_min) or (p >= lo_mem_max) then
print_char("*") // POOL 42
else
begin
print_scaled(mem[p + 1].int); // print_scaled(width(p));
if s <> 0 then
print(s);
if mem[p + 2].int <> 0 then // if stretch(p) <> 0 then
begin
print(" plus "); // POOL 312
print_glue(mem[p + 2].int, mem[p].hh.b0, s); // print_glue(stretch(p), stretch_order(p), s)
end;
if mem[p + 3].int <> 0 then // if shrink(p) <> 0 then
begin
print(" minus "); // POOL 313
print_glue(mem[p + 3].int, mem[p].hh.b1, s); // print_glue(stretch(p), stretch_order(p), s)
end;
end;
end;
{</178>}
{<179>}
{<Declare procedures needed for displaying the elements of mlists 691>=}
{<692>}
{</692>}
{<694>}
{</694>}
{</691>}
{<Declare the procedure called print_skip_param 225>=}
{</225>}
{</179>}
{<182>}
procedure show_node_list(p: integer); {prints a node list symbolically}
label 10; // label exit;
var n: integer; {the number of items already printed at this level}
g: real; {a glue ratio, as a floating point number}
begin
if (pool_ptr - str_start[str_ptr]) > depth_threshold then // if cur_length > depth_threshold then
begin
if p > 0 then // if p > null then
print(" []"); {indicate that there's been some truncation} // POOL 314
goto 10; // return;
end;
n := 0;
while p > mem_min do
begin
print_ln;
print_current_string; {display the nesting history}
if p>mem_end then {pointer out of range}
begin
print("Bad link, display aborted."); // POOL 315
goto 10; // return;
end;
n := n + 1; // incr(n);
if n > breadth_max then {time to stop}
begin
print("etc."); // POOL 316
goto 10; // return;
end;
{183:}
if (p>=hi_mem_min)then print_font_and_char(p)
else
case mem[p].hh.b0 of
0, 1, 13:
{184:}
begin
if mem[p].hh.b0=0 then print_esc(104)
else if mem[p].hh.
b0=1 then print_esc(118)
else print_esc(318);
print(319);
print_scaled(mem[p+3].int);
print_char(43);
print_scaled(mem[p+2].int);
print(320);
print_scaled(mem[p+1].int);
if mem[p].hh.b0=13 then{185:}
begin
if mem[p].hh.b1<>0 then
begin
print(286);
print_int(mem[p].hh.b1+1);
print(322);
end;
if mem[p+6].int<>0 then
begin
print(323);
print_glue(mem[p+6].int,mem[p+5].hh.b1,0);
end;
if mem[p+4].int<>0 then
begin
print(324);
print_glue(mem[p+4].int,mem[p+5].hh.b0,0);
end;
end{:185}
else
begin{186:}
g := mem[p+6].gr;
if (g<>0.0)and(mem[p+5].hh.b0<>0)then
begin
print(325);
if mem[p+5].hh.b0=2 then print(326);
if abs(mem[p+6].int)<1048576 then print(327)
else if abs(g)>20000.0 then
begin
if g>0.0 then print_char(62)
else print(328);
print_glue(20000*65536,mem[p+5].hh.b1,0);
end
else print_glue(round(65536*g),mem[p+5].hh.b1,0);
end{:186};
if mem[p+4].int<>0 then
begin
print(321);
print_scaled(mem[p+4].int);
end;
end;
begin
begin
str_pool[pool_ptr] := 46;
pool_ptr := pool_ptr+1;
end;
show_node_list(mem[p+5].hh.rh);
pool_ptr := pool_ptr-1;
end;
end{:184};
2:{187:}
begin
print_esc(329);
print_rule_dimen(mem[p+3].int);
print_char(43);
print_rule_dimen(mem[p+2].int);
print(320);
print_rule_dimen(mem[p+1].int);
end{:187};
3:{188:}
begin
print_esc(330);
print_int(mem[p].hh.b1-0);
print(331);
print_scaled(mem[p+3].int);
print(332);
print_spec(mem[p+4].hh.rh,0);
print_char(44);
print_scaled(mem[p+2].int);
print(333);
print_int(mem[p+1].int);
begin
begin
str_pool[pool_ptr] := 46;
pool_ptr := pool_ptr+1;
end;
show_node_list(mem[p+4].hh.lh);
pool_ptr := pool_ptr-1;
end;
end{:188};
8:
{<1356>}
case mem[p].hh.b1 of
0:
begin
printwritewhatsit(1284,p);
print_char(61);
printfilename(mem[p+1].hh.rh,mem[p+2].hh.lh,mem[p+2].hh.rh);
end;
1:
begin
printwritewhatsit(594,p);
print_mark(mem[p+1].hh.rh);
end;
2:
printwritewhatsit(1285,p);
3:
begin
print_esc(1286);
print_mark(mem[p+1].hh.rh);
end;
4:
begin
print_esc(1288);
print_int(mem[p+1].hh.rh);
print(1291);
print_int(mem[p+1].hh.b0);
print_char(44);
print_int(mem[p+1].hh.b1);
print_char(41);
end;
others:
print(1292)
end;
{:1356}
10:
{189:}
if mem[p].hh.b1 >= 100 then{190:}
begin
print_esc(338);
if mem[p].hh.b1 = 101 then
print_char(99)
else if mem[p].hh.b1 = 102 then
print_char(120);
print(339);
print_spec(mem[p + 1].hh.lh,0);
begin
begin
str_pool[pool_ptr] := 46;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p + 1].hh.rh);
pool_ptr := pool_ptr - 1;
end;
end{:190}
else
begin
print_esc(334);
if mem[p].hh.b1 <> 0 then
begin
print_char(40);
if mem[p].hh.b1 < 98 then
printskipparam(mem[p].hh.b1 - 1)
else if mem[p].hh.b1 = 98 then
print_esc(335)
else
print_esc(336);
print_char(41);
end;
if mem[p].hh.b1 <> 98 then
begin
print_char(32);
if mem[p].hh.b1 < 98 then
print_spec(mem[p + 1].hh.lh,0)
else
print_spec(mem[p + 1].hh.lh,337);
end;
end;
{:189}
11:
{191:}
if mem[p].hh.b1 <> 99 then
begin
print_esc(340);
if mem[p].hh.b1 <> 0 then
print_char(32);
print_scaled(mem[p + 1].int);
if mem[p].hh.b1 = 2 then
print(341);
end
else
begin
print_esc(342);
print_scaled(mem[p + 1].int);
print(337);
end;
{:191}
9:
{192:}
begin
print_esc(343);
if mem[p].hh.b1 = 0 then
print(344)
else
print(345);
if mem[p+1].int <> 0 then
begin
print(346);
print_scaled(mem[p + 1].int);
end;
end{:192};
6:
{193:}
begin
print_font_and_char(p + 1);
print(347);
if mem[p].hh.b1 > 1 then
print_char(124);
font_in_short_display := mem[p + 1].hh.b0;
short_display(mem[p + 1].hh.rh);
if odd(mem[p].hh.b1) then
print_char(124);
print_char(41);
end;
{:193}
12:
{194:}
begin
print_esc(348);
print_int(mem[p+1].int);
end;
{:194}
7:
{195:}
begin
print_esc(349);
if mem[p].hh.b1 > 0 then
begin
print(350);
print_int(mem[p].hh.b1);
end;
begin
begin
str_pool[pool_ptr] := 46;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p + 1].hh.lh);
pool_ptr := pool_ptr - 1;
end;
begin
str_pool[pool_ptr] := 124;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p + 1].hh.rh);
pool_ptr := pool_ptr -1;
end;
{:195}
4:
{196:}
begin
print_esc(351);
print_mark(mem[p + 1].int);
end;
{:196}
5:
{197:}
begin
print_esc(352);
begin
begin
str_pool[pool_ptr] := 46;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p + 1].int);
pool_ptr := pool_ptr - 1;
end;
end;
{:197}
{690:}
14:
printstyle(mem[p].hh.b1);
15:
{695:}
begin
print_esc(525);
begin
str_pool[pool_ptr] := 68;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p+1].hh.lh);
pool_ptr := pool_ptr - 1;
begin
str_pool[pool_ptr] := 84;
pool_ptr := pool_ptr + 1;
end;
show_node_list(mem[p+1].hh.rh);
pool_ptr := pool_ptr - 1;
begin
str_pool[pool_ptr] := 83;
pool_ptr := pool_ptr+1;
end;
show_node_list(mem[p+2].hh.lh);
pool_ptr := pool_ptr-1;
begin
str_pool[pool_ptr] := 115;
pool_ptr := pool_ptr+1;
end;
show_node_list(mem[p+2].hh.rh);
pool_ptr := pool_ptr-1;
end;
{:695}
16,17,18,19,20,21,22,23,24,27,26,29,28,30,31:
{696:}
begin
case mem[p].hh.b0 of
16:
print_esc(865);
17:
print_esc(866);
18:
print_esc(867);
19:
print_esc(868);
20:
print_esc(869);
21:
print_esc(870);
22:
print_esc(871);
23:
print_esc(872);
27:
print_esc(873);
26:
print_esc(874);
29:
print_esc(539);
24:
begin
print_esc(533);
printdelimiter(p + 4);
end;
28:
begin
print_esc(508);
printfamandchar(p + 4);
end;
30:
begin
print_esc(875);
printdelimiter(p + 1);
end;
31:
begin
print_esc(876);
printdelimiter(p + 1);
end;
end;
if mem[p].hh.b1 <> 0 then
if mem[p].hh.b1 = 1 then
print_esc(877)
else
print_esc(878);
if mem[p].hh.b0 < 30 then
printsubsidiarydata(p + 1, 46);
printsubsidiarydata(p + 2,94);
printsubsidiarydata(p + 3,95);
end;
{:696}
25:
{697:}
begin
print_esc(879);
if mem[p + 1].int = 1073741824 then
print(880)
else print_scaled(mem[p + 1].int);
if (mem[p + 4].qqqq.b0 <> 0) or
(mem[p + 4].qqqq.b1 <> 0) or
(mem[p + 4].qqqq.b2 <> 0) or
(mem[p + 4].qqqq.b3 <> 0) then
begin
print(881);
printdelimiter(p + 4);
end;
if (mem[p + 5].qqqq.b0 <> 0) or
(mem[p + 5].qqqq.b1 <> 0) or
(mem[p + 5].qqqq.b2 <> 0) or
(mem[p + 5].qqqq.b3 <> 0) then
begin
print(882);
printdelimiter(p + 5);
end;
printsubsidiarydata(p + 2, 92);
printsubsidiarydata(p + 3, 47);
end;
{:697}
{:690}
others:
print(317)
end;
{:183}
p := mem[p].hh.rh;
end;
10:
end;
{</182>}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment