From ad547a6b5986815fda458221149728d9d9ab1d87 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Thu, 25 Feb 2021 19:22:25 +0000 Subject: restore Build,TODO from r57911 git-svn-id: svn://tug.org/texlive/trunk@57915 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/alephdir/omtrans.ch | 784 ++++++++++++++++++++++++++++ 1 file changed, 784 insertions(+) create mode 100644 Build/source/texk/web2c/alephdir/omtrans.ch (limited to 'Build/source/texk/web2c/alephdir/omtrans.ch') diff --git a/Build/source/texk/web2c/alephdir/omtrans.ch b/Build/source/texk/web2c/alephdir/omtrans.ch new file mode 100644 index 00000000000..f7b0e49d991 --- /dev/null +++ b/Build/source/texk/web2c/alephdir/omtrans.ch @@ -0,0 +1,784 @@ +% omtrans.ch: Characters sets for input and output +% +% This file is part of the Omega project, which +% is based on the web2c distribution of TeX. +% +% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous +% +% This library is free software; you can redistribute it and/or +% modify it under the terms of the GNU Library General Public +% License as published by the Free Software Foundation; either +% version 2 of the License, or (at your option) any later version. +% +% This library is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +% Library General Public License for more details. +% +% You should have received a copy of the GNU Library General Public +% License along with this library; if not, write to the Free Software +% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +% +%--------------------------------------- +@x [3] m.25 l.767 - Omega Translation +initialization. We shall define a word file later; but it will be possible +for us to specify simple operations on word files before they are defined. +@y +initialization. We shall define a word file later; but it will be possible +for us to specify simple operations on word files before they are defined. + +@d no_mode=0 +@d onebyte_mode=1 +@d ebcdic_mode=2 +@d twobyte_mode=3 +@d twobyteLE_mode=4 + +@d trans_input=0 +@d trans_output=1 +@d trans_default_input=2 +@d trans_default_output=3 +@d trans_no_input=4 +@d trans_no_output=5 +@d trans_no_default_input=6 +@d trans_no_default_output=7 + +@d mode_input=0 +@d mode_output=1 +@d mode_default_input=2 +@d mode_default_output=3 +@d mode_no_input=4 +@d mode_no_output=5 +@d mode_no_default_input=6 +@d mode_no_default_output=7 +@z +%--------------------------------------- +@x [3] m.30 l.890 - Omega Translation +@!max_buf_stack:0..buf_size; {largest index used in |buffer|} +@y +@!max_buf_stack:0..buf_size; {largest index used in |buffer|} +@!term_in_mode:halfword; +@!term_in_translation:halfword; +@z +%--------------------------------------- +@x [3] m.37 l.1065 - Omega Translation + if not input_ln(term_in,true) then {this shouldn't happen} +@y + if not new_input_ln(term_in,term_in_mode,term_in_translation,true) +then {this shouldn't happen} +@z +%--------------------------------------- +@x [5] m.54 l. - Omega Translation +@!log_file : alpha_file; {transcript of \TeX\ session} +@y +@!log_file : alpha_file; {transcript of \TeX\ session} +@!term_out_mode:halfword; +@!term_out_translation:halfword; +@z +%--------------------------------------- +@x [5] m.59 l. - Omega Translation +@= +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @ then + if selector= +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @ then + if selector=str_ptr then s:="???" {this can't happen} +@.???@> +else if spseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@) then + if selector; + if s<@"20 then begin + print_char(@"5E); print_char(@"5E); print_char(s+@'100); + end + else if s<@"7F then + print_char(s) + else if s=@"7F then begin + print_char(@"5E); print_char(@"5E); print_char(s-@'100); + end + else if s<@"100 then begin + print_char(@"5E); print_char(@"5E); + print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10); + end + else begin {Here is where we generate the strings on the fly.} + print_char(@"5E); print_char(@"5E); + print_char(@"5E); print_char(@"5E); + print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100); + print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10); + end; + @; + return; + end; +j:=str_start(s); +while j= +procedure slow_print(@!s:integer); {prints string |s|} +var j:pool_pointer; {current character code position} +begin if (s>=str_ptr) or (s<=biggest_char) then print(s) +else begin j:=str_start(s); + while j=str_ptr then s:="???" {this can't happen} +@.???@> +else if spseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@) then + if selector; + if s<@"20 then begin + print_char(@"5E); print_char(@"5E); print_char(s+@'100); + end + else if s<@"7F then + print_char(s) + else if s=@"7F then begin + print_char(@"5E); print_char(@"5E); print_char(s-@'100); + end + else if s<@"100 then begin + print_char(@"5E); print_char(@"5E); + print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10); + end + else begin {Here is where we generate the strings on the fly.} + print_char(@"5E); print_char(@"5E); + print_char(@"5E); print_char(@"5E); + print_lc_hex(s div @"1000); print_lc_hex((s mod @"1000) div @"100); + print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10); + end; + @; + return; + end; +j:=str_start(s); +while j0)and(odd(selector)))or@| + ((file_offset>0)and(selector>=log_only)) then print_ln; +print(s); +end; + +procedure overflow_ocp_buf_size; forward; +procedure overflow_ocp_stack_size; forward; + +procedure omega_print(s:str_number); +var new_s:str_number; + om_mode,om_translation:integer; + j:integer; +begin +om_mode:=no_mode; +om_translation:=0; +case selector of +term_and_log,log_only,term_only: begin + om_mode:=term_out_mode; + if om_mode<>no_mode then om_translation:=term_out_translation; + end; +no_print,pseudo,new_string: do_nothing; +othercases begin + om_mode:=write_file_mode[selector]; + if om_mode<>no_mode then om_translation:=write_file_translation[selector]; + end +endcases; + +if (om_mode=no_mode) or + ((om_mode=onebyte_mode) and (om_translation=0)) then + begin + j:=str_start(s); + while j; + end; + for otp_counter:=1 to (otp_output_end-1) do begin + new_s:=otp_output_buf[otp_counter]; + if (om_mode255) then + begin + print_char(@"5E); print_char(@"5E); + print_char(@"5E); print_char(@"5E); + print_lc_hex(new_s div @"1000); + print_lc_hex((new_s mod @"1000) div @"100); + print_lc_hex((new_s mod @"100) div @"10); + print_lc_hex(new_s mod @"10); + end + else + print_char(new_s); + end; + end; +end; + +@ Control sequence names, file names, and strings constructed with +\.{\\string} might contain |ASCII_code| values that can't +be printed using |print_char|. Therefore we use |slow_print| for them: + +@= +procedure slow_print(@!s:integer); {prints string |s|} +begin if (s>=str_ptr) or (s<=biggest_char) then print(s) +else omega_print(s); +end; +@z +%--------------------------------------- +@x [5] - Omega Translation +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>=log_only)) then print_ln; +print(s); +end; +@y +@z +%--------------------------------------- +@x [5] m.71 l.1694 - Omega Translation +if not input_ln(term_in,true) then fatal_error("End of file on the terminal!"); +@y +if not new_input_ln(term_in,term_in_mode,term_in_translation,true) +then fatal_error("End of file on the terminal!"); +@z +%--------------------------------------- +@x [15] m.209 l.4170 - Omega Translation +@d max_command=ocp_trace_level + {the largest command code seen at |big_switch|} +@y +@d char_trans=ocp_trace_level+1 +@d char_mode=char_trans+1 +@d max_command=char_mode + {the largest command code seen at |big_switch|} +@z +%--------------------------------------- +@x [17] m.230 l.4722 - Omega Translation +@d toks_base=ocp_active_base+max_active_ocp_lists + {table of |number_regs| token list registers} +@y +@d ocp_input_mode_base=ocp_active_base+max_active_ocp_lists +@d ocp_input_onebyte_translation_base =ocp_input_mode_base+ 1 +@d ocp_input_ebcdic_translation_base =ocp_input_mode_base+ 2 +@d ocp_input_twobyte_translation_base =ocp_input_mode_base+ 3 +@d ocp_input_twobyteLE_translation_base =ocp_input_mode_base+ 4 + +@d ocp_output_mode_base =ocp_input_mode_base+ 5 +@d ocp_output_onebyte_translation_base =ocp_input_mode_base+ 6 +@d ocp_output_ebcdic_translation_base =ocp_input_mode_base+ 7 +@d ocp_output_twobyte_translation_base =ocp_input_mode_base+ 8 +@d ocp_output_twobyteLE_translation_base =ocp_input_mode_base+ 9 + +@d toks_base =ocp_input_mode_base+10 +@z +%--------------------------------------- +@x [22] m.304 l.6535 - Omega Translation +@!input_file : array[1..max_in_open] of alpha_file; +@y +@!input_file : array[1..max_in_open] of alpha_file; +@!input_file_mode : array[1..max_in_open] of halfword; +@!input_file_translation : array[1..max_in_open] of halfword; +@z +%--------------------------------------- +@x [23] m.331 l.7066 - Omega Translation +param_ptr:=0; max_param_stack:=0; +@y +param_ptr:=0; max_param_stack:=0; +geq_define(ocp_input_mode_base,data,1); +term_in_mode:=equiv(ocp_input_mode_base); +term_out_mode:=equiv(ocp_input_mode_base); +if term_in_mode>0 +then term_in_translation:= + equiv(ocp_input_onebyte_translation_base+term_in_mode-1); +if term_out_mode>0 +then term_out_translation:= + equiv(ocp_output_onebyte_translation_base+term_in_mode-1); +@z +%--------------------------------------- +@x [24] m.362 l.7066 - Omega Translation + begin if input_ln(cur_file,true) then {not end of file} +@y + begin if new_input_ln(cur_file,input_file_mode[index], + input_file_translation[index],true) then {not end of file} +@z +%--------------------------------------- +@x [27] m.480 l.9411 - Omega Translation +@!read_file:array[0..15] of alpha_file; {used for \.{\\read}} +@y +@!read_file:array[0..15] of alpha_file; {used for \.{\\read}} +@!read_file_mode:array[0..15] of halfword; +@!read_file_translation:array[0..15] of halfword; +@z +%--------------------------------------- +@x [27] m.485 l.9475 - Omega Translation +@= +if input_ln(read_file[m],false) then read_open[m]:=normal +else begin a_close(read_file[m]); read_open[m]:=closed; + end +@y +@= +begin read_file_mode[m]:= + get_file_mode(read_file[m], equiv(ocp_input_mode_base)); +if read_file_mode[m]>0 +then read_file_translation[m]:= + equiv(ocp_input_onebyte_translation_base+read_file_mode[m]-1); +if new_input_ln(read_file[m],read_file_mode[m], + read_file_translation[m],false) then read_open[m]:=normal +else begin a_close(read_file[m]); read_open[m]:=closed; + end +end +@z +%--------------------------------------- +@x [27] m.486 l.9484 - Omega Translation +begin if not input_ln(read_file[m],true) then + begin a_close(read_file[m]); read_open[m]:=closed; +@y +begin if not new_input_ln(read_file[m], +read_file_mode[m],read_file_translation[m],true) then + begin a_close(read_file[m]); read_open[m]:=closed; +@z +%--------------------------------------- +@x [29] m.538 l.10371 - Omega Translation +begin line:=1; +if input_ln(cur_file,false) then do_nothing; +@y +begin line:=1; +input_file_mode[index]:= + get_file_mode(cur_file, equiv(ocp_input_mode_base)); +if input_file_mode[index]>0 +then input_file_translation[index]:= + equiv(ocp_input_onebyte_translation_base+input_file_mode[index]-1); +if new_input_ln(cur_file,input_file_mode[index], + input_file_translation[index],false) then do_nothing; +@z +%--------------------------------------- +@x [49] m.1210 l.22629 - Omega Translation +any_mode(ocp_trace_level) : prefixed_command; +@y +any_mode(ocp_trace_level) : prefixed_command; +any_mode(char_mode) : do_char_mode; +any_mode(char_trans) : do_char_translation; +@z +%--------------------------------------- +@x [49] m.1343 l.24928 - Omega Translation +@!write_file:array[0..15] of alpha_file; +@y +@!write_file:array[0..15] of alpha_file; +@!write_file_mode:array[0..15] of halfword; +@!write_file_translation:array[0..15] of halfword; +@z +%--------------------------------------- +@x +@* \[54] $\Omega$ changes. + +@y +@* \[54] $\Omega$ changes. + +@ Here we do the main work required for reading and interpreting + $\Omega$ Input Translation Processes. + +@ @= +primitive("InputTranslation", char_trans, trans_input); +primitive("OutputTranslation", char_trans, trans_output); +primitive("DefaultInputTranslation", char_trans, trans_default_input); +primitive("DefaultOutputTranslation", char_trans, trans_default_output); +primitive("noInputTranslation", char_trans, trans_no_input); +primitive("noOutputTranslation", char_trans, trans_no_output); +primitive("noDefaultInputTranslation", char_trans, trans_no_default_input); +primitive("noDefaultOutputTranslation", char_trans, trans_no_default_output); +primitive("InputMode", char_mode, mode_input); +primitive("OutputMode", char_mode, mode_output); +primitive("DefaultInputMode", char_mode, mode_default_input); +primitive("DefaultOutputMode", char_mode, mode_default_output); +primitive("noInputMode", char_mode, mode_no_input); +primitive("noOutputMode", char_mode, mode_no_output); +primitive("noDefaultInputMode", char_mode, mode_no_default_input); +primitive("noDefaultOutputMode", char_mode, mode_no_default_output); + +geq_define(ocp_input_onebyte_translation_base, data, 0); +geq_define(ocp_input_ebcdic_translation_base, data, 0); +geq_define(ocp_input_twobyte_translation_base, data, 0); +geq_define(ocp_input_twobyteLE_translation_base, data, 0); +geq_define(ocp_input_mode_base, data, 0); + +geq_define(ocp_output_onebyte_translation_base, data, 0); +geq_define(ocp_output_ebcdic_translation_base, data, 0); +geq_define(ocp_output_twobyte_translation_base, data, 0); +geq_define(ocp_output_twobyteLE_translation_base, data, 0); +geq_define(ocp_output_mode_base, data, 0); + +@ @= +char_trans: + case chr_code of + trans_input: print_esc("InputTranslation"); + trans_output: print_esc("OutputTranslation"); + trans_default_input: print_esc("DefaultInputTranslation"); + trans_default_output: print_esc("DefaultOutputTranslation"); + trans_no_input: print_esc("noInputTranslation"); + trans_no_output: print_esc("noOutputTranslation"); + trans_no_default_input: print_esc("noDefaultInputTranslation"); + trans_no_default_output: print_esc("noDefaultOutputTranslation"); + end; +char_mode: + case chr_code of + mode_input: print_esc("InputMode"); + mode_output: print_esc("OutputMode"); + mode_default_input: print_esc("DefaultInputMode"); + mode_default_output: print_esc("DefaultOutputMode"); + mode_no_input: print_esc("noInputMode"); + mode_no_output: print_esc("noOutputMode"); + mode_no_default_input: print_esc("noDefaultInputMode"); + mode_no_default_output: print_esc("noDefaultOutputMode"); + end; + +@ @= +procedure scan_file_referrent; +begin +if scan_keyword("currentfile") then cur_val:=max_halfword +else scan_int; +end; + +procedure scan_mode; +begin +if scan_keyword("onebyte") then cur_val:=onebyte_mode +else if scan_keyword("ebcdic") then cur_val:=ebcdic_mode +else if scan_keyword("twobyte") then cur_val:=twobyte_mode +else if scan_keyword("twobyteLE") then cur_val:=twobyteLE_mode +else begin print_err("Invalid input mode"); cur_val:=0; end; +end; + +procedure do_char_translation; +var kind:halfword; + fileref:halfword; + moderef:halfword; + ocpref:halfword; +begin +fileref:=0; +moderef:=0; +ocpref:=0; +kind:=cur_chr; +if (kind mod 4) <= 1 then begin + scan_file_referrent; + fileref:=cur_val; + end +else begin + scan_mode; + moderef:=cur_val; + end; +if kind < 4 then begin + scan_ocp_ident; + ocpref:=cur_val; + end; +case (kind mod 4) of + trans_input: begin + if (fileref>=0) and (fileref<=15) then begin + read_file_translation[fileref]:=ocpref; + end + else if fileref<>max_halfword then begin + term_in_translation:=ocpref; + end + else begin + base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; + while state = token_list do + begin + decr(base_ptr); + cur_input:=input_stack[base_ptr]; + end; + if name>17 then input_file_translation[index]:=ocpref; + cur_input:=input_stack[input_ptr]; + end; + end; + trans_output: begin + if (fileref>=0) and (fileref<=15) then begin + write_file_translation[fileref]:=ocpref; + end + else begin + term_out_translation:=ocpref; + end; + end; + trans_default_input: begin + geq_define(ocp_input_mode_base+moderef,data,ocpref); + end; + trans_default_output: begin + geq_define(ocp_output_mode_base+moderef,data,ocpref); + end; + end; +end; + +procedure do_char_mode; +var kind:halfword; + fileref:halfword; + moderef:halfword; +begin +fileref:=0; +moderef:=0; +kind:=cur_chr; +if (kind mod 4) <= 1 then begin + scan_file_referrent; + fileref:=cur_val; + end; +if kind < 4 then begin + scan_mode; + moderef:=cur_val; + end; +case (kind mod 4) of + trans_input: begin + if (fileref>=0) and (fileref<=15) then begin + read_file_mode[fileref]:=moderef; + end + else if fileref<>max_halfword then begin + term_in_mode:=moderef; + end + else begin + base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; + while state = token_list do + begin + decr(base_ptr); + cur_input:=input_stack[base_ptr]; + end; + if name>17 then input_file_mode[index]:=moderef; + cur_input:=input_stack[input_ptr]; + end; + end; + trans_output: begin + if (fileref>=0) and (fileref<=15) then begin + write_file_mode[fileref]:=moderef; + end + else begin + term_out_mode:=moderef; + end; + end; + trans_default_input: begin + geq_define(ocp_input_mode_base,data,moderef); + end; + trans_default_output: begin + geq_define(ocp_output_mode_base,data,moderef); + end; + end; +end; + +function p_new_input_ln(f:alpha_file; +the_mode,translation:halfword; +bypass_eoln:boolean):boolean; +begin +if (the_mode=no_mode) or ((the_mode=onebyte_mode) and (translation=0)) +then p_new_input_ln:=input_ln(f,bypass_eoln) +else if not newinputline(f,the_mode,bypass_eoln) +then p_new_input_ln:=false +else if translation=0 then +begin + if (first+otp_input_end)>=buf_size then overflow("buffer size", buf_size); + state:=new_line; + start:=first; + last:=start; + loc:=start; + for otp_counter:=1 to otp_input_end do + begin + buffer[last]:=otp_input_buf[otp_counter]; + incr(last); + end; + while buffer[last-1]=' ' do decr(last); + limit:=last-1; + p_new_input_ln:=true +end +else +begin + otp_input_start:=0; + otp_input_last:=0; + otp_stack_used:=0; + otp_stack_last:=0; + otp_stack_new:=0; + otp_output_end:=0; + otp_pc:=0; + otp_finished:=false; + otp_calc_ptr:=0; + otp_calcs[otp_calc_ptr]:=0; + otp_state_ptr:=0; + otp_states[otp_state_ptr]:=0; + otp_input_ocp:=translation; + while not otp_finished do + @; + if (first+otp_output_end)>=buf_size then overflow("buffer size", buf_size); + state:=new_line; + start:=first; + last:=start; + loc:=start; + for otp_counter:=1 to otp_output_end do + begin + buffer[last]:=otp_output_buf[otp_counter]; + incr(last); + end; + while buffer[last-1]=' ' do decr(last); + limit:=last-1; + p_new_input_ln:=true +end +end; + + +@z +%--------------------------------------- -- cgit v1.2.3