GFtype change file for Vax/VMS.
Based on DVItype change file for Vax/VMS, copyright 1983 by David Fuchs.
08Aug84 Jane Colman

@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\let\maybe=\iftrue
\def\title{GF$\,$\lowercase{type} changes for Vax/VMS}
@z

@x
@d banner=='This is GFtype, Version 2.2' {printed when the program starts}
@y
@d banner=='This is GFtype, Vax/VMS Version 2.2'
@z

@x
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
@z

@x
@d print(#)==write(#)
@d print_ln(#)==write_ln(#)
@d print_nl==write_ln
@y
@d print(#)==write(type_file,#)
@d print_ln(#)==write_ln(type_file,#)
@d print_nl==write_ln(type_file)
@z

@x
@p program GF_type(@!gf_file,@!output);
@y
@p program GF_type(@!gf_file,@!type_file,@!input,@!output);
@z

@x
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin print_ln(banner);@/
@y
@<Procedures for initialization@>@/
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin
  @<Preset initial values@>@/
  print_ln(banner);@/
@z

@x
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
{later we'll define files that contain binary data}
@z

@x
@!gf_file:byte_file; {the stuff we are \.{GF}typing}
@y
@!gf_file:packed file of byte_block; {the stuff we are \.{GF}typing}
@!gf_count:integer; {number of bytes read from current block of |gf_file|}
@z

@x
begin reset(gf_file);
@y
begin reset(gf_file);
gf_count:=0;
@z

@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
@d read_gf_file(#)==begin
    if gf_count=VAX_block_length then begin
        get(gf_file,@=error:=continue@>); gf_count:=0;
        end;
    #:=gf_file^[gf_count];
    incr(gf_count);
    end

@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;
@z

@x
and |term_out| for terminal output.
@^system dependencies@>

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}
@y
and |term_out| for terminal output.
@^system dependencies@>

@d term_in==input {the terminal, considered as an input file}
@d term_out==output {the terminal, considered as an output file}

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@z

@x
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
On Vax/VMS, this is actually not necessary in this context, since
|update_terminal| is always called just before a |read|.

@d update_terminal == {the terminal output buffer is emptied by |read|}
@z

@x
begin update_terminal; reset(term_in);
if eoln(term_in) then read_ln(term_in);
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
@y
begin update_terminal;
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
read_ln(term_in);
@z

@x
final_end:end.
@y
close(type_file,@=disposition:=save@>,@=error:=continue@>);
final_end:end.
@z

@x
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{GFtype} 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.
@y
Here are the remaining changes to the program
that are necessary to make \.{GFtype} work on Vax/VMS.

@<Const...@>==
@!VAX_block_length=512;

@ @<Types...@>==
@!byte_block=packed array [0..VAX_block_length-1] of 0..255;

@ On Vax/VMS we need the following special definitions, types, variables
and procedures to be able to get the file name from the command line,
or to prompt for them.

@d VAX_volatile==@=volatile@>
@d VAX_immed==@=%immed @>
@d VAX_external==@=external@>
@d VAX_stdescr==@=%stdescr @>
@d VAX_lib_get_foreign==@= lib$get_foreign@>
@d VAX_length==@=length @>

@ @<Types...@>=
@!sixteen_bits= 0..65535;

@ @<Glob...@>==
@!type_file: text;
@!command_line:packed array[1..300] of char;
@!cmd_len:sixteen_bits;
@!cmd_i:integer;
@!file_name,@!def_file_name:varying [300] of char;
@!ask,@!got_file_name: boolean;

@ @<Preset init...@>=
open(output,'SYS$OUTPUT',@=error:=continue@>); {FIX ME! JUNK FOR RUN-TIME BUG}

cmd_i:=0;
VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
got_file_name:=cmd_i<=cmd_len;
if got_file_name then
	def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);

if got_file_name then begin
	file_name:=def_file_name+'.GF';
	open(gf_file,file_name,@=readonly@>, @=error:=continue@>);
	ask:=status(gf_file)<>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	got_file_name:=false;
	write('GF file: ');
	if eof then goto 9999;
	read_ln(file_name);
	open(gf_file,file_name,@=readonly@>, @=error:=continue@>);
	ask:=status(gf_file)<>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

if got_file_name then begin
	cmd_i:=1;
	for cmd_len:=1 to def_file_name.VAX_length do
		if (def_file_name[cmd_len]=']')
		or (def_file_name[cmd_len]=':')
		then cmd_i:=cmd_len+1;
	if cmd_i<=def_file_name.VAX_length then
		def_file_name:=substr(def_file_name,cmd_i,
			def_file_name.VAX_length-cmd_i+1);
	file_name:=def_file_name+'.TYP';
	open(type_file,file_name,@=new,32767,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(type_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('TYPE file: ');
	if eof then goto 9999;
	read_ln(file_name);
	if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
	open(type_file,file_name,@=new,32767,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(type_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;
rewrite(type_file);

@ Here is the library procedure that gets the user's command line.

@<Procedures for ...@>=
[VAX_external] function VAX_lib_get_foreign(
  VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
	:= VAX_immed 0;
  VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
	:= VAX_immed 0;
  var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
  var flag : [VAX_volatile] integer := VAX_immed 0)
    :integer; extern;
@z