MERGE.I

[Table of Contents]

The MERGE.I include file resides on the Kyan Pascal 2.x Utilities Disk 1.

• procedure merge(var mergenames:namearray; select,fnum,rlen,klen,oset,order:integer; ktype:field_type);

Source Code

procedure merge(var mergenames:namearray;
                    select,fnum,rlen,klen,oset,order:integer;
                    ktype:field_type);
type
    rectype =array [1..1024] of char;
    filname =file of char;
    bufftype=array [1..5] of rectype;
    stiltype=array [1..5] of boolean;
var
    i,it,j    :integer;
    buffers   :bufftype;
    stillopen :stiltype;
    f         :array [1..7] of filname;
    empty,temp:boolean;
    function compare(var buff:bufftype;
                     oset,klen,order,fnum:integer;
                     ktype:field_type;
                     stillopen:stiltype):integer;
    type
        sortrec = record
            case field_type of
                alpha_field  :(str:array[1..255] of char);
                real_field   :(r:real);
                integer_field:(i:integer);
            end;(*sort rec*)
    var
        i,i2,comp,result:integer;
        bigger,first    :boolean;
        temp,test       :sortrec;
    begin
        first:=true;
        for i:=1 to fnum do
           if stillopen[I] then begin
               for i2:=1 to klen do
                   temp.str[i2]:=buff[i][oset+i2];
               if first then begin
                   comp:=i;
                   first:=false;
                   for i2:=1 to klen do
                       test.str[i2]:=buff[comp][oset+i2];
               end(*if*)
               else begin
                   case ktype of
                       alpha_field: begin
                           i2:=0;
                           repeat
                               i2:=i2+1;
                               if test.str[i2]<temp.str[i2] then
                                   result:=1
                               else
                                   if test.str[i2]>temp.str[i2] then
                                       result:=-1
                                   else
                                       result:=0;
                           until (result<>0) or (i2=klen) ;
                       end;(*alpha*)
                       integer_field :begin
                           if test.i<temp.i then
                               result:=1
                           else
                               if test.i<temp.i then
                                   result:=-1
                               else
                                   result:=0;
                       end;(*begin*)
                       real_field :begin
                           if test.r<temp.r then
                               result:=1
                           else
                               if test.r>temp.r then
                                   result:=1
                               else
                                   result:=0;
                       end;(*real*)
                   end; (*case*)
                   if ((result=-1) and (order>=0)) or
                      ((result=1) and (order<0)) then begin
                           comp:=i;
                           for i2:=1 to klen do
                               test.str[i2]:=buff[comp][oset+i2];
                   end;(*if*)
               end;(*else*)
       end;(*still open*)
       compare:=comp;
    end;(*compare*)


begin(*merge main*)
    case ktype of
        alpha_field  : ;
        integer_field: klen:=2;
        real_field   : klen:=8;
    end;
    for i:=1 to fnum do begin
        reset(f[i],mergenames[i]);
        for j:=1 to rlen do
            if eof(f[i]) then
                stillopen[i]:=false
            else begin
                read(f[i],buffers[i][j]);
                stillopen[i]:=true;
            end;
     end;
     rewrite(f[select],mergenames[select]);
     empty:=false;
     while not empty do begin
         it:=compare(buffers,oset,klen,order,fnum,ktype,stillopen);
         for j:=1 to rlen do
             write(f[select],buffers[it][j]);
         for j:=1 to rlen do
             if eof(f[it]) then begin
                 stillopen[it]:=false;
                 temp:=false;
                 for i:=1 to fnum do
                     temp:=temp or stillopen[i];
                 empty:=not(temp);
             end
             else
                 read(f[it],buffers[it][j]);
     end;(*while*)
end;(*merge main*)