path: root/dviware/crudetype/version3/primos.ch

% primos.ch -*-mode: change; webfile: crudetype.web version 3.01;-*-
%CRUDETYPE change file for the Primos Operating System.
%
%All PRIMOS changes Copyright (C) 1989 Jon Warbrick and Polytechnic South West.
%Permission is granted to use, copy and distribute copies of this file under
%the conditions that apply to the distribution of the CRUDETYPE program
%itself.
%
%This file modified by RMD for Crudetype version 2 --- and fixed by JW!
%Modified for V3
%

% Fix the 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 PRIMOS}}
@z

@x  Module 1; Lines 83 -- 86
This is an experimental version and no guarantee of performance is given.
I would like to receive bug reports, same address or electronic mail to
DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
NSFNET-RELAY.AC.UK). \par\vskip 0.5in
@y
This is an experimental version and no guarantee of performance is given.
I would like to receive bug reports, same address or electronic mail to
DAMERELL at UK.AC.NSFNET-RELAY (From the USA, I believe that site is
NSFNET-RELAY.AC.UK. \par\vskip 0.5in

The PRIMOS change file for this program was developed by Jon Warbrick, of
the Polytechnic South West (formally Plymouth Polytechnic) Computing
Service, Plymouth, UK.  Permission is granted to use, copy and distribute
copies of this PRIMOS version under the conditions that apply to
distrbution of the CRUDETYPE program itself.  Please report any bugs that
relate to the PRIMOS implementation, either by post or by electronic mail
to J.Warbrick at UK.AC.PLYMOUTH

This change file much modified by RMD to adapt it (I hope) to Crudetype
version 3.  Many of the changes originally made by JW and others have been
incorporated into the basic program.  I have asked the author to check it.
\par\vskip 0.5in
@z

@x  Module 4; Lines 213 -- 213
@d banner=='This is Crudetype, Version 3.01, copyright, experimental'
@y
@d banner=='This is Crudetype, Primos PSW Version 3'
@z

@x  Module 12; Lines 330 -- 334
the macros and constants defined here. See various change files for examples.

@d zchr == chr
@d zord == ord
@d Q_string == packed array[ first..last:integer] of char
@y
the macros and constants defined here. See various change files for examples.

PRIMOS \PASCAL does not have conformant arrays so we have to resort to
using |strings|, which are basically the same as VMS |varying|.

@d zchr == chr
@d zord == ord
@d Q_string == string
@d first = 1
@d last == length( ss)
@z

@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);
      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 18; Lines 432 -- 436
@<Set init...@>=
  be_string( '.DVI' ) ; dvi_def := buffer ;
  be_string( 'TEX$FONTS:.TFM' ) ; tfm_def := buffer ;
  be_string( 'TEX$GF:.&DGF' ) ; raster_def := buffer ;
  be_string( '.PRI' ) ; print_ex := buffer ;
@y
@<Set init...@>=
  be_string( '.DVI' ) ; dvi_def := buffer ;
  be_string( 'TEX>FONTS>.TFM' ) ; tfm_def := buffer ;
  be_string( 'TEX>GFDIR>.&DGF' ) ; raster_def := buffer ;
  be_string( '.LPT' ) ; print_ex := buffer ;
@z

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

In Primos, some condition handling stuff is used to see if the file got opened
OK.

