/* HEXSORT XEDIT:
Same as XEDIT SORT, but sorts hexadecimal data correctly.
 
LIMITATION: Unlike XEDIT SORT, there is a limit of 10 fields.
 
MODIFICATION HISTORY:
09/02/97 - Roger Deschner - Pad to LRECL when RECFM F
07/29/97 - Roger Deschner - Accommodate backwards targets
07/26/97 - Roger Deschner - Original version.
This technique is from PIPE AHELP SORT, by John Hartman, reprinted in
           "Plunging Into Pipes" by Melinda Varian.
*/
'COMMAND EXTRACT /LINE /LRECL /RECFM'
/* Save current line pointer */
origline = line.1
/* Do we need to pad lines when RECFM F or FP? */
IF (SUBSTR(recfm.1,1,1) = 'F') THEN padstage = '| PAD' lrecl.1
  ELSE padstage = ''
 
/* Start with a clean stack */
ADDRESS COMMAND 'CONWAIT'
ADDRESS COMMAND 'DESBUF'
 
/* Parse user input */
PARSE ARG argstr
QUEUE argstr
'MACRO PARSE 1 TARGET LINE'
orc = rc
IF (orc <> 0) THEN DO
  'COMMAND EMSG Missing operands.'
  CALL QUITTER 5
END
 
PARSE PULL nlines .
 
IF (nlines < 2) THEN DO
  'COMMAND EMSG No sort list given.'
  CALL QUITTER 40
END
 
/* Extract the target */
PARSE PULL targbeg targlen .
targ = SUBSTR(argstr,targbeg,targlen)
 
/* Extract the remainder of the line */
PARSE PULL restbeg restlen .
PARSE VALUE SUBSTR(argstr,restbeg,restlen) WITH direction colranges
 
UPPER direction
IF ((direction <> 'A') & (direction <> 'D')) THEN DO /* Set default */
  colranges = direction colranges
  direction = 'A'
END
 
/* Turn XEDIT style ranges into PIPE style ranges */
sortspec = ''
DO i = 1 UNTIL (colranges = '')
  PARSE VAR colranges col1 col2 colranges
  IF (col2 = '') THEN col2 = col1  /* default end col is start */
  IF ((DATATYPE(col1,'W') <> 1) | (DATATYPE(col2,'W') <> 1)) THEN DO
    'COMMAND EMSG Direction not "A" or "D",',
       'or column number not numeric.'
    CALL QUITTER 24
  END
  IF (col2 < col1) THEN DO
    'COMMAND EMSG Column range' col1 col2 'out of order.'
    CALL QUITTER 24
  END
  sortspec = sortspec col1'-'col2 direction
END
 
IF (i > 10) THEN DO
  'COMMAND EMSG You cannot specify more than 10 column ranges.'
  CALL QUITTER 24
END
 
ADDRESS COMMAND 'CONWAIT'        /* Get rid of anything leftover from */
ADDRESS COMMAND 'DESBUF'                               /* ...parsing. */
'COMMAND STACK' targ              /* Put all our lines into the stack */
/* Where are we now? Was this a backwards or forwards target? Find    */
/* this out now that we're there by extracting the line number. If    */
/* this was a backwards (upwards) target, then we are already at the  */
/* beginning of the range of lines. If this was a normal forwards     */
/* (downwards) target, then we need to go back to the beginning,      */
/* since the PIPE XEDIT stage only works one way - forwards.          */
'COMMAND EXTRACT /LINE'
IF (line.1 > origline) THEN 'COMMAND LOCATE :'origline
 
ADDRESS COMMAND 'PIPE STACK',                      /* Read from stack */
  '| XLATE 1-* A-F fa-ff fa-ff A-F',            /* Transform for sort */
  '| SORT' sortspec,                         /* Sort w/caller's parms */
  '| XLATE 1-* A-F fa-ff fa-ff A-F',                       /* Restore */
  padstage,                           /* If RECFM F, pad out to LRECL */
  '| XEDIT'                      /* Overwrite them back into the file */
orc = rc
 
'COMMAND LOCATE :'origline
CALL QUITTER orc
 
QUITTER:
PARSE ARG finalrc .
ADDRESS COMMAND 'CONWAIT'
ADDRESS COMMAND 'DESBUF'
EXIT finalrc