ESORTD.P

[Table of Contents]

 ESORTD.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

Source Code

PROGRAM ESORT_DEMO;

(* EXTERNAL SORT ROUTINE
   DEMONSTRATION PROGRAM.

  COPYRIGHT (C) 1986 BY
  KYAN SOFTWARE, INC.  *)


TYPE
#I SRTMERGT.I
(* RECORD OF 100 BYTES *)
   BIGRECTYPE   = RECORD
                     EXTRA1  : ARRAY[1..98] OF CHAR;
                     INFOKEY : INTEGER
                  END;

VAR
#I SRTMERGV.I

#I ADDDEV.I
#I DELETE.I
#I MERGE.I
#I ESORT.I


FUNCTION RND:REAL;
BEGIN
RND:=0;
#A
 TXA
 PHA
 LDA #0
 STA _T
RAN1 INC _T
 JSR POLY
 CMP #0
 BEQ RAN1
 ORA #$10
 LDY #5
 STA (_SP),Y
;
RAN2 INY
 JSR POLY
 ROL
 ROL
 ROL
 ROL
 AND #$F0
 STA _T+1
 JSR POLY
 ORA _T+1
 STA (_SP),Y
 CPY #11
 BCC RAN2
 LDA _T
 INY
 STA (_SP),Y
 PLA
 TAX
#
END;
#A
POLY TYA
 PHA
 LDY #0
POLY1 INY
 CLC
 ROL POLYN
 ROL POLYN+1
 ROL POLYN+2
 ROL POLYN+3
 ROL POLYN+4
 ROL POLYN+5
 ROL POLYN+6
 ROL POLYN+7
 BCC POLY3
;
 LDX #0
POLY2 LDA POLYN,X
 EOR GEN,X
 STA POLYN,X
 INX
 CPX #8
 BCC POLY2
 SEC
;
POLY3 ROL _T+2
 CPY #4
 BCC POLY1
;
 PLA
 TAY
 LDA _T+2
 AND #$0F
 CMP #$0A
 BCS POLY
 RTS
;
GEN DB $A1
 DB $A2
 DB $1A
 DB $A2
 DB $91
 DB $C3
 DB $93
 DB $C0
;
POLYN DB $63
 DB $42
 DB $A1
 DB $23
 DB $55
 DB $09
 DB $03
 DB $87
#


PROCEDURE HOME;
BEGIN
    WRITE(CHR(125));
END;


PROCEDURE BUILD_TEST_FILE;
VAR I:INTEGER;
    F:FILE OF BIGRECTYPE;
BEGIN
   WRITELN('GENERATING RANDOM DATA...');
   REWRITE(F,'DATAFILE');
   FOR I:=1 TO 75 DO
   BEGIN
      F^.INFOKEY:=ROUND(125*RND);
      WRITE(F^.INFOKEY:10);
      PUT(F);
   END;
   WRITELN
END;


PROCEDURE SHOW_TEST_FILE;
VAR I,J:INTEGER;
   F:FILE OF BIGRECTYPE;
BEGIN
   WRITELN('PRESS RETURN TO SEE SORTED FILE...');
   READLN;
   RESET(F,'DATAFILE');
   WHILE NOT EOF(F) DO
   BEGIN
      WRITE(F^.INFOKEY:10);
      GET(F)
   END;
   WRITELN
END;


BEGIN
   FYLE:='DATAFILE            ';
   HOME;
   WRITELN('*** ESORT DEMONSTRATION ***');
   WRITELN;
   WRITELN('THERE WILL BE 75 RECORDS SORTED.  EACH');
   WRITELN('RECORD IS 100 BYTES IN LENGTH.  THE KEY');
   WRITELN('FIELD IS AN INTEGER....');
   WRITELN('PRESS RETURN TO BEGIN...'); READLN;
   BUILD_TEST_FILE;
   ORDER:=1;
   RLEN:=100;
   OSET:=98;
   KLEN:=2;
   KTYPE:=INTEGER_FIELD;
   WRITELN('SORTING....');
   WRITELN('<PLEASE WAIT APPROX 1 MINUTE>...');
   ESORT;
   SHOW_TEST_FILE
END.