@x @d normal=0 {the most common case when several cases are named} @y @d normal=0 {the most common case when several cases are named} @d under_accent=2 {|subtype| of under math accents} @d nesting=1 {add this to an accent |subtype| to make it nesting} @z @x primitive("mathaccent",math_accent,0);@/ @!@:math_accent_}{\.{\\mathaccent} primitive@> @y primitive("mathaccent",math_accent,normal);@/ @!@:math_accent_}{\.{\\mathaccent} primitive@> primitive("nestingmathaccent",math_accent,normal+nesting);@/ @!@:nesting_math_accent_}{\.{\\nestingmathaccent} primitive@> primitive("mathunderaccent",math_accent,under_accent);@/ @!@:math_under_accent_}{\.{\\mathunderaccent} primitive@> primitive("nestingmathunderaccent",math_accent,under_accent+nesting);@/ @!@:nesting_math_under_accent_}{\.{\\nestingmathunderaccent} primitive@> @z @x primitive("radical",radical,0);@/ @!@:radical_}{\.{\\radical} primitive@> @y primitive("radical",radical,0);@/ @!@:radical_}{\.{\\radical} primitive@> primitive("genradical",radical,1);@/ @!@:genradical_}{\.{\\genradical} primitive@> @z @x math_accent: print_esc("mathaccent"); @y math_accent: case chr_code of normal: print_esc("mathaccent"); normal+nesting: print_esc("nestingmathaccent"); under_accent: print_esc("mathunderaccent"); under_accent+nesting:print_esc("nestingmathunderaccent"); othercases print("Unknown accent!") endcases; @z @x radical: print_esc("radical"); @y radical: if chr_code=0 then print_esc("radical") else print_esc("genradical"); @z @x @d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} @d badness_code=glue_val+2 {code for \.{\\badness}} @y @d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} @d badness_code=glue_val+2 {code for \.{\\badness}} @d math_style_code=glue_val+3 {code for \.{\\mathstyle}} @z @x primitive("badness",last_item,badness_code); @!@:badness_}{\.{\\badness} primitive@> @y primitive("badness",last_item,badness_code); @!@:badness_}{\.{\\badness} primitive@> primitive("mathstyle",last_item,math_style_code); @!@:mathstyle_}{\.{\\mathstyle} primitive@> @z @x input_line_no_code: print_esc("inputlineno"); othercases print_esc("badness") @y input_line_no_code: print_esc("inputlineno"); badness_code: print_esc("badness"); math_style_code: print_esc("mathstyle"); othercases confusion("last_item") @:this can't happen last_item}{\quad last_item@> @z @x if cur_chr>glue_val then begin if cur_chr=input_line_no_code then cur_val:=line else cur_val:=last_badness; {|cur_chr=badness_code|} cur_val_level:=int_val; end @y if cur_chr>glue_val then begin if cur_chr=input_line_no_code then cur_val:=line else if cur_chr=math_style_code then begin if abs(mode)=mmode then cur_val:=mathstyle else cur_val:=-1; end else cur_val:=last_badness; cur_val_level:=int_val; end @z @x @d radical_noad_size=5 {number of |mem| words in a radical noad} @y @d radical_noad_size=6 {number of |mem| words in a radical noad} @d is_null_delimiter(#) == ((mem[#].qqqq.b0=0) and (mem[#].qqqq.b1=min_quarterword) and (mem[#].qqqq.b2=0) and (mem[#].qqqq.b3=min_quarterword)) @z @x begin case c div 2 of 0: print_esc("displaystyle"); {|display_style=0|} 1: print_esc("textstyle"); {|text_style=2|} 2: print_esc("scriptstyle"); {|script_style=4|} 3: print_esc("scriptscriptstyle"); {|script_script_style=6|} othercases print("Unknown style!") @y begin case c of display_style: print_esc("displaystyle"); display_style+cramped: print_esc("crampeddisplaystyle"); text_style: print_esc("textstyle"); text_style+cramped: print_esc("crampedtextstyle"); script_style: print_esc("scriptstyle"); script_style+cramped: print_esc("crampedscriptstyle"); script_script_style: print_esc("scriptscriptstyle"); script_script_style+cramped: print_esc("crampedscriptscriptstyle"); othercases print("Unknown style!") @z @x radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p)); end; @y radical_noad: if subtype(p)=normal then begin print_esc("radical"); print_delimiter(left_delimiter(p)); end else begin print_esc("genradical"); print_delimiter(left_delimiter(p)); print_delimiter(right_delimiter(p)); end; @z @x @!cur_style:small_number; {style code at current place in the list} @y @!cur_style,mathstyle:small_number; {style code at current place in the list} @z @x accent_noad: make_math_accent(q); @y accent_noad: if subtype(q)0 then clr:=clr+half(delta); {increase the actual clearance} shift_amount(y):=-(height(x)+clr); link(y):=overbar(x,clr,height(y)); info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box; end; @y procedure make_radical(@!q:pointer); var x,@!y,z:pointer; {temporary registers for box construction} @!delta,@!clr,ht:scaled; {dimensions involved in the calculation} begin x:=clean_box(nucleus(q),cramped_style(cur_style)); if cur_style0 then clr:=clr+half(delta); {increase the actual clearance} shift_amount(y):=-(height(x)+clr); ht:=height(y); if subtype(q)=normal then link(y):=overbar(x,clr,ht) else begin z:=var_delimiter(right_delimiter(q),cur_size,height(x)+depth(x)+clr+ default_rule_thickness); shift_amount(z):=-(height(x)+clr); if height(z)>ht then ht:=height(z); link(y):=overbar(x,clr,ht); link(link(y)):=z; end; info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box; end; @z @x procedure make_math_accent(@!q:pointer); label done,done1; var p,@!x,@!y:pointer; {temporary registers for box construction} @y procedure horizontally_stack_into_box(@!b:pointer;@!f:internal_font_number;@!c:quarterword); var p:pointer; {new node placed into |b|} begin p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p; width(b):=width(b)+width(p); end; procedure make_math_under_accent(@!q:pointer); label done,done1,done2,done3; var p,qq,@!x,@!y:pointer; {temporary registers for box construction} @!a:integer; {address of lig/kern instruction} @!c:quarterword; {accent character} @!f:internal_font_number; {its font} @!i,ii:four_quarters; {its |char_info|} @!s:scaled; {amount to skew the accent to the right} @!h:scaled; {height of character being accented} @!delta,sep:scaled; {space to insert between accentee and accent} @!w,v,u:scaled; {width of the accentee, not including sub/superscripts} @!t:four_quarters; @!m,n:integer; @!hd:eight_bits; begin fetch(accent_chr(q)); if char_exists(cur_i) then begin i:=cur_i; c:=cur_c; f:=cur_f;@/ @; @; x:=clean_box(nucleus(q),cur_style); w:=width(x); h:=height(x); @; if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then if math_type(nucleus(q))=math_char then @; shift_amount(y):=half(w-width(y))-s; width(y):=0; p:=new_kern(sep); link(x):=p; link(p):=y; p:=new_kern(-sep-x_height(f)); link(y):=p; y:=vpack(x,natural); width(y):=w; depth(y):=depth(y)+height(y)-h; height(y):=h; info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box; end; end; procedure make_math_accent(@!q:pointer); label done,done1,done2; var p,qq,@!x,@!y:pointer; {temporary registers for box construction} @z @x @!w:scaled; {width of the accentee, not including sub/superscripts} @y @!w,v,u:scaled; {width of the accentee, not including sub/superscripts} @!t:four_quarters; @!m,n:integer; @!hd:eight_bits; @z @x y:=char_box(f,c); @y @z @x @ @= loop@+ begin if char_tag(i)<>list_tag then goto done; y:=rem_byte(i); i:=char_info(f)(y); if not char_exists(i) then goto done; if char_width(f)(i)>w then goto done; c:=y; end; done: @y @ @= loop@+ begin if char_tag(i)=ext_tag then begin y:=new_null_box; type(y):=hlist_node; i:=font_info[exten_base[f]+rem_byte(i)].qqqq;@/ c:=ext_rep(i); t:=char_info(f)(c); u:=char_width(f)(t); v:=0; hd:=height_depth(t); height(y):=char_height(f)(hd); depth(y):=char_depth(f)(hd); c:=ext_bot(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t); c:=ext_mid(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t); c:=ext_top(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t); n:=0; if u>0 then while vmin_quarterword then v:=v+u; end; c:=ext_bot(i); if c<>min_quarterword then horizontally_stack_into_box(y,f,c); c:=ext_rep(i); for m:=1 to n do horizontally_stack_into_box(y,f,c); c:=ext_mid(i); if c<>min_quarterword then begin horizontally_stack_into_box(y,f,c); c:=ext_rep(i); for m:=1 to n do horizontally_stack_into_box(y,f,c); end; c:=ext_top(i); if c<>min_quarterword then horizontally_stack_into_box(y,f,c); goto done2; end; if char_tag(i)<>list_tag then goto done; y:=rem_byte(i); i:=char_info(f)(y); if not char_exists(i) then goto done; if char_width(f)(i)>w then goto done; c:=y; end; done: y:=char_box(f,c); done2: @z @x @ @= s:=0; if math_type(nucleus(q))=math_char then begin fetch(nucleus(q)); @y @ @= s:=0; qq:=q; if odd(subtype(q)) then while (math_type(nucleus(qq))=sub_mlist)and (type(info(nucleus(qq)))=accent_noad)and ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do qq:=info(nucleus(qq)); if math_type(nucleus(qq))=math_char then begin fetch(nucleus(qq)); ii:=char_info(cur_f)(skew_char[cur_f]); if char_tag(ii)=lig_tag then begin a:=lig_kern_start(cur_f)(ii); ii:=font_info[a].qqqq; if skip_byte(ii)>stop_flag then begin a:=lig_kern_restart(cur_f)(ii); ii:=font_info[a].qqqq; end; loop@+ begin if qo(next_char(ii))=cur_c then begin if op_byte(ii)>=kern_flag then if skip_byte(ii)<=stop_flag then s:=char_kern(cur_f)(ii); goto done1; end; if skip_byte(ii)>=stop_flag then goto done1; a:=a+qo(skip_byte(ii))+1; ii:=font_info[a].qqqq; end; end; end; done1: @ @= sep:=0; ii:=i; if char_tag(ii)=lig_tag then begin a:=lig_kern_start(f)(ii); ii:=font_info[a].qqqq; if skip_byte(ii)>stop_flag then begin a:=lig_kern_restart(f)(ii); ii:=font_info[a].qqqq; end; loop@+ begin if qo(next_char(ii))=c then begin if op_byte(ii)>=kern_flag then if skip_byte(ii)<=stop_flag then sep:=char_kern(f)(ii); goto done3; end; if skip_byte(ii)>=stop_flag then goto done3; a:=a+qo(skip_byte(ii))+1; ii:=font_info[a].qqqq; end; end; done3: @ @= s:=0; qq:=q; {while odd(subtype(qq))and(math_type(nucleus(qq))=sub_mlist)and (type(info(nucleus(qq)))=accent_noad) do} if odd(subtype(q)) then while (math_type(nucleus(qq))=sub_mlist)and (type(info(nucleus(qq)))=accent_noad)and ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do qq:=info(nucleus(qq)); if math_type(nucleus(qq))=math_char then begin fetch(nucleus(qq)); @z @x begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1); if every_math<>null then begin_token_list(every_math,every_math_text); @y begin mathstyle:=text_style; push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1); if every_math<>null then begin_token_list(every_math,every_math_text); @z @x push_math(math_shift_group); mode:=mmode; eq_word_define(int_base+cur_fam_code,-1);@/ @y mathstyle:=display_style; push_math(math_shift_group); mode:=mmode; eq_word_define(int_base+cur_fam_code,-1);@/ @z @x mmode+left_brace: begin tail_append(new_noad); back_input; scan_math(nucleus(tail)); @y mmode+left_brace: begin tail_append(new_noad); back_input; scan_math(nucleus(tail),mathstyle); @z @x procedure scan_math(@!p:pointer); label restart,reswitch,exit; var c:integer; {math character code} begin restart:@; reswitch:case cur_cmd of letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); if c=@'100000 then begin @; goto restart; end; end; char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; goto reswitch; end; math_char_num: begin scan_fifteen_bit_int; c:=cur_val; end; math_given: c:=cur_chr; delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; end; othercases @ endcases;@/ math_type(p):=math_char; character(p):=qi(c mod 256); if (c>=var_code)and fam_in_range then fam(p):=cur_fam else fam(p):=(c div 256) mod 16; exit:end; @y procedure scan_math(@!p:pointer;s:small_number); label restart,reswitch,exit; var c:integer; {math character code} savedstyle:small_number; begin savedstyle:=mathstyle; mathstyle:=s; restart:@; reswitch:case cur_cmd of letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); if c=@'100000 then begin @; goto restart; end; end; char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; goto reswitch; end; math_char_num: begin scan_fifteen_bit_int; c:=cur_val; end; math_given: c:=cur_chr; delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; end; othercases @ endcases;@/ math_type(p):=math_char; character(p):=qi(c mod 256); if (c>=var_code)and fam_in_range then fam(p):=cur_fam else fam(p):=(c div 256) mod 16; mathstyle:=savedstyle; exit: end; @z @x begin back_input; scan_left_brace;@/ saved(0):=p; incr(save_ptr); push_math(math_group); return; @y begin back_input; scan_left_brace;@/ saved(0):=p; incr(save_ptr); saved(0):=savedstyle; incr(save_ptr); push_math(math_group); return; @z @x mmode+math_comp: begin tail_append(new_noad); type(tail):=cur_chr; scan_math(nucleus(tail)); @y mmode+math_comp: begin tail_append(new_noad); type(tail):=cur_chr; case type(tail) of over_noad: scan_math(nucleus(tail),cramped_style(mathstyle)); othercases scan_math(nucleus(tail),mathstyle); endcases; @z @x type(tail):=radical_noad; subtype(tail):=normal; @y type(tail):=radical_noad; subtype(tail):=cur_chr; @z @x {before |scan_math| in |math_radical|} scan_math(nucleus(tail)); @y if subtype(tail)=normal then mem[right_delimiter(tail)].qqqq:=null_delimiter else scan_delimiter(right_delimiter(tail),true); {before |scan_math| in |math_radical|} scan_math(nucleus(tail),cramped_style(mathstyle)); @z @x procedure math_ac; begin if cur_cmd=accent then @; tail_append(get_node(accent_noad_size)); type(tail):=accent_noad; subtype(tail):=normal; @y procedure math_ac; begin if cur_cmd=accent then @; tail_append(get_node(accent_noad_size)); type(tail):=accent_noad; subtype(tail):=cur_chr; @z @x if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam else fam(accent_chr(tail)):=(cur_val div 256) mod 16; scan_math(nucleus(tail)); end; @y if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam else fam(accent_chr(tail)):=(cur_val div 256) mod 16; scan_math(nucleus(tail),cramped_style(mathstyle)); end; @z @x primitive("displaystyle",math_style,display_style); @!@:display_style_}{\.{\\displaystyle} primitive@> primitive("textstyle",math_style,text_style); @!@:text_style_}{\.{\\textstyle} primitive@> primitive("scriptstyle",math_style,script_style); @!@:script_style_}{\.{\\scriptstyle} primitive@> primitive("scriptscriptstyle",math_style,script_script_style); @!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> @y primitive("displaystyle",math_style,display_style); @!@:display_style_}{\.{\\displaystyle} primitive@> primitive("crampeddisplaystyle",math_style,display_style+cramped); @!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@> primitive("textstyle",math_style,text_style); @!@:text_style_}{\.{\\textstyle} primitive@> primitive("crampedtextstyle",math_style,text_style+cramped); @!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@> primitive("scriptstyle",math_style,script_style); @!@:script_style_}{\.{\\scriptstyle} primitive@> primitive("crampedscriptstyle",math_style,script_style+cramped); @!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@> primitive("scriptscriptstyle",math_style,script_script_style); @!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> primitive("crampedscriptscriptstyle",math_style,script_script_style+cramped); @!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@> @z @x mmode+math_style: tail_append(new_style(cur_chr)); @y mmode+math_style: begin tail_append(new_style(cur_chr)); mathstyle:=cur_chr; end; @z @x procedure append_choices; begin tail_append(new_choice); incr(save_ptr); saved(-1):=0; push_math(math_choice_group); scan_left_brace; @y procedure append_choices; begin tail_append(new_choice); incr(save_ptr); saved(-1):=mathstyle; incr(save_ptr); saved(-1):=0; push_math(math_choice_group); scan_left_brace; mathstyle:=display_style; @z @x 3:begin script_script_mlist(tail):=p; decr(save_ptr); return; end; end; {there are no other cases} incr(saved(-1)); push_math(math_choice_group); scan_left_brace; @y 3:begin script_script_mlist(tail):=p; decr(save_ptr); mathstyle:=saved(-1); decr(save_ptr); return; end; end; {there are no other cases} incr(saved(-1)); push_math(math_choice_group); scan_left_brace; mathstyle:=2*saved(-1); @z @x procedure sub_sup; var t:small_number; {type of previous sub/superscript} @!p:pointer; {field to be filled by |scan_math|} begin t:=empty; p:=null; if tail<>head then if scripts_allowed(tail) then begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|} t:=math_type(p); end; if (p=null)or(t<>empty) then @; scan_math(p); end; @y procedure sub_sup; var t:small_number; {type of previous sub/superscript} @!p:pointer; {field to be filled by |scan_math|} begin t:=empty; p:=null; if tail<>head then if scripts_allowed(tail) then begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|} t:=math_type(p); end; if (p=null)or(t<>empty) then @; if cur_cmd=sup_mark then scan_math(p,sup_style(mathstyle)) else scan_math(p,sub_style(mathstyle)); end; @z @x @d delimited_code=3 { `\.{\\abovewithdelims}', etc.} @y @d delimited_code=3 { `\.{\\abovewithdelims}', etc.} @d fraction_code=6 { `\.{\\fraction}', etc.} @z @x primitive("atopwithdelims",above,delimited_code+atop_code); @!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> @y primitive("atopwithdelims",above,delimited_code+atop_code); @!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> primitive("fraction",above,fraction_code); @!@:fraction_}{\.{\\fraction} primitive@> @z @x delimited_code+atop_code:print_esc("atopwithdelims"); othercases print_esc("above") @y delimited_code+atop_code:print_esc("atopwithdelims"); fraction_code:print_esc("fraction"); othercases print_esc("above") @z @x mmode+above: math_fraction; @y mmode+above: if cur_chr=fraction_code then begin scan_left_brace; tail_append(new_noad); back_input; scan_math(nucleus(tail),num_style(mathstyle)); end else begin math_fraction; end; @z @x procedure math_fraction; var c:small_number; {the type of generalized fraction we are scanning} begin c:=cur_chr; @y procedure math_fraction; var c:small_number; {the type of generalized fraction we are scanning} begin c:=cur_chr; mathstyle:=denom_style(save_stack[cur_boundary-1].int); @z @x math_group: begin unsave; decr(save_ptr);@/ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p; @y math_group: begin unsave; decr(save_ptr);@/ mathstyle:=saved(0); decr(save_ptr); math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p; @z