home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
15a
/
murutil.zip
/
SORT80.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-12-10
|
6KB
|
260 lines
PROGRAM SORT80;
{ This Turbo Pascal program sorts an input file of up to 6000
80-character records and writes a sorted output file.
Note: The maximum number of input records is declared in
MAXNINP. The value of 6000 is appropriate for a
computer with 640 Kilobytes. For computers with
smaller memory, this figure should be reduced.
Program by Harry M. Murphy, 18 August 1986.
Revised by H.M.M. on 21 Oct 1986 to check for record overflow.
Revised by H.M.M. on 29 Oct 1986 to simplify the pointers and
to trim possible trailing blanks.
NOTICE
Copyright 1986, Harry M. Murphy.
A general license is hereby granted for non-commercial
use, copying and free exchange of this program without
payment of any royalties, provided that this copyright
notice is not altered nor deleted. All other rights are
reserved. }
CONST
LENSPEC = 65;
LINELEN = 80;
MAXNINP = 6000;
TYPE
FILESPEC = STRING[LENSPEC];
TEXTLINE = STRING[LINELEN];
LINEP = ^TEXTLINE;
VAR
FREE0 : REAL;
FREE1 : REAL;
FREE : REAL;
INP : TEXT[2048];
INPNAME: FILESPEC;
NINP : INTEGER;
OUT : TEXT[2048];
OUTNAME: FILESPEC;
LINPA : ARRAY [1..MAXNINP] OF LINEP;
PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);
{ This file gets an input file, either as the first parameter
on the command line or by requesting it from the user.
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
L: INTEGER;
BEGIN
IF PARAMCOUNT = 0
THEN
BEGIN
WRITE('Input file: ');
READLN(INPNAME)
END
ELSE
INPNAME := PARAMSTR(1);
FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L] := UPCASE(INPNAME[L]);
ASSIGN(INP,INPNAME);
{$I-} RESET(INP); {$I+}
IF IORESULT <> 0
THEN
BEGIN
CLOSE(INP);
WRITELN('ERROR! Can''t find file ',INPNAME,'!');
HALT
END;
END {Procedure GETINPFIL};
PROCEDURE GETOUTFIL(VAR OUTNAME: FILESPEC);
{ This file gets an output file, either as the second parameter
on the command line or by requesting it from the user.
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
L: INTEGER;
BEGIN
IF PARAMCOUNT < 2
THEN
BEGIN
WRITE('Output file: ');
READLN(OUTNAME)
END
ELSE
OUTNAME := PARAMSTR(2);
FOR L:=1 TO LENGTH(OUTNAME) DO OUTNAME[L] := UPCASE(OUTNAME[L]);
ASSIGN(OUT,OUTNAME);
{$I-} REWRITE(OUT); {$I-}
IF IORESULT <> 0
THEN
BEGIN
CLOSE(OUT);
WRITELN('ERROR! Can''t open ',OUTNAME,'!');
HALT
END
END {Procedure GETOUTFIL};
FUNCTION KBYTFREE: REAL;
{ This Turbo Pascal function returns the size of the largest
consecutive block of free space, in Kilobytes, on the heap
as a REAL number.
Function by Harry M. Murphy, 18 August 1986. }
CONST
CON = 0.016; {Kilobytes per "paragraph" of 16 bytes.}
VAR
MAXA : INTEGER;
BEGIN
MAXA := MAXAVAIL;
IF MAXA < 0
THEN
KBYTFREE := CON*(65536.0+MAXA)
ELSE
KBYTFREE := CON*MAXA
END {Function KBYTFREE};
PROCEDURE GETTEXT;
{ This routine reads the input file, updates the pointer array,
LINPA and stores the input records in LINE^. }
VAR
L : 0..LINELEN;
LINE : LINEP;
BEGIN
NINP := 0;
LINE := NIL;
WHILE (NOT EOF(INP)) AND (KBYTFREE > 10.0) DO
BEGIN
NINP:=NINP+1;
IF NINP <= MAXNINP
THEN
BEGIN
NEW(LINE);
LINPA[NINP] := LINE
END;
READLN(INP,LINE^);
L := LENGTH(LINE^);
LINE^[0] := CHR(0);
WHILE LINE^[L] = ' ' DO
BEGIN
L := L-1;
LINE^[0] := CHR(L)
END
END
END {Procedure GETTEXT};
PROCEDURE PUTTEXT;
{ This procedure writes the sorted output file. }
VAR
I : INTEGER;
LINE : LINEP;
BEGIN
FOR I:=1 TO NINP DO
BEGIN
LINE := LINPA[I];
WRITELN(OUT,LINE^)
END
END {Procedure PUTTEXT};
PROCEDURE SRTTEXT;
{ This procedure sorts the data, using a Shell pointer sort. }
VAR
I : INTEGER;
J : INTEGER;
M : INTEGER;
SRT : BOOLEAN;
SWAP: LINEP;
BEGIN
I := 1;
WHILE I <= NINP DO I := I+I;
M := I-1;
WHILE M > 1 DO
BEGIN
M := M DIV 2;
REPEAT
SRT := TRUE;
FOR J:=1 TO NINP-M DO
BEGIN
I := J+M;
IF LINPA[J]^ > LINPA[I]^
THEN
BEGIN
SWAP := LINPA[I];
LINPA[I] := LINPA[J];
LINPA[J] := SWAP;
SRT := FALSE
END
END
UNTIL SRT
END
END {Procedure SRTTEXT};
BEGIN {Program SORT80}
LOWVIDEO;
GETINPFIL(INPNAME);
GETOUTFIL(OUTNAME);
WRITELN;
WRITELN('SORT80 sorting ',INPNAME,' ==> ',OUTNAME,':');
WRITELN;
FREE0 := KBYTFREE;
GETTEXT;
CLOSE(INP);
FREE1 := KBYTFREE;
FREE := FREE0-FREE1;
WRITELN(NINP:8,' records read from ',INPNAME,'.');
IF NINP > MAXNINP
THEN
BEGIN
NORMVIDEO;
WRITELN('This exceeds the maximum of',MAXNINP:6,' records.');
WRITELN('This run is aborted.');
LOWVIDEO;
CLOSE(OUT);
ERASE(OUT)
END
ELSE
BEGIN
WRITELN(FREE:8:3,' Kilobytes used.');
WRITELN(FREE1:8:3,' Kilobytes free.');
WRITE(' Sorting the records now.',CHR(13));
SRTTEXT;
WRITELN(' Writing',NINP:6,' records to ',OUTNAME,'.');
PUTTEXT;
CLOSE(OUT);
WRITELN;
WRITELN('SORT80 is done.')
END
END.