summaryrefslogtreecommitdiff
path: root/support/makeprog/dos/makeprog.chf
blob: e2ddd3d7cea8c665813fe33b4a4648de930f7858 (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
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
@x
\def\version{1.0.1}
@y
 \let\maybe=\iffalse
\def\version{1.0.1, Rev.~2}
@z

@x
   \centerline{\titlefont The MAKEPROG processor}
@y
   \centerline{\titlefont DOS Changes to the MAKEPROG processor}
@z

@x
@d banner=='This is MAKEPROG, Version 1.0.1.'
@y
@d banner=='This is MAKEPROG, Version 1.0.1 (DOS Changes, Rev. 2).'
@z

@x
@d end_of_MAKEPROG = 9999 {go here to wrap it up}
@y
@f uses == const
@z

@x
program MAKEPROG(@!doc_file,@!change_file,@!prog_file);
@y
program MAKEPROG(@!output,@!doc_file,@!change_file,@!prog_file);
@z

@x
label end_of_MAKEPROG; {go here to finish}
@y
   uses CRT, DOS ;
@z

@x
@t\4@>@<Error handling procedures@>@;
@y
@t\4@>@<Turbo Pascal specific procedures@>@;
@t\4@>@<Error handling procedures@>@;
@z

 x
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
 y
@d debug==   {we are debugging \.{MAKEPROG}}
@d gubed==
 z

@x
@<Compiler directives@>=
@{@&@=$D-@> @} {no debug overhead}
@!debug @{@&@=$D+@> @}@+ gubed @; {but turn everything on when debugging}
@y
@<Compiler directives@>=
@{@=$R-,B-,D-,E-,L-,S+,V-@>@}

{ R-  no range checking 		   }
{ B-  boolean evaluation ... short circuit }
{ D-  debug information off		   }
{ E-  emulation off			   }
{ L-  local symbols ... off		   }
{ S+  stack checking ... on		   }
{ V-  var string checking ... relaxed	   }
@z

@x
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == else {default for cases not listed explicitly}
@z

@x
@d last_text_char=127 {ordinal number of the largest element of |text_char|}
@y
@d last_text_char=255 {ordinal number of the largest element of |text_char|}
@z

@x
@!text_file=packed file of text_char;
@y
@!text_file=text;
@z

@x
for i:=1 to " "-1 do xchr[i]:=' ';
@y
for i:=1 to " "-1 do xchr[i]:=' ';
xchr[tab_mark] := chr(tab_mark);
@z

@x
is assumed to consist of characters of type |text_char|:
@^system dependencies@>

@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
@d new_line==write_ln(term_out) {start new line}
@d print_nl(#)==  {print information starting on a new line}
  begin new_line; print(#);
  end

@<Globals...@>=
@!term_out:text_file; {the terminal as an output file}
@y
is assumed to consist of characters of type |text_char|:
@^system dependencies@>

@d term_out == output {the output file is normaly the terminal}
@#
@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
@d new_line==write_ln(term_out) {start new line}
@d print_nl(#)==  {print information starting on a new line}
  begin new_line; print(#);
  end
@z

@x
rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
@y
do_nothing; {|output| is opened automatically}
@z

@x
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
@d update_terminal == do_nothing {output to |output| is unbuffered}
@z

@x
reset(doc_file); reset(change_file);
@y
@< Initialize the Turbo Pascal specific input/output related variables @>;
tp_reset(doc_file, 'DOC', doc_buffer);
tp_reset(change_file, 'CHF', chf_buffer);
@z

@x
rewrite(prog_file);
@y
tp_rewrite(prog_file, prog_ext, prog_buffer);
@z

@x
function input_ln(var f:text_file):boolean; {inputs a line or returns |false|}
   var final_limit:0..buf_size; {|limit| without trailing blanks}
   begin limit:=0; final_limit:=0;
   if eof(f) then input_ln:=false
   else  begin
      while not eoln(f) do
	 begin buffer[limit]:=xord[f^]; get(f);
	 incr(limit);
	 if (buffer[limit-1]<>" ") and (buffer[limit-1]<>tab_mark) then
	    final_limit:=limit;
	 if limit=buf_size then
	    begin while not eoln(f) do get(f);
	    decr(limit); {keep |buffer[buf_size]| empty}
	    print_nl('! Input line too long'); error; mark_error;
@.Input line too long@>
	    end;
	 end;
      read_ln(f); limit:=final_limit; input_ln:=true;
      end;
   end;
@y
function input_ln(var f:text_file):boolean; {inputs a line or returns |false|}
   var s: string; {temporary line storage}
      final_limit: 0..buf_size+1; {index into |s|}
      i: 0..buf_size; {index into |buffer|}
   begin
   if eof(f) then
      begin  limit := 0;  input_ln := false;
      end
   else begin  read_ln(f,s);
      final_limit := ord(s[0]);
      while (final_limit > 0) and
	    ((s[final_limit] = ' ') or (s[final_limit] = xchr[tab_mark])) do
	 decr(final_limit);
      if final_limit > buf_size+1 then	final_limit := buf_size + 1;
      for i:=0 to final_limit-1 do  buffer[i] := xord[s[i+1]];
      if final_limit >= buf_size then
	 begin	final_limit := buf_size - 1; {keep |buffer[buf_size]| empty}
	 print_nl('! Input line too long');  error;  mark_error;
@.Input line too long@>
	 end;
      limit := final_limit;  input_ln := true ;
      end;
   end;
@z

@x
procedure jump_out;
begin goto end_of_MAKEPROG;
end;
@y
procedure jump_out;
   begin
   close(prog_file);  close(doc_file);	close(change_file);
   @;@#
   @<Print the job |history|@>;
   halt;
   end;
@z

@x
procedure put_line;
   var i: 0..buf_size;
   begin
   for i:=0 to limit-1 do  write(prog_file, xchr[buffer[i]]);
   write_ln(prog_file);
   end;
@y
procedure put_line;
   var i: 0..buf_size;
      s: string; {temporary line storage}
   begin
   for i:=0 to limit-1 do  s[i+1] := xchr[buffer[i]];
   s[0] := chr(limit);	write_ln(prog_file, s);
   end;
@z

@x
end_of_MAKEPROG:
   @#
   {here files should be closed if the operating system requires it}
   @;@#
   @<Print the job |history|@>;
@y
   jump_out;
@z

@x
@<Print the job |history|@>=
case history of
spotless: print_nl('(No errors were found.)');
harmless_message: print_nl('(Did you see the warning message above?)');
error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
fatal_message: print_nl('(That was a fatal error, my friend.)');
end {there are no other cases}
@y
@<Print the job |history|@>=
begin
case history of
   spotless: print_nl('(No errors were found.)');
   harmless_message: print_nl('(Did you see the warning message above?)');
   error_message:
      print_nl('(Pardon me, but I think I spotted something wrong.)');
   fatal_message: print_nl('(That was a fatal error, my friend.)');
   end; {there are no other cases}
new_line;
end
@z

@x
\noindent This module should be replaced, if necessary, by
changes to the program that are necessary to make
\MAKEPROG{} work at a particular installation.  It is
usually best to design your change file so that all changes
to previous modules preserve the module numbering; then
everybody's version will be consistent with the printed
program.  More extensive changes, which introduce new
modules, can be inserted here; then only the index itself
will get a new module number.
@^system dependencies@>
@y
\noindent This module should be replaced, if necessary, by
changes to the program that are necessary to make
\MAKEPROG{} work at a particular installation.	It is
usually best to design your change file so that all changes
to previous modules preserve the module numbering; then
everybody's version will be consistent with the printed
program.  More extensive changes, which introduce new
modules, can be inserted here; then only the index itself
will get a new module number.
@^system dependencies@>



@* Resetting and rewriting files.

\noindent Turbo Pascal allows the usage of command line
parameters but does not connect external files with the
internal file variables automatically. Therefore we demand
the file name (without extension) in the command line---with
this name we can open resp.\ create the files. The real
opening of input files is done via |tp_reset| and the
creating of output files is done via |tp_rewrite|. Both
procedures have two parameters, the file variable and the
extension which should be used together with the file name.
The extension is passed without a dot.

@< Glob... @>=
@!file_name: string;
@!prog_ext: string;


@ But first we have to look at the command line. If there is
no parameter present we print a usage message and finish the
program afterwards. Here |jump_out| cannot be used because
files would be closed that would be not open.

@< Initialize the Turbo... @>=
if param_count < 1 then
   begin  print('! usage: makeprog [-ext] file_name');  halt;
   end
else begin
   file_name := param_str(1);
   if (param_count = 2) and (file_name[1] = '-') then
      begin prog_ext := copy(file_name, 2, 3);	file_name := param_str(2);
      end
   else prog_ext := 'PRG';
   end;


@ @< Type... @>=
@!file_buffer=packed array[1..4096] of byte;


@ @< Glob... @>=
@!doc_buffer:file_buffer; {file buffer for primary input}
@!chf_buffer:file_buffer; {file buffer for updates}
@!prog_buffer:file_buffer; {file buffer for output}


@ If an input file can't be opened we handle it just like a
file that is not there. I.e., we use \.{NUL:} as the input
file---|eof| will then always return true as presumed by the
program.

@< Turbo Pascal specific procedures @>=
procedure tp_reset( var f: text_file; ext: string; var buf: file_buffer );
   begin  assign(f, file_name+'.'+ext); @/
   @{@=$I-@>@} reset(f); @{@=$I+@>@}
   if io_result = 0 then  settextbuf(f, buf)
   else begin  assign(f, 'NUL');  reset(f); { |eof(f) = true| }
      end;
   end;

@#

procedure tp_rewrite( var f: text_file; ext: string; var buf: file_buffer );
   begin  assign(f, file_name+'.'+ext);  rewrite(f);  settextbuf(f, buf);
   end;
@z