Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0109/adres.lst
There is 1 other file named adres.lst in the archive. Click here to see a list.
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 1
DSK:ADRES.SIM 20-FEB- 1977 19:00
1 OPTIONS(/l); COMMENT address file handling and printing program;
2 COMMENT written by Jacob Palme, FOA 1, 104 50 Stockholm 80, SWEDEN;
3 COMMENT Version 0A, December 20, 1975;
B1 4 BEGIN
5 EXTERNAL TEXT PROCEDURE scanto, from, conc2, front;
6 EXTERNAL INTEGER PROCEDURE search, trmop;
7 EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext, dotypeout;
8 EXTERNAL REF (outfile) PROCEDURE findoutfile;
9 EXTERNAL CHARACTER PROCEDURE findtrigger;
10 EXTERNAL INTEGER PROCEDURE scanint;
11 EXTERNAL LONG REAL PROCEDURE scanreal;
12 EXTERNAL REF (infile) PROCEDURE findinfile;
13 EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,
14 checkextension;
15 EXTERNAL PROCEDURE split;
16 EXTERNAL CLASS safmin;
17 EXTERNAL BOOLEAN PROCEDURE sqhelp;
18 EXTERNAL CLASS decom;
19 EXTERNAL CLASS select;
20 INTEGER i, max_number_of_lines, lastline, lastlinep1,
21 line_number, sortlength, page_step;
22 INTEGER count_of_input, count_of_output, count_of_error;
23 INTEGER count_of_rejected;
24 INTEGER labels_per_width, left_margin, label_width, label_spacing;
25 INTEGER line1_length, line2_length, line_dimension, in_dimension;
26 BOOLEAN end_of_file, usetabs, select_output, line1_output,
27 label_output, list_output, file_output, presort_output, asort_output;
28 BOOLEAN caseshift;
29 TEXT infilename, outfilename, blanktext, command;
30 TEXT motoron, motoroff, removetabs, settab;
31 TEXT mainline;
32 CHARACTER altmode, formfeed, tab;
33 REF (infile) infileref; REF (outfile) outfileref;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 2
DSK:ADRES.SIM 20-FEB- 1977 19:00
34
35
36 select CLASS label_select;
B2 37 BEGIN
38 REF (operator) line1_condition, line2_condition;
E2 39 END;
40 line_dimension:= 40;
41 outtext("[ADRES is here]"); outimage;
42 outtext("[For HELP type ? followed by one word"
43 " with the subject you want help on]"); outimage;
B3 44 decom(14) BEGIN
45 margin:= 0;
46 INSPECT NEW label_select DO
B4 47 BEGIN
48 TEXT line1_selector, line2_selector;
49 REF (label_data) first_label, last_label;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 3
DSK:ADRES.SIM 20-FEB- 1977 19:00
50
51 PROCEDURE setdependentparameters;
B5 52 BEGIN
53 count_of_rejected:= count_of_error:=
54 count_of_input:= count_of_output:= 0;
55 end_of_file:= FALSE;
56 IF asort_output OR presort_output OR file_output THEN
B6 57 BEGIN
58 labels_per_width:= 1; usetabs:= FALSE;
59 label_width:= line2_length;
60 max_number_of_lines:= line_dimension-2;
E6 61 END;
62 lastline:= max_number_of_lines+1;
63 lastlinep1:= lastline+1;
64 in_dimension:= line_dimension - 1 - line2_length//label_width;
65 sysout.image:- blanks(line1_length);
66 IF list_output THEN
B7 67 BEGIN page_step:= max_number_of_lines+1;
68 page_step:= 60//page_step-1;
69 page_step:= page_step*labels_per_width;
E7 70 END;
71 linecopy_buffer:- blanks(
72 IF select_output THEN
73 (IF line2_condition == NONE THEN
74 (IF caseshift THEN line1_length ELSE 0)
75 ELSE line2_length*10)
76 ELSE 0);
77 IF line1_output THEN
B8 78 BEGIN
79 IF line1_length > line2_length THEN line2_length:= line1_length
80 ELSE line1_length:= line2_length;
E8 81 END;
82 IF sysout == outfileref AND usetabs THEN
B9 83 BEGIN
84 if trmop(8R2005,sysout,1) = 0 then !IF TTY NO TAB;
B10 85 begin ! then .SET TTY TAB;
86 outtext("TTY TAB has been set by the ADRES program.");
87 outimage;
E10 88 END;
E9 89 END;
90 IF usetabs THEN
B11 91 BEGIN
92 outtext("Make sure that your terminal really can handle"
93 " tabs in the same way as"); outimage;
94 outtext("GNT, Terminet and similar terminals. If not,"
95 " use the /NOTABS switch"); outimage;
96 outtext("to the input for the ADRES program.");
97 outimage;
E11 98 end;
E5 99 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 4
DSK:ADRES.SIM 20-FEB- 1977 19:00
100
101
102 PROCEDURE outline(t); NAME t; TEXT t;
B12 103 BEGIN
104 sysout.image:= t; outimage;
E12 105 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 5
DSK:ADRES.SIM 20-FEB- 1977 19:00
106
107 BOOLEAN PROCEDURE adreshelp(selector);
108 VALUE selector; TEXT selector;
B13 109 BEGIN
110 IF selector == NOTEXT AND sysin.image =/= NOTEXT THEN
B14 111 BEGIN
112 command:- sysin.image.strip;
113 command.setpos(1); IF command.getchar = '?' THEN
114 selector:- command.sub(2,command.length-1);
E14 115 END;
116 sqhelp("ADRES",selector,19,72);
E13 117 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 6
DSK:ADRES.SIM 20-FEB- 1977 19:00
118
119 PROCEDURE interpretintegerswitches;
B15 120 BEGIN
121 intswitch("LINES","5",max_number_of_lines,
122 max_number_of_lines > 0 AND max_number_of_lines < 11,
123 "Must be between 0 and 11",adres_help(" /LINES"));
124 intswitch("LABELS","3",labels_per_width,
125 labels_per_width >= 1,"Must be >= 1",adres_help(" /LINES"));
126 intswitch("LEFT","0",left_margin,
127 left_margin >= 0 AND left_margin < 114,
128 "Must be between 0 and 114",
129 adres_help(" /LABELS"));
130 intswitch("WIDTH","36",label_width,
131 label_width > 5 AND
132 label_width < (132-left_margin)//labels_per_width,
133 "Too large or < 6",adres_help(" /WIDTH"));
134 IF boolswitch("SINGLE",TRUE,NOTEXT,adres_help(" /SINGLE")) THEN
B16 135 BEGIN
136 labels_per_width:= 1; left_margin:= 1;
137 label_width:= 48;
E16 138 END;
139 intswitch("TAB","41",label_spacing,
140 labels_per_width <= 1 OR
141 (label_spacing < (132-left_margin)//labels_per_width AND
142 label_spacing > label_width),
143 "Too large or less than /WIDTH",adres_help(" /TAB"));
144 intswitch("LINE1","300",line1_length,
145 line1_length > 0,"Must be positive",adres_help(" /LINE1"));
146 intswitch("LINE2","80",line2_length,
147 line2_length > 0 AND line2_length >= label_width,
148 "Must be positive and larger than /WIDTH",
149 adres_help(" /LINE2"));
E15 150 END of interpret_integer_switches;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 7
DSK:ADRES.SIM 20-FEB- 1977 19:00
151
152
153 PROCEDURE interpret_boolean_switches;
B17 154 BEGIN
155 usetabs:= NOT boolswitch("NOTABS",TRUE,NOTEXT,
156 adres_help(" /NO"));
157 list_output:= boolswitch("LIST",TRUE,NOTEXT,
158 adres_help(" /LIST"));
159 file_output:= boolswitch("FILE",NOT list_output,
160 "Only one kind of output",adres_help(" /FILE"));
161 presort_output:= boolswitch("PRESORT",
162 NOT list_output AND NOT file_output,
163 "Only one kind of output",adres_help(" /PRESORT"));
164 asort_output:= boolswitch("ASORT",
165 NOT list_output AND NOT file_output
166 AND NOT presort_output, "Only one kind of output",
167 adres_help(" /ASORT"));
168 select_output:= boolswitch("SELECT",NOT asort_output,
169 "/SELECT will not work combined with /ASORT",
170 adres_help(" /SELECT"));
171 caseshift:= NOT boolswitch("NOCASESHIFT",select_output,
172 "/NOCASESHIFT only meaningful combined with /SELECT",
173 adres_help(" /NOCASESHIFT"));
174 label_output:= NOT (list_output OR
175 file_output OR presort_output OR asort_output
176 OR boolswitch("NOLABEL",list_output OR
177 file_output OR presort_output OR asort_output,
178 "No kind of output",
179 adres_help(" /NOLABEL")));
180 line1_output:= boolswitch("OUT1",
181 label_output OR list_output,
182 "/OUT1 only meaningful with /LIST or /LABEL",
183 adres_help(" /OUT1"));
E17 184 END of interpret_boolean_switches;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 8
DSK:ADRES.SIM 20-FEB- 1977 19:00
185
186
187 PROCEDURE request_selectors;
B18 188 BEGIN
189 displaydefault:= FALSE;
190 outtext("Give Boolean condition on line 1");
191 outimage; request(":",
192 NOTEXT,textinput(line1_selector,
193 build_condition(line1_condition,line1_selector,caseshift)),
194 select_errmess,adres_help(" /SELECT"));
195 outchar('('); tree_print(line1_condition);
196 outchar(')'); outimage;
197 outtext("Give Boolean condition on lines after line 1");
198 outimage; request(":",
199 NOTEXT,textinput(line2_selector,
200 build_condition(line2_condition,line2_selector,caseshift)),
201 select_errmess,adres_help(" /SELECT"));
202 outchar('('); tree_print(line2_condition);
203 outchar(')'); outimage;
204 displaydefault:= TRUE;
E18 205 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 9
DSK:ADRES.SIM 20-FEB- 1977 19:00
206
207 BOOLEAN PROCEDURE filescanbecreated;
B19 208 BEGIN TEXT oldextension, newextension;
209 IF outfilename = NOTEXT THEN outfilename:-copy("TTY:");
210 IF infilename = NOTEXT THEN
B20 211 BEGIN
212 IF (label_output OR list_output OR presort_output) THEN
B21 213 BEGIN
214 infilename:- copy(outfilename);
215 IF findtrigger(infilename,dottext) = '.' THEN
216 infilename:- infilename.sub(1,infilename.pos-2);
E21 217 END ELSE
B22 218 BEGIN
219 outtext("?ADRES - Both infile and outfile name must");
220 outimage;
221 outtext("be given when creating .ADR files");
222 outimage; GOTO out;
E22 223 END;
E20 224 END;
225 newextension:- copy(
226 IF label_output THEN ".LAB" ELSE IF list_output THEN ".LST"
227 ELSE IF presort_output THEN ".USR" ELSE ".ADR");
228 oldextension:- copy(
229 IF asort_output THEN ".SRT" ELSE ".ADR");
230 createfiles(outfilename,infilename,
231 newextension, oldextension,
232 outfileref,infileref,adres_help("file"));
233 files_can_be_created:= TRUE;
234 out:
E19 235 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 10
DSK:ADRES.SIM 20-FEB- 1977 19:00
236
237 BOOLEAN PROCEDURE interpretlegalcommand;
B23 238 BEGIN
239 IF NOT deccom(upcase(command),outfilename,infilename)
240 THEN GOTO out;
241 displaydefault:= TRUE;
242 interpret_integer_switches;
243 interpret_boolean_switches;
244 IF select_output THEN request_selectors ELSE
245 line1_condition:- line2_condition:- NONE;
246 IF NOT illegalswitch(
247 "Uninterpretable or duplicate switch: /",adres_help(""))
248 THEN interpret_legal_command:= files_can_be_created;
249 out:
E23 250 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 11
DSK:ADRES.SIM 20-FEB- 1977 19:00
251 PROCEDURE adjust_label_form;
B24 252 BEGIN
253 BOOLEAN positioned;
254 WHILE NOT positioned DO
B25 255 BEGIN
256 request("Is this first line on a label?","NO",boolinput(positioned),
257 NOTEXT,adres_help("inserting label forms"));
E25 258 END;
E24 259 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 12
DSK:ADRES.SIM 20-FEB- 1977 19:00
260
261 PROCEDURE readinputcommand;
B26 262 BEGIN CHARACTER c;
263 prompt:
264 displaydefault:= FALSE;
265 request("*",nodefault,textinput(command,
266 interpret_legal_command),
267 NOTEXT,adres_help(""));
268 set_dependent_parameters;
269 IF label_output AND outfileref == sysout THEN
270 adjust_label_form;
E26 271 END of read_input_command;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 13
DSK:ADRES.SIM 20-FEB- 1977 19:00
272
273
274 CLASS label_data;
B27 275 BEGIN
276 REF (label_data) next;
277 TEXT line_buffer, sort_buffer;
278 TEXT ARRAY line(1:line_dimension), stripline(1:line_dimension);
279 TEXT second_alg_buffer;
280 INTEGER number_of_lines, line_number;
281 BOOLEAN faulty_address, erased_address;
282 IF first_label == NONE THEN first_label:- THIS label_data
283 ELSE last_label.next:- THIS label_data;
284 next:- first_label;
285 last_label:- THIS label_data;
286 line_buffer:-
287 blanks(5+line1_length+(line_dimension-1)*line2_length);
288 sort_buffer:- line_buffer.sub(6,line_buffer.length-5);
289 line(1):- line_buffer.sub(6,line1_length);
290 FOR i:= 2 STEP 1 UNTIL line_dimension DO
291 line(i):- line_buffer.sub
292 (6+line1_length+(i-2)*line2_length,line2_length);
293 second_alg_buffer:- blanks(label_width*max_number_of_lines);
E27 294 END of label_data;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 14
DSK:ADRES.SIM 20-FEB- 1977 19:00
295
296
297 label_data CLASS label_operations;
B28 298 BEGIN
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 15
DSK:ADRES.SIM 20-FEB- 1977 19:00
299
300
301 PROCEDURE erase_address;
B29 302 BEGIN
303 erased_address:= TRUE;
304 line[1]:= stripline[1]:= NOTEXT;
305 FOR number_of_lines:= 2 STEP 1 UNTIL lastline DO
B30 306 BEGIN
307 line[number_of_lines]:=
308 IF presort_output THEN NOTEXT ELSE "*****";
309 stripline[number_of_lines]:- line[number_of_lines].strip;
E30 310 END;
311 number_of_lines:= lastline;
E29 312 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 16
DSK:ADRES.SIM 20-FEB- 1977 19:00
313
314
315 PROCEDURE error(errmess); NAME errmess; TEXT errmess;
B31 316 BEGIN INTEGER i, addcount;
317 faulty_address:= TRUE;
318 outtext("?ADRES - "); outtext(errmess);
319 outimage;
320 i:= number_of_lines; IF i > 4 THEN i:= 4;
321 FOR line_number:= 1 STEP 1 UNTIL i DO
B32 322 BEGIN
323 image:= stripline(line_number); outimage;
E32 324 END;
325 outimage;
326 addcount:= 2+i; addcount:= lastline-mod(addcount,lastline);
327 If addcount = lastline then addcount:= 0;
328 for i:= 1 step 1 until addcount do outimage;
329 erase_address;
E31 330 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 17
DSK:ADRES.SIM 20-FEB- 1977 19:00
331
332
333 PROCEDURE divide_line;
B33 334 BEGIN
335 line[number_of_lines+1]:= line[number_of_lines].
336 sub(label_width+1,line2_length-label_width);
337 line[number_of_lines].sub(label_width+1,
338 line2_length-label_width)
339 := NOTEXT;
340 stripline[number_of_lines]:- line[number_of_lines].sub(1,
341 label_width);
342 number_of_lines:= number_of_lines+1;
343 stripline[number_of_lines]:- line[number_of_lines].strip;
E33 344 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 18
DSK:ADRES.SIM 20-FEB- 1977 19:00
345
346
347 PROCEDURE too_many_lines;
348 INSPECT infileref DO
B34 349 BEGIN
350 error("Too many lines in input address.");
351 WHILE TRUE DO
B35 352 BEGIN
353 inimage; image.setpos(image.strip.length);
354 IF (IF image.more THEN image.getchar ELSE ' ')
355 = formfeed THEN GOTO out;
E35 356 END;
357 out: image:= NOTEXT;
E34 358 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 19
DSK:ADRES.SIM 20-FEB- 1977 19:00
359
360
361 BOOLEAN PROCEDURE select_this_address;
B36 362 BEGIN
363 BOOLEAN select;
364 IF line_scan(line1_condition,stripline(1)) THEN
B37 365 BEGIN
366 IF array_scan(line2_condition,
367 stripline,2,number_of_lines)
368 THEN
369 select:= TRUE;
E37 370 END;
371 IF NOT select THEN count_of_rejected:= count_of_rejected+1;
372 select_this_address:= select;
E36 373 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 20
DSK:ADRES.SIM 20-FEB- 1977 19:00
374
375
376 PROCEDURE read_an_address;
377 INSPECT infileref DO
B38 378 BEGIN
379 top: number_of_lines:= IF line1_output THEN 2 ELSE 1;
380 IF faulty_address THEN count_of_error:= count_of_error+1;
381 erased_address:= faulty_address:= FALSE;
382 IF endfile THEN
B39 383 BEGIN
384 end_of_file:= TRUE; erase_address;
E39 385 END ELSE
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 21
DSK:ADRES.SIM 20-FEB- 1977 19:00
386
387
B40 388 BEGIN
389 count_input;
390 again:
391 WHILE NOT endfile AND number_of_lines <= in_dimension DO
B41 392 BEGIN
393 image:- line[number_of_lines];
394 inimage; IF endfile THEN image:= NOTEXT;
395 stripline[number_of_lines]:- line[number_of_lines].strip;
396 IF stripline[number_of_lines] == NOTEXT AND
397 number_of_lines
398 > 1 THEN GOTO again;
399 stripline[number_of_lines].setpos(stripline[
400 number_of_lines
401 ].length);
402 IF number_of_lines > 1 THEN
403 WHILE stripline[number_of_lines].length >
404 label_width DO divide_line;
405 IF (IF stripline[number_of_lines] = NOTEXT THEN ' ' ELSE
406 stripline[number_of_lines].getchar) = formfeed THEN
B42 407 BEGIN COMMENT end of address;
408 stripline[number_of_lines]:-
409 stripline[number_of_lines].sub(1,
410 stripline[number_of_lines].length-1);
411 IF stripline[number_of_lines] = NOTEXT THEN
412 number_of_lines:= number_of_lines-1;
413 GOTO out;
E42 414 END;
415 number_of_lines:= number_of_lines+1;
E41 416 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 22
DSK:ADRES.SIM 20-FEB- 1977 19:00
417
418
419 IF endfile THEN number_of_lines:= number_of_lines-1;
420 IF number_of_lines > in_dimension THEN
B43 421 BEGIN
422 too_many_lines; GOTO top;
E43 423 END;
424 out: IF number_of_lines <= 1 THEN
B44 425 BEGIN IF endfile or count_of_input = 1 THEN
426 count_of_input:= count_of_input-1 ELSE
B45 427 BEGIN
428 number_of_lines:= 10;
429 error("No text in address after or at:");
E45 430 END;
431 GOTO top;
E44 432 END;
433 IF select_output THEN
B46 434 BEGIN IF NOT select_this_address THEN GOTO top;
E46 435 END;
E40 436 END;
E38 437 END of read_an_address;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 23
DSK:ADRES.SIM 20-FEB- 1977 19:00
438
439
440 PROCEDURE count_input;
B47 441 BEGIN
442 count_of_input:= count_of_input+1;
443 IF mod(count_of_input,10) = 0 AND sysout =/= outfileref THEN
B48 444 BEGIN sysout.outchar('.'); sysout.breakoutimage;
E48 445 END;
E47 446 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 24
DSK:ADRES.SIM 20-FEB- 1977 19:00
447
448
449 BOOLEAN PROCEDURE reformat_first_algorithm;
B49 450 BEGIN
451 INTEGER firstno, secondno;
452 reformat_first_algorithm:= TRUE;
453 WHILE number_of_lines > lastline DO
B50 454 BEGIN
455 firstno:= 2; secondno:= 3;
456 FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
B51 457 BEGIN
458 while stripline[secondno] == NOTEXT DO
459 secondno:= secondno+1;
460 IF stripline[firstno].length +
461 stripline[secondno].length + 2 < label_width THEN
B52 462 BEGIN
463 mainline:- line[firstno];
464 mainline.setpos(stripline[firstno].length+1);
465 puttext(mainline,", ");
466 puttext(mainline,stripline[secondno]);
467 stripline[firstno]:- mainline.strip;
468 stripline[secondno]:- NOTEXT;
469 number_of_lines:= number_of_lines-1;
470 GOTO compressmore;
E52 471 END;
472 firstno:= secondno; secondno:= firstno+1;
E51 473 END;
474 reformat_first_algorithm:= FALSE; GOTO out;
475 compressmore:
E50 476 END;
477 out: secondno:= 3;
478 FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
B53 479 BEGIN
480 WHILE stripline[secondno] == NOTEXT
481 DO secondno:= secondno+1;
482 stripline[line_number]:- stripline[secondno];
483 secondno:= secondno+1;
E53 484 END;
E49 485 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 25
DSK:ADRES.SIM 20-FEB- 1977 19:00
486
487
488 BOOLEAN PROCEDURE reformat_second_algorithm;
B54 489 BEGIN
490 TEXT rest_of_buffer;
491 rest_of_buffer:- second_alg_buffer;
492 FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
B55 493 BEGIN
494 i:= stripline[line_number].length;
495 IF rest_of_buffer.length <= i THEN GOTO bad;
496 rest_of_buffer:= stripline[line_number];
497 rest_of_buffer:- rest_of_buffer.sub(i+1,
498 rest_of_buffer.length-i);
499 IF rest_of_buffer.length >= 2 AND i < label_width AND
500 line_number < number_of_lines THEN
B56 501 BEGIN
502 rest_of_buffer.sub(1,2):= ", ";
503 rest_of_buffer:- rest_of_buffer.sub(3,
504 rest_of_buffer.length-2);
E56 505 END;
506 IF line_number <= max_number_of_lines+1 THEN
507 stripline[line_number]:- second_alg_buffer.
508 sub(1+(line_number-2)*label_width,label_width);
E55 509 END;
510 number_of_lines:= max_number_of_lines+1;
511 reformat_second_algorithm:= TRUE;
512 bad:
E54 513 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 26
DSK:ADRES.SIM 20-FEB- 1977 19:00
514
515
516 BOOLEAN PROCEDURE can_be_reformatted;
B57 517 BEGIN
518 IF reformat_first_algorithm THEN can_be_reformatted:= TRUE ELSE
519 IF reformat_second_algorithm THEN can_be_reformatted:= TRUE ELSE
520 error("Too much text in this address");
E57 521 END of can_be_reformatted;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 27
DSK:ADRES.SIM 20-FEB- 1977 19:00
522
523
524 PROCEDURE write_line(this_line);
525 TEXT this_line;
526 INSPECT outfileref DO
B58 527 BEGIN
528 outtext(this_line);
529 IF next == first_label THEN
B59 530 BEGIN outimage; IF NOT usetabs THEN setpos(left_margin+1);
E59 531 END ELSE IF usetabs THEN outchar(tab)
532 ELSE setpos(pos+label_spacing-this_line.length);
E58 533 END of write_line;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 28
DSK:ADRES.SIM 20-FEB- 1977 19:00
534
535
536 PROCEDURE output_count;
B60 537 BEGIN
538 count_of_output:= count_of_output+1;
539 IF list_output THEN
B61 540 BEGIN
541 IF mod(count_of_output,page_step) = 1
542 THEN outfileref.outchar(formfeed);
E61 543 END;
E60 544 END of output_count;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 29
DSK:ADRES.SIM 20-FEB- 1977 19:00
545
546
E28 547 END of label_operations;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 30
DSK:ADRES.SIM 20-FEB- 1977 19:00
548
549
550 label_operations CLASS label_address;
B62 551 BEGIN
552 detach; WHILE TRUE DO
B63 553 BEGIN
554 nextin: read_an_address;
555 IF NOT can_be_reformatted AND NOT end_of_file THEN GOTO nextin;
556 IF THIS label_address == first_label AND end_of_file THEN detach
557 ELSE IF labels_per_width > 1 THEN resume(next);
558 IF NOT erased_address THEN output_count;
559 FOR line_number:= 2 STEP 1 UNTIL lastlinep1 DO
B64 560 BEGIN
561 write_line(IF line_number <= number_of_lines THEN
562 stripline[line_number] ELSE NOTEXT);
563 IF labels_per_width > 1 THEN resume(next);
E64 564 END of for loop;
E63 565 END of while loop;
E62 566 END of label_address;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 31
DSK:ADRES.SIM 20-FEB- 1977 19:00
567
568
569 label_operations CLASS file_address;
B65 570 BEGIN
571 TEXT line1m1;
572 line1m1:- line[1].main.sub(5,line1_length+1);
573 detach; WHILE TRUE DO
B66 574 BEGIN
575 nextin: read_an_address;
576 IF end_of_file THEN detach;
577 IF NOT erased_address THEN INSPECT outfileref DO
B67 578 BEGIN
579 count_of_output:= count_of_output+1;
580 IF count_of_output = 1 THEN image:- line[1] ELSE
B68 581 BEGIN image:- line1m1; image.putchar(formfeed);
E68 582 END;
583 outimage;
584 FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
B69 585 BEGIN
586 image:- stripline[line_number]; outimage;
E69 587 END of for loop;
E67 588 END of inspect;
E66 589 END of while loop;
E65 590 END of label_address;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 32
DSK:ADRES.SIM 20-FEB- 1977 19:00
591
592
593 label_operations CLASS asort_address;
B70 594 BEGIN
595 TEXT line1m1;
596 line1m1:- line[1].main.sub(5,line1_length+1);
597 infileref.image:- sort_buffer;
598 detach; WHILE TRUE DO
B71 599 BEGIN
600 nextin: infileref.inimage;
601 IF infileref.endfile THEN detach;
602 count_input;
603 IF NOT erased_address THEN INSPECT outfileref DO
B72 604 BEGIN
605 count_of_output:= count_of_output+1;
606 IF count_of_output = 1 THEN image:- line[1] ELSE
B73 607 BEGIN image:- line1m1; image.putchar(formfeed);
E73 608 END;
609 outimage;
610 FOR line_number:= 2 STEP 1 UNTIL line_dimension DO
B74 611 BEGIN
612 image:- line[line_number].strip;
613 IF image = NOTEXT THEN GOTO out;
614 outimage;
E74 615 END of for loop;
616 out:
E72 617 END of inspect;
E71 618 END of while loop;
E70 619 END of asort_address;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 33
DSK:ADRES.SIM 20-FEB- 1977 19:00
620
621
622 label_operations CLASS presort_address;
B75 623 BEGIN
624 detach; WHILE TRUE DO
B76 625 BEGIN
626 nextin: read_an_address;
627 IF end_of_file THEN detach;
628 IF NOT erased_address THEN INSPECT outfileref DO
B77 629 BEGIN
630 count_of_output:= count_of_output+1;
631 image:- sort_buffer.strip;
632 IF image.sub(image.length,1).getchar=formfeed THEN
B78 633 BEGIN image.sub(image.length,1).putchar(' ');
634 image:- image.sub(1,image.length-1);
E78 635 END;
636 IF sortlength < image.length THEN sortlength:= image.length;
637 outimage;
E77 638 END of inspect;
E76 639 END of while loop;
E75 640 END of label_address;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 34
DSK:ADRES.SIM 20-FEB- 1977 19:00
641
642
643 PROCEDURE create_labels;
B79 644 BEGIN
645 INTEGER label_no;
646 first_label:- NONE;
647 FOR label_no:= 1 STEP 1 UNTIL labels_per_width DO
648 IF file_output THEN NEW file_address ELSE
649 IF presort_output THEN NEW presort_address ELSE
650 IF asort_output THEN NEW asort_address ELSE
651 NEW label_address;
E79 652 END of create_labels;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 35
DSK:ADRES.SIM 20-FEB- 1977 19:00
653
654
655 PROCEDURE set_tab_settings_on_the_terminal;
656 INSPECT outfileref DO
B80 657 BEGIN
658 outtext(motoron); outtext(removetabs); outimage;
659 setpos(pos+left_margin); outtext(settab);
660 FOR i:= 2 STEP 1 UNTIL labels_per_width DO
B81 661 BEGIN
662 setpos(pos+label_spacing); outtext(settab);
E81 663 END;
E80 664 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 36
DSK:ADRES.SIM 20-FEB- 1977 19:00
665
666
667 PROCEDURE open_files;
B82 668 BEGIN
669 infileref.open(blanks(80));
670 IF outfileref =/= sysout and label_output then
B83 671 BEGIN
672 outtext("You must do .TTY NO CRLF");
673 if usetabs then
674 outtext(" and perhaps .TTY TABS");
675 outimage;
676 outtext("on the output terminal"); outimage;
677 outtext("if different from this terminal"); outimage;
E83 678 END;
679 IF outfileref =/= sysout THEN outfileref.open(blanks(132));
680 IF file_output THEN
B84 681 BEGIN outfileref.outchar(formfeed);
682 outfileref.breakoutimage;
E84 683 END ELSE
684 IF label_output OR list_output THEN
B85 685 BEGIN
686 IF usetabs THEN set_tab_settings_on_the_terminal
687 ELSE outfileref.outimage;
688 FOR i:= 2 STEP 1 UNTIL max_number_of_lines DO
689 outfileref.outimage;
690 IF NOT usetabs THEN outfileref.setpos(left_margin+1);
E85 691 END;
E82 692 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 37
DSK:ADRES.SIM 20-FEB- 1977 19:00
693
694
695 PROCEDURE close_files;
696 INSPECT outfileref DO
B86 697 BEGIN
698 infileref.close;
699 IF label_output THEN
B87 700 BEGIN
701 outfileref.outimage;
E87 702 END;
703 IF usetabs THEN
B88 704 BEGIN outtext(motoroff); outimage;
E88 705 END;
706 IF outfileref =/= sysout THEN close;
E86 707 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 38
DSK:ADRES.SIM 20-FEB- 1977 19:00
708
709
710 PROCEDURE initialize_constants;
B89 711 BEGIN
712 trmop(8r2010,sysout,1); ! .TTY NO CRLF;
713 blanktext:- blanks(132);
714 altmode:= char(27); formfeed:= char(12); tab:= char(9);
715 motoron:- copy(" h"); motoroff:- copy(" j");
716 removetabs:- copy(" 2"); settab:- copy(" 1");
717 motoron.putchar(altmode); motoroff.putchar(altmode);
718 removetabs.putchar(altmode); settab.putchar(altmode);
719 linesperpage(-1);
E89 720 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 39
DSK:ADRES.SIM 20-FEB- 1977 19:00
721
722
723 PROCEDURE countprint(t,count);
724 NAME t; TEXT t; INTEGER count;
B90 725 BEGIN
726 outtext(t); outint(count,5);
E90 727 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 40
DSK:ADRES.SIM 20-FEB- 1977 19:00
728
729
730 PROCEDURE message_end_of_processing;
B91 731 BEGIN
732 dotypeout(sysout); outimage;
733 outline("[ADRES processing is ready.]");
734 countprint("LABELS IN: ",count_of_input);
735 countprint(" LABELS OUT: ",count_of_output);
736 IF count_of_error > 0 THEN
B92 737 BEGIN
738 countprint(" UNACCEPTABLE LABELS IN: ",count_of_error);
E92 739 END;
740 outimage;
741 IF select_output THEN
B93 742 BEGIN
743 countprint(
744 "NUMBER OF LABELS REJECTED BECAUSE OF SELECTION CRITERIA: "
745 ,count_of_rejected); outimage;
E93 746 END;
747 IF presort_output THEN
B94 748 BEGIN
749 countprint("MINIMUM RECORD SIZE FOR SORTING: ",sortlength);
750 outimage;
E94 751 END;
E91 752 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 41
DSK:ADRES.SIM 20-FEB- 1977 19:00
753
754
755 initialize_constants;
756 WHILE TRUE DO
B95 757 BEGIN
758 read_input_command;
759 open_files;
760 create_labels;
761 resume(first_label);
762 close_files;
763 message_end_of_processing;
E95 764 END of input_command_loop;
E4 765 END of select block;
E3 766 END of decom block;
E1 767 quit: END of the whole program;
DEFAULT SWITCHES USED
NO ERRORS DETECTED