This change file is for the Vax/VMS version of Metafont.
It is based in part on the Vax/VMS change file for TeX written by David Fuchs.
Jane Colman, October 1984

July 1985 - Added support for online graphics output for various Tektronix
	    emulators.

@x
\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
@y
\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
\let\maybe=\iftrue
@z

@x
@d banner=='This is METAFONT, Version 1.0' {printed when \MF\ starts}
@y
@d banner=='This is METAFONT, Vax/VMS Version 1.0' {printed when \MF\ starts}
@z

@x
procedure initialize; {this procedure gets things started properly}
  var @<Local variables for initialization@>@/
  begin @<Set initial values of key variables@>@/
@y
@<Vax/VMS procedures@>@/
procedure initialize; {this procedure gets things started properly}
  var @<Local variables for initialization@>@/
  begin
  @<Set initial values of key variables@>@/
@z

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

@x
@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
  usage statistics}
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
  usage statistics}
@y
@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
  usage statistics}
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
  usage statistics}
@z

@x
@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
@f init==begin
@f tini==end
@y
Online graphics output will be useful only in the production version,
so we will use the codewords `$|graph|\ldots|hparg|$' to delimit code
used to produce it.

@d init==
@d tini==
@f init==begin
@f tini==end
@d graph==@{ {change this to `$\\{graph}\equiv\.{@@\{}$' when not using
	online graphics output}
