This sample was Assembled and tested during May 2002 on an OS/390 V2.R9 system. (Note that because the XCTL macro passes control to a separate Load Module, two routines are listed.)

         PRINT NOGEN
         TITLE 'EX8C - SUBROUTINE EXERCISE - XCTL METHOD'
EX8C     CSECT
         USING *,R15                       INITIAL BASE REGISTER
BEGIN    B     START
         DC    AL1(8),CL8'EX8C'            PROGRAM NAME FOR DEBUGGING
SAVEAREA DS    0F                          MY SAVE AREA
         DC    AL4(*-*)
PRESAVE  DC    AL4(*-*)                    ADDR OF PREVIOUS SAVE AREA
NEXTSAVE DC    AL4(*-*)                    ADDR OF NEXT SAVE AREA
SREG14   DC    AL4(*-*)                    GENERAL
SREG15   DC    AL4(*-*)                           PURPOSE
SREG0    DC    13AL4(*-*)                                REGISTER SAVE
SAVEEND  DS    0H                          END OF MY SAVE AREA
         SPACE 1
START    EQU   *
         DROP R15                          DROP INITIAL BASE REGISTER
         STM   14,R12,12(R13)              SAVE THE REGISTERS ON ENTRY.
         LR    R12,R15                     SET UP MY
         USING BEGIN,R12                   BASE REGISTER
         ST    R13,PRESAVE                 PERFORM SAVE
         LA    R15,SAVEAREA                            AREA
         ST    R15,8(R13)                                  CHAINING
         LR    R13,R15                     R13 = ADDR OF MY SAVE AREA.
         OPEN  (INDCB,INPUT)               OPEN INPUT FILE
         EJECT
*
*        PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
         LA    R11,DONEONCE                SET UP 1ST EOF ROUTINE
         SR    R5,R5                       R5  ZERO FOR COUNT.
READREC1 GET   INDCB,INAREA                READ A RECORD
*
*        RETRIEVE THE NAMES TO COUNT THEM
*        
         LA    R5,1(,R5)                   INCREMENT RECORD COUNT,
         B     READREC1                    AND REPEAT TILL EXHAUSTED.
DONEONCE CLOSE (INDCB)                     REPOSITION
         LA    R11,DUNTWICE                          INPUT
         OPEN  (INDCB,INPUT)                              FILE.
         ST    R5,SAVECNT                  SAVE RECORD COUNT.
         M     R4,=F'8'                    CALCULATE
         A     R5,=F'8'                             STORAGE SIZE.
         ST    R5,MYSIZE                   SAVE SIZE OF AREA.
         STORAGE OBTAIN,LENGTH=(5),ADDR=MYSTORE  GET STORAGE
         L     R15,MYSIZE                  SIZE READY FOR SUBROUTINE
         L     R3,MYSTORE                  CALCULATE END
         AR    R3,R15                                   OF ARRAY
         L     R4,MYSTORE                  GET GOTTEN AREA ADDRESS
         ST    R3,0(R4)                    SAVE END FOR SUB-ROUTINE.
         ST    R15,4(R4)                   SAVE SIZE FOR SUB-ROUTINE.
         A     R4,=F'8'                    POINT TO ARRAY START
         USING NAMETAB,R4                  GET ARRAY ADDRESSABILITY
READREC2 GET   INDCB,INAREA                READ A RECORD
*
*        RETRIEVE THE NAMES AND SORT THEM!
*
         MVC   NAME,INAREA                 SLOT NAME IN ARRAY,
         LA    R4,8(,R4)                   POINT TO NEXT ARRAY SLOT,
         B     READREC2                    AND REPEAT TILL EXHAUSTED.
DUNTWICE CLOSE (INDCB)                     CLOSE INPUT FILE
         L     R1,MYSTORE                  GET ARRAY ADDRESS
         XCTL  (2,12),EP=EX8CSUB           GO SORT WITHOUT RETURN
*
*        SHOULD NEVER DROP THROUGH HERE
*
         L     R13,PRESAVE                 R13 = PREVIOUS SAVE AREA ADDR.
         RETURN (14,12),RC=0               RESTORE REGISTERS
         SPACE 3
EOFRTN   BR    R11                         END OF FILE ROUTINE.
         EJECT
         LTORG
         SPACE 1
SAVECNT  DS    F                           SAVED RECORD COUNT
SIZES    DC    AL4(*-*),AL4(*-*)           STORAGE REQUEST SIZE (MIN/MAX)
MYSTORE  DC    AL4(*-*)                    ADDRESS OF GOTTEN AREA
MYSIZE   DC    AL4(*-*)                    SIZE OF GOTTEN AREA
         SPACE 1
