⟦402e515c8⟧

TextFile

TANGLE 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
\def\title{TANGLE changes for Vax/VMS}
@z

@x
@d banner=='This is TANGLE, Version 2.5'
@y
@d banner=='This is TANGLE, Vax/VMS Version 2.5'
@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.
ALTERED by RMD: these directives produce undesirable effects, so I have
deleted the lot.

@<Compiler directives@>=
@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
@!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}
c : text_char ;
begin limit:=0; final_limit:=0;
  if eof(f) then input_ln:=false
  else  begin while not eoln(f) do
    begin c := f^ ; get(f);
      if xord[c] = invalid_code then
      @<Complain about bad character, and discard it@>
      else begin
        buffer[limit] := xord[c] ;
        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;
    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;
final_limit:0..buf_size; {|limit| without trailing blanks}
c : text_char ;
begin limit:=0; final_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
      c :=temp_buffer[i];
      if xord[c] = invalid_code then
      @<Complain about bad character, and discard it@>
      else begin
        buffer[limit] := xord[c] ;
        incr(limit);
        if buffer[limit-1]<>" " then final_limit:=limit;
      end;
    end;
    if not eoln(f) then begin
      print_ln('! Input line too long'); error;
        @.Input line too long@>
    end
    else read_ln(f);
    limit := final_limit ;
    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 @>

@ @<Types...@>=
Vax_word = [word] -32768..32767;
{a signed word integer, as needed for LIB\$GET_FOREIGN }

@ @<Local...@>=
@!command_line:packed array[1..300] of char;
@!cmd_len: Vax_word ;
@!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] Vax_word := 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
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦402e515c8⟧ TextFile

Derivation

TextFile
