1 /* -table ted_gv_t_.incl.pl1
  2 -tl
  3 -sem ted_gv_.incl.pl1
  4 -parse */
  5 sem: proc(rulen,altn);
  6 
  7 dcl rulen           fixed bin,
  8     altn            fixed bin;
  9 
 10       goto rule(rulen);
 11 
 12 define: proc(where,which);
 13 
 14 dcl where           fixed bin,          /* where thread begins */
 15     which           fixed bin;          /* defined value */
 16 dcl i               fixed bin;
 17 dcl j               fixed bin;
 18 
 19       i = where;
 20       do while(i ^= 0);
 21          j = gvx.word (i);
 22          if db_gv then call ioa_$nnl ("^/^-define(^2i)=^i", i, which);
 23          gvx.word (i) = which;
 24          i = j;
 25       end;
 26 
 27    end define;%skip(3);
 28 thread: proc(where,which);
 29 dcl (where,which) fixed bin;
 30 
 31       do i = where
 32          repeat(gvx.word (i))
 33          while(gvx.word (i)^=0);
 34       end;
 35       if db_gv then call ioa_ ("^-thread(^2i)=^i", i, which);
 36       gvx.word (i) = which;
 37    end thread;%skip(3);
 38 /* <lex_order>      ::= g* v* ( ^ '| & ) '040 X ! */
 39 
 40 /* <gv>   ::= <rest> ! */
 41 
 42 /* <rest> ::= g* <srch> '040 ! */
 43 rule(0003):                             /* inclusive search                  */
 44 /****                bring the TRUE thread to here                           */
 45       if db_gv then call show_stk (2);
 46 /****      call define(ls.true(ls_top-1), gvx.tot_len+4);                    */
 47       call define(ls.true(ls_top-1), ls.loc (ls_top));
 48 /****                Make False thread fail                                  */
 49       call define(ls.false(ls_top-1),0);
 50 
 51 /* <rest> ::= g* '040 ! */
 52 rule(0004):                             /* no search needed                  */
 53       goto done_parse;
 54 
 55 /* <rest> ::= v* <srch> '040 ! */
 56 rule(0005):                             /* exclusive search wanted           */
 57       if db_gv then call show_stk(2);
 58 /****                Make TRUE thread fail                                   */
 59       call define(ls.true(ls_top-1),0);
 60 /****                bring FALSE thread to here                              */
 61 /****      call define(ls.false(ls_top-1),gvx.tot_len+5);                    */
 62       call define(ls.false(ls_top-1),ls.loc(ls_top));
 63       goto done_parse;
 64 
 65 show_stk: proc (N);
 66 dcl N               fixed bin;
 67 dcl db_I            fixed bin;
 68           do db_I = ls_top-N to ls_top;
 69              call ioa_$nnl ("^/^2i loc=^i^-true=^i^-false=^i", db_I, ls.loc (db_I),
 70                 ls.true (db_I), ls.false (db_I));
 71           end;
 72        end show_stk;
 73 
 74 /* <srch> ::= <srch> '| <y> ! */
 75 rule(0006):
 76 /****               bring <srch> false thread to <y>                         */
 77       if db_gv then call show_stk (2);
 78       call define(ls.false(ls_top-2),ls.loc(ls_top));
 79 /****               thread <srch> true onto <y> true list                    */
 80       call thread(ls.true(ls_top), ls.true(ls_top-2));
 81       ls.true(ls_top-2) = ls.true(ls_top);
 82       ls.false(ls_top-2) = ls.false(ls_top);
 83       return;
 84 
 85 /* <srch> ::= <y> ! */
 86 /* <y>    ::= <y> & <z> ! */
 87 rule(0008):
 88       if db_gv then call show_stk (2);
 89 /****                bring <y> true thread to <z>                            */
 90           call define(ls.true(ls_top-2),ls.loc(ls_top));
 91 /****                thread <y> false onto <z> false list                    */
 92           call thread(ls.false(ls_top), ls.false(ls_top-2));
 93           ls.true(ls_top-2) = ls.true(ls_top);
 94           ls.false(ls_top-2) = ls.false(ls_top);
 95           return;
 96 
 97 /* <y>    ::= <z> ! */
 98 /* <z>    ::= ^ <w> ! */
 99 rule(0010):
100 /****               just reverse the threads on the entry                    */
101           ls(ls_top-1) = ls(ls_top);
102           ls.true(ls_top-1) = ls.false(ls_top);
103           ls.false(ls_top-1) = ls.true(ls_top);
104           return;
105 
106 /* <z>    ::= <w> ! */
107 /* <w>    ::= X ! */
108 
109 /* <w>    ::= ( <srch> ) ! */
110 rule(0013):
111 /****               pull the entry out from the parens                       */
112           ls(ls_top-2) = ls(ls_top-1);
113           return;
114 
115 end;