INDCB    DCB   MACRF=GM,DDNAME=INDD,LRECL=80,EODAD=EOFRTN,                  *
               DSORG=PS
INAREA   DS    CL80
         SPACE 1
NAMETAB  DSECT
NAME     DS    CL8                         ANY GIVEN NAME HERE
EX8C     CSECT
R0       EQU   0
R1       EQU   1 
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         END

Below is the additional module invoked by EX8C.

         PRINT NOGEN
         TITLE 'EX8CSUB - SUBROUTINE INVOKED BY EX8C'
EX8CSUB  CSECT
         USING *,R15                       INITIAL BASE REGISTER
BEGIN    B    START
         DC    AL1(8),CL8'EX8CSUB'         PROGRAM NAME FOR DEBUGGING
SAVEAREA DS    0F                          MY SAVE AREA
         DC    AL4(*-*)
PRESAVE  DC    AL4(*-*)                    ADDR OF PREVIOUS SAVE AREA
NEXTSAVE DC    AL4(*-*)                    ADDR OF NEXT SAVE AREA
SREG14   DC    AL4(*-*)                    GENERAL
SREG15   DC    AL4(*-*)                           PURPOSE
SREG0    DC    13AL4(*-*)                                REGISTER SAVE
SAVEEND  DS    0H                          END OF MY SAVE AREA
         SPACE 1
START    EQU   *
         DROP R15                          DROP INITIAL BASE REGISTER
         STM   14,R12,12(R13)              SAVE THE REGISTERS ON ENTRY.
         LR    R12,R15                     SET UP MY
         USING BEGIN,R12                   BASE REGISTER
         ST    R13,PRESAVE                 PERFORM SAVE
         LA    R15,SAVEAREA                            AREA
         ST    R15,8(R13)                                  CHAINING
         LR    R13,R15                     R13 = ADDR OF MY SAVE AREA.
         L     R5,0(R1)                    R5  = END OF ARRAY ADDRESS
         LR    R2,R1                       R2  = NAME TABLE ADDRESS 
SORT     LA    R4,8(,R2)                   R4  = START OF ARRAY.
         LA    R3,8(,R4)                   R3  = START OF ARRAY + 1.
         TM    FLAG,SORTED                 ARE NAMES IN ORDER?
         BO    INFORM                      YEP - GO TELL ABOUT IT.
         OI    FLAG,SORTED                 NO  - INDICATE THEY ARE.
SORT1    CR    R3,R5                       END OF ARRAY?
         BNL   SORT                        YEP - CHECK ALL DONE,
         CLC   0(8,R4),0(R3)               NO  - IS FIRST > SECOND?
         BH    SWAP                        YEP - SWAP THEM
SORT2    LA    R4,8(,R4)                   NO  - MOVE TO
         LA    R3,8(,R3)                                NEXT
         B     SORT1                                        PAIR.
SWAP     MVC   TEMP,0(R4)                  SAVE FIRST NAME, THEN
         MVC   0(8,R4),0(R3)               MOVE SECOND NAME FORWARD,
         MVC   0(8,R3),TEMP                RETURN FIRST NAME TO ARRAY.
         NI    FLAG,255-SORTED             INDICATE NOT SORTED.
         B     SORT2                       GO GET NEXT PAIR.
         SPACE 1
INFORM   OPEN  (OUTDCB,OUTPUT)             OPEN OUTPUT FILE
         LA    R6,OUTAREA+1                MOVE   
         L     R7,4(R2)                         SORTED
         LA    R4,8(,R2)                               ARRAY
         LR    R5,R7                                         TO
         MVCL  R6,R4                                            OUTPUT
         PUT   OUTDCB,OUTAREA              AND PRINT IT.
         CLOSE OUTDCB                      CLOSE OUTPUT FILE
         L     R13,PRESAVE                 R13 = PREVIOUS SAVE AREA ADDR.
         RETURN (14,12),RC=0<              RESTORE REGISTERS
TEMP     DS    CL8                         SWITCH NAME AREA. 
FLAG     DC    X'00'                       INDICATE NOT SORTED
SORTED   EQU   X'01'                       INDICATE SORTED.
OUTDCB   DCB   DSORG=PS,MACRF=PM,DDNAME=OUTDD,RECFM=F,                      *
               LRECL=133
OUTAREA  DC    CL133' '
R0       EQU   0
R1       EQU   1 
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         END

Copyright © KMS-IT Limited 2002