⟦f142074fc⟧

TextFile


%FILE PRIMOS.CH
%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!
%
%

% [0] Fix the title
@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\def\title{Crudetype for {\mc PRIMOS}}
@z

% [1]
@x
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.UCL.CS.NSS (From the USA, I believe that site is
EDU.UCL.CS.NSS. \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.UCL.CS.NSS (From the USA, I believe that site is
EDU.UCL.CS.NSS. \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 2.  Many of the changes origanly made by JW and others have been
incorporated into the basic program.  The file has subsequently been
checked by its original author.
\par\vskip 0.5in
@z

% [4]
@x
@d banner=='This is Crudetype, Version 2, copyright, experimental'
@y
@d banner=='This is Crudetype, Primos PSW Version 2'
@z

% [12]
@x
compatible with a quoted string of any reasonable length. In VMS \PASCAL, we
can do this in 3 distinct ways: |ss| can be fixed (the actual parameter gets
padded), or |varying| or conformant. Since the Standard recognises conformant
arrays, this seems to be the lesser evil.

@d zchr == chr
@d zord == ord
@d Q_string == packed array[ first..last:integer] of char
@y
compatible with a quoted string of any reasonable length. In VMS \PASCAL, we
can do this in 3 distinct ways: |ss| can be fixed (the actual parameter gets
padded), or |varying| or conformant. Since the Standard recognises conformant
arrays, this seems to be the lesser evil.  Unfortulatly, 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

% [13 ]
@x
  fortran = false ;
@y
  fortran = true ;
@z

% [14]
@x
@<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

% [18]
@x
@<Set init...@>=
  set_string( dvi_def, '.DVI' , ' ', 0) ;
  set_string( tfm_def, 'TEX$FONTS:.TFM', ' ', 0) ;
  set_string( raster_def, 'TEX$GF:.&DGF', ' ', 0) ;
  set_string( print_ex, '.PRI', ' ', 0);
@y
@<Set init...@>=
  set_string( dvi_def, '.DVI' , ' ', 0) ;
  set_string( tfm_def, 'TEX>FONTS>.TFM', ' ', 0) ;
  set_string( raster_def, 'TEX>GFDIR>.&DGF', ' ', 0) ;
  set_string( print_ex, '.LPT', ' ', 0);
@z

% [19]
@x
@<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

% [20]
@x
@ @<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

% [21]
@x
@ \.{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: s_dat ;
  begin
    ss := blank.data ;
    read_command_line( ss) ;
    set_string( command, ss, ' ', 0) ;
  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) ;
    set_string( command, ss, ' ', 0) ;
  end;
@z

% [109]
@x
@ The |row_spec| must be a fixed length string because one of the many defects
of  Standard \PASCAL\ is that you cannot pass a conformant array to a value
parameter of another procedure.

@d row_length = 69   {The longest string \.{TANGLE} will allow }

@<Types...@>= row_string = packed array [1..row_length] of char ;
@y
@ The |row_spec| must be compatible with |Q_string|, as a knock-on effect
of the fact that the parameter to |epfargs| must be a |string|.

@<Types...@>= row_string = Q_string ;
@z

% [201]
@x
  page(printfile);
@y
  print_ln ;
  print ('1') ;
  print_ln ;
@z

% [210]
@x
@<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

% [213]
@x
  h_abs_com : var_string ;
@y
  h_abs_com : var_string ;
  bodge : packed record case boolean of
    true : (word  : shortint);
    false: (chars : packed array[1..2] of char);
  end;
@z

% [223]
@x
  start_stuff := blank ;
@y
  set_string ( start_stuff, '1', ' ', 0) ;
@z







% [236]
@x
*** 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;

@z
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦f142074fc⟧ TextFile

Derivation

TextFile
