1 /* START OF:        rdc_delete_.incl.pl1                      *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  2 
  3           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  4           /*                                                                                        */
  5           /* N^H__^Ha_^Hm_^He:  rdc_delete_.incl.pl1                                                          */
  6           /*                                                                                        */
  7           /*      This include segment is used by compilers generated by the reduction_compiler.    */
  8           /* It defines a procedure which the compilers can use to delete tokens from their list of */
  9           /* input tokens.                                                                          */
 10           /*                                                                                        */
 11           /* E^H__^Hn_^Ht_^Hr_^Hy:  DELETE                                                                              */
 12           /*                                                                                        */
 13           /*      DELETE removes the input tokens identified by the starting and ending number      */
 14           /* arguments from the list of input tokens.                                               */
 15           /*                                                                                        */
 16           /* U^H__^Hs_^Ha_^Hg_^He                                                                                       */
 17           /*                                                                                        */
 18           /*      call DELETE (start, end);                                                         */
 19           /*                                                                                        */
 20           /* 1) start    is the number relative to the token identified by Pthis_token of the first */
 21           /*             token to be removed from the list. (In)                                    */
 22           /* 2) end      is the number relative to the token identified by Pthis_token of the last  */
 23           /*             token to be removed from the list. (In)                                    */
 24           /*                                                                                        */
 25           /* N^H__^Ho_^Ht_^He_^Hs                                                                                       */
 26           /*                                                                                        */
 27           /*      The token identified by Pthis_token is regarded as token number 0.  Tokens        */
 28           /* which precede it have negative numbers, and those which follow have positive numbers.  */
 29           /*                                                                                        */
 30           /*      If the token identified by Pthis_token is one of those which are deleted, then    */
 31           /* the first token in the list following those which have been deleted will be identified */
 32           /* by Pthis_token.  If in 'PUSH DOWN LANGUAGE' mode and there are no tokens following     */
 33           /* those which have been deleted, then the first token preceding those which have been    */
 34           /* deleted will be indentified by Pthis_token.                                            */
 35           /*                                                                                        */
 36           /*      Note that DELETE(0,0) in 'PUSH DOWN LANGUAGE' mode has the effect of popping the  */
 37           /* token off the top of the stack, and pushing a new token onto the stack in its place.   */
 38           /*                                                                                        */
 39           /* S^H__^Ht_^Ha_^Ht_^Hu_^Hs                                                                                   */
 40           /*                                                                                        */
 41           /* 0) Created by:  G. C. Dixon  in  February, 1975.                                       */
 42           /*                                                                                        */
 43           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 44 
 45 
 46 DELETE:   procedure (Astart, Aend);
 47 
 48      dcl (Astart, Aend)                 fixed bin;
 49 
 50      dcl (start, end)                   fixed bin;          /* copies of our input arguments.                 */
 51 ^L
 52           if Pthis_token = null then return;                /* If input list already exhausted, cannot delete.*/
 53           if Astart > Aend then do;                         /* reverse input args if backwards.               */
 54                start = Aend;
 55                end   = Astart;
 56                end;
 57           else do;
 58                start = Astart;
 59                end   = Aend;
 60                end;
 61           Ptoken = Pthis_token;                             /* make sure these pointers are the same.         */
 62 
 63           if start > 0 then call delete_positive (start, end);
 64                                                             /* deleted tokens all follow Pthis_token.         */
 65           else if end < 0 then call delete_negative (start, end);
 66                                                             /* deleted tokens all precede Pthis_token.        */
 67           else do;                                          /* deleted tokens include Pthis_token.            */
 68                if start < 0 then call delete_negative (start, -1);
 69                                                             /* first, delete those which precede Pthis_token. */
 70                if end > 0 then call delete_positive (1, end);
 71                                                             /* then, delete those which follow Pthis_token.   */
 72                if token.Pnext = null then                   /* if no more tokens follow Pthis_token,          */
 73                     if SPDL then                            /*   and in 'PUSH DOWN LANGUAGE' mode,            */
 74                          if token.Plast = null then         /*   and no more tokens precede Pthis_token,      */
 75                               Ptoken = null;                /*   then all tokens have been deleted.           */
 76                          else do;
 77                               Ptoken = token.Plast;         /*   else still tokens on stack.  2nd top of stack*/
 78                               token.Pnext = null;           /*   becomes top, and old top is deleted.         */
 79                               end;
 80                     else Ptoken = null;                     /*   not in 'PUSH DOWN LANGUAGE' mode; remaining  */
 81                                                             /*   tokens have been deleted.                    */
 82                else do;                                     /* if there is a following token, make it be      */
 83                     Ptoken = token.Pnext;                   /*   identified by Pthis_token, and delete the    */
 84                     call delete_negative (-1, -1);          /*   old Pthis_token.                             */
 85                     end;
 86                Pthis_token = Ptoken;
 87                end;
 88           return;
 89 
 90 
 91 delete_positive:    procedure (start, end);                 /* This entry deletes tokens following Pthis_token*/
 92 
 93           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 94           /*                                                                                        */
 95           /* The procedure below handles deletion of tokens which precede and follow Pthis_token    */
 96           /* in the same way by mapping the starting and ending token numbers into an inner and     */
 97           /* outer token number, as shown below.                                                    */
 98           /*                                                                                        */
 99           /*        N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ -> N^HZ    */
