summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3/primos.ch
blob: 5540200e899a3adff952465fa81540e5ad07dd53 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
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