summaryrefslogtreecommitdiff
path: root/info/digests/texhax/txh/leichter.txh
blob: da85d63bafe2067b1432a6ab9cf3c12d759663df (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
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
Return-Path: <LEICHTER@VENUS.YCC.YALE.EDU>
Date: Wed, 27 Jan 88 14:31 EST
From: "Jerry Leichter (LEICHTER-JERRY@CS.YALE.EDU)"
 <LEICHTER@VENUS.YCC.YALE.EDU>
Subject: Bugfixes for VMS DVITYPE

Enclosed below is an updated change file for DVITYPE on VMS.  The first
change is simply an update to match the latest version number string.  The
second fixes a problem that causes DVITYPE to be unable to open an TFM files
unless you happen to have write access to them!

BTW, the code for DVITYPE is full of remarks like "stupid VMS run-time bug"
and "change me when bug is fixed".  Anyone know anymore what bug was being
worked around?  This code is presumably obsolete, but without knowing what
it was, it's impossible to know if it can be removed safely.

							-- Jerry

DVItype change file for Vax/VMS
Copyright (C) 1983 by David Fuchs.  All rights are reserved.
 7Dec87 JSL  .DVIType is now at Version 2.9.
27Jan88 JSL  .Use READONLY, not OLD, when opening the TFM files.
@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\let\maybe=\iffalse
\def\title{DVI$\,$\lowercase{type} changes for Vax/VMS}
@z

@x
@d banner=='This is DVItype, Version 2.9' {printed when the program starts}
@y
@d banner=='This is DVItype, Vax/VMS Version 2.9'
@z

@x
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
@z

@x
@d print(#)==write(#)
@d print_ln(#)==write_ln(#)
@y
In fact, we do this under Vax/VMS. We also use double-precision for all
real values.

@d print(#)==write(type_file,#)
@d print_ln(#)==write_ln(type_file,#)
@d real==double
@z

@x
@p program DVI_type(@!dvi_file,@!output);
@y
@p
@\@=[inherit('sys$library:starlet')]@>@\
 {allows us to use system symbols and routines}
program DVI_type(@!dvi_file,@!tfm_file,@!type_file,@!input,@!output);
@z

@x
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin print_ln(banner);@/
@y
@<Procedures for initialization@>@/
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin
  @<Preset initial values@>@/
  print_ln(banner);@/
@z

@x
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
{later we'll define files that contain binary data}
@z

@x
@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
@!tfm_file:byte_file; {a font metric file}
@y
@!dvi_file:packed file of byte_block; {the stuff we are \.{DVI}typing}
@!tfm_file:packed file of byte_block; {a font metric file}
@!dvi_count:integer; {number of bytes read from current block of |dvi_file|}
@!tfm_count:integer; {number of bytes read from current block of |tfm_file|}
@!dvi_blocks:integer; {number of blocks in |dvi_file|}
@z

@x
begin reset(dvi_file);
@y
begin reset(dvi_file);
dvi_count:=0;
@z

@x
begin reset(tfm_file,cur_name);
@y
begin close(tfm_file,@=error@>:=@=continue@>); {stupid Vax/VMS run-times}
open(tfm_file,cur_name,@=readonly@>,@=error@>:=@=continue@>);
reset(tfm_file,@=error@>:=@=continue@>);
tfm_count:=0;
@z

@x
@p procedure read_tfm_word;
begin read(tfm_file,b0); read(tfm_file,b1);
read(tfm_file,b2); read(tfm_file,b3);
@y
@d read_tfm_file(#)==begin
	if tfm_count=VAX_block_length then begin
		get(tfm_file,@=error:=continue@>); tfm_count:=0;
		end;
	#:=tfm_file^[tfm_count];
	incr(tfm_count);
	end

@p procedure read_tfm_word;
begin read_tfm_file(b0); read_tfm_file(b1);
read_tfm_file(b2); read_tfm_file(b3);
@z

@x
@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read(dvi_file,b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read(dvi_file,a); read(dvi_file,b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@y
@d read_dvi_file(#)==begin
	if dvi_count=VAX_block_length then begin
		get(dvi_file,@=error:=continue@>); dvi_count:=0;
		end;
	#:=dvi_file^[dvi_count];
	incr(dvi_count);
	end

@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(dvi_file) then get_byte:=0
else  begin read_dvi_file(b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:eight_bits;
begin read_dvi_file(b); incr(cur_loc);
if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read_dvi_file(a); read_dvi_file(b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin read_dvi_file(a); read_dvi_file(b);
cur_loc:=cur_loc+2;
if a<128 then signed_pair:=a*256+b
else signed_pair:=(a-256)*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_trio:integer; {returns the next three bytes, signed}
var a,@!b,@!c:eight_bits;
begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c);
cur_loc:=cur_loc+3;
if a<128 then signed_trio:=(a*256+b)*256+c
else signed_trio:=((a-256)*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c); read_dvi_file(d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@z

@x
begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
@y
begin dvi_length:=dvi_blocks*VAX_block_length-1;
@z

@x
begin set_pos(dvi_file,n); cur_loc:=n;
@y
var @!blk,@!byt:integer; {block and byte number}
begin cur_loc:=n;
blk:=n div VAX_block_length;
byt:=n-(blk*VAX_block_length);
@=find@>(dvi_file,blk+1); {VMS starts counting block numbers at 1, not 0}
dvi_count:=byt;
@z

@x
and |term_out| for terminal output.
@^system dependencies@>

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}
@y
and |term_out| for terminal output.
@^system dependencies@>

@d term_in==input {the terminal, considered as an input file}
@d term_out==output {the terminal, considered as an output file}

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@z

@x
@d update_terminal == break(term_out) {empty the terminal output buffer}
@y
On Vax/VMS, this is actually not necessary in this context, since
|update_terminal| is always called just before a |read|.

@d update_terminal == {the terminal output buffer is emptied by |read|}
@z

@x
begin update_terminal; reset(term_in);
if eoln(term_in) then read_ln(term_in);
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
@y
begin update_terminal;
k:=0;
while (k<terminal_line_length)and not eoln(term_in) do
  begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
  end;
buffer[k]:=" ";
read_ln(term_in);
@z

@x
    begin incr(buf_ptr); resolution:=k/get_integer;
@y
    begin incr(buf_ptr); resolution:=@=dble@>(k)/get_integer;
@z

@x
if eof(tfm_file) then
@y
if status(tfm_file)<>0 then
@z

@x
@d default_directory_name=='TeXfonts:' {change this to the correct name}
@d default_directory_name_length=9 {change this to the correct length}
@y
@d default_directory_name=='TEX$FONTS:' {change this to the correct name}
@d default_directory_name_length=10 {change this to the correct length}
@z

@x
m:=n-4;
@y
m:=n;
repeat if m=0 then bad_dvi('all 0s');
@.all 0s@>
move_to_byte(m); k:=get_byte; decr(m);
until k<>0;
if k<>223 then bad_dvi('223 byte is ',k:1);
@.223 byte is wrong@>
@z

@x
while (m=223)and not eof(dvi_file) do m:=get_byte;
@y
while ((m=223) or (m=0)) and not eof(dvi_file) do m:=get_byte;
@z

@x
final_end:end.
@y
close(type_file,@=disposition:=save@>,@=error:=continue@>);
final_end:end.
@z

@x
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{DVItype} work at a particular installation.
It is usually best to design your change file so that all changes to
previous sections preserve the section numbering; then everybody's version
will be consistent with the printed program. More extensive changes,
which introduce new sections, can be inserted here; then only the index
itself will get a new section number.
@y
Here are the remaining changes to the program
that are necessary to make \.{DVItype} work on Vax/VMS.

@<Const...@>==
@!VAX_block_length=512;

@ @<Types...@>==
@!byte_block=packed array [0..VAX_block_length-1] of 0..255;

@ On Vax/VMS we need the following special definitions, types, variables
and procedures to be able to get the file name from the command line,
or to prompt for them.

@d VAX_direct==@=direct@>
@d VAX_fixed==@=fixed@>
@d VAX_volatile==@=volatile@>
@d VAX_immed==@=%immed @>
@d VAX_external==@=external@>
@d VAX_stdescr==@=%stdescr @>
@d VAX_lib_get_foreign==@= lib$get_foreign@>
@d VAX_length==@=length @>
@d VAX_fab_type==@= FAB$TYPE @>
@d VAX_rab_type==@= RAB$TYPE @>
@d VAX_xab_type==@= XAB$TYPE @>
@d VAX_fab_xab==@= FAB$L_XAB @>
@d VAX_xab_nxt==@= XAB$L_NXT @>
@d VAX_xab_cod==@= XAB$B_COD @>
@d VAX_xab_fhc==@= XAB$C_FHC @>
@d VAX_xab_ebk==@= XAB$L_EBK @>

@ @<Types...@>=
@!sixteen_bits= 0..65535;

@ @<Glob...@>==
@!type_file: text;
@!command_line:packed array[1..300] of char;
@!cmd_len:sixteen_bits;
@!cmd_i:integer;
@!file_name,@!def_file_name:varying [300] of char;
@!ask,@!got_file_name: boolean;

@ @<Preset init...@>=
open(output,'SYS$OUTPUT',@=error:=continue@>); {FIX ME! JUNK FOR RUN-TIME BUG}

cmd_i:=0;
VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
got_file_name:=cmd_i<=cmd_len;
if got_file_name then
	def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);

if got_file_name then begin
	file_name:=def_file_name+'.DVI';
	open(dvi_file,file_name,@=readonly@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
	ask:=status(dvi_file)<>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	got_file_name:=false;
	write('DVI file: ');
	if eof then goto 9999;
	read_ln(file_name);
	open(dvi_file,file_name,@=readonly@>,,VAX_direct,
		VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
	ask:=status(dvi_file)<>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;

if got_file_name then begin
	cmd_i:=1;
	for cmd_len:=1 to def_file_name.VAX_length do
		if (def_file_name[cmd_len]=']')
		or (def_file_name[cmd_len]=':')
		then cmd_i:=cmd_len+1;
	if cmd_i<=def_file_name.VAX_length then
		def_file_name:=substr(def_file_name,cmd_i,
			def_file_name.VAX_length-cmd_i+1);
	file_name:=def_file_name+'.TYP';
	open(type_file,file_name,@=new,32767,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(type_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end
else ask:=true;
while ask do begin
	write('TYPE file: ');
	if eof then goto 9999;
	read_ln(file_name);
	if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
	open(type_file,file_name,@=new,32767,disposition:=delete@>,
		@=error:=continue@>);
	ask:=status(type_file)>0;
	if ask then write_ln('Couldn''t open ',file_name);
	end;
rewrite(type_file);

@ Here is the library procedure that gets the user's command line.

@<Procedures for ...@>=
[VAX_external] function VAX_lib_get_foreign(
  VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
	:= VAX_immed 0;
  VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
	:= VAX_immed 0;
  var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
  var flag : [VAX_volatile] integer := VAX_immed 0)
    :integer; extern;

@ Here is how we intervene to find out the length of the |dvi_file|.

@<Procedures for ...@>=
function dvi_open(var fab:VAX_fab_type; var rab:VAX_rab_type):integer;
	type XAB_ptr = ^VAX_xab_type;
	var	user_status:integer;
		xab,fhc:XAB_ptr;
	begin
	user_status:=@= $OPEN@>(fab);
	if odd(user_status) then @= $CONNECT@>(rab);
	xab:=fab.VAX_fab_xab::XAB_ptr;
	fhc:=nil;
	while (xab<>nil) and (fhc=nil) do
		if xab^.VAX_xab_cod=VAX_xab_fhc then fhc:=xab
		else xab:=xab^.VAX_xab_nxt::XAB_ptr;
	if fhc<>nil then dvi_blocks:=int(fhc^.VAX_xab_ebk)
	else dvi_blocks:=0;

	dvi_open:=user_status;
	end;

@z
-------