@d hparg==@} {change this to `$\\{hparg}\equiv\.{@@\}}$' when not using
	online graphics output}
@f graph==begin
@f hparg==end
@z

@x
@<Compiler directives@>=
@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
@y
On Vax/VMS, there are no compiler directives that can be introduced in this
way, but we take this opportunity to include a few system dependent goodies.

@d VAX_text==@= text @>
@d VAX_new==@= new @>
@d VAX_none==@= none @>
@d VAX_word==@= word @>
@d VAX_error==@= error @>
@d VAX_length==@= length @>
@d VAX_record_length==@= record_length @>
@d VAX_syi_sid==@= syi$_sid @>
@d VAX_continue==@= continue @>
@d VAX_external==@= external @>
@d VAX_readonly==@= readonly @>
@d VAX_volatile==@= volatile @>
@d VAX_aligned==@= aligned @>
@d VAX_unsigned==@= unsigned @>
@d VAX_carriage_control==@= carriage_control @>
@d VAX_io_setmode==@= io$_setmode @>
@d VAX_iom_ctrlcast==@= io$m_ctrlcast @>
@d VAX_immed==@= %immed @>
@d VAX_stdescr==@= %stdescr @>
@d VAX_ref==@= %ref @>
@d VAX_assign==@= $assign @>
@d VAX_qiow==@= $qiow @>
@d VAX_numtim==@= $numtim @>
@d VAX_getsyi==@= $getsyi @>
@d VAX_lib_get_foreign==@= lib$get_foreign @>
@d VAX_disposition==@= disposition @>
@d VAX_delete==@= delete @>
@d VAX_save==@= save @>

@d VAX_trnlog==@= $trnlog @>
@d VAX_ss_normal==@= ss$_normal @>
@d VAX_user_action==@=user_action@>
@d VAX_create==@=$create@>
@d VAX_connect==@=$connect@>
@d VAX_open==@=$open@>
@d VAX_FAB_type==@= FAB$type @>
@d VAX_RAB_type==@= RAB$type @>
@d VAX_NAM_type==@= NAM$type @>
@d VAX_PAS_FAB==@= PAS$FAB @>
@d VAX_PAS_RAB==@= PAS$RAB @>
@d VAX_FAB_L_NAM== @=FAB$L_NAM@>
@d VAX_NAM_B_RSL== @=NAM$B_RSL@>
@d VAX_NAM_L_RSA== @=NAM$L_RSA@>

@d VAX_lognam==@= lognam @>
@d VAX_rslbuf==@= rslbuf @>

@<Compiler directives@>=
@\@=[inherit('sys$library:starlet')]@>@\
 {allows us to use system symbols and routines}
@z

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

@x
@<Constants...@>=
@!mem_max=30000; {greatest index in \MF's internal |mem| array;
  must be strictly less than |max_halfword|;
  must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
@!max_internal=100; {maximum number of internal quantities}
@!buf_size=500; {maximum number of characters simultaneously present in
  current lines of open files; must not exceed |max_halfword|}
@!error_line=72; {width of context lines on terminal error messages}
@!half_error_line=42; {width of first lines of contexts in terminal
  error messages; should be between 30 and |error_line-15|}
@!max_print_line=79; {width of longest text lines output; should be at least 60}
@!screen_width=768; {number of pixels in each row of screen display}
@!screen_depth=1024; {number of pixels in each column of screen display}
@!stack_size=30; {maximum number of simultaneous input sources}
@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
@!string_vacancies=8000; {the minimum number of characters that should be
  available for the user's identifier names and strings,
  after \MF's own error messages are stored}
@!pool_size=32000; {maximum number of characters in strings, including all
  error messages and help texts, and the names of all identifiers;
  must exceed |string_vacancies| by the total
  length of \MF's own strings, which is currently about 22000}
@!move_size=5000; {space for storing moves in a single octant}
@!max_wiggle=300; {number of autorounded points per cycle}
@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8}
@!file_name_size=40; {file names shouldn't be longer than this}
@!pool_name='MFbases:MF.POOL                         ';
  {string of length |file_name_size|; tells where the string pool appears}
@.MFbases@>
@!path_size=300; {maximum number of knots between breakpoints of a path}
@!bistack_size=785; {size of stack for bisection algorithms;
  should probably be left at this value}
@!header_size=100; {maximum number of \.{TFM} header words, times~4}
@!lig_table_size=300; {maximum number of ligature/kern steps}
@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
@y
@<Constants...@>=
@!mem_max=30000; {greatest index in \MF's internal |mem| array;
  must be strictly less than |max_halfword|;
  must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
@!max_internal=100; {maximum number of internal quantities}
@!buf_size=500; {maximum number of characters simultaneously present in
  current lines of open files; must not exceed |max_halfword|}
@!error_line=72; {width of context lines on terminal error messages}
@!half_error_line=42; {width of first lines of contexts in terminal
  error messages; should be between 30 and |error_line-15|}
@!max_print_line=79; {width of longest text lines output; should be at least 60}
@!screen_width=512; {number of pixels in each row of screen display}
@!screen_depth=336; {number of pixels in each column of screen display}
@!stack_size=30; {maximum number of simultaneous input sources}
@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
@!string_vacancies=8000; {the minimum number of characters that should be
  available for the user's identifier names and strings,
  after \MF's own error messages are stored}
@!pool_size=32000; {maximum number of characters in strings, including all
  error messages and help texts, and the names of all identifiers;
  must exceed |string_vacancies| by the total
  length of \MF's own strings, which is currently about 22000}
@!move_size=5000; {space for storing moves in a single octant}
@!max_wiggle=300; {number of autorounded points per cycle}
@!gf_buf_size=1024; {size of the output buffer, must be a multiple of 8}
@!VAX_block_length=512; {must be half |gf_buf_size| on Vax/VMS}
@!file_name_size=40; {file names shouldn't be longer than this}
@!pool_name='MF$bases:MF.POO                         ';
  {string of length |file_name_size|; tells where the string pool appears}
@.MFbases@>
@!path_size=300; {maximum number of knots between breakpoints of a path}
@!bistack_size=785; {size of stack for bisection algorithms;
  should probably be left at this value}
@!header_size=100; {maximum number of \.{TFM} header words, times~4}
@!lig_table_size=300; {maximum number of ligature/kern steps}
@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
@z

@x
@d mem_min=0 {smallest index in the |mem| array, must not be less
  than |min_halfword|}
@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF};
  must be substantially larger than |mem_min|
  and not greater than |mem_max|}
@d hash_size=2100 {maximum number of symbolic tokens,
  must be less than |max_halfword-3*param_size|}
@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
@d max_in_open=6 {maximum number of input files and error insertions that
  can be going on simultaneously}
@d param_size=150 {maximum number of simultaneous macro parameters}
@y
@d mem_min=0 {smallest index in the |mem| array, must not be less
  than |min_halfword|}
@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF};
  must be substantially larger than |mem_min|
  and not greater than |mem_max|}
@d hash_size=2100 {maximum number of symbolic tokens,
  must be less than |max_halfword-3*param_size|}
@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
@d max_in_open=6 {maximum number of input files and error insertions that
  can be going on simultaneously}
@d param_size=150 {maximum number of simultaneous macro parameters}
@z

@x
for i:=1 to @'37 do xchr[i]:=' ';
@y
for i:=1 to @'37 do xchr[i]:=' ';
xchr[@'11]:=chr(@'11);
xchr[@'14]:=chr(@'14);
@z

@x
@!alpha_file=packed file of text_char; {files that contain textual data}
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
@!alpha_file=VAX_text; {files that contain textual data}
@!byte_block=packed array [0..VAX_block_length-1] of eight_bits;
@!byte_file=packed file of byte_block; {files that contain binary data}
@z

@x
@d reset_OK(#)==erstat(#)=0
@d rewrite_OK(#)==erstat(#)=0

@p function a_open_in(var @!f:alpha_file):boolean;
@y
@p function user_reset
	(var FAB:VAX_FAB_type;
	 var RAB:VAX_RAB_type;
	 var F:unsafe_file):integer;
var status:integer; NAM:NAM_ptr; p:chrptr; i:integer;
begin
last_length:=0;
status:=VAX_open(FAB);
if odd(status) then status:=VAX_connect(RAB);
if odd(status) then begin
	NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
	if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
	for i:=1 to last_length do begin
		p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
		last_name[i]:=p^;
		end;
	end;
user_reset:=status;
end;
@#
function user_rewrite
	(var FAB:VAX_FAB_type;
	 var RAB:VAX_RAB_type;
	 var F:unsafe_file):integer;
var status:integer; NAM:NAM_ptr; p:chrptr; i:integer;
begin
status:=VAX_create(FAB);
if odd(status) then status:=VAX_connect(RAB);
if odd(status) then begin
	NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
	if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
	for i:=1 to last_length do begin
		p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
		last_name[i]:=p^;
		end;
	end;
user_rewrite:=status;
end;
@#
function a_open_in(var @!f:alpha_file):boolean;
@z

@x
begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
@y
begin
@= open@>(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
	VAX_error:=VAX_continue);
if status(f)>0 then a_open_in:=false
else begin
  reset(f,VAX_error:=VAX_continue);
  a_open_in:=status(f)<=0;
  end;
@z

@x
begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
@y
begin
@= open@>(f,name_of_file,VAX_new,16383,VAX_disposition:=VAX_delete,
	VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
if status(f)>0 then a_open_out:=false
else begin
 linelimit(f,maxint);
 rewrite(f,VAX_error:=VAX_continue);
 a_open_out:=status(f)<=0;
 end;
@z

@x
begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
@y
begin
@= open@>(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
	VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
if status(f)>0 then b_open_out:=false
else begin
 rewrite(f,VAX_error:=VAX_continue);
 b_open_out:=status(f)<=0;
 end;
@z

@x
begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
@y
begin
@= open@>(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
	VAX_error:=VAX_continue);
if status(f)>0 then w_open_in:=false
else begin
 reset(f,VAX_error:=VAX_continue);
 w_open_in:=status(f)<=0;
 end;
base_count:=0; {hack}
@z

@x
begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
@y
begin
@= open@>(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
	VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
if status(f)>0 then w_open_out:=false
else begin
 rewrite(f,VAX_error:=VAX_continue);
 w_open_out:=status(f)<=0;
 end;
base_count:=0; {hack}
@z

@x [3] file closing
begin close(f);
@y
begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
@z

@x
begin close(f);
@y
begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
@z

@x
begin close(f);
@y
begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
@z

@x [3] read into auxiliary buffer first
representing the beginning and ending of a line of text.

@<Glob...@>=
@y
representing the beginning and ending of a line of text.

On Vax/VMS, we will read the lines first into an auxiliary buffer, in
order to save the running time of procedure-call overhead.  We have
to be very careful to handle lines longer than the arbitrarily chosen
length of the |aux_buf|.

@<Glob...@>=
@!aux_buf:varying [133] of char; {where the characters go first}
@z

@x
@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
  {inputs the next line or returns |false|}
var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
begin if bypass_eoln then if not eof(f) then get(f);
  {input the first character of the line into |f^|}
last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
if eof(f) then input_ln:=false
else  begin last_nonblank:=first;
  while not eoln(f) do
    begin if last>=max_buf_stack then
      begin max_buf_stack:=last+1;
      if max_buf_stack=buf_size then
        overflow("buffer size",buf_size);
@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
      end;
    buffer[last]:=xord[f^]; get(f); incr(last);
    if buffer[last-1]<>" " then last_nonblank:=last;
    end;
  last:=last_nonblank; input_ln:=true;
  end;
end;
@y
@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
  {inputs the next line or returns |false|}
label found;
var @!len:integer; {length of line input}
@!k:0..buf_size; {index into |buffer|}
begin
last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
if status(f)<>0 then input_ln:=false
else  begin
  while not eoln(f) do
    begin read(f,aux_buf,VAX_error:=VAX_continue);
    len:=VAX_length(aux_buf);
    if last+len>=max_buf_stack then
      begin
      if last+len<buf_size then max_buf_stack:=last+len
      else overflow("buffer size",buf_size);
      end;
    for k:=last to last+len-1 do buffer[k]:=xord[aux_buf[k-last+1]];
    last:=last+len;
    end;
  found: if last>first then if buffer[last-1]=" " then begin
	decr(last); goto found; end;
  input_ln:=true;
  read_ln(f,VAX_error:=VAX_continue);
  end;
end;
@z

@x [3] terminal file opening
@ Here is how to open the terminal files
in \ph. The `\.{/I}' switch suppresses the first |get|.
@^system dependencies@>

@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
@y
@ Here is how to open the terminal files
under Vax/VMS.
@^system dependencies@>

@d t_open_in==begin
 @= open@>(term_in,'SYS$INPUT');
 reset(term_in);
 in_FAB:=VAX_PAS_FAB(term_in);
 in_RAB:=VAX_PAS_RAB(term_in);
 end {open the terminal for text input}
@d t_open_out==begin
 @= open@>(term_out,'SYS$OUTPUT',VAX_carriage_control:=VAX_none,
	  VAX_record_length:=511);
 linelimit(term_out,maxint);
 rewrite(term_out);
 out_FAB:=VAX_PAS_FAB(term_out);
 out_RAB:=VAX_PAS_RAB(term_out);
 end {open the terminal for text output}
@z

@x [3] terminal hacks: clear and update
these operations can be specified in \ph:
@^system dependencies@>

@d update_terminal == break(term_out) {empty the terminal output buffer}
@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
@y
these operations can be specified in Vax/VMS Pascal:
@^system dependencies@>

@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
@d clear_terminal == in_RAB^.@=RAB$V_PTA@>:=true
  {clear the terminal input buffer}
@.PTA@>
@d wake_up_terminal == begin
  out_RAB^.@=RAB$V_CCO@>:=true;
  write_ln(term_out);
  out_RAB^.@=RAB$V_CCO@>:=false;
  end {cancel the user's cancellation of output}
@.CCO@>
@d crlf == chr(13),chr(10)
@z

@x
@ The following program does the required initialization
without retrieving a possible command line.
It should be clear how to modify this routine to deal with command lines,
if the system permits them.
@^system dependencies@>

@p function init_terminal:boolean; {gets the terminal input started}
label exit;
begin t_open_in;
loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
@.**@>
  if not input_ln(term_in,true) then {this shouldn't happen}
    begin write_ln(term_out);
    write(term_out,'! End of file on the terminal... why?');
@.End of file on the terminal@>
    init_terminal:=false; return;
    end;
  loc:=first;
  while (loc<last)and(buffer[loc]=" ") do incr(loc);
  if loc<last then
    begin init_terminal:=true;
    return; {return unless the line was all blank}
    end;
  write_ln(term_out,'Please type the name of your input file.');
  end;
exit:end;
@y
@ The following program does the required initialization
by retrieving a possible command line, and if none exists,
prompting the user for the first line of input.
@^system dependencies@>

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

function init_terminal:boolean; {gets the terminal input started}
label exit;
var cmd_line: packed array[1..300] of char;
@!len: sixteen_bits;
@!i: integer;
begin t_open_in;
i:=0;
VAX_lib_get_foreign(cmd_line,,len,i);
i:=1; while (i<=len) and (cmd_line[i]=' ') do incr(i);
if i<=len then begin
	loc:=first;
	last:=first;
	while i<=len do begin
		buffer[last]:=xord[cmd_line[i]];
		if (buffer[last]>="A") and (buffer[last]<="Z")
		then buffer[last]:=buffer[last]+"a"-"A";
		incr(last); incr(i);
		end;
	init_terminal:=true; return;
	end;
loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
@.**@>
  if not input_ln(term_in,true) then {this shouldn't happen}
    begin write(term_out,crlf);
    write_ln(term_out,'! End of file on the terminal... why?',crlf);
@.End of file on the terminal@>
    init_terminal:=false; return;
    end;
  loc:=first;
  while (loc<last)and(buffer[loc]=" ") do incr(loc);
  if loc<last then
    begin init_terminal:=true;
    return; {return unless the line was all blank}
    end;
  write_ln(term_out,'Please type the name of your input file.',crlf);
  end;
exit:end;
@z

@x [5] real crlf for terminal
@d wterm(#)==write(term_out,#)
@d wterm_ln(#)==write_ln(term_out,#)
@d wterm_cr==write_ln(term_out)
@y
@d wterm(#)==write_ln(term_out,#)
@d wterm_ln(#)==write_ln(term_out,#,crlf)
@d wterm_cr==write_ln(term_out,crlf)
@z

@x
@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
  end

@<Global...@>=
@!interrupt:integer; {should \MF\ pause for instructions?}
@y
@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
  end
@d enable_control_C==
VAX_qiow(,tt_chan,VAX_io_setmode+VAX_iom_ctrlcast,,,,
  VAX_immed ctrlc_rout,,VAX_immed 3,,,);

@<Global...@>=
@!interrupt:[VAX_volatile]integer; {should \MF\ pause for instructions?}
@z

@x
interrupt:=0; OK_to_interrupt:=true;
@y
interrupt:=0; OK_to_interrupt:=true;
if VAX_assign('TT',tt_chan,,)=1 then enable_control_C;
@z

@x
@d ho(#)==#-min_halfword
  {to take a sixteen-bit item from a halfword}
@d qo(#)==#-min_quarterword {to read eight bits from a quarterword}
@d qi(#)==#+min_quarterword {to store eight bits in a quarterword}
@y
@d ho(#)==#
@d qo(#)==#
@d qi(#)==#
@z

@x [8] block up word files
@!word_file = file of memory_word;
@y
@!word_block = packed array [0..VAX_block_length-1] of memory_word;
@!word_file = packed file of word_block;
@z

@x
Since standard \PASCAL\ cannot provide such information, something special
is needed. The program here simply specifies July 4, 1776, at noon; but
users probably want a better approximation to the truth.
@y
@z

@x
@p procedure fix_date_and_time;
begin internal[time]:=12*60*unity; {minutes since midnight}
internal[day]:=4*unity; {fourth day of the month}
internal[month]:=7*unity; {seventh month of the year}
internal[year]:=1776*unity; {Anno Domini}
@y
@p procedure fix_date_and_time;
var t:array[1..7] of signed_halfword; {raw year, month, day and time}
begin VAX_numtim(t);
internal[year]:=t[1]*unity;
internal[month]:=t[2]*unity;
internal[day]:=t[3]*unity;
internal[time]:=(t[4]*60+t[5])*unity; {minutes since midnight}
@z

@x  Treat tab and formfeed as blanks
char_class[127]:=invalid_class;
@y
char_class[127]:=invalid_class;
char_class[9]:=space_class;
char_class[12]:=space_class;
@z

@x VAX/VMS PASCAL COMPILER BUG!
begin if odd(octant_before)=odd(octant_after) then cur_x:=x
  else cur_x:=-x;
if (octant_before>negate_y)=(octant_after>negate_y) then cur_y:=y
@y
begin if (odd(octant_before) and odd(octant_after))
  or (not odd(octant_before) and not odd(octant_after))
  then cur_x:=x
  else cur_x:=-x;
if ((octant_before>negate_y)and(octant_after>negate_y))
  or ((octant_before<=negate_y)and(octant_after<=negate_y))
  then cur_y:=y
@z

@x VAX/VMS PASCAL COMPILER BUG!
if odd(right_type(p))<>odd(right_type(q)) then
@y
if (odd(right_type(p)) and not odd(right_type(q)))
  or (not odd(right_type(p)) and odd(right_type(q))) then
@z

@x
The \PASCAL\ code here is a minimum version of |init_screen| and
|update_screen|, usable on \MF\ installations that don't
support screen output. If |init_screen| is changed to return |true|
instead of |false|, the other routines will simply log the fact
that they have been called; they won't really display anything.
The standard test routines for \MF\ use this log information to check
that \MF\ is working properly, but the |wlog| instructions should be
removed from production versions of \MF.

@p function init_screen:boolean;
begin init_screen:=false;
end;
@#
procedure update_screen; {will be called only if |init_screen| returns |true|}
begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only}
end;

@ The user's screen is assumed to be a rectangular area, |screen_width|
@y
The user's screen is assumed to be a rectangular area, |screen_width|
@z

@x    Code definitions for Tektronix and GraphOn
@d white=0 {background pixels}
@d black=1 {visible pixels}

@<Types...@>=
@!screen_row=0..screen_depth; {a row number on the screen}
@!screen_col=0..screen_width; {a column number on the screen}
@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below}
@!pixel_color=white..black; {specifies one of the two pixel values}

@ We'll illustrate the |blank_rectangle| and |paint_row| operations by
pretending to declare a screen buffer called |screen_pixel|. This code
is actually commented out, but it does specify the intended effects.

@<Glob...@>=
@{@!screen_pixel:array[screen_row,screen_col] of pixel_color;@+@}
@y
The remaining definitions are for the graph mode codes to specify
coordinates on a Tektronix emulator.  The codes for x and y coordinates,
clearing the screen,
and writing |white| are standard Tektronix codes.  The |white_code|
is also used for entering graphics mode.  The codes used to blank a
rectangle are specific for the particular terminals supported; other Tektronix
emulators should have analogous ways of blanking out a rectangle.

@d GraphOn=1 {screen type is GraphOn 140}
@d Tektronix=2 {screen type is Tektronix 4105}
@d GraphicsPlus=3 {screen type is Northwest Digital Graphics Plus}
@d white=0 {background pixels}
@d black=1 {visible pixels}
@d white_code==chr(29) {Enter Tektronix Graph mode; next vector is white}
@d GP_area_erase==chr(30) {Next vector specifies area erase on GraphicsPlus}
@d GO_esc==chr(27) {Must precede the next 5 codes}
@d erase_screen==chr(12) {erase entire screen}
@d GO_data_on==chr(1) {Set data color to black on GraphOn}
@d GO_data_off==chr(16) {Set data color to white on GraphOn}
@d GO_block_enable==chr(2) {Next vector specifies rectangular block}
@d GO_block_disable==chr(3) {Next vector is a line}
@d GO_window_height=55 {Left for characters at bottom of screen;
	should be 782-|screen_depth|}
@d GO_screen_depth=391 {Number of pixels in column on GraphOn screen}
@d wTek(#)==begin incr(Tek_bufptr); Tek_buffer[Tek_bufptr]:=#; end
@d clear_Tek==begin Tek_hy := chr(0); Tek_hx := chr(0);
      Tek_buffer.LENGTH := 512; Tek_bufptr := 0;
      wTek(white_code); wTek(GO_esc); wTek(erase_screen); end

@<Types...@>=
@!screen_row=0..GO_screen_depth; {a row number on the screen}
@!screen_col=0..screen_width; {a column number on the screen}
@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below}
@!pixel_color=white..black; {specifies one of the two pixel values}

@ The |init_screen| function is used to determine if the terminal being
used will support screen output.  In VMS, this is determined by checking
the value of the logical name \.{MF\$TERM}, which should be set to |go140|
if the terminal is a GraphOn. |init_screen| also clears the terminal's
graph mode screen.

The |update_screen| procedure dumps the graphics output buffer if there's
anything in it.  We also use it to clear a space for
non-graphics characters at the
base of the screen, since a Tektronix terminal in alpha mode will just
write wherever the cursor is positioned and over whatever is there without
erasing it, making characters unreadable very quickly.

@<Glob...@>=
@!screen_type: integer;
@!VAX_termtype: packed array[1..63] of char;
@!Tek_buffer: varying[512] of char;
@!Tek_bufptr: integer; { Counts number of char output since last cr }
@!Tek_hy: char;	{ Graphic memory of Tektronix (for output compression) }
@!Tek_ly: char;
@!Tek_hx: char;
@!Tek_lx: char;

@ @p @!graph procedure wTek_coor( x : screen_col; y : screen_row );
  { output tektronix coordinates compressing bytes that don't change }
  var new_hy, new_ly, new_hx, new_lx : char;
  begin
  x := x*2; y := y*2;
  new_hy := chr(y div 32 + 32); new_ly := chr(y mod 32 + 96);
  new_hx := chr(x div 32 + 32); new_lx := chr(x mod 32 + 64);
  if (Tek_hy <> new_hy) then
    begin
    Tek_hy := new_hy;
    wTek( Tek_hy );
    end;
  if (Tek_ly <> new_ly) or (Tek_hx <> new_hx) then
    begin
    Tek_ly := new_ly;
    wTek( Tek_ly );
    if (Tek_hx <> new_hx) then
      begin
      Tek_hx := new_hx;
      wTek( Tek_hx );
      end;
    end;
  Tek_lx := new_lx;
  wTek( Tek_lx );
  end;@+hparg
@#
function init_screen:boolean;
begin
  @!graph
  VAX_trnlog( VAX_lognam:='MF$TERM',VAX_rslbuf:=VAX_termtype);
  if (VAX_termtype[1]='g') and (VAX_termtype[2]='o') and (VAX_termtype[3]='1')
    and (VAX_termtype[4]='4') and (VAX_termtype[5]='0')
    then begin {clear the graphics screen}
      screen_type:=GraphOn;
      clear_Tek;
      init_screen:=true;
  end else if (VAX_termtype[1]='t') and (VAX_termtype[2]='e')
    and (VAX_termtype[3]='k')
    then begin {clear the graphics screen}
      screen_type:=Tektronix;
      clear_Tek;
      wTek(GO_esc); wTek('M'); wTek('P'); wTek('0'); {select blank fill color}
      init_screen:=true;
  end else if (VAX_termtype[1]='g') and (VAX_termtype[2]='p')
    then begin {clear the graphics screen}
      screen_type:=GraphicsPlus;
      clear_Tek;
      init_screen:=true;
  end else @+hparg init_screen:=false;
@!init init_screen:=true;@+tini
end;
@#
procedure update_screen; {will be called only if |init_screen| returns |true|}
begin
  @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only}
  @!graph
  case screen_type of
  GraphOn: begin
    wTek(white_code); wTek(GO_esc); wTek(GO_data_off);
    wTek(GO_esc); wTek(GO_block_enable);
    wTek_coor(screen_width-1,0);
    wTek_coor(0,GO_window_height);
    wTek(GO_esc); wTek(GO_block_disable); wTek(GO_esc); wTek(GO_data_on);
  end;
  Tektronix: begin
    wTek(GO_esc); wTek('M'); wTek('L'); {set line color blank}
    wTek(GO_esc); wTek('L'); wTek('P'); {begin panel}
    wTek_coor(0,GO_window_height);
    wTek(white_code);
    wTek_coor(screen_width-1,GO_window_height);
    wTek_coor(screen_width-1,0);
    wTek_coor(0,0);
    wTek(GO_esc); wTek('L'); wTek('E'); {end panel}
    wTek(GO_esc); wTek('M'); wTek('L'); wTek('1'); {set line color}
    Tek_hy:=chr(0); Tek_hx:=chr(0); {no compression next set of coordinates}
  end;
  GraphicsPlus: begin
    wTek(white_code); wTek_coor(screen_width-1,0);
    wTek(GP_area_erase); wTek_coor(0,GO_window_height);
  end;
  othercases do_nothing
  endcases;
  if Tek_bufptr > 0 then
    begin
    Tek_buffer.LENGTH := Tek_bufptr;
    wterm_ln(Tek_buffer);
    Tek_bufptr := 0;
    Tek_buffer.LENGTH := 512;
    end;
  @+hparg
end;
@z

@x
The commented-out code in the following procedure is for illustrative
purposes only.
@y
@z

@x    Blank_rectangle for the GraphOn Tektronix emulator
begin @{@+for r:=top_row to bot_row-1 do
  for c:=left_col to right_col-1 do
    screen_pixel[r,c]:=white;@+@}@/
@y
begin
  @!graph
  if Tek_bufptr > 450 then
    begin
    Tek_buffer.LENGTH := Tek_bufptr;
    wterm_ln(Tek_buffer);
    Tek_bufptr := 0;
    Tek_buffer.LENGTH := 512;
    end;
  case screen_type of
  GraphOn: begin
    wTek(white_code);
    wTek(GO_esc); wTek(GO_data_off); wTek(GO_esc); wTek(GO_block_enable);
    wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
    wTek_coor(left_col, GO_screen_depth-top_row);
    wTek(GO_esc); wTek(GO_block_disable); wTek(GO_esc); wTek(GO_data_on);@/
  end;
  Tektronix: begin
    wTek(GO_esc); wTek('M'); wTek('L'); {set line color blank}
    wTek(GO_esc); wTek('L'); wTek('P'); {begin panel}
    wTek_coor(left_col, GO_screen_depth-top_row);
    wTek(white_code);
    wTek_coor(right_col-1, GO_screen_depth-top_row);
    wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
    wTek_coor(left_col, GO_screen_depth-bot_row+1);
    wTek(GO_esc); wTek('L'); wTek('E'); {end panel}
    wTek(GO_esc); wTek('M'); wTek('L'); wTek('1'); {set line color}
    Tek_hy:=chr(0); Tek_hx:=chr(0); {no compression next set of coordinates}
  end;
  GraphicsPlus: begin
    wTek(white_code); wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
    wTek(GP_area_erase); wTek_coor(left_col, GO_screen_depth-top_row);
  end;
  othercases do_nothing
  endcases;
  @+hparg
@z

@x
program (see the commented-out code below).
@y
program.
@z

@x    Paint-row for the Tektronix
begin @{ k:=0; c:=a[0];
repeat incr(k);
  repeat screen_pixel[r,c]:=b; incr(c);
  until c=a[k];
  b:=black-b; {$|black|\swap|white|$}
  until k=n;@+@}@/
@y
begin  @!graph k:=0; c:=a[0];
r:=GO_screen_depth-r; {because Tektronix has 0 at bottom of screen}
{ move to starting point }
wTek(white_code);
wTek_coor(c,r);
repeat incr(k);
  if b<>black then wTek(white_code);
  wTek_coor(a[k]-1, r);
  b:=black-b; {$|black|\swap|white|$}
  if Tek_bufptr > 450 then
    begin
    Tek_buffer.LENGTH := Tek_bufptr;
    wterm(Tek_buffer);
    Tek_bufptr := 0;
    Tek_buffer.LENGTH := 512;
    end;
  until k=n;@+hparg@/
@z

@x
following structure:  If the name contains `\.>' or `\.:', the file area
@y
following structure:  If the name contains `\.]' or `\.:', the file area
@z

@x
@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
@y
@!area_delimiter:pool_pointer; {the most recent `\.]' or `\.:', if any}
@z

@x
@d MF_area=="MFinputs:"
@.MFinputs@>
@y
@d MF_area=="MF$inputs:"
@.MFinputs@>
@.MF{\$}inputs@>
@z

@x
else  begin if (c=">")or(c=":") then
@y
else  begin if (c="]") or (c=":") then
@z

@x
@d base_area_length=8 {length of its area part}
@d base_ext_length=5 {length of its `\.{.base}' part}
@y
@d base_area_length=9 {length of its area part}
@d base_ext_length=4 {length of its `\.{.bas}' part}
@z

@x
MF_base_default:='MFbases:plain.base';
@.MFbases@>
@y
MF_base_default:='MF$bases:plain.bas';
@.MF{\$}bases@>
@z

@x [28] get file name from system
begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then
  make_name_string:="?"
else  begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
  make_name_string:=make_string;
  end;
@y
begin if (pool_ptr+last_length>pool_size)or(str_ptr=max_strings) then
  make_name_string:="?"
else  begin for k:=1 to last_length do append_char(xord[last_name[k]]);
  make_name_string:=make_string;
  end;
@z

@x
@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".gf"|, or
  |".base"|}
@y
@p procedure pack_job_name(@!s:str_number); {|s = ".lis"|, |".gf"|, or
  |".bas"|}
@z

@x
pack_job_name(".log");
@y
pack_job_name(".lis");
@z

@x
prompt_file_name("transcript file name",".log");
@y
prompt_file_name("transcript file name",".lis");
@z

@x
@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
@y
@d tfm_out(#)==begin tfm_file^[tfm_count]:=#; {output one byte to |tfm_file|}
    incr(tfm_count);
    if tfm_count=VAX_block_length then begin
        put(tfm_file,VAX_error:=VAX_continue); tfm_count:=0; end
    end
@z

@x
while not b_open_out(tfm_file) do
  prompt_file_name("file name for font metrics",".tfm");
@y
while not b_open_out(tfm_file) do
  prompt_file_name("file name for font metrics",".tfm");
tfm_count:=0;
@z

@x
b_close(tfm_file)
@y
while tfm_count>0 do tfm_out(0); {flush out the buffer}
b_close(tfm_file)
@z

@x
@ Some systems may find it more efficient to make |gf_buf| a |packed|
array, since output of four bytes at once may be facilitated.
@^system dependencies@>

@<Glob...@>=
@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output}
@y
@ Some systems may find it more efficient to make |gf_buf| a |packed|
array, since output of four bytes at once may be facilitated.
On Vax/VMS, we get even more complicated than that, for efficiency.

@d gf_buf==g_buffer.b  {buffer for \.{GF} output}

@<Glob...@>=
@!g_buffer: [VAX_volatile,VAX_aligned(9)] packed record
    case boolean of
        false: (b:packed array[gf_index] of eight_bits);
        true:  (l:byte_block; r:byte_block; j:eight_bits);
    end;
@z

@x
@ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling
|write_gf(a,b)|. It is safe to assume that |a| and |b+1| will both be
multiples of 4 when |write_gf(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@>

@<Declare generic font output procedures@>=
procedure write_gf(@!a,@!b:gf_index);
var k:gf_index;
begin for k:=a to b do write(gf_file,gf_buf[k]);
end;
@y
@ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling
|write| on the other variant of the |gf_buf| record.  Thus, we have to be
sure that things line up properly.
@^system dependencies@>

@<Check the ``co...@>=
if gf_buf_size<>2*VAX_block_length then bad:=223;
@z

@x
  begin write_gf(0,half_buf-1); gf_limit:=half_buf;
@y
  begin write(gf_file,g_buffer.l); gf_limit:=half_buf;
@z

@x
else  begin write_gf(half_buf,gf_buf_size-1); gf_limit:=gf_buf_size;
@y
else  begin write(gf_file,g_buffer.r); gf_limit:=gf_buf_size;
@z

@x
if gf_limit=half_buf then write_gf(half_buf,gf_buf_size-1);
if gf_ptr>0 then write_gf(0,gf_ptr-1)
@y
if gf_limit=half_buf then write(gf_file,g_buffer.r);
for k:=gf_ptr to gf_buf_size do gf_buf[k]:=223;
if gf_ptr>0 then write(gf_file,g_buffer.l);
if gf_ptr>half_buf then write(gf_file,g_buffer.r);
@z

@x  Fix for VMS V3.x only; should work as is in V4.x
if internal[hppp]<=0 then gf_ext:=".gf"
else  begin old_setting:=selector; selector:=new_string; print_char(".");
  print_int(make_scaled(internal[hppp],59429463));
    {$2^{32}/72.27\approx59429463.07$}
  print("gf"); gf_ext:=make_string; selector:=old_setting;
  end
@y
gf_ext:=".gf"
@z

@x
@d dump_wd(#)==begin base_file^:=#; put(base_file);@+end
@d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end
@d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end
@d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end
@y
@d base_put==begin incr(base_count);
    if base_count=VAX_block_length then begin
        put(base_file,VAX_error:=VAX_continue); base_count:=0; end
    end
@d base_word==base_file^[base_count]

@d dump_wd(#)==begin base_word:=#; base_put;@+end
@d dump_int(#)==begin base_word.int:=#; base_put;@+end
@d dump_hh(#)==begin base_word.hh:=#; base_put;@+end
@d dump_qqqq(#)==begin base_word.qqqq:=#; base_put;@+end
@z

@x
@d undump_wd(#)==begin get(base_file); #:=base_file^;@+end
@d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end
@d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end
@d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end
@y
@d base_get==begin incr(base_count);
    if base_count=VAX_block_length then begin
        get(base_file,VAX_error:=VAX_continue); base_count:=0; end
    end
@d undump_wd(#)==begin base_get; #:=base_word;@+end
@d undump_int(#)==begin base_get; #:=base_word.int;@+end
@d undump_hh(#)==begin base_get; #:=base_word.hh;@+end
@d undump_qqqq(#)==begin base_get; #:=base_word.qqqq;@+end
@z

@x
x:=base_file^.int;
@y
x:=base_word.int;
@z

@x
pack_job_name(".base");
while not w_open_out(base_file) do prompt_file_name("base file name",".base");
@y
pack_job_name(".bas");
while not w_open_out(base_file) do prompt_file_name("base file name",".bas");
@z

@x
w_close(base_file)
@y
while base_count>0 do dump_int(0); {flush out the buffer}
w_close(base_file)
@z

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

@ Here are the things we need for |byte_file| and |word_file| files:

@<Glob...@>=
@!gf_count: 0..VAX_block_length;
@!tfm_count:0..VAX_block_length;
@!base_count:0..VAX_block_length;

@ Here's the interrupt stuff.

@<Types...@>=
@!signed_halfword=[VAX_word] -32768..32767;
@!sixteen_bits=[VAX_word] 0..65535;

@ @<Glob...@>=
@!itm: array [1..4] of VAX_unsigned;
@!res:[VAX_volatile] integer;
@!tt_chan: [VAX_volatile] signed_halfword;

@ @<Vax/VMS procedures@>=
[asynchronous] procedure @!ctrlc_rout;
begin
interrupt:=1;
enable_control_C;
end;

@ Here is the stuff for magic file operations.
@<Types...@>=
unsafe_file = [unsafe] file of char;
FAB_ptr = ^VAX_FAB_type;
RAB_ptr = ^VAX_RAB_type;
NAM_ptr = ^VAX_NAM_type;
chrptr = ^char;

@ @<Vax/VMS procedures@>=
function VAX_PAS_FAB(var foobar:unsafe_file):FAB_ptr; extern;
function VAX_PAS_RAB(var foobar:unsafe_file):RAB_ptr; extern;

@ @<Glob...@>=
in_FAB,out_FAB,fyl_FAB: FAB_ptr;
in_RAB,out_RAB,fyl_RAB: RAB_ptr;
last_length: integer;
last_name:packed array [1..file_name_size] of char;
@z