Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0109/select.lst
There is 1 other file named select.lst in the archive. Click here to see a list.
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 1
DSK:SELECT.SIM 1-MAR- 1976 19:00
1 OPTIONS(/l);
2 COMMENT SELECT --- Boolean search conditions on text files;
3 OPTIONS(/-A/-D/-Q/-I);
4 OPTIONS(/L/P/E);
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 2
DSK:SELECT.SIM 1-MAR- 1976 19:00
5 EXTERNAL TEXT PROCEDURE rest, upcase;
6 EXTERNAL TEXT PROCEDURE scanto, from, conc;
7 EXTERNAL CHARACTER PROCEDURE findtrigger;
8 EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext;
9 EXTERNAL INTEGER PROCEDURE scanint, search;
10 CLASS select;
11 NOT HIDDEN PROTECTED line, linecopy_buffer, operator,
12 set_operator_characters,
13 build_condition, tree_print, line_scan, array_scan,
14 select_errmess;
B1 15 BEGIN
16 CHARACTER char0, and_char, or_char, not_char;
17 CHARACTER left_parenthesis, right_parenthesis;
18 TEXT op_chars, select_errmess, linecopy_buffer, line;
19 TEXT ARRAY line_array[1:10]; INTEGER la_index, la_max;
20 BOOLEAN array_search;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 3
DSK:SELECT.SIM 1-MAR- 1976 19:00
21
22 PROCEDURE set_operator_characters(t);
23 VALUE t; TEXT t;
B2 24 BEGIN
25 op_chars:- t;
26 and_char:= t.getchar;
27 or_char:= t.getchar;
28 not_char:= t.getchar;
29 left_parenthesis:= t.getchar;
30 right_parenthesis:= t.getchar;
E2 31 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 4
DSK:SELECT.SIM 1-MAR- 1976 19:00
32
33
34 CLASS operator(word);
35 VALUE word; TEXT word;
B3 36 BEGIN
37 BOOLEAN found, caseshift;
38 loop:
39 detach; INNER;
40 GOTO loop;
E3 41 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 5
DSK:SELECT.SIM 1-MAR- 1976 19:00
42
43
44 operator CLASS search_operator;
B4 45 BEGIN
46 IF array_search THEN
B5 47 BEGIN
48 found:= FALSE;
49 FOR la_index:= 1 STEP 1 UNTIL la_max DO
B6 50 BEGIN
51 line:- line_array[la_index]; line.setpos(1);
52 IF search(line,word) <
53 line.length THEN GOTO good;
E6 54 END;
55 IF FALSE THEN good: found:= TRUE;
E5 56 END ELSE
B7 57 BEGIN
58 line.setpos(1);
59 found:= search(line,word) < line.length;
E7 60 END;
E4 61 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 6
DSK:SELECT.SIM 1-MAR- 1976 19:00
62
63
64 operator CLASS and_operator(left, right);
65 REF (operator) left, right;
B8 66 BEGIN
67 call(left);
68 IF left.found THEN
B9 69 BEGIN call(right);
70 found:= right.found;
E9 71 END ELSE found:= FALSE;
E8 72 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 7
DSK:SELECT.SIM 1-MAR- 1976 19:00
73
74
75 operator CLASS or_operator(left, right);
76 REF (operator) left, right;
B10 77 BEGIN
78 call(left);
79 IF left.found THEN found:= TRUE ELSE
B11 80 BEGIN call(right);
81 found:= right.found;
E11 82 END;
E10 83 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 8
DSK:SELECT.SIM 1-MAR- 1976 19:00
84
85
86 operator CLASS not_operator(below);
87 REF (operator) below;
B12 88 BEGIN
89 call(below); found:= NOT below.found;
E12 90 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 9
DSK:SELECT.SIM 1-MAR- 1976 19:00
91
92
93 BOOLEAN PROCEDURE build_condition(selection_tree,selector,
94 caseshift);
95 NAME selection_tree; VALUE selector;
96 REF (operator) selection_tree; TEXT selector;
97 BOOLEAN caseshift;
B13 98 BEGIN
99 REF (operator) largest_tree;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 10
DSK:SELECT.SIM 1-MAR- 1976 19:00
100
101 REF (operator) PROCEDURE interpret(selector,restrictor);
102 TEXT selector; INTEGER restrictor;
B14 103 BEGIN
104 REF (operator) result, below, left, right;
105 CHARACTER firstchar;
106 IF selector = NOTEXT THEN GOTO out;
107 selector.setpos(1);
108 firstchar:= selector.getchar;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 11
DSK:SELECT.SIM 1-MAR- 1976 19:00
109
110 IF restrictor < 1 THEN
B15 111 BEGIN
112 selector.setpos(1);
113 scanto(selector,or_char); WHILE selector.more DO
B16 114 BEGIN
115 left:- interpret(selector.sub(1,selector.pos-2),1);
116 IF left =/= NONE THEN
B17 117 BEGIN
118 right:- interpret(selector.sub(selector.pos,
119 selector.length-selector.pos+1),0);
120 IF right =/= NONE THEN
B18 121 BEGIN result:- NEW or_operator(selector,left,
122 right); GOTO out;
E18 123 END;
E17 124 END;
125 scanto(selector,or_char);
E16 126 END;
E15 127 END of or operator interpretation;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 12
DSK:SELECT.SIM 1-MAR- 1976 19:00
128
129 IF restrictor < 2 THEN
B19 130 BEGIN
131 selector.setpos(1);
132 scanto(selector,and_char); WHILE selector.more DO
B20 133 BEGIN
134 left:- interpret(selector.sub(1,selector.pos-2),2);
135 IF left =/= NONE THEN
B21 136 BEGIN
137 right:- interpret(selector.sub(selector.pos,
138 selector.length-selector.pos+1),0);
139 IF right =/= NONE THEN
B22 140 BEGIN result:- NEW and_operator(selector,left,
141 right); GOTO out;
E22 142 END;
E21 143 END;
144 scanto(selector,and_char);
E20 145 END;
E19 146 END of and operator interpretation;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 13
DSK:SELECT.SIM 1-MAR- 1976 19:00
147
148 IF firstchar = left_parenthesis THEN
B23 149 BEGIN
150 selector.setpos(selector.length);
151 IF selector.getchar = right_parenthesis THEN
B24 152 BEGIN result:- interpret(selector.sub(2,
153 selector.length-2),0);
154 GOTO out;
E24 155 END;
E23 156 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 14
DSK:SELECT.SIM 1-MAR- 1976 19:00
157
158 IF firstchar = not_char THEN
B25 159 BEGIN
160 below:- interpret(selector.sub(2,selector.length-1),
161 0);
162 IF below =/= NONE THEN result:- NEW
163 not_operator(selector,below);
164 GOTO out;
E25 165 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 15
DSK:SELECT.SIM 1-MAR- 1976 19:00
166
167 selector.setpos(1);
168 IF findtrigger(selector,op_chars) = char0 THEN
169 result:- NEW search_operator(selector);
170 out: interpret:- result;
171 IF (IF result == NONE THEN FALSE
172 ELSE IF largest_tree == NONE THEN TRUE
173 ELSE result.word.length >= largest_tree.word.length)
174 THEN largest_tree:- result;
E14 175 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 16
DSK:SELECT.SIM 1-MAR- 1976 19:00
176
177 IF caseshift THEN upcase(selector);
178 selection_tree:- interpret(selector,0);
179 IF selection_tree == NONE AND selector =/= NOTEXT
180 THEN select_errmess:- conc(
181 "?SELECT - Syntax error",
182 IF largest_tree =/= NONE THEN conc(" after: ",
183 largest_tree.word) ELSE NOTEXT)
184 ELSE build_condition:= TRUE;
185 IF selection_tree == NONE THEN selection_tree:-
186 largest_tree;
187 IF selection_tree =/= NONE AND caseshift THEN
188 selection_tree.caseshift:= TRUE;
E13 189 END of procedure build_condition;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 17
DSK:SELECT.SIM 1-MAR- 1976 19:00
190
191
192 PROCEDURE tree_print(top);
193 REF (operator) top;
194 INSPECT top WHEN search_operator DO outtext(word)
195 WHEN not_operator DO
B26 196 BEGIN outchar(left_parenthesis); outchar(not_char);
197 tree_print(below); outchar(right_parenthesis);
E26 198 END WHEN and_operator DO
B27 199 BEGIN outchar(left_parenthesis); tree_print(left);
200 outchar(and_char);
201 tree_print(right);
202 outchar(right_parenthesis);
E27 203 END WHEN or_operator DO
B28 204 BEGIN outchar(left_parenthesis); tree_print(left);
205 outchar(or_char);
206 tree_print(right);
207 outchar(right_parenthesis);
E28 208 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 18
DSK:SELECT.SIM 1-MAR- 1976 19:00
209 BOOLEAN PROCEDURE line_scan(selection_tree,inline);
210 REF (operator) selection_tree; TEXT inline;
B29 211 BEGIN
212 IF selection_tree == NONE THEN GOTO yes;
213 IF inline =/= NOTEXT THEN
B30 214 BEGIN
215 IF selection_tree.caseshift THEN
B31 216 BEGIN
217 IF inline.length > linecopy_buffer.length THEN
218 linecopy_buffer:- blanks(inline.length+15);
219 line:- linecopy_buffer.sub(1,inline.length);
220 line:= inline;
221 upcase(line);
E31 222 END ELSE line:- inline;
223 array_search:= FALSE;
224 call(selection_tree);
225 IF selection_tree.found THEN GOTO yes;
E30 226 END;
227 IF FALSE THEN yes: line_scan:= TRUE;
E29 228 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 19
DSK:SELECT.SIM 1-MAR- 1976 19:00
229 BOOLEAN PROCEDURE array_scan(selection_tree,lines,i1,i2);
230 REF (operator) selection_tree; TEXT ARRAY lines;
231 INTEGER i1, i2;
B32 232 BEGIN
233 INTEGER i, totallength;
234 IF selection_tree == NONE THEN GOTO yes;
235 FOR i:= i1 STEP 1 UNTIL i2 DO
236 totallength:= totallength+lines(i).length;
237 IF totallength > 0 THEN
B33 238 BEGIN
239 array_search:= NOT (selection_tree.caseshift OR i2-i1 >
240 9);
241 IF array_search THEN
B34 242 BEGIN
243 la_max:= 0;
244 FOR i:= i1 STEP 1 UNTIL i2 DO
245 IF lines[i] =/= NOTEXT THEN
B35 246 BEGIN
247 la_max:= la_max+1; line_array[la_max]:- lines[i];
E35 248 END;
E34 249 END ELSE
B36 250 BEGIN
251 totallength:= totallength+i2-i1+1;
252 IF totallength > linecopy_buffer.length THEN
253 linecopy_buffer:- blanks(totallength+15*(i2-i1+1));
254 line:- linecopy_buffer.sub(1,totallength);
255 FOR i:= i1 STEP 1 UNTIL i2 DO
B37 256 BEGIN puttext(line,lines(i)); line.putchar(char0);
E37 257 END;
258 IF selection_tree.caseshift THEN upcase(line);
E36 259 END;
260 call(selection_tree);
261 IF selection_tree.found THEN GOTO yes;
E33 262 END;
263 IF FALSE THEN yes: array_scan:= TRUE;
E32 264 END;
DECsystem-20 SIMULA %4A(310) 1-FEB- 1981 14:50 PAGE 20
DSK:SELECT.SIM 1-MAR- 1976 19:00
265
266
267 set_operator_characters("&+-()");
E1 268 END of select class;
SWITCHES CHANGED FROM DEFAULT:
-A NO CHECK OF ARRAY INDEX
-D NO SYMBOL TABLE GENERATED FOR DEBUG
E EXTERNAL CLASS/PROCEDURE
-I NO LINENUMBER TABLE GENERATED
-Q NO CHECK OF QUALIFICATION
NO ERRORS DETECTED