DVItype change file for Vax/VMS
Copyright (C) 1983 by David Fuchs.  All rights are reserved.

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

@x
@d banner=='This is DVItype, Version 2.9' {printed when the program starts}
@y
@d banner=='This is DVItype, Vax/VMS Version 2.9'
@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(#)
@y
In fact, we do this under Vax/VMS. We also use double-precision for all
real values.

@d print(#)==write(type_file,#)
@d print_ln(#)==write_ln(type_file,#)
@d real==double
@z

@x
@p program DVI_type(@!dvi_file,@!output);
@y
@p
@\@=[inherit('sys$library:starlet')]@>@\
 {allows us to use system symbols and routines}
program DVI_type(@!dvi_file,@!tfm_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
@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
@!tfm_file:byte_file; {a font metric file}
@y
@!dvi_file:packed file of byte_block; {the stuff we are \.{DVI}typing}
@!tfm_file:packed file of byte_block; {a font metric file}
@!dvi_count:integer; {number of bytes read from current block of |dvi_file|}
@!tfm_count:integer; {number of bytes read from current block of |tfm_file|}
@!dvi_blocks:integer; {number of blocks in |dvi_file|}
@z

@x
begin reset(dvi_file);
@y
begin reset(dvi_file);
dvi_count:=0;
@z

@x
begin reset(tfm_file,cur_name);
@y
begin close(tfm_file,@=error@>:=@=continue@>); {stupid Vax/VMS run-times}
open(tfm_file,cur_name,@=readonly@>,@=error@>:=@=continue@>);
reset(tfm_file,@=error@>:=@=continue@>);
tfm_count:=0;
@z

@x
@p procedure read_tfm_word;
begin read(tfm_file,b0); read(tfm_file,b1);
read(tfm_file,b2); read(tfm_file,b3);
@y
@d read_tfm_file(#)==begin
	if tfm_count=VAX_block_length then begin
		get(tfm_file,@=error:=continue@>); tfm_count:=0;
		end;
	#:=tfm_file^[tfm_count];
	incr(tfm_count);
	end

@p procedure read_tfm_word;
begin read_tfm_file(b0); read_tfm_file(b1);
read_tfm_file(b2); read_tfm_file(b3);
@z

@x
@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read(dvi_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(dvi_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(dvi_file,a); read(dvi_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(dvi_file,a); read(dvi_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(dvi_file,a); read(dvi_file,b); read(dvi_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(dvi_file,a); read(dvi_file,b); read(dvi_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(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_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_dvi_file(#)==begin
	if dvi_count=VAX_block_length then begin
		get(dvi_file,@=error:=continue@>); dvi_count:=0;
		end;
	#:=dvi_file^[dvi_count];
	incr(dvi_count);
	end

@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read_dvi_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_dvi_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_dvi_file(a); read_dvi_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_dvi_file(a); read_dvi_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_dvi_file(a); read_dvi_file(b); read_dvi_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_dvi_file(a); read_dvi_file(b); read_dvi_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_dvi_file(a); read_dvi_file(b); read_dvi_file(c); read_dvi_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
begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
@y
begin dvi_length:=dvi_blocks*VAX_block_length-1;
@z

@x
begin set_pos(dvi_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@>(dvi_file,blk+1); {VMS starts counting block numbers at 1, not 0}
dvi_count:=byt;
@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
    begin incr(buf_ptr); resolution:=k/get_integer;
@y
    begin incr(buf_ptr); resolution:=@=dble@>(k)/get_integer;
@z

@x
if eof(tfm_file) then
@y
if status(tfm_file)<>0 then
@z

@x
@d default_directory_name=='TeXfonts:' {change this to the correct name}
@d default_directory_name_length=9 {change this to the correct length}
@y
@d default_directory_name=='TEX$FONTS:' {change this to the correct name}
@d default_directory_name_length=10 {change this to the correct length}
@z

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

@x
while (m=223)and not eof(dvi_file) do m:=get_byte;
@y
while ((m=223) or (m=0)) and not eof(dvi_file) do m:=get_byte;
@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 \.{DVItype} 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 \.{DVItype} 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...@>==
@!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+'.DVI';
	open(dvi_file,file_name,@=readonly@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
	ask:=status(dvi_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('DVI file: ');
	if eof then goto 9999;
	read_ln(file_name);
	open(dvi_file,file_name,@=readonly@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
	ask:=status(dvi_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;

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

@<Procedures for ...@>=
function dvi_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 dvi_blocks:=int(fhc^.VAX_xab_ebk)
	else dvi_blocks:=0;

	dvi_open:=user_status;
	end;

@z