@d close_binary(#)==
    close(#)

@<Lowest...@>=
  function open_binary
  (var f_f: byte_file; name: var_string ): boolean;
  label exit;
  @<Define |open_io_onunit|@>
  begin
    close_binary(f_f );
      {in case the file was left open}
    open_binary := false;
    on('IO_ERROR',open_io_onunit);
    reset(f_f, name.data);
    open_binary := true;
    exit: { come here after error opening file } ;
  end;
@z

@x  Module 20; Lines 445 -- 446
@ @<Open |printfile|@>=
  rewrite(printfile) ;
@y
@ Primos makes it fairly easy to open the print file.  We define a condition
handler so that the program will fail fairly neatly if we can't open the file,
or if we have problems writing to it in the future.

@<Open |printfile|@>=
  on('IO_ERROR', print_io_onunit);
  rewrite(printfile, print_name.data) ;
@z

@x  Module 21; Lines 448 -- 466
@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
be the procedure that actually reads the line, and these macros extract pieces
of it. The code below should work on systems that cannot read command lines.

@d get_val( #) == # := s_to_i( #, true)
@d prefix == "/"
@d got_cl == ( command.len > 0)
@d read_command_line( #) == do_nothing

@<Lowest...@>=
  {Declare |read_command_line| }
@#
  procedure get_command ;
  var ss: fix_string ;
  begin
    ss := blank.data ;
    read_command_line( ss) ;
    be_string( ss ) ; command := buffer ;
  end;
@y
@ \.{Crudetype} tries to read a ``command line''. |@!read_command_line| should
be the procedure that actually reads the line, and these macros extract pieces
of it. The code below will work under Primos, providing that the program is
loaded as an EPF.

@d get_val( #) == # := s_to_i( #, true)
@d prefix == "-"
@d got_cl == ( command.len > 0)
@d read_command_line( #) == @= epfargs@> ( #)

@<Lowest...@>=
  procedure get_command ;
  var ss: Q_string ;
  begin
    read_command_line( ss) ;
    be_string( ss ) ;  command := buffer ;
  end;
@z

@x  Module 198; Lines 3377 -- 3377
    page(printfile)
@y
    begin
      print_ln ;
      print ('1') ;
      print_ln ;
    end
@z

@x  Module 206; Lines 3464 -- 3464
  v_abs_com, h_abs_com, pause_after: var_string ;
@y
  v_abs_com, h_abs_com, pause_after: var_string ;
  bodge : packed record case boolean of
    true : (word  : shortint);
    false: (chars : packed array[1..2] of char);
  end;
@z

@x  Module 207; Lines 3474 -- 3474
  fortran := false ;
@y
  fortran := true ;
@z

@x  Module 207; Lines 3509 -- 3509
  start_stuff := blank ;
@y
  be_string ( '1' ) ;  start_stuff := buffer ;
@z

@x  Module 211; Lines 3570 -- 3572
@<Open |printfile|@>=
  string_print(start_stuff) ;
  print_ln ;
@y
@<Open |printfile|@>=
  bodge.word := @"0101 ;
  print(bodge.chars);
  print_ln ;
  string_print(start_stuff) ;
  print_ln ;
@z

@x  Module 235; Lines 4028 -- 4028
*** Attach printer change file here ***
@y
@* Additional Primos modules.

Some extra modules for the Primos version are included here to avoid
re-numbering all of the existing ones.
@.System dependencies@>

@ First some error handling: we use conditional handlers (or on-units) to
trap various IO errors, either on opening the \.{DVI} file or on writing
the output.

Errors on opening input files are trapped by |open_io_onunit|.  We do some
devious Sheffield pascal programming to see that the error was caused by a
|reset|, and if it was we jump to the exit label.  If it wasn't, then we just
return, leaving it to the system to see what to do next.

@<Define |open_io_onunit|@>=
  procedure open_io_onunit ( cfptr : integer ) ;
    var
    er_ptr: ptrerror;
  begin
    p$errptr(cfptr,er_ptr);
    with er_ptr^ do
      if (name_string = 'RESET   ') and
        (func_string = 'opening             ') then
        goto exit;
  end ;

@ Just before we open the output file we nominate |print_io_onunit| to handle
output errors.  We use some devious bits of Sheffield Pascal system
programming to find out what operation caused the problem, and print a
suitable error message before failing if we recognise the error.  If we dont
then we can just return and let the system handle it.

@<Lowest...@>=
  procedure print_io_onunit (cfptr: integer);
    var
    er_ptr: ptrerror;
  begin
    p$errptr(cfptr,er_ptr);
    with er_ptr^ do
      if (name_string = 'REWRITE ') then
        abort ('unable to open output file')
          @.fatal: unable to open...@>
      else if (name_string = 'PUT     ') or
        (name_string = 'WRTBUF  ') then
        abort ('error writing to output file -- disc storage may be full');
      @.fatal: error writing...@>
  end ;

@ @<Types...@>=
  ptrerror = ^io_error_struct;
  io_error_struct = record
    file_block : integer;
    err_code : shortint;
    error_value : integer;
    error_len : shortint;
    error_string : packed array [1..128] of char;
    name_le : shortint;
    name_string : packed array [1..8] of char;
    func_len : shortint;
    func_string : packed array [1..20] of char;
    caller_address : integer
  end;

@ @<Forw...@>=
  procedure p$errptr(cfptr:integer; var er_ptr:ptrerror); extern;

@ Turn off Pascal system interupt handling.  The pascal run-time library
routine |p$break| can be used to turn on or off handling of interupts.  So
we turn it off so that the program will fail quietly.

@<Set initial...@>=
  p$break (false);

@ @<Forw...@>=
  procedure p$break (onoroff : boolean ) ; extern;

@ In screenview the output file name must be different.

@<Set up for...@>=
  if inspection or batch_view then begin
      be_string( '.TEXT' ) ; print_ex := buffer ; end;
@z