TANGLE change file for Vax/VMS
Copyright (C) 1983 by David Fuchs.  All rights are reserved.
21Oct85 JLC  .Increased max_toks to tangle inimf 0.9999.

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

@x
@d banner=='This is TANGLE, Version 2.8'
@y
@d banner=='This is TANGLE, Vax/VMS Version 2.8'
@z

@x
and the string pool output goes to file |pool|.
@y
and the string pool output goes to file |pool|.
VMS requires us to mention |input| and |output| in the program header, too.
They are used for terminal input and output.
@z

@x
program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
@y
program TANGLE(@!input,@!output,@!web_file,@!change_file,@!Pascal_file,
	@!pool);
@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, things are a bit different.

@<Compiler directives@>=
@=[check(none)]@> {no debug overhead, but...}
debug @=[check(all)]@> gubed {turn everything on when debugging}
@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
@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
  must be less than 65536}
@y
@!max_toks=51000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
  must be less than 65536}
@z

@x
@!text_file=packed file of text_char;
@y
@!text_file=text;
@z

@x
@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
@d new_line==write_ln(term_out) {start new line}
@y
@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
	{`|print|' and then start new line}
@d new_line==write_ln(term_out,chr(13),chr(10)) {start new line}
@z

@x
rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
@y
open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
rewrite(term_out);
@z

@x
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
@z

@x
@ The following code opens |Pascal_file| and |pool|.
Since these files were listed in the program header, we assume that the
\PASCAL\ runtime system has checked that suitable external file names have
been given.
@^system dependencies@>

@<Set init...@>=
rewrite(Pascal_file); rewrite(pool);
@y
@ The following code opens |Pascal_file| and |pool|.
Acutally, on Vax/VMS this task is put off until later.
@^system dependencies@>
@z

@x
@ Input goes into an array called |buffer|.

@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
@y
@ Input goes into an array called |buffer|.
Actually, it is first read into |temp_buffer|.
@<Glob...@>=
@!buffer: array[0..buf_size] of ASCII_code;
@!temp_buffer: varying [buf_size] of char;
@z

@x
@p function input_ln(var f:text_file):boolean;
  {inputs a line or returns |false|}
var final_limit:0..buf_size; {|limit| without trailing blanks}
begin limit:=0; final_limit:=0;
if eof(f) then input_ln:=false
else  begin while not eoln(f) do
    begin buffer[limit]:=xord[f^]; get(f);
    incr(limit);
    if buffer[limit-1]<>" " then final_limit:=limit;
    if limit=buf_size then
      begin while not eoln(f) do get(f);
      decr(limit); {keep |buffer[buf_size]| empty}
      print_nl('! Input line too long'); loc:=0; error;
@.Input line too long@>
      end;
    end;
  read_ln(f); limit:=final_limit; input_ln:=true;
  end;
end;
@y
On Vax/VMS we first read a line into |temp_buffer|, since that's faster.

@p function input_ln(var f:text_file):boolean;
  {inputs a line or returns |false|}
var i,@!l:0..buf_size;
begin limit:=0;
if eof(f) then input_ln:=false
else  begin
	read(f,temp_buffer);
	l:=temp_buffer.@=length@>;
	for i:=1 to l do begin
		buffer[i-1]:=xord[temp_buffer[i]];
		if buffer[i-1]<>" " then limit:=i;
		end;
	if not eoln(f) then begin
		print_nl('! Input line too long'); error;
@.Input line too long@>
		end
	else read_ln(f);
	input_ln:=true;
	end;
end;
@z

@x
@d ww=2 {we multiply the byte capacity by approximately this amount}
@y
@d ww=3 {we multiply the byte capacity by approximately this amount}
@z

@x
for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
write_ln(Pascal_file); incr(line);
@y
for k:=1 to break_ptr do out_temp_buffer[k]:=xchr[out_buf[k-1]];
write_ln(Pascal_file,substr(out_temp_buffer,1,break_ptr)); incr(line);
@z

@x
@!term_in:text_file; {the user's terminal as an input file}
@y
@z

@x
@<Set init...@>=
@y
@d term_in==input

@<Set init...@>=
@z

@x
reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
@y
@z

@x save pool and Pascal files only if they were written to.
if string_ptr>128 then @<Finish off the string pool file@>;
stat @<Print statistics about memory usage@>;@+tats@;@/
@t\4\4@>{here files should be closed if the operating system requires it}
@y
if history<fatal_message then begin
	if string_ptr>128 then begin @<Finish off the string pool file@>;
		close(pool,@=disposition:=save@>,@=error:=continue@>);
		end;
	close(Pascal_file,@=disposition:=save@>,@=error:=continue@>);
	end;
stat @<Print statistics about memory usage@>;@+tats@;@/
@z

@x
This module should be replaced, if necessary, by changes to the program
that are necessary to make \.{TANGLE} work at a particular installation.
It is usually best to design your change file so that all changes to
previous modules preserve the module numbering; then everybody's version
will be consistent with the printed program. More extensive changes,
which introduce new modules, can be inserted here; then only the index
itself will get a new module number.
@y
Here are the remaining changes to the program
that are necessary to make \.{TANGLE} work on Vax/VMS.


@ This variable is for speeding up the output routine.

@<Glob...@>=
@!out_temp_buffer:packed array [1..out_buf_size] of char;

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

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

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

@<Error...@>=
[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;

@ We get the external file names, and then call |open|
to associate an external file with each file variable.

@<Set init...@>=
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
	default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);

if got_file_name then begin
	file_name:=default_file_name+'.WEB';
	open(web_file,file_name,@=readonly@>,@=error:=continue@>);
	ask:=status(web_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('Web file: ');
	if eof then begin mark_fatal; jump_out; end;
	read_ln(file_name);
	open(web_file,file_name,@=readonly@>,@=error:=continue@>);
	ask:=status(web_file)<>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

if got_file_name then begin
	file_name:=default_file_name+'.CH';
	open(change_file,file_name,@=readonly@>,@=error:=continue@>);
	ask:=status(change_file)>0; {can be empty}
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('Change file: ');
	if eof then begin mark_fatal; jump_out; end;
	read_ln(file_name);
	if file_name.VAX_length=0 then file_name:='NL:';
	open(change_file,file_name,@=readonly@>,@=error:=continue@>);
	ask:=status(change_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 default_file_name.VAX_length do
		if (default_file_name[cmd_len]=']')
		or (default_file_name[cmd_len]=':')
		then cmd_i:=cmd_len+1;
	if cmd_i<=default_file_name.VAX_length then
		default_file_name:=substr(default_file_name,cmd_i,
			default_file_name.VAX_length-cmd_i+1);
	end;

if got_file_name then begin
	file_name:=default_file_name+'.PAS';
	open(Pascal_file,file_name,@=new,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(Pascal_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('Pascal file: ');
	if eof then begin mark_fatal; jump_out; end;
	read_ln(file_name);
	open(Pascal_file,file_name,@=new,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(Pascal_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

if got_file_name then begin
	file_name:=default_file_name+'.POO';
	open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
	ask:=status(pool)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('Pool file: ');
	if eof then begin mark_fatal; jump_out; end;
	read_ln(file_name);
	open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
	ask:=status(pool)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

rewrite(Pascal_file); rewrite(pool);
@z