Inside COBOL #81 (Sorting tables)
by
Shawn Gordon
President
The Kompany

Well, to follow up our discussion on Python last month, it seems that BeOpen has gone out of business and the Pythonlabs people are now employed by Digital Creations, the authors of Zope, which is a Python web development package.

How many times have you just had some simple data in a table in your program that you wanted to sort. Seems like a waste of time to go through and write it to a file and sort the file and read it back in. The new COBOL standard has a verb to allow you to sort tables (finally), but it will be some time before you get to use it. I’ve actually gotten a few emails recently asking me about this, so I thought I would go over it. What I have this month is both a simple
bubble sort and a more complex, but efficient, Shell sort. The bubble sort only requires that we have two counters, one save buffer, and one table max variable, on top of the table data. 

 
WORKING-STORAGE SECTION. 
01 SAVE-CODE 	PIC X(04) VALUE SPACES. 
01 S1 		PIC S9(4) COMP VALUE 0. 
01 S2 		PIC S9(4) COMP VALUE 0. 
01 TABLE-MAX 	PIC S9(4) COMP VALUE 0. 
01 CODE-TABLE.
   03 CODE-DATA PIC X(04) OCCURS 100 TIMES. 

PROCEDURE DIVISION.
 
A1000-INIT. 
* 
* Do whatever steps are necessary to fill CODE-TABLE with the values 
* you are going to use in your program. Make sure to increment 
* TABLE-MAX for each entry you put in the table. 
* 
* Now we are going to perform a bubble sort of the table. 
*
PERFORM VARYING S1 FROM 1 BY 1 UNTIL S1 = TABLE-MAX
	PERFORM VARYING S2 FROM S1 BY 1 UNTIL S2 > TABLE-MAX
		IF CODE-DATA(S2) < CODE-DATA(S1)
			MOVE CODE-DATA(S1) TO SAVE-CODE
			MOVE CODE-DATA(S2) TO CODE-DATA(S1)
			MOVE SAVE-CODE TO CODE-DATA(S2)
		END-IF
	END-PERFORM
END-PERFORM. 

As you can see, this is a pretty trivial, and easy to implement solution for simple table. What we have next is a macro that does a Shell Sort.  As I said, this is much faster and more efficient, but a bit more complex. I got this originally from John Zoltak, and the following text is his, with some slight edits from me.

COPY SORTDEF. 
When I want to sort the array I use 

MOVE number-of-elements to N-SUB. 

%SORTTABLE(TABLE-NAME#, HOLD-AREA#). 

It uses the shell sort, faster than a bubble. Also since it's a macro, I can sort on any table. The only real constraint is that it compares the whole table element, so you just have to arrange your table element so it sort's the way you want. 

* SHELL SORT ROUTINE 
* 
* This macro expects parameter 1 to be the element of the 
* table to be sorted. This sort compares the entire element. 
* Parameter 2 is the element hold area. Can be a higher 
* element of the table if you wish. 
* 
* To use this sort macro, you must COPY it into your program 
* in the 01 LEVEL area. Four (4) variables will be declared 
* and the $DEFINE for %SORTTABLE will be defined. 
* 
* Before invoking this macro you must set N-SUB to the 
* highest table element to be sorted. 
01 I-SUB 	PIC S9(4) COMP. 
01 J-SUB 	PIC S9(4) COMP. 
01 M-SUB 	PIC S9(4) COMP. 
01 N-SUB 	PIC S9(4) COMP. 
$DEFINE %SORTTABLE=
	IF N-SUB > 1
		MOVE N-SUB TO M-SUB
		PERFORM TEST AFTER UNTIL M-SUB = 1
			DIVIDE 2 INTO M-SUB
			ADD 1 TO M-SUB GIVING I-SUB
			PERFORM UNTIL I-SUB > N-SUB
				MOVE !1(I-SUB) TO !2 
				MOVE I-SUB TO J-SUB 
				SUBTRACT M-SUB FROM J-SUB GIVING TALLY
				PERFORM UNTIL J-SUB <= M-SUB OR !1(TALLY) <= !2 
     				        MOVE !1(TALLY) TO !1(J-SUB) 
					SUBTRACT M-SUB FROM J-SUB
 					SUBTRACT M-SUB FROM J-SUB GIVING TALLY
 
				END-PERFORM 
				MOVE !2 TO !1(J-SUB)
 				ADD 1 TO I-SUB
 			END-PERFORM 
		END-PERFORM
 	END-IF#