/********************************************************************/ 01310000 /* */ 01320000 /* PROCEDURE NAME - SORT (ACCESS METHOD SERVICES) @Z40LB37*/ 01330000 /* @Z40LB37*/ 01340000 /* FUNCTION - THIS COMMON INCLUDED PROCEDURE PROVIDES THE @Z40LB37*/ 01342400 /* CALLER WITH THE BASIC FUNCTION OF SORTING @Z40LB37*/ 01342800 /* A CONTIGUOUS AREA OF STORAGE OF ANY LENGTH, @Z40LB37*/ 01343200 /* OR ELEMENT (RECORD) SIZE. IT ALLOWS @Z40LB37*/ 01343600 /* CHARACTER FIELDS TO BE SORTED PER USER CALL, @Z40LB37*/ 01343700 /* ANYWHERE WITHIN AN ELEMENT (RECORD) FOR ANY @Z40LB37*/ 01343800 /* LENGTH EQUAL TO OR SMALLER THAN AN ELEMENTS @Z40LB37*/ 01343900 /* SIZE. THE ELEMENT SIZE CANNOT CHANGE BETWEEN @Z40LB37*/ 01345100 /* CALLS TO THE SORT PROCEDURE. (THIS IS A @Z40LB37*/ 01345500 /* COMPILE TIME VARIABLE.) @Z40LB37*/ 01345900 /* @Z40LB37*/ 01349400 /* ENTRY POINT - SORT @Z40LB37*/ 01350600 /* @Z40LB37*/ 01351800 /* LINKAGE - 'CALL SORT (SRTAGL)' @Z40LB37*/ 01353000 /* '%SRTLABEL = 'WORK AREA'' @Z40LB37*/ 01354200 /* '%INCLUDE SYSLIB(IDCDF54)' @Z40LB37*/ 01355400 /* @Z40LB37*/ 01356600 /* INPUT - ADDRESS OF ARGUMENT LIST (SRTAGL) @Z40LB37*/ 01357800 /* @Z40LB37*/ 01359000 /* OUTPUT - A RETURN CODE IN REGISTER 15 @Z40LB37*/ 01360200 /* @Z40LB37*/ 01361400 /* (0) - SORT SUCCESSFUL @Z40LB37*/ 01362600 /* @Z40LB37*/ 01363800 /* EXIT NORMAL - RETURNS TO CALLER WITH CONDITION @Z40LB37*/ 01365000 /* CODE ZERO @Z40LB37*/ 01366200 /* @Z40LB37*/ 01367400 /* EXIT ERROR - NONE @Z40LB37*/ 01377400 /* @Z40LB37*/ 01377800 /* CHANGE ACTIVITY - NONE @Z40LB37*/ 01378200 /* */ 01378300 /********************************************************************/ 01378400 % DECLARE SRTLABEL CHARACTER; /*@Z40LB37*/ 01388800 % IF SRTLABEL = '' %THEN 01388900 %SRTLABEL = '0'; /*@Z40LB37*/ 01389000 01389200 SORT: /*AMS SORT ROUTINE @Z40LB37*/ 01400000 PROCEDURE(SRTARG); /*SORT ARGUMENT LIST @Z40LB37*/ 01450000 01700000 @EJECT; /*@Z40LB37*/ 01750000 /*****************************************************************/ 01794400 /* */ 01800000 /* DECLARATIONS FOR THE SORT ROUTINE. @Z40LB37*/ 01850000 /* */ 01900000 /*****************************************************************/ 01950000 02000000 DCL 02050000 1 SRTSTOR(*) BASED(SRTPTR), /*INPUT STORAGE DCL @Z40LB37*/ 02100000 2 SRTELEM CHAR(LENGTH(SRTLABEL));/*FOR MOVING ONE 02150000 ELEMENT @Z40LB37*/ 02200000 DCL 02250000 SRTSAVE CHAR(LENGTH(SRTLABEL))/*PASSED ELEMENT @Z40LB37*/ 02260000 BASED(SRTWPTR); /*SAVE AREA @Z40LB37*/ 02270000 DCL 02272000 (SRTPTR,SRTWPTR) PTR(31); /*SORT AREA PTRS @Z40LB37*/ 02274000 DCL 02278000 SRTLN FIXED(31); /*SORT ELEMENT LENGTH @Z40LB37*/ 02278400 DCL 02280000 (SRTBEG,SRTEND) FIXED(31); /*SORT FIELD DCLS @Z40LB37*/ 02290000 DCL 02294000 (SRTSTOP,SRTMOVE) BIT(1); /*SORT SWITCHES @Z40LB37*/ 02294100 DCL 02294300 SRTON BIT(1) CONSTANT('1'B);/*SWITCH ON CONSTANT @Z40LB37*/ 02308200 DCL 02320200 SRTOFF BIT(1) CONSTANT('0'B);/*SWITCH OFF CONSTANT @Z40LB37*/ 02320600 DCL 02338000 (SRTMAXCT,SRTI,SRTJ) FIXED(31);/*SORT COUNTER DCLS @Z40LB37*/ 02340000 DCL 02360000 SRTRC FIXED(15) CONSTANT(0);/*SORT RETURN CODE AREA @Z40LB37*/ 02370000 02372400 @EJECT; /*@Z40LB37*/ 02374400 /*****************************************************************/ 02374800 /* */ 02375200 /* RESPECIFY SRTAGL ON PASSED ADDRESS, ISSUE UTRACE @Z40LB37*/ 02375600 /* AND UDUMP MACROS, AND INITIALIZE LOCAL COUNTERS AND @Z40LB37*/ 02379800 /* LENGTH FIELDS. @Z40LB37*/ 02380600 /* */ 02381800 /*****************************************************************/ 02383800 02385800 RFY 02387800 SRTAGL BASED(ADDR(SRTARG)); /*@Z40LB37*/ 02389800 02391800 UTRACE = 'SORT'; /*@Z40LB37*/ 02395600 02399200 UDUMP (GDTTBL,'SOTI'); /*@Z40LB37*/ 02402800 02406400 SRTHEAD = 'SRTAGL '; /*@Z40LB37*/ 02419200 SRTWPTR = SRTWORKP; /*@Z40LB37*/ 02419600 SRTPTR = SRTADDR; /*@Z40LB37*/ 02419700 SRTLN = SRTLEN; /*@Z40LB37*/ 02419800 SRTMAXCT = SRTNUM; /*@Z40LB37*/ 02419900 SRTBEG = SRTPOSIT; /*@Z40LB37*/ 02420000 SRTEND = SRTPOSIT + (SRTFLDLN - 1); /*@Z40LB37*/ 02430000 SRTSTOP = SRTOFF; /*@Z40LB37*/ 02440000 SRTMOVE = SRTOFF; /*@Z40LB37*/ 02442000 02446000 @EJECT; /*@Z40LB37*/ 02446400 /*****************************************************************/ 02446800 /* */ 02447200 /* EXECUTE THE SORT LOOP USING THE MAXIMUM ELEMENTS @Z40LB37*/ 02447600 /* MINUS ONE FOR THE SRTI COUNTER AND DECREMENTING THE @Z40LB37*/ 02447700 /* THE SRTI COUNTER BY ONE EACH PASS. THE SRTJ COUNTER @Z40LB37*/ 02448500 /* IS USED TO COUNT THE ELEMENTS THRU EACH PASS AND IN- @Z40LB37*/ 02448600 /* CREMENT THE SRTJ COUNTER BY ONE AFTER EACH ELEMENT @Z40LB37*/ 02448700 /* IS COMPARED. THE SRTSTOP SWITCH IS USED TO TERM- @Z40LB37*/ 02448800 /* INATE THE SORT IF NO INTERCHANGE OF ELEMENTS TAKES @Z40LB37*/ 02450200 /* PLACE. @Z40LB37*/ 02453200 /* */ 02454600 /*****************************************************************/ 02455000 02455800 SRTLOOP: 02457100 DO SRTI = SRTMAXCT-1 TO 1 BY -1 WHILE SRTSTOP = SRTOFF;/*@Z40LB37*/ 02458400 DO SRTJ = 1 TO SRTI; /*@Z40LB37*/ 02459700 02461000 /*************************************************************/ 02462300 /* */ 02463600 /* COMPARE THE TWO ELEMENTS TO SEE IF AN INTER- @Z40LB37*/ 02464900 /* CHANGE SHOULD TAKE PLACE, USING THE PASSED SORT @Z40LB37*/ 02465300 /* FIELDS AS A SUBSTRING, IF SO INTERCHANGE THEM. @Z40LB37*/ 02465700 /* */ 02466200 /*************************************************************/ 02467500 02468800 IF SRTELEM(SRTJ,SRTBEG:SRTEND) > SRTELEM(SRTJ+1,SRTBEG:SRTEND) 02470100 THEN 02471400 DO; /*@Z40LB37*/ 02472700 SRTMOVE = SRTON; /*@Z40LB37*/ 02474000 SRTSAVE = SRTELEM(SRTJ); /*@Z40LB37*/ 02475300 SRTELEM(SRTJ) = SRTELEM(SRTJ+1); /*@Z40LB37*/ 02476600 SRTELEM(SRTJ+1) = SRTSAVE; /*@Z40LB37*/ 02478600 END; /*@Z40LB37*/ 02480600 END; /*@Z40LB37*/ 02482600 02482800 /***************************************************************/ 02482900 /* */ 02492600 /* IF AN ELEMENT WAS INTERCHANGED THEN TURN SRTMOVE @Z40LB37*/ 02502600 /* SWITCH OFF. IF NO INTERCHANGE WAS MADE TURN SORT @Z40LB37*/ 02502800 /* STOP SWITCH TO ON. @Z40LB37*/ 02510300 /* */ 02512700 /***************************************************************/ 02514200 02524200 IF SRTMOVE = SRTON 02525700 THEN 02537000 SRTMOVE = SRTOFF; /*@Z40LB37*/ 02548300 ELSE 02559600 SRTSTOP = SRTON; /*@Z40LB37*/ 02570900 END SRTLOOP; /*END OF SRTLOOP TO SORT INTO AN */ 02582200 /*ASCENDING SEQUENCE @Z40LB37*/ 02593500 02604800 @EJECT; /*@Z40LB37*/ 02614800 UDUMP (GDTTBL,'SOTO'); /*UDUMP EXIT @Z40LB37*/ 02616100 02627400 RETURN CODE(SRTRC); /*RETURN TO MAIN ROUTINE @Z40LB37*/ 02638700 02650000 END SORT; /*END OF AMS SORT ROUTINE - 03000000 SORT @Z40LB37*/ 03050000