100           /*                                           A^H|                                         */
101           /*                                           |                                            */
102           /*             A^H|              A^H|         Pthis_token    A^H|                        A^H|       */
103           /*             |              |                        |                        |         */
104           /*           start           end                     start                     end        */
105           /*           outer          inner                    inner                    outer       */
106           /*                                                                                        */
107           /* This mapping allows preceding and following tokens to be deleted in the same way.      */
108           /*                                                                                        */
109           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
110 
111 
112      dcl (start, end)                   fixed bin;
113 
114      dcl  1 token                       based,              /* overlay for token converting token.Pnext/last  */
115             2 pad                       fixed bin,          /*   to a 2-element pointer array.                */
116             2 P (1:2)                   ptr unaligned,
117          (Pinner, Pouter)               ptr,                /* pointers to inner/outer tokens.                */
118          ( inner,  outer)               fixed bin,          /* #s of inner/outer tokens (wrt Pthis_token)     */
119          (    in,  out  )               fixed bin,          /* elements of token.P for next inner/outer token */
120           direction                     fixed bin,          /* increment added to inner # to reach outer #.   */
121           i                             fixed bin;          /* a do-group index.                              */
122           inner = start;      outer = end;
123              in = 2;            out = 1;
124                     direction = +1;
125 
126           go to common;
127 
128 delete_negative:    entry (start, end);                     /* This entry deletes tokens preceding Pthis_token*/
129 
130           inner = end;        outer = start;
131              in = 1;            out = 2;
132                     direction = -1;
133 
134 common:   Pinner = Ptoken;                                  /* start at Pthis_token.                          */
135           do i = direction to inner by direction while (Pinner ^= null);
136                Pinner = Pinner -> token.P(out);             /* work out from Pthis_token until inner token is */
137                end;                                         /*   found.                                       */
138           if Pinner ^= null then do;                        /* if inner token doesn't exist, nothing to delete*/
139                Pouter = Pinner;                             /* starting at inner token, work out to outer one.*/
140                do i = inner+direction to outer by direction while (Pouter ^= null);
141                     Pouter = Pouter -> token.P(out);
142                     end;
143                if Pouter = null then                        /* if outer token not found, delete all tokens    */
144                                                             /*   from inner one to outer-most.                */
145                     Pinner -> token.P(in) -> token.P(out) = null;
146                else do;                                     /* otherwise, delete inner to outer token.        */
147                     Pinner -> token.P(in) -> token.P(out) = Pouter -> token.P(out);
148                     if Pouter -> token.P(out) ^= null then
149                          Pouter -> token.P(out) -> token.P(in) = Pinner -> token.P(in);
150                     end;
151                end;
152 
153           end delete_positive;
154 
155           end DELETE;
156 
157 /* END OF:          rdc_delete_.incl.pl1                      *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */