DIRECTORY
  jsysdefs: INCLUDE "<mps>jsysdefs",
  segdefs: INCLUDE "<mps>segdefs";
sortdriver: PROGRAM =
  BEGIN
  ijfn, ojfn: INTEGER;
  ibuffer: ARRAY [0..3] OF WORD;
  tbuffer: ARRAY [0..2000] OF WORD;
  shandle: TYPE = RECORD [ array: DESCRIPTOR FOR ARRAY OF WORD];
  mtrec: shandle _ DESCRIPTOR [777777B, 0];

  yes: PROCEDURE [str: STRING] RETURNS [BOOLEAN] = -- require CR unlike cmgio.yes
    BEGIN
    astr: STRING[100];
    ach: CHARACTER;
    DO
      BEGIN
      Request[str, astr];
      ach _ NthChar[astr,0];
      CASE ach OF
	'y, 'Y: RETURN [TRUE];
	'n, 'N: RETURN [FALSE];
	ENDCASE: soutty["Y or N, please."];
      END;
   END;

  buildfilename: PROCEDURE [dest, old, defdir, defext: STRING] =
    BEGIN
    i: INTEGER;
    hasdir, hasext: BOOLEAN _ FALSE;
    SetStrNull[dest];
    IF NthChar[old,0] # '<
      THEN AppendString[dest, defdir];
    FOR i THRU [0..STRLength[old]) WHILE ~hasext DO
      IF NthChar[old,i] = '.
	THEN hasext _ TRUE;
    AppendString[dest, old];
    IF NOT hasext
      THEN AppendString[dest, defext];
    END;

  readrec: PROCEDURE RETURNS [shandle] =
    BEGIN
    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
    IF ibuffer[0] = -1
      THEN
	BEGIN
	CloseFile[ijfn, FALSE];
	IF yes["more files? "]
	  THEN
	    BEGIN
	    newinput[];
	    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
	    END
	  ELSE RETURN[mtrec];
	END;
    RETURN [DESCRIPTOR[ibuffer]];
    END;

  changechunk: BOOLEAN _ FALSE;
  newchunk: INTEGER;
  readrec3: PROCEDURE RETURNS [shandle] =
    BEGIN
    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
    IF ibuffer[0] = -1
      THEN
	BEGIN
	CloseFile[ijfn, FALSE];
	IF yes["more files? "]
	  THEN
	    BEGIN
	    newinput[];
	    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
	    END
	  ELSE RETURN[mtrec];
	END;
    IF changechunk
      THEN ibuffer[2] _ newchunk;
    RETURN [DESCRIPTOR[ibuffer]];
    END;

  datadir: STRING [20];
  dataext: STRING[30];

  newinput: PROCEDURE =
    BEGIN
    infile, fstr: STRING[50];
    soutty[" input: "];
    ReadString[fstr, EOL];
    buildfilename[infile, fstr, datadir,dataext];
    ijfn _ OpenFile[infile, 1B11, ReadAccess];
    END;

  writerec: PROCEDURE [rec: shandle] =
    BEGIN
    JSYS[ sout, ojfn, 444400B6+BASE[rec$array], -4];
    END;

  treadrec: PROCEDURE RETURNS [shandle] =
    BEGIN
    tbsize: INTEGER;
    IF ibuffer[0] = -1
      THEN RETURN[mtrec];
    tbuffer[0] _ ibuffer[0];
    tbuffer[1] _ ibuffer[1];
    tbuffer[2] _ ibuffer[2];
    tbuffer[3] _ 1;
    tbuffer[4] _ ibuffer[3];
    tbuffer[5] _ ibuffer[0];
    tbsize _ 6;
    DO
      BEGIN
      readrec[];
      IF ibuffer[0] = -1 OR ibuffer[1] # tbuffer[1] OR ibuffer[2] # tbuffer[2]
	THEN RETURN [DESCRIPTOR[ BASE[tbuffer], tbsize]];
      tbuffer[tbsize] _ ibuffer[3];
      tbuffer[tbsize+1] _ ibuffer[0];
      tbuffer[0] _ tbuffer[0]+ibuffer[0];
      tbuffer[3] _ tbuffer[3]+1;
      tbsize _ tbsize+2;
      END;
    END;

  twriterec: PROCEDURE [rec: shandle] =
    BEGIN
    JSYS[ sout, ojfn, 444400B6+BASE[rec$array], -LENGTH[rec$array]];
    END;

  pswriterec: PROCEDURE [rec: shandle] =
    BEGIN
    JSYS[ sout, ojfn, 444400B6+BASE[rec$array]+1, -2];
    END;

  combine: PROCEDURE [rec1, rec2: shandle] RETURNS [shandle] =
    BEGIN
    rec1$array[0] _ rec1$array[0] + rec2$array[0];
    RETURN [rec1];
    END;

  combine3: PROCEDURE [rec1, rec2: shandle] RETURNS [shandle] =
    BEGIN
    rec1$array[3] _ rec1$array[3] + rec2$array[3];
    RETURN [rec1];
    END;

  scream: PROCEDURE [rec1, rec2: shandle] RETURNS [shandle] =
    BEGIN
    ERROR;
    END;

  compare3: PROCEDURE [rec1, rec2: shandle] RETURNS [INTEGER] =
    BEGIN
    ar1, ar2: DESCRIPTOR FOR ARRAY OF WORD;
    ar1 _ rec1$array;
    ar2 _ rec2$array;
    CASE ar1[0] - ar2[0] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[1] - ar2[1] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[2] - ar2[2] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE: RETURN[0];
    END;

  compare1: PROCEDURE [rec1, rec2: shandle] RETURNS [INTEGER] =
    BEGIN
    ar1, ar2: DESCRIPTOR FOR ARRAY OF WORD;
    ar1 _ rec1$array;
    ar2 _ rec2$array;
    CASE ar1[1] - ar2[1] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[2] - ar2[2] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[3] - ar2[3] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE: RETURN[0];
    END;

  compare2: PROCEDURE [rec1, rec2: shandle] RETURNS [INTEGER] =
    BEGIN
    ar1, ar2: DESCRIPTOR FOR ARRAY OF WORD;
    ar1 _ rec1$array;
    ar2 _ rec2$array;
    CASE ar1[1] - ar2[1] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[2] - ar2[2] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[3] - ar2[3] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE: ERROR;
    END;

  tcompare: PROCEDURE [rec1, rec2: shandle] RETURNS [INTEGER] =
    BEGIN
    ar1, ar2: DESCRIPTOR FOR ARRAY OF WORD;
    ar1 _ rec1$array;
    ar2 _ rec2$array;
    CASE ar2[0] - ar1[0] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[1] - ar2[1] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE;
    CASE ar1[2] - ar2[2] OF
      <0: RETURN [-1];
      >0: RETURN [1];
      ENDCASE: RETURN[0];
    END;

  sortdata: PROCEDURE [pass: INTEGER] =
    BEGIN
    infile, fstr: STRING[50];
    SetStrNull[datadir]; SetStrNull[dataext];
    AppendString[datadir,"<RES>"];
    AppendString[dataext,".PATDATA"];
    newinput[];
    soutty["output: "];
    ReadString[fstr, EOL];
    buildfilename[infile, fstr, "<RES>",".PATDATA"];
    ojfn _ OpenFile[infile, 4B11, WriteAccess];
    IF pass = 1
      THEN mergesort[PROCEDURE readrec, PROCEDURE writerec, PROCEDURE compare1, PROCEDURE combine, FALSE]
      ELSE mergesort[PROCEDURE readrec, PROCEDURE writerec, PROCEDURE compare2, PROCEDURE combine, TRUE];
    JSYS [sout, ojfn, 444400B6+BASE[ibuffer], -4];
    CloseFile[ojfn, FALSE];
    END;

  sort3data: PROCEDURE =
    BEGIN
    infile, fstr: STRING[50];
    SetStrNull[datadir]; SetStrNull[dataext];
    AppendString[datadir,"<RESMESA>"];
    newinput[];
    soutty["output: "];
    ReadString[fstr, EOL];
    buildfilename[infile, fstr, "<RESMESA>",".sortedata"];
    ojfn _ OpenFile[infile, 4B11, WriteAccess];
    mergesort[PROCEDURE readrec3, PROCEDURE writerec, PROCEDURE compare3, PROCEDURE combine3, FALSE];
    JSYS [sout, ojfn, 444400B6+BASE[ibuffer], -4];
    CloseFile[ojfn, FALSE];
    END;

  nsamples: INTEGER _ 10;

  collapse3data: PROCEDURE =
    BEGIN
    chunkcounts: ARRAY [1..20] OF INTEGER;
    i: INTEGER;
    han, pat, phtot: INTEGER;
    ct: INTEGER;
    outfile, fstr: STRING[50];
    SetStrNull[datadir]; SetStrNull[dataext];
    AppendString[datadir,"<RESMESA>"];
    AppendString[dataext,".sortedata"];
    soutty["output: "];
    ReadString[fstr, EOL];
    buildfilename[outfile, fstr, "<RES>",".PATCHUNK"];
    ojfn _ OpenFile[outfile, 4B11, WriteAccess];
    JSYS[bout, ojfn, nsamples];
    newinput[];
    readrec[];
    WHILE ibuffer[0] # -1 DO
      BEGIN
      FOR i THRU [1..nsamples] DO
	chunkcounts[i] _ 0;
      pat _ ibuffer[0];
      han _ ibuffer[1];
      phtot _ 0;
      DO
	BEGIN
	chunkcounts[ibuffer[2]] _ ibuffer[3];
	phtot _ phtot+ibuffer[3];
	readrec[];
	END
      UNTIL ibuffer[0] # pat OR ibuffer[1] # han;
      JSYS[bout, ojfn, pat];
      JSYS[bout, ojfn, han];
      JSYS[bout, ojfn, phtot];
      JSYS[sout, ojfn, 444400B6+@chunkcounts[1], -nsamples];
      END;
    JSYS[bout, ojfn, -1];
    CloseFile[ojfn, -1];
    END;

  collapsedata: PROCEDURE =
    BEGIN
    outfile, fstr: STRING[50];
    newinput[];
    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
    soutty["output: "];
    ReadString[fstr, EOL];
    buildfilename[outfile, fstr, "<RES>",".PATCOMP"];
    ojfn _ OpenFile[outfile, 4B11, WriteAccess];
    mergesort[PROCEDURE treadrec, PROCEDURE twriterec, PROCEDURE tcompare, PROCEDURE scream, TRUE];
    JSYS [sout, ojfn, 444400B6+BASE[ibuffer], -4];
    CloseFile[ojfn, FALSE];
    END;

  patseqgen: PROCEDURE =
    BEGIN
    outfile, fstr: STRING[50];
    newinput[];
    JSYS [sin, ijfn, 444400B6+BASE[ibuffer], -4];
    soutty["output: "];
    ReadString[fstr, EOL];
    buildfilename[outfile, fstr, "<RES>",".PATSEQDATA"];
    ojfn _ OpenFile[outfile, 4B11, WriteAccess];
    mergesort[PROCEDURE treadrec, PROCEDURE pswriterec, PROCEDURE tcompare, PROCEDURE scream, TRUE];
    JSYS [sout, ojfn, 444400B6+BASE[ibuffer], -2];
    CloseFile[ojfn, FALSE];
    END;

  CREATE "sdio" FROM "<mps>cmgio";

  Bind[CREATE "sortmerge" FROM "<sweet>sortmerge"];

  END.