summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/alephdir/eo16bit-rc3.ch')
-rw-r--r--Build/source/texk/web2c/alephdir/eo16bit-rc3.ch759
1 files changed, 0 insertions, 759 deletions
diff --git a/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch b/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch
deleted file mode 100644
index dcd5c3c3905..00000000000
--- a/Build/source/texk/web2c/alephdir/eo16bit-rc3.ch
+++ /dev/null
@@ -1,759 +0,0 @@
-% 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
-@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
-dimen, skip, muskip, box, and token registers. As in \TeX\ the first
-256 registers of each kind are realized as arrays in the table of
-equivalents; the additional registers are realized as tree structures
-built from variable-size nodes with individual registers existing only
-when needed. Default values are used for nonexistent registers: zero
-for count and dimen values, |zero_glue| for glue (skip and muskip)
-values, void for boxes, and |null| for token lists (and current marks
-discussed below).
-
-Similarly there are 32768 mark classes; the command \.{\\marks}|n|
-creates a mark node for a given mark class |0<=n<=32767| (where
-\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
-the |fire_up| routine) and the |vsplit| routine maintain the current
-values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
-|split_bot_mark| for each mark class. They are accessed as
-\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
-\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
-are realized as |cur_mark| array. The additional current marks are
-again realized as tree structure with individual mark classes existing
-only when needed.
-
-@<Generate all \eTeX...@>=
-primitive("marks",mark,marks_code);
-@!@:marks_}{\.{\\marks} primitive@>
-primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
-@!@:top_marks_}{\.{\\topmarks} primitive@>
-primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
-@!@:first_marks_}{\.{\\firstmarks} primitive@>
-primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
-@!@:bot_marks_}{\.{\\botmarks} primitive@>
-primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
-@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
-primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
-@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
-
-@ The |scan_register_num| procedure scans a register number that must
-not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure@?scan_register_num; forward;@t\2@>
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_register_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>max_reg_num) then
- begin print_err("Bad register code");
-@.Bad register code@>
- help2(max_reg_help_line)("I changed this one to zero.");
- int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Initialize variables for \eTeX\ comp...@>=
-max_reg_num:=255;
-max_reg_help_line:="A register number must be between 0 and 255.";
-
-@ @<Initialize variables for \eTeX\ ext...@>=
-max_reg_num:=32767;
-max_reg_help_line:="A register number must be between 0 and 32767.";
-@y
-@ \eOmega\ (in extended mode) supports 65536 (i.e., $2^{16}$) count,
-dimen, skip, muskip, box, and token registers. They are
-implemented as in \TeX.
-
-There are 32768 mark classes; the command \.{\\marks}|n|
-creates a mark node for a given mark class |0<=n<=32767| (where
-\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
-the |fire_up| routine) and the |vsplit| routine maintain the current
-values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
-|split_bot_mark| for each mark class. They are accessed as
-\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
-\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
-are realized as |cur_mark| array. The additional current marks are
-again realized as tree structure with individual mark classes existing
-only when needed.
-
-@<Generate all \eTeX...@>=
-primitive("marks",mark,marks_code);
-@!@:marks_}{\.{\\marks} primitive@>
-primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
-@!@:top_marks_}{\.{\\topmarks} primitive@>
-primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
-@!@:first_marks_}{\.{\\firstmarks} primitive@>
-primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
-@!@:bot_marks_}{\.{\\botmarks} primitive@>
-primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
-@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
-primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
-@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
-
-@ The |scan_register_num| procedure scans a (token) register number.
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure@?scan_register_num; forward;@t\2@>
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_register_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>max_reg_num) then
- begin print_err("Bad register code");
-@.Bad register code@>
- help2(max_reg_help_line)("I changed this one to zero.");
- int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Initialize variables for \eTeX\ comp...@>=
-max_reg_num:=255;
-max_reg_help_line:="A register number must be between 0 and 255.";
-
-@ @<Initialize variables for \eTeX\ ext...@>=
-max_reg_num:=32767;
-max_reg_help_line:="A register number must be between 0 and 32727.";
-@z
-%----------------------------------------
-@x l.4607
-@ @<Glob...@>=
-@!max_reg_num: halfword; {largest allowed register number}
-@!max_reg_help_line: str_number; {first line of help message}
-
-@ 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
-@ @<Glob...@>=
-@!max_reg_num: halfword; {largest allowed register number}
-@!max_reg_help_line: str_number; {first line of help message}
-
-@ There is one doubly linked tree, to handle the sparse array of the up
-to 32727 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 mark_val=7 {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
-if t<>mark_val then begin
- confusion("sparse arrays, finding")
- cur_ptr:=null;
- return;
-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;
-
-@ 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}
-@#
-@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}
-@#
-
-@<Create a new array element...@>=
-{|if t=mark_val then|} {a mark class} {check not needed}
- 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|}
-{| confusion("sparse arrays, creating");|}
-{|end|}
-sa_index(cur_ptr):=256*t+i; sa_lev(cur_ptr):=level_one
-
-@z
-%----------------------------------------
-% TODO: l.5029+: will the simply be removed?
-% (i.e.: cases which cannot happen (anymore)?)
-%----------------------------------------
-@x l.5078
-@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
-etc., as well as for references to sparse array elements defined by
-`\.{\\countdef}', etc.
-
-@<Cases of |register| for |print_cmd_chr|@>=
-begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
- cmd:=sa_type(chr_code)
-else begin cmd:=chr_code-mem_bot; chr_code:=null;
- end;
-if cmd=int_val then print_esc("count")
-else if cmd=dimen_val then print_esc("dimen")
-else if cmd=glue_val then print_esc("skip")
-else print_esc("muskip");
-if chr_code<>null then print_sa_num(chr_code);
-end
-
-@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
-well as for references to sparse array elements defined by
-`\.{\\toksdef}'.
-
-@<Cases of |toks_register| for |print_cmd_chr|@>=
-begin print_esc("toks");
-if chr_code<>mem_bot then print_sa_num(chr_code);
-end
-
-@ When a shorthand definition for an element of one of the sparse arrays
-is destroyed, we must reduce the reference count.
-
-@<Cases for |eq_destroy|@>=
-toks_register,register:
- if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
- delete_sa_ref(equiv_field(w));
-
-@ The task to maintain (change, save, and restore) register values is
-essentially the same when the register is realized as sparse array
-element or entry in |eqtb|. The global variable |sa_chain| is the head
-of a linked list of entries saved at the topmost level |sa_level|; the
-lists for lowel levels are kept in special save stack entries.
-
-@<Glob...@>=
-@!sa_chain: pointer; {chain of saved sparse array entries}
-@!sa_level: quarterword; {group level for |sa_chain|}
-
-@ @<Set init...@>=
-sa_chain:=null; sa_level:=level_zero;
-
-@ The individual saved items are kept in pointer or word nodes similar
-to those used for the array elements: a word node with value zero is,
-however, saved as pointer node with the otherwise impossible |sa_index|
-value |tok_val_limit|.
-
-@d sa_loc==sa_ref {location of saved item}
-
-@<Declare \eTeX\ procedures for tr...@>=
-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;
-
-@ The procedure |sa_def| assigns a new value to sparse array elements,
-and saves the former value if appropriate. This procedure is used only
-for skip, muskip, box, and token list registers. The counterpart of
-|sa_def| for count and dimen registers is called |sa_w_def|.
-
-@d sa_define(#)==if e then
- if global then gsa_def(#)@+else sa_def(#)
- else define
-@#
-@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
- begin find_sa_element(box_val,cur_val,true);
- if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
- end
-@#
-@d sa_word_define(#)==if e then
- if global then gsa_w_def(#)@+else sa_w_def(#)
- else word_define(#)
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure sa_def(@!p:pointer;@!e:halfword);
- {new data for sparse array elements}
-begin add_sa_ref(p);
-if sa_ptr(p)=e then
- begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
- sa_destroy(p);
- end
-else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
- if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
- sa_lev(p):=cur_level; sa_ptr(p):=e;
- @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
- end;
-delete_sa_ref(p);
-end;
-@#
-procedure sa_w_def(@!p:pointer;@!w:integer);
-begin add_sa_ref(p);
-if sa_int(p)=w then
- begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
- end
-else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
- if sa_lev(p)<>cur_level then sa_save(p);
- sa_lev(p):=cur_level; sa_int(p):=w;
- @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
- end;
-delete_sa_ref(p);
-end;
-
-@ The |sa_def| and |sa_w_def| routines take care of local definitions.
-@^global definitions@>
-Global definitions are done in almost the same way, but there is no need
-to save old values, and the new value is associated with |level_one|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
-begin add_sa_ref(p);
-@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
-sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
-@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
-delete_sa_ref(p);
-end;
-@#
-procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
-begin add_sa_ref(p);
-@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
-sa_lev(p):=level_one; sa_int(p):=w;
-@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
-delete_sa_ref(p);
-end;
-
-@ The |sa_restore| procedure restores the sparse array entries pointed
-at by |sa_chain|
-
-@<Declare \eTeX\ procedures for tr...@>=
-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
-@ @<Cases of |register| for |print_cmd_chr|@>=
-begin cmd:=chr_code-mem_bot;
-if cmd=int_val then print_esc("count")
-else if cmd=dimen_val then print_esc("dimen")
-else if cmd=glue_val then print_esc("skip")
-else print_esc("muskip");
-end
-
-@ @<Cases of |toks_register| for |print_cmd_chr|@>=
-print_esc("toks")
-
-@ @<Cases for |eq_destroy|@>=
-{empty section}
-
-@z