Method 2

This sample was Assembled and tested during April 2002 on an OS/390 V2.R9 system.

         PRINT NOGEN
         TITLE 'EX3B - EXERCISE IN ADDRESSING - 2'
EX3B     CSECT
         USING *,R15                 INITIAL BASE REGISTER
BEGIN    B     START
         DC    AL1(8),CL8'EX3B'      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  15                   DUMP INITIAL BASE REG.
         STM   R14,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,OUTDCB,OUTPUT)
         EJECT
*
*        PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.
*
         LA    R3,NAMETABD           R3  = ADDR OF PREVIOUS SLOT.
         LA    R4,NAMETAB            R4  = ADDR OF 1/CURRENT SLOT.
READREC  GET   INDCB,INAREA          READ A RECORD
*
*        RETRIEVE THE NAMES AND SORT THEM!
*
         CLC   =CL4'****',INAREA     IS IT LAST INPUT RECORD?
         BE    READDONE              YEP - STOP READING.
         CLC   INAREA(4),0(R3)       IS NAME LESS THAN PREVIOUS?
         BE    ADDIT                 NO  - THEN PUT
         BH    ADDIT                 - - - - - - - -> IN TABLE.
         STM   R3,R4,WREGS           SAVE WORKING REGISTERS.
SORTIT   MVC   0(10,R4),0(R3)        PREVIOUS TO NEXT.
         L     R6,=F'-10'            POINT TO
         LA    R3,0(R6,R3)           - - - - -> EARLIER ENTRY!
         LA    R4,0(R6,R4)
         CLC   INAREA(4),0(R3)       IS NAME LESS THAN PREVIOUS?
         BNL   SORTED                NO - THEN PUT IN AVAILABLE SLOT
         B     SORTIT                LOOP - TILL SLOT AVAILABLE.
SORTED   MVC   0(10,R4),INAREA       PUT NAME IN TABLE.
         LM    R3,R4,WREGS           RESTORE CONTENTS, AND
         B     ADDIT2                REPEAT TILL END OF INPUT.
*
*        NAME HIGH MEANS WE SIMPLY ADD TO THE LIST.
*
ADDIT    MVC   0(7,R4),INAREA        NO  - INSERT NAME IN PRINTLINE
ADDIT2   LR    R3,R4                 R3  = NEW PREVIOUS SLOT ADDR.
         LA    R4,10(,R4)            R4  = NEW CURRENT SLOT ADDR.
         B     READREC               AND REPEAT TILL FILE EXHAUSTED
         SPACE 1
READDONE MVC   OUTAREA+1(80),NAMETAB
         PUT   OUTDCB,OUTAREA        OUTPUT SORTED LIST
         SPACE 3
EXIT     CLOSE (INDCB,,OUTDCB)       CLOSE BOTH FILES
         SR    R15,R15               FORCE COND CODE ZERO
         L     R13,PRESAVE           R13 = PREVIOUS SAVE AREA ADDR.
         L     R14,12(R13)           RESTORE REGISTERS
         LM    R0,R12,20(R13)        EXCEPT REGISTER 15
         BR    R14                   RETURN TO CALLER (Z/OS)
         EJECT 
         LTORG
         SPACE 1
WREGS    DC    AL4(*-*),AL4(*-*)     SAVED R3 - R4 INCLUSIVE.
         SPACE 1
INDCB    DCB   MACRF=GM,EODAD=READDONE,DDNAME=INDD,LRECL=80,         * 
               DSORG=PS
INAREA   DS    CL80
         SPACE 1
OUTDCB   DCB   MACRF=PM,RECFM=F,LRECL=133,DDNAME=OUTDD,DSORG=PS
OUTAREA  DC    CL133' '
         SPACE 1
NAMETABD DC    XL10'0'               DUMMY FIRST ENTRY - LOW VALUES
NAMETAB  DC    CL10' '               FIRST ENTRY - NAMES + BLANKS
         DC    7CL10' '              FURTHER 7 ENTRIES.
NAMETABE DC    XL1'FF'               END OF NAME TABLE.
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