GFtoPXL change file for Vax/VMS.
Jane Colman, Lawrence Berkeley Laboratory
10 Oct 84

@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\let\maybe=\iftrue
\def\title{GFtoPXL changes for Vax/VMS}
@z

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

@x
@d debug==@{
@d gubed==@t@>@}
@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
@y
@d debug==@{
@d gubed==@t@>@}
@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
@z

@x
@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@y
@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@d real == double
@z

@x
@p program GF_to_PXL(@!gf_file,@!pxl_file,@!output);
@y
@p
@\@=[inherit('sys$library:starlet')]@>@\
program GF_to_PXL(@!gf_file,@!pxl_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
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
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
{later we'll define files that contain binary date}
@z

@x
@!gf_file:byte_file; {the stuff we are \.{GFtoPXL}ing}
@!pxl_file:byte_file; {the stuff we have \.{GFtoPXL}ed}
@y
@!gf_file:packed file of byte_block; {the stuff we are \.{GFtoPXL}ing}
@!pxl_file:packed file of byte_block; {the stuff we have \.{GFtoPXL}ed}
@!gf_count:integer; {number of bytes read from current block of |gf_file|}
@!pxl_count:integer; {number of bytes written to current block of |pxl_file|}
@!gf_blocks:integer; {number of blocks in |gf_file|}
@z

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

@x
begin rewrite(pxl_file);
@y
begin rewrite(pxl_file);
pxl_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 signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read(gf_file,b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
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 signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*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_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*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 signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read_gf_file(b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
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 signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read_gf_file(a); read_gf_file(b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*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_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read_gf_file(a); read_gf_file(b); read_gf_file(c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*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
@d pxl_byte(#)==begin write(pxl_file,#); incr(pxl_byte_no); end
@y
@d pxl_byte(#)==begin pxl_file^[pxl_count]:=#; {output one byte to |pxl_file|}
    incr(pxl_count);
    if pxl_count=VAX_block_length then begin
        put(pxl_file,@=error:=continue@>); pxl_count:=0; end;
    incr(pxl_byte_no);
    end
@z

@x
begin set_pos(gf_file,-1); gf_length:=cur_pos(gf_file);
@y
begin gf_length:=gf_blocks*VAX_block_length-1;
@z

@x
begin set_pos(gf_file,n); cur_loc:=n;
@y
var @!blk,@!byt:integer; {block and byte number}
begin cur_loc:=n;
  blk:=n div VAX_block_length;
  byt:=n-(blk*VAX_block_length);
 @=find@>(gf_file,blk+1); {VMS starts counting block numbers at 1, not 0}
  gf_count:=byt;
@z

@x
post_loc:=gf_length-4;
@y
post_loc:=gf_length-4;
repeat if post_loc=0 then bad_gf('all 0s');
@.all 0s@>
move_to_byte(post_loc); k:=get_byte; decr(post_loc);
until k<>0;
if k<>223 then bad_gf('223 byte is ',k:1);
@.223 byte is wrong@>
@z

@x
final_end:end.
@y
while pxl_count>0 do pxl_byte(0);
close(pxl_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 \.{GFtoPXL} 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 \.{GFtoPXL} 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_direct==@=direct@>
@d VAX_fixed==@=fixed@>
@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 @>
@d VAX_fab_type==@= FAB$TYPE @>
@d VAX_rab_type==@= RAB$TYPE @>
@d VAX_xab_type==@= XAB$TYPE @>
@d VAX_fab_xab==@= FAB$L_XAB @>
@d VAX_xab_nxt==@= XAB$L_NXT @>
@d VAX_xab_cod==@= XAB$B_COD @>
@d VAX_xab_fhc==@= XAB$C_FHC @>
@d VAX_xab_ebk==@= XAB$L_EBK @>

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

@ @<Glob...@>==
@!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@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>gf_open,@=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@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>gf_open,@=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+'.PXL';
	open(pxl_file,file_name,@=new,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(pxl_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('PXL file: ');
	if eof then goto 9999;
	read_ln(file_name);
	if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
	open(pxl_file,file_name,@=new,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(pxl_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

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

@ Here is how we intervene to find out the length of the |gf_file|.

@<Procedures for ...@>=
function gf_open(var fab:VAX_fab_type; var rab:VAX_rab_type):integer;
	type XAB_ptr = ^VAX_xab_type;
	var	user_status:integer;
		xab,fhc:XAB_ptr;
	begin
	user_status:=@= $OPEN@>(fab);
	if odd(user_status) then @= $CONNECT@>(rab);
	xab:=fab.VAX_fab_xab::XAB_ptr;
	fhc:=nil;
	while (xab<>nil) and (fhc=nil) do
		if xab^.VAX_xab_cod=VAX_xab_fhc then fhc:=xab
		else xab:=xab^.VAX_xab_nxt::XAB_ptr;
	if fhc<>nil then gf_blocks:=int(fhc^.VAX_xab_ebk)
	else gf_blocks:=0;

	gf_open:=user_status;
	end;

@z