Any body interested in the following?
Free COBOL source internal table sort routine.
Sorts fields:
1. alphanumeric ( PIC x(..) )
2. binary unsigned ( PIC 9(..) BINARY )
3. binary signed ( PIC s9(..) BINARY )
4. packed-decimal ( PIC 9(..) or s9(..) PACKED-DECIMAL)
5. floating-point short precision ( COMP-1 )
6. floating-point long precision ( COMP-2 )
7. alphanumeric code page independent sort ( PIC x(..) ) with a ASCII or EBCDIC independent collating sequence.
Interested?
I will sent you the source, just write mailto:
ahlers_wim@hotmail.com
Following is some additional information showing how the call structure works:
Regards, Wim Ahlers.
Free COBOL source internal table sort routine.
Sorts fields:
1. alphanumeric ( PIC x(..) )
2. binary unsigned ( PIC 9(..) BINARY )
3. binary signed ( PIC s9(..) BINARY )
4. packed-decimal ( PIC 9(..) or s9(..) PACKED-DECIMAL)
5. floating-point short precision ( COMP-1 )
6. floating-point long precision ( COMP-2 )
7. alphanumeric code page independent sort ( PIC x(..) ) with a ASCII or EBCDIC independent collating sequence.
Interested?
I will sent you the source, just write mailto:
ahlers_wim@hotmail.com
Following is some additional information showing how the call structure works:
Code:
*-------------------------------------------------------*
* *
* ALL 'SORT' PERMUTATIONS FOR THE 'combSort' FUNCTION: *
* *
*-------------------------------------------------------*
REPLACE ==<K>== BY ___ / ---------------- ==<L>== BY ___ ( SEE TABLES BELOW )
==<M>== BY ___ . \ ---------------- /
05 returnStatus PIC X(01).
88 allOK VALUE '0'.
88 NOTok VALUE '1'.
05 theMethod PIC X(30).
05 methodData.
10 sortOrder PIC X(03).
10 tableLength PIC 9(09) BINARY.
10 entryLength PIC 9(09) BINARY.
10 keyStart PIC 9(09) BINARY.
10 keyLength PIC 9(09) BINARY.
* ---> keyLength is NOT used for COMP-1 or COMP-2 sorts.
05 tableSpace.
10 tableElement OCCURS 100 TIMES.
15 tableEntry.
20 field1 PIC X(11).
20 field2 PIC X(13).
20 sortKey.
25 field3 <K>.
20 moreFields PIC X(19).
MOVE '<L>' TO sortOrder
MOVE '<M>' TO theMethod
REPLACE OFF.
* The following 'MOVE LENGTH OF' statement is NOT coded for
* COMP-1 or COMP-2 sorts.
MOVE LENGTH OF sortKey TO keyLength
ADD LENGTH OF field1, LENGTH OF field2, +1
GIVING keyStart
MOVE LENGTH OF tableSpace TO tableLength
MOVE LENGTH OF tableEntry TO entryLength
CALL 'CombSort' USING
, by reference returnStatus
, by content theMethod
, by content methodData
, by reference tableSpace
END-CALL
*---------------------------------------------------------------
*
*
* Where <L> is one of the following:
* .-----------------------.---------------------.
* ! ! !
* ! sort order ! replace statement !
* ! ! !
* !-----------------------!---------------------!
* ! ! !
* ! for ASCending sort ! REPLACE ==<L>== !
* ! ! BY ==ASC==. !
* ! ! !
* !-----------------------!---------------------!
* ! ! !
* ! for DEScending sort ! REPLACE ==<L>== !
* ! ! BY ==DES==. !
* ! ! !
* '-----------------------'---------------------'
*
*
* Where the combination of <K> and <M> is one of the following:
* .-------------------.-----------------------------------------.
* ! ! !
* ! sort method ! replace statement !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! byte ! REPLACE ==<K>== !
* ! ! BY ==PIC X(??)== !
* ! (same as: ! ==<M>== !
* ! unsignedBinary) ! BY ==byte==. !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! unsignedBinary ! REPLACE ==<K>== !
* ! ! BY ==PIC 9(??) BINARY== !
* ! (same as: ! ==<M>== !
* ! byte) ! BY ==unsignedBinary==. !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! signedBinary ! REPLACE ==<K>== !
* ! ! BY ==PIC s9(??) BINARY== !
* ! ! ==<M>== !
* ! ! BY ==signedBinary==. !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! packedDecimal ! REPLACE ==<K>== !
* ! ! BY ==PIC s9(??) PACKED-DECIMAL== !
* ! ! ==<M>== !
* ! ! BY ==packedDecimal==. !
* ! ! !
* ! ! (sign 's' is optional) !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! alphanumeric ! REPLACE ==<K>== !
* ! ! BY ==PIC X(??)== !
* ! (code page ! ==<M>== !
* ! independent ! BY ==alphanumeric==. !
* ! sort) ! !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! floating-point ! REPLACE ==<K>== !
* ! ! BY ==COMP-1== !
* ! (short precision) ! ==<M>== !
* ! ! BY ==shortPrecision==. !
* ! (*) ! !
* ! ! !
* !-------------------!-----------------------------------------!
* ! ! !
* ! floating-point ! REPLACE ==<K>== !
* ! ! BY ==COMP-2== !
* ! (long precision) ! ==<M>== !
* ! ! BY ==longPrecision==. !
* ! (*) ! !
* ! ! !
* '-------------------'-----------------------------------------'
*
*
*
* ADDITIONAL REMARKS:
* -------------------
*
* ?? is any legal(!) numeric value.
*
* (*) COMP-1 and COMP-2 (COMP-1 + 2) are vendor dependent!
* COMP-1 + 2 are assumed to be floating-point fields.
* COMP-1 + 2 both have a fixed field length.
* The keyLength field is not used for COMP-1 + 2 sorts.
* consequently, the coding line:
* MOVE LENGTH OF sortKey TO keyLength
* is NOT(!) coded for COMP-1 + 2 sorts.
*
* byte sort and unsignedBinary are interchangable.
* That is, byte sort and unsignedBinary are exactly the
* same sort.
*
* alphanumeric sort is used for sorting text.
* alphanumeric sort is a code page independent sort!
* It will sort either ASCII or EBCDIC in exactly(!) the
* same collating sequence regardless the code page used.
* Requirement: This is only(!) true for LATIN based code
* pages. LATIN based code pages include the following
* characters: (0-9), (A-Z), (a-z)
*
* The methodData contains upper- and lower-case characters.
* upper- and lower-case characters should be used asis!
* The sort routine may (or may not!) abend when the
* upper- and lower-case characters are NOT(!) used asis!
*
*
*---------------------------------------------------------------