Software Tools in Pascal (Part 2 of 6)
sources-request%genrad.UUCP at isi-hobgoblin
sources-request%genrad.UUCP at isi-hobgoblin
Thu Jul 25 03:39:20 AEST 1985
Mod.sources: Volume 2, Issue 8
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 02 of 06:'
echo 'x - charclas.pascal'
sed 's/^X//' > charclas.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CharClass -- definition of character table }
Xsegment CharClass;
X%include swtools
X%include chardef
Xvalue
X CharTable := ChTable(
X [] { 00 }, [] { 01 }, [] { 02 }, [] { 03 },
X [] { 04 }, [] { 05 }, [] { 06 }, [] { 07 },
X [] { 08 }, [] { 09 }, [] { 0a }, [] { 0b },
X [] { 0c }, [] { 0d }, [] { 0e }, [] { 0f },
X [] { 10 }, [] { 11 }, [] { 12 }, [] { 13 },
X [] { 14 }, [] { 15 }, [] { 16 }, [] { 17 },
X [] { 18 }, [] { 19 }, [] { 1a }, [] { 1b },
X [] { 1c }, [] { 1d }, [] { 1e }, [] { 1f },
X [] { 20 }, [] { 21 }, [] { 22 }, [] { 23 },
X [] { 24 }, [] { 25 }, [] { 26 }, [] { 27 },
X [] { 28 }, [] { 29 }, [] { 2a }, [] { 2b },
X [] { 2c }, [] { 2d }, [] { 2e }, [] { 2f },
X [] { 30 }, [] { 31 }, [] { 32 }, [] { 33 },
X [] { 34 }, [] { 35 }, [] { 36 }, [] { 37 },
X [] { 38 }, [] { 39 }, [] { 3a }, [] { 3b },
X [] { 3c }, [] { 3d }, [] { 3e }, [] { 3f },
X [ChSpecial] { 40 },
X [] { 41 }, [] { 42 }, [] { 43 },
X [] { 44 }, [] { 45 }, [] { 46 }, [] { 47 },
X [] { 48 }, [] { 49 },
X [ChSpecial] { 4a }, [ChSpecial] { 4b },
X [ChSpecial] { 4c }, [ChSpecial] { 4d },
X [ChSpecial] { 4e }, [ChSpecial] { 4f },
X [ChSpecial] { 50 },
X [] { 51 }, [] { 52 }, [] { 53 },
X [] { 54 }, [] { 55 }, [] { 56 }, [] { 57 },
X [] { 58 }, [] { 59 },
X [ChSpecial] { 5a }, [ChSpecial] { 5b },
X [ChSpecial] { 5c }, [ChSpecial] { 5d },
X [ChSpecial] { 5e }, [ChSpecial] { 5f },
X [ChSpecial] { 60 }, [ChSpecial] { 61 },
X [] { 62 }, [] { 63 },
X [] { 64 }, [] { 65 }, [] { 66 }, [] { 67 },
X [] { 68 }, [] { 69 }, [] { 6a },
X [ChSpecial] { 6b },
X [ChSpecial] { 6c }, [ChSpecial] { 6d },
X [ChSpecial] { 6e }, [ChSpecial] { 6f },
X [] { 70 }, [] { 71 }, [] { 72 }, [] { 73 },
X [] { 74 }, [] { 75 }, [] { 76 }, [] { 77 },
X [] { 78 }, [] { 79 },
X [ChSpecial] { 7a }, [ChSpecial] { 7b },
X [ChSpecial] { 7c }, [ChSpecial] { 7d },
X [ChSpecial] { 7e }, [ChSpecial] { 7f },
X [] { 80 },
X [ChLetter,ChLower] { 81 },
X [ChLetter,ChLower] { 82 }, [ChLetter,ChLower] { 83 },
X [ChLetter,ChLower] { 84 }, [ChLetter,ChLower] { 85 },
X [ChLetter,ChLower] { 86 }, [ChLetter,ChLower] { 87 },
X [ChLetter,ChLower] { 88 }, [ChLetter,ChLower] { 89 },
X [] { 8a },
X [ChSpecial] { 8b },
X [] { 8c }, [] { 8d }, [] { 8e }, [] { 8f },
X [] { 90 },
X [ChLetter,ChLower] { 91 },
X [ChLetter,ChLower] { 92 }, [ChLetter,ChLower] { 93 },
X [ChLetter,ChLower] { 94 }, [ChLetter,ChLower] { 95 },
X [ChLetter,ChLower] { 96 }, [ChLetter,ChLower] { 97 },
X [ChLetter,ChLower] { 98 }, [ChLetter,ChLower] { 99 },
X [] { 9a },
X [ChSpecial] { 9b },
X [] { 9c }, [] { 9d }, [] { 9e }, [] { 9f },
X [] { a0 }, [] { a1 },
X [ChLetter,ChLower] { a2 }, [ChLetter,ChLower] { a3 },
X [ChLetter,ChLower] { a4 }, [ChLetter,ChLower] { a5 },
X [ChLetter,ChLower] { a6 }, [ChLetter,ChLower] { a7 },
X [ChLetter,ChLower] { a8 }, [ChLetter,ChLower] { a9 },
X [] { aa }, [] { ab },
X [] { ac },
X [ChSpecial] { ad },
X [] { ae }, [] { af },
X [] { b0 }, [] { b1 }, [] { b2 }, [] { b3 },
X [] { b4 }, [] { b5 }, [] { b6 }, [] { b7 },
X [] { b8 }, [] { b9 }, [] { ba }, [] { bb },
X [] { bc },
X [ChSpecial] { bd },
X [] { be }, [] { bf },
X [] { c0 },
X [ChLetter,ChUpper] { c1 },
X [ChLetter,ChUpper] { c2 }, [ChLetter,ChUpper] { c3 },
X [ChLetter,ChUpper] { c4 }, [ChLetter,ChUpper] { c5 },
X [ChLetter,ChUpper] { c6 }, [ChLetter,ChUpper] { c7 },
X [ChLetter,ChUpper] { c8 }, [ChLetter,ChUpper] { c9 },
X [] { ca }, [] { cb },
X [] { cc }, [] { cd }, [] { ce }, [] { cf },
X [] { d0 },
X [ChLetter,ChUpper] { d1 },
X [ChLetter,ChUpper] { d2 }, [ChLetter,ChUpper] { d3 },
X [ChLetter,ChUpper] { d4 }, [ChLetter,ChUpper] { d5 },
X [ChLetter,ChUpper] { d6 }, [ChLetter,ChUpper] { d7 },
X [ChLetter,ChUpper] { d8 }, [ChLetter,ChUpper] { d9 },
X [] { da }, [] { db },
X [] { dc }, [] { dd }, [] { de }, [] { df },
X [] { e0 }, [] { e1 },
X [ChLetter,ChUpper] { e2 }, [ChLetter,ChUpper] { e3 },
X [ChLetter,ChUpper] { e4 }, [ChLetter,ChUpper] { e5 },
X [ChLetter,ChUpper] { e6 }, [ChLetter,ChUpper] { e7 },
X [ChLetter,ChUpper] { e8 }, [ChLetter,ChUpper] { e9 },
X [] { ea }, [] { eb },
X [] { ec }, [] { ed }, [] { ee }, [] { ef },
X [ChDigit] { f0 }, [ChDigit] { f1 },
X [ChDigit] { f2 }, [ChDigit] { f3 },
X [ChDigit] { f4 }, [ChDigit] { f5 },
X [ChDigit] { f6 }, [ChDigit] { f7 },
X [ChDigit] { f8 }, [ChDigit] { f9 },
X [] { fa }, [] { fb },
X [] { fc }, [] { fd }, [] { fe }, [] { ff }
X );
Xfunction CharClass;
Xbegin
X CharClass := CharTable[Ord(tIndex)]
Xend;
/
echo 'x - docmd.pascal'
sed 's/^X//' > docmd.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoCmd -- handle all commands except globals }
Xsegment DoCmd;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoCmd;
Xvar
X fil, sub: StringType;
X line3: Integer;
X gFlag, pFlag: Boolean;
Xbegin
X pFlag := false; { may be set by d, m, s }
X status := ERR;
X case lin[i] of
X PCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X status := DoPrint(line1, line2);
X LCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X status := DoLPrint(line1, line2);
X NEWLINE: begin
X if (nLines = 0) then begin
X line2 := nextLn(curLn);
X line1 := line2;
X end; {if}
X status := DoPrint(line1, line2)
X end;
X QCMD:
X if (lin[i+1] = NEWLINE) and (nLines = 0) and (not glob) then
X status := ENDDATA;
X OCMD:
X if (not glob) then
X status := DoOption(lin, i);
X ACMD:
X if (lin[i+1] = NEWLINE) then
X status := Append(line2, glob);
X CCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X if (LnDelete(line1, line2, status) = OK) then
X status := Append(PrevLn(line1), glob);
X DCMD:
X if (CkP(lin, i+1, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X if (LnDelete(line1, line2, status) = OK) then
X if (NextLn(curLn) <> 0) then
X curLn := NextLn(curLn);
X ICMD:
X if (lin[i+1] = NEWLINE) then begin
X if (line2 = 0) then
X status := Append(0, glob)
X else
X status := Append(PrevLn(line2), glob)
X end;
X EQCMD:
X if (CkP(lin, i+1, pFlag, status) = OK) then begin
X PutDec(line2, 1);
X PutC(NEWLINE);
X end;
X KCMD: begin
X i := i + 1;
X SkipBl(lin, i);
X if (GetOne(lin, i, line3, status) = ENDDATA) then
X status := ERR;
X if (status = OK) then
X if (CkP(lin, i, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X status := Kopy(line3)
X end;
X MCMD: begin
X i := i + 1;
X SkipBl(lin, i);
X if (GetOne(lin, i, line3, status) = ENDDATA) then
X status := ERR;
X if (status = OK) then
X if (CkP(lin, i, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X status := Move(line3)
X end;
X SCMD: begin
X i := i + 1;
X if (OptPat(lin,i) = OK) then
X if (GetRHS(lin,i,sub,gFlag) = OK) then
X if (CkP(lin,i+1,pFlag,status) = OK) then
X if (Default(curLn,curLn,status) = OK) then
X status := SubSt(sub, gFlag, glob)
X end;
X ECMD:
X if (nLines = 0) then
X if (GetFn(lin, i, fil) = OK) then begin
X SCopy(fil, 1, saveFile, 1);
X ClrBuf;
X SetBuf;
X status := DoRead(0, fil)
X end;
X FCMD:
X if (nLines = 0) then
X if (GetFn(lin,i,fil) = OK) then begin
X SCopy(fil, 1, saveFile, 1);
X PutStr(saveFile, STDOUT);
X PutC(NEWLINE);
X status := OK
X end;
X RCMD:
X if (GetFn(lin, i, fil) = OK) then
X status := DoRead(line2, fil);
X WCMD:
X if (GetFn(lin,i,fil) = OK) then
X if (Default(1, lastLn, status) = OK) then
X status := DoWrite(line1, line2, fil)
X otherwise
X status := ERR
X end;
X if (status = OK) and (pFlag) then
X status := DoPrint(curLn, curLn);
X DoCmd := status
Xend;
/
echo 'x - fontinit.A'
sed 's/^X//' > fontinit.A << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Font -- definitions of font file }
Xsegment FontInit;
X%include swtools
Xconst
X nChars = 68;
X charHeight = 14;
X nFonts = 3;
X nElements = nChars * charHeight * nFonts;
Xtype
X CharElement = packed -32768..32767;
X ElementArray = array [1..nElements] of CharElement;
X FontFirstType = array [0..nFonts-1] of 0..charHeight-1;
X FontWidthType = packed array [1..nChars * nFonts] of
X 0..16;
Xdef
X fontWidth: FontWidthType;
X fontFirst: array [0..nFonts-1] of 0..charHeight-1;
X Displays: ElementArray;
X transArray: StringType;
Xprocedure FontInit; external;
X%PAGE
X{ BANNER FONTS }
Xvalue
X Displays := ElementArray(
X{' '}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X{'A'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X{'B'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0000011100000111'B,
X '0000000000000000'B,'0001111111111100'B,'0000011100000111'B,
X '0001111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011111111100'B,
X '0000110000110000'B,'0000011111111000'B,'0000011111111100'B,
X '0000111111100000'B,'0000011111111000'B,'0000011100000111'B,
X '0000111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111110'B,
X '0001111111100000'B,'0001111111111000'B,'0001111111111100'B,
X%PAGE
X{'C'}
X '0000000000000000'B,'0000000000000000'B,'0000111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111000000'B,'0001100000001100'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100001100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111100000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111000000'B,'0000111111111000'B,'0000011111111100'B,
X{'D'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0000011100000111'B,
X '0000000000000000'B,'0001111111111100'B,'0000011100000111'B,
X '0001111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111110'B,
X '0001111111100000'B,'0001111111111000'B,'0001111111111100'B,
X{'E'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001111111111000'B,
X '0001100000000000'B,'0001111111100000'B,'0001111111111000'B,
X '0001111110000000'B,'0001111111100000'B,'0001110000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X%PAGE
X{'F'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001111111111000'B,
X '0001100000000000'B,'0001111111100000'B,'0001111111111000'B,
X '0001111110000000'B,'0001111111100000'B,'0001110000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X{'G'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000110000'B,'0001100000000000'B,'0001110001111110'B,
X '0001100000000000'B,'0001100000000000'B,'0001110001111111'B,
X '0001100111100000'B,'0001100001111000'B,'0001110000000111'B,
X '0001100111110000'B,'0001100001111100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X{'H'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X%PAGE
X{'I'}
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000011100000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000011100000000'B,
X '0001111110000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111110000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X{'J'}
X '0000000000000000'B,'0000000000000000'B,'0000000011111111'B,
X '0000000000000000'B,'0000000000000000'B,'0000000011111111'B,
X '0000000000000000'B,'0000000111111110'B,'0000000011111111'B,
X '0000000000000000'B,'0000000111111110'B,'0000000000011100'B,
X '0000001111110000'B,'0000000000110000'B,'0000000000011100'B,
X '0000001111110000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001100011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001111111000000'B,'0000111111110000'B,'0000111111111100'B,
X '0000111110000000'B,'0000011111100000'B,'0000011111111000'B,
X{'K'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000001110'B,
X '0000000000000000'B,'0001100000110000'B,'0001110000011100'B,
X '0000000000000000'B,'0001100001100000'B,'0001110000111000'B,
X '0001100001100000'B,'0001100011000000'B,'0001110001110000'B,
X '0001100011000000'B,'0001100110000000'B,'0001110011100000'B,
X '0001100110000000'B,'0001101100000000'B,'0001111111000000'B,
X '0001101100000000'B,'0001111000000000'B,'0001111111000000'B,
X '0001111000000000'B,'0001111000000000'B,'0001110011100000'B,
X '0001111000000000'B,'0001101100000000'B,'0001110001110000'B,
X '0001101100000000'B,'0001100110000000'B,'0001110000111000'B,
X '0001100110000000'B,'0001100011000000'B,'0001110000011100'B,
X '0001100011000000'B,'0001100001100000'B,'0001110000001110'B,
X '0001100001100000'B,'0001100000110000'B,'0001110000000111'B,
X%PAGE
X{'L'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X{'M'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000001'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000001110'B,'0001111000001111'B,
X '0001100000011000'B,'0001111000011110'B,'0001111100011111'B,
X '0001110000111000'B,'0001111100111110'B,'0001111110111111'B,
X '0001111001111000'B,'0001101111110110'B,'0001111111111111'B,
X '0001111111111000'B,'0001100111100110'B,'0001110111110111'B,
X '0001101111011000'B,'0001100011000110'B,'0001110011100111'B,
X '0001100110011000'B,'0001100000000110'B,'0001110001000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X{'N'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000000110'B,'0001111000000111'B,
X '0001100000011000'B,'0001111000000110'B,'0001111100000111'B,
X '0001110000011000'B,'0001111100000110'B,'0001111110000111'B,
X '0001111000011000'B,'0001101110000110'B,'0001110111000111'B,
X '0001111100011000'B,'0001100111000110'B,'0001110011100111'B,
X '0001101110011000'B,'0001100011100110'B,'0001110001110111'B,
X '0001100111011000'B,'0001100001110110'B,'0001110000111111'B,
X '0001100011111000'B,'0001100000111110'B,'0001110000011111'B,
X '0001100001111000'B,'0001100000011110'B,'0001110000001111'B,
X '0001100000111000'B,'0001100000001110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000011'B,
X%PAGE
X{'O'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111111000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111111000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111110000'B,'0000111111111000'B,'0000011111111100'B,
X{'P'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111110'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111100'B,
X '0001111111110000'B,'0001111111111000'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X{'Q'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001100111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001110111'B,
X '0001100000110000'B,'0001100011001100'B,'0001110000111111'B,
X '0001100110110000'B,'0001100001101100'B,'0001110000011111'B,
X '0001100011110000'B,'0001100000111100'B,'0001110000001110'B,
X '0001111111100000'B,'0001111111111000'B,'0000111111111111'B,
X '0000111110110000'B,'0000111111101100'B,'0000011111110011'B,
X%PAGE
X{'R'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111110'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111100'B,
X '0001111111110000'B,'0001111111111000'B,'0001110011100000'B,
X '0001111111100000'B,'0001100011000000'B,'0001110001110000'B,
X '0001100110000000'B,'0001100001100000'B,'0001110000111000'B,
X '0001100011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001100001100000'B,'0001100000011000'B,'0001110000001110'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X{'S'}
X '0000000000000000'B,'0000000000000000'B,'0000001111111000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111110000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000011000'B,'0000111000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0000011100000000'B,
X '0001100000110000'B,'0001100000000000'B,'0000000111000000'B,
X '0001100000000000'B,'0001111111110000'B,'0000000001110000'B,
X '0001111111100000'B,'0000111111111000'B,'0000000000011100'B,
X '0000111111110000'B,'0000000000011000'B,'0000000000001110'B,
X '0000000000110000'B,'0000000000011000'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000011000'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111000'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111110000'B,'0000001111111000'B,
X{'T'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111110'B,'0000000011100000'B,
X '0000000000000000'B,'0001111111111110'B,'0000000011100000'B,
X '0001111111111000'B,'0000000011000000'B,'0000000011100000'B,
X '0001111111111000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X%PAGE
X{'U'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X{'V'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0000110000001110'B,
X '0001100000011000'B,'0000110000001100'B,'0000011100011100'B,
X '0000110000110000'B,'0000011000011000'B,'0000001110111000'B,
X '0000011001100000'B,'0000001100110000'B,'0000000111110000'B,
X '0000001111000000'B,'0000000111100000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000001000000'B,
X{'W'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110001000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110011100111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110111110111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111110111111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111100011111'B,
X '0001100100110000'B,'0001100010001100'B,'0001111000001111'B,
X '0001101110110000'B,'0000110111011000'B,'0001110000000111'B,
X '0000111011100000'B,'0000011101110000'B,'0001100000000011'B,
X '0000010001000000'B,'0000001000100000'B,'0001000000000001'B,
X%PAGE
X{'X'}
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000011'B,'0000111000001110'B,
X '0000000000000000'B,'0000110000000110'B,'0000011100011100'B,
X '0001100000001100'B,'0000011000001100'B,'0000001110111000'B,
X '0000110000011000'B,'0000001100011000'B,'0000000111110000'B,
X '0000011000110000'B,'0000000110110000'B,'0000000011100000'B,
X '0000001101100000'B,'0000000011100000'B,'0000000111110000'B,
X '0000000111000000'B,'0000000011100000'B,'0000001110111000'B,
X '0000000111000000'B,'0000000110110000'B,'0000011100011100'B,
X '0000001101100000'B,'0000001100011000'B,'0000111000001110'B,
X '0000011000110000'B,'0000011000001100'B,'0001110000000111'B,
X '0000110000011000'B,'0000110000000110'B,'0001100000000011'B,
X '0001100000001100'B,'0001100000000011'B,'0001000000000001'B,
X{'Y'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000001'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0001100000000011'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000000111'B,'0000111000001110'B,
X '0001100000000110'B,'0000111000001110'B,'0000011100011100'B,
X '0000110000001100'B,'0000011100011100'B,'0000001110111000'B,
X '0000011000011000'B,'0000001110111000'B,'0000000111110000'B,
X '0000001100110000'B,'0000000111110000'B,'0000000011100000'B,
X '0000000111100000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X{'Z'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000001110'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000011100'B,
X '0001111111110000'B,'0000000000011000'B,'0000000000111000'B,
X '0001111111110000'B,'0000000000110000'B,'0000000001110000'B,
X '0000000001100000'B,'0000000001100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011000000'B,'0000000111000000'B,
X '0000000110000000'B,'0000000110000000'B,'0000001110000000'B,
X '0000001100000000'B,'0000001100000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000111000000000'B,
X '0000110000000000'B,'0000110000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X%PAGE
X{'a'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0000111100000000'B,'0001100011000000'B,'0001111111100000'B,
X '0001000010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111110000000'B,'0001111111000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001100011000000'B,'0001100001100000'B,
X{'b'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0000110001100000'B,
X '0001111100000000'B,'0000100011000000'B,'0000111111000000'B,
X '0000100010000000'B,'0000111110000000'B,'0000111111000000'B,
X '0000111100000000'B,'0000100011000000'B,'0000110001100000'B,
X '0000100010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111100000000'B,'0001111110000000'B,'0001111111000000'B,
X{'c'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0000111110000000'B,'0001100011000000'B,'0001100000000000'B,
X '0001000010000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0000111110000000'B,'0000111110000000'B,'0000111111000000'B,
X%PAGE
/
echo 'x - sort.pascal'
sed 's/^X//' > sort.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SortDriv -- Driver and Quick sort }
Xprogram Sort;
X%include SWTOOLS
X%include ioref
Xconst
X inCoreSize = 500;
X MERGEORDER = 5;
Xtype
X LineType = -> StringType;
X fdBufType = array [1..MERGEORDER] of FileDesc;
Xvar
X notEof: Boolean;
X inBuf: array [1..inCoreSize] of LineType;
X inFile: fdBufType;
X i: Integer;
X temp: StringType;
X depth: Integer;
X maxDepth: Integer;
Xprocedure GName (n: Integer; var name: StringType);
Xvar
X junk: Integer;
X temp: String(30);
Xbegin
X WriteStr(temp, 'STEMP',n:1,' TEMP A');
X name := temp;
Xend; {GName}
Xprocedure GOpen (var inFile: fdBufType; f1, f2: Integer);
Xvar
X name: StringType;
X i: 1..MERGEORDER;
Xbegin
X for i := 1 to f2-f1+1 do begin
X GName (f1+i-1, name);
X inFile[i] := MustOpen(name, IOREAD);
X end; {for}
Xend; {GOpen}
Xprocedure GRemove (var inFile: fdBufType; f1, f2: Integer);
Xvar
X name: StringType;
X i: 1..MERGEORDER;
Xbegin
X for i := 1 to f2-f1+1 do begin
X FClose (inFile[i]);
X GName (f1+i-1, name);
X Remove (name);
X end; {for}
Xend; {GRemove}
Xfunction MakeFile (n: Integer): FileDesc;
Xvar
X name: StringType;
X temp: FileDesc;
Xbegin
X GName (n, name);
X temp := FCreate (name, IOWRITE);
X if temp = IOERROR then
X Error('Could not create temporary file' || Str(name));
X MakeFile := temp;
Xend; {MakeFile}
Xprocedure PText (nLines: Integer; outFile: FileDesc);
Xvar
X i: Integer;
Xbegin
X for i := 1 to nLines do begin
X PutStr(inBuf[i]@, outFile);
X end; {for}
Xend; {PText}
Xfunction GText (var nLines: Integer; inFile: FileDesc): Boolean;
Xvar
X temp: StringType;
X done: Boolean;
Xbegin
X nLines := 1;
X done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
X while (not done) do begin
X nLines := nLines + 1;
X if nLines > inCoreSize then leave;
X done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
X end; {while}
X nLines := nLines - 1;
X GText := done;
Xend; {GText}
X
Xprocedure QSort(l,r: integer);
X var i,j: integer;
X temp, hold: LineType;
Xbegin
X if l >= r then return;
X depth := depth + 1;
X maxDepth := Max (maxDepth, depth);
X i := l;
X j := r;
X temp := inBuf[(i+j) div 2];
X repeat
X while inBuf[i]@ < temp@ do
X i := i+1;
X while temp@ < inBuf[j]@ do
X j := j-1;
X if i <= j then begin
X hold := inBuf[i];
X inBuf[i] := inBuf[j];
X inBuf[j] := hold;
X i := i+1;
X j := j-1
X end
X until i > j;
X { if left smaller do: }
X if (j - l) < (r - i) then begin
X QSort(l,j); {left side first}
X QSort(i,r);
X end
X else begin
X QSort(i,r); {right side first}
X QSort(l,j);
X end; {if}
X depth := depth - 1;
Xend {QSort} ;
X{ Merge -- Merge infile[1] .. infile[nf] into outfile }
Xprocedure Merge(var inFile: fdBufType; nf: Integer; outFile: FileDesc);
Xvar
X i,j: Integer;
X lbp: Integer;
X temp: LineType;
X fromArray: array [1..MERGEORDER] of Integer;
Xprocedure ReHeap (nf: Integer);
Xvar
X i,j,k: Integer;
X temp: LineType;
Xbegin
X i := 1;
X j := 2 * i;
X while (j <= nf) do begin
X if (j < nf) then { find smaller child }
X if inBuf[j]@ > inBuf[j+1]@ then
X j := j + 1;
X if inBuf[i]@ <= inBuf[j]@ then
X i := nf { proper position found, terminate loop }
X else begin
X k := fromArray[i];
X fromArray[i] := fromArray[j];
X fromArray[j] := k;
X temp := inBuf[i];
X inBuf[i] := inBuf[j];
X inBuf[j] := temp;
X end; {if}
X i := j;
X j := 2 * i;
X end; {while}
Xend; {while}
Xprocedure PermSort(l,r: Integer);
Xvar
X i,j,k: Integer;
X temp: LineType;
Xbegin
X for i := 1 to r do
X fromArray[i] := i;
X
X for i := r downto 2 do
X for j := 1 to i-1 do
X if inBuf[j]@ > inBuf[j + 1]@ then begin
X k := fromArray[j];
X fromArray[j] := fromArray[j + 1];
X fromArray[j + 1] := k;
X temp := inBuf[j];
X inBuf[j] := inBuf[j + 1];
X inBuf[j + 1] := temp;
X end; {if}
Xend; {PermSort}
Xbegin
X j := 1;
X for i := 1 to nf do { get one line from each file }
X if GetLine(inBuf[j]@, inFile[i], MAXSTR) then
X j := j + 1;
X nf := j - 1;
X PermSort (1, nf); { make initial heap }
X while (nf > 0) do begin
X PutStr(inBuf[1]@, outFile);
X if not
X (GetLine(inBuf[1]@, inFile[fromArray[1]], MAXSTR))
X then begin
X temp := inBuf[1];
X inBuf[1] := inBuf[nf];
X inBuf[nf] := temp;
X fromArray[1] := fromArray[nf];
X nf := nf - 1;
X end; {if}
X ReHeap(nf);
X end; {while}
Xend; {Merge}
X
Xvar
X done: Boolean;
X nLines: Integer;
X highMark: Integer;
X lowMark: Integer;
X lim: Integer;
X outFile: FileDesc;
X name: StringType;
Xbegin
X ToolInit;
X highMark := 0;
X for i := 1 to inCoreSize do
X New(inBuf[i]);
X
X repeat { initial formation of runs }
X done := GText (nLines, STDIN);
X depth := 0;
X maxDepth := 0;
X QSort(1, nLines);
X highMark := highMark + 1;
X outFile := MakeFile(highMark);
X PText (nLines, outFile);
X FClose (outFile);
X until (done);
X lowMark := 1;
X while (lowMark < highMark) do begin { merge runs }
X lim := Min(lowMark + MERGEORDER - 1, highMark);
X GOpen (inFile, lowMark, lim);
X highMark := highMark + 1;
X outFile := MakeFile(highMark);
X Merge(inFile, lim-lowMark+1, outFile);
X FClose (outFile);
X GRemove (inFile, lowMark, lim);
X lowMark := lowMark + MERGEORDER;
X end; {while}
X GName (highMark, name); { final cleanup }
X outFile := FOpen (name, IOREAD);
X FCopy (outFile, STDOUT);
X FClose (outFile);
X Remove (name);
Xend.
/
echo 'Part 02 of pack.out complete.'
exit
More information about the Comp.sources.unix
mailing list