1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1989   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Bull Inc., 1988                *
   6         *                                                         *
   7         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   8         *                                                         *
   9         * Copyright (c) 1972 by Massachusetts Institute of        *
  10         * Technology and Honeywell Information Systems, Inc.      *
  11         *                                                         *
  12         *********************************************************** */
  13 
  14 
  15 
  16 /****^  HISTORY COMMENTS:
  17   1) change(88-08-03,RWaters), approve(88-08-03,MCR7950), audit(88-09-29,Huen),
  18      install(88-10-07,MR12.2-1146):
  19      Bug fixes for MR12.2.
  20   2) change(89-03-29,Huen), approve(89-03-29,MCR8062), audit(89-04-25,JRGray),
  21      install(89-05-02,MR12.3-1037):
  22      Fix bug 205: Modify ted not to complain that "." is undefined unless there
  23      is an attempt to reference it.
  24                                                    END HISTORY COMMENTS */
  25 
  26 
  27 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16            */
  28 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
  29 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
  30 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */
  31 
  32 /*                                                                           */
  33 /*   _|_              |             |      |                                 */
  34 /*    |      _      _ |   ___     _ |    _ |    _                            */
  35 /*    |     / \    / \|   ___\   / \|   / \|  |/ \                           */
  36 /*    |    (__/   (   |  /   |  (   |  (   |  |                              */
  37 /*    \_    \_/    \_/|  \__/|   \_/|   \_/|  |                              */
  38 /*                                                   -----                   */
  39 /*                                                                           */
  40 
  41 /* tedaddr_ .......... subroutine to find address portion of ted request    */
  42 /*  and locate addressed line in buffer                                      */
  43 
  44 /**** <<<<----- dcl_tedaddr_.incl.pl1 tedaddr_                               */
  45 tedaddr_:                               /* process request addresses         */
  46    proc (adb_p, ain_p, ain_l, abp, msg, acode);
  47 dcl (
  48     adb_p           ptr,                /* -> database                       */
  49     ain_p           ptr,                /* -> string containing address      */
  50     ain_l           fixed bin (21),     /*   length of it               [IN] */
  51                                         /* If <0 then recursive call         */
  52                                         /*   how much was used up      [OUT] */
  53     abp             ptr,                /* -> buffer control block  [IN/OUT] */
  54     msg             char (168) var,     /* place to hold err message if any  */
  55     acode           fixed bin (35)      /* status code                       */
  56                                         /*   0- null address                 */
  57                                         /*   1- address found                */
  58                                         /*   8- error, msg tells what        */
  59     )               parm;               /* ----->>>>                         */
  60 
  61 /*    req_addr                               request address format          */
  62 /*             ::= {@bufname,}{address}      optional buffer spec            */
  63 /*                                                                           */
  64 /*    address                                basic address format            */
  65 /*             ::= {prefix}...addr                                           */
  66 /*                                                                           */
  67 /*    prefix                                 conditional address process     */
  68 /*             ::= ? gadr ,                    see NOTE 1                    */
  69 /*               | ? gadr ;                    see NOTE 2                    */
  70 /*                                                                           */
  71 /*    addr                                                                   */
  72 /*             ::= gadr                      single address                  */
  73 /*               | gadr , gadr               range, see NOTE 1               */
  74 /*               | gadr ; gadr               range, see NOTE 2               */
  75 /*               | adr ( adr , adr )         byte range, see NOTE 1          */
  76 /*               | adr ( adr ; adr )         byte range, see NOTE 2          */
  77 /*               |   0 ( adr , adr )         buffer range, see NOTE 1        */
  78 /*               |   0 ( adr ; adr )         buffer range, see NOTE 2        */
  79 /*                                                                           */
  80 /*    gadr                                                                   */
  81 /*             ::= adr                       line address                    */
  82 /*               | adr ( adr )               line/byte address               */
  83 /*               |   0 ( adr )               buffer address                  */
  84 /*                                                                           */
  85 /*    adr                                                                    */
  86 /*             ::= num                       absolute line number            */
  87 /*               | num adrr                    with additional parts         */
  88 /*               |     adrr                  (just additional parts)         */
  89 /*                                                                           */
  90 /*    adrr                                   additional parts                */
  91 /*             ::= rel                       relative line number            */
  92 /*               | num                       non-initial number is +rel      */
  93 /*               | fwd                       forward regexp search           */
  94 /*               | bwd                       backward regexp search          */
  95 /*               | .                         curline                         */
  96 /*               | $                         last line                       */
  97 /*               | \l                        enter line mode                 */
  98 /*               | \s                        enter string mode               */
  99 /*                                                                           */
 100 /*    rel                                                                    */
 101 /*             ::= + num                     forward relative                */
 102 /*               | . num                       (same)                        */
 103 /*               | - num                     backward relative               */
 104 /*                                                                           */
 105 /*    fwd                                    forward search                  */
 106 /*             ::= / regexp /                  wrap-around, next line to     */
 107 /*                                             end of buffer, then beginning */
 108 /*                                             of buffer to curline          */
 109 /*               | [ address ] / regexp /      restricted range, beginning   */
 110 /*                                             to end of addressed area      */
 111 /*                                                                           */
 112 /*    bwd                                    backward search                 */
 113 /*             ::= </ regexp /               curloc to begin buffer          */
 114 /*               | [ address ] </ regexp /   end to begin of addressed area  */
 115 /*                                                                           */
 116 /* NOTE 1: when 2 address syllables are separated by a comma, this means     */
 117 /*  that the second address uses the same initial location as the first one. */
 118 /*                                                                           */
 119 /* NOTE 2: when 2 address syllables are separated by a semicolon, this       */
 120 /*  means that the second address uses the result of the first as its        */
 121 /*  beginning location.                                                      */
 122 
 123 /* UPDATE HISTORY (finally)                                                  */
 124 /* EL#   date       TR        comments                                       */
 125 /* 138 84-10-08 phx16962 pass failure of tedsrch_$compile back               */
 126 /* 144 84-10-09 phx17335 "Addr- after buffer" in byte mode in mid-buffer     */
 127 /* 195 88-08-07 phx19783,19787 Motion relative to '.' illegal if '.' is      */
 128 /*        undefined                                                          */
 129 /* 205 89-01-20 phx21225 ted should not complain that "." is undefined       */
 130 /*        unless there is an attempt to reference it.                        */
 131 
 132 dcl 1 ca_           based (ca__p) like b.a_; /* current address              */
 133 
 134 dcl next_in         fixed bin;          /* where at in address data          */
 135 dcl in_p            ptr;                /* -> address data                   */
 136 dcl in_l            fixed bin;          /*   length of it                    */
 137 dcl in_s            char (in_l) based (in_p); /* data as a string            */
 138 dcl in_c            (in_l) char (1) based (in_p); /* data as an array      */
 139 
 140 /**** data refering to the string being searched                             */
 141 dcl file_str        char (last_file_char) based (b.cur.sp);
 142 dcl first_file_char fixed bin (21);
 143 dcl next_file_char  fixed bin (21);
 144 dcl last_file_char  fixed bin (21);
 145 dcl in_part_2       bit (1);            /* which part of file are we in      */
 146 
 147 dcl adr_num         fixed bin;
 148 dcl all_buffer      bit (1);
 149 dcl bkp_sw          bit (1);
 150 dcl ca__p           ptr;
 151 dcl ch              char (1);
 152 dcl code            fixed bin (35);
 153 dcl concealsw       bit (1);
 154 dcl delim           char (1);
 155 dcl dot_sw          bit (1);
 156 dcl end_sw          bit (1);
 157 dcl expr_l          fixed bin (21);
 158 dcl i               fixed bin (21);
 159 dcl line_sw         bit (1);
 160 dcl negsw           bit (1);
 161 dcl num             fixed bin (21);
 162 dcl possw           bit (1);
 163 dcl q_sw            bit (1);
 164 dcl recurring       bit (1);
 165 dcl reg_sw          bit (1);
 166 dcl relsw           bit (1);
 167 dcl srb1            fixed bin (21);
 168 dcl srb2            fixed bin (21);
 169 dcl sre1            fixed bin (21);
 170 dcl sre2            fixed bin (21);
 171 dcl start_scan      fixed bin (21);
 172 dcl string_sw       bit (1) defined (b.present (0));
 173 dcl tbp             ptr;
 174 dcl used            fixed bin (21);
 175 
 176 dcl NL              char (1) int static init ("
 177 ");
 178 
 179 dcl ioa_            entry options (variable);
 180 dcl ioa_$ioa_switch entry () options (variable);
 181 dcl ioa_$ioa_switch_nnl entry () options (variable);
 182 
 183 
 184 dcl (
 185     addr, fixed, index, null, reverse, substr, verify
 186     )               builtin; %page;
 187       dbase_p = adb_p;
 188       bp = abp;                         /* "current" buffer                  */
 189       in_part_2 = ""b;
 190       in_p = ain_p;
 191       if (ain_l < 0)
 192       then do;
 193          ain_l = -ain_l;
 194          recurring = "1"b;
 195       end;
 196       else recurring = ""b;
 197       in_l = ain_l;
 198       next_in = 1; %skip (2);
 199       if db_addr
 200       then call ioa_$ioa_switch (db_output,
 201                 "addr: in=^p,^i ""^a"" b(^a)", /* ^/^-pfnl=part|first,next,last",   */
 202                 ain_p, ain_l, substr (in_s, 1, in_l - 1), b.name);
 203       if (in_c (next_in) = "@")         /* explicit buffer specification?    */
 204       then do;
 205          next_in = next_in + 1;
 206          used = in_l - next_in + 1;
 207          call tedget_buffer_ (adb_p, addr (in_c (next_in)),
 208               used, tbp, msg);
 209          next_in = next_in + used;
 210          if (tbp = null ())             /* did not find that buffer          */
 211          then do;
 212             acode = 8;
 213             return;
 214          end;
 215          bp = tbp;                      /* change reference to that buffer   */
 216          next_in = next_in              /* skip SPs                          */
 217               + verify (substr (in_s, next_in), " ") - 1;
 218          if (in_c (next_in) ^= ",")     /* no address following?             */
 219          then do;                       /*   just point to specified buffer  */
 220             q_sw = "1"b;
 221             b.present (1), b.present (2) = ""b;
 222             acode = 0;
 223             goto finished;
 224          end;
 225          next_in = next_in + 1;         /* skip over the comma               */
 226       end; %skip (3);
 227       adr_num = 1;                      /* prepare for 1st address           */
 228       b.a_.r.ln (1), b.a_.r.ln (2) = -1;
 229       ca__p = addr (b.a_ (1));
 230 q_comma:                                /* begin at "."                      */
 231       b.a_ (1) = b.a_ (0);
 232 q_semi:
 233       b.present (1), b.present (2) = ""b;
 234       acode = 0;                        /* indicate null addr                */
 235 
 236 line2:                                  /* continue on 2nd line address      */
 237       line_sw = "1"b;                   /* in line addr                      */
 238       all_buffer = "0"b;                /* not addressing whole buffer       */
 239       reg_sw = "0"b;                    /* no byte regexp just finished      */
 240 byte2:                                  /* continue on 2nd byte address      */
 241       start_scan = 0;                   /* scan is not started               */
 242       end_sw = "0"b;                    /* address is not finished           */
 243       q_sw = "0"b;                      /* prefix not in effect              */
 244       relsw = "0"b;                     /* absolute numerics                 */
 245       negsw = "0"b;                     /* not "-"                           */
 246       possw = "0"b;                     /* not "+"                           */
 247       dot_sw = "0"b;                    /* not "."                           */
 248       goto scan2;                       /* begin (or resume) scan of input   */
 249 
 250 a_line:
 251       ca_.l.re = ca_.l.le;
 252       ca_.r.le = ca_.r.re;              /* set string to full line           */
 253 scan:                                   /* actually found some address       */
 254       acode = 1;                        /* resume scan                       */
 255       b.present (adr_num) = "1"b;       /* current address (1|2) is present  */
 256       relsw = "1"b;                     /* any more numbers are relative     */
 257 scan0:                                  /* begin prefix or byte addr         */
 258       if (start_scan = 0)               /* keep where this scan started      */
 259       then start_scan = next_in;
 260 scan1:
 261       next_in = next_in + 1;            /* bump source char index            */
 262 scan2:
 263       if db_addr
 264       then call ioa_$ioa_switch_nnl (db_output,
 265                 """^1a""(^i)", in_c (next_in), next_in);
 266 
 267       if (next_in > in_l)               /* check for end of line             */
 268       then do;                          /* OPPS, went too far                */
 269          next_in = in_l;                /* bring it back in line             */
 270 err_Amn:
 271          msg = "Amn) No NL.";
 272 add_err_8:
 273          acode = 8;                     /* error found                       */
 274 add_err_text:
 275          if recurring
 276          then goto fail;
 277          if (start_scan = 0)            /* didnt capture start point,        */
 278          then start_scan = next_in;     /* so force it in                    */
 279          msg = msg || " """;
 280          msg = msg || substr (in_s, start_scan, next_in - start_scan + 1);
 281          msg = msg || """";
 282          goto fail;
 283       end;
 284       ch = in_c (next_in);              /* pick up next char from input line */
 285       if db_addr
 286       then call ioa_$ioa_switch (db_output,
 287                 "^-a^d:^[,rel^]^[,pos^]^[,neg^]", adr_num, relsw, possw, negsw);
 288 
 289       if (ch = " ") then goto scan1;    /* ignore blanks at this level       */
 290       if ^end_sw
 291       then do;
 292          if (ch = "/") then goto reg;   /* start of regular expression       */
 293 /**** A special case exists so that (/abc/////) will find the 3rd occrrance  */
 294 /****  but will also be able to find the abc beginning in col 1.             */
 295 /**** A TR complained about (/,/;//) giving a single character result,       */
 296 /****  so we make this special case carry over the ";".                      */
 297          if (ch ^= ";")
 298          then reg_sw = "0"b;            /*   not regexp                      */
 299          if (ch = "$") then goto last;  /* "$" goto end of input file        */
 300          if (ch = "-") then goto neg;   /* "-" note minus sign seen          */
 301          if (ch = "+") then goto pos;   /* "+" note plus sign seen           */
 302          if (ch >= "0") & (ch <= "9") then goto get_num;
 303          if (ch = "[") then goto limit; /* search limiting                   */
 304          if (ch = "?")                  /* prefix                            */
 305          then do;
 306             if b.present (1)            /* already been an address           */
 307             then goto err_Ad1;          /*   so this is an error             */
 308             q_sw = "1"b;
 309             goto scan0;                 /* go get the prefix                 */
 310          end;
 311          if ^line_sw                    /* in byte addr                      */
 312          then do;
 313             if (ch = ".")
 314             then do;
 315                if relsw
 316                then do;
 317 err_Ad1:
 318                   msg = "Ad1) . $ ? Can only appear first.";
 319                   goto add_err_8;
 320                end;
 321                dot_sw = "1"b;
 322                goto scan;
 323             end;
 324             if (ch = ")")               /* end byte address                  */
 325             then do;
 326                if negsw | possw         /* ### number missing                */
 327                then goto err_Anm;
 328                line_sw = "1"b;          /* back in line address              */
 329                end_sw = "1"b;           /* however, this one finished        */
 330                goto scan1;
 331             end;
 332             if (ch = ",") | (ch = ";")  /* byte address separator            */
 333             then do;
 334                if q_sw                  /* cant use this form in byte addr   */
 335                then goto err_Aqe;
 336                if negsw | possw         /* ### number missing                */
 337                then goto err_Anm;
 338                if (adr_num = 2)         /* ### already done 2nd?             */
 339                then goto only_2;
 340                if ^b.present (1)        /* ### left out 1st one?             */
 341                then goto err_Aa1;
 342                next_in = next_in + 1;   /* skip the separator                */
 343                adr_num = 2;             /* start 2nd address                 */
 344                ca__p = addr (b.a_.l (2)); /* begin 2nd where 1st left off */
 345                b.a_ (2) = b.a_ (1);
 346                if (ch = ",")            /* except if comma then go back to   */
 347                then do;                 /*   beginning of line               */
 348                   b.a_.l.re (2) = b.a_.l.le (2);
 349                   b.a_.r.le (2) = b.a_.r.re (2);
 350                end;
 351                b.present (2) = "0"b;    /* no address found                  */
 352                goto byte2;
 353             end;
 354             msg = "Abc) Bad char in byte addr.";
 355             goto add_err_8;
 356          end;
 357          else do;                       /* in line address                   */
 358             if negsw | possw            /* ### number missing                */
 359             then goto err_Anm;
 360             if (ch = ".")               /* current line ref                  */
 361             then do;
 362                if q_sw & (ca_.r.le = 0) /* prefix and undefined "."          */
 363                then goto q_fail;        /* then let him know by failing      */
 364                if relsw
 365                then goto err_Ad1;       /* dot only allowed first            */
 366                dot_sw = "1"b;
 367                goto a_line;
 368             end;
 369             if (ch = "(")               /* begin byte | buffer addr?         */
 370             then do;
 371                relsw, dot_sw, line_sw = "0"b;
 372                goto scan0;
 373             end;
 374             if (ch = "<")               /* backup search                     */
 375             then goto backup;
 376          end;
 377       end;
 378       if negsw | possw                  /* ### number missing                */
 379       then goto err_Anm;
 380       if (ch = ",") | (ch = ";")        /* line address separator            */
 381       then do;
 382          if (adr_num = 2)               /* already done 2 of em?             */
 383          then do;
 384 only_2:
 385             msg = "Ao2) Only 2 addr allowed.";
 386             goto add_err_8;
 387          end;
 388          if ^b.present (1)              /* any 1st one there?                */
 389          then goto err_Aa1;
 390          next_in = next_in + 1;         /* skip over separator               */
 391          if (ca_.l.re < b.b_.l.le)      /* before beginning?                 */
 392               | (ca_.r.le > b.b_.r.re)  /* ...after end                      */
 393          then goto q_fail;              /* too bad!                          */
 394          if q_sw                        /* just finish up a prefix?          */
 395          then do;
 396             q_sw = "0"b;                /* turn off prefix flag              */
 397             if (ch = ",")
 398             then goto q_comma;
 399             goto q_semi;
 400          end;
 401          ca__p = addr (b.a_ (2));       /* point to 2nd result               */
 402          if (ch = ",")                  /* comma means                       */
 403          then adr_num = 0;              /* use same starting location        */
 404          else adr_num = 1;              /* use updated location              */
 405          ca_ = b.a_ (adr_num);          /* set "." value for next address    */
 406          b.present (2) = "0"b;          /* havent found 2nd one yet          */
 407          adr_num = 2;                   /* begining 2nd address              */
 408          goto line2;
 409       end;
 410 
 411       if (ch = "\")
 412       then do;
 413          ch = in_c (next_in + 1);
 414          if (ch = "s")
 415          then do;
 416             string_sw = "1"b;
 417             next_in = next_in + 1;
 418             goto scan1;
 419          end;
 420          if (ch = "l")
 421          then do;
 422             string_sw = "0"b;
 423             next_in = next_in + 1;
 424             goto scan1;
 425          end;
 426       end;
 427 
 428 finished:
 429       ain_l = next_in - 1;
 430       if q_sw                           /* end in prefix?                    */
 431       then b.present (1) = "0"b;        /* then no effective address         */
 432       if db_addr
 433       then do;
 434          call ioa_$ioa_switch (db_output,
 435               """^1a""(^i) b(^a)", in_c (ain_l), ain_l, b.name);
 436          call tedshow_ (bp, ". adr a0 a1 a2");
 437       end;
 438       abp = bp;                         /* tell him buffer we worked on      */
 439       return;                           /* normal return to caller           */
 440                                         /* (acode = 0, 1 or 2)               */
 441 
 442 q_fail:                                 /* "non-failing" failure             */
 443       b.present (1), b.present (2) = "0"b;
 444       next_in = ain_l + 1;              /* throw away rest of line           */
 445 fail:                                   /* here on any other failure         */
 446       ain_l = next_in - 1;
 447       return;
 448 %page;
 449 limit:                                  /* limit range of a search expr      */
 450       if negsw | possw                  /* ### number missing                */
 451       then goto err_Anm;
 452       if (start_scan = 0)
 453       then start_scan = next_in;
 454       next_in = next_in + 1;            /* skip over the [                   */
 455       if (in_c (next_in) = "@")         /* TRYING TO REF OTHER BUFFER HERE?  */
 456       then do;
 457          msg = "Misplaced @.";          /* no you dont!                      */
 458          goto add_err_8;
 459       end;
 460       b.rel_temp = b.a_;                /* keep the current address data     */
 461       if b.present (1)                  /* WHAT TO DO?                       */
 462       then do;
 463          b.a_ (0) = ca_;
 464       end;
 465       apr (1) = b.present (1);
 466       apr (2) = b.present (2);
 467 dcl apr             (2) bit (1);
 468       used = -(in_l - next_in + 1);     /* <0 flags recursive entry          */
 469       call tedaddr_ (adb_p, addr (in_c (next_in)), used, bp, msg, acode);
 470       next_in = next_in + used;
 471       if (acode = 8)
 472       then do;
 473          if q_sw
 474          then goto q_fail;
 475          goto add_err_text;
 476       end;
 477       if (in_c (next_in) ^= "]")        /* next thing up must be the closer  */
 478       then do;
 479          msg = "Anb) Missing ].";
 480          goto add_err_8;
 481       end;
 482       next_in = next_in + 1;            /* skip over "]", then SPs           */
 483       next_in = next_in + verify (substr (in_s, next_in), " ") - 1;
 484       if b.present (1)
 485       then do;
 486          b.a_ (0) = b.a_ (1);
 487          if b.present (2)
 488          then b.a_.r (0) = b.a_.r (2);
 489       end;
 490       b.present (1) = apr (1);
 491       b.present (2) = apr (2);
 492       ch = in_c (next_in);
 493       if (ch = "<")
 494       then do;
 495          srb1 = 0;                      /* must look at last line            */
 496          srb2 = b.a_.l.le (0);
 497          sre2 = b.a_.r.re (0);
 498          b.a_ = b.rel_temp;             /* restore old address data          */
 499          ca_.l.le = sre2;
 500          goto backup_limit;
 501       end;
 502       if (ch = "/")
 503       then do;
 504          srb1 = b.a_.l.re (0);
 505          sre1 = b.a_.r.le (0);
 506          srb2, sre2 = 0;
 507          b.a_ = b.rel_temp;             /* restore old address data          */
 508          goto reg_limit;
 509       end;
 510 
 511       msg = "Invalid char follows [...].";
 512       goto add_err_8; %page;
 513 backup:
 514       if negsw | possw
 515       then goto err_Anm;
 516       srb1 = -1;                        /* do not look at cur line           */
 517       srb2 = b.b_.l.le;
 518       sre2 = ca_.l.le;
 519 backup_limit:
 520       next_in = next_in + 1;
 521       delim = in_c (next_in);
 522       bkp_sw = "1"b;
 523       goto scan_reg; %skip (2);
 524 reg:
 525       if negsw | possw                  /* ### number missing                */
 526       then goto err_Anm;
 527       srb1 = ca_.r.le + 1;              /* from here to buffer end           */
 528       sre1 = b.b_.r.re;
 529       srb2 = b.b_.l.le;                 /* then from buffer begin to here    */
 530       sre2 = ca_.r.le;
 531 reg_limit:
 532       delim = "/";
 533       bkp_sw = "0"b; %skip (2);
 534 scan_reg:
 535       b.rel_temp = tedcommon_$no_data;
 536       if (b.cur.sn = 0)
 537       then goto buffer_empty;
 538       if (start_scan = 0)
 539       then start_scan = next_in;
 540       i = next_in + 1;                  /* here after "/" found, look for    */
 541                                         /*  regular expression               */
 542       concealsw = "0"b;
 543       do next_in = i to in_l;
 544          if concealsw
 545          then concealsw = "0"b;
 546          else do;
 547             ch = in_c (next_in);
 548             if (ch = delim)
 549             then goto reg1;
 550             if (ch = "^Y")              /* is this \031 ?                    */
 551             then concealsw = "1"b;
 552             if (ch = "\")
 553             then do;
 554                if (in_c (next_in + 1) = "c")
 555                     | (in_c (next_in + 1) = "C")
 556                then do;
 557                   next_in = next_in + 1;
 558                   concealsw = "1"b;
 559                end;
 560 
 561             end;
 562          end;
 563       end;
 564       msg = "Ad2) No 2nd delimiter.";
 565       acode = 8;
 566       goto fail;
 567 
 568 reg1:
 569       expr_l = next_in - i;             /*  length of regular expression     */
 570 
 571       if (expr_l > 0)
 572       then do;
 573          call tedsrch_$compile (addr (in_c (i)), expr_l, addr (dbase.regexp),
 574               (string_sw), (dbase.lit_sw), msg, code);
 575          if (code ^= 0)
 576          then do;                       /* #138*/
 577             acode = code;               /* #138*/
 578             goto fail;                  /* #138*/
 579          end;                           /* #138*/
 580       end;
 581                                         /** b.newa = b.b_; */
 582       if bkp_sw
 583       then goto bkp1;
 584       if ^line_sw
 585       then goto creg;
 586       if (srb1 < 1)                     /* undefined ".", search whole thing */
 587       then do;
 588          srb1 = b.b_.l.le;
 589          sre1 = b.b_.r.re;
 590          sre2 = 0;
 591       end;
 592       call tedsrch_$search (addr (dbase.regexp), bp,
 593            srb1, sre1, ca_.l.re, ca_.r.le, 0,
 594            msg, code);
 595                                         /* try to match expression, pass 1   */
 596       if (code = 1) & (sre2 > 0)
 597       then call tedsrch_$search (addr (dbase.regexp), bp,
 598                 srb2, sre2, ca_.l.re, ca_.r.le, 0,
 599                 msg, code);
 600                                         /* try to match expression, pass 2   */
 601       if (code ^= 0)
 602       then do;                          /* error if match failed on 2nd pass */
 603          if (code = 2)
 604          then do;
 605             acode = 8;
 606             goto fail;
 607          end;
 608          if q_sw
 609          then goto q_fail;
 610          msg = "Als) Line search failed.";
 611          acode = 2;
 612          goto add_err_text;
 613       end;
 614 
 615       call find_line (0);               /* isolate /.../ line                */
 616       if line_sw
 617       then goto a_line;
 618       goto scan;
 619 
 620 bkp1:                                   /* what if "." undefined?            */
 621       ca_.l.re, ca_.r.le = ca_.l.le;
 622       do while (ca_.l.le > srb2);
 623          call find_line (srb1);         /* may go 0 or -1 the first time     */
 624          srb1 = -1;                     /*  make sure any more go -1         */
 625          call tedsrch_$search (addr (dbase.regexp), abp,
 626               ca_.l.le, ca_.r.re, ca_.l.re, ca_.r.le, 0, msg, code);
 627          if (code = 0)
 628          then do;
 629             if line_sw
 630             then goto a_line;
 631             goto scan;
 632          end;
 633          if (code ^= 1)
 634          then do;
 635             acode = 8;
 636             goto fail;
 637          end;
 638          expr_l = 0;
 639          ca_.l.re, ca_.r.le = ca_.l.le;
 640       end;
 641       if q_sw
 642       then goto q_fail;
 643       msg = "Abs) Backup search failed.";
 644       acode = 2;
 645       goto add_err_text;
 646 
 647 last:                                   /* $ found                           */
 648       if negsw | possw
 649       then goto err_Anm;
 650       if relsw
 651       then goto err_Ad1;
 652       if ^line_sw
 653       then do;                          /* CHAR - last, i.e. the NL          */
 654          if all_buffer                  /* if referencing all of buffer      */
 655          then ca_.r.re = b.b_.r.re;     /*  then give him last char thereof  */
 656          if (ca_.r.re = -1)
 657          then do;
 658 err_Adn:
 659             msg = "A.n) ""."" undefined.";
 660             goto add_err_8;
 661          end;
 662          if (b_c (ca_.r.re) = NL)       /* is there a NL on EOL?             */
 663          then ca_.l.re, ca_.r.le = ca_.r.re; /*  point to it                 */
 664          else ca_.l.re, ca_.r.le = ca_.r.re + 1; /*  point where it should be*/
 665          goto scan;                     /* continue scan                     */
 666       end;
 667       if (b.cur.sn = 0)
 668       then goto scan;                   /* "$" found, find last line         */
 669       if (b.b_.r.re + 1 = b.b_.r.le)    /* upper part empty                  */
 670       then ca_.r.le = b.b_.l.re;
 671       else ca_.r.le = b.b_.r.re;
 672       ca_.l.re = ca_.r.le;
 673       ca_.l.ln, ca_.r.ln = b.b_.r.ln;
 674       call find_line (0);               /* isolate $ line                    */
 675       goto a_line;                      /* resume line addr                  */
 676 
 677 neg:
 678       if possw | negsw
 679       then do;
 680 err_Anm:
 681          msg = "Amn) Missing number value.";
 682          goto add_err_8;
 683       end;
 684       dot_sw = "0"b;
 685       negsw = "1"b;                     /* "-" found, note minus sign seen   */
 686 
 687 /* RW 88: bug 195 */
 688 /* If we are attempting to reference a relative address, '.' MUST be defined
 689  * command sequences such as  "$d; -1" have 1 address, but a_(0) is undefined
 690    SH 89: bug 205
 691    Complain '.' is undefined only when there is an attempt to reference it
 692  */
 693       if (b.a_.r.re (0) = -1) & (ca_.r.re = -1) /*# 205 */
 694       then do;                          /*# 205 */
 695          msg = "A.u) ""."" undefined."; /*# 205 */
 696          goto add_err_8;                /*# 205 */
 697       end;                              /*# 205 */
 698 
 699       goto scan;                        /*  continue addr scan               */
 700 
 701 
 702 pos:
 703       if possw | negsw
 704       then goto err_Anm;
 705       dot_sw = "0"b;
 706       possw = "1"b;                     /* "+" found, note plus sign seen    */
 707 
 708 /* RW 88: bug 195 */
 709 /* If we are attempting to reference a relative address, '.' MUST be defined
 710  * command sequences such as  "$d; -1" have 1 address, but a_(0) is undefined
 711    SH 89: bug 205
 712    Complain '.' is undefined only when there is an attempt to reference it
 713  */
 714       if (b.a_.r.re (0) = -1) & (ca_.r.re = -1) /*# 205 */
 715       then do;                          /*# 205 */
 716          msg = "A.u) ""."" undefined."; /*# 205 */
 717          goto add_err_8;                /*# 205 */
 718       end;                              /*# 205 */
 719 
 720       goto scan;                        /*  continue addr scan               */ %page;
 721 get_num:
 722       if (start_scan = 0)
 723       then start_scan = next_in;
 724       i = verify (substr (in_s, next_in), "0123456789") - 1;
 725       num = fixed (substr (in_s, next_in, i));
 726       next_in = next_in + i - 1;
 727                                         /* allow zero even if buffer empty   */
 728       if (b.cur.sn = 0) & ((num ^= 0) | relsw | ^line_sw)
 729       then goto buffer_empty;
 730       if dot_sw                         /* back by popular demand:           */
 731       then do;                          /* i.e.  .35 -> +35                  */
 732          dot_sw = "0"b;
 733          possw = "1"b;
 734       end;
 735       if line_sw
 736       then do;
 737          if ^relsw
 738          then do;
 739          /*** see if we know any locations near here                         */
 740             do i = 1 to 2;
 741             end;
 742          end;
 743          if ^relsw                      /* absolute line number              */
 744          then do;                       /* begin at left end                 */
 745             if (b.b_.l.le - 1 = b.b_.l.re) /* is lower part empty?           */
 746             then ca_.l.le = b.b_.r.le;  /* YES, use upper                    */
 747             else ca_.l.le = b.b_.l.le;  /*  NO, use lower                    */
 748             if (num = 0)                /* line "0" is a special case        */
 749             then do;
 750                all_buffer = "1"b;
 751                ca_.r.re = ca_.l.le - 1; /* undefined location                */
 752             end;
 753             else do;
 754                ca_.l.re, ca_.r.le = ca_.l.le;
 755                ca_.r.ln = 1;            /* -> beginning of buffer            */
 756                call find_line (num - 1);/* move ahead necessary amount      */
 757             end;
 758          end;
 759          else do;                       /* relative line number              */
 760             if (ca_.r.re = -1)          /* undefined?                        */
 761             then ca_.r.le, ca_.r.re = ca_.l.le;
 762             else ca_.r.le = ca_.r.re;
 763             ca_.l.re = ca_.l.le;
 764             if negsw
 765             then num = -num;
 766             else if ^possw
 767             then do;
 768 err_Axn:
 769                msg = "Axn) Extra number present.";
 770                goto add_err_8;
 771             end;
 772             call find_line (num);       /* isolate +- Nth line               */
 773             negsw, possw = "0"b;
 774          end;
 775          goto a_line;                   /* continue addr a_line              */
 776       end; %skip (2);
 777 cnum:                                   /* CHAR - numeric addr               */
 778       if (ca_.r.re = -1)                /* no good if "." undefined          */
 779       then goto err_Adn;
 780       ca_.l.ln, ca_.r.ln = -1;          /* #144*/
 781       if ^relsw
 782       then do;                          /* #144*/
 783 /****    calc the absolute location, then if that is above               #144*/
 784 /****      the lower part, adjust it into the upper part.                #144*/
 785          i = ca_.l.le - 1 + num;
 786          if db_addr then call ioa_ ("(abs) ^i = ^i -1 + ^i", i, ca_.l.le, num);
 787 
 788          if (ca_.l.le <= b.b_.l.re) & (i > b.b_.l.re)
 789          then
 790             do;
 791             if db_addr then call ioa_ ("^i<=^i & ^i>^i", ca_.l.le, b.b_.l.re, i, b.b_.l.re);
 792             i = b.b_.r.le - b.b_.l.re + i - 1; /* #144*/
 793             if db_addr then call ioa_ ("^i = ^i - ^i +i-1", i, b.b_.r.le, b.b_.l.re);
 794          end;
 795       end;                              /* #144*/
 796       else if negsw
 797       then do;                          /* #144*/
 798 /****    apply the negative offset, then if that pushed it out           #144*/
 799 /****    of the upper part, adjust it into the lower part.               #144*/
 800          i = ca_.l.re - num;
 801          if (ca_.l.re >= b.b_.r.le) & (i < b.b_.r.le)
 802          then i = i - b.b_.r.le + b.b_.l.re + 1; /* #144*/
 803       end;                              /* #144*/
 804       else if possw
 805       then do;                          /* #144*/
 806 /****    apply the positive offset, then if that pushed it out           #144*/
 807 /****    of the lower part, adjust it into the upper.                    #144*/
 808          i = ca_.l.re + num;
 809          if (ca_.l.re <= b.b_.l.re) & (i > b.b_.l.re)
 810          then i = b.b_.r.le - b.b_.l.re + i - 1; /* #144*/
 811       end;                              /* #144*/
 812       else goto err_Axn;
 813       negsw, possw = "0"b;
 814       if (i < ca_.l.le)                 /* is it before line begin?          */
 815       then do;
 816          if ^string_sw                  /* not OK in line mode               */
 817          then goto addr_before_line;
 818          if (i < 1)                     /* can't fall out of                 */
 819          then goto addr_before_buffer;  /*  the buffer                       */
 820          ca_.l.re, ca_.r.le = i;
 821          call find_line (0);            /* isolate (N) char                  */
 822          goto scan;
 823       end;
 824       if (i ^< ca_.r.re)                /* is it after line end?             */
 825       then do;
 826          if string_sw | all_buffer      /* if in string mode                 */
 827          then do;
 828                                         /* code deleted                  #144*/
 829             if (i > b.b_.r.re)          /* can't fall out of                 */
 830             then call addr_after_buffer;/*  the buffer                       */
 831             ca_.l.re, ca_.r.le = i;
 832             call find_line (0);
 833             goto scan;
 834          end;
 835          if (b_c (ca_.r.re) = NL)       /* find the NL                       */
 836          then ca_.r.le = ca_.r.re - 1;
 837          else ca_.r.le = ca_.r.re;      /*  or where it should be            */
 838          if (i ^= ca_.r.le)             /* that is all that is               */
 839          then goto addr_after_line;     /*  for "after" the line             */
 840       end;
 841       ca_.l.re, ca_.r.le = i;           /* set str to this char              */
 842       goto scan;                        /* continue scan                     */ %skip (2);
 843 creg:                                   /* CHAR - contextual addr            */
 844       if string_sw
 845       then sre1 = b.b_.r.re;
 846       else sre1 = ca_.r.re;
 847       srb1 = ca_.l.re;
 848 /**** When a "first" expression search is specified, allow it to match at    */
 849 /****  the current location. Then any immediately following searches will    */
 850 /****  start at current+1. This is so (/abc/////) doesn't match the same     */
 851 /****  thing 3 times.                                                        */
 852       if reg_sw
 853       then srb1 = srb1 + 1;
 854       reg_sw = "1"b;
 855       call tedsrch_$search (addr (dbase.regexp), bp, srb1, sre1,
 856            ca_.l.re, ca_.r.le, 0, msg, code);
 857       if (code ^= 0)
 858       then do;
 859          if (code = 2)
 860          then do;
 861             acode = 8;
 862             goto fail;
 863          end;
 864          if q_sw
 865          then goto q_fail;
 866          msg = "Acs) Char search failed.";
 867          acode = 2;
 868          goto add_err_text;
 869       end;
 870       if string_sw
 871       then call find_line (0);
 872       goto scan; %page;
 873 /****  NOTE! --------------------------------------------------------------- */
 874 /****         find_line assumes that a line will never be split.             */
 875 /**** ---------------------------------------------------------------------- */
 876 find_line: proc (num);
 877 
 878 dcl num             fixed bin (21);     /* how many lines to move + or -     */
 879 
 880 dcl NLct            fixed bin (21);
 881 dcl i               fixed bin (21);
 882 dcl (lb, le, se)    fixed bin (21);
 883 
 884       lb = ca_.l.re;
 885       le = ca_.r.le;
 886       if db_addr
 887       then call ioa_$ioa_switch_nnl (db_output, "^i:^i", lb, le);
 888       if (lb = le + 2) | (lb = le + 1)
 889       then le = lb;
 890       if (le = -1)
 891       then goto err_Adn;
 892       if (le < 1)                       /* & (le+1 ^= lb) */
 893       then call addr_after_buffer;
 894       NLct = 0; %skip (3);
 895       if (NLct < num)
 896       then do;                          /* go forward num lines              */
 897          call set_file (le);
 898          do while ((NLct < num)
 899               & ((next_file_char < last_file_char) | ^in_part_2));
 900             i = index (substr (file_str, next_file_char), NL);
 901             if (i = 0)
 902             then next_file_char = last_file_char + 1;
 903             else next_file_char = next_file_char + i;
 904             if (next_file_char > last_file_char)
 905             then if ^in_part_2
 906                  then call set_file (b.b_.r.le);
 907             NLct = NLct + 1;
 908          end;
 909 /**** coming out of this loop, next_file_char points just past a NL          */
 910 /****  (unless none there )                                                  */
 911          lb, le = next_file_char;
 912          if (ca_.r.ln ^= -1)
 913          then ca_.r.ln = ca_.r.ln + NLct;
 914       end; %skip (3);
 915       if (NLct > num)
 916       then do;                          /* go backward num lines             */
 917          call set_file (lb);
 918          do while ((NLct > num) & (first_file_char <= next_file_char));
 919             i = index (reverse (substr (file_str, first_file_char,
 920                  next_file_char - first_file_char)), NL);
 921             if (i = 0)
 922             then do;
 923                if in_part_2
 924                then call set_file (b.b_.l.re);
 925                else do;
 926                   if (NLct ^= num + 1)
 927                   then goto addr_before_buffer;
 928                   next_file_char = 0;   /* allow decr to line 0 (undefined)  */
 929                   NLct = -1;
 930                   goto set;
 931                end;
 932             end;
 933             next_file_char = next_file_char - i;
 934             NLct = NLct - 1;
 935          end;
 936 /**** coming out of this loop, next_file_char points just ahead of a         */
 937 /****  NL unless there is none there.                                        */
 938          lb, le = next_file_char;
 939          if (le = 0)
 940          then le = -1;
 941          if (ca_.r.ln ^= -1)
 942          then ca_.r.ln = ca_.r.ln + NLct;
 943       end;
 944       ca_.l.ln = ca_.r.ln;
 945       if (NLct = num)
 946            & (b.b_.l.le <= lb)          /* 82-3-4 don't remember why this
 947          & (le <= b.b_.r.re)            /* 82-3-4 don't remember why this    */
 948       then do;                          /* find both ends of current line    */
 949          call set_file (le);
 950          i = index (substr (file_str, le), NL);
 951          if (i = 0)
 952          then le = last_file_char + 1;
 953          else le = le + i - 1;
 954 
 955          call set_file (lb);
 956          i = index (reverse (substr (file_str, first_file_char,
 957               lb - first_file_char)), NL);
 958          if (i = 0)
 959          then lb = first_file_char;
 960          else lb = lb - i + 1;
 961       end;
 962 
 963       if (NLct < num)
 964       then call addr_after_buffer;
 965       if (NLct > num)
 966       then goto addr_before_buffer;
 967       if (b_c (b.b_.r.re) = NL)
 968       then se = b.b_.r.re;
 969       else se = b.b_.r.re + 1;
 970       if (le > se)
 971       then call addr_after_buffer;
 972       if (le = b.b_.r.re + 1)           /* if just barely fell out of part2  */
 973       then le = b.b_.r.re;              /* ..then reference end              */
 974       else if (le = b.b_.l.re + 1)      /* if just barely fell out of part1  */
 975            & (b.b_.r.le > b.b_.r.re)    /* ..and part 2 is empty             */
 976       then le = b.b_.l.re;              /* ..then reference end of part1     */
 977 set:
 978       ca_.l.le = lb;
 979       ca_.r.re = le;
 980       if (num ^= 0)
 981       then do;
 982          ca_.l.re = lb;
 983          ca_.r.le = le;
 984       end;
 985       if db_addr
 986       then do;
 987          call ioa_$ioa_switch (db_output,
 988               "^xfind[^d]a^d  l=^4d,^d(^d)^30.1tr=^4d,^d(^d) ^[str^;lin^]",
 989               num, adr_num,
 990               ca_.l.le, ca_.l.re, ca_.l.ln, ca_.r.le, ca_.r.re, ca_.r.ln,
 991               string_sw);
 992       end;
 993    end find_line; %skip (3);
 994 set_file: proc (at);
 995 
 996 dcl at              fixed bin (21);     /* location which must be available  */
 997 
 998       next_file_char = at;
 999       if (next_file_char <= b.b_.l.re)
1000       then do;
1001          in_part_2 = ""b;
1002          first_file_char = b.b_.l.le;
1003          last_file_char = b.b_.l.re;
1004       end;
1005       else if (b.b_.r.le <= next_file_char)
1006       then do;
1007          in_part_2 = "1"b;
1008          first_file_char = b.b_.r.le;
1009          last_file_char = b.b_.r.re;
1010       end;
1011       else do;
1012          msg = "next in gap";
1013 range_err:
1014          call ioa_ (" addr: ^a", msg);
1015          signal condition (addr_error); dcl addr_error condition;
1016          goto fail;
1017       end;
1018       if (next_file_char < first_file_char)
1019       then goto addr_before_buffer;
1020       if (last_file_char < next_file_char)
1021       then call addr_after_buffer;
1022 
1023       if db_addr
1024       then call ioa_$ioa_switch (db_output, "^-^[>>^;<<^] ^i)^i(^i",
1025                 in_part_2, first_file_char, next_file_char, last_file_char);
1026 
1027    end set_file; %page;
1028 /*                        : : : ERROR messages : : :                         */
1029 err_Aqe:
1030       msg = "Aqe) Bad ? form.";
1031       goto add_err_8;
1032 
1033 err_Aa1:
1034       msg = "Aa1) No 1st addr.";
1035       goto add_err_8;
1036 
1037 addr_before_buffer:
1038       msg = "Abb) Addr- before buffer";
1039       goto addr_outside;
1040 
1041 addr_before_line:
1042       msg = "Abl) Addr- before line";
1043       goto addr_outside;
1044 
1045 addr_after_buffer: proc;
1046       msg = "Aab) Addr- after  buffer";
1047       goto addr_outside;
1048    end;
1049 
1050 addr_after_line:
1051       msg = "Aal) Addr- after  line";
1052       goto addr_outside;
1053 
1054 buffer_empty:
1055       msg = "Abe) Buffer empty.";
1056       goto addr_outside;
1057 
1058 addr_outside:
1059       if ^q_sw
1060       then do;
1061          acode = 8;
1062          goto fail;
1063       end;
1064       goto q_fail; %page;
1065 %include tedbase;
1066 %include tedcommon_;
1067 %include tedbcb;
1068 dcl tedaddr_        entry (             /* process request addresses         */
1069                     ptr,                /* -> database                       */
1070                     ptr,                /* -> string containing address      */
1071                     fixed bin (21),     /*   length of it               [IN] */
1072                                         /* If <0 then recursive call         */
1073                                         /*   how much was used up      [OUT] */
1074                     ptr,                /* -> buffer control block  [IN/OUT] */
1075                     char (168) var,     /* place to hold err message if any  */
1076                     fixed bin (35),     /* status code                       */
1077                                         /*   0- null address                 */
1078                                         /*   1- address found                */
1079                                         /*   8- error, msg tells what        */
1080                     );
1081 
1082 
1083 dcl tedshow_        entry () options (variable);
1084 %include tedsrch_;
1085 /*dcl tedget_existing_buffer_ entry (   /* find a named buffer               */
1086 /*                  ptr,                /* -> database                       */
1087 /*                  ptr,                /* -> string containing buffer name  */
1088 /*                  fixed bin (21),     /*   length of string           [IN] */
1089 /*                                      /*   how much was used         [OUT] */
1090 /*                  ptr,                /* buffer control block (OUT)        */
1091 /*                  char (168)var       /* error message text                */
1092 /*                  );                                                       */
1093 
1094 dcl tedget_buffer_  entry (             /* find (or create) a buffer         */
1095                     ptr,                /* -> database                       */
1096                     ptr,                /* -> string containing buffer name  */
1097                     fixed bin (21),     /*   length of string           [IN] */
1098                                         /*   how much was used         [OUT] */
1099                     ptr,                /* buffer control block (OUT)        */
1100                     char (168) var      /* error message text                */
1101                     );
1102 
1103 
1104 
1105    end tedaddr_;