From: "Rao, Raghu" <[log in to unmask]>
> Hi all,
>
> Is there anyway that I can SORT a RECORD in a COBOL program (without using
a
> FILE).
Here is a COBOL wrapper for 'qsort'
I've also put it on my web site http://invent3k.external.hp.com/~KEN.HIRSCH/
as cobqsort.zip, along with an example program.
$CONTROL SUBPROGRAM,POST85
IDENTIFICATION DIVISION.
PROGRAM-ID. COBQSORT.
$VERSION "$Id$"
*
* Author. Ken Hirsch. [log in to unmask]
* July 28, 2000
*
* A subroutine used to call 'qsort', the standard C quicksort
* subroutine, from a COBOL program on the HP3000.
*
* It will sort a COBOL table in memory.
*
* To call it, you need to create a comparison routine
* specialized for the particular table you're sorting.
*
* You can create more than one routine if you have more
* than one sort order for that table.
*
* The comparison routines takes 2 records from the table
* as arguments. It must return a negative number in
* RETURN-CODE if the first record comes after the second,
* a positive number if the first record comes before the second,
* or zero if they compare equal.
* (Think: KEY1 minus KEY2)
*
* For example:
*$CONTROL POST85,DYNAMIC
*IDENTIFICATION DIVISION.
*PROGRAM-ID. SORTORDER1.
*DATA DIVISION.
*LINKAGE SECTION.
*01 RECORD-A.
* 05 SOME-DATA PIC X(20).
* 05 SOME-KEY PIC X(10).
* 05 MORE-DATA PIC X(08).
* 05 ANOTHER-KEY PIC S9(7) COMP-3.
*
*01 RECORD-B.
* 05 SOME-DATA PIC X(20).
* 05 SOME-KEY PIC X(10).
* 05 MORE-DATA PIC X(08).
* 05 ANOTHER-KEY PIC S9(7) COMP-3.
*
*PROCEDURE DIVISION USING RECORD-A, RECORD-B.
*COMPARE-SORTORDER1.
* IF SOME-KEY OF RECORD-A > SOME-KEY OF RECORD-B
* MOVE 1 TO RETURN-CODE
* ELSE IF SOME-KEY OF RECORD-A < SOME-KEY OF RECORD-B
* MOVE -1 TO RETURN-CODE
* ELSE IF ANOTHER-KEY OF RECORD-A > ANOTHER-KEY OF RECORD-B
* MOVE 1 TO RETURN-CODE
* ELSE IF ANOTHER-KEY OF RECORD-A < ANOTHER-KEY OF RECORD-B
* MOVE -1 TO RETURN-CODE
* ELSE
* MOVE 0 TO RETURN-CODE.
*
* EXIT PROGRAM.
*
*
* To call from your program:
*
* MOVE 42 to TABLE-WIDTH
* MOVE 100 to NROWS
* MOVE "~SORTORDER1~" TO ORDER-SUB
* CALL "COBQSORT" USING MY-TABLE, NROWS,
* TABLE-WIDTH, ORDER-SUB
*
*
* Where 42 is the byte-width, 100 is the number of rows:
*
*
*01 NROWS PIC S9(9) COMP.
*01 TABLE-WIDTH PIC S9(9) COMP.
*01 ORDER-SUB PIC X(40).
*01 MY-TABLE.
* 05 TABLE-ROW OCCURS 100 TIMES.
* 10 SOME-DATA PIC X(20).
* 10 SOME-KEY PIC X(10).
* 10 MORE-DATA PIC X(08).
* 10 ANOTHER-KEY PIC S9(7) COMP-3.
*
*
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PLABEL PIC S9(9) COMP.
01 MYPROGRAM PIC X(38) VALUE SPACES.
01 ret-status pic s9(9) comp.
LINKAGE SECTION.
01 TABLE-BASE PIC XX.
01 NUM-ROWS PIC S9(9) COMP.
01 ROW-WIDTH PIC S9(9) COMP.
01 COMP-ROUTINE PIC X(20).
PROCEDURE DIVISION USING TABLE-BASE,
NUM-ROWS,
ROW-WIDTH,
COMP-ROUTINE.
QSORT-MAIN SECTION.
COMP-ROUTER.
IF MYPROGRAM = SPACES
CALL INTRINSIC "HPMYPROGRAM" USING MYPROGRAM
END-IF
move 0 to plabel
CALL INTRINSIC "HPGETPROCPLABEL" USING COMP-ROUTINE,
PLABEL, ret-status, MYPROGRAM
if ret-status <> 0
call intrinsic "HPERRMSG" using 2, \\, \\, ret-status
call intrinsic "SETJCW" using -1
stop run
end-if
CALL "qsort" USING TABLE-BASE,
\NUM-ROWS\,
\ROW-WIDTH\,
\PLABEL\
EXIT PROGRAM.
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
