/* SEG0_DUMMY.PLP, SEGSRC, KJC, 12/20/79
/* Routine to Read/Write Segment 0 of a Segmented Run-file
/* Copyright (c) 1981, Prime Computer, Inc., Natick, MA 01760
/******************************************************************************/

seg0: procedure(name, namlnt, iocmd) returns(bit(1));

  declare name character(80);
  declare (namlnt, iocmd) fixed binary(15);
  declare (i, j) fixed binary(15);  /* temporary indexes */
  declare (iarg, code) fixed binary(15);
  declare map pointer external;
  declare (fixdir, symcha) entry;
  declare prwf$$ entry(bin, bin, ptr, bin, bin(31), bin, bin);
  declare opent$ entry(bin, char(*), bin, bin) returns(bin);
  declare srch$$ entry(bin, char(*), bin, bin, bin, bin);
  declare errpr$ entry(bin, bin, char(*), bin, char(*), bin);
  declare ss$err entry;
  declare addrel entry(ptr, bin(31)) returns(ptr);

$Insert loatmp.ins.plp
$Insert bufctl.ins.plp
$Insert loactl.ins.plp
$Insert isave.ins.plp
$Insert itime.ins.plp
$Insert lodcmp.ins.plp
$Insert chain.ins.plp
$Insert syscom>keys.ins.pl1

  declare binb(bufctl_size) fixed binary(15) based;
  declare bits bit(16) based;
  declare bin fixed binary(15) based;
  declare 1 filler_bits based,
        2 bit1  bit(1) unaligned,
        2 bit2  bit(1) unaligned,
        2 bit3  bit(1) unaligned,
        2 bit4  bit(1) unaligned,
        2 bit5  bit(1) unaligned,
        2 bit6  bit(1) unaligned,
        2 bit7  bit(1) unaligned,
        2 bit8  bit(1) unaligned,
        2 bit9  bit(1) unaligned,
        2 bit10 bit(1) unaligned,
        2 bit11 bit(1) unaligned,
        2 bit12 bit(1) unaligned,
        2 bit13 bit(1) unaligned,
        2 bit14 bit(1) unaligned,
        2 bit15 bit(1) unaligned,
        2 bit16 bit(1) unaligned;
  declare errsev fixed bin static external;
  declare offset fixed bin static external;

  if opent$(iocmd, name, namlnt, iarg) = 0
    then if iarg ^= 0
      then do;
        code = 0;
        go to ERRRTN;
       end;
      else if iocmd ^= k$read
        then call segment_0_io;
        else;
    else call segment_0_io;

  /* Now we are done, let's clean up */

  offset = 1;         /* Set up offset value for SEGPRW */
  seg_file_rev = 7;   /* old runfiles have been updated to REV18 */
  revflg = -1;        /* for BUFCTL from now on */
  call srch$$(k$clos, '', 0, segment_0, iarg, code);
  if code ^= 0 then go to ERRRTN;
  return('0'B);      /* no errors */

ERRRTN:
  call errpr$(k$irtn, code, '', 0, 'SEG0', 4);
  call ss$err;
  errsev =-1;
  return('1'B);      /* error return */

segment_0_io: procedure;     /* to work with SEG's tables */


    if iocmd = k$read
      then addr(bufctl.bufctl) -> binb = 0;     /*  = '0000'B4;  no bit promotion in PLP  */

  /* get revflg, should be -1 */

    call prwf$$(iocmd, segment_0, addr(revflg), 1, 0, iarg, code);
    if code ^= 0 then go to ERRRTN;

      call prwf$$(iocmd, segment_0, addr(bufctl.bufcnt), 1, 0, iarg, code);
      if code ^= 0 then go to ERRRTN;
      call prwf$$(iocmd, segment_0, addr(bufctl.bufctl), bufctl.bufcnt*2, 0, iarg, code);
      if code ^= 0 then go to ERRRTN;

  /* Now everything is up to date, time to work on the rest of the common blocks */

    if iocmd = k$writ
      then symbol_table_size = symlow * symsiz;
      else;
    call prwf$$(iocmd, segment_0, addr(isave), 10, 0, iarg, code);
    if code ^= 0 then go to ERRRTN;
    call prwf$$(iocmd, segment_0, addr(itime), 30, 0, iarg, code);
    if code ^= 0 then go to ERRRTN;
    if seg_file_rev < 6
      then call fixdir;        /* if old file, make room for debug information */
      else;
    if seg_file_rev < 7
      then symbol_table_size = addr(symbol_table_size) -> bin;
      else;

  /* Copy the symbol table after computing its size */

    symlow = divide(symbol_table_size, symsiz, 15);
    call prwf$$(iocmd, segment_0, addrel(addr(map), -symbol_table_size), (symbol_table_size), 0, iarg, code);
    if code ^= 0 then go to ERRRTN;

  /* Very old files need more massaging to be updated */

    if seg_file_rev < 4
      then call symcha;
      else do;
        call prwf$$(iocmd, segment_0, addr(chain), 21, 0, iarg, code);
        if code ^= 0 then go to ERRRTN;
       end;

    return;

   end /* segment_0_io */;

 end /* seg0 */;