Software Tools in Pascal (Part 2 of 6)

sources-request at genrad.UUCP sources-request at genrad.UUCP
Sat Jul 13 09:11:59 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 Mod.sources mailing list