Google
 

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