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