% This is GFtoDVI.CHGCMS in text format, as of jul 11, 1986
%  (change file for IBM CMS PASCAL/VS, created by B.SCHULZE, Univ. Bonn)
%
%
%line numbers correspond to version 1.7 of GFtoDVI (of may  5, 1986)
%
%line 59
%
%module x
@x
@d banner=='This is GFtoDVI, Version 1.7' {printed when the program starts}
@y
@d banner=='This is GFtoDVI, CMS Version 1.7'
                     {printed when the program starts}
@z
%
%line 72
%
%module x
@x
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == otherwise {default for cases not listed explicitly}
@d term_in == INTERM {terminal input}
@d term_out == OUTTERM {terminal output}
@z
%
%line 88
%
%module x
@x
@d print(#)==write(#)
@d print_ln(#)==write_ln(#)
@d print_nl(#)==begin write_ln; write(#);
@y
@d print(#)==write(term_out,#)
@d print_ln(#)==write_ln(term_out,#)
@d print_nl(#)==begin write_ln(term_out); write(term_out,#);
@z
%
%line 99
%
%module x
@x
  var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
  begin print_ln(banner);@/
  @<Set initial values@>@/
@y
  var @!i,@!j,@!k,@!m,@!n:integer; {loop indices for initializations}
  begin
  @= termin@>(term_in);
  @= termout@>(term_out);
  print_ln(banner);@/
  @<Set initial values@>@/
@z
%
%line 120
%
%module x
@x
@!file_name_size=50; {a file name shouldn't be longer than this}
@!font_mem_size=1000; {space for font metric data}
@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
@y
@!file_name_size=20; {a file name shouldn't be longer than this}
@!font_mem_size=1000; {space for font metric data}
@!dvi_buf_size=4096; {size of the output buffer; must be a multiple of 8}
@!dvi_blck_size=2048;
@!max_gf_size=4096;
@!max_tfm_size=4096;
@z
%
%line 219
%
%module x
@x
@d last_text_char=127 {ordinal number of the largest element of |text_char|}
@y
@d last_text_char=255 {ordinal number of the largest element of |text_char|}
@z
%
%line 222
%
%module x
@x
@!text_file=packed file of text_char;
@y
@!text_file=text;
@z
%
%line 356
%
%module x
@x
@d update_terminal == break(output) {empty the terminal output buffer}
@y
@d update_terminal ==
@z
%
%line 360
%
%module x
@x
@!term_in:text_file; {the terminal, considered as an input file}
@y
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}
@z
%
%line 366
%
%module x
@x
@p procedure input_ln; {inputs a line from the terminal}
begin update_terminal; reset(term_in);
if eoln(term_in) then read_ln(term_in);
line_length:=0;
while (line_length<terminal_line_length)and not eoln(term_in) do
  begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
  end;
end;
@y
@p procedure input_ln; {inputs a line from the terminal}
var k:0..terminal_line_length;
    il: string(terminal_line_length);
begin update_terminal;
read_ln(term_in,il);
k:=0;
while (k<@=length@>(il)) do
  begin
     buffer(.k.):=xord(.il(.k+1.).);  incr(k);
  end;
buffer[k]:=" ";
end;
@z
%
%line 1512
%
%module x
@x
@!eight_bits=0..255; {unsigned one-byte quantity}
@y
@!eight_bits=packed 0..255; {unsigned one-byte quantity}
@!type_dvi_blck=packed array(.1..dvi_blck_size.) of eight_bits;
@z
%
%line 1522
%
%module x
@x
@!gf_file:byte_file; {the character data we are reading}
@!dvi_file:byte_file; {the typesetting instructions we are writing}
@!tfm_file:byte_file; {a font metric file}
@y
@!gf_file:text;
@!dvi_file:file of type_dvi_blck;
@!tfm_file:text;
@!dvi_block:type_dvi_blck;         {file to write: fixed}
@!gf_rec:string(max_gf_size);      {file to read: varying}
@!tfm_rec:string(max_tfm_size);    {file to read: varying}
@!gf_count:integer;     {current position in gf record}
@!gf_length:integer;    {length of current gf record}
@!tfm_count:integer;    {current position in tfm record}
@!tfm_length:integer;   {length of current tfm record}
@!eof_gf_file:boolean;
@!eof_tfm_file:boolean;
@z
%
%line 1534
%
%module x
@x
@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file,name_of_file);
cur_loc:=0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin reset(tfm_file,name_of_file);
end;
@#
procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
begin rewrite(dvi_file,name_of_file);
end;
@y
@d ccat==@=||@>
@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin
gf_count:=max_gf_size + 1;
gf_length:=0;
eof_gf_file:= false;
reset(gf_file);
cur_loc:=0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin
tfm_count:=max_tfm_size + 1;
tfm_length:=0;
eof_tfm_file:= false;
reset(tfm_file,'NAME='||trim(str(name_of_file)));
end;
@#
procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
begin rewrite(dvi_file);
end;
@z
%
%line 1570
%
%module x
@x
begin read(tfm_file,b0); read(tfm_file,b1);
read(tfm_file,b2); read(tfm_file,b3);
@y works only if tfm rec size multiple of 4
begin
if tfm_count > tfm_length then
 begin
 read(tfm_file,tfm_rec);
 tfm_length:=@= length@>(tfm_rec);
 tfm_count:=1;
 end;
b0:=ord(tfm_rec(.tfm_count.));
b1:=ord(tfm_rec(.tfm_count+1.));
b2:=ord(tfm_rec(.tfm_count+2.));
b3:=ord(tfm_rec(.tfm_count+3.));
tfm_count:=tfm_count+4;
eof_tfm_file:=(eof(tfm_file) & (tfm_count > tfm_length));
@z
%
%line 1580
%
%module x
@x
@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(gf_file) then get_byte:=0
else  begin read(gf_file,b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@y
@p
procedure get_gf(var bb: eight_bits);   {gets next byte from gf file}
begin
if gf_count > gf_length then
 begin
 read(gf_file,gf_rec);
 gf_length:=@= length@>(gf_rec);
 gf_count:=1;
 end;
bb := ord(gf_rec(.gf_count.));
incr(gf_count);
incr(cur_loc);
eof_gf_file:=(eof(gf_file) & (gf_count > gf_length));
end;
@#
function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin
get_gf(b); get_byte:=b;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin get_gf(a); get_gf(b);
get_two_bytes:=a*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin get_gf(a); get_gf(b); get_gf(c);
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin get_gf(a); get_gf(b); get_gf(c); get_gf(d);
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@z
%
%line 1627
%
%module x
@x
@d qi(#)==#+min_quarterword
  {to put an |eight_bits| item into a quarterword}
@d qo(#)==#-min_quarterword
  {to take an |eight_bits| item out of a quarterword}
@y
@d qi(#)==#  {to put an |eight_bits| item into a quarterword}
@d qo(#)==#  {to take an |eight_bits| item out of a quarterword}
@z
%
%line 2284
%
%module x
@x
l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
@y
l:=2; init_str2(".")("*")(home_font_area);@/
@z
%
%line 2297
%
%module x
@x
begin if c=" " then more_name:=false
else  begin if (c=">")or(c=":") then
    begin area_delimiter:=pool_ptr; ext_delimiter:=0;
    end
  else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
  str_room(1); append_char(c); {contribute |c| to the current string}
  more_name:=true;
  end;
end;
@y
var ret:boolean;
begin if c=" " then ret:=false
else  begin ret:=true;
  if (c=".")then if ext_delimiter=0 then ext_delimiter:=pool_ptr
    else if area_delimiter=0 then area_delimiter:=pool_ptr
    else ret:=false;
  if ret then begin {contribute |c| to the current string}
    str_room(1); append_char(c); end;
  end;
more_name:=ret;
end;
@z
%
%line 2311
%
%module x
@x
if area_delimiter=0 then cur_area:=null_string
else  begin cur_area:=str_ptr; incr(str_ptr);
  str_start[str_ptr]:=area_delimiter+1;
  end;
if ext_delimiter=0 then
  begin cur_ext:=null_string; cur_name:=make_string;
  end
else  begin cur_name:=str_ptr; incr(str_ptr);
  str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string;
  end;
end;
@y
if ext_delimiter=0 then begin cur_area:=null_string;
  cur_ext:=null_string;
  cur_name:=make_string; end
else  begin cur_name:=str_ptr; incr(str_ptr);
  str_start[str_ptr]:=ext_delimiter+1;
  if area_delimiter=0 then
    begin cur_area:=null_string; cur_ext:=make_string;
    end
  else  begin cur_ext:=str_ptr; incr(str_ptr);
    str_start[str_ptr]:=area_delimiter; cur_area:=make_string;
    end;
  end;
end;
@z
%
%line 2341
%
%module x
@x
for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
@y
for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
@z
%
%line 2357
%
%module x
@x
@ The |start_gf| procedure prompts the user for the name of the generic
font file to be input. It opens the file, making sure that some input is
present; then it opens the output file.

Although this routine is system-independent, it should probably be
modified to take the file name from the command line (without an initial
prompt), on systems that permit such things.

@p procedure start_gf;
label found,done;
begin loop@+begin print_nl('GF file name: '); input_ln;
@.GF file name@>
  buf_ptr:=0; buffer[line_length]:="?";
  while buffer[buf_ptr]=" " do incr(buf_ptr);
  if buf_ptr<line_length then
    begin @<Scan the file name in the buffer@>;
    if cur_ext=null_string then cur_ext:=gf_ext;
    pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
    if not eof(gf_file) then goto found;
    print_nl('Oops... I can''t find file '); print(name_of_file);
@.Oops...@>
@.I can't find...@>
    end;
  end;
found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
open_dvi_file;
end;

@ @<Scan the file name in the buffer@>=
if buffer[line_length-1]="/" then
  begin interaction:=true; decr(line_length);
  end;
begin_name;
loop@+  begin if buf_ptr=line_length then goto done;
  if not more_name(buffer[buf_ptr]) then goto done;
  incr(buf_ptr);
  end;
done:end_name
@y
@ I don't see the slightest reason why the user should be prompted for
the name of the file to be processed.

@p procedure start_gf;
begin
open_gf_file;
if eof(gf_file) then
    bad_gf('Oops... I can''t find gf file ');
@.Oops...@>
@.I can't find...@>
open_dvi_file;
end;
@z
%
%line 2474
%
%module x
@x
@ Some systems may find it more efficient to make |dvi_buf| a |packed|
array, since output of four bytes at once may be facilitated.
@^system dependencies@>
@y
@ We play a trick with variant records so that we can fill up the
|dvi_buf| array byte by byte, but write it out in one swell foop.
@^system dependencies@>
@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
@z
%
%line 2479
%
%module x
@x
@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
@y
@!d_buffer: packed record
  case boolean of
  false:(b:packed array [dvi_index] of eight_bits);
  true: (l:type_dvi_blck; r:type_dvi_blck);
  end;
@z
%
%line 2493
%
%module x
@x
@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
|write_dvi(a,b)|. It is safe to assume that |a| and |b+1| will both be
multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
many machines to use efficient methods to pack four bytes per word and to
output an array of words with one system call.
@^system dependencies@>

@p procedure write_dvi(@!a,@!b:dvi_index);
var k:dvi_index;
begin for k:=a to b do write(dvi_file,dvi_buf[k]);
end;
@y
@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
|write| on the other variant of the |dvi_buf| record.
@^system dependencies@>
@z
%
%line 2514
%
%module x
@x
  begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
@y
  begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
@z
%
%line 2517
%
%module x
@x
else  begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
@y
else  begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
@z
%
%line 2525
%
%module x
@x
if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
@y
if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223; {bug is |k| ok?}
if dvi_ptr>0 then write(dvi_file,d_buffer.l);
if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
@z
%
%line 3579
%
%module x
@x
@!b:array[0..4095] of 0..120; {largest existing character for a given pattern}
@!r:array[0..4095] of 1..4096; {the ``ruler function''}
@y
@!b:array(.0..4095.) of packed 0..120;
                   {largest existing character for a given pattern}
@!r:array(.0..4095.) of packed 1..4096; {the ``ruler function''}
@z
%
%line 3625
%
%module x
@x
@!a:array[0..widest_row] of 0..4095; {bit patterns for twelve rows}
@y
@!a:array(.0..widest_row.) of packed 0..4095; {bit patterns for twelve rows}
@z
%
%line 4146
%
%module x
@x
@p begin initialize; {get all variables initialized}
@<Initialize the strings@>;
start_gf; {open the input and output files}
@<Process the preamble@>;
cur_gf:=get_byte; init_str_ptr:=str_ptr;
loop@+  begin @<Initialize variables for the next character@>;
  while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
  if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
  if cur_gf<>boc then if cur_gf<>boc1 then abort('Missing boc!');
@.Missing boc@>
  @<Process a character@>;
  cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
  end;
final_end:end.
@y
@p procedure second_init;
var @!m:integer;
begin
@<Initialize the strings@>;@/
start_gf; {open the input and output files}
@<Process the preamble@>;
cur_gf:=get_byte; init_str_ptr:=str_ptr;
end;
procedure process;
var @!k:integer;
begin
  @<Process a character@>;
end;
begin initialize; {get all variables initialized}
second_init;
loop@+  begin @<Initialize variables for the next character@>;
  while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
  if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
  if cur_gf<>boc then if cur_gf<>boc1 then abort('Missing boc!');
@.Missing boc@>
  process;
  cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
  end;
final_end:end.
@z