% vms.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
% Originally, this was nearly empty, but I have now put into this file a lot
% of the most VMS-specific code that was in the WEB file.
%
%

% WEAVE: New title
@x  Module 0; Lines 42 -- 42
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\def\title{Crudetype for {\mc VMS}}
@z

% 11
@x  Module 11; Lines 305 -- 307
@d real_number == real
@d make_real( #) == #
    {convert an integer to a |real_number|. Usually automatic}
@y
@d real_number == double
@d make_real( #) == dble( #)
    {convert an integer to double-length real}
@z

% 14
%
@x  Module 14; Lines 360 -- 361
@<Lowest...@>=
  {Declare |parse_file|}
@y
@<Lowest...@>=
  procedure  parse_file( name: var_string; var dir, nam, ex: var_string) ;
  var p,q,r,s: s_ptr ;
  begin
    dir := blank; nam := blank; ex := blank;
    s := name.len ;
    if ( s>0) then begin
      p := s_search( name, ']', -s);
      q := s_search( name, ':', -s);
      if ( q>p) then p := q ;
      if ( p>0) then substring( dir, name, 1, p) ;
      r := s_search( name, '.', -s);
      if ( r>p) then substring( ex, name, r, s-r+1)
      else r := s +1 ;
      substring( nam, name, p+1, r-p-1) ;
    end;
  end;
@z

@x  Module 16; Lines 387 -- 388
@ The next few sections contain the lowest level code for file handling. These
macros describe how we use the terminal.
@y
@ The next few sections contain the lowest level code for file handling. These
macros describe how we use the terminal. Here we have to do some messy stuff
to circumvent a bad feature of VMS \PASCAL. VMS opens the terminal channels
automatically, but by default, with a (short) maximum record length. The
effect is that the program crashes on long files.
@z

@x  Module 16; Lines 405 -- 406
@d display(#)==write(term_out, #)
@d display_ln(#)==write_ln(term_out, # )
@y
@d display(#)==write_ln(term_out, #)
@d display_ln(#)==write_ln(term_out, #, chr( 13), chr( 10) )
    {effectively makes record length infinite}
@#
@d no_crash == @=error := continue@>
@d close_binary(#)== close(# , no_crash )
@d r_len == @=record_length@>
@d c_con == @=carriage_control@>
  {VMS file-handling eccentricities}
@z

@x  Module 16; Lines 416 -- 416
@<Open terminal channels@>= do_nothing
@y
@<Open terminal channels@>=
  open( output, 'SYS$OUTPUT', c_con := none);
@z

@x  Module 19; Lines 442 -- 443
@<Lowest...@>=
  {Declare |open_binary|}
@y

If the VMS |open| procedure cannot open the file, |no_crash| suppresses the
system error message, and |status| gets some nonzero value.

@<Lowest...@>=
  function open_binary
  (var f_f: byte_file; name: var_string ): boolean;
  var s: integer; f_n: filename ;
  begin
    close_binary(f_f );
      {in case the file was left open}
    name_of( f_n,  name) ;
    open(f_f, f_n, readonly, ,, fixed, no_crash );
    s := status(f_f) ;
    if ( s <> 0) then open_binary := false
    else begin
      reset(f_f , no_crash );
      s := status(f_f) ;
      open_binary := (s = 0 );
    end;
  end;
@z

@x  Module 20; Lines 445 -- 446
@ @<Open |printfile|@>=
  rewrite(printfile) ;
@y
@ VMS \PASCAL\ allows 3 types of carriage control, called |list|, |fortran|,
or |none|. No doubt other systems will have other peculiar types of carriage
control. In VMS, |none| is to be used if at all possible, but some printers
insist on a line feed after every carriage return. Roughly speaking, |@!list|
directs the operating system to put a CR--LF at the end of each record when
the file is printed. |@!fortran| means that a Fortran-type carriage control
character must be put at the start of each record, and we assume that this
must be inserted explicitly. One type of run-time error that causes a lot of
trouble occurs if you try to write too many characters onto one record of the
|printfile|. I have tried to defeat this by declaring a very long record
length.

@<Open |printfile|@>=
  if inspection then
  open (printfile, 'SYS$OUTPUT', c_con := list, r_len := 30000 )
  else if fortran then
  open (printfile, print_name.data, c_con := fortran, r_len := 30000 )
  else if list then
  open(printfile, print_name.data, c_con := list, r_len := 30000 )
  else
  open(printfile, print_name.data, c_con := none, r_len := 30000 ) ;
  rewrite(printfile) ;

@z

@x  Module 21; Lines 455 -- 458
@d read_command_line( #) == do_nothing

@<Lowest...@>=
  {Declare |read_command_line| }
@y
@d read_command_line( #) == @= lib$get_foreign @> ( #)

@<Lowest...@>=
  procedure read_command_line( @= %descr @> ss: fix_string); extern ;
@z