texk 1

git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 651 insertions, 0 deletions

diff --git a/Build/source/texk/web2c/dvicopy.ch b/Build/source/texk/web2c/dvicopy.ch
new file mode 100644
index 00000000000..4d6a7d39143
--- /dev/null
+++ b/Build/source/texk/web2c/dvicopy.ch
@@ -0,0 +1,651 @@
+% dvicopy.ch for C compilation with web2c.
+% The original version of this file was created by Monika Jayme and
+% Klaus Guntermann at TH Darmstadt (THD), FR Germany.
+% Some parts are borrowed from the changes to dvitype, vftovp and vptovf.
+%
+%  July 90   THD  First versions for dvicopy 0.91 and 0.92
+%  Aug 09 90 THD  Updated to dvicopy 1.0 and released
+%  Mar 20 91 THD  Updated to dvicopy 1.2
+% (more recent changes in the ChangeLog)
+
+@x [0] WEAVE: print changes only
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+@z
+
+@x [3] Set up kpathsea.
+procedure initialize; {this procedure gets things started properly}
+  var @<Local variables for initialization@>@/
+  begin print_ln(banner);@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize; {this procedure gets things started properly}
+  var @<Local variables for initialization@>@/
+  begin 
+    kpse_set_progname (argv[0]);
+    parse_arguments;
+    print (banner); print_ln (version_string);
+@z
+
+@x [5] Big enough arrays to convert the dvilj sample font document.
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+  must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+  line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@<Constants...@>=
+@!max_fonts=400; {maximum number of distinct fonts}
+@!max_chars=750000; {maximum number of different characters among all fonts}
+@!max_widths=16000; {maximum number of different characters widths}
+@!max_packets=65530; {maximum number of different characters packets;
+  must be less than 65536}
+@!max_bytes=250000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=256; {maximum number of characters input in a single
+  line of input from the terminal}
+@z
+
+% [7] Rename the integer types, as they collide with names used by C99.
+% Rather than change the code all over the place, we use macros to do
+% the renaming.  This could also be done at C preprocessor level.
+@x
+@d int_32 == integer {signed 32~bit integers}
+@y
+@d int_32 == integer {signed 32~bit integers}
+@d int_31 == int_31_t
+@d int_24u == int_24u_t
+@d int_24 == int_24_t
+@d int_23 == int_23_t
+@d int_16u == int_16u_t
+@d int_16 == int_16_t
+@d int_15 == int_15_t
+@d int_8u == int_8u_t
+@d int_8 == int_8_t
+@d int_7 == int_7_t
+@z
+
+% [14] Redirect output, so it can go to either stdout or stderr,
+% depending on where the output dvi file is going.
+@x
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@y
+@d print(#)==write(term_out,#)
+@d print_ln(#)==write_ln(term_out,#)
+@d new_line==write_ln(term_out) {start new line}
+@z
+
+@x [14] Permissive input.
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+@y
+@!ASCII_code=0..255; {a subrange of the integers}
+@z
+
+% [15] The text_char type is used as an array index into xord.  The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+@x
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+
+@x [23] Remove non-local goto
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+    end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+@y
+@d abort(#)==begin write_ln(stderr, ' ',#,'.'); jump_out;
+    end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+uexit(1);
+end;
+@z
+
+@x [51] Fix casting problem in C.
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@y
+@d comp_spair(#) == if a<128 then #:=a*intcast(256)+b
+                             @+ else #:=(a-intcast(256))*intcast(256)+b
+@d comp_upair(#) == #:=a*intcast(256)+b
+@z
+
+@x [52]
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@y
+if a<128 then #:=(a*intcast(256)+b)*intcast(256)+c @+
+else #:=((a-intcast(256))*intcast(256)+b)*intcast(256)+c
+@d comp_utrio(#) == #:=(a*intcast(256)+b)*intcast(256)+c
+@z
+
+@x [53]
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@y
+if a<128 then #:=((a*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+else #:=(((a-intcast(256))*intcast(256)+b)*intcast(256)+c)*intcast(256)+d
+@z
+
+@x [62] cur_name is no longer a fixed-size array.
+@!cur_name:packed array[1..name_length] of char; {external name,
+  with no lower case letters}
+@y
+@!cur_name:^char;
+@z
+
+@x [63] Ignore arguments to make_font_name.
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+  if l_cur_name<name_length then
+    begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+    end
+  else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+  append_to_name(#[l]); make_name
+@d make_font_name(#)==
+  l_cur_name:=0; for l:=1 to # do make_font_name_end
+@y
+@ Since files are actually searched through path definitions,
+the area definitions are ignored here.
+To reduce the required changes we simply ignore the parameters given
+to |make_font_name|.
+@^system dependencies@>
+
+@d append_to_name(#)== begin 
+    cur_name[l_cur_name]:=#;
+    incr(l_cur_name); 
+    end
+@d make_font_name_end(#)==
+  make_name
+@d make_font_name(#)==
+  l_cur_name:=0; make_font_name_end
+@z
+
+% [67] No conversion of filenames in lower case, and initialize and
+% terminate for C strings.
+@x
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@y
+cur_name := xmalloc_array (char, pckt_length (n) + pckt_length (e));
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+@z
+
+@x
+  if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+@y
+@z
+
+@x
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+  begin pckt_extract(b); append_res_to_name(xchr[b]);
+  end;
+while l_cur_name<name_length do
+  begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+  end;
+@y Skip copying in the extension, kpathsea knows what to do.
+  cur_name[l_cur_name] := 0;
+@z
+
+@x [93] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+ 
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+@y
+@ If no font directory has been specified, we search paths.
+@z
+
+@x [94] Remove initialization of now-defunct array
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+@y
+@ (No initialization to be done.  Keep this module to preserve numbering.)
+@z
+
+@x [96] Open TFM file
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then
+@y
+|TFM_default_area_name_length| and |TFM_default_area| will not
+be used by |make_font_name|.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+
+full_name := kpse_find_tfm (cur_name);
+if full_name then begin
+  resetbin (tfm_file, full_name);
+  free (cur_name);
+  free (full_name);
+end else
+@z
+
+@x [103] Fix casting problem in C.
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+@y
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*intcast(256)+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*intcast(256)+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128
+then #:=((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+else #:=(((tfm_b0-intcast(256))*intcast(256)+tfm_b1)
+        *intcast(256)+tfm_b2)*intcast(256)+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*intcast(256)+tfm_b1)*intcast(256)+tfm_b2)*intcast(256)+tfm_b3)
+@z
+
+@x [109] Declare full_name.
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@y
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+@!full_name: ^char;
+@z
+
+@x [111] Fix up opening the binary files
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+@y
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+dvi_loc:=0;
+@z
+
+@x [113] Make dvi_length() and dvi_move() work.
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+@y
+@p function dvi_length:int_32;
+begin xfseek(dvi_file, 0, 2, 'dvicopy');
+dvi_loc:=xftell(dvi_file, 'dvicopy');
+dvi_length:=dvi_loc;
+end;
+@#
+procedure dvi_move(n:int_32);
+begin xfseek(dvi_file, n, 0, 'dvicopy');
+dvi_loc:=n;
+end;
+@z
+
+@x [137/138] Set default directory name
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+ 
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+@y
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+ 
+Actually, under UNIX the standard area is defined in an external
+file \.{site.h}.  And the users have a path searched for fonts,
+by setting the \.{VFFONTS} environment variable.
+
+@ (No initialization to be done.  Keep this module to preserve numbering.)
+@z
+
+@x [139] Open VF file
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then
+@^system dependencies@>
+@y
+Do path searching. But the \.{VF} file may not exist.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+full_name := kpse_find_vf (cur_name);
+if full_name then begin
+  resetbin (vf_file, full_name);
+  free (cur_name);
+  free (full_name);
+end else 
+@z
+
+@x [163] copy elements of array piece by piece
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+@ \.{web2c} does not like array assignments. So we need to do them
+through a macro replacement.
+
+@d do_vf_move(#) == vf_move[vf_ptr]# := vf_move[vf_ptr-1]#
+@d vf_move_assign == begin do_vf_move([0][0]); do_vf_move([0][1]);
+			   do_vf_move([1][0]); do_vf_move([1][1])
+		     end
+
+@<VF: Start a new level@>=
+append_one(push);
+vf_move_assign;
+@z
+
+@x [170] and again...
+  vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+@y
+  vf_move_assign;
+@z
+
+@x [175] break is fflush.
+@d update_terminal == break(output) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(stdout) {empty the terminal output buffer}
+@z
+
+@x [175]
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+  begin print('Enter option: '); update_terminal; reset(input);
+  if eoln(input) then read_ln(input);
+  k:=0; pckt_room(terminal_line_length);
+  while (k<terminal_line_length)and not eoln(input) do
+    begin append_byte(xord[input^]); incr(k); get(input);
+    end;
+  end
+else if k_opt<n_opt then
+  begin incr(k_opt);
+  {Copy command line option number |k_opt| into |byte_mem| array!}
+  end;
+end;
+@y
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin print('Enter option: '); update_terminal;
+{|if eoln(input) then read_ln(input);|}
+k:=0; pckt_room(terminal_line_length);
+while (k<terminal_line_length)and not eoln(input) do
+  begin append_byte(xord[getc(input)]); incr(k);
+  end;
+end;
+@z
+
+@x [231] No dialog, remove unused final label.
+dialog; {get options}
+@y
+@z
+@x
+final_end:end.
+@y
+end.
+@z
+
+@x [236] Do this later, to avoid creating empty files.
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+@y
+@<Open output file(s)@>=
+@z
+
+@x [238] Use external routine to output bytes.
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+@y
+@d out_byte(#) == put_byte(#,out_file) {write next \.{DVI} byte}
+@z
+
+@x [250] String declaration.
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+@y
+@!comment:^char; {preamble comment prefix}
+@z
+
+@x [251] Output the string from 0 to len-1, not 1 to len.
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+@y
+for k:=0 to comm_length - 1 do append_byte(xord[comment[k]]);
+@z
+
+@x [] System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+This macro tests if its argument is the current option, as represented
+by the index variable |option_index|.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 5; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+    @!getopt_return_val: integer;
+    @!option_index: c_int_type;
+    @!current_option: 0..n_options;
+    @!k, @!m: c_int_type;
+    @!end_num: ^char;
+begin
+  @<Define the option table@>;
+  @<Initialize options@>;
+  repeat
+    getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+                                           address_of (option_index));
+    if getopt_return_val = -1 then begin
+      {End of arguments; we exit the loop below.} ;
+
+    end else if getopt_return_val = "?" then begin
+      usage ('dvicopy');
+
+    end else if argument_is ('help') then begin
+      usage_help (DVICOPY_HELP, nil);
+
+    end else if argument_is ('version') then begin
+      print_version_and_exit (banner, 'Peter Breitenlohner', nil);
+
+    end else if argument_is ('magnification') then begin
+      out_mag := atou (optarg);
+    
+    end else if argument_is ('max-pages') then begin
+      max_pages := atou (optarg);
+      incr (cur_select);
+      
+    end else if argument_is ('page-start') then begin
+      @<Determine the desired |start_count| values from |optarg|@>;
+    
+    end; {Else it was a flag; |getopt| has already done the assignment.}
+  until getopt_return_val = -1;
+
+  {Now |optind| is the index of first non-option on the command line.
+   We can have zero, one, or two remaining arguments.}
+  if optind = argc then begin
+    dvi_file := make_binary_file (stdin);
+    out_file := make_binary_file (stdout);
+    term_out := stderr;
+    
+  end else if optind + 1 = argc then begin
+    resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+    out_file := make_binary_file (stdout);
+    term_out := stderr;
+    
+  end else if optind + 2 = argc then begin
+    resetbin (dvi_file, extend_filename (cmdline (optind), 'dvi'));
+    rewritebin (out_file, extend_filename (cmdline (optind + 1), 'dvi'));
+    term_out := stdout;
+  
+  end else begin
+    write_ln (stderr, 'dvicopy: Need at most two file arguments.');
+    usage ('dvicopy');
+  end;
+end;
+
+@ Here is the first of the options we allow.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[0].name := 'help';
+long_options[0].has_arg := 0;
+long_options[0].flag := 0;
+long_options[0].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Magnification to apply.
+@.-magnification@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'magnification';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ How many pages to do.
+@.-max-pages@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'max-pages';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ What page to start at.
+@.-page-start@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'page-start';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Parsing the starting page specification is a bit complicated. 
+(This is the same as in \.{DVItype}.)
+
+@<Determine the desired |start_count|...@> =
+k := 0; {which \.{\\count} register we're on}
+m := 0; {position in |optarg|}
+while optarg[m] do begin
+  if optarg[m] = "*" then begin
+    start_there[k] := false;
+    incr (m);
+  
+  end else if optarg[m] = "." then begin
+    incr (k);
+    if k >= 10 then begin
+      write_ln (stderr, 'dvicopy: More than ten count registers specified.');
+      uexit (1);
+    end;
+    incr (m);
+  
+  end else begin
+    start_count[k] := strtol (optarg + m, address_of (end_num), 10);
+    if end_num = optarg + m then begin
+      write_ln (stderr, 'dvicopy: -page-start values must be numeric or *.');
+      uexit (1);
+    end;
+    start_there[k] := true;
+    m := m + end_num - (optarg + m);
+  end;
+end;
+start_vals := k;
+selected := false;
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ @<Glob...@> =
+@!term_out:text;
+@z