summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/alephdir/eo16bit.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/alephdir/eo16bit.ch')
-rw-r--r--Build/source/texk/web2c/alephdir/eo16bit.ch696
1 files changed, 696 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/alephdir/eo16bit.ch b/Build/source/texk/web2c/alephdir/eo16bit.ch
new file mode 100644
index 00000000000..d3749c3aff5
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/eo16bit.ch
@@ -0,0 +1,696 @@
+% This is an \Aleph change file; it brings \eTeX register numbers
+% from 32767 ($2^{15}-1$) to 65535 ($2^{16}-1), to bring it on line
+% with \Omega
+% Noticeably, since Omega has 16-bit quarterwords, it is possible
+% to do so without changing much.
+% Notice that we do this for marks register: everything else is
+% brought to level with Omega in eomem.ch
+%----------------------------------------
+@x Section 53a onwards l.4600
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+@y
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=65535;
+max_reg_help_line:="A register number must be between 0 and 65535.";
+@z
+%----------------------------------------
+@x l.4607
+@ There are seven almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees or are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 16 pointers are non-null.
+@y
+@ There is one doubly linked tree, to handle the sparse array of the up
+to 65535 additional mark classes.
+The root of the tree, if it exists, is an index node containing 16
+pointers to subtrees for 4096 consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for 4096, 256,
+and 16 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is nine words long. The pointers to the 16 possible
+subtrees are kept in the |info| and |link| fields of the last eight
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains eight bits (two
+hexadecimal digits) of the mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (which is always |mark_val|). The |sa_used| field in the
+index nodes counts how many of the 16 pointers are non-null.
+@z
+%----------------------------------------
+@x l.4630
+The |sa_index| field in the nodes for array elements contains the four
+bits plus 16 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=6 {the additional mark classes}
+@#
+@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
+@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
+@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
+@y
+The |sa_index| field in the nodes for array elements contains the eight
+bits plus 256 times the type. The type field is actually ignored,
+since we only use this hoop-jumpings for marks registers (the code
+will probably get a rewrite to get in line with the rest of the
+(e-)Omega stuf, anyway, so \dots)
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==7 {the additional box registers}
+@d mark_val=8 {the additional mark classes}
+@z
+%----------------------------------------
+@x
+@ The roots of the seven trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first six locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to tok_val do sa_root[i]:=null;
+@y
+@ The root of the tree for the additional mark classes is kept
+in |sa_mark|.
+
+@<Glob...@>=
+@!sa_mark:pointer; {pointer to sparse array of marks}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+@z
+%----------------------------------------
+@x l.4681
+@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then set_equiv(box_base+cur_val,#)@+else set_sa_box(#)
+@#
+
+{ FIXME: needs debugging (sparse arrays) }
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@y
+@ Given a type |t| (which is always |mark_val|) and a sixteen-bit number |n|,
+the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node
+for the corresponding array element, or |null| when no such element exists.
+The third parameter |w| is set |true| if the element must exist, e.g., because
+it is about to be modified. The procedure has two main branches: one follows
+the existing tree structure, the other (only used when |w| is |true|) creates
+the missing nodes.
+
+We use macros to extract the four-bit pieces from a sixteen-bit register
+number or mark class and to fetch or store one of the 16 pointers from
+an index node.
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+{FIXME: needs debugging}
+@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
+@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
+@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
+@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+begin
+begin if t<>mark_val then begin
+ cur_ptr:=null;
+ return;
+end; end;
+cur_ptr:=sa_mark;
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_mark:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ FIXME OBSOLETE The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number.
+
+@ Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 256) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+{FIXME: will be removed}
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+{FIXME: will be removed}
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<number_regs then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end;
+{
+|else begin if t<=dimen_val then| {a count or dimen register}
+| begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;|
+| sa_num(cur_ptr):=n;|
+| end|
+| else begin cur_ptr:=get_node(pointer_node_size);|
+| if t<=mu_val then| {a skip or muskip register}
+| begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);|
+| end|
+| else sa_ptr(cur_ptr):=null; |{a box or token list register}
+| end;|
+| sa_ref(cur_ptr):=null;| {all registers have a reference count}
+| end;|
+}
+sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ set_equiv(box_base+cur_val,#)
+@#
+
+{FIXME: will be removed}
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>0 then
+ begin
+ set_equiv(sa_ptr(cur_ptr),#);
+ add_sa_ref(cur_ptr);
+ delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if false then {was |if sa_index(q)<dimen_val_limit then|}
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if false then {was |sa_index(q)<mu_val_limit then|}
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin
+ sa_mark:=null {was |sa_root[i]:=null|}; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if false {was |sa_index(q)<dimen_val_limit|} then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
+ q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+{|var t:small_number;|} {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+{
+|if p=null then print_char("?")| {this can't happen}
+|else begin t:=sa_type(p);|
+| if t<box_val then print_cmd_chr(register,p)|
+| else if t=box_val then|
+| begin print_esc("box"); print_sa_num(p);|
+| end|
+| else if t=tok_val then print_cmd_chr(toks_register,p)|
+| else print_char("?");| {this can't happen either}
+| print_char("=");|
+| if t=int_val then print_int(sa_int(p))|
+| else if t=dimen_val then|
+| begin print_scaled(sa_dim(p)); print("pt");|
+| end|
+| else begin p:=sa_ptr(p);|
+| if t=glue_val then print_spec(p,"pt")|
+| else if t=mu_val then print_spec(p,"mu")|
+| else if t=box_val then|
+| if p=null then print("void")|
+| else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);|
+| end|
+| else if t=tok_val then|
+| begin if p<>null then show_token_list(link(p),null,32);|
+| end|
+| else print_char("?");| {this can't happen either}
+| end;|
+| end;|
+}
+print_char("}"); end_diagnostic(false);
+end;
+tats
+@z
+%----------------------------------------
+% TODO: l.5029+: will the simply be removed?
+% (i.e.: cases which cannot happen (anymore)?)
+%----------------------------------------
+@x
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@y
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if false {was |i<dimen_val_limit|} then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=i {was |i:=tok_val_limit|};
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if false {was |sa_index(p)<mu_val_limit|} then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if false {was |sa_index(p)<box_val_limit|} then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+@z
+%----------------------------------------
+@x
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@y
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin {|if sa_index(p)>=dimen_val_limit then|} sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if false {was |sa_index(p)<dimen_val_limit|} then
+ if false {was |sa_index(sa_chain)<dimen_val_limit|} then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if false {was |sa_index(p)<dimen_val_limit|} then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+@z