Relay-Version: version B 2.10.3 4.3bsd-beta 6/6/85; site seismo.UUCP Posting-Version: version B 2.10.2 9/3/84; site genrad.UUCP Path: seismo!harvard!think!mit-eddie!genrad!sources-request From: sources-request@genrad.UUCP Newsgroups: mod.sources Subject: Software Tools in Pascal (Part 2 of 6) Message-ID: <939@genrad.UUCP> Date: 12 Jul 85 23:11:59 GMT Sender: john@genrad.UUCP Lines: 1023 Approved: john@genrad.UUCP 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