DataMuseum.dk

top - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »tcmerge2    «

└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
    └─⟦6a563b143⟧ 
        └─ ⟦this⟧ »tcmerge2    « 
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─ ⟦this⟧ »tcmerge2    « 

TextFile

begin
  integer i,j,maxsource;
  boolean skipbits;
  real array arr(1:2);
  procedure error(cause);
  integer cause;
  begin
    write(out,<:<10>***cmerge :>,
      case cause of (
        <:no object file:>,
        <:syntax at source:>,
        <:sequence error at source:>,
        <:object file could not be created:>,
        <:object file protected or in use:>,
        <:skip bracket not closed:>,
        <:***:>),<:<10>:>);
    goto abend;
  end error;

  if system(4,1,arr) <> 6 shift 12 + 10 then error(1);
  system(4,3,arr);
  if arr(1) <> real <:sourc:> add 101 then error(2);
  maxsource:=0;
  while system(4,maxsource+4,arr) = 8 shift 12 + 10 do
    maxsource:= maxsource + 1;
  skipbits:= false;
  i:= maxsource+4;
  if system(4, i, arr) = 4 shift 12 + 10 and arr(1) = real <:skip:> then
  begin
    i:= i+1;
    while system(4, i, arr) = 8 shift 12 +  4 do
    begin
      skipbits:= skipbits or (false add (1 shift arr(1)));
      i:= i+1;
    end;
  end;
  begin
    zone array source(maxsource,128*2,2,stderror);
    zone object(128*2,2,stderror);
    integer array state(1:maxsource);
    integer array tail(1:10);
    integer partition,slabel,currcharout;

    integer procedure search(z,no,startpos,output);
    zone z; integer no,startpos; boolean output;
    begin
      integer margin,class,pos,i,j;
      boolean found;
      integer array line(1:132);
      line(startpos):=0;
      if startpos = 1 then margin:=case partition of (0,2,2,4,4,6,4,4)
        else margin:=0;
      if partition = 1 then
      begin
        for class:= readchar(z, i) while class <> 8 do outchar(out, i);
        outchar(out, 10);
        ud(out);
      end else
      if startpos = 1 then <* source file *>
        begin
        for class:= readchar(z,i) while class<>8 do outchar(out,i);
        outchar(out,10);
        ud(out);
      end else
      begin <* master file *>
        for class:= readchar(z, i) while class <> 8 do ;
      end;
nextline:
      pos:=1;
      for class:=readchar(z,line(pos)) while class <> 8 and pos < startpos+2 do pos:=pos+1;
      if line(pos) = 25 then search:=1000000 else
      if pos = startpos+2 and (line(startpos) = 58 and line(startpos+2) = 58) then
      search:= line(startpos+1)-48
      else
      begin
        if class <> 8 then
        begin
          pos:= pos + 1;
          for class:= readchar(z, line(pos)) while class <> 8 do pos:= pos+1;
        end;
        if (line(1) = 60   <* < *> and
           (line(1+1) = 42 <* * *> and
           (line(1+2) = 43 <* + *> and
           (line(1+4) = 42 <* * *> and
            line(1+5) = 62 <* > *> )))) then
        begin
          i:= line(1+3) - 48;
          if (i > 0 and i < 10) and skipbits shift (-i) then
          begin  <* skip until closing bracket *>
            repeat
              pos:=1;
              for class:= readchar(z, line(pos)) while class <> 8 do pos:= pos+1;
              if line(pos) = 25 then
              begin
                close(object, true);
                error(6);
              end;
              found:= true;
              for j:= 0 step 1 until 5 do
              begin
                if line(j+1) <> (case (j+1) of (60, 42, 45, i+48, 42, 62))
                then found:= false;
              end;
            until found;
            goto nextline;
          end;
        end;
        if output then
        begin
          write(object,false add 32,margin);
          for i:=1 step 1 until pos do outchar(object,line(i));
        end;
        goto nextline;
      end;
    end search;

    system(4,0,arr);
    i:=1;
    open(object,4,string arr(increase(i)),0);
    if monitor(42) lookup entry :(object,0,tail) <> 0 then
    begin
      tail(1):=50;
      for i:=2 step 1 until 10 do tail(i):=0;
      if monitor(40) create entry :(object,0,tail) <> 0 then error(4);
    end;
    if monitor(52,object,0,tail) + monitor(8,object,0,tail) <> 0 then error(5);
    for j:=1 step 1 until maxsource do
    begin
      state(j):=0;
      system(4,j+3,arr);
      i:=1;
      open(source(j),4,string arr(increase(i)),0);
    end;
    for partition:=1 step 1 until 8 do
    begin
      for i:=1 step 1 until maxsource do
      begin
        if state(i) < partition then
        begin
          slabel:=search(source(i),partition,1,partition>1);
          if slabel <= state(i) then error(3);
          state(i):=slabel;
        end;
      end;
      search(in,partition,4,true);
    end;
    outchar(object,25);
    close(object,true);
    for i:=1 step 1 until maxsource do close(source(i),true);
  end;
abend:
end


▶EOF◀