diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/crudetype/version3/primos.ch |
Initial commit
Diffstat (limited to 'dviware/crudetype/version3/primos.ch')
-rw-r--r-- | dviware/crudetype/version3/primos.ch | 317 |
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 + |