summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3/primos.ch
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/crudetype/version3/primos.ch
Initial commit
Diffstat (limited to 'dviware/crudetype/version3/primos.ch')
-rw-r--r--dviware/crudetype/version3/primos.ch317
1 files changed, 317 insertions, 0 deletions
diff --git a/dviware/crudetype/version3/primos.ch b/dviware/crudetype/version3/primos.ch
new file mode 100644
index 0000000000..5540200e89
--- /dev/null
+++ b/dviware/crudetype/version3/primos.ch
@@ -0,0 +1,317 @@
+% 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
+