diff options
Diffstat (limited to 'Build/source/texk/web2c/omegaware/ofm2opl.ch')
-rw-r--r-- | Build/source/texk/web2c/omegaware/ofm2opl.ch | 461 |
1 files changed, 0 insertions, 461 deletions
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.ch b/Build/source/texk/web2c/omegaware/ofm2opl.ch deleted file mode 100644 index 4b99c98d152..00000000000 --- a/Build/source/texk/web2c/omegaware/ofm2opl.ch +++ /dev/null @@ -1,461 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% applies only to the changes to the original tftopl.ch. -% -% tftopl.ch for C compilation with web2c. -% -% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL, -% released with version 0.96 of TeX in February, 1983. -% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX -% in April, 1983. -% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle. -% 07/28/83 (HWT) Brought up to version 2 -% 11/21/83 (HWT) Brought up to version 2.1 -% 03/24/84 (HWT) Brought up to version 2.2 -% 07/12/84 (HWT) Brought up to version 2.3 -% 07/05/87 (ETM) Brought up to version 2.5 -% 03/22/88 (ETM) Converted for use with WEB to C. -% 11/30/89 (KB) Version 3. -% 01/16/90 (SR) Version 3.1. -% (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 -%\def\title{TF\lowercase{to}PL changes for C} -@z - -% [2] Fix files in program statement. We need to tell web2c about one -% special variable. Perhaps it would be better to allow @define's -% anywhere in a source file, but that seemed just as painful as this. -@x -@p program OFM2OPL(@!tfm_file,@!pl_file,@!output); -@y -@p -{Tangle doesn't recognize @@ when it's right after the \.=.} -@\@= @@define var tfm;@>@\ -program OFM2OPL(@!tfm_file,@!pl_file,@!output); -@z - -@x [still 2] Don't print banner until later (and unless verbose). -procedure initialize; {this procedure gets things started properly} - begin print_ln(banner);@/ -@y -@<Define |parse_arguments|@> -procedure initialize; {this procedure gets things started properly} - begin - kpse_set_progname (argv[0]); - kpse_init_prog ('OFM2OPL', 0, nil, nil); - {We |xrealloc| when we know how big the file is. The 1000 comes - from the negative lower bound.} - tfm_file_array := cast_to_byte_pointer (xmalloc (2000000)); - parse_arguments; -@z - -%@x [5] Increase sizes to match vptovf. -%@!tfm_size=30000; {maximum length of |tfm| data, in bytes} -%@!lig_size=5000; {maximum length of |lig_kern| program, in words} -%@!hash_size=5003; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@y -%@!tfm_size=40000; {maximum length of |tfm| data, in bytes} -%@!lig_size=8000; {maximum length of |lig_kern| program, in words ($<2^{15}$)} -%@!hash_size=8009; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@z - -@x [7] Open the TFM file. -@ On some systems you may have to do something special to read a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -reset(tfm_file); -@y -@ On some systems you may have to do something special to read a -packed file of bytes. With C under Unix, we just open the file by name -and read characters from it. - -@<Set init...@>= -tfm_file := kpse_open_file (tfm_name, kpse_ofm_format); -if verbose then begin - print (banner); - print_ln (version_string); -end; -@z - -@x [17] Open the PL file. -@!pl_file:text; - -@ @<Set init...@>= -rewrite(pl_file); -@y -@!pl_file:text; - -@ If an explicit filename isn't given, we write to |stdout|. - -@<Set init...@>= -if optind + 1 = argc then begin - pl_file := stdout; -end else begin - pl_name := extend_filename (cmdline (optind + 1), 'opl'); - rewrite (pl_file, pl_name); -end; -@z - -@x [18,19] Make |tfm| be dynamically allocated, and rename `index'. -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} -@!index=-1000..tfm_size; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ -@<Glob...@>= -@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} -@y -@d index == index_type - -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} -@!index=integer; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ CHECK OUT tfm array ranges. -@<Glob...@>= -{Kludge here to define |tfm| as a macro which takes care of the negative - lower bound. We've defined |tfm| for the benefit of web2c above.} -@=#define tfm (tfmfilearray + 1001);@>@\ -@!tfm_file_array: pointer_to_byte; {the input data all goes here} -@z - -@x [20] Send error output to stderr. -@d abort(#)==begin print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); -@y -@d abort(#)==begin write_ln(stderr, #); - write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?'); -@z - -@x [20] Allow arbitrarily large input files. -if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); -@.The file is bigger...@> -@y -{|tfm_file_array - := cast_to_byte_pointer (xrealloc (tfm_file_array, 4 * lf - 1 + 1108));|} -@z - -% [27, 28] Change strings to C char pointers. The Pascal strings are -% indexed starting at 1, so we pad with a blank. -@x -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} -@y -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string; - {strings for output in the user's external character set} -@!ASCII_all: packed array[0..256] of char; -@!MBL_string,@!RI_string,@!RCE_string: c_string; - {handy string constants for |face| codes} -@z - -@x -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:='0123456789ABCDEF';@/ -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; -@y -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:=' 0123456789ABCDEF';@/ -strcpy (ASCII_all, ASCII_04); -strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); -strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/ -MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE'; -@z - -% [38] How we output the character code depends on |charcode_format|. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -begin if font_type>vanilla then - out_hex_char(c) -else if (c>="0")and(c<="9") then - out(' C ',c-"0":1) -else if (c>="A")and(c<="Z") then - out(' C ',ASCII_10[c-"A"+2]) -else if (c>="a")and(c<="z") then - out(' C ',ASCII_14[c-"a"+2]) -else out_hex_char(c); -@y -begin if (font_type > vanilla) or (charcode_format = charcode_hex) then - out_hex_char(c) -else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~") - and (c <> "(") and (c <> ")") then - out(' C ', ASCII_all[c - " " + 1]) -{default case, use hex} -else out_hex_char(c); -@z - -% [39] Don't output the face code as an integer. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - out(MBL_string[1+(b mod 3)]); - out(RI_string[1+s]); - out(RCE_string[1+(b div 3)]); -@y - put_byte(MBL_string[1+(b mod 3)], pl_file); - put_byte(RI_string[1+s], pl_file); - put_byte(RCE_string[1+(b div 3)], pl_file); -@z - -@x [40] Force 32-bit constant arithmetic for 16-bit machines. -f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; -@y -f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3]; -@z - -% [78] No progress reports unless verbose. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - incr(chars_on_line); - end; - if no_repeats(c)>0 then begin - print_hex(c); print('-'); print_hex(c+no_repeats(c)); - left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; - end - else begin - print_hex(c); {progress report} - left; out('CHARACTER'); out_char(c); out_ln; - end; -@y - if verbose then incr(chars_on_line); - end; - if no_repeats(c)>0 then begin - if verbose then begin - print_hex(c); print('-'); print_hex(c+no_repeats(c)); - end; - left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; - end - else begin - if verbose then print_hex(c); {progress report} - left; out('CHARACTER'); out_char(c); out_ln; - end; -@z - -% [89] Change the name of the variable `class', since AIX 3.1's <math.h> -% defines a function by that name. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@d pending=4 {$f(x,y)$ is being evaluated} -@y -@d pending=4 {$f(x,y)$ is being evaluated} - -@d class == class_var -@z - -% [90] Change name of the function `f'. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@y - r:=f_fn(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@z - -% [94] web2c can't handle these mutually recursive procedures. -% But let's do a fake definition of f here, so that it gets into web2c's -% symbol table. We also have to change the name, because there is also a -% variable named `f', and some C compilers can't deal with that. -@x -@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -@y -@p -ifdef('notdef') -function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -endif('notdef') -@z -@x -else eval:=f(h,x,y); -@y -else eval:=f_fn(h,x,y); -@z - -% [95] The real definition of f. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@p function f; -@y -@p function f_fn(@!h,@!x,@!y:index):index; -@z -@x -f:=lig_z[h]; -@y -f_fn:=lig_z[h]; -@z - -% [99] No final newline unless verbose. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -do_characters; print_ln('.');@/ -@y -do_characters; if verbose then print_ln('.');@/ -@z - -@x [100] System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{TFtoPL} 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. - -@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) - -@<Define |parse_arguments|@> = -procedure parse_arguments; -const n_options = 4; {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; -begin - @<Initialize the option variables@>; - @<Define the option table@>; - 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 ('ofm2opl'); - - end else if argument_is ('help') then begin - usage_help (OFM2OPL_HELP, nil); - - end else if argument_is ('version') then begin - print_version_and_exit - (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); - - end else if argument_is ('charcode-format') then begin - if strcmp (optarg, 'ascii') = 0 then - charcode_format := charcode_ascii - else if strcmp (optarg, 'hex') = 0 then - charcode_format := charcode_hex - else - write_ln (stderr, 'Bad character code format', 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.} - if (optind + 1 <> argc) and (optind + 2 <> argc) then begin - write_ln (stderr, 'ofm2opl: Need one or two file arguments.'); - usage ('ofm2opl'); - end; - - tfm_name := cmdline (optind); -end; - -@ Here are the options we allow. The first is one of the standard GNU options. -@.-help@> - -@<Define the option...@> = -current_option := 0; -long_options[current_option].name := 'help'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].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); - -@ Print progress information? -@.-verbose@> - -@<Define the option...@> = -long_options[current_option].name := 'verbose'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := address_of (verbose); -long_options[current_option].val := 1; -incr (current_option); - -@ -@<Glob...@> = -@!verbose: c_int_type; - -@ -@<Initialize the option...@> = -verbose := false; - -@ This option changes how we output character codes. -@.-charcode-format@> - -@<Define the option...@> = -long_options[current_option].name := 'charcode-format'; -long_options[current_option].has_arg := 1; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ We use an ``enumerated'' type to store the information. - -@<Type...@> = -@!charcode_format_type = charcode_ascii..charcode_default; - -@ -@<Const...@> = -@!charcode_ascii = 0; -@!charcode_hex = 1; -@!charcode_default = 2; - -@ -@<Global...@> = -@!charcode_format: charcode_format_type; - -@ It starts off as the default, which is hex for OFM2OPL. - -@<Initialize the option...@> = -charcode_format := charcode_default; - -@ 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; - -@ Global filenames. - -@<Global...@> = -@!tfm_name, @!pl_name:c_string; -@z |