/* SETBB.PLP, SEGSRC, KJC-LSS,  03/21/79
/* Procedure to create base areas
/* Copyright (c) 1981, Prime Computer, Inc., Natick, MA 01760
/********************************************************************/

setbb: procedure(base,size) returns(bit(1));

  declare (base,pt,size,bound) fixed binary(15);
  declare 1 sbuff static,
           2 bas$flg  bit(16) initial('0200'b4),
           2 bas$seg  fixed binary(15) initial(2049),
           2 bas$bot  fixed binary(15) initial(128),
           2 bas$low  fixed binary(15) initial(128),
           2 bas$high fixed binary(15) initial(511),
           2 bas$top  fixed binary(15) initial(511),
           2 mtz(3)   fixed binary(15) initial((3)0);
  declare bits bit(16) based;
  declare initne entry(1, 2 bin, 2 bin, 2 bin, 2 bin, 2 ptr, 2 bin(31), bin, bin);
  declare next entry(1, 2 bin, 2 bin, 2 bin, 2 bin, 2 ptr, 2 bin(31)) returns(bin);
  declare symadd entry options(variable);

$Insert symbol_table.ins.plp
$Insert itime.ins.plp
$Insert point3.ins.plp

  bound = size;
  if base ^= 0
    then do;
      if bound = 0
        then addr(bound)->bits = (addr(base)->bits & 'FE00'b4) | '01FF'b4;
        else bound = base + bound - 1;
      call initne(point3,base$,0);
      do until(pt = 0);
        pt = next(point3);
        if pt ^= 0
          then if p3$ptr->ba$seg > segpnt
            then pt = 0;
            else if p3$ptr->ba$seg = segpnt
              then do;
                if addr(base)->bits < addr(p3$ptr->ba$bot)->bits
                  then do;
                    if addr(p3$ptr->ba$bot)->bits < addr(bound)->bits
                      then return('0'B);
                      else pt = 0;
                   end;
                  else if addr(base)->bits > addr(p3$ptr->ba$bot)->bits
                    then do;
                      if addr(base)->bits <= addr(p3$ptr->ba$top)->bits
                        then return('0'B);
                        else;
                     end;
                    else return('0'B);
               end;
              else;
          else;
       end;
      if (addr(base)->bits & 'FE00'b4) ^= '0'B
        then obase = obase + 1;
        else;
      bas$seg = segpnt;
      bas$bot = base;
      bas$low = base;
      bas$high = bound;
      bas$top = bound;
      call symadd(sbuff,point3);
      return('1'B);
     end;
    else return('0'B);
 end /* setbb */;